(defconst package-directory-map
'(
;; xemacs-packages
- ("Sun" . "xemacs-packages")
("ada" . "xemacs-packages")
("apel" . "xemacs-packages")
("auctex" . "xemacs-packages")
("bbdb" . "xemacs-packages")
- ("build" . "xemacs-packages")
("c-support" . "xemacs-packages")
("calc" . "xemacs-packages")
("calendar" . "xemacs-packages")
("cc-mode" . "xemacs-packages")
("cedet-common" . "xemacs-packages")
- ("clearcase" . "xemacs-packages")
("cogre" . "xemacs-packages")
("cookie" . "xemacs-packages")
("crisp" . "xemacs-packages")
("textools" . "xemacs-packages")
("time" . "xemacs-packages")
("tm" . "xemacs-packages")
- ("tooltalk" . "xemacs-packages")
("tpu" . "xemacs-packages")
("tramp" . "xemacs-packages")
("vc" . "xemacs-packages")
- ("vc-cc" . "xemacs-packages")
("vhdl" . "xemacs-packages")
("view-process" . "xemacs-packages")
("viper" . "xemacs-packages")
("x-symbol" . "xemacs-packages")
("xemacs-base" . "xemacs-packages")
("xemacs-devel" . "xemacs-packages")
- ("xetla" . "xemacs-packages")
("xlib" . "xemacs-packages")
("xslide" . "xemacs-packages")
("xslt-process" . "xemacs-packages")
("xwem" . "xemacs-packages")
- ("zenirc" . "xemacs-packages")
;; mule-packages
("edict" . "mule-packages")
("egg-its" . "mule-packages")
(list (expand-file-name "lisp" (file-name-as-directory dir))))
((equal package "mew")
(list (expand-file-name "mew" (file-name-as-directory dir))))
- ((equal package "zenirc")
- (list (expand-file-name "src" (file-name-as-directory dir))))
((equal package "semantic")
(list dir
(expand-file-name "bovine" (file-name-as-directory dir))
\
cedet-common speedbar eieio ede semantic cogre \
\
- Sun ada auctex bbdb build c-support calc calendar clearcase \
+ ada auctex bbdb c-support calc calendar \
cookie crisp dictionary docbookide easypg ecb ediff edt emerge \
erc escreen eshell eudc footnote forms fortran-modes \
frame-icon games general-docs gnats gnus guided-tour haskell-mode \
prog-modes ps-print psgml psgml-dtds python-modes re-builder \
reftex riece rmail ruby-modes sasl scheme sgml \
sieve slider sml-mode sounds-au sounds-wav strokes \
- supercite textools time tm tooltalk tpu tramp \
- vc vc-cc vhdl view-process viper vm w3 x-symbol \
- xetla xslide xslt-process xwem zenirc
+ supercite textools time tm tpu tramp \
+ vc vhdl view-process viper vm w3 x-symbol \
+ xslide xslt-process xwem
else
PACKAGES := $(NONMULE_PACKAGES)
endif
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.19 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
-
-2012-01-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2011-12-30 Aidan Kehoe <kehoea@parhasard.net>
-
- * sunpro-sparcworks.el:
- No longer require cl-19, Quiroz's CL compatibility package is long
- gone, (require 'cl) is good enough.
-
-2004-09-06 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2004-08-24 Jerry James <james@xemacs.org>
-
- * sun-eos-debugger-extra.el (get-buffer-window-list): Removed.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2003-09-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try
- to build custom-loads, this package doesn't have any.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-1998-07-25 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: removed.
-
-1998-07-18 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Elimination of Lisp read-time macros.
-
-1998-03-06 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Don't dump cc-mode, it's broken for dumping.
-
-1998-01-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (PACKAGE): Update to package standard 1.0.
-
-1998-01-04 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: New file from standard dumped-lisp.el.
-
-1997-12-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile: Created.
-
+++ /dev/null
-# Makefile for Sun specific lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.19
-AUTHOR_VERSION =
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
-PACKAGE = Sun
-PKG_TYPE = regular
-REQUIRES = cc-mode xemacs-base
-CATEGORY = standard
-
-ELCS = eos.elc sccs.elc sun-eos-browser.elc sun-eos-common.elc \
- sun-eos-debugger-extra.elc sun-eos-debugger.elc \
- sun-eos-editor.elc sun-eos-init.elc sun-eos-load.elc \
- sun-eos-menubar.elc sun-eos-toolbar.elc sun-eos.elc \
- sunpro-init.elc sunpro-keys.elc sunpro-menubar.elc \
- sunpro-sparcworks.elc
-
-include ../../XEmacs.rules
+++ /dev/null
-### Makefile --- The makefile to build EOS
-
-## Copyright (C) 1995 Sun Microsystems, Inc.
-
-## Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-## Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-## Keywords: SPARCworks EOS Era on SPARCworks make makefile
-
-### Commentary:
-
-## Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-### Code:
-
-# what emacs is called on your system
-EMACS = ../../src/xemacs
-
-# compile with noninteractive and relatively clean environment
-BATCHFLAGS = -batch -vanilla -eval "(push \"$$(pwd)\" load-path)"
-
-# files that contain variables and macros that everything else depends on
-CORE = sun-eos-common.el
-
-OBJECTS = \
- sun-eos-browser.elc sun-eos-common.elc sun-eos-debugger-extra.elc \
- sun-eos-debugger.elc sun-eos-editor.elc sun-eos-init.elc \
- sun-eos-menubar.elc sun-eos-toolbar.elc sun-eos-load.elc
-
-SOURCES = \
- sun-eos-browser.el sun-eos-common.el sun-eos-debugger-extra.el \
- sun-eos-debugger.el sun-eos-editor.el sun-eos-init.el \
- sun-eos-menubar.el sun-eos-toolbar.el sun-eos-load.el
-
-EXTRA = custom-load.elc
-
-all: $(OBJECTS)
-
-clean:
- rm -f $(OBJECTS)
-
-custom-load.elc: auto-autoloads.el
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile custom-load.el
-
-sun-eos-browser.elc: sun-eos-browser.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-browser.el
-
-sun-eos-debugger.elc: sun-eos-debugger.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-debugger.el
-
-sun-eos-debugger-extra.elc: sun-eos-debugger-extra.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-debugger-extra.el
-
-sun-eos-editor.elc: sun-eos-editor.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-editor.el
-
-sun-eos-toolbar.elc: sun-eos-toolbar.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-toolbar.el
-
-sun-eos-menubar.elc: sun-eos-menubar.el $(CORE)
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-menubar.el
-
-sun-eos-common.elc: sun-eos-common.el
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-common.el
-
-sun-eos-init.elc: sun-eos-init.el
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-init.el
-
-sun-eos-load.elc: sun-eos-load.el
- ${EMACS} ${BATCHFLAGS} -f batch-byte-compile sun-eos-load.el
-
-autoloads: custom-load.el
-
-custom-load.el: $(SOURCES)
- $(EMACS) -batch -q -no-site-file \
- -eval '(setq autoload-target-directory "'`pwd`'/")' \
- -l autoload \
- -f batch-update-autoloads $?
-
-### Makefile ends here
+++ /dev/null
-;;; eos.el --- Intereactively loads the XEmacs/SPARCworks interface
-;;; this file is an alias for sun-eos.el
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks load
-
-;;; Commentary:
-
-;; If manual loading is desired...
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(load "sun-eos-load.el")
-(eos::start)
-
-;;; sun-eos-eos.el ends here
+++ /dev/null
-(Sun
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority low
- category CATEGORY
- dump nil
- description "Support for Sparcworks."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (sccs eos-browser eos-common eos-debugger eos-debugger eos-editor eos-init eos-load eos-menubar eos-toolbar sunpro)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-;; sccs.el -- easy-to-use SCCS control from within Emacs
-;; @(#)sccs.el 3.5
-
-;; This file is part of GNU Emacs.
-
-;; GNU Emacs is distributed in the hope that it will be useful,
-;; but WITHOUT ANY WARRANTY. No author or distributor
-;; accepts responsibility to anyone for the consequences of using it
-;; or for whether it serves any particular purpose or works at all,
-;; unless he says so in writing. Refer to the GNU Emacs General Public
-;; License for full details.
-
-;; Everyone is granted permission to copy, modify and redistribute
-;; GNU Emacs, but only under the conditions described in the
-;; GNU Emacs General Public License. A copy of this license is
-;; supposed to have been given to you along with GNU Emacs so you
-;; can know your rights and responsibilities. It should be in a
-;; file named COPYING. Among other things, the copyright notice
-;; and this notice must be preserved on all copies.
-;;;
-;;; Synched up with: Not in FSF.
-;;; #### Chuck -- I say remove this piece of crap! Use VC instead.
-
-;;; Author: Eric S. Raymond (eric@snark.thyrsus.com).
-;;;
-;;; It is distantly derived from an rcs mode written by Ed Simpson
-;;; ({decvax, seismo}!mcnc!duke!dukecdu!evs) in years gone by
-;;; and revised at MIT's Project Athena.
-;;;
-;;; Modified: Made to work for Lucid Emacs by persons who don't know SCCS.
-;;; Modified: Ben Wing (Ben.Wing@eng.sun.com) -- fixed up and redid menus
-;;;
-
-;; User options
-
-(defvar sccs-bin-directory nil
- "*Directory that holds the SCCS executables.
-Initialized automatically the first time you execute an SCCS command,
-if not already set.")
-
-(defvar sccs-max-log-size 510
- "*Maximum allowable size of an SCCS log message.")
-(defvar sccs-diff-command '("diff" "-c")
- "*The command/flags list to be used in constructing SCCS diff commands.")
-(defvar sccs-headers-wanted '("\%\W\%")
- "*SCCS header keywords to be inserted when sccs-insert-header is executed.")
-(defvar sccs-insert-static t
- "*Insert a static character string when inserting SCCS headers in C mode.")
-(defvar sccs-mode-expert nil
- "*Treat user as expert; suppress yes-no prompts on some things.")
-
-;; Vars the user doesn't need to know about.
-
-(defvar sccs-log-entry-mode nil)
-(defvar sccs-current-major-version nil)
-
-;; Some helper functions
-
-(defun sccs-name (file &optional letter)
- "Return the sccs-file name corresponding to a given file."
- (format "%sSCCS/%s.%s"
- (concat (file-name-directory (expand-file-name file)))
- (or letter "s")
- (concat (file-name-nondirectory (expand-file-name file)))))
-
-(defun sccs-lock-info (file index)
- "Return the nth token in a file's SCCS-lock information."
- (let
- ((pfile (sccs-name file "p")))
- (and (file-exists-p pfile)
- (save-excursion
- (find-file pfile)
- (auto-save-mode nil)
- (goto-char (point-min))
- (replace-string " " "\n")
- (goto-char (point-min))
- (forward-line index)
- (prog1
- (buffer-substring (point) (progn (end-of-line) (point)))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
- )
- )
- )
- )
-
-(defun sccs-locking-user (file)
- "Return the name of the person currently holding a lock on FILE.
-Return nil if there is no such person."
- (sccs-lock-info file 2)
- )
-
-(defun sccs-locked-revision (file)
- "Return the revision number currently locked for FILE, nil if none such."
- (sccs-lock-info file 1)
- )
-
-(defmacro error-occurred (&rest body)
- (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-;; There has *got* to be a better way to do this...
-(defmacro chmod (perms file)
- (list 'call-process "chmod" nil nil nil perms file))
-
-(defun sccs-save-vars (sid)
- (save-excursion
- (find-file "SCCS/emacs-vars.el")
- (erase-buffer)
- (insert "(setq sccs-current-major-version \"" sid "\")")
- (basic-save-buffer)
- )
- )
-
-(defun sccs-load-vars ()
- (if (error-occurred (load-file "SCCS/emacs-vars.el"))
- (setq sccs-current-major-version "1"))
-)
-
-(defun sccs-init-bin-directory ()
- (setq sccs-bin-directory
- (cond ((file-executable-p "/usr/sccs/unget") "/usr/sccs")
- ((file-executable-p "/usr/bin/unget") "/usr/bin")
- ((file-directory-p "/usr/sccs") "/usr/sccs")
- ((file-directory-p "/usr/bin/sccs") "/usr/bin/sccs")
- (t "/usr/bin"))))
-
-;; The following functions do most of the real work
-
-(defun sccs-get-version (file sid)
- "For the given FILE, retrieve a copy of the version with given SID.
-The text is retrieved into a tempfile. Return the tempfile name, or nil
-if no such version exists."
- (let (oldversion vbuf)
- (setq oldversion (sccs-name file (or sid "new")))
- (setq vbuf (create-file-buffer oldversion))
- (prog1
- (if (not (error-occurred
- (sccs-do-command vbuf "get" file
- (and sid (concat "-r" sid))
- "-p" "-s")))
- (save-excursion
- (set-buffer vbuf)
- (write-region (point-min) (point-max) oldversion t 0)
- oldversion)
- )
- (kill-buffer vbuf)
- )
- )
- )
-
-(defun sccs-mode-line (file)
- "Set the mode line for an SCCS buffer.
-FILE is the file being visited to put in the modeline."
- (setq mode-line-process
- (if (file-exists-p (sccs-name file "p"))
- (format " <SCCS: %s>" (sccs-locked-revision file))
- ""))
-
- ; force update of frame
- (save-excursion (set-buffer (other-buffer)))
- (sit-for 0)
- )
-
-(defun sccs-do-command (buffer command file &rest flags)
- " Execute an SCCS command, notifying the user and checking for errors."
- (setq file (expand-file-name file))
- (message "Running %s on %s..." command file)
- (or sccs-bin-directory (sccs-init-bin-directory))
- (let ((status
- (save-window-excursion
- (set-buffer (get-buffer-create buffer))
- (erase-buffer)
- (while (and flags (not (car flags)))
- (setq flags (cdr flags)))
- (setq flags (append flags (and file (list (sccs-name file)))))
- (let ((default-directory (file-name-directory (or file "./")))
- (exec-path (cons sccs-bin-directory exec-path)))
- (apply 'call-process command nil t nil flags)
- )
- (goto-char (point-max))
- (previous-line 1)
- (if (looking-at "ERROR")
- (progn
- (previous-line 1)
- (print (cons command flags))
- (next-line 1)
- nil)
- t))))
- (if status
- (message "Running %s...OK" command)
- (pop-to-buffer buffer)
- (error "Running %s...FAILED" command)))
- (if file (sccs-mode-line file)))
-
-(defun sccs-shell-command (command)
- "Like shell-command except that the *Shell Command Output*buffer
-is created even if the command does not output anything"
- (shell-command command)
- (get-buffer-create "*Shell Command Output*"))
-
-(defun sccs-tree-walk (func &rest optargs)
- "Apply FUNC to each SCCS file under the default directory.
-If present, OPTARGS are also passed."
- (sccs-shell-command (concat "/bin/ls -1 " default-directory "SCCS/s.*"))
- (set-buffer "*Shell Command Output*")
- (goto-char (point-min))
- (replace-string "SCCS/s." "")
- (goto-char (point-min))
- (if (eobp)
- (error "No SCCS files under %s" default-directory))
- (while (not (eobp))
- (let ((file (buffer-substring (point) (progn (end-of-line) (point)))))
- (apply func file optargs)
- )
- (forward-line 1)
- )
- )
-
-(defun sccs-init ()
- (or (current-local-map) (use-local-map (make-sparse-keymap)))
- (condition-case nil
- ;; If C-c s is already defined by another mode, then we
- ;; will get an error. In that case, just don't do anything.
- (progn
- (define-key (current-local-map) "\C-cs?" 'describe-mode)
- (define-key (current-local-map) "\C-csn" 'sccs)
- (define-key (current-local-map) "\C-csm" 'sccs-register-file)
- (define-key (current-local-map) "\C-csh" 'sccs-insert-headers)
- (define-key (current-local-map) "\C-csd" 'sccs-revert-diff)
- (define-key (current-local-map) "\C-csp" 'sccs-prs)
- (define-key (current-local-map) "\C-csr" 'sccs-revert-buffer)
- (define-key (current-local-map) "\C-cs\C-d" 'sccs-version-diff)
- (define-key (current-local-map) "\C-cs\C-p" 'sccs-pending)
- (define-key (current-local-map) "\C-cs\C-r" 'sccs-registered)
- )
- (error nil)))
-
-;; Here's the major entry point
-
-(defun sccs (verbose)
- "*Do the next logical SCCS operation on the file in the current buffer.
-You must have an SCCS subdirectory in the same directory as the file being
-operated on.
- If the file is not already registered with SCCS, this does an admin -i
-followed by a get -e.
- If the file is registered and not locked by anyone, this does a get -e.
- If the file is registered and locked by the calling user, this pops up a
-buffer for creation of a log message, then does a delta -n on the file.
-A read-only copy of the changed file is left in place afterwards.
- If the file is registered and locked by someone else, an error message is
-returned indicating who has locked it."
- (interactive "P")
- (sccs-init)
- (if (buffer-file-name)
- (let
- (do-update revision owner
- (file (buffer-file-name))
- (sccs-file (sccs-name (buffer-file-name)))
- (sccs-log-buf (get-buffer-create "*SCCS-Log*"))
- (err-msg nil))
-
- ;; if there is no SCCS file corresponding, create one
- (if (not (file-exists-p sccs-file))
- (progn
- (sccs-load-vars)
- (sccs-admin
- file
- (cond
- (verbose (read-string "Initial SID: "))
- ((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
- (t sccs-current-major-version))
- )
- )
- )
-
- (cond
-
- ;; if there is no lock on the file, assert one and get it
- ((not (file-exists-p (sccs-name file "p")))
- (progn
- (sccs-get file t)
- (revert-buffer nil t)
- (sccs-mode-line file)
- ))
-
- ;; a checked-out version exists, but the user may not own the lock
- ((not (string-equal
- (setq owner (sccs-locking-user file)) (user-login-name)))
- (error "Sorry, %s has that file checked out" owner))
-
- ;; OK, user owns the lock on the file
- (t (progn
-
- ;; if so, give luser a chance to save before delta-ing.
- (if (and (buffer-modified-p)
- (or
- sccs-mode-expert
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name)))))
- (save-buffer))
-
- (setq revision (sccs-locked-revision file))
-
- ;; user may want to set nonstandard parameters
- (if verbose
- (if (or sccs-mode-expert (y-or-n-p
- (format "SID: %s Change revision level? " revision)))
- (setq revision (read-string "New revision level: "))))
-
- ;; OK, let's do the delta
- (if
- ;; this excursion returns t if the new version was saved OK
- (save-window-excursion
- (pop-to-buffer (get-buffer-create "*SCCS*"))
- (erase-buffer)
- (set-buffer-modified-p nil)
- (sccs-mode)
- (message
- "Enter log message. Type C-c C-c when done, C-c ? for help.")
- (prog1
- (and (not (error-occurred (recursive-edit)))
- (not (error-occurred (sccs-delta file revision))))
- (setq buffer-file-name nil)
- (bury-buffer "*SCCS*")))
-
- ;; if the save went OK do some post-checking
- (if (buffer-modified-p)
- (error
- "Delta-ed version of file does not match buffer!")
- (progn
- ;; sccs-delta already turned off write-privileges on the
- ;; file, let's not re-fetch it unless there's something
- ;; in it that get would expand
- ;;
- ;; fooey on this. You always need to refetch the
- ;; file; otherwise weirdness will ensue when you're
- ;; trying to do a make. --bpw
- ; (if (sccs-check-headers)
- (sccs-get file nil)
- (revert-buffer nil t)
- (sccs-mode-line file)
- (run-hooks 'sccs-delta-ok)
- )
- ))))))
- (error "There is no file associated with buffer %s" (buffer-name))))
-
-(defun sccs-insert-last-log ()
- "*Insert the log message of the last SCCS check in at point."
- (interactive)
- (insert-buffer sccs-log-buf))
-
-;;; These functions help the sccs entry point
-
-(defun sccs-get (file writeable)
- "Retrieve a copy of the latest delta of the given file."
- (sccs-do-command "*SCCS*" "get" file (if writeable "-e")))
-
-(defun sccs-admin (file sid)
- "Checks a file into sccs.
-FILE is the unmodified name of the file. SID should be the base-level sid to
-check it in under."
- ; give a change to save the file if it's modified
- (if (and (buffer-modified-p)
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name))))
- (save-buffer))
- (sccs-do-command "*SCCS*" "admin" file
- (concat "-i" file) (concat "-r" sid))
- (chmod "-w" file)
- (if (sccs-check-headers)
- (sccs-get file nil)) ;; expand SCCS headers
- (revert-buffer nil t)
- (sccs-mode-line file)
-)
-
-(defun sccs-delta (file &optional rev comment)
- "Delta the file specified by FILE.
-The optional argument REV may be a string specifying the new revision level
-\(if nil increment the current level). The file is retained with write
-permissions zeroed. COMMENT is a comment string; if omitted, the contents of
-the current buffer up to point becomes the comment for this delta."
- (if (not comment)
- (progn
- (goto-char (point-max))
- (if (not (bolp)) (newline))
- (newline)
- (setq comment (buffer-substring (point-min) (1- (point)))))
- )
- (sccs-do-command "*SCCS*" "delta" file "-n"
- (if rev (format "-r%s" rev))
- (format "-y%s" comment))
- (chmod "-w" file))
-
-(defun sccs-delta-abort ()
- "Abort an SCCS delta command."
- (interactive)
- (if (or sccs-mode-expert (y-or-n-p "Abort the delta? "))
- (progn
- (delete-window)
- (error "Delta aborted")))
- )
-
-(defun sccs-log-exit ()
- "Leave the recursive edit of an SCCS log message."
- (interactive)
- (if (< (buffer-size) sccs-max-log-size)
- (progn
- (copy-to-buffer sccs-log-buf (point-min) (point-max))
- (exit-recursive-edit)
- (delete-window))
- (progn
- (goto-char sccs-max-log-size)
- (error
- "Log must be less than %d characters. Point is now at char %d."
- sccs-max-log-size sccs-max-log-size)))
-)
-
-;; Additional entry points for examining version histories
-
-(defun sccs-revert-diff (&rest flags)
- "*Compare the version being edited with the last checked-in revision.
-Or, if given a prefix argument, with another specified revision."
- (interactive)
- (let (old file)
- (if
- (setq old (sccs-get-version (buffer-file-name)
- (and
- current-prefix-arg
- (read-string "Revision to compare against: "))
- ))
- (progn
- (if (and (buffer-modified-p)
- (or
- sccs-mode-expert
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name)))))
- (save-buffer))
-
- (setq file (buffer-file-name))
- (set-buffer (get-buffer-create "*SCCS*"))
- (erase-buffer)
- (apply 'call-process (car sccs-diff-command) nil t nil
- (append (cdr sccs-diff-command) flags (list old) (list file)))
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (delete-file old)
- (if (equal (point-min) (point-max))
- (message "No changes to %s since last get." file)
- (pop-to-buffer "*SCCS*")
- )
- )
- )
- )
- )
-
-(defun sccs-prs ()
- "*List the SCCS log of the current buffer in an emacs window."
- (interactive)
- (if (and buffer-file-name (file-exists-p (sccs-name buffer-file-name "s")))
- (progn
- (sccs-do-command "*SCCS*" "prs" buffer-file-name)
- (pop-to-buffer (get-buffer-create "*SCCS*"))
- )
- (error "There is no SCCS file associated with this buffer")
- )
- )
-
-(defun sccs-version-diff (file rel1 rel2)
- "*For FILE, report diffs between two stored deltas REL1 and REL2 of it."
- (interactive "fFile: \nsOlder version: \nsNewer version: ")
- (if (string-equal rel1 "") (setq rel1 nil))
- (if (string-equal rel2 "") (setq rel2 nil))
- (set-buffer (get-buffer-create "*SCCS*"))
- (erase-buffer)
- (sccs-vdiff file rel1 rel2)
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (if (equal (point-min) (point-max))
- (message "No changes to %s between %s and %s." file rel1 rel2)
- (pop-to-buffer "*SCCS*")
- )
- )
-
-(defun sccs-vdiff (file rel1 rel2 &optional flags)
- "Compare two deltas into the current buffer."
- (let (vers1 vers2)
- (and
- (setq vers1 (sccs-get-version file rel1))
- (setq vers2 (if rel2 (sccs-get-version file rel2) file))
-; (prog1
-; (save-excursion
-; (not (error-occurred
-; (call-process "prs" nil t t
-; (sccs-name file))))
-; )
-; )
- (unwind-protect
- (apply 'call-process (car sccs-diff-command) nil t t
- (append (cdr sccs-diff-command) flags (list vers1) (list vers2)))
- (condition-case () (delete-file vers1) (error nil))
- (if rel2
- (condition-case () (delete-file vers2) (error nil)))
- )
- )
- )
- )
-
-;; SCCS header insertion code
-
-(defun sccs-insert-headers ()
- "*Insert headers for use with the Source Code Control System.
-Headers desired are inserted at the start of the buffer, and are pulled from
-the variable sccs-headers-wanted"
- (interactive)
- (save-excursion
- (save-restriction
- (widen)
- (if (or (not (sccs-check-headers))
- (y-or-n-p "SCCS headers already exist. Insert another set?"))
- (progn
- (goto-char (point-min))
- (run-hooks 'sccs-insert-headers-hook)
- (cond ((eq major-mode 'c-mode) (sccs-insert-c-header))
- ((eq major-mode 'lisp-mode) (sccs-insert-lisp-header))
- ((eq major-mode 'emacs-lisp-mode) (sccs-insert-lisp-header))
- ((eq major-mode 'scheme-mode) (sccs-insert-lisp-header))
- ((eq major-mode 'nroff-mode) (sccs-insert-nroff-header))
- ((eq major-mode 'plain-tex-mode) (sccs-insert-tex-header))
- ((eq major-mode 'texinfo-mode) (sccs-insert-texinfo-header))
- (t (sccs-insert-generic-header))))))))
-
-(defun sccs-insert-c-header ()
- (let (st en)
- (insert "/*\n")
- (mapcar '(lambda (s)
- (insert " *\t" s "\n"))
- sccs-headers-wanted)
- (insert " */\n\n")
- (if (and sccs-insert-static
- (not (string-match "\\.h$" (buffer-file-name))))
- (progn
- (insert "#ifndef lint\n"
- "static char *sccsid")
-;; (setq st (point))
-;; (insert (file-name-nondirectory (buffer-file-name)))
-;; (setq en (point))
-;; (subst-char-in-region st en ?. ?_)
- (insert " = \"\%\W\%\";\n"
- "#endif /* lint */\n\n")))
- (run-hooks 'sccs-insert-c-header-hook)))
-
-(defun sccs-insert-lisp-header ()
- (mapcar '(lambda (s)
- (insert ";;;\t" s "\n"))
- sccs-headers-wanted)
- (insert "\n")
- (run-hooks 'sccs-insert-lisp-header-hook))
-
-(defun sccs-insert-nroff-header ()
- (mapcar '(lambda (s)
- (insert ".\\\"\t" s "\n"))
- sccs-headers-wanted)
- (insert "\n")
- (run-hooks 'sccs-insert-nroff-header-hook))
-
-(defun sccs-insert-tex-header ()
- (mapcar '(lambda (s)
- (insert "%%\t" s "\n"))
- sccs-headers-wanted)
- (insert "\n")
- (run-hooks 'sccs-insert-tex-header-hook))
-
-(defun sccs-insert-texinfo-header ()
- (mapcar '(lambda (s)
- (insert "@comment\t" s "\n"))
- sccs-headers-wanted)
- (insert "\n")
- (run-hooks 'sccs-insert-texinfo-header-hook))
-
-(defun sccs-insert-generic-header ()
- (let* ((comment-start-sccs (or comment-start "#"))
- (comment-end-sccs (or comment-end ""))
- (dont-insert-nl-p (string-match "\n" comment-end-sccs)))
- (mapcar '(lambda (s)
- (insert comment-start-sccs "\t" s ""
- comment-end-sccs (if dont-insert-nl-p "" "\n")))
- sccs-headers-wanted)
- (insert comment-start-sccs comment-end-sccs (if dont-insert-nl-p "" "\n"))))
-
-(defun sccs-check-headers ()
- "Check if the current file has any SCCS headers in it."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" (point-max) t)))
-
-;; Status-checking functions
-
-(defun sccs-status (prefix legend)
- "List all files underneath the current directory matching a prefix type."
- (sccs-shell-command
- (concat "/bin/ls -1 SCCS/" prefix ".*"))
- (if
- (save-excursion
- (set-buffer "*Shell Command Output*")
- (if (= (point-max) (point-min))
- (not (message
- "No files are currently %s under %s"
- legend default-directory))
- (progn
- (goto-char (point-min))
- (insert
- "The following files are currently " legend
- " under " default-directory ":\n")
- (replace-string (format "SCCS/%s." prefix) "")
- )
- )
- )
- (pop-to-buffer "*Shell Command Output*")
- )
- )
-
-(defun sccs-pending ()
- "*List all files currently SCCS locked."
- (interactive)
- (sccs-status "p" "locked"))
-
-(defun sccs-registered ()
- "*List all files currently SCCS registered."
- (interactive)
- (sccs-status "s" "registered"))
-
-(defun sccs-register-file (override)
- "*Register the file visited by the current buffer into SCCS."
- (interactive "P")
- (if (file-exists-p (sccs-name (buffer-file-name)))
- (error "This file is already registered into SCCS.")
- (progn
- (if (and (buffer-modified-p)
- (or
- sccs-mode-expert
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name)))))
- (save-buffer))
- (sccs-load-vars)
- (sccs-admin
- (buffer-file-name)
- (cond
- (override (read-string "Initial SID: "))
- ((error-occurred (load-file "SCCS/emacs-vars.el")) "1")
- (t sccs-current-major-version))
- )
- )
- )
- )
-
-;; Major functions for release-tracking and generation.
-
-(defun sccs-release-diff (rel1 rel2)
- "*Diff all files below default-directory between versions REL1 and REL2.
-The report goes to a shell output buffer which is popped to. If REL2 is
-omitted or nil, the comparison is done against the most recent version."
- (interactive "sOlder version: \nsNewer version: ")
- (if (string-equal rel1 "") (setq rel1 nil))
- (if (string-equal rel2 "") (setq rel2 nil))
- (sccs-shell-command (concat
- "/bin/ls -1 " default-directory "SCCS/s.*"
- ))
- (set-buffer "*Shell Command Output*")
- (goto-char (point-min))
- (replace-string "SCCS/s." "")
- (goto-char (point-min))
- (if (eobp)
- (error "No SCCS files under %s" default-directory))
- (let
- ((sccsbuf (get-buffer-create "*SCCS*")))
- (save-excursion
- (set-buffer sccsbuf)
- (erase-buffer)
- (insert (format "Diffs from %s to %s.\n\n"
- (or rel1 "current") (or rel2 "current"))))
- (while (not (eobp))
- (let ((file (buffer-substring (point) (progn (end-of-line) (point)))))
- (save-excursion
- (set-buffer sccsbuf)
- (set-buffer-modified-p nil)
-
- (sccs-vdiff file rel1 rel2)
- (if (buffer-modified-p)
- (insert "\n"))
- )
- (forward-line 1)
- )
- )
- (kill-buffer "*Shell Command Output*")
- (pop-to-buffer sccsbuf)
- (insert "\nEnd of diffs.\n")
- (goto-char (point-min))
- (replace-string (format "/SCCS/%s." rel1) "/")
- (goto-char (point-min))
- (replace-string (format "/SCCS/%s." rel2) "/new/")
- (goto-char (point-min))
- (replace-string "/SCCS/new." "/new/")
- (goto-char (point-min))
- (replace-regexp (concat "^*** " default-directory) "*** ")
- (goto-char (point-min))
- (replace-regexp (concat "^--- " default-directory) "--- ")
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- )
- )
-
-(defun sccs-dummy-delta (file sid)
- "Make a dummy delta to the given FILE with the given SID."
- (interactive "sFile: \nsRelease ID: ")
- (if (not (sccs-locked-revision file))
- (sccs-get file t))
- ;; Grottiness alert -- to get around SCCS's obsessive second-guessing we
- ;; have to mung the p-file
- (save-excursion
- (let ((pfile (sccs-name file "p")))
- (chmod "u+w" pfile)
- (find-file pfile)
- (auto-save-mode nil)
- (replace-regexp "^\\([0-9.]+\\) \\([0-9.]+\\)" (concat "\\1 " sid) t)
- (write-region (point-min) (point-max) pfile t 0)
- (chmod "u-w" pfile)
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer))
- )
- )
- (sccs-delta file sid (concat "Release " sid))
- (sccs-get file nil)
- (sccs-save-vars sid)
- )
-
-(defun sccs-delta-release (sid)
- "*Delta everything underneath the current directory to mark it as a release."
- (interactive "sRelease: ")
- (sccs-tree-walk 'sccs-dummy-delta sid)
- (kill-buffer "*SCCS*")
- )
-
-;; Miscellaneous other entry points
-
-(defun sccs-revert-buffer ()
- "*Revert the current buffer's file back to the last saved version."
- (interactive)
- (let ((file (buffer-file-name)))
- (if (y-or-n-p (format "Revert file %s to last SCCS revision?" file))
- (progn
- (delete-file file)
- (delete-file (sccs-name file "p"))
- (rename-file (sccs-get-version file nil) file)
- (chmod "-w" file)
- (revert-buffer nil t)
- (sccs-mode-line file)))))
-
-(defun sccs-rename-file (old new)
- "*Rename a file, taking its SCCS files with it."
- (interactive "fOld name: \nFNew name: ")
- (let ((owner (sccs-locking-user old)))
- (if (and owner (not (string-equal owner (user-login-name))))
- (error "Sorry, %s has that file checked out" owner))
- )
- (rename-file old new)
- (if (file-exists-p (sccs-name old "p"))
- (rename-file (sccs-name old "p") (sccs-name new "p")))
- (if (file-exists-p (sccs-name old "s"))
- (rename-file (sccs-name old "s") (sccs-name new "s")))
- )
-
-;; Set up key bindings for SCCS use, e.g. while editing log messages
-
-(defun sccs-mode ()
- "Minor mode for driving the SCCS tools.
-
-These bindings are added to the global keymap when you enter this mode:
-\\[sccs] perform next logical SCCS operation (`sccs') on current file
-\\[sccs-register-file] register current file into SCCS
-\\[sccs-insert-headers] insert SCCS headers in current file
-\\[sccs-prs] display change history of current file
-\\[sccs-revert-buffer] revert buffer to last saved version
-\\[sccs-revert-diff] show difference between buffer and last saved delta
-\\[sccs-pending] show all files currently locked by any user in or below .
-\\[sccs-registered] show all files registered into SCCS in or below .
-\\[sccs-version-diff] show diffs between saved versions for all files in or below .
-
-When you generate headers into a buffer using C-c h, the value of
-sccs-insert-headers-hook is called before insertion. If the file is
-recognized a C or Lisp source, sccs-insert-c-header-hook or
-sccs-insert-lisp-header-hook is called after insertion respectively.
-
-While you are entering a change log message for a delta, the following
-additional bindings will be in effect.
-
-\\[sccs-log-exit] proceed with check in, ending log message entry
-\\[sccs-insert-last-log] insert log message from last check-in
-\\[sccs-delta-abort] abort this delta check-in
-
-Entry to the change-log submode calls the value of text-mode-hook, then
-the value sccs-mode-hook.
-
-Global user options:
- sccs-mode-expert suppresses some conformation prompts,
- notably for delta aborts and file saves.
- sccs-max-log-size specifies the maximum allowable size
- of a log message plus one.
- sccs-diff-command A list consisting of the command and flags
- to be used for generating context diffs.
- sccs-headers-wanted which %-keywords to insert when adding
- SCCS headers with C-c h
- sccs-insert-static if non-nil, SCCS keywords inserted in C files
- get stuffed in a static string area so that
- what(1) can see them in the compiled object
- code.
-"
- (interactive)
- (set-syntax-table text-mode-syntax-table)
- (use-local-map sccs-log-entry-mode)
- (setq local-abbrev-table text-mode-abbrev-table)
- (setq major-mode 'sccs-mode)
- (setq mode-name "SCCS Change Log Entry")
- (run-hooks 'text-mode-hook 'sccs-mode-hook)
-)
-
-;; Initialization code, to be done just once at load-time
-(if sccs-log-entry-mode
- nil
- (setq sccs-log-entry-mode (make-sparse-keymap))
- (define-key sccs-log-entry-mode "\C-ci" 'sccs-insert-last-log)
- (define-key sccs-log-entry-mode "\C-c\C-i" 'sccs-insert-last-log)
- (define-key sccs-log-entry-mode "\C-ca" 'sccs-delta-abort)
- (define-key sccs-log-entry-mode "\C-c\C-a" 'sccs-delta-abort)
- (define-key sccs-log-entry-mode "\C-c\C-c" 'sccs-log-exit)
- (define-key sccs-log-entry-mode "\C-x\C-s" 'sccs-log-exit)
- )
-
-\f
-;;; Lucid Emacs support
-
-(defconst sccs-menu
- '("SCCS Commands"
-
- ["SCCS" sccs t nil] ; C-c s n
- ["Insert Headers" sccs-insert-headers t] ; C-c s h
- ["Archive History:" sccs-prs t nil] ; C-c s p
- ["Diffs from Archive:" sccs-revert-diff t nil] ; C-c s d
- ["Revert to Archive:" sccs-revert-buffer t nil] ; C-c s r
- "----"
- ["Check In..." sccs-dummy-delta t]
- ["Create Archive..." sccs-register-file t] ; C-c s h
- ["Rename Archive..." sccs-rename-file t]
- "----"
- ["List Checked-Out Files" sccs-pending t] ; C-c s C-p
- ["List Registered Files" sccs-registered t] ; C-c s C-r
- ["Diff Directory" sccs-release-diff t]
- ["Delta Directory" sccs-delta-release t]
- ))
-
-(progn
- (delete-menu-item '("SCCS"))
- (add-menu '() "SCCS" (cdr sccs-menu)))
-
-(defun sccs-sensitize-menu ()
- (let* ((rest (cdr (car (find-menu-item current-menubar '("SCCS")))))
- (case-fold-search t)
- (file (if buffer-file-name
- (file-name-nondirectory buffer-file-name)
- (buffer-name)))
- (dir (file-name-directory
- (if buffer-file-name buffer-file-name default-directory)))
- (sccs-file (and buffer-file-name (sccs-name buffer-file-name)))
- (known-p (and sccs-file (file-exists-p sccs-file)))
- (checked-out-p (and known-p
- (file-exists-p (sccs-name buffer-file-name "p"))))
- command
- item)
- (while rest
- (setq item (car rest))
- (if (not (vectorp item))
- nil
- (setq command (aref item 1))
- (if (eq 'sccs command)
- (aset item 0
- (cond ((or (null sccs-file) (not known-p))
- "Create Archive:")
- ((not checked-out-p)
- "Check Out")
- (t
- "Check In"))))
- (cond
- ((and (> (length item) 3)
- (string-match "directory" (aref item 0)))
- (aset item 3 dir))
- ((> (length item) 3)
- (aset item 3 file))
- (t nil))
- (aset item 2
- (cond
- ((memq command '(sccs-prs))
- known-p)
- ((memq command '(sccs-revert-diff sccs-revert-buffer))
- checked-out-p)
- (t))))
- (setq rest (cdr rest))))
- nil)
-
-(add-hook 'activate-menubar-hook 'sccs-sensitize-menu)
-
-(provide 'sccs)
-
-;; sccs.el ends here
+++ /dev/null
-;;; sun-eos-browser.el --- Implements the XEmacs/SPARCworks SourceBrowser interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks SBrowser Source Browser
-
-;;; Commentary:
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(require 'eos-common "sun-eos-common")
-
-;; ================
-;; Browser Protocol
-;; ================
-;;
-;; three notifications
-;;
-;; SPRO_SBENG_START
-;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
-;; SPRO_SBENG_QUIT
-
-(defvar eos::currentMatch-inst "/* XPM */
-static char * file[] = {
-\"14 11 5 1\",
-\" s background c #FFFFFFFFFFFF\",
-\". c #000000000000\",
-\"X c #0000FFFF0000\",
-\"o c #000077770000\",
-\"O c #000044440000\",
-\" \",
-\" oo \",
-\" oXOo \",
-\" oXXXOo \",
-\" oXXXXXOo \",
-\" oXXXXXXXo. \",
-\" oXXXXXOo \",
-\" oXXXOo \",
-\" oXOo \",
-\" oo \",
-\" \"};")
-
-(defvar eos::currentMatch-inst-alt "/* XPM */
-static char * file[] = {
-\"14 11 5 1\",
-\" s background c #FFFFFFFFFFFF\",
-\". c #000000000000\",
-\"X c #0000FFFF0000\",
-\"o c #000077770000\",
-\"O c #000044440000\",
-\" \",
-\" oo \",
-\" oXOo \",
-\" oXXXOo \",
-\" oXXXXXOo \",
-\" oXXXXXXXo. \",
-\" oXXXXXOo \",
-\" oXXXOo \",
-\" oXOo \",
-\" oo .. \",
-\" .. \"};")
-
-(defvar sbrowser-pattern-list nil)
-
-
-(defun eos::browser-startup ()
- ;; Actions to do at startup for eos-browser.el
- (make-face 'sbrowse-arrow-face)
-
- (set-face-foreground 'sbrowse-arrow-face
- eos::sbrowse-arrow-color)
- (set-face-background 'sbrowse-arrow-face
- (face-background (get-face 'default)))
-
- (setq sbrowser-pattern-list ; list of browser TT patterns
- (eos::create-sbrowser-patterns))
-
- ;; now register glyphs and faces...
-
- (eos::annotation-set-inst 'sbrowser 'x eos::currentMatch-inst [nothing])
- (eos::annotation-set-inst 'sbrowser 'tty "|>" [nothing])
- (eos::annotation-set-face 'sbrowser 'x
- (get-face 'sbrowse-arrow-face)
- (get-face 'sbrowse-arrow-face))
- (eos::annotation-set-face 'sbrowser 'tty
- (get-face 'highlight)
- (get-face 'highlight))
-)
-
-(defvar eos::current-match nil)
-
-(defun eos::spro_sbeng_current_element (msg pat)
- ;; SPRO_SBENG_CURRENT_ELEMENT CONTEXT_UID filename lineno center==0
- (let* ((filename
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (lineno
- (read (get-tooltalk-message-attribute msg 'arg_ival 2)))
- )
- (setq eos::current-match
- (eos::make-annotation-visible eos::current-match
- filename
- lineno
- 'sbrowser))
- (return-tooltalk-message msg)
- ))
-
-(defun eos::spro_sbeng_start (msg pat)
- (eos::make-annotation-invisible eos::current-match)
- (return-tooltalk-message msg)
- )
-
-(defun eos::spro_sbeng_quit (msg pat)
- (eos::make-annotation-invisible eos::current-match)
- (return-tooltalk-message msg)
- )
-
-(defun eos::create-sbrowser-patterns ()
- ;; returns list of patterns
- (list
- (make-an-observer "SPRO_SBENG_CURRENT_ELEMENT"
- 'eos::spro_sbeng_current_element)
- (make-an-observer "SPRO_SBENG_START"
- 'eos::spro_sbeng_start)
- (make-an-observer "SPRO_SBENG_QUIT"
- 'eos::spro_sbeng_quit)
- ))
-
-(defun eos::register-sbrowser-patterns ()
- ;; register all sbrowser patterns
- (mapcar 'register-tooltalk-pattern sbrowser-pattern-list))
-
-(defun eos::unregister-sbrowser-patterns ()
- ;; unregister all sbrowser patterns
- (mapcar 'unregister-tooltalk-pattern sbrowser-pattern-list))
-
-;; Actions to start a sourcebrowser in the background.
-
-(defvar eos::sbrowser-process nil
- "sbrowser process for the background. Only one per XEmacs")
-
-(defun eos::start-sbrowser ()
- ;; Start an "sbrowser -editor" in the background. Will ask for confirmation if
- ;; XEmacs somehow believes there is already one running
- (interactive)
- (if (or (not (processp eos::sbrowser-process))
- (not (eq (process-status eos::sbrowser-process) 'run))
- (yes-or-no-p
- "Warning! XEmacs believes there already is a sbrowser -editor, proceed?"))
- (progn
- (setq eos::sbrowser-process
- (start-process "*eos sbrowser*" nil "sbrowser" "-editor"))
- (message "Starting SBrowser subprocess")
- (eos::select-sbrowser-frame (selected-frame))
- )))
-
-(provide 'eos-browser)
-
-;;; sun-eos-browser.el ends here
+++ /dev/null
-;; Copyright (C) 1995, Sun Microsystems
-;;
-;; Light Weight Editor Integration for Sparcworks.
-;; "Era on Sparcworks" (EOS)
-;;
-;; Author: Eduardo Pelegri-Llopart
-;;
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;; Common routines for EOS
-
-(defvar eos::version "1.5.2"
- "Version of Eos")
-
-(defvar eos::left-margin-width 5
- "size of left margin")
-
-(defvar eos::stop-color "red"
- "foreground color for stop signs")
-(defvar eos::solid-arrow-color "purple"
- "foreground color for solid arrow")
-(defvar eos::hollow-arrow-color "purple"
- "foreground color for hollow arrow")
-(defvar eos::sbrowse-arrow-color "blue"
- "foreground color for browser glyphs")
-
-(defun eos::recompute-presentation ()
- (set-face-foreground 'stop-face eos::stop-color)
- (set-face-foreground 'solid-arrow-face eos::solid-arrow-color)
- (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color)
- (set-face-foreground 'sbrowse-arrow-face eos::sbrowse-arrow-color)
- )
-
-;;
-
-(defvar eos::displayed-initial-message nil
- "Whether we have shown the initial display message")
-
-(defconst eos::startup-message-lines
- '("Please send feedback to eos-comments@cs.uiuc.edu."
- "The latest Eos news are under SPARCworks->News"
- "See Options->SPARCworks for configuration and Help->SPARCworks for help"
- ))
-
-;; copied from vm
-
-(defun eos::display-initial-message ()
- ;; Display initial Eos message - REMOVED
- )
-
-(defun eos-old::display-initial-message ()
- ;; Display initial Eos message
- (if (not eos::displayed-initial-message)
- (let ((lines eos::startup-message-lines))
- (message "Eos %s, Copyright (C) 1995 Sun MicroSystems"
- eos::version)
- (setq eos::displayed-initial-message t)
- (while (and (sit-for 3) lines)
- (message (car lines))
- (setq lines (cdr lines))))
- (message "")))
-
-;; misc
-
-(defun eos::line-at (pos)
- ;; At what line is POS
- (save-restriction
- (widen)
- (save-excursion
- (goto-char pos)
- (beginning-of-line)
- (1+ (count-lines 1 (point))))))
-
-;; frame-specific enabling
-;;
-;; will maintain at most one frame to debugger, one to sbrowser
-;; annotations have a type, either
-;;
-;; sbrowser
-;; debugger-solid-arrow
-;; debugger-holow-arrow
-;; debugger-stop
-;; debugger-visit
-;;
-;; adding an annotation of type sbrowser will be only on frame sbrowser
-;; adding an annotation of type debugger will be only on frame debugger
-;;
-;; turn off patterns when there is no frame.
-
-
-;;;
-;;; Common ToolTalk function
-;;;
-
-(defun make-an-observer (op callback)
- (let ((pattern-desc
- (list
- 'category 'TT_OBSERVE
- 'scope 'TT_SESSION
- 'class 'TT_NOTICE
- 'op op
- 'callback callback)))
- (make-tooltalk-pattern pattern-desc)
- ))
-
-;;;
-;;; Frame management
-;;;
-
-(defun eos::log (msg)
- (if (fboundp 'ut-log-text)
- (ut-log-text "eos version: %s; %s" eos::version msg)))
-
-(defvar eos::sbrowser-frame nil)
-(defvar eos::debugger-frame nil)
-
-(defun eos::update-specifiers (type old-frame new-frame)
- ;; Change the database for annotations of TYPE, so that OLD-FRAME is
- ;; now using the alternate specifier, while NEW-FRAME uses the main one
- (let* ((device-type (device-type (selected-device)))
- (g (eos::annotation-get-glyph type device-type))
- (im (and (glyphp g) (glyph-image g)))
- (new-instantiator (eos::annotation-get-inst type device-type))
- (alt-instantiator (eos::annotation-get-inst-alt type device-type))
- )
- (if (eq device-type 'x)
- (progn
- (if (frame-live-p old-frame)
- (progn
- (remove-specifier im old-frame)
- (add-spec-to-specifier im alt-instantiator old-frame)))
- (if new-frame
- (progn
- (add-spec-to-specifier im new-instantiator new-frame)
- ))))))
-
-
-(defun eos::select-sbrowser-frame (frame)
- (require 'eos-toolbar "sun-eos-toolbar")
- (let ((toolbar (eos::toolbar-position)))
- (eos::display-initial-message)
- ;; logging
- (if frame
- (eos::log "selected frame for sbrowser")
- (eos::log "unselected frame for sbrowser"))
- ;; TT patterns
- (cond
- ((and (null eos::sbrowser-frame) frame)
- (eos::register-sbrowser-patterns))
- ((and (null frame) eos::sbrowser-frame)
- (eos::unregister-sbrowser-patterns)))
- ;; adjust toolbars
- (if (frame-live-p eos::sbrowser-frame)
- (remove-specifier toolbar eos::sbrowser-frame))
- (if (frame-live-p eos::debugger-frame)
- (remove-specifier toolbar eos::debugger-frame))
- ;; then add
- (cond
- ((and (frame-live-p eos::debugger-frame) (frame-live-p frame)
- (equal eos::debugger-frame frame))
- (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame))
- ((and (frame-live-p eos::debugger-frame) (frame-live-p frame))
- (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame)
- (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame))
- ((frame-live-p frame)
- (add-spec-to-specifier toolbar eos::sbrowser-toolbar frame))
- ((frame-live-p eos::debugger-frame)
- (add-spec-to-specifier toolbar eos::debugger-toolbar eos::debugger-frame))
- )
- ;; adjust specifiers for glyphs
- (eos::update-specifiers 'sbrowser eos::sbrowser-frame frame)
- (if (frame-live-p eos::sbrowser-frame)
- (progn
- (remove-specifier use-left-overflow eos::sbrowser-frame)
- (remove-specifier left-margin-width eos::sbrowser-frame)))
- (if (frame-live-p frame)
- (progn
- (add-spec-to-specifier use-left-overflow t frame)
- (add-spec-to-specifier left-margin-width eos::left-margin-width frame)
- (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
- (if (frame-live-p eos::debugger-frame)
- (progn
- (add-spec-to-specifier use-left-overflow t eos::debugger-frame)
- (add-spec-to-specifier left-margin-width eos::left-margin-width eos::debugger-frame)
- (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
- ;;
- (setq eos::sbrowser-frame frame)
- (set-menubar-dirty-flag)
- ))
-
-(defun eos::select-debugger-frame (frame)
- (require 'eos-toolbar "sun-eos-toolbar")
- (let ((toolbar (eos::toolbar-position)))
- (eos::display-initial-message)
- (save-excursion
- (eos::ensure-debugger-buffer)
- (bury-buffer))
- ;; logging
- (if frame
- (eos::log "selected frame for debugger")
- (eos::log "unselected frame for debugger"))
- ;; TT patterns
- (cond
- ((and (null eos::debugger-frame) frame)
- (eos::register-debugger-patterns)
- (eos::register-visit-file-pattern))
- ((and (null frame) eos::debugger-frame)
- (eos::unregister-debugger-patterns)
- (eos::unregister-visit-file-pattern)))
- ;; adjust toolbars, remove
- (if (frame-live-p eos::sbrowser-frame)
- (remove-specifier toolbar eos::sbrowser-frame))
- (if (frame-live-p eos::debugger-frame)
- (remove-specifier toolbar eos::debugger-frame))
- ;; then add
- (cond
- ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame)
- (equal eos::sbrowser-frame frame))
- (add-spec-to-specifier toolbar eos::debugger-sbrowser-toolbar frame))
- ((and (frame-live-p eos::sbrowser-frame) (frame-live-p frame))
- (add-spec-to-specifier toolbar eos::debugger-toolbar frame)
- (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame))
- ((frame-live-p frame)
- (add-spec-to-specifier toolbar eos::debugger-toolbar frame))
- ((frame-live-p eos::sbrowser-frame)
- (add-spec-to-specifier toolbar eos::sbrowser-toolbar eos::sbrowser-frame))
- )
- ;; update glyph specifiers
- (eos::update-specifiers 'debugger-solid-arrow eos::debugger-frame frame)
- (eos::update-specifiers 'debugger-hollow-arrow eos::debugger-frame frame)
- (eos::update-specifiers 'debugger-stop eos::debugger-frame frame)
- (if (frame-live-p eos::debugger-frame)
- (progn
- (remove-specifier use-left-overflow eos::debugger-frame)
- (remove-specifier left-margin-width eos::debugger-frame)))
- (if (frame-live-p frame)
- (progn
- (add-spec-to-specifier use-left-overflow t frame)
- (add-spec-to-specifier left-margin-width eos::left-margin-width frame)
- (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
- (if (frame-live-p eos::sbrowser-frame)
- (progn
- (add-spec-to-specifier use-left-overflow t eos::sbrowser-frame)
- (add-spec-to-specifier left-margin-width eos::left-margin-width eos::sbrowser-frame)
- (add-spec-to-specifier left-margin-width 0 (minibuffer-window))))
- ;;
- (setq eos::debugger-frame frame)
- (set-menubar-dirty-flag)
- ))
-
-;; HERE use file-truename
-
-(defun eos::select-frame (type)
- ;; Select a frame; return nil if should skip
- (cond ((eq type 'sbrowser)
- (if (frame-live-p eos::sbrowser-frame)
- eos::sbrowser-frame
- (message "selecting destroyed frame; will ignore")
- (eos::select-sbrowser-frame nil)
- nil))
- ((or (eq type 'debugger-solid-arrow)
- (eq type 'debugger-hollow-arrow)
- (eq type 'debugger-stop)
- (eq type 'debugger-visit))
- (if (frame-live-p eos::debugger-frame)
- eos::debugger-frame
- (message "selecting destroyed frame; will ignore")
- (eos::select-debugger-frame nil)
- nil))
- (t (selected-frame))))
-
-(defun eos::select-window (win)
- ;; Will select a window if it is not showing neither of eos::debugger-buffer or
- ;; eos::toolbar-buffer"
- (let ((name (buffer-name (window-buffer win))))
- (if (and (>= (length name) 4)
- (equal (substring name 0 4) "*Eos"))
- nil
- (select-window win)
- (throw 'found t)
- )))
-
-(defun eos::find-line (file line type)
- ;; Show FILE at LINE; returns frame or nil if inappropriate
- ;; if type is nil
- (if (eos::null-file file)
- (selected-frame)
- (let ((sc (eos::select-frame type))
- (win (selected-window)))
- (if (null sc)
- nil
- (select-frame sc)
- (if (catch 'found
- (eos::select-window (selected-window))
- (walk-windows 'eos::select-window)
- nil)
- nil ; do nothing, already there
- (select-window win)
- (split-window-vertically)
- (other-window 1)
- )
- (switch-to-buffer (find-file-noselect file t)) ;; no warn!
- (if (eq (device-type) 'x) (x-disown-selection))
- (goto-line line)
- sc
- ))))
-
-(defun eos::null-file (file)
- ;; returns t if FILE is nil or the empty string
- (or (null file) (equal file "")))
-
-;;;
-;;; Annotation handling
-;;;
-
-(defun eos::valid-annotation (annotation)
- ;; returns t if ANNOTATION is an annotation and its buffer exists
- (and (annotationp annotation)
- (bufferp (extent-buffer annotation))
- (buffer-name (extent-buffer annotation)))
- )
-
-(defvar eos::annotation-list nil
- "list of annotations set")
-
-(defun eos::add-to-annotation-list (ann type)
- (if (not (eq type 'debugger-stop))
- (error "not implemented"))
- (setq eos::annotation-list (cons ann
- eos::annotation-list))
- )
-
-(defun eos::remove-from-annotation-list (ann type)
- (if (not (eq type 'debugger-stop))
- (error "not implemented"))
- (setq eos::annotation-list (delq ann eos::annotation-list))
- )
-
-(defun eos::remove-all-from-annotation-list (type)
- (if (not (eq type 'debugger-stop))
- (error "not implemented"))
- (mapcar (function (lambda (annot)
- (if (extent-live-p annot)
- (delete-annotation annot))))
- eos::annotation-list)
- (setq eos::annotation-list nil))
-
-(defun eos::add-annotation (type file line uid)
- (let ((anot nil)
- (fr (selected-frame))
- (win (selected-window))
- )
- (if (eos::null-file file)
- (setq anot nil)
- (if (null (eos::find-line file line type))
- (error "No frame to select"))
- (let* ((device-type (device-type (selected-device)))
- (graphics (eos::annotation-get-glyph type device-type))
- (face (eos::annotation-get-face type device-type))
- )
- (setq anot (make-annotation graphics (point) 'outside-margin))
- (set-annotation-data anot uid)
- (set-extent-face anot face)
- (eos::add-to-annotation-list anot type)
- ))
- (select-frame fr)
- (select-window win)
- anot
- ))
-
-(defun eos::compare-uid (extent uid)
- (and (annotationp extent)
- (equal (annotation-data extent) uid)
- extent))
-
-(defun eos::delete-annotation (type file line uid)
- ;; ignore file and line, they are here for backward compatibility
- (let ((anot nil)
- (alist eos::annotation-list)
- )
- (if (not (eq type 'debugger-stop))
- (error "not implemented"))
- (while (and alist
- (not (equal (annotation-data (car alist)) uid)))
- (setq alist (cdr alist)))
- (if (null alist)
- (error "Event UID not found; ignored")
- (setq anot (car alist))
- (delete-annotation anot)
- (eos::remove-from-annotation-list anot type))
- ))
-
-;; probably type should not be given here... (already stored in the annotation-data
-;; field) but it is a bit more robust this way.
-
-(defun eos::make-annotation-visible (annotation file line type)
- ;; returns nil or moves the ANNOTATION to FILE and LINE; annotation is of TYPE
- (let ((back nil)
- (fr (selected-frame))
- (win (selected-window))
- )
- ;; (save-window-excursion
- (if (not (eos::null-file file))
- (progn
- (if (eos::valid-annotation annotation)
- (detach-extent annotation) ; should operate on annotations
- )
- (if (null (eos::find-line file line type))
- (error "No frame to select"))
- (let* ((device-type (device-type (selected-device)))
- (graphics (eos::annotation-get-glyph type device-type))
- (face (eos::annotation-get-face type device-type))
- )
- (if (and (eos::valid-annotation annotation)
- (extent-detached-p annotation))
- (progn
- (setq back (insert-extent annotation (point) (point) t))
- (set-annotation-glyph back graphics 'whitespace)
- )
- (setq back (make-annotation graphics (point) 'whitespace))
- )
- (set-annotation-data back type)
- (set-extent-face back face)
- )))
- ;; )
- (if (not (eq (selected-frame) fr))
- (select-frame fr))
- (select-window win)
- back
- ))
-
-(defun eos::make-annotation-invisible (annotation)
- ;; make this ANNOTATION invisible
- (if (eos::valid-annotation annotation)
- (detach-extent annotation) ;; should operate on annotations
- ))
-
-
-;; mapping between annotation types and their screen representations.
-
-(defvar eos::alist-annotation-glyph nil) ; assoc list of annotation type
- ; device type, and glyph
-(defvar eos::alist-annotation-inst nil) ; assoc list of annotation type
- ; device type, and instantiator
-(defvar eos::alist-annotation-inst-alt nil) ; alternate assoc list of annotation type
- ; device type, and instantiator
-
-(defvar eos::alist-annotation-face nil) ;; assoc list of annotation type,
- ;; device type and face
-
-;; PUBLIC
-
-;; TBD! merge both instance lists.
-
-(defun eos::annotation-set-inst (annotation-type device-type inst inst-alt)
- "define the instantiator for ANNOTATION-TYPE on DEVICE-TYPE to be
-INST for the frame enabled for this type and INST-ALT for other frames"
- (interactive)
- (setq eos::alist-annotation-inst
- (cons (cons (cons annotation-type device-type) inst)
- eos::alist-annotation-inst))
- (setq eos::alist-annotation-inst-alt
- (cons (cons (cons annotation-type device-type) inst-alt)
- eos::alist-annotation-inst-alt)) )
-
-(defun eos::annotation-set-face (annotation-type device-type face-1 face-2)
- "define the face for ANNOTATION-TYPE on DEVICE-TYPE to be
-FACE-1 for the frame enabled for this type and FACE-2 for other frames"
- (interactive)
- (setq eos::alist-annotation-face
- (cons (cons (cons annotation-type device-type) face-1)
- eos::alist-annotation-face))
- )
-
-;; PRIVATE
-
-(defun eos::annotation-get-glyph (annotation-type device-type)
- ;; Get the glyph for ANNOTATION-TYPE on DEVICE-TYPE
- (interactive)
- (let ((found (assoc (cons annotation-type device-type)
- eos::alist-annotation-glyph)))
- (if found
- (cdr found)
- (let ((inst (eos::annotation-get-inst annotation-type device-type))
- (alt-inst (eos::annotation-get-inst-alt annotation-type device-type))
- (glyph nil)
- (frame (selected-frame)))
- (if (null inst)
- nil
- (setq glyph (make-glyph `((global . (nil . ,alt-inst)))))
- (add-spec-to-specifier (glyph-image glyph) inst frame)
- (setq eos::alist-annotation-glyph
- (cons (cons (cons annotation-type device-type) glyph)
- eos::alist-annotation-glyph))
- glyph))
- )))
-
-(defun eos::annotation-get-inst (annotation-type device-type)
- ;; Get the primary instantiator for ANNOTATION-TYPE on DEVICE-TYPE
- (interactive)
- (let ((found (assoc (cons annotation-type device-type)
- eos::alist-annotation-inst)))
- (if found
- (cdr found)
- nil)))
-
-(defun eos::annotation-get-inst-alt (annotation-type device-type)
- ;; Get the alternate instantiator for ANNOTATION-TYPE on DEVICE-TYPE
- (interactive)
- (let ((found (assoc (cons annotation-type device-type)
- eos::alist-annotation-inst-alt)))
- (if found
- (cdr found)
- nil)))
-
-(defun eos::annotation-get-face (annotation-type device-type)
- ;; Get the face for ANNOTATION-TYPE on DEVICE-TYPE
- (interactive)
- (let ((found (assoc (cons annotation-type device-type)
- eos::alist-annotation-face))
- )
- (if found
- (cdr found)
- nil
- ))
- )
-
-
-(defun eos::common-startup () )
-;;
-
-
-(provide 'eos-common)
+++ /dev/null
-;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks Debugger interface
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx
-
-;;; Commentary:
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-;; debugger buffer
-
-(require 'eos-common "sun-eos-common")
-(require 'eos-debugger "sun-eos-debugger")
-(require 'eos-menubar "sun-eos-menubar")
-
-(defvar eos::debugger-buffer "*Eos Debugger Log*"
- "name of buffer where to log debugger activity; see eos::use-debugger-buffer")
-(defvar eos::dbx-buffer nil)
-(defvar eos::key-mode 'none "Style of key mode interaction for Eos")
-
-(defun eos::ensure-debugger-buffer ()
- ;; will ensure a debugger buffer, with the proper major mode
- (let ((buf (get-buffer eos::debugger-buffer)))
- (if buf
- (switch-to-buffer buf)
- (setq buf (get-buffer-create eos::debugger-buffer))
- (set-buffer buf)
- (eos::debugger-mode)
- (toggle-read-only -1) ; writeable
- (eos::insert-string-as-extent "[Debugger] " t (get-face 'bold))
- (toggle-read-only 1) ; read-only
- )))
-
-(defun eos::synchronize-debugger-buffer ()
- ;; ensure all views of this buffer are at the end
- (eos::ensure-debugger-buffer)
- (let ((x (point-max)))
- (goto-char x)
- (mapcar (function
- (lambda (win)
- (set-window-point win x)))
- (get-buffer-window-list eos::debugger-buffer))
- ))
-
-(defvar eos::debugger-mode-map nil)
-
-(if eos::debugger-mode-map
- nil
- (progn
- (setq eos::debugger-mode-map (make-keymap))
- (set-keymap-name eos::debugger-mode-map 'eos::debugger-mode-map)
- (define-key eos::debugger-mode-map [(meta p)] 'eos::debugger-previous-cmd)
- (define-key eos::debugger-mode-map [(meta n)] 'eos::debugger-next-cmd)
- (define-key eos::debugger-mode-map [return] 'eos::debugger-send-cmd)
- ))
-
-(defun eos::debugger-mode ()
- (interactive)
- "local mode"
- (kill-all-local-variables)
- (setq major-mode 'eos::debugger-mode)
- (setq mode-name "eos::debugger")
- (setq truncate-lines t)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (use-local-map eos::debugger-mode-map))
-
-
-;; Handling of command lists
-
-(defvar eos::current-command nil "Current command navigated; as an extent")
-(defvar eos::last-command nil "last command sent to debugger, as an extent")
-
-(defun eos::debugger-previous-cmd ()
- ;; present the previous command
- (interactive)
- (save-excursion
- (let ((xt nil))
- (if (null eos::current-command)
- (setq xt eos::last-command)
- (setq xt (extent-property
- eos::current-command
- 'previous-command)))
- (if xt
- (progn
- (eos::debugger-delete-last-cmd-line)
- (goto-char (point-max))
- (insert (buffer-substring
- (extent-start-position xt)
- (1- (extent-end-position xt)) ; remove <CR>
- ))
- (setq eos::current-command xt))
- (error "no previous command")
- ))
- ))
-
-(defun eos::debugger-next-cmd ()
- ;; present the next command
- (interactive)
- (save-excursion
- (let ((xt nil))
- (if (null eos::current-command)
- (error "no next command")
- (setq xt (extent-property
- eos::current-command
- 'next-command)))
- (eos::debugger-delete-last-cmd-line)
- (if xt
- (progn
- (goto-char (point-max))
- (insert (buffer-substring
- (extent-start-position xt)
- (1- (extent-end-position xt)) ; remove <CR>
- ))
- (setq eos::current-command xt))
- (setq eos::current-command nil)
- ))
- ))
-
-(defun eos::debugger-delete-last-cmd-line ()
- ;; delete the last command line, not yet inputed, returns that cmd line
- (goto-char (point-max))
- (let ((e (point)))
- (beginning-of-line)
- (let* ((xt (extent-at (point)))
- (p (extent-end-position xt))
- (str (buffer-substring p e))
- )
- (delete-region p e)
- str
- )))
-
-(defun eos::debugger-send-cmd ()
- ;; send the message in the current line
- (interactive)
- (end-of-line)
- (let ((e (point)))
- (beginning-of-line)
- (let* ((xt (extent-at (point)))
- (p (extent-end-position xt))
- (str (buffer-substring p e))
- )
- (delete-region p e)
- (eos::send-spider-current-do-msg (concat str "\n"))
- (goto-char (point-max))
- (setq eos::current-command nil)
- )))
-
-;; client
-;;
-
-(defun eos::dbx-process ()
- ;; Returns nil, or the corresponding process where to insert
- (let ((pl (process-list))
- (found-proc nil)
- )
- (while (and pl (null found-proc))
- (let* ((proc (car pl))
- (name (process-name proc))
- )
- (if (and (>= (length name) 3)
- (equal (substring name 0 3) "Eos"))
- (setq found-proc proc)
- (setq pl (cdr pl))
- )
- ))
- found-proc
- ))
-
-(defun eos::insert-echo (process string)
- (if (null process)
- nil
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-max))
-;; (let ((beg (point)))
-;; (insert-before-markers string))
- (insert-before-markers string)
- (if (process-mark process)
- (set-marker (process-mark process) (point-max))))
- (if (eq (process-buffer process)
- (current-buffer))
- (goto-char (point-max)))
- ))
-
-
-(defun eos::insert-on-debugger-buffer (msg rdonly face &optional previous-command)
- ;; will insert MSG at end of debugger buffer with RDONLY property and with FACE.
- ;; If PREVIOUS-COMMAND is given, the newly created extent will be doubly linked into this one
- ;; using 'previous-command and 'next-command properties
- (save-window-excursion
- (let ((fr (selected-frame))
- (buf (current-buffer))
- (xt nil))
- (eos::ensure-debugger-buffer)
- (toggle-read-only -1) ; not read-only
- (eos::insert-echo (eos::dbx-process) msg)
- (setq xt (eos::insert-string-as-extent msg rdonly face))
- (if previous-command
- (progn
- (set-extent-property xt 'previous-command previous-command)
- (set-extent-property previous-command 'next-command xt)
- ))
- (toggle-read-only 1) ; now read-only
- (switch-to-buffer buf)
- (select-frame fr)
- xt
- ))
- )
-
-(defun eos::insert-string-as-extent (msg rdonly face)
- ;; insert MSG as a extent with RDONLY and FACE. Returns the extent
- (let ((here nil)
- (xt nil))
- (goto-char (point-max))
- (setq here (point))
- (insert msg)
- (setq xt (make-extent here (point) nil))
- (if rdonly
- (progn
- (set-extent-property xt 'read-only t)
- (set-extent-property xt 'duplicable nil)
- ))
- (set-extent-face xt face)
- (eos::synchronize-debugger-buffer)
- xt
- ))
-\f
-
-;; (require 'comint)
-
-(defvar eos::dbx-program "dbx")
-(defvar eos::dbx-switches (list "-editor"))
-
-(defun eos::expand-file-name (file)
- ;; expand file name depending on first character
- (cond
- ((null file)
- nil)
- ((eq (elt file 0) ?~)
- (expand-file-name file))
- ((eq (elt file 0) ?$)
- (substitute-in-file-name file))
- (t file)))
-
-(defun eos::read-dbx-request (program switches)
- ;; will prompt to the user with PROGRAM and SWITCHES, let her modify this
- ;; and then will read the result and split it into program and switches.
- (let* ((prompt
- (concat program " " (mapconcat 'identity switches " ")))
- (ret (read-from-minibuffer "Run dbx as: " prompt))
- (ret2 (split-string ret " ")))
- ;; some testing
- (cons (car ret2) (cdr ret2))
- ))
-
-(defun eos::dbx ()
-;; Run an inferior dbx -editor process, with I/O through buffer *Eos Dbx*.
-;; If buffer exists but dbx process is not running, make new dbx.
-;; If buffer exists and dbx process is running,
-;; just switch to buffer `*Eos Dbx*'.
- (let ((buffer "*Eos Dbx*")
- (buffer-name "Eos Dbx")
- (input nil))
- (cond ((not (comint-check-proc buffer))
- (setq input (eos::read-dbx-request eos::dbx-program
- eos::dbx-switches))
- (setq eos::dbx-program (car input))
- (setq eos::dbx-switches (cdr input))
- (message "Starting Dbx subprocess")
- (setq buffer
- (set-buffer
- (apply 'make-comint
- buffer-name
- (eos::expand-file-name eos::dbx-program)
- nil
- (mapcar 'eos::expand-file-name eos::dbx-switches))))
- (comint-mode)
- (if (and (eq (device-type (frame-device (selected-frame))) 'tty)
- (eq eos::key-mode 'none)
- (yes-or-no-p
- "Do you want the prefix map activated?"))
- (eos::set-key-mode 'prefix))
- (setq eos::dbx-or-debugger 'dbx)
- (setq eos::dbx-buffer (current-buffer))
- (make-local-variable 'kill-buffer-hook)
- (setq kill-buffer-hook
- (list (function (lambda ()
- (cond
- ((null (eos::dbx-process)) t)
- ((not (eq (process-status (eos::dbx-process)) 'run)) t)
- ((yes-or-no-p
- "Warning! Killing this buffer will kill a dbx process, proceed? ")
- (eos::internal-clear-annotations t t t t))
- (t (error "kill-buffer aborted!")))
- ))))
- )
- (t
- (message "Reusing existing dbx buffer and dbx process")))
- (switch-to-buffer buffer)
- ))
-
-\f
-;; Actions to start a debugger in the background.
-
-(defvar eos::debugger-process nil
- "Debugger process for the background. Only one per XEmacs")
-
-(defvar eos::dbx-or-debugger nil)
-
-(defun eos::start-debugger ()
- "Start an \"debugger -editor\" in the background. Will ask for confirmation if
-XEmacs somehow believes there is already one running"
- (interactive)
- (if (and (or (not (processp eos::debugger-process))
- (not (eq (process-status eos::debugger-process) 'run))
- (yes-or-no-p
- "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
- (or (not (eos::dbx-process))
- (not (eq (process-status (eos::dbx-process)) 'run))
- (yes-or-no-p
- "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
- (progn
- (setq eos::debugger-process
- (start-process "*eos debugger*" nil "debugger" "-editor"))
- (message "Starting Debugger subprocess")
- (eos::select-debugger-frame (selected-frame))
- (setq eos::dbx-or-debugger 'debugger)
- )))
-
-;; Ditto for dbx.
-
-(defun eos::start-dbx ()
- "Start an \"dbx -editor\" as a subprocess. Will ask for confirmation if
-XEmacs somehow believes there is already one running"
- (interactive)
- (if (and (or (not (processp eos::debugger-process))
- (not (eq (process-status eos::debugger-process) 'run))
- (yes-or-no-p
- "Warning! XEmacs believes there already is a debugger -editor, proceed? "))
- (or (not (eos::dbx-process))
- (not (eq (process-status (eos::dbx-process)) 'run))
- (yes-or-no-p
- "Warning! XEmacs believes there already is a dbx -editor, proceed? ")))
- (progn
- (eos::select-debugger-frame (selected-frame))
- (eos::dbx)
- )))
-
-\f
-;;
-;; Communication commands
-;;
-
-(defun eos::spider-do-callback (msg pat)
- ;; Callback after processing a spider_do request
- (eos::insert-on-debugger-buffer
- (format "%s" (get-tooltalk-message-attribute msg 'arg_val 2))
- t
- (get-face 'bold))
- (destroy-tooltalk-message msg)
- )
-
-(defvar eos::last-command-was-print nil "(eos:: internal)")
-
-(defun eos::spro_spider_output (msg pat)
- ;; For spider output
- (let ((s (get-tooltalk-message-attribute msg 'arg_val 1))
- (err (get-tooltalk-message-attribute msg 'arg_val 2))
- )
- (message (format "%s" s))
- (eos::insert-on-debugger-buffer (format "%s" s)
- t
- (get-face 'default))
- (if (and err (not (string-equal err "")))
- (eos::insert-on-debugger-buffer
- (insert (format "STDERR> %s" err))
- t
- (get-face 'default))
- )
- (destroy-tooltalk-message msg)))
-
-(defun eos::spro_spider_output-common (msg pat)
- ;; For spider output
- (if eos::last-command-was-print
- (eos::spro_spider_print_output msg pat)
- (eos::spro_spider_output msg pat)))
-
-(defmacro eos::spider-tt-args (cmd spider-id clique-id)
- (` (list
- 'class TT_REQUEST
- 'address TT_HANDLER
- 'scope TT_SESSION
- 'handler (, spider-id)
- 'op "SPRO_SPIDER_DO"
- 'callback 'eos::spider-do-callback
- 'args (list
- (list 'TT_IN (, clique-id) "Context_ID")
- (list 'TT_IN (, cmd) "string")
- (list 'TT_OUT))
- )))
-
-(defun eos::send-spider-do-msg (cmd spider-id clique-id)
- ;; Send CMD, a string, to SPIDER-ID, using CLIQUE-ID
- (let ((msg (make-tooltalk-message
- (eos::spider-tt-args cmd spider-id clique-id))))
- (setq eos::last-command
- (eos::insert-on-debugger-buffer
- cmd
- t
- (get-face 'italic)
- eos::last-command))
- (setq eos::current-command eos::last-command)
- (send-tooltalk-message msg)
- (destroy-tooltalk-message msg)
- ))
-
-(defvar eos::no-connection-box
- '("XEmacs does not know the ID of a debugger to connect to.
-You may need to reissue a debug or attach command from the debugger.
-Consult the introduction to Eos (Help->SPARCworks...) for more details."
- ["Dismiss" (message "Command aborted") t]))
-
-(defun eos::send-spider-current-do-msg (cmd)
- ;; Send CMD to the current dbx engine using the current debugger clique;
- ;;The cmd ends in a new-line.
- (if (null eos::current-debugger-clique-id)
- (popup-dialog-box eos::no-connection-box)
- (eos::send-spider-do-msg cmd
- eos::current-dbx-proc-id
- eos::current-debugger-clique-id)))
-
-(defun eos::dbx-cmd (arg)
- "Send CMD to the current dbx engine using the current debugger clique;
-The cmd does not end in a new-line; a new-line will be added"
- (interactive "sDbx cmd: ")
- (eos::send-spider-current-do-msg (concat arg "\n")))
-
-\f
-;;
-;; Extra patterns
-
-(defvar eos::dbx-extra-pattern-list nil)
-
-(defun eos::debugger-extra-startup ()
- ;; Actions to do at startup for eos-debugger-extra.el
- (setq eos::dbx-extra-pattern-list ; list of extra TT patterns
- (eos::create-debugger-extra-patterns))
- (eos::ensure-available-print-frame)
- (eos::define-prefix-map) ; initialize keymap
- )
-
-(defun eos::create-debugger-extra-patterns ()
- ;; returns a list of patterns
- (list
- (make-an-observer "SPRO_SPIDER_OUTPUT" 'eos::spro_spider_output-common)
- ))
-
-(defun eos::register-debugger-extra-patterns ()
- ;; register additional dbx patterns
- (mapcar 'register-tooltalk-pattern eos::dbx-extra-pattern-list))
-
-(defun eos::unregister-debugger-extra-patterns ()
- ;; unregister additional dbx patterns
- (mapcar 'unregister-tooltalk-pattern eos::dbx-extra-pattern-list))
-
-;;
-;; Common commands
-;;
-
-
-(defun eos::type () (interactive)
- (if (eq eos::dbx-or-debugger 'debugger)
- (call-interactively 'eos::dbx-cmd)
- (if (buffer-live-p eos::dbx-buffer)
- (switch-to-buffer eos::dbx-buffer)
- (message "no dbx subprocess buffer known"))))
-
-(defun eos::run () (interactive) (eos::dbx-cmd "run"))
-(defun eos::fix () (interactive) (eos::dbx-cmd "fix"))
-(defun eos::build () (interactive) (eos::dbx-cmd "make"))
-
-(defun eos::cont () (interactive) (eos::dbx-cmd "cont"))
-(defun eos::cont-and-dismiss () (interactive)
- (eos::dismiss-print-frame) (eos::cont))
-(defun eos::clear-all () (interactive) (eos::dbx-cmd "clear"))
-(defun eos::next () (interactive) (eos::dbx-cmd "next"))
-(defun eos::next-and-dismiss () (interactive)
- (eos::dismiss-print-frame) (eos::next))
-(defun eos::step () (interactive) (eos::dbx-cmd "step"))
-(defun eos::step-and-dismiss () (interactive)
- (eos::dismiss-print-frame) (eos::step))
-(defun eos::step-up () (interactive) (eos::dbx-cmd "step up"))
-
-(defun eos::up () (interactive) (eos::dbx-cmd "up" ))
-(defun eos::down () (interactive) (eos::dbx-cmd "down"))
-(defun eos::pop () (interactive) (eos::dbx-cmd "pop"))
-
-
-(defun eos::stop-at ()
- (interactive)
- (let ((name (buffer-file-name)))
- (if (null name) (error "Buffer has no associated file"))
- (eos::dbx-cmd
- (format "stop at \"%s\":%d" name (eos::line-at (point))))
- ))
-
-(defun eos::clear-at ()
- (interactive)
- (let ((name (buffer-file-name)))
- (if (null name) (error "Buffer has no associated file"))
- (eos::dbx-cmd
- (format "clear \"%s\":%d" name (eos::line-at (point))))
- ))
-
-(defun eos::stop-in ()
- (interactive)
- (eos::dbx-cmd
- (format "stop in %s"
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- ))
- (setq zmacs-region-stays t))
-
-(defun eos::func ()
- (interactive)
- (eos::dbx-cmd
- (format "func %s"
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- ))
- (setq zmacs-region-stays t))
-
-(defun eos::cont-to ()
- (interactive)
- (let ((name (buffer-file-name)))
- (if (null name) (error "Buffer has no associated file"))
- (eos::dbx-cmd
- (format "stop at \"%s\":%d -temp; cont" name (eos::line-at (point))))
- ))
-
-(defun eos::print-normal ()
- (interactive)
- (eos::dbx-cmd
- (format "print %s"
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- ))
- (setq zmacs-region-stays t))
-
-(defun eos::print*-normal ()
- (interactive)
- (eos::dbx-cmd
- (format "print *(%s)"
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- ))
- (setq zmacs-region-stays t))
-
-;; specialization for print commands
-
-(defun eos::send-spider-print-msg (expr)
- ;; Print EXPR using separate frame
- (setq eos::last-command-was-print t)
- (eos::dbx-cmd (format "print %s" expr)))
-
-(defun eos::send-spider-print*-msg (expr)
- ;; Send *EXPR using separate frame
- (setq eos::last-command-was-print t)
- (eos::dbx-cmd (format "print *(%s)" expr)))
-
-(defun eos::print () (interactive)
- (eos::send-spider-print-msg
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- )
- (setq zmacs-region-stays t))
-
-(defun eos::print* () (interactive)
- (eos::send-spider-print*-msg
- (if (eq 'x (device-type (selected-device)))
- (x-get-selection)
- (buffer-substring (point) (mark)))
- )
- (setq zmacs-region-stays t))
-
-\f
-;;
-;;
-;; Print on separate frame
-
-
-(defun eos::buffer-line-size (buffer)
- (interactive)
- (or (bufferp buffer)
- (setq buffer (current-buffer)))
- (save-excursion
- (switch-to-buffer buffer)
- (eos::line-at (point-max))))
-
-;;
-;; Handling of a collection of print frames
-;; (currently only one)
-
-(defvar eos::print-frame nil "Frame for prints")
-(defvar eos::print-buffer " *Eos Print Output*" "Buffer for prints")
-
-(defun eos::new-available-print-frame()
- ;; returns an available print frame
- ;; currently just returns the one frame
- (require 'eos-toolbar "sun-eos-toolbar")
- (let ((scr (selected-frame))
- (buf (current-buffer)))
-
- ;; create frames
- (if (and
- (frame-live-p eos::print-frame)
- (or (not (frame-live-p eos::debugger-frame))
- (not (eq eos::print-frame
- eos::debugger-frame))))
- (progn
- (make-frame-visible eos::print-frame)
- eos::print-frame)
- (setq eos::print-frame (make-frame))
- ;; no modeline visible...
- (set-face-background 'modeline
- (face-background (get-face 'default))
- eos::print-frame)
- (set-face-foreground 'modeline
- (face-background (get-face 'default))
- eos::print-frame)
- ;; there is redundancy below.
- (select-frame eos::print-frame)
- (switch-to-buffer eos::print-buffer)
- (set-buffer-menubar nil)
- (add-spec-to-specifier (eos::toolbar-position) eos::print-toolbar (selected-frame))
- (add-spec-to-specifier has-modeline-p nil (selected-frame))
- (select-frame scr)
- (switch-to-buffer buf)
- eos::print-frame
- )))
-
-;; set delete-frame-hook and check for this frame... then do
-
-
-
-(defun eos::ensure-available-print-frame ()
- ;; ensures that there is at least one available print frame
- t)
-
-(defun eos::show-print-frame ()
- (interactive)
- (setq eos::print-frame (eos::new-available-print-frame))
- (select-frame eos::print-frame)
- (switch-to-buffer eos::print-buffer)
- (set-frame-height eos::print-frame
- (+ 1 (eos::buffer-line-size eos::print-buffer)))
- (goto-char (point-min))
- )
-
-(defun eos::dismiss-print-frame ()
- (interactive)
- (if (frame-live-p eos::print-frame)
- (progn
- (make-frame-invisible eos::print-frame)
- (select-frame (car (visible-frame-list))))))
-;;
-;; print output
-;;
-
-(defun eos::spro_spider_print_output (msg pat)
- ;; For spider print output (switched with spro_spider_output
- (let ((buf (current-buffer))
- (scr (selected-frame)))
- (save-excursion ; does not work in callbacks?
- (switch-to-buffer eos::print-buffer)
- (delete-region (point-min) (point-max))
- (goto-char (point-max))
- (insert (format "%s" (get-tooltalk-message-attribute msg
- 'arg_val 1)))
- (let ((err (get-tooltalk-message-attribute msg
- 'arg_val 2)))
- (if (and err (not (string-equal err "")))
- (insert (format "STDERR> %s" err))))
- (eos::show-print-frame)
- (select-frame scr)
- (switch-to-buffer buf)
- )
- (destroy-tooltalk-message msg)
- (setq eos::last-command-was-print nil)
- ))
-
-\f
-;; User interface
-
-(defvar eos::prefix-map (make-keymap))
-
-(defun eos::define-prefix-map ()
-
- (define-key eos::prefix-map "%" 'eos::dbx-cmd)
- (define-key eos::prefix-map "r" 'eos::run)
- (define-key eos::prefix-map "f" 'eos::fix)
-
- (define-key eos::prefix-map "p" 'eos::print)
- (define-key eos::prefix-map "\C-p" 'eos::print*)
-
- (define-key eos::prefix-map "c" 'eos::cont)
- (define-key eos::prefix-map "b" 'eos::stop-at)
- (define-key eos::prefix-map "\C-b" 'eos::clear-at)
-
- (define-key eos::prefix-map "n" 'eos::next)
- (define-key eos::prefix-map "s" 'eos::step)
- (define-key eos::prefix-map "\C-s" 'eos::step-up)
-
- (define-key eos::prefix-map "u" 'eos::up)
- (define-key eos::prefix-map "d" 'eos::down)
-
-)
-
-(defun eos::set-key-mode (mode)
- ;; Set the key MODE to either 'none, 'prefix, or 'function
- (setq eos::key-mode mode)
- (cond
- ((eq eos::key-mode 'none)
- (define-key global-map "\C-cd" nil)
- (eos::remove-function-keys)
- (add-submenu nil (append '("SPARCworks") eos::short-menu))
- )
- ((eq eos::key-mode 'prefix)
- (define-key global-map "\C-cd" eos::prefix-map)
- (eos::remove-function-keys)
- (add-submenu nil (append '("SPARCworks") eos::long-menu))
- )
- ((eq eos::key-mode 'function)
- (define-key global-map "\C-cd" nil)
- (eos::add-function-keys)
- (add-submenu nil (append '("SPARCworks") eos::long-menu))
- )
- (t
- (error "unimplemented")
- )))
-
-(defun eos::add-function-keys ()
- (interactive)
-
- ;;
- (global-set-key [f6] 'eos::dbx-cmd)
- (global-set-key [(control f6)] 'eos::run)
- (global-set-key [(shift f6)] 'eos::fix)
- ;;
- (global-set-key [f7] 'eos::print)
- (global-set-key [(control f7)] 'eos::print*)
- (global-set-key [(shift f7)] 'eos::dismiss-print-frame)
- ;;
- (global-set-key [f8] 'eos::cont)
- (global-set-key [(control f8)] 'eos::stop-at)
- (global-set-key [(shift f8)] 'eos::clear-at)
- ;;
- (global-set-key [f9] 'eos::next)
- (global-set-key [(control f9)] 'eos::step)
- (global-set-key [(shift f9)] 'eos::step-up)
- ;;
- )
-
-(defun eos::remove-function-keys ()
- (interactive)
-
- ;;
- (global-set-key [f6] nil)
- (global-set-key [(control f6)] nil)
- (global-set-key [(shift f6)] nil)
- ;;
- (global-set-key [f7] nil)
- (global-set-key [(control f7)] nil)
- (global-set-key [(shift f7)] nil)
- ;;
- (global-set-key [f8] nil)
- (global-set-key [(control f8)] nil)
- (global-set-key [(shift f8)] nil)
- ;;
- (global-set-key [f9] nil)
- (global-set-key [(control f9)] nil)
- (global-set-key [(shift f9)] nil)
- ;;
- )
-
-;; Provides popup access
-
-(defvar eos::popup-mode nil)
-(defvar eos::saved-global-popup-menu nil)
-
-(defun eos::toggle-popup-menu ()
- ;; Toggle whether to use or not popup menus for SPARCworks
- (interactive)
- (if eos::popup-mode
- (setq global-popup-menu eos::saved-global-popup-menu)
- (eos::push-popup-menu))
- (setq eos::popup-mode (null eos::popup-mode))
- )
-
-(defun eos::push-popup-menu ()
- (setq eos::saved-global-popup-menu global-popup-menu)
- (setq global-popup-menu
- (append
- '("SPARCworks Command"
- ["Stop At" eos::stop-at t]
- ["Clear At" eos::clear-at t]
- ["Stop In" eos::stop-in t]
- ["Cont To" eos::cont-to t]
- ["Print" eos::print t]
- ["Print*" eos::print* t]
- "---"
- ["Read a Dbx Command" eos::dbx-cmd t]
- "---")
- (list
- eos::saved-global-popup-menu))
- ))
-
-(provide 'eos-debugger)
-
-;;; sun-eos-debugger.el ends here
+++ /dev/null
-;;; sun-eos-debugger.el --- Implements the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx
-
-;;; Commentary:
-
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(require 'eos-common "sun-eos-common")
-
-;;; =================
-;;; debugger protocol
-;;; =================
-
-(defvar eos::current-hollow-arrow nil)
-(defvar eos::current-solid-arrow nil)
-(defvar eos::current-dbx-proc-id nil
- "TT id for the current dbx")
-(defvar eos::current-debugger-clique-id nil
- "Clique_ID for the current debugger/dbx")
-
-;; currentpc.color
-
-(defvar eos::currentpc-inst "/* XPM */
-static char * file[] = {
-\"16 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #0000FFFF0000\",
-\"o c #000077770000\",
-\"O c #000044440000\",
-\" . \",
-\" .. \",
-\" .X. \",
-\" .........XX. \",
-\" .XXXXXXXXXoX. \",
-\" .Xooooooooooo. \",
-\" .oOOOOOOOOoO. \",
-\" .........OO. \",
-\" .O. \",
-\" .. \",
-\" . \"};")
-
-(defvar eos::currentpc-inst-alt
- "/* XPM */
-static char * file[] = {
-\"16 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #0000FFFF0000\",
-\"o c #000077770000\",
-\"O c #000044440000\",
-\" . \",
-\" .. \",
-\" .X. \",
-\" .........XX. \",
-\" .XXXXXXXXXoX. \",
-\" .Xooooooooooo. \",
-\" .oOOOOOOOOoO. \",
-\" .........OO. \",
-\" .O. \",
-\" .. ..\",
-\" . ..\"};")
-
-(defvar eos::visitedpc-inst
- "/* XPM */
-static char * file[] ={
-\"16 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #AFAFAFAFAFAF\",
-\"o c #7E7E7E7EA9A9\",
-\"O c #666633339999\",
-\" . \",
-\" .. \",
-\" .X. \",
-\" .........XX. \",
-\" .XXXXXXXXXoX. \",
-\" .XooooooooooO. \",
-\" .XOOOOOOOOoO. \",
-\" .........OO. \",
-\" .O. \",
-\" .. \",
-\" . \"};")
-
-(defvar eos::visitedpc-inst-alt
- "/* XPM */
-static char * file[] ={
-\"16 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #AFAFAFAFAFAF\",
-\"o c #7E7E7E7EA9A9\",
-\"O c #666633339999\",
-\" . \",
-\" .. \",
-\" .X. \",
-\" .........XX. \",
-\" .XXXXXXXXXoX. \",
-\" .XooooooooooO. \",
-\" .XOOOOOOOOoO. \",
-\" .........OO. \",
-\" .O. \",
-\" .. ..\",
-\" . ..\"};")
-
-(defvar eos::breakpoint-inst
- "/* XPM */
-static char * file[] ={
-\"11 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #FFFF66666666\",
-\"o c #FFFF00000000\",
-\"O c #777700000000\",
-\" ..... \",
-\" .XXXXX. \",
-\" .XXoooXX. \",
-\".XXoooooXO.\",
-\".XoooooooO.\",
-\".XoooooooO.\",
-\".XoooooooO.\",
-\".XXoooooOO.\",
-\" .XXoooOO. \",
-\" .OOOOO. \",
-\" ..... \"};")
-
-(defvar eos::breakpoint-inst-alt
- "/* XPM */
-static char * file[] ={
-\"11 11 5 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c #FFFF66666666\",
-\"o c #FFFF00000000\",
-\"O c #777700000000\",
-\" ..... \",
-\" .XXXXX. \",
-\" .XXoooXX. \",
-\".XXoooooXO.\",
-\".XoooooooO.\",
-\".XoooooooO.\",
-\".XoooooooO.\",
-\".XXoooooOO.\",
-\" .XXoooOO. \",
-\" .OOOOO...\",
-\" ..... ..\"};")
-
-;; The TT protocol does not provide enough information to
-;; use the eos::disabledBreakpoint glyph.
-
-(defvar eos::disabledBreakpoint-inst
- "/* XPM */
-static char * file[] ={
-\"11 11 4 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c Grey\",
-\"O c Grey80\",
-\" ..... \",
-\" .XXXXX. \",
-\" .XXXXXXX. \",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXOO.\",
-\" .XXXXXOO. \",
-\" .OOOOO. \",
-\" ..... \"};")
-
-(defvar eos::disabledBreakpoint-inst-alt
- "/* XPM */
-static char * file[] ={
-\"11 11 4 1\",
-\" s background c #BDBDBDBDBDBD\",
-\". c #000000000000\",
-\"X c Grey\",
-\"O c Grey80\",
-\" ..... \",
-\" .XXXXX. \",
-\" .XXXXXXX. \",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXXO.\",
-\".XXXXXXXOO.\",
-\" .XXXXXOO. \",
-\" .OOOOO...\",
-\" ..... ..\"};")
-
-(defvar eos::dbx-pattern-list nil)
-
-(defun eos::debugger-startup ()
- ;; Actions to do at startup for eos-debugger.el
- (make-face 'stop-face)
- (make-face 'solid-arrow-face)
- (make-face 'hollow-arrow-face)
-
- (set-face-foreground 'stop-face eos::stop-color)
- (set-face-background 'stop-face
- (face-background (get-face 'default)))
- (set-face-foreground 'solid-arrow-face eos::solid-arrow-color)
- (set-face-background 'solid-arrow-face
- (face-background (get-face 'default)))
- (set-face-foreground 'hollow-arrow-face eos::hollow-arrow-color)
- (set-face-background 'hollow-arrow-face
- (face-background (get-face 'default)))
-
- (setq eos::dbx-pattern-list ; list of dbx TT patterns
- (eos::create-debugger-patterns))
-
-;; should there be only one stop-face, with different properties depending
-;; on the frame/device?
-
- (eos::annotation-set-inst 'debugger-stop 'x eos::breakpoint-inst [nothing])
- (eos::annotation-set-inst 'debugger-stop 'tty "[S]" [nothing])
- (eos::annotation-set-face 'debugger-stop 'x
- (get-face 'stop-face) (get-face 'stop-face))
- (eos::annotation-set-face 'debugger-stop 'tty
- (get-face 'highlight) (get-face 'highlight))
-
- (eos::annotation-set-inst 'debugger-hollow-arrow 'x eos::visitedpc-inst [nothing])
- (eos::annotation-set-inst 'debugger-hollow-arrow 'tty "[]>" [nothing])
- (eos::annotation-set-face 'debugger-hollow-arrow 'x
- (get-face 'hollow-arrow-face)
- (get-face 'hollow-arrow-face))
- (eos::annotation-set-face 'debugger-hollow-arrow 'tty
- (get-face 'highlight) (get-face 'highlight))
-
- (eos::annotation-set-inst 'debugger-solid-arrow 'x eos::currentpc-inst [nothing])
- (eos::annotation-set-inst 'debugger-solid-arrow 'tty "=>" [nothing])
- (eos::annotation-set-face 'debugger-solid-arrow 'x
- (get-face 'solid-arrow-face)
- (get-face 'solid-arrow-face))
- (eos::annotation-set-face 'debugger-solid-arrow 'tty
- (get-face 'highlight) (get-face 'highlight))
-)
-
-;; Not yet ready for prime time.
-
-(defvar eos::fill-stack-buffer nil
- "when t don't try any stack tracing")
-
-(defvar eos::stack-buffer "*Eos Stack*"
- "name of buffer where to log Stack")
-
-(defun eos::empty-stack ()
- ;; No valid stack data - e.g. resume/run program -
- (if eos::fill-stack-buffer
- (progn
- (set-buffer (get-buffer-create eos::stack-buffer))
- (toggle-read-only -1)
- (delete-region (point-min) (point-max))
- (toggle-read-only 1)
- )))
-
-(defun eos::load-stack ()
- ;; Should send a TT message requesting for the stack information;
- ;; with the real work done in a callback
- (if eos::fill-stack-buffer
- (eos::stack-test 1)))
-
-(defun eos::visit-stack (stackpos)
- (if eos::fill-stack-buffer
- (progn
- (eos::empty-stack)
- (eos::stack-test 1)
- )))
-
-(defun eos::create-stack-patterns ()
- ;; returns a list of patterns
- (list
- (make-an-observer "SPRO_SPIDER_FRAMES" 'eos::spro_spider_frames)
- ))
-
-(defun eos::spro_spider_frames (msg pat)
- ;; We have received a SPRO_SPIDER_FRAMES notice
- (let ((count (get-tooltalk-message-attribute msg 'args_count))
- (i 1))
- (set-buffer (get-buffer-create eos::stack-buffer))
- (toggle-read-only -1)
- (while (< i count)
- ;; optional leading comment
- (if (equal (get-tooltalk-message-attribute msg 'arg_type i)
- "Stack_Info1")
- (progn
- (insert (get-tooltalk-message-attribute msg 'arg_val i))
- (setq i (1+ i))))
- ;; current frame?
- (insert (if (equal (get-tooltalk-message-attribute msg 'arg_ival i)
- "0") " " "> "))
- (setq i (1+ i))
- (insert (format "[%s] %s%s %s:%s"
- ;; frameno
- (get-tooltalk-message-attribute msg 'arg_ival i)
- ;; funcname
- (get-tooltalk-message-attribute msg 'arg_val (+ i 1))
- ;; funcargs
- (get-tooltalk-message-attribute msg 'arg_val (+ i 2))
- ;; source
- (get-tooltalk-message-attribute msg 'arg_val (+ i 3))
- ;; line
- (get-tooltalk-message-attribute msg 'arg_val (+ i 4))))
- (setq i (+ i 5))
- (if (equal (get-tooltalk-message-attribute msg 'arg_type i)
- "Stack_Info2")
- (progn
- (insert (get-tooltalk-message-attribute msg 'arg_val i))
- (setq i (1+ i))))
- (insert "\n"))
- (toggle-read-only 1)
-;; (return-tooltalk-message msg)
- ))
-
-(defun eos::spider-stack-callback (msg pat)
- ;; Callback after processing a spider_stack request
- (destroy-tooltalk-message msg)
- )
-
-(defmacro eos::stack-tt-args (spider-id clique-id hidden verbose quick starting-index count)
- (` (list
- 'class TT_REQUEST
- 'address TT_HANDLER
- 'scope TT_SESSION
- 'handler (, spider-id)
- 'op "SPRO_SPIDER_STACK"
- 'callback 'eos::spider-stack-callback
- 'args (list
- (list 'TT_IN (, clique-id) "Context_ID")
- (list 'TT_IN (, hidden) "Boolean")
- (list 'TT_IN (, verbose) "Boolean")
- (list 'TT_IN (, quick) "Boolean")
- (list 'TT_IN (, starting-index) "int")
- (list 'TT_IN (, count) "int"))
- )))
-
-(defun eos::stack-test (starting-index)
- (let ((msg (make-tooltalk-message
- (eos::stack-tt-args eos::current-dbx-proc-id
- eos::current-debugger-clique-id
- 0 ; hidden
- 1 ; verbose
- 0 ; quick
- starting-index
- 4 ; count
- ))))
- (send-tooltalk-message msg)
-;; (destroy-tooltalk-message msg)
- ))
-
-;; (setq eos::fill-stack-buffer t)
-;; (setq eos::fill-stack-buffer nil)
-;; (setq eos::stack-pattern-list (eos::create-stack-patterns))
-;; (mapcar 'register-tooltalk-pattern eos::stack-pattern-list)
-;; (mapcar 'unregister-tooltalk-pattern eos::stack-pattern-list)
-;; (eos::stack-test 1)
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-
-;;
-
-(defun eos::spro_te_eventset (msg pat)
- ;; thread_id trap_id string string filename lineno string string
- (let* ((trap-id
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (filename
- (get-tooltalk-message-attribute msg 'arg_val 4))
- (lineno
- (read (get-tooltalk-message-attribute msg 'arg_ival 5))))
- (eos::add-annotation 'debugger-stop filename lineno trap-id)
-;; (return-tooltalk-message msg)
- ))
-
-(defun eos::spro_te_eventdel (msg pat)
- ;; trap_id string string filename lineno string string
- (let* ((trap-id
- (get-tooltalk-message-attribute msg 'arg_val 0))
- (filename
- (get-tooltalk-message-attribute msg 'arg_val 3))
- (lineno
- (read (get-tooltalk-message-attribute msg 'arg_ival 4))))
- (eos::delete-annotation 'debugger-stop filename lineno trap-id)
-;; (return-tooltalk-message msg)
- ))
-
-(defun eos::spro_te_stopped (msg pat)
- ;; thread_id filename procname lineno filename procname lineno
- (let* ((filename-hollow
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (procname-hollow
- (get-tooltalk-message-attribute msg 'arg_val 2))
- (lineno-hollow
- (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
- (filename-solid
- (get-tooltalk-message-attribute msg 'arg_val 4))
- (lineno-solid
- (read (get-tooltalk-message-attribute msg 'arg_ival 6)))
- )
- (setq eos::current-solid-arrow
- (eos::make-annotation-visible eos::current-solid-arrow
- filename-solid
- lineno-solid
- 'debugger-solid-arrow))
- (if (or (not (equal filename-solid filename-hollow))
- (not (equal lineno-solid lineno-hollow)))
- (setq eos::current-hollow-arrow
- (eos::make-annotation-visible eos::current-hollow-arrow
- filename-hollow
- lineno-hollow
- 'debugger-hollow-arrow)))
-;; (return-tooltalk-message msg)
- (eos::load-stack)
- ))
-
-;; Tracking current id's
-;;
-
-(defun eos::update-dbx-proc-id (msg)
- (setq eos::current-dbx-proc-id
- (get-tooltalk-message-attribute msg 'sender))
- ;; the following is needed to make toolbar entries be active or not
- ;; I think it is not needed in 19.13
- (eos::select-debugger-frame eos::debugger-frame)
- )
-
-(defun eos::update-current-debugger-clique-id (msg)
- (setq eos::current-debugger-clique-id
- (get-tooltalk-message-attribute msg 'arg_val 0))
- )
-
-;;
-;; Updating arrows
-;;
-
-
-(defun eos::update-pids (msg)
- (eos::update-dbx-proc-id msg)
- (eos::update-current-debugger-clique-id msg))
-
-(defun eos::internal-clear-annotations (stack arrows stops &optional clique)
- (if stack
- (eos::empty-stack))
- (if arrows
- (progn
- (eos::make-annotation-invisible eos::current-hollow-arrow)
- (eos::make-annotation-invisible eos::current-solid-arrow)))
- (if clique
- (progn
- (setq eos::current-debugger-clique-id nil)
- ;; not needed in 19.13?
- (eos::select-debugger-frame eos::debugger-frame)))
- (if stops
- (eos::remove-all-from-annotation-list 'debugger-stop)))
-
-
-(defun eos::clear-arrows (msg pat)
- (eos::internal-clear-annotations t t nil)
-;; (return-tooltalk-message msg)
- )
-
-(defun eos::update-clear-stops (msg pat)
- (eos::update-pids msg)
- (eos::internal-clear-annotations t nil t)
-;; (return-tooltalk-message msg)
- )
-
-(defun eos::update-clear-arrows-stops (msg pat)
- (eos::update-pids msg)
- (eos::internal-clear-annotations t t t)
-;; (return-tooltalk-message msg)
- )
-
-(defun eos::clear-arrows-stops (msg pat)
- (let ((this-proc-id
- (get-tooltalk-message-attribute msg 'sender)))
- (if (equal eos::current-dbx-proc-id this-proc-id)
- (progn
- (eos::internal-clear-annotations t t t)
- ;; (return-tooltalk-message msg)
- ))))
-
-;;
-
-;;
-
-(defun eos::spro_detach (msg pat)
- ;; a detach notification has been received. this means dbx/debugger
- ;; is exiting
- (eos::internal-clear-annotations t t t t)
- (eos::dismiss-print-frame))
-
-(defun eos::spro_te_location (msg pat)
- ;; thread_id filename procname lineno filename procname lineno
- (let* ((filename-hollow
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (lineno-hollow
- (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
- (filename-solid
- (get-tooltalk-message-attribute msg 'arg_val 4))
- (lineno-solid
- (read (get-tooltalk-message-attribute msg 'arg_ival 6)))
- )
- (setq eos::current-solid-arrow
- (eos::make-annotation-visible eos::current-solid-arrow
- filename-solid
- lineno-solid
- 'debugger-solid-arrow))
- (if (or (not (equal filename-solid filename-hollow))
- (not (equal lineno-solid lineno-hollow)))
- (setq eos::current-hollow-arrow
- (eos::make-annotation-visible eos::current-hollow-arrow
- filename-hollow
- lineno-hollow
- 'debugger-hollow-arrow)))
-;; (return-tooltalk-message msg)
- ))
-
-(defun eos::spro_te_visit (msg pat)
- ;; thread_id filename procname lineno stackpos
- (let* ((filename
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (procname
- (get-tooltalk-message-attribute msg 'arg_val 2))
- (lineno
- (read (get-tooltalk-message-attribute msg 'arg_ival 3)))
- (stackpos
- (read (get-tooltalk-message-attribute msg 'arg_ival 4)))
- )
- (eos::make-annotation-invisible eos::current-hollow-arrow)
- (if (equal stackpos 1)
- (progn
- (eos::make-annotation-invisible eos::current-solid-arrow)
- (setq eos::current-solid-arrow
- (eos::make-annotation-visible eos::current-solid-arrow
- filename
- lineno
- 'debugger-solid-arrow))
- )
- (setq eos::current-hollow-arrow
- (eos::make-annotation-visible eos::current-hollow-arrow
- filename
- lineno
- 'debugger-hollow-arrow))
- )
-;; (return-tooltalk-message msg)
- (eos::visit-stack stackpos)
- ))
-
-;; generate a list of patterns
-;; so it can be registered and unregistered.
-
-
-(defun eos::create-debugger-patterns ()
- ;; returns a list of patterns
- (list
- (make-an-observer "SPRO_TE_STOPPED" 'eos::spro_te_stopped)
- (make-an-observer "SPRO_SE_STARTED" 'eos::clear-arrows)
- (make-an-observer "SPRO_TE_STEPPED" 'eos::clear-arrows)
- (make-an-observer "SPRO_TE_CONTINUED" 'eos::clear-arrows)
- (make-an-observer "SPRO_SE_DROPPED" 'eos::clear-arrows-stops)
- (make-an-observer "SPRO_SE_DEBUGGED" 'eos::update-clear-stops)
- (make-an-observer "SPRO_SE_REVIVED" 'eos::update-clear-arrows-stops)
- (make-an-observer "SPRO_SE_ATTACHED" 'eos::update-clear-arrows-stops)
- (make-an-observer "SPRO_SE_GONE" 'eos::clear-arrows)
- (make-an-observer "SPRO_TE_LOCATION" 'eos::spro_te_location)
- (make-an-observer "SPRO_TE_VISIT" 'eos::spro_te_visit)
- (make-an-observer "SPRO_TE_EVENTSET" 'eos::spro_te_eventset)
- (make-an-observer "SPRO_TE_EVENTDEL" 'eos::spro_te_eventdel)
- (make-an-observer "SPRO_DETACH" 'eos::spro_detach)
- ))
-
-(defun eos::register-debugger-patterns ()
- ;; register all dbx patterns
- (mapcar 'register-tooltalk-pattern eos::dbx-pattern-list)
- (eos::register-debugger-extra-patterns))
-
-(defun eos::unregister-debugger-patterns ()
- ;; unregister all dbx patterns
- (mapcar 'unregister-tooltalk-pattern eos::dbx-pattern-list)
- (eos::unregister-debugger-extra-patterns))
-
-(provide 'eos-debugger)
-
-;;; sun-eos-debugger.el ends here
+++ /dev/null
-;;; sun-eos-editor.el --- Implements the XEmacs/SPARCworks editor protocol
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks editor
-
-;;; Commentary:
-
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(require 'eos-common "sun-eos-common")
-
-;; ===============
-;; Editor protocol
-;;
-;; message is
-;; SPRO_Visit_File CONTEXT_UID filename lineno center==0
-
-(defvar eos::visit-file-pattern)
-(defvar eos::get-src-line-pattern)
-
-(defun eos::editor-startup ()
- ;; Actions to do at startup time for eos-editor
- (setq eos::visit-file-pattern
- (eos::create-visit-file-pattern))
- (setq eos::get-src-line-pattern
- (eos::create-get-src-line-pattern))
- (eos::register-get-src-line-pattern)
- )
-
-(defun eos::visit-file-callback (msg pat)
- ;; A callback for a SPRO_Visit_File message
- ;; really should be discarded in the pattern
- (let* ((filename
- (get-tooltalk-message-attribute msg 'arg_val 1))
- (lineno-dot
- (read
- (get-tooltalk-message-attribute msg 'arg_ival 2)))
- )
- (if (null (eos::find-line filename lineno-dot 'debugger-visit))
- (message "No frame to select"))
- (return-tooltalk-message msg)
- ))
-
-(defun eos::create-visit-file-pattern ()
- ;; Create Visit File pattern
- (let* ((pattern-desc '(category TT_HANDLE
- scope TT_SESSION
- class TT_REQUEST
- op "SPRO_Visit_File"
- callback eos::visit-file-callback))
- (pattern (make-tooltalk-pattern pattern-desc))
- )
- pattern
- ))
-
-(defun eos::register-visit-file-pattern ()
- ;; Register Visit File pattern
- (register-tooltalk-pattern eos::visit-file-pattern))
-
-(defun eos::unregister-visit-file-pattern ()
- ;; Unregister Visit File pattern
- (unregister-tooltalk-pattern eos::visit-file-pattern))
-
-;;
-;; ====================
-;;
-;; Auxiliary TT message to get source and lineno.
-;;
-;; message is
-;; SPRO_Get_Src_Line CONTEXT_UID (INOUT filename) (INOUT lineno)
-
-;;
-
-(defun eos::get-src-line-callback (msg pat)
- ;; A callback for a SPRO_Get_Src_Line message
- ;; really should be discarded in the pattern
- (let* ((filename
- (buffer-file-name))
- (lineno
- (format "%d" (eos::line-at (point)))))
- (set-tooltalk-message-attribute filename msg 'arg_val 1)
- (set-tooltalk-message-attribute lineno msg 'arg_val 2)
- (return-tooltalk-message msg)
- ))
-
-(defun eos::create-get-src-line-pattern ()
- ;; Create a pattern to get filename and lineno
- (let* ((pattern-desc '(category TT_HANDLE
- scope TT_SESSION
- class TT_REQUEST
- op "SPRO_Get_Src_Line"
- callback eos::get-src-line-callback))
- (pattern (make-tooltalk-pattern pattern-desc))
- )
- pattern
- ))
-
-(defun eos::register-get-src-line-pattern ()
- ;; Register Get Src Line pattern
- (register-tooltalk-pattern eos::get-src-line-pattern))
-
-(defun eos::unregister-get-src-line-pattern ()
- ;; Unregister Get Src Line pattern
- (unregister-tooltalk-pattern eos::get-src-line-pattern))
-
-(provide 'eos-editor)
-
-;;; sun-eos-debugger.el ends here
+++ /dev/null
-;;; sun-eos-init.el --- Initializes the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1996 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks initialize
-
-;;; Commentary:
-
-;; Initialize EOS
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-;; This stuff needs to be done at startup time
-(defun eos::start ()
- "Initialization needed at start-up time. Should be done by automatic
-loading of eos"
- (if (not (and (string-match "XEmacs" emacs-version)
- (emacs-version>= 19 12)))
- (error "Eos version %s only runs on XEmacs 19.12 and later"
- eos::version))
- (if (not noninteractive)
- (progn
- (eos::common-startup)
- (eos::editor-startup)
- (eos::debugger-startup)
- (eos::debugger-extra-startup)
- (eos::browser-startup)
- (eos::menubar-startup))))
-
-;(add-hook 'before-init-hook 'eos::start t) ; append to the end of hook list
-
-(provide 'eos-init)
-
-;;; sun-eos-init.el ends here
+++ /dev/null
-;;; sun-eos-load.el --- Loads the XEmacs/SPARCworks interface code
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks Debugger dbx
-
-;;; Commentary:
-
-;; Load EOS code
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(load "sun-eos-init" nil t)
-(load "sun-eos-common" nil t)
-(load "sun-eos-editor" nil t)
-(load "sun-eos-browser" nil t)
-(load "sun-eos-debugger" nil t)
-(load "sun-eos-debugger-extra" nil t)
-(load "sun-eos-menubar" nil t)
-;; don't load toolbar (load "sun-eos-toolbar" nil t)
-
-(provide 'eos-load)
-
-;;; sun-eos-load.el ends here
+++ /dev/null
-;;; sun-eos-menu.el --- Implements the XEmacs/SPARCworks menubar
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks menubar
-
-;;; Commentary:
-;; This file contains functions that populate a SPARCworks menu
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(require 'eos-common "sun-eos-common")
-
-(defun eos::toggle-sbrowser-selected-frame ()
- ;; Toggle whether this frame is selected for SBrowser
- (interactive)
- (if (equal eos::sbrowser-frame (selected-frame))
- (eos::select-sbrowser-frame nil)
- (eos::select-sbrowser-frame (selected-frame)))
- )
-
-(defun eos::toggle-debugger-selected-frame ()
- ;; Toggle whether this frame is selected for Debugger
- (interactive)
- (if (equal eos::debugger-frame (selected-frame))
- (eos::select-debugger-frame nil)
- (eos::select-debugger-frame (selected-frame)))
- )
-
-(defvar eos::long-menu
- '(
- ["Read and Execute a Dbx Command" eos::dbx-cmd (not (eq eos::key-mode 'none))]
- ["Run" eos::run (not (eq eos::key-mode 'none))]
- ["Fix" eos::fix (not (eq eos::key-mode 'none))]
- "-----"
- ["Print" eos::print (not (eq eos::key-mode 'none))]
- ["Print *" eos::print* (not (eq eos::key-mode 'none))]
- ["Dismiss Print" eos::dismiss-print-frame (not (eq eos::key-mode 'none))]
- "-----"
- ["Continue" eos::cont (not (eq eos::key-mode 'none))]
- ["Stop" eos::stop-at (not (eq eos::key-mode 'none))]
- ["Clear" eos::clear-at (not (eq eos::key-mode 'none))]
- ["Next" eos::next (not (eq eos::key-mode 'none))]
- ["Step" eos::step (not (eq eos::key-mode 'none))]
- ["Step Up" eos::step-up (not (eq eos::key-mode 'none))]
- ["Continue To" eos::cont-to (not (eq eos::key-mode 'none))]
- "-----"
- ["Stack Up" eos::up (not (eq eos::key-mode 'none))]
- ["Stack Down" eos::down (not (eq eos::key-mode 'none))]
- "-----"
- ("Start Tool and Enable Frame"
- ["Debugger" eos::start-debugger t]
- ["Dbx" eos::start-dbx t]
- ["SBrowser" eos::start-sbrowser t]
- )
- "-----"
- ["Enable Frame for SBrowser"
- eos::toggle-sbrowser-selected-frame
- :style toggle
- :selected (equal eos::sbrowser-frame
- (selected-frame))]
- ["Enable Frame for Debugger and Dbx"
- eos::toggle-debugger-selected-frame
- :style toggle
- :selected (equal eos::debugger-frame
- (selected-frame))]
- "-----"
- ["News..." eos::sw-news t]
- )
- )
-
-(defvar eos::short-menu
- '(
- ("Start Tool and Enable Frame"
- ["Debugger" eos::start-debugger t]
- ["Dbx" eos::start-dbx t]
- ["SBrowser" eos::start-sbrowser t]
- )
- "-----"
- ["Enable Frame for SBrowser"
- eos::toggle-sbrowser-selected-frame
- :style toggle
- :selected (equal eos::sbrowser-frame
- (selected-frame))]
- ["Enable Frame for Debugger and Dbx"
- eos::toggle-debugger-selected-frame
- :style toggle
- :selected (equal eos::debugger-frame
- (selected-frame))]
- "-----"
- ["News..." eos::sw-news t]
- )
- )
-
-(defun eos::menubar-startup ()
- ;; Actions to do at startup for eos-menubar.el
- (if (and (eq (device-type (selected-device)) 'x)
- (or (not (local-variable-p 'current-menubar (current-buffer)))
- (yes-or-no-p
- "SPARCworks menu will be local (menubar is buffer-local); proceed?")))
- (progn
- (add-menu-button '("Help") ["SPARCworks..." eos::sw-intro t])
- (add-submenu nil
- (append '("SPARCworks") (copy-tree eos::short-menu))
- "Version Control"
- )
- )))
-
-;;
-;; Insertion of text with a font
-;;
-
-(defun eos::insert-italics (a-string)
- (eos::insert-with-font a-string 'italic))
-
-(defun eos::insert-bold (a-string)
- (eos::insert-with-font a-string 'bold))
-
-(defun eos::insert-with-font (a-string a-font)
- (interactive "")
- (let (a b ext)
- (setq a (point))
- (insert a-string)
- (setq b (point))
- (setq ext (make-extent a b))
- (set-extent-face ext (find-face a-font))
- ))
-
-;;
-;; Generic insert code
-;;
-
-(defun eos::insert (s)
- (let ((len (length s))
- (pos 0)
- (newpos 0)
- (state 'normal))
- (while (< pos len)
- (setq newpos (string-match "#[bnir]" s pos))
- (if (and newpos (> newpos pos))
- (progn
- (cond ((equal (aref s (+ newpos 1)) ?b) ; bold
- (if (equal state 'normal)
- (progn
- (insert (substring s pos newpos))
- (setq state 'bold))
- (error "found bold when not in normal")))
- ((equal (aref s (+ newpos 1)) ?r) ; red
- (if (equal state 'normal)
- (progn
- (insert (substring s pos newpos))
- (setq state 'red))
- (error "found red when not in normal")))
- ((equal (aref s (+ newpos 1)) ?i) ; italics
- (if (equal state 'normal)
- (progn
- (insert (substring s pos newpos))
- (setq state 'italics))
- (error "found italics when not in normal")))
- ((equal (aref s (+ newpos 1)) ?n) ; normal
- (cond ((equal state 'italics)
- (eos::insert-italics (substring s pos newpos))
- (setq state 'normal))
- ((equal state 'bold)
- (eos::insert-bold (substring s pos newpos))
- (setq state 'normal))
- ((equal state 'normal)
- (error "found normal when in normal"))))
- (t
- (error "internal error"))
- )
- (setq pos (+ newpos 2))
- )
- (if (equal state 'normal)
- (progn
- (insert (substring s pos))
- (setq pos len))
- (error "eos::insert with unclosed special font"))
- ))
- ))
-
-;;
-;; Introduction File
-;;
-
-(defun eos::sw-intro ()
- "Generate an intro buffer."
- (interactive)
- (let ((buffer1 (get-buffer-create " *SPARCworks Intro*"))
- )
- (switch-to-buffer buffer1)
- (setq buffer-read-only nil)
- (delete-region (point-min) (point-max))
- (eos::insert "
- #bSPARCworks Editor Integration#n
- Eos is copyright (c) 1995 by Sun Microsystems.
-
-#bIntroduction (for Eos 1.5.x)#n
-
-#iSPARCworks#n is a set of integrated programming tools from SunSoft that
-support the program development cycle. #iXEmacs#n is a version of the Emacs
-editor that includes interfaces to the selection service and to the
-#iToolTalk#n service. The #iEos#n package uses these two interfaces to provide
-a simple yet useful editor integration with three SPARCworks tools:
-the #iSourceBrowser#n, the #iDebugger#n and #iDbx#n. Eos requires XEmacs 19.12
-or above, and SW3.0.1 or above.
-
-When used with Eos, the Debugger and SourceBrowser do not include a
-source pane for displaying of sources and instead use an XEmacs frame.
-Then the user can interact with the XEmacs frame in a way very similar
-to how the source panes of the SW tools would be used. The user can also
-start Dbx and request that sources be shown in XEmacs.
-
-#bSimple Startup#n
-
-In most cases, the user will start an interaction with Eos as follows:
-
- (1) Start XEmacs,
-
- (2) Load \"eos.el\" to add a SPARCworks submenu to the menubar (this
-step might not be needed if Eos is preloaded to your XEmacs binary), and
-
- (3) On some XEmacs frame use the SPARCworks submenu and start the
-desired tool and simultaneously enable that frame to display sources.
-
-The toolbar for the enabled frame will change after (3) to show that
-this frame will behave as the source display for the SW tool and to
-indicate that some actions on the tool can be performed from this frame.
-
-The actions available depend on the SW tool. The interaction model for
-the Debugger and the SourceBrowser can be described as #iselect on the
-XEmacs frame and then click on the button on the SW tool#n. As an example,
-a browser query can be performed by selecting some text and then clicking
-on the query button on the SBrowser tool; the source for the first match
-will appear in the XEmacs frame, together with a glyph showing the match.
-
-The Debugger and Dbx can also be driven from XEmacs. Most frequently
-this will be done using the ToolBar. Entries in the toolbar of a frame
-enabled for debugging are deactivated when there is not enough information
-to invoke their associated commands (due to technical reasons, it is
-necessary for XEmacs to have had a frame enabled for Debugger/Dbx when
-a debug or attach command was issued to Debugger/Dbx to make most toolbar
-commands active). As an example, to set a breakpoint at some line, select
-a position in that line and then click on the toolbar icon with the stop
-with the arrow inside.
-
-#bDetails#n
-
-#iManual Startup#n
-
-In the scenario described above, the user simultaneously starts a tool
-and enables a frame for that tool. The two actions can also be done
-independently. The tools (Source Browser, Debugger, and Dbx) have to
-be started with the \"-editor\" option and the XEmacs frame can be
-enabled manually using the SPARCworks submenu. The most common use
-of this feature is to disable and re-enable a frame, be it to recover
-the default toolbar, or to avoid conflicts with other active tools
-(see the paragraph below on multiple active tools).
-
-#iFrame Enabling#n
-
-At any given time there can be at most one frame enabled to display
-Source Browser sources, and at most one frame enabled to display
-Debugger and Dbx sources. The same XEmacs frame can be used for both
-types of sources. The toolbar of an enabled frame always starts with
-an informational icon. This icon is a large-font #ii#n with either a
-smaller-font #iB#n, if the frame has browsing enabled, and/or a smaller-font
-#iD#n, if the frame has debugging enabled.
-
-If no frames are enabled for a given tool, the editor integration for
-that tool is disabled. This means that XEmacs deregisters the TT
-patterns relevant to this tool, and XEmacs does not receive any
-messages from that tool.
-
-#iMultiple Active Tools#n
-
-In order to provide a simpler user model, Eos has no provisions to
-#igracefully#n support more than one simultaneous active tool of a
-given class per TT session. A Debugger and a SourceBrowser, or a Dbx
-and a SourceBrowser, can coexist gracefully, but a Debugger and a Dbx
-cannot, and neither can two SourceBrowsers, two Debuggers, or two
-dbxs. This simplification is consistent with the needs of most users.
-
-The implementation of Eos notifies the user if she attempts to start two
-conflicting tools, but it does not enforce the restriction. In some
-cases two conflicting tools can be used profitably by a careful user,
-but in others the result is likely to be chaos. An example of the first
-is using two SourceBrowsers, and one of the later is attempting to send
-debugging commands from XEmacs to two debuggers.
-
-If a user really needs to have multiple active tools, she can do this
-in a safe way by creating several TT sessions (e.g. using #ittsession
--c /bin/csh#n, see the man page for ttsession), and placing the tools
-with their own XEmacses in separate TT sessions.
-
-#iA Visual Data Inspector in XEmacs#n
-
-Users that choose to drive the debugger from XEmacs also have
-available a #ivery simple#n but fast visual data inspector. The results
-of #iprint#n and #iprint*#n commands are formatted into an XEmacs buffer
-(#i\"*Eos Print Output*\"#n) and presented into a separate frame.
-This frame is mapped and unmapped so that, except for the first time,
-it appears quickly.
-
-#iBuffers for Debugger/Dbx Interaction#n
-
-When starting dbx as a subprocess, a buffer will be created to interact
-with dbx. The name of this buffer is of the form #i\"*Eos dbx*\"#n.
-
-If a dbx engine is receiving requests from both Debugger and XEmacs
-(e.g. it was started via #idebugger -editor#n), the responses to
-commands sent by XEmacs will be shown in the echo area and will be
-recorded in a read-only buffer (#i\"*Eos Debugger Log*\"#n), but responses
-to Debugger commands will not appear. Conversely, responses to Debugger
-commands will appear in the Debugger transcript pane but not in XEmacs's
-log buffer. This is a limitation of the underlying TT protocols.
-
-#bTTY Support#n
-
-Although tty support is not an official part of Eos, it is possible
-with some extra effort and specialized knowledge from the user.
-
-#iStarting a ToolTalk Session#n
-
-Eos requires a ToolTalk communication. This may require starting a TT
-session by:
-
- (0) Start a ToolTalk session, and a shell so that all processes
-started from this shell will use the new TT session. Do this by
-executing \"ttsession -c /bin/csh\" - or whatever shell you use
-
-At this point, you can start your XEmacs on that shell, as shown in
-step (1) above. Note that, since there is no TTY toolbar in 19.12
-(nor 19.13), an alternative mechanism must be used to enable the
-(tty) frame.
-
-A typical use for tty is to interact with dbx. The command
-#ieos::start-dbx#n will select the tty frame for debugging and will start
-a dbx buffer. From this point on, dbx will use this tty frame to show
-its sources. The introduction and news messages can be generated
-using the commands #ieos::sw-intro#n and #ieos::sw-news#n. You can interact
-with the dbx subprocess by typing to its associated input buffer or
-using some key bindings.
-
-#iKey Bindings#n
-
-A tty user can interact with Eos by invoking directly the Eos
-commands, evaluating elisp expressions, or through some key-bindings.
-The expert user may provide her own key bindings. Eos also provides two
-set of global bindings, which are activated by evaluating the
-expressions (eos::set-key-mode 'prefix) or (eos::set-key-mode
-'function).
-
-#bKnown Bugs#n
-
-Due to a bug in the internal subprocess machinery of XEmacs 19.12, the
-default prompt of dbx subprocesses will show the full path to the binary.
-The prompt can be overridden using the ksh variable PS1\; one way to do
-this is by adding the following line to your ~/.dbxrc:
-
- PS1='(dbx) '
-
-#bFeedback#n
-
-You are encouraged to send us feedback via the Comments button in
-the About Box of either SPARCworks tool, or directly to
-eos-comments@cs.uiuc.edu.
-
-#bEnjoy.#n")
- (setq buffer-read-only t)
- (goto-char (point-min))
- (view-mode nil 'kill-buffer) ;; assume the new view-less
- ))
-
-;;
-;; Cheat Sheets for keyboard mappings
-;;
-;; This depends on the mapping being used!
-;;
-
-(defun eos::sw-cheat-sheet ()
- "Generate buffer that has a description of the key maps that can be
-printed, cut and then taped somewhere (like on the keyboard or on your
-monitor). This is particularly useful for the function keys"
- (interactive)
- (let ((buffer1 (get-buffer-create " *Cheat Sheets*"))
- )
- (switch-to-buffer buffer1)
- (setq buffer-read-only nil)
- (delete-region (point-min) (point-max))
- (eos::insert "
- #bCheat Sheets for Eos#n
-
-This buffer has a description of the key maps that can be printed, cut
-and then taped somewhere (like on the keyboard or on your monitor).
-This is particularly useful for the function keys since their numbers
-don't any particular mnemonic value.
-
-
-#bWhen using function keys#n #i[Options->SPARCworks->Use Function Keys]#n
-
-----------------------------------------
-
-F6 F7 F8 F9
-
-Do Print Cont ---- Next
-Run Print* Stop <Ctrl> Step
-Fix Dismiss Clear <Shft> Step Up
-
-
-----------------------------------------
-
-#bWhen using prefix map#n #i[Options->SPARCworks->Use C-c d Prefix Map]#n
-
-----------------------------------------
-Basic prefix: C-c d
-
-
- Do %
- Run r
- Fix f
-
- Print p
- Print* C-p
-
- Cont c
- Stop b (for breakpoint)
- Clear C-b
-
- Next n
- Step s
- Step up C-s
-
- Up u
- Down d
-----------------------------------------
-
-")
- (setq buffer-read-only t)
- (goto-char (point-min))
- (view-mode nil 'kill-buffer) ;; assume the new view-less
- ))
-
-;;
-;; News files
-;;
-
-(defun eos::sw-news ()
- "Generate a News buffer."
- (interactive)
- (let ((buffer1 (get-buffer-create " *Eos News*"))
- )
- (switch-to-buffer buffer1)
- (setq buffer-read-only nil)
- (delete-region (point-min) (point-max))
- (eos::insert "
- #bEos News#n
-
-See the #iHelp#n top-level menu for additional information on the
-SPARCworks lightweight editor integration (Eos). The current version
-of Eos is available as the contents of the variable eos::version.
-
-#bversion 1.5.2#n
-
- Support for 19.12 and 19.13. Works on TTYs. Uses real ToolBar.
- Toolbars for debugger & content inspector are frame-local.
- Better icons and glyphs. Support for (load-library \"eos\").
- Ease-of-use: startup for tools.
- Icon files are now defined \"in-line\" to simplify administration.
-
- Removed the following to simplify use:
- - Textual toolbar (from 1.4).
- - Option submenu to add keymaps for debugger use.
- - Popup menu.
- - Any pretenses to support SW3.0; use SW3.0.1 instead.
-
-#bversion 1.4.1#n
-
- Added eos::add-button interface.
-
-#bversion 1.4#n
-
- Added toolbar like in dbxtool. Toolbar uses echo-help to show
- meaning of buttons, (setq inhibit-help-echo t) if you don't
- want it.
-
- Selection now remains after \"print\"-like commands. Now it
- is possible to have the *debugger* buffer in the frame selected
- for displaying debugged sources.
-
- Added a command to relayout debugger buffers so they show in
- a layout similar to that of dbxtool.
-
-#bversion 1.3#n
-
- Provided popup-menu bindings for those debugger actions
- that operate on the contents of the selection or its position;
- selectable via options.
-
- The *debugger* buffer now support M-p and M-n.
-
-#bversion 1.2#n
-
- Better support for interactions via *debugger* buffer and directly
- using a prefix map and function keys.
-
- Converted to use new toggle and radio menus, reorganizing
- SPARCworks menu to factor out help and options into submenus,
- which are now available under the Options and Help top-level menus.
-
-#bversion 1.1#n
-
- Some internal cleanup.
-
- Eos now provides basic machinery to drive the debugger
- engine directly using ToolTalk messages. This feature is
- not yet very well polished. You can try using it at your own risk,
- or await for release 1.2 (soon to come) that will provide a better
- interface and improved functionality, as well as documentation
- for the interface.
-
-#bversion 1.0#n
-
- First widely available release. Supports simple #iselect and click#n model.
-
-#bPossible Future Enhancements#n
-
-* Add a \"peek-in-source\" mechanism to show the values of
- expressions in the sources.
-
-* The comint package should be generalized to allow for TT-based
- interpreters and it should be used in Eos.
-
-* Key & popup bindings should probably be a minor mode (currently
- it conflicts with cc-mode).
-
-* Should support locking a print frame to force new print frames. Also,
- should allow for following fields in print frames.
-
-
-#bFeedback#n
-
- Send feedback to #ieos-comments@cs.uiuc.edu#n")
- (setq buffer-read-only t)
- (goto-char (point-min))
- (view-mode nil 'kill-buffer) ;; assume the new view-less
- ))
-
-(provide 'eos-menubar)
-
-;;; sun-eos-debugger.el ends here
+++ /dev/null
-;;; sun-eos-toolbar.el --- Implements the EOS toolbar interface
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks toolbar
-
-;;; Commentary:
-
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(defvar eos::toolbar-icon-directory
- (file-name-as-directory (locate-data-directory "eos")))
-
-(defvar eos::toolbar-run-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". s FgColor c #000000000000\",
-\"X c #0000FFFF0000\",
-\"+ c #000077770000\",
-\"@ c #000044440000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ....... \",
-\" \",
-\" ..... \",
-\" .X+@. ....... \",
-\" .X+@. \",
-\" ......@.... \",
-\" .XXX++++. ....... \",
-\" .XX++@. \",
-\" .@+@. \",
-\" .@. ....... \",
-\" . \",
-\" \",
-\" ....... \",
-\" \",
-\" \",
-\" ....... \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-run.xbm" eos::toolbar-icon-directory)))
- "A Run icon pair.")
-
-(defvar eos::toolbar-type-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 2 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\"X c #000000000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" XX XX \",
-\" XX XX \",
-\" XXXX XXXX XX XX \",
-\" XX XX XX XX XX XX XXX X \",
-\" XX XX XX XX XXX X X X \",
-\" XX XX XX XX X XXXX \",
-\" XX XX XX XX XXX XXXX \",
-\" XX XX XX XX XX XX X X X \",
-\" XXX XXX XX XX X XXX \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-type.xbm" eos::toolbar-icon-directory)))
- "A Type-at icon pair.")
-
-
-(defvar eos::toolbar-stop-at-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #4B4B4B4B4B4B\",
-\"X c #FFFFFFFFFFFF\",
-\"o c #AFAFAFAFAFAF\",
-\"O c #FFFF00000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ........ \",
-\" .XXXXXXXX. \",
-\" .XoOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOXOOOOOoX. \",
-\" .XOOOOOOOOOXXOOOOOX. \",
-\" .XOOOOXXXXXXXXOOOOX. \",
-\" .XOOOOXXXXXXXXXOOOX. \",
-\" .XOOOOXXXXXXXXOOOOX. \",
-\" .XOOOOOOOOOXXOOOOOX. \",
-\" .XOOOOOOOOOXOOOOOOX. \",
-\" .XoOOOOOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOOOOX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOoX. \",
-\" .XXXXXXXX. \",
-\" ........ \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-stop.xbm" eos::toolbar-icon-directory)))
- "A Stop At icon pair.")
-
-(defvar eos::toolbar-clear-at-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #4B4B4B4B4B4B\",
-\"X c #FFFFFFFFFFFF\",
-\"o c #AFAFAFAFAFAF\",
-\"O c #FFFF00000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ........ \",
-\" .XXXXXXXX. \",
-\" .XoOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOOOoX. \",
-\" .XoOOOXXOOOOXXOOOoX. \",
-\" .XOOOOOXXOOXXOOOOOX. \",
-\" .XOOOOOOXXXXOOOOOOX. \",
-\" .XOOOOOOOXXOOOOOOOX. \",
-\" .XOOOOOOXXXXOOOOOOX. \",
-\" .XOOOOOXXOOXXOOOOOX. \",
-\" .XOOOOXXOOOOXXOOOOX. \",
-\" .XoOOOXOOOOOOXOOOoX. \",
-\" .XoOOOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOoX. \",
-\" .XXXXXXXX. \",
-\" ........ \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-clear-at.xbm" eos::toolbar-icon-directory)))
- "A Clear At icon pair.")
-
-(defvar eos::toolbar-stop-in-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #4B4B4B4B4B4B\",
-\"X c #FFFFFFFFFFFF\",
-\"o c #AFAFAFAFAFAF\",
-\"O c #FFFF00000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ........ \",
-\" .XXXXXXXX. \",
-\" .XoOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOOXOXOOoX. \",
-\" .XOOOXXXXOOXOOOXOOX. \",
-\" .XOOOXOOOOOXOOOXOOX. \",
-\" .XOOOXOOOOOXOOOXOOX. \",
-\" .XOOOXXXOOXOOOOOXOX. \",
-\" .XOOOXOOOOOXOOOXOOX. \",
-\" .XOOOXOOOOOXOOOXOOX. \",
-\" .XoOOXOOOOOXOOOXOoX. \",
-\" .XoOOOOOOOOXOXOoX. \",
-\" .XoOOOOOOOOOOoX. \",
-\" .XoOOOOOOOOoX. \",
-\" .XoOOOOOOoX. \",
-\" .XXXXXXXX. \",
-\" ........ \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-stop-in.xbm" eos::toolbar-icon-directory)))
- "A Stop in icon pair.")
-
-(defvar eos::toolbar-step-into-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\"O c #0000FFFF0000\",
-\"+ c #000077770000\",
-\"@ c #000044440000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ..... ....... \",
-\" .OOOO. \",
-\" .O++++. \",
-\" .O+.... ........ \",
-\" .O+. \",
-\" .O+. . \",
-\" .O+. .. \",
-\" .O+. .O. \",
-\" .O+...O@. ....... \",
-\" .O++OOO+@. \",
-\" .O+++++++@. \",
-\" .++++++@. ....... \",
-\" ....O@. \",
-\" .O. \",
-\" .. ....... \",
-\" . \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-step-into.xbm" eos::toolbar-icon-directory)))
- "A Step Into icon pair.")
-
-(defvar eos::toolbar-step-up-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\"O c #0000FFFF0000\",
-\"+ c #000077770000\",
-\"@ c #000044440000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" . \",
-\" .. ....... \",
-\" .O. \",
-\" ....O@. \",
-\" .++++++@. ....... \",
-\" .O+++++++@. \",
-\" .O++OOO+@. \",
-\" .O+...O@. ....... \",
-\" .O+. .O. \",
-\" .O+. .. \",
-\" .O+. . \",
-\" .O+. \",
-\" .O+.... ........ \",
-\" .O++++. \",
-\" .OOOO. \",
-\" ..... ....... \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-step-up.xbm" eos::toolbar-icon-directory)))
- "A Step up icon pair.")
-
-(defvar eos::toolbar-step-over-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\"X c #0000FFFF0000\",
-\"+ c #000077770000\",
-\"@ c #000044440000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ..... \",
-\" .XXXX. ....... \",
-\" .X++++. \",
-\" .X+.... \",
-\" .X+. ....... \",
-\" .X+. . \",
-\" .X+. .. \",
-\" .X+. .X. ....... \",
-\" .X+...X@. \",
-\" .X++XXX+@. \",
-\" .X+++++++@. ....... \",
-\" .++++++@. \",
-\" ....X@. \",
-\" .X. ....... \",
-\" .. \",
-\" . \",
-\" ....... \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-step-over.xbm" eos::toolbar-icon-directory)))
- "A Step Over icon pair.")
-
-(defvar eos::toolbar-evaluate-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 2 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" .... \",
-\" .. .. ...... \",
-\" .. .. ...... \",
-\" .. .. \",
-\" .. .. ...... \",
-\" .. .. ...... \",
-\" .... \",
-\" .. \",
-\" .. \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-evaluate.xbm" eos::toolbar-icon-directory)))
- "A Evaluate icon pair.")
-
-(defvar eos::toolbar-evaluate-star-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 2 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\"X c #000000000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" XX XX \",
-\" XXX \",
-\" XXXXXXX \",
-\" XXX XXXX \",
-\" XX XX XX XX XXXXXX \",
-\" XX XX XXXXXX \",
-\" XX XX \",
-\" XX XX XXXXXX \",
-\" XX XX XXXXXX \",
-\" XXXX \",
-\" XX \",
-\" XX \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-evaluate-star.xbm" eos::toolbar-icon-directory)))
- "A Evaluate Star icon pair.")
-
-(defvar eos::toolbar-fix-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 8 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #7D7D7D7D7D7D\",
-\"X c #000000000000\",
-\"o c #FFFFFFFF0000\",
-\"O c #FFFF99990000\",
-\"+ c #FFFFCCCC3333\",
-\"@ c #CCCC9999FFFF\",
-\"# c #99996666CCCC\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" .XX. \",
-\" XoOXX. \",
-\" .Xo+OOXXX. \",
-\" Xo++++OOOXXX \",
-\" .Xo+++++++OOOX. \",
-\" Xo++++++OOOXX. \",
-\" .Xo++++OOXXX. \",
-\" Xo++OOOXX. \",
-\" .XoOOOXXXXXXXXXXXX \",
-\" XoOXXX@@@@@@@@@@@X \",
-\" XXX##############X \",
-\" X@##############X \",
-\" XXXXXXXXXXXXXXXXX \",
-\" X@@@@X X@@@@X \",
-\" X@###X X@###X \",
-\" X@###X X@###X \",
-\" X@###X X@###X \",
-\" X@###X X@###X \",
-\" XXXXXX XXXXXX \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-fix.xbm" eos::toolbar-icon-directory)))
- "A Fix icon pair.")
-
-(defvar eos::toolbar-run2-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". s FgColor c #000000000000\",
-\"X c #0000FFFF0000\",
-\"o c #000077770000\",
-\"O c #000044440000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" . \",
-\" .. \",
-\" .X. \",
-\" ............XX. \",
-\" .XXXXXXXXXXXXoX. \",
-\" .XoooooooooooooX. \",
-\" .Xooooooooooooooo. \",
-\" .XoooooooooooooO. \",
-\" .oOOOOOOOOOOOoO. \",
-\" ............OO. \",
-\" .O. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-run2.xbm" eos::toolbar-icon-directory)))
- "A Run icon pair.")
-
-(defvar eos::toolbar-cont-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 6 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\"O c #0000FFFF0000\",
-\"+ c #000077770000\",
-\"@ c #000044440000\",
-\"o c #FFFF00000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ..... ....... \",
-\" .OOOO. \",
-\" .O++++. \",
-\" .O+.... ........ \",
-\" .O+. \",
-\" .O+. . \",
-\" .O+. .. \",
-\" .O+. .O. \",
-\" .O+...O@. .. \",
-\" .O++OOO+@. .oo. \",
-\" .O+++++++@. .oooo. \",
-\" .++++++@. .oooo. \",
-\" ....O@. .oo. \",
-\" .O. .. \",
-\" .. \",
-\" . \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-cont.xbm" eos::toolbar-icon-directory)))
- "A Cont icon pair.")
-
-
-(defvar eos::toolbar-up-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 8 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". s FgColor c #000000000000\",
-\"X c #CCCC9999FFFF\",
-\"o c #99996666CCCC\",
-\"O c #FFFFFFFF0000\",
-\"+ c #FFFFCCCC3333\",
-\"@ c #0000FFFF0000\",
-\"# c #000077770000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" . \",
-\" ... \",
-\" ........ ..... \",
-\" .XXXXXX. ....... \",
-\" .Xooooo. ... \",
-\" .Xooooo. ... \",
-\" .Xooooo. ... \",
-\" .Xooooo. ... \",
-\" .O+++++. ... \",
-\" .O+++++. ... \",
-\" .O+++++. \",
-\" .O+++++. \",
-\" .O+++++. \",
-\" .@#####. \",
-\" .@#####. \",
-\" .@#####. \",
-\" .@#####. \",
-\" .@#####. \",
-\" ........ \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-up.xbm" eos::toolbar-icon-directory)))
- "A Up icon pair.")
-
-(defvar eos::toolbar-down-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 8 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". s FgColor c #000000000000\",
-\"X c #CCCC9999FFFF\",
-\"o c #99996666CCCC\",
-\"O c #FFFFFFFF0000\",
-\"+ c #FFFFCCCC3333\",
-\"@ c #0000FFFF0000\",
-\"# c #000077770000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ........ \",
-\" .XXXXXX. \",
-\" .Xooooo. \",
-\" .Xooooo. \",
-\" .Xooooo. \",
-\" .Xooooo. \",
-\" .O+++++. ... \",
-\" .O+++++. ... \",
-\" .O+++++. ... \",
-\" .O+++++. ... \",
-\" .O+++++. ... \",
-\" .@#####. ... \",
-\" .@#####. ....... \",
-\" .@#####. ..... \",
-\" .@#####. ... \",
-\" .@#####. . \",
-\" ........ \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-down.xbm" eos::toolbar-icon-directory)))
- "A Down icon pair.")
-
-(defvar eos::toolbar-build-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 8 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\". c #000000000000\",
-\"X c #CCCC9999FFFF\",
-\"o c #99996666CCCC\",
-\"O c #FFFFFFFF0000\",
-\"+ c #FFFFCCCC3333\",
-\"@ c #FFFF99990000\",
-\"# c #FFFF66666666\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" ...... \",
-\" .XXXX. \",
-\" .Xooo. \",
-\" .Xooo. \",
-\" .Xooo. \",
-\" .Xooo. \",
-\" . .Xooo. \",
-\" .O. .Xooo. \",
-\" .O+@. .Xooo. \",
-\" .O+++@. .Xooo. \",
-\" .O+++++@..Xooo. \",
-\" .O+++++++@.Xooo. \",
-\" .O+++.............. \",
-\" .O@@@@. . \",
-\" ....... ###########. \",
-\" . ###########. \",
-\" . ###########. \",
-\" .............. \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-build.xbm" eos::toolbar-icon-directory)))
- "A Build icon pair.")
-
-(defvar eos::toolbar-dismiss-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * file[] = {
-\"28 28 5 1\",
-\" c #C8C8C8C8C8C8 s backgroundToolBarColor\",
-\"X c #4B4B4B4B4B4B\",
-\". c #FFFFFFFFFFFF\",
-\"o c #AFAFAFAFAFAF\",
-\"O c #FFFF00000000\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" X X \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" XXXX \",
-\" XX \",
-\" XXXX \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" XX XX \",
-\" X X \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- (toolbar-make-button-list
- (expand-file-name "eos-dismiss.xbm" eos::toolbar-icon-directory)))
- "A Dismiss icon pair.")
-
-(defvar eos::toolbar-intro-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * info[] = {
-\"28 28 2 1\",
-\"X c Gray75 s backgroundToolBarColor\",
-\"o c #000077770000\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXoooooooXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXoooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXoooooooXXXXXXXXXXX\",
-\"XXXXXXXXXoooooooooXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};")
- (toolbar-make-button-list
- (expand-file-name "eos-intro.xbm" eos::toolbar-icon-directory)))
- "An intro icon pair.")
-
-(defvar eos::toolbar-introD-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * info[] = {
-\"28 28 2 1\",
-\"X c Gray75 s backgroundToolBarColor\",
-\"o c #000077770000\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXoooooooXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXoooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXoooXXXXXXoooooXXXXXXXXXXXX\",
-\"XXoXXoXXXXXoooooXXXXXXXXXXXX\",
-\"XXoXXoXXXXoooooooXXXXXXXXXXX\",
-\"XXoXXoXXXoooooooooXXXXXXXXXX\",
-\"XXoXXoXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXoXXoXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXoooXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};")
- (toolbar-make-button-list
- (expand-file-name "eos-introD.xbm" eos::toolbar-icon-directory)))
- "An intro icon pair.")
-
-(defvar eos::toolbar-introDB-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * info[] = {
-\"28 28 2 1\",
-\"X c Gray75 s backgroundToolBarColor\",
-\"o c #000077770000\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXoooooooXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXoooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXoooXXXXXXoooooXXXXXXoooXXX\",
-\"XXoXXoXXXXXoooooXXXXXXoXXoXX\",
-\"XXoXXoXXXXoooooooXXXXXoXXoXX\",
-\"XXoXXoXXXoooooooooXXXXoooXXX\",
-\"XXoXXoXXXXXXXXXXXXXXXXoXXoXX\",
-\"XXoXXoXXXXXXXXXXXXXXXXoXXoXX\",
-\"XXoooXXXXXXXXXXXXXXXXXoooXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};")
- (toolbar-make-button-list
- (expand-file-name "eos-introDB.xbm" eos::toolbar-icon-directory)))
- "An intro icon pair.")
-
-(defvar eos::toolbar-introB-icon
- (if (featurep 'xpm)
- (toolbar-make-button-list
- "/* XPM */
-static char * info[] = {
-\"28 28 2 1\",
-\"X c Gray75 s backgroundToolBarColor\",
-\"o c #000077770000\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXoooooooXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXoXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\",
-\"XXXXXXXXXXooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXoooooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXXXXXXX\",
-\"XXXXXXXXXXXoooooXXXXXXoooXXX\",
-\"XXXXXXXXXXXoooooXXXXXXoXXoXX\",
-\"XXXXXXXXXXoooooooXXXXXoXXoXX\",
-\"XXXXXXXXXoooooooooXXXXoooXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXoXXoXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXoXXoXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXoooXXX\",
-\"XXXXXXXXXXXXXXXXXXXXXXXXXXXX\"};")
- (toolbar-make-button-list
- (expand-file-name "eos-introB.xbm" eos::toolbar-icon-directory)))
- "An intro icon pair.")
-
-
-(defvar eos::debugger-toolbar
- '(
- [eos::toolbar-introD-icon
- eos::sw-intro
- t
- "Show Introduction to Eos"]
- [eos::toolbar-stop-at-icon
- eos::stop-at
- eos::current-debugger-clique-id
- "stop at: Stop at selected position"]
- [eos::toolbar-stop-in-icon
- eos::stop-in
- eos::current-debugger-clique-id
- "stop in: Stop in function whose name is selected"]
- [eos::toolbar-clear-at-icon
- eos::clear-at
- eos::current-debugger-clique-id
- "clear at: Clear at selected position"]
- [eos::toolbar-run-icon
- eos::run
- eos::current-debugger-clique-id
- "run: Run current program"]
- [eos::toolbar-evaluate-icon
- eos::print
- eos::current-debugger-clique-id
- "print: Evaluate selected expression; shows in separate XEmacs frame"]
- [eos::toolbar-evaluate-star-icon
- eos::print*
- eos::current-debugger-clique-id
- "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
- [eos::toolbar-up-icon
- eos::up
- eos::current-debugger-clique-id
- "up: move in stack towards \"cooler\" (less recently visited) frames"]
- [eos::toolbar-down-icon
- eos::down
- eos::current-debugger-clique-id
- "down: move in stack towards \"warmer\" (more recently visited) frames)"]
- [eos::toolbar-cont-icon
- eos::cont
- eos::current-debugger-clique-id
- "cont: Continue current program"]
- [eos::toolbar-step-over-icon
- eos::next
- eos::current-debugger-clique-id
- "next: Step over subprogram calls"]
- [eos::toolbar-step-into-icon
- eos::step
- eos::current-debugger-clique-id
- "step: Step into subprogram calls)"]
- [eos::toolbar-step-up-icon
- eos::step-up
- eos::current-debugger-clique-id
- "step up: Step up from subprogram calls)"]
- [eos::toolbar-build-icon
- eos::build
- eos::current-debugger-clique-id
- "make: Build target"]
- [eos::toolbar-fix-icon
- eos::fix
- eos::current-debugger-clique-id
- "fix: Fix file"]
- [eos::toolbar-type-icon
- eos::type
- (or (and (eq eos::dbx-or-debugger 'debugger)
- eos::current-debugger-clique-id)
- (and (eq eos::dbx-or-debugger 'dbx)
- (eos::dbx-process)
- (eq (process-status (eos::dbx-process)) 'run)))
- "Type a Dbx command"]
- ))
-
-(defvar eos::debugger-sbrowser-toolbar
- '(
- [eos::toolbar-introDB-icon
- eos::sw-intro
- t
- "Show Introduction to Eos"]
- [eos::toolbar-stop-at-icon
- eos::stop-at
- eos::current-debugger-clique-id
- "stop at: Stop at selected position"]
- [eos::toolbar-stop-in-icon
- eos::stop-in
- eos::current-debugger-clique-id
- "stop in: Stop in function whose name is selected"]
- [eos::toolbar-clear-at-icon
- eos::clear-at
- eos::current-debugger-clique-id
- "clear at: Clear at selected position"]
- [eos::toolbar-run-icon
- eos::run
- eos::current-debugger-clique-id
- "run: Run current program"]
- [eos::toolbar-evaluate-icon
- eos::print
- eos::current-debugger-clique-id
- "print: Evaluate selected expression; shows in separate XEmacs frame"]
- [eos::toolbar-evaluate-star-icon
- eos::print*
- eos::current-debugger-clique-id
- "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
- [eos::toolbar-up-icon
- eos::up
- eos::current-debugger-clique-id
- "up: move in stack towards \"cooler\" (less recently visited) frames"]
- [eos::toolbar-down-icon
- eos::down
- eos::current-debugger-clique-id
- "down: move in stack towards \"warmer\" (more recently visited) frames)"]
- [eos::toolbar-cont-icon
- eos::cont
- eos::current-debugger-clique-id
- "cont: Continue current program"]
- [eos::toolbar-step-over-icon
- eos::next
- eos::current-debugger-clique-id
- "next: Step over subprogram calls"]
- [eos::toolbar-step-into-icon
- eos::step
- eos::current-debugger-clique-id
- "step: Step into subprogram calls)"]
- [eos::toolbar-step-up-icon
- eos::step-up
- eos::current-debugger-clique-id
- "step up: Step up from subprogram calls)"]
- [eos::toolbar-build-icon
- eos::build
- eos::current-debugger-clique-id
- "make: Build target"]
- [eos::toolbar-fix-icon
- eos::fix
- eos::current-debugger-clique-id
- "fix: Fix file"]
- [eos::toolbar-type-icon
- eos::type
- (or (and (eq eos::dbx-or-debugger 'debugger)
- eos::current-debugger-clique-id)
- (and (eq eos::dbx-or-debugger 'dbx)
- (eos::dbx-process)
- (eq (process-status (eos::dbx-process)) 'run)))
- "Type a Dbx command"]
- ))
-
-(defvar eos::sbrowser-toolbar
- '([eos::toolbar-introB-icon
- eos::sw-intro
- t
- "Show Introduction to Eos"]
- ))
-
-(defvar eos::print-toolbar
- '(
- [eos::toolbar-intro-icon
- eos::sw-intro
- t
- "Show Introduction to Eos"]
- [eos::toolbar-evaluate-icon
- eos::print
- eos::current-debugger-clique-id
- "print: Evaluate selected expression; shows in separate XEmacs frame"]
- [eos::toolbar-evaluate-star-icon
- eos::print*
- eos::current-debugger-clique-id
- "print *: Evaluate selected expression as a pointer; shows in separate XEmacs frame"]
- [eos::toolbar-cont-icon
- eos::cont-and-dismiss
- eos::current-debugger-clique-id
- "cont & dismiss: Continue current program and dismiss this frame"]
- [eos::toolbar-step-over-icon
- eos::next-and-dismiss
- eos::current-debugger-clique-id
- "next & dismiss: Step over subprogram calls and dismiss this frame"]
- [eos::toolbar-step-into-icon
- eos::step-and-dismiss
- eos::current-debugger-clique-id
- "step & dismiss: Step into subprogram calls and dismiss this frame)"]
- [eos::toolbar-dismiss-icon
- eos::dismiss-print-frame
- t
- "dismiss (make invisible) this print frame"]
- ))
-
-(defun eos::toolbar-position ()
- (let ((pos (default-toolbar-position)))
- (cond ((eq pos 'top) top-toolbar)
- ((eq pos 'bottom) bottom-toolbar)
- ((eq pos 'left) left-toolbar)
- ((eq pos 'right) right-toolbar)
- (t top-toolbar))))
-
-(provide 'eos-toolbar)
-
-;;; sun-eos-toolbar.el ends here
+++ /dev/null
-;;; sun-eos.el --- Intereactively loads the XEmacs/SPARCworks interface
-
-;; Copyright (C) 1995 Sun Microsystems, Inc.
-
-;; Maintainer: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-;; Author: Eduardo Pelegri-Llopart <eduardo.pelegri-llopart@Eng.Sun.COM>
-
-;; Keywords: SPARCworks EOS Era on SPARCworks load
-
-;;; Commentary:
-
-;; If manual loading is desired...
-;; Please send feedback to eduardo.pelegri-llopart@eng.sun.com
-
-;;; Code:
-
-(load "sun-eos-load.el")
-(eos::start)
-
-;;; sun-eos-eos.el ends here
+++ /dev/null
-;;; No byte-compiler warnings
-;(eval-when-compile
-; (require 'w3))
-
-;;; Keep these obsolete variables for backward compatibility
-(defconst era-version "0.95" "\
-Version numbers of this version of Era.")
-
-;; We're (not really anymore) calling this version Sun Era.
-(defconst sun-era t)
-
-(defun era-version ()
- "Return (obsolete) string describing the version of Era that is running.
-Era is now known as XEmacs. Use (emacs-version) instead."
- (interactive)
- (if (interactive-p)
- (message "%s" (era-version))
- (format "%sEra %s of %s %s on %s (%s)"
- (if sun-era "Sun " "")
- era-version
- (substring emacs-build-time 0
- (string-match " *[0-9]*:" emacs-build-time))
- (substring emacs-build-time
- (string-match "[0-9]*$" emacs-build-time))
- emacs-build-system system-type)))
-
-;(defun sunpro-maybe-connect-to-tooltalk ()
-; (if (and (not (noninteractive))
-; (fboundp 'command-line-do-tooltalk))
-; (command-line-do-tooltalk nil)))
-
-;; sunpro-maybe-connect-to-tooltalk must appear in the hook list
-;; before any clients that register patterns, like eos-load.el.
-;; Currently eos-load.el places its functions at the end of the list
-
-;(add-hook 'before-init-hook 'sunpro-maybe-connect-to-tooltalk)
-
-(set-glyph-image text-pointer-glyph "xterm")
-(set-glyph-image nontext-pointer-glyph "xterm")
-
-;; W3 doesn't know about using pageview, so let's fix that.
-;; There doesn't seem to be any such function `w3-parse-mailcap' - mrb
-
-;(defun sunpro-fix-postscript-viewer ()
-; (if (not (noninteractive))
-; (condition-case nil
-; (w3-parse-mailcap
-; (expand-file-name "sparcworks/sunpro-mailcap" data-directory))
-; (error nil))))
-
-;(add-hook 'w3-load-hooks 'sunpro-fix-postscript-viewer)
-
-;; turn on pending delete without messing up its autoloads
-;(defun sunpro-pending-delete-on ()
-; (if (not (noninteractive))
-; (pending-delete-on nil)))
-
-;(add-hook 'before-init-hook 'sunpro-pending-delete-on)
-
-;;; Decide whether to use workshop.el or eos at runtime, based on
-;;; which Sun DevPro products are installed.
-
-(defun sunpro-update-paths-for-workshop ()
- "Update exec-path and load-path to find supporting workshop files.
-Returns nil if the required files cannot be found."
- (and
- (cond
- ((locate-file "workshop.el" load-path))
-
- ((file-exists-p (concat sunpro-dir "lib/workshop.el"))
- (setq load-path (append load-path (list (concat sunpro-dir "lib/"))))))
-
- (cond
- ((locate-file "workshop" exec-path))
-
- ((file-exists-p (concat sunpro-dir "bin/workshop"))
- (setq exec-path (append exec-path (list (concat sunpro-dir "bin/"))))))))
-
-(defun sunpro-startup ()
- "Runs at startup if support for Sun Workshop is compiled in. Don't run this."
-
- ;; Sun distribution censors yow, among other things...
- (unless (locate-file "yow.el" load-path)
- (fmakunbound 'yow)
- (delete-menu-item '("Apps" "Games" "Quote from Zippy"))
- (delete-menu-item '("Apps" "Games" "Psychoanalyze Zippy!")))
-
- (when (not (noninteractive))
-
- (flet
- ((sunpro-dir-p (dir)
- (and dir
- (file-exists-p (concat dir "bin/workshop"))
- (file-exists-p (concat dir "lib/workshop.el")))))
- (defconst sunpro-dir
- (cond
- ;; Look on the PATH
- ((let ((path exec-path) dir (found nil))
- (while (and path (not found))
- (setq dir (or (car path) "."))
- (setq path (cdr path))
- (setq dir (concat dir (if (string-match "/$" dir) "../" "/../")))
- (setq found (sunpro-dir-p dir)))
- (if found
- (expand-file-name dir))))
-
- ;; Check for standard Sun DevPro CD Install layout
- ((if (string-match "contrib/[^/]+/[^/]+/[^/]+/[^/]+/$" exec-directory)
- (let ((dir (substring exec-directory 0 (match-beginning 0))))
- (if (sunpro-dir-p dir)
- (expand-file-name dir)))))
-
- ;; Default install location
- ("/opt/SUNWspro/"))
-
- "Directory where Sun Developer Products are installed."))
-
- ;; Sunpro ships the mule version as a 2-file addition to the
- ;; non-mule distribution - the binary and the doc file.
- ;;
- ;; This is a quick hack, I know...
- ;; There ought to be a better way to do this.
- ;; Perhaps a --xemacs-flavor=mule flag?
- (if (featurep 'mule)
- (let ((mule-doc-file-name (concat internal-doc-file-name "-mule")))
- (if (file-exists-p (concat doc-directory mule-doc-file-name))
- (setq internal-doc-file-name mule-doc-file-name))))
-
- ;; Connect to tooltalk, but only on an X server.
- (when (and (featurep 'tooltalk)
- (fboundp 'command-line-do-tooltalk)
- (eq 'x (device-type)))
- (command-line-do-tooltalk nil))
-
- ;; Sun's pending-del default is like textedit's
- (require 'pending-del)
- (turn-on-pending-delete)
-
- ;; Bar cursor 2 pixels wide
- (setq bar-cursor 2)
-
- ;; Nice CDE compliant icon -- now the default...
- ;;(if (featurep 'xpm)
- ;; (set-glyph-image
- ;; frame-icon-glyph
- ;; (format "%s%s" data-directory "xemacs-icon3.xpm")
- ;; 'global 'x))
-
- (cond
- ;; Use Sun WorkShop if available
- ((sunpro-update-paths-for-workshop)
- ;; Unfortunately, changes to the default toolbar in 20.3 b21
- ;; have broken workshop-frob-toolbar in workshop.el. Since new
- ;; XEmacsen have to work with older WorkShops, this must be
- ;; fixed both in workshop.el (distributed on the Sun WorkShop CD)
- ;; and worked-around here.
- (set-specifier default-toolbar
- (append (specifier-instance default-toolbar)
- `([,(toolbar-make-button-list nil)
- workshop-bugfix nil nil])))
- (require 'workshop)
- (set-specifier default-toolbar
- (delete-if (lambda (b) (eq (aref b 1) 'workshop-bugfix))
- (specifier-instance default-toolbar))))
-
- ;; Else, use eos package with sparcworks if available
- ((or
- (locate-file "sparcworks" exec-path)
- (prog1
- (file-exists-p (concat sunpro-dir "bin/sparcworks"))
- (setq exec-path (append exec-path (list (concat sunpro-dir "bin/"))))))
-
- (load "sun-eos-init")
- (load "sun-eos-common")
- (load "sun-eos-editor")
- (load "sun-eos-browser")
- (load "sun-eos-debugger")
- (load "sun-eos-debugger-extra")
- (load "sun-eos-menubar")
- (eos::start))
-
- (t ; Neither? Complain...
- (display-warning
- 'sunpro
- "XEmacs was compiled with support for Sun Developer Products,
-but neither `workshop' nor `sparcworks' were found on the PATH.")))
- ))
-
-(add-hook 'before-init-hook 'sunpro-startup)
-
-(provide 'sunpro)
+++ /dev/null
-;;; sunpro-keys.el --- SunPro-specific key bindings
-
-;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
-
-(define-key global-map 'find 'x-isearch-maybe-with-region)
-
-(define-key isearch-mode-map 'f18 'isearch-yank-x-clipboard)
-(add-hook 'isearch-mode-hook 'sunpro-set-isearch-direction)
-(define-key isearch-mode-map 'f19 'isearch-repeat-forward)
-
-(defun x-isearch-maybe-with-region (&optional backward-p)
- "Enter isearch mode. If the region is active, find the selected text."
- (interactive "P")
- (let ((sunpro-isearch-direction
- (if backward-p 'backward 'forward)))
- (if (and zmacs-regions (mark))
- (progn (isearch-mode (not backward-p)) (isearch-yank-x-selection))
- (if backward-p (isearch-backward) (isearch-forward)))))
-
-(defun sunpro-set-isearch-direction ()
- (if (or (eq this-command 'isearch-backward)
- (eq this-command 'isearch-backward-regexp)
- (and (boundp 'sunpro-isearch-direction)
- (eq sunpro-isearch-direction 'backward)))
- (define-key isearch-mode-map 'f19 'isearch-repeat-backward)
- (define-key isearch-mode-map 'f19 'isearch-repeat-forward)))
+++ /dev/null
-;;; sunpro-menubar.el --- Initialize the SunPro menubar
-
-;; Copyright (C) 1993, 1994 Sun Microsystems, Inc
-
-;; Author: Aaron Endelman <endelman@Eng.Sun.COM>
-;; Maintainer: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; Created: 93/09/13 15:16:24
-
-;; Keywords: SunPro menubar initialization
-
-;;; Commentary:
-;; Creates the default SunPro menubars.
-
-;;; To Do:
-
-;;; Code:
-
-(defconst sunpro-menubar
- (purecopy-menubar ;the simple, new user menubar
- (list
- '("File"
- ["New" sunpro-new-buffer t]
- ["Open:" find-file t]
- ["Include File:" insert-file t]
- "-----"
- ["Save" save-buffer t nil]
- ["Save As:" write-file t]
- ["Revert..." revert-buffer t nil]
- "-----"
- ["Print" lpr-buffer t nil]
- "-----"
- ["Close" delete-frame t]
- ["Exit XEmacs" save-buffers-kill-emacs t]
- )
-
- '("Edit"
- ["Undo" advertised-undo t]
- "-----"
- ["Cut" x-kill-primary-selection t]
- ["Copy" x-copy-primary-selection t]
- ["Paste" x-yank-clipboard-selection t]
- ["Delete" x-delete-primary-selection t]
- "-----"
- ["Select Block" mark-paragraph t]
- ["Select All" mark-whole-buffer t]
- )
-
- '("View"
- ["New View" make-frame t]
- "-----"
- ["Split Window" (split-window) t]
- ["Unsplit Window" delete-other-windows t]
- ["Close Buffer" (kill-buffer nil) t nil]
- "-----! before list all buffers"
- ["List All Buffers" list-buffers t]
- )
-
- '("Find"
- ["Forward:" sunpro-search-forward t]
- ["Backward:" sunpro-search-backward t]
- ["And Replace:" sunpro-query-replace t]
- )
-
- ;; Copy the options menu from the default menubar
- (car (find-menu-item default-menubar '("Options")))
-
- '("Utilities"
- ["Cancel Command" (keyboard-quit) t]
- "-----"
- ["Execute Macro" call-last-kbd-macro last-kbd-macro]
- ["Start Macro Recording" start-kbd-macro (not defining-kbd-macro)]
- ["End Macro Recording" end-kbd-macro defining-kbd-macro]
- "-----"
- ["Spell" ispell-buffer t]
- ["Sort" sort-lines t]
- "-----"
- ["Format Paragraph " fill-paragraph t]
- "-----"
- ["Goto Line:" goto-line t]
- )
-
- ;; the following is supposed to be here! It ensures that the
- ;; Help item is always the rightmost item.
-
- nil ; the partition: menus after this are flushright
-
- '("Help" ["About XEmacs..." about-xemacs t]
- "-----"
- ["XEmacs WWW Page" xemacs-www-page t]
- ["XEmacs FAQ via WWW" xemacs-www-faq t]
- "-----"
- ["Info" info t]
- ["Describe Mode" describe-mode t]
- ["Hyper Apropos..." hyper-apropos t]
- ["Command Apropos..." command-apropos t]
- ["Full Apropos..." apropos t]
- ["List Keybindings" describe-bindings t]
- ["Describe Key..." describe-key t]
- ["Describe Function..." describe-function t]
- ["Describe Variable..." describe-variable t]
- "-----"
- ["Unix Manual..." manual-entry t]
- ["XEmacs Tutorial" help-with-tutorial t]
- ["XEmacs News" view-emacs-news t]
- ))))
-
-(set-menubar sunpro-menubar)
-
-(defconst programmer-menu '(["Programmer Menus"
- (toggle-programmer-menus)
- :style toggle
- :selected programmer-menus-p]
- ["-----! before save options" nil t]))
-(setq save-options-menu-item
- (car (find-menu-item default-menubar '("Options" "Save Options"))))
-(delete-menu-item '("Options" "Save Options"))
-(add-menu () "Options" (append
- (cdr (car
- (find-menu-item default-menubar '("Options"))))
- programmer-menu
- (list save-options-menu-item)))
-
-;;;
-;;; helper commands
-;;;
-
-(defun sunpro-new-buffer ()
- (interactive)
- (switch-to-buffer (generate-new-buffer "Untitled")))
-
-(defun sunpro-new-window ()
- (interactive)
- (switch-to-buffer-other-frame (generate-new-buffer "Untitled")))
-
-(defun sunpro-clone-buffer ()
- (interactive)
- (let
- ((old (current-buffer)))
- (switch-to-buffer (generate-new-buffer (buffer-name old)))
- (insert-buffer old)))
-
-(defun sunpro-search-forward ()
- (interactive)
- (if isearch-mode (isearch-repeat-forward)
- (x-isearch-maybe-with-region)))
-
-(defun sunpro-search-backward ()
- (interactive)
- (if isearch-mode (isearch-repeat-backward)
- (x-isearch-maybe-with-region t)))
-
-(put 'sunpro-search-forward 'isearch-command t)
-(put 'sunpro-search-backward 'isearch-command t)
-
-(defun sunpro-query-replace ()
- (interactive)
- (call-interactively 'query-replace))
-
-(defun sunpro-menu-quit ()
- "Abort minibuffer input if any."
- (while (not (zerop (minibuffer-depth)))
- (abort-recursive-edit)))
-
-(defvar programmer-menus-p nil)
-(defvar sccs-or-vc-menus 'sccs
- "Choose to use the SCCS or the VC menu.")
-
-(defun toggle-programmer-menus ()
- (interactive)
- (if programmer-menus-p
- (progn
- (if (equal sccs-or-vc-menus 'sccs)
- (delete-menu-item '("SCCS"))
- (delete-menu-item '("Version Control")))
- (delete-menu-item '("SPARCworks"))
- (delete-menu-item '("Options" "SPARCworks"))
- (delete-menu-item '("Options" "-----! before save options"))
- (delete-menu-item '("Help" "SPARCworks"))
- (setq programmer-menus-p nil))
- (progn
- (require 'eos-load "sun-eos-load")
- (eos::start)
- (if (equal sccs-or-vc-menus 'sccs)
- (progn
- (delete-menu-item '("Version Control"))
- (require 'sccs)
- (add-menu '() "SCCS" (cdr sccs-menu)))
- (progn
- (require 'vc)
- (delete-menu-item '("SCCS"))
- (add-menu '() "Version Control" vc-default-menu)))
- (setq programmer-menus-p t))))
-
-(defun sunpro-build-buffers-menu-hook ()
- "For use as a value of activate-menubar-hook.
-This function changes the contents of the \"View\" menu to add
-at the end the current set of buffers. Only the most-recently-used few buffers
-will be listed on the menu, for efficiency reasons. You can control how
-many buffers will be shown by setting `buffers-menu-max-size'.
-You can control the text of the menu items by redefining the function
-`format-buffers-menu-line'."
- (let ((buffer-menu (car (find-menu-item current-menubar '("View"))))
- buffers)
- (if (not buffer-menu)
- nil
- (setq buffer-menu (cdr buffer-menu))
- (setq buffers (buffer-list))
-
- (if (and (integerp buffers-menu-max-size)
- (> buffers-menu-max-size 1))
- (if (> (length buffers) buffers-menu-max-size)
- (setcdr (nthcdr buffers-menu-max-size buffers) nil)))
-
- (setq buffers (build-buffers-menu-internal buffers))
- (setq buffers (append (delq nil buffers)))
- ;; slightly (only slightly) more efficient to not install the menubar
- ;; if it hasn't visibly changed.
- (let ((tail (member "-----! before list all buffers" (cdr buffer-menu)))
- )
- (if tail
- (if (equal buffers (cdr tail))
- t ; return t meaning "no change"
- (setcdr tail buffers)
- nil)
- ;; only the first time
- (add-menu nil "View" (append buffer-menu
- '("-----! before list all buffers")
- buffers))
- nil
- )))))
-
-(add-hook 'activate-menubar-hook 'sunpro-build-buffers-menu-hook)
-
-;;; sunpro-menubar.el ends here
+++ /dev/null
-;;; sunpro-sparcworks.el --- support SPARCworks manager ToolTalk messages
-
-;; Copyright (C) Sun Microsystems, Inc.
-
-;; Author: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; Maintainer: Vladimir Ivanovic <vladimir@Eng.Sun.COM>
-;; Created: 20 Mar 95
-
-;; Keywords: SPARCworks, ToolTalk, messages
-
-;;; Commentary:
-
-;; Called from the SPARCworks Manager with the command:
-;;
-;; xemacs -q -l sunpro-sparcworks $SUNPRO_SWM_TT_ARGS $SUNPRO_SWM_GUI_ARGS
-;;
-
-;;; To Do:
-
-;;; Code:
-
-(require 'cl) ; Common Lisp compatibility
-
-(defvar sunpro-sparcworks-ops
- '("quit"
- "hide"
- "expose"
- "PEI_CLOSE"
- "PEI_OPEN"
- "PEI_NOP")
- "The ToolTalk operations that are handled.")
-
-(defvar sunpro-sparcworks-callbacks
- '(sp-sw-quit-handler
- sp-sw-hide-handler
- sp-sw-expose-handler
- sp-sw-close-handler
- sp-sw--open-handler
- sp-sw-nop-handler)
- "The ToolTalk operations that are handled.")
-
-(defvar sunpro-sparcworks-invocation-count nil
- "The number of XEmacsen invoked via the SPARCworks Manager.")
-
-(defun sp-sw-quit-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- (save-buffers-kill-emacs))
-
-(defun sp-sw-hide-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- (mapcar #'make-frame-invisible (frame-list)))
-
-(defun sp-sw-expose-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- (mapcar #'make-frame-visible (frame-list)))
-
-(defun sp-sw-close-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- (mapcar #'iconify-frame (frame-list)))
-
-(defun sp-sw-open-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- (mapcar #'deiconify-frame (frame-list)))
-
-(defun sp-sw-nop-handler (msg pat)
- (return-tooltalk-message msg 'reply)
- '())
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "quit"
- callback sp-sw-quit-handler)))
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "hide"
- callback sp-sw-hide-handler)))
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "expose"
- callback sp-sw-expose-handler)))
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "PEI_CLOSE"
- callback sp-sw-close-handler)))
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "PEI_OPEN"
- callback sp-sw-open-handler)))
-
-(register-tooltalk-pattern
- (make-tooltalk-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "PEI_NOP"
- callback sp-sw-nop-handler)))
-
-(defun sunpro-sparcworks-handle-command-line (arg)
- "Handle the SPARCworks Manager-specific command line arguments."
- (setq *sunpro-sparcworks-invocation-count* arg)
- ;;Fix up the command-line in case there are more arguments
- (setq command-line-args-left
- (cdr command-line-args-left)))
-
-
-;;; Initialize
-(setq command-switch-alist
- (purecopy
- (append '(("-swtm" . sunpro-sparcworks-handle-command-line))
- command-switch-alist)))
-
-
-;;; sunpro-sparcworks.el ends here
-
+++ /dev/null
-2016-01-11 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2015-07-11 Steve Youngs <steve@sxemacs.org>
-
- * build.el: Require 'build-rpt' instead of 'build-report' when
- using SXEmacs.
- Note that it is not recommended for SXEmacs users to install or
- use this package, this change is purely to allow building the
- package with SXEmacs.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
- * README: Restore CVS keyword expansions.
- * build-report.el: Ditto.
- * build.el: Ditto.
-
-2009-10-02 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2009-10-01 Aidan Kehoe <kehoea@parhasard.net>
-
- * build-report.el:
- Have compiled 21.4 code also work on XEmacs binaries with real
- support for multiple values, by avoiding runtime calls to
- #'values.
- Not waiting for approval from Adrian, as he hasn't been around
- recently, and the code worked fine in the other packages it has
- been applied to.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-10-19 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.13 released.
-
-2003-10-18 Adrian Aichner <adrian@xemacs.org>
-
- * build-report.el: Update copyright years.
- * build-report.el (build-report-keep-regexp): Update
- build-report.el for test harness output.
- * build-report.el (build-report-delete-regexp): Ditto.
- * build-report.el (build-report-installation-data): Handle
- builds of non-beta versions.
- * build-report.el (build-report-version-file-data): Ditto.
-
-2003-10-13 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.12 released.
-
-2003-09-30 Jerry James <james@xemacs.org>
-
- * build.el (build): Minor typo correction.
-
-2003-10-13 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.11 released.
-
-2003-10-12 Adrian Aichner <adrian@xemacs.org>
-
- * build.texi: Add dircategory Emacs.
- * build.texi (Top): Move from incorrect use of @var to correct use
- of @code.
- * build.texi (Build Overview): Ditto.
- * build.texi (Build Installation): Ditto.
- * build.texi (Build XEmacs From CVS): Ditto.
- * build.texi (Build XEmacs From Tarballs): Ditto.
- * build.texi (Build XEmacs With GNU Tools): Ditto.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile (MULE_ELCS): Removed.
- Delete explicit compile:: and binkit: rules.
- Don't add custom-load.elc to the list of generated elc's.
- Use STANDARD_DOCS instead of explicitly giving the targets
- and dependencies.
- Delete unused MULE_ELCS.
-
-2003-01-13 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.10 released.
-
-2003-01-11 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Increment.
- * build.el: Remove commented code.
- * build.el (build): Provide package before requiring others.
- * build.el (build-cvs-get-branch-and-release-tags): Use temp
- buffer to avoid changing directory of current buffer.
- * build.el (build-cvs-xemacs-release): Improve docstring.
- * build.el (build-from-CVS): Improve "Go Back" button notify function.
- * build.el (build-from-tarballs): Ditto.
- * build.el (build-with-GNU): Ditto.
- * build.el (build-with-MS): Ditto.
- * build.el (build-build-report): Ditto.
-
-2003-01-03 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.09 released.
-
-2002-12-17 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (INFO_FILES): build.texi is still on top-level.
- * Makefile (html): Ditto.
-
-2002-12-17 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (compile): Use $(INFO_DEP) dependency to make info
- documentaion.
-
-2002-12-14 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Increment.
- * Makefile (ELCS): Include build-report.el
- * Makefile (HTML_FILES): Removed.
- * Makefile (HTML_DEP): Removed.
- * Makefile (INFO_DEP): New.
- * Makefile (all): Removed.
- * Makefile (compile): Use info target instead of INFO_FILES.
- * Makefile (html): New.
- * build.el: Move defuns and defcustoms to make package work in
- vanilla XEmacs. Update CVS release tags in `build-from-CVS',
- istead of defcustom.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
- * README (build.texi):
- * README (PACKAGE_INDEX):
- * README (XEMACS_STAGING): Removed.
- Correct for new Local.rules format.
-
-2002-12-06 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.08 released.
-
-2002-11-26 Adrian Aichner <adrian@xemacs.org>
-
- * build-report.el: Sync with XEmacs core improvements.
- * build-report.el (build-report-installation-version-regexp):
- Support xemacs_extra_name.
- * build-report.el (build-report-version-file-regexp): Ditto.
- * build-report.el (build-report-keep-regexp): Add useful stuff.
- * build-report.el (build-report-delete-regexp): Don't delete
- successful tests.
- * build-report.el (build-report-make-output-files): Typo fix.
- * build-report.el (build-report): Sync docstring from core.
- * build-report.el (build-report-installation-data): Support
- xemacs_extra_name. Default missing version information components
- by defaulting to "".
- * build-report.el (build-report-version-file-data): Ditto.
- * build.el:
- * build.el (build-call-process): Moved.
- * build.el (build-compilation-mode-hook): Include time zone
- information.
- * build.el (build-cvs-get-branch-and-release-tags): New. Retrieve
- release tags from version.sh via CVS.
- * build.el (build-cvs-xemacs-release): Remove static definition
- in favor of `build-cvs-get-branch-and-release-tags'.
- * build.el (build-cvs-login): Fix bug in build-cvs-available-p
- house-keeping.
- * build.el (build-tarball-site): Generate list dynamically from
- `package-get-download-sites'. Unification!
- * build.el (build-with-MS-make-options): Fix default value.
- * build.el (build-with-GNU): Set `build-report-installation-file'
- and `build-report-version-file'.
- * build.el (build-with-MS): Set `build-report-installation-file'
- in addtion to `build-report-version-file'. Tell user not to
- forget saving config.inc.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2002-08-12 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.07 released.
-
-2002-08-10 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build): Save build-settings to custom-file.
-
-2002-08-10 Adrian Aichner <adrian@xemacs.org>
-
- * build.texi: Add some index and section entries. Change button
- documentation from [Back] and [Go Back].
- * build.texi (Saving Multiple Build Settings): New.
-
-2002-07-20 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.06 released.
-
-2002-07-19 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Sync with `build-version-number' in
- build.el.
- * build.el: Use `message-or-box' instead of `message'. Rename
- "Back" button to "Go Back". Set `custom-mode' after
- `widget-setup'. Use `build-call-process'.
- * build.el (build-version): Use `message-or-box' instead of `message'.
- * build.el (build-cvs-available-p): New.
- * build.el (build-cvs-xemacs-repository): Update to user `cvs'.
- * build.el (build-cvs-working-dir-naming):
- * build.el (build-cvs-login): Use `build-call-process'.
- * build.el (build-from-what): Change from `defvar' to `defcustom'.
- * build.el (build-from-CVS): Check for existence of
- `build-cvs-checkout-dir'.
- * build.el (build): Add support for build-settings via "Load",
- "Delete", and "Save" buttons. Use `build-call-process'.
- * build.el (build-call-process): New.
- * build.el (build-with-what): Change from `defvar' to `defcustom'.
- * build.el (build-with-GNU): Fix "Go Back" button action.
- * build.el (build-settings-save-custom-group): New.
- * build.el (build-settings-load): New.
-
-2002-07-16 Adrian Aichner <adrian@xemacs.org>
-
- * .cvsignore: Add generated .info* and .html files.
-
-2002-07-04 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-make-target-doc-paragraph): Update docstring.
- * build.el (build-make-target-paragraph): Ditto.
- * build.el (build-settings): Ditto.
- * build.el (build-make-macro-paragraph): Match ..._DIR variable
- definitions inside comments in xemacs.mak to handle them
- generically.
- * build.el (build-make-customize): Remove special ..._DIR variable
- handling cruft.
-
-2002-07-03 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-with-MS-has-config-inc): New.
- * build.el (build-from-CVS): Replace all NL and TAB in
- `widget-insert' arguments to \n and \t to avoid inadvertent
- reformatting.
- * build.el (build-from-tarballs): Ditto.
- * build.el (build): Ditto.
- * build.el (build-with-GNU): Ditto.
- * build.el (build-build-report): Ditto.
- * build.el (build-with-MS): Ditto. Set
- `build-with-MS-has-config-inc' according to
- `build-report-version-file'. Pass `build-make-get-option-string'
- to `build-make' only when build-with-MS-has-config-inc is nil.
- * build.el (build-make-sym-to-opt): Add #### comment.
- * build.el (build-make-set-value): Improve updating of
- `build-make-options' from customized variables.
-
-2002-06-24 Adrian Aichner <adrian@xemacs.org>
-
- * build.el: Update of Id CVS keyword.
- * build.el (build-version-number): Doc fix.
- * build.el (build-cvs-checkout-dir): Default to nil.
- * build.el (build-tarball-dir): Actualize default.
- * build.el (build-tarball-prefix): Ditto.
- * build.el (build-tarball-set): Provide custom tags for constants.
- * build.el (build-tarball-expand): Use `expand-file-name' instead
- of `concat'.
- * build.el (build-tarball-get-all): Doc fix.
- * build.el (build-tarball-expand-all): Ditto.
- * build.el (build-with-MS-make-options): Provide working default.
-
-2002-06-03 Adrian Aichner <adrian@xemacs.org>
-
- * build.texi (Build Installation): Update pxref according to
- change in XEmacs manual.
-
-2002-05-26 Adrian Aichner <adrian@xemacs.org>
-
- * build.el: Update copyright years.
- * build.el (build-version-number): Update to 2.00.
- * build.el (build-version-date): Update to 2002-05-26.
- * build.el (build-cvs-set-var-and-update-buffer): New.
- * build.el (build-cvs-checkout-options-validate): Use new
- build-cvs-set-var-and-update-buffer.
- * build.el (build-cvs-options): Ditto.
- * build.el (build-cvs-update-options): Ditto.
- * build.el (build-cvs-checkout-parent-dir): Default to
- (temp-directory). Use new build-cvs-set-var-and-update-buffer.
- * build.el (build-cvs-xemacs-module): Change from defcustom to
- defconst.
- * build.el (build-cvs-checkout-dir): Change from defcustom to
- defvar.
- * build.el (build-cvs-use-pcl-cvs): Use new
- build-cvs-set-var-and-update-buffer.
- * build.el (build-cvs-xemacs-release): Ditto. Add choices for
- known releases.
- * build.el (build-cvs-xemacs-repository): Update to repository at
- SunSITE.dk.
- * build.el (build-cvs-login): This works now.
- * build.el (build-cvs-working-dir-naming): New. Use new
- build-cvs-set-var-and-update-buffer.
- * build.el (build-cvs-update): Add -A switch for update to latest
- sources.
- * build.el (build-from-CVS): Set `build-cvs-checkout-dir' from
- `build-cvs-working-dir-naming'. Display build-cvs settings and
- general explanations in widget interface.
- * build.el (build-tarball-dest): Use (temp-directory).
- * build.el (build-tarball-site): Updated from
- http://www.xemacs.org/Download/ as of 2002-03-07.
- * build.el (build): Add documentation links to defgroup. Test
- availability of cvs and initialize GUI accordingly. Add more user
- information to widget interface.
- * build.el (build-with-GNU): Back button to take build-from-what
- into account. Rename "Customize ..." to "Browse ..." in buttons.
- * build.el (build-with-MS): Ditto.
- * build.el (build-build-report): Back button to take
- build-with-what into account. Rename "Customize ..." to "Browse ..."
- in buttons.
- * build.el (build-with-MS): Ditto.
- * build.el (build-make-alist): Fix typo.
- * build.el (build-settings): New. Reserved for future use.
- * build.texi: Update copyright years.
- * build.texi (Top): Update release version and date information.
- * build.texi (Build Installation): Add Windows 2000.
- * build.texi (Build XEmacs): Add information about Info and HTML
- documentation. Document cvs availability check.
- * build.texi (Build XEmacs From CVS): Document CVS login, which
- works now.
- * build.texi (Build XEmacs With GNU Tools): Add some cindex
- entries.
- * build.texi (Build XEmacs With Microsoft Tools): Ditto. Document
- change of "Customize ..." to "Browse ..." in buttons.
- * build.texi (Generate XEmacs Build Report): Document change of
- "Customize ..." to "Browse ..." in buttons.
-
-2002-01-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (HTML_FILES): New.
- * Makefile (HTML_DEP): New.
- * Makefile (all): Move $(INFO_FILES) dependency to end.
-
-2001-12-30 Adrian Aichner <adrian@xemacs.org>
-
- * build.texi: Add missing direntry.
-
-2001-12-02 Adrian Aichner <adrian@xemacs.org>
-
- * build.el:
- * build.el (build-cvs-use-pcl-cvs): New.
- * build.el (build-cvs-update): Obey build-cvs-use-pcl-cvs. If
- nil, run cvs update via (compile ...).
- * build.el (build-from-CVS): Reword widget UI to use "CVS tag".
- * build.el (build-with-MS): Overwrite build-report-version-file
- according to build settings for build-report to find correct
- information.
-
-2001-05-19 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-with-MS): Use build-report-version-file after
- setting is.
-
-2001-05-13 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-from-CVS): Name buffer correctly.
- * build.el (build-tarball-site): Update download sites from
- XEmacs-21.4.2/etc/FTP.
- * build.el (build-with-MS): Use version.sh of directory we build
- in and customize build-report-version-file accordingly (without
- saving in order to stay out of build-report's way).
- * build.el (build-with-MS-make-commandline): Removed.
-
-2001-04-30 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-version-number): Don't skip over first
- character, which used to be r (for release).
-
-2001-04-30 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): Start at 1.01 for now.
- * README: Document discontinuation of CVS keywords Name and Date
- and their use via cvs update -r rMAJOR-MINOR -kv.
- * build.el (build-version-number): Substitute version manually.
- * build.el (build-version-date): Substitute date manually.
- * build.texi: Substitute version and date manually.
-
-2001-04-29 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Changed to '1.78'.
- (ELCS): Removed 'build-report.elc'.
- (REQUIRES): Add xemacs-base, pcl-cvs, dired, w3 & prog-modes.
-
-2001-04-28 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-78 is released.
- * .cvsignore: Ignore the usual autogenerated files.
-
-2001-04-26 Steve Youngs <youngs@xemacs.org>
-
- * build.el: Autoload 'ring-insert-at-beginning, efs-copy-file'.
-
-2001-04-25 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-77 is released.
- * Makefile (CATEGORY): Change from comm to libs.
- * build.el (build-with-MS): Generate config.inc for XEmacs 21
- minor versions > 2.
-
-2001-04-19 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-76 is released.
- * README: Update documentation.
-
-2001-04-08 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-75 is released.
- * build.el: Require compile.
- * build.el (build-configure-sym-to-opt): Retain both dashes in
- build-configure options.
-
-2001-04-08 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-74 is released.
- * build.el (build-configure): Fix configure argument processing.
- * build.el (build-configure-generate): Find "configure.usage"
- according to `build-from-what', not (config-value-hash-table) of
- running XEmacs.
- * build.el (build-make-generate): Ditto for "Makefile.in".
-
-2001-04-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-73 is released.
- * build.el (build-configure-string): Use
- `build-configure-set-value' instead of `build-make-set-value'.
- * build.el (build-configure-file): Ditto.
- * build.el (build-configure-dir): Ditto.
- * build.el (build-configure-type): Ditto.
-
-2001-04-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-72 is released.
- * build.el (build-make-sym-to-opt): Removed from
- `build-configure-prolog'.
- * build.el (build-configure-sym-to-opt): New in
- `build-configure-prolog'. Fix substring FROM value.
- * build.el (build-make-set-value): Removed from
- `build-configure-prolog'.
- * build.el (build-configure-set-value): New in
- `build-configure-prolog'.
-
-2001-03-28 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-68 is released.
- * build.el: Try requiring pcl-cvs.
- * build.el (build-cvs-update): Use feature pcl-cvs, if available.
-
-2001-03-20 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-67 is released.
- * build.el (build-configure-option-category): Adjust for
- configure.usage option line proliferation.
- * build.el (build-configure-generate): Avoid setting and switching
- to buffer.
- * build.el (build-with-GNU): Add whitespace between widgets.
- * build.texi: Fix CVS keyword in subtitle.
-
-2001-03-17 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (VERSION): r1-66 is released.
- * build-report.el: Update Copyright section.
- * build.el: Add Legalese.
- * build.el (build-make-customize): Add support for GTK_DIR and
- sort list lexically.
- * build.texi: Update Copyright information. Update release Date.
- * build.texi (Top): Add version and author information.
-
-2001-03-17 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-cvs-checkout-options-validate): Improve
- documentation.
- * build.el (build-cvs-checkout-dir): Change custom type from
- directory to string.
-
-2001-03-12 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-configure):
- * build.el (build-cvs-checkout-options-validate):
- * build.el (build-cvs-options):
- * build.el (build-cvs-checkout-dir):
- * build.el (build-cvs-checkout-parent-dir): New.
- * build.el (build-cvs-xemacs-module):
- * build.el (build-cvs-xemacs-release):
- * build.el (build-cvs-login):
- * build.el (build-cvs-checkout):
- * build.el (build-cvs-update):
- * build.el (build-from-CVS):
- * build.el (build-tarball-extract):
- * build.el (build-make):
-
-2001-02-18 Adrian Aichner <adrian@xemacs.org>
-
- * build-report.el (build-report-destination): xemacs-build-reports
- has moved to SourceForge, where mailing list name length is
- restricted, hence the name change to
- xemacs-buildreports@xemacs.org.
- * build.el: Fix comment structure for folding-mode.
- * build.el (build-cvs-checkout-options-validate): New.
- * build.el (build-cvs-working-dir): Commented out.
- * build.el (build-cvs-checkout-dir): New.
- * build.el (build-config-inc-generate): Moved to Build Make
- section.
-
-2000-12-30 Adrian Aichner <adrian@xemacs.org>
-
- * README: New.
-
-2000-12-29 Adrian Aichner <adrian@xemacs.org>
-
- * build 1.58 is released.
-
- * TODO: Correct my E-mail address.
- * build.el: Order all "^\s-*(def" blocks by name in preparation
- for split into multiple files.
- * build.texi (Build Overview): Improve some wording.
- * package-info.in: Shorten description for build package.
-
-2000-10-21 Adrian Aichner <adrian@xemacs.org>
-
- * build 1.57 is released.
-
- * Makefile (VERSION): Increment to 1.01
- * build.el (build): Rename buttons.
- * build.texi (Build XEmacs): Document more buttons.
- * build.texi (Known Problems of Build): Enumerate Problems,
- itemize into Problem, Workaround, and Fix.
-
-2000-10-09 Adrian Aichner <adrian@xemacs.org>
-
- * build.el (build-version-number): Use CVS keyword Name for
- AUTHOR_VERSION handling.
- * build.texi: Ditto.
- * Makefile (AUTHOR_VERSION): Ditto.
- * build 1.56 is released.
-
-2000-09-23 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * build-report.el: Update copyright year range.
- build-report-version is determined by XEmacs version -- remove
- build-report-version*.
- * build-report.el (build-report-keep-regexp): Match test results.
- * build-report.el (build-report-delete-regexp): Ignore
- auto-linlining conflicts and texinfmt "Formatting" output.
- * build-report.el (build-report-insert-header): Report
- emacs-version and system-configuration instead of
- build-report-version.
- * build.el: Require build-report on top-level. Add package
- version support. Improve UI.
- * build.el (build): Add informative text to UI. Fix config.inc
- support check (> 21.2-b32) for building with Microsoft Tools.
- * build.el (build-version-number): New.
- * build.el (build-version-date): New.
- * build.el (build-version): New.
- * build.el (build-config-inc-generate): Report version number of
- build.
-
-2000-07-05 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * Makefile (VERSION): build 1.51 is released.
-
-2000-07-05 AichnerAd <aichner@ecf.teradyne.com>
-
- * build-report.el: Minor doc changes. Sync with XEmacs 21.2
- lisp/build-report.el 1.5.2.4.
- * build-report.el (build-report-version-number): New.
- * build-report.el (build-report-version-date): New.
- * build-report.el (build-report-version): New.
-
-2000-06-22 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * build.texi (Overview): Fix trivial typo.
-
-2000-06-12 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * Makefile (VERSION): build 1.49 is released.
-
- * build.el (build-config-option-category): Rename all
- build-config- symbols to build-configure-, build-config- is now
- reserved for config.inc support under native Windows builds.
- (build): Re-indent whole file.
- (build-with-MS): Generate config.inc file from 'build-make
- options.
- (build-with-MS-make-commandline): New function building long or
- short build-make commandline depending on config.inc support in
- xemacs.mak.
-
-2000-05-06 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * build.el (build-make-customize): Bring back *_DIR interface for
- MS builds (can't be deduced from xemacs.mak).
-
- * Makefile (VERSION): build 1.48 is released.
-
-2000-04-09 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * Makefile (VERSION): build 1.47 is released with minimal
- documentation.
-
- * build.el: Add ellipsis for push-buttons requiring further
- interaction.
-
- * Makefile (ELCS): Remove obsolete build-info.elc
- (VERSION): build 1.46 is released.
-
- * build.el (build-make-customize): Remove MS-specific stuff.
- (build-from-tarballs): Add "Back" button.
- (build-from-CVS): ditto.
- (build-with-GNU): ditto.
- (build-with-MS): ditto.
- (build-build-report): ditto.
- (build-with-MS): Add buttons to "Check temacs (XEmacs before
- dumping)" and "Check XEmacs".
-
-1999-07-15 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * Makefile (AUTHOR_VERSION): Increment to 1.43.
-
- * build-report.el (build-report-installation-file): Installation
- file is now in top-level directory for Windows NT as well.
-
- * build.el (build-build-report): Ditto.
-
- * Makefile (AUTHOR_VERSION): Increment to 1.42.
-
- * build.el (build-cvs-update-options): Remove -A switch.
-
- * build-report.el (build-report-installation-version-regexp):
- Handle releases in addition to betas.
-
-1999-03-16 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * Create package.
+++ /dev/null
-# Makefile for build lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# For the time being, remove MULE_ELCS from the all dependencies if
-# building without Mule.
-
-VERSION = 1.18
-AUTHOR_VERSION = 2.02
-MAINTAINER = Adrian Aichner <adrian@xemacs.org>
-PACKAGE = build
-PKG_TYPE = regular
-# Specify any required libraries which are not part of core lisp.
-REQUIRES = xemacs-base pcl-cvs dired w3 prog-modes
-CATEGORY = standard
-
-ELCS = build.elc build-report.elc
-
-STANDARD_DOCS = t
-
-include ../../XEmacs.rules
+++ /dev/null
-Below instructions regarding "Making a release" are incorrect as per
-2001-04-30.
-
-Instead, make sure to manually update following approximate locations
-before making a new release of build, checkin the changes and roll a
-new release.
-
-Substitute the package VERSION number (see Makefile) for $Name[^$]+$
-below.
-Substitute an ISO8601 date (YYYY-MM-DD) for $Date[^$]+$.
-
-cd c:\Hacking\XEmacs\xemacs-packages\libs\build\
-egrep -ni "\$[A-Z][a-z]+" * NUL
-Compilation started at Sun Apr 29 23:59:06 2001 +0200 (W. Europe Daylight Time)
-egrep: CVS: Invalid request code
-build.el:8:;; Date: $Date: 2002-12-08 21:26:36 $
-build.el:9:;; Version: $Name: $
-build.el:71: (let ((x "$Name: $"))
-build.el:80: (let ((x "$Date: 2002-12-08 21:26:36 $"))
-build.texi:28:@subtitle Version $Name: $ (for XEmacs 21.1, 21.2), dated $Date: 2002-12-08 21:26:36 $
-build.texi:59:This is the XEmacs Build Reference Manual, Version $Name: $ (for XEmacs
-build.texi:60:21.1, 21.2), released $Date: 2002-12-08 21:26:36 $, by @email{adrian@@xemacs.org, Adrian
-
-grep exited abnormally with code 2 at Sun Apr 29 23:59:07
-
-============================================================================
-
-Making a release (2001-04-19):
-
-1.
-Tag the sources (using cvs tag rJMAJOR-MINOR).
-rtag will probably not work because build-report.el is in the Attic.
-
-2.
-Update from cvs using:
-cvs update -r rMAJOR-MINOR -kv
-
-3.
-make distclean
-make bindist
-
-4.
-Update again to remove sticky tag and expanded keywords:
-cvs update -PdA
-
-5.
-Hand-edit
-
-PACKAGE_INDEX = package-index.LATEST.pgp
-
-in NONMULE_INSTALLED_PACKAGES_ROOT (see ..\..\Local.rules) to remove any
-old entries for the build package.
-
-6.
-Options -> Manage Packages -> Add Download Site
- Adrian's Packages local to ZJ75T
-Options -> Manage Packages -> Update Package Index
-Options -> Manage Packages -> List & Install
- Uninstall the old build package.
- Install the new build package version.
+++ /dev/null
-2001-03-17 Adrian Aichner <adrian@xemacs.org>
-
-Need to remove trailing \ from build-make variables containing pathnames.
-
-2000-09-30 Adrian Aichner <adrian@xemacs.org>
-
-Avoid GUI elements to appear and disappear depending on user choices.
-Present all and activate or deactivate them as appropriate.
-
- (setq
- build-from-button-widget
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (cond
- ((string-equal build-from-what "Tarballs")
- (build-from-tarballs))
- ((string-equal build-from-what "CVS")
- (build-from-CVS))))
- (format "Build XEmacs From %s Now ..." build-from-what)))
-
-is an example that needs to be fixed.
-
+++ /dev/null
-;;; build-report.el --- Automatically formatted build reports for XEmacs
-
-;; Copyright (C) 1997-2003 Adrian Aichner
-
-;; Author: Adrian Aichner <adrian@xemacs.org>
-;; Date: $Date: 2009-10-01 18:39:57 $
-;; Version: $Revision: 1.50 $
-;; Keywords: internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not synched.
-
-;;; Commentary:
-
-;; The Idea:
-;; Let XEmacs report interesting aspects of how it was built.
-
-;; The Concept:
-;; User creates an XEmacs Build Report by just calling
-;; M-x build-report
-;; which will initialize a mail buffer with relevant information
-;; derived from the XEmacs build process. Point is left at the
-;; beginning of the report for user to input some personal notes and
-;; send the report.
-
-;; The Status:
-;; This is the first `Proof of Concept'.
-
-;; The Author:
-;; Adrian Aichner, Teradyne GmbH Munich, Sun., Apr. 20, 1997.
-
-;;; Code:
-
-(require 'config)
-(require 'custom)
-(require 'cl)
-(provide 'build-report)
-
-(eval-when-compile (when (eq 'list (symbol-function 'values))
- (define-compiler-macro values (&rest args)
- `(list ,@args))))
-
-;;; Constant definitions used internally by `build-report'. These are not
-;;; anticipated to be changed by users of `build-report'.
-;;; If users do need to change the value of any of these, they need to do
-;;; it after `build-report' has been loaded (not just required). Please
-;;; report it to the maintainers of `build-report' when you think you
-;;; need to do this.
-(defconst build-report-installation-version-regexp
- "XEmacs\\s-+\\([0-9]+\\)\\.\\([0-9]+\\)\\(\\(-b\\|\\.\\)\\([0-9]+\\)\\)?\\s-+\\\\?\"\\([^\\\"]+\\)\\\\?\"\\s-+\\(.*\\)?configured\\s-+for\\s-+`\\(.+\\)'\\."
- "*REGEXP matching XEmacs Beta Version string in
-`build-report-installation-file' file. This variable is used by
-`build-report-installation-data'.")
-
-(defconst build-report-version-file-regexp
- "emacs_major_version\\s-*=\\s-*\\([0-9]+\\)
-emacs_minor_version\\s-*=\\s-*\\([0-9]+\\)
-emacs_beta_version\\s-*=\\s-*\\([0-9]+\\)?
-xemacs_codename\\s-*=\\s-*\"\\([^\"]+\\)\"\\(
-xemacs_extra_name\\s-*=\\s-*\"\\([^\"]+\\)\"\\)?"
- "*REGEXP matching XEmacs Beta Version variable assignments in
-`build-report-version-file' file. This variable is used by
-`build-report-version-file-data'.")
-
-(defconst build-report-installation-srcdir-regexp
- "\\s-*Where should the build process find the source code\\?\\s-*\\(.*\\)$"
- "REGEXP matching XEmacs Beta srcdir as the first substring match in
-`build-report-installation-file' file. This variable is used by
-`build-report-installation-data'.")
-
-;;; Customization support for build-report starts here.
-
-(defgroup build-report nil
- "Standardizes the Creation of XEmacs Build Reports."
- :load 'build-report
- :group 'build)
-
-(defcustom build-report-destination
- (list
- "XEmacs Build Reports List <xemacs-buildreports@xemacs.org>"
- "XEmacs Beta List <xemacs-beta@xemacs.org>")
- "*The list of mail addresses XEmacs Build Reports should most likely
-go to."
- :type '(repeat
- :custom-show t
- :documentation-shown t
- string)
- :group 'build-report)
-
-(defcustom build-report-keep-regexp
- (list
- "^\\(cd\\|n?make\\)\\s-"
- "errors?"
- "warnings?"
- "pure.*\\(space\\|size\\)"
- "hides\\b"
- "strange"
- "shadowings"
- "^Compil\\(ing\\s-+in\\|ation\\)"
- "^Using"
- "not\\s-+found"
- "^While\\s-+compiling.*\\(\n\\s-+.+\\)*"
- "^Note:"
- "Installing"
- "[Ff]ile(s) copied"
- "\\s-+tests\\s-+"
- "^[A-Z] [^ ]+$"
- "^Wrong number of arguments:"
- "^ \\*\\* "
- "^\\(FAIL\\|SKIP\\):")
- "*Regexp of make process output lines to keep in the report."
- :type '(repeat
- :custom-show t
- :documentation-shown t
- regexp)
- :group 'build-report)
-
-(defcustom build-report-delete-regexp
- (list
- "confl.*with.*auto-inlining"
- "^Formatting:"
- "^\\s-*0 .*\\(failure\\|error\\)s?"
- "^PASS:"
- "(100%) tests successful")
- "*Regexp of make process output lines to delete from the report."
- :type '(repeat
- :custom-show t
- :documentation-shown t
- regexp)
- :group 'build-report)
-
-(defcustom build-report-make-output-dir
- (cond
- ((equal system-type 'windows-nt)
- (expand-file-name "nt"
- (gethash 'blddir (config-value-hash-table))))
- (t
- (gethash 'blddir (config-value-hash-table))))
- "*Directory where the build report file is found.
- If this is empty or nil, the default, it is replaced by the value of
- the XEmacs build directory."
- :type '(directory
- :custom-show t
- :documentation-shown t)
- :group 'build-report)
-
-(defcustom build-report-make-output-files
- (list
- "beta.err"
- "xemacs-make-all.err"
- "xemacs-make-check-temacs.err"
- "xemacs-make-check.err"
- "xemacs-make-install.err")
- "*List of Filenames where stdout and stderr of XEmacs make process
-have been stored. These are relative to
-`build-report-make-output-dir`. You'll have to run make with output
-redirection or use the `build' XEmacs package to save this output. You
-may use following alias
-
-alias mk 'make \!* >>&\! \!$.err &'
-
-under csh, so that you get beta.err when you run `mk beta'."
- :type '(repeat
- :custom-show t
- :documentation-shown t
- file)
- :group 'build-report)
-
-(defcustom build-report-installation-file
- (expand-file-name "Installation"
- (gethash 'blddir (config-value-hash-table)))
- "*Installation file produced by XEmacs configure process."
- :type '(file
- :custom-show t
- :documentation-shown t)
- :group 'build-report)
-
-(defcustom build-report-version-file
- (expand-file-name
- "version.sh"
- (gethash 'blddir (config-value-hash-table)))
- "*version.sh file identifying XEmacs (Beta) Distribution."
- :type '(file
- :custom-show t
- :documentation-shown t)
- :group 'build-report)
-
-(defcustom build-report-installation-insert-all
- nil
- "*Tell build-report to insert the whole Installation file
- instead of just the last report."
- :type 'boolean
- :group 'build-report)
-
-(defcustom build-report-subject
- (concat "[%s] " emacs-version " on " system-configuration)
- "*XEmacs Build Report Subject Line. %s-sequences will be substituted
- with user input through `build-report' according to
- `build-report-prompts' using `format'."
- :type '(string
- :custom-show t
- :documentation-shown t)
- :group 'build-report)
-
-(defcustom build-report-prompts
- (quote (("Status?: " ("Success" "Failure"))))
- "*XEmacs Build Report Prompt(s). This is a list of prompt-string
- lists used by `build-report' in conjunction with
- `build-report-subject'. Each list consists of a prompt string
- followed by any number of strings which can be chosen via the history
- mechanism."
- :type '(repeat
- :custom-show t
- :documentation-shown t
- (list
- :tag "Prompt"
- string
- (repeat
- :tag "Values"
- string)))
- :group 'build-report)
-
-(defcustom build-report-file-encoding
- "7bit"
- "*XEmacs Build Report File Encoding to be used when MIME support is
- available."
- :group 'build-report)
-
-;; Symbol Name mappings from TM to SEMI serving as Compatibility
-;; Bandaid
-(when (featurep 'mime-setup)
- ;; No (defvaralias ...) so far. Thanks to "Didier Verna"
- ;; <didier@xemacs.org> for reporting my incorrect defvaraliasing of
- ;; `mime-editor/insert-tag'.
- ;; Thanks to Jens-Ulrik Holger Petersen
- ;; <petersen@kurims.kyoto-u.ac.jp> for suggesting the conditional
- ;; aliasing of SEMI functions.
- (unless (fboundp 'mime-edit-content-beginning)
- (defalias 'mime-edit-content-beginning 'mime-editor/content-beginning))
- (unless (fboundp 'mime-edit-insert-tag)
- (defalias 'mime-edit-insert-tag 'mime-editor/insert-tag))
- (unless (fboundp 'mime-edit-insert-binary-file)
- (defalias 'mime-edit-insert-binary-file
- 'mime-editor/insert-binary-file)))
-
-(defun build-report-make-output-get ()
- "Return the filename the XEmacs make output is saved in."
- (interactive)
- (if (or (string-equal build-report-make-output-dir "")
- (null build-report-make-output-dir))
- (mapcar
- (function
- (lambda (f)
- (expand-file-name
- f
- (file-name-as-directory
- (gethash 'blddir (config-value-hash-table))))))
- build-report-make-output-files)
- (mapcar
- (function
- (lambda (f)
- (expand-file-name
- f
- (file-name-as-directory build-report-make-output-dir))))
- build-report-make-output-files)))
-
-;;;###autoload
-(defun build-report (&rest args)
- "Report build information including Installation and make output.
-
-Prompts for status (usually \"Success\" or \"Failure\"). Then uses
-`compose-mail' to create a mail message. The Subject header contains
-status and version information. Point is left at the beginning of the
-mail text. Add some notes if you like, and send the report.
-
-Looks for Installation and the make output file (`beta.err' by
-default, customizable via `build-report-make-output-files') in the
-build directory of the running XEmacs by default (customizable via
-`build-report-make-output-dir'). The output from make is filtered
-through `build-report-keep-regexp' and `build-report-delete-regexp'
-before including in the message.
-
-See also `mail-user-agent', `build-report-destination', and
-`build-report-installation-file'."
- ;; `interactive' form returns value for formal parameter `args'.
- (interactive
- (let (prompt
- hist
- arg
- (prompts build-report-prompts))
- (progn
- (while prompts
- (defvar hist)
- (setq prompt (caar prompts))
- (setq hist (cdar prompts))
- ;; `build-report-prompts' used to be a list of lists, the
- ;; first element of each list being the prompt, the rest being
- ;; the history. The history is now in a separate list. We
- ;; better check for that.
- (if (listp (car hist))
- (setq hist (car hist)))
- (setq prompts (cdr prompts))
- (setq arg (cons (read-string prompt "" 'hist) arg)))
- arg)))
- (save-excursion
- (if (file-exists-p build-report-installation-file)
- (multiple-value-bind
- (major minor beta codename extraname configuration)
- (build-report-installation-data build-report-installation-file)
- (setq build-report-subject
- (format "[%%s] XEmacs %s.%s%s \"%s\" %s%s"
- major minor beta codename extraname configuration)))
- (multiple-value-bind
- (major minor beta codename extraname)
- (build-report-version-file-data build-report-version-file)
- (setq build-report-subject
- (format "[%%s] XEmacs %s.%s%s \"%s\" %s%s"
- major minor beta codename extraname system-configuration))))
- (compose-mail
- ;; `build-report-destination' used to be a single string, so
- ;; let's test if we really get a list of destinations.
- (if (listp build-report-destination)
- (read-string
- "Build Report Destination: "
- (car build-report-destination)
- 'build-report-destination)
- (read-string
- "Build Report Destination: "
- build-report-destination)
- )
- (apply 'format build-report-subject args)
- nil
- nil
- nil
- nil
- nil)
- (let* ((report-begin (point))
- (files (reverse (build-report-make-output-get)))
- (file (car files)))
- (while file
- (if (file-exists-p file)
- (insert (build-report-insert-make-output report-begin file))
- (insert (format "%s not found!\n" file)))
- (insert "\n")
- (setq files (cdr files))
- (setq file (car files)))
- (if (file-exists-p build-report-installation-file)
- (insert (build-report-insert-installation-file
- report-begin
- build-report-installation-insert-all))
- (insert (format "%s not found!\n" build-report-installation-file)))
-;;; (when (and (>= major 21) (>= minor 2) (or (null beta) (>= beta 32)))
-;;; (insert "\n")
-;;; (insert (build-report-insert-config-inc report-begin)))
- (insert "\n")
- (insert (build-report-insert-header report-begin))
- (goto-char report-begin))))
-
-(defun build-report-insert-header (where)
- "Inserts the build-report-header at the point specified by `where'."
- (goto-char where)
- (with-temp-buffer
- (insert
- (format "
-> XEmacs Build Report generated by emacs-version
-> %s
-> with system-configuration
-> %s
-> follows:\n\n" emacs-version system-configuration))
- (buffer-string)))
-
-(defun build-report-insert-make-output (where file)
- "Inserts the output of the XEmacs Beta make run in the
-current buffer at position WHERE.
-The make process output must have been saved in
-`build-report-make-output-files' during the XEmacs Beta building."
- (goto-char where)
- (with-temp-buffer
- (if (file-exists-p file)
- (progn
- (if (featurep 'mime-setup)
- (progn
- (mime-edit-insert-tag
- "text"
- "plain"
- (concat
- "\nContent-Disposition: attachment;"
- " filename=\""
- (file-name-nondirectory
- file)
- "\""))
- (mime-edit-insert-binary-file
- file
- build-report-file-encoding))
- (insert-file-contents file))
- (when build-report-keep-regexp
- (goto-char (point-min))
- (delete-non-matching-lines (build-report-keep)))
- (when build-report-delete-regexp
- (goto-char (point-min))
- (delete-matching-lines (build-report-delete)))
- (goto-char (point-min))
- (if build-report-keep-regexp
- (insert
- (format
- "> keeping lines matching
-> \"%s\"
-"
- (build-report-keep))))
- (if build-report-delete-regexp
- (insert
- (format
- "> %sdeleting lines matching
-> \"%s\"
-"
- (if build-report-keep-regexp
- "and then "
- "")
- (build-report-delete))))
- (insert "\n")
- (goto-char (point-min))
- (insert
- (format "> Contents of %s\n" file)))
- (insert "> " file
- " does not exist!\n\n"))
- (buffer-string)))
-
-(defun build-report-insert-installation-file (where all)
- "Inserts the contents of the `build-report-installation-file'
-created by the XEmacs Beta configure process."
- (goto-char where)
- (with-temp-buffer
- (if (file-exists-p build-report-installation-file)
- (let (file-begin last-configure)
- (insert "> Contents of "
- build-report-installation-file
- ":\n")
- (insert
- (format
- "> (Output from %s of ./configure)\n\n"
- (if all "all runs" "most recent run")))
- (if (featurep 'mime-setup)
- (progn
- (mime-edit-insert-tag
- "text"
- "plain"
- (concat
- "\nContent-Disposition: attachment;"
- " filename=\""
- (file-name-nondirectory
- build-report-installation-file)
- "\""))
- (mime-edit-insert-binary-file
- build-report-installation-file
- build-report-file-encoding)
- (setq file-begin (mime-edit-content-beginning)))
- (setq file-begin (point))
- (insert-file-contents
- build-report-installation-file))
- (unless all
- (setq last-configure
- (search-backward-regexp
- "^\\(uname.*\\|osversion\\|OS\\):\\s-+" file-begin t))
- (if (and file-begin last-configure)
- (delete-region file-begin last-configure))))
- (insert "> " build-report-installation-file
- " does not exist!\n\n"))
- (buffer-string)))
-
-(defun build-report-keep ()
- "Concatenate elements of `build-report-keep-regexp' and a general
-MIME tag REGEXP. The result is a REGEXP string matching either of the
-REGEXPs in `build-report-keep-regexp' or a general MIME tag REGEXP."
- (mapconcat #'identity
- (cons "^--\\[\\[\\|\\]\\]$" build-report-keep-regexp) "\\|"))
-
-(defun build-report-delete ()
- "Concatenate elements of `build-report-delete-regexp' and a general
-MIME tag REGEXP. The result is a REGEXP string matching either of the
-REGEXPs in `build-report-delete-regexp' or a general MIME tag REGEXP."
- (mapconcat '(lambda (item) item)
- build-report-delete-regexp "\\|"))
-
-(defun build-report-installation-data (&optional file)
- "Return a list of XEmacs installation data containing MAJOR_NUMBER
-MINOR_NUMBER BETA_STRING CODENAME CONFIGURATION SRCDIR from FILE,
-which defaults to `build-report-installation-file'."
- (interactive "fInstallation file: ")
- (unless file
- (setq file build-report-installation-file))
- (let
- (major minor beta codename extraname configuration srcdir)
- (save-window-excursion
- (find-file-read-only file)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond
- ((looking-at build-report-installation-version-regexp)
- (goto-char (match-end 0))
- (setq major (or (match-string 1) ""))
- (setq minor (or (match-string 2) ""))
- (setq beta (or (match-string 3) ""))
- (setq codename (or (match-string 6) ""))
- (setq extraname (or (match-string 7) ""))
- (setq configuration (or (match-string 8) "")))
- ((looking-at build-report-installation-srcdir-regexp)
- (goto-char (match-end 0))
- (setq srcdir (or (match-string 1) "")))
- ;; We avoid matching a potentially zero-length string to avoid
- ;; infinite looping.
- ((looking-at
- "^.+$")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (goto-char (match-end 0)))))
- (values major minor (or beta "") codename extraname configuration srcdir))))
-
-(defun build-report-version-file-data (&optional file)
- "Return a list of XEmacs version information containing
-MAJOR_NUMBER MINOR_NUMBER BETA_STRING CODENAME from FILE, which
-defaults to `build-report-version-file'."
- (interactive "fversion.sh file: ")
- (unless file
- (setq file build-report-version-file))
- (let
- (major minor beta codename extraname)
- (save-window-excursion
- (find-file-read-only file)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond
- ((looking-at build-report-version-file-regexp)
- (goto-char (match-end 0))
- (setq major (or (match-string 1) ""))
- (setq minor (or (match-string 2) ""))
- (setq beta (or (match-string 3) ""))
- (setq codename (or (match-string 4) ""))
- (setq extraname (or (match-string 6) "")))
- ;; We avoid matching a potentially zero-length string to avoid
- ;; infinite looping.
- ((looking-at
- "^.+$")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (goto-char (match-end 0)))))
- (values major minor (or beta "") codename extraname))))
-
-;;; build-report.el ends here
+++ /dev/null
-;;; $Id: build.el,v 1.52 2003-10-13 15:52:13 james Exp $
-
-;;{{{ Legalese
-
-;; Copyright (C) 1997-2002 Adrian Aichner
-
-;; Author: Adrian Aichner <adrian@xemacs.org>
-;; Date: $Date: 2003-10-13 15:52:13 $
-;; Version: $Revision: 1.52 $
-;; Keywords: internal
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the Free
-;; Software Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA
-;; 02111-1307, USA.
-
-;;; Synched up with: Not synched.
-
-;;}}}
-
-;;{{{ provide/require
-
-(provide 'build)
-
-(require 'custom)
-(require 'cus-edit)
-(require 'widget)
-(if (featurep 'sxemacs)
- (require 'build-rpt)
- (require 'build-report))
-
-(autoload 'ring-insert-at-beginning "ring")
-(autoload 'efs-copy-file "efs")
-
-;; `url-copy-file' (buffer: build.el, mode: Lisp)
-
-(eval-when-compile
- (require 'cl))
-
-;; Pull in compile, if it is available.
-(condition-case nil
- (require 'compile)
- (error nil))
-
-(eval-when-compile
- (require 'wid-edit))
-
-;; Pull in pcl-cvs, if it is available.
-(condition-case nil
- (require 'pcl-cvs)
- (error nil))
-
-;;}}}
-
-(defcustom build-from-what
- "Tarballs"
- "The Source Code units XEmacs is to be built from (\"Tarballs\" or
-\"CVS\")."
- :type '(choice
- :custom-state t
- (const "Tarballs")
- (const "CVS"))
- :group 'build)
-
-(defcustom build-with-what
- "GNU Tools"
- "The Toolset XEmacs is to be built with (\"GNU Tools\" or
-\"Microsoft Tools\")."
- :type '(choice
- :custom-state t
- (const "GNU Tools")
- (const "Microsoft Tools"))
- :group 'build)
-
-;;{{{ Version info
-
-;;;
-;;; Version-handling, based on ideas from w3.
-;;;
-(defconst build-version-number
- (let ((x "2.00"))
- (if (string-match "Name:[ \t\n]+\\([^\n]+\\) \\$" x)
- (setq x (match-string 1 x))
- (setq x (substring x 0)))
- (mapconcat
- (function (lambda (x) (if (= x ?-) "." (char-to-string x)))) x ""))
- "Version number of build package.")
-
-(defconst build-version-date
- (let ((x "2002-03-07"))
- (if (string-match "Date:[ \t\n]+\\([^\n]+\\) \\$" x)
- (match-string 1 x)
- x))
- "Date this version of build was released.")
-
-(defconst build-version
- (format "build %s %s" build-version-number build-version-date)
- "More descriptive version of build-version-number.")
-
-;;;###autoload
-(defun build-version (&optional here)
- "Show the version number of `build' in the minibuffer.
-If optional argument HERE is non-nil, insert info at point."
- (interactive "P")
- (if here
- (insert build-version)
- (if (interactive-p)
- (message-or-box "%s" build-version)
- build-version)))
-;;}}}
-
-;;{{{ Build
-
-(defgroup build nil
- "Simplifies Building XEmacs; i.e. Fetching, Configuring, Making, and
-Reporting."
- :link '(url-link :tag "XEmacs Build Reference Manual"
- "http://www.xemacs.org/Documentation/packages/html/build.html")
- :link '(url-link :tag "XEmacs Beta README"
- "ftp://ftp@ftp.xemacs.org/pub/xemacs/beta/README")
- :link '(url-link :tag "XEmacs Gamma README"
- "ftp://ftp@ftp.xemacs.org/pub/xemacs/gamma/README")
- :link '(url-link :tag "XEmacs Stable README"
- "ftp://ftp@ftp.xemacs.org/pub/xemacs/stable/README")
- :group 'emacs)
-
-
-(defun build-call-process (command infile buffer displayp)
- (let (exit-status result)
- (with-temp-buffer
- (condition-case signal
- (setq exit-status
- (apply 'call-process
- (append
- (list (car command) infile buffer displayp)
- (cdr command))))
- (error
- (warn "\n%s\ncannot be executed: %S %S\n"
- (mapconcat 'identity command " ")
- (car signal) (cdr signal))))
- ;; return value of result
- (setq result (cons exit-status (buffer-string))))))
-
-;;;###autoload
-(defun build ()
- "Creates a widget-based interface to build a beta/release version of
-XEmacs. All aspects of fetching tarballs, configuring, making and
-reporting can be customized and executed from the newly created buffer
-*Build*."
- (interactive)
- (let
- (exit-status
- (command
- (list
- "cvs" "-v"))
- infile
- (buffer (list t t))
- displayp
- result
-; build-from-cvs-button-widget
-; build-from-tarballs-button-widget
- (name "*Build XEmacs*"))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- ;; Determine availability of CVS client.
- (message-or-box
- "build: checking whether you have cvs, please wait")
- (setq result
- (build-call-process command infile buffer displayp))
- (cond
- ((null (car result))
- (setq build-cvs-available-p nil)
- (warn "\nprogram %s cannot be found or executed\n"
- (car command))
- (setq build-from-what "Tarballs"))
- ((/= (car result) 0)
- (setq build-cvs-available-p nil)
- (warn "\n%s\nfailed with following output:\n%s\n"
- (mapconcat 'identity command " ")
- (cdr result))
- (setq build-from-what "Tarballs")
- (widget-insert
- "\n\nPlease install cvs, unless you want to build from our tarballs.\n"))
- (t
- (setq build-cvs-available-p t)
- (setq build-from-what "CVS")
- (message-or-box
- "build: cvs is available")))
- ;; Create widget-based interface.
- (widget-insert
- "Visit info documentation for the XEmacs build package inside ")
- (widget-create
- 'info-link
- :tag "XEmacs"
- :value "(build)")
- (widget-insert "\nor on the XEmacs website at\n")
- (widget-create
- 'url-link
- :value
- "http://www.xemacs.org/Documentation/packages/html/build.html")
- (widget-insert "\n\n")
- (let
- ((inhibit-read-only t))
- (setq build-current-build-settings-widget
- (widget-create
- 'string
- :tag "Current Build Settings"
- :value
- "unknown")))
- (widget-apply
- build-current-build-settings-widget
- :deactivate)
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- ((name (widget-value build-settings-widget)))
- (widget-apply
- build-current-build-settings-widget
- :activate)
- (widget-value-set
- build-current-build-settings-widget
- name)
- (widget-apply
- build-current-build-settings-widget
- :deactivate)
- (widget-setup)
- (build-settings-load name build-settings)
- (message-or-box
- "loaded \"%s\" build-settings"
- name)))
- "Load")
- (widget-insert " ")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let*
- ((args
- (widget-get build-settings-widget :args))
- (value (widget-value build-settings-widget))
- new-args)
- (if (string= value "default")
- (message-or-box
- "cannot delete \"%s\" build-settings"
- value)
- (when
- (yes-or-no-p
- (format "delete \"%s\" build-settings? " value))
- (setq
- new-args
- (remrassoc
- (list
- :value
- value)
- args))
- (widget-put
- build-settings-widget
- :args new-args)
- (widget-put
- build-settings-name-widget
- :args
- (cons (list 'string :value "default")
- new-args))
- (widget-value-set
- build-settings-widget
- (widget-get
- (first (widget-get build-settings-widget :args))
- :value))
- (widget-setup)
- (setq
- build-settings
- (remassoc
- value
- build-settings))
- (message-or-box
- "deleted \"%s\" build-settings"
- value)))))
- "Delete")
- (widget-insert " ")
- (setq build-settings-widget
- (widget-create 'choice
- :tag "build settings"
- :value "default"
- :args
- (cons
- (list 'item :value "default")
- (mapcar
- (function
- (lambda (setting)
- (let ((name setting))
- (list 'item :value (car setting)))))
- build-settings))
-; :notify (lambda (widget &rest ignore)
-; (setq build-settings (widget-value widget)))
- '(item :value "default")))
- (widget-value-set
- build-settings-widget
- (widget-get
- (first (widget-get build-settings-widget :args))
- :value))
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- ((name
- (widget-value build-settings-name-widget)))
- (unless
- (and
- (assoc name build-settings)
- (not
- (yes-or-no-p
- (format "overwrite current \"%s\" build-settings? " name))))
- (setq
- build-settings
- (build-settings-save-custom-group
- 'build
- name
- build-settings))
- (unless
- (rassoc
- (cdr (list 'item :value name))
- (widget-get build-settings-widget :args))
- (widget-put
- build-settings-widget
- :args
- (cons (list 'item :value name)
- (widget-get build-settings-widget :args)))
- (widget-put
- build-settings-name-widget
- :args
- (cons (list 'item :value name)
- (widget-get build-settings-name-widget :args))))
- (customize-save-variable 'build-settings build-settings)
- (message-or-box
- "saved \"%s\" build-settings"
- name))))
- "Save")
- (widget-insert " ")
- (setq build-settings-name-widget
- (widget-create 'choice
- :tag "current build settings as"
- :value "default"
- :args
- (cons
- (list 'string :value "default")
- (mapcar
- (function
- (lambda (setting)
- (let ((name setting))
- (list 'item :value (car setting)))))
- build-settings))
-; :notify (lambda (widget &rest ignore)
-; (setq build-settings (widget-value widget)))
- ))
- (widget-insert "Build settings are named build configurations allowing you to switch\nbetween them quickly, once you have set them up and saved them. Please\nmake sure you have gone through all required customizations of the\nbuild process before you save them. You may change existing settings\nat a later time, though.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build))
- "Browse Build Options ...")
- (widget-insert "\nBrowse and customize any options of the build process according to\nyour current choices for the sources to build from and the tools to\nbuild with.\n")
- (setq build-from-what-choice-widget
- (widget-create 'choice
- :tag "Build from"
- :value build-from-what
- :notify (lambda (widget &rest ignore)
- (setq build-from-what (widget-value widget))
- (cond
- ((string-equal build-from-what "CVS")
- (widget-apply
- build-from-cvs-button-widget
- :activate)
- (widget-apply
- build-from-tarballs-button-widget
- :deactivate))
- ((string-equal build-from-what "Tarballs")
- (widget-apply
- build-from-cvs-button-widget
- :deactivate)
- (widget-apply
- build-from-tarballs-button-widget
- :activate))))
- '(item :value "CVS")
- '(item :value "Tarballs")))
- (widget-insert
- "Please decide now whether to build XEmacs from tarballs in .tar.gz\nformat or from CVS sources. Using CVS is highly recommended.")
- (widget-insert "\n\n")
- (setq build-with-what-choice-widget
- (widget-create 'choice
- :tag "Build with"
- :value build-with-what
- :notify (lambda (widget &rest ignore)
- (setq build-with-what (widget-value widget)))
- '(item :value "GNU Tools")
- '(item :value "Microsoft Tools")
- ))
- (widget-insert
- "Furthermore, please specify whether you will build with GNU tools\nusing configure and make or Microsoft Tools using nt\\xemacs.mak and\nVC++ 4.0 or higher.")
- (widget-insert "\n\n")
- (setq
- build-from-cvs-button-widget
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-from-CVS))
- "Build XEmacs From CVS Now"))
- (widget-insert "\n")
- ;; Recommend installation of CVS or provide cvs version
- ;; information.
- (if build-cvs-available-p
- (widget-insert (format "cvs -v returns this:\n%s\n" (cdr result)))
- (widget-insert
- "\n\nPlease install cvs, unless you want to build from our tarballs.\n"))
- ;; Building XEmacs from tarballs.
- (setq
- build-from-tarballs-button-widget
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-from-tarballs))
- "Build XEmacs From Tarballs Now"))
- ;; Initialize these buttons according to `build-from-what'.
- (cond
- ((string-equal build-from-what "CVS")
- (widget-apply
- build-from-cvs-button-widget
- :activate)
- (widget-apply
- build-from-tarballs-button-widget
- :deactivate))
- ((string-equal build-from-what "Tarballs")
- (widget-apply
- build-from-cvs-button-widget
- :deactivate)
- (widget-apply
- build-from-tarballs-button-widget
- :activate)))
- (widget-insert
- "\nProceed after you have chosen what sources to build from and what\ntools to build with.\n")
-; (widget-browse-other-window build-settings-widget)
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-;;}}}
-
-;;{{{ Build Compilation
-
-;;{{{ Compilation
-(make-variable-buffer-local
- 'compilation-finish-function)
-(make-variable-buffer-local
- 'compilation-exit-message-function)
-
-(setq
- compilation-finish-function
- 'build-compilation-finish-function
- compilation-exit-message-function
- (function build-compilation-exit-message-function))
-
-;;}}}
-
-(defun build-compilation-mode-hook ()
- (set (make-local-variable 'auto-save-hook)
- '(lambda ()
- (message "Auto-saved %s\n" (buffer-name))))
- (auto-save-mode 1)
- (insert
- (format
- "Compilation started at %s %+.4d (%s)\n"
- (current-time-string)
- (/ (nth 0 (current-time-zone)) 36)
- (nth 1 (current-time-zone)))))
-
-(defun build-compilation-finish-function (comp-buffer finish-string)
- (message "Build Make finished in %s with status \"%s\"."
- (buffer-name comp-buffer) finish-string))
-
-(defun build-compilation-exit-message-function (proc exit-msg)
- (message "Build Make exited with proc status \"%s\", exit status \"%s\", exit message \"%s\"."
- (process-status proc) (process-exit-status proc) exit-msg)
- (cons exit-msg (process-exit-status proc)))
-
-;;}}}
-
-;;{{{ Build Configure
-
-(defconst build-configure-option-category
- "^\\(\\S-+\\).+\\(options\\|features\\):$"
- "REGEXP matching an XEmacs configuration option category in
-configure.usage")
-
-(defconst build-configure-option-paragraph
- "^\\(--[a-zA-Z][-a-zA-Z0-9]+\\)\\(=\\(\\S-+\\)\\)?\\(\\s-+(\\*)\\)?\\s-+\\(\\(.+\\)\\(\n[ \t]+.+\\)*\\)$"
- "REGEXP matching one XEmacs configuration option in
-configure.usage")
-
-(defun build-configure (&optional dir)
- "Configure XEmacs according to the settings in customized group
-`build' and its members."
- (interactive)
- (if dir
- (cd dir))
- (let ((cmd
- (format "sh configure%s"
- (mapconcat
- (function (lambda (e)
- (cond
- ((or (string= "" (rest e))
- (string= "autodetected" (rest e))
- (string= "defaulted" (rest e)))
- "")
- ((string= "yes" (rest e))
- (format " '%s'" (first e)))
- ((and
- (string-match "\\`--without-\\(.+\\)\\'" (first e))
- (string= "no" (rest e)))
- (format " '-with-%s'" (match-string 1 (first e))))
- (t
- (format " '%s=%s'" (first e) (rest e))))))
- (delete-duplicates
- build-configure-options :from-end t
- :test (lambda (a b)
- (string=
- (first a) (first b))))
- "")))
- (compilation-mode-hook
- 'build-compilation-mode-hook)
- (compilation-buffer-name-function
- '(lambda (mode)
- (generate-new-buffer-name
- (cond
- ((string-equal build-from-what "Tarballs")
- (concat build-tarball-prefix "-configure.err"))
- ((string-equal build-from-what "CVS")
- (concat build-cvs-checkout-dir "-configure.err")))
- ))))
- (compile cmd)))
-
-;;; Functionality which was prototyped in co2cu.el:
-
-(defun build-configure-customize (a-list)
- (mapcar
- (lambda (cat)
- (princ (format "(defgroup build-configure-%s nil\n" (first cat)))
- (princ (format " \"%s options.\"\n" (first cat)))
- (princ " :group 'build-configure)\n\n")
- (list (first cat)
- (mapcar
- (lambda (opt)
- (cond
- ((or (member "TYPE[,TYPE]..." (second opt))
- (and (member "TYPE" (second opt))
- (string-match
- "list\\s-+of"
- (apply 'concat (fourth opt)))))
- (build-configure-types cat opt)
- )
- ((member "TYPE" (second opt))
- (build-configure-type cat opt)
- )
- ((member "FLAGS" (second opt))
- (build-configure-string cat opt)
- )
- ;; compiler=XXXX prior to r21.0-b34
- ((member "XXXX" (second opt))
- (build-configure-file cat opt)
- )
- ;; compiler=prog after Martin Buchholz's configure
- ;; mega-patch to r21.0-b34-pre2
- ((member "prog" (second opt))
- (build-configure-file cat opt)
- )
- ((member "VALUE" (second opt))
- (build-configure-string cat opt)
- )
- ((member "DIR" (second opt))
- (build-configure-dir cat opt)
- )
- ((member "LIB" (second opt))
- (build-configure-file cat opt)
- )
- ((member "PATH" (second opt))
- (build-configure-path cat opt)
- )
- ((or (null (second opt))
- (subsetp (second opt)
- '("no" "yes") :test 'string-equal))
- (build-configure-type cat opt)
- )
- (t
- (build-configure-type cat opt)
- )
- ))
- (delete-duplicates
- (cdr cat) :from-end t
- :test (lambda (a b)
- (string=
- (first a) (first b)))))))
- a-list))
-
-(defun build-configure-process-option (option value detected doc category a-list)
- (let (prev-val prev-doc pos doc-vals)
- (unless (null value)
- (setq prev-val
- (first (cdr (assoc option (assoc category a-list)))))
- (setq prev-val
- (append prev-val (list value))))
- (setq detected
- (or
- (second (cdr (assoc option (assoc category a-list))))
- (null (null detected))))
- (setq prev-doc
- (third (cdr (assoc option (assoc category a-list)))))
- (unless (null doc)
- (setq prev-doc (append prev-doc (list doc)))
- (setq pos 0)
- (setq doc-vals (concat (first prev-doc)))
- (while (string-match "`\\(\\w+\\)'" doc pos)
- (setq prev-val
- (append prev-val (list (match-string 1 doc))))
- (setq pos (match-end 0)))
- (unless
- (null
- (string-match "\\([Vv]alid\\s-+types\\s-+are\\s-+\\|(\\)\\(\\(\\w+\\)\\(,\\s-*\\(\\(and\\|or\\)\\s-+\\)?\\(\\w+\\)\\)+\\)\\()\\|\\.\\)" doc 0))
- (setq doc-vals (match-string 2 doc))
- (setq pos 0)
- (while
- (string-match "\\(\\(,\\s-*\\(\\(and\\|or\\)\\s-+\\)?\\)?\\(\\w+\\)\\)" doc-vals pos)
- (setq prev-val
- (append prev-val (list (match-string 5 doc-vals))))
- (setq pos (match-end 0)))))
- (setcdr
- (assoc category a-list)
- (acons
- option
- (list prev-val detected prev-doc)
- (cdr (assoc category a-list))))))
-
-(defun build-configure-generate (&optional file)
- (interactive "fconfigure.usage file: ")
- (unless file
- (setq file
- (expand-file-name
- "configure.usage"
- (cond
- ((string-equal build-from-what "Tarballs")
- (expand-file-name
- build-tarball-prefix
- build-tarball-dest))
- ((string-equal build-from-what "CVS")
- (expand-file-name
- build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))))))
- (let
- (category categories option value detected doc build-configure-alist
- (buffer "build-configure.el"))
- (kill-buffer (get-buffer-create buffer))
- (with-output-to-temp-buffer buffer
- (save-window-excursion
- (find-file-read-only file)
- (build-configure-prolog file)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond
- ((looking-at build-configure-option-paragraph)
- (goto-char (match-end 0))
- (build-configure-process-option
- (match-string 1)
- (match-string 3)
- (match-string 4)
- (match-string 5)
- category
- build-configure-alist))
- ((looking-at build-configure-option-category)
- (goto-char (match-end 0))
- (setq category (match-string 1))
- (setq build-configure-alist
- (append build-configure-alist (list (list category)))))
- ;; We avoid matching a potentially zero-length string to
- ;; avoid infinite looping.
- ((looking-at
- "^.+$")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (goto-char (match-end 0)))))
- (build-configure-customize build-configure-alist)
-; (print build-configure-alist)
- ))
-; (set-buffer buffer)
-; (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- (lisp-mode)
- (font-lock-mode 1)
- (toggle-read-only 1)))
-
-(defun build-configure-string (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ " \"\"\n")
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(string)\n")
- (princ " :set 'build-configure-set-value)\n")
- (princ "\n"))
-
-(defun build-configure-file (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ " \"\"\n")
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(file)\n")
- (princ " :set 'build-configure-set-value)\n")
- (princ "\n"))
-
-(defun build-configure-dir (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ " \"\"\n")
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(directory)\n")
- (princ " :set 'build-configure-set-value)\n")
- (princ "\n"))
-
-(defun build-configure-path (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ " '()\n")
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(repeat\n")
- (princ " :custom-show t\n")
- (princ " :documentation-shown t\n")
- (princ " (directory))\n")
- (princ " :set 'build-set-path)\n")
- (princ "\n"))
-
-(defun build-configure-types (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ (format " '(%S)\n"
- (if (third opt) "autodetected" "defaulted")))
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(choice\n")
- (if (third opt)
- (princ " (const (\"autodetected\"))\n")
- (princ " (const (\"defaulted\"))\n"))
- (princ " (const (\"no\"))\n")
- (princ " (set")
- (mapc (lambda (e)
- (princ (format "\n (const %S)" e)))
- (set-difference
- (second opt)
- '("no" "TYPE[,TYPE]..." "TYPE")
- :test 'string=))
- (princ "))\n")
- (princ " :set 'build-set-types)\n")
- (princ "\n"))
-
-(defun build-configure-type (cat opt)
- (princ (format "(defcustom build-configure%s\n" (first opt)))
- (princ (format " %S\n"
- (if (third opt) "autodetected" "defaulted")))
- (princ (format " %S\n" (build-configure-fill-doc (fourth opt))))
- (princ (format " :group \'build-configure-%s\n" (first cat)))
- (princ " :type '(choice\n")
- (if (third opt)
- (princ " (const \"autodetected\")\n")
- (princ " (const \"defaulted\")\n"))
- (princ " (const \"no\")")
- (if (subsetp (second opt) '("no" "yes") :test 'string-equal)
- (princ "\n (const \"yes\")")
- (mapc (lambda (e)
- (princ (format "\n (const %S)" e)))
- (set-difference
- (second opt)
- '("no" "TYPE[,TYPE]..." "TYPE")
- :test 'string=)))
- (princ ")\n")
- (princ " :set 'build-configure-set-value)\n")
- (princ "\n"))
-
-(defun build-configure-fill-doc (doc)
- (with-temp-buffer
- (let ((sentence-end-double-space t)
- (use-hard-newlines t)
- (colon-double-space t))
- (insert (mapconcat 'eval doc " "))
- (canonically-space-region (point-min) (point-max))
- (fill-region (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "\\s-+\\'" nil t)
- (replace-match "" nil nil))
- (buffer-string))))
-
-(defun build-configure-prolog (file)
- (princ ";;; Produced from
-;;; ")
- (princ file)
- (princ "
-;;; by ")
- (princ
- ;; Make sure the RCS keyword Id does not end up in the output file,
- ;; in case build.el is not `co -kv ...' or during development.
- (with-temp-buffer
- (insert build-version)
- (while (re-search-backward "\\$" nil t)
- (replace-match "" nil nil))
- (buffer-string)))
- (princ "\n;;; at\n;;; ")
- (princ (format-time-string "%a %b %d %T %Z %Y"))
- (princ "
-(provide 'build-configure)\n
-(setq build-configure-options nil)\n
-(defun build-configure-sym-to-opt (sym)
- (substring (symbol-name sym) 15))\n
-(defun build-set-path (sym val)
- (setq build-configure-options
- (acons (build-configure-sym-to-opt sym)
- (mapconcat '(lambda (item) item) val \":\")
- build-configure-options))
- (set-default sym val))\n
-(defun build-set-types (sym val)
- (setq build-configure-options
- (acons (build-configure-sym-to-opt sym)
- (mapconcat '(lambda (item) item) val \",\")
- build-configure-options))
- (set-default sym val))\n
-(defun build-configure-set-value (sym val)
- (setq build-configure-options
- (acons (build-configure-sym-to-opt sym) val
- build-configure-options))
- (set-default sym val))\n
-(defgroup build-configure nil
- \"XEmacs Build Configuration.\"
- :group 'build)\n
-"))
-
-;;}}}
-
-;;{{{ Build CVS
-
-(defvar build-cvs-available-p nil
- "Internal variable keeping track whether CVS is available.")
-
-(defgroup build-cvs nil
- "Standardizes the fetching of XEmacs from the CVS repository."
- :group 'build)
-
-(defun build-cvs-get-branch-and-release-tags ()
- "Retrieve all symbolic names (CVS tags) for XEmacs from version.sh."
- (interactive)
- (let*
- (exit-status
- (file "XEmacs/xemacs/version.sh")
- (co-command
- (list
- "cvs" "-d" build-cvs-xemacs-repository "checkout" file))
- (status-command
- (list
- "cvs" "-d" build-cvs-xemacs-repository "status" "-v" file))
- infile
- (buffer (list t t))
- displayp
- result
- last-match-end
- this-match-beginning
- tags)
- (with-temp-buffer
- (cd (temp-directory))
- (unless
- (file-exists-p file)
- (message-or-box
- "build: checking out %s to determine cvs tags" file)
- (setq result
- (build-call-process co-command infile buffer displayp))
- (cond
- ((null (car result))
- (warn "\nprogram %s cannot be found or executed\n"
- (car co-command)))
- ((/= (car result) 0)
- (warn "\n%s\nfailed with following output:\n%s\n"
- (mapconcat 'identity co-command " ")
- (cdr result)))
- (t
- (message-or-box
- "build: %s has been checked out" file))))
- (message-or-box
- "build: retrieving cvs tags from %s" file)
- (setq result
- (build-call-process status-command infile buffer displayp))
- (cond
- ((null (car result))
- (warn "\nprogram %s cannot be found or executed\n"
- (car status-command)))
- ((/= (car result) 0)
- (warn "\n%s\nfailed with following output:\n%s\n"
- (mapconcat 'identity status-command " ")
- (cdr result)))
- (t
- (message-or-box
- "build: cvs tags have been retrieved from %s" file)))
- (if
- (setq this-match-beginning
- (string-match "^\\s-+Existing Tags:\n" (cdr result)))
- (setq last-match-end (match-end 0)))
- (while
- (and
- (setq this-match-beginning
- (string-match
- "\t\\(\\S-+\\)\\s-+\\(.*\\)\n" (cdr result) last-match-end))
- (= last-match-end this-match-beginning))
- (setq last-match-end (match-end 0))
- (if last-match-end
- (push (list
- (match-string 1 (cdr result))
- (match-string 2 (cdr result))) tags)))
- (reverse tags))))
-
-(defun build-cvs-checkout-options-validate (sym val)
- (cond
- ((string-match "-\\(d\\|N\\)\\b" val)
- (customize-set-value sym build-cvs-checkout-options)
- (warn "cannot use -d and -N. `build-cvs-checkout-dir' will be used as -d argument if set, else `build-cvs-xemacs-module' will be used. The -N option is unsupported."))
- (t
- (build-cvs-set-var-and-update-buffer sym val))))
-
-(defun build-cvs-set-var-and-update-buffer (sym val)
- "Internal function for build."
- (set-default sym val)
- (when (fboundp 'build-from-CVS)
- (save-window-excursion
- (save-excursion
- (build-from-CVS)))))
-
-(defcustom build-cvs-checkout-options
- "-P"
- "CVS checkout command-line options to use for all CVS commands."
- :type 'string
- :set 'build-cvs-checkout-options-validate
- :group 'build-cvs)
-
-(defcustom build-cvs-options
- "-z3"
- "CVS command-line options to use for all CVS commands."
- :type 'string
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defcustom build-cvs-update-options
- "-P -d"
- "CVS update command-line options to use for all CVS commands."
- :type 'string
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defcustom build-cvs-checkout-parent-dir
- (temp-directory)
- "The parent directory on the local host into which the
-`build-cvs-xemacs-module' will be checked out, named according to
-`build-cvs-checkout-dir'."
- :type 'directory
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defconst build-cvs-xemacs-module
- "xemacs"
- "CVS XEmacs module name to be checked out.")
-
-(defvar build-cvs-checkout-dir
- nil
- "Internal variable updated from user variable
- `build-cvs-working-dir-naming'.")
-
-(defcustom build-cvs-use-pcl-cvs
- nil
- "*Whether build is to use PCL-CVS, when available.
-Alternatively, build will run CVS commands via `compile'."
- :type 'boolean
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defcustom build-cvs-xemacs-repository
- ":pserver:cvs@cvs.xemacs.org:/pack/xemacscvs"
- "CVS Repository where XEmacs can be checked out from."
- :type 'string
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defcustom build-cvs-working-dir-naming
- '(format "%s-%s"
- build-cvs-xemacs-module
- build-cvs-xemacs-release)
- "The naming of the directory on the local host into which the
-`build-cvs-xemacs-module' will be checked out. Be aware that cvs
-checkout options -d and -N will affect the resulting directory
-structure. Therefor these options are disallowed in
-`build-cvs-checkout-options'. The -N option is not supported, in order
-to avoid unknown directory structures."
- :type '(choice
- (const :tag "Named after CVS MODULE" build-cvs-xemacs-module)
- (const :tag "Named after RELEASE Tag" build-cvs-xemacs-release)
- (const :tag "Named after MODULE-RELEASE"
- (format "%s-%s"
- build-cvs-xemacs-module
- build-cvs-xemacs-release))
- (string :tag "Working Dir Named manually" ""))
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defcustom build-cvs-xemacs-release
- "HEAD"
- "CVS XEmacs release to be checked out.
-The list of available releases is updated via cvs, if installed, by
-`build-from-CVS'. Use \"Specify Tag Name\" to fill in the name of a
-release tag not yet in the list of choices."
- :type '(choice :custom-state t
- (string :tag "Unlisted Release Name" "")
- (const :tag "release-21-1 (branch: 1.165.2)" "release-21-1")
- (const :tag "release-21-4 (branch: 1.166.2)" "release-21-4")
- (const :tag "r21-5-9 (revision: 1.183)" "r21-5-9"))
- :set 'build-cvs-set-var-and-update-buffer
- :group 'build-cvs)
-
-(defun build-cvs-login ()
- "Login to XEmacs CVS repository."
- (interactive)
- (unless (file-exists-p build-cvs-checkout-parent-dir)
- (make-directory build-cvs-checkout-parent-dir t))
- (cd build-cvs-checkout-parent-dir)
- (let (exit-status
- (command
- (list
- "cvs" build-cvs-options "-d" build-cvs-xemacs-repository "login"))
- (file (make-temp-name (expand-file-name "cvs-login" (getenv "TEMP"))))
- (buffer (list t t))
- displayp)
- (with-temp-file file (insert "cvs\n"))
- (message-or-box "build: cvs login at cvs.xemacs.org, please wait")
- (setq result
- (build-call-process command file buffer displayp))
- (cond
- ((null (car result))
- (setq build-cvs-available-p nil)
- (warn "\nprogram %s cannot be found or executed\n"
- (car command)))
- ((/= (car result) 0)
- (setq build-cvs-available-p nil)
- (warn "\n%s\nfails with following output:\n%s\n"
- (mapconcat 'identity command " ")
- (cdr result)))
- (t
- (setq build-cvs-available-p t)
- (message-or-box "build: cvs login succeeded")))
- (delete-file file)))
-
-(defun build-cvs-checkout (&optional release-tag)
- "Fetch XEmacs from the repository."
- (interactive "sXEmacs Release Tag: ")
- (unless (file-exists-p build-cvs-checkout-parent-dir)
- (make-directory build-cvs-checkout-parent-dir t))
- (cd build-cvs-checkout-parent-dir)
- (let ((cmd
- (format "cvs %s -d%s checkout %s -d %s%s %s"
- build-cvs-options
- build-cvs-xemacs-repository
- build-cvs-checkout-options
- build-cvs-checkout-dir
- (if (and release-tag
- (not (string-equal release-tag "")))
- (concat " -r " release-tag)
- "")
- build-cvs-xemacs-module))
- (compilation-mode-hook
- 'build-compilation-mode-hook)
- (compilation-buffer-name-function
- '(lambda (mode)
- (generate-new-buffer-name
- (format "%s-cvs-checkout%s.err" build-cvs-checkout-dir
- (if (and release-tag
- (not (string-equal release-tag "")))
- (format "-%s" release-tag)
- ""))))))
- (compile cmd)))
-
-(defun build-cvs-update (&optional release-tag)
- "Update XEmacs from the repository to newest release or to release
-specified by RELEASE-TAG'."
- (interactive "sXEmacs Release Tag: ")
- (cd
- (expand-file-name build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))
- (let ((cmd
- (format "cvs %s update %s%s"
- build-cvs-options
- build-cvs-update-options
- (if (and release-tag
- (not (string-equal release-tag "")))
- (concat " -r " release-tag)
- " -A")
- ))
- (compilation-mode-hook
- 'build-compilation-mode-hook)
- (compilation-buffer-name-function
- '(lambda (mode)
- (generate-new-buffer-name
- (concat build-cvs-checkout-dir "-cvs-update"
- (when (and release-tag
- (not (string-equal release-tag "")))
- (format "-%s" release-tag))
- ".err")))))
- (cond
- ((and
- build-cvs-use-pcl-cvs
- (featurep 'pcl-cvs))
- (cvs-update
- (expand-file-name build-cvs-checkout-dir
- build-cvs-checkout-parent-dir)
- (split-string build-cvs-update-options "\\s-+")))
- (t
- (compile cmd)))))
-
-;;}}}
-
-;;{{{ Build From
-
-(defun build-from-CVS ()
- (interactive)
- (let
- ((name
- (format "*Build XEmacs From CVS With %s*" build-with-what)))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- (unless (file-exists-p build-cvs-checkout-parent-dir)
- (make-directory build-cvs-checkout-parent-dir t))
- (cd build-cvs-checkout-parent-dir)
- ;; #### FIXME build-cvs-checkout-dir is not driven by custom
- ;; events as it should be!
- (setq build-cvs-checkout-dir
- (eval build-cvs-working-dir-naming))
- (put 'build-cvs-xemacs-release 'custom-type
- (append
- '(choice
- :custom-state t)
- (cons
- '(string :tag "Unlisted Release Name" "")
- (mapcar
- (function
- (lambda (tag)
- (list
- 'const
- :tag (format "%s %s" (first tag) (second tag)) (first tag))))
- (build-cvs-get-branch-and-release-tags)))))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- ((buffer-back "*Build XEmacs*"))
- (if (buffer-live-p (get-buffer buffer-back))
- (switch-to-buffer buffer-back)
- (build))))
- "Go Back")
- (widget-insert
- "\nYou need to customize CVS options and then download a release\nof XEmacs.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-cvs))
- "Browse Build CVS Options ...")
- (widget-insert "\n")
- (widget-insert
- (format "\t%+20s: %s\n" "Use Pcl Cvs"
- (if build-cvs-use-pcl-cvs "Yes" "No")))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "XEmacs CVS Repository"
- build-cvs-xemacs-repository))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "CVS Options"
- build-cvs-options))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "Checkout Options"
- build-cvs-checkout-options))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "Update Options"
- build-cvs-update-options))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "XEmacs Module"
- build-cvs-xemacs-module))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "XEmacs Release"
- build-cvs-xemacs-release))
- (widget-insert
- (format "\t%+20s: %S\n" "Working Dir Naming"
- build-cvs-working-dir-naming))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "Checkout Parent Dir"
- build-cvs-checkout-parent-dir))
- (widget-insert
- (format "\t%+20s: \"%s\"\n" "Working Dir"
- build-cvs-checkout-dir))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-cvs-login))
- "CVS Login XEmacs")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-cvs-checkout
- build-cvs-xemacs-release))
- "CVS Checkout XEmacs")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-cvs-update
- build-cvs-xemacs-release))
- (format
- "CVS Update XEmacs To CVS Tag \"%s\""
- build-cvs-xemacs-release))
- (widget-insert "\nor\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-cvs-update))
- "CVS Update To Latest XEmacs on Trunk")
- (widget-insert "\nMake sure to \"Browse Build CVS Options ...\" first.\nChoose XEmacs release to be checked out.\nAlternatively you can simply get the latest sources on the trunk (not\non any branch). This is always the latest XEmacs version under\ndevelopment. As of 2002-03-14 the trunk is headed for XEmacs 21.5.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- ((dir
- (cond
- ((string-equal build-with-what "GNU Tools")
- (expand-file-name
- build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))
- ((string-equal build-with-what "Microsoft Tools")
- (expand-file-name
- "nt"
- (expand-file-name
- build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))))))
- (if
- (file-directory-p
- (file-name-as-directory dir))
- (cond
- ((string-equal build-with-what "GNU Tools")
- (build-with-GNU dir))
- ((string-equal build-with-what "Microsoft Tools")
- (build-with-MS dir)))
- (message-or-box "need to checkout to create %s?" dir))))
- (format "Build XEmacs With %s Now ..." build-with-what))
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-(defun build-from-tarballs ()
- (interactive)
- (let
- ((name
- (format "*Build XEmacs From Tarballs With %s*" build-with-what)))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- (cd build-tarball-dest)
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- ((buffer-back "*Build XEmacs*"))
- (if (buffer-live-p (get-buffer buffer-back))
- (switch-to-buffer buffer-back)
- (build))))
- "Go Back")
- (widget-insert
- "\nYou need to customize Tarball options and then download a beta/release\nversion of XEmacs.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-tarball))
- "Browse Build Tarball Options ...")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (dired build-tarball-site))
- "Browse Build Tarball Site ...")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-tarball-expand-all))
- "View Build Tarball Set ...")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-tarball-get-all))
- "Download Build Tarball Set")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-tarball-extract-all))
- "Install Downloaded Build Tarball Set")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (cond
- ((string-equal build-with-what "GNU Tools")
- (build-with-GNU
- (expand-file-name
- build-tarball-prefix
- build-tarball-dest)))
- ((string-equal build-with-what "Microsoft Tools")
- (build-with-MS
- (expand-file-name
- "nt"
- (expand-file-name
- build-tarball-prefix
- build-tarball-dest))))))
- (format "Build XEmacs With %s Now ..." build-with-what))
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-;;}}}
-
-;;{{{ Build Tarballs
-
-(defgroup build-tarball nil
- "Standardized the fetching of XEmacs beta/release tarballs."
- :group 'build)
-
-(defcustom build-tarball-dest
- (temp-directory)
- "The destination directory on the local host the `build-tarball-set'
-will be deposited in."
- :type 'directory
- :group 'build-tarball)
-
-(defcustom build-tarball-dir
- "beta"
- "The sub-directory under `build-tarball-site' in which the
-`build-tarball-set' is located."
- :type '(choice
- :custom-state t
- (const "beta")
- (const "gamma")
- (const "stable"))
- :group 'build-tarball)
-
-(defcustom build-tarball-prefix
- "xemacs-21.5.6"
- "The prefix shared among all of the `build-tarball-set'. This makes
-it easy to switch over from one beta/gamma/stable release tarball set
-to the next,
-e.g. from \"xemacs-21.5.5\" to \"xemacs-21.5.6\"."
- :type 'string
- :group 'build-tarball)
-
-(defcustom build-tarball-set
- nil
- "The set of final name components of XEmacs tarballs you wish to
-fetch."
- :type'(set
- (const :tag "XEmacs byte-compiled lisp tarball" "-elc.tar.gz")
- (const :tag "XEmacs byte-compiled lisp tarball signature" "-elc.tar.gz.asc")
- (const :tag "XEmacs info tarball" "-info.tar.gz")
- (const :tag "XEmacs info tarball signature" "-info.tar.gz.asc")
- (const :tag "XEmacs Mule tarball" "-mule.tar.gz")
- (const :tag "XEmacs Mule tarball signature" "-mule.tar.gz.asc")
- (const :tag "XEmacs source tarball" ".tar.gz")
- (const :tag "XEmacs source tarball signature" ".tar.gz.asc")
- (repeat
- :custom-show t
- :documentation-shown t
- (string "")))
- :group 'build-tarball)
-
-(defcustom build-tarball-site
- "/ftp@ftp.xemacs.org:/pub/xemacs/"
- "The EFS path to a top-level XEmacs directory to fetch the XEmacs
- `build-tarball-set' from.
-The list of available sites is dynamically generated based on
-`package-get-download-sites'. In addition you may set the value to a
-manually chosen EFS path."
- :link '(url-link :tag "XEmacs Download Locations"
- "http://www.xemacs.org/Download/")
- :type (append
- '(choice :custom-state t)
- (cons
- '(directory :tag "EFS Path" "/user@host.domain:/directory/")
- (remove
- nil
- (mapcar
- (function
- (lambda (entry)
- (let (comment host path efs-path)
- (setq comment (nth 0 entry)
- host (nth 1 entry)
- path (nth 2 entry))
- (when
- (and host
- (not (string-equal comment "Pre-Releases")))
- (setq efs-path (format "/ftp@%s:/%s" host path))
- (list
- 'const
- :tag (format "%s - %s" efs-path comment)
- (file-name-directory efs-path))))))
- package-get-download-sites))))
- :group 'build-tarball)
-
-(defun build-tarball-expand (item)
- (let ((prfx
- (expand-file-name
- build-tarball-prefix
- (concat build-tarball-site build-tarball-dir))))
- (concat prfx item)))
-
-(defun build-tarball-collapse (item)
- (let ((str
- (concat build-tarball-site build-tarball-dir build-tarball-prefix)))
- (string-match str item)
- (replace-match "" t t item)))
-
-(defun build-tarball-get (file)
- (if (not (featurep 'efs))
- (message-or-box
- "please install efs to be able to \"Download Build Tarball Set\".")
- (let ((efs-mode-hook
- '(lambda ()
- (set (make-local-variable 'efs-expire-ftp-buffers) nil)
- (set (make-local-variable 'auto-save-hook)
- '(lambda ()
- (message "Auto-saved %s\n" (buffer-name))))
- (auto-save-mode 1))))
- (efs-copy-file
- (build-tarball-expand file)
- (concat
- (expand-file-name
- build-tarball-prefix build-tarball-dest)
- file)
- 1 nil t))))
-
-(defun build-tarball-extract (file)
- (cd build-tarball-dest)
- (let ((cmd
- (format "gunzip -c %s%s | tar -xvf -" build-tarball-prefix file))
- (compilation-mode-hook
- 'build-compilation-mode-hook)
- (compilation-buffer-name-function
- '(lambda (mode)
- (generate-new-buffer-name
- (concat
- (file-name-sans-extension
- (file-name-sans-extension
- (concat build-tarball-prefix file))) "-toc.err"))))
- )
- (if (string-match "tar\\.gz$" file)
- (compile cmd)
- (warn "%s is not a tar.gz file, skipped."
- (concat build-tarball-prefix file)))))
-
-(defun build-tarball-get-all ()
- "Get all the expanded files of `build-tarball-set'.
-Use `build-tarball-expand-all' to find out which tarballs would be
-fetched by this function. All tarballs are saved under
-`build-tarball-dest'"
- (interactive)
- (mapc 'build-tarball-get build-tarball-set))
-
-(defun build-tarball-extract-all ()
- "Extract all files from the locally present `build-tarball-set' which
-have to be in \".tar.gz\" format."
- (interactive)
- (mapc 'build-tarball-extract build-tarball-set))
-
-(defun build-tarball-expand-all ()
- "Print the expanded value of `build-tarball-set' to temporary buffer
-\"*Build Tarball Set*\"."
- (interactive)
- (cd build-tarball-dest)
- (with-output-to-temp-buffer
- "*Build Tarball Set*"
- (princ (mapconcat 'build-tarball-expand build-tarball-set "\n"))))
-
-(defun build-tarball-add-url ()
- "Add URL near point to `build-tarball-set' via
-`url-get-url-at-point'."
- (interactive)
- (setq build-tarball-set (cons (url-get-url-at-point) build-tarball-set)))
-
-;;}}}
-
-;;{{{ Build With
-
-(defvar build-with-MS-has-config-inc
- nil
- "Internal variable indicating whether the XEmacs to be built has
-support for config.inc.")
-
-(defgroup build-with-MS nil
- "Standardizes the building of XEmacs with MiroSoft tools."
- :group 'build)
-
-(defcustom build-with-MS-make-command
- "nmake"
- "Path of Microsoft make utility used to build XEmacs."
- :type 'file
- :group 'build-with-MS)
-
-(defcustom build-with-MS-make-options
- '("/f xemacs.mak")
- "Options to use with Microsoft make utility when building XEmacs."
- :type '(repeat string)
- :group 'build-with-MS)
-
-(defun build-with-GNU (dir)
- (interactive)
- (let
- ((name "*Build XEmacs With GNU Tools*"))
- ;; Overwrite any customized setting for this build session so
- ;; that build-report will find the right information.
- (customize-set-variable
- 'build-report-installation-file
- (expand-file-name "Installation" dir))
- (customize-set-variable
- 'build-report-version-file
- (expand-file-name "version.sh" dir))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- (cd dir)
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- (buffer-back get-back)
- (cond
- ((string-equal build-from-what "Tarballs")
- (setq buffer-back "*Build XEmacs From Tarballs With GNU Tools*")
- (setq get-back 'build-from-tarballs))
- ((string-equal build-from-what "CVS")
- (setq buffer-back "*Build XEmacs From CVS With GNU Tools*")
- (setq get-back 'build-from-CVS)))
- (if (buffer-live-p (get-buffer buffer-back))
- (switch-to-buffer buffer-back)
- (funcall get-back))))
- "Go Back")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-configure-generate "configure.usage"))
- "Generate Build Configure")
- (widget-insert "\n\t")
- (widget-apply
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (eval-buffer "build-configure.el"))
- "Activate Generated Build Configure")
- (if (boundp 'build-configure-options)
- :deactivate
- :activate))
- (when (boundp 'build-configure-options)
- (widget-insert
- "\n\tYou will need to restart XEmacs first if you want to activate the\n\tgenerated interface to Build Make again."))
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-configure))
- "Browse Build Configure ...")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-configure))
- "Run XEmacs Configure")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make-generate))
- "Generate XEmacs Make")
-; (widget-insert "\n\t")
-; (widget-create 'push-button
-; :notify (lambda (&rest ignore)
-; (customize-browse 'build-make))
-; "Browse Build-Make")
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (call-interactively 'build-make))
- "Run XEmacs Make")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-build-report))
- "Generate XEmacs Build Report ...")
- (widget-insert "\n\n")
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-(defun build-with-MS (dir)
- (interactive "DXEmacs source directry: ")
- (let
- ((name "*Build XEmacs With Microsoft Tools*"))
- ;; Overwrite any customized setting for this build session so
- ;; that build-report will find the right information.
- (customize-set-variable
- 'build-report-installation-file
- (expand-file-name
- "Installation"
- (expand-file-name
- ".."
- dir)))
- (customize-set-variable
- 'build-report-version-file
- (expand-file-name
- "version.sh"
- (expand-file-name
- ".."
- dir)))
- (setq build-with-MS-has-config-inc
- (multiple-value-bind
- (major minor beta codename)
- (build-report-version-file-data
- build-report-version-file)
- ;; APA: config.inc file was introduced by Ben Wing in 21.2-b32.
- (if
- (and
- (>= (string-to-int major) 21)
- (or
- ;; 21.2 versions >= b32
- (and
- (= (string-to-int minor) 2)
- (>= (string-to-int beta) 32))
- ;; 21 versions with minor number > 2
- (> (string-to-int minor) 2)))
- t
- nil)))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (kill-all-local-variables)
- (cd (expand-file-name "" dir))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- (buffer-back get-back)
- (cond
- ((string-equal build-from-what "Tarballs")
- (setq buffer-back "*Build XEmacs From Tarballs With Microsoft Tools*")
- (setq get-back 'build-from-tarballs))
- ((string-equal build-from-what "CVS")
- (setq buffer-back "*Build XEmacs From CVS With Microsoft Tools*")
- (setq get-back 'build-from-CVS)))
- (if (buffer-live-p (get-buffer buffer-back))
- (switch-to-buffer buffer-back)
- (funcall get-back))))
- "Go Back")
- (widget-insert "\n")
- (widget-insert
- "\nYou need to customize Microsoft Tools options.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-with-MS))
- "Browse Build With MS Options ...")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make-generate "xemacs.mak"))
- "Generate XEmacs Make")
- (widget-insert "\n\t")
- (widget-apply
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (eval-buffer "build-make.el"))
- "Activate Generated Build Make")
- (if (boundp 'build-make-options)
- :deactivate
- :activate))
- (when (boundp 'build-make-options)
- (widget-insert
- "\n\tYou will need to restart XEmacs to activate\n\tthe generated interface to Build Make again."))
- (widget-insert "\n\t")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-make))
- "Browse Build Make ...")
- (widget-insert "\n\t")
- (widget-apply
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (eval-buffer "build-make.el")
- (build-config-inc-generate))
- "Generate config.inc")
- (if build-with-MS-has-config-inc
- :activate
- :deactivate))
- (widget-insert
- "\n\tXEmacs versions prior to 21.2-b32 do not use config.inc.\n\tThose are configured by passing all variable values to nmake\n\ton the command-line.\n\nDon't forget to save config.inc before building!")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make
- "distclean"
- (mapconcat
- 'identity
- (cons
- build-with-MS-make-command
- build-with-MS-make-options)
- " ")))
- "Clean XEmacs Distribution")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make
- "all"
- (concat
- (mapconcat
- 'identity
- (cons
- build-with-MS-make-command
- build-with-MS-make-options)
- " ")
- (unless build-with-MS-has-config-inc
- (build-make-get-option-string)))))
- "Build XEmacs")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make
- "install"
- (concat
- (mapconcat
- 'identity
- (cons
- build-with-MS-make-command
- build-with-MS-make-options)
- " ")
- (unless build-with-MS-has-config-inc
- (build-make-get-option-string)))))
- "Build and Install XEmacs")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make
- "check-temacs"
- (concat
- (mapconcat
- 'identity
- (cons
- build-with-MS-make-command
- build-with-MS-make-options)
- " ")
- (unless build-with-MS-has-config-inc
- (build-make-get-option-string)))))
- "Check temacs (XEmacs before dumping)")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-make
- "check"
- (concat
- (mapconcat
- 'identity
- (cons
- build-with-MS-make-command
- build-with-MS-make-options)
- " ")
- (unless build-with-MS-has-config-inc
- (build-make-get-option-string)))))
- "Check XEmacs")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (build-build-report))
- "Generate XEmacs Build Report ...")
- (widget-insert "\n\n")
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-;;}}}
-
-;;{{{ Build Report
-
-(defun build-build-report ()
- (interactive)
- (let
- ((name "*Generate XEmacs Build Report*"))
- (kill-buffer (get-buffer-create name))
- (switch-to-buffer (get-buffer-create name))
- (widget-insert "\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (let
- (buffer-back get-back dir)
- (cond
- ((string-equal build-with-what "GNU Tools")
- (setq buffer-back "*Build XEmacs With GNU Tools*")
- (setq get-back 'build-with-GNU))
- ((string-equal build-with-what "Microsoft Tools")
- (setq buffer-back "*Build XEmacs With Microsoft Tools*")
- (setq get-back 'build-with-MS)))
- (cond
- ((string-equal build-from-what "Tarballs")
- (setq dir
- (expand-file-name
- build-tarball-prefix
- build-tarball-dest)))
- ((string-equal build-from-what "CVS")
- (setq dir
- (expand-file-name
- build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))))
- (if (buffer-live-p (get-buffer buffer-back))
- (switch-to-buffer buffer-back)
- (funcall get-back dir))))
- "Go Back")
- (widget-insert "\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (customize-browse 'build-report))
- "Browse Build Report ...")
- (widget-insert "\n\nYou may need to customize Build Report options in order to find all\ninformation created by your last building of XEamcs.\n\n")
- (widget-create 'push-button
- :notify (lambda (&rest ignore)
- (call-interactively 'build-report))
- "Generate Build Report ...")
- (widget-insert "\n")
- (use-local-map widget-keymap)
- (widget-setup)
- (custom-mode)
- (goto-char (point-min))))
-
-;;}}}
-
-;;{{{ Build Make
-
-(defvar build-make-alist
- nil
- "Internal variable keeping track of makefile macros and targets")
-
-(defconst build-make-target-doc-paragraph
- "^##\\s-*make\\s-+\\([^
- ]+\\(\\s-+or\\s-+make\\s-+\\([^
- ]+\\)\\)*\\)\\(\\s-*\\(\\(.*\\)\\(\n##\\s-\\{3,\\}.+\\)*\\)\\)$"
- "Internal REGEXP matching a XEmacs makefile target comment. These comments
-don't exist in `xemacs.mak'")
-
-(defconst build-make-target-paragraph
- "\\(^#.+
-\\)?\\(\\(\\w\\|_\\)+\\)\\s-*:.*"
- "Internal REGEXP matching a XEmacs makefile target name.")
-
-(defconst build-make-macro-paragraph
- "^\\(?:!message Please specify root directory for your .* installation: \\)?\\(\\(\\w\\|_\\)+\\)\\s-*=\\s-*\\(\\(.*\\\\
-\\)*.+\\)$"
- "Internal REGEXP matching a XEmacs makefile macro definition.")
-
-(defconst build-make-prolog
- "
-(provide 'build-make)
-
-(setq build-make-options nil)
-
-(defun build-make-sym-to-opt (sym)
- ;; #### Strip the \"build-make-\" prefix.
- (substring (symbol-name sym) 11))
-
-(defun build-make-set-value (sym val)
- (setq build-make-options
- (remassoc (build-make-sym-to-opt sym) build-make-options))
- (unless (equal val (first (get sym 'standard-value)))
- (setq build-make-options
- (acons (build-make-sym-to-opt sym) val
- build-make-options)))
- (set-default sym val))
-
-(defgroup build-make nil
- \"build-make options.\"
- :group 'build)
-
-"
- "Internal variable of `build'.")
-
-(defun build-config-inc-generate (&optional dir)
- (interactive)
- (let
- ((buffer (buffer-name (generate-new-buffer "config.inc"))))
- (if dir
- (cd dir))
- (with-output-to-temp-buffer buffer
- (save-window-excursion
- (princ "# -*- mode: makefile -*-\n")
- (princ (format "# generated by %s" build-version))
- (princ "\n\n")
- (princ
- (if (boundp 'build-make-options)
- (mapconcat
- (function (lambda (e)
- (cond
- (t
- (format "%s=%s\n" (first e) (rest e))))))
- (sort
- (delete-duplicates
- build-make-options :from-end t
- :test (lambda (a b)
- (string=
- (first a) (first b))))
- (lambda (a b)
- (string<
- (first a) (first b))))
- "")
- ""))
- ))
- (set-buffer buffer)
- (kill-all-local-variables)
- (makefile-mode)
- (font-lock-mode 1)
- (toggle-read-only 1)))
-
-(defun build-make (&optional target command)
- "Build the XEmacs target argument according to the settings in
-customized group `build' and its members."
- (interactive "sTarget: \nsCommand: ")
- (let ((cmd
- (if (string-equal command "")
- (format "make %s" target)
- (format "%s %s" command target)))
- (compilation-mode-hook
- 'build-compilation-mode-hook)
- (compilation-buffer-name-function
- '(lambda (mode)
- (generate-new-buffer-name
- (format "%s-make%s.err"
- (cond
- ((string-equal build-from-what "Tarballs")
- build-tarball-prefix)
- ((string-equal build-from-what "CVS")
- build-cvs-checkout-dir))
- (if target
- (format "-%s" target)
- ""))))))
- (compile cmd)))
-
-(defun build-make-generate (&optional file)
- (interactive "fMakefile: ")
- (setq build-make-alist (list (cons 'macros nil) (cons 'targets nil)))
- (unless file
- (setq file
- (expand-file-name
- "Makefile.in"
- (cond
- ((string-equal build-from-what "Tarballs")
- (expand-file-name
- build-tarball-prefix
- build-tarball-dest))
- ((string-equal build-from-what "CVS")
- (expand-file-name
- build-cvs-checkout-dir
- build-cvs-checkout-parent-dir))))))
- (let
- (category categories option value detected doc
- (buffer "build-make.el"))
- (with-output-to-temp-buffer buffer
- (save-window-excursion
- (find-file-read-only file)
-; (build-make-prolog file)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond
- ((looking-at build-make-target-doc-paragraph)
- (goto-char (match-end 0))
- (build-make-process-target-doc
- ;; target [or target ...]
- (match-string 1)
- ;; documentation for current targets; possibly
- ;; spreading multiple lines.
- (match-string 5)
- build-make-alist))
- ((looking-at build-make-target-paragraph)
- (goto-char (match-end 0))
- (when (> (length (match-string 1)) 0)
- (build-make-process-target-doc
- ;; target name
- (match-string 2)
- ;; documentation for target; possibly
- ;; spreading multiple lines.
- (match-string 1)
- build-make-alist))
- )
- ((looking-at build-make-macro-paragraph)
- (goto-char (match-end 0))
-; (unless (string-match "\\$" (match-string 3))
- (build-make-process-macro
- ;; macro name
- (match-string 1)
- ;; macro value
- (match-string 3)
- build-make-alist))
-; )
- ((looking-at
- "^.+$")
- (goto-char (match-end 0)))
- ((looking-at "\n")
- (goto-char (match-end 0)))
- ))
- (build-make-customize build-make-alist)
- ))
- (set-buffer buffer)
- (insert "(setq build-make-alist (quote")
-; (cl-prettyprint (nreverse build-make-alist))
- (cl-prettyprint build-make-alist)
- (insert "))\n")
- (toggle-read-only 1)))
-
-(defun build-make-get-option-string ()
- (if (boundp 'build-make-options)
- (mapconcat
- (function (lambda (e)
- (cond
- (t
- (format " %s=\"%s\"" (first e) (rest e))))))
- (delete-duplicates
- build-make-options :from-end t
- :test (lambda (a b)
- (string=
- (first a) (first b))))
- "")
- ""))
-
-(defun build-make-process-target-doc (targets doc a-list)
- (setq targets (replace-in-string targets "or\\(\n\\|\\s-\\)+make" ""))
- (setq doc (replace-in-string doc "##?\\s-+" ""))
- (setq doc (build-configure-fill-doc (list doc)))
- (setcdr (assoc 'targets a-list)
- (append (list (list targets doc)) (cdr (assoc 'targets a-list)))))
-
-(defun build-make-process-macro (name value a-list)
- (unless (assoc name (assoc 'macros a-list))
- (setcdr (assoc 'macros a-list)
- (append (list (list name value)) (cdr (assoc 'macros a-list))))))
-
-(defun build-make-customize (a-list)
- (princ build-make-prolog)
- (mapcar
- (lambda (macro)
- (if (string-match "_DIR\\'" (first macro))
- (build-make-file (first macro) (second macro))
- (build-make-string (first macro) (second macro))))
- (rest (assoc 'macros a-list))))
-
-(defun build-make-string (name val)
- (princ (format "(defcustom build-make-%s\n" name))
- (princ (format " %S\n" val))
- (princ (format " \"macro %s\"\n" name))
- (princ (format " :group \'build-make\n"))
- (princ " :type 'string\n")
- (princ " :set 'build-make-set-value)\n")
- (princ "\n"))
-
-(defun build-make-file (name val)
- (princ (format "(defcustom build-make-%s\n" name))
- (princ (format " %S\n" val))
- (princ (format " \"macro %s\"\n" name))
- (princ (format " :group \'build-make\n"))
- (princ " :type 'file\n")
- (princ " :set 'build-make-set-value)\n")
- (princ "\n"))
-
-;;}}}
-
-;;{{{ Build Settings
-
-(defcustom build-settings
- nil
- "Internal alist of named settings for building multiple XEmacs
-configurations.
-This variable is updated via \"Delete\", Load\", and \"Save\" buttons
-of the `build' GUI."
- :type 'sexp
- :group 'build)
-
-(defun build-settings-save-custom-group (group key alist)
- "Save customization values of custom GROUP as value of KEY in ALIST"
- (dolist
- (cgm (custom-group-members group nil))
- (let ((symbol (first cgm))
- (type (second cgm)))
- (cond
- ((equal type 'custom-group)
- (setq alist (build-settings-save-custom-group symbol key alist)))
- (t
- (unless
- (assoc key alist)
- (setq alist
- (acons key nil alist)))
- (if (get symbol 'customized-value)
- (setcdr
- (assoc key alist)
- (append
- (cdr
- (assoc key alist))
- (list
- (list symbol (car
- (get symbol 'customized-value)))))))))))
- alist)
-
-(defun build-settings-load (key alist)
- "Load build variable settings from alist."
- (interactive)
- (dolist
- (var (cdr (assoc key alist)))
- (message "%S\n\t%S" (car var) (car (cdr var)))
- (set (car var) (eval (car (cdr var))))
- ))
-
-;;}}}
-
-;; build.el ends here
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename build.info
-@settitle XEmacs Build Reference Manual
-@dircategory Emacs
-@direntry
-* Build: (build). Build XEmacs from within (UNIX, Windows).
-@end direntry
-@c footnotestyle separate
-@c paragraphindent 2
-@c %**end of header
-@setchapternewpage odd
-@ifinfo
-This document describes the XEmacs package called build.
-Copyright @copyright{} 2000-2002 Adrian Aichner.
-@end ifinfo
-
-@c @c Combine indices.
-@c @synindex cp fn
-@c @syncodeindex vr fn
-@c @syncodeindex ky fn
-@c @syncodeindex pg fn
-@c @syncodeindex tp fn
-
-@titlepage
-@c @sp 10
-@c @comment The title is printed in a large font.
-@c @center @titlefont{Build}
-@c @c The following two commands start the copyright page.
-@c @page
-@c @vskip 0pt plus 1filll
-@c Copyright @copyright{} 2000-2002 Adrian Aichner.
-@title XEmacs Build Reference Manual
-@subtitle Version 2.00 (for XEmacs 21.1, 21.4, 21.5), dated 2002-03-07
-
-@author by Adrian Aichner
-@page
-@vskip 0pt plus 1filll
-@sp 2
-@c Version 3.3 @*
-@c Revised for XEmacs Versions 21.0,@*
-@c April 1998.@*
-
-Permission is granted to make and distribute verbatim copies of this
-manual provided the copyright notice and this permission notice are
-preserved on all copies.
-
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-section entitled ``GNU General Public License'' is included
-exactly as in the original, and provided that the entire resulting
-derived work is distributed under the terms of a permission notice
-identical to this one.
-
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that the section entitled ``GNU General Public License'' may be
-included in a translation approved by the Free Software Foundation
-instead of in the original English.
-@end titlepage
-@node Top, Build Overview, , (dir)
-@comment node-name, next, previous, up
-@chapter Build Package
-
-This is the XEmacs Build Reference Manual, Version 2.00 (for XEmacs
-21.1, 21.4, 21.5), dated 2002-03-07, by @email{adrian@@xemacs.org,
-Adrian Aichner}.
-
-@menu
-* Build Overview:: Overview of build package
-* Build Installation:: Installation of the build package
-* Build XEmacs:: Choosing source and tools
-* Build XEmacs From CVS:: Fetching sources with CVS
-* Build XEmacs From Tarballs:: Fetching source tarballs with EFS
-* Build XEmacs With GNU Tools:: UNIX-style build using configure, make
-* Build XEmacs With Microsoft Tools:: Microsoft build using MS VC++ >= 4.0
-* Generate XEmacs Build Report:: Reporting Success or Failure
-* Known Problems of Build:: Problems, Workarounds, and Fixes
-* Concept Index:: An item for each concept
-@end menu
-
-@node Build Overview, Build Installation, Top, (dir)
-@comment node-name, next, previous, up
-@chapter Build Overview
-@cindex What build is
-
-@code{build} supports the building process of the XEmacs editor from its
-sources.
-
-@cindex XEmacs build process
-
-The build process consists of following steps:
-
-@enumerate
-
-@item
-Download source code from FTP server or CVS repository.
-
-@item
-Configure any attributes of the build process, of the resulting XEmacs
-executable, and of the XEmacs environment.
-
-@item
-Start the make process to build XEmacs, install it, and run the
-regression tests.
-
-@item
-Report on the success or failure of the build, using build-report.
-
-@end enumerate
-
-The @code{build} command generates a widget-based interface to configure
-and build XEmacs either using GNU Tools (@code{configure}, @code{make})
-or Microsoft Tools (@code{nmake} with command-line options (<= 21.2-b32)
-or @file{config.inc} configuration file (> 21.2-b32)).
-
-@node Build Installation, Build XEmacs, Build Overview, (dir)
-@comment node-name, next, previous, up
-@chapter Build Installation
-@cindex How to install build
-
-You have following three choices to install build (@pxref{Installing
-Packages, Installing Packages, , xemacs}):
-
-@enumerate
-
-@item
-Use the package GUI:
-
-@itemize @bullet
-
-@item
-In XEmacs Release 21.1:
-
-Select a download site under
-
-@example
-Options->Manage Packages->Add Download Site
-@end example
-
-and after listing available packages with
-
-@example
-Options->Manage Packages->List & Install
-@end example
-
-install @code{build} with
-
-@example
-Packages->Toggle install `build'
-Packages->Install/Remove Selected
-@end example
-
-followed by starting a fresh XEmacs.
-
-@item
-In XEmacs Beta Release 21.2-bXX:
-
-Menus have been re-arranged in XEmacs 21.2.
-
-Select a download site under
-
-@example
-Tools->Packages->Add Download Site
-@end example
-
-and after listing available packages with
-
-@example
-Tools->Packages->List and Install
-@end example
-
-install @code{build} with
-
-@example
-Packages->Toggle install `build'
-Packages->Install/Remove Selected
-@end example
-
-followed by starting a fresh XEmacs.
-
-@end itemize
-
-@item
-Run XEmacs command
-
-@example
-@kbd{M-x package-admin-add-binary-package @key{RET} @var{build-package-tarball-path} @key{RET}}
-@end example
-
-after tarball download with EFS or ftp.
-
-@item
-
-Extract the build tarball(s) into the xemacs-packages hierarchy from
-your favorite shell.
-
-@code{bash}, @code{csh}, @code{ksh}, @code{zsh} come to mind on UNIX
-systems; Cygwin's @code{bash}, @code{cmd.exe}, and @code{command.exe}
-for Windows 95/98/NT/2000.
-
-@example
-@kbd{cd @var{installation-directory}/xemacs-packages;
-gzip -dc @var{build-package-tarball-path} | tar -xvf -}
-@end example
-
-@end enumerate
-
-@node Build XEmacs, Build XEmacs From CVS, Build Installation, Top
-@comment node-name, next, previous, up
-@chapter Build XEmacs
-
-@cindex Accessing Documentation
-@section Accessing Documentation for the Build package
-
-You may want to read through the build package info documentation first.
-It is accessible via links to Info- and HTML-documentation from the
-initial *Build XEmacs* buffer, which has this:
-
-@example
-Visit info documentation for the XEmacs build package in [XEmacs]
-or on the XEmacs website at
-[http://www.xemacs.org/Documentation/packages/html/build.html]
-@end example
-
-@cindex build-settings
-@cindex build settings
-@section Saving Multiple Build Settings
-
-Build settings, introduced in build 2.00, allow you to save all variable
-settings relevant to building XEmacs under a single name. This saves
-time and simplifies the process of building multiple XEmacs versions or
-configurations.
-
-@example
-Current Build Settings: unknown
-
-[Load] [Delete] build settings: [Value Menu] default
-[Save] current build settings as: [Value Menu] String: default
-@end example
-
-@cindex Browsing Build Options
-@section Browsing Build Options
-
-Global build options can be browsed next.
-
-@example
-[Browse Build Options ...]
-@end example
-
-@cindex build from
-@section What to Build From and Build With
-
-You have to decide what to @emph{build from}:
-
-@enumerate
-
-@item
-CVS sources in the XEmacs CVS repository at
-@uref{http://cvs.xemacs.org/}.
-
-@item
-Tarballs (tar.gz files) on the XEmacs FTP Site
-@uref{http://ftp.xemacs.org/pub/xemacs/} or one of its mirror sites.
-
-@end enumerate
-
-@cindex build with
-and what to @emph{build with}:
-
-@enumerate
-
-@item
-GNU@footnote{Alert readers will note: GNU's Not UNIX!}/UNIX tools using
-@code{configure}, @code{make}, and @code{cc}.
-
-@cindex xemacs.mak
-@item
-Microsoft tools using @code{nmake} and @code{cl}, supported by
-@file{nt/xemacs.mak} and, beginning with XEmacs 21.2-b33,
-@file{nt/config.inc}.
-
-@end enumerate
-
-These two choices determine which of the following steps will be taken.
-
-@example
-[Build XEmacs From CVS Now]
-@end example
-
-@example
-[Build XEmacs From Tarballs Now]
-@end example
-
-As of build version 2.00 a check is performed whether CVS is available.
-
-The user interface to *Build XEmacs from CVS* will only be available if
-this test (cvs -v) passes.
-
-The cvs client version installed on your system will be displayed below
-following button.
-
-@example
-[Build XEmacs From CVS Now]
-@end example
-
-Finally either press the button labeled @ref{Build XEmacs From CVS}
-or @ref{Build XEmacs From Tarballs}. Only the button labeled according
-to your choice under the @emph{build from:} menu will be active.
-See @ref{Build XEmacs} and @ref{Known Problems of Build}.
-
-Each of the following steps allow to return to a previous one with the
-
-@cindex Going Back
-@example
-[Go Back]
-@end example
-
-button to review your choices.
-
-Whether to build from tarballs or CVS sources depends on what the user
-wants to do with the sources.
-
-@itemize @bullet
-
-@item
-Tarballs are convenient for building a well-defined release of XEmacs.
-These tarballs are big and users with slow or expensive network
-connections should avoid them.
-
-@code{gzip} and @code{tar} are required for this method.
-
-@item
-For users who want to stay in close sync with the development of XEmacs,
-especially the Beta releases, create patches against files or whole
-directories, CVS is the way to go.
-
-You will obviously need to install @code{cvs} first.
-
-@end itemize
-
-The choice is yours@footnote{unless your access to the Internet is
-limited by firewalls or disabled IP ports, you don't have gzip/tar, or
-cvs.}.
-
-@node Build XEmacs From CVS, Build XEmacs From Tarballs, Build XEmacs, Top
-@comment node-name, next, previous, up
-@chapter Build XEmacs From CVS
-@cindex Obtaining sources with CVS
-
-The CVS commands to fetch XEmacs source code are run through the XEmacs
-@code{compile} command (@pxref{Compilation, , , xemacs}).
-
-The buffers are named uniquely with the current working directory
-appropriately set to save the buffers with @kbd{C-x C-w} (@kbd{M-x
-write-file}) under the XEmacs source directory.
-
-First you have to login to the XEmacs CVS server.
-
-Please do so by pressing following button.
-
-@example
-[CVS Login XEmacs]
-@end example
-
-If that fails, please send the message generated in the *Warnings*
-buffer to @email{cvs-admin@@xemacs.org, XEmacs CVS Administrator}.
-
-After pressing the
-
-@example
-[CVS Checkout XEmacs]
-@end example
-
-button (unless you have
-checked out before) and either one of
-
-@example
-[CVS Update XEmacs To Release]
-@end example
-
-(as specified with
-
-@example
-[Browse Build CVS Options ...]
-@end example
-
-) or
-
-@example
-[CVS Update XEmacs To Latest]
-@end example
-
-(resetting all @pxref{Sticky tags, , , cvs}) you are ready to proceed
-with
-
-@example
-[Build XEmacs Now ...]
-@end example
-
-@node Build XEmacs From Tarballs, Build XEmacs With GNU Tools, Build XEmacs From CVS, Top
-@comment node-name, next, previous, up
-@chapter Build XEmacs From Tarballs
-@cindex Obtaining sources with EFS
-
-The tarballs chosen with
-
-@example
-[Browse Build Tarball Options ...]
-@end example
-
-Press
-
-@example
-[Download Build Tarball Set]
-@end example
-
-to fetch tarballs with EFS, which needs to be installed @footnote{If EFS
-is not installed you may obtain these tarballs by other means and
-extract them to the configured directory.}, followed by
-
-@example
-[Install Downloaded Build Tarball Set]
-@end example
-
-to extract tarballs using @code{gzip} and @code{tar} in a
-@code{compilation-mode} buffer named accordingly (e.g. ???).
-
-Finally press the button either labeled @ref{Build XEmacs With GNU
-Tools} or @ref{Build XEmacs With Microsoft Tools} according to your
-choice under the @emph{build with:} menu. See @ref{Build XEmacs}.
-
-@node Build XEmacs With GNU Tools, Build XEmacs With Microsoft Tools, Build XEmacs From Tarballs, Top
-@comment node-name, next, previous, up
-@chapter Build XEmacs With GNU Tools
-@cindex Build on UNIX
-@cindex Build with Cygnus (now Cygwin)
-@cindex Build with Cygwin
-@cindex configure
-@cindex configure.usage
-@cindex make
-@cindex gcc
-
-Besides GNU make (@code{make}) and GNU cc (@code{gcc}) XEmacs can be
-built with the equivalent programs from many UNIX vendors.
-
-The @dfn{configure}@footnote{This shell script is on the top-level of
-the XEmacs source tree, see also configure.usage there.} script, which
-is run before @code{make}, determines the configuration of your system
-and warns about any problems it finds.
-
-@node Build XEmacs With Microsoft Tools, Generate XEmacs Build Report, Build XEmacs With GNU Tools, Top
-@comment node-name, next, previous, up
-@chapter Build XEmacs With Microsoft Tools
-@cindex Build on Windows 95/98/NT/2000
-@cindex Build with MS Visual Studio C++
-@cindex nmake
-@cindex cl
-@cindex config.inc
-
-XEmacs is built using Microsoft's version of @code{make}, @dfn{nmake},
-and Microsoft's C++ compiler, @dfn{cl}, which are both part of Microsoft
-Visual Studio @footnote{Version 4.0 or greater is required.}.
-
-Up to XEmacs 21.2-b32 all configuration choices are passed on to
-@code{nmake} as command-line options.
-
-XEmacs versions > 21.2-b32
-support @file{nt/config.inc} which is generated according to user
-choices made under
-
-@example
-[Browse Build Make ...]
-@end example
-
-by
-
-@example
-[Generate config.inc]
-@end example
-
-which you have to save after reviewing it shortly.
-
-@node Generate XEmacs Build Report, Known Problems of Build, Build XEmacs With Microsoft Tools, Top
-@comment node-name, next, previous, up
-@chapter Generate XEmacs Build Report
-
-This is a GUI making use of the @code{build-report} feature provided
-with XEmacs.
-
-When used standalone, you have to first
-
-@example
-[Browse Build Report ...]
-@end example
-
-to pick up the information for the XEmacs build you would like to
-generate the report for.
-
-@c #### If you use @code{build-report} as part of the @code{build} package, you should not save any customized @code{build-report} variables, so that @code{build} can ???
-
-@node Known Problems of Build, Concept Index, Generate XEmacs Build Report, Top
-@chapter Known Problems of Build
-@cindex Limitations
-@cindex Bugs
-
-@enumerate
-
-@item
-Activated buttons appear to be inactive.
-
-@itemize @bullet
-
-@item
-Problem
-
-The buttons
-@example
-[Build XEmacs From CVS Now]
-@end example
-and
-@example
-[Build XEmacs From Tarballs Now]
-@end example
-don't show as active after being re-activated due to a bug in
-wid-edit.el in XEmacs 21.1.12 and below.
-
-@item
-Workaround
-
-You can easily find which button is active by using
-@kbd{TAB} runs `widget-forward'
-or
-@kbd{Sh-TAB} runs `widget-backward'.
-
-@item
-Fix
-
-@uref{http://www.xemacs.org/list-archives/xemacs-patches/200010/msg00031.html}
-should fix this problem for later versions of XEmacs.
-
-@end itemize
-
-@item
-Inactive buttons appear to be active.
-
-@itemize @bullet
-
-@item
-Problem
-
-XEmacs 21.2-b36 and below have another bug which will not render the
-de-activated button as such.
-
-@item
-Workaround
-
-You can easily find which button is active by using
-@kbd{TAB} runs `widget-forward'
-or
-@kbd{Sh-TAB} runs `widget-backward'.
-
-@item
-Fix
-
-None as of 2000-10-21. See
-@uref{http://www.xemacs.org/list-archives/xemacs-beta/200010/msg00194.html}.
-
-@end itemize
-
-@end enumerate
-
-@node Concept Index, , Known Problems of Build, Top
-@comment node-name, next, previous, up
-@unnumbered Concept Index
-@printindex cp
-@contents
-@bye
+++ /dev/null
-(build
- (standards-version 1.0
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution stable
- priority low
- category CATEGORY
- dump nil
- description "Build XEmacs from within (UNIX, Windows)."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (build)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.12 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.11 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
-
-2005-06-04 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.10 released.
-
-2005-06-04 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Update to /main/laptop/165.
- * Makefile (MAINTAINER): Change to Adrian Aichner.
- * clearcase.el: General sync and getting rid of fsf-compat
- dependency.
- * clearcase.el (clearcase-version-stamp): Sync.
- * clearcase.el (clearcase-submit-bug-report): Sync.
- * clearcase.el (clearcase-remove-branch-after-unheckout-when-only-0-version): New.
- * clearcase.el (clearcase-annotate-fmt-string): New.
- * clearcase.el (clearcase-annotate-file): Use
- clearcase-annotate-fmt-string.
- * clearcase.el (clearcase-browse-vtree-current-buffer): Sync
- adding graphical prefix argument.
- * clearcase.el (clearcase-browse-vtree-dired-file): Ditto.
- * clearcase.el (clearcase-gui-vtree-browser): Use start-process
- instead of start-process-shell-command.
- * clearcase.el (clearcase-gui-clearexplorer): Ditto.
- * clearcase.el (clearcase-gui-rebase): Ditto.
- * clearcase.el (clearcase-gui-deliver): Ditto.
- * clearcase.el (clearcase-gui-merge-manager): Ditto.
- * clearcase.el (clearcase-gui-project-explorer): Ditto.
- * clearcase.el (clearcase-gui-snapshot-view-updater): Ditto.
- * clearcase.el (clearcase-sync-all-buffers): New.
- * clearcase.el (clearcase-sync-file-if-needed): New.
- * clearcase.el (clearcase-post-update-timer-function): Use
- delete-itimer under XEmacs to remove fsf-compat/timer dependency.
- * clearcase.el (clearcase-uncheckout): Sync, supporting new
- clearcase-remove-branch-after-unheckout-when-only-0-version.
- * clearcase.el (clearcase-browse-vtree): Sync adding graphical
- prefix argument.
- * clearcase.el (clearcase-vprop-timer-function): Use delete-itimer
- under XEmacs to remove fsf-compat/timer dependency.
- * clearcase.el (clearcase-read-version-name): Comment change.
- * clearcase.el (clearcase-utl-make-writeable): Don't use #o syntax
- for the benefit of older Emacsen.
- * clearcase.el (clearcase-utl-make-unwriteable): Ditto.
-
-2004-10-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.09 released.
-
-2004-08-16 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (AUTHOR_VERSION): Update to upstream /main/laptop/156.
- * Makefile (REQUIRES): Add sh-script.
- * clearcase.el: Full sync with upstream /main/laptop/156.
- * clearcase.el (clearcase-version-stamp):
- * clearcase.el (clearcase-sink-file-name): New.
- * clearcase.el (executable):
- * clearcase.el (clearcase-dump):
- * clearcase.el (clearcase-keep-uncheckouts): New.
- * clearcase.el (clearcase-keep-unhijacks): New.
- * clearcase.el (clearcase-auto-dired-mode):
- * clearcase.el (clearcase-display-status): Removed.
- * clearcase.el (clearcase-display-branch): Removed.
- * clearcase.el (clearcase-checkout-dir-on-mkelem): Removed.
- * clearcase.el (clearcase-dired-show-view): New.
- * clearcase.el (clearcase-verify-pre-mkelem-dir-checkout): New.
- * clearcase.el (clearcase-checkin-switches): Removed.
- * clearcase.el (clearcase-checkin-arguments): New.
- * clearcase.el (clearcase-checkout-switches): Removed.
- * clearcase.el (clearcase-checkout-arguments): New.
- * clearcase.el (clearcase-normal-diff-switches): Removed.
- * clearcase.el (clearcase-normal-diff-arguments): New.
- * clearcase.el (clearcase-prefix-map): New.
- * clearcase.el (clearcase-dired-insert-viewtag): New.
- * clearcase.el (clearcase-dired-reformat-buffer):
- * clearcase.el (clearcase-dired-list-checkouts): Removed.
- * clearcase.el (clearcase-dired-list-checkouts-experimental): Removed.
- * clearcase.el (clearcase-dired-list-hijacks): Removed.
- * clearcase.el (clearcase-dired-prefix-map): New.
- * clearcase.el (clearcase-dired-list-modified-files): New.
- * clearcase.el (clearcase-comment-start-entry):
- * clearcase.el (clearcase-comment-save-comment-for-buffer):
- * clearcase.el (clearcase-edcs-edit):
- * clearcase.el (clearcase-hijack-current-buffer): New.
- * clearcase.el (clearcase-hijack-dired-files): New.
- * clearcase.el (clearcase-unhijack-current-buffer): New.
- * clearcase.el (clearcase-unhijack-dired-files): New.
- * clearcase.el (clearcase-annotate-file): New.
- * clearcase.el (clearcase-annotate-current-buffer): New.
- * clearcase.el (clearcase-annotate-dired-file): New.
- * clearcase.el (clearcase-find-checkouts-in-current-view):
- * clearcase.el (clearcase-ucm-set-activity-current-dir):
- * clearcase.el (clearcase-ucm-describe-current-activity):
- * clearcase.el (clearcase-edit-checkout-comment-current-buffer): New.
- * clearcase.el (clearcase-edit-checkout-comment-dired-file): New.
- * clearcase.el (clearcase-edit-checkout-comment): New.
- * clearcase.el (clearcase-applet-diff-pred-current-buffer): Removed.
- * clearcase.el (clearcase-gui-diff-pred-current-buffer): New.
- * clearcase.el (clearcase-applet-diff-pred-dired-file): Removed.
- * clearcase.el (clearcase-gui-diff-pred-dired-file): New.
- * clearcase.el (clearcase-gui-diff-branch-base-current-buffer):
- * clearcase.el (clearcase-gui-diff-branch-base-dired-file):
- * clearcase.el (clearcase-applet-diff-branch-base-current-buffer()): Removed.
- * clearcase.el (clearcase-gui-diff-branch-base-current-buffer()): New.
- * clearcase.el (clearcase-applet-diff-branch-base-dired-file()): Removed.
- * clearcase.el (clearcase-gui-diff-branch-base-dired-file()): New.
- * clearcase.el (clearcase-applet-diff-named-version-current-buffer): Removed.
- * clearcase.el (clearcase-gui-diff-named-version-current-buffer): New.
- * clearcase.el (clearcase-applet-diff-named-version-dired-file): Removed.
- * clearcase.el (clearcase-gui-diff-named-version-dired-file): New.
- * clearcase.el (clearcase-applet-diff-file-with-version): Removed.
- * clearcase.el (clearcase-gui-diff-file-with-version): New.
- * clearcase.el (clearcase-version-other-window): New.
- * clearcase.el (clearcase-applet-vtree-browser-current-buffer): Removed.
- * clearcase.el (clearcase-gui-vtree-browser-current-buffer): New.
- * clearcase.el (clearcase-applet-vtree-browser-dired-file): Removed.
- * clearcase.el (clearcase-gui-vtree-browser-dired-file): New.
- * clearcase.el (clearcase-applet-vtree-browser): Removed.
- * clearcase.el (clearcase-gui-vtree-browser): New.
- * clearcase.el (clearcase-applet-clearexplorer): Removed.
- * clearcase.el (clearcase-gui-clearexplorer): New.
- * clearcase.el (clearcase-applet-deliver): Removed.
- * clearcase.el (clearcase-gui-deliver): New.
- * clearcase.el (clearcase-applet-rebase): Removed.
- * clearcase.el (clearcase-gui-rebase): New.
- * clearcase.el (clearcase-applet-merge-manager): Removed.
- * clearcase.el (clearcase-gui-merge-manager): New.
- * clearcase.el (clearcase-applet-project-explorer): Removed.
- * clearcase.el (clearcase-gui-project-explorer): New.
- * clearcase.el (clearcase-applet-snapshot-view-updater): Removed.
- * clearcase.el (clearcase-gui-snapshot-view-updater): New.
- * clearcase.el (clearcase-update-default-directory):
- * clearcase.el (clearcase-update-current-buffer):
- * clearcase.el (clearcase-post-update-timer): New.
- * clearcase.el (clearcase-post-update-work-queue): New.
- * clearcase.el (clearcase-post-update-schedule-work): New.
- * clearcase.el (clearcase-post-update-timer-function): Retain fix
- to ignore nil viewtag.
- * clearcase.el (clearcase-post-update-check-process-buffer): New.
- * clearcase.el (clearcase-sync-after-scopes-updated): New.
- * clearcase.el (clearcase-update):
- * clearcase.el (clearcase-file-ok-to-hijack): New.
- * clearcase.el (clearcase-hijack-seq): New.
- * clearcase.el (clearcase-hijack): New.
- * clearcase.el (clearcase-file-ok-to-unhijack): New.
- * clearcase.el (clearcase-unhijack): New.
- * clearcase.el (cleartool-unhijack-parse-for-kept-files): New.
- * clearcase.el (clearcase-utl-files-in-same-view-p): New.
- * clearcase.el (clearcase-unhijack-seq): New.
- * clearcase.el (clearcase-file-ok-to-mkelem):
- * clearcase.el (clearcase-commented-mkelem):
- * clearcase.el (clearcase-commented-mkelem-seq):
- * clearcase.el (clearcase-commented-checkin):
- * clearcase.el (clearcase-file-ok-to-checkout):
- * clearcase.el (clearcase-commented-checkout):
- * clearcase.el (cleartool-unco-parse-for-kept-file): New.
- * clearcase.el (clearcase-uncheckout):
- * clearcase.el (clearcase-describe):
- * clearcase.el (clearcase-list-history):
- * clearcase.el (clearcase-diff-files):
- * clearcase.el (clearcase-fprop-unparse-properties):
- * clearcase.el (clearcase-fprop-display-properties):
- * clearcase.el (clearcase-fprop-dump): Removed.
- * clearcase.el (clearcase-fprop-dump-to-current-buffer): New.
- * clearcase.el (clearcase-fprop-hijacked): New.
- * clearcase.el (clearcase-fprop-fmt-string):
- * clearcase.el (clearcase-fprop-read-properties):
- * clearcase.el (clearcase-vprop-dump): Removed.
- * clearcase.el (clearcase-vprop-dump-to-current-buffer): New.
- * clearcase.el (clearcase-vprop-prefetch-queue): Removed.
- * clearcase.el (clearcase-vprop-work-queue): New.
- * clearcase.el (clearcase-vprop-schedule-fetch): Removed.
- * clearcase.el (clearcase-vprop-schedule-work): New.
- * clearcase.el (clearcase-vprop-timer-function):
- * clearcase.el (clearcase-vprop-read-properties):
- * clearcase.el (clearcase-vprop-read-activities-asynchronously):
- * clearcase.el (clearcase-vprop-read-activities-synchronously): Removed.
- * clearcase.el (clearcase-file-appears-modified-since-checkout-p):
- * clearcase.el (clearcase-file-snapshot-root):
- * clearcase.el (clearcase-ct-do-cleartool-command):
- * clearcase.el (clearcase-ct-get-command-stdout):
- * clearcase.el (clearcase-ct-kill-tq):
- * clearcase.el (clearcase-do-command):
- * clearcase.el (clearcase-path-file-in-any-scopes): New.
- * clearcase.el (clearcase-path-file-in-scope): New.
- * clearcase.el (clearcase-sync-after-file-updated-from-vob): New.
- * clearcase.el (clearcase-sync-from-disk-if-needed): New.
- * clearcase.el (clearcase-utl-populate-and-view-buffer): New.
- * clearcase.el (clearcase-utl-edit-and-view-buffer): New.
- * clearcase.el (clearcase-utl-touch-file): New.
- * clearcase.el (clearcase-utl-any): New.
- * clearcase.el (clearcase-utl-every): New.
- * clearcase.el (clearcase-utl-make-writeable): New.
- * clearcase.el (clearcase-utl-make-unwriteable): New.
- * clearcase.el (clearcase-menu-contents-minimised):
- * clearcase.el (clearcase-menu-contents):
- * clearcase.el (clearcase-dired-current-ok-to-hijack): New.
- * clearcase.el (clearcase-dired-current-ok-to-unhijack): New.
- * clearcase.el (clearcase-dired-marked-ok-to-checkout):
- * clearcase.el (clearcase-dired-marked-ok-to-uncheckout):
- * clearcase.el (clearcase-dired-marked-ok-to-hijack): New.
- * clearcase.el (clearcase-dired-marked-ok-to-mkelem):
- * clearcase.el (clearcase-dired-marked-ok-to-unhijack): New.
- * clearcase.el (clearcase-dired-menu-contents-minimised):
- * clearcase.el (clearcase-dired-menu-contents):
- * clearcase.el (clearcase-non-lt-registry-server-online-p):
- * clearcase.el (clearcase-lt-registry-server-online-p):
- * clearcase.el (clearcase-hook-find-file-hook):
- * clearcase.el (clearcase-hook-dired-mode-hook):
- * clearcase.el (clearcase-hook-dired-after-readin-hook):
- * clearcase.texi: Add dircategory XEmacs.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.08 released.
-
-2003-10-19 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.07 released.
-
-2003-10-18 Adrian Aichner <adrian@xemacs.org>
-
- * clearcase.el: Sync with upstream version /main/laptop/116.
- * clearcase.el (clearcase-version-stamp):
- * clearcase.el (clearcase-submit-bug-report):
- * clearcase.el (clearcase-on-mswindows):
- * clearcase.el (clearcase-on-cygwin32): Removed.
- * clearcase.el (clearcase-on-cygwin): New.
- * clearcase.el (clearcase-set-to-new-activity): New.
- * clearcase.el (clearcase-prompt-for-activity-names): New.
- * clearcase.el (clearcase-dired-reformat-buffer): Typo fix for
- /main/laptop/116.
- * clearcase.el (clearcase-path-follow-if-vob-slink): New.
- * clearcase.el (clearcase-dired-list-checkouts):
- * clearcase.el (clearcase-dired-list-checkouts-experimental):
- * clearcase.el (clearcase-dired-list-hijacks):
- * clearcase.el (clearcase-edcs-edit):
- * clearcase.el (clearcase-edcs-save):
- * clearcase.el (clearcase-read-new-activity-name): New.
- * clearcase.el (clearcase-read-mkact-args): New.
- * clearcase.el (clearcase-make-internally-named-activity): New.
- * clearcase.el (clearcase-ucm-mkact-current-dir):
- * clearcase.el (clearcase-ucm-mkact-named-current-dir): Removed.
- * clearcase.el (clearcase-ucm-set-activity):
- * clearcase.el (clearcase-next-action):
- * clearcase.el (clearcase-compute-next-action):
- * clearcase.el (clearcase-applet-diff-file-with-version):
- * clearcase.el (clearcase-diff-file-with-version):
- * clearcase.el (clearcase-applet-vtree-browser):
- * clearcase.el (clearcase-applet-clearexplorer): New.
- * clearcase.el (clearcase-uncheckout):
- * clearcase.el (clearcase-commented-mkbrtype):
- * clearcase.el (clearcase-browse-vtree):
- * clearcase.el (clearcase-list-history):
- * clearcase.el (clearcase-diff-files):
- * clearcase.el (clearcase-fprop-unparse-properties):
- * clearcase.el (clearcase-fprop-canonicalise-path):
- * clearcase.el (clearcase-fprop-vob-slink-text): New.
- * clearcase.el (clearcase-fprop-file-is-vob-slink-p): New.
- * clearcase.el (clearcase-fprop-fmt-string): Regexp fix for
- /main/laptop/116.
- * clearcase.el (clearcase-vprop-timer-function): Fix for
- /main/laptop/116 to not the properties for nil viewtag.
- * clearcase.el (clearcase-vprop-activities):
- * clearcase.el (clearcase-lsstream-fmt-string):
- * clearcase.el (clearcase-vprop-read-properties):
- * clearcase.el (clearcase-vprop-finish-reading-activities):
- * clearcase.el (clearcase-file-appears-modified-since-checkout-p):
- * clearcase.el (clearcase-viewdat-to-uuid):
- * clearcase.el (clearcase-view-uuid-to-tag):
- * clearcase.el (clearcase-file-is-in-view-p):
- * clearcase.el (clearcase-ct-start-cleartool):
- * clearcase.el (clearcase-ct-sentinel): New.
- * clearcase.el (clearcase-ct-do-cleartool-command):
- * clearcase.el (clearcase-ct-cd):
- * clearcase.el (clearcase-ct-blocking-call):
- * clearcase.el (clearcase-viewtag-start-view):
- * clearcase.el (clearcase-vxpath-of-branch-base):
- * clearcase.el (clearcase-vxpath-get-version-in-buffer):
- * clearcase.el (clearcase-path-canonical):
- * clearcase.el (clearcase-path-native):
- * clearcase.el (clearcase-buffer-revert):
- * clearcase.el (clearcase-utl-filetimes-close): New.
- * clearcase.el (clearcase-menu-contents-minimised):
- * clearcase.el (clearcase-menu-contents):
- * clearcase.el (clearcase-dired-menu-contents-minimised):
- * clearcase.el (clearcase-dired-menu-contents):
- * clearcase.el (clearcase-get-version-string):
- * clearcase.el (clearcase-non-lt-registry-server-online-p):
- * clearcase.el (clearcase-lt-registry-server-online-p):
- * clearcase.el (clearcase-hook-find-file-hook):
- * clearcase.el (clearcase-hook-vxpath-find-file-hook):
- * clearcase.el (clearcase-suppress-vc-within-mvfs-file-name-handler): Removed.
- * clearcase.el (clearcase-vxpath-file-name-handler):
- * clearcase.el (vc-registered): New.
- * clearcase.el ('clearcase-install): New. Prepare for XEmacs 21.5
- behavior support.
- * clearcase.el ('clearcase-uninstall): New. Ditto.
- * clearcase.el (clearcase-integrate): Add autoload cookie.
- * clearcase.el (clearcase-unintegrate): Ditto.
- * clearcase.el (clearcase-v6): New.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
- Don't add custom-load.elc to the list of generated elc's.
- Use STANDARD_DOCS instead of explicitly giving the targets
- and dependencies.
- Move the include of XEmacs.rules to the end of the file.
-
-2003-03-02 Norbert Koch <nk@viteno.net>
-
- * Makefile (VERSION): XEmacs package 1.06 released.
-
- * Makefile (VERSION): XEmacs package 1.05 released.
-
-2003-02-24 Michael Diers <mdiers@xemacs.org>
-
- * clearcase.el (clearcase-xemacs-package-maintainer-address): New
- constant.
- * clearcase.el (clearcase-submit-bug-report): Recipient is
- clearcase-xemacs-package-maintainer-address instead of
- clearcase-maintainer-address.
- * Makefile (MAINTAINER): Change to xemacs.org address.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2002-07-16 Adrian Aichner <adrian@xemacs.org>
-
- * .cvsignore: Add generated .info* and .html files.
-
-2002-06-27 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.04 released.
-
-2002-05-24 Patrik Hagglund <patha@softlab.ericsson.se>
-
- * clearcase.el (clearcase-vxpath-get-version-in-buffer): Fix Emacs
- 20 compatibility buglet.
-
-2002-02-12 Michael Diers <mdiers@elego.de>
-
- * clearcase.el (clearcase-get-version-string): Fix version
- detection for Cygwin.
-
-2002-01-24 Steven E. Harris <seh@speakeasy.org>
-
- * clearcase.el (clearcase-dired-reformat-buffer): Fix path
- conversions for cygwin.
- (clearcase-dired-list-checkouts): Fix newline escape for proper
- 'ct lsco' output.
- (clearcase-applet-diff-file-with-version): Fix path conversions
- for cygwin.
- (clearcase-diff-file-with-version): Clean up temp. file.
- (clearcase-diff-files): Fix path conversions for cygwin.
-
-2002-01-21 Adrian Aichner <adrian@xemacs.org>
-
- * clearcase.el (clearcase-vxpath-get-version-in-buffer): Make
- temp-file writable if necessary to avoid failure of `delete-file'.
-
-2002-01-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (HTML_FILES): New.
- * Makefile (HTML_DEP): New.
- * Makefile (all): Move $(INFO_FILES) dependency to end.
-
-2001-12-30 Adrian Aichner <adrian@xemacs.org>
-
- * clearcase.texi: Add missing direntry.
-
-2001-12-09 Adrian Aichner <adrian@xemacs.org>
-
- * Create package.
-
+++ /dev/null
-# Makefile for clearcase lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.12
-AUTHOR_VERSION = /main/laptop/165
-MAINTAINER = Adrian Aichner <adrian@xemacs.org>
-PACKAGE = clearcase
-PKG_TYPE = regular
-# Specify any required libraries which are not part of core lisp.
-# cl comint custom dired easymenu reporter ring timer tq
-REQUIRES = dired mail-lib xemacs-base sh-script
-CATEGORY = standard
-
-ELCS = clearcase.elc
-
-STANDARD_DOCS = t
-
-include ../../XEmacs.rules
+++ /dev/null
-;;; clearcase.el --- ClearCase/Emacs integration.
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004 Kevin Esler
-
-;; Author: Kevin Esler <kaesler@us.ibm.com>
-;; Maintainer: Kevin Esler <kaesler@us.ibm.com>
-;; Keywords: clearcase tools
-;; Web home: http://members.verizon.net/~vze24fr2/EmacsClearCase
-
-;; This file is not part of GNU Emacs.
-;;
-;; This program 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.
-
-;; This program 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.
-
-;;{{{ Introduction
-
-;; This is a ClearCase/Emacs integration.
-;;
-;;
-;; How to use
-;; ==========
-;;
-;; 0. Make sure you're using Gnu Emacs-20.4 or later or a recent XEmacs.
-;; In general it seems to work better in Gnu Emacs than in XEmacs,
-;; although many XEmacs users have no problems at all with it.
-;;
-;; 1. Make sure that you DON'T load old versions of vc-hooks.el which contain
-;; incompatible versions of the tq package (functions tq-enqueue and
-;; friends). In particular, Bill Sommerfeld's VC/CC integration has this
-;; problem.
-;;
-;; 2. Copy the files (or at least the clearcase.elc file) to a directory
-;; on your emacs-load-path.
-;;
-;; 3. Insert this in your emacs startup file: (load "clearcase")
-;;
-;; When you begin editing in any view-context, a ClearCase menu will appear
-;; and ClearCase Minor Mode will be activated for you.
-;;
-;; Summary of features
-;; ===================
-;;
-;; Keybindings compatible with Emacs' VC (where it makes sense)
-;; Richer interface than VC
-;; Works on NT and Unix
-;; Context sensitive menu (Emacs knows the ClearCase-status of files)
-;; Snapshot view support: update, version comparisons
-;; Can use Emacs Ediff for version comparison display
-;; Dired Mode:
-;; - en masse checkin/out etc
-;; - enhanced display
-;; - browse version tree
-;; Completion of viewnames, version strings
-;; Auto starting of views referenced as /view/TAG/.. (or \\view\TAG\...)
-;; Emacs for editing comments, config specs
-;; Standard ClearCase GUI tools launchable from Emacs menu
-;; - version tree browser
-;; - project browser
-;; - UCM deliver
-;; - UCM rebase
-;; Operations directly available from Emacs menu/keymap:
-;; create-activity
-;; set-activity
-;; mkelem,
-;; checkout
-;; checkin,
-;; unco,
-;; describe
-;; list history
-;; edit config spec
-;; mkbrtype
-;; snapshot view update: file, directory, view
-;; version comparisons using ediff, diff or GUI
-;; find checkouts
-;; annotate version
-;; et al.
-;;
-;; Acknowledgements
-;; ================
-;;
-;; The help of the following is gratefully acknowledged:
-;;
-;; XEmacs support and other bugfixes:
-;;
-;; Rod Whitby
-;; Adrian Aichner
-;; Michael Diers
-;;
-;; This was a result of examining earlier versions of VC and VC/ClearCase
-;; integrations and borrowing freely therefrom. Accordingly, the following
-;; are ackowledged as contributors:
-;;
-;; VC/ClearCase integration authors:
-;;
-;; Bill Sommerfeld
-;; Rod Whitby
-;; Andrew Markebo
-;; Andy Eskilsson
-;; Paul Smith
-;; John Kohl
-;; Chris Felaco
-;;
-;; VC authors:
-;;
-;; Eric S. Raymond
-;; Andre Spiegel
-;; Sebastian Kremer
-;; Richard Stallman
-;; Per Cederqvist
-;; ttn@netcom.com
-;; Andre Spiegel
-;; Jonathan Stigelman
-;; Steve Baur
-;;
-;; Other Contributors:
-;;
-;; Alastair Rankine
-;; Andrew Maguire
-;; Barnaby Dalton
-;; Christian Savard
-;; David O'Shea
-;; Dee Zsombor
-;; Gabor Zoka
-;; Jason Rumney
-;; Jeff Phillips
-;; Justin Vallon
-;; Mark Collins
-;; Patrik Madison
-;; Ram Bhamidipaty
-;; Reinhard Hahn
-;; Richard Kim
-;; Richard Y. Kim
-;; Simon Graham
-;; Stephen Leake
-;; Steven E. Harris
-;; John K. Sterling
-;; Trey Jackson
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;}}}
-
-;;{{{ Version info
-
-(defconst clearcase-version-stamp "ClearCase-version: </main/laptop/165>")
-(defconst clearcase-version (substring clearcase-version-stamp 19))
-
-(defun clearcase-maintainer-address ()
- ;; Avoid spam.
- ;;
- (concat "kevin.esler.1989"
- "@"
- "alum.bu.edu"))
-
-(defconst clearcase-xemacs-package-maintainer-address
- "Michael Diers <mdiers@xemacs.org>, xemacs-beta@xemacs.org")
-
-(defun clearcase-submit-bug-report ()
- "Submit via mail a bug report on ClearCase Mode"
- (interactive)
- (let ((recipient
- (if (string-match "XEmacs" emacs-version)
- clearcase-xemacs-package-maintainer-address
- (clearcase-maintainer-address))))
- (and (y-or-n-p "Do you really want to submit a report on ClearCase Mode ? ")
- (reporter-submit-bug-report
- recipient
- (concat "clearcase.el " clearcase-version)
- '(
- system-type
- system-configuration
- emacs-version
- clearcase-clearcase-version-installed
- clearcase-cleartool-path
- clearcase-lt
- clearcase-v3
- clearcase-v4
- clearcase-v5
- clearcase-v6
- clearcase-servers-online
- clearcase-disable-tq
- clearcase-on-cygwin
- clearcase-setview-root
- clearcase-suppress-vc-within-mvfs
- shell-file-name
- w32-quote-process-args
- )))))
-
-;;}}}
-
-;;{{{ Macros
-
-(defmacro clearcase-when-debugging (&rest forms)
- (list 'if 'clearcase-debug (cons 'progn forms)))
-
-(defmacro clearcase-with-tempfile (filename-var &rest forms)
- `(let ((,filename-var (clearcase-utl-tempfile-name)))
- (unwind-protect
- ,@forms
-
- ;; Cleanup.
- ;;
- (if (file-exists-p ,filename-var)
- (delete-file ,filename-var)))))
-
-;;}}}
-
-;;{{{ Portability
-
-(defvar clearcase-xemacs-p (string-match "XEmacs" emacs-version))
-
-(defvar clearcase-on-mswindows (memq system-type
- '(windows-nt ms-windows cygwin cygwin32)))
-
-(defvar clearcase-on-cygwin (memq system-type '(cygwin cygwin32)))
-
-(defvar clearcase-sink-file-name
- (cond
- (clearcase-on-cygwin "/dev/null")
- (clearcase-on-mswindows "NUL")
- (t "/dev/null")))
-
-(defun clearcase-view-mode-quit (buf)
- "Exit from View mode, restoring the previous window configuration."
- (progn
- (cond ((frame-property (selected-frame) 'clearcase-view-window-config)
- (set-window-configuration
- (frame-property (selected-frame) 'clearcase-view-window-config))
- (set-frame-property (selected-frame) 'clearcase-view-window-config nil))
- ((not (one-window-p))
- (delete-window)))
- (kill-buffer buf)))
-
-(defun clearcase-view-mode (arg &optional camefrom)
- (if clearcase-xemacs-p
- (let* ((winconfig (current-window-configuration))
- (was-one-window (one-window-p))
- (buffer-name (buffer-name (current-buffer)))
- (clearcase-view-not-visible
- (not (and (windows-of-buffer buffer-name) ;shortcut
- (memq (selected-frame)
- (mapcar 'window-frame
- (windows-of-buffer buffer-name)))))))
- (when clearcase-view-not-visible
- (set-frame-property (selected-frame)
- 'clearcase-view-window-config winconfig))
- (view-mode camefrom 'clearcase-view-mode-quit)
- (setq buffer-read-only nil))
- (view-mode arg)))
-
-(defun clearcase-port-view-buffer-other-window (buffer)
- (if clearcase-xemacs-p
- (switch-to-buffer-other-window buffer)
- (view-buffer-other-window buffer nil 'kill-buffer)))
-
-(defun clearcase-dired-sort-by-date ()
- (if (fboundp 'dired-sort-by-date)
- (dired-sort-by-date)))
-
-;; Copied from emacs-20
-;;
-(if (not (fboundp 'subst-char-in-string))
- (defun subst-char-in-string (fromchar tochar string &optional inplace)
- "Replace FROMCHAR with TOCHAR in STRING each time it occurs.
-Unless optional argument INPLACE is non-nil, return a new string."
- (let ((i (length string))
- (newstr (if inplace string (copy-sequence string))))
- (while (> i 0)
- (setq i (1- i))
- (if (eq (aref newstr i) fromchar)
- (aset newstr i tochar)))
- newstr)))
-
-;;}}}
-
-;;{{{ Require calls
-
-;; nyi: we also use these at the moment:
-;; -view
-;; -ediff
-;; -view
-;; -dired-sort
-
-(require 'cl)
-(require 'comint)
-(require 'dired)
-(require 'easymenu)
-(require 'executable)
-(require 'reporter)
-(require 'ring)
-(or clearcase-xemacs-p
- (require 'timer))
-
-;; NT Emacs - doesn't use tq.
-;;
-(if (not clearcase-on-mswindows)
- (require 'tq))
-
-;;}}}
-
-;;{{{ Debugging facilities
-
-;; Setting this to true will enable some debug code.
-;;
-(defvar clearcase-debug nil)
-
-(defun clearcase-trace (string)
- (clearcase-when-debugging
- (let ((trace-buf (get-buffer "*clearcase-trace*")))
- (if trace-buf
- (save-excursion
- (set-buffer trace-buf)
- (goto-char (point-max))
- (insert string "\n"))))))
-
-(defun clearcase-enable-tracing ()
- (interactive)
- (setq clearcase-debug t)
- (get-buffer-create "*clearcase-trace*"))
-
-(defun clearcase-disable-tracing ()
- (interactive)
- (setq clearcase-debug nil))
-
-(defun clearcase-dump ()
- (interactive)
- (clearcase-utl-populate-and-view-buffer
- "*clearcase-dump*"
- nil
- (function (lambda ()
- (clearcase-fprop-dump-to-current-buffer)
- (clearcase-vprop-dump-to-current-buffer)))))
-
-(defun clearcase-flush-caches ()
- (interactive)
- (clearcase-fprop-clear-all-properties)
- (clearcase-vprop-clear-all-properties))
-
-;;}}}
-
-;;{{{ Customizable variables
-
-(eval-and-compile
- (condition-case nil
- (require 'custom)
- (error nil))
- (if (and (featurep 'custom)
- (fboundp 'custom-declare-variable))
- nil ;; We've got what we needed
- ;; We have the old custom-library, hack around it!
- (defmacro defgroup (&rest args)
- nil)
- (defmacro defcustom (var value doc &rest args)
- (` (defvar (, var) (, value) (, doc))))
- (defmacro defface (face value doc &rest stuff)
- `(make-face ,face))
- (defmacro custom-declare-variable (symbol value doc &rest args)
- (list 'defvar (eval symbol) value doc))))
-
-(defgroup clearcase () "ClearCase Options" :group 'tools :prefix "clearcase")
-
-(defcustom clearcase-keep-uncheckouts t
- "When true, the contents of an undone checkout will be kept in a file
-with a \".keep\" suffix. Otherwise it will be removed."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-keep-unhijacks t
- "When true, the contents of an undone hijack will be kept in a file
-with a \".keep\" suffix. Otherwise it will be removed."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-remove-branch-after-unheckout-when-only-0-version t
- "When true, after a file has been unchecked out, if the version is .../0, remove the branch."
- :group 'clearcase
- :type 'boolean)
-
-;; nyi: We could also allow a value of 'prompt here
-;;
-(defcustom clearcase-set-to-new-activity t
- "*If this variable is non-nil when a new activity is created, that activity
-will be set as the current activity for the view, otherwise no change is made
-to the view's current activity setting."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-prompt-for-activity-names t
- "*If this variable is non-nil the user will be prompted for activity names.
-Otherwise, activity names will be generated automatically and will typically
-have the form \"activity011112.155233\". If the name entered is empty sucn an
-internal name will also be generated."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-make-backup-files nil
- "*If non-nil, backups of ClearCase files are made as with other files.
-If nil (the default), files under ClearCase control don't get backups."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-complete-viewtags t
- "*If non-nil, completion on viewtags is enabled. For sites with thousands of view
-this should be set to nil."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-minimise-menus nil
- "*If non-nil, menus will hide rather than grey-out inapplicable choices."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-auto-dired-mode t
- "*If non-nil, automatically enter `clearcase-dired-mode' in dired-mode
-for directories in ClearCase."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-dired-highlight t
- "If non-nil, highlight reserved files in clearcase-dired buffers."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-dired-show-view t
- "If non-nil, show the view tag in dired buffers."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-verify-pre-mkelem-dir-checkout nil
- "*If non-nil, prompt before checking out the containing directory
-before creating a new ClearCase element."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-diff-on-checkin nil
- "Display diff on checkin to help you compose the checkin comment."
- :group 'clearcase
- :type 'boolean)
-
-;; General customization
-
-(defcustom clearcase-suppress-confirm nil
- "If non-nil, treat user as expert; suppress yes-no prompts on some things."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-initial-mkelem-comment nil
- "Prompt for initial comment when an element is created."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-command-messages nil
- "Display run messages from back-end commands."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-checkin-arguments
- ;; For backwards compatibility with old name for this variable:
- ;;
- (if (and (boundp 'clearcase-checkin-switches)
- (not (null clearcase-checkin-switches)))
- (list clearcase-checkin-switches)
- nil)
- "A list of extra arguments passed to the checkin command."
- :group 'clearcase
- :type '(repeat (string :tag "Argument")))
-
-(defcustom clearcase-checkin-on-mkelem nil
- "If t, file will be checked-in when first created as an element."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-suppress-checkout-comments nil
- "Suppress prompts for checkout comments for those version control
-systems which use them."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-checkout-arguments
- ;; For backwards compatibility with old name for this variable:
- ;;
- (if (and (boundp 'clearcase-checkout-arguments)
- (not (null clearcase-checkout-arguments)))
- (list clearcase-checkout-arguments)
- nil)
- "A list of extra arguments passed to the checkout command."
- :group 'clearcase
- :type '(repeat (string :tag "Argument")))
-
-(defcustom clearcase-directory-exclusion-list '("lost+found")
- "Directory names ignored by functions that recursively walk file trees."
- :group 'clearcase
- :type '(repeat (string :tag "Subdirectory")))
-
-(defcustom clearcase-use-normal-diff nil
- "If non-nil, use normal diff instead of cleardiff."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-normal-diff-program "diff"
- "*Program to use for generating the differential of the two files
-when `clearcase-use-normal-diff' is t."
- :group 'clearcase
- :type 'string)
-
-(defcustom clearcase-normal-diff-arguments
- (if (and (boundp 'clearcase-normal-diff-switches)
- (not (null clearcase-normal-diff-switches)))
- (list clearcase-normal-diff-switches)
- (list "-u"))
- "A list of extra arguments passed to `clearcase-normal-diff-program'
-when `clearcase-use-normal-diff' is t. Usage of the -u switch is
-recommended to produce unified diffs, when your
-`clearcase-normal-diff-program' supports it."
- :group 'clearcase
- :type '(repeat (string :tag "Argument")))
-
-(defcustom clearcase-vxpath-glue "@@"
- "The string used to construct version-extended pathnames."
- :group 'clearcase
- :type 'string)
-
-(defcustom clearcase-viewroot (if clearcase-on-mswindows
- "//view"
- "/view")
- "The ClearCase viewroot directory."
- :group 'clearcase
- :type 'file)
-
-(defcustom clearcase-viewroot-drive "m:"
- "The ClearCase viewroot drive letter for Windows."
- :group 'clearcase
- :type 'string)
-
-(defcustom clearcase-suppress-vc-within-mvfs t
- "Suppresses VC activity within the MVFS."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-hide-rebase-activities t
- "Hide rebase activities from activity selection list."
- :group 'clearcase
- :type 'boolean)
-
-(defcustom clearcase-rebase-id-regexp "^rebase\\."
- "The regexp used to detect rebase actvities."
- :group 'clearcase
- :type 'string)
-
-(defcustom clearcase-annotate-fmt-string "/** %Sd %-8.8u **/"
- "The -fmt argument passed top cleartool+annotate when it is called."
- :group 'clearcase
- :type 'string)
-
-;;}}}
-
-;;{{{ Global variables
-
-;; Initialize clearcase-pname-sep-regexp according to
-;; directory-sep-char.
-(defvar clearcase-pname-sep-regexp
- (format "[%s/]"
- (char-to-string directory-sep-char)))
-
-(defvar clearcase-non-pname-sep-regexp
- (format "[^%s/]"
- (char-to-string directory-sep-char)))
-
-;; Matches any viewtag (without the trailing "/").
-;;
-(defvar clearcase-viewtag-regexp
- (concat "^"
- clearcase-viewroot
- clearcase-pname-sep-regexp
- "\\("
- clearcase-non-pname-sep-regexp "*"
- "\\)"
- "$"
- ))
-
-;; Matches ANY viewroot-relative path
-;;
-(defvar clearcase-vrpath-regexp
- (concat "^"
- clearcase-viewroot
- clearcase-pname-sep-regexp
- "\\("
- clearcase-non-pname-sep-regexp "*"
- "\\)"
- ))
-
-;;}}}
-
-;;{{{ Minor Mode: ClearCase
-
-;; For ClearCase Minor Mode
-;;
-(defvar clearcase-mode nil)
-(set-default 'clearcase-mode nil)
-(make-variable-buffer-local 'clearcase-mode)
-(put 'clearcase-mode 'permanent-local t)
-
-;; Tell Emacs about this new kind of minor mode
-;;
-(if (not (assoc 'clearcase-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(clearcase-mode clearcase-mode)
- minor-mode-alist)))
-
-;; For now we override the bindings for VC Minor Mode with ClearCase Minor Mode
-;; bindings.
-;;
-(defvar clearcase-mode-map (make-sparse-keymap))
-(defvar clearcase-prefix-map (make-sparse-keymap))
-(define-key clearcase-mode-map "\C-xv" clearcase-prefix-map)
-(define-key clearcase-mode-map "\C-x\C-q" 'clearcase-toggle-read-only)
-
-(define-key clearcase-prefix-map "b" 'clearcase-browse-vtree-current-buffer)
-(define-key clearcase-prefix-map "c" 'clearcase-uncheckout-current-buffer)
-(define-key clearcase-prefix-map "e" 'clearcase-edcs-edit)
-(define-key clearcase-prefix-map "g" 'clearcase-annotate-current-buffer)
-(define-key clearcase-prefix-map "i" 'clearcase-mkelem-current-buffer)
-(define-key clearcase-prefix-map "l" 'clearcase-list-history-current-buffer)
-(define-key clearcase-prefix-map "m" 'clearcase-mkbrtype)
-(define-key clearcase-prefix-map "u" 'clearcase-uncheckout-current-buffer)
-(define-key clearcase-prefix-map "v" 'clearcase-next-action-current-buffer)
-(define-key clearcase-prefix-map "w" 'clearcase-what-rule-current-buffer)
-(define-key clearcase-prefix-map "=" 'clearcase-diff-pred-current-buffer)
-(define-key clearcase-prefix-map "?" 'clearcase-describe-current-buffer)
-(define-key clearcase-prefix-map "~" 'clearcase-version-other-window)
-
-;; To avoid confusion, we prevent VC Mode from being active at all by
-;; undefining its keybindings for which ClearCase Mode doesn't yet have an
-;; analogue.
-;;
-(define-key clearcase-prefix-map "a" 'undefined) ;; vc-update-change-log
-(define-key clearcase-prefix-map "d" 'undefined) ;; vc-directory
-(define-key clearcase-prefix-map "h" 'undefined) ;; vc-insert-headers
-(define-key clearcase-prefix-map "m" 'undefined) ;; vc-merge
-(define-key clearcase-prefix-map "r" 'undefined) ;; vc-retrieve-snapshot
-(define-key clearcase-prefix-map "s" 'undefined) ;; vc-create-snapshot
-(define-key clearcase-prefix-map "t" 'undefined) ;; vc-dired-toggle-terse-mode
-
-;; Associate the map and the minor mode
-;;
-(or (not (boundp 'minor-mode-map-alist))
- (assq 'clearcase-mode (symbol-value 'minor-mode-map-alist))
- (setq minor-mode-map-alist
- (cons (cons 'clearcase-mode clearcase-mode-map)
- minor-mode-map-alist)))
-
-(defun clearcase-mode (&optional arg)
- "ClearCase Minor Mode"
-
- (interactive "P")
-
- ;; Behave like a proper minor-mode.
- ;;
- (setq clearcase-mode
- (if (interactive-p)
- (if (null arg)
- (not clearcase-mode)
-
- ;; Check if the numeric arg is positive.
- ;;
- (> (prefix-numeric-value arg) 0))
-
- ;; else
- ;; Use the car if it's a list.
- ;;
- (if (consp arg)
- (setq arg (car arg)))
- (if (symbolp arg)
- (if (null arg)
- (not clearcase-mode) ;; toggle mode switch
- (not (eq '- arg))) ;; True if symbol is not '-
-
- ;; else
- ;; assume it's a number and check that.
- ;;
- (> arg 0))))
-
- (if clearcase-mode
- (easy-menu-add clearcase-menu 'clearcase-mode-map))
- )
-
-;;}}}
-
-;;{{{ Minor Mode: ClearCase Dired
-
-;;{{{ Reformatting the Dired buffer
-
-;; Create a face for highlighting checked out files in clearcase-dired.
-;;
-(if (not (memq 'clearcase-dired-checkedout-face (face-list)))
- (progn
- (make-face 'clearcase-dired-checkedout-face)
- (set-face-foreground 'clearcase-dired-checkedout-face "red")))
-
-(defun clearcase-dired-insert-viewtag ()
- (save-excursion
- (progn
- (goto-char (point-min))
-
- ;; Only do this if the buffer is not currently narrowed
- ;;
- (if (= 1 (point))
- (let ((viewtag (clearcase-fprop-viewtag (file-truename default-directory))))
- (if viewtag
- (progn
- (forward-line 1)
- (let ((buffer-read-only nil))
- (insert (format " [ClearCase View: %s]\n" viewtag))))))))))
-
-(defun clearcase-dired-reformat-buffer ()
- "Reformats the current dired buffer."
- (let* ((checkout-list nil)
- (modified-file-info nil)
- (hijack-list nil)
- (directory default-directory)
- subdir
- fullpath)
-
- ;; Iterate over each line in the buffer.
- ;;
- ;; Important notes:
- ;; 1. In general, a Dired buffer can contain listings for several
- ;; directories. We pass though from top to bottom and adjust
- ;; subdir as we go.
- ;; 2. Since this is called from dired-after-reading-hook, it can get
- ;; called on a single-line buffer. In this case there is no subdir,
- ;; and no checkout-list. We need to call clearcase-fprop-checked-out
- ;; to test for a checkout.
- ;;
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (cond
-
- ;; Case 1: Look for directory markers
- ;;
- ((setq subdir (dired-get-subdir))
-
- ;; We're at a subdirectory line in the dired buffer.
- ;; Go and list all checkouts and hijacks in this subdirectory.
- ;;
- (setq modified-file-info (clearcase-dired-list-modified-files subdir))
- (setq checkout-list (nth 0 modified-file-info))
- (setq hijack-list (nth 1 modified-file-info))
-
- ;; If no checkouts are found, we don't need to check each file, and
- ;; it's very slow. The checkout-list should contain something so it
- ;; doesn't attempt to do this.
- ;;
- (if (null checkout-list)
- (setq checkout-list '(nil)))
- (if (null hijack-list)
- (setq hijack-list '(nil)))
- (message "Reformatting %s..." subdir))
-
- ;; Case 2: Look for files (the safest way to get the filename).
- ;;
- ((setq fullpath (dired-get-filename nil t))
-
- ;; Expand it to get rid of . and .. entries.
- ;;
- (setq fullpath (expand-file-name fullpath))
-
- (setq fullpath (clearcase-path-canonicalise-slashes fullpath))
-
- ;; Only modify directory listings of the correct format.
- ;; We replace the GID field with a checkout indicator.
- ;;
- (if (looking-at
- ;; (1) (2) (3) (4)
- ;; -rw-rw-rw- 1 esler 5 28 Feb 2 16:02 foo.el
- "..\\([drwxlts-]+ \\) *\\([0-9]+\\) \\([^ ]+\\) *\\([^ ]+ *\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)")
-
- (let* ((replacement-begin (match-beginning 4))
- (replacement-end (match-end 4))
-
- (replacement-length (- replacement-end replacement-begin))
- (checkout-replacement-text (format "CHECKOUT"))
- (hijack-replacement-text (format "HIJACK"))
- (is-checkout (if checkout-list
- (member fullpath checkout-list)
- (clearcase-fprop-checked-out fullpath)))
- (is-hijack (if hijack-list
- (member fullpath hijack-list)
- (clearcase-fprop-hijacked fullpath))))
-
- ;; Highlight the line if the file is checked-out.
- ;;
- (if is-checkout
- (progn
- ;; Replace the GID field with CHECKOUT.
- ;;
- (let ((buffer-read-only nil))
-
- ;; Pad with replacement text with trailing spaces if necessary.
- ;;
- (if (>= replacement-length (length checkout-replacement-text))
- (setq checkout-replacement-text
- (concat checkout-replacement-text
- (make-string (- replacement-length (length checkout-replacement-text))
- 32))))
- (goto-char replacement-begin)
- (delete-char replacement-length)
- (insert (substring checkout-replacement-text 0 replacement-length)))
-
- ;; Highlight the checked out files.
- ;;
- (if (fboundp 'put-text-property)
- (let ((buffer-read-only nil))
- (put-text-property replacement-begin replacement-end
- 'face 'clearcase-dired-checkedout-face)))
- )
- )
-
- (if is-hijack
- (progn
- ;; Replace the GID field with CHECKOUT.
- ;;
- (let ((buffer-read-only nil))
-
- ;; Pad with replacement text with trailing spaces if necessary.
- ;;
- (if (>= replacement-length (length hijack-replacement-text))
- (setq hijack-replacement-text
- (concat hijack-replacement-text
- (make-string (- replacement-length (length hijack-replacement-text))
- 32))))
- (goto-char replacement-begin)
- (delete-char replacement-length)
- (insert (substring hijack-replacement-text 0 replacement-length)))
-
- ;; Highlight the checked out files.
- ;;
- (if (fboundp 'put-text-property)
- (let ((buffer-read-only nil))
- (put-text-property replacement-begin replacement-end
- 'face 'clearcase-dired-checkedout-face)))
- )
- )
-
- ))))
- (forward-line 1))))
- (message "Reformatting...Done"))
-
-
-(defun clearcase-path-follow-if-vob-slink (path)
- (if (clearcase-fprop-file-is-vob-slink-p path)
-
- ;; It's a slink so follow it.
- ;;
- (let ((slink-text (clearcase-fprop-vob-slink-text path)))
- (if (file-name-absolute-p slink-text)
- slink-text
- (concat (file-name-directory path) slink-text)))
-
- ;; Not an slink.
- ;;
- path))
-
-;;{{{ Searching for modified files
-
-;;{{{ Old code
-
-;; (defun clearcase-dired-list-checkouts (directory)
-;; "Returns a list of files checked-out to the current view in DIRECTORY."
-
-;; ;; Don't bother looking for checkouts in
-;; ;; - a history-mode branch-qua-directory
-;; ;; - a view-private directory
-;; ;;
-;; ;; NYI: For now don't run lsco in root of a snapshot because it gives errors.
-;; ;; We need to make this smarter.
-;; ;;
-;; ;; NYI: For a pathname which is a slink to a dir, despite the fact that
-;; ;; clearcase-fprop-file-is-version-p returns true, lsco fails on it,
-;; ;; with "not an element". Sheesh, surely lsco ought to follow links ?
-;; ;; Solution: catch the error and check if the dir is a slink then follow
-;; ;; the link and retry the lsco on the target.
-;; ;;
-;; ;; For now just ignore the error.
-;; ;;
-;; (if (and (not (clearcase-vxpath-p directory))
-;; (not (eq 'view-private-object (clearcase-fprop-mtype directory)))
-;; (clearcase-fprop-file-is-version-p directory))
-
-
-;; (let* ((ignore (message "Listing ClearCase checkouts..."))
-
-;; (true-dir-path (file-truename directory))
-
-;; ;; Give the directory as an argument so all names will be
-;; ;; fullpaths. For some reason ClearCase adds an extra slash if you
-;; ;; leave the trailing slash on the directory, so we need to remove
-;; ;; it.
-;; ;;
-;; (native-dir-path (clearcase-path-native (directory-file-name true-dir-path)))
-
-;; (followed-dir-path (clearcase-path-follow-if-vob-slink native-dir-path))
-
-;; ;; Form the command:
-;; ;;
-;; (cmd (list
-;; "lsco" "-cview" "-fmt"
-;; (if clearcase-on-mswindows
-;; "%n\\n"
-;; "'%n\\n'")
-
-;; followed-dir-path))
-
-;; ;; Capture the output:
-;; ;;
-;; (string (clearcase-path-canonicalise-slashes
-;; (apply 'clearcase-ct-cleartool-cmd cmd)))
-
-;; ;; Split the output at the newlines:
-;; ;;
-;; (checkout-list (clearcase-utl-split-string-at-char string ?\n)))
-
-;; ;; Add entries for "." and ".." if they're checked-out.
-;; ;;
-;; (let* ((entry ".")
-;; (path (expand-file-name (concat (file-name-as-directory true-dir-path)
-;; entry))))
-;; (if (clearcase-fprop-checked-out path)
-;; (setq checkout-list (cons path checkout-list))))
-;; (let* ((entry "..")
-;; (path (expand-file-name (concat (file-name-as-directory true-dir-path)
-;; entry))))
-;; (if (clearcase-fprop-checked-out path)
-;; (setq checkout-list (cons path checkout-list))))
-
-;; ;; If DIRECTORY is a vob-slink, checkout list will contain pathnames
-;; ;; relative to the vob-slink target rather than to DIRECTORY. Convert
-;; ;; them back here. We're making it appear that lsco works on
-;; ;; slinks-to-dirs.
-;; ;;
-;; (if (clearcase-fprop-file-is-vob-slink-p true-dir-path)
-;; (let ((re (regexp-quote (file-name-as-directory followed-dir-path))))
-;; (setq checkout-list
-;; (mapcar
-;; (function
-;; (lambda (path)
-;; (replace-regexp-in-string re true-dir-path path)))
-;; checkout-list))))
-
-;; (message "Listing ClearCase checkouts...done")
-
-;; ;; Return the result.
-;; ;;
-;; checkout-list)
-;; ))
-
-;; ;; I had believed that this implementation below OUGHT to be faster, having
-;; ;; read the code in "ct+lsco". It seemed that "lsco -cview" hit the VOB and
-;; ;; listed all checkouts on all elements in the directory, and then filtered by
-;; ;; view. I thought it would probably be quicker to run "ct ls -vob_only" and
-;; ;; keep the lines that have "[eclipsed by checkout]". However this code
-;; ;; actually seemed to run slower. Leave the code here for now so I can test
-;; ;; further.
-;; ;;
-;; (defun clearcase-dired-list-checkouts-experimental (directory)
-;; "Returns a list of files checked-out to the current view in DIRECTORY."
-
-;; ;; Don't bother looking for checkouts in a history-mode listing
-;; ;; nor in view-private directories.
-;; ;;
-;; (if (and (not (clearcase-vxpath-p directory))
-;; (not (eq 'view-private-object (clearcase-fprop-mtype directory))))
-
-;; (let* ((ignore (message "Listing ClearCase checkouts..."))
-
-;; (true-directory (file-truename directory))
-
-;; ;; Move temporarily to the directory:
-;; ;;
-;; (default-directory true-directory)
-
-;; ;; Form the command:
-;; ;;
-;; (cmd (list "ls" "-vob_only"))
-
-;; ;; Capture the output:
-;; ;;
-;; (string (clearcase-path-canonicalise-slashes
-;; (apply 'clearcase-ct-cleartool-cmd cmd)))
-
-;; ;; Split the output at the newlines:
-;; ;;
-;; (line-list (clearcase-utl-split-string-at-char string ?\n))
-
-;; (checkout-list nil))
-
-;; ;; Look for lines of the form:
-;; ;; FILENAME@@ [eclipsed by checkout]
-;; ;;
-;; (mapcar (function
-;; (lambda (line)
-;; (if (string-match "^\\([^ @]+\\)@@ +\\[eclipsed by checkout\\].*" line)
-;; (setq checkout-list (cons (concat
-;; ;; Add back directory name to get
-;; ;; full pathname.
-;; ;;
-;; default-directory
-;; (substring line
-;; (match-beginning 1)
-;; (match-end 1)))
-;; checkout-list)))))
-;; line-list)
-
-;; ;; Add entries for "." and ".." if they're checked-out.
-;; ;;
-;; (let* ((entry ".")
-;; (path (expand-file-name (concat true-directory entry))))
-;; (if (clearcase-fprop-checked-out path)
-;; (setq checkout-list (cons path checkout-list))))
-;; (let* ((entry "..")
-;; (path (expand-file-name (concat true-directory entry))))
-;; (if (clearcase-fprop-checked-out path)
-;; (setq checkout-list (cons path checkout-list))))
-
-;; (message "Listing ClearCase checkouts...done")
-
-;; ;; Return the result.
-;; ;;
-;; checkout-list)))
-
-;; (defun clearcase-dired-list-hijacks (directory)
-;; "Returns a list of files hijacked to the current view in DIRECTORY."
-
-;; ;; Don't bother looking for hijacks in;
-;; ;; - a history-mode listing
-;; ;; - a in view-private directory
-;; ;; - a dynamic view
-;; ;;
-;; (let* ((true-directory (file-truename directory))
-;; (viewtag (clearcase-fprop-viewtag true-directory)))
-
-;; (if (and viewtag
-;; (not (clearcase-vxpath-p directory))
-;; (not (eq 'view-private-object (clearcase-fprop-mtype directory)))
-;; (clearcase-file-would-be-in-snapshot-p true-directory))
-
-;; (let* ((ignore (message "Listing ClearCase hijacks..."))
-
-;; (true-directory (file-truename directory))
-
-;; ;; Form the command:
-;; ;;
-;; (cmd (list
-;; "ls"
-
-;; ;; Give the directory as an argument so all names will be
-;; ;; fullpaths. For some reason ClearCase adds an extra slash
-;; ;; if you leave the trailing slash on the directory, so we
-;; ;; need to remove it.
-;; ;;
-;; (clearcase-path-native (directory-file-name true-directory))))
-
-;; ;; Capture the output:
-;; ;;
-;; (string (clearcase-path-canonicalise-slashes
-;; (apply 'clearcase-ct-cleartool-cmd cmd)))
-
-;; ;; Split the output at the newlines:
-;; ;;
-;; (line-list (clearcase-utl-split-string-at-char string ?\n))
-
-;; (hijack-list nil))
-
-;; (mapcar (function
-;; (lambda (line)
-;; (if (string-match "^\\([^ @]+\\)@@[^ ]+ \\[hijacked\\].*" line)
-;; (setq hijack-list (cons (substring line
-;; (match-beginning 1)
-;; (match-end 1))
-;; hijack-list)))))
-;; line-list)
-
-;; (message "Listing ClearCase hijacks...done")
-
-;; ;; Return the result.
-;; ;;
-;; hijack-list))))
-
-;;}}}
-
-(defun clearcase-dired-list-modified-files (directory)
- "Returns a pair of lists of files (checkouts . hijacks) to the current view in DIRECTORY."
-
- ;; Don't bother looking for hijacks in;
- ;; - a history-mode listing
- ;; - a in view-private directory
- ;; - a dynamic view
- ;;
- (let* ((true-directory (file-truename directory))
- (viewtag (clearcase-fprop-viewtag true-directory))
- (snapshot (clearcase-file-would-be-in-snapshot-p true-directory))
- (result '(() ())))
-
- (if (and viewtag
- (not (clearcase-vxpath-p directory))
- (not (eq 'view-private-object (clearcase-fprop-mtype directory))))
-
- (let* ((ignore (message "Listing ClearCase modified files..."))
-
- (true-directory (file-truename directory))
-
- ;; Form the command:
- ;;
- (cmd (list
- "ls"
-
- ;; Give the directory as an argument so all names will be
- ;; fullpaths. For some reason ClearCase adds an extra slash
- ;; if you leave the trailing slash on the directory, so we
- ;; need to remove it.
- ;;
- (clearcase-path-native (directory-file-name true-directory))))
-
- ;; Capture the output:
- ;;
- (string (clearcase-path-canonicalise-slashes
- (apply 'clearcase-ct-cleartool-cmd cmd)))
-
- ;; Split the output at the newlines:
- ;;
- (line-list (clearcase-utl-split-string-at-char string ?\n))
-
- (hijack-list nil)
- (checkout-list nil))
-
- (mapcar (function
- (lambda (line)
- (if (string-match "^\\([^ @]+\\)@@[^ ]+ \\[hijacked\\].*" line)
- (setq hijack-list (cons (substring line
- (match-beginning 1)
- (match-end 1))
- hijack-list)))
- (if (string-match "^\\([^ @]+\\)@@.+CHECKEDOUT from .*" line)
- (setq checkout-list (cons (substring line
- (match-beginning 1)
- (match-end 1))
- checkout-list)))))
- line-list)
-
- (message "Listing ClearCase modified files...done")
-
- ;; Return the result.
- ;;
- (setq result (list checkout-list hijack-list))))
- result))
-
-;;}}}
-
-;;}}}
-
-;; For ClearCase Dired Minor Mode
-;;
-(defvar clearcase-dired-mode nil)
-(set-default 'clearcase-dired-mode nil)
-(make-variable-buffer-local 'clearcase-dired-mode)
-
-;; Tell Emacs about this new kind of minor mode
-;;
-(if (not (assoc 'clearcase-dired-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(clearcase-dired-mode clearcase-dired-mode)
- minor-mode-alist)))
-
-;; For now we override the bindings for VC Minor Mode with ClearCase Dired
-;; Minor Mode bindings.
-;;
-(defvar clearcase-dired-mode-map (make-sparse-keymap))
-(defvar clearcase-dired-prefix-map (make-sparse-keymap))
-(define-key clearcase-dired-mode-map "\C-xv" clearcase-dired-prefix-map)
-
-(define-key clearcase-dired-prefix-map "b" 'clearcase-browse-vtree-dired-file)
-(define-key clearcase-dired-prefix-map "c" 'clearcase-uncheckout-dired-files)
-(define-key clearcase-dired-prefix-map "e" 'clearcase-edcs-edit)
-(define-key clearcase-dired-prefix-map "i" 'clearcase-mkelem-dired-files)
-(define-key clearcase-dired-prefix-map "g" 'clearcase-annotate-dired-file)
-(define-key clearcase-dired-prefix-map "l" 'clearcase-list-history-dired-file)
-(define-key clearcase-dired-prefix-map "m" 'clearcase-mkbrtype)
-(define-key clearcase-dired-prefix-map "u" 'clearcase-uncheckout-dired-files)
-(define-key clearcase-dired-prefix-map "v" 'clearcase-next-action-dired-files)
-(define-key clearcase-dired-prefix-map "w" 'clearcase-what-rule-dired-file)
-(define-key clearcase-dired-prefix-map "=" 'clearcase-diff-pred-dired-file)
-(define-key clearcase-dired-prefix-map "~" 'clearcase-version-other-window)
-(define-key clearcase-dired-prefix-map "?" 'clearcase-describe-dired-file)
-
-;; To avoid confusion, we prevent VC Mode from being active at all by
-;; undefining its keybindings for which ClearCase Mode doesn't yet have an
-;; analogue.
-;;
-(define-key clearcase-dired-prefix-map "a" 'undefined) ;; vc-update-change-log
-(define-key clearcase-dired-prefix-map "d" 'undefined) ;; vc-directory
-(define-key clearcase-dired-prefix-map "h" 'undefined) ;; vc-insert-headers
-(define-key clearcase-dired-prefix-map "m" 'undefined) ;; vc-merge
-(define-key clearcase-dired-prefix-map "r" 'undefined) ;; vc-retrieve-snapshot
-(define-key clearcase-dired-prefix-map "s" 'undefined) ;; vc-create-snapshot
-(define-key clearcase-dired-prefix-map "t" 'undefined) ;; vc-dired-toggle-terse-mode
-
-;; Associate the map and the minor mode
-;;
-(or (not (boundp 'minor-mode-map-alist))
- (assq 'clearcase-dired-mode (symbol-value 'minor-mode-map-alist))
- (setq minor-mode-map-alist
- (cons (cons 'clearcase-dired-mode clearcase-dired-mode-map)
- minor-mode-map-alist)))
-
-(defun clearcase-dired-mode (&optional arg)
- "The augmented Dired minor mode used in ClearCase directory buffers.
-All Dired commands operate normally. Users with checked-out files
-are listed in place of the file's owner and group. Keystrokes bound to
-ClearCase Mode commands will execute as though they had been called
-on a buffer attached to the file named in the current Dired buffer line."
-
- (interactive "P")
-
- ;; Behave like a proper minor-mode.
- ;;
- (setq clearcase-dired-mode
- (if (interactive-p)
- (if (null arg)
- (not clearcase-dired-mode)
-
- ;; Check if the numeric arg is positive.
- ;;
- (> (prefix-numeric-value arg) 0))
-
- ;; else
- ;; Use the car if it's a list.
- ;;
- (if (consp arg)
- (setq arg (car arg)))
-
- (if (symbolp arg)
- (if (null arg)
- (not clearcase-dired-mode) ;; toggle mode switch
- (not (eq '- arg))) ;; True if symbol is not '-
-
- ;; else
- ;; assume it's a number and check that.
- ;;
- (> arg 0))))
-
- (if (not (eq major-mode 'dired-mode))
- (setq clearcase-dired-mode nil))
-
- (if (and clearcase-dired-mode clearcase-dired-highlight)
- (clearcase-dired-reformat-buffer))
-
- (if clearcase-dired-mode
- (easy-menu-add clearcase-dired-menu 'clearcase-dired-mode-map))
- )
-
-;;}}}
-
-;;{{{ Major Mode: for editing comments.
-
-;; The major mode function.
-;;
-(defun clearcase-comment-mode ()
- "Major mode for editing comments for ClearCase.
-
-These bindings are added to the global keymap when you enter this mode:
-
-\\[clearcase-next-action-current-buffer] perform next logical version-control operation on current file
-\\[clearcase-mkelem-current-buffer] mkelem the current file
-\\[clearcase-toggle-read-only] like next-action, but won't create elements
-\\[clearcase-list-history-current-buffer] display change history of current file
-\\[clearcase-uncheckout-current-buffer] cancel checkout in buffer
-\\[clearcase-diff-pred-current-buffer] show diffs between file versions
-\\[clearcase-version-other-window] visit old version in another window
-
-While you are entering a comment for a version, the following
-additional bindings will be in effect.
-
-\\[clearcase-comment-finish] proceed with check in, ending comment
-
-Whenever you do a checkin, your comment is added to a ring of
-saved comments. These can be recalled as follows:
-
-\\[clearcase-comment-next] replace region with next message in comment ring
-\\[clearcase-comment-previous] replace region with previous message in comment ring
-\\[clearcase-comment-search-reverse] search backward for regexp in the comment ring
-\\[clearcase-comment-search-forward] search backward for regexp in the comment ring
-
-Entry to the clearcase-comment-mode calls the value of text-mode-hook, then
-the value of clearcase-comment-mode-hook.
-
-Global user options:
- clearcase-initial-mkelem-comment If non-nil, require user to enter a change
- comment upon first checkin of the file.
-
- clearcase-suppress-confirm Suppresses some confirmation prompts,
- notably for reversions.
-
- clearcase-command-messages If non-nil, display run messages from the
- actual version-control utilities (this is
- intended primarily for people hacking clearcase.el
- itself).
-"
- (interactive)
-
- ;; Major modes are supposed to just (kill-all-local-variables)
- ;; but we rely on clearcase-parent-buffer already having been set
- ;;
- ;;(let ((parent clearcase-parent-buffer))
- ;; (kill-all-local-variables)
- ;; (set (make-local-variable 'clearcase-parent-buffer) parent))
-
- (setq major-mode 'clearcase-comment-mode)
- (setq mode-name "ClearCase/Comment")
-
- (set-syntax-table text-mode-syntax-table)
- (use-local-map clearcase-comment-mode-map)
- (setq local-abbrev-table text-mode-abbrev-table)
-
- (make-local-variable 'clearcase-comment-operands)
- (make-local-variable 'clearcase-comment-ring-index)
-
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (run-hooks 'text-mode-hook 'clearcase-comment-mode-hook))
-
-;; The keymap.
-;;
-(defvar clearcase-comment-mode-map nil)
-(if clearcase-comment-mode-map
- nil
- (setq clearcase-comment-mode-map (make-sparse-keymap))
- (define-key clearcase-comment-mode-map "\M-n" 'clearcase-comment-next)
- (define-key clearcase-comment-mode-map "\M-p" 'clearcase-comment-previous)
- (define-key clearcase-comment-mode-map "\M-r" 'clearcase-comment-search-reverse)
- (define-key clearcase-comment-mode-map "\M-s" 'clearcase-comment-search-forward)
- (define-key clearcase-comment-mode-map "\C-c\C-c" 'clearcase-comment-finish)
- (define-key clearcase-comment-mode-map "\C-x\C-s" 'clearcase-comment-save)
- (define-key clearcase-comment-mode-map "\C-x\C-q" 'clearcase-comment-num-num-error))
-
-;; Constants.
-;;
-(defconst clearcase-comment-maximum-ring-size 32
- "Maximum number of saved comments in the comment ring.")
-
-;; Variables.
-;;
-(defvar clearcase-comment-entry-mode nil)
-(defvar clearcase-comment-operation nil)
-(defvar clearcase-comment-operands)
-(defvar clearcase-comment-ring nil)
-(defvar clearcase-comment-ring-index nil)
-(defvar clearcase-comment-last-match nil)
-(defvar clearcase-comment-window-config nil)
-
-;; In several contexts, this is a local variable that points to the buffer for
-;; which it was made (either a file, or a ClearCase dired buffer).
-;;
-(defvar clearcase-parent-buffer nil)
-(defvar clearcase-parent-buffer-name nil)
-
-;;{{{ Commands and functions
-
-(defun clearcase-comment-start-entry (uniquifier
- prompt
- continuation
- operands
- &optional parent-buffer comment-seed)
-
- "Accept a comment by popping up a clearcase-comment-mode buffer
-with a name derived from UNIQUIFIER, and emitting PROMPT in the minibuffer.
-Set the continuation on close to CONTINUATION, which should be apply-ed to a list
-formed by appending OPERANDS and the comment-string.
-
-Optional 5th argument specifies a PARENT-BUFFER to return to when the operation
-is complete.
-
-Optional 6th argument specifies a COMMENT-SEED to insert in the comment buffer for
-the user to edit."
-
- (let ((comment-buffer (get-buffer-create (format "*clearcase-comment-%s*" uniquifier)))
- (old-window-config (current-window-configuration))
- (parent (or parent-buffer
- (current-buffer))))
- (pop-to-buffer comment-buffer)
-
- ;; Record in buffer-local variables information sufficient to restore
- ;; window context.
- ;;
- (set (make-local-variable 'clearcase-comment-window-config) old-window-config)
- (set (make-local-variable 'clearcase-parent-buffer) parent)
-
- (clearcase-comment-mode)
- (setq clearcase-comment-operation continuation)
- (setq clearcase-comment-operands operands)
- (if comment-seed
- (insert comment-seed))
- (message "%s Type C-c C-c when done." prompt)))
-
-
-(defun clearcase-comment-cleanup ()
- ;; Make sure it ends with newline
- ;;
- (goto-char (point-max))
- (if (not (bolp))
- (newline))
-
- ;; Remove useless whitespace.
- ;;
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
- (replace-match ""))
-
- ;; Remove trailing newlines, whitespace.
- ;;
- (goto-char (point-max))
- (skip-chars-backward " \n\t")
- (delete-region (point) (point-max)))
-
-(defun clearcase-comment-finish ()
- "Complete the operation implied by the current comment."
- (interactive)
-
- ;;Clean and record the comment in the ring.
- ;;
- (let ((comment-buffer (current-buffer)))
- (clearcase-comment-cleanup)
-
- (if (null clearcase-comment-ring)
- (setq clearcase-comment-ring (make-ring clearcase-comment-maximum-ring-size)))
- (ring-insert clearcase-comment-ring (buffer-string))
-
- ;; Perform the operation on the operands.
- ;;
- (if clearcase-comment-operation
- (save-excursion
- (apply clearcase-comment-operation
- (append clearcase-comment-operands (list (buffer-string)))))
- (error "No comment operation is pending"))
-
- ;; Return to "parent" buffer of this operation.
- ;; Remove comment window.
- ;;
- (let ((old-window-config clearcase-comment-window-config))
- (pop-to-buffer clearcase-parent-buffer)
- (delete-windows-on comment-buffer)
- (kill-buffer comment-buffer)
- (if old-window-config (set-window-configuration old-window-config)))))
-
-(defun clearcase-comment-save-comment-for-buffer (comment buffer)
- (save-excursion
- (set-buffer buffer)
- (let ((file (buffer-file-name)))
- (if (clearcase-fprop-checked-out file)
- (progn
- (clearcase-ct-do-cleartool-command "chevent"
- file
- comment
- (list "-replace"))
- (clearcase-fprop-set-comment file comment))
- (error "Can't change comment of checked-in version with this interface")))))
-
-(defun clearcase-comment-save ()
- "Save the currently entered comment"
- (interactive)
- (let ((comment-string (buffer-string))
- (parent-buffer clearcase-parent-buffer))
- (if (not (buffer-modified-p))
- (message "(No changes need to be saved)")
- (progn
- (save-excursion
- (set-buffer parent-buffer)
- (clearcase-comment-save-comment-for-buffer comment-string parent-buffer))
-
- (set-buffer-modified-p nil)))))
-
-(defun clearcase-comment-num-num-error ()
- (interactive)
- (message "Perhaps you wanted to type C-c C-c instead?"))
-
-;; Code for the comment ring.
-;;
-(defun clearcase-comment-next (arg)
- "Cycle forwards through comment history."
- (interactive "*p")
- (clearcase-comment-previous (- arg)))
-
-(defun clearcase-comment-previous (arg)
- "Cycle backwards through comment history."
- (interactive "*p")
- (let ((len (ring-length clearcase-comment-ring)))
- (cond ((or (not len) (<= len 0))
- (message "Empty comment ring")
- (ding))
- (t
- (erase-buffer)
-
- ;; Initialize the index on the first use of this command so that the
- ;; first M-p gets index 0, and the first M-n gets index -1.
- ;;
- (if (null clearcase-comment-ring-index)
- (setq clearcase-comment-ring-index
- (if (> arg 0) -1
- (if (< arg 0) 1 0))))
- (setq clearcase-comment-ring-index
- (mod (+ clearcase-comment-ring-index arg) len))
- (message "%d" (1+ clearcase-comment-ring-index))
- (insert (ring-ref clearcase-comment-ring clearcase-comment-ring-index))))))
-
-(defun clearcase-comment-search-forward (str)
- "Searches forwards through comment history for substring match."
- (interactive "sComment substring: ")
- (if (string= str "")
- (setq str clearcase-comment-last-match)
- (setq clearcase-comment-last-match str))
- (if (null clearcase-comment-ring-index)
- (setq clearcase-comment-ring-index 0))
- (let ((str (regexp-quote str))
- (n clearcase-comment-ring-index))
- (while (and (>= n 0) (not (string-match str (ring-ref clearcase-comment-ring n))))
- (setq n (- n 1)))
- (cond ((>= n 0)
- (clearcase-comment-next (- n clearcase-comment-ring-index)))
- (t (error "Not found")))))
-
-(defun clearcase-comment-search-reverse (str)
- "Searches backwards through comment history for substring match."
- (interactive "sComment substring: ")
- (if (string= str "")
- (setq str clearcase-comment-last-match)
- (setq clearcase-comment-last-match str))
- (if (null clearcase-comment-ring-index)
- (setq clearcase-comment-ring-index -1))
- (let ((str (regexp-quote str))
- (len (ring-length clearcase-comment-ring))
- (n (1+ clearcase-comment-ring-index)))
- (while (and (< n len)
- (not (string-match str (ring-ref clearcase-comment-ring n))))
- (setq n (+ n 1)))
- (cond ((< n len)
- (clearcase-comment-previous (- n clearcase-comment-ring-index)))
- (t (error "Not found")))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Major Mode: for editing config-specs.
-
-;; The major mode function.
-;;
-(defun clearcase-edcs-mode ()
- (interactive)
- (set-syntax-table text-mode-syntax-table)
- (use-local-map clearcase-edcs-mode-map)
- (setq major-mode 'clearcase-edcs-mode)
- (setq mode-name "ClearCase/edcs")
- (make-variable-buffer-local 'clearcase-parent-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (run-hooks 'text-mode-hook 'clearcase-edcs-mode-hook))
-
-;; The keymap.
-;;
-(defvar clearcase-edcs-mode-map nil)
-(if clearcase-edcs-mode-map
- nil
- (setq clearcase-edcs-mode-map (make-sparse-keymap))
- (define-key clearcase-edcs-mode-map "\C-c\C-c" 'clearcase-edcs-finish)
- (define-key clearcase-edcs-mode-map "\C-x\C-s" 'clearcase-edcs-save))
-
-;; Variables.
-;;
-(defvar clearcase-edcs-tag-name nil
- "Name of view tag which is currently being edited")
-
-(defvar clearcase-edcs-tag-history ()
- "History of view tags used in clearcase-edcs-edit")
-
-;;{{{ Commands
-
-(defun clearcase-edcs-edit (tag-name)
- "Edit a ClearCase configuration specification"
-
- (interactive
- (let ((vxname (clearcase-fprop-viewtag default-directory)))
- (if clearcase-complete-viewtags
- (list (directory-file-name
- (completing-read "View Tag: "
- (clearcase-viewtag-all-viewtags-obarray)
- nil
- ;;'fascist
- nil
- vxname
- 'clearcase-edcs-tag-history)))
- (read-string "View Tag: "))))
-
- (let ((start (current-buffer))
- (buffer-name (format "*clearcase-config-spec-%s*" tag-name)))
- (kill-buffer (get-buffer-create buffer-name))
- (pop-to-buffer (get-buffer-create buffer-name))
- (auto-save-mode auto-save-default)
- (erase-buffer)
- (insert (clearcase-ct-cleartool-cmd "catcs" "-tag" tag-name))
- (goto-char (point-min))
- (re-search-forward "^[^#\n]" nil 'end)
- (beginning-of-line)
- (clearcase-edcs-mode)
- (setq clearcase-parent-buffer start)
- (make-local-variable 'clearcase-edcs-tag-name)
- (setq clearcase-edcs-tag-name tag-name)))
-
-(defun clearcase-edcs-save ()
- (interactive)
- (if (not (buffer-modified-p))
- (message "Configuration not changed since last saved")
-
- (message "Setting configuration for %s..." clearcase-edcs-tag-name)
- (clearcase-with-tempfile
- cspec-text
- (write-region (point-min) (point-max) cspec-text nil 'dont-mention-it)
- (let ((ret (clearcase-ct-cleartool-cmd "setcs"
- "-tag"
- clearcase-edcs-tag-name
- (clearcase-path-native cspec-text))))
-
- ;; nyi: we could be smarter and retain viewtag info and perhaps some
- ;; other info. For now invalidate all cached file property info.
- ;;
- (clearcase-fprop-clear-all-properties)
-
- (set-buffer-modified-p nil)
- (message "Setting configuration for %s...done"
- clearcase-edcs-tag-name)))))
-
-(defun clearcase-edcs-finish ()
- (interactive)
- (let ((old-buffer (current-buffer)))
- (clearcase-edcs-save)
- (bury-buffer nil)
- (kill-buffer old-buffer)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ View browser
-
-;; nyi: Just an idea now.
-;; Be able to present a selection of views at various times
-;; - show me current file in other view
-;; - top-level browse operation
-
-;; clearcase-viewtag-started-viewtags gives us the dynamic views that are mounted.
-
-;; How to find local snapshots ?
-
-;; How to find drive-letter mount points for view on NT ?
-;; - parse "subst" output
-
-;;}}}
-
-;;{{{ Commands
-
-;;{{{ Hijack/unhijack
-
-(defun clearcase-hijack-current-buffer ()
- "Hijack the file in the current buffer."
- (interactive)
- (clearcase-hijack buffer-file-name))
-
-(defun clearcase-hijack-dired-files ()
- "Hijack the selected files."
- (interactive)
- (clearcase-hijack-seq (dired-get-marked-files)))
-
-(defun clearcase-unhijack-current-buffer ()
- "Unhijack the file in the current buffer."
- (interactive)
- (clearcase-unhijack buffer-file-name))
-
-(defun clearcase-unhijack-dired-files ()
- "Hijack the selected files."
- (interactive)
- (clearcase-unhijack-seq (dired-get-marked-files)))
-
-;;}}}
-
-;;{{{ Annotate
-
-(defun clearcase-annotate-file (file)
- (let ((relative-name (file-relative-name file)))
- (message "Annotating %s ..." relative-name)
- (clearcase-with-tempfile
- annotation-file
- (clearcase-ct-do-cleartool-command "annotate"
- file
- 'unused
- (list "-nco"
- "-fmt"
- clearcase-annotate-fmt-string
- "-out"
- annotation-file))
- (clearcase-utl-populate-and-view-buffer
- "*clearcase-annotate*"
- nil
- (function
- (lambda ()
- (insert-file-contents annotation-file)))))
- (message "Annotating %s ...done" relative-name)))
-
-(defun clearcase-annotate-current-buffer ()
- (interactive)
- (clearcase-annotate-file buffer-file-name))
-
-(defun clearcase-annotate-dired-file ()
- "Annotate the selected file."
- (interactive)
- (clearcase-annotate-file (dired-get-filename)))
-
-;;}}}
-
-;;{{{ nyi: Find checkouts
-
-;; NYI: Enhance this:
-;; - group by:
-;; - activity name
-;; - checkout comment
-;; - permit unco/checkin
-;;
-(defun clearcase-find-checkouts-in-current-view ()
- "Find the checkouts in all vobs in the current view."
- (interactive)
- (let ((viewtag (clearcase-fprop-viewtag default-directory))
- (dir default-directory))
- (if viewtag
- (let* ((ignore (message "Finding checkouts..."))
- (text (clearcase-ct-blocking-call "lsco"
- "-cview"
- "-avobs"
- "-short")))
- (if (zerop (length text))
- (message "No checkouts found")
- (progn
- (message "Finding checkouts...done")
-
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- (list text)
- (function (lambda (s)
- (insert s))))))))))
-
-;;}}}
-
-;;{{{ UCM operations
-
-;;{{{ Make activity
-
-(defun clearcase-read-new-activity-name ()
- "Read the name of a new activity from the minibuffer.
-Return nil if the empty string is entered."
-
- ;; nyi: Probably should check that the activity doesn't already exist.
- ;;
- (let ((entered-name (read-string "Activity name (optional): " )))
- (if (not (zerop (length entered-name)))
- entered-name
- nil)))
-
-(defun clearcase-read-mkact-args ()
- "Read the name and headline arguments for clearcase-ucm-mkact-current-dir
-from the minibuffer."
-
- (let ((name nil)
- (headline ""))
- (if clearcase-prompt-for-activity-names
- (setq name (clearcase-read-new-activity-name)))
- (setq headline (read-string "Activity headline: " ))
- (list name headline)))
-
-(defun clearcase-make-internally-named-activity (stream-name comment-file)
- "Make a new activity in STREAM-NAME with creation comment in COMMENT-FILE,
-and use an internally-generated name for the activity."
-
- (let ((ret
- (if clearcase-set-to-new-activity
- (clearcase-ct-blocking-call "mkact"
- "-cfile" (clearcase-path-native comment-file)
- "-in" stream-name
- "-force")
- (clearcase-ct-blocking-call "mkact"
- "-nset"
- "-cfile" (clearcase-path-native comment-file)
- "-in" stream-name
- "-nset"
- "-force"))))
- (if (string-match "Created activity \"\\([^\"]+\\)\"" ret)
- (substring ret (match-beginning 1) (match-end 1))
- (error "Failed to create activity: %s" ret))))
-
-(defun clearcase-ucm-mkact-current-dir (name headline &optional comment)
-
- "Make an activity with NAME and HEADLINE and optional COMMENT, in the stream
-associated with the view associated with the current directory."
-
- (interactive (clearcase-read-mkact-args))
- (let* ((viewtag (clearcase-fprop-viewtag default-directory))
- (stream (clearcase-vprop-stream viewtag))
- (pvob (clearcase-vprop-pvob viewtag)))
- (if (not (clearcase-vprop-ucm viewtag))
- (error "View %s is not a UCM view" viewtag))
- (if (null stream)
- (error "View %s has no stream" viewtag))
- (if (null stream)
- (error "View %s has no PVOB" viewtag))
-
- (if (null comment)
- ;; If no comment supplied, go and get one..
- ;;
- (progn
- (clearcase-comment-start-entry (format "new-activity-%d" (random))
- "Enter comment for new activity."
- 'clearcase-ucm-mkact-current-dir
- (list name headline)))
- ;; ...else do the operation.
- ;;
- (message "Making activity...")
- (clearcase-with-tempfile
- comment-file
- (write-region comment nil comment-file nil 'noprint)
- (let ((qualified-stream (format "%s@%s" stream pvob)))
- (if (stringp name)
- (if clearcase-set-to-new-activity
- (clearcase-ct-blocking-call "mkact"
- "-cfile" (clearcase-path-native comment-file)
- "-headline" headline
- "-in" qualified-stream
- "-force"
- name)
- (clearcase-ct-blocking-call "mkact"
- "-nset"
- "-cfile" (clearcase-path-native comment-file)
- "-headline" headline
- "-in" qualified-stream
- "-force"
- name))
- (progn
- ;; If no name was provided we do the creation in two steps:
- ;; mkact -force
- ;; chact -headline
- ;; to make sure we get preferred internally generated activity
- ;; name of the form "activityNNN.MMM" rather than some horrible
- ;; concoction based on the headline.
- ;;
- (let ((name (clearcase-make-internally-named-activity qualified-stream comment-file)))
- (clearcase-ct-blocking-call "chact"
- "-headline" headline
- name))))))
-
- ;; Flush the activities for this view so they'll get refreshed when needed.
- ;;
- (clearcase-vprop-flush-activities viewtag)
-
- (message "Making activity...done"))))
-
-;;}}}
-
-;;{{{ Set activity
-
-(defun clearcase-ucm-filter-out-rebases (activities)
- (if (not clearcase-hide-rebase-activities)
- activities
- (clearcase-utl-list-filter
- (function
- (lambda (activity)
- (let ((id (car activity)))
- (not (string-match clearcase-rebase-id-regexp id)))))
- activities)))
-
-(defun clearcase-ucm-set-activity-current-dir ()
- (interactive)
- (let* ((viewtag (clearcase-fprop-viewtag default-directory)))
- (if (not (clearcase-vprop-ucm viewtag))
- (error "View %s is not a UCM view" viewtag))
- ;; Filter out the rebases here if the user doesn't want to see them.
- ;;
- (let ((activities (clearcase-ucm-filter-out-rebases (clearcase-vprop-activities viewtag))))
- (if (null activities)
- (error "View %s has no activities" viewtag))
- (clearcase-ucm-make-selection-window (format "*clearcase-activity-select-%s*" viewtag)
- (mapconcat
- (function
- (lambda (activity)
- (let ((id (car activity))
- (title (cdr activity)))
- (format "%s\t%s" id title))))
- activities
- "\n")
- 'clearcase-ucm-activity-selection-interpreter
- 'clearcase-ucm-set-activity
- (list viewtag)))))
-
-(defun clearcase-ucm-activity-selection-interpreter ()
- "Extract the activity name from the buffer at point"
- (if (looking-at "^\\(.*\\)\t")
- (let ((activity-name (buffer-substring (match-beginning 1)
- (match-end 1))))
- activity-name)
- (error "No activity on this line")))
-
-(defun clearcase-ucm-set-activity-none-current-dir ()
- (interactive)
- (let* ((viewtag (clearcase-fprop-viewtag default-directory)))
- (if (not (clearcase-vprop-ucm viewtag))
- (error "View %s is not a UCM view" viewtag))
- (clearcase-ucm-set-activity viewtag nil)))
-
-(defun clearcase-ucm-set-activity (viewtag activity-name)
- (if activity-name
- ;; Set an activity
- ;;
- (progn
- (message "Setting activity...")
- (let ((qualified-activity-name (if (string-match "@" activity-name)
- activity-name
- (concat activity-name "@" (clearcase-vprop-pvob viewtag)))))
- (clearcase-ct-blocking-call "setactivity" "-nc" "-view"
- viewtag
- (if qualified-activity-name
- qualified-activity-name
- "-none")))
- ;; Update cache
- ;;
- (clearcase-vprop-set-current-activity viewtag activity-name)
- (message "Setting activity...done"))
-
- ;; Set NO activity
- ;;
- (message "Unsetting activity...")
- (clearcase-ct-blocking-call "setactivity"
- "-nc"
- "-view" viewtag
- "-none")
- ;; Update cache
- ;;
- (clearcase-vprop-set-current-activity viewtag nil)
- (message "Unsetting activity...done")))
-
-;;}}}
-
-;;{{{ Show current activity
-
-(defun clearcase-ucm-describe-current-activity ()
- (interactive)
- (let* ((viewtag (clearcase-fprop-viewtag default-directory)))
- (if (not viewtag)
- (error "Not in a view"))
- (if (not (clearcase-vprop-ucm viewtag))
- (error "View %s is not a UCM view" viewtag))
- (let ((pvob (clearcase-vprop-pvob viewtag))
- (current-activity (clearcase-vprop-current-activity viewtag)))
- (if (not current-activity)
- (message "No activity set")
- (let ((text (clearcase-ct-blocking-call "desc"
- (concat "activity:"
- current-activity
- "@"
- pvob))))
- (if (not (zerop (length text)))
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- (list text)
- (function (lambda (s)
- (insert s))))))))))
-;;}}}
-
-;;}}}
-
-;;{{{ Next-action
-
-(defun clearcase-next-action-current-buffer ()
- "Do the next logical operation on the current file.
-Operations include mkelem, checkout, checkin, uncheckout"
- (interactive)
- (clearcase-next-action buffer-file-name))
-
-(defun clearcase-next-action-dired-files ()
- "Do the next logical operation on the marked files.
-Operations include mkelem, checkout, checkin, uncheckout.
-If all the files are not in an equivalent state, an error is raised."
-
- (interactive)
- (clearcase-next-action-seq (dired-get-marked-files)))
-
-(defun clearcase-next-action (file)
- (let ((action (clearcase-compute-next-action file)))
- (cond
-
- ((eq action 'mkelem)
- (clearcase-commented-mkelem file))
-
- ((eq action 'checkout)
- (clearcase-commented-checkout file))
-
- ((eq action 'uncheckout)
- (if (yes-or-no-p "Checked-out file appears unchanged. Cancel checkout ? ")
- (clearcase-uncheckout file)))
-
- ((eq action 'illegal-checkin)
- (error "This file is checked out by someone else: %s" (clearcase-fprop-user file)))
-
- ((eq action 'checkin)
- (clearcase-commented-checkin file))
-
- (t
- (error "Can't compute suitable next ClearCase action for file %s" file)))))
-
-(defun clearcase-next-action-seq (files)
- "Do the next logical operation on the sequence of FILES."
-
- ;; Check they're all in the same state.
- ;;
- (let ((actions (mapcar (function clearcase-compute-next-action) files)))
- (if (not (clearcase-utl-elts-are-eq actions))
- (error "Marked files are not all in the same state"))
- (let ((action (car actions)))
- (cond
-
- ((eq action 'mkelem)
- (clearcase-commented-mkelem-seq files))
-
- ((eq action 'checkout)
- (clearcase-commented-checkout-seq files))
-
- ((eq action 'uncheckout)
- (if (yes-or-no-p "Checked-out files appears unchanged. Cancel checkouts ? ")
- (clearcase-uncheckout-seq files)))
-
- ((eq action 'illegal-checkin)
- (error "These files are checked out by someone else; will no checkin"))
-
- ((eq action 'checkin)
- (clearcase-commented-checkin-seq files))
-
- (t
- (error "Can't compute suitable next ClearCase action for marked files"))))))
-
-(defun clearcase-compute-next-action (file)
- "Compute the next logical action on FILE."
-
- (cond
- ;; nyi: other cases to consider later:
- ;;
- ;; - file is unreserved
- ;; - file is not mastered
-
- ;; Case 1: it is not yet an element
- ;; ==> mkelem
- ;;
- ((clearcase-file-ok-to-mkelem file)
- 'mkelem)
-
- ;; Case 2: file is not checked out
- ;; ==> checkout
- ;;
- ((clearcase-file-ok-to-checkout file)
- 'checkout)
-
- ;; Case 3: file is checked-out but not modified in buffer or disk
- ;; ==> offer to uncheckout
- ;;
- ((and (clearcase-file-ok-to-uncheckout file)
- (not (file-directory-p file))
- (not (buffer-modified-p))
- (not (clearcase-file-appears-modified-since-checkout-p file)))
- 'uncheckout)
-
- ;; Case 4: file is checked-out but by somebody else using this view.
- ;; ==> refuse to checkin
- ;;
- ;; This is not reliable on some Windows installations where a user is known
- ;; as "esler" on Unix and the ClearCase server, and "ESLER" on the Windows
- ;; client.
- ;;
- ((and (not clearcase-on-mswindows)
- (clearcase-fprop-checked-out file)
- (not (string= (user-login-name)
- (clearcase-fprop-user file))))
- 'illegal-checkin)
-
- ;; Case 5: user has checked-out the file
- ;; ==> check it in
- ;;
- ((clearcase-file-ok-to-checkin file)
- 'checkin)
-
- (t
- nil)))
-
-;;}}}
-
-;;{{{ Mkelem
-
-(defun clearcase-mkelem-current-buffer ()
- "Make the current file into a ClearCase element."
- (interactive)
-
- ;; Watch out for new buffers of size 0: the corresponding file
- ;; does not exist yet, even though buffer-modified-p is nil.
- ;;
- (if (and (not (buffer-modified-p))
- (zerop (buffer-size))
- (not (file-exists-p buffer-file-name)))
- (set-buffer-modified-p t))
-
- (clearcase-commented-mkelem buffer-file-name))
-
-(defun clearcase-mkelem-dired-files ()
- "Make the selected files into ClearCase elements."
- (interactive)
- (clearcase-commented-mkelem-seq (dired-get-marked-files)))
-
-;;}}}
-
-;;{{{ Checkin
-
-(defun clearcase-checkin-current-buffer ()
- "Checkin the file in the current buffer."
- (interactive)
-
- ;; Watch out for new buffers of size 0: the corresponding file
- ;; does not exist yet, even though buffer-modified-p is nil.
- ;;
- (if (and (not (buffer-modified-p))
- (zerop (buffer-size))
- (not (file-exists-p buffer-file-name)))
- (set-buffer-modified-p t))
-
- (clearcase-commented-checkin buffer-file-name))
-
-(defun clearcase-checkin-dired-files ()
- "Checkin the selected files."
- (interactive)
- (clearcase-commented-checkin-seq (dired-get-marked-files)))
-
-(defun clearcase-dired-checkin-current-dir ()
- (interactive)
- (clearcase-commented-checkin (dired-current-directory)))
-
-;;}}}
-
-;;{{{ Edit checkout comment
-
-(defun clearcase-edit-checkout-comment-current-buffer ()
- "Edit the clearcase comment for the checked-out file in the current buffer."
- (interactive)
- (clearcase-edit-checkout-comment buffer-file-name))
-
-(defun clearcase-edit-checkout-comment-dired-file ()
- "Checkin the selected file."
- (interactive)
- (clearcase-edit-checkout-comment (dired-get-filename)))
-
-(defun clearcase-edit-checkout-comment (file &optional comment)
- "Edit comment for FILE by popping up a buffer to accept one. If COMMENT
-is specified, save it."
- (if (null comment)
- ;; If no comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry (file-name-nondirectory file)
- "Edit the file's check-out comment."
- 'clearcase-edit-checkout-comment
- (list buffer-file-name)
- (find-file-noselect file)
- (clearcase-fprop-comment file))
- ;; We have a comment, save it
- (clearcase-comment-save-comment-for-buffer comment clearcase-parent-buffer)))
-
-;;}}}
-
-;;{{{ Checkout
-
-(defun clearcase-checkout-current-buffer ()
- "Checkout the file in the current buffer."
- (interactive)
- (clearcase-commented-checkout buffer-file-name))
-
-(defun clearcase-checkout-dired-files ()
- "Checkout the selected files."
- (interactive)
- (clearcase-commented-checkout-seq (dired-get-marked-files)))
-
-(defun clearcase-dired-checkout-current-dir ()
- (interactive)
- (clearcase-commented-checkout (dired-current-directory)))
-
-;;}}}
-
-;;{{{ Uncheckout
-
-(defun clearcase-uncheckout-current-buffer ()
- "Uncheckout the file in the current buffer."
- (interactive)
- (clearcase-uncheckout buffer-file-name))
-
-(defun clearcase-uncheckout-dired-files ()
- "Uncheckout the selected files."
- (interactive)
- (clearcase-uncheckout-seq (dired-get-marked-files)))
-
-(defun clearcase-dired-uncheckout-current-dir ()
- (interactive)
- (clearcase-uncheckout (dired-current-directory)))
-
-;;}}}
-
-;;{{{ Mkbrtype
-
-(defun clearcase-mkbrtype (typename)
- (interactive "sBranch type name: ")
- (clearcase-commented-mkbrtype typename))
-
-;;}}}
-
-;;{{{ Describe
-
-(defun clearcase-describe-current-buffer ()
- "Give a ClearCase description of the file in the current buffer."
- (interactive)
- (clearcase-describe buffer-file-name))
-
-(defun clearcase-describe-dired-file ()
- "Describe the selected files."
- (interactive)
- (clearcase-describe (dired-get-filename)))
-
-;;}}}
-
-;;{{{ What-rule
-
-(defun clearcase-what-rule-current-buffer ()
- (interactive)
- (clearcase-what-rule buffer-file-name))
-
-(defun clearcase-what-rule-dired-file ()
- (interactive)
- (clearcase-what-rule (dired-get-filename)))
-
-;;}}}
-
-;;{{{ List history
-
-(defun clearcase-list-history-current-buffer ()
- "List the change history of the current buffer in a window."
- (interactive)
- (clearcase-list-history buffer-file-name))
-
-(defun clearcase-list-history-dired-file ()
- "List the change history of the current file."
- (interactive)
- (clearcase-list-history (dired-get-filename)))
-
-;;}}}
-
-;;{{{ Ediff
-
-(defun clearcase-ediff-pred-current-buffer ()
- "Use Ediff to compare a version in the current buffer against its predecessor."
- (interactive)
- (clearcase-ediff-file-with-version buffer-file-name
- (clearcase-fprop-predecessor-version buffer-file-name)))
-
-(defun clearcase-ediff-pred-dired-file ()
- "Use Ediff to compare the selected version against its predecessor."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-ediff-file-with-version truename
- (clearcase-fprop-predecessor-version truename))))
-
-(defun clearcase-ediff-branch-base-current-buffer()
- "Use Ediff to compare a version in the current buffer
-against the base of its branch."
- (interactive)
- (clearcase-ediff-file-with-version buffer-file-name
- (clearcase-vxpath-version-of-branch-base buffer-file-name)))
-
-(defun clearcase-ediff-branch-base-dired-file()
- "Use Ediff to compare the selected version against the base of its branch."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-ediff-file-with-version truename
- (clearcase-vxpath-version-of-branch-base truename))))
-
-(defun clearcase-ediff-named-version-current-buffer (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- buffer-file-name)))
- (clearcase-ediff-file-with-version buffer-file-name version))
-
-(defun clearcase-ediff-named-version-dired-file (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- (dired-get-filename))))
- (clearcase-ediff-file-with-version (clearcase-fprop-truename (dired-get-filename))
- version))
-
-(defun clearcase-ediff-file-with-version (truename other-version)
- (let ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename)
- other-version)))
- (if (clearcase-file-is-in-mvfs-p truename)
- (ediff-files other-vxpath truename)
- (ediff-buffers (clearcase-vxpath-get-version-in-buffer other-vxpath)
- (find-file-noselect truename t)))))
-
-;;}}}
-
-;;{{{ GUI diff
-
-(defun clearcase-gui-diff-pred-current-buffer ()
- "Use GUI to compare a version in the current buffer against its predecessor."
- (interactive)
- (clearcase-gui-diff-file-with-version buffer-file-name
- (clearcase-fprop-predecessor-version buffer-file-name)))
-
-(defun clearcase-gui-diff-pred-dired-file ()
- "Use GUI to compare the selected version against its predecessor."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-gui-diff-file-with-version truename
- (clearcase-fprop-predecessor-version truename))))
-
-(defun clearcase-gui-diff-branch-base-current-buffer()
- "Use GUI to compare a version in the current buffer
-against the base of its branch."
- (interactive)
- (clearcase-gui-diff-file-with-version buffer-file-name
- (clearcase-vxpath-version-of-branch-base buffer-file-name)))
-
-(defun clearcase-gui-diff-branch-base-dired-file()
- "Use GUI to compare the selected version against the base of its branch."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-gui-diff-file-with-version truename
- (clearcase-vxpath-version-of-branch-base truename))))
-
-(defun clearcase-gui-diff-named-version-current-buffer (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- buffer-file-name)))
- (clearcase-gui-diff-file-with-version buffer-file-name version))
-
-(defun clearcase-gui-diff-named-version-dired-file (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- (dired-get-filename))))
- (clearcase-gui-diff-file-with-version (clearcase-fprop-truename (dired-get-filename))
- version))
-
-(defun clearcase-gui-diff-file-with-version (truename other-version)
- (let* ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename)
- other-version))
- (other-file (if (clearcase-file-is-in-mvfs-p truename)
- other-vxpath
- (clearcase-vxpath-get-version-in-temp-file other-vxpath)))
- (gui-name (if clearcase-on-mswindows
- "cleardiffmrg"
- "xcleardiff")))
- (start-process "Diff"
- nil
- gui-name
- (clearcase-path-native other-file)
- (clearcase-path-native truename))))
-
-;;}}}
-
-;;{{{ Diff
-
-(defun clearcase-diff-pred-current-buffer ()
- "Use Diff to compare a version in the current buffer against its predecessor."
- (interactive)
- (clearcase-diff-file-with-version buffer-file-name
- (clearcase-fprop-predecessor-version buffer-file-name)))
-
-(defun clearcase-diff-pred-dired-file ()
- "Use Diff to compare the selected version against its predecessor."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-diff-file-with-version truename
- (clearcase-fprop-predecessor-version truename))))
-
-(defun clearcase-diff-branch-base-current-buffer()
- "Use Diff to compare a version in the current buffer
-against the base of its branch."
- (interactive)
- (clearcase-diff-file-with-version buffer-file-name
- (clearcase-vxpath-version-of-branch-base buffer-file-name)))
-
-(defun clearcase-diff-branch-base-dired-file()
- "Use Diff to compare the selected version against the base of its branch."
- (interactive)
- (let ((truename (clearcase-fprop-truename (dired-get-filename))))
- (clearcase-diff-file-with-version truename
- (clearcase-vxpath-version-of-branch-base truename))))
-
-(defun clearcase-diff-named-version-current-buffer (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- buffer-file-name)))
- (clearcase-diff-file-with-version buffer-file-name version))
-
-(defun clearcase-diff-named-version-dired-file (version)
- ;; nyi: if we're in history-mode, probably should just use
- ;; (read-file-name)
- ;;
- (interactive (list (clearcase-read-version-name "Version for comparison: "
- (dired-get-filename))))
- (clearcase-diff-file-with-version (clearcase-fprop-truename (dired-get-filename))
- version))
-
-(defun clearcase-diff-file-with-version (truename other-version)
- (let ((other-vxpath (clearcase-vxpath-cons-vxpath (clearcase-vxpath-element-part truename)
- other-version)))
- (if (clearcase-file-is-in-mvfs-p truename)
- (clearcase-diff-files other-vxpath truename)
- (clearcase-diff-files (clearcase-vxpath-get-version-in-temp-file other-vxpath)
- truename))))
-
-;;}}}
-
-;;{{{ Browse vtree
-
-(defun clearcase-version-other-window (version)
- (interactive
- (list
- (clearcase-read-version-name (format "Version of %s to visit: "
- (file-name-nondirectory buffer-file-name))
- buffer-file-name)))
- (find-file-other-window (clearcase-vxpath-cons-vxpath
- (clearcase-vxpath-element-part buffer-file-name)
- version)))
-
-(defun clearcase-browse-vtree-current-buffer (&optional graphical)
- "Browse vtree of ClearCase element in current buffer. Uses Dired Mode unless a
-prefix argument is givem in which case the GUI vtree tool is invoked."
- (interactive "P")
- (clearcase-browse-vtree buffer-file-name graphical))
-
-(defun clearcase-browse-vtree-dired-file (&optional graphical)
- "Browse vtree of ClearCase element selected in current dired buffer. Uses Dired Mode unless a
-prefix argument is givem in which case the GUI vtree tool is invoked."
- (interactive "P")
- (clearcase-browse-vtree (dired-get-filename) graphical))
-
-;;}}}
-
-;;{{{ GUI vtree
-
-(defun clearcase-gui-vtree-browser-current-buffer ()
- (interactive)
- (clearcase-gui-vtree-browser buffer-file-name))
-
-(defun clearcase-gui-vtree-browser-dired-file ()
- (interactive)
- (clearcase-gui-vtree-browser (dired-get-filename)))
-
-(defun clearcase-gui-vtree-browser (file)
- (let ((gui-name (if clearcase-on-mswindows
- "clearvtree"
- "xlsvtree")))
- (start-process "Vtree_browser"
- nil
- gui-name
- (clearcase-path-native file))))
-
-;;}}}
-
-;;{{{ Other GUIs
-
-(defun clearcase-gui-clearexplorer ()
- (interactive)
- (start-process "ClearExplorer"
- nil
- "clearexplorer"
- "."))
-
-(defun clearcase-gui-rebase ()
- (interactive)
- (start-process "Rebase"
- nil
- "clearmrgman"
- (if clearcase-on-mswindows
- "/rebase"
- "-rebase")))
-
-(defun clearcase-gui-deliver ()
- (interactive)
- (start-process "Deliver"
- nil
- "clearmrgman"
- (if clearcase-on-mswindows
- "/deliver"
- "-deliver")))
-
-(defun clearcase-gui-merge-manager ()
- (interactive)
- (start-process "Merge_manager"
- nil
- "clearmrgman"))
-
-(defun clearcase-gui-project-explorer ()
- (interactive)
- (start-process "Project_explorer"
- nil
- "clearprojexp"))
-
-(defun clearcase-gui-snapshot-view-updater ()
- (interactive)
- (start-process "View_updater"
- nil
- "clearviewupdate"))
-
-;;}}}
-
-;;{{{ Update snapshot
-
-;; In a file buffer:
-;; - update current-file
-;; - update directory
-;; In dired:
-;; - update dir
-;; - update marked files
-;; - update file
-
-;; We allow several simultaneous updates, but only one per view.
-
-(defun clearcase-update-view ()
- (interactive)
- (clearcase-update (clearcase-fprop-viewtag default-directory)))
-
-(defun clearcase-update-default-directory ()
- (interactive)
- (clearcase-update (clearcase-fprop-viewtag default-directory)
- default-directory))
-
-(defun clearcase-update-current-buffer ()
- (interactive)
- (clearcase-update (clearcase-fprop-viewtag default-directory)
- buffer-file-name))
-
-(defun clearcase-update-dired-files ()
- (interactive)
- (apply (function clearcase-update)
- (cons (clearcase-fprop-viewtag default-directory)
- (dired-get-marked-files))))
-
-
-;;}}}
-
-;;{{{ Sync all buffers
-(defun clearcase-sync-all-buffers ()
- "Synchronize clearcase information for all clearcase buffers if needed."
- (interactive)
- (mapcar (lambda (buf)
- (let* ((file (buffer-file-name buf))
- (version (when file (clearcase-fprop-version file))))
- (when (and file version (not (equal version "")))
- (clearcase-sync-from-disk-if-needed file))))
- (buffer-list)))
-
-(defun clearcase-sync-file-if-needed ()
- "Function to be run from a hook to synchronize with clearcase.
-
-Intended to be used with the auto-revert hook 'auto-revert-buffer-reverted-hook"
- (let ((filename (buffer-file-name)))
- (when filename
- (clearcase-sync-from-disk-if-needed filename))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Functions
-
-;;{{{ Basic ClearCase operations
-
-;;{{{ Update snapshot view
-
-;;{{{ Asynchronous post-processing of update
-
-(defvar clearcase-post-update-timer nil)
-(defvar clearcase-post-update-work-queue nil)
-
-(defun clearcase-post-update-schedule-work (buffer)
- (clearcase-trace "entering clearcase-post-update-schedule-work")
- ;; Add to the work queue.
- ;;
- (setq clearcase-post-update-work-queue (cons buffer
- clearcase-post-update-work-queue))
- ;; Create the timer if necessary.
- ;;
- (if (null clearcase-post-update-timer)
- (if clearcase-xemacs-p
- ;; Xemacs
- ;;
- (setq clearcase-post-update-timer
- (run-with-idle-timer 2 t 'clearcase-post-update-timer-function))
- ;; FSF Emacs
- ;;
- (progn
- (setq clearcase-post-update-timer (timer-create))
- (timer-set-function clearcase-post-update-timer 'clearcase-post-update-timer-function)
- (timer-set-idle-time clearcase-post-update-timer 2)
- (timer-activate-when-idle clearcase-post-update-timer)))
- (clearcase-trace "clearcase-post-update-schedule-work: post-update timer found to be non-null")))
-
-
-(defun clearcase-post-update-timer-function ()
- (clearcase-trace "Entering clearcase-post-update-timer-function")
- ;; For (each update-process buffer in the work queue)
- ;; if (its process has successfully terminated)
- ;; do the post-processing for this update
- ;; remove it from the work queue
- ;;
- (clearcase-trace (format "Queue before: %s" clearcase-post-update-work-queue))
- (setq clearcase-post-update-work-queue
-
- (clearcase-utl-list-filter
- (function clearcase-post-update-check-process-buffer)
- clearcase-post-update-work-queue))
-
- (clearcase-trace (format "Queue after: %s" clearcase-post-update-work-queue))
- ;; If the work queue is now empty cancel the timer.
- ;;
- (if (null clearcase-post-update-work-queue)
- (progn
- (if clearcase-xemacs-p
- (delete-itimer clearcase-post-update-timer)
- (cancel-timer clearcase-post-update-timer))
- (setq clearcase-post-update-timer nil))))
-
-(defun clearcase-post-update-check-process-buffer (buffer)
- (clearcase-trace "Entering clearcase-post-update-check-process-buffer")
-
- ;; return t for those buffers that should remain in the work queue
-
- ;; if it has terminated successfully
- ;; go sync buffers on the files that were updated
-
- ;; We want to field errors here and when they occurm return nil to avoid a
- ;; loop
- ;;
- ;;(condition-case nil
-
- ;; protected form
- (let ((proc (get-buffer-process buffer)))
- (if proc
- ;; Process still exists so keep this on the work queue.
- ;;
- (progn
- (clearcase-trace "Update process still exists")
- t)
-
- ;; Process no longer there, cleaned up by comint code.
- ;;
-
- ;; Sync any buffers that need it.
- ;;
- (clearcase-trace "Update process finished")
- (clearcase-sync-after-scopes-updated (with-current-buffer buffer
- ;; Evaluate buffer-local variable.
- ;;
- clearcase-update-buffer-scopes))
-
- ;; Remove from work queue
- ;;
- nil))
-
- ;; Error occurred, make sure we return nil to remove the buffer from the
- ;; work queue, or a loop could develop.
- ;;
- ;;(error nil)
- )
-
-(defun clearcase-sync-after-scopes-updated (scopes)
- (clearcase-trace "Entering clearcase-sync-after-scopes-updated")
-
- ;; nyi: reduce scopes to minimal set of disjoint scopes
-
- ;; Use dynamic binding here since we don't have lexical binding.
- ;;
- (let ((clearcase-dynbound-updated-scopes scopes))
-
- ;; For all buffers...
- ;;
- (mapcar
- (function
- (lambda (buffer)
- (let ((visited-file (buffer-file-name buffer)))
- (if visited-file
- (if (clearcase-path-file-in-any-scopes visited-file
- clearcase-dynbound-updated-scopes)
- ;; This buffer visits a file within an updated scope.
- ;; Sync it from disk if it needs it.
- ;;
- (clearcase-sync-from-disk-if-needed visited-file))
-
- ;; Buffer is not visiting a file. If it is a dired-mode buffer
- ;; under one of the scopes, revert it.
- ;;
- (with-current-buffer buffer
- (if (eq 'dired-mode major-mode)
- (if (clearcase-path-file-in-any-scopes default-directory
- clearcase-dynbound-updated-scopes)
- (dired-revert nil t))))))))
- (buffer-list))))
-
-;;}}}
-
-;; Silence compiler complaints about free variable.
-;;
-(defvar clearcase-update-buffer-viewtag nil)
-
-(defun clearcase-update (viewtag &rest files)
- "Run a cleartool+update process in VIEWTAG
-if there isn't one already running in that view.
-Other arguments FILES indicate files to update"
-
- ;; Check that there is no update process running in that view.
- ;;
- (if (apply (function clearcase-utl-or-func)
- (mapcar (function (lambda (proc)
- (if (not (eq 'exit (process-status proc)))
- (let ((buf (process-buffer proc)))
- (and buf
- (assq 'clearcase-update-buffer-viewtag
- (buffer-local-variables buf))
- (save-excursion
- (set-buffer buf)
- (equal viewtag
- clearcase-update-buffer-viewtag)))))))
- (process-list)))
- (error "There is already an update running in view %s" viewtag))
-
- ;; All clear so:
- ;; - create a process in a buffer
- ;; - rename the buffer to be of the form *clearcase-update*<N>
- ;; - mark it as one of ours by setting clearcase-update-buffer-viewtag
- ;;
- (pop-to-buffer (apply (function make-comint)
- (append (list "*clearcase-update-temp-name*"
- clearcase-cleartool-path
- nil
- "update")
- files))
- t) ;; other window
- (rename-buffer "*clearcase-update*" t)
-
- ;; Store in this buffer what view was being updated and what files.
- ;;
- (set (make-local-variable 'clearcase-update-buffer-viewtag) viewtag)
- (set (make-local-variable 'clearcase-update-buffer-scopes) files)
-
- ;; nyi: schedule post-update buffer syncing
- (clearcase-post-update-schedule-work (current-buffer)))
-
-;;}}}
-
-;;{{{ Hijack
-
-(defun clearcase-file-ok-to-hijack (file)
-
- "Test if FILE is suitable for hijack."
-
- (and
-
- ;; If it is writeable already, no need to offer a hijack operation, even
- ;; though, according to ClearCase, it may not yet be hijacked.
- ;;
- ;;(not (file-writable-p file))
-
- (not (clearcase-fprop-hijacked file))
- (clearcase-file-is-in-view-p file)
- (not (clearcase-file-is-in-mvfs-p file))
- (eq 'version (clearcase-fprop-mtype file))
- (not (clearcase-fprop-checked-out file))))
-
-(defun clearcase-hijack-seq (files)
- (unwind-protect
- (progn
- (message "Hijacking...")
- (mapcar
- (function
- (lambda (file)
- (if (not (file-directory-p file))
- (clearcase-hijack file))))
- files))
- ;; Unwind
- ;;
- (message "Hijacking...done")))
-
-(defun clearcase-hijack (file)
-
- ;; cases
- ;; - buffer/files modtimes are equal
- ;; - file more recent
- ;; ==> revert
- ;; - buffer more recent
- ;; ==> make file writeable; save buffer ?
- ;;
- ;; Post-conditions:
- ;; - file is hijacked wrt. CC
- ;; - buffer is in sync with disk contents, modtime and writeability
- ;; except if the user refused to save
- ;;
- (if (not (file-writable-p file))
- ;; Make it writeable.
- ;;
- (clearcase-utl-make-writeable file))
-
- ;; Attempt to modify the modtime of the file on disk, otherwise ClearCase
- ;; won't actually deem it hijacked. This will silently fail if there is no
- ;; "touch" command command available.
- ;;
- (clearcase-utl-touch-file file)
-
- ;; Sync up any buffers.
- ;;
- (clearcase-sync-from-disk file t))
-
-;;}}}
-
-;;{{{ Unhijack
-
-(defun clearcase-file-ok-to-unhijack (file)
- "Test if FILE is suitable for unhijack."
- (clearcase-fprop-hijacked file))
-
-(defun clearcase-unhijack (file)
- (clearcase-unhijack-seq (list file)))
-
-(defun cleartool-unhijack-parse-for-kept-files (ret snapshot-view-root)
- ;; Look for occurrences of:
- ;; Loading "source\emacs\.emacs.el" (296690 bytes).
- ;; (renaming original hijacked object to ".emacs.el.keep.10").
- ;;
- (let ((start 0)
- (kept-files nil))
- (while (string-match
- "^Loading \"\\([^\"]+\\)\"[^\n]+\n(renaming original hijacked object to \"\\([^\"]+\\)\")\\.\n"
- ret
- start)
- (let* ((elt-path (substring ret (match-beginning 1) (match-end 1)))
- (abs-elt-path (concat (if snapshot-view-root
- snapshot-view-root
- "/")
- elt-path))
- (abs-elt-dir (file-name-directory abs-elt-path ))
- (kept-file-rel (concat abs-elt-dir
- (substring ret (match-beginning 2) (match-end 2))))
-
- ;; This is necessary on Windows to get an absolute path, i.e. one
- ;; with a drive letter. Note: probably only correct if
- ;; unhijacking files in a single snapshot view, mounted on a
- ;; drive-letter.
- ;;
- (kept-file (expand-file-name kept-file-rel)))
- (setq kept-files (cons kept-file kept-files)))
- (setq start (match-end 0)))
- kept-files))
-
-(defun clearcase-utl-files-in-same-view-p (files)
- (if (< (length files) 2)
- t
- (let ((v0 (clearcase-fprop-viewtag (nth 0 files)))
- (v1 (clearcase-fprop-viewtag (nth 1 files))))
- (if (or (not (stringp v0))
- (not (stringp v1))
- (not (string= v0 v1)))
- nil
- (clearcase-utl-files-in-same-view-p (cdr files))))))
-
-(defun clearcase-unhijack-seq (files)
-
- ;; Check: there are no directories involved.
- ;;
- (mapcar
- (function
- (lambda (file)
- (if (file-directory-p file)
- (error "Cannot unhijack a directory"))))
- files)
-
- ;; Check: all files are in the same snapshot view.
- ;;
- ;; (Why ? The output from ct+update only has view-root-relative paths
- ;; and we need to obtain absolute paths of renamed-aside hijacks if we are to
- ;; dired-relist them.)
- ;;
- ;; Alternative: partition the set, with each partition containing elements in
- ;; the same view.
- ;;
- (if (not (clearcase-utl-files-in-same-view-p files))
- (error "Can't unhijack files in different views in the same operation"))
-
- ;; Run the scoped workspace update synchronously.
- ;;
- (unwind-protect
- (progn
- (message "Unhijacking...")
- (let* ((ret (apply (function clearcase-ct-blocking-call)
- (append (list "update"
- (if clearcase-keep-unhijacks
- "-rename"
- "-overwrite")
- "-log" clearcase-sink-file-name)
- files)))
- (snapshot-view-root (clearcase-file-snapshot-root (car files)))
-
- ;; Scan for renamed-aside files.
- ;;
- (kept-files (if clearcase-keep-unhijacks
- (cleartool-unhijack-parse-for-kept-files ret
- snapshot-view-root)
- nil)))
-
- ;; Do post-update synchronisation.
- ;;
- (mapcar
- (function clearcase-sync-after-file-updated-from-vob)
- files)
-
- ;; Update any dired buffers as to the existence of the kept files.
- ;;
- (if clearcase-keep-unhijacks
- (mapcar (function
- (lambda (file)
- (dired-relist-file file)))
- kept-files))))
- ;; unwind
- ;;
- (message "Unhijacking...done")))
-
-;;}}}
-
-;;{{{ Mkelem
-
-(defun clearcase-file-ok-to-mkelem (file)
- "Test if FILE is okay to mkelem."
- (let ((mtype (clearcase-fprop-mtype file)))
- (and (not (file-directory-p file))
- (and (or (equal 'view-private-object mtype)
- (equal 'derived-object mtype))
- (not (clearcase-fprop-hijacked file))
- (not (clearcase-file-covers-element-p file))))))
-
-(defun clearcase-assert-file-ok-to-mkelem (file)
- "Raise an exception if FILE is not suitable for mkelem."
- (if (not (clearcase-file-ok-to-mkelem file))
- (error "%s cannot be made into an element" file)))
-
-(defun clearcase-commented-mkelem (file &optional okay-to-checkout-dir-first comment)
- "Create a new element from FILE. If OKAY-TO-CHECKOUT-DIR-FIRST is non-nil,
-the containing directory will be checked out if necessary.
-If COMMENT is non-nil, it will be used, otherwise the user will be prompted
-to enter one."
-
- ;; Pre-condition
- ;;
- (clearcase-assert-file-ok-to-mkelem file)
-
- (let ((containing-dir (file-name-directory file)))
-
- ;; Pre-condition
- ;;
- (if (not (eq 'directory-version (clearcase-fprop-mtype containing-dir)))
- (error "Parent directory of %s is not a ClearCase versioned directory."
- file))
-
- ;; Determine if we'll need to checkout the parent directory first.
- ;;
- (let ((dir-checkout-needed (not (clearcase-fprop-checked-out containing-dir))))
- (if dir-checkout-needed
- (progn
- ;; Parent dir will need to be checked out. Get permission if
- ;; appropriate.
- ;;
- (if (null okay-to-checkout-dir-first)
- (setq okay-to-checkout-dir-first
- (or (null clearcase-verify-pre-mkelem-dir-checkout)
- (y-or-n-p (format "Checkout directory %s " containing-dir)))))
- (if (null okay-to-checkout-dir-first)
- (error "Can't make an element unless directory is checked-out."))))
-
- (if (null comment)
- ;; If no comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry (file-name-nondirectory file)
- "Enter initial comment for the new element."
- 'clearcase-commented-mkelem
- (list file okay-to-checkout-dir-first)
- (find-file-noselect file)
- clearcase-initial-mkelem-comment)
-
- ;; ...otherwise perform the operation.
- ;;
-
- ;; We may need to checkout the directory.
- ;;
- (if dir-checkout-needed
- (clearcase-commented-checkout containing-dir comment))
-
- (clearcase-fprop-unstore-properties file)
-
- (message "Making element %s..." file)
-
- (save-excursion
- ;; Sync the buffer to disk.
- ;;
- (let ((buffer-on-file (find-buffer-visiting file)))
- (if buffer-on-file
- (progn
- (set-buffer buffer-on-file)
- (clearcase-sync-to-disk))))
-
- (clearcase-ct-do-cleartool-command "mkelem"
- file
- comment
- (if clearcase-checkin-on-mkelem
- (list "-ci")))
- (message "Making element %s...done" file)
-
- ;; Resync.
- ;;
- (clearcase-sync-from-disk file t))))))
-
-(defun clearcase-commented-mkelem-seq (files &optional comment)
- "Mkelem a sequence of FILES. If COMMENT is supplied it will be
-used, otherwise the user will be prompted to enter one."
-
- (mapcar
- (function clearcase-assert-file-ok-to-mkelem)
- files)
-
- (if (null comment)
- ;; No comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry "mkelem"
- "Enter comment for elements' creation"
- 'clearcase-commented-mkelem-seq
- (list files))
- ;; ...otherwise operate.
- ;;
- (mapcar
- (function
- (lambda (file)
- (clearcase-commented-mkelem file nil comment)))
- files)))
-
-;;}}}
-
-;;{{{ Checkin
-
-(defun clearcase-file-ok-to-checkin (file)
- "Test if FILE is suitable for checkin."
- (let ((me (user-login-name)))
- (equal me (clearcase-fprop-owner-of-checkout file))))
-
-(defun clearcase-assert-file-ok-to-checkin (file)
- "Raise an exception if FILE is not suitable for checkin."
- (if (not (clearcase-file-ok-to-checkin file))
- (error "You cannot checkin %s" file)))
-
-(defun clearcase-commented-checkin (file &optional comment)
- "Check-in FILE with COMMENT. If the comment is omitted,
-a buffer is popped up to accept one."
-
- (clearcase-assert-file-ok-to-checkin file)
-
- (if (null comment)
- ;; If no comment supplied, go and get one..
- ;;
- (progn
- (clearcase-comment-start-entry (file-name-nondirectory file)
- "Enter a checkin comment."
- 'clearcase-commented-checkin
- (list file)
- (find-file-noselect file)
- (clearcase-fprop-comment file))
-
- ;; Also display a diff, if that is the custom:
- ;;
- (if (and (not (file-directory-p file))
- clearcase-diff-on-checkin)
- (save-excursion
- (let ((tmp-buffer (current-buffer)))
- (message "Running diff...")
- (clearcase-diff-file-with-version file
- (clearcase-fprop-predecessor-version file))
- (message "Running diff...done")
- (set-buffer "*clearcase*")
- (if (get-buffer "*clearcase-diff*")
- (kill-buffer "*clearcase-diff*"))
- (rename-buffer "*clearcase-diff*")
- (pop-to-buffer tmp-buffer)))))
-
- ;; ...otherwise perform the operation.
- ;;
- (message "Checking in %s..." file)
- (save-excursion
- ;; Sync the buffer to disk, and get local value of clearcase-checkin-arguments
- ;;
- (let ((buffer-on-file (find-buffer-visiting file)))
- (if buffer-on-file
- (progn
- (set-buffer buffer-on-file)
- (clearcase-sync-to-disk))))
- (clearcase-ct-do-cleartool-command "ci"
- file
- comment
- clearcase-checkin-arguments))
- (message "Checking in %s...done" file)
-
- ;; Resync.
- ;;
- (clearcase-sync-from-disk file t)))
-
-(defun clearcase-commented-checkin-seq (files &optional comment)
- "Checkin a sequence of FILES. If COMMENT is supplied it will be
-used, otherwise the user will be prompted to enter one."
-
- ;; Check they're all in the right state to be checked-in.
- ;;
- (mapcar
- (function clearcase-assert-file-ok-to-checkin)
- files)
-
- (if (null comment)
- ;; No comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry "checkin"
- "Enter checkin comment."
- 'clearcase-commented-checkin-seq
- (list files))
- ;; ...otherwise operate.
- ;;
- (mapcar
- (function
- (lambda (file)
- (clearcase-commented-checkin file comment)))
- files)))
-
-;;}}}
-
-;;{{{ Checkout
-
-(defun clearcase-file-ok-to-checkout (file)
- "Test if FILE is suitable for checkout."
- (let ((mtype (clearcase-fprop-mtype file)))
- (and (or (eq 'version mtype)
- (eq 'directory-version mtype)
- (clearcase-fprop-hijacked file))
- (not (clearcase-fprop-checked-out file)))))
-
-(defun clearcase-assert-file-ok-to-checkout (file)
- "Raise an exception if FILE is not suitable for checkout."
- (if (not (clearcase-file-ok-to-checkout file))
- (error "You cannot checkout %s" file)))
-
-;; nyi: Offer to setact if appropriate
-
-(defun clearcase-commented-checkout (file &optional comment)
- "Check-out FILE with COMMENT. If the comment is omitted,
-a buffer is popped up to accept one."
-
- (clearcase-assert-file-ok-to-checkout file)
-
- (if (and (null comment)
- (not clearcase-suppress-checkout-comments))
- ;; If no comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry (file-name-nondirectory file)
- "Enter a checkout comment."
- 'clearcase-commented-checkout
- (list file)
- (find-file-noselect file))
-
- ;; ...otherwise perform the operation.
- ;;
- (message "Checking out %s..." file)
- ;; Change buffers to get local value of clearcase-checkin-arguments.
- ;;
- (save-excursion
- (set-buffer (or (find-buffer-visiting file)
- (current-buffer)))
- (clearcase-ct-do-cleartool-command "co"
- file
- comment
- clearcase-checkout-arguments))
- (message "Checking out %s...done" file)
-
- ;; Resync.
- ;;
- (clearcase-sync-from-disk file t)))
-
-
-(defun clearcase-commented-checkout-seq (files &optional comment)
- "Checkout a sequence of FILES. If COMMENT is supplied it will be
-used, otherwise the user will be prompted to enter one."
-
- (mapcar
- (function clearcase-assert-file-ok-to-checkout)
- files)
-
- (if (and (null comment)
- (not clearcase-suppress-checkout-comments))
- ;; No comment supplied, go and get one...
- ;;
- (clearcase-comment-start-entry "checkout"
- "Enter a checkout comment."
- 'clearcase-commented-checkout-seq
- (list files))
- ;; ...otherwise operate.
- ;;
- (mapcar
- (function
- (lambda (file)
- (clearcase-commented-checkout file comment)))
- files)))
-
-;;}}}
-
-;;{{{ Uncheckout
-
-(defun clearcase-file-ok-to-uncheckout (file)
- "Test if FILE is suitable for uncheckout."
- (equal (user-login-name)
- (clearcase-fprop-owner-of-checkout file)))
-
-(defun clearcase-assert-file-ok-to-uncheckout (file)
- "Raise an exception if FILE is not suitable for uncheckout."
- (if (not (clearcase-file-ok-to-uncheckout file))
- (error "You cannot uncheckout %s" file)))
-
-(defun cleartool-unco-parse-for-kept-file (ret)
- ;;Private version of "foo" saved in "foo.keep.1"
- (if (string-match "^Private version of .* saved in \"\\([^\"]+\\)\"\\.$" ret)
- (substring ret (match-beginning 1) (match-end 1))
- nil))
-
-(defun clearcase-uncheckout (file)
- "Uncheckout FILE."
-
- (clearcase-assert-file-ok-to-uncheckout file)
-
- ;; If it has changed since checkout, insist the user confirm.
- ;;
- (if (and (not (file-directory-p file))
- (clearcase-file-appears-modified-since-checkout-p file)
- (not clearcase-suppress-confirm)
- (not (yes-or-no-p (format "Really discard changes to %s ?" file))))
- (message "Uncheckout of %s cancelled" file)
-
- ;; Go ahead and unco.
- ;;
- (message "Cancelling checkout of %s..." file)
- ;; nyi:
- ;; - Prompt for -keep or -rm
- ;; - offer to remove /0 branches
- ;;
- (let* ((ret (clearcase-ct-blocking-call "unco"
- (if clearcase-keep-uncheckouts
- "-keep"
- "-rm")
- file))
- ;; Discover the name of the saved.
- ;;
- (kept-file (if clearcase-keep-uncheckouts
- (cleartool-unco-parse-for-kept-file ret)
- nil)))
-
- (if kept-file
- (message "Checkout of %s cancelled (saved in %s)"
- file
- (file-name-nondirectory kept-file))
- (message "Cancelling checkout of %s...done" file))
-
- ;; Sync any buffers over the file itself.
- ;;
- (clearcase-sync-from-disk file t)
-
- ;; now remove the branch type if the remaining version is 0
- (let* ((version (clearcase-fprop-version file))
- (full-version (clearcase-vxpath-cons-vxpath file (file-name-directory version))))
-
- (when (and clearcase-remove-branch-after-unheckout-when-only-0-version
- (string= (file-name-nondirectory version) "0")
- (y-or-n-p (format "Remove branch `%s'?" full-version)))
- ;; remove branch type and re-sync any buffers over the file itself.
- (clearcase-ct-cleartool-cmd "rmbranch" "-force" full-version)
- (clearcase-sync-from-disk file t)))
-
- ;; Update any dired buffers as to the existence of the kept file.
- ;;
- (if kept-file
- (dired-relist-file kept-file)))))
-
-(defun clearcase-uncheckout-seq (files)
- "Uncheckout a sequence of FILES."
-
- (mapcar
- (function clearcase-assert-file-ok-to-uncheckout)
- files)
-
- (mapcar
- (function clearcase-uncheckout)
- files))
-
-;;}}}
-
-;;{{{ Describe
-
-(defun clearcase-describe (file)
- "Give a ClearCase description of FILE."
-
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- (list file)
- (function
- (lambda (file)
- (clearcase-ct-do-cleartool-command "describe" file 'unused)))))
-
-(defun clearcase-describe-seq (files)
- "Give a ClearCase description of the sequence of FILES."
- (error "Not yet implemented"))
-
-;;}}}
-
-;;{{{ Mkbrtype
-
-(defun clearcase-commented-mkbrtype (typename &optional comment)
- (if (null comment)
- (clearcase-comment-start-entry (format "mkbrtype:%s" typename)
- "Enter a comment for the new branch type."
- 'clearcase-commented-mkbrtype
- (list typename))
- (clearcase-with-tempfile
- comment-file
- (write-region comment nil comment-file nil 'noprint)
- (let ((qualified-typename typename))
- (if (not (string-match "@" typename))
- (setq qualified-typename
- (format "%s@%s" typename default-directory)))
-
- (clearcase-ct-cleartool-cmd "mkbrtype"
- "-cfile"
- (clearcase-path-native comment-file)
- qualified-typename)))))
-
-;;}}}
-
-;;{{{ Browse vtree (using Dired Mode)
-
-(defun clearcase-file-ok-to-browse (file)
- (and file
- (or (equal 'version (clearcase-fprop-mtype file))
- (equal 'directory-version (clearcase-fprop-mtype file)))
- (clearcase-file-is-in-mvfs-p file)))
-
-(defun clearcase-browse-vtree (file &optional graphical)
- (if (not (clearcase-fprop-file-is-version-p file))
- (error "%s is not a Clearcase element" file))
-
- (if graphical
- (clearcase-gui-vtree-browser file)
-
- ;; else...
- (if (not (clearcase-file-is-in-mvfs-p file))
- (error "File is not in MVFS"))
-
- (let* ((version-path (clearcase-vxpath-cons-vxpath
- file
- (or (clearcase-vxpath-version-part file)
- (clearcase-fprop-version file))))
- ;; nyi: Can't seem to get latest first here.
- ;;
- (dired-listing-switches (concat dired-listing-switches
- "rt"))
-
- (branch-path (clearcase-vxpath-branch version-path))
-
- ;; Position cursor to the version we came from.
- ;; If it was checked-out, go to predecessor.
- ;;
- (version-number (clearcase-vxpath-version
- (if (clearcase-fprop-checked-out file)
- (clearcase-fprop-predecessor-version file)
- version-path))))
-
- (if (file-exists-p version-path)
- (progn
- ;; Invoke dired on the directory of the version branch.
- ;;
- (dired branch-path)
-
- (clearcase-dired-sort-by-date)
-
- (if (re-search-forward (concat "[ \t]+"
- "\\("
- (regexp-quote version-number)
- "\\)"
- "$")
- nil
- t)
- (goto-char (match-beginning 1))))
- (dired (concat file clearcase-vxpath-glue))
-
- ;; nyi: We want ANY directory in the history tree to appear with
- ;; newest first. Probably requires a hook to dired mode.
- ;;
- (clearcase-dired-sort-by-date)))))
-
-;;}}}
-
-;;{{{ List history
-
-(defun clearcase-list-history (file)
- "List the change history of FILE.
-
-FILE can be a file or a directory. If it is a directory, only the information
-on the directory element itself is listed, not on its contents."
-
- (let ((mtype (clearcase-fprop-mtype file)))
- (if (or (eq mtype 'version)
- (eq mtype 'directory-version))
- (progn
- (message "Listing element history...")
-
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- (list file)
- (function
- (lambda (file)
- (clearcase-ct-do-cleartool-command "lshistory"
- file
- 'unused
- (if (eq mtype 'directory-version)
- (list "-d")))
- (setq default-directory (file-name-directory file))
- (while (looking-at "=3D*\n")
- (delete-char (- (match-end 0) (match-beginning 0)))
- (forward-line -1))
- (goto-char (point-min))
- (if (looking-at "[\b\t\n\v\f\r ]+")
- (delete-char (- (match-end 0) (match-beginning 0)))))))
- (message "Listing element history...done"))
-
- (error "%s is not a ClearCase element" file))))
-
-;;}}}
-
-;;{{{ Diff/cmp
-
-(defun clearcase-files-are-identical (f1 f2)
- "Test if FILE1 and FILE2 have identical contents."
-
- (clearcase-when-debugging
- (if (not (file-exists-p f1))
- (error "%s non-existent" f1))
- (if (not (file-exists-p f2))
- (error "%s non-existent" f2)))
-
- (zerop (call-process "cleardiff" nil nil nil "-status_only" f1 f2)))
-
-(defun clearcase-diff-files (file1 file2)
- "Run cleardiff on FILE1 and FILE2 and display the differences."
- (if clearcase-use-normal-diff
- (clearcase-do-command 2
- clearcase-normal-diff-program
- file2
- (append clearcase-normal-diff-arguments
- (list file1)))
- (clearcase-do-command 2
- "cleardiff"
- file2
- (list "-diff_format" file1)))
- (let ((diff-size (save-excursion
- (set-buffer "*clearcase*")
- (buffer-size))))
- (if (zerop diff-size)
- (message "No differences")
- (clearcase-port-view-buffer-other-window "*clearcase*")
- (goto-char 0)
- (shrink-window-if-larger-than-buffer))))
-
-;;}}}
-
-;;{{{ What rule
-
-(defun clearcase-what-rule (file)
- (let ((result (clearcase-ct-cleartool-cmd "ls"
- "-d"
- (clearcase-path-native file))))
- (if (string-match "Rule: \\(.*\\)\n" result)
- (message (substring result
- ;; Be a little more verbose
- (match-beginning 0) (match-end 1)))
- (error result))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ File property cache
-
-;; ClearCase properties of files are stored in a vector in a hashtable with the
-;; absolute-filename (with no trailing slashes) as the lookup key.
-;;
-;; Properties are:
-;;
-;; [0] truename : string
-;; [1] mtype : { nil, view-private-object, version,
-;; directory-version, file-element,
-;; dir-element, derived-object
-;; }
-;; [2] checked-out : boolean
-;; [3] reserved : boolean
-;; [4] version : string
-;; [5] predecessor-version : string
-;; [6] oid : string
-;; [7] user : string
-;; [8] date : string (yyyymmdd.hhmmss)
-;; [9] time-last-described : (N, N, N) time when the properties were last read
-;; from ClearCase
-;; [10] viewtag : string
-;; [11] comment : string
-;; [12] slink-text : string (empty string if not symlink)
-;; [13] hijacked : boolean
-
-;; nyi: other possible properties to record:
-;; mtime when last described (lets us know when the cached properties
-;; might be stale)
-
-;;{{{ Debug code
-
-(defun clearcase-fprop-unparse-properties (properties)
- "Return a string suitable for printing PROPERTIES."
- (concat
- (format "truename: %s\n" (aref properties 0))
- (format "mtype: %s\n" (aref properties 1))
- (format "checked-out: %s\n" (aref properties 2))
- (format "reserved: %s\n" (aref properties 3))
- (format "version: %s\n" (aref properties 4))
- (format "predecessor-version: %s\n" (aref properties 5))
- (format "oid: %s\n" (aref properties 6))
- (format "user: %s\n" (aref properties 7))
- (format "date: %s\n" (aref properties 8))
- (format "time-last-described: %s\n" (current-time-string (aref properties 9)))
- (format "viewtag: %s\n" (aref properties 10))
- (format "comment: %s\n" (aref properties 11))
- (format "slink-text: %s\n" (aref properties 12))
- (format "hijacked: %s\n" (aref properties 13))))
-
-(defun clearcase-fprop-display-properties (file)
- "Display the recorded ClearCase properties of FILE."
- (interactive "F")
- (let* ((abs-file (expand-file-name file))
- (properties (clearcase-fprop-lookup-properties abs-file)))
- (if properties
- (let ((unparsed-properties (clearcase-fprop-unparse-properties properties)))
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- nil
- (function (lambda ()
- (insert unparsed-properties)))))
- (error "Properties for %s not stored" file))))
-
-(defun clearcase-fprop-dump-to-current-buffer ()
- "Dump to the current buffer the table recording ClearCase properties of files."
- (interactive)
- (insert (format "File describe count: %s\n" clearcase-fprop-describe-count))
- (mapatoms
- (function
- (lambda (symbol)
- (let ((properties (symbol-value symbol)))
- (insert "\n"
- (format "key: %s\n" (symbol-name symbol))
- "\n"
- (clearcase-fprop-unparse-properties properties)))))
- clearcase-fprop-hashtable)
- (insert "\n"))
-
-(defun clearcase-fprop-dump ()
- (interactive)
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- nil
- (function (lambda ()
- (clearcase-fprop-dump-to-current-buffer)))))
-
-;;}}}
-
-(defvar clearcase-fprop-hashtable (make-vector 31 0)
- "Obarray for per-file ClearCase properties.")
-
-(defun clearcase-fprop-canonicalise-path (filename)
- ;; We want DIR/y and DIR\y to map to the same cache entry on ms-windows.
- ;; We want DIR and DIR/ (and on windows DIR\) to map to the same cache entry.
- ;;
- ;; However, on ms-windows avoid canonicalising X:/ to X: because, for some
- ;; reason, cleartool+desc fails on X:, but works on X:/
- ;;
- (setq filename (clearcase-path-canonicalise-slashes filename))
- (if (and clearcase-on-mswindows
- (string-match (concat "^" "[A-Za-z]:" clearcase-pname-sep-regexp "$")
- filename))
- filename
- (clearcase-utl-strip-trailing-slashes filename)))
-
-(defun clearcase-fprop-clear-all-properties ()
- "Delete all entries in the clearcase-fprop-hashtable."
- (setq clearcase-fprop-hashtable (make-vector 31 0)))
-
-(defun clearcase-fprop-store-properties (file properties)
- "For FILE, store its ClearCase PROPERTIES in the clearcase-fprop-hashtable."
- (assert (file-name-absolute-p file))
- (set (intern (clearcase-fprop-canonicalise-path file)
- clearcase-fprop-hashtable) properties))
-
-(defun clearcase-fprop-unstore-properties (file)
- "For FILE, delete its entry in the clearcase-fprop-hashtable."
- (assert (file-name-absolute-p file))
- (unintern (clearcase-fprop-canonicalise-path file) clearcase-fprop-hashtable))
-
-(defun clearcase-fprop-lookup-properties (file)
- "For FILE, lookup and return its ClearCase properties from the
-clearcase-fprop-hashtable."
- (assert (file-name-absolute-p file))
- (symbol-value (intern-soft (clearcase-fprop-canonicalise-path file)
- clearcase-fprop-hashtable)))
-
-(defun clearcase-fprop-get-properties (file)
- "For FILE, make sure its ClearCase properties are in the hashtable
-and then return them."
- (or (clearcase-fprop-lookup-properties file)
- (let ((properties
- (condition-case signal-info
- (clearcase-fprop-read-properties file)
- (error
- (progn
- (clearcase-trace (format "(clearcase-fprop-read-properties %s) signalled error: %s"
- file
- (cdr signal-info)))
- (make-vector 31 nil))))))
- (clearcase-fprop-store-properties file properties)
- properties)))
-
-(defun clearcase-fprop-truename (file)
- "For FILE, return its \"truename\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 0))
-
-(defun clearcase-fprop-mtype (file)
- "For FILE, return its \"mtype\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 1))
-
-(defun clearcase-fprop-checked-out (file)
- "For FILE, return its \"checked-out\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 2))
-
-(defun clearcase-fprop-reserved (file)
- "For FILE, return its \"reserved\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 3))
-
-(defun clearcase-fprop-version (file)
- "For FILE, return its \"version\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 4))
-
-(defun clearcase-fprop-predecessor-version (file)
- "For FILE, return its \"predecessor-version\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 5))
-
-(defun clearcase-fprop-oid (file)
- "For FILE, return its \"oid\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 6))
-
-(defun clearcase-fprop-user (file)
- "For FILE, return its \"user\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 7))
-
-(defun clearcase-fprop-date (file)
- "For FILE, return its \"date\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 8))
-
-(defun clearcase-fprop-time-last-described (file)
- "For FILE, return its \"time-last-described\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 9))
-
-(defun clearcase-fprop-viewtag (file)
- "For FILE, return its \"viewtag\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 10))
-
-(defun clearcase-fprop-comment (file)
- "For FILE, return its \"comment\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 11))
-
-(defun clearcase-fprop-vob-slink-text (file)
- "For FILE, return its \"slink-text\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 12))
-
-(defun clearcase-fprop-hijacked (file)
- "For FILE, return its \"hijacked\" ClearCase property."
- (aref (clearcase-fprop-get-properties file) 13))
-
-(defun clearcase-fprop-set-comment (file comment)
- "For FILE, set its \"comment\" ClearCase property to COMMENT."
- (aset (clearcase-fprop-get-properties file) 11 comment))
-
-(defun clearcase-fprop-owner-of-checkout (file)
- "For FILE, return whether the current user has it checked-out."
- (if (clearcase-fprop-checked-out file)
- (clearcase-fprop-user file)
- nil))
-
-(defun clearcase-fprop-file-is-vob-slink-p (object-name)
- (not (zerop (length (clearcase-fprop-vob-slink-text object-name)))))
-
-(defun clearcase-fprop-file-is-version-p (object-name)
- (if object-name
- (let ((mtype (clearcase-fprop-mtype object-name)))
- (or (eq 'version mtype)
- (eq 'directory-version mtype)))))
-
-;; Read the object's ClearCase properties using cleartool and the Lisp reader.
-;;
-;; nyi: for some reason the \n before the %c necessary here so avoid confusing the
-;; cleartool/tq interface. Completely mysterious. Arrived at by
-;; trial and error.
-;;
-(defvar clearcase-fprop-fmt-string
-
- ;; Yuck. Different forms of quotation are needed here apparently to deal with
- ;; all the various ways of spawning sub-process on the the various platforms
- ;; (XEmacs vs. GnuEmacs, Win32 vs. Unix, Cygwin-built vs. native-built).
- ;;
- (if clearcase-on-mswindows
- (if clearcase-xemacs-p
- ;; XEmacs/Windows
- ;;
- (if clearcase-on-cygwin
- ;; Cygwin build
- ;;
- "[nil \\\"%m\\\" \\\"%f\\\" \\\"%Rf\\\" \\\"%Sn\\\" \\\"%PSn\\\" \\\"%On\\\" \\\"%u\\\" \\\"%Nd\\\" nil nil nil \\\"%[slink_text]p\\\" nil ]\\n%c"
- ;; Native build
- ;;
- "[nil \\\"%m\\\" \\\"%f\\\" \\\"%Rf\\\" \\\"%Sn\\\" \\\"%PSn\\\" \\\"%On\\\" \\\"%u\\\" \\\"%Nd\\\" nil nil nil \\\"%[slink_text]p\\\" nil]\n%c")
-
- ;; GnuEmacs/Windows
- ;;
- "[nil \"%m\" \"%f\" \"%Rf\" \"%Sn\" \"%PSn\" \"%On\" \"%u\" \"%Nd\" nil nil nil \"%[slink_text]p\" nil]\\n%c")
-
- ;; Unix
- ;;
- "'[nil \"%m\" \"%f\" \"%Rf\" \"%Sn\" \"%PSn\" \"%On\" \"%u\" \"%Nd\" nil nil nil \"%[slink_text]p\" nil]\\n%c'")
-
- "Format for cleartool+describe command when reading the
-ClearCase properties of a file")
-
-(defvar clearcase-fprop-describe-count 0
- "Count the number of times clearcase-fprop-read-properties is called")
-
-(defun clearcase-fprop-read-properties (file)
- "Invoke the cleartool+describe command to obtain the ClearCase
-properties of FILE."
- (assert (file-name-absolute-p file))
- (let* ((truename (clearcase-fprop-canonicalise-path (file-truename (expand-file-name file)))))
-
- ;; If the object doesn't exist, signal an error
- ;;
- (if (or (not (file-exists-p (clearcase-vxpath-element-part file)))
- (not (file-exists-p (clearcase-vxpath-element-part truename))))
- (error "File doesn't exist: %s" file)
-
- ;; Run cleartool+ describe and capture the output as a string:
- ;;
- (let ((desc-string (clearcase-ct-cleartool-cmd "desc"
- "-fmt"
- clearcase-fprop-fmt-string
- (clearcase-path-native truename))))
- (setq clearcase-fprop-describe-count (1+ clearcase-fprop-describe-count))
-
- ;;(clearcase-trace (format "desc of %s <<<<" truename))
- ;;(clearcase-trace desc-string)
- ;;(clearcase-trace (format "desc of %s >>>>" truename))
-
- ;; Read all but the comment, using the Lisp reader, and then copy
- ;; what's left as the comment. We don't try to use the Lisp reader to
- ;; fetch the comment to avoid problems with quotation.
- ;;
- ;; nyi: it would be nice if we could make cleartool use "/" as pname-sep,
- ;; because read-from-string will barf on imbedded "\". For now
- ;; run clearcase-path-canonicalise-slashes over the cleartool
- ;; output before invoking the Lisp reader.
- ;;
- (let* ((first-read (read-from-string (clearcase-path-canonicalise-slashes desc-string)))
- (result (car first-read))
- (bytes-read (cdr first-read))
- (comment (substring desc-string (1+ bytes-read)))) ;; skip \n
-
- ;; Plug in the slots I left empty:
- ;;
- (aset result 0 truename)
- (aset result 9 (current-time))
-
- (aset result 11 comment)
-
- ;; Convert mtype to an enumeration:
- ;;
- (let ((mtype-string (aref result 1)))
- (cond
- ((string= mtype-string "version")
- (aset result 1 'version))
-
- ((string= mtype-string "directory version")
- (aset result 1 'directory-version))
-
- ((string= mtype-string "view private object")
- (aset result 1 'view-private-object)
-
- ;; If we're in a snapshot see if it is hijacked by running
- ;; ct+desc FILE@@. No error indicates it's hijacked.
- ;;
- (if (clearcase-file-would-be-in-snapshot-p truename)
- (aset result 13
- (condition-case nil
- (stringp
- (clearcase-ct-cleartool-cmd
- "desc"
- "-short"
- (concat (clearcase-path-native truename)
- clearcase-vxpath-glue)))
- (error nil)))))
-
- ((string= mtype-string "file element")
- (aset result 1 'file-element))
-
- ((string= mtype-string "directory element")
- (aset result 1 'directory-element))
-
- ((string= mtype-string "derived object")
- (aset result 1 'derived-object))
-
- ;; For now treat checked-in DOs as versions.
- ;;
- ((string= mtype-string "derived object version")
- (aset result 1 'version))
-
- ;; On NT, coerce the mtype of symlinks into that
- ;; of their targets.
- ;;
- ;; nyi: I think this is approximately right.
- ;;
- ((and (string= mtype-string "symbolic link")
- clearcase-on-mswindows)
- (if (file-directory-p truename)
- (aset result 1 'directory-version)
- (aset result 1 'version)))
-
- ;; We get this on paths like foo.c@@/main
- ;;
- ((string= mtype-string "branch")
- (aset result 1 'branch))
-
- ((string= mtype-string "**null meta type**")
- (aset result 1 nil))
-
- (t
- (error "Unknown mtype returned by cleartool+describe: %s"
- mtype-string))))
-
- ;; nyi: possible efficiency win: only evaluate the viewtag on demand.
- ;;
- (if (aref result 1)
- (aset result 10 (clearcase-file-viewtag truename)))
-
- ;; Convert checked-out field to boolean:
- ;;
- (aset result 2 (not (zerop (length (aref result 2)))))
-
- ;; Convert reserved field to boolean:
- ;;
- (aset result 3 (string= "reserved" (aref result 3)))
-
- ;; Return the array of properties.
- ;;
- result)))))
-
-;;}}}
-
-;;{{{ View property cache
-
-;; ClearCase properties of views are stored in a vector in a hashtable
-;; with the viewtag as the lookup key.
-;;
-;; Properties are:
-;;
-;; [0] ucm : boolean
-;; [1] stream : string
-;; [2] pvob : string
-;; [3] activities : list of strings
-;; [4] current-activity : string
-
-;;{{{ Debug code
-
-(defun clearcase-vprop-dump-to-current-buffer ()
- "Dump to the current buffer the table recording ClearCase properties of views."
- (insert (format "View describe count: %s\n" clearcase-vprop-describe-count))
- (mapatoms
- (function
- (lambda (symbol)
- (let ((properties (symbol-value symbol)))
- (insert "\n"
- (format "viewtag: %s\n" (symbol-name symbol))
- "\n"
- (clearcase-vprop-unparse-properties properties)))))
- clearcase-vprop-hashtable)
- (insert "\n"))
-
-(defun clearcase-vprop-dump ()
- (interactive)
- (clearcase-utl-populate-and-view-buffer
- "*clearcase*"
- nil
- (function (lambda ()
- (clearcase-vprop-dump-to-current-buffer)))))
-
-(defun clearcase-vprop-unparse-properties (properties)
- "Return a string suitable for printing PROPERTIES."
- (concat
- (format "ucm: %s\n" (aref properties 0))
- (format "stream: %s\n" (aref properties 1))
- (format "pvob: %s\n" (aref properties 2))
- (format "activities: %s\n" (aref properties 3))
- (format "current-activity: %s\n" (aref properties 4))))
-
-;;}}}
-
-;;{{{ Asynchronously fetching view properties:
-
-(defvar clearcase-vprop-timer nil)
-(defvar clearcase-vprop-work-queue nil)
-
-(defun clearcase-vprop-schedule-work (viewtag)
- ;; Add to the work queue.
- ;;
- (setq clearcase-vprop-work-queue (cons viewtag
- clearcase-vprop-work-queue))
- ;; Create the timer if necessary.
- ;;
- (if (null clearcase-vprop-timer)
- (if clearcase-xemacs-p
- ;; Xemacs
- ;;
- (setq clearcase-vprop-timer
- (run-with-idle-timer 5 t 'clearcase-vprop-timer-function))
- ;; FSF Emacs
- ;;
- (progn
- (setq clearcase-vprop-timer (timer-create))
- (timer-set-function clearcase-vprop-timer 'clearcase-vprop-timer-function)
- (timer-set-idle-time clearcase-vprop-timer 5)
- (timer-activate-when-idle clearcase-vprop-timer)))))
-
-(defun clearcase-vprop-timer-function ()
- ;; Process the work queue and empty it.
- ;;
- (mapcar (function (lambda (viewtag)
- (if viewtag
- (clearcase-vprop-get-properties viewtag))))
- clearcase-vprop-work-queue)
- (setq clearcase-vprop-work-queue nil)
-
- ;; Cancel the timer.
- ;;
- (if clearcase-xemacs-p
- (delete-itimer clearcase-vprop-timer)
- (cancel-timer clearcase-vprop-timer))
- (setq clearcase-vprop-timer nil))
-
-;;}}}
-
-(defvar clearcase-vprop-hashtable (make-vector 31 0)
- "Obarray for per-view ClearCase properties.")
-
-(defun clearcase-vprop-clear-all-properties ()
- "Delete all entries in the clearcase-vprop-hashtable."
- (setq clearcase-vprop-hashtable (make-vector 31 0)))
-
-(defun clearcase-vprop-store-properties (viewtag properties)
- "For VIEW, store its ClearCase PROPERTIES in the clearcase-vprop-hashtable."
- (set (intern viewtag clearcase-vprop-hashtable) properties))
-
-(defun clearcase-vprop-unstore-properties (viewtag)
- "For VIEWTAG, delete its entry in the clearcase-vprop-hashtable."
- (unintern viewtag clearcase-vprop-hashtable))
-
-(defun clearcase-vprop-lookup-properties (viewtag)
- "For VIEWTAG, lookup and return its ClearCase properties from the
-clearcase-vprop-hashtable."
- (symbol-value (intern-soft viewtag clearcase-vprop-hashtable)))
-
-(defun clearcase-vprop-get-properties (viewtag)
- "For VIEWTAG, make sure it's ClearCase properties are in the hashtable
-and then return them."
- (or (clearcase-vprop-lookup-properties viewtag)
- (let ((properties (clearcase-vprop-read-properties viewtag)))
- (clearcase-vprop-store-properties viewtag properties)
- properties)))
-
-(defun clearcase-vprop-ucm (viewtag)
- "For VIEWTAG, return its \"ucm\" ClearCase property."
- (aref (clearcase-vprop-get-properties viewtag) 0))
-
-(defun clearcase-vprop-stream (viewtag)
- "For VIEWTAG, return its \"stream\" ClearCase property."
- (aref (clearcase-vprop-get-properties viewtag) 1))
-
-(defun clearcase-vprop-pvob (viewtag)
- "For VIEWTAG, return its \"stream\" ClearCase property."
- (aref (clearcase-vprop-get-properties viewtag) 2))
-
-(defun clearcase-vprop-activities (viewtag)
- "For VIEWTAG, return its \"activities\" ClearCase property."
-
- ;; If the activity set has been flushed, go and schedule a re-fetch.
- ;;
- (let ((properties (clearcase-vprop-get-properties viewtag)))
- (if (null (aref properties 3))
- (aset properties 3 (clearcase-vprop-read-activities-asynchronously viewtag))))
-
- ;; Now poll, waiting for the activities to be available.
- ;;
- (let ((loop-count 0))
- ;; If there is a background process still reading the activities,
- ;; wait for it to finish.
- ;;
- ;; nyi: probably want a timeout here.
- ;;
- ;; nyi: There seems to be a race on NT in accept-process-output so that
- ;; we would wait forever.
- ;;
- (if (not clearcase-on-mswindows)
- ;; Unix synchronization with the end of the process
- ;; which is reading activities.
- ;;
- (while (bufferp (aref (clearcase-vprop-get-properties viewtag) 3))
- (save-excursion
- (set-buffer (aref (clearcase-vprop-get-properties viewtag) 3))
- (message "Reading activity list...")
- (setq loop-count (1+ loop-count))
- (accept-process-output clearcase-vprop-async-proc)))
-
- ;; NT synchronization with the end of the process which is reading
- ;; activities.
- ;;
- ;; Unfortunately on NT we can't rely on the process sentinel being called
- ;; so we have to explicitly test the process status.
- ;;
- (while (bufferp (aref (clearcase-vprop-get-properties viewtag) 3))
- (message "Reading activity list...")
- (save-excursion
- (set-buffer (aref (clearcase-vprop-get-properties viewtag) 3))
- (if (or (not (processp clearcase-vprop-async-proc))
- (eq 'exit (process-status clearcase-vprop-async-proc)))
-
- ;; The process has finished or gone away and apparently
- ;; the sentinel didn't get called which would have called
- ;; clearcase-vprop-finish-reading-activities, so call it
- ;; explicitly here.
- ;;
- (clearcase-vprop-finish-reading-activities (current-buffer))
-
- ;; The process is apparently still running, so wait
- ;; so more.
- (setq loop-count (1+ loop-count))
- (sit-for 1)))))
-
- (if (not (zerop loop-count))
- (message "Reading activity list...done"))
-
- (aref (clearcase-vprop-get-properties viewtag) 3)))
-
-(defun clearcase-vprop-current-activity (viewtag)
- "For VIEWTAG, return its \"current-activity\" ClearCase property."
- (aref (clearcase-vprop-get-properties viewtag) 4))
-
-(defun clearcase-vprop-set-activities (viewtag activities)
- "For VIEWTAG, set its \"activities\" ClearCase property to ACTIVITIES."
- (let ((properties (clearcase-vprop-lookup-properties viewtag)))
- ;; We must only set the activities for an existing vprop entry.
- ;;
- (assert properties)
- (aset properties 3 activities)))
-
-(defun clearcase-vprop-flush-activities (viewtag)
- "For VIEWTAG, set its \"activities\" ClearCase property to nil,
-to cause a future re-fetch."
- (clearcase-vprop-set-activities viewtag nil))
-
-(defun clearcase-vprop-set-current-activity (viewtag activity)
- "For VIEWTAG, set its \"current-activity\" ClearCase property to ACTIVITY."
- (aset (clearcase-vprop-get-properties viewtag) 4 activity))
-
-;; Read the object's ClearCase properties using cleartool lsview and cleartool lsstream.
-
-(defvar clearcase-vprop-describe-count 0
- "Count the number of times clearcase-vprop-read-properties is called")
-
-(defvar clearcase-lsstream-fmt-string
- (if clearcase-on-mswindows
- (if clearcase-xemacs-p
- ;; XEmacs/Windows
- ;;
- (if clearcase-on-cygwin
- ;; Cygwin build
- ;;
- "[\\\"%n\\\" \\\"%[master]p\\\" ]"
- ;; Native build
- ;;
- "[\\\"%n\\\" \\\"%[master]p\\\" ]")
- ;; GnuEmacs/Windows
- ;;
- "[\"%n\" \"%[master]p\" ]")
- ;; Unix
- ;;
- "'[\"%n\" \"%[master]p\" ]'"))
-
-(defun clearcase-vprop-read-properties (viewtag)
- "Invoke cleartool commands to obtain the ClearCase
-properties of VIEWTAG."
-
- ;; We used to use "ct+lsview -properties -full TAG", but this seemed to take
- ;; a long time in some circumstances. It appears to be because the
- ;; ADM_VIEW_GET_INFO RPC can take up to 60 seconds in certain circumstances
- ;; (typically on my laptop with self-contained ClearCase region).
-
- ;; Accordingly, since we don't really need to store snapshotness, the minimum
- ;; we really need to discover about a view is whether it is UCM-attached. For
- ;; this the much faster ct+lsstream suffices.
- ;;
- (let* ((result (make-vector 5 nil)))
- (if (not clearcase-v3)
- (let ((ucm nil)
- (stream nil)
- (pvob nil)
- (activity-names nil)
- (activity-titles nil)
- (activities nil)
- (current-activity nil)
- (ret ""))
-
- ;; This was necessary to make sure the "done" message was always
- ;; displayed. Not quite sure why.
- ;;
- (unwind-protect
- (progn
- (message "Reading view properties...")
- (setq ret (clearcase-ct-blocking-call "lsstream" "-fmt"
- clearcase-lsstream-fmt-string
- "-view" viewtag))
-
- (setq clearcase-vprop-describe-count (1+ clearcase-vprop-describe-count))
-
- (if (setq ucm (not (zerop (length ret))))
-
- ;; It's apparently a UCM view
- ;;
- (let* ((first-read (read-from-string (clearcase-utl-escape-backslashes ret)))
- (array-read (car first-read))
- (bytes-read (cdr first-read)))
-
- ;; Get stream name
- ;;
- (setq stream (aref array-read 0))
-
- ;; Get PVOB tag from something like "unix@/vobs/projects"
- ;;
- (let ((s (aref array-read 1)))
- (if (string-match "@" s)
- (setq pvob (substring s (match-end 0)))
- (setq pvob s)))
-
- ;; Get the activity list and store as a list of (NAME . TITLE) pairs
- ;;
- (setq activities (clearcase-vprop-read-activities-asynchronously viewtag))
-
- ;; Get the current activity
- ;;
- (let ((name-string (clearcase-ct-blocking-call "lsact" "-cact" "-fmt" "%n"
- "-view" viewtag)))
- (if (not (zerop (length name-string)))
- (setq current-activity name-string)))
-
- (aset result 0 ucm)
- (aset result 1 stream)
- (aset result 2 pvob)
- (aset result 3 activities)
- (aset result 4 current-activity))))
-
- (message "Reading view properties...done"))))
-
- result))
-
-(defvar clearcase-vprop-async-viewtag nil)
-(defvar clearcase-vprop-async-proc nil)
-(defun clearcase-vprop-read-activities-asynchronously (viewtag)
- (let ((buf-name (format "*clearcase-activities-%s*" viewtag)))
- ;; Clean up old instance of the buffer we use to fetch activities:
- ;;
- (let ((buf (get-buffer buf-name)))
- (if buf
- (progn
- (save-excursion
- (set-buffer buf)
- (if (and (boundp 'clearcase-vprop-async-proc)
- clearcase-vprop-async-proc)
- (condition-case nil
- (kill-process clearcase-vprop-async-proc)
- (error nil))))
- (kill-buffer buf))))
-
- ;; Create a buffer and an associated new process to read activities in the
- ;; background. We return the buffer to be stored in the activities field of
- ;; the view-properties record. The function clearcase-vprop-activities will
- ;; recognise when the asynch fetching is still underway and wait for it to
- ;; finish.
- ;;
- ;; The process has a sentinel function which is supposed to get called when
- ;; the process finishes. This sometimes doesn't happen on Windows, so that
- ;; clearcase-vprop-activities has to do a bit more work. (Perhaps a race
- ;; exists: the process completes before the sentinel can be set ?)
- ;;
- (let* ((buf (get-buffer-create buf-name))
- (proc (start-process (format "*clearcase-activities-process-%s*" viewtag)
- buf
- clearcase-cleartool-path
- "lsact" "-view" viewtag)))
- (process-kill-without-query proc)
- (save-excursion
- (set-buffer buf)
- ;; Create a sentinel to parse and store the activities when the
- ;; process finishes. We record the viewtag as a buffer-local
- ;; variable so the sentinel knows where to store the activities.
- ;;
- (set (make-local-variable 'clearcase-vprop-async-viewtag) viewtag)
- (set (make-local-variable 'clearcase-vprop-async-proc) proc)
- (set-process-sentinel proc 'clearcase-vprop-read-activities-sentinel))
- ;; Return the buffer.
- ;;
- buf)))
-
-(defun clearcase-vprop-read-activities-sentinel (process event-string)
- (clearcase-trace "Activity reading process sentinel called")
- (if (not (equal "finished\n" event-string))
- ;; Failure
- ;;
- (error "Reading activities failed: %s" event-string))
- (clearcase-vprop-finish-reading-activities (process-buffer process)))
-
-(defun clearcase-vprop-finish-reading-activities (buffer)
- (let ((activity-list nil))
- (message "Parsing view activities...")
- (save-excursion
- (set-buffer buffer)
- (if (or (not (boundp 'clearcase-vprop-async-viewtag))
- (null clearcase-vprop-async-viewtag))
- (error "Internal error: clearcase-vprop-async-viewtag not set"))
-
- ;; Check that our buffer is the one currently expected to supply the
- ;; activities. (Avoid races.)
- ;;
- (let ((properties (clearcase-vprop-lookup-properties clearcase-vprop-async-viewtag)))
- (if (and properties
- (eq buffer (aref properties 3)))
- (progn
-
- ;; Parse the buffer, slicing out the 2nd and 4th fields as name and title.
- ;;
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t]+[ \t]+\\([^ \t]+\\)[ \t]+[^ \t]+[ \t]+\"+\\(.*\\)\"$" nil t)
- (let ((id (buffer-substring (match-beginning 1)
- (match-end 1)))
- (title (buffer-substring (match-beginning 2)
- (match-end 2))))
- (setq activity-list (cons (cons id title)
- activity-list))))
-
- ;; We've got activity-list in the reverse order that
- ;; cleartool+lsactivity generated them. I think this is reverse
- ;; chronological order, so keep this order since it is more
- ;; convenient when setting to an activity.
- ;;
- ;;(setq activity-list (nreverse activity-list))
-
- (clearcase-vprop-set-activities clearcase-vprop-async-viewtag activity-list))
-
- (kill-buffer buffer))))
- (message "Parsing view activities...done")))
-
-;;{{{ old synchronous activity reader
-
-;; (defun clearcase-vprop-read-activities-synchronously (viewtag)
-;; "Return a list of (activity-name . title) pairs for VIEWTAG"
-;; ;; nyi: ought to use a variant of clearcase-ct-blocking-call that returns a buffer
-;; ;; rather than a string
-
-;; ;; Performance: takes around 30 seconds to read 1000 activities.
-;; ;; Too slow to invoke willy-nilly on integration streams for example,
-;; ;; which typically can have 1000+ activities.
-
-;; (let ((ret (clearcase-ct-blocking-call "lsact" "-view" viewtag)))
-;; (let ((buf (get-buffer-create "*clearcase-temp-activities*"))
-;; (activity-list nil))
-;; (save-excursion
-;; (set-buffer buf)
-;; (erase-buffer)
-;; (insert ret)
-;; (goto-char (point-min))
-;; ;; Slice out the 2nd and 4th fields as name and title
-;; ;;
-;; (while (re-search-forward "^[^ \t]+[ \t]+\\([^ \t]+\\)[ \t]+[^ \t]+[ \t]+\"+\\(.*\\)\"$" nil t)
-;; (setq activity-list (cons (cons (buffer-substring (match-beginning 1)
-;; (match-end 1))
-;; (buffer-substring (match-beginning 2)
-;; (match-end 2)))
-;; activity-list)))
-;; (kill-buffer buf))
-
-;; ;; We've got activity-list in the reverse order that
-;; ;; cleartool+lsactivity generated them. I think this is reverse
-;; ;; chronological order, so keep this order since it is more
-;; ;; convenient when setting to an activity.
-;; ;;
-;; ;;(nreverse activity-list))))
-;; activity-list)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Determining if a checkout was modified.
-
-;; How to tell if a file changed since checkout ?
-;;
-;; In the worst case we actually run "ct diff -pred" but we attempt several
-;; less expensive tests first.
-;;
-;; 1. If it's size differs from pred.
-;; 2. The mtime and the ctime are no longer the same.
-;;
-;; nyi: Other cheaper tests we could use:
-;;
-;; (a) After each Emacs-driven checkout go and immediately fetch the mtime of
-;; the file and store as fprop-checkout-mtime. Then use that to compare
-;; against current mtime. This at least would make this function work
-;; right on files checked out by the current Emacs process.
-;;
-;; (b) In the MVFS, after each Emacs-driven checkout go and immediately fetch
-;; the OID and store as fprop-checkout-oid. Then use that to compare
-;; against the current oid (the MVFS assigns a new OID at each write).
-;; This might not always be a win since we'd still need to run cleartool
-;; to get the current OID.
-
-(defun clearcase-file-appears-modified-since-checkout-p (file)
- "Return whether FILE appears to have been modified since checkout.
-It doesn't examine the file contents."
-
- (if (not (clearcase-fprop-checked-out file))
- nil
-
- (let ((mvfs (clearcase-file-is-in-mvfs-p file)))
-
- ;; We consider various cases in order of increasing cost to compute.
-
- (cond
- ;; Case 1: (MVFS only) the size is different to its predecessor.
- ;;
- ((and mvfs
- (not
- (equal
- (clearcase-utl-file-size file)
- ;; nyi: For the snapshot case it'd be nice to get the size of the
- ;; predecessor by using "ct+desc -pred -fmt" but there doesn't
- ;; seem to be a format descriptor for file size. On the other hand
- ;; ct+dump can obtain the size.
- ;;
- (clearcase-utl-file-size (clearcase-vxpath-cons-vxpath
- file
- (clearcase-fprop-predecessor-version
- file)))))
- ;; Return:
- ;;
- 'size-changed))
-
- ;; Case 2: (MVFS only) the mtime and the ctime are no longer the same.
- ;;
- ;; nyi: At least on Windows there seems to be a small number of seconds
- ;; difference here even when the file is not modified.
- ;; So we really check to see of they are close.
- ;;
- ;; nyi: This doesn't work in a snapshot view.
- ;;
- ((and mvfs
- (not (clearcase-utl-filetimes-close (clearcase-utl-file-mtime file)
- (clearcase-utl-file-ctime file)
- 5))
- ;; Return:
- ;;
- 'ctime-mtime-not-close))
-
- (t
- ;; Case 3: last resort. Actually run a diff against predecessor.
- ;;
- (let ((ret (clearcase-ct-blocking-call "diff"
- "-options"
- "-quiet"
- "-pred"
- file)))
- (if (not (zerop (length ret)))
- ;; Return:
- ;;
- 'diffs-nonempty
-
- ;; Return:
- ;;
- nil)))))))
-
-;;}}}
-
-;;{{{ Tests for view-residency
-
-;;{{{ Tests for MVFS file residency
-
-;; nyi: probably superseded by clearcase-file-would-be-in-view-p
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; nyi: this should get at least partially invalidated when
-;; VOBs are unmounted.
-
-;; nyi: make this different for NT
-;;
-(defvar clearcase-always-mvfs-regexp (if (not clearcase-on-mswindows)
- "^/vobs/[^/]+/"
-
- ;; nyi: express this using drive variable
- ;;
- (concat "^"
- "[Mm]:"
- clearcase-pname-sep-regexp)))
-
-;; This prevents the clearcase-file-vob-root function from pausing for long periods
-;; stat-ing /net/host@@
-;;
-;; nyi: is there something equivalent on NT I need to avoid ?
-;;
-
-(defvar clearcase-never-mvfs-regexps (if clearcase-on-mswindows
- nil
- '(
- "^/net/[^/]+/"
- "^/tmp_mnt/net/[^/]+/"
- ))
- "Regexps matching those paths we can assume are never inside the MVFS.")
-
-(defvar clearcase-known-vob-root-cache nil)
-
-(defun clearcase-file-would-be-in-mvfs-p (filename)
- "Return whether FILE, after it is created, would reside in an MVFS filesystem."
- (let ((truename (file-truename filename)))
- (if (file-exists-p truename)
- (clearcase-file-is-in-mvfs-p truename)
- (let ((containing-dir (file-name-as-directory (file-name-directory truename))))
- (clearcase-file-is-in-mvfs-p containing-dir)))))
-
-(defun clearcase-file-is-in-mvfs-p (filename)
- "Return whether existing FILE, resides in an MVFS filesystem."
- (let ((truename (file-truename filename)))
-
- (or
- ;; case 1: its prefix matches an "always VOB" prefix like /vobs/...
- ;;
- ;; nyi: problem here: we return true for "/vobs/nonexistent/"
- ;;
- (numberp (string-match clearcase-always-mvfs-regexp truename))
-
- ;; case 2: it has a prefix which is a known VOB-root
- ;;
- (clearcase-file-matches-vob-root truename clearcase-known-vob-root-cache)
-
- ;; case 3: it has an ancestor dir which is a newly met VOB-root
- ;;
- (clearcase-file-vob-root truename))))
-
-(defun clearcase-wd-is-in-mvfs ()
- "Return whether the current directory resides in an MVFS filesystem."
- (clearcase-file-is-in-mvfs-p (file-truename ".")))
-
-(defun clearcase-file-matches-vob-root (truename vob-root-list)
- "Return whether TRUENAME has a prefix in VOB-ROOT-LIST."
- (if (null vob-root-list)
- nil
- (or (numberp (string-match (regexp-quote (car vob-root-list))
- truename))
- (clearcase-file-matches-vob-root truename (cdr vob-root-list)))))
-
-(defun clearcase-file-vob-root (truename)
- "File the highest versioned directory in TRUENAME."
-
- ;; Use known non-MVFS patterns to rule some paths out.
- ;;
- (if (apply (function clearcase-utl-or-func)
- (mapcar (function (lambda (regexp)
- (string-match regexp truename)))
- clearcase-never-mvfs-regexps))
- nil
- (let ((previous-dir nil)
- (dir (file-name-as-directory (file-name-directory truename)))
- (highest-versioned-directory nil))
-
- (while (not (string-equal dir previous-dir))
- (if (clearcase-file-covers-element-p dir)
- (setq highest-versioned-directory dir))
- (setq previous-dir dir)
- (setq dir (file-name-directory (directory-file-name dir))))
-
- (if highest-versioned-directory
- (add-to-list 'clearcase-known-vob-root-cache highest-versioned-directory))
-
- highest-versioned-directory)))
-
-;; Note: you should probably be using clearcase-fprop-mtype instead of this
-;; unless you really know what you're doing (nyi: check usages of this.)
-;;
-(defun clearcase-file-covers-element-p (path)
- "Determine quickly if PATH refers to a Clearcase element,
-without caching the result."
-
- ;; nyi: Even faster: consult the fprop cache first ?
-
- (let ((element-dir (concat (clearcase-vxpath-element-part path) clearcase-vxpath-glue)))
- (and (file-exists-p path)
- (file-directory-p element-dir))))
-
-;;}}}
-
-;;{{{ Tests for snapshot view residency
-
-;; nyi: probably superseded by clearcase-file-would-be-in-view-p
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar clearcase-known-snapshot-root-cache nil)
-
-(defun clearcase-file-would-be-in-snapshot-p (filename)
- "Return whether FILE, after it is created, would reside in a snapshot view.
-If so, return the viewtag."
- (let ((truename (file-truename filename)))
- (if (file-exists-p truename)
- (clearcase-file-is-in-snapshot-p truename)
- (let ((containing-dir (file-name-as-directory (file-name-directory truename))))
- (clearcase-file-is-in-snapshot-p containing-dir)))))
-
-(defun clearcase-file-is-in-snapshot-p (truename)
- "Return whether existing FILE, resides in a snapshot view.
-If so, return the viewtag."
-
- (or
- ;; case 1: it has a prefix which is a known snapshot-root
- ;;
- (clearcase-file-matches-snapshot-root truename clearcase-known-snapshot-root-cache)
-
- ;; case 2: it has an ancestor dir which is a newly met VOB-root
- ;;
- (clearcase-file-snapshot-root truename)))
-
-(defun clearcase-wd-is-in-snapshot ()
- "Return whether the current directory resides in a snapshot view."
- (clearcase-file-is-in-snapshot-p (file-truename ".")))
-
-(defun clearcase-file-matches-snapshot-root (truename snapshot-root-list)
- "Return whether TRUENAME has a prefix in SNAPSHOT-ROOT-LIST."
- (if (null snapshot-root-list)
- nil
- (or (numberp (string-match (regexp-quote (car snapshot-root-list))
- truename))
- (clearcase-file-matches-snapshot-root truename (cdr snapshot-root-list)))))
-
-;; This prevents the clearcase-file-snapshot-root function from pausing for long periods
-;; stat-ing /net/host@@
-;;
-;; nyi: is there something equivalent on NT I need to avoid ?
-;;
-
-(defvar clearcase-never-snapshot-regexps (if clearcase-on-mswindows
- nil
- '(
- "^/net/[^/]+/"
- "^/tmp_mnt/net/[^/]+/"
- ))
- "Regexps matching those paths we can assume are never inside a snapshot view.")
-
-(defun clearcase-file-snapshot-root (truename)
- "File the the snapshot view root containing TRUENAME."
-
- ;; Use known non-snapshot patterns to rule some paths out.
- ;;
- (if (apply (function clearcase-utl-or-func)
- (mapcar (function (lambda (regexp)
- (string-match regexp truename)))
- clearcase-never-snapshot-regexps))
- nil
- (let ((previous-dir nil)
- (dir (file-name-as-directory (file-name-directory truename)))
- (viewtag nil)
- (viewroot nil))
-
-
- (while (and (not (string-equal dir previous-dir))
- (null viewtag))
-
- ;; See if .view.dat exists and contains a valid view uuid
- ;;
- (let ((view-dat-name (concat dir (if clearcase-on-mswindows
- "view.dat" ".view.dat"))))
- (if (file-readable-p view-dat-name)
- (let ((uuid (clearcase-viewdat-to-uuid view-dat-name)))
- (if uuid
- (progn
- (setq viewtag (clearcase-view-uuid-to-tag uuid))
- (if viewtag
- (setq viewroot dir)))))))
-
- (setq previous-dir dir)
- (setq dir (file-name-directory (directory-file-name dir))))
-
- (if viewroot
- (add-to-list 'clearcase-known-snapshot-root-cache viewroot))
-
- ;; nyi: update a viewtag==>viewroot map ?
-
- viewroot)))
-
-(defun clearcase-viewdat-to-uuid (file)
- "Extract the view-uuid from a .view.dat file."
- ;; nyi, but return non-nil so clearcase-file-snapshot-root works
- t
- )
-
-(defun clearcase-view-uuid-to-tag (uuid)
- "Look up the view-uuid in the register to discover its tag."
- ;; nyi, but return non-nil so clearcase-file-snapshot-root works
- t
- )
-
-;;}}}
-
-;; This is simple-minded but seems to work because cleartool+describe
-;; groks snapshot views.
-;;
-;; nyi: Might be wise to cache view-roots to speed this up because the
-;; filename-handlers call this.
-;;
-;; nyi: Some possible shortcuts
-;; 1. viewroot-relative path [syntax]
-;; 2. under m:/ on NT [syntax]
-;; 3. setviewed on Unix [find a containing VOB-root]
-;; 4. subst-ed view on NT (calling net use seems very slow though)
-;; [find a containing VOB-root]
-;; 5. snapshot view
-;;
-(defun clearcase-file-would-be-in-view-p (filename)
- "Return whether FILE, after it is created, would reside in a ClearCase view."
- (let ((truename (file-truename (expand-file-name filename))))
-
- ;; We use clearcase-path-file-really-exists-p here to make sure we are dealing
- ;; with a real file and not something faked by Emacs' file name handlers
- ;; like Ange-FTP.
- ;;
- (if (clearcase-path-file-really-exists-p truename)
- (clearcase-file-is-in-view-p truename)
- (let ((containing-dir (file-name-as-directory (file-name-directory truename))))
- (and (clearcase-path-file-really-exists-p containing-dir)
- (clearcase-file-is-in-view-p containing-dir))))))
-
-(defun clearcase-file-is-in-view-p (filename)
- (let ((truename (file-truename (expand-file-name filename))))
- ;; Shortcut if the file is a version-extended path.
- ;;
- (or (clearcase-file-snapshot-root truename)
- (clearcase-vxpath-p truename)
- (clearcase-fprop-mtype truename)
-
- ;; nyi: How to efficiently know if we're in a dynamic-view root
- ;; 1. Test each contained name for elementness.
- ;; Too inefficient.
- ;; 2. If it is viewroot-relative.
- ;; Okay but not sufficient.
- ;; How about case v:/ when view is substed ?
- ;; 3. We're setviewed.
- ;; Okay but not sufficient.
- ;; Maintain a cache of viewroots ?
- )))
-
-(defun clearcase-file-viewtag (filename)
- "Find the viewtag associated with existing FILENAME."
-
- (clearcase-when-debugging
- (assert (file-exists-p filename)))
-
- (let ((truename (file-truename (expand-file-name filename))))
- (cond
-
- ;; Case 1: viewroot-relative path
- ;; ==> syntax
- ;;
- ((clearcase-vrpath-p truename)
- (clearcase-vrpath-viewtag truename))
-
- ;; Case 2: under m:/ on NT
- ;; ==> syntax
- ;;
- ((and clearcase-on-mswindows
- (string-match (concat clearcase-viewroot-drive
- clearcase-pname-sep-regexp
- "\\("
- clearcase-non-pname-sep-regexp "*"
- "\\)"
- )
- truename))
- (substring truename (match-beginning 1) (match-end 1)))
-
- ;; Case 3: setviewed on Unix
- ;; ==> read EV, but need to check it's beneath a VOB-root
- ;;
- ((and clearcase-setview-viewtag
- (clearcase-file-would-be-in-mvfs-p truename))
- clearcase-setview-viewtag)
-
- ;; Case 4: subst-ed view on NT
- ;; ==> use ct+pwv -wdview
- ;; Case 5: snapshot view
- ;; ==> use ct+pwv -wdview
- (t
- (clearcase-file-wdview truename)))))
-
-(defun clearcase-file-wdview (truename)
- "Return the working-directory view associated with TRUENAME,
-or nil if none"
- (let ((default-directory (if (file-directory-p truename)
- truename
- (file-name-directory truename))))
- (clearcase-ct-cd default-directory)
- (let ((ret (clearcase-ct-blocking-call "pwv" "-wdview" "-short")))
- (if (not (string-match " NONE " ret))
- (clearcase-utl-1st-line-of-string ret)))))
-
-;;}}}
-
-;;{{{ The cleartool sub-process
-
-;; We use pipes rather than pty's for two reasons:
-;;
-;; 1. NT only has pipes
-;; 2. On Solaris there appeared to be a problem in the pty handling part
-;; of Emacs, which resulted in Emacs/tq seeing too many cleartool prompt
-;; strings. This would occasionally occur and prevent the tq-managed
-;; interactions with the cleartool sub-process from working correctly.
-;;
-;; Now we use pipes. Cleartool detects the "non-tty" nature of the output
-;; device and doesn't send a prompt. We manufacture an end-of-transaction
-;; marker by sending a "pwd -h" after each cleartool sub-command and then use
-;; the expected output of "Usage: pwd\n" as our end-of-txn pattern for tq.
-;;
-;; Even using pipes, the semi-permanent outboard-process using tq doesn't work
-;; well on NT. There appear to be bugs in accept-process-output such that:
-;; 0. there apparently were hairy race conditions, which a sprinkling
-;; of (accept-process-output nil 1) seemed to avoid somewhat.
-;; 1. it never seems to timeout if you name a process as arg1.
-;; 2. it always seems to wait for TIMEOUT, even if there is output ready.
-;; The result seemed to be less responsive tha just calling a fresh cleartool
-;; process for each invocation of clearcase-ct-blocking-call
-;;
-;; It still seems worthwhile to make it work on NT, as clearcase-ct-blocking-call
-;; typically takes about 0.5 secs on NT versus 0.05 sec on Solaris,
-;; an order of magnitude difference.
-;;
-
-(defconst clearcase-ct-eotxn-cmd "pwd -h\n")
-(defconst clearcase-ct-eotxn-response "Usage: pwd\n")
-(defconst clearcase-ct-eotxn-response-length (length clearcase-ct-eotxn-response))
-
-(defconst clearcase-ct-subproc-timeout 30
- "Timeout on calls to subprocess")
-
-(defvar clearcase-ct-tq nil
- "Transaction queue to talk to ClearTool in a subprocess")
-
-(defvar clearcase-ct-return nil
- "Return value when we're involved in a blocking call")
-
-(defvar clearcase-ct-view ""
- "Current view of cleartool subprocess, or the empty string if none")
-
-(defvar clearcase-ct-wdir ""
- "Current working directory of cleartool subprocess,
-or the empty string if none")
-
-(defvar clearcase-ct-running nil)
-
-(defun clearcase-ct-accept-process-output (proc timeout)
- (accept-process-output proc timeout))
-
-(defun clearcase-ct-start-cleartool ()
- (interactive)
- (clearcase-trace "clearcase-ct-start-cleartool()")
- (let ((process-environment (append '("ATRIA_NO_BOLD=1"
- "ATRIA_FORCE_GUI=1")
- ;;; emacs is a GUI, right? :-)
- process-environment)))
- (clearcase-trace (format "Starting cleartool in %s" default-directory))
- (let* ( ;; Force the use of a pipe
- ;;
- (process-connection-type nil)
- (cleartool-process
- (start-process "cleartool" ;; Absolute path won't work here
- " *cleartool*"
- clearcase-cleartool-path)))
- (process-kill-without-query cleartool-process)
- (setq clearcase-ct-view "")
- (setq clearcase-ct-tq (tq-create cleartool-process))
- (tq-enqueue clearcase-ct-tq
- clearcase-ct-eotxn-cmd ;; question
- clearcase-ct-eotxn-response ;; regexp
- 'clearcase-ct-running ;; closure
- 'set) ;; function
- (while (not clearcase-ct-running)
- (message "waiting for cleartool to start...")
- (clearcase-ct-accept-process-output (tq-process clearcase-ct-tq)
- clearcase-ct-subproc-timeout))
- ;; Assign a sentinel to restart it if it dies.
- ;; nyi: This needs debugging.
- ;;(set-process-sentinel cleartool-process 'clearcase-ct-sentinel)
-
- (clearcase-trace "clearcase-ct-start-cleartool() done")
- (message "waiting for cleartool to start...done"))))
-
-;; nyi: needs debugging.
-;;
-(defun clearcase-ct-sentinel (process event-string)
- (clearcase-trace (format "Cleartool process sentinel called: %s" event-string))
- (if (not (eq 'run (process-status process)))
- (progn
- ;; Restart the dead cleartool.
- ;;
- (clearcase-trace "Cleartool process restarted")
- (clearcase-ct-start-cleartool))))
-
-(defun clearcase-ct-kill-cleartool ()
- "Kill off cleartool subprocess. If another one is needed,
-it will be restarted. This may be useful if you're debugging clearcase."
- (interactive)
- (clearcase-ct-kill-tq))
-
-(defun clearcase-ct-callback (arg val)
- (clearcase-trace (format "clearcase-ct-callback:<\n"))
- (clearcase-trace val)
- (clearcase-trace (format "clearcase-ct-callback:>\n"))
- ;; This can only get called when the last thing received from
- ;; the cleartool sub-process was clearcase-ct-eotxn-response,
- ;; so it is safe to just remove it here.
- ;;
- (setq clearcase-ct-return (substring val 0 (- clearcase-ct-eotxn-response-length))))
-
-(defun clearcase-ct-do-cleartool-command (command file comment &optional extra-args)
- "Execute a cleartool command, notifying user and checking for
-errors. Output from COMMAND goes to buffer *clearcase*. The last argument of the
-command is the name of FILE; this is appended to an optional list of
-EXTRA-ARGS."
-
- (if file
- (setq file (expand-file-name file)))
- (if (listp command)
- (error "command must not be a list"))
- (if clearcase-command-messages
- (if file
- (message "Running %s on %s..." command file)
- (message "Running %s..." command)))
- (let ((camefrom (current-buffer))
- (squeezed nil)
- status)
- (set-buffer (get-buffer-create "*clearcase*"))
- (setq buffer-read-only nil)
- (erase-buffer)
- (set (make-local-variable 'clearcase-parent-buffer) camefrom)
- (set (make-local-variable 'clearcase-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
-
- ;; This is so that command arguments typed in the *clearcase* buffer will
- ;; have reasonable defaults.
- ;;
- (if file
- (setq default-directory (file-name-directory file)))
-
- (mapcar
- (function (lambda (s)
- (and s
- (not (zerop (length s)))
- (setq squeezed
- (append squeezed (list s))))))
- extra-args)
-
- (clearcase-with-tempfile
- comment-file
- (if (not (eq comment 'unused))
- (if comment
- (progn
- (write-region comment nil comment-file nil 'noprint)
- (setq squeezed (append squeezed (list "-cfile" (clearcase-path-native comment-file)))))
- (setq squeezed (append squeezed (list "-nc")))))
- (if file
- (setq squeezed (append squeezed (list (clearcase-path-native file)))))
- (let ((default-directory (file-name-directory
- (or file default-directory))))
- (clearcase-ct-cd default-directory)
- (if clearcase-command-messages
- (message "Running %s..." command))
- (insert
- (apply 'clearcase-ct-cleartool-cmd (append (list command) squeezed)))
- (if clearcase-command-messages
- (message "Running %s...done" command))))
-
- (goto-char (point-min))
- (clearcase-view-mode 0 camefrom)
- (set-buffer-modified-p nil) ; XEmacs - fsf uses `not-modified'
- (if (re-search-forward "^cleartool: Error:.*$" nil t)
- (progn
- (setq status (buffer-substring (match-beginning 0) (match-end 0)))
- (clearcase-port-view-buffer-other-window "*clearcase*")
- (shrink-window-if-larger-than-buffer)
- (error "Running %s...FAILED (%s)" command status))
- (if clearcase-command-messages
- (message "Running %s...OK" command)))
- (set-buffer camefrom)
- status))
-
-(defun clearcase-ct-cd (dir)
- (if (or (not dir)
- (string= dir clearcase-ct-wdir))
- clearcase-ct-wdir
- (clearcase-ct-blocking-call "cd" (clearcase-path-native dir))
- (setq clearcase-ct-wdir dir)))
-
-(defun clearcase-ct-cleartool-cmd (&rest cmd)
- (apply 'clearcase-ct-blocking-call cmd))
-
-;; NT Emacs - needs a replacement for tq.
-;;
-(defun clearcase-ct-get-command-stdout (program &rest args)
- "Call PROGRAM.
-Returns PROGRAM's stdout.
-ARGS is the command line arguments to PROGRAM."
- (let ((buf (get-buffer-create "cleartoolexecution")))
- (prog1
- (save-excursion
- (set-buffer buf)
- (apply 'call-process program nil buf nil args)
- (buffer-string))
- (kill-buffer buf))))
-
-;; The TQ interaction still doesn't work on NT.
-;;
-(defvar clearcase-disable-tq clearcase-on-mswindows
- "Set to T if the Emacs/cleartool interactions via tq are not working right.")
-
-(defun clearcase-ct-blocking-call (&rest cmd)
- (clearcase-trace (format "clearcase-ct-blocking-call(%s)" cmd))
- (save-excursion
- (setq clearcase-ct-return nil)
-
- (if clearcase-disable-tq
- ;; Don't use tq:
- ;;
- (setq clearcase-ct-return (apply 'clearcase-ct-get-command-stdout
- clearcase-cleartool-path cmd))
-
- ;; Use tq:
- ;;
- (setq clearcase-ct-return nil)
- (if (not clearcase-ct-tq)
- (clearcase-ct-start-cleartool))
- (unwind-protect
- (let ((command ""))
- (mapcar
- (function
- (lambda (token)
- ;; If the token has imbedded spaces and is not already quoted,
- ;; add double quotes.
- ;;
- (setq command (concat command
- " "
- (clearcase-utl-quote-if-nec token)))))
- cmd)
- (tq-enqueue clearcase-ct-tq
- (concat command "\n"
- clearcase-ct-eotxn-cmd) ;; question
- clearcase-ct-eotxn-response ;; regexp
- nil ;; closure
- 'clearcase-ct-callback) ;; function
- (while (not clearcase-ct-return)
- (clearcase-ct-accept-process-output (tq-process clearcase-ct-tq)
- clearcase-ct-subproc-timeout)))
- ;; Error signalled:
- ;;
- (while (tq-queue clearcase-ct-tq)
- (tq-queue-pop clearcase-ct-tq)))))
- (if (string-match "cleartool: Error:" clearcase-ct-return)
- (error "cleartool process error %s: "
- (substring clearcase-ct-return (match-end 0))))
- (clearcase-trace (format "command-result(%s)" clearcase-ct-return))
- clearcase-ct-return)
-
-(defun clearcase-ct-kill-tq ()
- (setq clearcase-ct-running nil)
- (setq clearcase-ct-tq nil)
- (process-send-eof (tq-process clearcase-ct-tq))
- (kill-process (tq-process clearcase-ct-tq)))
-
-(defun clearcase-ct-kill-buffer-hook ()
-
- ;; NT Emacs - doesn't use tq.
- ;;
- (if (not clearcase-on-mswindows)
- (let ((kill-buffer-hook nil))
- (if (and (boundp 'clearcase-ct-tq)
- clearcase-ct-tq
- (eq (current-buffer) (tq-buffer clearcase-ct-tq)))
- (error "Don't kill TQ buffer %s, use `clearcase-ct-kill-tq'" (current-buffer))))))
-
-(add-hook 'kill-buffer-hook 'clearcase-ct-kill-buffer-hook)
-
-;;}}}
-
-;;{{{ Invoking a command
-
-;; nyi Would be redundant if we didn't need it to invoke normal-diff-program
-
-(defun clearcase-do-command (okstatus command file &optional extra-args)
- "Execute a version-control command, notifying user and checking for errors.
-The command is successful if its exit status does not exceed OKSTATUS.
-Output from COMMAND goes to buffer *clearcase*. The last argument of the command is
-an optional list of EXTRA-ARGS."
- (setq file (expand-file-name file))
- (if clearcase-command-messages
- (message "Running %s on %s..." command file))
- (let ((camefrom (current-buffer))
- (pwd )
- (squeezed nil)
- status)
- (set-buffer (get-buffer-create "*clearcase*"))
- (setq buffer-read-only nil)
- (erase-buffer)
- (set (make-local-variable 'clearcase-parent-buffer) camefrom)
- (set (make-local-variable 'clearcase-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
- ;; This is so that command arguments typed in the *clearcase* buffer will
- ;; have reasonable defaults.
- ;;
- (setq default-directory (file-name-directory file)
- file (file-name-nondirectory file))
-
- (mapcar
- (function (lambda (s)
- (and s
- (not (zerop (length s)))
- (setq squeezed
- (append squeezed (list s))))))
- extra-args)
- (setq squeezed (append squeezed (list file)))
- (setq status (apply 'call-process command nil t nil squeezed))
- (goto-char (point-min))
- (clearcase-view-mode 0 camefrom)
- (set-buffer-modified-p nil) ; XEmacs - fsf uses `not-modified'
- (if (or (not (integerp status)) (< okstatus status))
- (progn
- (clearcase-port-view-buffer-other-window "*clearcase*")
- (shrink-window-if-larger-than-buffer)
- (error "Running %s...FAILED (%s)" command
- (if (integerp status)
- (format "status %d" status)
- status)))
- (if clearcase-command-messages
- (message "Running %s...OK" command)))
- (set-buffer camefrom)
- status))
-
-;;}}}
-
-;;{{{ Viewtag management
-
-;;{{{ Started views
-
-(defun clearcase-viewtag-try-to-start-view (viewtag)
- "If VIEW is not apparently already visible under viewroot, start it."
- (if (not (member viewtag (clearcase-viewtag-started-viewtags)))
- (clearcase-viewtag-start-view viewtag)))
-
-(defun clearcase-viewtag-started-viewtags-alist ()
- "Return an alist of views that are currently visible under the viewroot."
- (mapcar
- (function
- (lambda (tag)
- (list (concat tag "/"))))
- (clearcase-viewtag-started-viewtags)))
-
-(defun clearcase-viewtag-started-viewtags ()
- "Return the list of viewtags already visible under the viewroot."
- (let ((raw-list (if clearcase-on-mswindows
- (directory-files clearcase-viewroot-drive)
- (directory-files clearcase-viewroot))))
- (clearcase-utl-list-filter
- (function (lambda (string)
- ;; Exclude the ones that start with ".",
- ;; and the ones that end with "@@".
- ;;
- (and (not (equal ?. (aref string 0)))
- (not (string-match "@@$" string)))))
- raw-list)))
-
-;; nyi: Makes sense on NT ?
-;; Probably also want to run subst ?
-;; Need a better high-level interface to start-view
-;;
-(defun clearcase-viewtag-start-view (viewtag)
- "If VIEWTAG is in our cache of valid view names, start it."
- (if (clearcase-viewtag-exists viewtag)
- (progn
- (message "Starting view server for %s..." viewtag)
- (clearcase-ct-blocking-call "startview" viewtag)
- (message "Starting view server for %s...done" viewtag))))
-
-;;}}}
-
-;;{{{ All views
-
-;;{{{ Internals
-
-(defvar clearcase-viewtag-cache nil
- "Oblist of all known viewtags.")
-
-(defvar clearcase-viewtag-dir-cache nil
- "Oblist of all known viewtag dirs.")
-
-(defvar clearcase-viewtag-cache-timeout 1800
- "*Default timeout of all-viewtag cache, in seconds.")
-
-(defun clearcase-viewtag-schedule-cache-invalidation ()
- "Schedule the next invalidation of clearcase-viewtag-cache."
- (run-at-time (format "%s sec" clearcase-viewtag-cache-timeout)
- nil
- (function (lambda (&rest ignore)
- (setq clearcase-viewtag-cache nil)))
- nil))
-;; Some primes:
-;;
-;; 1,
-;; 2,
-;; 3,
-;; 7,
-;; 17,
-;; 31,
-;; 61,
-;; 127,
-;; 257,
-;; 509,
-;; 1021,
-;; 2053,
-
-(defun clearcase-viewtag-read-all-viewtags ()
- "Invoke ct+lsview to get all viewtags, and return an obarry containing them."
- (message "Fetching view names...")
- (let* ((default-directory "/")
- (result (make-vector 1021 0))
- (raw-views-string (clearcase-ct-blocking-call "lsview" "-short"))
- (view-list (clearcase-utl-split-string-at-char raw-views-string ?\n)))
- (message "Fetching view names...done")
- (mapcar (function (lambda (string)
- (set (intern string result) t)))
- view-list)
- result))
-
-(defun clearcase-viewtag-populate-caches ()
- (setq clearcase-viewtag-cache (clearcase-viewtag-read-all-viewtags))
- (let ((dir-cache (make-vector 1021 0)))
- (mapatoms
- (function (lambda (sym)
- (set (intern (concat (symbol-name sym) "/") dir-cache) t)))
- clearcase-viewtag-cache)
- (setq clearcase-viewtag-dir-cache dir-cache))
- (clearcase-viewtag-schedule-cache-invalidation))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;}}}
-
-;; Exported interfaces
-
-;; This is for completion of viewtags.
-;;
-(defun clearcase-viewtag-all-viewtags-obarray ()
- "Return an obarray of all valid viewtags as of the last time we looke d."
- (if (null clearcase-viewtag-cache)
- (clearcase-viewtag-populate-caches))
- clearcase-viewtag-cache)
-
-;; This is for completion of viewtag dirs, like /view/my_view_name/
-;; The trailing slash is required for compatibility with other instances
-;; of filename completion in Emacs.
-;;
-(defun clearcase-viewtag-all-viewtag-dirs-obarray ()
- "Return an obarray of all valid viewtag directory names as of the last time we looked."
- (if (null clearcase-viewtag-dir-cache)
- (clearcase-viewtag-populate-caches))
- clearcase-viewtag-dir-cache)
-
-(defun clearcase-viewtag-exists (viewtag)
- (symbol-value (intern-soft viewtag (clearcase-viewtag-all-viewtags-obarray))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Pathnames
-
-;;{{{ Pathnames: version-extended
-
-(defun clearcase-vxpath-p (path)
- (or (string-match (concat clearcase-vxpath-glue "/") path)
- (string-match (concat clearcase-vxpath-glue "\\\\") path)))
-
-(defun clearcase-vxpath-element-part (vxpath)
- "Return the element part of version-extended PATH."
- (if (string-match clearcase-vxpath-glue vxpath)
- (substring vxpath 0 (match-beginning 0))
- vxpath))
-
-(defun clearcase-vxpath-version-part (vxpath)
- "Return the version part of version-extended PATH."
- (if (string-match clearcase-vxpath-glue vxpath)
- (substring vxpath (match-end 0))
- nil))
-
-(defun clearcase-vxpath-branch (vxpath)
- "Return the branch part of a version-extended path or of a version"
- (if (clearcase-vxpath-p vxpath)
- (clearcase-vxpath-cons-vxpath
- (clearcase-vxpath-element-part vxpath)
- (file-name-directory (clearcase-vxpath-version-part vxpath)))
- (file-name-directory vxpath)))
-
-(defun clearcase-vxpath-version (vxpath)
- "Return the numeric version part of a version-extended path or of a version"
- (if (clearcase-vxpath-p vxpath)
- (file-name-nondirectory (clearcase-vxpath-version-part vxpath))
- (file-name-nondirectory vxpath)))
-
-(defun clearcase-vxpath-cons-vxpath (file version &optional viewtag)
- "Make a ClearCase version-extended pathname for ELEMENT's version VERSION.
-If ELEMENT is actually a version-extended pathname, substitute VERSION for
-the version included in ELEMENT. If VERSION is nil, remove the version-extended
-pathname.
-
-If optional VIEWTAG is specified, make a view-relative pathname, possibly
-replacing the existing view prefix."
- (let* ((element (clearcase-vxpath-element-part file))
- (glue-fmt (if (and (> (length version) 0)
- (= (aref version 0) ?/))
- (concat "%s" clearcase-vxpath-glue "%s")
- (concat "%s" clearcase-vxpath-glue "/%s")))
- (relpath (clearcase-vrpath-tail element)))
- (if viewtag
- (setq element (concat clearcase-viewroot "/" viewtag (or relpath element))))
- (if version
- (format glue-fmt element version)
- element)))
-
-;; NYI: This should cache the predecessor version as a property
-;; of the file.
-;;
-(defun clearcase-vxpath-of-predecessor (file)
- "Compute the version-extended pathname of the predecessor version of FILE."
- (if (not (equal 'version (clearcase-fprop-mtype file)))
- (error "Not a clearcase version: %s" file))
- (let ((abs-file (expand-file-name file)))
- (let ((ver (clearcase-utl-1st-line-of-string
- (clearcase-ct-cleartool-cmd "describe"
- "-pred"
- "-short"
- (clearcase-path-native abs-file)))))
- (clearcase-path-canonicalise-slashes (concat
- (clearcase-vxpath-element-part file)
- clearcase-vxpath-glue
- ver)))))
-
-(defun clearcase-vxpath-version-extend (file)
- "Compute the version-extended pathname of FILE."
- (if (not (equal 'version (clearcase-fprop-mtype file)))
- (error "Not a clearcase version: %s" file))
- (let ((abs-file (expand-file-name file)))
- (clearcase-path-canonicalise-slashes
- (clearcase-utl-1st-line-of-string
- (clearcase-ct-cleartool-cmd "describe"
- "-fmt"
- (concat "%En"
- clearcase-vxpath-glue
- "%Vn")
- (clearcase-path-native abs-file))))))
-
-(defun clearcase-vxpath-of-branch-base (file)
- "Compute the version-extended pathname of the version at the branch base of FILE."
- (let* ((file-version-path
- (if (clearcase-fprop-checked-out file)
- ;; If the file is checked-out, start with its predecessor version...
- ;;
- (clearcase-vxpath-version-extend (clearcase-vxpath-of-predecessor file))
- ;; ...otherwise start with the file's version.
- ;;
- (clearcase-vxpath-version-extend file)))
- (file-version-number (string-to-int (clearcase-vxpath-version file-version-path)))
- (branch (clearcase-vxpath-branch file-version-path)))
- (let* ((base-number 0)
- (base-version-path (format "%s%d" branch base-number)))
- (while (and (not (clearcase-file-is-in-snapshot-p base-version-path))
- (not (file-exists-p base-version-path))
- (< base-number file-version-number))
- (setq base-number (1+ base-number))
- (setq base-version-path (format "%s%d" branch base-number)))
- base-version-path)))
-
-(defun clearcase-vxpath-version-of-branch-base (file)
- (clearcase-vxpath-version-part (clearcase-vxpath-of-branch-base file)))
-
-(defun clearcase-vxpath-get-version-in-buffer (vxpath)
- "Return a buffer containing the version named by VXPATH.
-Intended for use in snapshot views."
- (let* ((temp-file (clearcase-vxpath-get-version-in-temp-file vxpath))
- (buffer (find-file-noselect temp-file t)))
-
- ;; XEmacs throws an error if you delete a read-only file
- ;;
- (if clearcase-xemacs-p
- (if (not (file-writable-p temp-file))
- (set-file-modes temp-file (string-to-number "666" 8))))
-
- (delete-file temp-file)
- buffer))
-
-(defun clearcase-vxpath-get-version-in-temp-file (vxpath)
- "Return the name of a temporary file containing the version named by VXPATH.
-Intended for use in snapshot views."
-
- (let ((temp-file (clearcase-utl-tempfile-name vxpath)))
- (progn
- (clearcase-ct-blocking-call "get"
- "-to"
- (clearcase-path-native temp-file)
- (clearcase-path-native vxpath))
- temp-file)))
-
-;;}}}
-
-;;{{{ Pathnames: viewroot-relative
-
-;; nyi: make all this work with viewroot-drive-relative files too
-
-(defun clearcase-vrpath-p (path)
- "Return whether PATH is viewroot-relative."
- (string-match clearcase-vrpath-regexp path))
-
-(defun clearcase-vrpath-head (vrpath)
- "Given viewroot-relative PATH, return the prefix including the view-tag."
- (if (string-match clearcase-vrpath-regexp vrpath)
- (substring vrpath (match-end 0))))
-
-(defun clearcase-vrpath-tail (vrpath)
- "Given viewroot-relative PATH, return the suffix after the view-tag."
- (if (string-match clearcase-vrpath-regexp vrpath)
- (substring vrpath (match-end 0))))
-
-(defun clearcase-vrpath-viewtag (vrpath)
- "Given viewroot-relative PATH, return the view-tag."
- (if (string-match clearcase-vrpath-regexp vrpath)
- (substring vrpath (match-beginning 1) (match-end 1))))
-
-;; Remove useless viewtags from a pathname.
-;; e.g. if we're setviewed to view "VIEWTAG"
-;; (clearcase-path-remove-useless-viewtags "/view/VIEWTAG/PATH")
-;; ==> "PATH"
-;; (clearcase-path-remove-useless-viewtags "/view/z/view/y/PATH")
-;; ==> /view/y/"PATH"
-;;
-(defvar clearcase-multiple-viewroot-regexp
- (concat "^"
- clearcase-viewroot
- clearcase-pname-sep-regexp
- clearcase-non-pname-sep-regexp "+"
- "\\("
- clearcase-viewroot
- clearcase-pname-sep-regexp
- "\\)"
- ))
-
-(defun clearcase-path-remove-useless-viewtags (pathname)
- ;; Try to avoid file-name-handler recursion here:
- ;;
- (let ((setview-root clearcase-setview-root))
- (if setview-root
- ;; Append "/":
- ;;
- (setq setview-root (concat setview-root "/")))
-
- (cond
-
- ((string-match clearcase-multiple-viewroot-regexp pathname)
- (clearcase-path-remove-useless-viewtags (substring pathname (match-beginning 1))))
-
- ((and setview-root
- (string= setview-root "/"))
- pathname)
-
- ;; If pathname has setview-root as a proper prefix,
- ;; strip it off and recurse:
- ;;
- ((and setview-root
- (< (length setview-root) (length pathname))
- (string= setview-root (substring pathname 0 (length setview-root))))
- (clearcase-path-remove-useless-viewtags (substring pathname (- (length setview-root) 1))))
-
- (t
- pathname))))
-
-;;}}}
-
-;; Don't pass the "INPLACE" parameter to subst-char-in-string here since the
-;; parameter is not necessarily a local variable (in some cases it is
-;; buffer-file-name and replacing / with \ in it wreaks havoc).
-;;
-(defun clearcase-path-canonicalise-slashes (path)
- (if (not clearcase-on-mswindows)
- path
- (subst-char-in-string ?\\ ?/ path)))
-
-(defun clearcase-path-canonical (path)
- (if (not clearcase-on-mswindows)
- path
- (if clearcase-on-cygwin
- (substring (shell-command-to-string (concat "cygpath -u '" path "'")) 0 -1)
- (subst-char-in-string ?\\ ?/ path))))
-
-(defun clearcase-path-native (path)
- (if (not clearcase-on-mswindows)
- path
- (if clearcase-on-cygwin
- (substring (shell-command-to-string (concat "cygpath -w " path)) 0 -1)
- (subst-char-in-string ?/ ?\\ path))))
-
-(defun clearcase-path-file-really-exists-p (filename)
- "Test if a file really exists, when all file-name handlers are disabled."
- (let ((inhibit-file-name-operation 'file-exists-p)
- (inhibit-file-name-handlers (mapcar
- (lambda (pair)
- (cdr pair))
- file-name-handler-alist)))
- (file-exists-p filename)))
-
-(defun clearcase-path-file-in-any-scopes (file scopes)
- (let ((result nil)
- (cursor scopes))
- (while (and (null result)
- cursor)
- (if (clearcase-path-file-in-scope file (car cursor))
- (setq result t))
- (setq cursor (cdr cursor)))
- result))
-
-
-(defun clearcase-path-file-in-scope (file scope)
- (assert (file-name-absolute-p file))
- (assert (file-name-absolute-p scope))
-
- (or
- ;; Pathnames are equal
- ;;
- (string= file scope)
-
- ;; scope-qua-dir is an ancestor of file (proper string prefix)
- ;;
- (let ((scope-as-dir (concat scope "/")))
- (string= scope-as-dir
- (substring file 0 (length scope-as-dir))))))
-
-;;}}}
-
-;;{{{ Mode-line
-
-(defun clearcase-mode-line-buffer-id (filename)
- "Compute an abbreviated version string for the mode-line.
-It will be in one of three forms: /main/NNN, or .../branchname/NNN, or DO-NAME"
-
- (if (clearcase-fprop-checked-out filename)
- (if (clearcase-fprop-reserved filename)
- "RESERVED"
- "UNRESERVED")
- (let ((ver-string (clearcase-fprop-version filename)))
- (if (not (zerop (length ver-string)))
- (let ((i (length ver-string))
- (slash-count 0))
- ;; Search back from the end to the second-last slash
- ;;
- (while (and (> i 0)
- (< slash-count 2))
- (if (equal ?/ (aref ver-string (1- i)))
- (setq slash-count (1+ slash-count)))
- (setq i (1- i)))
- (if (> i 0)
- (concat "..." (substring ver-string i))
- (substring ver-string i)))))))
-
-;;}}}
-
-;;{{{ Minibuffer reading
-
-;;{{{ clearcase-read-version-name
-
-(defun clearcase-read-version-name (prompt file)
- "Display PROMPT and read a version string for FILE in the minibuffer,
-with completion if possible."
- (let* ((insert-default-directory nil)
- ;; XEmacs change: disable dialog-box, to avoid
- ;; Dialog box error: "Creating file-dialog-box",
- ;; "FNERR_INVALIDFILENAME"
- ;;
- (use-dialog-box nil)
- (predecessor (clearcase-fprop-predecessor-version
- file))
- (default-filename (clearcase-vxpath-cons-vxpath file predecessor))
-
- ;; To get this to work it is necessary to make Emacs think
- ;; we're completing with respect to "ELEMENT@@/" rather
- ;; than "ELEMENT@@". Otherwise when we enter a version
- ;; like "/main/NN", it thinks we entered an absolute path.
- ;; So instead, we prompt the user to enter "main/..../NN"
- ;; and add back the leading slash before returning.
- ;;
- (completing-dir (concat file "@@/")))
- ;; XEmacs change: enable completion on Windows.
- ;; Works fine with use-dialog-box nil.
- ;;
- (if (clearcase-file-is-in-mvfs-p file)
- ;; Completion only works in MVFS:
- ;;
- (concat "/" (read-file-name prompt
- completing-dir
- (substring predecessor 1)
- ;;nil
- t
- (substring predecessor 1)))
- (concat "/" (read-string prompt
- (substring predecessor 1)
- nil)))))
-
-;;}}}
-
-;;{{{ clearcase-read-label-name
-
-;; nyi: unused
-
-(defun clearcase-read-label-name (prompt)
- "Read a label name."
-
- (let* ((string (clearcase-ct-cleartool-cmd "lstype"
- "-kind"
- "lbtype"
- "-short"))
- labels)
- (mapcar (function (lambda (arg)
- (if (string-match "(locked)" arg)
- nil
- (setq labels (cons (list arg) labels)))))
- (clearcase-utl-split-string string "\n"))
- (completing-read prompt labels nil t)))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Directory-tree walking
-
-(defun clearcase-dir-all-files (func &rest args)
- "Invoke FUNC f ARGS on each regular file f in default directory."
- (let ((dir default-directory))
- (message "Scanning directory %s..." dir)
- (mapcar (function (lambda (f)
- (let ((dirf (expand-file-name f dir)))
- (apply func dirf args))))
- (directory-files dir))
- (message "Scanning directory %s...done" dir)))
-
-(defun clearcase-file-tree-walk-internal (file func args quiet)
- (if (not (file-directory-p file))
- (apply func file args)
- (or quiet
- (message "Traversing directory %s..." file))
- (let ((dir (file-name-as-directory file)))
- (mapcar
- (function
- (lambda (f) (or
- (string-equal f ".")
- (string-equal f "..")
- (member f clearcase-directory-exclusion-list)
- (let ((dirf (concat dir f)))
- (or
- (file-symlink-p dirf) ;; Avoid possible loops
- (clearcase-file-tree-walk-internal dirf func args quiet))))))
- (directory-files dir)))))
-;;
-(defun clearcase-file-tree-walk (func &rest args)
- "Walk recursively through default directory.
-Invoke FUNC f ARGS on each non-directory file f underneath it."
- (clearcase-file-tree-walk-internal default-directory func args nil)
- (message "Traversing directory %s...done" default-directory))
-
-(defun clearcase-subdir-tree-walk (func &rest args)
- "Walk recursively through default directory.
-Invoke FUNC f ARGS on each subdirectory underneath it."
- (clearcase-subdir-tree-walk-internal default-directory func args nil)
- (message "Traversing directory %s...done" default-directory))
-
-(defun clearcase-subdir-tree-walk-internal (file func args quiet)
- (if (file-directory-p file)
- (let ((dir (file-name-as-directory file)))
- (apply func dir args)
- (or quiet
- (message "Traversing directory %s..." file))
- (mapcar
- (function
- (lambda (f) (or
- (string-equal f ".")
- (string-equal f "..")
- (member f clearcase-directory-exclusion-list)
- (let ((dirf (concat dir f)))
- (or
- (file-symlink-p dirf) ;; Avoid possible loops
- (clearcase-subdir-tree-walk-internal dirf
- func
- args
- quiet))))))
- (directory-files dir)))))
-
-;;}}}
-
-;;{{{ Buffer context
-
-;; nyi: it would be nice if we could restore fold context too, for folded files.
-
-;; Save a bit of the text around POSN in the current buffer, to help
-;; us find the corresponding position again later. This works even
-;; if all markers are destroyed or corrupted.
-;;
-(defun clearcase-position-context (posn)
- (list posn
- (buffer-size)
- (buffer-substring posn
- (min (point-max) (+ posn 100)))))
-
-;; Return the position of CONTEXT in the current buffer, or nil if we
-;; couldn't find it.
-;;
-(defun clearcase-find-position-by-context (context)
- (let ((context-string (nth 2 context)))
- (if (equal "" context-string)
- (point-max)
- (save-excursion
- (let ((diff (- (nth 1 context) (buffer-size))))
- (if (< diff 0) (setq diff (- diff)))
- (goto-char (nth 0 context))
- (if (or (search-forward context-string nil t)
- ;; Can't use search-backward since the match may continue
- ;; after point.
- ;;
- (progn (goto-char (- (point) diff (length context-string)))
- ;; goto-char doesn't signal an error at
- ;; beginning of buffer like backward-char would.
- ;;
- (search-forward context-string nil t)))
- ;; to beginning of OSTRING
- ;;
- (- (point) (length context-string))))))))
-
-;;}}}
-
-;;{{{ Synchronizing buffers with disk
-
-(defun clearcase-sync-after-file-updated-from-vob (file)
- ;; Do what is needed after a file in a snapshot is updated or a checkout is
- ;; cancelled.
-
- ;; "ct+update" will not always make the file readonly, if, for
- ;; example, its contents didn't actually change. But we'd like
- ;; update to result in a readonly file, so force it here.
- ;;
- (clearcase-utl-make-unwriteable file)
-
- (or
- ;; If this returns true, there was a buffer visiting the file and it it
- ;; flushed fprops...
- ;;
- (clearcase-sync-from-disk-if-needed file)
-
- ;; ...otherwise, just sync this other state:
- ;;
- (progn
- (clearcase-fprop-unstore-properties file)
- (dired-relist-file file))))
-
-(defun clearcase-sync-from-disk (file &optional no-confirm)
-
- (clearcase-fprop-unstore-properties file)
- ;; If the given file is in any buffer, revert it.
- ;;
- (let ((buffer (find-buffer-visiting file)))
- (if buffer
- (save-excursion
- (set-buffer buffer)
- (clearcase-buffer-revert no-confirm)
- (clearcase-fprop-get-properties file)
-
- ;; Make sure the mode-line gets updated.
- ;;
- (setq clearcase-mode
- (concat " ClearCase:"
- (clearcase-mode-line-buffer-id file)))
- (force-mode-line-update))))
-
- ;; Update any Dired Mode buffers that list this file.
- ;;
- (dired-relist-file file)
-
- ;; If the file was a directory, update any dired-buffer for
- ;; that directory.
- ;;
- (mapcar (function (lambda (buffer)
- (save-excursion
- (set-buffer buffer)
- (revert-buffer))))
- (dired-buffers-for-dir file)))
-
-(defun clearcase-sync-from-disk-if-needed (file)
-
- ;; If the buffer on FILE is out of sync with its file, synch it. Returns t if
- ;; clearcase-sync-from-disk is called.
-
- (let ((buffer (find-buffer-visiting file)))
- (if (and buffer
- ;; Buffer can be out of sync in two ways:
- ;; (a) Buffer is modified (hasn't been written)
- ;; (b) Buffer is recording a different modtime to what the file has.
- ;; This is what happens when the file is updated by another
- ;; process.
- ;; (c) Buffer and file differ in their writeability.
- ;;
- (or (buffer-modified-p buffer)
- (not (verify-visited-file-modtime buffer))
- (eq (file-writable-p file)
- (with-current-buffer buffer buffer-read-only))))
- (progn
- (clearcase-sync-from-disk file
- ;; Only confirm for modified buffers.
- ;;
- (not (buffer-modified-p buffer)))
- t)
- nil)))
-
-
-(defun clearcase-sync-to-disk (&optional not-urgent)
-
- ;; Make sure the current buffer and its working file are in sync
- ;; NOT-URGENT means it is ok to continue if the user says not to save.
- ;;
- (if (buffer-modified-p)
- (if (or clearcase-suppress-confirm
- (y-or-n-p (format "Buffer %s modified; save it? "
- (buffer-name))))
- (save-buffer)
- (if not-urgent
- nil
- (error "Aborted")))))
-
-
-(defun clearcase-buffer-revert (&optional no-confirm)
- ;; Should never call for Dired buffers
- ;;
- (assert (not (eq major-mode 'dired-mode)))
-
- ;; Revert buffer, try to keep point and mark where user expects them in spite
- ;; of changes because of expanded version-control key words. This is quite
- ;; important since otherwise typeahead won't work as expected.
- ;;
- (widen)
- (let ((point-context (clearcase-position-context (point)))
-
- ;; Use clearcase-utl-mark-marker to avoid confusion in transient-mark-mode.
- ;; XEmacs - mark-marker t, FSF Emacs - mark-marker.
- ;;
- (mark-context (if (eq (marker-buffer (clearcase-utl-mark-marker))
- (current-buffer))
- (clearcase-position-context (clearcase-utl-mark-marker))))
- (camefrom (current-buffer)))
-
- ;; nyi: Should we run font-lock ?
- ;; Want to avoid re-doing a buffer that is already correct, such as on
- ;; check-in/check-out.
- ;; For now do-nothing.
-
- ;; The actual revisit.
- ;; For some reason, revert-buffer doesn't recompute whether View Minor Mode
- ;; should be on, so turn it off and then turn it on if necessary.
- ;;
- ;; nyi: Perhaps we should re-find-file ?
- ;;
- (or clearcase-xemacs-p
- (if (fboundp 'view-mode)
- (view-mode 0)))
- (revert-buffer t no-confirm t)
- (or clearcase-xemacs-p
- (if (and (boundp 'view-read-only)
- view-read-only
- buffer-read-only)
- (view-mode 1)))
-
- ;; Restore point and mark.
- ;;
- (let ((new-point (clearcase-find-position-by-context point-context)))
- (if new-point
- (goto-char new-point))
- (if mark-context
- (let ((new-mark (clearcase-find-position-by-context mark-context)))
- (if new-mark
- (set-mark new-mark))))
-
- ;; Restore a semblance of folded state.
- ;;
- (if (and (boundp 'folded-file)
- folded-file)
- (progn
- (folding-open-buffer)
- (folding-whole-buffer)
- (if new-point
- (folding-goto-char new-point)))))))
-
-;;}}}
-
-;;{{{ Utilities
-
-;;{{{ Displaying content in special buffers
-
-(defun clearcase-utl-populate-and-view-buffer (buffer
- args
- content-generating-func)
- "Empty BUFFER, and populate it by applying to ARGS the CONTENT-GENERATING-FUNC,
-and display in a separate window."
-
- (clearcase-utl-edit-and-view-buffer
- buffer
- (list args)
- (function
- (lambda (args)
- (erase-buffer)
- (apply content-generating-func args)))))
-
-(defun clearcase-utl-edit-and-view-buffer (buffer
- args
- content-editing-func)
- "Empty BUFFER, and edit it by applying to ARGS the CONTENT-EDITING-FUNC,
-and display in a separate window."
-
- (let ( ;; Create the buffer if necessary.
- ;;
- (buf (get-buffer-create buffer))
-
- ;; Record where we came from.
- ;;
- (camefrom (current-buffer)))
-
- (set-buffer buf)
- (clearcase-view-mode 0 camefrom)
-
- ;; Edit the buffer.
- ;;
- (apply content-editing-func args)
-
- ;; Display the buffer.
- ;;
- (clearcase-port-view-buffer-other-window buf)
- (goto-char 0)
- (set-buffer-modified-p nil) ; XEmacs - fsf uses `not-modified'
- (shrink-window-if-larger-than-buffer)))
-
-;;}}}
-
-;;{{{ Temporary files
-
-(defvar clearcase-tempfiles nil)
-(defun clearcase-utl-tempfile-name (&optional vxpath)
- (let ((ext ""))
- (and vxpath
- (save-match-data
- (if (string-match "\\(\\.[^.]+\\)@@" vxpath)
- (setq ext (match-string 1 vxpath)))))
- (let ((filename (concat
- (make-temp-name (clearcase-path-canonical
- ;; Use TEMP e.v. if set.
- ;;
- (concat (or (getenv "TEMP") "/tmp")
- "/clearcase-")))
- ext)))
- ;; Store its name for later cleanup.
- ;;
- (setq clearcase-tempfiles (cons filename clearcase-tempfiles))
- filename)))
-
-(defun clearcase-utl-clean-tempfiles ()
- (mapcar (function
- (lambda (tempfile)
- (if (file-exists-p tempfile)
- (condition-case nil
- (delete-file tempfile)
- (error nil)))))
- clearcase-tempfiles)
- (setq clearcase-tempfiles nil))
-
-;;}}}
-
-(defun clearcase-utl-touch-file (file)
- "Attempt to update the modtime of FILE. Return t if it worked."
- (zerop
- ;; Silently fail if there is no "touch" command available. Couldn't find a
- ;; convenient way to update a file's modtime in ELisp.
- ;;
- (condition-case nil
- (prog1
- (shell-command (concat "touch " file))
- (message ""))
- (error nil))))
-
-(defun clearcase-utl-filetimes-close (filetime1 filetime2 tolerance)
- "Test if FILETIME1 and FILETIME2 are within TOLERANCE of each other."
- ;; nyi: To do this correctly we need to know MAXINT.
- ;; For now this is correct enough since we only use this as a guideline to
- ;; avoid generating a diff.
- ;;
- (if (equal (first filetime1) (first filetime2))
- (< (abs (- (second filetime1) (second filetime2))) tolerance)
- nil))
-
-(defun clearcase-utl-emacs-date-to-clearcase-date (s)
- (concat
- (substring s 20) ;; yyyy
- (int-to-string (clearcase-utl-month-unparse (substring s 4 7))) ;; mm
- (substring s 8 10) ;; dd
- "."
- (substring s 11 13) ;; hh
- (substring s 14 16) ;; mm
- (substring s 17 19))) ;; ss
-
-(defun clearcase-utl-month-unparse (s)
- (cond
- ((string= s "Jan") 1)
- ((string= s "Feb") 2)
- ((string= s "Mar") 3)
- ((string= s "Apr") 4)
- ((string= s "May") 5)
- ((string= s "Jun") 6)
- ((string= s "Jul") 7)
- ((string= s "Aug") 8)
- ((string= s "Sep") 9)
- ((string= s "Oct") 10)
- ((string= s "Nov") 11)
- ((string= s "Dec") 12)))
-
-(defun clearcase-utl-strip-trailing-slashes (name)
- (let* ((len (length name)))
- (while (and (> len 1)
- (or (equal ?/ (aref name (1- len)))
- (equal ?\\ (aref name (1- len)))))
- (setq len (1- len)))
- (substring name 0 len)))
-
-(defun clearcase-utl-file-size (file)
- (nth 7 (file-attributes file)))
-(defun clearcase-utl-file-atime (file)
- (nth 4 (file-attributes file)))
-(defun clearcase-utl-file-mtime (file)
- (nth 5 (file-attributes file)))
-(defun clearcase-utl-file-ctime (file)
- (nth 6 (file-attributes file)))
-
-(defun clearcase-utl-kill-view-buffer ()
- (interactive)
- (let ((buf (current-buffer)))
- (delete-windows-on buf)
- (kill-buffer buf)))
-
-(defun clearcase-utl-escape-double-quotes (s)
- "Escape any double quotes in string S"
- (mapconcat (function (lambda (char)
- (if (equal ?\" char)
- (string ?\\ char)
- (string char))))
- s
- ""))
-
-(defun clearcase-utl-escape-backslashes (s)
- "Double any backslashes in string S"
- (mapconcat (function (lambda (char)
- (if (equal ?\\ char)
- "\\\\"
- (string char))))
- s
- ""))
-
-(defun clearcase-utl-quote-if-nec (token)
- "If TOKEN contains whitespace and is not already quoted,
-wrap it in double quotes."
- (if (and (string-match "[ \t]" token)
- (not (equal ?\" (aref token 0)))
- (not (equal ?\' (aref token 0))))
- (concat "\"" token "\"")
- token))
-
-(defun clearcase-utl-or-func (&rest args)
- "A version of `or' that can be applied to a list."
- (let ((result nil)
- (cursor args))
- (while (and (null result)
- cursor)
- (if (car cursor)
- (setq result t))
- (setq cursor (cdr cursor)))
- result))
-
-(defun clearcase-utl-any (predicate list)
- "Returns t if PREDICATE is satisfied by any element in LIST."
- (let ((result nil)
- (cursor list))
- (while (and (null result)
- cursor)
- (if (funcall predicate (car cursor))
- (setq result t))
- (setq cursor (cdr cursor)))
- result))
-
-(defun clearcase-utl-every (predicate list)
- "Returns t if PREDICATE is satisfied by every element in LIST."
- (let ((result t)
- (cursor list))
- (while (and result
- cursor)
- (if (not (funcall predicate (car cursor)))
- (setq result nil))
- (setq cursor (cdr cursor)))
- result))
-
-(defun clearcase-utl-list-filter (predicate list)
- "Map PREDICATE over each element of LIST, and return a list of the elements
-that mapped to non-nil."
- (let ((result '())
- (cursor list))
- (while (not (null cursor))
- (let ((elt (car cursor)))
- (if (funcall predicate elt)
- (setq result (cons elt result)))
- (setq cursor (cdr cursor))))
- (nreverse result)))
-
-(defun clearcase-utl-elts-are-eq (l)
- "Test if all elements of LIST are eq."
- (if (null l)
- t
- (let ((head (car l))
- (answer t))
- (mapcar (function (lambda (elt)
- (if (not (eq elt head))
- (setq answer nil))))
- (cdr l))
- answer)))
-
-;; FSF Emacs - doesn't like parameters on mark-marker.
-;;
-(defun clearcase-utl-mark-marker ()
- (if clearcase-xemacs-p
- (mark-marker t)
- (mark-marker)))
-
-(defun clearcase-utl-syslog (buf value)
- (save-excursion
- (let ((tmpbuf (get-buffer buf)))
- (if (bufferp tmpbuf)
- (progn
- (set-buffer buf)
- (goto-char (point-max))
- (insert (format "%s\n" value)))))))
-
-;; Extract the first line of a string.
-;;
-(defun clearcase-utl-1st-line-of-string (s)
- (let ((newline ?\n)
- (len (length s))
- (i 0))
- (while (and (< i len)
- (not (eq newline
- (aref s i))))
- (setq i (1+ i)))
- (substring s 0 i)))
-
-(defun clearcase-utl-split-string (str pat &optional indir suffix)
- (let ((ret nil)
- (start 0)
- (last (length str)))
- (while (< start last)
- (if (string-match pat str start)
- (progn
- (let ((tmp (substring str start (match-beginning 0))))
- (if suffix (setq tmp (concat tmp suffix)))
- (setq ret (cons (if indir (cons tmp nil)
- tmp)
- ret)))
- (setq start (match-end 0)))
- (setq start last)
- (setq ret (cons (substring str start) ret))))
- (nreverse ret)))
-
-(defun clearcase-utl-split-string-at-char (str char)
- (let ((ret nil)
- (i 0)
- (eos (length str)))
- (while (< i eos)
- ;; Collect next token
- ;;
- (let ((token-begin i))
- ;; Find the end
- ;;
- (while (and (< i eos)
- (not (eq char (aref str i))))
- (setq i (1+ i)))
-
- (setq ret (cons (substring str token-begin i)
- ret))
- (setq i (1+ i))))
- (nreverse ret)))
-
-
-(defun clearcase-utl-add-env (env var)
- (catch 'return
- (let ((a env)
- (vname (substring var 0
- (and (string-match "=" var)
- (match-end 0)))))
- (let ((vnl (length vname)))
- (while a
- (if (and (> (length (car a)) vnl)
- (string= (substring (car a) 0 vnl)
- vname))
- (throw 'return env))
- (setq a (cdr a)))
- (cons var env)))))
-
-
-(defun clearcase-utl-augment-env-from-view-config-spec (old-env tag &optional add-ons)
- (let ((newenv nil)
- (cc-env (clearcase-misc-extract-evs-from-config-spe tag)))
-
- ;; 1. Add-on bindings at the front:
- ;;
- (while add-ons
- (setq newenv (clearcase-utl-add-env newenv (car add-ons)))
- (setq add-ons (cdr add-ons)))
-
- ;; 2. Then bindings defined in the config-spec:
- ;;
- (while cc-env
- (setq newenv (clearcase-utl-add-env newenv (car cc-env)))
- (setq cc-env (cdr cc-env)))
-
- ;; 3. Lastly bindings that were in the old environment.
- ;;
- (while old-env
- (setq newenv (clearcase-utl-add-env newenv (car old-env)))
- (setq old-env (cdr old-env)))
- newenv))
-
-(defun clearcase-utl-make-writeable (file)
- ;; Equivalent to chmod u+w
- ;;
- (set-file-modes file
- ;; Some users still have Emacs 20 so don't use the octal
- ;; literal #o0200
- ;;
- (logior 128 (file-modes file))))
-
-(defun clearcase-utl-make-unwriteable (file)
- ;; Equivalent to chmod u-w
- ;;
- (set-file-modes file
- ;; Some users still have Emacs 20 so don't use the octal
- ;; literal #o7577
- ;;
- (logand 3967 (file-modes file))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Menus
-
-;; Predicate to determine if ClearCase menu items are relevant.
-;; nyi" this should disappear
-;;
-(defun clearcase-buffer-contains-version-p ()
- "Return true if the current buffer contains a ClearCase file or directory."
- (let ((object-name (if (eq major-mode 'dired-mode)
- default-directory
- buffer-file-name)))
- (clearcase-fprop-file-is-version-p object-name)))
-
-;;{{{ clearcase-mode menu
-
-;;{{{ The contents
-
-;; This version of the menu will hide rather than grey out inapplicable entries.
-;;
-(defvar clearcase-menu-contents-minimised
- (list "ClearCase"
-
- ["Checkin" clearcase-checkin-current-buffer
- :keys nil
- :visible (clearcase-file-ok-to-checkin buffer-file-name)]
-
- ["Edit checkout comment" clearcase-edit-checkout-comment-current-buffer
- :keys nil
- :visible (clearcase-file-ok-to-checkin buffer-file-name)]
-
- ["Checkout" clearcase-checkout-current-buffer
- :keys nil
- :visible (clearcase-file-ok-to-checkout buffer-file-name)]
-
- ["Hijack" clearcase-hijack-current-buffer
- :keys nil
- :visible (clearcase-file-ok-to-hijack buffer-file-name)]
-
- ["Unhijack" clearcase-unhijack-current-buffer
- :keys nil
- :visible (clearcase-file-ok-to-unhijack buffer-file-name)]
-
- ["Uncheckout" clearcase-uncheckout-current-buffer
- :visible (clearcase-file-ok-to-uncheckout buffer-file-name)]
-
- ["Find checkouts" clearcase-find-checkouts-in-current-view t]
-
- ["Make element" clearcase-mkelem-current-buffer
- :visible (clearcase-file-ok-to-mkelem buffer-file-name)]
-
- "---------------------------------"
- ["Describe version" clearcase-describe-current-buffer
- :visible (clearcase-buffer-contains-version-p)]
-
- ["Describe file" clearcase-describe-current-buffer
- :visible (not (clearcase-buffer-contains-version-p))]
-
- ["Annotate version" clearcase-annotate-current-buffer
- :visible (clearcase-buffer-contains-version-p)]
-
- ["Show config-spec rule" clearcase-what-rule-current-buffer
- :visible (clearcase-buffer-contains-version-p)]
-
- ;; nyi: enable this also when setviewed ?
- ;;
- ["Edit config-spec" clearcase-edcs-edit t]
-
- "---------------------------------"
- (list "Compare (Emacs)..."
- ["Compare with predecessor" clearcase-ediff-pred-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-ediff-branch-base-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-ediff-named-version-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)])
- (list "Compare (GUI)..."
- ["Compare with predecessor" clearcase-gui-diff-pred-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-gui-diff-branch-base-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-gui-diff-named-version-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)])
- (list "Compare (diff)..."
- ["Compare with predecessor" clearcase-diff-pred-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-diff-branch-base-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-diff-named-version-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)])
- "---------------------------------"
- ["Browse versions (dired)" clearcase-browse-vtree-current-buffer
- :visible (clearcase-file-ok-to-browse buffer-file-name)]
- ["Vtree browser GUI" clearcase-gui-vtree-browser-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- "---------------------------------"
- (list "Update snapshot..."
- ["Update view" clearcase-update-view
- :keys nil
- :visible (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update directory" clearcase-update-default-directory
- :keys nil
- :visible (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update this file" clearcase-update-current-buffer
- :keys nil
- :visible (and (clearcase-file-ok-to-checkout buffer-file-name)
- (not (clearcase-file-is-in-mvfs-p buffer-file-name)))]
- )
- "---------------------------------"
- (list "Element history..."
- ["Element history (full)" clearcase-list-history-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Element history (branch)" clearcase-list-history-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)]
- ["Element history (me)" clearcase-list-history-current-buffer
- :keys nil
- :visible (clearcase-buffer-contains-version-p)])
- "---------------------------------"
- ["Show current activity" clearcase-ucm-describe-current-activity
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Make activity" clearcase-ucm-mkact-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set activity..." clearcase-ucm-set-activity-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set NO activity" clearcase-ucm-set-activity-none-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Rebase this stream" clearcase-gui-rebase
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Deliver from this stream" clearcase-gui-deliver
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- "---------------------------------"
- (list "ClearCase GUI"
- ["ClearCase Explorer" clearcase-gui-clearexplorer
- :keys nil
- :visible clearcase-on-mswindows]
- ["Project Explorer" clearcase-gui-project-explorer
- :keys nil]
- ["Merge Manager" clearcase-gui-merge-manager
- :keys nil]
- ["Snapshot View Updater" clearcase-gui-snapshot-view-updater
- :keys nil])
- "---------------------------------"
-
- ;; nyi:
- ;; Enable this when current buffer is on VOB.
- ;;
- ["Make branch type" clearcase-mkbrtype
- :keys nil]
-
- "---------------------------------"
- ["Report Bug in ClearCase Mode" clearcase-submit-bug-report
- :keys nil]
-
- ["Dump internals" clearcase-dump
- :keys nil
- :visible (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- ["Flush caches" clearcase-flush-caches
- :keys nil
- :visible (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- "---------------------------------"
- ["Customize..." (customize-group 'clearcase)
- :keys nil]))
-
-(defvar clearcase-menu-contents
- (list "ClearCase"
-
- ["Checkin" clearcase-checkin-current-buffer
- :keys nil
- :active (clearcase-file-ok-to-checkin buffer-file-name)]
-
- ["Edit checkout comment" clearcase-edit-checkout-comment-current-buffer
- :keys nil
- :active (clearcase-file-ok-to-checkin buffer-file-name)]
-
- ["Checkout" clearcase-checkout-current-buffer
- :keys nil
- :active (clearcase-file-ok-to-checkout buffer-file-name)]
-
- ["Hijack" clearcase-hijack-current-buffer
- :keys nil
- :active (clearcase-file-ok-to-hijack buffer-file-name)]
-
- ["Unhijack" clearcase-unhijack-current-buffer
- :keys nil
- :active (clearcase-file-ok-to-unhijack buffer-file-name)]
-
- ["Uncheckout" clearcase-uncheckout-current-buffer
- :active (clearcase-file-ok-to-uncheckout buffer-file-name)]
-
- ["Make element" clearcase-mkelem-current-buffer
- :active (clearcase-file-ok-to-mkelem buffer-file-name)]
-
- "---------------------------------"
- ["Describe version" clearcase-describe-current-buffer
- :active (clearcase-buffer-contains-version-p)]
-
- ["Describe file" clearcase-describe-current-buffer
- :active (not (clearcase-buffer-contains-version-p))]
-
- ["Annotate version" clearcase-annotate-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
-
- ["Show config-spec rule" clearcase-what-rule-current-buffer
- :active (clearcase-buffer-contains-version-p)]
-
- ;; nyi: enable this also when setviewed ?
- ;;
- ["Edit config-spec" clearcase-edcs-edit t]
-
- "---------------------------------"
- (list "Compare (Emacs)..."
- ["Compare with predecessor" clearcase-ediff-pred-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-ediff-branch-base-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-ediff-named-version-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)])
- (list "Compare (GUI)..."
- ["Compare with predecessor" clearcase-gui-diff-pred-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-gui-diff-branch-base-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-gui-diff-named-version-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)])
- (list "Compare (diff)..."
- ["Compare with predecessor" clearcase-diff-pred-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with branch base" clearcase-diff-branch-base-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Compare with named version" clearcase-diff-named-version-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)])
- "---------------------------------"
- ["Browse versions (dired)" clearcase-browse-vtree-current-buffer
- :active (clearcase-file-ok-to-browse buffer-file-name)]
- ["Vtree browser GUI" clearcase-gui-vtree-browser-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- "---------------------------------"
- (list "Update snapshot..."
- ["Update view" clearcase-update-view
- :keys nil
- :active (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update directory" clearcase-update-default-directory
- :keys nil
- :active (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update this file" clearcase-update-current-buffer
- :keys nil
- :active (and (clearcase-file-ok-to-checkout buffer-file-name)
- (not (clearcase-file-is-in-mvfs-p buffer-file-name)))]
- )
- "---------------------------------"
- (list "Element history..."
- ["Element history (full)" clearcase-list-history-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Element history (branch)" clearcase-list-history-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)]
- ["Element history (me)" clearcase-list-history-current-buffer
- :keys nil
- :active (clearcase-buffer-contains-version-p)])
- "---------------------------------"
- ["Show current activity" clearcase-ucm-describe-current-activity
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Make activity" clearcase-ucm-mkact-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set activity..." clearcase-ucm-set-activity-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set NO activity" clearcase-ucm-set-activity-none-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Rebase this stream" clearcase-gui-rebase
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Deliver from this stream" clearcase-gui-deliver
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- "---------------------------------"
- (list "ClearCase GUI"
- ["ClearCase Explorer" clearcase-gui-clearexplorer
- :keys nil
- :active clearcase-on-mswindows]
- ["Project Explorer" clearcase-gui-project-explorer
- :keys nil]
- ["Merge Manager" clearcase-gui-merge-manager
- :keys nil]
- ["Snapshot View Updater" clearcase-gui-snapshot-view-updater
- :keys nil])
- "---------------------------------"
-
- ;; nyi:
- ;; Enable this when current buffer is on VOB.
- ;;
- ["Make branch type" clearcase-mkbrtype
- :keys nil]
-
- "---------------------------------"
- ["Report Bug in ClearCase Mode" clearcase-submit-bug-report
- :keys nil]
-
- ["Dump internals" clearcase-dump
- :keys nil
- :active (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- ["Flush caches" clearcase-flush-caches
- :keys nil
- :active (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- "---------------------------------"
- ["Customize..." (customize-group 'clearcase)
- :keys nil]))
-
-(if (and clearcase-minimise-menus
- (not clearcase-xemacs-p))
- (setq clearcase-menu-contents clearcase-menu-contents-minimised))
-
-;;}}}
-
-(if (>= emacs-major-version '20)
- (progn
- ;; Define the menu
- ;;
- (easy-menu-define
- clearcase-menu
- (list clearcase-mode-map)
- "ClearCase menu"
- clearcase-menu-contents)
-
- (or clearcase-xemacs-p
- (add-to-list 'menu-bar-final-items 'ClearCase))))
-
-;;}}}
-
-;;{{{ clearcase-dired-mode menu
-
-;;{{{ Related functions
-
-;; nyi: this probably gets run for each menu element.
-;; For better efficiency, look into using a one-pass ":filter"
-;; to construct this menu dynamically.
-
-(defun clearcase-dired-mark-count ()
- (let ((old-point (point))
- (count 0))
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^" (regexp-quote (char-to-string
- dired-marker-char))) nil t)
- (setq count (1+ count)))
- (goto-char old-point)
- count))
-
-(defun clearcase-dired-current-ok-to-checkin ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-checkin file))))
-
-(defun clearcase-dired-current-ok-to-checkout ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-checkout file))))
-
-(defun clearcase-dired-current-ok-to-uncheckout ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-uncheckout file))))
-
-(defun clearcase-dired-current-ok-to-hijack ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-hijack file))))
-
-(defun clearcase-dired-current-ok-to-unhijack ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-unhijack file))))
-
-(defun clearcase-dired-current-ok-to-mkelem ()
- (let ((file (dired-get-filename nil t)))
- (and file
- (clearcase-file-ok-to-mkelem file))))
-
-(defun clearcase-dired-current-ok-to-browse ()
- (let ((file (dired-get-filename nil t)))
- (clearcase-file-ok-to-browse file)))
-
-(defvar clearcase-dired-max-marked-files-to-check 5
- "The maximum number of marked files in a Dired buffer when constructing
-the ClearCase menu.")
-
-;; nyi: speed these up by stopping check when a non-qualifying file is found
-;; Better:
-;; - hook the menu constuction and figure out what ops apply
-;; - hook mark/unmark/move cursor
-
-(defun clearcase-dired-marked-ok-to-checkin ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-checkin)
- files))))
-
-(defun clearcase-dired-marked-ok-to-checkout ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-checkout)
- files))))
-
-(defun clearcase-dired-marked-ok-to-uncheckout ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-uncheckout)
- files))))
-
-(defun clearcase-dired-marked-ok-to-hijack ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-hijack)
- files))))
-
-(defun clearcase-dired-marked-ok-to-unhijack ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-unhijack)
- files))))
-
-(defun clearcase-dired-marked-ok-to-mkelem ()
- (let ((files (dired-get-marked-files)))
- (or (> (length files) clearcase-dired-max-marked-files-to-check)
- (clearcase-utl-every (function clearcase-file-ok-to-mkelem)
- files))))
-
-(defun clearcase-dired-current-dir-ok-to-checkin ()
- (let ((dir (dired-current-directory)))
- (clearcase-file-ok-to-checkin dir)))
-
-(defun clearcase-dired-current-dir-ok-to-checkout ()
- (let ((dir (dired-current-directory)))
- (clearcase-file-ok-to-checkout dir)))
-
-(defun clearcase-dired-current-dir-ok-to-uncheckout ()
- (let ((dir (dired-current-directory)))
- (clearcase-file-ok-to-uncheckout dir)))
-
-;;}}}
-
-;;{{{ Contents
-
-;; This version of the menu will hide rather than grey out inapplicable entries.
-;;
-(defvar clearcase-dired-menu-contents-minimised
- (list "ClearCase"
-
- ;; Current file
- ;;
- ["Checkin file" clearcase-checkin-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkin))]
-
- ["Edit checkout comment" clearcase-edit-checkout-comment-dired-file
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkin))]
-
- ["Checkout file" clearcase-checkout-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkout))]
-
- ["Uncheckout file" clearcase-uncheckout-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-uncheckout))]
-
- ["Hijack file" clearcase-hijack-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-hijack))]
-
- ["Unhijack file" clearcase-unhijack-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-unhijack))]
-
- ["Find checkouts" clearcase-find-checkouts-in-current-view t]
-
- ["Make file an element" clearcase-mkelem-dired-files
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-mkelem))]
-
- ;; Marked files
- ;;
- ["Checkin marked files" clearcase-checkin-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-checkin))]
-
- ["Checkout marked files" clearcase-checkout-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-checkout))]
-
- ["Uncheckout marked files" clearcase-uncheckout-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-uncheckout))]
-
- ["Hijack marked files" clearcase-hijack-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-hijack))]
-
- ["Unhijack marked files" clearcase-unhijack-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-unhijack))]
-
- ["Make marked files elements" clearcase-mkelem-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-mkelem))]
-
-
- ;; Current directory
- ;;
- ["Checkin current-dir" clearcase-dired-checkin-current-dir
- :keys nil
- :visible (clearcase-dired-current-dir-ok-to-checkin)]
-
- ["Checkout current dir" clearcase-dired-checkout-current-dir
- :keys nil
- :visible (clearcase-dired-current-dir-ok-to-checkout)]
-
- ["Uncheckout current dir" clearcase-dired-uncheckout-current-dir
- :keys nil
- :visible (clearcase-dired-current-dir-ok-to-uncheckout)]
-
- "---------------------------------"
- ["Describe file" clearcase-describe-dired-file
- :visible t]
-
- ["Annotate file" clearcase-annotate-dired-file
- :visible t]
-
- ["Show config-spec rule" clearcase-what-rule-dired-file
- :visible t]
-
-
- ["Edit config-spec" clearcase-edcs-edit t]
-
- "---------------------------------"
- (list "Compare (Emacs)..."
- ["Compare with predecessor" clearcase-ediff-pred-dired-file
- :keys nil
- :visible t]
- ["Compare with branch base" clearcase-ediff-branch-base-dired-file
- :keys nil
- :visible t]
- ["Compare with named version" clearcase-ediff-named-version-dired-file
- :keys nil
- :visible t])
- (list "Compare (GUI)..."
- ["Compare with predecessor" clearcase-gui-diff-pred-dired-file
- :keys nil
- :visible t]
- ["Compare with branch base" clearcase-gui-diff-branch-base-dired-file
- :keys nil
- :visible t]
- ["Compare with named version" clearcase-gui-diff-named-version-dired-file
- :keys nil
- :visible t])
- (list "Compare (diff)..."
- ["Compare with predecessor" clearcase-diff-pred-dired-file
- :keys nil
- :visible t]
- ["Compare with branch base" clearcase-diff-branch-base-dired-file
- :keys nil
- :visible t]
- ["Compare with named version" clearcase-diff-named-version-dired-file
- :keys nil
- :visible t])
- "---------------------------------"
- ["Browse versions (dired)" clearcase-browse-vtree-dired-file
- :visible (clearcase-dired-current-ok-to-browse)]
- ["Vtree browser GUI" clearcase-gui-vtree-browser-dired-file
- :keys nil
- :visible t]
- "---------------------------------"
- (list "Update snapshot..."
- ["Update view" clearcase-update-view
- :keys nil
- :visible (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update directory" clearcase-update-default-directory
- :keys nil
- :visible (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update file" clearcase-update-dired-files
- :keys nil
- :visible (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkout)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update marked files" clearcase-update-dired-files
- :keys nil
- :visible (and (>= (clearcase-dired-mark-count) 2)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- )
- "---------------------------------"
- (list "Element history..."
- ["Element history (full)" clearcase-list-history-dired-file
- :keys nil
- :visible t]
- ["Element history (branch)" clearcase-list-history-dired-file
- :keys nil
- :visible t]
- ["Element history (me)" clearcase-list-history-dired-file
- :keys nil
- :visible t])
- "---------------------------------"
- ["Show current activity" clearcase-ucm-describe-current-activity
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Make activity" clearcase-ucm-mkact-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set activity..." clearcase-ucm-set-activity-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set NO activity" clearcase-ucm-set-activity-none-current-dir
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Rebase this stream" clearcase-gui-rebase
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Deliver from this stream" clearcase-gui-deliver
- :keys nil
- :visible (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- "---------------------------------"
- (list "ClearCase GUI"
- ["ClearCase Explorer" clearcase-gui-clearexplorer
- :keys nil
- :visible clearcase-on-mswindows]
- ["Project Explorer" clearcase-gui-project-explorer
- :keys nil]
- ["Merge Manager" clearcase-gui-merge-manager
- :keys nil]
- ["Snapshot View Updater" clearcase-gui-snapshot-view-updater
- :keys nil])
- "---------------------------------"
-
- ["Make branch type" clearcase-mkbrtype
- :keys nil]
-
- "---------------------------------"
- ["Report Bug in ClearCase Mode" clearcase-submit-bug-report
- :keys nil]
-
- ["Dump internals" clearcase-dump
- :keys nil
- :visible (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- ["Flush caches" clearcase-flush-caches
- :keys nil
- :visible (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- "---------------------------------"
- ["Customize..." (customize-group 'clearcase)
- :keys nil]))
-
-(defvar clearcase-dired-menu-contents
- (list "ClearCase"
-
- ;; Current file
- ;;
- ["Checkin file" clearcase-checkin-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkin))]
-
- ["Edit checkout comment" clearcase-edit-checkout-comment-dired-file
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkin))]
-
- ["Checkout file" clearcase-checkout-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkout))]
-
- ["Uncheckout file" clearcase-uncheckout-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-uncheckout))]
-
- ["Hijack file" clearcase-hijack-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-hijack))]
-
- ["Unhijack file" clearcase-unhijack-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-unhijack))]
-
- ["Make file an element" clearcase-mkelem-dired-files
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-mkelem))]
-
- ;; Marked files
- ;;
- ["Checkin marked files" clearcase-checkin-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-checkin))]
-
- ["Checkout marked files" clearcase-checkout-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-checkout))]
-
- ["Uncheckout marked files" clearcase-uncheckout-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-uncheckout))]
-
- ["Hijack marked files" clearcase-hijack-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-hijack))]
-
- ["Unhijack marked files" clearcase-unhijack-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-unhijack))]
-
- ["Make marked files elements" clearcase-mkelem-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (clearcase-dired-marked-ok-to-mkelem))]
-
-
- ;; Current directory
- ;;
- ["Checkin current-dir" clearcase-dired-checkin-current-dir
- :keys nil
- :active (clearcase-dired-current-dir-ok-to-checkin)]
-
- ["Checkout current dir" clearcase-dired-checkout-current-dir
- :keys nil
- :active (clearcase-dired-current-dir-ok-to-checkout)]
-
- ["Uncheckout current dir" clearcase-dired-uncheckout-current-dir
- :keys nil
- :active (clearcase-dired-current-dir-ok-to-uncheckout)]
-
- "---------------------------------"
- ["Describe file" clearcase-describe-dired-file
- :active t]
-
- ["Annotate file" clearcase-annotate-dired-file
- :active t]
-
- ["Show config-spec rule" clearcase-what-rule-dired-file
- :active t]
-
-
- ["Edit config-spec" clearcase-edcs-edit t]
-
- "---------------------------------"
- (list "Compare (Emacs)..."
- ["Compare with predecessor" clearcase-ediff-pred-dired-file
- :keys nil
- :active t]
- ["Compare with branch base" clearcase-ediff-branch-base-dired-file
- :keys nil
- :active t]
- ["Compare with named version" clearcase-ediff-named-version-dired-file
- :keys nil
- :active t])
- (list "Compare (GUI)..."
- ["Compare with predecessor" clearcase-gui-diff-pred-dired-file
- :keys nil
- :active t]
- ["Compare with branch base" clearcase-gui-diff-branch-base-dired-file
- :keys nil
- :active t]
- ["Compare with named version" clearcase-gui-diff-named-version-dired-file
- :keys nil
- :active t])
- (list "Compare (diff)..."
- ["Compare with predecessor" clearcase-diff-pred-dired-file
- :keys nil
- :active t]
- ["Compare with branch base" clearcase-diff-branch-base-dired-file
- :keys nil
- :active t]
- ["Compare with named version" clearcase-diff-named-version-dired-file
- :keys nil
- :active t])
- "---------------------------------"
- ["Browse versions (dired)" clearcase-browse-vtree-dired-file
- :active (clearcase-dired-current-ok-to-browse)]
- ["Vtree browser GUI" clearcase-gui-vtree-browser-dired-file
- :keys nil
- :active t]
- "---------------------------------"
- (list "Update snapshot..."
- ["Update view" clearcase-update-view
- :keys nil
- :active (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update directory" clearcase-update-default-directory
- :keys nil
- :active (and (clearcase-file-is-in-view-p default-directory)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update file" clearcase-update-dired-files
- :keys nil
- :active (and (< (clearcase-dired-mark-count) 2)
- (clearcase-dired-current-ok-to-checkout)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- ["Update marked files" clearcase-update-dired-files
- :keys nil
- :active (and (>= (clearcase-dired-mark-count) 2)
- (not (clearcase-file-is-in-mvfs-p default-directory)))]
- )
- "---------------------------------"
- (list "Element history..."
- ["Element history (full)" clearcase-list-history-dired-file
- :keys nil
- :active t]
- ["Element history (branch)" clearcase-list-history-dired-file
- :keys nil
- :active t]
- ["Element history (me)" clearcase-list-history-dired-file
- :keys nil
- :active t])
- "---------------------------------"
- ["Show current activity" clearcase-ucm-describe-current-activity
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Make activity" clearcase-ucm-mkact-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set activity..." clearcase-ucm-set-activity-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Set NO activity" clearcase-ucm-set-activity-none-current-dir
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Rebase this stream" clearcase-gui-rebase
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- ["Deliver from this stream" clearcase-gui-deliver
- :keys nil
- :active (clearcase-vprop-ucm (clearcase-fprop-viewtag default-directory))]
- "---------------------------------"
- (list "ClearCase GUI"
- ["ClearCase Explorer" clearcase-gui-clearexplorer
- :keys nil
- :active clearcase-on-mswindows]
- ["Project Explorer" clearcase-gui-project-explorer
- :keys nil]
- ["Merge Manager" clearcase-gui-merge-manager
- :keys nil]
- ["Snapshot View Updater" clearcase-gui-snapshot-view-updater
- :keys nil])
- "---------------------------------"
-
- ["Make branch type" clearcase-mkbrtype
- :keys nil]
-
- "---------------------------------"
- ["Report Bug in ClearCase Mode" clearcase-submit-bug-report
- :keys nil]
-
- ["Dump internals" clearcase-dump
- :keys nil
- :active (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- ["Flush caches" clearcase-flush-caches
- :keys nil
- :active (or (equal "rwhitby" (user-login-name))
- (equal "esler" (user-login-name)))]
-
- "---------------------------------"
- ["Customize..." (customize-group 'clearcase)
- :keys nil]))
-
-(if (and clearcase-minimise-menus
- (not clearcase-xemacs-p))
- (setq clearcase-dired-menu-contents clearcase-dired-menu-contents-minimised))
-
-;;}}}
-
-(if (>= emacs-major-version '20)
- (progn
- (easy-menu-define
- clearcase-dired-menu
- (list clearcase-dired-mode-map)
- "ClearCase Dired menu"
- clearcase-dired-menu-contents)
-
- (or clearcase-xemacs-p
- (add-to-list 'menu-bar-final-items 'ClearCase))))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Widgets
-
-;;{{{ Single-selection buffer widget
-
-;; Keep the compiler quiet by declaring these
-;; buffer-local variables here thus.
-;;
-(defvar clearcase-selection-window-config nil)
-(defvar clearcase-selection-interpreter nil)
-(defvar clearcase-selection-continuation nil)
-(defvar clearcase-selection-operands nil)
-
-(defun clearcase-ucm-make-selection-window (buffer-name
- buffer-contents
- selection-interpreter
- continuation
- cont-arglist)
- (let ((buf (get-buffer-create buffer-name)))
- (save-excursion
-
- ;; Reset the buffer
- ;;
- (set-buffer buf)
- (setq buffer-read-only nil)
- (erase-buffer)
- (setq truncate-lines t)
-
- ;; Paint the buffer
- ;;
- (goto-char (point-min))
- (insert buffer-contents)
-
- ;; Insert mouse-highlighting
- ;;
- (save-excursion
- (goto-char (point-min))
- (while (< (point) (point-max))
- (condition-case nil
- (progn
- (beginning-of-line)
- (put-text-property (point)
- (save-excursion
- (end-of-line)
- (point))
- 'mouse-face 'highlight))
- (error nil))
- (forward-line 1)))
-
- ;; Set a keymap
- ;;
- (setq buffer-read-only t)
- (use-local-map clearcase-selection-keymap)
-
- ;; Set up the interpreter and continuation
- ;;
- (set (make-local-variable 'clearcase-selection-window-config)
- (current-window-configuration))
- (set (make-local-variable 'clearcase-selection-interpreter)
- selection-interpreter)
- (set (make-local-variable 'clearcase-selection-continuation)
- continuation)
- (set (make-local-variable 'clearcase-selection-operands)
- cont-arglist))
-
- ;; Display the buffer
- ;;
- (pop-to-buffer buf)
- (goto-char 0)
- (shrink-window-if-larger-than-buffer)
- (message "Use RETURN to select an item")))
-
-(defun clearcase-selection-continue ()
- (interactive)
- (beginning-of-line)
- (sit-for 0)
- ;; Call the interpreter to extract the item of interest
- ;; from the buffer.
- ;;
- (let ((item (funcall clearcase-selection-interpreter)))
- ;; Call the continuation.
- ;;
- (apply clearcase-selection-continuation
- (append clearcase-selection-operands (list item))))
-
- ;; Restore window config
- ;;
- (let ((sel-buffer (current-buffer)))
- (if clearcase-selection-window-config
- (set-window-configuration clearcase-selection-window-config))
- (delete-windows-on sel-buffer)
- (kill-buffer sel-buffer)))
-
-(defun clearcase-selection-mouse-continue (click)
- (interactive "@e")
- (mouse-set-point click)
- (clearcase-selection-continue))
-
-(defvar clearcase-selection-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map [return] 'clearcase-selection-continue)
- (define-key map [mouse-2] 'clearcase-selection-mouse-continue)
- (define-key map "q" 'clearcase-utl-kill-view-buffer)
- ;; nyi: refresh list
- ;; (define-key map "g" 'clearcase-selection-get)
- map))
-
-;;}}}
-
-;;}}}
-
-;;{{{ Integration with Emacs
-
-;;{{{ Functions: examining the ClearCase installation
-
-;; Discover ClearCase version-string
-;;
-(defun clearcase-get-version-string ()
- ;; Some care seems to be necessary to avoid problems caused by odd settings
- ;; of the "SHELL" environment variable. I found that simply
- ;; (shell-command-to-string "cleartool -version") on Windows-2000 with
- ;; SHELL==cmd.exe just returned a copy of the Windows command prompt. The
- ;; result was that clearcase-integrate would not complete.
- ;;
- ;; The follow seems to work.
- ;;
- (if clearcase-on-mswindows
- (shell-command-to-string "cmd /c cleartool -version")
- (shell-command-to-string "sh -c \"cleartool -version\"")))
-
-;; Find where cleartool is installed.
-;;
-(defun clearcase-find-cleartool ()
- "Search directories listed in the PATH environment variable
-looking for a cleartool executable. If found return the full pathname."
- (let ((dir-list (parse-colon-path (getenv "PATH")))
- (cleartool-name (if clearcase-on-mswindows
- "cleartool.exe"
- "cleartool"))
- (cleartool-path nil))
- (catch 'found
- (mapcar
- (function (lambda (dir)
- (let ((f (expand-file-name (concat dir cleartool-name))))
- (if (file-executable-p f)
- (progn
- (setq cleartool-path f)
- (throw 'found t))))))
- dir-list)
- nil)
- cleartool-path))
-
-(defun clearcase-non-lt-registry-server-online-p ()
- "Heuristic to determine if the local host is network-connected to
-its ClearCase servers. Used for a non-LT system."
-
- (let ((result nil)
- (buf (get-buffer-create " *clearcase-lsregion*")))
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (let ((process (start-process "lsregion"
- buf
- "cleartool"
- "lsregion"
- "-long"))
- (timeout-occurred nil))
-
- ;; Now wait a little while, if necessary, for some output.
- ;;
- (while (and (null result)
- (not timeout-occurred)
- (< (buffer-size) (length "Tag: ")))
- (if (null (accept-process-output process 10))
- (setq timeout-occurred t))
- (goto-char (point-min))
- (if (looking-at "Tag: ")
- (setq result t)))
- (condition-case nil
- (kill-process process)
- (error nil))))
- ;; If servers are apparently not online, keep the
- ;; buffer around so we can see what lsregion reported.
- ;;
- (sit-for 0.01); Fix by AJM to prevent kill-buffer claiming process still running
- (if result
- (kill-buffer buf))
- result))
-
-;; We could have an LT system, which lacks ct+lsregion, but has ct+lssite.
-;;
-(defun clearcase-lt-registry-server-online-p ()
- "Heuristic to determine if the local host is network-connected to
-its ClearCase servers. Used for LT system."
-
- (let ((result nil)
- (buf (get-buffer-create " *clearcase-lssite*")))
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (let ((process (start-process "lssite"
- buf
- "cleartool"
- "lssite"
- "-inquire"))
- (timeout-occurred nil))
-
- ;; Now wait a little while, if necessary, for some output.
- ;;
- (while (and (null result)
- (not timeout-occurred)
- (< (buffer-size) (length " view_cache_size")))
- (if (null (accept-process-output process 10))
- (setq timeout-occurred t))
- (goto-char (point-min))
- (if (re-search-forward "view_cache_size" nil t)
- (setq result t)))
- (condition-case nil
- (kill-process process)
- (error nil))))
-
- ;; If servers are apparently not online, keep the
- ;; buffer around so we can see what lssite reported.
- ;;
- (sit-for 0.01); Fix by AJM to prevent kill-buffer claiming process still running
- (if result
- (kill-buffer buf))
- result))
-
-;; Find out if the ClearCase registry server is accessible.
-;; We could be on a disconnected laptop.
-;;
-(defun clearcase-registry-server-online-p ()
- "Heuristic to determine if the local host is network-connected to
-its ClearCase server(s)."
-
- (if clearcase-lt
- (clearcase-lt-registry-server-online-p)
- (clearcase-non-lt-registry-server-online-p)))
-
-;;}}}
-;;{{{ Functions: hooks
-
-;;{{{ A find-file hook to turn on clearcase-mode
-
-(defun clearcase-hook-find-file-hook ()
- (let ((filename (buffer-file-name)))
- (if filename
- (progn
- (clearcase-fprop-unstore-properties filename)
- (if (clearcase-file-would-be-in-view-p filename)
- (progn
- ;; 1. Activate minor mode
- ;;
- (clearcase-mode 1)
-
- ;; 2. Pre-fetch file properties
- ;;
- (if (file-exists-p filename)
- (progn
- (clearcase-fprop-get-properties filename)
-
- ;; 3. Put branch/ver in mode-line
- ;;
- (setq clearcase-mode
- (concat " ClearCase:"
- (clearcase-mode-line-buffer-id filename)))
- (force-mode-line-update)
-
- ;; 4. Schedule the asynchronous fetching of the view's properties
- ;; next time Emacs is idle enough.
- ;;
- (clearcase-vprop-schedule-work (clearcase-fprop-viewtag filename))
-
- ;; 5. Set backup policy
- ;;
- (unless clearcase-make-backup-files
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t))))
-
- (clearcase-set-auto-mode)))))))
-
-(defun clearcase-set-auto-mode ()
- "Check again for the mode of the current buffer when using ClearCase version extended paths."
-
- (let* ((version (clearcase-vxpath-version-part (buffer-file-name)))
- (buffer-file-name (clearcase-vxpath-element-part (buffer-file-name))))
-
- ;; Need to recheck the major mode only if a version was appended.
- ;;
- (if version
- (set-auto-mode))))
-
-;;}}}
-
-;;{{{ A find-file hook for version-extended pathnames
-
-(defun clearcase-hook-vxpath-find-file-hook ()
- (if (clearcase-vxpath-p default-directory)
- (let ((element (clearcase-vxpath-element-part default-directory))
- (version (clearcase-vxpath-version-part default-directory)))
-
- ;; 1. Set the buffer name to <filename>@@/<branch path>/<version>.
- ;;
- (let ((new-buffer-name
- (concat (file-name-nondirectory element)
- clearcase-vxpath-glue
- version
- (buffer-name))))
-
- (or (string= new-buffer-name (buffer-name))
-
- ;; Uniquify the name, if necessary.
- ;;
- (let ((n 2)
- (uniquifier-string ""))
- (while (get-buffer (concat new-buffer-name uniquifier-string))
- (setq uniquifier-string (format "<%d>" n))
- (setq n (1+ n)))
- (rename-buffer
- (concat new-buffer-name uniquifier-string)))))
-
- ;; 2. Set the default directory to the dir containing <filename>.
- ;;
- (let ((new-dir (file-name-directory element)))
- (setq default-directory new-dir))
-
- ;; 3. Disable auto-saving.
- ;;
- ;; If we're visiting <filename>@@/<branch path>/199
- ;; we don't want Emacs trying to find a place to create a "#199#.
- ;;
- (auto-save-mode 0))))
-
-;;}}}
-
-;;{{{ A dired-mode-hook to turn on clearcase-dired-mode
-
-(defun clearcase-hook-dired-mode-hook ()
- ;; Force a re-computation of whether the directory is within ClearCase.
- ;;
- (clearcase-fprop-unstore-properties default-directory)
-
- ;; Wrap this in an exception handler. Otherwise, diredding into
- ;; a deregistered or otherwise defective snapshot-view fails.
- ;;
- (condition-case nil
- ;; If this directory is below a ClearCase element,
- ;; 1. turn on ClearCase Dired Minor Mode.
- ;; 2. display branch/ver in mode-line
- ;;
- (if (clearcase-file-would-be-in-view-p default-directory)
- (progn
- (if clearcase-auto-dired-mode
- (progn
- (clearcase-dired-mode 1)
- (clearcase-fprop-get-properties default-directory)
- (clearcase-vprop-schedule-work (clearcase-fprop-viewtag default-directory))))
- (setq clearcase-dired-mode
- (concat " ClearCase:"
- (clearcase-mode-line-buffer-id default-directory)))
- (force-mode-line-update)))
- (error (message "Error fetching ClearCase properties of %s" default-directory))))
-
-;;}}}
-
-;;{{{ A dired-after-readin-hook to add ClearCase information to the display
-
-(defun clearcase-hook-dired-after-readin-hook ()
-
- ;; If in clearcase-dired-mode, reformat the buffer.
- ;;
- (if clearcase-dired-mode
- (progn
- (clearcase-dired-reformat-buffer)
- (if clearcase-dired-show-view
- (clearcase-dired-insert-viewtag))))
- t)
-
-;;}}}
-
-;;{{{ A write-file-hook to auto-insert a version-string.
-
-;; To use this, put a line containing this in the first 8 lines of your file:
-;; ClearCase-version: </main/laptop/165>
-;; and make sure that clearcase-version-stamp-active gets set to true at least
-;; locally in the file.
-
-(defvar clearcase-version-stamp-line-limit 1000)
-(defvar clearcase-version-stamp-begin-regexp "ClearCase-version:[ \t]<")
-(defvar clearcase-version-stamp-end-regexp ">")
-(defvar clearcase-version-stamp-active nil)
-
-(defun clearcase-increment-version (version-string)
- (let* ((branch (clearcase-vxpath-branch version-string))
- (number (clearcase-vxpath-version version-string))
- (new-number (1+ (string-to-number number))))
- (format "%s%d" branch new-number)))
-
-(defun clearcase-version-stamp ()
- (interactive)
- (if (and clearcase-mode
- clearcase-version-stamp-active
- (file-exists-p buffer-file-name)
- (equal 'version (clearcase-fprop-mtype buffer-file-name)))
- (let ((latest-version (clearcase-fprop-predecessor-version buffer-file-name)))
-
- ;; Note: If the buffer happens to be folded, we may not find the place
- ;; to insert the version-stamp. Folding mode really needs to supply a
- ;; 'save-folded-excursion function to solve this one. We won't attempt
- ;; a cheaper hack here.
-
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (forward-line clearcase-version-stamp-line-limit)
- (let ((limit (point))
- (v-start nil)
- (v-end nil))
- (goto-char (point-min))
- (while (and (< (point) limit)
- (re-search-forward clearcase-version-stamp-begin-regexp
- limit
- 'move))
- (setq v-start (point))
- (end-of-line)
- (let ((line-end (point)))
- (goto-char v-start)
- (if (re-search-forward clearcase-version-stamp-end-regexp
- line-end
- 'move)
- (setq v-end (match-beginning 0)))))
- (if v-end
- (let ((new-version-stamp (clearcase-increment-version latest-version)))
- (goto-char v-start)
- (delete-region v-start v-end)
- (insert-and-inherit new-version-stamp)))))))))
-
-(defun clearcase-hook-write-file-hook ()
-
- (clearcase-version-stamp)
- ;; Important to return nil so the files eventually gets written.
- ;;
- nil)
-
-;;}}}
-
-;;{{{ A kill-buffer hook
-
-(defun clearcase-hook-kill-buffer-hook ()
- (let ((filename (buffer-file-name)))
- (if (and filename
- ;; W3 has buffers in which 'buffer-file-name is bound to
- ;; a URL. Don't attempt to unstore their properties.
- ;;
- (boundp 'buffer-file-truename)
- buffer-file-truename)
- (clearcase-fprop-unstore-properties filename))))
-
-;;}}}
-
-;;{{{ A kill-emacs-hook
-
-(defun clearcase-hook-kill-emacs-hook ()
- (clearcase-utl-clean-tempfiles))
-
-;;}}}
-
-;;}}}
-;;{{{ Function: to replace toggle-read-only
-
-(defun clearcase-toggle-read-only (&optional arg)
- "Change read-only status of current buffer, perhaps via version control.
-If the buffer is visiting a ClearCase version, then check the file in or out.
-Otherwise, just change the read-only flag of the buffer. If called with an
-argument then just change the read-only flag even if visiting a ClearCase
-version."
- (interactive "P")
- (cond (arg
- (toggle-read-only))
- ((and (clearcase-fprop-mtype buffer-file-name)
- buffer-read-only
- (file-writable-p buffer-file-name)
- (/= 0 (user-uid)))
- (toggle-read-only))
-
- ((clearcase-fprop-mtype buffer-file-name)
- (clearcase-next-action-current-buffer))
-
- (t
- (toggle-read-only))))
-
-;;}}}
-;;{{{ Functions: file-name-handlers
-
-;;{{{ Start dynamic views automatically when paths to them are used
-
-;; This handler starts views when viewroot-relative paths are dereferenced.
-;;
-;; nyi: for now really only seems useful on Unix.
-;;
-(defun clearcase-viewroot-relative-file-name-handler (operation &rest args)
-
- (clearcase-when-debugging
- (if (fboundp 'clearcase-utl-syslog)
- (clearcase-utl-syslog "*clearcase-fh-trace*"
- (cons "clearcase-viewroot-relative-file-name-handler:"
- (cons operation args)))))
-
- ;; Inhibit the handler to avoid recursion.
- ;;
- (let ((inhibit-file-name-handlers
- (cons 'clearcase-viewroot-relative-file-name-handler
- (and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
-
- (let ((first-arg (car args)))
- ;; We don't always get called with a string.
- ;; e.g. one file operation is verify-visited-file-modtime, whose
- ;; first argument is a buffer.
- ;;
- (if (stringp first-arg)
- (progn
- ;; Now start the view if necessary
- ;;
- (save-match-data
- (let* ((path (clearcase-path-remove-useless-viewtags first-arg))
- (viewtag (clearcase-vrpath-viewtag path))
- (default-directory (clearcase-path-remove-useless-viewtags default-directory)))
- (if viewtag
- (clearcase-viewtag-try-to-start-view viewtag))))))
- (apply operation args))))
-
-;;}}}
-
-;;{{{ Completion on viewtags
-
-;; This handler provides completion for viewtags.
-;;
-(defun clearcase-viewtag-file-name-handler (operation &rest args)
-
- (clearcase-when-debugging
- (if (fboundp 'clearcase-utl-syslog)
- (clearcase-utl-syslog "*clearcase-fh-trace*"
- (cons "clearcase-viewtag-file-name-handler:"
- (cons operation args)))))
- (cond
-
- ((eq operation 'file-name-completion)
- (save-match-data (apply 'clearcase-viewtag-completion args)))
-
- ((eq operation 'file-name-all-completions)
- (save-match-data (apply 'clearcase-viewtag-completions args)))
-
- (t
- (let ((inhibit-file-name-handlers
- (cons 'clearcase-viewtag-file-name-handler
- (and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
- (apply operation args)))))
-
-(defun clearcase-viewtag-completion (file dir)
- (try-completion file (clearcase-viewtag-all-viewtag-dirs-obarray)))
-
-(defun clearcase-viewtag-completions (file dir)
- (let ((tags (all-completions file
- (clearcase-viewtag-all-viewtags-obarray))))
- (mapcar
- (function (lambda (tag)
- (concat tag "/")))
- tags)))
-
-;;}}}
-
-;;{{{ File name handler for version extended file names
-
-;; For version extended pathnames there are two possible answers
-;; for each of
-;; file-name-directory
-;; file-name-nondirectory
-;;
-;; 1. that pertaining to the element path, e.g.
-;; (file-name-directory "DIR/FILE@@/BRANCH/VERSION")
-;; ==> "DIR/"
-;; 2. that pertaining to the version path, e.g.
-;; (file-name-directory "DIR/FILE@@/BRANCH/VERSION")
-;; ==> "DIR/FILE@@/BRANCH/"
-;;
-;; Often we'd like the former, but sometimes we'd like the latter, for example
-;; inside clearcase-browse-vtree, where it calls dired. Within dired on Gnu
-;; Emacs, it calls file-name-directory on the supplied pathname and in this
-;; case we want the version (i.e. branch) path to be used.
-;;
-;; How to get the behaviour we want ?
-
-;; APPROACH A:
-;; ==========
-;;
-;; Define a variable clearcase-treat-branches-as-dirs, which modifies
-;; the behaviour of clearcase-vxpath-file-name-handler to give answer (1).
-;;
-;; Just before we invoke dired inside clearcase-browse-vtree, dynamically
-;; bind clearcase-treat-branches-as-dirs to t. Also in the resulting Dired Mode
-;; buffer, make clearcase-treat-branches-as-dirs buffer-local and set it.
-;;
-;; Unfortunately this doesn't quite give us what we want. For example I often
-;; invoke grep from a dired buffer on a branch-qua-directory to scan all the
-;; version on that branch for a certain string. The grep-mode buffer has no
-;; buffer-local binding for clearcase-treat-branches-as-dirs so the grep
-;; command runs in "DIR/" instead of in "DIR/FILE@@/BRANCH/".
-;;
-;; APPROACH B:
-;; ==========
-;;
-;; Modify the semantics of clearcase-vxpath-file-name-handler so that
-;; if the filename given is a pathname to an existing branch-qua-directory
-;; give answer 2, otherwise give answer 1.
-;;
-;; APPROACH C:
-;; ==========
-;;
-;; Use the existence of a Dired Mode buffer on "DIR/FILE@@/BRANCH/" to
-;; change the semantics of clearcase-vxpath-file-name-handler.
-;;
-;; (A) is unsatisfactory and I'm not entirely happy with (B) nor (C) so for now
-;; I'm going to disable this filename handler until I'm more convinced it is
-;; needed.
-
-(defun clearcase-vxpath-file-name-handler (operation &rest args)
- (clearcase-when-debugging
- (if (fboundp 'clearcase-utl-syslog)
- (clearcase-utl-syslog "*clearcase-fh-trace*"
- (cons "clearcase-vxpath-file-name-handler:"
- (cons operation args)))))
- ;; Inhibit recursion:
- ;;
- (let ((inhibit-file-name-handlers
- (cons 'clearcase-vxpath-file-name-handler
- (and (eq inhibit-file-name-operation operation)
- inhibit-file-name-handlers)))
- (inhibit-file-name-operation operation))
-
- (cond ((eq operation 'file-name-nondirectory)
- (file-name-nondirectory (clearcase-vxpath-element-part
- (car args))))
-
- ((eq operation 'file-name-directory)
- (file-name-directory (clearcase-vxpath-element-part
- (car args))))
-
- (t
- (apply operation args)))))
-
-;;}}}
-
-;;}}}
-;;{{{ Advice: Disable VC in the MVFS
-
-;; This handler ensures that VC doesn't attempt to operate inside the MVFS.
-;; This stops it from futile searches for RCS directories and the like inside.
-;; It prevents a certain amount of clutter in the MVFS' noent-cache.
-;;
-
-(defadvice vc-registered (around clearcase-interceptor disable compile)
- "Disable normal behavior if in a clearcase dynamic view.
-This is enabled/disabled by clearcase-integrate/clearcase-unintegrate."
- (if (clearcase-file-would-be-in-view-p (ad-get-arg 0))
- nil
- ad-do-it))
-
-;;}}}
-
-;;{{{ Functions: integrate and un-integrate.
-
-;; Prepare for XEmacs 21.5 behavior support.
-;;;###autoload
-(defalias 'clearcase-install 'clearcase-integrate)
-(defalias 'clearcase-uninstall 'clearcase-unintegrate)
-
-;;;###autoload
-(defun clearcase-integrate ()
- "Enable ClearCase integration"
- (interactive)
-
- ;; 0. Empty caches.
- ;;
- (clearcase-fprop-clear-all-properties)
- (clearcase-vprop-clear-all-properties)
-
- ;; 1. Install hooks.
- ;;
- (add-hook 'find-file-hooks 'clearcase-hook-find-file-hook)
- (add-hook 'find-file-hooks 'clearcase-hook-vxpath-find-file-hook)
- (add-hook 'dired-mode-hook 'clearcase-hook-dired-mode-hook)
- (add-hook 'dired-after-readin-hook 'clearcase-hook-dired-after-readin-hook)
- (add-hook 'kill-buffer-hook 'clearcase-hook-kill-buffer-hook)
- (add-hook 'write-file-hooks 'clearcase-hook-write-file-hook)
- (add-hook 'kill-emacs-hook 'clearcase-hook-kill-emacs-hook)
-
- ;; 2. Install file-name handlers.
- ;;
- ;; 2.1 Start views when //view/TAG or m:/TAG is referenced.
- ;;
- (add-to-list 'file-name-handler-alist
- (cons clearcase-vrpath-regexp
- 'clearcase-viewroot-relative-file-name-handler))
-
- ;; 2.2 Completion on viewtags.
- ;;
- (if clearcase-complete-viewtags
- (add-to-list 'file-name-handler-alist
- (cons clearcase-viewtag-regexp
- 'clearcase-viewtag-file-name-handler)))
-
- ;; 2.3 Turn off RCS/VCS/SCCS activity inside a ClearCase dynamic view.
- ;;
- (if clearcase-suppress-vc-within-mvfs
- (when clearcase-suppress-vc-within-mvfs
- (ad-enable-advice 'vc-registered 'around 'clearcase-interceptor)
- (ad-activate 'vc-registered)))
-
- ;; Disabled for now. See comments above clearcase-vxpath-file-name-handler.
- ;;
- ;; ;; 2.4 Add file name handler for version extended path names
- ;; ;;
- ;; (add-to-list 'file-name-handler-alist
- ;; (cons clearcase-vxpath-glue 'clearcase-vxpath-file-name-handler))
- )
-
-;;;###autoload
-(defun clearcase-unintegrate ()
- "Disable ClearCase integration"
- (interactive)
-
- ;; 0. Empty caches.
- ;;
- (clearcase-fprop-clear-all-properties)
- (clearcase-vprop-clear-all-properties)
-
- ;; 1. Remove hooks.
- ;;
- (remove-hook 'find-file-hooks 'clearcase-hook-find-file-hook)
- (remove-hook 'find-file-hooks 'clearcase-hook-vxpath-find-file-hook)
- (remove-hook 'dired-mode-hook 'clearcase-hook-dired-mode-hook)
- (remove-hook 'dired-after-readin-hook 'clearcase-hook-dired-after-readin-hook)
- (remove-hook 'kill-buffer-hook 'clearcase-hook-kill-buffer-hook)
- (remove-hook 'write-file-hooks 'clearcase-hook-write-file-hook)
- (remove-hook 'kill-emacs-hook 'clearcase-hook-kill-emacs-hook)
-
- ;; 2. Remove file-name handlers.
- ;;
- (setq file-name-handler-alist
- (delete-if (function
- (lambda (entry)
- (memq (cdr entry)
- '(clearcase-viewroot-relative-file-name-handler
- clearcase-viewtag-file-name-handler
- clearcase-vxpath-file-name-handler))))
- file-name-handler-alist))
-
- ;; 3. Turn on RCS/VCS/SCCS activity everywhere.
- ;;
- (ad-disable-advice 'vc-registered 'around 'clearcase-interceptor)
- (ad-activate 'vc-registered))
-
-;;}}}
-
-;; Here's where we really wire it all in:
-;;
-(defvar clearcase-cleartool-path nil)
-(defvar clearcase-clearcase-version-installed nil)
-(defvar clearcase-lt nil)
-(defvar clearcase-v3 nil)
-(defvar clearcase-v4 nil)
-(defvar clearcase-v5 nil)
-(defvar clearcase-v6 nil)
-(defvar clearcase-servers-online nil)
-(defvar clearcase-setview-root nil)
-(defvar clearcase-setview-viewtag)
-(defvar clearcase-setview-root nil)
-(defvar clearcase-setview-viewtag nil)
-
-(progn
- ;; If the SHELL environment variable points to the wrong place,
- ;; call-process fails on Windows and this startup fails.
- ;; Check for this and unset the useless EV.
-
- (let ((shell-ev-value (getenv "SHELL")))
- (if clearcase-on-mswindows
- (if (stringp shell-ev-value)
- (if (not (executable-find shell-ev-value))
- (setenv "SHELL" nil)))))
-
- ;; Things have to be done here in a certain order.
- ;;
- ;; 1. Make sure cleartool is on the shell search PATH.
- ;;
- (if (setq clearcase-cleartool-path (clearcase-find-cleartool))
- (progn
- ;; 2. Try to discover what version of ClearCase we have:
- ;;
- (setq clearcase-clearcase-version-installed (clearcase-get-version-string))
- (setq clearcase-lt
- (not (null (string-match "ClearCase LT"
- clearcase-clearcase-version-installed))))
- (setq clearcase-v3
- (not (null (string-match "^ClearCase version 3"
- clearcase-clearcase-version-installed))))
- (setq clearcase-v4
- (not (null (string-match "^ClearCase version 4"
- clearcase-clearcase-version-installed))))
- (setq clearcase-v5
- (not (null (string-match "^ClearCase \\(LT \\)?version 2002.05"
- clearcase-clearcase-version-installed))))
- (setq clearcase-v6
- (not (null (string-match "^ClearCase \\(LT \\)?version 2003.06"
- clearcase-clearcase-version-installed))))
-
- ;; 3. Gather setview information:
- ;;
- (if (setq clearcase-setview-root (if (not clearcase-on-mswindows)
- (getenv "CLEARCASE_ROOT")))
- (setq clearcase-setview-viewtag
- (file-name-nondirectory clearcase-setview-root)))
-
- ;; 4. Discover if the servers appear to be online.
- ;;
- (setq clearcase-servers-online (clearcase-registry-server-online-p))
-
- (if clearcase-servers-online
-
- ;; 5. Everything seems in place to ensure that ClearCase mode will
- ;; operate correctly, so integrate now.
- ;;
- (progn
- (clearcase-integrate)
- ;; Schedule a fetching of the view properties when next idle.
- ;; This avoids awkward pauses after the user reaches for the
- ;; ClearCase menubar entry.
- ;;
- (if clearcase-setview-viewtag
- (clearcase-vprop-schedule-work clearcase-setview-viewtag)))))))
-
-(if (not clearcase-servers-online)
- (message "ClearCase apparently not online. ClearCase/Emacs integration not installed."))
-
-;;}}}
-
-(provide 'clearcase)
-
-;;; clearcase.el ends here
-\f
-;; Local variables:
-;; folded-file: t
-;; clearcase-version-stamp-active: t
-;; End:
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-@c %**start of header
-@setfilename clearcase.info
-@settitle XEmacs Clearcase Reference Manual
-@dircategory XEmacs
-@direntry
-* Clearcase: (clearcase). New Clearcase Version Control for XEmacs (UNIX, Windows).
-@end direntry
-@c footnotestyle separate
-@c paragraphindent 2
-@c %**end of header
-@setchapternewpage odd
-@ifinfo
-This document describes the XEmacs package called clearcase.
-Copyright @copyright{} 2001 Adrian Aichner.
-@end ifinfo
-
-@c @c Combine indices.
-@c @synindex cp fn
-@c @syncodeindex vr fn
-@c @syncodeindex ky fn
-@c @syncodeindex pg fn
-@c @syncodeindex tp fn
-
-@titlepage
-@c @sp 10
-@c @comment The title is printed in a large font.
-@c @center @titlefont{Clearcase}
-@c @c The following two commands start the copyright page.
-@c @page
-@c @vskip 0pt plus 1filll
-@c Copyright @copyright{} 2000 Adrian Aichner.
-@title XEmacs Clearcase Reference Manual
-@subtitle Version 1.00 (for XEmacs 21.1, 21.2), dated 2001-12-09
-
-@author by Adrian Aichner
-@page
-@vskip 0pt plus 1filll
-@sp 2
-@c Version 3.3 @*
-@c Revised for XEmacs Versions 21.0,@*
-@c April 1998.@*
-
-Permission is granted to make and distribute verbatim copies of this
-manual provided the copyright notice and this permission notice are
-preserved on all copies.
-
-Permission is granted to copy and distribute modified versions of this
-manual under the conditions for verbatim copying, provided also that the
-section entitled ``GNU General Public License'' is included
-exactly as in the original, and provided that the entire resulting
-derived work is distributed under the terms of a permission notice
-identical to this one.
-
-Permission is granted to copy and distribute translations of this manual
-into another language, under the above conditions for modified versions,
-except that the section entitled ``GNU General Public License'' may be
-included in a translation approved by the Free Software Foundation
-instead of in the original English.
-@end titlepage
-@node Top, Clearcase Overview, , (dir)
-@comment node-name, next, previous, up
-@chapter Clearcase Package
-
-This is the XEmacs Clearcase Reference Manual, Version 1.00 (for XEmacs
-21.1, 21.2), released 2001-12-09, by @email{adrian@@xemacs.org, Adrian
-Aichner}.
-
-@menu
-* Clearcase Overview:: Overview of clearcase package
-* Clearcase Installation:: Installation of the clearcase package
-* Known Problems of Clearcase:: Problems, Workarounds, and Fixes
-* Concept Index:: An item for each concept
-@end menu
-
-@node Clearcase Overview, Clearcase Installation, Top, (dir)
-@comment node-name, next, previous, up
-@chapter Clearcase Overview
-@cindex What is clearcase?
-
-@code{clearcase} is a Configuration Management System of Rational
-Software Corporation written by @email{esler@@rational.com, Kevin
-Esler}.
-
-The @code{clearcase} package described here supports ClearCase version
-control from within the @code{XEmacs} editor.
-
-@enumerate
-
-@item
-
-Make sure you're using Gnu Emacs-20.4 or XEmacs-21.1 or later.
-
-Make sure that you DON'T load old versions of vc-hooks.el which contain
-incompatible versions of the tq package (functions tq-enqueue and
-friends). In particular, Bill Sommerfeld's VC/CC integration has this
-problem.
-
-@item
-
-Insert this in your emacs startup file:
-(unless (noninteractive)
- (require 'clearcase))
-
-@end enumerate
-
-When you begin editing in any view-context, a ClearCase menu will appear
-and ClearCase Minor Mode will be activated for you.
-
-@node Clearcase Installation, Known Problems of Clearcase, Clearcase Overview, (dir)
-@comment node-name, next, previous, up
-@chapter Clearcase Installation
-@cindex How to install clearcase
-
-You have following three choices to install clearcase (@pxref{Using
-Packages, Using Packages, , xemacs}):
-
-@enumerate
-
-@item
-Use the package GUI:
-
-@itemize @bullet
-
-@item
-In XEmacs Release 21.1:
-
-Select a download site under
-
-@example
-Options->Manage Packages->Add Download Site
-@end example
-
-and after listing available packages with
-
-@example
-Options->Manage Packages->List & Install
-@end example
-
-install @code{clearcase} with
-
-@example
-Packages->Toggle install `clearcase'
-Packages->Install/Remove Selected
-@end example
-
-followed by starting a fresh XEmacs.
-
-@item
-In XEmacs Beta Release 21.2-bXX:
-
-Menus have been re-arranged in XEmacs 21.2.
-
-Select a download site under
-
-@example
-Tools->Packages->Add Download Site
-@end example
-
-and after listing available packages with
-
-@example
-Tools->Packages->List and Install
-@end example
-
-install @code{clearcase} with
-
-@example
-Packages->Toggle install `clearcase'
-Packages->Install/Remove Selected
-@end example
-
-followed by starting a fresh XEmacs.
-
-@end itemize
-
-@item
-Run XEmacs command
-
-@example
-@kbd{M-x package-admin-add-binary-package RET @var{clearcase-package-tarball-path}}
-@end example
-
-after tarball download with EFS or ftp.
-
-@item
-
-Extract the clearcase tarball(s) into the xemacs-packages hierarchy from
-your favorite shell.
-
-@code{bash}, @code{csh}, @code{ksh}, @code{zsh} come to mind on
-@code{UNIX} systems; @code{Cygwin's} @code{bash}, @code{cmd.exe}, and
-@code{command.exe} for @code{Windows 95/98/NT}.
-
-@example
-@kbd{cd @var{installation-directory}/xemacs-packages;
-gzip -dc @var{clearcase-package-tarball-path} | tar -xvf -}
-@end example
-
-@end enumerate
-
-@node Known Problems of Clearcase, Concept Index, Clearcase Installation, Top
-@comment node-name, next, previous, up
-@chapter Known Problems of Clearcase
-@cindex Limitations
-@cindex Bugs
-
-@enumerate
-
-@item
-None known. Please report any using M-x report-emacs-bug.
-
-@end enumerate
-
-@node Concept Index, , Known Problems of Clearcase, Top
-@comment node-name, next, previous, up
-@unnumbered Concept Index
-@printindex cp
-@contents
-@bye
+++ /dev/null
-(clearcase
- (standards-version 1.0
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority low
- category CATEGORY
- dump nil
- description "New Clearcase Version Control for XEmacs (UNIX, Windows)."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (clearcase)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 3, 29 June 2007
-
- Copyright (C) 2007 Free Software Foundation, Inc. <http://fsf.org/>
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The GNU General Public License is a free, copyleft license for
-software and other kinds of works.
-
- The licenses for most software and other practical works are designed
-to take away your freedom to share and change the works. By contrast,
-the GNU General Public License is intended to guarantee your freedom to
-share and change all versions of a program--to make sure it remains free
-software for all its users. We, the Free Software Foundation, use the
-GNU General Public License for most of our software; it applies also to
-any other work released this way by its authors. You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-them if you wish), that you receive source code or can get it if you
-want it, that you can change the software or use pieces of it in new
-free programs, and that you know you can do these things.
-
- To protect your rights, we need to prevent others from denying you
-these rights or asking you to surrender the rights. Therefore, you have
-certain responsibilities if you distribute copies of the software, or if
-you modify it: responsibilities to respect the freedom of others.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must pass on to the recipients the same
-freedoms that you received. You must make sure that they, too, receive
-or can get the source code. And you must show them these terms so they
-know their rights.
-
- Developers that use the GNU GPL protect your rights with two steps:
-(1) assert copyright on the software, and (2) offer you this License
-giving you legal permission to copy, distribute and/or modify it.
-
- For the developers' and authors' protection, the GPL clearly explains
-that there is no warranty for this free software. For both users' and
-authors' sake, the GPL requires that modified versions be marked as
-changed, so that their problems will not be attributed erroneously to
-authors of previous versions.
-
- Some devices are designed to deny users access to install or run
-modified versions of the software inside them, although the manufacturer
-can do so. This is fundamentally incompatible with the aim of
-protecting users' freedom to change the software. The systematic
-pattern of such abuse occurs in the area of products for individuals to
-use, which is precisely where it is most unacceptable. Therefore, we
-have designed this version of the GPL to prohibit the practice for those
-products. If such problems arise substantially in other domains, we
-stand ready to extend this provision to those domains in future versions
-of the GPL, as needed to protect the freedom of users.
-
- Finally, every program is threatened constantly by software patents.
-States should not allow patents to restrict development and use of
-software on general-purpose computers, but in those that do, we wish to
-avoid the special danger that patents applied to a free program could
-make it effectively proprietary. To prevent this, the GPL assures that
-patents cannot be used to render the program non-free.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-
- TERMS AND CONDITIONS
-
- 0. Definitions.
-
- "This License" refers to version 3 of the GNU General Public License.
-
- "Copyright" also means copyright-like laws that apply to other kinds of
-works, such as semiconductor masks.
-
- "The Program" refers to any copyrightable work licensed under this
-License. Each licensee is addressed as "you". "Licensees" and
-"recipients" may be individuals or organizations.
-
- To "modify" a work means to copy from or adapt all or part of the work
-in a fashion requiring copyright permission, other than the making of an
-exact copy. The resulting work is called a "modified version" of the
-earlier work or a work "based on" the earlier work.
-
- A "covered work" means either the unmodified Program or a work based
-on the Program.
-
- To "propagate" a work means to do anything with it that, without
-permission, would make you directly or secondarily liable for
-infringement under applicable copyright law, except executing it on a
-computer or modifying a private copy. Propagation includes copying,
-distribution (with or without modification), making available to the
-public, and in some countries other activities as well.
-
- To "convey" a work means any kind of propagation that enables other
-parties to make or receive copies. Mere interaction with a user through
-a computer network, with no transfer of a copy, is not conveying.
-
- An interactive user interface displays "Appropriate Legal Notices"
-to the extent that it includes a convenient and prominently visible
-feature that (1) displays an appropriate copyright notice, and (2)
-tells the user that there is no warranty for the work (except to the
-extent that warranties are provided), that licensees may convey the
-work under this License, and how to view a copy of this License. If
-the interface presents a list of user commands or options, such as a
-menu, a prominent item in the list meets this criterion.
-
- 1. Source Code.
-
- The "source code" for a work means the preferred form of the work
-for making modifications to it. "Object code" means any non-source
-form of a work.
-
- A "Standard Interface" means an interface that either is an official
-standard defined by a recognized standards body, or, in the case of
-interfaces specified for a particular programming language, one that
-is widely used among developers working in that language.
-
- The "System Libraries" of an executable work include anything, other
-than the work as a whole, that (a) is included in the normal form of
-packaging a Major Component, but which is not part of that Major
-Component, and (b) serves only to enable use of the work with that
-Major Component, or to implement a Standard Interface for which an
-implementation is available to the public in source code form. A
-"Major Component", in this context, means a major essential component
-(kernel, window system, and so on) of the specific operating system
-(if any) on which the executable work runs, or a compiler used to
-produce the work, or an object code interpreter used to run it.
-
- The "Corresponding Source" for a work in object code form means all
-the source code needed to generate, install, and (for an executable
-work) run the object code and to modify the work, including scripts to
-control those activities. However, it does not include the work's
-System Libraries, or general-purpose tools or generally available free
-programs which are used unmodified in performing those activities but
-which are not part of the work. For example, Corresponding Source
-includes interface definition files associated with source files for
-the work, and the source code for shared libraries and dynamically
-linked subprograms that the work is specifically designed to require,
-such as by intimate data communication or control flow between those
-subprograms and other parts of the work.
-
- The Corresponding Source need not include anything that users
-can regenerate automatically from other parts of the Corresponding
-Source.
-
- The Corresponding Source for a work in source code form is that
-same work.
-
- 2. Basic Permissions.
-
- All rights granted under this License are granted for the term of
-copyright on the Program, and are irrevocable provided the stated
-conditions are met. This License explicitly affirms your unlimited
-permission to run the unmodified Program. The output from running a
-covered work is covered by this License only if the output, given its
-content, constitutes a covered work. This License acknowledges your
-rights of fair use or other equivalent, as provided by copyright law.
-
- You may make, run and propagate covered works that you do not
-convey, without conditions so long as your license otherwise remains
-in force. You may convey covered works to others for the sole purpose
-of having them make modifications exclusively for you, or provide you
-with facilities for running those works, provided that you comply with
-the terms of this License in conveying all material for which you do
-not control copyright. Those thus making or running the covered works
-for you must do so exclusively on your behalf, under your direction
-and control, on terms that prohibit them from making any copies of
-your copyrighted material outside their relationship with you.
-
- Conveying under any other circumstances is permitted solely under
-the conditions stated below. Sublicensing is not allowed; section 10
-makes it unnecessary.
-
- 3. Protecting Users' Legal Rights From Anti-Circumvention Law.
-
- No covered work shall be deemed part of an effective technological
-measure under any applicable law fulfilling obligations under article
-11 of the WIPO copyright treaty adopted on 20 December 1996, or
-similar laws prohibiting or restricting circumvention of such
-measures.
-
- When you convey a covered work, you waive any legal power to forbid
-circumvention of technological measures to the extent such circumvention
-is effected by exercising rights under this License with respect to
-the covered work, and you disclaim any intention to limit operation or
-modification of the work as a means of enforcing, against the work's
-users, your or third parties' legal rights to forbid circumvention of
-technological measures.
-
- 4. Conveying Verbatim Copies.
-
- You may convey verbatim copies of the Program's source code as you
-receive it, in any medium, provided that you conspicuously and
-appropriately publish on each copy an appropriate copyright notice;
-keep intact all notices stating that this License and any
-non-permissive terms added in accord with section 7 apply to the code;
-keep intact all notices of the absence of any warranty; and give all
-recipients a copy of this License along with the Program.
-
- You may charge any price or no price for each copy that you convey,
-and you may offer support or warranty protection for a fee.
-
- 5. Conveying Modified Source Versions.
-
- You may convey a work based on the Program, or the modifications to
-produce it from the Program, in the form of source code under the
-terms of section 4, provided that you also meet all of these conditions:
-
- a) The work must carry prominent notices stating that you modified
- it, and giving a relevant date.
-
- b) The work must carry prominent notices stating that it is
- released under this License and any conditions added under section
- 7. This requirement modifies the requirement in section 4 to
- "keep intact all notices".
-
- c) You must license the entire work, as a whole, under this
- License to anyone who comes into possession of a copy. This
- License will therefore apply, along with any applicable section 7
- additional terms, to the whole of the work, and all its parts,
- regardless of how they are packaged. This License gives no
- permission to license the work in any other way, but it does not
- invalidate such permission if you have separately received it.
-
- d) If the work has interactive user interfaces, each must display
- Appropriate Legal Notices; however, if the Program has interactive
- interfaces that do not display Appropriate Legal Notices, your
- work need not make them do so.
-
- A compilation of a covered work with other separate and independent
-works, which are not by their nature extensions of the covered work,
-and which are not combined with it such as to form a larger program,
-in or on a volume of a storage or distribution medium, is called an
-"aggregate" if the compilation and its resulting copyright are not
-used to limit the access or legal rights of the compilation's users
-beyond what the individual works permit. Inclusion of a covered work
-in an aggregate does not cause this License to apply to the other
-parts of the aggregate.
-
- 6. Conveying Non-Source Forms.
-
- You may convey a covered work in object code form under the terms
-of sections 4 and 5, provided that you also convey the
-machine-readable Corresponding Source under the terms of this License,
-in one of these ways:
-
- a) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by the
- Corresponding Source fixed on a durable physical medium
- customarily used for software interchange.
-
- b) Convey the object code in, or embodied in, a physical product
- (including a physical distribution medium), accompanied by a
- written offer, valid for at least three years and valid for as
- long as you offer spare parts or customer support for that product
- model, to give anyone who possesses the object code either (1) a
- copy of the Corresponding Source for all the software in the
- product that is covered by this License, on a durable physical
- medium customarily used for software interchange, for a price no
- more than your reasonable cost of physically performing this
- conveying of source, or (2) access to copy the
- Corresponding Source from a network server at no charge.
-
- c) Convey individual copies of the object code with a copy of the
- written offer to provide the Corresponding Source. This
- alternative is allowed only occasionally and noncommercially, and
- only if you received the object code with such an offer, in accord
- with subsection 6b.
-
- d) Convey the object code by offering access from a designated
- place (gratis or for a charge), and offer equivalent access to the
- Corresponding Source in the same way through the same place at no
- further charge. You need not require recipients to copy the
- Corresponding Source along with the object code. If the place to
- copy the object code is a network server, the Corresponding Source
- may be on a different server (operated by you or a third party)
- that supports equivalent copying facilities, provided you maintain
- clear directions next to the object code saying where to find the
- Corresponding Source. Regardless of what server hosts the
- Corresponding Source, you remain obligated to ensure that it is
- available for as long as needed to satisfy these requirements.
-
- e) Convey the object code using peer-to-peer transmission, provided
- you inform other peers where the object code and Corresponding
- Source of the work are being offered to the general public at no
- charge under subsection 6d.
-
- A separable portion of the object code, whose source code is excluded
-from the Corresponding Source as a System Library, need not be
-included in conveying the object code work.
-
- A "User Product" is either (1) a "consumer product", which means any
-tangible personal property which is normally used for personal, family,
-or household purposes, or (2) anything designed or sold for incorporation
-into a dwelling. In determining whether a product is a consumer product,
-doubtful cases shall be resolved in favor of coverage. For a particular
-product received by a particular user, "normally used" refers to a
-typical or common use of that class of product, regardless of the status
-of the particular user or of the way in which the particular user
-actually uses, or expects or is expected to use, the product. A product
-is a consumer product regardless of whether the product has substantial
-commercial, industrial or non-consumer uses, unless such uses represent
-the only significant mode of use of the product.
-
- "Installation Information" for a User Product means any methods,
-procedures, authorization keys, or other information required to install
-and execute modified versions of a covered work in that User Product from
-a modified version of its Corresponding Source. The information must
-suffice to ensure that the continued functioning of the modified object
-code is in no case prevented or interfered with solely because
-modification has been made.
-
- If you convey an object code work under this section in, or with, or
-specifically for use in, a User Product, and the conveying occurs as
-part of a transaction in which the right of possession and use of the
-User Product is transferred to the recipient in perpetuity or for a
-fixed term (regardless of how the transaction is characterized), the
-Corresponding Source conveyed under this section must be accompanied
-by the Installation Information. But this requirement does not apply
-if neither you nor any third party retains the ability to install
-modified object code on the User Product (for example, the work has
-been installed in ROM).
-
- The requirement to provide Installation Information does not include a
-requirement to continue to provide support service, warranty, or updates
-for a work that has been modified or installed by the recipient, or for
-the User Product in which it has been modified or installed. Access to a
-network may be denied when the modification itself materially and
-adversely affects the operation of the network or violates the rules and
-protocols for communication across the network.
-
- Corresponding Source conveyed, and Installation Information provided,
-in accord with this section must be in a format that is publicly
-documented (and with an implementation available to the public in
-source code form), and must require no special password or key for
-unpacking, reading or copying.
-
- 7. Additional Terms.
-
- "Additional permissions" are terms that supplement the terms of this
-License by making exceptions from one or more of its conditions.
-Additional permissions that are applicable to the entire Program shall
-be treated as though they were included in this License, to the extent
-that they are valid under applicable law. If additional permissions
-apply only to part of the Program, that part may be used separately
-under those permissions, but the entire Program remains governed by
-this License without regard to the additional permissions.
-
- When you convey a copy of a covered work, you may at your option
-remove any additional permissions from that copy, or from any part of
-it. (Additional permissions may be written to require their own
-removal in certain cases when you modify the work.) You may place
-additional permissions on material, added by you to a covered work,
-for which you have or can give appropriate copyright permission.
-
- Notwithstanding any other provision of this License, for material you
-add to a covered work, you may (if authorized by the copyright holders of
-that material) supplement the terms of this License with terms:
-
- a) Disclaiming warranty or limiting liability differently from the
- terms of sections 15 and 16 of this License; or
-
- b) Requiring preservation of specified reasonable legal notices or
- author attributions in that material or in the Appropriate Legal
- Notices displayed by works containing it; or
-
- c) Prohibiting misrepresentation of the origin of that material, or
- requiring that modified versions of such material be marked in
- reasonable ways as different from the original version; or
-
- d) Limiting the use for publicity purposes of names of licensors or
- authors of the material; or
-
- e) Declining to grant rights under trademark law for use of some
- trade names, trademarks, or service marks; or
-
- f) Requiring indemnification of licensors and authors of that
- material by anyone who conveys the material (or modified versions of
- it) with contractual assumptions of liability to the recipient, for
- any liability that these contractual assumptions directly impose on
- those licensors and authors.
-
- All other non-permissive additional terms are considered "further
-restrictions" within the meaning of section 10. If the Program as you
-received it, or any part of it, contains a notice stating that it is
-governed by this License along with a term that is a further
-restriction, you may remove that term. If a license document contains
-a further restriction but permits relicensing or conveying under this
-License, you may add to a covered work material governed by the terms
-of that license document, provided that the further restriction does
-not survive such relicensing or conveying.
-
- If you add terms to a covered work in accord with this section, you
-must place, in the relevant source files, a statement of the
-additional terms that apply to those files, or a notice indicating
-where to find the applicable terms.
-
- Additional terms, permissive or non-permissive, may be stated in the
-form of a separately written license, or stated as exceptions;
-the above requirements apply either way.
-
- 8. Termination.
-
- You may not propagate or modify a covered work except as expressly
-provided under this License. Any attempt otherwise to propagate or
-modify it is void, and will automatically terminate your rights under
-this License (including any patent licenses granted under the third
-paragraph of section 11).
-
- However, if you cease all violation of this License, then your
-license from a particular copyright holder is reinstated (a)
-provisionally, unless and until the copyright holder explicitly and
-finally terminates your license, and (b) permanently, if the copyright
-holder fails to notify you of the violation by some reasonable means
-prior to 60 days after the cessation.
-
- Moreover, your license from a particular copyright holder is
-reinstated permanently if the copyright holder notifies you of the
-violation by some reasonable means, this is the first time you have
-received notice of violation of this License (for any work) from that
-copyright holder, and you cure the violation prior to 30 days after
-your receipt of the notice.
-
- Termination of your rights under this section does not terminate the
-licenses of parties who have received copies or rights from you under
-this License. If your rights have been terminated and not permanently
-reinstated, you do not qualify to receive new licenses for the same
-material under section 10.
-
- 9. Acceptance Not Required for Having Copies.
-
- You are not required to accept this License in order to receive or
-run a copy of the Program. Ancillary propagation of a covered work
-occurring solely as a consequence of using peer-to-peer transmission
-to receive a copy likewise does not require acceptance. However,
-nothing other than this License grants you permission to propagate or
-modify any covered work. These actions infringe copyright if you do
-not accept this License. Therefore, by modifying or propagating a
-covered work, you indicate your acceptance of this License to do so.
-
- 10. Automatic Licensing of Downstream Recipients.
-
- Each time you convey a covered work, the recipient automatically
-receives a license from the original licensors, to run, modify and
-propagate that work, subject to this License. You are not responsible
-for enforcing compliance by third parties with this License.
-
- An "entity transaction" is a transaction transferring control of an
-organization, or substantially all assets of one, or subdividing an
-organization, or merging organizations. If propagation of a covered
-work results from an entity transaction, each party to that
-transaction who receives a copy of the work also receives whatever
-licenses to the work the party's predecessor in interest had or could
-give under the previous paragraph, plus a right to possession of the
-Corresponding Source of the work from the predecessor in interest, if
-the predecessor has it or can get it with reasonable efforts.
-
- You may not impose any further restrictions on the exercise of the
-rights granted or affirmed under this License. For example, you may
-not impose a license fee, royalty, or other charge for exercise of
-rights granted under this License, and you may not initiate litigation
-(including a cross-claim or counterclaim in a lawsuit) alleging that
-any patent claim is infringed by making, using, selling, offering for
-sale, or importing the Program or any portion of it.
-
- 11. Patents.
-
- A "contributor" is a copyright holder who authorizes use under this
-License of the Program or a work on which the Program is based. The
-work thus licensed is called the contributor's "contributor version".
-
- A contributor's "essential patent claims" are all patent claims
-owned or controlled by the contributor, whether already acquired or
-hereafter acquired, that would be infringed by some manner, permitted
-by this License, of making, using, or selling its contributor version,
-but do not include claims that would be infringed only as a
-consequence of further modification of the contributor version. For
-purposes of this definition, "control" includes the right to grant
-patent sublicenses in a manner consistent with the requirements of
-this License.
-
- Each contributor grants you a non-exclusive, worldwide, royalty-free
-patent license under the contributor's essential patent claims, to
-make, use, sell, offer for sale, import and otherwise run, modify and
-propagate the contents of its contributor version.
-
- In the following three paragraphs, a "patent license" is any express
-agreement or commitment, however denominated, not to enforce a patent
-(such as an express permission to practice a patent or covenant not to
-sue for patent infringement). To "grant" such a patent license to a
-party means to make such an agreement or commitment not to enforce a
-patent against the party.
-
- If you convey a covered work, knowingly relying on a patent license,
-and the Corresponding Source of the work is not available for anyone
-to copy, free of charge and under the terms of this License, through a
-publicly available network server or other readily accessible means,
-then you must either (1) cause the Corresponding Source to be so
-available, or (2) arrange to deprive yourself of the benefit of the
-patent license for this particular work, or (3) arrange, in a manner
-consistent with the requirements of this License, to extend the patent
-license to downstream recipients. "Knowingly relying" means you have
-actual knowledge that, but for the patent license, your conveying the
-covered work in a country, or your recipient's use of the covered work
-in a country, would infringe one or more identifiable patents in that
-country that you have reason to believe are valid.
-
- If, pursuant to or in connection with a single transaction or
-arrangement, you convey, or propagate by procuring conveyance of, a
-covered work, and grant a patent license to some of the parties
-receiving the covered work authorizing them to use, propagate, modify
-or convey a specific copy of the covered work, then the patent license
-you grant is automatically extended to all recipients of the covered
-work and works based on it.
-
- A patent license is "discriminatory" if it does not include within
-the scope of its coverage, prohibits the exercise of, or is
-conditioned on the non-exercise of one or more of the rights that are
-specifically granted under this License. You may not convey a covered
-work if you are a party to an arrangement with a third party that is
-in the business of distributing software, under which you make payment
-to the third party based on the extent of your activity of conveying
-the work, and under which the third party grants, to any of the
-parties who would receive the covered work from you, a discriminatory
-patent license (a) in connection with copies of the covered work
-conveyed by you (or copies made from those copies), or (b) primarily
-for and in connection with specific products or compilations that
-contain the covered work, unless you entered into that arrangement,
-or that patent license was granted, prior to 28 March 2007.
-
- Nothing in this License shall be construed as excluding or limiting
-any implied license or other defenses to infringement that may
-otherwise be available to you under applicable patent law.
-
- 12. No Surrender of Others' Freedom.
-
- If conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot convey a
-covered work so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you may
-not convey it at all. For example, if you agree to terms that obligate you
-to collect a royalty for further conveying from those to whom you convey
-the Program, the only way you could satisfy both those terms and this
-License would be to refrain entirely from conveying the Program.
-
- 13. Use with the GNU Affero General Public License.
-
- Notwithstanding any other provision of this License, you have
-permission to link or combine any covered work with a work licensed
-under version 3 of the GNU Affero General Public License into a single
-combined work, and to convey the resulting work. The terms of this
-License will continue to apply to the part which is the covered work,
-but the special requirements of the GNU Affero General Public License,
-section 13, concerning interaction through a network will apply to the
-combination as such.
-
- 14. Revised Versions of this License.
-
- The Free Software Foundation may publish revised and/or new versions of
-the GNU General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
- Each version is given a distinguishing version number. If the
-Program specifies that a certain numbered version of the GNU General
-Public License "or any later version" applies to it, you have the
-option of following the terms and conditions either of that numbered
-version or of any later version published by the Free Software
-Foundation. If the Program does not specify a version number of the
-GNU General Public License, you may choose any version ever published
-by the Free Software Foundation.
-
- If the Program specifies that a proxy can decide which future
-versions of the GNU General Public License can be used, that proxy's
-public statement of acceptance of a version permanently authorizes you
-to choose that version for the Program.
-
- Later license versions may give you additional or different
-permissions. However, no additional obligations are imposed on any
-author or copyright holder as a result of your choosing to follow a
-later version.
-
- 15. Disclaimer of Warranty.
-
- THERE IS NO WARRANTY FOR THE PROGRAM, TO THE EXTENT PERMITTED BY
-APPLICABLE LAW. EXCEPT WHEN OTHERWISE STATED IN WRITING THE COPYRIGHT
-HOLDERS AND/OR OTHER PARTIES PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY
-OF ANY KIND, EITHER EXPRESSED OR IMPLIED, INCLUDING, BUT NOT LIMITED TO,
-THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR
-PURPOSE. THE ENTIRE RISK AS TO THE QUALITY AND PERFORMANCE OF THE PROGRAM
-IS WITH YOU. SHOULD THE PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF
-ALL NECESSARY SERVICING, REPAIR OR CORRECTION.
-
- 16. Limitation of Liability.
-
- IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MODIFIES AND/OR CONVEYS
-THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES, INCLUDING ANY
-GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING OUT OF THE
-USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED TO LOSS OF
-DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY YOU OR THIRD
-PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER PROGRAMS),
-EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE POSSIBILITY OF
-SUCH DAMAGES.
-
- 17. Interpretation of Sections 15 and 16.
-
- If the disclaimer of warranty and limitation of liability provided
-above cannot be given local legal effect according to their terms,
-reviewing courts shall apply local law that most closely approximates
-an absolute waiver of all civil liability in connection with the
-Program, unless a warranty or assumption of liability accompanies a
-copy of the Program in return for a fee.
-
- END OF TERMS AND CONDITIONS
-
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-state the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) <year> <name of author>
-
- This program 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 3 of the License, or
- (at your option) any later version.
-
- This program 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 this program. If not, see <http://www.gnu.org/licenses/>.
-
-Also add information on how to contact you by electronic and paper mail.
-
- If the program does terminal interaction, make it output a short
-notice like this when it starts in an interactive mode:
-
- <program> Copyright (C) <year> <name of author>
- This program comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, your program's commands
-might be different; for a GUI interface, you would use an "about box".
-
- You should also get your employer (if you work as a programmer) or school,
-if any, to sign a "copyright disclaimer" for the program, if necessary.
-For more information on this, and how to apply and follow the GNU GPL, see
-<http://www.gnu.org/licenses/>.
-
- The GNU General Public License does not permit incorporating your program
-into proprietary programs. If your program is a subroutine library, you
-may consider it more useful to permit linking proprietary applications with
-the library. If this is what you want to do, use the GNU Lesser General
-Public License instead of this License. But first, please read
-<http://www.gnu.org/philosophy/why-not-lgpl.html>.
+++ /dev/null
-2015-10-02 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 2.03 released.
-
-2015-10-01 Henry S. Thompson <ht@inf.ed.ac.uk>
-
- * Makefile (MAINTAINER): change from Mike Kupfer to me
-
-2015-09-18 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 2.02 released.
-
-2015-06-25 Michael Sperber <mike@xemacs.org>
-
- * lisp/parse-time.el (fboundp): Conditionalize this on the
- existence of `digit-char-p'.
-
-2015-02-28 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 2.01 released.
-
-2015-02-26 Mike Kupfer <mike.kupfer@xemacs.org>
-
- * README.xemacs-packaging: New file: notes on packaging Gnus for
- XEmacs.
-
-2014-09-08 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 2.00 released.
-
-2014-08-20 Mats Lidell <matsl@xemacs.org>
-
- * lisp/message.el (message-use-idna): Use nil as default since
- calculated value will not byte-compile.
- * lisp/gnus-art.el (gnus-use-idna): Ditto.
-
-2014-06-22 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.99 released.
-
-2014-05-22 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.98 released.
-
-2014-05-18 Mats Lidell <matsl@xemacs.org>
-
- * gnus-fun.el (gnus-grab-cam-face): Upstream security issue. Do
- not use predictable temp-file name.
- (http://bugs.debian.org/747100) Patch by Glenn Morris.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.97 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.96 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * texi/.cvsignore: Remove.
- * texi/ps/.cvsignore: Remove.
- * .hgignore: New file.
-
-2012-06-26 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.95 released.
-
-2012-06-18 Mike Kupfer <mike.kupfer@xemacs.org>
-
- * gnus/lisp/custom-load.el: Deleted (possibly an artifact from the
- conversion from CVS).
-
- * etc/gnus/dead.xpm: Deleted in favor of the copy in etc/smilies.
-
- * lisp/smiley.el (smiley-nosey-regexp-alist):
- (smiley-deformed-regexp-alist): Add entry for "dead", from
- upstream smiley.el.
-
- * README.readmes: New file describing the upstream READMEs and
- what was done with them.
-
- * Makefile (DATA_2_FILES, DATA_1_FILES): Add the READMEs to the
- list of files to package.
- (EXTRA_SOURCES): Add COPYING (package it, too).
-
- * Makefile (AUTHOR_VERSION): Change to 5.10.10.
-
- Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2010-01-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.94 released.
-
-2008-04-03 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-win.el (gnus-configure-frame, gnus-all-windows-visible-p):
- Fix last change in case the element is not even a symbol.
-
-2008-03-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-win.el (gnus-configure-frame, gnus-all-windows-visible-p):
- Prefer fboundp to functionp so it works with macros as well.
-
-2008-04-07 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mail-source.el (mail-source-value):
- Prefer fboundp to functionp so it works with macros as well.
-
-2008-03-25 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.93 released.
-
-2008-03-12 Ville Skyttä <scop@xemacs.org>
-
- * lisp/mm-decode.el (mm-display-external): Use `itimer-list' if
- `timer-list' is not available.
-
-2008-01-02 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.92 released.
-
-2007-12-24 Aidan Kehoe <kehoea@parhasard.net>
-
- * lisp/gnus-sum.el:
- * lisp/gnus-sum.el (put-display-table): New.
- * lisp/gnus-sum.el (get-display-table): New.
- Provide with #'defun-when-void, so as to not override the 21.5
- implementation.
- * lisp/gnus-sum.el (gnus-summary-set-display-table):
- * lisp/gnus-xmas.el (gnus-xmas-summary-set-display-table):
- Use #'put-display-table, not #'aref, to deal with the case where
- the display table is a char table and not a vector.
-
-2007-03-06 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.91 released.
-
-2007-03-05 Mike Kupfer <mike.kupfer@xemacs.org>
-
- * lisp/gnus-spec.el (gnus-parse-simple-format): Add required 2nd
- argument to (setq dontinsert), using the fix from the HEAD
- branch at gnus.org.
-
- * Makefile (AUTHOR_VERSION): Change to 5.10.8.
- (MAINTAINER): Change from Steve Youngs to me.
-
- * Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2006-03-16 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.90 released.
-
-2006-03-16 Steve Youngs <steve@sxemacs.org>
-
- * Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2006-01-04 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.89 released.
-
-2006-01-04 Steve Youngs <steve@sxemacs.org>
-
- * Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2005-12-19 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.88 released.
-
-2005-12-19 Steve Youngs <steve@sxemacs.org>
-
- * Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2005-11-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.87 released.
-
-2005-11-15 Steve Youngs <steve@sxemacs.org>
-
- * Sync with upstream stable branch.
- Please see the ChangeLog.upstream files for details.
-
-2005-10-12 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.86 released.
-
-2005-04-03 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.85 released.
-
-2005-04-03 Steve Youngs <steve@sxemacs.org>
-
- * lisp/gnus-sum.el (gnus-summary-make-menu-bar): Fix an
- "unrecognised menu descriptor" error.
- From Katsumi Yamaoka <yamaoka@jpl.org>
-
-2005-03-20 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.84 released.
-
-2005-03-19 Aidan Kehoe <kehoea@parhasard.net>
-
- * lisp/mm-util.el (mm-xemacs-find-mime-charset): Only call
- mm-xemacs-find-mime-charset-1 if we have the mule feature
- available at runtime.
-
-2005-03-14 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.83 released.
-
-2005-03-14 Aidan Kehoe <kehoea@parhasard.net>
-
- * lisp/mm-util.el (mm-coding-system-priorities): Healthier default
- with non-Japanese language environments.
-
-2005-03-13 Steve Youngs <steve@sxemacs.org>
-
- * lisp/gnus-util.el (gnus-emacs-version): Support SXEmacs in
- `gnus-extended-version'.
-
-2005-03-13 Steve Youngs <steve@sxemacs.org>
-
- * lisp/gnus.el: Don't try and mark `gnus-agent-save-groups' as an
- autoloaded function.
- From: Andrey Slusar <anrays@gmail.com>.
-
-2005-03-13 Steve Youngs <steve@sxemacs.org>
-
- * Sync to upstream 5.10 branch.
- See ChangeLog.upstream files for details.
-
- * Makefile (AUTHOR_VERSION): Bump to 5.10.7
-
-2004-10-01 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.82 released.
-
-2004-09-29 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.81 released.
-
-2004-09-28 Steve Youngs <steve@youngs.au.com>
-
- * Sync to upstream 5.10 branch.
- See ChangeLog.upstream files for details.
-
-2004-06-07 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.80 released.
-
-2004-06-07 Steve Youngs <steve@youngs.au.com>
-
- * Makefile (MAINTAINER): Update my email address.
-
- * Sync to upstream 5.10 branch.
- Upstream Gnus has branched off a 5.10 series (there is talk of a
- 5.10.7 release some time). This syncs our package to that. See
- the ChangeLog.upstream files for details.
-
- * lisp/gnus-idna.el: Removed.
- Unfortunately there is no mention of this in the upstream
- ChangeLogs.
-
-2004-01-27 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.79 released.
-
-2004-01-26 Jerry James <james@xemacs.org>
-
- * lisp/gnus-spec.el (gnus-parse-simple-format): Fix setq value
- omission.
-
-2004-01-17 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.78 released.
-
-2004-01-16 Steve Youngs <sryoungs@bigpond.net.au>
-
- * lisp/gnus.el: Autoload `message-y-or-n-p'
-
-2004-01-12 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.77 released.
-
-2004-01-12 Steve Youngs <sryoungs@bigpond.net.au>
-
- * Makefile (DONTCOMPILE): Add _pkg.el, auto-autoloads.el, and
- custom-load.el to prevent circular dependencies and double files
- in the tarballs.
-
-2004-01-05 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.76 released.
-
-2004-01-05 Steve Youngs <sryoungs@bigpond.net.au>
-
- * Makefile (AUTHOR_VERSION): Gnus 5.10.6 is released.
- See the ChangeLog.upstream files for details.
-
-2003-12-08 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.75 released.
-
-2003-12-08 Steve Youngs <sryoungs@bigpond.net.au>
-
- * lisp/lpath.el: Maybe bind `with-timeout'.
-
- * lisp/dgnushack-xemacs.el: Defalias `match-string-no-properties'
- to `match-string'.
-
- * Makefile (DONTCOMPILE): Add gpg*.el.
- (REQUIRES): Remove rmail, tm, and apel.
-
-2003-12-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lisp/gnus-util.el: Revert 2003-11-29 change, instead, provide the
- compiler macro for rmail-select-summary if rmail is not available.
-
-2003-12-04 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.74 released.
-
-2003-12-03 Steve Youngs <sryoungs@bigpond.net.au>
-
- * Makefile (REQUIRES): Remove fsf-compat, add ps-print.
- (LISPFILES): Removed.
- (DONTCOMPILE): New. For any lisp that shouldn't be compiled.
- (ELCS): Use it.
- (PRELOADS): New. Preload lisp/dgnushack-xemacs.el & lisp/lpath.el
-
- * lisp/dgnushack.el: New. We don't do anything with this file,
- it's only here because it exists in the upstream tree.
-
- * lisp/dgnushack-xemacs.el: New. XEmacs package version of
- above.
-
- * lisp/lpath.el: New. From upstream tree.
-
-2003-11-29 Jerry James <james@xemacs.org>
-
- * lisp/gnus-util.el: Get rmail definitions when compiling.
- * lisp/gnus-xmas.el: Add autoloads for macros defined in gnus.el.
-
-2003-12-01 Steve Youngs <sryoungs@bigpond.net.au>
-
- * lisp/mm-url.el: Require itimer when building with XEmacs.
-
- * lisp/gpg.el: Ditto.
-
-2003-10-13 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.73 released.
-
-2003-10-12 Adrian Aichner <adrian@xemacs.org>
-
- * texi/gnus.texi: General typo and whitespace fixes from gnus CVS,
- carefully avoiding syncing documentation of new features.
- * texi/gnus.texi (Mail Source Specifiers): uref fixes.
-
-2003-10-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.72 released.
-
-2003-10-09 Steve Youngs <sryoungs@bigpond.net.au>
-
- * Makefile (MAINTAINER): Update my email address.
-
-2003-05-18 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.71 released.
-
-2003-05-18 Vin Shelton <acs@xemacs.org>
-
- * Makefile (REQUIRES): Add sasl.
-
-2003-05-14 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.70 released.
-
-2003-05-14 Steve Youngs <youngs@xemacs.org>
-
- * Sync to upstream version 5.10.2
- See the ChangeLog.upstream files for details.
-
- * Makefile (AUTHOR_VERSION): Bump.
-
-2003-05-02 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.69 released.
-
-2003-05-02 Steve Youngs <youngs@xemacs.org>
-
- * Sync to upstream version 5.10.1.
- See the ChangeLog.upstream files for details of changes.
-
- * Makefile (AUTHOR_VERSION): Bump to 5.10.1.
- (REQUIRES): Add pgg, net-utils, os-utils, dired, sieve.
- (EXTRA_SOURCES): Add the upstream ChangeLogs.
- (DATA_2_FILES): Add the .pbm files.
- (DATA_4_FILES): Removed.
- (DATA_4_DEST): Removed.
- (DATA_5_FILES): Removed.
- (DATA_5_DEST): Removed.
- (EXTRA_TEXI_FILES): Remove 'gnusmail.texi', add
- 'doclicense.texi'.
-
- * package-info.in (provides): Update to include all provides.
-
-2003-03-27 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.68 released.
-
-2003-03-27 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (MAINTAINER): Put my name there.
- (LISPFILES): The directory is now 'lisp/' not gnus/lisp/'.
- (EXTRA_SOURCES): Ditto.
- (DATA_5_FILES): Ditto.
- (EXPLICIT_DOCS): Ditto.
- (EXTRA_TEXI_FILES): Ditto.
- (AUTOLOAD_PATH): Ditto.
- (DATA_4_DEST): Put these files into etc/gnus/gnusrefcard/.
- (DATA_5_DEST): Put these files into etc/gnus/.
- (EXTRA_SOURCES): Add lisp/GNUS-NEWS.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
- Don't add custom-load.elc to the list of generated elc's.
- Use EXPLICIT_DOCS instead of explicitly giving the targets
- and dependencies. Specify EXTRA_TEXI_FILES.
-
-2003-03-02 Norbert Koch <nk@viteno.net>
-
- * Makefile (VERSION): XEmacs package 1.67 released.
-
- * Makefile (VERSION): XEmacs package 1.66 released.
-
-2003-01-03 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.65 released.
-
-2002-12-17 Jerry James <james@xemacs.org>
-
- * Makefile (REQUIRES): Add tm and apel to satisfy transitive
- dependencies from rmail.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
- (.PHONY): Remove srckit.
-
-2002-10-14 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (MANUALS): Removed (unused).
-
-2002-09-26 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.64 released.
-
-2002-09-25 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.63 released.
-
-2002-09-17 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (REQUIRES): Add ecrypto, we'll use md5 from there.
- (EXTRA_SOURCES): New, add gnus/lisp/md5.el.upstream.
- * package-info.in (provides): Remove md5.
-
-2002-06-27 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.62 released.
-
-2002-06-08 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.61 released.
-
-2002-05-10 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.60 released.
-
-2002-05-07 Jerry James <james@xemacs.org>
-
- * etc/gnusrefcard/Makefile: Synch with last maintainer version.
- * etc/gnusrefcard/README: Ditto.
- * etc/gnusrefcard/gnusref.tex: Ditto.
-
-2002-03-25 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): 1.59 released.
-
-2002-03-17 Adrian Aichner <adrian@xemacs.org>
-
- * gnus/texi/Makefile: New file.
- * gnus/texi/Makefile: include .../XEmacs.rules for generic HTML
- rules.
- * gnus/texi/Makefile (HTML_FILES): Moved here from ../../Makefile.
- * gnus/texi/Makefile (HTML_DEP): Ditto.
-
-2002-03-17 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile: Add html rule to invoke gnus/texi/Makefile.
-
-2002-01-13 Steve Youngs <youngs@xemacs.org>
-
- * package-info.in (provides): Update to include all provides.
-
-2002-01-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (HTML_FILES): New.
- * Makefile (HTML_DEP): New.
-
-2001-08-29 Don Pellegrino <udpelleg@speakeasy.net>
-
- * ./gnus/lisp/gnus-msg.el (gnus-inews-do-gcc): Don't use
- 'gnus-alive-p".
-
-2001-06-06 Mark Thomas <mthomas@edrc.cmu.edu>
-
- * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To
- fix so it works with older versions of XEmacs.
-
-2001-02-14 Steve Youngs <youngs@xemacs.org>
-
- * gnus-win.el: (gnus-configure-windows). Use 'switch-to-buffer' instead
- of 'set-buffer' if featurep 'xemacs.
- (gnus-remove-some-windows): Ditto.
-
-2001-02-08 Steve Youngs <youngs@xemacs.org>
-
- * Sync with author version 5.8.8.
-
-2000-11-08 Steve Youngs <youngs@xemacs.org>
-
- * ./gnus/lisp/custom-load.el: Removed - generated file.
-
- * ./gnus/lisp/rfc2104.el: Moved to mail-lib package.
-
-2000-11-07 Martin Buchholz <martin@xemacs.org>
-
- * ./gnus/texi/gnus.texi: Doc fix.
-
-2000-10-05 Martin Buchholz <martin@xemacs.org>
-
- * *: Mega typo fix.
-
-2000-09-25 Steve Youngs <youngs@xemacs.org>
-
- * Makefile: Bring into line with author version 5.8.7
- (LISPFILES): New variable.
- (ELCS): Use LISPFILES.
- (DATA_FILES): Use wildcards.
-
-2000-08-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile: Remove target 'clean' because it's covered in XEmacs.rules
- (REQUIRES): Add fsf-compat
-
-2000-07-10 Andreas Jaeger <aj@suse.de>
-
- * Imported version 5.8.7.
-
- * Makefile (ELCS): Added new files.
- (TEXI_FILES): Added new files.
- (REQUIRES): Remove apel and tm since those are not needed
- anymore.
- (MANUALS): Added emacs-mime.
- (INFO_FILES): Added emacs-mime.
- (AUTHOR_VERSION): Updated.
-
-2000-02-13 Gunnar Evermann <ge204@eng.cam.ac.uk>
-
- * Makefile (DATA_2_FILES): Install etc/smilies/*.x?m instead of
- only *.xpm.
- From Yoshiaki Kasahara <kasahara@nc.kyushu-u.ac.jp>
-
-2000-01-07 Andreas Jaeger <aj@suse.de>
-
- * Makefile: Removed mailheader.el.
-
- * gnus/gnus/lisp/mailheader.el: Moved to package mail-lib in
- for Gnus 5.8.x usage.
-
-1999-12-05 Andreas Jaeger <aj@suse.de>
-
- * Makefile (REQUIRES): Add eterm.
- Patch by Jan Vroonhof <vroonhof@math.ethz.ch>.
-
-1999-03-12 Charles G Waldman <cgw@fnal.gov>
-
- * Makefile: install gnus-tut.txt
-
-1999-02-17 SL Baur <steve@xemacs.org>
-
- * Gnus' version of pop3.el is no longer used by XEmacs.
-
-1998-09-25 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.44.
-
-1998-09-05 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.43.
-
-1998-08-28 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.42.
-
-1998-08-27 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.41.
- * Synch with Gnus-5.6.40.
-
-1998-08-22 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.39.
-
-1998-08-19 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.38.
-
-1998-08-14 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.36.
- * Synch with Gnus-5.6.35.
-
-1998-08-13 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.34.
-
-1998-08-11 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.33.
-
-1998-08-09 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.31.
-
-1998-08-06 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.29.
-
-1998-07-26 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.27.
-
-1998-07-24 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.25.
-
-1998-07-06 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.23.
-
-1998-06-29 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.22.
-
-1998-06-27 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.20+gnus.texi patch.
-
-1998-06-26 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.16+Karl Kleinpaste patch.
-
-1998-06-24 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.13.
-
-1998-06-01 SL Baur <steve@altair.xemacs.org>
-
- * Synch with Gnus-5.6.10.
-
-1998-04-06 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (binkit): Use TAR/EXCLUDES variables from XEmacs.rules.
-
-1998-03-31 SL Baur <steve@altair.xemacs.org>
-
- * Synch with gnus-5.6.4.
-
-1998-03-19 SL Baur <steve@altair.xemacs.org>
-
- * Synch with gnus-5.6.3.
-
-1998-03-08 SL Baur <steve@altair.xemacs.org>
-
- * Synch with gnus-5.6.2.
-
-1998-03-07 SL Baur <steve@altair.xemacs.org>
-
- * Synch with gnus-5.6.1.
-
-1998-02-28 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.34.
-
-1998-02-23 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.32.
-
-1998-02-16 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.28.
-
-1998-02-15 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.27.
-
-1998-02-14 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.26.
-
-1998-02-13 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.25.
-
-1998-02-11 SL Baur <steve@altair.xemacs.org>
-
- * Synch with qgnus-0.24.
-
-1998-01-25 SL Baur <steve@altair.xemacs.org>
-
- * gnus/lisp/auto-autoloads.el: Restore.
-
-1998-01-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (VERSION): Update to package standard 1.0.
- * package-info.in: Ditto.
+++ /dev/null
-2008-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * README: Gnus v5.10.10 is released.
-
-2008-03-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * GNUS-NEWS (Installation changes): Mention that spaces and tabs are
- allowed in the installation directory name.
-
- * Makefile.in (datarootdir): Define.
-
- * aclocal.m4 (AC_PATH_LISPDIR): Quote directory name that might contain
- whitespace.
-
- * configure: Regenerate.
-
- * mkinstalldirs: Replace it with the 2006-05-11.19 version.
-
-2008-03-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS (incoming mail files): Add version.
-
-2008-03-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Update for change of `mail-source-delete-incoming'.
-
-2008-03-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Update copyright years.
-
-2007-11-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * README: Bump version to 5.10.9.
-
-2007-11-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (RELEASE_COMMIT_FILES): Add etc/ChangeLog.
- (release-check-settings): Add release-add-changelog
- (release-bump-version): Add check for CODENAME_TO_STABLE. Split off
- release-add-changelog.
- (release-add-changelog): New target. Separate some commands from
- release-bump-version. Add etc/ChangeLog.
- (release-diff-commit-files): New target.
- (RELEASE_COMMIT_FILES): Reorder files.
-
-2007-11-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * COPYING: GPLv3 from Emacs repository.
-
-2007-10-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (SED_I, CODENAME_PATTERN): New.
- (OLD_PATTERN): Adjust.
- (release-bump-version): Use new variables. Allow going from
- development version to release.
-
-2007-10-27 Alexander Solovyov <piranha@piranha.org.ua> (tiny change)
-
- * make.bat: Initial check didn't work if path contained spaces.
-
-2007-10-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-bump-version): Adjust version
- in (gnus)Troubleshooting.
-
-2007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Relicense "GPLv2 or later" files to "GPLv3 or later".
-
-2007-07-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (COMMIT_STRING): New variable.
- (release-bump-version): Use it.
- (bump-version, bump-version-commit): New targets.
-
-2006-07-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Regenerate from Oort Gnus node in texi/gnus.texi using
- texi/gnus-news.el of the trunk.
-
-2006-04-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat (:etc): Simplify.
-
-2006-04-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat: Use "echo *" to clarify the output.
- (:lisp, :infotest): Avoid "not found" errors
- (:etc): Remove etc\gnus. Be more verbose.
-
-2006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * README: Gnus v5.10.8 is released.
-
-2006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-sign-files): Use rm -f.
- (RELEASE_COMMIT_FILES): Add ./ChangeLog.
- (release-bump-version): Add README.
- (release-check-settings): OLD_TAG, not OLDTAG.
- (release-commit): Echo command lines before prompt.
- (RELEASE_COMMIT_FILES): Add README.
- (release-bump-version): Fix gnusversionname substitution.
- (OLD_PATTERN): Add grouping.
-
-2006-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (GZIP_PROG): Use gzip -f.
- (release-bump-version, RELEASE_COMMIT_FILES): Add README.
- (release-sign-files): Remove old *.sig files.
-
- * README: Let sentences end with double space.
-
-2006-04-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (GZIP_PROG): New variable.
- (release-diff): Use it.
- (release-sign-files): New sign-only target. Use GPG_AGENT_INFO.
-
-2006-04-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (TAR_BALL_EXTRA, release-make-tar-ball, README):
- Remove; README is in CVS now.
- (release-files, release-files-signed, release-cvs-export)
- (release-make-tar-ball): Use $(VERSION) instead of $(TAG).
- (OLD_PATTERN): Catch stable and trunk.
- (CIN): New variable.
- (release-files, release-files-signed, release-cvs-export)
- (release-make-tar-ball, release-diff, release-post-clean): Add
- CIN.
- (OLD_PATTERN): Remove quotes.
- (release-bump-version): Fix typo.
-
- * etc/images/README: Add more Emacs 22 icons. Add suggestion on
- how to use those in Emacs 21.
-
- * etc/images/close.xpm, etc/images/cut.xpm, etc/images/home.xpm,
- etc/images/index.xpm, etc/images/jump-to.xpm, etc/images/new.xpm,
- etc/images/next-node.xpm, etc/images/open.xpm,
- etc/images/preferences.xpm, etc/images/prev-node.xpm,
- etc/images/saveas.xpm, etc/images/spell.xpm: New icons duplicated
- from Emacs 22.
-
- * README: Addition from 5.10.6 tar ball. Clarify "beta".
- Simplify Info directory setting. Update required Emacs and XEmacs
- version. Use current Gnus version in examples. texi isn't draft
- anymore.
-
-2006-03-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (CVS_IGNORE_FILES): Additions.
- (release-files-signed): New target.
-
- * etc/images/README, etc/images/cancel.xpm, etc/images/copy.xpm,
- etc/images/diropen.xpm, etc/images/help.xpm,
- etc/images/left-arrow.xpm, etc/images/paste.xpm,
- etc/images/print.xpm, etc/images/redo.xpm,
- etc/images/right-arrow.xpm, etc/images/save.xpm,
- etc/images/search.xpm: Update from the trunk.
-
-2006-03-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Add gnus-group-update-tool-bar. Update version for
- mm-fill-flowed.
-
- * etc/images/separator.xpm: Update from Emacs CVS.
-
-2006-03-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-bump-version): Consider named Gnus versions
- in replacements.
-
-2006-03-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-revert-files): Replace
- release-revert-changelog.
- (release-diff): Remove garbage.
-
-2006-03-11 Miles Bader <miles@gnu.org>
-
- * etc/images/mail: New directory.
- * etc/images/attach.xpm, etc/images/connect.xpm:
- * etc/images/contact.xpm, etc/images/delete.xpm:
- * etc/images/describe.xpm, etc/images/disconnect.xpm:
- * etc/images/exit.xpm, etc/images/gnus/toggle-subscription.xpm:
- * etc/images/lock-broken.xpm, etc/images/lock-ok.xpm:
- * etc/images/lock.xpm, etc/images/mail/compose.xpm:
- * etc/images/mail/copy.xpm, etc/images/mail/forward.xpm:
- * etc/images/mail/inbox.xpm, etc/images/mail/move.xpm:
- * etc/images/mail/not-spam.xpm, etc/images/mail/outbox.xpm:
- * etc/images/mail/preview.xpm, etc/images/mail/reply-all.xpm:
- * etc/images/mail/reply.xpm, etc/images/mail/save-draft.xpm:
- * etc/images/mail/save.xpm, etc/images/mail/send.xpm:
- * etc/images/mail/spam.xpm, etc/images/next-page.xpm:
- * etc/images/refresh.xpm, etc/images/separator.xpm:
- * etc/images/sort-ascending.xpm:
- * etc/images/sort-column-ascending.xpm:
- * etc/images/sort-criteria.xpm, etc/images/sort-descending.xpm:
- * etc/images/sort-row-ascending.xpm:
- New icons, copied from Gnus trunk (originally from Gnome 2.6).
-
-2006-03-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-check-settings): Add status and
- suggestions.
- (release-files): Remove duplicate release-cvs-export.
- (README): New target.
- (release-files, release-make-tar-ball, release-diff): List files.
- (README, release-make-tar-ball): Fix.
-
-2006-03-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (release-*): New targets.
-
-2006-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * xemacs.mak: Remove outdated file. Use make.bat instead.
-
- * GNUS-NEWS: Add `mm-fill-flowed'.
-
-2006-03-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat: Add note about "Out of environment space" on Windows
- 98 SE. Avoid `>' in echo.
-
-2006-02-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * ChangeLog, texi/ChangeLog, lisp/ChangeLog: Fix "From so-and-so"
- and "(tiny change)" entries.
-
-2006-02-27 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change)
-
- * etc/gnus-tut.txt: `G m' instead of `G V'. (Sync 2004-01-07
- change from the trunk).
-
-2006-02-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * make.bat: Make sure that gnus-load.el and sieve are writable to
- avoid breakage. (Sync 2004-03-08 change from the trunk).
-
-2006-02-27 Michael Schierl <schierlm-public@gmx.de> (tiny change)
-
- * make.bat: Fix directory test for Windows 9x/ME. (Sync
- 2004-03-01 change from the trunk).
-
-2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (clean): Clean all subdirectories; remove *~.
- (elclean): Remove lisp/auto-autoloads.el, lisp/custom-load.el, and
- lisp/gnus-load.el.
- (distclean): Don't use sub-make to run clean; use $(MAKE) instead
- of make.
-
- * etc/Makefile.in (clean): New rule.
- (distclean): Use it; remove Makefile.
-
-2005-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * aclocal.m4 (AC_PATH_LISPDIR): Default to .../site-lisp/gnus for
- Emacs.
- (AC_PATH_ETCDIR): Don't change the default value for Emacs.
-
- * configure: Generated.
-
- * Makefile.in (list-installed-shadows): New entry.
- (remove-installed-shadows): New entry.
-
- * GNUS-NEWS: Mention that the Lisp files are now installed in
- .../site-lisp/gnus/ by default.
-
-2005-09-28 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Fix IDNA notes.
-
-2005-02-19 Miles Bader <miles@gnu.org>
-
- * etc/Makefile.in (install): Create $(etcdir)/images/gnus dir.
-
- * etc/Makefile.in (install, uninstall): Fix installed image dirs.
-
- * etc/Makefile.in (install): Put gnus-tut.txt in the right place.
-
- * Makefile.in (all): Don't do sub-make in etc.
- * etc/Makefile.in (all): Remove target.
-
- * make.bat: Do image copies properly.
-
-2005-02-18 Miles Bader <miles@gnu.org>
-
- Move all remaining images from etc/gnus to etc/images/gnus.
-
-2004-06-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (all): Do sub-make in etc.
- * etc/Makefile.in (all): Link . to images.
- (install, uninstall): Use $(etcdir)/images for images.
- * make.bat: Likewise.
-
-2004-06-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat: Fix line endings around arch-tag.
-
-2004-05-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Mention new behavior of `F' and `R' when the region
- is active.
-
-2004-01-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Update copyright.
-
- * etc/gnus-tut.txt (Gnus FAQ): Remove text version. Refer to info
- documentation and online version instead.
-
- * GNUS-NEWS: Changed "Dired integration"
-
-2004-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Add `gnus-group-read-ephemeral-group'.
-
-2003-12-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Mention change of `e' in draft groups.
-
-2003-05-01 Jesper Harder <harder@ifa.au.dk>
-
- * etc/gnus-tut.txt (http): Update.
-
-2003-05-01 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Add prefix limit feature.
-
-2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Added Article Buttons. Added Upgrading (from Simon
- Josefsson). Add gnus-mime-delete-part, markup fixes and some
- other corrections. Mention Gnus FAQ.
-
-
-2003-04-30 Jesper Harder <harder@ifa.au.dk>
-
- * GNUS-NEWS: Additions.
-
-2003-04-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Fixed X-Draft-Headers entry.
-
-2003-04-27 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Fix PGP entry. Doc GCC variable change.
-
-2003-04-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat: Flag as binary to ensure DOS line terminators. Delete
- trailing whitespace.
-
-2003-04-21 Reiner Steib <Reiner.Steib@gmx.de>
- From Frank Schmitt <ich@frank-schmitt.net>
-
- * etc/gnus-tut.txt: Update Gnus FAQ, delete trailing whitespace.
-
-2003-04-17 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * make.bat: Cleaned up end-of-line characters.
-
-2003-04-17 Steve Youngs <youngs@xemacs.org>
-
- * Makefile.in (XEMACS): Use @EMACS@.
-
- * aclocal.m4 (AC_PATH_LISPDIR): Set $datadir to $prefix/lib if
- building with XEmacs.
-
- * aclocal.m4 (AC_SET_BUILD_FLAGS): New. So we can set XEmacs
- command line options to '-batch -no-autoloads...' for a cleaner
- build environment.
-
- * configure.in: Use it.
-
- * configure: Regenerate.
-
-2003-04-16 Reiner Steib <Reiner.Steib@gmx.de>
- From Frank Schmitt <ich@frank-schmitt.net>
-
- * make.bat: New variable EMACS_ARGS. Changed XEmacs args.
-
-2003-03-23 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Add IDNA. Add TLS. Fix USEFOR reference.
-
-2003-03-22 Frank Schmitt <ich@frank-schmitt.net>
-
- * make.bat: Redone from scratch; supports both Emacs and XEmacs
- now; correctly generate gnus-load.el; check for errors; use
- makeinfo if available, infohack.el if it isn't; be less verbose
- when copying files; copy files from etc/gnus and etc/smilies, too
-
-2003-03-22 Frank Schmitt <ich@frank-schmitt.net>
-
- * make-x.bat: Removed, make.bat does its job now.
-
-2003-03-22 Frank Schmitt <ich@frank-schmitt.net>
-
- * etc/gnus-tut.txt: Include Gnus FAQ from http://my.gnus.org.
-
-2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * GNUS-NEWS: Renamed `gnus-unsightly-citation-regexp' to
- `gnus-cite-unsightly-citation-regexp'.
-
-2003-02-18 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Talk about canlock more.
-
-2003-02-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * GNUS-NEWS: Add user visible changes from Michael Shields from
- the past couple of days. Actual text from Michael.
-
-2003-01-24 Jesper Harder <harder@ifa.au.dk>
-
- * etc/gnus-tut.txt: Update.
-
-2003-01-15 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Add. Fix from Reiner Steib
- <4uce.02.r.steib@gmx.net>.
-
-2003-01-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * make.bat: Removed "-no-init-file" (it's the same as "-q"). Use
- new variables EMACSBATCH and GNUS_INFO_DIR. Install gnus-?,
- message-?, sieve and pgg (in texi). Added hint for dir entries.
-
- * make-x.bat: Ditto.
-
-2003-01-13 Simon Josefsson <jas@extundo.com>
-
- * GNUS-NEWS: Add smileys, Sender:, message-utils.
- Expand anti-spam. Fixes.
-
-2003-01-09 Simon Josefsson <jas@extundo.com>
-
- * etc/gnus/preview.xpm: Add.
-
-2003-01-06 Simon Josefsson <jas@extundo.com>
-
- * etc/gnus/receipt.xpm: Add.
-
-2003-01-10 Jesper Harder <harder@ifa.au.dk>
-
- * etc/gnus/preview.xbm: Add.
-
-2003-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * etc/gnus/gnus.xpm (oort): Make the color replaceable.
-
-2002-12-05 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * etc/smilies/*.pbm: Made them binary.
-
-2002-11-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * etc/smilies/blink.xpm: Changed smileys and some new ones from
- Alex Schroeder <alex@emacswiki.org>.
-
-2002-04-26 Steve Youngs <youngs@xemacs.org>
-
- * aclocal.m4 (AC_PATH_INFODIR): New. Defaults to '$prefix/info'
- for Emacs and 'site-packages/info' for XEmacs.
- (AC_PATH_ETCDIR): Drop 'gnus' off the end of the default directory
- for XEmacs.
-
- * configure.in: Use 'AC_PATH_INFO_DIR'.
-
-2002-02-22 Steve Youngs <youngs@xemacs.org>
-
- * aclocal.m4 (AC_PATH_LISPDIR): Default to
- .../site-packages/lisp/gnus for XEmacs.
- (AC_PATH_ETCDIR): Default to .../site-packages/etc/gnus for
- XEmacs.
-
-2002-02-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * etc/gnus/gnus.xpm: Remove some garbages at the end of the file.
-
-2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * etc/gnus/oort.xface (X-Face): Oort X-Face from
- Raymond Scholz <ray-2002@zonix.de>.
-
-2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * etc/gnus/describe-group.xpm: Set pixels of first line to
- background color. A bug in Emacs?
-
-2001-12-18 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog, todo: (oops) changed buffer-file-coding-system back
- to coding.
-
-2001-12-18 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * make-x.bat: Ensure nonempty variable value. Reported by Frank
- Haun <pille3000@gmx.net>.
-
-2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ChangeLog, todo: Add `coding'.
-
-2001-12-17 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog: changed coding to buffer-file-coding-system
- * todo: same
-
-2001-12-10 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * make-x.bat: Code cleanup. Fix a bug with "/copy". From Frank
- Schmitt <ich@Frank-Schmitt.net>.
-
-2001-11-26 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * make-x.bat: Use parameter "/copy" rather than "copy" for increased
- dwimishness for old-time DOS users. From Frank Schmitt
- <ich@Frank-Schmitt.net>.
-
-2001-11-15 Simon Josefsson <jas@extundo.com>
-
- * etc/gnus/unimportant.xpm, etc/gnus/important.xpm: New files.
-
-2001-11-11 Simon Josefsson <jas@extundo.com>
-
- * make-x.bat: Don't use -nw. Suggested by Frank Haun
- <pille3000@gmx.net>.
-
-2001-11-01 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * etc/smilies/blink.xpm: New set of xpm. From Oliver Scholz
- <oscholz@my.gnus.org>.
-
-2001-10-29 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * etc/smilies/sad.pbm: New bitmap.
- * etc/smilies/blink.pbm: Ditto.
- Contributed by Kim F. Storm <storm@cua.dk>.
-
-2001-10-19 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- From Frank Schmitt <ich@Frank-Schmitt.net>.
-
- * make-x.bat: Use correct directory structure for XEmacs on Windows.
-
-2001-10-06 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (uninstall): Add.
-
- * etc/Makefile.in (uninstall): Add.
-
-2001-09-27 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * aclocal.m4 (GNUS_CHECK_FONTS): Typo. Use /dev/null as latex input.
-
-2001-09-27 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * aclocal.m4, configure.in: Check commercial fonts.
-
-2001-09-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * configure.in: Generate texi/ps/Makefile.
-
-2001-09-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * make.bat: Use parameter "/copy" rather than "copy" for increased
- dwimishness for old-time DOS users.
-
-2001-09-18 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * make-x.bat: New.
-
-2001-07-04 Yair Friedman <yairfr@Amdocs.com>
-
- * make.bat: Use infohack.el to create info files.
-
-2001-05-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * etc/Makefile.in (datadir): Set this variable, like in the other
- Makefile.in's. Patch from Gaute B Strokkenes <gs234@cam.ac.uk>.
-
-2001-02-11 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * GNUS-NEWS: Copyright and others.
-
-2001-02-09 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * aclocal.m4 (AC_CHECK_URL): Add.
-
- * configure.in: Use it.
-
-2001-01-15 Jesper Harder <harder@ifa.au.dk>
-
- * make.bat: Fix doc.
-
-2000-12-22 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * configure.in: Add etc/Makefile.
-
-2000-12-20 Jesper Harder <jesper_harder@hotmail.com>
-
- * make.bat: set max-lisp-eval-depth.
-
-2000-10-12 Jesper Harder <jesper_harder@hotmail.com>
-
- * make.bat: Makes it possible to generate the Info files on
- windows again.
-
-2000-08-24 Jesper Harder <jesper_harder@hotmail.com>
-
- * make.bat: Use emacs.exe if emacs.bat does not exist.
-
-2000-05-07 Pavel Janik <Pavel.Janik@inet.cz>
-
- * gnus.texi: direntry added.
-
- * message.texi: direntry added.
-
- * emacs-mime.texi: direntry added.
-
-2000-07-13 10:09:52 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * aclocal.m4 (AC_CHECK_W3): Fix typo.
-
-2000-07-12 15:47:06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * aclocal.m4: Stolen macros from w3.
- * configure.in: Use them.
- * configure: Generate it.
-
-2000-04-22 20:25:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * GNUS-NEWS: Outline.
-
-2000-01-06 Dave Love <fx@gnu.org>
-
- * aclocal.m4 (AM_PATH_LISPDIR): Check for user's EMACS setting.
-
-1999-11-13 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * xemacs.mak: New NMAKE file to support build and install on
- Windows NT.
-
- Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
- 2007 2008 Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; fill-column: 79
-;; add-log-time-zone-rule: t
-;; End:
-
-;;; arch-tag: 60301ba8-b152-41b3-8fb2-173bba77f2a8
+++ /dev/null
-# Makefile for Packaged Gnus code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 2.03
-AUTHOR_VERSION = 5.10.10
-MAINTAINER = Henry S. Thompson <ht@inf.ed.ac.uk>
-PACKAGE = gnus
-PKG_TYPE = regular
-REQUIRES = gnus mail-lib xemacs-base eterm sh-script net-utils os-utils dired \
- mh-e sieve ps-print w3 pgg mailcrypt ecrypto sasl
-
-CATEGORY = standard
-
-DONTCOMPILE = lisp/dgnushack-xemacs.el lisp/dgnushack.el lisp/lpath.el \
- lisp/gpg.el lisp/gpg-ring.el lisp/_pkg.el lisp/auto-autoloads.el \
- lisp/custom-load.el
-
-ELCS = $(patsubst %.el,%.elc,$(filter-out $(DONTCOMPILE),$(wildcard lisp/*.el)))
-
-EXTRA_SOURCES = COPYING $(wildcard lisp/*.upstream) lisp/GNUS-NEWS \
- $(DONTCOMPILE)
-
-DATA_FILES = $(wildcard etc/sounds/*.au) $(wildcard etc/sounds/*.wav)
-DATA_DEST = sounds
-DATA_1_FILES = etc/smilies/README $(wildcard etc/smilies/*.x?m)
-DATA_1_DEST = smilies
-DATA_2_FILES = etc/gnus/GNUS-README etc/gnus/README etc/gnus/README2 \
- etc/gnus/README3 $(wildcard etc/gnus/*.[px]?m) \
- etc/gnus/x-splash
-DATA_2_DEST = $(PACKAGE)
-DATA_3_FILES = etc/gnus-tut.txt
-DATA_3_DEST = $(PACKAGE)
-
-EXPLICIT_DOCS = texi/message.texi texi/gnus.texi texi/emacs-mime.texi
-EXTRA_TEXI_FILES = texi/gnus-faq.texi texi/doclicense.texi
-
-AUTOLOAD_PATH = lisp
-
-PRELOADS = -l dgnushack-xemacs.el -l lpath.el
-
-include ../../XEmacs.rules
-
+++ /dev/null
-The upstream READMEs have been reorganized as follows:
-
-upstream package
-src path src path notes
--------- -------- --------
-README -- build instructions; not needed
-
-contrib/README -- description of libraries in upstream
- contrib directory; not needed
-
-etc/images/ etc/gnus/ copyright and provenance information;
-README README edited to reflect images that we
- include. installed as etc/gnus/README
-
-etc/images/ etc/gnus/ provenance information.
-GNUS-README GNUS-README
-
-etc/images/ etc/gnus/ copyright and provenance information.
-gnus/README README2
-
-etc/images/ etc/gnus/ copyright and provenance information.
-mail/README README3
-
-etc/images/ etc/smilies/ copyright information. installed as
-smilies/ README etc/smilies/README.
-README
+++ /dev/null
--*- outline -*-
-
-This file contains notes on packaging new versions of Gnus.
-
-* What to Merge
-
-XEmacs distributes the "stable" release of Gnus. For a long time
-this was the 5.10 branch. Currently there are at least 3 contenders
-for the "stable" release, and no direction has been forthcoming from
-the Gnus developers. The 3 contenders are
-
- - the latest release in the 5.10 branch
- - the last release in the previous development branch (e.g., if "Ma"
- Gnus is the current development branch, then use the last release
- from the "No" Gnus branch)
- - the version of Gnus that was included in the most recent release
- of GNU Emacs.
-
-In any event, tarballs are no longer being posted on gnus.org.
-Instead, you must download a snapshot from an upstream repo, either
-the Git repository on gnus.org or the Git repository for Emacs.
-
-* How to Merge
-
-** Files to (Not) Include
-
-Upstream Gnus releases contain many files that are not included in the
-XEmacs Gnus package. The following files from the "lisp" directory
-should _NOT_ be included in the XEmacs Gnus package, as they are
-delivered in other XEmacs packages:
-
- dig.el
- dns.el
- hex-util.el
- netrc.el
- pgg-def.el
- pgg-gpg.el
- pgg-parse.el
- pgg-pgp.el
- pgg-pgp5.el
- pgg.el
- pop3.el
- rfc2104.el
- sha1.el
- sieve-manage.el
- sieve-mode.el
- sieve.el
- starttls.el
- tls.el
-
-Corresponding files from the texi directory should also be omitted.
-
-We have not been delivering the current smiley.el, either, because an
-earlier maintainer preferred an old version over the one that is
-currently included in Gnus releases.
-
-The XEmacs Gnus package does include the following files from the
-"contrib" directory:
-
- gpg-ring.el
- gpg.el
- hashcash.el
- nnir.el
- vcard.el
-
-It would make more sense for vcard.el to be included in the mail-lib
-package, so that it can be more easily used by other MUAs, notably VM.
-Getting that fixed will require negotiation with the maintainers for
-mail-lib and VM.
+++ /dev/null
-2008-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * ChangeLog: Gnus v5.10.10 is released.
-
-2008-03-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (datarootdir): Define.
- (install, uninstall): Quote directory name that might contain
- whitespace.
-
-2008-03-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * images/gnus/mail-send.xpm: Add missing legacy image from the trunk.
-
-2007-11-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * ChangeLog: Bump version to 5.10.9.
-
-2007-11-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * images/GNUS-README: Rename from README. Add some information
- about the purpose of the various README files.
-
- * images/README: New. `emacs/etc/images/README' from Emacs.
-
- * ChangeLog: New ChangeLog for `./etc'. Should simplify syncing with
- Emacs a little bit.
-
- Copyright (C) 2007, 2008 Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; fill-column: 79
-;; add-log-time-zone-rule: t
-;; End:
-
-;; arch-tag: 192bae9c-78fa-403d-8482-f2fdcd918cad
+++ /dev/null
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: So you want to use the new Gnus
-Message-ID: <lars-doc1@eyesore.no>
-
-Actually, since you are reading this, chances are you are already
-using the new Gnus. Congratulations.
-
-This entire newsgroup you are reading is, in fact, no real newsgroup
-at all, in the traditional sense. It is an example of one of the
-"foreign" select methods that Gnus may use.
-
-The text you are now reading is stored in the "etc" directory with the
-rest of the Emacs sources. You are using the "nndoc" backend for
-accessing it. Scary, isn't it?
-
-This isn't the real documentation. `M-x info', `m gnus <RET>' to read
-that. This "newsgroup" is intended as a kinder, gentler way of getting
-people started.
-
-Gnus is a rewrite of GNUS 4.1, written by Masanobu Umeda. The rewrite
-was done by moi, yours truly, your humble servant, Lars Magne
-Ingebrigtsen. If you have a WWW browser, you can investigate to your
-heart's delight at <URL:http://www.gnus.org/> and
-<URL:http://quimby.gnus.org/lmi/>.
-
-;; Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@ifi.uio.no>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Starting up
-Message-ID: <lars-doc2@eyesore.no>
-
-If you are having problems with Gnus not finding your server, you have
-to set `gnus-select-method'. A "method" is a way of specifying *how*
-the news is to be found, and from *where*.
-
-Say you want to read news from you local, friendly nntp server
-"news.my.local.server".
-
-(setq gnus-select-method '(nntp "news.my.local.server"))
-
-Quite easy, huh?
-
-From the news spool:
-
-(setq gnus-select-method '(nnspool ""))
-
-From your mh-e spool:
-
-(setq gnus-select-method '(nnmh ""))
-
-There's a whole bunch of other methods for reading mail and news, see
-the "Foreign groups" article for that.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Where are all the groups, then?
-Message-ID: <lars-doc3@eyesore.no>
-
-If this is the first time you have used a newsreader, you won't have a
-.newsrc file. This means that Gnus will think that all the newsgroups
-on the server are "new", and kill them all.
-
-If you have a .newsrc file, the new groups will be processed with the
-function in the `gnus-subscribe-newsgroup-method' variable, which is
-`gnus-subscribe-zombies' by default.
-
-This means that all the groups have been made into "zombies" - not
-quite dead, but not exactly alive, either.
-
-Jump back to the *Group* buffer, and type `A z' to list all the zombie
-groups. Look though the list, and subscribe to the groups you want to
-read by pressing `u' on the one you think look interesting.
-
-If all the groups have been killed, type `A k' to list all the killed
-groups. Subscribe to them the same way.
-
-When you are satisfied, press `S z' to kill all the zombie groups.
-
-Now you should have a nice list of all groups you are interested in.
-
-(If you later want to subscribe to more groups, press `A k' to
-list all the kill groups, and repeat. You can also type `U' and be
-prompted for groups to subscribe to.)
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: I want to read my mail!
-Message-ID: <lars-doc4@eyesore.no>
-
-Yes, Virginia, you can read mail with Gnus.
-
-First you have to decide which mail backend you want to use. You have
-nnml, which is a one-file-one-mail backend, which is quite nice, but
-apt to make your systems administrator go crazy and come after you
-with a shotgun.
-
-nnmbox uses a Unix mail box to store mail. Nice, but slow.
-
-nnmh uses mh-e folders, which is also a one-file-one-mail thingie, but
-slower than nnml. (It doesn't support NOV files.)
-
-So if you want to go with nnmbox, you can simply say:
-
-(setq gnus-secondary-select-methods '((nnmbox "")))
-
-(The same for the other methods, kind of.)
-
-You should also set `nnmail-split-methods' to something sensible:
-
-(setq nnmail-split-methods
- '(("mail.junk" "From:.*Lars")
- ("mail.misc "")))
-
-This will put all mail from me in you junk mail group, and the rest in
-"mail.misc".
-
-These groups will be subscribe the same way as the normal groups, so
-you will probably find them among the zombie groups after you set
-these variables and re-start Gnus.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Foreign newsgroups
-Message-ID: <lars-doc5@eyesore.no>
-
-These are groups that do not come from `gnus-select-method'.
-
-Say you want to read "alt.furniture.couches" from "news.funet.fi". You
-can then either type `B news.funet.fi <RET>' to browse that server and
-subscribe to that group, or you can type
-`G m alt.furniture.couches<RET>nntp<RET>news.funet.fi<RET>', if you
-like to type a lot.
-
-If you want to read a directory as a newsgroup, you can create an
-nndir group, much the same way. There's a shorthand for that,
-though. If, for instance, you want to read the (ding) list archives,
-you could type `G d /ftp <RET>'.
-
-There's lots more to know about foreign groups, but you have to read
-the info pages to find out more.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Low level changes in GNUS, or, Wrong type argument: stringp, nil
-Message-ID: <lars-doc6@eyesore.no>
-
-Gnus really isn't GNUS, even though it looks like it. If you scrape
-the surface, you'll find that most things have changed.
-
-This means that old code that relies on GNUS internals will fail.
-
-In particular, `gnus-newsrc-hashtb', `gnus-newsrc-assoc',
-`gnus-killed-list', the `nntp-header-' macros and the display formats
-have all changed. If you have some code lying around that depend on
-these, or change these, you'll have to re-write your code.
-
-Old hilit19 code does not work at all. In fact, you should probably
-remove all hilit code from all the Gnus hooks
-(`gnus-group-prepare-hook', `gnus-summary-prepare-hook' and
-`gnus-summary-article-hook'). (Well, at the very least the first
-two.) Gnus provides various integrated functions for highlighting,
-which are both faster and more accurated.
-
-There is absolutely no chance, whatsoever, of getting Gnus to work
-with Emacs 18. It won't even work on Emacsen older than Emacs
-20.7/XEmacs 21.1. Upgrade your Emacs or die.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: How do I re-scan my mail groups?
-Message-ID: <lars-doc8@eyesore.no>
-
-Reading the active file from the nntp server is a drag.
-
-Just press `M-g' on the mail groups, and they will be re-scanned.
-
-You can also re-scan all the mail groups by putting them on level 1
-(`S l 1'), and saying `1 g' to re-scan all level 1 groups.
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: How do I set up virtual newsgroups?
-Message-ID: <lars-doc9@eyesore.no>
-
-Virtual newsgroups are collections of other newsgroups. Why people
-want this is beyond me, but here goes:
-
-Create the group by saying
-
-`G m my.virtual.newsgroup<RET>nnvirtual<RET>^rec\.aquaria\.*<RET>'
-
-This will create the group "nnvirtual:my.virtual.newsgroup", which
-will collect all articles from all the groups in the "rec.aquaria"
-hierarchy.
-
-If you want to edit the regular expression, just type `M-e' on the
-group line.
-
-Note that all the groups that are part of the virtual group have to be
-alive. This means that the cannot, absolutely not, be zombie or
-killed. They can be unsubscribed; that's no problem.
-
-You can combine groups from different servers in the same virtual
-newsgroup, something that may actually be useful. Say you have the
-group "comp.headers" on the server "news.server.no" and the same group
-on "news.server.edu". If people have posted articles with Distribution
-headers that stop propagation of their articles, combining these two
-newsgroups into one virtual newsgroup should give you a better view of
-what's going on.
-
-One caveat, though: The virtual group article numbers from the first
-source group (group A) will always be lower than the article numbers
-from the second (group B). This means that Gnus will believe that
-articles from group A are older than articles from group B. Threading
-will lessen these problems, but it might be a good idea to sort the
-threads over the date of the articles to get a correct feel for the
-flow of the groups:
-
-(setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))
-
-If you only want this in virtual groups, you could say something along
-the lines of:
-
-(setq gnus-select-group-hook
- (lambda ()
- (if (eq 'nnvirtual (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- (progn
- (make-local-variable 'gnus-thread-sort-functions)
- (setq gnus-thread-sort-functions '(gnus-thread-sort-by-date))))))
-
-
-From lars Thu Feb 23 23:20:38 1995
-From: larsi@gnus.org (ding)
-Date: Fri Feb 24 13:40:45 1995
-Subject: Bugs & stuff
-Message-ID: <lars-doc7@eyesore.no>
-
-If you want to report a bug, please type `M-x gnus-bug'. This will
-give me a precise overview of your Gnus and Emacs version numbers,
-along with a look at all Gnus variables you have changed.
-
-Du not expect a reply back, but your bug should be fixed in the next
-version. If the bug persists, please re-submit your bug report.
-
-When a bug occurs, I need a recipe for how to trigger the bug. You
-have to tell me exactly what you do to uncover the bug, and you should
-(setq debug-on-error t) and send me the backtrace along with the bug
-report.
-
-If I am not able to reproduce the bug, I won't be able to fix it.
-
-I would, of course, prefer that you locate the bug, fix it, and mail
-me the patches, but one can't have everything.
-
-If you have any questions on usage, the "ding@gnus.org" mailing list
-is where to post the questions.
-
-
-From fschmitt Sat Mar 22 18:13:00 2003
-From: faq@my.gnus.org (Gnus FAQ team)
-Date: Sat Mar 22 18:13:00 2003
-Subject: Gnus FAQ (Frequently Asked Questions)
-Message-ID: <lars-doc9@eyesore.no>
-
-The Gnus FAQ is distributed within the Gnus manual. The home page of
-the Gnus FAQ is <URL:http://my.gnus.org/FAQ/>, where you can find the
-most recent version in HTML various other formats.
-
-To browse the FAQ now, put the cursor at the end of the following line
-and press `C-x C-e':
-
- (info "(gnus)Frequently Asked Questions")
-
-On older XEmacs version, use:
-
- (Info-goto-node "(gnus)Frequently Asked Questions")
-
-Or simply use RET or the middle mouse button, if the above is displayed
-as a clickable button.
-
-
+++ /dev/null
-CONTENTS
-
-COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
-
-ORIGIN OF THE IMAGE FILES
-
-The following icons are from GNOME 2.6:
-
- attach.xpm (stock_attach)
- connect.xpm (stock_connect)
- contact.xpm (stock_contact)
- delete.xpm (stock_delete)
- describe.xpm (stock_properties)
- disconnect.xpm (stock_disconnect)
- exit.xpm (stock_exit)
- lock-broken.xpm (stock_lock_broken)
- lock-ok.xpm (stock_lock_ok)
- lock.xpm (stock_lock)
- next-page.xpm (stock_next-page)
- refresh.xpm (stock_refresh)
- sort-ascending.xpm (stock_sort-ascending)
- sort-column-ascending.xpm (stock_sort-column-ascending)
- sort-criteria.xpm (stock_sort-criteria)
- sort-descending.xpm (stock_sort-descending)
- sort-row-ascending.xpm (stock_sort-row-ascending)
-
- toggle-subscription.xpm (stock_task-recurring)
-
- compose.xpm (stock_mail-compose)
- copy.xpm (stock_mail-copy)
- forward.xpm (stock_mail-forward)
- inbox.xpm (stock_inbox)
- move.xpm (stock_mail-move)
- not-spam.xpm (stock_not-spam)
- outbox.xpm (stock_outbox)
- reply-all.xpm (stock_mail-reply-to-all)
- reply.xpm (stock_mail-reply)
- save-draft.xpm (stock_mail-handling)
- send.xpm (stock_mail-send)
- spam.xpm (stock_spam)
-
-
-The following icons were contributed by Adam Sjøgren <asjo@koldfront.dk>:
-
- preview.xpm (combining stock_mail and stock_zoom)
- save.xpm (combining stock_mail, stock_save and stock_convert)
-
-
-The folling icon are duplicated from Emacs 22. They are either not present in
-Emacs 21 or look different there.
-
- cancel.xpm
- close.xpm
- cut.xpm
- diropen.xpm
- help.xpm
- home.xpm
- index.xpm
- jump-to.xpm
- left-arrow.xpm
- new.xpm
- next-node.xpm
- open.xpm
- paste.xpm
- preferences.xpm
- prev-node.xpm
- print.xpm
- redo.xpm
- right-arrow.xpm
- saveas.xpm
- search.xpm
- separator.xpm
- spell.xpm
-
-You might want to use the following code to get Gnome icons in Emacs 21:
-
- ;; Only for Emacs 21:
- (when (and (not (featurep 'xemacs))
- (not (boundp 'image-load-path))
- tool-bar-mode)
- (push "/path/to/etc/images/" image-load-path)
- (setq tool-bar-map (make-sparse-keymap))
- (clear-image-cache)
- (tool-bar-setup))
-
-
-CONVERSION OF PNG FILES TO XPM
-
-The GNOME's stock_*.png files were converted to XPM using the following GIMP
-script:
-
-;; -*- scheme -*-
-;; Put this file in ~/.gimp-*/scripts/
-;; gimp -i -b '(rs-save-as-xpm "foo.png" "foo.xpm" 127)' '(gimp-quit 0)'
-(define (rs-save-as-xpm filename filename2 threshold)
- (let* ((image (car (gimp-file-load RUN-NONINTERACTIVE filename filename)))
- (drawable (car (gimp-image-get-active-layer image))))
- (file-xpm-save RUN-NONINTERACTIVE image drawable
- filename2 filename2 threshold)
- (gimp-image-delete image)))
-;; end
+++ /dev/null
-* The default GTK icons were not overridden by the GNOME theme due to
- a bug which was fixed in GNOME 2.15. Once GNOME 2.16 is in wide
- circulation, the GTK icons should be replaced with the equivalent
- GNOME icons.
-
-* Recipe for Creating PBM Versions
-
-1. Edit .xpm image in GIMP.
-2. Image > Mode > Indexed. Check Use Black/White Palette and No
- Color Dithering.
-3. File > Save As file.xbm.
-4. Run xbmtopbm < file.xbm > file.pbm.
-
-Thanks to jan.h.d@swipnet.se for the help.
-
-
-COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
-
-Files: gnus.pbm
- Author: Luis Fernandes <elf@ee.ryerson.ca>
- Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
- License: GNU General Public License version 3 or later (see COPYING)
-
-
-* The following icons are from GTK+ 2.x and GNOME 2.x. They are not
-part of Emacs, but distributed and used by Emacs.
-
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
- Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson,
- Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca
- Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco
- Pesenti Gritti
- License: GNU General Public License version 2
-
-* From GTK+ 2.x:
-
- close.xpm cut.xpm help.xpm home.xpm index.xpm
- jump-to.xpm left-arrow.xpm new.xpm open.xpm paste.xpm
- preferences.xpm print.xpm refresh.xpm right-arrow.xpm
- saveas.xpm search.xpm sort-ascending.xpm sort-descending.xpm
- spell.xpm
-
- diropen.xpm is file-manager.png from Gnome hicolor theme.
-
-* From GNOME 2.x:
-
- Emacs images and their source in the GNOME icons stock/ directory:
-
- attach.xpm document/stock_attach
- cancel.xpm slightly modified generic/stock_stop
- connect.xpm net/stock_connect
- contact.xpm net/stock_contact
- delete.xpm generic/stock_delete
- describe.xpm generic/stock_properties
- disconnect.xpm net/stock_disconnect
- exit.xpm generic/stock_exit
- lock-broken.xpm data/stock_lock-broken
- lock-ok.xpm data/stock_lock-ok
- lock.xpm data/stock_lock
- redo.xpm generic/stock_redo
- next-page.xpm navigation/stock_next-page
- refresh.xpm generic/stock_refresh
- separator.xpm ?
- sort-ascending.xpm slightly modified data/stock_sort-ascending
- sort-column-ascending.xpm data/stock_sort-column-ascending
- sort-criteria.xpm data/stock_sort-criteria
- sort-descending.xpm slightly modified data/stock_sort-descending
- sort-row-ascending.xpm data/stock_sort-row-ascending
-
- next-node.xpm and prev-node.xpm are from gthumb version 2.0 (part of
- GNOME 2.x) where they are called next-image-24.png and prev-image-24.png.
+++ /dev/null
-COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
-
-Files: important.xpm, unimportant.xpm
-Author: Simon Josefsson <simon@josefsson.org>
-Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
-License: GNU General Public License version 3 or later (see COPYING)
-
-Files: catchup.pbm catchup.xpm cu-exit.pbm cu-exit.xpm
- describe-group.pbm describe-group.xpm exit-gnus.pbm exit-gnus.xpm
- exit-summ.pbm exit-summ.xpm followup.pbm followup.xpm fuwo.pbm
- fuwo.xpm get-news.pbm get-news.xpm gnntg.pbm gnntg.xpm gnus.xbm
- gnus.xpm gnus-pointer.xbm gnus-pointer.xpm mail-reply.pbm
- mail-reply.xpm next-ur.pbm next-ur.xpm post.pbm post.xpm prev-ur.pbm
- prev-ur.xpm preview.xbm receipt.xpm reply-wo.pbm
- reply-wo.xpm reply.pbm save-aif.pbm save-aif.xpm
- save-art.pbm save-art.xpm subscribe.pbm subscribe.xpm
- unsubscribe.pbm unsubscribe.xpm uu-decode.pbm uu-decode.xpm
- uu-post.pbm uu-post.xpm
-Author: Luis Fernandes <elf@ee.ryerson.ca>
-Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
-License: GNU General Public License version 3 or later (see COPYING)
-
-The following icons are from GNOME 2.x. They are not part of Emacs,
-but distributed and used by Emacs.
-
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
- Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson,
- Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca
- Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco
- Pesenti Gritti
- License: GNU General Public License version 2
-
-toggle-subscription.xpm (GNOME stock/document/stock_task-recurring)
-kill-group.pbm and kill-group.xpm are converted from close.xpm
-rot13.pbm and rot13.xpm are converted from lock.xpm
+++ /dev/null
-COPYRIGHT AND LICENSE INFORMATION FOR IMAGE FILES
-
-The following icons are from GNOME 2.x. They are not part of Emacs,
-but distributed and used by Emacs.
-
- Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007
- Tuomas Kuosmanen, Rodney Dawes, Jakub Steiner, Alexander Larsson,
- Tor Lillqvist, Garrett LeSage, Dennis Cranston, Jody Goldberg, Luca
- Ferretti, Mark Finlay, Lapo Calamandrei, Andreas Nilsson and Marco
- Pesenti Gritti
- License: GNU General Public License version 2
-
-Emacs images and their GNOME source (GNOME icons are from stock/net/
-directory unless otherwise stated):
-
-compose.xpm stock_mail-compose
-copy.xpm stock_mail-copy
-forward.xpm stock_mail-forward
-inbox.xpm stock_inbox
-move.xpm stock_mail-move
-not-spam.xpm stock_not-spam
-outbox.xpm stock_outbox
-preview.xpm combines stock_mail and navigation/stock_zoom
-reply-all.xpm stock_mail-reply-to-all
-reply.xpm stock_mail-reply
-save-draft.xpm stock_mail-handling
-save.xpm combines stock_mail, io/stock_save and
- stock_convert (from gnome-themes)
-send.xpm stock_mail-send
-spam.xpm stock_spam
-
-(preview and save were contributed by Adam Sjøgren <asjo@koldfront.dk>)
-
-The pbm versions (where present) were converted from the xpm versions
-via an essentially automatic procedure (see README).
+++ /dev/null
-/* XPM */
-static char * stock_attach_xpm[] = {
-"24 24 99 2",
-" c None",
-". c #000000",
-"+ c #010101",
-"@ c #515151",
-"# c #9A9A9A",
-"$ c #CFCFCF",
-"% c #6F6F6F",
-"& c #464646",
-"* c #A5A5A5",
-"= c #E2E2E2",
-"- c #FFFFFF",
-"; c #F6F6F6",
-"> c #8A8A8A",
-", c #393939",
-"' c #1C1C1C",
-") c #8B8B8B",
-"! c #E6E6E6",
-"~ c #EEEEEE",
-"{ c #E1E1E1",
-"] c #F8F8F8",
-"^ c #F7F7F7",
-"/ c #CCCCCC",
-"( c #565656",
-"_ c #3E3E3E",
-": c #818181",
-"< c #D4D4D4",
-"[ c #E7E7E7",
-"} c #D7D7D7",
-"| c #FAFAFA",
-"1 c #F9F9F9",
-"2 c #C2C2C2",
-"3 c #CBCBCB",
-"4 c #F5F5F5",
-"5 c #D9D9D9",
-"6 c #030303",
-"7 c #545454",
-"8 c #DEDEDE",
-"9 c #B3B3B3",
-"0 c #797979",
-"a c #F4F4F4",
-"b c #9D9D9D",
-"c c #282828",
-"d c #FBFBFB",
-"e c #A6A6A6",
-"f c #C5C5C5",
-"g c #F0F0F0",
-"h c #CACACA",
-"i c #C7C7C7",
-"j c #F2F2F2",
-"k c #CECECE",
-"l c #C4C4C4",
-"m c #D5D5D5",
-"n c #DADADA",
-"o c #F3F3F3",
-"p c #858585",
-"q c #BEBEBE",
-"r c #D3D3D3",
-"s c #DCDCDC",
-"t c #9C9C9C",
-"u c #484848",
-"v c #A7A7A7",
-"w c #D6D6D6",
-"x c #C8C8C8",
-"y c #C6C6C6",
-"z c #4C4C4C",
-"A c #EAEAEA",
-"B c #E5E5E5",
-"C c #D8D8D8",
-"D c #ADADAD",
-"E c #BCBCBC",
-"F c #E0E0E0",
-"G c #F1F1F1",
-"H c #909090",
-"I c #686868",
-"J c #A2A2A2",
-"K c #C0C0C0",
-"L c #C1C1C1",
-"M c #787878",
-"N c #AEAEAE",
-"O c #151515",
-"P c #D0D0D0",
-"Q c #979797",
-"R c #727272",
-"S c #4A4A4A",
-"T c #ECECEC",
-"U c #ACACAC",
-"V c #BABABA",
-"W c #DDDDDD",
-"X c #DBDBDB",
-"Y c #B1B1B1",
-"Z c #232323",
-"` c #696969",
-" . c #B7B7B7",
-".. c #828282",
-"+. c #404040",
-"@. c #969696",
-"#. c #323232",
-"$. c #E8E8E8",
-"%. c #121212",
-" ",
-" . . . . . ",
-" . . . . ",
-" . + @ # $ % . ",
-" . . & * = - - ; > , ",
-" . ' ) ! ~ { - ] ^ ; / ( ",
-" . _ : < ' [ } | 1 ] 2 3 4 5 : . ",
-" 6 7 ! - - - . } 8 9 0 . = ; 4 a b c ",
-" . ; - - | | d . e f g ] . = 2 h a i ( ",
-" . j ] 1 k l f . m 1 ] ] . 9 n a o o 0 . ",
-" p - ] q 1 1 . r s 2 2 . = 4 a o j t c ",
-" u - ^ ^ ] ] . v w ^ ; . = a l x j y z ",
-" . A - ; q 2 . B C ; 4 . D E A F G A H . ",
-" I - 4 ; ; J . K L . M w o j G G m N O ",
-" , - a 4 4 n # . . 0 w j j G w P Q R S ",
-" . T - a U V W o k X T } w Y : ( Z . ",
-" ` - o o o o j j } ...+.Z . . ",
-" c - o j j } q @.#.Z . ",
-" . ! $./ # +.Z . . ",
-" , .., %.. ",
-" . . ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 6
-#define noname_height 48
-static char noname_bits[] = {
- 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
- 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
- 0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,0x0c,
- 0x0c,0x0c,0x0c};
+++ /dev/null
-/* XPM */
-static char * picon-bar_xpm[] = {
-"6 48 2 1",
-" c white s background",
-". c black",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. "};
+++ /dev/null
-/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 5 1",
-" c #01c601c601c6",
-". c Gray40",
-"X c #a527a527a527",
-"o c #da22da22da22",
-"O c None",
-/* pixels */
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOO OOOOOOOOO",
-"OOOOOO XXooXX. OOOOOOO",
-"OOOOO XooooooooX. OOOOOO",
-"OOOOO oooooooooo. OOOOOO",
-"OOOO Xooo ooo XoX. OOOOO",
-"OOOO Xoo o XXX OOOOO",
-"OOOO oooo XoXX OOOOO",
-"OOOO Xoooo ooXXX OOOOO",
-"OOOO Xooo OXX. OOOOO",
-"OOOO Xoo o XX. OOOOO",
-"OOOO .Xoo ooX XX.. OOOOO",
-"OOOOO XXOoXoXXX.. OOOOOO",
-"OOOOO XXXXXXXXX.. OOOOOO",
-"OOOOOO XXXX... OOOOOOO",
-"OOOOOOOO OOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO"
-};
+++ /dev/null
-/* XPM */
-static char * catchup_xpm[] = {
-"24 24 6 1",
-" c None",
-". c #FFFFFFFFFFFF",
-"X c #E1E1E0E0E0E0",
-"o c #A5A5A5A59595",
-"O c #999999999999",
-"+ c #000000000000",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . ",
-" . .X ",
-" ... .oX . ",
-" ..oooX.oXo .X ",
-" .oooXXXX..oXXoXX ",
-" .oXXXX.XoX.oXooX ",
-" X...X.X.XX.XoXX ",
-" Xo..X.XXX.XXXX ",
-" . Xo.oXX..XXXXXX ",
-"OOOOXoXXXXXo.XXXXX++OOOO",
-"OOOOOX..X.XXXXXXXX++OOOO",
-"OOOOOX..XXXXXXXXX++OOOOO",
-"OOOOOOXXXXXXXXX+++OOOOOO",
-"OOOOOOOOOXXXX++++OOOOOOO",
-"OOOOOOOOO+++++OOOOOOOOOO",
-"OOOOOOOOOO+OOOOOOOOOOOOO",
-"OOOOOOOOOOOOOOOOOOOOOOOO"};
+++ /dev/null
-/* XPM */
-static char * close_xpm[] = {
-"24 24 2 1",
-" c None",
-". c #000000",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . . ",
-" . ... ",
-" .. .... ",
-" .. ... ",
-" ..... ",
-" ... ",
-" ..... ",
-" ....... ",
-" ... .... ",
-" ... .... ",
-" ... .. ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_compose_xpm[] = {
-"24 24 198 2",
-" c None",
-". c #000000",
-"+ c #D1AF61",
-"@ c #F1E3AC",
-"# c #FBA90F",
-"$ c #FFFFFF",
-"% c #B5B5B5",
-"& c #A06B09",
-"* c #816000",
-"= c #E0E0E0",
-"- c #C1C1C1",
-"; c #F4F4F4",
-"> c #FDFDFD",
-", c #E6C370",
-"' c #F1D387",
-") c #D58F0C",
-"! c #B2B2B2",
-"~ c #C3C3C3",
-"{ c #FBFBFB",
-"] c #A8A8A8",
-"^ c #F6F6F6",
-"/ c #B3B3B3",
-"( c #FAFAFA",
-"_ c #ADADAD",
-": c #767676",
-"< c #5D5D5D",
-"[ c #404040",
-"} c #F8F8F8",
-"| c #F1D07E",
-"1 c #ACACAC",
-"2 c #F8F8F6",
-"3 c #E2E2E2",
-"4 c #858585",
-"5 c #4B4B49",
-"6 c #161616",
-"7 c #FBFBFA",
-"8 c #7D7D7D",
-"9 c #F2F2F2",
-"0 c #F0F0F0",
-"a c #EFEFEF",
-"b c #D5D5D5",
-"c c #F9F9F9",
-"d c #F6F6F3",
-"e c #F3F3F3",
-"f c #878786",
-"g c #E5E5E5",
-"h c #DFDFDF",
-"i c #EBEBEB",
-"j c #AEAEAE",
-"k c #7B5307",
-"l c #EDEDED",
-"m c #EBEBE9",
-"n c #E9E9E7",
-"o c #E0E0DE",
-"p c #BFBFBF",
-"q c #F0F0ED",
-"r c #F1D284",
-"s c #CA870B",
-"t c #9E9E9C",
-"u c #DCDCD9",
-"v c #D9D9D9",
-"w c #D9D9D6",
-"x c #D6D6D4",
-"y c #E5E5E4",
-"z c #D9D9D7",
-"A c #BABABA",
-"B c #AAAAAA",
-"C c #E7E7E5",
-"D c #E4E4E2",
-"E c #E2E2E0",
-"F c #EEEEEC",
-"G c #979796",
-"H c #D4D4D1",
-"I c #DEDEDC",
-"J c #DEDEDB",
-"K c #BDBDBC",
-"L c #E7E7E7",
-"M c #EFEFED",
-"N c #A6A6A5",
-"O c #BA7C0A",
-"P c #7A5B00",
-"Q c #DBDBD9",
-"R c #D5D5D3",
-"S c #BCBCBC",
-"T c #E3E3E3",
-"U c #F2E6B6",
-"V c #7B7B7B",
-"W c #704B05",
-"X c #676764",
-"Y c #CBCBC7",
-"Z c #C9C9C7",
-"` c #DBDBD7",
-" . c #D7D7D5",
-".. c #D7D7D3",
-"+. c #B4B4B4",
-"@. c #E4E4E4",
-"#. c #DBD5C1",
-"$. c #7E6F57",
-"%. c #755800",
-"&. c #D9D9D5",
-"*. c #D5D5D1",
-"=. c #D0D0CE",
-"-. c #BABAB8",
-";. c #DDDDDB",
-">. c #D1D1CF",
-",. c #0E0E0E",
-"'. c #535353",
-"). c #8D8D8B",
-"!. c #C4C4C1",
-"~. c #C4C4BF",
-"{. c #C1C1BC",
-"]. c #D3D3D0",
-"^. c #D1D1D0",
-"/. c #DCDCDB",
-"(. c #E0E0DC",
-"_. c #898987",
-":. c #C9C9C6",
-"<. c #CDCDCA",
-"[. c #D0D0CD",
-"}. c #CECECB",
-"|. c #CFCFCC",
-"1. c #D0D0CC",
-"2. c #B6B6B6",
-"3. c #D4D4D0",
-"4. c #C3C3C0",
-"5. c #5B5B5B",
-"6. c #91918D",
-"7. c #91918F",
-"8. c #9F9F9D",
-"9. c #AFAFAC",
-"0. c #B9B9B6",
-"a. c #BEBEBB",
-"b. c #C5C5C2",
-"c. c #C8C8C5",
-"d. c #CACAC7",
-"e. c #CBCBC8",
-"f. c #CCCCC9",
-"g. c #CCCCC8",
-"h. c #D2D2D0",
-"i. c #D2D2CF",
-"j. c #BFBFBD",
-"k. c #9F9F9C",
-"l. c #888886",
-"m. c #878785",
-"n. c #8C8C8A",
-"o. c #959593",
-"p. c #9C9C9A",
-"q. c #A8A8A5",
-"r. c #B1B1AE",
-"s. c #B5B5B3",
-"t. c #BBBBB8",
-"u. c #BFBFBC",
-"v. c #C2C2BE",
-"w. c #D1D1CE",
-"x. c #AEAEAB",
-"y. c #9D9D9A",
-"z. c #979794",
-"A. c #949491",
-"B. c #9A9A97",
-"C. c #A3A3A0",
-"D. c #AAAAA7",
-"E. c #B0B0AC",
-"F. c #B8B8B5",
-"G. c #B0B0AE",
-"H. c #CFCFCD",
-"I. c #BEBEBC",
-"J. c #B4B4B0",
-"K. c #ACACA8",
-"L. c #A4A4A2",
-"M. c #A0A09C",
-"N. c #A4A4A0",
-"O. c #A8A8A6",
-"P. c #ABABA7",
-"Q. c #B2B2AE",
-"R. c #A4A4A4",
-"S. c #CECECC",
-"T. c #CECECA",
-"U. c #C6C6C2",
-"V. c #BCBCB9",
-"W. c #B3B3AF",
-"X. c #ABABA9",
-"Y. c #A6A6A3",
-"Z. c #A0A09D",
-"`. c #ACACA9",
-" + c #A1A1A1",
-".+ c #B1B1AF",
-"++ c #B4B4B3",
-"@+ c #B4B4B1",
-"#+ c #B3B3B1",
-"$+ c #AEAEAA",
-"%+ c #A7A7A4",
-"&+ c #A2A2A0",
-"*+ c #A5A5A1",
-"=+ c #999997",
-"-+ c #929290",
-";+ c #949490",
-">+ c #9D9D9B",
-",+ c #858583",
-" . . . ",
-" . . . . . . . . . . . . + @ # . . . ",
-" . $ $ $ $ $ $ $ $ $ % & @ # * . = - . ",
-" . $ ; $ $ $ $ $ > > . , ' ) . ! ~ { ] . ",
-" . $ ^ $ $ $ > > > / & @ # * . ( _ : < [ . ",
-" . $ ^ $ { { { { } . , | ) . 1 2 3 4 5 6 . ",
-" . $ ; > > { { 7 8 & @ # * . ; 9 0 a b _ . ",
-" . $ 9 c ^ ^ d e . , | ) . f g 3 h i 3 - . ",
-" . $ 0 } } } 2 j k @ # * . l i m n n o p . ",
-" . $ a e 0 q l . , r s . t u v w x y z A . ",
-" . $ l ; ; 9 B & @ # * . C y y D o E z A . ",
-" . $ i F C g . , r s . G H E o I J I z K . ",
-" . $ L M i N O # # P . E o I J u Q Q R S . ",
-" . $ g T v . U V W . X Y Z u ` z .z ..+.. ",
-" . $ E y @.. #.$.%.. u Q ` &...R *...=.-.. ",
-" . $ I ;.>.,.'.. . ).!.~.{.*.*.].^.].=.-.. ",
-" . $ /.(.;.. . _.:.<.[.}.[.[.[.[.|.[.1.2.. ",
-" . $ Q 3.4.5.6.7.8.9.0.a.4.b.c.d.e.f.g.! . ",
-" . $ h.i.|.j.k.l.m.n.o.p.q.r.s.t.a.u.v.! . ",
-" . $ w.1.f.|.4.x.y.z.z.A.B.k.C.q.D.E.F.G.. ",
-" . $ i.w.w.w.H.e.I.J.K.L.M.M.N.L.O.P.Q.R.. ",
-" . $ ^.w.=.S.T.T.g.U.V.W.J.X.Y.Z.Y.D.`. +. ",
-" . $ .+++@+@+@+#+#+Q.$+%+&+*+*+=+-+;+>+,+. ",
-" . . . . . . . . . . . . . . . . . . . . "};
+++ /dev/null
-/* XPM */
-static char * stock_connect_xpm[] = {
-"24 24 58 1",
-" c None",
-". c #000000",
-"+ c #989389",
-"@ c #807D74",
-"# c #C6C2BA",
-"$ c #34332D",
-"% c #B7B3AA",
-"& c #C4C2BD",
-"* c #EAE8E3",
-"= c #9C978D",
-"- c #BCB9B2",
-"; c #363433",
-"> c #E2E1DD",
-", c #F0EFEC",
-"' c #AAA7A0",
-") c #F0EEEB",
-"! c #B2B0AB",
-"~ c #F9F9F8",
-"{ c #C5C3BD",
-"] c #0F0F0D",
-"^ c #F2F0ED",
-"/ c #EBEAE6",
-"( c #8A857B",
-"_ c #ECEBE8",
-": c #EEECEA",
-"< c #9F9C93",
-"[ c #F3F2F0",
-"} c #E8E7E4",
-"| c #E3E1DD",
-"1 c #78756B",
-"2 c #BEBBB5",
-"3 c #B3B1AA",
-"4 c #7D786E",
-"5 c #E1DFDB",
-"6 c #D1D0CC",
-"7 c #938E84",
-"8 c #C8C5BF",
-"9 c #A7A298",
-"0 c #010101",
-"a c #8C8981",
-"b c #A6A29B",
-"c c #726D63",
-"d c #CECAC3",
-"e c #A7A49E",
-"f c #7E7A70",
-"g c #A09D94",
-"h c #817D73",
-"i c #6C685E",
-"j c #3C3933",
-"k c #8B877E",
-"l c #706C62",
-"m c #B1ADA4",
-"n c #97938A",
-"o c #625E54",
-"p c #6A655B",
-"q c #37342D",
-"r c #646056",
-"s c #8B877D",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" .. .. ",
-" ..+@.#@.. ",
-" $%&*@.*@=-; ",
-" .>,'*@.)@!~{] ",
-"......@>,'*@.)@!~{@.....",
-"*******^/(_@.:@<[}|*****",
-"@@@@@1123451.6@789@@@@@@",
-".....01abcd1.e@fghi.....",
-" ]abcd1.e@fgh] ",
-" ]jklmi.n@opq. ",
-" ]]+r.s@.. ",
-" ]] ]. ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_contact_xpm[] = {
-"24 24 102 2",
-" c None",
-". c #000000",
-"+ c #E3E1DE",
-"@ c #ECEBE7",
-"# c #F0EEEB",
-"$ c #D2CFC9",
-"% c #81817F",
-"& c #4C4C4A",
-"* c #ECEAE6",
-"= c #ECEAE5",
-"- c #EBE9E5",
-"; c #D2CEC8",
-"> c #D9C7B8",
-", c #D9C7B9",
-"' c #D8C5B8",
-") c #D1C0B3",
-"! c #D6C5B7",
-"~ c #EBEAE5",
-"{ c #D3D0C9",
-"] c #CDBCAC",
-"^ c #AFA093",
-"/ c #3A3531",
-"( c #443F3A",
-"_ c #AE9F93",
-": c #CBBAAB",
-"< c #4E4E4C",
-"[ c #595957",
-"} c #595857",
-"| c #7D7C7A",
-"1 c #D3D0CA",
-"2 c #C6B5A4",
-"3 c #3D3833",
-"4 c #433D37",
-"5 c #C2B0A2",
-"6 c #D4D1CA",
-"7 c #B0A08E",
-"8 c #261F18",
-"9 c #D37D1E",
-"0 c #D68021",
-"a c #B26616",
-"b c #27241F",
-"c c #9C8E7F",
-"d c #EAE9E5",
-"e c #A29281",
-"f c #2E2012",
-"g c #CC751A",
-"h c #CC761A",
-"i c #BF6C16",
-"j c #24211C",
-"k c #8E8170",
-"l c #EAE8E3",
-"m c #E9E8E3",
-"n c #E9E7E3",
-"o c #8E7F6C",
-"p c #221E17",
-"q c #C56D14",
-"r c #7D450D",
-"s c #AF5F11",
-"t c #221E19",
-"u c #7F7260",
-"v c #E9E7E2",
-"w c #E8E6E1",
-"x c #E7E5E1",
-"y c #E7E5E0",
-"z c #D5D1CB",
-"A c #3E372C",
-"B c #1C1F1F",
-"C c #301B06",
-"D c #542D07",
-"E c #291B0E",
-"F c #151412",
-"G c #473F33",
-"H c #E8E6E2",
-"I c #546371",
-"J c #849CB4",
-"K c #56687C",
-"L c #343332",
-"M c #495868",
-"N c #566D85",
-"O c #293643",
-"P c #E6E4DF",
-"Q c #E5E4DE",
-"R c #EEEDE9",
-"S c #7B95AF",
-"T c #7B96B0",
-"U c #68819B",
-"V c #8999AA",
-"W c #5A7088",
-"X c #607A96",
-"Y c #5B7691",
-"Z c #E5E3DE",
-"` c #4B4A48",
-" . c #757471",
-".. c #E6E3DE",
-"+. c #3B3A39",
-"@. c #747371",
-"#. c #D3CFC8",
-"$. c #E2E1DD",
-"%. c #E7E4E0",
-"&. c #D2CFC8",
-"*. c #D1D0CA",
-"=. c #C2C0B9",
-" ",
-" ",
-" ",
-" . . . . . . . . . . . . . . . . . . . . ",
-" . + @ # # # # # # # # # # # # # # # # # $ . ",
-" . # % . . . . . . . & * = - - - - - - - ; . ",
-" . # . > , ' ) ! > , . * * ~ ~ ~ ~ - - ~ { . ",
-" . # . ] ^ / . ( _ : . * < [ ~ } } | - ~ 1 . ",
-" . # . 2 3 . . . 4 5 . * * ~ ~ - - - - - 6 . ",
-" . # . 7 8 9 0 a b c . * [ < | [ - } | d 6 . ",
-" . # . e f g h i j k . * * l l m n n n n 6 . ",
-" . # . o p q r s t u . v v w w w x y y y z . ",
-" . # . A B C D E F G . H H y y y y y y y 6 . ",
-" . # . I J K L M N O . y y P P P P P P Q { . ",
-" . R . S T U V W X Y . y y P P P P Z Z Z { . ",
-" . d ` . . . . . . . ` y y ...+.+.Z @.Z #.. ",
-" . $.y y y y y y y y y %.P Z Z Z Z Z Z Z &.. ",
-" . *.6 z 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 6 =.. ",
-" . . . . . . . . . . . . . . . . . . . . . ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_copy_xpm[] = {
-"24 24 77 1",
-" c None",
-". c #010101",
-"+ c #2F2F2F",
-"@ c #E3E2E1",
-"# c #FCFCFC",
-"$ c #B3B2B1",
-"% c #95938E",
-"& c #F7F7F7",
-"* c #F5F4F2",
-"= c #F8F8F8",
-"- c #F7F6F6",
-"; c #EAE9E5",
-"> c #7B7976",
-", c #D2CFCA",
-"' c #E1E0DD",
-") c #908E8B",
-"! c #EBEAEA",
-"~ c #F1F0EE",
-"{ c #E2E0DD",
-"] c #7C7B78",
-"^ c #C6C3C0",
-"/ c #E5E3DE",
-"( c #DCDAD7",
-"_ c #8F8C88",
-": c #EBEBEA",
-"< c #EFEDEA",
-"[ c #DFDDDA",
-"} c #787774",
-"| c #C1BEBA",
-"1 c #E6E3E0",
-"2 c #EFEEEC",
-"3 c #CBCAC6",
-"4 c #ECECEC",
-"5 c #F3F2F0",
-"6 c #DCDCDC",
-"7 c #7D7C79",
-"8 c #B4B2AE",
-"9 c #E7E5E1",
-"0 c #F0EFEB",
-"a c #E4E2DD",
-"b c #7B7874",
-"c c #AFACA6",
-"d c #ABA8A3",
-"e c #F9F8F6",
-"f c #EAE9E8",
-"g c #B0ADA7",
-"h c #F5F3F0",
-"i c #B9B8B6",
-"j c #CBC9C4",
-"k c #DEDBD5",
-"l c #9D9994",
-"m c #DBD9D6",
-"n c #747370",
-"o c #A09C97",
-"p c #DAD8D5",
-"q c #E7E6E3",
-"r c #E8E6E1",
-"s c #E0DED9",
-"t c #F7F6F4",
-"u c #D3D1CF",
-"v c #868480",
-"w c #C2BFBD",
-"x c #DAD9D5",
-"y c #F6F5F1",
-"z c #D8D6D1",
-"A c #F7F5F2",
-"B c #92908B",
-"C c #CCCAC5",
-"D c #F7F6F2",
-"E c #F5F4F0",
-"F c #EAE8E3",
-"G c #D2D0CB",
-"H c #D9D7D2",
-"I c #DAD8D3",
-"J c #D5D3CE",
-"K c #D6D4CF",
-"L c #040404",
-" ",
-" ",
-" ",
-" .+........... ",
-" .@###########$. ",
-" .#%&*=*-*-*;>,. ",
-" .#')!~-*-*{]^/. ",
-" .#~(_:~<~[}|1/. ",
-" .#~23]4567890a. ",
-" .#22~b.+........... ",
-" .#~2c.@###########$. ",
-" .#2de.#%&*=*-*-*;>,. ",
-" .fgeh.#')!~-*-*{]^/. ",
-" .ijkk.#~(_:~<~[}|1/. ",
-" .....#~23]4567890a. ",
-" .#22~l]mnopqrs. ",
-" .#~2ctuvwxoy0z. ",
-" .#2deetptAABrC. ",
-" .fgehDEAEAhFBG. ",
-" .ijkkkHIJKGGGB. ",
-" ............L ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * cu_exit_xpm[] = {
-"24 24 4 1",
-" c None",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ..... ",
-" .. .XXX. ",
-" ..X..XXXX... ",
-" .XXXX.XXXX.X... ",
-" ..XXXX.XXX.XXX.. ",
-" .XXX.......... ",
-" .XXX.XXX.XXX.. ",
-" .XX.XXX.XXX. ",
-" .XX.XXX.XX.. ",
-" ............ ",
-" .X.X.X.X.. ",
-"ooooooo..........ooooooo",
-"ooooooo.X.X.X.X.oooooooo",
-"ooooooo.........oooooooo",
-"ooooooo..X...X..oooooooo",
-"ooooooo...X.X...oooooooo",
-"ooooooo........ooooooooo",
-"ooooooooo.....oooooooooo",
-"oooooooooooooooooooooooo"};
+++ /dev/null
-/* XPM */
-static char * cut_xpm[] = {
-"24 24 40 1",
-" c None",
-". c #000000",
-"+ c #C9C7C2",
-"@ c #E6E4E0",
-"# c #EFEEED",
-"$ c #494946",
-"% c #73726E",
-"& c #F0EEED",
-"* c #7F7D75",
-"= c #F2F1EF",
-"- c #D2CFC8",
-"; c #E7E7E4",
-"> c #BAB5AB",
-", c #565653",
-"' c #EDECE9",
-") c #A4A097",
-"! c #817F7E",
-"~ c #4E4C48",
-"{ c #F6F5F4",
-"] c #474541",
-"^ c #EFEEEC",
-"/ c #8C8B8A",
-"( c #F3F2F0",
-"_ c #77746D",
-": c #323232",
-"< c #EBEBEA",
-"[ c #605D58",
-"} c #F5F4F3",
-"| c #CECCC7",
-"1 c #363634",
-"2 c #6F6E6D",
-"3 c #BEBDBB",
-"4 c #EAE7E4",
-"5 c #B8B5B1",
-"6 c #474747",
-"7 c #DAD8D4",
-"8 c #9B9996",
-"9 c #161615",
-"0 c #6D6B6A",
-"a c #3A3837",
-" ",
-" ",
-" . . ",
-" . . ",
-" .+. .@. ",
-" .#$ %@. ",
-" .&*. .=-. ",
-" .;>, %'). ",
-" !#*. .=-~ ",
-" .{>] ~^>. ",
-" /(_.:<-[ ",
-" .}|123>. ",
-" .456>. ",
-" .78.. ",
-" .90a. ",
-" ............. ",
-" . ... ... ... ",
-" .. .. .. .. ",
-" . . . . ",
-" .. .. .. .. ",
-" .... .. . ",
-" .... .... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_delete_xpm[] = {
-"24 24 243 2",
-" c None",
-". c #000000",
-"+ c #1C1C1C",
-"@ c #767676",
-"# c #E6E6E6",
-"$ c #D3D3D3",
-"% c #C3C3C3",
-"& c #909090",
-"* c #494949",
-"= c #48473D",
-"- c #BAB8A6",
-"; c #E2E2DF",
-"> c #F1F1F0",
-", c #EAE9E6",
-"' c #F2F2EE",
-") c #EBEAE5",
-"! c #C1C0B5",
-"~ c #57564A",
-"{ c #525146",
-"] c #A8A68F",
-"^ c #BDBBA1",
-"/ c #C0BEA3",
-"( c #A3A18A",
-"_ c #6D6C5C",
-": c #7C7C72",
-"< c #4C4C49",
-"[ c #45453F",
-"} c #44433A",
-"| c #6F6F67",
-"1 c #C6C5B9",
-"2 c #B6B59B",
-"3 c #6D6C5D",
-"4 c #B3B19B",
-"5 c #A7A68E",
-"6 c #908F7A",
-"7 c #AAA993",
-"8 c #CCCBB5",
-"9 c #D0CEBA",
-"0 c #D5D3C1",
-"a c #AEADA3",
-"b c #94938A",
-"c c #454442",
-"d c #232321",
-"e c #353431",
-"f c #292823",
-"g c #1E1E1A",
-"h c #535246",
-"i c #ADAC93",
-"j c #929189",
-"k c #C2C1AF",
-"l c #B1AF96",
-"m c #ACAA92",
-"n c #93927D",
-"o c #080808",
-"p c #D1D0C1",
-"q c #D6D5C4",
-"r c #DFDED1",
-"s c #CECDC0",
-"t c #ACACA6",
-"u c #908F8A",
-"v c #7E7D77",
-"w c #5C5C55",
-"x c #47463E",
-"y c #656456",
-"z c #777665",
-"A c #807E6F",
-"B c #BEBDA7",
-"C c #B5B39A",
-"D c #A19F88",
-"E c #D9D8CC",
-"F c #F6F5F2",
-"G c #DBDAD1",
-"H c #DAD9CE",
-"I c #E5E4D9",
-"J c #D0CFC3",
-"K c #D3D3C9",
-"L c #CAC9BC",
-"M c #B7B6A6",
-"N c #B8B6A1",
-"O c #B0AF96",
-"P c #B9B89D",
-"Q c #B9B79D",
-"R c #B8B69C",
-"S c #C4C2A9",
-"T c #AFAD97",
-"U c #8B8976",
-"V c #AAA998",
-"W c #B6B6B2",
-"X c #F9F9F7",
-"Y c #FAFAF8",
-"Z c #F4F4F0",
-"` c #E2E1DA",
-" . c #D9D9CE",
-".. c #DBDACF",
-"+. c #D3D1BE",
-"@. c #C5C4AC",
-"#. c #D6D5C3",
-"$. c #CDCCBF",
-"%. c #BBBAAD",
-"&. c #7C7A69",
-"*. c #717060",
-"=. c #131313",
-"-. c #999882",
-";. c #AFAE9D",
-">. c #C3C3BE",
-",. c #DEDEDC",
-"'. c #E9E9E8",
-"). c #FBFBFA",
-"!. c #FDFDFC",
-"~. c #FDFDFD",
-"{. c #FCFBFA",
-"]. c #F2F2EF",
-"^. c #EAE9E3",
-"/. c #C0BFB1",
-"(. c #959484",
-"_. c #787766",
-":. c #6E6D5D",
-"<. c #5B5B4D",
-"[. c #5D5C4F",
-"}. c #A3A293",
-"|. c #B8B7A6",
-"1. c #D8D7D0",
-"2. c #DBDBD4",
-"3. c #D3D2CA",
-"4. c #C8C8C3",
-"5. c #C6C5BD",
-"6. c #BDBCAD",
-"7. c #BAB8A8",
-"8. c #9F9E8B",
-"9. c #8E8C78",
-"0. c #8C8B77",
-"a. c #7A7968",
-"b. c #6C6B5D",
-"c. c #4E4D45",
-"d. c #424242",
-"e. c #7B7B73",
-"f. c #9F9F96",
-"g. c #D2D1C7",
-"h. c #DCDBD2",
-"i. c #CCCBBE",
-"j. c #D1D0C2",
-"k. c #C4C3B6",
-"l. c #9A9883",
-"m. c #807F6D",
-"n. c #7D7C6B",
-"o. c #6A695E",
-"p. c #40403E",
-"q. c #37372D",
-"r. c #0F0F0F",
-"s. c #383734",
-"t. c #787875",
-"u. c #999893",
-"v. c #8A897E",
-"w. c #B3B2A4",
-"x. c #AAAA9E",
-"y. c #878673",
-"z. c #8F8D79",
-"A. c #626155",
-"B. c #545451",
-"C. c #31312E",
-"D. c #2B2B23",
-"E. c #71715D",
-"F. c #57574B",
-"G. c #42423A",
-"H. c #262620",
-"I. c #212121",
-"J. c #1B1B1B",
-"K. c #242424",
-"L. c #161613",
-"M. c #2A2A22",
-"N. c #303027",
-"O. c #3F3F34",
-"P. c #7A7A65",
-"Q. c #5B5B51",
-"R. c #858576",
-"S. c #76766B",
-"T. c #98988E",
-"U. c #75756B",
-"V. c #515146",
-"W. c #7F7F74",
-"X. c #6A6A58",
-"Y. c #404035",
-"Z. c #626251",
-"`. c #545445",
-" + c #3E3E33",
-".+ c #555546",
-"++ c #34342B",
-"@+ c #515143",
-"#+ c #85856E",
-"$+ c #5D5D54",
-"%+ c #919182",
-"&+ c #828278",
-"*+ c #AAAAA3",
-"=+ c #7A7A71",
-"-+ c #4E4E45",
-";+ c #8A8A80",
-">+ c #7C7C6D",
-",+ c #424237",
-"'+ c #606052",
-")+ c #5A5A4A",
-"!+ c #3C3C32",
-"~+ c #4E4E41",
-"{+ c #35352C",
-"]+ c #ACAC9C",
-"^+ c #85857B",
-"/+ c #BBBBB3",
-"(+ c #A3A39A",
-"_+ c #54544B",
-":+ c #93938A",
-"<+ c #919185",
-"[+ c #686856",
-"}+ c #414136",
-"|+ c #434337",
-"1+ c #A4A493",
-"2+ c #C1C1B6",
-"3+ c #B1B1A2",
-"4+ c #6B6B5F",
-"5+ c #9D9D8B",
-"6+ c #848470",
-"7+ c #71715E",
-"8+ c #A5A594",
-"9+ c #C2C2B7",
-"0+ c #7B7B65",
-"a+ c #5F5F4F",
-"b+ c #666654",
-"c+ c #49493C",
-"d+ c #575748",
-"e+ c #57574A",
-"f+ c #7D7D6D",
-"g+ c #767669",
-"h+ c #B3B3A8",
-"i+ c #A1A194",
-"j+ c #6D6D61",
-"k+ c #B3B3A5",
-"l+ c #696957",
-"m+ c #414135",
-"n+ c #565647",
-"o+ c #444438",
-"p+ c #595951",
-"q+ c #585849",
-"r+ c #4E4E40",
-"s+ c #747467",
-"t+ c #616153",
-" . . . . . . ",
-" . + @ # $ % & * . . ",
-" . . . = - ; > , ' ) ! ~ { . . . ",
-" . ] ^ / ( _ : < [ } | 1 2 3 4 5 6 . ",
-" . 7 8 9 0 a b c d e f g h i j k l m n . ",
-" o p 8 q r s t u v w x y z A B C 2 C D . ",
-" . E F G H I J K L M N O D P Q R S T U . ",
-" . V W X Y Z ` ...0 +.S / @.#.$.%.&.*.. ",
-" =.-.;.>.,.'.).!.~.{.X ].^.G /.(._.:.<.. ",
-" . [.n }.|.1.2.3.4.5.6.7.8.9.0.9.a.b.c. ",
-" . d.e.f.g.h.i.j.k.l l l l.m.n.o.p.. ",
-" . q.r.s.t.u.v.w.x.( y.z.A.B.C.. D.. ",
-" . E.F.G.H.I.J.. K.. . . . L.M.N.O.. ",
-" . P.Q.R.S.T.U.V.W.X.Y.Z.`. +.+++@+. ",
-" . #+$+%+&+*+=+-+;+>+,+'+)+!+~+{+`.. ",
-" . #+Q.]+^+/+(+_+:+<+,+'+[+}+X.|+X.. ",
-" . #+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+X.. ",
-" . #+Q.8+^+9+3+4+3+5+`.6+7+|+X.|+X.. ",
-" . #+Q.5+^+2+3+4+3+5+`.6+7+|+X.|+X.. ",
-" . 0+Q.1+^+2+3+4+3+5+`.6+7+|+X.|+a+. ",
-" . b+Q.1+&+2+3+4+3+5+`.6+7+|+X.c+d+. ",
-" . e+f+g+h+i+j+k+5+`.6+l+m+n+o+. . ",
-" . . . p+q+r+s+t+~+c+c+. . . ",
-" . . . . . . . . . . "};
+++ /dev/null
-/* XPM */
-static char * describe_group_xpm[] = {
-"24 24 5 1",
-". c None",
-" c #000000000000",
-"o c #FFFFF5F5ACAC",
-"+ c #E1E1E0E0E0E0",
-"@ c #C7C7C6C6C6C6",
-"........................",
-"........................",
-".................oooo...",
-" .. .. .. .. .. oo oo o.",
-"..............oooooooooo",
-".............ooooooooooo",
-" .. .. .. .. oo oo oo oo",
-"............oooooooooooo",
-"............oooooooooooo",
-" .. .. .. .. oo oo oo oo",
-"............oooooooooooo",
-"............oooooooooooo",
-" .. .. .. .. oo oo oo oo",
-"............oooooooooooo",
-"..... ...oooooooooooo",
-" .. ++ .. .o oo oo oo",
-"... @@@+ ....ooooooooo",
-"... @ ....oooooooo.",
-" . . .. .. .. ..",
-". ..............",
-" ................",
-" .. .. .. .. .. ..",
-" ..................",
-" ...................."};
+++ /dev/null
-/* XPM */
-static char * stock_properties_xpm[] = {
-"24 24 68 1",
-" c None",
-". c #000000",
-"+ c #74716E",
-"@ c #C9C4BD",
-"# c #DFDAD2",
-"$ c #F4EFE5",
-"% c #F2ECE1",
-"& c #FFFFFF",
-"* c #4C4B48",
-"= c #EEE5D4",
-"- c #ECE2CF",
-"; c #EADFC9",
-"> c #F9F9F9",
-", c #E2D2B1",
-"' c #F4F4F4",
-") c #EEEEEE",
-"! c #959595",
-"~ c #F5F5F5",
-"{ c #F6F6F6",
-"] c #D9D9D9",
-"^ c #C7B99C",
-"/ c #E9E9E9",
-"( c #787878",
-"_ c #E1E1E1",
-": c #E2E2E2",
-"< c #C8C8C8",
-"[ c #877E69",
-"} c #9A8F78",
-"| c #DEDEDE",
-"1 c #E3E3E3",
-"2 c #929292",
-"3 c #AFA389",
-"4 c #ACACAC",
-"5 c #A2A2A2",
-"6 c #E4E4E4",
-"7 c #BCBCBC",
-"8 c #939393",
-"9 c #EDEDED",
-"0 c #EFEFEF",
-"a c #F0F0F0",
-"b c #E5E5E5",
-"c c #E7E7E7",
-"d c #E8E8E8",
-"e c #EAEAEA",
-"f c #EBEBEB",
-"g c #BEBEBE",
-"h c #F1F1F1",
-"i c #DFDFDF",
-"j c #F3F3F3",
-"k c #E0E0E0",
-"l c #ABABAB",
-"m c #AEAEAE",
-"n c #AFAFAF",
-"o c #ADADAD",
-"p c #B0B0B0",
-"q c #B1B1B1",
-"r c #F7F7F7",
-"s c #B3B3B3",
-"t c #F8F8F8",
-"u c #B4B4B4",
-"v c #B5B5B5",
-"w c #B6B6B6",
-"x c #FAFAFA",
-"y c #FBFBFB",
-"z c #DCDCDC",
-"A c #DDDDDD",
-"B c #E6E6E6",
-"C c #969696",
-" ",
-" ",
-" ",
-" ......... ",
-" .+@#$%.&&. ",
-" *=---;.&>. ",
-" .......;.,,,,.'). ",
-" !~~{].;.^.,^^./(.. ",
-" .~_:<.;.[.^.}..|].. ",
-" .~:1.;.2.[.3.4...5. ",
-" .{16..7/8.[.49)0a|. ",
-" .{6bcd/ef8.g9)0ahi. ",
-" .{bcd/ef9ef9)0ahjk. ",
-" .{cllefmnomnppqj'_. ",
-" .rd/ef9)09)0ahj'~:. ",
-" .r/4o9)ppnppqss~{1. ",
-" .tef9)0ah0ahj'~{rb. ",
-" .>9npahssqssuvw>xc. ",
-" .>)0ahj'~j'~{r>xyd. ",
-" .nzA|ik_:k_:1bBcdC. ",
-" ................. ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * diropen_xpm[] = {
-"19 24 17 1",
-" c None",
-". c #000100",
-"+ c #C6C9A6",
-"@ c #D0D3AF",
-"# c #93997C",
-"$ c #E6E7D0",
-"% c #BEC19E",
-"& c #B4B895",
-"* c #A7AA88",
-"= c #6B6D59",
-"- c #4A4E40",
-"; c #7C8166",
-"> c #898E72",
-", c #3C4032",
-"' c #575845",
-") c #34332C",
-"! c #24231D",
-" ............... ",
-" .+@@@@@@@@@@@@@#. ",
-".$@@@@@@@@@@@@@@@#.",
-".++++%%%%%%%%%&&&*.",
-".&&&&&&&&&&******#.",
-".*%+++%%%%%%%%%&=#.",
-".*+***********##-#.",
-".*+****;===;####-#.",
-".*+****=*****###-#.",
-".*+****;*****###-#.",
-".*+****########>-#.",
-".*&######>>>>>>>,>.",
-".*#-------------'>)",
-".*&&&&&&&&&&&&&*#>)",
-".*&************#'>)",
-".*&***********##,>)",
-".*&****====;###>,>)",
-".#&****=**#**##>,;)",
-".#&****>****###>,;)",
-".#&****########>,;)",
-".##''''''''''''',;)",
-".#>==============;)",
-".''''''''''''''''-!",
-" ................. "};
+++ /dev/null
-/* XPM */
-static char * stock_disconnect_xpm[] = {
-"24 24 42 1",
-" c None",
-". c #000000",
-"+ c #989389",
-"@ c #807D74",
-"# c #C6C2BA",
-"$ c #43423C",
-"% c #B7B3AA",
-"& c #C4C2BD",
-"* c #EAE8E3",
-"= c #E2E1DD",
-"- c #F0EFEC",
-"; c #AAA7A0",
-"> c #C5D2C8",
-", c #E9EEEA",
-"' c #F0EEEB",
-") c #F2F0ED",
-"! c #EBEAE6",
-"~ c #8A857B",
-"{ c #ECEBE8",
-"] c #EEECEA",
-"^ c #78756B",
-"/ c #BEBBB5",
-"( c #B3B1AA",
-"_ c #7D786E",
-": c #E1DFDB",
-"< c #D1D0CC",
-"[ c #010101",
-"} c #8C8981",
-"| c #A6A29B",
-"1 c #726D63",
-"2 c #CECAC3",
-"3 c #A7A49E",
-"4 c #0F0F0D",
-"5 c #F0F3F1",
-"6 c #272622",
-"7 c #8B877E",
-"8 c #706C62",
-"9 c #B1ADA4",
-"0 c #6C685E",
-"a c #97938A",
-"b c #646056",
-"c c #8B877D",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" .. ..",
-" ..+@. .#@",
-" $%&*@.... .*@",
-" .=-;*@.>>,. .'@",
-".....@=-;*@.... .'@",
-"******)!~{@. .]@",
-"@@@@^^/(_:^. .<@",
-"....[^}|12^.... .3@",
-" 4}|12^.>>5. .3@",
-" 67890.... .a@",
-" 44+b. .c@",
-" 44 4.",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * exit_gnus_xpm[] = {
-"24 24 6 1",
-" c None",
-". c #8686ADAD7D7D",
-"X c #919187876969",
-"o c #C2C2B9B99C9C",
-"O c #A8A8F0F0ECEC",
-"+ c #EFEFEFEFEFEF",
-" ",
-" .... . ",
-" .. .. . ",
-" ............. ",
-" . . . .... ",
-" ............. ",
-" .............. .. ",
-" . . .......... . ",
-" .XXXX... .. ",
-" o.XXX. . .. ",
-" oo.X. .. ... ",
-" ooX. . ... ",
-" oXo. .. ",
-" ooX . . ",
-" ooX ",
-"OOOOoXXOOOOOOOOOOOOOOOOO",
-"OOOoXoXOOOOOOOOOOOOOOOOO",
-"OOOooXXOOOO+OOOOOOOOOOOO",
-"O+OoooXOO+OOO+OO+OOO+OOO",
-"OXXoXoXoXOO++O++OO++OO+O",
-"XXXXXXXXXXXX+OOOOOOOOOOO",
-"XXXXXXXXXXXXXX+O++OO++OO",
-"XXXXXXXXXXXXXXXXOOOOOOOO",
-"O++O++++O+OO++OOOO++OOO+"};
+++ /dev/null
-/* XPM */
-static char * exit_summ_xpm[] = {
-"24 24 3 1",
-". c None",
-" c #000000000000",
-"X c #E1E1E0E0E0E0",
-" .. .. .. .. .. .. .. ..",
-"........................",
-"........................",
-" .. .. .. ..",
-"...... XXXX .....",
-"...... XXXXXXX .....",
-" .. .. XX XX XX .. ..",
-"...... XXXXXXXX .....",
-"...... XXXXXXX .....",
-" .. .. X XX .. ..",
-"...... XXXX .....",
-"...... XXXX .....",
-" .. .. X XXXXX .. ..",
-"...... XXXXXXX .....",
-"...... XXXXX XX .....",
-" .. .. X XXXXX .. ..",
-"...... XXXXX .....",
-"...... X .....",
-" .. . . .. ..",
-"........................",
-"........................",
-" .. .. .. .. .. .. .. ..",
-"........................",
-"........................"};
+++ /dev/null
-/* XPM */
-static char * stock_exit_xpm[] = {
-"24 24 140 2",
-" c None",
-". c #000000",
-"+ c #D6D6D4",
-"@ c #BDBDBC",
-"# c #A8A8A4",
-"$ c #92928F",
-"% c #727370",
-"& c #61615E",
-"* c #20201F",
-"= c #F1F1EF",
-"- c #E6E6E4",
-"; c #DADAD7",
-"> c #CFCFCD",
-", c #C4C4C1",
-"' c #A8A8A5",
-") c #767674",
-"! c #777774",
-"~ c #1E1E1D",
-"{ c #B9B9B7",
-"] c #AEAEAC",
-"^ c #8F8F8D",
-"/ c #262626",
-"( c #414140",
-"_ c #E9836C",
-": c #DEDEDC",
-"< c #C5C5C2",
-"[ c #636362",
-"} c #040504",
-"| c #040604",
-"1 c #050705",
-"2 c #E87B62",
-"3 c #E67056",
-"4 c #D5D5D3",
-"5 c #DBDBD8",
-"6 c #D0D0CE",
-"7 c #080A07",
-"8 c #0A0C09",
-"9 c #0A0D09",
-"0 c #0B0E0A",
-"a c #F0B0A1",
-"b c #EB8D77",
-"c c #DF421E",
-"d c #E97E66",
-"e c #CBCBC8",
-"f c #0C0F0B",
-"g c #0F130D",
-"h c #10140E",
-"i c #11150F",
-"j c #EFA392",
-"k c #BFBFBD",
-"l c #5D5D5C",
-"m c #10150F",
-"n c #141912",
-"o c #161C14",
-"p c #171D15",
-"q c #B7B7B4",
-"r c #0C0C0C",
-"s c #192017",
-"t c #1C2319",
-"u c #1D241A",
-"v c #CD8484",
-"w c #990000",
-"x c #701616",
-"y c #A6A6A5",
-"z c #181E16",
-"A c #1E261B",
-"B c #212A1E",
-"C c #222B1F",
-"D c #4F0000",
-"E c #AEAEAB",
-"F c #1D261B",
-"G c #242E21",
-"H c #273224",
-"I c #283325",
-"J c #580000",
-"K c #B5B5B3",
-"L c #293426",
-"M c #2D3929",
-"N c #2E3A2A",
-"O c #7C4343",
-"P c #6A0000",
-"Q c #720000",
-"R c #BDBDBB",
-"S c #232C20",
-"T c #2A3526",
-"U c #303C2B",
-"V c #33402E",
-"W c #C5C5C3",
-"X c #1E261C",
-"Y c #303D2C",
-"Z c #374532",
-"` c #394834",
-" . c #500000",
-".. c #CDCDCB",
-"+. c #1B2319",
-"@. c #253022",
-"#. c #303E2D",
-"$. c #394934",
-"%. c #3D4E38",
-"&. c #9D9D9B",
-"*. c #565655",
-"=. c #2C3828",
-"-. c #40503A",
-";. c #43553E",
-">. c #BABAB7",
-",. c #777776",
-"'. c #323830",
-"). c #232C1F",
-"!. c #313E2D",
-"~. c #3B4A36",
-"{. c #43553D",
-"]. c #485B42",
-"^. c #4A5E44",
-"/. c #F0F0EE",
-"(. c #E5E5E3",
-"_. c #C6C6C3",
-":. c #ACACAB",
-"<. c #8B8B8A",
-"[. c #32392F",
-"}. c #2C3728",
-"|. c #3F503A",
-"1. c #465840",
-"2. c #4B5E44",
-"3. c #4E6347",
-"4. c #506549",
-"5. c #DADAD8",
-"6. c #7A7D78",
-"7. c #333C30",
-"8. c #475A41",
-"9. c #4F6348",
-"0. c #53694C",
-"a. c #566C4E",
-"b. c #576D4F",
-"c. c #91968F",
-"d. c #3B4736",
-"e. c #42543C",
-"f. c #51674A",
-"g. c #586F50",
-"h. c #5B7353",
-"i. c #5C7454",
-" ",
-" . . . . . . . . . . . . . . . . ",
-" . + @ # $ % & & & * . . . . . . ",
-" . = - ; > , ' ) ! ~ . . . . . . ",
-" . . = - ; > , { ] ^ / . . . . . . ",
-" . . . = - ; > , { { { ( . . . . . . ",
-" . _ . : - ; > < { { { [ } | 1 1 1 . ",
-". . . . . . 2 3 . 4 5 6 < { { { [ 7 8 9 0 0 . ",
-". a 2 2 2 2 b c d . e 6 < { { { [ f g h i i . ",
-". j c c c c c c c 3 . k < { l { [ m n o p p . ",
-". j c c c c c c c c 3 . q { l r [ n s t u u . ",
-". v w w w w w w w w w x . y r { [ z A B C C . ",
-". v w w w w w w w w D . E { { { [ F G H I I . ",
-". v w w w w w w w J . K < { { { [ C L M N N . ",
-". O P P P P Q w J . R 6 < { { { [ S T U V V . ",
-". . . . . . Q J . W 5 6 < { { { [ X H Y Z ` . ",
-" . .. ..- 5 6 < { { { [ +.@.#.$.%.. ",
-" . . . = - 5 6 < { ] &.*.B =.Z -.;.. ",
-" . . = - 5 6 >.&.,.'.).!.~.{.].^.. ",
-" . /.(._.:.<.[.}.Z |.1.2.3.4.4.. ",
-" . 5.k 6.7.Z -.8.9.0.a.a.b.b.b.. ",
-" . c.d.e.^.f.g.h.i.i.i.i.i.i.i.. ",
-" . . . . . . . . . . . . . . . . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * followup_xpm[] = {
-"24 24 4 1",
-" c None",
-". c #A5A5A5A59595",
-"X c #C7C7C6C6C6C6",
-"o c #E1E1E0E0E0E0",
-" ",
-" . ",
-" ..X. ",
-" ..XXX. ",
-" ..XXXXXo. ",
-" ...XXXXXXooo. . ",
-" .o.XXXXXooooo..X. ",
-" .oo.XXXoooo..XXX. ",
-" .oo..Xooo..XXXXXo. ",
-" .oo.XX...XXXXXXooo. ",
-" .o.Xoo.o.XXXXXoooo. ",
-" .XXoo.oo.XXXoooooo. ",
-" .Xooo.oo..XXooooooo. ",
-" .ooo.oo.XXooooooooo. ",
-" .ooo.o.XoooooooooooX.",
-" .ooo.XXoooooooooooo.",
-" .ooo.Xoooooooooooo. ",
-" .ooo.ooooooooooo. ",
-" .oo..oooooooooo. ",
-" .. .ooooooo.. ",
-" .oooooo. ",
-" .ooo.. ",
-" .oo. ",
-" .. "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_forward_xpm[] = {
-"24 24 65 1",
-" c None",
-". c #000000",
-"+ c #535353",
-"@ c #FFFFFF",
-"# c #FEFEFE",
-"$ c #FDFDFD",
-"% c #FCFCFC",
-"& c #FBFBFB",
-"* c #F9F9F9",
-"= c #F8F8F8",
-"- c #F7F7F7",
-"; c #F6F6F6",
-"> c #F5F5F5",
-", c #F4F4F4",
-"' c #E3E3E3",
-") c #EEEEEE",
-"! c #4F4F4F",
-"~ c #F3F3F3",
-"{ c #F2F2F2",
-"] c #F1F1F1",
-"^ c #F0F0F0",
-"/ c #EFEFEF",
-"( c #EDEDED",
-"_ c #AEAEAE",
-": c #E4E4E4",
-"< c #434343",
-"[ c #ACACAC",
-"} c #C8C8C8",
-"| c #A0A0A0",
-"1 c #D4D4D4",
-"2 c #ECECEC",
-"3 c #959595",
-"4 c #3E3E3E",
-"5 c #4D4D4D",
-"6 c #818181",
-"7 c #C6C6C6",
-"8 c #6A6A6A",
-"9 c #636363",
-"0 c #B9B9B9",
-"a c #737373",
-"b c #7C7C7C",
-"c c #5B88B2",
-"d c #9EB8D1",
-"e c #5080AD",
-"f c #B5C9DC",
-"g c #AFC5DA",
-"h c #B2C7DB",
-"i c #B6CADD",
-"j c #A4BDD5",
-"k c #9CB7D1",
-"l c #080D11",
-"m c #BCBCBC",
-"n c #9BB6D0",
-"o c #A0BAD3",
-"p c #9AB5CF",
-"q c #97B3CE",
-"r c #5F8BB4",
-"s c #91B0CC",
-"t c #95B2CE",
-"u c #4C79A3",
-"v c #49749C",
-"w c #3F6588",
-"x c #2A435B",
-"y c #456F96",
-"z c #375978",
-" ",
-" ",
-" ",
-" ................. ",
-" .+@@@@#$%&*=-;>,'+. ",
-" .)!@>,~{{]^^/)('!_. ",
-" .@:<$~{{]^/))('![}. ",
-" .@>:!&]^^/)(('<|1}. ",
-" .@&>:<=^/)(2'!31:}. ",
-" .@>>>:4>)(2'567::}. ",
-" .@&>>:8<~2'!877>.}. ",
-" .@>>:9@0!^!37a7>... ",
-" .@&:9@>:1![7::b:.c. ",
-" .@:a@>>>>:.......de. ",
-" .@b@::::::.fghiiijkel ",
-" .ammmmmmmm.nokknpokqr. ",
-" ..........sdppnkkkotu.",
-" .vwwwwwwwwx. ",
-" .yzzzzzwwx. ",
-" .......wx. ",
-" .x. ",
-" .. ",
-" . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * fuwo_xpm[] = {
-"24 24 4 1",
-" c None",
-". c #A5A5A5A59595",
-"X c #C7C7C6C6C6C6",
-"o c #E1E1E0E0E0E0",
-" ",
-" . ",
-" .. . ",
-" .. . ",
-" .. . ",
-" ... . . ",
-" . . ..X. ",
-" . . ..XXX. ",
-" . .. ..XXXXXo. ",
-" . . ...XXXXXXooo. ",
-" . .X .o.XXXXXoooo. ",
-" .XX .oo.XXXoooooo. ",
-" .X .oo..XXooooooo. ",
-" . .oo.XXooooooooo. ",
-" . .o.XoooooooooooX.",
-" . .XXoooooooooooo.",
-" . .Xoooooooooooo. ",
-" . .ooooooooooo. ",
-" . ..oooooooooo. ",
-" .. .ooooooo.. ",
-" .oooooo. ",
-" .ooo.. ",
-" .oo. ",
-" .. "};
+++ /dev/null
-/* XPM */
-static char * get_news_xpm[] = {
-"24 24 4 1",
-". c None",
-"X c #A5A5A5A59595",
-"o c #E1E1E0E0E0E0",
-"O c #C7C7C6C6C6C6",
-"........................",
-"........................",
-"........................",
-".....XXX................",
-"...XXoooXXXXX...........",
-"XXXoooooXXoooX.XXX......",
-"XoXooXXXooooXXXoooX.....",
-"XooXoXoXooXXXoooooX.....",
-"XooXXXooXoXoXooooooX....",
-"XooXOXooXXXooXooooooX...",
-"XoXOOXooXOXooXXooooooX..",
-"OXOOOXoXOOXooXoooooooX..",
-"OXOooOXOOOXoXOooooooooX.",
-".OXooOXOooOXOOooooooooX.",
-".OXoooOXooOXOooooooooooX",
-"..OXooOXoooOXooooooooooX",
-"..OXooOOXooOXooooooooooX",
-"...OXooOXoooOXoooooooXXX",
-"...OXooXOXooOXooooooXOO.",
-"....OXXOOXooXOXoooXXO...",
-".....OO..OXXOOXooXOO....",
-"..........OO..OXXO......",
-"...............OO.......",
-"........................"};
+++ /dev/null
-/* XPM */
-static char * gnntg_xpm[] = {
-"24 24 4 1",
-" c None",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #C7C7C6C6C6C6",
-" ",
-" ....... ",
-" .XXXXX. ",
-" .XXXXX. ... ",
-" .XXXXX... .ooo. ",
-" .XXXXX.... ..ooo.. ",
-" .XXXXX..o.. ..ooo.. ",
-" .XXXXX...o.. ..o.. ",
-" .XXXXX. ..o........ ",
-" .XXXXX. ..oooooooo. ",
-" ....... .oooooooo.. ",
-" .ooooo..o. ",
-" .oooo..o. ",
-" .oooo..o. ",
-" .oooo..o. ",
-" .oooo..o. ",
-" ......... ",
-" ......oo. ",
-" .ooooo... ",
-" .oo..o... ",
-" .oo..o.. ",
-" ........ ",
-" .... ... ",
-" ... ... "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x20,0x40,0x10,0x20,0x0a,0x15,0x85,0x0a,0x20,0x20,0x28,0x50,0x8a,0x8a,0x02,
- 0x05,0x10,0x5e,0x54,0xa8,0xa5,0x35,0x01,0x7a,0x00,0x33,0x54,0x95,0xaa,0xaa,
- 0x02,0xcc,0xfe,0x17,0xa8,0xd8,0x01,0xac,0xfa,0x4f,0x3d,0xf8,0x05,0x30,0x22,
- 0x80,0xf6,0x60,0x2b,0xfc,0x8f,0x20,0x11,0x82,0xca,0x60,0x1a,0x2a,0x6e,0x28,
- 0x08,0x85,0x42,0x68,0xfa,0x11,0x28,0xc8,0x04,0x8b,0xe2,0xb7,0x06,0x21,0x14,
- 0xd4,0x1a,0x11,0x31,0x04,0x31,0x56,0x6d,0xdc,0x58,0xea,0xc7,0x28,0x64,0x66,
- 0x60,0xa9,0x57,0x72,0x90,0x49,0xc8,0xec,0x5f,0x99,0xa6,0x7f,0x95,0x52,0xaa,
- 0x64,0x22,0xbf,0x49,0x2a,0xa9,0x7e,0x92,0x52,0x55,0x55,0x54,0x49,0x4a,0xa4,
- 0x49,0xaa,0xa4,0x4a,0x2a,0x49,0x2a,0x25};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" .... ",
-" .XXXX. .... ",
-" .XXXX. .XXXX.",
-" .XXX. .XXXX.",
-" .........XX. .XXX.",
-".ooooooooo.. .........XX. ",
-".o....ooooo...... .ooooooooo.. ",
-"X. .ooooooooo.X..o....ooooo. ",
-"X. .oooo........X. .ooooo. ",
-". .oooo. .X. .ooooo. ",
-" .oooo. .. .oooo.o. ",
-" .oooo. .oooo.o. ",
-" ...... .ooooo.oo..",
-" .ooooo. ...... ..X.",
-" .ooooo. .ooooo. ..",
-" .o..ooo. ..oooo. ",
-".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX",
-"ooo.XX.oo.XXX......ooo..ooo.XXXX",
-"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX",
-"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX",
-"XXXXXXX.oo.XX.......XXX .oo.XXXX",
-"XXXXXXX.....X..XXXXXXXXXX.oo.XXX",
-"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX",
-"XXXXXXXXXXXXXXXXXXXXXXXXX......X",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x84,0x20,0x00,0x04,0x21,0x88,0x54,0x51,0x84,0x22,0x02,0x04,0x51,0x88,0xa0,
- 0x42,0x04,0x1f,0x0a,0x28,0x51,0x75,0xa1,0x7a,0x04,0x23,0x04,0xcc,0xa1,0x76,
- 0xa9,0xa6,0xfe,0x1b,0x00,0xd8,0x01,0x0c,0xfd,0x5f,0x3d,0xf8,0x05,0x30,0x26,
- 0x80,0xf7,0x60,0x33,0xfc,0xdb,0x20,0x11,0x22,0x8e,0x20,0x14,0x8a,0x66,0x68,
- 0x09,0x45,0x48,0x28,0xfc,0x11,0x21,0xc8,0x04,0x45,0xf4,0xf7,0x06,0x89,0x10,
- 0xc4,0x1a,0x23,0x35,0x2c,0x31,0xaa,0x6c,0x54,0x58,0xea,0xc7,0x48,0x64,0x66,
- 0xa0,0x99,0x57,0x72,0x50,0x59,0xc8,0xec,0x2f,0x49,0xa6,0x7f,0xaa,0x52,0xaa,
- 0x64,0x49,0xbf,0x49,0x2a,0xa5,0x7e,0x92,0xa4,0x14,0x55,0xa9,0x52,0xaa,0x92,
- 0x4a,0xa5,0x24,0x25,0xa5,0x94,0xaa,0xa8};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" .... ",
-" .XXXX. .... ",
-" .XXXX. .XXXX.",
-" .XXX. .XXXX.",
-" .........XX. .XXX.",
-".ooooooooo.. .........XX. ",
-".o....ooooo...... .ooooooooo.. ",
-"X. .ooooooooo.X..o....ooooo. ",
-"X. .oooo........X. .ooooo. ",
-". .oooo. .X. .ooooo. ",
-" .oooo. .. .oooo.o. ",
-" .oooo. .oooo.o. ",
-" ...... .ooooo.oo..",
-" .ooooo. ...... ..X.",
-" .ooooo. .ooooo. ..",
-" .o..ooo. ..oooo. ",
-".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX",
-"ooo.XX.oo.XXX......ooo..ooo.XXXX",
-"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX",
-"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX",
-"XXXXXXX.oo.XX.......XXX .oo.XXXX",
-"XXXXXXX.....X..XXXXXXXXXX.oo.XXX",
-"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX",
-"XXXXXXXXXXXXXXXXXXXXXXXXX......X",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x55,0xb5,0x55,0xb5,0xaa,0x12,0xa9,0x12,0x12,0x55,0x12,0x65,0xa9,0xa4,0x4a,
- 0x10,0x55,0x9b,0x15,0xc1,0x55,0x51,0x09,0x00,0x92,0x4a,0x02,0x00,0xa9,0x24,
- 0x01,0x00,0x55,0x5b,0x11,0x11,0x92,0xa4,0x00,0x00,0x2a,0x49,0x00,0x00,0x49,
- 0x55,0x00,0x00,0x35,0x55,0x11,0x11,0xaa,0xaa,0x00,0x00,0x92,0x44,0x00,0x00,
- 0xa5,0x32,0x00,0x00,0x55,0x55,0x11,0x11,0x29,0x55,0x01,0x00,0xaa,0x24,0x01,
- 0x00,0x92,0x97,0x00,0x00,0x75,0xba,0x13,0x11,0x2a,0x51,0x04,0x00,0xb2,0xaa,
- 0x0a,0x40,0x59,0x75,0x25,0x40,0xb5,0x3d,0x59,0xb5,0xfa,0x77,0xa5,0x2a,0xae,
- 0x9a,0x2a,0x49,0xd6,0x5f,0x49,0xa5,0xf7,0x57,0x35,0x55,0x7d,0x29,0x95,0x2a,
- 0x7e,0x55,0xa9,0x54,0x5f,0x92,0x94,0x92};
+++ /dev/null
-/* XPM */
-static char * icon-describe-group_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #999999999999 s backgroundToolBarColor",
-"X c #FFFFFFFFFFFF",
-"o c #BFBFBFBFBFBF",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-".......................XXXXX....",
-" ... ... ... ... ... XXX XXXXX..",
-"....................XXXXXXXXXXX.",
-"...................XXXXXXXXXXXXX",
-"..................XXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-".................XXXXXXXXXXXXXXX",
-".................XXXXXXXXXXXXXXX",
-"....... .......XXXXXXXXXXXXXX",
-" ... . oooo ... ..X XXX XXX XXX",
-"..... o...oo .......XXXXXXXXXXX.",
-".... .o....o. .......XXXXXXXXX..",
-".... o . ... .........XXXXX....",
-" ... o .. . .. ... ... ... ...",
-"... o . . ..................",
-".. X . . . ...................",
-". o . . ....................",
-" o . ... ... ... ... ...",
-" o .........................",
-"o . ...o......................",
-" ..........................."};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x00,0x40,0x00,0x00,0x30,0x30,0x00,0x00,0x68,0x38,0x00,0x38,0x60,0x48,
- 0x00,0xd4,0x91,0xde,0x07,0x68,0xcf,0xb7,0x1a,0x80,0xb4,0x6e,0x05,0x00,0xe2,
- 0x07,0x00,0x00,0xde,0x1d,0x00,0xe0,0xfd,0x77,0x00,0xb0,0x6a,0xf3,0x00,0x20,
- 0x9c,0xa5,0x03,0x00,0xaa,0x86,0x02,0x00,0x65,0x06,0x02,0xab,0x6f,0xaf,0x59,
- 0x80,0x62,0x0c,0x00,0xaa,0xab,0xba,0x4a,0x40,0x21,0x10,0x10,0xea,0x45,0x4a,
- 0x42,0x40,0x89,0x90,0x28,0xd2,0x21,0x02,0x82,0xa4,0x8a,0x44,0x20,0xf0,0x10,
- 0x10,0x85,0xa4,0x04,0x4a,0x20,0xe2,0x22,0x80,0x80,0xbc,0x4b,0x09,0x2a,0xee,
- 0x8e,0x32,0x80,0xeb,0x73,0x85,0x28,0x56,0xaa,0xb5,0x02,0xff,0xff,0x85,0x48,
- 0x08,0x94,0x11,0x01,0x42,0x02,0x48,0x54};
+++ /dev/null
-/* XPM */
-static char * icon-exit-gnus_xpm[] = {
-"32 32 4 1",
-" c #FFFFFFFFFFFF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #BFBFBFBFBFBF",
-" . ",
-" .. .. ",
-" . .. ... ",
-" ... .. . . ",
-" . . ... . . .... ..... ",
-" . .. .... ..... .. . . .. ",
-" . . .. . ... .. . . ",
-" . ...... ",
-" .... ... ... ",
-" .... ......... ... ",
-" .. . . .X.. .. .... ",
-" . .X. .. . . ... ",
-" .X. . . .. . . ",
-" .X. .. .. . ",
-".. . . ..X.. .. .... . .. .. . ",
-"ooooooo.X.ooo..ooo..oo ooooooooo",
-"oooo oo.X.ooo.ooooo..oooooooo oo",
-"o oooo.X.ooooooo ooo.ooooooooooo",
-"oooooo.X.ooooooooooooooo ooooooo",
-"ooo oo.X.ooo ooooooooooooooooooo",
-"oooooo.X.oooooooooo oooooo ooo",
-"ooooo.X.ooooooooooooooo ooooooo",
-"o ooo.X.oooooo ooooooooooooooooo",
-"ooooo.X.oooo o ooooooooo ooooo",
-"ooooo.X.ooooooooooo oooo o ooo",
-"oo....X...ooooooo o oooooooooo",
-"o..XX...XX..ooo.o.oo.oo oooooooo",
-".XX.XX..X.XX...ooo.oo o oooooo",
-"X.XX.XXXXXXXXXX..oooo.o.oooooo o",
-".................o.o oo.oooo o ",
-"oooooo ooo.oo oo.o . ooooooooo",
-"oooo o oo o oooooooooooooooo"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x20,0x00,0x40,0x88,0xff,0x57,0x15,0x22,0x02,0x0c,0xa0,0x88,0x02,0xa4,0x0a,
- 0x22,0x02,0x04,0xf0,0x84,0x03,0x54,0xdd,0x21,0x02,0x1e,0x14,0x97,0x02,0x66,
- 0xcd,0x02,0x02,0x7c,0x14,0x2b,0x03,0x9c,0xad,0x41,0x02,0x54,0xb1,0x0a,0x02,
- 0x2c,0xff,0x47,0x02,0xe4,0x14,0x2d,0xff,0x4f,0xa5,0x0a,0x48,0xa0,0x4a,0xb4,
- 0x12,0x0a,0x51,0x1b,0x40,0xa1,0x96,0x36,0x2a,0x10,0x4a,0x56,0x80,0x4a,0x57,
- 0x1b,0x55,0x00,0x92,0x52,0x00,0x55,0x26,0x17,0xa9,0x00,0xab,0x5a,0x04,0x2a,
- 0xfe,0x1f,0x41,0x41,0xcb,0x48,0x14,0x14,0x95,0x2f,0x82,0x42,0x53,0x09,0x28,
- 0x08,0xa5,0xaf,0x84,0xa2,0x75,0x06,0x12,0x04,0xd3,0x54,0x40,0x51,0xdf,0x0f,
- 0x0a,0x82,0xae,0x23,0xa0,0x28,0x8a,0x4a};
+++ /dev/null
-/* XPM */
-static char * icon-get-new-news-this-group_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" .......... ",
-" .XXXXXXXX. ",
-" .XXXXXXXX. ",
-" .XXXXXXXX. .... ",
-" .XXXXXXXX. .oooo. ",
-" .XXXXXXX.... .oooooo. ",
-" .XXXXXXX.. . .oooooo. ",
-" .XXXXXXXX...o. .oooooo. ",
-" .XXXXXXXX..ooo. .oooo. ",
-" .XXXXXXXX. .ooo. .oo. ",
-" .XXXXXXXX. .ooo.....o.... ",
-" .XXXXXXXX. .oooooooooooo. ",
-" .......... .oooooooooooo. ",
-" .oooooooooooo. ",
-" .oooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" ............ ",
-" .oooooo. . ",
-" .ooooooo.. . ",
-" .ooooooo. . ",
-" .oooo.oo... ",
-" .oooo.oooo. ",
-" .ooo. .ooo. ",
-" ..... ..... ",
-" .o. .o. ",
-" .o. .o. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x81,0x00,0x08,0xff,0x2b,0xa8,0x42,0x01,0x42,0x05,0x14,0x01,0x16,0x50,
- 0x41,0x01,0xa2,0x7a,0x0a,0x01,0x0a,0xcc,0x40,0x01,0xaf,0x92,0x15,0x01,0x13,
- 0x56,0x43,0x01,0xbe,0x2a,0x09,0x01,0x6e,0xcc,0x52,0x01,0xca,0x69,0x80,0x01,
- 0x32,0xdf,0x2b,0x01,0x66,0x55,0x85,0xff,0x33,0xa9,0x2e,0x24,0xc9,0x92,0x88,
- 0x09,0x82,0x4a,0x2e,0xa0,0x28,0xfd,0xf9,0x14,0x42,0x07,0x8d,0x42,0x08,0x85,
- 0x8d,0x20,0x52,0x87,0x85,0x8a,0x80,0x45,0x86,0x20,0x2a,0xc7,0x82,0x8a,0x00,
- 0xe7,0x82,0x41,0xd4,0x15,0x81,0x14,0x81,0xe6,0x81,0x81,0xa8,0x3d,0xff,0x14,
- 0x82,0xfa,0x02,0x42,0xd1,0x52,0x57,0x08,0x8a,0xad,0x82,0xa2,0xa0,0xef,0x2b,
- 0x04,0x05,0x55,0x81,0x51,0x50,0xc7,0x2b};
+++ /dev/null
-/* XPM */
-static char * icon-get-new-news_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-".......... ",
-".XXXXXXXX. ",
-".XXXXXXXX. ",
-".XXXXXXXX. .... ",
-".XXXXXXXX. .oooo. ",
-".XXXXXXX.... .oooooo. ",
-".XXXXXXX.. . .oooooo. ",
-".XXXXXXXX...o. .oooooo. ",
-".XXXXXXXX..ooo. .oooo. ",
-".XXXXXXXX. .ooo. .oo. ",
-".XXXXXXXX. .ooo.....o.... ",
-".XXXXXXXX. .oooooooooooo. ",
-".......... .oooooooooooo. ",
-" .oooooooooooo. ",
-" .ooooooooooo. ",
-" .o.......oo.....",
-" .o.XXXXX.oo.XXX.",
-" .o.XXXX.ooo.XXX.",
-" .o.XXXX.oo.XXXX.",
-" .o.XXX.ooo.XXXX.",
-" .o.XXX.oo.XXXXX.",
-" ...XX...o.XXXXX.",
-" .oo.X. .XXXXXX.",
-" .oo.XX.. .XXXXXX.",
-" .oo.... ........",
-" .oooo.o..o. ",
-" .oooo.oooo. ",
-" .ooo. .ooo. ",
-" ..... ..... ",
-" .o. .o. ",
-" .o. .o. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x04,0x20,0x20,0x54,0xa1,0x0a,0x4a,0x02,0x0a,0x50,0x01,0xa0,0x40,0x05,
- 0x54,0xca,0xff,0x7f,0x00,0x50,0x00,0x60,0x55,0x42,0x00,0xa0,0x80,0x68,0xc0,
- 0x21,0x2b,0x42,0xe0,0xe3,0x83,0x50,0xb0,0x06,0x2a,0x4a,0xf0,0x07,0x42,0x60,
- 0x70,0x07,0x16,0x42,0xe0,0x03,0x42,0x68,0x40,0x01,0x2a,0x42,0x40,0x01,0x82,
- 0x50,0xc8,0x05,0x2a,0x4a,0x0c,0x0c,0x82,0x60,0x30,0x03,0x2a,0x4a,0xc0,0x00,
- 0x82,0x40,0xc0,0x00,0x2a,0x6a,0x30,0x03,0x42,0x41,0x0c,0x0c,0x16,0x54,0x08,
- 0x04,0x22,0x41,0x00,0x00,0x4a,0x54,0x00,0x00,0x02,0x41,0x00,0x00,0x56,0x54,
- 0x00,0x00,0x02,0x42,0x00,0x00,0x52,0xe8,0xff,0xff,0x0b,0x04,0x84,0x00,0x42,
- 0x52,0x11,0xaa,0x28,0x00,0xa4,0x04,0x04};
+++ /dev/null
-/* XPM */
-static char * icon-killfile_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXXX.. ",
-" .XXXXXXXXXXXXXX.X. ",
-" .XXXXXXX...XXXX.XX. ",
-" .XXXXXX.....XXX..... ",
-" .XXXXX..X.X..XXXXXX. ",
-" .XXXXX.......XXXXXX. ",
-" .XXXXX...X...XXXXXX. ",
-" .XXXXXX.....XXXXXXX. ",
-" .XXXXXXX.X.XXXXXXXX. ",
-" .XXXXXXX.X.XXXXXXXX. ",
-" .XXXX.XX...X.XXXXXX. ",
-" .XXX..XXXXXX..XXXXX. ",
-" .XXXXX..XX..XXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX. ",
-" .XXXXX..XX..XXXXXXX. ",
-" .XXX..XXXXXX..XXXXX. ",
-" .XXXX.XXXXXX.XXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa,
- 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0x8a,0xa0,0x80,0x42,0x84,
- 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x80,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41,
- 0x80,0x00,0x16,0x54,0x8a,0x00,0x42,0x41,0x84,0x00,0x2a,0x54,0x8a,0x00,0x82,
- 0x41,0x80,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0x8a,0x00,
- 0x82,0x44,0x84,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x80,0x00,0x16,0xea,0xff,
- 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44,
- 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42,
- 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22};
+++ /dev/null
-/* XPM */
-static char * icon-unsubscribe_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXX.XXXXX.. ",
-" .XX.X.XXX.XXXXX.X. ",
-" .XXX.XXXX.XXXXX.XX. ",
-" .XX.X.XXX.XXXXX..... ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x04,0x00,0x40,0x22,0x51,0x55,0x15,0x88,0x04,0x00,0x20,0x22,0xa0,0xaa,
- 0x4a,0xc4,0xff,0x3f,0x00,0x61,0x80,0x60,0x55,0x54,0xa0,0xa0,0x80,0x42,0x90,
- 0x20,0x2b,0x68,0x8a,0xe0,0x83,0x42,0x84,0x00,0x2a,0xd4,0xff,0x00,0x42,0x41,
- 0x80,0x00,0x16,0x54,0xa0,0x00,0x42,0x41,0x90,0x00,0x2a,0x54,0x8a,0x00,0x82,
- 0x41,0x84,0x00,0x2a,0xd4,0xff,0x00,0x82,0x42,0x80,0x00,0x2a,0x68,0xa0,0x00,
- 0x82,0x44,0x90,0x00,0x2a,0x52,0x8a,0x00,0x42,0x40,0x84,0x00,0x16,0xea,0xff,
- 0x00,0x22,0x40,0x80,0x00,0x4a,0x4a,0x80,0x00,0x02,0x61,0x80,0x00,0x56,0x44,
- 0x80,0x00,0x02,0x51,0x80,0x00,0x52,0xc4,0xff,0xff,0x0b,0xa1,0x04,0x00,0x42,
- 0x14,0xa8,0xaa,0x88,0x82,0x02,0x00,0x22};
+++ /dev/null
-/* XPM */
-static char * icon-subscribe_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXX.XXXXX.. ",
-" .XXXXXX.X.XXXXX.X. ",
-" .XXXXX.XX.XXXXX.XX. ",
-" .XX.X.XXX.XXXXX..... ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.X.XXXXXXXXX. ",
-" .XXXXX.XX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.X.XXXXXXXXX. ",
-" .XXXXX.XX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 18
-#define noname_height 13
-static char noname_bits[] = {
- 0x00,0x00,0x00,0xc0,0x0c,0x00,0xe0,0x1f,0x00,0x92,0x39,0x00,0x0e,0x71,0x02,
- 0x46,0xe0,0x03,0x20,0xc0,0x01,0x00,0x08,0x00,0x10,0x0d,0x00,0xc4,0x08,0x00,
- 0x78,0x08,0x00,0x18,0x89,0x00,0x00,0x08,0x00};
+++ /dev/null
-/* XPM */
-static char *gnus-pointer[] = {
-/* width height num_colors chars_per_pixel */
-" 18 13 2 1",
-/* colors */
-". c #0000ff",
-"# c None s None",
-/* pixels */
-"##################",
-"######..##..######",
-"#####........#####",
-"#.##.##..##...####",
-"#...####.###...##.",
-"#..###.######.....",
-"#####.########...#",
-"###########.######",
-"####.###.#..######",
-"######..###.######",
-"###....####.######",
-"###..######.######",
-"###########.######"
-};
\ No newline at end of file
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x40,0x40,0x10,0x01,0x15,0x15,0x45,0x50,0x40,0x40,0x08,0x05,0x14,0x14,0xa2,
- 0x50,0xe2,0xff,0x3f,0x82,0x48,0x00,0xe0,0x28,0x62,0xe6,0xb8,0x82,0x48,0x29,
- 0x25,0x29,0x62,0xa9,0xe4,0x83,0x48,0x2f,0x05,0x2a,0x42,0xe9,0x38,0x42,0x60,
- 0x00,0x00,0x16,0x4a,0x82,0x10,0x22,0x50,0x00,0x00,0x4a,0x42,0xcb,0x1c,0x02,
- 0x68,0x2b,0x25,0x56,0x42,0x2d,0x1d,0x02,0x50,0x2d,0x05,0x52,0x4a,0xc9,0x04,
- 0x0a,0x40,0x00,0x00,0x42,0x6a,0x18,0x00,0x16,0x41,0x3c,0x00,0x42,0x54,0xe6,
- 0x3f,0x0a,0x41,0xe6,0x3f,0x52,0x54,0x3c,0x2a,0x06,0x42,0x18,0x2a,0x42,0x68,
- 0x00,0x08,0x2a,0x44,0x00,0x00,0x06,0xd2,0xff,0xff,0x53,0x20,0x84,0x20,0x04,
- 0x8a,0x10,0x8a,0xa8,0x20,0x4a,0x21,0x02};
+++ /dev/null
-/* XPM */
-static char * icon-rot13_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXXX.. ",
-" .XX..XX...XXX...X. ",
-" .X.XX.X.XX.X.XX.XX. ",
-" .X.XX.X.X.XX.XX..... ",
-" .X....X.XX.X.XXXXXX. ",
-" .X.XX.X...XXX...XXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XX.XXXXX.XXXX.XXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .X..X.XX..XX...XXXX. ",
-" .X..X.X.XX.X.XX.XXX. ",
-" .X.X..X.XX.X...XXXX. ",
-" .X.X..X.XX.X.XXXXXX. ",
-" .X.XX.XX..XX.XXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXX..XXXXXXXXXXXX. ",
-" .XXX....XXXXXXXXXXX. ",
-" .XX..XX.........XXX. ",
-" .XX..XX.........XXX. ",
-" .XXX....XXX.X.X.XXX. ",
-" .XXXX..XXXX.X.X.XXX. ",
-" .XXXXXXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x11,0x11,0x01,0x11,0x54,0x4a,0xa9,0x52,0x82,0x10,0x04,0x08,0x28,0x24,0xa1,
- 0x42,0x91,0x91,0x0f,0x19,0x25,0xaa,0xa9,0x44,0x88,0x60,0x18,0x11,0x42,0x1c,
- 0x56,0x44,0x19,0x07,0x97,0x31,0x44,0x01,0x23,0x0a,0x12,0x81,0x60,0x50,0x80,
- 0x02,0x42,0x05,0x3b,0x05,0x78,0x59,0x00,0x0a,0x56,0x12,0xaa,0xf4,0x05,0x41,
- 0x00,0x54,0x51,0x10,0x5b,0x51,0x95,0x55,0x10,0x15,0x00,0x11,0x42,0x40,0x55,
- 0x44,0x10,0x2a,0x00,0x21,0x5b,0x91,0x5b,0x95,0x80,0x24,0x00,0x21,0x12,0x92,
- 0x2a,0x14,0x44,0x01,0x80,0x42,0x11,0xb5,0x35,0x19,0x54,0x11,0x08,0x42,0x02,
- 0x44,0xa1,0x08,0xa8,0x22,0x14,0x52,0x11,0x99,0x51,0x11,0x4a,0x22,0x14,0x4a,
- 0x20,0x89,0x42,0x10,0x15,0x40,0x20,0x45};
+++ /dev/null
-/* XPM */
-static char * icon-cancel-post_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ... ... ... ... ....... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... .... ... ...",
-"............... XX ............",
-"............. XXXX ...........",
-"........... XXXX X ...........",
-" ... .... XXXXX X ... ... ...",
-"........ XXXXXXX XXX ..........",
-"........ XXXXXX oXXXX ..........",
-"........o XXXXXXXoXXXX .........",
-" ... ...oo XXXXXXXX . ... ...",
-".........oo XXXXX oooo.........",
-"..........oo o..............",
-"..........ooooooo...............",
-" ... ... ... oo. ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x81,0x00,0x04,0x42,0x28,0x52,0x51,0x14,0x85,0x08,0x04,0x81,0x20,0x42,
- 0x49,0x14,0x8a,0x08,0x20,0x41,0x21,0x52,0x15,0x14,0x44,0x00,0x40,0x41,0x91,
- 0xbf,0x2a,0x14,0xda,0x10,0x80,0x81,0x94,0x90,0x2a,0x14,0x73,0xf0,0x80,0xe1,
- 0x60,0x90,0x2b,0xc4,0x60,0x08,0x43,0xa2,0xf0,0x0f,0x15,0x88,0x11,0xfc,0x21,
- 0xd2,0x11,0x8c,0x4a,0x80,0x12,0x84,0x00,0xd5,0x13,0x84,0x55,0x00,0x17,0x74,
- 0x80,0x54,0xfb,0xcf,0x2a,0x02,0x9a,0x24,0x40,0x54,0x9f,0xbc,0x36,0xa9,0xf4,
- 0x77,0x49,0x94,0x96,0x94,0xa4,0x25,0x95,0x35,0x15,0xa9,0xfe,0xbf,0xa4,0x92,
- 0xdc,0x5c,0x29,0x4a,0x9e,0x3d,0x95,0xaa,0xfe,0x4f,0x52,0x24,0xf9,0xaf,0x4a,
- 0xa9,0x52,0x91,0x94,0x25,0x29,0x55,0x52};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ...... ",
-" .. .XXXX. ",
-" .X. .XXXX. ",
-" ..XX...XXXXX.... ",
-" ..XXXXX..XXXXX.XX... ",
-" ..XXXXX..XXXX.XXXX.. ",
-" .XXXX........XXXX. ",
-" ..XXX.XXXXX....... ",
-" ..XXX.XXXXX..XXX. ",
-" .X.XX.XXXXX.XXXX. ",
-" ...XX.XXXXX.XXXX. ",
-" ...X.XXXXX.X... ",
-" .X.........XX. ",
-" . .XX.XX.XX. ",
-"ooooooooo....XX.XX....oooooooooo",
-"oooooooooo. ....... .oooooooooo",
-"oooooooooo.X.XX.X .X.ooooooooooo",
-"oooooooooo. .X . . .ooooooooooo",
-"oooooooooo...........ooooooooooo",
-"oooooooooo...X..XX...ooooooooooo",
-"oooooooooo...X ..X...ooooooooooo",
-"oooooooooo..........oooooooooooo",
-"oooooooooooo.......ooooooooooooo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x11,0x91,0x11,0x95,0x54,0x25,0x54,0x21,0x02,0x90,0x00,0x84,0xa0,0x0a,0x54,
- 0x29,0x1b,0xb1,0x11,0x91,0x40,0x0a,0x4a,0x25,0x8a,0xa0,0x20,0x88,0x20,0x14,
- 0x0e,0x22,0x9b,0x51,0xb7,0x99,0x20,0x14,0x0b,0x02,0x42,0xc1,0x22,0x28,0x14,
- 0x92,0x48,0x45,0x51,0x19,0x11,0x11,0x14,0x42,0xaa,0x54,0x42,0x88,0x00,0x02,
- 0x90,0x72,0xaa,0x56,0x15,0x71,0x11,0x17,0x42,0x3a,0x49,0x4b,0x28,0x49,0xa4,
- 0x22,0x04,0x30,0x02,0x09,0xb1,0xdb,0x59,0xb5,0x15,0xa0,0xd3,0xff,0x40,0x05,
- 0xbf,0x02,0x2a,0xd3,0x08,0x54,0x91,0x53,0x77,0x7f,0xc8,0xa9,0xd4,0x8a,0x62,
- 0x22,0x86,0x35,0xc8,0x5b,0x4b,0x67,0x93,0xfd,0x91,0x39,0x24,0x18,0xff,0x7a,
- 0x90,0x46,0xc5,0xcf,0x25,0x94,0x21,0xf1};
+++ /dev/null
-/* XPM */
-static char * icon-catchup2_xpm[] = {
-"32 32 2 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................. .............",
-" ... ... ... ... . ... ... ...",
-"................ ..............",
-"............... ................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"............. .......... .....",
-" ... ... ... . ... ... . ...",
-"............ .......... ......",
-"........... ........... ........",
-"............ .......... .......",
-" ... ... ... . . ... ... ... ...",
-"............... ..... ",
-"................ ... ......",
-"........ ..... ... ...... .....",
-" ... .. .. . . . . .. . .",
-"....... .... .... ... .. . ... ",
-"...... ...... ... ..... ... ...",
-"...... .. .... ...... .. ..",
-" ... ... . ... .. .. ..",
-"........... .... . .... .",
-".......... ..... ..... .. .",
-".......... ..... ....... ... "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x19,0x51,0x91,0x11,0x82,0x14,0x2a,0x48,0x28,0x42,0x40,0x25,0x82,0x10,0x15,
- 0x00,0x59,0xfa,0xff,0x5b,0x12,0x4b,0xfe,0x21,0x40,0x21,0xf1,0x93,0x2a,0x0b,
- 0xf8,0x05,0x91,0xb5,0xf2,0x31,0x24,0x01,0xf1,0x4b,0x12,0x54,0xfa,0x01,0x80,
- 0x83,0xf0,0x55,0x5b,0x35,0xf2,0x11,0x00,0x8b,0xfe,0x4b,0x2a,0x21,0xf7,0x21,
- 0x80,0x0b,0xf6,0x13,0x5b,0xb5,0xf4,0x59,0x10,0x03,0xf1,0x01,0x42,0x2b,0xf4,
- 0x55,0x90,0x40,0xf3,0x03,0x13,0x1a,0xf8,0x59,0xa8,0x83,0xf2,0x11,0x02,0x2b,
- 0x5c,0x43,0x50,0xe3,0xee,0x10,0x93,0xfc,0x55,0x5b,0x48,0x92,0x92,0x00,0x22,
- 0x49,0x48,0xaa,0x08,0x00,0x84,0x00,0xb5,0xbb,0x31,0x5b,0x01,0x00,0x0a,0x00,
- 0x54,0x25,0x51,0x55,0x01,0x48,0x04,0x00};
+++ /dev/null
-/* XPM */
-static char * icon-exit-summary_xpm[] = {
-"32 32 2 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ...... ... ...",
-"........ ....... .......",
-"........ ........... .......",
-"........ .......... .......",
-" ... ... ... ....... ... ...",
-"................ ... .......",
-".................... .......",
-"........ .......... .......",
-" ... ... ... ....... ... ...",
-"........ ....... . .......",
-"........ ....... . .......",
-"........ ....... . .......",
-" ... ... ... ....... ... ...",
-"........ .......... .......",
-"........ ........... .......",
-"................ ... .......",
-" ... ....... ....... ... ...",
-"........ .......... .......",
-"........ ........ . . .......",
-"........ .... . . . . ........",
-" ... .. .. . . . . ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x00,0x40,0x08,0xb6,0x76,0x37,0x63,0x20,0x02,0x00,0x04,0x8a,0x48,0x55,
- 0x51,0x10,0x22,0x0e,0x82,0xa6,0xaa,0xa9,0x36,0x12,0x62,0x38,0x20,0xa0,0x18,
- 0x96,0x4a,0x0a,0x07,0x17,0x00,0xa2,0x01,0xa3,0x76,0x6a,0x80,0x60,0x00,0x60,
- 0x00,0x40,0x55,0x52,0x00,0x40,0x00,0xa6,0x00,0x80,0x6b,0x90,0xe1,0x80,0x04,
- 0x24,0x9a,0x00,0x51,0x82,0x86,0x01,0x85,0xaa,0x61,0x01,0x32,0x60,0x70,0x01,
- 0x42,0x1d,0x30,0x02,0x14,0x04,0x08,0x02,0x4c,0x06,0x00,0x02,0x28,0x06,0x00,
- 0x04,0xac,0x08,0x00,0x08,0x0b,0x0a,0x00,0xc8,0x22,0x12,0x00,0x70,0x6a,0x1a,
- 0x00,0x10,0x01,0x20,0x00,0x60,0x52,0x32,0x00,0x20,0x08,0x46,0x00,0x40,0x63,
- 0x50,0x00,0x40,0x04,0x85,0x00,0x80,0x52};
+++ /dev/null
-/* XPM */
-static char * icon-followup_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXXX. ",
-" .X..XX.XXXXXXXX. ",
-" ..XXXX..XXXXXXX. ",
-" . ..XXXX..X.XXXXXXXX. . ",
-" ..XXXXX...X.XXXXXXXX. ",
-" ..XXXXXXX..XXX.XXXXXXXX. ",
-" .XXXXXXXX.XXXXX.XXXXXXXX. ",
-" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX.XXXXXXX.. ",
-" .XXXXXXXXXXXXXXX.XXXX.. ",
-" .XXXXXXXXXXXXXXX.XX.. ",
-" . .XXXXXXXXXXXXXXX.. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x04,0x40,0x10,0x00,0xa3,0x36,0xa6,0x76,0x54,0x40,0x11,0x02,0x01,0x2a,0x88,
- 0x48,0x54,0x81,0x22,0x22,0x22,0x6a,0xaa,0x2a,0x4a,0x02,0x21,0xa0,0x90,0x50,
- 0x8e,0x0a,0x02,0x0a,0x27,0x50,0xb2,0xa2,0xab,0x26,0x42,0xaa,0x00,0x92,0x94,
- 0x00,0xaa,0x20,0x00,0xaa,0x00,0x85,0xb6,0x22,0x76,0x32,0x20,0xea,0x80,0x44,
- 0x8a,0x98,0x2a,0x11,0x10,0x87,0x00,0x44,0xa6,0x71,0x6b,0x33,0x60,0xcc,0x22,
- 0x44,0x1d,0xe3,0x0a,0x11,0xc8,0xe0,0x24,0x44,0x3e,0x90,0x6c,0x2b,0x08,0x00,
- 0x09,0xa0,0x06,0x00,0x49,0x0a,0x04,0x00,0x92,0x50,0x0b,0x00,0x32,0x26,0x0c,
- 0x00,0xa4,0x90,0x11,0x00,0x24,0x24,0x14,0x00,0xc8,0x82,0x22,0x00,0x48,0x32,
- 0x2a,0x00,0x90,0x42,0x50,0x00,0x90,0x28};
+++ /dev/null
-/* XPM */
-static char * icon-followup-w-orig_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ",
-" . . . . . . . . ",
-" ",
-" .. ",
-" ... ",
-" . . . . .. . . . ",
-" . ",
-" ",
-" ",
-" . . . . . . . . ",
-" .. ",
-" ..XX. ",
-" ..XXXX. ",
-" . ..XXX...X. . . . ",
-" ..XXX..XX..X. ",
-" ..XXX..XXX...X. ",
-" .XX..XXXXX...XX. ",
-" . ...XXXXXX.XX.XX. . . . ",
-" .XXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXX.XX. ",
-" . .XXXXXXXXXXXXX.XX. . . ",
-" .XXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXX.XX. ",
-" . .XXXXXXXXXXXXX.XX. . . ",
-" .XXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x20,0x20,0x40,0xaa,0x8a,0x0a,0x15,0xfe,0xff,0xff,0x27,0x0e,0x00,0x80,
- 0x4d,0x32,0x00,0x60,0x04,0xc2,0x00,0x18,0x54,0x02,0x03,0x06,0x04,0x03,0x8c,
- 0x01,0x54,0x02,0x74,0x02,0x04,0x02,0x03,0x0c,0x54,0x82,0x00,0x10,0x84,0xf2,
- 0xff,0xff,0x3f,0x52,0x00,0x00,0x6c,0x9b,0x01,0x00,0x23,0x16,0x06,0xc0,0x60,
- 0x1e,0x18,0x30,0x20,0x14,0x60,0x0c,0xa0,0x11,0xa0,0x0b,0x20,0x14,0x10,0x30,
- 0x60,0x11,0x0c,0x40,0x20,0x14,0x02,0x80,0xa0,0x12,0x01,0x00,0x23,0xd8,0x00,
- 0x00,0x64,0x32,0x00,0x00,0x38,0xf8,0xff,0xff,0xbf,0x02,0x00,0x40,0x24,0x54,
- 0x55,0x15,0x11,0x01,0x00,0x40,0x44,0x54,0x55,0x15,0x11,0x01,0x00,0x40,0x44,
- 0x54,0x55,0x05,0x11,0x02,0x00,0x50,0x44};
+++ /dev/null
-/* XPM */
-static char * icon-mail-copy_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" .......................... ",
-" ...XXXXXXXXXXXXXXXXXXX..X. ",
-" .XX..XXXXXXXXXXXXXXX..XXX. ",
-" .XXXX..XXXXXXXXXXX..XXXXX. ",
-" .XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXXX.X...XX.XXXXXXXX. ",
-" .XXXXXX..XXXXXXXX..XXXXXX. ",
-" .XXXXX.XXXXXXXXXXXX.XXXXX. ",
-" .XX.......................... ",
-" .XX.X.XXXXXXXXXXXXXXXXXXX..X. ",
-" .X..XX..XXXXXXXXXXXXXXX..XXX. ",
-" ..X.XXXX..XXXXXXXXXXX..XXXXX. ",
-" ....XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXXX.X...X.XXXXXXXXX. ",
-" .XXXXXXX.XXXXXXX..XXXXXXX. ",
-" .XXXXX..XXXXXXXXXX.XXXXXX. ",
-" .XXXX.XXXXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXXXX.XX. ",
-" ..XXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x00,0x80,0x00,0xa2,0xaa,0x2a,0x54,0x08,0x00,0x40,0x81,0xf2,0xab,0x2a,
- 0x28,0x5c,0x03,0x80,0x82,0x2d,0x56,0xf5,0x28,0x84,0x06,0x98,0x8b,0x5d,0x5e,
- 0xe7,0x2c,0x1c,0x1f,0x1f,0xba,0xf1,0xf3,0xa7,0xc9,0x44,0xa8,0x90,0x88,0xf1,
- 0xf3,0x8b,0x08,0x1c,0x5f,0x7f,0x09,0xad,0x1e,0xff,0x08,0x04,0x46,0x08,0x04,
- 0xae,0x26,0x06,0x04,0x18,0x8b,0x02,0x06,0xfa,0x23,0xc1,0x01,0x20,0x88,0x38,
- 0x00,0x95,0x62,0x07,0x80,0x40,0xe4,0x00,0x40,0x14,0xd1,0x00,0x20,0x42,0x44,
- 0x03,0x60,0x10,0x11,0x05,0x10,0x4a,0x44,0x1c,0xa8,0x00,0x11,0x61,0x0c,0x2a,
- 0x42,0xa4,0x25,0x81,0x14,0x09,0x42,0x14,0x20,0x50,0x15,0xa1,0x4a,0x05,0x40,
- 0x04,0x00,0xa8,0x0a,0x51,0x55,0x05,0x50};
+++ /dev/null
-/* XPM */
-static char * icon-mail-delete_xpm[] = {
-"32 32 4 1",
-" c #BEBEBEBEBEBE s backgroundToolBarColor",
-"X c #000000000000",
-"o c #E7E7E7E7E7E7",
-"O c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" XXXXX ",
-" XX XX ",
-" XX XX XXX ",
-" X X XXooXX X ",
-" XX XXX XXooXX XX ",
-" XX XXXXX XXXXX XOXXX ",
-" XXXXX XXXXXX XOOXOOXX",
-" XOX XOOOXOOOX",
-" XXXXX XXXXXX XOOOXOOOO",
-" XX XXXXX XXXXXX XOOXOOOO",
-" XX XXX XXXXXXXOOOXOOOO",
-" X X XOOOOOOXOOOOO",
-" XX XX XOOOOOOOXOOOOO",
-" XX XX XOOOOOOOXXOOOOO",
-" XXXXX XOOOOOXXXOOOOOOO",
-" XOOOXXXOOOOOOOOOO",
-" XOXXXOOOOOOOOOOOOX",
-" XXXOOOOOOOOOOOOOOX ",
-" XXOOOOOOOOOOOOOX ",
-" XXOOOOOOOOOOOX ",
-" XOOOOOOOOOX ",
-" XXOOOOOOX ",
-" XXOOOX ",
-" XXOX ",
-" X ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x10,0x42,0x80,0x20,0x84,0x10,0x2a,0x14,0x3a,0xa5,0x40,0x41,0x64,0x08,0x14,
- 0x28,0xd6,0xa0,0x62,0x85,0x80,0x15,0xe8,0x20,0xca,0x41,0x39,0x8b,0xb0,0x2a,
- 0x24,0x22,0xd2,0x86,0x12,0x86,0x58,0x24,0x11,0x2c,0xd2,0x8c,0x08,0x98,0x34,
- 0x75,0x08,0x10,0x30,0x14,0x08,0x60,0x8a,0x0e,0x04,0x20,0x10,0x05,0xfc,0x7f,
- 0x45,0x02,0x02,0x60,0x10,0x01,0x03,0x18,0xca,0xe0,0x01,0x44,0x20,0x3e,0x00,
- 0x0a,0xf4,0x21,0x00,0x53,0x32,0x20,0x80,0x80,0x10,0x10,0x40,0x2a,0x2a,0x10,
- 0xb0,0x80,0x60,0x10,0x28,0x2a,0xea,0x10,0x84,0x40,0x81,0x10,0x2a,0x14,0x94,
- 0x11,0x41,0x21,0x21,0xca,0x2a,0x48,0x84,0xac,0x80,0x02,0x21,0x3d,0x54,0x50,
- 0x14,0x84,0x00,0x05,0x42,0x21,0xaa,0x50};
+++ /dev/null
-/* XPM */
-static char * icon-mail-forward_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ... ",
-" . . ",
-" . . . ",
-" . ... ",
-" ... ...XX. ",
-" . . . .XX.XXX. ",
-" . . . .XX.XXXX.. ",
-" . . . .XXX.XXXXX.. ",
-" . . . .XXX.XXXXXXX. ",
-" .. . ..XXXX.XXXXXXXX. ",
-" . . .XXXXXX.XXXXXXXXX. ",
-" . .XXXXXX.XXXXXXXXXX. ",
-" .XXXXXXX............. ",
-" .XXXXXXX.XXXXXXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX.. ",
-" ..XXXXX....XXXXXXXXX. ",
-" .XXX.....XXXXXXXXXXX. ",
-" ....XXXX.XXXXXXXXXX. ",
-" ..XXXXXXX.XXXXXXXXX. ",
-" .XXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.XXXXXXX.. ",
-" ..XXXXX.XXXXXX. ",
-" ..XXXX.XXXXX. ",
-" .XXXX.XXXX. ",
-" .XXX.XXX. ",
-" .X.XX.. ",
-" ..X. ",
-" ... ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x48,0x00,0x11,0x02,0x12,0x54,0x84,0x50,0x40,0x81,0x50,0x82,0x2a,0x28,0x0a,
- 0x28,0x80,0x42,0xa0,0x82,0xaa,0x13,0x3d,0x28,0x40,0x46,0xd4,0x42,0xb5,0x28,
- 0x86,0x10,0x50,0xda,0x51,0x47,0x99,0xb0,0x09,0x13,0x14,0x50,0x01,0x45,0x21,
- 0x18,0x82,0x21,0x74,0x4c,0xc7,0x94,0x81,0x13,0x78,0x02,0x94,0x44,0x05,0x29,
- 0xf1,0xff,0xff,0x7f,0x74,0x00,0x00,0x2c,0x91,0x01,0x00,0x23,0x14,0x06,0xc0,
- 0xa0,0x11,0x18,0x30,0x20,0x14,0x60,0x0c,0x60,0x12,0x90,0x0b,0x20,0x18,0x0c,
- 0x30,0xa0,0x12,0x02,0x40,0x20,0x18,0x01,0x80,0xa0,0xd2,0x00,0x00,0x23,0x38,
- 0x00,0x00,0x64,0x12,0x00,0x00,0x38,0xf8,0xff,0xff,0xbf,0x02,0x00,0x00,0x20,
- 0xa8,0xaa,0xaa,0x8a,0x05,0x00,0x40,0x20};
+++ /dev/null
-/* XPM */
-static char * icon-mail-get_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ... ... ",
-" . . . . ",
-" . . . . ",
-" . . . . .. ",
-" . .. .. .. ",
-" .XXXXXXX. .XXXXXXX. ",
-" .XXXXX. .XXXXX. ",
-" ..XXX.. ..XXX.. ",
-" ... ... ",
-" ",
-" .......................... ",
-" ...XXXXXXXXXXXXXXXXXXX..X. ",
-" .XX..XXXXXXXXXXXXXXX..XXX. ",
-" .XXXX..XXXXXXXXXXX..XXXXX. ",
-" .XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXX.XX...X.XXXXXXXXX. ",
-" .XXXXX..XXXXXXXX..XXXXXXX. ",
-" .XXXX.XXXXXXXXXXXX.XXXXXX. ",
-" .XXX.XXXXXXXXXXXXXX.XXXXX. ",
-" .X..XXXXXXXXXXXXXXXX..XXX. ",
-" ..XXXXXXXXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x04,0x42,0x08,0x10,0xa1,0x10,0x42,0x05,0x14,0xa2,0xff,0xaf,0x01,0x89,0x00,
- 0x14,0x54,0xa4,0x00,0x64,0x02,0xc1,0x00,0x3c,0xf8,0xff,0x1f,0xa0,0x6d,0x10,
- 0x68,0x20,0xf8,0xff,0x1f,0x60,0x12,0x84,0x00,0x20,0x48,0xd1,0x00,0xa0,0x02,
- 0x88,0xfc,0x21,0xfc,0xff,0x00,0x60,0x1e,0x80,0x6c,0x21,0x64,0x80,0x00,0xa0,
- 0x86,0x81,0x00,0x20,0x04,0x86,0x00,0x60,0x05,0x98,0x00,0x20,0x04,0xe4,0x00,
- 0xa0,0x06,0x83,0x80,0x25,0x84,0x80,0x00,0x60,0x46,0x80,0x00,0x20,0x34,0x80,
- 0x00,0xa0,0x0d,0x80,0xff,0x3f,0x04,0x00,0x00,0x2e,0xfe,0xff,0xff,0x4f,0x48,
- 0x92,0x44,0x12,0x92,0x08,0x11,0x44,0x00,0x21,0x44,0x11,0x55,0x48,0x21,0x44,
- 0x80,0x02,0x8a,0x10,0x2a,0xa8,0x40,0x44};
+++ /dev/null
-/* XPM */
-static char * icon-mail-originate_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ............. ",
-" .XXXXXXXXXX.X. ",
-" .XXXXXXXXXX.XX. ",
-" .XXXXXXXXXX.... ",
-" ..................XXXXXXXX. ",
-" .X. X X X X X X .X..XXXXXX. ",
-" ..................XXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" .XX.......XXXX. ",
-" ..............XXXXXXXXXXXXX. ",
-" ...XXXXXXXXXX.XX..X..X.XXXX. ",
-" .XX..XXXXXXXX.XXXXXXXXXXXXX. ",
-" .XXXX..XXXXXX.XXXXXXXXXXXXX. ",
-" .XXXXXX..XXXX.XXXXXXXXXXXXX. ",
-" .XXXXXXXX..XX.XXXXXXXXXXXXX. ",
-" .XXXXXXX.XX...XXXXXXXXXXXXX. ",
-" .XXXXX..XXXXX.XXXXXXX..X.XX. ",
-" .XXXX.XXXXXXX.XXXXXXXXXXXXX. ",
-" .XXX.XXXXXXXX.XXXXXXXXXXXXX. ",
-" .X..XXXXXXXXX.XXXXXXXXXXXXX. ",
-" ..XXXXXXXXXXX............... ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x40,0x40,0x20,0xaa,0x2a,0x7a,0x0a,0x00,0x80,0x88,0x51,0xaa,0x2a,0x06,
- 0x06,0x00,0xc0,0x05,0x58,0xaa,0x3a,0x12,0x08,0x00,0x0c,0x11,0x2c,0xaa,0x03,
- 0x09,0x42,0xc0,0x80,0x04,0x06,0x35,0x40,0x04,0x57,0x98,0x49,0x80,0x18,0x3a,
- 0x20,0x41,0x56,0xc8,0x10,0xc1,0x11,0x0c,0x93,0x60,0x50,0x0a,0x1c,0x18,0x90,
- 0x08,0x30,0x06,0x30,0x0a,0xc8,0x05,0x90,0x08,0x06,0x18,0x30,0x0a,0x01,0x20,
- 0x10,0x88,0x00,0x40,0x50,0x6a,0x00,0x80,0x11,0x19,0x00,0x00,0x52,0x0c,0x00,
- 0x00,0x1c,0xf9,0xff,0xff,0x5f,0x44,0x44,0x44,0x24,0x11,0x11,0x11,0x09,0x44,
- 0x44,0x44,0xa0,0x11,0x11,0x11,0x15,0x44,0x44,0x44,0x40,0x11,0x11,0x91,0x14,
- 0x44,0x44,0x04,0xa2,0x11,0x22,0xa2,0x08};
+++ /dev/null
-/* XPM */
-static char * icon-mail-reply_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ... ",
-" .XXX.. ",
-" .XXXXXX.. ",
-" ... .XXXXXXXX. ",
-" ..XXX.XX.XXXXXX. ",
-" ..XXXX.XXX.XXXXX. ",
-" ..XXXXXX.XX.XXXXX. ",
-" ..XXXXXXX.XX.XXXXXX. ",
-" .XXXXXXXX.XXX.XXXXX... ",
-" ..XX..XX.XX.XXXXXXXX.XXX.. ",
-" ...XXXXXXX.XX.XXXXX.XX..X. ",
-" .XX..XXXX.XXX.XXXXX...XXX. ",
-" .XXXX..XX.XX.XXXXX..XXXXX. ",
-" .XXXXXX...XXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXX.XX...X.XXXXXXXXX. ",
-" .XXXXX..XXXXXXXX..XXXXXXX. ",
-" .XXXX.XXXXXXXXXXXX.XXXXXX. ",
-" .XXX.XXXXXXXXXXXXXX.XXXXX. ",
-" .X..XXXXXXXXXXXXXXXX..XXX. ",
-" ..XXXXXXXXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x10,0x10,0x00,0x55,0x45,0x45,0x55,0x00,0x10,0x08,0x00,0xd4,0xff,0xff,
- 0x7f,0x82,0x03,0x00,0xf0,0xd0,0x0c,0x00,0x4c,0x82,0x30,0x00,0x43,0xd4,0xc0,
- 0xc0,0x40,0x80,0x80,0x33,0xc0,0xaa,0x60,0xcc,0x40,0xc0,0x10,0x00,0x41,0x95,
- 0x08,0x00,0x46,0xc0,0x06,0x00,0xd8,0xfe,0xff,0x0f,0x60,0x2c,0x00,0x0b,0x40,
- 0x35,0x10,0xfd,0x7f,0x2c,0x02,0x2b,0x49,0x35,0x40,0x4d,0x12,0xac,0x00,0x0b,
- 0xa0,0x35,0x00,0xad,0x0a,0x2c,0x24,0x09,0x90,0x2d,0x00,0x5d,0x25,0xf4,0xff,
- 0x0b,0x80,0xa6,0x55,0xad,0x2a,0x4c,0xaa,0x08,0x40,0xf5,0xff,0x5d,0x15,0x6c,
- 0x35,0x0b,0x20,0x66,0x37,0xab,0x4a,0x6c,0x2d,0x0d,0x00,0xb9,0x35,0x4b,0x55,
- 0xf4,0xff,0x1f,0x80,0x01,0x40,0x80,0x2a};
+++ /dev/null
-/* XPM */
-static char * icon-save-mail_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ........................ ",
-" ...XXXXXXXXXXXXXXXXXX... ",
-" .XX..XXXXXXXXXXXXXX..XX. ",
-" .XXXX..XXXXXXXXXX..XXXX. ",
-" .XXXXXX..XXXXXX..XXXXXX. ",
-" .XXXXXXX...XX..XXXXXXXX. ",
-" .XXXXX..XXX..XX..XXXXXX. ",
-" .XXXX.XXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXX..X. ",
-" ..................XXXXXXXXX.. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo............ ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo............oo. ",
-" .oooooooooooooooo. ",
-" .oooooooooooooooo. ",
-" .oo............oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x10,0x20,0x00,0xa3,0x66,0xab,0x76,0x14,0x11,0x04,0x02,0x41,0x04,0xa1,
- 0x48,0x14,0x51,0x1e,0x22,0x62,0xa6,0xa9,0x2a,0x0a,0x71,0x18,0xa0,0x40,0x18,
- 0xb6,0x0a,0x8a,0x06,0x17,0x50,0xb2,0x01,0x63,0x27,0x62,0x80,0x20,0x90,0x50,
- 0x00,0x40,0x25,0x4a,0x00,0x40,0x80,0xe2,0x00,0x80,0x36,0x12,0xe1,0x80,0x41,
- 0x84,0x9a,0x00,0x29,0x10,0x87,0x01,0x85,0xa6,0x61,0x01,0x32,0x62,0x70,0x01,
- 0x42,0x18,0x30,0x02,0x14,0x06,0x08,0x02,0x4c,0x06,0x00,0x02,0x28,0x04,0x00,
- 0x04,0xac,0xca,0x07,0x7c,0x0b,0x68,0x0d,0xea,0x20,0x1b,0x12,0x93,0x6b,0xb4,
- 0x54,0x29,0x03,0x91,0xba,0x95,0x51,0x74,0x19,0x53,0x0b,0x6a,0x0a,0xd6,0x62,
- 0xe0,0x07,0x7c,0x09,0x8a,0x00,0x80,0x42};
+++ /dev/null
-/* XPM */
-static char * icon-next-unread_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXXX. ",
-" .X..XX.XXXXXXXX. ",
-" ..XXXX..XXXXXXX. ",
-" . ..XXXX..X.XXXXXXXX. . ",
-" ..XXXXX...X.XXXXXXXX. ",
-" ..XXXXXXX..XXX.XXXXXXXX. ",
-" .XXXXXXXX.XXXXX.XXXXXXXX. ",
-" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX.XXXXXXX.. ",
-" .XX.....XXXXXXX.....X.. ",
-" .X.ooooo.XXXXX.oooo.. ",
-" . .oXooooo.XXX.oXooooo.. . ",
-" .ooooooo.X.X.ooooooo. ",
-" .ooooooo..X..ooooooo. ",
-" ..oooooo.XXX.ooooooo. ",
-" . ..oooo.XXXXX.oooo.. . . ",
-" .....XXXXXXX..... ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x10,0x10,0x01,0x6b,0xa7,0x66,0x72,0x04,0x10,0x02,0x05,0xa1,0x8a,0x50,
- 0x48,0x04,0x20,0x8f,0x20,0x72,0xab,0x39,0x2b,0x02,0x64,0x58,0xa4,0x50,0x19,
- 0x16,0x01,0x0a,0x06,0x57,0x54,0xe2,0x01,0x23,0x23,0x72,0x80,0x20,0x94,0x44,
- 0x00,0x40,0x01,0x50,0x00,0xc0,0x54,0xa6,0x00,0x80,0x22,0x92,0x00,0x80,0x4a,
- 0x40,0x01,0x00,0x11,0x8a,0x01,0x00,0x45,0x32,0x02,0x00,0x2a,0x42,0x02,0x00,
- 0xa2,0x10,0x05,0x00,0x0c,0x4a,0x06,0x00,0x24,0x22,0x0a,0x00,0x68,0xaa,0x0c,
- 0x00,0x0c,0x00,0x11,0x80,0x53,0x2a,0x14,0x40,0x05,0x22,0x23,0x70,0x62,0x92,
- 0x34,0x0e,0x09,0x24,0xc0,0x4b,0x52,0x80,0x0a,0x21,0x80,0x6b,0x62,0xaa,0x36,
- 0x04,0x15,0x01,0x42,0x51,0x80,0xa8,0x28};
+++ /dev/null
-/* XPM */
-static char * icon-post_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . . .XXXXXXXXXXXXXXX. . ",
-" .XXXXXXXXXXXXXX.. ",
-" .XXXXXXXXXX... ",
-" .XXXXXXXXX. ",
-" . . . .XXXXXX.. . . ",
-" .XXX... ",
-" .... ",
-" ",
-" . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x08,0x40,0x20,0x23,0x63,0x2b,0x2b,0x54,0x14,0x24,0xa4,0x01,0x02,0x09,
- 0x01,0x54,0xa9,0x2e,0x2a,0x22,0xa2,0xa9,0x62,0x4a,0x6a,0x18,0x12,0x90,0x18,
- 0xb6,0x04,0x02,0x06,0x17,0x50,0xea,0x01,0x63,0x2b,0x64,0x80,0x20,0x44,0x51,
- 0x00,0x40,0x21,0x44,0x00,0x40,0x8a,0xe2,0x00,0xc0,0x22,0x0a,0xe1,0xc0,0x2f,
- 0xd0,0x9f,0x20,0x4d,0x42,0x87,0xb1,0x1a,0xea,0x61,0x15,0x72,0x60,0x70,0xbb,
- 0x14,0x1d,0x30,0xb1,0x5a,0x04,0x08,0x22,0x0d,0x06,0x00,0xc2,0x6f,0x06,0x00,
- 0x84,0x20,0x08,0x00,0x64,0x0a,0x0a,0x00,0x58,0x50,0x12,0x00,0x10,0x27,0x1a,
- 0x00,0x50,0x90,0x20,0x00,0xa0,0x24,0x32,0x00,0x20,0x82,0x26,0x00,0xc0,0x32,
- 0x40,0x00,0x40,0x44,0xaa,0x00,0x80,0x11};
+++ /dev/null
-/* XPM */
-static char * icon-prev-unread_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXX..... ",
-" ...o..XX.XXXXX.oooo.. ",
-" .oo..XXXX..XXX.oXooooo. ",
-" . .o..XXXX..X.X.X.ooooooo.. ",
-" ..XXXXX...X..X..ooooooo. ",
-" ..XXXXXXX..XX.XXX.ooooooo. ",
-" .XXXXXXXX.XXXXX.XXX.oooo.. ",
-" ..XXXXXXXXXXXXXX.XXXX..... . ",
-" .XXXXXXXXXXXXXXX.XXXX. ",
-" .XXXXXXXXXXXXXX.XX.. ",
-" .XXXXXXXXXXXXXXX.. ",
-" . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . .XXXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x10,0x00,0x11,0x88,0x45,0x55,0x84,0x22,0x08,0x80,0x10,0x88,0x42,0x55,0xa4,
- 0x22,0x28,0x00,0x01,0x84,0x05,0x55,0x5a,0x21,0x50,0x00,0x35,0x8a,0x09,0xf5,
- 0xc2,0x20,0x24,0x18,0x81,0x85,0x01,0x87,0x00,0x2a,0xd4,0x41,0x00,0x43,0x61,
- 0x40,0x80,0x17,0x1c,0x20,0x80,0x58,0xb5,0x1a,0xc0,0x3f,0x0c,0x08,0x60,0xb0,
- 0x75,0x08,0xb0,0x2e,0x84,0x04,0xb8,0xa1,0x06,0x03,0x4c,0x20,0x04,0x0c,0x36,
- 0x60,0x06,0x10,0x0f,0x20,0x06,0x70,0x07,0x60,0x05,0xc8,0x09,0xa0,0x04,0x04,
- 0x10,0xa0,0x06,0x02,0x20,0x60,0x85,0x01,0xc0,0xa0,0x44,0x00,0x00,0x61,0x25,
- 0x00,0x00,0x22,0x1e,0x00,0x00,0xbc,0x0e,0x00,0x00,0x70,0xfd,0xff,0xff,0x3f,
- 0x94,0x52,0x55,0x55,0x4a,0x29,0x22,0xa2};
+++ /dev/null
-/* XPM */
-static char * icon-follow-up_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . ",
-" .X.. ",
-" ... .XXXX. ",
-" ..XXX.XXXXXX.. ",
-" ..XXXX.XXXXXXXXX. ",
-" ..XXXXX.XXXXXXXXX.. ",
-" ..XXXXXXX.XXXXXXXX.... ",
-" ..XXXXXXXX.XXXXXXXXX.oXX.. ",
-" .X..X.X.X..XXXXXXXXX..o...o. ",
-" ..XXXXXXX.XXXXXXXXX..ooXXX.. ",
-" .X...XXXX.XXXXXXXX..ooX...X. ",
-" .XXXX.XX.XXXXXXXX..oX..XXXX. ",
-" .XXXXX..XXXXXXXX..oX.XXXXXX. ",
-" .XXXXXXX..XXXXX..X..XXXXXXX. ",
-"oo.XXXXXXXXX.XXX....XXXXXXXXX.oo",
-"oo.XXXXXXXXX...X...XXXXXXXXXX.oo",
-"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo",
-"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo",
-"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo",
-"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo",
-"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo",
-"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo",
-"oo...XXXXXXXXXXXXXXXXXXXXX....oo",
-"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo",
-"oo............................oo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x08,0x00,0x20,0xaa,0x82,0xaa,0x4a,0x00,0x54,0x00,0x00,0xaa,0x02,0x54,
- 0x55,0x00,0xa8,0x07,0x00,0x54,0x85,0x5a,0x55,0x02,0x50,0x32,0x80,0x50,0x25,
- 0xc2,0x2a,0x02,0x18,0x81,0x41,0x54,0x17,0x01,0x17,0x80,0x09,0xc1,0x23,0x75,
- 0x04,0x3d,0x4f,0x18,0xc3,0x83,0x18,0x85,0x40,0xc0,0x61,0x4c,0x7c,0x60,0x30,
- 0xf6,0x23,0xb0,0x6e,0x84,0x20,0x98,0x21,0x05,0x13,0x5c,0x20,0x04,0x1c,0x36,
- 0x60,0x06,0x30,0x0f,0x60,0x06,0x70,0x07,0xa0,0x05,0xc8,0x09,0x20,0x06,0x04,
- 0x10,0x60,0x04,0x02,0x20,0xa0,0x85,0x01,0xc0,0x20,0x46,0x00,0x00,0xa1,0x24,
- 0x00,0x00,0x62,0x1e,0x00,0x00,0x7c,0x0d,0x00,0x00,0xb0,0xfc,0xff,0xff,0x3f,
- 0x55,0x55,0x4a,0x55,0x24,0x89,0x52,0xa2};
+++ /dev/null
-/* XPM */
-static char * icon-follow-up-incl_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ... ",
-" .X.X. ",
-" .XX.XX.. ",
-" .XXX.XXXX. ",
-" ..XXX.XXXXXX.. ",
-" ..X.XXX.XXXXXXX.. ",
-" ..XX.XXXX.XXXXX.... ",
-" ..XXX.XXXXX.X....XX... ",
-" ..XXX..XXXX....XXXXX.oXX.. ",
-" .XXXX.XXXXXX.XXXXXXX..oXXXo. ",
-" ..XX.XXX.....XXXXXX..ooXXX.. ",
-" .X......XXX.XXXXXX..ooX...X. ",
-" .XXXX.XXXXX.XXXXX..oX..XXXX. ",
-" .XXXXX..XX.XXXXX..oX.XXXXXX. ",
-" .XXXXXXX...XXXX..X..XXXXXXX. ",
-"oo.XXXXXXXXX..XX....XXXXXXXXX.oo",
-"oo.XXXXXXXXX...X...XXXXXXXXXX.oo",
-"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo",
-"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo",
-"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo",
-"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo",
-"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo",
-"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo",
-"oo...XXXXXXXXXXXXXXXXXXXXX....oo",
-"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo",
-"oo............................oo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x20,0x08,0x08,0x82,0x8a,0x82,0xa2,0x20,0x20,0x14,0x04,0x15,0x14,0xfd,0xff,
- 0x43,0x42,0x04,0x00,0x0d,0x10,0x05,0x00,0x49,0x22,0x06,0x00,0x31,0x88,0x04,
- 0x00,0x1f,0x22,0x06,0x00,0x50,0x88,0x04,0x00,0x10,0x22,0x04,0x00,0xb0,0x88,
- 0x06,0x00,0x10,0x22,0x04,0x00,0x50,0xfc,0xff,0x0f,0x10,0x36,0x00,0x0b,0xb0,
- 0x2c,0x02,0x0d,0x10,0x34,0x10,0x0b,0x50,0x2d,0x00,0x0b,0x10,0x34,0x41,0x0d,
- 0xb0,0x2d,0x08,0x09,0x10,0x34,0x00,0x0b,0x50,0x2d,0x01,0x0d,0x10,0xf4,0xff,
- 0x0b,0xb0,0xad,0xda,0x0a,0x10,0x44,0x22,0x0d,0x50,0xf6,0xff,0xf9,0x1f,0x6c,
- 0x3b,0x4b,0x52,0xb5,0x2d,0x1d,0x08,0x6c,0x35,0x4b,0xa1,0x6a,0x3b,0x29,0x14,
- 0xf8,0xff,0x8f,0x40,0x02,0x40,0x2a,0x15};
+++ /dev/null
-/* XPM */
-static char * icon-save-text_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXX.X. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XXX. ",
-" .XXXXXXXXXXXXX..... ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" ..................XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo............oo.XXXXXXXX. ",
-" .oooooooooooooooo.XXXXXXXX. ",
-" .oooooooooooooooo.XXXXXXXX. ",
-" .oo............oo.......... ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x10,0x81,0x04,0x01,0x45,0x28,0x40,0x50,0x88,0x42,0x15,0x05,0xa2,0xff,0xff,
- 0x7f,0x88,0x03,0x00,0xf0,0xa2,0x0c,0x00,0x4c,0x88,0x30,0x00,0x43,0xc5,0xc0,
- 0xc0,0x40,0x90,0x80,0x33,0xc0,0xa4,0x60,0xcc,0x40,0x82,0x10,0x00,0x41,0xd0,
- 0x08,0x00,0x46,0x82,0x06,0x00,0xd8,0xfc,0xff,0x0f,0x60,0x2e,0x00,0x0d,0x40,
- 0x34,0x02,0xfb,0x7f,0x36,0x10,0x0d,0x91,0xac,0x00,0x4b,0x24,0x34,0x00,0x2d,
- 0x81,0x2d,0x48,0x4b,0x28,0x34,0x02,0x0d,0x85,0x2d,0x00,0xab,0x20,0xf4,0xff,
- 0x0d,0x8a,0xa6,0xaa,0xaa,0x20,0x4c,0x55,0x0a,0x85,0xf5,0xff,0x5b,0x20,0x6c,
- 0x35,0x8d,0x8a,0xad,0x36,0x2b,0x20,0xf4,0x2a,0x89,0x8a,0x6a,0x3b,0x5d,0x20,
- 0xf8,0xff,0x0f,0x85,0x02,0x40,0xa2,0x20};
+++ /dev/null
-/* XPM */
-static char * icon-save-mail_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ........................ ",
-" ...XXXXXXXXXXXXXXXXXX... ",
-" .XX..XXXXXXXXXXXXXX..XX. ",
-" .XXXX..XXXXXXXXXX..XXXX. ",
-" .XXXXXX..XXXXXX..XXXXXX. ",
-" .XXXXXXX...XX..XXXXXXXX. ",
-" .XXXXX..XXX..XX..XXXXXX. ",
-" .XXXX.XXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXX..X. ",
-" ..................XXXXXXXXX.. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo............ ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo............oo. ",
-" .oooooooooooooooo. ",
-" .oooooooooooooooo. ",
-" .oo............oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x00,0x08,0x10,0x01,0xaa,0x42,0x45,0x54,0x00,0x14,0x10,0x01,0x55,0x41,0x45,
- 0x50,0x00,0x0a,0x88,0x0a,0xaa,0xa0,0x22,0x40,0x80,0xff,0xff,0x17,0xaa,0x95,
- 0x54,0x43,0x80,0x2a,0xa5,0x0a,0xaa,0xfd,0x7f,0x53,0xc0,0x06,0x40,0x06,0x94,
- 0x04,0x40,0x43,0xc2,0x05,0xc0,0x2a,0x90,0x86,0xc0,0x06,0xa2,0x64,0x4b,0x53,
- 0x88,0x96,0x44,0x06,0xd2,0x45,0xc0,0x52,0x84,0x25,0xc1,0x06,0x90,0xe6,0x41,
- 0x53,0x8a,0x05,0x42,0x06,0xa0,0x06,0xc4,0x52,0x95,0x04,0xc0,0x06,0xc0,0x05,
- 0x40,0x53,0x94,0x06,0x40,0x06,0xa2,0x05,0xc0,0x52,0x88,0xfc,0xff,0x06,0xa2,
- 0x95,0x12,0x53,0x88,0x4a,0xa9,0x06,0xa2,0xff,0xff,0x53,0x90,0x10,0x00,0x04,
- 0x42,0x42,0x55,0x50,0x14,0x28,0x80,0x0a};
+++ /dev/null
-/* XPM */
-static char * icon-decode-view_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ................... ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XX.............XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.oooo.oooooo.XX. ",
-" .XX.oo..o..o.oo.XX. ",
-" .XX.o.oo.oo.ooo.XX. ",
-" .XX.ooo.ooooooo.XX. ",
-" .XX.oo.oo.ooooo.XX. ",
-" .XX.oo....ooooo.XX. ",
-" .XX.oooooo.oooo.XX. ",
-" .XX.ooooooo.ooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.............XX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" ................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x11,0x11,0x19,0x51,0x4a,0x95,0x82,0x14,0x20,0x40,0x29,0x42,0x0a,0xd5,0x86,
- 0x10,0x31,0x31,0x3b,0x53,0x08,0x9d,0xe8,0x10,0xa2,0x43,0x82,0x4b,0x88,0xff,
- 0xff,0x03,0xb3,0xaa,0x54,0xbb,0x88,0x55,0xaa,0x02,0xa2,0xfc,0x7f,0x4b,0x88,
- 0x06,0xc0,0x12,0xb1,0x05,0x40,0x56,0x8a,0x05,0x40,0x03,0xd0,0x86,0xc0,0xaa,
- 0x85,0x64,0x4b,0x06,0xb1,0x95,0xc4,0x32,0x8a,0x46,0x40,0x4b,0xd0,0x24,0x41,
- 0x03,0x84,0xe6,0xc1,0x56,0xd9,0x05,0x42,0x12,0x82,0x04,0x44,0x4b,0x94,0x07,
- 0xc0,0x22,0xc1,0x04,0x40,0x16,0x95,0x05,0xc0,0x52,0xa0,0x06,0x40,0x13,0x8a,
- 0xfd,0xff,0x46,0xd0,0x94,0x52,0x12,0x93,0x29,0xa5,0x5a,0xa4,0xff,0xff,0x03,
- 0x10,0x02,0x08,0x55,0x85,0xa8,0xa2,0x00};
+++ /dev/null
-/* XPM */
-static char * icon-post-pic_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................ ...............",
-".............. . .............",
-" ... ... ... .. .. ... ... ...",
-".......... ......... .........",
-"........ ............. .......",
-"....... ......",
-" ... .. XXXXXXXXXXXXXXXXX .. ...",
-"....... XXXXXXXXXXXXXXXXX ......",
-"....... XX XX ......",
-"....... XX ooooooooooo XX ......",
-" ... .. XX ooooooooooo XX .. ...",
-"....... XX ooooooooooo XX ......",
-"....... XX oooo oooooo XX ......",
-"....... XX oo o o oo XX ......",
-" ... .. XX o oo oo ooo XX .. ...",
-"....... XX ooo ooooooo XX ......",
-"....... XX oo oo ooooo XX ......",
-"....... XX oo ooooo XX ......",
-" ... .. XX oooooo oooo XX .. ...",
-"....... XX ooooooo ooo XX ......",
-"....... XX ooooooooooo XX ......",
-"....... XX ooooooooooo XX ......",
-" ... .. XX ooooooooooo XX .. ...",
-"....... XX ooooooooooo XX ......",
-"....... XX XX ......",
-"....... XXXXXXXXXXXXXXXXX ......",
-" ... .. XXXXXXXXXXXXXXXXX .. ...",
-"....... ......",
-"................................",
-"................................"};
+++ /dev/null
-#define noname_width 271
-#define noname_height 273
-static char noname_bits[] = {
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x49,0xe0,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x97,0xaa,0x8a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x57,0x2a,0x41,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0x52,0x16,0xfe,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0x49,0x05,
- 0xf9,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0x95,0xaa,0x58,0xf4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xa5,0x54,0x26,0xe1,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x54,0x49,0x49,0xe4,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x2a,0xa5,
- 0x2a,0xd1,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xaf,0x52,0x95,0x54,0xc4,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,
- 0x24,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x57,0x29,0xa9,0x92,0x11,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x57,0xd5,0xfa,0xff,0xff,0xab,0xea,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x4a,0x55,0x2a,0x41,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x25,0x29,0xe5,0xff,0xff,0x95,0xa4,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0xa4,
- 0x24,0xa5,0x14,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4a,0xa5,0xd4,0xff,
- 0x3f,0x52,0xa9,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x29,0x55,0x55,0x55,0x41,0x7e,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xa9,0x54,0xea,0xff,0xdf,0x2a,0x55,0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x4a,0x49,0x12,0x7e,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0x55,0xa5,0x92,0xff,0x23,0xa5,0x4a,0xd6,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5,0xa4,0x94,0xaa,0x42,
- 0x7d,0xff,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0x2a,0xa9,0xff,0xad,0x92,0x24,
- 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a,
- 0x95,0x52,0x52,0x29,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x52,0x49,0x55,
- 0xfe,0x91,0x54,0x55,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0x49,0x29,0x55,0x25,0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x4f,0x95,0xaa,0x92,0x7e,0x55,0x55,0xa9,0x4a,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2a,0x50,0x95,0xaa,0x24,0x7e,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x57,0x2a,0x95,0x54,0x79,0x95,0x92,0x92,0x94,0xfc,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb9,0x62,0x29,0x49,
- 0x85,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x49,0x49,0x95,0xba,0xa4,0x54,
- 0xaa,0x52,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,
- 0x1a,0xf8,0xa7,0xaa,0x22,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0x55,0x52,
- 0x2a,0x75,0x55,0xa5,0x24,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xbf,0x5a,0xfd,0x57,0x92,0x94,0x7e,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x4a,0x4a,0x55,0x49,0x89,0x92,0x94,0xaa,0x94,0xf4,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xfc,0x2f,0x55,0x05,0x7c,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x55,0xa9,0x4a,0x55,0x2a,0x55,0x55,0x55,0x55,0xe5,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x4e,0xfd,0x5f,
- 0x29,0xa5,0x7c,0xff,0xff,0xff,0xff,0xff,0xff,0xa4,0x54,0x52,0x4a,0x55,0xa9,
- 0xa4,0x24,0xa5,0x94,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x2f,0x1d,0xfe,0x3f,0x95,0x04,0x7c,0xff,0xfd,0xff,0xff,0xff,0x3f,0x49,0xa5,
- 0x54,0xa9,0xa4,0x92,0x4a,0x49,0x4a,0x55,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xaf,0x44,0xfe,0x5f,0xa9,0x52,0x7d,0xff,0xe5,0xff,0xff,
- 0xff,0x5f,0x55,0x92,0x2a,0x95,0x52,0x4a,0x52,0xaa,0x52,0x4a,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x16,0xff,0xbf,0x4a,0x05,0x7c,
- 0xff,0xd9,0xff,0xff,0xff,0x5f,0x95,0x42,0xa5,0x52,0x95,0xaa,0xaa,0xaa,0x94,
- 0x54,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x43,0xfe,
- 0xbf,0x54,0x52,0x7d,0x7f,0x25,0xff,0xff,0xff,0xa7,0xa4,0x28,0x92,0x54,0x4a,
- 0xa5,0x4a,0x92,0xaa,0x4a,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xab,0x12,0xfe,0x7f,0xa5,0x02,0x7c,0x7f,0x55,0xfd,0xff,0xff,0x95,0x2a,
- 0x82,0x54,0xa5,0x54,0x2a,0xa9,0x2a,0xa5,0x52,0xf5,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x27,0x4b,0xff,0xff,0x4a,0x29,0x7d,0xff,0x92,0xfe,
- 0xff,0xff,0x55,0x92,0x20,0xa8,0x94,0x2a,0xa5,0x94,0x52,0x29,0xa9,0xf4,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,0x01,0xff,0x7f,0x52,0x42,
- 0x7c,0xff,0x25,0xf9,0xff,0x7f,0xaa,0x02,0x8a,0x40,0x29,0x49,0x09,0x41,0x4a,
- 0x55,0x25,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57,
- 0xff,0xff,0x95,0x12,0x7d,0xff,0xa9,0xfa,0xff,0x7f,0x25,0xa9,0x20,0x2a,0xa5,
- 0xaa,0x42,0x92,0x54,0x92,0x54,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xaf,0x83,0xff,0xff,0xa9,0x42,0x7e,0xff,0xaa,0xf4,0xff,0xaf,0x54,
- 0x01,0x82,0x80,0xaa,0x54,0x14,0x08,0xa2,0xaa,0x4a,0xd2,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xef,0xcf,0xd7,0xff,0xff,0x52,0x12,0x7f,0xff,0x4a,
- 0xea,0xff,0x57,0x92,0xaa,0x28,0x24,0x29,0x25,0x81,0x82,0x08,0x49,0x52,0x55,
- 0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xdf,0xef,0xe7,0xff,0xff,0x2a,
- 0x05,0x7e,0xff,0x55,0xd5,0xff,0xa5,0x2a,0x00,0x8e,0x10,0x4a,0x89,0x24,0x28,
- 0xa0,0xaa,0x2a,0x49,0xff,0xff,0xff,0xff,0xbf,0xff,0xff,0xff,0xff,0xe7,0xff,
- 0xef,0xff,0xff,0xa5,0x50,0x7e,0xff,0x25,0xe5,0xff,0x2a,0xa5,0x52,0x7f,0x85,
- 0x54,0x35,0x08,0x82,0x0a,0x55,0x95,0xaa,0xfc,0xff,0xff,0xff,0xcf,0xff,0xff,
- 0xff,0xff,0xd7,0xff,0xff,0xff,0x7f,0x52,0x85,0x7e,0xff,0xab,0x94,0x1e,0x55,
- 0x2a,0xc8,0xff,0x10,0x90,0x92,0xa0,0x08,0x20,0x24,0x52,0x25,0xfd,0xff,0xff,
- 0xff,0xef,0xff,0xff,0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0x94,0x10,0x7e,0xff,
- 0x93,0xaa,0x6a,0x49,0x49,0xf2,0xff,0x85,0x52,0x09,0x0a,0xa2,0x4a,0x92,0x29,
- 0xa9,0xf2,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0x7f,
- 0x55,0x25,0x7f,0xff,0x55,0x49,0x49,0x95,0x0a,0xf9,0xff,0x17,0x48,0x26,0x50,
- 0x08,0x00,0xa9,0x4a,0x95,0xfa,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xf2,
- 0xff,0xff,0xff,0xff,0x92,0x80,0x7e,0xff,0xa7,0x54,0xaa,0xa4,0x52,0xfc,0xff,
- 0xaf,0x42,0x89,0xfa,0xbf,0x54,0x20,0xa9,0xa4,0xd4,0xff,0xff,0xff,0xcb,0xff,
- 0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff,0x54,0x29,0x7f,0xff,0x4b,0xa5,0x92,
- 0x2a,0x01,0xff,0xff,0x1f,0xa8,0x22,0xff,0xff,0x01,0xa5,0x2a,0x55,0xa9,0xff,
- 0xff,0xff,0xd4,0xff,0xff,0xff,0x7f,0xfa,0xff,0xff,0xff,0x7f,0xa5,0x04,0x7f,
- 0xff,0x57,0x2a,0x55,0xa9,0x54,0xfe,0xff,0x3f,0x05,0x89,0xff,0xff,0x5f,0x48,
- 0x92,0x2a,0x95,0xff,0xff,0xff,0xea,0xff,0xff,0xff,0xff,0xd2,0xff,0xff,0xff,
- 0x7f,0x2a,0x91,0x7f,0xff,0xa9,0x54,0x4a,0x52,0x02,0xff,0xff,0xff,0x50,0xd1,
- 0xff,0xff,0x1f,0x81,0xaa,0xa4,0x52,0xfe,0xff,0x3f,0xe9,0xff,0xff,0xff,0x7f,
- 0x1d,0xff,0xff,0xff,0xff,0x54,0x41,0x7f,0xff,0x93,0x92,0x52,0x95,0xc8,0xff,
- 0xff,0xff,0x8b,0xc4,0xff,0xff,0x7f,0x24,0xa5,0x2a,0x49,0xf9,0xff,0x7f,0xd5,
- 0xff,0xff,0xff,0xbf,0x4a,0xff,0xff,0xff,0xff,0x4a,0x14,0x7f,0xff,0x28,0xa5,
- 0x94,0x2a,0xa0,0xff,0xff,0x7f,0x22,0xf0,0xff,0xff,0x7f,0x12,0x94,0xa4,0xaa,
- 0xea,0xff,0xaf,0xea,0xff,0xff,0xff,0x5f,0x8e,0xff,0xff,0xff,0x7f,0xa9,0x40,
- 0x7f,0xff,0x48,0x55,0x55,0x12,0xca,0xff,0xff,0xff,0x0a,0xf5,0xff,0xff,0xff,
- 0x80,0x52,0x95,0x54,0xaa,0xfe,0x55,0xc4,0xff,0xff,0xff,0x5f,0xa5,0xff,0xff,
- 0xff,0xff,0x94,0x14,0x7f,0xff,0x52,0x2a,0xa9,0x4a,0xe1,0xff,0xff,0xbf,0x24,
- 0xf0,0xff,0xff,0xff,0x0b,0x28,0xa9,0x92,0x24,0x55,0x49,0xe5,0xd7,0xff,0xff,
- 0xa7,0x8a,0xff,0xff,0xff,0x7f,0xa5,0xc0,0x7f,0xff,0x50,0x49,0x95,0x04,0xf8,
- 0xff,0xff,0x5f,0x1f,0xfd,0xff,0xff,0xff,0x47,0x45,0x55,0xaa,0xaa,0x4a,0xaa,
- 0xea,0xaf,0xff,0xff,0x2b,0xc3,0xff,0xff,0xff,0x7f,0x55,0x94,0x7f,0x7f,0x4a,
- 0x55,0x52,0x51,0xfe,0xff,0xff,0x5f,0x4e,0xf8,0xff,0xff,0xff,0x1f,0x50,0x92,
- 0x52,0x49,0xa9,0x92,0xe4,0xd3,0xff,0xff,0x4b,0xd5,0xff,0xff,0xff,0xff,0x94,
- 0xc0,0x7f,0x3f,0xa0,0xa4,0xaa,0x04,0xfe,0xff,0xff,0xa7,0x1d,0xfd,0xff,0xff,
- 0xff,0x9f,0x84,0xaa,0x4a,0xaa,0x24,0x55,0xf2,0x2b,0xff,0x7f,0xa9,0xc1,0xff,
- 0xff,0xff,0x7f,0x4a,0x95,0x7f,0xbf,0x2a,0x95,0x24,0x50,0xff,0xff,0xff,0x97,
- 0x5e,0xfe,0xff,0xff,0xff,0x3f,0x92,0x24,0x95,0x92,0xaa,0xa4,0xf2,0xcb,0xff,
- 0x5f,0xd5,0xe5,0xff,0xff,0xff,0xff,0x52,0x80,0x7f,0x3f,0xa0,0x52,0x15,0x85,
- 0xff,0xff,0xff,0xd7,0x38,0xfe,0xff,0xff,0xff,0xff,0x20,0xaa,0x52,0x55,0x55,
- 0x55,0xf9,0x29,0xfd,0xab,0xa4,0xf0,0xff,0xff,0xff,0x7f,0x29,0xa9,0x7f,0xff,
- 0x42,0x25,0x49,0xe8,0xff,0xff,0xff,0x69,0x7a,0xff,0xff,0xff,0xff,0xff,0x82,
- 0x52,0xaa,0x24,0x89,0x4a,0xf8,0x55,0x2a,0x49,0x95,0xf5,0xff,0xff,0xff,0xbf,
- 0x2a,0xc4,0x7f,0x7f,0x90,0x54,0x15,0xe2,0xff,0xff,0xff,0x25,0xbc,0xff,0xff,
- 0xff,0xff,0xff,0x29,0x48,0x49,0xaa,0xaa,0xa4,0xfa,0x95,0x92,0x54,0x52,0xf0,
- 0xff,0xff,0xff,0xbf,0x4a,0xd1,0x7f,0xff,0x05,0xaa,0x40,0xf8,0xff,0xff,0x7f,
- 0xaa,0xfc,0xff,0xff,0xff,0xff,0xff,0x43,0xa9,0xaa,0x4a,0x52,0xa9,0xf8,0xa4,
- 0xaa,0x52,0x95,0xfc,0xff,0xff,0xff,0x7f,0x52,0xc0,0x7f,0xff,0xa1,0x00,0x24,
- 0xfa,0xff,0xff,0xff,0x0a,0xfe,0xff,0xff,0xff,0xff,0xff,0x17,0x92,0x24,0xa5,
- 0x2a,0x55,0xfe,0xaa,0xa4,0x2a,0x29,0xf9,0xff,0xff,0xff,0xbf,0x2a,0xea,0x7f,
- 0xff,0x05,0x92,0x90,0xfc,0xff,0xff,0xbf,0xa4,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x4f,0xa0,0xaa,0x54,0x49,0x25,0x7c,0x49,0x95,0xa4,0x12,0xfc,0xff,0xff,0xff,
- 0x7f,0x8a,0xe0,0x7f,0xff,0xa3,0x04,0x05,0xfe,0xff,0xff,0xbf,0x06,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x1f,0x49,0x95,0x52,0xaa,0x12,0x7f,0x55,0x52,0x55,0x0a,
- 0xfd,0xff,0xff,0xff,0x3f,0x29,0xe8,0x7f,0xff,0x0f,0x50,0x50,0xff,0xff,0xff,
- 0x5f,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x04,0xa9,0x4a,0x25,0x45,0x3e,
- 0xa9,0x2a,0xa9,0xa2,0xfc,0xff,0xff,0xff,0x7f,0x55,0xe1,0x7f,0xff,0x27,0x05,
- 0xc4,0xff,0xff,0xff,0x9f,0x91,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x41,0x4a,
- 0x29,0xa9,0x12,0x5e,0x95,0x94,0x4a,0x0a,0xfe,0xff,0xff,0xff,0xbf,0x12,0xf4,
- 0x7f,0xff,0x8f,0x50,0xf1,0xff,0xff,0xff,0xa7,0xc2,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x14,0x92,0xaa,0x4a,0xa2,0xbf,0xa4,0x52,0x95,0x22,0xff,0xff,0xff,
- 0xff,0x3f,0x45,0xf2,0x7f,0xff,0x3f,0x04,0xf4,0xff,0xff,0xff,0xd7,0xe8,0xff,
- 0xff,0xff,0xff,0x5f,0xff,0xff,0x83,0xa8,0x94,0x54,0x09,0x2f,0x55,0x4a,0x52,
- 0x49,0xff,0xff,0xff,0xff,0x5f,0x99,0xf0,0x7f,0xff,0x7f,0x51,0xfc,0xff,0xff,
- 0xff,0x6b,0xf1,0xff,0xff,0xff,0xff,0x5f,0xfd,0xff,0x2b,0x2a,0xa9,0x12,0x20,
- 0x5f,0xa9,0xaa,0x54,0x00,0xff,0xff,0xff,0xff,0x5f,0x15,0xf2,0x7f,0xff,0xff,
- 0x8f,0xff,0xff,0xff,0xff,0x2b,0xfc,0xff,0xff,0xff,0xff,0x2f,0xfd,0xff,0x87,
- 0xa0,0x4a,0xaa,0x8a,0x9f,0x4a,0x52,0x15,0xa9,0xff,0xff,0xff,0xff,0x5f,0x8a,
- 0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xf8,0xff,0xff,0xff,0xff,
- 0x57,0xf2,0xff,0x2f,0x82,0x52,0x05,0xd0,0x2f,0x95,0x4a,0x49,0x84,0xff,0xff,
- 0xff,0xff,0xbf,0x24,0xf8,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x12,0xfd,
- 0xff,0xff,0xff,0xff,0x4b,0xd5,0xff,0x9f,0x28,0x54,0x48,0xc5,0xbf,0x52,0x55,
- 0x0a,0xe1,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfa,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x1a,0xfe,0xff,0xff,0xff,0xff,0x57,0xa9,0xff,0x3f,0x82,0x00,0x21,
- 0xf0,0x5f,0x2a,0x49,0x21,0xc4,0xff,0xff,0xff,0xff,0xaf,0x1a,0xfd,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x3f,0x85,0xff,0xff,0xff,0xff,0xff,0x29,0xa5,0xff,
- 0xff,0x24,0x52,0x88,0xfc,0xbf,0x92,0x2a,0x09,0xf1,0xff,0xff,0xff,0xff,0x9f,
- 0x4c,0xfc,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x15,0xff,0xff,0xff,0x7f,
- 0xff,0xa5,0x4a,0xff,0xff,0x90,0x08,0x01,0xfe,0x3f,0x55,0x52,0x24,0xf4,0xff,
- 0xff,0xff,0xff,0xaf,0x02,0xfd,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xc6,
- 0xff,0xff,0xff,0xbf,0xfe,0x95,0x54,0xff,0xff,0x05,0x42,0xa8,0xfe,0xbf,0xa4,
- 0x2a,0x41,0xf9,0xff,0xff,0xff,0xff,0x5f,0x55,0xfc,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x4f,0xd0,0xff,0xff,0xff,0xbf,0x7c,0xaa,0x92,0xfc,0xff,0x53,0x08,
- 0x01,0xff,0x1f,0x4a,0x01,0x04,0xfc,0xff,0xff,0xff,0xff,0x27,0x05,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xc5,0xff,0xff,0xff,0x4f,0xbf,0x52,0xaa,
- 0xfe,0xff,0x07,0x42,0xea,0xff,0xbf,0x50,0x54,0x51,0xff,0xff,0xff,0xff,0xff,
- 0x97,0x56,0xfe,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xf0,0xff,0xff,0xff,
- 0x2f,0x7f,0xa5,0x54,0xfd,0xff,0x3f,0x09,0xe0,0xff,0x1f,0x02,0x01,0x04,0xff,
- 0xff,0xff,0xff,0xff,0xaf,0x02,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,
- 0xf5,0xff,0xff,0xff,0xab,0x9f,0x94,0x92,0xfc,0xff,0xff,0x40,0xfd,0xff,0x9f,
- 0x48,0x48,0xa1,0xff,0xff,0xff,0xff,0xff,0xa7,0x56,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x6b,0xf8,0xff,0xff,0xff,0xa4,0x5f,0xa9,0x2a,0xfd,0xff,0xff,
- 0xff,0xff,0xff,0x3f,0x22,0x21,0xc4,0xff,0xff,0xff,0xff,0xff,0x2f,0x03,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0xfa,0xff,0xff,0x7f,0xd5,0x2f,0xa5,
- 0xa4,0xfa,0xff,0xff,0xff,0xff,0xff,0xbf,0x08,0x08,0xf9,0xff,0xff,0xff,0xff,
- 0xff,0x97,0x4a,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x94,0xfc,0xff,0xff,
- 0x7f,0x69,0xac,0x2a,0x55,0xf9,0xff,0xff,0xff,0xff,0xff,0x7f,0xa2,0x22,0xf8,
- 0xff,0xff,0xff,0xff,0xff,0x53,0x21,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x15,0xfe,0xff,0xff,0x9f,0x2a,0x95,0x94,0x92,0xf4,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x08,0x88,0xfe,0xff,0xff,0xff,0xff,0xff,0x57,0x8b,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xa9,0xfe,0xff,0xff,0x5f,0x52,0xbc,0x52,0x55,0xf5,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x21,0x21,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xa1,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x7f,0x0d,0xff,0xff,0xff,0x57,0x15,0x3f,
- 0x55,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xc8,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xd7,0x89,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xbf,0xd6,0xff,0xff,
- 0xff,0x4b,0x45,0x3f,0x49,0xaa,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,0xf9,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xc9,0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0x3f,0x81,0xff,0xff,0xff,0x29,0x11,0x5f,0x28,0x55,0xf5,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xc8,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0x5f,0xd6,0xff,0xff,0x7f,0xaa,0xc2,0x0f,0x55,0x49,0xea,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa5,
- 0xe2,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x9f,0xe1,0xff,0xff,0xbf,0x4a,0xd1,
- 0x5f,0x48,0xa5,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xe9,0xe0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x27,0xf4,0xff,
- 0xff,0xbf,0x94,0xc4,0x07,0x91,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xea,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xaf,0xf1,0xff,0xff,0x9f,0x52,0xe0,0x4b,0x44,0x52,0xe9,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x6a,0xe0,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xab,0x2a,0xf5,0x0f,0x51,0xa5,
- 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0x69,0xe5,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x55,0xf8,0xff,0xff,0x95,0x14,
- 0xf0,0x5f,0x84,0x54,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0x75,0xf0,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x13,0xfd,
- 0xff,0xff,0xa5,0x42,0xf9,0x7f,0x91,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xb2,0xfa,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0x54,0xfe,0xff,0x7f,0x52,0x12,0xfa,0xff,0x20,0xa5,0xe4,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x34,0xf8,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0x25,0xff,0xff,0xaf,0xaa,0x48,0xfc,0xff,0x0b,
- 0x29,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xb5,0xf8,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0x52,0xff,0xff,0x2f,0x49,
- 0x02,0xfe,0xff,0x43,0xaa,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x3f,0x3a,0xfa,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x4a,
- 0xff,0xff,0xa5,0x2a,0xa9,0xff,0xff,0x17,0x25,0xe9,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x9a,0xfc,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0x2a,0xff,0x7f,0x95,0x54,0x80,0xff,0xff,0x07,0xa9,0xea,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x1d,0xfc,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0x3f,0xa9,0xfe,0x7f,0xa9,0x12,0xe5,0xff,0xff,
- 0x5f,0x4a,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x5f,0xad,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x7f,0x95,0xea,0x97,0x54,
- 0x4a,0xf0,0xff,0xff,0x1f,0xa8,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x5f,0x0e,0xfe,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,
- 0x52,0x55,0xa9,0x92,0x02,0xfd,0xff,0xff,0x5f,0x53,0xf5,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x5e,0xfe,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xbf,0x2a,0x49,0x4a,0x55,0x49,0xfc,0xff,0xff,0x3f,0x94,0xf8,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x0f,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f,0xa5,0xaa,0x92,0xa4,0x20,0xff,0xff,
- 0xff,0xbf,0xa4,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x5f,0x57,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x52,0x52,0xaa,
- 0x2a,0x0a,0xff,0xff,0xff,0x7f,0x54,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x8f,0x07,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xa7,0x94,0x4a,0x55,0x4a,0xa0,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x57,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0x2f,0x55,0xa9,0x92,0x12,0xe9,0xff,0xff,0xff,0x7f,0x24,
- 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,
- 0x87,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0xa5,0x4a,0xaa,0x44,0xf4,0xff,
- 0xff,0xff,0xff,0x55,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xa7,0xab,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xab,0x94,0xa4,
- 0x92,0x12,0xf9,0xff,0xff,0xff,0xff,0xa8,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xab,0x83,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0x47,0xa9,0x2a,0x55,0x40,0xfc,0xff,0xff,0xff,0xff,0x25,0xf5,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff,0xff,0xd7,0x97,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0x33,0x55,0xa9,0x24,0x15,0xfe,0xff,0xff,0xff,0xff,
- 0x95,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff,
- 0x93,0xc3,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x25,0xa5,0x2a,0x40,0xff,
- 0xff,0xff,0xff,0xff,0xa9,0xf4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xff,
- 0xff,0xff,0xff,0xff,0xe7,0xd5,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4b,0x92,
- 0x54,0x92,0xd4,0xff,0xff,0xff,0xff,0xff,0x55,0xf5,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xe9,0xff,0xff,0xff,0xff,0xff,0xd5,0xc1,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0x97,0xaa,0x4a,0x05,0xe2,0xff,0xff,0xff,0xff,0xff,0x25,0xf1,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xe3,0xfd,0xff,0xff,0xff,0xff,0xd5,0xea,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0x57,0x55,0x25,0xa1,0xf0,0xff,0xff,0xff,0xff,
- 0xff,0x95,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe8,0xfa,0xff,0xff,0xff,
- 0xff,0xea,0xe0,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xa7,0x24,0x59,0x04,0xfa,
- 0xff,0xff,0xff,0xff,0xff,0xa9,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe2,
- 0xfd,0xff,0xff,0xff,0xff,0xc9,0xe9,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x4f,
- 0x52,0x05,0xa1,0xfc,0xff,0xff,0xff,0xff,0xff,0xa5,0xfa,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x70,0xf9,0xff,0xff,0xff,0xff,0x74,0xe2,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0x47,0x95,0x92,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0xf8,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xe2,0xfa,0xff,0xff,0xff,0xff,0x72,0xe8,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x97,0xaa,0x20,0xd0,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xb8,0xfc,0xff,0xff,
- 0xff,0xff,0xea,0xe2,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x07,0x04,0x82,0xc2,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x29,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0x71,0xfd,0xff,0xff,0xff,0x7f,0x2a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0x4f,0x91,0x28,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0xfc,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x1f,0x54,0xfe,0xff,0xff,0xff,0x7f,0x75,0xf2,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0x27,0x44,0x82,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0x29,
- 0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xb8,0xfc,0xff,0xff,0xff,0xbf,0x14,
- 0xf1,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x0f,0x11,0x20,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x55,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x9a,0xfe,0xff,
- 0xff,0xff,0x7f,0x5a,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0x5f,0x40,0x85,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x4f,0x2d,0xfd,0xff,0xff,0xff,0x9f,0x12,0xf9,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0x3f,0x14,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfe,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x07,0xa6,0xfe,0xff,0xff,0xff,0x5f,0x4d,0xfa,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0x40,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x09,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x4b,0xfe,0xff,0xff,0xff,0xbf,
- 0x2c,0xf8,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xf5,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x43,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0x57,0xff,
- 0xff,0xff,0xff,0x5f,0x0a,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xd5,0xa9,0xff,0xff,0xff,0xff,0xaf,0x5a,0xfc,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa3,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x81,0x95,0xff,0xff,0xff,0xff,0x9f,0x06,0xfd,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xca,0xa5,0xff,0xff,0xff,0xff,
- 0x2f,0x95,0xfc,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe0,0xea,
- 0xff,0xff,0xff,0xff,0xaf,0x26,0xfe,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd5,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xf5,0xf4,0xff,0xff,0xff,0xff,0xaf,0x86,0xfe,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc1,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0x70,0xe5,0xff,0xff,0xff,0xff,0x4f,0x2e,0xfe,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xeb,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xb2,0xfa,0xff,0xff,0xff,
- 0xff,0x57,0x83,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xf3,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x78,
- 0xf2,0xff,0xff,0xff,0xff,0xa7,0x22,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x5f,0x5d,0xfd,0xff,0xff,0xff,0xff,0x97,0x87,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x1f,0x3c,0xfd,0xff,0xff,0xff,0xff,0x53,0xa3,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xac,0xfe,0xff,0xff,
- 0xff,0xff,0x57,0x95,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x0f,
- 0x9e,0xfe,0xff,0xff,0xff,0xff,0x97,0x81,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xa7,0x57,0xfe,0xff,0xff,0xff,0xff,0xa9,0xa5,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x03,0xaf,0xff,0xff,0xff,0xff,0xff,0x4b,
- 0x89,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0x93,0xff,0xff,
- 0xff,0xff,0xff,0x95,0xa2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x83,0xab,0xff,0xff,0xff,0xff,0xff,0xd3,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xff,
- 0xff,0xff,0xff,0xff,0xe9,0xa5,0xff,0xff,0xff,0xff,0xff,0xa5,0xe1,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xc0,0xd5,0xff,0xff,0xff,0xff,0xff,
- 0xd5,0xc8,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xea,0xea,0xff,
- 0xff,0xff,0xff,0xff,0x14,0xc1,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,
- 0xff,0xe0,0xe4,0xff,0xff,0xff,0xff,0xff,0x65,0xe8,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,
- 0xff,0xff,0xff,0xff,0x3f,0x72,0xe9,0xff,0xff,0xff,0xff,0xff,0x6a,0xe1,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xef,0xff,0xff,0xff,0xff,0xbf,0xb8,0xfa,0xff,0xff,0xff,0xff,
- 0xff,0x52,0xea,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd3,0xff,0xff,0xff,0xff,0x1f,0x7a,0xf5,
- 0xff,0xff,0xff,0xff,0x7f,0x2a,0xe0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xeb,0xff,0xff,0xff,
- 0xff,0x8f,0x58,0xfa,0xff,0xff,0xff,0xff,0x7f,0x25,0xf5,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xb5,0xff,0xff,0xdf,0xff,0x57,0x5e,0xfd,0xff,0xff,0xff,0xff,0xff,0x34,0xe0,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xca,0xff,0xff,0x8f,0xff,0x07,0xac,0xfc,0xff,0xff,0xff,
- 0xff,0x7f,0x2a,0xf5,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd4,0xff,0xff,0x57,0xff,0x2b,0x2d,
- 0xfd,0xff,0xff,0xff,0xff,0xff,0xb2,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd2,0xff,0xff,
- 0x07,0xff,0x43,0x4a,0xff,0xff,0xff,0xff,0xff,0xbf,0x2a,0xf8,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x3f,0xc5,0xff,0xff,0x2b,0xfe,0x08,0xab,0xfe,0xff,0xff,0xff,0xff,0x7f,0xaa,
- 0xf2,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xbf,0xea,0xff,0xff,0x83,0x36,0x20,0x55,0xff,0xff,0xff,
- 0xff,0xff,0x3f,0x15,0xf0,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xc2,0xff,0xff,0x48,0x4a,0x85,
- 0x49,0xff,0xff,0xff,0xff,0xff,0x7f,0x59,0xfa,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0xf5,0xff,
- 0x7f,0x10,0x29,0x50,0xa5,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xf9,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x97,0xe4,0xff,0x7f,0x05,0x95,0x42,0xd5,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0x35,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xab,0xea,0xff,0xbf,0xa0,0x24,0xa8,0xd4,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0x19,0xf9,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x27,0xe5,0xff,0x3f,0x92,0xaa,
- 0x50,0xe9,0xff,0xff,0xff,0xff,0xff,0x9f,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa9,0xe2,
- 0xff,0x9f,0xa0,0xaa,0x2a,0xf5,0xff,0xff,0xff,0xff,0xff,0x5f,0x1a,0xf9,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x95,0xf8,0xff,0x5f,0x4a,0x92,0x4a,0xf5,0xff,0xff,0xff,0xff,0xff,
- 0xbf,0x4a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xf2,0xff,0x1f,0x20,0x49,0xa5,0xfa,0xff,
- 0xff,0xff,0xff,0xff,0x5f,0x1a,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaa,0xf8,0xff,0x47,0xa9,
- 0x2a,0x29,0xf9,0xff,0xff,0xff,0xff,0xff,0xbf,0x0a,0xfc,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49,
- 0xf2,0xff,0x17,0x92,0xaa,0xaa,0xfe,0xff,0xff,0xff,0xff,0xff,0x9f,0xac,0xfe,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x9f,0x2a,0xf8,0xff,0x43,0xa8,0x24,0x25,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xaf,0x0a,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xfa,0xff,0x91,0x54,0xaa,0x52,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x2f,0x4d,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0x45,0xfc,0xff,0x03,
- 0x92,0x52,0xaa,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x06,0xfc,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,
- 0x12,0xfe,0xff,0x50,0xaa,0x2a,0x95,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0xa5,
- 0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xa7,0x44,0xff,0xff,0x0a,0x25,0xa5,0xa4,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x97,0x06,0xfc,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2b,0x15,0xff,0xff,0x40,0xa9,0x92,0xea,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x55,0xfd,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xa1,0xff,0x7f,
- 0x92,0x4a,0xaa,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x06,0xfc,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x95,0x8a,0xff,0x3f,0x84,0x54,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,
- 0x25,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x52,0xe0,0xff,0xbf,0x50,0xa9,0x4a,0xf2,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xa7,0x8e,0xfe,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa9,0xea,0xff,0x3f,0x24,0x95,0x54,
- 0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0x57,0x23,0xfe,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x4a,0xf0,0xff,
- 0x9f,0x50,0x69,0x49,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x8b,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xa5,0xf4,0xff,0x0f,0x2d,0x75,0xaa,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xaf,0x03,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x9f,0x14,0xfa,0xff,0x2f,0xa8,0xfa,0x25,0xfd,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x97,0xd7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xaa,0xfc,0xff,0x0f,0x4d,0xfd,
- 0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xcf,0x83,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x12,0xfc,
- 0xff,0x27,0x92,0xfe,0xcb,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xd7,0xd7,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x97,0x0a,0xff,0xff,0x83,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xef,0xc7,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xab,0x24,0xff,0xff,0x2b,0xaa,0xfe,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xe7,0xef,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0x05,0x95,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xe7,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x82,
- 0xff,0xff,0x51,0xa9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xf7,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xa9,0xe8,0xff,0xff,0x85,0xca,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0x52,0xc1,0xff,0xff,0x90,0xd5,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x4d,0xe8,0xff,0xff,0xa5,
- 0xe4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x51,
- 0xf2,0xff,0x7f,0x40,0xd5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x3f,0x95,0xf8,0xff,0x7f,0xa9,0xea,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x15,0xfa,0xff,0x3f,0xa4,0xf4,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xa4,0xfc,0xff,0x7f,
- 0x71,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,
- 0x15,0xfe,0xff,0x3f,0x94,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xa7,0x0a,0xff,0xff,0x1f,0x79,0xf2,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xab,0xa4,0xff,0xff,0x5f,0x8c,0xfa,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x82,0xff,0xff,
- 0x1f,0x5c,0xfd,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xa4,0x92,0xff,0xff,0xbf,0x56,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x9a,0xc4,0xff,0xff,0x0f,0x2e,0xfd,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa2,0xf0,0xff,0xff,0xaf,0xa7,0xfe,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x55,0xe4,0xff,
- 0xff,0x0f,0x57,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xbf,0x54,0xf2,0xff,0xff,0x9f,0x4b,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x9f,0x92,0xf8,0xff,0xff,0xc7,0xab,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x15,0xfe,0xff,0xff,0x97,0xd7,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xa7,0x94,0xfc,
- 0xff,0xff,0xc7,0xe3,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x2f,0x05,0xfe,0xff,0xff,0xcf,0xf5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x53,0xa9,0xff,0xff,0xff,0xd3,0xeb,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x05,0xff,0xff,0xff,0xe3,
- 0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0xc2,
- 0xff,0xff,0xff,0xeb,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x95,0xc8,0xff,0xff,0xff,0xf3,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xd2,0xff,0xff,0xff,0xff,0xf5,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xaa,0xe0,0xff,0xff,0xff,
- 0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x49,
- 0xf8,0xff,0xff,0xff,0xff,0xfa,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x9f,0x2a,0xf5,0xff,0xff,0xff,0xff,0xfd,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x4a,0xf8,0xff,0xff,0xff,0xff,0xfc,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x14,0xfd,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x97,
- 0x4a,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xab,0x04,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x95,0x52,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x53,0x85,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x54,0xa2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x4a,0xc9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xa5,0xe0,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x94,0xe4,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x5f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xbf,0x12,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4f,0x54,0xfa,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0x0a,0xfc,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x53,0x45,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x97,0x14,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x4b,0x45,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x54,0x82,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x4a,0xe9,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x52,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x55,0xe8,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24,
- 0xf1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0x55,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0x24,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0x15,0xfe,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,
- 0x49,0xfc,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x2f,0x95,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x5f,0x01,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x2f,0xd5,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x57,0x81,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x97,0xd4,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xaf,0xe0,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x93,0xf4,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x57,0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x2b,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x89,0xfc,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x55,0xfc,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x05,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x49,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x22,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0x89,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xe5,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xc1,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xbf,0xe9,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xf2,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x9f,0xf8,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xf9,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xfc,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0x6f,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xbf,0xfe,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x3f,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,
- 0xff,0x9f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xdf,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xef,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,
- 0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0xff,0x7f};
+++ /dev/null
-/* XPM */
-static char *gnus[] = {
-/* width height num_colors chars_per_pixel */
-" 271 273 3 1",
-/* colors */
-". s thing c #bf9900",
-"# s shadow c #ffcc00",
-"a s None c None",
-/* pixels */
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............#######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........................#######aaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................######aaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................######aaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................#######aaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................aaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................aaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................########aaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......................aaaaaaaaaaaaaa........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#######aaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................aaaaaaaaaaa............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................########aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................aaaaaaaaa..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................aaaaaaa................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................aaaaa..................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......######.......................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................aaaa...................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#######aa....................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................aa.....................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaa.................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................a......................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaa................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaa...............#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaa...............#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaa..............#######aaaaa",
-"aaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaa..............#######aaaaa",
-"aaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa.............#######aaaaa",
-"aaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............####....................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa............########aaaaa",
-"aaaaaaa.........aaaaaaaaaaaaaaaaaaaaaaaaaaa.............########...................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaa.............############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaaa..........aaaaaaaaaaaaaaaaaaaaaa.............##############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaaa...........aaaaaaaaaaaaaaaaaaaa............##################.......................##########................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa..........########aaaaa",
-"aaaaaaaa............aaaaaaaaaaaaaaaaaa............####################....................###############..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaa............aaaaaaaaaaaaaaaa..............#####################.................#####################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa###aaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaa.............aaaaaaaaaaaaaa..............#######################...............#######################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaaa.............aaaaaaaaaaa...............##########aa#############.............#########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaaa.............aaaaaaaaa................#########aaaaaaa###########............##########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa................aaaa..................#######aaaaaaaaaa###########..........############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa.....................................######aaaaaaaaaaaaa###########.........#############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa....................................######aaaaaaaaaaaaaaaa#########........###############################.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaaa.................................#######aaaaaaaaaaaaaaaaaa#########.......#######aaaaaaaaaaa##############..........................aaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaaa................................#######aaaaaaaaaaaaaaaaaaaa########......#####aaaaaaaaaaaaaaaaa############..........................aaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaaa...............................########aaaaaaaaaaaaaaaaaaaaa########....#####aaaaaaaaaaaaaaaaaaaaa##########..........................aaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaa#..............................########aaaaaaaaaaaaaaaaaaaaaaaa#.####...#####aaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaa#.............................########aaaaaaaaaaaaaaaaaaaaaaaaa...###..######aaaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaa......a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###...........................#########aaaaaaaaaaaaaaaaaaaaaaaa....##########aaaaaaaaaaaaaaaaaaaaaaaaaa##########............................aaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###..........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....#########aaaaaaaaaaaaaaaaaaaaaaaaaaaa##########...............................aaaaaaaa...........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###.........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....a#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##########................................................##aaaaaa...aaaaaaaaaaaaaaaaaaaaa......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaaa####........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................................##aaaaaa....aaaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaaa####.......................########aaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..............................................##aaaaa.....aaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa######....................#########aaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########............................................##aaaaaa......aaaaaaaaaaaaaaa.........a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa######...................#########aaaaaaaaaaaaaaaaaaaaaaaaaa......##aaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................................##aaaaa.......aaaaaaaaaaaaa..........aa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa#######.................#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a###aaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................................###aaaaa.........aaaaaaa..............a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaa",
-"aaaaaaa#######...............#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########........................................##aaaaa...............................a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaa########............##########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.......................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaaa##########.......###########aaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.....................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########....................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaaa",
-"aaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaa#######################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................####aaaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.............................#####aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaaa###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................######aaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......########aaaaaaaaaa",
-"aaaaaaaaaaaa#################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................######aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
-"aaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaa#########.......................#######aaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaa#########....................#########aaaa............................########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaa#########..................#########aaaaa..........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........aaaaaaaaaaaaaaa###########.............###########aaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............aaaaaaaaaaaaaaa##############....###############aaaaaaa.......................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............aaaaaaaaaaaaaaa##############################aaaaaaaaa.....................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaa############################aaaaaaaaaaa...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaa................aaaaaaaaaaaaaaaa##########################aaaaaaaaaaaa#................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaa.................aaaaaaaaaaaaaaaa########################aaaaaaaaaaaaa##..............#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa...................aaaaaaaaaaaaaaaa######################aaaaaaaaaaaaa#####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa....................aaaaaaaaaaaaaaaaa###################aaaaaaaaaaaaaaa########..##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaa....................aaaaaaaaaaaaaaaaaaa################aaaaaaaaaaaaaaaa###########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa......................aaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a###a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a####a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaa........a#####aaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaa#.....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaa##....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaa#####..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa#########.................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa###########................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaa##########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaa#########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaaaaa########..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaaaa............#########aaaaaaaaaaaaa#######..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaa#######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaaaa######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaa..............#########aaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaaaa#####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaa..................########aaaaaaaaaaaaaaaaaaaaaaaaa####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................................########aaaaaaaaaaaaaaaaaaaaaaaaaa####...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....................................########aaaaaaaaaaaaaaaaaaaaaaaaaaaa###...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa####..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.......##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###............##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######..###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#aaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaa#######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#aaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#aaaaaaaaaaaaaaaaaaaa#######aaaaaaa#########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......##aaaaaaaaaaaaaaaaaaa########a..aa##########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaa#########....##########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaa#########......#########........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#aaaaaaaaaaaaaaaaaa#########......########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa#########.......#######.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa########.........#####.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaa########........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........###aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........####aaaaaaaaaaaaaaa#########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######.........a..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######a........aaa............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######........aaaaa..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######a.......aaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa######a........aaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaa####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaa###aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaa####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaa###aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-};
-
+++ /dev/null
-/* XPM */
-static char * help_xpm[] = {
-"24 24 244 2",
-" c None",
-". c #000000",
-"+ c #454442",
-"@ c #1D1D1C",
-"# c #040404",
-"$ c #1B1B1B",
-"% c #3D3C3A",
-"& c #4D4C4B",
-"* c #2F2F2D",
-"= c #C1BFBB",
-"- c #ECEAE7",
-"; c #F5F3F0",
-"> c #F2F0EC",
-", c #E1DFDC",
-"' c #AFADAA",
-") c #272726",
-"! c #020202",
-"~ c #3F3E3E",
-"{ c #36302D",
-"] c #181818",
-"^ c #FBF8F5",
-"/ c #FEFCF8",
-"( c #FAF8F5",
-"_ c #F5F4F1",
-": c #F2F1ED",
-"< c #F1EFEB",
-"[ c #F1EEEB",
-"} c #EAE9E6",
-"| c #DAD8D4",
-"1 c #100E0E",
-"2 c #1F100E",
-"3 c #AF3A1E",
-"4 c #FBAB93",
-"5 c #FAE9E3",
-"6 c #F0EFEB",
-"7 c #E9E8E5",
-"8 c #EAE8E6",
-"9 c #ECEAE8",
-"0 c #EDEBE9",
-"a c #EDEBE8",
-"b c #EACFC6",
-"c c #D5340A",
-"d c #751904",
-"e c #100806",
-"f c #34160D",
-"g c #AF3C20",
-"h c #FCCCBD",
-"i c #F7BEAD",
-"j c #E67554",
-"k c #DFDDDB",
-"l c #DBD9D6",
-"m c #D8D7D3",
-"n c #DBDAD6",
-"o c #E3E2DE",
-"p c #ECEBE8",
-"q c #E5572D",
-"r c #E33A0B",
-"s c #D4340A",
-"t c #691504",
-"u c #100504",
-"v c #582C22",
-"w c #0F0F0F",
-"x c #FDD4C8",
-"y c #F7BFAF",
-"z c #E87554",
-"A c #D5512B",
-"B c #C68270",
-"C c #BEBDBA",
-"D c #A5A3A0",
-"E c #9C9A95",
-"F c #B9B7B2",
-"G c #D7D6D2",
-"H c #E7E5E2",
-"I c #E79A85",
-"J c #E53C0B",
-"K c #E43C0B",
-"L c #E23A0B",
-"M c #C93009",
-"N c #010000",
-"O c #040100",
-"P c #FAB19C",
-"Q c #FACCBE",
-"R c #EB8264",
-"S c #D8532D",
-"T c #C0340F",
-"U c #932006",
-"V c #141412",
-"W c #857974",
-"X c #DA370B",
-"Y c #EC7C5B",
-"Z c #E95B32",
-"` c #DE380B",
-" . c #9D2306",
-".. c #626261",
-"+. c #FEF1ED",
-"@. c #F09479",
-"#. c #DC532B",
-"$. c #C0350F",
-"%. c #942006",
-"&. c #621404",
-"*. c #E2522B",
-"=. c #F2A690",
-"-. c #E74E21",
-";. c #E23B0B",
-">. c #C99181",
-",. c #454342",
-"'. c #E5E4E2",
-"). c #FCFBFA",
-"!. c #E2D8D3",
-"~. c #C34C2A",
-"{. c #B02B07",
-"]. c #9E2D12",
-"^. c #EF8D71",
-"/. c #F09B83",
-"(. c #EADDD7",
-"_. c #272724",
-":. c #F0EEEC",
-"<. c #F3F2EF",
-"[. c #D7D6D3",
-"}. c #BFBEBB",
-"|. c #9E6153",
-"1. c #3F0D02",
-"2. c #F0B9A9",
-"3. c #F6F5F4",
-"4. c #E8E7E4",
-"5. c #DAD8D5",
-"6. c #585652",
-"7. c #F6F4F0",
-"8. c #DAD8D6",
-"9. c #C2C1BE",
-"0. c #989691",
-"a. c #0A0A08",
-"b. c #F6F4F2",
-"c. c #F4F3F1",
-"d. c #E4E3E0",
-"e. c #D3D2CE",
-"f. c #63625D",
-"g. c #DCDAD8",
-"h. c #C7C6C2",
-"i. c #ABAAA5",
-"j. c #0A0A0A",
-"k. c #FAF8F6",
-"l. c #EFEDEA",
-"m. c #DDDCD8",
-"n. c #C6C4C2",
-"o. c #3E3E39",
-"p. c #1B1B19",
-"q. c #F0EEEA",
-"r. c #E0DFDD",
-"s. c #CCCBC9",
-"t. c #C0BFBB",
-"u. c #131311",
-"v. c #676663",
-"w. c #FCFAF8",
-"x. c #D6D4D2",
-"y. c #BCBAB7",
-"z. c #3C3C3A",
-"A. c #DEDCD9",
-"B. c #7E4B3E",
-"C. c #232323",
-"D. c #CC9385",
-"E. c #FAFAF7",
-"F. c #E6E6E2",
-"G. c #CDCCCA",
-"H. c #B0B0AC",
-"I. c #EDE3DF",
-"J. c #E78468",
-"K. c #DF5D3A",
-"L. c #631909",
-"M. c #282828",
-"N. c #B46E5E",
-"O. c #FCC3B2",
-"P. c #F1A691",
-"Q. c #DCD2CC",
-"R. c #C8C6C3",
-"S. c #7E7C78",
-"T. c #E8AD9C",
-"U. c #E96139",
-"V. c #EB7452",
-"W. c #EF8E72",
-"X. c #EA8063",
-"Y. c #9E2E13",
-"Z. c #3F1811",
-"`. c #121212",
-" + c #6B433B",
-".+ c #E0A191",
-"++ c #FDD3C7",
-"@+ c #F4AD98",
-"#+ c #DE532B",
-"$+ c #C83409",
-"%+ c #B48274",
-"&+ c #383534",
-"*+ c #D6340A",
-"=+ c #E43D0F",
-"-+ c #E8582E",
-";+ c #ED7957",
-">+ c #F4B6A4",
-",+ c #F4B09D",
-"'+ c #F0E5E0",
-")+ c #F4F3EF",
-"!+ c #FDF8F6",
-"~+ c #FBCEC1",
-"{+ c #F28B6E",
-"]+ c #E44E23",
-"^+ c #D3370A",
-"/+ c #BF2F09",
-"(+ c #260800",
-"_+ c #190F0B",
-":+ c #D5350A",
-"<+ c #E43D0C",
-"[+ c #E74C1F",
-"}+ c #EFBBAB",
-"|+ c #F5F4F3",
-"1+ c #F5F3F1",
-"2+ c #EAB1A0",
-"3+ c #DE4316",
-"4+ c #C5310A",
-"5+ c #591202",
-"6+ c #0E0504",
-"7+ c #C83009",
-"8+ c #E0532B",
-"9+ c #E7E6E3",
-"0+ c #E7E6E2",
-"a+ c #DDDCD9",
-"b+ c #CFCECA",
-"c+ c #C14724",
-"d+ c #AE2907",
-"e+ c #290800",
-"f+ c #0F0705",
-"g+ c #9B2205",
-"h+ c #C1A89F",
-"i+ c #D1D0CC",
-"j+ c #CFCDCA",
-"k+ c #C7C6C3",
-"l+ c #BBBAB7",
-"m+ c #B5B4B1",
-"n+ c #A7A6A2",
-"o+ c #66564F",
-"p+ c #0B0908",
-"q+ c #010100",
-"r+ c #222221",
-"s+ c #51504B",
-"t+ c #5D5C57",
-"u+ c #3B3B37",
-" . . + @ # # $ % ",
-" . . . . & # * = - ; > , ' ) ! ~ . . . . ",
-". . { ] ^ / ( _ : > < [ } | . 1 . . ",
-" . 2 3 4 5 6 - 7 8 9 0 0 a b c d e . ",
-" . f g h i j k l m n o } p a q r s t u . . ",
-" v w x y z A B C D E F G H I J K L M . N ",
-" O P Q R S T U . . . . V W X Y Z K ` .. ",
-" ..+.@.#.$.%.. . . &.*.=.-.;.>.! . ",
-",.'.).!.~.{.. . . ].^./.(.n _.. ",
-"@ :.<.[.}.|.. 1.2.3.4.5.6.. ",
-"# 7.6 8.9.0.. a.b.c.d.e.f.. ",
-"# > < g.h.i.. j.k.l.m.n.o.. ",
-"p., q.r.s.t.u. v.w.9 x.y.. . ",
-"z.' [ 7 A.[.B.. C.D.E.F.G.H.. . ",
-" ) } 0 I.J.K.L.. M.N.O.P.Q.R.S.. . ",
-" ! | T.U.V.W.X.Y.Z.a.`. +.+++@+#+$+%+. . ",
-" &+. *+=+-+;+>+,+'+)+k.!+~+{+]+^+/+(+. . ",
-" . _+d :+L <+[+}+|+l.1+|+2+3+^+4+5+. . . ",
-" . 6+t 7+` 8+9+0+o a+[.b+c+d+e+. . . ",
-" . f+. g+h+i+j+k+l+m+n+o+. . . . ",
-" . . . p+. q+r+s+t+u+. . . . . . . ",
-" . . . . . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * home_xpm[] = {
-"24 24 101 2",
-" c None",
-". c #000000",
-"+ c #212121",
-"@ c #2C2C2C",
-"# c #C1665A",
-"$ c #924B37",
-"% c #2A2A2A",
-"& c #333333",
-"* c #343434",
-"= c #242424",
-"- c #944D3A",
-"; c #A05443",
-"> c #181818",
-", c #474747",
-"' c #555555",
-") c #8D8D8D",
-"! c #383838",
-"~ c #191919",
-"{ c #974F3C",
-"] c #222222",
-"^ c #313131",
-"/ c #A1A1A1",
-"( c #676767",
-"_ c #ACACAC",
-": c #BCBCBC",
-"< c #585858",
-"[ c #141414",
-"} c #1C1C1C",
-"| c #464646",
-"1 c #666666",
-"2 c #BABABA",
-"3 c #7E7E7E",
-"4 c #D2D2D2",
-"5 c #FFFFFF",
-"6 c #4F4F4F",
-"7 c #262626",
-"8 c #232323",
-"9 c #505050",
-"0 c #B2B2B2",
-"a c #909090",
-"b c #9A9A9A",
-"c c #838383",
-"d c #171717",
-"e c #202020",
-"f c #717171",
-"g c #A6A6A6",
-"h c #616161",
-"i c #1D1D1D",
-"j c #1F1F1F",
-"k c #C4C4C4",
-"l c #CACACA",
-"m c #AEAEAE",
-"n c #D1D1D1",
-"o c #7C7C7C",
-"p c #BFBFBF",
-"q c #6C6C6C",
-"r c #EEEEEE",
-"s c #949494",
-"t c #C7C7C7",
-"u c #EBEBEB",
-"v c #7D7D7D",
-"w c #6E6E6E",
-"x c #A9A9A9",
-"y c #E99E8F",
-"z c #DD806D",
-"A c #9B5343",
-"B c #CECECE",
-"C c #626262",
-"D c #858585",
-"E c #ECA292",
-"F c #D0533A",
-"G c #934F3E",
-"H c #6D6D6D",
-"I c #ECA291",
-"J c #CF543C",
-"K c #371D16",
-"L c #5D5D5D",
-"M c #868686",
-"N c #787878",
-"O c #ECA696",
-"P c #C95C49",
-"Q c #E17C66",
-"R c #924E3D",
-"S c #888888",
-"T c #A0A0A0",
-"U c #3D1208",
-"V c #D15137",
-"W c #919191",
-"X c #879981",
-"Y c #82947C",
-"Z c #8A9B85",
-"` c #6E8467",
-" . c #5D7555",
-".. c #4C6042",
-"+. c #3F4F37",
-"@. c #303D2A",
-"#. c #7F8F7A",
-"$. c #64785E",
-"%. c #44563E",
-"&. c #657460",
-"*. c #40503A",
-" ",
-" . . ",
-" . . . . . + @ . ",
-" . # $ . . % & * = . ",
-" . - ; . > , ' ) ! ~ . ",
-" . { . ] ^ / ( _ : < [ . ",
-" . . } | 1 2 3 4 : 5 6 7 . ",
-" . 8 9 0 a 4 b 5 : 5 : c d . ",
-" . e f g 4 b 5 : 5 : 5 : 5 h i . ",
-" . j k k l 5 m 5 2 5 2 5 : 5 n o } . ",
-" . 8 m p p p p p p p p . . . . . a q = . ",
-" . . . . r 5 5 5 5 5 5 5 . s t u . v . . . . ",
-" . 4 5 . . . . . 5 . : 5 5 . w . ",
-" . x 5 . y z A . 5 . B 5 5 . C . ",
-" . D 5 . E F G . 5 . . . . . H . ",
-" . . 5 . I J K . k s L L M N . . ",
-" . . r . O P G . 5 5 5 5 5 2 . ",
-" . 2 . Q # R . : : : : : S . ",
-" . T U V # A . 5 5 5 5 5 W . ",
-" . . . . . . . . . . . . . . . . . . . . . ",
-" } X Y Z X ` ...+.@.. Y #.$.%.&.*.. ",
-" . . . . . . . . . . . . . . . . . ",
-" . . . ",
-" "};
+++ /dev/null
-/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 2 1",
-"! c red",
-"w c Gray75",
-/* pixels */
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwww!!!wwwwwwwwwwww",
-"wwwwwwwww!!!wwwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwww!!!!!!!wwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwwww!!!wwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwww!!!wwwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwww!!!!!wwwwwwwwwww",
-"wwwwwwwww!!!wwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww"
-};
+++ /dev/null
-/* XPM */
-static char * stock_inbox_xpm[] = {
-"24 24 76 1",
-" c None",
-". c #000000",
-"+ c #B5CADD",
-"@ c #BFD1E1",
-"# c #C3D4E3",
-"$ c #C7D7E5",
-"% c #B0C6DA",
-"& c #6B94BB",
-"* c #131E29",
-"= c #739ABF",
-"- c #7EA2C4",
-"; c #9AB6D0",
-"> c #E4EBF2",
-", c #DDE6EF",
-"' c #8CACCA",
-") c #5C8AB4",
-"! c #090F15",
-"~ c #B1C7DB",
-"{ c #D0DDEA",
-"] c #D9E3ED",
-"^ c #88A9C8",
-"/ c #4D7CA7",
-"( c #030405",
-"_ c #41688D",
-": c #32506C",
-"< c #C4D5E4",
-"[ c #A5BED5",
-"} c #456F97",
-"| c #3B5F81",
-"1 c #C8D8E6",
-"2 c #9CB8D2",
-"3 c #395B7B",
-"4 c #C6D6E4",
-"5 c #BBCEDF",
-"6 c #3D6183",
-"7 c #B6CBDE",
-"8 c #426A90",
-"9 c #E2C6A9",
-"0 c #E5CDB4",
-"a c #D5AA7F",
-"b c #9D6733",
-"c c #CB9967",
-"d c #ADC4D9",
-"e c #B99877",
-"f c #CFBAA4",
-"g c #9A7149",
-"h c #CDA378",
-"i c #D2A87E",
-"j c #608DB6",
-"k c #AA7B4B",
-"l c #C2A588",
-"m c #996633",
-"n c #BB9978",
-"o c #C3976B",
-"p c #D2A980",
-"q c #D1A77D",
-"r c #E0C4A8",
-"s c #C9B097",
-"t c #D7B38E",
-"u c #DAC2A9",
-"v c #BD9063",
-"w c #CEA57C",
-"x c #E5CFBB",
-"y c #393633",
-"z c #E0C8B1",
-"A c #C9A480",
-"B c #D1A87E",
-"C c #D0A67B",
-"D c #E1CAB4",
-"E c #52504D",
-"F c #D8C6B5",
-"G c #CBA988",
-"H c #CCAF93",
-"I c #D2B496",
-"J c #A67D51",
-"K c #E2CFBD",
-" ...... ",
-" .+@#$%&*. ",
-" .=-;$>,')! ",
-" ...=~{]^/( ",
-" .=+#$_:. ",
-" .<[@}|. ",
-" .12@}3. ",
-" ....425}6.... ",
-" .=2527}8}:. ",
-" ..9.=227}}:. ",
-" ..0abb.=2~}:.. ",
-" ..0abbbbc.=d:.ef.. ",
-".0abbbbghii.j.kkklf.. ",
-".mnabgopqqqi.iokkkkef. ",
-".mmmnrooqiqqqiiiokkkks. ",
-".mmmmmnrooqiqqqiiiokkl. ",
-" ..mmmmmnrooqiqqiiituf. ",
-" ..mmmmmnrvwiqqtxxy. ",
-" ..mmmmmzABCDxE.. ",
-" ...mmmFGHIE.. ",
-" ...mJK... ",
-" ..... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * index_xpm[] = {
-"24 24 174 2",
-" c None",
-". c #000000",
-"+ c #FDFDFD",
-"@ c #F5F5F5",
-"# c #F6F6F6",
-"$ c #D0D0D0",
-"% c #C1C1C1",
-"& c #C3C3C3",
-"* c #C6C6C6",
-"= c #C8C8C8",
-"- c #8D8D8D",
-"; c #CACACA",
-"> c #919191",
-", c #EFEFEF",
-"' c #878787",
-") c #8A8A8A",
-"! c #5C5C5C",
-"~ c #F8F8F8",
-"{ c #EAEAEA",
-"] c #CCCCCC",
-"^ c #CECECE",
-"/ c #979797",
-"( c #CDCDCD",
-"_ c #A1A1A1",
-": c #090600",
-"< c #A3A3A3",
-"[ c #C5C5C5",
-"} c #C4C4C4",
-"| c #D1D1D1",
-"1 c #D2D2D1",
-"2 c #D2D2D2",
-"3 c #9A9A9A",
-"4 c #E8E8E8",
-"5 c #949494",
-"6 c #939393",
-"7 c #574F4F",
-"8 c #FDFDFC",
-"9 c #777777",
-"0 c #7E7E7E",
-"a c #9D9D9D",
-"b c #6B6B6B",
-"c c #F1F1F1",
-"d c #ECECEC",
-"e c #CFCFCF",
-"f c #575050",
-"g c #FDFAF8",
-"h c #A5A5A5",
-"i c #B9B9B9",
-"j c #EEEEEE",
-"k c #EDEDED",
-"l c #D5D5D5",
-"m c #BABABA",
-"n c #6D6767",
-"o c #F9F1EA",
-"p c #9E9E9E",
-"q c #B5B5B5",
-"r c #D9D9D9",
-"s c #D7D7D7",
-"t c #BCBCBC",
-"u c #625C5B",
-"v c #F9EEE4",
-"w c #4F4D4A",
-"x c #646464",
-"y c #747474",
-"z c #D6D6D5",
-"A c #DFDFDF",
-"B c #A0A0A0",
-"C c #615C5B",
-"D c #F9F0E4",
-"E c #746C67",
-"F c #FEFDFC",
-"G c #FFFEFD",
-"H c #131210",
-"I c #636363",
-"J c #7C7C7C",
-"K c #F3F2F2",
-"L c #98948F",
-"M c #F9EFE3",
-"N c #A09489",
-"O c #FEFDFD",
-"P c #766D68",
-"Q c #736961",
-"R c #A3A3A2",
-"S c #A6A6A6",
-"T c #DBDBDB",
-"U c #C7C7C7",
-"V c #E8E5E2",
-"W c #97938E",
-"X c #F6E9D8",
-"Y c #84817A",
-"Z c #FBF3EA",
-"` c #908C86",
-" . c #F1EDE7",
-".. c #7B7975",
-"+. c #878786",
-"@. c #070000",
-"#. c #FAFAFA",
-"$. c #DDDDDD",
-"%. c #E2DFDC",
-"&. c #A8A199",
-"*. c #F0E0CE",
-"=. c #C8BFB4",
-"-. c #D5CCBF",
-";. c #DFD7CD",
-">. c #DAD3C9",
-",. c #DDCFC4",
-"'. c #928C84",
-"). c #A8A8A8",
-"!. c #959595",
-"~. c #040000",
-"{. c #D9D5D2",
-"]. c #D9CABB",
-"^. c #D7C8B8",
-"/. c #DECFBF",
-"(. c #D8C9B9",
-"_. c #E3D3C2",
-":. c #C9BBAC",
-"<. c #D9CEC2",
-"[. c #7F766D",
-"}. c #909090",
-"|. c #D3D3D3",
-"1. c #060100",
-"2. c #C0BDBA",
-"3. c #8C8782",
-"4. c #C2B5A7",
-"5. c #BFB4A6",
-"6. c #B8AB9D",
-"7. c #BAAD9E",
-"8. c #BEB0A2",
-"9. c #948A7F",
-"0. c #716860",
-"a. c #E2E2E2",
-"b. c #A9A9A8",
-"c. c #332C2B",
-"d. c #5D5954",
-"e. c #79736C",
-"f. c #958C80",
-"g. c #8D8379",
-"h. c #988D82",
-"i. c #706760",
-"j. c #787878",
-"k. c #E4E4E4",
-"l. c #C2C2C2",
-"m. c #201A1A",
-"n. c #57514F",
-"o. c #625C59",
-"p. c #625A53",
-"q. c #6B625A",
-"r. c #585251",
-"s. c #696764",
-"t. c #080000",
-"u. c #989898",
-"v. c #B0B0B0",
-"w. c #AFAFAF",
-"x. c #999999",
-"y. c #9D9897",
-"z. c #050000",
-"A. c #0C0303",
-"B. c #080100",
-"C. c #030000",
-"D. c #282523",
-"E. c #5A5A5A",
-"F. c #868686",
-"G. c #ECE4E2",
-"H. c #DED7D5",
-"I. c #D8D1D0",
-"J. c #E0DBD7",
-"K. c #E9E6E3",
-"L. c #FCFBFA",
-"M. c #030500",
-"N. c #0B0505",
-"O. c #14100F",
-"P. c #090806",
-"Q. c #000100",
-" ",
-" . . . . . . . . . . . . . . . . . . . . ",
-" . + @ @ @ @ @ @ @ # # # # # # # # # $ . ",
-" . @ % % % & & & & * * * * * = = = = - . ",
-" . # & & & * * * * = = = = = ; ; ; ; > . ",
-" . , ' ' ' ) ) ) ) - - - - - > > > > ! . ",
-" . ~ { { { { { { { { { { { { { { { { ; . ",
-" . # ; ; ; ] ] ] ] ] ^ ^ ^ ^ $ $ $ $ / . ",
-" . # ] ] ] ( ^ ^ ^ _ : < [ } | 1 | 2 3 . ",
-" . 4 5 5 5 / / / 6 7 8 . 9 0 - a a a b . ",
-" . ~ c d d d d d e f g . h i $ j j k * . ",
-" . ~ 2 2 2 2 l l m n o . > p q r r r < . ",
-" . ~ l l l l s s t u v w . x . y p z < . ",
-" . A B B B B < 9 . C D E F . G H . I J . ",
-" . ~ @ , , , j . K L M N O P F Q R . S . ",
-" . ~ T T T T U . V W X Y Z ` ...+.@.< . ",
-" . #.$.$.$.$.& . %.&.*.=.-.;.>.,.'.@.p . ",
-" . { ).).).).!.~.{.].^./.(._.:.<.[.@.}.. ",
-" . #.@ c c c |.1.2.3.4.5.6.7.8.9.0.@.] . ",
-" . #.a.a.a.a.l b.c.d.e.f.g.9.h.i.. j.q . ",
-" . #.a.a.a.a.k.l.j.m.n.o.p.q.r.s.t.u.q . ",
-" . a.v.v.v.v.v.w.x.y.z.A.t.B.C.D.E.F.m . ",
-" . . . . . . . . . ~.G.H.I.J.K.L.M.. . . ",
-" ~.N.z.O.C.P.. Q. "};
+++ /dev/null
-/* XPM */
-static char * jump_to_xpm[] = {
-"24 24 144 2",
-" c None",
-". c #000000",
-"+ c #9ABC82",
-"@ c #C1E3AA",
-"# c #A0C487",
-"$ c #8F6508",
-"% c #AD671D",
-"& c #D6AF41",
-"* c #E1B744",
-"= c #B86F20",
-"- c #7E5907",
-"; c #D8E7CD",
-"> c #D9E7CF",
-", c #DDEAD2",
-"' c #E4EFDA",
-") c #EBF6DF",
-"! c #C8EBB0",
-"~ c #A2C688",
-"{ c #986F26",
-"] c #E2B946",
-"^ c #EFCD64",
-"/ c #F4D268",
-"( c #F6D469",
-"_ c #E7C24A",
-": c #D5B044",
-"< c #BC8C31",
-"[ c #1A0700",
-"} c #D7E6CD",
-"| c #B2D29C",
-"1 c #B6D69F",
-"2 c #BDDEA5",
-"3 c #C4E7AC",
-"4 c #CAEEB1",
-"5 c #A1C387",
-"6 c #CBB86E",
-"7 c #EDD97E",
-"8 c #FEE882",
-"9 c #FEE77E",
-"0 c #FDDF60",
-"a c #FBD14F",
-"b c #E4BF49",
-"c c #BB8C31",
-"d c #CFE2C3",
-"e c #B2D19C",
-"f c #B5D59F",
-"g c #BBDBA4",
-"h c #C1E3A9",
-"i c #C6E9AE",
-"j c #C3E6AB",
-"k c #A9CE8D",
-"l c #DCBA5C",
-"m c #FBE46B",
-"n c #FFEB64",
-"o c #FFE054",
-"p c #FED952",
-"q c #F8CF4E",
-"r c #C4A13E",
-"s c #8BA27B",
-"t c #618249",
-"u c #628349",
-"v c #64864B",
-"w c #66894D",
-"x c #688B4E",
-"y c #678B4D",
-"z c #6B9251",
-"A c #719755",
-"B c #55833A",
-"C c #ECC75E",
-"D c #FFED59",
-"E c #FFE757",
-"F c #FFDF54",
-"G c #FBD44F",
-"H c #E1BD48",
-"I c #B36C1F",
-"J c #608148",
-"K c #628449",
-"L c #63854A",
-"M c #65894C",
-"N c #6C9151",
-"O c #527E39",
-"P c #B39237",
-"Q c #F0C248",
-"R c #FFF25B",
-"S c #FFEB58",
-"T c #FFE155",
-"U c #FBD450",
-"V c #E3BD49",
-"W c #BC983B",
-"X c #618349",
-"Y c #628549",
-"Z c #65884B",
-"` c #4D7735",
-" . c #907934",
-".. c #DCB444",
-"+. c #FCDB52",
-"@. c #FFEF5A",
-"#. c #FFE957",
-"$. c #FEDF54",
-"%. c #F9D24F",
-"&. c #E0BA48",
-"*. c #B08F37",
-"=. c #52743B",
-"-. c #456A2F",
-";. c #608248",
-">. c #628448",
-",. c #476F31",
-"'. c #7F6B32",
-"). c #D0AF4B",
-"!. c #F5CF4E",
-"~. c #FFE255",
-"{. c #FEDA52",
-"]. c #EAC54B",
-"^. c #D0AC42",
-"/. c #9C5D1A",
-"(. c #5A7B42",
-"_. c #456C2F",
-":. c #6F5C23",
-"<. c #A78833",
-"[. c #F0C54A",
-"}. c #FFDA52",
-"|. c #FFDE53",
-"1. c #C39032",
-"2. c #886423",
-"3. c #BC9D3B",
-"4. c #F0C84E",
-"5. c #FFD551",
-"6. c #FED751",
-"7. c #FDD550",
-"8. c #EDC74C",
-"9. c #E5BF49",
-"0. c #CCA941",
-"a. c #AB7727",
-"b. c #B1822D",
-"c. c #DCB746",
-"d. c #DFBA47",
-"e. c #EDC64C",
-"f. c #E9C34B",
-"g. c #D6B144",
-"h. c #C19D3D",
-"i. c #AB7C2B",
-"j. c #BC7222",
-"k. c #BB983B",
-"l. c #B09638",
-"m. c #A2621B",
-" ",
-" ",
-" . ",
-" . . ",
-" . + . . . . . . . ",
-" . . . . . . @ # . . $ % & * = - . . ",
-" . ; > , ' ) ! ! ~ . { ] ^ / ( _ : < [ . ",
-" . } | 1 2 3 4 4 3 5 . 6 7 8 9 0 a b c . ",
-" . d e f g h i i h j k . l m n o p q r - . ",
-" . s t u v w x x y z A B . C D E F G H I . ",
-" . s J t K L v v M N O . P Q R S T U V W . ",
-" . s J J t X u Y Z ` . ...+.@.#.$.%.&.*.. ",
-" . =.-.-.-.-.;.>.,.. '.).!.E E ~.{.].^./.. ",
-" . . . . . . (._.. :.<.[.}.|.|.{.%.V 1.$ . ",
-" . -.. . 2.3.4.5.6.7.8.9.0.a.. ",
-" . . . . b.c.d.e.f.g.h.i.. . ",
-" . . $ j.k.l.m.$ . . ",
-" . . . . . . ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * kill_group_xpm[] = {
-"24 24 3 1",
-". c None",
-"o c #000000000000",
-"+ c #9A9A6C6C4E4E",
-"o..o..o..o..o..o..o..o..",
-"........................",
-"........................",
-"o..o..o..o..o..o..o..o..",
-"........................",
-"........................",
-"o..o..o..o..++.o..o..o..",
-".......++..++++.........",
-"........++.+++..........",
-"o..o..o.+++++..o..o..o..",
-".........+++............",
-".........++++...........",
-"o..o..o.++++++.o..o..o..",
-"........++.++++.........",
-".......++...++++........",
-"o..o...+.o...++o..o..o..",
-"........................",
-"........................",
-"o..o..o..o..o..o..o..o..",
-"........................",
-"........................",
-"o..o..o..o..o..o..o..o..",
-"........................",
-"........................"};
+++ /dev/null
-/* XPM */
-static char * left_arrow_xpm[] = {
-"24 24 43 1",
-" c None",
-". c #000000",
-"+ c #B9D0B9",
-"@ c #CDDECB",
-"# c #B6C7B6",
-"$ c #B1C9B0",
-"% c #B3C4B3",
-"& c #B4CBB2",
-"* c #B5CEB5",
-"= c #B7CCB5",
-"- c #B9CEB7",
-"; c #BAD1BA",
-"> c #BBCFBA",
-", c #BBD0B9",
-"' c #B2C9B0",
-") c #7EAB78",
-"! c #AAC7A8",
-"~ c #B3CAB1",
-"{ c #B0C9B0",
-"] c #B0C9AE",
-"^ c #AEC7AC",
-"/ c #AAC5A8",
-"( c #A9C4A7",
-"_ c #698267",
-": c #2D2D2D",
-"< c #CFDFCC",
-"[ c #ADC8AB",
-"} c #B0C7AE",
-"| c #ADC6AB",
-"1 c #678C63",
-"2 c #9BAD9A",
-"3 c #85AE81",
-"4 c #87AF84",
-"5 c #87B083",
-"6 c #88AF84",
-"7 c #88B085",
-"8 c #86AF82",
-"9 c #547150",
-"0 c #3C5235",
-"a c #5B7950",
-"b c #4A6342",
-"c c #3B5035",
-"d c #415639",
-" ",
-" ",
-" ",
-" . ",
-" .. ",
-" .+. ",
-" .@#. ",
-" .@$%........ ",
-" .@&*=-;->,'). ",
-" .@!~{]^///^(_. ",
-" :<[}||[!^^}^[1. ",
-" .23444445645789. ",
-" .0aaaaaaaaaaab. ",
-" .0aaaaaaaaaab. ",
-" .0aabccccccd. ",
-" .0ab........ ",
-" .0b. ",
-" .b. ",
-" .. ",
-" . ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_lock_broken_xpm[] = {
-"24 24 204 2",
-" c None",
-". c #0E0E0E",
-"+ c #262626",
-"@ c #464646",
-"# c #3C3C3C",
-"$ c #3B3B3B",
-"% c #212121",
-"& c #252525",
-"* c #ADADAD",
-"= c #F0F0F0",
-"- c #EAEAEA",
-"; c #1A1A1A",
-"> c #000000",
-", c #FAFAFA",
-"' c #F4F4F4",
-") c #4D4D4D",
-"! c #303030",
-"~ c #D8D8D8",
-"{ c #E5E5E5",
-"] c #B0B0B0",
-"^ c #414141",
-"/ c #484848",
-"( c #030303",
-"_ c #DADADA",
-": c #E4E4E4",
-"< c #353535",
-"[ c #070707",
-"} c #A6A6A6",
-"| c #E6E6E6",
-"1 c #686868",
-"2 c #020202",
-"3 c #3E3E3E",
-"4 c #EFEFEF",
-"5 c #9B9B9B",
-"6 c #343434",
-"7 c #F8F8F8",
-"8 c #999999",
-"9 c #F1F1F1",
-"0 c #C4C4C4",
-"a c #232323",
-"b c #535353",
-"c c #AEAEAE",
-"d c #F3F3F3",
-"e c #D3D3D3",
-"f c #242424",
-"g c #4E4E4E",
-"h c #EEEEEE",
-"i c #B5B5B5",
-"j c #0F0601",
-"k c #200E03",
-"l c #765E49",
-"m c #7D6A56",
-"n c #38291D",
-"o c #180A03",
-"p c #D6CBC1",
-"q c #A09E9D",
-"r c #1D1109",
-"s c #2A1E13",
-"t c #3D2E21",
-"u c #3F3123",
-"v c #47423D",
-"w c #DBB98E",
-"x c #D6B183",
-"y c #D3AC7E",
-"z c #CFA573",
-"A c #CD9E67",
-"B c #C39056",
-"C c #46270A",
-"D c #281F14",
-"E c #675643",
-"F c #A48367",
-"G c #D8AB7C",
-"H c #BF9E7C",
-"I c #DCBB93",
-"J c #DCB786",
-"K c #D1A872",
-"L c #231B12",
-"M c #7B6C58",
-"N c #C69B63",
-"O c #C39860",
-"P c #C09257",
-"Q c #BD8A4A",
-"R c #B9803D",
-"S c #AA6E28",
-"T c #412409",
-"U c #100B07",
-"V c #CDB598",
-"W c #E8CCA9",
-"X c #DAB587",
-"Y c #D4AC7D",
-"Z c #D1A775",
-"` c #C99F6A",
-" . c #AF8B5B",
-".. c #2E2517",
-"+. c #1E1910",
-"@. c #0B0805",
-"#. c #594B39",
-"$. c #2A2015",
-"%. c #C2975E",
-"&. c #BE8D50",
-"*. c #BB823F",
-"=. c #AE722C",
-"-. c #422409",
-";. c #0E0B07",
-">. c #AB957E",
-",. c #E9CEAC",
-"'. c #DBB68A",
-"). c #D5AD7E",
-"!. c #D0A975",
-"~. c #C9A26F",
-"{. c #B99667",
-"]. c #AA895F",
-"^. c #31291C",
-"/. c #322A1C",
-"(. c #54493B",
-"_. c #C69C64",
-":. c #C2965E",
-"<. c #BE8E50",
-"[. c #C29156",
-"}. c #9E692A",
-"|. c #1A150D",
-"1. c #887762",
-"2. c #EAD1AF",
-"3. c #DDB98E",
-"4. c #D4AC7E",
-"5. c #D2A876",
-"6. c #C39E6D",
-"7. c #927751",
-"8. c #15110C",
-"9. c #988468",
-"0. c #C2945A",
-"a. c #BE8F51",
-"b. c #BC8544",
-"c. c #BE8A4F",
-"d. c #9A6526",
-"e. c #70604D",
-"f. c #EFD6B5",
-"g. c #DEBD93",
-"h. c #D4AC7C",
-"i. c #D0A672",
-"j. c #C9A069",
-"k. c #9D7E53",
-"l. c #140F09",
-"m. c #1F1710",
-"n. c #EFD8B9",
-"o. c #E3C39C",
-"p. c #D7B080",
-"q. c #D4AC79",
-"r. c #CDA46F",
-"s. c #3A2C1B",
-"t. c #FFFFFF",
-"u. c #1C160D",
-"v. c #B29E85",
-"w. c #E6C8A3",
-"x. c #D7B081",
-"y. c #D1A874",
-"z. c #CBA16A",
-"A. c #BA905A",
-"B. c #251C10",
-"C. c #DF421E",
-"D. c #F7F7F7",
-"E. c #DFDFDF",
-"F. c #2F2619",
-"G. c #92806A",
-"H. c #E6C7A2",
-"I. c #D6AF7E",
-"J. c #CCA26C",
-"K. c #53422A",
-"L. c #211910",
-"M. c #2A2014",
-"N. c #E1E1E1",
-"O. c #6A5C4A",
-"P. c #EAD0AD",
-"Q. c #DAB68B",
-"R. c #D2A978",
-"S. c #CEA56E",
-"T. c #C89D66",
-"U. c #856740",
-"V. c #534026",
-"W. c #F9F9F9",
-"X. c #FBFBFB",
-"Y. c #E2E2E2",
-"Z. c #42362B",
-"`. c #D1BA9B",
-" + c #DCBA8E",
-".+ c #D1A773",
-"++ c #C4975C",
-"@+ c #BE8C4C",
-"#+ c #B4813F",
-"$+ c #281B0B",
-"%+ c #E3E3E3",
-"&+ c #372416",
-"*+ c #74654F",
-"=+ c #B68E5C",
-"-+ c #926231",
-";+ c #452B11",
-">+ c #341E09",
-",+ c #221205",
-"'+ c #150802",
-")+ c #FDFDFD",
-"!+ c #030000",
-"~+ c #050000",
-"{+ c #010000",
-"]+ c #C3C3C3",
-" ",
-" ",
-" . + @ # $ % ",
-" & * = - ; > , ' ) > ",
-" ! ~ { ] ^ / ( $ _ : < ",
-" [ } | 1 2 3 4 5 > ",
-" 6 7 8 > > 9 0 a ",
-" b 9 c > > d e f ",
-" g h i > j k l m n o ",
-" ^ p q r s t u > v w x y z A B C ",
-" D E F G H I J K L > M N O P Q R S T ",
-" U V W X Y Z ` ...+. @.#.$.%.&.*.=.-. ",
-" ;.>.,.'.).!.~.{.].^./. (._.:.<.[.}.-. ",
-" |.1.2.3.4.5.6.7.8. > 9.0.a.b.c.d.T ",
-" e.f.g.h.i.j.k.l.> > > > > > > > > > ",
-" m.n.o.p.q.r._.s. > t.t.t.t.t.t.t.> ",
-" u.v.w.x.y.z.A.B.> > t.C.C.D.C.C.E.> ",
-" F.G.H.I.i.J.K.L.M. > t.C.C.C.C.C.N.> ",
-" O.P.Q.R.S.T.U.V. > t.W.C.C.C.X.Y.> ",
-" Z.`. +.+z.++@+#+$+> > t.C.C.C.C.C.%+> ",
-" &+*+=+-+;+>+,+'+ > t.C.C.)+C.C.{ > ",
-" !+~+{+> > - %+%+: { { ]+> ",
-" > > > > > > > > > ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_lock_ok_xpm[] = {
-"24 24 188 2",
-" c None",
-". c #000000",
-"+ c #212121",
-"@ c #9E9E9E",
-"# c #E6E6E6",
-"$ c #E7E7E7",
-"% c #C8C8C8",
-"& c #A0A0A0",
-"* c #131313",
-"= c #5F5F5F",
-"- c #EDEDED",
-"; c #D6D6D6",
-"> c #D5D5D5",
-", c #DDDDDD",
-"' c #D8D8D8",
-") c #A1A1A1",
-"! c #3C3C3C",
-"~ c #353535",
-"{ c #EFEFEF",
-"] c #CFCFCF",
-"^ c #4C4C4C",
-"/ c #141414",
-"( c #6A6A6A",
-"_ c #D0D0D0",
-": c #B2B2B2",
-"< c #454545",
-"[ c #E2E2E2",
-"} c #292929",
-"| c #0F0F0F",
-"1 c #949494",
-"2 c #E9E9E9",
-"3 c #C3C3C3",
-"4 c #1C1C1C",
-"5 c #E1E1E1",
-"6 c #272727",
-"7 c #DEDEDE",
-"8 c #B6B6B6",
-"9 c #B7B6B6",
-"0 c #150902",
-"a c #2E2419",
-"b c #251D15",
-"c c #616160",
-"d c #5E5A56",
-"e c #29211A",
-"f c #15100C",
-"g c #2F251B",
-"h c #1D1710",
-"i c #4A392B",
-"j c #656361",
-"k c #565352",
-"l c #392B1D",
-"m c #322110",
-"n c #0C0500",
-"o c #EFDBBF",
-"p c #EDD9C0",
-"q c #E9D5BE",
-"r c #E7D2B9",
-"s c #E5D0B3",
-"t c #DCC09D",
-"u c #D9BE99",
-"v c #DABE99",
-"w c #D7BB95",
-"x c #D5B68E",
-"y c #D2AF85",
-"z c #CFA77C",
-"A c #9A5E1B",
-"B c #F0DABF",
-"C c #E4C6A0",
-"D c #D6AF80",
-"E c #D3AC7B",
-"F c #D0A570",
-"G c #C99F68",
-"H c #C69B64",
-"I c #C69C64",
-"J c #C89D66",
-"K c #C79C65",
-"L c #C39860",
-"M c #C09256",
-"N c #BC8645",
-"O c #B67C36",
-"P c #985E1A",
-"Q c #EED8BC",
-"R c #E3C39C",
-"S c #D3AA7B",
-"T c #CFA670",
-"U c #CA9F68",
-"V c #C89E66",
-"W c #C89F68",
-"X c #C49961",
-"Y c #C09358",
-"Z c #BC8746",
-"` c #B77D39",
-" . c #EED8BB",
-".. c #E2C29B",
-"+. c #D6AE7F",
-"@. c #CA9E6D",
-"#. c #C69861",
-"$. c #BF925A",
-"%. c #BB8E56",
-"&. c #BD8E56",
-"*. c #5C7354",
-"=. c #EFDABE",
-"-. c #E4C49D",
-";. c #D7B080",
-">. c #DAB685",
-",. c #D4B07C",
-"'. c #D0A971",
-"). c #CEA46B",
-"!. c #CDA46D",
-"~. c #FFFFFF",
-"{. c #DBE0D9",
-"]. c #52684B",
-"^. c #4E6346",
-"/. c #52674A",
-"(. c #EFD8BB",
-"_. c #E0C199",
-":. c #D3AA7A",
-"<. c #C89B67",
-"[. c #C3965F",
-"}. c #BC8E56",
-"|. c #BA8B52",
-"1. c #BA8C54",
-"2. c #F6F6F6",
-"3. c #F7F7F7",
-"4. c #F8F8F8",
-"5. c #E6E9E5",
-"6. c #6B8064",
-"7. c #4B5F45",
-"8. c #44553D",
-"9. c #E3C29C",
-"0. c #D9B484",
-"a. c #D4AE77",
-"b. c #CFA770",
-"c. c #CCA46B",
-"d. c #CBA36B",
-"e. c #B6BEB3",
-"f. c #4E6047",
-"g. c #788274",
-"h. c #CBD2C9",
-"i. c #6A8063",
-"j. c #384834",
-"k. c #EDD6B8",
-"l. c #E1BD94",
-"m. c #D1A874",
-"n. c #BD9058",
-"o. c #B7874E",
-"p. c #B48349",
-"q. c #B5844C",
-"r. c #8F9C8A",
-"s. c #53684B",
-"t. c #475841",
-"u. c #657C5E",
-"v. c #4A5D44",
-"w. c #626E5D",
-"x. c #EED8BA",
-"y. c #E0C099",
-"z. c #D8B37F",
-"A. c #D2AD76",
-"B. c #CEA66F",
-"C. c #CCA46D",
-"D. c #FAFAFA",
-"E. c #6A7E63",
-"F. c #63715E",
-"G. c #E3E3E3",
-"H. c #EED5B7",
-"I. c #DFC096",
-"J. c #D2A776",
-"K. c #CEA46E",
-"L. c #C89D65",
-"M. c #C49960",
-"N. c #C1955C",
-"O. c #C2955C",
-"P. c #FBFBFB",
-"Q. c #FCFCFC",
-"R. c #80937A",
-"S. c #6D796A",
-"T. c #FEFEFE",
-"U. c #E5E5E5",
-"V. c #AC8C65",
-"W. c #CFA772",
-"X. c #C49256",
-"Y. c #C08D51",
-"Z. c #BA8849",
-"`. c #B78342",
-" + c #B48240",
-".+ c #B68241",
-"++ c #EAEAEA",
-"@+ c #E4E4E4",
-" ",
-" ",
-" . . . . . ",
-" . + @ # $ % & * ",
-" . = - # ; > , ' ) ! . ",
-" ~ { ] ^ . . / ( _ : < ",
-" . [ ' } . | ( % 1 . ",
-" * 2 3 . 4 5 @ . ",
-" 6 7 8 . . $ 9 . ",
-" 0 a b c d e f g b h b i j k l m n ",
-" . o p q r s t u u v u w x y z A . ",
-" . B C D E F G H I J K L M N O P . ",
-" . Q R D S T U I V W V X Y Z ` A . ",
-" . ...+.@.#.$.%.&.. . . . . . . . . *. ",
-" . =.-.;.>.,.'.).!.. ~.~.~.~.~.~.{.].^./.",
-" . (._.:.<.[.}.|.1.. ~.2.3.3.4.5.6.7.8. ",
-" . Q 9.+.0.a.b.c.d.. ~.e.f.g.h.i.7.j. ",
-" . k.l.m.#.n.o.p.q.. ~.r.s.t.u.v.w.. ",
-" . x.y.S z.A.B.c.C.. ~.D.E.s./.F.G.. ",
-" . H.I.J.K.L.M.N.O.. ~.P.Q.R.S.T.U.. ",
-" . V.W.X.Y.Z.`. +.+. ++G.G.@+U.U.3 . ",
-" . . . . . . . . . . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_lock_xpm[] = {
-"24 24 200 2",
-" c None",
-". c #000000",
-"+ c #212121",
-"@ c #9E9E9E",
-"# c #E6E6E6",
-"$ c #E7E7E7",
-"% c #C8C8C8",
-"& c #A0A0A0",
-"* c #131313",
-"= c #5F5F5F",
-"- c #EDEDED",
-"; c #D6D6D6",
-"> c #D5D5D5",
-", c #DDDDDD",
-"' c #D8D8D8",
-") c #A1A1A1",
-"! c #3C3C3C",
-"~ c #353535",
-"{ c #EFEFEF",
-"] c #CFCFCF",
-"^ c #4C4C4C",
-"/ c #141414",
-"( c #6A6A6A",
-"_ c #D0D0D0",
-": c #B2B2B2",
-"< c #454545",
-"[ c #E2E2E2",
-"} c #292929",
-"| c #0F0F0F",
-"1 c #949494",
-"2 c #E9E9E9",
-"3 c #C3C3C3",
-"4 c #1C1C1C",
-"5 c #E1E1E1",
-"6 c #272727",
-"7 c #DEDEDE",
-"8 c #B6B6B6",
-"9 c #B7B6B6",
-"0 c #150902",
-"a c #2E2419",
-"b c #251D15",
-"c c #616160",
-"d c #5E5A56",
-"e c #29211A",
-"f c #15100C",
-"g c #2F251B",
-"h c #1D1710",
-"i c #4A392B",
-"j c #656361",
-"k c #565352",
-"l c #392B1D",
-"m c #322110",
-"n c #0C0500",
-"o c #EFDBBF",
-"p c #EDD9C0",
-"q c #E9D5BE",
-"r c #E7D2B9",
-"s c #E5D0B3",
-"t c #DCC09D",
-"u c #D9BE99",
-"v c #DABE99",
-"w c #D7BB95",
-"x c #D5B68E",
-"y c #D2AF85",
-"z c #CFA77C",
-"A c #9A5E1B",
-"B c #F0DABF",
-"C c #E4C6A0",
-"D c #D6AF80",
-"E c #D3AC7B",
-"F c #D0A570",
-"G c #C99F68",
-"H c #C69B64",
-"I c #C69C64",
-"J c #C89D66",
-"K c #C79C65",
-"L c #C39860",
-"M c #C09256",
-"N c #BC8645",
-"O c #B67C36",
-"P c #985E1A",
-"Q c #EED8BC",
-"R c #E3C39C",
-"S c #D3AA7B",
-"T c #CFA670",
-"U c #CA9F68",
-"V c #C89E66",
-"W c #C89F68",
-"X c #C49961",
-"Y c #C09358",
-"Z c #BC8746",
-"` c #B77D39",
-" . c #EED8BB",
-".. c #E2C29B",
-"+. c #D6AE7F",
-"@. c #CA9E6D",
-"#. c #C69861",
-"$. c #BF925A",
-"%. c #BB8E56",
-"&. c #BD8E56",
-"*. c #BD9058",
-"=. c #BC8F58",
-"-. c #B9884E",
-";. c #B48145",
-">. c #BA8442",
-",. c #B47834",
-"'. c #975C1A",
-"). c #EFDABE",
-"!. c #E4C49D",
-"~. c #D7B080",
-"{. c #DAB685",
-"]. c #D4B07C",
-"^. c #D0A971",
-"/. c #CEA46B",
-"(. c #CDA46D",
-"_. c #CCA66D",
-":. c #CCA46B",
-"<. c #CA9F63",
-"[. c #C79858",
-"}. c #B9813F",
-"|. c #B37834",
-"1. c #975D1A",
-"2. c #EFD8BB",
-"3. c #E0C199",
-"4. c #D3AA7A",
-"5. c #C89B67",
-"6. c #C3965F",
-"7. c #BC8E56",
-"8. c #BA8B52",
-"9. c #BA8C54",
-"0. c #BB8D55",
-"a. c #BA8C55",
-"b. c #B6864C",
-"c. c #B47F43",
-"d. c #BA833F",
-"e. c #B37934",
-"f. c #9B601E",
-"g. c #E3C29C",
-"h. c #D9B484",
-"i. c #D4AE77",
-"j. c #CFA770",
-"k. c #CBA36B",
-"l. c #CCA46C",
-"m. c #CA9D61",
-"n. c #C69856",
-"o. c #BA813E",
-"p. c #B27733",
-"q. c #A36B2F",
-"r. c #EDD6B8",
-"s. c #E1BD94",
-"t. c #D1A874",
-"u. c #B7874E",
-"v. c #B48349",
-"w. c #B5844C",
-"x. c #B5884D",
-"y. c #B48146",
-"z. c #B27A3C",
-"A. c #B67D3A",
-"B. c #B07530",
-"C. c #A67137",
-"D. c #EED8BA",
-"E. c #E0C099",
-"F. c #D8B37F",
-"G. c #D2AD76",
-"H. c #CEA66F",
-"I. c #CCA46D",
-"J. c #CCA56D",
-"K. c #C99D61",
-"L. c #C69858",
-"M. c #B9803D",
-"N. c #B67D38",
-"O. c #AB783F",
-"P. c #EED5B7",
-"Q. c #DFC096",
-"R. c #D2A776",
-"S. c #CEA46E",
-"T. c #C89D65",
-"U. c #C49960",
-"V. c #C1955C",
-"W. c #C2955C",
-"X. c #C2965C",
-"Y. c #C09155",
-"Z. c #BC8A4B",
-"`. c #BE8A4C",
-" + c #A9773C",
-".+ c #AC8C65",
-"++ c #CFA772",
-"@+ c #C49256",
-"#+ c #C08D51",
-"$+ c #BA8849",
-"%+ c #B78342",
-"&+ c #B48240",
-"*+ c #B68241",
-"=+ c #B88544",
-"-+ c #BB8949",
-";+ c #BC8748",
-">+ c #BA874A",
-",+ c #B98548",
-"'+ c #B27B3B",
-")+ c #6D4215",
-" ",
-" ",
-" . . . . . ",
-" . + @ # $ % & * ",
-" . = - # ; > , ' ) ! . ",
-" ~ { ] ^ . . / ( _ : < ",
-" . [ ' } . | ( % 1 . ",
-" * 2 3 . 4 5 @ . ",
-" 6 7 8 . . $ 9 . ",
-" 0 a b c d e f g b h b i j k l m n ",
-" . o p q r s t u u v u w x y z A . ",
-" . B C D E F G H I J K L M N O P . ",
-" . Q R D S T U I V W V X Y Z ` A . ",
-" . ...+.@.#.$.%.&.*.=.-.;.>.,.'.. ",
-" . ).!.~.{.].^./.(._.:.<.[.}.|.1.. ",
-" . 2.3.4.5.6.7.8.9.0.a.b.c.d.e.f.. ",
-" . Q g.+.h.i.j.:.k.l.k.m.n.o.p.q.. ",
-" . r.s.t.#.*.u.v.w.x.b.y.z.A.B.C.. ",
-" . D.E.S F.G.H.:.I.J.l.K.L.M.N.O.. ",
-" . P.Q.R.S.T.U.V.W.X.X.Y.Z.>.`. +. ",
-" . .+++@+#+$+%+&+*+=+-+;+>+,+'+)+. ",
-" . . . . . . . . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * mail_reply_xpm[] = {
-"24 24 5 1",
-" c None",
-". c #000000000000",
-"X c #E1E1E0E0E0E0",
-"O c #FFFFFFFFFFFF",
-"o c #C7C7C6C6C6C6",
-" .. ",
-" .X. ",
-" ..XX. ",
-" ......XoXX.. ",
-" ...OOO.XooXXX. ",
-" ..OOOO.XooXXX. ",
-" ...OOOOO.XooXXX... ",
-" ..OOOOOO.XXooXX.OO.. ",
-" ...OOOO.oooXXX...... ",
-" .O...O.oXooXXX...OO. ",
-" .OOO...oXoXX...OOOO. ",
-" .OOOOO...X...OOOOOO. ",
-" .OOOOO.O...OO.OOOOO. ",
-" .OOO..OOOOOOOO..OOO. ",
-" .OO.OOOOOOOOOOOO.OO. ",
-" .O.OOOOOOOOOOOOOO.O. ",
-" ..OOOOOOOOOOOOOOOO.. ",
-" .................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 9 1",
-" c Gray0",
-". c #675e6580613e",
-"X c #8c8c7c7c6969",
-"o c #9b458d377822",
-"O c #a941a6459f3e",
-"+ c #c8c8b2b29898",
-"@ c #dadac2c2a5a5",
-"# c #eb4dea2fe4ad",
-"$ c None",
-/* pixels */
-"$$$$$$$$$$$$$$$$$$$$$$$$",
-"$$$$$$$$$$$$$$$$$$$$$$$$",
-"$$$$$$$$$$$$$ $$$$$$$",
-"$$$$$$$$ .@#+ $$$$$$",
-"$$$ .+#####@O $$$$$$",
-"$$ .+##########.+O $$$$$",
-"$$ @..########O.+# $$$$$",
-"$$ O@O..@#####.+## $$$$$",
-"$$$ ###+O.O##...##O $$$$",
-"$$$ @####@+..O#O.+# $$$$",
-"$$$ O####.#######.O $$$$",
-"$$$$ ###+O########.O $$$",
-"$$$$ ###.########@O $$$",
-"$$$$ +#+O#####@O $$$$$",
-"$$$$$ #.###@O $$$$$$",
-"$$$$$ .O@O $$ .. $$$$$",
-"$$$$$ .. $$$$ .oo. $$$$",
-"$$$$$$ $$$$$ oo $$$",
-"$$$$$$$$$$$$$$$ Oo $$$$$",
-"$$$$$$$$$$$$$$ oOOX $$$$",
-"$$$$$$$$$$$$$$ ++++ $$$$",
-"$$$$$$$$$$$$$ O@@@@O $$$",
-"$$$$$$$$$$$$$ $$$",
-"$$$$$$$$$$$$$$$$$$$$$$$$"
-};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x08,0x40,0x02,0x10,0x42,0x15,0x50,0x45,0x14,0xa0,0x02,0x10,0x81,0x0a,0x54,
- 0x45,0x54,0x50,0x01,0x08,0x01,0xc5,0xab,0x42,0x14,0x68,0x06,0x14,0xa1,0xe2,
- 0xa6,0x42,0x04,0x14,0x17,0x08,0x51,0xc1,0x81,0x52,0xfc,0xff,0xff,0x1f,0x39,
- 0x00,0x00,0x56,0xc8,0x80,0x81,0x11,0x0c,0x83,0x61,0x50,0x0a,0x0c,0x18,0x10,
- 0x08,0x30,0x06,0x50,0x0a,0xc8,0x05,0x90,0x08,0x06,0x18,0x30,0x0a,0x01,0x20,
- 0x90,0x88,0x00,0x40,0x30,0x6a,0x00,0x80,0x11,0x19,0x00,0x00,0x52,0x0c,0x00,
- 0x00,0x1c,0xf9,0xff,0xff,0x5f,0x04,0x11,0x11,0x22,0x51,0x44,0x84,0x08,0x84,
- 0x10,0x51,0xa2,0x21,0x8a,0x88,0x10,0x44,0x20,0x22,0x4a,0x11,0x8a,0x88,0x00,
- 0xa4,0x10,0x21,0x2a,0x09,0x44,0x0a,0x41};
+++ /dev/null
-/* XPM */
-static char * icon-mail-help_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ",
-" .... ",
-" .. .. ",
-" .. .. ",
-" .. ",
-" .. ",
-" .......................... ",
-" ...XXXXXXXXXXXXXXXXXXX..X. ",
-" .XX..XXXXXXX..XXXXXX..XXX. ",
-" .XXXX..XXXXX..XXXX..XXXXX. ",
-" .XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXX.XX...X.XXXXXXXXX. ",
-" .XXXXX..XXXXXXXX..XXXXXXX. ",
-" .XXXX.XXXXXXXXXXXX.XXXXXX. ",
-" .XXX.XXXXXXXXXXXXXX.XXXXX. ",
-" .X..XXXXXXXXXXXXXXXX..XXX. ",
-" ..XXXXXXXXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define noname_width 32
-#define noname_height 32
-static char noname_bits[] = {
- 0x10,0x10,0x40,0x08,0x44,0x85,0x1e,0x42,0x12,0x28,0xe2,0x28,0x80,0x42,0x81,
- 0x05,0x2a,0x78,0x01,0x52,0x81,0x8e,0x04,0x0a,0x14,0x43,0x04,0xa5,0xc1,0x40,
- 0x82,0x01,0x34,0x20,0x81,0x54,0x09,0x10,0xc1,0x01,0x66,0x12,0x20,0x2e,0x0e,
- 0x48,0x90,0x45,0x32,0x44,0x70,0x0c,0xc3,0x24,0x18,0x44,0x02,0x07,0x06,0xd4,
- 0x02,0x8c,0x01,0x3c,0x02,0x72,0x01,0x4f,0x83,0x01,0x86,0x17,0x42,0x20,0xe8,
- 0x45,0x22,0x78,0xf0,0x14,0x1a,0xfc,0x79,0xa4,0x07,0xf8,0xbd,0x0c,0x02,0xf0,
- 0x3f,0x27,0xfe,0xff,0xff,0x4f,0x92,0xd4,0x87,0x00,0x20,0x82,0x27,0x54,0x8a,
- 0x48,0x91,0x02,0x20,0x12,0x20,0x50,0x82,0x40,0x85,0x82,0x28,0x29,0x50,0x28,
- 0x02,0x84,0x02,0x81,0x50,0x21,0x54,0x2a};
+++ /dev/null
-/* XPM */
-static char * icon-mail-spell_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ... ",
-" .XXX.. ",
-" .XXXXXX.. ",
-" ... .XXXXXXXX. ",
-" ..XXX.XX.XXXXXX. ",
-" ..XXXX.XXX.XXXXX. ",
-" ..XXXXXX.XX.XXXXX. ",
-" ..XXXXXXX.XX.XXXXXX. ",
-" .XXXXXXXX.XXX.XXXXX... ",
-" ..XX..XX.XX.XXXXXXXX.XXX.. ",
-" ...XXXXXXX.XX.XXXXX.XX..X. ",
-" .XX..XXXX.XXX.XXXXX...XXX. ",
-" .XXXX..XX.XX.XXXXX..XXXXX. ",
-" .XXXXXX...XXXXXX..XXXXXXX. ..",
-" .XXXXXXXX..XXX..XXXXXXXX ....X ",
-" .XXXXXXX.XX...X.XXXXXX ...X ",
-" .XXXXX..XXXX XXX..XXX ....X ",
-" .XXXX.XXXXX . XXXX. ... . ",
-" .XXX.XXXX ... XXX .... X. ",
-" .X..XXXX ...... X .... XX. ",
-" ..XXXXXXX ...... .... .XX. ",
-" .XXXXXXXXX ......... XX... ",
-" .......................... ",
-" X.....X ",
-" X... ",
-" X.X ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_move_xpm[] = {
-"24 24 76 1",
-" c None",
-". c #010101",
-"+ c #2F2F2F",
-"@ c #E3E2E1",
-"# c #FCFCFC",
-"$ c #B3B2B1",
-"% c #95938E",
-"& c #F7F7F7",
-"* c #F5F4F2",
-"= c #F8F8F8",
-"- c #F7F6F6",
-"; c #EAE9E5",
-"> c #7B7976",
-", c #D2CFCA",
-"' c #E1E0DD",
-") c #908E8B",
-"! c #EBEAEA",
-"~ c #F1F0EE",
-"{ c #E2E0DD",
-"] c #7C7B78",
-"^ c #C6C3C0",
-"/ c #E5E3DE",
-"( c #DCDAD7",
-"_ c #8F8C88",
-": c #EBEBEA",
-"< c #EFEDEA",
-"[ c #DFDDDA",
-"} c #787774",
-"| c #C1BEBA",
-"1 c #E6E3E0",
-"2 c #EFEEEC",
-"3 c #CBCAC6",
-"4 c #ECECEC",
-"5 c #F3F2F0",
-"6 c #DCDCDC",
-"7 c #7D7C79",
-"8 c #B4B2AE",
-"9 c #E7E5E1",
-"0 c #F0EFEB",
-"a c #E4E2DD",
-"b c #9D9994",
-"c c #DBD9D6",
-"d c #747370",
-"e c #A09C97",
-"f c #DAD8D5",
-"g c #E7E6E3",
-"h c #E8E6E1",
-"i c #E0DED9",
-"j c #AFACA6",
-"k c #F7F6F4",
-"l c #D3D1CF",
-"m c #868480",
-"n c #C2BFBD",
-"o c #DAD9D5",
-"p c #F6F5F1",
-"q c #D8D6D1",
-"r c #ABA8A3",
-"s c #F9F8F6",
-"t c #F7F5F2",
-"u c #92908B",
-"v c #CCCAC5",
-"w c #EAE9E8",
-"x c #B0ADA7",
-"y c #F5F3F0",
-"z c #F7F6F2",
-"A c #F5F4F0",
-"B c #EAE8E3",
-"C c #D2D0CB",
-"D c #B9B8B6",
-"E c #CBC9C4",
-"F c #DEDBD5",
-"G c #D9D7D2",
-"H c #DAD8D3",
-"I c #D5D3CE",
-"J c #D6D4CF",
-"K c #040404",
-" ",
-" ",
-" ",
-" . . . . . . . ",
-" . . ",
-" ",
-" . . ",
-" ",
-" . . ",
-" .+........... ",
-" . .@###########$. ",
-" .#%&*=*-*-*;>,. ",
-" . .#')!~-*-*{]^/. ",
-" .#~(_:~<~[}|1/. ",
-" . . .#~23]4567890a. ",
-" .#22~b]cdefghi. ",
-" .#~2jklmnoep0q. ",
-" .#2rsskfkttuhv. ",
-" .wxsyzAtAtyBuC. ",
-" .DEFFFGHIJCCCu. ",
-" ............K ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * new_xpm[] = {
-"24 24 127 2",
-" c None",
-". c #000000",
-"+ c #D3D3D3",
-"@ c #F6F6F6",
-"# c #FFFFFF",
-"$ c #F9F9F9",
-"% c #DADADA",
-"& c #585858",
-"* c #C7C7C7",
-"= c #D1D1D1",
-"- c #D6D6D6",
-"; c #FEFEFE",
-"> c #FDFDFD",
-", c #C0C0C0",
-"' c #E1E1E1",
-") c #F0F0F0",
-"! c #9B9B9B",
-"~ c #FCFCFB",
-"{ c #FBFBFB",
-"] c #AFAFAE",
-"^ c #E9E9E9",
-"/ c #DFDFDF",
-"( c #8F8F8F",
-"_ c #FAFAF9",
-": c #F9F9F8",
-"< c #A4A4A3",
-"[ c #F4F4F4",
-"} c #CFCFCF",
-"| c #A2A2A2",
-"1 c #F8F8F7",
-"2 c #F8F7F6",
-"3 c #9E9E9E",
-"4 c #F7F6F5",
-"5 c #F6F6F4",
-"6 c #F4F3F2",
-"7 c #DEDDDC",
-"8 c #D3D2D0",
-"9 c #B7B7B5",
-"0 c #9F9E9D",
-"a c #706F6F",
-"b c #65625A",
-"c c #F5F4F3",
-"d c #F2F2F0",
-"e c #E4E4E2",
-"f c #DAD9D7",
-"g c #D8D8D6",
-"h c #CDCCCA",
-"i c #AFAEAC",
-"j c #88847B",
-"k c #F3F3F1",
-"l c #EFEFED",
-"m c #EEEDEB",
-"n c #EDECEA",
-"o c #E9E8E6",
-"p c #D5D4D3",
-"q c #C4C3C2",
-"r c #8F8A81",
-"s c #F6F5F4",
-"t c #F5F5F3",
-"u c #F1F1EF",
-"v c #F1F0EE",
-"w c #ECEBE9",
-"x c #EAE9E7",
-"y c #E5E4E2",
-"z c #E4E3E0",
-"A c #D2D1CE",
-"B c #8D887E",
-"C c #F3F2F1",
-"D c #F0F0EE",
-"E c #F0EFED",
-"F c #EFEEEC",
-"G c #E8E7E5",
-"H c #E5E4E1",
-"I c #E2E1DE",
-"J c #E1DFDC",
-"K c #979288",
-"L c #A49E93",
-"M c #E8E7E4",
-"N c #E7E6E3",
-"O c #E3E2DF",
-"P c #E2E0DD",
-"Q c #E1E0DC",
-"R c #E0DFDB",
-"S c #A19C90",
-"T c #EDEDEB",
-"U c #EBEAE8",
-"V c #E9E8E5",
-"W c #E6E4E1",
-"X c #E3E2DE",
-"Y c #DFDEDA",
-"Z c #DEDDD9",
-"` c #DDDCD8",
-" . c #A19B90",
-".. c #E7E5E2",
-"+. c #E4E3DF",
-"@. c #DCDBD7",
-"#. c #E6E5E2",
-"$. c #E5E4E0",
-"%. c #E2E1DD",
-"&. c #DBD9D5",
-"*. c #D9D7D3",
-"=. c #9F998D",
-"-. c #E4E2DF",
-";. c #DDDBD7",
-">. c #DCDAD6",
-",. c #D8D6D2",
-"'. c #9E988D",
-"). c #EDEDED",
-"!. c #E1E0DD",
-"~. c #E0DEDA",
-"{. c #D8D6D1",
-"]. c #D7D5D1",
-"^. c #9D978B",
-"/. c #E1DFDB",
-"(. c #DEDCD8",
-"_. c #D7D6D1",
-":. c #D5D3CE",
-"<. c #9B958A",
-"[. c #999891",
-"}. c #A39E92",
-"|. c #A39D92",
-"1. c #A39D91",
-"2. c #A29C90",
-"3. c #A19B8F",
-"4. c #9D978C",
-"5. c #9B968A",
-"6. c #676359",
-" ",
-" . . . . . . . . . . . . . ",
-" . + @ # # # # # # # # $ % & . ",
-" . @ # # # # # # # # # # * = - . ",
-" . # # # # # # # ; # ; > , ' ) ! . ",
-" . # # # # # ; > ~ > ~ { ] ^ # / ( . ",
-" . # # # ; > ~ { _ { _ : < ) # [ } | . ",
-" . # ; > ~ { _ : 1 : 1 2 3 . . . . . . . ",
-" . # ~ { _ : 1 2 4 2 4 5 6 7 8 9 0 a b . ",
-" . # _ : 1 2 4 5 c 5 c 6 d e f g h i j . ",
-" . # 1 2 4 5 c 6 k 6 k d l m n o p q r . ",
-" . # s t 6 6 k d u d u v m w x y z A B . ",
-" . # 6 C d D l v E v E F w G H z I J K . ",
-" . # 6 C d D l v E v E F w G H z I J L . ",
-" . # D l l F m n n n n w M N O P Q R S . ",
-" . # T n w w w U V U V V H W X Y Z ` .. ",
-" . # U o o G M M N M N ..+.X R Z ` @. .. ",
-" . # N #.#.#.H W $.W $.+.%.R Z @.&.*.=.. ",
-" . $ z O X -.+.%.X %.X Q Q Z ;.>.*.,.'.. ",
-" . ).!.J Q R %.R Q R Q Y ~.;.>.*.{.].^.. ",
-" . = /.~.Y Z R Z ~.Z ~.(.(.>.>.,._.:.<.. ",
-" . [.}.L |.1.|.S 2.S 2.3. .=.=.4.4.5.6.. ",
-" . . . . . . . . . . . . . . . . . . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * next_node2_xpm[] = {
-"24 24 18 1",
-" c None",
-". c #000000",
-"+ c #FFFFFF",
-"@ c #DADAD6",
-"# c #BCBCB8",
-"$ c #506B46",
-"% c #778E6F",
-"& c #0F1308",
-"* c #77A16E",
-"= c #C2D7BE",
-"- c #6B9060",
-"; c #A9C7A6",
-"> c #C1D6BD",
-", c #BDD3B8",
-"' c #B0CAAD",
-") c #A4C3A2",
-"! c #445B2C",
-"~ c #8CA782",
-" .................. ",
-" .+++++++++++++++@#. ",
-" .+++++++++++++++#+#. ",
-" .+++$#++++++++++#%$&. ",
-" .+++..#@++++++++@%$&. ",
-" .+++.*.#@@+@++++++@#. ",
-" .+@@.=-.#@@++@@@@@@#. ",
-".......=;-.#@@@+@@@@@#. ",
-".=>>>>>,;;-.#@@@@@@@@#. ",
-".=;;;;';;;;-.##@@@@@@#. ",
-".@>,,,>,,,,;-.#@@@@@@#. ",
-".)----------!.%#@@@@@#. ",
-".~---------!.%##@@@@##. ",
-".*--------!.$%##@@@@@#. ",
-".......--!.%####@@@@@#. ",
-" .##%.-!.$%####@@@@##. ",
-" .@##.!.%####@####@##. ",
-" .+##..%%#####@@@@@@#. ",
-" .+@#.#####@@@####@@#. ",
-" .+@@#####@@@@####@##. ",
-" .+##################. ",
-" ..................... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_next_page_xpm[] = {
-"24 24 92 2",
-" c None",
-". c #000000",
-"+ c #5B7289",
-"@ c #FFFFFF",
-"# c #F2F2F2",
-"$ c #E5E5E5",
-"% c #D8D8D8",
-"& c #CCCCCC",
-"* c #B0B0B0",
-"= c #8B8B8B",
-"- c #6A6A6A",
-"; c #494949",
-"> c #888888",
-", c #C9C9C9",
-"' c #E3E3E3",
-") c #EEEEEE",
-"! c #E6E6E6",
-"~ c #DEDEDE",
-"{ c #D6D6D6",
-"] c #ADADAD",
-"^ c #556D85",
-"/ c #47617B",
-"( c #BFBFBF",
-"_ c #B2B2B2",
-": c #ACACAC",
-"< c #A6A6A6",
-"[ c #F6F6F6",
-"} c #384F66",
-"| c #3A5067",
-"1 c #DADADA",
-"2 c #3A5168",
-"3 c #D3D3D3",
-"4 c #3B5269",
-"5 c #47617C",
-"6 c #3D526A",
-"7 c #48627D",
-"8 c #B6B6B6",
-"9 c #959595",
-"0 c #7C7C7C",
-"a c #616161",
-"b c #464646",
-"c c #262626",
-"d c #C5C5C5",
-"e c #3E546A",
-"f c #49637D",
-"g c #3F556B",
-"h c #4B647E",
-"i c #40566C",
-"j c #4C647F",
-"k c #41576D",
-"l c #4C657F",
-"m c #42586E",
-"n c #4E6780",
-"o c #44586F",
-"p c #4F6881",
-"q c #B5B5B5",
-"r c #45596F",
-"s c #506982",
-"t c #77838F",
-"u c #9C9FA1",
-"v c #91969C",
-"w c #91979C",
-"x c #92979C",
-"y c #92979D",
-"z c #A2A3A4",
-"A c #9D9FA2",
-"B c #8F9296",
-"C c #8F9396",
-"D c #8F9397",
-"E c #909397",
-"F c #868788",
-"G c #465B70",
-"H c #526A83",
-"I c #3E5975",
-"J c #3F5A76",
-"K c #415B77",
-"L c #425C78",
-"M c #435E79",
-"N c #445F7A",
-"O c #46607B",
-"P c #68727D",
-"Q c #7D8185",
-"R c #616A73",
-"S c #3B4F63",
-"T c #3C5064",
-"U c #3C5065",
-"V c #3E5166",
-"W c #3F5266",
-"X c #405367",
-"Y c #405468",
-"Z c #344353",
-"` c #2F4050",
-" ",
-" ",
-" . . . . . . . . . . . . . . . . ",
-" . + @ # $ % & * = - ; > , ' ) ! ~ { ] ^ . ",
-" . / @ # $ % & ( _ : < @ @ [ ) ! ~ { _ } . ",
-" . / @ # $ % & ( _ : < @ ' [ ) ! ~ { _ | . ",
-" . / @ # $ % & ( _ : < @ . 1 ) ! ~ { * 2 . ",
-" . / @ # $ % & ( _ : < @ . . 3 ! ~ { * 4 . ",
-" . 5 @ # $ % & ( _ : < @ . . . & ~ { * 6 . ",
-" . 7 @ # $ 8 9 0 a b c . . . . . d { * e . ",
-" . f @ # $ % & ( _ : < @ . . . & ~ { * g . ",
-" . h @ # $ % & ( _ : < @ . . 3 ! ~ { * i . ",
-" . j @ # $ % & ( _ : < @ . 1 ) ! ~ { * k . ",
-" . l @ # $ % & ( _ : < @ ' [ ) ! ~ { * m . ",
-" . n @ # $ % & ( _ : < @ @ [ ) ! ~ { * o . ",
-" . p @ # $ % & ( _ : < @ @ [ ) ! ~ { q r . ",
-" . s t u v w x y y z < A B C C D D E F G . ",
-" . H I J K L M N O P Q R S T U V W X Y Z . ",
-" . . . . . . . . . ` . . . . . . . . . . ",
-" . . . ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * next_ur_xpm[] = {
-"24 24 8 1",
-". c None",
-" c #000000000000",
-"X c #A5A5A5A59595",
-"o c #C7C7C6C6C6C6",
-"O c #FFFF00000000",
-"+ c #9A9A6C6C4E4E",
-"@ c #E1E1E0E0E0E0",
-"# c #FFFFFFFFFFFF",
-" .. .. .. .. .. .. .. ..",
-"........................",
-"............X...........",
-" .. .. .. .XXX. .. .. ..",
-".........XXooOX.........",
-".......XXooo+O@X........",
-" .. XXXoooo++@@@X. .. ..",
-"....X@Xoooooo@@@X.......",
-"....X@@Xooo@@@@@@X......",
-" .. X@@XXoo@@@@@@@X.. ..",
-"....X@@Xoo@@@@@@@@@X....",
-"....X@Xo@@@XX@@@@@@oX...",
-" .. oXoo@XXooO@@@@@@X ..",
-"....oXoXXooo+OX@@@@Xo...",
-"....XXXoooo++@@X@@Xo....",
-" .. X@Xoooooo@@@XX .. ..",
-"....X@@Xooo@@@@@@X......",
-"....X@@XXoo@@@@@@@X.....",
-" .. X@@Xoo@@@@@@@@@X. ..",
-"....X@Xo@ @@@@@@@ X...",
-"... oXoo ## @@ @@ ## ...",
-" .. oXo #### @ #### ..",
-".....oX #### @@@ #### ..",
-".....oX@ ## @@@@X ## ..."};
+++ /dev/null
-/* XPM */
-static char * stock_not_spam_xpm[] = {
-"24 24 122 2",
-" c None",
-". c #1D1E1E",
-"+ c #333839",
-"@ c #393F40",
-"# c #171819",
-"$ c #B2B8B9",
-"% c #D5E3E7",
-"& c #AABABD",
-"* c #64696A",
-"= c #0C0D0D",
-"- c #929C9E",
-"; c #E7F0F3",
-"> c #EDF0F1",
-", c #E5EDEF",
-"' c #C5D9DD",
-") c #2E3132",
-"! c #3F4343",
-"~ c #1F2121",
-"{ c #DFEBEE",
-"] c #B7C4C8",
-"^ c #D2D9DA",
-"/ c #E1EFF2",
-"( c #B6CBCF",
-"_ c #3C4547",
-": c #1E2223",
-"< c #191E1F",
-"[ c #2D2E2F",
-"} c #191A1A",
-"| c #252829",
-"1 c #7E8E92",
-"2 c #B7C2C3",
-"3 c #C3D9DD",
-"4 c #9CACB0",
-"5 c #C3CDCE",
-"6 c #C7E1E7",
-"7 c #668F97",
-"8 c #90ACB2",
-"9 c #CDDDE1",
-"0 c #485559",
-"a c #88A6AC",
-"b c #1F2223",
-"c c #3F4545",
-"d c #242728",
-"e c #313B3E",
-"f c #A8C2C8",
-"g c #B2BDC0",
-"h c #CFE5E9",
-"i c #C2D9DE",
-"j c #81989C",
-"k c #A2C0C5",
-"l c #85A9B1",
-"m c #E5ECEE",
-"n c #E7F2F4",
-"o c #9BAEB3",
-"p c #C8E1E7",
-"q c #3A3E3F",
-"r c #0C0E0E",
-"s c #000000",
-"t c #333737",
-"u c #B3C2C5",
-"v c #DDEDF0",
-"w c #D8E4E6",
-"x c #DAECEF",
-"y c #D5E9ED",
-"z c #D2E7EC",
-"A c #95ADB2",
-"B c #DBE2E2",
-"C c #EDEFF0",
-"D c #A2B1B3",
-"E c #8FA4A8",
-"F c #D7E2E5",
-"G c #798F94",
-"H c #151819",
-"I c #F3B5A7",
-"J c #865E55",
-"K c #AFB9BB",
-"L c #F1F8F9",
-"M c #F7FBFB",
-"N c #D9EBEF",
-"O c #ECF4F6",
-"P c #F3F7F7",
-"Q c #E9F2F4",
-"R c #EEF2F3",
-"S c #E9EDEE",
-"T c #C5C8C9",
-"U c #C2C6C8",
-"V c #E0E7E7",
-"W c #DDEAED",
-"X c #7A9DA5",
-"Y c #EB8169",
-"Z c #B83618",
-"` c #924E3C",
-" . c #9FA5A6",
-".. c #E3EEF0",
-"+. c #ECF5F7",
-"@. c #D6EAED",
-"#. c #CBE4E9",
-"$. c #747C7D",
-"%. c #B43518",
-"&. c #E76A4D",
-"*. c #B53F24",
-"=. c #CB705A",
-"-. c #C4D8DB",
-";. c #D2E6E9",
-">. c #CAE3E8",
-",. c #A9C8CF",
-"'. c #EC927D",
-"). c #E66F54",
-"!. c #D26951",
-"~. c #F1A897",
-"{. c #E76547",
-"]. c #C58B7D",
-"^. c #A8ABAC",
-"/. c #70A1AB",
-"(. c #DF421E",
-"_. c #C43A1A",
-":. c #E17055",
-"<. c #DD8D7A",
-"[. c #FFFFFF",
-"}. c #030505",
-"|. c #A2432E",
-"1. c #AC3316",
-" ",
-" ",
-" . + @ ",
-" # $ % & * . ",
-" = - ; > , ' ) ! ",
-" ~ { ] ^ / ( _ : < [ } ",
-" | 1 2 3 4 5 6 7 8 9 0 a b ",
-" c d e f g h i j k l m n o p q r ",
-" s t u v w / x y z A B C D E F G H ",
-" s s I J K L M N O P Q R S T U V W X < ",
-"s I Y Z ` ...+.@.#.$.s s s s s s s s s s s s ",
-"s %.&.Y *.=.-.;.>.,.s '.).).).).).).).).).).!.s ",
-"s %.%.%.&.~.{.].^./.s ).(.(.(.(.(.(.(.(.(.(._.s ",
-"s %.%.%.%.%.&.~.:.<.s ).(.[.[.(.(.(.(.[.[.(._.s ",
-" s s %.%.%.%.%.&.~.s ).(.[.[.[.(.(.[.[.[.(._.s ",
-" s s %.%.%.%.%.s ).(.(.[.[.[.[.[.[.(.(._.s ",
-" s s %.%.%.s ).(.(.(.[.[.[.[.(.(.(._.s ",
-" }.s s |.s ).(.(.(.[.[.[.[.(.(.(._.s ",
-" s s s ).(.(.[.[.[.[.[.[.(.(._.s ",
-" s ).(.[.[.[.(.(.[.[.[.(._.s ",
-" s ).(.[.[.(.(.(.(.[.[.(._.s ",
-" s ).(.(.(.(.(.(.(.(.(.(._.s ",
-" s !._._._._._._._._._._.1.s ",
-" s s s s s s s s s s s s "};
+++ /dev/null
-X-Face: $BP*2z+\?fNM."!*~JsIgw(Y]n?WG!KMc;^jL$SLrt@X4%uMguO/$3HO<5@43P@[~'kE'fG
- #YdP[sb6IJ5|Sm[z#9sI|)iJ})U5;Rt-?jI3i24zoJmonTV}kTVOm/5wMCnc3P~d#+BF1c&N6mdF{u
- CE+<;lN!v~JRyR"q0d5<\y]faXpTC4,wpQ{=<==?LRA`}3qqIgr
+++ /dev/null
-/* XPM */
-static char * open_xpm[] = {
-"24 24 173 2",
-" c None",
-". c #000000",
-"+ c #010100",
-"@ c #B5B8A5",
-"# c #E4E7D2",
-"$ c #878A76",
-"% c #33342B",
-"& c #0B0B0B",
-"* c #E2E5CF",
-"= c #CFD4AF",
-"- c #CED3AE",
-"; c #B2B696",
-"> c #2D2D25",
-", c #23241D",
-"' c #9D9F90",
-") c #C6CAA6",
-"! c #C4C9A5",
-"~ c #C6CBA7",
-"{ c #C7CCA8",
-"] c #C9CEA9",
-"^ c #555847",
-"/ c #1A1B15",
-"( c #20201A",
-"_ c #D4D6C2",
-": c #BEC2A0",
-"< c #B3B896",
-"[ c #B0B595",
-"} c #B3B797",
-"| c #B6BB99",
-"1 c #BBC09E",
-"2 c #BCC19F",
-"3 c #81856C",
-"4 c #3E3F32",
-"5 c #010101",
-"6 c #DADDC8",
-"7 c #AFB494",
-"8 c #AAAF8F",
-"9 c #A3A789",
-"0 c #A6AA8B",
-"a c #A9AD8E",
-"b c #A7AB8D",
-"c c #A4A88A",
-"d c #A1A588",
-"e c #AAAD96",
-"f c #B3B5A5",
-"g c #B8BBAA",
-"h c #BABCAB",
-"i c #C1C3B2",
-"j c #C7CAB7",
-"k c #CACDBB",
-"l c #BABDA8",
-"m c #0C0C09",
-"n c #DDDFCB",
-"o c #969B7E",
-"p c #9DA286",
-"q c #95987C",
-"r c #96997E",
-"s c #9A9D81",
-"t c #999D80",
-"u c #9DA184",
-"v c #A5AA8B",
-"w c #A4A98A",
-"x c #A3A889",
-"y c #A2A588",
-"z c #A2A587",
-"A c #9FA386",
-"B c #9B9E83",
-"C c #898D74",
-"D c #D8DBC9",
-"E c #84866E",
-"F c #7D8169",
-"G c #151612",
-"H c #D7DAC9",
-"I c #797D67",
-"J c #3D3F34",
-"K c #E0E0D9",
-"L c #EBEDDD",
-"M c #E8EBD9",
-"N c #E7EAD8",
-"O c #E3E6D4",
-"P c #DEE1D0",
-"Q c #DADCCC",
-"R c #DADCD1",
-"S c #2B2C28",
-"T c #D7DAC6",
-"U c #6F735E",
-"V c #0D0D0D",
-"W c #F4F4EC",
-"X c #CACFAB",
-"Y c #C6CBA8",
-"Z c #C2C6A4",
-"` c #ABB091",
-" . c #23251E",
-".. c #494B3D",
-"+. c #DCDCD4",
-"@. c #EAECDD",
-"#. c #CDD2AD",
-"$. c #CCD1AC",
-"%. c #CACFAA",
-"&. c #BABF9D",
-"*. c #B5B999",
-"=. c #81836C",
-"-. c #070806",
-";. c #D5D8C4",
-">. c #161616",
-",. c #F2F2EA",
-"'. c #C9CEAA",
-"). c #C8CDA9",
-"!. c #C4C9A6",
-"~. c #C1C5A3",
-"{. c #BCC09F",
-"]. c #B6BB9A",
-"^. c #B0B494",
-"/. c #9DA185",
-"(. c #535445",
-"_. c #B6B8A7",
-":. c #747470",
-"<. c #ECECE2",
-"[. c #C3C8A5",
-"}. c #C2C7A4",
-"|. c #C0C5A2",
-"1. c #BFC4A1",
-"2. c #BDC2A0",
-"3. c #B9BD9C",
-"4. c #B9BE9D",
-"5. c #A9AD8F",
-"6. c #A3A78A",
-"7. c #80836D",
-"8. c #020201",
-"9. c #A6A998",
-"0. c #B8BC9B",
-"a. c #AFB394",
-"b. c #ACB091",
-"c. c #A8AC8E",
-"d. c #A6AA8C",
-"e. c #9FA286",
-"f. c #9B9F83",
-"g. c #9A9D82",
-"h. c #8A8D75",
-"i. c #4F5243",
-"j. c #070705",
-"k. c #9E9F91",
-"l. c #E5E6DA",
-"m. c #ADB192",
-"n. c #A5A98C",
-"o. c #9FA387",
-"p. c #999D81",
-"q. c #95987E",
-"r. c #92957B",
-"s. c #8C8F76",
-"t. c #8A8D74",
-"u. c #71735F",
-"v. c #080908",
-"w. c #E3E5D9",
-"x. c #C0C3AF",
-"y. c #94987C",
-"z. c #8F9379",
-"A. c #8B8F75",
-"B. c #8A8E74",
-"C. c #888C73",
-"D. c #858970",
-"E. c #868971",
-"F. c #82866E",
-"G. c #80836C",
-"H. c #7D8069",
-"I. c #797C66",
-"J. c #727560",
-"K. c #717460",
-"L. c #71745F",
-"M. c #6A6D59",
-"N. c #434538",
-"O. c #080907",
-"P. c #050504",
-" ",
-" ",
-" ",
-" . . . . . . . ",
-" + @ # # # # # $ % ",
-" & * = = = - - ; > ",
-", ' * ) ! ~ { ] ] ^ / ",
-"( _ : < [ } | 1 2 3 4 5 . . . . . . . ",
-", 6 7 8 9 0 8 a b c d e f g h i j k l . ",
-"m n o p q r s t r u v w x y 9 z A B C . ",
-". D E F G . . . . . . . . . . . . . . . 5 5 ",
-". H I J K L M M M M M M M M M M M N O P Q R S ",
-". T U V W = = = = = = = = = - - - X Y Z 1 ` . ",
-". T ..+.@.#.- - #.- #.#.#.#.#.$.%.Y Z &.*.=.-. ",
-". ;.>.,.X %.X %.'.%.'.{ ).).Y !.~.{.].^./.(.m ",
-". _.:.<.[.}.}.Z |.Z 1.2.|.2.3.4.} [ 5.6.7.8. ",
-". 9.+.0.0.*.} } [ [ a.a.a.b.c.d.e.f.g.h.i.j. ",
-". k.l.m.5.d.n.6.6.d o.e.f.p.q.r.s.t.t.u.v. ",
-". w.x.y.z.A.B.C.C.D.E.F.G.H.I.J.K.L.M.N.O. ",
-" . . . . . . . . . . . . . . . . . . P. ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_outbox_xpm[] = {
-"24 24 69 1",
-" c None",
-". c #000000",
-"+ c #E66040",
-"@ c #EE937E",
-"# c #E55E3F",
-"$ c #E1431F",
-"% c #EC8770",
-"& c #F0A08E",
-"* c #F3B7A9",
-"= c #EF9985",
-"- c #E76749",
-"; c #ED8C75",
-"> c #F5BEB1",
-", c #F3B4A5",
-"' c #F4B8AA",
-") c #F1A593",
-"! c #E55B3B",
-"~ c #E45534",
-"{ c #F4BDB0",
-"] c #F4BAAC",
-"^ c #EF9C89",
-"/ c #E34E2B",
-"( c #C0391A",
-"_ c #8A2912",
-": c #3E3E3C",
-"< c #D4D3D2",
-"[ c #DB411D",
-"} c #F1A999",
-"| c #D23E1C",
-"1 c #812611",
-"2 c #C7C7C5",
-"3 c #ACABA8",
-"4 c #6A6966",
-"5 c #E9775D",
-"6 c #CECDCC",
-"7 c #A93217",
-"8 c #9B9A97",
-"9 c #494846",
-"0 c #9A9996",
-"a c #BBBBB9",
-"b c #747370",
-"c c #A5A4A1",
-"d c #AAA9A6",
-"e c #686765",
-"f c #7D7C79",
-"g c #686764",
-"h c #9C9B98",
-"i c #999895",
-"j c #ABAAA7",
-"k c #A9A8A5",
-"l c #AF3417",
-"m c #E55D3D",
-"n c #C5C5C3",
-"o c #8D8C89",
-"p c #626260",
-"q c #B2B1AE",
-"r c #A7A6A3",
-"s c #B4B4B2",
-"t c #C3C3C1",
-"u c #92918E",
-"v c #D1D0CF",
-"w c #373735",
-"x c #CACAC8",
-"y c #A8A7A4",
-"z c #CCCCCA",
-"A c #52514E",
-"B c #C8C8C6",
-"C c #B5B5B3",
-"D c #7E7D7A",
-" . ",
-" .. ",
-" .+. ",
-" ....@#. ",
-" .$%&*=@-. ",
-" .;>,')@@@!. ",
-" .~{]*^@@@@@-.",
-" ...@>/((((((_. ",
-" .:<.[}|((((((1. ",
-" ..234.5+(_...(1. ",
-" ..63444.@(7...._. ",
-" ..6344448.@(.90a.. ",
-".634444bcd.#$.eff.a.. ",
-".gh34bijkk.lm.iffff0a. ",
-".ggghniikdo..pddiffffq. ",
-".ggggghniikdkkkdddiffr. ",
-" ..ggggghniikdkkdddsta. ",
-" ..ggggghnurdkksvvw. ",
-" ..gggggxrdyzvA.. ",
-" ...gggB3qCA.. ",
-" ...gDv... ",
-" ..... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * paste_xpm[] = {
-"24 24 89 1",
-" c None",
-". c #000000",
-"+ c #B9B9B9",
-"@ c #FEFEFE",
-"# c #F9F9F9",
-"$ c #757575",
-"% c #F5F5E8",
-"& c #565651",
-"* c #FFFFFF",
-"= c #A0A0A0",
-"- c #939393",
-"; c #7C7C7C",
-"> c #C5C5BB",
-", c #CFC6A0",
-"' c #D7CEAA",
-") c #ADA689",
-"! c #4B483C",
-"~ c #6D6D6D",
-"{ c #6C6C6C",
-"] c #A9A9A9",
-"^ c #3D3A30",
-"/ c #979178",
-"( c #C1B898",
-"_ c #8A793D",
-": c #C3BB9A",
-"< c #AFA78A",
-"[ c #444236",
-"} c #FAFAFA",
-"| c #EFEFEF",
-"1 c #C7C7C7",
-"2 c #D8D8D8",
-"3 c #D2D2D2",
-"4 c #7B7B7B",
-"5 c #302E26",
-"6 c #89846C",
-"7 c #C4BC9A",
-"8 c #847235",
-"9 c #C5C5C5",
-"0 c #A7A7A7",
-"a c #ADADAD",
-"b c #9A9A9A",
-"c c #9B9B9B",
-"d c #868686",
-"e c #424242",
-"f c #847033",
-"g c #C9C09E",
-"h c #464337",
-"i c #35332A",
-"j c #2D2B23",
-"k c #C6BE9D",
-"l c #826F33",
-"m c #7F7964",
-"n c #4C493C",
-"o c #171612",
-"p c #13120F",
-"q c #3E3B31",
-"r c #282210",
-"s c #474438",
-"t c #B3B3B3",
-"u c #D6D6D6",
-"v c #B7AE90",
-"w c #B1AA8C",
-"x c #37352B",
-"y c #151410",
-"z c #8F8F8F",
-"A c #989898",
-"B c #C6C6C6",
-"C c #B9B293",
-"D c #11100D",
-"E c #434035",
-"F c #636363",
-"G c #767676",
-"H c #AAA48B",
-"I c #A5A086",
-"J c #A19A7F",
-"K c #312F26",
-"L c #AFA88C",
-"M c #050403",
-"N c #12110E",
-"O c #A9A489",
-"P c #A39E85",
-"Q c #EBE7D0",
-"R c #D2C9A5",
-"S c #A29053",
-"T c #8E7C3D",
-"U c #88793B",
-"V c #806C2F",
-"W c #78652B",
-"X c #251F0C",
-" .... ",
-" ......+@#$...... ",
-".%%%%%&*=-;&>%%%,. ",
-".%''')!*~{]^/(''_. ",
-".%::<[}|123456<78. ",
-".%''!900abcde!)'f. ",
-".%g:6hijjjjj56<kl. ",
-".%'''////////(''l. ",
-".%g::::mnopppp^qr.... ",
-".%'''''st***********u. ",
-".%vwwwwx*************. ",
-".%'''''y*0zzA**Bz*zB*. ",
-".%CwwwwD*************. ",
-".%'''''E*~F*GzzB*Bz**. ",
-".%HIJJJK*************. ",
-".%'''''E*0zz*zzzB*Az*. ",
-".%LIJJJM*************. ",
-".%'''''N*~F*GzzB*Bz**. ",
-".%OPJJJK*************. ",
-".Q'''''E*0zz*zzzB*Az*. ",
-".RSTUVWX*************. ",
-" .......u***********u. ",
-" ............. ",
-" "};
+++ /dev/null
-/* XPM */
-static char * post_xpm[] = {
-"24 24 8 1",
-". c None",
-" c #434343434343",
-"X c #A5A5A5A59595",
-"O c #000000000000",
-"+ c #C7C7C6C6C6C6",
-"@ c #FFFF00000000",
-"# c #9A9A6C6C4E4E",
-"$ c #E1E1E0E0E0E0",
-"O..O..O..O..O..O..O..O..",
-"........................",
-"............X...........",
-"O..O..O..O.XXX.O..O..O..",
-".........XX++@X.........",
-".......XX+++#@$X........",
-"O..OXXX++++##$$$X.O..O..",
-"....X$X++++++$$$X.......",
-"....X$$X+++$$$$$$X......",
-"O..OX$$XX++$$$$$$$X..O..",
-"....X$$X++$$$$$$$$$X....",
-"....X$X+$$$$$$$$$$$+X...",
-"O..O+X++$$$$$$$$$$$$XO..",
-"....+X+$$$$$$$$$$$$X+...",
-".....+X$$$$$$$$$$$X+....",
-"O..O.+X$$$$$$$$$XXO..O..",
-"......+X$$$$$$$X++......",
-"......+X$$$$$XX+........",
-"O..O..O+X$$$X++O..O..O..",
-".......+X$$X++..........",
-"........+XX+............",
-"O..O..O..O+.O..O..O..O..",
-"........................",
-"........................"};
+++ /dev/null
-/* XPM */
-static char * preferences_xpm[] = {
-"24 24 87 1",
-" c None",
-". c #000000",
-"+ c #BAB5AB",
-"@ c #D0CDC6",
-"# c #88857D",
-"$ c #C9C6BE",
-"% c #CCC8C1",
-"& c #E5E3E0",
-"* c #FFFFFF",
-"= c #757575",
-"- c #2E2E2E",
-"; c #F6F5F5",
-"> c #CCCCCC",
-", c #AFAFAF",
-"' c #D3D1CB",
-") c #C1C0BF",
-"! c #F0EFED",
-"~ c #797772",
-"{ c #DCDCDC",
-"] c #A5A19C",
-"^ c #EAE9E5",
-"/ c #F3F1F0",
-"( c #EDEDED",
-"_ c #A19D96",
-": c #C1BDB4",
-"< c #DBD8D3",
-"[ c #D9D6D1",
-"} c #89857E",
-"| c #FCFCFC",
-"1 c #EAE9E6",
-"2 c #F5F4F3",
-"3 c #C6C2BA",
-"4 c #F0EFEE",
-"5 c #F4F4F3",
-"6 c #CBC7C0",
-"7 c #ECECEB",
-"8 c #676560",
-"9 c #54524D",
-"0 c #777676",
-"a c #797978",
-"b c #85827E",
-"c c #79756F",
-"d c #7590AE",
-"e c #A4BAD0",
-"f c #90A6BE",
-"g c #9F9F9E",
-"h c #BEBDBC",
-"i c #B8B4AD",
-"j c #87837C",
-"k c #D3DFEA",
-"l c #A2AEBC",
-"m c #9DB6CE",
-"n c #637B95",
-"o c #E2E2E2",
-"p c #EEEEED",
-"q c #849CB6",
-"r c #D7E2ED",
-"s c #8D98A5",
-"t c #9DB8D2",
-"u c #607791",
-"v c #EDEDEC",
-"w c #99ADC3",
-"x c #DFE7F0",
-"y c #8193A9",
-"z c #586D84",
-"A c #5B7189",
-"B c #F1F1F1",
-"C c #EEEDEB",
-"D c #A7A6A5",
-"E c #726F6A",
-"F c #A1B4C8",
-"G c #EEF3F6",
-"H c #60768F",
-"I c #DEDDDC",
-"J c #787776",
-"K c #4E4E4D",
-"L c #91A6BE",
-"M c #F0F4F7",
-"N c #97A5B6",
-"O c #BFBEBD",
-"P c #AAAAA9",
-"Q c #ACACAB",
-"R c #B0C6DB",
-"S c #EDF2F6",
-"T c #818A95",
-"U c #6C85A1",
-"V c #C0D1E2",
-" .. ",
-" .+@#. ",
-" .$%+. .. ",
-" .&$. .*=. ",
-" .. -;$. .*>,. ",
-" .' ..)!+~. .{,. ",
-" .]%%^/+++. .(.. ",
-" ._:%$<[+}. .|. ",
-" .....123}..>. ",
-" .456.,. ",
-" .7.,.. ",
-" .,.89. ",
-" ....,.0abc. ",
-" .def.. .ghij. ",
-" .dklmn. .op6}. ",
-" .qrsntu. .v/$}. ",
-" .wxyztdA. .BCDE..",
-" .FGyHtdA. .IJK,.",
-" .LMNHtdA. .OPQ.",
-" .RSTtdA.. ... ",
-" .UtVLA.. ",
-" .UUn.. ",
-" ... ",
-" "};
+++ /dev/null
-/* XPM */
-static char * prev_node3_xpm[] = {
-"24 24 17 1",
-" c None",
-". c #000000",
-"+ c #0F1308",
-"@ c #FFFFFF",
-"# c #BCBCB8",
-"$ c #DADAD6",
-"% c #778E6F",
-"& c #C2D7BE",
-"* c #A6BFA0",
-"= c #A9C7A6",
-"- c #BDD3B8",
-"; c #B0CAAD",
-"> c #C1D6BD",
-", c #8CA782",
-"' c #5B7950",
-") c #6B9060",
-"! c #445B2C",
-" .................. ",
-" +@#@@@@@@@@@@@@@@$. ",
-" +@@%$@@@@@@@@@@@@@$. ",
-" .$#%%$@@@@@@@@@$.$$$. ",
-" .%$##$@@@@@@@@#..$$$. ",
-" .#@@@@@@@@@$$#.&.#$$. ",
-" .$@@@@@@@@@@#.$*.##$. ",
-" .@@@@@@@@$$#.$=*.......",
-" .@@@@@@@$$#.$==-&&&&&*.",
-" .@@@@@@@$#.@====;====%.",
-" .@$@$$$$#.$>>>>>>>>>>,.",
-" .@$@$$$$#.'))))))))))!.",
-" .@$$$$$$##.')))))))))!.",
-" .@$$$$$$##%.')))'!!!!!.",
-" .@$$$$$##$#%.')!.......",
-" .@$$$$$$$###%.'!.%%%. ",
-" .@$$#####$$##%.!.%##. ",
-" .@$$$$$$$#####%..###. ",
-" .@$$#####$$$###%.###. ",
-" .@$$$$$$$$$$$#######. ",
-" .@##################. ",
-" ..................... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * prev_ur_xpm[] = {
-"24 24 8 1",
-". c None",
-" c #000000000000",
-"X c #A5A5A5A59595",
-"o c #C7C7C6C6C6C6",
-"O c #FFFF00000000",
-"+ c #9A9A6C6C4E4E",
-"@ c #E1E1E0E0E0E0",
-"# c #FFFFFFFFFFFF",
-" .. .. .. .. .. .. .. ..",
-"........................",
-"............X...........",
-" .. .. .. .XXX. .. .. ..",
-".........XXooOX.........",
-".......XXooo+O@X........",
-" .. XXXoooo++@@@X. .. ..",
-"....X@Xoooooo@@@X.......",
-"....X@@Xooo@@@@@@X......",
-" .. X@@XXoo@@@@@@@X.. ..",
-"....X@@Xo @@@@@@ X....",
-"....X@Xo ## X @ ## X...",
-" .. oXo #XXXoO@ #### ..",
-"....oXoXXooo+OX #### ...",
-"....XXXoooo++@@X ## ....",
-" .. X@Xoooooo@@@X .. ..",
-"....X@@Xooo@@@@@@X......",
-"....X@@XXoo@@@@@@@X.....",
-" .. X@@Xoo@@@@@@@@@X. ..",
-"....X@Xo@@@@@@@@@@@@X...",
-"... oXoo@@@@@@@@@@@@X...",
-" .. oXo@@@@@@@@@@@@X....",
-".....oX@@@@@@@@@@@X.....",
-".....oX@@@@@@@@@@X......"};
+++ /dev/null
-#define preview_width 24
-#define preview_height 24
-static char preview_bits[] = {
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xc0,0x03,0x00,0x3e,0x06,0xf0,0x03,0x04,0x08,0x00,0x0a,0x78,0x00,0x09,
- 0x88,0xf9,0x08,0x10,0xc6,0x10,0x10,0x3a,0x13,0x10,0x06,0x15,0x20,0x02,0x29,
- 0x20,0x02,0x31,0x20,0xad,0x0f,0x40,0xf9,0x03,0xc0,0xb8,0x07,0x80,0x07,0x0e,
- 0x80,0x01,0x1c,0x00,0x00,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc8,0x00,
- 0x00,0x00,0x39,0x00,0x00,0x00,0x08,0xc0,0x12,0x42,0x00,0x00,0x00,0x00,0x38,
- 0x82,0x18,0x08,0x00,0x00,0x00 };
+++ /dev/null
-/* XPM */
-static char * mail_preview_xpm[] = {
-"24 24 151 2",
-" c None",
-". c #343434",
-"+ c #2D2D2D",
-"@ c #292929",
-"# c #262626",
-"$ c #2E2E2E",
-"% c #303030",
-"& c #737373",
-"* c #A1A1A1",
-"= c #B4B4B4",
-"- c #B2B2B2",
-"; c #9D9D9D",
-"> c #676767",
-", c #202020",
-"' c #1C1C1C",
-") c #272727",
-"! c #616161",
-"~ c #CACACA",
-"{ c #CFCFCF",
-"] c #D0D0D0",
-"^ c #CECECE",
-"/ c #C9C9C9",
-"( c #C1C1C1",
-"_ c #A7A7A7",
-": c #4C4C4C",
-"< c #131313",
-"[ c #222222",
-"} c #757575",
-"| c #D3D3D3",
-"1 c #DBDBDB",
-"2 c #E7E7E7",
-"3 c #EFEFEF",
-"4 c #F3F3F3",
-"5 c #F1F1F1",
-"6 c #E5E5E5",
-"7 c #D2D2D2",
-"8 c #BCBCBC",
-"9 c #5E5E5E",
-"0 c #101010",
-"a c #212121",
-"b c #5B5B5B",
-"c c #CCCCCC",
-"d c #D7D7D7",
-"e c #F5F5F5",
-"f c #FAFAFA",
-"g c #FBFBFB",
-"h c #F8F8F8",
-"i c #F0F0F0",
-"j c #E1E1E1",
-"k c #C2C2C2",
-"l c #434343",
-"m c #0F0F0F",
-"n c #1F1F1F",
-"o c #B9B9B9",
-"p c #D4D4D4",
-"q c #F7F7F7",
-"r c #F9F9F9",
-"s c #F6F6F6",
-"t c #EAEAEA",
-"u c #E2E2E2",
-"v c #ABABAB",
-"w c #0E0E0E",
-"x c #000000",
-"y c #111111",
-"z c #686868",
-"A c #9C9C9C",
-"B c #808080",
-"C c #8E8E8E",
-"D c #919191",
-"E c #929292",
-"F c #949494",
-"G c #939393",
-"H c #8B8B8B",
-"I c #838383",
-"J c #A3A3A3",
-"K c #555555",
-"L c #080808",
-"M c #535353",
-"N c #333333",
-"O c #AFAFAF",
-"P c #E6E6E6",
-"Q c #FDFDFD",
-"R c #FEFEFE",
-"S c #FCFCFC",
-"T c #A8A8A8",
-"U c #8D8D8D",
-"V c #050505",
-"W c #EEEEEE",
-"X c #A6A6A6",
-"Y c #C8C8C8",
-"Z c #FFFFFF",
-"` c #B6B6B6",
-" . c #F4F4F4",
-".. c #F2F2F2",
-"+. c #A9A9A9",
-"@. c #040404",
-"#. c #2A2A2A",
-"$. c #AAAAAA",
-"%. c #ECECEC",
-"&. c #A5A5A5",
-"*. c #C7C7C7",
-"=. c #D8D8D8",
-"-. c #CDCDCD",
-";. c #858585",
-">. c #010101",
-",. c #606060",
-"'. c #646464",
-"). c #C3C3C3",
-"!. c #DADADA",
-"~. c #494949",
-"{. c #ADADAD",
-"]. c #0A0A0A",
-"^. c #BABABA",
-"/. c #DCDCDC",
-"(. c #989898",
-"_. c #E9E9E9",
-":. c #EBEBEB",
-"<. c #A4A4A4",
-"[. c #B7B7B7",
-"}. c #D1D1D1",
-"|. c #414141",
-"1. c #3D3D3D",
-"2. c #969696",
-"3. c #A0A0A0",
-"4. c #BEBEBE",
-"5. c #D9D9D9",
-"6. c #C5C5C5",
-"7. c #515151",
-"8. c #C0C0C0",
-"9. c #959595",
-"0. c #DDDDDD",
-"a. c #484848",
-"b. c #030303",
-"c. c #454545",
-"d. c #060606",
-"e. c #B5B5B5",
-"f. c #C6C6C6",
-"g. c #C4C4C4",
-"h. c #A2A2A2",
-"i. c #828282",
-"j. c #1E1E1E",
-"k. c #191919",
-"l. c #7C7C7C",
-"m. c #E4E4E4",
-"n. c #9E9E9E",
-"o. c #525252",
-"p. c #B0B0B0",
-"q. c #6C6C6C",
-"r. c #565656",
-"s. c #797979",
-"t. c #3A3A3A",
-" ",
-" ",
-" . + @ # # # ",
-" $ % & * = - ; > , ' ",
-" ) ! = ~ { ] ^ / ( _ : < ",
-" [ } ~ | 1 2 3 4 5 6 7 8 9 0 ",
-" a b c d 6 e f g f h e i j k l m ",
-" n o p 6 q r g g f r s i t u v w ",
-" x y z A B C D E F F G G D C H I J K L ",
-"x M N O P e r g Q R R Q S f h e i T U V ",
-"x W y ~ t 5 q q g r S r f q e i X Y _ V ",
-"x Z y ` t 3 4 e s q q q s ...+.~ ] J @. ",
-"x Z #.$.v %.i .. .e e e 4 5 &.*.=.-.;.>. ",
-"x Z ,.'.1 ; %.3 i 5 5 i i T ).=.!./ ~.x ",
-"x Z {.].^./.(._.:.%.%.%.<.[.}.!.p &.>. ",
-"x Z /.|.1.7 +.2.6 6 6 3.$.4.=.5.).% x ",
-"x Z e 6.L 7.8.( 9.0.(.= Y J ).( a.b.x ",
-"x Z g d c.d.. 3.( F e.8.~ f.U + b.].x x ",
-"x Z e & ^.g.1.b.a.I h.&.i.l x j.[.k.x x x ",
-"x Z l.p m.m.Y n.o.j.b.b.j.o.n.p.q.O j.n x x ",
-"x & 8 8 8 8 8 8 &.&.&.&.&.&.&.8 8 r.x > N x x ",
-" x x x x x x x x x x x x x x x x x x x s.t.x x ",
-" x z n x ",
-" x x "};
+++ /dev/null
-/* XPM */
-static char * print_xpm[] = {
-"24 24 175 2",
-" c None",
-". c #000000",
-"+ c #C7C7C7",
-"@ c #FAFAFA",
-"# c #FCFCFC",
-"$ c #FBFBFB",
-"% c #F8F8F8",
-"& c #AFAFAF",
-"* c #F9F9F9",
-"= c #E5E5E5",
-"- c #E3E3E3",
-"; c #E2E2E2",
-"> c #E0E0E0",
-", c #DFDFDF",
-"' c #DCDCDC",
-") c #DBDBDB",
-"! c #B6B6B6",
-"~ c #6B6B6B",
-"{ c #676767",
-"] c #818181",
-"^ c #E7E7E7",
-"/ c #606060",
-"( c #A0A0A0",
-"_ c #DADADA",
-": c #E1E1E1",
-"< c #B7B7B7",
-"[ c #FDFDFD",
-"} c #EFEFEF",
-"| c #EEEEEE",
-"1 c #EDEDED",
-"2 c #ECECEC",
-"3 c #EBEBEB",
-"4 c #E9E9E9",
-"5 c #E8E8E8",
-"6 c #BFBFBF",
-"7 c #8A8A8A",
-"8 c #6A6A6A",
-"9 c #9E9E9E",
-"0 c #F6F6F6",
-"a c #909090",
-"b c #A2A2A2",
-"c c #AAAAAA",
-"d c #F4F4F4",
-"e c #CECECE",
-"f c #ADADAD",
-"g c #AEAEAE",
-"h c #BEBEBE",
-"i c #A6A6A6",
-"j c #CDCDCD",
-"k c #F5F5F5",
-"l c #DEDEDE",
-"m c #DDDDDD",
-"n c #C9C9C9",
-"o c #878787",
-"p c #888888",
-"q c #D0D0D0",
-"r c #6E6E6E",
-"s c #797979",
-"t c #D1D1D1",
-"u c #A1A1A1",
-"v c #B3B3B3",
-"w c #FFFFFF",
-"x c #CACACA",
-"y c #A7A7A7",
-"z c #A5A5A5",
-"A c #A4A4A4",
-"B c #A3A3A3",
-"C c #87847C",
-"D c #EAE8E3",
-"E c #8D8982",
-"F c #53524C",
-"G c #807D74",
-"H c #AAA9A5",
-"I c #BAB5AB",
-"J c #F3F3F3",
-"K c #C3C1BD",
-"L c #8B8B89",
-"M c #E6E5E1",
-"N c #F9F9F8",
-"O c #FAFAF9",
-"P c #F9F9F7",
-"Q c #F7F6F5",
-"R c #F7F7F4",
-"S c #F6F5F4",
-"T c #F2F1EE",
-"U c #F0EFEC",
-"V c #E5E5E4",
-"W c #9F9F9F",
-"X c #DFDED9",
-"Y c #A4A3A1",
-"Z c #6C6B6A",
-"` c #F5F4F3",
-" . c #D5D5D5",
-".. c #D3D3D3",
-"+. c #D4D4D3",
-"@. c #D4D4D4",
-"#. c #A9A9A9",
-"$. c #B5B5B5",
-"%. c #CDCDCB",
-"&. c #B5B5B4",
-"*. c #DCDAD3",
-"=. c #6B6B6A",
-"-. c #999896",
-";. c #918F87",
-">. c #999895",
-",. c #E6E4E1",
-"'. c #F0EEEC",
-"). c #FAF9F9",
-"!. c #F9F8F7",
-"~. c #F8F7F6",
-"{. c #F8F8F7",
-"]. c #F4F3F1",
-"^. c #F2F1EF",
-"/. c #565655",
-"(. c #858482",
-"_. c #9C9B99",
-":. c #6B6A68",
-"<. c #585858",
-"[. c #5E5C57",
-"}. c #524F4B",
-"|. c #4A4845",
-"1. c #4B4A46",
-"2. c #4B4946",
-"3. c #4A4844",
-"4. c #494743",
-"5. c #484642",
-"6. c #474541",
-"7. c #464440",
-"8. c #514F4B",
-"9. c #53514E",
-"0. c #7B7A77",
-"a. c #797771",
-"b. c #949391",
-"c. c #989694",
-"d. c #868480",
-"e. c #6E6C66",
-"f. c #706D67",
-"g. c #5C5955",
-"h. c #67645F",
-"i. c #5B5954",
-"j. c #585651",
-"k. c #5D5B56",
-"l. c #595652",
-"m. c #53504C",
-"n. c #575450",
-"o. c #595752",
-"p. c #5C5956",
-"q. c #5B5956",
-"r. c #61615E",
-"s. c #696861",
-"t. c #77756F",
-"u. c #7E7B77",
-"v. c #979690",
-"w. c #96938D",
-"x. c #807E77",
-"y. c #7D7A74",
-"z. c #787770",
-"A. c #716F6A",
-"B. c #6E6C67",
-"C. c #595753",
-"D. c #63615C",
-"E. c #686661",
-"F. c #6F6E68",
-"G. c #6D6C66",
-"H. c #72716B",
-"I. c #76746F",
-"J. c #6A6963",
-"K. c #8B8880",
-"L. c #B2AFA8",
-"M. c #B6B3AD",
-"N. c #BFBDB6",
-"O. c #BDBBB4",
-"P. c #B0AEA6",
-"Q. c #ABA8A2",
-"R. c #9C9991",
-" ",
-" . . . . . . . . . . . . ",
-" . + @ # # # # # # # $ % & . ",
-" . * = - - - ; > , , ' ) ! . ",
-" . # ~ { ] ^ / ( _ : > > < . ",
-" . [ } | 1 1 | 2 2 3 4 5 6 . ",
-" . [ 7 8 9 0 a b 4 c a d + . ",
-" . [ # # # # $ $ # # $ $ e . ",
-" . [ f g = h % h i j 3 # j . ",
-" . k l l l m l l , l 5 : n . ",
-" . . @ o ~ p q r s t p u q v . . ",
-" . w . x y z A z z i B b u u 9 . C . ",
-" . w D E F . . . . . . . . . . G C H I . ",
-" . w w J w w w w w w w w w w w w w w w w D . ",
-" . K L M N O N P Q R O O S T T U V D W X I . ",
-" . Y Z ` h .! ..! +.< @.#...$.%.&.*.=.-.;.. ",
-" . >.=.,.'.Q N @ ).N !.~.{.{.].].].^./.(.;.. ",
-" . _.:.<.[.}.|.1.2.2.2.3.4.5.6.4.7.8.9.0.a.. ",
-" . b.c.d.e.f.g.h.i.j.i.k.l.m.n.o.p.q.r.s.t.. ",
-" . u.v.w.;.x.y.z.t.A.t.A.B.C.D.E.F.G.H.I.J.. ",
-" . . . . . . . . . . . . . . . . . . . . ",
-" . K.L.M.N.N.N.N.N.O.P.L.Q.P.R.R.R.G G . ",
-" . . . . . . . . . . . . . . . . . . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * receipt_xpm[] = {
-"24 24 5 1",
-" c None",
-". c #FFFFFFFFFFFF",
-"X c #676766666363",
-"o c #FFFF00000000",
-"O c #AEAE3E3E4848",
-" ",
-" ",
-" .. ",
-" . ",
-" . ",
-" . ",
-" .. ",
-" Xooo .. ",
-" Xoooooooo.. ",
-" Xoooooooooooooo ... ",
-" oooooooooooOOoo . ",
-" ooooooooooOOOOo. ",
-" oooooooooOO...o ",
-" ooooooooooOOooo ",
-" ooooooooooooooo ",
-" ooooooooooooooo ",
-" oooooooooooooo ",
-" ooooooooooo ",
-" ooooooo ",
-" oooo ",
-" oo ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_redo_xpm[] = {
-"24 24 42 1",
-" c None",
-". c #000000",
-"+ c #939A8D",
-"@ c #BAD09D",
-"# c #92998C",
-"$ c #818F71",
-"% c #ADBDA0",
-"& c #C2D5AA",
-"* c #D1DFBE",
-"= c #BED2A3",
-"- c #99A28F",
-"; c #A8BCA6",
-"> c #D5E1C6",
-", c #CDDCBC",
-"' c #D2E0BF",
-") c #C5D7AE",
-"! c #919889",
-"~ c #8C9A7F",
-"{ c #D4E0C5",
-"] c #D3E0C1",
-"^ c #BFD3A6",
-"/ c #9BAA87",
-"( c #B5C3A9",
-"_ c #92AD62",
-": c #7C9B40",
-"< c #59702D",
-"[ c #7F8E6B",
-"} c #C8D9B2",
-"| c #85A24D",
-"1 c #53692A",
-"2 c #A4B690",
-"3 c #9BB572",
-"4 c #6D8839",
-"5 c #95A77E",
-"6 c #8BA859",
-"7 c #657255",
-"8 c #98AF74",
-"9 c #AFC394",
-"0 c #6D7A5B",
-"a c #9CAF84",
-"b c #748261",
-"c c #879772",
-" ",
-" ",
-" ",
-" . ",
-" .. ",
-" .+. ",
-" ....@#. ",
-" .$%&*=@-. ",
-" .;>,')@@@!. ",
-" .~{]*^@@@@@/. ",
-" .(>_::::::<. ",
-" .[}|::::::1. ",
-" .23:<...:1. ",
-" .@:4. .<. ",
-" .@:.. .. ",
-" .56. . ",
-" .78. ",
-" .9. ",
-" .0a. ",
-" .bc. ",
-" ... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * refresh_xpm[] = {
-"24 24 126 2",
-" c None",
-". c #000000",
-"+ c #F0FFEE",
-"@ c #CAE3C6",
-"# c #F5FFF4",
-"$ c #0D110C",
-"% c #729C6C",
-"& c #A6CAA1",
-"* c #CBE4C7",
-"= c #EFFDEE",
-"- c #172116",
-"; c #88B583",
-"> c #CCE5C8",
-", c #CDE6C9",
-"' c #CFE7CB",
-") c #F3FFF2",
-"! c #7FA879",
-"~ c #689063",
-"{ c #CDE5C9",
-"] c #CFE7CA",
-"^ c #D0E9CC",
-"/ c #D4EAD0",
-"( c #D5ECD1",
-"_ c #AED5A9",
-": c #9ABC95",
-"< c #63865F",
-"[ c #2B3A29",
-"} c #8CB887",
-"| c #70986A",
-"1 c #71986B",
-"2 c #729A6B",
-"3 c #759C6D",
-"4 c #759F6F",
-"5 c #76A170",
-"6 c #567453",
-"7 c #AFCBAC",
-"8 c #7EAB77",
-"9 c #78A472",
-"0 c #6F9669",
-"a c #70976A",
-"b c #71996B",
-"c c #739B6D",
-"d c #759F6E",
-"e c #77A170",
-"f c #526F4C",
-"g c #B7D2B2",
-"h c #60835B",
-"i c #A5C9A0",
-"j c #9AC195",
-"k c #4F6B4C",
-"l c #769F70",
-"m c #516D4C",
-"n c #B9D5B4",
-"o c #7BA574",
-"p c #C7E0C3",
-"q c #6D9568",
-"r c #51714E",
-"s c #B6D3B2",
-"t c #81AB7C",
-"u c #C3DBBF",
-"v c #6B9265",
-"w c #C8EFC3",
-"x c #A7CCA2",
-"y c #B5D2B1",
-"z c #80A87A",
-"A c #90B68B",
-"B c #79A674",
-"C c #C6EAC1",
-"D c #DEF7D9",
-"E c #B3D7AE",
-"F c #BBD9B8",
-"G c #AFCCAB",
-"H c #749E6D",
-"I c #5B7B57",
-"J c #8CB087",
-"K c #BBE1B6",
-"L c #DAF5D6",
-"M c #E1F7DD",
-"N c #DCF4D6",
-"O c #D7F0D3",
-"P c #CFECCB",
-"Q c #C6E3C3",
-"R c #BCD6B9",
-"S c #7EA778",
-"T c #64885F",
-"U c #A6C1A3",
-"V c #B3D5AE",
-"W c #CDEAC9",
-"X c #D0EBCB",
-"Y c #CAE9C5",
-"Z c #C7E6C3",
-"` c #C3E3BF",
-" . c #BDDCBA",
-".. c #B5D2B2",
-"+. c #96B991",
-"@. c #76A071",
-"#. c #3A4E37",
-"$. c #5E7F5A",
-"%. c #8FAF8B",
-"&. c #9CBE97",
-"*. c #C7E0C4",
-"=. c #CBE3C6",
-"-. c #CDE4C9",
-";. c #CBE4C8",
-">. c #C7E1C4",
-",. c #C2DBBF",
-"'. c #88AF82",
-"). c #6B9266",
-"!. c #557451",
-"~. c #63885E",
-"{. c #759C70",
-"]. c #749E6F",
-"^. c #72996B",
-"/. c #739A6D",
-"(. c #71996C",
-"_. c #6E9668",
-":. c #6C9367",
-"<. c #5F815A",
-"[. c #70996B",
-"}. c #6E9467",
-"|. c #698F63",
-"1. c #6B9166",
-"2. c #5D8059",
-"3. c #4D6A49",
-"4. c #6A8F64",
-"5. c #283926",
-" . ",
-" . . ",
-" . + . ",
-" . . . . @ # . ",
-" $ % & @ @ * * = . . . ",
-" - ; @ @ * * > , ' ) . . ! ~ . ",
-" . % @ * * > { ] ^ / ( _ . . : < . ",
-" [ & @ } | 1 2 3 4 5 6 . . 7 . ",
-". 8 @ 9 0 a b c d e f . . g h . ",
-". i j 0 k . . . l m . . . n o . ",
-". p q h . . r . . . . s t . ",
-". u v . . . . w . . x y z . ",
-". A B . . . C D . . . E F G H . ",
-". I J . . K L M N O P Q R S T . ",
-" . U . . V W X Y Z ` ...+.@.#.. ",
-" . $.%.. . &.*.=., -.;.>.,.'.).!.. ",
-" . ~.{.. . ].^.c /.(.| _.:.<.. . ",
-" . . . [.}.|.~ 1.2.3.. . ",
-" . q 4.. . . . ",
-" 5.).. ",
-" . . ",
-" . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_reply_to_all_xpm[] = {
-"24 24 149 2",
-" c None",
-". c #000000",
-"+ c #ADA99C",
-"@ c #E6E1D0",
-"# c #F0EAD9",
-"$ c #A9A598",
-"% c #141416",
-"& c #161618",
-"* c #080809",
-"= c #DBD6C7",
-"- c #1B1B1C",
-"; c #050505",
-"> c #5A5A5A",
-", c #676767",
-"' c #020202",
-") c #807D76",
-"! c #D49A3E",
-"~ c #D2973B",
-"{ c #040402",
-"] c #6D6B6B",
-"^ c #7A7979",
-"/ c #030100",
-"( c #040100",
-"_ c #282724",
-": c #DD9831",
-"< c #DA962F",
-"[ c #1A0E01",
-"} c #BC6D1B",
-"| c #BE6E13",
-"1 c #BE6D13",
-"2 c #BD6C13",
-"3 c #3E3C36",
-"4 c #D69029",
-"5 c #D18D27",
-"6 c #737067",
-"7 c #110900",
-"8 c #CF791C",
-"9 c #CE791C",
-"0 c #CD761A",
-"a c #C47013",
-"b c #4A4136",
-"c c #A0731E",
-"d c #96691A",
-"e c #000100",
-"f c #291703",
-"g c #BA6613",
-"h c #8C4E0D",
-"i c #844A0D",
-"j c #BF6D13",
-"k c #1F2A0D",
-"l c #306220",
-"m c #4F7242",
-"n c #448D44",
-"o c #2E802E",
-"p c #3A6F3A",
-"q c #FFFFFF",
-"r c #535353",
-"s c #171009",
-"t c #AC600C",
-"u c #713F0A",
-"v c #693A0A",
-"w c #AA5F0A",
-"x c #192B10",
-"y c #275926",
-"z c #68A769",
-"A c #358A36",
-"B c #2D812D",
-"C c #FBFBFB",
-"D c #F7F7F7",
-"E c #FAFAFA",
-"F c #F5F5F5",
-"G c #4F4F4F",
-"H c #AEAEAE",
-"I c #141517",
-"J c #6F767C",
-"K c #534C46",
-"L c #241609",
-"M c #23180E",
-"N c #484644",
-"O c #354A4D",
-"P c #050B07",
-"Q c #4F7E4F",
-"R c #399239",
-"S c #2D852D",
-"T c #297F29",
-"U c #ACACAC",
-"V c #C8C8C8",
-"W c #151618",
-"X c #6C7C8B",
-"Y c #728EA9",
-"Z c #5D6B78",
-"` c #C8CBCD",
-" . c #C3C7CD",
-".. c #8090A2",
-"+. c #5A728B",
-"@. c #4E6479",
-"#. c #111714",
-"$. c #328732",
-"%. c #2B7F2C",
-"&. c #2B772C",
-"*. c #434343",
-"=. c #A0A0A0",
-"-. c #D4D4D4",
-";. c #25282A",
-">. c #8A9EB4",
-",. c #6A86A1",
-"'. c #596A7C",
-"). c #DDE1E4",
-"!. c #DCE2E7",
-"~. c #899CAC",
-"{. c #687E96",
-"]. c #546D87",
-"^. c #10161D",
-"/. c #8C8C8C",
-"(. c #959595",
-"_. c #E4E4E4",
-":. c #23282D",
-"<. c #8096AB",
-"[. c #5D7996",
-"}. c #53687D",
-"|. c #CDD3D9",
-"1. c #CBD2DC",
-"2. c #899BAB",
-"3. c #CCD4DC",
-"4. c #5C748C",
-"5. c #111820",
-"6. c #4D4D4D",
-"7. c #818181",
-"8. c #C6C6C6",
-"9. c #1F252B",
-"0. c #6B8197",
-"a. c #536D89",
-"b. c #4A5D6F",
-"c. c #81919F",
-"d. c #8293A4",
-"e. c #5A7087",
-"f. c #496481",
-"g. c #445D79",
-"h. c #0E151B",
-"i. c #6A6A6A",
-"j. c #0E141A",
-"k. c #0D1319",
-"l. c #0E141B",
-"m. c #0E131A",
-"n. c #0F141A",
-"o. c #636363",
-"p. c #737373",
-"q. c #7C7C7C",
-"r. c #BCBCBC",
-" ",
-" . . ",
-" + @ # $ . ",
-" % & * = # # # . ",
-" - ; > , ' ) ! ~ # . ",
-" { ] ^ / ( _ : < # . ",
-" [ } | 1 2 3 4 5 # 6 ",
-" 7 8 9 0 a b c d # # . e . . . . . . ",
-" f g h i j k l m n o p . q q q q q r . ",
-" s t u v w x y z A o B . C D E F G H . ",
-" I J K L M N O P Q R S T . F F F G U V . ",
-" W X Y Z ` ...+.@.#.$.%.&.. F F *.=.-.V . ",
-" ;.>.,.'.).!.~.{.].^.. . . /.F G (.-._.V . ",
-" :.<.[.}.|.1.2.3.4.5.F F F F 6.7.8._._.V . ",
-" 9.0.a.b.c.d.e.f.g.h.F F F G i.=._.F _.V . ",
-" j.k.l.l.l.j.m.n.o.G F G (.8.p.8.F _.V . ",
-" . q C F o.8.F _.-.G U 8._.F q._._.V . ",
-" . q F p.-.F F F F _._.F F F F q._.V . ",
-" . q q.-._._._._._._._._._._._._.q.V . ",
-" . p.r.r.r.r.r.r.r.r.r.r.r.r.r.r.r.o.. ",
-" . . . . . . . . . . . . . . . . . . ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * reply_wo_xpm[] = {
-"24 24 4 1",
-" c None",
-". c #000000000000",
-"X c #E1E1E0E0E0E0",
-"O c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" .... ",
-" ..X.... ",
-" ..XX.XX.. ",
-" .O.XX.XXXX.. ",
-" ..O.XXX.XXXX... ",
-" .OO.XXXX.X....... ",
-" .OO.XXXX...XXX.OO.. ",
-" ..OO.XX....XXXX.OOOO.. ",
-" .......XX.XXXX.OOO.... ",
-" .OOO.XXX.XXXX.OO..OOO. ",
-" .OOOO....XXX....OOOOO. ",
-" .OOOOOOO..XX..OOOOOOO. ",
-" .OOOOOOO......OOOOOOO. ",
-" .OOOOOO.OO..O..OOOOOO. ",
-" .OOOOO.OOOOOOOO.OOOOO. ",
-" .OOOO.OOOOOOOOOO.OOOO. ",
-" .OOO.OOOOOOOOOOOO.OOO. ",
-" .O..OOOOOOOOOOOOOO..O. ",
-" ..OOOOOOOOOOOOOOOOOO.. ",
-" ...................... ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_reply_xpm[] = {
-"24 24 67 1",
-" c None",
-". c #000000",
-"+ c #535353",
-"@ c #FFFFFF",
-"# c #FEFEFE",
-"$ c #FDFDFD",
-"% c #FCFCFC",
-"& c #FBFBFB",
-"* c #F9F9F9",
-"= c #F8F8F8",
-"- c #F7F7F7",
-"; c #F6F6F6",
-"> c #F5F5F5",
-", c #F4F4F4",
-"' c #E3E3E3",
-") c #EEEEEE",
-"! c #4F4F4F",
-"~ c #F3F3F3",
-"{ c #F2F2F2",
-"] c #F1F1F1",
-"^ c #F0F0F0",
-"/ c #EFEFEF",
-"( c #EDEDED",
-"_ c #AEAEAE",
-": c #E4E4E4",
-"< c #434343",
-"[ c #ACACAC",
-"} c #C8C8C8",
-"| c #A0A0A0",
-"1 c #D4D4D4",
-"2 c #ECECEC",
-"3 c #959595",
-"4 c #3E3E3E",
-"5 c #4D4D4D",
-"6 c #818181",
-"7 c #C6C6C6",
-"8 c #3D1A13",
-"9 c #6A6A6A",
-"0 c #636363",
-"a c #B9B9B9",
-"b c #737373",
-"c c #EAC0BA",
-"d c #7C7C7C",
-"e c #DF9E95",
-"f c #E0A198",
-"g c #E1A59D",
-"h c #E2A79E",
-"i c #E3ABA3",
-"j c #E3AAA2",
-"k c #CC6253",
-"l c #DD978D",
-"m c #DF9F97",
-"n c #DE9A90",
-"o c #DD968C",
-"p c #DD948A",
-"q c #B14334",
-"r c #BCBCBC",
-"s c #431913",
-"t c #EAC2BC",
-"u c #DF9C92",
-"v c #DD998F",
-"w c #B54535",
-"x c #65261D",
-"y c #983A2C",
-"z c #7C2F24",
-"A c #63251D",
-"B c #6C291F",
-" ",
-" ",
-" ",
-" ................. ",
-" .+@@@@#$%&*=-;>,'+. ",
-" .)!@>,~{{]^^/)('!_. ",
-" .@:<$~{{]^/))('![}. ",
-" .@>:!&]^^/)(('<|1}. ",
-" .@&>:<=^/)(2'!31:}. ",
-" .@>>>:4>)(2'567::}. ",
-" .@&8>:9<~2'!977>:}. ",
-" .@..:0@a!^!37b7>:}. ",
-" ..c.0@>:1![7::d::}. ",
-" .ce.......:>>>:d:}. ",
-" .cfghihjek.::::::d}. ",
-" .clmenoonpq.rrrrrrr0. ",
-"stnuvvlnnnnw.......... ",
-" .xyyyyyyyyz. ",
-" .xyyAAAAAB. ",
-" .xy....... ",
-" .x. ",
-" .. ",
-" . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * reverse_smile_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++.....+++.",
-".++.+++++.++.",
-".++.+++++.++.",
-".+++++++++++.",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * right_arrow_xpm[] = {
-"24 24 41 1",
-" c None",
-". c #000000",
-"+ c #8CA782",
-"@ c #B1CDAE",
-"# c #77A16E",
-"$ c #B4CEB1",
-"% c #ACC8A9",
-"& c #709867",
-"* c #C1D6BD",
-"= c #BDD3B8",
-"- c #BFD4BB",
-"; c #C2D7BE",
-"> c #B0CAAD",
-", c #B2CBB0",
-"' c #AAC7A8",
-") c #0F1308",
-"! c #AEC5A8",
-"~ c #AEC8AD",
-"{ c #ABC7A8",
-"] c #AAC6A7",
-"^ c #A8C6A5",
-"/ c #ADC8AD",
-"( c #A8C7A8",
-"_ c #A5C4A3",
-": c #7F9F76",
-"< c #A6BFA0",
-"[ c #ABC7AA",
-"} c #A7C5A4",
-"| c #A9C7A6",
-"1 c #AFC8AD",
-"2 c #A4C3A2",
-"3 c #6B9060",
-"4 c #778E6F",
-"5 c #698D60",
-"6 c #6B9063",
-"7 c #445B2C",
-"8 c #6B8661",
-"9 c #5B7950",
-"0 c #6C8562",
-"a c #65815C",
-"b c #506B46",
-" ",
-" ",
-" ",
-" . ",
-" .. ",
-" .+. ",
-" .@#. ",
-" ........$%&. ",
-" .*=-;;;;>,'&) ",
-" .!~{{{]^'/(_:. ",
-" .<[^}^|{%'{123. ",
-" .45666666666657. ",
-" .8999999999997. ",
-" .099999999997. ",
-" .abbbbbb9997. ",
-" ........b97. ",
-" .b7. ",
-" .7. ",
-" .. ",
-" . ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * rot13_xpm[] = {
-"24 24 101 2",
-" g None",
-". g #000000",
-"+ g #212121",
-"@ g #9E9E9E",
-"# g #E6E6E6",
-"$ g #E7E7E7",
-"% g #C8C8C8",
-"& g #A0A0A0",
-"* g #131313",
-"= g #5F5F5F",
-"- g #EDEDED",
-"; g #D6D6D6",
-"> g #D5D5D5",
-", g #DDDDDD",
-"' g #D8D8D8",
-") g #A1A1A1",
-"! g #3C3C3C",
-"~ g #353535",
-"{ g #EFEFEF",
-"] g #CFCFCF",
-"^ g #4C4C4C",
-"/ g #141414",
-"( g #6A6A6A",
-"_ g #D0D0D0",
-": g #B2B2B2",
-"< g #454545",
-"[ g #E2E2E2",
-"} g #292929",
-"| g #0F0F0F",
-"1 g #949494",
-"2 g #E9E9E9",
-"3 g #C3C3C3",
-"4 g #1C1C1C",
-"5 g #E1E1E1",
-"6 g #272727",
-"7 g #DEDEDE",
-"8 g #B6B6B6",
-"9 g #0C0C0C",
-"0 g #262626",
-"a g #1F1F1F",
-"b g #616161",
-"c g #5B5B5B",
-"d g #232323",
-"e g #111111",
-"f g #181818",
-"g g #3D3D3D",
-"h g #636363",
-"i g #545454",
-"j g #2E2E2E",
-"k g #242424",
-"l g #070707",
-"m g #DCDCDC",
-"n g #D3D3D3",
-"o g #C5C5C5",
-"p g #C2C2C2",
-"q g #BFBFBF",
-"r g #B5B5B5",
-"s g #696969",
-"t g #ACACAC",
-"u g #999999",
-"v g #8F8F8F",
-"w g #868686",
-"x g #686868",
-"y g #B1B1B1",
-"z g #9A9A9A",
-"A g #909090",
-"B g #878787",
-"C g #DBDBDB",
-"D g #A6A6A6",
-"E g #979797",
-"F g #8A8A8A",
-"G g #8D8D8D",
-"H g #838383",
-"I g #666666",
-"J g #BBBBBB",
-"K g #9F9F9F",
-"L g #8B8B8B",
-"M g #828282",
-"N g #676767",
-"O g #A3A3A3",
-"P g #8E8E8E",
-"Q g #888888",
-"R g #8C8C8C",
-"S g #BABABA",
-"T g #818181",
-"U g #757575",
-"V g #DADADA",
-"W g #AFAFAF",
-"X g #848484",
-"Y g #7F7F7F",
-"Z g #7B7B7B",
-"` g #B8B8B8",
-" . g #D9D9D9",
-".. g #ABABAB",
-"+. g #929292",
-"@. g #939393",
-"#. g #808080",
-"$. g #919191",
-"%. g #ADADAD",
-"&. g #969696",
-"*. g #4A4A4A",
-" ",
-" ",
-" . . . . . ",
-" . + @ # $ % & * ",
-" . = - # ; > , ' ) ! . ",
-" ~ { ] ^ . . / ( _ : < ",
-" . [ ' } . | ( % 1 . ",
-" * 2 3 . 4 5 @ . ",
-" 6 7 8 . . $ 8 . ",
-" 9 0 a b c d e 6 a f a g h i j k l ",
-" . 7 m ' ; n o p p p p q r r r s . ",
-" . 7 p 8 : t t t t t t t u v w x . ",
-" . m p 8 y t t t t t t t z A B s . ",
-" . C p r D E E E E E E A F G H I . ",
-" . , p 8 J t t t t t t t K L M N . ",
-" . m p y O E E E E E E P Q R H ( . ",
-" . m p r S t t t t t t t K L T U . ",
-" . V p W & E E E E E E F X B Y Z . ",
-" . C p y ` t t t t t t t K F B T . ",
-" . .p W ..E E E E E E E +.G @.#.. ",
-" . $.%.z &.A L F F G $.A A P X *.. ",
-" . . . . . . . . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * save_aif_xpm[] = {
-"24 24 6 1",
-" c None",
-". c #999999999999",
-"X c #E1E1E0E0E0E0",
-"o c #C7C7C6C6C6C6",
-"O c #000000000000",
-"+ c #FFFFFFFFFFFF",
-" ",
-" ",
-" ............. ",
-" .XXXXXXXXXX.X.. ",
-" .XXXXXXXXXX.XX. ",
-" .XXXXXXXXXX.... ",
-" .XXXXXXXXXXooo. ",
-" .XXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" OOOOOOOOOOOOOOXXXXXX. ",
-" O..O+++++++O.OXXXXXX. ",
-" O..O+++++++O.OXXXXXX. ",
-" O..O+++++++O.OXXXXXX. ",
-" O..O+++++++O.OXXXXXX. ",
-" O..O+++++++O.OXXXXXX. ",
-" O..OOOOOOOOO.OXXXXXX. ",
-" O............OXXXXXX. ",
-" O............OXXXXXX. ",
-" O..OOOOOOOOO.O....... ",
-" O..OoooooO++.O ",
-" O..OoooooO++.O ",
-" O.OoooooO++.O ",
-" OOOOOOOOOOOO "};
+++ /dev/null
-/* XPM */
-static char * save_art_xpm[] = {
-"24 24 5 1",
-" c None",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #C7C7C6C6C6C6",
-" ",
-" ",
-" .................. ",
-" ...XXXXXXXXXXXXX.. ",
-" .XX..XXXXXXXXX..X. ",
-" .XXXX..XXXXX..XXX. ",
-" .XXXXX......XXXXX. ",
-" .XXX..XX..XX..XXX. ",
-" .XX..XXXXXXXX..XX. ",
-" ...XXXXXXXXXXXX... ",
-" ..............XXXXXXX. ",
-" .oo.XXXXXXX.o......... ",
-" .oo.XXXXXXX.o. ",
-" .oo.XXXXXXX.o. ",
-" .oo.XXXXXXX.o. ",
-" .oo.XXXXXXX.o. ",
-" .oo.........o. ",
-" .oooooooooooo. ",
-" .oooooooooooo. ",
-" .oo.........o. ",
-" .oo.OOOOO.XXo. ",
-" .oo.OOOOO.XXo. ",
-" .o.OOOOO.XXo. ",
-" ............ "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_handling_xpm[] = {
-"24 24 72 1",
-" c None",
-". c #000000",
-"+ c #BCBCBC",
-"@ c #FFFFFF",
-"# c #535353",
-"$ c #EEEEEE",
-"% c #4F4F4F",
-"& c #F5F5F5",
-"* c #FBFBFB",
-"= c #F7F7F7",
-"- c #FAFAFA",
-"; c #AEAEAE",
-"> c #E4E4E4",
-", c #434343",
-"' c #ACACAC",
-") c #C8C8C8",
-"! c #A0A0A0",
-"~ c #D4D4D4",
-"{ c #959595",
-"] c #3E3E3E",
-"^ c #4D4D4D",
-"/ c #818181",
-"( c #C6C6C6",
-"_ c #6A6A6A",
-": c #636363",
-"< c #B9B9B9",
-"[ c #737373",
-"} c #010101",
-"| c #AAAAAA",
-"1 c #0B0B0B",
-"2 c #0C0C0C",
-"3 c #060606",
-"4 c #E4E3E1",
-"5 c #050505",
-"6 c #B3B3B1",
-"7 c #484641",
-"8 c #9F9D96",
-"9 c #888781",
-"0 c #7C7C7C",
-"a c #B0AFAD",
-"b c #A8A7A1",
-"c c #908E86",
-"d c #97958E",
-"e c #807D74",
-"f c #969696",
-"g c #090909",
-"h c #595854",
-"i c #605E57",
-"j c #898883",
-"k c #76746B",
-"l c #43423F",
-"m c #282724",
-"n c #363430",
-"o c #6D6B63",
-"p c #E2E2E1",
-"q c #B6B5AF",
-"r c #21201E",
-"s c #0A0908",
-"t c #181816",
-"u c #E6E6E4",
-"v c #65635C",
-"w c #161614",
-"x c #8C8B89",
-"y c #DFDEDC",
-"z c #B0AFA9",
-"A c #D5D4D1",
-"B c #93918B",
-"C c #D6D5D2",
-"D c #ABA9A3",
-"E c #5D5C55",
-"F c #494943",
-"G c #42413C",
-" ",
-" ................. ",
-" .+@@@@@@@@@@@@@@@#. ",
-" .$%&*&*=*&*&*=-&%;. ",
-" .@>,&&&&&&&&&&&%'). ",
-" .@&>%&&&&&&&&&,!~). ",
-" .@*&>,&&&&&&&%{~>). ",
-" .@&&&>]&&&&&^/(>>). ",
-" .@*&&&_,&&&%_!>&>). ",
-" .@&&&:<<%&%{([(}}}. ",
-" .@*&:(&>~%'|12:345... ",
-" .@&[~&&&&>>2>62787.9.. ",
-" .@0~>>>>>>>1ab888cde7. ",
-" .[+++++++++fg88hijek. ",
-" ...........78ilmn8o7..",
-" .pq8hrstuevi.",
-" ..78jnwxyv7..",
-" .zequABv. ",
-" .CD8eekkE7. ",
-" ..h.7k7.F.. ",
-" .. .G. .. ",
-" ... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * mail_save_xpm[] = {
-"24 24 264 2",
-" c None",
-". c #000000",
-"+ c #141414",
-"@ c #262626",
-"# c #212121",
-"$ c #1F1F1F",
-"% c #1E1E1E",
-"& c #1D1D1D",
-"* c #202020",
-"= c #232323",
-"- c #292929",
-"; c #171717",
-"> c #121212",
-", c #B8B8B8",
-"' c #FFFFFF",
-") c #A8A8A8",
-"! c #0E0E0E",
-"~ c #595959",
-"{ c #444444",
-"] c #4F4F4F",
-"^ c #050505",
-"/ c #222222",
-"( c #3D3D3D",
-"_ c #FEFEFE",
-": c #FCFCFC",
-"< c #FDFDFD",
-"[ c #CACACA",
-"} c #191919",
-"| c #B3B1B0",
-"1 c #EEECEB",
-"2 c #F0DCAA",
-"3 c #E5C470",
-"4 c #DFB84F",
-"5 c #8A681F",
-"6 c #100E09",
-"7 c #FBFBFB",
-"8 c #515151",
-"9 c #F0F0F0",
-"0 c #D6D6D6",
-"a c #EEECE9",
-"b c #E6D498",
-"c c #EED682",
-"d c #EED680",
-"e c #E3C15E",
-"f c #D29815",
-"g c #976E15",
-"h c #7F5B0A",
-"i c #1C190F",
-"j c #D9D9D9",
-"k c #424242",
-"l c #F1F1F1",
-"m c #F3F3F3",
-"n c #EBE9E5",
-"o c #CBB771",
-"p c #735817",
-"q c #C6A546",
-"r c #E3C05D",
-"s c #BC8710",
-"t c #AD7C10",
-"u c #6B6B6B",
-"v c #A0A0A0",
-"w c #535353",
-"x c #505050",
-"y c #AE9C5C",
-"z c #292928",
-"A c #CECDCA",
-"B c #CAC9C7",
-"C c #1A1917",
-"D c #9C7E2B",
-"E c #AB7C12",
-"F c #242012",
-"G c #555555",
-"H c #DEDEDE",
-"I c #E8E8E8",
-"J c #3B3B3B",
-"K c #D7D6D6",
-"L c #656462",
-"M c #DAD9D7",
-"N c #E1E0DF",
-"O c #1A1A19",
-"P c #3D351F",
-"Q c #A37819",
-"R c #231F13",
-"S c #282828",
-"T c #898989",
-"U c #EFEFEF",
-"V c #FAFAFA",
-"W c #E8E7E6",
-"X c #8B8B8A",
-"Y c #0B0B06",
-"Z c #A97C1A",
-"` c #1B1B1B",
-" . c #C9C9C9",
-".. c #DFDFDF",
-"+. c #EBEBEB",
-"@. c #ECECEC",
-"#. c #E1E1E1",
-"$. c #221E11",
-"%. c #EAE8E3",
-"&. c #C58F13",
-"*. c #B68411",
-"=. c #826321",
-"-. c #302C19",
-";. c #131313",
-">. c #1A1A1A",
-",. c #161616",
-"'. c #151515",
-"). c #181818",
-"!. c #1B1B1A",
-"~. c #141413",
-"{. c #363220",
-"]. c #916F25",
-"^. c #322F1E",
-"/. c #98B4C8",
-"(. c #25313B",
-"_. c #A9CCE0",
-":. c #545A68",
-"<. c #BC6A60",
-"[. c #AD5A51",
-"}. c #A4574D",
-"|. c #2B2719",
-"1. c #353120",
-"2. c #5A4D51",
-"3. c #6E8DA2",
-"4. c #0C1820",
-"5. c #BAE5FF",
-"6. c #696E6F",
-"7. c #F9F9F9",
-"8. c #EBEBEA",
-"9. c #937025",
-"0. c #CDCAC1",
-"a. c #73726E",
-"b. c #7496AF",
-"c. c #0A131A",
-"d. c #BAE0FD",
-"e. c #6A6E71",
-"f. c #ECEDEC",
-"g. c #DEDFDF",
-"h. c #DBDDDD",
-"i. c #D8DBDB",
-"j. c #CDCFCF",
-"k. c #312E1B",
-"l. c #2F2C19",
-"m. c #B2B3B0",
-"n. c #C0C0BE",
-"o. c #6F6D6B",
-"p. c #7C9FBB",
-"q. c #050F15",
-"r. c #B7DDFC",
-"s. c #54575A",
-"t. c #F4F4F3",
-"u. c #ECECEB",
-"v. c #F3F3F2",
-"w. c #7F7D7A",
-"x. c #7EA0BB",
-"y. c #020A10",
-"z. c #B1D7F7",
-"A. c #FDFCFB",
-"B. c #EFEFEE",
-"C. c #EDEDEC",
-"D. c #EBECEB",
-"E. c #EBECEC",
-"F. c #F7F7F6",
-"G. c #7D7977",
-"H. c #7F9FB9",
-"I. c #050B0E",
-"J. c #B3DDF7",
-"K. c #685050",
-"L. c #847F7C",
-"M. c #7E9DB7",
-"N. c #0A0B0C",
-"O. c #A9D3F0",
-"P. c #7B99AB",
-"Q. c #6B6E70",
-"R. c #63696C",
-"S. c #60666B",
-"T. c #5E6569",
-"U. c #555E67",
-"V. c #5D6267",
-"W. c #61676B",
-"X. c #64696D",
-"Y. c #62666A",
-"Z. c #6B747E",
-"`. c #7D9CB4",
-" + c #000508",
-".+ c #A8CBED",
-"++ c #7498B7",
-"@+ c #6F92B0",
-"#+ c #3F5160",
-"$+ c #4A5E70",
-"%+ c #566E82",
-"&+ c #4D6779",
-"*+ c #52697C",
-"=+ c #52697A",
-"-+ c #54687A",
-";+ c #455E70",
-">+ c #7697B4",
-",+ c #92A9BC",
-"'+ c #000205",
-")+ c #A8CEEB",
-"!+ c #7196B3",
-"~+ c #4D5152",
-"{+ c #D7D2CB",
-"]+ c #F1EEEA",
-"^+ c #FAF8F5",
-"/+ c #F9F8F5",
-"(+ c #E8E4DF",
-"_+ c #D8D4CD",
-":+ c #9D968B",
-"<+ c #425563",
-"[+ c #446783",
-"}+ c #A7C4DA",
-"|+ c #000101",
-"1+ c #A5CDEA",
-"2+ c #7196B1",
-"3+ c #57595C",
-"4+ c #534F46",
-"5+ c #2E281F",
-"6+ c #CAC7C2",
-"7+ c #C9C4BD",
-"8+ c #C2BBB1",
-"9+ c #E3E0DC",
-"0+ c #314353",
-"a+ c #40647C",
-"b+ c #B6C9DA",
-"c+ c #A3CDEB",
-"d+ c #7695B1",
-"e+ c #525455",
-"f+ c #474239",
-"g+ c #3B372D",
-"h+ c #C0BCB5",
-"i+ c #C7C2BA",
-"j+ c #E2DFD9",
-"k+ c #F8F6F3",
-"l+ c #344652",
-"m+ c #406479",
-"n+ c #A6C3DA",
-"o+ c #010000",
-"p+ c #708798",
-"q+ c #6A8DA7",
-"r+ c #4F5052",
-"s+ c #F7F2EC",
-"t+ c #59534B",
-"u+ c #57524A",
-"v+ c #C1BCB4",
-"w+ c #EBE9E4",
-"x+ c #FFFFFD",
-"y+ c #30414E",
-"z+ c #415C6F",
-"A+ c #A2C4DC",
-"B+ c #020000",
-"C+ c #030406",
-"D+ c #141A1F",
-"E+ c #151718",
-"F+ c #35332F",
-"G+ c #393634",
-"H+ c #41403E",
-"I+ c #3F3E3D",
-"J+ c #454344",
-"K+ c #434241",
-"L+ c #312F2C",
-"M+ c #02070A",
-"N+ c #070E12",
-"O+ c #465A69",
-". + @ # $ % & & & % * = - ; . ",
-"> , ' ' ' ' ' ' ' ' ' ' ' ) ! ",
-"@ ' ~ ' ' ' ' ' ' ' ' ' { ] ^ . . . ",
-"/ ' ' ( ' _ : < < ' [ } | 1 2 3 4 5 . 6 ",
-"* ' ' 7 8 9 < 7 _ 0 @ a b c d d e f g h i ",
-"$ ' ' ' j k l : m $ n o . . . p q r s t i ",
-"* ' ' ' u v w ' x . y z A B C D d f E F ",
-"/ ' ' G H 7 I J , K > L M N O P d f Q R ",
-"S ' T U ' ' ' _ V ' < W X Y . . . d f Z . . . ",
-"` ...U +.+.+.@.@.+.@.+.#.$.%.d d d f &.*.=.-.. ",
-". ;.>.; ,.'.'.'.'.'.,.).!.~.{.%.d d f f ].^./.(.",
-" . _.:.<.[.}.|.%.d f ].1.2.3.4.",
-" . 5.6.' ' 7.8.-.%.9.^.0.a.b.c.",
-" . d.e.f.g.h.i.j.k.l.m.n.o.p.q.",
-" . r.s.' ' ' ' ' ' t.u.v.w.x.y.",
-" . z.6.A.B.C.D.+.E.C.U F.G.H.I.",
-" . J.K.' ' ' ' ' ' ' ' ' L.M.N.",
-" . O.P.Q.R.S.T.U.V.W.X.Y.Z.`. +",
-" . .+++@+#+$+%+&+*+=+-+;+>+,+'+",
-" . )+!+~+{+]+^+/+(+_+:+<+[+}+|+",
-" . 1+2+3+' 4+5+6+7+8+9+0+a+b+. ",
-" . c+d+e+' f+g+h+i+j+k+l+m+n+o+",
-" . p+q+r+s+t+u+v+w+x+]+y+z+A+B+",
-" C+D+E+F+G+H+I+J+K+L+M+N+O+. "};
+++ /dev/null
-/* XPM */
-static char * saveas_xpm[] = {
-"24 24 262 2",
-" c None",
-". c #000000",
-"+ c #FBE73B",
-"@ c #F2B64D",
-"# c #FCEB3D",
-"$ c #F7B544",
-"% c #5D502C",
-"& c #C3D7F4",
-"* c #A9CDE5",
-"= c #75757A",
-"- c #EFC5BB",
-"; c #F1C8BE",
-"> c #F0C6BC",
-", c #EEBCB2",
-"' c #EEBEB5",
-") c #EEC1B8",
-"! c #EDBFB6",
-"~ c #E8B6AC",
-"{ c #FCE93B",
-"] c #F7B545",
-"^ c #6C5F34",
-"/ c #434345",
-"( c #92A7B9",
-"_ c #96B1C7",
-": c #BBD6E8",
-"< c #8AAAC5",
-"[ c #605F68",
-"} c #E08D7E",
-"| c #E0826E",
-"1 c #E0806E",
-"2 c #DC7A68",
-"3 c #DC8171",
-"4 c #DA7868",
-"5 c #D38072",
-"6 c #FAE43A",
-"7 c #F4B244",
-"8 c #615030",
-"9 c #783E35",
-"0 c #4D4C52",
-"a c #7790A2",
-"b c #526D82",
-"c c #BAD5E9",
-"d c #88A7C3",
-"e c #686670",
-"f c #C8817B",
-"g c #CB7C74",
-"h c #CB7A73",
-"i c #CB7B73",
-"j c #CC7C72",
-"k c #CA7C72",
-"l c #F9DF39",
-"m c #F3AF42",
-"n c #614F2F",
-"o c #8F4941",
-"p c #945554",
-"q c #5B5A62",
-"r c #7B97AE",
-"s c #536F84",
-"t c #B6D3E7",
-"u c #87ABC1",
-"v c #737373",
-"w c #FFFFFF",
-"x c #FEFEFE",
-"y c #F9DC38",
-"z c #EFB44D",
-"A c #665A32",
-"B c #BBBBBB",
-"C c #CDCDCD",
-"D c #E4E4E4",
-"E c #6E6E6E",
-"F c #819EB6",
-"G c #526C80",
-"H c #B9D3E7",
-"I c #85A4BF",
-"J c #F8D837",
-"K c #F0A93F",
-"L c #655930",
-"M c #BABABA",
-"N c #CCCCCC",
-"O c #E5E5E5",
-"P c #F7F7F7",
-"Q c #727272",
-"R c #83A0B8",
-"S c #4F697C",
-"T c #B9D3E6",
-"U c #84A3BF",
-"V c #CECECE",
-"W c #F6D236",
-"X c #EDA43E",
-"Y c #5C5130",
-"Z c #949494",
-"` c #A3A3A3",
-" . c #B7B7B7",
-".. c #C6C6C6",
-"+. c #BDBDBD",
-"@. c #88A4BB",
-"#. c #486276",
-"$. c #B7D2E7",
-"%. c #82A0BB",
-"&. c #636363",
-"*. c #FDFDFD",
-"=. c #D7AE74",
-"-. c #61562F",
-";. c #465E70",
-">. c #B5CAE5",
-",. c #7FA2B9",
-"'. c #4F4115",
-"). c #87A3BA",
-"!. c #455C6D",
-"~. c #AECCE5",
-"{. c #7DA0B6",
-"]. c #CBCBCB",
-"^. c #9B9B9B",
-"/. c #9C9C9C",
-"(. c #A7A7A7",
-"_. c #B8B8B8",
-":. c #C5C5C5",
-"<. c #546069",
-"[. c #B0D1E4",
-"}. c #83A1B6",
-"|. c #735B5B",
-"1. c #F0F0F0",
-"2. c #D9D9D9",
-"3. c #D3D3D3",
-"4. c #E1E1E1",
-"5. c #EDEDED",
-"6. c #F8F8F8",
-"7. c #515C64",
-"8. c #AACEE3",
-"9. c #7B9BB2",
-"0. c #7A8E9A",
-"a. c #7A7A7A",
-"b. c #707070",
-"c. c #6C6C6C",
-"d. c #6F6F6F",
-"e. c #6A6E71",
-"f. c #696969",
-"g. c #6F777E",
-"h. c #86A2B9",
-"i. c #3A515D",
-"j. c #A9C9E2",
-"k. c #7494AF",
-"l. c #7E9BB4",
-"m. c #7D9AB3",
-"n. c #7998B2",
-"o. c #85A1B8",
-"p. c #829FB7",
-"q. c #8CA7BD",
-"r. c #8AA5BB",
-"s. c #364A59",
-"t. c #ABC4E2",
-"u. c #7294AD",
-"v. c #6F90AC",
-"w. c #7192AE",
-"x. c #414A4E",
-"y. c #424A51",
-"z. c #525B63",
-"A. c #626F79",
-"B. c #5F6C76",
-"C. c #5C6971",
-"D. c #5A666F",
-"E. c #58636B",
-"F. c #57636A",
-"G. c #3B5360",
-"H. c #39424B",
-"I. c #7897B3",
-"J. c #A4B9CB",
-"K. c #364853",
-"L. c #AAC9E2",
-"M. c #7091AA",
-"N. c #6F8FA7",
-"O. c #4A5359",
-"P. c #97938C",
-"Q. c #DFDDDA",
-"R. c #E3E1DE",
-"S. c #EBEAE8",
-"T. c #EAE9E7",
-"U. c #CFCEC9",
-"V. c #C9C6C0",
-"W. c #9B968E",
-"X. c #566168",
-"Y. c #4B657A",
-"Z. c #54738C",
-"`. c #AAC6DD",
-" + c #34464E",
-".+ c #AAC9E1",
-"++ c #6C8EA6",
-"@+ c #6C8CA4",
-"#+ c #40474D",
-"$+ c #DAD8D3",
-"%+ c #E7E6E2",
-"&+ c #67655E",
-"*+ c #524F47",
-"=+ c #D9D7D4",
-"-+ c #C7C5BF",
-";+ c #C0BCB5",
-">+ c #B8B3AB",
-",+ c #434C54",
-"'+ c #4D697F",
-")+ c #4F6F84",
-"!+ c #B3CADC",
-"~+ c #313E49",
-"{+ c #A8C8E1",
-"]+ c #6B8DA6",
-"^+ c #728FA4",
-"/+ c #E2E1DD",
-"(+ c #F0EFEC",
-"_+ c #CDCAC6",
-":+ c #C2BFB9",
-"<+ c #CAC6C0",
-"[+ c #DCDAD7",
-"}+ c #4B555D",
-"|+ c #4E697F",
-"1+ c #BACCDC",
-"2+ c #A4C4DE",
-"3+ c #698BA3",
-"4+ c #708AA1",
-"5+ c #383E43",
-"6+ c #E0DEDA",
-"7+ c #514E46",
-"8+ c #4F4C44",
-"9+ c #C7C4BE",
-"0+ c #CBC8C2",
-"a+ c #E1E0DC",
-"b+ c #E9E8E6",
-"c+ c #475158",
-"d+ c #4E6879",
-"e+ c #4D6C80",
-"f+ c #A3C3DB",
-"g+ c #383F43",
-"h+ c #778999",
-"i+ c #6E899E",
-"j+ c #65859C",
-"k+ c #33383C",
-"l+ c #D7D4D0",
-"m+ c #D6D4D0",
-"n+ c #4E4A43",
-"o+ c #4D4942",
-"p+ c #D1CEC9",
-"q+ c #E6E5E2",
-"r+ c #EDECEA",
-"s+ c #454F55",
-"t+ c #486173",
-"u+ c #4D6678",
-"v+ c #A1C1DA",
-"w+ c #373C40",
-"x+ c #0C0D0F",
-"y+ c #4E5E6A",
-"z+ c #5B6E7C",
-"A+ c #4F5B62",
-"B+ c #A4A099",
-"C+ c #CCC9C3",
-"D+ c #D7D5D1",
-"E+ c #E4E2E0",
-"F+ c #DDDBD7",
-"G+ c #B8B5B0",
-"H+ c #3E474D",
-"I+ c #4A6176",
-"J+ c #4A6070",
-"K+ c #9BC3D8",
-"L+ c #363C41",
-"M+ c #28323E",
-" . . ",
-" . + @ . ",
-" . . . . . . . . . . . . . # $ % . . . ",
-" . & * = - ; > , ' ) ! ~ . { ] ^ . / ( _ . ",
-" . : < [ } | 1 2 3 4 5 . 6 7 8 . 9 0 a b . ",
-" . c d e f g h i j k . l m n . o p q r s . ",
-" . t u v w w w w x . y z A . B C D E F G . ",
-" . H I v w w w x . J K L . M N O P Q R S . ",
-" . T U v V C N . W X Y . Z ` ...+.v @.#.. ",
-" . $.%.&.w w *.. =.-.. M N D P *.w v @.;.. ",
-" . >.,.v w x . '.. . M N D P *.w w v ).!.. ",
-" . ~.{.v V ].. . ^./.(._...].C C :.v ).<.. ",
-" . [.}.|.w *.1.2.3.4.5.6.x w w w w v R 7.. ",
-" . 8.9.0.a.Q b.c.c.d.e.E v v v v f.g.h.i.. ",
-" . j.k.F R h.F l.m.F n.h.o.o.).p.q.R r.s.. ",
-" . t.u.v.w.x.y.z.A.B.C.D.E.F.z.G.H.I.J.K.. ",
-" . L.M.N.O.P.Q.R.S.S.T.Q.U.V.W.X.Y.Z.`. +. ",
-" . .+++@+#+$+%+&+*+*+=+-+;+>+U.,+'+)+!+~+. ",
-" . {+]+^+#+/+(+&+*+*+_+:+;+<+[+}+|+)+1+~+. ",
-" . 2+3+4+5+6+S.7+8+8+9+;+0+a+b+c+d+e+f+g+. ",
-" . h+i+j+k+l+m+n+o+o+;+p+q+r+q+s+t+u+v+w+. ",
-" x+y+z+A+B+;+>+C+C+D+E+T.F+G+H+I+J+K+L+. ",
-" . . . . . . . . . . . . . . . . M+. ",
-" "};
+++ /dev/null
-/* XPM */
-static char * search_xpm[] = {
-"24 24 207 2",
-" c None",
-". c #000000",
-"+ c #D3D3D3",
-"@ c #F6F6F6",
-"# c #FFFFFF",
-"$ c #F9F9F9",
-"% c #DADADA",
-"& c #585858",
-"* c #C7C7C7",
-"= c #D1D1D1",
-"- c #D6D6D6",
-"; c #FEFEFE",
-"> c #FDFDFD",
-", c #C0C0C0",
-"' c #E1E1E1",
-") c #F0F0F0",
-"! c #9B9B9B",
-"~ c #FCFCFB",
-"{ c #FBFBFB",
-"] c #AFAFAE",
-"^ c #E9E9E9",
-"/ c #DFDFDF",
-"( c #8F8F8F",
-"_ c #FAFAF9",
-": c #F9F9F8",
-"< c #A4A4A3",
-"[ c #F4F4F4",
-"} c #CFCFCF",
-"| c #A2A2A2",
-"1 c #B8B8B8",
-"2 c #47473F",
-"3 c #0A0A09",
-"4 c #4B4B43",
-"5 c #B4B4B3",
-"6 c #F7F6F5",
-"7 c #9E9E9E",
-"8 c #A9A9A8",
-"9 c #34342E",
-"0 c #9D9D8D",
-"a c #CFCFB9",
-"b c #C4C4AF",
-"c c #8D8D7F",
-"d c #353530",
-"e c #ACACAA",
-"f c #F1F0EF",
-"g c #DEDDDC",
-"h c #D3D2D0",
-"i c #B7B7B5",
-"j c #9F9E9D",
-"k c #706F6F",
-"l c #65625A",
-"m c #46463F",
-"n c #9C9C8C",
-"o c #E2E2D0",
-"p c #EDEDE7",
-"q c #C0C0AC",
-"r c #B2B29F",
-"s c #828274",
-"t c #4C4C44",
-"u c #E4E4E2",
-"v c #E1E1DF",
-"w c #DAD9D7",
-"x c #D8D8D6",
-"y c #CDCCCA",
-"z c #AFAEAC",
-"A c #88847B",
-"B c #F8F8F7",
-"C c #090908",
-"D c #D5D5BF",
-"E c #FBFBFA",
-"F c #C3C3AE",
-"G c #B5B5A2",
-"H c #A6A695",
-"I c #9C9C8F",
-"J c #080807",
-"K c #CFCFCD",
-"L c #E3E2E0",
-"M c #ECEBE9",
-"N c #E9E8E6",
-"O c #D5D4D3",
-"P c #C4C3C2",
-"Q c #8F8A81",
-"R c #F6F5F4",
-"S c #F3F3F1",
-"T c #090909",
-"U c #CACAB5",
-"V c #DDDDD0",
-"W c #B7B7A4",
-"X c #AAAA98",
-"Y c #9B9B8B",
-"Z c #AEAEA3",
-"` c #BBBAB9",
-" . c #E8E7E5",
-".. c #E5E4E2",
-"+. c #E4E3E0",
-"@. c #D2D1CE",
-"#. c #8D887E",
-"$. c #F4F3F2",
-"%. c #F0EFEE",
-"&. c #474740",
-"*. c #929283",
-"=. c #BABAA7",
-"-. c #ADAD9B",
-";. c #9F9F8E",
-">. c #ACACA1",
-",. c #CFCFCB",
-"'. c #4C4C45",
-"). c #B3B2B1",
-"!. c #E2E1DE",
-"~. c #E1DFDC",
-"{. c #979288",
-"]. c #949493",
-"^. c #34342F",
-"/. c #878779",
-"(. c #A0A090",
-"_. c #AEAEA2",
-":. c #C3C3BE",
-"<. c #010101",
-"[. c #B1B0AF",
-"}. c #D2D1CF",
-"|. c #A49E93",
-"1. c #F0F0EE",
-"2. c #EDEDEB",
-"3. c #DDDDDB",
-"4. c #898988",
-"5. c #414141",
-"6. c #737271",
-"7. c #A4A3A1",
-"8. c #DFDEDB",
-"9. c #E2E0DD",
-"0. c #E1E0DC",
-"a. c #E0DFDB",
-"b. c #A19C90",
-"c. c #E1E0DE",
-"d. c #CBCAC9",
-"e. c #B2B1B0",
-"f. c #A3A2A1",
-"g. c #9D9C9A",
-"h. c #9E9D9C",
-"i. c #9F9F9D",
-"j. c #ABAAA7",
-"k. c #DCDBD7",
-"l. c #DEDDD9",
-"m. c #DDDCD8",
-"n. c #A19B90",
-"o. c #EBEAE8",
-"p. c #E6E5E3",
-"q. c #C8C7C4",
-"r. c #B6B6B3",
-"s. c #B0AFAD",
-"t. c #B3B2B0",
-"u. c #747371",
-"v. c #9D9C99",
-"w. c #DAD9D5",
-"x. c #E7E6E3",
-"y. c #E6E5E2",
-"z. c #E3E2DF",
-"A. c #DBDAD7",
-"B. c #D4D3D0",
-"C. c #D0CFCB",
-"D. c #D1CFCC",
-"E. c #D1D0CC",
-"F. c #C9C8C4",
-"G. c #6B6B69",
-"H. c #CECDC9",
-"I. c #D6D4D0",
-"J. c #9F998D",
-"K. c #E3E2DE",
-"L. c #E4E2DF",
-"M. c #DFDEDA",
-"N. c #D5D4D0",
-"O. c #C0BFBC",
-"P. c #7B7A78",
-"Q. c #BCBAB6",
-"R. c #CECCC8",
-"S. c #9D978C",
-"T. c #EDEDED",
-"U. c #E1E0DD",
-"V. c #E2E1DD",
-"W. c #DBDAD6",
-"X. c #BBB9B6",
-"Y. c #A6A4A1",
-"Z. c #9E9C99",
-"`. c #ACABA7",
-" + c #C7C5C2",
-".+ c #9B9589",
-"++ c #E1DFDB",
-"@+ c #E0DEDA",
-"#+ c #DEDCD8",
-"$+ c #DAD8D4",
-"%+ c #BDBCB8",
-"&+ c #ACABA8",
-"*+ c #B2B1AD",
-"=+ c #C6C4C0",
-"-+ c #999388",
-";+ c #999891",
-">+ c #A39E92",
-",+ c #A39D92",
-"'+ c #A39D91",
-")+ c #A29C90",
-"!+ c #A19B8F",
-"~+ c #9D978B",
-"{+ c #989286",
-"]+ c #918C82",
-"^+ c #938D83",
-"/+ c #979286",
-"(+ c #666258",
-" ",
-" . . . . . . . . . . . . . ",
-" . + @ # # # # # # # # $ % & . ",
-" . @ # # # # # # # # # # * = - . ",
-" . # # # # # # # ; # ; > , ' ) ! . ",
-" . # # # # # ; > ~ > ~ { ] ^ # / ( . ",
-" . # # # ; > ~ { _ { _ : < ) # [ } | . ",
-" . # ; > ~ 1 2 3 3 4 5 6 7 . . . . . . . ",
-" . # ~ { 8 9 0 a b c d e f g h i j k l . ",
-" . # _ : m n o p q r s t u v w x y z A . ",
-" . # B 6 C D E F G H I J K L M N O P Q . ",
-" . # R S T U V W X Y Z 3 ` w ...+.@.#.. ",
-" . # $.%.&.*.=.-.;.>.,.'.).h !.+.!.~.{.. ",
-" . # $.%.].^./.(._.:.<.<.[.}.!.+.!.~.|.. ",
-" . # 1.2.3.4.4 3 3 5.6.<.<.7.8.9.0.a.b.. ",
-" . # 2.M c.d.e.f.g.h.i.<.<.<.j.k.l.m.n.. ",
-" . # o.N p.w q.r.z s.t.u.. <.<.v.w.k.n.. ",
-" . # x.y.y.z.A.B.C.D.E.F.G.<.<.<.H.I.J.. ",
-" . $ +.z.K.L.K.a.a.M.M.N.O.P.<.<.Q.R.S.. ",
-" . T.U.~.0.a.V.a.0.a.0.W.E.X.Y.Z.`. +.+. ",
-" . = ++@+M.l.a.l.@+l.@+#+$+R.%+&+*+=+-+. ",
-" . ;+>+|.,+'+,+b.)+b.)+!+n.~+{+]+^+/+(+. ",
-" . . . . . . . . . . . . . . . . . . ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_mail_send_xpm[] = {
-"24 24 58 1",
-" c None",
-". c #4F3F0A",
-"+ c #000000",
-"@ c #F4E6B5",
-"# c #F4E5B3",
-"$ c #EDD684",
-"% c #755F10",
-"& c #EDD580",
-"* c #EED685",
-"= c #AF8D18",
-"- c #EFD98C",
-"; c #EED88B",
-"> c #EDD582",
-", c #EED889",
-"' c #EFDA92",
-") c #F0DB93",
-"! c #735D10",
-"~ c #535353",
-"{ c #FFFFFF",
-"] c #F0DC97",
-"^ c #F6F6F6",
-"/ c #F5F5F5",
-"( c #F4F4F4",
-"_ c #E3E3E3",
-": c #EEEEEE",
-"< c #4F4F4F",
-"[ c #EDD37C",
-"} c #EDEDED",
-"| c #AEAEAE",
-"1 c #E4E4E4",
-"2 c #434343",
-"3 c #FDFDFD",
-"4 c #F3F3F3",
-"5 c #E4BF3D",
-"6 c #CBA41C",
-"7 c #D1A81C",
-"8 c #907413",
-"9 c #7C6411",
-"0 c #ACACAC",
-"a c #C8C8C8",
-"b c #FBFBFB",
-"c c #A0A0A0",
-"d c #D4D4D4",
-"e c #F8F8F8",
-"f c #F0F0F0",
-"g c #EFEFEF",
-"h c #ECECEC",
-"i c #959595",
-"j c #3E3E3E",
-"k c #4D4D4D",
-"l c #818181",
-"m c #C6C6C6",
-"n c #6A6A6A",
-"o c #636363",
-"p c #B9B9B9",
-"q c #737373",
-"r c #7C7C7C",
-"s c #BCBCBC",
-" ",
-" . ",
-" +@+ ",
-" +#$%+ ",
-" +#&*=%+ ",
-" +#-;>==%+ ",
-" +#,',>===%+ ",
-" ++++++)$&=!++++++ ",
-" +~{{{{+]$$=!+^/(_~+ ",
-" +:<{/(+,[$=!+:}_<|+ ",
-" +{1234+56789+}_<0a+ ",
-" +{/1<b+++++++_2cda+ ",
-" +{b/12efg:}h_<id1a+ ",
-" +{///1j/:}h_klm11a+ ",
-" +{b//1n24h_<nmm/1a+ ",
-" +{//1o{p<f<imqm/1a+ ",
-" +{b1o{/1d<0m11r11a+ ",
-" +{1q{////11///1r1a+ ",
-" +{r{111111111111ra+ ",
-" +qssssssssssssssso+ ",
-" ++++++++++++++++++ ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * separator_xpm[] = {
-"2 24 3 1",
-" c None",
-". c #DBD3CB",
-"+ c #FCFBFA",
-" ",
-" ",
-" ",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-".+",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * sort_ascending_xpm[] = {
-"24 24 34 1",
-" c None",
-". c #000000",
-"+ c #FAFAFA",
-"@ c #DDDFD2",
-"# c #8B8E7C",
-"$ c #E5E7DD",
-"% c #84A77E",
-"& c #586546",
-"* c #81A57C",
-"= c #EDEEE8",
-"- c #81A57B",
-"; c #ECEDE6",
-"> c #7EA379",
-", c #7DA377",
-"' c #DDDFD3",
-") c #7DA378",
-"! c #C9D5C4",
-"~ c #7EA378",
-"{ c #7C7E73",
-"] c #DFE7DE",
-"^ c #CCDACA",
-"/ c #90B08C",
-"( c #76986D",
-"_ c #6C855E",
-": c #22231E",
-"< c #3F443B",
-"[ c #C8D8C7",
-"} c #9DB89A",
-"| c #76966B",
-"1 c #3D4237",
-"2 c #565B4E",
-"3 c #9EBA9A",
-"4 c #3C4237",
-"5 c #5E6154",
-" ",
-" ",
-" ",
-" .... ",
-" ..... .. .. ",
-" .+@#. .. .. ",
-" .$%&. ...... ",
-" .$*&. .. .. ",
-" .=-&. .. .. ",
-" .;-&. ",
-" .$*&. .. ",
-" .$*&. .. ",
-" .$>&. ",
-" .$,&. .. ",
-" .')&. .. ",
-" ...!~&... ",
-" .{]^/(_:. ...... ",
-" .<[}|1. ... ",
-" .234. ... ",
-" .5. ... ",
-" . ... ",
-" ...... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_sort_column_ascending_xpm[] = {
-"24 24 2 1",
-" c None",
-". c #000000",
-" ",
-" ",
-" ... ",
-" . .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" ..... . ",
-" ",
-" . ",
-" ",
-" . ",
-" .... ",
-" .. .. ",
-" .. .. ",
-" .. .. ",
-" ..... ",
-" .. ",
-" . ... ",
-" ..... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_sort_criteria_xpm[] = {
-"24 24 28 1",
-" c None",
-". c #000000",
-"+ c #FFFFFF",
-"@ c #D3D3D3",
-"# c #F2ECE1",
-"$ c #F4EFE5",
-"% c #DFDAD2",
-"& c #C9C4BD",
-"* c #74716E",
-"= c #FAFAFA",
-"- c #EADFC9",
-"; c #ECE2CF",
-"> c #EEE5D4",
-", c #4C4B48",
-"' c #F5F5F5",
-") c #C9C9C9",
-"! c #E2D2B1",
-"~ c #CFC4B1",
-"{ c #BFBFBF",
-"] c #C0C0C0",
-"^ c #C7B99C",
-"/ c #F0F0F0",
-"( c #B7B7B7",
-"_ c #9A8F78",
-": c #877E69",
-"< c #AFA389",
-"[ c #A09889",
-"} c #314E6C",
-" ",
-" ",
-" ...... ",
-" ... ",
-" ... ",
-" ... ",
-" ......... ... ",
-" .+@.#$%&*. ...... ",
-" .=@.-;;;>, ",
-" .').!!!!.~. ",
-" .{].^^!.^.~. ",
-" ./(.._.^.:.~. ",
-" .....<.:...[. ",
-" .:.. .. ",
-" .. ",
-" ",
-" }}}} ",
-" }} }} ",
-" }} }} ",
-" }}}}}} ",
-" }} }} ",
-" }} }} ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * sort_descending_xpm[] = {
-"24 24 35 1",
-" c None",
-". c #000000",
-"+ c #F8F0EE",
-"@ c #E5B9BB",
-"# c #895F63",
-"$ c #E7BDBC",
-"% c #C14B35",
-"& c #922B34",
-"* c #C24F3C",
-"= c #942B32",
-"- c #E8BFBE",
-"; c #E8C2BF",
-"> c #C34E3B",
-", c #C24F3A",
-"' c #C24D38",
-") c #E5B8B9",
-"! c #C24F38",
-"~ c #E2B1AA",
-"{ c #CC6B5A",
-"] c #643C3E",
-"^ c #E3B5AC",
-"/ c #E3B3A9",
-"( c #D07868",
-"_ c #982E19",
-": c #7E261F",
-"< c #120C0F",
-"[ c #2B1D1F",
-"} c #DFAA9E",
-"| c #D28575",
-"1 c #7D2617",
-"2 c #321C23",
-"3 c #3B262E",
-"4 c #D68A7A",
-"5 c #321C21",
-"6 c #3F2A35",
-" ",
-" ",
-" ",
-" ...... ",
-" ..... ... ",
-" .+@#. ... ",
-" .$%&. ... ",
-" .$*=. ... ",
-" .-*=. ...... ",
-" .;>=. ",
-" .$*=. .. ",
-" .$*=. .. ",
-" .$,=. ",
-" .$'=. .. ",
-" .)!=. .. ",
-" ...~{=... ",
-" .]^/(_:<. .... ",
-" .[}|12. .. .. ",
-" .345. .. .. ",
-" .6. ...... ",
-" . .. .. ",
-" .. .. ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_sort_row_ascending_xpm[] = {
-"21 17 2 1",
-" c None",
-". c #000000",
-" ",
-" ",
-" ",
-" ",
-" ... .... ",
-" . .. .. .. ",
-" .. .. .. ",
-" .. .. .. ",
-" .. ..... ",
-" .. .. ",
-" .. . .. ",
-" ..... . . . ..... ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_spam_xpm[] = {
-"24 24 190 2",
-" c None",
-". c #1D1E1E",
-"+ c #333839",
-"@ c #393F40",
-"# c #171819",
-"$ c #B2B8B9",
-"% c #D5E3E7",
-"& c #AABABD",
-"* c #64696A",
-"= c #0C0D0D",
-"- c #929C9E",
-"; c #E7F0F3",
-"> c #EDF0F1",
-", c #E5EDEF",
-"' c #C5D9DD",
-") c #2E3132",
-"! c #3F4343",
-"~ c #1F2121",
-"{ c #DFEBEE",
-"] c #B7C4C8",
-"^ c #D2D9DA",
-"/ c #E1EFF2",
-"( c #B6CBCF",
-"_ c #3C4547",
-": c #1E2223",
-"< c #191E1F",
-"[ c #2D2E2F",
-"} c #191A1A",
-"| c #252829",
-"1 c #7E8E92",
-"2 c #B7C2C3",
-"3 c #C3D9DD",
-"4 c #9CACB0",
-"5 c #C3CDCE",
-"6 c #C7E1E7",
-"7 c #668F97",
-"8 c #90ACB2",
-"9 c #CDDDE1",
-"0 c #485559",
-"a c #88A6AC",
-"b c #1F2223",
-"c c #3F4545",
-"d c #242728",
-"e c #313B3E",
-"f c #A8C2C8",
-"g c #B2BDC0",
-"h c #CFE5E9",
-"i c #C2D9DE",
-"j c #81989C",
-"k c #A2C0C5",
-"l c #85A9B1",
-"m c #E5ECEE",
-"n c #E7F2F4",
-"o c #9BAEB3",
-"p c #C8E1E7",
-"q c #3A3E3F",
-"r c #0C0E0E",
-"s c #000000",
-"t c #333737",
-"u c #B3C2C5",
-"v c #DDEDF0",
-"w c #D8E4E6",
-"x c #DAECEF",
-"y c #D5E9ED",
-"z c #D2E7EC",
-"A c #95ADB2",
-"B c #DBE2E2",
-"C c #EDEFF0",
-"D c #A2B1B3",
-"E c #8FA4A8",
-"F c #D7E2E5",
-"G c #798F94",
-"H c #151819",
-"I c #F3B5A7",
-"J c #865E55",
-"K c #AFB9BB",
-"L c #F1F8F9",
-"M c #F7FBFB",
-"N c #D9EBEF",
-"O c #ECF4F6",
-"P c #F3F7F7",
-"Q c #E9F2F4",
-"R c #EEF2F3",
-"S c #E9EDEE",
-"T c #C5C8C9",
-"U c #C2C6C8",
-"V c #E0E7E7",
-"W c #DDEAED",
-"X c #7A9DA5",
-"Y c #EB8169",
-"Z c #B83618",
-"` c #924E3C",
-" . c #9FA5A6",
-".. c #E3EEF0",
-"+. c #ECF5F7",
-"@. c #D6EAED",
-"#. c #CBE4E9",
-"$. c #D9E7E9",
-"%. c #E1EBED",
-"&. c #B8CBD0",
-"*. c #BDCBCF",
-"=. c #ABB3B5",
-"-. c #E3E5E5",
-";. c #DCEBEF",
-">. c #6A979F",
-",. c #131819",
-"'. c #B43518",
-"). c #E76A4D",
-"!. c #B53F24",
-"~. c #CB705A",
-"{. c #C4D8DB",
-"]. c #D2E6E9",
-"^. c #CAE3E8",
-"/. c #A9C8CF",
-"(. c #7FA4AA",
-"_. c #82B4BE",
-":. c #E2EFF0",
-"<. c #D3E7EA",
-"[. c #AFD5DE",
-"}. c #C7E2E7",
-"|. c #E7F1F2",
-"1. c #97C3CB",
-"2. c #637F86",
-"3. c #191311",
-"4. c #EF9985",
-"5. c #F1A897",
-"6. c #E76547",
-"7. c #C58B7D",
-"8. c #A8ABAC",
-"9. c #70A1AB",
-"0. c #88B5BE",
-"a. c #95C7D1",
-"b. c #ADD4DC",
-"c. c #DCEAEF",
-"d. c #B5D8E0",
-"e. c #CAE4E9",
-"f. c #95BEC6",
-"g. c #6696A0",
-"h. c #585857",
-"i. c #51190C",
-"j. c #D9401D",
-"k. c #EC8A74",
-"l. c #E17055",
-"m. c #DD8D7A",
-"n. c #D8E7EA",
-"o. c #D8E9ED",
-"p. c #D6EAEE",
-"q. c #D9EBEE",
-"r. c #E4F0F3",
-"s. c #CFE3E8",
-"t. c #5B94A0",
-"u. c #5C7E85",
-"v. c #3D221D",
-"w. c #782310",
-"x. c #EA7A60",
-"y. c #E5A293",
-"z. c #EBD9D5",
-"A. c #C6D3D6",
-"B. c #799FA8",
-"C. c #558C98",
-"D. c #45686E",
-"E. c #27201F",
-"F. c #5D3228",
-"G. c #B86F5D",
-"H. c #F1A593",
-"I. c #E58D78",
-"J. c #C0C0C1",
-"K. c #32464B",
-"L. c #4A6E75",
-"M. c #282121",
-"N. c #4A2E27",
-"O. c #C6968B",
-"P. c #DDA89B",
-"Q. c #5F1C0D",
-"R. c #F2AFA0",
-"S. c #A36F63",
-"T. c #341C17",
-"U. c #301A15",
-"V. c #674C45",
-"W. c #E4AEA1",
-"X. c #8D2A13",
-"Y. c #030505",
-"Z. c #A2432E",
-"`. c #E4A799",
-" + c #D97C67",
-".+ c #B66A59",
-"++ c #B26C5C",
-"@+ c #882812",
-"#+ c #DB411D",
-"$+ c #F4BAAC",
-" ",
-" ",
-" ",
-" ",
-" . + @ ",
-" # $ % & * . ",
-" = - ; > , ' ) ! ",
-" ~ { ] ^ / ( _ : < [ } ",
-" | 1 2 3 4 5 6 7 8 9 0 a b ",
-" c d e f g h i j k l m n o p q r ",
-" s t u v w / x y z A B C D E F G H ",
-" s s I J K L M N O P Q R S T U V W X < ",
-"s I Y Z ` ...+.@.#.$.%.h &.*.=.-.;.>.,.s ",
-"s '.).Y !.~.{.].^./.(._.:.<.[.}.|.1.2.3.4.s ",
-"s '.'.'.).5.6.7.8.9.0.a.b.c.d.e.f.g.h.i.j.k.s ",
-"s '.'.'.'.'.).5.l.m.n.o.p.q.r.s.t.u.v.w.j.x.s ",
-" s s '.'.'.'.'.).5.6.y.z.A.B.C.D.E.F.G.H.4.s ",
-" s s '.'.'.'.'.).5.I.J.K.L.M.N.O.P.Q.s ",
-" s s '.'.'.'.'.R.S.T.U.V.W.X.s s ",
-" Y.s s Z.'.'.`. +.+++@+s s ",
-" s s s '.#+$+s s s ",
-" s s s s s ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * spell_xpm[] = {
-"24 24 37 1",
-" c None",
-". c #000000",
-"+ c #8BBB8C",
-"@ c #ABD0AC",
-"# c #1A3B1A",
-"$ c #8ABA88",
-"% c #B4D5B4",
-"& c #70A770",
-"* c #132C13",
-"= c #77A676",
-"- c #2D2D2D",
-"; c #CBDFCB",
-"> c #6FAE6E",
-", c #A8CBA6",
-"' c #6D9D6C",
-") c #D0E4D0",
-"! c #6FAF6F",
-"~ c #587055",
-"{ c #B8D6B8",
-"] c #5B9159",
-"^ c #D4E4D4",
-"/ c #67AF67",
-"( c #5D905B",
-"_ c #9FC59D",
-": c #93BE92",
-"< c #B5D1B5",
-"[ c #67AF68",
-"} c #63A261",
-"| c #BBD6BA",
-"1 c #82B881",
-"2 c #75AF74",
-"3 c #6B8868",
-"4 c #9DC39D",
-"5 c #7DB17B",
-"6 c #6BA368",
-"7 c #485C46",
-"8 c #89BA88",
-" ",
-" ",
-" ",
-" ",
-" ... .... ... ",
-" .. . .. . .. . ",
-" .. . .... .. ",
-" ..... .. . .. ",
-" .. . .. . .. . . ",
-" .. . .... ... ... ",
-" .+. ",
-" .. .@# ",
-" .$. .%&. ",
-" *=. -;>. ",
-" .,'. .)!~. ",
-" .{].^/(. ",
-" ._:<[}~. ",
-" .|123. ",
-" .4567. ",
-" .83. ",
-" .37. ",
-" .. ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * subscribe_xpm[] = {
-"24 24 5 1",
-" c None",
-". c #A5A5A5A59595",
-"X c #E1E1E0E0E0E0",
-"o c #C7C7C6C6C6C6",
-"O c #8686ADAD7D7D",
-" ",
-" ",
-" ",
-" ... ",
-" ..XXX..... ",
-"...XXXXX..XXX. ... ",
-".X.XX...XXXX...XXX. ",
-".XX.X.X.XX...XXXXX. ",
-".XX...XX.X.X.XXXXXX. ",
-".XX.o.XX...XX.XXXXXX. ",
-".X.oo.XX.o.XX..XXXXXX. ",
-"o.ooo.X.oo.XX.XXXOXXX. ",
-"o.oXXo.ooo.X.oXXOXXXXX. ",
-" o.XXo.oXXo.ooXXOXXXXX. ",
-" o.XXXo.XXo.oXXXOXXXXXX.",
-" o.XXo.XXXo.XOOOOXXXXX.",
-" o.XXoo.XXo.XXXOOXXXXX.",
-" o.XXo.XXXo.XXXXXXX...",
-" o.XX.o.XXo.XXXXXX.oo ",
-" o..oo.XX.o.XXX..o ",
-" oo o..oo.XX.oo ",
-" oo o..o ",
-" oo ",
-" "};
+++ /dev/null
-/* XPM */
-static char * stock_task_recurring_xpm[] = {
-"24 24 31 1",
-" c None",
-". c #000000",
-"+ c #FFFFFF",
-"@ c #F4E2BC",
-"# c #F4D597",
-"$ c #434343",
-"% c #F0CC84",
-"& c #EBB13D",
-"* c #4B4B4B",
-"= c #535353",
-"- c #C8C8C8",
-"; c #7D7D7D",
-"> c #7C7C7C",
-", c #858585",
-"' c #5C5C5C",
-") c #949494",
-"! c #F2F2F2",
-"~ c #B6B6B6",
-"{ c #BDBDBD",
-"] c #818181",
-"^ c #878787",
-"/ c #B2B2B2",
-"( c #FDFDFD",
-"_ c #DBDBDB",
-": c #CCCCCC",
-"< c #ECECEC",
-"[ c #7F7F99",
-"} c #333366",
-"| c #8F8FA9",
-"1 c #59597F",
-"2 c #EEEEEE",
-" ",
-" . . . . . . . ",
-" .+.+.+.+.+.+.+. ",
-" .@.#.#.#.#.#.#. ",
-" .$%$&*&*&=&=&$&*. ",
-" .-*;*>*>*>*>=,'). ",
-" .!>~>{]{]{]{]{^/. ",
-" .(_:::::::::::_/. ",
-" .+<<<<<<<<<<<<</. ",
-" .+_::[}::}}}}:_/. ",
-" .+<<|}<<<}}}<<</. ",
-" .+_:}[:::}}1[:_/. ",
-" .+<<}<<<<}<|}<</. ",
-" .+_:}[:}::::}:_/. ",
-" .+<<|}}}<<<|}<</. ",
-" .+_::}}}:::}[:_/. ",
-" .+<<}}}}<<}|<<</. ",
-" .+_:::::::::::_/. ",
-" .+<<<<<<<<<<<<</. ",
-" .2//////////////. ",
-" ................. ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char *magick[] = {
-/* columns rows colors chars-per-pixel */
-"24 24 2 1",
-"! c blue",
-"w c Gray75",
-/* pixels */
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"ww!!!wwwwww!!!wwwwww!!!w",
-"www!!!wwwww!!!wwwww!!!ww",
-"wwww!!!wwww!!!wwww!!!www",
-"wwwww!!!www!!!www!!!wwww",
-"wwwwww!!!ww!!!ww!!!wwwww",
-"wwwwwww!!!w!!!w!!!wwwwww",
-"wwwwwwww!!!!!!!!!wwwwwww",
-"wwwwwwwww!!!!!!!wwwwwwww",
-"wwwwwwwwww!!!!!wwwwwwwww",
-"wwwwwwwwwww!!!wwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww",
-"wwwwwwwwwwwwwwwwwwwwwwww"
-};
+++ /dev/null
-/* XPM */
-static char * unsubscribe_xpm[] = {
-"24 24 5 1",
-" c None",
-". c #A5A5A5A59595",
-"X c #E1E1E0E0E0E0",
-"o c #C7C7C6C6C6C6",
-"O c #FFFF00000000",
-" ",
-" ",
-" ",
-" ... ",
-" ..XXX..... ",
-"...XXXXX..XXX. ... ",
-".X.XX...XXXX...XXX. ",
-".XX.X.X.XX...XXXXX. ",
-".XX...XX.X.X.XXXXXX. ",
-".XX.o.XX...XX.XXXXXX. ",
-".X.oo.XX.o.XX..XXXXXX. ",
-"o.ooo.X.oo.XX.XXXXXXX. ",
-"o.oXXo.ooo.X.oXXXXXXXX. ",
-" o.XXo.oXXo.ooXXOXXXXX. ",
-" o.XXXo.XXo.oXXXOXXXXXX.",
-" o.XXo.XXXo.XOOOXXXXXX.",
-" o.XXoo.XXo.XoOOOXXXXX.",
-" o.XXo.XXXo.XOoOXXX...",
-" o.XX.o.XXo.XOXoXX.oo ",
-" o..oo.XX.o.oXX..o ",
-" oo o..oo.XX.oo ",
-" oo o..o ",
-" oo ",
-" "};
+++ /dev/null
-/* XPM */
-static char * uu_decode_xpm[] = {
-"24 24 9 1",
-" c None",
-". c #919187876969",
-"X c #C2C2B9B99C9C",
-"o c #868686868686",
-"O c #8F8F8F8F8F8F",
-"+ c #000000000000",
-"@ c #4C4C4C4C4C4C",
-"# c #E9E9EFEFE8E8",
-"$ c #8686ADAD7D7D",
-" ",
-" ",
-" ",
-" .............. ",
-" X.o.........O.++ ",
-" XX++++++++++..++ ",
-" XX@########+..++ ",
-" XX@########+..++ ",
-" XX@$#$$$#$#+..++ ",
-" XX@#$$$$$$#+..++ ",
-" XX@##$#####+..++ ",
-" XX@##$#$$##+..++ ",
-" XX@##$#$$##+..++ ",
-" XX@##$$#$$#+..++ ",
-" XX@######$#+..++ ",
-" XX@########+..++ ",
-" XX@########+..++ ",
-" XX.@@@@@@@@@..++ ",
-" X.XXXXXXXXXX..++ ",
-" .XXXXXXXXXXXX.++ ",
-" +++++++++++++++ ",
-" +++++++++++++++ ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * uu_post_xpm[] = {
-"24 24 8 1",
-". c None",
-"X c #000000000000",
-"+ c #C2C2B9B99C9C",
-"@ c #919187876969",
-"# c #868686868686",
-"% c #4C4C4C4C4C4C",
-"& c #E9E9EFEFE8E8",
-"* c #8686ADAD7D7D",
-"X..X..X..X.XX..X..X..X..",
-"..........X.X...........",
-".........X...X..........",
-"X..X..X.XX..X.XX..X..X..",
-".......X.......X........",
-"......X.........X.......",
-"X..X+X@@@@@@@@@@@XX..X..",
-"....+@@@@@@@@@@@@@......",
-"....++XXXXXXXXXX@@......",
-"X..X++%&&&&&&&&X@@X..X..",
-"....++%&&&&&&&&X@@......",
-"....++%*&***&*&X@@......",
-"X..X++%&******&X@@X..X..",
-"....++%&&*&&&&&X@@......",
-"....++%&&*&**&&X@@......",
-"X..X++%&&*&**&&X@@X..X..",
-"....++%&&**&**&X@@......",
-"....++%&&&&&&*&X@@......",
-"X..X++%&&&&&&&&X@@X..X..",
-"....++%&&&&&&&&X@@......",
-"....++@%%%%%%%%%@@......",
-"X..X+@++++++++++@@X..X..",
-"....+++++++++++++@......",
-"........................"};
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X....X.E ",
-"E...X..X...E",
-"E...X..X...E",
-"E..........E",
-"E...XXXX...E",
-" E.X....X.E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-"..E EEEE E..",
-"E..E....E..E",
-" E........E ",
-" E.. .....E ",
-"E..XX..XX..E",
-"E..........E",
-"E.X......X.E",
-"E..X....X..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E.X......X.E",
-"E.XXXXXXXX.E",
-" E........E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..XXXXXX..E",
-"E..X....X..E",
-" E..X..X..E ",
-" E...XX...E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E.X......X.E",
-"E..XXXXXX..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E........X.E",
-"E...XXXXX..E",
-" E.X......E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X.XX.X.E ",
-"E...X..X...E",
-"E..X.XX.X..E",
-"E..........E",
-"E..........E",
-" E.XXXXXX.E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E........E ",
-"E..XX..XX..E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E..oooX..E ",
-" E...oo...E ",
-" EE.Xo.EE ",
-" EEEE .Xo.",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E.X....X.E ",
-" EX......XE ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E...XXXX...E",
-"E..X....X..E",
-" E.X....X.E ",
-" E..XXXX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E........E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXXX..E",
-" E....XXX.E ",
-" E....XX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E...o......E",
-"E..ooo.....E",
-" E.XXXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X.....E ",
-"E...X.XXX..E",
-"E..........E",
-"E.X......X.E",
-"E..XXXXXX..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E.....XXX..E",
-" E..XX....E ",
-" E....XX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X....X.E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E..XXXXX...E",
-" E..oooX..E ",
-" E...oo...E ",
-" EE.Xo.EE ",
-" EEEE .Xo.",
+++ /dev/null
-Files: blink.pbm blink.xpm braindamaged.xpm cry.xpm dead.xpm evil.xpm
- forced.xpm frown.pbm frown.xpm grin.xpm indifferent.xpm sad.pbm
- sad.xpm smile.pbm smile.xpm wry.pbm wry.xpm
-Authors: Reiner Steib, Simon Josefsson, Kai Grossjohann, Alex
- Schroeder, Oliver Scholz, Per Abrahamsen, Kim F. Storm.
-Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
-License: GNU General Public License version 3 or later (see COPYING)
+++ /dev/null
-#define Face_ase_width 24
-#define Face_ase_height 16
-static char Face_ase_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0xf0,0xc0,0x03,
- 0x68,0xa1,0x05,
- 0x68,0xa1,0x05,
- 0x68,0xa1,0x05,
- 0xf0,0xc0,0x23,
- 0x00,0x00,0x20,
- 0x00,0x00,0x50,
- 0x50,0x40,0x52,
- 0x00,0x00,0x50,
- 0x20,0x91,0x20,
- 0x00,0x0e,0x00,
- 0x00,0x00,0x00};
+++ /dev/null
-#define Face_ase2_width 32
-#define Face_ase2_height 16
-static char Face_ase2_bits[] = {
- 0x00,0x00,0x00,0x00,
- 0xf0,0x83,0x1f,0x00,
- 0x08,0x44,0x20,0x00,
- 0x00,0x00,0x00,0x00,
- 0xe0,0x81,0x07,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xe0,0x81,0x87,0x10,
- 0x00,0x00,0x80,0x10,
- 0x00,0x00,0x40,0x29,
- 0xa0,0x80,0x44,0x29,
- 0x00,0x00,0x40,0x29,
- 0x40,0x22,0x81,0x10,
- 0x00,0x1c,0x00,0x00,
- 0x00,0x00,0x00,0x00};
+++ /dev/null
-#define Face_ase3_width 24
-#define Face_ase3_height 16
-static char Face_ase3_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0x18,0x00,0x07,
- 0xe0,0xe0,0x00,
- 0xfc,0xf3,0x0f,
- 0xc0,0xe1,0x00,
- 0x38,0x00,0x27,
- 0x00,0x00,0x20,
- 0x00,0x00,0x50,
- 0x50,0x40,0x52,
- 0x00,0x00,0x50,
- 0x20,0x91,0x20,
- 0x00,0x0e,0x00,
- 0x00,0x00,0x00
-};
+++ /dev/null
-#define Face_smile_width 24
-#define Face_smile_height 16
-static char Face_smile_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0xf0,0xc0,0x07,
- 0x68,0xa1,0x09,
- 0x68,0xa1,0x09,
- 0x68,0xa1,0x09,
- 0xf0,0xc0,0x07,
- 0x00,0x00,0x00,
- 0x00,0x00,0x00,
- 0x50,0x80,0x04,
- 0x00,0x00,0x00,
- 0x20,0x22,0x01,
- 0x00,0x1c,0x00,
- 0x00,0x00,0x00};
+++ /dev/null
-#define Face_weep_width 24
-#define Face_weep_height 16
-static char Face_weep_bits[] = {
- 0x1c,0x00,0x3c,
- 0xe2,0x80,0x43,
- 0x00,0x63,0x00,
- 0x18,0x00,0x18,
- 0x60,0x00,0x07,
- 0x80,0xe3,0x00,
- 0xfc,0xf7,0x3f,
- 0x80,0xe3,0x00,
- 0x60,0x00,0x07,
- 0x58,0x00,0x1a,
- 0x40,0x00,0x02,
- 0xa0,0x00,0x05,
- 0xa0,0x00,0x05,
- 0xa0,0x1c,0x05,
- 0x40,0x22,0x02,
- 0x00,0x00,0x00
-};
+++ /dev/null
-/* XPM */
-static char * blink_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".+++++++..++.",
-".+++++++..++.",
-".++...++++++.",
-".+++++++++++.",
-".++++++++.++.",
-".++.+++++.++.",
-".+++.....+++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * mad_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".++...++++++.",
-".++.+.+...++.",
-".++...+.+.++.",
-".++++++...++.",
-".+.+++++++.+.",
-".+.+++++++.+.",
-".++.+++++.++.",
-".+++.....+++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * cry_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++++++++.++.",
-".+++++++.+.+.",
-".+++++++.+.+.",
-".++++++++..+.",
-".+++.....+++.",
-".++.+++++.++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * dead_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++.+.+.+.++.",
-".+++.+++.+++.",
-".++.+.+.+.++.",
-".+++++++++++.",
-".+++++++++++.",
-".+.+++++++.+.",
-".++.......++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * diabolic_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".++.+++++.++.",
-".++..+++..++.",
-".++...+...++.",
-".+++++++++++.",
-".+.+++++++.+.",
-".++.+++++.++.",
-".+++.+++.+++.",
-".++++...++++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * forced_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-".+++++++++++.",
-".+.+++++++.+.",
-".+.+++++++.+.",
-".+.........+.",
-".+++++++++++.",
-" ...+++++... ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * frown_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".++..+++..++.",
-".++++.+.++++.",
-".+...+++...+.",
-".+...+++...+.",
-".+++++++++++.",
-".+++.....+++.",
-".++.+++++.++.",
-".++.+++++.++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * grin_xpm[] = {
-"13 14 4 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-"@ c #FFFFFF",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-".+.........+.",
-".+.@@@@@@@.+.",
-".++.@@@@@.++.",
-".+++.....+++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * indifferent_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-".+++++++++++.",
-".+++++++++++.",
-".++.......++.",
-".+++++++++++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * reverse_smile_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++.....+++.",
-".++.+++++.++.",
-".++.+++++.++.",
-".+++++++++++.",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * sad_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-".+++++++++++.",
-".+++.....+++.",
-".++.+++++.++.",
-".++.+++++.++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * smile_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".++..+++..++.",
-".++..+++..++.",
-".+++++++++++.",
-".+++++++++++.",
-".++.+++++.++.",
-".++.+++++.++.",
-".+++.....+++.",
-" .+++++++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-/* XPM */
-static char * wry_xpm[] = {
-"13 14 3 1",
-" c None",
-". c #000000",
-"+ c #FFDD00",
-" ....... ",
-" ..+++++.. ",
-" .+++++++++. ",
-".+++++++++++.",
-".+++++++..++.",
-".++..+++..++.",
-".++..+++++++.",
-".+++++++++++.",
-".+++++++...+.",
-".+++++...+++.",
-".++++..+++++.",
-" .+++.+++++. ",
-" ..+++++.. ",
-" ....... "};
+++ /dev/null
-;; Also know as the "wish list". Some are done. For the others, no
-;; promise when to be implemented.
-
-* gnus-topic-kill-region
- From Colin Marquardt <colin.marquardt@usa.alcatel.com>
-
- I noticed that when re-arranging topics, C-k yanks a topic just fine
- (runs gnus-topic-kill-group).
-
- However, my habit is to do marking and the yanking the region, so I
- would run C-w on the marked topic. But C-w runs
- gnus-group-kill-region and doesn't yank the topic (for groups it
- works fine).
-
- So could we have a gnus-topic-kill-region, or a
- gnus-group-kill-region which handles topics as well?
-
-* Speed up sorting in summary buffer if there is a limit.
-
- Suggested by Daniel Ortmann <ortmann@isl.net>.
-
-* Investigate the memory usage of Gnus.
-
- But it does seem strange that Gnus would use some 15meg for this. I
- think that is worth investigating. I suspect that bugs or bad
- design are causing waste; they could be in Gnus, or in Emacs. -- RMS
-
-* Google group digest
-
- The result of Google group search return a thread. Is it a digest
- format?
-
-* NOV caching.
-
- Implement NOV caching with Gnus Agent.
-
-* Multiple charsets for topic names.
-
- [Done]
-
-* Allow specification of server in Newsgroups header
-
- [Kai wrote]
-
- WIBNI I could put `Newsgroups: nntp+quimby:bla' into a message and
- Gnus would know to post this message on my server `nntp:quimby' into
- the group bla? I think this would be way cool.
-
- But Gnus would have to rewrite the Newsgroups header before actually
- sending the posting.
-
- Thanks for Micha Wiedenmann for this suggestion.
-
-* Understand mail-user-agent. Maybe gnus-mail-user-agent.
-
- [Done]
-
-* Emphasis delimiters show when `W W c'.
-
- [Fixed]
-
-* Parsing of the common list confirmation requests so that Gnus can
- prepare the response with a single command. Including LISTSERV
- periodic ping messages and the like.
-
-* Parsing of the various List-* headers to enable automatic commands
- like "send help message," "send unsubscribe message," and the like.
-
- [done, see gnus-ml.el]
-
-* Parsing of the subscription notice to stash away details like what
- address you're subscribed to the list under (and automatically send
- mail to the list using that address, when you send mail inside the list
- group), what address to mail to unsubscribe, and the list info message
- if available. Hitting the "get FAQ" command inside a mailing list
- group should display that stashed copy of the info message.
-
-* Some help in coming up with good split rules for mailing lists, as
- automated as possible. Splitting on To and Cc is almost always not
- what I want, since it can misfile messages and since if I'm cc'd on
- list mail I want to get both copies, one in my personal mailbox and one
- in the list mailbox. I know other people handle it other ways, but I
- prefer it that way. Accordingly, some way to semi-automatically
- generate split rules based on Sender, Mailing-List, Return-Path,
- X-Loop, and all of the other random headers that often work would be
- very cool.
-
-* Support for zipped folders for all backends this makes sense for.
- Most likely using jka-compr. (It has been suggested that this do
- work but I think it should be verified for all backends.)
-
-* Support for RFC2015, PGP-MIME. Probably has to involve the people in
- the Mailcrypt project.
-
- [done]
-
-* Agent (Can someone write some subtopics here? I don't use it myself
- so I don't know what is lacking.)
-
-* Support for encrypted folders. Even if the mail arrives unencrypted
- Gnus should be able to encrypt the *folder* for added safety. This
- should go for both Gnus' own folders and the folders Gnus reads from
- (e.g. /var/spool/mail/${USER}). All backends this makes sense for.
-
- [John Wiegley's article <200011030445.VAA08277@localhost.dynodns.net>,
- posted on gnu.emacs.gnus does this.
- Also, gnus-article-encrypt `K E' encrypts the article body.]
-
-* The stuff on "Newest Features" in the manual should be implemented
- and the node updated (it maybe is?).
-
-* Splitting .newsrc.eld so the history is in one file and the
- configuration is in another. To help those that reads at two
- locations (e.g. work and home) and want to have the same
- configuration.
-
-* gnus-uu-decode should complain if one or more parts of a series post
- (ie, "part N of X") is missing, and optionally tick what parts are
- there for decoding in a later session.
-
-* Additional article marking, and an ability to affect marks placed
- during e.g. mail acquisition. I want to be able to notice the
- subject "fast money" or "web traffic", automatically mark it with a
- `$', and score it into oblivion. (But I fear that wanting to change
- marks with mail-source-* and nnmail-* functions will represent a
- philosophical conflict with the rest of Gnus' management of article
- marks. mail-source-* and nnmail-* currently hack around with files
- under ~/Mail and leave traces in ~/Mail/active, but don't affect
- things stored in .newsrc.eld.)
-
-* A much better interface to nnmail-split-methods. I don't know how
- I'd like this done, but I know that the current method of manually
- hacking regexps is pretty untenable for new users. My boss, who is
- tenured faculty at CMU and CEO & CTO at JPRC, and whose research
- work has involved Lisp for the last 25 years, is trying to implant
- himself in a Gnus mail environment, and this is a big sticking point
- even for him.
-
-* PGP-supported encryption of entire nnml & nnmh groups. There are
- people with whom I exchange mail routinely who don't send w/PGP, but
- I'd really rather that the content not be left lying around
- unencrypted. Hook into article acquisition the way jka-compr
- supposedly does, to auto-decrypt every message read.
-
- [See Support for encrypted folders.]
-
-* Baby's First Mail In Gnus. Some set of functions that the
- new-to-mail-in-Gnus user can invoke which will query the user
- appropriately for the basic information required to establish mail
- handling, leaving the appropriate traces in .gnus. Perhaps a
- customize buffer would be appropriate.
- - Where does your mail come from?
- - If some server, what is your POP/IMAP protocol identity?
- - What is your identity when sending mail, as opposed to posting to
- Usenet?
- - Here are some basic concepts of mail groups (list a few:
- personal mail, company-wide mail, mailing lists, garbage dumps,
- receptacles for outbound copies of what one sends; which ones do
- you want to instantiate, and what mail should land in each?
- [/viz./ problem of nnmail-split-methods interface.]
-
-* Full integration of nnir into Gnus. Generic hooks for adding new
- external nnir sources. I use a couple experimental, in-house tools
- (JPRC is a research lab, occupied with document analysis and machine
- learning) and adding new search engines to nnir by hacking the main
- nnir.el module is rather clunky.
-
-* Manual ordering of articles in an nnml folder.
-
- That is, keystrokes to move articles (or whole threads) up or down
- in the *Summary* buffer relative to the other articles. The order
- would be persistent (e.g., across gnus sessions).
-
- With this ability, an nnml folder would make for a good to-do list.
-
-* Since many uses Gnus to store to do lists I think it is time for an
- nntodo. (I know Kai already written one, maybe use that for a start?)
-
-* nnsql backend, which would allow messages or folders to be imported
- in a local (My|Postgre|?)SQL RDBMS.
-
-* "posting profiles" ideally accessible from a popup menu; allowing
- choice between predefined profiles of
- from,name,organization,etc. Example: I'm at home, but need to reply
- to a work mail; i can hit 'R', then use this command to switch to my
- 'work' profile for purposes of this one reply. (This might already
- be possible with current Gnus, but I don't think so.)
-
-* Better handling of the mail retrieving / splitting feature:
- - the variables <backend>-get-new-mail should not exist anymore. Mail
- retrieving should be a separate matter.
- - we should be able to split mails to groups AND backends at the same time.
- - meanwhile, we should still be able to associate certain mail sources with
- certain backends.
-
-* A better interface to the agent download scoring rules, like the one
- for the other scoring rules.
-
-* Editing of messages in the agents cache.
-
-* More article marks (like '!' or '?').
- Maybe user defined marks that can be displayed as any choosen charakter,
- so one could do things like limiting on, to do whatever one likes with
- these articles.
-
-* A possibility to add notes to messages. If thouse could include links
- to other (stored) messages this would be very practical.
-
-* A nnfolder like backend with .overview files.
- This would not only speed up things, but also allow nnir to work on it.
-
- [done]
-
-* Allow article editing in groups which do not support it, but
- emulating it via deleting the old article and entering the new one
- into the group. This would be very useful to support `T ^' (say) in
- nnimap groups.
-
-* Allow user to specify which kinds of groups should be displayed.
- For example, I want to display all the groups that are displayed
- now, plus those which have cached messages in them. (Gnus does
- display those with ticked messages but not those with
- cached-but-unticked ones.) This would become even more important
- when we allow labels.
-
-* Go through the todo list and remove items already done.
-
-* Create new data type `article identifier' and use that instead of
- article numbers. A first implementation could offer something like
- (num . 4711) but this could be extended. This would be useful for
- using servers with *really* large numbers -- there we could have a
- bignum type. It might also be useful for the nnweb and nnultimate
- thingies where article identifiers are not really numbers.
-
-* Allow use of digests to keep related articles. Normally, you use
- groups to group together articles which are thematically related.
- But sometimes, you have so many themes that this becomes
- impractical. WIBNI I could have digests in a group, and there was a
- way to add a new article to one of the digests in that group?
-
- Or maybe what I really want is a way to tell Gnus that a specific
- thread should always be hidden (as in `T h') by default, while most
- other threads are not hidden by default. Hm.
-
-* New backend between nnfolder and nnml: have more than one article
- per file, but more than one file per group. With .overview files.
-
- [done. nnfolder has .overview. Backward- and forward-compatible
- between 1.0 and 2.0. (setq nnfolder-nov-is-evil t) disables the
- feature]
-
-* .overview files for nnfolder?
-
- [done]
-
-* New backend nnbabylfolder. There is also nnbabyl which is like
- nnmbox but uses babyl format, but there is no babyl format
- equivalent of nnfolder.
-
-* Make movement commands in summary buffer independent of `move after
- mark' behavior when marking articles. Currently, if you don't want
- `E' to move to the next unread article, you have to set
- gnus-summary-goto-unread to nil, and then there is no way to move to
- the next or previous unread article.
-
- This one has two sub-tasks. Providing the commands is one thing,
- finding out useful key bindings for them is another. I think we
- could provide the commands first while not changing the behavior of
- the key bindings; then different people can experiment with
- different key binding schemes until we find something which suits
- many people.
-
-* `Move to next/previous/first article' is a misnomer, since ticked
- articles are also unread but not moved to by these commands. Should
- the terminology be fixed or the documentation, or what?
-
-* Allow sorting of threads by newest article rather than by root of
- thread. Consider the following thread structure:
-
- root1 Jan 1
- leaf1 Jan 4
- root2 Jan 2
- leaf2 Jan 3
-
- These two threads are sorted this way because root1 is older than
- root2. I want an option to sort them the other way round because
- leaf1 is newer than leaf2.
-
-* Improve editing of MIME messages. I would like to use html-mode to
- edit the body of a text/html message, and enriched-mode for
- text/enriched messages, and so on. This should go for multipart
- messages as well. This is probably a hard one since Emacs currently
- does not allow several major modes per buffer. But maybe it would
- be nice to hack Emacs to provide this infrastructure so that Gnus
- can make use of it? This would also make it possible to provide
- nifty commands for editing the headers, for example, rather than
- relying on commands which do the same thing everywhere.
- message-x.el is really just a half-assed attempt at doing it, and
- while it is useful, that's not the way it should be done.
-
- I think Francisco Potort\e,Al\e(B already did something like this?
-
-* Provide commands for editing MML tags. For example, there could be
- a command mml-add-tag-attribute which prompts me for an attribute
- name (with completion, from the set filename, type, ...), and then
- for a value. (This is like `C-c +' in psgml.) Or there could be a
- command which showed me all the attributes in an MML tag and allows
- me to use TAB to move between them, and then to edit each attribute
- value. (This is like `C-c C-a' in psgml.)
-
-* Have Gnus automagically set group parameters for mailing list
- groups. For example, if I have a splitting rule that automatically
- sorts ding@gnus.org into mail.ding, then Gnus should clue in, set
- the to-list parameter to 'ding@gnus.org', and set total-expire.
- (This is probably Hard (TM). And of course the user should be able
- to configure what parameters exactly get set.)
-
-* Along the same lines, automagically detect broken reply-to's. (But
- don't auto-detect users legitimately setting a reply-to header that
- points back to the list.)
-
-* Make it easier to change parameters on a set of groups,
- e.g. set/clear gcc-self on process-marked groups.
-
-* Make it easier/possible to migrate between primary select-methods,
- if that concept is going to be kept. Right now I have only one
- group on my primary server, and I'd kind of like to change from nntp
- to nnml, but apparently this doesn't work well.
-
-* Make it possible to refer to uniquely-named groups without
- select-method prefix (e.g. mail.misc instead of nnml:mail.misc).
-
-* Allow a user-defined picons directory for personal groups.
-
-* Annotations as discussed last autumn. Be able to make comments to
- articles for all bakends. The comments amybe should go into a
- seperate "backend", like nndraft.
-
-* Catchup on a topic and all its subtopics. I.e. do "c y" when on a
- topic line in *Group*.
-
-* Better/more advanced subject washing in *Summary*, see my
- js-gnus-simplify-subject-function I posted earlier this winter.
-
-;; From Newest Features node. Some are not done.
-
-* I would like the zombie-page to contain an URL to the source of the
-latest version of gnus or some explanation on where to find it.
-
-* A way to continue editing the latest Message composition.
-
-* http://www.sonicnet.com/feature/ari3/
-
- [N/A]
-
-* facep is not declared.
-
-* Include a section in the manual on why the number of articles isn't
-the same in the group buffer and on the SPC prompt.
-
-* Interacting with rmail fcc isn't easy.
-
-* Hypermail:
- [N/A]<URL:http://www.falch.no/people/pepper/DSSSL-Lite/archives/>
- [N/A]<URL:http://www.eit.com/software/hypermail/hypermail.html>
- [N/A]<URL:http://homer.ncm.com/>
- [N/A]<URL:http://www.yahoo.com/Computers_and_Internet/Internet/World_Wide_Web/HTML_Converters/>
- http://www.uwsg.indiana.edu/hypermail/linux/kernel/9610/index.html
- [N/A]<URL:http://union.ncsa.uiuc.edu/HyperNews/get/www/html/converters.html>
- [N/A]http://www.miranova.com/gnus-list/
-
- [w3 or nnwarchive?]
-
-* `^-- ' is made into - in LaTeX.
-
-* gnus-kill is much slower than it was in GNUS 4.1.3.
-
-* when expunging articles on low score, the sparse nodes keep
- hanging on?
-
-* starting the first time seems to hang Gnus on some systems. Does
- NEWGROUPS answer too fast?
-
-* nndir doesn't read gzipped files.
-
-* FAQ doesn't have an up node?
-
-* when moving mail from a procmail spool to the crash-box, the
- crash-box is only appropriate to one specific group.
-
-* `t' `t' makes X-Faces disappear.
-
-* nnmh-be-safe means that crossposted articles will be marked as
- unread.
-
-* Orphan score entries don't show on "V t" score trace
-
-* when clearing out data, the cache data should also be reset.
-
-* rewrite gnus-summary-limit-children to be non-recursive to avoid
-exceeding lisp nesting on huge groups.
-
-* expunged articles are counted when computing scores.
-
-* implement gnus-batch-brew-soup
-
-* ticked articles aren't easy to read in pick mode - `n' and stuff
- just skips past them. Read articles are the same.
-
-* topics that contain just groups with ticked articles aren't
- displayed.
-
-* nndoc should always allocate unique Message-IDs.
-
-* If there are mail groups the first time you use Gnus, Gnus'll
- make the mail groups killed.
-
-* no "no news is good news" when using topics.
-
-* when doing crosspost marking, the cache has to be consulted and
- articles have to be removed.
-
-* nnweb should fetch complete articles when they are split into
- several parts.
-
-* scoring on head immediate doesn't work.
-
-* finding short score file names takes forever.
-
-* canceling articles in foreign groups.
-
-* nntp-open-rlogin no longer works.
-
-* C-u C-x C-s (Summary) switches to the group buffer.
-
-* move nnmail-split-history out to the backends.
-
-* nnweb doesn't work properly.
-
-* using a virtual server name as `gnus-select-method' doesn't work?
-
-* when killing/yanking a group from one topic to another in a
- slave, the master will yank it first to one topic and then add it
- to another. Perhaps.
-
-* warn user about `=' redirection of a group in the active file?
-
-* take over the XEmacs menubar and offer a toggle between the XEmacs
- bar and the Gnus bar.
-
-* push active file and NOV file parsing down into C code.
- `(canonize-message-id id)'
- `(mail-parent-message-id references n)'
- `(parse-news-nov-line &optional dependency-hashtb)'
- `(parse-news-nov-region beg end &optional dependency-hashtb fullp)'
- `(parse-news-active-region beg end hashtb)'
-
-* nnml .overview directory with splits.
-
-* asynchronous cache
-
-* postponed commands.
-
-* the selected article show have its Subject displayed in its
- summary line.
-
-* when entering groups, get the real number of unread articles from
- the server?
-
-* sort after gathering threads - make false roots have the headers
- of the oldest orphan with a 0 article number?
-
-* nndoc groups should inherit the score files of their parents?
- Also inherit copy prompts and save files.
-
-* command to start up Gnus (if not running) and enter a mail mode
- buffer.
-
-* allow editing the group description from the group buffer for
- backends that support that.
-
-* gnus-hide,show-all-topics
-
-* groups and sub-topics should be allowed to mingle inside each
- topic, and not just list all subtopics at the end.
-
-* a command to remove all read articles that are not needed to
- connect threads - `gnus-summary-limit-to-sparse-unread'?
-
-* a variable to turn off limiting/cutting of threads in the tree
- buffer.
-
-* a variable to limit how many files are uudecoded.
-
-* add zombie groups to a special "New Groups" topic.
-
-* server mode command: close/open all connections
-
-* put a file date in gnus-score-alist and check whether the file
- has been changed before using it.
-
-* on exit from a digest group, go to the next article in the parent
- group.
-
-* hide (sub)threads with low score.
-
-* when expiring, remove all marks from expired articles.
-
-* gnus-summary-limit-to-body
-
-* a regexp alist that says what level groups are to be subscribed
- on. Eg. - `(("nnml:" . 1))'.
-
-* easier interface to nnkiboze to create ephemeral groups that
- contain groups that match a regexp.
-
-* allow newlines in <URL:> urls, but remove them before using the
- URL.
-
-* If there is no From line, the mail backends should fudge one from
- the "From " line.
-
-* fuzzy simplifying should strip all non-alpha-numerical info from
- subject lines.
-
-* gnus-soup-brew-soup-with-high-scores.
-
-* nntp-ping-before-connect
-
-* command to check whether NOV is evil. "list overview.fmt".
-
-* when entering a group, Gnus should look through the score files
- very early for `local' atoms and set those local variables.
-
-* message annotations.
-
-* topics are always yanked before groups, and that's not good.
-
-* (set-extent-property extent 'help-echo "String to display in
- minibuf") to display help in the minibuffer on buttons under
- XEmacs.
-
-* allow group line format spec to say how many articles there are
- in the cache.
-
-* AUTHINFO GENERIC
-
-* `run-with-idle-timer' in gnus-demon.
-
-* stop using invisible text properties and start using overlays
- instead
-
-* C-c C-f C-e to add an Expires header.
-
-* go from one group to the next; everything is expunged; go to the
- next group instead of going to the group buffer.
-
-* gnus-renumber-cache - to renumber the cache using "low" numbers.
-
-* record topic changes in the dribble buffer.
-
-* `nnfolder-generate-active-file' should look at the folders it
- finds and generate proper active ranges.
-
-* nneething-look-in-files-for-article-heads variable to control
- whether nneething should sniff all files in the directories.
-
-* gnus-fetch-article - start Gnus, enter group, display article
-
-* gnus-dont-move-articles-to-same-group variable when respooling.
-
-* when messages are crossposted between several auto-expirable
- groups, articles aren't properly marked as expirable.
-
-* nneething should allow deletion/moving.
-
-* TAB on the last button should go to the first button.
-
-* if the car of an element in `mail-split-methods' is a function,
- and the function returns non-nil, use that as the name of the
- group(s) to save mail in.
-
-* command for listing all score files that have been applied.
-
-* a command in the article buffer to return to `summary' config.
-
-* `gnus-always-post-using-current-server' - variable to override
- `C-c C-c' when posting.
-
-* nnmail-group-spool-alist - says where each group should use as a
- spool file.
-
-* when an article is crossposted to an auto-expirable group, the
- article should be marker as expirable.
-
-* article mode command/menu for "send region as URL to browser".
-
-* on errors, jump to info nodes that explain the error. For
- instance, on invalid From headers, or on error messages from the
- nntp server.
-
-* when gathering threads, make the article that has no "Re: " the
- parent. Also consult Date headers.
-
-* a token in splits to call shrink-window-if-larger-than-buffer
-
-* `1 0 A M' to do matches on the active hashtb.
-
-* duplicates - command to remove Gnus-Warning header, use the read
- Message-ID, delete the "original".
-
-* when replying to several messages at once, put the "other"
- message-ids into a See-Also header.
-
-* support setext: URL:http://www.bsdi.com/setext/
-
-* support ProleText:
- <URL:http://proletext.clari.net/prole/proletext.html>
-
-* when browsing a foreign server, the groups that are already
- subscribed should be listed as such and not as "K".
-
- [done]
-
-* generate font names dynamically.
-
-* score file mode auto-alist.
-
-* allow nndoc to change/add/delete things from documents. Implement
- methods for each format for adding an article to the document.
-
-* `gnus-fetch-old-headers' `all' value to incorporate absolutely
- all headers there is.
-
-* function like `|', but concatenate all marked articles and pipe
- them to the process.
-
-* cache the list of killed (or active) groups in a separate file.
- Update the file whenever we read the active file or the list of
- killed groups in the .eld file reaches a certain length.
-
-* function for starting to edit a file to put into the current mail
- group.
-
-* score-find-trace should display the total score of the article.
-
-* "ghettozie" - score on Xref header and nix it out after using it
- to avoid marking as read in other groups it has been crossposted
- to.
-
-* look at procmail splitting. The backends should create the
- groups automatically if a spool file exists for that group.
-
-* function for backends to register themselves with Gnus.
-
-* when replying to several process-marked articles, have all the
- From end up in Cc headers? Variable to toggle.
-
-* command to delete a crossposted mail article from all groups it
- has been mailed to.
-
-* `B c' and `B m' should be crosspost aware.
-
-* hide-pgp should also hide PGP public key blocks.
-
-* Command in the group buffer to respool process-marked groups.
-
-* `gnus-summary-find-matching' should accept pseudo-"headers" like
- "body", "head" and "all"
-
-* When buttifying <URL: > things, all white space (including
- newlines) should be ignored.
-
-* Process-marking all groups in a topic should process-mark groups
- in subtopics as well.
-
-* Add non-native groups to the list of killed groups when killing
- them.
-
-* nntp-suggest-kewl-config to probe the nntp server and suggest
- variable settings.
-
-* add edit and forward secondary marks.
-
-* nnml shouldn't visit its .overview files.
-
-* allow customizing sorting within gathered threads.
-
-* `B q' shouldn't select the current article.
-
-* nnmbox should support a newsgroups file for descriptions.
-
-* allow fetching mail from several pop servers.
-
- [done]
-
-* Be able to specify whether the saving commands save the original
- or the formatted article.
-
-* a command to reparent with the child process-marked (cf. `T ^'.).
-
-* I think the possibility to send a password with nntp-open-rlogin
- should be a feature in Red Gnus.
-
-* The `Z n' command should be possible to execute from a mouse
- click.
-
-* more limiting functions - date, etc.
-
-* be able to limit on a random header; on body; using reverse
- matches.
-
-* a group parameter (`absofucking-total-expiry') that will make
- Gnus expire even unread articles.
-
-* a command to print the article buffer as postscript.
-
-* variable to disable password fetching when opening by
- nntp-open-telnet.
-
-* manual: more example servers - nntp with rlogin, telnet
-
-* checking for bogus groups should clean topic alists as well.
-
-* canceling articles in foreign groups.
-
-* article number in folded topics isn't properly updated by Xref
- handling.
-
-* Movement in the group buffer to the next unread group should go
- to the next closed topic with unread messages if no group can be
- found.
-
-* Extensive info pages generated on the fly with help everywhere -
- in the "*Gnus edit*" buffers, for instance.
-
-* Topic movement commands - like thread movement. Up, down,
- forward, next.
-
-* a way to tick/mark as read Gcc'd articles.
-
- [done, (setq gnus-inews-mark-gcc-as-read t)]
-
-* a way to say that all groups within a specific topic comes from a
- particular server? Hm.
-
-* `gnus-article-fill-if-long-lines' - a function to fill the
- article buffer if there are any looong lines there.
-
-* `T h' should jump to the parent topic and fold it.
-
-* a command to create an ephemeral nndoc group out of a file, and
- then splitting it/moving it to some other group/backend.
-
-* a group parameter for nnkiboze groups that says that all kibozed
- articles should be entered into the cache.
-
-* It should also probably be possible to delimit what
- `gnus-jog-cache' does - for instance, work on just some groups, or
- on some levels, and entering just articles that have a score
- higher than a certain number.
-
-* nnfolder should append to the folder instead of re-writing the
- entire folder to disk when accepting new messages.
-
-* allow all backends to do the proper thing with .gz files.
-
-* a backend for reading collections of babyl files nnbabylfolder?
-
-* a command for making the native groups into foreign groups.
-
-* server mode command for clearing read marks from all groups from
- a server.
-
-* when following up multiple articles, include all To, Cc, etc
- headers from all articles.
-
-* a command for deciding what the total score of the current thread
- is. Also a way to highlight based on this.
-
-* command to show and edit group scores
-
-* a gnus-tree-minimize-horizontal to minimize tree buffers
- horizontally.
-
-* command to generate nnml overview file for one group.
-
-* `C-u C-u a' - prompt for many crossposted groups.
-
-* keep track of which mail groups have received new articles (in
- this session). Be able to generate a report and perhaps do some
- marking in the group buffer.
-
-* gnus-build-sparse-threads to a number - build only sparse threads
- that are of that length.
-
-* have nnmh respect mh's unseen sequence in .mh_profile.
-
-* cache the newsgroups descriptions locally.
-
-* asynchronous posting under nntp.
-
-* be able to control word adaptive scoring from the score files.
-
-* a variable to make `C-c C-c' post using the "current" select
- method.
-
-* `limit-exclude-low-scored-articles'.
-
-* if `gnus-summary-show-thread' is a number, hide threads that have
- a score lower than this number.
-
-* split newsgroup subscription variable up into "order" and
- "method".
-
-* buttonize ange-ftp file names.
-
-* a command to make a duplicate copy of the current article so that
- each copy can be edited separately.
-
-* nnweb should allow fetching from the local nntp server.
-
-* record the sorting done in the summary buffer so that it can be
- repeated when limiting/regenerating the buffer.
-
-* nnml-generate-nov-databses should generate for all nnml servers.
-
-* when the user does commands in the group buffer, check the
- modification time of the .newsrc.eld file and use
- ask-user-about-supersession-threat. Also warn when trying to save
- .newsrc.eld and it has changed.
-
-* M-g on a topic will display all groups with 0 articles in the
- topic.
-
-* command to remove all topic stuff.
-
-* allow exploding incoming digests when reading incoming mail and
- splitting the resulting digests.
-
-* nnsoup shouldn't set the `message-' variables.
-
-* command to nix out all nnoo state information.
-
-* nnmail-process-alist that calls functions if group names matches
- an alist - before saving.
-
-* use buffer-invisibility-spec everywhere for hiding text.
-
-* variable to activate each group before entering them to get the
- (new) number of articles. `gnus-activate-before-entering'.
-
-* command to fetch a Message-ID from any buffer, even starting Gnus
- first if necessary.
-
-* when posting and checking whether a group exists or not, just ask
- the nntp server instead of relying on the active hashtb.
-
-* buttonize the output of `C-c C-a' in an apropos-like way.
-
-* `G p' should understand process/prefix, and allow editing of
- several groups at once.
-
-* command to create an ephemeral nnvirtual group that matches some
- regexp(s).
-
-* nndoc should understand "Content-Type: message/rfc822" forwarded
- messages.
-
- [done]
-
-* it should be possible to score "thread" on the From header.
-
-* hitting RET on a "gnus-uu-archive" pseudo article should unpack
- it.
-
-* `B i' should display the article at once in the summary buffer.
-
-* remove the "*" mark at once when unticking an article.
-
-* `M-s' should highlight the matching text.
-
-* when checking for duplicated mails, use Resent-Message-ID if
- present.
-
-* killing and yanking groups in topics should be better. If
- killing one copy of a group that exists in multiple topics, only
- that copy should be removed. Yanking should insert the copy, and
- yanking topics should be possible to be interspersed with the
- other yankings.
-
-* command for enter a group just to read the cached articles. A
- way to say "ignore the nntp connection; just read from the cache."
-
-* `X u' should decode base64 articles.
-
- [`X m' does so.]
-
-* a way to hide all "inner" cited text, leaving just the most
- recently cited text.
-
-* nnvirtual should be asynchronous.
-
-* after editing an article, gnus-original-article-buffer should be
- invalidated.
-
-* there should probably be a way to make Gnus not connect to the
- server and just read the articles in the server
-
-* allow a `set-default' (or something) to change the default value
- of nnoo variables.
-
-* a command to import group infos from a .newsrc.eld file.
-
-* groups from secondary servers have the entire select method
- listed in each group info.
-
-* a command for just switching from the summary buffer to the group
- buffer.
-
-* a way to specify that some incoming mail washing functions should
- only be applied to some groups.
-
-* Message `C-f C-t' should ask the user whether to heed
- mail-copies-to: never.
-
-* new group parameter - `post-to-server' that says to post using
- the current server. Also a variable to do the same.
-
-* the slave dribble files should auto-save to the slave file names.
-
-* a group parameter that says what articles to display on group
- entry, based on article marks.
-
-* a way to visually distinguish slave Gnusae from masters. (Whip
- instead of normal logo?)
-
-* Use DJ Bernstein "From " quoting/dequoting, where applicable.
-
-* Why is hide-citation-maybe and hide-citation different? Also
- clear up info.
-
-* group user-defined meta-parameters.
-
- From: John Griffith <griffith@sfs.nphil.uni-tuebingen.de>
-
-* I like the option for trying to retrieve the FAQ for a group and
- I was thinking it would be great if for those newsgroups that had
- archives you could also try to read the archive for that group.
- Part of the problem is that archives are spread all over the net,
- unlike FAQs. What would be best I suppose is to find the one
- closest to your site.
-
- In any case, there is a list of general news group archives at
- ftp://ftp.neosoft.com/pub/users/claird/news.lists/newsgroup_archives.html
-
-* From: Jason L Tibbitts III <tibbs@hpc.uh.edu>
- (add-hook 'gnus-select-group-hook
- (lambda ()
- (gnus-group-add-parameter group
- (cons 'gnus-group-date-last-entered (list (current-time-string))))))
-
- (defun gnus-user-format-function-d (headers)
- "Return the date the group was last read."
- (cond ((car (gnus-group-get-parameter gnus-tmp-group 'gnus-group-date-last-entered)))
- (t "")))
-
-* tanken var at n\e,Ae\e(Br du bruker `gnus-startup-file' som prefix (FOO)
- til \e,Ae\e(B lete opp en fil FOO-SERVER, FOO-SERVER.el, FOO-SERVER.eld,
- kan du la den v\e,Af\e(Bre en liste hvor du bruker hvert element i listen
- som FOO, istedet. da kunne man hatt forskjellige serveres
- startup-filer forskjellige steder.
-
-* LMI> Well, nnbabyl could alter the group info to heed labels like
- LMI> answered and read, I guess.
-
- It could also keep them updated (the same for the Status: header of
- unix mbox files).
-
- They could be used like this:
-
- `M l <name> RET' add label <name> to current message.
- `M u <name> RET' remove label <name> from current message.
- `/ l <expr> RET' limit summary buffer according to <expr>.
-
- <expr> would be a boolean expression on the labels, e.g.
-
- `/ l bug & !fixed RET'
-
- would show all the messages which are labeled `bug' but not labeled
- `fixed'.
-
- One could also imagine the labels being used for highlighting, or
- affect the summary line format.
-
-* Sender: abraham@dina.kvl.dk
-
- I'd like a gnus-find-file which work like find file, except that it
- would recognize things that looks like messages or folders:
-
- - If it is a directory containing numbered files, create an nndir
- summary buffer.
-
- - For other directories, create a nneething summary buffer.
-
- - For files matching "\\`From ", create a nndoc/mbox summary.
-
- - For files matching "\\`BABYL OPTIONS:", create a nndoc/baby
- summary.
-
- - For files matching "\\`[^ \t\n]+:", create an *Article* buffer.
-
- - For other files, just find them normally.
-
- I'd like `nneething' to use this function, so it would work on a
- directory potentially containing mboxes or babyl files.
-
-* Please send a mail to bwarsaw@cnri.reston.va.us (Barry A. Warsaw)
- and tell him what you are doing.
-
-* Currently, I get prompted:
-
- decend into sci? - type y decend into sci.something ? - type n
- decend into ucd?
-
- The problem above is that since there is really only one
- subsection of science, shouldn't it prompt you for only descending
- sci.something? If there was a sci.somethingelse group or section,
- then it should prompt for sci? first the sci.something? then
- sci.somethingelse?...
-
-* Ja, det burde v\e,Af\e(Bre en m\e,Ae\e(Bte \e,Ae\e(B si slikt. Kanskje en ny variabel?
- `gnus-use-few-score-files'? S\e,Ae\e(B kunne score-regler legges til den
- "mest" lokale score-fila. F. eks. ville no-gruppene betjenes av
- "no.all.SCORE", osv.
-
-* What i want is for Gnus to treat any sequence or combination of
- the following as a single spoiler warning and hide it all,
- replacing it with a "Next Page" button:
-
- ^L's
-
- more than n blank lines
-
- more than m identical lines (which should be replaced with button
- to show them)
-
- any whitespace surrounding any of the above
-
-* Well, we could allow a new value to `gnus-thread-ignore-subject' -
- `spaces', or something. (We could even default to that.) And then
- subjects that differ in white space only could be considered the
- "same" subject for threading purposes.
-
-* Modes to preprocess the contents (e.g. jka-compr) use the second
- form "(REGEXP FUNCTION NON-NIL)" while ordinary modes (e.g. tex)
- use the first form "(REGEXP . FUNCTION)", so you could use it to
- distinguish between those two types of modes. (auto-modes-alist,
- insert-file-contents-literally.)
-
-* Under XEmacs - do funny article marks: tick - thumb tack killed -
- skull soup - bowl of soup score below - dim light bulb score over
- - bright light bulb
-
-* Yes. I think the algorithm is as follows:
-
- Group-mode
-
- show-list-of-articles-in-group
- if (key-pressed == SPACE)
- if (no-more-articles-in-group-to-select)
- if (articles-selected)
- start-reading-selected-articles;
- junk-unread-articles;
- next-group;
- else
- show-next-page;
-
- else if (key-pressed = '.')
- if (consolidated-menus) # same as hide-thread in Gnus
- select-thread-under-cursor;
- else
- select-article-under-cursor;
-
-
- Article-mode
- if (key-pressed == SPACE)
- if (more-pages-in-article)
- next-page;
- else if (more-selected-articles-to-read)
- next-article;
- else
- next-group;
-
-* My precise need here would have been to limit files to Incoming*.
- One could think of some `nneething-only-files' variable, but I
- guess it would have been unacceptable if one was using many
- unrelated such nneething groups.
-
- A more useful approach would be to, in response to the `G D'
- prompt, be allowed to say something like: `~/.mail/Incoming*',
- somewhat limiting the top-level directory only (in case
- directories would be matched by the wildcard expression).
-
-* It would be nice if it also handled
-
- <URL:news://sunsite.auc.dk/>
-
- which should correspond to `B nntp RET sunsite.auc.dk' in *Group*.
-
- [done]
-
-* Take a look at w3-menu.el in the Emacs-W3 distribution - this
- works out really well. Each menu is 'named' by a symbol that
- would be on a gnus-*-menus (where * would be whatever, but at
- least group, summary, and article versions) variable.
-
- So for gnus-summary-menus, I would set to '(sort mark dispose ...)
-
- A value of '1' would just put _all_ the menus in a single 'GNUS'
- menu in the main menubar. This approach works really well for
- Emacs-W3 and VM.
-
-* nndoc should take care to create unique Message-IDs for all its
- articles.
-
-* gnus-score-followup-article only works when you have a summary
- buffer active. Make it work when posting from the group buffer as
- well. (message-sent-hook).
-
-* rewrite gnus-demon to use run-with-idle-timers.
-
-* * Enhancements to Gnus:
-
- Add two commands:
-
- * gnus-servers (gnus-start-server-buffer?)-enters Gnus and goes
- straight to the server buffer, without opening any connections to
- servers first.
-
- * gnus-server-read-server-newsrc-produces a buffer very similar to
- the group buffer, but with only groups from that server listed;
- quitting this buffer returns to the server buffer.
-
-* add a command to check the integrity of an nnfolder folder - go
- through the article numbers and see that there are no duplicates,
- and stuff.
-
-* `unsmileyfy-buffer' to undo smileification.
-
-* a command to give all relevant info on an article, including all
- secondary marks.
-
-* when doing `-request-accept-article', the backends should do the
- nnmail duplicate checking.
-
-* allow `message-signature-file' to be a function to return the
- value of the signature file.
-
-* In addition, I would love it if I could configure message-tab so
- that it could call `bbdb-complete-name' in other headers. So,
- some sort of interface like
-
- (setq message-tab-alist '((message-header-regexp
- message-expand-group) ("^\\(To\\|[cC]c\\|[bB]cc\\)"
- bbdb-complete-name)))
-
- then you could run the relevant function to complete the
- information in the header
-
-* cache the newsgroups file locally to avoid reloading it all the
- time.
-
-* a command to import a buffer into a group.
-
-* nnweb should allow fetching by Message-ID from servers.
-
-* point in the article buffer doesn't always go to the beginning of
- the buffer when selecting new articles.
-
-* a command to process mark all unread articles.
-
-* `gnus-gather-threads-by-references-and-subject' - first do
- gathering by references, and then go through the dummy roots and
- do more gathering by subject.
-
-* gnus-uu-mark-in-numerical-order - process mark articles in
- article numerical order.
-
-* (gnus-thread-total-score (gnus-id-to-thread (mail-header-id
- (gnus-summary-article-header)))) bind to a key.
-
-* sorting by score is wrong when using sparse threads.
-
-* a command to fetch an arbitrary article - without having to be in
- the summary buffer.
-
-* a new nncvs backend. Each group would show an article, using
- version branches as threading, checkin date as the date, etc.
-
-* http://www.dejanews.com/forms/dnsetfilter_exp.html ? This filter
- allows one to construct advance queries on the Dejanews database
- such as specifying start and end dates, subject, author, and/or
- newsgroup name.
-
-* new Date header scoring type - older, newer
-
-* use the summary toolbar in the article buffer.
-
-* a command to fetch all articles that are less than X days old.
-
-* in pick mode, `q' should save the list of selected articles in the
- group info. The next time the group is selected, these articles
- will automatically get the process mark.
-
-* Isn't it possible to (also?) allow M-^ to automatically try the
- default server if it fails on the current server? (controlled by a
- user variable, (nil, t, 'ask)).
-
-* make it possible to cancel articles using the select method for
- the current group.
-
-* `gnus-summary-select-article-on-entry' or something. It'll
- default to t and will select whatever article decided by
- `gnus-auto-select-first'.
-
-* a new variable to control which selection commands should be
- unselecting. `first', `best', `next', `prev', `next-unread',
- `prev-unread' are candidates.
-
-* be able to select groups that have no articles in them to be able
- to post in them (using the current select method).
-
-* be able to post via DejaNews.
-
-* `x' should retain any sortings that have been performed.
-
-* allow the user to specify the precedence of the secondary marks.
- Also allow them to be displayed separately.
-
-* gnus-summary-save-in-pipe should concatenate the results from the
- processes when doing a process marked pipe.
-
-* a new match type, like Followup, but which adds Thread matches on
- all articles that match a certain From header.
-
-* a function that can be read from kill-emacs-query-functions to
- offer saving living summary buffers.
-
-* a function for selecting a particular group which will contain
- the articles listed in a list of article numbers/id's.
-
-* a battery of character translation functions to translate common
- Mac, MS (etc) characters into ISO 8859-1.
-
- (defun article-fix-m$word ()
- "Fix M$Word smartquotes in an article."
- (interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (while (search-forward "\221" nil t)
- (replace-match "`" t t))
- (goto-char (point-min))
- (while (search-forward "\222" nil t)
- (replace-match "'" t t))
- (goto-char (point-min))
- (while (search-forward "\223" nil t)
- (replace-match "\"" t t))
- (goto-char (point-min))
- (while (search-forward "\224" nil t)
- (replace-match "\"" t t)))))
-
- [done]
-
-* (add-hook 'gnus-exit-query-functions
- '(lambda ()
- (if (and (file-exists-p nnmail-spool-file)
- (> (nnheader-file-size nnmail-spool-file) 0))
- (yes-or-no-p "New mail has arrived. Quit Gnus anyways? ")
- (y-or-n-p "Are you sure you want to quit Gnus? "))))
-
-* allow message-default-headers to be a function.
-
-* new Date score match types - < > = (etc) that take floating point
- numbers and match on the age of the article.
-
-* > > > If so, I've got one gripe: It seems that when I fire up gnus 5.2.25
- > > > under xemacs-19.14, it's creating a new frame, but is erasing the
- > > > buffer in the frame that it was called from =:-O
- >
- > > Hm. How do you start up Gnus? From the toolbar or with
- > > `M-x gnus-other-frame'?
- >
- > I normally start it up from the toolbar; at
- > least that's the way I've caught it doing the
- > deed before.
-
-* all commands that react to the process mark should push the
- current process mark set onto the stack.
-
-* gnus-article-hide-pgp Selv ville jeg nok ha valgt \e,Ae\e(B slette den
- dersom teksten matcher
- "\\(This\s+\\)?[^ ]+ has been automatically signed by"
- og det er maks hundre tegn mellom match-end og ---linja. Men -det-
- er min type heuristikk og langt fra alles.
-
-* `gnus-subscribe-sorted' - insert new groups where they would have
- been sorted to if `gnus-group-sort-function' were run.
-
-* gnus-(group,summary)-highlight should respect any `face' text
- props set on the lines.
-
-* use run-with-idle-timer for gnus-demon instead of the home-brewed
- stuff for better reliability.
-
-* add a way to select which NoCeM type to apply - spam, troll, etc.
-
-* nndraft-request-group should tally auto-save files.
-
-* implement nntp-retry-on-break and nntp-command-timeout.
-
-* gnus-article-highlight-limit that says when not to highlight
- (long) articles.
-
-* (nnoo-set SERVER VARIABLE VALUE)
-
- [done]
-
-* nn*-spool-methods
-
-* interrupitng agent fetching of articles should save articles.
-
-* command to open a digest group, and copy all the articles there
- to the current group.
-
-* a variable to disable article body highlights if there's more than
- X characters in the body.
-
-* handle 480/381 authinfo requests separately.
-
-* include the texi/dir file in the distribution.
-
-* format spec to "tab" to a position.
-
-* Move all prompting to the new `M-n' default style.
-
-* command to display all dormant articles.
-
-* gnus-auto-select-next makeover - list of things it should do.
-
-* a score match type that adds scores matching on From if From has
- replied to something someone else has said.
-
-* Read Netscape discussion groups:
- snews://secnews.netscape.com/netscape.communicator.unix
-
-* One command to edit the original version if an article, and one to
- edit the displayed version.
-
-* `T v' - make all process-marked articles the children of the
- current article.
-
-* Switch from initial text to the new default text mechanism.
-
-* How about making it possible to expire local articles? Will it be
- possible to make various constraints on when an article can be
- expired, e.g. (read), (age > 14 days), or the more interesting
- (read & age > 14 days)?
-
-* New limit command--limit to articles that have a certain string in
- the head or body.
-
-* Allow breaking lengthy NNTP commands.
-
-* gnus-article-highlight-limit, to disable highlighting in big
- articles.
-
-* Editing an article should put the article to be edited in a
- special, unique buffer.
-
-* A command to send a mail to the admin-address group param.
-
-* A Date scoring type that will match if the article is less than a
- certain number of days old.
-
-* New spec: %~(tab 56) to put point on column 56
-
-* Allow Gnus Agent scoring to use normal score files.
-
-* Rething the Agent active file thing. `M-g' doesn't update the
- active file, for instance.
-
-* With dummy roots, `^' and then selecing the first article in any
- other dummy thread will make Gnus highlight the dummy root instead
- of the first article.
-
-* Propagate all group properties (marks, article numbers, etc) up to
- the topics for displaying.
-
-* `n' in the group buffer with topics should go to the next group
- with unread articles, even if that group is hidden in a topic.
-
-* gnus-posting-styles doesn't work in drafts.
-
-* gnus-summary-limit-include-cached is slow when there are many
- articles in the cache, since it regenerates big parts of the
- summary buffer for each article.
-
-* Implement gnus-batch-brew-soup.
-
-* Group parameters and summary commands for un/subscribing to mailing
- lists.
-
-* Introduce nnmail-home-directory.
-
-* gnus-fetch-group and friends should exit Gnus when the user exits
- the group.
-
-* The jingle is only played on the second invocation of Gnus.
-
-* Bouncing articles should do MIME.
-
- [done]
-
-* Crossposted articles should "inherit" the % or mark from the other
- groups it has been crossposted to, or something. (Agent.)
-
-* If point is on a group that appears multiple times in topics, and
- you press `l', point will move to the first instance of the group.
-
-* A spec for the group line format to display the number of
- agent-downloaded articles in the group.
-
-* Some nntp servers never respond when posting, so there should be a
- timeout for all commands.
-
-* When stading on a topic line and `t'-ing, point goes to the last
- line. It should go somewhere else.
-
-* I'm having trouble accessing a newsgroup with a "+" in its name
- with Gnus. There is a new newsgroup on msnews.microsoft.com named
- "microsoft.public.multimedia.directx.html+time" that I'm trying to
- access as
- "nntp+msnews.microsoft.com:microsoft.public.multimedia.directx.html+time"
- but it gives an error that it cant access the group.
-
- Is the "+" character illegal in newsgroup names? Is there any way
- in Gnus to work around this? (gnus 5.6.45 - XEmacs 20.4)
-
- [It works in 5.8.8.]
-
-* When `#F', do:
-
- Subject: Answer to your mails 01.01.1999-01.05.1999
- --text follows this line--
- Sorry I killfiled you...
-
- Under the subject "foo", you wrote on 01.01.1999:
- > bar
- Under the subject "foo1", you wrote on 01.01.1999:
- > bar 1
-
-* Allow "orphan" scores in the Agent scoring.
-
- [done?]
-
-* - Edit article's summary line.
- - End edit
- - Sort lines in buffer by subject
-
- --> the old subject line appears in Summary buffer, not the one that was
- just changed to.
-
-* Remove list identifiers from the subject in the summary when doing
- `^' and the like.
-
-* Have the Agent write out articles, one by one, as it retrieves
- them, to avoid having to re-fetch them all if Emacs should crash
- while fetching.
-
-* Be able to forward groups of messages as MIME digests.
-
- [done]
-
-* nnweb should include the "get whole article" article when getting
- articles.
-
-* When I type W W c (gnus-article-hide-citation) in the summary
- buffer, the citations are revealed, but the [+] buttons don't turn
- into [-] buttons. (If I click on one of the [+] buttons, it does
- turn into a [-] button.)
-
- [fixed]
-
-* Perhaps there should be a command to "attach" a buffer of comments
- to a message? That is, `B WHATEVER', you're popped into a buffer,
- write something, end with `C-c C-c', and then the thing you've
- written gets to be the child of the message you're commenting.
-
-* Handle external-body parts.
-
- [done for some access types]
-
-* When renaming a group name, nnmail-split-history does not get the
- group name renamed.
-
-* Allow mail splitting on bodies when using advanced mail splitting.
-
- (body "whatever.text")
-
-* Be able to run `J u' from summary buffers.
-
- [Done]
-
-* Solve the halting problem.
-
-\f
-;; Local Variables:
-;; mode: outline
-;; coding: iso-2022-7bit
-;; paragraph-separate: "[ \f]*$"
-;; End:
+++ /dev/null
-2000-10-27 Jason Rumney <jasonr@gnu.org>
-
- * gnus-art.el (gnus-signature-face): Use italic on any frame that
- supports it.
-
-2000-10-27 14:19:53 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-mlspl.el: Require cl when compiling.
- * messagexmas.el: Ditto.
- * mm-util.el: Ditto.
- * rfc2047.el: Ditto.
- * rfc2231.el: Ditto.
- * smiley-ems.el: Ditto.
- * uudecode.el: Ditto.
-
- * smiley-ems.el (smiley-region): Use mapcar.
-
-2000-10-27 Stefan Monnier <monnier@cs.yale.edu>
-
- * ietf-drums.el: Require cl when compiling.
-
-2000-10-27 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mm-valid-and-fit-image-p): Don't test
- window-system here.
-
- * gnus-art.el (gnus-article-x-face-command): Check
- gnus-article-compface-xbm.
- (gnus-treat-display-xface): Check for uncompface.
-
- * nnheader.el (nnheader-translate-file-chars): Only kludge things
- under Doze with XEmacs.
-
-2000-10-26 Simon Josefsson <sj@extundo.com>
-
- * mail-source.el (mail-sources): IMAP predicate is a string.
- (mail-sources): Add default values for IMAP mailbox, predicate and
- fetchflag.
-
-2000-10-26 Dave Love <fx@gnu.org>
-
- * flow-fill.el: Require cl when compiling.
-
- * mail-source.el: Require imap when compiling and defvar
- display-time-mail-function. Require mm-util.
- (nnheader-cancel-timer): Autoload.
- (mail-source-imap-authenticators, mail-source-imap-streams): New
- variables.
- (mail-sources): Use them.
-
-2000-10-25 20:13:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-viewer-completion-map): New.
- (mm-interactively-view-part): Use it.
-
-2000-10-25 18:51:12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encode-region): Don't break if a QP-word
- could be fitted in one line.
-
-2000-10-25 Dirk Meyer <dischi@tzi.de>
-
- * gnus-demon.el (gnus-demon-time-to-step): theHour was set to
- seconds instead of hour.
-
-2000-10-25 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mail-source.el (mail-sources): Better `:type'.
-
-2000-10-24 18:31:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer):
- gnus-refer-article-method might be a single method.
- * gnus-sum.el (gnus-refer-article-methods): The second could be
- a named method.
-
-2000-10-23 Simon Josefsson <simon@josefsson.org>
-
- * flow-fill.el (fill-flowed): Don't flow "-- " lines.
- (fill-flowed): Make "quote-depth wins" rule work when first line
- is at level 0.
-
-2000-10-21 11:23:21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-multibyte-p): Test (featurep 'xemacs).
-
-2000-10-21 10:54:57 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-mime-total-parts): New function.
- (gnus-mm-display-part): Use it.
- (gnus-mime-display-single): Ditto.
- (gnus-mime-display-alternative): Ditto.
-
-2000-10-21 09:38:27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcaps): Don't use parse-colon-path,
- because they are files, not directories.
- (mailcap-parse-mimetypes): Ditto.
-
-2000-10-20 19:55:59 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Check validity of charset.
-
-2000-10-18 Dave Love <fx@gnu.org>
-
- * mail-source.el (mm-util): Require.
- (defvar): Use rmail-spool-directory unconditionally.
-
- * gnus-nocem.el (gnus-nocem-issuers): Update.
- (gnus-nocem-check-from): New option.
- (gnus-nocem-scan-groups): Use it.
- (gnus-nocem-check-article): Bind gnus-newsgroup-name.
-
-2000-10-18 Miles Bader <miles@lsi.nec.co.jp>
-
- * gnus-nocem.el (gnus-nocem-check-article-limit): New variable.
- (gnus-nocem-scan-groups): Obey `gnus-nocem-check-article-limit'.
-
-2000-10-18 Simon Josefsson <simon@josefsson.org>
-
- * nnheader.el (nnheader-parse-head): Try both "from:" and "from: ".
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Ditto.
-
-2000-10-17 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Search for "from:"
- instead of "from: " for rfc822 compliance.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Ditto. Insert SPC.
-
- * nnheader.el (nnheader-parse-head): Ditto.
-
-2000-10-13 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * mail-source.el (mail-source-keyword-map): Use
- `rmail-spool-directory' as a default directory for the `file'
- source, if the variable is defined. Fall back to hardcoded
- "/usr/spool/mail/", as before. Suggestion by Steven E. Harris
- <seh@speakeasy.org>.
-
-2000-10-13 12:01:15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Replace the header
- delimiter with a blank line.
-
-2000-10-13 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-get-split-value): Use first match only (Ed L
- Cashin <ecashin@coe.uga.edu>).
-
-2000-10-13 10:52:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el (gnus-article-compface-xbm): Ignore errors.
-
-2000-10-11 John Wiegley <johnw@gnu.org>
-
- * gnus-topic.el (gnus-topic-mode): Use `setq' to clear
- `gnus-group-change-level-function', instead of `remove-hook',
- because it's not a hook!
-
- * gnus-mlspl.el (gnus-group-split-update): Check the value of
- `nnmail-crosspost', and use it to set the `no-crosspost'
- argument when calling `gnus-group-split-fancy'. Otherwise, it
- assumes that cross-posting is always OK, no matter what
- `nmail-crosspost' is set to.
- (gnus-group-split-fancy): The argument order in the
- second-to-last `push' call was wrong, but since `no-crosspost'
- was always nil, it was never being triggered.
-
- * gnus-art.el (gnus-treat-hide-citation-maybe): Added this
- variable to correspond with `gnus-article-hide-citation-maybe'.
- (gnus-treatment-function-alist): Added entry for the above
- correlation.
-
-2000-10-12 08:26:30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Revert to old.
- (mm-with-unibyte-current-buffer-mule4): New function.
- * qp.el (quoted-printable-encode-region): Use it.
- * rfc2047.el (rfc2047-decode): Ditto.
- * webmail.el (webmail-init): Revert to use mm-disable-multibyte.
-
-2000-10-10 08:44:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-fold-region): "=?=" is not a break point.
-
-2000-10-10 00:00:28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-init): Use mm-disable-multibyte-mule4.
-
-2000-10-09 22:50:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * base64.el (base64-decode-region): Just give a message if the end
- is not sane.
-
-2000-10-09 20:09:11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Move fold into
- encode-region.
- (rfc2047-dissect-region): Rewrite.
- (rfc2047-encode-region): Rewrite.
- (rfc2047-fold-region): Fold any line longer than 76.
- (rfc2047-unfold-region): New function.
- (rfc2047-decode-region): Use it.
- (rfc2047-q-encode-region): Don't break at bob.
-
-2000-10-09 17:12:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-open-connection): Kill process buffer when quit.
- (nntp-connection-timeout): Add a note. SIGALRM is ignored in both
- FSF Emacs 20 and XEmacs 21.
- * gnus-agent.el (gnus-agent-fetch-session): Catch quit.
-
-2000-10-09 Dave Love <fx@gnu.org>
-
- * gnus-audio.el: Don't require cl.
- (gnus-audio): New custom group.
- (gnus-audio-inline-sound): Change to work with Emacs.
- (gnus-audio-directory, gnus-audio-directory)
- (gnus-audio-au-player): Customize.
- (gnus-audio-play): Try external player if play-sound-file fails.
- Use file-name-extension, not string-match.
-
- * gnus-art.el (article-de-quoted-unreadable)
- (article-de-base64-unreadable): Fold search case rather than
- downcasing string. Apply mm-charset-to-coding-system to arg of
- quoted-printable-decode-region.
- (gnus-article-dumbquotes-map): Fix dashes.
- (gnus-button-mailto, gnus-button-embedded-url): Doc fix.
- (gnus-button-reply): Just alias it.
-
-2000-10-09 Stefan Monnier <monnier@cs.yale.edu>
-
- * mm-encode.el: Require CL. At least, for `incf'.
-
- * nnfolder.el (nnfolder-ignore-active-file): Typos.
-
- * gnus-mh.el (gnus-summary-save-in-folder): Obey mh-lib-progs.
-
- * gnus-kill.el (gnus-kill): Typo.
-
-2000-10-09 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-update-cache): Use `:ascent center'.
-
-2000-10-09 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-group-overview-filename): Create directory for
- newfile (when use long filenames is nil). Copy+delete file if
- rename didn't work.
- (nnimap-group-overview-filename): `rename-file' and `copy-file'
- doesn't return anything useful, use ignore-errors instead.
-
-2000-10-08 13:05:11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-compile): Delete old elc files first.
-
-2000-10-08 10:59:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el (gnus-kill-all-overlays): Move here.
- * gnus-util.el (gnus-kill-all-overlays): Move out.
- * gnus-sum.el (gnus-cache-write-active): Auto load.
- * lpath.el: Shut up.
- * nnweb.el (nnweb-url-retrieve-asynch): url-retrieve is
- asynchronous in Exp version.
-
-2000-10-08 08:57:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el, gnus-ems.el, gnus-start.el: Remove gnus-xemacs.
- * gnus-ems.el: Autoload smiley.
- * gnus-art.el (gnus-treat-display-smileys): Default value in Emacs 21.
-
-2000-10-08 08:45:48 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-display-article): Enable multibyte.
- (gnus-summary-select-article): Don't enable multibyte here.
- (gnus-summary-goto-article): Ditto.
-
-2000-10-08 Christoph Conrad <christoph.conrad@gmx.de>
-
- * gnus-draft.el (gnus-draft-send-message): Typo.
-
-2000-10-08 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-verify-uidvalidity): Delete overview file when
- uid validity changes.
- (nnimap-group-overview-filename): Store uidvalidity in filenames.
- Rename old files into new format.
-
-2000-10-07 15:49:39 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-enable-multibyte-mule4): New.
- (mm-disable-multibyte-mule4): New.
- * gnus-sum.el (gnus-summary-mode): Use it.
- (gnus-summary-select-article): Ditto.
- (gnus-summary-goto-article): Use enable multibyte.
- * rfc2047.el (rfc2047-decode): Use unibyte.
-
-2000-10-07 15:42:59 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-logic.el (gnus-advanced-string): Use "" if nil.
-
-2000-10-07 10:31:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encode-region): Better calculation of
- break point.
- (rfc2047-fold-region): Don't break the first non-LWSP characters.
-
-2000-10-07 09:18:53 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-agent-fetching): New variable.
- * gnus-agent.el (gnus-agent-with-fetch): Bind it.
- * gnus-score.el (gnus-score-body): Don't score body when
- agent-fetching.
- (gnus-score-followup): Don't score followup either.
-
-2000-10-07 08:19:17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el: Define dynamic variables in eval-when-compile.
- * message.el (message-sending-message): New variable.
- (message-send): Use it.
- * gnus-draft.el (gnus-draft-send-message): Ditto.
- (gnus-group-send-drafts): Ditto.
-
-2000-10-06 Dave Love <fx@gnu.org>
-
- * gnus-audio.el: Don't require cl.
- (gnus-audio): New custom group.
- (gnus-audio-inline-sound): Change to work with Emacs.
- (gnus-audio-directory, gnus-audio-directory)
- (gnus-audio-au-player): Customize.
- (gnus-audio-play): Try external player if play-sound-file fails.
- Use file-name-extension, not string-match.
-
-2000-10-06 17:38:03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-prepare): Configure it again.
-
-2000-10-06 15:11:07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-default-charset): Default value for non-Mule
- Emacsen.
-
-2000-10-06 14:28:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-alternative-emails): New.
- (message-use-alternative-email-as-from): New.
- (message-setup): Use them.
-
-2000-10-06 13:46:47 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * base64.el, dgnushack.el, gnus-spec.el, messagexmas.el
- * gnus-xmas.el, nnheaderxm.el, nndraft.el: Use defalias.
-
- * gnus-xmas.el (gnus-xmas-define): Defalias gnus-overlay-buffer,
- gnus-overlay-start.
- * gnus.el: Ditto.
- * gnus-art.el (gnus-insert-mime-button): Use them.
-
-2000-10-06 10:01:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Don't set unibyte
- if eight-bit-control is a charset, e.g. Mule 5.0 in Emacs 21.
-
-2000-10-06 09:38:54 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Use
- mm-with-unibyte-current-buffer within narrowed region.
-
-2000-10-06 08:56:33 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-type-definition): Fix my-deja open url.
-
-2000-10-06 Emerick Rogul <emerick@csa.bu.edu>
-
- * message.el (message-setup-fill-variables): New variable.
- (message-mode): Use it.
-
-2000-10-05 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-fold-region): Use gnus-point-at-bol.
- (rfc2047-charset-encoding-alist): Add iso-8859-1[45].
-
- * binhex.el: Use defalias, not fset.
-
- * rfc1843.el: Require cl when compiling.
-
-2000-10-05 12:25:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Score-param could be nil.
-
-2000-10-05 11:43:25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-region): Merge only if regions are
- adjacent.
-
-2000-10-05 09:41:33 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-multibyte-p): In XEmacs, it is (feature 'mule).
- (mm-find-charset-region): Merge conditions, delete ascii.
- (mm-charset-after): Rewrite.
- * mm-bodies.el (mm-encode-body): Use it.
-
-2000-10-05 09:04:32 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-list): Fix.
-
-2000-10-05 Stefan Monnier <monnier+gnu/emacs@rum.cs.yale.edu>
-
- * nnimap.el (require): cl.
-
-2000-10-04 15:24:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-prepare): Configure windows before
- gnus-article-prepare-display is called. Otherwise, BBDB's popup
- window might be overrided.
-
-2000-10-04 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface)
- [gnus-article-compface-xbm]: Fix.
- (gnus-x-splash): Bind width, height.
-
-2000-10-04 11:45:04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Use prefix argument only
- when it is called interactively.
-
-2000-10-03 21:20:31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-action-alist): New variable.
- (gnus-mime-action-on-part): Use it.
- (gnus-mime-button-commands): Add command ".".
-
-2000-10-03 20:37:42 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Support prefix argument.
-
-2000-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: "." is in the load-path because dgnushack.el.
-
-2000-10-03 Bjorn Torkelsson <torkel@hpc2n.umu.se>
-
- * uudecode.el: xemacs cleanup (use featurep ' xemacs)
-
- * nnheader.el: ditto
-
- * mm-util.el: ditto
-
- * message.el: ditto
-
- * binhex.el: ditto
-
- * gnus-audio.el: removed unnecessary xemacs test
-
- * earcon.el: ditto
-
-2000-10-03 19:55:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-decode-entities): Work for non-character
- entities.
-
-2000-09-26 09:20:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Message the quit parts.
-
-2000-10-03 08:08:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Don't insert
- newlines.
-
-2000-10-02 20:14:27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-compile): Don't compile dgnushack.el,
- lpath.el. Don't compile base64.el if there is builtin base64.
-
-2000-10-02 Bj\e,Av\e(Brn Torkelsson <torkel@hpc2n.umu.se>
-
- * base64.el (Repository): Use featurep for XEmacs test.
-
-2000-10-02 17:38:12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-data): Don't ignore quit.
-
-2000-10-02 14:43:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-banner-alist): New variable.
- (article-strip-banner): Use it.
- * gnus-cus.el (gnus-group-parameters): Allow symbol.
-
-2000-10-02 Dave Love <fx@gnu.org>
-
- * smiley-ems.el: New file.
-
- * gnus-ems.el (gnus-smiley-display): Autoload.
- (mouse-set-point, set-face-foreground, set-face-background)
- (x-popup-menu): Don't clobber these.
- (gnus-article-compface-xbm): New variable.
- (gnus-article-display-xface): Move graphic test. Use unibyte.
- Obey gnus-article-compface-xbm. Use pbm, not xbm.
-
- * mml.el (require): Fix typo.
- (mml-parse-1): Modify unknown encoding prompt.
-
- * mail-source.el (mail-sources): Revert to nil.
-
- * nnmail.el (nnmail-spool-file): Revert previous change.
-
- * gnus.el: Don't require custom, message.
- (gnus-message-archive-method): Wrap initializer in progn and
- require message here.
-
-2000-10-02 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-mode-line-buffer-identification) [Emacs]: Change
- image's :ascent to 80. That gives a mode-line which is approx.
- as tall as the normal one.
-
-2000-10-02 08:04:48 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-list): Fix.
-
-2000-10-01 20:55:53 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Don't postpone GCC if none of GCC methods is agent-covered. This
- fix presumes that the post-method must be agent-covered if any Gcc
- method is agent-covered.
-
- * gnus-msg.el (gnus-inews-group-method): New function.
- (gnus-inews-do-gcc): Use it.
- * gnus-agent.el (gnus-agent-any-covered-gcc): New function.
- (gnus-agent-possibly-save-gcc): Use it.
- (gnus-agent-possibly-do-gcc): Ditto.
-
-2000-10-01 17:08:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-mime-types): Use mailcap-mime-data.
- * mml.el (mml-minibuffer-read-type): Use mailcap-mime-types.
-
-2000-10-01 13:07:21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-netscape-open, webmail-hotmail-article,
- webmail-hotmail-list): Update.
-
-2000-10-01 08:36:09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-report-new-mail): Use
- nnheader-cancel-timer.
-
-2000-10-01 08:35:38 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el (overlay-*): Shut up.
- * dgnushack.el: Two implementations of smiley.
-
-2000-10-01 08:32:42 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el: Usage.
- (gnus-mailing-list-archive, gnus-mailing-list-owner,
- gnus-mailing-list-post, gnus-mailing-list-unsubscribe,
- gnus-mailing-list-subscribe, gnus-mailing-list-help): Bind list-*.
- (gnus-mailing-list-menu): Define it.
- (turn-on-gnus-mailing-list-mode, gnus-mailing-list-mode): Autoload.
-
- * gnus-xmas.el (gnus-xmas-mailing-list-menu-add): Move here.
-
-2000-09-30 18:52:51 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-my-deja-*): Rewrite.
-
-2000-09-30 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-request-accept-article): Remove \n's from
- From_ lines.
-
-2000-08-05 Simon Josefsson <simon@josefsson.org>
-
- Make GCC to remote groups work when unplugged
- (postpone GCC until message is actually sent).
-
- * gnus-draft.el (gnus-draft-send): Call `gnus-agent-restore-gcc'.
-
- * gnus-agent.el (gnus-agent-possibly-do-gcc):
- (gnus-agent-restore-gcc):
- (gnus-agent-possibly-save-gcc): New functions.
-
- * gnus-msg.el (gnus-inews-add-send-actions): Use
- `gnus-agent-possibly-do-gcc' if Agentized.
- (gnus-inews-add-send-actions): Add `gnus-agent-possibly-save-gcc'
- to `message-header-hook'.
-
- * gnus.el (gnus-agent-gcc-header): New variable.
-
-2000-07-13 Simon Josefsson <simon@josefsson.org>
-
- Asks the user to synch flags with server when you plug in.
-
- * gnus-agent.el (gnus-agent-synchronize-flags): New variable.
- (gnus-agent-possibly-synchronize-flags-server): New function, use it.
- (gnus-agent-toggle-plugged): Call it.
- (gnus-agent-synchronize-flags): Renamed from `gnus-agent-synchronize'.
- (gnus-agent-group-mode-map): `g-a-s' -> `g-a-s-flags'.
- (gnus-agent-possibly-synchronize-flags): New function.
- (gnus-agent-possibly-synchronize-flags-server): New function.
-
-2000-09-30 Simon Josefsson <simon@josefsson.org>
-
- * starttls.el: New file, by Daiki Ueno.
-
-2000-08-02 Stanislav Shalunov <shalunov@internet2.edu>
-
- * message.el (message-make-in-reply-to): In-Reply-To is message-id
- (see DRUMS).
-
-2000-09-29 Simon Josefsson <simon@josefsson.org>
-
- * nntp.el (nntp-async-trigger): Fix authinfo in asynchronous
- prefetch.
-
-2000-08-09 10:21:20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-open-telnet): Wait for the telnet prompt before
- sending a command; allow the rtelnet prompt as well.
-
-2000-09-29 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-send): Make sure error is signalled if no
- send method is specified.
-
-2000-09-29 Florian Weimer <fw@deneb.enyo.de>
-
- * qp.el (quoted-printable-encode-region): Wrap with
- `mm-with-unibyte-current-buffer'.
-
-2000-09-29 12:12:49 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Reimplement Mike
- McEwan's proposal.
-
-2000-09-29 12:06:40 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el: Revoke Mike McEwan's 1998-09-05 patch due to
- the GNU assignment issue.
-
-2000-09-29 09:56:34 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Correctly mark body-begin.
-
-2000-09-29 09:14:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Decode to-address.
-
-2000-09-28 Andrei Elkin <astro@sbor.ru> (tiny change)
-
- * gnus-art.el (article-strip-banner): Use
- gnus-group-find-parameter rather than gnus-group-get-parameter, to
- allow inheritance on the banner.
-
-2000-09-26 Richard M. Alderson III <alderson@netcom2.netcom.com>
-
- * gnus-art.el (gnus-read-save-file-name): expand-file-name.
-
-2000-09-26 Dave Love <fx@gnu.org>
-
- * gnus-draft.el: Don't require gnus-agent.
-
- * mm-view.el: Use featurep for XEmacs test.
- (mm-inline-message): Test for `remove-specifier'; don't use
- condition-case.
-
-2000-09-24 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-request-accept-article): Remove From[^:] lines.
-
- * gnus-group.el (gnus-group-nnimap-edit-acl): Check if server
- support ACL's.
-
- * nnimap.el (nnimap-acl-get): Check capability.
-
- * mail-source.el (mail-source-imap-file-coding-system): New variable.
- (mail-source-fetch-imap): Use it.
-
- * rfc2104.el (rfc2104-hexstring-to-bitstring): New function.
- (rfc2104-hash): Use it.
-
- * imap.el (imap-starttls-p): Check for starttls binary.
- (imap-starttls-open): More verbose.
- (imap-gssapi-auth): Ditto.
- (imap-kerberos4-auth): Ditto.
- (imap-cram-md5-auth): Ditto.
- (imap-login-auth): Ditto.
- (imap-anonymous-auth): Ditto.
- (imap-digest-md5-auth): Ditto.
- (imap-open): Ditto.
- (imap-digest-md5-p): Check capability first.
-
-2000-09-24 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-flag-list): Correctly parse empty lists.
- (imap-login-p): Support LOGINDISABLED.
-
-2000-09-23 Simon Josefsson <jas@nada.kth.se>
-
- * rfc2104.el: Add SHA-1 example.
-
-2000-09-22 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-body): Work around bug in Sun SIMS.
-
-2000-09-21 21:54:48 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Bind nnkiboze-score-file.
-
-2000-09-21 16:15:25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-use-all-scores): New variable.
- (gnus-all-score-files): Use it.
- * nnkiboze.el (nnkiboze-generate-group): Use it. Inhibit list groups.
- (nnkiboze-enter-nov): Fix it when there is no xref.
- (nnkiboze-generate-groups): List groups.
- * gnus-group.el (gnus-group-make-kiboze-group): Use
- nnkiboze-score-file.
-
- * nnkiboze.el (nnkiboze-request-article): Use
- gnus-cache-request-article.
- * gnus-group.el (gnus-group-make-kiboze-group): Fix prompt.
-
-2000-07-16 Dmitry Bely <dbely@mail.ru>
-
- * nnheader.el (nnheader-translate-file-chars): Path splitting on NT.
-
-2000-09-20 18:33:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-find-bnews): Use directory-sep-char.
-
-2000-09-20 17:37:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-default-charset): Set default value in
- non-MULE XEmacsen as iso-8859-1.
-
-2000-09-20 12:02:24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-demon.el: Use (featurep 'xemacs).
- * gnus-agent.el: timer vs. itimer.
- * mail-source.el: Ditto.
-
-2000-09-19 10:24:57 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-kiboze-group): Makedir.
- * nnheader.el (nnheader-parse-nov): Remove Xref in mail-header-xref.
- * gnus-sum.el (gnus-nov-parse-line): Ditto.
- * nnkiboze.el (nnkiboze-file-coding-system): New.
- (nnkiboze-retrieve-headers): Use it.
- (nnkiboze-request-group): Ditto.
- (nnkiboze-close-group): Ditto.
- (nnkiboze-generate-group): Ditto.
- (nnkiboze-enter-nov): Insert first Xref properly.
-
-2000-09-19 Dave Love <fx@gnu.org>
-
- * nnmail.el (nnmail-cache-accepted-message-ids): Default to nil.
- (nnmail-get-new-mail): Test `sources' in top-level conditional.
-
- * mail-source.el (mail-sources): Change default to '((file)).
- Add useful custom type.
-
-2000-09-18 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-util.el (gnus-time-iso8601): Correct doc string (four digit
- year).
- (gnus-date-iso8601): Ditto.
-
-2000-09-18 09:05:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-imap): Disable multibyte.
-
-2000-09-17 01:13:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encoding-alist): Remove = and _ from the
- pattern. Avoid using 8 bit chars.
- * qp.el (quoted-printable-encode-region): Avoid using 8 bit chars.
-
-2000-09-16 15:57:42 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smiley.el (smiley-buffer-ems, smiley-create-glyph-ems,
- smiley-toggle-extent-ems, smiley-toggle-extents-ems,
- smiley-toggle-buffer-ems): New functions for Emacs 21. Toggle
- functions are not implemented yet.
-
- * dgnushack.el (dgnushack-compile): Remove smiley.el and
- x-overlay.el from the FSF Emacs black list.
-
-2000-09-15 21:10:20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-inlined-types): Add application/emacs-lisp.
- (mm-inline-media-tests): Ditto.
- (mm-automatic-display): Ditto.
- * mm-view.el (mm-display-inline-fontify): Generalize from
- mm-display-patch-inline.
- (mm-display-patch-inline): Use it.
- (mm-display-elisp-inline): Ditto.
-
-2000-09-15 14:03:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-find-groups): Add recursive parameter.
- (gnus-topic-unmark-topic): Ditto.
- (gnus-topic-mark-topic): Ditto.
- (gnus-topic-get-new-news-this-topic): Use it.
-
-2000-09-15 09:01:40 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-display-xface): By default, Emacs 21
- display xface.
-
-2000-08-23 02:54:46 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-rename-group): Inhibit renaming of
- zombie or killed groups.
-
-2000-09-15 00:09:56 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Reinsert unibyte content.
- (mml-parse-1): Remove with-unibyte-current-buffer.
- (mml-generate-mime-1): Ditto.
- * gnus-msg.el (gnus-summary-mail-forward): Ditto.
- * message.el (message-forward): Ditto.
-
-2000-09-14 23:13:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-quoted-unreadable): Guess charset from
- original article buffer.
- (article-de-base64-unreadable): Ditto.
- (article-wash-html): Ditto.
-
-2000-09-14 18:55:30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Disable multibyte
- unless forward-show-mml.
-
-2000-09-14 14:48:57 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-save-parts-type-history): New.
- (gnus-summary-save-parts-last-directory): New.
- (gnus-summary-save-parts): Save history.
-
-2000-09-14 Ben Gertzfield <che@debian.org>
-
- * gnus-sum.el (gnus-summary-save-parts-default-mime): New
- variable.
- (gnus-summary-save-parts): Use it.
-
-2000-09-14 11:31:28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Clean handle-alist.
- * gnus-sum.el (gnus-summary-exit): Ditto.
- (gnus-summary-exit-no-update): Ditto.
- (gnus-summary-show-article): Ditto.
-
-2000-09-14 08:42:48 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Remove
- Content-Disposition.
-
-2000-09-13 23:58:40 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Hotmail updated. Add X-Gnus-Webmail.
-
-2000-09-13 21:41:25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Set
- gnus-article-mime-handles to nil.
- * gnus-sum.el (gnus-summary-exit): Ditto.
- (gnus-summary-exit-no-update): Ditto.
- (gnus-summary-show-article): Ditto.
- (gnus-summary-save-parts): Use gnus-article-mime-handles if
- dissected.
- * mm-partial.el (mm-partial-find-parts): Remove redundancy.
-
-2000-09-13 16:59:33 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-sort): Sort loose threads too.
- (gnus-sort-threads-1): New function. Sort threads recursively.
- (gnus-sort-threads): Use it.
- (gnus-sort-gathered-threads): Doc fix.
-
-2000-09-13 Dave Love <fx@gnu.org>
-
- * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode.
-
- * gnus-ems.el (gnus-ems-redefine): Don't alias
- gnus-summary-set-display-table.
-
- * message.el (message-user-agent): Don't wrap ignore-errors around
- it.
-
- * mm-encode.el (mm-insert-multipart-headers): Avoid redundant
- `format'.
- (mm-content-transfer-encoding): Don't use cadar.
-
- * uudecode.el (uudecode-decoder-program)
- (uudecode-decoder-switches): Customize.
-
- * gnus-score.el (gnus-home-score-file): Improve custom type.
-
- * gnus-cus.el (gnus-custom-mode): Conditionally set local
- variables for Emacs 21.
- (gnus-group-customize): Disable undo while laying out the buffer.
-
-2000-09-13 09:38:26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-write-active-file): Bind
- coding-system-for-write.
-
-2000-09-13 09:14:57 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-get-new-mail): Don't test nnmail-spool-file.
-
- * gnus-cache.el (gnus-jog-cache): Temporarily disable mail-sources.
- * gnus-kill.el (gnus-batch-score): Ditto.
- * gnus-move.el (gnus-change-server): Ditto.
- * nnkiboze.el (nnkiboze-generate-groups): Ditto.
-
-2000-09-12 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-update-read-articles): Undo
- `gnus-request-set-mark' operation.
-
-2000-09-11 Dave Love <fx@gnu.org>
-
- * Changelog: Use iso-2022 coding.
-
- * gnus-msg.el (gnus-msg-mail): New function.
- (gnus-user-agent): New mail agent.
-
-2000-09-10 Dave Love <fx@gnu.org>
-
- * message.el: Require mail-abbrevs for XEmacs for a problem with
- keybinding despite the autoloads for it.
-
-2000-09-08 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-kerberos4-open): Erase more (fixes race condition?).
-
- * nnimap.el (nnimap-request-update-info-internal): Remove tick
- marks from dormant articles. (See nnimap-request-set-mark.)
- (nnimap-retrieve-headers-progress): Demule.
- (nnimap-open-server): Call nnoo-change-server twice, once for
- getting the nnimap-server-buffer and once for letting n-c-s set
- the variables in that buffer.
-
-2000-09-08 David Edmondson <dme@dme.org>
-
- * gnus.el (gnus-short-group-name): Guess separator.
-
-2000-09-07 Tadashi Watanabe <watanabe@sigmaitec.co.jp>
-
- * smiley.el (smiley-buffer, smiley-create-glyph): Work with GTK
- XEmacs as well.
-
-2000-09-06 Francis Litterio <franl-removethis@world.omitthis.std.com>
-
- * gnus-group.el (gnus-group-insert-group-line): Fix.
-
-2000-09-04 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mime-display) <defgroup>: Add `multimedia' group.
- (mm-get-image): Avoid the losing `make-glyph' from W3.
-
-2000-09-03 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-summary-delete-article): Check server.
-
-2000-09-01 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-flag-list): Rewrite.
-
- * nnimap.el (nnimap-retrieve-headers-from-file): Ignore errors.
-
- * imap.el (imap-parse-flag-list): Hack.
-
-2000-08-29 Dave Love <fx@gnu.org>
-
- * gnus-mlspl.el (gnus-group-split-fancy): Eschew mapcon.
-
- * dgnushack.el (mapcon, union): Remove compiler macros.
-
- * gnus-agent.el (gnus-agent-union): new function.
- (gnus-agent-fetch-headers): Use it.
-
- * gnus.el (gnus-group-startup-message): Modifications to last change.
-
-2000-08-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-group-startup-message): Specify foreground and
- background for xpm image. Centre image vertically.
-
-2000-08-24 23:49:23 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail): Narrow-to-headers.
-
-2000-08-24 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-insert-mime-button): Fix help-echo for Emacs
- 21.
-
-2000-08-23 Dave Love <fx@gnu.org>
-
- * dgnushack.el: Remove `member-if' compiler macro.
-
-2000-08-21 Dave Love <fx@gnu.org>
-
- * nnimap.el (nnimap-request-newgroups): Eschew member-if.
-
-2000-08-21 10:09:47 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-hide-topic): Use find-topology if
- permanent is used.
- (gnus-topic-show-topic): Read topic when to show permanent hidden
- topic.
- (gnus-topic-remove-topic): Revert to the old behavior, not using
- hide.
-
-2000-08-21 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-add-minor-mode): Add &rest arg.
- (gnus-xemacs): Use featurep.
-
- * mm-util.el (mm-read-charset): Maybe use builtin.
- (mm-replace-chars-in-string): Maybe use subst-char-in-string.
- (mm-multibyte-p, mm-with-unibyte-current-buffer)
- (mm-with-unibyte): Use featurep, not string-match.
- (mm-with-unibyte-buffer): Simplify.
- (mm-quote-arg): Maybe use shell-quote-argument.
-
- * mml.el (mml-make-string): Deleted (unused).
-
- * gnus.el (gnus-mode-line-buffer-identification): Supply
- definition for Emacs 21.
-
- * gnus-salt.el: Small doc fixes.
- (gnus-pick-mode, gnus-binary-mode): Supply a toggle-func arg to
- gnus-add-minor-mode.
-
- * gnus-topic.el (gnus-topic-mode): Supply a toggle-func arg to
- gnus-add-minor-mode.
-
-2000-08-20 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-before-find-minmax-bugworkaround): New
- function, thanks to Lloyd Zusman for debugging.
- (nnimap-request-group):
- (nnimap-request-list):
- (nnimap-retrieve-groups):
- (nnimap-request-newgroups): Use it.
-
- * nnimap.el (nnimap-request-article-part): Less verbose.
-
-2000-08-19 Andreas Jaeger <aj@suse.de>
-
- * lpath.el ((string-match "XEmacs" emacs-version)): Remove
- subst-char-in-string since we test elsewhere whether it's bound.
-
-2000-08-18 Dave Love <fx@gnu.org>
-
- * gnus-score.el (gnus-score-find-score-files-function): Fix doc,
- custom type.
-
- * gnus-xmas.el (gnus-group-icon-create-glyph): Don't test
- gnus-group-running-xemacs.
-
- * nnheader.el (nnheader-replace-chars-in-string): Use
- subst-char-in-string if available.
-
- * gnus-art.el (gnus-read-save-file-name, gnus-plain-save-name)
- (gnus-request-article-this-buffer): Use expand-file-name.
- (gnus-mime-view-part-as-type): Simplify interactive spec.
- (gnus-mime-button-map): Define it all in defvar.
-
-2000-08-17 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-running-xemacs): Deleted.
-
- * gnus-demon.el (gnus-demon): Bind use-dialog-box and
- last-nonmenu-event.
-
- * uudecode.el (char-int): Use defalias, not fset.
-
- * score-mode.el: Don't require easymenu. Require mm-util.
- (score-mode-coding-system): Use mm-auto-save-coding-system.
-
- * nneething.el (nneething-create-mapping): Don't use cadar & al.
- (nneething-file-name): Use expand-file-name, not concat.
-
-2000-08-16 13:05:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers):
- Failure proof for email addresses.
- (nnslashdot-sane-retrieve-headers): Ditto.
-
-2000-08-14 20:08:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Only insert courtesy message
- when text/plain.
-
-2000-08-14 19:55:04 Jesper Harder <jesper_harder@hotmail.com>
-
- * message.el (message-cancel-news): Copy the From header from the
- original article.
-
-2000-08-14 19:52:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-async.el (gnus-asynchronous): Removed.
-
-2000-08-14 16:12:11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Use MMDF mail
- format.
-
-2000-08-14 19:12:22 Rod Whitby <list.ding@rwhitby.net>
-
- * nnmail.el (nnmail-expiry-target-group): Fixed.
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * nnmail.el (nnmail-expiry-target-group): Fix the call to
- gnus-request-accept-article so that body encoding is *not* done.
- Encoding is not done on incoming mail, so why should it be done on
- expired mail?
-
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * nnml.el (nnml-request-expire-articles): Fix the calls to
- nnml-request-article (the filename was being passed instead of the
- article number) and nnmail-expiry-target-group
- (nnml-current-directory is changed by nnml-request-accept-article,
- causing it to be incorrect for the next article to be expired).
-
-2000-08-14 Rod Whitby <list.ding@rwhitby.net>
-
- * gnus-sum.el (gnus-summary-expire-articles): Fix the handling of
- expiry-target group parameters.
-
-2000-08-13 18:53:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-select-group): Touch the dribble
- buffer.
- (gnus-topic-hide-topic): Take a PERMANENT parameter.
- (gnus-topic-show-topic): Ditto.
-
- * gnus-dup.el (gnus-dup-suppress-articles): Do auto-expiry.
-
-2000-08-12 21:48:00 John H. Palmieri <palmieri@math.washington.edu>
-
- * mail-source.el (mail-source-incoming-file-prefix): New
- variable.
-
-2000-08-12 20:29:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-check-first-time-used): Clean up a bit.
-
- * mailcap.el (mailcap-maybe-eval): Be even more warning.
-
-2000-08-11 Florian Weimer <fw@deneb.enyo.de>
-
- * message.el (message-syntax-checks): New check quotin-style:
- Text must be written below quoted text.
- (message-check-news-body-syntax): Check it.
-
-2000-08-11 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-authenticator-alist): Fix typo.
- (imap-gssapi-open): Copy krb4 fixes for modern imtest's, thanks to
- Jonas Oberg for debugging.
-
-2000-08-11 Simon Josefsson <simon@josefsson.org>
-
- * gnus-async.el (gnus-asynchronous): Disable by default.
-
-2000-08-10 20:22:09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind fill-column.
-
- * nnvirtual.el (nnvirtual-request-expire-articles): Return the
- list of unexpired articles.
-
- * gnus-group.el (gnus-group-expire-articles-1): Return the list of
- un-expired articles.
-
- * gnus-sum.el (gnus-summary-reparent-thread): Narrow to the
- headers.
-
- * gnus-topic.el (gnus-topic-kill-group): Move up one line so that
- we update the right topic..
-
- * mm-decode.el (mm-display-external): Put point at start.
-
-2000-08-10 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-expiry-target): More explicit documentation.
-
- * gnus-cus.el (gnus-group-parameters): Add parameter `expiry-wait'.
-
-2000-08-09 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-parse-body):
- (imap-parse-string-list): Add bug workarounds for Stalker
- Communigate Pro 3.0 server.
- (imap-body-lines): Remove bogus comment.
-
- * imap.el (imap-range-to-message-set): Move from nnimap.el.
-
- * nnimap.el (nnimap-retrieve-which-headers):
- (nnimap-retrieve-headers-from-server):
- (nnimap-request-set-mark):
- (nnimap-request-expire-articles): Use `i-r-t-m-set' instead.
-
-2000-08-08 00:53:41 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-dont-reply-to-names):
- rmail-dont-reply-to-names may not be defined.
-
-2000-08-07 09:37:01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-iterate): Uncompiled function should
- not use pop.
-
-2000-07-19 Dave Love <fx@gnu.org>
-
- * gnus-ems.el: Defalias some dummy funcs to `ignore'.
- (gnus-x-splash): Use expand-file-name. Remove redundant facep
- check.
- (gnus-article-display-xface): Special-case for dark backgrounds.
-
-2000-07-19 Kim-Minh Kaplan <kmkaplan@galaxy.fr>
-
- * imap.el (imap-calculate-literal-size-first): New variable.
- (imap-local-variables): Add it.
- (imap-kerberos4-open): Set it.
- (imap-send-command): Use it.
-
-2000-07-17 14:18:16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-mimetypes-parsed-p): New variable.
- (mailcap-parse-mimetypes): Use it.
- (mailcap-extension-to-mime): Parse mimetype.
- (mailcap-mime-types): Ditto.
- * mml.el (mml-minibuffer-read-type): Ditto.
-
-2000-07-16 18:25:07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Add outlook.
- (nndoc-outlook-type-p): New function.
- (nndoc-outlook-article-begin): Ditto.
-
-2000-07-16 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-sum.el (gnus-restore-hidden-threads-configuration): Save
- excursion.
-
-2000-07-15 Simon Josefsson <simon@josefsson.org>
-
- * gnus-cus.el (gnus-group-parameters, banner): Type is regexp.
-
- * imap.el (imap):
- (imap-kerberos4-program):
- (imap-gssapi-program):
- (imap-ssl-program): Customization.
- (imap-shell-program):
- (imap-shell-host): New variables.
- (imap-streams):
- (imap-stream-alist): Add shell.
- (imap-shell-p):
- (imap-shell-open): New functions.
- (imap-open): Don't call authenticator if preauth.
- (imap-authenticate): Return t if already authenticated.
-
-2000-07-14 Simon Josefsson <simon@josefsson.org>
-
- * gnus.el (gnus-invalid-group-regexp): New variable.
- (gnus-read-group): Use it.
-
-2000-07-14 12:40:51 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): mark-below,
- expunge-below and orphan-score are "group variables".
-
-2000-07-13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-srvr.el (gnus-browse-read-group): Don't pass fully
- qualified group names to `gnus-group-read-ephemeral-group'.
-
-2000-07-13 07:40:39 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (srcdir): Define it before use it.
-
-2000-07-12 19:37:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el: `W t' is toggle-header in info.
-
-2000-07-12 16:50:06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Fbind subst-char-in-string.
-
-2000-07-12 15:48:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Use W3DIR and lispdir.
- * dgnushack.el: Ditto.
-
-2000-07-12 10:12:31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-base64-unreadable): Typo.
-
-2000-07-12 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (require): Require timer.
-
-2000-07-11 18:29:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-bounce): Call mime-to-mml.
-
-2000-07-11 18:00:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-close): New function.
-
-2000-07-04 23:23:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Get the
- right line number for the article.
-
-2000-07-10 22:41:58 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Save point.
- * webmail.el (webmail-fetch): Bind
- url-http-silence-on-insecure-redirection.
-
-2000-07-10 11:43:22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Use
- unibyte.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
-
-2000-07-10 11:12:32 William M. Perry <wmperry@aventail.com>
-
- * mailcap.el (mailcap-parse-mimetype-file):
-
-2000-07-07 23:46:22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Stricter test.
- * webmail.el (webmail-refresh-redirect): Ditto.
-
-2000-07-06 14:17:48 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Match the EOL of boundary.
-
-2000-07-05 21:19:22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-insert-nov): Remove EOLs of all fields.
-
-2000-07-05 Dave Love <fx@gnu.org>
-
- * utf7.el: Doc and header fixes.
-
- * gnus-sum.el: Doc fixes.
-
- * gnus-util.el (gnus-point-at-eol, gnus-point-at-bol): Use
- defalias, not fset.
-
- * flow-fill.el (fill-flowed-point-at-eol)
- (fill-flowed-point-at-bol): Use defalias, not fset.
-
- * gnus-art.el: Don't alias article-mime-decode-quoted-printable.
- (gnus-Plain-save-name): Delete -- apparently bogus.
-
-2000-07-03 00:12:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnsoup.el: Use expand-file-name throughout.
-
-2000-07-03 00:07:51 Kjetil Torgrim Homme <kjetilho@ifi.uio.no>
-
- * nnmail.el (nnmail-read-incoming-hook): New example.
-
-2000-07-02 23:17:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Check whether the text has already
- been decoded.
-
-2000-07-04 15:17:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-sid-strip): To strip or not to strip?
-
-2000-07-03 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * gnus-sum.el (gnus-recenter): Fix horizontal recenter.
-
-2000-07-03 Simon Josefsson <simon@josefsson.org>
-
- * gnus-sum.el (gnus-update-marks): Don't propagate download and
- unsend flags.
-
-2000-07-03 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-open-connection): Don't look up virtual server
- name in authinfo (.authinfo now support ports, no need for the
- hack).
- (nnimap-split-find-rule): Fix.
- (nnimap-open-connection): Look for nnimap-server-address in authinfo.
-
-2000-07-03 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * message.el (message-unquote-tokens): Remove all quotes.
-
-2000-07-03 00:29:08 Julien Gilles <julien.gilles@bcv01y01.vz.cit.alcatel.fr>
-
- * gnus-ml.el: New file.
-
-2000-07-02 16:11:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-close): New function.
-
- * gnus-start.el (gnus-clear-system): Clear nnmail-split-history.
-
-2000-06-18 Norbert Koch <norbert@s.netic.de>
-
- * Makefile.in: Better support for xemacs builds
-
-Sun Jul 2 15:11:35 2000 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.7 is released.
-
-2000-05-19 06:32:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-insert-part): Characters doubly decoded.
-
-2000-07-01 10:23:08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-do-fcc): Encode MIME.
-
-2000-06-28 13:52:57 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Fbind image-size.
-
-2000-06-28 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-split-rule): Update doc with extended syntax.
- (nnimap-assoc-match): New function.
- (nnimap-split-find-rule): Support extended syntax.
-
-2000-06-28 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-open-connection): Use port stuff.
-
- * gnus-util.el (gnus-netrc-machine): Add defaultport parameter,
- document port and defaultport.
-
-2000-06-27 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * gnus-agent.el (gnus-agent-synchronize): Kill flags buffer.
-
-2000-06-26 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mm-image-fit-p): Use `image-size' in Emacs.
-
- * message.el: Remove unnecessary `require'ments. Defvar
- gnus-list-identifiers when compiling. Don't try to autoload
- variable `gnus-list-identifiers'. Autoload
- gnus-group-name-charset.
- (message-fetch-field): Don't assume `format' removes text
- properties.
- (message-strip-list-identifiers, message-reply, message-followup):
- Require gnus-sum.
- (message-mode): Tidy XEmacs conditionals.
- (message-replace-chars-in-string): Use subst-char-in-string when
- available.
-
- * gnus-xmas.el (gnus-xmas-define) <match-string-no-properties>:
- Define if necessary.
-
- * gnus-art.el (gnus-article-edit-exit): Don't assume `format'
- removes text properties.
-
- * gnus-srvr.el (gnus-browse-group-name): Likewise.
-
- * gnus-msg.el (gnus-copy-article-buffer): Likewise.
-
- * gnus-score.el (gnus-summary-score-entry): Likewise.
-
-2000-06-26 11:18:57 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnimap.el (nnimap-request-post): Fix parenthesis.
-
-2000-06-26 Paul Stodghill <stodghil@CS.Cornell.EDU>
-
- * message.el (message-unquote-tokens): New function.
-
- * gnus-msg.el (gnus-inews-do-gcc): Unquote gcc tokens.
-
- * nnimap.el (nnimap-request-post): Ditto.
-
-2000-06-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-asynchronous): Removed (defined in gnus-async.el).
-
- * nnimap.el (nnimap-callback): Update for IMAP4rev1 servers (see
- patch commited 2000-04-02).
-
-2000-06-20 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-mailbox-examine-1): New function.
- (imap-message-copyuid-1):
- (imap-message-appenduid-1): Use it, instead of
- `imap-mailbox-examine' which would utf-7 encode mailbox name
- twice.
-
-2000-06-19 Dave Love <fx@gnu.org>
-
- * mm-uu.el Don't require message. Require cl when compiling.
-
-2000-06-17 18:58:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-local-variables): gnus-orphan-score is
- a local variable.
- * gnus-sum.el (gnus-orphan-score): Move here.
-
-2000-06-10 09:33:36 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): Remove show-mml condition.
- (message-forward-ignored-headers): Remove X-Gnus headers.
-
-2000-06-08 Simon Josefsson <simon@josefsson.org>
-
- * gnus-cus.el (gnus-extra-group-parameters): Add uidvalidity.
-
-2000-06-08 12:34:26 Urban Engberg <ue@ccieurope.com>
-
- * gnus-demon.el (gnus-demon-scan-mail): Bind nnmail-fetched-sources.
-
-2000-06-08 12:27:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-syntax-checks): Add type.
-
-2000-06-07 Dave Love <fx@gnu.org>
-
- * mm-view.el (mm-inline-image-emacs): Don't specify string for
- put-image.
- (mm-inline-image): Defalias, not fset.
-
- * gnus.el (gnus-group-startup-message): Don't specify string for
- insert-image.
-
- * gnus-ems.el (gnus-add-minor-mode): Make it an alias if
- add-minor-mode is available.
- (gnus-article-display-xface): Don't specify string for
- insert-image.
-
-2000-06-06 13:28:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-remove-topic): Set hidden.
- (gnus-topic-insert-topic-line): Use shownp.
- (gnus-topic-hide-topic): Don't use hidden.
- (gnus-topic-show-topic): Don't use hidden.
-
-2000-06-05 22:25:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Bind coding
- system.
- * gnus-soup.el (gnus-soup-write-prefixes): Ditto.
- * gnus-start.el (gnus-slave-save-newsrc): Ditto.
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
- (gnus-write-buffer): Ditto.
- * gnus-uu.el (gnus-uu-save-article): Ditto.
-
-2000-06-04 15:05:16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-read-from-minibuffer): Typo.
-
-2000-06-03 13:36:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Override non-MIME forward
- charset.
-
-2000-06-02 12:04:26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-quote-region): Correct the regexp.
- * gnus-msg.el (gnus-summary-reply): mml-quote it.
-
-2000-06-02 11:57:15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): Insert raw text.
- * mml.el (mml-parse-1): Get raw text in unibyte mode.
- (mml-generate-mime-1): Insert raw text in unibyte mode.
-
-2000-06-01 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-bodies.el (mm-body-encoding): Always encoded if
- `mm-use-ultra-safe-encoding' is set.
-
-2000-05-31 14:50:52 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (ange-ftp-name-format): Typo.
-
-2000-05-30 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): If
- `gnus-activate-group' and/or `gnus-check-server' return nil, don't
- try to do anything on that server.
-
-2000-05-25 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-group-nnimap-edit-acl): Help text updated
- from latest draft.
-
-2000-05-08 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-group-expire-articles-1): Make sure server
- is open.
-
-2000-05-24 Dave Love <fx@gnu.org>
-
- * mml.el (mml-parse-file-name): Fix ange-ftp part.
-
-2000-05-22 Didier Verna <didier@lrde.epita.fr>
-
- * gnus.el (gnus-redefine-select-method-widget): new function, call
- it once. Add an "other" entry for unknown but editable backend
- name symbols.
- * gnus-start.el (gnus-declare-backend): use it.
-
-2000-05-19 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-article-next-page): Revert last change.
-
-2000-05-19 09:56:07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-open-history): Open history in binary mode.
-
-2000-05-19 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-mime-externalize-part): Bind mm-inlined-types,
- not mm-inline-large-images.
-
-2000-05-19 01:45:40 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Don't test multiple-charsets within mml tag.
-
-2000-05-18 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Use defalias, not fset.
- (gnus-article-x-face-command): Don't test for xbm.
- (gnus-article-next-page): Redisplay before testing point in window.
-
-2000-05-17 21:16:54 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-mode-map): Add M-SPACE.
- * mml.el (mml-mode-map): Comment out mml-narrow-to-part.
-
-2000-05-17 21:13:38 Jim Davidson <jdavidson@acm.org>
-
- * gnus-sum.el (gnus-summary-save-article-rmail): Use
- gnus-summary-save-in-rmail.
- * message.el (message-output): Ditto.
-
-2000-05-17 22:37:25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-emphasize-whitespace-regexp): Doc fix.
-
-2000-05-17 14:03:49 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode if the method
- is a charset.
- * message.el (message-send-news): Check group name charset.
- * gnus-msg.el (gnus-post-news): Decode group name.
- (gnus-inews-do-gcc): Encode group name.
-
-2000-05-17 10:16:32 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-art.el (gnus-emphasize-whitespace-regexp): New variable.
- * gnus-util.el (gnus-put-text-property-excluding-newlines): Use it.
-
-2000-05-17 02:25:11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-mark-line-p): New function.
- (gnus-group-goto-group): New parameter.
- (gnus-group-remove-mark): Use it.
- * gnus-topic.el (gnus-topic-move-group): Ditto.
- (gnus-topic-remove-group): Ditto.
-
-2000-05-17 00:49:09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-list-dormant): New function.
-
-2000-05-16 23:20:42 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-synchronize): Use
- nnheader-insert-file-contents.
- (gnus-agent-save-active-1): Ditto.
- (gnus-agent-write-active): Ditto.
- (gnus-agent-expire): Ditto.
- * gnus-cache.el (gnus-cache-read-active): Ditto.
- * gnus-start.el (gnus-master-read-slave-newsrc): Ditto.
- * gnus-sum.el (gnus-summary-import-article): Ditto.
-
- * gnus-agent.el (gnus-agent-write-servers): Bind coding-system.
- (gnus-agent-save-group-info): Ditto.
- (gnus-agent-save-alist): Ditto.
- * gnus-util.el (gnus-make-directory): Ditto.
-
- * gnus-agent.el (gnus-agent-save-group-info): Disable multibyte.
-
-2000-05-16 21:13:24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-preprocess-function): New variable.
- (mml-generate-mime-postprocess-function): New variable.
- (mml-generate-mime-1): Use them.
-
-2000-05-16 18:15:24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-apropos): Group name charset.
- * gnus-sum.el (gnus-set-mode-line): Ditto.
- * gnus-group.el (gnus-group-decoded-name): New function.
- (gnus-group-edit-group): Use it.
- * gnus-cus.el (gnus-group-customize): Use it.
-
-2000-05-16 17:55:57 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-util.el (gnus-put-text-property-excluding-newlines): Improve.
-
-2000-05-16 16:22:17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-name-charset-method-alist): New variable.
- (gnus-group-name-charset-group-alist): Ditto.
- (gnus-group-name-charset): New function.
- (gnus-group-name-decode): New function.
- (gnus-group-insert-group-line): Use them.
- (gnus-group-prepare-flat-list-dead): Ditto.
- (gnus-group-list-active): Ditto.
- (gnus-group-describe-all-groups): Ditto.
- (gnus-group-prepare-flat-list-dead-predicate): Ditto.
- * gnus-srvr.el: (gnus-browse-foreign-server): Decode group name and
- add gnus-group property.
- (gnus-browse-group-name): Read gnus-group property.
-
-2000-05-16 15:27:08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-possibly-change-group): Use
- file-name-coding-system instead of pathname-coding-system.
- * nnmail.el (nnmail-find-file): Ditto.
- (nnmail-write-region): Ditto.
- * nnmh.el (nnmh-retrieve-headers): Ditto.
- (nnmh-request-article): Ditto.
- (nnmh-request-group): Ditto.
- (nnmh-request-list): Ditto.
- (nnmh-possibly-change-directory): Ditto.
- (nnmh-active-number): Ditto.
- * nnml.el (nnml-possibly-change-directory): Ditto.
- (nnml-request-list): Ditto.
- (nnml-request-article): Ditto.
- (nnml-retrieve-headers): Ditto.
-
-2000-05-16 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-request-accept-article): Don't unselect
- mailbox if no mailbox is selected.
-
-2000-05-15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-button-url-regexp): Revert earlier change.
- Recognize domain names starting with `www.' as starting an URL.
-
-2000-05-15 09:46:47 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-maildir): Insert "From ".
- (mail-source-keyword-map): Add "subdirs" for maildir.
-
-2000-05-14 16:19:28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-scan-directory-mail-source-once): New variable.
- (nnmail-get-new-mail): Use it.
- * gnus-start.el (gnus-get-unread-articles): Ditto.
-
-2000-05-14 14:02:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-edit-article): Better support for
- nndraft:drafts.
- * nndraft.el (nndraft-request-replace-article): New function,
- bind nnmail-file-coding-system.
-
-2000-05-14 Dave Love <fx@gnu.org>
-
- * nnheader.el: Replace uses of `fset' with `defalias'.
- (jka-compr-compression-info-list): Only defvar when compiling.
-
-2000-05-14 12:30:28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-netaddress-article): Refresh redirect.
-
-2000-05-13 20:41:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): w3 might not recognize utf-8.
-
-2000-05-13 16:49:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Translate to SP.
-
-2000-05-13 13:00:17 Robin S. Socha <robin@socha.net>
-
- * message.el (message-bounce): Doc typo.
-
-2000-05-13 12:25:21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-encoding-type): u is USENET news format.
- (gnus-soup-store): Ditto.
- (gnus-soup-send-packet): Ditto.
- * nnsoup.el (nnsoup-replies-format-type): Ditto.
- (nnsoup-dissect-buffer): Ditto.
- (nnsoup-narrow-to-article): Ditto.
- (nnsoup-make-active): Ditto
-
-2000-05-13 12:03:29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mode): Two parameters for local-variable-p.
-
-2000-05-13 00:54:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-strip-list-identifiers): New function.
- (message-reply): Use it and use message-strip-subject-re.
- (message-followup): Ditto.
- * gnus-art.el (article-hide-list-identifiers): Remove more.
- * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto.
-
-2000-05-12 22:28:54 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Bind
- mail-parset-charset and use non-numeric argument.
-
-2000-05-12 20:54:11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-buffer-list): New variable.
- (mml-generate-new-buffer): New function.
- (mml-destroy-buffers): Ditto.
- (mml-insert-mime): Use them.
- * gnus-msg.el (gnus-setup-message): mml-buffer leaks.
- * gnus-sum.el (gnus-summary-edit-article): Ditto.
- * message.el (message-mode): Ditto.
- * gnus-uu.el (gnus-uu-digest-headers): Keep MIME headers.
- (gnus-uu-save-article): Support show-as-mml.
- * message.el (message-forward): Ditto.
-
-2000-05-12 15:15:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): mime-digest head-begin.
- (nndoc-mime-digest-type-p): Locate article head precisely.
- * mml.el (mml-generate-default-type): New variable.
- (mml-generate-mime-1): Use it.
- (mml-insert-mime-headers): Use it.
- * gnus-uu.el (gnus-uu-digest-buffer): New variable.
- (gnus-uu-digest-mail-forward): Use it and call message-forward
- with argument digest.
- (gnus-uu-save-article): Support message-forward-as-mime.
- * message.el (message-forward): Add parameter digest.
- * mm-decode.el (mm-dissect-default-type): New variable.
- (mm-dissect-buffer): Use it.
-
-2000-05-11 11:08:03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Set space,
- newline and paragraph to nil when got a non-ascii character. Test
- paragraph before newline.
-
-2000-05-10 12:17:58 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Bind tab-width to 1. Set
- limit to 76.
-
-2000-05-10 09:11:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-sid-strip): New function.
- (nnslashdot-threaded-retrieve-headers): New format.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
- (nnslashdot-threaded-retrieve-headers): Thread properly.
- (nnslashdot-request-article): Be more lenient.
- (nnslashdot-threaded-retrieve-headers): Regexp search.
-
-2000-05-09 13:23:50 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-with-article): Define it before use it.
-
-2000-05-08 22:34:19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-supersede): Use mime-to-mml.
- * mm-decode.el (mm-insert-part): Test the buffer if no encoding.
-
-2000-05-08 22:34:24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-list-cached): Don't use
- `subst-char-in-string'.
-
-2000-05-08 Dave Love <fx@gnu.org>
-
- * pop3.el (pop3-open-server): Fix creating name of trace buffer.
-
-2000-05-08 01:07:47 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-interactively-view-part): Append %s if the
- method is a single word.
- * nnwarchive.el (nnwarchive-type-definition): Typo.
-
-2000-05-07 17:24:01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-prepare-flat-list-dead-predicate): New
- function.
- (gnus-group-prepare-flat-predicate): Use it.
- (gnus-group-list-cached): List dead groups.
-
-2000-05-07 10:50:02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Don't decode message with
- format.
-
-2000-05-07 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mailcap.el (mailcap-maybe-eval): Honor user request not to
- evaluate the Lisp code.
-
-2000-05-06 17:40:20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-wash-html): New function.
- (gnus-article-wash-html): Bind.
- (gnus-article-make-menu-bar): Menu item.
- * gnus-sum.el (gnus-summary-wash-map): Bind 'h'.
- (gnus-summary-make-menu-bar): Menu item.
- * gnus.el: Autoload.
-
-2000-05-06 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * gnus-uu.el (gnus-uu-unshar-warning): New variable.
- (gnus-uu-unshar-article): Use it.
-
- * mailcap.el (mailcap-maybe-eval-warning): New variable.
- (mailcap-maybe-eval): Use it.
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Speling mistake
- in docstring.
-
- * mml.el (mml-generate-mime-1): Small comment.
-
-2000-05-05 12:27:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-de-base64-unreadable): New function.
- (gnus-article-de-base64-unreadable): Bind.
- (gnus-article-make-menu-bar): Menu item.
- * gnus-sum.el (gnus-summary-wash-map): Bind '6' and 'Z'.
- (gnus-summary-make-menu-bar): Menu item.
- * gnus.el: Autoload.
-
-2000-05-05 10:32:27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Remove en/disable multibyte.
- (gnus-summary-select-article): Add en/disable multibyte.
-
-2000-05-05 02:47:23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-edit-article): Enable multibyte.
- (gnus-summary-edit-article): New feature: editing raw articles.
-
-2000-05-05 00:30:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-region): Insert a space before encoding.
- Emacs MULE can not encode adjacent iso-2022-jp and cn-gb-2312.
- * gnus-msg.el (gnus-summary-mail-forward): Use unibyte buffer.
- Emacs MULE can not copy some 8bit characters in multibyte buffers.
- * mm-decode.el (mm-insert-part): Ditto.
-
-2000-05-04 17:49:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Extend forward regexp.
- (nndoc-forward-type-p): Ditto.
-
-2000-05-04 17:13:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Set the default
- value of enable-multibyte-characters.
-
-2000-05-04 10:31:24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): En/disable multibyte.
-
-2000-05-03 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-article-xface-ring-internal)
- (gnus-article-xface-ring-size): New variable.
- (gnus-article-display-xface): Use them to cache data. Don't try
- to use XPM. Set up binary coding for PBM's sake.
-
-2000-05-03 14:23:38 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-do-gcc): Set mail-parse-charset.
- * gnus-int.el (gnus-request-accept-article): Ditto.
- (gnus-request-replace-article): Ditto.
- * mm-util.el (mm-mime-mule-charset-alist): Add a fake mule-charset.
-
-2000-05-03 14:11:23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Test the validity of coding-system.
-
-2000-05-03 11:35:15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode field by
- field.
- * mml.el (mml-to-mime): Use message-default-charset.
- (mml-preview): Narrow to headers.
- * message.el (message-send-mail): Use message-default-charset.
- (message-send-news): Narrow to headers;
- use message-default-charset.
-
-2000-05-03 08:09:14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): A better junk
- detect.
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Save
- restriction.
- (mml-parse-1): Warning message.
- (mml-preview): Disable multibyte.
-
-2000-05-03 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-group-startup-message): Add newline before image.
-
-2000-05-02 21:34:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Check the coding-system.
- * message.el (message-send-mail): Use unibyte-buffer.
- (message-send-mail): Ditto.
-
-Mon May 1 15:09:46 2000 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.6 is released.
-
-2000-05-01 07:45:43 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Set no-markup-p and warn to nil.
-
-2000-04-28 21:14:21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-q-encoding-alist): Encode HTAB.
-
-2000-04-28 16:37:09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Use forward-line.
-
-2000-04-28 16:01:09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-button-menu): Use call-interactively.
-
-2000-04-28 15:30:17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Ignore 0x1b.
- (mml-insert-mime): No markup only for text/plain.
- (mime-to-mml): Remove MIME headers.
-
-2000-04-28 14:23:14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Set gnus-newsgroup-charset.
- * rfc2047.el (rfc2047-encode-message-header): Encode non-ascii
- as 8-bit.
- * lpath.el: Fbind image functions.
-
-2000-04-28 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-group-startup-message): Maybe use image in Emacs
- 21.
-
- * mailcap.el (mailcap-parse-mailcaps): Revert last change to
- search order. Use parse-colon-path and remove some redundancy.
- Doc fix.
- (mailcap-parse-mimetypes): Code consistently with
- mailcap-parse-mailcaps. Doc fix.
-
- * gnus-start.el (gnus-unload): Iterate over `features', not
- `load-history'.
-
-2000-04-28 09:52:21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Don't create blank parts.
- (mml-read-part): Fix mml tag.
- (mml-insert-mime): Convert message/rfc822.
- (mml-insert-mml-markup): Add mmlp parameter.
-
-2000-04-28 01:16:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Remove CTE.
-
-2000-04-28 00:31:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Fbind put-image for XEmacs.
- * mm-view.el (mm-inline-image): Fset it.
-
-2000-04-27 23:23:37 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Change forward regexp.
-
-2000-04-27 21:57:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially-limit): Change the
- default value.
-
-2000-04-27 21:53:32 Erik Toubro Nielsen <erik@ifad.dk>
-
- * gnus-util.el (gnus-extract-address-components): Name might be
- "".
-
-2000-04-27 20:32:06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Use ARG.
- (gnus-summary-post-forward): Ditto.
- * message.el (message-forward-show-mml): New variable.
- (message-forward): Use it.
- * mml.el (mml-parse-1): Add tag mml.
- (mml-read-part): Ditto.
- (mml-generate-mime): Support reentance.
- (mml-generate-mime-1): Support mml tag.
-
-2000-04-27 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Don't bother to require custom, browse-url.
- (gnus-article-x-face-command): Include gnus-article-display-xface.
-
- * gnus-ems.el: Assume only (X)Emacs 20+. Simplify XEmacs checks.
- Use defalias, not fset.
- (gnus-article-display-xface): New function.
-
- * mm-view.el (mm-inline-image-emacs): Use put-image, remove-images.
-
- * mm-decode.el: Small doc fixes. Require cl when compiling.
- (mm-xemacs-p): Deleted.
- (mm-get-image-emacs, mm-get-image-xemacs): Deleted.
- (mm-get-image): Amalgamate Emacs and XEmacs code here; for Emacs,
- use create-image and don't special-case xbm.
- (mm-valid-image-format-p): Use display-graphic-p.
-
-2000-04-27 15:27:54 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially-limit): New variable.
- (message-send-mail-partially): New function.
- (message-send-mail): Use it.
- * mm-bodies.el (mm-decode-content-transfer-encoding): Remove
- all blank lines inside of base64.
- * mm-partial.el (mm-inline-partial): Add an option. Remove tail
- blank lines.
-
-2000-04-27 10:03:36 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-tag): Match more special characters.
-
-2000-04-27 09:06:29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-bug): Avoid attaching the external buffer.
-
-2000-04-27 00:58:43 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-inline-media-tests): Add message/partial.
- (mm-inlined-types): Ditto.
- * mm-partial.el: New file.
-
-2000-04-27 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-mime-data): Fix octet-stream syntax -- might
- matter in Emacs 21.
-
-2000-04-26 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-bodies.el (mm-encode-body): Remove reference to
- mm-default-charset in comment.
-
-2000-04-24 00:56:00 Bj\e,Av\e(Brn Torkelsson <torkel@hpc2n.umu.se>
-
- * rfc2047.el (rfc2047-encode-message-header): Fixing typo.
-
-2000-04-26 12:27:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-send): Move gnus-draft-setup inside of
- let.
-
-2000-04-26 12:26:10 Pavel Janik ml. <Pavel.Janik@inet.cz>
-
- * gnus-draft.el (gnus-draft-setup): Fix comments.
-
-2000-04-26 10:06:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmbox.el (nnmbox-create-mbox): Use nnmbox-file-coding-system,
- if nnmbox-file-coding-system-for-write is nil.
-
-2000-04-26 02:17:44 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Just remove the
- header if nil.
-
-2000-04-26 00:23:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Insert directly if decoded.
- * mml.el (autoload): Typo.
-
-2000-04-25 22:46:36 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Set up posting-charset.
- * gnus-msg.el (gnus-group-posting-charset-alist): Add koi8-r.
-
-2000-04-25 21:23:54 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Fix yahoo mail.
-
-2000-04-25 20:12:17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Don't include LWS ahead of
- word if not necessary.
- (rfc2047-encode-region): Put space between encoded words.
-
-2000-04-24 21:11:48 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-netrc-machine): Another default to nntp.
-
-2000-04-24 18:14:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-setup): Restore mml only when
- required.
- (gnus-draft-edit-message): Require restoration.
-
-2000-04-24 16:51:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-headers): Copy gnus-newsgrou-scored
- back.
-
-2000-04-24 16:01:15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-article): Make sure that the summary
- buffer is live.
-
-2000-04-24 15:42:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcaps): Reorder.
- (mailcap-parse-mailcap): Backwards parsing.
- (mailcap-possible-viewers): Remove nreverse.
- (mailcap-mime-info): Ditto.
- (mailcap-add-mailcap-entry): Keep alternative viewer.
-
-Mon Apr 24 21:12:06 2000 Lars Magne Ingebrigtsen <lmi@quimbies.gnus.org>
-
- * gnus.el: Gnus v5.8.5 is released.
-
-2000-04-24 16:29:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-header-encoding-alist): Doc fix.
-
- * gnus-util.el (gnus-netrc-machine): Default to nntp.
-
- * mml.el (mml-generate-mime-1): Force 8bit on message/rfc822.
-
-2000-04-23 23:27:25 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Disable prepare-hook.
-
-2000-04-23 00:32:32 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Fix copyright statements.
-
- * gnus-sum.el (gnus-alter-articles-to-read-function): New
- variable.
- (gnus-articles-to-read): Use it.
-
- * message.el (message-get-reply-headers): Bind free variable.
-
-2000-04-23 01:14:28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-get-reply-headers): Fix to-address.
-
-2000-04-22 22:51:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Hotmail fix. Add a debug function.
-
-2000-04-23 00:32:32 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (t): M-down and M-up.
-
-2000-04-22 20:22:03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el: Doc fix.
-
-2000-04-22 10:25:56 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-egroups-article): Remove < and >.
-
-2000-04-22 14:25:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-dejanews-create-mapping): Remove the context
- string.
- (nnweb-request-group): Don't scan twice.
- (nnweb-request-scan): Don't nix out the hashtb.
-
- * message.el (message-get-reply-headers): Return a value.
-
-2000-04-22 14:12:41 David Aspinwall <aspinwall@TimesTen.com>
-
- * gnus-art.el (gnus-button-url-regexp): New value to match naked
- urls.
-
-2000-04-22 01:23:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cache.el (gnus-summary-insert-cached-articles): Reverse the
- order messages are inserted.
-
- * mml.el (mml-generate-mime-1): rfc2047-encode the heads of
- message/rfc822 parts.
-
- * gnus-art.el (gnus-article-read-summary-keys): Check for
- numerical values.
-
- * message.el (message-get-headers): Made into own function.
- (message-reply): Use it.
- (message-get-reply-headers): Renamed.
- (message-widen-reply): New command.
-
-2000-04-21 20:52:09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-data): Report the error and return nil.
-
-2000-04-21 19:38:43 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Don't remove
- non-base64 text at the end if not found.
-
-2000-03-01 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-read-move-group-name):
- (gnus-summary-move-article): Use `gnus-group-method' to find out
- what method the manually entered group belong to.
- `gnus-group-name-to-method' doesn't return any method parameters
- and `gnus-find-method-for-group' uses `gnus-group-name-to-method'
- for new groups so they wouldn't work.
-
-2000-04-21 22:27:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow nil values to
- override.
-
-2000-04-21 21:58:20 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-cache-insert): Does some stuff that is
- probably good to do, or something. I dunno. I just write these
- ChangeLog entries, and my name is Lars.
-
-1999-12-06 Hrvoje Niksic <hniksic@iskon.hr>
-
- * message.el (message-caesar-region): Use translate-region.
-
-2000-04-21 21:20:32 Mike Fabian <mike.fabian@gmx.de>
-
- * gnus-group.el (gnus-group-catchup-current): Doc fix.
-
-2000-04-21 20:36:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-buffer): Don't kill local
- variables, because that makes Emacs flash.
-
- * gnus-group.el (gnus-group-insert-group-line): Don't call
- gnus-group-add-icon unconditionally.
-
- * gnus-xmas.el (gnus-group-add-icon): Moved here.
-
- * gnus-group.el (gnus-group-glyph-directory): Don't depend on
- xmas.
- (gnus-group-glyph-directory): Removed.
-
-2000-04-21 20:26:23 Jaap-Henk Hoepman <hoepman@cs.utwente.nl>
-
- * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't do stuff if
- gnus-newsgroup-name is "".
-
-2000-04-21 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Add support for UTF-8
- in conjunction with MULE-UCS.
-
-1999-12-13 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * rfc2047.el (rfc2047-fold-region): Don't use the same break twice.
-
-1999-12-14 04:14:44 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (last, mapcon, member-if, union): New compiler
- macros for emulating cl functions.
-
-1999-12-21 Jan Vroonhof <vroonhof@math.ethz.ch>
-
- * message.el (message-shorten-references): Only cater to broken
- INN for news. This caters for broken smtpd.
-
-2000-04-21 18:20:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-info): Use the first match; not the
- last.
-
- * gnus-agent.el (gnus-category-kill): Save the category list.
-
-2000-04-21 16:41:50 Chris Brierley <brierley@pobox.com>
-
- * gnus-sum.el (gnus-summary-move-article): Do something or other.
-
-2000-04-21 16:07:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-add-icon): Fixed indentation.
-
-2000-04-21 16:07:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-add-icon): Fixed indentation.
-
-2000-04-21 10:43:16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-prepare-flat-predicate): New function.
- (gnus-group-list-cached): Use it.
-
-2000-04-21 16:07:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Update all the copyright notices.
-
-2000-04-21 15:38:06 Vladimir Volovich <vvv@vvv.vsu.ru>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Remove
- non-base64 text at the end.
-
-2000-04-21 15:21:30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-bodies.el (mm-body-charset-encoding-alist): defcustomized.
-
-2000-04-21 15:15:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el: Don't autoload cancel-function-timers.
-
- * message.el (message-fetch-field): Fold case.
-
-2000-04-21 15:11:09 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-forward-before-signature): New variable.
-
-2000-04-21 15:10:31 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
-
- * gnus-mlspl.el: Fix stuff.
-
-2000-04-21 14:41:09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-update-article-line): Don't hide
- subjects when unthreaded.
-
-2000-04-21 14:11:39 David S. Goldberg <dsg@mitre.org>
-
- * gnus-art.el (gnus-boring-article-headers): Work on long CCs as
- well.
-
-2000-04-21 14:06:43 Rui Zhu <sprache@iname.com>
-
- * gnus-art.el (gnus-article-mode): Fix variable name.
-
-2000-04-21 13:54:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el: Fix autoload.
-
- * flow-fill.el (flow-fill): Fix provide.
-
- * gnus-draft.el (gnus-draft-send): Bind message-setup-hook to
- nil.
-
-2000-04-20 22:24:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-windows): Revert to switch-to-buffer.
-
-2000-04-21 05:22:18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-netrc-machine): Didn't work.
-
-2000-04-20 21:22:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-setup): Restore to mml.
-
-2000-04-21 01:24:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * flow-fill.el: Renamed from fill-flowed.
-
- * message.el (message-forward-ignored-headers): Default to
- removing CTE.
-
-2000-04-21 00:48:48 <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-mode): Don't fill headers.
-
-2000-04-20 23:12:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-pipe-buffer-body): Use shell
-
-2000-02-21 Yoshiki Hayashi <yoshiki@xemacs.org>
-
- * nnvirtual.el (nnvirtual-request-article):
- Bind gnus-override-method to nil.
- (nnvirtual-request-update-mark): Don't update mark when
- article is not there.
-
-2000-04-20 16:35:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Check forwarded message.
-
-2000-04-20 21:17:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-parse-netrc): Allow "port".
- (gnus-netrc-machine): Take a port param.
- (gnus-netrc-machine):
-
- * gnus-art.el (gnus-request-article-this-buffer): Allow
- re-selecting referenced articles.
-
- * message.el (message-cancel-news): Allow editing.
- (message-cancel-message): Add newline.
-
-2000-04-20 21:03:54 William M. Perry <wmperry@aventail.com>
-
- * mm-view.el (mm-inline-image-emacs): New function.
-
-2000-04-20 20:44:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-delete-incoming): Change default in
- cvs.
-
-2000-04-20 20:43:34 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * gnus-art.el (gnus-mime-view-part-as-type-internal): New
- function.
-
-2000-04-20 14:45:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnml.el (nnml-request-expire-articles): Use it.
-
- * nnmail.el (nnmail-expiry-target): New variable.
- (nnmail-expiry-target-group): New function.
-
-2000-04-20 02:36:31 Emerick Rogul <emerick@cs.bu.edu>
-
- * message.el (message-forward): Add non-MIME separators.
-
-2000-04-20 02:25:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-generate-headers): Respect the syntax check
- spec.
-
- * gnus-sum.el (gnus-remove-thread-1): Show thread.
- (gnus-remove-thread): Don't show all threads.
-
-Thu Apr 20 01:39:25 2000 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.4 is released.
-
-2000-04-19 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-parse-mimetypes): Add ...mime.types.
-
-2000-04-18 12:28:24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-type-definition): New egroups html.
- (nnwarchive-egroups-*): Ditto.
- (nnwarchive-url): Unibyte buffer and single line cookie.
-
-2000-04-14 18:50:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-char-or-char-int-p): New alias.
- * nnweb.el (nnweb-decode-entities): Check the validity of numeric
- entities.
-
-2000-04-10 Daiki Ueno <ueno@unixuser.org>
-
- * lisp/imap.el (imap-body-lines): Check Content-Type: of the
- article case insensitively.
-
-2000-04-10 20:35:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Use the default
- password provided in mail-sources; use webmail:subtype:user as
- the key.
-
-2000-04-10 20:35:46 John Wiegley <johnw@gnu.org>
-
- * mail-source.el (mail-source-fetch-webmail): Use
- mail-source-password-cache.
-
-2000-04-09 18:13:47 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Add netscape mail and fix HotMail mail.
-
-2000-04-08 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-kerberos4-open): Work with recent `imtest's.
-
-2000-04-02 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-request-article): Use BODY.PEEK[] instead of
- RFC822.PEEK if server support IMAP4rev1.
- (nnimap-request-body): Use BODY.PEEK[TEXT] instead of
- RFC822.TEXT.PEEK if server support IMAP4rev1.
- (nnimap-request-head): Use BODY.PEEK[HEADER] instead of
- RFC822.HEADER if server support IMAP4rev1.
- (nnimap-request-article-part): Support bodydetail in response
- data.
-
-2000-03-11 Simon Josefsson <jas@pdc.kth.se>
-
- * fill-flowed.el: New file.
-
- * mm-decode.el (mm-dissect-singlepart): Create a MIME handle for
- text/plain parts with `format' parameters.
-
- * mm-view.el (autoload): Autoload fill-flowed.
- (mm-inline-text): For "plain" parts with a format=flowed
- parameter, call `fill-flowed'.
-
-2000-03-21 10:32:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-list): Fudge new-style
- slashdot ids.
-
-2000-03-20 00:12:42 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-list): Use the new slashdot
- format.
-
-2000-03-16 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: GSSAPI support, support kerberos 4 with Cyrus v1.6.x
- `imtest' too.
- (imap-kerberos4-program): Renamed from `imap-imtest-program'.
- (imap-gssapi-program): New variable.
- (imap-streams): Add gssapi.
- (imap-stream-alist): Ditto.
- (imap-authenticators): Ditto.
- (imap-authenticator-alist): Ditto.
- (imap-kerberos4-stream-p): Rename from `imap-kerberos4s-p'.
- (imap-kerberos4-open): Loop over imtest programs, support Cyrus
- 1.6.x `imtest' syntax.
- (imap-gssapi-stream-p): New function.
- (imap-gssapi-open): Ditto.
- (imap-gssapi-auth-p): Ditto.
- (imap-gssapi-auth): Ditto.
- (imap-kerberos4-auth-p): Renamed from `imap-kerberos4a-p'.
- (imap-send-command): Use buffer-local `imap-client-eol' value.
-
- * nnimap.el (nnimap-retrieve-headers-progress): Fold continuation
- lines and turn TAB into SPC before parsing.
-
-2000-03-15 Simon Josefsson <jas@pdc.kth.se>
-
- * nnheader.el (nnheader-group-pathname): Make sure to return a
- directory.
- * nnmail.el (nnmail-group-pathname): Ditto.
-
-2000-02-08 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): Fix `In-Reply-To' too, it
- might split in the middle of a message-id.
-
-2000-03-13 13:51:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-server-kill-server): Offer to kill all the
- groups from the server.
-
- * gnus-sum.el (gnus-summary-save-parts): Fix interactive spec.
- (gnus-summary-toggle-header): Update the wash status.
-
- * gnus-uu.el ((gnus-uu-extract-map "X" gnus-summary-mode-map)):
- Moved here.
-
- * gnus-agent.el (gnus-agent-save-group-info): Respect old
- setting.
-
- * nnmail.el (nnmail-get-active): Use it.
- (nnmail-parse-active): New function.
-
- * mm-view.el (mm-inline-text): Support the new version of
- vcard.el.
-
- * gnus-sum.el (gnus-summary-move-article): Only delete article
- when moving junk.
- (gnus-deaden-summary): Bury the buffer.
-
- * nnmail.el (nnmail-group-pathname): Ditto.
-
- * nnheader.el (nnheader-group-pathname): Use expand-file-name.
-
-2000-03-13 20:23:06 Christoph Rohland <hans-christoph.rohland@sap.com>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode no matter
- whether Mule.
-
-2000-03-10 14:57:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Protect against unloaded Gnus.
-
- * gnus-topic.el (gnus-topic-update-topic-line): Don't update the
- parent.
- (gnus-topic-update-topic-line): Yes, do.
- (gnus-topic-goto-missing-group): Tally the correct number of
- unread articles before inserting the topic line.
-
-2000-03-01 09:55:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Ignore errors.
-
-2000-02-13 13:53:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-dissect-buffer): Ditto.
-
- * gnus-art.el (article-decode-charset): Strip CTE.
-
- * ietf-drums.el (ietf-drums-strip): New function.
-
- * gnus-sum.el (gnus-summary-move-article): Don't use the prefix
- when prompting in read-only groups.
-
-2000-02-23 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-send-command): Change EOL-chars when
- `imap-client-eol' differs from default, not only for kerberos4.
- (imap-mailbox-status): Get encoded mailbox's status.
-
-2000-02-19 Simon Josefsson <jas@pdc.kth.se>
-
- * mail-source.el (mail-source-fetch-imap): Copy `imap-password'
- into `mail-source-password-cache'.
-
-2000-02-17 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * mm-util.el (mm-mime-charset): Check for presence of
- `coding-system-get' and `get-charset-property' (recent XEmacs has
- the former, but not the latter).
-
-2000-01-28 Dave Love <fx@gnu.org>
-
- * message.el (message-check-news-header-syntax): Fix typo
- `newsgroyps'.
- (message-talkative-question): Put temp buffer in fundamental-mode.
- (message-recover): Use fundamental-mode in the right buffer.
-
- * nnmail.el (nnmail-split-history): Use fundamental-mode in the
- right buffer.
-
-2000-01-26 12:01:18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-decode-region): Add charset parameter.
- (quoted-printable-decode-string): Ditto.
-
- * gnus-art.el (article-de-quoted-unreadable): Use it.
-
-2000-01-21 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-split-predicate): New variable.
- (nnimap-split-articles): Use it.
-
-2000-01-20 Simon Josefsson <jas@pdc.kth.se>
-
- * utf7.el: Change email address.
-
-2000-01-18 22:03:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-catchup): Purge split history.
-
-2000-01-14 02:43:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-generate-active): Support extended group name.
- (nnmail-get-active): Ditto.
-
-2000-01-13 15:16:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-write-active): Since no prefix in
- group names, don't remove anything.
-
-2000-01-13 15:10:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-my-deja-open): My-deja changes.
-
-2000-01-13 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-headers-progress): Create xref field.
-
-2000-01-10 23:35:33 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Translate full path.
-
-2000-01-09 22:52:35 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-other-frame): Fix typo.
-
-1999-06-25 Andreas Jaeger <aj@arthur.rhein-neckar.de>
-
- * gnus-cus.el (gnus-group-customize): Fix typo.
-
-2000-01-08 08:36:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-insert): Simplified.
-
-2000-01-06 18:32:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-map): "e" is
- gnus-summary-edit-article.
-
-2000-01-06 18:25:37 Jari Aalto <jari.aalto@poboxes.com>
-
- * mailcap.el (mailcap-mime-extensions): Add .diff.
-
-2000-01-06 00:06:40 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * mm-decode.el (mm-mailcap-command): handle "%%" and the case where
- there is no "%s" in the method.
-
-2000-01-08 21:01:04 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * gnus-sum.el (gnus-summary-select-article): Return 'old.
-
-2000-01-06 13:41:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnfolder.el (nnfolder-read-folder): Use nnfolder-save-buffer.
-
- * gnus.el: Really always pop up a new frame.
-
- * parse-time.el (parse-time-rules): Allow 100-110 to be
- 2000-2010.
-
- * time-date.el (date-to-time): Don't use timezone.
-
-2000-01-06 Dave Love <fx@gnu.org>
-
- * time-date.el: Add keywords.
- (date-to-time): Add autoload cookie. Canonicalize with
- timezone-make-date-arpa-standard.
- (time-to-seconds): Avoid caddr.
- (safe-date-to-time): Add autoload cookie.
-
- * base64.el: Require cl when compiling.
-
-2000-01-05 BrYan P. Johnson <beej@mindspring.net>
-
- * gnus-group.el (gnus-group-line-format-alist): Added %E for
- eyecandy.
- (gnus-group-insert-group-line): Now groks %E and inserts icon in
- group line using gnus-group-add-icon.
- (gnus-group-icons): Added customize group.
- (gnus-group-icon-list): Added variable.
- (gnus-group-glyph-directory): Added variable.
- (gnus-group-icon-cache): Added variable.
- (gnus-group-running-xemacs): Added variable.
- (gnus-group-add-icon): Added function. Add an icon to the current
- line according to gnus-group-icon-list.
- (gnus-group-icon-create-glyph): Added function.
-
-2000-01-05 17:31:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-select-article): Return whether we
- selected something new.
- (gnus-summary-search-article): Start searching at the window
- point.
-
- * gnus-group.el (gnus-fetch-group): Complete over
- gnus-active-hashtb.
-
-Wed Jan 5 17:06:41 2000 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.3 is released.
-
-2000-01-05 15:56:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-preserve-marks): New variable.
- (gnus-summary-move-article): Use it.
- (gnus-group-charset-alist): Added more entries.
-
-2000-01-03 01:18:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-override-types): Removed duplicate.
-
- * gnus-uu.el (gnus-uu-mark-over): Use gnus-summary-default-score
- as the default score.
-
- * gnus-score.el (gnus-score-delta-default): Changed name.
-
-2000-01-04 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-parse-literal):
- (imap-parse-flag-list): Don't care about props.
- (imap-parse-string): Handle quoted characters.
-
-2000-01-02 08:37:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-goto-unread): Doc fix.
- (gnus-summary-mark-article): Doc fix.
- (gnus-summary-mark-forward): Doc fix.
- (t): Changed keystroke for gnus-summary-customize-parameters.
-
- * gnus-art.el (gnus-article-mode-map): Use gnus-article-edit for
- "e".
- (gnus-article-mode-map): No, don't.
-
- * gnus-sum.el (gnus-summary-next-subject): Don't show the thread
- of the final article.
-
- * mm-decode.el (mm-interactively-view-part): Error on no method.
-
-2000-01-02 06:10:32 Stefan Monnier <monnier+gnu/emacs@tequila.cs.yale.edu>
-
- * gnus-score.el (gnus-score-insert-help): Something.
-
- * gnus-art.el (gnus-button-alist): Exclude < from <URL:
-
- * gnus-win.el (gnus-configure-frame): Ditto.
-
- * gnus-mh.el (gnus-summary-save-in-folder): Use
- with-current-buffer.
-
-2000-01-02 05:00:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnwarchive.el: Changed file perms.
-
-1999-12-19 21:42:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-delete-groups): New command.
- (gnus-group-delete-group): Extra no-prompt parameters.
-
-1999-12-14 10:18:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-article): Translate <br> into
- <p>.
-
-1999-12-28 12:20:18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Don't insert message id.
-
-1999-12-28 Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro\e,A_\e(Bjohann)
-
- * nnimap.el (nnimap-split-fancy): New variable.
- (nnimap-split-fancy): New function.
-
-1999-12-28 Simon Josefsson <jas@pdc.kth.se>
-
- (nnimap-split-rule): Document symbol value.
-
-1999-12-28 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-headers-progress): Let
- `nnheader-parse-head' parse article.
- (nnimap-retrieve-headers-from-server): Don't request ENVELOPE,
- request headers needed by `nnheader-parse-head'.
-
-1999-12-23 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Correct default
- value (crosspostings are handled), improve documentation.
-
- * smiley.el: Declare file coding system as iso-8859-1.
-
- * nnultimate.el: Dito.
-
- * message.el: Dito.
-
- * gnus-cite.el: Dito.
-
- * gnus-spec.el: Dito.
-
-1999-12-21 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): New layout.
- (gnus-setup-message): No longer make `message-posting-charset'
- buffer-local.
- (gnus-setup-posting-charset): Reflect the new layout of
- `gnus-group-posting-charset-alist' and `message-posting-charset'.
-
- * message.el (message-send-mail): Bind `message-this-is-mail' and
- `message-posting-charset'.
- (message-send-news): Dito, and honour new layout of
- `message-posting-charset'.
- (message-encode-message-body): Ignore `message-posting-charset'.
-
- * mm-bodies.el (mm-body-encoding): Consider
- `message-posting-charset' when deciding whether to use 8bit.
-
- * rfc2047.el (rfc2047-encode-message-header): Back out change.
- (rfc2047-encodable-p): Now solely for headers; use
- `message-posting-charset'.
-
-1999-12-20 14:10:39 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-type-definition): Set default value.
-
-1999-12-19 22:49:13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el (nnagent-server-opened): Optional.
- (nnagent-status-message): Optional.
-
-1999-12-19 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-cite.el (gnus-article-toggle-cited-text): Restore beg and
- end (referenced by instructions in
- `gnus-cited-opened-text-button-line-format-alist').
-
-1999-12-18 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el (imap-starttls-open): Typo.
-
-1999-12-18 16:43:37 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): Non-MULE case.
- * mail-prsvr.el (mail-parse-mule-charset): New variable.
- * rfc2047.el (rfc2047-dissect-region): Bind it.
-
-1999-12-18 Florian Weimer <fw@s.netic.de>
-
- * mml.el (mml-generate-multipart-alist): Correct default value.
-
- * mm-encode.el (mm-use-ultra-safe-encoding): New variable.
- (mm-safer-encoding): New function.
- (mm-content-transfer-encoding): Use both.
-
- * mm-bodies.el (mm-body-encoding): Use mm-use-ultra-safe-encoding.
- * qp.el (quoted-printable-encode-region): Dito.
-
-1999-12-18 14:08:48 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Snarf the raw file.
-
-1999-12-18 14:08:12 Victor S. Miller <victor@idaccr.org>
-
- * webmail.el (webmail-hotmail-list): raw=0.
-
-1999-12-18 11:14:51 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-enter-history): Back-compatible in
- group name.
-
-1999-12-18 11:02:00 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire): Convert to symbol if stringp.
-
-1999-12-18 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: Don't autoload digest-md5.
- (imap-starttls-open): Bind coding-system-for-{read,write}.
- (imap-starttls-p): Check if we can find starttls.el.
- (imap-digest-md5-p): Check if we can find digest-md5.el.
-
-1999-12-17 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * base64.el (base64-encode-string): Accept 2nd argument
- `no-line-break'.
-
- * imap.el: Require `digest-md5' when compiling; add autoload
- settings for `digest-md5-parse-digest-challenge',
- `digest-md5-digest-response', `starttls-open-stream' and
- `starttls-negotiate'.
- (imap-authenticators): Add `digest-md5'.
- (imap-authenticator-alist): Setup for `digest-md5'.
- (imap-digest-md5-p): New function.
- (imap-digest-md5-auth): New function.
- (imap-stream-alist): Add STARTTLS entry.
- (imap-starttls-p): New function.
- (imap-starttls-open): New function.
-
-1999-12-18 01:08:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-enter-history): Bad group name.
-
-1999-12-17 19:36:47 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Use mapcar instead of
- string-to-x function.
-
-1999-12-17 13:08:54 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-fold-region): Fold a line more than once.
-
-1999-12-17 11:54:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Enhance hotmail-snarf.
-
-1999-12-17 10:38:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-dissect-region): Rewrite.
-
-1999-12-16 22:59:22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-list): Search no-error.
-
-1999-12-15 22:07:15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Support nov-is-evil.
- * gnus-bcklg.el (gnus-backlog-request-article): Buffer is optional.
- Set it if non-nil.
- * gnus-agent.el (gnus-agent-fetch-articles): Use it.
-
-1999-12-15 08:55:19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el (nnagent-server-opened): Redefine.
- (nnagent-status-message): Ditto.
-
-1999-12-14 23:37:44 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc1843.el (rfc1843-decode-region): Use
- buffer-substring-no-properties.
- * gnus-art.el (article-decode-HZ): New function.
-
-1999-12-14 22:07:26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-translate-file-chars): Only in full path.
-
-1999-12-14 16:21:45 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): mail-parse-charset is a
- MIME charset not a MULE charset.
-
-1999-12-14 15:08:03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el: Translate more ugly characters.
- * nnheader.el (nnheader-translate-file-chars): Don't translate
- the second ':'.
-
-1999-12-14 10:40:33 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Use all refer
- method if cannot find the article.
-
-1999-12-14 01:13:50 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Don't use refer
- method if overrided.
-
-1999-12-13 23:38:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Parameter
- dontexpunge.
-
-1999-12-13 23:31:17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support my-deja. Better error report.
-
-1999-12-13 18:59:33 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-date-to-date): Error proof when input
- is bad.
- * gnus-sum.el (gnus-list-of-unread-articles): When (car read)
- is not 1.
-
-1999-12-13 18:22:08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-request-article): A space.
-
-1999-12-13 17:20:25 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el: Support different backend with same name.
-
-1999-12-13 13:14:42 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers): Support
- archived group.
- (nnslashdot-sane-retrieve-headers): Ditto.
- (nnslashdot-request-article): Ditto.
-
-1999-12-13 11:41:32 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Narrow to point.
-
-1999-12-13 10:59:42 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-insert): Follow refresh url.
- * nnslashdot.el: Use it.
-
-1999-12-13 10:39:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-decode-entities): Decode numerical entities.
- (nnweb-decode-entities-string): New function.
-
- * nnwarchive.el (nnwarchive-decode-entities-string): Rename to
- nnweb-* and move to nnweb.el.
- * nnwarchive.el: Use nnweb-decode-entities, etc.
- * webmail.el: Ditto.
-
- * nnslashdot.el: Use nnweb-decode-entities-string.
- (nnslashdot-decode-entities): Remove.
-
-1999-12-13 10:40:56 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * nnslashdot.el: Decode entities.
-
-1999-12-12 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-category-edit-groups)
- (gnus-category-edit-score, gnus-category-edit-predicate): Replace
- expansion of setf, fixed.
-
-1999-12-12 12:50:30 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el: Revoke last Dave Love's patch, because of
- incompatibility of XEmacs.
-
-1999-12-12 12:27:03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el: Change headers.
- * rfc1843.el: Ditto.
- * uudecode.el: Ditto.
-
-1999-12-07 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-category-edit-predicate)
- (gnus-category-edit-score, gnus-category-edit-score): Expand setf
- inside backquote to avoid it at runtime.
-
-1999-12-07 Dave Love <fx@gnu.org>
-
- * binhex.el: Require cl when compiling.
-
-1999-12-04 Dave Love <fx@gnu.org>
-
- * gnus-cus.el (gnus-group-parameters): Allow nil for banner.
-
-1999-12-04 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-delete-duplicates): New function.
- (mm-write-region): Use it.
-
- * mml.el (mml-minibuffer-read-type): Use mm-delete-duplicates.
-
- * mailcap.el (mailcap-mime-types): Require mm-util. Use
- mm-delete-duplicates.
-
- * imap.el (imap-open, imap-debug): Avoid mapc.
-
- * nnvirtual.el (nnvirtual-create-mapping): Likewise.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Avoid copy-list.
- (gnus-multi-decode-encoded-word-string): Avoid mapc.
-
- * gnus-start.el (gnus-site-init-file): Avoid ignore-errors at
- runtime.
-
- * gnus.el (gnus-select-method): Likewise.
-
- * nnheader.el (nnheader-nov-read-integer): Likewise.
-
- * mm-view.el (mm-inline-message): Require cl when compiling.
- Avoid ignore-errors at runtime.
- (mm-inline-text): Avoid mapc.
-
-1999-12-12 10:36:51 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Widen is bad.
-
-1999-12-12 10:17:42 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): `charset-after' may not be defined.
-
-1999-12-12 Florian Weimer <fw@s.netic.de>
-
- * rfc2047.el (rfc2047-encodable-p): New parameter header used to
- indicate that only US-ASCII is permitted.
- (rfc2047-encode-message-header): Use it. Now, Gnus should never
- use unencoded 8-bit characters in message headers.
-
-1999-12-12 03:08:15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * ietf-drums.el (ietf-drums-narrow-to-header): Make it work with
- CRLF.
-
-1999-12-11 14:42:26 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Require url-cookie.
-
-1999-12-11 14:21:23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-make-caesar-translation-table): A
- new function to make modified caesar table.
- (nnwarchive-from-r13): Use it.
- (nnwarchive-mail-archive-article): Improved.
-
-1999-12-11 12:30:20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-url): Use mm-with-unibyte-current-buffer.
-
-1999-12-10 16:22:24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-request-article): Return cons.
-
-1999-12-10 16:06:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Typo.
-
-1999-12-10 12:14:04 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte): New macro.
- * nnweb.el (nnweb-init): Use it.
-
-1999-12-09 20:39:49 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-after): New function.
- (mm-find-mime-charset-region): Set charsets after
- delete-duplicates and use find-coding-systems-region.
- (mm-find-charset-region): Remove composition.
-
- * mm-bodies.el (mm-encode-body): Use mm-charset-after.
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Ditto.
-
-1999-12-09 17:47:56 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-mime-charset-region): Revoke last change.
- * mml.el (mml-confirmation-set): New variable.
- (mml-parse-1): Ask user to confirm.
-
-1999-12-09 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Make sure all methods
- are scanned when we have directory mail-sources (the mail source
- is modified in that case, so we must scan it for all
- groups/methods).
-
-1999-12-09 12:05:28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-request-move-article): Save nnml-current-directory
- and nnml-article-file-alist.
-
-1999-12-09 10:20:07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-get-new-news-this-group): Binding
- nnmail-fetched-sources.
-
-1999-12-09 10:19:01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Use the last charset.
-
-1999-12-08 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-select-method): Made the option list prettier.
-
-1999-12-08 Florian Weimer <fw@s.netic.de>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Use iso-8859-1
- for the `de' newsgroups hierarchy, as it is common practice there.
-
-
-1999-12-07 16:17:12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-mail-archive-article): Fix
- buffer-string arguments. Fix references.
-
-1999-12-07 15:04:18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-confirmation-function): New variable.
- (gnus-agent-batch-fetch): Use it.
- (gnus-agent-fetch-session): Use it.
-
-1999-12-07 12:32:43 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-mime-charset-region): Delete nil.
-
-1999-12-07 11:45:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Don't capitalize. Delete
- nil.
-
-1999-12-07 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnslashdot.el (nnslashdot-request-list): There were two
- top-level body-forms. Put a `progn' around them.
-
- * gnus.el (gnus-select-method): Use `condition-case'
- instead of `ignore-errors', since cl may not be loaded when the
- form is evaluated.
-
-1999-12-06 23:57:47 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Support www.mail-archive.com.
-
-1999-12-06 23:55:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-get-new-mail): Remove fetched sources before
- do anything.
-
-1999-12-06 Simon Josefsson <jas@pdc.kth.se>
-
- * utf7.el: New file, written by Jon K Hellan.
-
- * imap.el (imap-use-utf7): Renamed from `imap-utf7-p', change
- default to t.
-
-1999-12-06 04:40:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-delete-group): New function.
-
- * gnus-sum.el (gnus-summary-refer-article): Work for lists with
- current.
- (gnus-refer-article-methods): New function.
- (gnus-summary-refer-article): Use it.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-retrieve-groups): Return active format.
-
- * nnimap.el (nnimap-replace-in-string): Removed.
- (nnimap-request-list):
- (nnimap-retrieve-groups):
- (nnimap-request-newgroups): Quote group instead of escaping SPC.
-
-1999-12-05 Simon Josefsson <jas@pdc.kth.se>
-
- * imap.el: Use format-spec for ssl program.
- * imap.el (imap-ssl-arguments): Removed.
- (imap-ssl-open-{1,2}): Removed.
-
-1999-12-04 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-start.el (gnus-site-init-file): Use `condition-case'
- instead of `ignore-errors', since cl may not be loaded when the
- form is evaluated.
-
-1999-12-04 11:34:22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-8bit-char-regexps): Removed.
- (mm-7bit-chars): New variable.
- (mm-body-7-or-8): Use it in both cases.
-
-1999-12-04 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * gnus-start.el (gnus-site-init-file): Don't use cl macros in
- defcustom definitions.
-
-1999-12-04 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-decode.el (mm-display-part): Let mm-display-external return
- inline or external.
- (mm-display-external): For copiousoutput methods, insert output in
- buffer.
-
-1999-12-04 03:29:13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-headers-with-xover): Goto the end of
- buffer.
-
-1999-12-04 08:31:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-audio.el: An M too far.
-
- * gnus-msg.el (gnus-setup-message): One backtick too many.
-
- * gnus-art.el (gnus-mime-view-part-as-type): mailcap-mime-types is
- a function, not a variable.
-
-1999-12-04 08:14:08 Max Froumentin <masmef@maths.bath.ac.uk>
-
- * gnus-score.el (gnus-score-body): Widen before requesting.
-
-1999-12-04 08:06:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-prepare-flat): Comment fix.
-
-1999-12-04 03:01:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-webmail): Bind
- mail-source-string.
-
-1999-12-04 07:18:23 Matt Swift <swift@alum.mit.edu>
-
- * gnus-uu.el (gnus-uu-mark-by-regexp): Doc fix.
- (gnus-uu-unmark-by-regexp): Ditto.
-
- * gnus-group.el (gnus-group-catchup-current): Would bug out on
- dead groups.
-
-1999-12-04 01:34:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-setup-message): Allow the charset setting to
- do their real thing.
-
- * nnmh.el (nnmh-be-safe): Doc fix.
-
- * gnus-sum.el (gnus-summary-exit): Write cache active file.
-
- * nntp.el (nntp-retrieve-headers-with-xover): Make sure the entire
- status line has arrived before we count it.
-
- * mailcap.el (mailcap-mime-data): Removed save-file from audio/*.
-
- * gnus-sum.el (gnus-thread-header): Fixed after indent.
- Whitespace problems.
-
- * gnus-win.el (gnus-configure-windows): Error fix.
-
- * gnus-demon.el (gnus-demon-add-nntp-close-connection): Add the
- right function.
-
- * gnus.el: Fixed all the doc strings to match the FSF convetions.
- Indent all functions. Fix all comments to match the comment
- conventions. Double-space after full stop.
-
-1999-12-04 01:14:55 YAMAMOTO Kouji <kouji@pobox.com>
-
- * nnmail.el (nnmail-split-it): I redefined nnmail-split-fancy's
- value to divide received mails into my favorite groups and I met
- an error. It takes place if the length of a element "VALUE" in
- nnmail-split-fancy is less than two.
-
-1999-10-10 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mml.el (mml-insert-part): New function.
-
-1999-09-29 04:48:14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Add `sc-cite-regexp'.
-
-1999-12-02 Dave Love <fx@gnu.org>
-
- * mm-decode.el: Customize.
-
-1999-12-03 Dave Love <fx@gnu.org>
-
- * nnslashdot.el, nnultimate.el: Don't lose at compile time when
- the W3 stuff isn't available.
-
-1999-12-03 Dave Love <fx@gnu.org>
-
- * imap.el, mailcap.el, nnvirtual.el, rfc2104.el: Don't require cl
- at runtime.
-
-1999-12-04 00:47:35 Dan Christensen <jdc@jhu.edu>
-
- * gnus-score.el (gnus-score-headers): Fix orphan scoring.
-
-1999-12-01 Andrew Innes <andrewi@gnu.org>
-
- * nnmbox.el (nnmbox-read-mbox): Count messages correctly, and
- don't be fooled by "From nobody" lines added by respooling.
-
- * pop3.el (pop3-movemail): Write crashbox in binary.
- (pop3-get-message-count): New function.
-
- * mail-source.el (mail-source-primary-source): New variable.
- (mail-source-report-new-mail-interval): New variable.
- (mail-source-idle-time-delay): New variable.
- (mail-source-new-mail-available): New internal variable.
- (mail-source-fetch-pop): Clear new mail flag, when mail from
- primary source has been fetched.
- (mail-source-check-pop): New function.
- (mail-source-new-mail-p): New function.
- (mail-source-start-idle-timer): New function.
- (mail-source-report-new-mail): New function.
- (mail-source-report-new-mail): New internal variable.
- (mail-source-report-new-mail-timer): New internal variable.
- (mail-source-report-new-mail-idle-timer): New internal variables.
-
-1999-12-04 00:39:34 Andreas Schwab <schwab@suse.de>
-
- * gnus-cus.el (gnus-group-customize): Customize fix.
-
-1999-12-04 00:38:24 Andrea Arcangeli <andrea@suse.de>
-
- * message.el (message-send-mail-with-sendmail): Use
- message-make-address.
-
-Fri Dec 3 20:34:11 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.2 is released.
-
-Fri Dec 3 20:09:41 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v5.8.1 is released.
-
-1999-11-11 Hrvoje Niksic <hniksic@iskon.hr>
-
- * mml.el (mml-insert-tag): Don't close the tag.
- (mml-insert-empty-tag): New function.
- (mml-attach-file): Use mml-insert-empty-tag instead of
- mml-insert-tag.
- (mml-attach-buffer): Ditto.
- (mml-attach-external): Ditto.
- (mml-insert-multipart): Ditto.
-
-1999-12-03 08:49:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-article): Return -1 if not find
- the article number.
-
-1999-12-03 01:12:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-find-method-for-group): The method of a new group
- is not the native one.
-
-1999-12-03 01:26:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-embedded-url): Always call browse-url.
-
-1999-12-02 18:00:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Use
- mm-with-unibyte-current-buffer.
- (nnultimate-request-article): Ditto.
-
-1999-12-02 14:57:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-groups): Set to process buffer.
-
-1999-12-02 11:14:50 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-current-buffer): New macro.
- * nnweb.el (nnweb-retrieve-headers): Use it.
- (nnweb-request-article): Use it.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Set a default date in
- case matching failed.
-
-1999-12-02 John Wiegley <jwiegley@inprise.com>
-
- * mail-source.el (mail-source-keyword-map): Add backslash to
- Delete-flag.
-
-1999-12-02 07:24:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-group-charset-alist): Default nnweb groups to
- Latin-1.
- (gnus-group-charset-alist): No, don't.
-
- * nnweb.el (nnweb-init): Make the buffer unibyte.
-
-1999-12-01 23:02:48 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-set-common-1): Fix to get the
- default value.
-
-1999-12-02 00:27:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-read-groups): Unibyte.
-
- * nnultimate.el (nnultimate-request-list): Use unibyte.
-
- * gnus-uu.el (gnus-uu-grab-articles): Bind
- gnus-display-mime-function to nil.
-
- * message.el (message-send-mail-with-sendmail): Use the
- user-mail-address variable.
-
- * gnus-art.el (gnus-ignored-headers): More headers.
-
- * message.el (message-shorten-1): Use list.
-
-1999-12-01 21:59:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Ignore nil
- signatures.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Get the data.
- (nnweb-dejanews-create-mapping): Do the properish date.
-
-1999-12-01 17:41:21 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-common-keyword-map): New variable.
- (mail-source-bind-common): New macro.
- (mail-source-fetch): Support plugged mail source.
- * gnus-int.el (gnus-request-scan): Use them.
-
-1999-12-01 21:59:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-message): Check whether charset is a
- string.
-
- * nnslashdot.el (nnslashdot-request-post): Insert <p>'s.
-
- * message.el (message-mode-map): Changed keystroke for
- message-yank-buffer.
-
-1999-11-26 Hrvoje Niksic <hniksic@iskon.hr>
-
- * message.el (message-shorten-references): Cut references to 31
- elements, then either fold them or shorten them to 988 characters.
- (message-shorten-1): New function.
- (message-cater-to-broken-inn): New variable.
-
-1999-12-01 21:47:10 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * nnslashdot.el (nnslashdot-lose): New function.
-
-1999-12-01 21:08:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-message): Not the right type of charset is
- being fetched here. Let the group charset rule.
- (mm-inline-message): Ignore us-ascii.
-
-1999-11-24 Carsten Leonhardt <leo@arioch.oche.de>
-
- * mail-source.el (mail-source-fetch-maildir): work around the
- ommitted "file-regular-p" in efs/ange-ftp
-
-1999-12-01 19:59:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Don't insert extra empty line.
- (mml-generate-mime-1): Use the encoding param.
-
- * gnus-sum.el (gnus-summary-show-article): Don't bind gnus-visual.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Require
- gnus-art before binding its variables.
-
- * gnus-art.el (gnus-article-prepare-display): Run the prepare
- after the MIME.
-
-1999-12-01 19:48:14 Rupa Schomaker <rupa-list@rupa.com>
-
- * message.el (message-clone-locals): Use it.
-
- * gnus-msg.el (gnus-configure-posting-styles): Make
- user-mail-address local.
-
-1999-11-20 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Scan each method only
- once.
-
-1999-12-01 17:37:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-generate-new-buffer-clone-locals): Use varstr.
- (message-clone-locals): Ditto.
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Have the digest
- group inherit reply-to or from.
-
-1999-12-01 13:04:09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Support numbered ARG
- for charset.
- (gnus-summary-show-article-charset-alist): New variable.
-
- * mm-bodies.el (mm-decode-string): Support gnus-all and
- gnus-unknown.
- (mm-decode-body): Ditto.
- * rfc2047.el (rfc2047-decode): Ditto.
-
-1999-12-01 17:37:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-delete-incoming): Change default to
- t.
-
-Wed Dec 1 16:31:31 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.99 is released.
-
-1999-12-01 14:28:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dgnushack.el (dgnushack-compile): No webmail under Emacs.
-
- * gnus-sum.el (gnus-summary-refer-article): Wrong interactive
- spec.
-
- * gnus-msg.el (gnus-configure-posting-styles): Eval `eval'.
- (gnus-configure-posting-styles): No, don't.
- (gnus-configure-posting-styles): Allow overriding files.
-
- * gnus-art.el (gnus-header-button-alist): Use browse-url
- directly.
-
- * mm-decode.el (mm-inline-media-tests): Check feature vcard.
-
- * gnus-msg.el (gnus-summary-yank-message): New command and
- keystroke.
-
- * message.el (message-yank-buffer): New command.
- (message-buffers): New function.
-
- * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Select
- next group in a more normal fasion.
-
- * mml.el (mml-boundary-function): New variable.
- (mml-compute-boundary): Use it.
-
- * nnmh.el (nnmh-active-number): Skip past files that have buffers
- that exist for them.
-
- * gnus-async.el (gnus-async-prefetch-next): Cancel timers.
- (gnus-async-timer): New variable.
-
-1999-11-30 02:07:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-list): Be more lenient with
- root addresses.
-
-1999-11-28 20:22:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Do
- gnus-treat-capitalize-sentences.
-
-1999-11-30 09:07:53 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-hotmail-article): Hotmail changes the
- format.
-
-1999-11-29 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-decode.el (mm-display-external): For `copiousoutput' methods,
- switch to buffer after calling program.
- (mm-display-external): Use `shell-command-switch' instead of "-c".
-
-1999-11-27 15:21:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-possibly-change-server): Don't always
- read groups file.
-
- * nnslashdot.el (nnslashdot-request-article): Convert <br><br> to
- <p>.
-
-1999-11-24 20:18:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Doc fix.
-
-1999-11-24 09:25:00 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-emphasize): Check group variable.
- * rfc1843.el (rfc1843-decode-article-body): Ditto.
-
-1999-11-24 00:11:27 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-save-part-to-file): Inhibit jka-compr for any
- type.
-
-1999-11-23 17:21:05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support www.netaddress.com, i.e. usa.net.
-
-1999-11-23 Hrvoje Niksic <hniksic@iskon.hr>
-
- * mml.el (mml-quote-region): Insert ! after the hash.
-
-1999-11-23 05:08:23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-warchive-address-history): Change to
- nil.
-
-1999-11-23 02:33:13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el: Support mail.yahoo.com.
-
- * mail-source.el (mail-source-fetch-webmail): Add password check.
- (mail-source-keyword-map): Use `subtype'.
-
-1999-11-22 04:35:43 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-keyword-map): Add webmail.
- (mail-source-fetcher-alist): Ditto.
- (mail-source-fetch-webmail): New function.
- * webmail.el: New file.
-
-1999-11-21 12:20:02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-request-group): Print 0 if it is nil.
-
-1999-11-21 12:19:11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcap): Don't skip double semicolon.
-
-1999-11-20 12:54:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-request-list): Add fetch-time slot.
- (nnultimate-prune-days): New function.
- (nnultimate-create-mapping): Use it.
- (nnultimate-request-group): Only fetch the groups list if it has
- not been done before.
- (nnultimate-retrieve-headers): Don't write groups.
- (nnultimate-create-mapping): Off-by-one error.
-
-1999-11-19 12:17:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-sane-retrieve-headers): Fix to match
- threaded subjects.
-
-1999-11-20 02:22:52 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: Lots of changes make agent happy.
-
-1999-11-19 21:37:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-get-unread-articles): Assert group is in
- hashtb.
-
-1999-11-19 19:53:08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Write region with binary
- mode.
-
-1999-11-18 14:52:05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-dejanews-create-mapping): Bind `text'.
-
-1999-11-18 14:35:01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Use fake charset `gnus-decoded'.
- (mm-uu-test): Now it is in restricted region.
-
- * gnus-art.el (article-decode-charset): Don't mm-uu-test.
-
- * mm-view.el (mm-view-message): Fix buffer leak.
- (mm-inline-message): Support 'gnus-decoded.
-
- * mm-bodies.el (mm-decode-body): Ditto.
-
- * rfc2047.el (rfc2047-decode-region): Ditto.
-
-1999-11-18 Matthias Andree <ma@dt.e-technik.uni-dortmund.de>
-
- * imap.el (require): Added autoload for base64-encode-string.
-
-1999-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-refer-article-method): Made list value
- customizable.
-
-1999-11-17 13:09:37 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-recenter): set-window-start with
- NOFORCE in Emacs case.
-
-1999-11-17 13:04:01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-request-article-this-buffer): Set
- gnus-newsgroup-name.
-
-1999-11-16 23:53:22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-summary-recenter): set-window-start with
- NOFORCE.
-
-1999-11-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Check server before
- scanning.
-
-1999-11-16 10:01:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-valid-select-methods): nnslashdot is news.
-
- * nnslashdot.el (nnslashdot-login-name): New variable.
- (nnslashdot-password): Ditto.
- (nnslashdot-request-post): New function.
-
- * gnus-art.el (gnus-treat-buttonize): More testing.
-
- * mm-encode.el: Another CVS test.
-
- * gnus-art.el (gnus-treat-emphasize): Change default.
- (gnus-treat-buttonize): Ditto.
- (gnus-treat-buttonize): This is a test.
-
- * gnus-sum.el (gnus-build-old-threads): Bind mail-parse-charset.
- (gnus-build-sparse-threads): Ditto.
- (gnus-build-all-threads): Ditto.
-
- * nnheader.el (make-full-mail-header): Make into a subst.
-
- * dgnushack.el (dgnushack-compile): Skip all w3-dependent files
- unless w3 is supplied.
-
- * gnus.el (gnus-refer-article-method): Doc fix.
-
- * gnus-sum.el: Do not accept a prefix.
- (gnus-summary-refer-article): Accept a list of select methods.
-
-1999-11-15 21:28:40 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Change `^ *' to `\t'.
-
-1999-11-11 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-forward): Pay attention to prefix argument
- again and forward all headers when it is set, regardless of the
- value of message-forward-ignored-headers.
-
-1999-11-15 20:44:50 William M. Perry <wmperry@aventail.com>
-
- * dgnushack.el (dgnushack-compile): Vpath file.
-
- * Makefile.in (SHELL): VPATH support.
-
-1999-11-15 20:37:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el: Check for cygwin32.
-
-1999-11-14 18:15:28 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Use 'non-viewer.
-
-1999-11-14 15:21:06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * base64.el (base64-encode-string): An alias for base64-encode for
- compatibility.
-
-1999-11-14 01:58:18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-groups): Erase nntp-sever-buffer before
- nntp-inhibit-erase.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-get-unread-articles): Use
- nnfoo-retrieve-groups to find new news, if available.
- (gnus-read-active-file-2): New function.
- (gnus-get-unread-articles): Use it.
- (gnus-read-active-file-1): Ditto.
-
-1999-11-13 17:59:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-mime-charset-region): Make sure
- find-coding-systems-for-charsets is fbound.
-
- * gnus-ems.el: Typo fix.
-
-1999-11-13 Florian Weimer <fw@s.netic.de>
-
- * mm-util.el (mm-find-mime-charset-region): Use UTF-8 if
- it's available and makes sense.
-
-1999-11-12 19:56:23 Fabrice POPINEAU <Fabrice.Popineau@supelec.fr>
-
- * gnus-score.el (gnus-score-save): Translate score file.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * mail-source.el (mail-source-keyword-map): For IMAP mail source,
- added fetchflag and dontexpunge keywords.
- (mail-source-fetch-imap): Use them.
-
-1999-11-12 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-start.el (gnus-level-subscribed, gnus-level-unsubscribed,
- gnus-level-zombie, gnus-level-killed): Changed from `defcustom' to
- `defconst'.
-
- * gnus-cus.el (gnus-group-parameters): Changed from `defcustom' to
- `defconst'.
- Mention that it is both for group and topic parameters.
- (gnus-extra-topic-parameters): New constant, including `subscribe'
- parameter.
- (gnus-extra-group-parameters): New constant.
- (gnus-group-customize): Use them.
-
- * gnus.el (gnus-select-method): Added default value and tag.
- (gnus-refer-article-method): Added `DejaNews' customization option.
-
-1999-11-12 05:04:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-int.el (gnus-server-opened): Ignore denied servers.
-
- * gnus-ems.el (gnus-mule-max-width-function): New backquote
- syntax.
-
- * nndoc.el (nndoc-mime-digest-type-p): Reinstated.
-
- * nnslashdot.el (nnslashdot-group-number): Changed default.
-
- * nnweb.el (nnweb-dejanews-create-mapping): Work with new deja.
- (nnweb-dejanews-wash-article): Removed.
- (nnweb-type-definition): Fetch by id.
-
- * gnus-msg.el (gnus-configure-posting-styles): Don't insert unless
- we mean it.
-
- * nnslashdot.el (nnslashdot-group-number): Doc fix.
- (nnslashdot-request-list): Use Ultramode as well.
- (nnslashdot-date-to-date): Be more lenient.
- (nnslashdot-threaded): New function.
-
-1999-11-11 17:40:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-internalize-part): Doc fix.
-
-1999-11-11 14:32:48 Steinar Bang <sb@metis.no>
-
- * nnweb.el (nnweb-type-definition): /=dnc
-
-1999-11-11 10:58:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Work with american
- dates.
- (nnultimate-retrieve-headers): Wrong ordering.
-
-1999-11-11 07:31:51 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-forward-as-mime): New variable.
-
-1999-11-11 05:24:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-dd-mmm): Beware buggy dates.
-
-1999-11-10 16:50:01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-movemail-and-remove): New function.
- (mail-source-keyword-map): Add `function' for `maildir'.
- (mail-source-fetch-maildir): Use it.
-
-1999-11-10 13:48:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el: New file.
- * gnus-group.el (gnus-group-make-warchive-group): New function.
- * gnus.el (gnus-valid-select-methods): Add `nnwarchive'.
-
-1999-11-10 12:13:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Work for multi-page
- subjects.
-
-1999-11-10 11:33:23 Rajappa Iyer <rajappa@mindspring.com>
-
- * gnus-salt.el (gnus-pick-article-or-thread): Don't move point.
-
-1999-11-10 05:22:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-open-server): Do address.
- (nnultimate-forum-table-p): New function.
-
- * nnweb.el (nnweb-insert-html): Renamed.
- (nnweb-insert): New function.
-
- * nnultimate.el (nnultimate-insert-html): New function.
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Don't do anything
- if nov is evil.
- (nnslashdot-retrieve-headers): use the sane version instead.
-
-1999-11-09 00:13:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-article): Fold case.
-
- * nnultimate.el: New file.
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Skip the article
- unless wanted.
-
- * gnus-start.el (gnus-active-to-gnus-format): Catch errors.
- (gnus-read-active-file-1): Separated into own function.
- (gnus-read-active-file): Catch quits.
-
- * nnslashdot.el (nnslashdot-request-article): Search better on
- first article.
- (nnslashdot-request-list): Fold case.
- (nnslashdot-retrieve-headers): Ditto.
-
-1999-11-08 05:33:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Autoload gnus-subscribe-topics.
-
-1999-11-07 22:56:46 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-save-group-info): Remove backslash
- before dot.
- * gnus-util.el (gnus-write-active-file): Ditto.
-
-1999-11-07 22:31:10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-replace-duplicate-chars-in-string): New
- function.
- * gnus-cache.el (gnus-cache-file-name): Use it.
- * gnus-agent.el (gnus-agent-group-path): Use it.
- * nnmail.el (nnmail-group-pathname): Use it.
-
-1999-11-07 21:07:55 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-active-to-gnus-format): Don't insert backslash
- if cooked.
- * gnus-util.el (gnus-write-active-file): Write cooked active file.
- * gnus-agent.el (gnus-agent-save-group-info): Ditto.
- * gnus.el (gnus-short-group-name): "..." proof.
-
-1999-11-07 20:03:16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Keep using `read' to
- support nnslashdot.
-
-1999-11-08 00:06:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-retrieve-headers): Don't fetch too
- many articles.
- (nnslashdot-generate-active): New function.
- (nnslashdot-request-newgroups): Use it.
-
- * gnus-start.el (gnus-active-to-gnus-format): Intern strings group
- names.
-
- * nnslashdot.el (nnslashdot-request-newgroups): New function.
- (nnslashdot-request-list): Not moderated.
-
-1999-11-07 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el (nnimap-open-server): Remove error signal if
- nnimap-server-buffer is nil (the check should've been `boundp').
-
- * imap.el (imap-log):
- * nnimap.el (nnimap-debug): Disable debugging by default.
-
-1999-11-07 01:17:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-subscribe-newsgroup-method): Doc fix.
-
- * gnus-topic.el (gnus-subscribe-topic): New function.
-
- * nnslashdot.el (nnslashdot-request-list): Give out extended group
- names.
-
- * gnus-start.el (gnus-ignored-newsgroups): Disregard bogus chars
- if starting with a quote.
-
-1999-11-07 13:06:11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Support backslash in
- group name.
-
-1999-11-07 01:17:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el: New file.
-
- * nnheader.el (nnheader-insert-header): New function.
-
- * gnus-art.el (gnus-mime-internalize-part): Bind
- mm-inlined-types.
-
- * nndraft.el (nndraft-request-expire-articles): Do all the backup
- files.
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * smiley.el (gnus-smiley-display): Use `smiley-toggle-buffer'.
- (smiley-toggle-buffer): New function.
- (smiley-buffer): Don't quote the function.
- (smiley-toggle-extents): Ditto.
-
-1999-11-07 01:00:32 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-goto-missing-topic): Work even in
- empty buffers.
-
-1999-11-06 23:16:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-map): Use the summary article
- edit.
-
-1999-11-06 22:56:49 Jens-Ulrik Petersen <Jens-Ulrik.Petersen@nokia.com>
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Doc fix.
-
-1999-11-06 21:40:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-uu.el (gnus-uu-mark-thread): Don't move point around.
-
-1999-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-predicate): Examine whether the argument
- is list or not before condition.
-
-1999-10-07 Yoshiki Hayashi <t90553@mail.ecc.u-tokyo.ac.jp>
-
- * gnus-art.el (gnus-treat-predicate): Work for (typep "something").
-
-1999-11-06 19:18:14 Kevin the Bandicoot <user42@zip.com.au>
-
- * gnus-art.el (gnus-emphasis-alist): New value.
-
-1999-11-06 13:57:13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use both `read' and
- `buffer-substring'.
-
-1999-11-06 04:24:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-date-ut): Keep the updated timer.
- (gnus-emphasis-underline-italic): Doc fix.
-
- * gnus-msg.el (gnus-post-method): Doc fix.
- (gnus-post-method): Change default.
-
-1999-11-06 04:12:13 Francisco Solsona <flsc@hp.fciencias.unam.mx>
-
- * message.el (message-newline-and-reformat): Improvements.
-
-1999-11-06 03:51:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-newline-and-reformat): Don't insert too many
- newlines.
- (message-newline-and-reformat): Work even if not sc.
-
- * mm-view.el (mm-inline-message): Insert a delimiter at the end.
-
- * mm-decode.el (mm-inline-media-tests): Only if diff mode.
-
-1999-11-06 03:48:02 Toby Speight <Toby.Speight@streapadair.freeserve.co.uk>
-
- * mm-view.el (mm-display-patch-inline): New function.
-
-1999-11-06 03:47:54 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mm-view.el (mm-display-patch-inline): New function.
-
-1999-11-06 02:17:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-read-move-group-name): Subscribe to the
- group.
-
- * message.el (message-forward): Narrow to the right header.
-
- * gnus-sum.el (gnus-summary-limit-to-age): Protect against bogus
- dates.
-
- * gnus-msg.el (gnus-configure-posting-styles): Use the
- user-full-name function.
-
- * mm-bodies.el (mm-body-encoding): Use the choosing function.
- (mm-body-charset-encoding-alist): Default to nil.
-
- * message.el (message-elide-ellipsis): Fix typo.
- (message-elide-region): Ditto.
- (message-elide-region): Don't insert a newline first.
-
-1999-11-05 20:28:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-cut-thread): Also cut for numberp
- gnus-fetch-old-headers.
- (gnus-cut-threads): Ditto.
- (gnus-summary-initial-limit): Ditto.
- (gnus-summary-limit-children): Ditto.
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow `header'
- matches.
-
-1999-11-06 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (article-decode-encoded-words):
- (gnus-mime-display-single): Don't assume gnus-summary-buffer is
- live.
-
- * gnus.el (gnus-read-method): Add methods from
- `gnus-opened-servers' to completion. Map entered method/address
- into existing methods if possible.
-
- * gnus-group.el (gnus-group-make-group): Simplify method.
-
- * gnus-srvr.el (gnus-browse-unsubscribe-group): Simplify method.
-
- * mml.el (mml-preview): Remove mail-header-separator before
- encoding.
-
-1999-11-05 20:28:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-read-from-minibuffer): New function.
-
-Fri Nov 5 19:10:02 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.98 is released.
-
-1999-11-05 01:27:49 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire): Remove bad line in NOV.
-
-1999-11-04 22:20:35 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Read attached binary file in
- binary mode.
-
-1999-11-03 16:08:56 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-toggle-header): Fix arg bug.
-
-1999-11-03 15:27:38 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-viewer-lessp): Fix bug.
-
-1999-11-02 17:28:33 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-search-article): Fix loop search bug.
-
-1999-10-31 21:24:59 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-mime-match-handle-first): New function.
- (gnus-article-mime-match-handle-function): New variable.
- (gnus-article-view-part): Make `b' customizable.
-
-1999-10-29 14:30:07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-article-get-xrefs): Test eobp.
-
-1999-09-27 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-attachment-override-types): Exclude text/plain.
-
-1999-10-26 23:27:44 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-buffer): CTE may come without CTL.
-
-1999-10-26 21:44:05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use
- `buffer-substring' instead of `read'.
-
-1999-10-23 Simon Josefsson <jas@pdc.kth.se>
-
- * nnimap.el, imap.el, rfc2104.el: New files.
-
- * gnus.el (gnus-valid-select-methods): Add nnimap.
-
- * gnus-group.el (gnus-group-group-map): Add
- gnus-group-nnimap-edit-acl, gnus-group-nnimap-expunge.
- (gnus-group-nnimap-expunge): New function.
- (gnus-group-nnimap-edit-acl): New function.
-
- * gnus-agent.el (gnus-agent-group-mode-map): Add
- gnus-agent-synchronize.
- (gnus-agent-synchronize): New function.
- (gnus-agent-fetch-group-1): Check if server is open.
-
- * nnagent.el (nnagent-request-set-mark): Save marks.
-
- * mail-source.el (mail-source-keyword-map): New imap mail-source.
- (mail-source-fetcher-alist): Map to imap fetcher function.
- (mail-source-fetch-imap): New function.
-
- * gnus-art.el (article-hide-pgp): Hide all headers, not just
- Hash:.
-
-1999-10-22 11:03:00 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-sort-topics-1): New function.
- (gnus-topic-sort-topics): New function.
- (gnus-topic-make-menu-bar): Add sort-topics.
- (gnus-topic-move): New function.
- (gnus-topic-move-group): Move the topic if no group selected.
-
-1999-10-13 21:31:50 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-setup-buffer): Fix buffer leak.
-
-1999-10-13 12:52:18 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Fix leaving group bug.
-
-1999-10-07 17:59:49 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-post-method): Use normal method if current is
- not available.
-
-1999-10-07 17:09:34 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-insert-xref): Dealing with empty articles.
- (nnmail-insert-lines): Ditto.
-
-1999-10-07 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-insert-newsgroup-line): Insert a blank
- line.
-
- * message.el (message-unsent-separator): One more separator.
-
-1999-10-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-move-article): For empty article,
- search till (point-max).
- (nnfolder-retrieve-headers): Ditto.
- (nnfolder-request-accept-article): Ditto.
- (nnfolder-save-mail): Ditto.
- (nnfolder-insert-newsgroup-line): Ditto.
-
-1999-10-05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Check eobp.
-
-1999-10-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-headers-with-xover): Fix hanging problem.
-
-1999-10-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-send-xover-command): Wait for nothing if not
- wait-for-reply.
-
-1999-09-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-begin-line): Change the regexp.
- (mm-uu-forward-end-line): Ditto.
-
-1999-09-29 Didier Verna <verna@inf.enst.fr>
-
- * binhex.el (binhex-decode-region): don't consider the value of
- `enable-multibyte-characters' in XEmacs.
-
- * gnus-start.el (gnus-read-descriptions-file): ditto.
-
- * mm-util.el (mm-multibyte-p): ditto.
- (mm-with-unibyte-buffer): ditto.
- (mm-find-charset-region): use `mm-multibyte-p'.
-
- * mm-bodies.el (mm-decode-body): ditto.
- (mm-decode-string): ditto.
-
- * lpath.el ((string-match "XEmacs" emacs-version)): Don't define
- `enable-multibyte-characters' in XEmacs.
-
-1999-09-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-binary-coding-system): Try binary first.
-
-1999-09-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc1843.el (rfc1843-decode-article-body): Don't decode twice.
-
-1999-09-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-make-date-line): Add time-zone in iso8601
- format.
- (article-date-ut): Find correct insert position.
-
-1999-09-03 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Do not dissect quoted-printable
- forwarded message.
-
-1999-09-27 20:33:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-find-groups): Work for unactivated
- groups.
-
- * message.el (message-resend): Use message mode when prompting.
-
- * gnus-art.el (article-hide-headers): Mark wash.
- (article-emphasize): Ditto.
-
-1999-09-27 19:52:14 Vladimir Volovich <vvv@vvv.vsu.ru>
-
- * message.el (message-newline-and-reformat): Work for SC.
-
-1999-09-27 19:38:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): 2047 in de.*.
-
- * gnus-sum.el (gnus-newsgroup-ignored-charsets): Add x-unknown.
-
-1999-10-20 David S. Goldberg <dsg@mitre.org>
-
- * mm-decode.el mm-inline-override-types: New variable
-
- * mm-decode.el (mm-inline-override-p): New function
-
- * mm-decode.el (mm-inlined-p): Use it
-
-1999-10-20 David S. Goldberg <dsg@mitre.org>
-
- * mm-decode.el mm-inline-override-types: New variable
-
- * mm-decode.el (mm-inline-override-p): New function
-
- * mm-decode.el (mm-inlined-p): Use it
-
-Mon Sep 27 15:18:05 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.97 is released.
-
-1999-09-01 Brendan Kehoe <brendan@zen.org>
-
- * gnus-sum.el (gnus-summary-catchup-and-goto-next-group): Use
- gnus-summary-next-group, not gnus-summary-next-article. Only give
- 3 args.
-
-1999-09-25 08:07:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Look in the group
- buffer for params.
-
- * gnus-xmas.el (gnus-xmas-summary-recenter): Display one more
- line.
-
- * message.el (message-forward-ignored-headers): New variable.
-
- * gnus-art.el (gnus-article-prepare-display): Nix out
- gnus-article-wash-types.
-
- * gnus-agent.el (gnus-agent-create-buffer): New function.
- (gnus-agent-fetch-group-1): Use it.
- (gnus-agent-start-fetch): Ditto.
-
- * gnus-sum.el (gnus-summary-exit): Don't use
- `gnus-use-adaptive-scoring'.
-
- * mail-source.el (mail-source-fetch-pop): Only store password when
- successful.
-
- * gnus-nocem.el (gnus-nocem-scan-groups): Message better.
-
-1999-09-24 18:43:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-reply): Use it.
- (message-dont-reply-to-names): New variable.
-
- * nntp.el (nntp-open-telnet): Don't erase-buffer.
-
- * mm-util.el (mm-preferred-coding-system): Typo fix.
-
- * message.el (message-bounce): Work for non-MIME.
-
- * gnus.el (gnus-short-group-name): Short the right parts of the
- name.
-
-1999-09-24 18:17:48 Johan Kullstam <kullstam@ne.mediaone.net>
-
- * mm-encode.el (mm-qp-or-base64): New version.
-
-1999-09-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-make-date-line): Fix time-zone bug.
-
-1999-09-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-add-buttons): Don't delete markers out
- of restricted region.
- (gnus-mime-display-single): Set beg at correct point.
-
-1999-09-09 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-process-maildir-mail-format): Typo.
-
-1999-09-09 Jens-Ulrik Petersen <jens-ulrik.petersen@nokia.com>
-
- * gnus-msg.el (gnus-configure-posting-styles): Let
- `gnus-posting-styles' have its say in posting-style: local
- variable `styles' is already bound to `gnus-posting-styles' so
- don't rebind it to nil.
-
-1999-09-24 18:10:56 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus-score.el (gnus-summary-increase-score): Allow editing of
- Message-ID.
-
-1999-09-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-encode.el (mm-encode-content-transfer-encoding): Fold
- quoted-printable-encode-region.
-
- * qp.el (quoted-printable-encode-region): Assume charset
- encoded. Fold every line in the region.
-
-1999-09-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Read the first line
- of active file.
-
-1999-09-01 Didier Verna <verna@inf.enst.fr>
-
- * message.el (message-mode): allows whitespaces between multiple
- instances of the fill character ">".
-
-1999-09-24 18:02:50 Kim-Minh Kaplan <kmkaplan@vocatex.fr>
-
- * mm-encode.el (mm-qp-or-base64): Fix.
-
-1999-09-01 12:18:01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-send): Too much and.
-
-1999-09-24 17:58:07 Andreas Schwab <schwab@suse.de>
-
- * gnus-art.el (gnus-mime-view-part-as-type): Renamed.
-
-1999-08-28 12:44:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-headers): Work for nil scores.
-
-1999-08-27 20:46:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cache.el (gnus-cache-write-active): Write full names.
-
- * gnus-util.el (gnus-write-active-file): Accept full name.
-
- * mm-decode.el (mm-inlinable-p): Use string-match on the types.
- (mm-assoc-string-match): New function.
- (mm-display-inline): Use it.
-
- * gnus-group.el (gnus-group-set-info): Work for nil group params.
-
- * gnus-msg.el (gnus-configure-posting-styles): Allow eval.
-
-1999-08-27 19:08:10 Florian Weimer <fw@s.netic.de>
-
- * mml.el (mml-generate-multipart-alist): New variable.
-
-1999-08-27 15:30:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-predicate): Work for (not 5).
-
-1999-08-27 Peter von der Ahe <pahe@daimi.au.dk>
-
- * message.el (message-send): More helpful error message if sending
- fails
-
-1999-09-06 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus-score.el (gnus-summary-increase-score): "Lars" was broken
- in newer emacsen, where ?r isn't equal 114.
-
-Fri Aug 27 13:17:48 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.96 is released.
-
-1999-08-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-groups-to-gnus-format): Only use agent
- to get active info if method is covered by agent, otherwise
- active info is lost.
-
-1999-08-17 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-move-article): Report backend errors.
-
-1999-08-09 Dave Love <fx@gnu.org>
-
- * mm-util.el: Use `defalias', not `fset' for dummy functions.
-
-1999-08-09 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (gnus-ignored-headers): Remove "X-Pgp-*"
- (already matched by "^X-Pgp"), removed duplicate
- X-Mailing-List, added several new junk headers.
-
-1999-08-01 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-art.el (article-decode-charset): Don't assume
- gnus-summary-buffer is live.
-
-1999-08-27 15:07:43 Paul Flinders <paul@dawa.demon.co.uk>
-
- * smiley.el (smiley-deformed-regexp-alist): Fix % smileys.
-
-1999-08-27 15:02:58 Florian Weimer <fw@s.netic.de>
-
- * gnus-score.el (gnus-home-score-file): Work with absolute path
- names.
-
-1999-07-17 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-articles-to-read): Return cached articles if
- nothing else in the group.
-
-1999-07-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-bcklg.el (gnus-backlog-enter-article): Check the size of
- the article.
-
-1999-07-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Fix for base64 message.
-
-1999-07-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-end-line): Support forwarded message
- from mutt.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Delete
- whitespace.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-text-coding-system-for-write): New variable.
- (mm-append-to-file): New function.
- (mm-write-region): New function.
-
- * gnus-art.el (gnus-output-to-file): Use it.
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
- * gnus-uu.el (gnus-uu-binhex-article): Ditto.
-
-1999-07-14 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-find-file): Use mm-auto-mode-alist.
-
- * nnheader.el (nnheader-insert-file-contents): Revert and use
- mm-insert-file-contents.
- (nnheader-find-file-noselect): Use mm-auto-mode-alist.
- (nnheader-auto-mode-alist): Removed.
-
- * mm-util.el (mm-inhibit-file-name-handlers): New variable.
- (mm-insert-file-contents): Add a new parameter for inserting
- compressed file literally.
-
- * mml.el (mml-generate-mime-1): Insert non-text literally.
-
- * gnus.el: Change most mm-insert-file-contents back to nnheader.
-
-1999-07-13 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-unbuttonized-mime-types): Fix docstring.
-
-1999-08-27 14:53:42 Oleg S. Tihonov <ost@benetnash.ffke-campus.mipt.ru>
-
- * gnus-sum.el (gnus-group-charset-alist): Default fido7 to
- koi8-r.
-
-1999-07-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-mime): Decode text.
- (mml-to-mime): Narrow to headers-or-head.
-
-1999-07-11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Check
- w3-meta-content-type-charset-regexp.
-
-1999-07-10 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Search topics for
- predicate.
-
-1999-07-10 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlspl.el: Documentation fixes.
-
-1999-08-27 14:42:14 Rui Zhu <sprache@iname.com>
-
- * gnus-sum.el (gnus-summary-limit-to-age): Prompt better.
-
-1999-08-27 14:40:52 Michael Cook <cook@sightpath.com>
-
- * gnus-art.el (gnus-article-setup-buffer): Kill all local
- variables.
-
-1999-08-27 14:39:34 Hrvoje Niksic <hniksic@srce.hr>
-
- * nnmail.el (nnmail-get-new-mail): "Done".
-
-1999-08-27 14:38:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-kill-all-zombies): Only prompt when
- interactive.
-
-1999-07-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-charset): Fix broken CT.
-
-1999-07-12 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Recreate agent
- overview buffer if it is killed.
-
-1999-08-27 14:26:03 Eric Marsden <emarsden@mail.dotcom.fr>
-
- * gnus-art.el (article-babel): New version.
-
-1999-08-27 14:22:39 Jon Kv <jonkv@ida.liu.se>
-
- * nnfolder.el (nnfolder-request-list-newsgroups): Faster expiry.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (More Threading): Document new variable
- `gnus-sort-gathered-threads-function'.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (More Threading): Document new variable
- `gnus-sort-gathered-threads-function'.
-
-1999-07-11 Andreas Jaeger <aj@arthur.rhein-neckar.de>
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Delete file after
- usage.
-
-1999-07-10 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-running-xemacs): Removed.
- (mm-coding-system-p): New function.
- (mm-binary-coding-system): Safe guess.
- (mm-text-coding-system): Ditto.
- (mm-auto-save-coding-system): Ditto.
-
-1999-07-11 11:02:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-qp-or-base64): Also consider control chars.
- (mm-qp-or-base64): Reversed logic.
-
- * mm-decode.el (mm-save-part-to-file): Let coding system be
- binary.
-
-1999-07-15 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Allow 'agent-score' to
- be set in topic parameters.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-sum.el (gnus-sort-gathered-threads-function): New variable.
- (gnus-sort-gathered-threads): Allow the user to specify the
- function to use when sorting gathered threads.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Don't
- mark cached articles as `undownloaded'.
-
-Tue Jul 20 02:39:56 1999 Peter von der Ahe <peter@ahe.dk>
-
- * gnus-sum.el (gnus-summary-exit): Allow gnus-use-adaptive-scoring
- to have buffer local values.
-
-1999-07-25 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-group.el (gnus-group-make-doc-group): Notice when user
- types 'g' for 'guess group type.
-
-1999-07-30 Simon Josefsson <jas@pdc.kth.se>
-
- * nnmail.el (nnmail-remove-list-identifiers): Remove whitespace
- after each regexp in nnmail-list-identifiers, not just after last
- one.
-
- * gnus-sum.el (gnus-list-identifiers): New variable.
- (gnus-summary-remove-list-identifiers): New function.
- (gnus-select-newsgroup): Use it.
- (gnus-summary-wash-hide-map): Bind
- `gnus-article-hide-list-identifiers' to W W l.
- (gnus-summary-make-menu-bar): Add list-identifiers command.
-
- * gnus-art.el (gnus-treat-strip-list-identifiers): New variable.
- (gnus-treatment-function-alist): Add variable.
- (article-hide-list-identifiers): New function.
- (mapcar): Add function.
- (gnus-article-hide): Use it.
-
-Fri Jul 9 22:21:16 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.95 is released.
-
-1999-07-09 21:46:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-mailcap-command): New function.
- (mm-display-external): Use it.
-
- * gnus-art.el (article-make-date-line): Work for India.
-
- * mm-encode.el (mm-qp-or-base64): Typo.
-
- * gnus-topic.el (gnus-topic-goto-topic): Made into command.
-
-Fri Jul 9 19:28:29 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.94 is released.
-
-1999-07-09 21:19:23 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * pop3.el: New version.
-
-1999-07-09 20:01:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-qp-or-base64): New function.
- (mm-content-transfer-encoding): Use it.
-
- * gnus-util.el (gnus-parse-netrc): Allow quoted names.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Fix typo and use 'non-viewer.
-
- * mailcap.el (mailcap-mailcap-entry-passes-test): Add needsterminal.
-
-1999-07-09 18:52:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-part-as-media): New command and
- keystroke.
-
- * mailcap.el (mailcap-mime-types): New function.
-
- * nnmh.el (nnmh-request-group): Update nnmh-group-alist.
-
- * message.el (message-goto-eoh): Really go to the end.
-
-1999-07-09 18:40:23 Puneet Goel <puneet@computer.org>
-
- * message.el (message-make-date): Do the right thing in with
- sub-hour time zones.
-
-1999-07-09 18:36:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-make-menu-bar): Removed double bug
- report.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-rename-group): Create directory.
-
-1999-07-08 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-parse-mailcap): Skip \;.
- (mailcap-parse-mailcap-extras): Fix "nonterminal;" and empty name,
- and use t as default value.
-
-Wed Jul 7 18:40:30 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Don't assume
- gnus-summary-buffer is live.
-
-1999-07-09 17:44:03 Robert Pluim <rpluim@nortelnetworks.com>
-
- * mm-util.el (mm-enable-multibyte): Check whether var bound.
-
-1999-07-09 17:31:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-bounce): Do MIME bounces MIMEy.
-
- * gnus-sum.el (gnus-summary-read-group-1): Update mark positions.
-
-1999-07-08 08:41:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-extensions): Changed patch to
- text/x-patch.
-
- * mm-decode.el (mm-display-external): Wrong placement of paren.
-
-Wed Jul 7 13:09:51 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.93 is released.
-
-1999-07-08 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-cus.el (gnus-group-parameters): New entries for
- gnus-group-split.
-
- * gnus-mlspl.el: Renamed functions and variables so as to
- start with gnus-group-split.
- * gnus.el: Adjust autoload entries.
-
-1999-07-07 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlspl.el: Removed trailing t from comment and provide.
- Renamed functions and variables to start with gnus-mlsplit.
- Added autoload comments.
- * gnus.el: Added autoload entries.
-
-1999-07-06 05:37:46 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * nnmail.el (nnmail-split-it): Search the regexp multiple times,
- so that matches excluded by RESTRICTs do not cause the whole split
- to be ignored. This also fixes a long-standing bug in which a
- split with \N substitutions wouldn't cause cross-posting as
- expected.
-
- * nnmail.el (nnmail-split-fancy): Document RESTRICT clauses.
- (nnmail-split-it): Implement them.
-
- * nnmail.el (nnmail-split-fancy): Document ! splits.
-
-1999-07-07 10:41:11 Stainless Steel Rat <ratinox@peorth.gweep.net>
-
- * pop3.el: New version.
-
-1999-07-05 Simon Josefsson
-
- * gnus-srvr.el (gnus-browse-foreign-server): Use read.
-
-1999-07-07 10:37:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-alternative): Do treatment.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-write-active-file): Use real name.
-
- * gnus-agent.el (gnus-agent-expire): Update active file
- method by method.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-article): Use difference
- coding-systems for queue and drafts.
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Special-case
- nndraft:drafts.
-
- * mm-util.el (mm-auto-save-coding-system): New coding system.
-
- * message.el (message-draft-coding-system): Use it.
-
-1999-07-06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el: More customizable and less aggressive.
-
-1999-07-07 07:53:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-groups-to-gnus-format): Only gnus-active
- when plugged.
-
- * mml.el (mml-generate-mime-1): Don't insert nofile files.
- (mml-insert-mml-markup): Accept a nofile.
- (mml-insert-mime): Insert nofile.
-
- * gnus-art.el (gnus-treat-strip-blank-lines): Removed.
-
- * mm-decode.el (mm-handle-media-type): New function.
- (mm-handle-media-supertype): New function.
- (mm-handle-media-subtype): New function.
- Use new functions throughout. "/"))
-
-1999-05-18 03:03:50 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-predicate): Typo.
-
-1999-07-07 06:21:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-summary-score-entry): Made un-interactive.
-
-1999-07-06 17:57:16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-date-ut): UT! Default it!
-
-Tue Jul 6 10:59:24 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.92 is released.
-
-1999-07-06 12:30:59 Johannes Weinert <Johannes.Weinert@Informatik.Uni-Oldenburg.DE>
-
- * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix.
-
-1999-07-06 07:41:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-retrieve-groups): Don't do anything when not
- connected.
-
- * gnus-start.el (gnus-active-to-gnus-format): Only save active
- when plugged.
-
- * mm-view.el (mm-inline-message): Ignore remove-spec.
-
- * gnus-agent.el (gnus-agent-write-active): Check whether orig sym
- is bound.
-
- * gnus-msg.el (gnus-summary-mail-forward): Rename From_ lines.
-
- * nndoc.el (nndoc-guess-type): Remove blank lines at the start.
-
- * nnfolder.el (nnfolder-read-folder): Remove blank lines at the
- start.
-
- * message.el (message-fill-yanked-message): Remove `t' arg.
-
- * gnus-group.el (gnus-group-kill-group): Message killing of
- groups.
-
- * mm-util.el (mm-preferred-coding-system): New function.
- (mm-mime-charset): Use it.
-
- * mml.el (mml-generate-mime-1): Charset-encode message parts.
-
-1999-07-06 07:03:31 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus-mlsplt.el: New file.
-
-1999-07-06 05:47:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-Media-tests): Changed from forms to
- functions.
- (mm-attachment-override-p): Take a handle instead of a type.
- (mm-inlined-p): Ditto.
- (mm-automatic-display-p): Ditto,
- (mm-inlinable-p): Ditto.
-
- * nndraft.el (nndraft-request-expire-articles): Delete backup
- files.
-
- * mailcap.el (mailcap-parse-mailcap): Regexp-quote stuff.
-
- * gnus-sum.el (gnus-summary-limit-to-extra): Typo.
-
-1999-07-06 05:37:46 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * nnmail.el (nnmail-split-it): Allow .*.
-
-1999-07-05 05:04:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-large-images-p): Renamed.
-
- * gnus-art.el (article-date-ut): Always look in the current buffer
- for the Date header.
-
- * mml.el (mml-validate): New command.
-
- * mailcap.el (mailcap-possible-viewers): Revert to string-match
- since we are dealing with regexps.
-
-Sun Jul 4 06:31:01 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.91 is released.
-
-1999-07-04 04:35:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-save-active-1): New function.
- (gnus-agent-save-active): use it.
- (gnus-agent-save-groups): Ditto.
-
- * gnus-cache.el (gnus-cache-write-active): Use it.
-
- * gnus-agent.el (gnus-agent-write-active): Use it.
-
- * gnus-util.el (gnus-write-active-file): New function.
-
- * gnus-agent.el (gnus-agent-write-active): New function to keep
- lower boundaries and canceled groups.
- (gnus-agent-save-groups): Use it.
- (gnus-agent-save-active): Use it.
- (gnus-agent-save-group-info): Only write active files.
- (gnus-agent-expire): Update active file.
-
- * mm-decode.el (mm-inlinable-part-p): Removed.
- (mm-user-display-methods): Default to nil.
- (mm-user-display-methods): Removed.
- (add-mime-display-method): Removed.
- (mm-automatic-display): Renamed.
- (mm-automatic-display-p): Use it.
- (mm-inlined-types): New variable.
- (mm-inlined-p): New function.
-
- * message.el (message-reply): Bind message-this-is-mail.
-
-1999-07-03 13:16:31 Michael Klingbeil <mklingbeil@knuut.de>
-
- * smiley.el (smiley-buffer): Fix for NT.
-
-1999-07-03 11:26:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el (mm-encode-buffer): Check whether we have 7bit.
-
- * message.el (message-check-news-header-syntax): Protect against
- nil froms.
-
- * mm-util.el (mm-auto-mode-alist): New.
-
- * mml.el (mml-generate-mime-1): Ditto.
-
- * gnus.el: Use mm-insert-file-contents throughout instead of
- nnheader.
-
- * mm-util.el (mm-insert-file-contents): New function.
-
-Sat Jul 3 07:35:35 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.90 is released.
-
-1999-07-03 09:31:10 Sven Fischer <herpes@kawo2.rwth-aachen.de>
-
- * mailcap.el (mailcap-possible-viewers): Use string=.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-forward-begin-line): New variable.
- (mm-uu-forward-end-line): New variable.
- (mm-uu-begin-line): Handle forwarded message.
- (mm-uu-identifier-alist): Ditto.
- (mm-uu-dissect): Ditto.
-
-1999-06-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Two free variables.
-
-1999-07-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-file-coding-system): Use raw-text.
- * gnus-agent.el (gnus-agent-file-coding-system): Ditto.
- * gnus-cache.el (gnus-cache-coding-system): Ditto.
-
- * nnfolder.el (nnfolder-file-coding-system): Use mm-text-coding-system.
- (nnfolder-file-coding-system-for-write): New variable.
- (nnfolder-active-file-coding-system): New variable.
- (nnfolder-active-file-coding-system-for-write): New variable.
- (nnfolder-save-active): New function.
- (nnfolder-save-buffer): Use them.
- (nnfolder-possibly-change-group): Ditto.
- (nnfolder-request-list-newsgroups): Ditto.
- (nnfolder-request-create-group): Ditto.
- (nnfolder-request-expire-articles): Ditto.
- (nnfolder-request-move-article): Ditto.
- (nnfolder-request-accept-article): Ditto.
- (nnfolder-request-delete-group): Ditto.
- (nnfolder-request-rename-group): Ditto.
- (nnfolder-possibly-change-folder): Ditto.
- (nnfolder-read-folder): Ditto.
- (nnfolder-request-list): Remove pathname-coding-system.
- (nnfolder-possibly-change-group): Use nnmail-pathname-coding-system.
-
- * nnmail.el (nnmail-file-coding-system): Use raw-text.
- (nnmail-file-coding-system-1): Removed.
- (nnmail-find-file): Use nnmail-pathname-coding-system.
- (nnmail-write-region): Ditto.
-
- * nnmbox.el (nnmbox-file-coding-system): New variable.
- (nnmbox-file-coding-system-for-write): New variable.
- (nnmbox-active-file-coding-system): New variable.
- (nnmbox-active-file-coding-system-for-write): New variable.
- (nnmbox-save-buffer): New function.
- (nnmbox-save-active): New function.
- (nnmbox-request-scan): Use them.
- (nnmbox-request-expire-articles): Ditto.
- (nnmbox-request-move-article): Ditto.
- (nnmbox-request-accept-article): Ditto.
- (nnmbox-request-replace-article): Ditto.
- (nnmbox-request-delete-group): Ditto.
- (nnmbox-request-rename-group): Ditto.
- (nnmbox-request-create-group): Ditto.
-
- * mm-util.el (mm-text-coding-system): raw-text or -dos.
- (mm-running-ntemacs): Removed.
-
- * nnml.el (nnml-file-coding-system): Use nnmail-file-coding-system.
-
-1999-07-02 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-read-folder): Use nnheader-file-coding-system.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encoding-characters): Support lower case.
-
-1999-07-01 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Fold before B-encoding.
- (rfc2047-b-encode-region): Encode line by line.
-
-1999-07-03 09:20:16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-mime-charset-region): Fix.
-
-1999-06-30 KOSEKI Yoshinori <kose@yk.NetLaputa.ne.jp>
-
- * mm-util.el (mm-mime-mule-charset-alist): Fix iso-2022-jp(-2) bug.
- (mm-find-mime-charset-region): Ditto.
-
-1999-07-03 09:15:35 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-move-article): Fix something or
- other.
-
-1999-06-29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-ephemeral-charset): New variable.
- (gnus-newsgroup-ephemeral-ignored-charsets): New variable.
- (gnus-summary-enter-digest-group): Use them.
- (gnus-summary-setup-default-charset): Ditto.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * base64.el (base64-run-command-on-region): Use unibyte buffer.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Fix bug when
- gnus-newsgroup-name is nil.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): Chop the tail newline.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-emphasize): Use correct
- gnus-article-emphasis-alist.
-
-1999-06-15 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Fix text/html bug.
-
-Mon Jun 28 17:54:01 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.89 is released.
-
-1999-06-24 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-file-coding-system-1): For NTEmacs in Windows.
- * message.el (message-draft-coding-system): Ditto.
- * mm-util.el (mm-running-ntemacs): Ditto.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-summary-recenter): A blank line may
- cause problem.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Ignore error in w3-region.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el: require mm-decode.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Treat as head only if necessary.
-
-1999-06-23 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-image): Fix image undisplayer.
-
-1999-06-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-multipart): Error in compeling-read.
- (mml-insert-tag): Match tags.
-
-1999-06-19 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-braid-nov): Fix coding-system bug.
- (gnus-cache-braid-heads): Ditto.
- (gnus-cache-retrieve-headers): Ditto.
-
-1999-06-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-send): Fix encoding bug.
-
-1999-06-16 10:17:29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-read-summary-keys): Convert key events
- to string under XEmacs.
-
-1999-06-28 19:34:03 Petersen Jens-Ulrik <jens-ulrik.petersen@nokia.com>
-
- * gnus-start.el (gnus-find-new-newsgroups): Doc fix.
-
-1999-06-22 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Fix message view bug.
- * gnus-art.el (gnus-article-prepare): Ditto.
-
-1999-06-16 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Fetch headers.
-
-Tue Jun 15 04:13:01 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.88 is released.
-
-1999-06-15 04:13:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-save-parts): Destroy handles after
- usage.
-
- * nnmail.el (nnmail-get-new-mail): Save info.
-
-Mon Jun 14 01:15:59 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.87 is released.
-
-1999-06-14 02:46:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-file): Use prescript-delay.
- (mail-source-run-script): New function.
- (mail-source-fetch-pop): Use it.
-
-1999-06-13 09:52:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-highlight-words): Moved here.
-
-Sun Jun 13 07:30:40 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.86 is released.
-
-1999-06-13 08:51:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-translate): New variable.
- (gnus-treat-predicate): Accept a list of regexps.
- (gnus-article-treat-custom): Allow a list of regexps.
-
-1999-06-09 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
-
- * gnus/gnus-group.el (gnus-permanently-visible-groups): Fix custom
- type.
-
-1999-06-13 05:15:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-babel): Narrow a bit.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Was too slow.
-
-1999-06-12 Simon Josefsson <jas@pdc.kth.se>
-
- (gnus-agent-get-undownloaded-list): Operate on all articles, not
- only unread ones.
- (gnus-agent-fetch-headers): Fetch headers from unread and marked
- articles, not only unread ones.
-
-1999-06-13 03:01:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-limit-to-extra): New command and
- keystroke.
-
- * gnus-art.el (gnus-article-x-face-command): Ditto.
-
- * gnus-uu.el (gnus-uu-default-view-rules): Default to "display".
-
- * gnus.el (gnus-method-simplify): Accept server names.
-
-1999-06-13 02:36:15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (article-babel-prompt): New function.
- (article-babel): New command.
-
-1999-06-13 01:01:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-part-wrapper): Go to part.
-
- * mml.el (mml-generate-mime-1): Don't insert literally.
-
- * gnus-util.el (gnus-parse-netrc): Skip lines with #'s.
- (gnus-netrc-syntax-table): Removed.
- (gnus-parse-netrc): Don't use syntax table; just use whitespace.
-
-Wed May 5 13:51:13 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Fix charset for text/html.
-
-Wed May 5 01:15:08 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Use emacs-mule-dos.
-
-1999-06-12 07:29:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-incoming): Return the number of split
- mails.
- (nnmail-process-babyl-mail-format): Ditto.
- (nnmail-process-unix-mail-format): Ditto.
- (nnmail-process-mmdf-mail-format): Ditto.
- (nnmail-process-maildir-mail-format): Ditto.
-
- * mail-source.el (mail-source-callback): Return the number from
- the callback.
-
- * message.el (message-send-mail): Generate Lines.
-
- * mail-source.el (mail-source-call-script): New function.
- (mail-source-call-script): New function.
-
-Sun May 2 02:00:27 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-setup-highlight-words): New function.
- (gnus-select-newsgroup): Use it.
- (gnus-group-highlight-words-alist): New variable.
- (gnus-newsgroup-emphasis-alist): New variable.
- (gnus-summary-local-variables): Use it.
- * lpath.el: Use it.
- * gnus-art.el (article-emphasize): Use it.
- (gnus-emphasis-highlight-words): New face.
- * gnus-cus.el (gnus-group-parameters): New parameter.
-
-Sun May 2 01:00:02 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Remove
- parameter `headers'.
- (gnus-cache-enter-article): Ditto.
- (gnus-cache-update-article): Ditto.
- * gnus-sum.el (gnus-summary-move-article): Ditto.
- (gnus-summary-mark-article-as-unread): Ditto.
- (gnus-summary-mark-article): Ditto.
-
-1999-06-12 03:59:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-message-insert-stylings): Removed.
- (gnus-posting-style-alist): Removed.
- (gnus-message-style-insertions): Ditto.
- (gnus-configure-posting-styles): Reimplementation.
-
- * mail-source.el (mail-source-fetch): Error the message.
-
- * gnus-msg.el (gnus-inews-do-gcc): Do mml and encoding.
-
-Sat Jun 12 00:19:57 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.85 is released.
-
-1999-04-20 Michael Cook <cook@sightpath.com>
-
- * gnus-cite.el (gnus-cite-attribution-prefix): Tweak for MS
- Outlook citation regex.
-
-1999-06-12 02:09:49 Lars Magne Ingebrigtsen <pinard@iro.umontreal.ca>
-
- * nndoc.el (nndoc-mime-parts-type-p): Accept space before
- semicolon.
-
-1999-05-24 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Document range1
- modification, protect range2.
-
-1999-05-24 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Protect lists from
- gnus-remove-from-range, don't sort twice.
-
-1999-05-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-start.el (gnus-read-descriptions-file): Protect if no
- function in backend.
-
-1999-05-15 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-valid-move-group-p): Check for a
- request-accept-article function in the backend instead of using
- the 'respool capability.
-
-1999-04-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Handle
- spurious whitespace at eob.
-
-1999-06-12 02:02:06 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * nnmail.el (nnmail-get-new-mail): Check right variable.
-
-1999-06-12 01:57:39 Karl Kleinpaste <karl@justresearch.com>
-
- * mailcap.el (mailcap-mime-data): Fix rfc822.
-
-1999-06-11 23:48:50 TOZAWA Akihiko <miles@is.s.u-tokyo.ac.jp>
-
- * nndoc.el (nndoc-nsmail-type-p): New function.
- (nndoc-type-alist): Recognize nsmail.
-
-1999-05-12 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-art.el (gnus-treatment-function-alist): Display `x-face'
- *before* `article-hide-headers' deletes the information.
-
-1999-05-22 00:26:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-save-parts): New command and
- keystroke.
- (gnus-summary-save-parts-1): New function.
- (gnus-summary-iterate): Buggy.
-
- * mm-decode.el (mm-save-part-to-file): Made into own function.
-
-1999-05-11 05:53:16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-set-info): Resist nils.
-
-1999-05-04 19:26:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Ditto.
-
- * gnus-uu.el (gnus-uu-default-view-rules): Ditto.
-
- * gnus-art.el (gnus-article-x-face-command): Default to ee.
-
-1999-05-02 Gareth Jones <gdj1@gdjones.demon.co.uk>
-
- * gnus-art.el (article-make-date-line): Put X-Sent below Date if
- gnus-article-date-lapsed-new-header is t.
-
-Sat May 1 20:27:43 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.84 is released.
-
-1999-05-01 22:23:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-bug-message): Mime change.
-
-1999-04-22 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Process null mark lists.
-
-1999-04-21 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Recognize
- `x-uue'.
-
-1999-03-04 Aaron M. Ucko <amu@mit.edu>
-
- * mail-source.el (mail-source-fetch-pop): Only prompt for password
- when authentication is 'password.
-
-1999-05-01 22:17:55 <pinard@iro.umontreal.ca>
-
- * gnus-win.el (gnus-configure-windows): Accept a setting.
-
-1999-04-21 20:51:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-quote-arg): Moved here.
-
- * mm-decode.el (mm-quote-arg): Quote more chars.
-
-1999-04-18 20:12:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-parse-head): Message-ID in In-Reply-To
- with newlines would create buggy .nov files.
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): Default to nil.
-
- * qp.el (quoted-printable-encode-region): Encode whitespace at the
- end of lines.
-
- * message.el (message-mode): Doc fix.
-
- * gnus-art.el (article-hide-headers): Delete the hidden headers.
-
- * gnus-msg.el (gnus-setup-posting-charset): Default group to "".
-
- * gnus-art.el (article-date-ut): Rewrite.
-
- * mm-decode.el (mm-preferred-alternative-precedence): Reverse the
- order.
-
- * gnus-msg.el (gnus-message-insert-stylings): Remove duplicate
- headers.
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): Doc fix.
-
-1999-04-18 Didier Verna <verna@inf.enst.fr>
-
- * gnus-art.el (gnus-article-date-lapsed-new-header): new variable.
- (article-date-ut): use it.
-
-1999-04-18 20:06:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Call script
- asynchronously.
-
-Sun Apr 18 12:40:04 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.83 is released.
-
-1999-04-18 10:55:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-draft-mode): Use mml minor mode.
-
- * gnus-cite.el (gnus-dissect-cited-text): Off-by-one error.
-
- * gnus-uu.el (gnus-uu-mark-thread): Save hidden threads.
-
- * gnus-art.el (gnus-mime-inline-part): Don't do a charset param.
-
- * gnus-msg.el (gnus-bug): Use application/x-emacs-lisp.
-
- * message.el (message-generate-headers): Accept continuation
- headers.
-
-1999-04-18 10:48:57 Renaud Rioboo <Renaud.Rioboo@lip6.fr>
-
- * gnus-demon.el (gnus-demon-time-to-step): Not strings.
-
-1999-04-18 08:21:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): use
- maybe-hide-headers.
-
- * message.el (message-inhibit-body-encoding): Typo.
- (message-resend): Inhibit encoding.
-
- * gnus-sum.el (gnus-summary-toggle-header): Decode rfc2047.
-
- * gnus-art.el (article-remove-cr): Use re-search.
-
- * rfc2231.el (rfc2231-parse-string): Allow broken elm MIME
- headers.
-
- * mm-decode.el (mm-quote-arg): Quote '.
-
- * gnus-ems.el (gnus-x-splash): Would place splash wrongly.
-
- * mm-decode.el (mm-insert-part): Use multibyte for text.
-
- * gnus-start.el (gnus-read-newsrc-file): New variable.
- (gnus-read-newsrc-file): Use it.
-
-1999-04-17 18:51:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnvirtual.el (nnvirtual-request-expire-articles): New function.
-
- * gnus-group.el (gnus-group-expire-articles-1): Made into own
- function.
-
-Sat Apr 17 16:41:30 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.82 is released.
-
-1999-04-15 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-sum.el (gnus-group-charset-alist): Include Croatian groups
- for iso8859-2.
-
-1999-04-17 18:23:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-charset-synonym-alist): Remove iso-2022-jp-2 from
- synonym alist.
-
-1999-04-17 18:03:38 Adam P. Jenkins <ajenkins@netway.com>
-
- * gnus-sum.el (gnus-summary-local-variables): Mark as global.
-
-1999-04-17 18:02:05 Ettore Perazzoli <ettore@comm2000.it>
-
- * mail-source.el (mail-source-fetch): Ask before bugging out.
-
-1999-03-19 Hrvoje Niksic <hniksic@srce.hr>
-
- * uudecode.el (uudecode-decode-region-external): Don't assume
- uudecode-temporary-file-directory ends with a slash.
-
-1999-03-18 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks):
- (gnus-update-read-articles):
- (gnus-summary-expire-articles): Check server.
-
-1999-03-16 Simon Josefsson <jas@pdc.kth.se>
-
- * mml.el (mml-preview): New function.
-
-1999-04-17 17:10:21 William M. Perry <wmperry@aventail.com>
-
- * mail-source.el (mail-source-fetch-file): Return the right
- value.
-
-1999-04-17 07:52:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-parameter): New function.
- (mml-insert-parameter-string): New function.
-
- * nnmail.el (nnmail-get-new-mail): Say how many new articles.
-
- * gnus-art.el (gnus-mime-multipart-functions): New variable.
- (gnus-mime-display-part): Use it.
-
- * mm-decode.el (mm-alternative-precedence): Removed.
- (mm-discouraged-alternatives): New variable.
- (mm-preferred-alternative-precedence): New function.
-
- * nnmail.el (nnmail-get-new-mail): Use mail-sources.
-
- * mail-source.el (mail-sources): New variable.
-
- * gnus-art.el (article-remove-cr): Remove several trailing CRs.
-
- * mm-decode.el (mm-valid-image-format-p): New function.
- (mm-inline-media-tests): Use it.
- (mm-valid-and-fit-image-p): New function.
-
- * gnus-agent.el (gnus-agent-fetch-groups): Error when unplugged.
- (gnus-agent-fetch-group): Ditto.
-
-1999-04-12 Didier Verna <verna@inf.enst.fr>
-
- * nnmail.el (nnmail-article-group): in case of a group name
- containing "\\n" constructs, be sure to pass the expanded value to
- nn*-save-mail.
-
-Sat Apr 17 05:40:45 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.81 is released.
-
-1999-04-16 15:54:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-split-value): Reverse result.
-
-1999-04-03 00:17:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-always-read-dribble-file): Doc fix.
-
-1999-04-02 15:33:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-tag): Insert concluding part.
-
- * message.el (message-send-mail): Encode later.
- (message-send-news): Ditto.
-
- * nnfolder.el: Don't use mail delim.
-
-1999-03-28 19:14:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cus.el (gnus-group-customize): Put point at min.
-
- * mm-view.el (mm-inline-text): Allow toggling html.
-
-1999-03-28 17:11:15 William M. Perry <wmperry@aventail.com>
-
- * mail-source.el: Added prescript and postscript to file.
-
-1999-03-28 13:46:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el: Reverted.
-
- * gnus-msg.el (gnus-setup-posting-charset): Didn't work.
- (gnus-setup-posting-charset): Did work.
-
-1999-03-28 13:19:50 Jae-you Chung <jay@pllab.kaist.ac.kr>
-
- * gnus.el (gnus-short-group-name): Use
- gnus-group-uncollapsed-levels.
-
-1999-03-28 13:11:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-dissect-cited-text): Don't remove overlays.
-
-1999-03-26 13:18:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-strip-headers-in-body): New variable.
- (article-strip-headers-from-body): New command and keystroke.
-
-1999-03-14 16:09:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Check for symbol first.
-
- * nnheader.el (nnheader-insert-file-contents): Bind
- enable-local-eval to nil.
- (nnheader-find-file-noselect): Ditto.
-
- * nnmail.el (nnmail-article-group): Don't remove long lines.
- (nnmail-remove-long-lines): New function.
- (nnmail-split-header-length-limit): Removed.
-
- * mml.el (mml-generate-mime-1): Use unibyte buffers.
-
- * gnus-group.el (gnus-group-kill-all-zombies): Query user.
-
-1999-03-06 07:20:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-generic-mark): New function.
-
- * nnmail.el (nnmail-split-header-length-limit): Increased.
- (nnmail-article-group): Allow nil.
-
- * gnus-cite.el (gnus-cite-parse-wrapper): Inhibit point-motion.
-
- * nndoc.el (nndoc-generate-mime-parts-head): Insert real headers
- first.
-
- * mml.el (mml-minibuffer-read-type): Include types from
- mailcap-mime-data.
-
- * nndraft.el (nndraft-request-article): Would clobber Japanese.
-
-1999-03-05 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-insert-tag): New function.
- (mml-read-file): Renamed to mml-minibuffer-read-file to avoid
- confusion with functions like `mml-read-tag'.
- (mml-read-type): Ditto with `mml-minibuffer-read-type'.
- (mml-minibuffer-read-description): Ditto with
- `mml-minibuffer-read-description'.
- (mml-attach-buffer): New function.
- (mml-mode-map): New entry for /.
- (mml-minibuffer-read-type): Accept DEFAULT.
-
- * mml.el (mml-quote-region): Narrow the region.
-
- * message.el (message-mode-menu): message-mime-attach-file is now
- mml-attach-file.
-
-1999-03-05 21:24:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Do emphasis earlier.
-
-1999-03-05 21:08:10 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * mml.el (mml-attach-buffer): New command.
-
-1999-02-27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-marks): Call gnus-remove-from-range
- with a proper range. Compress range.
-
- * gnus-range.el (gnus-remove-from-range): Protect arguments.
-
-1999-03-05 20:59:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-get-image): Create a temporary file for xbms.
-
-1999-03-04 04:20:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-x-face-file-name): Removed.
- (gnus-picons-convert-x-face): Removed.
- (gnus-picons-article-display-x-face): Removed.
- (gnus-picons-x-face-sentinel): Ditto.
- (gnus-picons-display-x-face): Ditto.
-
-Thu Mar 4 01:38:00 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.80 is released.
-
-1999-03-02 16:04:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mm-display-part): Narrow to the part itself.
-
- * gnus-sum.el (gnus-with-article): Moved here.
-
- * mail-source.el (mail-source-fetch-pop): Ask for password even
- when program.
-
-1999-02-28 13:16:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-bug): Add description.
-
- * mml.el (mml-insert-mml-markup): Insert disposition.
-
- * message.el (message-send-mail): Always encode mail headers.
-
- * smiley.el (gnus-smiley-display): Goto body.
-
-1999-02-28 13:15:47 Petr Konecny <pekon@informatics.muni.cz>
-
- * smiley.el (gnus-smiley-display): Don't search to blank line.
-
-1999-02-28 00:38:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-article): Only run the highlight stuff
- when requested.
-
- * nnmail.el (nnmail-current-spool): Removed.
-
- * gnus-salt.el (gnus-tree-inhibit): New varible.
-
- * gnus.el (mm-util): Required.
-
-1999-02-27 23:44:52 paul stevenson <spaul@mail.phy.ornl.gov>
-
- * gnus-sum.el (gnus-summary-toggle-header): Narrow to head first.
-
-1999-02-27 17:17:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-bind): Doc fix.
-
-1999-02-26 20:35:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Doc fix.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Use 8bit
- encoding.
-
- * gnus.el (gnus-methods-equal-p): Moved here.
-
- * mail-source.el: pop at 110.
-
- * pop3.el (pop3-movemail): Use write-region instead of
- append-to-file to avoid excessive messaging.
-
-1999-02-27 lantz moore <lmoore@contigo.com>
-
- * nnmail.el (nnmail-get-new-mail): honor suffix for spool-files of
- type directory.
-
-1999-03-04 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus-art.el (article-hide-boring-headers): Field names must not
- contain whitespace.
-
-Fri Feb 26 18:54:16 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.79 is released.
-
-1999-02-26 18:11:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-cite-toggle): Don't remove highlighting.
-
- * mml.el (mml-mode): Don't use add-minor-mode.
-
- * message.el (messgage-inhibit-body-encoding): New variable.
- (message-encode-message-body): Use it.
-
-Fri Feb 26 17:00:25 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.78 is released.
-
-1999-02-26 07:45:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode): Switch on MML mode.
-
- * mml.el: Included commands and functions.
- (mml-mode-map): New keymap.
-
- * message.el: Removed the insertion commands and functions.
-
- * gnus-ems.el (gnus-mule-cite-add-face): Removed.
-
- * gnus-sum.el (gnus-summary-sort-by-chars): New command and
- keystroke.
-
- * gnus-art.el (gnus-narrow-to-page): Revert.
-
- * gnus-cite.el (gnus-cite-delete-overlays): New function.
- (gnus-cite-parse-maybe): Always reparse.
-
- * message.el (message-encode-message-body): Don't insert
- "multipart warning".
-
- * gnus-art.el (gnus-article-treat-head-custom): New variable.
-
-1999-02-25 Miles Bader <miles@ccs.mt.nec.co.jp>
-
- * mail-source.el (mail-source-fetch-pop): Return 1 for success.
-
- * nnmail.el: Require mm-util.
-
-1999-02-26 07:39:33 Justin Sheehy <justin@linus.mitre.org>
-
- * nnmail.el (nnmail-get-new-mail): Only get mail for the one
- group.
-
-1999-02-26 07:38:08 SeokChan LEE <chan@smoky-blue.com>
-
- * mm-bodies.el (mm-body-charset-encoding-alist): Add euc-kr.
-
-1999-02-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-msg.el (gnus-extended-version): Better regexp.
-
-1999-02-25 Didier Verna <verna@inf.enst.fr>
-
- * nnmail.el (nnmail-split-it): new syntax: `(! FUNC SPLIT)'. FUNC
- is called with the result of SPLIT and should return a new split.
-
- * gnus.texi: update the doc.
-
-1999-02-23 Didier Verna <verna@inf.enst.fr>
-
- * gnus-picon.el (gnus-picons-display-bar-p): when picons are
- displayed in the article buffer, output bars if
- `gnus-picons-display-article-move-p'.
-
-1999-02-20 Aaron M. Ucko <amu@mit.edu>
-
- * mail-source.el (mail-source-fetch-pop): Typo.
-
-1999-02-26 07:15:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-toggle-header): Save restriction.
-
-1999-02-23 03:07:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-cite-parse-wrapper): Always parse.
-
-1999-02-21 11:11:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-buffer): New function.
-
- * message.el (message-forward): Insert the buffer in the buffer.
-
-Sun Feb 21 01:20:50 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-message): Insert part in narrowed region.
-
-Sat Feb 20 23:09:40 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-toggle-header): Save restriction.
-
-Sat Feb 20 21:34:28 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.77 is released.
-
-1999-02-20 17:32:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-displaying-mime): New variable.
- (article-narrow-to-head): New function.
-
- * mail-source.el (mail-source-fetch-pop): Include pre/postscript.
- Default to pop instead of pop3.
-
-1999-02-19 16:16:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-hide-pgp): Goto body.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Don't kill buffer.
-
- * gnus-cite.el: Don't use goto-line.
-
- * gnus-art.el (gnus-article-treat-html): Removed.
- (gnus-treat-article): Save restriction.
-
-1999-02-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-send-mail): Don't untabify.
- (message-mode): Don't use tabs for indentation.
-
-1999-02-19 14:54:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Don't untabify.
-
- * nnml.el (nnml-save-mail): Typo fix.
-
-1999-02-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-cite-function): Add
- `message-cite-original-without-signature' customization option.
-
-1999-02-18 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): Mark as option to
- `nnmail-prepare-incoming-header-hook'.
-
-1999-02-19 14:41:43 Justin Sheehy <justin@linus.mitre.org>
-
- * gnus-util.el (gnus-make-sort-function-1): Typo fix.
-
-1999-02-19 14:40:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-get-new-news): Require nnmail.
-
-1999-02-18 Michael Cook <cook@sightpath.com>
-
- * Recognize Microsoft Outlook's cite attribution conventions.
-
-1999-02-19 14:33:11 James H. Cloos, Jr. <cloos@jhcloos.com>
-
- * gnus-sum.el: Bind M.
-
-1999-02-19 14:31:29 Neil Crellin <neilc@wallaby.cc>
-
- * mail-source.el (mail-source-fetch-pop): Bind pop3-port.
-
-1999-02-15 Didier Verna <verna@inf.enst.fr>
-
- * gnus-picon.el (gnus-group-display-picons): ensures that
- `article-goto-body' really goes to the article body.
-
-1999-02-19 12:57:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind url-standalone-mode.
-
- * gnus-msg.el (gnus-summary-mail-forward): Create unique names.
-
- * mm-view.el (mm-view-message): Enable multibyte.
-
-1999-02-11 18:37:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-get-new-mail): Message later.
-
- * mm-util.el (mm-find-charset-region): Revert to checking
- multibyte.
-
-1999-02-11 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-msg.el (gnus-bug): Encode environment info as a MIME
- attachment.
-
-Thu Feb 11 04:58:51 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.76 is released.
-
-1999-02-06 Felix Lee <flee@cygnus.com>
-
- * gnus.el (gnus-group-change-level-function): Typo.
-
-1999-02-11 05:47:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-nov-skip-field): Removed.
- (gnus-nov-field): Ditto.
- (gnus-nov-parse-extra): Ditto.
- (gnus-nov-read-integer): Ditto.
-
-1999-02-05 09:44:20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-nov-read-message-id): New macro.
- (nnheader-parse-nov): Use it.
-
- * gnus-sum.el (gnus-nov-read-message-id): New macro.
- (gnus-nov-parse-line): Use it; use `(eobp)' instead of
- `(eq (char-after) ?\n)'.
-
-1999-02-11 05:16:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-other-frame): Always pop up a new frame.
-
-Wed Feb 10 01:03:43 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-range.el (gnus-range-add): Rewrite.
-
-1999-02-02 18:12:00 Carsten Leonhardt <leo@arioch.oche.de>
-
- * nnmail.el (nnmail-split-incoming): Added detection of maildir
- format.
- (nnmail-process-maildir-mail-format): New function.
-
- * mail-source.el (mail-source-fetch-maildir): New function.
- (mail-source-keyword-map): Add default for maildir method.
- (mail-source-fetcher-alist): Changed "qmail" to "maildir".
-
-1999-02-10 02:29:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetcher-alist): Remove apop.
-
- * nndoc.el (nndoc-type-alist): Remove MIME-digest.
- (nndoc-mime-digest-type-p): Removed.
-
-1999-02-09 15:25:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-read-summary-keys): Set the point
- where it is supposed to be.
- (gnus-treat-play-sounds): New variable.
-
- * gnus-sum.el (gnus-newsgroup-ignored-charsets): New variable.
-
- * gnus-art.el (article-display-x-face): Narrow to head.
- (gnus-article-washed-types): New variable.
- (article-hide-pgp): Is not a toggle.
- (gnus-article-hide-text-type): Save types.
- (article-decode-charset): Use it.
-
- * nnmail.el (nnmail-get-new-mail): Ignore procmail.
-
- * message.el (message-forward-start-separator): Removed.
- (message-forward-end-separator): Removed.
- (message-signature-before-forwarded-message): Removed.
- (message-included-forward-headers): Removed.
- (message-check-news-body-syntax): Don't check forward.
- (message-forward): Use MIME.
-
- * nnvirtual.el (nnvirtual-request-article): Bind
- gnus-article-decode-hook to nil.
-
-1999-02-06 16:55:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): Check for
- us-ascii.
-
-1999-02-04 00:00:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * format-spec.el (format-spec): Be more robust.
-
- * message.el (message-encode-message-body): Default
- mail-parse-charset to mail-parse-charset.
-
- * gnus-sum.el (gnus-summary-edit-article-done): Don't encode.
- (gnus-summary-edit-article): Bind mail-parse-charset.
-
- * mml.el (mml-read-tag): Ignore white space after end of tag.
-
- * message.el (message-goto-body): Also work in separatorless
- articles.
-
- * mml.el (mml-translate-from-mime): New function.
- (mml-insert-mime): Ditto.
- (mml-to-mime): New function.
- (mime-to-mml): New name.
-
- * gnus-sum.el (gnus-summary-edit-article): Always select raw
- article.
-
- * gnus-group.el (gnus-group-catchup-current): Unmark groups.
-
- * gnus-sum.el (gnus-summary-setup-default-charset): Don't
- special-case nndraft groups.
-
-1999-02-03 16:44:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Bind charset.
- (gnus-get-newsgroup-headers): Already bound.
-
- * message.el (message-encode-message-body): Use posting charset.
-
- * mm-bodies.el (mm-encode-body): Use MIME charsets.
- (mm-body-encoding): Do CTE.
- (mm-body-7-or-8): New function.
-
- * mm-util.el (mm-mime-charset): Always fall back on alist.
- (mm-mime-mule-charset-alist): Include katakana-jisx0201.
- (mm-mime-mule-charset-alist): Add arabic-*-column.
- (mm-find-mime-charset-region): New function.
-
- * format-spec.el (format-spec-make): New function.
-
- * mail-source.el (format-spec): Required.
- (mail-source-fetch-with-program): Removed.
- (mail-source-fetch-with-program): New function.
-
- * format-spec.el: New file.
-
-1999-02-03 16:00:41 Tatsuya Ichikawa <ichikawa@hv.epson.co.jp>
-
- * mail-source.el (mail-source-fetch-with-program): Take optional
- parameter.
-
-1999-02-03 00:31:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el: Ignore some groups.
- (gnus-setup-news): Bind nnmail-fetched-sources.
-
- * message.el (message-send-mail): Remove all tabs.
-
- * mm-util.el (mm-find-charset-region): Just check whether
- find-charset-region is defined.
-
-1999-02-02 23:35:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-get-new-news): Use
- nnmail-fetched-sources.
-
- * nnmail.el (nnmail-fetched-sources): New variable.
- (nnmail-get-new-mail): Use it.
-
- * mail-source.el (mail-source-fetched-sources): New variable.
- (mail-source-fetch): Use it.
-
-1999-02-02 23:20:20 Mark W. Eichin <eichin@thok.org>
-
- * gnus.el (gnus-getenv-nntpserver): if the file that
- gnus-nntpserver-file names has a trailing newline, the
- string-match will always match, and thus the file will never be
- read. (^ matches start of "line", \\` matches start of "buffer",
- which is what was intended...)
-
-1999-02-02 23:17:40 Kim-Minh Kaplan <kmkaplan@western.fr>
-
- * gnus-picon.el (gnus-picons-parse-filenames): Quote group names.
-
-1999-01-28 04:15:46 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-read-active-file): Eliminate duplicated
- select methods.
-
-1999-01-27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Sort second argument.
-
-1999-02-02 10:55:23 Scott Hofmann <shofmann@mindspring.com>
-
- * nntp.el: Use mail-source-read-passwd instead of nnmail-read-passwd.
-
-Mon Feb 1 23:23:03 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-parameters): Charset as symbol, and fix
- a typo.
- * gnus-sum.el (gnus-summary-setup-default-charset): Set nndraft's
- charset to nil.
- * gnus-agent.el (gnus-agent-queue-setup): Remove charset setting.
- * gnus-start.el (gnus-start-draft-setup): Ditto.
-
-1999-02-02 22:13:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-directory): Use the predicate.
- (mail-source-value): Don't do variables.
-
- * nnmail.el (nnmail-get-new-mail): Set the predicate.
-
- * gnus-sum.el (gnus-summary-toggle-header): Fix, and bound to t.
-
-1999-02-01 Michael Cook <cook@sightpath.com>
-
- * Defenestrate spurious ?a.
-
-1999-02-02 21:59:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-pop): Instead use
- :authentication.
-
-1999-02-01 Tatsuya Ichikawa <t-ichi@po.shiojiri.ne.jp>
-
- * lisp/mail-source.el : Support APOP authentication scheme.
-
-1999-02-02 21:56:14 Tatsuya Ichikawa <t-ichi@niagara.shiojiri.ne.jp>
-
- * pop3.el (pop3-movemail): Return t.
-
-1999-02-02 21:48:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-fold-region): New function.
- (rfc2047-encode-message-header): Use it.
-
-1999-02-02 21:07:27 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * gnus-sum.el (gnus-group-charset-alist): Add more.
-
-Mon Feb 1 21:18:00 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.75 is released.
-
-1999-02-01 21:54:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-display-x-face): Don't narrow to head.
-
-1999-02-01 21:48:39 Michael Cook <cook@sightpath.com>
-
- * gnus-cite.el (gnus-cited-lines-visible): Accept a cons.
-
-1999-02-01 20:59:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-directory): Ignore
- directories.
-
- * gnus-cus.el (gnus-group-parameters): Addition.
-
- * gnus-art.el (article-strip-banner): Do symbolic banners.
- (article-strip-banner): New keystroke.
-
-1999-02-01 20:54:32 Michael Cook <cook@sightpath.com>
-
- * gnus-art.el (article-strip-banner): New command.
-
-1999-02-01 20:53:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-strip-banners): New variable.
-
-1999-01-28 05:34:56 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-read-passwd): Use `read-passwd' if it
- has been exist.
-
-Thu Jan 28 01:38:34 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Check coding-system.
- * mm-util.el (mm-text-coding-system): Ditto.
-
-1999-01-28 12:11:31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-fetch-pop): Save excursion.
-
-1999-01-28 08:14:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-movemail-args): Not constant.
- (mail-source-movemail-args): Removed.
- (mail-source-fetch-with-program): New function.
- (mail-source-fetch-pop): Use program and function.
- (mail-source-movemail-program): Removed.
-
- * gnus-art.el (gnus-treat-date-iso8601): New variable.
- (gnus-treat-date-user-defined): New variable.
-
-1999-01-28 08:07:12 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-fix-eudora-headers): New function.
-
-1999-01-28 08:05:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-encode-body): Use mail-parse-charset.
-
-1999-01-27 08:06:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * smiley.el (smiley-deformed-regexp-alist): Removed =>.
- (smiley-nosey-regexp-alist): Ditto.
-
- * gnus-art.el (gnus-treatment-function-alist): Do
- gnus-article-add-buttons-to-head later.
- (gnus-treat-capitalize-sentences): New variable.
- (article-capitalize-sentences): New command and keystroke.
-
- * gnus-group.el (gnus-group-catchup-current): Do group.
-
- * message.el (message-default-charset): Add group.
-
-Wed Jan 27 05:24:53 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.74 is released.
-
-1999-01-27 05:56:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-fill-long-lines): Renamed.
- (article-fill-long-lines): New keystroke.
-
-1999-01-26 06:35:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-setup-posting-charset): Check for group.
-
- * gnus-group.el (gnus-group-catchup-current): Skip groups now
- displayed.
- (gnus-group-catchup-current): Be more robus.
-
- * gnus-sum.el (gnus-summary-select-article): Reselect for showing
- headers.
-
-1999-01-25 Dave Love <fx@gnu.org>
-
- * message.el (message-mode-menu): Add message-mime-attach-file.
- (message-mode): Doc fix.
-
-1999-01-26 05:24:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-check-duplication): Insert the mail source
- string.
-
- * mail-source.el (mail-source-fetch-pop): Bind mail-source-string.
- (mail-source-fetch-directory): Ditto.
- (mail-source-fetch-file): Ditto.
- (mail-source-string): New variable.
-
- * gnus-start.el (gnus-get-unread-articles): Nix out groups over
- the level.
-
- * rfc2047.el (rfc2047-encodable-p): Convert to MIME charsets
- before handling.
-
- * mm-util.el (mm-mime-charset): Use the parameters.
- (mm-mime-charset): Removed region paremeters.
-
- * nnmail.el (nnmail-get-new-mail): Don't message the entire
- source.
-
-1999-01-25 12:05:16 Lloyd Zusman <ljz@asfast.com>
-
- * nnmail.el (nnmail-get-split-group): Quote right.
-
-1999-01-25 05:55:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-movemail): Would kill an arbitrary
- buffer.
-
-1999-01-24 03:02:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-clear-inboxes-moved): Removed.
- (gnus-group-mode): Don't hook.
-
- * mail-source.el (mail-source-bind): Doc fix.
- (mail-source-bind): Take only one param.
-
- * gnus-art.el (gnus-treat-highlight-signature): typep.
-
- * mail-source.el (mail-source-movemail): Ignore empty file.
- (mail-source-callback): Check before deleting.
-
- * message.el (message-mime-attach-file): Include name.
-
-1999-01-23 17:01:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-read-charset): Return a symbol.
-
- * mm-view.el (mm-inline-text): Insert signature separator.
-
- * gnus-art.el (gnus-treat-predicate): New function.
- (gnus-treat-article): Allow all types to be checked.
-
- * gnus-util.el (gnus-or): New function.
- (gnus-and): Ditto.
-
- * gnus-art.el (gnus-mime-display-single): Use override.
-
- * mm-decode.el (mm-attachment-override-types): New variable.
- (mm-attachment-override-p): New function.
-
- * gnus-picon.el (gnus-group-display-picons): Don't go backward.
-
-1999-01-23 16:45:06 Andrew J. Cosgriff <ajc@bing.wattle.id.au>
-
- * mm-view.el (mm-inline-text): Do vcards.
-
-Sat Jan 23 14:23:27 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.73 is released.
-
-1999-01-23 11:38:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-spool-file): Changed to use mail-source.
- (nnmail-crash-box, nnmail-use-procmail, nnmail-procmail-directory,
- nnmail-procmail-suffix, nnmail-resplit-incoming): Removed.
- (nnmail-movemail-program): Removed.
- (nnmail-movemail-args): Removed.
- (nnmail-pop-password-required): Ditto.
- (nnmail-tmp-directory): Ditto.
- (nnmail-delete-incoming): Removed.
- (nnmail-pop-password, nnmail-moved-inboxes,
- nnmail-internal-password, nnmail-move-inbox): Removed.
- (nnmail-read-passwd): Ditto.
- (nnmail-get-spool-files): Removed.
- (nnmail-resplit-incoming): Reinstated.
-
- * mail-source.el: New file.
-
-1999-01-23 09:08:31 James H. Cloos, Jr. <cloos@jhcloos.com>
-
- * gnus-art.el (gnus-article-mode-map): Bind backspace.
-
-1999-01-23 09:05:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-make-date-line): Fix iso8601 display.
-
-1999-01-20 02:53:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-display-smileys): Check xpm.
-
- * gnus-picon.el (gnus-group-display-picons): Goto body.
-
- * gnus.el: Indented all functions; broke long lines; changed all
- instances of illegal/legal to invalid/valid. Yes, I'm bored.
-
-Wed Jan 20 00:50:53 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.72 is released.
-
-1999-01-20 01:39:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Cleaned up trailing whitespace.
-
- * mm-util.el (mm-read-charset): Work.
-
-1999-01-17 Matt Armstrong <mattdav+matt@best.com>
-
- * gnus-score.el (gnus-score-find-bnews): Match regexp on the
- nnheader-translate-file-chars'd group name.
-
-1999-01-20 01:30:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Fold case.
-
-1999-01-20 01:28:16 Alexei V. Barantsev <barancev@ispras.ru>
-
- * gnus-xmas.el (gnus-xmas-modeline-glyph): Backquote.
-
-1999-01-20 00:46:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-add): New function.
-
-1999-01-18 09:40:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-goto-body-goes-to-point-min-p): New variable.
- (article-goto-body): Use it.
- (gnus-treat-article): Ditto.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Remove the
- downloaded articles from the downloadeble list.
-
-1999-01-16 17:31:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Bind
- mail-parse-charset.
-
- * mm-util.el (mm-charset-synonym-alist): New variable.
- (mm-charset-to-coding-system): Use it.
- (mm-charset-coding-system-alist): Removed.
- (mm-charset-to-coding-system): Don't use it.
- (mm-find-charset-region): Use mail-parse-charset.
-
- * gnus-art.el (gnus-treatment-function-alist): Use
- gnus-article-display-picons.
- (gnus-treat-display-xface): Only do if we have xface feature.
- (gnus-part-display-hook): New function.
- (gnus-treat-article): Use it.
- (gnus-treat-article): Use gnus-visual.
-
- * gnus-msg.el (gnus-setup-posting-charset): Check elem.
-
- * gnus-art.el (gnus-mm-display-part): Fix the MIME button after
- displaying.
-
- * mm-decode.el (mm-insert-part): Use insert-buffer-substring.
-
- * gnus-score.el (gnus-score-find-bnews): Protect against invalid
- regexp file names.
-
-Sat Jan 16 03:15:57 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.71 is released.
-
-1999-01-16 00:13:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-image): Don't add a dot.
-
- * gnus-art.el (gnus-treat-article): New function.
-
- * gnus.el (gnus-article-display-hook): Removed.
-
- * gnus-art.el (gnus-article-treat-custom): New variable.
-
- * gnus-start.el (gnus-ignored-newsgroups-has-to-p): Removed.
-
- * gnus-msg.el (gnus-setup-posting-charset): Allow variables and
- functions.
-
- * message.el (message-posting-charset): New variable.
- (message-send-mail): Use it.
-
- * gnus-msg.el (gnus-group-posting-charset-alist): Moved here.
- (gnus-setup-posting-charset): New function.
- (gnus-setup-message): Use it.
-
- * message.el (message-encode-message-body): Just look for
- Content-Type before inserting a new one.
-
-1999-01-15 23:08:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-default-charset): Removed.
-
- * mail-prsvr.el: New file.
- (mail-parse-charset): New variable.
-
- * gnus-sum.el (gnus-newsgroup-charset): Changed name.
- Changed name.
-
- * gnus.el (gnus-charset): New group.
-
- * nnmail.el (nnmail-pathname-coding-system): Default to binary.
-
- * gnus-sum.el (gnus-default-charset): Default to nil.
- (gnus-newsgroup-iso-8859-1-forced-regexp): Removed.
- (gnus-newsgroup-iso-8859-1-forced): Removed.
-
- * mm-util.el (mm-known-charsets): Removed.
- (mm-default-coding-system): Removed.
- (mm-default-charset): Removed.
- (mm-read-charset): New function.
-
- * message.el (message-default-charset): Removed.
-
- * rfc2047.el (rfc2047-default-charset): Default to nil.
-
- * mm-util.el (mm-charset-iso-8859-1-forced): Removed.
-
-Fri Jan 15 20:50:38 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.70 is released.
-
-1999-01-15 00:06:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-save-part): Use mm-get-part.
- (mm-insert-part): New function.
- (mm-get-part): Use it.
- (mm-get-image): Ditto.
- (mm-display-external): Ditto.
-
- * mm-view.el (mm-inline-text): Ditto.
-
- * gnus-move.el (gnus-move-group-to-server): Protect against nil
- ranges.
-
- * mm-decode.el (mm-display-external): Save the buffer.
- (mm-remove-part): Kill it.
-
- * qp.el (quoted-printable-decode-region): Do the right thing at eobp.
-
- * nnagent.el (nnagent-request-set-mark): Defined stub.
-
-1999-01-14 23:05:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-load-score-alist): Bind
- coding-system-for-read.
-
- * gnus-sum.el (gnus-summary-exit): Do adaptive scoring before
- prepare-exit-hook.
-
- * mm-view.el (mm-setup-w3): Require w3.
-
-1999-01-13 Kiyokazu SUTO <suto@merry.xmath.ous.ac.jp>
-
- * lisp/nnspool.el (nnspool-retrieve-headers): Protect against empty
- body.
-
-1999-01-14 21:17:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-encode.el: Ditto.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Message the
- error.
-
- * mailcap.el (mailcap-mime-data): SAFER ps.
-
- * message.el (message-encode-message-body): Always insert a
- Content-Type header.
-
- * mm-decode.el (mm-inline-media-tests): Default all text/* to be
- shown inline.
-
- * mm-view.el (mm-inline-text): Handle all sorts of text.
-
- * mailcap.el (mailcap-mime-data): non-viewer for viewers that
- don't view.
-
- * mm-decode.el (mm-display-external): Use it.
-
- * gnus-art.el (gnus-visible-headers): Added bcc, gcc, fcc.
-
- * mm-decode.el (mm-save-part): Removed double code.
-
-1999-01-12 Dave Love <fx@gnu.org>
-
- * mm-decode.el (mm-save-part): Avoid doubly-compressed
- application/octet-stream .gz & al files with jka-compr.
-
-1999-01-12 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-down-mouse-3): New variable.
- * gnus-art.el (gnus-mime-button-map): Use it.
- (gnus-mime-button-menu): Set the clicked-on buffer initially.
-
-1999-01-13 19:41:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Added ImageMagic and ee.
-
-1999-01-12 17:34:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-kill-buffer): Don't kill article
- buffers.
-
- * gnus-sum.el (gnus-summary-exit): Destroy all MIME.
-
- * gnus-cache.el (gnus-cache-read-active): Reversed check.
-
-1999-01-12 17:18:25 Matt Armstrong <matta@geoworks.com>
-
- * mml.el (mml-parameter-string): Strip directory component.
-
-1999-01-12 17:02:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-use-demon): Removed.
-
-1999-01-12 05:53:23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-article-group): Don't infloop.
-
-1999-01-11 Colin Rafferty <colin@xemacs.org>
-
- * gnus-art.el (article-update-date-lapsed): Made it work with
- picons, and make it update on all visible frames.
- (article-date-ut): Get summary-buffer's current-headers.
-
-1999-01-12 07:20:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Don't set major mode.
- (gnus-picons-setup-p): New variable.
-
-1999-01-11 02:13:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-header-length-limit): Lowered to 512.
-
-1999-01-04 12:58:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit-no-update): Don't use run-hooks.
- (gnus-summary-exit-no-update): Use mapcar.
-
-1999-01-02 14:36:32 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-category-write): Make directory.
-
-1998-09-26 19:39:31 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-read-articles):
- (gnus-update-marks): Request backend update of mark.
-
-1999-01-03 15:29:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-body-encoding): Use mm-find.
-
-1999-01-03 15:28:27 Kim-Minh Kaplan <kmkaplan@western.fr>
-
- * gnus-picon.el (gnus-article-display-picons): Fix.
-
-Sun Jan 3 13:32:02 1999 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.69 is released.
-
-1999-01-03 06:45:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Run the hook.
-
- * gnus-agent.el (gnus-agent-remove-group): New command and
- keystroke.
-
- * rfc2047.el (rfc2047-decode-region): Check for us-ascii.
-
-1999-01-02 14:12:41 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-agent.el (gnus-agent-write-servers): Make directory.
-
-1998-12-26 02:38:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind current id.
-
- * mm-decode.el (mm-handle-id): New macro.
- (mm-make-handle): Accept id.
- (mm-dissect-singlepart): Use it.
-
-1998-12-23 Matt Pharr <mmp@graphics.stanford.edu>
-
- * message.el (message-cite-original-without-signature): Use
- message-signature-separator when searching for signature in
- message-cite-original-without-signature.
-
-1998-12-24 16:25:38 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-server-to-method): Check named methods.
-
-1998-12-24 03:27:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): Goto point-min.
-
- * nnmail.el (nnmail-article-group): Don't delete lines, only
- shorten them.
-
- * gnus-msg.el (gnus-configure-posting-styles): Also do nil
- values.
-
- * nnheader.el (nnheader-temp-directory): New variable.
- (nnheader-temp-directory): Removed.
-
-1998-12-22 Jack Vinson <jvinson@chevax.ecs.umass.edu>
-
- * mailcap.el (mailcap-parse-mailcaps): Add "~/.mailcaps" to the
- list of files to check for mailcap entries under windows-nt.
-
-1998-12-24 03:02:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-maybe-hide-headers): Check whether the
- summary buffer exists.
-
-1998-12-22 Aaron M. Ucko <amu@mit.edu>
-
- * nnsoup.el (nnsoup-store-reply): Remove code to deal with
- irrelevant Sun sendmail bug.
- (nnsoup-store-reply): Stop mucking with mail-header-separator.
-
- * message.el (message-send-news): Bind mail-header-separator to
- "" when asking backend to post.
-
-1998-12-22 Karl Kleinpaste <karl@justresearch.com>
-
- * mm-uu.el (mm-dissect-disposition): New variable.
- (mm-uu-dissect): Use it.
-
-1998-12-21 21:34:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Bind url-current-object.
-
-1998-12-06 03:05:41 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Rewrite.
-
-1998-12-09 SL Baur <steve@altair.xemacs.org>
-
- * gnus-picon.el (annotations): Remove bogus require 'xpm.
-
-1998-12-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-encode-message-body): Insert `MIME-Version'
- instead of `Mime-Version'.
-
-1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-mime-part): Add the attachment
- disposition.
- (message-insert-mime-part): Make TYPE and DESCRIPTION optional.
- (message-mime-query-type): New function.
- (message-mime-query-description): Ditto.
- (message-mime-query-file): Ditto.
- (message-insert-mime-part): Use them.
- (message-mime-insert-external): Use the new stuff.
-
-1998-12-19 23:02:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-split-header-length-limit): New variable.
-
- * mm-decode.el (mm-dissect-buffer): Check syntax.
-
- * rfc2231.el (rfc2231-parse-string): Remove check for syntax.
-
- * rfc2047.el (rfc2047-encodable-p): Use mm-find-charset-region.
- (rfc2047-dissect-region): Ditto.
-
-1998-12-17 18:36:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): Decode charset.
-
-1998-12-16 16:01:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2231.el (rfc2231-parse-string): Ignore syntactically invalid
- CT headers.
-
-Wed Dec 16 01:44:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Use
- mm-uu-*-function.
- * mm-uu.el (mm-uu-dissect): Use x-uuencode.
-
-1998-12-16 10:20:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Do MML first.
- (message-send-news): Ditto.
-
-1998-12-15 20:57:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-face): New face.
- (gnus-picons-try-face): Use it.
-
-Tue Dec 15 19:17:43 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.68 is released.
-
-Tue Dec 15 18:28:24 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.67 is released.
-
-Tue Dec 15 17:31:44 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.66 is released.
-
-1998-12-13 11:00:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Decode description.
-
-Sat Dec 5 16:50:49 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-encoded-words): Rollback to 0.55.
- (gnus-decode-header-methods): Ditto.
- (gnus-decode-with-mail-decode-encoded-word-region): Ditto.
-
-1998-12-13 10:04:39 Lloyd Zusman <ljz@asfast.com>
-
- * gnus-xmas.el (gnus-xmas-summary-recenter): Allow numbers.
-
-1998-12-13 09:32:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-mime-headers): Encode description.
-
- * nnfolder.el (nnfolder-request-expire-articles): Go to the date
- line.
-
- * gnus-sum.el (gnus-default-charset): Doc fix.
-
-Wed Dec 9 15:18:39 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-part): Forward a line.
-
-Wed Dec 9 13:30:29 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-running-ntemacs): New variable.
- (mm-text-coding-system): Ditto.
- * nnmail.el (nnmail-incoming-coding-system): Ditto.
- (nnmail-split-incoming): Use nnmail-incoming-coding-system.
-
-1998-12-13 08:52:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-network-display-internal): Don't set
- buffer.
-
- * message.el (message-insert-headers): New command and keystroke.
-
-1998-12-07 23:42:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Recognize x-xbitmap.
- (mm-get-image): Ditto.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Only for
- base64, uudecode and binhex.
-
-Sun Dec 6 21:58:31 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF
- in text/plain.
- * mm-uu.el (mm-uu-dissect): Use inline.
-
-1998-12-07 23:19:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-view-message): New function.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Changed to
- qp.
-
-1998-12-07 Karl Kleinpaste <karl@justresearch.com>
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Add an
- entry for message/rfc822 as 8bit.
-
-1998-12-07 23:16:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-extensions): Add patch.
-
-1998-12-05 Dale Hagglund <rdh@best.com>
-
- * gnus-sum.el (gnus-summary-display-buttonized): Use prefix
- argument to force all multipart/* to look like multipart/mixed.
-
- * gnus-art.el (gnus-mime-display-multipart-as-mixed): New
- variable.
- (gnus-mime-display-part): Use it.
-
-1998-12-07 22:46:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-draft-send): Only disable checks for
- non-interactive use.
- (gnus-draft-send-message): Use it.
-
-Sun Dec 6 19:36:53 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.65 is released.
-
-1998-12-06 20:11:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-prepare-display): Don't init w3.
-
- * mm-view.el (mm-inline-text): Bind url-standalone-mode here.
-
-Sat Dec 5 18:35:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.64 is released.
-
-1998-12-05 18:51:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): Don't load.
-
- * gnus-msg.el (gnus-setup-message): Set group name.
- (gnus-group-mail): Avoid leaking local vars.
-
- * message.el (message-attach-file): Renamed.
- (message-mime-attach-file): Renamed again.
-
-1998-12-05 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (article-decode-encoded-words): Bind
- rfc2047-default-charset here.
-
- * gnus-art.el (gnus-insert-mime-button): Nix slashes in file name.
-
-1998-12-05 18:33:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-setup-buffer): Run picons hook.
- (gnus-picons-setup-hook): New hook.
-
-1998-12-05 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mailcap.el (mailcap-mime-data): Remove "*" from documentation
- string.
- (mailcap-mime-extensions): Ditto. Made first sentense fit a
- line.
-
-1998-12-05 17:11:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-prepare-display): Setup w3.
- (gnus-mime-view-part): Ditto.
- (gnus-mime-inline-part): Dotii.
- (gnus-mime-externalize-part): Daddo.
- (gnus-mime-internalize-part): Tutti frutti.
- (gnus-widget-press-button): Da da do.
-
- * mm-view.el (mm-setup-w3): Require url-vars.
-
-Fri Dec 4 12:13:12 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-draft-coding-system): Fix for XEmacs-NT.
- * mm-util.el (mm-find-charset-region): Ditto.
-
-1998-12-05 16:30:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send): Don't encode here.
- (message-send-mail): But here.
- (message-send-news): And here.
-
-1998-12-04 15:29:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-message-insert-stylings): Don't insert twice.
-
-Fri Dec 4 04:09:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.63 is released.
-
-1998-12-04 04:59:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-base-boundary): Shorten.
-
- * message.el (message-insert-mime-part): Use default.
-
- * gnus-art.el (gnus-insert-mime-button): Bind gnus-tmp-type-long.
-
-1998-12-03 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-mime-display-alternative): Use (*) for radio
- buttons, not [*].
-
-1998-12-04 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-insert-mime-button): Do proper help-echo.
-
-1998-12-04 04:48:37 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-insert-mime-button): Fix.
-
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-mime-part): Nicify prompts.
- (message-insert-mime-part): Really delete duplicates.
- (message-insert-mime-part): Check against common errors.
- (message-insert-mime-part): Fix docstring.
-
-1998-12-04 04:41:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-internalize-part): Bugged out.
-
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-mime-button-line-format): Nicify.
- (gnus-insert-mime-button): Modify accordingly.
-
-1998-12-04 01:50:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-display-mime): Set window point.
-
- * mm-decode.el (mm-display-external): Only decode when not
- saving.
- (mm-alternative-precedence): Prefer multiparts.
- (mm-inline-media-tests): Inline multiparts.
-
- * gnus-picon.el (gnus-picons-next-job-internal): Do bar if asked.
- Ignore errors when requiring url.
-
- * mml.el (mml-quote-region): New command.
-
- * message.el (message-cite-original): Use it.
- (message-cite-original-without-signature): Ditto.
-
-Thu Dec 3 12:53:58 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.62 is released.
-
-1998-12-03 13:38:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): Work with multiparts.
-
-1998-12-03 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-view.el (mm-inline-text): Use `point-min-marker' and
- `point-max-marker'.
-
-1998-12-03 13:22:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-extensions): Use image/xpm for xpms.
-
- * gnus-art.el (gnus-mime-display-single): Check for attachment
- before other tests.
-
-1998-12-03 Didier Verna <verna@inf.enst.fr>
-
- * gnus-msg.el (gnus-configure-posting-styles): find a
- posting-style entry in the group parameters, if any, and honor it
- at the end.
-
-1998-12-03 13:03:37 Felix Lee <flee@teleport.com>
-
- * nntp.el (nntp-after-change-function): Fix.
-
-1998-12-03 12:44:30 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * mml.el (mml-generate-mime-1): Insert literally.
-
-1998-12-03 00:23:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-mime-headers): Removed debug.
-
-1998-12-02 22:22:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-show-article): Destroy parts when
- prefixed.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Default
- application/emacs-lisp to 8bit.
-
-1998-12-03 Dale Hagglund <rdh@best.com>
-
- * mm-decode.el (mm-quote-arg): Add quoting of '()', '<>', and '|'.
-
-Wed Dec 2 20:24:27 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.61 is released.
-
-1998-12-02 21:12:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parse-1): Skipped parts.
- (mml-insert-mime-headers): Nil is a list.
- (mml-generate-mime-1): Don't insert literally.
- (mml-read-tag): Drop text props.
- (mml-read-part): Ditto.
- (mml-parse-singlepart-with-multiple-charsets): Ditto.
-
-Wed Dec 2 20:07:16 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.60 is released.
-
-1998-12-02 20:11:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parse-1): Don't throw contents away.
-
-1998-12-02 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-compute-boundary-1): Regexp-quote the boundary.
-
-1998-12-02 18:42:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parse-singlepart-with-multiple-charsets): New
- function.
- (mml-parse-1): Use it.
-
-Tue Dec 1 23:04:25 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-decode-with-mail-decode-encoded-word-region):
- Use gnus-newsgroup-default-charset.
- (article-decode-encoded-words): Remove charset codes.
- * gnus-sum.el (gnus-newsgroup-default-charset): Use
- gnus-default-charset.
-
-1998-12-02 03:14:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Don't encode here.
- (message-send-news): Nor here.
- (message-send): ... but here instead.
-
- * gnus-picon.el (gnus-picons-display-article-move-p): Changed
- default to nil.
- (gnus-article-display-picons): Replace From line.
- (gnus-group-display-picons): Replace Newsgroups line.
- (gnus-picons-display-glyph): Set baseline.
- (gnus-group-display-picons): Piconize the entire Newsgroups line.
- (gnus-picons-xbm-face): Revert to old, standard colors.
-
- * message.el (message-fetch-field): Remove text props.
-
- * gnus-art.el (gnus-article-normalized-header-length): New
- variable.
- (article-normalize-headers): New command and keystroke.
-
- * gnus-picon.el (gnus-picons-xbm-face): Changed colors.
-
-Wed Dec 2 01:43:48 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.59 is released.
-
-1998-12-02 01:38:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-insert-mime-headers): Beep at multiple charsets.
-
- * gnus-art.el (gnus-mime-copy-part): Set buffer-file-name.
-
-1998-11-30 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-generate-mime-1): Handle unquoting end-tags.
-
-1998-12-02 00:15:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-all-images-fit): New variable.
- (mm-image-fit-p): Use it.
-
- * gnus-art.el (gnus-mime-display-single): Use it.
- (gnus-mime-internalize-part): New command and keystroke.
-
- * mm-decode.el (mm-user-automatic-external-display): New
- variable.
- (mm-automatic-external-display-p): New function.
-
- * gnus-picon.el (gnus-picons-xbm-face): Default to sensible
- colors.
-
-1998-12-01 23:52:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-repair-multipart): Reselect article.
-
- * gnus-art.el (gnus-with-article): Work in the original article
- buffer.
- (gnus-with-article): Work in read-only groups.
-
-Tue Dec 1 00:15:36 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-string): Return original string if not
- decode.
-
-Mon Nov 30 23:38:02 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Use mm-make-handle.
-
-1998-12-01 01:53:49 Francois Pinard <pinard@iro.umontreal.ca>
-
- * nndoc.el (nndoc-mime-parts-type-p): Do related.
-
-Tue Dec 1 00:46:20 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.58 is released.
-
-1998-11-30 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-get-image): Return a glyph, not an image
- specifier.
-
-1998-11-29 Hrvoje Niksic <hniksic@srce.hr>
-
- * rfc2047.el (rfc2047-decode): Bind mm-default-charset.
-
-1998-12-01 01:23:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-parse.el (rfc2045): Required.
-
-1998-12-01 00:59:53 William M. Perry <wmperry@aventail.com>
-
- * mm-view.el (mm-inline-text): Remove props.
-
-1998-12-01 00:18:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): Protect url-misc.
-
- * message.el (message-ignored-resent-headers): Remove
- Gnus-Warning.
-
- * mml.el (mml-insert-mime-headers): Use encoding.
- (mml-parameter-string): Ditto.
-
- * rfc2045.el: New file.
- (rfc2045-encode-string): New function.
-
-1998-11-30 23:11:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-parse.el (mail-header-encode-parameter): New function.
-
- * rfc2231.el (rfc2231-encode-string): New function.
-
-Mon Nov 30 13:52:50 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-string): New function.
- * mm-view.el (mm-inline-text): Use mm-decode-string.
-
-Mon Nov 30 21:57:00 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.57 is released.
-
-1998-11-23 Felix Lee <flee@cygnus.com>
-
- * nntp.el (nntp-async-needs-kluge): new setting.
- (nntp-async-timer): new var.
- (nntp-async-process-list): new var.
- (nntp-async-kluge): new function.
- (nntp-async-timer-handler): new function.
- (nntp-async-wait): new function.
- (nntp-async-stop): new function.
- (nntp-after-change-function): renamed, and split apart.
- (nntp-async-trigger): new function.
- (nntp-do-callback): new function.
- (nntp-accept-process-output): add optional timeout arg.
-
- * gnus-async.el (gnus-async-request-fetched-article): fixed.
- (gnus-async-wait-for-article): new function.
- (gnus-async-with-semaphore): s/asynch/async/.
-
-1998-11-30 16:54:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-with-article): Don't encode.
- (gnus-insert-mime-button): Fall back on filename from C-D.
- (gnus-mime-display-single): Have dots right on text/plain
- attachments.
-
- * mm-decode.el (mm-dissect-buffer): Respect Content-Disposition in
- broken parts.
-
- * gnus-art.el (gnus-with-article): Flush cache and backlog.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Also do
- binhex.
-
- * gnus-sum.el (gnus-summary-reparent-thread): Use new macro.
- (gnus-summary-repair-multipart): New command and keystroke.
-
- * gnus-art.el (gnus-with-article-buffer): New macro.
-
-Sun Nov 29 23:51:57 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Do not get part when
- undisplay the part.
-
-1998-11-30 03:38:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-make-sort-function-1): Allow lambdas.
-
- * mml.el (mml-read-part): Partition right.
-
- * mm-decode.el (mm-handle-set-cache): New macro.
- (mm-handle-cache): Ditto.
- (mm-make-handle): Ditto.
- (mm-dissect-singlepart): Use it.
- (mm-get-image): Use the cache.
-
-1998-11-29 23:44:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-mixed): Rewrite.
- (gnus-mime-display-single): Don't insert lines between parts.
-
-Sun Nov 29 04:55:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-file-coding-system-1): New variable.
- * nnfolder.el (nnfolder-file-coding-system): Ditto.
- (nnfolder-read-folder): Use nnfolder-file-coding-system.
- * nnml.el (nnml-file-coding-system): New variable.
- (nnml-request-article): Use nnml-file-coding-system.
-
-Sun Nov 29 15:12:52 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.56 is released.
-
-1998-11-29 00:52:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-part): New function.
- (gnus-mime-display-mixed): Use it.
-
- * mm-view.el (mm-setup-w3): Don't register.
-
- * message.el (message-cite-original): Cite parts.
-
-1998-11-28 23:51:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-parameter-string): New function.
- (mml-insert-mime-headers): Separated into new function.
-
-1998-11-28 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-make-boundary): Use `make-string'.
-
-1998-11-27 Hrvoje Niksic <hniksic@srce.hr>
-
- * binhex.el (binhex-insert-char): Ditto.
-
- * base64.el (base64-insert-char): Ditto.
-
- * uudecode.el (uudecode-insert-char): Code correctly.
-
-1998-11-28 01:08:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime): Don't generate multiparts for
- empties.
-
- * gnus-art.el (gnus-display-mime): Save excursion.
-
- * message.el (message-remove-first-header): New function.
- (message-encode-message-body): Use it.
-
-Fri Nov 27 12:26:10 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.55 is released.
-
-1998-11-27 12:38:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-setup-w3): New function.
-
- * mm-decode.el (mm-content-id-get-contents): New function.
- (mm-content-id-get-type): Ditto.
- (mm-content-id-get-encoding): Ditto.
- (mm-get-handle-by-content-id): Removed.
-
-1998-11-25 Colin Rafferty <colin@xemacs.org>
-
- * message.el (message-generate-new-buffers): Fix tag.
-
-1998-11-25 10:43:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-buffer-name): Check for unique first.
-
- * gnus-art.el (gnus-unbuttonized-mime-type-p): use
- gnus-inhibit-mime-unbuttonizing.
-
- * gnus-sum.el (t): Bind M-t.
- (gnus-inhibit-unbuttonizing): New variable.
- (gnus-summary-toggle-display-buttonized): New command.
-
- * gnus-art.el (gnus-display-mime): Select article window.
- (article-strip-trailing-space): New command and keystroke.
-
- * nneething.el (nneething-include-files): New variable.
- (nneething-create-mapping): Use it.
-
- * nntp.el (nntp-possibly-change-group): Use nntp-send-command.
-
- * nnvirtual.el (nnvirtual-request-update-mark): Only yodate
- ayto-expirable marks.
-
-1998-11-24 21:00:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): Set buffer.
-
- * gnus-sum.el (gnus-summary-display-buttonized): Don't pass on
- ARG.
-
- * gnus-art.el (gnus-article-mode-line-format): Doc fix.
-
-Tue Nov 24 14:57:41 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-binary-coding-system): New variable.
- (mm-with-unibyte-buffer): Use mm-binary-coding-system.
- * mm-decode.el (mm-display-external): Ditto.
-
-Tue Nov 24 10:43:06 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.54 is released.
-
-1998-11-24 11:21:32 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-newsgroup-default-charset-alist): Note fj.
-
-1998-11-24 11:14:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-save-part): Unquote.
-
-1998-11-24 11:14:39 Matt Armstrong <matta@geoworks.com>
-
- * mm-decode.el (mm-save-part): Bind coding system for write.
-
-1998-11-24 10:42:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode-line-format): New default.
- (gnus-article-mime-part-status): New function.
-
- * message.el (message-send-news): Check the body syntax before
- encoding.
-
- * gnus-art.el (gnus-unbuttonized-mime-type): New function.
- (gnus-mime-display-single): Use it.
- (gnus-mime-display-alternative): Ditto.
-
- * mm-decode.el: Check for whether we are running under a term.
-
-1998-11-22 08:12:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-preferred-alternative): Default to first
- alternative.
- (mm-preferred-alternative): No, we dont.
-
-Tue Nov 24 03:01:48 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-external): Use binary instead of
- no-conversion.
- * gnus-agent.el (gnus-agent-file-coding-system): Ditto.
- * nnheader.el (nnheader-file-coding-system): Ditto.
- * mm-util.el (mm-with-unibyte-buffer): Use binary instead of nil.
-
-Mon Nov 23 01:51:57 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-setup-default-charset): Use group
- name without method.
-
-Mon Nov 23 01:26:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-default-charset): Rename
- coding-system -> default-charset.
- (gnus-newsgroup-default-charset-alist): Ditto.
- (gnus-summary-local-variables): Ditto.
- (gnus-set-global-variables): Ditto.
- (gnus-get-newsgroup-headers): Ditto.
- (gnus-summary-from-or-to-or-newsgroups): Ditto.
- (gnus-get-newsgroup-headers-xover): Ditto.
- (gnus-newsgroup-setup-default-charset): Ditto.
- (article-decode-mime-words): Ditto.
- (article-decode-charset): Ditto.
- (article-decode-encoded-words): Ditto.
- (article-de-quoted-unreadable): Ditto.
- (gnus-mime-view-all-parts): Ditto.
- (gnus-mime-externalize-part): Ditto.
- (gnus-mm-display-part): Ditto.
- (gnus-mime-display-single): Ditto.
- (gnus-mime-display-alternative): Ditto.
- * lpath.el : Ditto.
-
-Mon Nov 23 00:54:33 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-decode-region): Do not decode nil charset.
- * gnus-art.el (article-decode-charset): Overlay
- rfc2047-default-charset.
- * message.el (message-draft-coding-system): New variable.
- (message-set-auto-save-file-name): Use message-draft-coding-system.
- * nndraft.el (nndraft-request-article): Ditto.
- * gnus-start.el (gnus-start-draft-setup): Set charset nil.
- * gnus-agent.el (gnus-agent-queue-setup): Ditto.
-
-Sun Nov 22 04:42:22 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-test): New function.
- (mm-uu-dissect): Inherit charset and cte from head.
- * gnus-art.el (article-decode-charset): Use mm-uu-test.
-
-Sat Nov 21 09:57:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.53 is released.
-
-1998-11-21 05:54:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-get-image): New function.
- (mm-image-fit-p): New function.
-
- * gnus-xmas.el (gnus-xmas-annotation-in-region-p): Ditto.
-
- * gnus-util.el (gnus-annotation-in-region-p): New definition.
-
- * gnus-art.el (gnus-article-insert-newline): New function.
- (article-goto-body): New function.
-
-1998-11-20 10:34:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-single): Insert blank line before
- buttons.
-
- * gnus-sum.el (gnus-summary-display-buttonized): New command and
- keystroke.
-
- * gnus-art.el (gnus-mime-display-single): Don't insert a blank
- line between parts.
-
- * message.el (message-remove-header): Go to end if wanted.
-
-1998-11-20 Karl Kleinpaste <karl@justresearch.com>
-
- * gnus-art.el (gnus-mime-display-alternative): Avoid window
- movement with save-window-excursion.
-
-Fri Nov 20 03:50:30 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): Use argument as charset.
-
-Fri Nov 20 03:37:53 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-bodies.el (mm-decode-body): Remove buffer-file-coding-system.
-
-Fri Nov 20 01:20:38 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Use
- gnus-newsgroup-coding-system.
- (gnus-get-newsgroup-headers): Ditto.
- (gnus-get-newsgroup-headers-xover): Ditto.
- (gnus-set-global-variables): Ditto.
- * gnus-art.el (article-decode-mime-words): Ditto.
- (article-decode-charset): Ditto.
- (article-decode-encoded-words): Ditto.
- (article-de-quoted-unreadable): Ditto.
- (gnus-mime-view-all-parts): Ditto.
- (gnus-mime-externalize-part): Ditto.
- (gnus-mm-display-part): Ditto.
- (gnus-mime-display-alternative): Ditto.
- (gnus-mime-display-single): Ditto.
- * mm-view.el (mm-inline-text): Use default coding system.
-
-Fri Nov 20 00:54:37 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-coding-system-alist): New variable.
- (gnus-newsgroup-iso-8859-1-forced-regexp): New variable.
- (gnus-newsgroup-coding-system): New local variable.
- (gnus-newsgroup-iso-8859-1-forced): New local variable.
- (gnus-summary-local-variables): Add two new local variables.
- (gnus-newsgroup-setup-coding-system): New function.
- (gnus-select-newsgroup): Setup coding system.
- * lpath.el: Add two new variables.
- * mm-util.el (mm-charset-iso-8859-1-forced): New variable.
- (mm-charset-to-coding-system): Use mm-charset-iso-8859-1-forced.
- * gnus-cus.el (gnus-group-parameters): Customizable
- iso-8859-1-forced.
-
-Fri Nov 20 05:30:26 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.52 is released.
-
-1998-11-20 04:32:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encode-message-header): Encode the default
- encoding.
-
- * gnus-art.el (gnus-mime-display-single): Insert buttons for
- undisplayed text types.
-
- * mm-decode.el (mm-automatic-display-p): Only prefer inlinable
- types.
-
-1998-11-19 Felix Lee <flee@cygnus.com>
-
- * nntp.el (nntp-after-change-function-callback): recover from C-g.
-
-1998-11-19 Felix Lee <flee@cygnus.com>
-
- * gnus-async.el (gnus-asynch-obarray): rename to
- gnus-async-hashtb, and don't buffer-local it.
-
- (gnus-async-article-callback): new function.
- (gnus-make-async-article-function): use it.
-
- (gnus-async-current-prefetch-group): new var.
- (gnus-async-current-prefetch-article): new var.
- (gnus-async-request-fetched-article): are we fetching it already?
-
- (gnus-async-delete-prefected-entry): s/prefected/prefetched/
-
-1998-11-20 02:49:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-show-article): Require.
-
- * message.el: Provide before hooks.
- (message-send-news): Do MIME before headers.
-
- * gnus-art.el (gnus-article-check-buffer): New function.
- (gnus-article-read-summary-keys): Use it.
-
- * mm-decode.el (mm-user-automatic-display): Display all inline
- images.
-
- * gnus-art.el (gnus-mime-display-single): Don't buttonize so
- much.
- (gnus-unbuttonized-mime-types): New variable.
-
-1998-11-19 06:29:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-inhibit-user-auto-expire): Changed to t.
-
- * mm-decode.el (mm-quote-arg): Quote semicolons.
-
- * gnus-art.el (gnus-mime-display-single): Don't display
- attachments.
- (gnus-mime-externalize-part): New command and keystroke.
-
- * mm-decode.el (mm-dissect-buffer): Pass on the description info.
- (mm-alternative-precedence): Changed order.
-
-1998-11-07 17:41:47 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-method-simplify): New function.
- (gnus-native-method-p): New function.
- (gnus-secondary-method-p): Use gnus-method-equal.
-
- * gnus-start.el (gnus-group-change-level): Shorten select method.
-
-Thu Nov 19 04:48:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.51 is released.
-
-1998-11-19 04:02:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Applied patches from 5.6.45.
-
- * gnus-score.el (gnus-score-find-trace): Print complete file
- paths.
- (gnus-score-find-trace): Truncate lines.
-
- * gnus.el (gnus-message-archive-group): Allow function.
-
- * message.el (message-encode-message-body): Remove Mime-Version
- before inserting.
-
- * gnus-cus.el (gnus-group-customize): Optional topic.
-
- * gnus-sum.el (gnus-summary-customize-parameters): New command and
- keystroke.
-
-Wed Nov 18 13:46:08 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-encode-message-body): Rewrite.
-
-1998-11-18 07:37:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-base-boundary): New variable.
- (mml-make-boundary): New function.
-
- * gnus-cache.el (gnus-cache-coding-system): New variable.
- (gnus-cache-request-article): Use it.
-
- * message.el (message-insert-mime-part): Delete duplicates.
-
-Wed Nov 18 11:52:19 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-alternative): Set end of
- multipart and display even when nothing is preferred.
-
-Wed Nov 18 05:06:44 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.50 is released.
-
-1998-11-18 04:42:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Check that device-type is
- fbound.
-
- * gnus-sum.el (gnus-summary-sort): Didn't do reverse.
-
-1998-11-07 23:39:48 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.el (gnus-similar-server-opened): Compare backend.
-
-1998-11-08 03:37:42 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-topic.el (gnus-topic-expire-articles): New function.
- (gnus-topic-mode-map): Bind it.
-
- * gnus.texi (Topic Commands): New expiry command. Reordered.
-
-1998-11-10 Miles Bader <miles@ccs.mt.nec.co.jp>
-
- * gnus-sum.el
- (gnus-auto-expirable-marks): New variable.
- (gnus-inhibit-user-auto-expire): New variable.
- (gnus-summary-mark-article-as-read, gnus-summary-mark-article):
- When looking to see if we should expire instead, check
- gnus-auto-expirable-marks instead of using a hard-wired list.
- (gnus-summary-mark-as-read-forward,
- gnus-summary-mark-as-read-backward):
- Pass gnus-inhibit-user-auto-expire for the no-expire argument to
- gnus-summary-mark-forward, instead of `t'.
-
-1998-11-18 03:30:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-compute-boundary): New function.
- (mml-compute-boundary-1): New function.
- (mml-generate-mime-1): Use it.
-
-1998-11-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * mml.el (mml-generate-mime-1): Always precede closing boundary
- with newline.
-
-1998-11-18 02:36:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Do right boundaries when several
- multiparts.
-
- * mm-decode.el (mm-user-automatic-display): Default to inline
- jpeg.
-
- * mml.el (mml-generate-mime-1): Encode non-text parts.
-
-Wed Nov 18 02:22:23 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.49 is released.
-
-1998-11-18 00:37:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-inline-text): Require w3-vars.
-
- * gnus-setup.el (gnus-use-tm): Removed.
-
- * gnus-art.el (gnus-article-goto-part): Don't beep.
- (gnus-article-view-part): Check return value.
- (gnus-mime-display-alternative): Don't display when there is
- nothing to display.
-
- * mml.el (mml-generate-mime-1): Don't use a unibyte buffer.
- (mml-generate-mime-1): Use unibyte for binaries.
-
- * gnus-art.el (gnus-display-mime): Call
- gnus-article-mime-part-function.
- (gnus-mime-part-function): New function.
- (gnus-article-mime-part-function): New function.
-
- * mml.el (mml-generate-mime-1): Don't insert so many newlines.
-
-1998-11-16 06:44:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Do it in unibyte buffers.
-
- * message.el (message-font-lock-keywords): Highlight MML.
- (message-mml-face): New font.
-
-Mon Nov 16 23:34:12 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Clean up even when no handles.
- (gnus-mm-display-part): Do not select-window if the article window
- is not found.
-
-Mon Nov 16 02:26:40 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Use no-encode for B m.
-
-Mon Nov 16 02:00:05 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.48 is released.
-
-1998-11-15 23:18:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-encode-body): Disbabled for nonmule.
-
- * mm-util.el (mm-find-charset-region): Bogus change for non-Mule.
-
- * message.el (message-cite-original-without-signature): Ditto.
- (message-cite-original): Quote parts.
-
-Sun Nov 15 22:01:55 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.47 is released.
-
-1998-11-15 20:11:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Insert MIME warning.
-
- * mml.el (mml-read-tag): Look for #tag.
-
- * mm-util.el (mm-find-charset-region): Check whether
- enable-multibyte-characters is bound.
-
-Sun Nov 15 02:01:31 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.46 is released.
-
-1998-11-15 01:54:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Insert headers at the
- right spot.
-
-Sun Nov 15 01:13:41 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.45 is released.
-
-1998-11-15 00:28:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nndraft.el (nndraft-save-mime-part): Removed.
- (nndraft-get-mime-part): Ditto.
-
- * message.el (message-format-mime-old): Removed.
- (message-encode-message-body): Removed.
- (message-encode-message-body): Renamed.
-
-1998-11-14 18:27:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Translate \r's.
-
- * message.el (message-format-mime): Check message-mime-part.
-
- * mm-encode.el (mm-mime-file-types): Removed.
- (mm-default-file-encoding): New definition.
-
-Sat Nov 14 01:29:39 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-image): Use mm-insert-inline.
- * gnus-art.el (gnus-mm-display-part): Go to correct position.
-
-Sat Nov 14 05:47:57 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.44 is released.
-
-1998-11-14 03:59:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-format-mime): New function.
-
- * nndraft.el (nndraft-save-mime-part): New function.
- (nndraft-get-mime-part): New function.
-
- * mm-encode.el (mm-default-file-encoding): New function.
- (mm-content-transfer-encoding): New function.
- (mm-encode-buffer): New function.
-
- * message.el: New command.
- (message-mime-part): New variable.
- (message-insert-mime-part): New command.
-
- * mm-encode.el (mm-encode-content-transfer-encoding): New
- function.
-
- * mm-util.el (mm-content-transfer-encoding-defaults): New
- variable.
- (mm-mime-file-types): Taken from TM.
-
-Sat Nov 14 01:51:06 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.43 is released.
-
-1998-11-07 Karl Kleinpaste <karl@jprc.com>
-
- * gnus-cus.el (gnus-score-customize): Add "Extra" element.
- * gnus-score.el (gnus-score-default-header): Ditto.
- (gnus-header-index): Ditto.
- (gnus-summary-increase-score): Ditto, & process "extra" requests.
- (gnus-summary-header): Handle extra headers.
- (gnus-summary-score-entry): Ditto, & provide new score element.
- (gnus-summary-score-effect): Ditto.
- (gnus-score-string): Avoid "extra" string sort, & modify match in
- "extra" case.
- * gnus-sum.el (gnus-make-score-map): Add "extra" element.
-
-1998-11-13 20:30:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-resend): Bind message-required-mail-headers
- to nil.
-
- * mm-view.el (mm-inline-text): Bind w3-strict-width.
-
- * nngateway.el (require): Require cl.
-
- * gnus-art.el (gnus-button-alist): Exclude more chars from news:
- things.
-
-Wed Nov 11 02:15:06 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Create directory even
- when no articles.
-
-1998-11-13 19:25:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-ignored-resent-headers): Remove X-Gnus.
-
-1998-11-10 Colin Rafferty <colin@xemacs.org>
-
- * gnus-sum.el (gnus-ignored-from-addresses): Only quote
- user-mail-address if non-nil.
-
-1998-11-13 18:50:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-make-sort-function): Do `reverse'.
- (gnus-make-sort-function-1): Ditto.
-
- * gnus-art.el (gnus-mm-display-part): Switch to mm in right
- window.
-
-1998-11-12 22:31:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-with-unibyte-buffer): Ditto.
-
- * binhex.el (binhex-decode-region): Quote.
-
-1998-11-10 05:32:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Don't downcase charset.
-
- * gnus-sum.el (gnus-get-newsgroup-headers-xover): Translate CR's.
-
-Sun Nov 8 23:17:24 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.42 is released.
-
-Sun Nov 8 02:36:33 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Add id for alternative part.
-
-1998-11-08 02:24:47 Simon Josefsson <jas@pdc.kth.se>
-
- * nntp.el (nntp-send-mode-reader): Revert.
-
-Sun Nov 8 00:45:13 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-articles): Use with-temp-buffer.
-
-Sat Nov 7 23:07:24 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-date): Fix for negative time zones.
-
-Sun Nov 8 01:00:16 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.41 is released.
-
-1998-11-08 00:52:38 Hrvoje Niksic <hniksic@srce.hr>
-
- * mm-decode.el (mm-dissect-multipart): Quote regexp.
-
-1998-10-29 Sudish Joseph <sj@eng.mindspring.net>
-
- * gnus.el (gnus-short-group-name): When shortening foreign select
- methods, do not scan for plusses beyond the first colon.
-
-1998-11-07 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-save-group-info): Cater for group info
- lines where `group' is the last thing on the line.
-
-1998-11-08 00:35:09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Do alternative.
- (gnus-mime-display-alternative): Insert marker.
-
-1998-11-07 14:33:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-dissect-multipart): Quote regexp.
-
- * nnmail.el (nnmail-expired-article-p): Protect against bogus
- dates.
-
- * gnus-cus.el (gnus-topic): Required.
-
- * nnheader.el (nnheader-parse-nov): Parse extra.
- (nnheader-nov-parse-extra): New macro.
-
-1998-10-31 12:33:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Internal move.
-
-1998-10-28 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-cus-new.el (gnus-custom-topic): New free variable.
- (gnus-group-customize): Support editing topic parameters.
-
-1998-10-29 12:09:20 Karl Kleinpaste <karl@jprc.com>
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Add
- indicators.
-
-1998-10-29 11:31:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mm-display-part): Return.
- (gnus-article-view-part): Only go if external.
- (gnus-article-dumbquotes-map): Do 205.
-
- * mm-decode.el (mm-display-part): Return what was done.
-
- * message.el (message-buffer-naming-style): New variable.
- (message-generate-new-buffers): Extended.
- (message-buffer-naming-style): Removed.
- (message-buffer-name): Use it.
- (message-do-send-housekeeping): Rename new styling.
-
- * gnus-sum.el (gnus-summary-recenter): Allow
- gnus-auto-center-summary to be a number.
-
-Wed Nov 4 02:24:39 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-open-server): Use "binary" instead of
- "no-conversion".
-
-Sun Nov 1 01:26:42 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Set
- gnus-browse-current-method to the result of gnus-server-to-method.
-
-Thu Oct 29 01:47:44 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-pull): Another optional argument.
- * nnweb.el (nnweb-request-delete-group): Delete from
- nnweb-group-alist and update active file.
-
-Thu Oct 29 01:05:08 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-group): Accept group of new
- method.
-
-Wed Oct 28 02:19:16 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Update dribble.
-
-Tue Oct 27 11:59:31 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Postion of html portion.
-
-1998-10-29 10:26:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-list-active-group): Waited for short strings.
- (nntp-send-mode-reader): Ditto.
- (nntp-open-connection): Ditto.
-
- * gnus-int.el (gnus-request-group-articles): New function.
-
- * nntp.el (nntp-request-listgroup): New function.
- (nntp-request-group-articles): Renamed.
-
-1998-10-27 10:37:52 Karl Kleinpaste <karl@jprc.com>
-
- * nnheader.el (nnheader-parse-nov): Supply extra.
-
-1998-10-26 23:03:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-push): Don't go to
- gnus-article-buffer.
-
- * mm-view.el (mm-inline-image): Add a newline.
-
- * gnus-start.el (gnus-check-first-time-used): Check more.
-
-1998-10-26 23:03:29 Francois Felix Ingrand <felix@laas.fr>
-
- * gnus-start.el (gnus-check-first-time-used): Check current.
-
-1998-10-26 22:07:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-find-charset-region): New function.
-
- * ietf-drums.el (ietf-drums-narrow-to-header): Work when no header.
-
- * gnus-art.el (gnus-mime-button-menu): Fix.
-
-1998-10-26 22:07:43 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * gnus-art.el (gnus-mime-button-menu): New definition.
-
-1998-10-26 01:46:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Downcase charset.
- (article-decode-charset): Pass on type.
- (article-decode-charset): Check nil charsets.
- (article-remove-cr): Translate CR to LF.
- (gnus-ignored-mime-types): Default to nil.
-
- * nnheader.el (nnheader-insert-nov): Work when not Xref.
-
- * gnus-sum.el (gnus-ignored-from-addresses): Default to
- user-mail-address.
- (gnus-nov-parse-extra): Didn't return right thing.
-
-1998-10-25 23:25:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-xmas.el: Use compiled-function-p.
-
-Mon Oct 26 14:37:19 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-copy-Yo-buffer): Make it works when no header.
-
-Sun Oct 25 23:11:44 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.40 is released.
-
-1998-10-25 21:41:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-mark-forward): Show thread.
-
- * gnus-start.el (gnus-check-first-time-used): Ignore dribble.
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Bind name.
-
- * nnml.el (nnml-possibly-create-directory): Check before making.
-
-1998-10-25 19:43:08 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnheader.el (nnheader-insert-nov): Don't infloop.
-
-1998-10-25 19:26:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-set-mode-line): Check that the spec has been
- set up.
-
-1998-10-25 19:22:03 Joerg Lenneis <lenneis@statrix2.wu-wien.ac.at>
-
- * nneething.el (nneething-file-name): New definition.
-
-1998-10-25 17:56:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Fix.
- (gnus-summary-save-in-rmail): Use gnus-output-to-rmail.
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Recognize first part.
-
-Sun Oct 25 06:23:13 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.39 is released.
-
-1998-10-25 00:34:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-ignored-mime-types): New variable.
- (gnus-mime-display-single): Use it.
- (gnus-treatment-function-alist): New variable.
-
- * gnus.el (gnus-mime): New group.
-
- * gnus-art.el (gnus-mime-display-alternative): Don't destroy
- things for other parts.
- (gnus-mime-display-alternative): Place point.
-
- * gnus.el: autoload gnus-uu-post-news.
-
- * mailcap.el (mailcap-mailcap-entry-passes-test): Also check
- needsterm/DISPLAY.
-
- * mm-decode.el (mm-display-part): Default to inline text/.*
- parts.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Default to
- 8bit.
-
- * gnus-art.el (gnus-mime-copy-part): Use normal-mode.
- (gnus-mime-display-single): Inline all text parts.
- (gnus-article-narrow-to-signature): Removed mime:: stubs.
-
-1998-10-24 21:38:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnml.el (nnml-possibly-create-directory): Rewrite.
- (nnml-request-create-group): Change to right server.
-
- * gnus-xmas.el (gnus-xmas-define): Use byte-code-function-p.
-
- * gnus-sum.el (gnus-set-mode-line): Use truncate-string-to-width.
-
- * gnus.el: rmail-output-to-rmail-file autoload.
-
- * gnus-util.el (gnus-output-to-rmail): Didn't work if not in
- Gnus.
-
- * nnheader.el (nnheader-parse-head): Checked wrong variable.
-
- * gnus-sum.el (gnus-summary-update-mark): Ignore nil'd marks.
-
-Tue Oct 20 23:37:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-mixed): Multipart in
- mixed part.
-
-Tue Oct 20 23:36:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Ditto.
-
-Tue Oct 20 16:22:51 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
-
-1998-10-24 20:51:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-valid-move-group-p): Make sure group has a
- value.
-
- * gnus-art.el (gnus-article-hidden-text-p): Return nil when not
- hidden.
-
- * gnus-spec.el (gnus-update-format-specifications): Use the
- article mode line spec.
-
- * gnus-art.el (gnus-insert-mime-button): Put right type.
- (gnus-insert-prev-page-button): Ditto.
- (gnus-insert-next-page-button): Dutti.
-
- * pop3.el: New version installed.
-
-Sat Oct 24 16:48:51 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Delete the begining spurious newline
- and display last part.
-
-Sat Oct 24 20:31:55 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.38 is released.
-
-1998-10-24 07:54:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-mime-decode-quoted-printable-buffer):
- Removed.
- (article-de-quoted-unreadable): Narrow to default.
-
- * qp.el (quoted-printable-encode-region): Encode before QP-ing.
-
- * gnus-art.el (article-decode-charset): Decode even when broken
- MIME.
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Return
- name.
-
- * gnus-msg.el (gnus-copy-article-buffer): Delete headers.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Use
- nnheader.
-
- * nnmail.el (nnmail-extra-headers): New variable.
-
- * nnheader.el (nnheader-insert-nov): Insert extra.
-
- * gnus.el (gnus-summary-line-format): Doc fix.
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Parse extra.
- (gnus-nov-parse-line): Ditto.
- (gnus-nov-parse-extra): New macro.
- (gnus-header): New function.
- (gnus-update-summary-mark-positions): Change.
- (gnus-ignored-from-addresses): New variable.
- (gnus-summary-insert-from-or-to): New function.
-
- * gnus.el (gnus-extra-headers): New variable.
-
- * nnheader.el (make-mail-header): Expand.
- (mail-header-extra): New macro.
- (mail-header-set-extra): Ditto.
- (make-full-mail-header): Expand.
-
-Sat Oct 24 07:41:42 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.37 is released.
-
-1998-10-24 07:29:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Check for multibyticity.
-
- * mm-util.el (mm-enable-multibyte): Don't always switch multibyte
- on.
-
-1998-10-22 Didier Verna <verna@inf.enst.fr>
-
- * gnus-spec.el (gnus-balloon-face-function): new function
- (gnus-parse-format): understand the %< %> specifiers
- (gnus-parse-complex-format): ditto.
-
-1998-10-24 06:31:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Changed following-char to char-after throughout.
-
-1998-10-22 04:05:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Protect more and message.
-
-Wed Oct 21 03:26:30 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-article-push-button): Go to the
- position.
-
-Tue Oct 20 23:37:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-mixed): Multipart in
- mixed part.
-
-Tue Oct 20 23:36:43 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-exit): Use mm-destroy-parts.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Ditto.
-
-Tue Oct 20 16:22:51 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-dissect): Create pseudo multipart head.
-
-1998-10-21 Hrvoje Niksic <hniksic@srce.hr>
-
- * mailcap.el (mailcap-save-binary-file): Use unwind-protect.
-
- * mm-decode.el (mm-display-external): Set undisplayer to mm
- buffer, not the current buffer; use unwind-protect.
-
-1998-10-21 00:07:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit): Destroy parts.
- (gnus-summary-exit-no-update): Ditto.
-
-1998-10-20 22:02:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): Look for w3.
-
- * mailcap.el (mailcap-mime-data): Inline html.
-
-Tue Oct 20 20:25:03 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.36 is released.
-
-1998-10-20 18:13:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-translate-strings):
- (gnus-article-dumbquotes-map): Don't dot.
-
- * pop3.el (pop3-open-server): Set point right.
-
- * mm-decode.el (mm-dissect-multipart): Dissect hierarchically.
- (mm-dissect-buffer): Ditto.
- (mm-destroy-part): Ignore non-handles.
- (mm-remove-part): Ditto.
- (mm-destroy-parts): New function.
- (mm-remove-parts): Ditto.
-
- * gnus-art.el (gnus-mm-display-part): Don't move point.
-
-Tue Oct 20 02:16:36 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el : New file.
-
- * gnus-art.el (gnus-display-mime): Dissect uu stuffs.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Encoding as
- a function.
-
-1998-10-20 00:35:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Check before selecting.
-
-Sat Sep 26 02:03:00 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-multi-decode-encoded-word-string): Rewrite.
-
- * gnus-sum.el (gnus-decode-encoded-word-methods): New variable.
-
- * gnus-sum.el (gnus-decode-encoded-word-methods-cache): New
- variable.
-
- * gnus-sum.el (gnus-encoded-word-method-alist): Deleted.
-
- * gnus-art.el (gnus-decode-header-methods): New variable.
-
- * gnus-art.el (gnus-decode-header-methods-cache): New variable.
-
- * gnus-art.el (gnus-multi-decode-header): New function.
-
-Tue Oct 20 00:24:16 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.35 is released.
-
-1998-10-20 00:00:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * uudecode.el (uudecode-decode-region-external): Insert
- literally.
-
- * gnus-xmas.el (gnus-xmas-mime-button-menu): Moved here.
-
- * mm-bodies.el (mm-decode-body): Optional encoding.
-
-1998-10-19 23:57:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el (gnus-mouse-3): New variable.
-
- * binhex.el (binhex-decode-region-external): Don't use -internally.
-
-1998-10-16 14:54:02 Simon Josefsson <jas@pdc.kth.se>
-
- * mailcap.el (mailcap-parse-mailcaps): Only open regular
- files.
-
-1998-09-26 22:28:01 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-group.el (gnus-add-marked-articles): Request backend update
- of flags.
-
-1998-09-26 19:39:31 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-update-read-articles):
- (gnus-update-marks): Request backend update of mark.
-
-1998-09-26 19:33:58 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Optional Backend Functions): New item,
- nnchoke-request-set-mark.
-
-1998-09-26 16:27:27 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-range.el (gnus-remove-from-range): Don't add stuff in
- list to range.
-
-1998-10-19 23:45:13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus-sum.el (gnus-summary-exit-no-update): Don't expire.
-
-1998-10-14 SL Baur <steve@altair.xemacs.org>
-
- * gnus-sum.el: Move gnus-save-hidden-threads above where it is
- first used.
-
-1998-10-10 SL Baur <steve@altair.xemacs.org>
-
- * mm-view.el: Require mm-decode for macros.
-
- * mm-decode.el (mm-handle-type): Move macro declarations above the
- place where they are used.
-
-Sun Oct 18 13:59:07 1998 Kurt Swanson <ksw@dna.lth.se>
-
- * gnus-msg.el (gnus-summary-mail-forward): Erase old forward
- buffer.
-
-1998-10-19 23:38:11 Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
-
- * nnagent.el (nnagent-open-server): Error message.
-
-1998-10-19 23:35:08 Joerg Lenneis <lenneis@statrix2.wu-wien.ac.at>
-
- * nnheader.el (nnheader-article-p): Recognize lower-case headers.
-
-1998-10-19 Hrvoje Niksic <hniksic@srce.hr>
-
- * score-mode.el (gnus-score-mode-map): Ditto.
-
- * message.el (message-mode-map): Ditto.
-
- * gnus-uu.el (gnus-uu-post-news): Ditto.
-
- * gnus-kill.el (gnus-kill-file-mode-map): Ditto.
-
- * gnus-eform.el (gnus-edit-form-mode-map): Ditto.
-
- * gnus-art.el (gnus-article-edit-mode-map): Use
- `set-keymap-parent' rather than `copy-keymap'.
-
-1998-10-18 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (gnus-mime-button-commands): New variable.
- (gnus-mime-button-map): Initialize it from
- `gnus-mime-button-commands'.
- (gnus-mime-button-menu): New function.
- (gnus-insert-mime-button): Use `gnus-mime-button-map'.
-
-1998-10-11 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-insert-to): Make `nobody' and `poster'
- synonymous to `never' and `always' in Mail-Copies-To.
- (message-reply): Ditto.
- (message-followup): Ditto.
-
-1998-10-19 23:17:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-data): Save sound.
-
-1998-09-24 Hrvoje Niksic <hniksic@srce.hr>
-
- * message.el (message-ignored-supersedes-headers): Include
- `NNTP-Posting-Date'.
-
-1998-10-19 01:25:27 Jonas Steverud <d4jonas@dtek.chalmers.se>
-
- * gnus-art.el (gnus-article-dumbquotes-table): New variable.
-
-1998-10-19 00:50:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Use
- uudecode.
-
-1998-10-18 18:20:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Don't switch on save.
-
-1998-10-18 18:14:06 Andy Piper <andyp@parallax.co.uk>
-
- * nnmail.el (nnmail-movemail-args): New variable.
-
-1998-10-18 00:17:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-translate-strings):
-
-1998-10-17 22:51:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-view-part): Use it.
- (gnus-mm-display-part): New function.
- (article-de-quoted-unreadable): Yse mm-default-coding-system.
-
- * mm-decode.el (mm-handle-displayed-p): New function.
-
- * gnus-art.el (gnus-mime-copy-part): Create better names.
- (gnus-mime-button-line-format): Include dots spec.
-
-1998-10-15 Matt Pharr <mmp@graphics.stanford.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Erase contents of old
- forward buffer first.
-
-1998-10-17 21:16:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-set-window-start): New function.
-
- * message.el (message-send): Don't check changed.
-
-1998-10-12 15:26:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-setup-buffer): Set params.
-
- * mm-decode.el (mm-user-display-methods): Inline
- "message/delivery-status".
-
-1998-10-11 07:06:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-auto-save-directory): Rename.
- (message-mode): Dof fix.
-
- * gnus-art.el (gnus-summary-save-in-pipe): Default to "cat".
- (gnus-summary-save-in-pipe): No, check gnus-last-shell-command.
-
- * nndoc.el (nndoc-mime-parts-type-p): Be a bit more forgiving.
-
- * message.el (message-make-date): Avoid locale.
-
- * gnus-art.el (gnus-article-edit-done): Allow update before doing
- cache.
-
- * mm-decode.el (mm-display-inline): Goto point-min.
-
- * gnus-art.el (gnus-article-prepare-display): Not read-only.
-
- * mm-decode.el (mm-display-external): Reverse before sorting.
-
- * gnus-draft.el (gnus-draft-send): Allow mail.
-
-1998-10-10 SL Baur <steve@altair.xemacs.org>
-
- * message.el (message-check): Move message-check macro above where
- it is first used.
-
- * gnus-art.el (article-hide-pgp): Hide the PGP 5/GNUPG Hash: line.
-
-1998-10-11 06:45:37 Lloyd Zusman <ljz@asfast.com>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Fix.
-
-Sun Oct 11 02:28:40 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.34 is released.
-
-1998-10-11 02:15:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inline-media-tests): delivery-status.
-
- * mm-view.el (mm-inline-text): Provide default.
-
-1998-10-11 01:01:37 Lloyd Zusman <ljz@asfast.com>
-
- * mailcap.el (mailcap-possible-viewers): Fix nils.
-
-1998-10-11 00:03:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-edit-exit): Don't do updates.
- (article-update-date-lapsed): Record the buffer.
- (article-update-date-lapsed): Do all windows that display article
- buffers.
-
- * nnml.el (nnml-generate-nov-databases-1): Ditto.
-
- * gnus-score.el (gnus-score-score-files-1): Ignore dotted files.
-
- * gnus-art.el (gnus-insert-mime-button): Mark buttons as
- annoations.
-
- * gnus-msg.el (gnus-summary-mail-forward): Decode properly.
-
-1998-10-10 22:07:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-category-add): Change default category to
- 'false.
-
- * nnvirtual.el (nnvirtual-update-read-and-marked): Don't nix out
- scores.
-
- * gnus-draft.el (gnus-draft-send): Check server more.
-
- * gnus-art.el (gnus-article-view-part): New command and keystroke.
- (gnus-article-goto-part): New function.
-
- * mm-view.el (mm-inline-text): Insert richtext properly.
-
- * gnus-art.el (gnus-insert-mime-button): Store handle in alist.
-
-1998-10-03 15:04:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * parse-time.el (parse-time-rules): Accept dates far into the past
- and the future, and parse single-digit numbers as years.
-
-1998-10-02 04:46:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-display-external): Chop off directories.
-
-1998-10-01 07:33:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * uudecode.el (uu-decode-region-external): Use
- insert-file-contents-literally.
-
- * gnus-cache.el (gnus-cache-generate-active): Translate _ to :.
-
-1998-10-01 07:02:11 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * uudecode.el: New file.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Do
- x-uuencode.
-
-1998-10-01 05:19:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-display-alternative): Set faces.
-
- * message.el (message-fetch-field): Unfold properly.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Replace CRLF
- in text/plain.
-
-1998-09-30 05:47:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-first-unread-subject): New command.
- (gnus-auto-select-first): Removed.
- (gnus-auto-select-first): Extended.
- (gnus-summary-read-group-1): Use new value.
-
-1998-09-29 13:21:06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-fix-before-sending): Space.
-
- * nnmail.el (nnmail-find-file): Don't erase.
-
-Wed Sep 30 23:49:03 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Do not decode headers.
-
-Wed Sep 30 23:46:29 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-add-article): Do not decode headers.
-
-Wed Sep 30 23:44:08 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-pack-packet): Pack only if necesary.
-
-Sat Sep 26 03:04:18 1998 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-with-unibyte-buffer): Make it work in XEmacs
- 20.4.
-
-1998-09-29 11:35:09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-view-all-parts): New command and
- keystroke.
-
- * mm-decode.el (mm-display-external): Translate slashes.
-
- * nnmail.el (nnmail-find-file): Restrict auto-mode-alist.
-
- * nndraft.el (nndraft-retrieve-headers): Don't copy so much.
-
- * mm-decode.el (mm-quote-arg): Quote spaces.
- (mm-display-external): Quote args.
-
-1998-09-24 22:27:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-inlinable-part-p): New function.
-
-1998-09-25 22:28:01 Simon Josefsson <jas@pdc.kth.se>
-
- * mm-util.el (mm-disable-multibyte): New function.
-
-Thu Sep 24 20:28:31 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.33 is released.
-
-1998-09-24 18:47:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Get buffer size.
-
- * mm-decode.el (mm-display-external): Don't switch for externals.
- (mm-dissect-multipart): Don't include end-sep.
-
- * mm-util.el (mm-get-coding-system-list): New function.
- (mm-coding-system-list): New variable.
-
-Thu Sep 24 02:08:10 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-parameters): Add charset as a parameter
-
-Thu Sep 24 02:05:48 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-customize): Use variable as cons not as
- group
-
-Thu Sep 24 01:41:03 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * base64.el (base64-run-command-on-region): External base64
- decoder do not use coding system
-
-Thu Sep 24 01:39:44 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-interactively-view-part): Typo.
-
-Thu Sep 24 01:37:30 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Display last part when the
- article has no close-delimiter
-
-Thu Sep 24 01:28:54 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-buffer): Display parts which have no
- content-type.
-
-Thu Sep 24 01:23:57 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-display-mime): Typo.
-
-Thu Sep 24 02:29:57 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.32 is released.
-
-1998-09-24 00:27:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-kill.el (gnus-batch-score): Protect against errors.
-
- * gnus-art.el: Protect against broken headers.
-
- * mm-decode.el (mm-display-external): Respect needsterm.
- (mm-display-external): Create buffer for external commands.
-
-1998-09-23 22:04:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mailcap.el (mailcap-mime-info): Return the proper viewer.
-
- * mm-decode.el (mm-display-external): Use file name.
-
-1998-09-22 Markus Rost <markus.rost@mathematik.uni-regensburg.de>
-
- * gnus-util.el (gnus-output-to-rmail): adjust to
- `rmail-output-to-rmail-file'
-
-1998-09-23 20:07:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-output-to-rmail): Reinstated function.
-
- * gnus-sum.el (gnus-select-newsgroup): Set global variables before
- headers.
-
- * gnus-art.el (article-decode-charset): Fold case.
-
-1998-09-17 15:49:10 Simon Josefsson <jas@pdc.kth.se>
-
- * mailcap.el (mailcap-save-binary-file): Goto point-min.
-
-1998-09-23 19:48:52 Aaron M. Ucko <amu@mit.edu>
-
- * nnmail.el (nnmail-check-duplication): Enter into duplicate list
- after being stored.
-
-Tue Sep 15 16:15:16 1998 Kurt Swanson <ksw@dna.lth.se>
-
- * gnus-salt.el (gnus-pick-setup-message): Return from whence ye
- come.
-
-1998-09-23 19:42:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-xmas.el (wid-edit): Required.
-
- * gnus-ems.el (gnus-widget-button-keymap): New variable.
-
-Sun Sep 20 00:27:55 1998 ZHU Shenghuo <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-inline-part): remove part if necessary
-
-1998-09-23 19:30:52 Matt Armstrong <matta@geoworks.com>
-
- * gnus-art.el (article-decode-charset): Narrow to the correct
- region.
-
- * mm-bodies.el: Fix autoload.
-
-1998-09-22 18:35:12 Lee Willis <lee@gbdirect.co.uk>
-
- * gnus-art.el (gnus-mime-button-line-format): Doc fix.
-
-1998-09-22 14:53:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-decode): Use rfc2047-default-charset.
-
-1998-09-19 13:58:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-insert-mime-button): Specify keymap.
- (gnus-article-add-button): Ditto.
-
- * gnus-sum.el (gnus-summary-insert-pseudos): Use mm.
-
- * gnus-art.el (gnus-article-prepare-display): Make article mode.
- (gnus-article-prepare-display): Bind url-standalone-mode.
-
- * mm-decode.el (mm-remove-part): Also delete directory.
- (mm-display-external): Create a private sub-dir.
-
- * mailcap.el (mailcap-binary-suffixes): New variable.
- (mailcap-command-p): Use it.
-
-1998-09-16 10:38:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmbox.el (nnmbox-request-group): Change server.
- (nnmbox-possibly-change-newsgroup): Enable multibyte.
-
- * message.el (message-encode-message-body): Don't stomp MIME
- headers.
-
- * gnus-sum.el (gnus-summary-edit-article-done): Don't encode
- unless useful.
- (gnus-summary-exit): Check for a live article buffer.
- (gnus-summary-exit-no-update): Ditto.
-
- * gnus-int.el (gnus-request-replace-article): Accept no-encode
- param.
-
- * gnus-sum.el (gnus-article-decoded-p): New variable.
-
- * mm-decode.el (mm-display-external): Use no-conv.
-
- * rfc2047.el (rfc2047-q-encode-region): Bound properly.
- (rfc2047-charset-encoding-alist): Use B encoding for koi8-r.
-
- * gnus-art.el (gnus-article-mode-map): Bind button2 to
- mouse-click.
-
-1998-09-15 14:38:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-expire): Protect against nil infos.
-
-Mon Sep 14 18:55:38 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.31 is released.
-
-1998-09-14 15:12:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit): Destroy MIME.
-
- * mm-decode.el (mm-display-part): Accept no-default.
-
- * gnus-art.el (gnus-insert-mime-button): buffer-size doesn't take
- a parameter.
-
- * gnus-sum.el (gnus-summary-insert-line): Don't exclude faces.
- (gnus-summary-prepare-threads): Ditto.
-
- * gnus.el (gnus-article-mode-map): Make sparse keymap.
-
- * gnus-art.el (gnus-mime-button-line-format-alist): Allow a %d spec.
- (gnus-mime-button-line-format): Doc fix.
- (gnus-insert-mime-button): Use it.
- (gnus-article-add-button): Use widget-convert-button.
-
- * gnus.el ((featurep 'gnus-xmas)): Defalias gnus-decode-rfc1522 to
- ignore.
-
- * mm-decode.el (mm-alternative-precedence): Ditto.
-
-1998-09-14 15:12:49 Conrad Sauerwald <conrad@stack.nl>
-
- * mm-decode.el (mm-user-automatic-display): Use enriched.
-
-1998-09-14 15:09:12 Paul Fisher <rao@gnu.org>
-
- * mm-decode.el (mm-dissect-multipart): Have the part start on the
- right place.
-
-1998-09-14 14:33:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-inews-add-send-actions): Mark silently.
-
- * gnus-art.el (article-update-date-lapsed): Only update header if
- buffer is dispalyed in frame.
- (gnus-article-prepare-display): New function.
- (gnus-article-prepare): Use it.
-
-1998-09-14 08:16:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-inline-part): New command and keystroke.
-
- * mm-view.el (mm-insert-inline): New function.
-
- * mm-decode.el (mm-pipe-part): Bugged.
-
- * gnus-agent.el (gnus-agent-send-mail): Don't encode.
-
- * mm-bodies.el (mm-encode-body): Move over the body.
-
- * nnmbox.el (nnmbox-read-mbox): Enable multibyte.
-
- * rfc2047.el (rfc2047-q-encode-region): Would bug out.
-
-1998-09-13 Francois Pinard <pinard@iro.umontreal.ca>
-
- * nndoc.el: Make nndoc-dissection-alist simpler for MIME, adjust all
- related functions. Handle message/rfc822 parts. Display subject on
- multipart summary lines. Display name on sub-parts when available.
-
-1998-09-14 07:36:38 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mailcap.el (mailcap-command-p): New version.
-
-1998-09-13 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-expire): Stop expiry barfing on killed
- groups.
-
-1998-09-13 18:34:06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-date): Remove weekday name.
-
- * mm-decode.el (mm-dissect-buffer): Protect against broken
- headers.
-
- * mailcap.el (mailcap-command-in-path-p): New function.
- (mailcap-command-p): Renamed.
-
-1998-09-13 17:58:47 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * rfc2047.el (eval): Autoload.
-
-1998-09-13 12:22:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-decode-encoded-word-functions): New variable.
- (gnus-multi-decode-encoded-word-string): New function.
- (gnus-encoded-word-method-alist): New variable.
- (gnus-decode-encoded-word-functions): Removed.
-
-1998-09-13 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-int.el (gnus-request-replace-article): Replace
- message-narrow-to-headers with message-narrow-to-head
-
-1998-09-13 12:05:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * drums.el (drums-quote-string): Reversed match.
-
- * message.el (message-make-date): Use weekday name.
-
-Sun Sep 11 10:27:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.30 is released.
-
-1998-09-13 08:00:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-encoded-words): Use it.
- (gnus-decode-header-function): New variable.
-
- * gnus-sum.el (gnus-nov-parse-line): Use it.
- (gnus-decode-encoded-word-function): New variable.
-
- * gnus-msg.el (gnus-copy-article-buffer): Decode the right
- buffer.
-
- * gnus-art.el (gnus-insert-mime-button): Use widget.
- (gnus-widget-press-button): New function.
- (gnus-article-prev-button): Removed.
- (gnus-article-next-button): Ditto.
- (gnus-article-add-button): Ditto.
-
- * gnus.el (gnus-article-mode-map): Inherit from widget.
- (gnus-article-mode-map): No, don't.
-
- * mm-decode.el (mm-dissect-buffer): Store Content-ID things.
- (mm-content-id-alist): New variable.
- (mm-get-content-id): New function.
-
- * gnus-art.el (gnus-request-article-this-buffer): Only decode
- articles if we are fetching to the article buffer.
-
-1998-09-13 07:58:59 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Don't decode accepting
- articles.
-
-1998-09-13 07:23:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-mime-charset): Try to use safe-charsets.
- (mm-default-mime-charset): New variable.
-
- * rfc2047.el (rfc2047-dissect-region): Dissect using tspecials.
-
- * drums.el (drums-quote-string): Reversed test.
-
-1998-09-12 14:29:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-insert-rfc822-headers): Possibly not quote
- string.
-
- * drums.el (drums-quote-string): New function.
-
- * rfc2047.el (rfc2047-encode-message-header): Goto point-min.
- (rfc2047-b-encode-region): Chop lines.
- (rfc2047-q-encode-region): Ditto.
-
-Sat Sep 12 13:27:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.29 is released.
-
-1998-09-12 12:46:30 Istvan Marko <imarko@pacificnet.net>
-
- * mm-decode.el (mm-save-part): Message right.
-
-1998-09-12 11:30:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * drums.el (drums-parse-address): Returned a list instead of a
- string.
- (drums-remove-whitespace): Skip comments.
- (drums-parse-addresses): Didn't work.
-
-Sat Sep 12 09:17:30 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.28 is released.
-
-1998-09-12 04:57:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-button-map): Use the article keymap as a
- starting point.
- (article-decode-encoded-words): Rename.
-
- * message.el (message-narrow-to-headers-or-head): New function.
-
- * gnus-int.el (gnus-request-accept-article): Narrow to the right
- region.
-
- * message.el (message-send-news): Encode body after checking
- syntax.
-
- * gnus-art.el (gnus-mime-button-line-format): Allow descriptions.
-
- * mm-decode.el (mm-save-part): Use Content-Disposition filename.
-
- * gnus-art.el (gnus-display-mime): Respect disposition.
-
- * mm-decode.el (mm-preferred-alternative): Respect disposition.
-
- * gnus-art.el (article-strip-multiple-blank-lines): Don't delete
- text with annotations.
-
- * message.el (message-make-date): Fix sign for negative time
- zones.
-
- * mm-view.el (mm-inline-image): Insert a space at the end of the
- image.
-
- * mail-parse.el: New file.
-
- * rfc2231.el: New file.
-
- * drums.el (drums-content-type-get): Removed.
- (drums-parse-content-type): Ditto.
-
- * mailcap.el (mailcap-mime-data): Use symbols instead of strings.
-
-Fri Sep 11 18:23:34 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.27 is released.
-
-1998-09-11 12:42:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-alternative-precedence): New variable.
- (mm-preferred-alternative): New function.
-
- * gnus-art.el (gnus-mime-copy-part): New command.
-
- * mm-decode.el (mm-get-part): New function.
-
- * mm-view.el: New file.
-
- * mm-decode.el (mm-dissect-buffer): Downcase cte.
- (mm-display-part): Default to mailcap-save-binary-file.
-
-Fri Sep 11 12:32:50 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.26 is released.
-
-1998-09-11 08:25:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el (mm-interactively-view-part): New function.
-
- * gnus-art.el (gnus-mime-view-part): New command.
-
- * mm-decode.el (mm-last-shell-command): New variable.
-
- * mailcap.el (mailcap-mime-info): Allow returning all matches.
-
- * mm-decode.el (mm-save-part): New function.
-
- * gnus-art.el (article-decode-charset): Protect against buggy
- content-types.
- (gnus-mime-pipe-part): New command.
- (gnus-mime-save-part): New command.
- (gnus-mime-button-map): New keymap.
- (gnus-mime-button-line-format): New variable.
- (gnus-insert-mime-button): New function.
- (gnus-display-mime): Use it.
-
- * gnus-util.el (gnus-dd-mmm): Removed length spec.
-
- * mm-decode.el (mm-inline-text): Decode charsets.
-
- * gnus-art.el (gnus-article-save): Comment fix.
-
- * gnus-int.el (gnus-start-news-server): When in batch, don't
- prompt.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Don't
- decode.
-
- * mm-decode.el (mm-inline-media-tests): Add audio.
- (mm-inline-audio): New function.
-
-1998-09-11 08:19:22 Katsumi Yamaoka <yamaoka@ga.sony.co.jp>
-
- * gnus-art.el (article-make-date-line): Didn't work.
-
- * parse-time.el (parse-time-string): One too many nils.
-
-Fri Sep 11 08:09:40 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.25 is released.
-
-1998-09-11 07:38:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-remove-trailing-blank-lines): Don't remove
- annotations.
-
- * gnus.el ((featurep 'gnus-xmas)): New
- 'gnus-annotation-in-region-p alias.
-
-1998-09-10 06:20:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-with-unibyte-buffer): New function.
-
- * gnus-uu.el (gnus-quote-arg-for-sh-or-csh): Renamed.
-
- * mm-decode.el (mm-inline-media-tests): New variable.
-
- * gnus-sum.el (gnus-summary-exit): Destroy handles.
-
- * gnus-art.el (gnus-article-mime-handles): New variable.
-
- * drums.el (drums-narrow-to-header): New function.
-
- * gnus-art.el (article-decode-charset): Use it.
-
- * drums.el (drums-content-type-get): New function.
-
- * mm-util.el (mm-content-type-charset): Removed.
-
- * drums.el (drums-syntax-table): @ is word.
- (drums-parse-content-type): New function.
-
- * parse-time.el (parse-time-rules): Parse "Wed, 29 Apr 98 0:26:01
- EDT" times.
-
- * gnus-util.el (gnus-date-get-time): Use safe date.
-
- * gnus-sum.el (gnus-show-mime): Removed.
- (gnus-summary-toggle-mime): Removed.
-
- * gnus-art.el (gnus-strict-mime): Removed.
- (gnus-article-prepare): Don't do MIME.
- (gnus-decode-encoded-word-method): Removed.
- (gnus-show-mime-method): Removed.
-
-Thu Sep 10 04:03:29 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.24 is released.
-
-1998-09-10 01:58:24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-show-article): Don't decode chars if
- PREFIX.
-
- * parse-time.el (parse-time-rules): Accept times that look like
- "h:mm".
-
- * message.el (message-make-date): Use zone properly.
-
- * gnus.el: Autoload gnus-batch.
-
- * gnus-art.el (article-de-quoted-unreadable): Do not do
- gnus-article-decode-rfc1522.
-
- * gnus-msg.el (gnus-inews-do-gcc): Use it.
-
- * gnus-int.el (gnus-request-accept-article): Accept a no-encode
- param.
-
- * message.el (message-encode-message-body): Check for us-ascii.
-
- * gnus-msg.el (gnus-extended-version): Move Gnus version comments
- to the left.
-
-1998-09-09 13:18:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-charset): Rename.
-
-Wed Sep 9 12:25:48 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.23 is released.
-
-1998-09-09 12:14:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-parent-id): Ditto.
- (gnus-put-text-property-excluding-newlines): Ditto.
-
- * gnus-sum.el (gnus-dependencies-add-header): Make into subst.
-
-1998-09-08 Karl Kleinpaste <karl@jprc.com>
-
- * message.el (message-generate-headers): Generate User-Agent
- instead of X-Mailer & X-Newsreader.
-
- * gnus-msg.el (gnus-extended-version): Reformat for USEFOR
- User-Agent header format.
-
-Tue Sep 8 22:38:27 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.22 is released.
-
-1998-09-08 22:36:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-multibyte-p): Typo.
-
-Tue Sep 8 22:25:53 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.21 is released.
-
-1998-09-08 Hrvoje Niksic <hniksic@srce.hr>
-
- * gnus-art.el (article-treat-dumbquotes): Handle \224 correctly.
-
-1998-09-08 22:18:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el (mm-multibyte-p): New function.
-
-Tue Sep 8 21:43:03 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.20 is released.
-
-1998-09-08 11:40:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-decode-region): Only decode when in
- multibyte.
-
- * nnheader.el (nnheader-pathname-coding-system): Changed to binary.
-
- * gnus-int.el (gnus-request-replace-article): Encode.
- (gnus-request-accept-article): Encode.
-
- * gnus-art.el (gnus-request-article-this-buffer): Decode charsets
- here.
-
- * gnus.el (gnus-article-display-hook): Take the charset functions
- out.
-
- * time-date.el (safe-date-to-time): New function.
-
- * gnus-util.el (gnus-dd-mmm): Protect against bogus dates.
-
-Tue Sep 8 07:09:28 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.19 is released.
-
-1998-09-08 04:51:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * base64.el (base64-encode-region): Accept no-line-break.
-
- * mm-util.el (mm-mime-charset): New function.
-
- * gnus-draft.el (gnus-draft-edit-message): Delete article.
-
-Tue Sep 8 04:29:23 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.18 is released.
-
-1998-09-08 02:21:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-and-exit): Return t on success.
- (message-make-date): Make a proper time zone.
-
- * gnus-draft.el (gnus-draft-send): Only remove article if the
- sending is successful.
-
- * drums.el (drums-get-comment): Return the last comment.
- (drums-parse-address): Parse old-style From headers.
-
-1998-09-07 SL Baur <steve@altair.xemacs.org>
-
- * gnus-sum.el (gnus-data-compute-positions): Move below
- `gnus-save-hidden-threads' so the former is correctly detected as
- a macro.
-
-1998-09-06 Dave Love <fx@gnu.org>
-
- * gnus/nnweb.el (require): Wrap requirement of w3 and url in
- ignore-errors too, eval'd when compile. Require w3 stuff at load
- time for nicer failure if it's not available.
-
-1998-09-08 00:38:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el (time-to-seconds): Renamed.
-
- * parse-time.el (parse-time-string): Downcase before handling.
- (parse-time-rules): Times without seconds have 0 seconds.
-
- * rfc2047.el (rfc2047-encode-region): New version.
- (rfc2047-dissect-region): New function.
-
-1998-09-07 01:08:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-date): Use symbolic zone.
-
-1998-09-06 23:23:06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el (parse-time): Always use parse-time.
-
- * parse-time.el (parse-time-syntax): Use vectors.
-
-Sun Sep 6 21:19:26 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.17 is released.
-
-1998-09-06 05:45:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * time-date.el: Renamed from "date".
-
- * gnus.el: Removed all timezone dependencies.
-
- * score-mode.el: Removed.
- (gnus-score-edit-insert-date): Use date.
-
- * date.el (float-to-time): New function.
-
- * nnspool.el (nnspool-seconds-since-epoch): Removed.
-
- * date.el (time-to-float): New function.
-
- * message.el (message-make-date): Use format-time-string.
- (message-make-expires): Use make-date.
-
- * gnus-xmas.el (gnus-xmas-seconds-since-epoch): Removed.
-
- * gnus-util.el (gnus-dd-mmm): Use date.
- (gnus-sortable-date): Ditto.
-
- * message.el (message-make-date): Take an optional time.
-
- * gnus: Applied patches from 5.6.43.
-
- * date.el (if): Use parse-time.
-
- * gnus-score.el (gnus-summary-score-entry): Make into a command
- again.
-
- * gnus-group.el (gnus-group-get-new-news-this-group): Only call if
- gnus-agent.
-
- * gnus.el (gnus-agent-meta-information-header): Moved here.
-
-1998-09-05 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-scoreable-headers): New variable.
- (gnus-agent-fetch-group-1): Score article headers using normal
- group score files if the download score rule of a category/group
- is `file'.
- (gnus-agent-fetch-group-1): Don't parse the entire .overview when
- deciding what articles to download.
- (gnus-agent-fetch-group-1): Don't push headers through scoring and
- predicate processing if predicate is `true' or `false'.
-
-1998-09-06 01:56:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-load-score-alist): Bind coding system.
-
- * gnus-art.el (gnus-article-setup-buffer): Enable multibyte.
-
- * score-mode.el (score-mode-coding-system): New variable.
- (gnus-score-edit-exit): Use it.
-
-1998-09-04 Jason R Mastaler <jason@4b.org>
-
- * drums.el: Corrected typo.
-
-1998-09-05 23:24:43 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mm-bodies.el (mm-body-encoding): Faster version.
-
-1998-09-05 22:23:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Only decode text
- things.
-
- * message.el (message-output): Use rmail.
-
- * rfc2047.el (rfc2047-encoded-word-regexp): Allow spaces in the
- word part.
-
- * mm-util.el (mm-charset-to-coding-system): Use
- rfc2047-default-charset.
- (mm-known-charsets): New variable.
-
- * message.el (message-caesar-region): Bugged out.
-
-1998-09-06 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Allow lists when
- specifying `agent-predicate' in a group's parameters.
-
-Sat Sep 5 21:55:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.16 is released.
-
-1998-09-05 17:30:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-expired-article-p): Use predicate.
-
- * date.el (time-less-p): Renamed.
-
- * gnus-art.el (gnus-article-decode-charset): Really fetch headers
- from the headers.
-
- * rfc2047.el (rfc2047-decode-region): Use the mm decoding
- functions.
-
- * gnus-group.el (gnus-group-sort-selected-flat): Didn't work at
- all.
- (gnus-group-sort-selected-groups-by-alphabet): Changed interface
- to all functions.
-
-Sat Sep 5 01:45:52 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.15 is released.
-
-1998-09-05 00:21:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * date.el: New file.
-
- * gnus-util.el (gnus-encode-date): Removed.
- (gnus-time-less): Ditto.
-
- * nnmail.el (nnmail-date-to-time): Removed.
- (nnmail-time-less): Ditto.
- (nnmail-days-to-time): Ditto.
- (nnmail-time-since): Ditto.
-
- * drums.el: New file.
-
-1998-09-04 00:25:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Encode headers with
- body encoding.
-
- * rfc2047.el (rfc2047-default-charset): Renamed.
- (rfc2047-encodable-p): Use it.
-
- * base64.el (mm-util): Required.
-
-1998-09-03 16:28:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-post-method): Peel off real info from opened
- servers.
-
- * gnus-util.el (gnus-output-to-rmail): Removed.
-
- * gnus-art.el (gnus-summary-save-in-rmail): Use
- gnus-output-to-rmailrmail-output-to-rmail-file.
-
- * rfc2047.el (rfc2047-decode-region): Fold case.
- (rfc2047-decode): Use decode-string.
-
- * mm-util.el: Provide mm-char-int.
-
-Thu Sep 3 15:23:22 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.14 is released.
-
-1998-09-03 15:08:30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-body-encoding): Go through the buffer to make
- sure we have 7bit.
-
-1998-09-02 14:38:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-post-method): Use opened servers, and remove
- ducplicates.
- (gnus-inews-insert-mime-headers): Removed.
-
- * message.el (message-caesar-region): Protect against MULE chars.
-
-1998-09-02 00:36:23 Hallvard B. Furuseth <h.b.furuseth@usit.uio.no>
-
- * mm-util.el (if): fset the right function.
-
-1998-09-02 00:31:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Use real
- read-coding-system.
-
-1998-09-01 17:58:40 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Protect against malformed
- base64.
- (mm-decode-body): Check that buffer-file-coding-system is
- non-nil.
-
-Tue Sep 1 10:29:33 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.13 is released.
-
-1998-09-01 09:14:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-strip-whitespace): Already defined.
- Removed.
-
- * gnus-art.el (gnus-article-decode-charset): Strip whitespace.
-
- * gnus-util.el (gnus-strip-whitespace): New function.
-
- * mm-util.el (mm-content-type-charset): Downcase.
-
-1998-08-31 23:04:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-charset): Accept a prefix.
- (gnus-article-decode-charset): Don't fetch all headers.
-
- * mm-util.el (mm-read-coding-system): New function.
-
- * mm-bodies.el (mm-decode-body): Check the right charset.
-
- * gnus-sum.el (gnus-summary-mode-line-format): Ditto.
-
- * gnus-art.el (gnus-article-mode-line-format): Use short group
- format.
-
-Mon Aug 31 23:03:13 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.12 is released.
-
-1998-08-31 22:39:36 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-bodies.el (mm-decode-body): Don't do charset unless MULE.
-
- * gnus-art.el (gnus-article-decode-charset): Supply cte.
- (gnus-article-decode-charset): Always run.
-
- * mm-bodies.el (mm-decode-body): Decode cte.
-
-Mon Aug 31 22:14:50 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.11 is released.
-
-1998-08-31 14:27:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-encode-message-body): Ditto.
-
- * gnus-art.el (gnus-article-decode-mime-words): New command and
- keystroke.
- (gnus-article-decode-charset): Ditto.
- (gnus-article-decode-charset): Only work under MULE.
-
- * mm-util.el (mm-content-type-charset): New function.
-
- * nnmail.el (nnmail-delete-incoming): Changed to nil.
-
- * message.el (message-send-mail): Insert MIME headers.
- (message-check-news-body-syntax): Don't warn for escape sequences.
- (message-check-news-body-syntax): Insert MIME headers.
-
- * mm-bodies.el (mm-body-encoding): New function.
-
- * message.el (message-encode-message-body): New function.
-
- * mm-bodies.el: New file.
-
- * mm-util.el (mm-narrow-to-head): New function.
-
- * rfc2047.el (rfc2047-encode): Use it.
-
- * mm-util.el: Provide mm-encode-coding-region.
-
- * gnus-sum.el (gnus-summary-mode): Enable multibyte.
-
- * gnus-util.el (gnus-set-work-buffer): Enable multibyte.
-
- * mm-util.el (mm-enable-multibyte): New function.
-
- * message.el (message-set-work-buffer): Set multibyte.
-
- * gnus.el (gnus-continuum-version): Be valid forever and ever.
-
- * gnus-util.el (gnus-point-at-eol): Removed.
- (gnus-point-at-bol): Ditto.
-
- * base64.el (base64-decode-region): Commented out messaging.
-
-1998-08-31 Didier Verna <verna@inf.enst.fr>
-
- * gnus-msg.el (gnus-group-mail): make it behave like
- gnus-group-post-news with regards to the prefix (this enables the
- use of posting styles).
-
-1998-08-31 12:53:32 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-article-display-hook): Added
- gnus-article-decode-rfc1522 to hook.
-
-Mon Aug 31 12:43:46 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.10 is released.
-
-1998-08-31 11:45:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnfolder.el (nnfolder-delete-mail): Narrow to mail and allow
- hook to be run.
-
-1998-08-30 17:59:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encodable-p): Use find-charset-region.
-
- * mm-util.el (mm-charsets-in-region): Removed.
-
- * rfc2047.el: Renamed file.
-
- * gnus-msg.el (gnus-copy-article-buffer): Multibyte.
-
- * message.el (message-mode): Set multibyte.
-
- * mm-util.el (mm-charsets-in-region): Copied here.
-
- * gnus-util.el: Removed gnus-truncate-string.
-
- * gnus-art.el (gnus-article-decode-mime-words): Use 1522.
-
- * rfc1522.el (rfc1522-unencoded-charsets): New variable.
- (rfc1522-encodable-p): New function.
- (rfc1522-encode-message-header): Use it.
-
-Sun Aug 30 17:46:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.9 is released.
-
-1998-08-30 16:13:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-util.el: Shadow encode-coding-string.
-
- * base64.el (base64-encode-region): Don't add newline.
-
- * rfc1522.el (rfc1522-narrow-to-field): Copied here.
-
- * mm-util.el: New file.
-
- * mm-decode.el: Somewhat depleted.
- * mm-encode.el: Ditto.
-
- * rfc1522.el: New file.
-
- * mm-util.el (mm-replace-chars-in-string): Copied here.
-
- * mm-encode.el (mm-q-encode-region): New function.
-
- * qp.el (quoted-printable-encode-region): Take an optional CLASS
- param.
-
- * mm-encode.el (mm-encode-word-region): Downcase.
-
-Sun Aug 30 15:28:01 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.8 is released.
-
-1998-08-30 12:23:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-mail): Encode headers.
-
- * qp.el (quoted-printable-encode-region): Encode 8-bit words.
- (quoted-printable-encode-region): Upcase.
-
- * message.el (message-default-charset): New variable.
-
- * qp.el (quoted-printable-encode-region): Optional param FOLD.
-
- * message.el (message-narrow-to-field): Changed name.
-
- * mm-encode.el: New file.
-
- * message.el (message-narrow-to-header): New function.
-
- * gnus-art.el (gnus-article-decode-mime-words): Place point in the
- right buffer.
-
-Sun Aug 30 12:15:54 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.7 is released.
-
-1998-08-30 01:26:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Remove autoload for
- gnus-article-mime-decode-quoted-printable.
-
- * mm-decode.el (mm-charset-to-coding-system): Allow iso-8859-1 to
- be decoded in non-MULE Emacsen.
-
- * gnus-xmas.el (gnus-xmas-logo-color-alist): More brown.
-
-1998-08-29 SL Baur <steve@altair.xemacs.org>
-
- * gnus-xmas.el (gnus-xmas-logo-color-alist): Try shades of brown.
-
-1998-08-30 01:04:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-decode.el: Check for coding-system-list.
-
-Sun Aug 30 00:59:15 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.6 is released.
-
-1998-08-30 00:36:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (fboundp): Protect code-coding-string.
-
- * gnus-art.el (gnus-article-mode): Check that set-buffer-multibyte
- is available.
-
-Sat Aug 29 23:24:31 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Pterodactyl Gnus v0.5 is released.
-
-1998-08-29 22:38:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode): Make article buffer multibyte.
- (gnus-hack-decode-rfc1522): Removed.
-
- * mm-decode.el (mm-charset-coding-system-alist): Check better.
-
-Sat Aug 29 22:20:39 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Gnus v0.4 is released.
-
-1998-08-29 20:53:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-decode-mime-words): New command and
- keystroke.
-
- * qp.el (quoted-printable-decode-region): Don't use hexl.
-
- * gnus-xmas.el (gnus-xmas-logo-color-style): Changed to dino.
-
- * gnus-sum.el (gnus-parse-headers-hook): Default to nil.
- (gnus-structured-field-decoder): Removed.
- (gnus-unstructured-field-decoder): Ditto.
-
- * mm-decode.el: New file.
-
- * qp.el: New file.
-
- * gnus-art.el (article-mime-decode-quoted-printable): Removed.
-
- * gnus-ems.el (fboundp): Removed gnus-split-string.
-
- * gnus.el (gnus-splash-face): Doc fix.
-
- * gnus-ems.el (fboundp): Don't bind mail-file-babyl-p.
-
- * gnus-art.el (article-mime-decode-quoted-printable): Don't use
- hexl.
-
- * nnheader.el (nnheader-temp-write): Removed.
-
-Sat Aug 29 20:34:17 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Gnus v0.3 is released.
-
-Sat Aug 29 19:32:06 1998 Lars Magne Ingebrigtsen <larsi@menja.ifi.uio.no>
-
- * gnus.el: Gnus v0.2 is released.
-
- Copyright (C) 1998, 1999, 2000 Free Software Foundation, Inc.
- Copying and distribution of this file, with or without modification,
- are permitted provided the copyright notice and this notice are preserved.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; End:
-
-;;; arch-tag: bc9bf70e-b352-4a38-9dec-edce4b023b22
+++ /dev/null
-2004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.6 is released.
-
-2004-01-04 Kai Grossjohann <kai@emptydomain.de>
-
- * gnus-sum.el (gnus-summary-print-article): Doc fix.
-
-2004-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2004-01-04 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.5 is released.
-
-2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-face-from-file): Message 9.
-
-2004-01-03 Romain FRANCOISE <romain@orebokech.com>
-
- * gnus-fun.el (gnus-face-from-file): Use gnus-message.
-
-2004-01-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-mid-or-mail-heuristic): Treat Gmane
- addresses specially. Fix returned value and messages.
-
- * mm-decode.el (mm-enable-external): New variable.
- (mm-display-part): Use it.
- (mm-display-external): Fix message in case of nil handle.
-
- * Update copyright for several files.
-
- * spam-report.el (spam-report-gmane): Adjust verbosity.
- Delete trailing whitespace. Update copyright.
-
- * spam.el: Fix many (but not all) checkdoc complaints.
- Delete trailing whitespace.
-
- * message.el (message-header-synonyms): Defcustom.
- (message-get-reply-headers): Catch `Original-To'.
- (message-carefully-insert-headers): Added comment.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Improved "Washing" menu.
-
-2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-select-newsgroup): Use cat.
-
- * gnus-agent.el (gnus-agent-cat-enable-undownloaded-faces): New
- cat.
-
- * gnus.el (gnus-user-agent): Moved here.
-
- * gnus-msg.el (gnus-user-agent): Moved from here.
-
- * gnus.el (gnus-version-number): Bump.
-
-2004-01-03 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.4 is released.
-
-2004-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-mode-line-buffer-identification): Show version in
- help-echo.
- (gnus-read-group): Allow most group names. Changed warning.
-
-2004-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-dired.el (gnus-dired-mode-map): Change keymaps.
-
-2004-01-02 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * smime.el (smime-crl-check): Doc fix.
-
-2004-01-02 Edwin Steiner <edwin.steiner@gmx.net> (tiny change)
-
- * gnus-nocem.el (gnus-nocem-enter-article): Use the real group
- hashtb.
-
-2004-01-02 Michael Albinus <Michael.Albinus@alcatel.de>
-
- * nnml.el (nnml-save-mail): Grok compressed articles.
-
-2004-01-02 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-copy-or-move-routine): use spam-list-articles
- (spam-list-articles): rewritten to only check a mark once per
- invocation
-
-2004-01-01 Simon Josefsson <jas@extundo.com>
-
- * mml-sec.el (mml-default-encrypt-method)
- (mml-default-sign-method): Defcustom.
-
-2003-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml.el (mml-generate-mime-1): Remove extra ).
-
- * gnus-group.el (gnus-group-set-current-level): Signal errors on
- topic lines.
- (gnus-group-set-current-level): Fix fix.
-
-2003-12-31 Jeremy Maitin-Shepard <jbms@attbi.com>
-
- * mml.el (mml-generate-mime-1): Use mml-compute-boundary (tiny
- change).
-
-2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el: Removed `(when t ...)' around `gnus-define-keys'.
- (gnus-group-group-map): Added `gnus-group-read-ephemeral-group'
- (already in previous commit inadvertently).
- (gnus-group-make-menu-bar): Added `gnus-group-read-ephemeral-group'.
- (gnus-group-read-ephemeral-group): Made interactive.
-
- * gnus-score.el (gnus-score-find-trace): Added comment on sync
- with `gnus-score-edit-file-at-point'.
-
- * gnus-logic.el (gnus-score-advanced): Ditto.
-
- * gnus-score.el (gnus-score-edit-file-at-point): Fix for
- advanced scoring.
-
-2003-12-30 Simon Josefsson <jas@extundo.com>
-
- * gnus-score.el (gnus-score-edit-file-at-point): Use
- gnus-point-at-*, for portability.
-
-2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-treat-body-boundary): Fix doc-string and
- custom type.
- (gnus-button-mid-or-mail-regexp): Don't be too restrictive.
- Suggested by Felix Wiemann <Felix.Wiemann@gmx.net>.
- (gnus-button-alist): Added "M-x ... RET" and "mid:" buttons.
- Added comments about relevant RFCs.
-
- * gnus-sum.el (gnus-summary-mode): Untabify doc-string.
- (gnus-summary-goto-article): Allow `%40'.
- (gnus-summary-refer-article): Convert `%40' to `@'.
-
-2003-12-30 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * smime.el (smime-crl-check): New.
- (smime-verify-region): Use it.
-
-2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- (gnus-score-find-trace): Use gnus-score-edit-file-at-point. Added
- `f' and `t' commands, added quick help. With some suggestions
- from Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>.
-
- * gnus-util.el (gnus-emacs-version): Added doc-string.
-
- * mml.el (mml-minibuffer-read-disposition): New function.
- (mml-attach-file): Use it.
- (mml-preview): Added MIME preview to gnus-buffers.
-
-2003-12-30 Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>
-
- * gnus-score.el (gnus-score-edit-file-at-point): Consider the
- whole match element.
-
-2003-12-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add ellipses.
-
-2003-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-get-unread-articles): Inline gnus-server-get-method.
- (gnus-get-unread-articles): Cache methods.
- (gnus-get-unread-articles-in-group): Indent.
-
- * gnus.el (gnus-version-number): Bump.
- (gnus-secondary-method-p): Extend servers to methods before comparing.
- (gnus-secondary-method-p): Revert.
-
-2003-12-30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.3 is released.
-
-2003-12-29 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agentize): Improve auto-agentizing logic.
- Suggested by Steinar Bang <sb@dod.no>.
- (gnus-agent-auto-agentize-methods): Customize.
-
-2003-12-29 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus.el (gnus-server-to-method): Fixed bug in 2003-12-22
- check-in.
-
-2003-12-28 Adrian Lanz <lanz@fowi.ethz.ch>
-
- * mail-source.el (mail-source-fetch-imap): Prevent storing of
- identical entries for imap mail sources, when retrieving mail
- messages from an imap server within the same Gnus session several
- times (tiny change).
-
-2003-12-28 Jesper Harder <harder@ifa.au.dk>
-
- * mm-view.el (mm-text-html-washer-alist): Use
- mm-inline-wash-with-stdin for w3m-standalone.
-
- * mm-decode.el (mm-text-html-renderer): Add w3m-standalone.
-
- * mml1991.el (mml1991-pgg-encrypt): Decode according to CTE before
- encrypting.
-
-2003-12-28 Ivan Boldyrev <boldyrev@uiggm.nsc.ru> (tiny change).
-
- * mml1991.el (mml1991-pgg-sign): Use unibyte when re-encoding.
-
-2003-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el: Add an advice to byte-optimize-form-code-walker to
- avoid the warning ``...called for effect'' for the pop form when
- running Emacs 21.3.
-
-2003-12-26 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-body-encoding): Don't use 7bit if the body
- contains "^From " and mm-use-ultra-safe-encoding is true.
-
-2003-12-25 Jesper Harder <harder@ifa.au.dk>
-
- * mml1991.el (mml1991-pgg-sign): Encode and decode according to
- CTE header. Don't insert gpg output as unibyte.
-
-2003-12-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Remove display-time-event-handler and open-ssl-stream;
- add delete-extent for Emacs; rearrange bindings assuming w3 may
- not be available and XEmacs without the file-coding feature may be
- used.
-
-2003-12-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (dgnushack-compile): Increase the value for
- max-specpdl-size when compiling Gnus with Emacs 20.
-
-2003-12-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-int.el (gnus-open-server): Fixed the server status such
- that an agentized server, when opened offline, has a status of
- offline. Also fixes bug whereby the agent's backend was called
- twice to open each server.
-
- * gnus-start.el (gnus-get-unread-articles-in-group): Autoload
- gnus-agent-possibly-alter-active rather than inline to resolve
- compiler warnings.
-
- * gnus.el (gnus-server-to-method): Added fallback of iterating
- over gnus-newsrc-alist to resolve names of foreign servers.
- Should fix recent agent bug.
-
-2003-12-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-score.el (gnus-summary-lower-score)
- (gnus-summary-increase-score): Mention symbolic prefix in the
- doc-string. Suggested by Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>.
-
-2003-12-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-agent.el (gnus-agent-read-agentview): Use
- car-less-than-car.
-
-2003-12-20 Artem Chuprina <ran@ran.pp.ru> (tiny change)
-
- * message.el (message-yank-buffer): Bind message-reply-buffer to
- a buffer rather than a string.
-
-2003-12-19 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-summary-followup): Correct documentation.
-
-2003-12-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-inews-add-send-actions): `yanked' can be a
- list of lists. Reported by Dmitri Paduchikh <paduch@imm.uran.ru>.
-
-2003-12-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-url.el (mm-url-insert-file-contents-external)
- (mm-url-insert-file-contents): Added doc-strings. Autoload.
-
-2003-12-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-cus.el (defvar): defvar
- gnus-agent-cat-disable-undownloaded-faces.
-
-2003-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-forward-subject-name-subject): Use
- gnus-extract-address-components instead of
- mail-header-parse-address because it may be called with non-ascii
- text.
-
-2003-12-16 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-split-fancy): The widget now supports
- restrictions.
-
-2003-12-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-find-etc-directory): Find the newest one.
-
-2003-12-16 Simon Josefsson <jas@extundo.com>
-
- * sha1-el.el (autoload): Don't use ignore-errors.
- (sha1-use-external): Use condition-case. Suggested by Katsumi
- Yamaoka <yamaoka@jpl.org>.
-
-2003-12-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-split-fancy): Make it customizable with Emacs
- 20 as well.
-
-2003-12-15 Simon Josefsson <jas@extundo.com>
-
- * sha1-el.el (autoload): Ignore errors for
- executable-find. (XEmacs ecrypto does not require sh-script where
- executable.el is located.)
- (sha1-use-external): Likewise.
-
- * sha1-el.el (sha1): Add defgroup.
- (sha1-maximum-internal-length, sha1-program, sha1-use-external)
- (sha1-program): Use 'sha1sum' from GNU CoreUtils instead of OpenSSL.
- (sha1): Autoload.
-
- * nndraft.el (nndraft-request-move-article): Copy definition of
- nnmh-request-move-article instead of calling it, because the nnmh
- version uses nnmh-request-article which isn't the same as the
- nndraft version.
-
-2003-12-13 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: added some gnus-registry autoloads
- (spam-split-symbolic-return): makes spam-split return 'spam
- instead of the value of spam-split-group when spam is detected
- (spam-split-symbolic-return-positive): makes spam-split return
- 'ham instead of nil when ham is detected
- (spam-autodetect-recheck-messages): tells spam.el whether it
- should recheck all messages in a group, or only the unseen ones
- (spam-split-last-successful-check): spam-split will set this to
- the last successful check; this was seen as a cleaner approach
- than returning a cell like '(spam spam-use-bogofilter)
- (spam-list-of-checks): documentation appended
- (spam-split): accomodate the spam-split-symbolic-return and
- spam-split-symbolic-return-positive variables
- (spam-find-spam): new function called when the summary is built
- (spam-log-registered-p): checks if a ham or spam registration has
- already been done for an article
- (spam-check-regex-headers, spam-check-blackholes, spam-check-BBDB)
- (spam-check-ifile, spam-check-stat, spam-check-whitelist)
- (spam-check-blacklist, spam-check-bogofilter-headers)
- (spam-check-spamoracle): respect the spam-split-symbolic-return
- and spam-split-symbolic-return-positive variables
- (spam-initialize): add spam-find-spam to gnus-summary-prepare-hook
- (spam-unload-hook): remove spam-find-spam from
- gnus-summary-prepare-hook
-
- * gnus.el (spam-autodetect, spam-autodetect-methods): new
- configuration items for spam autodetection
-
-2003-12-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-draft.el (gnus-draft-mode-map): Bind `e' to
- `gnus-draft-edit-message'. We still have `B w' for
- `gnus-summary-edit-article'.
-
-2003-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheaderxm.el (nnheader-xmas-run-at-time): Use a simple function
- definition if there is not a bug in start-itimer.
-
- * pgg.el (pgg-run-at-time): Ditto.
-
-2003-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-possibly-alter-active): New Function.
- (gnus-agent-regenerate-group): When necessary, alter the group's
- active range to include articles newly recognized as being
- downloaded.
- (gnus-agent-regenerate): Removed code that updated the agent's
- active file as the new gnus-agent-possibly-alter-active function
- obsolesced it.
-
- * gnus-cus.el (gnus-agent-customize-category): Added missing
- agent-disable-undownloaded-faces parameter.
-
- * gnus-start.el (gnus-activate-group): Backed out my 2003-11-29
- patch as it was too late at adjusting the active range.
- (gnus-get-unread-articles-in-group): Added call to new
- gnus-agent-possibly-alter-active to adjust the active range.
-
-2003-12-10 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-get-reply-headers): Narrow to headers.
-
-2003-12-10 L\e,Bu\e(Brentey K\e,Ba\e(Broly <lorentey@elte.hu>
-
- * spam.el (spam-disable-spam-split-during-ham-respool): New
- variable.
- (spam-ham-copy-or-move-routine): Respect
- spam-disable-spam-split-during-ham-respool.
- (spam-split-disabled): New variable.
- (spam-split): Respect spam-split-disabled.
-
-2003-12-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheaderxm.el (nnheader-xmas-run-at-time): Make it work
- correctly for the first argument.
-
- * pgg.el (pgg-run-at-time): New function.
- (pgg-add-passphrase-cache): Use it.
-
-2003-12-10 Simon Josefsson <jas@extundo.com>
-
- * pgg-parse.el (pgg-decode-packets): Rewrite to handle corrupt
- input.
- (pgg-decode-armor-region): Don't parse packet if decoding fail.
-
-2003-12-09 L\e,Bu\e(Brentey K\e,Ba\e(Broly <lorentey@elte.hu>
-
- * spam.el (spam-check-bogofilter): run in the correct buffer.
-
-2003-12-09 Xavier Maillard <zedek@gnu-rox.org>
-
- * spam.el (spam-bogofilter-database-directory): correct
- customization group.
-
-2003-12-09 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * nnmail.el (nnmail-lazy, nnmail-split-fancy): New widgets.
- (nnmail-split-fancy): Use it.
-
-2003-12-08 Joel Ray Holveck <joelh@piquan.org> (tiny change)
-
- * gnus-sum.el (gnus-summary-save-parts-1): Consider the "name"
- parameter of Content-Type.
-
-2003-12-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el: Revert 2003-12-03 change, instead, provide the
- compiler macro for rmail-select-summary if rmail is not available,
- and bind rmail-summary-displayed and rmail-maybe-display-summary
- in order to silence the compiler even if tm is not available.
-
-2003-12-08 Simon Josefsson <jas@extundo.com>
-
- * flow-fill.el (fill-flowed-encode-tests, fill-flowed-test): Add.
-
-2003-12-08 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-extended-version): Bind float-output-format to
- nil.
-
-2003-12-08 Simon Josefsson <jas@extundo.com>
-
- * mml-smime.el (mml-smime-sign): Replace CRLF with LF in OpenSSL
- output. Reported by Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>.
-
-2003-12-07 Lloyd Zusman <ljz@asfast.com> (tiny change)
-
- * pgg-gpg.el (pgg-gpg-recipient-arg): Add.
- (pgg-gpg-encrypt-region): Use it.
-
-2003-12-07 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-recipient-argument): Doc fix.
- Renamed from p-g-r-a.
- (pgg-gpg-encrypt-region): Update.
-
-2003-12-07 Jesper Harder <harder@ifa.au.dk>
-
- * spam.el (spam-check-spamoracle, spam-spamoracle-learn): Don't
- use = or zerop to test the return value of call-process, because
- it can be a string.
-
- * mail-source.el (mail-source-fetch-with-program): do.
-
- * mailcap.el (mailcap-viewer-passes-test): do.
-
- * gnus-uu.el (gnus-uu-treat-archive, gnus-uu-post-encode-mime)
- (gnus-uu-post-encode-file): do.
-
- * gnus-soup.el (gnus-soup-pack, gnus-soup-unpack-packet): do.
-
- * message.el (message-fix-before-sending): Fix detection of
- non-printables. Don't replace unencodable utf-8.
-
-2003-12-05 Jesper Harder <harder@ifa.au.dk>
-
- * mm-url.el (mm-url-predefined-programs): Add user-agent for wget.
- (mm-url-insert-file-contents-external): Signal an error if program
- fails.
-
-2003-12-04 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam-report.el (spam-report-gmane): iterate over articles
- instead of a single one; remove interactive usage
-
-2003-12-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dns.el: Fix misplaced eval-when-compile.
-
- * gnus-util.el: Require alist and provide tm-view when compiling
- with XEmacs.
-
-2003-12-03 Jerry James <james@xemacs.org> (tiny change)
-
- * gnus-xmas.el: Add autoloads for macros defined in gnus.el.
-
- * gnus-util.el: Get rmail definitions when compiling.
-
- * dns.el: Require gnus-xmas at compile time instead of trying to
- autoload `gnus-xmas-open-network-stream' because it wasn't picking
- up the macro.
-
-2003-12-01 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-consider-all-articles): Updated
- docstring.
- (gnus-predicate-implies-unread, gnus-predicate-implies-unread-1):
- Fixed implementation such that the predicate `true' no longer
- evaluates to t.
-
-2003-12-01 Adrian Lanz <lanz@fowi.ethz.ch> (tiny change)
-
- * spam.el (spam-check-bogofilter): check the bogofilter headers
- AFTER the save-excursion scope is over.
-
-2003-12-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-fetch-field-message-id-fast): Doc fix
-
-2003-12-01 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-expire-days): Doc fix.
-
-2003-11-30 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-expire-group-1): Bind message-log-max
- when messaging "X % completed" to inhibit logging them to the
- message buffer.
- (gnus-agent-expire-group-1): Mention group name in messages.
- (gnus-agent-expire-group-1): Only print a message for an article
- when there actually was something done to it.
-
- * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Custom fix.
-
-2003-11-30 Kenichi Handa <handa@m17n.org>
-
- * mm-util.el (mm-enable-multibyte): Call set-buffer-multibyte with
- 'to argument. Fixes something or other in Emacs 22, and is
- backwards compatible.
-
-2003-11-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-covered-methods): Remove nil methods.
-
-2003-11-29 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-start.el (gnus-activate-group): The active range of the
- group must include the articles known to the agent.
-
- * gnus.el (gnus-agent-method-p): Accept a server name as the
- method being tested.
-
-2003-11-29 Alexander Kreuzer <alex@freesources.org> (tiny change)
-
- * nnrss.el (nnrss-check-group): Set xml when nnrss-use-local is t.
-
-2003-11-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-make-menu-bar): Add
- gnus-group-make-rss-group.
-
-2003-11-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el: Added custom-manual links to all variables that have
- an index entry in the message manual.
- (message-generate-headers-first): Fixed doc-string.
-
-2003-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-summary-yank-message): Don't bind
- gnus-display-mime-function to nil so that non-ascii text is
- decoded and attachments are not shown.
-
- * message.el (message-cite-original-without-signature): Replace
- the value of message-reply-headers with the yanked article since
- it may be a different article from the original.
- (message-cite-original): Ditto.
-
-2003-11-25 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-blacklist-ignored-regexes): new variable, so
- blacklisting can ignore certain regular expressions (e.g. the
- user's e-mail address)
- (spam-bogofilter-spam-strong-switch,
- spam-bogofilter-ham-strong-switch): options used when articles are
- already registered as the opposite classification
- (spam-old-ham-articles, spam-old-spam-articles): lists of ham and
- spam articles, generated when a summary buffer is entered, and
- consulted when it's exited so we know what articles are changing
- state from spam to ham or vice-versa
- (spam-xor): everyone needs a little convenience
- (spam-list-of-processors): lookup table for old-style spam/ham
- exits processors
- (spam-group-processor-p): support old-style and new-style spam/ham
- exit processors
- (spam-group-processor-multiple-p): handle new-style spam/ham exit
- processors
- (spam-summary-prepare): use spam-old-{ham,spam}-articles; change
- logic to iterate over list of processors instead of manual
- individual lookup, unregister any articles that change from ham to
- spam or vice-versa in the course of the summary buffer usage; use
- the new spam-register-routine
- (spam-ham-copy-routine, spam-ham-move-routine,
- spam-mark-spam-as-expired-and-move-routine): check that the list
- of groups is not nil, because apply doesn't like to apply a
- function across nil
- (spam-registration-functions): variable for looking up spam/ham
- registration/unregistration functions based on a spam-use-* symbol
- (spam-classification-valid-p, spam-process-type-valid-p)
- (spam-registration-check-valid-p)
- (spam-unregistration-check-valid-p): convenience functions
- (spam-registration-function, spam-unregistration-function): look
- up the registration/unregistration function based on a
- classification and the check (spam-use-* symbol)
- (spam-list-articles): generate list of spam/ham articles from a
- given list of articles
- (spam-register-routine): do the heavy work of registering and
- unregistering articles, using all the articles in the group or
- specific ones as needed
- (spam-generic-register-routine): removed, no longer used
- (spam-log-unregistration-needed-p, spam-log-undo-registration):
- handle article registration/unregistration with a given spam/ham
- processor and group
- (BBDB, ifile, spam-stat, blacklists, whitelists, spam-report,
- bogofilter, spamoracle): rewrite registration/unregistration
- functions to take a list of articles and the unregister option.
- Much hilarity ensues.
- (spam-initialize): spam-stat-maybe-{save,load} already respect spam-use-stat
- (spam-stat-register-ham-routine, spam-stat-register-spam-routine):
- don't load and save unnecessarily
-
- * spam-stat.el (spam-stat-dirty): new variable, set when the stats
- database is modified
- (spam-stat-buffer-is-spam, spam-stat-buffer-is-non-spam)
- (spam-stat-buffer-change-to-spam, spam-stat-to-hash-table)
- (spam-stat-buffer-change-to-non-spam): set spam-stat-dirty when
- needed
- (spam-stat-save): respect spam-stat-dirty, unless the force
- parameter is specified
- (spam-stat-load): clear spam-stat-dirty
-
- * gnus.el (gnus-install-group-spam-parameters): marked the
- old-style exit processors as obsolete in the docs, added the
- new-style exit processors while the old ones are still allowed
-
-
-2003-11-25 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (article-hide-boring-headers): Don't hide Reply-To
- unless its list of addresses is identical to From.
-
-2003-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (mapc): Add the compiler macro for Emacs 20.
-
-2003-11-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-srvr.el (gnus-server-insert-server-line): The server names
- used in gnus-agent are different (for example, the native server
- uses the alias "native") from the names in gnus-srvr.
- Compensating by adding a second text property storing the name
- expected by gnus-agent.
- (gnus-server-named-server): New function.
- * gnus-agent.el (gnus-agent-remove-server, gnus-agent-add-server):
- No longer expect an argument as it was ignored anyway. Uses the
- new gnus-server-named-server function to get gnus-agent compatible
- names from the server buffer.
-
-2003-11-20 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.el (gnus-agent-covered-methods): Documented use of
- named servers, not methods, to identity agentized groups.
- Users may now change their server configurations without having
- the server become "unagentized".
- (gnus-agent-covered-methods): Removed from gnus-variable-list to
- avoid storing two copies of gnus-agent-covered-methods, one in
- .newsrc.eld and the other in agent/lib/servers.
- (gnus-server-to-method): Do not cache server for the nil method.
- (gnus-method-to-server): New function. Associate named server
- with all, even foreign, methods.
- (gnus-agent-method-p, gnus-agent-method-p-cache): Incorporated
- simple last-response cache to offset performance lose of having to
- always convert methods to named servers.
- * gnus-agent.el (gnus-agent-expire-days): Removed obsolete
- documentation.
- (gnus-agentize, gnus-agent-add-server, gnus-agent-remove-server):
- Modified to support new definition of gnus-agent-covered-method.
- (gnus-agent-read-servers): Rewritten to convert old method data
- into server names.
- (gnus-agent-read-servers-validate)
- (gnus-agent-read-servers-validate-native): New functions.
- (gnus-agent-write-servers): No longer use gnus-method-simplify as
- it failed to simplify foreign methods.
- (gnus-agent-close-connections, gnus-agent-synchronize-flags)
- (gnus-agent-possibly-synchronize-flags, gnus-agent-fetch-session)
- (gnus-agent-regenerate): Uses new gnus-agent-covered-methods
- function as gnus-agent-covered-methods variable no longer provides
- methods.
- (gnus-agent-covered-methods): New function
- (gnus-agent-expire-group, gnus-agent-expire): Final message will,
- if gnus-verbose is greater than 4, report statistics of NOV
- entries and files deleted as well as total bytes recovered.
- (gnus-agent-expire-done-message): New function
- (gnus-agent-unread-articles): Bug fix. No longer drops last
- unread article onto read list.
- (gnus-agent-regenerate-group): Changed prompt to use typical
- style.
- (gnus-agent-group-covered-p): Rewrote to internally use
- gnus-agent-method-p.
- * gnus-int.el (gnus-start-news-server): Partially convert old
- gnus-agent-covered-methods to new format so that gnus-open-server
- functions correctly.
- * gnus-srvr.el (gnus-server-insert-server-line): Replaced
- gnus-agent-covered-methods with gnus-agent-method-p.
- * gnus-start.el (gnus-clear-system): Added
- gnus-agent-covered-methods to compensate for removing it from
- gnus-variable-list.
- (gnus-setup-news): Complete conversion of old
- gnus-agent-covered-methods to new format so that secondary and
- foreign servers can be correctly opened.
-
-2003-11-20 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-copy-or-move-routine): add respooling
- support, not working well yet
-
- * gnus.el (ham-process-destination): make 'respool option the
- only one, so it can't be chosen together with other groups
-
-2003-11-19 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-track-extra): make it a set of
- choices instead of a boolean
- (gnus-registry-track-subject-p, gnus-registry-track-sender-p):
- new convenience functions
- (gnus-registry-split-fancy-with-parent): use convenience
- functions, also don't return extra tracking info if sender or
- subject is found in more than one groups
- (gnus-registry-add-group): use new convenience functions to
- decide if sender and subject should be tracked
-
- * gnus.el (ham-process-destination): add 'respool option,
- unused by spam.el yet
-
-2003-11-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-score.el (gnus-decay-score): Return a surely smaller value
- than the argument in XEmacs.
-
-2003-11-18 Sam Steingold <sds@gnu.org>
-
- * message.el (message-insert-to): Don't use `gnus-message'.
- (message-header-synonyms): New variable.
- (message-carefully-insert-headers): Use it (check for synonyms).
- Added doc-string.
-
-2003-11-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * html2text.el (html2text-remove-tags): Remove the tag in a
- simpler way to avoid inflooping.
-
-2003-11-17 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-gssapi-auth-p): Don't check capability (some
- servers remove AUTH=GSSAPI from capability response returned after
- successful authentication).
-
-2003-11-16 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-getenv-nntpserver): Fix regexp and simplify.
- Reported by Artem Chuprina <ran@ran.pp.ru>.
-
-2003-11-14 Simon Josefsson <jas@extundo.com>
-
- * mm-util.el (mm-charset-synonym-alist): Map BIG5-HKSCS to BIG5
- when it isn't available.
-
-2003-11-13 Alex Schroeder <alex@gnu.org>
-
- * nnrss.el (nnrss-check-group): Use dc:contributor if neither
- rss:author nor dc:creator is provided.
-
-2003-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-dissect-buffer): Save start="<id>" value
- contained in Content-Type header of multipart/related messages.
-
- * mm-view.el (mm-w3m-cid-retrieve-1): New function.
- (mm-w3m-cid-retrieve): Use it.
-
- * mml.el (mml-generate-mime-1): Add start="<id>" to Content-Type.
- (mml-insert-mime-headers): Insert Content-ID header.
- (mml-insert-mml-markup): Insert start="<id>" value.
-
-2003-11-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * nnml.el (nnml-request-accept-article): pass sender to
- nnmail-cache-insert
-
- * nnmh.el (nnmh-request-accept-article): pass sender to
- nnmail-cache-insert
-
- * nnmbox.el (nnmbox-request-accept-article): pass sender to
- nnmail-cache-insert
-
- * nnfolder.el (nnfolder-request-accept-article): pass sender to
- nnmail-cache-insert
-
- * nnbabyl.el (nnbabyl-request-accept-article): pass sender to
- nnmail-cache-insert
-
- * nnmail.el (nnmail-cache-insert): accept sender parameter and
- pass it to the nnmail-spool-hook
-
- * gnus-registry.el (gnus-registry-track-extra): clarify doc
- (gnus-registry-action): add sender lexical var and pass it to
- gnus-registry-add-group
- (gnus-registry-spool-action): take a sender parameter, pass to
- gnus-registry-add-group
- (gnus-registry-split-fancy-with-parent): trace by sender in
- addition to subject
- (gnus-registry-fetch-sender-fast): new function
- (gnus-registry-add-group): accept sender parameter
-
-2003-11-11 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-copy-routine, spam-ham-move-routine)
- (spam-mark-spam-as-expired-and-move-routine): allow for the
- groups to be a list of a single item
-
- * gnus.el (gnus-install-group-spam-parameters):
- ham-process-destination and spam-process-destination allow lists now
-
-2003-11-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-mode-field-menu): Moved some entries, added
- `message-insert-wide-reply'.
- (message-change-subject): Fixed comment.
-
-2003-11-10 Sam Steingold <sds@gnu.org>
-
- * message.el (message-insert-to): Do error out when the user
- requested no Cc. Don't insert empty To. Can be added to
- `message-setup-hook' now.
-
-2003-11-10 Simon Josefsson <jas@extundo.com>
-
- * pgg-def.el (pgg-encrypt-for-me): Change default from nil to t.
-
-2003-11-09 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Cache passphrase under hex
- key id too (for decryption).
- (pgg-gpg-sign-region): Likewise.
-
-2003-11-09 Satyaki Das <satyakid@stanford.edu>
-
- * pgg-gpg.el (pgg-gpg-all-secret-keys): New variable.
- (pgg-gpg-lookup-all-secret-keys): New function.
- (pgg-gpg-select-matching-key): Likewise.
- (pgg-gpg-decrypt-region): Use new functions.
-
-2003-11-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * nnmail.el (nnmail-cache-insert): make sure that the
- nnmail-spool-hook is called with a valid newsgroup name (though
- it may be wrong)
-
- * gnus.el (gnus-group-real-prefix): return nil if group is not a
- string, instead of triggering an error
-
-2003-11-06 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.el (gnus-group-guess-full-name-from-command-method): new function
-
- * gnus-registry.el (gnus-registry-fetch-group): use long names if
- requested
- (gnus-registry-split-fancy-with-parent): when long names are in
- use, strip the name if we're in the native server, or else return nothing
- (gnus-registry-spool-action, gnus-registry-action): use
- gnus-group-guess-full-name-from-command-method instead of
- gnus-group-guess-full-name
-
- * spam.el (spam-mark-spam-as-expired-and-move-routine)
- (spam-ham-copy-or-move-routine): prevent article deletions or
- moves unless the backend allows it
-
- * gnus.el (gnus-install-group-spam-parameters): fixed parameters
- to list spamoracle as well, suggested by Jean-Marc Lasgouttes
- <Jean-Marc.Lasgouttes@inria.fr>
-
- * spam.el (spam-spamoracle): doc change, suggested by Jean-Marc
- Lasgouttes <Jean-Marc.Lasgouttes@inria.fr>
-
-2003-11-04 Norbert Koch <viteno@xemacs.org> (tiny change)
-
- * gnus-score.el (gnus-decay-score): Protect against arithmetic
- errors.
-
-2003-10-31 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el
- (spam-log-processing-to-registry): improved message and comments
- (spam-log-unregistration-needed-p): new function
- (spam-ifile-register-spam-routine)
- (spam-ifile-register-ham-routine, spam-stat-register-spam-routine)
- (spam-stat-register-ham-routine)
- (spam-blacklist-register-routine)
- (spam-whitelist-register-routine)
- (spam-bogofilter-register-spam-routine)
- (spam-bogofilter-register-ham-routine)
- (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): change
- spam-log-processing-to-registry invocations appropriately
-
-2003-10-31 Derek Atkins <warlord@MIT.EDU> (tiny change)
-
- * imap.el (imap-kerberos4-open): Ignore output from ATHENA imtest.
-
-2003-10-31 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-process-connection-type): Improve docstring.
- Suggested by Derek Atkins <warlord@MIT.EDU>.
-
-2003-10-31 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (autoload): autoload the gnus-registry functions we'll
- need
- (spam-log-to-registry): new variable for interfacing with the
- gnus-registry
- (spam-install-hooks): variable had the wrong customization group
- (spam-fetch-field-message-id-fast): convenience function for fetch
- a message ID quickly
- (spam-log-processing-to-registry): new function
- (spam-ifile-register-spam-routine)
- (spam-ifile-register-ham-routine, spam-stat-register-spam-routine)
- (spam-stat-register-ham-routine)
- (spam-blacklist-register-routine)
- (spam-whitelist-register-routine)
- (spam-bogofilter-register-spam-routine)
- (spam-bogofilter-register-ham-routine)
- (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): add
- spam-log-processing-to-registry invocations
-
- * gnus-registry.el: fixed docs in the preface to mention
- gnus-registry-initialize
- (gnus-registry-store-extra): remove cached extra entry
- information when new extra entry is stored
-
-2003-10-29 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-forward-make-body-plain): Fix ARG=1 mode
- after separating m-f-m-b.
-
-2003-10-29 Andre Srinivasan <andre@e2open.com> (tiny change)
-
- * message.el (message-forward-make-body-plain): Remove ignored
- headers.
-
-2003-10-29 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-forward-make-body-plain): Fix ARG=1.
-
-2003-10-28 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-forward-subject-name-subject)
- (message-forward-subject-author-subject): Decode non-ASCII
- newsgroup names.
- (autoload): Autoload gnus-group-decoded-name.
-
-2003-10-27 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): New optional
- parameter key, overrides the key id used to store passphrase
- under (uses true key id from gpg output if nil).
- (pgg-gpg-encrypt-region): Search for passphrase using user suplied
- string STR, instead of (pgg-lookup-key STR t).
- (pgg-gpg-encrypt-region): Store passphrase under user suplied
- string, instead of real key id taken from gpg output.
- (pgg-gpg-decrypt-region): Likewise.
- (pgg-gpg-sign-region): Likewise.
- * pgg.el (pgg-decrypt-region): Don't set pgg-default-user-id.
-
-2003-10-27 Romain FRANCOISE <romain@orebokech.com>
-
- * gnus-art.el (gnus-article-goto-prev-page): Doc fix.
-
-2003-10-27 Simon Josefsson <jas@extundo.com>
-
- * mm-bodies.el (mm-body-encoding): Don't use QP when message body
- only consists of short lines and ASCII, when
- mm-use-ultra-safe-encoding. Refer to 'About foo' thread in
- gnus-bug, e.g. <ilullrg4k7p.fsf@extundo.com>, for more discussion.
- This make it possible to pipe the raw RFC 822 message into 'gpg'
- and have the signature work. Potential problem: what if message
- contain data that would be dash-escaped by OpenPGP
- implementations? Then PGP 2.x might not be able to parse the raw
- RFC 822 message correctly. If that problem is worth fixing, it
- should be fixed by detecting the situation, instead of applying QP
- to everything. Based on discussion with "John A. Martin"
- <jam@jamux.com>.
-
-2003-10-27 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-mark-spam-as-expired-and-move-routine)
- (spam-ham-copy-or-move-routine): don't ask when deleting copied
- articles, and use move instead of copy when possible
- (spam-split): added the option of specifying a string as a
- spam-split parameter; such a string will override
- spam-split-group temporarily.
-
- * nnmail.el (nnmail-cache-insert): protect from nil message IDs,
- but should we do something else?
-
- * gnus-registry.el (gnus-registry-spool-action): protect from nil
- message IDs
-
-2003-10-26 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-button-alist): Allow & in mailto URLs.
- (gnus-header-button-alist): Likewise.
- (gnus-url-mailto): Handle ?to parameters. Replace \r\n with \n.
- Reverse parameter list to use same order as in the URL. Reported
- by f95-msv@f.kth.se (M\e,Ae\e(Brten Svantesson).
-
-2003-10-25 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-move-spam-nonspam-groups-only): documentation fix
- for the variable
-
-2003-10-25 Steve Youngs <sryoungs@bigpond.net.au>
-
- * Makefile.in (clean-some): Remove auto-autoloads.* and
- custom-load.* as well.
- (distclean): Ditto.
-
- * dgnushack.el (dgnushack-make-load): Add a local vars section to
- the dummy gnus-load.el.
-
-2003-10-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-copy-or-move-routine): do not delete if copy
- is t, also don't intepret the list of groups as a list of lists
- (spam-mark-spam-as-expired-and-move-routine)
- (spam-ham-copy-or-move-routine): delete articles only if 1 or
- more groups were specified (and "copy" was not specified for
- spam-ham-copy-or-move-routine) (fixed twice)
-
-2003-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nndoc.el (nndoc-guess-type): Reverse the sort order. Suggested
- by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
- (nndoc-dissect-buffer): Don't miss even-numbered articles.
-
-2003-10-24 Steve Youngs <sryoungs@bigpond.net.au>
-
- * dgnushack.el (dgnushack-gnus-load-file): Set to
- "auto-autoloads.el" if building with XEmacs.
- (dgnushack-cus-load-file): Set to "custom-load.el" if building
- with XEmacs.
- (dgnushack-make-cus-load): We don't delete the resulting file if
- building with XEmacs so byte-compile it.
- (dgnushack-make-load): When building with XEmacs do nothing except
- byte-compile the autoload file and create a dummy gnus-load.el
- file.
-
-2003-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-make-fqdn): Bind case-fold-search.
- Suggested by Christopher Richards <richards@CS.Princeton.EDU>.
-
-2003-10-23 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.el (spam-process-destination, ham-process-destination):
- allow multiple groups as a choice
-
- * spam.el (spam-check-blackholes): remove "[IP address]"
- requirement, now just "IP address" is enough for detection for
- blackhole checking
- (spam-check-blackholes): oops, the dots were not escaped
- (spam-mark-spam-as-expired-and-move-routine): added multiple group
- support (multiple copies, then delete)
- (spam-ham-copy-routine): new function
- (spam-ham-move-routine): new function
- (spam-ham-copy-or-move-routine): new function (used to be
- spam-ham-move-routine), handle multiple groups
- (spam-summary-prepare-exit): call the new functions
-
-2003-10-23 Simon Josefsson <jas@extundo.com>
-
- * flow-fill.el (fill-flowed-encode, fill-flowed): Autoload.
-
-2003-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-emphasis-strikethru): Use the :strike-through
- attribute in Emacs.
-
-2003-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-bounce): Don't erase except bounced header.
-
-2003-10-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-reverse-ip-string): new function to reverse an IP
- address in a string
- (spam-check-blackholes): use spam-reverse-ip-string
-
-2003-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-narrow-to-page): Clear as well as set the
- value for gnus-page-broken.
-
- * gnus-sum.el (gnus-summary-beginning-of-article): Use
- gnus-break-pages instead of gnus-page-broken.
- (gnus-summary-end-of-article): Use gnus-break-pages instead of
- gnus-page-broken; narrow to the end of a page beforehand.
- (gnus-summary-toggle-header): Use gnus-break-pages instead of
- gnus-page-broken; remove delimiter buttons unless gnus-break-pages
- is non-nil.
-
-2003-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picon-transform-address): Protect against
- errors.
-
-2003-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (nnspool-rejected-article-hook): Remove defvar.
- (xemacs-codename): Move defvar to gnus-util.el.
-
- * gnus-util.el (xemacs-codename): Defvar when compiling.
-
-2003-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * spam-report.el (spam-report-url-ping-plain): Include a
- User-Agent.
-
- * gnus-msg.el (gnus-extended-version): Use it.
-
- * gnus-util.el (gnus-emacs-version): Separated out into own
- function.
-
-2003-10-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-mode-field-menu): Added
- message-generate-unsubscribed-mail-followup-to.
- (message-forward-subject-fwd): Avoid double "Fwd: "
- (message-change-subject): Added comment.
-
-2003-10-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-nov-parse-line): Remove condition-cases.
-
- * mml.el (mml-insert-mime): Quote mml.
-
-2003-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-remove-odd-characters): Use
- mm-subst-char-in-string instead of subst-char-in-string.
- (gnus-summary-refer-article): Use gnus-replace-in-string instead
- of replace-regexp-in-string.
-
-2003-10-19 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-uu.el (gnus-uu-uustrip-article): Really strip directory
- from file name.
-
-2003-10-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-save-parts-last-directory): Default
- to mm-default-directory.
- (gnus-summary-save-parts-1): Use mm-file-name-rewrite-functions.
-
-2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * pop3.el (pop3-read-response): Check whether the process is
- alive.
-
- * gnus-sum.el (gnus-summary-refer-article): Strip spaces.
-
- * rfc2047.el (rfc2047-encode-region): Do error out on invalid
- strings.
-
- * nntp.el (nntp-retrieve-headers-with-xover): Get error messages
- right.
-
- * gnus-agent.el (gnus-agent-read-servers): Remove sit-for.
-
- * gnus-art.el (article-treat-dumbquotes): Doc fix.
-
- * message.el (message-field-value): New function.
- (message-insert-disposition-notification-to): Use Reply-To, too.
-
- * imap.el (imap-mailbox-status): Upcase STATUS commands.
-
- * gnus-sum.el (gnus-remove-odd-characters): New function.
- (gnus-nov-parse-line): Use it.
-
-2003-10-18 Matt Swift <swift@alum.mit.edu>
-
- * mm-decode.el (mm-inline-media-tests): Recognize pjpeg as jpeg.
-
-2003-10-18 Romain FRANCOISE <romain@orebokech.com>
-
- * message.el (message-forward-make-body): does both
- m-f-make-body-mml and m-f-make-body-plain, resulting in a strange
- message buffer.
-
-2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-narrow-to-page): Only break page if it's
- broken.
-
- * nnrss.el (nnrss-find-rss-via-syndic8): Return nil if xml-rpc
- isn't available.
-
- * message.el (message-hidden-headers): Doc fix.
-
-2003-10-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-summary-resend-message-edit): Avoid error when
- fields aren't found.
-
-2003-10-18 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-forward-make-body-plain)
- (message-forward-make-body-mime, message-forward-make-body-mml)
- (message-forward-make-body-digest-plain)
- (message-forward-make-body-digest-mime)
- (message-forward-make-body-digest): New, derived from
- message-forward-make-body.
- (message-forward-make-body): Use them.
- (message-forward-show-mml): New default 'best.
- (message-forward-make-body): Support it.
-
-2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-mode): Set gnus-page-broken to nil.
- (gnus-article-prepare): Don't set to t.
- (gnus-narrow-to-page): Set to t if we break.
-
-2003-06-11 Daniel N\e,Ai\e(Bri <dne@mayonnaise.net>
-
- * message.el (message-resend): Generate Resent-Message-ID header.
-
-2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-next-page): Don't go to the next line
- before checking end-of-buffer.
- (gnus-mime-delete-part): Don't insert parts twice.
-
-2003-10-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-update-date-lapsed): Make sure point
- doesn't move around (much).
-
-2003-07-28 Vasily Korytov <deskpot@myrealbox.com>
-
- * mail-source.el (mail-source-keyword-map): List "cur" before
- "new" for maildirs.
-
-2003-10-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-enter-digest-group): ogroup, nor
- group.
-
- * gnus-msg.el (gnus-inews-insert-archive-gcc): Use the parent
- name for gcc-self.
- (gnus-inews-insert-archive-gcc): Paren mistake.
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Add
- parent-group.
-
- * gnus-art.el (gnus-ignored-headers): Add more headers.
-
- * rfc2047.el (rfc2047-encode): See which encoding is shorter --
- base64 or QP.
-
- * nnmail.el (nnmail-article-group): Default to "bogus".
-
- * mail-source.el (mail-source-delete-incoming): Change to nil.
-
-2003-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-fetch-imap): Fix mismatched parens.
-
-2003-10-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (defvar): Add post/pre/scripts.
- (mail-source-fetch-imap): Use them.
-
- * nndraft.el (nndraft-request-move-article): Fix infinite
- recursion.
-
- * gnus-group.el (gnus-group-mark-regexp): Jump to groups.
-
-2003-10-16 Ed L. Cashin <ecashin@uga.edu>
-
- * imap.el (imap-interactive-login): Set imap-password to nil if
- login fails.
-
-2003-10-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-inserted-headers): New variable.
- (message-mode): Make local.
- (message-mode): Set all the local action variables to nil.
-
-2003-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-inline-text-html-with-images): Doc fix.
- (mm-w3m-safe-url-regexp): Doc fix.
-
-2003-10-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-respool-query): Don't narrow to head,
- it's done by nnmail-article-group.
-
-2003-10-12 Mark Hood <markhood@speakeasy.net> (tiny change)
-
- * gnus-uu.el (gnus-uu-grab-articles): Fix misplaced parens.
-
-2003-10-10 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-file-name-delete-gotchas): Avoid infloop in
- XEmacs.
-
-2003-10-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-initialize): new function, does the spam-face
- update and all the hooks, replaces spam-install-hooks-function
-
- * gnus-registry.el (gnus-registry-initialize): new autoloaded
- function to explicitly initialize the registry
-
-2003-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-w3m-safe-url-regexp): Doc fix.
-
- * mm-view.el (mm-w3m-mode-map): Doc fix.
- (mm-inline-text-html-render-with-w3m): Add a comment.
-
-2003-10-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el: Remove superfluous eval-when-compiles.
-
-2003-10-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-suspend): Reset gnus-backlog-articles.
-
-2003-10-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dns.el (query-dns): Don't error out on malformed resolv files.
-
-2003-10-06 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-group-faq-directory): Update .tw entry. From
- Albert Chun-Chieh Huang <mr894348@cs.nthu.edu.tw>
-
-2003-10-03 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-blackholes): exit the loop if matches are
- found (idea from Adrian Lanz <lanz@fowi.ethz.ch>)
- (spam-check-bogofilter-headers, spam-check-blackholes, spam-check-BBDB)
- (spam-from-listed-p): use nnmail-fetch-field instead of message-fetch-field
-
-
-2003-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-attachment-file-modes): Change the default
- value into 384 from ?\600 which doesn't mean an integer in XEmacs.
-
-2003-10-03 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-file-name-delete-control)
- (mm-file-name-delete-gotchas): New functions.
- (mm-file-name-rewrite-functions): Use them.
- (mm-attachment-file-modes): New option.
- (mm-save-part-to-file): Use it.
-
-2003-10-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam.el (spam-install-hooks-function): Added Autoload cookie.
-
-2003-10-02 Michael Shields <shields@msrl.com>
-
- * pgg-def.el (pgg-default-keyserver-address): Change to
- subkeys.pgp.net.
-
-2003-10-01 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-idna-to-ascii-rhs-1): RHS can be terminated
- by ',', as in 'foo@example.org, bar@example.org'.
-
-2003-10-01 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-send): Fix reversed logic of supersedes
- check.
-
-2003-09-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-article-view-part-as-charset): Doc fix,
- suggested by Norbert Koch <viteno@xemacs.org>.
-
-2003-09-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-topic.el (gnus-topic-goto-missing-topic): Revert 2003-02-09
- change in order to correct the position where an invisible topic
- (because gnus-topic-display-empty-topics is nil) may be inserted.
-
-2003-09-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-ignored-supersedes-headers): Add X-Payment.
-
-2003-09-20 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-encode): Limit line length to 76 characters.
-
-2003-09-20 Simon Josefsson <jas@extundo.com>
-
- * tls.el (tls-process-connection-type): Doc fix.
-
- * imap.el (imap-starttls-open): Rewrite, should support both old
- starttls.el and new starttls.el that uses GNUTLS.
-
-2003-09-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-display-x-face): Use set-default instead
- of custom-set-default which isn't available in old XEmacsen.
-
-2003-09-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-summary-resend-message-edit): Don't convert
- to MML. MIME -> MML -> MIME does not work for PGP/MIME.
-
- * message.el (message-bounce, message-forward-show-mml): do.
-
-2003-09-13 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-charset-encoding-alist): Add viscii.
- (rfc2047-encode): Add factors for big5, gb2312 and euc-kr.
-
- * nnweb.el (nnweb-google-parse-1): Fix parsing.
-
-2003-09-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-fetch-control): ISC changed
- compression from .Z to .gz.
-
- * rfc2047.el (rfc2047-header-encoding-alist): Add "Approved" to
- address-mime.
-
-2003-09-11 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-encode): Restrict encoded-words to 75
- characters.
-
-2003-09-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-group-charter-alist): Update.
-
-2003-09-10 Eric Knauel <knauel@informatik.uni-tuebingen.de>
-
- * spam-report.el: Use mm-url.el functions for external URL loading
- when the built-in HTTP GET is insufficient (e.g. proxies are in
- the way).
-
-2003-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam-report.el (spam-report-url-ping-function): New option,
- defaults to the built-in HTTP GET (spam-report-url-ping-plain).
- (spam-report-url-ping): Call spam-report-url-ping-function.
- (spam-report-url-ping-plain): New function, does what
- spam-report-url-ping used to do.
- (spam-report-url-ping-mm-url): Function that delegates to
- mm-url.el (autoloaded).
-
-2003-09-08 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-delete-id): function to
- completely delete an ID, including all the cache hashtables
- (gnus-registry-delete-group): use gnus-registry-delete-id
- (gnus-registry-simplify-subject): only run if the argument is a
- string, return nil otherwise
-
-2003-09-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-summary-resend-bounced-mail): Docstring fix.
-
-2003-09-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-split-fancy-with-parent): yet
- another error *sigh*
-
- * gnus-registry.el (gnus-registry-fetch-extra-entry): don't use
- puthash unless gnus-registry-entry-caching is on
- (gnus-registry-split-fancy-with-parent): misplaced parenthesis
- made everything a part of the 'else'
- (gnus-registry-save): used 'entry-caching' instead of 'caching'
-
-2003-09-05 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-button-alist): Improve Info regexp.
-
-2003-09-04 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el: added brief explanation of basics
- (gnus-registry-track-extra): new variable for tracking of message
- subjects
- (gnus-registry-entry-caching): caching parameter, used for extra
- data
- (gnus-registry-minimum-subject-length): minimum subject length
- before it's considered when tracing subjects
- (gnus-registry-save): accomodate extra data entry caching
- (gnus-registry-action): change function name, add the subject and
- pass it to gnus-registry-add-group
- (gnus-registry-spool-action): change function name, add the
- subject and pass it to gnus-registry-add-group
- (gnus-registry-split-fancy-with-parent): add subject tracking
- (gnus-registry-register-message-ids): pass subject to
- gnus-registry-add-group
- (gnus-registry-simplify-subject)
- (gnus-registry-fetch-simplified-message-subject-fast): new
- functions
- (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry): add
- extra data entry caching
- (gnus-registry-add-group): handle the extra subject parameter
- (gnus-registry-install-hooks, gnus-registry-unload-hook): fix the
- gnus-register-* function names
-
- * nnmail.el (nnmail-cache-insert): add subject parameter, pass it
- on to the nnmail-spool-hook
-
- * nnbabyl.el (nnbabyl-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nndiary.el (nndiary-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nnfolder.el (nnfolder-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nnimap.el (nnimap-split-articles): added subject to
- nnmail-cache-insert call
- (nnimap-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nnmbox.el (nnmbox-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nnmh.el (nnmh-request-accept-article): added subject to
- nnmail-cache-insert call
-
- * nnml.el (nnml-request-accept-article): added subject to
- nnmail-cache-insert call
-
-2003-09-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-button-handle-info-url)
- (gnus-button-handle-info-url-gnome)
- (gnus-button-handle-info-url-kde, gnus-button-alist): Handle GNOME
- and KDE style Info URLs.
-
- * gnus-util.el (gnus-url-unhex-string): Don't replace "+" with " ".
-
-2003-09-02 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-fold-region): Don't fold at the beginning
- of the field.
-
-2003-09-01 Simon Josefsson <jas@extundo.com>
-
- * mml.el (mml-insert-mime-headers-always): New variable.
- (mml-insert-mime-headers): Use it. Based on (tiny) patch from
- Lars Balker Rasmussen <lars@balker.org>.
-
-2003-08-30 Gaute B Strokkenes <gs234@srcf.ucam.org> (tiny change)
-
- * mail-source.el (mail-source-fetch-imap): Pass correct buffer to
- imap-open, reverts 2003-03-17 change. Reverse remove before
- calling gnus-compress-sequence.
-
-2003-08-29 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-delete-group): Doc fix. Suggested by
- Jochen K\e,A|\e(Bpper <jochen@jochen-kuepper.de>.
-
-2003-08-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-display-x-face): Make it possible to set
- the gnus-article-x-face-command variable to the lambda form.
-
-2003-08-27 Simon Josefsson <jas@extundo.com>
-
- * mm-decode.el (mm-remove-part): Try to kill external displayers
- cleanly first (if it refuses, C-g aborts loop and kill process
- unconditionally). Also make sure process is dead before we remove
- the files it may be using. Reported by David Coe
- <davidc@debian.org>.
-
-2003-08-27 Vagn Johansen <v@johansen.mail.dk> (tiny change)
-
- * gnus-cache.el (gnus-cache-generate-active): Fix bug in
- replacement.
-
-2003-08-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el: Don't use defvaralias.
- (gnus-treat-display-x-face): Warn if the obsolete variable
- `gnus-treat-display-xface' exists.
-
-2003-08-25 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-treat-display-face): Fix typo.
- (gnus-treat-display-xface): Rename to gnus-treat-display-x-face
- (reported by Jochen K\e,A|\e(Bpper <jochen@jochen-kuepper.de>)
-
-2003-08-24 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-header-button-alist, gnus-button-alist): Fix
- type.
-
-2003-08-22 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-make-forward-subject-function): Fix
- customize mismatch.
-
- * gnus.el (gnus-message-archive-method): do.
-
-2003-08-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-read-group): Offer to continue only if the invalid
- char is `/' and add more information for the user.
-
- * gnus-art.el (gnus-button-alist): Add `+' (gnus-button-handle-man).
- (gnus-header-button-alist): Added `In-Reply-To'.
-
- * nnimap.el (nnimap-open-connection): Allow different user names
- on the same server (and in the same authinfo file).
-
-2003-08-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sieve.el (gnus-sieve-crosspost): Fix type.
-
- * message.el (message-make-forward-subject-function): Add
- message-forward-subject-name-subject to choices.
-
- * gnus-art.el (gnus-article-edit-done, gnus-article-edit-exit):
- Redisplay article after editing.
-
-2003-08-20 Jari Aalto <jari.aalto@poboxes.com>
-
- * gnus.el (gnus-read-group): Added check to ask confirmation if
- Group name contains invalid character. You can use '/' in IMAP,
- but not in filenames. G m cannot know what the user is creating,
- so let user decide. See thread m2oeysiev3.fsf@naima.lensflare.org.
-
-2003-08-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-score.el (gnus-summary-score-effect): Fix interactive use.
-
-2003-08-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-draft.el (gnus-draft-send-all-messages): ask if all drafts
- should be sent unless gnus-expert-user is on
-
-2003-08-09 Jesper Harder <harder@ifa.au.dk>
-
- * pgg-gpg.el (pgg-gpg-extra-args): Fix customization type.
-
-2003-08-07 Jesper Harder <harder@ifa.au.dk>
-
- * pgg-gpg.el (pgg-gpg-process-region): Bind
- default-enable-multibyte-characters to nil.
-
-2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-password): Fix customization type.
- (canlock-password-for-verify): Ditto.
- * deuglify.el (gnus-outlook-deuglify-unwrap-min): Ditto.
- (gnus-outlook-deuglify-unwrap-max): Ditto.
- (gnus-outlook-deuglify-unwrap-stop-chars): Ditto.
- * gnus-sum.el (gnus-sum-thread-tree-root): Ditto.
- (gnus-sum-thread-tree-false-root): Ditto.
- (gnus-sum-thread-tree-single-indent): Ditto.
- * message.el (message-archive-note): Ditto.
- (message-subscribed-address-file): Ditto.
- (message-user-fqdn): Ditto.
- * spam-report.el (spam-report-gmane-regex): Ditto.
- * spam.el (spam-blackhole-good-server-regex): Ditto.
-
- * gnus-start.el (gnus-save-killed-list): Fix last change.
- * message.el (message-courtesy-message): Ditto.
-
-2003-08-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-header-face-alist): Revert previous change.
- (gnus-header-newsgroups-face): Explain that it's only used for
- crossposts.
-
-2003-08-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-registry.el (gnus-registry-max-entries): Fix customization
- type.
- * gnus-score.el (gnus-adaptive-word-length-limit): Ditto.
- * gnus.el (gnus-refer-article-method): Ditto.
- * message.el (message-courtesy-message): Ditto.
-
-2003-08-06 Chunyu Wang <spr@db.cs.hit.edu.cn> (tiny change)
-
- * gnus-art.el (gnus-header-face-alist): Fix "Newsgroups" entry.
-
-2003-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-save-killed-list): Fix customization type.
- * gnus-sum.el (gnus-thread-hide-subtree): Ditto.
- * gnus.el (gnus-use-long-file-name): Ditto.
-
-2003-08-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-rename-group): Don't allow renaming to
- an existing name.
-
- * gnus-sum.el (gnus-summary-highlight): Add uncached to docstring.
-
- * nnmail.el (nnmail-large-newsgroup): Docstring fix.
-
- * nntp.el (nntp-large-newsgroup): do.
-
- * nnspool.el (nnspool-large-newsgroup): do.
-
- * gnus-cus.el (gnus-group-parameters): Typo.
-
-2003-07-31 Simon Josefsson <jas@extundo.com>
-
- * mml-sec.el (mml-signencrypt-style-alist): Use separate S/MIME
- method by default (revert partial 2003-07-10 patch).
-
-2003-07-28 Dave Love <fx@gnu.org>
-
- * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el: Require cl when compiling.
-
-2003-07-26 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-install): add an initial
- registry read to the loading when gnus-registry-install is set
-
-2003-07-26 Mark Thomas <swoon@bellatlantic.net> (tiny change)
-
- * flow-fill.el (fill-flowed): Empty lines separate paragraphs
- even if the preceding line ends with a soft break.
-
-2003-07-25 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-use-regex-body, spam-regex-body-spam)
- (spam-regex-body-ham): new variables, default to nil/empty/empty
- (spam-install-hooks): added spam-use-regex-body to list or
- pre-install conditions
- (spam-list-of-checks): added spam-use-regex-body and
- spam-check-regex-body to list of checks
- (spam-list-of-statistical-checks): added spam-use-regex-body to
- list of statistical checks
- (spam-check-regex-body): invokes spam-check-regex-headers with
- appropriate variable masking
- (spam-check-regex-headers): changes to print "body" or "header"
- where appropriate
-
-2003-07-25 Jesper Harder <harder@ifa.au.dk>
-
- * smime.el (smime-ask-passphrase): Use read-passwd rather than
- comint-read-noecho. The former is more secure.
-
-2003-07-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-cache-whitespace): make "adding
- whitespace" message level 5 instead of 4
- (gnus-registry-clean-empty-function): new function to remove empty
- registry entries
- (gnus-registry-clean-empty): new variable to enable cleaning the
- registry when saving it by calling gnus-registry-clean-empty-function
-
- * spam.el (spam-summary-prepare-exit): use spam-process-ham-in-spam-groups
- (spam-process-ham-in-spam-groups): new variable
-
-2003-07-24 Jesper Harder <harder@ifa.au.dk>
-
- * pgg-gpg.el (pgg-gpg-process-region): Add "--yes" to options.
-
- * pgg-gpg.el, pgg-pgp.el, pgg-pgp5.el, pgg.el: Reapply changes
- from 2003-04-03 to fix security problem. See
- http://www.debian.org/security/2003/dsa-339
-
-2003-07-23 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.el (gnus-install-group-spam-parameters): add the
- gnus-ticked-mark to the possible choices of ham marks
-
- * spam.el (spam-process-ham-in-nonham-groups): new variable
- (spam-summary-prepare-exit): use spam-process-ham-in-nonham-groups
-
-2003-07-23 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-header-encoding-alist): Add Mail-Followup-To
- and Mail-Copies-To to address-mime.
- (rfc2047-narrow-to-field): Use rfc2047-point-at-bol.
-
-2003-07-19 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-coding-system-priorities): Docstring improvement.
-
-2003-07-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-thread-latest-date): Move condition-case to
- the right place.
-
-2003-07-14 Simon Josefsson <jas@extundo.com>
-
- * mail-source.el (mail-source-fetch-imap): Don't assume
- imap-error-text returns something.
-
-2003-07-12 Nevin Kapur <kapur@mts.jhu.edu>
-
- * nnimap.el (nnimap-request-newgroups): Use the pattern in
- nnimap-list-pattern instead of "*".
-
-2003-07-10 Simon Josefsson <jas@extundo.com>
-
- * mml-sec.el (mml-signencrypt-style-alist): Use "combined" by
- default. Improve docstring.
-
-2003-07-10 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * imap.el (imap-arrival-filter): Fix test for missing process
- buffer.
-
-2003-07-09 Gaute B Strokkenes <gs234@cam.ac.uk> (tiny change)
-
- * imap.el (imap-wait-for-tag): Clarify comment. Use timeout zero
- for second, after-process-has-died, accept-process-output.
- (imap-arrival-filter): If PROC has no buffer, do nothing.
-
-2003-07-09 Jesper Harder <harder@ifa.au.dk>
-
- * flow-fill.el: Docstring and message fixes.
-
- * deuglify.el: do.
-
- * gnus-int.el: do.
-
- * gnus-msg.el: do.
-
- * gnus-util.el: do.
-
- * gnus-draft.el: do.
-
- * gnus-start.el: do.
-
- * gnus.el: do.
-
- * gnus-group.el: do.
-
- * gnus-art.el: do.
-
- * gnus-sum.el: do.
-
- * mail-source.el (mail-source-movemail): Handle non-numerical
- return values.
-
-2003-07-08 Jesper Harder <harder@ifa.au.dk>
-
- * mailcap.el (mailcap-parse-args-syntax-table)
- (mailcap-viewer-passes-test): Docstring fix.
-
- * mm-bodies.el (mm-long-lines-p): Docstring fix.
-
- * mm-decode.el (mm-w3m-safe-url-regexp, mm-verify-option)
- (mm-decrypt-option, mm-handle-set-external-undisplayer)
- (mm-file-name-replace-whitespace): Docstring fix.
-
- * mm-uu.el (mm-uu-emacs-sources-regexp): Docstring fix.
- (mm-uu-pgp-signed-test): Fix message.
-
- * mml.el (mml-tweak-sexp-alist): Docstring fix.
- (mml-parse-1, mml-insert-mime-headers): Fix message.
-
- * message.el (message-archive-header)
- (message-subscribed-address-functions)
- (message-subscribed-addresses, message-subscribed-regexps)
- (message-canlock-generate)
- (message-generate-new-buffer-clone-locals): Docstring fixes.
-
-2003-07-07 Gaute B Strokkenes <gs234@cam.ac.uk> (tiny change)
-
- * imap.el (imap-wait-for-tag): After the process has died, look
- for more output still pending.
-
-2003-07-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-bogofilter-score): redisplay article normally
- after spam-bogofilter-score is called
-
-2003-07-06 Michael Piotrowski <mxp@dynalabs.de> (tiny change)
-
- * gnus-sum.el (gnus-print-buffer): Apply emphasis.
-
-2003-07-06 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-send-mail-with-sendmail): Handle
- non-numeric return values.
-
- * gnus-start.el (gnus-clear-system): Revert change from
- 2003-06-19.
-
-2003-07-04 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-q-encode-region): Exclude especials from
- characters not encoded, and make the list more legible.
-
-2003-07-04 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-make-from): Revert change from 2002-01-08.
-
-2003-06-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-init-server-buffer): Don't add
- nntp-server-buffer to list of Gnus buffers.
-
-2003-06-25 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-parse-list): prevent empty ("") strings
-
-2003-06-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-parse-list): use gnus-extract-address-components
- instead of ietf-drums-parse-addresses
- (spam-from-listed-p): let* was unnecessary
-
-2003-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-ems.el (gnus-put-image): Mark the right text segment with
- gnus-image-category.
-
- * gnus-srvr.el (gnus-browse-unsubscribe-group): Strip prefix from
- native groups.
-
- * gnus-topic.el (gnus-group-prepare-topics): Update topic line
- format specs.
-
- * gnus-picon.el: Written by moi, moi, moi.
-
- * gnus-group.el (gnus-group-kill-group): Clean up.
-
-2003-06-23 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-from-listed-p, spam-parse-list): use
- ietf-drums-parse-addresses to extract the address portion of the
- whitelist/blacklist file if it looks like an address can be found
-
-2003-06-23 Didier Verna <didier@xemacs.org>
-
- * gnus-ems.el (gnus-put-image): New argument CATEGORY. Add it as a
- text property.
- (gnus-remove-image): New argument CATEGORY. Only remove if
- category matches.
- * gnus-xmas.el (gnus-xmas-put-image):
- (gnus-xmas-remove-image): Ditto, with extents.
- * gnus-art.el (gnus-delete-images): Pass CATEGORY argument to
- gnus-[xmas-]remove-image.
- (article-display-face): Don't always act as a toggle. Call
- `gnus-put-image' with CATEGORY argument.
- (article-display-x-face): Call `gnus-put-image' with CATEGORY
- argument.
- * smiley.el (smiley-region): Ditto.
- * gnus-fun.el (gnus-display-x-face-in-from): Ditto.
- * gnus-picon.el (gnus-picon-insert-glyph): Ditto.
- (gnus-treat-mail-picon): Don't always act as a toggle.
- * gnus-picon.el (gnus-treat-newsgroups-picon): Ditto.
-
-2003-06-23 Didier Verna <didier@xemacs.org>
-
- * gnus-art.el (article-display-face): Check for existence of the
- original article buffer before switching to it.
-
-2003-06-20 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-append-to-file): Say "Appended to". Suggested by
- Dan Jacobson <jidanni@jidanni.org>.
-
- * mm-view.el (mm-inline-message): Bind
- gnus-original-article-buffer to the buffer in the mml handle
- holding the message.
-
-2003-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (sender, from): No need to bind them.
-
-2003-06-19 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-enter-list): search-forward specified wrong
-
-2003-06-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el: Comment fix.
-
-2003-06-20 Jesper Harder <harder@ifa.au.dk>
-
- * spam.el (spam-spamoracle-learn): insert-string is obsolete.
-
-2003-06-20 Jan Rychter <jan@rychter.com>
-
- * gnus-msg.el (gnus-configure-posting-styles): Remove unused
- variable.
-
-2003-06-19 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-enter-list): do not enter duplicate addresses into
- the whitelist/blacklist
-
-2003-06-19 Jesper Harder <harder@ifa.au.dk>
-
- * nnheader.el (nnheader-init-server-buffer): Add
- nntp-server-buffer to gnus-buffers.
-
- * gnus-start.el (gnus-clear-system): Now we don't need to kill
- nntp-server-buffer separately.
-
-2003-06-18 Didier Verna <didier@xemacs.org>
-
- * gnus-art.el (article-display-face): Correctly toggle between
- display and hiding. Handle multiple Face headers.
-
-2003-06-17 Dave Love <fx@gnu.org>
-
- * nnimap.el: Require cl when compiling.
-
- * message.el (message-fix-before-sending): Reinstate nullifying
- the invisible text property.
- (sender, from): Defvar when compiling.
- (message-is-yours-p): Remove autoload cookie.
-
-2003-06-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-extract-address-components): Added
- doc-string.
-
-2003-06-16 Michael Albinus <Michael.Albinus@alcatel.de>
-
- * nnml.el (nnml-current-group-article-to-file-alist): Don't read
- overview when using compressed files.
-
-2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-refer-parent-article): Extract
- Message-ID from In-Reply-To header.
-
-2003-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-is-yours-p): Narrow to head; extract from
- and sender by itself.
- (message-cancel-news, message-supersede): Remove useless things.
-
-2003-06-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Bind
- `gnus-article-emulate-mime'.
-
-2003-06-15 Tommi Vainikainen <thv+gnus@iki.fi>
-
- * message.el (message-is-yours-p): New function. Separated common
- code from message-cancel-news and message-supersede. Added
- matching code which uses message-alternative-emails regexp as last
- resort.
- (message-cancel-news, message-supersede): Use message-is-yours-p.
-
-2003-06-13 Niklas Morberg <niklas.morberg@axis.com>
-
- * nnimap.el (nnimap-split-articles): Narrow the right buffer to
- the headers.
-
-2003-06-12 Dave Love <fx@gnu.org>
-
- * nnheader.el (nnheader-functionp): Deleted.
-
- * nnmail.el (nnmail-split-fancy-syntax-table): Define all in
- defvar.
- (nnmail-version): Deleted.
- (nnmail-check-duplication, nnmail-expiry-target-group): Don't use
- nnheader-functionp.
-
-2003-06-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-bogofilter-headers): fix for when the score
- is requested but the message is not spam
-
-2003-06-09 Eric Knauel <knauel@informatik.uni-tuebingen.de>
-
- * spam.el (spam-use-spamoracle): new variable
- (spam-install-hooks): add spamoracle to the list of conditions
- for activation of spam-install-hooks
- (spam-spamoracle): new variable customization group
- (spam-spamoracle, spam-spamoracle): new variables
- (spam-group-spam-processor-spamoracle-p)
- (spam-group-ham-processor-spamoracle-p): new functions
- (spam-summary-prepare-exit): added spamoracle ham/spam exit processing
- (spam-list-of-checks, spam-list-of-statistical-checks): add
- spam-use-spamoracle
- (spam-check-spamoracle, spam-spamoracle-learn)
- (spam-spamoracle-learn-ham, spam-spamoracle-learn-spam): new functions
-
- * gnus.el (gnus-group-spam-exit-processor-spamoracle)
- (gnus-group-ham-exit-processor-spamoracle): new variables for SpamOracle
- (spam-process, ham-process): added spamoracle spam/ham processors
-
-2003-06-08 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-beginning-of-line): Docstring improvement.
- Suggested by Michael R. Wolf <MichaelRunningWolf@att.net>
-
-2003-06-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Removed ["Add buttons"
- gnus-summary-display-buttonized t]
-
-2003-06-07 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * nnmail.el (nnmail-split-fancy-match-partial-words): Doc string
- fix. Reported by Johan Bockg\e,Ae\e(Brd <bojohan+news@dd.chalmers.se>.
-
-2003-06-07 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-beginning-of-line): Docstring improvement.
-
-2003-06-06 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Parse garbage NNTP
- groups correctly.
-
-2003-06-06 Benjamin Rutt <rutt+news@cis.ohio-state.edu>.
-
- * message.el (message-fetch-field): Augment documentation to state
- the narrowed-to-headers restriction.
- (message-change-subject, message-reduce-to-to-cc)
- (message-generate-unsubscribed-mail-followup-to)
- (message-insert-importance-high, message-insert-importance-low)
- (message-insert-or-toggle-importance)
- (message-insert-disposition-notification-to): Narrow to headers
- before calling message-fetch-field or message-remove-header.
-
-2003-06-06 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-trim): fix for when
- gnus-registry-max-entries is nil
-
-2003-06-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * qp.el (quoted-printable-decode-region): Don't error out on
- malformed text.
-
-2003-06-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encode-region): Don't error out on invalid
- strings.
-
-2003-06-04 Ivan Boldyrev <boldyrev+nospam@cgitftp.uiggm.nsc.ru> (tiny change)
-
- * mml1991.el (mml1991-pgg-sign): Insert pgg output as unibyte.
-
-2003-06-03 Dave Love <fx@gnu.org>
-
- * gnus-soup.el (gnus-soup-send-packet): Don't use
- message-functionp.
-
- * gnus.el (gnus-agent-cache): Doc fix.
- (gnus-other-frame): Quote lambda used as hook.
-
- * message.el: Doc fixes.
- (message-functionp): Deleted. Callers changed.
- (message-fix-before-sending): Highlight with overlays. Clarify
- `illegible text' messages.
- (rmail-enable-mime-composing, gnus-message-group-art): Defvar when
- compiling.
- (gnus-find-method-for-group, nnvirtual-find-group-art): Autoload.
-
-2003-06-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * nnmail.el (nnmail-split-fancy-match-partial-words): New user
- option.
- (nnmail-split-it): Obey it. Don't let-bind regexp twice.
-
- * message.el (message-fetch-field): Mention narrow-to-headers
- requirement.
-
-2003-06-03 Eric Eide <eeide@cs.utah.edu>
-
- * gnus-xmas.el (gnus-xmas-create-image): Use
- insert-file-contents-literally.
-
-2003-06-02 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-fetch-group): always return the
- short name of the group
-
-2003-06-02 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-cus.el (defvar): Silence byte-compiler warnings.
-
- * gnus-sum.el (gnus-get-newsgroup-headers): Unfold headers.
-
-2003-05-31 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (article-unsplit-urls): Use gnus-treat-article
- rather than gnus-display-mime-function.
-
-2003-05-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-use-long-group-names): new variable
- (gnus-registry-add-group): use it
- (gnus-registry-trim-articles-without-groups): new variable
- (gnus-registry-delete-group): use it
- (gnus-registry-unload-hook): uninstall all the hooks
-
- * spam.el (spam-install-hooks-function, spam-unload-hook): new
- functions so users that load spam.el for customization don't get
- all the hooks installed
- (spam-install-hooks): new variable, set to t by default if user
- has one of the spam-use-* variables set
-
- * spam-stat.el (spam-stat-install-hooks, spam-stat-unload-hook): new
- functions so users that load spam-stat.el for customization don't get
- all the hooks installed
-
-2003-05-30 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-decode): Don't use
- mm-with-unibyte-current-buffer.
-
- * qp.el (quoted-printable-decode-string): Use
- mm-with-unibyte-buffer.
-
-2003-05-29 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-save): allow forced saving even
- when registry is not dirty. Use gnus-registry-trim to shorten the
- gnus-registry-alist.
- (gnus-registry-max-entries): new variable
- (gnus-registry-trim): new function, trim gnus-registry-alist to
- size gnus-registry-max-entries, sorting by entry mtime so the
- newest entries stick around
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): instead of
- just one specific variable, allow a list of specific variables
-
-2003-05-28 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-encode-region): Skip ASCII at beginning and
- end of region.
-
-2003-05-28 Jesper Harder <harder@ifa.au.dk>
-
- * lpath.el: Add put-char-table and get-char-table.
-
-2003-05-28 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-dirty): flag for modified registry
- (gnus-registry-save, gnus-registry-read)
- (gnus-registry-store-extra, gnus-registry-clear): use it (note
- that gnus-registry-store-extra is invoked for all modifications to
- set the mtime, so gnus-registry-dirty only needs to be set there)
-
-2003-05-23 Simon Josefsson <jas@extundo.com>
-
- * mml1991.el (mml1991-pgg-sign): Use mml-sender instead of
- message-sender.
-
- * gnus-art.el (gnus-use-idna): Check if idna-program is installed.
-
- * message.el (message-use-idna): Ditto.
-
-2003-05-20 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-q-encoding-alist): Deleted.
- (rfc2047-q-encode-region): Don't use it.
- (rfc2047-encode-message-header) <(eq method 'mime)>: Bind
- rfc2047-encoding-type to `mime'.
- (rfc2047-encode-string, rfc2047-encode): Doc fix.
-
-2003-05-20 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-send-mail): Don't insert a courtesy copy
- notice in base64 encoded messages.
-
-2003-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-move-article): Don't copy expirable
- marks if the destination group is not auto-expirable.
-
-2003-05-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (assq-delete-all): Removed the compiler macro.
-
-2003-05-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agentize): Updated documentation to match
- usage.
- (gnus-agent-expire-group-1): Do not skip over a group when the
- force argument is set.
- * gnus.el (gnus-agent): Updated documentation to reflect that
- gnus-agent now defaults to t.
-
-2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-05-14 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.2 is released.
-
-2003-05-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-delete-incoming): Changed to t.
-
- * rfc2047.el (rfc2047-syntax-table): Funcall.
-
- * lpath.el ((featurep 'xemacs)): Added set-char-table-range.
- ((featurep 'xemacs)): No, don't.
-
- * rfc2047.el (rfc2047-encodable-p): Use the header charset.
-
- * gnus-sum.el (gnus-summary-reselect-current-group): Supply
- leave-hidden.
-
-2003-05-14 Jonathan Kamens <jik@kamens.brookline.ma.us>
-
- * gnus-sum.el (gnus-summary-exit): Added `leave-hidden'. (Tiny
- patch.)
-
-2003-05-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-registry.el (gnus-registry-store-extra-entry): Use
- gnus-assq-delete-all.
-
- * gnus-xmas.el (gnus-xmas-assq-delete-all): New function.
-
- * message.el (message-ignored-bounced-headers): Add Delivered-To.
-
- * gnus-sum.el (gnus-summary-find-next): Indent.
- (gnus-summary-find-prev): Ditto.
- (gnus-summary-catchup): Doc fix.
- (gnus-summary-mark-current-read-and-unread-as-read): New function.
- (gnus-summary-catchup): Really mark after point.
-
- * gnus-util.el (gnus-user-date): Use %d instead of %m.
- (gnus-user-date): Use floating point time so that we don't get
- overflows.
-
- * gnus-sum.el (gnus-summary-local-variables): Clean up.
-
- * gnus-fun.el (gnus-display-x-face-in-from): Don't use centering
- since none of the other image things do.
-
-2003-05-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (assq-delete-all): New compiler macro for Emacs 20.
-
-2003-05-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind find-coding-system.
-
- * dgnushack.el (dgnushack-make-load): Remove redundant format call
- in message. Suggested by Yoichi NAKAYAMA <yoichi@geiin.org>.
- * pop3.el (pop3-movemail): Ditto.
-
-2003-05-12 Colin Marquardt <c.marquardt@alcatel.de> (tiny change)
-
- * gnus.el (gnus-agent): Docstring fix.
-
-2003-05-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-install): new variable
- (gnus-registry-fetch-extra, gnus-registry-fetch-extra-entry)
- (gnus-registry-store-extra-entry, gnus-registry-delete-group)
- (gnus-registry-add-group): add a modification timestamp to each entry
- (gnus-registry-install-hooks): new function
-
-2003-05-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-cat-name): Eval macro while compiling.
- (gnus-agent-cat-disable-undownloaded-faces): New function.
- Accessor for new agent property
- 'agent-disable-undownloaded-faces'.
- gnus-cus.el (gnus-agent-parameters): Added
- agent-disable-undownloaded-faces and corrected documentation.
- (gnus-agent-cat-prepare-category-field,
- gnus-agent-customize-category): Changed to avoid creating free
- references to each field's symbol.
- gnus-sum.el (gnus-summary-use-undownloaded-faces): New local variable.
- (gnus-select-newgroup): Initialize it.
- (gnus-summary-highlight-line): Use it.
-
-2003-05-12 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-read-charset): Deleted.
- (mm-coding-system-mime-charset): New.
- (mm-read-coding-system, mm-mule-charset-to-mime-charset)
- (mm-charset-to-coding-system, mm-mime-charset)
- (mm-find-mime-charset-region): Use it.
- (mm-default-multibyte-p): Fix non-mule case.
-
- * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-bol): Eval
- and compile.
- (rfc2047-syntax-table): Fix building table to work in Emacs 22.
- (rfc2047-unfold-region): Delete unused var `leading'.
-
-2003-05-12 Ville Skytt\e,Ad\e(B <scop@xemacs.org> (tiny change)
-
- * pgg.el (pgg-temp-buffer-show-function): Reuse existing visible
- output window if one is available.
-
-2003-05-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Added
- space.
-
-2003-05-11 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Don't do article
- washing etc.
- (gnus-handle-ephemeral-exit): Don't reload article after exiting.
-
- * nndoc.el (nndoc-type-alist): `mime-digest' should be before
- `mime-parts'.
-
-2003-05-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-cite.el (gnus-article-hide-citation-maybe): Make toggling
- work. Update mode-line.
-
-2003-05-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-logo-color-alist): Added no colours.
-
-2003-05-09 Dave Love <fx@gnu.org>
-
- * utf7.el (mm-util): Require.
- (utf7-direct-encoding-chars, utf7-imap-direct-encoding-chars):
- Defconst, not defvar.
- (utf7-utf-16-coding-system): New.
- (utf7-encode-internal): Hoist concat out of loop.
- (utf7-fragment-encode): Use mm-with-unibyte-current-buffer.
- (utf7-get-u16char-converter) [utf7-utf-16-coding-system]: New
- case.
- (utf7-latin1-u16-char-converter): Encode the region.
- (utf7-u16-latin1-char-converter): Decode the region.
- (utf7-encode, utf7-decode): Fix multibyteness.
-
- * mm-bodies.el (mm-body-7-or-8): Don't special-case mule.
- (mm-encode-body): Use mm-read-coding-system, not mm-read-charset.
- (mm-uu-yenc-decode-function): Defvar when compiling.
- (mm-encode-body, mm-decode-body): Doc fix.
-
-2003-05-09 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-unregistered-group-regex):
- removed in favor of the group/topic/global variables
- (gnus-registry-register-message-ids): fixed test to omit
- gnus-registry-unregistered-group-regex
-
- * gnus.el (gnus-variable-list): removed gnus-registry-alist and
- gnus-registry-headers-alist from the list
- (gnus-registry-headers-alist): removed
- (registry-ignore): new parameter, with accompanying
- gnus-registry-ignored-groups global variable
-
- * gnus-start.el (gnus-clear-system): no need to clear the
- registry, we can do it ourselves
- (gnus-gnus-to-quick-newsrc-format): extra parameters so it can be
- used by gnus-registry.el
-
- * gnus-registry.el (gnus-registry-cache-file): new file variable
- (gnus-registry-cache-read, gnus-registry-cache-save): new
- functions
- (gnus-registry-save, gnus-registry-read): use the new
- gnus-registry-cache-{read|save} functions, and change the name
- from gnus-registry-translate-{from|to}-alist
- (gnus-registry-clear): fixed so it doesn't refer to old function name
-
-2003-05-09 Dan Christensen <jdc@chow.mat.jhu.edu>
-
- * gnus-registry.el (gnus-registry-cache-whitespace): new function.
-
-2003-05-09 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-picon.el (gnus-picon-transform-address): Parse the encoded
- address.
-
-2003-05-08 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-start.el (gnus-clear-system): added gnus-registry-alist to
- the list of cleared variables
-
- * gnus-registry.el (gnus-registry-split-fancy-with-parent):
- nnmail-split-fancy-with-parent-ignore-groups can be a single regex
- in addition to a list of regexes.
-
-2003-05-08 Niklas Morberg <niklas.morberg@axis.com>
-
- * spam.el (spam-use-regex-headers): docstring fix.
-
-2003-05-08 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus-sum.el (gnus-summary-next-page): Mention
- `gnus-article-skip-boring' in docstring.
-
-2003-05-08 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2231.el (rfc2231-parse-string): "=" should have whitespace
- syntax here.
-
- * ietf-drums.el (ietf-drums-syntax-table): "=" should not have
- whitespace syntax class when parsing email addresses.
-
- * message.el (message-forward-subject-name-subject): Don't use
- mail-decode-encoded-word-string before parsing from.
-
-2003-05-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup-1): Setup alternative email before
- generate-headers.
-
- (message-forward-subject-name-subject): Fix the case when the
- field "from" doesn't exist.
-
-2003-05-07 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-encode-region): Skip \n as whitespace.
-
- * mm-util.el (mm-find-mime-charset-region): Expurgate utf-16 from
- possible values.
-
-2003-05-07 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-kill-to-signature): Fix.
-
-2003-05-06 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-auto-goto-ignores): Docstring fix.
-
- * gnus-art.el (gnus-mime-display-multipart-as-mixed)
- (gnus-mime-display-multipart-related-as-mixed)
- (gnus-button-mid-or-mail-heuristic-alist): do.
-
-2003-05-05 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-default-multibyte-p): New.
- (mm-coding-system-p): Maybe use find-coding-systems.
-
-2003-05-04 Dave Love <fx@gnu.org>
-
- * rfc2047.el (with-syntax-table): Define if necessary.
- (rfc2047-syntax-table): Fix last change for XEmacs.
- (rfc2047-parse-and-decode): Revert last change.
-
-2003-05-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el: Don't test for `mm-guess-mime-charset'.
-
- * mm-util.el (mm-guess-mime-charset): Remove. Not used any more.
-
- * gnus.el (gnus-default-charset): Set default value to
- `undecided'.
-
- * gnus-art.el (article-decode-charset): Don't supply 4th arg to
- mm-decode-body.
-
- * mm-bodies.el (mm-decode-coding-region-safely): Remove.
- (mm-decode-body): Don't use mm-decode-coding-region-safely.
-
-2003-05-03 Vasily Korytov <deskpot@despammed.com> (tiny change)
-
- * gnus-util.el (gnus-multiple-choice): Add ", ?".
-
-2003-05-03 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-syntax-table): Don't call make-char-table
- with 2 args.
- (rfc2047-decode-string): Don't set the buffer multibyte before
- calling buffer-string.
-
- * mm-encode.el (mm-long-lines-p): Autoload.
- (mm-encode-content-transfer-encoding): Doc fix. Don't make buffer
- unibyte. Signal error on unknown encoding.
- (mm-encode-buffer, mm-qp-or-base64): Doc fix.
-
- * rfc2047.el (rfc2047-point-at-bol, rfc2047-point-at-eol): New.
- Callers of gnus- versions changed to use them.
- (rfc2047-header-encoding-alist): Add `address-mime' part. Doc
- fixes.
- (rfc2047-encoding-type): New.
- (rfc2047-encode-message-header): Use mm-charset-to-coding-system.
- Don't include header name field in encoding. Add `address-mime'
- case and bind rfc2047-encoding-type for `mime' case.
- (rfc2047-encodable-p): Deleted.
- (rfc2047-syntax-table): New.
- (rfc2047-encode-region, rfc2047-encode): Rewritten to take account
- of rfc2047 rules with respect to rfc2822 tokens and to do encoding
- in place rather than by passing strings.
- (rfc2047-encode-string): Doc fix.
- (rfc2047-q-encode-region): Don't use
- mm-with-unibyte-current-buffer.
- (rfc2047-encoded-word-regexp): eval-and-compile.
- (rfc2047-decode-region): Avoid concatenation in loop.
- (rfc2047-parse-and-decode): Remove useless disjunction.
-
-2003-05-02 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-q-encode-region, rfc2047-decode): Use
- mm-with-unibyte-current-buffer.
- (ietf-drums, gnus-util): don't require.
-
- * sieve.el (sieve-manage-mode-menu): Define before use.
-
- * mml-smime.el (message-narrow-to-headers): Autoload.
-
- * mm-util.el (mm-coding-system-p): Don't override nil from
- coding-system-p.
- (mm-mule4-p, mm-disable-multibyte-mule4)
- (mm-with-unibyte-current-buffer-mule4): Deleted.
- (mm-multibyte-p): Use defun, not defalias.
- (mm-make-temp-file): Moved to group at top of file.
- (mm-point-at-eol, mm-point-at-bol): New.
-
- * gnus-cite.el (gnus-art): Require.
-
- * gnus-ems.el (gnus-get-buffer-create)
- (nnheader-find-etc-directory, message-text-with-property):
- Autoload.
- (gnus-tmp-unread, gnus-tmp-replied, gnus-tmp-score-char)
- (gnus-tmp-indentation, gnus-tmp-opening-bracket, gnus-tmp-lines)
- (gnus-tmp-name, gnus-tmp-closing-bracket, gnus-tmp-subject-or-nil)
- (gnus-check-before-posting): Only defvar when compiling.
-
- * gnus-int.el (gnus-agent-expire): Autoload, don't defun.
-
- * gnus-util.el (rmail-default-rmail-file, mm-text-coding-system):
- Defvar when compiling.
- (gnus-output-to-rmail): Require mm-util.
-
- * mail-source.el (mail-source-callback): Use mm-make-temp-file.
- (mail-source-make-complex-temp-name): Deleted.
-
- * message.el (message-use-idna): Use mm-coding-system-p.
- (message-tokenize-header, message-make-organization)
- (message-make-from): Use with-temp-buffer.
- (message-set-work-buffer): Deleted.
- (message-fill-paragraph): Use `if' not `and' for compiler warning.
- (message-check-news-header-syntax): Remove useless lambda.
- (message-forward-make-body): Use mm-disable-multibyte,
- mm-with-unibyte-current-buffer, mm-enable-multibyte.
- (message-replace-chars-in-string): Deleted.
-
- * mm-extern.el (mm-extern-local-file): Use mm-disable-multibyte.
- (mm-extern-url): Use mm-with-unibyte-current-buffer,
- mm-disable-multibyte.
- (mm-extern-anon-ftp): Use mm-disable-multibyte.
-
- * mml1991.el (mml1991-mailcrypt-encrypt, mml1991-gpg-encrypt): Use
- mm-with-unibyte-current-buffer.
-
- * mml2015.el (mml): Require.
- (mml2015-mailcrypt-encrypt, mml2015-gpg-encrypt): Use
- mm-with-unibyte-current-buffer.
-
- * nnheader.el (gnus-util): Require.
-
- * nntp.el (format-spec, format-spec-make, open-tls-stream):
- Autoload.
-
- * rfc2231.el (mail-header-remove-comments, mm-encode-body)
- (mail-header-remove-whitespace): Autoload.
-
- * sieve-manage.el (starttls-negotiate): Autoload.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnrss.el (nnrss-find-rss-via-syndic8): Indent.
-
-2003-05-01 Mark A. Hershberger <mah@everybody.org>
-
- * nnrss.el (nnrss-find-rss-via-syndic8): Don't error out.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-05-01 Jon Ericson <Jon.Ericson@jpl.nasa.gov> (tiny change)
-
- * spam-report.el (spam-report-gmane-regex): docstring fix.
-
- * gnus.el (gnus-install-group-spam-parameters): docstring fix.
-
-2003-05-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-fetch-extra)
- (gnus-registry-store-extra, gnus-registry-group-count): new functions
- (gnus-registry-fetch-group, gnus-registry-delete-group)
- (gnus-registry-add-group): changed to work with extra data element
- if present
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Gnus v5.10.1 is released.
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.24 is released.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dgnushack.el (when): Check whether defadvice is fbound.
-
-2003-05-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-unregistered-group-regex): new variable
- (gnus-registry-register-message-ids): use it
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
- * gnus.el: Update copyright for several files.
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.23 is released.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * spam-stat.el (spam-stat-test-directory): Compare against zero.
-
-2003-05-01 Trey Jackson <tjackson@ichips.intel.com> (tiny change)
-
- * spam-stat.el (spam-stat-test-directory): Skip 0 length files.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-forward-subject-name-subject): Decode
- string when forwarding.
-
-2003-05-01 Oystein Viggen <oysteivi@tihlde.org>
-
- * dgnushack.el (when): Add defadvice.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.22 is released.
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.21 is released.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-05-01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.20 is released.
-
-2003-05-01 Vasily Korytov <deskpot@despammed.com>
-
- * gnus-dired.el (gnus-dired-mode-map): Move to C-c C-l.
-
-2003-04-30 Mark A. Hershberger <mah@everybody.org>
-
- * mm-url.el (mm-url-insert-file-contents): set url-current-object
- in the case where mm-url-use-external is set.
-
- * nnrss.el (nnrss-request-article): Change the messages created to
- multipart/alternative. Hopefully fixes a problem interaction with
- w3m.
- (nnrss-find-rss-via-syndic8): Better handling if xml-rpc.el isn't
- around.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-check-news-header-syntax): Alter "posting"
- message.
-
- * nnrss.el (nnrss-node-text): Don't use char classes.
-
-2003-05-01 David Z. Maze <dmaze@mit.edu>
-
- * nnrss.el (nnrss-find-rss-via-syndic8): Have an `error' branch
- in condition-case.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-required-headers): Remove In-Reply-To.
-
- * gnus-int.el (gnus-open-server): Revert changes.
-
-2003-04-30 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus-int.el (gnus-open-server): Try to open unagentized servers
- even when unplugged.
-
-2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-prefer-mid-or-mail): Fixed typo in
- doc-string.
-
-2003-05-01 Steve Youngs <youngs@xemacs.org>
-
- * lpath.el: Add a section for non-Mule XEmacsen.
- fbind `find-charset-string' and `coding-system-base' in that
- section.
-
- * gnus-util.el (gnus-completing-read-maybe-default): New.
- (gnus-completing-read): Use it.
-
- * mm-view.el (mm-view-pkcs7-decrypt): Ditto.
-
- * gnus-art.el (gnus-read-string): New.
- (gnus-summary-pipe-to-muttprint): Use it.
-
- * gnus-xmas.el (gnus-xmas-open-network-stream): New.
-
- * dns.el (dns-make-network-process): Use it.
-
- Take care of some differences between XEmacs 21.1 and newer
- versions of XEmacs.
-
-2003-04-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-split-fancy-with-parent): added
- diagnostic message
- (gnus-registry-grep-in-list): don't run when word is nil
- (gnus-registry-fetch-message-id-fast): new function
- (gnus-registry-delete-group, gnus-registry-add-group): make sure
- the id and group are not nil
- (gnus-registry-register-message-ids): new function
- (gnus-register-action): optimized logical flow
- (gnus-summary-prepare-hook): added gnus-registry-register-message-ids
-
-2003-04-30 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus-delay.el (gnus-delay-article): Call
- `gnus-agent-queue-setup' to create the delay group.
-
- * gnus-agent.el (gnus-agent-queue-setup): Support optional arg
- for the (queue) group name.
-
-2003-04-30 Simon Josefsson <jas@extundo.com>
-
- * mm-util.el (mm-charset-to-coding-system): Use user specified
- charset unless coding-system-get is fboundp.
-
-2003-04-30 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-cat-defaccessor, gnus-agent-cat-name):
- Wrapped in eval-when-compile.
- (gnus-agent-mode): Bind gnus-agent-go-online to nil as you
- shouldn't be asked twice to go online with each server.
- (gnus-agent-get-undownloaded-list, gnus-agent-fetch-articles,
- gnus-agent-crosspost, gnus-agent-flush-cache,
- gnus-agent-fetch-session, gnus-agent-unread-articles,
- gnus-agent-uncached-articles, gnus-agent-regenerate-group,
- gnus-agent-group-covered-p): Expanded pop macros used for
- effect. Avoids compilation warning in emacs 21.3.
-
- * gnus-int.el (gnus-open-server): Restructured to only open
- nnagent when gnus-plugged is nil.
-
-2003-04-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind string-to-multibyte.
-
-2003-04-30 Steve Youngs <youngs@xemacs.org>
-
- * dgnushack.el: Add some missing autoloads for XEmacs 21.1.
-
-2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-fetch-group): faster
- (gnus-registry-delete-group): new function
- (gnus-registry-add-group): new function
- (gnus-register-spool-action): use it
- (gnus-register-action): use it
- (gnus-registry-translate-from-alist)
- (gnus-registry-translate-to-alist): remove the headers registry
- for now
-
-2003-04-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-alist): Fixed CTAN regexp.
-
-2003-04-29 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam-report.el (spam-report-gmane): gnus-summary-article-number
- is not necessary, just use the function parameter
-
-2003-04-29 Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>
-
- * spam-stat.el (spam-stat-save): No longer font-locks the file
- when saving
-
-2003-04-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el: Bind mail-header-separator when compiling (XEmacs
- provides it in mail-lib/auto-autoloads.el).
-
-2003-04-29 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-pgg-sign): Use mml-sender instead of
- message-sender.
-
- * mml.el (mml-generate-mime-1): Set mml-sender too.
-
-2003-04-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-display-while-building): Docstring fix.
-
- * mm-url.el (mm-url-use-external): do.
-
-2003-04-29 Simon Josefsson <jas@extundo.com>
-
- * canlock.el (mail-fetch-field): Autoload it (fix xemacs compile
- warnings).
-
- * sieve-mode.el (c-mode): Ditto.
-
- * pgg.el (run-at-time): Ditto.
-
- * mm-url.el (require): Require timer when compiling for
- with-timeout macro (fix xemacs compile warnings).
-
-2003-04-28 Dave Love <fx@gnu.org>
-
- * gnus-util.el (nnheader): Don't require.
- (Nnheader-narrow-to-headers, nnheader-replace-chars-in-string):
- Autoload.
-
- * spam.el: Require cl when compiling.
-
- * dns.el: Require cl when compiling.
-
-2003-04-28 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-goto-next-page)
- (gnus-article-goto-prev-page): Revert 2003-02-12 change to make
- gnus-pick-mode work.
-
-2003-04-28 Steve Youngs <youngs@xemacs.org>
-
- * Makefile.in (FLAGS): Use @FLAGS@.
-
-2003-04-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-mime-display-multipart-as-mixed)
- (gnus-mime-display-multipart-alternative-as-mixed)
- (gnus-mime-display-multipart-related-as-mixed): Added doc-strings,
- allow customization.
-
-2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * dgnushack.el (dgnushack-compile-verbosely): New function. Not
- currently called (See source for explanation).
-
-2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-catchup): Don't mark ticked messages.
- (gnus-summary-mark-read-and-unread-as-read): Take an optional
- mark.
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-04-27 06:47:31 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.19 is released.
-
-2003-04-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-registry.el (gnus-register-spool-action): Replaced literal
- carriage-return character with its escape sequence.
-
-2003-04-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-catchup-from-here): Doc fix.
-
- * nnrss.el (nnrss-node-text): Use only one
- gnus-replace-in-string.
-
- * gnus.el: Remove gnus-functionp throughout.
-
- * gnus-util.el (gnus-functionp): Removed.
-
- * gnus-msg.el (gnus-summary-wide-reply-with-original): Doc fix.
-
- * message.el (message-required-headers): Add In-Reply-To.
-
-2003-04-27 Marshall T. Vandegrift <vandem2@rpi.edu>
-
- * gnus-fun.el (gnus-face-from-file): Bind coding-system-for-read
- to binary.
-
-2003-04-27 Jesper Harder <harder@ifa.au.dk>
-
- * mml.el (mml-preview): do.
-
- * message.el (message-mode): do.
-
- * gnus-undo.el (gnus-undo-mode): do.
-
- * gnus-topic.el (gnus-topic-mode): do.
-
- * gnus-sum.el (gnus-summary-mode, gnus-summary-edit-article): do.
-
- * gnus-msg.el (gnus-setup-message)
- (gnus-inews-add-send-actions, gnus-configure-posting-styles): do.
-
- * gnus-gl.el (gnus-grouplens-mode): do.
-
- * gnus-art.el (gnus-mime-save-part-and-strip)
- (gnus-mime-delete-part): Use it.
-
- * gnus-util.el (gnus-make-local-hook): New function.
-
-2003-04-25 Simon Josefsson <jas@extundo.com>
-
- * nnrss.el (nnrss-node-text): Don't use a star.
- (nnrss-node-text): Use g-r-i-s, not g-r-r-i-s which doesn't exist.
-
-2003-04-24 Dave Love <fx@gnu.org>
-
- * mm-encode.el (mm-long-lines-p): Autoload.
- (mm-encode-content-transfer-encoding): Don't try to make buffer
- unibyte before decoding. Don't ignore errors for base64 encoding.
-
- * qp.el (quoted-printable-decode-region): Use mm-insert-byte.
- Signal error on malformed text, as for base64.
- (quoted-printable-encode-region): DTRT in Emacs 22.
-
- * mm-util.el (mm-make-temp-file, mm-insert-byte): New.
- (mm-auto-save-coding-system): Consider utf-8-emacs.
- (mm-mime-mule-charset-alist, mm-mule-charset-to-mime-charset)
- (mm-charset-to-coding-system, mm-mime-charset)
- (mm-find-mime-charset-region): Check for :mime-charset coding
- systems property.
-
- * mml-sec.el (mml2015, mml1991): Don't require.
- (mml2015-sign, mml2015-encrypt, mml1991-sign, mml1991-encrypt)
- (message-goto-body, mml-insert-tag): Autoload.
-
- * mm-decode.el (mm-tmp-directory): Re-write to help avoid warnings.
-
- * gnus-start.el (message-make-date): Autoload rather than
- requiring message.
-
- * gnus-group.el (gnus-group-name-charset-group-alist): Use
- mm-coding-system-p.
- (gnus-cache-active-altered): Defvar when compiling.
- (gnus-group-delete-group): Re-write to help avoid warnings.
-
- * gnus-art.el (gnus-use-idna): Use mm-coding-system-p.
-
- * pgg.el: Split eval-when-compile forms.
-
-2003-04-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-large-ephemeral-newsgroup)
- (gnus-fetch-old-ephemeral-headers): News variables.
- (gnus-group-read-ephemeral-group): Use them.
-
-2003-04-24 Simon Josefsson <jas@extundo.com>
-
- * sieve.el (sieve-upload): Don't use replace-regexp-in-string.
-
- * nnrss.el (nnrss-node-text): Ditto.
-
-2003-04-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-inews-do-gcc): Make sure the obsolete variable
- gnus-inews-mark-gcc-as-read exists.
-
-2003-04-23 Simon Josefsson <jas@extundo.com>
-
- * gnus-sieve.el (gnus-sieve-generate): Rewrite regexp search so it
- doesn't exceed the regexp stack space.
-
-2003-04-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-inews-mark-gcc-as-read): Don't defvar it.
-
- * gnus-art.el (gnus-article-hide-pgp-hook): do.
-
-2003-04-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mml.el (mml-preview): Bind `=', RET, and mouse-2.
-
-2003-04-23 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-decode-body): Don't override supplied charset.
-
-2003-04-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (merge, copy-list): Remove compiler macros.
- (butlast): Add a compiler macro.
-
-2003-04-22 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-util.el (gnus-merge): Added "type" argument to match CL
- merge and gnus-sum.el's expectations.
-
-2003-04-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-url-regexp): Added nntp.
-
- * message.el (message-generate-headers-first): Default to
- '(references).
-
- * gnus-art.el (gnus-mime-delete-part): Require confirmation.
-
-2003-04-21 Jesper Harder <harder@ifa.au.dk>
-
- * smime.el (smime-decrypt-region): Insert From header.
-
-2003-04-21 Gaute B Strokkenes <gs234@cam.ac.uk> (tiny change)
-
- * gnus-fun.el (gnus-face-from-file, gnus-convert-png-to-face):
- Max length of header is 726, not 740.
-
-2003-04-20 Jesper Harder <harder@ifa.au.dk>
-
- * nndb.el, mml1991.el: Fix license template.
-
-2003-04-20 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-split-articles): Don't download body unless
- required.
-
- * imap.el (imap-gssapi-open, imap-ssl-open): Erase buffer before
- starting process, like imap-kerberos4-open does.
-
- * mml-smime.el, rfc1843.el, dig.el, smime.el, uudecode.el: Fix
- license template.
-
- * mml-sec.el: Fix license template.
-
- * gnus-sieve.el, sieve.el, sieve-manage.el, sieve-mode.el: Fix
- license template.
-
- * pgg-def.el, pgg.el, pgg-gpg.el, pgg-parse.el, pgg-pgp5.el,
- pgg-pgp.el: Fix license template.
-
-2003-04-19 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-delete-article): Improve docstring.
-
-2003-04-19 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-move-spam-nonspam-groups-only): dumb typo fix
-
-2003-04-18 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-split): allow a particular check as a parameter,
- e.g. (: spam-split 'spam-use-bogofilter)
- (spam-mark-only-unseen-as-spam): new parameter, see doc
- (spam-mark-junk-as-spam-routine): use
- spam-mark-only-unseen-as-spam, simplify routine to take advantage
- of gnus-newsgroup-unread as well as gnus-newsgroup-unseen
-
-2003-04-17 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.el (gnus-group-short-name, gnus-group-prefixed-p): new functions
- (gnus-group-guess-full-name): don't prefix the group twice
-
- * nnmail.el (nnmail-split-fancy-with-parent): docstring fix
-
- * gnus-registry.el (gnus-registry-clear)
- (gnus-registry-fetch-group, gnus-registry-grep-in-list)
- (gnus-registry-split-fancy-with-parent): new functions
- (gnus-register-spool-action, gnus-register-action): simplified the format
- (gnus-registry): new customization group
- (gnus-registry-unfollowed-groups): new variable
-
-2003-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-alist): Add nntp: urls.
- (gnus-header-button-alist): Ditto.
-
-2003-04-17 Dave Love <fx@gnu.org>
-
- * gnus-util.el (gnus-string-equal): Revert last change.
-
-2003-04-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-browse-make-menu-bar): Fix typo.
-
-2003-04-17 Mike Woolley <mike@ariel.co.uk>
-
- * gnus-sum.el (gnus-sum-thread-tree-false-root): New variable.
-
-2003-04-15 Michael Shields <shields@msrl.com>
-
- * gnus-art.el (article-hide-boring-headers): Hide Reply-To: if
- the broken-reply-to group parameter is set. Idea from Vasily
- Korytov <deskpot@myrealbox.com>.
-
-2003-04-17 Steve Youngs <youngs@xemacs.org>
-
- * dgnushack.el: 'setenv' is in env.el for XEmacsen <= 21.4, but in
- process.el in XEmacsen >= 21.5.
-
-2003-04-17 Steve Youngs <youngs@xemacs.org>
-
- * dgnushack.el: Add a whole swag of autoloads and defaliases to
- satisfy the byte-compiler when building with XEmacs.
-
- * lpath.el (maybe-bind): Add 'w3-meta-content-type-charset-regexp'
- and 'w3-meta-charset-content-type-regexp' in XEmacs. The upstream
- W3 doesn't have these.
-
- * mailcap.el: Maybe require 'lpr in XEmacs.
-
-2003-04-16 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-pgg-sign): Bind pgg-default-user-id to MML
- sender tag, if available.
-
-2003-04-16 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-register-action)
- (gnus-register-spool-action, hashtable-to-alist)
- (gnus-registry-translate-from-alist, alist-to-hashtable)
- (gnus-registry-translate-to-alist, gnus-registry-headers-hashtb):
- new variables and function fixes
-
- * gnus.el (gnus-registry-headers-alist): new variable to hold
- article header data
- (gnus-variable-list): save gnus-registry-headers-alist
-
- * spam-report.el (Module): new module for spam reporting
-
- * gnus.el (spam-process): added
- gnus-group-spam-exit-processor-report-gmane to the list of choices
- (gnus-install-group-spam-parameters): defined new spam exit processor
-
- * spam.el (autoload): autoload spam-report-gmane when needed
- (spam-report-gmane-register-routine): glue for spam-report.el
- (spam-group-spam-processor-report-gmane-p): glue for the
- gnus-group-spam-exit-processor-report-gmane spam processor
- (spam-summary-prepare-exit): check the report-gmane spam processor
- and run spam-report-gmane-register-routine if it's active
-
-2003-04-16 John Wiegley <johnw@gnu.org>
-
- * spam.el (spam-bogofilter-score): check bogofilter headers before
- checking bogofilter itself
-
-2003-04-16 Dave Love <fx@gnu.org>
-
- * gnus-agent.el: Wrap defsetf in eval-when-compile.
- (gnus-agent-cat-defaccessor): Don't use gensym.
-
- * mml1991.el: Require cl, mm-util when compiling.
- (quoted-printable-decode-region, quoted-printable-encode-region):
- Autoload.
-
- * pgg.el: Require cl when compiling.
-
- * nnmail.el (gnus): Require.
-
- * gnus-util.el: Move provide to end.
- (gnus-string-equal): Maybe use compare-strings.
- (gnus-merge): New.
-
- * gnus-sum.el (gnus-summary-prepare-threads): Don't use copy-list.
- (gnus-summary-insert-articles): Use gnus-merge.
-
- * gnus-fun.el: Require cl and mm-util when compiling.
-
- * gnus-diary.el (gnus-diary-delay-format-french)
- (gnus-diary-delay-format-english): Don't use setf with nthcdr.
-
- * nndiary.el (nndiary-compute-reminders): Don't use setf with
- nthcdr.
-
-2003-04-16 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-make-cat): Added optional parameter to
- specify a predicate other than false.
- (gnus-category-read): Use the new feature to create a 'default'
- category with a 'short' predicate.
-
-2003-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-unique-id): Comment change.
-
- * gnus-art.el (gnus-article-next-page-1): New function.
- (gnus-article-next-page): Use it.
-
-2003-04-15 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-split): added save-restriction to save-excursion
-
-2003-04-15 Julien Avarre <julien@avarre.com>
-
- * gnus-fun.el: Fixed autoload cookie.
-
-2003-04-15 Remi Letot <remi.letot@easynet.be>
-
- * nnmaildir.el (nnmaildir-request-scan): Use gnus-remove-if
- instead of remove-if.
-
-2003-04-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-summary-news-other-window): Use delq and
- copy-sequence instead of remove which is a cl run-time function in
- Emacs 20.
-
-2003-04-14 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-summary-news-other-window): Make a buffer
- local copy of gnus-discouraged-post-methods with the current
- method removed.
-
-2003-04-14 Simon Josefsson <jas@extundo.com>
-
- * mailcap.el (mailcap-mime-data): Add application/pgp-keys.
-
-2003-04-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-util.el (mm-sort-coding-systems-predicate): Convert elements
- of `mm-coding-system-priorities' to base coding system.
-
- * gnus-sum.el: Added coding cookie ("middle dot" in
- gnus-summary-morse-message).
-
-2003-04-13 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (article-fill-long-lines)
- (article-verify-x-pgp-sig, article-decode-group-name)
- (gnus-mime-button-menu): Split >80 character lines.
-
-2003-04-13 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-local-variables): Use defvar since
- we're let-binding it.
-
- * nnmbox.el (nnmbox-mbox-buffer): It's not a constant.
-
-2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-hide-headers): Don't do intangible.
-
- * gnus.el (gnus-group-prefixed-name): Comment out the test for
- colon.
-
- * gnus-srvr.el (gnus-browse-read-group): Don't give the real name
- to the ephemeral entry, but the prefixed name.
-
- * gnus.el (gnus-group-prefixed-name): Clean up.
-
-2003-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-group-pathname): Bind
- gnus-command-method so that gnus-agent-directory will always
- return a valid directory.
- * gnus-cache.el (gnus-cache-enter-article): Remove article from
- gnus-newsgroup-undownloaded so that the summary will display the
- article as downloaded.
- (gnus-cache-remove-article): If the article isn't in the agent,
- remove it from gnus-newsgroup-undownloaded so that the summary
- will display the article as undownloaded.
-
-2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-04-13 01:12:01 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.18 is released.
-
-2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-draft-send): Add message-hidden-headers.
-
-2003-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-next-page): Use
- gnus-article-over-scroll.
- (gnus-article-over-scroll): New variable.
-
- * message.el (message-newline-and-reformat): Place a boundary
- before filling.
- (message-make-forward-subject-function): Changed default to
- message-forward-subject-name-subject.
- (message-forward-subject-name-subject): New function.
-
- * nnimap.el (nnimap-split-fancy): Ditto.
-
- * gnus-sum.el (gnus-summary-line-message-size): Ditto.
-
- * gnus-cus.el (gnus-group-parameters): Removed "which see".
-
- * mml.el (mml-minibuffer-read-file): Bind
- completion-ignored-extensions to nil.
-
- * message.el (message-fix-before-sending): Comment fix.
- (message-fix-before-sending): Make hidden headers visible.
- (message-hide-headers): Bind after-change-functions to nil.
- (message-forbidden-properties): Put invisible and intangible
- back.
- (message-strip-forbidden-properties): Ignore message-hidden text.
-
- * gnus-msg.el: Hide headers.
-
- * message.el (message-hidden-headers): New variable.
- (message-hide-headers): New function.
- (message-hide-header-p): New function.
- (message-hide-header-p): Change logic.
- (message-forbidden-properties): Remove intangible nil invisible
- nil.
- (message-hide-headers): Narrow to headers.
-
- * lpath.el (featurep): Bind Info-directory, Info-menu.
-
-2003-04-12 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-body-charset-encoding-alist): UTF-16 *must* be
- encoded.
- (mm-encode-body): Don't corrupt UTF-16.
- (mm-body-encoding): Pay attention to mm-body-charset-encoding-alist.
-
-2003-04-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Articles in
- the CACHE are now detected and handled the same as an article
- downloaded into the agent.
- (gnus-agent-group-path): Modified to match nnmail-group-pathname
- so that the agent front-end and back-end (nnagent) always use the
- same directory.
- (gnus-agent-group-pathname): New function. Wrapper for
- nnmail-group-pathname.
- (gnus-agent-expire-unagentized-dirs): New variable. May be
- customized to disable gnus-agent-expire-unagentized-dirs.
- (gnus-agent-expire-unagentized-dirs): Expand gnus-agent-directory
- as the directories in gnus-agent-expire-current-dirs were
- expanded.
-
-2003-04-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Encrypt
- body" entry in read only groups.
-
-2003-04-09 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Disable "Import file"
- and "Create article" items in non-editable groups.
-
-2003-04-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-write-active): Added option of
- replacing, rather than updating, the agent's active file. Do NOT
- use the fully qualified group name as gnus-active-to-gnus-format
- blindly prefixes group names with server names.
- (gnus-agent-save-group-info): Merge BOTH min/max of current active
- range, was just merging min, with specified active range.
- (gnus-agent-expire): Save agent's active ranges after
- expiring all groups.
- (gnus-agent-expire-group-1): Update min of agent's active range to
- min article currently fetched.
- (gnus-agent-expire-unagentized-dirs): Avoid asking to delete the
- same ancestor multiple times.
-
- * gnus-async.el (gnus-asynchronous): Moved defcustom of
- gnus-asynchronous away from defgroup of gnus-asynchronous. This
- seems to fix an intermittant error in which loading gnus-async
- fails to define gnus-asynchronous (the variable).
-
- * gnus-sum.el: Concur with Steve Young, 5th argument to 'load' is
- non-essential. Removed on all platforms.
- (gnus-select-newsgroup): When the agent is active, expand the
- group's active range to include fetched articles that are no
- longer in the server's active range.
-
- * gnus-util.el (gnus-with-output-to-file): Removed all of the
- print-* bindings as they should be handled by the function doing
- the printing.
-
-2003-04-09 Jesper Harder <harder@ifa.au.dk>
-
- * mm-uu.el (mm-uu-copy-to-buffer): buffer-file-coding-system
- might be unbound in non-MULE XEmacsen.
-
-2003-04-08 Jesper Harder <harder@ifa.au.dk>
-
- * mm-uu.el (mm-uu-diff-groups-regexp, mm-uu-type-alist)
- (mm-uu-diff-extract, mm-uu-diff-test): New functionality:
- recognize diffs.
-
- * mm-bodies.el (mm-decode-body): Use the supplied charset
- unconditionally if `code-pages' hasn't been loaded.
-
-2003-04-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (article-verify-x-pgp-sig): Don't use
- `insert-buffer', the docstring says "This function is meant for
- the user to run interactively. Don't call it from programs!"
-
- * mm-extern.el (mm-extern-mail-server): do.
-
- * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-sign)
- (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign)
- (mml1991-pgg-encrypt): do.
-
- * pgg.el (pgg-decrypt-region): do.
-
- * mm-view.el (mm-view-pkcs7-decrypt): do.
-
- * mml-smime.el (mml-smime-verify): do.
-
- * mml.el (mml-insert-mime, mml-preview): do.
-
- * mml2015.el (mml2015-gpg-decrypt-1, mml2015-gpg-sign)
- (mml2015-gpg-encrypt, mml2015-pgg-clear-decrypt)
- (mml2015-pgg-encrypt): do.
-
-2003-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-bodies.el (mm-decode-body): Silence XEmacs when compiling.
-
-2003-04-06 Jesper Harder <harder@ifa.au.dk>
-
- * mm-uu.el (mm-uu-copy-to-buffer): Copy
- `buffer-file-coding-system' to the new buffer.
- (mm-uu-pgp-signed-extract-1): Don't copy
- `buffer-file-coding-system' here.
-
- * mm-bodies.el (mm-decode-body): last-coding-system-used doesn't
- exist in XEmacs.
- (mm-decode-body): Add missing quote.
-
- * mm-uu.el (mm-uu-pgp-signed-extract-1): Set
- buffer-file-coding-system.
-
- * mm-bodies.el (mm-decode-body): Set buffer-file-coding-system to
- last-coding-system-used.
-
- * mml2015.el (mml2015-pgg-clear-verify): Encode the text
- according to buffer-file-coding-system.
-
- * pgg-gpg.el (pgg-gpg-process-region): Revert previous change.
-
- * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
- (pgg-pgp-snarf-keys-region): do.
-
- * pgg-pgp5.el (pgg-pgp5-verify-region)
- (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): do.
-
- * pgg.el (pgg-make-temp-file, pgg-temporary-file-directory): do.
-
-2003-04-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-split): (save-excursion) around (widen)
- (spam-ham-move-routine): Use spam-group-ham-mark-p, not
- spam-group-spam-mark-p (from Michael Shields <shields@msrl.com>)
-
-2003-04-05 Steve Youngs <youngs@xemacs.org>
-
- * gnus-sum.el: XEmacs doesn't support the 5th arg to 'load', so
- don't use it when loading gnus-sum.el if we're in XEmacs.
-
-2003-04-05 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-escape-nonascii to fix more characters in compiled format
- specs.
-
-2003-04-05 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player):
- Fix customization type.
-
-2003-04-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-quoted, print-readably, print-escape-multibyte, and
- print-level to match original behavior of gnus-prin1. This should
- repair the format of .newsrc.eld when using compiled format specs.
-
-2003-04-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (tool-bar-map): defvar it.
-
- * gnus-art.el (tool-bar-map): do.
-
- * gnus-sum.el (tool-bar-map): do.
-
-2003-04-03 Jesper Harder <harder@ifa.au.dk>
-
- * earcon.el (earcon-regexp-alist): catmeow is a wav file.
-
-2003-04-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-ctan-directory-regexp): Changed meaning
- and value.
- (gnus-button-alist): Use it.
-
-2003-04-03 Jesper Harder <harder@ifa.au.dk>
-
- * pgg-gpg.el (pgg-gpg-process-region): do.
-
- * pgg-pgp.el (pgg-pgp-process-region, pgg-pgp-verify-region)
- (pgg-pgp-snarf-keys-region): do.
-
- * pgg-pgp5.el (pgg-pgp5-verify-region)
- (pgg-pgp5-snarf-keys-region, pgg-pgp5-process-region): Use it.
-
- * pgg.el (pgg-make-temp-file): New function. `make-temp-name' is
- unsafe.
- (pgg-temporary-file-directory): Remove.
-
-2003-04-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind Info-directory and Info-menu.
-
-2003-04-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-message): Added doc-string.
-
- * gnus-score.el (gnus-score-find-trace): Changed behavior of `q'.
- (gnus-score-edit-file-at-point): Goto first match when using `e'.
-
-2003-04-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-ctan-directory-regexp): New variable.
- (gnus-button-alist): Use it. Changed CTAN and "setq" entries.
-
-2003-04-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-via-rlogin-command-switches): Doc fix.
- (nntp-open-via-rlogin-and-telnet): Disable the telnet linemode.
-
-2003-03-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bound
- print-escape-newlines to print escape sequences rather than
- literal newline characters.
-
-2003-03-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-valid-fqdn-regexp): Use
- `message-valid-fqdn-regexp' for initialization.
- (gnus-button-handle-info-url): Renamed and extended version of
- `gnus-button-handle-info'.
- (gnus-button-message-level): Renamed from `gnus-button-mail-level'
- (gnus-button-handle-symbol, gnus-button-handle-library)
- (gnus-button-handle-info-keystrokes): New functions.
- (gnus-button-browse-level): New variable.
- (gnus-button-alist): Use them. Added levels.
- (gnus-header-button-alist): Added levels.
-
-2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-03-31 20:08:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.17 is released.
-
-2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-unload): Removed.
-
- * pop3.el (pop3-read-response): Use
- nnheader-accept-process-output.
- (pop3-retr): Ditto.
-
- * mm-view.el (mm-text-html-renderer-alist): Add -nolist to Lynx.
- (mm-text-html-washer-alist): Ditto.
-
-2003-03-31 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-gssapi-program): Also try GNU SASL.
- (imap-gssapi-open): Accept GNU SASL greeting.
- (imap-read-timeout): New.
- (imap-wait-for-tag): Use it.
-
-2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-accept-process-output): Use new function.
-
- * nnheader.el (nnheader-read-timeout): New variable.
- (nnheader-accept-process-output): New function.
-
- * nntp.el (nntp-read-timeout): Removed.
-
- * gnus-sum.el (gnus-summary-prepare-threads): Add comment.
-
-2003-03-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-cache.el (gnus-cache-braid-nov): Revoke last change.
-
-2003-03-30 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-idna-inside-rhs-p): Narrow to header before
- searching.
-
- * gnus-art.el (article-decode-idna-rhs): More restrictive regexp.
-
-2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-process-mmdf-mail-format): Indent.
-
-2003-03-28 Vasily Korytov <deskpot@myrealbox.com>
-
- * message.el (message-make-in-reply-to): Use
- mail-extract-address-components to determine sender's
- name/address.
-
-2003-03-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nndoc.el (nndoc-type-alist): Move mime-parts further ahead.
-
- * gnus-registry.el (gnus-registry-translate-to-alist): Make a
- valid lambda.
- (gnus-registry-translate-from-alist): Ditto.
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
- print-length to nil.
-
- * gnus-sum.el (gnus-summary-highlight-line-0): Indent.
-
- * gnus-fun.el (gnus-fun-ppm-change-string): New function.
- (gnus-grab-cam-face): Use it.
-
-2003-03-28 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-set-mark)
- (nnmaildir-close-group): Allow each mark directory in a group to
- have its own inode for mark files, to accommodate AFS.
-
-2003-03-28 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-start.el (gnus-read-newsrc-el-hook): new hook called by
- gnus-read-newsrc-el-file
- (gnus-read-newsrc-el-file): call the gnus-read-newsrc-el-hook
-
- * gnus-registry.el (gnus-registry-translate-to-alist)
- (gnus-registry-translate-from-alist: new functions
- (gnus-register-spool-action): add a spool item to the registry
-
- * gnus.el (gnus-variable-list): added gnus-registry-alist to the
- list of saved variables
- (gnus-registry-alist): new variable
-
-2003-03-28 Andreas Fuchs <asf@void.at>
-
- * gnus-registry.el (alist-to-hashtable, hashtable-to-alist): New
- functions.
-
-2003-03-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (article-decode-group-name): Be correct instead of
- smart.
-
-2003-03-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Bind url-current-object for Emacs; bind
- gnus-agent-expire-current-dirs for XEmacs; fbind open-ssl-stream
- for both Emacsen.
-
-2003-03-27 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-article-loose-mime)
- (gnus-article-emulate-mime): Move to gnus-article-mime customize
- group.
-
- * gnus-msg.el (gnus-mailing-list-groups): Fix customize type and
- doc string.
-
-2003-03-26 Kevin Ryde <user42@zip.com.au>
-
- * gnus-sum.el (gnus-summary-find-for-reselect): Renamed from
- gnus-summary-find-uncancelled, skip temporary articles inserted by
- "refer" functions.
-
-2003-03-26 Vasily Korytov <deskpot@myrealbox.com>
-
- * smiley.el (smiley-buffer): New function.
-
-2003-03-26 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Replaced
- gnus-summary-update-line (which updated the article's face) with
- gnus-summary-update-download-mark (which updates the article's
- face by calling gnus-summary-update-line AND updates the download
- mark to show that the article was fetched).
-
-2003-03-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-expire-unagentized-dirs): Provides
- option of deleting agent directories for groups/servers that are
- not currently agentized.
- (gnus-agent-expire): Use gnus-agent-expire-unagentized-dirs.
-
- * gnus-int.el (gnus-open-server): Report backend errors in
- condition handler.
-
-2003-03-23 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-idna-to-ascii-rhs-1): Don't continue outside
- header.
-
- * rfc2047.el (rfc2047-header-encoding-alist): Make Followup-To
- same as Newsgroups.
-
- * nntp.el (nntp-open-connection-function): Mention
- nntp-open-tls-stream.
- (nntp-open-tls-stream): New function.
-
- * tls.el: New file.
-
- * nnimap.el (nnimap-server-port, nnimap-stream): Say TLS/SSL
- instead of SSL.
- (nnimap-stream): Add other streams, link to imap variables.
- (nnimap-authenticator): Add other authenticator, link to imap
- variables.
-
- * imap.el: Autoload open-tls-stream.
- (imap-streams): Add tls in front of ssl.
- (imap-stream-alist): Add tls.
- (imap-default-tls-port): New variable.
- (imap-tls-p, imap-tls-open): New functions.
-
-2003-03-22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el (mm-url-insert-file-contents): parse url only if
- results is a list.
-
-2003-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-imap): Revert.
-
-2003-03-22 Svend Tollak Munkejord <stm@bacchus.pvv.org>
-
- * deuglify.el (gnus-outlook-repair-attribution-outlook): Use a
- less strict regexp.
-
-2003-03-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch-imap): Use buffer name for
- more imap function.
-
-2003-03-21 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (article-decode-group-name): Replace Newsgroups and
- Followup-To data inline.
-
-2003-03-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-treat-display-xface): Don't enable if
- icontopbm isn't available.
-
-2003-03-21 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-int.el (gnus-open-server): Catch errors in backend's
- open-server method. Returns nil rather than crashing startup.
-
- * gnus-sum.el (eval-when-compile): Modified to resolve
- compile-time warnings.
-
- * gnus-uu.el (gnus-uu-mark-series): Added informative msg.
- Reports length of series so that the user can compare N with a
- subject that should, if the entire series is present, contain
- '(.../N)'.
- (gnus-uu-delete-work-dir): Avoid hanging when O/S forbids deletion
- of temp file (Win-XP may leave the temp file locked when the
- uudecode process fails).
-
-2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-split-line): Ignore error.
-
- * lpath.el (split-line): Avoid split-line warning message.
-
-2003-03-20 Kim F. Storm <storm@cua.dk>
-
- * message.el (message-split-line): New function.
- (message-mode-map): Remap split-line to message-split-line.
-
-2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-make-overlay): Defalias it to make-overlay.
- (message-delete-overlay): Defalias it to delete-overlay.
- (message-overlay-put): Defalias it to overlay-put.
- (message-idna-to-ascii-rhs-1): Use them.
-
- * messagexmas.el (message-xmas-redefine): Defalias some overlay
- functions to extent functions.
-
-2003-03-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-check-news-header-syntax): Fixed regexp.
-
-2003-03-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el (rfc2231-decode-encoded-string): Downcase charset.
-
- * mm-url.el (mm-url-insert): Move url-current-object stuff into
- mm-url-insert-file-contents.
-
- * nnrss.el (nnrss-fetch): Fetch the local stuff.
- (nnrss-check-group): Use it.
-
-2003-03-20 Mark A. Hershberger <mah@everybody.org>
-
- * nnrss.el: Primitive XML Name-space support. This means that RSS
- feeds like Kevin Burton's[1] can now be read in Gnus.
-
- Implemented support for Mark Pilgrim's RSS Autodiscovery.[2] This
- means that if you want to read the RSS feed for example.com, all
- you have to do is hit "G R http://www.example.com/ RET" and
- nnrss.el will find and the feed listed on the site or (if you have
- loaded xml-rpc.el) look it up on syndic8.com.
-
- Marked the message as HTML (by adding a Content-Type header) so
- that Gnus will render it as html if the user wants that.
-
- Implemented the ability to save nnrss-group-alist so that any new
- feeds the you subscribe to will be found the next time you start
- up.
-
- Implemented support for RSS 2.0 elements (author, pubDate).
-
- Prefer for <content:encoded> over <description> where both
- elements exist.
-
- * mm-url.el (mm-url-insert): Set url-current-object.
-
- * gnus-group.el (gnus-group-make-rss-group): New function.
-
-2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-idna-to-ascii-rhs-1): Don't use replace-*
- for highlight overlays.
-
-2003-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-cache.el (gnus-cache-braid-nov): Test if a line looks like
- a NOV.
-
-2003-03-20 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-use-idna): Disable if UTF-8 unavailable.
- (message-idna-to-ascii-rhs): Use it.
-
- * gnus-art.el (gnus-use-idna): Disable if UTF-8 unavailable.
-
-2003-03-19 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
- (spam-group-ham-marks, spam-group-spam-marks): new functions
- (spam-spam-marks, spam-ham-marks): removed in favor of the
- spam-marks and ham-marks parameters
- (spam-generic-register-routine, spam-ham-move-routine): use the
- new spam-group-{spam,ham}-mark-p functions
-
- * gnus.el (spam-marks, ham-marks): new group parameters with
- default values same as the old spam-spam-marks and spam-ham-marks
-
-2003-03-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-article-decode-hook): Add IDNA.
- (gnus-use-idna): New variable.
- (article-decode-idna-rhs): New function.
-
- * message.el (message-use-idna): New variable.
- (message-mode-field-menu): Add entry for IDNA.
- (message-idna-inside-rhs-p, message-idna-to-ascii-rhs-1)
- (message-idna-to-ascii-rhs): New function.
- (message-generate-headers): Invoke IDNA code.
-
-2003-03-19 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--system-name): New function.
- (nnmaildir-request-accept-article): Use it.
-
-2003-03-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-byte-compile): Make it work silently as the
- gnus-compile function does.
-
- * gnus-sum.el (gnus-summary-highlight-line-0): Revoke the last
- bogus change.
-
-2003-03-19 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-mule-charset-to-mime-charset): Test if
- sort-coding-systems is defined.
-
-2003-03-18 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-open-server, nnmaildir-request-scan)
- (nnmaildir-request-create-group, nnmaildir-request-delete-group):
- Replace create-directory with target-prefix.
-
-2003-03-18 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-decode-coding-region-safely): Don't use
- find-charset-string which is slooow in XEmacs.
-
-2003-03-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-highlight-line-0): Silence the byte-
- compiler under XEmacs.
-
-2003-03-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-treat-highlight-signature): Make the default
- work for multipart/signed where the message text isn't `last'.
-
-2003-03-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-setup-w3m): Set w3m-display-inline-images to
- the value of mm-inline-text-html-with-images.
- (mm-inline-text-html-render-with-w3m): Don't bind
- w3m-display-inline-images.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Don't bind
- w3m-display-inline-images.
-
- * lpath.el: Bind w3m-display-inline-images; bind mm-w3m-mode-map
- regardless of an Emacs flavor.
-
-2003-03-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump.
-
-2003-03-18 00:38:22 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.16 is released.
-
-2003-03-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * lpath.el (featurep): Bind mm-w3m-mode-map.
-
-2003-03-17 Paul Jarc <prj@po.cwru.edu>
-
- * nnmail.el (nnmail-cache-primary-mail-backend): Not all
- 'respool-able backends define a global nnchoke-get-new-mail
- variable.
-
-2003-03-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-mime-delete-part): New function.
- (gnus-mime-action-alist, gnus-mime-button-commands): Use it.
-
-2003-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-check-news-header-syntax): Don't push
- groups twice onto list of unknown groups.
-
- * nndoc.el (nndoc-type-alist): Move exim-bounce a bit further
- back.
-
- * nnheader.el (nnheader-find-etc-directory): Doc fix.
-
- * gnus-msg.el (gnus-inews-add-send-actions): Don't restore window
- config unless the summary buffer exists.
-
- * gnus-sum.el (gnus-summary-next-group): Semi-exit group first to
- that target group is computed correctly when articles are marked
- as read by Xref handling.
-
- * mail-source.el (mail-source-fetch-imap): Pass buffer-name to
- imap-open.
-
- * message.el (message-send-mail): Add courtesy string to Bcc's,
- too.
-
- * gnus-cite.el (gnus-cited-line-p): New function.
-
-2003-03-15 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-decode-body): Add new optional parameter,
- force, to use the supplied charset unconditionally.
-
- * gnus-art.el (article-decode-charset): Use it.
-
-2003-03-14 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-decode-coding-region-safely): New function.
- (mm-decode-body): Use it.
-
- * rfc2047.el (rfc2047-decode-region): do.
- (rfc2047-decode-string): Guess coding system if the default is
- invalid.
-
-2003-03-12 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-update-info): Pretend missing
- articles are marked 'read, so we get correct article counts.
-
-2003-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-insert-mime-button): Exclude a newline from
- the button.
- (gnus-insert-prev-page-button): Ditto.
- (gnus-insert-next-page-button): Ditto.
- (gnus-insert-mime-security-button): Ditto.
-
- * mm-view.el (mm-inline-image-emacs): Open the bottom of an image
- one line. Suggested by Greg Klanderman <gak@klanderman.net>.
- (mm-inline-image-xemacs): Ditto.
-
-2003-03-12 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--parse-filename, nnmaildir--sort-files,
- nnmaildir--scan, nnmaildir-request-accept-article): Changes for
- the recent filename uniqueness discussion.
-
-2003-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-inline-image-emacs): Make it delete an excessive
- newline next time.
- (mm-inline-image-xemacs): Ditto.
-
-2003-03-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-agent.el (gnus-agent-synchronize-flags-server): Don't use
- kill-line.
-
-2003-03-09 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-inews-insert-archive-gcc): Don't use
- kill-line.
-
-2003-03-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetched-hook): New variable. Just
- fixing the code to match the documentation.
- (gnus-agent-fetch-selected-article): Replaced
- gnus-summary-update-article-line with gnus-summary-update-line as
- the former did not correctly recalculate the thread indentation.
- (gnus-agent-find-parameter): The agent-predicate, if not found
- anywhere else, defaults to the value of gnus-agent-predicate.
- (gnus-agent-fetch-session): Fixed typo; now executes
- gnus-agent-fetched-hook rather than the undocumented
- gnus-agent-fetch-hook.
- (gnus-agent-fetch-group-1): Removed part of 2003-03-06 fix. The
- default agent predicate is now provided by
- gnus-agent-find-parameter.
- (gnus-agent-message): New macro. This macro avoids potentially
- costly parameter evaluation when the message's level is too high
- to display.
- (gnus-agent-expire-group-1): Disabled undo tracking in temp
- overview buffer. Uses new gnus-agent-message macro to reduce
- overhead of optional messages. Reversed message levels to
- emphasize percent completion messages. Detailed messages of
- little use except when debugging code.
-
-2003-03-08 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-move-routine): use
- spam-mark-ham-unread-before-move-from-spam-group
- (spam-mark-ham-unread-before-move-from-spam-group): new variable
-
-2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: load nnimap.el when compiling
- (spam-setup-widening): use
- nnimap-split-download-body-default instead of
- nnimap-split-download-body which is a user-customizable variable
-
-2003-03-07 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-split-download-body-default): New, holds
- default for n-s-d-b.
- (nnimap-split-download-body): Add new setting (symbol default),
- which uses contents of n-s-d-b-d, and made it the default.
-
-2003-03-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-use-hashcash): new variable
- (spam-list-of-checks): added spam-use-hashcash with associated
- spam-check-hashcash
- (spam-check-hashcash): new function, installed iff hashcash.el is
- loaded
- (spam-setup-widening): don't use (return)
-
-2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Added default
- predicate of `false' to avoid an error when a group defines no
- predicate. Fixed typo that disabled agent scoring (i.e. the
- low/high predicates should now work).
-
-2003-03-06 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: add spam-maybe-spam-stat-load to
- gnus-get-top-new-news-hook, remove it from gnus-get-new-news-hook
- (spam-bogofilter-register-with-bogofilter): use
- spam-bogofilter-spam-switch and spam-bogofilter-ham-switch
- (spam-bogofilter-spam-switch, spam-bogofilter-ham-switch): new
- custom variables to replace "-s" and "-n"
-
- * gnus-group.el (gnus-group-get-new-news): call the new
- gnus-get-top-new-news-hook hook
-
- * gnus-start.el (gnus-get-top-new-news-hook): new hook, run ONLY
- by gnus-get-new-news, NOT by gnus-group-get-new-news-this-group
-
-2003-03-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-uu.el (mm-uu-pgp-encrypted-test): Fix message.
-
-2003-03-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-cus.el (gnus-group-customize): Don't use delete-if which is
- a cl run-time function.
-
-2003-03-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Added missing binding
- on gnus-agent-short-article.
- (gnus-category-read): Replaced CL function mapcar* with new macro:
- gnus-mapcar.
- * gnus-util.el (gnus-mapcar): New macro. Generalizes mapcar to
- support functions that accept multiple parameters. A separate
- sequence must be provided for each parameter in the function.
- Iteration stops when the end of the shortest list is reached.
-
-2003-03-06 Jesper Harder <harder@ifa.au.dk>
-
- * nnimap.el (nnimap-request-accept-article): Use delete-region.
-
- * html2text.el (html2text-clean-dtdd, html2text-delete-tags)
- (html2text-delete-single-tag, html2text-clean-anchor)
- (html2text-remove-tags): Use delete-region.
- (html2text-fix-paragraphs): Simplify.
-
- * mml1991.el (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt)
- (mml1991-gpg-sign, mml1991-gpg-encrypt, mml1991-pgg-sign)
- (mml1991-pgg-encrypt, mml1991-pgg-encrypt): Use delete-region, not
- kill-region.
-
-2003-03-04 John Paul Wallington <jpw@gnu.org>
-
- * gnus-agent.el (gnus-agent-enable-expiration)
- (gnus-agent-article-alist, gnus-agent-article-alist)
- (gnus-agent-cat-defaccessor): Doc fixes.
-
-2003-03-04 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-function-implies-unread-1): Grok
- byte-compiled functions.
-
-2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-sum.el (gnus-auto-goto-ignores): New variable. Provides
- customization between new maneuvering (which permits selecting
- undownloaded articles) and old maneuvering (which skipped over
- undownloaded articles) behaviors.
- (gnus-summary-find-next): Pass through the unread and subject
- parameters when calling gnus-summary-find-prev.
- (gnus-summary-find-next,gnus-summary-find-prev): Apply
- gnus-auto-goto-ignores to filter out unacceptable articles.
-
-2003-03-04 Jesper Harder <harder@ifa.au.dk>
-
- * mail-source.el (mail-source-read-passwd): Remove. `read-passwd'
- exists in all supported Emacs versions, so we don't need this
- compatibility function.
- (mail-source-fetch-pop, mail-source-check-pop)
- (mail-source-fetch-webmail): Use read-passwd.
-
- * nntp.el (nntp-send-authinfo, nntp-send-nosy-authinfo)
- (nntp-open-telnet, nntp-open-via-telnet-and-telnet): Use
- read-passwd.
-
- * nnwarchive.el (nnwarchive-open-server): Use read-passwd.
-
- * imap.el (imap-read-passwd): Remove.
- (imap-interactive-login): Use read-passwd.
-
- * canlock.el (canlock-read-passwd): Remove.
- (canlock-insert-header, canlock-verify): Use read-passwd.
-
- * sieve-manage.el (sieve-manage-read-passwd): Remove.
- (sieve-manage-interactive-login): Use read-passwd.
-
- * pop3.el (pop3-read-passwd): Remove.
- (pop3-movemail, pop3-get-message-count, pop3-apop): Use
- read-passwd.
-
- * pgg.el (pgg-read-passphrase): Simplify.
-
-2003-03-04 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-mode): Fixed the mode line reports
- 'plugged' when actually 'unplugged' bug.
- (gnus-category-read): Ignore nil values when converting an
- old-format category so that the new-format category will default
- those attributes to the global variables.
-
-2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mail-source.el (mail-source-delete-old-incoming-confirm): Fixed
- doc-string.
-
-2003-03-03 Jesper Harder <harder@ifa.au.dk>
-
- * nnrss.el (nnrss-decode-entities-unibyte-string): Use `buffer-string'.
- * nndoc.el (nndoc-dissect-mime-parts-sub): do.
- * nndb.el (nndb-request-accept-article, nndb-status-message): do.
- * mm-url.el (mm-url-decode-entities-string): do.
- * mml1991.el (mml1991-mailcrypt-sign, mml1991-gpg-sign): do.
- * mm-decode.el (mm-find-raw-part-by-type): do.
- * message.el (message-send-mail-partially)
- (message-send-mail-with-sendmail): do.
- * gnus-uu.el (gnus-uu-save-article, gnus-uu-reginize-string): do.
- * gnus-kill.el (gnus-pp-gnus-kill): do.
- * gnus-art.el (gnus-article-treat-unfold-headers)
- (gnus-article-encrypt-body): do.
-
-2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mail-source.el (mail-source-delete-incoming): Allow integer value.
- (mail-source-delete-old-incoming-confirm): New variable.
- (mail-source-delete-old-incoming): Use it. New function.
- (mail-source-callback): Call `mail-source-delete-old-incoming' if
- `mail-source-delete-incoming' is a nonnegative integer.
-
-2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-extended-version): Fix for 'emacs-gnus-config.
- (gnus-user-agent): Fixed typo.
-
-2003-03-03 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-enable-expiration): Fixed documentation.
- (gnus-agent-expire-group-1): Removed invalid (interactive) specifier.
-
-2003-03-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-fetch-articles): Fix nil message.
- (gnus-agent-fetch-session): Allow debugging to take place.
-
-2003-03-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-highlight-selected-summary)
- (gnus-article-get-xrefs, gnus-summary-show-thread): Use
- `gnus-point-at-bol' and `gnus-point-at-eol' instead of
- `(progn (beginning-of-line) (point))'. It's shorter, faster,
- and makes it clear that we don't need the side effect.
- * gnus-util.el (gnus-delete-line): do.
- * gnus-xmas.el (gnus-group-add-icon): do.
- * nnmail.el (nnmail-article-group, nnmail-cache-fetch-group): do.
- * nntp.el (nntp-send-authinfo-from-file): do.
- * nnml.el (nnml-header-value): do.
- * nnheader.el (nnheader-insert-references): do.
- * gnus-cite.el (gnus-article-highlight-citation)
- (gnus-cite-parse): do.
- * gnus-score.el (gnus-score-followup): do.
- * gnus-draft.el (gnus-draft-send): do.
- * gnus-group.el (gnus-group-highlight-line): do.
- * gnus-cache.el (gnus-cache-braid-nov): do.
- * nnfolder.el (nnfolder-retrieve-headers)
- (nnfolder-request-article): do.
- * gnus-art.el (article-hide-boring-headers)
- (gnus-article-hide-header): do.
-
- * nnheader.el (nnheader-find-nov-line): Use gnus-delete-line.
- * nnml.el (nnml-request-replace-article): do.
- * nnmbox.el (nnmbox-request-move-article, nnmbox-delete-mail): do.
- * nnfolder.el (nnfolder-request-move-article): do.
- * gnus-cache.el (gnus-cache-possibly-remove-article): do.
- * gnus-art.el (gnus-mm-display-part): do.
-
- * gnus-art.el (gnus-article-goto-part): Use gnus-goto-char.
-
-2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * nntp.el (nntp-possibly-change-group): Avoid calling
- process-buffer on nil (Which happened when you lost your
- connection while fetching); instead signal a "Server Closed
- Connection" error.
-
-2003-03-02 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-enable-expiration): New
- variable. Either ENABLE or DISABLE. Sets default behavior for
- selecting which groups are expired.
- (gnus-agent-cat-set-property, gnus-agent-cat-defaccessor,
- gnus-agent-set-cat-groups): Provides abstract interface for
- accessing agent category. Category now implemented by an alist.
- (gnus-agent-add-group, gnus-agent-remove-group,
- gnus-category-insert-line, gnus-category-edit-predicate,
- gnus-category-edit-score, gnus-category-edit-groups,
- gnus-category-copy, gnus-category-add, gnus-group-category): Use
- new agent category abstraction.
- (gnus-agent-find-parameter): New function. Search for agent
- configuration parameter first in the group's parameters, then its
- topics (if any), and then the group's category. If not found
- anywhere, use the original defined constants.
- (gnus-agent-fetch-headers, gnus-agent-fetch-group-1): Use new
- gnus-agent-find-parameter.
- (gnus-agent-fetch-headers, gnus-agent-uncached-articles): Clearing
- gnus-agent-cache now blocks retrieving headers and articles from
- the local cache. Fetched content is still added to the cache
- before being returned.
- (gnus-agent-fetch-session): Use error-message-string to generate
- displayed error message.
- (gnus-agent-customize-category): New Command. 'e' in category
- buffer opens category customization buffer.
- (gnus-category-read): Reads either positional or alist format;
- returns alist format.
- (gnus-category-write): Writes category file compatible with
- current, and previous, versions of gnus-agent.
- (gnus-category-make-function, gnus-category-make-function-1):
- Corrected documentation; parameter is predicate NOT category.
- (gnus-predicate-implies-unread): Now works in more cases per the
- todo comment.
- (gnus-function-implies-unread-1): New function. Supports
- gnus-predicate-implies-unread.
- (gnus-agent-expire-group): Command now provides default of group
- under point.
- (gnus-agent-expire-group-1): Obeys new agent-enable-expiration and
- agent-days-until-old parameters. No longer supports
- gnus-agent-expire-days being set to an alist.
- (gnus-agent-request-article): Now performs its own checks of
- gnus-agent, gnus-agent-cache, and gnus-plugged rather than
- assuming that the caller will do them correctly.
- (): Added one-time hook to gnus-group-prepare-hook. Detects when
- gnus-agent-expire-days is set to an alist. Converts said alist
- into group parameter so that gnus-agent-expire-days will not be
- needed.
- * gnus-art.el (gnus-request-article-this-buffer): Conditional
- checks surrounding gnus-agent-request-article removed; now
- performed by gnus-agent-request-article.
- * gnus-cus.el (gnus-agent-parameters): New variable. List of
- customizable group/topic parameters that regulate the agent.
- (gnus-group-customize): Uses gnus-agent-parameters. Replaced
- kill-buffer with gnus-kill-buffer to remove the killed buffer from
- the list of gnus buffers.
- (gnus-trim-whitespace): Removes leading and trailing whitespace
- from multiline strings.
- (gnus-agent-cat-prepare-category-field,
- gnus-agent-customize-category): Constructs a category
- customization buffer.
- * gnus-int.el (gnus-retrieve-headers,
- gnus-request-expire-articles): No longer checks gnus-agent-cache
- as it is handled internally by the agent.
- (gnus-request-head, gnus-request-body): Conditional checks
- surrounding gnus-agent-request-article removed; now performed by
- gnus-agent-request-article.
-
- * gnus-start.el (): Added defvar statements to resolve compilation
- warnings.
- (gnus-long-file-names): New function. Isolates platform dependent
- msdos-long-file-names.
- (gnus-save-startup-file-via-temp-buffer): New variable. Provides
- option of writing directly to file. Avoids memory exhausted
- errors when .newsrc.eld is huge.
- (gnus-save-newsrc-file): Uses new
- gnus-save-startup-file-via-temp-buffer.
- (gnus-gnus-to-quick-newsrc-format): Rewritten to write to
- standard-output.
- (gnus-display-time-event-handler): Changed to alias from a defun
- to avoid a compile-time warning when display-time-event-handler is
- not defined.
- * gnus-util.el (gnus-with-output-to-file): New macro. Binds
- standard-output such that prin1 and princ will write directly to a
- file.
-
- * gnus.el (gnus-agent-cache): Expanded documentation.
- (gnus-summary-high-undownloaded-face): Removed second bold keyword
- so that this face is actually bold.
-
- * nnkiboze.el (nnkiboze-request-article): Only use the cache when
- gnus-use-cache has been set.
-
-2003-03-02 Jesper Harder <harder@ifa.au.dk>
-
- * nnvirtual.el (nnvirtual-update-xref-header): Simplify.
-
-2003-03-01 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-refer-article): Be more permissive.
-
-2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * spam.el: Fix typo.
-
-2003-03-01 Satyaki Das <satyaki@theforce.stanford.edu>
-
- * pgg-gpg.el (pgg-gpg-process-region): Insert process status into
- errors-buffer. This produces a nicer error message in case of
- problems.
-
-2003-03-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-maybe-spam-stat-load, spam-maybe-spam-stat-load):
- load stats iff spam-use-stat is on
-
- * spam.el: add spam-maybe-spam-stat-load to gnus-startup hook,
- also use spam-maybe-spam-stat-load and spam-maybe-spam-stat-save
- instead of spam-stat-load and spam-stat-save in the
- gnus-get-new-news-hook and gnus-save-newsrc-hook, respectively
-
-2003-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Ignore errors from enriched-decode.
-
-2003-03-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-fqdn): Protect against nil user-mail.
-
-2003-02-28 Vasily Korytov <deskpot@myrealbox.com>
-
- * gnus-art.el (gnus-boring-article-headers): New values:
- 'to-list and 'cc-list.
-
-2003-02-28 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-setup-widening): new function to set
- nnimap-split-download-body, we add it to gnus-get-new-news-hook
- (spam-list-of-statistical-checks): list of statistical splitter
- checks
- (spam-split): added a widen call when a statistical check is
- enabled
-
-2003-02-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-user-agent): Changed default to
- 'emacs-gnus-type, renamed 'full.
-
-2003-02-28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-accept-article): Don't use
- mail-header-unfold-field.
-
-2003-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * imap.el (imap-ssl-open): Don't depend on ssl.el.
- * nntp.el (nntp-open-ssl-stream): Don't depend on ssl.el.
-
-2003-02-26 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: add spam-stat-load to gnus-get-new-news-hook
- (spam-split): remove spam-stat-load call
-
-2003-02-26 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-toggle-header): Run
- gnus-article-decode-hook instead of calling a-decode-encoded-words
- directly (the latter is run as part of the former).
-
-2003-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire-group): Remove debug.
-
-2003-02-25 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-sendmail-envelope-from): New option.
- (message-sendmail-envelope-from): New function.
- (message-send-mail-with-sendmail): Use it.
-
-2003-02-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): Added
- compensation for TDMA addresses.
-
-2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-user-agent): New variable.
- (gnus-version-expose-system): Removed. Obsoleted by
- `gnus-user-agent'.
- (gnus-extended-version): Use `gnus-user-agent'.
-
-2003-02-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-stat-register-spam-routine,
- spam-stat-register-ham-routine): remove spam-stat-save
- (spam-stat hook): add spam-stat-save to the gnus-save-newsrc-hook
-
-2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-group.el (gnus-topic-mode-p): Fixed free variable
- reference.
-
-2003-02-24 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * nnheader.el (nnheader-find-nov-line): Changed midpoint
- calculation to avoid integer overflow.
-
-2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-start.el (gnus-backup-startup-file): Fixed custom type.
-
-2003-02-24 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el: disabled spam-get-article-as-filename
-
-2003-02-24 Michael Shields <shields@msrl.com>
-
- * gnus-group.el (gnus-group-is-exiting-without-update-p): New.
- * gnus-sum.el (gnus-summary-exit-no-update): Use it.
- * gnus-sum.el (gnus-summary-expire-articles): Use it.
- * spam.el (spam-summary-prepare-exit): Use it.
- * gnus.el (gnus-install-group-spam-parameters): New.
- * spam.el (spam-group-ham-processor-copy-p): New.
- * spam.el (spam-summary-prepare-exit): Support for ham copying.
- * spam.el (spam-mark-spam-as-expired-and-move-routine): Fix bug
- that would cause the current message to be moved if the group had
- no spam.
- * spam.el (spam-ham-move-routine): New `copy' argument.
-
-2003-02-24 Martin Thornquist <martint@ifi.uio.no>
-
- * gnus-topic.el (gnus-topic-select-group): Select last group if
- after last group.
- * gnus-group.el (gnus-group-select-group): Ditto.
-
-2003-02-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (popup-menu): Compiler macro for Emacs 20.
- (gnus-article-refer-article): Use gnus-point-at-(b|e)ol instead of
- point-at-(b|e)ol which aren't available in Emacs 20.
-
- * gnus-registry.el (puthash): Alias to cl-puthash for Emacs 20.
-
-2003-02-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-start.el (gnus-activate-group): Re-enabled the catch error
- clause of the condition-case statement. Errors connecting to a
- server no longer terminate gnus.
-
- * gnus-agent.el (gnus-agent-toggle-plugged): Renamed parameter to
- make its use obvious. Added no-nothing case to avoid
- opening(closing) servers when already open(closed).
- (gnus-agent-while-plugged): Added macro to facilitate internal use
- of gnus-agent-toggle-plugged.
- (gnus-agent-fetch-group): Use new gnus-agent-while-plugged to
- temporarily open servers.
- (gnus-agent-get-undownloaded-list): Sort list of article numbers
- as sorting gnus-newsgroup-headers is wrong.
- (gnus-agent-summary-fetch-group): Use new gnus-agent-while-plugged
- to temporarily open servers. Corrected logic to handle setting
- gnus-agent-mark-unread-after-downloaded.
- (gnus-agent-fetch-articles): Now handles headers with missing
- article sizes and/or missing article lengths. Now clears the
- message buffer when finished.
- (gnus-agent-fetch-group-1): Position point before calling
- gnus-summary-set-agent-mark.
- (gnus-get-predicate): Corrected description, parameter is
- predicate not category.
- (gnus-agent-expire-group): Adapted the gnus-agent-expire-* code to
- provide a separate single group expiration function.
- (gnus-agent-regenerate-group): Now clears the message buffer when
- finished.
-
-2003-02-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.el (gnus-agent-target-move-group-header): New variable.
- * gnus-draft.el (gnus-draft-send): If special header
- "X-Gnus-Agent-Target-Move-Group" is present, do like Gcc into
- that group, instead of performing the regular sending functions.
-
-2003-02-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-xmas.el (gnus-xmas-mime-button-menu): Accept a prefix arg.
-
-2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-user-fqdn, message-valid-fqdn-regexp): New
- variables.
- (message-make-fqdn): Use it. Improved validity check.
-
-2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-user-mail-address): Check whether
- user-mail-address looks valid.
-
- * gnus-msg.el (gnus-mailing-list-followup-to): New function.
-
- * gnus-util.el (gnus-fetch-original-field): New function.
-
-2003-02-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * message.el (message-mode): \\(...\\) around additional
- paragraph-separate alternative.
-
-2003-02-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-mime-button-commands): Add ellipsis.
- (gnus-mime-button-menu): Define MIME popup menu with easy-menu to
- display key bindings.
- (gnus-mime-button-menu): Rewrite.
-
-2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-url-regexp): Removed `.
-
-2003-02-23 Max Froumentin <mf@w3.org>
-
- * gnus-art.el (gnus-button-url-regexp): Remove `, enter '.
-
-2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-action-on-part): Require a match
- interactively.
-
- * gnus-start.el (gnus-save-newsrc-file): Use
- gnus-backup-startup-file.
- (gnus-backup-startup-file): New variable.
-
-2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-summary-buffer-name): Moved function here.
-
- * gnus-draft.el (defun): Remove debug.
-
-2003-02-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-refer-article): Skip method if we
- can't open server.
-
-2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (defun): Configure posting styles.
-
- * gnus-start.el (gnus-get-unread-articles-in-group): Make sure
- the entry for the group exists before we alter it.
-
-2003-02-22 David S. Goldberg <david.goldberg6@verizon.net> (tiny change)
-
- * message.el (message-mode): MML tags separate paragraphs.
-
-2003-02-22 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Sort
- `gnus-newsgroup-headers'.
-
-2003-02-22 Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>
-
- * gnus-art.el (gnus-article-refer-article): Grok more message id
- formats.
-
-2003-02-22 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-path-name-rewrite-functions): Doc fix: don't
- use "path name".
-
-2003-02-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-sum.el (gnus-summary-move-article)
- (gnus-summary-expire-articles): send data header for article, not
- just article ID
-
- * gnus-registry.el (gnus-registry-hashtb, gnus-register-action)
- (gnus-register-spool-action): added hashtable of message ID keys
- with message motion data
-
-2003-02-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-mid-or-mail-heuristic-alist): New
- variable, used in `gnus-button-mid-or-mail-heuristic'.
- (gnus-button-mid-or-mail-heuristic): New function derived from
- Florian Weimer's Perl script.
- (gnus-button-handle-mid-or-mail): Allow a function instead of
- 'guess.
- (gnus-button-guessed-mid-regexp): Removed.
-
-2003-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-resend): Bind message-setup-hook to nil;
- remove X-Draft-From header.
-
-2003-02-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-simplify-subject-fully, gnus-subject-equal)
- (gnus-newsgroup-undownloaded)
- (gnus-summary-save-parts-default-mime, gnus-auto-select-next):
- Doc fixes.
-
-2003-02-17 John Paul Wallington <jpw@gnu.org>
-
- * gnus.el (gnus-shell-command-separator, gnus-email-address)
- (gnus-default-charset, gnus-other-frame-parameters): Doc fixes.
-
-2003-02-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-spec.el (gnus-xmas-format): Use insert instead of
- insert-string which is obsolete in Emacs 22.1.
-
- * message.el (message-cross-post-followup-to-header): do.
-
- * spam.el (spam-ifile-register-with-ifile)
- (spam-stat-register-spam-routine)
- (spam-stat-register-ham-routine)
- (spam-bogofilter-register-with-bogofilter): do.
-
- * mailcap.el (mailcap-mime-data): Fix typo.
-
- * gnus-topic.el (gnus-topic-make-menu-bar): Add ellipsis.
-
-2003-02-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
- (gnus-cite-parse): Renamed `gnus-unsightly-citation-regexp' to
- `gnus-cite-unsightly-citation-regexp'.
-
-2003-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-copy-article-buffer): Copy an article header
- even if there's just a header.
-
-2003-02-19 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-fix-before-sending): Fix highlighting of
- illegible and invisible text.
-
- * gnus-util.el (gnus-multiple-choice): Separate choices with
- ",\e,A \e(B". Suggested by Dan Jacobson <jidanni@dman.ddts.net>.
-
-2003-02-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-exit-no-update): Use gnus-kill-buffer.
-
-2003-02-18 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-move-routine)
- (spam-mark-spam-as-expired-and-move-routine): use
- gnus-summary-kill-process-mark and gnus-summary-yank-process-mark
- around process-mark manipulation on the group
-
-2003-02-17 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME/Multipart
- submenu.
-
-2003-02-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch): Reverse the return value of
- the continuation question.
-
-2003-02-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nndraft.el (nndraft-request-move-article): Bind
- nnmh-allow-delete-final to t.
-
-2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-uu-filename): Fix use of character constant.
-
-2003-02-11 Stefan Monnier <monnier@cs.yale.edu>
-
- * nntp.el (nntp-accept-process-output): Don't use point-max to get
- the buffer's size.
-
-2003-01-31 Joe Buehler <jhpb@draco.hekimian.com>
-
- * nnheader.el: Added cygwin to system-type comparisons.
-
-2003-01-27 Juanma Barranquero <lektu@terra.es>
-
- * imap.el (imap-mailbox-status): Fix typo.
-
-2003-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-prepare): Don't set agent mark if
- online.
-
-2003-02-14 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-group-make-menu-bar): Include all
- commands.
- * gnus-sum.el: Small change from Frank Weinberg
- <frank@usenet-rundfahrt.de>:
- (gnus-auto-center-group): New variable.
- (gnus-summary-read-group-1): Use it.
- (gnus-summary-next-group): Fix docstring.
-
-2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-faces-at): Simplify.
-
-2003-02-13 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-move-routine)
- (spam-mark-spam-as-expired-and-move-routine): made the article
- move conditional, so it's not called even if there's nothing to move
-
-2003-02-13 Kurt B. Kaiser <kbk@shore.net>
-
- * message.el (message-unix-mail-delimiter): Accept any whitespace
- after the email address and before the date; do not require the
- space character.
-
-2003-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-only-boring-p): Make sure that the
- gnus-article-boring-faces variable is bound; use gnus-faces-at.
-
- * gnus-util.el (gnus-faces-at): New macro.
-
-2003-02-13 Michael Shields <shields@msrl.com>
-
- * gnus-cite.el
- (gnus-cite-attribution-suffix, gnus-cite-parse):
- Better handling for Microsoft citation styles.
- (gnus-unsightly-citation-regexp): New.
-
-2003-02-12 Michael Shields <shields@msrl.com>
-
- * gnus-art.el (article-strip-banner): Strip both per-group and
- per-user-address banners.
- (article-really-strip-banner): New.
-
-2003-02-12 Michael Shields <shields@msrl.com>
-
- * gnus-sum.el (gnus-article-goto-next-page,
- gnus-article-goto-prev-page): Call gnus-summary-*-page, instead of
- relying on the summary bindings of `n' and `p'.
-
-2003-02-12 Michael Shields <shields@msrl.com>
-
- * gnus-art.el (gnus-article-only-boring-p): New.
- (gnus-article-skip-boring): New.
- * gnus-cite.el (gnus-article-boring-faces): New.
- * gnus-sum.el (gnus-summary-next-page): Use
- gnus-article-only-boring-p.
-
-2003-02-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-mark-spam-as-expired-and-move-routine)
- (spam-ham-move-routine): unmark all articles before marking those
- of interest and calling gnus-summary-move-article
-
-2003-02-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-kill-buffer): Move to gnus.el because it's
- logically the complement of gnus-get-buffer-create and
- gnus-add-buffer.
-
- * gnus-util.el (gnus-kill-buffer): do.
-
- * nnmail.el: Autoload gnus-kill-buffer.
-
-2003-02-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-summary-set-agent-mark): Added call to
- gnus-summary-goto-subject as gnus-summary-update-mark operates on
- the current LINE.
- (gnus-agent-summary-fetch-group): Minimized the number of times
- that the article is updated in the buffer.
-
-2003-02-11 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-move-routine): use the process-mark instead of
- gnus-current-article when moving articles
- (spam-mark-spam-as-expired-and-move-routine): ditto, use the process-mark
-
-2003-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-expire-articles): Recursive.
- (gnus-topic-catchup-articles): Ditto.
- (gnus-topic-mark-topic): Reverse recursive logic.
-
-2003-02-11 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-refer-thread): Handle case where
- gnus-refer-thread-limit is t.
-
-2003-02-10 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-mule-charset-to-mime-charset): Use
- sort-coding-systems to prefer utf-8 over utf-16.
-
-2003-02-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-expire-days):
- gnus-request-move-article depends on gnus-agent-expire to clean up
- the cache after moving the article. Therefore, g-a-e-d can NOT
- default to nil or can gnus-agent-expire be disabled by doing so.
- If you don't want to run gnus-agent-expire, don't call it.
- (gnus-agent-expire): The broken test to disable gnus-agent-expire
- when g-a-e-d was NOT nil was removed.
- (gnus-agent-article-name): Removed unnecessary input test as
- article IDs are always strings.
- (gnus-agent-regenerate-group): Added check to protect against
- servers that generate absurdly long article IDs. Valid IDs are
- less than 10 digits to avoid overflow errors. Fixed logic error
- when ensuring that the final article ID is present in the new
- alist.
-
-2003-02-09 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-goto-missing-topic): Just move to the
- next line after finding the parent.
-
-2003-02-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bumped.
-
-2003-02-08 23:23:27 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.15 is released.
-
-2003-02-08 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * nnmail.el (nnmail-split-it): If a message ends up matching the
- same mailbox more than once, it will cause duplicates to appear
- in the mailbox.
-
-2003-02-08 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-select-article): Remove blink removal
- code that only worked under Emacs.
-
-2003-02-08 Satyaki Das <satyaki@chicory.stanford.edu>
-
- * pgg-gpg.el (pgg-gpg-process-region): Don't blink.
-
-2003-02-08 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-refer-article): Use
- gnus-replace-in-string.
-
- * gnus-util.el (gnus-map-function): Remove unneeded let-binding.
- (gnus-remove-duplicates): do.
-
-2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-int.el (gnus-internal-registry-spool-current-method): new variable
- (gnus-request-scan): set
- gnus-internal-registry-spool-current-method to gnus-command-method
- before a request-scan operation
-
- * gnus-registry.el (regtest-nnmail): use
- gnus-internal-registry-spool-current-method
-
-2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch): Typo fix.
-
-2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * nnmail.el (nnmail-spool-hook): new hook
- (nnmail-cache-insert): call nnmail-spool-hook
-
- * gnus-registry.el: new file with examples of using the hooks
-
- * gnus.el (gnus-registry): added registry customization group
- (gnus-group-prefixed-name): improve function to return full group
- name optionally
- (gnus-group-guess-prefixed-name): shortcut to
- gnus-group-prefixed-name, using just the group name
- (gnus-group-full-name): always get a group's full name
- (gnus-group-guess-full-name): shortcut, using just the group name
-
- * gnus-sum.el (gnus-summary-article-move-hook)
- (gnus-summary-article-delete-hook)
- (gnus-summary-article-expire-hook): new hooks
- (gnus-summary-move-article, gnus-summary-expire-articles)
- (gnus-summary-delete-article): invoke the new hooks
-
-2003-02-07 Frank Weinberg <frank@usenet-rundfahrt.de>
-
- * gnus-art.el (gnus-article-refer-article): Strip leading "news:"
- from message-ID
-
-2003-02-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-util.el (gnus-run-hooks): Use save-current-buffer.
-
-2003-02-07 John Paul Wallington <jpw@gnu.org>
-
- * mm-util.el (mm-delete-duplicates, mm-append-to-file)
- (mm-write-region, mm-detect-coding-region): Doc fixes.
-
-2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-source-fetch): Ignore errors.
- (mail-source-ignore-errors): New variable.
-
- * gnus-sum.el (gnus-summary-refer-thread): Don't re-fetch current
- articles.
-
- * gnus-msg.el (gnus-version-expose-system): Change default.
-
-2003-02-07 Vasily Korytov <deskpot@myrealbox.com>
-
- * gnus-msg.el (gnus-version-expose-system): New variable.
-
-2003-02-07 Simon Josefsson <jas@extundo.com>
-
- * mml-sec.el (mml-unsecure-message): Don't use kill-region. Tiny
- patch from deskpot@myrealbox.com (Vasily Korytov).
-
-2003-02-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-display-face): Get the Face header from
- the current buffer.
-
-2003-02-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-view-part-internally): Bind
- buffer-read-only to nil.
-
-2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-expire-1,2): Pass the dir argument
- from g-a-e-1 to g-a-e-2.
-
-2003-02-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-BBDB): no need to regexp-quote the argument
- of bbdb-search-simple, use spam-use-BBDB-exclusive
- (spam-check-whitelist): use spam-use-whitelist-exclusive
- (spam-use-whitelist-exclusive): new variable affecting
- spam-use-whitelist
- (spam-use-BBDB-exclusive): new variable affecting spam-use-BBDB
-
-2003-02-05 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-expire-days): Change default to nil.
- (gnus-agent-expire): Don't expire if g-a-e-d is nil.
- (gnus-agent-expire): Move most code into gnus-agent-expire-1.
- (gnus-agent-expire-1): New.
- (gnus-agent-expire-1): Move code into gnus-agent-expire-2.
- (gnus-agent-expire-2): New.
-
-2003-02-05 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-util.el (gnus-delete-if): Rename to gnus-remove-if.
- "delete-if" is misleading because it isn't actually destructive.
-
- * gnus-topic.el (gnus-group-prepare-topics): Use new name.
-
- * nnmail.el (nnmail-purge-split-history): do.
-
- * gnus-win.el (gnus-get-buffer-window): do.
-
- * gnus-sum.el (gnus-simplify-whitespace): Remove unnecessary
- let-binding.
- (gnus-simplify-all-whitespace): do.
-
-2003-02-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-delay.el (gnus-delay-article): Fix binding of the
- nndraft:delayed group.
-
-2003-02-04 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.el (spam group parameters): change 'other to 'const in
- the group parameter definitions to soothe XEmacs
-
-2003-02-04 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-delay.el (gnus-delay-article): Really create
- nndraft:delayed group if it doesn't exist.
-
-2003-02-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-search-article): Speed up by
- disabling various visual features while searching.
- (gnus-summary-recenter): Test gnus-auto-center-summary first.
-
-2003-02-03 Jesper Harder <harder@ifa.au.dk>
-
- * spam.el (spam-list-of-checks): Don't quote nil and t in
- docstrings. From the elisp manual:
-
- When a documentation string refers to a Lisp symbol, write
- it [..] with single-quotes around it. [..] There are two
- exceptions: write t and nil without single-quotes.
-
- * messcompat.el (message-from-style): do.
-
- * message.el (message-send-mail): do.
-
- * gnus-util.el (gnus-use-byte-compile): do.
-
- * gnus-score.el (gnus-score-lower-thread): do.
-
- * gnus-int.el (gnus-server-unopen-status): do.
-
- * gnus.el (gnus-define-group-parameter, gnus-large-newsgroup)
- (large-newsgroup-initial, gnus-install-group-spam-parameters): do.
-
- * gnus-cus.el (gnus-group-customize, gnus-score-parameters)
- (gnus-group-parameters): do.
-
- * gnus-art.el (gnus-article-mime-match-handle-function): do.
-
- * mm-decode.el (mm-text-html-renderer): do.
-
-2003-02-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-directory-separator-character): Change the
- way to compute the dafault value.
-
-2003-02-02 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-button-handle-describe-key): Implement it.
- (gnus-button-alist): Fix regexp for describe-key.
- (gnus-button-handle-describe-function)
- (gnus-button-handle-describe-variable)
- (gnus-button-handle-apropos, gnus-button-handle-apropos-command)
- (gnus-button-handle-apropos-variable)
- (gnus-button-handle-apropos-documentation): Docstring fix.
-
- * gnus-util.el (gnus-kill-buffer): Use get-buffer.
-
-2003-02-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el (gnus-group-send-queue): Bind gnus-posting-styles
- to nil.
-
- * nnmail.el: Removed gnus-util autoload.
-
- * gnus.el: Use gnus-prin1-to-string throughout.
-
- * gnus-util.el (gnus-prin1-to-string): Bind print-length and
- print-level.
-
- * gnus-art.el (article-display-x-face): Removed grey x-face stuff.
- (gnus-treat-display-grey-xface): Removed.
-
- * gnus-fun.el (gnus-grab-cam-face): New.
- (gnus-convert-image-to-gray-x-face): Removed.
- (gnus-convert-gray-x-face-to-xpm): removed.
- (gnus-convert-gray-x-face-region): Removed.
- (gnus-grab-gray-x-face): Removed.
-
- * nnmail.el (nnmail-expiry-wait-function): Doc indent.
-
-2003-01-31 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-util.el (gnus-kill-buffer): Functions in gnus-util
- shouldn't depend on the rest of Gnus, so test if gnus-buffers is
- bound.
-
- * nnmail.el (nnmail-cache-close): Use gnus-kill-buffer.
-
-2003-01-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-cite.el (gnus-cite-reply-regexp, gnus-cite-always-check):
- Remove -- these are bogus options which are never used.
-
-2003-01-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-mode): Use summary tool bar.
-
-2003-01-27 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-blackholes)
- (spam-blackhole-good-server-regex): new variable to skip some IPs
- when checking blackholes; use it
- (spam-check-bogofilter-headers)
- (spam-bogofilter-bogosity-positive-spam-header): new variable, in
- case more X-Bogosity is used than just "Yes/No"
- (spam-ham-move-routine): semi-fixed, only first article is
- properly moved now
-
-2003-01-27 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-util.el (gnus-kill-buffer): Remove buffer from gnus-buffers
- as well.
-
- * gnus-sum.el (gnus-select-newsgroup): Use gnus-kill-buffer.
-
- * gnus-score.el (gnus-score-headers, gnus-score-find-bnews): do.
-
- * gnus-start.el (gnus-save-newsrc-file, gnus-clear-system): do.
-
- * gnus-bcklg.el (gnus-backlog-shutdown): do.
-
- * gnus-srvr.el (gnus-server-exit, gnus-browse-exit): do.
-
-2003-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-face-encode): New function.
- (gnus-convert-png-to-face): Use it.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Added M-& to marks.
-
-2003-01-26 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-dissection-list): Remove.
- (mm-dissect-singlepart): Don't push to mm-dissection-list, it's
- only used in mm-remove-all-parts.
- (mm-remove-all-parts): Remove it, it's never called.
-
-2003-01-25 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-make-group): Report errors.
-
- * nnimap.el (nnimap-request-create-group): Ditto.
-
- * sieve-manage.el (sieve-manage-is-okno): Parse literal strings.
-
- * sieve.el (sieve-upload): Fix error printing.
-
- * mm-encode.el (mm-qp-or-base64): Always QP iff
- mm-use-ultra-safe-encoding and cleartext PGP.
-
- * gnus-sum.el (gnus-summary-select-article): Inhibit
- redisplay (mainly for secured messages).
-
- * nnmail.el (nnmail-article-group): Copy body too (but don't
- process it).
-
-2003-01-25 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-setup-buffer): Reset
- gnus-button-marker-list.
-
-2003-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-read-timeout): Default to using a second delay
- under Microsoft Windows.
-
-2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-directory-separator-character): New
- variable.
-
-2003-01-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-max-fetch-size)
- (gnus-agent-article-alist, gnus-agent-get-undownloaded-list)
- (gnus-agent-catchup, gnus-agent-summary-fetch-group)
- (gnus-agent-fetch-articles, gnus-agent-backup-overview-buffer)
- (gnus-agent-flush-cache, gnus-agent-fetch-headers)
- (gnus-agent-braid-nov, gnus-agent-load-alist)
- (gnus-agent-article-alist-save-format)
- (gnus-agent-read-agentview, gnus-agent-save-alist)
- (gnus-agent-fetch-group-1, gnus-agent-expire)
- (gnus-agent-uncached-articles, gnus-agent-retrieve-headers)
- (gnus-agent-regenerate-group): Reformat to keep under eighty
- columns. Reword docstrings so that first line is under eighty
- chars and a complete sentence. Still need to work on the rear
- end of the file, in particular gnus-agent-expire.
-
-2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agentize): Indent.
-
- * gnus.el (gnus-version-number): Bumped.
-
-2003-01-24 20:32:44 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.14 is released.
-
-2003-01-24 Mark Thomas <swoon@bellatlantic.net> (tiny change)
-
- * gnus-sum.el (gnus-summary-prepare-threads): Reset state for %B
- before beginning.
-
-2003-01-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-blackholes, spam-split)
- (spam-mark-junk-as-spam-routine, spam-summary-prepare-exit): added
- gnus-message calls to show to users what spam.el is doing
-
-2003-01-24 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-message-replysign)
- (gnus-message-replyencrypt): Fix typo.
-
-2003-01-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-mime-security-show-details): Toggle showing
- details.
-
-2003-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-press-button): let* -> let.
- (gnus-mime-security-show-details): Cleaned up.
- (gnus-mime-security-press-button): Save excursion.
- (gnus-insert-mime-security-button): Clean up.
-
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Doc fix.
-
- * gnus-async.el (gnus-async-wait-for-article): Don't use a
- timeout.
-
- * nntp.el (nntp-accept-process-output): Removed timeout.
- (nntp-read-timeout): New variable.
- (nntp-accept-process-output): Use it.
-
- * gnus-sum.el (gnus-data-find-list): Remove *.
-
-2003-01-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-sum.el (gnus-summary-first-subject): Fixed bug that I
- introduced on 2002-01-22.
- (gnus-summary-first-unseen-or-unread-subject): Ditto.
-
-2003-01-23 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-regex-headers, spam-list-of-checks)
- (spam-regex-headers-spam, spam-regex-headers-ham): added spam/ham
- checks of incoming mail based on simple header regexp matching
-
-2003-01-22 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-sum.el (gnus-spam-mark): set to `$'
-
-2003-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Now computes
- gnus-newsgroup-unfetched, the list of articles whose headers have
- not been fetched from the server.
-
- * gnus-sum.el (gnus-summary-find-next): Removed undownloaded
- parameter as it never worked due to a bug. Added check to prevent
- selection of any article in the gnus-newsgroup-unfetched list.
- (gnus-summary-find-prev): Added check to prevent selection of any
- article in the gnus-newsgroup-unfetched list.
- (gnus-summary-first-subject): Documented API. Modified
- implementation so that constraints are handled independently.
- Added check to prevent selection of any article in the
- gnus-newsgroup-unfetched list.
- (gnus-summary-first-unseen-subject): Updated parameters in
- gnus-summary-first-subject call to match new API.
- (gnus-summary-first-unseen-or-unread-subject): Ditto.
- (gnus-summary-catchup): Do not mark unfetched articles as read.
-
-2003-01-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-treat-strip-pgp, gnus-article-hide-pgp-hook):
- make-obsolete-variable allows only two arguments in XEmacs and
- Emacs 20.
-
- * gnus-sum.el (gnus-summary-wash-hide-map): Remove
- gnus-article-hide-pgp.
- (gnus-summary-make-menu-bar): do.
-
- * gnus-art.el (gnus-treat-strip-pgp): Make obsolete.
- (gnus-treatment-function-alist): Remove gnus-treat-strip-pgp and
- gnus-article-hide-pgp.
- (article-hide-pgp): Remove.
- (gnus-article-hide): Remove gnus-article-hide-pgp.
-
- * gnus.el: Remove gnus-article-hide-pgp
-
-2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-required-headers): Doc fix.
-
-2003-01-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-group-ham-processor-bogofilter-p): fixed bug
- (spam-ifile-register-ham-routine, spam-ifile-ham-category): new
- option to make ifile a purely binary classifier
-
-2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mml-sec.el (mml-secure-sign-pgpauto): Renamed.
- (mml-secure-encrypt-pgpmime): Removed double.
-
- * gnus-sum.el (gnus-summary-mark-article-as-replied): Added
- debugging statements.
-
-2003-01-21 Andreas Fuchs <asf@void.at>
-
- * mml-sec.el (mml-sign-alist): Added pgpauto.
-
-2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bumped version number.
-
-2003-01-21 07:15:41 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.13 is released.
-
-2003-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-button-url-regexp): Removed |.
-
- * message.el (message-send-hook): Doc fix.
-
- * gnus-win.el (gnus-buffer-configuration): Display article
- instead of article-copy when `reply'.
-
-2003-01-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-format): Change customize group to gnus.
- (gnus-cache): Add link.
- (gnus-group-charter-alist): Fix docstring.
-
-2003-01-20 Jesper Harder <harder@ifa.au.dk>
-
- * mailcap.el (mailcap-print-command): lpr-command might be
- unbound in XEmacs.
-
-2003-01-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-regenerate-group): Added interactive form.
-
- * gnus-sum.el (gnus-summary-update-article-line): Fixed
- calculation of net characters added for use in the gnus-data
- structure.
-
-2003-01-18 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * nnmail.el (nnmail-process-unix-mail-format): Improve error
- message. Suggested by Jari Aalto.
-
-2003-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-followup-with-original): Clean up.
- (gnus-article-reply-with-original): Ditto.
-
- * gnus-sum.el (gnus-summary-catchup): Make sure downloadable,
- read articles don't become unread.
-
-2003-01-17 Simon Josefsson <jas@extundo.com>
-
- * gnus-fun.el (gnus-x-face-from-file):
- (gnus-face-from-file): Suggest image format in minibuffer prompt.
-
- * gnus-fun.el (gnus-convert-image-to-x-face-command)
- (gnus-convert-image-to-face-command): Doc fix.
-
-2003-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-convert-face-to-png): Protect against errors.
-
-2003-01-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-mime-print-part): Use mm-save-part-to-file to
- avoid encoding problems.
-
- * mailcap.el (mailcap-ps-command): New variable.
- (mailcap-mime-data): Add print entry where applicable. Use
- pdftotext on a tty.
-
-2003-01-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-alter-header-function): Add type and group.
-
-2003-01-16 Simon Josefsson <jas@extundo.com>
-
- * gnus-fun.el (gnus-convert-image-to-x-face-command)
- (gnus-convert-image-to-face-command, gnus-x-face-from-file)
- (gnus-face-from-file): Doc fix; don't mention image format.
-
-2003-01-16 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-get-article-as-filename): new function (unused for now)
- (spam-get-article-as-buffer): new function
- (spam-get-article-as-string): use spam-get-article-as-buffer
- (spam-summary-prepare-exit): fixed bug, noticed by Malcolm Purvis
-
-2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el: Don't use `path'.
- From the GNU coding standards:
-
- Please do not use the term ``pathname'' that is used in Unix
- documentation; use ``file name'' (two words) instead. We use
- the term ``path'' only for search paths, which are lists of
- directory names.
-
- * nnsoup.el (nnsoup-file-name): Ditto.
-
- * nnmail.el (nnmail-pathname-coding-system): Ditto.
- (nnmail-group-pathname): Ditto.
-
- * nnimap.el (nnimap-group-overview-filename): Ditto.
-
- * nnheader.el (nnheader-pathname-coding-system): Ditto.
- (nnheader-group-pathname): Ditto.
-
- * nnfolder.el (nnfolder-group-pathname): Ditto.
-
- * gnus.el (gnus-home-directory): Ditto.
-
- * gnus-group.el (gnus-group-icon-list): Ditto.
-
-2003-01-16 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-mime-print-part): Use mm-handle-media-type.
-
- * message.el (message-mode-menu): Use it.
- (message-mode-menu): Deactivate "Yank Original" if there's no
- reply buffer.
-
- * messagexmas.el (message-xmas-redefine): Redefine in XEmacs.
-
- * message.el (message-mark-active-p): New function.
-
-2003-01-15 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-use-bogofilter-headers, spam-bogofilter-header)
- (spam-bogofilter-database-directory): new variables
- (spam-check-bogofilter-headers, spam-check-bogofilter)
- (spam-bogofilter-register-with-bogofilter)
- (spam-bogofilter-register-spam-routine)
- (spam-bogofilter-register-ham-routine)
- (spam-group-ham-processor-bogofilter-p): new functions for the new
- Bogofilter interface
- (spam-summary-prepare-exit): use the new Bogofilter functions
- (spam-list-of-checks): added spam-use-bogofilter-headers
- (spam-bogofilter-score): rewrote function
- (spam-check-bogofilter): optional score parameter, uses
- spam-check-bogofilter-headers better
- (spam-check-bogofilter-headers): optional score parameter
-
- * gnus.el (gnus-install-group-spam-parameters): new variable, t by
- default, in the gnus-start customization group. Used to disable
- the spam-*/ham-* parameters.
- (gnus-group-ham-exit-processor-bogofilter): new ham processor
-
-2003-01-15 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-xmas.el (gnus-xmas-redefine): Use region-exists-p in
- XEmacs.
-
- * gnus-ems.el (gnus-mark-active-p): do.
-
-2003-01-15 Kevin Ryde <user42@zip.com.au>
-
- * gnus.texi (Using MIME): Mention auto-compression-mode with
- gnus-mime-copy-part.
-
-2003-01-15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send): Don't warn about duplicates when
- superseding.
-
-2003-01-15 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-split-download-body): New variable.
- (nnimap-split-articles): Use it.
-
-2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): This data
- integrity checker was incorrectly flagging, and removing, articles
- whose article number was negative.
- (gnus-agent-fetch-group-1): When executed in the group's summary
- buffer, refresh each downloaded line to update the status flag and
- font. Preserve the value of gnus-newsgroup-headers so that
- gnus-agent-fetch-articles can split the requests by size.
- (gnus-agent-expire): Corrected day calculation for when
- gnus-agent-expire-days contains a list.
-
-2003-01-14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-audio.el (gnus-audio-au-player): Use executable-find.
-
-2003-01-13 Jhair Tocancipa Triana <jhair_tocancipa@@gmx.net>
-
- * gnus-audio.el (gnus-audio-au-player, gnus-audio-wav-player): Use
- /usr/bin/play as default player.
- (gnus-audio-play): Added ARG-DESCRIPTOR to prompt for a file to play.
-
-2003-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-inews-add-send-actions): Allow a list of
- articles to be marked as well.
-
-2003-01-14 Kevin Greiner <kgreiner@xpediantsolutions.com>
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Include the
- fictious headers generated by nnagent (ie. Undownloaded Article
- ####) in the list of articles that have not been downloaded.
-
- * gnus-int.el (): Added require declarations to resolve
- compile-time warnings.
- (gnus-open-server): If the server status is set to offline,
- recursively execute gnus-open-server to open the offline backend
- (e.g. nnagent).
-
-2003-01-14 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (gnus-article-reply-with-original): Use
- gnus-mark-active-p.
- (gnus-article-followup-with-original): do.
-
-2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el: Removed `(when t ...)' around `gnus-define-keys'.
-
-2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-score.el (gnus-score-edit-file-at-point): New function.
- (gnus-score-find-trace): Bind it to `e' key. Added `q' for quit.
-
-2003-01-13 Romain FRANCOISE <romain@orebokech.com>
-
- * gnus-fun.el (gnus-x-face-from-file): Quote file name.
- (gnus-face-from-file): Ditto.
-
-2003-01-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-articles-to-read): Don't just apply
- gnus-alter-articles-to-read-function to the unread articles.
-
-2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * deuglify.el (gnus-article-outlook-unwrap-lines)
- (gnus-article-outlook-repair-attribution)
- (gnus-article-outlook-rearrange-citation): New function names,
- renamed from "gnus-outlook-" to "gnus-article-outlook-". Changed
- doc-string.
-
- * gnus-sum.el (gnus-summary-mode-map): Use new function names,
- removed `W k' key binding (use `W Y f' instead).
- (gnus-summary-make-menu-bar): Use new function names.
-
-2003-01-13 Simon Josefsson <jas@extundo.com>
-
- * gnus-fun.el (gnus-random-x-face): Doc fix.
- (gnus-insert-random-x-face-header): New function.
-
-2003-01-13 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Deactivate items if
- mark is not active.
-
- * gnus-msg.el (gnus-inews-do-gcc): Comment.
-
- * gnus-ems.el (gnus-mark-active-p): New function.
-
- * gnus-group.el (gnus-topic-mode-p): New function.
- (gnus-group-make-menu-bar): Show more key bindings in topic mode.
- Deactivate items if mark is not active.
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bumped version.
- (gnus-summary-line-format): Doc fix.
-
-2003-01-12 22:02:49 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.12 is released.
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mail-source.el (mail-sources): Removed autoload to make it
- compile under XEmacs.
-
-2003-01-12 Raymond Scholz <ray-2003@zonix.de>
-
- * gnus-msg.el (gnus-confirm-mail-reply-to-news): May be a
- regexp or a function too.
- (gnus-confirm-treat-mail-like-news): New variable. Ask for
- confirmation even if the original article is mail.
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-inews-add-send-actions): Get the right
- articles to be marked when not yanking.
-
-2003-01-12 Fran\e,Ag\e(Bois-David Collin <Francois-David.Collin@curie.fr>
-
- * mm-decode.el (mm-get-part): Use mm-with-unibyte-current-buffer.
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-face-from-file): Autoload.
-
- * gnus-cite.el (gnus-cite-delete-overlays): Protect against more
- errors.
-
-2003-01-12 Simon Josefsson <jas@extundo.com>
-
- * sieve.el (sieve-upload-and-bury): New. Suggested by
- kai.grossjohann@uni-duisburg.de (Kai Gro\e,A_\e(Bjohann).
-
- * sieve-mode.el (sieve-mode-map): Bind s-u-a-b to C-c C-c.
- Suggested by kai.grossjohann@uni-duisburg.de (Kai Gro\e,A_\e(Bjohann).
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-ignored-headers): Don't include the ^ and :
- in every string.
-
- * gnus.el (gnus-version-number): Bumped version number.
-
-2003-01-12 13:46:20 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.11 is released.
-
-2003-01-12 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-fetch-reply-field): Narrow to headers.
-
- * gnus-msg.el (gnus-inews-do-gcc): Don't try to mark GCC's as read
- if Gnus isn't alive.
-
-2003-01-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Remove downloadable
- marks from articles that are already stored in the agent.
- (gnus-agent-backup-overview-buffer): New debug tool. Creates a
- backup copy of an invalid .overview file for later analysis.
-
-2003-01-12 Gregorio Gervasio, Jr. <gtgj@pacbell.net>
-
- * gnus-sum.el (gnus-summary-exit): Reverse change to make group
- exit work with two frames.
-
-2003-01-11 Fran\e,Ag\e(Bois-David Collin <Francois-David.Collin@wanadoo.fr>
-
- * message.el (message-forward-make-body): Use mule4.
-
-2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-mode-map): Move wide-reply command.
-
-2003-01-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * deuglify.el (gnus-outlook-deuglify-attrib-verb-regexp): Added
- castellano.
- (gnus-outlook-display-hook): New variable.
- (gnus-outlook-display-article-buffer): New function.
- (gnus-outlook-unwrap-lines, gnus-outlook-repair-attribution)
- (gnus-outlook-deuglify-article): Made them interactive and added
- optional arg. Use `g-o-d-a-b'.
- (gnus-article-outlook-deuglify-article): Use `g-o-d-a-b'.
-
- * gnus-sum.el: Added autoloads.
- (gnus-summary-mode-map): Added gnus-summary-wash-deuglify-map.
- (gnus-summary-make-menu-bar): Added "(Outlook) Deuglify" menu.
-
-2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-display-mime): Use the mime emulation
- variable.
-
- * gnus-sum.el (gnus-article-emulate-mime): New variable.
-
- * gnus-start.el (gnus-read-newsrc-el-file): Make sure that the
- newsrc-alist is initialized properly.
-
- * mail-source.el (mail-sources): Autoload.
-
- * gnus-sum.el (gnus-summary-make-false-root-always): Default to
- nil.
-
- * gnus-msg.el (gnus-configure-posting-styles): Make sure we don't
- insert two newlines.
-
- * message.el (message-check-news-header-syntax): Compute the
- header length correctly.
-
-2003-01-10 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-expire): Do not remove article from
- alist when keeping fetched article file.
- (gnus-agent-retrieve-headers): When parsing response for article
- numbers, use the same algorithm as gnus-agent-braid-nov to protect
- against garbage in the server's response.
-
- * gnus-int.el (gnus-request-expire-articles,
- gnus-request-move-article): Only expire when the group's server
- has been agentized.
-
-2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-cite.el (gnus-cite-delete-overlays): Protect against
- errors when deleting overlays.
-
- * gnus-score.el (gnus-score-followup): Allow tracing.
-
- * gnus-art.el (gnus-treat-display-face): New variable.
- (article-display-face): New command.
-
- * gnus-fun.el (gnus-face-from-file): New function.
- (gnus-convert-face-to-png): Ditto.
-
- * gnus-art.el (gnus-ignored-headers): Added Face.
-
-2003-01-10 Simon Josefsson <jas@extundo.com>
-
- * nndraft.el (nndraft-request-group): Avoid crash in
- directory-files when draft directory doesn't exists.
-
- * gnus-sum.el (gnus-select-article-hook): Add :option.
-
-2003-01-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-use-stat): new variable
- (spam-group-spam-processor-stat-p)
- (spam-group-ham-processor-stat-p): new convenience functions
- (spam-summary-prepare-exit): add spam/ham processors to sequence
- (spam-list-of-checks): add spam-use-stat to list of checks
- (spam-split): conditionally load the spam-stat tables
- (spam-stat-register-spam-routine, spam-stat-register-ham-routine,
- spam-check-ifile): new functions
-
- * spam-stat.el (spam-stat): typo fix
- (spam-stat-install-hooks): new variable
- (spam-stat-split-fancy-spam-group): added documentation clarification
- (spam-stat-split-fancy-spam-threshhold): new variable
- (spam-stat-install-hooks): make hooks conditional
- (spam-stat-split-fancy): use spam-stat-split-fancy-spam-threshhold
-
- * gnus.el (gnus-group-ham-exit-processor-stat, spam-process): add
- spam-stat ham/spam processor symbols
-
-2003-01-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-read-newsrc-el-file): Make sure the .eld
- file exists.
-
-2003-01-10 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-read-group-1): Don't select first
- undownloaded/downloadable only when unplugged.
-
-2003-01-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Optimize inner loop.
-
-2003-01-09 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-ifile): fixed call-process-region to use the
- db parameter only if it's set
- (spam-ifile-register-with-ifile): ditto
-
-2003-01-09 Alex Schroeder <alex@emacswiki.org>
-
- * spam-stat.el (spam-stat-save): Set spam-stat-ngood and
- spam-stat-nbad before creating the hash table.
- (spam-stat-reset): Set spam-stat-ngood and spam-stat-nbad to 0.
- Changed copyright statement to FSF.
-
-2003-01-09 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-catchup): Do not mark cached nor
- processable articles as read.
- (gnus-agent-summary-fetch-series): Remove processable and
- downloadable marks on all downloaded articles in the series.
-
- * nntp.el (nntp-report): Throw error after reporting the problem.
- (nntp-accept-process-output): Corrected error check to report an
- error when the process is nil.
-
-2003-01-09 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-tool-bar-map): Add preview.
-
-2003-01-09 Jesper Harder <harder@ifa.au.dk>
-
- * mml.el (mml-preview): Get rid of MIME handles and buffers after
- previewing.
-
-2003-01-08 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--grp-add-art): Fix wrong-type-argument
- bug when the (n+1)th article to be added to a group has a smaller
- number than the n articles already added.
-
-2003-01-08 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-mode-field-menu): Use backquote.
-
-2003-01-08 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: fixed the BBDB autoloads again, using
- bbdb-search-simple now (which is not a macro, thank god)
-
- * lpath.el (bbdb-search): removed function from maybe-fbind list
-
- * gnus.el (ham-process-destination): added new parameter for
- destination of ham articles found in spam groups at summary exit
-
- * spam.el (spam-get-ifile-database-parameter): use spam-ifile-database-path
- (spam-check-ifile, spam-ifile-register-with-ifile): use spam-get-ifile-database-parameter
- (spam-ifile-database-path): added new parameter for ifile's database
- (spam-move-spam-nonspam-groups-only): new parameter to determine
- if spam should be moved from all groups or only some
- (spam-summary-prepare-exit): fixed logic to use
- spam-move-spam-nonspam-groups-only when deciding to invoke
- spam-mark-spam-as-expired-and-move-routine; always invoke that
- routine after the spam has been expired-or-moved in case there's
- some spam left over; use spam-ham-move-routine in spam groups
- (spam-ham-move-routine): new function to move ham articles to the
- ham-process-destinations group parameter
-
-2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-spec.el (gnus-parse-complex-format): %~ => ~*.
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Use
- gnus-summary-update-article-line.
-
-2003-01-08 Simon Josefsson <jas@extundo.com>
-
- * nnmail.el (nnmail-expiry-target-group): Request group, create it
- not successful.
-
-2003-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el (bbdb-records): Fbind it for both Emacs and XEmacs.
-
-2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-ifile): fixed the spam-ifile-all-categories
- logic, finally
-
-2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-spec.el (gnus-parse-format): %C is a complex format.
- (gnus-parse-format): Change to %~.
-
- * message.el (message-generate-headers): Don't generate optional
- empty headers.
-
-2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-cross-post-default)
- (message-cross-post-note-function, message-shoot-gnksa-feet)
- (message-strip-subject-trailing-was, message-change-subject)
- (message-mark-insert-file, message-cross-post-followup-to)
- (message-cross-post-followup-to, message-mode-map)
- (message-generate-unsubscribed-mail-followup-to)
- (message-make-mail-followup-to): Minor changes to doc-strings and
- error messages. Updated copyright line.
-
- * message.el (message-make-mail-followup-to,
- message-generate-unsubscribed-mail-followup-to): New function
- names. Renamed functions: "-mft" -> "-mail-followup-to".
- (message-make-mft, message-gen-unsubscribed-mft): Removed function
- names.
-
- * mml.el (mml-preview-insert-mail-followup-to): New function name.
- (mml-preview-insert-mft): Removed function name.
- (mml-preview): Use new function names.
-
- * gnus-art.el (gnus-article-edit-mode-map): Use new function names.
-
- * message.el (message-mode-field-menu): Moved header related
- commands from "Message" to "Field" menu.
-
-2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-generate-headers-first): Added customization
- if variable is a list.
-
-2003-01-07 Michael Shields <shields@msrl.com>
-
- * gnus-art.el (gnus-article-next-page): Correctly handle the case
- where the last line of the article is the last line of the window.
-
-2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-debug): Use ignore-errors.
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Use
- `gnus-summary-update-line'.
-
-2003-01-08 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-unbuttonized-mime-types)
- (gnus-buttonized-mime-types): Doc fix.
-
-2003-01-08 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-inline-media-tests): .xpm is 'x-xpixmap'.
-
-2003-01-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-group-alist): Add and clear up.
-
-2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: removed unnecessary condition-case for loading bbdb-com.el
-
- * lpath.el (bbdb-search): added BBDB functions for a better way to
- fix missing functions
-
- * spam.el (spam-check-ifile): if should be an unless
-
- * spam.el: define 'ignore alias for spam-BBDB-register-routine,
- spam-enter-ham-BBDB, and bbdb-create-internal initially to hush up warnings
- (spam-ifile-all-categories): doc string fixed to be less than 80 chars
-
-2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Added
- gnus-summary-refer-thread to thread menu.
-
-2003-01-07 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): When fetching within a
- summary buffer, articles that cannot be fetched are marked as
- canceled.
-
- * nntp.el (nntp-with-open-group): The quit signal handler must
- propagate the quit signal to the next outer handler so that the
- caller knows that the request aborted abnormally.
-
-2003-01-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-ifile, spam-ifile-register-with-ifile)
- (spam-ifile-register-spam-routine)
- (spam-ifile-register-ham-routine): added ifile functionality that
- does not use ifile-gnus.el to classify and register articles
- (spam-get-article-as-string): convenience function
- (spam-summary-prepare-exit): added ifile spam and ham registration
- (spam-ifile-all-categories, spam-ifile-spam-category)
- (spam-ifile-path, spam-ifile): added customization options
-
- * gnus.el (gnus-group-ham-exit-processor-ifile): added ifile ham
- exit processor
- (spam-process): added gnus-group-ham-exit-processor-ifile to the
- list of choices
-
-2003-01-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-followup): Also score immediate
- followups.
-
-2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-asynchronous-p): Changed to nil.
-
-2003-01-07 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-mode-menu): Fix receipt balloon help.
-
-2003-01-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-group-post-news): Don't assume that "" will
- always be interpreted as news.
-
-2003-01-07 Simon Josefsson <jas@extundo.com>
-
- * gnus-sieve.el (gnus-sieve-script): Use the crosspost argument to
- gnus-sieve-script, instead of the global variable
- gnus-sieve-crosspost. One-line patch from Steinar Bang
- <sb@dod.no>.
-
-2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.el: Renamed gnus-summary-*-uncached-face as
- gnus-summary-*-undownloaded-face to avoid confusing the agent with
- the cache.
-
- * gnus-sum.el: Ditto.
-
-2003-01-06 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-group): Modified to permit execution
- in either the group or summary buffer.
- New command "JS", in summary buffer, will fetch articles per the
- group's category, predicate, and processable flags.
- (gnus-agent-summary-fetch-series): Rewritten to call
- gnus-agent-session-fetch-group once with all articles in the
- series.
- (gnus-agent-summary-fetch-group): Fixed bug and modified code to
- return list of fetched articles.
- (gnus-agent-fetch-articles): Split fetch list into sublists such
- that the article buffer is only slightly larger than
- gnus-agent-max-fetch-size. Added unwind-protect to ensure that
- the group's article alist is saved.
- (gnus-agent-fetch-headers): The 'killed' and 'cached' marks no
- longer result in the agent trying to fetch an article.
- (gnus-agent-fetch-group-1): Can now be called in either the group
- or summary buffer. Removed the max-fetch-size code that I added
- on 2002-12-13 as that capability is now part of
- gnus-agent-fetch-articles. Added code to update summary buffer.
- When called in the group buffer, articles that can not be fetched
- are AUTOMATICALLY MARKED AS READ.
-
- * gnus-sum.el (): Modified eval-when-compile to minimize
- misleading compilation warnings.
- (gnus-update-summary-mark-positions): Changed code to use
- gnus-undownloaded-mark rather than gnus-downloaded-mark.
-
- * nnheader.el (nnheader-insert-nov-file): Do not try to insert an
- empty file as the parser assumes that the file isn't empty.
-
- * nntp.el (nntp-send-string): The process-send-string call can,
- because it performs I/O on the process, change the process' state
- from open to closed. If this happens, call nntp-report
- immediately to report the broken connection.
- (nntp-report): Rewritten to avoid needing a global variable to
- determine the appropriate course of action. Instead, two function
- implementations are provided and the nntp-report function value is
- bound to the appropriate implementation.
- (nntp-retrieve-data): Moved nntp-report call to end of implementation.
- (nntp-with-open-group): Now binds nntp-report's function cell
- rather than binding gnus-with-open-group-first-pass. Added a
- condition-case to detect a quit during a nntp command. When the
- quit occurs, the current connection is closed as a fetch articles
- request could have several megabytes queued up for reading.
- (nntp-retrieve-headers): Bind articles to itself. If
- nntp-with-open-group repeats this command, I must have access to
- the original list of articles.
- (nntp-retrieve-groups): Ditto for groups.
- (nntp-retrieve-articles): Ditto for articles.
- (*): Replaced nntp-possibly-change-group calls to
- nntp-with-open-group forms in all, but one, occurrance.
- (nntp-accept-process-output): Bug fix. Detect when called with
- null process.
-
-2003-01-06 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-find-mime-charset-region): Don't do Latin-9 hack
- if we don't need to.
- (mm-iso-8859-x-to-15-region): Fix misplaced parenthesis.
-
-2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-make-web-group): Pass the select
- method on to group-create.
- (gnus-group-line-format-alist): %U is an integer.
-
- * gnus-sum.el (gnus-summary-exit-no-update): Don't update
- ephemeral groups.
- (gnus-summary-read-group-1): Ditto.
- (gnus-group-make-articles-read): Ditto.
-
- * mm-url.el (mm-url-program): Doc fix.
-
- * message.el (message-mode-map): Rebound
- message-insert-wide-reply.
-
-2003-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-xmas.el (gnus-xmas-group-startup-message): Bind the oort
- color as `gnus-group-startup-message' does.
-
-2003-01-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: fixed line lengths to 80 chars or less
-
- * gnus-sum.el (gnus-read-mark-p): added the spam-mark as a
- "not-read" mark
- (gnus-summary-mark-forward): added the spam-mark to the list of
- marks not to be marked as "read" when viewed
-
-2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-inews-make-draft): Quote article-reply.
-
- * gnus-group.el (gnus-number-of-unseen-articles-in-group):
- Protect against unactive groups.
-
- * message.el (message-check-news-header-syntax): Check long
- header lines.
- (message-check-news-header-syntax): Update `start'.
-
- * gnus-group.el (gnus-group-expire-articles): Doc fix.
- (gnus-group-line-format): %U.
- (gnus-group-line-format-alist): ?U.
- (gnus-number-of-unseen-articles-in-group): New function.
-
- * nntp.el (nntp-accept-process-output): Use a 0.1 second timeout.
-
- * gnus.el (gnus-version-number): Bump version number.
-
-2003-01-05 01:53:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.10 is released.
-
-2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Fix version number.
-
-2003-01-05 01:40:09 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.08 is released.
-
-2003-01-04 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el: Add mm-string-make-unibyte.
-
- * gnus-group.el (gnus-group-jump-to-group): Make it work for
- UTF-8 groups.
-
-2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-variable-list): Write gnus-format-specs last.
-
- * gnus-sum.el (gnus-summary-goto-subjects): Fix typo.
-
-2003-01-04 Kevin Ryde <user42@zip.com.au>
-
- * gnus-art.el (gnus-mime-jka-compr-maybe-uncompress): New
- function.
-
-2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-exit): Bind gnus-group-is-exiting-p.
- (gnus-summary-read-group-1): Update group line.
- (gnus-summary-exit-no-update): Update group on exit.
-
- * gnus-group.el (gnus-group-line-format): Add %*.
- (gnus-group-line-format-alist): Ditto.
- (gnus-group-insert-group-line): Set it.
- (gnus-group-is-exiting-p): New variable.
- (gnus-group-insert-group-line): Use it.
-
-2003-01-03 Teodor Zlatanov <tzz@beld.net>
-
- * spam.el (spam-enter-ham-BBDB, spam-BBDB-register-routine):
- enable BBDB ham processing
- (spam-blacklist-register-routine): enable blacklist spam processing
- (spam-whitelist-register-routine): enable whitelist ham processing
- (spam-fetch-field-from-fast): fast fetching of the "from" field
- from (gnus-data-list)
- (spam-summary-prepare-exit): works completely now
- (spam-use-blacklist): oops, should be nil by default
- (spam-summary-prepare-exit): spam-use-PROCESSOR is only for
- split processing now; before it was for summary exit as
- well but that's done with the spam-contents and spam-process
- parameters now
-
-2003-01-03 Jesper Harder <harder@ifa.au.dk>
-
- * mml.el (mml-insert-tag): Don't quote non-ASCII unibyte
- characters.
-
-2003-01-02 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-group-spam-contents-p, spam-group-ham-contents-p)
- (spam-group-processor-p, spam-group-processor-bogofilter-p)
- (spam-group-processor-ifile-p, spam-group-processor-blacklist-p)
- (spam-group-processor-whitelist-p, spam-group-processor-BBDB-p)
- (spam-mark-spam-as-expired-and-move-routine)
- (spam-generic-register-routine, spam-BBDB-register-routine)
- (spam-ifile-register-routine, spam-blacklist-register-routine)
- (spam-whitelist-register-routine): new functions
- (spam-summary-prepare-exit): added summary exit processing (expire
- or move) of spam-marked articles for spam groups; added slots for
- all the spam-*-register-routine functions
-
-2003-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * pop3.el (pop3-retr): Wait 500 msecs.
- (pop3-read-response): Ditto.
-
- * gnus-msg.el (gnus-setup-message): Get the evaliation order
- right.
- (gnus-inews-make-draft): New function.
- (gnus-setup-message): Use it.
-
- * message.el (message-required-headers): Add From.
-
-2003-01-02 Norbert Koch <nk@viteno.net> (tiny change)
-
- * gnus-msg.el (gnus-gcc-externalize-attachments): Fix typo.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-generate-headers): Let header formatters do
- their work.
-
-2003-01-02 Raymond Scholz <ray-2003@zonix.de>
-
- * deuglify.el (gnus-article-outlook-deuglify-article):
- Rehighlight, reapply treatments and call
- `gnus-article-prepare-hook'. Suggested by Niels Olof Bouvin.
- (gnus-outlook-repair-attribution-block): Recognize cited
- attributions. Suggested by Niklas Morberg.
-
-2003-01-02 Pete Kazmier <pete@kazmier.com>
-
- * gnus-art.el (gnus-treat-predicate): Check condition first.
-
-2003-01-02 Jesper Harder <harder@ifa.au.dk>
-
- * lpath.el: Add url-http-file-exists-p.
-
- * gnus-group.el (gnus-group-fetch-charter): Use
- http://TLH.news-admin.org/charters/GROUPNAME as a fallback.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-draft-headers): Also generate From to get a
- nicer draft buffer summary.
-
- * gnus-xmas.el (gnus-xmas-read-event-char): Take an optional
- parameter.
-
- * gnus-art.el (article-wash-html): Clean up.
- (article-wash-html): Typo fix.
-
- * gnus-msg.el (gnus-summary-mail-forward): Clean up.
- (gnus-summary-mail-forward): To many lists of lists.
-
- * gnus-art.el (article-wash-html): Clean up.
-
-2003-01-02 pete-temp <pete-temp-12-29-2002@kazmier.com>
-
- * gnus-art.el (gnus-treat-wash-html): New variable.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-check-news-header-syntax): Allow posting.
- (message-check-news-header-syntax): Fix logic for sure, this
- time.
-
-2003-01-02 Matthieu Moy <Matthieu.Moy@imag.fr>
-
- * message.el (message-check-news-header-syntax): Check syntax of
- continuation headers.
-
-2003-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-url-regexp,
- (gnus-button-mid-or-mail-regexp, gnus-button-alist,
- (gnus-header-button-alist): Regexps are case insensitive here.
-
-2003-01-02 Simon Josefsson <jas@extundo.com>
-
- * dig.el (query-dig): Doc fix.
-
-2003-01-02 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Update whole
- summary buffer line, not just the download mark.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-goto-subjects): New function.
- (gnus-summary-insert-dormant-articles): New command and
- keystroke.
-
- * gnus-cache.el (gnus-summary-insert-cached-articles): Use new
- function for mass insertion of subjects.
-
- * nndraft.el (nndraft-generate-headers): Don't move point.
-
- * gnus.el (nnheader): Require nnheader.
-
- * nndraft.el (nndraft-request-associate-buffer): Use
- make-local-variable.
-
-2003-01-02 Michael Shields <shields@msrl.com>
-
- * nndraft.el (nndraft-request-associate-buffer): Make
- write-contents-hooks buffer-local before setting it.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-group-parameter-value): Take an extra param.
- (gnus-group-fast-parameter): Let group param results be nil.
-
- * gnus-art.el (gnus-article-forward-header): New function.
- (article-date-ut): Use it to remove continuation date headers.
-
- * gnus-sum.el (gnus-summary-walk-group-buffer): Supply prompt to
- read-event.
- (gnus-summary-remove-bookmark): Clean up.
- (gnus-summary-set-bookmark): Clean up.
-
- * gnus-util.el (gnus-read-event-char): Take an optional prompt.
-
- * gnus.el (gnus-group-startup-message): Bind data-directory to
- the Gnus etc directory.
-
-2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-summary-prepare-exit): added slots for spam- and
- ham-processing of articles; use the new
- spam-group-(spam|ham)-contents-p functions
- (spam-group-spam-contents-p, spam-group-ham-contents-p): new
- convenience functions
- (spam-mark-junk-as-spam-routine): use the new
- spam-group-spam-contents-p function
-
- * gnus.el (spam-process, spam-contents, spam-process-destination):
- added new parameters with corresponding global variables
- (gnus-group-spam-exit-processor-ifile,
- gnus-group-spam-exit-processor-bogofilter,
- gnus-group-spam-exit-processor-blacklist,
- gnus-group-spam-exit-processor-whitelist,
- gnus-group-spam-exit-processor-BBDB,
- gnus-group-spam-classification-spam,
- gnus-group-spam-classification-ham): added new symbols for the
- spam-process and spam-contents parameters
-
- * spam.el (spam-ham-marks, spam-spam-marks): changed list
- customization and list itself to store mark symbol rather than
- mark character.
- (spam-bogofilter-register-routine): added logic to generate mark
- values list from spam-ham-marks and spam-spam-marks, so (member)
- would work.
-
-2003-01-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-cross-post-followup-to): Fix comment.
-
-2003-01-01 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-ham-marks, spam-spam-marks): changed list
- customization and list itself to store mark symbol rather than
- mark character.
- (spam-bogofilter-register-routine): added logic to generate mark
- values list from spam-ham-marks and spam-spam-marks, so (member)
- would work.
-
-2003-01-01 Raymond Scholz <ray-2002@zonix.de>
-
- * message.el (message-signature-insert-empty-line): New variable.
-
-2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el: Renamed functions and variables: "xpost" ->
- "cross-post", "-fup2" -> "-followup-to".
- (message-cross-post-old-target, message-cross-post-default,
- message-cross-post-note, message-followup-to-note,
- message-cross-post-note-function): New variables names.
- (message-xpost-old-target, message-xpost-default,
- message-xpost-note, message-fup2-note,
- message-xpost-note-function): Removed variable names.
- (message-cross-post-followup-to-header,
- message-cross-post-insert-note, message-cross-post-followup-to):
- New function names.
- (message-xpost-fup2-header, message-xpost-insert-note,
- message-xpost-fup2): Removed function names.
-
-2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-send-mail): Added message-cleanup-headers to
- prevent newlines in headers.
-
-2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dns.el (dns-make-network-process): Comment.
-
- * gnus-sum.el (gnus-summary-display-while-building): Default to
- nil.
-
-2003-01-01 Wes Hardaker <wes@hardakers.net>
-
- * gnus-sum.el (gnus-summary-display-while-building): New
- variable.
-
-2003-01-01 Raymond Scholz <ray-2003@zonix.de>
-
- * deuglify.el (gnus-outlook-rearrange-article): Kill overlays
- before rearranging the article.
-
-2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nndraft.el (nndraft-generate-headers): New function.
- (nndraft-request-associate-buffer): Use it to write headers on
- buffer save.
-
- * message.el (message-generate-headers): Let the function be a
- lambda form.
- (message-draft-headers): New variable.
-
- * gnus-msg.el (gnus-inews-make-draft-meta-information): New
- function.
- (gnus-setup-message): Use it.
-
- * message.el (message-generate-headers-first): Doc fix.
- (message-setup-1): Use new function for getting which headers to
- generate.
- (message-headers-to-generate): New function.
-
-2003-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-save-alist): Make directory.
-
-2002-12-31 Reiner Steib <4uce.02.r.steib@gmx.net>
-
- * gnus-sum.el (gnus-summary-limit-to-age): Make prompt string
- mention negatives.
-
-2002-12-31 Raymond Scholz <ray-2002@zonix.de>
-
- * deuglify.el (gnus-outlook-rearrange-article): Use
- `transpose-regions' instead of tempering the kill-ring.
- (gnus-article-outlook-deuglify-article): Rehighlight article
- instead of a complete redisplay.
-
-2002-12-31 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el: most defvars are defcustoms now
-
- patches from Michael Shields <shields@msrl.com>
-
- * spam.el (spam-bogofilter-articles): Select the article
- body using gnus-summary-show-article t instead of
- gnus-summary-select-article; this presents the raw text
- without running any hooks.
-
- * spam.el (spam-bogofilter-articles): Use message-remove-header
- to remove headers; the old way incorrectly removed just the first
- line of folded headers.
-
-2002-12-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-load): Replace `ding-file' with `file'.
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-load): New function.
- (gnus-read-newsrc-el-file): Use it.
-
-2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-valid-fqdn-regexp): New variable.
- (gnus-button-handle-apropos-documentation): New function.
- (gnus-button-handle-ctan): New function.
- (gnus-button-alist): Use them. Improve some regexps.
- (gnus-button-prefer-mid-or-mail): Addition to doc-string.
-
-2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-subscribed-p): New function.
- (message-send-mail): Use it.
- * mml.el (mml-preview-insert-mft): New function.
- (mml-preview): Use it.
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-thread-latest-date): Protect against errors
- when sorting by date.
-
- * gnus-art.el (gnus-article-edit-mode): New variable.
- (gnus-article-setup-buffer): Warn user about discarding edits.
-
- * gnus-sum.el (gnus-summary-pipe-output): Clean up.
- (gnus-summary-pipe-output): Take a symbolic prefix to save all
- headers.
-
- * mm-uu.el (mm-uu-configure-list): Default to (shar . disabled).
-
-2002-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-completion-alist): Added "Mail-Followup-To"
- and "Mail-Copies-To".
-
-2002-07-21 Jesper harder <harder@ifa.au.dk>
-
- * gnus-group.el: Add key bindings for
- gnus-group-sort-groups-by-real-name and
- gnus-group-sort-selected-groups-by-real-name.
-
-2002-07-21 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Sorting Groups): Add key bindings for
- gnus-group-sort-groups-by-real-name and
- gnus-group-sort-selected-groups-by-real-name.
-
-2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-use-dig): new variable for blackhole checking
- through dig.el
- (spam-check-blackholes): added dig.el checking functionality and
- more verbose reporting; query-dig is autoloaded from dig.el
- (spam-use-blackholes): disabled by default
- (spam-blackhole-servers): removed rbl.maps.vix.com from the
- blackhole servers list
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-required-headers): New variable.
-
-2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * dig.el (query-dig): new function
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * flow-fill.el (fill-flowed): Don't infloop on too long fill
- prefixes.
-
- * dns.el (query-dns): Protect against errors.
-
- * gnus-msg.el (gnus-article-yanked-articles): New variable.
- (gnus-inews-add-send-actions): Mark all answered messages as
- answered.
-
-2002-08-10 Jari Aalto <jari.aalto@poboxes.com>
-
- * nnmail.el (nnmail-split-it): Added tracing to
- `:' split rule
-
-2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
-
- * mm-decode.el (mm-mailcap-command): Remove the quotes around '%s'
- and "%s" so we don't overquote them.
-
-2002-08-13 Hrvoje Niksic <hniksic@xemacs.org>
-
- * (mm-display-external): Display the actual command that has been
- executed in the echo area.
-
-2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-display-missing-topic): Bind entry.
-
- * message.el (message-with-reply-buffer): New macro.
- (message-fetch-reply-field): Use it.
- (message-insert-wide-reply): New command and keystroke.
- (message-carefully-insert-headers): New function.
- (message-insert-to): Use new function.
-
- * gnus-topic.el (gnus-topic-display-missing-topic): New function.
- (gnus-topic-goto-missing-group): Use it.
-
- * message.el (message-required-news-headers): Removed Lines.
- (message-reply): Don't insert References first.
- (message-followup): Ditto.
- (message-make-references): New function.
- (message-followup): Set message-reply-headers before generating
- the buffer stuff.
-
-2002-12-29 Jesper Harder <harder@ifa.au.dk>
-
- * mml.el (mml-generate-mime-1): Reverse the order of
- encoding/flowing.
-
-2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnmail.el (nnmail-expiry-target-group): Mark articles as read
- after moving them.
-
- * gnus-sum.el (gnus-summary-dummy-line-format): Update format to
- fit with newer standard format.
- (gnus-summary-make-false-root-always): New variable.
- (gnus-gather-threads-by-subject): Use it.
-
- * message.el (message-get-reply-headers): Take an address list
- optional argument.
-
-2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-keep-backlog): Change default to 20.
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): Start from
- start.
- (gnus-agent-check-overview-buffer): Remove negative article
- numbers.
-
- * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): Doc fix.
- (nnmail-cache-ignore-groups): Doc fix.
-
- * nnimap.el (nnimap-debug): Made into a flag and defcustomed.
- (nnimap-debug-buffer): New variable.
- (nnimap-debug): Use it.
-
-2002-12-28 Lars Magne Ingebrigtsen <kgreiner@xpediantsolutions.com>
-
- * gnus.el (gnus-summary-high-uncached-face): New color scheme.
-
-2002-12-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): Sort lines if
- they aren't already sorted.
-
-2002-12-28 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-mode-menu): Add ellipses to menu items
- expecting user interaction.
- (message-mode-field-menu): do.
-
-2002-12-26 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-highlight-line): Don't bind `list' --
- it isn't used any more.
-
-2002-12-22 Jesper Harder <harder@ifa.au.dk>
-
- * binhex.el (binhex-decoder-program): Fix docstring.
-
-2002-12-21 Laurent Martelli <laurent@bearteam.org>
-
- * mm-decode.el (mm-mailcap-command): Do not backslash-quote
- special chars if the mailcap file uses single quotes around %s.
-
-2002-12-19 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-int.el (gnus-request-update-info): nnchoke-r-u-i might not
- return the info object.
-
-2002-12-18 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-int.el (gnus-request-update-info): Artificially add
- (1 . (1- min)) to the read range, in case the backend doesn't
- store marks for nonexistent articles.
-
-2002-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * binhex.el (binhex-insert-char): Eval-and-compile.
-
-2002-12-17 Jesper Harder <harder@ifa.au.dk>
-
- * lpath.el: Add tool-bar-local-item-from-menu.
-
- * message.el (message-tool-bar-local-item-from-menu): New function.
- (message-tool-bar-map): Use it.
-
-2002-12-14 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-uu.el (gnus-uu-digest-headers): Mention nil value in docstring.
-
- * gnus-art.el (gnus-article-header-rank): Last header in
- gnus-sorted-header-list should have higher rank than non-members.
-
-2002-12-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-close-agent): Don't blank out the list of
- covered methods.
-
-2002-12-12 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * nntp.el (nntp-with-open-group-first-pass): Do not wrap in
- eval-when-compile. Suggested by Kevin Greiner.
-
-2002-12-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-max-fetch-size): New, defcustom.
- (gnus-agent-fetch-headers): Initialize gnus-agent-overview-buffer
- even though no headers may have been fetched
- (gnus-agent-fetch-group-1, and perhaps others, require this
- behavior).
- (gnus-agent-fetch-group-1): Fetch articles in chucks so that the
- server buffer is constrained by gnus-agent-max-fetch-size.
- Multiple chunks in the same group may perform arbitrarily large
- updates.
-
-2002-12-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Added call to
- gnus-summary-update-download-mark to update the article in the
- summary.
-
-2002-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.el (gnus-summary-high-uncached-face,
- gnus-summary-normal-uncached-face, gnus-summary-low-uncached-face)
- New faces.
-
- * gnus-agent.el (gnus-agent-downloaded-article-face): REMOVED. I
- added this on 2002-11-23 but it just wasn't working out as
- intended. The idea isn't entirely dead, three new faces
- gnus-summary-*-uncached-face are being added to gnus.el to provide
- the basis for an improved implementation.
- (gnus-agent-read-servers): Undo the change made on 2002-11-23. The
- proper file to open is lib/servers.
- (gnus-summary-set-agent-mark): Expanded documentation. Unmarking
- (i.e. removing the article from gnus-newsgroup-downloadable) will
- now restore the article's default mark rather than simply setting
- no mark.
- (gnus-agent-get-undownloaded-list): Corrected documentation.
- Added code to set new summary local variable,
- gnus-newsgroup-agentized. Reworked impl so that it doesn't create
- a temporary list. No longer sets gnus-newsgroup-downloadable.
- (gnus-agent-summary-fetch-group): Keep gnus-newsgroup-undownloaded
- up to date. Call new gnus-summary-update-download-mark to keep
- summary buffer up-to-date.
- (gnus-agent-fetch-selected-article): Keep
- gnus-newsgroup-undownloaded up to date.
- (gnus-agent-fetch-articles): Return list of articles that were
- successfully fetched.
- (gnus-agent-check-overview-buffer): No more thingatpt.
- (gnus-agent-expire): No longer deletes NOV entries of unread
- articles.
- (gnus-agent-unread-articles): New function.
- (gnus-agent-regenerate-group): The article number must be
- terminated by a tab character. Added more messages to report
- repairs. Inhibit quits while writing changes so it is now safe
- have to quit regeneration. Renamed gnus-tmp-downloaded back to
- downloaded to 1) resolve the unbound references and 2) avoid
- confusing this list with the gnus-tmp-downloaded in gnus-sum.el
-
- * gnus-art.el (gnus-article-prepare): The agent
- downloaded/undownloaded mark is no longer stored as the article's
- mark.
-
- * gnus-salt.el (gnus-tree-highlight-node): Added uncached as
- gnus-summary-highlight may use it. Added downloaded as
- gnus-summary-highlight was using it.
-
- * gnus-sum.el (gnus-undownloaded-mark): Changed from ?@ to ?- as
- the download mark now follows Kai's +/- convention.
- (gnus-downloaded-mark): Added ?+ mark.
- (gnus-summary-highlight): Added rules to select
- gnus-summary-high-uncached-face,
- gnus-summary-normal-uncached-face, and
- gnus-summary-low-uncached-face. Removed the
- gnus-agent-downloaded-article-face.
- (gnus-summary-line-format-alist): Implemented the download flag
- format (?O) as named in the manual. This implementation displays
- either gnus-undownloaded-mark, gnus-downloaded-mark, or
- gnus-no-mark.
- (gnus-newsgroup-agentized): New local variable that identifies
- which groups are agentized. While the agent is now on by default,
- you don't have to agentize every server that you use.
- (gnus-update-summary-mark-positions): Completed support for the
- download type of mark.
- (gnus-summary-insert-line): Added undownloaded to the parameters.
- (gnus-summary-prepare-threads): Set gnus-tmp-downloaded for
- reference by the gnus-summary-line-format-spec.
-
- * nntp.el (nntp-with-open-group): This macro handles dropped or
- broken connections by opening a new connection and repeating the
- failed command.
- (nntp-retrieve-headers-with-xover): Some NNTP servers respond to
- XOVER commands preceeding the active articles with the nov entry
- of the first available article. When gnus connected to such a
- server, the unexpected nov entry would result in duplicate lines
- in the agent's overview file. This patch fixes the duplicate
- lines problem and improves performance by skipping over all
- articles IDs that preceed the first nov entry in the server's
- reply.
-
-2002-12-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-tmp-downloaded): New internal variable.
- (gnus-summary-highlight): Use it instead of `downloaded'.
- (gnus-summary-highlight-line): Ditto.
-
- * gnus-agent.el (gnus-agent-regenerate-group): Ditto.
-
-2002-12-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-variable-list): Add gnus-agent-covered-methods.
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): Remove debug
- calls.
-
- * gnus-sum.el (gnus-summary-highlight-line): Don't set the
- downloaded variable if we're in an uncovered group.
-
- * gnus-agent.el (gnus-agent-downloaded-article-face): Change the
- font to soemthing less noticeable.
- (gnus-agent-group-covered-p): New function.
-
-2002-12-09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-braid-nov): Remove corrupted lines.
- Because of an unknown bug, the group buffer is saved in .overview
- file.
-
-2002-12-09 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * nntp.el (nntp-send-command): Braino in last commit. Replace
- `and' with `or'.
-
-2002-12-08 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * nntp.el (nntp-send-command): Assume that echo does not happen
- when nntp-open-connection-function is nntp-open-network-stream.
- Suggested by Sebastian D.B. Krause <krause@my.gnus.org>.
-
-2002-12-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Update the parser.
-
-2002-12-06 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-group): bugfix: don't erase
- nntp-server-buffer if we aren't going to write to it.
-
-2002-12-04 Itai Zukerman <zukerman@math-hat.com> (tiny change)
-
- * mm-decode.el (mm-w3m-safe-url-regexp): Fix parenthesis.
-
-2002-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-decode-region): Remove newlines between
- decoded words.
-
-2002-12-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.el (fboundp): After loading mm-util, make sure it was the
- right one.
-
-2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Moved here from
- gnus-sum. Made into a user option.
-
- * gnus-sum.el (gnus-simplify-ignored-prefixes)
- (gnus-summary-mark-article-as-unread)
-
-2002-11-29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * time-date.el (date-to-time): Typo.
-
- * parse-time.el: Typo.
-
- * nnsoup.el (nnsoup-retrieve-headers): Typo.
-
- * nnmail.el (nnmail-split, nnmail-process-unix-mail-format): Typos.
-
- * nnimap.el:
- (nnimap-split-rule, nnimap-find-minmax-uid): Typos.
-
- * mm-encode.el (mm-safer-encoding): Typo.
-
- * messcompat.el: Typo.
-
- * message.el (message-face-alist): Typo.
-
- * imap.el (imap-interactive-login, imap-open): Typos.
-
- * ietf-drums.el (ietf-drums-text-token, ietf-drums-qtext-token): Typos.
-
- * gnus.el: Typo.
-
- * gnus-win.el (gnus-configure-frame): Typo.
-
- * gnus-util.el (gnus-atomic-progn-assign): Typo.
-
- * gnus-topic.el (gnus-topic-sort-topics): Typo.
-
- * gnus-sum.el (gnus-summary-article-number)
- (gnus-summary-read-group-1, gnus-summary-mark-article)
- (gnus-summary-fetch-faq, gnus-refer-article-methods): Typos.
-
- * gnus-mule.el (gnus-mule-add-group): Typo.
-
- * gnus-mlspl.el (gnus-group-split-fancy): Typo.
-
- * gnus-group.el (gnus-group-fetch-faq): Typo.
-
- * gnus-art.el (gnus-decode-header-methods): Typo.
-
- * flow-fill.el: Typo.
-
-2002-11-19 Stefan Monnier <monnier@cs.yale.edu>
-
- * binhex.el (binhex-decode-region): Don't hardcode point-min == 1.
-
-2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-sum.el (gnus-simplify-ignored-prefixes)
- (gnus-summary-mark-article-as-unread)
- (gnus-mark-article-as-unread, gnus-summary-highlight-line):
- Reformatting to avoid long lines.
- (gnus-inhibit-mime-unbuttonizing): Moved to gnus-art.
-
-2002-11-28 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): Article numbers should
- be accessed through `mail-header-number'.
-
-2002-11-27 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-sum.el (gnus-summary-insert-old-articles): No longer passes
- compressed range to gnus-summary-insert-articles.
-
-2002-11-26 Kevin Ryde <user42@zip.com.au>
-
- * gnus-art.el (gnus-mime-copy-part): Look for filename
- parameter under content-disposition, not content-type.
-
- * gnus-sum.el (gnus-summary-find-uncancelled): New function.
- (gnus-summary-reselect-current-group): Use it.
-
-2002-11-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-uncached-articles): if
- gnus-agent-load-alist fails, return ARTICLES.
-
- * nnrss.el (nnrss-group-alist): Update the link of Jabber.
-
-2002-11-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-sum.el (gnus-summary-insert-old-articles): Remove
- superfluous function call.
- (gnus-summary-catchup-all, gnus-summary-catchup-all-and-exit):
- Add warning to docstring.
-
-2002-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el: Autoload number-at-point instead.
- (gnus-agent-check-overview-buffer): No warning for deactivate-mark.
-
-2002-11-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): Explicitly
- require thingatpt (for number-at-point) and protect against
- deactivate-mark being unbound (on XEmacs).
-
-2002-11-25 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-check-overview-buffer): Make debugger
- print message on entry.
-
-2002-11-25 Kevin Greiner <kgreiner@xpediantsolutions.com>.
-
- * gnus-range.el (gnus-range-difference): New function.
- * gnus-sum.el (gnus-summary-insert-old-articles): Use it.
-
-2002-11-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-sum.el (gnus-summary-insert-old-articles): Use
- gnus-remove-from-range instead of gnus-range-difference which
- doesn't exist.
-
-2002-11-23 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el (gnus-agent-downloaded-article-face): New face,
- used for showing which articles have been downloaded.
- (gnus-agent-article-alist): Format change. Add documentation.
- (gnus-agent-summary-mode-map): New keybinding `J s' for fetching
- process-marked articles.
- (gnus-agent-summary-fetch-series): Command for `J s'. Articles
- in the series are individually fetched to minimize lose of
- content due to an error/quit.
- (gnus-agent-synchronize-flags-server, gnus-agent-add-server): Use
- gnus-message instead of message.
- (gnus-agent-read-servers): Use file lib/methods instead of
- lib/servers. TODO: Why?
- (gnus-summary-set-agent-mark): Adapt to new agent-alist format.
- (gnus-agent-get-undownloaded-list): Remove articles that appear to
- come from the agent. This means that they are not downloaded.
- (gnus-agent-fetch-selected-article): Don't use history.
- (gnus-agent-save-history, gnus-agent-enter-history)
- (gnus-agent-article-in-history-p, gnus-agent-history-path):
- Removed function; history is not used anymore.
- (gnus-agent-fetch-articles): Fix handling of crossposted articles.
- (gnus-agent-crosspost): Started rewrite then realized that a typo
- in gnus-agent-fetch-articles ensures that this function is never
- called. This will need to be fixed later.
- (gnus-agent-check-overview-buffer): Some sanity checks on the
- agent overview buffer. This is a safety net used during
- development.
- (gnus-agent-flush-cache): The gnus-agent-article-alist format has
- changed, write a number to the file indicating this.
- (gnus-agent-fetch-headers): Rewrite to respect
- gnus-agent-consider-all-articles without relying on the
- `.fetched' files. Make it fast.
- (gnus-agent-braid-nov): Change resulting from
- gnus-agent-fetch-headers change.
- (gnus-agent-load-alist, gnus-agent-save-alist): Don't use
- `.fetched' files.
- (gnus-agent-read-agentview): New function, used by
- gnus-agent-load-alist.
- (gnus-agent-load-fetched-headers): Remove.
- (gnus-agent-save-alist): Rewrite to accomodate new format.
- (gnus-agent-fetch-group-1): Make sure list of articles is in the
- same order as in gnus-newsgroup-headers.
- (gnus-agent-expire): Document and implement extra args ARTICLES,
- GROUP, FORCE. Do not restrict usage.
- (gnus-agent-uncached-articles): New function.
- (gnus-agent-retrieve-headers): Use it.
- (gnus-agent-regenerate-group): No longer needs to be called from
- gnus-agent-regenerate. Individual groups may be regenerated. The
- regeneration code now fixes duplicate, and mis-ordered, NOV entries.
- The article fetch dates are validated in the article alist. The
- article alist is pruned of entries that do not reference existing
- NOV entries. All changes are computed then applied with
- inhibit-quit bound to t. As a result, it is now safe to quit out of
- regeneration. The optional clean parameter has been replaced with
- an optional reread parameter. Clean is no longer necessary as
- regeneration gets the appropriate setting from
- gnus-agent-consider-all-articles. The new reread parameter will
- result in fetched, or all, articles being marked as unread.
- (gnus-agent-regenerate): Removed code to regenerate the history
- file as it is no longer used.
-
- * gnus-start.el (gnus-make-ascending-articles-unread): New
- function, for efficient mass-marking.
-
- * gnus-sum.el (gnus-summary-highlight): Use new face for
- downloaded articles.
- (gnus-article-mark): Prefer to indicate read/unread status over
- downloaded status.
- (gnus-summary-highlight-line-0): New function, maybe rehighlights
- line.
- (gnus-summary-highlight-line): Use new face for downloaded
- articles.
- (gnus-summary-insert-old-articles): Improved performance by
- replacing the initial LIST of older articles with a compressed
- RANGE of older articles. Some servers appear to lie about
- their active range so the original list could contain millions
- of article numbers. The range is not expanded into a list
- until the optional ALL parameter has been applied.
-
-2002-11-18 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-category-mode): Typo in doc string.
-
-2002-11-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el:
- added patch from Andreas Fuchs <asf@void.at> to prevent apply errors
-
- * spam.el: added `M s t' and `M s x' key mappings
-
-2002-11-20 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-morse-message): Narrow to body.
-
-2002-11-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-morse-message): Load
- morse.el (unmorse-region not autoloaded in Emacs 20 nor XEmacs).
- (unmorse-region): Autoload it instead.
-
-2002-11-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-morse-message): New function.
- (gnus-summary-wash-map): Bind to `W m'.
- (gnus-summary-make-menu-bar): Add.
-
- * nnimap.el (nnimap-request-expire-articles): Compress sequence
- before storing \Deleted mark on expired articles.
-
-2002-11-17 Markus Rost <rost@math.ohio-state.edu> (tiny change)
-
- * gnus-sum.el (gnus-summary-goto-unread): Doc fix - escape open
- parens in column 0.
-
-2002-11-17 Juanma Barranquero <lektu@terra.es>
-
- * nnweb.el (nnweb-google-create-mapping): Fix typo.
-
- * nnlistserv.el (nnlistserv-kk-create-mapping): Likewise.
-
- * gnus-nocem.el (gnus-nocem-liberal-fetch): Likewise.
-
-2002-11-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-set-auto-save-file-name): Use
- make-directory, to avoid the dependence on gnus-util.
-
-2002-11-16 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-callback-callback-function):
- (nnimap-callback-buffer): Removed, these cannot be global but must
- be embedded into the callback.
- (nnimap-make-callback): New. Embedd article number, callback and
- buffer in function.
- (nnimap-callback, nnimap-request-article-part): Update.
-
-2002-11-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-preview): Bind message-this-is-mail if it is mail.
-
-2002-11-13 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.el (gnus-summary-line-format): Document %C.
-
-2002-11-11 Simon Josefsson <jas@extundo.com>
-
- * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify): Display
- output when called interactively.
-
-2002-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-edit-exit): Kill local variables.
-
- * message.el (message-draft-coding-system): Improve comment; use
- mm-auto-save-coding-system for the default value.
-
- * nndraft.el (nndraft-request-article): Revert to the state before
- 2002-10-29; regexp-quote mail-header-separator.
-
-2002-11-06 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-draft.el (gnus-draft-setup): Set gnus-message-group-art to
- allow editing of drafts from an nnvirtual group.
-
-2002-11-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nndraft.el (nndraft-request-article): Replace emacs-mule with
- mm-auto-save-coding-system.
-
- * message.el (message-draft-coding-system): Default to
- iso-2022-7bit.
-
- * mm-util.el (mm-auto-save-coding-system): Undo last change to
- restore the default value to emacs-mule or escape-quoted.
-
-2002-11-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-encrypt-body): Inhibit encrypting of
- a delayed or a queued article as well as a draft.
-
- * gnus-sum.el (gnus-summary-edit-article): Inhibit editing of a
- delayed or a queued article in the raw format; treat a delayed
- article as a raw article as well as a draft.
- (gnus-summary-setup-default-charset): Clear gnus-newsgroup-charset
- for the delayed group.
-
- * nndraft.el (nndraft-request-article): Ignore auto save files for
- a delayed or a queued article; don't bother to decode a queued
- article; don't bind nnmail-file-coding-system for a queued article.
-
- * nnmail.el (nnmail-split-fancy-with-parent): Ignore the delayed
- and the queue group.
-
-2002-11-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-delete-group):
- gnus-cache-active-hashtb might be void.
-
-2002-11-02 Raymond Scholz <ray-2002@zonix.de>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Makes PGG respect the
- setting of the default user ID.
-
-2002-11-01 Jesper Harder <harder@ifa.au.dk>
-
- * mm-bodies.el (mm-body-encoding): Don't return 8bit for 7bit
- charset.
-
-2002-10-31 Alex Schroeder <alex@emacswiki.org>
-
- * spam-stat.el (spam-stat-process-directory): add dir to message
- (spam-stat-reduce-size): No longer remove words
- with values close to 0.5, because the default value is 0.2.
-
-2002-10-31 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-util.el (gnus-user-date-format-alist): Clarify and correct
- documentation.
-
-2002-10-28 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-fetched-headers)
- (gnus-agent-load-fetched-headers)
- (gnus-agent-save-fetched-headers): Remove variable and two
- functions. Kevin Greiner's version of gnus-agent-fetch-headers
- works better.
- (gnus-agent-fetch-headers): New implementation from Kevin
- Greiner. Uses gnus-agent-article-alist to store information
- about fetched messages which aren't on the server anymore. The
- trick is to return a list of considered messages to the caller,
- but to only fetch those which haven't been fetched yet.
-
-2002-10-30 Simon Josefsson <jas@extundo.com>
-
- * pgg-def.el (pgg-passphrase-cache-expiry): New, defcustom.
-
- * pgg.el (pgg-passphrase-cache-expiry): Removed.
-
-2002-10-30 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * mm-view.el (mm-w3m-local-map-property): Make it work with older
- versions of emacs-w3m than 1.3.3.
-
- * lpath.el: Bind w3m-minor-mode-map.
-
- * mm-view.el (mm-w3m-mode-command-alist)
- (mm-w3m-mode-dont-bind-keys, mm-w3m-mode-ignored-keys): Removed.
- (mm-w3m-mode-map): Undefined for Emacs21 and XEmacs.
- (mm-setup-w3m): Simplified.
- (mm-w3m-local-map-property): New function.
- (mm-inline-text-html-render-with-w3m): Use it.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Use
- mm-w3m-local-map-property.
-
-2002-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-auto-save-coding-system): Default to
- iso-2022-7bit.
-
- * nndraft.el (nndraft-request-article): Decode an article using
- the coding-system emacs-mule if it seems to have been saved using
- emacs-mule.
- (nndraft-request-replace-article): Use message-draft-coding-system
- instead of mm-auto-save-coding-system for the draft or delayed
- group.
-
-2002-10-28 Josh Huber <huber@alum.wpi.edu>
-
- * mml.el (mml-mode-map): Fixed keybindings for mml-secure-*
- functions.
-
-2002-10-28 Mark A. Hershberger <mah@everybody.org>
-
- * mm-url.el (mm-url-insert-file-contents): Make it return the same
- type values ("url" size) regardless of the values of
- mm-url-use-external.
-
-2002-10-26 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * nnimap.el (nnimap-request-article-part): Try harder to show
- group name in debugging message.
-
-2002-10-25 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-save-fetched-headers): Create
- directory if it doesn't exist.
- (gnus-agent-fetch-headers): Remove old cruft that tried to
- abstain from downloading articles more than once if
- gnus-agent-consider-all-articles was true. This is now done
- properly via the .fetched files.
-
-2002-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nndraft.el (nndraft-request-article): Treat delayed articles
- like drafts.
-
-2002-10-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-load-alist): Fix parenthesis.
-
-2002-10-24 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-save-alist, gnus-agent-load-alist):
- Remove unused optional arg DIR and corresponding code.
-
- * nnimap.el (nnimap-request-article-part): Include group name in
- debugging output.
-
-2002-10-24 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Add some comments.
-
-2002-10-23 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus-agent.el (gnus-agent-fetched-headers): New variable,
- contains range of headers that have been fetched by the agent
- already. Compare gnus-agent-article-alist.
- (gnus-agent-file-header-cache): Like
- gnus-agent-file-loading-cache, but for gnus-agent-fetched-headers.
- (gnus-agent-fetch-headers): Improve comment. Revert to old
- seen/recent logic.
- Remember which headers have been fetched before and don't fetch
- them again the next time round.
- (gnus-agent-load-fetched-headers)
- (gnus-agent-save-fetched-headers): New functions, for remembering
- which headers have been fetched before.
-
-2002-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Remove useless bindings.
-
-2002-10-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-execute-command): Disable visual
- features while searching.
-
-2002-10-22 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * pgg.el (pgg-snarf-keys): Do not refer unbinded local variables.
-
-2002-10-22 Simon Josefsson <jas@extundo.com>
-
- * pgg.el (pgg-encrypt, pgg-decrypt, pgg-sign, pgg-verify)
- (pgg-snarf-keys): Add.
-
-2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind bbdb-records.
-
- * spam.el: Don't autoload bbdb-records.
-
-2002-10-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * spam.el: Set autoload for bbdb-records after loading bbdb-com to
- prevent inf-loop.
-
-2002-10-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el: Removed some test lines.
- More test.
-
-2002-10-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Remove articles that
- are known to be downloaded already.
-
-2002-10-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-text-html-renderer-alist): Add w3m-standalone.
- (mm-text-html-washer-alist): Ditto.
-
-2002-10-19 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * nnheader.el (nnheader-remove-body): Fix an error of detecting
- boundary between headers and body.
- * nnml.el (nnml-parse-head): Ditto.
-
-2002-10-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-generate-active): Ignore any bogus
- entries.
-
- * gnus-group.el (gnus-fetch-group): Allow an optional
- specification of the articles to select.
-
- * gnus-srvr.el (gnus-server-prepare): Removed superfluous cdr.
-
-2002-10-20 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-fetch-group-1): After fetching
- headers from the group, update variable `articles' to contain
- only those numbers where headers exist. (When fetching all
- articles in a group, Gnus creates lots of numbers where there is
- no articles.)
-
-2002-10-20 Steve Youngs <youngs@xemacs.org>
-
- * pgg-parse.el (pgg-parse-public-key-algorithm-alist): XEmacs
- doesn't have the 'alist custom type, use cons cells instead.
- (pgg-parse-symmetric-key-algorithm-alist): Ditto.
- (pgg-parse-hash-algorithm-alist): Ditto.
- (pgg-parse-compression-algorithm-alist): Ditto.
- (pgg-parse-signature-type-alist): Ditto.
-
- * pgg-gpg.el (pgg-gpg-extra-args): Fix custom mismatch.
-
- * pgg-pgp5.el (pgg-pgp5-extra-args): Ditto.
-
- * pgg-pgp.el (pgg-pgp-extra-args): Ditto.
-
-2002-10-19 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-open-server): Check imap-state in IMAP server
- buffer.
-
-2002-10-18 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-spec.el (gnus-make-format-preserve-properties)
- (gnus-xmas-format, gnus-parse-simple-format): Preserve text
- properties also on XEmacs. `gnus-xmas-format' is like format but
- preserves text properties on XEmacs (though it only understands
- simple format specs). The variable
- `gnus-make-format-preserve-properties' controls whether the
- function is used, and is checked in `gnus-parse-simple-format'.
- Patch by Paul Moore <gustav@morpheus.demon.co.uk>.
-
- * gnus-agent.el (gnus-agent-fetch-articles): More debugging
- output.
- (gnus-agent-consider-all-articles): New variable.
- (gnus-agent-get-undownloaded-list): Comment that marks todo item.
- (gnus-agent-fetch-headers): Depending on
- gnus-agent-consider-all-articles, maybe get all articles.
- (gnus-category-predicate-alist, gnus-agent-read-p): New predicate
- `read'.
- (gnus-predicate-imples-unread): New function.
- (gnus-agent-fetch-headers): Optimize to call
- gnus-list-of-unread-articles if that is sufficient.
- Check unseen and recent instead of seen and recent.
- (gnus-agent-fetch-headers): Abstain from calling
- gnus-list-range-intersection if range (a . b) would have (> a b).
-
-2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-send-mail): Make it possible to perform
- edebug-defun.
-
-2002-10-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-button-man-handler): Change default to
- `manual-entry' (defined in both emacsen).
- (gnus-button-man-handler): Remove emacsen difference and use
- `manual-entry'.
-
-2002-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * spam.el: Wrap autoload settings for bbdb-records,
- executable-find and ifile-spam-filter with eval-and-compile.
- (spam-display-buffer-contents): Remove.
- (spam-bogofilter-score): Merge spam-display-buffer-contents.
-
-2002-10-17 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-display-buffer-contents): New function.
- (spam-bogofilter-score): use spam-display-buffer-contents, patch
- from Katsumi Yamaoka <yamaoka@jpl.org>.
-
-2002-10-17 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * nnheader.el (nnheader-parse-naked-head): New function.
- (nnheader-parse-head): Use the above function, in order to handle
- continuation lines properly.
- (nnheader-remove-body): New function.
- (nnheader-remove-cr-followed-by-lf): New function.
- (nnheader-ms-strip-cr): Use the above function.
-
- * gnus-agent.el (gnus-agent-regenerate-group): Call
- `nnheader-remove-body'; use `nnheader-parse-naked-head' instead of
- `nnheader-parse-head'.
- * gnus-cache.el (gnus-cache-possibly-enter-article): Ditto.
-
- * gnus-msg.el (gnus-inews-yank-articles): Do not unfold
- continuation lines by itself; call `nnheader-parse-naked-head'
- instead of `nnheader-parse-head'.
- * nndiary.el (nndiary-parse-head): Ditto.
- * nnfolder.el (nnfolder-parse-head): Ditto.
- * nnimap.el (nnimap-retrieve-headers-progress): Ditto.
- * nnmaildir.el (nnmaildir--update-nov): Ditto.
- * nnml.el (nnml-parse-head): Ditto.
-
-2002-10-17 Steve Youngs <youngs@xemacs.org>
-
- * gnus-art.el (gnus-button-man-handler): Add 'manual-entry' for
- XEmacs, default to it if featurep 'xemacs.
-
-2002-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * spam-stat.el: Check for the existence of hash functions instead
- of the Emacs version to decide whether to load cl. Suggested by
- Kai Gro\e,A_\e(Bjohann.
-
-2002-10-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Open history
- if it isn't open yet.
-
-2002-10-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el: Require mm-url only when compiling.
- (gnus-group-fetch-charter): Require mm-url.
-
- * spam-stat.el: Require cl for the functions gethash,
- hash-table-count, make-hash-table and mapc for Emacs 20.
- (puthash): Alias to cl-puthash for Emacs 20.
- (with-syntax-table): New macro for Emacs 20.
-
-2002-10-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-spec.el (gnus-pad-form): Use gnus-string-width-function.
-
-2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-check-ifile): added ifile as a spam checking
- backend, and spam-use-ifle as the variable to toggle that check.
-
-2002-10-12 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-beginning-of-line): New variable.
- (message-beginning-of-line): Use it.
-
-2002-10-11 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el: more compilation fixes for BBDB
-
- * spam-stat.el: added code from Alex Schroeder <alex@gnu.org>
- (spam-stat-reduce-size): Interactive.
- (spam-stat-reset): New function.
- (spam-stat-save): Interactive.
-
-2002-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el: Autoload gnus-delay-initialize.
-
- * message.el: Autoload gnus-delay-article.
-
-2002-10-11 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-spec.el (gnus-balloon-face-function): Use the help-echo
- text property in Emacs.
-
-2002-10-11 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
- (mml2015-pgg-verify, mml2015-pgg-clear-verify): Remove CR.
-
- * mml1991.el (mml1991-pgg-sign): Remove CR.
-
-2002-10-10 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-pgg-decrypt): Set gnus details even when
- decrypt failed.
- (mml2015-trust-boundaries-alist): Removed.
- (mml2015-gpg-extract-signature-details): Don't use it.
- (mml2015-unabbrev-trust-alist): New.
- (mml2015-gpg-extract-signature-details): Use it.
-
-2002-10-10 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el: compilation fixes, spam-check-bbdb function is nil if no
- BBDB installed
-
- * spam-stat.el: added code from Alex Schroeder <alex@gnu.org> to do
- statistical analysis of spam in Lisp only
-
-2002-10-10 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-open-server): Re-open server if it isn't in
- auth, selected or examine state.
-
- * pgg-gpg.el (pgg-gpg-verify-region): Filter out stuff into output
- buffer and error buffer depending on type of information.
-
- * mml2015.el (mml2015-gpg-extract-signature-details): Parse
- --status-fd stuff even if gpg.el is not used (revert earlier
- change).
- (mml2015-pgg-{clear-,}verify): Store both output and errors as
- gnus details.
- (mml2015-pgg-{clear-,}verify): Extract signature info from errors
- buffer.
-
- * pgg.el (pgg-verify-region): Use it.
-
- * pgg-def.el (pgg-query-keyserver): New variable.
-
- * pgg.el (pgg-decrypt-region): Bind pgg-default-user-id to
- key-identifier in packet. Is this a good idea?
-
- * mml.el (mml-mode-map): Add security commands that operates on
- MIME parts.
- (mml-menu): And menu items for them.
-
- * mml1991.el (mml1991-pgg-encrypt): Remove headers.
-
- * mml.el (mml-parse-1): Support sender in #secure tags.
-
- * mml1991.el (mml1991-pgg-sign): Only use message-sender if it is
- defined.
-
- * mml-sec.el (mml-smime-encrypt-buffer): Warn about combined signing.
- (mml-pgp-encrypt-buffer): Support combined signing.
-
- * mml1991.el (mml1991-mailcrypt-encrypt): Support combined signing.
- (mml1991-gpg-encrypt): Ditto.
- (mml1991-pgg-encrypt): Ditto.
- (mml1991-encrypt): Pass sign parameter.
-
- * mml-sec.el (mml-signencrypt-style-alist): Defcustom.
- (mml-signencrypt-style): Mention the variable.
-
-2002-10-09 Simon Josefsson <jas@extundo.com>
-
- * mml1991.el (mml1991-pgg-sign): Bind pgg-default-user-id, not
- pgg-gpg-user-id.
-
- * pgg.el (pgg-insert-url-with-w3): Ignore errors.
- (pgg-fetch-key-function): Nil if w3 is not installed.
-
-2002-10-08 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Bind
- gnus-agent-current-history.
-
-2002-10-06 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-parse-status): Don't use read to read token.
-
-2002-10-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-fetch-selected-article): Do nothing
- for methods not covered by the agent, and when unplugged.
-
-2002-10-05 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Query passphrase when
- signing.
-
- * gnus-agent.el (gnus-agent-read-servers): If getting method from
- a named server fails, ignore the server.
-
- * mml1991.el (mml1991-pgg-sign): Do QP.
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt really
- work.
-
-2002-10-04 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Make signencrypt work.
-
- * pgg-pgp.el (pgg-pgp-verify-region): Inline
- binary-write-decoded-region from MEL.
-
- * pgg.el (pgg-encrypt-region): Support sign.
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Ditto.
-
- * mml2015.el (mml2015-pgg-encrypt): Ditto.
-
- * pgg.el, pgg-def.el, pgg-parse.el, pgg-gpg.el, pgg-pgp5.el,
- pgg-pgp6.el: Moved from ../pgg/. Modifications compared to EMIKO
- branch where PGG was taken from in the ChangeLog entries below.
-
-2002-10-01 Simon Josefsson <jas@extundo.com>
-
- * pgg-pgp.el: Don't require mel. Don't use luna.
- (pgg-scheme-pgp-instance, pgg-make-scheme-pgp): Remove.
- (pgg-pgp-process-region): Use expand-file-name instead of concat.
- (pgg-pgp-process-region): Don't use binary-funcall.
-
- * pgg-pgp5.el (pgg-pgp5-process-region): Don't use binary-funcall.
-
- * pgg-gpg.el (pgg-gpg-process-region): Use expand-file-name
- instead of concat.
-
- * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
-
-2002-09-29 Simon Josefsson <jas@extundo.com>
-
- * pgg-parse.el (pgg-char-int, pgg-string-as-unibyte): Prevent byte
- compile warnings.
-
- * pgg.el (pgg-decrypt-region): Don't parse packet.
-
- * pgg.el, pgg-gpg.el, pgg-pgp5.el: Don't depend on luna.el.
-
-2002-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * pgg.el: Remove dependency on calist.el.
-
-2002-09-28 Simon Josefsson <jas@extundo.com>
-
- * pgg.el (pgg-temporary-file-directory): New variable.
- (pgg-verify-region): Don't assume set-buffer-multibyte exists.
-
- * pgg-pgp5.el (pgg-pgp5-process-region, pgg-scheme-verify-region)
- (pgg-scheme-snarf-keys-region): Use pgg-temporary-file-directory.
-
- * pgg-parse.el (pgg-char-int): Defalias.
- (pgg-format-key-identifier, pgg-byte-after, pgg-read-byte)
- (pgg-read-bytes, pgg-read-body): Use it.
- (pgg-decode-packets): Don't use MEL, use base64-*.
- (pgg-parse-armor): Don't assume set-buffer-multibyte exists.
- (pgg-string-as-unibyte): Defalias.
- (pgg-parse-armor-region): Use it.
-
- * pgg-gpg.el (pgg-gpg-process-region): Use
- pgg-temporary-file-directory.
-
- * luna.el: Don't def-edebug.
-
- * pgg-pgp5.el (pgg-scheme-verify-region): Inline
- binary-write-decoded-region from MEL.
-
- * pgg-pgp5.el, pgg-gpg.el: Don't require mel.
-
- * alist.el, calist.el: Don't require product/APEL.
-
- * pgg-parse.el (top-level): Remove dependency on static.el,
- pccl.el, mel.el.
- (pgg-parse-crc24, pgg-parse-crc24-string): Only define if
- `define-ccl-program' is boundp, instead of using broken.
-
-2002-10-01 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-required-mail-headers): Remove Lines:.
-
-2002-10-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-fetch-charter,
- gnus-group-fetch-control): Prompt for group if given a prefix
- argument.
- * gnus-sum.el: Add gnus-group-fetch-charter and
- gnus-group-fetch-control to summary key map and menu.
-
-2002-10-03 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--group-maxnum-art): fix maximum article
- number when there are no articles.
-
-2002-10-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-agent.el (gnus-agent-summary-fetch-group): Optional prefix
- arg ALL means to fetch all articles, not only downloadable ones.
- (gnus-agent-fetch-selected-article): New function for
- gnus-select-article-hook or gnus-mark-article-hook.
-
-2002-10-02 Peter von der Ahe <nospam2159@daimi.au.dk>
-
- * gnus-ems.el (gnus-x-splash): Set coding-system-for-read to
- raw-text.
-
-2002-09-30 Ted Zlatanov <tzz@lifelogs.com>
-
- * spam.el: merged changes from pinard@iro.umontreal.ca (Fran\e,Ag\e(Bois
- Pinard).
- Major revamp of the code, documentation is in comments in the file
- for now.
-
-2002-09-30 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-pgg-clear-verify): Verifying in a unibyte
- buffer seem to be needed?
-
-2002-09-29 Simon Josefsson <jas@extundo.com>
-
- * mml1991.el (pgg-output-buffer, pgg-errors-buffer): Prevent byte
- compile warnings.
-
- * mml1991.el (mml1991-function-alist): Add pgg.
- (mml1991-pgg-sign, mml1991-pgg-encrypt): New functions.
- (mml1991-pgg-encrypt): Fix recipients querying.
-
-2002-09-28 <dme@dme.org> (tiny change)
-
- * mml2015.el (autoload): Autoload correct files.
-
-2002-09-28 Simon Josefsson <jas@extundo.com>
-
- (mml2015-pgg-decrypt, mml2015-pgg-verify): Make sure either nil or
- handle is returned.
-
-2002-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news):
- Protect against non-existent of `nnimap-mailbox-info'.
-
-2002-09-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-start.el (gnus-fixup-nnimap-unread-after-getting-new-news): New.
- (gnus-setup-news-hook): Use it.
- (gnus-after-getting-new-news-hook): Ditto.
-
- * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Remove.
-
-2002-09-27 Mats Lidell <matsl@contactor.se>
-
- * gnus-art.el (gnus-article-mode-syntax-table): Replace "-" to " ".
-
-2002-09-27 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-sum.el (gnus-nov-parse-line): When an error is signaled in
- the part to decode encoded words, use raw words instead of decoded
- words.
-
-2002-09-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnimap.el (nnimap-update-unseen): Use gnus-gethash-safe.
-
- * mm-view.el (mm-w3m-mode-ignored-keys): New variable.
- (mm-setup-w3m): Use it.
-
-2002-09-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-article-mode-syntax-table): Make M-. work in
- article buffers.
-
- * nnimap.el (nnimap-fixup-unread-after-getting-new-news): Autoload
- it just in case.
- (nnimap-update-unseen): New function; update unseen count in
- `n-m-info'.
- (nnimap-close-group): Call it.
-
- * gnus-start.el (gnus-setup-news-hook): Add n-f-u-a-g-n-n.
- (gnus-after-getting-new-news-hook): Ditto.
-
- * nnimap.el (nnimap-retrieve-groups): Move the quick mail check
- message into verboselevel 9. Change slow mail check message.
- (nnimap-retrieve-groups): Use prefixed names in n-mailbox-info.
- (nnimap-fixup-unread-after-getting-new-news): New function, to be
- used as a hook after getting new mail.
-
-2002-09-26 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-parse-resp-text-code): The UNSEEN value in
- SELECT/EXAMINE is first unseen article, not number of unseen
- articles. Make them distinct by renaming the former to
- `first-unseen' instead of `unseen'.
-
- * nnimap.el (nnimap-retrieve-groups): Get uidvalidity and unseen
- too.
- (nnimap-retrieve-groups): Don't used cached data if uidvalidity
- changed.
- (nnimap-retrieve-groups): Store uidvalidity and unseen data too.
-
- * gnus-int.el (gnus-server-unopen-status): Defcustom.
-
- * mml-sec.el (mml-signencrypt-style): Docstring to font-lock
- better.
-
- * mml2015.el (mml2015-pgg-decrypt): Only add security information
- if dissecting resulting buffer actually had any information.
-
-2002-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-sort-by-method): Remove `symbol-name'
- because the function `string<' allows symbols.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Ditto.
-
-2002-09-25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward-make-body): Revert an early change
- because 8-bit utf-8 emails.
-
-2002-09-25 Bj\e,Av\e(Brn Torkelsson <torkel@acc.umu.se>
-
- * gnus-agent.el (gnus-category-line-format): Doc fixes (mostly added
- links to Info)
- * gnus-art.el (gnus-treat-highlight-signature):
- * gnus-art.el (gnus-treat-buttonize):
- * gnus-art.el (gnus-treat-buttonize-head):
- * gnus-art.el (gnus-treat-emphasize):
- * gnus-art.el (gnus-treat-strip-cr):
- * gnus-art.el (gnus-treat-unsplit-urls):
- * gnus-art.el (gnus-treat-leading-whitespace):
- * gnus-art.el (gnus-treat-hide-headers):
- * gnus-art.el (gnus-treat-hide-boring-headers):
- * gnus-art.el (gnus-treat-hide-signature):
- * gnus-art.el (gnus-treat-fill-article):
- * gnus-art.el (gnus-treat-hide-citation):
- * gnus-art.el (gnus-treat-hide-citation-maybe):
- * gnus-art.el (gnus-treat-strip-list-identifiers):
- * gnus-art.el (gnus-treat-strip-pgp):
- * gnus-art.el (gnus-treat-strip-pem):
- * gnus-art.el (gnus-treat-strip-banner):
- * gnus-art.el (gnus-treat-highlight-headers):
- * gnus-art.el (gnus-treat-highlight-citation):
- * gnus-art.el (gnus-treat-date-ut):
- * gnus-art.el (gnus-treat-date-local):
- * gnus-art.el (gnus-treat-date-english):
- * gnus-art.el (gnus-treat-date-lapsed):
- * gnus-art.el (gnus-treat-date-original):
- * gnus-art.el (gnus-treat-date-iso8601):
- * gnus-art.el (gnus-treat-date-user-defined):
- * gnus-art.el (gnus-treat-strip-headers-in-body):
- * gnus-art.el (gnus-treat-strip-trailing-blank-lines):
- * gnus-art.el (gnus-treat-strip-leading-blank-lines):
- * gnus-art.el (gnus-treat-strip-multiple-blank-lines):
- * gnus-art.el (gnus-treat-unfold-headers):
- * gnus-art.el (gnus-treat-fold-headers):
- * gnus-art.el (gnus-treat-fold-newsgroups):
- * gnus-art.el (gnus-treat-overstrike):
- * gnus-art.el (gnus-treat-display-xface):
- * gnus-art.el (gnus-treat-display-smileys):
- * gnus-art.el (gnus-treat-from-picon):
- * gnus-art.el (gnus-treat-mail-picon):
- * gnus-art.el (gnus-treat-newsgroups-picon):
- * gnus-art.el (gnus-treat-body-boundary):
- * gnus-art.el (gnus-treat-capitalize-sentences):
- * gnus-art.el (gnus-treat-fill-long-lines):
- * gnus-art.el (gnus-treat-play-sounds):
- * gnus-art.el (gnus-treat-translate):
- * gnus-art.el (gnus-treat-x-pgp-sig):
- * gnus-art.el (gnus-mime-button-line-format):
- * gnus-art.el (gnus-button-man-level):
- * gnus-art.el (gnus-button-emacs-level):
- * gnus-cus.el (gnus-group-parameters):
- * gnus-gl.el (bbb-build-mid-scores-alist):
- * gnus-group.el (gnus-group-line-format):
- * gnus-mlspl.el (gnus-group-split-setup):
- * gnus-mlspl.el (gnus-group-split):
- * gnus-msg.el (gnus-mailing-list-groups):
- * gnus-msg.el (gnus-posting-styles):
- * gnus-nocem.el (gnus-nocem-issuers):
- * gnus-score.el (gnus-score-regexp-bad-p):
- * gnus-srvr.el (gnus-server-line-format):
- * gnus-topic.el (gnus-topic-line-format):
- * gnus.el (gnus-summary-line-format):
- * mail-source.el (mail-sources):
- * message.el (message-subscribed-address-file):
- * nnmail.el (nnmail-split-fancy):
-
-2002-09-24 Evgeny Roubinchtein <zhenya@freeshell.org>
-
- * mail-source.el(mail-source-run-script): use `functionp' to test
- whether the argument `script' is in fact a function.
- (mail-sources): adjust the defcustom to allow users to specify a
- function or a string as the value of the `:prescript' and
- `:postscript' arguments of the `file' and `pop3' mail sources.
-
-2002-09-25 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--grp-add-art): fix minimum article
- number when article 1 does not exist.
-
-2002-09-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-handle-apropos-variable): Fall back to
- apropos if apropos-variable does not exist.
- (gnus-button-guessed-mid-regexp)
- (gnus-button-handle-describe-prefix, gnus-button-alist): Better
- regexes.
- (gnus-button-handle-describe-function)
- (gnus-button-handle-describe-variable): Doc fix.
- (gnus-button-handle-describe-key, gnus-button-handle-apropos)
- (gnus-button-handle-apropos-command): Doc fix.
-
-2002-09-25 Mark A. Hershberger <mah@everybody.org> (tiny change)
-
- * nnrss.el (nnrss-save-server-data): Save nnrss-group-alist in
- the file.
-
-2002-09-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-1): Create nndraft:queue, nndraft:drafts.
-
-2002-09-24 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (top-level): Require mm-util for mm-make-temp-file.
- (mml2015-use): Prefer PGG if installed.
- (mml2015-function-alist): Add PGG wrappers.
- (mml2015-gpg-extract-signature-details): Check mml2015-use too.
- (mml2015-gpg-extract-signature-details): PGG strips "gpg: "
- prefix, make regexp optionally skip it.
- (mml2015-pgg-decrypt, mml2015-pgg-clear-decrypt)
- (mml2015-pgg-verify, mml2015-pgg-clear-verify, mml2015-pgg-sign)
- (mml2015-pgg-encrypt): New functions.
- (defvar, autoload): Prevent byte-compile warnings.
-
-2002-09-24 TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
-
- * gnus-art.el (article-strip-banner): Check for the existence of
- from header.
-
-2002-09-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-guessed-mid-regexp): Improved regexp.
- (gnus-button-alist): Improved regexp for
- gnus-button-handle-mid-or-mail (false positives), fixed
- gnus-button-handle-man entries.
-
-2002-09-23 Josh Huber <huber@alum.wpi.edu>
-
- * nnmaildir.el (nnmaildir--update-nov): fix wrong-type error when
- nnmail-extra-headers is non-nil.
-
-2002-09-23 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el: Store article numbers persistently. General
- revision.
- (nnmaildir-request-expire-articles): handle 'immediate and 'never
- for nnmail-expiry-wait; delete instead of moving if 'force is
- given.
-
-2002-09-23 Simon Josefsson <jas@extundo.com>
- Trivial fix from beaker@iavmb.pl (Krzysztof J\e,Bj\e(Bdruczyk).
-
- * smime.el (smime-sign-buffer): Get key and extra certs.
- (smime-get-key-with-certs-by-email): Utility function.
-
-2002-09-21 ShengHuo ZHU <zsh@cs.rochester.edu>
- Trivial patch from Micha Wiedenmann <mw-u1@gmx.de>
-
- * gnus-soup.el (gnus-soup-add-article): Mark as read only when the
- article exists.
-
-2002-09-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-next-group): Switch to the summary buffer.
-
-2002-09-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-handle-custom,
- gnus-button-handle-mid-or-mail,
- gnus-button-handle-describe-{function,variable,key},
- gnus-button-handle-apropos{,command,variable}): New functions.
- (gnus-button-prefer-mid-or-mail,gnus-button-guessed-mid-regexp,
- gnus-button-{man,emacs,mail}-level): New variables.
- (gnus-button-alist): Use the above to buttonize emacs and mail
- related links.
-
-2002-09-18 Juanma Barranquero <lektu@terra.es>
-
- * gnus-int.el (gnus-status-message): Fix spacing.
-
- * imap.el (imap-continuation): Fix typos.
-
-2002-09-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Sort results.
-
- * gnus-art.el (gnus-article-reply-with-original): Correct
- with-current-buffer scope.
-
- * message.el (message-completion-alist): Add Reply-To, From, etc.
-
-2002-09-18 Nevin Kapur <nevin@jhu.edu>
-
- * nnimap.el (nnimap-request-expire-articles): Make flag setting
- conditional.
-
-2002-09-17 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-expiry-target): Don't search for which
- articles exists here.
- (nnimap-request-expire-articles): Do it here instead. Only expire
- when articles are found. Suggested by Nevin Kapur
- <nevin@jhu.edu>.
-
-2002-09-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-strip-subject-trailing-was)
- (message-change-subject, message-add-archive-header)
- (message-xpost-fup2-header, message-xpost-insert-note)
- (message-xpost-fup2, message-reduce-to-to-cc): New functions
- adopted from message-utils.el. Add functions to the keymap, mode
- describtion and menu.
- (message-change-subject,message-xpost-fup2): Signal error if
- current header is empty.
- (message-xpost-insert-note): Changed insert position.
- (message-archive-note): Ensure to insert note in message body (not
- in head).
- (message-archive-header, message-archive-note)
- (message-xpost-default, message-xpost-note, message-fup2-note)
- (message-xpost-note-function): New variables adopted from
- message-utils.el. Changed some doc-strings.
- (message-mark-insert-{begin,end}): Rename from
- message-{begin,end}-inserted-text-mark (message-utils.el), changed
- values.
- (message-subject-trailing-was-query)
- (message-subject-trailing-was-ask-regexp)
- (message-subject-trailing-was-regexp): New variables.
- (message-to-list-only): Added doc-string and menu entry.
-
- * message-utils.el: Removed. Functions are now in message.el.
-
-2002-09-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-reply-with-original,
- gnus-article-followup-with-original): Switch to
- gnus-summary-buffer before reply/followup.
-
-2002-09-15 John Paul Wallington <jpw@shootybangbang.com>
-
- * gnus-sum.el (gnus-summary-toggle-header): The article window may
- not exist. Toggle it anyway.
-
-2002-09-13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-copy-article-buffer): Bind mail-header-separator.
-
- * gnus-art.el (article-fill-long-lines): Fill-paragraph properly.
- Trivial patch from Urban Engberg <ue@ccieurope.com>.
-
- * rfc2047.el (message-posting-charset): Defvar it.
- (rfc2047-charset-encoding-alist): Use B for iso-8859-7 and
- iso-8859-8. Fix doc. Suggested by Dave Love <fx@gnu.org>.
-
- * mail-source.el (mail-source-fetch): Hide password.
-
- * gnus-sum.el (gnus-summary-next-group): Semi-exit only when needed.
-
-2002-09-12 John Paul Wallington <jpw@shootybangbang.com>.
-
- * gnus.el (gnus-visual, gnus-meta): Fix typo.
-
-2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-address-banner-alist): Doc fix.
-
-2002-09-11 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-expiry-target): Only expiry-target existing articles.
- (nnimap-split-rule): Doc fix.
- (nnimap-request-expire-articles): Cleanup code.
-
-2002-09-11 TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
-
- * gnus-art.el (gnus-article-address-banner-alist): New option.
- (article-strip-banner): Refer the above option to split banners of
- free mail servers, when no group parameter is specified.
-
-2002-09-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-wait-for-string): Check for a process in the
- current buffer instead of `nntp-server-buffer'.
-
-2002-09-09 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-button-man-handler): New variable.
- (gnus-button-alist): Use g-b-handle-man.
- (gnus-button-handle-man): New, call g-b-man-handler.
-
-2002-09-08 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-button-alist): Buttonize man page links.
-
-2002-09-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-dumbquotes-map): Add \230.
-
-2002-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-browse-make-menu-bar): Add "d".
-
- * gnus-sum.el (gnus-summary-limit-to-unseen): New command and
- keystroke.
-
- * gnus-srvr.el (gnus-browse-describe-group): New command and
- keystroke.
-
-2002-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-treat-body-boundary): Don't quote a
- value for gnus-decoration property.
-
-2002-09-06 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-cache-fetch-group): Don't return "" (empty
- string) as group name in case we have a CRLF in the file.
-
-2002-09-04 Jesper Harder <harder@ifa.au.dk>
-
- * rfc1843.el (rfc1843-decode-loosely): Move to mime customization
- group.
- (rfc1843-decode-hzp): do.
- (rfc1843-newsgroups-regexp): do.
-
-2002-09-04 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-canlock-generate): Make sure sha1 doesn't
- call external programs.
-
-2002-09-03 Simon Josefsson <jas@extundo.com>
-
- * nntp.el (nntp-wait-for-string): Dont infloop if process died.
-
- * gnus-agent.el (gnus-agent-batch): Add doc.
-
-2002-09-03 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-msg.el (gnus-summary-handle-replysign): Change the order we
- check for signed and encrypted parts.
- * mml.el (mml-parse-1): Correct small typo which preventing
- setting recipients in a secure tag.
-
-2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-coding-system-priorities): Default to a list of
- iso-2022-jp and others for the Japanese environment.
-
-2002-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-frame-or-window-display-name): Exclude
- invalid display names.
-
-2002-08-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-group-fetch-control): Fix typo in last
- commit.
-
-2002-08-26 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-group-charter-alist): New option.
- (gnus-group-fetch-control-use-browse-url): New option.
-
- * gnus-group.el (gnus-group-fetch-charter): New function.
- (gnus-group-fetch-control): New function.
- Add them to the keymap and menu. Require mm-url.
-
-2002-08-30 Alex Schroeder <alex@emacswiki.org>.
-
- * gnus-mlspl.el (gnus-group-split-fancy): Doc fix.
-
-2002-08-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-group.el (gnus-group-make-menu-bar): Add ellipses to menu
- items expecting user interaction.
-
- * gnus-topic.el (gnus-topic-make-menu-bar): do.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): do.
-
- * gnus-srvr.el (gnus-server-make-menu-bar): do.
-
- * mml.el (mml-menu): do.
-
-2002-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-touch-pop): New function.
-
- * message.el (message-smtpmail-send-it): New function.
- (message-send-mail-function): Add it for a candidate.
-
-2002-08-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-msg.el (posting-charset-alist): Use
- gnus-define-group-parameter instead of defcustom.
- (gnus-put-message): Handle SPC in GCC.
- (gnus-inews-insert-gcc): Ditto.
- (gnus-inews-insert-archive-gcc): Ditto.
-
-2002-08-26 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-auto-agentize-methods): New variable.
- (gnus-agentize): Auto agentize all nntp and nnimap groups.
- (gnus-agent-possibly-save-gcc): Autoload.
- Suggested by (KOSEKI Yoshinori) <kose@meadowy.org>.
-
-2002-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-other-frame-function): New user option.
- (gnus-other-frame): Use it; add a doc-string; make it work with
- the gnuclient program.
-
- * gnus-util.el (gnus-frame-or-window-display-name): New function.
-
- * lpath.el: Fbind `frame-parameter', `make-frame-on-display',
- `device-connection' and `dfw-device'.
-
-2002-08-22 Jochen Hein <jochen@jochen.org> (tiny change)
-
- * gnus-art.el (gnus-emphasis-alist): Strikethru had a lot of false
- positives, make it stricter.
-
-2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-other-frame): Trivial fix.
-
-2002-08-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-other-frame-parameters): New user option.
- (gnus-other-frame-object): New variable.
- (gnus-other-frame): Make it search for existing Gnus frame; don't
- read new news; delete frame on exit.
-
- * gnus-util.el (gnus-select-frame-set-input-focus): New function.
-
- * lpath.el: Fbind w32-focus-frame and x-focus-frame.
-
-2002-08-20 \e$B>.4X\e(B \e$B5HB'\e(B (KOSEKI Yoshinori) <kose@meadowy.org>.
-
- * message.el (message-set-auto-save-file-name): Add support for
- the Cygwin Emacs; the system-type is `cygwin'.
- * nnheader.el (nnheader-file-name-translation-alist): Ditto.
-
-2002-08-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-button-url-regexp): Use POSIX regexp if possible.
-
- * nnmh.el (nnmh-request-list-1): Use %.0f instead of %d to
- avoid arithmetic errors.
-
-2002-08-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el: Don't fbind `gnus-article-replace-with-quoted-text'.
-
-2002-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-ignored-supersedes-headers): Add X-Hashcash.
- (message-ignored-resent-headers): Add envelope From.
-
-2002-08-18 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.el (gnus-summary-line-format): Document %k specifier.
-
-2002-08-17 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-summary-line-message-size): New function.
- (gnus-summary-line-format-alist): Use it.
-
-2002-08-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-make-date-line): Refer to the value for
- `gnus-article-time-format' in the summary buffer.
-
- * message.el (message-cite-prefix-regexp): Exclude ":" and "\e,A;\e(B".
-
-2002-08-14 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-button-alist): Use ' not ` for default value
- quoting.
- (gnus-button-alist): Fix doc.
- (gnus-header-button-alist): Use ' not ` for default value quoting.
- (gnus-header-button-alist): Don't inline gnus-button-url-regexp,
- rationale similar to 2002-05-01 change.
- (gnus-article-add-buttons-to-head): Evaluate expression.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add MIME button option.
-
-2002-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-font-lock-keywords): Refer to the value for
- `message-cite-prefix-regexp' dynamically.
-
-2002-08-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-decode-header-methods): Doc fix.
-
-2002-08-12 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-shell-open): Allow non-list `imap-shell-program'.
- (imap-shell-open): Skip initial junk before IMAP greeting.
-
-2002-08-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message-utils.el (message-xpost-default)
- (message-xpost-fup2-header, message-xpost-fup2): Fixed Typos.
-
-2002-08-09 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-canlock-password): Set
- canlock-password-for-verify to newly generated canlock-password.
- When Emacs is restarted, Custom makes sure this is set, but during
- the same session we must set it manually.
-
-2002-08-07 Jesper Harder <harder@ifa.au.dk>
-
- * yenc.el: New file.
-
- * mm-uu.el (mm-uu-yenc-decode-function): New variable.
- (mm-uu-type-alist): Add yenc.
- (mm-uu-yenc-filename): New function.
- (mm-uu-yenc-extract): New function.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Add yenc.
-
-2002-08-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (merge): Don't use coerce.
-
-2002-05-27 Jesper Harder <harder@ifa.au.dk>
-
- * mailcap.el (mailcap-mime-data): Test window-system rather than
- mm-device-type.
- (mailcap-mime-data): Call xdvi and gv with "-safer".
-
- * mm-util.el: Don't define mm-device-type.
-
-2002-08-05 Simon Josefsson <jas@extundo.com>
-
- * mm-util.el (mm-coding-system-priorities): coding-system type not
- supported everywhere.
-
-2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bumped version number.
-
-2002-08-04 01:48:57 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.07 is released.
-
-2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-thread-sort-functions): Doc fix.
- (gnus-article-sort-functions): Doc fix.
- (t): New keystroke.
- (gnus-article-sort-by-random): New function.
- (gnus-thread-sort-by-random): New function.
-
-2002-08-02 Scott A Crosby <scrosby@cs.rice.edu>
-
- * gnus-logic.el (gnus-advanced-integer): Swap arguments in
- funcall.
-
-2002-07-31 Danny Siu <dsiu@adobe.com>
-
- * nnimap.el (nnimap-split-articles): do not call nnmail-fetch-field
- when splitting malformed messages without message-id
-
-2002-07-28 Niklas Morberg <niklas.morberg@axis.com>.
-
- * nnweb.el (nnweb-type, nnweb-type-definition)
- (nnweb-gmane-create-mapping, nnweb-gmane-wash-article)
- (nnweb-gmane-search, nnweb-gmane-identity): Added gmane
- functionality.
- * nnweb.el: Removed old non-functioning search engines.
-
-2002-07-27 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-forward-make-body): Don't use
- `message-forward-ignored-headers' when doing a "raw" followup (it
- is important to preserve e.g. CTE).
-
- * flow-fill.el (fill-flowed): Disable filladapt-mode.
-
- * gnus-sieve.el (gnus-sieve-guess-rule-for-article): Don't
- regexp-quote, Cyrus Sieve is fixed.
-
- * sieve-manage.el (sieve-manage-deletescript): New function.
-
- * sieve.el (sieve-manage-mode-map): Fix down-mouse-2 and down-mouse-3.
- (sieve-manage-mode): Fix menubar.
- (sieve-activate): Change some messages.
- (sieve-deactivate-all): New function.
- (sieve-deactivate): New alias.
- (sieve-remove): New function.
- (sieve-help): Fix help.
- All suggested by Ned Ludd.
-
-2002-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-inline-text-html-with-images): Doc fix.
- (mm-w3m-safe-url-regexp): New user option.
-
- * mm-view.el (mm-inline-text-html-render-with-w3m): Use
- `mm-w3m-safe-url-regexp' to bind `w3m-safe-url-regexp'.
-
-2002-07-23 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-sum.el (gnus-summary-delete-article): Force
- nnmail-expiry-target to 'delete, so that absolute deletion
- happens when absolute deletion is requested.
-
-2002-07-21 Nevin Kapur <nevin@jhu.edu>.
-
- * nnmail.el (nnmail-fancy-expiry-target): Treat nonexisting
- headers as empty headers.
-
-2002-07-21 Jochen Hein <jochen@jochen.org>.
-
- * gnus-art.el (gnus-emphasis-alist): Add strikethrough and
- correct typo.
- (gnus-emphasis-strikethru): New face.
-
-2002-07-20 Jason Merrill <jason@redhat.com>.
-
- * nnfolder.el (nnfolder-retrieve-headers): Avoid searching the
- entire file for each of a sequence of missing articles.
-
- * gnus-salt.el (gnus-binary-display-article): Respect an existing
- value for gnus-view-pseudos.
-
- * gnus-sum.el (gnus-summary-insert-new-articles): Count down to
- avoid nreverse.
-
-2002-07-14 Ted Zlatanov <teodor.zlatanov@divine.com>
-
- * gnus-sum.el (gnus-auto-expirable-marks): Remove `spam'.
- (gnus-summary-mode-line-format-alist): Add %h for number of
- spams.
- (gnus-newsgroup-spam-marked): New variable.
- (gnus-summary-local-variables): Add gnus-newsgroup-spam-marked.
- (gnus-article-read-p, gnus-article-mark)
- (gnus-set-global-variables, gnus-set-global-variables)
- (gnus-article-marked-p, gnus-summary-mark-article-as-read)
- (gnus-summary-mark-article-as-unread)
- (gnus-summary-mark-article-as-unread, gnus-summary-mark-article)
- (gnus-mark-article-as-read, gnus-mark-article-as-unread)
- (gnus-mark-article-as-unread, gnus-summary-catchup): Grok spam.
-
-2002-07-10 KANEMATSU Daiji <kdaiji@bea.com>
-
- * nnimap.el (nnimap-split-to-groups): Allow group string to be a
- function.
-
-2002-07-09 Nevin Kapur <nevin@jhu.edu>
-
- * gnus-sum.el (gnus-summary-delete-article): Respect group
- parameters while expiring.
-
-2002-07-08 Henrik Enberg <henrik@enberg.org>
-
- * gnus-art.el (article-make-date-line): Fix string.
-
-2002-07-08 Niklas Morberg <niklas.morberg@axis.com>
-
- * gnus-art.el (article-unsplit-urls): Only display MIME when this
- function is called interactively.
-
-2002-07-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-indent, gnus-topic-unindent): Change
- cdaar to cdar and car.
-
- * nnsoup.el (nnsoup-retrieve-headers, nnsoup-request-type)
- (nnsoup-read-active-file, nnsoup-article-to-area): Ditto.
-
-2002-07-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-toggle-header): Show headers anyway;
- don't break a narrowed article.
-
- * nntp.el (nntp-via-rlogin-command-switches): Doc fix.
- (nntp-open-via-rlogin-and-telnet): Ditto.
-
-2002-07-02 Didier Verna <didier@xemacs.org>
-
- * nnmail.el (nnmail-split-methods): fix custom type.
-
-2002-07-02 Niklas Morberg <niklas.morberg@axis.com>
-
- * gnus-art.el (article-unsplit-urls): Keep URL buttonized after
- unsplitting.
-
-2002-07-01 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-msg.el (gnus-summary-resend-default-address): New user option.
- (gnus-summary-resend-message): Use it.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-via-rlogin-command-switches): New variable.
- (nntp-open-via-rlogin-and-telnet): Re-revert; use the var above.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-font-lock-keywords): Don't fontify
- headers in the message body, only in the header.
- (message-font-lock-make-header-matcher): New function, used by
- message-font-lock-keywords.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-open-via-rlogin-and-telnet): Revert last change.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-open-via-rlogin-and-telnet): Hide commandline args.
-
-2002-06-26 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-font-lock-keywords): Revert 2002-06-22
- change.
-
-2002-06-24 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-font-lock-keywords): Put colon in header
- name match.
-
-2002-06-22 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-font-lock-keywords): Don't use header faces
- in the body. Thanks to Stefan Monnier for the hint on the
- implementation.
-
-2002-05-09 Miles Bader <miles@gnu.org>
-
- * gnus-cite.el (gnus-cite-blank-line-after-header): New variable.
- (gnus-article-hide-citation): Respect it.
-
-2002-04-12 Juanma Barranquero <lektu@terra.es>
-
- * pop3.el (pop3-open-server): Fix typo.
-
-2002-06-18 Josh Huber <huber@alum.wpi.edu>
-
- * gnus.el (gnus-find-subscribed-addresses): Use add-to-list
- instead of push to ignore duplicate to-(list|address) values.
- * nnmail.el (nnmail-cache-ignore-groups): New.
- * nnmail.el (nnmail-cache-insert): Obey nnmail-cache-ignore-groups
-
-2002-06-18 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-send-queue): Delete the delay header
- before sending. Suggested by Jan Rychter.
-
-2002-06-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (remove): New compiler macro.
- (last, coerce, subseq): Remove compiler macros for those built-in
- or unused functions.
-
-2002-06-17 Simon Josefsson <jas@extundo.com>
-
- * gnus-start.el (gnus-clear-system, gnus-read-newsrc-file): Make
- sure to write byte-compiled versions of gnus-*-format-alist to
- .newsrc.eld.
-
-2002-06-16 Bj\e,Ax\e(Brn Mork <bmork@dod.no>
-
- * gnus-agent.el (gnus-agent-read-servers)
- (gnus-agent-write-servers): Put server name (string like
- "nnchoke:frumple") in the file instead of a server specification
- (Lisp expression like (nnchoke "frumple" ...parameters...)).
-
-2002-06-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-cache.el (gnus-cache-remove-article): n is &optional.
-
-2002-06-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-file-name-translation-alist): Set the
- default value for MS Windows systems.
-
- * gnus-ems.el (nnheader-file-name-translation-alist): Removed.
-
-2002-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-beginning-of-line): Keep the region active
- in XEmacs. Suggested by TAKAHASHI Kaoru <kaoru@kaisei.org>.
-
-2002-06-13 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-msg.el (gnus-summary-followup): Use g-s-handle-replysign.
- * gnus-msg.el (gnus-summary-reply): Ditto.
- * gnus-msg.el (gnus-summary-handle-replysign): New.
-
-2002-06-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-send-mail-with-sendmail): Kill errbuf even
- if sending failed.
-
-2002-06-11 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-start.el (gnus-dribble-enter): Don't call set-window-point anymore
- * mml2015.el (mml2015-mailcrypt-encrypt): Accept optional argument
- to sign while encrypting.
-
-2002-06-11 Simon Josefsson <jas@extundo.com>
-
- * gnus-int.el (gnus-request-move-article): Agent expire article if
- successfuly moved.
-
-2002-06-11 Niklas Morberg <niklas.morberg@axis.com>
-
- * nnweb.el (nnweb-google-create-mapping): Honors the value of
- nnweb-max-hits.
-
-2002-06-10 Simon Josefsson <jas@extundo.com>
-
- * gnus-int.el (gnus-request-expire-articles): Fix last change?
-
-2002-06-09 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-delete-article): Don't agent expire here.
-
- * gnus-int.el (gnus-request-expire-articles): Do it here instead.
-
-2002-06-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * flow-fill.el (fill-flowed): Ignore errors.
-
-2002-06-06 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-send-mail-with-sendmail): Improve error message.
-
-2002-06-06 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-interactive): Change default from nil to t.
- Better to be safe than to be fast.
-
-2002-06-05 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-send-mail-with-sendmail): Check return value
- from call-process-region.
-
-2002-06-04 Simon Josefsson <jas@extundo.com>
-
- * gnus-msg.el (gnus-group-mail, gnus-group-news)
- (gnus-group-post-news, gnus-summary-mail-other-window)
- (gnus-summary-news-other-window, gnus-summary-post-news): Bind
- gnus-article-copy to nil, thereby inhibiting the `header' posting
- style match to use data from last viewed article.
- Suggested by Hrvoje Niksic.
-
-2002-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * spam.el (spam-point-at-eol): New alias.
- (spam-parse-whitelist): Use it.
-
-2002-06-03 Simon Josefsson <jas@extundo.com>
-
- * nnmail.el (nnmail-mail-splitting-decodes): New variable.
- (nnmail-article-group): Use it.
-
-2002-05-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-inews-yank-articles): Merge split header lines
- so that code reading them won't be surprised.
-
-2002-05-29 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-delete-article): Agent expire deleted
- articles.
-
- * gnus.el (gnus-agent-cache): Doc fix.
- (gnus-agent): Change default to t.
-
- * gnus-agent.el (gnus-agent-expire): Make it accept optional
- ARTICLES, GROUP and FORCE parameters.
-
-2002-05-28 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-line-format): Doc fix.
-
-2002-05-28 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-inews-yank-articles): Unfold headers of
- original article before yanking.
-
-2002-05-26 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-menu-split): New function.
- (gnus-summary-make-menu-bar): Split charset submenu.
- (gnus-summary-menu-maxlen): New variable.
- (gnus-summary-menu-split): Use it.
-
-2002-05-25 Simon Josefsson <jas@extundo.com>
-
- * mml.el (mml-preview): Generate some headers.
-
- * gnus.el (gnus-large-newsgroup): Fix :type.
-
- * nnimap.el (nnimap-nov-is-evil): Change default to t (because the
- Agent cache NOV's by default now).
- (nnimap-nov-is-evil): Make it default to `gnus-agent' instead.
-
-2002-05-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-dependencies-add-header): Avoid one unecessary
- call to gnus-parent-id when we check for References loops.
- (gnus-summary-prepare-threads): Avoid simplifying every Subject
- twice by saving the simplified subject string in simp-subject.
-
-2002-05-23 Benjamin Rutt <rutt+news@cis.ohio-state.edu> (tiny change)
-
- * gnus-msg.el (gnus-confirm-mail-reply-to-news): Typo.
-
-2002-05-23 Niklas Morberg <niklas.morberg@axis.com> (tiny change)
-
- * nnweb.el (nnweb-type): Remove dejanewsold.
-
-2002-05-22 Simon Josefsson <jas@extundo.com>
-
- * sieve.el (sieve-change-region): Define it before it is used.
-
-2002-05-22 Benjamin Rutt <rutt+news@cis.ohio-state.edu>
-
- * gnus-msg.el (gnus-confirm-mail-reply-to-news)
- (gnus-summary-reply): Ask for confirmation when replying to news.
- Defaults to not ask.
-
- * nnimap.el (nnimap-nov-is-evil): Improve doc.
-
-2002-05-21 Simon Josefsson <jas@extundo.com>
-
- * sieve-mode.el (sieve-manage): Fix autoloads.
-
- * sieve-manage.el (sieve-manage-cram-md5-auth): Just send the SASL
- name (makes it work with recent Cyrus timsieved).
-
-2002-05-20 Jason <jbaker@cs.utah.edu>
- Trivial patch.
-
- * gnus-art.el (gnus-request-article-this-buffer): Try
- reconnecting if you don't get the message.
-
-2002-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Only get
- Reply-To headers from the headers.
-
-2002-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-url.el (mm-url-insert): Remove junk message.
-
-2002-05-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-list): Parse new html.
- (nnslashdot-use-front-page): New variable.
- (nnslashdot-request-list): Use it.
-
- * mm-url.el (mm-url-timeout): New variable.
- (mm-url-retries): Ditto.
- (mm-url-insert): Use it.
-
-2002-05-16 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-simplify-all-whitespace): New function.
- (gnus-simplify-subject-functions): Mention g-s-a-w.
-
-2002-05-15 Josh Huber <huber@alum.wpi.edu>
-
- * nnbabyl.el (nnbabyl-request-accept-article): Pass group to
- nnmail-cache-insert.
- * nndiary.el (nndiary-request-accept-article): Ditto.
- * nnfolder.el (nnfolder-request-accept-article): Ditto.
- * nnimap.el (nnimap-request-accept-article): Ditto.
- * nnmail.el (nnmail-process-unix-mail-format): Ditto.
- * nnmail.el (nnmail-check-duplication): Ditto. (from gnus-art)
- * nnmbox.el (nnmbox-request-accept-article): Ditto.
- * nnmh.el (nnmh-request-accept-article): Ditto.
- * nnmail.el (nnmail-cache-insert): Change group to required,
- removed code which tried to figure out the group.
-
-2002-05-13 Hans de Graaff <hans@degraaff.org>
-
- * mml.el (mml-generate-mime-1): Fix mml generation for signed only
- messages.
-
-2002-05-13 Josh Huber <huber@alum.wpi.edu>
-
- * nnml.el (nnml-request-accept-article): Pass in the group name to
- nnmail-cache-insert, since it's available.
-
-2002-05-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-mime-digest-type-p): Set proper file-end.
-
-2002-05-08 Florian Weimer <fw@deneb.enyo.de>
-
- * gnus.el (subscribed): New group parameter.
- (gnus-find-subscribed-addresses): Use it.
-
-2002-05-08 Josh Huber <huber@alum.wpi.edu>
-
- * mml-sec.el (mml-signencrypt-style-alist): Rename. Also, changed
- the default for pgpmime to support pgp v2.
- * mml-sec.el (mml-signencrypt-style): New accessor function to
- allow users to get/set the signencrypt style more easily without
- frobbing the alist directly.
- * mml.el (mml-generate-mime-1): Use accessor function.
-
-2002-05-08 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-art.el (gnus-article-mode-syntax-table): Specify matching
- parenthesis for "<" and ">". Suggested by Andreas Schwab
- <schwab@suse.de>.
-
-2002-05-07 Josh Huber <huber@alum.wpi.edu>
-
- * nnmail.el (nnmail-cache-insert): Prefer group-art over group
- when intuiting the group the message is written to.
-
-2002-05-06 Matt Armstrong <matt@lickey.com>
-
- * gnus-topic.el (gnus-group-topic-parameters): Work when group
- buffer doesn't show group.
-
-2002-05-06 Josh Huber <huber@alum.wpi.edu>
-
- * mml2015.el (mml2015-gpg-encrypt): Changed name of optional
- argument, and fixed compiler warning. (added autoload for
- gpg-encrypt).
-
-2002-05-04 Simon Josefsson <jas@extundo.com>
-
- * mml1991.el (mml1991-function-alist): Doc fix.
-
- * mml.el (mml-preview): Bind gnus-newsrc-hashtb temporarily if it
- doesn't exist (for previewing messages without having Gnus
- started).
-
- * mm-util.el (mm-coding-system-priorities): Defcustom.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Defcustom.
-
-2002-05-01 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-msg.el (gnus-message-replysignencrypted): enabled by
- default.
- * mml-sec.el:
- * mml-sec.el (mml-signencrypt-style): New.
- * mml-sec.el (mml-pgpmime-encrypt-buffer): Accept optional
- argument `sign'.
- * mml-sec.el (mml-secure-message-encrypt-pgp): Changed default to
- signencrypt.
- * mml-sec.el (mml-secure-message-encrypt-pgpmime): Ditto.
- * mml.el (mml-generate-mime-1): Changed logic so a part which is
- both signed & encryped is processed in one operation. (rather than
- two separate ops: sign, then encrypt)
- * mml2015.el (mml2015-gpg-extract-signature-details): Give some
- indication if a message is signed by an expired key.
- * mml2015.el (mml2015-gpg-encrypt): Accept optional argument which
- enables combined sign & encrypt operation. (this was always on
- before).
- * mml2015.el (mml2015-encrypt): Accept optional argument `sign'.
-
-2002-05-01 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-retrieve-groups): Use separate data for each
- server.
- (nnimap-mailbox-info): defvar instead of defvoo.
-
-2002-05-01 20:09:21 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.06 is released.
-
-2002-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * lpath.el: Bind url-package-version.
-
-2002-05-01 Simon Josefsson <jas@extundo.com>
-
- * nnfolder.el (nnfolder-request-delete-group): Figure out nov/mrk
- filename before deleting the group itself, because the presence of
- a group filename decides if long filenames are used or not.
-
- * gnus-art.el (gnus-button-alist): Don't inline
- gnus-button-url-regexp. This makes it possible to change g-b-u-r
- without also modifying g-button-alist.
- (gnus-button-alist): Fix type to allow variable as well as regexp.
- (gnus-article-add-buttons): Evaluate regexp. Strings evaluate to
- themselves, variables to its contents.
- (gnus-button-entry): Ditto.
-
-2002-05-01 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-parse-resp-text-code, imap-parse-status): Treat
- UIDNEXT as a string.
-
- * nnimap.el (nnimap-string-lessp-numerical): New function.
- (nnimap-retrieve-groups): Compare UIDNEXT as strings instead of
- integers.
-
-2002-04-29 Simon Josefsson <jas@extundo.com>
-
- * nnmail.el (nnmail-cache-insert): Accept optional group
- parameter.
-
- * nnimap.el (nnimap-retrieve-groups): Don't send STATUS when
- n-r-g-a is disabled.
-
-2002-04-29 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-split-fancy): Fix doc.
- (nnimap-split-fancy): Fix doc.
-
- * nnimap.el (nnimap-retrieve-groups-asynchronous): New variable.
- (nnimap-mailbox-info): New internal variable.
- (nnimap-retrieve-groups): Implement faster new mail check.
-
- * nnimap.el (nnimap-split-articles): Support
- nnmail-cache-accepted-message-ids.
- (nnimap-request-accept-article): Ditto.
-
- * imap.el (imap-mailbox-status-asynch): New command.
-
-2002-04-29 Nevin Kapur <nevin@jhu.edu>
-
- * gnus.el (gnus-find-subscribed-addresses): Return nil when there
- are no subscribed mail groups.
- - Strip quoted names when comparing addresses
-
-2002-04-28 Jesper Harder <harder@ifa.au.dk>
-
- * mm-decode.el (mm-text-html-renderer): Change customize type to
- const.
-
- * gnus-msg.el (gnus-discouraged-post-methods): Fix typo.
- (gnus-debug-exclude-variables): do.
-
-2002-04-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-article-mail): Use gnus-msg-mail instead.
- Trivial change from Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>.
-
-2002-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dns.el (dns-make-network-process): New macro.
- (query-dns): Use it.
-
-2002-04-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-reply): Remove unbound variable
- article-buffer.
-
- * mm-url.el (mm-url-package-name): New variable.
- (mm-url-package-version): New variable.
- (mm-url-insert-file-contents): Bind url-package-name and
- url-package-version here.
- * nnrss.el (nnrss-insert-w3): Move the bindings.
-
- * nnrss.el (nnrss-insert-w3): Bind url-package-name and
- url-package-version. Trivial change from Andrew J Cosgriff
- <ajc@polydistortion.net>
-
- * mm-decode.el (mm-save-part): Fill in file name when GUI saving
- attachments. Trivial change from Peter 'Luna' Runestig
- <peter@runestig.com>.
-
-2002-04-19 Jesper Harder <harder@ifa.au.dk>
-
- * nnkiboze.el (nnkiboze-request-scan): Call
- nnkiboze-possibly-change-group.
- (nnkiboze-generate-group): Use mm-with-unibyte to avoid encoding
- problems.
- (nnkiboze-generate-group): Set newsrc to the *highest* article
- number kibozed, not the lowest.
-
-2002-04-15 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-art.el (article-unsplit-urls): Allow trailing SPC.
-
-2002-04-24 Dan Christensen <jdc+news@uwo.ca>
-
- * nndoc.el (nndoc-type-alist, nndoc-lanl-gov-announce-type-p)
- (nndoc-transform-lanl-gov-announce, nndoc-generate-lanl-gov-head):
- Recognize math postings. Extract Date (now ignores "(15kb)").
- Extract email address using gnus-extract-address-components
- instead of just taking the first word. Create Date and From
- headers for message which are missing these headers. Get rid
- of spurious \\ lines (purely cosmetic). Extend body-end and
- file-end regexps, to exclude more garbage from the message.
- Make URL rephrasing regexp more flexible, to match current
- format.
-
-2002-04-23 Simon Josefsson <jas@extundo.com>
-
- * netrc.el: New file, functions copied from gnus-util.el by Ted
- Zlatanov <tzz@lifelogs.com>.
-
- * gnus-util.el: Require netrc.
- (gnus-netrc-get, gnus-netrc-machine, gnus-parse-netrc): Aliased to
- new code in netrc.el.
-
-2002-04-23 Matthieu Moy <Matthieu.Moy@imag.fr>
-
- * gnus-msg.el (gnus-summary-resend-message-edit): Remove
- message-ignored-resent-headers, too.
-
-2002-04-22 Bj\e,Av\e(Brn Torkelsson <torkel@acc.umu.se>
-
- * gnus-srvr.el (gnus-server-browse-in-group-buffer): it is a
- boolean not a string
- * gnus-group.el (gnus-group-line-format): add description of %C
- * gnus-group.el (gnus-group-line-format-alist): add gnus-tmp-comment
- as %C
- * gnus-group.el (gnus-group-insert-group-line): add gnus-tmp-comment
-
-2002-04-22 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-scan): typo: set
- nnmaildir-get-new-mail, not nnmaildir-new-mail. Don't call
- nnmail-get-new-mail for 'find-new-groups.
-
-2002-04-21 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-update-info,
- nnmaildir-request-group, nnmaildir-retrieve-groups): remove
- unnecessary calls to nnmaildir-request-scan.
-
-2002-04-20 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-msg.el:
- * gnus-msg.el (gnus-message-replysign): New.
- * gnus-msg.el (gnus-message-replyencrypt): New.
- * gnus-msg.el (gnus-message-replysignencrypted): New.
- * gnus-msg.el (gnus-summary-reply): Use the three new variables
- (above) to automatically encrypt/sign to encrypted/signed
- messages.
- * message.el:
- * message.el (message-mode-map): Add keybinding for
- `message-to-list-only'
- * message.el (message-mode): Add description for
- `message-to-list-only'
- * message.el (message-to-list-only): New.
- * message.el (message-make-mft): Changed to use the cl loop macro,
- and added optional flag to return only the matched list. (for use
- in new message-to-list-only function)
-
-2002-04-20 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-msg.el:
- * gnus-msg.el (gnus-message-replysign):
- * gnus-msg.el (gnus-replysign): New.
- * gnus-msg.el (gnus-replyencrypt): New.
- * gnus-msg.el (gnus-replysignencrypted): New.
- * gnus-msg.el (gnus-summary-reply):
- * message.el:
- * message.el (message-mode-map):
- * message.el (message-mode):
- * message.el (message-to-list-only): New.
- * message.el (message-make-mft):
-
-2002-04-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-windows-hook): Fix typo.
-
-2002-04-18 Josh Huber <huber@alum.wpi.edu>
-
- * message.el (message-gen-unsubscribed-mft): accept a prefix
- argument so CC can be included with C-u C-c C-f C-a
-
-2002-04-17 Ted Zlatanov <teodor.zlatanov@divine.com>
-
- * spam.el (spam-whitelist, spam-blacklist, spam-enter-whitelist):
- Improve docstring.
- (spam-enter-blacklist): New command.
-
- * gnus-sum.el (gnus-spam-mark): New mark.
- (gnus-auto-expirable-marks): Add gnus-spam-mark.
- (gnus-summary-make-tool-bar): Correct conditional.
- (gnus-summary-limit-to-unread): Add gnus-spam-mark.
- (gnus-summary-mark-as-spam): New command.
-
-2002-04-13 Josh Huber <huber@alum.wpi.edu>
-
- * mml-sec.el (mml-secure-message): changed to support arbritrary
- modes.
- * mml-sec.el (mml-secure-message-encrypt-(smime|pgp|pgpmime)):
- changed to support "signencrypt" mode.
- * mml.el (mml-parse-1): changed to support different secure modes
- more easily. (for signencrypt)
-
-2002-04-11 Stefan Monnier <monnier@cs.yale.edu>
-
- * gnus-sum.el (gnus-update-summary-mark-positions)
- (gnus-summary-toggle-header):
- * gnus-uu.el (gnus-uu-binhex-article, gnus-uu-reginize-string)
- (gnus-uu-expand-numbers, gnus-uu-post-make-mime)
- (gnus-uu-post-encoded):
- * nnfolder.el (nnfolder-possibly-change-group):
- * nnimap.el (nnimap-retrieve-headers):
- * nnmbox.el (nnmbox-create-mbox): Don't assume point-min == 1.
-
-2002-04-08 Stefan Monnier <monnier@cs.yale.edu>
-
- * nnml.el (nnml-save-nov, nnml-generate-nov-file):
- * pop3.el (pop3-md5): Don't hardcode point-min == 1.
-
-2002-04-12 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-srvr.el (gnus-server-set-info): Clear
- `gnus-server-method-cache' when `gnus-server-alist' is changed.
-
-2002-04-11 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): Force
- viewing of security buttons. Thanks to Nicolas Kowalski
- <Nicolas.Kowalski@imag.fr>.
-
- * smime.el (smime-CA-directory): Fix doc. Thanks to Arne
- J
\e,Ax
\e(Brgensen <arne+usenet@daimi.au.dk>.
- (smime-sign-buffer): Work in XEmacs. Thanks to Nicolas Kowalski
- <Nicolas.Kowalski@imag.fr>.
- (smime-decrypt-buffer): Ditto.
-
-2002-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-prepare): Place point on the emtpy
- header line.
-
-2002-04-11 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-refer-article-method): Change `dejanews' to `google'.
-
-2002-04-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-delete-marked-with): Fix typo.
-
-2002-04-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text-html-render-with-w3): Don't ignore
- errors when debug.
-
-2002-04-07 Josh Huber <huber@alum.wpi.edu>
-
- * message.el (message-make-mft): Changed MFT code from using
- message-recipients (which included Bcc) to use only the To and CC
- headers.
-
-2002-04-05 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-treat-from-picon): Add to gnus-picon group and
- add link.
- (gnus-treat-mail-picon): Ditto.
- (gnus-treat-newsgroups-picon): Ditto.
- (gnus-picon-databases): Fix custom type.
- (gnus-picon-databases): Add link.
- (gnus-article-x-face-command): Add to gnus-picon group.
-
-2002-04-01 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-buffer-naming-style): Remove.
-
-2002-04-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-make-tool-bar): Load tool-bar first.
-
- * message.el (message-tool-bar-map): Ditto.
-
- * gnus-sum.el (gnus-summary-make-tool-bar): Ditto.
-
-2002-04-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-mail-archive-article): Fix typo.
-
-2002-04-01 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el: fixed some buggy invocations of nnmaildir--pgname.
-
-2002-03-31 Andrew Cohen <cohen@andy.bu.edu>
- Trivial patch.
-
- * dns.el: open-network-stream under XEmacs does udp.
-
-2002-03-31 Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
-
- * spam.el (spam-enter-whitelist): New function.
- (spam-parse-whitelist): Ditto.
- (spam-refresh-list-cache): Ditto.
- (spam-address-whitelisted-p): New function.
-
- * dns.el (query-dns): Use TCP when make-network-process isn't
- available.
- (dns-servers): New variable.
- (dns-parse-resolv-conf): New function.
- (query-dns): Use it.
-
- * spam.el: New file.
-
- * dns.el (query-dns): Test.
-
-2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * lpath.el (featurep): Bind make-network-process.
-
-2002-03-31 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el: Use defstruct. Use a single copy of
- nnmail-extra-headers to save memory. Store server's group name
- prefix instead of each group's prefixed name.
- * nnnil.el (nnnil-retrieve-headers, nnnil-request-list): Erase
- nntp-server-buffer.
-
-2002-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dns.el: New file.
-
-2002-03-28 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-dummy-line-format):
- * gnus.el (gnus-summary-line-format): Fixing links to Info.
- Trivial change from Bj\e,Av\e(Brn Torkelsson <torkel@pdc.kth.se>.
-
-2002-03-29 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-summary-move-article)
- (gnus-summary-copy-article): Mention `gnus-move-split-methods' in
- the doc string.
-
-2002-03-28 Simon Josefsson <jas@extundo.com>
-
- * mml-sec.el (mml-secure-message): Search after
- mail-header-separator from top of message.
-
-2002-03-28 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el: Cosmetic changes.
- (nnmaildir--with-nntp-buffer, nnmaildir--with-work-buffer,
- nnmaildir--with-nov-buffer, nnmaildir--with-move-buffer,
- nnmaildir--group-ls): New macros/functions. Use them.
- (nnmaildir--unlink): Evalutate argument only once.
-
-2002-03-27 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-summary-highlight): Use `eq' when comparing
- symbols.
- (gnus-summary-highlight-line): Use `gnus-point-at-bol' and
- `gnus-point-at-eol'.
-
-2002-03-27 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--subdir, nnmaildir--nov-dir,
- nnmaildir--marks-dir): New macros. Use them.
- Use inhibit-quit for atomicity instead of in-memory journaling.
- (nnmaildir--edit-prep): New function.
- (Local Variables): Use it.
-
-2002-03-26 Pavel@Janik.cz (Pavel Jan\e,Am\e(Bk)
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Fix typo.
-
-2002-03-25 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-mode): Fix doc.
-
-2002-03-25 Matthieu Moy <Matthieu.Moy@imag.fr>
-
- * message.el (message-subject-re-regexp): Skip Re[42]: junk.
-
-2002-03-24 Jesper Harder <harder@ifa.au.dk>
-
- * mml-sec.el (mml-unsecure-message): Add docstring.
-
-2002-03-23 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
-
- * nnmail.el (nnmail-large-newsgroup): Fix doc, allow non-numeric
- value.
-
-2002-03-22 Josh Huber <huber@alum.wpi.edu>
-
- * mml.el (mml-mode-map): Added a keybinding for
- `mml-unsecure-message'. Also, added a menu entry for said
- function in the Attachments menu.
-
-2002-03-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-version): Remove.
- (canlock-sha1-with-openssl): Don't use `canlock-string-as-unibyte'
- here; simplify \x insertions.
- (canlock-sha1): New function, always return a unibyte string.
- (canlock-make-cancel-key): Use `canlock-sha1'; simplify truncation
- of a password.
- (canlock-insert-header): Use `canlock-sha1'.
- (canlock-verify): Ditto.
-
-2002-03-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-fix-before-sending): Add an option that
- ignores illegible text.
- Trivial change from Mark Milhollan <mlm@attglobal.net>
-
- * message.el (message-font-lock-keywords): Support multi-line MML
- tags.
-
-2002-03-21 L\e,Bu\e(Brentey K\e,Ba\e(Broly <lorentey@elte.hu>
-
- * gnus-sum.el (gnus-print-buffer): Remove gnus-decoration.
-
-2002-03-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Use intern'ed function
- symbols for "View as different encoding" submenu.
-
-2002-03-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add "View as different
- encoding" submenu.
-
-2002-03-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-process-prefix): Make sure there is a mark.
-
-2002-03-19 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-sum-thread-tree-root)
- (gnus-sum-thread-tree-single-indent)
- (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
- (gnus-sum-thread-tree-leaf-with-other)
- (gnus-sum-thread-tree-single-leaf): Make customizable.
-
-2002-03-16 Francis Litterio <franl@world.std.com>
-
- * gnus-util.el (gnus-extract-address-components): Don't break on
- names such as James "Kibo" Parry.
-
-2002-03-13 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * pop3.el (pop3-open-server): Revert multibyte change.
-
- * message.el (message-send-mail-with-qmail): Make it work.
-
-2002-03-13 Josh Huber <huber@alum.wpi.edu>
-
- * message.el (message-make-mft): Set case-fold-search while
- generating the MFT. Also, a little cleanup in the MFT code.
-
-2002-03-12 Faried Nawaz <fn@hungry.org> (tiny change)
-
- * message.el (message-qmail-inject-args): May be function. Adjust
- doc string and custom type.
- (message-send-mail-with-qmail): Call function if m-q-i-a is a
- function.
-
-2002-03-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-abbrevs-loaded): Remove.
- (mailabbrev): Require it.
-
- * nnslashdot.el (nnslashdot-request-article): Remove IFRAME.
-
-2002-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * pop3.el (pop3-open-server): Set process buffer unibyte.
-
-2002-03-10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-subscribe-to-mailing-list): New function.
-
-2002-03-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-request-article): Remove javascript
- too.
-
-2002-03-09 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
-
- * gnus-sum.el (gnus-summary-save-parts-default-mime): Remove
- duplication.
- (gnus-summary-save-parts-type-history): Ditto.
- (gnus-summary-save-parts-last-directory): Ditto.
-
-2002-03-09 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-start.el (gnus-auto-subscribed-groups): Include nnmaildir.
-
-2002-03-06 Matthieu Moy <Matthieu.Moy@imag.fr>
-
- * gnus-msg.el (gnus-summary-resend-message-edit): New function.
-
-2002-03-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-request-article): Use "<!-- no ad 6
- -->" as the end of the first article.
-
- * message.el (message-add-action): Use add-to-list.
- (message-delete-action): New function.
-
- * nndoc.el (nndoc-mail-in-mail-type-p): Break a long regexp into
- pieces.
-
-2002-03-05 Paul Jarc <prj@po.cwru.edu>
-
- * nnnil.el: New file.
- * gnus.el (gnus-valid-select-methods): Include nnnil.
-
-2002-03-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-syntax-checks): Because canlock is
- supported, we disable sender syntax check.
- (message-shoot-gnksa-feet): Add cancel-messages option doc.
-
- * gnus-draft.el (gnus-draft-send): If interactive, use its default
- value of message-syntax-checks.
-
- * qp.el (quoted-printable-decode-region): Doc addition.
- From: Eli Zaretskii <eliz@is.elta.co.il>
-
- * mail-source.el (make-source-make-complex-temp-name): Use
- make-temp-file.
-
- * mm-util.el (mm-make-temp-file): New function.
- * nneething.el (nneething-file-name): Use it.
- * mml-smime.el (mml-smime-encrypt): Ditto.
- * mm-view.el (mm-inline-wash-with-file): Ditto.
- * mm-decode.el (mm-display-external, mm-create-image-xemacs): Ditto.
- * gnus-uu.el (gnus-uu-decode-binhex, gnus-uu-decode-binhex-view)
- (gnus-uu-digest-mail-forward, gnus-uu-initialize): Ditto.
- * gnus-start.el (gnus-slave-save-newsrc): Ditto.
- * gnus-fun.el (gnus-convert-image-to-gray-x-face): Ditto.
- * gnus-art.el (gnus-mime-print-part): Ditto.
-
-2002-03-04 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (nnmaildir-article-number-to-base-name): New
- function.
- (nnmaildir-base-name-to-article-number): New function.
-
-2002-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * smime.el (smime-make-temp-file): Don't quote
- `temporary-file-directory'.
-
-2002-03-04 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-sign-region): Rename argument keyfiles to
- keyfile. You only sign something with one key.
- (smime-sign-buffer): Better completing-read prompt.
- (smime-decrypt-buffer): Ditto.
-
- * smime.el (smime-make-temp-file): Make it work under XEmacs.
-
- * mm-view.el (mm-view-pkcs7-decrypt): Better prompt for
- completing-read.
- (mm-view-pkcs7-decrypt): CRLF->LF.
-
-2002-03-04 Teodor Zlatanov <teodor.zlatanov@divine.com>
-
- * message.el (message-hierarchical-addresses): New variable.
- (message-get-reply-headers): Use it.
-
-2002-03-03 Geoff Greene <ggreene@wpi.edu> (tiny change)
-
- * message.el (message-mode): If buffer-file-name, don't set auto
- save file name.
-
-2002-03-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-multiple-choice): Use message. XEmacs only
- takes one argument in read-char.
-
- * message.el (message-fix-before-sending): Forward a char.
- Check mmu-multibyte-p, add control-1.
-
-2002-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-read-init-file): Ditto.
-
- * gnus-agent.el (gnus-agent-fetch-session): Ditto.
-
- * dgnushack.el (dgnushack-make-load): Ditto.
-
- * mail-source.el (mail-source-fetch): Extract the right error
- code.
-
- * message.el (message-fix-before-sending): Check illegible text.
-
- * gnus-util.el (gnus-multiple-choice): New function.
-
- * gnus-kill.el (gnus-score-insert-help): Removed, because it is
- also defined in gnus-score.el.
-
-2002-03-01 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-get-reply-headers): downcase email addresses
- for comaparisons for duplicate removal.
-
-2002-03-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-view-pkcs7-verify): New function. A bogus
- implementation of PKCS#7, which just allows users read the
- message.
- (mm-view-pkcs7): Use it.
-
-2002-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (large-newsgroup-initial): New parameter.
-
- * gnus-sum.el (gnus-articles-to-read): Use large-newsgroup-initial.
- (gnus-summary-insert-old-articles): Ditto.
-
-2002-02-26 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-sum.el (gnus-articles-to-read): `gnus-large-newsgroup' is
- used as the default answer of the question, "How many articles?".
-
-2002-02-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnagent.el (nnagent-retrieve-headers): Remove articles with
- small numbers.
-
-2002-02-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * deuglify.el: Fix comments.
-
-2002-02-23 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
-
- * mml.el (mml-generate-mime-1): Add cdr.
-
-2002-02-23 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * html2text.el (html2text-clean-anchor): If there is no HREF,
- insert nothing.
-
- * mm-view.el (mm-text-html-renderer-alist): Add html2text.
- (mm-text-html-washer-alist): Ditto.
-
- * mm-decode.el (mm-text-html-renderer): Add html2text.
-
- * html2text.el: Face lift.
-
- * html2text.el: New file from Joakim Hove <hove@phys.ntnu.no>.
-
-2002-02-22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el: Add gnus-article-outlook-deuglify-article.
-
- * deuglify.el: Change copy right. Add autoload. Add coding-system.
-
-2002-02-22 Raymond Scholz <rscholz@zonix.de>
-
- * deuglify.el: New file. The original file name is
- gnus-outlook-deuglify.el.
-
-2002-02-22 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
-
- * mm-decode.el (mm-display-external): Use
- mm-file-name-rewrite-functions.
-
-2002-02-22 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-list): Report the highest
- article number, not the total number of articles.
-
-2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el: Move uu key map here.
- (gnus-summary-make-menu-bar): Add gnus-summary-save-parts.
-
-2002-02-21 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-expire-articles): Use
- nnmail-expiry-wait* if expire-age parameter is not set.
-
-2002-02-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-sort-groups-by-real-name): New
- function.
- (gnus-group-sort-selected-groups-by-real-name): New function.
- (gnus-group-make-menu-bar): Add sort by real name.
-
- * gnus-sum.el (gnus-dependencies-add-header): If replaced, don't
- rebuild.
- (gnus-summary-edit-article-done): Gnus-get-newsgroup-headers takes
- nil as dependencies as well.
-
-2002-02-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-dissect-mime-parts-sub): Fix MIME-Version header
- for mime-parts.
-
- * gnus-art.el (gnus-article-edit-done): Widen the buffer.
-
- * message.el (message-send-mail): Be talkative.
-
-2002-02-20 TSUCHIYA Masatoshi <tsuchiya@pine.kuee.kyoto-u.ac.jp>
-
- * gnus-group.el (gnus-group-name-decode): Don't test
- multibyte-string, because it breaks XEmacs.
-
-2002-02-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-decode.el (mm-inlined-types): Add application/x-emacs-lisp.
- (mm-automatic-display): Ditto.
-
- * mailcap.el (mailcap-mime-data): Ditto.
-
-2002-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * many files: Remove trailing whitespaces, replace spc+tab with
- tab, replace leading whitespaces with tabs.
-
-2002-02-19 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-sum.el (gnus-summary-toggle-header): Fix handling of
- articles with no body and no blank line after the header.
-
-2002-02-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Consider the case of empty
- parts.
-
- * ietf-drums.el (ietf-drums-syntax-table): Modify syntax of
- non-ascii chars.
-
- * rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
-
- * gnus-art.el (gnus-article-wash-html-with-w3): Remove
- w3-delay-image-loads.
- * mm-view.el (mm-inline-text-html-render-with-w3): Ditto.
- (mm-w3-prepare-buffer): Ditto.
-
- * mail-source.el (mail-source-fetch-directory): Run scripts.
-
-2002-02-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-respond-to-confirmation): Do the right thing
- for Majordomo confirmations.
-
-2002-02-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-respond-to-confirmation): New command.
-
-2002-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Clean up.
-
-2002-02-18 Mark Thomas <mthomas@cmu.edu>
-
- * gnus-util.el (gnus-parent-id): Ignore trailing whitespace in the
- References header field.
-
-2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-render-with-file): With unibyte buffer.
- (mm-inline-render-with-stdin): Ditto.
- (mm-inline-render-with-function): Ditto.
- (mm-inline-wash-with-file): Bind coding-system-for-write.
- (mm-inline-wash-with-stdin): Ditto.
-
-2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Suggested by Felix Natter <fnatter@gmx.net>
-
- * gnus-art.el (gnus-mime-view-part-externally): Rename from
- gnus-mime-externalize-view.
- (gnus-mime-view-part-internally): Rename from
- gnus-mime-internalize-view.
- (gnus-article-view-part-externally): Rename from
- gnus-article-externalize-part.
- (gnus-mime-action-alist): Change correspondingly.
- (gnus-mime-button-commands): Ditto.
- (gnus-mime-action-alist): Remove duplication.
-
- * gnus-sum.el (gnus-summary-mime-map): Change correspondingly.
-
-2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-buffer): Add loose-mime parameter.
-
- * gnus-art.el (gnus-display-mime): Use it.
-
- * mm-partial.el (mm-partial-find-parts): Use it.
-
- * gnus-sum.el (gnus-article-loose-mime): Rename from
- gnus-article-no-strict-mime.
- (gnus-summary-save-parts): Use it.
-
-2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Remove unused
- local variable.
-
- * gnus-art.el (article-display-x-face): Don't sort multiple
- X-Faces.
-
-2002-02-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Improved to speed
- up. Suggested by Yuuichi Teranishi <teranisi@gohome.org>.
-
- * gnus-art.el (article-display-x-face): Sort gray X-Faces.
-
-2002-02-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Some ideas is inspired by code from Hrvoje Niksic
- <hniksic@arsdigita.com>
-
- * gnus-art.el (gnus-article-wash-function): Set the default to
- nil, so that we use mm-text-html-renderer instead.
- (article-wash-html): Use mm-text-html-renderer.
-
- * mm-decode.el (mm-inline-media-tests): Use mm-inline-text-*.
- (mm-text-html-renderer): New variable.
- (mm-inline-text-html-renderer): Set the default to nil, so that we
- use mm-text-html-renderer instead.
-
- * mm-view.el (mm-inline-text-html): New function.
- (mm-text-html-renderer-alist): New variable.
- (mm-inline-text-vcard): New function.
- (mm-inline-text): Split.
- (mm-links-remove-leading-blank): New function.
- (mm-inline-render-with-file): New function.
- (mm-inline-render-with-stdin): New function.
- (mm-inline-render-with-function): New function.
- (mm-text-html-washer-alist): New variable.
- (mm-inline-wash-with-file): New function.
- (mm-inline-wash-with-stdin): New function.
-
-2002-02-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message-utils.el: Fix installation doc.
-
-2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-discouraged-post-methods): New variable.
- (gnus-post-method): Use it.
- (gnus-summary-cancel-article): Find the correct post-method.
-
- * gnus-soup.el (gnus-soup-send-packet): Via ... using ...
- * message.el (message-send-news): Ditto.
- Suggested by Lloyd Zusman <ljz@asfast.com> and IPmonger
- <ipmonger@delamancha.org>
-
- * gnus.el (gnus-select-method): Fix doc.
- (gnus-server-string): Use 'using nntp'.
-
- * gnus-agent.el (gnus-slave-unplugged): New command.
- From: Felix Natter <fnatter@gmx.net>
-
-2002-02-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-edit-done): Kill-all-local-variables.
- Call edit-done-function first, then change the window
- configuration.
- (gnus-article-edit-mode-map): Add message key bindings. Add menu.
- (gnus-article-edit-mode): mml-mode.
-
- * gnus-util.el (gnus-byte-compile): Work around a bug in XEmacs
- 21.4. Suggested by Russ Allbery <rra@stanford.edu> .
-
- * message-utils.el: Adopt the file.
-
-2002-02-15 Holger Schauer <Holger.Schauer@gmx.de>
-
- * message-utils.el: New file.
-
-2002-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Select-article only
- when gnus-move-split-methods is non-nil. And we don't render or
- mark the article.
-
- * gnus-fun.el (gnus-shell-command-to-string): New function.
- (gnus-shell-command-on-region): New function.
- (gnus-random-x-face): Use them.
- (gnus-x-face-from-file): Ditto.
- (gnus-convert-image-to-gray-x-face): Ditto.
- (gnus-convert-gray-x-face-to-xpm): Ditto.
- (gnus-convert-image-to-x-face-command): Don't use 2>/dev/null.
-
-2002-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-treat-display-xface): Don't use
- `shell-command-to-string' when compiling.
- (gnus-treat-display-grey-xface): Ditto.
-
-2002-02-13 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--article-count): If the group is
- completely empty, report minimum article number as 1 instead of 0.
-
-2002-02-13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-get-predicate): Use nconc.
-
- * gnus-sum.el (gnus-summary-display-make-predicate): Use
- gnus-summary-display-cache as cache.
-
- * nndoc.el (nndoc-type-alist): Add mail-in-mail type.
- (nndoc-mail-in-mail-type-p): New function.
- (nndoc-mail-in-mail-article-begin): New function.
-
-2002-02-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-mime-data): Use enriched-decode.
-
- * gnus-cite.el (gnus-article-fill-cited-article): Bind
- use-hard-newlines to nil.
-
- * gnus-xmas.el (gnus-xmas-image-type-available-p): Assume that
- image is not available if window-system is not available.
-
- * gnus-sum.el (gnus-summary-display-make-predicate): Add unread.
-
-2002-02-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-article-unpropagated-mark-lists): Don't propagate
- bookmark, because update-mark doesn't handle it correctly.
-
-2002-02-09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-soup.el (gnus-soup-send-packet): Send news and mail
- directly instead of calling message-send-mail.
-
- * gnus-start.el (gnus-read-descriptions-file): Use
- gnus-default-charset.
-
- * mm-util.el (mm-guess-mime-charset): New function.
-
- * gnus.el (gnus-default-charset): Use it.
- (gnus-group-charset-alist): Remove .*, Let gnus-default-charset be
- the default.
-
-2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-display-grey-xface): New variable.
- (article-display-x-face): Use it. Disable grey xface, if
- uncompface is not found.
-
- * message.el (message-mode): Don't enable multibyte on an indirect
- buffer.
-
- * nnrss.el (nnrss-content-function): New variable.
- (nnrss-request-article): Use it.
-
-2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: Add article-unsplit-urls.
- * gnus-sum.el: Ditto.
- * gnus-art.el (gnus-treat-strip-cr): New variable.
- (gnus-treatment-function-alist): Use it.
- (article-unsplit-urls): New function.
- (gnus-article-make-menu-bar): Use it.
- From: Michael Cook <michael.cook@cisco.com>
-
-2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-braid-nov): Find the first article to
- copy.
-
-2002-02-07 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-util.el (gnus-split-references): Allow (broken) Message-IDs
- with internal whitespace.
- (gnus-parent-id): Ditto.
-
-2002-02-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-treat-body-boundary): Add
- gnus-decoration property.
- * gnus-msg.el (gnus-copy-article-buffer): Remove gnus-decoration.
-
- * gnus-art.el (gnus-article-treat-unfold-headers): Don't remove
- too many spaces.
-
- * rfc2047.el (rfc2047-unfold-region): Ditto.
- (rfc2047-decode-region): Don't unfold. Let
- gnus-article-treat-unfold-headers do it.
-
-2002-02-07 Matt Armstrong <matt@lickey.com>.
-
- * message.el (message-mode): Set local-abbrev-table.
-
-2002-02-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-sum.el (gnus-dependencies-add-header): Fix typo.
-
-2002-02-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-posting-styles): Add x-face-file.
- (gnus-configure-posting-styles): Use it.
- (gnus-configure-posting-styles): Remove trailing newspaces.
-
-2002-02-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-articles-to-read): Fetch all if the predicate
- is non-nil.
-
- * mm-util.el (mm-use-find-coding-systems-region): Add doc.
-
- * gnus.el (gnus-server-to-method): Switch position with
- gnus-server-get-method.
- (gnus-agent): Add doc.
-
- * gnus-sum.el (gnus-article-no-strict-mime): New variable.
- (gnus-summary-save-parts): Use it.
-
- * gnus-art.el (gnus-display-mime): Use it.
- * mm-partial.el (mm-partial-find-parts): Use it.
-
- * nnweb.el (nnweb-google-parse-1): Use a correct format of date.
-
- * nnagent.el (nnagent-request-expire-articles): Don't delete
- files.
-
-2002-02-06 Stefan Reich\e,Av\e(Br <xsteve@riic.at>
-
- * gnus-agent.el (gnus-agent-summary-make-menu-bar): Fix typo.
-
-2002-02-05 Sriram Karra <karra@cs.utah.edu>
-
- * message.el (message-gen-unsubscribed-mft): New function.
-
-2002-02-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-article-unpropagated-mark-lists): Backslash the
- open parenthesis.
-
- * mm-view.el (mm-w3-prepare-buffer): Bind url-gateway-unplugged.
- (mm-inline-text-html-render-with-w3): Ditto.
- * gnus-art.el (gnus-article-wash-html-with-w3): Ditto.
- Suggested by Dave Love <d.love@dl.ac.uk>.
-
- * mm-url.el (mm-url-load-url): Require w3-vars for old versions.
-
- * nntp.el (nntp-send-command-and-decode): Check PROCESS.
- * nntp.el (nntp-send-command): Ditto.
- * nntp.el (nntp-send-command-nodelete): Ditto.
-
-2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el (mm-url-load-url): New function.
- (mm-url-insert-file-contents): Use it.
-
- * gnus-msg.el (gnus-summary-mail-forward): Use gnus-article-charset.
-
- * message.el (message-forward-make-body): Correctly copy
- forward-buffer.
-
- * rfc2047.el (rfc2047-decode-region): Don't decode us-ascii characters.
-
-2002-02-04 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-article-followup-with-original): Mark with
- force, prevent errors when following up from article buffer.
- (gnus-article-reply-with-original): Ditto.
-
- * binhex.el (binhex-decoder-switches): Fix doc. From
- Pavel@Janik.cz (Pavel Jan\e,Am\e(Bk).
-
-2002-02-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treatment-function-alist): Move hide-citation,
- highlight-citation after emphasize.
-
-2002-02-04 David Edmondson <dme@sun.com>
-
- * nnfolder.el (nnfolder-open-marks): Message when done.
-
- * nnml.el (nnml-open-marks): Ditto.
-
-2002-02-03 Steinar Bang <sb@dod.no>
-
- * imap.el (imap-anonymous-auth): Fix typo.
-
-2002-02-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-braid-nov): Use set-buffer instead of
- save-excursion.
- (gnus-cache-braid-heads): Ditto.
-
- * gnus-agent.el (gnus-agent-copy-nov-line): Move to the correct
- line, because there are extra articles in the overview buffer.
-
- * nntp.el (nntp-retrieve-groups): Check whether BUF is live.
-
- * message.el (message-forward-rmail-make-body): Directly use
- rmail-msg-restore-non-pruned-header to avoid calling
- vertical-motion.
-
-2002-02-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-summary-insert-cached-articles):
- (gnus-summary-limit-include-cached): gnus-newsgroup-cached is sorted.
-
- * gnus-group.el (gnus-group-mark-article-read): Nreverse
- gnus-newsgroups-unselected.
-
- * gnus-agent.el (gnus-summary-set-agent-mark): Use
- gnus-add-to-sorted-list.
-
- * gnus-sum.el (gnus-summary-update-info): gnus-newsgroup-unreads
- gnus-newsgroup-unselected are sorted. Use gnus-sorted-union.
- (gnus-build-all-threads): Use gnus-add-to-sorted-list.
- (gnus-update-read-articles): UNREAD is sorted.
- (gnus-newsgroup-unreads, gnus-newsgroup-unselected)
- (gnus-newsgroup-marked, gnus-newsgroup-cached)
- (gnus-newsgroup-expirable, gnus-newsgroup-downloadable)
- (gnus-newsgroup-dormant): Require sorted.
-
- * gnus-dired.el (gnus-dired-find-file-mailcap): Correctly handle
- directories.
- (gnus-dired-print): New function.
-
- * gnus-art.el (gnus-mime-print-part): Add argument filename. Call
- ps-despool.
-
-2002-02-02 Simon Josefsson <jas@extundo.com>
-
- * gnus-dired.el (turn-on-gnus-dired-mode): Autoload. Make defun.
-
-2002-02-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-1): Call gnus-agentize if gnus-agent is
- t. This makes gnus-agent customizable without putting
- gnus-agentize into .gnus.
-
- * gnus.el (gnus-agent): Make it customizable.
-
- * gnus-cache.el (gnus-cache-articles-in-group): Remove from active
- if no article.
- (gnus-cache-possibly-remove-article): Ditto.
- (gnus-cache-possibly-enter-article): Use gnus-add-to-sorted-list.
-
-2002-02-02 Benjamin Rutt <brutt@bloomington.in.us>
-
- * gnus-dired.el: New file.
-
-2002-02-01 Simon Josefsson <jas@extundo.com>
-
- * gnus-int.el (gnus-request-accept-article): Use gnus-get-function.
-
-2002-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-w3m-mode-dont-bind-keys): New variable.
- (mm-setup-w3m): Don't bind keys listed in the above.
-
-2002-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-inline-text-html-render-with-w3m): Bind
- `w3m-safe-url-regexp' with nil if `mm-inline-text-html-with-images'
- is non-nil; bind `w3m-force-redisplay' with nil.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto.
-
- * mm-decode.el (mm-inline-text-html-with-images): Supplement docs.
-
-2002-01-31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-replace-article): Unfold. Don't
- use mail-header-unfold-field.
-
- * gnus-cache.el (gnus-summary-insert-cached-articles): Use
- gnus-summary-limit.
-
- * gnus-range.el (gnus-add-to-sorted-list): New function.
- * gnus-sum.el (gnus-mark-article-as-read): Use it.
- (gnus-mark-article-as-unread): Ditto.
- (gnus-summary-mark-article-as-unread): Ditto.
- (gnus-build-get-header): Ditto.
- (gnus-summary-prepare-threads): Ditto.
- (gnus-summary-insert-pseudos): Ditto.
- (gnus-articles-to-read): Use gnus-sorted-union and gnus-sorted-nunion.
- (gnus-summary-insert-new-articles): Use gnus-sorted-nunion.
- (gnus-summary-insert-old-articles): Ditto.
-
- * gnus-msg.el (gnus-posting-styles): Add new format of header.
- (gnus-configure-posting-styles): Support the new format.
-
- * mail-source.el (mail-source-bind, mail-source-bind-common): Set
- edebug-form-spec to (sexp body).
- Suggested by Joe Wells <jbw@izanami.cee.hw.ac.uk>.
-
- * message.el (message-reply-headers): Add doc.
-
-2002-01-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-delete-group): Nix the entry in
- gnus-cache-active-hashtb.
-
- * gnus-agent.el (gnus-agent-mark-unread-afer-downloaded): New variable.
- (gnus-agent-summary-fetch-group): Use it.
-
- * gnus-msg.el (gnus-debug-files): New variable.
- (gnus-debug-exclude-variables): New variable.
- (gnus-debug): Use them.
-
- * gnus-range.el (gnus-range-length): Don't use gnus-uncompress-range.
-
-2002-01-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cite-prefix-regexp): Use text-mode-syntax-table.
- (message-mode-syntax-table): Move back the previous position.
-
- * nnagent.el (nnagent-retrieve-headers): Use gnus-sorted-difference.
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- gnus-sorted-difference.
-
- * nnsoup.el (nnsoup-request-expire-articles): Use
- gnus-sorted-difference.
-
- * nnheader.el: Autoload gnus-sorted-difference.
-
- * nnfolder.el (nnfolder-request-expire-articles): Use
- gnus-sorted-difference.
-
- * gnus-cache.el (gnus-cache-retrieve-headers): Use
- gnus-sorted-difference.
-
- * gnus-range.el: Autoload cookies.
- (gnus-sorted-difference): New function.
- (gnus-sorted-ndifference): New function.
- (gnus-sorted-nintersection): Rename from
- gnus-set-sorted-intersection.
- (gnus-sorted-nunion): Rename from gnus-set-sorted-union.
- (gnus-list-range-difference): Rename from
- gnus-inverse-list-range-intersection.
- (gnus-inverse-list-range-intersection): Use defalias.
-
- * gnus-sum.el (gnus-select-newsgroup): Use gnus-sorted-difference,
- gnus-sorted-ndifference, and gnus-sorted-nintersection.
- (gnus-articles-to-read): Use gnus-sorted-difference.
- (gnus-summary-limit-mark-excluded-as-read): Use
- gnus-sorted-intersection and gnus-sorted-ndifference.
- (gnus-list-of-read-articles): Use gnus-list-range-difference.
- (gnus-summary-insert-articles): Use gnus-sorted-difference.
-
- * gnus-sum.el (gnus-summary-update-info): Use gnus-sorted-union.
-
-2002-01-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Add keymap
- property to the buffer for using emacs-w3m command keys.
-
- * mm-decode.el (mm-inline-text-html-with-w3m-keymap): New user
- option.
-
- * mm-view.el (mm-w3m-mode-map): New variable.
- (mm-w3m-mode-command-alist): New variable.
- (mm-w3m-minor-mode): Removed.
- (mm-setup-w3m): Setup `mm-w3m-mode-map'; don't add minor mode.
- (mm-inline-text-html-render-with-w3m): Add keymap property to the
- buffer for using emacs-w3m command keys.
-
-2002-01-29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mode-syntax-table): Move forward.
- (message-cite-prefix-regexp): Auto detect non word constituents.
- (message-cite-prefix-regexp): Don't use with-syntax-table.
-
- * gnus-sum.el (gnus-summary-update-info): Use
- gnus-list-range-intersection.
-
- * gnus-agent.el (gnus-agent-fetch-headers): Use
- gnus-list-range-intersection.
-
- * gnus-range.el (gnus-range-normalize): Use correct predicate.
- (gnus-list-range-intersection): Use it.
- (gnus-inverse-list-range-intersection): Ditto.
- (gnus-sorted-intersection): Add doc.
- (gnus-set-sorted-intersection): Add doc.
- (gnus-sorted-union): New function.
- (gnus-set-sorted-union): New function.
-
- * gnus-range.el (gnus-list-range-intersection): Correct the logic.
- (gnus-inverse-list-range-intersection): Ditto.
-
-2002-01-29 Karl Kleinpaste <karl@charcoal.com>
-
- * mm-uu.el (mm-uu-type-alist): Add optional leading `0'.
-
- * gnus-uu.el (gnus-uu-shar-name-marker): Add optional leading `0'
- and permit `:' and `\' in order to handle full Windows pathnames.
- (gnus-uu-begin-string): Add optional leading `0'. Leading `0' is
- technically not correct per standard, but seems to have common use.
-
-2002-01-29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-uu.el (gnus-uu-expand-numbers): Ignore errors when
- replacing numbers.
-
-2002-01-28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-followup-with-original): Use (mark).
-
- * gnus-score.el (gnus-score-insert-help): Move to (point-min).
- Don't split when the window is small, e.g. when a small *BBDB*
- window is the lowest one.
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- nnheader-find-nov-line to speed up. Use nreverse, because it is
- sorted. Use nnheader-insert-nov-file.
-
-2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-inline-text-html-with-images): New user option.
-
- * mm-view.el (mm-inline-text-html-render-with-w3m): Bind the value
- of `w3m-display-inline-images' with the value of
- `mm-inline-text-html-with-images'.
- From: TSUCHIYA Masatoshi <tsuchiya@namazu.org>.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Ditto.
-
-2002-01-27 Richard M. Stallman <rms@gnu.org>
-
- * time-date.el: Add autoload cookies. Many doc fixes.
- (time-add): New function.
- (time-subtract): Renamed from subtract-time.
- (subtract-time): New alias for time-subtract.
-
-2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Replace w3m to
- emacs-w3m in doc-string.
-
- * lpath.el: Bind `w3m-cid-retrieve-function-alist' and
- `w3m-current-buffer'.
-
-2002-01-27 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Handle cid: URLs.
-
- * mm-view.el (mm-setup-w3m): Add `mm-w3m-cid-retrieve' to
- `w3m-cid-retrieve-function-alist' for `gnus-article-mode'.
- (mm-w3m-cid-retrieve): New function.
- (mm-inline-text-html-render-with-w3m): Handle cid: URLs.
-
-2002-01-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-fetch-articles): Don't save empty articles.
-
-2002-01-27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-util.el (gnus-cache-file-contents): Don't use equalp.
-
-2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-insert-nov-file): Increased cutoff to
- 32K.
-
- * gnus-sum.el (gnus-summary-expire-articles): Clean up.
-
- * nnmail.el (nnmail-article-group): Decode headers before running
- split rules over them.
- (nnmail-mail-splitting-charset): New variable.
-
- * smiley.el: Replaced with smiley-ems.el.
-
-2002-01-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el (mm-url-predefined-programs): Add w3m.
- (mm-url-program): Ditto.
-
-2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnml.el (nnml-use-compressed-files): New variable.
- (nnml-filenames-are-evil): Removed.
- (nnml-current-group-article-to-file-alist): Don't use.
- (nnml-update-file-alist): Inhibit.
- (nnml-article-to-file): Use new var.
-
-2002-01-26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-parse-without-error): Add edebug-form-spec.
-
- * nnagent.el (nnagent-retrieve-headers): loop until eobp.
-
-2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-load-alist): Use new caching
- function.
-
- * gnus-util.el (gnus-cache-file-contents): New function.
-
- * gnus-agent.el (gnus-agent-file-loading-cache): New variable.
- (gnus-agent-load-alist): Use it.
-
- * nnagent.el (nnagent-retrieve-headers): Use optimized function.
-
- * nnheader.el (nnheader-insert-nov-file): New function.
-
- * gnus-util.el (gnus-parse-without-error): Correct the loop.
-
- * gnus-sum.el (gnus-dependencies-add-header): Use in-reply-to if
- there are no references.
- (gnus-extract-message-id-from-in-reply-to): New function.
- (gnus-nov-parse-line): Use in-reply-to if there are no
- references.
-
-2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnagent.el (nnagent-retrieve-headers): Use new macro.
-
- * gnus-util.el (gnus-parse-without-error): New macro.
-
-2002-01-25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): Call w3m-region.
- (gnus-article-wash-function): use locate-library to decide which
- to use.
-
-2002-01-25 Simon Josefsson <jas@extundo.com>
-
- * pop3.el (pop3-munge-message-separator): Work if no date.
- Trivial patch from Marius Vollmer <mvo@zagadka.ping.de>.
-
-2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-save-alist): Fix.
-
- * nnagent.el (nnagent-retrieve-headers): Must have cut too much by
- mistake. Reinstated lost code.
-
-2002-01-25 Josh Huber <huber@alum.wpi.edu>
-
- * mml2015.el (mml2015-mailcrypt-decrypt): Display a signature if
- one exists in the case of an encrypted message with an internal
- signature.
-
-2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-save-alist): Optimized.
-
-2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el: Commented out the experimental code.
-
-2002-01-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-range.el (gnus-inverse-list-range-intersection): Off-by-one
- error.
-
- * gnus.el (gnus-server-to-method): Made into subst.
- (gnus-server-method-cache): New variable.
- (gnus-server-to-method): Use it.
- (gnus-group-method-cache): New variable.
- (gnus-find-method-for-group-1): Renamed.
- (gnus-find-method-for-group): New function.
- (gnus-group-method-cache): Removed.
-
- * gnus-sum.el (gnus-compute-unseen-list): Use new optimized
- function.
-
- * gnus-range.el (gnus-members-of-range): New function.
- (gnus-list-range-intersection): Renamed.
- (gnus-inverse-list-range-intersection): New function.
-
- * gnus-sum.el (gnus-compute-unseen-list): Made into own function.
-
- * nnagent.el (nnagent-retrieve-headers): New implementation.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): New, faster
- implementation.
-
-2002-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind `w3m-charset-to-coding-system'; bind
- `w3m-meta-content-type-charset-regexp'.
-
- * mm-view.el (mm-inline-text-html-render-with-w3m): Decode
- charset-encoded html contents.
-
-2002-01-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-request-article): Make sure it is not
- an empty file.
-
- * nnweb.el (url): Ignore errors when request url.
-
- * nnrss.el: Clean up the comments.
-
-2002-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind `w3m-region'; bind `w3m-mode-map'.
-
- * mm-decode.el (mm-inline-text-html-renderer): New user option.
- (mm-inline-media-tests): Test whether the value of
- `mm-inline-text-html-renderer' is a function for text/html.
-
- * mm-view.el (mm-inline-text-html-render-with-w3): New function
- separated from `mm-inline-text'.
- (mm-w3m-minor-mode): New variable.
- (mm-w3m-setup): New variable.
- (mm-setup-w3m): New function.
- (mm-inline-text-html-render-with-w3m): New function.
- (mm-inline-text): Funcall `mm-inline-text-html-renderer' for
- text/html.
-
-2002-01-23 Paul Jarc <prj@po.cwru.edu>
-
- * lpath.el: fbind make-symbolic-link and unix-sync for nnmaildir.
-
-2002-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-xmas.el (gnus-xmas-redefine): Quote `gnus-completing-read'
- and `gnus-xmas-completing-read'.
-
-2002-01-19 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * nneething.el (nneething-message-id-number): Abolished.
- (nneething-encode-file-name): Not encode numerical characters.
- (nneething-make-head): `nneething-message-id-number' is not
- used to generate message IDs.
-
-2002-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-emphasis-alist): Include !? as sentence-ending
- characters.
-
-2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-xmas.el (gnus-xmas-completing-read): New function.
- (gnus-xmas-redefine): Redefine conditionally.
-
-2002-01-22 Josh Huber <huber@alum.wpi.edu>
-
- * mml.el (mml-parse-1): Fixed usage of recipients in the secure
- tag.
-
-2002-01-22 Josh Huber <huber@alum.wpi.edu>
-
- * message.el (message-font-lock-keywords): Added the secure tag.
- * mml-sec.el: Added functions to generate/modify/remove the secure
- tag while in message mode.
- * mml-sec.el (mml-secure-message): New.
- * mml-sec.el (mml-unsecure-message): New.
- * mml-sec.el (mml-secure-message-sign-smime): New.
- * mml-sec.el (mml-secure-message-sign-pgp): New.
- * mml-sec.el (mml-secure-message-sign-pgpmime): New.
- * mml-sec.el (mml-secure-message-encrypt-smime): New.
- * mml-sec.el (mml-secure-message-encrypt-pgp): New.
- * mml-sec.el (mml-secure-message-encrypt-pgpmime): New.
- * mml.el (mml-parse-1): Added code to recognise the secure tag and
- convert it to either a part or multipart depending on if there are
- other parts in the message.
- * mml.el (mml-mode-map): Changed default sign/encrypt keybindings
- to use the secure tag, rather than the part tag.
- * mml.el (mml-preview): Added a save-excursion to keep cursor
- position after doing an MML preview.
-
-2002-01-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheader.el (nnheader-parse-overview-file): New function.
- (nnheader-write-overview-file): New function.
-
-2002-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-group-fast-parameter): Check better if expansion
- in wanted.
-
- * nnweb.el (nnweb-type-definition): Clean up.
-
-2002-01-21 Alastair Burt <burt@dfki.de>
- Trivial patch.
-
- * gnus-art.el (gnus-mm-display-part): Make sure that the summary
- buffer exists before jumping to it.
-
-2002-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-wash-html-with-w3): Made into own
- function.
- (article-wash-html): Use it.
- (gnus-article-wash-function): New variable.
- (gnus-article-wash-html-with-w3m): New function.
-
-2002-01-20 Bj\e,Av\e(Brn Torkelsson <torkel@acc.umu.se>
-
- * dgnushack.el (dgnushack-compile): Compile smiley-ems for
- XEmacs.
-
-2002-01-20 John H. Palmieri <palmieri@math.washington.edu>
-
- * gnus-fun.el (gnus-convert-image-to-gray-x-face): More standard
- command line.
-
-2002-01-21 Simon Josefsson <jas@extundo.com>
-
- * canlock.el (base64-encode-string): Autoload it from base64.
- (canlock-make-cancel-key): Base64 encode unibyte string.
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnfolder.el (nnfolder-request-accept-article): Unfold
- x-from-line.
- (nnfolder-request-replace-article): Ditto.
-
-2002-01-20 Nevin Kapur <nevin@jhu.edu>
-
- * gnus-group.el (gnus-group-best-unread-group): Use the right
- positioning function.
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * smiley-ems.el (smiley-region): Use new function.
- (smiley-update-cache): Use general image functions.
- (smiley-region): Use general functions.
-
- * gnus-util.el (gnus-graphic-display-p): New function.
-
- * nnmail.el (nnmail-article-group): Allow outputting traces of
- non-strings.
-
- * nndoc.el (nndoc-type-alist): Rules for exim bounces.
- (nndoc-exim-bounce-type-p): New function.
-
- * message.el (message-dont-send): Doc fix.
-
- * gnus-util.el (gnus-completing-read): Remove
- inherit-input-method.
-
- * gnus-art.el (gnus-treat-smiley): Doc fix.
-
- * gnus-agent.el (gnus-agent-fetch-headers): Ignore seen and recent
- articles.
-
-2002-01-19 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-gssapi-open): Don't wait for logout to complete.
- (imap-kerberos4-open): Ditto.
- (imap-open): Set port correctly, don't set auth.
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-version-number): Bump version number.
-
-2002-01-20 05:33:30 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.05 is released.
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnkiboze.el (nnkiboze-generate-group): Make sure the directory
- exists.
-
- * gnus-spec.el (gnus-string-width-function): New function.
- (gnus-tilde-cut-form): Use it.
- (gnus-tilde-max-form): Ditto.
- (gnus-use-correct-string-widths): Default to (featurep 'xemacs).
- (gnus-substring-function): Use it.
- (gnus-tilde-cut-form): Ditto.
- (gnus-substring-function): New function.
-
- * message.el (message-check-news-header-syntax): New message.
-
- * gnus.el (gnus-slave-no-server): Doc fix.
-
- * gnus-spec.el (gnus-use-correct-string-widths): Default to t.
-
-2002-01-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-adjust-marked-articles): Fix the record for
- `seen' if it looks like (seen NUM1 . NUM2). It should be
- (seen (NUM1 . NUM2)).
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-catchup-articles): Update article
- number in closed topics.
-
-2002-01-19 Daniel Pittman <daniel@rimspace.net>
-
- * gnus-sum.el (gnus-summary-first-unseen-or-unread-subject): New
- functions.
-
-2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-group-find-parameter): Clean up.
-
- * gnus-sum.el (gnus-summary-goto-subject): Error on non-numerical
- articles.
-
- * gnus-util.el (gnus-completing-read-with-default): Renamed.
-
- * nnmail.el (nnmail-article-group): Clean up.
-
-2002-01-19 Paul Stodghill <stodghil@cs.cornell.edu>
-
- * gnus-agent.el (gnus-category-name): Intern the category name.
-
-2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-topic.el (gnus-topic-move-group): Use gnus-topic-history.
-
- * gnus-util.el (gnus-completing-read): New function.
-
-2002-01-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-add-wash-type): Use add-to-list.
-
- * smiley-ems.el (smiley-region): Register smiley.
- (smiley-toggle-buffer): Rewrite the function.
- (smiley-active): Removed.
-
-2002-01-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-util.el (gnus-parent-id): Optimize null n case. From
- Jesper Harder <harder@ifa.au.dk>.
-
-2002-01-18 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-art.el (gnus-request-article-this-buffer): Call
- `nneething-get-file-name' to extract the file name from the
- message id.
-
- * nneething.el (nneething-encode-file-name): New function.
- (nneething-decode-file-name): Ditto.
- (nneething-get-file-name): Ditto.
- (nneething-make-head): Encode the file name and encapsulate it
- into the field of the message id.
-
-2002-01-18 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-request-update-info): Don't erase flags that isn't
- stored in .marks.
-
- * nnfolder.el (nnfolder-request-update-info): Ditto.
-
-2002-01-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-url-parse-query-string): Allow new line in value.
-
-2002-01-18 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-starttls-p): Don't check for binary.
- (imap-gssapi-auth-p): Ditto.
- (imap-kerberos4-auth-p): Ditto.
- (imap-open): Change logic. Iterate through all possible streams,
- instead of bailing out after first failure. Move authenticator
- decision to `imap-authenticate'.
- (imap-authenticate): Change logic, now finds the authenticator to
- use, was previously in `imap-open'.
- (imap-open): Return nil on failure.
- (imap-open): Setup temp buffer correctly.
- (imap-open): Return buffer only on success.
- (imap-interactive-login, imap-interactive-login): Tell the user
- which stream/authenticator is used for the queried
- username/password.
- (imap-open, imap-authenticate): Set variables.
- (imap-gssapi-auth-p, imap-kerberos4-auth-p): Fix typo.
- (imap-open): Don't assume how `with-temp-buffer' is implemented.
-
-2002-01-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-grab-cam-x-face): New function.
-
-2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-emphasis-alist): Allow matching "*this*.)".
-
-2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-toggle-group-plugged): New function.
- (gnus-agent-group-mode-map): Bind it to "Jo".
- (gnus-agent-group-make-menu-bar): Add it into menu bar.
-
-2002-01-17 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-xmas.el (gnus-group-toolbar): Add .newsrc save button.
- (gnus-summary-mail-toolbar): Add mail article deletion button.
-
- * smiley.el (smiley-deformed-regexp-alist): Eliminate noseless
- false positives for lines of "^^^^".
-
- * gnus-picon.el (gnus-picon-find-face): faces database is all
- lowercase.
-
-2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Use correct buffer.
- (gnus-agent-braid-nov): Switch back to nntp-server-buffer. Remove
- duplications.
- (gnus-agent-batch): Bind gnus-agent-confirmation-function.
-
-2002-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-initial-limit): Inline
- gnus-summary-limit-children.
- (gnus-summary-initial-limit): Don't limit if
- gnus-newsgroup-display is nil.
- (gnus-summary-initial-limit): No, don't.
-
- * gnus-util.el
- (gnus-put-text-property-excluding-characters-with-faces): Inline
- gnus-put-text-property.
-
- * gnus-spec.el (gnus-default-format-specs): New variable.
-
- * gnus-start.el (gnus-read-newsrc-file): Don't clear
- gnus-format-specs.
- (gnus-read-newsrc-el-file): Default to gnus-default-format-specs.
-
- * gnus-spec.el (gnus-update-format-specifications): Really check
- the Gnus version of the .newsrc.eld file.
- (gnus-format-specs): Save the new default summary format.
-
- * gnus-util.el (gnus-parent-id): Check whether references is empty
- before splitting.
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): Inline some
- functions.
- (gnus-gather-threads-by-references): Inline
- `gnus-split-references'.
-
- * gnus-spec.el (gnus-summary-line-format-spec): New, optimized
- default value of gnus-summary-line-format-spec.
-
-2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): A better error
- message.
- (nnslashdot-request-list): Ditto.
- (nnslashdot-sid-strip): Removed.
-
-2002-01-15 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-close-asynchronous): Enable.
- (nnimap-close-group): Expunge.
-
-2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-user-date-format-alist): Typo.
- From: Frank Schmitt <usereplyto@Frank-Schmitt.net>
-
-2002-01-15 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * nneething.el (nneething-request-article): Set
- `nnmail-file-coding-system' to `binary' locally, in order to read
- files without any conversion.
-
-2002-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Use
- nnheader-file-coding-system and nnmail-active-file-coding-system.
- (gnus-agent-regenerate-group): Ditto.
- (gnus-agent-regenerate): Ditto.
- (gnus-agent-write-active): Ditto.
- Suggested by Katsumi Yamaoka <yamaoka@jpl.org>
-
-2002-01-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-button-alist): Don't highlight <URL:.
- Suggested by Ian Fitchet <ian.fitchet@lunanbay.com>
-
-2002-01-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: We don't need gnus-article-show-all-headers.
-
- * gnus-art.el (article-show-all, gnus-article-show-all-header):
- Ditto.
-
- * gnus-sum.el (gnus-summary-select-article): Don't call
- show-all-headers, because hidden headers are not hidden text any
- more.
-
-2002-01-13 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-newline-and-reformat): Use `newline' instead
- of inserting \n, so that the newline is marked as hard.
-
-2002-01-13 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-spec.el (gnus-pad-form): Don't evaluate EL multiple times.
-
-2002-01-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * imap.el (imap-close): Keep going if quit.
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Erase
- nntp-server-buffer.
-
-2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * mm-view.el (mm-display-inline-fontify): Require font-lock to
- avoid unbinding shadowed variables.
-
- * gnus-art.el (gnus-picon-databases): Moved here.
- (gnus-picons-installed-p): Moved here.
- (gnus-article-reply-with-original): Use `mark'.
-
- * gnus.el (gnus-picon): Moved here and renamed.
-
- * gnus-art.el (gnus-treat-from-picon): Only be on if picons are
- installed.
- (gnus-treat-mail-picon): Ditto.
- (gnus-treat-newsgroups-picon): Ditto.
-
- * gnus-picon.el (gnus-picons-installed-p): New function.
-
-2002-01-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-go-online): Fix doc.
-
-2002-01-12 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-need-unselect-to-notice-new-mail)
- (nnimap-before-find-minmax-bugworkaround): Use it.
- (nnimap-find-minmax-uid): Don't reselect current mailbox.
- (nnimap-dont-close): New variable.
- (nnimap-close-group): Use it.
-
-2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-reply-with-original): Use
- `mark-active'.
-
- * gnus-msg.el (gnus-summary-reply): Don't bug out on regions.
-
- * gnus-logic.el (gnus-advanced-score-rule): Thinko fix.
- (gnus-score-advanced): Clean up.
- (gnus-score-advanced): Accept a multiple of the score.
-
-2002-01-12 Simon Josefsson <jas@extundo.com>
-
- * flow-fill.el (fill-flowed-display-column)
- (fill-flowed-encode-columnq): New variables. Suggested by
- Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro\e,b_\e(Bjohann).
- (fill-flowed-encode, fill-flowed): Use them.
-
- * message.el (message-send-news, message-send-mail): Use
- m-b-s-n-p-e-h-n.
-
- * mml.el (autoload): Autoload fill-flowed-encode.
- (mml-buffer-substring-no-properties-except-hard-newlines): New
- function.
- (mml-read-part): Use it.
- (mml-generate-mime-1): Encode format=flowed if appropriate.
- (mml-insert-mime-headers): Insert format=flowed.
-
- * flow-fill.el (fill-flowed-encode): New function.
- (fill-flowed): Bind fill-column to window width.
-
-2002-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-buffer-name): Return the dead name if
- it exists.
- (gnus-summary-setup-buffer): Wake up dead summary buffers.
- (gnus-summary-buffer-name): Don't return the dead name after all.
- (gnus-summary-setup-buffer): Kill the dead buffer.
-
- * gnus-art.el (gnus-article-followup-with-original): Store the
- value of the mark before deactivating it.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-fun.el (gnus-display-x-face-in-from): Fake it.
- From: Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-art.el (article-display-x-face): Ditto.
- (gnus-article-reply-with-original): Use gnus-region-active-p.
- (gnus-article-followup-with-original): Ditto.
-
- * gnus-sum.el (gnus-summary-read-group-1): Don't select
- downloadable article either.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-display-x-face): Insert From:.
-
- * gnus-sum.el (gnus-summary-move-article): Don't draw the
- article. Bind gnus-display-mime-function and
- gnus-article-prepare-hook.
-
- * gnus-agent.el (gnus-agent-retrieve-headers): Load agentview.
- (gnus-agent-toggle-plugged): Use gnus-agent-go-online. Move
- gnus-agent-possibly-synchronize-flags to the last.
- (gnus-agent-go-online): New function. New variable.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-regenerate-group): Add clean option.
- (gnus-agent-regenerate): Ditto.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-ignored-news-headers)
- (message-ignored-mail-headers): Add X-Gnus-Agent-Meta-Information:.
- Suggested by ARISAWA Akihiro <ari@atesoft.advantest.co.jp>
-
- * gnus.el (gnus-gethash-safe): New macro.
-
- * gnus-agent.el (gnus-agent-regenerate-history): New function.
- (gnus-agent-regenerate): Show messages.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-regenerate-group): New function.
- (gnus-agent-regenerate): New function.
- (gnus-agent-save-alist): Sort.
- (gnus-agent-copy-nov-line): Test eobp.
- (gnus-agent-retrieve-headers): Erase buffer.
-
-2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-to-coding-system): Change charset to cs.
- From: Torsten Hilbrich <email@myrkr.in-berlin.de>
-
- * gnus.el (gnus-agent-covered-methods): Move here.
- (gnus-online): New function.
- (gnus-agent-method-p): Move here.
-
- * nnagent.el (nnagent-retrieve-headers): Check whether arts is
- nil. Remove articles-alist.
-
- * gnus-start.el (gnus-get-unread-articles): Check online.
- (gnus-groups-to-gnus-format): Ditto.
- (gnus-active-to-gnus-format): Ditto.
-
- * gnus-agent.el (gnus-agent-get-function): Use it.
- (gnus-agent-get-undownloaded-list): Ditto.
- (gnus-agent-fetch-session): Only fetch online methods.
-
- * gnus-srvr.el (gnus-server-make-menu-bar): Add offline.
- (gnus-server-mode-map): Ditto.
- (gnus-server-offline-face): New face.
- (gnus-server-offline-face): New variable.
- (gnus-server-font-lock-keywords): Add offline.
- (gnus-server-insert-server-line): Ditto.
- (gnus-server-offline-server): New function.
-
- * gnus-int.el (gnus-open-server): Turn to offline.
- (gnus-server-unopen-status): New variable.
-
-2002-01-10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnkiboze.el (nnkiboze-request-article): Use
- gnus-agent-request-article.
-
- * nnagent.el (nnagent-retrieve-headers): Don't use nnml
- function. Insert undownloaded NOV.
-
- * gnus-agent.el (gnus-agent-retrieve-headers): New function.
- (gnus-agent-request-article): New function.
-
- * gnus.el (gnus-agent-cache): New variable.
-
- * gnus-int.el (gnus-retrieve-headers): Use
- gnus-agent-retrieve-headers.
- (gnus-request-head): Use gnus-agent-request-article.
- (gnus-request-body): Ditto.
-
- * gnus-art.el (gnus-request-article-this-buffer): Use
- gnus-agent-request-article.
-
- * gnus-sum.el (gnus-summary-read-group-1): Don't show the first
- article if it is undownloaded.
-
-2002-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-spec.el (gnus-spec-tab): Deal with wide characters.
-
-2002-01-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-string-as-unibyte): New macro.
- (canlock-sha1-with-openssl): Return a unibyte string.
- (canlock-make-cancel-key): Treat Message-ID as a unibyte string.
-
-2002-01-09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-expand-group-parameters): Match \N or \& only.
-
-2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Add
- application/x-emacs-lisp.
-
- * gnus-msg.el (gnus-bug): Use application/emacs-lisp.
-
- * nntp.el (nntp-request-article): Add group parameter.
- (nntp-request-head): Ditto.
- (nntp-find-group-and-number): Add parameter group. Figure out
- number if the status line doesn't give (e.g. quimby.gnus.org).
-
-2002-01-08 Simon Josefsson <jas@extundo.com>
-
- * mml.el (mml-generate-mime-1): Set recipient correctly.
-
-2002-01-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-read-from-minibuffer): Add parameter
- initial-contents.
- * gnus-msg.el (gnus-summary-resend-message): Use it.
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Restore the old
- behavior of quit-config.
-
-2002-01-08 Bj\e,Ax\e(Brn Mork <bmork@dod.no> (tiny change)
-
- * message.el (message-make-from): Don't quote fullname.
-
-2002-01-08 Andre Srinivasan <andre@slamdunknetworks.com> (tiny change)
-
- * gnus-group.el (gnus-group-suspend): Don't kill message buffers.
-
-2002-01-07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-mark-article-read): Typo. Increase n.
-
- * gnus-art.el (gnus-header-button-alist): Handle mailto.
-
- * mml.el (mml-preview): Bind gnus-original-article-buffer because
- article-decode-group-name uses it. Bind gnus-article-prepare-hook
- because bbdb may use it.
-
-2002-01-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * nneething.el (nneething-request-article): When a non-text file
- is converted to an article, its data is encoded in base64. Call
- `nneething-make-head' with options to specify MIME types.
- (nneething-make-head): Add optional arguments to specify MIME
- types.
-
-2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-fun.el (gnus-display-x-face-in-from): Fake a "From: "
- header if there is not.
-
- * gnus-xmas.el (gnus-xmas-put-image): Insert " " if bobp.
-
- * gnus-msg.el (gnus-gcc-mark-as-read): New variable.
- (gnus-inews-mark-gcc-as-read): Obsolete variable.
- (gnus-inews-do-gcc): Use them.
-
- * gnus-group.el (gnus-group-mark-article-read): Put holes into
- gnus-newsgroup-unselected.
-
-2002-01-06 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-ssl-open, imap-ssl-open, imap-parse-fetch): Use
- condition-case, not ignore-errors.
-
-2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-insert-old-articles): Bind
- gnus-fetch-old-headers.
-
- * gnus-art.el (article-display-x-face): Use the current buffer
- unless `W f'. Otherwise, X-Face may be shown in the header of a
- forwarded part.
- (gnus-treatment-function-alist): Treat xface before hiding
- headers.
-
-2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Fix
- parameters.
-
-2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-multibyte-p): Define conditionally when load.
- (mm-guess-charset): New function.
- (mm-charset-after): Use it.
- (mm-detect-coding-region): New function.
- (mm-detect-mime-charset-region): New function.
-
- * gnus-sum.el (gnus-summary-show-article): Use
- mm-detect-coding-region.
-
-2002-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-make-fqdn): Be less violent.
-
- * gnus.el (gnus-logo-color-style): Compute custom form
- automatically.
-
- * gnus-sum.el (gnus-summary-enter-digest-group): Feed the adaptive
- score file of the parent to the document group.
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Add an optional
- parameters parameter.
-
- * gnus-score.el (gnus-score-load-file): Clean up.
-
-2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-thread-sort-by-most-recent-number): Fix typo.
- From: Damien Wyart <damien.wyart@free.fr>
-
- * gnus-util.el (gnus-local-map-property): In Emacs 21, use keymap.
-
-2002-01-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-select-group-hook): Typo.
-
- * rfc2047.el (rfc2047-decode-string): Return immediately if there
- is no quoted-printable-encoded STRING.
- From: Jesper Harder <harder@ifa.au.dk>
-
- (rfc2047-decode-string): Decode it.
-
-2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-logo-color-alist): Added more colors from Luis.
-
-2002-01-05 Keiichi Suzuki <keiichi@nanap.org>
- Trivial patch.
-
- * nntp.el (nntp-possibly-change-group): Erase contents of nntp
- buffer to get rid of junk line.
-
-2002-01-05 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-mode-map): Bind message-goto-from to C-c C-f
- C-o.
- (message-mode-map): Bind message-insert-or-toggle-importance to
- C-c C-u.
- (message-mode-map): Bind message-disposition-notification-to to
- C-c M-n.
- (message-mode-menu): Add m-d-n-t.
- (message-mode-field-menu): Add m-goto-from.
- (message-mode): Doc fix.
- (message-goto-from): New function.
- (message-insert-disposition-notification-to): New function.
- (message-tool-bar-map): Add receipt button.
-
-2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-thread-latest-date): New function.
- (gnus-thread-sort-by-most-recent-number): Renamed.
- (gnus-thread-sort-functions): Doc fix.
- (gnus-select-group-hook): Don't use setq on a hook.
- (gnus-thread-latest-date): Use date, not number
-
- * gnus-agent.el (gnus-agent-expire-days): Doc fix.
- (gnus-agent-expire): Allow regexp of expire-days.
-
- * gnus-art.el (gnus-article-reply-with-original): Deactivate
- region.
- (gnus-article-followup-with-original): Ditto.
-
- * gnus-sum.el (gnus-thread-highest-number): Doc fix.
-
- * gnus-art.el (gnus-mime-display-alternative): Use
- gnus-local-map-property.
- (gnus-mime-display-alternative): Ditto.
- (gnus-insert-mime-security-button): Ditto.
- (gnus-insert-next-page-button): Ditto.
- (gnus-button-prev-page): Take optional args.
- (gnus-insert-prev-page-button): widget-convert.
-
- * gnus-util.el (gnus-local-map-property): New function.
-
- * gnus-art.el (gnus-prev-page-map): Use parent map.
- (gnus-next-page-map): Ditto.
-
- * gnus-spec.el (gnus-parse-format): Clean up.
- (gnus-parse-format): Do complex formatting for %=.
-
- * gnus-fun.el (gnus-display-x-face-in-from): Add the string
- "X-Face: " to the data in the built-in scenario.
-
- * gnus-spec.el (gnus-parse-simple-format): Use gnus-pad-form.
- (gnus-correct-pad-form): Renamed.
- (gnus-tilde-max-form): Clean up.
- (gnus-pad-form): Use gnus-use-correct-string-widths.
-
- * gnus-fun.el (gnus-display-x-face-in-from): Use native xface
- support if that is available.
-
- * gnus-sum.el (gnus-thread-highest-number): New function.
- (gnus-thread-sort-by-most-recent-thread): New function.
- (gnus-thread-sort-functions): Doc fix.
-
-2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-select-article): Disable multibyte in
- all cases.
- (gnus-summary-mode): Enable it in all cases.
- (gnus-summary-display-article): Ditto.
- (gnus-summary-edit-article): Ditto.
-
- * gnus-ems.el (gnus-put-image): Really return glyph.
-
- * gnus-art.el (gnus-article-x-face-command): Fix :type.
- (gnus-treat-smiley): Don't take "P" in the interactive form.
-
-2002-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * compface.el (uncompface): XEmacs and Emacs have differing
- capabilities.
-
- * gnus-fun.el (gnus-display-x-face-in-from): Use face.
-
- * gnus-ems.el (gnus-article-xface-ring-internal): Removed.
- (gnus-article-xface-ring-size): Removed.
- (gnus-article-display-xface): Removed.
- (gnus-remove-image): Cleaned up.
-
- * gnus-xmas.el (gnus-xmas-create-image): Convert pbm to xbm.
- (gnus-xmas-create-image): Take pbm files.
- (gnus-x-face): Removed.
- (gnus-xmas-article-display-xface): Removed.
-
- * gnus-fun.el (gnus-display-x-face-in-from): Bind
- default-enable-multibyte-characters.
-
- * compface.el (uncompface): Doc fix.
-
- * gnus-art.el (gnus-article-x-face-command): Use
- gnus-display-x-face-in-from.
-
- * gnus-xmas.el (gnus-xmas-put-image): Return the image.
-
- * gnus-ems.el (gnus-put-image): Return the image.
-
- * gnus-fun.el (gnus-display-x-face-in-from): New function.
- (gnus-x-face): Moved here.
-
-2002-01-04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-put-image): Don't insert SPC or make
- invisible if string is nil.
- (gnus-xmas-article-display-xface): Use it.
-
- * gnus-ems.el (gnus-put-image): Explicitly use SPC, and add text
- property when string is nil.
- (gnus-article-display-xface): Use it.
-
-2002-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-display-x-face): Check whether valid grey
- face was returned.
- (article-display-x-face): Place image in the right spot.
-
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Get rid of
- stderr.
- (gnus-convert-gray-x-face-to-xpm): Check whether output is valid.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-xmas.el (gnus-xmas-create-image): Take optional
- parameters.
- (gnus-xmas-put-image): Allow non-strings to be passed.
-
- * gnus-art.el (article-display-x-face): Use optional parameters.
-
- * gnus-ems.el (gnus-create-image): Take optional parameters.
-
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Use uncompface.
-
- * compface.el (compface-xbm-p): Removed.
-
- * gnus-ems.el (gnus-article-compface-xbm): Removed.
- (gnus-article-display-xface): Use compface.
-
- * compface.el: New file.
-
- * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Remove quotes.
- (gnus-convert-image-to-x-face-command): Ditto.
- (gnus-random-x-face): Quote argument.
- (gnus-x-face-from-file): Ditto.
-
-2002-01-03 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-request-expire-articles): evaluate
- the expire-group parameter once per article rather than once
- per group; bind `nnmaildir-article-file-name' and `article'
- for convenience. Leave article alone when expire-group
- specifies the current group.
- (nnmaildir--update-nov): be more concurrency-friendly with
- temp file names.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-read-init-file): Cleaned up.
-
-2002-01-03 Dave Love <d.love@dl.ac.uk>
-
- * gnus-start.el (gnus-startup-file-coding-system): Removed.
- (gnus-read-init-file): Don't use it.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-fetch-session): Run hook.
-
-2002-01-03 Dave Love <fx@gnu.org>
-
- * gnus-start.el (gnus-read-init-file): Don't force coding system
- for ~/.gnus.
-
-2002-01-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-send-buffer): Use mm-with-unibyte-current-buffer.
- * nnspool.el (nnspool-request-post): Ditto.
-
- * mm-util.el (mm-use-find-coding-systems-region): New variable.
- (mm-find-mime-charset-region): Use it.
-
-2002-01-03 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-summary-line-format): Added :link.
- * gnus-topic.el (gnus-topic-line-format): Ditto.
- * gnus-sum.el (gnus-summary-dummy-line-format): Ditto.
- * gnus-srvr.el (gnus-server-line-format): Ditto.
- * gnus-group.el (gnus-group-line-format): Ditto.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Use correct syntax for
- :keys, it works on both Emacsen.
-
-2002-01-03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-to-coding-system): Don't setq charset.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-summary-send-map): Fix binding for very-wide.
-
-2002-01-03 Reiner Steib <reiner.steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Menu bar entries for
- very wide reply.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picon-transform-address): Cache stuff.
- (gnus-picon-cache): New variable.
- (gnus-picon-transform-newsgroups): Cache stuff.
-
- * gnus-art.el (gnus-article-reply-with-original): New command.
- (gnus-article-followup-with-original): New command.
-
- * gnus-msg.el (gnus-copy-article-buffer): Take optional BEG and
- END parameters.
- (gnus-summary-followup): Take a list of list of articles.
- (gnus-inews-yank-articles): Allow lists of article/regions.
-
- * gnus-art.el (gnus-article-read-summary-keys): `R' and `F' are no
- longer the usual commands.
-
- * gnus-fun.el (gnus-convert-image-to-gray-x-face): Use pnmnoraw.
- (gnus-convert-gray-x-face-to-xpm): Don't use six parameters to
- shell-command-on-region.
-
-2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-picon.el (gnus-picon-transform-newsgroups): Fix for the case
- "Newsgroups: rec.music.beatles.moderated, rec.music.beatles".
-
-2002-01-03 Steve Youngs <youngs@xemacs.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): XEmacs doesn't
- understand ':keys', wrap it in an featurep 'xemacs.
-
-2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el (gnus-article-display-xface): Show xface in the
- order of headers (Actually, it is called in a reversed order). Add
- 'gnus-image-text-deletable property.
- (gnus-remove-image): Remove text with such a property.
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Don't use
- gnus-put-image.
-
- * gnus-art.el (gnus-article-treat-fold-newsgroups): Replace ", *"
- with ", "
-
-2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el (gnus-convert-gray-x-face-to-xpm): Renamed.
-
- * gnus-art.el (gnus-ignored-headers): Hide all X-Faces.
- (article-display-x-face): Display grey X-Faces.
-
- * gnus-fun.el (gnus-convert-gray-x-face-region): New function.
- (gnus-convert-gray-x-face-to-ppm): Ditto.
- (gnus-convert-image-to-gray-x-face): Ditto.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add a :keys to
- gnus-summary-show-raw-article.
-
-2002-01-02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Display picons in XEmacs without showing text.
-
- * gnus-xmas.el (gnus-xmas-create-image): Don't use
- mm-create-image-xemacs to create xbm glyph, because it deletes
- temporary files.
- (gnus-xmas-put-image): Use end-glyph. Make text invisible.
- (gnus-xmas-remove-image): Make text visible, remove glyph.
-
- * gnus-picon.el (gnus-picon-transform-newsgroups)
- (gnus-picon-transform-address): Insert spec backward, due to the
- incompatibility of gnus-xmas-put-image.
-
-2002-01-02 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-fun.el (gnus-convert-pbm-to-x-face-command): Doc fix.
-
-2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el: Doc fix.
-
- * gnus-art.el: Doc fix.
-
- * gnus-agent.el: Doc fix.
-
-2002-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-diary.el, gnus-delay.el: Fix copyright lines.
-
-2002-01-01 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir--update-nov): automatically parse
- NOV data out of the message again if nnmail-extra-headers has
- changed.
-
-2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-fun.el: New file.
- (gnus-convert-image-to-x-face-command): New variable.
- (gnus-insert-x-face): New function.
- (gnus-random-x-face): Renamed.
- (gnus-x-face-from-file): Renamed.
-
- * gnus-art.el (gnus-body-boundary-delimiter): Changed default to
- "_".
- (gnus-body-boundary-delimiter): Typo fix.
-
-2002-01-02 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-article-treat-body-boundary): Handle nil.
- (gnus-body-boundary-delimiter): Fix type.
-
-2002-01-01 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-treat-buttonize, gnus-treat-buttonize-head)
- (gnus-treat-emphasize, gnus-treat-strip-cr)
- (gnus-treat-leading-whitespace, gnus-treat-hide-headers)
- (gnus-treat-hide-boring-headers, gnus-treat-hide-signature)
- (gnus-treat-fill-article, gnus-treat-hide-citation)
- (gnus-treat-hide-citation-maybe)
- (gnus-treat-strip-list-identifiers, gnus-treat-strip-pgp)
- (gnus-treat-strip-pem, gnus-treat-strip-banner)
- (gnus-treat-highlight-headers, gnus-treat-highlight-citation)
- (gnus-treat-date-ut, gnus-treat-date-local)
- (gnus-treat-date-english, gnus-treat-date-lapsed)
- (gnus-treat-date-original, gnus-treat-date-iso8601)
- (gnus-treat-date-user-defined, gnus-treat-strip-headers-in-body)
- (gnus-treat-strip-trailing-blank-lines)
- (gnus-treat-strip-leading-blank-lines)
- (gnus-treat-strip-multiple-blank-lines)
- (gnus-treat-unfold-headers, gnus-treat-fold-headers)
- (gnus-treat-fold-newsgroups, gnus-treat-overstrike)
- (gnus-treat-display-xface, gnus-treat-display-smileys)
- (gnus-treat-from-picon, gnus-treat-mail-picon)
- (gnus-treat-newsgroups-picon, gnus-treat-body-boundary)
- (gnus-treat-capitalize-sentences, gnus-treat-fill-long-lines)
- (gnus-treat-play-sounds, gnus-treat-translate)
- (gnus-treat-x-pgp-sig): Doc fix, add link to manual.
-
- * gnus-art.el (gnus-body-boundary-delimiter): New variable.
- (gnus-article-treat-body-boundary): Use it.
-
- * message.el (message-mode): Fix doc.
- (message-mode-menu): Fix names.
-
-2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-first-subject): Really go to unseen
- articles.
-
- * gnus-picon.el (gnus-picon-find-face): Search MISC for all types.
- (gnus-picon-transform-address): Search for unknown faces as well.
- (gnus-picon-find-face): Don't search "news" for MISC.
- (gnus-picon-user-directories): Changed default back to exclude
- "unknown".
-
- * gnus-sum.el (gnus-summary-hide-all-threads): Reversed logic.
-
- * gnus-picon.el (gnus-picon-find-face): Search through all
- databases.
- (gnus-picon-find-face): New implementation.
-
- * gnus-topic.el (gnus-topic-goto-previous-topic): New command and
- keystroke.
- (gnus-topic-goto-next-topic): Ditto.
-
- * gnus.el (gnus-summary-line-format): Changed default.
-
- * nnmail.el (nnmail-extra-headers): Change default.
-
- * gnus-sum.el (gnus-extra-headers): Change default.
-
- * message.el (message-news-other-window): Changed "news" to
- "posting".
- (message-news-other-frame): Ditto.
- (message-do-send-housekeeping): Ditto.
-
- * gnus-sum.el (gnus-summary-maybe-hide-threads): Use predicate
- function.
- (gnus-article-unread-p): New function.
- (gnus-article-unseen-p): New function.
- (gnus-dead-summary-mode-map): Typo.
-
- * gnus-util.el (gnus-make-predicate): New function.
- (gnus-make-predicate-1): New function.
-
- * gnus-sum.el: New function.
- (gnus-map-articles): New function.
-
- * gnus-art.el (gnus-treat-fold-headers): New variable.
- (gnus-article-treat-fold-headers): New command and keystroke.
-
- * gnus-sum.el (gnus-dead-summary-mode-map): Clean up.
- (gnus-dead-summary-mode-map): Bind q to bury-buffer.
-
-2002-01-01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-fcc-externalize-attachments): New variable.
- (message-do-fcc): Use it.
-
- * gnus-msg.el (gnus-gcc-externalize-attachments): New variable.
- (gnus-inews-do-gcc): Use it.
-
- * mml.el (mml-tweak-sexp-alist): New variable.
- (mml-externalize-attachments): New variable.
- (mml-tweak-part): Use mml-tweak-sexp-alist.
- (mml-tweak-externalize-attachments): New function.
-
-2002-01-01 Steve Youngs <youngs@xemacs.org>
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Uncomment
- 'set-glyph-face' so x-face back/foreground can be set.
-
-2001-12-31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-fix-before-sending): Fix a typo.
-
-2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-smiley): Renamed command.
- (gnus-article-remove-images): New command and keystroke.
-
- * gnus-sum.el (gnus-summary-toggle-smiley): Removed.
-
- * smiley-ems.el (gnus-smiley-display): Removed.
-
- * gnus.el (gnus-version-number): Update version.
-
- * message.el (message-text-with-property): Renamed and moved
- here.
- (message-fix-before-sending): Highlight invisible text and place
- point there.
-
-2002-01-01 02:32:53 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.04 is released.
-
-2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-delay.el (gnus-delay-send-queue): Renamed.
-
- * gnus-art.el (gnus-ignored-headers): More headers,
-
- * ietf-drums.el (ietf-drums-parse-addresses): Use `error' instead
- of `scan-error', since XEmacs doesn't seem to support that.
-
-2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-best-unread-article): Take a prefix
- arg.
- (gnus-summary-best-unread-subject): Ditto.
- (gnus-summary-best-unread-subject): No, don't.
- (gnus-summary-better-unread-subject): New command.
-
- * gnus-xmas.el (gnus-xmas-put-image): Insert the string itself.
-
- * lpath.el ((featurep 'xemacs)): fbind url function.
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Use data, not
- buffer.
- (gnus-xmas-remove-image): Implementation that does something.
- (gnus-xmas-article-display-xface): Mark images properly.
-
- * gnus-art.el (gnus-mime-print-part): Use mm-temp-directory.
-
-2001-12-31 Florian Weimer <fw@deneb.enyo.de>
-
- * gnus.el (gnus): Warn if trying to run Gnus un-byte-compiled.
-
-2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-line-format): Added %O to the default
- value.
-
- * gnus-util.el (gnus-text-with-property): The smallest point is
- point-min.
-
- * smiley-ems.el (smiley-region): Return images.
- (gnus-smiley-display): Allow toggling.
- (smiley-region): Use text properties, not overlays.
-
- * gnus-xmas.el (gnus-xmas-remove-image): New function, not
- implemented yet.
-
- * smiley-ems.el (smiley-update-cache): Check for valid types.
-
- * gnus-art.el (gnus-with-article-buffer): New macro.
-
- * gnus-picon.el (gnus-picon-transform-newsgroups): Keep the
- strings as well as the glyphs.
- (gnus-picon-transform-address): Ditto.
- (gnus-picon-insert-glyph): Ditto.
- (gnus-picon-transform-newsgroups): Toggle.
- (gnus-picon-transform-address): Toggle.
-
- * gnus-ems.el (gnus-remove-image): New function.
- (gnus-put-image): Take an optional string.
-
- * gnus-util.el (gnus-text-with-property): New function.
-
- * gnus-art.el (gnus-delete-images): New function.
-
- * gnus-ems.el (gnus-article-display-xface): Mark and store image.
-
- * gnus-art.el (gnus-article-wash-status-entry): Renamed.
- (gnus-article-wash-status): Use it.
- (gnus-signature-toggle): Clean up.
- (gnus-add-wash-status): New function.
- (gnus-delete-wash-status): New function.
- (gnus-article-hide-text-type): Use them throughout.
- (gnus-add-image): New function.
-
- * gnus-ems.el (gnus-article-display-xface): Use new interface.
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Use new
- interface.
-
- * gnus-art.el (article-display-x-face): Cleaned up.
-
- * rfc2047.el (rfc2047-field-value): New function.
-
- * mail-parse.el (mail-header-field-value): New alias.
-
- * gnus-art.el (gnus-mime-print-part): Fix typos.
-
- * smiley-ems.el (gnus-smiley-file-types): New variable.
- (smiley-update-cache): Use it.
- (smiley-regexp-alist): Suffix-less smiley names.
- (smiley-regexp-alist): Added more smileys.
-
- * gnus-sum.el (gnus-print-buffer): Made into own function.
- (gnus-summary-print-article): Use it.
-
- * mailcap.el (mailcap-mime-info): Actually return the bit that we
- looked for when REQUEST is a string.
-
- * gnus-art.el (gnus-mime-button-commands): Add printing
- keystroke.
- (gnus-mime-copy-part): Doc fix.
- (gnus-mime-print-part): New command.
-
-2001-12-31 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-parse-fetch): Notice empty flags responses. From
- Nic Ferrier <nferrier@tf1.tapsellferrier.co.uk>.
-
-2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-picon.el (gnus-treat-from-picon): Autoload.
- (picon): Fix doc.
-
- * gnus-win.el (gnus-window-to-buffer): gnus-picon-buffer-name no
- longer exists. Remove those codes.
- * gnus.el (gnus-use-picons): Ditto.
-
-2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-treat-fold-newsgroups): Don't
- infloop.
-
- * gnus-sum.el (t): New `W D' map.
-
- * gnus-art.el (gnus-treat-fold-newsgroups): New variable.
- (gnus-article-treat-body-boundary): Clean up.
- (gnus-body-boundary-face): Removed.
- (gnus-article-goto-header): Moved here.
- (gnus-article-goto-header): Allow better regexps.
- (gnus-article-treat-fold-newsgroups): New command.
-
- * gnus-sum.el (gnus-summary-move-article): We have to select an
- article to give `gnus-read-move-group-name' an opportunity to
- suggest an appropriate default.
-
- * rfc2047.el (rfc2047-fold-line): New function.
- (rfc2047-unfold-line): Ditto.
- (rfc2047-fold-region): Don't fold just after the header name.
-
- * mail-parse.el (mail-header-fold-line): New alias.
- (mail-header-unfold-line): Ditto.
-
- * gnus-art.el (gnus-body-boundary-face): Renamed.
- (gnus-article-treat-body-boundary): Use it.
- (gnus-article-treat-body-boundary): Use an invisible header and a
- line of underline characters.
-
-2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ietf-drums.el (ietf-drums-parse-addresses): Recover from errors.
-
- * gnus-picon.el (gnus-picon-transform-address): Skip bad addresses.
- (gnus-picon-split-address): New function.
- (gnus-picon-find-face): Use it.
- (gnus-picon-transform-address): Use it. Set first to t for each
- address.
-
- * gnus-art.el (gnus-with-article-headers): Move to here. Define
- the macro then use it.
- (gnus-treatment-function-alist): Treat picons earlier.
-
-2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-body-separator-face): New variable.
- (gnus-article-treat-body-boundary): Use a blank, colored line.
-
- * gnus-picon.el (gnus-picon-find-face): Look into misc/MISC as
- well.
-
- * gnus-art.el (gnus-treat-body-boundary): New variable.
- (gnus-article-treat-unfold-headers): Use helper macro.
- (gnus-article-treat-body-boundary): New command.
-
- * gnus.el (gnus-logo-color-style): Change the default color.
- (gnus-splash-face): Gray, gray.
-
- * gnus-xmas.el (gnus-xmas-group-startup-message): Use general
- colors.
-
- * gnus.el (gnus-logo-color-alist): Moved here and renamed.
- (gnus-logo-color-style): Ditto.
- (gnus-logo-colors): Ditto.
-
- * gnus-picon.el (gnus-picon-create-glyph): Cache glyphs.
-
- * gnus-art.el (gnus-treat-newsgroups-picon): New variable.
-
- * gnus-picon.el (gnus-treat-newsgroups-picon): New function.
- (gnus-picon-transform-newsgroups): New function.
-
- * ietf-drums.el (ietf-drums-parse-addresses): Accept a nil
- string.
-
- * gnus-picon.el (gnus-treat-mail-picon): Renamed.
-
- * gnus-art.el (gnus-treat-cc-picon): New variable.
- (gnus-treat-mail-picon): Renamed.
-
- * gnus-picon.el: New implementation.
- (gnus-picon-find-face): Renamed.
- (gnus-treat-from-picon): Use it.
- (gnus-picon-transform-address): Renamed.
- (gnus-treat-from-picon): Use it.
- (gnus-picon-create-glyph): Renamed.
- (gnus-picon-transform-address): Use it.
- (gnus-treat-cc-picon): New command.
-
- * mm-decode.el (mm-create-image-xemacs): Separated out into
- function.
- (mm-get-image): Use it.
-
- * gnus-art.el (gnus-treat-display-picons): Simplify.
- (gnus-treat-from-picon): Renamed.
-
- * gnus-ems.el (gnus-create-image): New function.
- (gnus-put-image): New function.
-
- * gnus-art.el (gnus-article-treat-unfold-headers): Doc fix.
- (gnus-with-article-headers): New macro.
- (gnus-article-goto-header): New function.
-
- * gnus-xmas.el (gnus-image-type-available-p): New function.
-
- * gnus-ems.el (gnus-image-type-available-p): New function.
-
-2001-12-30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-check-group): Find the correct tag, because
- xml.el is changed.
-
-2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-article-treat-unfold-headers): Only fold when
- lines are shorter than the window width.
- (gnus-ignored-headers): More headers.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-unfold-lines): New variable.
- (gnus-treat-unfold-headers): Renamed.
- (gnus-article-treat-unfold-headers): New command and keystroke.
-
- * rfc2047.el (rfc2047-encode-message-header): Clean up.
-
- * gnus-int.el (gnus-open-server): Mark quit-ed server as denied.
-
-2001-12-29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * sha1-el.el (sha1-use-external): New variable.
- (sha1-region): Use it.
- (sha1-string): Ditto.
-
- * dgnushack.el (dgnushack-compile): Compile gnus-picon for Emacs.
- * gnus-picon.el: Less warnings when compile.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-picon.el (gnus-picons-news-directories): Removed obsolete
- alias.
- (gnus-picons-database): Default to list.
- (gnus-picons-lookup-internal): Use it.
-
- * nnmail.el (nnmail-article-group): Default nnmail-split-methods
- to "bogus".
-
- * gnus-win.el (gnus-configure-windows-hook): New hook.
-
-2001-12-29 Sascha L\e,A|\e(Bdecke <sascha@meta-x.de>
-
- * gnus-win.el (gnus-configure-windows): Minimize tree buffer.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-update-marks): Don't uncompress the seen
- lists.
- (gnus-select-newsgroup): Don't append; push.
- (gnus-adjust-marked-articles): Remove obsolete ranges from
- `seen'.
- (gnus-update-marks): Clean up.
- (gnus-select-newsgroup): Don't stomp gnus-newsgroup-seen.
-
-2001-12-29 Frank Schmitt <usereplyto@Frank-Schmitt.net>
-
- * gnus-sum.el (gnus-summary-limit-to-age): Allow negative days.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-auto-select-subject): New variable.
- (gnus-summary-best-unread-subject): New function.
- (gnus-summary-best-unread-article): Use it.
- (gnus-summary-first-unseen-subject): New function and command.
-
- * gnus-art.el (gnus-treatment-function-alist): Emphasize after
- other treatments.
-
- * gnus-util.el (gnus-put-overlay-excluding-newlines): New
- function.
-
- * gnus-art.el (gnus-article-show-hidden-text): Remove the type
- from the list of hidden types.
-
- * mm-view.el (mm-inline-text): Ditto.
- (mm-inline-text): Ditto.
- (mm-w3-prepare-buffer): Ditto.
-
- * gnus-art.el (article-wash-html): Inhibit more remote fetching.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-ignored-headers): Added more headers.
-
-2001-12-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Compute the prefix
- once.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-server-browse-in-group-buffer): Doc fix.
-
-2001-12-28 Simon Josefsson <jas@extundo.com>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Fix typo. From
- Jesper Harder <harder@ifa.au.dk>.
-
-2001-12-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-select-newsgroup): Make
- `gnus-newsgroup-unseen' sorted. Make `gnus-newsgroup-unseen'
- contain all articles (instead of none) when no seen marks have
- been set for the group.
- (gnus-update-marks): Use `gnus-range-add' on a uncompressed list
- instead, it seems to result in shorter ranges.
-
-2001-12-26 11:00:00 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-iso-8859-x-to-15-region): Use
- insert-before-markers.
-
-2001-12-26 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el (nnmaildir-save-mail): create the destination
- groups if they do not exist.
-
-2001-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-sha1-with-openssl): Remove unused variable.
-
-2001-12-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Call
- gnus-group-real-name.
-
- * gnus-sum.el (gnus-decode-encoded-word-methods): Backslash paren.
- (gnus-newsgroup-variables): Ditto.
-
- * gnus.el (gnus-group-prefixed-name): If group name is prefixed,
- return it.
-
-2001-12-21 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.el (gnus-valid-select-methods): Include nnmaildir.
- * nnmaildir.el (top-level): Add commentary.
- (nnmaildir-version): Indicate that nnmaildir is now a standard
- part of Gnus, not separately released.
-
-2001-12-21 08:00:00 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-art.el, gnus-picon.el, gnus-sieve.el, gnus-sum.el:
- * gnus-xmas.el, imap.el, mailcap.el, mm-util.el, nnfolder.el:
- * nnheader.el, nnmail.el: Nil/NIL vs. nil.
-
-2001-12-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmaildir.el: Copyright changes. Require cl only at compile time.
-
-2001-12-20 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (top-level): Don't require cl. Suggested by ShengHuo
- ZHU <zsh@cs.rochester.edu>.
- (nnimap-close-group): Don't quote KEYLIST items. Suggested by
- Brian P Templeton <bpt@tunes.org>.
-
-2001-12-19 17:00:00 Paul Jarc <prj@po.cwru.edu>
-
- * nnmaildir.el: New file.
-
-2001-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-type-alist): Move forward to the end.
-
-2001-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-find-subscribed-addresses): Replace `mapc' with
- `dolist'.
-
-2001-12-19 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-frames-on-display-list): New function.
- (gnus-get-buffer-window): Use it.
-
-2001-12-19 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnwarchive.el (nnwarchive-mail-archive-xover): Fix the regexp.
-
-2001-12-18 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-get-buffer-window): Use gnus-delete-if.
-
-2001-12-18 11:00:00 Harald Meland <Harald.Meland@usit.uio.no>
-
- * gnus-win.el (gnus-get-buffer-window): New function.
- (gnus-all-windows-visible-p): Use it.
-
- * gnus-util.el (gnus-horizontal-recenter)
- (gnus-horizontal-recenter, gnus-horizontal-recenter)
- (gnus-horizontal-recenter, gnus-set-window-start): Use it.
-
- * gnus-score.el (gnus-score-insert-help): Use it.
-
- * gnus-salt.el (gnus-tree-recenter, gnus-generate-tree)
- (gnus-generate-tree, gnus-highlight-selected-tree)
- (gnus-highlight-selected-tree, gnus-tree-highlight-article): Use
- it.
-
- * gnus-art.el (gnus-article-set-window-start)
- (gnus-mm-display-part, gnus-request-article-this-buffer)
- (gnus-button-next-page, gnus-button-prev-page)
- (gnus-article-button-next-page, gnus-article-button-prev-page):
- Use it.
-
-2001-12-18 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog, ChangeLog.1, nnwfm.el, smiley.el:
- * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
- * mml1991.el, nnultimate.el: Removed buffer-file-coding-system tag.
-
-2001-12-18 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ChangeLog, ChangeLog.1, nnwfm.el, gnus-smiley.el:
- * gnus-cite.el, gnus-delay.el, gnus-spec.el, message.el:
- * mml1991.el, nnultimate.el: Add `coding'.
-
-2001-12-17 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog: changed coding to buffer-file-coding-system
- * ChangeLog.1: same
- * nnwfm.el: same
- * gnus-smiley.el: same
- * gnus-cite.el: moved -*- magic cookie -*- to Local Variables
- * gnus-delay.el: same
- * gnus-spec.el: same
- * message.el: same
- * mml1991.el: same
- * nnultimate.el: same
-
-2001-12-16 Simon Josefsson <jas@extundo.com>
- Inspired by code by Dirk Meyer <dischi@tzi.de>.
-
- * gnus-sum.el (gnus-summary-muttprint-program): New variable.
- (gnus-summary-save-map): Add muttprint.
- (gnus-summary-make-menu-bar): Ditto.
- (gnus-summary-muttprint): New function.
-
- * gnus-art.el (gnus-summary-pipe-to-muttprint): New function.
-
-2001-12-14 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * uudecode.el (uudecode-decode-region-internal): Speedup by using
- temporary list instead of buffer.
-
- * mm-url.el (executable-find): autoload.
-
-2001-12-12 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-mlspl.el (gnus-group-split-fancy): Doc fix (add reference
- to variable, follow doc-string conventions).
-
-2001-12-13 Josh Huber <huber@alum.wpi.edu>
-
- * gnus-cus.el (gnus-extra-topic-parameters): added topic parameter
- subscribe-level
- * gnus-topic.el (gnus-subscribe-topics): use it.
-
-2001-12-13 22:00:00 Sean Neakums <sneakums@zork.net> (tiny change)
-
- * gnus-msg.el (gnus-summary-mail-forward): Forward all marked
- messages.
-
- * gnus-uu.el (gnus-uu-grab-articles): Set gnus-current-article to
- nil after shooting down the gnus-original-article-buffer.
-
-2001-12-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * uudecode.el (uudecode-use-external): New variable.
- (uudecode-decode-region): Automatically detect external program.
-
- * binhex.el (binhex-use-external): New variable.
- (binhex-decode-region-internal): New function.
- (binhex-decode-region): Automatically detect external program.
-
- * mm-uu.el (mm-uu-decode-function,mm-uu-binhex-decode-function):
- Use them.
-
-2001-12-12 Simon Josefsson <jas@extundo.com>
-
- * nnvirtual.el (nnvirtual-always-rescan)
- (nnvirtual-component-regexp): Fix doc.
-
- * nnoo.el (defvoo): Add doc to defvoo variables.
-
- * nnml.el (nnml-directory, nnml-active-file)
- (nnml-newsgroups-file, nnml-get-new-mail, nnml-nov-is-evil)
- (nnml-marks-is-evil, nnml-filenames-are-evil)
- (nnml-prepare-save-mail-hook, nnml-inhibit-expiry): Fix doc.
-
- * nnmh.el (nnmh-directory, nnmh-get-new-mail)
- (nnmh-prepare-save-mail-hook, nnmh-be-safe): Fix doc.
- (nnmh-possibly-change-directory): Use `nnheader-report' instead of
- `error'.
-
- * nnmbox.el (nnmbox-mbox-file, nnmbox-active-file)
- (nnmbox-get-new-mail, nnmbox-prepare-save-mail-hook):
-
- * nnfolder.el (nnfolder-directory, nnfolder-active-file)
- (nnfolder-newsgroups-file, nnfolder-get-new-mail)
- (nnfolder-save-buffer-hook, nnfolder-inhibit-expiry)
- (nnfolder-nov-is-evil, nnfolder-marks-is-evil): Fix doc.
-
- * nnbabyl.el (nnbabyl-mbox-file, nnbabyl-active-file)
- (nnbabyl-get-new-mail, nnbabyl-prepare-save-mail-hook): Fix doc.
-
- * imap.el, nnimap.el: Fix indentation.
-
- * gnus-sieve.el (gnus-sieve-article-add-rule): Autoload it.
-
-2001-12-12 Didier Verna <didier@xemacs.org>
-
- * gnus-msg.el (gnus-group-news): New function.
- * gnus-group.el (gnus-group-mode-map): bind it to `i'.
- * gnus-group.el (gnus-group-make-menu-bar): add a menu item for it.
- * gnus-salt.el (gnus-carpal-group-buffer-buttons): add a button
- for it.
- * gnus-msg.el (gnus-summary-news-other-window): New function.
- * gnus-msg.el ((gnus-summary-send-map "S" gnus-summary-mode-map)):
- bind it to `i'.
- * gnus-sum.el (gnus-summary-mode-map): bind it to `i'.
- * gnus-sum.el (gnus-summary-make-menu-bar): add a menu item for it.
- * gnus-salt.el (gnus-carpal-summary-buffer-buttons): add a button
- for it (called with a prefix).
- * gnus-msg.el (gnus-configure-posting-styles): add an optional
- group-name argument.
- * gnus-msg.el (gnus-setup-message): use it.
-
-2001-12-12 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Fix doc.
-
-2001-12-10 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mime-to-mml): Remove Content-Disposition too.
-
-2001-12-09 08:00:00 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-sum.el (gnus-summary-buffer-name): Decode group name.
- * gnus-group.el (gnus-group-name-decode): Decode unibyte
- strings only.
-
-2001-12-08 Nevin Kapur <nevin@jhu.edu>
-
- * nnmail.el (nnmail-fancy-expiry-targets): New variable.
- (nnmail-fancy-expiry-target): Use it.
- Suggestions from Simon Josefsson <jas@extundo.com>.
-
-2001-12-07 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Recount lines if not exist.
-
-2001-12-07 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnwfm.el (nnwfm-create-mapping): Use gnus-url-unhex-string.
-
- * gnus-util.el (gnus-url-unhex-string): Move here.
-
-2001-12-07 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-decode-entities-unibyte-string): Use
- mm-url-decode-entities-nbsp.
-
- * nnlistserv.el, nnultimate.el, nnwarchive.el, nnweb.el:
- * webmail.el, nnwfm.el: Use mm-url.
-
- * mm-url.el (mm-url-fetch-form): Move from nnweb.
- (mm-url-remove-markup): Move from nnweb.
- (mm-url-fetch-simple): Move from webmail.
-
- * nnslashdot.el (nnslashdot-request-post): Use mm-url-fetch-form.
-
-2001-12-07 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-print-truncate-and-quote): New function.
- (gnus-summary-print-article): Use it.
-
- * gnus-util.el (gnus-replace-in-string): Typo.
-
-2001-12-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-replace-in-string): Removed.
-
- * gnus-util.el (gnus-replace-in-string): New function.
- (gnus-mode-string-quote): Use it.
-
- * nnrss.el (nnrss-format-string): Use gnus-replace-in-string.
- * nnwfm.el (nnwfm-create-mapping): Ditto.
-
-2001-12-06 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-compile): nnrss.el and
- nnslashdot.el don't depend on nnweb, url, w3.
-
- * nnrss.el: Use mm-url.
-
-2001-12-06 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el (mm-url-insert-file-contents): Support file:.
-
-2001-12-05 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el: Lower case for the description line. Sync from the
- Emacs CVS.
-
-2001-12-05 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-find-new-groups): Fix doc.
- From: Stefan Monnier <monnier@cs.yale.edu>
-
-2001-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-inline-text): Decode a charset-encoded rich text.
-
-2001-12-04 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el: Require executable.
- Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
-
-2001-12-03 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-munge-message-separator): Only use valid date.
- Trivial patch from Michael Welsh Duggan <md5i@cs.cmu.edu>.
-
- * Makefile.in: gnus-load.elc may not be generated.
-
-2001-12-03 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-url.el: New file.
- * nnslashdot.el: Use it.
- * mm-extern.el (mm-extern-url): Use it.
-
-2001-12-01 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-save-article): Nix
- gnus-display-mime-function and gnus-article-prepare-hook.
-
- * gnus-spec.el (gnus-parse-complex-format): Properly handle %C at
- the beginning of lines.
- (gnus-complex-form-to-spec): Ditto.
-
-2001-12-01 08:00:00 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-make-mft): Fix the m-s-a-file regexp.
-
-2001-11-30 21:00:00 Paul Jarc <prj@po.cwru.edu>
-
- * message.el: New variable message-subscribed-address-file;
- use it in message-make-mft.
-
-2001-11-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-tab-body-function): Set to nil.
- (message-tab): Use text-mode-map or global-map.
- Suggested by Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>.
-
-2001-11-30 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-fetch-headers): Use gnus-range-add
- instead of gnus-union, for speed. Suggested by Christoph Conrad
- <christoph.conrad@gmx.de>.
- (gnus-agent-fetch-group-1): Add verbose message.
-
-2001-11-29 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-write-active): Make sure sym is a cons
- of integers.
-
-2001-11-29 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-newgroups-header-regexp)
- (message-completion-alist, message-tab-body-function): Use
- defcustom rather than defvar.
- (message-tab): Mention `message-tab-body-function' in doc.
- Suggested by Karl Eichwalder.
-
-2001-11-28 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-uu.el (gnus-uu-save-article): Use #part instead of #mml.
-
-2001-11-28 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-find-nov-line): Don't use macro
- gnus-delete-line.
-
- * gnus-group.el (gnus-group-name-decode): Defun instead of defsubst.
- (gnus-group-name-charset): Ditto.
-
- * gnus-util.el (gnus-buffer-live-p): Ditto.
-
-2001-11-28 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * sieve-manage.el (sieve-manage-stream-alist): Backslash before
- open parenthesis in doc.
- (sieve-manage-authenticator-alist): Typo in doc.
- * imap.el (imap-authenticator-alist): Typo in doc.
- (imap-stream-alist): Backslash.
-
- * gnus-sum.el (gnus-summary-limit-to-author): Missing arguments.
- Thanks to david.goldberg6@verizon.net (David S. Goldberg)
-
-2001-11-27 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-mode): Add LOCAL for add-hook.
-
- * message.el (message-mode): make-local-hook is harmless in Emacs 21.
-
- * gnus-msg.el (gnus-configure-posting-styles): use
- make-local-hook. Add LOCAL for add-hook.
-
-2001-11-27 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-mode): Use `make-local-hook' unless
- obsolete.
- Patch by Katsumi Yamaoka <yamaoka@jpl.org>.
-
-2001-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el: Remove sha1.el and base64.el stuff.
-
-2001-11-26 Didier Verna <didier@xemacs.org>
-
- * nnmbox.el (nnmbox-create-mbox): create the mbox file directory
- if needed.
-
-2001-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-tamago-not-in-use-p): New function.
- (message-strip-forbidden-properties): Use it.
-
-2001-11-26 Didier Verna <didier@xemacs.org>
-
- * gnus-start.el (gnus-check-first-time-used): only check for
- existence of .el[d] files.
-
-2001-11-25 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-coding-system-priorities): Add backslash in the doc.
-
- * message.el (message-setup-1): Clean up mc-*.
-
-2001-11-25 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-directory-sep-char-regexp): New variable.
- * gnus-score.el (gnus-score-find-bnews): Use it.
-
- * gnus-sum.el (gnus-summary-limit-to-subject): An exclusion version.
- (gnus-summary-limit-to-author): Ditto.
- (gnus-summary-limit-to-extra): Ditto.
- (gnus-summary-find-matching): Support not-matching argument.
-
-2001-11-25 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-wash-subject): Use `insert' rather than
- `insert-string', which is deprecated.
-
-2001-11-24 Simon Josefsson <jas@extundo.com>
-
- * mm-encode.el (mm-encode-content-transfer-encoding): Fix error
- message. (Gnus does not "default" to using 8bit for the message,
- it default to use 8bit encoding and the user-supplied CTE
- value. Calling this behaviour "treating it as 8bit" is perhaps
- better.)
-
- * mm-bodies.el (mm-body-encoding): Intern encoding if needed
- (compare mm-charset-to-coding-system).
-
-2001-11-23 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * canlock.el (canlock-sha1-with-openssl): Use unibyte
- buffer. Correctly decode hex.
-
-2001-11-21 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-category-insert-line): Convert category
- names to strings.
-
-2001-11-20 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (sha1): eval-and-compile.
-
-2001-11-20 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-allow-no-recipients): New variable.
- (message-send): Use it, customize the prompting when posting to
- Gcc/Fcc alone.
-
-2001-11-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-coding-system-priorities): New variable.
- (mm-sort-coding-systems-predicate): New function.
- (mm-find-mime-charset-region): Resort coding systems if needed.
- Suggested by Katsumi Yamaoka <yamaoka@jpl.org>.
-
-2001-11-20 Didier Verna <didier@xemacs.org>
-
- * gnus-group.el (gnus-group-make-help-group): new optional
- argument to control the error behavior.
- * gnus-start.el (gnus-check-first-time-used): use it to avoid
- erroring.
-
-2001-11-19 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-mode-map): Use C-c C-f C-i for Importance:
- instead of C-c C-u. Suggested by Per Abrahamsen
- <abraham@dina.kvl.dk>.
-
-2001-11-18 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-read-folder): Use group instead of
- nnfolder-current-group.
- Suggested by K\e,Ba\e(Broly L\e,Bu\e(Brentey <lorentey@elte.hu>.
-
-2001-11-17 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-send): Ask user if Fcc/Gcc should be
- performed when no other sender was specified.
- Suggested by prj@po.cwru.edu (Paul Jarc).
-
-2001-11-17 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-mode, message-mode-map): Use C-c C-u for
- Importance: instead of C-c C-p (used by SC).
-
-2001-11-16 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-insert-importance-high)
- (message-insert-importance-low): Save point.
-
- * mail-source.el (mail-source-fetch-imap): Fix BODY.PEEK return
- value.
-
-2001-11-16 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-strip-special-text-properties): New option.
- (message-strip-forbidden-properties): Obey it.
-
-2001-11-14 Sam Steingold <sds@gnu.org>
-
- * gnus-score.el: Fixed some doc strings to properly quote symbols.
-
-2001-11-15 Simon Josefsson <jas@extundo.com>
-
- Support "Importance:" header in Message.
-
- * message.el (message-mode-map): Bind C-c C-p to
- `message-insert-or-toggle-importance'
- (message-mode-menu): Add message-insert-importance-{high,low}.
- (message-insert-importance-high, message-insert-importance-low)
- (message-insert-or-toggle-importance): New functions.
- (message-tool-bar-map): Add {un,}important.
- (message-mode): Doc fix.
-
-2001-11-15 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-tool-bar-map): Fix attach toolbar tooltip.
-
- * mml.el (mml-menu): Fix toolbar tooltip.
-
-2001-11-15 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-save-marks): gnus-prin1 takes one argument.
- * nnml.el (nnml-save-marks): Ditto.
-
- * gnus-sum.el (gnus-newsgroup-variables): Fix doc.
-
-2001-11-15 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-save-marks):
- * nnfolder.el (nnfolder-save-marks): Use `gnus-prin1'.
- Suggested by Istvan Marko <mi-gnus@imarko.dhs.org>.
-
-2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-article-wash-status-strings): Use
- `copy-sequence', not `copy-seq'.
-
-2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-art.el (gnus-article-wash-status-strings): New constant.
- (gnus-gnus-article-wash-status-entry): New function.
- (gnus-article-wash-status): Use it.
-
-2001-11-13 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml1991.el: Add coding header.
-
-2001-11-12 Simon Josefsson <jas@extundo.com>
-
- * mml1991.el (mml1991-use, mml1991-function-alist): New variables.
- (mml1991-gpg-sign, mml1991-gpg-encrypt): Renamed, from
- `mml1991-sign' and `mml1991-encrypt'.
- (mml1991-encrypt, mml1991-sign): New glue functions.
- (mml1991-mailcrypt-sign, mml1991-mailcrypt-encrypt): New functions.
-
- * mml.el (mml-mode-map): `C-c RET o' map for PGP.
- (mml-menu): Add PGP to menu.
-
- * mml-sec.el (top-level): Require mml1991. Don't require smime.
- (mml-sign-alist, mml-encrypt-alist): Add "pgp".
- (mml-pgp-sign-buffer, mml-pgp-encrypt-buffer)
- (mml-secure-sign-pgp, mml-secure-encrypt-pgp): New glue functions.
-
- * mml2015.el: Mention RFC 3156.
-
-2001-11-12 Sascha L\e,A|\e(Bdecke <sascha@meta-x.de>
-
- * mml1991.el: New file.
-
-2001-11-12 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-auto-subscribed-groups): Use ^nnml.
-
-2001-11-12 Michael Cook <Michael.Cook@cisco.com>
-
- * gnus-sum.el (gnus-summary-move-article): Use number-to-string.
-
-2001-11-11 Simon Josefsson <jas@extundo.com>
-
- * message.el (top-level): Autoload sha1.
- (message-canlock-generate): Use sha1 instead of md5 (sha1 used by
- canlock, no need to require two different hash algs). Suggested
- by Ferenc Wagner <wferi@bolyai1.elte.hu>.
-
-2001-11-09 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus.el (gnus-local-domain): Fix doc.
-
-2001-11-09 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-point-in-header-p): New function.
- (message-do-auto-fill): Use it.
- (message-beginning-of-line): New function. Goes to beginning of
- header value (i.e., end of header name), or to beginning of line
- if already at beginning of value. Behaves like
- `beginning-of-line' when in message body.
- (message-mode-map): Bind it.
-
-2001-11-08 Simon Josefsson <jas@extundo.com>
-
- * gnus-msg.el (gnus-posting-styles): Add doc.
-
-2001-11-07 Simon Josefsson <jas@extundo.com>
-
- * gnus-sieve.el (gnus-sieve-generate): Don't invoke sieve-mode.
-
- * sieve-mode.el (sieve-control-commands-face)
- (sieve-control-commands-face, sieve-action-commands-face)
- (sieve-test-commands-face, sieve-tagged-arguments-face): New
- faces.
- (sieve-font-lock-keywords): Use them.
- (sieve-mode): Only set font-lock-defaults in emacs.
-
- * gnus-art.el (gnus-default-article-saver): Add
- gnus-summary-save-body-in-file.
- (gnus-summary-write-to-file): Fix doc.
-
-2001-11-07 Simon Josefsson <jas@extundo.com>
-
- * gnus-art.el (gnus-treat-highlight-signature): Add cross
- reference to the correct chapter in the manual.
-
- * mml.el (mml-mode): Add cross reference to Emacs MIME manual.
- Suggested by "Golubev I. N." <gin@mo.msk.ru>.
-
-2001-11-07 06:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Bind mail-header-separator.
-
-2001-11-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el: Always require canlock.
- (message-ignored-supersedes-headers): Include Cancel-Lock and
- Cancel-Key.
- (message-insert-canlock): Don't require canlock.
- (message-cancel-news): Don't check whether canlock is available.
- (message-supersede): Support cancel-locks.
-
- * gnus-art.el: Don't autoload canlock.
-
-2001-11-06 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch-imap): ASYNC param.
- From: <andre@slamdunknetworks.com>
-
-2001-11-06 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * many files: Fix copyright lines.
-
-2001-11-05 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Use mm-with-unibyte-current-buffer.
- Suggested by Dave Love <fx@gnu.org>.
-
-2001-11-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-kill-buffer): Remove auto-save file after
- confirm.
-
- * message.el (message-send-mail): Call message-generate-headers
- once. Suggested by Matt Armstrong <matt@lickey.com>.
-
- * gnus-topic.el (gnus-topic-rename): Initial-input.
- Suggested by Katsuhiro Hermit Endo <hermit@koka-in.org>.
-
-2001-11-03 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-forbidden-properties): New constant.
- (message-strip-forbidden-properties): New function.
- (message-mode): Activate it.
-
-2001-11-02 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-iso-8859-15-compatible): Fix doc.
- (mm-hack-charsets): Fix doc.
-
-2001-11-02 Simon Josefsson <jas@extundo.com>
-
- * gnus-int.el (gnus-check-server): Message "...done" when done.
-
- * imap.el (imap-close): Don't message (imap-send-command-wait
- returns if the connection is dropped).
- (imap-wait-for-tag): Nix out message only when necessary.
-
- * gnus-sieve.el (gnus-sieve-script): Use "stop" instead of "elsif"
- for non-crossposting.
- (gnus-sieve-crosspost): Default to t to be consistent with other
- parts of Gnus.
-
-2001-11-01 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-iso-8859-15-compatible): Add inconvertible chars.
- (mm-iso-8859-x-to-15-table): Ditto.
- (mm-iso-8859-x-to-15-region): Ditto.
- (mm-find-mime-charset-region): Ditto.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-close-asynchronous): New variable.
- (nnimap-close-group): Use it.
- (nnimap-expunge): Don't use it.
-
- * imap.el (imap-callbacks): New variable.
- (imap-remassoc): Copied from `gnus-remassoc'.
- (imap-add-callback): New function.
- (imap-mailbox-expunge, imap-mailbox-close): Support asynchronous
- behaviour.
- (imap-parse-response): Call the callback.
-
- * message.el (message-insert-canlock): New variable.
- (message-canlock-generate, message-canlock-password)
- (message-insert-canlock): New functions.
- (message-send-news): Call `message-insert-canlock'.
- (top-level): Require canlock when compiling.
- (message-insert-canlock): Require canlock before we need it.
-
-2001-11-01 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-copy-article-buffer): Copy sequence.
-
-2001-11-01 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-make-load): A workaround for
- custom-add-loads bug in some versions of XEmacs.
-
-2001-11-01 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-synonym-alist): Revert (some).
-
-2001-11-01 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-iso-8859-x-to-15-region): New function.
- (mm-hack-charsets): New variable.
- (mm-iso-8859-15-compatible): New variable.
- (mm-iso-8859-x-to-15-table): New variable.
- (mm-find-mime-charset-region): Add parameter hack-charsets.
-
- * mm-bodies.el (mm-encode-body): Use it.
- * mml.el (mml-parse-1): Ditto.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-make-menu-bar): Add Sieve.
-
-2001-11-01 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-to-coding-system): Return nil, if charset
- is nil.
-
-2001-11-01 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smiley-ems.el (smiley-update-cache): Auto detect file type.
-
- * message.el (message-forward-rmail-make-body): Use
- save-window-excursion.
- (message-encode-message-body): Search with noerror.
- (message-setup-1): Convert compose-mail send-actions to
- message-send-actions.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * sieve.el: Don't require easy-mmode. Suggested by Katsumi Yamaoka
- <yamaoka@jpl.org>.
-
-2001-10-31 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * sieve-manage.el (sieve-string-bytes): No complain.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-mode-map): Bind "D u" to
- `gnus-sieve-update' and "D g" to `gnus-sieve-generate'. (Functions
- has autoload cookies, so no `require' should be necessary.)
-
- * sieve.el, sieve-mode.el, sieve-manage.el, gnus-sieve.el: New
- files.
-
-2001-10-31 Simon Josefsson <jas@extundo.com>
-
- * gnus-cus.el (gnus-group-parameters): Support integer `display'
- parameter.
-
- * gnus-sum.el (gnus-select-newsgroup): If group parameter
- `display' is a number (and C-u wasn't used to enter group), only
- fetch that number of articles.
-
-2001-10-31 Matt Armstrong <matt@lickey.com>
-
- * gnus.el (gnus-find-subscribed-addresses): Doc fix:
- not-subscribed -> subscribed.
-
-2001-10-31 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From: Josh Huber <huber@alum.wpi.edu>
-
- * message.el (message-subscribed-address-functions): New variable.
- (message-subscribed-addresses): New variable.
- (message-subscribed-regexps): New variable.
- (message-goto-mail-followup-to): New function.
- (message-send-mail): Add Mail-Followup-To.
- (message-make-mft): New function.
-
- * gnus.el (gnus-find-subscribed-addresses): New function.
-
-2001-10-31 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-fetch): If debug, don't regain signals.
- (mail-source-fetch-pop): Ditto.
- (mail-source-check-pop): Ditto.
-
- * gnus-start.el (gnus-read-init-file): Ditto.
- (gnus-activate-group): Ditto.
- (gnus-read-newsrc-el-file): Ditto.
-
-2001-10-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-get-reply-headers): Make sure there is ", ".
-
- * mm-util.el (mm-mime-mule-charset-alist): Move down and call
- mm-coding-system-p. Don't correct it only in XEmacs.
- (mm-charset-to-coding-system): Use mm-coding-system-p and
- mm-get-coding-system-list.
- (mm-emacs-mule, mm-mule4-p): New variables.
- (mm-enable-multibyte, mm-disable-multibyte,
- mm-enable-multibyte-mule4, mm-disable-multibyte-mule4,
- mm-with-unibyte-current-buffer,
- mm-with-unibyte-current-buffer-mule4): Use them.
- (mm-find-mime-charset-region): Treat iso-2022-jp.
-
-2001-10-30 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Make it correct by
- construction.
- (mm-charset-synonym-alist): Remove windows-125[02]. Make other
- entries conditional on not having a coding system defined for
- them.
- (mm-mule-charset-to-mime-charset): Use
- find-coding-systems-for-charsets if defined.
- (mm-charset-to-coding-system): Don't use
- mm-get-coding-system-list. Look in mm-charset-synonym-alist
- later. Add last resort search of coding systems.
- (mm-enable-multibyte-mule4, mm-disable-multibyte-mule4)
- (mm-with-unibyte-current-buffer-mule4): Just treat Mule 5 like
- Mule 4.
- (mm-find-mime-charset-region): Re-write.
- (mm-with-unibyte-current-buffer): Restore buffer as well as
- multibyteness.
-
-2001-10-30 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * canlock.el, sha1-el.el, hex-util.el: Move from contrib
- directory. Thanks to Katsumi Yamaoka <yamaoka@jpl.org> and Shuhei
- KOBAYASHI <shuhei@aqua.ocn.ne.jp>.
-
-2001-10-30 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-display-x-face): Nix buffer-read-only
- again.
-
- * mml2015.el (mml2015-gpg-verify): Convert <LF> to <CR><LF>.
-
-2001-10-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-spec.el (gnus-parse-simple-format): Use
- buffer-substring-no-properties.
-
-2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-verify-cancel-lock): New function.
-
- * nnheader.el (nntp-process-response): New variable.
- (nnheader-init-server-buffer): Make `nntp-process-response'
- buffer-local in `nntp-server-buffer'.
-
- * nntp.el (nntp-prepare-post-hook): New hook.
- (nntp-wait-for): Save a server's ID in `nntp-process-response'.
- (nntp-async-trigger): Ditto.
- (nntp-request-post): Insert a server's ID if there's no Message-ID
- header; run `nntp-prepare-post-hook'.
-
-2001-10-30 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-decode-group-name): Use nnmail-fetch-field
- instead.
-
- * message.el (message-forward-subject-author-subject): Don't use
- message-news-p, which widens the buffer.
- (message-forward-make-body): New function.
- (message-forward): Use it.
- (message-insinuate-rmail): New function.
- (message-forward-rmail-make-body): New function.
-
-2001-10-30 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-extern.el (mm-extern): Provide it.
-
- * mm-partial.el (mm-partial): Provide it.
-
-2001-10-28 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-setup-message): Call post-command-hook.
-
-2001-10-29 Jesper Harder <harder@myrealbox.com>
-
- * mml.el (mml-preview): Bind message-this-is-news if it is
- news.
-
-2001-10-28 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-group-make-articles-read): Inline group.
-
-2001-10-29 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * smiley-ems.el (smiley-regexp-alist): Add support for sad and
- ironic smilies.
-
-2001-10-27 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-indent-citation): Don't add trailing
- whitespace when citing text.
-
-2001-10-27 Jesper Harder <harder@myrealbox.com>
-
- * gnus.el (gnus-group-faq-directory): Fix.
-
-2001-10-26 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-possibly-change-server): Create nnweb-hashtb if
- not available.
- (nnweb-request-scan): Nix nnweb-hashtb if ephemeral.
- (nnweb-type-definition): Add google as alias of dejanews.
- (nnweb-google-parse-1): Forward 1 line.
-
-2001-10-26 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-msg.el (gnus-summary-mail-forward): Doc fix: add pointer to
- variable `message-forward-ignored-headers'.
-
-2001-10-24 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-expand-group-parameter): New function.
- (gnus-expand-group-parameters): Call it.
- (gnus-group-fast-parameter): New function.
- (gnus-group-find-parameter): Call it.
-
-2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-news-group-p): Rewrote. Now accepts a header
- vector (it didn't before because of a bug).
- * gnus-msg.el (gnus-post-news): Use header vector directly, if
- available. Before it converted it to an article number.
-
- This makes followup to news articles with negative numbers in
- nnvirtual groups use news instead of mail.
-
-2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (post-method): Use `native' instead of `nil'.
-
- * gnus-msg.el (gnus-post-method): Ditto.
-
-2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-define-group-parameter): Grammar fix.
-
-2001-10-22 Simon Josefsson <jas@extundo.com>
-
- * gnus-msg.el (gnus-extended-version): Include
- system-configuration.
- Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE (Kai Gro\e,b_\e(Bjohann).
-
-2001-10-22 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (post-method): Customization fix: `native' is not a
- valid value.
- * gnus-msg.el (gnus-post-method): Doc and customization fix:
- `native' is not a valid value.
-
-2001-10-21 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap): Defgroup
- (nnimap-strict-function, nnimap-strict-function-match): New
- widget, from Per Abrahamsen <abraham@dina.kvl.dk>.
- (nnimap-split-crosspost, nnimap-split-inbox)
- (nnimap-split-rule, nnimap-split-predicate)
- (nnimap-split-predicate): Defcustom.
- (nnimap-split-inbox, nnimap-expunge-search-string)
- (nnimap-importantize-dormant): Remove "*" from doc.
-
-2001-10-20 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-summary-limit-to-score): Prompt for score if
- not supplied via prefix arg. From Lisp, make arg mandatory.
- Suggested by Frank Schmitt.
-
-2001-10-20 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-do-auto-fill): Avoid calling
- 'rfc822-goto-eoh'.
-
-2001-10-20 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-get-reply-headers): Restructure the logic
- and add comments.
-
-2001-10-20 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-cancel-news): Support cancel-locks.
- Suggested by Per Abrahamsson.
-
- * nnfolder.el (nnfolder-marks-changed-p): Ditto.
-
-2001-10-20 David Z. Maze <dmaze@MIT.EDU>
-
- * nnml.el (nnml-marks-changed-p): Use `equal' when comparing
- conses.
-
-2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mm-decode.el (mm-default-directory): Fix customize type.
-
- * message.el (message-setup-fill-variables): Kludge to use
- normal-auto-fill-function even if auto fill is already activated.
-
-2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-do-auto-fill): New version that does not
- rely on text properties, by Simon Josefsson <jas@extundo.com>.
- (message-setup-1): Removed the `message-field' property.
-
- * gnus-draft.el (gnus-draft-edit-message): Removed the
- `message-field' property.
-
-2001-10-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-draft.el (gnus-draft-edit-message): Change `field' to
- `message-field'. The `field' property has a special significance in
- Emacs 21.
-
- * message.el (message-send, message-setup-1): Ditto.
-
-2001-10-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-group-make-articles-read): Call g-r-set-mark
- when undoing.
-
-2001-10-18 Frank Schmitt <usereplyto@Frank-Schmitt.net>
-
- * gnus-sum.el (gnus-summary-limit-to-display-predicate): Fix typo.
- (gnus-summary-make-menu-bar): Ditto.
-
-2001-10-17 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-expiry-target): Make sure it is back to the
- server. Suggested by ShengHuo ZHU <zsh@cs.rochester.edu>.
-
-2001-10-17 17:00:00 Frank Schmitt <usenet@Frank-Schmitt.net>
-
- * gnus-sum.el (gnus-summary-line-format-alist): user-date entry.
- * gnus-util.el (gnus-user-date): New function.
-
-2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-check-news-header-syntax): Special case
- nnvirtual groups.
-
- * gnus-sum.el (gnus-summary-respool-default-method): Changed
- customize type to `symbol'.
-
-2001-10-17 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-spec.el (gnus-parse-simple-format): Support extended spec
- %&foo;.
- (gnus-parse-simple-format): Support user extended spec too.
- %u&foo; invokes gnus-user-format-function-foo.
-
-2001-10-17 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-request-expire-articles): Make sure it is back to
- the server.
- * nnmbox.el (nnmbox-request-expire-articles): Ditto.
- * nnfolder.el (nnfolder-request-expire-articles): Ditto.
- * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
- * nndiary.el (nndiary-request-expire-articles): Ditto.
- (nndiary-schedule): Defsubst it before use it.
- (nndiary-error): eval-and-compile.
-
-2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-msg.el (gnus-post-method): Changed two instances of
- `active' to `current' and one `null' to `not'.
-
-2001-10-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-setup-fill-variables): Use
- `normal-auto-fill-function' instead of `auto-fill-function'.
-
-2001-10-16 Simon Josefsson <jas@extundo.com>
-
- * mml2015.el (mml2015-fix-micalg): Fix for Mutt-bug.
- (mml2015-gpg-decrypt-1): Decanonicalize decrypted MIME
- body. (Mailcrypt seem to do this, but gpg.el doesn't.)
-
-2001-10-16 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- Patch by Oliver Scholz <oscholz@my.gnus.org>.
-
- * gnus-draft.el (gnus-draft-edit-message): Add text property
- `field' with value `header' to message headers.
- * message.el (message-setup-1): Really add text property to all of
- the header, not just part of it.
-
-2001-09-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-sort-by-server): Use it.
-
- * gnus.el (gnus-method-to-full-server-name): New, bogus function.
-
- * gnus-topic.el (gnus-topic-sort-groups-by-server): New command
- and keystroke.
-
-2001-10-14 Simon Josefsson <jas@extundo.com>
-
- * dig.el: Doc fix.
-
- * smime.el: Doc fix.
-
- * gnus-msg.el (gnus-inews-do-gcc): Port header encoded-word
- charset magic from message.el.
-
-2001-10-12 Simon Josefsson <jas@extundo.com>
- Suggested by david.goldberg6@verizon.net (David S. Goldberg)
-
- * gnus-cite.el (gnus-article-toggle-cited-text): Don't remove
- 'cite from g-a-wash-types.
- (gnus-cite-toggle): Ditto. Add 'cite. Set modeline.
- (gnus-article-hide-citation): Fix.
-
- * gnus-cite.el (gnus-article-hide-citation): Add `c' mode line
- character.
- (gnus-article-toggle-cited-text): Toggle `c' mode line character.
-
- * gnus-art.el (gnus-treat-hide-citation-maybe): Remove duplicate
- definition.
- (gnus-signature-toggle): Toggle `s' mode line character.
-
- * gnus-art.el (article-emphasize): Set `g-a-wash-types' after
- doing stuff that clears it.
-
-2001-10-12 Eric Marsden <emarsden@laas.fr>
-
- * gnus-cache.el (gnus-summary-limit-include-cached): Rewrite.
-
-2001-10-12 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-do-auto-fill): Use gnus-point-at-bol.
- (autoload): Add some autoloads.
-
-2001-10-12 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
- Suggested by Oliver Scholz <epameinondas@gmx.de>.
-
- * message.el (message-do-auto-fill): New function. Like
- `do-auto-fill' but don't fill when in the message header.
- (message-setup-1): Put a text property on the message header.
- (message-setup-fill-variables): Use `message-do-auto-fill'.
-
-2001-10-10 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-partially): Insert an empty line
- first, because of the change of message-make-lines.
-
-2001-10-10 Florian Weimer <fw@deneb.enyo.de>
-
- * mm-util.el (mm-charset-synonym-alist): If Emacs doesn't support
- iso-8859-15, make it an alias for iso-8859-1.
-
-2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-send-news): Don't modify the value of
- `message-syntax-checks' if it is not a list (possibly it is
- `dont-check-for-anything-just-trust-me').
-
-2001-10-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-name-charset-group-alist): Use
- `find-coding-system' for XEmacs to check whether the coding-system
- `utf-8' is available.
-
-2001-10-09 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-compile): Detect mh-e and xml.
-
-2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-send-news): Oops, missed case with no
- "Followup-To" header...
-
-2001-10-09 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-send-news): Allow
- `gnus-group-name-charset-group-alist' to affect encoding of the
- "Newsgroups" and "Followup-To" headers.
-
-2001-10-07 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (install-el): Depend on gnus-load.el.
-
-2001-10-07 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (install-el): Use -f.
- From: Amos Gouaux <amos+lists.ding@utdallas.edu>
-
-2001-10-07 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-send-news): Don't encode Followups-To when
- `gnus-group-name-charset-group-alist is' ".*". [Yuck]
-
- * gnus-util.el (gnus-decode-newsgroups): No space in newsgroup
- header.
-
- * gnus-art.el (article-decode-group-name): Also decode
- "Followup-To".
-
- * rfc2047.el (rfc2047-encode-message-header): Encode without
- asking for null methods.
-
- * gnus-group.el (gnus-group-name-charset-group-alist): Make utf-8
- default charset for newsgroup names in accordance with USEFOR.
-
- * gnus-group.el (gnus-group-name-charset-method-alist,
- gnus-group-name-charset-group-alist): Removed "*" from doc
- strings, "*" should not be used for complex variables.
-
-2001-10-06 Simon Josefsson <jas@extundo.com>
-
- Support UTF-8 group names better.
-
- * message.el (message-check-news-header-syntax): Encode group
- names before comparison.
-
- * gnus-msg.el (gnus-copy-article-buffer): Run all
- `gnus-article-decode-hook's except `article-decode-charset'
- instead of hardcoding call to one of them.
-
- * gnus-art.el (gnus-article-decode-hook): Add
- `article-decode-group-name'.
- (article-decode-group-name): New function, use `g-d-n'.
-
- * gnus-group.el (gnus-group-insert-group-line): Decode
- gnus-tmp-group using `g-d-n'.
-
- * gnus-util.el (gnus-decode-newsgroups): New function.
-
-2001-10-06 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Fixed bug non-nil
- `gnus-group-name-charset-group-alist'.
-
-2001-10-06 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Install el in install. Add uninstall.
-
-2001-10-05 Simon Josefsson <jas@extundo.com>
-
- * nnheader.el (gnus-verbose-backends, gnus-nov-is-evil): Custom.
-
- * gnus-sum.el (gnus-summary-move-article): Also activate new groups.
-
- * nnfolder.el (nnfolder-normalize-buffer): Don't insert \n\n in
- empty folders.
-
- * gnus-sum.el (gnus-select-newsgroup): Don't enable `display'
- limiting if read-all (C-u RET) was used.
-
-2001-10-04 Simon Josefsson <jas@extundo.com>
-
- * mail-source.el (mail-source-movemail-program): New variable.
- (mail-source-movemail): Use it. Suggested by Taylor Hutt
- <thutt@thutt.vmware.com>.
-
-2001-10-03 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-from-or-to-or-newsgroups): New param.
- (gnus-summary-line-format-alist): Fix param.
-
-2001-10-02 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-request-move-article): Use imap.el directly,
- don't go through `nnimap-request-expire-articles' to delete the
- article. Thanks to prj@po.cwru.edu (Paul Jarc).
-
-2001-10-02 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-write-active): The min in the
- agent/active may be larger than that in the server/active.
-
-2001-10-01 Simon Josefsson <jas@extundo.com>
-
- * mail-source.el (mail-source-fetch-imap): Use BODY.PEEK if server
- is IMAP4rev1.
-
- * nnml.el (gnus-article-unpropagatable-p): Autoload gnus-sum.
-
- * nnfolder.el: Ditto.
-
-2001-09-30 Dan Christensen <jdc@uwo.ca>
-
- * gnus-sum.el (gnus-summary-extract-address-component): New function.
- (gnus-summary-from-or-to-or-newsgroups): Optimize.
-
-2001-09-29 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-mode-map): Keybinding for `gnus-delay-article'.
- (message-mode-menu): Menu item for same.
-
- * gnus-group.el (gnus-group-make-menu-bar): Menu item for sending
- delayed articles.
-
- * gnus-delay.el (gnus-delay-send-drafts): Do nothing if
- nndraft:delayed does not exist.
- (gnus-delay-initialize): Don't set up keymap, that's done from
- message.el now.
- (gnus-delay, gnus-delay-group, gnus-delay-header)
- (gnus-delay-default-delay, gnus-delay-default-hour): Customize.
-
-2001-09-29 Simon Josefsson <jas@extundo.com>
-
- * mm-util.el (mm-mime-mule-charset-alist): Encode mule-utf-8 as
- utf-8, not eight-bit-control.
-
- * imap.el (imap-shell-host, imap-default-user, imap-use-utf7)
- (imap-log, imap-debug): Custom.
- (imap-log-buffer, imap-debug-buffer): New constants.
- (imap-kerberos4-open, imap-gssapi-open, imap-ssl-open)
- (imap-network-open, imap-shell-open, imap-starttls-open)
- (imap-send-command-1, imap-send-command, imap-arrival-filter)
- (imap-debug): Use imap-*-buffer.
-
- * nndoc.el (nndoc-article-type): Add mailman.
- (nndoc-type-alist): Ditto.
- (nndoc-mailman-type-p): New function.
-
-2001-09-28 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-article-x-face-command): Merge it into
- gnus-art.el.
-
-2001-09-27 Simon Josefsson <jas@extundo.com>
-
- * gnus-topic.el (gnus-topic-mode-map): Add catchup.
- (gnus-topic-catchup-articles): New function. Suggested by Robin
- S. Socha <robin-dated-1001857693.185e29@socha.net>.
-
-2001-09-27 11:00:00 Gerd M\e,Av\e(Bllmann <gerd@gnu.org>.
-
- * gnus-ems.el (gnus-article-display-xface): Insert xface after
- previous ones.
-
-2001-09-27 07:00:00 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-sum.el (gnus-summary-show-article): The arglist of
- detect-coding-region is incompatible.
-
-2001-09-26 18:00:00 Katsuhiro Hermit Endo <hermit@koka-in.org>
-
- * gnus-group.el (gnus-group-delete-group): Typo.
-
-2001-09-26 Simon Josefsson <jas@extundo.com>
-
- * nnmail.el (nnmail-expiry-target-group): Add doc warning.
-
- * nnimap.el (nnimap-expiry-target): Use temp buffer.
-
-2001-09-26 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-group-parameters): Display as sexp.
-
-2001-09-22 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-open-marks): Remove unpropagatable marks.
-
- * nnfolder.el (nnfolder-open-marks): Ditto.
-
- * gnus-sum.el (gnus-article-unpropagatable-p): New function.
- (gnus-update-marks): Use it.
- (gnus-update-marks): Use `gnus-article-mark-to-type' instead of
- hardcoded list.
-
- * gnus.el (gnus-article-special-mark-lists): Add killed.
- (gnus-article-unpropagated-mark-lists): New constant.
-
-2001-09-22 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-mode-hook): Add gnus-pick-mode as
- custom option.
-
-2001-09-23 Simon Josefsson <jas@extundo.com>
-
- * gnus-draft.el (gnus-draft-setup): Add mark in backend as well.
-
-2001-09-23 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-button-mailto): Hack save-selected-window-window.
-
-2001-09-22 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-group.el (gnus-group-sort-function): Fix customize type to
- accept lists of functions.
-
-2001-09-20 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-catchup): Update expire marks in
- backend. Also, if ALL also set expire marks on tick/dormant.
-
-2001-09-20 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-tab-body-function): New variable.
- * message.el (message-tab): Use it.
-
-2001-09-19 Sam Steingold <sds@gnu.org>
-
- * gnus-win.el (gnus-buffer-configuration): Respect
- `gnus-bug-create-help-buffer'.
-
-2001-09-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-spec.el (gnus-correct-pad-form): Re-revert.
- (gnus-parse-simple-format): Re-revert.
-
-2001-09-16 Katsuhiro Hermit Endo <hermit@koka-in.org>
- Trivial patch.
-
- * gnus-spec.el (gnus-parse-complex-format): Don't fold search
- case. (Thanks to Daiki Ueno <ueno@unixuser.org>.)
-
-2001-09-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-spec.el (gnus-correct-pad-form): Remove until papers are
- signed.
- (gnus-parse-simple-format): Don't use it.
-
-2001-09-17 Miles Bader <miles@gnu.org>
-
- * gnus-srvr.el (gnus-server-insert-server-line): Don't let an
- error querying a backend abort the whole process.
-
-2001-09-17 08:00:00 Gerd M\e,Av\e(Bllmann <gerd@gnu.org>
-
- * gnus-srvr.el (gnus-server-mode): Fix bogus fontification.
-
-2001-09-17 Didier Verna <didier@xemacs.org>
-
- * nndiary.el: version 0.2-b14.
- * gnus-diary.el (gnus-diary-check-message): fix `read-string'
- compatibility problem with XEmacs 21.1.
-
-2001-09-15 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-line-format): Document %c.
-
- * nnml.el (nnml-parse-head): Handle CRLF files.
- (nnml-generate-nov-file): Ditto.
- (nnml-retrieve-headers): Ditto.
-
-2001-09-15 Michael Welsh Duggan <md5i@cs.cmu.edu>
-
- * gnus-spec.el (gnus-parse-format): Don't treat %c as %C.
-
-2001-09-13 Martin Kretzschmar <Martin.Kretzschmar@inf.tu-dresden.de>
-
- * gnus-spec.el (gnus-correct-substring): Still stopped one
- character before we wanted (never included last character).
- (gnus-tilde-max-form, gnus-tilde-cut-form) Made readable again,
- add missing "," (once per function)
-
-2001-09-14 Simon Josefsson <jas@extundo.com>
-
- * gnus-start.el (gnus-group-mode-hook): Moved from gnus-group
- (otherwise e.g. gnus-agentize in .gnus overrides the customized
- default before gnus-group is loaded and the variable set.)
-
- * nnimap.el (nnimap-request-set-mark): Do not store bookmark,
- killed or unsent marks.
-
- * gnus-draft.el (gnus-draft-setup): Don't set mark when there
- isn't an article to set it on (e.g. when you `a' in a group).
-
-2001-09-12 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * mm-util.el (mm-charset-synonym-alist): add windows-1250 so we
- can read e-mails from Microsoft Outlook users not using ISO
- 8859-2 character set.
-
-2001-09-12 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-diary.el: Minor modifications to avoid warnings.
- (gnus-summary-misc-menu): defvar.
- (gnus-diary-check-message): Use gnus-point-at-eol.
- (gnus-diary-kill-entire-line): eval-and-compile.
-
-2001-09-12 Didier Verna <didier@xemacs.org>
-
- * nndiary.el: new version (0.2-b13).
- * nndiary.el (nndiary-mail-sources): doc update.
- * nndiary.el (nndiary-split-methods): ditto.
- * nndiary.el (nndiary-request-accept-article-hooks): New.
- * nndiary.el (nndiary-request-accept-article): use it, check
- message validity.
- * nndiary.el (nndiary-get-new-mail): changed default to nil.
- * nndiary.el (nndiary-schedule): fix bug (misplaced
- condition-case): it didn't return nil on error.
- * gnus-diary.el: new version.
- * gnus-diary.el (gnus-diary-summary-line-format): removed %I.
- * gnus-diary.el (gnus-diary-header-value-history): New.
- * gnus-diary.el (gnus-diary-narrow-to-headers): New.
- * gnus-diary.el (gnus-diary-add-header): New.
- * gnus-diary.el (gnus-diary-check-message): New.
- * gnus-diary.el (message-mode-map): bind the above to `C-c D c'.
- * gnus-diary.el (gnus-article-edit-mode-map): ditto.
-
-2001-09-10 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-sum.el (gnus-select-newsgroup): Make
- `gnus-current-select-method' buffer-local.
-
- * gnus-art.el (gnus-request-article-this-buffer): Refer
- `gnus-current-select-method' in the current summary buffer.
-
-2001-09-10 Daniel Pittman <daniel@rimspace.net>
-
- * gnus-spec.el (gnus-correct-pad-form): Fix.
-
-2001-09-09 Simon Josefsson <jas@extundo.com>
-
- * mm-decode.el (mm-inline-media-tests): Add
- application/x-emacs-lisp.
- (mm-attachment-override-types): Add
- application/{x-,}pkcs7-signature.
-
- * gnus-srvr.el (gnus-server-mode-hook, gnus-server-exit-hook)
- (gnus-server-line-format, gnus-server-mode-line-format)
- (gnus-server-browse-in-group-buffer): Customize.
-
-2001-09-08 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-marks-changed-p): Typo.
- (nnml-save-marks, nnml-open-marks): Use gnus-sethash.
- (nnml-marks-changed-p): Use gnus-gethash.
- (nnml-marks-modtime): Use gnus-make-hashtable.
-
- * nnfolder.el (nnfolder-marks-changed-p): Typo.
- (nnfolder-request-expire-articles, nnfolder-save-marks)
- (nnfolder-open-marks): Typo.
- (nnfolder-save-marks, nnfolder-open-marks): Use gnus-sethash.
- (nnfolder-marks-changed-p): Use gnus-gethash.
- (nnfolder-marks-modtime): Use gnus-make-hashtable.
-
-2001-09-08 Simon Josefsson <jas@extundo.com>
-
- * nnfolder.el (nnfolder-marks-modtime): New variable.
- (nnfolder-marks-changed-p): New function.
- (nnfolder-save-marks, nnfolder-open-marks): Save modtime.
- (nnfolder-request-update-info): Don't update if marks didn't change.
-
- * nnml.el (nnml-marks-modtime): New variable.
- (nnml-marks-changed-p): New function.
- (nnml-save-marks, nnml-open-marks): Save modtime.
- (nnml-request-update-info): Don't update if marks didn't change.
-
- * gnus-agent.el (gnus-agent-any-covered-gcc)
- (gnus-agent-add-server, gnus-agent-remove-server): Use
- gnus-agent-method-p.
-
- * gnus-art.el (gnus-buttonized-mime-types): New variable.
- (gnus-unbuttonized-mime-type-p): Use it.
-
- * gnus-agent.el (gnus-agent-fetch-group): If online, actually
- fetch group.
-
-2001-09-08 Daniel Pittman <daniel@rimspace.net>
-
- * gnus-spec.el (gnus-correct-pad-form): New function.
- (gnus-parse-simple-format): Use it.
-
-2001-09-07 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-group-sort-groups): Unmark all groups.
- (gnus-group-sort-selected-groups): Ditto. Suggested by Harry
- Putnam <reader@newsguy.com>.
- (gnus-group-sort-selected-groups): Touch dribble file.
-
-2001-09-07 Raja R Harinath <harinath@cs.umn.edu>
-
- * nnml.el (nnml-filenames-are-evil): New variable.
- (nnml-article-to-file-alist): Rename to ...
- (nnml-current-group-article-to-file-alist): ... this.
- Respect `nnml-filenames-are-evil'.
- (nnml-active-number): Update.
- (nnml-update-file-alist): Update.
- (nnml-request-article): Use nnheader-article-to-file-alist.
- (nnml-request-rename-group): Likewise.
-
-2001-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-insert-line): Fix.
-
-2001-09-06 Bj\e,Av\e(Brn Torkelsson <torkel@acc.umu.se>
-
- * gnus-sum.el: Bind g-s-t-s to "W g".
- * gnus-sum.el (gnus-summary-make-menu-bar): Add g-s-t-s.
- * gnus-sum.el (gnus-summary-toggle-smiley): New function. Toggles
- display of graphical smilies.
-
-2001-09-07 02:00:00 Bill White <billw@wolfram.com>
-
- * gnus-start.el (gnus-setup-news): A typo.
-
-2001-09-06 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-insert-line): Insert forwarded, recent
- and unseen marks.
-
-2001-09-05 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-split-fancy): Document `junk'.
-
-2001-09-04 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-search): Don't error if server is broken.
-
-2001-09-02 Benjamin Rutt <brutt@bloomington.in.us>
-
- * nnmbox.el (nnmbox-find-article): Fix infinite loop when
- searching for an article that isn't in the mbox.
-
-2001-09-02 23:12:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Get references
- right, and get all the comments.
-
-2001-09-02 Simon Josefsson <jas@extundo.com>
- Suggested by Dan Christensen <jdc+news@uwo.ca>
-
- * nnfolder.el (nnfolder-request-update-info): Fix message.
-
- * nnml.el (nnml-request-update-info): Ditto.
-
-2001-09-01 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-request-expire-articles): Also bind
- `nnml-current-group' and `nnml-article-file-alist' when using
- expiry-target. (Otherwise nnml will be in a inconsistent internal
- state causing all kind of problems.)
- (nnml-request-expire-articles): If `nnml-article-to-file' or
- `file-attributes' failes, return article as un-expirable instead
- of treating it as expired.
-
-2001-08-31 Sam Steingold <sds@gnu.org>
-
- * imap.el (imap-mailbox-examine, imap-mailbox-examine-1): Fix a
- typo: `exmine' --> `examine'.
-
-2001-08-30 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-forward-type-p): It is not a digest.
-
-2001-08-30 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-check-directory-twice): Remove.
- (nnml-retrieve-headers): Ditto.
- (nnml-article-to-file): Use nnheader-directory-files-is-safe.
-
-2001-08-30 Andrew Innes <andrewi@gnu.org>
-
- * nnheader.el (nnheader-directory-files-is-safe): No need to read
- directory twice on Windows, or on GNU Emacs-21.
-
-2001-08-30 Andrew Innes <andrewi@gnu.org>
-
- * nnml.el (nnml-request-article): Use nnml-article-to-file-alist.
- (nnml-request-rename-group): Ditto.
- (nnml-active-number): Ditto.
- (nnml-request-create-group): Use nnml-directory-articles.
- (nnml-request-expire-articles): Use nnml-directory-articles, which
- gets list from nov database if available.
- (nnml-get-nov-buffer): New function.
- (nnml-open-nov): Use it.
- (nnml-update-file-alist): Use nnml-article-to-file-alist, which
- gets alist from nov database if available.
- (nnml-directory-articles): New function.
- (nnml-article-to-file-alist): New function.
-
-2001-08-30 Andrew Innes <andrewi@gnu.org>
-
- * mm-decode.el (mm-display-external): Use `name' as filename, if
- `filename' attribute is not present.
-
-2001-08-30 Andrew Innes <andrewi@gnu.org>
-
- * mail-source.el (mail-source-flash): New defcustom.
- (mail-source-new-mail-p): Ring visible bell if appropriate.
- (mail-source-start-idle-timer): Use unwind-protect to ensure idle
- timer is cleared even if mail check signals an error.
-
-2001-08-29 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-move-article): Only update marks of
- type 'list.
-
-2001-08-29 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * flow-fill.el (fill-flowed): eol might be point-max.
-
-2001-08-27 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-request-update-info): Fix message.
- (nnml-open-marks): Ditto.
-
- * nnfolder.el (nnfolder-request-update-info):
- (nnfolder-open-marks): Fix message.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
-
- * nnfolder.el (nnfolder-save-marks): Don't create directory named
- after group in ~/.
-
-2001-08-25 Andreas Jaeger <aj@suse.de>
-
- * nnfolder.el (nnfolder-open-marks): Fix typo.
- * nnml.el (nnml-open-marks): Likewise.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
-
- Make nnfolder groups self-contained as far as marks are concerned.
-
- * nnfolder.el (nnfolder-marks-directory, nnfolder-marks-is-evil)
- (nnfolder-marks, nnfolder-marks-file-suffix): New variables.
- (nnfolder-open-server): Make marks directory.
- (nnfolder-request-delete-group): Delete marks file.
- (nnfolder-request-delete-group): Check of nov/marks file exist
- before deleting.
- (nnfolder-request-rename-group): Rename marks file.
- (nnfolder-request-rename-group): Only rename nov/mark if they exists.
- (nnfolder-request-set-mark, nnfolder-request-update-info)
- (nnfolder-group-marks-pathname, nnfolder-save-marks)
- (nnfolder-open-marks): New functions.
- (top-level): Require gnus.
-
-2001-08-25 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-type-definition): Use google raw file.
- (nnweb-google-parse-1): Ditto.
- (nnweb-google-identity): Ditto.
- (nnweb-reference-wash-article): Move nnweb-decode-entities here.
- (nnweb-altavista-wash-article): Ditto.
- (nnweb-request-article): Remove nnweb-decode-entities.
-
- * nnml.el: Require 'gnus.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-marks-is-evil): Add doc.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-save-marks): Wrap saving marks in a
- condition-case, to allow user to start Gnus if saving marks failed
- for some reason.
-
-2001-08-24 16:05:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-spec.el (gnus-compile): Don't compile gnus-version.
-
- * gnus-group.el (gnus-update-group-mark-positions): Bind
- gnus-group-update-hook to nil.
-
-2001-08-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Force as multibyte string.
-
-2001-08-24 12:00:00 Martin Kretzschmar <Martin.Kretzschmar@inf.tu-dresden.de>
-
- * gnus-sum.el (gnus-summary-insert-line)
- (gnus-summary-prepare-threads): gnus-tmp-lines should be a string.
-
-2001-08-24 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-spec.el (gnus-correct-substring): Take optional END.
-
- * nnrss.el (nnrss-request-article): Remove \n.
- (nnrss-retrieve-headers): Lines number is -1.
-
-2001-08-24 Simon Josefsson <jas@extundo.com>
-
- * gnus-group.el (gnus-info-clear-data): Call
- nnfoo-request-set-mark to propagate marks. Fix bug:
- `gnus-group-update-line' doesn't update read range unless we call
- `gnus-get-unread-articles-in-group' first.
-
- * nnimap.el (nnimap-request-set-mark): Don't propagate seen flags
- to server.
-
-2001-08-23 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-create-info-command): Return an interactive
- function.
-
-2001-08-23 19:00:00 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-spec.el (gnus-parse-complex-format): Use equal.
-
-2001-08-23 18:43:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-select-newsgroup): Use it.
-
- * gnus-util.el (gnus-not-ignore): New function.
-
- * lpath.el (featurep): Don't fbind char-int.
-
- * gnus-util.el (gnus-create-info-command): New function.
-
- * gnus-group.el (gnus-group-edit-group): Make C-c C-i go to the
- right node.
-
- * gnus-sum.el (gnus-select-newsgroup): Clean up.
- (gnus-summary-limit-children): Use 'identity instead of `all'.
- (gnus-summary-limit-to-display-predicate): New command and
- keystroke.
-
-2001-08-23 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-group-alist): Use fm-releases.rdf.
-
- * gnus-spec.el (gnus-format-specs): Miss a right parenthesis.
-
-2001-08-23 18:43:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-spec.el: Add the Gnus version.
- (gnus-update-format-specifications): If the Gnus version changes,
- nix out the format spec cache.
-
- * gnus.el (gnus-continuum-version): Made into a command and
- optionalize the VERSION.
-
- * gnus-spec.el (gnus-parse-complex-format): Remove %C specs from
- the start of the lines.
-
-2001-08-22 00:06:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-visual-p): Define function before use of
- function.
-
-2001-08-21 23:28:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-adjust-marked-articles): Use new variable.
- (gnus-article-mark-to-type): New function.
- (gnus-update-missing-marks): Only update marks of type 'list.
-
- * gnus.el (gnus-article-special-mark-lists): New variable.
-
-2001-08-21 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-limit-children): Check 'all.
- (gnus-select-newsgroup): Still use 'all.
- (gnus-summary-initial-limit): Comparing with 'all.
-
-2001-08-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-activate-group): If dont-check, don't update
- active.
-
-2001-08-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Replace
- nnslashdot-*-retrieve-headers.
- (nnslashdot-request-article): Fix for slashcode 2.2.
- (nnslashdot-make-tuple): New function.
- (nnslashdot-read-groups): Use it.
-
-2001-08-20 01:34:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-expand-group-parameters): Don't alter the variable
- list.
-
- * gnus-sum.el (gnus-summary-move-article): Don't select article.
-
-2001-08-20 Simon Josefsson <jas@extundo.com>
-
- * gnus-msg.el (gnus-inews-do-gcc): If archive server can't be
- opened, error instead of continuing (and exploding later).
-
-2001-08-20 01:34:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.el (gnus-expand-group-parameters): Return the parameter
- list.
-
- * gnus-sum.el (gnus-summary-show-article): Doc fix.
- (gnus-summary-show-article): Guess at charset if required.
-
- * gnus-spec.el (gnus-correct-substring): Stopped one character
- before we wanted.
-
-2001-08-19 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * earcon.el (earcon-auto-play): Remove unused option.
-
-2001-08-19 16:14:41 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-headers): Move the "Scoring..."
- message down in levels, since it happens very fast.
-
- * smiley-ems.el (smiley-update-cache): Respect the symbol version
- of smiley-regexp-alist.
-
- * mm-view.el (mm-inline-text): Ignore vcard errors.
-
- * gnus-art.el (gnus-ignored-headers): Added more junk headers.
-
- * gnus-score.el (gnus-all-score-files): Use append instead of
- nconc.
-
- * gnus.el (gnus-splash-face): Doc fix.
-
- * mm-decode.el (mm-mailcap-command): Use
- mm-path-name-rewrite-functions.
- (mm-path-name-rewrite-functions): New variable.
-
- * gnus-spec.el (gnus-parse-complex-format): React to ?=.
- (gnus-complex-form-to-spec): Insert tab.
- (gnus-spec-tab): New function.
-
- * gnus-sum.el (gnus-select-newsgroup): Set the marks before
- entering the group.
-
- * gnus-spec.el (gnus-complex-form-to-spec): Insert Lisp to match
- the positional spec.
- (gnus-parse-complex-format): React to %C.
-
- * gnus-ems.el (gnus-char-width): Moved here.
-
- * gnus-sum.el (gnus-select-newsgroup): Set
- gnus-newsgroup-articles.
- (gnus-unseen-mark): New variable.
- (gnus-newsgroup-unseen): Ditto.
- (gnus-newsgroup-seen): Ditto.
- (gnus-adjust-marked-articles): Use them.
- (gnus-update-marks): Use them.
- (gnus-summary-update-secondary-mark): Display.
- (gnus-summary-prepare-threads): Display.
-
- * gnus-msg.el (gnus-inews-group-method): Use and return the
- method, not the server.
-
-2001-08-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-srvr.el (gnus-server-agent-face): New.
- (gnus-server-agent-face): New.
- (gnus-server-mode): Turn on font-lock-mode.
-
- * gnus.el (gnus-server-visual): Add defgroup.
-
-2001-08-19 Joe Casadonte <jcasadonte@northbound-train.com>
-
- * gnus-srvr.el (gnus-server-opened-face, gnus-server-closed-face,
- gnus-server-denied-face): New.
- (gnus-server-opened-face, gnus-server-closed-face,
- gnus-server-denied-face): New.
- (gnus-server-font-lock-keywords): Add.
-
-2001-08-19 Simon Josefsson <jas@extundo.com>
-
- * nnml.el (nnml-request-set-mark): Return nil.
- (nnml-save-marks): Use nnml-possibly-create-directory.
- (nnml-open-marks): Only work in temp buffer when inserting/reading
- .marks file.
-
-2001-08-18 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-expand-group-parameters): Fix.
-
- * gnus-spec.el (gnus-char-width): New function.
- (gnus-correct-substring, gnus-correct-length): Use it.
-
- * message.el (message-required-mail-headers): Fix doc.
-
-2001-08-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-group-make-articles-read): gnus-request-set-mark.
-
- * mm-decode.el (mm-save-part-to-file): Insert the handle.
-
-2001-08-18 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-threaded-retrieve-headers):
- slashdot 2.2 (not fully fixed yet).
- (nnslashdot-request-article): Ditto.
-
-2001-08-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-util.el (gnus-remassoc, gnus-update-alist-soft): Moved from
- nnimap.
-
- * nnimap.el (nnimap-remassoc, nnimap-update-alist-soft): Moved to
- gnus-util.
- (nnimap-request-update-info-internal): Use new functions.
-
- * nnml.el (nnml-request-set-mark, nnml-request-update-info): Use
- new functions.
-
-2001-08-18 Simon Josefsson <jas@extundo.com>
-
- Make nnml groups self-contained as far as marks are concerned.
-
- * nnml.el (nnml-request-delete-group): Delete marks file.
- (nnml-request-rename-group): Move marks file.
- (nnml-marks-file-name, nnml-marks-is-evil, nnml-marks): New server
- variables.
- (nnml-request-set-mark, nnml-request-update-info): New server
- functions.
- (nnml-save-marks, nnml-open-marks): New functions.
-
-2001-08-18 Simon Josefsson <jas@extundo.com>
-
- * gnus-sum.el (gnus-summary-move-article): Use `add' instead of
- `set' when setting marks.
-
-2001-08-17 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-info-find-node): Take an argument.
-
- * gnus-art.el (gnus-button-handle-info): New function.
- (gnus-url-unhex-string): Replace "+" with " ".
-
-2001-08-17 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-check-news-header-syntax): Check bad From.
-
-2001-08-18 00:14:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-spec.el (gnus-correct-length): New function.
- (gnus-correct-substring): New function.
- (gnus-tilde-max-form): Use it.
-
-2001-08-17 Nevin Kapur <nevin@jhu.edu>
-
- * nnmh.el: Docstring changes as below.
-
- * nnml.el: Docstring changes as below.
-
- * nnbabyl.el: Docstring changes as below.
-
- * nnmbox.el: Docstring changes as below.
-
- * nnfolder.el: Added docstrings identifying each virtual server
- parameter.
-
-2001-08-18 Simon Josefsson <jas@extundo.com>
-
- * mml.el (mml-menu): Collapse Attach, Insert and Security submenu.
-
-2001-08-17 Bj\e,Av\e(Brn Torkelsson <torkel@acc.kth.se>
-
- * message.el: rename "Abort Message" to "Postpone Message".
- Remove "Attach file as MIME" from Message menu, it's already in
- the MIME menu.
-
-2001-08-17 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smime.el (smime-point-at-eol): eval-and-compile.
- (smime-make-temp-file): New function.
- (smime-sign-region, smime-encrypt-region, smime-decrypt-region):
- Use it.
-
-2001-08-17 10:41:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-fetch-group): Go online if offline.
- (gnus-agent-summary-fetch-group): New command and keystroke.
-
- * gnus-art.el (gnus-insert-mime-button): Tiny clean-up.
- (gnus-mime-display-security): Make it respect
- gnus-unbuttonized-mime-type-p.
-
- * gnus-sum.el (gnus-articles-to-read): Comments.
- (gnus-article-marked-p): New function.
- (gnus-summary-display-make-predicate): New function.
- (gnus-select-newsgroup): Use them.
-
- * mm-decode.el (mm-save-part-to-file): Made it not error.
-
-2001-08-17 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-wait-for-tag): If process-status isn't open or
- run, return nil instead of sit-for looping.
-
-2001-08-17 10:41:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * lpath.el (featurep): fbind xml-parse-region.
-
- * gnus.el (gnus-message-archive-method): Default to "archive".
- (gnus-message-archive-method): Doc fix.
- (gnus-parameters-get-parameter): Cleaned up.
- (gnus-expand-group-parameter): New function.
-
- * gnus-start.el (gnus-setup-news): Push the archive server only
- the server list.
-
- * mml.el (mml-menu): Changed name to "Attachments".
-
- * mm-decode.el (mm-destroy-postponed-undisplay-list): Only message
- when there is something to detroy.
-
-2001-05-21 17:11:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-server-browse-in-group-buffer): Default to
- nil.
-
-2001-08-15 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-article): Allow "01:23" time spec,
- which specifies a time today or tomorrow.
-
-2001-08-15 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-agent.el (gnus-agent-make-mode-line-string)
- (gnus-agent-toggle-plugged): Use new API.
-
-2001-08-14 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-send-drafts): Fix check whether
- deadline has expired.
-
-2001-08-12 Simon Josefsson <jas@extundo.com>
- Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE
-
- Support `recent' mark indicating newly arrived messages (to
- separate from old but unread messages).
-
- * nnimap.el (nnimap-retrieve-groups): Push dummy article into
- `nnmail-split-history' if recent is > 0.
- (nnimap-request-update-info-internal): Update `recent' marks.
- (nnimap-request-set-mark): Never set `recent' marks.
- (nnimap-mark-to-predicate-alist, nnimap-mark-to-flag-alist): Add
- recent.
-
- * gnus-sum.el (gnus-recent-mark): New mark.
- (gnus-newsgroup-recent): New variable.
- (gnus-summary-local-variables): Add gnus-newsgroup-recent.
- (gnus-summary-prepare-threads): Mark recent articles.
- (gnus-summary-add-mark): Support recent.
- (gnus-summary-update-secondary-mark): Support recent.
-
- * gnus.el (gnus-article-mark-lists): Add recent.
-
-2001-08-12 Simon Josefsson <jas@extundo.com>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Returns
- whether successful decoding took place. Add doc.
-
-2001-08-12 Simon Josefsson <jas@extundo.com>
- Suggested by Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.el (gnus-summary-line-format, gnus-parameters):
- * gnus-gl.el (gnus-summary-grouplens-line-format):
- * gnus-salt.el (gnus-summary-pick-line-format):
- * gnus-spec.el (gnus-format-specs): %n is 23 chars.
-
-2001-08-11 09:40:00 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-score.el (gnus-score-string): Fix `match' regexp
- for `extra' header case.
-
-2001-08-10 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmbox.el (nnmbox-read-mbox): No warning.
-
-2001-08-10 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndoc.el (nndoc-article-type): Fix doc.
- (nndoc-generate-article-function): New variable.
- (nndoc-dissection-function): New variable.
- (nndoc-type-alist): Add oe-dbx.
- (nndoc-oe-dbx-type-p): New function.
- (nndoc-oe-dbx-dissection): New function.
- (nndoc-oe-dbx-generate-article): New function.
-
-2001-08-11 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-send-drafts): Cleaner way to check
- whether deadline has been reached. Patch from Dan Nicolaescu
- <dann@godzilla.ics.uci.edu>.
-
-2001-08-10 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el (turn-on-gnus-mailing-list-mode): Use
- gnus-group-find-parameter. Suggested by Janne Rinta-Manty
- <rintaman@cs.Helsinki.FI>.
-
- * mail-source.el (mail-source-movemail): The error buffer is
- modified, but nothing in it.
-
-2001-08-10 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-bogus-system-names): New variable.
- (message-make-fqdn): Use it.
-
-2001-08-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-group): Use
- nndraft-auto-save-file-name.
-
-2001-08-09 Simon Josefsson <jas@extundo.com>
-
- * mm-view.el (mm-view-pkcs7-decrypt): Operate in current buffer.
- Don't ask whether to decrypt. Just leave result in buffer (don't
- call mm).
-
- * mm-decode.el (mm-dissect-buffer): Possibly verify/decrypt single
- parts as well.
- (mm-inline-media-tests): Ignore application/{x-,}pkcs7-mime.
- (mm-possibly-verify-or-decrypt): Support application/{x-,}pkcs7-mime.
-
-2001-08-09 Simon Josefsson <jas@extundo.com>
-
- * mm-decode.el (mm-insert-part): Return decoding success status.
- (mm-save-part-to-file): Error if decoding failed.
-
-2001-08-09 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-tab): Use indent-relative.
- (message-mode): Don't bind indent-line-function to indent-relative.
-
-2001-08-09 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-get-reply-headers): Fix string. Suggested by
- Christoph Conrad <cc@cli.de>.
-
-2001-08-08 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-tab): Use the current value of
- indent-line-function.
- (message-mode): Bind indent-line-function to indent-relative.
-
-2001-08-08 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-gssapi-auth-p, imap-kerberos4-auth-p): Also check
- whether `imtest' is installed.
-
-2001-08-04 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
-
- * gnus-sum.el (gnus-summary-show-article): Call
- gnus-summary-update-secondary-secondary-mark.
- * gnus-sum.el (gnus-summary-edit-article-done): Ditto.
- * gnus-sum.el (gnus-summary-reparent-thread): Ditto.
-
-2001-08-07 16:00:00 Gerd M\e,Av\e(Bllmann <gerd@gnu.org>
-
- * mm-uu.el (mm-uu-dissect): Autoload.
-
-2001-08-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Misc -> Gnus.
-
- * gnus-group.el (gnus-group-make-menu-bar): Ditto.
-
- * gnus-art.el (gnus-output-to-file): Bind file-name-coding-system.
-
- * gnus-util.el (gnus-output-to-rmail): Ditto.
- (gnus-output-to-mail): Ditto.
-
- * nnmail.el (nnmail-pathname-coding-system): Set default to nil.
-
-2001-08-06 Florian Weimer <fw@deneb.enyo.de>
-
- * message.el (message-indent-citation): Use
- `message-yank-cited-prefix' for empty lines.
-
-2001-08-05 Florian Weimer <fw@deneb.enyo.de>
-
- * message.el (message-indent-citation): Quote only lines starting
- with ">" using `message-yank-cited-prefix'.
-
-2001-08-05 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
- Trivial patch.
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Use
- gnus-cache-fully-p.
-
-2001-08-04 Simon Josefsson <jas@extundo.com>
-
- * gnus-cache.el (gnus-cache-possibly-update-active): Create active
- file if it doesn't exist (by calling gnus-cache-read-active).
-
-2001-08-04 Simon Josefsson <jas@extundo.com>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): Revert.
- (gnus-cache-passively-or-fully-p): Removed.
- (gnus-cache-fully-p): Fix it.
-
- * mm-view.el (mm-pkcs7-signed-magic): Support more ASN.1 lengths.
-
-2001-08-04 Simon Josefsson <jas@extundo.com>
-
- * gnus-cache.el (gnus-cache-fully-p)
- (gnus-cache-passively-or-fully-p): New functions.
- (gnus-cache-possibly-enter-article): Cosmetic change, use
- `g-c-p-o-f-p'.
- (gnus-cache-possibly-enter-article): Use `g-c-p-u-a'; last change
- was bogus (`g-c-p-a-a' does not change active info, just change
- the functions parameters).
- (gnus-cache-possibly-remove-articles-1): Make sure articles are
- not removed in groups that match `gnus-uncacheable-groups'.
-
- Reported and modifications based on discussions with Nuutti
- Kotivuori <nuutti.kotivuori@smarttrust.com>.
-
-2001-08-04 Simon Josefsson <jas@extundo.com>
- Trivial patch from Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
-
- * gnus-cache.el (gnus-cache-possibly-update-active): New function;
- calls `gnus-cache-update-active' if bounds has been extended.
-
-2001-08-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-security-verify-or-decrypt): Insert
- before remove.
- (gnus-mime-security-show-details): Ditto.
-
-2001-08-04 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-split-fancy-with-parent): Correct `mapconcat'
- syntax. Protect string-match against nil string and regexp.
-
-2001-08-03 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Remove control-1.
-
-2001-08-03 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-readable-p): Emacs 20 takes one argument.
-
-2001-08-04 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-sign-region, smime-encrypt-region): Fix details
- buffer. Delete MIME-Version header.
-
-2001-08-03 Simon Josefsson <jas@extundo.com>
-
- * gnus-cache.el (gnus-cache-possibly-enter-article): The article
- that is entered does not necessarily have the highest article
- number in the group, so use `gnus-cache-possibly-alter-active'
- instead of `gnus-cache-update-active'.
-
-2001-08-03 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-gpg-extract-signature-details): Don't barf.
-
-2001-08-03 Simon Josefsson <jas@extundo.com>
-
- * mml.el (mml-menu): Rename from MML to Mime. Collapse Security
- menu.
-
-2001-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (post-method): New group parameter. It also provides
- the user option `gnus-post-method-alist' and the internal function
- `gnus-parameter-post-method'.
-
- * gnus-msg.el (gnus-post-method): Bind the value of
- `gnus-post-method' to the group parameter if it is defined.
-
-2001-08-02 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-extra-arguments): Removed.
- (smime-call-openssl-region): Don't use it.
-
-2001-08-02 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-sign-region): Handle stderr.
- (smime-encrypt-region): Ditto.
-
- * mm-view.el (mm-pkcs7-signed-magic): Make it a regexp. Don't
- match the ASN.1 length bytes.
- (mm-pkcs7-enveloped-magic): Ditto.
- (mm-view-pkcs7-get-type): Don't regexp quote.
-
-2001-08-01 14:00:00 Andreas Fuchs <asf@void.at>
-
- * mml2015.el (mml2015-trust-boundaries-alist): Typo.
-
-2001-08-01 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-header-button-alist): References regexp.
-
-2001-08-01 Gerd Moellmann <gerd@gnu.org>
-
- * mm-view.el (autoload): Don't autoload `diff-mode' if it's
- already fboundp. Add INTERACTIVE arg to autoload form.
-
-2001-08-01 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-init): Add as gnus buffer.
-
- * nnmail.el (nnmail-cache-open): Ditto.
-
-2001-07-31 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-button-fetch-group): Fix the regexp.
-
-2001-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-post-method): Refer to `gnus-parameters'.
-
-2001-07-31 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- Originally from Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-agent.el (gnus-agent-make-mode-line-string): New function.
- (gnus-agent-toggle-plugged): Use it.
-
-2001-07-31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-startup-file-coding-system): Revert to binary.
- (gnus-ding-file-coding-system): New variable.
- (gnus-read-newsrc-el-file, gnus-save-newsrc-file)
- (gnus-slave-save-newsrc): Use it.
-
-2001-07-31 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-initialize): Use standard define-key
- syntax.
-
-2001-07-30 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- Originally from Andreas Fuchs <asf@void.at>
-
- * mml2015.el (mml2015-trust-boundaries-alist): New variable.
- (mml2015-gpg-pretty-print-fpr): New function.
- (mml2015-gpg-extract-signature-details): More details, rename from
- `m-g-e-from'.
- (mml2015-gpg-verify): Use them.
- (mml2015-gpg-clear-verify): Use them.
-
-2001-07-31 Simon Josefsson <jas@extundo.com>
-
- * mml-smime.el (mml-smime-sign, mml-smime-encrypt): Goto end of
- buffer when done.
-
-2001-07-30 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-call-openssl-region): Revert previous change,
- just pass on buf to `call-process-region'.
- (smime-verify-region): Doc fix. Don't message stuff. Use
- `smime-new-details-buffer'. Inserts error messages into buffer.
- (smime-noverify-region): Ditto.
- (smime-decrypt-region): Ditto. Handles stderr separately.
- (smime-verify-buffer, smime-noverify-buffer)
- (smime-decrypt-buffer): Doc fix.
- (smime-new-details-buffer): New function.
- (smime-pkcs7-region, smime-pkcs7-certificates-region)
- (smime-pkcs7-email-region): Use `smime-new-details-buffer'.
- (smime-sign-region, smime-encrypt-region): Don't use
- `insert-buffer'.
-
- * mml-smime.el (mml-smime-verify): Fix security button strings.
-
-2001-07-30 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-save-part-and-strip): Save
- gnus-article-mime-handles.
-
-2001-07-29 Simon Josefsson <jas@extundo.com>
-
- * mail-source.el (top-level): Require message for message-directory.
- (mail-source-directory): Change default to message-directory.
-
- * smime.el (smime-keys, smime-CA-directory, smime-CA-file)
- (smime-certificate-directory, smime-openssl-program)
- (smime-encrypt-cipher, smime-dns-server): Fix doc (leading "*").
- (smime-extra-arguments): New variable.
- (smime-dns-server): Fix customize group.
- (smime-call-openssl-region): Use `smime-extra-arguments'.
-
-2001-07-29 Vladimir Volovich <vvv@vsu.ru>
-
- * smime.el (smime-call-openssl-region): Ignore stderr.
-
-2001-07-29 Christoph Conrad <christoph.conrad@gmx.de>
-
- * gnus-agent.el (gnus-agent-save-group-info): Don't destroy active
- file.
-
-2001-07-29 Simon Josefsson <jas@extundo.com>
-
- * mm-view.el (mm-view-pkcs7-decrypt): Adhere to `mm-decrypt-option'.
-
- Support S/MIME decryption.
-
- * mm-decode.el (mm-inline-media-tests):
- (mm-inlined-types):
- (mm-automatic-display):
- (mm-attachment-override-types): Add application/{x-,}pkcs7-mime.
-
- * mm-view.el (mm-pkcs7-signed-magic):
- (mm-pkcs7-enveloped-magic): New variables.
- (mm-view-pkcs7-get-type): New function; identify PKCS#7 type.
- (mm-view-pkcs7): New function; mm viewer for PKCS#7 blobs.
- (mm-view-pkcs7-decrypt): New function; mm viewer for encrypted
- PKCS#7 blobs.
-
- * smime.el (smime-decrypt-region): Expand keyfile.
-
-2001-07-29 Simon Josefsson <jas@extundo.com>
-
- * nntp.el (nntp-open-ssl-stream): Don't mess with internal
- `ssl.el' variables.
-
- * gnus-agent.el (gnus-agent-save-group-info): Delete everything
- but line instead of narrowing to it, because `nnmail-parse-active'
- calls widen. Thanks to Christoph Conrad
- <christoph.conrad@gmx.de>.
-
-2001-07-29 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.el (gnus-summary-line-format): Mention `gnus-sum-thread-*'
- for %B spec.
-
- * gnus-sum.el (gnus-summary-prepare-threads): If
- gnus-sum-thread-tree-root is nil, use subject instead.
- (gnus-sum-thread-tree-root, gnus-sum-thread-tree-single-indent)
- (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
- (gnus-sum-thread-tree-leaf-with-other)
- (gnus-sum-thread-tree-single-leaf): Documentation.
- (gnus-sum-thread-tree-single-indent): Allow nil.
-
-2001-07-28 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-fill-paragraph): Do nothing if the user
- wants filladapt-mode.
-
-2001-07-27 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-image-type-from-buffer): New function.
- (mm-get-image): Use it.
-
-2001-07-27 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-large-newsgroup): Add doc, "If it is nil, ..."
-
- * gnus-art.el (gnus-mime-view-all-parts): buffer-read-only covers
- mm-display-parts too.
-
-2001-07-27 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-accept-article): Bind
- nntp-server-buffer.
-
- * nnmail.el (nnmail-parse-active): Read from buffer instead of
- nntp-server-buffer.
-
-2001-07-27 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-check-news-header-syntax): Use
- message-post-method.
- (message-send-news): Bind message-post-method.
-
-2001-07-27 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-tweak-type-alist): New variable.
- (mml-tweak-function-alist): New variable.
- (mml-tweak-part): New function.
- (mml-generate-mime-1): Use it.
-
-2001-07-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-accept-article): Replace
- nnfolder-request-list.
-
-2001-07-27 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-open-server): Set nnimap-server-buffer if
- nnoo-change-server failed to do it.
-
-2001-07-26 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-parameters): Make it customizable.
-
-2001-07-26 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mm-display-part): Narrow to point if eobp.
-
- * message.el (message-set-auto-save-file-name): More
- poor-system-types.
-
- * mailcap.el (mailcap-parse-mimetypes): poor-system-types.
-
- * gnus-ems.el (nnheader-file-name-translation-alist): M$Windows-NT
- supports +.
-
-2001-07-26 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-readable-p): New function.
- (mm-inline-media-tests): Fix the default testers.
-
-2001-07-26 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-version): Bump version number.
-
-2001-07-26 10:00:00 Steven E. Harris <seh@speakeasy.org>
-
- * nnheader.el (nnheader-translate-file-chars): cygwin32 is running
- in M$Windows too.
-
-2001-07-26 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-send-drafts): Don't `error'.
-
-2001-07-25 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-bcklg.el (gnus-backlog-shutdown): Make interactive.
-
- * mm-decode.el (mm-get-image): Guess then use the type.
-
- * gnus-art.el (gnus-mime-view-part-as-type): Don't copy cache.
-
-2001-07-25 12:54:00 Danny Siu <dsiu@adobe.com>
-
- * gnus-sum.el (gnus-summary-prepare-threads): Shouldn't do tree
- display (%B) for threads if threading is off.
-
-2001-07-25 14:00:00 Henrik Enberg <henrik@enberg.org>
-
- * gnus-msg.el: Customization patch.
-
-2001-07-25 22:22:22 Raymond Scholz <rscholz@zonix.de>
-
- * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups): New
- variable.
- (nnmail-split-fancy-with-parent): Ignore certain groups.
-
-2001-07-25 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-byte-compile): New function.
- (gnus-use-byte-compile): New variable.
- (gnus-make-sort-function): Use it.
-
- * nnmail.el (nnmail-get-new-mail): Use it.
-
- * gnus-agent.el (gnus-category-make-function): Simple function or
- compiled function.
- (gnus-agent-fetch-group-1): Don't use (caaddr predicate).
-
- * gnus-gl.el (bbb-build-rate-command): Remove quote before lambda.
- * gnus-topic.el (gnus-topic-sort-topics-1): Ditto.
- (gnus-topic-sort-topics-1): Use gnus-byte-compile.
-
- * message.el (message-check-news-header-syntax): Remove quote.
-
-2001-07-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-use-mail-followup-to): `t' is not a
- documented value.
-
-2001-07-24 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-display-arrow): Test fboundp.
-
-2001-07-24 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-encode.el (mm-encode-buffer): Don't use 7bit encoding if
- there are long lines.
-
-2001-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (copy-list): New compiler macro.
-
-2001-07-24 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-bounce): If no Return-Path, the whole
- content is considered as the original message.
-
- * nnml.el (nnml-check-directory-twice): New variable.
- (nnml-article-to-file): Use it.
- (nnml-retrieve-headers): Hack it.
-
-2001-07-24 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-buffer-configuration): New configure.
-
- * gnus-art.el (gnus-mm-display-part): Don't select-window if it is
- not alive.
-
- * mm-decode.el (mm-remove-part): Don't murder the current window (nil).
- (mm-display-external): Use display-term configure.
-
-2001-07-24 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-default-hour): New variable.
- (gnus-delay-article): Allow specific date in YYYY-MM-DD format.
-
-2001-07-23 22:00:00 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-sum.el (gnus-summary-line-format-alist): Add %B.
- (gnus-summary-prepare-threads): Ditto.
-
- * gnus.el (gnus-summary-line-format): Add %B.
-
-2001-07-23 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-articles-to-read): Use gnus-group-decoded-name.
-
- * mm-util.el (mm-string-as-multibyte): New function.
-
- * nnmh.el (nnmh-request-list-1): Encode, not decode!
-
-2001-07-23 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-universal-coding-system): New variable.
-
- * gnus-start.el (gnus-startup-file-coding-system): Use it.
-
- * score-mode.el (score-mode-coding-system): Use it.
-
-2001-07-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-setup-news): Call
- `gnus-check-bogus-newsgroups' just after the native server is
- opened.
-
-2001-07-23 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-do-request-post): Util function to be used by
- `nnchoke-request-post' for all nnmail-derived backends.
-
- * nnml.el (nnml-request-post): Use it.
-
- * gnus.el (gnus-valid-select-methods): nnml is a post-mail
- backend, for it groks nnml-request-post.
-
- * gnus-group.el (gnus-group-highlight, gnus-group-highlight-line):
- Treat `mail-post' backends like `mail' backends, not like `news'
- backends.
-
-2001-07-22 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-setup-message): make-local-hook.
-
-2001-07-22 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el (gnus-delay-article): Fix `read-string' for
- XEmacs. Allow more units. Submitted by Karl Kleinpaste
- <karl@charcoal.com>, slightly changed by Kai.
-
- * message.el (message-check-news-header-syntax): When checking
- whether the groups exist, check the right server based on
- `gnus-post-method'.
-
-2001-07-21 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-delay.el: New file.
-
-2001-07-21 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-read-coding-system): Take two arguments.
-
- * gnus-sum.el (gnus-summary-show-article): Use
- mm-read-coding-system.
-
- * gnus-art.el (article-de-quoted-unreadable):
- (article-de-base64-unreadable, article-wash-html):
- (gnus-mime-inline-part, gnus-mime-view-part-as-charset): Ditto.
-
-2001-07-21 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnml.el (nnml-request-post): New function. Can be used for
- annotations in nnml groups.
-
-2001-07-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-request-newgroups): Use UTC date for NEWGROUPS
- command.
-
- * gnus-start.el (gnus-find-new-newsgroups): Use
- `message-make-date' instead of `current-time-string'.
- (gnus-ask-server-for-new-groups): Ditto.
- (gnus-check-first-time-used): Ditto.
-
-2001-07-20 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-home-score-file): nnheader-translate-file-chars.
-
-2001-07-18 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * message.el (message-shorten-references): Change `maxcount' and
- `cut' to obey USEFOR draft 5.
-
-2001-07-12 Colin Walters <walters@cis.ohio-state.edu>
-
- * gnus-sum.el (gnus-summary-display-arrow): New variable.
- (gnus-summary-set-article-display-arrow): New function.
- (gnus-summary-goto-subject): Use it.
-
-2001-07-18 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-import-article): Insert date if
- doesn't exist.
-
-2001-07-18 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-content-type-parameters): New variable.
- (mml-content-disposition-parameters): New variable.
- (mml-insert-mime-headers): Use them.
- (mml-parse-1): Accept charset.
-
-2001-07-17 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-select-group): Doc fix.
-
- * gnus-eform.el (gnus-edit-form-done): Return nil if end-of-file.
-
-2001-07-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (dgnushack-make-auto-load): Advise `make-autoload'
- to handle `define-derived-mode'.
-
-2001-07-16 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From: Stefan Monnier <monnier@cs.yale.edu>
-
- * message.el (message-mode): Use define-derived-mode.
- (message-tab): message-completion-alist.
-
- * imap.el (imap-interactive-login): Use make-local-variable.
- (imap-open): Ditto.
- (imap-authenticate): Ditto.
-
- * gnus-msg.el (gnus-setup-message): Change-major-mode-hook.
-
- * gnus-art.el (gnus-article-edit-mode): Use define-derived-mode.
-
-2001-07-16 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-citation-line-function): Refer to
- gnus-cite-attribution-suffix.
-
-2001-07-15 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-art.el,...: Error convention changes.
-
-2001-07-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-rebuild-thread): Count hidden lines too.
-
-2001-07-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-read-group-data): Nuke emacs-lisp-mode-hook.
- (nnrss-read-server-data): Ditto.
-
-2001-07-13 12:00:00 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-setup.el (gnus-use-installed-gnus): Typo.
- * Cleanup files.
-
-
-2001-07-13 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-summary-line-format): Add %o.
-
- * gnus-sum.el (gnus-summary-pipe-output): Don't configure as pipe
- unless shell outputs something.
-
-2001-07-13 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-boring-article-headers): Better doc.
- (article-hide-headers): Better regexp.
- Suggested by Matt Swift <swift@alum.mit.edu>.
-
- * nnheader.el (nnheader-max-head-length): Better doc.
- (nnheader-header-value): Skip spaces.
- (nnheader-parse-head): Remove space.
- Suggested by Matt Swift <swift@alum.mit.edu>.
-
- * gnus-sum.el (gnus-summary-show-raw-article): New function.
- (gnus-get-newsgroup-headers): Remove space.
-
-2001-07-12 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-msg-treat-broken-reply-to): Add force.
- (gnus-summary-reply): Use it.
- (gnus-summary-reply-broken-reply-to): New function.
- (gnus-msg-force-broken-reply-to): New function.
-
- * mm-view.el (mm-inline-text): Showing as text/plain when error.
-
-2001-07-12 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-setup): Restore gnus-newsgroup-name.
-
-2001-07-12 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-external-terminal-program): New variable.
- (mm-display-external): Use it. Use term to display when no
- window-system.
-
-2001-07-12 Bj\e,Av\e(Brn Torkelsson <torkel@hpc2n.umu.se>
-
- * gnus-srvr.el (gnus-browse-make-menu-bar): Changed one of the
- Browse->Next entries to Browse->Prev
-
-2001-07-11 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-do-gcc): Don't test gnus-alive-p.
-
-2001-07-11 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-encode.el (mm-content-transfer-encoding-defaults): Use base64
- for the default encoding.
-
- * nnrss.el (nnrss-url-field): New field.
- (nnrss-request-article): Add newsgroups.
-
- * nnfolder.el (nnfolder-read-folder): Force to use a multibyte buffer.
-
-2001-07-11 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-restore-buffer): Don't remove Date.
-
- * gnus-draft.el (gnus-draft-edit-message): Remove Date here.
- (gnus-draft-setup): Remove backlog.
-
-2001-07-10 Pavel Jan
\e,Am
\e(Bk <Pavel@Janik.cz>
-
- * gnus-logic.el, gnus-srvr.el, gnus-vm.el, nnheaderxm.el, nnoo.el:
- Cleanup.
-
-2001-07-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-bug): Erase buffer.
-
- * nnfolder.el (nnfolder-possibly-change-group): Don't create group.
-
-2001-07-09 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-attachment-override-p): Fix typo.
-
-2001-03-19 05:28:00 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-kill.el (gnus-execute): Work with the extra headers.
- * gnus-sum.el (gnus-summary-execute-command): Ditto.
-
-2001-07-09 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): w3-coding-system-for-mime-charset
- may not defined. From: Raja R Harinath <harinath@cs.umn.edu>.
-
- * message.el (message-send-mail-real-function): New variable.
- (message-send-mail-partially, message-send-mail):
-
- * nngateway.el (nngateway-request-post): Use it.
-
- * gnus-agent.el (gnus-agentize): Use it.
-
- * nnsoup.el (nnsoup-old-functions, nnsoup-set-variables)
- (nnsoup-revert-variables): Use it.
-
-2001-07-09 Colin Walters <walters@cis.ohio-state.edu>
-
- * mm-decode.el (mm-inline-media-tests): Default to displaying as
- text/plain if the type doesn't match any other media types.
- (mm-inlined-types): Doc fix.
- (mm-display-inline): Revert previous change (now handled by a
- default type in `mm-inline-media-tests'.
- (mm-inlinable-p): Revive.
- (mm-display-part): Call `mm-inlinable-p'.
- (mm-attachment-override-p): Ditto.
- (mm-inlined-p): Doc fix.
-
- * gnus-art.el (gnus-mime-display-single): Call `mm-inlinable-p' as
- well as `mm-inlined-p'.
-
-2001-07-09 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-send-command, nntp-send-command-nodelete):
- (nntp-send-command-and-decode): Use gnus-point-at-bol.
-
-2001-07-09 13:00:00 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-use-mail-followup-to): New variable.
- (message-get-reply-headers): Use it.
-
-2001-07-04 Gerd Moellmann <gerd@gnu.org>
-
- * nnheader.el (nnheader-init-server-buffer): Make sure the
- *nntpd* buffer is made multibyte instead of a random buffer.
-
-2001-07-09 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-get-newsgroup-headers-xover): Get headers only
- when it returns headers.
-
-2001-07-07 Simon Josefsson <jas@extundo.com>
-
- * rfc2047.el (rfc2047-encode-message-header): Skip header when
- trying to fold. Thanks to Colin Walters
- <walters@cis.ohio-state.edu>
-
-2001-07-06 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-parse-address-list, imap-parse-flag-list)
- (imap-parse-body-extension, imap-parse-body-ext, imap-parse-body):
- Add information in `assert's.
-
- * nnimap.el (nnimap-possibly-change-group): Ignore uidvalidity
- changes. (From nnimaps' point of view, `nnimap-verify-uidvalidity'
- and `nnimap-group-overview-filename', should handle all
- change-of-uidvalidity related issues. But there may be other
- problems.)
-
-2001-07-05 Colin Walters <walters@cis.ohio-state.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Don't include the
- header name when folding.
-
-2001-07-05 Colin Walters <walters@cis.ohio-state.edu>
-
- * mm-decode.el (mm-inlined-types): Document relationship with
- `mm-inline-media-tests'.
- (mm-display-inline): Default to displaying as plain text if no
- inlining handler is available.
- (mm-inlinable-p): Remove.
- (mm-inlined-p): Don't call `mm-inlinable-p'.
- (mm-automatic-display-p): Ditto.
- (mm-attachment-override-p): Ditto.
-
-2001-07-04 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-importantize-dormant): New variable.
- (nnimap-request-update-info-internal): Use it.
- (nnimap-request-set-mark): Ditto.
-
-2001-07-04 Didier Verna <didier@lrde.epita.fr>
-
- * nntp.el (nntp-send-command): don't pass a buffer argument to
- `point'. Only XEmacs accepts this.
- * nntp.el (nntp-send-command-nodelete): ditto.
- * nntp.el (nntp-send-command-and-decode): ditto.
-
-2001-07-04 Didier Verna <didier@lrde.epita.fr>
-
- * nntp.el (nntp-open-connection-function): doc update.
- * nntp.el (nntp-pre-command): New.
- * nntp.el (nntp-via-rlogin-command): New.
- * nntp.el (nntp-via-telnet-command): New.
- * nntp.el (nntp-via-telnet-switches): New.
- * nntp.el (nntp-via-user-name): New.
- * nntp.el (nntp-via-user-password): New.
- * nntp.el (nntp-via-address): New.
- * nntp.el (nntp-via-envuser): New.
- * nntp.el (nntp-via-shell-prompt): New.
- * nntp.el (nntp-open-telnet-stream): New.
- * nntp.el (nntp-open-via-rlogin-and-telnet): New.
- * nntp.el (nntp-open-via-telnet-and-telnet): New.
- * nntp.el (nntp-wait-for): check for possibly echo'ed commands.
- * nntp.el (nntp-send-command): ditto.
- * nntp.el (nntp-send-command-nodelete): ditto.
- * nntp.el (nntp-send-command-and-decode): ditto.
-
-2001-06-30 YAGI Tatsuya <yagi@is.titech.ac.jp>
- Trivial patch.
-
- * gnus-start.el (gnus-check-first-time-used): Use `if' instead of
- `when'.
-
-2001-07-03 Nuutti Kotivuori <nuutti.kotivuori@smarttrust.com>
-
- * flow-fill.el (fill-flowed): Use (1+ (point-at-eol)) instead.
-
-2001-07-03 Simon Josefsson <jas@extundo.com>
-
- * flow-fill.el (fill-flowed): If `fill-region' inserts empty line,
- remove it (workaround XEmacs `fill-region' bug).
-
-2001-07-01 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-date-days-ago): Defeat locale.
-
-2001-06-28 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-format-error): New function.
- (mml2015-mailcrypt-decrypt, mml2015-mailcrypt-clear-decrypt)
- (mml2015-mailcrypt-verify, mml2015-gpg-clear-verify)
- (mml2015-mailcrypt-clear-verify, mml2015-gpg-verify): Use it.
-
-2001-06-26 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-retrieve-headers): The description may not exist.
- Suggested by Christoph Conrad <C.Conrad@cli.de>.
-
- * gnus-sum.el (gnus-summary-set-local-parameters): Don't override
- group variables.
-
-2001-06-25 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-write-groups): Use gnus-prin1.
-
- * nnrss.el (nnrss-save-server-data): Bind print-level and print-length.
- (nnrss-save-group-data): Ditto.
-
- * gnus-agent.el (gnus-agent-save-alist): Ditto.
-
-2001-06-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-do-send-housekeeping): Narrow to headers.
-
-2001-06-24 Simon Josefsson <jas@extundo.com>
-
- * rfc2047.el (rfc2047-fold-region): The check to skip WSP
- insertion when breaking lines looked for " \t" instead of "[ \t]".
- (rfc2047-encode-message-header): Fold lines even if
- no QP encoding is done.
-
-2001-06-23 Samuel Tardieu <sam@inf.enst.fr>
-
- * smime.el (smime-keys): Support additional certificates.
- (smime-make-certfiles): New function.
- (smime-sign-region): Use previous variables.
- (smime-get-certfiles): New function.
- (smime-sign-buffer): Use it.
- (smime-verify-region): Support both CAfile and CApath.
-
-2001-06-23 Simon Josefsson <jas@extundo.com>
-
- * smime.el (smime-decrypt-region): Perhaps work.
-
-2001-06-22 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-copy-article-buffer): Typo.
-
-2001-04-06 Ralph Schleicher <rs@nunatak.allgaeu.org>
-
- * mm-decode.el (mm-save-part): Rewrite file name.
- (mm-file-name-rewrite-functions): New variable.
- (mm-file-name-delete-whitespace): New function.
- (mm-file-name-trim-whitespace): New function.
- (mm-file-name-collapse-whitespace): New function.
- (mm-file-name-replace-whitespace): New variable and function.
-
-2001-06-22 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-make-date): Workaround locale for weekdays.
-
-2001-06-21 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-goto-body): Return nil if not found. (revert!)
-
-2001-06-21 10:00:00 John Fremlin <chief@bandits.org> (tiny change)
-
- * message.el (message-goto-body): Some messages have no header.
-
- * gnus-msg.el (gnus-copy-article-buffer): Use it.
-
-2001-06-21 Ralph Schleicher <rs@nunatak.allgaeu.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Date fix.
-
-2001-06-21 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-date): Add week day.
- Suggested by Jason R. Mastaler <jason@mastaler.com>.
-
-2001-06-19 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-yank-prefix): Doc fix.
- (message-yank-cited-prefix): Ditto.
- (message-delete-not-region): Keep citation prefix on first line,
- if possible and appropriate.
-
-2001-06-19 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-process-connection-type): New variable.
- (imap-kerberos4-open, imap-gssapi-open): Use it. This makes
- recent `imtest's work completely (no line length issues), while
- making making old `imtest's unusable. Thanks to NAGY Andras
- <nagya@inf.elte.hu> for his work.
-
-2000-12-30 NAGY Andras <nagya@inf.elte.hu>
-
- * imap.el (imap-ssl-program): Add -quiet to shut up
- OpenSSL/SSLeay's internal debug talk.
-
-2001-06-19 Matt Armstrong <matt@lickey.com>
-
- * imap.el (imap-parse-flag-list): Workaround bug in Courier IMAP
- server.
-
-2001-06-19 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-article-buffer): New variable.
- (nnmail-split-incoming): Use it.
-
-2001-06-15 Eli Zaretskii <eliz@is.elta.co.il>
-
- * qp.el (quoted-printable-decode-region): If called interactively,
- use coding-system-for-read.
-
-2001-06-16 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-check-news-header-syntax): Check Reply-To.
-
-2001-06-16 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-parse-1): Use message options.
-
- * message.el (message-do-fcc): Don't do anything if there is no
- FCC.
-
-2001-06-16 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-split-articles): Support 'junk to-groups.
- (nnimap-expunge-search-string): New variable.
- (nnimap-request-expire-articles): Use it.
-
-2001-06-15 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-send-mail-with-qmail): wrong exit status is
- 100 not 1. Reported by Paul Jarc <prj@po.cwru.edu>.
-
-2001-06-15 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-strip-multiple-blank-lines): Use
- delete-region instead of replace-match.
-
-2001-06-14 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-google-parse-1): Fix Google content regexp.
- (nnweb-google-wash-article): Ditto.
-
-2001-06-14 Ferenc Wagner <wferi@bolyai1.elte.hu>
-
- * nnweb.el (nnweb-google-parse-1): Fix Google url regexp.
-
-2001-06-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-define-group-parameter): Don't quote the defcustom
- specs.
-
-2001-06-13 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-email-address): Move it here.
-
- * gnus-art.el (article-de-quoted-unreadable): Read charset if
- requested.
- (article-de-base64-unreadable): Ditto.
- (article-wash-html): Ditto.
-
-2001-06-12 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-options-set-recipient): Don't add ", "
- unless necessary. Suggested by Josh Huber <huber@alum.wpi.edu>.
-
-2001-06-12 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-group-alist): Use |fr| instead of [fr].
-
-2001-06-12 11:00:00 Marc Lefranc <Marc.Lefranc@univ-lille1.fr>
-
- * gnus-art.el (gnus-plain-save-name): Use file-relative-name.
-
-2001-06-12 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-node-text): Node might be nil.
-
-2001-06-11 10:00:00 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-uu.el (gnus-uu-save-article): Use mml tag instead of
- part.
-
-2001-06-11 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-group-alist): More items.
-
-2001-06-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-node-text): Use cddr instead xml-node-children.
-
-2001-06-03 ShengHuo ZHU <zsh@cs.rochester.edu>
- Trivial patch from Dale Hagglund <rdh@best.com>
-
- * gnus-mlspl.el (gnus-group-split-fancy): Fix generation of split
- restrict clauses.
-
-2001-06-07 16:00:00 Benjamin Rutt <brutt+news@bloomington.in.us>
-
- * message.el (message-wide-reply-confirm-recipients): New variable.
-
-2001-06-06 Mark Thomas <mthomas@edrc.cmu.edu> (tiny change)
-
- * nnmail.el (nnmail-fix-eudora-headers): Change the In-Reply-To
- fix so it works with XEmacs.
-
-2001-06-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-retrieve-headers): Support description as extra
- headers.
-
-2001-06-07 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el: Fix a few bugs.
-
-2001-06-05 Alex Schroeder <alex@gnu.org>
-
- * mm-decode.el (mm-handle-set-external-undisplayer): Don't
- generate compiler warnings.
-
-2001-06-04 Hrvoje Niksic <hniksic@arsdigita.com>
-
- * mm-decode.el (mm-pipe-part): Bind coding-system-for-write to
- binary so that we don't transmit ISO 2022 garbage to the process.
- This is needed under XEmacs.
-
-2001-06-03 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-ssl-open): Require ssl. (Otherwise ssl.el is
- autoloaded incorrectly below because ssl-program-* is bound.)
- Thanks to Amos Gouaux for report.
-
-2001-06-02 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-kerberos4-open):
- (imap-gssapi-open):
- (imap-ssl-open):
- (imap-network-open):
- (imap-shell-open):
- (imap-starttls-open): Set buffer to workaround spurious
- `accept-process-output' buffer changes. Thanks to Mats Lidell
- <Mats.Lidell@contactor.se> for report and partial patch and Jake
- Colman <colman@ppllc.com> for report.
-
-2001-05-31 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-catchup): New argument.
- (gnus-summary-catchup-from-here): New function.
-
-2001-05-30 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * mm-view.el (mm-inline-image-xemacs): Insert newline, then move
- back, then insert glyph. (Before, the glyph was inserted first,
- then the newline.) This works around a behavior in XEmacs where
- it is not possible to insert a character after a glyph which is at
- the end of a buffer. Patch by Lloyd Zusman <ljz@asfast.com>.
-
-2001-05-28 Jaap-Henk Hoepman <jhh@xs4all.nl>
-
- * mm-decode.el (mm-keep-viewer-alive-types): New variable.
- (mm-keep-viewer-alive-p, mm-handle-set-external-undisplayer,
- mm-destroy-postponed-undisplay-list): New functions.
- (mm-display-external): Use them.
-
-2001-05-27 Raja R. Harinath <harinath@cs.umn.edu>
-
- * gnus-salt.el (gnus-tree-highlight-node): Bind `default-high' and
- `default-low' when evaluating `gnus-summary-highlight'.
-
-2001-05-27 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-yank-cited-prefix): New variable.
- (message-indent-citation): Use it.
-
- * mml2015.el (mml2015-mailcrypt-verify): Store gpg stderr output
- as details.
- (mml2015-mailcrypt-clear-verify): Ditto.
-
-2001-05-24 Nevin Kapur <nevin@jhu.edu>
-
- * gnus-sum.el (gnus-summary-default-high-score,
- gnus-summary-default-low-score): New variables.
- (gnus-summary-highlight): Use them.
-
-2001-05-16 Didier Verna <didier@lrde.epita.fr>
-
- * message.el (message-mail): pass the 'send-actions argument to
- `message-setup'.
-
-2001-05-16 Raymond Scholz <ray-2001@zonix.de>
-
- * gnus-art.el (gnus-mime-view-part-as-charset):
- (gnus-mime-internalize-part): Doc fixes.
-
-2001-05-11 Simon Josefsson <simon@josefsson.org>
-
- * gnus-start.el (gnus-ignored-newsgroups): Also ignore NNTP type
- status lines without any text ("^215$").
-
-2001-05-06 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-check-group): Reverse.
-
-2001-05-07 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-get-reply-headers):
- (message-followup): Fix typo, suggested by David Green
- <dgreen@uab.edu>
-
-2001-05-05 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-request-expire-articles): Fix.
-
- * nnrss.el (nnrss-open-server): Read server data when it is called.
- (nnrss-request-expire-articles): Fix.
-
-2001-05-05 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-do-send-housekeeping): mail-abbrevs may
- rename buffer behind Gnus.
-
-2001-05-04 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-check-group): Use nnheader-translate-file-chars.
- (nnrss-group-alist): Add more resources.
- (nnrss-check-group): Ignore errors.
-
-2001-05-04 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-request-expire-articles): Correct the return value.
-
- * nnslashdot.el (nnslashdot-request-list): Add time.
- (nnslashdot-request-expire-articles): New function.
-
- * gnus-start.el (gnus-check-bogus-newsgroups): Remove bogus
- secondary methods too.
-
-2001-05-03 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-use-followup-to): Set default value to t.
-
-2001-05-03 Florian Weimer <fw@deneb.enyo.de>
-
- * message.el (message-dont-reply-to-names): Fix documentation.
- (message-get-reply-headers): Use Mail-Followup-To only for wide
- replies.
-
-2001-05-03 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-request-expire-articles): Calculate # of days
- correctly.
- (nnrss-check-group): Use time.
-
-2001-05-01 19:21:19 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.03 is released.
-
-2001-05-01 19:06:21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-topic-article-to-article): Use the
- group.
-
-2001-04-24 19:50:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-srvr.el (gnus-server-insert-server-line): Add a space.
-
-2001-04-15 14:55:03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Return all
- available headers.
-
- * gnus-sum.el (gnus-read-all-available-headers): New variable.
- (gnus-get-newsgroup-headers-xover): Use it.
-
-2001-04-14 15:47:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Clean up.
-
-2001-04-30 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-retrieve-groups): Use throw instead of error.
-
-2001-04-29 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el (nnrss-insert-w3): Use cache before I figure out how to
- disable it.
-
- * gnus.el (gnus-info-nodes): Remove a few The's.
-
-2001-04-29 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-movemail): Call-process may return a
- signal description string.
-
- * gnus-start.el (gnus-read-newsrc-el-file):
- gnus-newsrc-file-version may be nil.
-
- * nnmail.el (nnmail-get-new-mail): Use the exact file only.
- Suggested by Michael Sperber [Mr. Preprocessor]
- <sperber@informatik.uni-tuebingen.de>.
-
-2001-04-25 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mm-uu.el (mm-uu-configure-list): Fixed customize type.
-
-2001-04-24 Hrvoje Niksic <hniksic@arsdigita.com>
-
- * mm-view.el (mm-display-inline-fontify): Allow XEmacs to fully
- fontify HANDLE.
-
-2001-04-18 Simon Josefsson <simon@josefsson.org>
-
- * smime.el (smime-ask-passphrase): Rework to return value.
- (smime-sign-region): Rework to bind value and use it.
- (smime-decrypt-region): Ditto.
-
-2001-04-18 Simon Josefsson <simon@josefsson.org>
- Trivial patch from Mathias Herberts <Mathias.Herberts@iroise.net>
-
- * smime.el (smime-ask-passphrase): New function.
- (smime-sign-region): Use it.
- (smime-encrypt-cipher): New variable.
- (smime-decrypt-region): Ditto.
-
-2001-04-12 Jason Merrill <jason_merrill@redhat.com>
-
- * imap.el (imap-shell-open): Erase the buffer *after* copying it into
- the log.
-
-2001-04-14 01:14:42 Lars Magne Ingebrigtsen <lars@ingebrigtsen.no>
-
- * gnus.el: Oort Gnus v0.02 is released.
-
-2001-04-14 00:48:42 Lars Magne Ingebrigtsen <larsi@quimby.gnus.org>
-
- * gnus.el: Oort Gnus v0.01 is released.
-
-2001-04-13 22:01:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-highlight): Highlight read
- undownloaded articles as read articles.
-
- * gnus-agent.el (gnus-agent-get-undownloaded-list): Clean up.
- (gnus-agent-get-undownloaded-list): Mark all undownloaded
- articles, even read ones, as such.
-
- * gnus-sum.el (gnus-summary-find-matching): Clean up.
- (gnus-find-matching-articles): New function.
- (gnus-summary-limit-include-matching-articles): New command.
- (gnus-summary-limit-include-thread): Include articles that have
- matching subjects.
- (gnus-offer-save-summaries): Clean up.
-
-2001-04-13 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * nnmail.el (nnmail-split-fancy-with-parent): Add docstring.
-
-2001-04-12 19:00:00 Jason Merrill <jason_merrill@redhat.com>
-
- * gnus-sum.el (gnus-summary-insert-new-articles): Reverse the articles.
-
-2001-04-10 08:01:15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-post-news): Fill the Newsgroups header by the
- newsgroup names when the original article is a news message.
-
-2001-04-12 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cite-prefix-regexp): Use POSIX regexp if
- supported. Suggest by Jim Meyering <jim@meyering.net>.
-
-2001-04-02 Nevin Kapur <nevin@jhu.edu>
-
- * nnmail.el (nnmail-split-it): Added check for .* at the end of
- regexp in nnmail-split-fancy.
-
-2001-04-10 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-options-set-recipient): Look at Cc and Bcc too.
-
-2001-04-10 Colin Marquardt <colin@marquardt-home.de>
-
- * message.el (message-send-mail): Improve the interaction with the
- user.
-
-2001-04-10 Simon Josefsson <simon@josefsson.org>
-
- * imap.el (imap-message-copy): Work around buggy servers that
- doesn't send TRYCREATE tags.
-
-2001-04-09 01:15:54 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-read-newsrc-el-file): Work with Semi-gnusae.
-
-2001-04-05 21:43:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-update-summary-mark-positions): Use a valid
- date.
-
-2001-04-04 16:13:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-quit): Check that the dribble buffer
- lives.
-
-2001-04-02 00:40:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-parse-news-url): New function.
- (gnus-button-handle-news): New function.
- (gnus-button-alist): Point to new functions.
-
- * gnus-group.el (gnus-group-quit): Only mark buffer in non-empty.
-
- * gnus-start.el (gnus-read-newsrc-el-file): Nix out
- gnus-format-specs.
-
- * message.el (message-check-news-header-syntax): Question even
- when Gnus doesn't know the group names.
- (message-send-news): Clean up.
-
- * gnus-start.el (gnus-dribble-read-file): Say whether Gnus was
- exited on purpose without saving.
-
- * gnus-group.el (gnus-group-quit): Mark the dribble file as `Q'.
-
-2001-04-01 00:37:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-score.el (gnus-score-orphans): Clean up.
-
- * gnus-win.el (gnus-remove-some-windows): Leave one Gnus window.
-
- * gnus-sum.el (gnus-summary-exit): Kill the summary buffer a bit
- later.
-
- * gnus-start.el (gnus-close-all-servers): Find the right items to
- close.
-
- * qp.el (quoted-printable-decode-region): Just message
- malformation; don't quit.
-
-2001-03-31 21:00:00 Gerd Moellmann <gerd@gnu.org>
-
- * gnus.el (gnus-interactive): A typo.
-
-2001-03-26 Juanma Barranquero <lektu@uol.com.br>
-
- * gnus-util.el (gnus-delete-alist): Declare it as an alias of
- `assq-delete-all', if that function exists; otherwise use the old
- definition. Documentation changed to match the one in
- `assq-delete-all'.
-
-2001-04-01 00:37:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-close-all-servers): New function.
-
- * gnus-srvr.el (gnus-server-close-all-servers): Clean up.
- (gnus-server-remove-denials): Clean up.
-
- * gnus-sum.el (gnus-summary-sort-by-original): New command and
- keystroke.
-
-2001-03-31 02:56:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-send-news): Message where we are sending.
- (message-send-mail): Ditto.
-
- * gnus.el (gnus-server-string): New function.
-
- * gnus-sum.el (gnus-summary-up-thread): Doc fix.
-
- * mm-decode.el (mm-default-directory): Customized.
- (mm-tmp-directory): Ditto.
-
- * gnus-sum.el (gnus-summary-catchup-and-exit): Doc fix.
- (gnus-get-newsgroup-headers): Return -1 for articles without Lines
- or Chars.
- (gnus-summary-line-format-alist): ?l is now a string.
- (gnus-summary-prepare-threads): Output ? for unknown lines.
- (gnus-summary-insert-line): Ditto.
- (gnus-summary-print-article): Unbalanced parentheses.
-
- * gnus-msg.el (gnus-inews-do-gcc): Check group to allow it to find
- out whether new stuff has arrived.
-
-2001-03-31 02:14:38 Alan Shutko <ats@acm.org>
-
- * gnus-sum.el: Let printing work on ttys on Emacs.
-
-2001-03-31 01:11:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-post-news): Add an empty Newsgroups header
- when forcing news.
-
- * gnus-sum.el (gnus-summary-mark-article-as-replied): Make into a
- command.
-
-2001-03-31 01:04:54 Francis Litterio <franl@world.std.com>
-
- * message.el (message-set-auto-save-file-name): Don't use
- asterisks under nt.
-
-2001-03-31 00:03:42 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-inews-insert-draft-meta-information): Allow
- lists of articles.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Mark as forwarded.
-
- * gnus-msg.el (gnus-put-message): Clean up.
- (gnus-summary-reply): Mark all replied-to articles as replied to.
- (gnus-inews-add-send-actions): Also mark as forwarded.
- (gnus-summary-mail-forward): Mark as forwarded.
-
- * gnus-sum.el (gnus-summary-mark-article-as-replied): Take a list
- of articles.
- (gnus-summary-mark-article-as-forwarded): Ditto.
-
- * gnus-msg.el (gnus-summary-resend-message): Mark article as
- forwarded.
- (gnus-summary-mail-forward): Clean up.
-
- * gnus.el (gnus-article-mark-lists): Added forward.
-
- * gnus-sum.el (gnus-forwarded-mark): New variable.
- (gnus-summary-prepare-threads): Use it.
- (gnus-summary-update-secondary-mark): Ditto.
- (gnus-newsgroup-forwarded): New variable.
-
-2001-03-30 23:13:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-summary-reply): Allow very wide replies.
- (gnus-summary-very-wide-reply): New command and keystroke.
- (gnus-summary-very-wide-reply-with-original): Ditto.
-
- * gnus-score.el (gnus-adaptive-word-length-limit): New variable.
- (gnus-score-adaptive): Use it.
-
- * gnus-start.el (gnus-get-unread-articles): Clean up.
-
-2001-03-21 20:00:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Work for other
- boards.
-
-2001-03-21 Didier Verna <didier@lrde.epita.fr>
-
- * gnus-start.el (gnus-subscribe-newsgroup-hooks): New.
- * gnus-start.el (gnus-subscribe-newsgroup): use it.
-
-2001-03-15 09:47:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-retrieve-headers): Understand
- long-form month names.
-
-2001-03-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-all-headers):
- gnus-article-show-all-headers is broken. Use
- gnus-summary-toggle-header instead.
-
- * mml2015.el (mml2015-gpg-extract-from): No error.
-
-2001-03-18 23:00:00 Bj\e,Ax\e(Brn Mork <bmork@dod.no>
-
- * mml2015.el (mml2015-gpg-extract-from): New function.
- (mml2015-gpg-verify): Use it.
- (mml2015-gpg-clear-verify): Use it.
-
-2001-03-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup-fill-variables): Use
- fill-paragraph-function.
- (message-fill-paragraph): Take an argument.
- (message-newline-and-reformat): Take another argument.
-
-2001-03-16 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (rmail-output): It is in rmailout.el not rmail.el.
-
-2001-03-16 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward): local-variable-p takes an extra
- argument in XEmacs.
-
-2001-03-16 Simon Josefsson <simon@josefsson.org>
-
- * nnimap.el (nnimap-dont-use-nov-p): Renamed from
- `nnimap-use-nov-p' (it really tested the negative).
- (nnimap-retrieve-headers): Use it.
-
-2001-03-11 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-generate-headers-first): Update doc.
-
-2001-03-10 Matthias Wiehl <mwiehl@gmx.de>
- Trivial patch.
-
- * gnus.el (gnus-summary-line-format): Typo.
-
-2001-03-11 Simon Josefsson <simon@josefsson.org>
-
- * mailcap.el (mailcap-mime-data): Add application/sieve.
- (mailcap-mime-extensions): Add .siv, .xls.
-
-2001-03-14 20:00:00 Christoph Conrad <christoph.conrad@gmx.de>
-
- * gnus-score.el (gnus-summary-lower-thread): Typo.
-
-2001-03-14 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-forward-decoded-p): New variable.
- (message-forward-subject-author-subject): Use it.
- (message-make-forward-subject): Use it.
- (message-forward): Use it.
-
- * gnus-uu.el (gnus-uu-digest-mail-forward): Use it.
-
- * mm-util.el, message.el, rfc2047.el, gnus-sum.el, gnus-score.el:
- Sync with Emacs 21 (tag EMACS_PRETEST_21_0_100).
-
-;;Has been fixed -- zsh.
-;;2001-03-05 Dave Love <fx@gnu.org>
-;;
-;; * mm-util.el (mm-mime-mule-charset-alist): Fix utf-8 case.
-;; Move it after definition of mm-coding-system-p.
-;;
-2001-03-01 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-inhibit-file-name-handlers): Add
- image-file-handler.
-
-2001-02-11 Dave Love <fx@gnu.org>
-
- * message.el (message-signature-file): Fix doc, :type.
-
-2001-02-08 Dave Love <fx@gnu.org>
-
- * rfc2047.el (rfc2047-fold-region): Don't forward-char at EOB.
- (message-posting-charset): Defvar when compiling again.
- (rfc2047-encodable-p): Require message.
-
- * gnus-sum.el (gnus-alter-articles-to-read-function):
- * gnus-score.el (gnus-score-after-write-file-function): Fix :type.
-
-2001-03-08 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnrss.el: New file.
-
-2001-03-08 02:41:36 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-unfold-region): Fix arg of
- `skip-chars-forward'.
-
-2001-03-07 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-group): Restore auto save files if
- the original files do not exist.
-
-2001-03-07 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-find-bnews): Print messages on illegal
- SCORE paths.
-
- * mm-decode.el (mm-dissect-buffer): Call
- mail-extract-address-components only if necessary.
-
-2001-03-06 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-find-bnews): Maybe there is no
- directory part.
- (gnus-score-search-global-directories): Use file-directory-p.
-
-2001-03-06 13:00:00 Adrian Aichner <adrian@xemacs.org>
-
- * gnus-score.el (gnus-score-score-files-1): Use
- gnus-kill-files-directory.
-
-2001-03-05 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (charset): Move here from gnus-sum.el.
-
-2001-03-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-preview): Disable local map.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Make
- gnus-article-post-menu here.
-
- * gnus-art.el (gnus-article-make-menu-bar): Make summary-menu bar
- if it has not been made.
-
-2001-03-02 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-describe-key): Map key to event.
- (gnus-article-describe-key-briefly): Ditto
-
-2001-03-01 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-limit-include-expunged): Fix.
-
-2001-03-01 22:00:00 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el (coerce, merge, subseq): defmacro.
-
-2001-03-01 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el (nndraft-request-group): Move it here from nndraft.el.
- A fake defalias in nndraft.el results a not-activated bug in
- uncompiled versions.
-
-2001-02-26 11:27:27 Paul Jarc <prj@po.cwru.edu>
-
- * gnus-util.el (gnus-split-references): Handle malformed References:.
-
-2001-02-26 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-mime-part-status): 1 part.
-
-2001-02-25 10:00:00 NAGY Andras <nagya@inf.elte.hu>
-
- * gnus.el (gnus-parameters): Typo.
-
-2001-02-24 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-read-method): Remove redundancy.
-
-2001-02-23 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnslashdot.el (nnslashdot-backslash-url): New variable.
- (nnslashdot-request-list): Use it.
-
-2001-02-23 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnml.el (nnml-generate-active-info): Fix the case when there is
- no file.
-
- * gnus-sum.el (gnus-summary-import-article): Display it. Enable edit.
- (gnus-summary-create-article): New function.
-
- * gnus-group.el (gnus-group-mark-article-read): New function.
-
- * gnus-msg.el (gnus-inews-do-gcc): Use it.
-
- * gnus-art.el (gnus-article-edit-article): Set modified-p nil.
-
-2001-02-23 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-edit-done): Don't use
- gnus-article-edit-exit.
- (gnus-article-edit-exit): Confirm and insert original-article-buffer.
-
- * gnus.el (gnus-parameters): New variable.
- Suggested by NAGY Andras <nagya@inf.elte.hu>.
- (gnus-parameters-get-parameter): New function.
- (gnus-group-find-parameter): Use it.
-
-2001-02-23 Simon Josefsson <simon@josefsson.org>
-
- * gnus-msg.el (gnus-post-method): Fix documentation to reflect
- change of default value to `current'.
-
-2001-02-23 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nneething.el (nneething-get-head): Insert unreadable file too.
-
-2001-02-22 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-insert-articles): Remove fetched headers.
-
- * webmail.el (webmail-type-definition): Deja is bought by google.
-
-2001-02-22 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-fetch-headers): New function.
- (gnus-select-newsgroup): Use it.
- (gnus-summary-insert-articles): New function.
- (gnus-summary-insert-old-articles): New function.
- (gnus-summary-insert-new-articles): New function.
-
- * gnus-group.el (gnus-group-prepare-flat-list-dead): Use decoded-name.
- (gnus-group-list-active): Ditto.
- * gnus-sum.el (gnus-set-mode-line): Ditto.
- (gnus-summary-read-group-1): Ditto.
-
-2001-02-21 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-get-new-news-this-topic): Redraw the
- current topic.
-
-2001-02-21 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smiley.el (gnus-smiley-display): Don't do widening.
-
- * smiley-ems.el (gnus-smiley-display): Don't do widening. Smiley
- within body.
-
- * gnus-msg.el (gnus-inews-do-gcc): Activate group anyway.
-
- * gnus-art.el (gnus-mime-display-multipart-alternative-as-mixed):
- New variable.
- (gnus-mime-display-multipart-related-as-mixed): New variable.
- (gnus-mime-display-part): Use them.
-
-2001-02-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-setup-news): Allow gnus-group-line-format to be
- something special.
-
-2001-02-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnweb.el (nnweb-request-group): Set nnweb-group anyway.
- (nnweb-request-article): Call reference if exists.
- (nnweb-type-definition): Dejanews is bought by google.com.
- Beta!
-
-2001-02-19 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-reminder): "Confirm to exit?"
-
-2001-02-19 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-thread-sort-functions): Doc fix. Refer to
- gnus-article-sort-functions.
- (gnus-article-sort-functions): Doc fix. Refer to
- gnus-thread-sort-functions.
-
-2001-02-18 20:00:00 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-get-reply-headers): More fixes.
-
-2001-02-17 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-get-reply-headers): Fix bug with
- Mail-Followup-To/to-address interaction.
-
-2001-02-17 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-configure-posting-styles): Match header in
- gnus-article-copy.
-
-2001-02-16 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-do-send-housekeeping): Rename to a better
- name.
-
-2001-02-16 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cancel-news): Check article first, then ask
- yes or no.
-
-2001-02-16 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-type-alist): Add emacs-sources.
-
-2001-02-16 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-range.el (gnus-range-normalize): New function.
-
-2001-02-15 NAGY Andras <nagya@inf.elte.hu>
-
- * imap.el (imap-gssapi-open): Set imap-c-l-s-first.
-
-2001-02-14 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-server-regenerate-server): Use gnus-get-function.
-
- * nnagent.el (nnagent-request-regenerate): New function.
-
- * nnfolder.el (nnfolder-request-regenerate): New deffoo.
-
- * nnml.el (nnml-generate-nov-databases): Accept argument
- server. Don't open server if it is opened.
- (nnml-request-regenerate): Use it. Change to deffoo.
-
-2001-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-define-group-parameter): Fix.
-
-2001-02-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-define-group-parameter): Improved.
-
- * gnus-sum.el (charset): Define parameter.
- (ignored-charsets): Ditto.
- (gnus-summary-setup-default-charset): Use them.
-
- * gnus-start.el (gnus-read-descriptions-file): Use them.
-
- * gnus-cus.el (gnus-group-parameters): Remove them.
-
-2001-02-14 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-print-article): Redo highlight.
-
-2001-02-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-read-group-1): Remove
- gnus-summary-set-local-parameters.
- (gnus-summary-setup-buffer): Put it here.
-
-2001-02-13 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (to-address): Define parameter.
- (to-list): Ditto.
- * gnus-art.el (article-hide-boring-headers): Use them.
- * gnus-msg.el (gnus-post-news): Ditto.
- * gnus-cus.el (gnus-group-parameters): Remove them.
-
-2001-02-13 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-draft.el (gnus-draft-reminder): New function.
-
- * gnus-art.el (gnus-sender-save-name): New function.
-
-2001-02-13 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-mime-charset): Error message.
-
-2001-02-13 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-check-news-body-syntax): Don't check mml lines.
-
-2001-02-12 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-subscribe-topics): Return nil if not
- subscribe.
-
- * gnus-start.el (gnus-call-subscribe-functions): New function.
- (gnus-find-new-newsgroups): Use it.
- (gnus-ask-server-for-new-groups): Use it.
- (gnus-check-first-time-used): Use it.
- (gnus-subscribe-newsgroup-method): Grok a list of functions.
- (gnus-subscribe-options-newsgroup-method): Ditto.
- (gnus-subscribe-hierarchically): Return gnus-subscribe-newsgroup's
- return .
-
-2001-02-12 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-cus.el (gnus-score-customize): Doc fix.
-
-2001-02-11 Jesper Harder <harder@ifa.au.dk>
-
- * dgnushack.el (my-getenv): Typo.
-
-2001-02-11 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-make-load): Don't autoload smiley functions.
-
-2001-02-11 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-suspend): Offer save summaries.
-
- * gnus-art.el (gnus-treat-leading-whitespace): New variable.
- (gnus-treatment-function-alist): Use it.
- (article-remove-leading-whitespace): New function.
- (gnus-article-make-menu-bar): Use it.
-
- * gnus-sum.el (gnus-summary-wash-empty-map): Add
- remove-leading-whitespace.
- (gnus-summary-wash-map): Bind strip-headers-in-body to `W a',
- because of conflict.
-
-2001-02-09 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Hack generating gnus-load.el.
- * dgnushack.el: Ditto.
- * gnus-load.el: Remove it.
-
-2001-02-09 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el : Add URLDIR.
-
- * Makefile.in (EMACS_COMP): Ditto.
-
-2001-02-09 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cus.el (gnus-score-customize): Error on no score file.
-
-2001-02-09 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-merge-handles): New function.
-
- * mm-view.el (mm-inline-message): Use it.
- (mm-view-message): Ditto.
-
- * mm-partial.el (mm-inline-partial): Ditto.
-
- * mm-extern.el (mm-inline-external-body): Ditto.
-
- * gnus-art.el (gnus-mime-view-part): Ditto.
- (gnus-mime-view-part-as-type): Ditto.
- (gnus-mime-save-part-and-strip): Prevent users to strip in some
- cases.
-
-2001-02-08 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cancel-news): Allow to shoot foot.
- (message-supersede): Ditto.
-
-2001-02-08 Tommi Vainikainen <thv@iki.fi>
- Trivial patch.
-
- * gnus-sum.el (gnus-simplify-subject-re): Use
- message-subject-re-regexp.
-
-2001-02-08 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-expiry-target-group): Bind
- nnmail-cache-accepted-message-ids to nil.
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Use binary
- coding system.
-
-2001-02-07 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Make sure characters are
- between 00 and FF. Don't check charset.
-
- * mm-encode.el (mm-encode-content-transfer-encoding): Use unibyte
- in Emacs 20.
- * rfc2047.el (rfc2047-q-encode-region): Ditto.
-
-2001-02-07 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-forward-subject): Argument decoded.
- (message-forward): Use it when digest.
-
- * gnus-uu.el (gnus-uu-grab-articles): Shoot down original article
- buffer.
-
-2001-02-07 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.el (message-generate-headers-first): Doc fix.
-
-2001-02-07 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-make-date-line): Error proof.
-
-2001-02-06 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-listing-limit): New variable.
- (gnus-group-prepare-flat-list-dead): Use old trick to speed up.
-
- * gnus-topic.el (gnus-group-prepare-topics): Use gnus-killed-hashtb.
-
-2001-02-06 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-newline-and-reformat): Special case for
- breaking at BOL.
-
-2001-02-06 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-uu.el (gnus-uu-save-article): Make the topics summary a
- message/rfc822.
-
-2001-02-06 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-encode-message-body): Don't insert
- Content-Type if it is inside a mail.
-
-2001-02-06 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-article-menu-add): Add
- gnus-article-commands-menu.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Don't share menu bar
- in Emacs.
-
- * gnus-start.el (gnus-read-descriptions-file): Use
- gnus-group-name-charset and gnus-group-charset-alist.
-
-2001-02-04 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-mark-as-processable): Understand
- active region.
-
- * gnus-start.el (gnus-group-change-level): Remove from both
- gnus-zombie-list and gnus-killed-list.
-
-2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-subscribe-options-newsgroup-method): Add
- gnus-subscribe-topics.
-
- * gnus-cus.el (gnus-extra-topic-parameters): Fix doc.
-
-2001-02-04 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-make-menu-bar): Make
- gnus-article-post-menu.
-
- * gnus-xmas.el (gnus-xmas-article-menu-add): Add post menu.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Use t if XEmacs.
-
- * gnus-group.el (gnus-group-make-menu-bar): Ditto.
-
- * message.el (message-mode-menu): Ditto.
-
- * gnus-art.el (defvar): eval-when-compile.
-
-2001-02-02 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agentize): Fix doc.
-
-2001-02-02 Karl Kleinpaste <karl@charcoal.com>
-
- * mml.el (mml-preview): Bind `q'.
-
-2001-02-02 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-mime-mule-charset-alist): non-Mule case.
-
-2001-01-31 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-mime-mule-charset-alist)
- (mm-find-mime-charset-region): Consider mule-utf-8.
-
-2001-01-31 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-article-x-face-command)
- (gnus-treat-display-xface, gnus-treat-display-smileys): Add
- :version.
-
-2001-01-26 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-multibyte-string-p): New.
-
-;; * qp.el: Remove un-logged bogus changes from 2000-12-20.
-;; (quoted-printable-encode-region): Doc fix. Don't call
-;; string-as-multibyte on class. Clarify line-folding.
- (quoted-printable-encode-string): Make temp buffer inherit
- string's multibyteness.
-
-2001-01-23 Gerd Moellmann <gerd@gnu.org>
-
- * nnheader.el (toplevel): Don't require `gnus-util' at
- compile-time; this creates a circular dependency, and prevents
- a bootstrap.
-
-2001-01-22 Andreas Schwab <schwab@suse.de>
-
- * nnheader.el (gnus-delete-line): Autoload it as a macro.
-
-2001-01-31 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-remove-list-identifiers): Use consp.
-
- * gnus-art.el (article-hide-list-identifiers): Ditto.
-
- * gnus-sum.el (gnus-summary-remove-list-identifiers): Ditto.
-
-2001-01-31 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-remove-list-identifiers): Similar.
-
- * gnus-art.el (article-hide-list-identifiers): Similar.
-
-2001-01-31 Karl Kleinpaste <karl@charcoal.com>
-
- * nnmail.el (nnmail-remove-list-identifiers): Improved.
-
-2001-01-31 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-summary-score-entry): match may be an integer.
-
-2001-01-30 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-string-equal): New function.
-
- * gnus-art.el (article-hide-boring-headers): Use it.
-
-2001-01-27 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus-art.el (gnus-article-banner-alist): eGroups new banner.
-
-2001-01-27 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-msg-mail): Support switch-action.
-
-2001-01-26 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-summary-save-in-pipe): Prompt for saving
- command if there is not last-saver.
-
-2001-01-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-open-connection): 201 is possible.
-
-2001-01-24 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode): MIME charset is not coding system.
- (rfc2047-charset-encoding-alist): Add big5.
-
-2001-01-24 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-add-server): Redraw the line.
- (gnus-agent-remove-server): Ditto.
- (autoload): gnus-server-update-server.
-
- * gnus-srvr.el (gnus-server-line-format): Add %a.
- (gnus-server-line-format-alist): Add gnus-tmp-agent.
- (gnus-server-insert-server-line): Use it.
-
-2001-01-24 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-mime-mule-charset-alist): Preferred MIME names
- GB2312 and Big5.
-
-2001-01-24 Simon Josefsson <sj@extundo.com>
-
- * mail-source.el (mail-sources): Add :program specifier to IMAP
- mail source.
- (mail-source-fetch-imap): Map :program to `imap-shell-program'.
-
-2001-01-24 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-score.el (gnus-score-lower-thread): Fix a doc typo.
-
-2001-01-24 12:22:47 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nntp.el (nntp-wait-for): Return the success code.
- (nntp-open-connection): Use it.
-
-2001-01-11 11:49:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-int.el (gnus-check-server): Allow breaking the opening.
-
-2001-01-23 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-print-article): Remove process mark.
-
-2001-01-22 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-print-article): Take one prefix
- argument. Allow to print several articles in one file.
-
-2001-01-21 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * webmail.el (webmail-type-definition): netaddress changes.
-
-2001-01-21 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: Fix copyright. Remove trailing spaces.
-
- * message.el (message-forward): Use mule4.
-
-2001-01-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-string-as-unibyte): New function.
-
- * message.el (message-forward): Use it.
-
-2001-01-19 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cite-original-without-signature): Don't peel
- off the blank line.
- (message-get-reply-headers): Add Cc if it is not in follow-to.
-
-2001-01-20 Simon Josefsson <sj@extundo.com>
-
- * mm-decode.el (mm-handle-multipart-from): Add.
- (mm-dissect-buffer): Save From: header value.
- (mm-security-from): Remove.
- (mm-possibly-verify-or-decrypt): Don't set mm-security-from.
-
- * mml-smime.el (mml-smime-verify): Use `mm-handle-multipart-from'
- instead of `mml-security-from'. Protect null from value.
-
-2001-01-20 Simon Josefsson <sj@extundo.com>
-
- * mailcap.el (mailcap-mime-data): Run `gnumeric' on
- application/vnd.ms-excel attachments.
-
-2001-01-19 Simon Josefsson <sj@extundo.com>
-
- * gnus-art.el (gnus-button-alist): Add `?=' to mailto URL regexp.
-
-2001-01-19 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-ignored-mail-headers): Ditto.
-
-2001-01-19 Simon Josefsson <sj@extundo.com>
-
- * message.el (message-ignored-news-headers): Only search beginning
- of line.
-
-2001-01-19 ShengHuo Zhu <zsh@cs.rochester.edu>
- Trivial patch from Alberto Lusiani <a.lusiani@noemail.org>
-
- * message.el (message-send-mail): Content-Type may not be there.
-
-2001-01-18 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ems.el (gnus-article-display-xface): Add BUFFER.
- * gnus-xmas.el (gnus-xmas-article-display-xface): Ditto.
-
- * gnus-art.el (article-display-x-face): Insert X-Face if there is
- not.
-
-2001-01-18 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-read-group-1): Don't test dead
- non-native groups.
-
-2001-01-18 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-yank-original): Understand
- universal-argument.
-
-2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-boring-article-headers): Add to-address.
- (article-hide-boring-headers): Ditto.
-
- * mm-view.el (mm-inline-message): Insert a newline unless bolp.
-
-2001-01-18 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-fold-region): Don't insert LWSP if there is
- one.
-
-2001-01-16 Simon Josefsson <simon@josefsson.org>
-
- * message.el (message-make-in-reply-to): Add comment to message-id
- (old syntax, see 2000-08-02 change).
-
-2001-01-16 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-url-mailto): Use gnus-msg-mail.
- (gnus-button-mailto): Setup message. Moved to gnus-msg.el.
- (gnus-button-reply): Ditto.
-
-2001-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-display-x-face): Fix.
-
-2001-01-15 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-display-x-face): Use
- gnus-original-article-buffer.
-
-2001-01-15 Jack Twilley <jmt@tbe.net>
-
- * message.el (message-add-header): Move to point-max.
-
-2001-01-15 Simon Josefsson <simon@josefsson.org>
-
- * smime.el (smime-CA-directory, smime-CA-file): Change default to
- nil, improve documentation.
- (smime-certificate-directory): Comment out false hints (until it
- is implemented).
-
- * mml-smime.el (mml-smime-sign): Place user in customize buffer if
- there aren't any keys.
- (mml-smime-verify): If smime-CA-{file,directory} set, also try to
- verify certificate. Default is changed to only check integrity.
- Improved security status texts. If a certificate doesn't contain
- a email address, don't fail.
-
- * smime.el (smime-noverify-region):
- (smime-noverify-buffer): New functions. Verifies integrity only.
-
-2001-01-12 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-sort-by-score): Reverse order.
-
-2001-01-12 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-windows): switch-to-buffer in XEmacs.
- (gnus-remove-some-windows): Ditto.
-
-2001-01-12 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-make-date-line): 11th.
-
-2001-01-11 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-gpg-encrypt): Remove CR.
- (mml2015-gpg-sign): Ditto.
-
-2001-01-10 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: Sync with EMACS_PRETEST_21_0_95.
- * gnus.el (gnus-default-posting-charset): Bogus. Removed.
-
-2001-01-08 Dave Love <fx@gnu.org>
-
- * mm-encode.el (mm-qp-or-base64): Don't base64 for the sake of a
- single character.
-
- * mm-util.el (mm-mime-mule-charset-alist): Add Latin-{8,9}.
-
- * message.el: Doc and message fixes.
- (message-send-rename-function)
- (message-make-forward-subject-function)
- (message-send-mail-function, message-reply-to-function)
- (message-wide-reply-to-function, message-followup-to-function)
- (message-distribution-function, message-auto-save-directory): Fix
- :type.
-
- * gnus/mml.el (mml-parse-1): Frob mml-confirmation-set when
- proceeding after warnings. Amend multipart warning message.
-
-2001-01-04 Dave Love <fx@gnu.org>
-
- * gnus-util.el (nnmail-pathname-coding-system): Defvar when
- compiling.
- (gnus-make-directory): Require nnmail.
-
- * mm-decode.el (mm-inline-media-tests): Add
- image/x-portable-bitmap.
- (mm-get-image): Grok pbm.
-
-2001-01-10 Paul Stevenson <p.stevenson@surrey.ac.uk>
-
- * nnvirtual.el (nnvirtual-request-expire-articles): delq nil.
-
-2001-01-09 Didier Verna <didier@xemacs.org>
-
- * dgnushack.el (dgnushack-compile): give a dummy value to
- `gnus-xmas-glyph-directory' for the time of compilation.
- * gnus-agent.el: moved some XEmacs specific hook add-ons from
- `gnus-xmas-[re]define' to avoid loosing user custom settings.
- * gnus-art.el: ditto.
- * gnus-group.el: ditto.
- * gnus-salt.el: ditto.
- * gnus-sum.el: ditto.
- * gnus-topic.el: ditto.
- * gnus-xmas.el (gnus-xmas-define): see above.
- * gnus-xmas.el (gnus-xmas-redefine): see above.
- * gnus-xmas.el (gnus-xmas-glyph-directory): generate a
- non-continuable error when the directory can't be found.
-
-2001-01-09 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-interactively-view-part): Don't copy-sequence
- handle.
- * gnus-art.el (gnus-mime-view-part): Copy it.
- (gnus-mime-view-part-as-type): Add into gnus-article-mime-handles.
-
-2001-01-09 Michael Downes <mjd@ams.org>
-
- * gnus-sum.el (gnus-summary-read-group-1): More useful message.
-
-2001-01-08 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-get-new-mail): Find group only if file is not
- orig-file. Use ',source.
-
-2001-01-08 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-modeline-glyph):
- (gnus-xmas-group-startup-message):
- Detect gnus-xmas-glyph-directory when it is nil.
-
-2001-01-08 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-get-message-count): Andrew Innes
- <andrewi@gnu.org>'s patch of 1999-12-01 was not fully committed.
-
-2001-01-05 06:49:37 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-fetch-session): Say what we quit.
-
- * time-date.el (time-to-number-of-days): New function.
-
-2001-01-04 11:06:14 Gregory Chernov <greg@visiontech-dml.com>
- Trivial patch.
-
- * nnslashdot.el (nnslashdot-request-list): Always get the right
- sid.
-
-2001-01-05 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-minibuffer-local-map): New keymap.
- (message-read-from-minibuffer): Use it.
- * gnus-msg.el (gnus-summary-resend-message): Use it
-
-2001-01-04 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-display-time-event-handler): New function.
- (gnus-after-getting-new-news-hook): Use it.
-
-2001-01-03 07:26:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-ignored-mail-headers): Add draft header.
-
-2001-01-02 06:28:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-expire-articles): Don't save
- excursion.
-
- * nnslashdot.el (nnslashdot-request-list): Get the right year.
-
-2001-01-01 00:52:44 Ed L. Cashin <ecashin@coe.uga.edu>
- A revoked patch.
-
- * gnus-sum.el (gnus-summary-expire-articles): Save excursion.
-
-2000-12-31 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-decode-region): Don't backward-char.
-
-2000-12-31 03:57:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-draft.el: Mark articles as replied.
-
- * gnus-sum.el (gnus-summary-add-mark): New function.
-
- * gnus-group.el (gnus-add-mark): New function.
-
- * gnus-sum.el (gnus-summary-buffer-name): New function.
- (gnus-summary-setup-buffer): Use it.
-
- * gnus-draft.el: Set things up with the right post method and
- stuff.
-
- * message.el (message-ignored-news-headers): Remove X-Draft-From.
-
- * gnus-msg.el (gnus-inews-insert-draft-meta-information): New function.
-
- * gnus.el (gnus-draft-meta-information-header): New variable.
-
-2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treatment-function-alist): Move the date
- functions before the header sorting functions.
-
- * mm-uu.el (mm-uu-pgp-signed-extract-1): Unquote "- " quotes.
-
- * dgnushack.el (dgnushack-compile): Message whether there is w3.
- Don't (push "/usr/share/emacs/site-lisp" load-path).
-
- * gnus-cite.el (gnus-article-fill-cited-article): Don't add space
- to empty fill prefixes.
-
-2000-12-30 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-open-connection): Kill pbuffer if process is nil.
- Suggested by Christoph Conrad <christoph.conrad@gmx.de>.
-
-2000-12-30 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (autoload): Autoload gnus-sorted-intersection.
-
- * nnml.el (autoload): Move to nnheader.el.
-
- * nnfolder.el (nnfolder-existing-articles): Reversed, i.e. sorted.
- (nnfolder-request-expire-articles): Use gnus-sorted-intersection.
- (nnfolder-retrieve-headers): Use intersection. Suggested by Jonas
- Kvarnstr\e,Av\e(Bm <jonkv@ida.liu.se>.
-
-2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-make-date-line): Get the hours right.
- (gnus-ignored-headers): More hiding.
-
- * nnmail.el (nnmail-expiry-wait): Not an integer.
-
- * message.el (message-goto-body): Only expand abbrev when called
- interactively.
- (message-make-lines): Use it.
-
-2000-12-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-yank-articles): Reparse headers.
-
-2000-12-30 00:17:38 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-sum.el (gnus-summary-limit-include-expunged): Really
- include the expunged articles.
-
- * gnus-group.el (gnus-group-sort-by-server): New function.
-
- * gnus.el (gnus-method-to-server-name): New function.
- (gnus-group-prefixed-name): Use it.
-
- * gnus-group.el (gnus-group-sort-function): Doc fix.
- (gnus-group-sort-groups-by-server): New command.
-
-2000-12-29 13:25:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (gnus-treat-date-english): New variable.
- (article-date-english): New command.
- (gnus-english-month-names): New variable.
- (article-make-date-line): Do 'english.
-
- * gnus-cite.el (gnus-article-fill-cited-article): Add a space
- after the fill prefix.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Removed "Enter
- score...".
-
- * gnus-art.el (gnus-ignored-headers): Hide more headers.
-
- * message.el (message-mode-map): Bind comment-region.
-
- * gnus-art.el (gnus-mime-display-part): Let w3 display
- multipart/related.
-
- * mm-bodies.el (mm-long-lines-p): New function.
- (mm-body-encoding): Use it.
- (mm-body-encoding): Encode articles with lines longer than 1000
- characters.
-
-2000-12-29 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-enable-multibyte): Use
- default-enable-multibyte-characters.
- (mm-enable-multibyte-mule4): Ditto.
- (mm-disable-multibyte): Test XEmacs.
- (mm-disable-multibyte-mule4): Ditto.
- (mm-with-unibyte-current-buffer): Simplified.
- (mm-with-unibyte-current-buffer-mule4): Ditto.
-
-2000-12-28 19:44:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnheaderxm.el (nnheader-string-as-multibyte): New alias.
-
- * nnheader.el (nnheader-string-as-multibyte): New alias.
-
- * mm-view.el (mm-inline-text): Warn when bugging out in w3.
-
- * gnus-uu.el (gnus-message-process-mark): New function.
- (gnus-uu-mark-by-regexp): Use it.
- (gnus-new-processable): New function.
-
-2000-12-28 19:21:57 Inge Frick <inge@nada.kth.se>
- Trivial patch.
-
- * gnus-sum.el (gnus-no-mark): New variable.
-
-2000-11-01 01:12:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnwfm.el (nnwfm-create-mapping): Remove quote marks and
- backslashes.
-
-2000-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-banner-alist): Remove duplicate
- definition.
-
-2000-12-25 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * dgnushack.el (dgnushack-compile): elc is in the current directory.
-
- * qp.el (quoted-printable-encode-region): Don't check multibyte in
- XEmacs.
-
-2000-12-25 Lloyd Zusman <ljz@asfast.com>
- Trivial patch.
-
- * mml.el (mml-read-tag): Save tag location.
-
-2000-12-25 Simon Josefsson <simon@josefsson.org>
-
- * starttls.el: Sync with Emacs 21.
-
-2000-12-24 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mail): Support yank-action.
-
- * message.el (message-setup): Revoke the last change.
-
-2000-12-24 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup): Use cons. Suggested by Johan Vromans
- <jvromans@squirrel.nl>.
-
-2000-12-24 Simon Josefsson <sj@extundo.com>
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Preserve
- mailing list junk at end of part.
-
-2000-12-23 Simon Josefsson <sj@extundo.com>
-
- * nnimap.el (nnimap-expiry-target): New function.
- (nnimap-request-expire-articles): Use it.
-
-2000-12-22 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-group-parameters-more): New variable.
- * gnus-cus.el (gnus-group-customize): Use it.
-
- * gnus.el (gnus-define-group-parameter): New macro.
- (auto-expire): Use it
- (total-expire): Use it.
- * gnus-art.el (banner): Use it.
-
- * mml.el (mml-parse): save-excursion. Suggested by Lloyd Zusman
- <ljz@asfast.com>.
-
-2000-12-22 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-topic.el (gnus-topic-create-topic): Use list.
-
- * gnus-vm.el (gnus-summary-save-article-vm): Require gnus-art
- before binding gnus-default-article-saver.
-
- * gnus-sum.el (gnus-summary-save-article):
- (gnus-summary-pipe-output):
- (gnus-summary-save-article-mail):
- (gnus-summary-save-article-rmail):
- (gnus-summary-save-article-file):
- (gnus-summary-write-article-file):
- (gnus-summary-save-article-body-file): Ditto.
-
- * gnus-mh.el (gnus-summary-save-article-folder): Ditto.
-
-2000-12-22 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-security-button-map):
- (gnus-mime-button-map): Add parent.
-
-2000-12-22 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * messagexmas.el (message-xmas-redefine): New function.
-
- * message.el: Use it.
-
- * gnus-art.el (gnus-article-check-hidden-text): Return t.
-
- * gnus-util.el (gnus-remove-text-properties-when): Return t.
-
-2000-12-22 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-dissect-multipart): Avoid errors owing to
- malformatted messages.
-
-2000-12-22 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-image-load-path): New function.
-
- * gnus-group.el (gnus-group-make-tool-bar): Use it.
-
- * gnus-sum.el (gnus-summary-make-tool-bar): Use it.
-
- * message.el (message-tool-bar-map): Use it.
-
- * Makefile.in (install-el): New rule.
-
-2000-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-treat-dumbquotes): Quote \.
-
-2000-12-21 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-treat-emphasize): Don't treat emphasis if
- Emacs 20 runs on a terminal.
-
-2000-12-21 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-bug): Revert to save-excursion.
-
- * mml.el (gnus-add-minor-mode): Autoload.
-
- * message.el (message-forward): Save-restriction.
-
-2000-12-21 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-art.el (article-treat-dumbquotes): More doc, provided by
- Paul Stevenson <p.stevenson@surrey.ac.uk>
-
-2000-12-21 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el (gnus-mailing-list-mode-map): Use C-c C-n prefix.
-
- * mml.el (gnus-ems): Don't require.
-
- * gnus.el (gnus-decode-rfc1522): Removed.
- (gnus-set-text-properties): Define.
-
-2000-12-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-*): handle may be nil.
-
- * gnus-sum.el (gnus-summary-mode): Turn on gnus-mailing-list-mode.
-
- * gnus.el (gnus-group-remove-excess-properties): Not defined
- in gnus-xmas.
-
-2000-12-20 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mail-user-agent): Add :version.
-
-2000-12-21 Miles Bader <miles@gnu.org>
-
- * message.el (message-mode): Set `comment-start' to the yank prefix.
-
-2000-12-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mail-user-agent): New variable.
- (message-setup): Renamed to message-setup-1. Support
- mail-user-agent.
- (message-mail-user-agent): New function.
- (message-mail): Use it.
- (message-reply): Use it.
- (message-resend): Use it.
- (message-mail-other-window): Use it.
- (message-mail-other-frame): Use it.
-
- * gnus-msg.el (gnus-bug): Support mail-user-agent.
-
-2000-12-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-tool-bar-map): Simplify.
- (message-narrow-to-head-1): New function.
- (message-narrow-to-head): Use it.
- (message-reply): Ditto.
- (message-cancel-news): Ditto.
- (message-supersede): Ditto.
- (message-make-forward-subject): Ditto.
- (message-bounce): Ditto.
-
-2000-12-20 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * uudecode.el (uudecode-decode-region-external): make-temp-file
- may not be defined.
-
- * binhex.el (defalias): eval-and-compile.
-
- * message.el (message-tool-bar-map): New function.
- (message-mode): Use it.
-
-2000-12-20 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-find-connection): Remove the entry.
- (nntp-retrieve-groups): (gnus-buffer-live-p buf).
-
-2000-12-20 05:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-summary-mail-forward): Use original buffer.
-
- * message.el (message-forward): Copy buffer in unibyte mode.
-
-2000-12-20 04:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-make-forward-subject): Don't widen. Decode.
- (message-forward): Don't decode subject.
-
-2000-12-20 Christoph Conrad <C.Conrad@cli.de>
-
- * qp.el (quoted-printable-encode-region): Upcase QP.
-
-2000-12-20 03:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-possibly-verify-or-decrypt): Use
- mail-extract-a-c instead. Don't depend on Gnus.
-
- * mml.el (gnus-ems): Require it.
-
- * gnus-msg.el (gnus-summary-mail-forward):
-
- * message.el (message-forward): Move mime-to-mml here.
-
-2000-12-20 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el, gnus-sum.el, message.el: Add :help unless Emacs.
- * gnus-art.el (gnus-insert-mime-button): Simplify.
- (gnus-mime-display-alternative): Ditto.
- (gnus-insert-mime-security-button): Ditto.
-
-2000-12-20 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-add-text-properties-when): In XEmacs,
- text-property-not-all doesn't return nil when start=mark(end).
- (gnus-remove-text-properties-when): Ditto.
-
-2000-12-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-group-change-level): Remove group from
- gnus-active-hashtb if real killed.
-
-2000-12-19 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-insert-mime-button): Emacs20 needs local-map.
- (gnus-mime-display-alternative): Ditto.
- (gnus-insert-mime-security-button): Ditto.
-
-2000-12-19 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-start.el (gnus-group-change-level): Don't add it into
- killed-list if it was killed.
-
-2000-12-19 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmbox.el (nnmbox-file-coding-system): Use binary.
- (nnmbox-active-file-coding-system): Ditto.
-
- * gnus-cus.el (gnus-group-parameters): Add posting-style.
-
-2000-12-19 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-version):
- (gnus-version-number): Set to Oort Gnus 0.01.
-
- * gnus-art.el (gnus-mime-security-button-map):
- (gnus-insert-mime-security-button): Fix for Emacs21.
-
-2000-12-19 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el, gnus-sum.el, message.el: Comment out :help in
- easymenu, because XEmacs doesn't understand :help.
-
- * mm-uu.el: Require binhex.
-
-2000-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: Merged. Emacs21 CVS tag is zsh-merge-ognus-1.
-
-2000-12-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-synonym-alist): Fix a typo.
-
-2000-12-18 Gerd Moellmann <gerd@gnu.org>
-
- * *.xpm, *.pbm: Convert icons icons to size 24x24.
-
-2000-12-18 Dave Love <fx@gnu.org>
-
- * gnus-msg.el (news-setup, news-reply-mode): Don't autoload
- (unused).
-
-2000-12-13 Miles Bader <miles@gnu.org>
-
- * smiley-ems.el (smiley-region): Bind `inhibit-point-motion-hooks'
- to t, so that we don't get stuck while trying to smilefy
- intangible text.
-
-2000-12-12 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-regexp-alist): Make regexps match
- at the end of the buffer.
- (smiley-region): In the loop, move to the end of the submatch
- matching the smiley instead of using the end of the match
- of the whole regexp.
-
-2000-12-12 Eli Zaretskii <eliz@is.elta.co.il>
-
- * message.el (message-mode): Doc fix.
-
-2000-12-12 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-region): Doc fix.
-
-2000-12-11 Miles Bader <miles@gnu.org>
-
- * gnus-sum.el (gnus-summary-recenter): When trying to keep the
- bottom line visible, check to see if it's partially obscured, and
- if so, either scroll one more line to make it fully visible, or
- revert to showing the second line from the top.
-
-2000-12-07 Dave Love <fx@gnu.org>
-
- * mailcap.el (mailcap-download-directory)
- * gnus-audio.el (gnus-audio-directory)
- * smiley-ems.el (smiley-data-directory): Fix :type.
-
-2000-11-30 Dave Love <fx@gnu.org>
-
- * message.el (message-auto-save-directory): Use
- file-name-as-directory.
- (message-set-auto-save-file-name): Create
- message-auto-save-directory if necessary.
- (message-replace-chars-in-string): Removed -- unused.
- (message-mail-alias-type): Customize.
- (message-headers): Remove duplicate defgroup.
-
-2000-11-29 Dave Love <fx@gnu.org>
-
- * qp.el (quoted-printable-decode-region): Use error, not message
- to report malformed text (like base64). Amend message.
-
-2000-11-29 Miles Bader <miles@gnu.org>
-
- * message.el (message-header-lines): Fontify tag.
-
-2000-11-27 Dave Love <fx@gnu.org>
-
- * nnlistserv.el: Ignore errors when requiring nnweb and avoid a
- compiler warning.
-
-;2000-11-26 Dave Love <fx@gnu.org>
-;
-; * mm-uu.el (mm-uu-configure-list): Fix typo in :type.
-;
-2000-11-23 Dave Love <fx@gnu.org>
-
- * uu-post.pbm, uu-decode.pbm: new files from XPMs.
-
- * mm-uu.el (uudecode): Require.
- (uudecode-decode-region, uudecode-decode-region-external): Don't
- autoload.
- (mm-uu-copy-to-buffer): Doc fix.
- (mm-uu-decode-function, mm-uu-binhex-decode-function): Doc, custom
- type fix.
-
- * mailcap.el: Doc fixes.
- (mailcap-mime-data): Various adjustments.
- (mailcap): New group.
- (mailcap-download-directory): Customize.
- (mailcap-generate-unique-filename, mailcap-binary-suffixes)
- (mailcap-temporary-directory): Deleted (unused).
- (mailcap-unescape-mime-test): Simplify slightly.
- (mailcap-viewer-passes-test): Use functionp.
- (mailcap-command-p): Aliased to executable-find.
-
- * rfc2047.el (rfc2047-encode-message-header): Don't encode if
- default-enable-multibyte-characters is nil.
-
-2000-11-22 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-group.el (gnus-group-make-tool-bar): Fix a paren typo.
-
-2000-11-21 Dave Love <fx@gnu.org>
-
- * gnus-art.el (gnus-mime-button-map): Don't inherit from
- gnus-article-mode-map.
-; (gnus-mime-button-menu): Use mouse-set-point.
- (gnus-insert-mime-button, gnus-mime-display-alternative)
- (gnus-mime-display-alternative): Don't use local-map property.
-
-2000-11-17 Dave Love <fx@gnu.org>
-
- * uudecode.el (uudecode-insert-char): Fix bogus feature test.
- (uudecode-decode-region-external): Doc fix. Use with-temp-buffer
- and make-temp-file.
- (uudecode-decode-region): Doc fix.
-
-2000-11-14 Dave Love <fx@gnu.org>
-
- * cu-exit.pbm, exit-summ.pbm, followup.pbm, fuwo.pbm:
- * mail-reply.pbm, next-ur.pbm, post.pbm, prev-ur.pbm:
- * reply-wo.pbm, reply.pbm, rot13.pbm, save-aif.pbm, save-art.pbm:
- New files, derived from the XPMs.
-
-2000-11-10 Dave Love <fx@gnu.org>
-
- * gnus-agent.el (gnus-agent-confirmation-function): Add :version.
- (gnus-agent-lib-file, gnus-agent-load-alist)
- (gnus-agent-save-alist, gnus-agent-article-name): Use
- expand-file-name.
-
- * gnus-group.el (gnus-group-name-charset-method-alist): Add
- :version.
- (nnkiboze-score-file): Defvar when compiling.
-
- * gnus-start.el (gnus-read-newsrc-file): Add :version.
-
- * gnus-art.el (gnus-article-banner-alist)
- (gnus-emphasize-whitespace-regexp, gnus-ignored-mime-types)
- (gnus-article-date-lapsed-new-header)
- (gnus-article-mime-match-handle-function, gnus-mime-action-alist)
- (gnus-treat-strip-list-identifiers, gnus-treat-date-iso8601)
- (gnus-treat-strip-headers-in-body)
- (gnus-treat-capitalize-sentences, gnus-treat-play-sounds)
- (gnus-treat-translate): Add :version.
- (gnus-article-mime-part-function): Fix defcustom.
-
- * nnmail.el (nnmail-expiry-target)
- (nnmail-scan-directory-mail-source-once, nnmail-extra-headers)
- (nnmail-split-header-length-limit): Add :version.
-
- * gnus-sum.el (gnus-auto-expirable-marks)
- (gnus-inhibit-user-auto-expire, gnus-list-identifiers)
- (gnus-extra-headers, gnus-ignored-from-addresses)
- (gnus-newsgroup-ignored-charsets)
- (gnus-group-highlight-words-alist)
- (gnus-summary-show-article-charset-alist): Add :version.
-
- * catchup.pbm, describe-group.pbm, exit-gnus.pbm, get-news.pbm:
- gnntg.pbm, kill-group.pbm, subscribe.pbm, unsubscribe.pbm: New
- files, converted from the XPMs.
-
- * gnus-cache.el (gnus-cache-active-file): Don't use
- file-name-as-directory on directory.
- (gnus-cache-file-name): Use expand-file-name, not concat. Don't
- use file-name-as-directory on directory.
-
- * time-date.el (timezone-make-date-arpa-standard): Autoload.
- (date-to-time): Use it.
-
-; * message.el (message-mode) <adaptive-fill-regexp>:
-; <adaptive-fill-first-line-regexp>: Use [:alnum:] in regexp range.
-; (message-newline-and-reformat): Likewise.
- (message-forward-as-mime, message-forward-ignored-headers)
- (message-buffer-naming-style, message-default-charset)
- (message-dont-reply-to-names, message-send-mail-partially-limit):
- Add :version.
-
- * mm-util.el: Doc fixes.
- (mm-mime-charset): Don't use the raw result of
- mm-preferred-coding-system.
- (mm-with-unibyte-buffer, mm-with-unibyte-current-buffer)
- (mm-with-unibyte): Simplify.
-
- * gnus-int.el (gnus-start-news-server): Use expand-file-name, not
- concat.
-
- * pop3.el (pop3-version): Deleted.
- (pop3-make-date): New function, avoiding message-make-date.
- (pop3-munge-message-separator): Use it.
-
-2000-11-09 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-make-directory-group)
- (gnus-group-fetch-faq): Use expand-file-name.
- (gnus-group-fetch-faq): Simplify completing-read form.
-
- * mm-bodies.el (mm-encode-body): Use mm-multibyte-p, don't just
- test for Mule.
-
- * message.el (tool-bar-map): Defvar when compiling.
-
- * gnus-setup.el (running-xemacs, gnus-use-installed-tm)
- (gnus-tm-lisp-directory): Deleted.
- (gnus-use-installed-mailcrypt, gnus-emacs-lisp-directory): Use
- (featurep 'xemacs).
- (gnus-gnus-lisp-directory, gnus-mailcrypt-lisp-directory)
- (gnus-mailcrypt-lisp-directory, gnus-bbdb-lisp-directory): Remove
- version numbers from file names.
-
-2000-11-08 Dave Love <fx@gnu.org>
-
- * mm-view.el: Use featurep for XEmacs test.
- (mm-inline-message): Test for `remove-specifier'; don't use
- condition-case.
-
- * mm-bodies.el (mm-encode-body): Use mm-multibyte-p.
-
- * gnus-score.el (gnus-score-load-file): Use expand-file-name.
- (gnus-score-find-bnews): Don't concat "".
-
- * cu-exit.xpm, prev-ur.xpm, next-ur.xpm, post.xpm, fuwo.xpm:
- * followup.xpm, uu-post.xpm, uu-decode.xpm, mail-reply.xpm:
- * reply.xpm, reply-wo.xpm, rot13.xpm, save-aif.xpm, save-art.xpm:
- * exit-summ.xpm: New files, renamed from icons by Luis Fernandes.
-
- * gnus-sum.el: Put some defvars in eval-when-compile.
- (gnus-summary-mode-hook): Add :options.
- (gnus-summary-make-menu-bar): Add some :help, used by tool bar.
- (gnus-summary-tool-bar-map): New variable.
- (gnus-summary-make-tool-bar): New function.
- (gnus-summary-mode): Put kill-all-local-variables first.
-
- * gnus-group.el (gnus-group-toolbar-map): New variable.
- (gnus-group-make-tool-bar): Rewritten.
- (gnus-group-mode): Put kill-all-local-variables first.
-
- * rfc2047.el: Require gnus-util.
-
- * nnml.el (gnus-sorted-intersection): Autoload.
-
- * nnheader.el: Wrap subst-char-in-string def in eval-and-compile.
- Put some defvars in eval-when-compile.
- (gnus-intersection, gnus-sorted-complement): Autoload.
-
- * imap.el (imap-point-at-eol): New, replacing gnus-point-at-eol.
-
- * mm-encode.el (mm-body-7-or-8): Autoload.
-
- * mm-decode.el (mm-insert-inline): Autoload.
-
- * mml.el:
- * message.el: Put some defvars in eval-when-compile.
-
- * gnus-msg.el: Put some defvars in eval-when-compile.
- (gnus-msg-mail): Move after gnus-setup-message.
-
- * smiley-ems.el (smiley-data-directory, smiley-regexp-alist): Doc fix.
-
-2000-11-07 Dave Love <fx@gnu.org>
-
- * gnus-util.el (nnheader): Don't require message (recursive
- autoload).
-
- * uudecode.el: Avoid compiler warnings.
-
- * rfc2047.el: (rfc2047-fold-region): Use gnus-point-at-bol.
- (rfc2047-charset-encoding-alist): Add iso-8859-1[45].
-
-2000-11-06 Dave Love <fx@gnu.org>
-
- * gnus-salt.el (gnus-binary-mode): Fix call to gnus-add-minor-mode.
-
- * uudecode.el: Use (featurep 'xemacs). Require cl when compiling.
- (uudecode-char-int): New alias, replacing char-int.
- (uudecode-decode-region): Don't call buffer-disable-undo.
-
-; * mm-uu.el (mm-uu-configure): Unquote lambda.
-; (mm-uu-configure-list): Doc fix.
-;
-; * earcon.el (running-xemacs): Don't define.
-;
-;2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
-;
-; * message.el (message-font-lock-keywords): Match a final newline
-; to help font-lock's multiline support.
-;
-2000-11-03 Dave Love <fx@gnu.org>
-
- * gnus-nocem.el (gnus-nocem-check-article-limit): Default to 500.
-
- * mm-partial.el (mm-inline-partial): Space-prefix temp buffer
- name.
-
- * gnus-cus.el (gnus-group-parameters) <gcc-self>: Fix custom type.
- <banner>: Fix custom type, doc.
-
- * mm-decode.el (mm-display-external): Space-prefix temp buffer
- name. Don't disable undo explicitly.
-
-;2000-11-02 Dave Love <fx@gnu.org>
-;
-; * message.el (message-font-lock-keywords): Use [:alpha:] for
-; cite-prefix.
-
-2000-11-01 Dave Love <fx@gnu.org>
-
- * rfc2047.el (base64): Require unconditionally.
- (message-posting-charset): Defvar when compiling.
- (rfc2047-encode-message-header, rfc2047-encodable-p): Require
- message.
-
- * gnus-sum.el (nnoo): Require.
- (mm-uu-dissect): Autoload.
-
- * mml.el (mml-parse-1): Clarify message.
- (mml-minibuffer-read-type): Use mailcap-mime-types.
-
-2000-11-01 Stefan Monnier <monnier@cs.yale.edu>
-
- * mml.el: Fix a typo in the requiring of CL.
-
-2000-11-01 Dave Love <fx@gnu.org>
-
- * utf7.el: Require cl when compiling.
-
- * binhex.el: Use (featurep 'xemacs).
- (binhex-char-int): New alias, replacing char-int. Change callers.
- (binhex-decode-region): Simplify work buffer code.
- (binhex-decode-region-external): Use expand-file-name, not concat.
-
-2000-10-30 Dave Love <fx@gnu.org>
-
- * gnus-art.el: Fix 2000-10-27 change properly.
-
-2000-10-28 Miles Bader <miles@gnu.org>
-
- * gnus-art.el (gnus-read-save-file-name): Remove extraneous paren.
-
-2000-10-27 Dave Love <fx@gnu.org>
-
- * gnus-group.el (gnus-group-make-menu-bar): Add some :help
- strings.
- (gnus-group-make-tool-bar): New function.
- (gnus-group-mode): Use it.
-
- * message.el (message-mode-menu): Add some :help strings.
- (message-mode) [message-tool-bar-map]: Define tool-bar-map.
- (featurep): Use (featurep 'xemacs). Install tool bar for Emacs.
-
- * catchup.xpm, exit-gnus.xpm, gnntg.xpm, subscribe.xpm:
- * describe-group.xpm, get-news.xpm, kill-group.xpm:
- * unsubscribe.xpm: New files. Renamed icons from Luis Fernandes.
-
- * mm-decode.el (mm-valid-and-fit-image-p): Don't test
- display-graphic-p here.
-
-2000-10-27 Miles Bader <miles@lsi.nec.co.jp>
-
- * gnus-ems.el (gnus-ems-redefine): Use (featurep 'xemacs) instead
- of the `gnus-xemacs' variable, as the latter has been removed.
- * gnus-start.el (gnus-1, gnus-read-descriptions-file): Likewise.
- * gnus-art.el (gnus-treat-display-xface)
- (gnus-treat-display-smileys, gnus-treat-display-picons)
- (gnus-article-read-summary-keys): Likewise.
-
-2000-10-26 Dave Love <fx@gnu.org>
-
- (defvar): Use rmail-spool-directory unconditionally.
-
-2000-10-18 Dave Love <fx@gnu.org>
-
- * mm-bodies.el (mm-uu-decode-function)
- (mm-uu-binhex-decode-function): Defvar when compiling.
-
- * gnus-nocem.el (gnus-nocem-issuers): Update.
- (gnus-nocem-check-from): New option.
- (gnus-nocem-scan-groups): Use it.
- (gnus-nocem-check-article): Bind gnus-newsgroup-name.
- (gnus-nocem-check-article-limit): Add :version.
-
-2000-10-16 Stefan Monnier <monnier@cs.yale.edu>
-
- * ietf-drums.el (mm-util): Require CL when compiling.
-
-2000-10-15 Dave Love <fx@gnu.org>
-
- * qp.el: Require mm-util.
-
-2000-10-13 Dave Love <fx@gnu.org>
-
- * qp.el (quoted-printable-decode-region): Avoid invalid
- coding-systems.
-
-2000-10-12 Gerd Moellmann <gerd@gnu.org>
-
- * mm-bodies.el: Don't require `mm-uu' at compile-time; it leads
- to a recursive load.
-
-2000-10-12 Dave Love <fx@gnu.org>
-
- * mm-util.el (mm-charset-synonym-alist): Add windows-1252.
-
- * gnus.el (gnus-group-startup-message): Check for PBM image.
-
-2000-10-09 Dave Love <fx@gnu.org>
-
- * mail-source.el (mail-source-fetch-imap): Bind
- default-enable-multibyte-characters rather than using
- mm-disable-multibyte.
-
-2000-10-05 Dave Love <fx@gnu.org>
-
- * qp.el (mm-decode-coding-region, mm-encode-coding-region):
- Autoload.
- (quoted-printable-decode-region): Rename arg which confused
- charset with coding-system. Don't use nonascii-insert-offset.
- Coding-system encode the region initially. Don't recognize `=='
- as valid QP. Coding-system decode the region finally.
- (quoted-printable-decode-string): Rename arg which confused
- charset with coding-system.
-
- * mm-bodies.el: Require mm-uu, Don't require qp, uudecode.
- (mm-encode-body): Apply mm-charset-to-coding-system to arg of
- mm-encode-coding-region.
- (mm-decode-body, mm-decode-string): Rename variables which
- confused charset with coding-system.
- (binhex-decode-region): Don't autoload.
- (mm-body-encoding): Require message.
- (mm-decode-content-transfer-encoding): Require mm-uu in relevant
- cond branches.
-
- * gnus-art.el (article-de-quoted-unreadable)
- (article-de-base64-unreadable): Fold search case
- rather than downcasing string. Apply mm-charset-to-coding-system
- to arg of quoted-printable-decode-region.
-
-2000-10-04 Dave Love <fx@gnu.org>
-
- * gnus-ems.el: Don't turn off compiler warnings in local vars.
- Require ring when compiling.
- (gnus-article-compface-xbm): New variable.
-
-2000-10-04 Dave Love <fx@gnu.org>
-
- * smiley-ems.el (smiley-regexp-alist, smiley-update-cache): Use
- pbm images.
-
- * frown.pbm, smile.pbm, wry.pbm: New files.
-
- * frown.xbm, smile.xbm, wry.xbm: Deleted.
-
-2000-10-03 Dave Love <fx@gnu.org>
-
- * mail-source.el (mail-sources): Revert to nil.
-
- * nnmail.el (nnmail-spool-file): Revert to `((file))'.
-
- * qp.el: Don't require mm-util.
- (quoted-printable-decode-region): Rewritten.
- (quoted-printable-decode-string, quoted-printable-encode-region):
- Doc fix.
- (quoted-printable-encode-region): Barf on multibyte characters.
- Maybe make the class multibyte. Upcase chars, not formatted
- strings. Allow mm-use-ultra-safe-encoding to be unbound.
- (quoted-printable-encode-string): Don't use
- mm-with-unibyte-buffer.
-
-2000-09-29 Gerd Moellmann <gerd@gnu.org>
-
- * smiley-ems.el (smiley-update-cache): Use `:ascent center'.
-
-2000-09-21 Dave Love <fx@gnu.org>
-
- * smiley-ems.el (smiley-region): Test if display-graphic-p bound
- (for Emacs 20). Tidy somewhat.
-
-2000-09-21 Dave Love <fx@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface): Use unibyte for the
- image processing. Rationalize logic somewhat.
-
-2000-09-20 Dave Love <fx@gnu.org>
-
- * gnus-start.el (gnus-1) <gnus-simple-splash>: Don't test for X
- specifically.
-
- * gnus.el (gnus-version-number): Avoid some redundant
- autoloads.
-
-2000-09-20 Gerd Moellmann <gerd@gnu.org>
-
- * gnus-ems.el (gnus-article-display-xface): Don't convert PBM
- to XBM; we always have PBM support.
-
-2000-09-14 Dave Love <fx@gnu.org>
-
- * gnus.el (gnus-charset):
- * mm-decode.el (mime-display):
- * imap.el (imap) <defgroup>: Add :version.
-
-2000-09-13 Gerd Moellmann <gerd@gnu.org>
-
- * parse-time.el: Fix author's mail address.
-
- * earcon.el, flow-fill.el, gnus-cite.el, gnus-gl.el, gnus-ml.el:
- * gnus-mlspl.el, gnus-nocem.el, gnus-range.el, gnus-salt.el:
- * gnus-setup.el, gnus-soup.el, gnus-undo.el, gnus-vm.el:
- * messcompat.el, nnbabyl.el, nndir.el, nneething.el:
- * nngateway.el, nnheaderxm.el, nnkiboze.el, nnlistserv.el:
- * nnmbox.el, nnmh.el, nnoo.el, nnsoup.el, nnspool.el, rfc2045.el:
- * rfc2231.el, uudecode.el: Fix copyright notice.
-
- * nnweb.el (toplevel): To make the file bootstrap in Emacs,
- require `w3' at load-time only if not running in batch mode.
-
-2000-12-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el: Before merge with Emacs21.
-
-2000-12-19 Raymond Scholz <ray-2000@zonix.de>
-
- * gnus-art.el (gnus-article-dumbquotes-map): Add EUR symbol.
-
-2000-12-19 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * mml.el (mml-mode-map): Change mml prefix from `M-m' to `C-c C-m'
- to avoid conflict with the standard `back-to-indentation'
- binding.
-
-2000-12-17 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-extern.el (mm-inline-external-body): g-a-m-h may be a handle.
-
- * mm-util.el (mm-enable-multibyte-mule4): Test charsetp.
- (mm-disable-multibyte-mule4): Ditto.
- (mm-with-unibyte-current-buffer-mule4): Ditto.
-
-2000-12-15 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-movemail): Use binary.
- (pop3-movemail-file-coding-system): Removed.
-
-2000-12-14 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-charset-synonym-alist): Add cn-gb.
-
-2000-12-13 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnspool.el (nnspool-lib-dir): Check whether /usr/lib/news/active
- exists.
-
-2000-12-13 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-post-method): Use backend name when the
- address is "".
-
-2000-12-08 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-verify-x-pgp-sig): Don't test
- mm-verify-option.
- (gnus-treat-x-pgp-sig): Default value.
- (gnus-ignored-headers): Redundant.
-
-2000-12-04 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-frame): Save selected window.
-
-2000-02-15 Andrew Innes <andrewi@gnu.org>
-
- * nnmbox.el: Require gnus-range.
- (nnmbox-group-building-active-articles): New variable.
- (nnmbox-group-active-articles): New variable; this is a cache of
- all active articles by group and number.
- (nnmbox-in-header-p): New function.
- (nnmbox-find-article): New function.
- (nnmbox-record-active-article): New function.
- (nnmbox-record-deleted-article): New function.
- (nnmbox-is-article-active-p): New function.
- (nnmbox-retrieve-headers): Use nnmbox-find-article.
- (nnmbox-request-article): Ditto. Also supply extra arg to
- nnmbox-article-group-number.
- (nnmbox-request-expire-articles): Ditto.
- (nnmbox-request-move-article): Ditto.
- (nnmbox-request-replace-article): Ditto.
- (nnmbox-request-rename-group): Rename group entry in active
- article cache.
- (nnmbox-delete-mail): Update active article cache, unless article
- is being replaced.
- (nnmbox-possibly-change-newsgroup): Call nnmbox-read-mbox, rather
- than partially duplicating it.
- (nnmbox-article-group-number): Add extra `this-line' arg, to
- handle articles belonging to multiple groups.
- (nnmbox-save-mail): Update active article cache.
- (nnmbox-read-mbox): Build active article cache when loading mbox.
- Also do some repair work, if we find articles that are missing the
- appropriate X-Gnus-Newsgroup lines in the header. We can usually
- reconstruct these from Xref info.
-
-2000-12-04 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mail-source.el (mail-source-report-new-mail): Use
- nnheader-run-at-time.
-
-2000-02-15 Andrew Innes <andrewi@gnu.org>
-
- * mail-source.el (mail-source-fetch-pop): Clear pop password when
- an error is thrown, and then rethrow the error.
- (mail-source-check-pop): Ditto.
- (mail-source-start-idle-timer): Prevent multiple pop checks
- running if the check takes a long time.
-
-2000-12-04 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-msg-mail): COMPOSEFUNC should return t if
- succeed.
-
-2000-12-04 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-win.el (gnus-configure-windows): Make sure
- nntp-server-buffer is live.
- (gnus-remove-some-windows): switch-to-buffer -> set-buffer.
-
-2000-11-21 Stefan Monnier <monnier@cs.yale.edu>
-
- * gnus-win.el (gnus-configure-windows): switch-to-buffer -> set-buffer.
-
-2000-12-04 Andreas Jaeger <aj@suse.de>
-
- * gnus-msg.el (gnus-summary-mail-forward): Fix typos in description.
-
-2000-12-03 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-fix-micalg): Alg might be nil.
-
-2000-12-01 ShengHuo ZHU <zsh@cs.rochester.edu>
- Trivial patch from Christopher Splinter <chris@splinter.inka.de>
-
- * gnus-sum.el (gnus-summary-limit-to-age): Fix typo.
-
-2000-12-01 Simon Josefsson <sj@extundo.com>
-
- * mml-smime.el (mml-smime-verify): Fix address parsing.
-
-2000-12-01 Simon Josefsson <sj@extundo.com>
-
- * mml-smime.el (mml-smime-verify): Don't modify MM buffer. Handle
- more than one certificate inside PKCS#7 blob. Better security
- information (clamed / actual sender, openssl output, certificates
- inside message).
-
- * smime.el (smime-verify-region): Output to /dev/null.
- (smime-buffer-as-string-region): Don't parse empty lines.
-
-2000-11-30 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-security-button-line-format-alist): Add
- ?d and ?D.
- (gnus-mime-security-show-details-inline): New variable.
- (gnus-mime-security-show-details): Use them.
- (gnus-insert-mime-security-button): Ditto.
-
- * mml2015.el (mml2015-gpg-verify): Set details when succeed.
- Suggest by Michael Duggan (md5i@cs.cmu.edu).
- (mml2015-gpg-clear-verify): Ditto.
- (mml2015-gpg-decrypt-1): Ditto.
- (mml2015-use): Prefer 'gpg.
-
-2000-11-30 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-add-text-properties-when): New function.
- (gnus-remove-text-properties-when): Ditto.
-
- * gnus-cite.el (gnus-article-hide-citation): Use them.
- (gnus-article-toggle-cited-text): Use them.
-
- * gnus-art.el (gnus-signature-toggle): Use them.
- (gnus-article-show-hidden-text): Ditto.
- (gnus-article-hide-text): Ditto.
-
-2000-11-30 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-find-charset-region): Remove eight-bit-*.
-
-2000-11-30 Simon Josefsson <sj@extundo.com>
-
- * smime.el (smime-point-at-eol): New alias.
- (smime-buffer-as-string-region): Use it.
-
-2000-11-29 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nndraft.el (nndraft-request-restore-buffer): Remove Date field.
-
-2000-11-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-request-expire-articles): expiry-target.
-
- * nnbabyl.el (nnbabyl-request-expire-articles): Ditto.
-
- * nnmbox.el (nnmbox-request-expire-articles): Ditto.
-
-2000-11-22 Jan Nieuwenhuizen <janneke@gnu.org>
-
- * nnmh.el (nnmh-request-expire-articles): Implemented
- expiry-target for nnmh backend.
-
-2000-11-30 Simon Josefsson <sj@extundo.com>
-
- * mm-decode.el (mm-security-from): New variable.
- (mm-possibly-verify-or-decrypt): Use it rather than `from'.
-
- * mml-smime.el (mml-smime-verify): Use `mm-security-from' rather
- than `from'.
-
-2000-11-30 Simon Josefsson <sj@extundo.com>
-
- * mml-smime.el (mml-smime-verify): Verify that certificate mail
- address match sender address.
-
- * mm-decode.el (mm-possibly-verify-or-decrypt): Bind sender address.
-
- * smime.el (smime-verify-region): Don't copy buffer.
- (smime-decrypt-buffer): Use expand-file-name on keyfile.
- (smime-pkcs7-region): New function.
- (smime-pkcs7-certificates-region): Ditto.
- (smime-pkcs7-email-region): Ditto.
- (smime-buffer-as-string-region): Ditto.
-
- * gnus-art.el (gnus-mime-security-show-details): Goto beginning of
- buffer.
-
-2000-11-23 Jens Krinke <j.krinke@gmx.de>
-
- * smime.el (smime-decrypt-region): Fix keyfile argument.
-
-2000-11-29 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnmail.el (nnmail-cache-accepted-message-ids): Add doc.
-
-2000-11-28 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-shoot-gnksa-feet): New variable.
- (message-gnksa-enable-p): New function.
- (message-send): Use it.
- (message-check-news-body-syntax): Ditto.
-
-2000-11-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-make-message-id): Remove the redundancy.
-
-2000-11-22 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup): Discourage using mc-install-*-mode.
-
- * gnus-setup.el (gnus-use-mailcrypt): Don't hook mail-crypt.
-
-2000-11-22 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cite.el (gnus-cite-parse): Guess citation length.
-
-2000-11-22 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el (gnus-mailing-list-insinuate): New function.
-
-2000-11-22 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el (gnus-mailing-list-archive): Find the real url.
-
-2000-11-22 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-xmas.el (gnus-xmas-article-display-xface): Use
- insert-buffer-substring.
-
- * message.el (message-send-mail): Use buffer-substring-no-properties.
- (message-send-news): Ditto.
-
-2000-11-22 David Edmondson <dme@dme.org>
-
- * imap.el (imap-wait-for-tag): Message read info.
-
-2000-11-21 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-encrypt): Ensure the part is encrypted.
- (mml2015-mailcrypt-encrypt): Use unibyte-buffer.
- (mml2015-gpg-encrypt): Ditto.
-
-2000-11-21 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-verify-option): Default value.
-
- * mml-sec.el (mml-secure-part): Error message.
-
-2000-11-20 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-ml.el (gnus-mailing-list-archive): Use browse-url.
-
-2000-11-20 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-make-menu-bar): Use easy-menu-add.
-
-2000-11-20 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-describe-key): Use prompt.
- (gnus-article-describe-key-briefly): Ditto.
-
-2000-11-20 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-agent.el (gnus-agent-expire): Ignore corrupted history.
-
-2000-11-20 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-describe-key): New function.
- (gnus-article-describe-key-briefly): New function.
-
-2000-11-19 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-decrypt-option): Doc typo.
-
- * gnus-art.el (gnus-article-read-summary-keys): lookup-key may
- return a number.
-
-2000-11-19 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-newline-and-reformat): Typo.
-
-2000-11-19 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (article-verify-x-pgp-sig): Check whether
- original-article-buffer exists.
-
- * rfc2047.el (rfc2047-q-encoding-alist): Match Resent-.
- (rfc2047-header-encoding-alist): Addresses are different from text.
- (rfc2047-encode-message-header): Ditto.
- (rfc2047-dissect-region): Extra parameter.
- (rfc2047-encode-region): Ditto.
- (rfc2047-encode-string): Ditto.
-
-2000-11-19 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-pgp-encrypted-extract-1): New function.
- (mm-uu-pgp-encrypted-extract): Use it.
- (mm-uu-pgp-signed-extract-1): New function.
- (mm-uu-pgp-signed-extract): Use it.
-
- * gnus-art.el (gnus-mime-display-security): New function.
- (gnus-mime-display-part): Use it.
- (gnus-mime-security-verify-or-decrypt): New function.
- (gnus-mime-security-press-button): New function.
- (gnus-insert-mime-security-button): Use it.
-
- * mm-decode.el (mm-possibly-verify-or-decrypt): Use mm-h-m-c-p.
- (mm-find-raw-part-by-type): Ditto.
- (mm-verify-function-alist): Add x-gnus-pgp-signature handle.
- (mm-decrypt-function-alist): Add x-gnus-pgp-encrypted handle.
- (mm-destroy-parts): Kill nested multibyte buffer.
-
- * mml2015.el (mml2015-mailcrypt-verify): Use mm-h-m-c-p.
- (mml2015-gpg-verify): Ditto.
-
-2000-11-18 Simon Josefsson <sj@extundo.com>
-
- * mml2015.el (mml2015-mailcrypt-clear-verify): New function.
- (mml2015-function-alist): Use it.
-
- * mml-sec.el (mml-sign-alist): Update names.
- (mml-encrypt-alist): Ditto.
- (mml-secure-part-smime-sign): Moved to mml-smime.el
- as `mml-smime-sign-query'.
- (mml-secure-part-smime-encrypt-by-file): Moved to mml-smime.el as
- `mml-smime-get-file-cert'.
- (mml-secure-part-smime-encrypt-by-dns): Moved to mml-smime.el as
- `mml-smime-get-dns-cert'.
- (mml-secure-part-smime-encrypt): Moved to mml-smime.el as
- `mml-smime-encrypt-query'.
- (mml-smime-sign-buffer): Use mml-smime-sign.
- (mml-smime-encrypt-buffer): Use mml-smime-encrypt.
-
- * mml-smime.el (mml-smime-sign): New function.
- (mml-smime-encrypt):
- (mml-smime-sign-query):
- (mml-smime-get-file-cert):
- (mml-smime-get-dns-cert):
- (mml-smime-encrypt-query): Moved from mml-sec.el.
-
-2000-11-16 Simon Josefsson <sj@extundo.com>
-
- * mml2015.el (mml2015-gpg-clear-verify): New function.
- (mml2015-function-alist): Add it.
-
-2000-11-17 14:21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-setup-fill-variables): Use
- message-cite-prefix-regexp.
- (message-newline-and-reformat): Check the end of citation, leading
- WSP, break in the cite prefix.
- (message-fill-paragraph): New function.
-
-2000-11-17 13:44 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * lpath.el: Shut up.
-
-2000-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus-msg.el (gnus-group-posting-charset-alist): No longer allow
- raw 8-bit in headers in dk.* newsgroups.
-
-2000-11-17 08:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-newline-and-reformat): Match extra WSPs.
-
-2000-11-16 23:31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Ignore ascii.
-
-2000-11-16 Justin Sheehy <justin@iago.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Fix menu items.
-
-2000-11-16 17:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-cite-prefix-regexp): Prefix should not end
- at space.
-
-2000-11-15 18:09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-mode-syntax-table): Add - as a word
- constituent as in articles.
- (message-setup-fill-variables): Add -_. as supercite-style prefix.
- * gnus-art.el (gnus-article-mode-syntax-table): Remove ?-.
- * gnus-cite.el (gnus-cite-parse): Match from the beginning of line.
-
-2000-11-15 13:21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-do-gcc): Expire the article.
-
-2000-11-12 David Edmondson <dme@dme.org>
-
- * message.el (message-font-lock-keywords): use
- message-cite-prefix-regexp.
-
-2000-11-15 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-group.el (gnus-group-jump-to-group-prompt): New variable by
- Stein Arild Str\e,Ax\e(Bmme.
- (gnus-group-jump-to-group): Use it.
- (gnus-group-jump-to-group-prompt): Customize.
-
-2000-11-14 10:32:42 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mailcap.el (mailcap-possible-viewers): Match the entire string.
-
-2000-11-14 10:20:56 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-verify): replace-match is
- incompatible.
- (mml2015-mailcrypt-sign): Ditto.
-
-2000-11-14 10:12:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-do-gcc): Update summary data when the
- group is open.
-
-2000-11-14 00:48:52 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-bcklg.el (gnus-backlog-enter-article): Don't enter
- nnvirtual articles.
- (gnus-backlog-request-article): Don't request nnvirtual articles.
-
-2000-11-13 22:08:09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-sign): Remove "-" escape.
- * mml.el (mml-generate-mime-1): Save cont. skip multipart attributes.
-
-2000-11-13 20:43:37 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-get-part): Don't call mm-insert-part.
- * mml.el (mml-generate-mime-1): Use charset attribute.
- * mm-bodies.el (mm-encode-body): Add parameter charset.
- * mm-util.el (mm-mime-charset): Show error when find 8-bit characters.
-
-2000-11-13 16:09:09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-decrypt): Handle quit.
- (mml2015-mailcrypt-clear-decrypt): Ditto.
- (mml2015-mailcrypt-verify): Ditto.
- (mml2015-mailcrypt-clear-verify): Ditto.
- (mml2015-gpg-verify): Ditto.
-
-2000-11-13 15:29:58 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * smime.el (smime-openssl-program): Test the existence of openssl.
- * mml-smime.el: Require mm-decode.
- (mml-smime-verify-test): New function.
- * mm-decode.el (mm-verify-function-alist): Use it.
-
-2000-11-13 09:50:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-repair-multipart): Fix Mime-Version
- anyway.
-
-2000-11-13 Simon Josefsson <sj@extundo.com>
-
- * mm-uu.el (mm-uu-pgp-signed-extract): Explain why clear
- verification doesn't work.
-
-2000-11-12 23:36:45 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-inews-mark-gcc-as-read): New variable.
- (gnus-inews-do-gcc): Use it.
-
-2000-11-12 21:35:04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el (rfc2231-encode-string): Insert semi-colon and
- leading space.
- * mm-extern.el (mm-inline-external-body): Report error when no
- access-type.
-
-2000-11-12 19:48:30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-select-newsgroup): Change the error message.
-
-2000-11-12 11:53:18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-button-menu): Use select-window.
-
-2000-11-12 09:47:54 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-part): Display multipart/related
- as multipart/mixed.
-
-2000-11-12 David Edmondson <dme@dme.org>
-
- * message.el (message-cite-prefix-regexp): moved from gnus-cite.el
- and replace `.' with `\w' to allow for different syntax tables
- (from Vladimir Volovich).
- * message.el (message-newline-and-reformat): use
- `message-cite-prefix-regexp'.
- * gnus-cite.el (gnus-supercite-regexp): use
- `message-cite-prefix-regexp'.
- * gnus-cite.el (gnus-cite-parse): use
- `message-cite-prefix-regexp'.
-
-2000-11-12 08:52:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-verify): Replace armors with
- PGP SIGNATURE. Escape leading "-"'s.
- (mml2015-mailcrypt-sign): Replace armors with PGP MESSAGE.
-
-2000-11-11 15:55:35 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-type-alist): Stricter shar regexp.
-
-2000-11-11 Simon Josefsson <sj@extundo.com>
-
- * mml2015.el (mml2015-gpg-verify): Set "OK" security status.
-
- * smime.el (smime-details-buffer): New variable.
- (smime-sign-region):
- (smime-encrypt-region):
- (smime-verify-region):
- (smime-decrypt-region): Copy OpenSSL output to the buffer.
-
- * mml-smime.el (mml-smime-verify): Support security info.
-
-2000-11-10 17:11:22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-verify-option): Set default to nil.
- (mm-decrypt-option): Ditto.
- * gnus-art.el (article-verify-x-pgp-sig): New function.
-
-2000-11-10 09:01:25 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-alternative): Show button if no
- preferred part.
-
-2000-11-07 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus-sum.el (gnus-move-split-methods): Say that
- `gnus-split-methods' uses file names, whereas this uses group
- names. (Report from Nevin Kapur)
-
-2000-11-10 01:23:20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-partial.el (mm-inline-partial): Insert MIME-Version.
-
-2000-11-09 17:02:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-directory-files-is-safe): New variable.
- (nnheader-directory-articles): Use it.
- (nnheader-article-to-file-alist): Ditto.
-
-2000-11-09 16:20:37 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-pad-base64): New function.
- (rfc2047-decode): Use it.
-
-2000-11-09 08:53:04 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Bind the original
- select method.
-
-2000-11-08 19:58:58 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-gpg-decrypt-1):
- (mml2015-gpg-verify): buffer-string has no argument in Emacs.
-
-2000-11-08 16:37:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-cache.el (gnus-cache-generate-nov-databases): Reopen cache.
-
-2000-11-08 08:38:30 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * pop3.el (pop3-munge-message-separator): A message may have an
- empty body.
-
-2000-11-07 18:02:26 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-type-alist): Don't test pgp stuff.
- (mm-uu-pgp-encrypted-extract): Clean mml2015 buffer.
- (mm-uu-pgp-signed-extract): Use coding-system.
-
-2000-11-07 14:33:19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-part): Show MIME security button.
- (gnus-insert-mime-security-button): New function.
- * mm-decode.el (mm-possibly-verify-or-decrypt): Add security info.
- * mml2015.el: Add security info when verify or decrypt.
- * mm-uu.el (mm-uu-pgp-signed-extract): Use multipart.
- (mm-uu-pgp-encrypted-extract): Ditto.
-
-2000-11-07 08:49:36 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-display-parts): New function.
- * gnus-art.el (gnus-mime-view-all-parts): Use it. Remove parts first.
-
-2000-02-02 Alexandre Oliva <oliva@lsd.ic.unicamp.br>
-
- * gnus-mlspl.el: Documentation tweaks.
-
-2000-11-06 22:06:44 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-possibly-verify-or-decrypt): Fix.
- * gnus-art.el (gnus-article-encrypt-body): Rename and support prefix
- argument.
-
-2000-11-06 19:10:14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el (rfc2231-encode-string): Use us-ascii if charset is nil.
-
-2000-11-06 18:17:53 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-article-encrypt): New function.
- (gnus-article-encrypt-protocol-alist): New variable.
- (gnus-article-encrypt-protocol): New variable.
- * mml2015.el (mml2015-self-encrypt): New function.
- (mml2015-mailcrypt-encrypt): Set mc-pgp-always-sign.
-
-2000-11-06 16:02:52 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-uu.el (mm-uu-gpg-key-skip-to-last): New function.
- (mm-uu-pgp-key-extract): Use application/pgp-keys, don't snarf,
- let mailcap do it.
- * mml2015.el: Remove snarf code.
- * mm-decode.el: Remove snarf code.
-
-2000-11-06 14:03:10 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-insert-mml-markup): Ignore internal stuff.
- (mml-insert-mime): Understand gnus-decoded.
- (mime-to-mml): New parameter handles.
- * gnus-art.el (gnus-mime-save-part-and-strip): Use it.
- * gnus-sum.el (gnus-summary-edit-article): Add argument `3'.
-
-2000-11-06 13:51:37 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mime-security): New group.
- (mm-verify-function-alist): Add test function.
- (mm-decrypt-function-alist): Ditto.
- (mm-snarf-option): Set default value as nil.
- (mm-find-part-by-type): Recursive parameter.
- (mm-possibly-verify-or-decrypt): Support draft-ietf-openpgp-multsig.
- * mml2015.el: Support draft-ietf-openpgp-multsig.
-
-2000-11-06 13:01:27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-view-part-as-charset): New function.
- (gnus-article-view-part-as-charset): New function.
-
-2000-11-05 22:34:07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-verify-option): Default value.
- (mm-possibly-verify-or-decrypt): Dealing with broken messages.
-
-2000-11-05 15:06:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnvirtual.el (nnvirtual-request-expire-articles): Uncompress range.
-
-2000-11-05 Simon Josefsson <sj@extundo.com>
-
- * mml-smime.el (mml-smime-verify): Work in original multipart
- buffert.
-
- * mm-decode.el (mm-handle-multipart-original-buffer): New macro.
- (mm-handle-multipart-ctl-parameter): Ditto.
- (mm-alist-to-plist): New function.
- (mm-dissect-buffer): Store CTL parameters and copy original buffer
- for multiparts.
- (mm-destroy-parts): Destroy multipart buffert.
- (mm-remove-part): Ditto.
-
- * mml-smime.el (mml-smime-sign): Not used.
- (mml-smime-encrypt): Ditto.
-
- * mm-decode.el (mml-smime-verify): Autoload mml-smime.
-
- Verify S/MIME signature support.
-
- * mm-decode.el (mm-inline-media-tests): Add
- application/{x-,}pkcs7-signature.
- (mm-inlined-types): Ditto.
- (mm-automatic-display): Ditto.
- (mm-verify-function-alist): Ditto. Add name of method.
- (mm-decrypt-function-alist): Add name of method.
- (mm-find-part-by-type): Add documentation.
- (mm-possibly-verify-or-decrypt): Use new format of
- mm-{verify,decrypt}-function-alist. Use method names.
-
- * mml-smime.el (mml-smime-verify): New function.
-
-2000-11-04 20:38:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-view.el (mm-inline-text): Move point to the end of inserted text.
-
-2000-11-04 19:07:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-function-alist): Clear verify and decrypt.
- * mm-uu.el: Reorganized. Add gnatsweb, pgp-signed, pgp-encrypted.
- * mm-decode.el (mm-snarf-option): New variable.
-
-2000-11-04 13:08:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-util.el (mm-subst-char-in-string): New function.
- (mm-replace-chars-in-string): Use it.
- * message.el (message-replace-chars-in-string): Use it.
- * nnheader.el (nnheader-replace-chars-in-string): Use it.
- * gnus-mh.el (mh-lib-progs): Shut up.
-
-2000-11-04 ShengHuo Zhu <zsh@cs.rochester.edu>
-
- * base64.el, md5.el: Moved to contrib directory.
-
-2000-11-04 11:13:56 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-search-article-forward): Don't move
- the last article when search.
-
-2000-11-04 10:34:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnheader.el (nnheader-pathname-coding-system): Default iso-8859-1.
- * nnmail.el (nnmail-pathname-coding-system): Ditto.
-
-2000-09-29 David Edmondson <dme@thus.net>
-
- * message.el (message-newline-and-reformat): Typo.
-
-2000-11-04 10:11:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el (rfc2231-decode-encoded-string): Test mm-multibyte-p.
-
-2000-11-04 09:53:42 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nntp.el (nntp-decode-text): Delete bogus status lines.
-
-2000-11-03 Stefan Monnier <monnier@cs.yale.edu>
-
- * message.el (message-font-lock-keywords): Match a final newline
- to help font-lock's multiline support.
-
-2000-11-04 09:11:44 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnoo.el (nnoo-set): New function.
-
-2000-11-04 ShengHuo Zhu <zsh@cs.rochester.edu>
-
- * gpg.el, gpg-ring.el: Moved to contrib directory.
-
-2000-11-04 Simon Josefsson <sj@extundo.com>
-
- * nnimap.el (nnimap-split-inbox): Typo.
-
-2000-11-03 10:46:44 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-msg.el (gnus-msg-mail): Move it backwards.
-
-2000-11-03 Simon Josefsson <sj@extundo.com>
-
- * rfc2231.el (rfc2231-parse-qp-string): New function.
- (require): rfc2047.
-
- * mail-parse.el (mail-header-parse-content-type):
- (mail-header-parse-content-disposition): Support invalid QP
- encoded strings, by using `rfc2231-parse-qp-string'.
-
-2000-11-03 08:58:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2231.el (rfc2231-parse-string): Decode when there is no number.
- (rfc2231-decode-encoded-string): Typo "> X 1".
- (rfc2231-encode-string): Insert the name of charset.
- * mail-parse.el (mail-header-encode-parameter): Use RFC2231.
-
-2000-11-02 23:35:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-save-part): Return the filename.
- * gnus-sum.el (gnus-summary-edit-article): Remove a hack.
- * gnus-art.el (gnus-mime-save-part-and-strip): New function.
- (gnus-mime-action-alist): Use it.
- (gnus-mime-button-commands): Use it.
- * mm-extern.el (mm-extern-local-file): Error when the file is gone.
- (mm-inline-external-body): unwind-protect.
-
-2000-11-02 21:08:49 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-insert-mime-button): Show url.
-
-2000-11-02 19:51:19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-1): Support external url.
- * nnwarchive.el (nnwarchive-mail-archive-article): Use external url.
-
-2000-11-02 16:53:32 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-partial.el (mm-inline-partial): Buffer name with a leading space.
- * mm-decode.el (mm-display-external): Ditto.
- * mm-extern.el: New file.
- * mm-decode.el (mm-inline-media-tests): Hook it up.
- (mm-inlined-types): Inline message/external-body.
-
-2000-11-02 Simon Josefsson <sj@extundo.com>
-
- * gnus-art.el (gnus-visible-headers): Add Mail-Followup-To.
-
- * message.el (message-get-reply-headers): Better handling when
- Mail-Followup-To is very large.
-
-2000-11-02 13:27:56 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-uu.el (gnus-uu-post-news): Comment out the redundancy.
- * gnus-art.el (gnus-article-edit-done):
- * gnus-sum.el (gnus-summary-edit-article-done): Move line
- counting code here.
- * gnus-msg.el (gnus-setup-message): Remove a hack.
-
-2000-11-02 09:33:01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-newsgroup-variables): New variable.
- (gnus-summary-mode): Make them local variables.
- (gnus-set-global-variables): Globalize them.
- (gnus-summary-exit): Kill them.
-
-2000-11-02 Hrvoje Niksic <hniksic@arsdigita.com>
-
- * rfc2047.el (rfc2047-encoded-word-regexp): Allow empty encoded
- word.
-
-2000-11-01 10:07:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-part): Add to signed or encrypted.
- gnus-article-wash-types.
- * gnus-art.el (gnus-article-wash-status): Use them.
-
-2000-11-01 08:54:11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-read-tag): Remove spaces and LF.
-
-2000-11-01 08:01:03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-encrypt): Use from and sign parameters.
- * mml.el (mml-generate-mime-1): Add sender and recipients attributes.
-
-2000-11-01 07:39:24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-force-verify-and-decrypt): New function.
-
-2000-10-31 22:06:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-article-charset): New variable.
- (gnus-summary-display-article): Set it.
- * gnus-msg.el (gnus-copy-article-buffer): Use it.
- * gnus-art.el (gnus-article-mode): Make it local variable.
-
-2000-11-01 01:12:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-create-mapping): Use nreverse.
-
-2000-10-31 23:45:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnwfm.el: New file.
-
- * nnweb.el (nnweb-replace-in-string): New function.
-
-2000-10-31 17:32:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el: Wrap gpg.el.
- * gpg.el (gpg-verify): The last argument of apply is a list.
- (gpg-encrypt): Add passphrase as a parameter.
-
-2000-10-31 17:28:45 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el: New file.
- * gpg-ring.el: New file.
-
-2000-10-31 11:44:29 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-sum.el (gnus-summary-show-article): Fix the summary line.
-
-2000-10-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-insert-line): Work with quoted
- double-quote characters.
- (gnus-summary-prepare-threads): Ditto.
-
-2000-10-31 08:36:03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-art.el (gnus-mime-display-single): Forward line -1.
- * mml.el (mml-read-tag): Don't skip the leading space.
- * lpath.el (font-lock-set-defaults): Shut up.
-
-2000-10-31 00:04:35 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el: Fix doc. Remove bogus mml2015-setup.
-
-2000-10-30 23:37:07 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * qp.el (quoted-printable-encode-region): Replace leading - when
- ultra safe.
- * mml.el (mml-generate-mime-postprocess-function): Removed.
- (mml-postprocess-alist): Removed.
- (mml-generate-mime-1): Use ultra-safe when sign.
- * mml2015.el (mml2015-fix-micalg): Uppercase.
- (mml2015-verify): Insert LF.
- (mml2015-mailcrypt-sign): Downcase; search backward.
-
-2000-10-16 11:36:52 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnultimate.el (nnultimate-forum-table-p): Be a bit more
- restrictive.
- (nnultimate-table-regexp): New variable.
- (nnultimate-forum-table-p): Use it.
-
-2000-10-30 Ed L Cashin <ecashin@coe.uga.edu>
- Trivial patch.
-
- * gnus-sum.el (gnus-summary-expire-articles): Save point.
-
-2000-10-30 08:52:50 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml-sec.el (mml-pgpmime-sign-buffer): Use mml2015-sign.
- (mml-pgpmime-encrypt-buffer): Use mml2015-encrypt.
-
-2000-10-30 08:38:12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el: Shut up.
-
-2000-10-30 08:17:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.el (gnus-server-browse-hashtb): Removed.
- * gnus-group.el (gnus-group-prepare-flat-list-dead): Use gnus-active.
- (gnus-group-insert-group-line-info): Use simplified method.
- * gnus-srvr.el (gnus-browse-foreign-server): Use gnus-set-active.
-
-2000-10-30 01:52:40 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-util.el (gnus-union): Renamed from gnus-agent-union, and
- moved here.
- * gnus-agent.el (gnus-agent-fetch-headers): Use it.
- * gnus-group.el (gnus-group-prepare-flat): Use it.
- * gnus-topic.el (gnus-group-prepare-topics): Use it.
-
-2000-10-30 01:23:49 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-mode): Show menu in XEmacs.
-
-2000-10-30 00:49:33 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-server-browse-in-group-buffer): New variable.
- (gnus-server-read-server-in-server-buffer): New function.
- (gnus-browse-foreign-server): Browse in group buffer.
- * gnus-group.el (gnus-group-prepare-flat): List group not in list.
- (gnus-group-prepare-flat-list-dead): Use gnus-group-insert-group-line.
- * gnus-topic.el (gnus-group-prepare-topics): Ditto.
- * gnus.el (gnus-server-browse-hashtb): New variable.
-
-2000-10-29 22:31:40 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-open-nov): Use group.
-
-2000-10-29 17:23:15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el: Add NOV. Set version to 2.0.
- (nnfolder-nov-is-evil): If non-nil, nnfolder acts like 1.0.
-
-2000-10-29 10:35:08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el (mml2015-mailcrypt-sign): Use mc-sign-generic.
-
-2000-10-29 09:42:05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-srvr.el (gnus-browse-foreign-server): Show level mark.
- (gnus-browse-unsubscribe-group): Unsubscribed is not killed.
-
-2000-10-29 08:28:58 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * nnfolder.el (nnfolder-read-folder): Don't goto point-min.
-
-2000-10-28 19:11:01 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-verify-function-alist): New variable.
- (mm-verify-option): New variable.
- (mm-decrypt-function-alist): Ditto.
- (mm-decrypt-option): Ditto.
- (mm-find-raw-part-by-type): New function.
- (mm-possibly-verify-or-decrypt): New function.
- (mm-dissect-multipart): Use it.
- * mml2015.el (mml2015-fix-micalg): New function.
- (mml2015-decrypt): Use new interface.
- (mml2015-verify): Use new interface.
- (mml2015-setup): Make it bogus.
-
-2000-10-28 16:54:45 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml.el (mml-generate-mime-postprocess-function): Set to
- mml-postprocess.
- (autoload): Autoload mml2015 and mml-smime.
- (mml-postprocess-alist): Use mml2015-sign and mml2015-encrypt.
- * mml2015.el (mml2015-encrypt): New function.
- (mml2015-sign): New function.
- (mml2015-encrypt-function): New variable.
- (mml2015-sign-function): New variable.
- (mml2015-mailcrypt-encrypt): Use message-recipients.
- (mml2015-setup): Don't set mml-generate-mime-postprocess-function.
- * mml-smime.el (mml-smime-setup): Ditto.
-
-2000-10-28 Simon Josefsson <sj@extundo.com>
-
- * imap.el (imap-parse-resp-text-code): Workaround bug in Stalker
- Communigate Pro 3.3.1 server.
-
- * mml-sec.el (mml-smime-encrypt-buffer): Support certfiles stored
- in buffers.
- (mml-secure-dns-server): Removed.
- (mml-secure-part-smime-encrypt-by-dns): Use DIG interface. Don't
- write certificates to files.
-
- * smime.el (smime-dns-server): New variable.
- (smime-mail-to-domain):
- (smime-cert-by-dns): New functions.
-
- * dig.el: New file.
-
-2000-10-28 10:09:41 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.el (message-options): New variable.
- (message-options-set-recipient): New function.
- (message-send): Use them.
- * gnus-int.el (gnus-request-replace-article): Use them.
- (gnus-request-accept-article): Ditto.
- * mml.el (mml-preview): Use them.
- * gnus-sum.el (gnus-summary-edit-article): Use them.
-
- * message.el (message-options-get): New function.
- (message-options-get): New function.
- * rfc2047.el (rfc2047-encode-message-header): Use them.
- * mm-bodies.el (mm-encode-body): Use them.
-
-2000-10-28 Simon Josefsson <sj@extundo.com>
-
- * nnimap.el (nnimap-retrieve-which-headers):
- (nnimap-request-article-part): Quote message-id.
-
- * smime.el (smime-CA-directory): Rename from `smime-CAs'.
- (smime-CA-file): New variable.
- (smime-call-openssl-region): Don't error.
- (smime-sign-region): Return result value.
- (smime-encrypt-region): Ditto.
- (smime-verify-region): New function.
- (smime-decrypt-region): Ditto.
- (smime-verify-buffer): Ditto.
- (smime-decrypt-buffer): Ditto.
-
- * mml.el: Require mml-sec.
- (mml-generate-mime-1): Support "sign" and "encrypt" MML tags.
- (mml-mode-map): Add "sign" and "encrypt" maps.
- (mml-menu): Add security menu.
- (mml-preview): Use generate-new-buffer.
-
- * mml-sec.el: New file.
-
-2000-10-28 03:43:03 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mm-decode.el (mm-find-part-by-type): Move it here.
- * mml.el (mml-postprocess): Move it here.
- (mml-postprocess-alist): Move it here. Merge them.
-
-2000-10-28 03:38:39 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * rfc2047.el (rfc2047-encode-message-header): Make sure no
- unencoded stuff in the header.
-
-2000-10-28 02:40:46 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus-group.el (gnus-group-listed-groups): New variable.
- (gnus-group-list-option): New variable.
- (gnus-group-list-limit-map): New keymap.
- (gnus-group-list-flush-map): New keymap.
- (gnus-group-list-plus-map): New keymap.
- (gnus-group-prepare-logic): New function.
- (gnus-group-prepare-flat): Merge with
- gnus-group-prepare-flat-predicate. Use gnus-group-listed-groups.
- (gnus-group-prepare-flat-list-dead): Ditto.
- (gnus-group-list-matching): Use gnus-group-prepare-function.
- (gnus-group-list-dormant): Ditto.
- (gnus-group-list-cached): Ditto.
- (gnus-group-listed-groups): New function.
- (gnus-group-list-limit): New function.
- (gnus-group-list-flush): New function.
- (gnus-group-list-plus): New function.
- * gnus-topic.el (gnus-group-prepare-topics): Accept predicate.
- (gnus-topic-prepare-topic): Ditto.
-
-2000-10-27 Paul Jarc <prj@po.cwru.edu>
-
- * message.el (message-insert-to, message-get-reply-headers):
- (message-reply, message-followup): Mail-{Followup,Reply}-To.
-
-2000-10-27 19:45:58 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * mml2015.el: New file.
- * smime.el: New file.
- * mml-smime.el: New file.
-
-2000-10-27 19:42:12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ChangeLog: Moved to ChangeLog.1.
-
-See ChangeLog.1 for earlier changes.
-
- Copyright (C) 2000, 2001, 2002, 2004, 2005, 2006, 2007
- Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; End:
-
-;; arch-tag: 956fd310-042f-4fca-8dca-a01dbe06acff
+++ /dev/null
-2007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Relicense "GPLv2 or later" files to "GPLv3 or later".
-
-2007-04-06 Chong Yidong <cyd@stupidchicken.com>
-
- * sendmail.el (mail-text, mail-mode): Revert extant pieces of
- 1995-05-19 doc changes.
-
-2007-03-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * smtpmail.el: Signal an error when used with Emacs 22+ or XEmacs.
- (smtpmail-send-it): Remove NOMODIFY argument of
- `set-buffer-file-coding-system' for compatibility with Emacs 21.
-
-2007-02-20 Juanma Barranquero <lekktu@gmail.com>
-
- * smtpmail.el (smtpmail-smtp-service, smtpmail-queue-index-file):
- Fix typos in docstrings.
- (smtpmail-local-domain, smtpmail-queue-mail): Doc fixes.
-
-2007-01-06 Simon Josefsson <simon@josefsson.org>
-
- * README: Mention that smtpmail.el doesn't work on XEmacs.
-
-2006-11-24 Eli Zaretskii <eliz@gnu.org>
-
- * smtpmail.el (smtpmail-send-it):
- Copy buffer-file-coding-system from the mail buffer. Possibly add a
- MIME header for the message encoding.
- Bind coding-system-for-write around the call to mail-do-fcc.
- Use smtpmail-code-conv-from to encode queued mail messages.
-
-2006-10-02 MIYOSHI Masanori <miyoshi@meadowy.org> (tiny change)
-
- * smtpmail.el (smtpmail-try-auth-methods): Fix typo in
- 2006-09-28 commit.
-
-2006-09-28 Osamu Yamane <yamane@green.ocn.ne.jp> (tiny change)
-
- * smtpmail.el (smtpmail-try-auth-methods): Do not break long
- lines in base64-encoded authentication response.
-
-2006-09-04 Chong Yidong <cyd@stupidchicken.com>
-
- * sendmail.el (sendmail-program): Moved here from pathe.el.
-
-2006-06-15 Chong Yidong <cyd@stupidchicken.com>
-
- * sendmail.el (mail-send): Search explicitly for
- mail-header-separator when checking for corrupted header lines.
-
-2006-02-11 Miles Bader <miles@gnu.org>
-
- * sendmail.el, smtpmail.el: New files, from Emacs tree.
-
-2005-05-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * hashcash.el (hashcash): New custom group.
- (hashcash-default-payment): Add :group.
- (hashcash-payment-alist): Ditto.
- (hashcash-default-accept-payment): Ditto.
- (hashcash-accept-resources): Ditto.
- (hashcash-path): Ditto.
- (hashcash-extra-generate-parameters): Ditto.
- (hashcash-double-spend-database): Ditto.
- (hashcash-in-news): Ditto.
-
- * nnir.el (nnir): Add :group.
-
-2005-03-13 Steve Youngs <steve@sxemacs.org>
-
- * gpg.el: Add timer/itimer compatibility.
-
-2003-11-15 Simon Josefsson <jas@extundo.com>
-
- * starttls.el: Sync with recent gnu.emacs.sources post.
-
-2003-10-24 Steve Youngs <sryoungs@bigpond.net.au>
-
- * nnir.el: Autoload `read-kbd-macro' at compile time.
-
-2003-09-30 Kai Grossjohann <kai.grossjohann@gmx.net>
- From Torsten Hilbrich <torsten.hilbrich@gmx.net>.
-
- * nnir.el (nnir-imap-search-field, nnir-imap-search-arguments)
- (nnir-imap-search-argument-history): New variables.
- (nnir-engines, nnir-run-imap): Use them.
- (nnir-read-parm): Support reading the new IMAP query parameters.
-
-2003-06-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * README: Explain purpose of each file (well, most files).
-
-2003-05-01 Vasily Korytov <deskpot@despammed.com>
-
- * gpg.el (gpg-passphrase-forget): Check that gpg-passphrase is
- set.
-
-2003-04-17 Steve Youngs <youngs@xemacs.org>
-
- * hashcash.el (hashcash-point-at-bol): Move the fbound test
- outside of the defalias.
- (hashcash-point-at-eol): Ditto.
-
-2003-03-19 Simon Josefsson <jas@extundo.com>
-
- * gnus-idna.el: Update.
-
-2003-03-11 Teodor Zlatanov <tzz@lifelogs.com>
-
- * hashcash.el (hashcash-version, hashcash-insert-payment): patch
- from Paul Foley
-
-2003-03-07 Simon Josefsson <jas@extundo.com>
-
- * gnus-idna.el (gnus-idna-to-ascii-rhs-1): Narrow to
- head (otherwise forwarded mail break havoc).
-
-2003-03-07 Teodor Zlatanov <tzz@bwh.harvard.edu>
-
- * hashcash.el: New version from Paul Foley with better variable
- names, executable-find support, and no errors in GNU Emacs
- (hashcash-version): return nil when invoked with a
- nil token
-
-2003-02-21 Simon Josefsson <jas@extundo.com>
-
- * hashcash.el (hashcash-point-at-bol):
- (hashcash-point-at-eol): Defalias.
- (hashcash-generate-payment):
- (mail-check-payment): Use it.
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * hashcash.el: New version from Paul Foley with new
- mail-check-payment function.
-
-2002-06-22 Simon Josefsson <jas@extundo.com>
-
- * hashcash.el: New file.
- (hashcash-default-payment, hashcash-payment-alist, hashcash):
- Defcustom.
- (hashcash-generate-payment): Update to recent hashcode command
- line syntax.
- (hashcash-insert-payment): Use X-Hashcode:.
- (mail-add-payment): Also look at Newsgroups.
- (top-level): Add provide and EOF comment.
- (mail-add-payment): Autoload.
- (hashcash-insert-payment): s/Hashcode/Hashcash/
- (mail-add-payment): Doc fix.
-
-2002-05-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-mdrtn.el (gnus-moderated-groups): Removed (require 'gnus-load).
-
-2002-04-24 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * ucs-tables.el (featurep): Barf on XEmacs.
-
-2002-03-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ucs-tables.el: Copy from Emacs 21.
-
-2002-03-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * xml.el: Sync with Emacs 21.
-
-2002-01-25 Josh Huber <huber@alum.wpi.edu>
-
- * gpg.el (gpg-command-decrypt): Enable the status-fd command line
- option to gpg when decrypting so `mml2015-mailcrypt-decrypt' can
- parse and display the output.
-
-2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-mdrtn.el (gnus-moderation-cancel-article): Insert an extra
- newline.
-
-2001-12-26 Florian Weimer <fw@deneb.enyo.de>
-
- * gpg.el (gpg-command-default-alist): Using gpg-2comp is no longer
- the default.
-
-2001-12-18 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog: changed buffer-file-coding-system back to
- coding. (oops)
-
-2001-12-17 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog: changed coding to buffer-file-coding-system
-
-2001-11-22 Simon Josefsson <jas@extundo.com>
-
- * sha1.el: Removed. (A FSF copyrighted sha1-el.el file is in
- ../lisp/).
-
-2001-10-30 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * canlock.el, hex-util.el, sha1-el.el: Move to lisp.
-
-2001-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el: (canlock-base64-encode-function): Removed.
- (canlock-mmencode-program): Removed.
- (canlock-mmencode-args-for-encoding): Removed.
- (canlock-openssl-program): Renamed from `canlock-ssleay-program'.
- (canlock-openssl-args): Renamed from `canlock-ssleay-args'.
- (canlock-load-hook): Removed.
- (canlock-base64-encode-string-with-mmencode): Removed.
- (canlock-sha1-with-openssl): Renamed from
- `canlock-sha1-with-ssleay'.
- (canlock-hex-string-to-int): Removed.
- (canlock-fetch-fields): Don't use `mapcar'.
- (canlock-fetch-id-for-key): Don't use Cancel header if there is no
- cancel command.
- (gnus-summary-canlock-verify): Removed.
- (wl-summary-canlock-verify): Removed.
- (canlock-mew-summary-display): Removed.
- (mew-summary-canlock-verify): Removed.
- (mh-summary-canlock-verify): Removed.
- (vm-summary-canlock-verify): Removed.
- (cmail-summary-canlock-verify): Removed.
- (rmail-summary-canlock-verify): Removed.
-
-2001-10-25 Simon Josefsson <jas@extundo.com>
-
- * canlock.el (canlock-password, canlock-password-for-verify)
- (canlock-force-insert-header): Defcustom.
-
-2001-10-17 Simon Josefsson <jas@extundo.com>
-
- * canlock.el (sha1-binary): Autoload `sha1-binary'.
- (canlock-sha1-function): Use it.
- (canlock-sha1-function-for-verify): Ditto.
-
- * sha1-el.el: New file.
-
- * hex-util.el: Ditto.
-
-2001-08-24 16:09:14 Fabien Penso <penso@linuxfr.org>
-
- * gpg.el (gpg-command-sign-detached): Doc fix.
-
-2001-08-07 Andreas Jaeger <aj@suse.de>
-
- * gpg.el (gpg-passphrase-forget): Don't cache
- gpg-passphrase-timer.
- (gpg-passphrase-store): Check if gpg-passphrase-timer is
- initialized already.
-
-2001-07-30 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Andreas Fuchs <asf@void.at>
-
- * gpg.el (gpg-command-verify): --status-fd 1
- (gpg-unabbrev-trust-alist): New.
-
-2001-01-18 Colin Marquardt <colin.marquardt@usa.alcatel.com>
-
- * gpg.el (gpg-make-temp-file): Error info.
-
-2001-01-13 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (gpg-build-arg-list): Use copy-sequence.
-
-2000-12-19 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (defalias): Use eval-and-compile.
- (gpg-command-all-arglist): Suggest by Jeff Senn <senn@maya.com>.
-
-2000-12-15 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (gpg-command-alist): Alist may not be defined.
-
-2000-12-14 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (gpg-make-temp-file): Don't check file-modes of M$Windows.
-
-2000-12-14 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (gpg-passphrase-store): Don't activate timer if it is live.
-
-2000-11-30 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el: (gpg-make-temp-file): Use expand-file-name.
- (gpg-point-at-eol): New function.
- (gpg-call-process): Use it.
- (gpg-key-list-keys-parse-line): Ditto.
- (gpg-with-passphrase-env): edebug-form-spec.
- (gpg-with-temp-files): Ditto.
- (gpg-show-result): Ditto.
-
-2000-11-08 Bj\e,Av\e(Brn Torkelsson <torkel@hpc2n.umu.se>
-
- * gpg.el: In Xemacs it is called point-at-eol, not
- line-end-position
-
- * gpg.el (gpg-key-lessp): use string-lessp instead of
- compare-strings (not available on XEmacs)
-
-2000-11-16 Simon Josefsson <sj@extundo.com>
-
- * gpg.el (gpg-command-verify-cleartext): New variable.
- (gpg-verify-cleartext): New function.
-
-2000-10-31 17:32:02 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gpg.el (gpg-verify): The last argument of apply is a list.
- (gpg-encrypt): Add passphrase as a parameter.
-
- Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006,
- 2007 Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; fill-column: 79
-;; add-log-time-zone-rule: t
-;; End:
-
-;;; arch-tag: 105a2bf0-3f04-4ba6-a991-619aece2c04f
+++ /dev/null
-2008-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el: Gnus v5.10.10 is released.
-
-2008-03-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (datarootdir): Define.
- (EMACS_COMP, install-el, install-elc, install-el-elc): Quote directory
- name that might contain whitespace.
-
-2008-03-29 Sven Joachim <svenjoac@gmx.de>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add missing dots.
-
-2008-03-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-cite-original-without-signature): Mention
- stripping of the signatur in doc string.
-
-2008-03-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * tls.el (open-tls-stream): Reindent.
-
-2008-03-18 Nils Ackermann <nils@ackermath.info> (tiny change)
-
- * nnmh.el (nnmh-request-expire-articles): Prefer expiry-target group
- parameter.
-
- * message.el (message-disassociate-draft): Specify drafts group name
- fully.
-
-2008-03-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mail-source.el (mail-source-delete-old-incoming) Fix regexp to find
- Incoming* files.
-
-2008-03-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-open-telnet-stream, nntp-open-via-rlogin-and-telnet)
- (nntp-open-via-telnet-and-telnet): Make sure the nntp port to specify
- is a string.
-
-2008-03-10 Glenn Morris <rgm@gnu.org>
-
- Merge from the Emacs trunk to enable it to work with XEmacs.
- * tls.el: Don't require rx when compiling.
- (tls-end-of-info): Rewrite without using rx.
- (open-tls-stream): Use with-current-buffer.
-
-2008-03-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Consider the case without Emacs/W3.
-
-2008-03-08 Riccardo Murri <riccardo.murri@gmail.com>
-
- * net/tls.el: Require rx when compiling.
- (tls-end-of-info): New variable.
- (open-tls-stream): Keep reading input until `tls-end-of-info' is
- matched. [Sync from EMACS_22_BASE.]
-
-2008-03-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mail-source.el (mail-source-delete-old-incoming-confirm): Change
- default to nil.
- (mail-source-delete-old-incoming): Make confirmation prompt more clear.
-
-2008-03-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Rearrange.
-
- * gnus-art.el (gnus-narrow-to-page): Position point properly.
- (gnus-article-goto-prev-page): Work for articles having ^L's.
-
- * gnus-sum.el (gnus-summary-end-of-article): Remove needless narrowing.
-
- * mm-view.el (mm-w3m-standalone-supports-m17n-p): Fix typo.
-
-2008-03-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-print-buffer): Honor ps-print-color-p.
- Suggested by <chris.anderton@zetnet.co.uk>.
-
-2008-03-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- Sync from EMACS_22_BASE.
-
- * parse-time.el: Rename elt->parse-time-elt and val->parse-time-val.
-
- * nnimap.el (nnimap-split-download-body): Fix spelling.
-
- * netrc.el: Remove eval-and-compile for `netrc-point-at-eol'.
-
- * gnus-uu.el (gnus-uu-default-view-rules, gnus-uu-decode-save): Fix
- spelling and typo.
-
- * gnus-demon.el (gnus-demon): Fix spelling.
-
- * deuglify.el: Don't use "illegal".
-
-2008-03-01 Glenn Morris <rgm@gnu.org>
-
- * calendar/time-date.el (with-decoded-time-value): Doc fix.
-
-2008-03-01 Ari Roponen <ari.roponen@gmail.com> (tiny change)
-
- * calendar/time-date.el (encode-time-value): Doc fix.
-
-2008-03-01 Glenn Morris <rgm@gnu.org>
-
- * message.el (message-tool-bar-retro): Update for rename
- mail_send.xpm->mail-send.xpm.
-
-2008-03-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Update copyright years.
-
-2008-02-29 Andreas Seltenreich <andreas@gate450.dyndns.org>
-
- * nnweb.el (nnweb-google-parse-1): Fix date parsing on articles with
- empty author.
-
-2008-02-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mail-source.el (mail-source-delete-incoming): Change default.
- Supplement doc string.
-
-2008-02-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnmail.el (nnmail-message-id-cache-file): Derive from
- `gnus-home-directory'.
-
-2008-02-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-topic.el (gnus-topic-select-group, gnus-topic-read-group):
- Document negativ prefix.
-
- * gnus-group.el (gnus-group-read-group): Document negativ prefix.
-
-2008-02-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-group-startup-message): Add `find-image' call before
- image-load-path is let-bound. Reported by Harald Hanche-Olsen
- <hanche@math.ntnu.no>.
-
-2008-01-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-article-sort-by-random)
- (gnus-thread-sort-by-random): Fix doc strings. Reported by
- jidanni@jidanni.org.
-
-2007-12-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-draft.el (gnus-draft-send-message): Mention process/prefix
- convention in doc string.
-
-2007-12-14 Johan Bockg\e,Ae\e(Brd <bojohan@gnu.org>
-
- * gnus-sum.el (gnus-summary-mark-unread-as-read)
- (gnus-summary-mark-read-and-unread-as-read)
- (gnus-summary-mark-current-read-and-unread-as-read)
- (gnus-summary-mark-unread-as-ticked): Doc fix.
- `gnus-mark-article-hook', not `gnus-summary-mark-article-hook'.
-
-2007-12-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-prev-article): Fix doc string. Reported by
- Christoph Conrad <christoph.conrad@gmx.de>.
-
-2007-12-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-ignored-supersedes-headers): Add "X-ID".
-
-2007-11-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el: Bump version to 5.10.9.
-
-2007-11-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-highlight): Mark as risky local variable.
-
-2007-11-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-util.el (mm-charset-eval-alist): Mark as risky local variable.
-
- * gnus.el (gnus-group-charter-alist): Mark as risky local variable.
-
- * gnus-art.el (gnus-button-alist, gnus-header-button-alist): Mark as
- risky local variable.
-
- * gnus-group.el (gnus-group-icon-list): Mark as risky local variable.
-
-2007-11-01 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
-
- * message.el (message-use-alternative-email-as-from): Examine the
- From header as well; use message-make-from in order to include a
- user's full name. [ Backported bug fix from No Gnus. ]
-
-2007-10-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * qp.el (quoted-printable-decode-string): Fix typo in doc string.
-
-2007-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-ems.el (gnus-x-splash): Work even if there's no scroll bar.
-
-2007-10-23 Richard Stallman <rms@gnu.org>
-
- * gnus-group.el (gnus-group-highlight): Mark as risky.
-
-2007-10-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-server-to-method): Return method found first in
- gnus-newsrc-alist.
-
-2007-10-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * html2text.el (html2text-fix-paragraph): Use `forward-line' instead of
- `next-line'.
-
-2007-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-fancy-expiry-target): Use rmail-dont-reply-to to
- exclude address matching message-dont-reply-to-names.
-
-2007-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-string<): New function.
-
- * gnus-sum.el (gnus-article-sort-by-author)
- (gnus-article-sort-by-subject): Use it.
-
-2007-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-win.el (gnus-configure-windows): Focus on the frame for which
- the frame-focus tag is set in gnus-buffer-configuration.
-
-2007-10-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-util.el (mm-charset-synonym-alist): Alias gbk to cp936.
-
-2007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Relicense "GPLv2 or later" files to "GPLv3 or later".
-
-2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-newsgroup-maximum-articles): Move from gnus.el.
- Suggested by Leo <sdl.web@gmail.com>.
-
- * gnus.el: Do.
-
-2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-newsgroup-maximum-articles): Rename from
- gnus-maximum-newsgroup. Suggested by Leo <sdl.web@gmail.com>.
-
- * gnus-agent.el (gnus-agent-fetch-headers): Do.
-
- * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles)
- (gnus-list-of-read-articles, gnus-sequence-of-unread-articles): Do.
-
-2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmbox.el (nnmbox-request-article): Don't assume delim regexp matches
- newline.
- (nnmbox-request-accept-article): Don't change article in source buffer;
- narrow to header to use message-fetch-field rather than
- nnmail-fetch-field; use with-current-buffer instead of save-excursion.
- (nnmbox-request-replace-article): Quote lines that'll be misidentified
- as delimiters; make sure article ends with newline.
- (nnmbox-delete-mail): Correct last position of article to be deleted;
- ignore X-Gnus-Newsgroup header in article body.
- (nnmbox-save-mail): Quote lines looking like delimiters at the right
- positions; make sure article ends with newline.
-
- * lpath.el: Don't bind define-ccl-program for non-Mule XEmacs.
-
- * dgnushack.el: Bind or autoload define-ccl-program for XEmacs.
-
-2007-09-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-cus.el (gnus-score-extra): New widget.
- (gnus-score-extra-convert): New function.
- (gnus-score-customize): Use it for Extra.
-
-2007-08-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-generate-mime): Make sure it uses multibyte temp buffer.
- (mml-generate-mime-1): Don't encode body if it is specified to be in
- raw form; don't make buffer be unibyte when inserting multibyte string.
-
-2007-08-23 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * sha1.el: Fix up comment style.
- (sha1-F0, sha1-F1, sha1-F2, sha1-F3, sha1-S1, sha1-S5, sha1-S30)
- (sha1-OP, sha1-add-to-H): Use new-style backquotes.
-
- * hex-util.el: Fix up comment style.
- (hex-char-to-num, num-to-hex-char): Use new-style backquotes.
-
- * gnus-salt.el: Use with-current-buffer.
- (gnus-pick-setup-message): Fix long-standing typo.
-
-2007-08-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-summary-command-nosave)
- (gnus-article-read-summary-keys): Don't use 3rd arg of pop-to-buffer.
-
-2007-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-maximum-newsgroup): New variable.
-
- * gnus-agent.el (gnus-agent-fetch-headers): Limit the range of articles
- according to gnus-maximum-newsgroup.
-
- * gnus-sum.el (gnus-articles-to-read, gnus-list-of-unread-articles)
- (gnus-list-of-read-articles, gnus-sequence-of-unread-articles):
- Limit the range of articles according to gnus-maximum-newsgroup.
-
-2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-xref-number-is-evil): New server variable.
- (nntp-find-group-and-number): If it is non-nil, don't trust article
- numbers in the Xref header.
-
-2007-08-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-ems.el (gnus-x-splash): Bind inhibit-read-only to t.
-
-2007-08-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (article-hide-headers): Bind inhibit-read-only to t.
-
-2007-08-08 Glenn Morris <rgm@gnu.org>
-
- * gmm-utils.el, gnus-async.el, gnus-msg.el, gnus-score.el
- * gnus-util.el, imap.el, mailcap.el, nnimap.el: Replace `iff' in
- doc-strings and comments.
-
-2007-07-25 Glenn Morris <rgm@gnu.org>
-
- * Relicense all FSF files to GPLv3 or later.
-
-2007-07-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-summary-supersede-article)
- (gnus-summary-resend-message-edit): Add Gcc header.
- (gnus-summary-resend-bounced-mail): Ditto; search whole body for parent
- article's Message-ID; refer parent article in summary buffer.
-
- * message.el (message-bounce): Call mime-to-mml.
-
-2007-07-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-uu.el (mm-uu-type-alist): Refer to mm-uu-configure-list in doc
- string.
-
-2007-07-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-srvr.el (gnus-server-font-lock-keywords): Quote faces.
-
-2007-07-14 David Kastrup <dak@gnu.org>
-
- * gnus-art.el (gnus-mime-delete-part): Don't go through article-edit
- finishing actions if we did not edit the article.
-
-2007-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
- (gnus-server-closed-face, gnus-server-denied-face)
- (gnus-server-offline-face): Remove variable.
- (gnus-server-font-lock-keywords): Use faces that are not aliases.
-
- * mm-util.el (mm-decode-coding-string, mm-encode-coding-string)
- (mm-decode-coding-region, mm-encode-coding-region): Don't modify string
- if the coding-system argument is nil for XEmacs.
-
- * nnrss.el (nnrss-compatible-encoding-alist): Inherit the value of
- mm-charset-override-alist.
-
- * rfc2047.el: Don't require base64; require rfc2045 for the function
- rfc2045-encode-string.
- (rfc2047-encode-parameter): Use rfc2045-encode-string to quote or not
- to quote the parameter value.
-
-2007-07-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-catchup): Don't recognize cached articles
- as unfetched articles.
-
-2007-07-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-start.el (gnus-level-unsubscribed): Improve doc string.
-
-2007-06-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-summary-command-nosave)
- (gnus-article-read-summary-keys): Don't set the 3rd arg of
- pop-to-buffer for XEmacs.
-
-2007-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-fetch-headers)
- (gnus-agent-retrieve-headers): Bind
- gnus-decode-encoded-address-function to identity.
-
- * nntp.el (nntp-send-xover-command): Recognize an xover command is
- available also when the server returns simply a dot.
-
- * gnus-ems.el (gnus-x-splash): Redisplay window before measuring it.
-
-2007-06-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-ems.el (gnus-x-splash): Make it work.
-
- * gnus-start.el (gnus-1): Relax restrictions that prevent gnus-x-splash
- from being used.
-
- * lpath.el: Bind line-spacing and tool-bar-mode for XEmacs.
-
- * gnus-art.el (gnus-article-summary-command-nosave): Correct the order
- of the arguments passed to pop-to-buffer.
- (gnus-article-read-summary-keys): Ditto.
-
-2007-06-07 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-art.el (gnus-split-methods): Fix typo in docstring.
-
-2007-06-06 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-diary.el (gnus-diary-time-format, gnus-summary-sort-by-schedule):
- * gnus-sum.el (gnus-summary-highlight):
- * pgg.el (pgg-sign-region, pgg-sign):
- * mail-source.el (mail-source-delete-old-incoming-confirm):
- * nndiary.el (nndiary-reminders): Fix typos in docstrings.
-
-2007-06-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-view-part-externally)
- (gnus-mime-view-part-internally): Fix predicate function passed to
- completing-read.
-
- * mm-decode.el (mm-image-fit-p): Return t if argument is not an image;
- return t if image size is just the same as window size.
-
-2007-05-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-pop-to-buffer): Add switch-function argument.
- (message-mail): Pass switch-function argument to it.
-
-2007-05-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-narrow-to-headers-or-head): Ignore
- mail-header-separator in the body.
-
-2007-05-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-article-mode): Fix comment about displaying
- non-break space.
-
-2007-05-09 Didier Verna <didier@xemacs.org>
-
- * gnus-diary.el, nndiary.el: Remove the description comment (nndiary is
- now properly documented in the Gnus manual). Fix the spelling of "Back
- End".
-
-2007-04-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-strip-charset-parameters): New function.
- (gnus-mime-view-part-as-charset): Use it; redisplay subpart currently
- displayed of multipart/alternative part if it is invoked from summary
- buffer.
- (gnus-article-part-wrapper): Select article window.
-
- * mm-view.el (mm-inline-text-html-render-with-w3m)
- (mm-inline-text-html-render-with-w3m-standalone)
- (mm-inline-render-with-function): Use mail-parse-charset by default.
-
-2007-04-18 Levin Du <zslevin@gmail.com> (tiny change)
-
- * parse-time.el (parse-time-string-chars): Check if CHAR
- is less than the length of parse-time-syntax.
-
-2007-04-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-inews-yank-articles): Use
- message-exchange-point-and-mark instead of exchange-point-and-mark.
-
-2007-04-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-yank-original): Make sure cited text ends with
- newline; don't exchange point and mark.
-
-2007-04-07 Chong Yidong <cyd@stupidchicken.com>
-
- * tls.el (open-tls-stream): Properly handle case where there
- is no associated buffer.
-
-2007-04-03 Thien-Thi Nguyen <ttn@gnu.org>
-
- * gnus-msg.el (gnus-inews-yank-articles): Fix bug: After
- message-yank-original, make sure (< mark TEXT point).
-
-2007-03-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnmail.el (nnmail-spool-file): Mark as obsolete.
- (nnmail-get-new-mail): Reformat.
-
- * gnus-registry.el (gnus-registry-cache-save): Add FIXME comment.
-
- * gmm-utils.el: Fix Commentary.
- (gmm-tool-bar-from-list): Fix typo in doc string.
-
-2007-03-27 Thien-Thi Nguyen <ttn@gnu.org>
-
- * message.el (message-yank-original): Fix bug:
- Don't switch point and mark unnecessarily.
-
-2007-03-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus-msg.el (gnus-setup-message, gnus-inews-add-send-actions): Move
- evaluation of gnus-extended-version to ensure correct generation of the
- User-Agent header when message-generate-headers-first is used.
-
-2007-03-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-alist): Also catch `<f1> k ...'.
- (gnus-treat-display-x-face): Fix doc string.
-
-2007-03-20 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * message.el (message-required-news-headers):
- * gnus-util.el (gnus-intern-safe): Fix typo in docstring.
-
-2007-03-18 Thien-Thi Nguyen <ttn@gnu.org>
-
- * tls.el (open-tls-stream): In handshake-waiting loop,
- don't wait more if there is output available to process.
-
-2007-03-17 Thien-Thi Nguyen <ttn@gnu.org>
-
- * tls.el (tls-program): Doc fix.
-
-2007-03-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-generate-new-buffers): Change the meaning of the
- nil value; add `standard' to the choices; treat t as `unique'; improve
- doc string.
- (gnus-select-frame-set-input-focus): Autoload.
- (message-buffer-name): Search for the existing message buffer if
- message-generate-new-buffers is nil or `standard'; treat the value t of
- message-generate-new-buffers as `unique'.
- (message-pop-to-buffer): Raise the frame already displaying the message
- buffer; clear the echo area after querying.
- (message-setup): Pass the `continue' argument to compose-mail.
- (message-mail): Prefer `switch-function' if it is given; search for the
- existing message buffer if the `continue' argument is non-nil; pass
- continue and switch-function arguments to compose-mail by way of
- message-setup.
- (message-mail-other-window): Adjust argument of message-setup.
- (message-mail-other-frame): Ditto.
-
-2007-02-24 Chris Moore <dooglus@gmail.com>
-
- * pgg-pgp5.el (pgg-pgp5-encrypt-region):
- * pgg-pgp.el (pgg-pgp-encrypt-region):
- * pgg-gpg.el (pgg-gpg-encrypt-region):
- Check pgg-encrypt-for-me if no other recipients.
-
-2007-02-24 John Paul Wallington <jpw@pobox.com>
-
- * tls.el (tls-certtool-program): Fix custom type.
-
-2007-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-make-in-reply-to): Quote name containing
- non-ASCII characters. It will make the RFC2047 encoder cause an error
- if there are special characters. Reported by NAKAJI Hiroyuki
- <nakaji@jp.freebsd.org>.
-
-2007-02-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-never-echoes-commands)
- (nntp-open-connection-functions-never-echo-commands): New variables.
- (nntp-send-command): Use them.
-
-2007-02-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-google-parse-1): Fix date parsing to also match on
- articles posted in the last 24 hours.
-
-2007-02-14 Chong Yidong <cyd@stupidchicken.com>
-
- * smiley.el (smiley-regexp-alist): Add "dead" smiley.
-
-2007-02-01 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-google-parse-1): Update parser.
-
-2007-01-29 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-art.el (gnus-button-prefer-mid-or-mail): Fix typo in docstring.
-
-2007-01-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnslashdot.el (nnslashdot-request-article): Update end-of-article
- regexp.
-
-2007-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * uudecode.el (uudecode-string-to-multibyte): New function emulating
- string-to-multibyte.
- (uudecode-decode-region-internal): Use it.
-
- * lpath.el: Fbind string-as-multibyte for XEmacs.
-
-2007-01-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-score.el (gnus-home-score-file, gnus-home-adapt-file): Fix
- custom choice.
-
- * gnus-art.el (gnus-signature-limit): Fix custom choice.
-
-2007-01-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnsoup.el (nnsoup-directory, nnsoup-packer, nnsoup-packet-directory):
- Use gnus-home-directory instead of "~/" or "$HOME".
-
-2007-01-12 Kenichi Handa <handa@m17n.org>
-
- * uudecode.el (uudecode-decode-region-internal): Make it work in a
- multibyte buffer.
-
-2007-01-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-auto-select-first): Improve doc string.
-
-2007-01-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-soup.el: Add missing :group in previous change.
-
-2007-01-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-soup.el (gnus-soup): New custom group. Make user variables
- customizable.
-
-2007-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-gmane-create-mapping): Put back code to merge the
- headers read from disk with the ones newly found in the current search.
- This should no longer cause problems, because the article numbers in
- Gmane's `nov.php' output are ignored since the previous change.
-
-2006-01-03 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-gmane-create-mapping): Keep the mapping stable for
- solid groups.
-
-2006-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnweb.el (nnweb-gmane-create-mapping): Use the article number from
- the headers when creating the mapping to avoid mismappings.
- (nnweb-gmane-create-mapping): Always nix out old mapping.
-
-2007-01-02 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gmm-utils.el (gmm-tool-bar-style): Fix custom type.
-
-2007-01-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind cp-supported-codepages; bind url-version; fbind
- display-images-p and timer-set-function for XEmacs; bind timer-list for
- XEmacs; fbind find-face and set-itimer-function for Emacs; bind
- itimer-list for Emacs; bind coding-system-change-eol-conversion for
- XEmacs without the file-coding feature.
-
- * mm-decode.el (mm-display-external): Use itimer function for XEmacs.
-
-2006-12-30 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus-sum.el (gnus-summary-insert-dormant-articles): Fix typo in
- message.
-
-2006-12-29 Jouni K. Sepp\e,Ad\e(Bnen <jks@iki.fi>
-
- * nnimap.el (nnimap-expunge-search-string): Mention
- nnimap-search-uids-not-since-is-evil in docstring.
-
-2006-12-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam.el: Revert to make-obsolete-variable because
- define-obsolete-variable-alias is not supported in Emacs 21.
-
-2006-12-28 Daiki Ueno <ueno@unixuser.org>
-
- * gnus-sum.el (gnus-summary-next-article): Make sure we are in the
- summary buffer.
-
-2006-12-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam.el (spam-ifile-path, spam-ifile-database-path)
- (spam-bogofilter-path): Use define-obsolete-variable-alias instead of
- make-obsolete-variable.
-
-2006-12-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-make-fqdn): Fix comment.
- (message-bogus-system-names): Add ".local".
-
- * spam.el (spam-ifile-path, spam-ifile-program)
- (spam-ifile-database-path, spam-ifile-database)
- (spam-bogofilter-path, spam-bogofilter-program): Rename variables.
- Don't use "path" inappropriately.
- (spam-spamoracle-database, spam-get-ifile-database-parameter): Fix doc
- strings.
- (spam-check-ifile, spam-ifile-register-with-ifile)
- (spam-check-bogofilter, spam-bogofilter-register-with-bogofilter): Use
- new variable names.
-
- * gnus-art.el (gnus-treat-display-x-face, gnus-treat-display-face)
- (gnus-treat-display-smileys): Simplify using
- gnus-image-type-available-p.
-
- * gnus-ems.el (gnus-image-type-available-p): Use display-images-p if
- available.
-
- * gnus-xmas.el (gnus-xmas-image-type-available-p): Use
- `display-images-p' if available.
-
-2006-12-25 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-def.el (pgg-passphrase-coding-system): Default to nil instead of
- locale-coding-system.
- * pgg-gpg.el (pgg-gpg-process-region): Encode passphrase with eol-type
- LF.
-
-2006-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-fetch): Replace buffer's contents with the decoded
- one after turning on the buffer's multibyteness instead of decoding
- them directly in the unibyte buffer that causes unexpected conversion
- in Emacs 23 (unicode).
-
-2006-12-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-group-tool-bar-gnome): Exchange connect and
- disconnect icons. Add help text.
-
-2006-12-17 Chong Yidong <cyd@stupidchicken.com>
-
- * pgg-gpg.el (pgg-gpg-use-agent): Default to t.
-
-2006-12-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * legacy-gnus-agent.el: Add Copyright notice.
-
-2006-12-12 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-sum.el (gnus-make-thread-indent-array): Fix last change.
-
-2006-12-08 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-sum.el (gnus-make-thread-indent-array): New optional arg
- specifying array size.
- (gnus-summary-insert-line, gnus-summary-prepare-threads): Regrow indent
- array if it is too small.
- (gnus-sort-threads-recursive): Renamed from gnus-sort-thread-1.
- (gnus-sort-threads-loop): New function.
-
-2006-12-06 Chris Moore <dooglus@gmail.com>
-
- * gnus-sum.el (gnus-sort-threads, gnus-summary-limit-children):
- Use `max' to avoid the value of `max-lisp-eval-depth' decreasing.
-
-2006-12-04 Jouni K. Sepp\e,Ad\e(Bnen <jks@iki.fi>
-
- * mm-url.el (mm-url-predefined-programs): Call curl with correct
- options.
-
-2006-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml2015.el (mml2015-pgg-clear-verify): Replace encode-coding-string
- with mm-encode-coding-string.
-
-2006-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nneething.el (nneething-decode-file-name): Replace
- decode-coding-string with mm-decode-coding-string.
-
-2006-11-24 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * pgg-pgp.el (pgg-pgp-process-region): Change `args' from a list of
- strings to a single string. Quote `errors-file-name'.
- (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region, pgg-pgp-sign-region)
- (pgg-pgp-verify-region, pgg-pgp-insert-key, pgg-pgp-snarf-keys-region):
- Adjust calls. Use `shell-quote-argument'.
-
-2006-11-24 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-agent.el (gnus-agent-expire-unagentized-dirs)
- (gnus-agent-regenerate-group): Fix space/tab mixup in messages.
-
- * gnus-art.el (gnus-article-x-face-command, gnus-numeric-save-name):
- * gnus-group.el (gnus-group-sort-function, gnus-group-line-format)
- (gnus-group-mode, gnus-group-read-group, gnus-group-delete-group)
- (gnus-group-make-directory-group, gnus-group-transpose-groups):
- * gnus-start.el (gnus-options-subscribe, gnus-options-not-subscribe)
- (gnus-subscribe-newsgroup, gnus-1):
- * gnus-sum.el (gnus-summary-make-false-root, gnus-make-threads):
- * gnus.el (gnus-nntp-server, gnus-use-cross-reference)
- (gnus-valid-select-methods, total-expire, gnus-summary-line-format)
- (gnus-group-read-only-p): Fix space/tab mixup in docstrings.
-
-2006-11-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-string-to-multibyte): Alias to identity in XEmacs.
-
-2006-11-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * mm-uu.el (mm-uu-pgp-signed-extract-1): Make last fix more thorough
- and comment it.
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Update regexp.
-
-2006-11-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-extract-address-components): Improve comment.
-
-2006-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-extract-address-components): Work with address in
- which the name portion contains @.
-
- * lpath.el: Fbind custom-autoload.
-
-2006-11-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-start): Move custom group up.
- (gnus-select-method): Don't autoload, but make it available for
- `customize-variable'.
- (gnus-getenv-nntpserver): Don't autoload.
-
-2006-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-generate-mime-1): Use mm-string-as-unibyte instead of
- mm-with-unibyte-current-buffer to make string unibyte.
-
- * mm-decode.el (mm-insert-part): Use mm-string-to-multibyte instead of
- mm-string-as-multibyte.
-
-2006-11-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el: Merge from the trunk to fix the bug WRT double encoded
- subjects.
- (message-replacement-char): New variable.
- (message-fix-before-sending): Use it.
- (message-simplify-subject): New function to remove duplicate code.
- (message-reply, message-followup): Use it.
- (message-simplify-subject-functions): New variable.
- (message-strip-subject-encoded-words): New function.
-
-2006-11-08 Wolfgang Jenkner <wjenkner@inode.at> (tiny change)
-
- * gnus-sum.el (gnus-summary-catchup): Use gnus-sorted-intersection
- instead of gnus-intersection because arguments of gnus-sorted-nunion
- must be sorted. This avoids corruption of gnus-newsgroup-unreads.
-
-2006-11-03 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-diary.el (gnus-diary-delay-format-function):
- * nndiary.el (nndiary-reminders):
- * nnsoup.el (nnsoup-always-save): Use "non-nil" in docstrings.
-
-2006-11-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (article-hide-boring-headers): Fetch date from
- gnus-original-article-buffer to avoid problems with localized date
- strings.
-
-2006-10-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * html2text.el (html2text-format-tags): Avoid infloop on open tags.
-
-2006-10-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-util.el (mm-codepage-iso-8859-list, mm-codepage-ibm-list):
- New variables.
- (mm-setup-codepage-iso-8859, mm-setup-codepage-ibm): New functions.
- (mm-charset-synonym-alist): Move some entries to
- mm-codepage-iso-8859-list.
- (mm-charset-synonym-alist, mm-charset-override-alist): Add
- iso-8859-8/windows-1255 and iso-8859-9/windows-1254.
-
-2006-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-set-mode-line): Quote % in group name.
-
-2006-10-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-agent.el (gnus-agent-make-mode-line-string): Make it compatible
- with Emacs 21 and XEmacs.
-
-2006-10-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-view.el: Add interactive arg to html2text autoload.
-
-2006-10-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-move-article): Use no-encode for `B B'.
-
-2006-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-make-doc-group): Work for non-ASCII group
- names.
-
- * gnus-sum.el (gnus-select-newsgroup): Decode group name.
-
-2006-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-headers-to-generate): Fix typo in docstring.
-
-2006-10-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-mime): Remove unused custom group.
- (gnus-getenv-nntpserver, gnus-select-method): Autoload.
-
-2006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * mm-uu.el (mm-uu-pgp-signed-extract-1): Use RFC 2440 definition of
- "blank line" when searching for end of armor headers.
-
-2006-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gmm-utils.el (gmm-write-region): Fix variable name.
-
-2006-10-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gmm-utils.el (gmm-write-region): New function based on compatibility
- code from `mm-make-temp-file'.
-
- * mm-util.el (mm-make-temp-file): Use `gmm-write-region'.
-
- * nnmaildir.el (nnmaildir--update-nov)
- (nnmaildir-request-replace-article, nnmaildir-request-accept-article):
- Use `gmm-write-region'.
-
-2006-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Clarify
- gnus-summary-limit-to-articles.
-
-2006-10-04 Romain Francoise <romain@orebokech.com>
-
- * gnus-util.el (gnus-alist-to-hashtable, gnus-hashtable-to-alist):
- Moved here (and renamed) from gnus-registry.el.
-
- * gnus-registry.el: Require gnus-util.
- Use `gnus-alist-to-hashtable' and `gnus-hashtable-to-alist'.
-
-2006-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * pop3.el (pop3-authentication-scheme): Clarify doc.
- (pop3-movemail): Warn about pop3-leave-mail-on-server.
-
-2006-10-04 Dave Love <fx@gnu.org>
-
- * pop3.el (pop3-authentication-scheme): Add custom version.
-
-2006-10-04 Jesper Harder <harder@ifa.au.dk>
-
- * pop3.el (pop3-leave-mail-on-server): Don't quote nil in
- doc string. Improve doc string.
-
-2006-10-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-with-local-quit): New macro.
-
- * gnus-demon.el (gnus-demon): Replace with-local-quit with it.
-
-2006-09-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gmm-utils.el (gmm): Adjust custom version.
-
- * mm-util.el (mm-charset-override-alist, mm-charset-eval-alist): Adjust
- custom version.
-
- * gnus-draft.el (gnus-draft-mode): Don't call `mml-mode'.
-
-2006-09-25 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-demon.el (gnus-demon): Use with-local-quit to avoid hangs.
-
-2006-09-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnslashdot.el (nnslashdot-request-article): Update end-of-article
- regexp. Articles containing quotation were cut prematurely.
-
-2006-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-cite-original-without-signature): Use nobody by
- default for the value of From header.
- (message-cite-original): Ditto.
- (message-reply): Ditto.
-
-2006-09-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * pop3.el (pop3-leave-mail-on-server): Mention problem of duplicate
- mails in the doc string. Add some URLs in comment.
-
-2006-09-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings): Fix
- backslashes handling and the way to find boundaries of quoted strings.
-
-2006-09-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-regexp, gnus-button-marker-list)
- (gnus-button-last): Move up. Convert comments into doc strings.
-
-2006-09-06 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-process-region): Encode passphrase with
- pgg-passphrase-coding-system rather than locale-coding-system.
- * pgg-def.el (pgg-passphrase-coding-system): New user option.
-
-2006-09-05 Daiki Ueno <ueno@unixuser.org>
-
- * pgg.el (pgg-clear-string): Alias to clear-string for backward
- compatibility.
-
- * pgg-gpg.el (pgg-gpg-process-region): Avoid display blinking with
- inhibit-redisplay; encode passphrase with locale-coding-system.
-
-2006-09-04 Chong Yidong <cyd@stupidchicken.com>
-
- * message.el (message-send-mail-with-sendmail): Look for sendmail in
- several common directories.
-
-2006-09-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-decode-encoded-words): Make it fast.
-
-2006-09-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-decode-encoded-words): Don't infloop in XEmacs.
-
- * rfc2047.el (rfc2047-strip-backslashes-in-quoted-strings): Decode `\\'
- in quoted string into `\'.
-
-2006-09-04 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-process-region): Revert two patches from Satyaki
- Das. http://article.gmane.org/gmane.emacs.gnus.general/49947
- http://article.gmane.org/gmane.emacs.gnus.general/50457
-
-2006-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
- Use standard-syntax-table.
-
-2006-09-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-decode-address-function): New variable.
- (article-decode-encoded-words): Use it to decode headers which are
- assumed to contain addresses.
- (gnus-mime-delete-part): Remove useless `or'.
-
- * gnus-sum.el (gnus-decode-encoded-address-function): New variable.
- (gnus-summary-from-or-to-or-newsgroups): Use it to decode To header.
- (gnus-nov-parse-line): Use it to decode From header.
- (gnus-get-newsgroup-headers): Ditto.
- (gnus-summary-enter-digest-group): Use it to decode `to-address'.
-
- * mail-parse.el (mail-decode-encoded-address-region): New alias.
- (mail-decode-encoded-address-string): New alias.
-
- * rfc2047.el (rfc2047-quote-special-characters-in-quoted-strings):
- New function.
- (rfc2047-encode-message-header, rfc2047-encode-region): Use it.
- (rfc2047-strip-backslashes-in-quoted-strings): New fnction.
- (rfc2047-decode-region): Use it; add optional argument `address-mime'.
- (rfc2047-decode-string): Ditto.
- (rfc2047-decode-address-region): New function.
- (rfc2047-decode-address-string): New function.
-
-2006-08-23 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- [ Backported bug fix from No Gnus. ]
-
- * gnus.el (gnus-find-method-for-group): On killed/unknown groups, try
- looking up the method using GROUP's prefix before inventing a new one.
- It is used on killed/unknown groups in various places where returning
- an all-new method isn't expected by the caller.
-
- * gnus-util.el (gnus-group-server): Copy required macro from No Gnus.
-
-2006-08-13 Romain Francoise <romain@orebokech.com>
-
- * mm-extern.el (mm-extern-mail-server): End `y-or-n-p' prompt with a
- space.
-
-2006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * compface.el (uncompface): Use binary rather than raw-text-unix.
-
-2006-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * compface.el (uncompface): Make sure the eol conversion doesn't take
- place when communicating with the external programs. Reported by
- ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
-
-2006-07-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-insert-head): Fix typo in comment.
-
-2006-07-31 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
- Make it more robust by parsing author and date independently.
-
-2006-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-insert-head): Make it work with Mac as well.
-
-2006-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnheader.el (nnheader-insert-head): Make it work even if the file
- uses CRLF for the line-break code.
-
-2006-07-24 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-def.el (pgg-truncate-key-identifier): Truncate the key ID to 8
- letters from the end. Thanks to "David Smith" <davidsmith@acm.org> and
- andreas@altroot.de (Andreas V\e,Av\e(Bgele)
-
-2006-07-19 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * mm-url.el (mm-url-insert-file-contents): Inhibit Connection: close
- workaround for the url package included with Emacs.
-
- * nnweb.el (nnweb-google-create-mapping): Update regexp.
-
-2006-07-18 Karl Fogel <kfogel@red-bean.com>
-
- * nnmail.el (nnmail-article-group): If splitting raises an error, give
- some information about the error when saying that the `bogus' mail
- group will be used.
-
-2006-07-18 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- [ Backported bug fixes from No Gnus. ]
-
- * nnweb.el (nnweb-google-parse-1): Update regexp for author and date.
- (nnweb-google-search): Respect nnweb-max-hits as upper bound.
- (nnweb-request-article): Do proper xwfu encoding when fetching articles
- by message-id.
-
- * gnus-srvr.el (gnus-browse-unsubscribe-group): Don't subscribe
- unsubscribed groups as if they were killed ones. It causes duplicate
- entries in gnus-newsrc-alist.
-
-2006-07-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-delete-article): Don't use TAB in doc
- string.
-
-2006-07-16 NAKAJI Hiroyuki <nakaji@heimat.jp> (tiny change)
-
- * mm-util.el (mm-charset-synonym-alist): Map windows-31j to cp932.
-
-2006-07-14 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus-start.el (gnus-subscribe-options-newsgroup-method): Doc fix.
-
-2006-06-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-diary.el (gnus-user-format-function-d)
- (gnus-user-format-function-D): Autoload.
-
-2006-06-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-group.el (gnus-group-select-group): Doc fix.
- [ See 2004-05-19 change on the trunk. ]
-
-2006-06-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Allow `*'s in parameter values.
-
-2006-06-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-syntax-checks): Doc fix.
-
-2006-06-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-syntax-checks): Doc fix.
- (message-send-mail): Add check for continuation headers.
- (message-check-news-header-syntax): Fix regexp used to check for
- continuation headers.
-
-2006-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-display-mime): Make sure body ends with newline.
-
-2006-06-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-mime-mule-charset-alist): Use unicode-precedence-list
- to fill the utf-8 entry.
-
- * lpath.el: Fbind unicode-precedence-list.
-
-2006-06-05 Dan Christensen <jdc@uwo.ca>
-
- * gnus-sum.el (gnus-summary-read-group-1): When summary is unthreaded,
- respect display group parameter and gnus-summary-expunge-below.
- (gnus-articles-to-read): Remove unused reference to display group
- parameter.
- [ Merge 2004-07-06 change from the trunk. ]
-
-2006-05-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-ml.el (gnus-mailing-list-subscribe)
- (gnus-mailing-list-unsubscribe, gnus-mailing-list-owner)
- (gnus-mailing-list-message): Fix doc strings.
-
-2006-05-29 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus-ml.el (gnus-mailing-list-message): Use gnus-url-mailto instead
- of doing it manually.
-
-2006-05-29 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-possibly-synchronize-flags): A server
- must be explicitly online rather than "not explicitly offline" for
- its flags to be synchronized.
- (gnus-agent-read-local): All symbols allocated in my-obarray
- (gnus-agent-set-local): Skip invalid entries (min and/or max is nil).
- (gnus-agent-regenerate-group): Check numeric names to see if they are
- messages or groups.
-
-2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-save-all-headers): Mention it might be overridden.
- (gnus-saved-headers): Ditto.
- (gnus-default-article-saver): Doc fix; add
- gnus-summary-write-body-to-file; mention functions may have properties.
- (gnus-article-save-coding-system): New variable.
- (gnus-article-save): Override gnus-save-all-headers and
- gnus-saved-headers by :headers property which saver function may have.
- (gnus-read-save-file-name): Add optional `dir-var' argument which
- specifies directory in which files are saved; work even if optional
- `variable' argument is not specified.
- (gnus-summary-save-in-file): Add properties :decode and :headers.
- (gnus-summary-write-to-file): Add properties :decode, :function, and
- :headers; read file name.
- (gnus-summary-save-body-in-file): Add :decode property; add optional
- `overwrite' argument.
- (gnus-summary-write-body-to-file): New function; add properties
- :decode and :function.
- (gnus-output-to-file): Add coding cookie and encode text according
- to gnus-article-save-coding-system; don't use mm-append-to-file.
-
- * gnus-sum.el (gnus-newsgroup-last-directory): New variable.
- (gnus-summary-local-variables): Add it.
- (gnus-summary-save-map): Add gnus-summary-write-article-body-file.
- (gnus-summary-save-article): Require gnus-art; save decoded articles
- if function that gnus-default-article-saver specifies has `:decode'
- property; bind gnus-prompt-before-saving to t when saving many
- articles in a file; move point to article which will be saved.
- (gnus-summary-write-article-body-file): New function.
-
- * lpath.el: Fbind select-safe-coding-system for XEmacs.
-
-2006-05-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * uudecode.el (uudecode-decode-region-external): Fix previous commit.
-
-2006-05-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Don't edit
- after-load-alist.
-
-2006-05-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * uudecode.el (uudecode-decode-region-external): nil isn't a valid
- coding system in XEmacs, use binary.
-
- * mail-source.el (mail-sources): Fix custom type.
-
- * imap.el (Commentary): Fix typo.
-
-2006-05-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-save-article-mail): Clarify doc string.
- (gnus-summary-expire-articles-now): Shorten prompt.
-
- * gmm-utils.el (wid-edit): Require.
- (defun-gmm): Renamed from `gmm-defun-compat'.
- (gmm-image-search-load-path): Use it.
- (gmm-image-load-path-for-library): Use it. Sync with `mh-compat.el'.
-
-2006-05-04 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mm-decode.el (mm-dissect-buffer): Remove spurious double assignment.
- (mm-copy-to-buffer): Use with-current-buffer.
- (mm-display-part): Simplify.
- (mm-inlinable-p): Add optional arg `type'.
-
- * gnus-art.el (gnus-mime-view-part-as-type): Add optional PRED arg.
- (gnus-mime-view-part-externally, gnus-mime-view-part-internally):
- Try harder to show the attachment internally or externally using
- gnus-mime-view-part-as-type.
-
-2006-05-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-mime-view-part-as-type-internal): Try to fetch
- `filename' from Content-Disposition if Content-Type doesn't
- provide `name'.
- (gnus-mime-view-part-as-type): Set default instead of initial-input.
-
-2006-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-pgp-encrypted-extract-1): Assume buffer is made
- unibyte after clear-decrypt function runs.
-
- * mml2015.el (mml2015-pgg-clear-decrypt): Treat data which pgg
- returns as a unibyte string.
-
-2006-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Don't fbind string-as-multibyte for XEmacs.
-
- * pgg-gpg.el (pgg-string-to-multibyte): Remove.
- (pgg-gpg-process-region): Revert.
-
- * pgg-pgp.el (pgg-pgp-process-region): Revert.
- (pgg-pgp-lookup-key): Revert.
-
- * pgg-pgp5.el (pgg-pgp5-process-region): Revert.
- (pgg-pgp5-lookup-key): Revert.
-
- * pgg.el (pgg-fetch-key): Revert.
-
-2006-04-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Fbind make-network-process for both Emacs and XEmacs;
- fbind string-as-multibyte for XEmacs.
-
- * mml1991.el (mml1991-pgg-sign): No need to load pgg.el, which is
- always loaded by way of gnus-art.el -> mm-uu.el -> mml2015.el.
- (mml1991-pgg-encrypt): Ditto.
-
- * pgg-gpg.el (pgg-string-to-multibyte): New function.
- (pgg-gpg-process-region): Make sure pgg-output-buffer is always
- a multibyte buffer.
-
- * pgg-pgp.el (pgg-pgp-process-region): Ditto.
- (pgg-pgp-lookup-key): Ditto.
-
- * pgg-pgp5.el (pgg-pgp5-process-region): Ditto.
- (pgg-pgp5-lookup-key): Ditto.
-
- * pgg.el (pgg-fetch-key): Ditto.
-
-2006-04-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * deuglify.el (gnus-outlook-deuglify-unwrap-min)
- (gnus-outlook-deuglify-unwrap-max): Remove autoload.
-
- * mml-sec.el (mml-secure-method): New internal variable.
- (mml-secure-sign, mml-secure-encrypt, mml-secure-message-sign)
- (mml-secure-message-sign-encrypt, mml-secure-message-encrypt):
- New functions using mml-secure-method. Sync from the trunk.
-
- * mml.el (mml-mode-map): Add key bindings for those functions.
- (mml-menu): Simplify security menu entries. Suggested by Jesper
- Harder <harder@myrealbox.com>. Sync from the trunk.
-
- * message.el (message-valid-fqdn-regexp): Add TLDs .cat, jobs,
- .mobi and .travel. Remove .nato, .bitnet and .uucp.
- (message-in-body-p): New function. Sync from the trunk.
-
- * mml.el (mml-mode, mml-dnd-protocol-alist)
- (mml-dnd-attach-options, mml-dnd-attach-file)
- (mml-attach-file, mml-attach-buffer, mml-attach-external):
- Sync DND support and use of message-in-body-p from the trunk.
-
-2006-04-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml1991.el (mml1991-pgg-sign): Make sure to load pgg.el before
- binding pgg-* variables; reimplement the section which prevents
- MIME header from being signed.
- (mml1991-pgg-encrypt): Make sure to load pgg.el before binding
- pgg-text-mode; remove a blank line at the top of body.
-
- * mm-uu.el (mm-uu-pgp-encrypted-extract-1): Don't remove blank
- lines at the top of body; use gnus-newsgroup-charset if there's no
- Charset header.
-
-2006-04-25 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-google-wash-article): Sync up to new Google HTML.
-
-2006-04-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-pgp-signed-test): Erase prompt.
- (mm-uu-pgp-encrypted-test): Ditto.
- (mm-uu-pgp-encrypted-extract-1): Make sure there's a blank line
- between header and body; return application/pgp-encrypted handle
- if decryption failed; decode decrypted body by charset.
-
- * mm-decode.el (mm-automatic-display): Don't make application/pgp
- element match to application/pgp-*.
-
-2006-04-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-replace-in-string):
- Prefer replace-regexp-in-string over of replace-in-string.
-
-2006-04-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el: Bind tool-bar-mode instead of tool-bar-map.
-
- * gnus-sum.el: Ditto.
-
- * gnus-util.el (gnus-select-frame-set-input-focus):
- Use select-frame-set-input-focus if it is available in XEmacs; use
- definition defined in Emacs 22 for old Emacsen.
-
- * dgnushack.el: Autoload customize-group for XEmacs.
-
- * lpath.el: Bind codepage-setup, cursor-in-non-selected-windows
- and select-frame-set-input-focus for XEmacs.
-
-2006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- [ Merge from Gnus trunk. ]
-
- * mm-util.el (mm-charset-synonym-alist): Improve doc string.
- (mm-charset-override-alist): New variable.
- (mm-charset-to-coding-system): Use it.
- (mm-codepage-setup): New helper function.
- (mm-charset-eval-alist): New variable.
- (mm-charset-to-coding-system): Use mm-charset-eval-alist.
- Warn about unknown charsets. Add allow-override.
- Use `mm-charset-override-alist' only when decoding.
- (mm-detect-mime-charset-region): Use :mime-charset.
-
- * mm-bodies.el (mm-decode-body, mm-decode-string):
- Call `mm-charset-to-coding-system' with allow-override argument.
-
- * message.el (message-tool-bar-zap-list, message-tool-bar)
- (message-tool-bar-gnome, message-tool-bar-retro): New variables.
- (message-tool-bar-local-item-from-menu): Remove.
- (message-tool-bar-map): Replace by `message-make-tool-bar'.
- (message-make-tool-bar): New function.
- (message-mode): Use `message-make-tool-bar'.
-
- * gnus-sum.el (gnus-summary-tool-bar)
- (gnus-summary-tool-bar-gnome, gnus-summary-tool-bar-retro)
- (gnus-summary-tool-bar-zap-list): New variables.
- (gnus-summary-make-tool-bar): Complete rewrite using
- `gmm-tool-bar-from-list'.
-
- * gnus-group.el (gnus-group-tool-bar, gnus-group-tool-bar-gnome)
- (gnus-group-tool-bar-retro, gnus-group-tool-bar-zap-list):
- New variables.
- (gnus-group-make-tool-bar): Complete rewrite using
- `gmm-tool-bar-from-list'.
- (gnus-group-tool-bar-update): New function.
-
- * gmm-utils.el: New file.
-
-2006-04-12 Ralf Angeli <angeli@iwi.uni-sb.de>
-
- * flow-fill.el (fill-flowed): Remove trailing space from blank
- quoted lines.
-
-2006-04-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-article-mode):
- Set cursor-in-non-selected-windows to nil.
-
-2006-04-12 Kenichi Handa <handa@m17n.org>
-
- * rfc2231.el (rfc2231-decode-encoded-string): Work on unibyte
- buffer and then decode the buffer text if necessary.
- (rfc2231-encode-string): Be sure to work on multibyte buffer at
- first, and after mm-encode-body, change the buffer to unibyte.
- Use mm-disable-multibyte instead of set-buffer-multibyte.
-
-2006-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-view-part-as-charset): Ignore charset
- that the part specifies.
-
- * mm-decode.el (mm-display-part): Work with external parts and
- usual parts similarly.
-
- * mm-extern.el (mm-inline-external-body): Use mm-display-part
- instead of gnus-display-mime.
-
- * gnus-uu.el (gnus-uu-save-article): Put mml tags instead of part
- tag to summarized topics part in order to encode non-ASCII text.
-
-2006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-valid-localpart-regexp): Exclude `@'.
-
-2006-04-11 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * gnus-sieve.el (gnus-sieve-generate): Delete from the start of
- the sieve region.
-
-2006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el: Gnus v5.10.8 is released.
-
-2006-04-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-retrieve-headers-1): Fix up to new layout.
-
- * rfc2047.el (rfc2047-decode-encoded-words): Don't message about
- unknown charset.
-
- * message.el (message-header-synonyms): Add Original-To to the default.
-
- * gnus-sum.el (gnus-get-newsgroup-headers-xover): Group is an
- optional parameter.
-
-2006-04-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * pgg-gpg.el: Revert to revision 7.15 to allow the use of gpg-agent.
-
-2006-04-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-fun.el (gnus): Require it for gnus-directory.
-
- * pgg-gpg.el: Revert to revision 7.11 because of unresolved
- problems caused by adding symmetric encryption support and the
- asynchronous gpg call.
-
-2006-04-05 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region, pgg-gpg-sign-region): Wait
- for BEGIN_SIGNING too, new in GnuPG 1.4.3.
-
-2006-03-29 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-start-process): Don't bind
- default-enable-multibyte-characters. This reverts the change from
- revision 6.17 which is no longer necessary because the passphrase
- is sent separately now. GnuPG messages are unreadable under
- multibyte locales with default-enable-multibyte-characters set to
- nil.
-
-2006-04-04 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-google-create-mapping): Update regexp.
- Some whitespace was matched into the url, which broke browsing hits
- > 100 when mm-url-use-external was nil.
-
-2006-04-04 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el: Clean up process buffers every time gpg processes
- complete.
-
-2006-04-03 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-process-filter)
- (pgg-gpg-wait-for-completion): Check if buffer is alive.
-
- * pgg-gpg.el (pgg-gpg-process-sentinel): Don't remove GNUPG:
- lines, temporary fix.
-
-2006-03-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-group-update-tool-bar): Add :initialize and :set.
-
-2006-03-27 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el: Invoke gpg asynchronous, to avoid querying for
- passphrases when it is not needed.
- (pgg-gpg-use-agent): Add, to hard code that pgg shouldn't wait for
- passphrase stuff from gpg, should only be necessary when you use
- gpg with a smartcard.
-
-2006-03-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-insert-mime): Ignore cached contents of
- message/external-body part.
-
- * mm-decode.el (mm-get-part): Add optional 'no-cache' argument.
- (mm-insert-part): Ditto.
-
-2006-03-23 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-update-agent): Add again, with fixes from
- Reiner.
- (pgg-gpg-use-agent-p): Use it again.
-
-2006-03-23 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-update-agent): Remove, doesn't work with
- older emacsen.
- (pgg-gpg-use-agent-p): Don't use it.
-
-2006-03-22 Sascha Wilde <wilde@sha-bang.de>
-
- * pgg-gpg.el (pgg-gpg-use-agent): Disable by default.
- (pgg-gpg-update-agent): New function.
- (pgg-gpg-use-agent-p): New function.
- (pgg-gpg-process-region, pgg-gpg-encrypt-region)
- (pgg-gpg-encrypt-symmetric-region, pgg-gpg-decrypt-region)
- (pgg-gpg-sign-region): Use it.
-
-2006-03-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-map-articles): Don't funcall symbol macro.
- Reported by Ralf Wachinger <rwachinger@gmx.de>.
-
-2006-03-21 Daniel Pittman <daniel@rimspace.net>
-
- * nnimap.el (nnimap-request-update-info-internal): Optimize.
- Don't `gnus-uncompress-range' to avoid excessive memory usage.
-
-2006-03-21 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el: Ideas below based on patch from Sascha Wilde
- <wilde@sha-bang.de>.
- (pgg-gpg-use-agent): New variable.
- (pgg-gpg-process-region): Use it.
- (pgg-gpg-encrypt-region): Likewise.
- (pgg-gpg-encrypt-symmetric-region): Likewise.
- (pgg-gpg-decrypt-region): Likewise.
- (pgg-gpg-sign-region): Likewise.
- (pgg-gpg-possibly-cache-passphrase): Don't cache a nil password.
-
-2006-03-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-agent.el (gnus-agent-queue-mail): Fix custom tag for `t'.
-
- * spam.el (spam-mark-new-messages-in-spam-group-as-spam):
- Add comment on version.
-
-2006-03-20 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam.el (spam-mark-new-messages-in-spam-group-as-spam): New variable.
- (spam-mark-junk-as-spam-routine): Use it. Allow to disable
- assigning the spam-mark to new messages.
-
-2006-03-20 Adam Sj
\e,Ax
\e(Bgren <asjo@koldfront.dk>
-
- (spam-ham-copy-or-move-routine): Don't declare `todo' twice.
-
-2006-03-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * smiley.el: Add missing test smiley.
-
-2006-03-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-with-part): New macro.
- (mm-get-part): Use it; work with message/external-body as well.
- (mm-save-part): Treat name and filename equally.
-
- * mm-extern.el (mm-extern-cache-contents): New function.
- (mm-inline-external-body): Use it; force the part to be displayed;
- move undisplayer added to the cached handle to the parent.
-
- * gnus-art.el (gnus-mime-save-part-and-strip): Add name parameter.
- (gnus-mime-view-part-as-type): Work with message/external-body.
-
- * gnus-util.el (gnus-tool-bar-update): Bind tool-bar-mode.
-
-2006-03-15 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus-art.el (gnus-article-only-boring-p):
- Bind inhibit-point-motion-hooks to avoid infinite loop when entering
- intangible text.
- Reported by Ralf Wachinger <rwnewsmampfer@geekmail.de>.
-
-2006-03-14 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-unique-id): Don't use message-number-base36
- if (user-uid) is a float.
- Reported by Bjorn Solberg <bjorn_ding1@hekneby.org>.
-
-2006-03-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-dissect): Dissect all parts correctly.
-
- * gnus-art.el (gnus-mime-display-single): Make sure there is an
- empty line between a part and a message part.
-
-2006-03-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * smiley.el: Add more test smileys.
- (smiley-data-directory, smiley-regexp-alist)
- (gnus-smiley-file-types): Fix doc strings.
- (smiley-update-cache): Clear smiley-cached-regexp-alist before
- adding new elements.
- (smiley-mouse-map): Unused code. Make it a comment.
-
-2006-03-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-nocem.el (gnus-nocem-scan-groups): Add autoload cookie;
- scan latest NoCeM messages instead of old ones.
- (gnus-nocem-check-article): Fix regexps so as to match to PGP
- delimiters that are recently used.
- (gnus-nocem-load-cache): Add autoload cookie.
-
- * gnus.el (gnus-use-nocem): Enable it to be set to also a number.
-
- * gnus-start.el (gnus-setup-news): Scan NoCeM messages if a group
- level which is larger than gnus-use-nocem is specified.
-
- * gnus-group.el (gnus-group-get-new-news): Ditto.
-
-2006-03-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-tool-bar-update): New function.
-
- * gnus-group.el (gnus-group-update-tool-bar): New variable.
- (gnus-group-insert-group-line): Add gnus-tool-bar-update.
-
- * gnus-topic.el (gnus-topic-prepare-topic): Add gnus-tool-bar-update.
-
-2006-03-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-split-it): Invert match-partial-words behavior
- if optional last element is specified in splits (FIELD VALUE...).
-
-2006-03-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-w3m-cid-retrieve-1): Check carefully whether
- handle is multipart when calling it recursively.
- (mm-w3m-cid-retrieve): Display warning if retrieving fails.
-
-2006-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Change "Emacs 23"
- to "Emacs 23 (unicode)" in doc string.
-
- * gnus-sum.el (gnus-summary-set-display-table): Change "Emacs 23" to
- "Emacs 23 (unicode)" in comment.
-
-2006-03-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-get-part): Don't use mm-with-unibyte-current-buffer.
-
- * gnus-sum.el (gnus-summary-set-display-table): Don't nix out
- characters 160 through 255 in Emacs 23.
-
-2006-03-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-generate-mime-1): Encode parts other than text/* or
- message/* containing non-ASCII text properly.
-
-2006-02-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-with-unibyte-current-buffer): Add note.
-
-2006-02-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-gmane-create-mapping): Don't choke on ^M.
-
-2006-02-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnweb.el (nnweb-type-definition, nnweb-gmane-search):
- Use new nov.php.
-
-2006-02-28 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-type-definition, nnweb-gmane-create-mapping)
- (nnweb-gmane-wash-article, nnweb-gmane-search): Fix Gmane web
- groups. Kudos to Olly Betts <olly@survex.com> for providing NOV
- output on the server side.
- (nnweb-google-create-mapping): Update regexps and add some
- progress indication.
-
-2006-02-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-user-fqdn): Remove useless * in doc string.
-
- * gnus-draft.el (gnus-draft-send): Bind message-signature to avoid
- unnecessary interaction when sending queued mails. Reported by
- TAKAHASHI Yoshio <tkh@jp.fujitsu.com>.
-
-2006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-int.el (gnus-open-server): Respect gnus-batch-mode.
- Merge of 2006-02-20 change from the trunk.
-
-2006-02-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dns.el (query-dns): Protect more against buggy tcp output.
- Merge of 2006-02-20 change from the trunk.
-
-2006-02-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-sequence-of-unread-articles): Return nil if
- first or last are nil.
-
-2006-02-24 Simon Josefsson <jas@extundo.com>
-
- * flow-fill.el (fill-flowed): Flow-fill unquoted lines too.
- Merge of 2005-10-26 change from the trunk.
-
-2006-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * flow-fill.el (fill-flowed): Bind adaptive-fill-mode to nil.
- Remove space stuffing, and only do quotes that actually start with
- ">" at the beginning of the lines.
- Merge of 2005-11-17 and 2004-07-25 from the trunk.
-
-2006-02-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * utf7.el (utf7-utf-16-coding-system): Fix comment. utf-16-be is
- also available in Emacs 21.3.
-
- * message.el (message-fix-before-sending): Change "Emacs 22" to
- "Emacs 23 (unicode)" in comment.
-
- * qp.el (quoted-printable-encode-region): Change "Emacs 22" to
- "Emacs 23 (unicode)" in comment.
-
- * mm-util.el: Change "Emacs 22" to "Emacs 23 (unicode)" in
- comment.
- (mm-coding-system-p): Add comment about no-MULE XEmacs.
-
- * mm-view.el (mm-fill-flowed): Add :version.
-
-2006-02-23 Ralf Angeli <angeli@iwi.uni-sb.de>
-
- * mm-view.el (mm-fill-flowed): New variable.
- (mm-inline-text): Use it.
-
-2006-02-21 Wolfram Fenske <wolfram.fenske@student.uni-magdeburg.de> (tiny change)
-
- * nnimap.el (nnimap-request-move-article): Change folder back to
- source group before deleting.
-
-2006-02-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-charset-to-coding-system): Don't check the
- coding system which mm-charset-to-coding-system returns for a
- given charset is valid.
-
-2006-02-16 Juanma Barranquero <lekktu@gmail.com>
-
- * html2text.el (html2text-remove-tag-list):
- * spam-stat.el (spam-stat-buffer-words): Fix typo in docstring.
-
-2006-02-14 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-cus.el: Revert 2005-10-17 change.
-
-2006-02-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-strip-banner): Call
- article-really-strip-banner only when the regexp match is made.
-
-2006-02-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-strip-banner): Use
- gnus-extract-address-components instead of
- mail-header-parse-addresses to make it work with non-ASCII text.
-
- * rfc2231.el (rfc2231-parse-string): Attempt to parse parameter
- values which are surrounded with \"...\"; make it never cause a
- Lisp error; give up parsing of parameters if it failed in
- extracting type.
-
-2006-02-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-make-temp-file): Import the Emacs 22 version of
- make-temp-file; make it work with Emacs 20 and XEmacs as well.
-
- * mm-decode.el (mm-display-external): Use the 3rd arg of
- mm-make-temp-file.
- (mm-create-image-xemacs): Ditto.
-
-2006-02-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-draft.el (gnus-draft-send): Replace message-narrow-to-head
- with message-narrow-to-headers.
- (gnus-draft-setup): Narrow to header to run message-fetch-field.
- (gnus-draft-check-draft-articles): New function.
- (gnus-draft-edit-message, gnus-draft-send-message): Use it.
-
-2006-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnoo.el (nnoo-declare): Don't generate duplicate entries when
- re-loading nn* modules.
-
-2006-02-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el: Remove bogus comment.
-
-2006-02-09 Daiki Ueno <ueno@unixuser.org>
-
- * pgg-gpg.el (pgg-gpg-encrypt-region): Don't convert line-endings
- in elisp.
- (pgg-gpg-encrypt-symmetric-region): Ditto.
- (pgg-gpg-sign-region): Ditto.
-
- * pgg-def.el (pgg-text-mode): New variable.
-
- * mml2015.el (mml2015-pgg-sign): Enable pgg-text-mode.
- (mml2015-pgg-encrypt): Ditto.
-
- * mml1991.el (mml1991-pgg-sign): Enable pgg-text-mode.
- (mml1991-pgg-encrypt): Ditto.
-
-2006-02-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnfolder.el (nnfolder-insert-newsgroup-line): Use
- message-make-date instead of current-time-string.
-
- * mm-view.el (mm-inline-message): Don't set gnus-newsgroup-charset
- to gnus-decoded which mm-uu might set.
-
-2006-02-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Sort segmented parameters;
- don't decode quoted parameters; remove misimported Emacs code.
- Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
- (rfc2231-decode-encoded-string): Don't use split-string which
- behaves differently according to Emacs version; use
- mm-decode-coding-region to convert charset to coding-system.
- Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
- (rfc2231-encode-string): Remove misimported Emacs code.
-
-2006-02-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-decode-charset): Don't use ignore-errors
- when calling mail-header-parse-content-type.
- (article-de-quoted-unreadable): Ditto.
- (article-de-base64-unreadable): Ditto.
- (article-wash-html): Ditto.
-
- * mm-decode.el (mm-dissect-buffer): Don't use ignore-errors when
- calling mail-header-parse-content-type and
- mail-header-parse-content-disposition.
- (mm-find-raw-part-by-type): Don't use ignore-errors when calling
- mail-header-parse-content-type.
-
- * mml.el (mml-insert-mime-headers): Use mml-insert-parameter to
- insert charset and format parameters; encode description after
- inserting it to buffer.
- (mml-insert-parameter): Fold lines properly even if a parameter is
- segmented into two or more lines; change the max column to 76.
-
- * rfc1843.el (rfc1843-decode-article-body): Don't use
- ignore-errors when calling mail-header-parse-content-type.
-
- * rfc2231.el (rfc2231-parse-string): Return at least type if
- possible; don't cause an error even if it fails in parsing of
- parameters. Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
- (rfc2231-encode-string): Don't break lines at the beginning, leave
- it to mml-insert-parameter.
-
- * webmail.el (webmail-yahoo-article): Don't use ignore-errors when
- calling mail-header-parse-content-type.
-
-2006-02-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam-report.el (spam-report-gmane-use-article-number):
- Improve doc string.
- (spam-report-gmane-internal): Check if a suitable header was found
- in the article.
-
-2006-02-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Revert 2006-02-03 change.
- (rfc2231-encode-string): Make param*=value always begin with LWSP.
-
-2006-02-05 Romain Francoise <romain@orebokech.com>
-
- Update copyright notices of all files in the gnus directory.
-
-2006-02-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-error): Describe `args'.
-
-2006-02-03 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-request-group): Avoid growing overview files.
-
-2006-02-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Add missing semicolons to
- segmented lines of parameter value to cope with Thunderbird 1.5
- bug (cf. https://bugzilla.mozilla.org/show_bug.cgi?id=323318).
- Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
- (rfc2231-encode-string): Don't make lines exceeding 76 column.
-
-2006-02-01 Max Froumentin <max@lapin-bleu.net> (tiny change)
-
- * mml.el (mml-generate-mime-1): Correct the order of inline signed
- parts.
-
-2006-01-31 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-group-alist): Use defvar instead of defvoo,
- there's only one active file for all servers.
- (nnweb-request-scan): Make sure nnweb-articles is initialized on
- solid groups. Gnus might have used a FAST request to select the group.
- (nnweb-request-group, nnweb-google-parse-1): Don't keep nnweb-type
- and nnweb-search redundantly in the active file.
- (nnweb-request-list): Don't list bogus groups. There can only be one.
- (nnweb-request-create-group): Don't use ARGS.
- (nnweb-possibly-change-server, nnweb-request-group): Remove some
- initialisations. Let nnoo do the work.
-
-2006-01-31 Romain Francoise <romain@orebokech.com>
-
- * message.el (message-alternative-emails): Improve docstring.
- (message-setup-1): Call `message-use-alternative-email-as-from'
- after `message-setup-hook' to give it precedence over posting
- styles, etc.
- (message-use-alternative-email-as-from): Add docstring.
- Remove the original From header if present.
-
-2006-01-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-emacs-sources-extract, mm-uu-diff-extract):
- Say the part has been decoded.
-
-2006-01-31 Kevin Ryde <user42@zip.com.au>
-
- * mailcap.el (mailcap-viewer-passes-test): Don't put "(nil t)" into
- mailcap-viewer-test-cache when there's no 'test clause, since that
- will invert the meaning of a "nil" test previously determined by
- mailcap-mailcap-entry-passes-test.
-
-2006-01-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnweb.el (nnweb-google-parse-1): Clarify some comments.
-
-2006-01-30 Andreas Seltenreich <uwi7@stud.uni-karlsruhe.de>
-
- * nnweb.el (nnweb-type-definition, nnweb-google-parse-1)
- (nnweb-google-create-mapping, nnweb-google-search): Adapt to
- current Google Groups.
-
-2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (clean): New rule.
- (distclean): Use it.
-
-2006-01-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-dissect-text-parts): Ignore it if a given part
- is dissected into a single part of which the type is the same as
- the given one; decode charset.
-
-2006-01-21 Kevin Ryde <user42@zip.com.au>
-
- * mailcap.el (mailcap-parse-mailcap-extras): "test" key must go
- into alists as symbol not string, since that's what
- mailcap-viewer-passes-test and mailcap-mailcap-entry-passes-test
- look for.
-
-2006-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-dissect-text-parts): Reduce the number of
- recursive calls.
-
-2006-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-w3m-standalone-supports-m17n-p): New variable.
- (mm-w3m-standalone-supports-m17n-p): New function.
- (mm-inline-text-html-render-with-w3m-standalone): Use it to alter
- w3m usage.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m-standalone): Use
- mm-w3m-standalone-supports-m17n-p to alter w3m usage.
-
-2006-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-dissect-text-parts): Decode content transfer
- encoding.
-
-2006-01-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mml.el (mml-attach-file): Describe `description' in doc string.
- (mml-menu): Add Emacs MIME manual and PGG manual.
-
-2006-01-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
- (spam-group-spam-marks, spam-list-articles, spam-group-ham-marks):
- Revert 2006-01-08 change because the functions will be used in No
- Gnus.
-
-2006-01-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-bodies.el (mm-decode-body): Don't decode decoded body.
-
- * mm-uu.el (mm-uu-dissect-text-parts): Dissect dissected parts.
-
-2006-01-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-inlined-types): Add application/pgp.
- (mm-automatic-display): Ditto.
-
- * mm-uu.el (mm-uu-dissect-text-parts): Recognize application/pgp
- part as text.
-
-2006-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el: Update copyright.
- (nnrss-opml-import): Query whether to subscribe to each entry.
-
- * gnus-art.el:
- * gnus-cus.el:
- * gnus-group.el:
- * gnus-start.el:
- * gnus-sum.el:
- * gnus-xmas.el:
- * messagexmas.el:
- * mm-uu.el:
- * mm-view.el: Update copyright.
-
-2006-01-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-info): New function.
- (message-mode-menu): Add it.
- Update copyright.
-
- * ChangeLog: Fix and update copyright.
-
-2006-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-uu.el (mm-uu-text-plain-type): New variable.
- (mm-uu-pgp-signed-extract-1): Use it.
- (mm-uu-pgp-encrypted-extract-1): Use it.
- (mm-uu-dissect): Use it; allow two optional arguments; one is a
- flag specifying whether there's no message header; the other is
- for a MIME type and parameters; bind mm-uu-text-plain-type with
- the later one.
- (mm-uu-dissect-text-parts): New function.
-
- * gnus-art.el (gnus-display-mime): Use mm-uu-dissect-text-parts to
- dissect text parts.
-
-2006-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-wash-html): Use
- gnus-summary-show-article-charset-alist if a numeric arg is given.
- (gnus-article-wash-html-with-w3m-standalone): New function.
-
- * mm-view.el (mm-text-html-renderer-alist): Map w3m-standalone to
- mm-inline-text-html-render-with-w3m-standalone.
- (mm-text-html-washer-alist): Map w3m-standalone to
- gnus-article-wash-html-with-w3m-standalone.
- (mm-inline-text-html-render-with-w3m-standalone): New function.
-
-2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-wash-html-in-text-plain-parts): New variable.
- (nnrss-request-article): Render text/plain parts as HTML.
-
- * gnus-art.el (gnus-article-wash-html-with-w3m): No need to narrow
- the buffer.
-
-2006-01-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-cus.el (gnus-group-parameters): Sync posting-style with
- custom definition of `gnus-posting-styles'.
-
- * gnus-start.el (gnus-gnus-to-quick-newsrc-format): Bind
- print-circle. Suggested by Kalle Olavi Niemitalo <kon@iki.fi>.
-
-2006-01-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-useful-groups): Use Gmane for ding.
- Use nntp for bug archive.
-
-2006-01-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-request-article): Fix the way to fill text/plain
- parts.
- (nnrss-normalize-date): New function converts ISO 8601 date into
- RFC822 style. Suggested by Mark Plaksin <happy@mcplaksin.org>.
- (nnrss-check-group): Use it.
-
-2006-01-03 Rodrigo Ventura <yoda@isr.ist.utl.pt> (tiny change)
-
- * gnus-xmas.el (gnus-xmas-group-startup-message): Typo
- gnus-splash-face -> gnus-splash. Fixes starting from a TTY in
- XEmacs.
-
-2006-01-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-work-articles): Remove useless `min'.
-
- * nnrss.el (nnrss-fetch): Make it fail gracefully when it can't
- fetch a feed. Suggested by Mark Plaksin <happy@mcplaksin.org>.
- (nnrss-insert-w3): Ditto.
-
-2005-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-request-article): Fix last change; fill
- text/plain parts.
-
-2005-12-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-request-article): Replace <br />s with newlines
- in text/plain part.
- (nnrss-check-group): Don't add excessive newline to dc:subject.
-
-2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-delete-text-of-type): Enable it to
- remove MIME buttons associated with multipart/alternative parts.
- (gnus-mime-display-alternative): Tag buttons using `article-type'
- text property.
-
- * gnus-msg.el (gnus-copy-article-buffer): Remove MIME buttons
- associated with multipart/alternative parts.
-
-2005-12-19 Mark Plaksin <happy@mcplaksin.org> (tiny change)
-
- * nnrss.el (nnrss-check-group): Put the RSS dc:subject in the
- article.
-
-2005-12-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dns.el (query-dns): Make sure we check the buffer size before
- removing tcp headers.
-
-2006-01-08 Chong Yidong <cyd@stupidchicken.com>
-
- * spam.el (spam-group-ham-mark-p, spam-group-spam-mark-p)
- (spam-group-spam-marks): Delete functions.
- (spam-list-articles): Just call spam-group-ham-marks directly.
- (spam-group-ham-marks): Simplify.
-
-2005-12-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-signature-separator): Fix custom type.
-
- * mm-decode.el (mm-inlined-types): Fix custom type.
- (mm-keep-viewer-alive-types): Ditto.
- (mm-automatic-display): Ditto.
- (mm-attachment-override-types): Ditto.
- (mm-inline-override-types): Ditto.
- (mm-automatic-external-display): Ditto.
-
-2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-buttonized-mime-types): Mention addition of
- multipart/alternative and add xref to mm-discouraged-alternatives
- in doc string.
-
- * mm-decode.el (mm-discouraged-alternatives): Add xref to
- gnus-buttonized-mime-types in doc string.
-
-2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-charset-to-coding-system): Recognize
- us-ascii as a MIME charset.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding): Protect
- against the case where the 2nd arg TYPE is nil.
-
-2005-12-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-start.el (gnus-no-server-1): Mention
- `gnus-level-default-subscribed' in doc string.
-
-2005-11-26 Dave Love <fx@gnu.org>
-
- * tls.el (open-tls-stream): Rename arg SERVICE to PORT.
- (tls-program, tls-success): Provide openssl alternative.
-
- * starttls.el: Doc fixes.
- (starttls-open-stream-gnutls, starttls-open-stream): Rename arg
- SERVICE to PORT.
-
-2005-12-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-start.el (gnus-start-draft-setup): Enforce
- `gnus-draft-mode' for nndraft:drafts at startup.
-
- * gnus.el (gnus-splash): Change custom group.
- (gnus-group-get-parameter, gnus-group-parameter-value): Describe
- allow-list argument.
-
- * gnus-agent.el (gnus-agent-article-alist-save-format): Format doc
- string.
-
-2005-12-09 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
-
- * mm-decode.el (mm-display-external): Add missing cdr.
-
-2005-12-12 Richard M. Stallman <rms@gnu.org>
-
- * mm-url.el (mm-url-load-url): Require url-parse and url-vars.
-
-2005-12-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-decode.el (mm-discouraged-alternatives): Fix custom type.
- Suggest image/.* in the doc string.
-
-2005-12-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-display-external): Use nametemplate (defined in
- RFC1524) if it is in mailcap or add a suffix according to
- mailcap-mime-extensions when generating a temp filename; postpone
- deleting a temp file for 2 seconds for some wrappers, shell
- scripts, and so on, which might exit right after having started a
- viewer command as a background job.
-
-2005-12-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-default-article-saver): Add user-defined
- `function' to custom type.
-
-2005-12-02 ARISAWA Akihiro <ari@mbf.ocn.ne.jp> (tiny change)
-
- * mm-view.el (mm-inline-text-html-render-with-w3m): Fix misplaced
- parens.
-
-2005-12-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-xmas.el (gnus-use-toolbar): Revert.
- (gnus-xmas-setup-toolbar): Use global default-toolbar if
- gnus-use-toolbar is default.
-
- * messagexmas.el (message-use-toolbar): Revert.
- (message-setup-toolbar): Use global default-toolbar if
- message-use-toolbar is default.
-
-2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-xmas.el (gnus-use-toolbar): Determine the default value
- according to default-toolbar-visible-p.
-
- * messagexmas.el (message-use-toolbar): Ditto.
-
-2005-11-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-cache.el (gnus-cache-rename-group): Wrap doc strings and
- long lines.
- (gnus-cache-delete-group): Wrap doc strings.
-
- * gnus-agent.el (gnus-agent-rename-group)
- (gnus-agent-delete-group): Wrap doc strings.
-
-2005-11-24 Pascal Rigaux <pixel@mandriva.com> (tiny change)
-
- * rfc2231.el (rfc2231-parse-string): Support non-ascii chars.
-
-2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnmail.el (nnmail-fancy-expiry-target): Use current-time instead
- of current-time-string.
-
-2005-11-20 Stefan Schimanski <schimmi@debian.org> (tiny change)
-
- * nnmail.el (nnmail-fancy-expiry-target): Protect against invalid
- date header.
-
-2005-11-16 Boris Samorodov <bsam@ipt.ru> (tiny change)
-
- * imap.el (imap-kerberos4-open): Ignore SSL stuff.
-
-2005-11-14 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-article-alist-save-format): Changed
- internal variable to a custom variable. Changed default value
- from compressed(2) to uncompressed(1).
- (gnus-agent-read-agentview): Reversed revision 7.8 to restore
- support for uncompressed agentview files. Taken together, reading
- the agentview file should now be 6-7 times faster.
- (gnus-agent-long-article,
- gnus-agent-short-article, gnus-agent-score): Renamed category
- keywords to match gnus-cus.
- (gnus-agent-summary-fetch-series): Modified to protect against
- gnus-agent-summary-fetch-group clearing processable flags.
- (gnus-agent-synchronize-group-flags): Update live group buffer as
- synchronization may occur due to the user toggling the plugged
- status.
- (gnus-agent-braid-nov): Now tests new nov entries
- for duplicates which are removed. The invalid sort check then
- triggers a rescan after the sort as sorting may have moved
- duplicate entries such that they can be cheaply detected.
- (gnus-agent-read-local): Trivial fix to format of
- error message to display actual error condition.
- (gnus-agent-save-local): Avoid saving symbols that are bound to
- nil as they simply result in a warning message in
- gnus-agent-read-local.
- (gnus-agent-fetch-group-1): Clear downloadable flag when article
- successfully downloaded.
- (gnus-agent-regenerate-group): Use
- gnus-agent-synchronize-group-flags to reset read status in both
- gnus and server.
-
- * nntp.el (nntp-end-of-line): Doc fix.
- (nntp-authinfo-rejected): New error condition.
- (nntp-wait-for): Use new error condition to signal authentication
- error.
- (nntp-retrieve-data): Rethrow new error condition to break out of
- recursive call to nntp-send-authinfo.
-
-2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-dribble-read-file): Use make-local-variable
- rather than make-variable-buffer-local for file-precious-flag.
-
-2005-11-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-start.el (gnus-dribble-read-file): Quote file-precious-flag.
-
-2005-11-11 Jan Nieuwenhuizen <janneke@gnu.org>
-
- * gnus-start.el (gnus-dribble-read-file): Set file-precious-flag,
- as a buffer-local variable. This avoids creating truncated
- dribble files as a result of a hang up, eg.
-
-2005-11-04 Ken Manheimer <ken.manheimer@gmail.com>
-
- * pgg-pgp.el (pgg-pgp-encrypt-region, pgg-pgp-decrypt-region)
- (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
- (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
- (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
- argument to all these routines, so the passphrase can be managed
- externally and passed in to the system.
- (pgg-pgp-decrypt-region, pgg-pgp-sign-region): Use new name for
- pgg-add-passphrase-to-cache function.
-
- * pgg-pgp5.el (pgg-pgp5-encrypt-region, pgg-pgp5-decrypt-region)
- (pgg-pgp5-encrypt-symmetric-region, pgg-pgp5-encrypt-symmetric)
- (pgg-pgp5-encrypt, pgg-pgp5-decrypt-region, pgg-pgp5-decrypt)
- (pgg-pgp5-sign-region, pgg-pgp5-sign): Add optional 'passphrase'
- argument to all these routines, so the passphrase can be managed
- externally and passed in to the system.
- (pgg-pgp5-sign-region): Use new name of pgg-add-passphrase-to-cache
- function.
-
-2005-10-30 Chong Yidong <cyd@stupidchicken.com>
-
- * imap.el (imap-open): Handle case where buffer is a buffer
- object.
-
-2005-10-29 Ken Manheimer <ken.manheimer@gmail.com>
-
- * pgg-gpg.el (pgg-gpg-select-matching-key): Fix: look at the right
- part of the decoded armor to find the key-identifier.
- (pgg-gpg-lookup-key-owner): New function to return the
- human-readable identifier of a key owner.
- (pgg-gpg-lookup-id-from-key-owner): Make it easy to identify the
- key itself.
- (pgg-gpg-decrypt-region): Prompt with the key owner (rather than
- the key value) if we have a key and can match it against a secret
- key. Also, added a note pointing out fact that the prompt only
- indicates the first matching key.
-
- * pgg.el (pgg-decrypt): Passing along 'passphrase' in call to
- pgg-decrypt-region.
- (pgg-pending-timers): A new hash for tracking the passphrase cache
- timers, so that new ones supercede old ones.
- (pgg-add-passphrase-to-cache): Rename from
- `pgg-add-passphrase-cache' to reduce confusion (all callers
- changed). Modified to cancel old timers when new ones are added.
- (pgg-remove-passphrase-from-cache): Rename from
- `pgg-remove-passphrase-cache' to reduce confusion (all callers
- changed). Modified to cancel old timers when their keys are
- removed from the cache.
- (pgg-cancel-timer): In Emacs, an alias for cancel-timer; in
- XEmacs, an indirection to delete-itimer.
- (pgg-read-passphrase-from-cache, pgg-read-passphrase):
- Extract pgg-read-passphrase-from-cache from pgg-read-passphrase so
- users can only check cache without risk of prompting. Correct bug in
- notruncate behavior.
- (pgg-read-passphrase-from-cache, pgg-read-passphrase)
- (pgg-add-passphrase-cache, pgg-remove-passphrase-cache):
- Add informative docstrings.
- (pgg-decrypt): Convey provided passphrase in subordinate call to
- pgg-decrypt-region.
-
-2005-10-20 Ken Manheimer <ken.manheimer+emacs@gmail.com>
-
- * pgg.el (pgg-encrypt-region, pgg-encrypt-symmetric-region)
- (pgg-encrypt-symmetric, pgg-encrypt, pgg-decrypt-region)
- (pgg-decrypt, pgg-sign-region, pgg-sign): Add optional
- 'passphrase' argument, so the passphrase can be managed externally
- and then passed in to the system.
-
- * pgg.el (pgg-read-passphrase, pgg-add-passphrase-cache)
- (pgg-remove-passphrase-cache): Add optional 'notruncate' argument,
- so the passphrase cache can be used reliably with identifiers
- besides a pgp packet's key id.
-
- * pgg-gpg.el (pgg-pgp-encrypt-region)
- (pgg-pgp-encrypt-symmetric-region, pgg-pgp-encrypt-symmetric)
- (pgg-pgp-encrypt, pgg-pgp-decrypt-region, pgg-pgp-decrypt)
- (pgg-pgp-sign-region, pgg-pgp-sign): Add optional 'passphrase'
- argument to all these routines, so the passphrase can be managed
- externally and passed in to the system.
-
- * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Add optional
- 'notruncate' argument, so the passphrase cache can be used
- reliably with identifiers besides a pgp packet's key id.
-
-2005-10-29 Sascha Wilde <swilde@sha-bang.de>
-
- * pgg-gpg.el (pgg-gpg-encrypt-symmetric-region): New function for
- symmetric encryption.
- (pgg-gpg-symmetric-key-p): New function to check for an symmetric
- encrypted session key.
- (pgg-gpg-decrypt-region): When decrypting a symmetric encrypted
- message ask for the passphrase in a proper way.
-
- * pgg.el (pgg-encrypt-symmetric, pgg-encrypt-symmetric-region):
- New user commands for symmetric encryption.
-
-2005-11-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * messagexmas.el (message-use-toolbar): Change the valid values
- into default, top, bottom, left, and right.
- (message-toolbar-thickness): New variable.
- (message-xmas-setup-toolbar): Locate gnus-xmas-glyph-directory as
- well.
- (message-setup-toolbar): Make it work.
-
- * gnus-xmas.el (gnus-xmas-update-toolbars): New function.
- (gnus-use-toolbar): Change the valid values into default, top,
- bottom, left, and right.
- (gnus-toolbar-thickness): New variable.
- (gnus-xmas-setup-toolbar): New function.
- (gnus-xmas-setup-group-toolbar): Use it.
- (gnus-xmas-setup-summary-toolbar): Use it.
-
-2005-11-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-delay.el (gnus-delay-group): Don't autoload.
- It's useless and could trigger a bug in cus-dep.el causing ldefs-boot
- to be re-loaded when customizing the `gnus-delay' group.
-
-2005-11-19 Chong Yidong <cyd@stupidchicken.com>
-
- * message.el: Revert last changes.
- (message-insert-citation-line): Use newlines.
-
-2005-11-17 Chong Yidong <cyd@stupidchicken.com>
-
- * message.el (message-courtesy-message)
- (message-mark-insert-begin, message-mark-insert-end)
- (message-elide-ellipsis, message-cancel-message)
- (message-add-header, message-change-subject)
- (message-cross-post-followup-to-header)
- (message-cross-post-insert-note, message-reduce-to-to-cc)
- (message-widen-reply, message-delete-not-region)
- (message-kill-to-signature, message-insert-signature)
- (message-insert-importance-high, message-insert-importance-low)
- (message-insert-or-toggle-importance)
- (message-insert-disposition-notification-to)
- (message-indent-citation, message-yank-original)
- (message-cite-original-without-signature, message-cite-original)
- (message-insert-citation-line, message-position-on-field)
- (message-fix-before-sending, message-send-mail-partially)
- (message-send-mail, message-send-mail-with-sendmail)
- (message-send-mail-with-qmail, message-send-news)
- (message-check-news-header-syntax, message-generate-headers)
- (message-insert-courtesy-copy, message-fill-address)
- (message-fill-header, message-shorten-references)
- (message-setup-1, message-cancel-news)
- (message-forward-make-body-plain, message-forward-make-body-mime)
- (message-forward-make-body-mml, message-encode-message-body)
- (message-forward-make-body-digest-plain)
- (message-forward-make-body-digest-mime)
- (message-use-alternative-email-as-from): Insert `hard-newline'
- instead of ordinary newlines.
-
-2005-11-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-generate-headers): Downcase the argument
- given to message-check-element.
-
-2005-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-parameters-case-fold-search): New variable.
- (gnus-parameters-get-parameter): Use it.
-
- * gnus-score.el (gnus-home-score-file): Doc fix.
-
-2005-11-01 Xavier Maillard <zedek@gnu-rox.org> (tiny change)
-
- * gnus-score.el (gnus-update-score-entry-dates): Doc fix.
-
-2005-10-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-preview): Doc fix.
-
-2005-10-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * flow-fill.el (fill-flowed-encode-tests): Restore trailing
- whitespace removed in revision 7.8. Use concatenated string to
- protect trailing whitespace.
-
-2005-10-27 Jouni K. Sepp\e,Ad\e(Bnen <jks@iki.fi>
-
- * nnimap.el (nnimap-search-uids-not-since-is-evil): Add variable.
- (nnimap-request-expire-articles): Use it to avoid sending 'UID
- SEARCH UID ... NOT SINCE' queries, for inefficient servers like
- Courier IMAP ("some version from 2004"). Mostly based on similar
- code in the same function.
-
-2005-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-display-completion-list): New function.
- (message-expand-group): Use it; make sure the Completions buffer
- is modifiable.
-
-2005-10-23 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-sum.el (gnus-ignored-from-addresses): Handle case where
- user-mail-name is an empty string.
-
-2005-10-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-score.el (gnus-default-adaptive-score-alist): Set defaults
- depending on gnus-score-decay-constant.
-
-2005-10-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * nnslashdot.el (nnslashdot-request-article)
- (nnslashdot-retrieve-headers-1): Update to new HTML.
-
-2005-10-23 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-gssapi-program): Align command line parameters
- with latest GNU SASL.
- (imap-gssapi-open): Ignore 'Trying ...' messages from GNU SASL.
-
-2005-10-20 Hiroshi Fujishima <hiroshi.fujishima@gmail.com> (tiny change)
-
- * mail-source.el (mail-source-fetch-pop): Require pop3.
- (mail-source-check-pop): Ditto.
-
-2005-10-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-decode-encoded-words): Fix the handling of
- errors.
-
-2005-10-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-treat-strip-trailing-blank-lines)
- (gnus-treat-strip-leading-blank-lines): Improve doc string.
-
- * message.el (message-tool-bar-local-item-from-menu): Fix comment.
-
-2005-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-allow-incomplete-encoded-text): New variable.
- (rfc2047-charset-to-coding-system): New function.
- (rfc2047-decode-encoded-words): New function.
- (rfc2047-decode-region): Use them.
- (rfc2047-decode-cte): Remove.
- (rfc2047-parse-and-decode): Remove.
- (rfc2047-decode): Remove.
-
-2005-10-15 Kenichi Handa <handa@m17n.org>
-
- * rfc2047.el (rfc2047-decode-cte): New function.
- (rfc2047-decode-region): Change the way to decode successive
- encoded-words: decode B- or Q-encoding in each encoded-word,
- concatenate them, and decode it as charset.
-
-2005-10-17 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus-cus.el (gnus-custom-map): New variable. Bind mouse-1 to
- widget-move-and-invoke.
- (gnus-custom-mode): Use gnus-custom-map.
-
-2005-10-15 Bill Wohler <wohler@newt.com>
-
- * message.el (message-tool-bar-map): Renamed image file from
- mail_send to mail/send.
-
-2005-10-16 Masatake YAMATO <jet@gyve.org>
-
- * message.el (message-expand-group): Pass the common
- prefix substring of completion to `display-completion-list'.
-
-2005-10-09 Daniel Brockman <daniel@brockman.se>
-
- * format-spec.el (format-spec): Propagate text properties of % spec.
-
-2005-01-21 Derek Atkins <warlord@MIT.EDU> (tiny change)
-
- * pgg-pgp.el (pgg-pgp-decrypt-region): Use passphrase cache.
-
-2005-10-08 Simon Josefsson <jas@extundo.com>
-
- * pgg-parse.el (top-level): Don't require custom, it is
- autoloaded. (To sync with No Gnus.)
-
-2005-05-09 Georg C. F. Greve <greve@gnu.org> (tiny change)
-
- * pgg-gpg.el (pgg-gpg-possibly-cache-passphrase): Fix PIN caching.
-
-2005-10-08 Simon Josefsson <jas@extundo.com>
-
- * pgg-def.el (top-level): Don't require custom, it is
- autoloaded. (To sync with No Gnus.)
-
-2005-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (list-installed-shadows): New entry.
- (install): Use it.
- (remove-installed-shadows): New entry.
-
- * dgnushack.el (dgnushack-default-load-path): New variable.
- (dgnushack-find-lisp-shadows): New function.
- (dgnushack-remove-lisp-shadows): New function.
-
-2005-10-04 David Hansen <david.hansen@gmx.net>
-
- * nnrss.el (nnrss-request-article): Add support for the comments tag.
- (nnrss-check-group): Ditto.
-
-2005-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-url.el (mm-url-predefined-programs): Add switches for curl.
-
- * gnus-util.el (gnus-remove-duplicates): Remove.
-
- * nnmail.el (nnmail-article-group): Use mm-delete-duplicates
- instead of gnus-remove-duplicates.
-
- * message.el (message-remove-duplicates): Remove.
- (message-idna-to-ascii-rhs-1): Use mm-delete-duplicates instead of
- message-remove-duplicates.
-
- * mm-util.el (mm-delete-duplicates): Use `delete-dups' if
- available, else use implementation from `delete-dups'.
-
-2005-10-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (install-el-elc): New entry.
- (install): Use it so that .el files are necessarily installed.
-
-2005-09-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * time-date.el: Autoload parse-time-string, XEmacs needs it.
-
-2005-09-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mm-decode.el (mm-inline-media-tests): Check presence of the diff-mode
- function rather than the diff-mode.el package.
- (mm-display-external): Use with-current-buffer.
- (mm-viewer-completion-map, mm-viewer-completion-map):
- Move initialization inside declaration.
-
-2005-09-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el: Remove useless autoloads.
-
-2005-09-28 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-use-idna): Default to t.
- (message-use-idna): Test whether encoding works too. Doc fix.
-
-2005-09-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nntp.el (nntp-warn-about-losing-connection): Remove.
-
-2005-09-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-uu.el (mm-uu-emacs-sources-regexp): Make variable
- customizable. Change default value.
- (mm-uu-diff-groups-regexp): Change default value.
- (mm-uu-type-alist): Add doc string.
- (mm-uu-configure): Add doc string. Make it interactive.
- (mm-uu-diff-groups-regexp): Fix missing quotes from previous commit.
-
-2005-09-27 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-idna-to-ascii-rhs-1): Reformat.
-
-2005-09-27 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * message.el (message-remove-duplicates): New function.
- Implementation borrowed from `gnus-remove-duplicates'.
- (message-idna-to-ascii-rhs): Also encode idna addresses in
- Reply-To:, Mail-Reply-To: and Mail-Followup-To:.
- (message-idna-to-ascii-rhs-1): When `message-use-idna' is 'ask
- only ask about the same idna domain once per header and also tell
- in what header to replace the idna domain.
-
- * gnus-art.el (article-decode-idna-rhs): Also decode idna
- addresses in Reply-To:, Mail-Reply-To: and Mail-Followup-To:.
- (article-decode-idna-rhs): Fix regexp so that all idna-address in
- a header is decoded and not just the last one.
-
-2005-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-display-single): Don't modify text if it
- has been decoded.
-
- * mm-decode.el (mm-insert-part): Don't modify text if it has been
- decoded.
-
- * mm-view.el (mm-inline-text): Don't strip text props unless
- decoding enriched or richtext parts.
-
-2005-09-25 Romain Francoise <romain@orebokech.com>
-
- * gnus-agent.el (gnus-agent-expire-group, gnus-agent-expire):
- * gnus-start.el (gnus-subscribe-interactively):
- * gnus-uu.el (gnus-uu-grab-articles):
- End `yes-or-no-p' and `y-or-n-p' prompts with question mark and
- space.
-
-2005-09-24 Emilio C. Lopes <eclig@gmx.net>
-
- * smime.el (smime-sign-buffer, smime-decrypt-buffer):
- * mm-view.el (mm-view-pkcs7-decrypt):
- * gnus-sum.el (gnus-summary-limit-to-extra)
- (gnus-summary-respool-article, gnus-read-move-group-name):
- * gnus-score.el (gnus-summary-increase-score):
- * gnus-util.el (gnus-completing-read-with-default):
- * gnus-art.el (gnus-read-save-file-name)
- (gnus-summary-save-in-rmail, gnus-summary-save-in-mail)
- (gnus-summary-save-in-file, gnus-summary-save-body-in-file):
- * message.el (message-check-news-header-syntax):
- Follow convention for reading with the minibuffer.
-
-2005-09-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam-report.el (spam-report-url-ping-plain):
- Use gnus-extended-version as User-Agent.
-
- * gnus-agent.el (gnus-agent-synchronize-flags): Explain why the
- default value is nil.
-
-2005-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-synchronize-flags): Switch the
- default to nil, to be able to use Gnus at all. If the default
- switches to something else, then the function should be fixed not
- be exceedingly slow.
-
-2005-09-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mm-url.el (mm-url-decode-entities): Fix regexp.
-
-2005-09-18 Deepak Goel <deego@gnufans.org>
-
- * sieve.el (sieve-help): Fix `message' call: first arg should be a
- format spec.
-
-2005-09-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.el (gnus-group-startup-message): Bind image-load-path.
-
-2005-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-display-part): Protect against broken
- MIME messages.
-
-2005-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-edit-article-done): Remove text props
- before parsing header.
-
-2005-09-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam-report.el (spam-report-gmane): Fix generation of spam
- report URL.
-
-2005-09-10 Simon Josefsson <jas@extundo.com>
-
- * gnus-agent.el (gnus-agent-synchronize-flags): Make the default
- t, based on discussion on the ding list with Robert Epprecht
- <epprecht@solnet.ch>.
-
-2005-09-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam-report.el (spam-report-gmane): Make it work without
- X-Report-Spam header. Gmane now only provides Archived-At.
- This is only used if `spam-report-gmane-use-article-number' is nil.
- (spam-report-gmane-spam-header): Remove. Not used anymore.
-
- * nnweb.el (nnweb-google-wash-article): Print a message if article
- is not available.
-
-2005-09-07 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * gnus-art.el (gnus-mime-display-single): Decode text/* parts
- content before displaying.
-
-2005-09-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mml-smime.el: Remove defvar of gnus-extract-address-components.
-
-2005-09-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-display-inline-fontify): Disable support modes.
-
- * lpath.el: Don't bind mc-pgp-always-sign, url-current-object,
- url-package-name, url-package-version,
- w3m-cid-retrieve-function-alist, w3m-current-buffer,
- w3m-display-inline-images, and w3m-minor-mode-map.
-
-2005-09-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-tab-body-function): Fixed mismatched custom
- type.
-
- * gnus.el (gnus-group-change-level-function): Ditto.
-
- * gnus-msg.el (gnus-outgoing-message-group): Ditto.
-
- * gnus-art.el (gnus-signature-limit)
- (gnus-article-mime-part-function): Ditto.
-
-2005-09-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnweb.el (nnweb-type-definition, nnweb-google-wash-article):
- Make fetching article by MID work again for Google Groups. Added
- FIXME concerning gnus-group-make-web-group.
-
- * mml-smime.el (mml-smime-sign-query, mml-smime-get-dns-cert):
- Don't depend on Gnus by using mail-extract-address-components if
- gnus-extract-address-components is not bound.
-
- * gnus.el (gnus-user-agent): Use list of symbols instead of
- symbols. Display full version number for (S)XEmacs. Optionally
- display (S)XEmacs codename.
-
- * gnus-util.el (gnus-emacs-version): Update for new
- `gnus-user-agent'.
-
- * gnus-msg.el (gnus-extended-version): Make it possible to omit
- Gnus version.
-
-2005-09-02 Hrvoje Niksic <hniksic@xemacs.org>
-
- * mm-encode.el (mm-encode-content-transfer-encoding): Likewise
- when encoding.
-
- * mm-bodies.el (mm-decode-content-transfer-encoding):
- De-canonicalize CRLF for all text content types, not just
- text/plain.
-
-2005-09-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-thread-hide-subtree): Doc fix.
-
- * gnus-msg.el (gnus-inews-insert-gcc): Fix the mistake of using
- list, not listp.
-
-2005-08-29 Romain Francoise <romain@orebokech.com>
-
- * gnus-fun.el (gnus-convert-image-to-face-command): Fix typo in
- docstring.
- (gnus-face-from-file): Likewise.
-
-2005-08-31 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-art.el (w3m-minor-mode-map):
- * gnus-spec.el (gnus-newsrc-file-version):
- * gnus-util.el (nnmail-active-file-coding-system)
- (gnus-original-article-buffer, gnus-user-agent):
- * gnus.el (gnus-ham-process-destinations)
- (gnus-parameter-ham-marks-alist)
- (gnus-parameter-spam-marks-alist, gnus-spam-autodetect)
- (gnus-spam-autodetect-methods, gnus-spam-newsgroup-contents)
- (gnus-spam-process-destinations, gnus-spam-process-newsgroups):
- * mm-decode.el (gnus-current-window-configuration):
- * mm-extern.el (gnus-article-mime-handles):
- * mm-url.el (url-current-object, url-package-name)
- (url-package-version):
- * mm-view.el (gnus-article-mime-handles, gnus-newsgroup-charset)
- (smime-keys, w3m-cid-retrieve-function-alist)
- (w3m-current-buffer, w3m-display-inline-images)
- (w3m-minor-mode-map):
- * mml-smime.el (gnus-extract-address-components):
- * mml.el (gnus-article-mime-handles, gnus-mouse-2)
- (gnus-newsrc-hashtb, message-default-charset)
- (message-deletable-headers, message-options)
- (message-posting-charset, message-required-mail-headers)
- (message-required-news-headers):
- * mml1991.el (mc-pgp-always-sign):
- * mml2015.el (mc-pgp-always-sign):
- * nnheader.el (nnmail-extra-headers):
- * rfc1843.el (gnus-decode-encoded-word-function)
- (gnus-decode-header-function, gnus-newsgroup-name):
- * spam-stat.el (gnus-original-article-buffer): Add defvars.
-
-2005-08-22 Karl Chen <quarl@cs.berkeley.edu>
-
- * gnus-art.el (gnus-treatment-function-alist): Move date-lapsed to
- the end of the date treatments.
-
-2005-08-15 Simon Josefsson <jas@extundo.com>
-
- * pgg.el (url-insert-file-contents): Don't autoload it, Emacs has
- it in url-handlers.el and XEmacs in url.el. Reported by Luca
- Capello and Romain Francoise.
- (pgg-fetch-key-function): Removed, not used?
- (pgg-insert-url-with-w3): Require url, to get
- url-insert-file-contents regardless of where it is defined.
-
-2005-08-08 Simon Josefsson <jas@extundo.com>
-
- * pgg.el: Autoload url-insert-file-contents instead of loading
- w3/url.
- (pgg-insert-url-with-w3): Don't load url here.
-
-2005-08-05 Daiki Ueno <ueno@unixuser.org>
-
- * mml2015.el (mml2015-pgg-sign): Make sure micalg is correct.
-
- * pgg-parse.el (pgg-parse-hash-algorithm-alist): Add SHA-2.
-
-2005-08-06 Romain Francoise <romain@orebokech.com>
-
- * message.el: Fix typo in docstring.
-
-2005-08-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-bodies.el (mm-encode-body): Use coding system rather than
- charset to encode text.
-
- * mm-util.el (mm-find-mime-charset-region): Attempt to reduce the
- number of charsets if utf-8 is available (XEmacs).
-
-2005-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-unsplit-urls): Don't anchor urls to the
- start of the lines.
- (gnus-picon-databases): Add /usr/share/picons.
-
-2005-08-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-button-valid-localpart-regexp): New variable
- taken from `gnus-button-mid-or-mail-regexp'.
- (gnus-button-mid-or-mail-regexp, gnus-button-alist): Use it.
- (gnus-button-alist): Improve regexp for domain part of the MIDs
- for news:localpart@domain buttons.
- (gnus-button-ctan-directory-regexp): Update.
-
- * message.el (message-kill-buffer): Raise the current frame.
- (message-bury): Use `window-dedicated-p'.
-
-2005-08-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * sieve-manage.el (sieve-manage-interactive-login): Use
- make-local-variable rather than make-variable-buffer-local.
- (sieve-manage-open): Ditto.
- (sieve-manage-authenticate): Ditto.
-
- * mml.el (mml-generate-mime-1): Make the content type default to
- text/plain if the filename is not specified.
-
-2005-08-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-uu.el (gnus-uu-save-article): Use insert-buffer-substring
- instead of insert-buffer.
-
- * message.el (message-yank-original): Ditto; set the mark at the
- end of the yanked message.
-
-2005-07-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-next-page-1): Reduce the number of
- lines to scroll rather than to stop it.
-
- * mml.el (mml-generate-default-type): Add doc string.
- (mml-generate-mime-1): Use mm-default-file-encoding or make it
- default to application/octet-stream when determining the content
- type if it is not specified for the part or the mml contents; add
- a comment about mml-generate-default-type.
-
-2005-07-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mml.el (mml-generate-mime-1): Use mm-default-file-encoding or
- make it default to application/octet-stream when determining the
- content type if it is not specified for the external contents.
-
-2005-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Take care that not only a
- segmented parameter but also other parameters might be there.
-
-2005-07-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-display-external): Delete temp file, directory
- and buffer immediately if the external process is exited.
-
-2005-07-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-next-page-1): Don't scroll if there're
- fewer lines than that of scroll-margin.
- (gnus-article-prev-page): Narrow the range to bind scroll-in-place.
-
-2005-07-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-next-page): Revert.
- (gnus-article-beginning-of-window): New macro.
- (gnus-article-next-page-1): Use it.
- (gnus-article-prev-page): Ditto.
- (gnus-mime-save-part-and-strip): Use insert-buffer-substring
- instead of insert-buffer.
- (gnus-mime-delete-part): Ditto.
- (gnus-article-edit-exit): Ditto.
-
- * gnus-util.el (gnus-beginning-of-window): Remove.
- (gnus-end-of-window): Remove.
-
- * lpath.el: Don't bind scroll-margin.
-
-2005-07-25 Simon Josefsson <jas@extundo.com>
-
- * pgg.el (pgg-insert-url-with-w3): Don't load w3, it is possible
- to have the url package without w3. Reported by Daiki Ueno
- <ueno@unixuser.org> and Luigi Panzeri <matley@muppetslab.org>.
-
-2005-07-21 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mml.el (mml-minibuffer-read-disposition): Don't use inline by default
- for text/rtf. Display default in prompt. Pass default for M-n.
-
- * mm-uu.el (mm-uu-copy-to-buffer): Use with-current-buffer.
-
-2005-07-16 Romain Francoise <romain@orebokech.com>
-
- * gnus-uu.el (gnus-uu-save-article): Use `message-make-date'
- instead of `current-time-string' as the latter creates a time
- string that is not RFC 2822 compliant (it lacks the zone).
-
-2005-07-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-msg.el (gnus-button-mailto): Remove
- save-selected-window-window hackery because it relies on
- save-selected-window internals.
-
-2005-07-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-next-page): Use gnus-end-of-window.
- (gnus-article-next-page-1): Use gnus-beginning-of-window.
- (gnus-article-prev-page): Ditto.
-
- * gnus-util.el (gnus-beginning-of-window): New function.
- (gnus-end-of-window): New function.
-
- * lpath.el: Bind scroll-margin for XEmacs.
-
-2005-07-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-salt.el (gnus-pick-mode): Remove the 5th arg of
- gnus-add-minor-mode.
- (gnus-binary-mode): Ditto.
-
- * gnus-topic.el (gnus-topic-mode): Ditto.
-
-2005-07-08 Ralf Angeli <angeli@iwi.uni-sb.de>
-
- * gnus-art.el (gnus-article-next-page, gnus-article-next-page-1)
- (gnus-article-prev-page): Take scroll-margin into consideration.
-
-2005-07-04 Lute Kamstra <lute@gnu.org>
-
- Update FSF's address in GPL notices.
-
-2005-07-04 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus.el (gnus-exit):
- * gnus-group.el (gnus-group-icons):
- * nnmail.el (nnmail-prepare): Fix typos in docstrings.
-
- * gnus-nocem.el (gnus-nocem):
- * message.el (message-various, message-buffers, message-sending)
- (message-interface, message-forwarding, message-insertion)
- (message-headers, message-news, message-mail):
- * pgg-gpg.el (pgg-gpg):
- * pgg-parse.el (pgg-parse):
- * pgg-pgp.el (pgg-pgp):
- * pgg-pgp5.el (pgg-pgp5):
- * pop3.el (pop3): Finish `defgroup' description with period.
-
-2005-07-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-display-face): Improve the efficiency.
- (article-display-x-face): Ditto; remove grey x-face stuff.
-
-2005-06-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-display-face): Correct the position in
- which Faces are inserted; use dolist.
-
-2005-06-29 Didier Verna <didier@xemacs.org>
-
- * gnus-art.el (article-display-face): Display faces in correct
- order.
-
-2005-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-nocem.el (gnus-nocem-verifyer): Default to pgg-verify.
- (gnus-nocem-check-article): Fetch the Type header.
- (gnus-nocem-message-wanted-p): Fix the way to examine types.
- (gnus-nocem-verify-issuer): Use functionp instead of fboundp.
- (gnus-nocem-enter-article): Make sure gnus-nocem-hashtb is initialized.
-
- * pgg.el (pgg-verify): Return the verification result.
-
-2005-06-24 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-art.el (gnus-article-mode): Set `nobreak-char-display', not
- `show-nonbreak-escape'.
-
-2005-06-23 Lute Kamstra <lute@gnu.org>
-
- * gnus-art.el (gnus-article-mode): Use kill-all-local-variables.
-
- * dig.el (dig-mode):
- * smime.el (smime-mode): Use gnus-run-mode-hooks.
-
-2005-06-21 Juanma Barranquero <lekktu@gmail.com>
-
- * nnimap.el (nnimap-split-download-body): Fix spellings.
-
-2005-06-16 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-art.el (gnus-article-encrypt-body):
- * gnus-cus.el (gnus-score-customize):
- * mm-extern.el (mm-extern-local-file, mm-inline-external-body):
- * pop3.el (pop3-user): Don't use `format' on `error' arguments.
-
-2005-06-16 Miles Bader <miles@gnu.org>
-
- * spam.el (spam): Remove "-face" suffix from face name.
- (spam-face): New backward-compatibility alias for renamed face.
- (spam-face, spam-initialize): Use renamed spam face.
-
- * message.el (message-header-to, message-header-cc)
- (message-header-subject, message-header-newsgroups)
- (message-header-other, message-header-name)
- (message-header-xheader, message-separator, message-cited-text)
- (message-mml): Remove "-face" suffix from face names.
- (message-header-to-face, message-header-cc-face)
- (message-header-subject-face, message-header-newsgroups-face)
- (message-header-other-face, message-header-name-face)
- (message-header-xheader-face, message-separator-face)
- (message-cited-text-face, message-mml-face):
- New backward-compatibility aliases for renamed faces.
- (message-font-lock-keywords): Use renamed message faces.
-
- * sieve-mode.el (sieve-control-commands, sieve-action-commands)
- (sieve-test-commands, sieve-tagged-arguments):
- Remove "-face" suffix from face names.
- (sieve-control-commands-face, sieve-action-commands-face)
- (sieve-test-commands-face, sieve-tagged-arguments-face):
- New backward-compatibility aliases for renamed faces.
- (sieve-control-commands-face, sieve-action-commands-face)
- (sieve-test-commands-face, sieve-tagged-arguments-face):
- Use renamed sieve faces.
-
- * gnus.el (gnus-group-news-1, gnus-group-news-1-empty)
- (gnus-group-news-2, gnus-group-news-2-empty, gnus-group-news-3)
- (gnus-group-news-3-empty, gnus-group-news-4)
- (gnus-group-news-4-empty, gnus-group-news-5)
- (gnus-group-news-5-empty, gnus-group-news-6)
- (gnus-group-news-6-empty, gnus-group-news-low)
- (gnus-group-news-low-empty, gnus-group-mail-1)
- (gnus-group-mail-1-empty, gnus-group-mail-2)
- (gnus-group-mail-2-empty, gnus-group-mail-3)
- (gnus-group-mail-3-empty, gnus-group-mail-low)
- (gnus-group-mail-low-empty, gnus-summary-selected)
- (gnus-summary-cancelled, gnus-summary-high-ticked)
- (gnus-summary-low-ticked, gnus-summary-normal-ticked)
- (gnus-summary-high-ancient, gnus-summary-low-ancient)
- (gnus-summary-normal-ancient, gnus-summary-high-undownloaded)
- (gnus-summary-low-undownloaded)
- (gnus-summary-normal-undownloaded, gnus-summary-high-unread)
- (gnus-summary-low-unread, gnus-summary-normal-unread)
- (gnus-summary-high-read, gnus-summary-low-read)
- (gnus-summary-normal-read, gnus-splash):
- Remove "-face" suffix from face names.
- (gnus-group-news-1-face, gnus-group-news-1-empty-face)
- (gnus-group-news-2-face, gnus-group-news-2-empty-face)
- (gnus-group-news-3-face, gnus-group-news-3-empty-face)
- (gnus-group-news-4-face, gnus-group-news-4-empty-face)
- (gnus-group-news-5-face, gnus-group-news-5-empty-face)
- (gnus-group-news-6-face, gnus-group-news-6-empty-face)
- (gnus-group-news-low-face, gnus-group-news-low-empty-face)
- (gnus-group-mail-1-face, gnus-group-mail-1-empty-face)
- (gnus-group-mail-2-face, gnus-group-mail-2-empty-face)
- (gnus-group-mail-3-face, gnus-group-mail-3-empty-face)
- (gnus-group-mail-low-face, gnus-group-mail-low-empty-face)
- (gnus-summary-selected-face, gnus-summary-cancelled-face)
- (gnus-summary-high-ticked-face, gnus-summary-low-ticked-face)
- (gnus-summary-normal-ticked-face)
- (gnus-summary-high-ancient-face, gnus-summary-low-ancient-face)
- (gnus-summary-normal-ancient-face)
- (gnus-summary-high-undownloaded-face)
- (gnus-summary-low-undownloaded-face)
- (gnus-summary-normal-undownloaded-face)
- (gnus-summary-high-unread-face, gnus-summary-low-unread-face)
- (gnus-summary-normal-unread-face, gnus-summary-high-read-face)
- (gnus-summary-low-read-face, gnus-summary-normal-read-face)
- (gnus-splash-face):
- New backward-compatibility aliases for renamed faces.
- (gnus-group-startup-message): Use renamed gnus faces.
-
- * gnus-srvr.el (gnus-server-agent, gnus-server-opened)
- (gnus-server-closed, gnus-server-denied, gnus-server-offline)
- (gnus-server-agent): Remove "-face" suffix from face names.
- (gnus-server-agent-face, gnus-server-opened-face)
- (gnus-server-closed-face, gnus-server-denied-face)
- (gnus-server-offline-face):
- New backward-compatibility aliases for renamed faces.
- (gnus-server-agent-face, gnus-server-opened-face)
- (gnus-server-closed-face, gnus-server-denied-face)
- (gnus-server-offline-face): Use renamed gnus faces.
-
- * gnus-picon.el (gnus-picon-xbm, gnus-picon):
- Remove "-face" suffix from face names.
- (gnus-picon-xbm-face, gnus-picon-face):
- New backward-compatibility aliases for renamed faces.
-
- * gnus-cite.el (gnus-cite-attribution, gnus-cite-1, gnus-cite-2)
- (gnus-cite-3, gnus-cite-4, gnus-cite-5, gnus-cite-6)
- (gnus-cite-7, gnus-cite-8, gnus-cite-9, gnus-cite-10)
- (gnus-cite-11): Remove "-face" suffix from face names.
- (gnus-cite-attribution-face, gnus-cite-face-1, gnus-cite-face-2)
- (gnus-cite-face-3, gnus-cite-face-4, gnus-cite-face-5)
- (gnus-cite-face-6, gnus-cite-face-7, gnus-cite-face-8)
- (gnus-cite-face-9, gnus-cite-face-10, gnus-cite-face-11):
- New backward-compatibility aliases for renamed faces.
- (gnus-cite-attribution-face, gnus-cite-face-list)
- (gnus-article-boring-faces): Use renamed gnus faces.
-
- * gnus-art.el (gnus-signature, gnus-header-from)
- (gnus-header-subject, gnus-header-newsgroups, gnus-header-name)
- (gnus-header-content): Remove "-face" suffix from face names.
- (gnus-signature-face, gnus-header-from-face)
- (gnus-header-subject-face, gnus-header-newsgroups-face)
- (gnus-header-name-face, gnus-header-content-face):
- New backward-compatibility aliases for renamed faces.
- (gnus-signature-face, gnus-header-face-alist): Use renamed gnus faces.
-
- * gnus-sum.el (gnus-summary-selected-face)
- (gnus-summary-highlight): Use renamed gnus faces.
- * gnus-group.el (gnus-group-highlight): Likewise.
-
-2005-06-14 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus-sieve.el (gnus-sieve-article-add-rule):
- * legacy-gnus-agent.el (gnus-agent-unlist-expire-days):
- * spam-stat.el (spam-stat-buffer-change-to-spam)
- (spam-stat-buffer-change-to-non-spam): Follow error conventions.
-
- * message.el (message-is-yours-p):
- * gnus-sum.el (gnus-auto-select-subject): Fix quoting in docstring.
-
-2005-06-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-inline-text): Withdraw the last change.
-
-2005-06-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-inline-text): Turn off adaptive-fill-mode while
- executing enriched-decode.
-
-2005-06-04 Luc Teirlinck <teirllm@auburn.edu>
-
- * gnus-art.el (article-update-date-lapsed): Use `save-match-data'.
-
-2005-06-04 Lute Kamstra <lute@gnu.org>
-
- * nnfolder.el (nnfolder-read-folder): Make sure that undo
- information is never recorded.
-
-2005-06-03 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-art.el (gnus-emphasis-alist): Disable the strikethru thingy.
-
-2005-06-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * pop3.el (pop3-md5): Run md5 in the binary mode.
- (pop3-md5-program-args): New variable.
-
- * starttls.el (starttls-set-process-query-on-exit-flag):
- Use eval-and-compile.
-
-2005-05-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-display-x-face): Replace
- process-kill-without-query by gnus-set-process-query-on-exit-flag.
-
- * gnus-group.el: Bind gnus-cache-active-hashtb when compiling.
-
- * gnus-util.el (gnus-set-process-query-on-exit-flag): Alias to
- set-process-query-on-exit-flag or process-kill-without-query.
-
- * html2text.el (html2text-fix-paragraphs): Use `while - re-search'
- loop instead of replace-regexp.
-
- * imap.el (imap-ssl-open): Use set-process-query-on-exit-flag
- instead of process-kill-without-query if it is available.
-
- * mm-util.el (mm-insert-file-contents): Bind find-file-hook
- instead of find-file-hooks if it is available.
-
- * mml1991.el: Bind pgg-default-user-id when compiling.
-
- * mml2015.el: Bind pgg-default-user-id when compiling.
-
- * nndraft.el (nndraft-request-associate-buffer):
- Use write-contents-functions instead of write-contents-hooks if it is
- available.
-
- * nnheader.el (nnheader-find-file-noselect): Bind find-file-hook
- instead of find-file-hooks if it is available.
-
- * nntp.el (nntp-open-connection): Replace
- process-kill-without-query by gnus-set-process-query-on-exit-flag.
- (nntp-open-ssl-stream): Ditto.
- (nntp-open-tls-stream): Ditto.
-
- * pgg.el: Don't bind itimer vars; don't autoload itimer functions.
- (pgg-run-at-time-1): New macro.
- (pgg-run-at-time): Use it.
-
- * starttls.el (starttls-set-process-query-on-exit-flag): Alias to
- set-process-query-on-exit-flag or process-kill-without-query.
- (starttls-open-stream-gnutls): Use it instead of
- process-kill-without-query.
- (starttls-open-stream): Ditto.
-
-2005-05-31 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-ssl-open): Use imap-process-connection-type,
- instead of hard coding to nil.
-
-2005-05-31 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-group.el: Require gnus-sum and autoload functions to
- resolve warnings when gnus-group.el compiled alone.
-
-2005-05-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-agent.el (gnus-agent-regenerate-group)
- (gnus-agent-fetch-articles): Replace `string-to-int' by
- `string-to-number'.
- * gnus-art.el (gnus-button-fetch-group): Ditto.
- * gnus-cache.el (gnus-cache-generate-active)
- (gnus-cache-articles-in-group): Ditto.
- * gnus-group.el (gnus-group-set-current-level)
- (gnus-group-insert-group-line): Ditto.
- * gnus-score.el (gnus-score-set-expunge-below)
- (gnus-score-set-mark-below, gnus-summary-score-effect)
- (gnus-summary-score-entry): Ditto.
- * gnus-soup.el (gnus-soup-send-packet, gnus-soup-parse-areas)
- (gnus-soup-pack): Ditto.
- * gnus-spec.el (gnus-xmas-format): Ditto.
- * gnus-start.el (gnus-newsrc-to-gnus-format): Ditto.
- * gnus-sum.el (gnus-create-xref-hashtb): Ditto.
- * gnus-uu.el (gnus-uu-expand-numbers): Ditto.
- * nnbabyl.el (nnbabyl-article-group-number): Ditto.
- * nndb.el (nndb-get-remote-expire-response): Ditto.
- * nndiary.el (nndiary-parse-schedule-value)
- (nndiary-string-to-number, nndiary-request-replace-article)
- (nndiary-request-article): Ditto.
- * nndoc.el (nndoc-rnews-body-end, nndoc-mbox-body-end): Ditto.
- * nndraft.el (nndraft-articles, nndraft-request-group): Ditto.
- * nneething.el (nneething-make-head): Ditto.
- * nnfolder.el (nnfolder-request-article)
- (nnfolder-retrieve-headers): Ditto.
- * nnheader.el (nnheader-file-to-number): Ditto.
- * nnkiboze.el (nnkiboze-request-article): Ditto.
- * nnmail.el (nnmail-process-unix-mail-format)
- (nnmail-process-babyl-mail-format): Ditto.
- * nnmbox.el (nnmbox-read-mbox, nnmbox-article-group-number): Ditto.
- * nnmh.el (nnmh-update-gnus-unreads, nnmh-active-number)
- (nnmh-request-create-group, nnmh-request-list-1)
- (nnmh-request-group, nnmh-request-article): Ditto.
- * nnml.el (nnml-request-replace-article, nnml-request-article): Ditto.
- * nnrss.el (nnrss-find-rss-via-syndic8): Ditto.
- * nnsoup.el (nnsoup-make-active): Ditto.
- * nnspool.el (nnspool-find-id, nnspool-request-group): Ditto.
- * nntp.el (nntp-find-group-and-number)
- (nntp-retrieve-headers-with-xover): Ditto.
- * pgg-gpg.el (pgg-gpg-snarf-keys-region): Ditto.
- * pgg-parse.el (pgg-read-body, pgg-read-bytes)
- (pgg-format-key-identifier): Ditto.
- * pop3.el (pop3-last, pop3-stat): Ditto.
- * qp.el (quoted-printable-decode-region): Ditto.
-
- * spam-report.el (spam-report-url-ping-mm-url): Use format instead
- of concat.
-
-2005-05-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-category-mode): Use gnus-run-mode-hooks.
-
- * gnus-art.el (gnus-article-mode): Use gnus-run-mode-hooks.
-
- * gnus-cus.el (gnus-custom-mode): Use gnus-run-mode-hooks.
-
- * gnus-eform.el (gnus-edit-form-mode): Use gnus-run-mode-hooks.
-
- * gnus-group.el (gnus-group-mode): Use gnus-run-mode-hooks.
-
- * gnus-kill.el (gnus-kill-file-mode): Use gnus-run-mode-hooks.
-
- * gnus-salt.el (gnus-tree-mode): Use gnus-run-mode-hooks.
- (gnus-carpal-mode): Ditto.
-
- * gnus-srvr.el (gnus-server-mode): Use gnus-run-mode-hooks.
- (gnus-browse-mode): Ditto.
-
- * gnus-sum.el (gnus-summary-mode): Use gnus-run-mode-hooks.
-
- * gnus-util.el (gnus-run-mode-hooks): Save current buffer.
-
-2005-05-29 Richard M. Stallman <rms@gnu.org>
-
- * gnus-cite.el (gnus-cite-add-face): Set overlay's evaporate property.
-
-2005-05-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-run-mode-hooks): New function.
-
- * score-mode.el (gnus-score-mode): Use gnus-run-mode-hooks.
-
- * dgnushack.el: Advise byte-optimize-form-code-walker to avoid the
- ``...called for effect'' warnings for Emacs 21.4 as well as 21.3.
-
-2005-05-26 Luc Teirlinck <teirllm@auburn.edu>
-
- * gnus-agent.el (gnus-agent-make-mode-line-string):
- Use mode-line-highlight as mouse-face.
-
-2005-05-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock): Change the parent group to news.
-
- * deuglify.el (gnus-outlook-deuglify): Add :group.
-
- * dig.el (dig): Add :group.
-
- * gnus-art.el (gnus-inhibit-mime-unbuttonizing): Add :group.
-
- * gnus-cite.el (gnus-cite-attribution-face): Add :group.
- (gnus-cite-face-1, gnus-cite-face-2, gnus-cite-face-3): Ditto.
- (gnus-cite-face-4, gnus-cite-face-5, gnus-cite-face-6): Ditto.
- (gnus-cite-face-7, gnus-cite-face-8, gnus-cite-face-9): Ditto.
- (gnus-cite-face-10, gnus-cite-face-11): Ditto.
-
- * gnus-diary.el (gnus-diary): Add :group.
-
- * gnus.el (gnus-group-news-1-face): Add :group.
- (gnus-group-news-1-empty-face): Ditto.
- (gnus-group-news-2-face, gnus-group-news-2-empty-face): Ditto.
- (gnus-group-news-3-face, gnus-group-news-3-empty-face): Ditto.
- (gnus-group-news-4-face, gnus-group-news-4-empty-face): Ditto.
- (gnus-group-news-5-face, gnus-group-news-5-empty-face): Ditto.
- (gnus-group-news-6-face, gnus-group-news-6-empty-face): Ditto.
- (gnus-group-news-low-face, gnus-group-news-low-empty-face): Ditto.
- (gnus-group-mail-1-face, gnus-group-mail-1-empty-face): Ditto.
- (gnus-group-mail-2-face, gnus-group-mail-2-empty-face): Ditto.
- (gnus-group-mail-3-face, gnus-group-mail-3-empty-face): Ditto.
- (gnus-group-mail-low-face, gnus-group-mail-low-empty-face): Ditto.
- (gnus-summary-selected-face, gnus-summary-cancelled-face): Ditto.
- (gnus-summary-high-ticked-face): Ditto.
- (gnus-summary-low-ticked-face): Ditto.
- (gnus-summary-normal-ticked-face): Ditto.
- (gnus-summary-high-ancient-face): Ditto.
- (gnus-summary-low-ancient-face): Ditto.
- (gnus-summary-normal-ancient-face): Ditto.
- (gnus-summary-high-undownloaded-face): Ditto.
- (gnus-summary-low-undownloaded-face): Ditto.
- (gnus-summary-normal-undownloaded-face): Ditto.
- (gnus-summary-high-unread-face): Ditto.
- (gnus-summary-low-unread-face): Ditto.
- (gnus-summary-normal-unread-face): Ditto.
- (gnus-summary-high-read-face, gnus-summary-low-read-face): Ditto.
- (gnus-summary-normal-read-face, gnus-splash-face): Ditto.
-
- * message.el (message-minibuffer-local-map): Add :group.
-
- * sieve-manage.el (sieve-manage-log): Add :group.
- (sieve-manage-default-user): Diito.
- (sieve-manage-server-eol, sieve-manage-client-eol): Ditto.
- (sieve-manage-streams, sieve-manage-stream-alist): Ditto.
- (sieve-manage-authenticators): Ditto.
- (sieve-manage-authenticator-alist): Ditto.
- (sieve-manage-default-port): Ditto.
-
- * sieve-mode.el (sieve-control-commands-face): Add :group.
- (sieve-action-commands-face): Ditto.
- (sieve-test-commands-face): Ditto.
- (sieve-tagged-arguments-face): Ditto.
-
- * smime.el (smime): Add :group.
-
- * spam-report.el (spam-report): Add :group.
-
- * spam.el (spam, spam-face): Add :group.
-
-2005-05-26 Lute Kamstra <lute@gnu.org>
-
- * score-mode.el (gnus-score-mode): Use run-mode-hooks.
-
-2005-05-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el: Autoload mail-extract-address-components for XEmacs.
-
- * gnus-art.el: Don't autoload mail-extract-address-components.
-
- * gnus.el: Use eval-and-compile to autoload message-y-or-n-p.
-
- * nndb.el: Don't declare the nndb back end two or more times; don't
- autoload news-reply-mode, news-setup, cancel-timer and telnet.
-
- * nntp.el: Autoload format-spec instead of format; use
- eval-and-compile to evaluate autoload forms.
-
- * spam-report.el (spam-report-process-queue): Use gnus-point-at-eol.
-
-2005-04-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-date-ut): Support converting date in
- forwarded parts as well.
- (gnus-article-save-original-date): New macro.
- (gnus-display-mime): Use it.
-
-2005-04-28 David Hansen <david.hansen@physik.fu-berlin.de>
-
- * nnrss.el (nnrss-check-group, nnrss-request-article): Support the
- enclosure element of <item>.
-
-2005-04-24 Teodor Zlatanov <tzz@lifelogs.com>
-
- * spam-report.el (spam-report-unplug-agent)
- (spam-report-plug-agent, spam-report-deagentize)
- (spam-report-agentize, spam-report-url-ping-temp-agent-function):
- support for the Agent in spam-report: when unplugged, report to a
- file; when plugged, submit all the requests.
- [Added missing offline functionality from trunk.]
-
-2005-04-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam-report.el (spam-report-url-to-file)
- (spam-report-requests-file): New function and variable for offline
- reporting.
- (spam-report-url-ping-function): Add `spam-report-url-to-file'
- and user defined function.
- (spam-report-process-queue): New function.
- Process requests from `spam-report-requests-file'.
- (spam-report-url-ping-mm-url): Autoload.
- [Added missing offline functionality from trunk.]
-
-2005-04-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * qp.el (quoted-printable-encode-region): Save excursion.
-
-2005-04-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-inline-part): Use mm-string-to-multibyte.
-
- * lpath.el: Fbind display-time-event-handler; don't fbind
- string-to-multibyte.
-
- * qp.el (quoted-printable-encode-region): Use mm-string-to-multibyte.
-
-2005-04-13 Miles Bader <miles@gnu.org>
-
- * mm-util.el (mm-string-to-multibyte): Use Gnus trunk definition.
-
-2005-04-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnrss.el (nnrss-node-text): Replace CRLFs (which might be
- contained in text because xml.el decodes entities) with LFs.
-
-2005-04-11 Lute Kamstra <lute@gnu.org>
-
- * message.el (message-make-date): Handle byte-compiler warnings
- differently.
- * nnimap.el (nnimap-date-days-ago): Ditto.
-
-2005-04-10 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mm-util.el (mm-string-to-multibyte): New function.
- (mm-detect-coding-region): Typo.
-
-2005-04-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-read-summary-keys): Fix misplaced parens.
-
-2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-coding-system-p): Don't return binary for the nil
- argument in XEmacs.
-
- * nnrss.el (nnrss-compatible-encoding-alist): New variable.
- (nnrss-request-group): Decode group name first.
- (nnrss-request-article): Make a text/plain article if mml-to-mime
- failed.
- (nnrss-get-encoding): Return a compatible encoding according to
- nnrss-compatible-encoding-alist.
- (nnrss-opml-export): Use dolist.
- (nnrss-find-el): Use consp instead of listp.
- (nnrss-order-hrefs): Use dolist.
-
-2005-04-06 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * nnrss.el (nnrss-verbose): Remove.
- (nnrss-request-group): Use `nnheader-message' instead.
-
-2005-04-06 Mark Plaksin <happy@usg.edu> (tiny change)
-
- * nnrss.el (nnrss-verbose): New variable.
- (nnrss-request-group): Make it say nnrss is requesting a group.
-
-2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * dgnushack.el: Autoload sgml-mode for XEmacs.
-
- * gnus-agent.el (gnus-agent-group-path): Decode group name.
- (gnus-agent-group-pathname): Ditto.
-
- * gnus-cache.el (gnus-cache-file-name): Decode group name.
-
- * gnus-group.el (gnus-group-line-format-alist): Use decoded group
- name for only %g and %c.
- (gnus-group-insert-group-line): Bind gnus-tmp-decoded-group
- instead of gnus-tmp-group to decoded group name.
- (gnus-group-make-group): Decode group name.
- (gnus-group-delete-group): Ditto.
- (gnus-group-make-rss-group): Exclude `/'s from group names;
- register the group data after opening the nnrss group; unify
- non-ASCII group names; encode group name.
- (gnus-group-catchup-current): Decode group name.
- (gnus-group-expire-articles-1): Ditto.
- (gnus-group-set-current-level): Ditto.
- (gnus-group-kill-group): Ditto.
-
- * gnus-spec.el (gnus-update-format-specifications): Flush the
- group format spec cache if it doesn't support decoded group names.
-
- * lpath.el: Fbind detect-coding-string.
-
- * mm-url.el (mm-url-predefined-programs): Add --silent arg to curl.
-
- * nnrss.el: Require rfc2047 and mml.
- (nnrss-file-coding-system): New variable.
- (nnrss-format-string): Redefine it as an inline function.
- (nnrss-decode-group-name): New function.
- (nnrss-string-as-multibyte): Remove.
- (nnrss-retrieve-headers): Decode group name; don't use
- nnrss-format-string.
- (nnrss-request-group): Decode group name.
- (nnrss-request-article): Decode group name; allow a Message-ID as
- well as an article number; don't use nnrss-format-string; encode a
- Message-ID string which may contain non-ASCII characters; use
- mml-to-mime to compose a MIME article; use search-forward instead
- of re-search-forward.
- (nnrss-request-expire-articles): Decode group name.
- (nnrss-request-delete-group): Delete entries in nnrss-group-alist
- as well; decode group name.
- (nnrss-get-encoding): Fix regexp.
- (nnrss-fetch): Clarify error message.
- (nnrss-read-server-data): Use insert-file-contents instead of load;
- bind file-name-coding-system; use multibyte buffer.
- (nnrss-save-server-data): Insert newline; bind
- coding-system-for-write to the value of nnrss-file-coding-system;
- bind file-name-coding-system; add coding cookie.
- (nnrss-read-group-data): Use insert-file-contents instead of load;
- bind file-name-coding-system; use multibyte buffer.
- (nnrss-save-group-data): Bind coding-system-for-write to the
- value of nnrss-file-coding-system; bind file-name-coding-system.
- (nnrss-decode-entities-string): Rename from n-d-e-unibyte-string;
- make it work with non-ASCII text.
- (nnrss-opml-export): Use mm-set-buffer-file-coding-system instead
- of set-buffer-file-coding-system.
- (nnrss-find-el): Check carefully whether there's a list of string
- which old xml.el may return rather than a string; make it work
- with old xml.el as well.
-
- * time-date.el (time-to-seconds): Don't use the #xhhhh syntax
- which Emacs 20 doesn't support.
- (seconds-to-time, days-to-time, time-subtract, time-add): Ditto.
-
-2005-04-06 Tsuyoshi AKIHO <akiho@kawachi.zaq.ne.jp>
-
- * gnus-sum.el (gnus-summary-walk-group-buffer): Decode group name.
-
- * nnrss.el (nnrss-get-encoding): New function.
- (nnrss-fetch): Use unibyte buffer initially; bind
- coding-system-for-read while performing mm-url-insert; remove ^Ms;
- decode contents according to the encoding attribute.
- (nnrss-save-group-data): Add coding cookie.
- (nnrss-mime-encode-string): New function.
- (nnrss-check-group): Use it to encode subject and author.
-
-2005-04-06 Maciek Pasternacki <maciekp@japhy.fnord.org> (tiny change)
-
- * nnrss.el (nnrss-fetch): Signal an error if w3-parse-buffer also
- failed.
-
-2005-04-06 Joakim Verona <joakim@verona.se> (tiny change)
-
- * nnrss.el (nnrss-read-group-data): Fix off-by-one error.
-
-2005-04-06 Jesper Harder <harder@ifa.au.dk>
-
- * mm-util.el (mm-subst-char-in-string): Support inplace.
-
- * nnrss.el: Pedantic docstring and whitespace fixes (courtesy of
- checkdoc.el).
- (nnrss-request-article): Cleanup.
- (nnrss-request-delete-group): Use nnrss-make-filename.
- (nnrss-read-server-data): Use nnrss-make-filename; use load.
- (nnrss-save-server-data): Use nnrss-make-filename; use gnus-prin1.
- (nnrss-read-group-data): hash on description if link is missing;
- use nnrss-make-filename; use load.
- (nnrss-save-group-data): Use nnrss-make-filename; use gnus-prin1.
- (nnrss-make-filename): New function.
- (nnrss-close): New function.
- (nnrss-check-group): Hash on description if link is missing.
- (nnrss-get-namespace-prefix): Use string= to compare strings!
- Reported by David D. Smith <davidsmith@acm.org>.
- (nnrss-opml-export): Turn on sgml-mode.
-
-2005-04-06 Mark A. Hershberger <mah@everybody.org>
-
- * nnrss.el (nnrss-opml-import, nnrss-opml-export): New functions.
-
-2005-04-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-make-date): Add defvars in order to silence
- the byte compiler inside the defun.
-
- * nnimap.el (nnimap-date-days-ago): Ditto.
-
- * gnus-demon.el (parse-time-string): Add autoload.
-
- * gnus-delay.el (parse-time-string): Add autoload.
-
- * gnus-art.el (parse-time-string): Add autoload.
-
- * nnultimate.el (parse-time): Require for `parse-time-string'.
-
-2005-04-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Avoid the
- "Unrecognized menu descriptor" error in XEmacs.
-
-2005-03-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-resend): Bind rfc2047-encode-encoded-words.
-
- * mm-util.el (mm-replace-in-string): New function.
- (mm-xemacs-find-mime-charset-1): Ignore errors while loading
- latin-unity, which cannot be used with XEmacs 21.1.
-
- * rfc2047.el (rfc2047-encode-function-alist): Rename from
- rfc2047-encoding-function-alist in order to avoid conflicting with
- the old version.
- (rfc2047-encode-message-header): Remove useless goto-char.
- (rfc2047-encodable-p): Don't move point.
- (rfc2047-syntax-table): Treat `(' and `)' as is.
- (rfc2047-encode-region): Concatenate words containing non-ASCII
- characters in structured fields; don't encode space-delimited
- ASCII words even in unstructured fields; don't break words at
- char-category boundaries; encode encoded words in structured
- fields; treat text within parentheses as special; show the
- original text when error has occurred; move point to the end of
- the region after encoding, suggested by IRIE Tetsuya
- <irie@t.email.ne.jp>; treat backslash-quoted characters as
- non-special; check carefully whether to encode special characters;
- fix some kind of misconfigured headers; signal a real error if
- debug-on-quit or debug-on-error is non-nil; don't infloop,
- suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>; assume
- the close parenthesis may be included in the encoded word; encode
- bogus delimiters.
- (rfc2047-encode-string): Use mm-with-multibyte-buffer.
- (rfc2047-encode-max-chars): New variable.
- (rfc2047-encode-1): New function.
- (rfc2047-encode): Use it; encode text so that it occupies the
- maximum width within 76-column; work correctly on Q encoding for
- iso-2022-* charsets; fold the line before encoding; don't append a
- space if the encoded word includes close parenthesis.
- (rfc2047-fold-region): Use existing whitespace for LWSP; make it
- sure not to break a line just after the header name.
- (rfc2047-b-encode-region): Remove.
- (rfc2047-b-encode-string): New function.
- (rfc2047-q-encode-region): Remove.
- (rfc2047-q-encode-string): New function.
- (rfc2047-encode-parameter): New function.
- (rfc2047-encoded-word-regexp): Don't use shy group.
- (rfc2047-decode-region): Follow rfc2047-encoded-word-regexp change.
- (rfc2047-parse-and-decode): Ditto.
- (rfc2047-decode): Treat the ascii coding-system as raw-text by default.
-
-2005-03-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * rfc2047.el (rfc2047-encode-encoded-words): New variable.
- (rfc2047-field-value): Strip props.
- (rfc2047-encode-message-header): Disable header folding -- not
- all headers can be folded, and this should be done by the message
- composition mode. Probably. I think.
- (rfc2047-encodable-p): Say that =? needs encoding.
- (rfc2047-encode-region): Encode =? strings.
-
-2005-03-25 Jesper Harder <harder@ifa.au.dk>
-
- * rfc2047.el (rfc2047-encoded-word-regexp): Support RFC 2231
- language tags; remove unnecessary '+'. Reported by Stefan Wiens
- <s.wi@gmx.net>.
- (rfc2047-decode-string): Don't cons a string unnecessarily.
- (rfc2047-parse-and-decode, rfc2047-decode): Use a character for
- the encoding to avoid consing a string.
- (rfc2047-decode): Use mm-subst-char-in-string instead of
- mm-replace-chars-in-string.
-
-2005-03-25 TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
- * rfc2047.el (rfc2047-encode): Use uppercase letters to specify
- encodings of MIME-encoded words, in order to improve
- interoperability with several broken MUAs.
-
-2005-03-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-srvr.el (gnus-browse-select-group): Add NUMBER argument and
- pass it to `gnus-browse-read-group'.
- (gnus-browse-read-group): Add NUMBER argument and pass it to
- `gnus-group-read-ephemeral-group'.
-
- * gnus-group.el (gnus-group-read-ephemeral-group): Add NUMBER
- argument and pass it to `gnus-group-read-group'.
-
-2005-03-19 Aidan Kehoe <kehoea@parhasard.net>
-
- * mm-util.el (mm-xemacs-find-mime-charset): Only call
- mm-xemacs-find-mime-charset-1 if we have the mule feature
- available at runtime.
-
-2005-03-25 Werner Lemberg <wl@gnu.org>
-
- * nnmaildir.el: Replace `illegal' with `invalid'.
-
-2005-03-23 Lute Kamstra <lute@gnu.org>
-
- * time-date.el: Add comment on time value formats.
- Don't require parse-time.
- (with-decoded-time-value): New macro.
- (encode-time-value): New function.
- (time-to-seconds, time-less-p, time-subtract, time-add): Use them.
- (days-to-time): Return a valid time value when arg is huge.
- (time-since): Use time-subtract.
- (time-to-number-of-days): Use time-to-seconds.
-
-2005-03-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-start.el (gnus-display-time-event-handler):
- Check display-time-timer at runtime rather than only at load time
- in case display-time-mode is turned off in the mean time.
-
-2005-03-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnimap.el (nnimap-open-connection): Print which authinfo file is
- used.
-
- * nneething.el (nneething-map-file-directory): Derive from
- `gnus-directory'.
-
- * gnus-art.el (gnus-header-button-alist): Use `gnus-msg-mail' for
- the To/Cc button.
-
-2005-03-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnmaildir.el (nnmaildir-request-accept-article):
- Use `nnheader-cancel-timer' for compatibility with current XEmacs.
-
-2005-03-13 Andrey Slusar <anrays@gmail.com> (tiny change)
-
- * gnus.el: Don't try and mark `gnus-agent-save-groups' as an
- autoloaded function.
-
-2005-03-13 Steve Youngs <steve@sxemacs.org>
-
- * mm-url.el: Require timer-funcs at compile time when in XEmacs
- for `with-timeout'.
-
- * mail-source.el: Require timer-funcs at compile time when in
- XEmacs for `run-with-idle-timer'.
-
- * gnus-async.el: Ditto.
-
- * dgnushack.el: No need to ignore `run-with-idle-timer', XEmacs
- has this function now.
-
-2005-03-16 Lute Kamstra <lute@gnu.org>
-
- * message.el (message-make-date): Require parse-time.
-
-2005-03-10 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * nnimap.el (nnimap-retrieve-headers-from-server): Fix last change.
-
-2005-03-10 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk> (tiny change)
-
- * nnimap.el (nnimap-retrieve-headers-from-server): Fix off-by-one flaw.
-
-2005-03-08 Bjorn Solberg <bjorn_ding@hekneby.org> (tiny change)
-
- * nnimap.el (nnimap-retrieve-headers-from-server): Sort NOV
- buffer (since IMAP server might return FETCH response out of
- order, and the nntp buffer must be sorted).
-
-2005-03-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el: Don't autoload former message-utils variables.
- (message-strip-subject-trailing-was): Change doc string.
-
- * nnweb.el: Fixes for `gnus-group-make-web-group'.
- (nnweb-type-definition): Don't add "hl=en" in `address'. Add `base'.
- (nnweb-google-search): Add "hl=en" here.
- (nnweb-google-parse-1, nnweb-google-create-mapping):
- Don't hardcode URL.
-
-2005-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-get-reply-headers, message-followup):
- Mention related variables `message-use-followup-to' and
- `message-use-mail-followup-to', in the information buffer.
-
- * nnweb.el (nnweb-type-definition): Use groups.google.de instead
- of broken groups(-beta).google.com.
-
-2005-03-01 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-sum.el (gnus-summary-exit): Undo last change and fix it in
- a more conservative way.
-
-2005-02-27 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * mm-decode.el (mm-dissect-buffer): Pass the from field on to
- `mm-dissect-multipart' and receive the from field as an (optional)
- argument from `mm-dissect-multipart'.
- (mm-dissect-multipart): Receive the from field as an argument and
- pass it on when we call `mm-dissect-buffer' on MIME parts.
- Fixes verification/decryption of signed/encrypted MIME parts.
-
-2005-02-26 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-sum.el (gnus-summary-exit): Move point after displaying the
- buffer, so it moves the window's cursor.
-
-2005-02-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nnheader.el (nnheader-find-file-noselect): Add doc string.
-
- * nnfolder.el (nnfolder-read-folder): Use RAWFILE for
- `nnheader-find-file-noselect' to avoid `large-file-warning-threshold'.
-
- * gnus-sum.el (gnus-summary-caesar-message):
- Apply `gnus-treat-article' after rotation.
-
- * gnus-group.el (gnus-group-clear-data): Mention process/prefix in
- doc string.
-
-2005-02-22 Arne J
\e,Ax
\e(Brgensen <arne@arnested.dk>
-
- * smime.el (smime-sign-buffer): Signal an error if
- `smime-sign-region' fails.
- (smime-encrypt-buffer): Signal an error if `smime-encrypt-region'
- fails.
-
-2005-02-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-art.el (gnus-parse-news-url, gnus-button-handle-news):
- Handle news URL with given port correctly.
-
-2005-02-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-copy-article-buffer): Quote decoded words
- containing special characters.
-
- * gnus-sum.el (gnus-summary-edit-article): Ditto.
-
- * mml.el (mime-to-mml): Ditto.
-
- * rfc2047.el (rfc2047-quote-decoded-words-containing-tspecials):
- New variable.
- (rfc2047-decode-region): Quote decoded words containing special
- characters when rfc2047-quote-decoded-words-containing-tspecials
- is non-nil.
-
-2005-02-16 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus-registry.el (gnus-registry-delete-group): Minor bug fix.
-
- * gnus.el (gnus-install-group-spam-parameters): Doc fix.
-
-2005-02-15 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-debug): Doc fix.
-
- * imap.el (imap-debug): Doc fix.
-
-2005-02-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-group.el (gnus-group-make-doc-group): Mention prefix
- argument in doc string. Make query for type more clear.
-
-2005-02-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-group-startup-message): Search for gnus images in
- etc/images/gnus.
- * mm-util.el (mm-image-load-path): Likewise.
- * smiley.el (smiley-data-directory): Search for smilies in
- etc/images/smilies.
-
-2005-02-09 Kim F. Storm <storm@cua.dk>
-
- Change Emacs release version from 21.4 to 22.1 throughout.
- Change Emacs development version from 21.3.50 to 22.0.50.
-
-2005-02-08 Simon Josefsson <jas@extundo.com>
-
- * imap.el (imap-log): Doc fix.
-
-2005-02-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-mime-inline-part): Show the raw contents if a
- prefix arg is neither nil nor a number, as info specifies.
-
-2005-01-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-art.el (gnus-article-mode): Turn off the "\ " non-break space.
-
-2005-01-28 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * message.el (message-beginning-of-line): Change the behavior when
- invoked between BOL and : so that it first moves backward.
-
-2005-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-setup-buffer): Kill and re-create the
- article buffer when editing of the article is discarded.
- (gnus-article-prepare): Revert.
-
-2005-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-prepare):
- Remove message-strip-forbidden-properties from the local hook.
-
-2005-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mml.el (mml-generate-mime-1): Convert string into unibyte when
- inserting " *mml*" buffer's contents into a unibyte temp buffer.
-
-2005-01-20 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-insert-part): Switch the multibyteness of data
- which will be inserted according to the multibyteness of a buffer
- rather than the type of contents. Suggested by ARISAWA Akihiro
- <ari@mbf.ocn.ne.jp>.
-
-2005-01-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * spam.el (spam-face): New face. Don't use `gnus-splash-face'
- which is unreadable in some setups.
-
-2004-12-27 Simon Josefsson <jas@extundo.com>
-
- * mm-bodies.el (mm-body-encoding): Don't permit 7-bit to be used when
- mm-use-ultra-safe-encoding is enabled (e.g., for PGP/MIME) and we have
- trailing white space. Reported by Werner Koch <wk@gnupg.org>.
-
-2004-12-17 Kim F. Storm <storm@cua.dk>
-
- * gnus-group.el (gnus-group-mode-map): Map follow-link to mouse-face.
-
- * gnus-sum.el (gnus-summary-mode-map): Likewise.
-
-2004-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-spec.el (gnus-spec-tab): Make a Lisp form which works
- correctly even if there are wide characters.
-
-2004-12-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2231.el (rfc2231-parse-string): Decode encoded value after
- concatenating segments rather than before concatenating them.
- Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
-
-2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-util.el (mm-xemacs-find-mime-charset): New macro.
-
-2004-12-17 Aidan Kehoe <kehoea@parhasard.net>
-
- * mm-util.el (mm-xemacs-find-mime-charset-1): New function used to
- unify Latin characters in XEmacs.
- (mm-find-mime-charset-region): Use it.
-
-2004-12-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-util.el (gnus-delete-directory): New function.
-
- * gnus-agent.el (gnus-agent-delete-group): Use it.
-
- * gnus-cache.el (gnus-cache-delete-group): Use it.
-
-2004-12-08 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-art.el (gnus-narrow-to-page): Don't hardcode point-min.
-
-2004-12-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-group-make-rss-group):
- Use gnus-group-make-group instead of gnus-group-unsubscribe-group.
-
- * gnus-start.el (gnus-setup-news): Honor user's setting to
- gnus-message-archive-method. Suggested by Lute Kamstra
- <lute@gnu.org>.
-
-2004-12-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-forward-make-body-mml): Remove headers
- according to message-forward-ignored-headers if a message is decoded.
-
-2004-12-02 Romain Francoise <romain@orebokech.com>
-
- * message.el (message-forward-make-body-plain): Always remove
- headers according to message-forward-ignored-headers.
-
-2004-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * lpath.el: Remove bbdb-create-internal, bbdb-records,
- spam-BBDB-register-routine and spam-enter-ham-BBDB.
-
- * nnrss.el (nnrss-string-as-multibyte): Redefine it as a macro in
- order to silence the byte compiler.
-
- * pop3.el (pop3-md5): Define it before being used.
-
- * spam.el: Fix the way to silence the byte compiler, which
- complained about bbdb-buffer, bbdb-create-internal,
- bbdb-search-simple, mail-check-payment, spam-BBDB-register-routine,
- spam-enter-ham-BBDB, spam-stat-buffer-change-to-non-spam,
- spam-stat-buffer-change-to-spam, spam-stat-buffer-is-non-spam,
- spam-stat-buffer-is-spam, spam-stat-load,
- spam-stat-register-ham-routine, spam-stat-register-spam-routine,
- spam-stat-save and spam-stat-split-fancy.
-
-2004-11-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-password): Remove `:size 0' or `:size 1'
- which may confuse users.
- (canlock-password-for-verify): Ditto.
-
- * deuglify.el (gnus-outlook-deuglify-unwrap-stop-chars): Ditto.
-
- * gnus-art.el (gnus-emphasis-alist): Ditto.
-
- * gnus-registry.el (gnus-registry-max-entries): Ditto.
-
- * gnus-score.el (gnus-adaptive-word-length-limit): Ditto.
-
- * gnus-start.el (gnus-save-killed-list): Ditto.
-
- * gnus-sum.el (gnus-thread-hide-subtree): Ditto.
- (gnus-sum-thread-tree-root): Ditto.
- (gnus-sum-thread-tree-false-root): Ditto.
- (gnus-sum-thread-tree-single-indent): Ditto.
-
- * message.el (message-courtesy-message): Ditto.
- (message-archive-note): Ditto.
- (message-subscribed-address-file): Ditto.
- (message-user-fqdn): Ditto.
-
- * spam-report.el (spam-report-gmane-regex): Ditto.
-
- * spam.el (spam-blackhole-good-server-regex): Ditto.
-
-2004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-forbidden-properties): Fix typo in doc string.
-
-2004-11-25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-strip-forbidden-properties):
- Bind buffer-read-only (etc) to nil.
-
-2004-11-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-util.el (gnus-replace-in-string): Add doc string.
-
- * nnmail.el (nnmail-split-header-length-limit): Increase to 2048
- to avoid problems when splitting mails with many recipients.
-
-2004-11-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * rfc2047.el (rfc2047-header-encoding-alist): Add In-Reply-To to
- address-mime. Suggested by ARISAWA Akihiro <ari@mbf.ocn.ne.jp>.
-
-2004-11-22 Marek Martin <marek.martin@mum.pri.ee> (tiny change)
-
- * nnfolder.el (nnfolder-request-create-group): Save current buffer.
-
-2004-11-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-sum.el (gnus-summary-exit): Remove redundant and harmful
- pop-to-buffer, covered by the subsequent gnus-configure-windows.
-
-2004-11-14 Luc Teirlinck <teirllm@auburn.edu>
-
- * nnfolder.el (nnfolder-save-marks): Add missing format field in
- call to `error'.
- * nnml.el (nnml-save-marks): Ditto.
-
-2004-11-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-version-number): Bump version to 5.10.7.
-
- * gnus-start.el (gnus-convert-old-newsrc):
- Assign legacy-gnus-agent to 5.10.7.
-
-2004-11-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-emphasis-alist): Don't hide asterisks by
- default; improve customization type.
- (gnus-emphasis-custom-with-format): New macro.
- (gnus-emphasis-custom-value-to-external): New function.
- (gnus-emphasis-custom-value-to-internal): New function.
-
-2004-11-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Don't cause the
- "Args out of range" error. Reported by Arnaud Giersch
- <arnaud.giersch@free.fr>.
-
-2004-11-04 Richard M. Stallman <rms@gnu.org>
-
- * spam.el (spam group): Add :version.
-
- * pgg-def.el (pgg group): Add :version.
-
-2004-11-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-edit-article): Don't associate the
- article buffer with a draft file. This is a temporary measure
- against the 2004-08-22 change to gnus-article-edit-mode.
-
-2004-11-02 Ilya N. Golubev <gin@mo.msk.ru>.
-
- * mm-util.el (mm-mime-mule-charset-alist): Add the windows-1251
- entry.
-
-2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * html2text.el (html2text-get-attr): Remove unused argument `tag'.
- (html2text-format-tags): Remove unused variable `attr'.
-
- * mm-util.el (mm-enrich-utf-8-by-mule-ucs): Fix cleaning of
- after-load-alist.
-
- * mm-util.el (mm-enrich-utf-8-by-mule-ucs): New function run when
- Mule-UCS is loaded under XEmacs.
- (mm-mime-mule-charset-alist): Avoid duplicated entries.
-
- * mm-util.el (mm-coding-system-p): Return a coding-system.
- (mm-mime-mule-charset-alist): Use shift_jis instead of
- iso-2022-jp-2 for the katakana-jisx0201 mule charset; add new
- entries for the mime charsets iso-2022-jp-3 and shift_jis.
- (mm-coding-system-priorities): Use shift_jis and iso-8859-1
- instead of japanese-shift-jis and iso-latin-1 respectively in
- order to share the default value with both Emacs and XEmacs-mule.
- (mm-mule-charset-to-mime-charset):
- Make mm-coding-system-priorities effective.
- (mm-sort-coding-systems-predicate): Canonicalize coding-systems
- while predicating of candidates upon the priorities.
-
-2004-11-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-summary-resend-default-address): Add :version.
-
- * tls.el (tls-process-connection-type, tls-success)
- (tls-certtool-program): Add :version.
-
- * starttls.el (starttls-gnutls-program, starttls-use-gnutls)
- (starttls-extra-arguments, starttls-process-connection-type)
- (starttls-connect, starttls-failure, starttls-success):
-
- * spam-stat.el (spam-stat): Add :version.
-
- * sieve.el (sieve): Add :version.
-
- * sha1.el (sha1): Add :version.
- (sha1-use-external): Remove redundant version.
-
- * nnmail.el (nnmail-split-fancy-with-parent-ignore-groups)
- (nnmail-cache-ignore-groups, nnmail-spool-hook)
- (nnmail-split-fancy-match-partial-words)
- (nnmail-split-lowercase-expanded): Add :version.
-
- * nndiary.el (nndiary): Add :version.
-
- * mml2015.el (mml2015-unabbrev-trust-alist): Add :version.
-
- * mml-sec.el (mml-default-sign-method)
- (mml-default-encrypt-method, mml-signencrypt-style-alist):
- Add :version.
-
- * mm-uu.el (mm-uu-diff-groups-regexp): Add :version.
-
- * mm-url.el (mm-url-use-external, mm-url-program)
- (mm-url-arguments): Add :version.
-
- * mm-decode.el (mm-inline-text-html-with-w3m-keymap)
- (mm-attachment-file-modes, mm-decrypt-option)
- (mm-w3m-safe-url-regexp): Add :version.
-
- * message.el (message-cite-prefix-regexp)
- (message-sendmail-envelope-from, message-minibuffer-local-map)
- (message-user-fqdn, message-completion-alist): Add :version.
-
- * gnus-win.el (gnus-configure-windows-hook)
- (gnus-use-frames-on-any-display): Add :version.
-
- * gnus-art.el (gnus-article-address-banner-alist)
- (gnus-treat-unsplit-urls, gnus-treat-unfold-headers)
- (gnus-treat-from-picon, gnus-treat-mail-picon)
- (gnus-treat-x-pgp-sig): Add :version.
-
- * gnus-sum.el (gnus-spam-mark, gnus-recent-mark)
- (gnus-undownloaded-mark, gnus-summary-article-move-hook)
- (gnus-summary-article-delete-hook)
- (gnus-summary-display-while-building): Add :version.
-
- * gnus-start.el (gnus-subscribe-newsgroup-hooks)
- (gnus-get-top-new-news-hook):Add :version.
-
- * gnus-srvr.el (gnus-server-agent-face, gnus-server-opened-face)
- (gnus-server-closed-face, gnus-server-denied-face): Add :version.
-
- * gnus-registry.el (gnus-registry): Add :version.
-
- * gnus-spec.el (gnus-use-correct-string-widths)
- (gnus-make-format-preserve-properties): Add :version.
-
- * gnus.el (gnus-group-charter-alist)
- (gnus-group-fetch-control-use-browse-url)
- (gnus-install-group-spam-parameters): Add :version.
-
- * gnus-diary.el (gnus-diary): Add :version.
-
- * gnus-delay.el (gnus-delay): Add :version.
-
- * gnus-cite.el (gnus-cite-unsightly-citation-regexp)
- (gnus-cite-ignore-quoted-from, gnus-cite-attribution-face)
- (gnus-cite-blank-line-after-header, gnus-article-boring-faces):
- Add :version.
-
- * gnus-agent.el (gnus-agent-max-fetch-size)
- (gnus-agent-enable-expiration, gnus-agent-queue-mail)
- (gnus-agent-prompt-send-queue): Add :version.
-
- * deuglify.el (gnus-outlook-deuglify): Add :version.
-
- * html2text.el: Beautify code. Improve doc strings. Some
- checkdoc cleanup.
- (html2text-get-attr, html2text-fix-paragraph): Simplify code.
-
-2004-11-01 Alfred M. Szmidt <ams@kemisten.nu> (tiny change)
-
- * html2text.el (html2text-format-tag-list): Add "strong" and "em".
-
-2004-10-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-msg.el (gnus-configure-posting-styles): Work with empty
- signature file. Suggested by Manoj Srivastava
- <srivasta@golden-gryphon.com>.
-
- * mm-util.el (mm-coding-system-priorities): Prefer iso-8859-1 than
- iso-2022-jp even in the Japanese language environment.
- Suggested by Jason Rumney <jasonr@gnu.org>.
-
-2004-10-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-update-summary-mark-positions): Allow users to
- use the same characters as the dummy marks; make it free from
- getting affected by the language environment.
- (gnus-summary-read-group-1): Update mark positions only when the
- format spec is updated.
-
- * gnus-spec.el (gnus-update-format-specifications): Return a list
- of updated types.
-
-2004-10-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * nnspool.el (nnspool-spool-directory): Use news-path if the
- news-directory variable is not bound.
-
- * gnus-group.el (gnus-group-line-format-alist): Convert the value
- of gnus-tmp-news-method into string if it may be passed to
- gnus-correct-length which takes only a string argument.
-
-2004-10-25 Reiner Steib <Reiner.Steib@gmx.de>
-
- * html2text.el (html2text-buffer-head): Remove. Use `goto-char'
- instead.
-
-2004-10-24 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-start.el (gnus-convert-old-newsrc): Fix numeric
- comparison on string.
-
-2004-10-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-view.el (mm-display-inline-fontify): Inhibit font-lock when
- running the major-mode function.
-
-2004-10-21 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-start.el (gnus-convert-old-newsrc): Two of the converters
- have been backported to 'Gnus v5.11' from 'No Gnus v0.2'. Added a
- boolean check to not apply converters that apply to future
- versions of gnus.
-
-2004-10-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-update-summary-mark-positions): Search for
- dummy marks in the right way.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * nnagent.el (nnagent-request-type): Bind gnus-agent to nil to
- avoid infinite recursion via gnus-get-function.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-synchronize-group-flags):
- When necessary, pass full group name to gnus-request-set-marks.
- (gnus-agent-synchronize-group-flags): Add support for sync'ing
- tick marks.
- (gnus-agent-synchronize-flags-server): Be silent when writing file.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-synchronize-group-flags):
- Replace gnus-request-update-info with explicit code to sync the
- in-memory info read flags with the marks being sync'd to the backend.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-possibly-synchronize-flags): Ignore servers
- that are offline. Avoids having gnus-agent-toggle-plugged first ask if
- you want to open a server and then, even when you responded with no,
- asking if you want to synchronize the server's flags.
- (gnus-agent-synchronize-flags-server): Rewrite read loop to handle
- multi-line expressions.
- (gnus-agent-synchronize-group-flags): New internal function.
- Updates marks in memory (in the info structure) AND in the backend.
- (gnus-agent-check-overview-buffer): Fix range of
- deletion to remove entire duplicate line. Fixes merged article
- number bug.
-
- * gnus-util.el (gnus-remassoc): Fix typo in documentation.
-
- * nnagent.el (nnagent-request-set-mark):
- Use gnus-agent-synchronize-group-flags, not backend's request-set-mark
- method, to ensure that synchronization updates marks in the
- backend and in the info (in memory) structure.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-synchronize-flags-server): Do nothing
- unless plugged. Disable the agent so that an open failure causes
- an error.
-
-2004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-agent.el (gnus-agent-fetched-hook): Add :version.
- (gnus-agent-go-online): Change :version.
- (gnus-agent-expire-unagentized-dirs)
- (gnus-agent-auto-agentize-methods): Add :version.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * legacy-gnus-agent.el
- (gnus-agent-convert-to-compressed-agentview-prompt):
- New function. Used internally to only display 'gnus converting
- files' message when actually necessary.
-
- * gnus-sum.el: Remove (require 'gnus-agent) as required
- methods now autoloaded.
-
- * gnus-int.el (gnus-request-move-article):
- Use gnus-agent-unfetch-articles in place of gnus-agent-expire to
- improve performance.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-cat-groups): Rewrite avoiding defsetf
- to avoid run-time CL dependencies.
- (gnus-agent-unfetch-articles): New function.
- (gnus-agent-fetch-headers): Use gnus-agent-braid-nov to validate
- article numbers even when local .overview file is missing.
- (gnus-agent-read-article-number): New function. Only accepts
- 27-bit article numbers.
- (gnus-agent-copy-nov-line, gnus-agent-uncached-articles):
- Use gnus-agent-read-article-number.
- (gnus-agent-braid-nov): Rewrote to validate article numbers coming
- from backend while recognizing that article numbers in .overview
- must be valid.
-
- * gnus-start.el (gnus-convert-old-newsrc): Change message text as
- some users confused by references to .newsrc when they only have a
- .newsrc.eld file.
- (gnus-convert-mark-converter-prompt)
- (gnus-convert-converter-needs-prompt): Fix use of property list.
-
-2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
-
-2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-start.el (gnus-get-unread-articles-in-group): Don't do
- stuff for non-living groups.
-
-2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-synchronize-flags): Default to nil.
- (gnus-agent-regenerate-group): Using nil messages aren't valid.
-
-2004-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-agent.el (gnus-agent-read-agentview):
- Inline gnus-uncompress-range.
-
-2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * legacy-gnus-agent.el
- (gnus-agent-convert-to-compressed-agentview): Fix typos with
- help from Florian Weimer <fw@deneb.enyo.de>
-
- * gnus-agent.el (gnus-agentize):
- gnus-agent-send-mail-real-function no longer set to current value
- of message-send-mail-function but rather a lambda that calls
- message-send-mail-function. The change makes the agent real-time
- responsive to user changes to message-send-mail-function.
-
-2004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-start.el (gnus-get-unread-articles): Fix last commit.
-
-2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-cache.el (gnus-cache-rename-group): New function.
- (gnus-cache-delete-group): New function.
-
- * gnus-agent.el (gnus-agent-rename-group): New function.
- (gnus-agent-delete-group): New function.
- (gnus-agent-save-group-info): Use gnus-command-method when
- `method' parameter is nil. Don't write nil entries into the
- active file.
- (gnus-agent-get-group-info): New function.
- (gnus-agent-get-local): Add optional parameters to avoid calling
- gnus-group-real-name and gnus-find-method-for-group.
- (gnus-agent-set-local): Delete stored entry if either min, or max,
- are nil.
- (gnus-agent-fetch-session): Reword error/quit messages.
- On quit, use gnus-agent-regenerate-group to record existance of any
- articles fetched to disk before the quit occurred.
-
- * gnus-int.el (gnus-request-delete-group):
- Use gnus-cache-delete-group and gnus-agent-delete-group to keep the
- local disk in sync with the server.
- (gnus-request-rename-group):
- Use gnus-cache-rename-group and gnus-agent-rename-group to keep the
- local disk in sync with the server.
-
- * gnus-start.el (gnus-get-unread-articles):
- Cosmetic simplification to logic.
-
- * gnus-group.el (gnus-group-delete-group): No longer update
- gnus-cache-active-altered as gnus-request-delete-group now keeps
- the cache in sync.
- (gnus-group-list-active): Let the agent store a server's active
- list if currently plugged.
-
- * gnus-util.el (gnus-rename-file): New function.
-
-2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
- when the group's active is not available.
-
-2004-10-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-read-agentview): Add a missing arg to
- error.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-start.el (gnus-convert-old-newsrc): Only write the conversion
- message to newsrc-dribble when an actual conversion is performed.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-agent.el (gnus-agent-read-local):
- Bind nnheader-file-coding-system to gnus-agent-file-coding-system to
- avoid the implicit assumption that they will always be equal.
- (gnus-agent-save-local): Bind buffer-file-coding-system, not
- coding-system-for-write, as the with-temp-file macro first prints
- to a buffer then saves the buffer.
-
-2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * legacy-gnus-agent.el (): New. Provides converters that are only
- loaded when gnus-convert-old-newsrc needs to call them.
-
- * gnus-agent.el (gnus-agent-read-agentview): Remove support for
- old file versions.
- (gnus-group-prepare-hook): Remove function that converted list
- form of gnus-agent-expire-days to group properties.
-
- * gnus-start.el (gnus-convert-old-newsrc): Register new
- converters to handle old agent file formats. Added logic for a
- "backup before upgrading warning".
- (gnus-convert-mark-converter-prompt): Developers can mark
- functions as needing (default), or not needing,
- gnus-convert-old-newsrc's "backup before upgrading warning".
- (gnus-convert-converter-needs-prompt): Tests whether the user
- should be protected from potentially irreversable changes by the
- function.
-
-2004-10-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-int.el (gnus-request-accept-article): Inform the agent that
- articles are being added to a group.
- (gnus-request-replace-article): Inform the agent that articles
- need to be uncached as the cached contents are no longer valid.
-
- * gnus-agent.el (gnus-agent-file-header-cache): Remove.
- (gnus-agent-possibly-alter-active): Avoid null in numeric comparison.
- (gnus-agent-set-local): Refuse to save null in local object table.
- (gnus-agent-regenerate-group): The REREAD parameter can now be a
- list of articles that will be marked as unread.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-range.el (gnus-sorted-range-intersection): Now accepts
- single-interval range of the form (min . max). Previously the
- range had to look like ((min . max)). Likewise, return
- (min . max) rather than ((min . max)).
- (gnus-range-map): Use gnus-range-normalize to accept
- single-interval range.
-
- * gnus-sum.el (gnus-summary-highlight-line): Articles stored in
- the cache, but not the agent, now appear with their usual face.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-sum.el (gnus-adjust-marks): Now correctly handles a list of
- marks consisting of a single range {for example, (3 . 5)} rather
- than a list of a single range { ((3 . 5)) }.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-sum.el (gnus-adjust-marks): Avoid splicing null INTO the
- uncompressed list.
-
-2004-10-18 Kevin Greiner <kevin.greiner@compsol.cc>
-
- * gnus-draft.el (gnus-group-send-queue): Pass the group name
- "nndraft:queue" along to gnus-draft-send.
- Use gnus-agent-prompt-send-queue.
- (gnus-draft-send): Rebind gnus-agent-queue-mail to nil when group
- is "nndraft:queue". Suggested by Gaute Strokkenes
- <gs234@srcf.ucam.org>
-
- * gnus-group.el (gnus-group-catchup): Use new
- gnus-sequence-of-unread-articles, not
- gnus-list-of-unread-articles, to avoid exhausting memory with huge
- numbers of articles. Use gnus-range-map to avoid having to
- uncompress the unread list.
- (gnus-group-archive-directory)
- (gnus-group-recent-archive-directory): Fix invalid ange-ftp reference.
-
- * gnus-range.el (gnus-range-map): Iterate over list or sequence.
- (gnus-sorted-range-intersection): Intersection of two ranges
- without requiring that they first be uncompressed.
-
- * gnus-start.el (gnus-activate-group): Unless blocked by the
- caller, possibly expand the active range to include both cached
- and agentized articles.
- (gnus-convert-old-newsrc): Rewrote in anticipation of having
- multiple version-dependent converters.
- (gnus-groups-to-gnus-format): Replace gnus-agent-save-groups with
- gnus-agent-save-active.
- (gnus-save-newsrc-file): Save dirty agent range limits.
-
- * gnus-sum.el (gnus-select-newgroup): Replace inline code with
- gnus-agent-possibly-alter-active.
- (gnus-adjust-marked-articles): Faster handling of simple lists.
-
-2004-10-18 David Edmondson <dme@dme.org>
-
- * mm-view.el (mm-w3m-cid-retrieve-1): Don't use recursive call
- excessively.
-
-2004-10-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mml.el (mml-preview): Use `pop-to-buffer'.
-
- * message.el (message-goto-mail-followup-to): Insert after "To".
- (message-carefully-insert-headers): Add comment.
-
- * gnus-sum.el (gnus-summary-make-menu-bar): Add help texts.
-
- * gnus-art.el (gnus-button-alist):
- Improve `gnus-button-handle-library' entry.
-
- * gnus-art.el (gnus-button-alist): Fix regexp for manual links.
-
- * gnus-group.el (gnus-group-get-new-news-this-group): Add doc-string.
-
- * gnus-start.el (gnus-activate-group): Add doc-string.
-
- * gnus-art.el (gnus-button-handle-man, gnus-button-alist): Try to
- handle manual section.
-
- * imap.el (imap-store-password): New variable.
- (imap-interactive-login): Use it.
- Suggested by Mark Plaksin <happy@mcplaksin.org>.
-
- * gnus-art.el (gnus-button-alist, gnus-header-button-alist):
- Allow / in mailto URLs.
-
- * spam.el (spam-directory): Derive from `gnus-directory'.
-
- * gnus-sum.el (gnus-pick-line-number): Add autoload.
-
-2004-10-17 Richard M. Stallman <rms@gnu.org>
-
- * gnus-registry.el (gnus-registry-unload-hook):
- Set as a variable with add-hook.
-
- * nnspool.el (nnspool-spool-directory): Use news-directory instead
- of news-path.
-
- * spam-stat.el (spam-stat-unload-hook): Set as a variable w/ add-hook.
-
- * spam.el: Delete duplicate `provide'.
- (spam-unload-hook): Set as a variable with add-hook.
-
-2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * pop3.el (pop3-leave-mail-on-server): Describe possible problems
- in the doc string.
-
- * message.el (message-ignored-news-headers)
- (message-ignored-supersedes-headers)
- (message-ignored-resent-headers)
- (message-forward-ignored-headers): Improve custom type.
-
-2004-10-15 Simon Josefsson <jas@extundo.com>
-
- * pop3.el (top-level): Don't require nnheader.
- (pop3-read-timeout): Add.
- (pop3-accept-process-output): Add.
- (pop3-read-response, pop3-retr): Use it.
-
-2004-10-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-tokenize-header): Fix 2004-09-06 change
- which used point-min in the wrong place.
-
-2004-10-12 Simon Josefsson <jas@extundo.com>
-
- * tls.el (tls-certtool-program): New variable.
- (tls-certificate-information): New function, based on
- ssl-certificate-information.
-
-2004-10-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-bury): Use `window-dedicated-p'.
-
-2004-10-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el: Mention that multibyte characters don't work as marks.
-
- * gnus.el (message-y-or-n-p): Autoload.
-
- * pop3.el (pop3-maildrop, pop3-mailhost, pop3-port)
- (pop3-password-required, pop3-authentication-scheme)
- (pop3-leave-mail-on-server): Made customizable.
- (pop3): New custom group.
- (pop3-retr): Remove `sleep-for' statements.
- Suggested by Dave Love <fx@gnu.org>.
-
- * nnheader.el (nnheader-read-timeout): Explain 1.0 timeout for
- Windows/DOS.
-
- * imap.el (imap-parse-flag-list, imap-parse-body-extension)
- (imap-parse-body): Fix incorrect use of `assert'. Suggested by
- Dave Love <fx@gnu.org>.
-
- * mml.el (mml-minibuffer-read-disposition): Require match.
- Suggested by Dave Love <fx@gnu.org>.
-
-2004-10-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-group.el (gnus-update-group-mark-positions):
- * gnus-sum.el (gnus-update-summary-mark-positions):
- * message.el (message-check-news-body-syntax):
- * gnus-msg.el (gnus-debug): Use mm-string-as-multibyte instead
- of string-as-multibyte.
-
- * gnus-sum.el (gnus-summary-insert-subject): Remove redundant setq.
-
-2004-10-05 Juri Linkov <juri@jurta.org>
-
- * gnus-group.el (gnus-update-group-mark-positions):
- * gnus-sum.el (gnus-update-summary-mark-positions):
- * message.el (message-check-news-body-syntax):
- * gnus-msg.el (gnus-debug): Use `string-as-multibyte' to convert
- 8-bit unibyte values to a multibyte string for search functions.
-
-2004-10-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-toggle-header): Make it work even if
- there's no visible header.
-
-2004-10-01 Simon Josefsson <jas@extundo.com>
-
- * mailcap.el (mailcap-mime-data): Add pdf. Remove non-free
- acroread.
-
-2004-09-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.el (gnus-method-to-server): Oops, move it don't delete it.
-
-2004-09-28 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-picon.el: Require cl.
-
- * mml-sec.el (mml-signencrypt-style): Don't depend on Gnus.
-
- * mml-smime.el: Require cl. Autoload message-fetch-field.
-
- * gnus-fun.el: Require gnus-ems and gnus-util.
-
- * gnus-diary.el (gnus-diary-header-schedule): caddr -> car (cddr).
-
- * gnus-art.el (gnus-article-edit-mode): Define before first reference.
-
- * gnus.el (gnus-method-to-server): Move defsubst before first use.
-
- * spam.el (spam-check-spamoracle, spam-spamoracle-learn):
- Fix format string mismatch.
- * nnml.el (nnml-request-set-mark, nnml-save-marks): Do.
- * nnfolder.el (nnfolder-request-set-mark, nnfolder-save-marks): Do.
-
-2004-09-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-copy-to-buffer): Don't use set-buffer-multibyte.
-
-2004-09-26 Christian Neukirchen <chneukirchen@yahoo.de> (tiny change)
-
- * mm-util.el (mm-image-load-path): Handle nil in load-path.
-
-2004-09-26 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-msg.el (gnus-post-news): Use blank Newsgroups line if
- GROUP is a virtual group.
-
- * mm-util.el (mm-charset-synonym-alist): Remove obsolete entries
- for big5 and gb2312.
-
- * rfc2047.el (rfc2047-pad-base64): Deal with more cases of invalid
- padding.
-
- * mm-bodies.el (mm-7bit-chars): Don't include \r.
-
- * mml.el (mml-compute-boundary-1): Don't uncompress files.
-
- * rfc2047.el (rfc2047-qp-or-base64): New function to reduce
- dependencies.
- (rfc2047-encode): Use it.
-
- * flow-fill.el: Typo.
-
- * mml.el (mml-generate-mime-1): Don't use format=flowed with
- inline PGP.
-
- * gnus.el (gnus-getenv-nntpserver): Strip whitespace.
-
- * gnus-cache.el (gnus-cache-save-buffers): Check if buffer is
- alive. Reported by Laurent Martelli <laurent@aopsys.com>.
-
- * html2text.el (html2text-replace-list): Add & and '.
-
- * nnheader.el (nnheader-max-head-length): Increase to 8192.
-
- * message.el (message-clone-locals): Clone sendmail and smtp
- variables.
-
-2004-09-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-configure-posting-styles): Narrow to headers
- in `header' match. Reported by Svend Tollak Munkejord.
-
-2004-09-20 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * mm-decode.el (mm-copy-to-buffer): Preserve the data's unibyteness.
-
-2004-09-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * uudecode.el (uudecode-use-external): Add :version.
-
- * smime.el (smime-CA-file, smime-encrypt-cipher)
- (smime-dns-server): Add :version.
-
- * smiley.el (gnus-smiley-file-types): Add :version.
-
- * sha1.el (sha1-use-external): Add :version.
-
- * pgg-def.el (pgg-query-keyserver): Add :version.
-
- * nnmail.el (nnmail-fancy-expiry-targets)
- (nnmail-mail-splitting-charset, nnmail-mail-splitting-decodes):
- Add :version.
-
- * nnimap.el (nnimap-split-download-body, nnimap-dont-close)
- (nnimap-retrieve-groups-asynchronous): Add :version.
- (nnimap-close-asynchronous): Add :version. Fixed typo in doc string.
-
- * mml.el (mml-content-disposition-parameters)
- (mml-insert-mime-headers-always): Add :version.
-
- * mm-util.el (mm-coding-system-priorities): Add :version.
-
- * mm-decode.el (mm-inline-text-html-with-images)
- (mm-keep-viewer-alive-types, mm-external-terminal-program)
- (mm-verify-option): Add :version.
- (mm-text-html-renderer): Change :version.
-
- * message.el (message-fcc-externalize-attachments)
- (message-required-headers, message-draft-headers)
- (message-subject-trailing-was-query)
- (message-subject-trailing-was-ask-regexp)
- (message-subject-trailing-was-regexp, message-mark-insert-begin)
- (message-mark-insert-end, message-archive-header)
- (message-archive-note, message-cross-post-default)
- (message-cross-post-note, message-followup-to-note)
- (message-cross-post-note-function, message-use-mail-followup-to)
- (message-subscribed-address-functions)
- (message-subscribed-address-file, message-subscribed-addresses)
- (message-subscribed-regexps, message-allow-no-recipients)
- (message-yank-cited-prefix, message-signature-insert-empty-line)
- (message-hidden-headers, message-hierarchical-addresses)
- (message-mail-user-agent, message-use-idna)
- (message-valid-fqdn-regexp)
- (message-strip-special-text-properties, message-header-synonyms)
- (message-beginning-of-line, message-tab-body-function): Add :version.
- (message-insert-canlock, message-wide-reply-confirm-recipients):
- Change :version.
-
- * mail-source.el (mail-source-ignore-errors): Add :group, :type
- and :version.
- (mail-source-delete-old-incoming-confirm)
- (mail-source-movemail-program): Add :version.
-
- * gnus.el (gnus-parameters, gnus-user-agent): Add :version.
- (gnus-agent-cache, gnus-agent): Change :version.
-
- * gnus-util.el (gnus-use-byte-compile): Change :version.
-
- * gnus-sum.el (gnus-summary-make-false-root-always)
- (gnus-summary-default-high-score)
- (gnus-summary-default-low-score, gnus-auto-goto-ignores)
- (gnus-forwarded-mark, gnus-unseen-mark, gnus-no-mark)
- (gnus-read-all-available-headers, gnus-article-emulate-mime)
- (gnus-sum-thread-tree-root, gnus-sum-thread-tree-false-root)
- (gnus-sum-thread-tree-single-indent)
- (gnus-sum-thread-tree-vertical, gnus-sum-thread-tree-indent)
- (gnus-sum-thread-tree-leaf-with-other)
- (gnus-sum-thread-tree-single-leaf): Add :version.
- (gnus-summary-display-arrow, gnus-summary-muttprint-program)
- (gnus-article-loose-mime): Change :version.
-
- * gnus-start.el (gnus-backup-startup-file)
- (gnus-save-startup-file-via-temp-buffer): Add :version.
-
- * gnus-srvr.el (gnus-server-browse-in-group-buffer)
- (gnus-server-offline-face): Add :version.
-
- * gnus-score.el (gnus-adaptive-word-length-limit): Add :version.
-
- * gnus-msg.el (gnus-gcc-externalize-attachments)
- (gnus-debug-files, gnus-debug-exclude-variables)
- (gnus-discouraged-post-methods): Change :version.
- (gnus-confirm-mail-reply-to-news)
- (gnus-confirm-treat-mail-like-news): Add :version.
-
- * gnus-int.el (gnus-server-unopen-status): Add :version.
-
- * gnus-group.el (gnus-group-jump-to-group-prompt)
- (gnus-large-ephemeral-newsgroup)
- (gnus-fetch-old-ephemeral-headers): Add :version.
-
- * gnus-fun.el (gnus-x-face-directory)
- (gnus-convert-pbm-to-x-face-command)
- (gnus-convert-image-to-x-face-command)
- (gnus-convert-image-to-face-command): Add :version.
-
- * gnus-delay.el (gnus-delay-default-hour): Add :version.
-
- * gnus-cite.el (gnus-cite-blank-line-after-header)
- (gnus-article-boring-faces): Add :version.
-
- * gnus-art.el (gnus-buttonized-mime-types)
- (gnus-inhibit-mime-unbuttonizing)
- (gnus-treat-display-face)
- (gnus-treat-body-boundary): Change :version.
- (gnus-body-boundary-delimiter, gnus-picon-databases)
- (gnus-treat-strip-cr, gnus-treat-leading-whitespace)
- (gnus-treat-date-english, gnus-treat-fold-headers)
- (gnus-article-skip-boring, gnus-treat-fold-newsgroups)
- (gnus-treat-mail-picon, gnus-treat-wash-html)
- (gnus-article-encrypt-protocol)
- (gnus-use-idna, gnus-article-over-scroll)
- (gnus-mime-display-multipart-alternative-as-mixed)
- (gnus-mime-display-multipart-related-as-mixed)
- (gnus-button-valid-fqdn-regexp, gnus-button-man-handler)
- (gnus-ctan-url, gnus-button-ctan-handler)
- (gnus-button-handle-ctan-bogus-regexp)
- (gnus-button-ctan-directory-regexp)
- (gnus-button-mid-or-mail-regexp, gnus-button-prefer-mid-or-mail)
- (gnus-button-mid-or-mail-heuristic-alist, gnus-button-tex-level)
- (gnus-button-man-level, gnus-button-emacs-level)
- (gnus-button-message-level, gnus-button-browse-level): Add :version.
-
- * gnus-agent.el (gnus-agent-fetched-hook): Add :version.
- (gnus-agent-go-online): Change :version.
- (gnus-agent-expire-unagentized-dirs)
- (gnus-agent-auto-agentize-methods): Add :version.
-
- * flow-fill.el (fill-flowed-display-column)
- (fill-flowed-encode-column): Add :version.
-
- * deuglify.el (gnus-outlook-deuglify-unwrap-min)
- (gnus-outlook-deuglify-unwrap-max)
- (gnus-outlook-deuglify-cite-marks)
- (gnus-outlook-deuglify-unwrap-stop-chars)
- (gnus-outlook-deuglify-no-wrap-chars)
- (gnus-outlook-deuglify-attrib-cut-regexp)
- (gnus-outlook-deuglify-attrib-verb-regexp)
- (gnus-outlook-deuglify-attrib-end-regexp)
- (gnus-outlook-display-hook): Add :version.
-
- * binhex.el (binhex-use-external): Add :version.
-
-2004-09-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-fetch-old-headers): Add custom choices `t'
- and `invisible'.
-
-2004-09-13 Simon Josefsson <jas@extundo.com>
-
- * nnimap.el (nnimap-demule): Revert 2004-08-30 change.
-
-2004-09-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-sum.el (gnus-summary-copy-article): Fix doc string.
-
-2004-09-10 Miles Bader <miles@gnu.ai.mit.edu>
-
- * nnimap.el (nnimap-open-connection): Remove extraneous end-paren.
-
-2004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * nnimap.el (nnimap-open-connection): Allow 'imaps' as a synonym
- for the 'imap' port in netrc files.
-
- * gnus-registry.el (gnus-registry-trim): Watch out for negatives
- in gnus-registry-trim.
-
-2004-09-10 Simon Josefsson <jas@extundo.com>
-
- * nndb.el (require): Remove tcp and duplicate cl.
-
-2004-09-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * nntp.el (nntp): New customization group.
- (nntp-authinfo-file): Add customization group.
-
- * mml2015.el (mml2015-unabbrev-trust-alist): Add customization group.
-
- * mml-sec.el (mml-signencrypt-style-alist): Ditto.
-
- * gnus.el (to-address, to-list, subscribed)
- (large-newsgroup-initial): Ditto.
-
- * flow-fill.el (fill-flowed-display-column)
- (fill-flowed-encode-column): Ditto.
-
-2004-09-06 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * message.el (message-tokenize-header, message-send-mail-with-qmail):
- Use point-min rather than 1.
- (message-send-mail): Use buffer-size rather than point-max.
-
- * gnus-sum.el (gnus-summary-search-article-forward):
- Signal a specific `search-failed' rather than a generic `error'.
-
- * gnus-salt.el (gnus-pick-mouse-pick-region): Switch 1 => point-min.
- (gnus-generate-vertical-tree): Usue `bobp' rather than compare to 1.
- (gnus-highlight-selected-tree): Use point-min rather than 1 and 2.
-
-2004-09-03 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-sum.el (gnus-summary-insert-subject): Remove list identifiers.
-
-2004-09-03 Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp> (tiny change)
-
- * spam-stat.el (spam-stat-reduce-size): Set spam-stat-dirty.
- (spam-stat-save): Accept prefix argument.
-
-2004-09-01 Simon Josefsson <jas@extundo.com>
-
- * message.el (message-canlock-generate): Require sha1, not
- sha1-el. (Can we get rid of this require alltogheter? It is ugly
- to require within a function. Sadly, if sha1.el isn't loaded, the
- let binding in m-c-g will hide the defcustom definition, which is
- bad.)
-
- * canlock.el: Require sha1, not sha1-el.
-
- * message.el: Don't autoload sha1 (there is a autoload cookie in
- sha1.el).
-
- * sha1-el.el: Renamed to sha1.el.
-
-2004-05-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * pgg-pgp.el (pgg-pgp-verify-region): Clean up.
-
-2004-05-19 Michael Schierl <schierlm-usenet@gmx.de> (tiny change)
-
- * pgg-pgp.el (pgg-pgp-verify-region): Default when signature
- isn't a string.
-
-2004-03-05 Jesper Harder <harder@ifa.au.dk>
-
- * sha1-el.el (sha1-maximum-internal-length): Doc fix.
-
-2004-03-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el: Don't autoload mail-fetch-field.
-
-2004-01-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (base64-encode-string): Don't autoload it.
-
-2004-01-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el: Always require sha1-el.
- (canlock-sha1): Bind sha1-maximum-internal-length to nil.
-
-2004-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.el (message-canlock-generate): Require sha1-el.
-
-2004-01-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-insert-header): Remove excessive grouping in
- regexp.
-
-2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * sha1-el.el (sha1-string-external): Use with-temp-buffer.
-
-2004-01-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * canlock.el (canlock-sha1-function): Remove.
- (canlock-sha1-function-for-verify): Remove.
- (canlock-openssl-program): Remove.
- (canlock-openssl-args): Remove.
- (canlock-ignore-errors): Remove.
- (canlock-sha1-with-openssl): Remove.
- (canlock-sha1): Use sha1 instead of to call canlock-sha1-function.
- (canlock-verify): Don't use canlock-ignore-errors.
-
- * sha1-el.el (sha1-string-external): Make it can return a string
- in binary form.
- (sha1-region-external): Ditto.
- (sha1-string-internal): Ditto.
- (sha1-region-internal): Ditto.
- (sha1-region): Ditto.
- (sha1-string): Ditto.
- (sha1): Ditto.
-
-2003-11-15 Simon Josefsson <jas@extundo.com>
-
- * pgg-gpg.el (pgg-gpg-lookup-all-secret-keys)
- (pgg-gpg-lookup-key): Use regexp match instead of
- split-string (split-string is different between emacs 21.2 and
- 22.1). Reported by ultrasoul@ultrasoul.com (David D. Smith).
-
-2004-07-28 Simon Josefsson <jas@extundo.com>
-
- * pgg-pgp5.el (pgg-pgp5-encrypt-region): Accept sign
- parameter (but don't use it, for now).
-
-2004-02-03 Jesper Harder <harder@ifa.au.dk>
-
- * sieve.el (sieve-deactivate-all): Fix format string mismatch.
-
-2004-05-26 Simon Josefsson <jas@extundo.com>
-
- * starttls.el: Merge with my GNUTLS based starttls.el.
- (starttls-gnutls-program, starttls-use-gnutls)
- (starttls-extra-arguments, starttls-process-connection-type)
- (starttls-connect, starttls-failure, starttls-success): New variables.
- (starttls-program, starttls-extra-args): Doc fix.
- (starttls-negotiate-gnutls, starttls-open-stream-gnutls):
- New functions.
- (starttls-negotiate, starttls-open-stream):
- Check `starttls-use-gnutls' and pass on to corresponding *-gnutls
- function if it is set.
-
-2004-08-30 Juanma Barranquero <lektu@terra.es>
-
- * ietf-drums.el (ietf-drums-remove-whitespace): Fix character constant.
-
-2004-08-30 Andreas Schwab <schwab@suse.de>
-
- * nnlistserv.el (nnlistserv-kk-wash-article): Fix paren nesting.
-
- * gnus-score.el (gnus-summary-increase-score): Fix format string.
-
-2004-08-30 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * nnimap.el (nnimap-demule): Avoid string-as-multibyte.
-
-2004-08-30 Kim F. Storm <storm@cua.dk>
-
- * nntp.el (nntp-authinfo-file): Add :group 'nntp.
-
- * nnimap.el (nnimap-authinfo-file, nnimap-prune-cache):
- Add :group 'nnimap.
-
-2004-08-30 Andreas Schwab <schwab@suse.de>
-
- * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for
- ?* and ?\;.
-
-2004-08-30 Andreas Schwab <schwab@suse.de>
-
- * rfc2231.el (rfc2231-parse-string): Restore whitespace syntax for
- ?* and ?\;.
-
- * ietf-drums.el (ietf-drums-syntax-table): Set syntax of ?* ?\;
- and ?\' to symbol instead of whitespace.
-
-2004-06-23 Jesper Harder <harder@ifa.au.dk>
-
- * message.el (message-idna-to-ascii-rhs-1): Don't choke on
- invalid addresses.
-
-2004-05-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.el (message-idna-to-ascii-rhs-1): Fix typo.
-
-2004-05-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-idna-to-ascii-rhs-1): Don't use equalp.
-
-2004-05-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus-art.el (article-decode-idna-rhs): Don't use
- message-idna-inside-rhs-p.
-
-2004-05-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.el (message-idna-inside-rhs-p): Remove.
- (message-idna-to-ascii-rhs-1): Use proper address parsing.
-
-2004-08-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-restore-gcc): Use ^ and regexp-quote.
-
-2004-08-30 Helmut Waitzmann <Helmut.Waitzmann@web.de> (tiny change)
-
- * gnus-sum.el (gnus-newsgroup-variables): Doc fix.
-
-2004-08-26 YAGI Tatsuya <ynyaaa@ybb.ne.jp> (tiny change)
-
- * gnus-art.el (gnus-article-next-page): Fix the way to find a real
- end-of-buffer.
-
-2004-08-26 Stefan Wiens <s.wi@gmx.net> (tiny change)
-
- * gnus-sum.el (gnus-read-header): Don't remove a header for the
- parent article of a sparse article in the thread hashtb.
-
-2004-08-26 David Hedbor <dhedbor@real.com> (tiny change)
-
- * nnmail.el (nnmail-split-lowercase-expanded): New user option.
- (nnmail-expand-newtext): Lowercase expanded entries if
- nnmail-split-lowercase-expanded is non-nil.
-
-2004-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-agent.el (gnus-agent-regenerate-group): Activate the group
- when the group's active is not available.
-
- * gnus-art.el (article-hide-headers): Refer to the values for
- gnus-ignored-headers and gnus-visible-headers in the summary
- buffer since a user may have set them as group parameters.
- (gnus-article-read-summary-keys): Restore new window-start and
- hscroll to summary window.
- (gnus-prev-page-map): Remove duplicated one.
-
- * gnus-cite.el (gnus-cite-ignore-quoted-from): New user option.
- (gnus-cite-parse): Ignore quoted envelope From_. Suggested by
- Karl Chen <quarl@nospam.quarl.org> and Reiner Steib
- <Reiner.Steib@gmx.de>.
-
- * gnus-cus.el (gnus-agent-cat-prepare-category-field):
- Replace pp-to-string with gnus-pp-to-string.
-
- * gnus-eform.el (gnus-edit-form): Replace pp with gnus-pp.
-
- * gnus-group.el (gnus-group-make-kiboze-group): Replace pp with
- gnus-pp.
-
- * gnus-msg.el (gnus-setup-message): Ignore an article copy while
- parsing gnus-posting-styles when the message is not for replying.
- (gnus-summary-resend-message-edit): Call mime-to-mml.
- Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
- (gnus-debug): Replace pp with gnus-pp.
-
- * gnus-score.el (gnus-score-save): Replace pp with gnus-pp.
-
- * gnus-spec.el (gnus-update-format): Replace pp-to-string with
- gnus-pp-to-string.
-
- * gnus-util.el (gnus-bind-print-variables): New macro.
- (gnus-prin1): Use it.
- (gnus-prin1-to-string): Use it.
- (gnus-pp): New function.
- (gnus-pp-to-string): New function.
-
- * gnus.el: Don't make unnecessary *Group* buffer when loading.
-
- * mail-source.el (mail-source-touch-pop): Doc fix.
-
- * message.el (message-mode): Don't modify paragraph-separate there.
- (message-setup-fill-variables): Add mml tags to paragraph-start
- and paragraph-separate. Suggested by Andrew Korty <ajk@iu.edu>.
- (message-smtpmail-send-it): Doc fix.
- (message-exchange-point-and-mark): Don't activate region if it was
- inactive. Suggested by Hiroshi Fujishima
- <pooh@nature.tsukuba.ac.jp> and Jesper Harder <harder@ifa.au.dk>.
-
- * mm-decode.el (mm-save-part): Bind enable-multibyte-characters to
- t while entering a file name using the mm-with-multibyte macro.
- Suggested by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
-
- * mm-encode.el (mm-content-transfer-encoding-defaults):
- Use qp-or-base64 for the application/* types.
- (mm-safer-encoding): Consider 7bit is safe.
-
- * mm-util.el (mm-with-multibyte-buffer): New macro.
- (mm-with-multibyte): New macro.
-
- * mm-view.el (mm-inline-render-with-function): Use multibyte
- buffer; decode html source by charset.
-
- * nndoc.el (nndoc-type-alist): Improve regexp for article-begin,
- add generate-head-function and generate-article-function to the
- rfc822-forward entry.
- (nndoc-forward-type-p): Recognize envelope From_.
- (nndoc-rfc822-forward-generate-article): New function.
- (nndoc-rfc822-forward-generate-head): New function.
-
- * score-mode.el (gnus-score-pretty-print): Replace pp with gnus-pp.
-
- * webmail.el (webmail-debug): Replace pp with gnus-pp.
-
-2004-08-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (gnus-article-wash-html-with-w3m):
- Bind w3m-safe-url-regexp as the value for mm-w3m-safe-url-regexp;
- use w3m-minor-mode-map instead of mm-w3m-local-map-property.
- (gnus-mime-save-part-and-strip): Use mm-complicated-handles
- instead of mm-multiple-handles.
- (gnus-mime-delete-part): Ditto.
-
- * lpath.el: Fbind w3m-detect-meta-charset; don't fbind
- w3m-charset-to-coding-system; don't bind
- w3m-meta-content-type-charset-regexp.
-
- * mm-decode.el (mm-multiple-handles): Recognize a string as a mime
- handle, as well as a list.
- (mm-complicated-handles): Former definition of mm-multiple-handles.
-
- * mm-view.el (mm-w3m-mode-map): Remove.
- (mm-w3m-local-map-property): Remove.
- (mm-w3m-cid-retrieve-1): Call itself recursively. Suggested by
- ARISAWA Akihiro <ari@mbf.sphere.ne.jp>.
- (mm-w3m-cid-retrieve): Simplify.
- (mm-inline-text-html-render-with-w3m): Decode html source by
- charset; check META tags only when charsets are not specified in
- headers; specify charset to w3m-region; use w3m-minor-mode-map
- instead of mm-w3m-local-map-property.
-
-2004-08-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus-art.el (article-hide-list-identifiers):
- Bind inhibit-read-only as t.
-
-2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-mlspl.el (gnus-group-split-update): Fix docstring.
-
-2004-08-22 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus-art.el: Use inhibit-read-only instead of buffer-read-only.
- (gnus-narrow-to-page): Don't assume point-min == 1.
- (gnus-article-edit-mode): Derive from message-mode.
-
- * gnus-score.el (gnus-score-find-bnews): Simplify and don't assume
- point-min == 1.
-
- * imap.el (imap-parse-address-list, imap-parse-body-ext):
- Disable incorrect use of `assert'.
-
- * message.el (message-mode): Set comment-start-skip.
-
-2004-08-22 Sam Steingold <sds@gnu.org>
-
- * pop3.el (pop3-leave-mail-on-server): New user variable.
- (pop3-movemail): Delete mail only when it is nil.
-
-2004-08-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * mailcap.el (mailcap-mime-data): Mark as risky.
-
-2004-08-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-group, gnus-summary, gnus-summary-sort):
- Fix custom-manual entries.
-
- * gnus-art.el (gnus-article): Fix custom-manual entries.
-
-2004-08-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.el (gnus-group, gnus-summary, gnus-summary-sort): Fix
- custom-manual entries.
-
-2004-05-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * mm-decode.el (mm-text-html-renderer): Make sure w3m exists in
- addition to emacs-w3m.
-
-2004-05-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-msg.el (gnus-summary-followup-with-original):
- Document yanking of region when active.
-
-2004-04-13 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus-agent.el: Merged 7.3 through 7.7 updates into branch.
- Revision 7.2 changes excluded to maintain compatibility with all
- targeted emacs versions.
-
- * gnus-cus.el: Merged revisions 7.2 through 7.5 into branch to support
- gnus-agent.el update and incorporate bug fixes.
-
-See ChangeLog.2 for earlier changes.
-
- Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; fill-column: 79
-;; add-log-time-zone-rule: t
-;; End:
-
-;;; arch-tag: 3f33a3e7-090d-492b-bedd-02a1417d32b4
+++ /dev/null
-GNUS NEWS -- history of user-visible changes.
-
-Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
- 2006, 2007, 2008 Free Software Foundation, Inc.
-See the end of the file for license conditions.
-
-Please send Gnus bug reports to bugs@gnus.org.
-For older news, see Gnus info node "New Features".
-
-\f
-* Installation changes
-
-** Upgrading from previous (stable) version if you have used Oort.
-
-If you have tried Oort (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version. In particular, you will probably want to remove all
-`.marks' (nnml) and `.mrk' (nnfolder) files, so that flags are read from
-your `.newsrc.eld' instead of from the `.marks'/`.mrk' file where this
-release store flags. See a later entry for more information about
-marks. Note that downgrading isn't save in general.
-
-** Lisp files are now installed in `.../site-lisp/gnus/' by default. It
-defaulted to `.../site-lisp/' formerly. In addition to this, the new
-installer issues a warning if other Gnus installations which will shadow
-the latest one are detected. You can then remove those shadows manually
-or remove them using `make remove-installed-shadows'.
-
-** The installation directory name is allowed to have spaces and/or tabs.
-
-** New `make.bat' for compiling and installing Gnus under MS Windows
-
-Use `make.bat' if you want to install Gnus under MS Windows, the first
-argument to the batch-program should be the directory where `xemacs.exe'
-respectively `emacs.exe' is located, if you want to install Gnus after
-compiling it, give `make.bat' `/copy' as the second parameter.
-
-`make.bat' has been rewritten from scratch, it now features automatic
-recognition of XEmacs and GNU Emacs, generates `gnus-load.el', checks if
-errors occur while compilation and generation of info files and reports
-them at the end of the build process. It now uses `makeinfo' if it is
-available and falls back to `infohack.el' otherwise. `make.bat' should
-now install all files which are necessary to run Gnus and be generally a
-complete replacement for the `configure; make; make install' cycle used
-under Unix systems.
-
-The new `make.bat' makes `make-x.bat' and `xemacs.mak' superfluous, so
-they have been removed.
-
-** `~/News/overview/' not used.
-
-As a result of the following change, the `~/News/overview/' directory is
-not used any more. You can safely delete the entire hierarchy.
-
-** `(require 'gnus-load)'
-
-If you use a stand-alone Gnus distribution, you'd better add `(require
-'gnus-load)' into your `~/.emacs' after adding the Gnus lisp directory
-into load-path.
-
-File `gnus-load.el' contains autoload commands, functions and variables,
-some of which may not be included in distributions of Emacsen.
-
-
-\f
-* New packages and libraries within Gnus
-
-** The revised Gnus FAQ is included in the manual, *Note Frequently Asked
-Questions::.
-
-** TLS wrapper shipped with Gnus
-
-TLS/SSL is now supported in IMAP and NNTP via `tls.el' and GNUTLS. The
-old TLS/SSL support via (external third party) `ssl.el' and OpenSSL
-still works.
-
-** Improved anti-spam features.
-
-Gnus is now able to take out spam from your mail and news streams using
-a wide variety of programs and filter rules. Among the supported
-methods are RBL blocklists, bogofilter and white/blacklists. Hooks for
-easy use of external packages such as SpamAssassin and Hashcash are also
-new. *Note Thwarting Email Spam::.
-
-** Gnus supports server-side mail filtering using Sieve.
-
-Sieve rules can be added as Group Parameters for groups, and the
-complete Sieve script is generated using `D g' from the Group buffer,
-and then uploaded to the server using `C-c C-l' in the generated Sieve
-buffer. *Note Sieve Commands::, and the new Sieve manual *Note Top:
-(sieve)Top.
-
-
-\f
-* Changes in group mode
-
-** `gnus-group-read-ephemeral-group' can be called interactively, using `G
-M'.
-
-** Retrieval of charters and control messages
-
-There are new commands for fetching newsgroup charters (`H c') and
-control messages (`H C').
-
-** The new variable `gnus-parameters' can be used to set group parameters.
-
-Earlier this was done only via `G p' (or `G c'), which stored the
-parameters in `~/.newsrc.eld', but via this variable you can enjoy the
-powers of customize, and simplified backups since you set the variable
-in `~/.gnus.el' instead of `~/.newsrc.eld'. The variable maps regular
-expressions matching group names to group parameters, a'la:
-(setq gnus-parameters
- '(("mail\\..*"
- (gnus-show-threads nil)
- (gnus-use-scoring nil))
- ("^nnimap:\\(foo.bar\\)$"
- (to-group . "\\1"))))
-
-** Unread count correct in nnimap groups.
-
-The estimated number of unread articles in the group buffer should now
-be correct for nnimap groups. This is achieved by calling
-`nnimap-fixup-unread-after-getting-new-news' from the
-`gnus-setup-news-hook' (called on startup) and
-`gnus-after-getting-new-news-hook'. (called after getting new mail). If
-you have modified those variables from the default, you may want to add
-`nnimap-fixup-unread-after-getting-new-news' again. If you were happy
-with the estimate and want to save some (minimal) time when getting new
-mail, remove the function.
-
-** Group names are treated as UTF-8 by default.
-
-This is supposedly what USEFOR wanted to migrate to. See
-`gnus-group-name-charset-group-alist' and
-`gnus-group-name-charset-method-alist' for customization.
-
-** `gnus-group-charset-alist' and `gnus-group-ignored-charsets-alist'.
-
-The regexps in these variables are compared with full group names
-instead of real group names in 5.8. Users who customize these variables
-should change those regexps accordingly. For example:
-("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr)
-
-** Old intermediate incoming mail files (`Incoming*') are deleted after a
-couple of days, not immediately. *Note Mail Source Customization::.
-(New in Gnus 5.10.10 / Emacs 22.2)
-
-\f
-* Changes in summary and article mode
-
-** `F' (`gnus-article-followup-with-original') and `R'
-(`gnus-article-reply-with-original') only yank the text in the region if
-the region is active.
-
-** In draft groups, `e' is now bound to `gnus-draft-edit-message'. Use `B
-w' for `gnus-summary-edit-article' instead.
-
-** Article Buttons
-
-More buttons for URLs, mail addresses, Message-IDs, Info links, man
-pages and Emacs or Gnus related references. *Note Article Buttons::.
-The variables `gnus-button-*-level' can be used to control the
-appearance of all article buttons. *Note Article Button Levels::.
-
-** Single-part yenc encoded attachments can be decoded.
-
-** Picons
-
-The picons code has been reimplemented to work in GNU Emacs--some of the
-previous options have been removed or renamed.
-
-Picons are small "personal icons" representing users, domain and
-newsgroups, which can be displayed in the Article buffer. *Note
-Picons::.
-
-** If the new option `gnus-treat-body-boundary' is non-`nil', a boundary
-line is drawn at the end of the headers.
-
-** Signed article headers (X-PGP-Sig) can be verified with `W p'.
-
-** The Summary Buffer uses an arrow in the fringe to indicate the current
-article. Use `(setq gnus-summary-display-arrow nil)' to disable it.
-
-** Warn about email replies to news
-
-Do you often find yourself replying to news by email by mistake? Then
-the new option `gnus-confirm-mail-reply-to-news' is just the thing for
-you.
-
-** If the new option `gnus-summary-display-while-building' is non-`nil',
-the summary buffer is shown and updated as it's being built.
-
-** The new `recent' mark `.' indicates newly arrived messages (as opposed
-to old but unread messages).
-
-** Gnus supports RFC 2369 mailing list headers, and adds a number of
-related commands in mailing list groups. *Note Mailing List::.
-
-** The Date header can be displayed in a format that can be read aloud in
-English. *Note Article Date::.
-
-** diffs are automatically highlighted in groups matching
-`mm-uu-diff-groups-regexp'
-
-** Better handling of Microsoft citation styles
-
-Gnus now tries to recognize the mangled header block that some Microsoft
-mailers use to indicate that the rest of the message is a citation, even
-though it is not quoted in any way. The variable
-`gnus-cite-unsightly-citation-regexp' matches the start of these
-citations.
-
-The new command `W Y f' (`gnus-article-outlook-deuglify-article') allows
-deuglifying broken Outlook (Express) articles.
-
-** `gnus-article-skip-boring'
-
-If you set `gnus-article-skip-boring' to `t', then Gnus will not scroll
-down to show you a page that contains only boring text, which by default
-means cited text and signature. You can customize what is skippable
-using `gnus-article-boring-faces'.
-
-This feature is especially useful if you read many articles that consist
-of a little new content at the top with a long, untrimmed message cited
-below.
-
-** Smileys (`:-)', `;-)' etc) are now displayed graphically in Emacs too.
-
-Put `(setq gnus-treat-display-smileys nil)' in `~/.gnus.el' to disable
-it.
-
-** Face headers handling. *Note Face::.
-
-** In the summary buffer, the new command `/ N' inserts new messages and `/
-o' inserts old messages.
-
-** Gnus decodes morse encoded messages if you press `W m'.
-
-** `gnus-summary-line-format'
-
-The default value changed to `%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n'.
-Moreover `gnus-extra-headers', `nnmail-extra-headers' and
-`gnus-ignored-from-addresses' changed their default so that the users
-name will be replaced by the recipient's name or the group name posting
-to for NNTP groups.
-
-** Deleting of attachments.
-
-The command `gnus-mime-save-part-and-strip' (bound to `C-o' on MIME
-buttons) saves a part and replaces the part with an external one.
-`gnus-mime-delete-part' (bound to `d' on MIME buttons) removes a part.
-It works only on back ends that support editing.
-
-** `gnus-default-charset'
-
-The default value is determined from the `current-language-environment'
-variable, instead of `iso-8859-1'. Also the `.*' item in
-`gnus-group-charset-alist' is removed.
-
-** Printing capabilities are enhanced.
-
-Gnus supports Muttprint natively with `O P' from the Summary and Article
-buffers. Also, each individual MIME part can be printed using `p' on
-the MIME button.
-
-** Extended format specs.
-
-Format spec `%&user-date;' is added into
-`gnus-summary-line-format-alist'. Also, user defined extended format
-specs are supported. The extended format specs look like `%u&foo;',
-which invokes function `gnus-user-format-function-FOO'. Because `&' is
-used as the escape character, old user defined format `%u&' is no longer
-supported.
-
-** `/ *' (`gnus-summary-limit-include-cached') is rewritten.
-
-It was aliased to `Y c' (`gnus-summary-insert-cached-articles'). The
-new function filters out other articles.
-
-** Some limiting commands accept a `C-u' prefix to negate the match.
-
-If `C-u' is used on subject, author or extra headers, i.e., `/ s', `/
-a', and `/ x' (`gnus-summary-limit-to-{subject,author,extra}')
-respectively, the result will be to display all articles that do not
-match the expression.
-
-** Gnus inlines external parts (message/external).
-
-
-\f
-* Changes in Message mode and related Gnus features
-
-** Delayed articles
-
-You can delay the sending of a message with `C-c C-j' in the Message
-buffer. The messages are delivered at specified time. This is useful
-for sending yourself reminders. *Note Delayed Articles::.
-
-** If the new option `nnml-use-compressed-files' is non-`nil', the nnml
-back end allows compressed message files.
-
-** The new option `gnus-gcc-mark-as-read' automatically marks Gcc articles
-as read.
-
-** Externalizing of attachments
-
-If `gnus-gcc-externalize-attachments' or
-`message-fcc-externalize-attachments' is non-`nil', attach local files
-as external parts.
-
-** The envelope sender address can be customized when using Sendmail.
- *Note Mail Variables: (message)Mail Variables.
-
-** Gnus no longer generate the Sender: header automatically.
-
-Earlier it was generated when the user configurable email address was
-different from the Gnus guessed default user address. As the guessing
-algorithm is rarely correct these days, and (more controversially) the
-only use of the Sender: header was to check if you are entitled to
-cancel/supersede news (which is now solved by Cancel Locks instead, see
-another entry), generation of the header has been disabled by default.
-See the variables `message-required-headers',
-`message-required-news-headers', and `message-required-mail-headers'.
-
-** Features from third party `message-utils.el' added to `message.el'.
-
-Message now asks if you wish to remove `(was: <old subject>)' from
-subject lines (see `message-subject-trailing-was-query'). `C-c M-m' and
-`C-c M-f' inserts markers indicating included text. `C-c C-f a' adds a
-X-No-Archive: header. `C-c C-f x' inserts appropriate headers and a
-note in the body for cross-postings and followups (see the variables
-`message-cross-post-*').
-
-** References and X-Draft-From headers are no longer generated when you
-start composing messages and `message-generate-headers-first' is `nil'.
-
-** Easy inclusion of X-Faces headers. *Note X-Face::.
-
-** Group Carbon Copy (GCC) quoting
-
-To support groups that contains SPC and other weird characters, groups
-are quoted before they are placed in the Gcc: header. This means
-variables such as `gnus-message-archive-group' should no longer contain
-quote characters to make groups containing SPC work. Also, if you are
-using the string `nnml:foo, nnml:bar' (indicating Gcc into two groups)
-you must change it to return the list `("nnml:foo" "nnml:bar")',
-otherwise the Gcc: line will be quoted incorrectly. Note that returning
-the string `nnml:foo, nnml:bar' was incorrect earlier, it just didn't
-generate any problems since it was inserted directly.
-
-** `message-insinuate-rmail'
-
-Adding `(message-insinuate-rmail)' and `(setq mail-user-agent
-'gnus-user-agent)' in `.emacs' convinces Rmail to compose, reply and
-forward messages in message-mode, where you can enjoy the power of MML.
-
-** `message-minibuffer-local-map'
-
-The line below enables BBDB in resending a message:
-(define-key message-minibuffer-local-map [(tab)]
- 'bbdb-complete-name)
-
-** `gnus-posting-styles'
-
-Add a new format of match like
-((header "to" "larsi.*org")
- (Organization "Somewhere, Inc."))
-The old format like the lines below is obsolete, but still accepted.
-(header "to" "larsi.*org"
- (Organization "Somewhere, Inc."))
-
-** `message-ignored-news-headers' and `message-ignored-mail-headers'
-
-`X-Draft-From' and `X-Gnus-Agent-Meta-Information' have been added into
-these two variables. If you customized those, perhaps you need add
-those two headers too.
-
-** Gnus supports the "format=flowed" (RFC 2646) parameter. On composing
-messages, it is enabled by `use-hard-newlines'. Decoding format=flowed
-was present but not documented in earlier versions.
-
-** The option `mm-fill-flowed' can be used to disable treatment of
-"format=flowed" messages. Also, flowed text is disabled when sending
-inline PGP signed messages. (New in Gnus 5.10.7)
-
-** Gnus supports the generation of RFC 2298 Disposition Notification
-requests.
-
-This is invoked with the `C-c M-n' key binding from message mode.
-
-** Message supports the Importance: (RFC 2156) header.
-
-In the message buffer, `C-c C-f C-i' or `C-c C-u' cycles through the
-valid values.
-
-** Gnus supports Cancel Locks in News.
-
-This means a header `Cancel-Lock' is inserted in news posting. It is
-used to determine if you wrote an article or not (for canceling and
-superseding). Gnus generates a random password string the first time
-you post a message, and saves it in your `~/.emacs' using the Custom
-system. While the variable is called `canlock-password', it is not
-security sensitive data. Publishing your canlock string on the web will
-not allow anyone to be able to anything she could not already do. The
-behavior can be changed by customizing `message-insert-canlock'.
-
-** Gnus supports PGP (RFC 1991/2440), PGP/MIME (RFC 2015/3156) and S/MIME
-(RFC 2630-2633).
-
-It needs an external S/MIME and OpenPGP implementation, but no
-additional Lisp libraries. This add several menu items to the
-Attachments menu, and `C-c RET' key bindings, when composing messages.
-This also obsoletes `gnus-article-hide-pgp-hook'.
-
-** MML (Mime compose) prefix changed from `M-m' to `C-c C-m'.
-
-This change was made to avoid conflict with the standard binding of
-`back-to-indentation', which is also useful in message mode.
-
-** The default for `message-forward-show-mml' changed to the symbol `best'.
-
-The behavior for the `best' value is to show MML (i.e., convert to MIME)
-when appropriate. MML will not be used when forwarding signed or
-encrypted messages, as the conversion invalidate the digital signature.
-
-** If `auto-compression-mode' is enabled, attachments are automatically
-decompressed when activated.
-
-** Support for non-ASCII domain names
-
-Message supports non-ASCII domain names in From:, To: and Cc: and will
-query you whether to perform encoding when you try to send a message.
-The variable `message-use-idna' controls this. Gnus will also decode
-non-ASCII domain names in From:, To: and Cc: when you view a message.
-The variable `gnus-use-idna' controls this.
-
-** You can now drag and drop attachments to the Message buffer. See
-`mml-dnd-protocol-alist' and `mml-dnd-attach-options'. *Note MIME:
-(message)MIME.
-
-
-\f
-* Changes in back ends
-
-** Gnus can display RSS newsfeeds as a newsgroup. *Note RSS::.
-
-** The nndoc back end now supports mailman digests and exim bounces.
-
-** Gnus supports Maildir groups.
-
-Gnus includes a new back end `nnmaildir.el'. *Note Maildir::.
-
-** The nnml and nnfolder back ends store marks for each groups.
-
-This makes it possible to take backup of nnml/nnfolder servers/groups
-separately of `~/.newsrc.eld', while preserving marks. It also makes it
-possible to share articles and marks between users (without sharing the
-`~/.newsrc.eld' file) within e.g. a department. It works by storing the
-marks stored in `~/.newsrc.eld' in a per-group file `.marks' (for nnml)
-and `GROUPNAME.mrk' (for nnfolder, named GROUPNAME). If the
-nnml/nnfolder is moved to another machine, Gnus will automatically use
-the `.marks' or `.mrk' file instead of the information in
-`~/.newsrc.eld'. The new server variables `nnml-marks-is-evil' and
-`nnfolder-marks-is-evil' can be used to disable this feature.
-
-
-\f
-* Appearance
-
-** The menu bar item (in Group and Summary buffer) named "Misc" has been
-renamed to "Gnus".
-
-** The menu bar item (in Message mode) named "MML" has been renamed to
-"Attachments". Note that this menu also contains security related
-stuff, like signing and encryption (*note Security: (message)Security.).
-
-** The tool bars have been updated to use GNOME icons in Group, Summary and
-Message mode. You can also customize the tool bars: `M-x customize-apropos
-RET -tool-bar$' should get you started. (Only for Emacs, not in XEmacs.)
-
-** The tool bar icons are now (de)activated correctly in the group buffer,
-see the variable `gnus-group-update-tool-bar'. Its default value
-depends on your Emacs version. This is a new feature in Gnus 5.10.9.
-
-\f
-* Miscellaneous changes
-
-** `gnus-agent'
-
-The Gnus Agent has seen a major updated and is now enabled by default,
-and all nntp and nnimap servers from `gnus-select-method' and
-`gnus-secondary-select-method' are agentized by default. Earlier only
-the server in `gnus-select-method' was agentized by the default, and the
-agent was disabled by default. When the agent is enabled, headers are
-now also retrieved from the Agent cache instead of the back ends when
-possible. Earlier this only happened in the unplugged state. You can
-enroll or remove servers with `J a' and `J r' in the server buffer.
-Gnus will not download articles into the Agent cache, unless you
-instruct it to do so, though, by using `J u' or `J s' from the Group
-buffer. You revert to the old behavior of having the Agent disabled
-with `(setq gnus-agent nil)'. Note that putting `(gnus-agentize)' in
-`~/.gnus.el' is not needed any more.
-
-** Gnus reads the NOV and articles in the Agent if plugged.
-
-If one reads an article while plugged, and the article already exists in
-the Agent, it won't get downloaded once more. `(setq gnus-agent-cache
-nil)' reverts to the old behavior.
-
-** Dired integration
-
-`gnus-dired-minor-mode' (see *Note Other modes::) installs key bindings
-in dired buffers to send a file as an attachment, open a file using the
-appropriate mailcap entry, and print a file using the mailcap entry.
-
-** The format spec `%C' for positioning point has changed to `%*'.
-
-** `gnus-slave-unplugged'
-
-A new command which starts Gnus offline in slave mode.
-
-
-\f
-* For older news, see Gnus info node "New Features".
-
-----------------------------------------------------------------------
-\f
-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 3, 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., 51 Franklin Street, Fifth Floor,
-Boston, MA 02110-1301, USA.
-
-\f
-Local variables:
-mode: outline
-paragraph-separate: "[ \f]*$"
-end:
+++ /dev/null
-;;; binhex.el --- elisp native binhex decode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: binhex 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(autoload 'executable-find "executable")
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (defalias 'binhex-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity)))
-
-(defcustom binhex-decoder-program "hexbin"
- "*Non-nil value should be a string that names a binhex decoder.
-The program should expect to read binhex data on its standard
-input and write the converted data to its standard output."
- :type 'string
- :group 'gnus-extract)
-
-(defcustom binhex-decoder-switches '("-d")
- "*List of command line flags passed to the command `binhex-decoder-program'."
- :group 'gnus-extract
- :type '(repeat string))
-
-(defcustom binhex-use-external
- (executable-find binhex-decoder-program)
- "*Use external binhex program."
- :version "22.1"
- :group 'gnus-extract
- :type 'boolean)
-
-(defconst binhex-alphabet-decoding-alist
- '(( ?\! . 0) ( ?\" . 1) ( ?\# . 2) ( ?\$ . 3) ( ?\% . 4) ( ?\& . 5)
- ( ?\' . 6) ( ?\( . 7) ( ?\) . 8) ( ?\* . 9) ( ?\+ . 10) ( ?\, . 11)
- ( ?\- . 12) ( ?0 . 13) ( ?1 . 14) ( ?2 . 15) ( ?3 . 16) ( ?4 . 17)
- ( ?5 . 18) ( ?6 . 19) ( ?8 . 20) ( ?9 . 21) ( ?@ . 22) ( ?A . 23)
- ( ?B . 24) ( ?C . 25) ( ?D . 26) ( ?E . 27) ( ?F . 28) ( ?G . 29)
- ( ?H . 30) ( ?I . 31) ( ?J . 32) ( ?K . 33) ( ?L . 34) ( ?M . 35)
- ( ?N . 36) ( ?P . 37) ( ?Q . 38) ( ?R . 39) ( ?S . 40) ( ?T . 41)
- ( ?U . 42) ( ?V . 43) ( ?X . 44) ( ?Y . 45) ( ?Z . 46) ( ?\[ . 47)
- ( ?\` . 48) ( ?a . 49) ( ?b . 50) ( ?c . 51) ( ?d . 52) ( ?e . 53)
- ( ?f . 54) ( ?h . 55) ( ?i . 56) ( ?j . 57) ( ?k . 58) ( ?l . 59)
- ( ?m . 60) ( ?p . 61) ( ?q . 62) ( ?r . 63)))
-
-(defun binhex-char-map (char)
- (cdr (assq char binhex-alphabet-decoding-alist)))
-
-;;;###autoload
-(defconst binhex-begin-line
- "^:...............................................................$")
-(defconst binhex-body-line
- "^[^:]...............................................................$")
-(defconst binhex-end-line ":$")
-
-(defvar binhex-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/")))
-
-(eval-and-compile
- (defalias 'binhex-insert-char
- (if (featurep 'xemacs)
- 'insert-char
- (lambda (char &optional count ignored buffer)
- "Insert COUNT copies of CHARACTER into BUFFER."
- (if (or (null buffer) (eq buffer (current-buffer)))
- (insert-char char count)
- (with-current-buffer buffer
- (insert-char char count)))))))
-
-(defvar binhex-crc-table
- [0 4129 8258 12387 16516 20645 24774 28903
- 33032 37161 41290 45419 49548 53677 57806 61935
- 4657 528 12915 8786 21173 17044 29431 25302
- 37689 33560 45947 41818 54205 50076 62463 58334
- 9314 13379 1056 5121 25830 29895 17572 21637
- 42346 46411 34088 38153 58862 62927 50604 54669
- 13907 9842 5649 1584 30423 26358 22165 18100
- 46939 42874 38681 34616 63455 59390 55197 51132
- 18628 22757 26758 30887 2112 6241 10242 14371
- 51660 55789 59790 63919 35144 39273 43274 47403
- 23285 19156 31415 27286 6769 2640 14899 10770
- 56317 52188 64447 60318 39801 35672 47931 43802
- 27814 31879 19684 23749 11298 15363 3168 7233
- 60846 64911 52716 56781 44330 48395 36200 40265
- 32407 28342 24277 20212 15891 11826 7761 3696
- 65439 61374 57309 53244 48923 44858 40793 36728
- 37256 33193 45514 41451 53516 49453 61774 57711
- 4224 161 12482 8419 20484 16421 28742 24679
- 33721 37784 41979 46042 49981 54044 58239 62302
- 689 4752 8947 13010 16949 21012 25207 29270
- 46570 42443 38312 34185 62830 58703 54572 50445
- 13538 9411 5280 1153 29798 25671 21540 17413
- 42971 47098 34713 38840 59231 63358 50973 55100
- 9939 14066 1681 5808 26199 30326 17941 22068
- 55628 51565 63758 59695 39368 35305 47498 43435
- 22596 18533 30726 26663 6336 2273 14466 10403
- 52093 56156 60223 64286 35833 39896 43963 48026
- 19061 23124 27191 31254 2801 6864 10931 14994
- 64814 60687 56684 52557 48554 44427 40424 36297
- 31782 27655 23652 19525 15522 11395 7392 3265
- 61215 65342 53085 57212 44955 49082 36825 40952
- 28183 32310 20053 24180 11923 16050 3793 7920])
-
-(defun binhex-update-crc (crc char &optional count)
- (if (null count) (setq count 1))
- (while (> count 0)
- (setq crc (logxor (logand (lsh crc 8) 65280)
- (aref binhex-crc-table
- (logxor (logand (lsh crc -8) 255)
- char)))
- count (1- count)))
- crc)
-
-(defun binhex-verify-crc (buffer start end)
- (with-current-buffer buffer
- (let ((pos start) (crc 0) (last (- end 2)))
- (while (< pos last)
- (setq crc (binhex-update-crc crc (char-after pos))
- pos (1+ pos)))
- (if (= crc (binhex-string-big-endian (buffer-substring last end)))
- nil
- (error "CRC error")))))
-
-(defun binhex-string-big-endian (string)
- (let ((ret 0) (i 0) (len (length string)))
- (while (< i len)
- (setq ret (+ (lsh ret 8) (binhex-char-int (aref string i)))
- i (1+ i)))
- ret))
-
-(defun binhex-string-little-endian (string)
- (let ((ret 0) (i 0) (shift 0) (len (length string)))
- (while (< i len)
- (setq ret (+ ret (lsh (binhex-char-int (aref string i)) shift))
- i (1+ i)
- shift (+ shift 8)))
- ret))
-
-(defun binhex-header (buffer)
- (with-current-buffer buffer
- (let ((pos (point-min)) len)
- (vector
- (prog1
- (setq len (binhex-char-int (char-after pos)))
- (setq pos (1+ pos)))
- (buffer-substring pos (setq pos (+ pos len)))
- (prog1
- (setq len (binhex-char-int (char-after pos)))
- (setq pos (1+ pos)))
- (buffer-substring pos (setq pos (+ pos 4)))
- (buffer-substring pos (setq pos (+ pos 4)))
- (binhex-string-big-endian
- (buffer-substring pos (setq pos (+ pos 2))))
- (binhex-string-big-endian
- (buffer-substring pos (setq pos (+ pos 4))))
- (binhex-string-big-endian
- (buffer-substring pos (setq pos (+ pos 4))))))))
-
-(defvar binhex-last-char)
-(defvar binhex-repeat)
-
-(defun binhex-push-char (char &optional count ignored buffer)
- (cond
- (binhex-repeat
- (if (eq char 0)
- (binhex-insert-char (setq binhex-last-char 144) 1
- ignored buffer)
- (binhex-insert-char binhex-last-char (- char 1)
- ignored buffer)
- (setq binhex-last-char nil))
- (setq binhex-repeat nil))
- ((= char 144)
- (setq binhex-repeat t))
- (t
- (binhex-insert-char (setq binhex-last-char char) 1 ignored buffer))))
-
-;;;###autoload
-(defun binhex-decode-region-internal (start end &optional header-only)
- "Binhex decode region between START and END without using an external program.
-If HEADER-ONLY is non-nil only decode header and return filename."
- (interactive "r")
- (let ((work-buffer nil)
- (counter 0)
- (bits 0) (tmp t)
- (lim 0) inputpos
- (non-data-chars " \t\n\r:")
- file-name-length data-fork-start
- header
- binhex-last-char binhex-repeat)
- (unwind-protect
- (save-excursion
- (goto-char start)
- (when (re-search-forward binhex-begin-line end t)
- (let (default-enable-multibyte-characters)
- (setq work-buffer (generate-new-buffer " *binhex-work*")))
- (beginning-of-line)
- (setq bits 0 counter 0)
- (while tmp
- (skip-chars-forward non-data-chars end)
- (setq inputpos (point))
- (end-of-line)
- (setq lim (point))
- (while (and (< inputpos lim)
- (setq tmp (binhex-char-map (char-after inputpos))))
- (setq bits (+ bits tmp)
- counter (1+ counter)
- inputpos (1+ inputpos))
- (cond ((= counter 4)
- (binhex-push-char (lsh bits -16) 1 nil work-buffer)
- (binhex-push-char (logand (lsh bits -8) 255) 1 nil
- work-buffer)
- (binhex-push-char (logand bits 255) 1 nil
- work-buffer)
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 6)))))
- (if (null file-name-length)
- (with-current-buffer work-buffer
- (setq file-name-length (char-after (point-min))
- data-fork-start (+ (point-min)
- file-name-length 22))))
- (if (and (null header)
- (with-current-buffer work-buffer
- (>= (buffer-size) data-fork-start)))
- (progn
- (binhex-verify-crc work-buffer
- (point-min) data-fork-start)
- (setq header (binhex-header work-buffer))
- (if header-only (setq tmp nil counter 0))))
- (setq tmp (and tmp (not (eq inputpos end)))))
- (cond
- ((= counter 3)
- (binhex-push-char (logand (lsh bits -16) 255) 1 nil
- work-buffer)
- (binhex-push-char (logand (lsh bits -8) 255) 1 nil
- work-buffer))
- ((= counter 2)
- (binhex-push-char (logand (lsh bits -10) 255) 1 nil
- work-buffer))))
- (if header-only nil
- (binhex-verify-crc work-buffer
- data-fork-start
- (+ data-fork-start (aref header 6) 2))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (insert-buffer-substring work-buffer
- data-fork-start (+ data-fork-start
- (aref header 6)))
- (delete-region (point) end)))
- (and work-buffer (kill-buffer work-buffer)))
- (if header (aref header 1))))
-
-;;;###autoload
-(defun binhex-decode-region-external (start end)
- "Binhex decode region between START and END using external decoder."
- (interactive "r")
- (let ((cbuf (current-buffer)) firstline work-buffer status
- (file-name (expand-file-name
- (concat (binhex-decode-region-internal start end t)
- ".data")
- binhex-temporary-file-directory)))
- (save-excursion
- (goto-char start)
- (when (re-search-forward binhex-begin-line nil t)
- (let ((cdir default-directory) default-process-coding-system)
- (unwind-protect
- (progn
- (set-buffer (setq work-buffer
- (generate-new-buffer " *binhex-work*")))
- (buffer-disable-undo work-buffer)
- (insert-buffer-substring cbuf firstline end)
- (cd binhex-temporary-file-directory)
- (apply 'call-process-region
- (point-min)
- (point-max)
- binhex-decoder-program
- nil
- nil
- nil
- binhex-decoder-switches))
- (cd cdir) (set-buffer cbuf)))
- (if (and file-name (file-exists-p file-name))
- (progn
- (goto-char start)
- (delete-region start end)
- (let (format-alist)
- (insert-file-contents-literally file-name)))
- (error "Can not binhex")))
- (and work-buffer (kill-buffer work-buffer))
- (ignore-errors
- (if file-name (delete-file file-name))))))
-
-;;;###autoload
-(defun binhex-decode-region (start end)
- "Binhex decode region between START and END."
- (interactive "r")
- (if binhex-use-external
- (binhex-decode-region-external start end)
- (binhex-decode-region-internal start end)))
-
-(provide 'binhex)
-
-;;; arch-tag: 8476badd-1e76-4f1d-a640-f9a38c72eed8
-;;; binhex.el ends here
+++ /dev/null
-;;; canlock.el --- functions for Cancel-Lock feature
-
-;; Copyright (C) 1998, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Katsumi Yamaoka <yamaoka@jpl.org>
-;; Keywords: news, cancel-lock, hmac, sha1, rfc2104
-
-;; This program 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 3, or (at your option)
-;; any later version.
-
-;; This program 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 this program; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Canlock is a library for generating and verifying Cancel-Lock and/or
-;; Cancel-Key header in news articles. This is used to protect articles
-;; from rogue cancel, supersede or replace attacks. The method is based
-;; on draft-ietf-usefor-cancel-lock-01.txt which was released on November
-;; 3rd 1998. For instance, you can add Cancel-Lock (and possibly Cancel-
-;; Key) header in a news article by using a hook which will be evaluated
-;; just before sending an article as follows:
-;;
-;; (add-hook '*e**a*e-header-hook 'canlock-insert-header t)
-;;
-;; Verifying Cancel-Lock is mainly a function of news servers, however,
-;; you can verify your own article using the command `canlock-verify' in
-;; the (raw) article buffer. You will be prompted for the password for
-;; each time if the option `canlock-password' or `canlock-password-for-
-;; verify' is nil. Note that setting these options is a bit unsafe.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'sha1)
-
-(defvar mail-header-separator)
-
-(defgroup canlock nil
- "The Cancel-Lock feature."
- :group 'news)
-
-(defcustom canlock-password nil
- "Password to use when signing a Cancel-Lock or a Cancel-Key header."
- :type '(radio (const :format "Not specified " nil)
- (string :tag "Password"))
- :group 'canlock)
-
-(defcustom canlock-password-for-verify canlock-password
- "Password to use when verifying a Cancel-Lock or a Cancel-Key header."
- :type '(radio (const :format "Not specified " nil)
- (string :tag "Password"))
- :group 'canlock)
-
-(defcustom canlock-force-insert-header nil
- "If non-nil, insert a Cancel-Lock or a Cancel-Key header even if the
-buffer does not look like a news message."
- :type 'boolean
- :group 'canlock)
-
-(eval-when-compile
- (defmacro canlock-string-as-unibyte (string)
- "Return a unibyte string with the same individual bytes as STRING."
- (if (fboundp 'string-as-unibyte)
- (list 'string-as-unibyte string)
- string)))
-
-(defun canlock-sha1 (message)
- "Make a SHA-1 digest of MESSAGE as a unibyte string of length 20 bytes."
- (let (sha1-maximum-internal-length)
- (sha1 message nil nil 'binary)))
-
-(defun canlock-make-cancel-key (message-id password)
- "Make a Cancel-Key header."
- (when (> (length password) 20)
- (setq password (canlock-sha1 password)))
- (setq password (concat password (make-string (- 64 (length password)) 0)))
- (let ((ipad (mapconcat (lambda (byte)
- (char-to-string (logxor 54 byte)))
- password ""))
- (opad (mapconcat (lambda (byte)
- (char-to-string (logxor 92 byte)))
- password "")))
- (base64-encode-string
- (canlock-sha1
- (concat opad
- (canlock-sha1
- (concat ipad (canlock-string-as-unibyte message-id))))))))
-
-(defun canlock-narrow-to-header ()
- "Narrow the buffer to the head of the message."
- (let (case-fold-search)
- (narrow-to-region
- (goto-char (point-min))
- (goto-char (if (re-search-forward
- (format "^$\\|^%s$"
- (regexp-quote mail-header-separator))
- nil t)
- (match-beginning 0)
- (point-max))))))
-
-(defun canlock-delete-headers ()
- "Delete Cancel-Key or Cancel-Lock headers in the narrowed buffer."
- (let ((case-fold-search t))
- (goto-char (point-min))
- (while (re-search-forward "^Cancel-\\(Key\\|Lock\\):" nil t)
- (delete-region (match-beginning 0)
- (if (re-search-forward "^[^\t ]" nil t)
- (goto-char (match-beginning 0))
- (point-max))))))
-
-(defun canlock-fetch-fields (&optional key)
- "Return a list of the values of Cancel-Lock header.
-If KEY is non-nil, look for a Cancel-Key header instead. The buffer
-is expected to be narrowed to just the headers of the message."
- (let ((field (mail-fetch-field (if key "Cancel-Key" "Cancel-Lock")))
- fields rest
- (case-fold-search t))
- (when field
- (setq fields (split-string field "[\t\n\r ,]+"))
- (while fields
- (when (string-match "^sha1:" (setq field (pop fields)))
- (push (substring field 5) rest)))
- (nreverse rest))))
-
-(defun canlock-fetch-id-for-key ()
- "Return a Message-ID in Cancel, Supersedes or Replaces header.
-The buffer is expected to be narrowed to just the headers of the
-message."
- (or (let ((cancel (mail-fetch-field "Control")))
- (and cancel
- (string-match "^cancel[\t ]+\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
- cancel)
- (match-string 1 cancel)))
- (mail-fetch-field "Supersedes")
- (mail-fetch-field "Replaces")))
-
-;;;###autoload
-(defun canlock-insert-header (&optional id-for-key id-for-lock password)
- "Insert a Cancel-Key and/or a Cancel-Lock header if possible."
- (let (news control key-for-key key-for-lock)
- (save-excursion
- (save-restriction
- (canlock-narrow-to-header)
- (when (setq news (or canlock-force-insert-header
- (mail-fetch-field "Newsgroups")))
- (unless id-for-key
- (setq id-for-key (canlock-fetch-id-for-key)))
- (if (and (setq control (mail-fetch-field "Control"))
- (string-match "^cancel[\t ]+<[^\t\n @<>]+@[^\t\n @<>]+>"
- control))
- (setq id-for-lock nil)
- (unless id-for-lock
- (setq id-for-lock (mail-fetch-field "Message-ID"))))
- (canlock-delete-headers)
- (goto-char (point-max))))
- (when news
- (if (not (or id-for-key id-for-lock))
- (message "There are no Message-ID(s)")
- (unless password
- (setq password (or canlock-password
- (read-passwd
- "Password for Canlock: "))))
- (if (or (not (stringp password)) (zerop (length password)))
- (message "Password for Canlock is bad")
- (setq key-for-key (when id-for-key
- (canlock-make-cancel-key
- id-for-key password))
- key-for-lock (when id-for-lock
- (canlock-make-cancel-key
- id-for-lock password)))
- (if (not (or key-for-key key-for-lock))
- (message "Couldn't insert Canlock header")
- (when key-for-key
- (insert "Cancel-Key: sha1:" key-for-key "\n"))
- (when key-for-lock
- (insert "Cancel-Lock: sha1:"
- (base64-encode-string (canlock-sha1 key-for-lock))
- "\n")))))))))
-
-;;;###autoload
-(defun canlock-verify (&optional buffer)
- "Verify Cancel-Lock or Cancel-Key in BUFFER.
-If BUFFER is nil, the current buffer is assumed. Signal an error if
-it fails."
- (interactive)
- (let (keys locks errmsg id-for-key id-for-lock password
- key-for-key key-for-lock match)
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (save-restriction
- (widen)
- (canlock-narrow-to-header)
- (setq keys (canlock-fetch-fields 'key)
- locks (canlock-fetch-fields))
- (if (not (or keys locks))
- (setq errmsg
- "There are neither Cancel-Lock nor Cancel-Key headers")
- (setq id-for-key (canlock-fetch-id-for-key)
- id-for-lock (mail-fetch-field "Message-ID"))
- (or id-for-key id-for-lock
- (setq errmsg "There are no Message-ID(s)")))))
- (if errmsg
- (error "%s" errmsg)
- (setq password (or canlock-password-for-verify
- (read-passwd "Password for Canlock: ")))
- (if (or (not (stringp password)) (zerop (length password)))
- (error "Password for Canlock is bad")
- (when keys
- (when id-for-key
- (setq key-for-key (canlock-make-cancel-key id-for-key password))
- (while (and keys (not match))
- (setq match (string-equal key-for-key (pop keys)))))
- (setq keys (if match "good" "bad")))
- (setq match nil)
- (when locks
- (when id-for-lock
- (setq key-for-lock
- (base64-encode-string
- (canlock-sha1 (canlock-make-cancel-key id-for-lock
- password))))
- (when (and locks (not match))
- (setq match (string-equal key-for-lock (pop locks)))))
- (setq locks (if match "good" "bad")))
- (prog1
- (when (member "bad" (list keys locks))
- "bad")
- (cond ((and keys locks)
- (message "Cancel-Key is %s, Cancel-Lock is %s" keys locks))
- (locks
- (message "Cancel-Lock is %s" locks))
- (keys
- (message "Cancel-Key is %s" keys))))))))
-
-(provide 'canlock)
-
-;;; arch-tag: 033c4f09-b9f1-459d-bd0d-254430283f78
-;;; canlock.el ends here
+++ /dev/null
-;;; compface.el --- functions for converting X-Face headers
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-;;;###
-(defun uncompface (face)
- "Convert FACE to pbm.
-Requires the external programs `uncompface', and `icontopbm'. On a
-GNU/Linux system these might be in packages with names like `compface'
-or `faces-xface' and `netpbm' or `libgr-progs', for instance."
- (with-temp-buffer
- (insert face)
- (let ((coding-system-for-read 'raw-text)
- ;; At least "icontopbm" doesn't work with Windows because
- ;; the line-break code is converted into CRLF by default.
- (coding-system-for-write 'binary))
- (and (eq 0 (apply 'call-process-region (point-min) (point-max)
- "uncompface"
- 'delete '(t nil) nil))
- (progn
- (goto-char (point-min))
- (insert "/* Width=48, Height=48 */\n")
- ;; I just can't get "icontopbm" to work correctly on its
- ;; own in XEmacs. And Emacs doesn't understand un-raw pbm
- ;; files.
- (if (not (featurep 'xemacs))
- (eq 0 (call-process-region (point-min) (point-max)
- "icontopbm"
- 'delete '(t nil)))
- (shell-command-on-region (point-min) (point-max)
- "icontopbm | pnmnoraw"
- (current-buffer) t)
- t))
- (buffer-string)))))
-
-(provide 'compface)
-
-;;; arch-tag: f9c78e84-98c0-4142-9682-8ba4cf4c3441
-;;; compface.el ends here
+++ /dev/null
-;;; deuglify.el --- deuglify broken Outlook (Express) articles
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Raymond Scholz <rscholz@zonix.de>
-;; Thomas Steffen (unwrapping algorithm,
-;; based on an idea of Stefan Monnier)
-;; Keywords: mail, 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file enables Gnus to repair broken citations produced by
-;; common user agents like MS Outlook (Express). It may repair
-;; articles of other user agents too.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; Outlook sometimes wraps cited lines before sending a message as
-;; seen in this example:
-;;
-;; Example #1
-;; ----------
-;;
-;; John Doe wrote:
-;;
-;; > This sentence no verb. This sentence no verb. This sentence
-;; no
-;; > verb. This sentence no verb. This sentence no verb. This
-;; > sentence no verb.
-;;
-;; The function `gnus-article-outlook-unwrap-lines' tries to recognize those
-;; erroneously wrapped lines and will unwrap them. I.e. putting the
-;; wrapped parts ("no" in this example) back where they belong (at the
-;; end of the cited line above).
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Note that some people not only use broken user agents but also
-;; practice a bad citation style by omitting blank lines between the
-;; cited text and their own text.
-;:
-;; Example #2
-;; ----------
-;;
-;; John Doe wrote:
-;;
-;; > This sentence no verb. This sentence no verb. This sentence no
-;; You forgot in all your sentences.
-;; > verb. This sentence no verb. This sentence no verb. This
-;; > sentence no verb.
-;;
-;; Unwrapping "You forgot in all your sentences." would be invalid as
-;; this part wasn't intended to be cited text.
-;; `gnus-article-outlook-unwrap-lines' will only unwrap lines if the resulting
-;; citation line will be of a certain maximum length. You can control
-;; this by adjusting `gnus-outlook-deuglify-unwrap-max'. Also
-;; unwrapping will only be done if the line above the (possibly)
-;; wrapped line has a minimum length of `gnus-outlook-deuglify-unwrap-min'.
-;;
-;; Furthermore no unwrapping will be undertaken if the last character
-;; is one of the chars specified in
-;; `gnus-outlook-deuglify-unwrap-stop-chars'. Setting this to ".?!"
-;; inhibits unwrapping if the cited line ends with a full stop,
-;; question mark or exclamation mark. Note that this variable
-;; defaults to `nil', triggering a few false positives but generally
-;; giving you better results.
-;;
-;; Unwrapping works on every level of citation. Thus you will be able
-;; repair broken citations of broken user agents citing broken
-;; citations of broken user agents citing broken citations...
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Citations are commonly introduced with an attribution line
-;; indicating who wrote the cited text. Outlook adds superfluous
-;; information that can be found in the header of the message to this
-;; line and often wraps it.
-;;
-;; If that weren't enough, lots of people write their own text above
-;; the cited text and cite the complete original article below.
-;;
-;; Example #3
-;; ----------
-;;
-;; Hey, John. There's no in all your sentences!
-;;
-;; John Doe <john.doe@some.domain> wrote in message
-;; news:a87usw8$dklsssa$2@some.news.server...
-;; > This sentence no verb. This sentence no verb. This sentence
-;; no
-;; > verb. This sentence no verb. This sentence no verb. This
-;; > sentence no verb.
-;; >
-;; > Bye, John
-;;
-;; Repairing the attribution line will be done by function
-;; `gnus-article-outlook-repair-attribution which calls other function that
-;; try to recognize and repair broken attribution lines. See variable
-;; `gnus-outlook-deuglify-attrib-cut-regexp' for stuff that should be
-;; cut off from the beginning of an attribution line and variable
-;; `gnus-outlook-deuglify-attrib-verb-regexp' for the verbs that are
-;; required to be found in an attribution line. These function return
-;; the point where the repaired attribution line starts.
-;;
-;; Rearranging the article so that the cited text appears above the
-;; new text will be done by function
-;; `gnus-article-outlook-rearrange-citation'. This function calls
-;; `gnus-article-outlook-repair-attribution to find and repair an attribution
-;; line.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Well, and that's what the message will look like after applying
-;; deuglification:
-;;
-;; Example #3 (deuglified)
-;; -----------------------
-;;
-;; John Doe <john.doe@some.domain> wrote:
-;;
-;; > This sentence no verb. This sentence no verb. This sentence no
-;; > verb. This sentence no verb. This sentence no verb. This
-;; > sentence no verb.
-;; >
-;; > Bye, John
-;;
-;; Hey, John. There's no in all your sentences!
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Usage
-;; -----
-;;
-;; Press `W k' in the Summary Buffer.
-;;
-;; Non recommended usage :-)
-;; ---------------------
-;;
-;; To automatically invoke deuglification on every article you read,
-;; put something like that in your .gnus:
-;;
-;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-unwrap-lines)
-;;
-;; or _one_ of the following lines:
-;;
-;; ;; repair broken attribution lines
-;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-repair-attribution)
-;;
-;; ;; repair broken attribution lines and citations
-;; (add-hook 'gnus-article-decode-hook 'gnus-article-outlook-rearrange-citation)
-;;
-;; Note that there always may be some false positives, so I suggest
-;; using the manual invocation. After deuglification you may want to
-;; refill the whole article using `W w'.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; Limitations
-;; -----------
-;;
-;; As I said before there may (or will) be a few false positives on
-;; unwrapping cited lines with `gnus-article-outlook-unwrap-lines'.
-;;
-;; `gnus-article-outlook-repair-attribution will only fix the first
-;; attribution line found in the article. Furthermore it fixed to
-;; certain kinds of attributions. And there may be horribly many
-;; false positives, vanishing lines and so on -- so don't trust your
-;; eyes. Again I recommend manual invocation.
-;;
-;; `gnus-article-outlook-rearrange-citation' carries all the limitations of
-;; `gnus-article-outlook-repair-attribution.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; See ChangeLog for other changes.
-;;
-;; Revision 1.5 2002/01/27 14:39:17 rscholz
-;; * New variable `gnus-outlook-deuglify-no-wrap-chars' to inhibit
-;; unwrapping if one these chars is first in the possibly wrapped line.
-;; * Improved rearranging of the article.
-;; * New function `gnus-outlook-repair-attribution-block' for repairing
-;; those big "Original Message (following some headers)" attributions.
-;;
-;; Revision 1.4 2002/01/03 14:05:00 rscholz
-;; Renamed `gnus-outlook-deuglify-article' to
-;; `gnus-article-outlook-deuglify-article'.
-;; Made it easier to deuglify the article while being in Gnus' Article
-;; Edit Mode. (suggested by Phil Nitschke)
-;;
-;;
-;; Revision 1.3 2002/01/02 23:35:54 rscholz
-;; Fix a bug that caused succeeding long attribution lines to be
-;; unwrapped. Minor doc fixes and regular expression tuning.
-;;
-;; Revision 1.2 2001/12/30 20:14:34 rscholz
-;; Clean up source.
-;;
-;; Revision 1.1 2001/12/30 20:13:32 rscholz
-;; Initial revision
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; Code:
-
-(require 'gnus-art)
-(require 'gnus-sum)
-
-(defconst gnus-outlook-deuglify-version "1.5 Gnus version"
- "Version of gnus-outlook-deuglify.")
-
-;;; User Customizable Variables:
-
-(defgroup gnus-outlook-deuglify nil
- "Deuglify articles generated by broken user agents like MS Outlook (Express)."
- :version "22.1"
- :group 'gnus)
-
-(defcustom gnus-outlook-deuglify-unwrap-min 45
- "Minimum length of the cited line above the (possibly) wrapped line."
- :version "22.1"
- :type 'integer
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-unwrap-max 95
- "Maximum length of the cited line after unwrapping."
- :version "22.1"
- :type 'integer
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-cite-marks ">|#%"
- "Characters that indicate cited lines."
- :version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-unwrap-stop-chars nil ;; ".?!" or nil
- "Characters that inhibit unwrapping if they are the last one on the cited line above the possible wrapped line."
- :version "22.1"
- :type '(radio (const :format "None " nil)
- (string :value ".?!"))
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-no-wrap-chars "`"
- "Characters that inhibit unwrapping if they are the first one in the possibly wrapped line."
- :version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-attrib-cut-regexp
- "\\(On \\|Am \\)?\\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),[^,]+, "
- "Regular expression matching the beginning of an attribution line that should be cut off."
- :version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-attrib-verb-regexp
- "wrote\\|writes\\|says\\|schrieb\\|schreibt\\|meinte\\|skrev\\|a écrit\\|schreef\\|escribió"
- "Regular expression matching the verb used in an attribution line."
- :version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-deuglify-attrib-end-regexp
- ": *\\|\\.\\.\\."
- "Regular expression matching the end of an attribution line."
- :version "22.1"
- :type 'string
- :group 'gnus-outlook-deuglify)
-
-(defcustom gnus-outlook-display-hook nil
- "A hook called after an deuglified article has been prepared.
-It is run after `gnus-article-prepare-hook'."
- :version "22.1"
- :type 'hook
- :group 'gnus-outlook-deuglify)
-
-;; Functions
-
-(defun gnus-outlook-display-article-buffer ()
- "Redisplay current buffer or article buffer."
- (with-current-buffer (or gnus-article-buffer (current-buffer))
- ;; "Emulate" `gnus-article-prepare-display' without calling
- ;; it. Calling `gnus-article-prepare-display' on an already
- ;; prepared article removes all MIME parts. I'm unsure whether
- ;; this is a bug or not.
- (gnus-article-highlight t)
- (gnus-treat-article nil)
- (gnus-run-hooks 'gnus-article-prepare-hook
- 'gnus-outlook-display-hook)))
-
-;;;###autoload
-(defun gnus-article-outlook-unwrap-lines (&optional nodisplay)
- "Unwrap lines that appear to be wrapped citation lines.
-You can control what lines will be unwrapped by frobbing
-`gnus-outlook-deuglify-unwrap-min' and `gnus-outlook-deuglify-unwrap-max',
-indicating the minimum and maximum length of an unwrapped citation line. If
-NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
- (save-excursion
- (let ((case-fold-search nil)
- (inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks)
- (no-wrap gnus-outlook-deuglify-no-wrap-chars)
- (stop-chars gnus-outlook-deuglify-unwrap-stop-chars))
- (gnus-with-article-buffer
- (article-goto-body)
- (while (re-search-forward
- (concat
- "^\\([ \t" cite-marks "]*\\)"
- "\\([" cite-marks "].*[^\n " stop-chars "]\\)[ \t]?\n"
- "\\1\\([^\n " cite-marks no-wrap "]+.*\\)$")
- nil t)
- (let ((len12 (- (match-end 2) (match-beginning 1)))
- (len3 (- (match-end 3) (match-beginning 3))))
- (if (and (> len12 gnus-outlook-deuglify-unwrap-min)
- (< (+ len12 len3) gnus-outlook-deuglify-unwrap-max))
- (progn
- (replace-match "\\1\\2 \\3")
- (goto-char (match-beginning 0)))))))))
- (unless nodisplay (gnus-outlook-display-article-buffer)))
-
-(defun gnus-outlook-rearrange-article (attr-start)
- "Put the text from ATTR-START to the end of buffer at the top of the article buffer."
- (save-excursion
- (let ((inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks))
- (gnus-with-article-buffer
- (article-goto-body)
- ;; article does not start with attribution
- (unless (= (point) attr-start)
- (gnus-kill-all-overlays)
- (let ((cur (point))
- ;; before signature or end of buffer
- (to (if (gnus-article-search-signature)
- (point)
- (point-max))))
- ;; handle the case where the full quote is below the
- ;; signature
- (if (< to attr-start)
- (setq to (point-max)))
- (transpose-regions cur attr-start attr-start to)))))))
-
-;; John Doe <john.doe@some.domain> wrote in message
-;; news:a87usw8$dklsssa$2@some.news.server...
-
-(defun gnus-outlook-repair-attribution-outlook ()
- "Repair a broken attribution line (Outlook)."
- (save-excursion
- (let ((case-fold-search nil)
- (inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks))
- (gnus-with-article-buffer
- (article-goto-body)
- (if (re-search-forward
- (concat "^\\([^" cite-marks "].+\\)"
- "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\)"
- "\\(.*\n?[^\n" cite-marks "].*\\)?"
- "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
- nil t)
- (progn
- (gnus-kill-all-overlays)
- (replace-match "\\1\\2\\4")
- (match-beginning 0)))))))
-
-
-;; ----- Original Message -----
-;; From: "John Doe" <john.doe@some.domain>
-;; To: "Doe Foundation" <info@doefnd.org>
-;; Sent: Monday, November 19, 2001 12:13 PM
-;; Subject: More Doenuts
-
-(defun gnus-outlook-repair-attribution-block ()
- "Repair a big broken attribution block."
- (save-excursion
- (let ((case-fold-search nil)
- (inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks))
- (gnus-with-article-buffer
- (article-goto-body)
- (if (re-search-forward
- (concat "^[" cite-marks " \t]*--* ?[^-]+ [^-]+ ?--*\\s *\n"
- "[^\n:]+:[ \t]*\\([^\n]+\\)\n"
- "\\([^\n:]+:[ \t]*[^\n]+\n\\)+")
- nil t)
- (progn
- (gnus-kill-all-overlays)
- (replace-match "\\1 wrote:\n")
- (match-beginning 0)))))))
-
-;; On Wed, 16 Jan 2002 23:23:30 +0100, John Doe <john.doe@some.domain> wrote:
-
-(defun gnus-outlook-repair-attribution-other ()
- "Repair a broken attribution line (other user agents than Outlook)."
- (save-excursion
- (let ((case-fold-search nil)
- (inhibit-read-only t)
- (cite-marks gnus-outlook-deuglify-cite-marks))
- (gnus-with-article-buffer
- (article-goto-body)
- (if (re-search-forward
- (concat "^\\("gnus-outlook-deuglify-attrib-cut-regexp"\\)?"
- "\\([^" cite-marks "].+\\)\n\\([^\n" cite-marks "].*\\)?"
- "\\(" gnus-outlook-deuglify-attrib-verb-regexp "\\).*"
- "\\(" gnus-outlook-deuglify-attrib-end-regexp "\\)$")
- nil t)
- (progn
- (gnus-kill-all-overlays)
- (replace-match "\\4 \\5\\6\\7")
- (match-beginning 0)))))))
-
-;;;###autoload
-(defun gnus-article-outlook-repair-attribution (&optional nodisplay)
- "Repair a broken attribution line.
-If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
- (let ((attrib-start
- (or
- (gnus-outlook-repair-attribution-other)
- (gnus-outlook-repair-attribution-block)
- (gnus-outlook-repair-attribution-outlook))))
- (unless nodisplay (gnus-outlook-display-article-buffer))
- attrib-start))
-
-(defun gnus-article-outlook-rearrange-citation (&optional nodisplay)
- "Repair broken citations.
-If NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
- (let ((attrib-start (gnus-article-outlook-repair-attribution 'nodisplay)))
- ;; rearrange citations if an attribution line has been recognized
- (if attrib-start
- (gnus-outlook-rearrange-article attrib-start)))
- (unless nodisplay (gnus-outlook-display-article-buffer)))
-
-;;;###autoload
-(defun gnus-outlook-deuglify-article (&optional nodisplay)
- "Full deuglify of broken Outlook (Express) articles.
-Treat dumbquotes, unwrap lines, repair attribution and rearrange citation. If
-NODISPLAY is non-nil, don't redisplay the article buffer."
- (interactive "P")
- ;; apply treatment of dumb quotes
- (gnus-article-treat-dumbquotes)
- ;; repair wrapped cited lines
- (gnus-article-outlook-unwrap-lines 'nodisplay)
- ;; repair attribution line and rearrange citation.
- (gnus-article-outlook-rearrange-citation 'nodisplay)
- (unless nodisplay (gnus-outlook-display-article-buffer)))
-
-;;;###autoload
-(defun gnus-article-outlook-deuglify-article ()
- "Deuglify broken Outlook (Express) articles and redisplay."
- (interactive)
- (gnus-outlook-deuglify-article nil))
-
-(provide 'deuglify)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: 5f895cc9-51a9-487c-b42e-28844d79eb73
-;;; deuglify.el ends here
+++ /dev/null
-;;; dgnushack-xemacs.el --- a version of dgnushack.el for XEmacs package
-(defalias 'facep 'ignore)
-
-(defalias 'device-sound-enabled-p 'ignore)
-(defalias 'play-sound-file 'ignore)
-(defalias 'nndb-request-article 'ignore)
-(defalias 'efs-re-read-dir 'ignore)
-(defalias 'ange-ftp-re-read-dir 'ignore)
-(defalias 'define-mail-user-agent 'ignore)
-
-
-(eval-and-compile
- (when (featurep 'xemacs)
- ;; XEmacs 21.1 needs some extra hand holding
- (when (eq emacs-minor-version 1)
- (autoload 'custom-declare-face "cus-face" nil t)
- (autoload 'cl-compile-time-init "cl-macs" nil t)
- (autoload 'defadvice "advice" nil nil 'macro))
- (unless (fboundp 'defadvice)
- (autoload 'defadvice "advice" nil nil 'macro))
- (autoload 'Info-directory "info" nil t)
- (autoload 'Info-menu "info" nil t)
- (autoload 'annotations-at "annotations")
- (autoload 'apropos "apropos" nil t)
- (autoload 'apropos-command "apropos" nil t)
- (autoload 'bbdb-complete-name "bbdb-com" nil t)
- (autoload 'browse-url "browse-url" nil t)
- (autoload 'customize-apropos "cus-edit" nil t)
- (autoload 'customize-save-variable "cus-edit" nil t)
- (autoload 'customize-variable "cus-edit" nil t)
- (autoload 'delete-annotation "annotations")
- (autoload 'dolist "cl-macs" nil nil 'macro)
- (autoload 'enriched-decode "enriched")
- (autoload 'info "info" nil t)
- (autoload 'make-annotation "annotations")
- (autoload 'make-display-table "disp-table")
- (autoload 'pp "pp")
- (autoload 'ps-despool "ps-print" nil t)
- (autoload 'ps-spool-buffer "ps-print" nil t)
- (autoload 'ps-spool-buffer-with-faces "ps-print" nil t)
- (autoload 'read-passwd "passwd")
- (autoload 'regexp-opt "regexp-opt")
- (autoload 'reporter-submit-bug-report "reporter")
- (if (emacs-version>= 21 5)
- (autoload 'setenv "process" nil t)
- (autoload 'setenv "env" nil t))
- (autoload 'smtpmail-send-it "smtpmail")
- (autoload 'sort-numeric-fields "sort" nil t)
- (autoload 'sort-subr "sort")
- (autoload 'trace-function-background "trace" nil t)
- (autoload 'w3-do-setup "w3")
- (autoload 'w3-prepare-buffer "w3-display")
- (autoload 'w3-region "w3-display" nil t)
- (defalias 'match-string-no-properties 'match-string)
- (defalias 'frame-char-height 'frame-height)
- (defalias 'frame-char-width 'frame-width)
- (defalias 'frame-parameter 'frame-property)
- (defalias 'make-overlay 'ignore)
- (defalias 'overlay-end 'ignore)
- (defalias 'overlay-get 'ignore)
- (defalias 'overlay-put 'ignore)
- (defalias 'overlay-start 'ignore)
- (defalias 'overlays-in 'ignore)
- (defalias 'replace-dehighlight 'ignore)
- (defalias 'replace-highlight 'ignore)
- (defalias 'w3-coding-system-for-mime-charset 'ignore)))
-
-;;; dgnushack-xemacs.el ends here
+++ /dev/null
-;;; dgnushack.el --- a hack to set the load path for byte-compiling
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2003,
-;; 2004, 2005, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Version: 4.19
-;; Keywords: news, path
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(defvar dgnushack-default-load-path (copy-sequence load-path))
-
-(defalias 'facep 'ignore)
-
-(require 'cl)
-
-(defvar srcdir (or (getenv "srcdir") "."))
-
-(defun my-getenv (str)
- (let ((val (getenv str)))
- (if (equal val "no") nil val)))
-
-(if (my-getenv "lispdir")
- (push (my-getenv "lispdir") load-path))
-
-(push (or (my-getenv "URLDIR") (expand-file-name "../../url/lisp/" srcdir))
- load-path)
-
-(push (or (my-getenv "W3DIR") (expand-file-name "../../w3/lisp/" srcdir))
- load-path)
-
-;(push "/usr/share/emacs/site-lisp" load-path)
-
-;; Define compiler macros for the functions provided by cl in old Emacsen.
-(unless (featurep 'xemacs)
- (define-compiler-macro butlast (&whole form x &optional n)
- (if (>= emacs-major-version 21)
- form
- (if n
- `(let ((x ,x)
- (n ,n))
- (if (and n (<= n 0))
- x
- (let ((m (length x)))
- (or n (setq n 1))
- (and (< n m)
- (progn
- (if (> n 0)
- (progn
- (setq x (copy-sequence x))
- (setcdr (nthcdr (- (1- m) n) x) nil)))
- x)))))
- `(let* ((x ,x)
- (m (length x)))
- (and (< 1 m)
- (progn
- (setq x (copy-sequence x))
- (setcdr (nthcdr (- m 2) x) nil)
- x))))))
-
- (define-compiler-macro remove (&whole form item seq)
- (if (>= emacs-major-version 21)
- form
- `(delete ,item (copy-sequence ,seq))))
-
- (define-compiler-macro mapc (&whole form fn seq &rest rest)
- (if (>= emacs-major-version 21)
- form
- (if rest
- `(let* ((fn ,fn)
- (seq ,seq)
- (args (list seq ,@rest))
- (m (apply (function min) (mapcar (function length) args)))
- (n 0))
- (while (< n m)
- (apply fn (mapcar (function (lambda (arg) (nth n arg))) args))
- (setq n (1+ n)))
- seq)
- `(let ((seq ,seq))
- (mapcar ,fn seq)
- seq)))))
-
-;; If we are building w3 in a different directory than the source
-;; directory, we must read *.el from source directory and write *.elc
-;; into the building directory. For that, we define this function
-;; before loading bytecomp. Bytecomp doesn't overwrite this function.
-(defun byte-compile-dest-file (filename)
- "Convert an Emacs Lisp source file name to a compiled file name.
- In addition, remove directory name part from FILENAME."
- (setq filename (byte-compiler-base-file-name filename))
- (setq filename (file-name-sans-versions filename))
- (setq filename (file-name-nondirectory filename))
- (if (memq system-type '(win32 w32 mswindows windows-nt))
- (setq filename (downcase filename)))
- (cond ((eq system-type 'vax-vms)
- (concat (substring filename 0 (string-match ";" filename)) "c"))
- ((string-match emacs-lisp-file-regexp filename)
- (concat (substring filename 0 (match-beginning 0)) ".elc"))
- (t (concat filename ".elc"))))
-
-(require 'bytecomp)
-;; To avoid having defsubsts and inlines happen.
-;(if (featurep 'xemacs)
-; (require 'byte-optimize)
-; (require 'byte-opt))
-;(defun byte-optimize-inline-handler (form)
-; "byte-optimize-handler for the `inline' special-form."
-; (cons 'progn (cdr form)))
-;(defalias 'byte-compile-file-form-defsubst 'byte-compile-file-form-defun)
-
-(when (and (not (featurep 'xemacs))
- (= emacs-major-version 21)
- (>= emacs-minor-version 3)
- (condition-case code
- (let ((byte-compile-error-on-warn t))
- (byte-optimize-form (quote (pop x)) t)
- nil)
- (error (string-match "called for effect"
- (error-message-string code)))))
- (defadvice byte-optimize-form-code-walker (around silence-warn-for-pop
- (form for-effect)
- activate)
- "Silence the warning \"...called for effect\" for the `pop' form.
-It is effective only when the `pop' macro is defined by cl.el rather
-than subr.el."
- (let (tmp)
- (if (and (eq (car-safe form) 'car)
- for-effect
- (setq tmp (get 'car 'side-effect-free))
- (not byte-compile-delete-errors)
- (not (eq tmp 'error-free))
- (eq (car-safe (cadr form)) 'prog1)
- (let ((var (cadr (cadr form)))
- (last (nth 2 (cadr form))))
- (and (symbolp var)
- (null (nthcdr 3 (cadr form)))
- (eq (car-safe last) 'setq)
- (eq (cadr last) var)
- (eq (car-safe (nth 2 last)) 'cdr)
- (eq (cadr (nth 2 last)) var))))
- (progn
- (put 'car 'side-effect-free 'error-free)
- (unwind-protect
- ad-do-it
- (put 'car 'side-effect-free tmp)))
- ad-do-it))))
-
-(push srcdir load-path)
-(load (expand-file-name "lpath.el" srcdir) nil t)
-
-(defalias 'device-sound-enabled-p 'ignore)
-(defalias 'play-sound-file 'ignore)
-(defalias 'nndb-request-article 'ignore)
-(defalias 'efs-re-read-dir 'ignore)
-(defalias 'ange-ftp-re-read-dir 'ignore)
-(defalias 'define-mail-user-agent 'ignore)
-
-(eval-and-compile
- (unless (featurep 'xemacs)
- (defalias 'get-popup-menu-response 'ignore)
- (defalias 'event-object 'ignore)
- (defalias 'x-defined-colors 'ignore)
- (defalias 'read-color 'ignore)))
-
-(eval-and-compile
- (when (featurep 'xemacs)
- ;; XEmacs 21.1 needs some extra hand holding
- (when (eq emacs-minor-version 1)
- (autoload 'custom-declare-face "cus-face" nil t)
- (autoload 'cl-compile-time-init "cl-macs" nil t)
- (autoload 'defadvice "advice" nil nil 'macro))
- (unless (fboundp 'defadvice)
- (autoload 'defadvice "advice" nil nil 'macro))
- (autoload 'Info-directory "info" nil t)
- (autoload 'Info-menu "info" nil t)
- (autoload 'ad-add-advice "advice")
- (autoload 'annotations-at "annotations")
- (autoload 'apropos "apropos" nil t)
- (autoload 'apropos-command "apropos" nil t)
- (autoload 'bbdb-complete-name "bbdb-com" nil t)
- (autoload 'browse-url "browse-url" nil t)
- (autoload 'customize-apropos "cus-edit" nil t)
- (autoload 'customize-group "cus-edit" nil t)
- (autoload 'customize-save-variable "cus-edit" nil t)
- (autoload 'customize-variable "cus-edit" nil t)
- (if (featurep 'mule)
- (unless (locate-library "mule-ccl")
- (autoload 'define-ccl-program "ccl" nil nil 'macro))
- (defalias 'define-ccl-program 'ignore))
- (autoload 'delete-annotation "annotations")
- (autoload 'dolist "cl-macs" nil nil 'macro)
- (autoload 'enriched-decode "enriched")
- (autoload 'info "info" nil t)
- (autoload 'mail-extract-address-components "mail-extr")
- (autoload 'mail-fetch-field "mail-utils")
- (autoload 'make-annotation "annotations")
- (autoload 'make-display-table "disp-table")
- (autoload 'pp "pp")
- (autoload 'ps-despool "ps-print" nil t)
- (autoload 'ps-spool-buffer "ps-print" nil t)
- (autoload 'ps-spool-buffer-with-faces "ps-print" nil t)
- (autoload 'read-passwd "passwd")
- (autoload 'regexp-opt "regexp-opt")
- (autoload 'reporter-submit-bug-report "reporter")
- (if (emacs-version>= 21 5)
- (autoload 'setenv "process" nil t)
- (autoload 'setenv "env" nil t))
- (autoload 'sgml-mode "psgml" nil t)
- (autoload 'smtpmail-send-it "smtpmail")
- (autoload 'sort-numeric-fields "sort" nil t)
- (autoload 'sort-subr "sort")
- (autoload 'trace-function-background "trace" nil t)
- (autoload 'w3-do-setup "w3")
- (autoload 'w3-prepare-buffer "w3-display")
- (autoload 'w3-region "w3-display" nil t)
- (defalias 'frame-char-height 'frame-height)
- (defalias 'frame-char-width 'frame-width)
- (defalias 'frame-parameter 'frame-property)
- (defalias 'make-overlay 'ignore)
- (defalias 'overlay-end 'ignore)
- (defalias 'overlay-get 'ignore)
- (defalias 'overlay-put 'ignore)
- (defalias 'overlay-start 'ignore)
- (defalias 'overlays-in 'ignore)
- (defalias 'replace-dehighlight 'ignore)
- (defalias 'replace-highlight 'ignore)
- (defalias 'w3-coding-system-for-mime-charset 'ignore)))
-
-(defun dgnushack-compile-verbosely ()
- "Call dgnushack-compile with warnings ENABLED. If you are compiling
-patches to gnus, you should consider modifying make.bat to call
-dgnushack-compile-verbosely. All other users should continue to use
-dgnushack-compile."
- (dgnushack-compile t))
-
-(defun dgnushack-compile (&optional warn)
- ;;(setq byte-compile-dynamic t)
- (when (and (not (featurep 'xemacs))
- (< emacs-major-version 21))
- (setq max-specpdl-size 1200))
- (unless warn
- (setq byte-compile-warnings
- '(free-vars unresolved callargs redefine)))
- (unless (locate-library "cus-edit")
- (error "You do not seem to have Custom installed.
-Fetch it from <URL:http://www.dina.kvl.dk/~abraham/custom/>.
-You also then need to add the following to the lisp/dgnushack.el file:
-
- (push \"~/lisp/custom\" load-path)
-
-Modify to suit your needs."))
- (let ((files (directory-files srcdir nil "^[^=].*\\.el$"))
- ;;(byte-compile-generate-call-tree t)
- file elc)
- ;; Avoid barfing (from gnus-xmas) because the etc directory is not yet
- ;; installed.
- (when (featurep 'xemacs)
- (setq gnus-xmas-glyph-directory "dummy"))
- (dolist (file '("dgnushack.el" "lpath.el"))
- (setq files (delete file files)))
- (when (featurep 'base64)
- (setq files (delete "base64.el" files)))
- (condition-case code
- (require 'w3-parse)
- (error
- (message "No w3: %s %s" (cadr code) (or (locate-library "w3-parse") ""))
- (dolist (file '("nnultimate.el" "webmail.el" "nnwfm.el"))
- (setq files (delete file files)))))
- (condition-case code
- (require 'mh-e)
- (error
- (message "No mh-e: %s %s" (cadr code) (or (locate-library "mh-e") ""))
- (setq files (delete "gnus-mh.el" files))))
- (condition-case code
- (require 'xml)
- (error
- (message "No xml: %s %s" (cadr code) (or (locate-library "xml") ""))
- (setq files (delete "nnrss.el" files))))
- (dolist (file
- (if (featurep 'xemacs)
- '("md5.el")
- '("gnus-xmas.el" "messagexmas.el" "nnheaderxm.el")))
- (setq files (delete file files)))
-
- (dolist (file files)
- (setq file (expand-file-name file srcdir))
- (when (and (file-exists-p
- (setq elc (concat (file-name-nondirectory file) "c")))
- (file-newer-than-file-p file elc))
- (delete-file elc)))
-
- (while (setq file (pop files))
- (setq file (expand-file-name file srcdir))
- (when (or (not (file-exists-p
- (setq elc (concat (file-name-nondirectory file) "c"))))
- (file-newer-than-file-p file elc))
- (ignore-errors
- (byte-compile-file file))))))
-
-(defun dgnushack-recompile ()
- (require 'gnus)
- (byte-recompile-directory "." 0))
-
-(defvar dgnushack-gnus-load-file
- (if (featurep 'xemacs)
- (expand-file-name "auto-autoloads.el")
- (expand-file-name "gnus-load.el")))
-
-(defvar dgnushack-cus-load-file
- (if (featurep 'xemacs)
- (expand-file-name "custom-load.el")
- (expand-file-name "cus-load.el")))
-
-(defun dgnushack-make-cus-load ()
- (load "cus-dep")
- (let ((cusload-base-file dgnushack-cus-load-file))
- (if (fboundp 'custom-make-dependencies)
- (custom-make-dependencies)
- (Custom-make-dependencies))
- (when (featurep 'xemacs)
- (message "Compiling %s..." dgnushack-cus-load-file)
- (byte-compile-file dgnushack-cus-load-file))))
-
-(defun dgnushack-make-auto-load ()
- (require 'autoload)
- (unless (make-autoload '(define-derived-mode child parent name
- "docstring" body)
- "file")
- (defadvice make-autoload (around handle-define-derived-mode activate)
- "Handle `define-derived-mode'."
- (if (eq (car-safe (ad-get-arg 0)) 'define-derived-mode)
- (setq ad-return-value
- (list 'autoload
- (list 'quote (nth 1 (ad-get-arg 0)))
- (ad-get-arg 1)
- (nth 4 (ad-get-arg 0))
- t nil))
- ad-do-it))
- (put 'define-derived-mode 'doc-string-elt 3))
- (let ((generated-autoload-file dgnushack-gnus-load-file)
- (make-backup-files nil)
- (autoload-package-name "gnus"))
- (if (featurep 'xemacs)
- (if (file-exists-p generated-autoload-file)
- (delete-file generated-autoload-file))
- (with-temp-file generated-autoload-file
- (insert ?\014)))
- (batch-update-autoloads)))
-
-(defun dgnushack-make-load ()
- (unless (featurep 'xemacs)
- (message "Generating %s..." dgnushack-gnus-load-file)
- (with-temp-file dgnushack-gnus-load-file
- (insert-file-contents dgnushack-cus-load-file)
- (delete-file dgnushack-cus-load-file)
- (goto-char (point-min))
- (search-forward ";;; Code:")
- (forward-line)
- (delete-region (point-min) (point))
- (insert "\
-;;; gnus-load.el --- automatically extracted custom dependencies and autoload
-;;
-;;; Code:
-")
- (goto-char (point-max))
- (if (search-backward "custom-versions-load-alist" nil t)
- (forward-line -1)
- (forward-line -1)
- (while (eq (char-after) ?\;)
- (forward-line -1))
- (forward-line))
- (delete-region (point) (point-max))
- (insert "\n")
- ;; smiley-* are duplicated. Remove them all.
- (let ((point (point)))
- (insert-file-contents dgnushack-gnus-load-file)
- (goto-char point)
- (while (search-forward "smiley-" nil t)
- (beginning-of-line)
- (if (looking-at "(autoload ")
- (delete-region (point) (progn (forward-sexp) (point)))
- (forward-line))))
- ;;
- (goto-char (point-max))
- (when (search-backward "\n(provide " nil t)
- (forward-line -1)
- (delete-region (point) (point-max)))
- (insert "\
-
-\(provide 'gnus-load)
-
-;;; Local Variables:
-;;; version-control: never
-;;; no-byte-compile: t
-;;; no-update-autoloads: t
-;;; End:
-;;; gnus-load.el ends here
-")
- ))
- (message "Compiling %s..." dgnushack-gnus-load-file)
- (byte-compile-file dgnushack-gnus-load-file)
- (when (featurep 'xemacs)
- (message "Creating dummy gnus-load.el...")
- (with-temp-file (expand-file-name "gnus-load.el")
- (insert "\
-
-\(provide 'gnus-load)
-
-;;; Local Variables:
-;;; version-control: never
-;;; no-byte-compile: t
-;;; no-update-autoloads: t
-;;; End:
-;;; gnus-load.el ends here"))))
-
-(defun dgnushack-find-lisp-shadows (&optional lispdir)
- "Return a list of directories in which other Gnus installations exist.
-This function looks for the other Gnus installations which will shadow
-the new Gnus Lisp modules which have been installed in LISPDIR, using
-the default `load-path'. The return value will make sense only when
-LISPDIR is existent and is listed in the default `load-path'. Assume
-LISPDIR will be prepended to `load-path' by a user if the default
-`load-path' does not contain it."
- (unless lispdir
- (setq lispdir (getenv "lispdir")))
- (when (and lispdir (file-directory-p lispdir))
- (setq lispdir (file-truename (directory-file-name lispdir)))
- (let ((indices '("gnus.elc" "gnus.el" "gnus.el.bz2" "gnus.el.gz"
- "message.elc" "message.el" "message.el.bz2"
- "message.el.gz"))
- (path (delq nil (mapcar
- (lambda (p)
- (condition-case nil
- (when (and p (file-directory-p p))
- (file-truename (directory-file-name p)))
- (error nil)))
- dgnushack-default-load-path)))
- rest elcs)
- (while path
- (setq rest (cons (car path) rest)
- path (delete (car rest) (cdr path))))
- (setq path (nreverse (cdr (member lispdir rest)))
- rest nil)
- (while path
- (setq elcs indices)
- (while elcs
- (when (file-exists-p (expand-file-name (pop elcs) (car path)))
- (setq rest (cons (car path) rest)
- elcs nil)))
- (setq path (cdr path)))
- (prog1
- (setq path (nreverse rest))
- (when path
- (let (print-level print-length)
- (princ (concat "\n\
-WARNING: The other Gnus installation" (if (cdr path) "s have" " has") "\
- been detected in:\n\n " (mapconcat 'identity path "\n ") "\n\n\
-You will need to modify the run-time `load-path', remove them manually,
-or remove them using `make remove-installed-shadows'.\n\n"))))))))
-
-(defun dgnushack-remove-lisp-shadows (&optional lispdir)
- "Remove the other Gnus installations which shadow the recent one."
- (let ((path (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (dgnushack-find-lisp-shadows lispdir))))
- elcs files shadows file)
- (when path
- (unless (setq elcs (directory-files srcdir nil "\\.elc\\'"))
- (error "You should build .elc files first."))
- (setq files
- (apply
- 'append
- (mapcar
- (lambda (el)
- (list (concat el "c") el (concat el ".bz2") (concat el ".gz")))
- (append
- (list (file-name-nondirectory dgnushack-gnus-load-file)
- (file-name-nondirectory dgnushack-cus-load-file))
- (mapcar (lambda (elc) (substring elc 0 -1)) elcs)))))
- (while path
- (setq shadows files)
- (while shadows
- (setq file (expand-file-name (pop shadows) (car path)))
- (when (file-exists-p file)
- (princ (concat " Removing " file "..."))
- (condition-case nil
- (progn
- (delete-file file)
- (princ "done\n"))
- (error (princ "failed\n")))))
- (setq path (cdr path))))))
-
-;;; dgnushack.el ends here
-
-;;; arch-tag: 579f585a-24eb-4e1c-8d34-4808e11b68f2
+++ /dev/null
-;;; earcon.el --- Sound effects for messages
-
-;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-;; This file provides access to sound effects in Gnus.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'gnus)
-(require 'gnus-audio)
-(require 'gnus-art)
-
-(defgroup earcon nil
- "Turn ** sounds ** into noise."
- :group 'gnus-visual)
-
-(defcustom earcon-prefix "**"
- "*String denoting the start of an earcon."
- :type 'string
- :group 'earcon)
-
-(defcustom earcon-suffix "**"
- "String denoting the end of an earcon."
- :type 'string
- :group 'earcon)
-
-(defcustom 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.wav")
- ("sob\\|boohoo" 1 "cry.wav")
- ("drum[ \t]*roll" 1 "drumroll.au")
- ("blast" 1 "explosion.au")
- ("flush\\|plonk!*" 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."
- :type '(repeat (list regexp
- (integer :tag "Match")
- (string :tag "Sound")))
- :group 'earcon)
-(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-audio-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-audio-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)
-
-;;; arch-tag: 844dfeea-980c-4ed0-907f-a30bf139691c
-;;; earcon.el ends here
+++ /dev/null
-;;; flow-fill.el --- interpret RFC2646 "flowed" text
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <jas@pdc.kth.se>
-;; Keywords: mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This implement decoding of RFC2646 formatted text, including the
-;; quoted-depth wins rules.
-
-;; Theory of operation: search for lines ending with SPC, save quote
-;; length of line, remove SPC and concatenate line with the following
-;; line if quote length of following line matches current line.
-
-;; When no further concatenations are possible, we've found a
-;; paragraph and we let `fill-region' fill the long line into several
-;; lines with the quote prefix as `fill-prefix'.
-
-;; Todo: implement basic `fill-region' (Emacs and XEmacs
-;; implementations differ..)
-
-;;; History:
-
-;; 2000-02-17 posted on ding mailing list
-;; 2000-02-19 use `point-at-{b,e}ol' in XEmacs
-;; 2000-03-11 no compile warnings for point-at-bol stuff
-;; 2000-03-26 committed to gnus cvs
-;; 2000-10-23 don't flow "-- " lines, make "quote-depth wins" rule
-;; work when first line is at level 0.
-;; 2002-01-12 probably incomplete encoding support
-;; 2003-12-08 started working on test harness.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defcustom fill-flowed-display-column 'fill-column
- "Column beyond which format=flowed lines are wrapped, when displayed.
-This can be a Lisp expression or an integer."
- :version "22.1"
- :group 'mime-display
- :type '(choice (const :tag "Standard `fill-column'" fill-column)
- (const :tag "Fit Window" (- (window-width) 5))
- (sexp)
- (integer)))
-
-(defcustom fill-flowed-encode-column 66
- "Column beyond which format=flowed lines are wrapped, in outgoing messages.
-This can be a Lisp expression or an integer.
-RFC 2646 suggests 66 characters for readability."
- :version "22.1"
- :group 'mime-display
- :type '(choice (const :tag "Standard fill-column" fill-column)
- (const :tag "RFC 2646 default (66)" 66)
- (sexp)
- (integer)))
-
-(eval-and-compile
- (defalias 'fill-flowed-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
- (defalias 'fill-flowed-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
-;;;###autoload
-(defun fill-flowed-encode (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- ;; No point in doing this unless hard newlines is used.
- (when use-hard-newlines
- (let ((start (point-min)) end)
- ;; Go through each paragraph, filling it and adding SPC
- ;; as the last character on each line.
- (while (setq end (text-property-any start (point-max) 'hard 't))
- (let ((fill-column (eval fill-flowed-encode-column)))
- (fill-region start end t 'nosqueeze 'to-eop))
- (goto-char start)
- ;; `fill-region' probably distorted end.
- (setq end (text-property-any start (point-max) 'hard 't))
- (while (and (< (point) end)
- (re-search-forward "$" (1- end) t))
- (insert " ")
- (setq end (1+ end))
- (forward-char))
- (goto-char (setq start (1+ end)))))
- t)))
-
-;;;###autoload
-(defun fill-flowed (&optional buffer)
- (save-excursion
- (set-buffer (or (current-buffer) buffer))
- (goto-char (point-min))
- ;; Remove space stuffing.
- (while (re-search-forward "^\\( \\|>+ $\\)" nil t)
- (delete-char -1)
- (forward-line 1))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (when (save-excursion
- (beginning-of-line)
- (looking-at "^\\(>*\\)\\( ?\\)"))
- (let ((quote (match-string 1))
- sig)
- (if (string= quote "")
- (setq quote nil))
- (when (and quote (string= (match-string 2) ""))
- (save-excursion
- ;; insert SP after quote for pleasant reading of quoted lines
- (beginning-of-line)
- (when (> (skip-chars-forward ">") 0)
- (insert " "))))
- ;; XXX slightly buggy handling of "-- "
- (while (and (save-excursion
- (ignore-errors (backward-char 3))
- (setq sig (looking-at "-- "))
- (looking-at "[^-][^-] "))
- (save-excursion
- (unless (eobp)
- (forward-char 1)
- (looking-at (format "^\\(%s\\)\\([^>\n\r]\\)"
- (or quote " ?"))))))
- (save-excursion
- (replace-match (if (string= (match-string 2) " ")
- "" "\\2")))
- (backward-delete-char -1)
- (end-of-line))
- (unless sig
- (condition-case nil
- (let ((fill-prefix (when quote (concat quote " ")))
- (fill-column (eval fill-flowed-display-column))
- filladapt-mode
- adaptive-fill-mode)
- (fill-region (fill-flowed-point-at-bol)
- (min (1+ (fill-flowed-point-at-eol))
- (point-max))
- 'left 'nosqueeze))
- (error
- (forward-line 1)
- nil))))))))
-
-;; Test vectors.
-
-(eval-when-compile
- (defvar show-trailing-whitespace))
-
-(defvar fill-flowed-encode-tests
- `(
- ;; The syntax of each list element is:
- ;; (INPUT . EXPECTED-OUTPUT)
- (,(concat
- "> Thou villainous ill-breeding spongy dizzy-eyed \n"
- "> reeky elf-skinned pigeon-egg! \n"
- ">> Thou artless swag-bellied milk-livered \n"
- ">> dismal-dreaming idle-headed scut!\n"
- ">>> Thou errant folly-fallen spleeny reeling-ripe \n"
- ">>> unmuzzled ratsbane!\n"
- ">>>> Henceforth, the coding style is to be strictly \n"
- ">>>> enforced, including the use of only upper case.\n"
- ">>>>> I've noticed a lack of adherence to the coding \n"
- ">>>>> styles, of late.\n"
- ">>>>>> Any complaints?")
- .
- ,(concat
- "> Thou villainous ill-breeding spongy dizzy-eyed reeky elf-skinned\n"
- "> pigeon-egg! \n"
- ">> Thou artless swag-bellied milk-livered dismal-dreaming idle-headed\n"
- ">> scut!\n"
- ">>> Thou errant folly-fallen spleeny reeling-ripe unmuzzled ratsbane!\n"
- ">>>> Henceforth, the coding style is to be strictly enforced,\n"
- ">>>> including the use of only upper case.\n"
- ">>>>> I've noticed a lack of adherence to the coding styles, of late.\n"
- ">>>>>> Any complaints?\n"
- ))
- ;; (,(concat
- ;; "\n"
- ;; "> foo\n"
- ;; "> \n"
- ;; "> \n"
- ;; "> bar\n")
- ;; .
- ;; ,(concat
- ;; "\n"
- ;; "> foo bar\n"))
- ))
-
-(defun fill-flowed-test ()
- (interactive "")
- (switch-to-buffer (get-buffer-create "*Format=Flowed test output*"))
- (erase-buffer)
- (setq show-trailing-whitespace t)
- (dolist (test fill-flowed-encode-tests)
- (let (start output)
- (insert "***** BEGIN TEST INPUT *****\n")
- (insert (car test))
- (insert "***** END TEST INPUT *****\n\n")
- (insert "***** BEGIN TEST OUTPUT *****\n")
- (setq start (point))
- (insert (car test))
- (save-restriction
- (narrow-to-region start (point))
- (fill-flowed))
- (setq output (buffer-substring start (point-max)))
- (insert "***** END TEST OUTPUT *****\n")
- (unless (string= output (cdr test))
- (insert "\n***** BEGIN TEST EXPECTED OUTPUT *****\n")
- (insert (cdr test))
- (insert "***** END TEST EXPECTED OUTPUT *****\n"))
- (insert "\n\n")))
- (goto-char (point-max)))
-
-(provide 'flow-fill)
-
-;;; arch-tag: addc0040-bc53-4f17-b4bc-1eb44eed6f0b
-;;; flow-fill.el ends here
+++ /dev/null
-;;; format-spec.el --- functions for formatting arbitrary formatting strings
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: tools
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defun format-spec (format specification)
- "Return a string based on FORMAT and SPECIFICATION.
-FORMAT is a string containing `format'-like specs like \"bash %u %k\",
-while SPECIFICATION is an alist mapping from format spec characters
-to values. Any text properties on a %-spec itself are propagated to
-the text that it generates."
- (with-temp-buffer
- (insert format)
- (goto-char (point-min))
- (while (search-forward "%" nil t)
- (cond
- ;; Quoted percent sign.
- ((eq (char-after) ?%)
- (delete-char 1))
- ;; Valid format spec.
- ((looking-at "\\([-0-9.]*\\)\\([a-zA-Z]\\)")
- (let* ((num (match-string 1))
- (spec (string-to-char (match-string 2)))
- (val (cdr (assq spec specification))))
- (unless val
- (error "Invalid format character: %s" spec))
- ;; Pad result to desired length.
- (let ((text (format (concat "%" num "s") val)))
- ;; Insert first, to preserve text properties.
- (insert-and-inherit text)
- ;; Delete the specifier body.
- (delete-region (+ (match-beginning 0) (length text))
- (+ (match-end 0) (length text)))
- ;; Delete the percent sign.
- (delete-region (1- (match-beginning 0)) (match-beginning 0)))))
- ;; Signal an error on bogus format strings.
- (t
- (error "Invalid format string"))))
- (buffer-string)))
-
-(defun format-spec-make (&rest pairs)
- "Return an alist suitable for use in `format-spec' based on PAIRS.
-PAIRS is a list where every other element is a character and a value,
-starting with a character."
- (let (alist)
- (while pairs
- (unless (cdr pairs)
- (error "Invalid list of pairs"))
- (push (cons (car pairs) (cadr pairs)) alist)
- (setq pairs (cddr pairs)))
- (nreverse alist)))
-
-(provide 'format-spec)
-
-;;; arch-tag: c22d49cf-d167-445d-b7f1-2504d4173f53
-;;; format-spec.el ends here
+++ /dev/null
-;;; gmm-utils.el --- Utility functions for Gnus, Message and MML
-
-;; Copyright (C) 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Reiner Steib <reiner.steib@gmx.de>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This library provides self-contained utility functions. The functions are
-;; used in Gnus, Message and MML, but within this library there are no
-;; dependencies on Gnus, Message, or MML.
-
-;;; Code:
-
-(require 'wid-edit)
-
-(defgroup gmm nil
- "Utility functions for Gnus, Message and MML"
- :prefix "gmm-"
- :version "22.1" ;; Gnus 5.10.9
- :group 'lisp)
-
-;; Helper functions from `gnus-utils.el': gmm-verbose, gmm-message, gmm-error
-
-(defcustom gmm-verbose 7
- "Integer that says how verbose gmm should be.
-The higher the number, the more messages will flash to say what
-it done. At zero, it will be totally mute; at five, it will
-display most important messages; and at ten, it will keep on
-jabbering all the time."
- :type 'integer
- :group 'gmm)
-
-;;;###autoload
-(defun gmm-message (level &rest args)
- "If LEVEL is lower than `gmm-verbose' print ARGS using `message'.
-
-Guideline for numbers:
-1 - error messages, 3 - non-serious error messages, 5 - messages for things
-that take a long time, 7 - not very important messages on stuff, 9 - messages
-inside loops."
- (if (<= level gmm-verbose)
- (apply 'message args)
- ;; We have to do this format thingy here even if the result isn't
- ;; shown - the return value has to be the same as the return value
- ;; from `message'.
- (apply 'format args)))
-
-;;;###autoload
-(defun gmm-error (level &rest args)
- "Beep an error if LEVEL is equal to or less than `gmm-verbose'.
-ARGS are passed to `message'."
- (when (<= (floor level) gmm-verbose)
- (apply 'message args)
- (ding)
- (let (duration)
- (when (and (floatp level)
- (not (zerop (setq duration (* 10 (- level (floor level)))))))
- (sit-for duration))))
- nil)
-
-;;;###autoload
-(defun gmm-widget-p (symbol)
- "Non-nil if SYMBOL is a widget."
- (get symbol 'widget-type))
-
-;; Copy of the `nnmail-lazy' code from `nnmail.el':
-(define-widget 'gmm-lazy 'default
- "Base widget for recursive datastructures.
-
-This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
- :format "%{%t%}: %v"
- :convert-widget 'widget-value-convert-widget
- :value-create (lambda (widget)
- (let ((value (widget-get widget :value))
- (type (widget-get widget :type)))
- (widget-put widget :children
- (list (widget-create-child-value
- widget (widget-convert type) value)))))
- :value-delete 'widget-children-value-delete
- :value-get (lambda (widget)
- (widget-value (car (widget-get widget :children))))
- :value-inline (lambda (widget)
- (widget-apply (car (widget-get widget :children))
- :value-inline))
- :default-get (lambda (widget)
- (widget-default-get
- (widget-convert (widget-get widget :type))))
- :match (lambda (widget value)
- (widget-apply (widget-convert (widget-get widget :type))
- :match value))
- :validate (lambda (widget)
- (widget-apply (car (widget-get widget :children)) :validate)))
-
-;; Note: The format of `gmm-tool-bar-item' may change if some future Emacs
-;; version will provide customizable tool bar buttons using a different
-;; interface.
-
-;; TODO: Extend API so that the "Command" entry can be a function or a plist.
-;; In case of a list it should have the format...
-;;
-;; (:none command-without-modifier
-;; :shift command-with-shift-pressed
-;; :control command-with-ctrl-pressed
-;; :control-shift command-with-control-and-shift-pressed
-;; ;; mouse-2 and mouse-3 can't be used in Emacs yet.
-;; :mouse-2 command-on-mouse-2-press
-;; :mouse-3 command-on-mouse-3-press) ;; typically a menu of related commands
-;;
-;; Combinations of mouse-[23] plus shift and/or controll might be overkill.
-;;
-;; Then use (plist-get rs-command :none), (plist-get rs-command :shift)
-
-(define-widget 'gmm-tool-bar-item (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
- "Tool bar list item."
- :tag "Tool bar item"
- :type '(choice
- (list :tag "Command and Icon"
- (function :tag "Command")
- (string :tag "Icon file")
- (choice
- (const :tag "Default map" nil)
- ;; Note: Usually we need non-nil attributes if map is t.
- (const :tag "No menu" t)
- (sexp :tag "Other map"))
- (plist :inline t :tag "Properties"))
- (list :tag "Separator"
- (const :tag "No command" gmm-ignore)
- (string :tag "Icon file")
- (const :tag "No map")
- (plist :inline t :tag "Properties"))))
-
-(define-widget 'gmm-tool-bar-zap-list (if (gmm-widget-p 'lazy) 'lazy 'gmm-lazy)
- "Tool bar zap list."
- :tag "Tool bar zap list"
- :type '(choice (const :tag "Zap all" t)
- (const :tag "Keep all" nil)
- (list
- ;; :value
- ;; Work around (bug in customize?), see
- ;; <news:v9is48jrj1.fsf@marauder.physik.uni-ulm.de>
- ;; (new-file open-file dired kill-buffer write-file
- ;; print-buffer customize help)
- (set :inline t
- (const new-file)
- (const open-file)
- (const dired)
- (const kill-buffer)
- (const save-buffer)
- (const write-file)
- (const undo)
- (const cut)
- (const copy)
- (const paste)
- (const search-forward)
- (const print-buffer)
- (const customize)
- (const help))
- (repeat :inline t
- :tag "Other"
- (symbol :tag "Icon item")))))
-
-;; (defun gmm-color-cells (&optional display)
-;; "Return the number of color cells supported by DISPLAY.
-;; Compatibility function."
-;; ;; `display-color-cells' doesn't return more than 256 even if color depth is
-;; ;; > 8 in Emacs 21.
-;; ;;
-;; ;; Feel free to add proper XEmacs support.
-;; (let* ((cells (and (fboundp 'display-color-cells)
-;; (display-color-cells display)))
-;; (plane (and (fboundp 'x-display-planes)
-;; (ash 1 (x-display-planes))))
-;; (none -1))
-;; (max (if (integerp cells) cells none)
-;; (if (integerp plane) plane none))))
-
-(defcustom gmm-tool-bar-style
- (if (and (boundp 'tool-bar-mode)
- tool-bar-mode
- (and (fboundp 'display-visual-class)
- (not (memq (display-visual-class)
- (list 'static-gray 'gray-scale
- 'static-color 'pseudo-color)))))
- 'gnome
- 'retro)
- "Prefered tool bar style."
- :type '(choice (const :tag "GNOME style" gnome)
- (const :tag "Retro look" retro))
- :group 'gmm)
-
-(defvar tool-bar-map)
-
-;;;###autoload
-(defun gmm-tool-bar-from-list (icon-list zap-list default-map)
- "Make a tool bar from ICON-LIST.
-
-Within each entry of ICON-LIST, the first element is a menu
-command, the second element is an icon file name and the third
-element is a test function. You can use \\[describe-key]
-<menu-entry> to find out the name of a menu command. The fourth
-and all following elements are passed as the PROPS argument to the
-function `tool-bar-local-item'.
-
-If ZAP-LIST is a list, remove those item from the default
-`tool-bar-map'. If it is t, start with a new sparse map. You
-can use \\[describe-key] <icon> to find out the name of an icon
-item. When \\[describe-key] <icon> shows \"<tool-bar> <new-file>
-runs the command find-file\", then use `new-file' in ZAP-LIST.
-
-DEFAULT-MAP specifies the default key map for ICON-LIST."
- (let (;; For Emacs 21, we must let-bind `tool-bar-map'. In Emacs 22, we
- ;; could use some other local variable.
- (tool-bar-map (if (eq zap-list t)
- (make-sparse-keymap)
- (copy-keymap tool-bar-map))))
- (when (listp zap-list)
- ;; Zap some items which aren't relevant for this mode and take up space.
- (dolist (key zap-list)
- (define-key tool-bar-map (vector key) nil)))
- (mapc (lambda (el)
- (let ((command (car el))
- (icon (nth 1 el))
- (fmap (or (nth 2 el) default-map))
- (props (cdr (cdr (cdr el)))) )
- ;; command may stem from different from-maps:
- (cond ((eq command 'gmm-ignore)
- ;; The dummy `gmm-ignore', see `gmm-tool-bar-item'
- ;; widget. Suppress tooltip by adding `:enable nil'.
- (if (fboundp 'tool-bar-local-item)
- (apply 'tool-bar-local-item icon nil nil
- tool-bar-map :enable nil props)
- ;; (tool-bar-local-item ICON DEF KEY MAP &rest PROPS)
- ;; (tool-bar-add-item ICON DEF KEY &rest PROPS)
- (apply 'tool-bar-add-item icon nil nil :enable nil props)))
- ((equal fmap t) ;; Not a menu command
- (if (fboundp 'tool-bar-local-item)
- (apply 'tool-bar-local-item
- icon command
- (intern icon) ;; reuse icon or fmap here?
- tool-bar-map props)
- ;; Emacs 21 compatibility:
- (apply 'tool-bar-add-item
- icon command
- (intern icon)
- props)))
- (t ;; A menu command
- (if (fboundp 'tool-bar-local-item-from-menu)
- (apply 'tool-bar-local-item-from-menu
- ;; (apply 'tool-bar-local-item icon def key
- ;; tool-bar-map props)
- command icon tool-bar-map (symbol-value fmap)
- props)
- ;; Emacs 21 compatibility:
- (apply 'tool-bar-add-item-from-menu
- command icon (symbol-value fmap)
- props))))
- t))
- (if (symbolp icon-list)
- (eval icon-list)
- icon-list))
- tool-bar-map))
-
-(defmacro defun-gmm (name function arg-list &rest body)
- "Create function NAME.
-If FUNCTION exists, then NAME becomes an alias for FUNCTION.
-Otherwise, create function NAME with ARG-LIST and BODY."
- (let ((defined-p (fboundp function)))
- (if defined-p
- `(defalias ',name ',function)
- `(defun ,name ,arg-list ,@body))))
-
-(defun-gmm gmm-image-search-load-path
- image-search-load-path (file &optional path)
- "Emacs 21 and XEmacs don't have `image-search-load-path'.
-This function returns nil on those systems."
- nil)
-
-;; Cf. `mh-image-load-path-for-library' in `mh-compat.el'.
-
-(defun-gmm gmm-image-load-path-for-library
- image-load-path-for-library (library image &optional path no-error)
- "Return a suitable search path for images used by LIBRARY.
-
-It searches for IMAGE in `image-load-path' (excluding
-\"`data-directory'/images\") and `load-path', followed by a path
-suitable for LIBRARY, which includes \"../../etc/images\" and
-\"../etc/images\" relative to the library file itself, and then
-in \"`data-directory'/images\".
-
-Then this function returns a list of directories which contains
-first the directory in which IMAGE was found, followed by the
-value of `load-path'. If PATH is given, it is used instead of
-`load-path'.
-
-If NO-ERROR is non-nil and a suitable path can't be found, don't
-signal an error. Instead, return a list of directories as before,
-except that nil appears in place of the image directory.
-
-Here is an example that uses a common idiom to provide
-compatibility with versions of Emacs that lack the variable
-`image-load-path':
-
- ;; Shush compiler.
- (defvar image-load-path)
-
- (let* ((load-path (image-load-path-for-library \"mh-e\" \"mh-logo.xpm\"))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
- (mh-tool-bar-folder-buttons-init))"
- (unless library (error "No library specified"))
- (unless image (error "No image specified"))
- (let (image-directory image-directory-load-path)
- ;; Check for images in image-load-path or load-path.
- (let ((img image)
- (dir (or
- ;; Images in image-load-path.
- (gmm-image-search-load-path image) ;; "gmm-" prefix!
- ;; Images in load-path.
- (locate-library image)))
- parent)
- ;; Since the image might be in a nested directory (for
- ;; example, mail/attach.pbm), adjust `image-directory'
- ;; accordingly.
- (when dir
- (setq dir (file-name-directory dir))
- (while (setq parent (file-name-directory img))
- (setq img (directory-file-name parent)
- dir (expand-file-name "../" dir))))
- (setq image-directory-load-path dir))
-
- ;; If `image-directory-load-path' isn't Emacs' image directory,
- ;; it's probably a user preference, so use it. Then use a
- ;; relative setting if possible; otherwise, use
- ;; `image-directory-load-path'.
- (cond
- ;; User-modified image-load-path?
- ((and image-directory-load-path
- (not (equal image-directory-load-path
- (file-name-as-directory
- (expand-file-name "images" data-directory)))))
- (setq image-directory image-directory-load-path))
- ;; Try relative setting.
- ((let (library-name d1ei d2ei)
- ;; First, find library in the load-path.
- (setq library-name (locate-library library))
- (if (not library-name)
- (error "Cannot find library %s in load-path" library))
- ;; And then set image-directory relative to that.
- (setq
- ;; Go down 2 levels.
- d2ei (file-name-as-directory
- (expand-file-name
- (concat (file-name-directory library-name) "../../etc/images")))
- ;; Go down 1 level.
- d1ei (file-name-as-directory
- (expand-file-name
- (concat (file-name-directory library-name) "../etc/images"))))
- (setq image-directory
- ;; Set it to nil if image is not found.
- (cond ((file-exists-p (expand-file-name image d2ei)) d2ei)
- ((file-exists-p (expand-file-name image d1ei)) d1ei)))))
- ;; Use Emacs' image directory.
- (image-directory-load-path
- (setq image-directory image-directory-load-path))
- (no-error
- (message "Could not find image %s for library %s" image library))
- (t
- (error "Could not find image %s for library %s" image library)))
-
- ;; Return an augmented `path' or `load-path'.
- (nconc (list image-directory)
- (delete image-directory (copy-sequence (or path load-path))))))
-
-(defun gmm-customize-mode (&optional mode)
- "Customize customization group for MODE.
-If mode is nil, use `major-mode' of the curent buffer."
- (interactive)
- (customize-group
- (or mode
- (intern (let ((mode (symbol-name major-mode)))
- (string-match "^\\(.+\\)-mode$" mode)
- (match-string 1 mode))))))
-
-(defun gmm-write-region (start end filename &optional append visit
- lockname mustbenew)
- "Compatibility function for `write-region'.
-
-In XEmacs, the seventh argument of `write-region' specifies the
-coding-system."
- (if (and mustbenew
- (or (featurep 'xemacs)
- (= emacs-major-version 20)))
- (if (file-exists-p filename)
- (signal 'file-already-exists
- (list "File exists" filename))
- (write-region start end filename append visit lockname))
- (write-region start end filename append visit lockname mustbenew)))
-
-(provide 'gmm-utils)
-
-;; arch-tag: e0b60920-2ce6-40c1-bfc0-cadbbe26b602
-;;; gmm-utils.el ends here
+++ /dev/null
-;;; gnus-agent.el --- unplugged support for Gnus
-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-cache)
-(require 'nnmail)
-(require 'nnvirtual)
-(require 'gnus-sum)
-(require 'gnus-score)
-(require 'gnus-srvr)
-(require 'gnus-util)
-(eval-when-compile
- (if (featurep 'xemacs)
- (require 'itimer)
- (require 'timer))
- (require 'cl))
-
-(eval-and-compile
- (autoload 'gnus-server-update-server "gnus-srvr")
- (autoload 'gnus-agent-customize-category "gnus-cus")
-)
-
-(defcustom gnus-agent-directory (nnheader-concat gnus-directory "agent/")
- "Where the Gnus agent will store its files."
- :group 'gnus-agent
- :type 'directory)
-
-(defcustom gnus-agent-plugged-hook nil
- "Hook run when plugging into the network."
- :group 'gnus-agent
- :type 'hook)
-
-(defcustom gnus-agent-unplugged-hook nil
- "Hook run when unplugging from the network."
- :group 'gnus-agent
- :type 'hook)
-
-(defcustom gnus-agent-fetched-hook nil
- "Hook run when finished fetching articles."
- :version "22.1"
- :group 'gnus-agent
- :type 'hook)
-
-(defcustom gnus-agent-handle-level gnus-level-subscribed
- "Groups on levels higher than this variable will be ignored by the Agent."
- :group 'gnus-agent
- :type 'integer)
-
-(defcustom gnus-agent-expire-days 7
- "Read articles older than this will be expired.
-If you wish to disable Agent expiring, see `gnus-agent-enable-expiration'."
- :group 'gnus-agent
- :type '(number :tag "days"))
-
-(defcustom gnus-agent-expire-all nil
- "If non-nil, also expire unread, ticked and dormant articles.
-If nil, only read articles will be expired."
- :group 'gnus-agent
- :type 'boolean)
-
-(defcustom gnus-agent-group-mode-hook nil
- "Hook run in Agent group minor modes."
- :group 'gnus-agent
- :type 'hook)
-
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-agent-group-mode-hook 'gnus-xmas-agent-group-menu-add))
-
-(defcustom gnus-agent-summary-mode-hook nil
- "Hook run in Agent summary minor modes."
- :group 'gnus-agent
- :type 'hook)
-
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-agent-summary-mode-hook 'gnus-xmas-agent-summary-menu-add))
-
-(defcustom gnus-agent-server-mode-hook nil
- "Hook run in Agent summary minor modes."
- :group 'gnus-agent
- :type 'hook)
-
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-agent-server-mode-hook 'gnus-xmas-agent-server-menu-add))
-
-(defcustom gnus-agent-confirmation-function 'y-or-n-p
- "Function to confirm when error happens."
- :version "21.1"
- :group 'gnus-agent
- :type 'function)
-
-(defcustom gnus-agent-synchronize-flags t
- "Indicate if flags are synchronized when you plug in.
-If this is `ask' the hook will query the user."
- ;; If the default switches to something else than nil, then the function
- ;; should be fixed not be exceedingly slow. See 2005-09-20 ChangeLog entry.
- :version "21.1"
- :type '(choice (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Ask" ask))
- :group 'gnus-agent)
-
-(defcustom gnus-agent-go-online 'ask
- "Indicate if offline servers go online when you plug in.
-If this is `ask' the hook will query the user."
- :version "21.3"
- :type '(choice (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Ask" ask))
- :group 'gnus-agent)
-
-(defcustom gnus-agent-mark-unread-after-downloaded t
- "Indicate whether to mark articles unread after downloaded."
- :version "21.1"
- :type 'boolean
- :group 'gnus-agent)
-
-(defcustom gnus-agent-download-marks '(download)
- "Marks for downloading."
- :version "21.1"
- :type '(repeat (symbol :tag "Mark"))
- :group 'gnus-agent)
-
-(defcustom gnus-agent-consider-all-articles nil
- "When non-nil, the agent will let the agent predicate decide
-whether articles need to be downloaded or not, for all articles. When
-nil, the default, the agent will only let the predicate decide
-whether unread articles are downloaded or not. If you enable this,
-groups with large active ranges may open slower and you may also want
-to look into the agent expiry settings to block the expiration of
-read articles as they would just be downloaded again."
- :version "22.1"
- :type 'boolean
- :group 'gnus-agent)
-
-(defcustom gnus-agent-max-fetch-size 10000000 ;; 10 Mb
- "Chunk size for `gnus-agent-fetch-session'.
-The function will split its article fetches into chunks smaller than
-this limit."
- :version "22.1"
- :group 'gnus-agent
- :type 'integer)
-
-(defcustom gnus-agent-enable-expiration 'ENABLE
- "The default expiration state for each group.
-When set to ENABLE, the default, `gnus-agent-expire' will expire old
-contents from a group's local storage. This value may be overridden
-to disable expiration in specific categories, topics, and groups. Of
-course, you could change gnus-agent-enable-expiration to DISABLE then
-enable expiration per categories, topics, and groups."
- :version "22.1"
- :group 'gnus-agent
- :type '(radio (const :format "Enable " ENABLE)
- (const :format "Disable " DISABLE)))
-
-(defcustom gnus-agent-expire-unagentized-dirs t
- "*Whether expiration should expire in unagentized directories.
-Have gnus-agent-expire scan the directories under
-\(gnus-agent-directory) for groups that are no longer agentized.
-When found, offer to remove them."
- :version "22.1"
- :type 'boolean
- :group 'gnus-agent)
-
-(defcustom gnus-agent-auto-agentize-methods '(nntp nnimap)
- "Initially, all servers from these methods are agentized.
-The user may remove or add servers using the Server buffer.
-See Info node `(gnus)Server Buffer'."
- :version "22.1"
- :type '(repeat symbol)
- :group 'gnus-agent)
-
-(defcustom gnus-agent-queue-mail t
- "Whether and when outgoing mail should be queued by the agent.
-When `always', always queue outgoing mail. When nil, never
-queue. Otherwise, queue if and only if unplugged."
- :version "22.1"
- :group 'gnus-agent
- :type '(radio (const :format "Always" always)
- (const :format "Never" nil)
- (const :format "When unplugged" t)))
-
-(defcustom gnus-agent-prompt-send-queue nil
- "If non-nil, `gnus-group-send-queue' will prompt if called when
-unplugged."
- :version "22.1"
- :group 'gnus-agent
- :type 'boolean)
-
-(defcustom gnus-agent-article-alist-save-format 1
- "Indicates whether to use compression(2), versus no
-compression(1), when writing agentview files. The compressed
-files do save space but load times are 6-7 times higher. A group
-must be opened then closed for the agentview to be updated using
-the new format."
- ;; Wouldn't symbols instead numbers be nicer? --rsteib
- :version "22.1"
- :group 'gnus-agent
- :type '(radio (const :format "Compressed" 2)
- (const :format "Uncompressed" 1)))
-
-;;; Internal variables
-
-(defvar gnus-agent-history-buffers nil)
-(defvar gnus-agent-buffer-alist nil)
-(defvar gnus-agent-article-alist nil
- "An assoc list identifying the articles whose headers have been fetched.
-If successfully fetched, these headers will be stored in the group's overview
-file. The key of each assoc pair is the article ID, the value of each assoc
-pair is a flag indicating whether the identified article has been downloaded
-\(gnus-agent-fetch-articles sets the value to the day of the download).
-NOTES:
-1) The last element of this list can not be expired as some
- routines (for example, get-agent-fetch-headers) use the last
- value to track which articles have had their headers retrieved.
-2) The function `gnus-agent-regenerate' may destructively modify the value.")
-(defvar gnus-agent-group-alist nil)
-(defvar gnus-category-alist nil)
-(defvar gnus-agent-current-history nil)
-(defvar gnus-agent-overview-buffer nil)
-(defvar gnus-category-predicate-cache nil)
-(defvar gnus-category-group-cache nil)
-(defvar gnus-agent-spam-hashtb nil)
-(defvar gnus-agent-file-name nil)
-(defvar gnus-agent-send-mail-function nil)
-(defvar gnus-agent-file-coding-system 'raw-text)
-(defvar gnus-agent-file-loading-cache nil)
-
-;; Dynamic variables
-(defvar gnus-headers)
-(defvar gnus-score)
-
-;;;
-;;; Setup
-;;;
-
-(defun gnus-open-agent ()
- (setq gnus-agent t)
- (gnus-agent-read-servers)
- (gnus-category-read)
- (gnus-agent-create-buffer)
- (add-hook 'gnus-group-mode-hook 'gnus-agent-mode)
- (add-hook 'gnus-summary-mode-hook 'gnus-agent-mode)
- (add-hook 'gnus-server-mode-hook 'gnus-agent-mode))
-
-(defun gnus-agent-create-buffer ()
- (if (gnus-buffer-live-p gnus-agent-overview-buffer)
- t
- (setq gnus-agent-overview-buffer
- (gnus-get-buffer-create " *Gnus agent overview*"))
- (with-current-buffer gnus-agent-overview-buffer
- (mm-enable-multibyte))
- nil))
-
-(gnus-add-shutdown 'gnus-close-agent 'gnus)
-
-(defun gnus-close-agent ()
- (setq gnus-category-predicate-cache nil
- gnus-category-group-cache nil
- gnus-agent-spam-hashtb nil)
- (gnus-kill-buffer gnus-agent-overview-buffer))
-
-;;;
-;;; Utility functions
-;;;
-
-(defun gnus-agent-read-file (file)
- "Load FILE and do a `read' there."
- (with-temp-buffer
- (ignore-errors
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (read (current-buffer)))))
-
-(defsubst gnus-agent-method ()
- (concat (symbol-name (car gnus-command-method)) "/"
- (if (equal (cadr gnus-command-method) "")
- "unnamed"
- (cadr gnus-command-method))))
-
-(defsubst gnus-agent-directory ()
- "The name of the Gnus agent directory."
- (nnheader-concat gnus-agent-directory
- (nnheader-translate-file-chars (gnus-agent-method)) "/"))
-
-(defun gnus-agent-lib-file (file)
- "The full name of the Gnus agent library FILE."
- (expand-file-name file
- (file-name-as-directory
- (expand-file-name "agent.lib" (gnus-agent-directory)))))
-
-(defun gnus-agent-cat-set-property (category property value)
- (if value
- (setcdr (or (assq property category)
- (let ((cell (cons property nil)))
- (setcdr category (cons cell (cdr category)))
- cell)) value)
- (let ((category category))
- (while (cond ((eq property (caadr category))
- (setcdr category (cddr category))
- nil)
- (t
- (setq category (cdr category)))))))
- category)
-
-(eval-when-compile
- (defmacro gnus-agent-cat-defaccessor (name prop-name)
- "Define accessor and setter methods for manipulating a list of the form
-\(NAME (PROPERTY1 VALUE1) ... (PROPERTY_N VALUE_N)).
-Given the call (gnus-agent-cat-defaccessor func PROPERTY1), the list may be
-manipulated as follows:
- (func LIST): Returns VALUE1
- (setf (func LIST) NEW_VALUE1): Replaces VALUE1 with NEW_VALUE1."
- `(progn (defmacro ,name (category)
- (list (quote cdr) (list (quote assq)
- (quote (quote ,prop-name)) category)))
-
- (define-setf-method ,name (category)
- (let* ((--category--temp-- (make-symbol "--category--"))
- (--value--temp-- (make-symbol "--value--")))
- (list (list --category--temp--) ; temporary-variables
- (list category) ; value-forms
- (list --value--temp--) ; store-variables
- (let* ((category --category--temp--) ; store-form
- (value --value--temp--))
- (list (quote gnus-agent-cat-set-property)
- category
- (quote (quote ,prop-name))
- value))
- (list (quote ,name) --category--temp--) ; access-form
- )))))
- )
-
-(defmacro gnus-agent-cat-name (category)
- `(car ,category))
-
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-days-until-old agent-days-until-old)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-expiration agent-enable-expiration)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-groups agent-groups)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-high-score agent-high-score)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-long agent-long-article)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-length-when-short agent-short-article)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-low-score agent-low-score)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-predicate agent-predicate)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-score-file agent-score)
-(gnus-agent-cat-defaccessor
- gnus-agent-cat-enable-undownloaded-faces agent-enable-undownloaded-faces)
-
-
-;; This form is equivalent to defsetf except that it calls make-symbol
-;; whereas defsetf calls gensym (Using gensym creates a run-time
-;; dependency on the CL library).
-
-(eval-and-compile
- (define-setf-method gnus-agent-cat-groups (category)
- (let* ((--category--temp-- (make-symbol "--category--"))
- (--groups--temp-- (make-symbol "--groups--")))
- (list (list --category--temp--)
- (list category)
- (list --groups--temp--)
- (let* ((category --category--temp--)
- (groups --groups--temp--))
- (list (quote gnus-agent-set-cat-groups) category groups))
- (list (quote gnus-agent-cat-groups) --category--temp--))))
- )
-
-(defun gnus-agent-set-cat-groups (category groups)
- (unless (eq groups 'ignore)
- (let ((new-g groups)
- (old-g (gnus-agent-cat-groups category)))
- (cond ((eq new-g old-g)
- ;; gnus-agent-add-group is fiddling with the group
- ;; list. Still, Im done.
- nil
- )
- ((eq new-g (cdr old-g))
- ;; gnus-agent-add-group is fiddling with the group list
- (setcdr (or (assq 'agent-groups category)
- (let ((cell (cons 'agent-groups nil)))
- (setcdr category (cons cell (cdr category)))
- cell)) new-g))
- (t
- (let ((groups groups))
- (while groups
- (let* ((group (pop groups))
- (old-category (gnus-group-category group)))
- (if (eq category old-category)
- nil
- (setf (gnus-agent-cat-groups old-category)
- (delete group (gnus-agent-cat-groups
- old-category))))))
- ;; Purge cache as preceeding loop invalidated it.
- (setq gnus-category-group-cache nil))
-
- (setcdr (or (assq 'agent-groups category)
- (let ((cell (cons 'agent-groups nil)))
- (setcdr category (cons cell (cdr category)))
- cell)) groups))))))
-
-(defsubst gnus-agent-cat-make (name &optional default-agent-predicate)
- (list name `(agent-predicate . ,(or default-agent-predicate 'false))))
-
-;;; Fetching setup functions.
-
-(defun gnus-agent-start-fetch ()
- "Initialize data structures for efficient fetching."
- (gnus-agent-create-buffer))
-
-(defun gnus-agent-stop-fetch ()
- "Save all data structures and clean up."
- (setq gnus-agent-spam-hashtb nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (widen)))
-
-(defmacro gnus-agent-with-fetch (&rest forms)
- "Do FORMS safely."
- `(unwind-protect
- (let ((gnus-agent-fetching t))
- (gnus-agent-start-fetch)
- ,@forms)
- (gnus-agent-stop-fetch)))
-
-(put 'gnus-agent-with-fetch 'lisp-indent-function 0)
-(put 'gnus-agent-with-fetch 'edebug-form-spec '(body))
-
-(defmacro gnus-agent-append-to-list (tail value)
- `(setq ,tail (setcdr ,tail (cons ,value nil))))
-
-(defmacro gnus-agent-message (level &rest args)
- `(if (<= ,level gnus-verbose)
- (message ,@args)))
-
-;;;
-;;; Mode infestation
-;;;
-
-(defvar gnus-agent-mode-hook nil
- "Hook run when installing agent mode.")
-
-(defvar gnus-agent-mode nil)
-(defvar gnus-agent-mode-status '(gnus-agent-mode " Plugged"))
-
-(defun gnus-agent-mode ()
- "Minor mode for providing a agent support in Gnus buffers."
- (let* ((buffer (progn (string-match "^gnus-\\(.*\\)-mode$"
- (symbol-name major-mode))
- (match-string 1 (symbol-name major-mode))))
- (mode (intern (format "gnus-agent-%s-mode" buffer))))
- (set (make-local-variable 'gnus-agent-mode) t)
- (set mode nil)
- (set (make-local-variable mode) t)
- ;; Set up the menu.
- (when (gnus-visual-p 'agent-menu 'menu)
- (funcall (intern (format "gnus-agent-%s-make-menu-bar" buffer))))
- (unless (assq 'gnus-agent-mode minor-mode-alist)
- (push gnus-agent-mode-status minor-mode-alist))
- (unless (assq mode minor-mode-map-alist)
- (push (cons mode (symbol-value (intern (format "gnus-agent-%s-mode-map"
- buffer))))
- minor-mode-map-alist))
- (when (eq major-mode 'gnus-group-mode)
- (let ((init-plugged gnus-plugged)
- (gnus-agent-go-online nil))
- ;; g-a-t-p does nothing when gnus-plugged isn't changed.
- ;; Therefore, make certain that the current value does not
- ;; match the desired initial value.
- (setq gnus-plugged :unknown)
- (gnus-agent-toggle-plugged init-plugged)))
- (gnus-run-hooks 'gnus-agent-mode-hook
- (intern (format "gnus-agent-%s-mode-hook" buffer)))))
-
-(defvar gnus-agent-group-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-group-mode-map
- "Ju" gnus-agent-fetch-groups
- "Jc" gnus-enter-category-buffer
- "Jj" gnus-agent-toggle-plugged
- "Js" gnus-agent-fetch-session
- "JY" gnus-agent-synchronize-flags
- "JS" gnus-group-send-queue
- "Ja" gnus-agent-add-group
- "Jr" gnus-agent-remove-group
- "Jo" gnus-agent-toggle-group-plugged)
-
-(defun gnus-agent-group-make-menu-bar ()
- (unless (boundp 'gnus-agent-group-menu)
- (easy-menu-define
- gnus-agent-group-menu gnus-agent-group-mode-map ""
- '("Agent"
- ["Toggle plugged" gnus-agent-toggle-plugged t]
- ["Toggle group plugged" gnus-agent-toggle-group-plugged t]
- ["List categories" gnus-enter-category-buffer t]
- ["Add (current) group to category" gnus-agent-add-group t]
- ["Remove (current) group from category" gnus-agent-remove-group t]
- ["Send queue" gnus-group-send-queue gnus-plugged]
- ("Fetch"
- ["All" gnus-agent-fetch-session gnus-plugged]
- ["Group" gnus-agent-fetch-group gnus-plugged])
- ["Synchronize flags" gnus-agent-synchronize-flags t]
- ))))
-
-(defvar gnus-agent-summary-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-summary-mode-map
- "Jj" gnus-agent-toggle-plugged
- "Ju" gnus-agent-summary-fetch-group
- "JS" gnus-agent-fetch-group
- "Js" gnus-agent-summary-fetch-series
- "J#" gnus-agent-mark-article
- "J\M-#" gnus-agent-unmark-article
- "@" gnus-agent-toggle-mark
- "Jc" gnus-agent-catchup)
-
-(defun gnus-agent-summary-make-menu-bar ()
- (unless (boundp 'gnus-agent-summary-menu)
- (easy-menu-define
- gnus-agent-summary-menu gnus-agent-summary-mode-map ""
- '("Agent"
- ["Toggle plugged" gnus-agent-toggle-plugged t]
- ["Mark as downloadable" gnus-agent-mark-article t]
- ["Unmark as downloadable" gnus-agent-unmark-article t]
- ["Toggle mark" gnus-agent-toggle-mark t]
- ["Fetch downloadable" gnus-agent-summary-fetch-group t]
- ["Catchup undownloaded" gnus-agent-catchup t]))))
-
-(defvar gnus-agent-server-mode-map (make-sparse-keymap))
-(gnus-define-keys gnus-agent-server-mode-map
- "Jj" gnus-agent-toggle-plugged
- "Ja" gnus-agent-add-server
- "Jr" gnus-agent-remove-server)
-
-(defun gnus-agent-server-make-menu-bar ()
- (unless (boundp 'gnus-agent-server-menu)
- (easy-menu-define
- gnus-agent-server-menu gnus-agent-server-mode-map ""
- '("Agent"
- ["Toggle plugged" gnus-agent-toggle-plugged t]
- ["Add" gnus-agent-add-server t]
- ["Remove" gnus-agent-remove-server t]))))
-
-(defun gnus-agent-make-mode-line-string (string mouse-button mouse-func)
- (if (and (fboundp 'propertize)
- (fboundp 'make-mode-line-mouse-map))
- (propertize string 'local-map
- (make-mode-line-mouse-map mouse-button mouse-func)
- 'mouse-face
- (cond ((and (featurep 'xemacs)
- ;; XEmacs' `facep' only checks for a face
- ;; object, not for a face name, so it's useless
- ;; to check with `facep'.
- (find-face 'modeline))
- 'modeline)
- ((facep 'mode-line-highlight) ;; Emacs 22
- 'mode-line-highlight)
- ((facep 'mode-line) ;; Emacs 21
- 'mode-line)) )
- string))
-
-(defun gnus-agent-toggle-plugged (set-to)
- "Toggle whether Gnus is unplugged or not."
- (interactive (list (not gnus-plugged)))
- (cond ((eq set-to gnus-plugged)
- nil)
- (set-to
- (setq gnus-plugged set-to)
- (gnus-run-hooks 'gnus-agent-plugged-hook)
- (setcar (cdr gnus-agent-mode-status)
- (gnus-agent-make-mode-line-string " Plugged"
- 'mouse-2
- 'gnus-agent-toggle-plugged))
- (gnus-agent-go-online gnus-agent-go-online)
- (gnus-agent-possibly-synchronize-flags))
- (t
- (gnus-agent-close-connections)
- (setq gnus-plugged set-to)
- (gnus-run-hooks 'gnus-agent-unplugged-hook)
- (setcar (cdr gnus-agent-mode-status)
- (gnus-agent-make-mode-line-string " Unplugged"
- 'mouse-2
- 'gnus-agent-toggle-plugged))))
- (set-buffer-modified-p t))
-
-(defmacro gnus-agent-while-plugged (&rest body)
- `(let ((original-gnus-plugged gnus-plugged))
- (unwind-protect
- (progn (gnus-agent-toggle-plugged t)
- ,@body)
- (gnus-agent-toggle-plugged original-gnus-plugged))))
-
-(put 'gnus-agent-while-plugged 'lisp-indent-function 0)
-(put 'gnus-agent-while-plugged 'edebug-form-spec '(body))
-
-(defun gnus-agent-close-connections ()
- "Close all methods covered by the Gnus agent."
- (let ((methods (gnus-agent-covered-methods)))
- (while methods
- (gnus-close-server (pop methods)))))
-
-;;;###autoload
-(defun gnus-unplugged ()
- "Start Gnus unplugged."
- (interactive)
- (setq gnus-plugged nil)
- (gnus))
-
-;;;###autoload
-(defun gnus-plugged ()
- "Start Gnus plugged."
- (interactive)
- (setq gnus-plugged t)
- (gnus))
-
-;;;###autoload
-(defun gnus-slave-unplugged (&optional arg)
- "Read news as a slave unplugged."
- (interactive "P")
- (setq gnus-plugged nil)
- (gnus arg nil 'slave))
-
-;;;###autoload
-(defun gnus-agentize ()
- "Allow Gnus to be an offline newsreader.
-
-The gnus-agentize function is now called internally by gnus when
-gnus-agent is set. If you wish to avoid calling gnus-agentize,
-customize gnus-agent to nil.
-
-This will modify the `gnus-setup-news-hook', and
-`message-send-mail-real-function' variables, and install the Gnus agent
-minor mode in all Gnus buffers."
- (interactive)
- (gnus-open-agent)
- (add-hook 'gnus-setup-news-hook 'gnus-agent-queue-setup)
- (unless gnus-agent-send-mail-function
- (setq gnus-agent-send-mail-function
- (or message-send-mail-real-function
- (function (lambda () (funcall message-send-mail-function))))
- message-send-mail-real-function 'gnus-agent-send-mail))
-
- ;; If the servers file doesn't exist, auto-agentize some servers and
- ;; save the servers file so this auto-agentizing isn't invoked
- ;; again.
- (unless (file-exists-p (nnheader-concat gnus-agent-directory "lib/servers"))
- (gnus-message 3 "First time agent user, agentizing remote groups...")
- (mapc
- (lambda (server-or-method)
- (let ((method (gnus-server-to-method server-or-method)))
- (when (memq (car method)
- gnus-agent-auto-agentize-methods)
- (push (gnus-method-to-server method)
- gnus-agent-covered-methods)
- (setq gnus-agent-method-p-cache nil))))
- (cons gnus-select-method gnus-secondary-select-methods))
- (gnus-agent-write-servers)))
-
-(defun gnus-agent-queue-setup (&optional group-name)
- "Make sure the queue group exists.
-Optional arg GROUP-NAME allows to specify another group."
- (unless (gnus-gethash (format "nndraft:%s" (or group-name "queue"))
- gnus-newsrc-hashtb)
- (gnus-request-create-group (or group-name "queue") '(nndraft ""))
- (let ((gnus-level-default-subscribed 1))
- (gnus-subscribe-group (format "nndraft:%s" (or group-name "queue"))
- nil '(nndraft "")))
- (gnus-group-set-parameter
- (format "nndraft:%s" (or group-name "queue"))
- 'gnus-dummy '((gnus-draft-mode)))))
-
-(defun gnus-agent-send-mail ()
- (if (or (not gnus-agent-queue-mail)
- (and gnus-plugged (not (eq gnus-agent-queue-mail 'always))))
- (funcall gnus-agent-send-mail-function)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (gnus-agent-insert-meta-information 'mail)
- (gnus-request-accept-article "nndraft:queue" nil t t)))
-
-(defun gnus-agent-insert-meta-information (type &optional method)
- "Insert meta-information into the message that says how it's to be posted.
-TYPE can be either `mail' or `news'. If the latter, then METHOD can
-be a select method."
- (save-excursion
- (message-remove-header gnus-agent-meta-information-header)
- (goto-char (point-min))
- (insert gnus-agent-meta-information-header ": "
- (symbol-name type) " " (format "%S" method)
- "\n")
- (forward-char -1)
- (while (search-backward "\n" nil t)
- (replace-match "\\n" t t))))
-
-(defun gnus-agent-restore-gcc ()
- "Restore GCC field from saved header."
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^" (regexp-quote gnus-agent-gcc-header) ":") nil t)
- (replace-match "Gcc:" 'fixedcase))))
-
-(defun gnus-agent-any-covered-gcc ()
- (save-restriction
- (message-narrow-to-headers)
- (let* ((gcc (mail-fetch-field "gcc" nil t))
- (methods (and gcc
- (mapcar 'gnus-inews-group-method
- (message-unquote-tokens
- (message-tokenize-header
- gcc " ,")))))
- covered)
- (while (and (not covered) methods)
- (setq covered (gnus-agent-method-p (car methods))
- methods (cdr methods)))
- covered)))
-
-;;;###autoload
-(defun gnus-agent-possibly-save-gcc ()
- "Save GCC if Gnus is unplugged."
- (when (and (not gnus-plugged) (gnus-agent-any-covered-gcc))
- (save-excursion
- (goto-char (point-min))
- (let ((case-fold-search t))
- (while (re-search-forward "^gcc:" nil t)
- (replace-match (concat gnus-agent-gcc-header ":") 'fixedcase))))))
-
-(defun gnus-agent-possibly-do-gcc ()
- "Do GCC if Gnus is plugged."
- (when (or gnus-plugged (not (gnus-agent-any-covered-gcc)))
- (gnus-inews-do-gcc)))
-
-;;;
-;;; Group mode commands
-;;;
-
-(defun gnus-agent-fetch-groups (n)
- "Put all new articles in the current groups into the Agent."
- (interactive "P")
- (unless gnus-plugged
- (error "Groups can't be fetched when Gnus is unplugged"))
- (gnus-group-iterate n 'gnus-agent-fetch-group))
-
-(defun gnus-agent-fetch-group (&optional group)
- "Put all new articles in GROUP into the Agent."
- (interactive (list (gnus-group-group-name)))
- (setq group (or group gnus-newsgroup-name))
- (unless group
- (error "No group on the current line"))
-
- (gnus-agent-while-plugged
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (gnus-agent-with-fetch
- (gnus-agent-fetch-group-1 group gnus-command-method)
- (gnus-message 5 "Fetching %s...done" group)))))
-
-(defun gnus-agent-add-group (category arg)
- "Add the current group to an agent category."
- (interactive
- (list
- (intern
- (completing-read
- "Add to category: "
- (mapcar (lambda (cat) (list (symbol-name (car cat))))
- gnus-category-alist)
- nil t))
- current-prefix-arg))
- (let ((cat (assq category gnus-category-alist))
- c groups)
- (gnus-group-iterate arg
- (lambda (group)
- (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
- (setf (gnus-agent-cat-groups c)
- (delete group (gnus-agent-cat-groups c))))
- (push group groups)))
- (setf (gnus-agent-cat-groups cat)
- (nconc (gnus-agent-cat-groups cat) groups))
- (gnus-category-write)))
-
-(defun gnus-agent-remove-group (arg)
- "Remove the current group from its agent category, if any."
- (interactive "P")
- (let (c)
- (gnus-group-iterate arg
- (lambda (group)
- (when (gnus-agent-cat-groups (setq c (gnus-group-category group)))
- (setf (gnus-agent-cat-groups c)
- (delete group (gnus-agent-cat-groups c))))))
- (gnus-category-write)))
-
-(defun gnus-agent-synchronize-flags ()
- "Synchronize unplugged flags with servers."
- (interactive)
- (save-excursion
- (dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (file-exists-p (gnus-agent-lib-file "flags"))
- (gnus-agent-synchronize-flags-server gnus-command-method)))))
-
-(defun gnus-agent-possibly-synchronize-flags ()
- "Synchronize flags according to `gnus-agent-synchronize-flags'."
- (interactive)
- (save-excursion
- (dolist (gnus-command-method (gnus-agent-covered-methods))
- (when (and (file-exists-p (gnus-agent-lib-file "flags"))
- (eq (gnus-server-status gnus-command-method) 'ok))
- (gnus-agent-possibly-synchronize-flags-server gnus-command-method)))))
-
-(defun gnus-agent-synchronize-flags-server (method)
- "Synchronize flags set when unplugged for server."
- (let ((gnus-command-method method)
- (gnus-agent nil))
- (when (file-exists-p (gnus-agent-lib-file "flags"))
- (set-buffer (get-buffer-create " *Gnus Agent flag synchronize*"))
- (erase-buffer)
- (nnheader-insert-file-contents (gnus-agent-lib-file "flags"))
- (cond ((null gnus-plugged)
- (gnus-message
- 1 "You must be plugged to synchronize flags with server %s"
- (nth 1 gnus-command-method)))
- ((null (gnus-check-server gnus-command-method))
- (gnus-message
- 1 "Couldn't open server %s" (nth 1 gnus-command-method)))
- (t
- (condition-case err
- (while t
- (let ((bgn (point)))
- (eval (read (current-buffer)))
- (delete-region bgn (point))))
- (end-of-file
- (delete-file (gnus-agent-lib-file "flags")))
- (error
- (let ((file (gnus-agent-lib-file "flags")))
- (write-region (point-min) (point-max)
- (gnus-agent-lib-file "flags") nil 'silent)
- (error "Couldn't set flags from file %s due to %s"
- file (error-message-string err)))))))
- (kill-buffer nil))))
-
-(defun gnus-agent-possibly-synchronize-flags-server (method)
- "Synchronize flags for server according to `gnus-agent-synchronize-flags'."
- (when (or (and gnus-agent-synchronize-flags
- (not (eq gnus-agent-synchronize-flags 'ask)))
- (and (eq gnus-agent-synchronize-flags 'ask)
- (gnus-y-or-n-p (format "Synchronize flags on server `%s'? "
- (cadr method)))))
- (gnus-agent-synchronize-flags-server method)))
-
-;;;###autoload
-(defun gnus-agent-rename-group (old-group new-group)
- "Rename fully-qualified OLD-GROUP as NEW-GROUP.
-Always updates the agent, even when disabled, as the old agent
-files would corrupt gnus when the agent was next enabled.
-Depends upon the caller to determine whether group renaming is
-supported."
- (let* ((old-command-method (gnus-find-method-for-group old-group))
- (old-path (directory-file-name
- (let (gnus-command-method old-command-method)
- (gnus-agent-group-pathname old-group))))
- (new-command-method (gnus-find-method-for-group new-group))
- (new-path (directory-file-name
- (let (gnus-command-method new-command-method)
- (gnus-agent-group-pathname new-group)))))
- (gnus-rename-file old-path new-path t)
-
- (let* ((old-real-group (gnus-group-real-name old-group))
- (new-real-group (gnus-group-real-name new-group))
- (old-active (gnus-agent-get-group-info old-command-method old-real-group)))
- (gnus-agent-save-group-info old-command-method old-real-group nil)
- (gnus-agent-save-group-info new-command-method new-real-group old-active)
-
- (let ((old-local (gnus-agent-get-local old-group
- old-real-group old-command-method)))
- (gnus-agent-set-local old-group
- nil nil
- old-real-group old-command-method)
- (gnus-agent-set-local new-group
- (car old-local) (cdr old-local)
- new-real-group new-command-method)))))
-
-;;;###autoload
-(defun gnus-agent-delete-group (group)
- "Delete fully-qualified GROUP.
-Always updates the agent, even when disabled, as the old agent
-files would corrupt gnus when the agent was next enabled.
-Depends upon the caller to determine whether group deletion is
-supported."
- (let* ((command-method (gnus-find-method-for-group group))
- (path (directory-file-name
- (let (gnus-command-method command-method)
- (gnus-agent-group-pathname group)))))
- (gnus-delete-directory path)
-
- (let* ((real-group (gnus-group-real-name group)))
- (gnus-agent-save-group-info command-method real-group nil)
-
- (let ((local (gnus-agent-get-local group
- real-group command-method)))
- (gnus-agent-set-local group
- nil nil
- real-group command-method)))))
-
-;;;
-;;; Server mode commands
-;;;
-
-(defun gnus-agent-add-server ()
- "Enroll SERVER in the agent program."
- (interactive)
- (let* ((server (gnus-server-server-name))
- (named-server (gnus-server-named-server))
- (method (and server
- (gnus-server-get-method nil server))))
- (unless server
- (error "No server on the current line"))
-
- (when (gnus-agent-method-p method)
- (error "Server already in the agent program"))
-
- (push named-server gnus-agent-covered-methods)
-
- (setq gnus-agent-method-p-cache nil)
- (gnus-server-update-server server)
- (gnus-agent-write-servers)
- (gnus-message 1 "Entered %s into the Agent" server)))
-
-(defun gnus-agent-remove-server ()
- "Remove SERVER from the agent program."
- (interactive)
- (let* ((server (gnus-server-server-name))
- (named-server (gnus-server-named-server)))
- (unless server
- (error "No server on the current line"))
-
- (unless (member named-server gnus-agent-covered-methods)
- (error "Server not in the agent program"))
-
- (setq gnus-agent-covered-methods
- (delete named-server gnus-agent-covered-methods)
- gnus-agent-method-p-cache nil)
-
- (gnus-server-update-server server)
- (gnus-agent-write-servers)
- (gnus-message 1 "Removed %s from the agent" server)))
-
-(defun gnus-agent-read-servers ()
- "Read the alist of covered servers."
- (setq gnus-agent-covered-methods
- (gnus-agent-read-file
- (nnheader-concat gnus-agent-directory "lib/servers"))
- gnus-agent-method-p-cache nil)
-
- ;; I am called so early in start-up that I can not validate server
- ;; names. When that is the case, I skip the validation. That is
- ;; alright as the gnus startup code calls the validate methods
- ;; directly.
- (if gnus-server-alist
- (gnus-agent-read-servers-validate)))
-
-(defun gnus-agent-read-servers-validate ()
- (mapcar (lambda (server-or-method)
- (let* ((server (if (stringp server-or-method)
- server-or-method
- (gnus-method-to-server server-or-method)))
- (method (gnus-server-to-method server)))
- (if method
- (unless (member server gnus-agent-covered-methods)
- (push server gnus-agent-covered-methods)
- (setq gnus-agent-method-p-cache nil))
- (gnus-message 1 "Ignoring disappeared server `%s'" server))))
- (prog1 gnus-agent-covered-methods
- (setq gnus-agent-covered-methods nil))))
-
-(defun gnus-agent-read-servers-validate-native (native-method)
- (setq gnus-agent-covered-methods
- (mapcar (lambda (method)
- (if (or (not method)
- (equal method native-method))
- "native"
- method)) gnus-agent-covered-methods)))
-
-(defun gnus-agent-write-servers ()
- "Write the alist of covered servers."
- (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
- (let ((coding-system-for-write nnheader-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (with-temp-file (nnheader-concat gnus-agent-directory "lib/servers")
- (prin1 gnus-agent-covered-methods
- (current-buffer)))))
-
-;;;
-;;; Summary commands
-;;;
-
-(defun gnus-agent-mark-article (n &optional unmark)
- "Mark the next N articles as downloadable.
-If N is negative, mark backward instead. If UNMARK is non-nil, remove
-the mark instead. The difference between N and the actual number of
-articles marked is returned."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and
- (> n 0)
- (progn
- (gnus-summary-set-agent-mark
- (gnus-summary-article-number) unmark)
- (zerop (gnus-summary-next-subject (if backward -1 1) nil t))))
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more articles"))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- n))
-
-(defun gnus-agent-unmark-article (n)
- "Remove the downloadable mark from the next N articles.
-If N is negative, unmark backward instead. The difference between N and
-the actual number of articles unmarked is returned."
- (interactive "p")
- (gnus-agent-mark-article n t))
-
-(defun gnus-agent-toggle-mark (n)
- "Toggle the downloadable mark from the next N articles.
-If N is negative, toggle backward instead. The difference between N and
-the actual number of articles toggled is returned."
- (interactive "p")
- (gnus-agent-mark-article n 'toggle))
-
-(defun gnus-summary-set-agent-mark (article &optional unmark)
- "Mark ARTICLE as downloadable. If UNMARK is nil, article is marked.
-When UNMARK is t, the article is unmarked. For any other value, the
-article's mark is toggled."
- (let ((unmark (cond ((eq nil unmark)
- nil)
- ((eq t unmark)
- t)
- (t
- (memq article gnus-newsgroup-downloadable)))))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-mark
- (if unmark
- (progn
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable))
- (gnus-article-mark article))
- (setq gnus-newsgroup-downloadable
- (gnus-add-to-sorted-list gnus-newsgroup-downloadable article))
- gnus-downloadable-mark)
- 'unread))))
-
-;;;###autoload
-(defun gnus-agent-get-undownloaded-list ()
- "Construct list of articles that have not been downloaded."
- (let ((gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (set (make-local-variable 'gnus-newsgroup-agentized)
- (gnus-agent-method-p gnus-command-method))
- (let* ((alist (gnus-agent-load-alist gnus-newsgroup-name))
- (headers (sort (mapcar (lambda (h)
- (mail-header-number h))
- gnus-newsgroup-headers) '<))
- (cached (and gnus-use-cache gnus-newsgroup-cached))
- (undownloaded (list nil))
- (tail-undownloaded undownloaded)
- (unfetched (list nil))
- (tail-unfetched unfetched))
- (while (and alist headers)
- (let ((a (caar alist))
- (h (car headers)))
- (cond ((< a h)
- ;; Ignore IDs in the alist that are not being
- ;; displayed in the summary.
- (setq alist (cdr alist)))
- ((> a h)
- ;; Headers that are not in the alist should be
- ;; fictious (see nnagent-retrieve-headers); they
- ;; imply that this article isn't in the agent.
- (gnus-agent-append-to-list tail-undownloaded h)
- (gnus-agent-append-to-list tail-unfetched h)
- (setq headers (cdr headers)))
- ((cdar alist)
- (setq alist (cdr alist))
- (setq headers (cdr headers))
- nil ; ignore already downloaded
- )
- (t
- (setq alist (cdr alist))
- (setq headers (cdr headers))
-
- ;; This article isn't in the agent. Check to see
- ;; if it is in the cache. If it is, it's been
- ;; downloaded.
- (while (and cached (< (car cached) a))
- (setq cached (cdr cached)))
- (unless (equal a (car cached))
- (gnus-agent-append-to-list tail-undownloaded a))))))
-
- (while headers
- (let ((num (pop headers)))
- (gnus-agent-append-to-list tail-undownloaded num)
- (gnus-agent-append-to-list tail-unfetched num)))
-
- (setq gnus-newsgroup-undownloaded (cdr undownloaded)
- gnus-newsgroup-unfetched (cdr unfetched))))))
-
-(defun gnus-agent-catchup ()
- "Mark as read all unhandled articles.
-An article is unhandled if it is neither cached, nor downloaded, nor
-downloadable."
- (interactive)
- (save-excursion
- (let ((articles gnus-newsgroup-undownloaded))
- (when (or gnus-newsgroup-downloadable
- gnus-newsgroup-cached)
- (setq articles (gnus-sorted-ndifference
- (gnus-sorted-ndifference
- (gnus-copy-sequence articles)
- gnus-newsgroup-downloadable)
- gnus-newsgroup-cached)))
-
- (while articles
- (gnus-summary-mark-article
- (pop articles) gnus-catchup-mark)))
- (gnus-summary-position-point)))
-
-(defun gnus-agent-summary-fetch-series ()
- (interactive)
- (when gnus-newsgroup-processable
- (setq gnus-newsgroup-downloadable
- (let* ((dl gnus-newsgroup-downloadable)
- (processable (sort (gnus-copy-sequence gnus-newsgroup-processable) '<))
- (gnus-newsgroup-downloadable processable))
- (gnus-agent-summary-fetch-group)
-
- ;; For each article that I processed that is no longer
- ;; undownloaded, remove its processable mark.
-
- (mapc #'gnus-summary-remove-process-mark
- (gnus-sorted-ndifference gnus-newsgroup-processable gnus-newsgroup-undownloaded))
-
- ;; The preceeding call to (gnus-agent-summary-fetch-group)
- ;; updated the temporary gnus-newsgroup-downloadable to
- ;; remove each article successfully fetched. Now, I
- ;; update the real gnus-newsgroup-downloadable to only
- ;; include undownloaded articles.
- (gnus-sorted-ndifference dl (gnus-sorted-ndifference processable gnus-newsgroup-undownloaded))))))
-
-(defun gnus-agent-summary-fetch-group (&optional all)
- "Fetch the downloadable articles in the group.
-Optional arg ALL, if non-nil, means to fetch all articles."
- (interactive "P")
- (let ((articles
- (if all gnus-newsgroup-articles
- gnus-newsgroup-downloadable))
- (gnus-command-method (gnus-find-method-for-group gnus-newsgroup-name))
- fetched-articles)
- (gnus-agent-while-plugged
- (unless articles
- (error "No articles to download"))
- (gnus-agent-with-fetch
- (setq gnus-newsgroup-undownloaded
- (gnus-sorted-ndifference
- gnus-newsgroup-undownloaded
- (setq fetched-articles
- (gnus-agent-fetch-articles
- gnus-newsgroup-name articles)))))
- (save-excursion
- (dolist (article articles)
- (let ((was-marked-downloadable
- (memq article gnus-newsgroup-downloadable)))
- (cond (gnus-agent-mark-unread-after-downloaded
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable))
-
- (gnus-summary-mark-article article gnus-unread-mark))
- (was-marked-downloadable
- (gnus-summary-set-agent-mark article t)))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-download-mark article))))))
- fetched-articles))
-
-(defun gnus-agent-fetch-selected-article ()
- "Fetch the current article as it is selected.
-This can be added to `gnus-select-article-hook' or
-`gnus-mark-article-hook'."
- (let ((gnus-command-method gnus-current-select-method))
- (when (and gnus-plugged (gnus-agent-method-p gnus-command-method))
- (when (gnus-agent-fetch-articles
- gnus-newsgroup-name
- (list gnus-current-article))
- (setq gnus-newsgroup-undownloaded
- (delq gnus-current-article gnus-newsgroup-undownloaded))
- (gnus-summary-update-download-mark gnus-current-article)))))
-
-;;;
-;;; Internal functions
-;;;
-
-(defun gnus-agent-synchronize-group-flags (group actions server)
-"Update a plugged group by performing the indicated actions."
- (let* ((gnus-command-method (gnus-server-to-method server))
- (info
- ;; This initializer is required as gnus-request-set-mark
- ;; calls gnus-group-real-name to strip off the host name
- ;; before calling the backend. Now that the backend is
- ;; trying to call gnus-request-set-mark, I have to
- ;; reconstruct the original group name.
- (or (gnus-get-info group)
- (gnus-get-info
- (setq group (gnus-group-full-name
- group gnus-command-method))))))
- (gnus-request-set-mark group actions)
-
- (when info
- (dolist (action actions)
- (let ((range (nth 0 action))
- (what (nth 1 action))
- (marks (nth 2 action)))
- (dolist (mark marks)
- (cond ((eq mark 'read)
- (gnus-info-set-read
- info
- (funcall (if (eq what 'add)
- 'gnus-range-add
- 'gnus-remove-from-range)
- (gnus-info-read info)
- range))
- (gnus-get-unread-articles-in-group
- info
- (gnus-active (gnus-info-group info))))
- ((memq mark '(tick))
- (let ((info-marks (assoc mark (gnus-info-marks info))))
- (unless info-marks
- (gnus-info-set-marks info (cons (setq info-marks (list mark)) (gnus-info-marks info))))
- (setcdr info-marks (funcall (if (eq what 'add)
- 'gnus-range-add
- 'gnus-remove-from-range)
- (cdr info-marks)
- range))))))))
-
- ;;Marks can be synchronized at any time by simply toggling from
- ;;unplugged to plugged. If that is what is happening right now, make
- ;;sure that the group buffer is up to date.
- (when (gnus-buffer-live-p gnus-group-buffer)
- (gnus-group-update-group group t)))
- nil))
-
-(defun gnus-agent-save-active (method)
- (when (gnus-agent-method-p method)
- (let* ((gnus-command-method method)
- (new (gnus-make-hashtable (count-lines (point-min) (point-max))))
- (file (gnus-agent-lib-file "active")))
- (gnus-active-to-gnus-format nil new)
- (gnus-agent-write-active file new)
- (erase-buffer)
- (nnheader-insert-file-contents file))))
-
-(defun gnus-agent-write-active (file new)
- (gnus-make-directory (file-name-directory file))
- (let ((nnmail-active-file-coding-system gnus-agent-file-coding-system))
- ;; The hashtable contains real names of groups. However, do NOT
- ;; add the foreign server prefix as gnus-active-to-gnus-format
- ;; will add it while reading the file.
- (gnus-write-active-file file new nil)))
-
-;;;###autoload
-(defun gnus-agent-possibly-alter-active (group active &optional info)
- "Possibly expand a group's active range to include articles
-downloaded into the agent."
- (let* ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group))))
- (when (gnus-agent-method-p gnus-command-method)
- (let* ((local (gnus-agent-get-local group))
- (active-min (or (car active) 0))
- (active-max (or (cdr active) 0))
- (agent-min (or (car local) active-min))
- (agent-max (or (cdr local) active-max)))
-
- (when (< agent-min active-min)
- (setcar active agent-min))
-
- (when (> agent-max active-max)
- (setcdr active agent-max))
-
- (when (and info (< agent-max (- active-min 100)))
- ;; I'm expanding the active range by such a large amount
- ;; that there is a gap of more than 100 articles between the
- ;; last article known to the agent and the first article
- ;; currently available on the server. This gap contains
- ;; articles that have been lost, mark them as read so that
- ;; gnus doesn't waste resources trying to fetch them.
-
- ;; NOTE: I don't do this for smaller gaps (< 100) as I don't
- ;; want to modify the local file everytime someone restarts
- ;; gnus. The small gap will cause a tiny performance hit
- ;; when gnus tries, and fails, to retrieve the articles.
- ;; Still that should be smaller than opening a buffer,
- ;; printing this list to the buffer, and then writing it to a
- ;; file.
-
- (let ((read (gnus-info-read info)))
- (gnus-info-set-read
- info
- (gnus-range-add
- read
- (list (cons (1+ agent-max)
- (1- active-min))))))
-
- ;; Lie about the agent's local range for this group to
- ;; disable the set read each time this server is opened.
- ;; NOTE: Opening this group will restore the valid local
- ;; range but it will also expand the local range to
- ;; incompass the new active range.
- (gnus-agent-set-local group agent-min (1- active-min)))))))
-
-(defun gnus-agent-save-group-info (method group active)
- "Update a single group's active range in the agent's copy of the server's active file."
- (when (gnus-agent-method-p method)
- (let* ((gnus-command-method (or method gnus-command-method))
- (coding-system-for-write nnheader-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system)
- (file (gnus-agent-lib-file "active"))
- oactive-min oactive-max)
- (gnus-make-directory (file-name-directory file))
- (with-temp-file file
- ;; Emacs got problem to match non-ASCII group in multibyte buffer.
- (mm-disable-multibyte)
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)
-
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote group) " ") nil t)
- (save-excursion
- (setq oactive-max (read (current-buffer)) ;; max
- oactive-min (read (current-buffer)))) ;; min
- (gnus-delete-line)))
- (when active
- (insert (format "%S %d %d y\n" (intern group)
- (max (or oactive-max (cdr active)) (cdr active))
- (min (or oactive-min (car active)) (car active))))
- (goto-char (point-max))
- (while (search-backward "\\." nil t)
- (delete-char 1)))))))
-
-(defun gnus-agent-get-group-info (method group)
- "Get a single group's active range in the agent's copy of the server's active file."
- (when (gnus-agent-method-p method)
- (let* ((gnus-command-method (or method gnus-command-method))
- (coding-system-for-write nnheader-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system)
- (file (gnus-agent-lib-file "active"))
- oactive-min oactive-max)
- (gnus-make-directory (file-name-directory file))
- (with-temp-buffer
- ;; Emacs got problem to match non-ASCII group in multibyte buffer.
- (mm-disable-multibyte)
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)
-
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote group) " ") nil t)
- (save-excursion
- (setq oactive-max (read (current-buffer)) ;; max
- oactive-min (read (current-buffer))) ;; min
- (cons oactive-min oactive-max))))))))
-
-(defun gnus-agent-group-path (group)
- "Translate GROUP into a file name."
-
- ;; NOTE: This is what nnmail-group-pathname does as of Apr 2003.
- ;; The two methods must be kept synchronized, which is why
- ;; gnus-agent-group-pathname was added.
-
- (setq group
- (nnheader-translate-file-chars
- (nnheader-replace-duplicate-chars-in-string
- (nnheader-replace-chars-in-string
- (gnus-group-real-name (gnus-group-decoded-name group))
- ?/ ?_)
- ?. ?_)))
- (if (or nnmail-use-long-file-names
- (file-directory-p (expand-file-name group (gnus-agent-directory))))
- group
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)))
-
-(defun gnus-agent-group-pathname (group)
- "Translate GROUP into a file name."
- ;; nnagent uses nnmail-group-pathname to read articles while
- ;; unplugged. The agent must, therefore, use the same directory
- ;; while plugged.
- (let ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group))))
- (nnmail-group-pathname (gnus-group-real-name
- (gnus-group-decoded-name group))
- (gnus-agent-directory))))
-
-(defun gnus-agent-get-function (method)
- (if (gnus-online method)
- (car method)
- (require 'nnagent)
- 'nnagent))
-
-(defun gnus-agent-covered-methods ()
- "Return the subset of methods that are covered by the agent."
- (delq nil (mapcar #'gnus-server-to-method gnus-agent-covered-methods)))
-
-;;; History functions
-
-(defun gnus-agent-history-buffer ()
- (cdr (assoc (gnus-agent-method) gnus-agent-history-buffers)))
-
-(defun gnus-agent-open-history ()
- (save-excursion
- (push (cons (gnus-agent-method)
- (set-buffer (gnus-get-buffer-create
- (format " *Gnus agent %s history*"
- (gnus-agent-method)))))
- gnus-agent-history-buffers)
- (mm-disable-multibyte) ;; everything is binary
- (erase-buffer)
- (insert "\n")
- (let ((file (gnus-agent-lib-file "history")))
- (when (file-exists-p file)
- (nnheader-insert-file-contents file))
- (set (make-local-variable 'gnus-agent-file-name) file))))
-
-(defun gnus-agent-close-history ()
- (when (gnus-buffer-live-p gnus-agent-current-history)
- (kill-buffer gnus-agent-current-history)
- (setq gnus-agent-history-buffers
- (delq (assoc (gnus-agent-method) gnus-agent-history-buffers)
- gnus-agent-history-buffers))))
-
-;;;
-;;; Fetching
-;;;
-
-(defun gnus-agent-fetch-articles (group articles)
- "Fetch ARTICLES from GROUP and put them into the Agent."
- (when articles
- (gnus-agent-load-alist group)
- (let* ((alist gnus-agent-article-alist)
- (headers (if (< (length articles) 2) nil gnus-newsgroup-headers))
- (selected-sets (list nil))
- (current-set-size 0)
- article
- header-number)
- ;; Check each article
- (while (setq article (pop articles))
- ;; Skip alist entries preceeding this article
- (while (> article (or (caar alist) (1+ article)))
- (setq alist (cdr alist)))
-
- ;; Prune off articles that we have already fetched.
- (unless (and (eq article (caar alist))
- (cdar alist))
- ;; Skip headers preceeding this article
- (while (> article
- (setq header-number
- (let* ((header (car headers)))
- (if header
- (mail-header-number header)
- (1+ article)))))
- (setq headers (cdr headers)))
-
- ;; Add this article to the current set
- (setcar selected-sets (cons article (car selected-sets)))
-
- ;; Update the set size, when the set is too large start a
- ;; new one. I do this after adding the article as I want at
- ;; least one article in each set.
- (when (< gnus-agent-max-fetch-size
- (setq current-set-size
- (+ current-set-size
- (if (= header-number article)
- (let ((char-size (mail-header-chars
- (car headers))))
- (if (<= char-size 0)
- ;; The char size was missing/invalid,
- ;; assume a worst-case situation of
- ;; 65 char/line. If the line count
- ;; is missing, arbitrarily assume a
- ;; size of 1000 characters.
- (max (* 65 (mail-header-lines
- (car headers)))
- 1000)
- char-size))
- 0))))
- (setcar selected-sets (nreverse (car selected-sets)))
- (setq selected-sets (cons nil selected-sets)
- current-set-size 0))))
-
- (when (or (cdr selected-sets) (car selected-sets))
- (let* ((fetched-articles (list nil))
- (tail-fetched-articles fetched-articles)
- (dir (gnus-agent-group-pathname group))
- (date (time-to-days (current-time)))
- (case-fold-search t)
- pos crosses id)
-
- (setcar selected-sets (nreverse (car selected-sets)))
- (setq selected-sets (nreverse selected-sets))
-
- (gnus-make-directory dir)
- (gnus-message 7 "Fetching articles for %s..." group)
-
- (unwind-protect
- (while (setq articles (pop selected-sets))
- ;; Fetch the articles from the backend.
- (if (gnus-check-backend-function 'retrieve-articles group)
- (setq pos (gnus-retrieve-articles articles group))
- (with-temp-buffer
- (let (article)
- (while (setq article (pop articles))
- (gnus-message 10 "Fetching article %s for %s..."
- article group)
- (when (or
- (gnus-backlog-request-article group article
- nntp-server-buffer)
- (gnus-request-article article group))
- (goto-char (point-max))
- (push (cons article (point)) pos)
- (insert-buffer-substring nntp-server-buffer)))
- (copy-to-buffer
- nntp-server-buffer (point-min) (point-max))
- (setq pos (nreverse pos)))))
- ;; Then save these articles into the Agent.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (while pos
- (narrow-to-region (cdar pos) (or (cdadr pos) (point-max)))
- (goto-char (point-min))
- (unless (eobp) ;; Don't save empty articles.
- (when (search-forward "\n\n" nil t)
- (when (search-backward "\nXrefs: " nil t)
- ;; Handle cross posting.
- (goto-char (match-end 0)) ; move to end of header name
- (skip-chars-forward "^ ") ; skip server name
- (skip-chars-forward " ")
- (setq crosses nil)
- (while (looking-at "\\([^: \n]+\\):\\([0-9]+\\) *")
- (push (cons (buffer-substring (match-beginning 1)
- (match-end 1))
- (string-to-number
- (buffer-substring (match-beginning 2)
- (match-end 2))))
- crosses)
- (goto-char (match-end 0)))
- (gnus-agent-crosspost crosses (caar pos) date)))
- (goto-char (point-min))
- (if (not (re-search-forward
- "^Message-ID: *<\\([^>\n]+\\)>" nil t))
- (setq id "No-Message-ID-in-article")
- (setq id (buffer-substring
- (match-beginning 1) (match-end 1))))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max)
- (concat dir (number-to-string (caar pos)))
- nil 'silent))
-
- (gnus-agent-append-to-list
- tail-fetched-articles (caar pos)))
- (widen)
- (setq pos (cdr pos)))))
-
- (gnus-agent-save-alist group (cdr fetched-articles) date)
- (gnus-message 7 ""))
- (cdr fetched-articles))))))
-
-(defun gnus-agent-unfetch-articles (group articles)
- "Delete ARTICLES that were fetched from GROUP into the agent."
- (when articles
- (gnus-agent-load-alist group)
- (let* ((alist (cons nil gnus-agent-article-alist))
- (articles (sort articles #'<))
- (next-possibility alist)
- (delete-this (pop articles)))
- (while (and (cdr next-possibility) delete-this)
- (let ((have-this (caar (cdr next-possibility))))
- (cond ((< delete-this have-this)
- (setq delete-this (pop articles)))
- ((= delete-this have-this)
- (let ((timestamp (cdar (cdr next-possibility))))
- (when timestamp
- (let* ((file-name (concat (gnus-agent-group-pathname group)
- (number-to-string have-this))))
- (delete-file file-name))))
-
- (setcdr next-possibility (cddr next-possibility)))
- (t
- (setq next-possibility (cdr next-possibility))))))
- (setq gnus-agent-article-alist (cdr alist))
- (gnus-agent-save-alist group))))
-
-(defun gnus-agent-crosspost (crosses article &optional date)
- (setq date (or date t))
-
- (let (gnus-agent-article-alist group alist beg end)
- (save-excursion
- (set-buffer gnus-agent-overview-buffer)
- (when (nnheader-find-nov-line article)
- (forward-word 1)
- (setq beg (point))
- (setq end (progn (forward-line 1) (point)))))
- (while crosses
- (setq group (caar crosses))
- (unless (setq alist (assoc group gnus-agent-group-alist))
- (push (setq alist (list group (gnus-agent-load-alist (caar crosses))))
- gnus-agent-group-alist))
- (setcdr alist (cons (cons (cdar crosses) date) (cdr alist)))
- (save-excursion
- (set-buffer (gnus-get-buffer-create (format " *Gnus agent overview %s*"
- group)))
- (when (= (point-max) (point-min))
- (push (cons group (current-buffer)) gnus-agent-buffer-alist)
- (ignore-errors
- (nnheader-insert-file-contents
- (gnus-agent-article-name ".overview" group))))
- (nnheader-find-nov-line (string-to-number (cdar crosses)))
- (insert (string-to-number (cdar crosses)))
- (insert-buffer-substring gnus-agent-overview-buffer beg end)
- (gnus-agent-check-overview-buffer))
- (setq crosses (cdr crosses)))))
-
-(defun gnus-agent-backup-overview-buffer ()
- (when gnus-newsgroup-name
- (let ((root (gnus-agent-article-name ".overview" gnus-newsgroup-name))
- (cnt 0)
- name)
- (while (file-exists-p
- (setq name (concat root "~"
- (int-to-string (setq cnt (1+ cnt))) "~"))))
- (write-region (point-min) (point-max) name nil 'no-msg)
- (gnus-message 1 "Created backup copy of overview in %s." name)))
- t)
-
-(defun gnus-agent-check-overview-buffer (&optional buffer)
- "Check the overview file given for sanity.
-In particular, checks that the file is sorted by article number
-and that there are no duplicates."
- (let ((prev-num -1)
- (backed-up nil))
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (save-restriction
- (widen)
- (goto-char (point-min))
-
- (while (< (point) (point-max))
- (let ((p (point))
- (cur (condition-case nil
- (read (current-buffer))
- (error nil))))
- (cond
- ((or (not (integerp cur))
- (not (eq (char-after) ?\t)))
- (or backed-up
- (setq backed-up (gnus-agent-backup-overview-buffer)))
- (gnus-message 1
- "Overview buffer contains garbage '%s'."
- (buffer-substring
- p (gnus-point-at-eol))))
- ((= cur prev-num)
- (or backed-up
- (setq backed-up (gnus-agent-backup-overview-buffer)))
- (gnus-message 1
- "Duplicate overview line for %d" cur)
- (delete-region p (progn (forward-line 1) (point))))
- ((< cur prev-num)
- (or backed-up
- (setq backed-up (gnus-agent-backup-overview-buffer)))
- (gnus-message 1 "Overview buffer not sorted!")
- (sort-numeric-fields 1 (point-min) (point-max))
- (goto-char (point-min))
- (setq prev-num -1))
- (t
- (setq prev-num cur)))
- (forward-line 1)))))))
-
-(defun gnus-agent-flush-cache ()
- (save-excursion
- (while gnus-agent-buffer-alist
- (set-buffer (cdar gnus-agent-buffer-alist))
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (write-region (point-min) (point-max)
- (gnus-agent-article-name ".overview"
- (caar gnus-agent-buffer-alist))
- nil 'silent))
- (setq gnus-agent-buffer-alist (cdr gnus-agent-buffer-alist)))
- (while gnus-agent-group-alist
- (with-temp-file (gnus-agent-article-name
- ".agentview" (caar gnus-agent-group-alist))
- (princ (cdar gnus-agent-group-alist))
- (insert "\n")
- (princ 1 (current-buffer))
- (insert "\n"))
- (setq gnus-agent-group-alist (cdr gnus-agent-group-alist)))))
-
-;;;###autoload
-(defun gnus-agent-find-parameter (group symbol)
- "Search for GROUPs SYMBOL in the group's parameters, the group's
-topic parameters, the group's category, or the customizable
-variables. Returns the first non-nil value found."
- (or (gnus-group-find-parameter group symbol t)
- (gnus-group-parameter-value (cdr (gnus-group-category group)) symbol t)
- (symbol-value
- (cdr
- (assq symbol
- '((agent-short-article . gnus-agent-short-article)
- (agent-long-article . gnus-agent-long-article)
- (agent-low-score . gnus-agent-low-score)
- (agent-high-score . gnus-agent-high-score)
- (agent-days-until-old . gnus-agent-expire-days)
- (agent-enable-expiration
- . gnus-agent-enable-expiration)
- (agent-predicate . gnus-agent-predicate)))))))
-
-(defun gnus-agent-fetch-headers (group &optional force)
- "Fetch interesting headers into the agent. The group's overview
-file will be updated to include the headers while a list of available
-article numbers will be returned."
- (let* ((fetch-all (and gnus-agent-consider-all-articles
- ;; Do not fetch all headers if the predicate
- ;; implies that we only consider unread articles.
- (not (gnus-predicate-implies-unread
- (gnus-agent-find-parameter group
- 'agent-predicate)))))
- (articles (if fetch-all
- (if gnus-newsgroup-maximum-articles
- (let ((active (gnus-active group)))
- (gnus-uncompress-range
- (cons (max (car active)
- (- (cdr active)
- gnus-newsgroup-maximum-articles
- -1))
- (cdr active))))
- (gnus-uncompress-range (gnus-active group)))
- (gnus-list-of-unread-articles group)))
- (gnus-decode-encoded-word-function 'identity)
- (gnus-decode-encoded-address-function 'identity)
- (file (gnus-agent-article-name ".overview" group)))
-
- (unless fetch-all
- ;; Add articles with marks to the list of article headers we want to
- ;; fetch. Don't fetch articles solely on the basis of a recent or seen
- ;; mark, but do fetch recent or seen articles if they have other, more
- ;; interesting marks. (We have to fetch articles with boring marks
- ;; because otherwise the agent will remove their marks.)
- (dolist (arts (gnus-info-marks (gnus-get-info group)))
- (unless (memq (car arts) '(seen recent killed cache))
- (setq articles (gnus-range-add articles (cdr arts)))))
- (setq articles (sort (gnus-uncompress-sequence articles) '<)))
-
- ;; At this point, I have the list of articles to consider for
- ;; fetching. This is the list that I'll return to my caller. Some
- ;; of these articles may have already been fetched. That's OK as
- ;; the fetch article code will filter those out. Internally, I'll
- ;; filter this list to just those articles whose headers need to
- ;; be fetched.
- (let ((articles articles))
- ;; Remove known articles.
- (when (and (or gnus-agent-cache
- (not gnus-plugged))
- (gnus-agent-load-alist group))
- ;; Remove articles marked as downloaded.
- (if fetch-all
- ;; I want to fetch all headers in the active range.
- ;; Therefore, exclude only those headers that are in the
- ;; article alist.
- ;; NOTE: This is probably NOT what I want to do after
- ;; agent expiration in this group.
- (setq articles (gnus-agent-uncached-articles articles group))
-
- ;; I want to only fetch those headers that have never been
- ;; fetched. Therefore, exclude all headers that are, or
- ;; WERE, in the article alist.
- (let ((low (1+ (caar (last gnus-agent-article-alist))))
- (high (cdr (gnus-active group))))
- ;; Low can be greater than High when the same group is
- ;; fetched twice in the same session {The first fetch will
- ;; fill the article alist such that (last
- ;; gnus-agent-article-alist) equals (cdr (gnus-active
- ;; group))}. The addition of one(the 1+ above) then
- ;; forces Low to be greater than High. When this happens,
- ;; gnus-list-range-intersection returns nil which
- ;; indicates that no headers need to be fetched. -- Kevin
- (setq articles (gnus-list-range-intersection
- articles (list (cons low high)))))))
-
- (gnus-message
- 10 "gnus-agent-fetch-headers: undownloaded articles are '%s'"
- (gnus-compress-sequence articles t))
-
- (save-excursion
- (set-buffer nntp-server-buffer)
-
- (if articles
- (progn
- (gnus-message 7 "Fetching headers for %s..." group)
-
- ;; Fetch them.
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t))
-
- (unless (eq 'nov (gnus-retrieve-headers articles group))
- (nnvirtual-convert-headers))
- (gnus-agent-check-overview-buffer)
- ;; Move these headers to the overview buffer so that
- ;; gnus-agent-braid-nov can merge them with the contents
- ;; of FILE.
- (copy-to-buffer
- gnus-agent-overview-buffer (point-min) (point-max))
- ;; NOTE: Call g-a-brand-nov even when the file does not
- ;; exist. As a minimum, it will validate the article
- ;; numbers already in the buffer.
- (gnus-agent-braid-nov group articles file)
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent))
- (gnus-agent-save-alist group articles nil)
- articles)
- (ignore-errors
- (erase-buffer)
- (nnheader-insert-file-contents file)))))
- articles))
-
-(defsubst gnus-agent-read-article-number ()
- "Reads the article number at point. Returns nil when a valid article number can not be read."
-
- ;; It is unfortunate but the read function quietly overflows
- ;; integer. As a result, I have to use string operations to test
- ;; for overflow BEFORE calling read.
- (when (looking-at "[0-9]+\t")
- (let ((len (- (match-end 0) (match-beginning 0))))
- (cond ((< len 9)
- (read (current-buffer)))
- ((= len 9)
- ;; Many 9 digit base-10 numbers can be represented in a 27-bit int
- ;; Back convert from int to string to ensure that this is one of them.
- (let* ((str1 (buffer-substring (match-beginning 0) (1- (match-end 0))))
- (num (read (current-buffer)))
- (str2 (int-to-string num)))
- (when (equal str1 str2)
- num)))))))
-
-(defsubst gnus-agent-copy-nov-line (article)
- "Copy the indicated ARTICLE from the overview buffer to the nntp server buffer."
- (let (art b e)
- (set-buffer gnus-agent-overview-buffer)
- (while (and (not (eobp))
- (or (not (setq art (gnus-agent-read-article-number)))
- (< art article)))
- (forward-line 1))
- (beginning-of-line)
- (if (or (eobp)
- (not (eq article art)))
- (set-buffer nntp-server-buffer)
- (setq b (point))
- (setq e (progn (forward-line 1) (point)))
- (set-buffer nntp-server-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer b e))))
-
-(defun gnus-agent-braid-nov (group articles file)
- "Merge agent overview data with given file.
-Takes unvalidated headers for ARTICLES from
-`gnus-agent-overview-buffer' and validated headers from the given
-FILE and places the combined valid headers into
-`nntp-server-buffer'. This function can be used, when file
-doesn't exist, to valid the overview buffer."
- (let (start last)
- (set-buffer gnus-agent-overview-buffer)
- (goto-char (point-min))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (when (file-exists-p file)
- (nnheader-insert-file-contents file))
- (goto-char (point-max))
- (forward-line -1)
-
- (unless (or (= (point-min) (point-max))
- (< (setq last (read (current-buffer))) (car articles)))
- ;; Old and new overlap -- We do it the hard way.
- (when (nnheader-find-nov-line (car articles))
- ;; Replacing existing NOV entry
- (delete-region (point) (progn (forward-line 1) (point))))
- (gnus-agent-copy-nov-line (pop articles))
-
- (ignore-errors
- (while articles
- (while (let ((art (read (current-buffer))))
- (cond ((< art (car articles))
- (forward-line 1)
- t)
- ((= art (car articles))
- (beginning-of-line)
- (delete-region
- (point) (progn (forward-line 1) (point)))
- nil)
- (t
- (beginning-of-line)
- nil))))
-
- (gnus-agent-copy-nov-line (pop articles)))))
-
- (goto-char (point-max))
-
- ;; Append the remaining lines
- (when articles
- (when last
- (set-buffer gnus-agent-overview-buffer)
- (setq start (point))
- (set-buffer nntp-server-buffer))
-
- (let ((p (point)))
- (insert-buffer-substring gnus-agent-overview-buffer start)
- (goto-char p))
-
- (setq last (or last -134217728))
- (while (catch 'problems
- (let (sort art)
- (while (not (eobp))
- (setq art (gnus-agent-read-article-number))
- (cond ((not art)
- ;; Bad art num - delete this line
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point))))
- ((< art last)
- ;; Art num out of order - enable sort
- (setq sort t)
- (forward-line 1))
- ((= art last)
- ;; Bad repeat of art number - delete this line
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point))))
- (t
- ;; Good art num
- (setq last art)
- (forward-line 1))))
- (when sort
- ;; something is seriously wrong as we simply shouldn't see out-of-order data.
- ;; First, we'll fix the sort.
- (sort-numeric-fields 1 (point-min) (point-max))
-
- ;; but now we have to consider that we may have duplicate rows...
- ;; so reset to beginning of file
- (goto-char (point-min))
- (setq last -134217728)
-
- ;; and throw a code that restarts this scan
- (throw 'problems t))
- nil))))))
-
-;; Keeps the compiler from warning about the free variable in
-;; gnus-agent-read-agentview.
-(eval-when-compile
- (defvar gnus-agent-read-agentview))
-
-(defun gnus-agent-load-alist (group)
- "Load the article-state alist for GROUP."
- ;; Bind free variable that's used in `gnus-agent-read-agentview'.
- (let ((gnus-agent-read-agentview group))
- (setq gnus-agent-article-alist
- (gnus-cache-file-contents
- (gnus-agent-article-name ".agentview" group)
- 'gnus-agent-file-loading-cache
- 'gnus-agent-read-agentview))))
-
-(defun gnus-agent-read-agentview (file)
- "Load FILE and do a `read' there."
- (with-temp-buffer
- (condition-case nil
- (progn
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let ((alist (read (current-buffer)))
- (version (condition-case nil (read (current-buffer))
- (end-of-file 0)))
- changed-version)
-
- (cond
- ((= version 0)
- (let ((inhibit-quit t)
- entry)
- (gnus-agent-open-history)
- (set-buffer (gnus-agent-history-buffer))
- (goto-char (point-min))
- (while (not (eobp))
- (if (and (looking-at
- "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
- (string= (match-string 2)
- gnus-agent-read-agentview)
- (setq entry (assoc (string-to-number (match-string 3)) alist)))
- (setcdr entry (string-to-number (match-string 1))))
- (forward-line 1))
- (gnus-agent-close-history)
- (setq changed-version t)))
- ((= version 1)
- (setq changed-version (not (= 1 gnus-agent-article-alist-save-format))))
- ((= version 2)
- (let (uncomp)
- (mapcar
- (lambda (comp-list)
- (let ((state (car comp-list))
- (sequence (inline
- (gnus-uncompress-range
- (cdr comp-list)))))
- (mapcar (lambda (article-id)
- (setq uncomp (cons (cons article-id state) uncomp)))
- sequence)))
- alist)
- (setq alist (sort uncomp 'car-less-than-car)))
- (setq changed-version (not (= 2 gnus-agent-article-alist-save-format)))))
- (when changed-version
- (let ((gnus-agent-article-alist alist))
- (gnus-agent-save-alist gnus-agent-read-agentview)))
- alist))
- (file-error nil))))
-
-(defun gnus-agent-save-alist (group &optional articles state)
- "Save the article-state alist for GROUP."
- (let* ((file-name-coding-system nnmail-pathname-coding-system)
- (prev (cons nil gnus-agent-article-alist))
- (all prev)
- print-level print-length item article)
- (while (setq article (pop articles))
- (while (and (cdr prev)
- (< (caadr prev) article))
- (setq prev (cdr prev)))
- (cond
- ((not (cdr prev))
- (setcdr prev (list (cons article state))))
- ((> (caadr prev) article)
- (setcdr prev (cons (cons article state) (cdr prev))))
- ((= (caadr prev) article)
- (setcdr (cadr prev) state)))
- (setq prev (cdr prev)))
- (setq gnus-agent-article-alist (cdr all))
-
- (gnus-agent-set-local group
- (caar gnus-agent-article-alist)
- (caar (last gnus-agent-article-alist)))
-
- (gnus-make-directory (gnus-agent-article-name "" group))
- (with-temp-file (gnus-agent-article-name ".agentview" group)
- (cond ((eq gnus-agent-article-alist-save-format 1)
- (princ gnus-agent-article-alist (current-buffer)))
- ((eq gnus-agent-article-alist-save-format 2)
- (let ((compressed nil))
- (mapcar (lambda (pair)
- (let* ((article-id (car pair))
- (day-of-download (cdr pair))
- (comp-list (assq day-of-download compressed)))
- (if comp-list
- (setcdr comp-list
- (cons article-id (cdr comp-list)))
- (setq compressed
- (cons (list day-of-download article-id)
- compressed)))
- nil)) gnus-agent-article-alist)
- (mapcar (lambda (comp-list)
- (setcdr comp-list
- (gnus-compress-sequence
- (nreverse (cdr comp-list)))))
- compressed)
- (princ compressed (current-buffer)))))
- (insert "\n")
- (princ gnus-agent-article-alist-save-format (current-buffer))
- (insert "\n"))))
-
-(defvar gnus-agent-article-local nil)
-(defvar gnus-agent-file-loading-local nil)
-
-(defun gnus-agent-load-local (&optional method)
- "Load the METHOD'S local file. The local file contains min/max
-article counts for each of the method's subscribed groups."
- (let ((gnus-command-method (or method gnus-command-method)))
- (setq gnus-agent-article-local
- (gnus-cache-file-contents
- (gnus-agent-lib-file "local")
- 'gnus-agent-file-loading-local
- 'gnus-agent-read-and-cache-local))))
-
-(defun gnus-agent-read-and-cache-local (file)
- "Load and read FILE then bind its contents to
-gnus-agent-article-local. If that variable had `dirty' (also known as
-modified) original contents, they are first saved to their own file."
-
- (if (and gnus-agent-article-local
- (symbol-value (intern "+dirty" gnus-agent-article-local)))
- (gnus-agent-save-local))
- (gnus-agent-read-local file))
-
-(defun gnus-agent-read-local (file)
- "Load FILE and do a `read' there."
- (let ((my-obarray (gnus-make-hashtable (count-lines (point-min)
- (point-max))))
- (line 1))
- (with-temp-buffer
- (condition-case nil
- (let ((nnheader-file-coding-system gnus-agent-file-coding-system))
- (nnheader-insert-file-contents file))
- (file-error))
-
- (goto-char (point-min))
- ;; Skip any comments at the beginning of the file (the only place where they may appear)
- (while (= (following-char) ?\;)
- (forward-line 1)
- (setq line (1+ line)))
-
- (while (not (eobp))
- (condition-case err
- (let (group
- min
- max
- (cur (current-buffer))
- (obarray my-obarray))
- (setq group (read cur)
- min (read cur)
- max (read cur))
-
- (when (stringp group)
- (setq group (intern group my-obarray)))
-
- ;; NOTE: The '+ 0' ensure that min and max are both numerics.
- (set group (cons (+ 0 min) (+ 0 max))))
- (error
- (gnus-message 3 "Warning - invalid agent local: %s on line %d: %s"
- file line (error-message-string err))))
- (forward-line 1)
- (setq line (1+ line))))
-
- (set (intern "+dirty" my-obarray) nil)
- (set (intern "+method" my-obarray) gnus-command-method)
- my-obarray))
-
-(defun gnus-agent-save-local (&optional force)
- "Save gnus-agent-article-local under it method's agent.lib directory."
- (let ((my-obarray gnus-agent-article-local))
- (when (and my-obarray
- (or force (symbol-value (intern "+dirty" my-obarray))))
- (let* ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
- ;; NOTE: gnus-command-method is used within gnus-agent-lib-file.
- (dest (gnus-agent-lib-file "local")))
- (gnus-make-directory (gnus-agent-lib-file ""))
-
- (let ((buffer-file-coding-system gnus-agent-file-coding-system))
- (with-temp-file dest
- (let ((gnus-command-method (symbol-value (intern "+method" my-obarray)))
- (file-name-coding-system nnmail-pathname-coding-system)
- print-level print-length item article
- (standard-output (current-buffer)))
- (mapatoms (lambda (symbol)
- (cond ((not (boundp symbol))
- nil)
- ((member (symbol-name symbol) '("+dirty" "+method"))
- nil)
- (t
- (let ((range (symbol-value symbol)))
- (when range
- (prin1 symbol)
- (princ " ")
- (princ (car range))
- (princ " ")
- (princ (cdr range))
- (princ "\n"))))))
- my-obarray))))))))
-
-(defun gnus-agent-get-local (group &optional gmane method)
- (let* ((gmane (or gmane (gnus-group-real-name group)))
- (gnus-command-method (or method (gnus-find-method-for-group group)))
- (local (gnus-agent-load-local))
- (symb (intern gmane local))
- (minmax (and (boundp symb) (symbol-value symb))))
- (unless minmax
- ;; Bind these so that gnus-agent-load-alist doesn't change the
- ;; current alist (i.e. gnus-agent-article-alist)
- (let* ((gnus-agent-article-alist gnus-agent-article-alist)
- (gnus-agent-file-loading-cache gnus-agent-file-loading-cache)
- (alist (gnus-agent-load-alist group)))
- (when alist
- (setq minmax
- (cons (caar alist)
- (caar (last alist))))
- (gnus-agent-set-local group (car minmax) (cdr minmax)
- gmane gnus-command-method local))))
- minmax))
-
-(defun gnus-agent-set-local (group min max &optional gmane method local)
- (let* ((gmane (or gmane (gnus-group-real-name group)))
- (gnus-command-method (or method (gnus-find-method-for-group group)))
- (local (or local (gnus-agent-load-local)))
- (symb (intern gmane local))
- (minmax (and (boundp symb) (symbol-value symb))))
-
- (if (cond ((and minmax
- (or (not (eq min (car minmax)))
- (not (eq max (cdr minmax))))
- min
- max)
- (setcar minmax min)
- (setcdr minmax max)
- t)
- (minmax
- nil)
- ((and min max)
- (set symb (cons min max))
- t)
- (t
- (unintern symb local)))
- (set (intern "+dirty" local) t))))
-
-(defun gnus-agent-article-name (article group)
- (expand-file-name article
- (file-name-as-directory
- (gnus-agent-group-pathname group))))
-
-(defun gnus-agent-batch-confirmation (msg)
- "Show error message and return t."
- (gnus-message 1 msg)
- t)
-
-;;;###autoload
-(defun gnus-agent-batch-fetch ()
- "Start Gnus and fetch session."
- (interactive)
- (gnus)
- (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
- (gnus-agent-fetch-session))
- (gnus-group-exit))
-
-(defun gnus-agent-fetch-session ()
- "Fetch all articles and headers that are eligible for fetching."
- (interactive)
- (unless gnus-agent-covered-methods
- (error "No servers are covered by the Gnus agent"))
- (unless gnus-plugged
- (error "Can't fetch articles while Gnus is unplugged"))
- (let ((methods (gnus-agent-covered-methods))
- groups group gnus-command-method)
- (save-excursion
- (while methods
- (setq gnus-command-method (car methods))
- (when (and (or (gnus-server-opened gnus-command-method)
- (gnus-open-server gnus-command-method))
- (gnus-online gnus-command-method))
- (setq groups (gnus-groups-from-server (car methods)))
- (gnus-agent-with-fetch
- (while (setq group (pop groups))
- (when (<= (gnus-group-level group)
- gnus-agent-handle-level)
- (if (or debug-on-error debug-on-quit)
- (gnus-agent-fetch-group-1
- group gnus-command-method)
- (condition-case err
- (gnus-agent-fetch-group-1
- group gnus-command-method)
- (error
- (unless (funcall gnus-agent-confirmation-function
- (format "Error %s while fetching session. Should gnus continue? "
- (error-message-string err)))
- (error "Cannot fetch articles into the Gnus agent")))
- (quit
- (gnus-agent-regenerate-group group)
- (unless (funcall gnus-agent-confirmation-function
- (format
- "%s while fetching session. Should gnus continue? "
- (error-message-string err)))
- (signal 'quit
- "Cannot fetch articles into the Gnus agent")))))))))
- (setq methods (cdr methods)))
- (gnus-run-hooks 'gnus-agent-fetched-hook)
- (gnus-message 6 "Finished fetching articles into the Gnus agent"))))
-
-(defun gnus-agent-fetch-group-1 (group method)
- "Fetch GROUP."
- (let ((gnus-command-method method)
- (gnus-newsgroup-name group)
- (gnus-newsgroup-dependencies gnus-newsgroup-dependencies)
- (gnus-newsgroup-headers gnus-newsgroup-headers)
- (gnus-newsgroup-scored gnus-newsgroup-scored)
- (gnus-use-cache gnus-use-cache)
- (gnus-summary-expunge-below gnus-summary-expunge-below)
- (gnus-summary-mark-below gnus-summary-mark-below)
- (gnus-orphan-score gnus-orphan-score)
- ;; Maybe some other gnus-summary local variables should also
- ;; be put here.
-
- gnus-headers
- gnus-score
- articles arts
- category predicate info marks score-param
- )
- (unless (gnus-check-group group)
- (error "Can't open server for %s" group))
-
- ;; Fetch headers.
- (when (or gnus-newsgroup-active
- (gnus-active group)
- (gnus-activate-group group))
- (let ((marked-articles gnus-newsgroup-downloadable))
- ;; Identify the articles marked for download
- (unless gnus-newsgroup-active
- ;; The variable gnus-newsgroup-active was selected as I need
- ;; a gnus-summary local variable that is NOT bound to any
- ;; value (its global value should default to nil).
- (dolist (mark gnus-agent-download-marks)
- (let ((arts (cdr (assq mark (gnus-info-marks
- (setq info (gnus-get-info group)))))))
- (when arts
- (setq marked-articles (nconc (gnus-uncompress-range arts)
- marked-articles))
- ))))
- (setq marked-articles (sort marked-articles '<))
-
- ;; Fetch any new articles from the server
- (setq articles (gnus-agent-fetch-headers group))
-
- ;; Merge new articles with marked
- (setq articles (sort (append marked-articles articles) '<))
-
- (when articles
- ;; Parse them and see which articles we want to fetch.
- (setq gnus-newsgroup-dependencies
- (or gnus-newsgroup-dependencies
- (make-vector (length articles) 0)))
- (setq gnus-newsgroup-headers
- (or gnus-newsgroup-headers
- (gnus-get-newsgroup-headers-xover articles nil nil
- group)))
- ;; `gnus-agent-overview-buffer' may be killed for
- ;; timeout reason. If so, recreate it.
- (gnus-agent-create-buffer)
-
- ;; Figure out how to select articles in this group
- (setq category (gnus-group-category group))
-
- (setq predicate
- (gnus-get-predicate
- (gnus-agent-find-parameter group 'agent-predicate)))
-
- ;; If the selection predicate requires scoring, score each header
- (unless (memq predicate '(gnus-agent-true gnus-agent-false))
- (let ((score-param
- (gnus-agent-find-parameter group 'agent-score-file)))
- ;; Translate score-param into real one
- (cond
- ((not score-param))
- ((eq score-param 'file)
- (setq score-param (gnus-all-score-files group)))
- ((stringp (car score-param)))
- (t
- (setq score-param (list (list score-param)))))
- (when score-param
- (gnus-score-headers score-param))))
-
- (unless (and (eq predicate 'gnus-agent-false)
- (not marked-articles))
- (let ((arts (list nil)))
- (let ((arts-tail arts)
- (alist (gnus-agent-load-alist group))
- (marked-articles marked-articles)
- (gnus-newsgroup-headers gnus-newsgroup-headers))
- (while (setq gnus-headers (pop gnus-newsgroup-headers))
- (let ((num (mail-header-number gnus-headers)))
- ;; Determine if this article is already in the cache
- (while (and alist
- (> num (caar alist)))
- (setq alist (cdr alist)))
-
- (unless (and (eq num (caar alist))
- (cdar alist))
-
- ;; Determine if this article was marked for download.
- (while (and marked-articles
- (> num (car marked-articles)))
- (setq marked-articles
- (cdr marked-articles)))
-
- ;; When this article is marked, or selected by the
- ;; predicate, add it to the download list
- (when (or (eq num (car marked-articles))
- (let ((gnus-score
- (or (cdr
- (assq num gnus-newsgroup-scored))
- gnus-summary-default-score))
- (gnus-agent-long-article
- (gnus-agent-find-parameter
- group 'agent-long-article))
- (gnus-agent-short-article
- (gnus-agent-find-parameter
- group 'agent-short-article))
- (gnus-agent-low-score
- (gnus-agent-find-parameter
- group 'agent-low-score))
- (gnus-agent-high-score
- (gnus-agent-find-parameter
- group 'agent-high-score))
- (gnus-agent-expire-days
- (gnus-agent-find-parameter
- group 'agent-days-until-old)))
- (funcall predicate)))
- (gnus-agent-append-to-list arts-tail num))))))
-
- (let (fetched-articles)
- ;; Fetch all selected articles
- (setq gnus-newsgroup-undownloaded
- (gnus-sorted-ndifference
- gnus-newsgroup-undownloaded
- (setq fetched-articles
- (if (cdr arts)
- (gnus-agent-fetch-articles group (cdr arts))
- nil))))
-
- (let ((unfetched-articles
- (gnus-sorted-ndifference (cdr arts) fetched-articles)))
- (if gnus-newsgroup-active
- ;; Update the summary buffer
- (progn
- (dolist (article marked-articles)
- (gnus-summary-set-agent-mark article t))
- (dolist (article fetched-articles)
- (when gnus-agent-mark-unread-after-downloaded
- (setq gnus-newsgroup-downloadable
- (delq article gnus-newsgroup-downloadable))
- (gnus-summary-mark-article
- article gnus-unread-mark))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-download-mark article)))
- (dolist (article unfetched-articles)
- (gnus-summary-mark-article
- article gnus-canceled-mark)))
-
- ;; Update the group buffer.
-
- ;; When some, or all, of the marked articles came
- ;; from the download mark. Remove that mark. I
- ;; didn't do this earlier as I only want to remove
- ;; the marks after the fetch is completed.
-
- (dolist (mark gnus-agent-download-marks)
- (when (eq mark 'download)
- (let ((marked-arts
- (assq mark (gnus-info-marks
- (setq info (gnus-get-info group))))))
- (when (cdr marked-arts)
- (setq marks
- (delq marked-arts (gnus-info-marks info)))
- (gnus-info-set-marks info marks)))))
- (let ((read (gnus-info-read
- (or info (setq info (gnus-get-info group))))))
- (gnus-info-set-read
- info (gnus-add-to-range read unfetched-articles)))
-
- (gnus-group-update-group group t)
- (sit-for 0)
-
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string info)
- ")"))))))))))))
-
-;;;
-;;; Agent Category Mode
-;;;
-
-(defvar gnus-category-mode-hook nil
- "Hook run in `gnus-category-mode' buffers.")
-
-(defvar gnus-category-line-format " %(%20c%): %g\n"
- "Format of category lines.
-
-Valid specifiers include:
-%c Topic name (string)
-%g The number of groups in the topic (integer)
-
-General format specifiers can also be used. See Info node
-`(gnus)Formatting Variables'.")
-
-(defvar gnus-category-mode-line-format "Gnus: %%b"
- "The format specification for the category mode line.")
-
-(defvar gnus-agent-predicate 'false
- "The selection predicate used when no other source is available.")
-
-(defvar gnus-agent-short-article 100
- "Articles that have fewer lines than this are short.")
-
-(defvar gnus-agent-long-article 200
- "Articles that have more lines than this are long.")
-
-(defvar gnus-agent-low-score 0
- "Articles that have a score lower than this have a low score.")
-
-(defvar gnus-agent-high-score 0
- "Articles that have a score higher than this have a high score.")
-
-
-;;; Internal variables.
-
-(defvar gnus-category-buffer "*Agent Category*")
-
-(defvar gnus-category-line-format-alist
- `((?c gnus-tmp-name ?s)
- (?g gnus-tmp-groups ?d)))
-
-(defvar gnus-category-mode-line-format-alist
- `((?u user-defined ?s)))
-
-(defvar gnus-category-line-format-spec nil)
-(defvar gnus-category-mode-line-format-spec nil)
-
-(defvar gnus-category-mode-map nil)
-(put 'gnus-category-mode 'mode-class 'special)
-
-(unless gnus-category-mode-map
- (setq gnus-category-mode-map (make-sparse-keymap))
- (suppress-keymap gnus-category-mode-map)
-
- (gnus-define-keys gnus-category-mode-map
- "q" gnus-category-exit
- "k" gnus-category-kill
- "c" gnus-category-copy
- "a" gnus-category-add
- "e" gnus-agent-customize-category
- "p" gnus-category-edit-predicate
- "g" gnus-category-edit-groups
- "s" gnus-category-edit-score
- "l" gnus-category-list
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
-
-(defvar gnus-category-menu-hook nil
- "*Hook run after the creation of the menu.")
-
-(defun gnus-category-make-menu-bar ()
- (gnus-turn-off-edit-menu 'category)
- (unless (boundp 'gnus-category-menu)
- (easy-menu-define
- gnus-category-menu gnus-category-mode-map ""
- '("Categories"
- ["Add" gnus-category-add t]
- ["Kill" gnus-category-kill t]
- ["Copy" gnus-category-copy t]
- ["Edit category" gnus-agent-customize-category t]
- ["Edit predicate" gnus-category-edit-predicate t]
- ["Edit score" gnus-category-edit-score t]
- ["Edit groups" gnus-category-edit-groups t]
- ["Exit" gnus-category-exit t]))
-
- (gnus-run-hooks 'gnus-category-menu-hook)))
-
-(defun gnus-category-mode ()
- "Major mode for listing and editing agent categories.
-
-All normal editing commands are switched off.
-\\<gnus-category-mode-map>
-For more in-depth information on this mode, read the manual
-\(`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-category-mode-map}"
- (interactive)
- (when (gnus-visual-p 'category-menu 'menu)
- (gnus-category-make-menu-bar))
- (kill-all-local-variables)
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-category-mode)
- (setq mode-name "Category")
- (gnus-set-default-directory)
- (setq mode-line-process nil)
- (use-local-map gnus-category-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-category-mode-hook))
-
-(defalias 'gnus-category-position-point 'gnus-goto-colon)
-
-(defun gnus-category-insert-line (category)
- (let* ((gnus-tmp-name (format "%s" (car category)))
- (gnus-tmp-groups (length (gnus-agent-cat-groups category))))
- (beginning-of-line)
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- ;; Insert the text.
- (eval gnus-category-line-format-spec))
- (list 'gnus-category gnus-tmp-name))))
-
-(defun gnus-enter-category-buffer ()
- "Go to the Category buffer."
- (interactive)
- (gnus-category-setup-buffer)
- (gnus-configure-windows 'category)
- (gnus-category-prepare))
-
-(defun gnus-category-setup-buffer ()
- (unless (get-buffer gnus-category-buffer)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-category-buffer))
- (gnus-category-mode))))
-
-(defun gnus-category-prepare ()
- (gnus-set-format 'category-mode)
- (gnus-set-format 'category t)
- (let ((alist gnus-category-alist)
- (buffer-read-only nil))
- (erase-buffer)
- (while alist
- (gnus-category-insert-line (pop alist)))
- (goto-char (point-min))
- (gnus-category-position-point)))
-
-(defun gnus-category-name ()
- (or (intern (get-text-property (gnus-point-at-bol) 'gnus-category))
- (error "No category on the current line")))
-
-(defun gnus-category-read ()
- "Read the category alist."
- (setq gnus-category-alist
- (or
- (with-temp-buffer
- (ignore-errors
- (nnheader-insert-file-contents (nnheader-concat gnus-agent-directory "lib/categories"))
- (goto-char (point-min))
- ;; This code isn't temp, it will be needed so long as
- ;; anyone may be migrating from an older version.
-
- ;; Once we're certain that people will not revert to an
- ;; earlier version, we can take out the old-list code in
- ;; gnus-category-write.
- (let* ((old-list (read (current-buffer)))
- (new-list (ignore-errors (read (current-buffer)))))
- (if new-list
- new-list
- ;; Convert from a positional list to an alist.
- (mapcar
- (lambda (c)
- (setcdr c
- (delq nil
- (gnus-mapcar
- (lambda (valu symb)
- (if valu
- (cons symb valu)))
- (cdr c)
- '(agent-predicate agent-score-file agent-groups))))
- c)
- old-list)))))
- (list (gnus-agent-cat-make 'default 'short)))))
-
-(defun gnus-category-write ()
- "Write the category alist."
- (setq gnus-category-predicate-cache nil
- gnus-category-group-cache nil)
- (gnus-make-directory (nnheader-concat gnus-agent-directory "lib"))
- (with-temp-file (nnheader-concat gnus-agent-directory "lib/categories")
- ;; This prin1 is temporary. It exists so that people can revert
- ;; to an earlier version of gnus-agent.
- (prin1 (mapcar (lambda (c)
- (list (car c)
- (cdr (assoc 'agent-predicate c))
- (cdr (assoc 'agent-score-file c))
- (cdr (assoc 'agent-groups c))))
- gnus-category-alist)
- (current-buffer))
- (newline)
- (prin1 gnus-category-alist (current-buffer))))
-
-(defun gnus-category-edit-predicate (category)
- "Edit the predicate for CATEGORY."
- (interactive (list (gnus-category-name)))
- (let ((info (assq category gnus-category-alist)))
- (gnus-edit-form
- (gnus-agent-cat-predicate info)
- (format "Editing the select predicate for category %s" category)
- `(lambda (predicate)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-predicate (assq ',category gnus-category-alist))
- ;; predicate)
- ;; use its expansion instead:
- (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
- 'agent-predicate predicate)
-
- (gnus-category-write)
- (gnus-category-list)))))
-
-(defun gnus-category-edit-score (category)
- "Edit the score expression for CATEGORY."
- (interactive (list (gnus-category-name)))
- (let ((info (assq category gnus-category-alist)))
- (gnus-edit-form
- (gnus-agent-cat-score-file info)
- (format "Editing the score expression for category %s" category)
- `(lambda (score-file)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-score-file (assq ',category gnus-category-alist))
- ;; score-file)
- ;; use its expansion instead:
- (gnus-agent-cat-set-property (assq ',category gnus-category-alist)
- 'agent-score-file score-file)
-
- (gnus-category-write)
- (gnus-category-list)))))
-
-(defun gnus-category-edit-groups (category)
- "Edit the group list for CATEGORY."
- (interactive (list (gnus-category-name)))
- (let ((info (assq category gnus-category-alist)))
- (gnus-edit-form
- (gnus-agent-cat-groups info)
- (format "Editing the group list for category %s" category)
- `(lambda (groups)
- ;; Avoid run-time execution of setf form
- ;; (setf (gnus-agent-cat-groups (assq ',category gnus-category-alist))
- ;; groups)
- ;; use its expansion instead:
- (gnus-agent-set-cat-groups (assq ',category gnus-category-alist)
- groups)
-
- (gnus-category-write)
- (gnus-category-list)))))
-
-(defun gnus-category-kill (category)
- "Kill the current category."
- (interactive (list (gnus-category-name)))
- (let ((info (assq category gnus-category-alist))
- (buffer-read-only nil))
- (gnus-delete-line)
- (setq gnus-category-alist (delq info gnus-category-alist))
- (gnus-category-write)))
-
-(defun gnus-category-copy (category to)
- "Copy the current category."
- (interactive (list (gnus-category-name) (intern (read-string "New name: "))))
- (let ((info (assq category gnus-category-alist)))
- (push (let ((newcat (gnus-copy-sequence info)))
- (setf (gnus-agent-cat-name newcat) to)
- (setf (gnus-agent-cat-groups newcat) nil)
- newcat)
- gnus-category-alist)
- (gnus-category-write)
- (gnus-category-list)))
-
-(defun gnus-category-add (category)
- "Create a new category."
- (interactive "SCategory name: ")
- (when (assq category gnus-category-alist)
- (error "Category %s already exists" category))
- (push (gnus-agent-cat-make category)
- gnus-category-alist)
- (gnus-category-write)
- (gnus-category-list))
-
-(defun gnus-category-list ()
- "List all categories."
- (interactive)
- (gnus-category-prepare))
-
-(defun gnus-category-exit ()
- "Return to the group buffer."
- (interactive)
- (kill-buffer (current-buffer))
- (gnus-configure-windows 'group t))
-
-;; To avoid having 8-bit characters in the source file.
-(defvar gnus-category-not (list '! 'not (intern (format "%c" 172))))
-
-(defvar gnus-category-predicate-alist
- '((spam . gnus-agent-spam-p)
- (short . gnus-agent-short-p)
- (long . gnus-agent-long-p)
- (low . gnus-agent-low-scored-p)
- (high . gnus-agent-high-scored-p)
- (read . gnus-agent-read-p)
- (true . gnus-agent-true)
- (false . gnus-agent-false))
- "Mapping from short score predicate symbols to predicate functions.")
-
-(defun gnus-agent-spam-p ()
- "Say whether an article is spam or not."
- (unless gnus-agent-spam-hashtb
- (setq gnus-agent-spam-hashtb (gnus-make-hashtable 1000)))
- (if (not (equal (mail-header-references gnus-headers) ""))
- nil
- (let ((string (gnus-simplify-subject (mail-header-subject gnus-headers))))
- (prog1
- (gnus-gethash string gnus-agent-spam-hashtb)
- (gnus-sethash string t gnus-agent-spam-hashtb)))))
-
-(defun gnus-agent-short-p ()
- "Say whether an article is short or not."
- (< (mail-header-lines gnus-headers) gnus-agent-short-article))
-
-(defun gnus-agent-long-p ()
- "Say whether an article is long or not."
- (> (mail-header-lines gnus-headers) gnus-agent-long-article))
-
-(defun gnus-agent-low-scored-p ()
- "Say whether an article has a low score or not."
- (< gnus-score gnus-agent-low-score))
-
-(defun gnus-agent-high-scored-p ()
- "Say whether an article has a high score or not."
- (> gnus-score gnus-agent-high-score))
-
-(defun gnus-agent-read-p ()
- "Say whether an article is read or not."
- (gnus-member-of-range (mail-header-number gnus-headers)
- (gnus-info-read (gnus-get-info gnus-newsgroup-name))))
-
-(defun gnus-category-make-function (predicate)
- "Make a function from PREDICATE."
- (let ((func (gnus-category-make-function-1 predicate)))
- (if (and (= (length func) 1)
- (symbolp (car func)))
- (car func)
- (gnus-byte-compile `(lambda () ,func)))))
-
-(defun gnus-agent-true ()
- "Return t."
- t)
-
-(defun gnus-agent-false ()
- "Return nil."
- nil)
-
-(defun gnus-category-make-function-1 (predicate)
- "Make a function from PREDICATE."
- (cond
- ;; Functions are just returned as is.
- ((or (symbolp predicate)
- (functionp predicate))
- `(,(or (cdr (assq predicate gnus-category-predicate-alist))
- predicate)))
- ;; More complex predicate.
- ((consp predicate)
- `(,(cond
- ((memq (car predicate) '(& and))
- 'and)
- ((memq (car predicate) '(| or))
- 'or)
- ((memq (car predicate) gnus-category-not)
- 'not))
- ,@(mapcar 'gnus-category-make-function-1 (cdr predicate))))
- (t
- (error "Unknown predicate type: %s" predicate))))
-
-(defun gnus-get-predicate (predicate)
- "Return the function implementing PREDICATE."
- (or (cdr (assoc predicate gnus-category-predicate-cache))
- (let ((func (gnus-category-make-function predicate)))
- (setq gnus-category-predicate-cache
- (nconc gnus-category-predicate-cache
- (list (cons predicate func))))
- func)))
-
-(defun gnus-predicate-implies-unread (predicate)
- "Say whether PREDICATE implies unread articles only.
-It is okay to miss some cases, but there must be no false positives.
-That is, if this predicate returns true, then indeed the predicate must
-return only unread articles."
- (eq t (gnus-function-implies-unread-1
- (gnus-category-make-function-1 predicate))))
-
-(defun gnus-function-implies-unread-1 (function)
- "Recursively evaluate a predicate function to determine whether it can select
-any read articles. Returns t if the function is known to never
-return read articles, nil when it is known to always return read
-articles, and t_nil when the function may return both read and unread
-articles."
- (let ((func (car function))
- (args (mapcar 'gnus-function-implies-unread-1 (cdr function))))
- (cond ((eq func 'and)
- (cond ((memq t args) ; if any argument returns only unread articles
- ;; then that argument constrains the result to only unread articles.
- t)
- ((memq 't_nil args) ; if any argument is indeterminate
- ;; then the result is indeterminate
- 't_nil)))
- ((eq func 'or)
- (cond ((memq nil args) ; if any argument returns read articles
- ;; then that argument ensures that the results includes read articles.
- nil)
- ((memq 't_nil args) ; if any argument is indeterminate
- ;; then that argument ensures that the results are indeterminate
- 't_nil)
- (t ; if all arguments return only unread articles
- ;; then the result returns only unread articles
- t)))
- ((eq func 'not)
- (cond ((eq (car args) 't_nil) ; if the argument is indeterminate
- ; then the result is indeterminate
- (car args))
- (t ; otherwise
- ; toggle the result to be the opposite of the argument
- (not (car args)))))
- ((eq func 'gnus-agent-read-p)
- nil) ; The read predicate NEVER returns unread articles
- ((eq func 'gnus-agent-false)
- t) ; The false predicate returns t as the empty set excludes all read articles
- ((eq func 'gnus-agent-true)
- nil) ; The true predicate ALWAYS returns read articles
- ((catch 'found-match
- (let ((alist gnus-category-predicate-alist))
- (while alist
- (if (eq func (cdar alist))
- (throw 'found-match t)
- (setq alist (cdr alist))))))
- 't_nil) ; All other predicates return read and unread articles
- (t
- (error "Unknown predicate function: %s" function)))))
-
-(defun gnus-group-category (group)
- "Return the category GROUP belongs to."
- (unless gnus-category-group-cache
- (setq gnus-category-group-cache (gnus-make-hashtable 1000))
- (let ((cs gnus-category-alist)
- groups cat)
- (while (setq cat (pop cs))
- (setq groups (gnus-agent-cat-groups cat))
- (while groups
- (gnus-sethash (pop groups) cat gnus-category-group-cache)))))
- (or (gnus-gethash group gnus-category-group-cache)
- (assq 'default gnus-category-alist)))
-
-(defun gnus-agent-expire-group (group &optional articles force)
- "Expire all old articles in GROUP.
-If you want to force expiring of certain articles, this function can
-take ARTICLES, and FORCE parameters as well.
-
-The articles on which the expiration process runs are selected as follows:
- if ARTICLES is null, all read and unmarked articles.
- if ARTICLES is t, all articles.
- if ARTICLES is a list, just those articles.
-FORCE is equivalent to setting the expiration predicates to true."
- (interactive
- (list (let ((def (or (gnus-group-group-name)
- gnus-newsgroup-name)))
- (let ((select (read-string (if def
- (concat "Group Name ("
- def "): ")
- "Group Name: "))))
- (if (and (equal "" select)
- def)
- def
- select)))))
-
- (if (not group)
- (gnus-agent-expire articles group force)
- (let ( ;; Bind gnus-agent-expire-stats to enable tracking of
- ;; expiration statistics of this single group
- (gnus-agent-expire-stats (list 0 0 0.0)))
- (if (or (not (eq articles t))
- (yes-or-no-p
- (concat "Are you sure that you want to "
- "expire all articles in " group "? ")))
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (overview (gnus-get-buffer-create " *expire overview*"))
- orig)
- (unwind-protect
- (let ((active-file (gnus-agent-lib-file "active")))
- (when (file-exists-p active-file)
- (with-temp-buffer
- (nnheader-insert-file-contents active-file)
- (gnus-active-to-gnus-format
- gnus-command-method
- (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
- (save-excursion
- (gnus-agent-expire-group-1
- group overview (gnus-gethash-safe group orig)
- articles force))))
- (kill-buffer overview))))
- (gnus-message 4 (gnus-agent-expire-done-message)))))
-
-(defun gnus-agent-expire-group-1 (group overview active articles force)
- ;; Internal function - requires caller to have set
- ;; gnus-command-method, initialized overview buffer, and to have
- ;; provided a non-nil active
-
- (let ((dir (gnus-agent-group-pathname group)))
- (when (boundp 'gnus-agent-expire-current-dirs)
- (set 'gnus-agent-expire-current-dirs
- (cons dir
- (symbol-value 'gnus-agent-expire-current-dirs))))
-
- (if (and (not force)
- (eq 'DISABLE (gnus-agent-find-parameter group
- 'agent-enable-expiration)))
- (gnus-message 5 "Expiry skipping over %s" group)
- (gnus-message 5 "Expiring articles in %s" group)
- (gnus-agent-load-alist group)
- (let* ((bytes-freed 0)
- (files-deleted 0)
- (nov-entries-deleted 0)
- (info (gnus-get-info group))
- (alist gnus-agent-article-alist)
- (day (- (time-to-days (current-time))
- (gnus-agent-find-parameter group 'agent-days-until-old)))
- (specials (if (and alist
- (not force))
- ;; This could be a bit of a problem. I need to
- ;; keep the last article to avoid refetching
- ;; headers when using nntp in the backend. At
- ;; the same time, if someone uses a backend
- ;; that supports article moving then I may have
- ;; to remove the last article to complete the
- ;; move. Right now, I'm going to assume that
- ;; FORCE overrides specials.
- (list (caar (last alist)))))
- (unreads ;; Articles that are excluded from the
- ;; expiration process
- (cond (gnus-agent-expire-all
- ;; All articles are marked read by global decree
- nil)
- ((eq articles t)
- ;; All articles are marked read by function
- ;; parameter
- nil)
- ((not articles)
- ;; Unread articles are marked protected from
- ;; expiration Don't call
- ;; gnus-list-of-unread-articles as it returns
- ;; articles that have not been fetched into the
- ;; agent.
- (ignore-errors
- (gnus-agent-unread-articles group)))
- (t
- ;; All articles EXCEPT those named by the caller
- ;; are protected from expiration
- (gnus-sorted-difference
- (gnus-uncompress-range
- (cons (caar alist)
- (caar (last alist))))
- (sort articles '<)))))
- (marked ;; More articles that are excluded from the
- ;; expiration process
- (cond (gnus-agent-expire-all
- ;; All articles are unmarked by global decree
- nil)
- ((eq articles t)
- ;; All articles are unmarked by function
- ;; parameter
- nil)
- (articles
- ;; All articles may as well be unmarked as the
- ;; unreads list already names the articles we are
- ;; going to keep
- nil)
- (t
- ;; Ticked and/or dormant articles are excluded
- ;; from expiration
- (nconc
- (gnus-uncompress-range
- (cdr (assq 'tick (gnus-info-marks info))))
- (gnus-uncompress-range
- (cdr (assq 'dormant
- (gnus-info-marks info))))))))
- (nov-file (concat dir ".overview"))
- (cnt 0)
- (completed -1)
- dlist
- type)
-
- ;; The normal article alist contains elements that look like
- ;; (article# . fetch_date) I need to combine other
- ;; information with this list. For example, a flag indicating
- ;; that a particular article MUST BE KEPT. To do this, I'm
- ;; going to transform the elements to look like (article#
- ;; fetch_date keep_flag NOV_entry_marker) Later, I'll reverse
- ;; the process to generate the expired article alist.
-
- ;; Convert the alist elements to (article# fetch_date nil
- ;; nil).
- (setq dlist (mapcar (lambda (e)
- (list (car e) (cdr e) nil nil)) alist))
-
- ;; Convert the keep lists to elements that look like (article#
- ;; nil keep_flag nil) then append it to the expanded dlist
- ;; These statements are sorted by ascending precidence of the
- ;; keep_flag.
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'unread nil))
- unreads)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'marked nil))
- marked)))
- (setq dlist (nconc dlist
- (mapcar (lambda (e)
- (list e nil 'special nil))
- specials)))
-
- (set-buffer overview)
- (erase-buffer)
- (buffer-disable-undo)
- (when (file-exists-p nov-file)
- (gnus-message 7 "gnus-agent-expire: Loading overview...")
- (nnheader-insert-file-contents nov-file)
- (goto-char (point-min))
-
- (let (p)
- (while (< (setq p (point)) (point-max))
- (condition-case nil
- ;; If I successfully read an integer (the plus zero
- ;; ensures a numeric type), prepend a marker entry
- ;; to the list
- (push (list (+ 0 (read (current-buffer))) nil nil
- (set-marker (make-marker) p))
- dlist)
- (error
- (gnus-message 1 "gnus-agent-expire: read error \
-occurred when reading expression at %s in %s. Skipping to next \
-line." (point) nov-file)))
- ;; Whether I succeeded, or failed, it doesn't matter.
- ;; Move to the next line then try again.
- (forward-line 1)))
-
- (gnus-message
- 7 "gnus-agent-expire: Loading overview... Done"))
- (set-buffer-modified-p nil)
-
- ;; At this point, all of the information is in dlist. The
- ;; only problem is that much of it is spread across multiple
- ;; entries. Sort then MERGE!!
- (gnus-message 7 "gnus-agent-expire: Sorting entries... ")
- ;; If two entries have the same article-number then sort by
- ;; ascending keep_flag.
- (let ((special 0)
- (marked 1)
- (unread 2))
- (setq dlist
- (sort dlist
- (lambda (a b)
- (cond ((< (nth 0 a) (nth 0 b))
- t)
- ((> (nth 0 a) (nth 0 b))
- nil)
- (t
- (let ((a (or (symbol-value (nth 2 a))
- 3))
- (b (or (symbol-value (nth 2 b))
- 3)))
- (<= a b))))))))
- (gnus-message 7 "gnus-agent-expire: Sorting entries... Done")
- (gnus-message 7 "gnus-agent-expire: Merging entries... ")
- (let ((dlist dlist))
- (while (cdr dlist) ; I'm not at the end-of-list
- (if (eq (caar dlist) (caadr dlist))
- (let ((first (cdr (car dlist)))
- (secnd (cdr (cadr dlist))))
- (setcar first (or (car first)
- (car secnd))) ; fetch_date
- (setq first (cdr first)
- secnd (cdr secnd))
- (setcar first (or (car first)
- (car secnd))) ; Keep_flag
- (setq first (cdr first)
- secnd (cdr secnd))
- (setcar first (or (car first)
- (car secnd))) ; NOV_entry_marker
-
- (setcdr dlist (cddr dlist)))
- (setq dlist (cdr dlist)))))
- (gnus-message 7 "gnus-agent-expire: Merging entries... Done")
-
- (let* ((len (float (length dlist)))
- (alist (list nil))
- (tail-alist alist))
- (while dlist
- (let ((new-completed (truncate (* 100.0
- (/ (setq cnt (1+ cnt))
- len))))
- message-log-max)
- (when (> new-completed completed)
- (setq completed new-completed)
- (gnus-message 7 "%3d%% completed..." completed)))
- (let* ((entry (car dlist))
- (article-number (nth 0 entry))
- (fetch-date (nth 1 entry))
- (keep (nth 2 entry))
- (marker (nth 3 entry)))
-
- (cond
- ;; Kept articles are unread, marked, or special.
- (keep
- (gnus-agent-message 10
- "gnus-agent-expire: %s:%d: Kept %s article%s."
- group article-number keep (if fetch-date " and file" ""))
- (when fetch-date
- (unless (file-exists-p
- (concat dir (number-to-string
- article-number)))
- (setf (nth 1 entry) nil)
- (gnus-agent-message 3 "gnus-agent-expire cleared \
-download flag on %s:%d as the cached article file is missing."
- group (caar dlist)))
- (unless marker
- (gnus-message 1 "gnus-agent-expire detected a \
-missing NOV entry. Run gnus-agent-regenerate-group to restore it.")))
- (gnus-agent-append-to-list
- tail-alist
- (cons article-number fetch-date)))
-
- ;; The following articles are READ, UNMARKED, and
- ;; ORDINARY. See if they can be EXPIRED!!!
- ((setq type
- (cond
- ((not (integerp fetch-date))
- 'read) ;; never fetched article (may expire
- ;; right now)
- ((not (file-exists-p
- (concat dir (number-to-string
- article-number))))
- (setf (nth 1 entry) nil)
- 'externally-expired) ;; Can't find the cached
- ;; article. Handle case
- ;; as though this article
- ;; was never fetched.
-
- ;; We now have the arrival day, so we see
- ;; whether it's old enough to be expired.
- ((< fetch-date day)
- 'expired)
- (force
- 'forced)))
-
- ;; I found some reason to expire this entry.
-
- (let ((actions nil))
- (when (memq type '(forced expired))
- (ignore-errors ; Just being paranoid.
- (let* ((file-name (nnheader-concat dir (number-to-string
- article-number)))
- (size (float (nth 7 (file-attributes file-name)))))
- (incf bytes-freed size)
- (incf files-deleted)
- (delete-file file-name))
- (push "expired cached article" actions))
- (setf (nth 1 entry) nil)
- )
-
- (when marker
- (push "NOV entry removed" actions)
- (goto-char marker)
-
- (incf nov-entries-deleted)
-
- (let ((from (gnus-point-at-bol))
- (to (progn (forward-line 1) (point))))
- (incf bytes-freed (- to from))
- (delete-region from to)))
-
- ;; If considering all articles is set, I can only
- ;; expire article IDs that are no longer in the
- ;; active range (That is, articles that preceed the
- ;; first article in the new alist).
- (if (and gnus-agent-consider-all-articles
- (>= article-number (car active)))
- ;; I have to keep this ID in the alist
- (gnus-agent-append-to-list
- tail-alist (cons article-number fetch-date))
- (push (format "Removed %s article number from \
-article alist" type) actions))
-
- (when actions
- (gnus-agent-message 8 "gnus-agent-expire: %s:%d: %s"
- group article-number
- (mapconcat 'identity actions ", ")))))
- (t
- (gnus-agent-message
- 10 "gnus-agent-expire: %s:%d: Article kept as \
-expiration tests failed." group article-number)
- (gnus-agent-append-to-list
- tail-alist (cons article-number fetch-date)))
- )
-
- ;; Clean up markers as I want to recycle this buffer
- ;; over several groups.
- (when marker
- (set-marker marker nil))
-
- (setq dlist (cdr dlist))))
-
- (setq alist (cdr alist))
-
- (let ((inhibit-quit t))
- (unless (equal alist gnus-agent-article-alist)
- (setq gnus-agent-article-alist alist)
- (gnus-agent-save-alist group))
-
- (when (buffer-modified-p)
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (gnus-make-directory dir)
- (write-region (point-min) (point-max) nov-file nil
- 'silent)
- ;; clear the modified flag as that I'm not confused by
- ;; its status on the next pass through this routine.
- (set-buffer-modified-p nil)))
-
- (when (eq articles t)
- (gnus-summary-update-info))))
-
- (when (boundp 'gnus-agent-expire-stats)
- (let ((stats (symbol-value 'gnus-agent-expire-stats)))
- (incf (nth 2 stats) bytes-freed)
- (incf (nth 1 stats) files-deleted)
- (incf (nth 0 stats) nov-entries-deleted)))
- ))))
-
-(defun gnus-agent-expire (&optional articles group force)
- "Expire all old articles.
-If you want to force expiring of certain articles, this function can
-take ARTICLES, GROUP and FORCE parameters as well.
-
-The articles on which the expiration process runs are selected as follows:
- if ARTICLES is null, all read and unmarked articles.
- if ARTICLES is t, all articles.
- if ARTICLES is a list, just those articles.
-Setting GROUP will limit expiration to that group.
-FORCE is equivalent to setting the expiration predicates to true."
- (interactive)
-
- (if group
- (gnus-agent-expire-group group articles force)
- (if (or (not (eq articles t))
- (yes-or-no-p "Are you sure that you want to expire all \
-articles in every agentized group? "))
- (let ((methods (gnus-agent-covered-methods))
- ;; Bind gnus-agent-expire-current-dirs to enable tracking
- ;; of agent directories.
- (gnus-agent-expire-current-dirs nil)
- ;; Bind gnus-agent-expire-stats to enable tracking of
- ;; expiration statistics across all groups
- (gnus-agent-expire-stats (list 0 0 0.0))
- gnus-command-method overview orig)
- (setq overview (gnus-get-buffer-create " *expire overview*"))
- (unwind-protect
- (while (setq gnus-command-method (pop methods))
- (let ((active-file (gnus-agent-lib-file "active")))
- (when (file-exists-p active-file)
- (with-temp-buffer
- (nnheader-insert-file-contents active-file)
- (gnus-active-to-gnus-format
- gnus-command-method
- (setq orig (gnus-make-hashtable
- (count-lines (point-min) (point-max))))))
- (dolist (expiring-group (gnus-groups-from-server
- gnus-command-method))
- (let* ((active
- (gnus-gethash-safe expiring-group orig)))
-
- (when active
- (save-excursion
- (gnus-agent-expire-group-1
- expiring-group overview active articles force))))))))
- (kill-buffer overview))
- (gnus-agent-expire-unagentized-dirs)
- (gnus-message 4 (gnus-agent-expire-done-message))))))
-
-(defun gnus-agent-expire-done-message ()
- (if (and (> gnus-verbose 4)
- (boundp 'gnus-agent-expire-stats))
- (let* ((stats (symbol-value 'gnus-agent-expire-stats))
- (size (nth 2 stats))
- (units '(B KB MB GB)))
- (while (and (> size 1024.0)
- (cdr units))
- (setq size (/ size 1024.0)
- units (cdr units)))
-
- (format "Expiry recovered %d NOV entries, deleted %d files,\
- and freed %f %s."
- (nth 0 stats)
- (nth 1 stats)
- size (car units)))
- "Expiry...done"))
-
-(defun gnus-agent-expire-unagentized-dirs ()
- (when (and gnus-agent-expire-unagentized-dirs
- (boundp 'gnus-agent-expire-current-dirs))
- (let* ((keep (gnus-make-hashtable))
- ;; Formally bind gnus-agent-expire-current-dirs so that the
- ;; compiler will not complain about free references.
- (gnus-agent-expire-current-dirs
- (symbol-value 'gnus-agent-expire-current-dirs))
- dir)
-
- (gnus-sethash gnus-agent-directory t keep)
- (while gnus-agent-expire-current-dirs
- (setq dir (pop gnus-agent-expire-current-dirs))
- (when (and (stringp dir)
- (file-directory-p dir))
- (while (not (gnus-gethash dir keep))
- (gnus-sethash dir t keep)
- (setq dir (file-name-directory (directory-file-name dir))))))
-
- (let* (to-remove
- checker
- (checker
- (function
- (lambda (d)
- "Given a directory, check it and its subdirectories for
- membership in the keep hash. If it isn't found, add
- it to to-remove."
- (let ((files (directory-files d))
- file)
- (while (setq file (pop files))
- (cond ((equal file ".") ; Ignore self
- nil)
- ((equal file "..") ; Ignore parent
- nil)
- ((equal file ".overview")
- ;; Directory must contain .overview to be
- ;; agent's cache of a group.
- (let ((d (file-name-as-directory d))
- r)
- ;; Search ancestor's for last directory NOT
- ;; found in keep hash.
- (while (not (gnus-gethash
- (setq d (file-name-directory d)) keep))
- (setq r d
- d (directory-file-name d)))
- ;; if ANY ancestor was NOT in keep hash and
- ;; it it's already in to-remove, add it to
- ;; to-remove.
- (if (and r
- (not (member r to-remove)))
- (push r to-remove))))
- ((file-directory-p (setq file (nnheader-concat d file)))
- (funcall checker file)))))))))
- (funcall checker (expand-file-name gnus-agent-directory))
-
- (when (and to-remove
- (or gnus-expert-user
- (gnus-y-or-n-p
- "gnus-agent-expire has identified local directories that are\
- not currently required by any agentized group. Do you wish to consider\
- deleting them?")))
- (while to-remove
- (let ((dir (pop to-remove)))
- (if (gnus-y-or-n-p (format "Delete %s? " dir))
- (let* (delete-recursive
- (delete-recursive
- (function
- (lambda (f-or-d)
- (ignore-errors
- (if (file-directory-p f-or-d)
- (condition-case nil
- (delete-directory f-or-d)
- (file-error
- (mapcar (lambda (f)
- (or (member f '("." ".."))
- (funcall delete-recursive
- (nnheader-concat
- f-or-d f))))
- (directory-files f-or-d))
- (delete-directory f-or-d)))
- (delete-file f-or-d)))))))
- (funcall delete-recursive dir))))))))))
-
-;;;###autoload
-(defun gnus-agent-batch ()
- "Start Gnus, send queue and fetch session."
- (interactive)
- (let ((init-file-user "")
- (gnus-always-read-dribble-file t))
- (gnus))
- (let ((gnus-agent-confirmation-function 'gnus-agent-batch-confirmation))
- (gnus-group-send-queue)
- (gnus-agent-fetch-session)))
-
-(defun gnus-agent-unread-articles (group)
- (let* ((read (gnus-info-read (gnus-get-info group)))
- (known (gnus-agent-load-alist group))
- (unread (list nil))
- (tail-unread unread))
- (while (and known read)
- (let ((candidate (car (pop known))))
- (while (let* ((range (car read))
- (min (if (numberp range) range (car range)))
- (max (if (numberp range) range (cdr range))))
- (cond ((or (not min)
- (< candidate min))
- (gnus-agent-append-to-list tail-unread candidate)
- nil)
- ((> candidate max)
- (setq read (cdr read))
- ;; return t so that I always loop one more
- ;; time. If I just iterated off the end of
- ;; read, min will become nil and the current
- ;; candidate will be added to the unread list.
- t))))))
- (while known
- (gnus-agent-append-to-list tail-unread (car (pop known))))
- (cdr unread)))
-
-(defun gnus-agent-uncached-articles (articles group &optional cached-header)
- "Restrict ARTICLES to numbers already fetched.
-Returns a sublist of ARTICLES that excludes those article ids in GROUP
-that have already been fetched.
-If CACHED-HEADER is nil, articles are only excluded if the article itself
-has been fetched."
-
- ;; Logically equivalent to: (gnus-sorted-difference articles (mapcar
- ;; 'car gnus-agent-article-alist))
-
- ;; Functionally, I don't need to construct a temp list using mapcar.
-
- (if (and (or gnus-agent-cache (not gnus-plugged))
- (gnus-agent-load-alist group))
- (let* ((ref gnus-agent-article-alist)
- (arts articles)
- (uncached (list nil))
- (tail-uncached uncached))
- (while (and ref arts)
- (let ((v1 (car arts))
- (v2 (caar ref)))
- (cond ((< v1 v2) ; v1 does not appear in the reference list
- (gnus-agent-append-to-list tail-uncached v1)
- (setq arts (cdr arts)))
- ((= v1 v2)
- (unless (or cached-header (cdar ref)) ; v1 is already cached
- (gnus-agent-append-to-list tail-uncached v1))
- (setq arts (cdr arts))
- (setq ref (cdr ref)))
- (t ; reference article (v2) preceeds the list being filtered
- (setq ref (cdr ref))))))
- (while arts
- (gnus-agent-append-to-list tail-uncached (pop arts)))
- (cdr uncached))
- ;; if gnus-agent-load-alist fails, no articles are cached.
- articles))
-
-(defun gnus-agent-retrieve-headers (articles group &optional fetch-old)
- (save-excursion
- (gnus-agent-create-buffer)
- (let ((gnus-decode-encoded-word-function 'identity)
- (gnus-decode-encoded-address-function 'identity)
- (file (gnus-agent-article-name ".overview" group))
- cached-articles uncached-articles)
- (gnus-make-directory (nnheader-translate-file-chars
- (file-name-directory file) t))
-
- ;; Populate temp buffer with known headers
- (when (file-exists-p file)
- (with-current-buffer gnus-agent-overview-buffer
- (erase-buffer)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-nov-file file (car articles)))))
-
- (if (setq uncached-articles (gnus-agent-uncached-articles articles group
- t))
- (progn
- ;; Populate nntp-server-buffer with uncached headers
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (cond ((not (eq 'nov (let (gnus-agent) ; Turn off agent
- (gnus-retrieve-headers
- uncached-articles group fetch-old))))
- (nnvirtual-convert-headers))
- ((eq 'nntp (car gnus-current-select-method))
- ;; The author of gnus-get-newsgroup-headers-xover
- ;; reports that the XOVER command is commonly
- ;; unreliable. The problem is that recently
- ;; posted articles may not be entered into the
- ;; NOV database in time to respond to my XOVER
- ;; query.
- ;;
- ;; I'm going to use his assumption that the NOV
- ;; database is updated in order of ascending
- ;; article ID. Therefore, a response containing
- ;; article ID N implies that all articles from 1
- ;; to N-1 are up-to-date. Therefore, missing
- ;; articles in that range have expired.
-
- (set-buffer nntp-server-buffer)
- (let* ((fetched-articles (list nil))
- (tail-fetched-articles fetched-articles)
- (min (cond ((numberp fetch-old)
- (max 1 (- (car articles) fetch-old)))
- (fetch-old
- 1)
- (t
- (car articles))))
- (max (car (last articles))))
-
- ;; Get the list of articles that were fetched
- (goto-char (point-min))
- (let ((pm (point-max))
- art)
- (while (< (point) pm)
- (when (setq art (gnus-agent-read-article-number))
- (gnus-agent-append-to-list tail-fetched-articles art))
- (forward-line 1)))
-
- ;; Clip this list to the headers that will
- ;; actually be returned
- (setq fetched-articles (gnus-list-range-intersection
- (cdr fetched-articles)
- (cons min max)))
-
- ;; Clip the uncached articles list to exclude
- ;; IDs after the last FETCHED header. The
- ;; excluded IDs may be fetchable using HEAD.
- (if (car tail-fetched-articles)
- (setq uncached-articles
- (gnus-list-range-intersection
- uncached-articles
- (cons (car uncached-articles)
- (car tail-fetched-articles)))))
-
- ;; Create the list of articles that were
- ;; "successfully" fetched. Success, in this
- ;; case, means that the ID should not be
- ;; fetched again. In the case of an expired
- ;; article, the header will not be fetched.
- (setq uncached-articles
- (gnus-sorted-nunion fetched-articles
- uncached-articles))
- )))
-
- ;; Erase the temp buffer
- (set-buffer gnus-agent-overview-buffer)
- (erase-buffer)
-
- ;; Copy the nntp-server-buffer to the temp buffer
- (set-buffer nntp-server-buffer)
- (copy-to-buffer gnus-agent-overview-buffer (point-min) (point-max))
-
- ;; Merge the temp buffer with the known headers (found on
- ;; disk in FILE) into the nntp-server-buffer
- (when uncached-articles
- (gnus-agent-braid-nov group uncached-articles file))
-
- ;; Save the new set of known headers to FILE
- (set-buffer nntp-server-buffer)
- (let ((coding-system-for-write
- gnus-agent-file-coding-system))
- (gnus-agent-check-overview-buffer)
- (write-region (point-min) (point-max) file nil 'silent))
-
- ;; Update the group's article alist to include the newly
- ;; fetched articles.
- (gnus-agent-load-alist group)
- (gnus-agent-save-alist group uncached-articles nil)
- )
-
- ;; Copy the temp buffer to the nntp-server-buffer
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring gnus-agent-overview-buffer)))
-
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- t)
-
- 'nov))
-
-(defun gnus-agent-request-article (article group)
- "Retrieve ARTICLE in GROUP from the agent cache."
- (when (and gnus-agent
- (or gnus-agent-cache
- (not gnus-plugged))
- (numberp article))
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (file (gnus-agent-article-name (number-to-string article) group))
- (buffer-read-only nil))
- (when (and (file-exists-p file)
- (> (nth 7 (file-attributes file)) 0))
- (erase-buffer)
- (gnus-kill-all-overlays)
- (let ((coding-system-for-read gnus-cache-coding-system))
- (insert-file-contents file))
- t))))
-
-(defun gnus-agent-regenerate-group (group &optional reread)
- "Regenerate GROUP.
-If REREAD is t, all articles in the .overview are marked as unread.
-If REREAD is a list, the specified articles will be marked as unread.
-In addition, their NOV entries in .overview will be refreshed using
-the articles' current headers.
-If REREAD is not nil, downloaded articles are marked as unread."
- (interactive
- (list (let ((def (or (gnus-group-group-name)
- gnus-newsgroup-name)))
- (let ((select (read-string (if def
- (concat "Group Name ("
- def "): ")
- "Group Name: "))))
- (if (and (equal "" select)
- def)
- def
- select)))
- (catch 'mark
- (while (let (c
- (cursor-in-echo-area t)
- (echo-keystrokes 0))
- (message "Mark as unread: (n)one / (a)ll / all (d)ownloaded articles? (n) ")
- (setq c (read-char-exclusive))
-
- (cond ((or (eq c ?\r) (eq c ?n) (eq c ?N))
- (throw 'mark nil))
- ((or (eq c ?a) (eq c ?A))
- (throw 'mark t))
- ((or (eq c ?d) (eq c ?D))
- (throw 'mark 'some)))
- (gnus-message 3 "Ignoring unexpected input")
- (sit-for 1)
- t)))))
- (when group
- (gnus-message 5 "Regenerating in %s" group)
- (let* ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group)))
- (file (gnus-agent-article-name ".overview" group))
- (dir (file-name-directory file))
- point
- (downloaded (if (file-exists-p dir)
- (sort (delq nil (mapcar (lambda (name)
- (and (not (file-directory-p (nnheader-concat dir name)))
- (string-to-number name)))
- (directory-files dir nil "^[0-9]+$" t)))
- '>)
- (progn (gnus-make-directory dir) nil)))
- dl nov-arts
- alist header
- regenerated)
-
- (mm-with-unibyte-buffer
- (if (file-exists-p file)
- (let ((nnheader-file-coding-system
- gnus-agent-file-coding-system))
- (nnheader-insert-file-contents file)))
- (set-buffer-modified-p nil)
-
- ;; Load the article IDs found in the overview file. As a
- ;; side-effect, validate the file contents.
- (let ((load t))
- (while load
- (setq load nil)
- (goto-char (point-min))
- (while (< (point) (point-max))
- (cond ((and (looking-at "[0-9]+\t")
- (<= (- (match-end 0) (match-beginning 0)) 9))
- (push (read (current-buffer)) nov-arts)
- (forward-line 1)
- (let ((l1 (car nov-arts))
- (l2 (cadr nov-arts)))
- (cond ((and (listp reread) (memq l1 reread))
- (gnus-delete-line)
- (setq nov-arts (cdr nov-arts))
- (gnus-message 4 "gnus-agent-regenerate-group: NOV\
- entry of article %s deleted." l1))
- ((not l2)
- nil)
- ((< l1 l2)
- (gnus-message 3 "gnus-agent-regenerate-group: NOV\
- entries are NOT in ascending order.")
- ;; Don't sort now as I haven't verified
- ;; that every line begins with a number
- (setq load t))
- ((= l1 l2)
- (forward-line -1)
- (gnus-message 4 "gnus-agent-regenerate-group: NOV\
- entries contained duplicate of article %s. Duplicate deleted." l1)
- (gnus-delete-line)
- (setq nov-arts (cdr nov-arts))))))
- (t
- (gnus-message 1 "gnus-agent-regenerate-group: NOV\
- entries contained line that did not begin with an article number. Deleted\
- line.")
- (gnus-delete-line))))
- (when load
- (gnus-message 5 "gnus-agent-regenerate-group: Sorting NOV\
- entries into ascending order.")
- (sort-numeric-fields 1 (point-min) (point-max))
- (setq nov-arts nil))))
- (gnus-agent-check-overview-buffer)
-
- ;; Construct a new article alist whose nodes match every header
- ;; in the .overview file. As a side-effect, missing headers are
- ;; reconstructed from the downloaded article file.
- (while (or downloaded nov-arts)
- (cond ((and downloaded
- (or (not nov-arts)
- (> (car downloaded) (car nov-arts))))
- ;; This entry is missing from the overview file
- (gnus-message 3 "Regenerating NOV %s %d..." group
- (car downloaded))
- (let ((file (concat dir (number-to-string (car downloaded)))))
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (nnheader-remove-body)
- (setq header (nnheader-parse-naked-head)))
- (mail-header-set-number header (car downloaded))
- (if nov-arts
- (let ((key (concat "^" (int-to-string (car nov-arts))
- "\t")))
- (or (re-search-backward key nil t)
- (re-search-forward key))
- (forward-line 1))
- (goto-char (point-min)))
- (nnheader-insert-nov header))
- (setq nov-arts (cons (car downloaded) nov-arts)))
- ((eq (car downloaded) (car nov-arts))
- ;; This entry in the overview has been downloaded
- (push (cons (car downloaded)
- (time-to-days
- (nth 5 (file-attributes
- (concat dir (number-to-string
- (car downloaded))))))) alist)
- (setq downloaded (cdr downloaded))
- (setq nov-arts (cdr nov-arts)))
- (t
- ;; This entry in the overview has not been downloaded
- (push (cons (car nov-arts) nil) alist)
- (setq nov-arts (cdr nov-arts)))))
-
- ;; When gnus-agent-consider-all-articles is set,
- ;; gnus-agent-regenerate-group should NOT remove article IDs from
- ;; the alist. Those IDs serve as markers to indicate that an
- ;; attempt has been made to fetch that article's header.
-
- ;; When gnus-agent-consider-all-articles is NOT set,
- ;; gnus-agent-regenerate-group can remove the article ID of every
- ;; article (with the exception of the last ID in the list - it's
- ;; special) that no longer appears in the overview. In this
- ;; situtation, the last article ID in the list implies that it,
- ;; and every article ID preceeding it, have been fetched from the
- ;; server.
-
- (if gnus-agent-consider-all-articles
- ;; Restore all article IDs that were not found in the overview file.
- (let* ((n (cons nil alist))
- (merged n)
- (o (gnus-agent-load-alist group)))
- (while o
- (let ((nID (caadr n))
- (oID (caar o)))
- (cond ((not nID)
- (setq n (setcdr n (list (list oID))))
- (setq o (cdr o)))
- ((< oID nID)
- (setcdr n (cons (list oID) (cdr n)))
- (setq o (cdr o)))
- ((= oID nID)
- (setq o (cdr o))
- (setq n (cdr n)))
- (t
- (setq n (cdr n))))))
- (setq alist (cdr merged)))
- ;; Restore the last article ID if it is not already in the new alist
- (let ((n (last alist))
- (o (last (gnus-agent-load-alist group))))
- (cond ((not o)
- nil)
- ((not n)
- (push (cons (caar o) nil) alist))
- ((< (caar n) (caar o))
- (setcdr n (list (car o)))))))
-
- (let ((inhibit-quit t))
- (if (setq regenerated (buffer-modified-p))
- (let ((coding-system-for-write gnus-agent-file-coding-system))
- (write-region (point-min) (point-max) file nil 'silent)))
-
- (setq regenerated (or regenerated
- (and reread gnus-agent-article-alist)
- (not (equal alist gnus-agent-article-alist))))
-
- (setq gnus-agent-article-alist alist)
-
- (when regenerated
- (gnus-agent-save-alist group)
-
- ;; I have to alter the group's active range NOW as
- ;; gnus-make-ascending-articles-unread will use it to
- ;; recalculate the number of unread articles in the group
-
- (let ((group (gnus-group-real-name group))
- (group-active (or (gnus-active group)
- (gnus-activate-group group))))
- (gnus-agent-possibly-alter-active group group-active)))))
-
- (when (and reread gnus-agent-article-alist)
- (gnus-agent-synchronize-group-flags
- group
- (list (list
- (if (listp reread)
- reread
- (delq nil (mapcar (function (lambda (c)
- (cond ((eq reread t)
- (car c))
- ((cdr c)
- (car c)))))
- gnus-agent-article-alist)))
- 'del '(read)))
- gnus-command-method)
-
- (when (gnus-buffer-live-p gnus-group-buffer)
- (gnus-group-update-group group t)))
-
- (gnus-message 5 "")
- regenerated)))
-
-;;;###autoload
-(defun gnus-agent-regenerate (&optional clean reread)
- "Regenerate all agent covered files.
-If CLEAN, obsolete (ignore)."
- (interactive "P")
- (let (regenerated)
- (gnus-message 4 "Regenerating Gnus agent files...")
- (dolist (gnus-command-method (gnus-agent-covered-methods))
- (dolist (group (gnus-groups-from-server gnus-command-method))
- (setq regenerated (or (gnus-agent-regenerate-group group reread)
- regenerated))))
- (gnus-message 4 "Regenerating Gnus agent files...done")
-
- regenerated))
-
-(defun gnus-agent-go-online (&optional force)
- "Switch servers into online status."
- (interactive (list t))
- (dolist (server gnus-opened-servers)
- (when (eq (nth 1 server) 'offline)
- (if (if (eq force 'ask)
- (gnus-y-or-n-p
- (format "Switch %s:%s into online status? "
- (caar server) (cadar server)))
- force)
- (setcar (nthcdr 1 server) 'close)))))
-
-(defun gnus-agent-toggle-group-plugged (group)
- "Toggle the status of the server of the current group."
- (interactive (list (gnus-group-group-name)))
- (let* ((method (gnus-find-method-for-group group))
- (status (cadr (assoc method gnus-opened-servers))))
- (if (eq status 'offline)
- (gnus-server-set-status method 'closed)
- (gnus-close-server method)
- (gnus-server-set-status method 'offline))
- (message "Turn %s:%s from %s to %s." (car method) (cadr method)
- (if (eq status 'offline) 'offline 'online)
- (if (eq status 'offline) 'online 'offline))))
-
-(defun gnus-agent-group-covered-p (group)
- (gnus-agent-method-p (gnus-group-method group)))
-
-(provide 'gnus-agent)
-
-;;; arch-tag: b0ba4afc-5229-4cee-ad25-9956daa4e91e
-;;; gnus-agent.el ends here
+++ /dev/null
-;;; gnus-art.el --- article mode commands for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (defvar tool-bar-map)
- (defvar w3m-minor-mode-map))
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'gnus-spec)
-(require 'gnus-int)
-(require 'gnus-win)
-(require 'mm-bodies)
-(require 'mail-parse)
-(require 'mm-decode)
-(require 'mm-view)
-(require 'wid-edit)
-(require 'mm-uu)
-(require 'message)
-
-(autoload 'gnus-msg-mail "gnus-msg" nil t)
-(autoload 'gnus-button-mailto "gnus-msg")
-(autoload 'gnus-button-reply "gnus-msg" nil t)
-(autoload 'parse-time-string "parse-time" nil nil)
-(autoload 'mm-extern-cache-contents "mm-extern")
-
-(defgroup gnus-article nil
- "Article display."
- :link '(custom-manual "(gnus)Article Buffer")
- :group 'gnus)
-
-(defgroup gnus-article-treat nil
- "Treating article parts."
- :link '(custom-manual "(gnus)Article Hiding")
- :group 'gnus-article)
-
-(defgroup gnus-article-hiding nil
- "Hiding article parts."
- :link '(custom-manual "(gnus)Article Hiding")
- :group 'gnus-article)
-
-(defgroup gnus-article-highlight nil
- "Article highlighting."
- :link '(custom-manual "(gnus)Article Highlighting")
- :group 'gnus-article
- :group 'gnus-visual)
-
-(defgroup gnus-article-signature nil
- "Article signatures."
- :link '(custom-manual "(gnus)Article Signature")
- :group 'gnus-article)
-
-(defgroup gnus-article-headers nil
- "Article headers."
- :link '(custom-manual "(gnus)Hiding Headers")
- :group 'gnus-article)
-
-(defgroup gnus-article-washing nil
- "Special commands on articles."
- :link '(custom-manual "(gnus)Article Washing")
- :group 'gnus-article)
-
-(defgroup gnus-article-emphasis nil
- "Fontisizing articles."
- :link '(custom-manual "(gnus)Article Fontisizing")
- :group 'gnus-article)
-
-(defgroup gnus-article-saving nil
- "Saving articles."
- :link '(custom-manual "(gnus)Saving Articles")
- :group 'gnus-article)
-
-(defgroup gnus-article-mime nil
- "Worshiping the MIME wonder."
- :link '(custom-manual "(gnus)Using MIME")
- :group 'gnus-article)
-
-(defgroup gnus-article-buttons nil
- "Pushable buttons in the article buffer."
- :link '(custom-manual "(gnus)Article Buttons")
- :group 'gnus-article)
-
-(defgroup gnus-article-various nil
- "Other article options."
- :link '(custom-manual "(gnus)Misc Article")
- :group 'gnus-article)
-
-(defcustom gnus-ignored-headers
- (mapcar
- (lambda (header)
- (concat "^" header ":"))
- '("Path" "Expires" "Date-Received" "References" "Xref" "Lines"
- "Relay-Version" "Message-ID" "Approved" "Sender" "Received"
- "X-UIDL" "MIME-Version" "Return-Path" "In-Reply-To"
- "Content-Type" "Content-Transfer-Encoding" "X-WebTV-Signature"
- "X-MimeOLE" "X-MSMail-Priority" "X-Priority" "X-Loop"
- "X-Authentication-Warning" "X-MIME-Autoconverted" "X-Face"
- "X-Attribution" "X-Originating-IP" "Delivered-To"
- "NNTP-[-A-Za-z]+" "Distribution" "X-no-archive" "X-Trace"
- "X-Complaints-To" "X-NNTP-Posting-Host" "X-Orig.*"
- "Abuse-Reports-To" "Cache-Post-Path" "X-Article-Creation-Date"
- "X-Poster" "X-Mail2News-Path" "X-Server-Date" "X-Cache"
- "Originator" "X-Problems-To" "X-Auth-User" "X-Post-Time"
- "X-Admin" "X-UID" "Resent-[-A-Za-z]+" "X-Mailing-List"
- "Precedence" "Original-[-A-Za-z]+" "X-filename" "X-Orcpt"
- "Old-Received" "X-Pgp" "X-Auth" "X-From-Line"
- "X-Gnus-Article-Number" "X-Majordomo" "X-Url" "X-Sender"
- "MBOX-Line" "Priority" "X400-[-A-Za-z]+"
- "Status" "X-Gnus-Mail-Source" "Cancel-Lock"
- "X-FTN" "X-EXP32-SerialNo" "Encoding" "Importance"
- "Autoforwarded" "Original-Encoded-Information-Types" "X-Ya-Pop3"
- "X-Face-Version" "X-Vms-To" "X-ML-NAME" "X-ML-COUNT"
- "Mailing-List" "X-finfo" "X-md5sum" "X-md5sum-Origin"
- "X-Sun-Charset" "X-Accept-Language" "X-Envelope-Sender"
- "List-[A-Za-z]+" "X-Listprocessor-Version"
- "X-Received" "X-Distribute" "X-Sequence" "X-Juno-Line-Breaks"
- "X-Notes-Item" "X-MS-TNEF-Correlator" "x-uunet-gateway"
- "X-Received" "Content-length" "X-precedence"
- "X-Authenticated-User" "X-Comment" "X-Report" "X-Abuse-Info"
- "X-HTTP-Proxy" "X-Mydeja-Info" "X-Copyright" "X-No-Markup"
- "X-Abuse-Info" "X-From_" "X-Accept-Language" "Errors-To"
- "X-BeenThere" "X-Mailman-Version" "List-Help" "List-Post"
- "List-Subscribe" "List-Id" "List-Unsubscribe" "List-Archive"
- "X-Content-length" "X-Posting-Agent" "Original-Received"
- "X-Request-PGP" "X-Fingerprint" "X-WRIEnvto" "X-WRIEnvfrom"
- "X-Virus-Scanned" "X-Delivery-Agent" "Posted-Date" "X-Gateway"
- "X-Local-Origin" "X-Local-Destination" "X-UserInfo1"
- "X-Received-Date" "X-Hashcash" "Face" "X-DMCA-Notifications"
- "X-Abuse-and-DMCA-Info" "X-Postfilter" "X-Gpg-.*" "X-Disclaimer"))
- "*All headers that start with this regexp will be hidden.
-This variable can also be a list of regexps of headers to be ignored.
-If `gnus-visible-headers' is non-nil, this variable will be ignored."
- :type '(choice :custom-show nil
- regexp
- (repeat regexp))
- :group 'gnus-article-hiding)
-
-(defcustom gnus-visible-headers
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^Followup-To:\\|^Reply-To:\\|^Organization:\\|^Summary:\\|^Keywords:\\|^To:\\|^[BGF]?Cc:\\|^Posted-To:\\|^Mail-Copies-To:\\|^Mail-Followup-To:\\|^Apparently-To:\\|^Gnus-Warning:\\|^Resent-From:\\|^X-Sent:"
- "*All headers that do not match this regexp will be hidden.
-This variable can also be a list of regexp of headers to remain visible.
-If this variable is non-nil, `gnus-ignored-headers' will be ignored."
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp)
- :group 'gnus-article-hiding)
-
-(defcustom gnus-sorted-header-list
- '("^From:" "^Subject:" "^Summary:" "^Keywords:" "^Newsgroups:"
- "^Followup-To:" "^To:" "^Cc:" "^Date:" "^Organization:")
- "*This variable is a list of regular expressions.
-If it is non-nil, headers that match the regular expressions will
-be placed first in the article buffer in the sequence specified by
-this list."
- :type '(repeat regexp)
- :group 'gnus-article-hiding)
-
-(defcustom gnus-boring-article-headers '(empty followup-to reply-to)
- "Headers that are only to be displayed if they have interesting data.
-Possible values in this list are:
-
- 'empty Headers with no content.
- 'newsgroups Newsgroup identical to Gnus group.
- 'to-address To identical to To-address.
- 'to-list To identical to To-list.
- 'cc-list CC identical to To-list.
- 'followup-to Followup-to identical to Newsgroups.
- 'reply-to Reply-to identical to From.
- 'date Date less than four days old.
- 'long-to To and/or Cc longer than 1024 characters.
- 'many-to Multiple To and/or Cc."
- :type '(set (const :tag "Headers with no content." empty)
- (const :tag "Newsgroups identical to Gnus group." newsgroups)
- (const :tag "To identical to To-address." to-address)
- (const :tag "To identical to To-list." to-list)
- (const :tag "CC identical to To-list." cc-list)
- (const :tag "Followup-to identical to Newsgroups." followup-to)
- (const :tag "Reply-to identical to From." reply-to)
- (const :tag "Date less than four days old." date)
- (const :tag "To and/or Cc longer than 1024 characters." long-to)
- (const :tag "Multiple To and/or Cc headers." many-to))
- :group 'gnus-article-hiding)
-
-(defcustom gnus-article-skip-boring nil
- "Skip over text that is not worth reading.
-By default, if you set this t, then Gnus will display citations and
-signatures, but will never scroll down to show you a page consisting
-only of boring text. Boring text is controlled by
-`gnus-article-boring-faces'."
- :version "22.1"
- :type 'boolean
- :group 'gnus-article-hiding)
-
-(defcustom gnus-signature-separator '("^-- $" "^-- *$")
- "Regexp matching signature separator.
-This can also be a list of regexps. In that case, it will be checked
-from head to tail looking for a separator. Searches will be done from
-the end of the buffer."
- :type '(choice :format "%{%t%}: %[Value Menu%]\n%v"
- (regexp)
- (repeat :tag "List of regexp" regexp))
- :group 'gnus-article-signature)
-
-(defcustom gnus-signature-limit nil
- "Provide a limit to what is considered a signature.
-If it is a number, no signature may not be longer (in characters) than
-that number. If it is a floating point number, no signature may be
-longer (in lines) than that number. If it is a function, the function
-will be called without any parameters, and if it returns nil, there is
-no signature in the buffer. If it is a string, it will be used as a
-regexp. If it matches, the text in question is not a signature."
- :type '(choice (const nil)
- (integer :value 200)
- (number :value 4.0)
- function
- (regexp :value ".*"))
- :group 'gnus-article-signature)
-
-(defcustom gnus-hidden-properties '(invisible t intangible t)
- "Property list to use for hiding text."
- :type 'sexp
- :group 'gnus-article-hiding)
-
-;; Fixme: This isn't the right thing for mixed graphical and non-graphical
-;; frames in a session.
-(defcustom gnus-article-x-face-command
- (if (featurep 'xemacs)
- (if (or (gnus-image-type-available-p 'xface)
- (gnus-image-type-available-p 'pbm))
- 'gnus-display-x-face-in-from
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | ee -")
- (if (gnus-image-type-available-p 'pbm)
- 'gnus-display-x-face-in-from
- "{ echo '/* Width=48, Height=48 */'; uncompface; } | icontopbm | \
-display -"))
- "*String or function to be executed to display an X-Face header.
-If it is a string, the command will be executed in a sub-shell
-asynchronously. The compressed face will be piped to this command."
- :type `(choice string
- (function-item gnus-display-x-face-in-from)
- function)
- :version "21.1"
- :group 'gnus-picon
- :group 'gnus-article-washing)
-
-(defcustom gnus-article-x-face-too-ugly nil
- "Regexp matching posters whose face shouldn't be shown automatically."
- :type '(choice regexp (const nil))
- :group 'gnus-article-washing)
-
-(defcustom gnus-article-banner-alist nil
- "Banner alist for stripping.
-For example,
- ((egroups . \"^[ \\t\\n]*-------------------+\\\\( \\\\(e\\\\|Yahoo! \\\\)Groups Sponsor -+\\\\)?....\\n\\\\(.+\\n\\\\)+\"))"
- :version "21.1"
- :type '(repeat (cons symbol regexp))
- :group 'gnus-article-washing)
-
-(gnus-define-group-parameter
- banner
- :variable-document
- "Alist of regexps (to match group names) and banner."
- :variable-group gnus-article-washing
- :parameter-type
- '(choice :tag "Banner"
- :value nil
- (const :tag "Remove signature" signature)
- (symbol :tag "Item in `gnus-article-banner-alist'" none)
- regexp
- (const :tag "None" nil))
- :parameter-document
- "If non-nil, specify how to remove `banners' from articles.
-
-Symbol `signature' means to remove signatures delimited by
-`gnus-signature-separator'. Any other symbol is used to look up a
-regular expression to match the banner in `gnus-article-banner-alist'.
-A string is used as a regular expression to match the banner
-directly.")
-
-(defcustom gnus-article-address-banner-alist nil
- "Alist of mail addresses and banners.
-Each element has the form (ADDRESS . BANNER), where ADDRESS is a regexp
-to match a mail address in the From: header, BANNER is one of a symbol
-`signature', an item in `gnus-article-banner-alist', a regexp and nil.
-If ADDRESS matches author's mail address, it will remove things like
-advertisements. For example:
-
-\((\"@yoo-hoo\\\\.co\\\\.jp\\\\'\" . \"\\n_+\\nDo You Yoo-hoo!\\\\?\\n.*\\n.*\\n\"))
-"
- :type '(repeat
- (cons
- (regexp :tag "Address")
- (choice :tag "Banner" :value nil
- (const :tag "Remove signature" signature)
- (symbol :tag "Item in `gnus-article-banner-alist'" none)
- regexp
- (const :tag "None" nil))))
- :version "22.1"
- :group 'gnus-article-washing)
-
-(defmacro gnus-emphasis-custom-with-format (&rest body)
- `(let ((format "\
-\\(\\s-\\|^\\|\\=\\|[-\"]\\|\\s(\\)\\(%s\\(\\w+\\(\\s-+\\w+\\)*[.,]?\\)%s\\)\
-\\(\\([-,.;:!?\"]\\|\\s)\\)+\\s-\\|[?!.]\\s-\\|\\s)\\|\\s-\\)"))
- ,@body))
-
-(defun gnus-emphasis-custom-value-to-external (value)
- (gnus-emphasis-custom-with-format
- (if (consp (car value))
- (list (format format (car (car value)) (cdr (car value)))
- 2
- (if (nth 1 value) 2 3)
- (nth 2 value))
- value)))
-
-(defun gnus-emphasis-custom-value-to-internal (value)
- (gnus-emphasis-custom-with-format
- (let ((regexp (concat "\\`"
- (format (regexp-quote format)
- "\\([^()]+\\)" "\\([^()]+\\)")
- "\\'"))
- pattern)
- (if (string-match regexp (setq pattern (car value)))
- (list (cons (match-string 1 pattern) (match-string 2 pattern))
- (= (nth 2 value) 2)
- (nth 3 value))
- value))))
-
-(defcustom gnus-emphasis-alist
- (let ((types
- '(("\\*" "\\*" bold nil 2)
- ("_" "_" underline)
- ("/" "/" italic)
- ("_/" "/_" underline-italic)
- ("_\\*" "\\*_" underline-bold)
- ("\\*/" "/\\*" bold-italic)
- ("_\\*/" "/\\*_" underline-bold-italic))))
- (nconc
- (gnus-emphasis-custom-with-format
- (mapcar (lambda (spec)
- (list (format format (car spec) (cadr spec))
- (or (nth 3 spec) 2)
- (or (nth 4 spec) 3)
- (intern (format "gnus-emphasis-%s" (nth 2 spec)))))
- types))
- '(;; I've never seen anyone use this strikethru convention whereas I've
- ;; several times seen it triggered by normal text. --Stef
- ;; Miles suggests that this form is sometimes used but for italics,
- ;; so maybe we should map it to `italic'.
- ;; ("\\(\\s-\\|^\\)\\(-\\(\\(\\w\\|-[^-]\\)+\\)-\\)\\(\\s-\\|[?!.,;]\\)"
- ;; 2 3 gnus-emphasis-strikethru)
- ("\\(\\s-\\|^\\)\\(_\\(\\(\\w\\|_[^_]\\)+\\)_\\)\\(\\s-\\|[?!.,;]\\)"
- 2 3 gnus-emphasis-underline))))
- "*Alist that says how to fontify certain phrases.
-Each item looks like this:
-
- (\"_\\\\(\\\\w+\\\\)_\" 0 1 'underline)
-
-The first element is a regular expression to be matched. The second
-is a number that says what regular expression grouping used to find
-the entire emphasized word. The third is a number that says what
-regexp grouping should be displayed and highlighted. The fourth
-is the face used for highlighting."
- :type
- '(repeat
- (menu-choice
- :format "%[Customizing Style%]\n%v"
- :indent 2
- (group :tag "Default"
- :value ("" 0 0 default)
- :value-create
- (lambda (widget)
- (let ((value (widget-get
- (cadr (widget-get (widget-get widget :parent)
- :args))
- :value)))
- (if (not (eq (nth 2 value) 'default))
- (widget-put
- widget
- :value
- (gnus-emphasis-custom-value-to-external value))))
- (widget-group-value-create widget))
- regexp
- (integer :format "Match group: %v")
- (integer :format "Emphasize group: %v")
- face)
- (group :tag "Simple"
- :value (("_" . "_") nil default)
- (cons :format "%v"
- (regexp :format "Start regexp: %v")
- (regexp :format "End regexp: %v"))
- (boolean :format "Show start and end patterns: %[%v%]\n"
- :on " On " :off " Off ")
- face)))
- :get (lambda (symbol)
- (mapcar 'gnus-emphasis-custom-value-to-internal
- (default-value symbol)))
- :set (lambda (symbol value)
- (set-default symbol (mapcar 'gnus-emphasis-custom-value-to-external
- value)))
- :group 'gnus-article-emphasis)
-
-(defcustom gnus-emphasize-whitespace-regexp "^[ \t]+\\|[ \t]*\n"
- "A regexp to describe whitespace which should not be emphasized.
-Typical values are \"^[ \\t]+\\\\|[ \\t]*\\n\" and \"[ \\t]+\\\\|[ \\t]*\\n\".
-The former avoids underlining of leading and trailing whitespace,
-and the latter avoids underlining any whitespace at all."
- :version "21.1"
- :group 'gnus-article-emphasis
- :type 'regexp)
-
-(defface gnus-emphasis-bold '((t (:bold t)))
- "Face used for displaying strong emphasized text (*word*)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-italic '((t (:italic t)))
- "Face used for displaying italic emphasized text (/word/)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-underline '((t (:underline t)))
- "Face used for displaying underlined emphasized text (_word_)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-underline-bold '((t (:bold t :underline t)))
- "Face used for displaying underlined bold emphasized text (_*word*_)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-underline-italic '((t (:italic t :underline t)))
- "Face used for displaying underlined italic emphasized text (_/word/_)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-bold-italic '((t (:bold t :italic t)))
- "Face used for displaying bold italic emphasized text (/*word*/)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-underline-bold-italic
- '((t (:bold t :italic t :underline t)))
- "Face used for displaying underlined bold italic emphasized text.
-Example: (_/*word*/_)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-strikethru (if (featurep 'xemacs)
- '((t (:strikethru t)))
- '((t (:strike-through t))))
- "Face used for displaying strike-through text (-word-)."
- :group 'gnus-article-emphasis)
-
-(defface gnus-emphasis-highlight-words
- '((t (:background "black" :foreground "yellow")))
- "Face used for displaying highlighted words."
- :group 'gnus-article-emphasis)
-
-(defcustom gnus-article-time-format "%a, %b %d %Y %T %Z"
- "Format for display of Date headers in article bodies.
-See `format-time-string' for the possible values.
-
-The variable can also be function, which should return a complete Date
-header. The function is called with one argument, the time, which can
-be fed to `format-time-string'."
- :type '(choice string symbol)
- :link '(custom-manual "(gnus)Article Date")
- :group 'gnus-article-washing)
-
-(defcustom gnus-save-all-headers t
- "*If non-nil, don't remove any headers before saving.
-This will be overridden by the `:headers' property that the symbol of
-the saver function, which is specified by `gnus-default-article-saver',
-might have."
- :group 'gnus-article-saving
- :type 'boolean)
-
-(defcustom gnus-prompt-before-saving 'always
- "*This variable says how much prompting is to be done when saving articles.
-If it is nil, no prompting will be done, and the articles will be
-saved to the default files. If this variable is `always', each and
-every article that is saved will be preceded by a prompt, even when
-saving large batches of articles. If this variable is neither nil not
-`always', there the user will be prompted once for a file name for
-each invocation of the saving commands."
- :group 'gnus-article-saving
- :type '(choice (item always)
- (item :tag "never" nil)
- (sexp :tag "once" :format "%t\n" :value t)))
-
-(defcustom gnus-saved-headers gnus-visible-headers
- "Headers to keep if `gnus-save-all-headers' is nil.
-If `gnus-save-all-headers' is non-nil, this variable will be ignored.
-If that variable is nil, however, all headers that match this regexp
-will be kept while the rest will be deleted before saving. This and
-`gnus-save-all-headers' will be overridden by the `:headers' property
-that the symbol of the saver function, which is specified by
-`gnus-default-article-saver', might have."
- :group 'gnus-article-saving
- :type 'regexp)
-
-(defcustom gnus-default-article-saver 'gnus-summary-save-in-rmail
- "A function to save articles in your favourite format.
-The function will be called by way of the `gnus-summary-save-article'
-command, and friends such as `gnus-summary-save-article-rmail'.
-
-Gnus provides the following functions:
-
-* gnus-summary-save-in-rmail (Rmail format)
-* gnus-summary-save-in-mail (Unix mail format)
-* gnus-summary-save-in-folder (MH folder)
-* gnus-summary-save-in-file (article format)
-* gnus-summary-save-body-in-file (article body)
-* gnus-summary-save-in-vm (use VM's folder format)
-* gnus-summary-write-to-file (article format -- overwrite)
-* gnus-summary-write-body-to-file (article body -- overwrite)
-
-The symbol of each function may have the following properties:
-
-* :decode
-The value non-nil means save decoded articles. This is meaningful
-only with `gnus-summary-save-in-file', `gnus-summary-save-body-in-file',
-`gnus-summary-write-to-file', and `gnus-summary-write-body-to-file'.
-
-* :function
-The value specifies an alternative function which appends, not
-overwrites, articles to a file. This implies that when saving many
-articles at a time, `gnus-prompt-before-saving' is bound to t and all
-articles are saved in a single file. This is meaningful only with
-`gnus-summary-write-to-file' and `gnus-summary-write-body-to-file'.
-
-* :headers
-The value specifies the symbol of a variable of which the value
-specifies headers to be saved. If it is omitted,
-`gnus-save-all-headers' and `gnus-saved-headers' control what
-headers should be saved."
- :group 'gnus-article-saving
- :type '(radio (function-item gnus-summary-save-in-rmail)
- (function-item gnus-summary-save-in-mail)
- (function-item gnus-summary-save-in-folder)
- (function-item gnus-summary-save-in-file)
- (function-item gnus-summary-save-body-in-file)
- (function-item gnus-summary-save-in-vm)
- (function-item gnus-summary-write-to-file)
- (function-item gnus-summary-write-body-to-file)
- (function)))
-
-(defcustom gnus-article-save-coding-system
- (or (and (mm-coding-system-p 'utf-8) 'utf-8)
- (and (mm-coding-system-p 'iso-2022-7bit) 'iso-2022-7bit)
- (and (mm-coding-system-p 'emacs-mule) 'emacs-mule)
- (and (mm-coding-system-p 'escape-quoted) 'escape-quoted))
- "Coding system used to save decoded articles to a file.
-
-The recommended coding systems are `utf-8', `iso-2022-7bit' and so on,
-which can safely encode any characters in text. This is used by the
-commands including:
-
-* gnus-summary-save-article-file
-* gnus-summary-save-article-body-file
-* gnus-summary-write-article-file
-* gnus-summary-write-article-body-file
-
-and the functions to which you may set `gnus-default-article-saver':
-
-* gnus-summary-save-in-file
-* gnus-summary-save-body-in-file
-* gnus-summary-write-to-file
-* gnus-summary-write-body-to-file
-
-Those commands and functions save just text displayed in the article
-buffer to a file if the value of this variable is non-nil. Note that
-buttonized MIME parts will be lost in a saved file in that case.
-Otherwise, raw articles will be saved."
- :group 'gnus-article-saving
- :type `(choice
- :format "%{%t%}:\n %[Value Menu%] %v"
- (const :tag "Save raw articles" nil)
- ,@(delq nil
- (mapcar
- (lambda (arg) (if (mm-coding-system-p (nth 3 arg)) arg))
- '((const :tag "UTF-8" utf-8)
- (const :tag "iso-2022-7bit" iso-2022-7bit)
- (const :tag "Emacs internal" emacs-mule)
- (const :tag "escape-quoted" escape-quoted))))
- (symbol :tag "Coding system")))
-
-(defcustom gnus-rmail-save-name 'gnus-plain-save-name
- "A function generating a file name to save articles in Rmail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
- :group 'gnus-article-saving
- :type 'function)
-
-(defcustom gnus-mail-save-name 'gnus-plain-save-name
- "A function generating a file name to save articles in Unix mail format.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FILE."
- :group 'gnus-article-saving
- :type 'function)
-
-(defcustom gnus-folder-save-name 'gnus-folder-save-name
- "A function generating a file name to save articles in MH folder.
-The function is called with NEWSGROUP, HEADERS, and optional LAST-FOLDER."
- :group 'gnus-article-saving
- :type 'function)
-
-(defcustom gnus-file-save-name 'gnus-numeric-save-name
- "A function generating a file name to save articles in article format.
-The function is called with NEWSGROUP, HEADERS, and optional
-LAST-FILE."
- :group 'gnus-article-saving
- :type 'function)
-
-(defcustom gnus-split-methods
- '((gnus-article-archive-name)
- (gnus-article-nndoc-name))
- "*Variable used to suggest where articles are to be saved.
-For instance, if you would like to save articles related to Gnus in
-the file \"gnus-stuff\", and articles related to VM in \"vm-stuff\",
-you could set this variable to something like:
-
- '((\"^Subject:.*gnus\\|^Newsgroups:.*gnus\" \"gnus-stuff\")
- (\"^Subject:.*vm\\|^Xref:.*vm\" \"vm-stuff\"))
-
-This variable is an alist where the where the key is the match and the
-value is a list of possible files to save in if the match is non-nil.
-
-If the match is a string, it is used as a regexp match on the
-article. If the match is a symbol, that symbol will be funcalled
-from the buffer of the article to be saved with the newsgroup as the
-parameter. If it is a list, it will be evalled in the same buffer.
-
-If this form or function returns a string, this string will be used as
-a possible file name; and if it returns a non-nil list, that list will
-be used as possible file names."
- :group 'gnus-article-saving
- :type '(repeat (choice (list :value (fun) function)
- (cons :value ("" "") regexp (repeat string))
- (sexp :value nil))))
-
-(defcustom gnus-page-delimiter "^\^L"
- "*Regexp describing what to use as article page delimiters.
-The default value is \"^\^L\", which is a form linefeed at the
-beginning of a line."
- :type 'regexp
- :group 'gnus-article-various)
-
-(defcustom gnus-article-mode-line-format "Gnus: %g [%w] %S%m"
- "*The format specification for the article mode line.
-See `gnus-summary-mode-line-format' for a closer description.
-
-The following additional specs are available:
-
-%w The article washing status.
-%m The number of MIME parts in the article."
- :type 'string
- :group 'gnus-article-various)
-
-(defcustom gnus-article-mode-hook nil
- "*A hook for Gnus article mode."
- :type 'hook
- :group 'gnus-article-various)
-
-(when (featurep 'xemacs)
- ;; Extracted from gnus-xmas-define in order to preserve user settings
- (when (fboundp 'turn-off-scroll-in-place)
- (add-hook 'gnus-article-mode-hook 'turn-off-scroll-in-place))
- ;; Extracted from gnus-xmas-redefine in order to preserve user settings
- (add-hook 'gnus-article-mode-hook 'gnus-xmas-article-menu-add))
-
-(defcustom gnus-article-menu-hook nil
- "*Hook run after the creation of the article mode menu."
- :type 'hook
- :group 'gnus-article-various)
-
-(defcustom gnus-article-prepare-hook nil
- "*A hook called after an article has been prepared in the article buffer."
- :type 'hook
- :group 'gnus-article-various)
-
-(make-obsolete-variable 'gnus-article-hide-pgp-hook
- "This variable is obsolete in Gnus 5.10.")
-
-(defcustom gnus-article-button-face 'bold
- "Face used for highlighting buttons in the article buffer.
-
-An article button is a piece of text that you can activate by pressing
-`RET' or `mouse-2' above it."
- :type 'face
- :group 'gnus-article-buttons)
-
-(defcustom gnus-article-mouse-face 'highlight
- "Face used for mouse highlighting in the article buffer.
-
-Article buttons will be displayed in this face when the cursor is
-above them."
- :type 'face
- :group 'gnus-article-buttons)
-
-(defcustom gnus-signature-face 'gnus-signature
- "Face used for highlighting a signature in the article buffer.
-Obsolete; use the face `gnus-signature' for customizations instead."
- :type 'face
- :group 'gnus-article-highlight
- :group 'gnus-article-signature)
-
-(defface gnus-signature
- '((t
- (:italic t)))
- "Face used for highlighting a signature in the article buffer."
- :group 'gnus-article-highlight
- :group 'gnus-article-signature)
-;; backward-compatibility alias
-(put 'gnus-signature-face 'face-alias 'gnus-signature)
-
-(defface gnus-header-from
- '((((class color)
- (background dark))
- (:foreground "spring green"))
- (((class color)
- (background light))
- (:foreground "red3"))
- (t
- (:italic t)))
- "Face used for displaying from headers."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight)
-;; backward-compatibility alias
-(put 'gnus-header-from-face 'face-alias 'gnus-header-from)
-
-(defface gnus-header-subject
- '((((class color)
- (background dark))
- (:foreground "SeaGreen3"))
- (((class color)
- (background light))
- (:foreground "red4"))
- (t
- (:bold t :italic t)))
- "Face used for displaying subject headers."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight)
-;; backward-compatibility alias
-(put 'gnus-header-subject-face 'face-alias 'gnus-header-subject)
-
-(defface gnus-header-newsgroups
- '((((class color)
- (background dark))
- (:foreground "yellow" :italic t))
- (((class color)
- (background light))
- (:foreground "MidnightBlue" :italic t))
- (t
- (:italic t)))
- "Face used for displaying newsgroups headers.
-In the default setup this face is only used for crossposted
-articles."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight)
-;; backward-compatibility alias
-(put 'gnus-header-newsgroups-face 'face-alias 'gnus-header-newsgroups)
-
-(defface gnus-header-name
- '((((class color)
- (background dark))
- (:foreground "SeaGreen"))
- (((class color)
- (background light))
- (:foreground "maroon"))
- (t
- (:bold t)))
- "Face used for displaying header names."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight)
-;; backward-compatibility alias
-(put 'gnus-header-name-face 'face-alias 'gnus-header-name)
-
-(defface gnus-header-content
- '((((class color)
- (background dark))
- (:foreground "forest green" :italic t))
- (((class color)
- (background light))
- (:foreground "indianred4" :italic t))
- (t
- (:italic t))) "Face used for displaying header content."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight)
-;; backward-compatibility alias
-(put 'gnus-header-content-face 'face-alias 'gnus-header-content)
-
-(defcustom gnus-header-face-alist
- '(("From" nil gnus-header-from)
- ("Subject" nil gnus-header-subject)
- ("Newsgroups:.*," nil gnus-header-newsgroups)
- ("" gnus-header-name gnus-header-content))
- "*Controls highlighting of article headers.
-
-An alist of the form (HEADER NAME CONTENT).
-
-HEADER is a regular expression which should match the name of a
-header and NAME and CONTENT are either face names or nil.
-
-The name of each header field will be displayed using the face
-specified by the first element in the list where HEADER matches
-the header name and NAME is non-nil. Similarly, the content will
-be displayed by the first non-nil matching CONTENT face."
- :group 'gnus-article-headers
- :group 'gnus-article-highlight
- :type '(repeat (list (regexp :tag "Header")
- (choice :tag "Name"
- (item :tag "skip" nil)
- (face :value default))
- (choice :tag "Content"
- (item :tag "skip" nil)
- (face :value default)))))
-
-(defcustom gnus-article-decode-hook
- '(article-decode-charset article-decode-encoded-words
- article-decode-group-name article-decode-idna-rhs)
- "*Hook run to decode charsets in articles."
- :group 'gnus-article-headers
- :type 'hook)
-
-(defcustom gnus-display-mime-function 'gnus-display-mime
- "Function to display MIME articles."
- :group 'gnus-article-mime
- :type 'function)
-
-(defvar gnus-decode-header-function 'mail-decode-encoded-word-region
- "Function used to decode headers.")
-
-(defvar gnus-decode-address-function 'mail-decode-encoded-address-region
- "Function used to decode addresses.")
-
-(defvar gnus-article-dumbquotes-map
- '(("\200" "EUR")
- ("\202" ",")
- ("\203" "f")
- ("\204" ",,")
- ("\205" "...")
- ("\213" "<")
- ("\214" "OE")
- ("\221" "`")
- ("\222" "'")
- ("\223" "``")
- ("\224" "\"")
- ("\225" "*")
- ("\226" "-")
- ("\227" "--")
- ("\230" "~")
- ("\231" "(TM)")
- ("\233" ">")
- ("\234" "oe")
- ("\264" "'"))
- "Table for MS-to-Latin1 translation.")
-
-(defcustom gnus-ignored-mime-types nil
- "List of MIME types that should be ignored by Gnus."
- :version "21.1"
- :group 'gnus-article-mime
- :type '(repeat regexp))
-
-(defcustom gnus-unbuttonized-mime-types '(".*/.*")
- "List of MIME types that should not be given buttons when rendered inline.
-See also `gnus-buttonized-mime-types' which may override this variable.
-This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
- :version "21.1"
- :group 'gnus-article-mime
- :type '(repeat regexp))
-
-(defcustom gnus-buttonized-mime-types nil
- "List of MIME types that should be given buttons when rendered inline.
-If set, this variable overrides `gnus-unbuttonized-mime-types'.
-To see e.g. security buttons you could set this to
-`(\"multipart/signed\")'. You could also add \"multipart/alternative\" to
-this list to display radio buttons that allow you to choose one of two
-media types those mails include. See also `mm-discouraged-alternatives'.
-This variable is only used when `gnus-inhibit-mime-unbuttonizing' is nil."
- :version "22.1"
- :group 'gnus-article-mime
- :type '(repeat regexp))
-
-(defcustom gnus-inhibit-mime-unbuttonizing nil
- "If non-nil, all MIME parts get buttons.
-When nil (the default value), then some MIME parts do not get buttons,
-as described by the variables `gnus-buttonized-mime-types' and
-`gnus-unbuttonized-mime-types'."
- :version "22.1"
- :group 'gnus-article-mime
- :type 'boolean)
-
-(defcustom gnus-body-boundary-delimiter "_"
- "String used to delimit header and body.
-This variable is used by `gnus-article-treat-body-boundary' which can
-be controlled by `gnus-treat-body-boundary'."
- :version "22.1"
- :group 'gnus-article-various
- :type '(choice (item :tag "None" :value nil)
- string))
-
-(defcustom gnus-picon-databases '("/usr/lib/picon" "/usr/local/faces"
- "/usr/share/picons")
- "Defines the location of the faces database.
-For information on obtaining this database of pretty pictures, please
-see http://www.cs.indiana.edu/picons/ftp/index.html"
- :version "22.1"
- :type '(repeat directory)
- :link '(url-link :tag "download"
- "http://www.cs.indiana.edu/picons/ftp/index.html")
- :link '(custom-manual "(gnus)Picons")
- :group 'gnus-picon)
-
-(defun gnus-picons-installed-p ()
- "Say whether picons are installed on your machine."
- (let ((installed nil))
- (dolist (database gnus-picon-databases)
- (when (file-exists-p database)
- (setq installed t)))
- installed))
-
-(defcustom gnus-article-mime-part-function nil
- "Function called with a MIME handle as the argument.
-This is meant for people who want to do something automatic based
-on parts -- for instance, adding Vcard info to a database."
- :group 'gnus-article-mime
- :type '(choice (const nil)
- function))
-
-(defcustom gnus-mime-multipart-functions nil
- "An alist of MIME types to functions to display them."
- :version "21.1"
- :group 'gnus-article-mime
- :type 'alist)
-
-(defcustom gnus-article-date-lapsed-new-header nil
- "Whether the X-Sent and Date headers can coexist.
-When using `gnus-treat-date-lapsed', the \"X-Sent:\" header will
-either replace the old \"Date:\" header (if this variable is nil), or
-be added below it (otherwise)."
- :version "21.1"
- :group 'gnus-article-headers
- :type 'boolean)
-
-(defcustom gnus-article-mime-match-handle-function 'undisplayed-alternative
- "Function called with a MIME handle as the argument.
-This is meant for people who want to view first matched part.
-For `undisplayed-alternative' (default), the first undisplayed
-part or alternative part is used. For `undisplayed', the first
-undisplayed part is used. For a function, the first part which
-the function return t is used. For nil, the first part is
-used."
- :version "21.1"
- :group 'gnus-article-mime
- :type '(choice
- (item :tag "first" :value nil)
- (item :tag "undisplayed" :value undisplayed)
- (item :tag "undisplayed or alternative"
- :value undisplayed-alternative)
- (function)))
-
-(defcustom gnus-mime-action-alist
- '(("save to file" . gnus-mime-save-part)
- ("save and strip" . gnus-mime-save-part-and-strip)
- ("delete part" . gnus-mime-delete-part)
- ("display as text" . gnus-mime-inline-part)
- ("view the part" . gnus-mime-view-part)
- ("pipe to command" . gnus-mime-pipe-part)
- ("toggle display" . gnus-article-press-button)
- ("toggle display" . gnus-article-view-part-as-charset)
- ("view as type" . gnus-mime-view-part-as-type)
- ("view internally" . gnus-mime-view-part-internally)
- ("view externally" . gnus-mime-view-part-externally))
- "An alist of actions that run on the MIME attachment."
- :group 'gnus-article-mime
- :type '(repeat (cons (string :tag "name")
- (function))))
-
-;;;
-;;; The treatment variables
-;;;
-
-(defvar gnus-part-display-hook nil
- "Hook called on parts that are to receive treatment.")
-
-(defvar gnus-article-treat-custom
- '(choice (const :tag "Off" nil)
- (const :tag "On" t)
- (const :tag "Header" head)
- (const :tag "Last" last)
- (integer :tag "Less")
- (repeat :tag "Groups" regexp)
- (sexp :tag "Predicate")))
-
-(defvar gnus-article-treat-head-custom
- '(choice (const :tag "Off" nil)
- (const :tag "Header" head)))
-
-(defvar gnus-article-treat-types '("text/plain")
- "Parts to treat.")
-
-(defvar gnus-inhibit-treatment nil
- "Whether to inhibit treatment.")
-
-(defcustom gnus-treat-highlight-signature '(or t (typep "text/x-vcard"))
- "Highlight the signature.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles'."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-highlight-signature 'highlight t)
-
-(defcustom gnus-treat-buttonize 100000
- "Add buttons.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles'."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-buttonize 'highlight t)
-
-(defcustom gnus-treat-buttonize-head 'head
- "Add buttons to the head.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-buttonize-head 'highlight t)
-
-(defcustom gnus-treat-emphasize
- (and (or window-system
- (featurep 'xemacs)
- (>= (string-to-number emacs-version) 21))
- 50000)
- "Emphasize text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-emphasize 'highlight t)
-
-(defcustom gnus-treat-strip-cr nil
- "Remove carriage returns.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-unsplit-urls nil
- "Remove newlines from within URLs.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-leading-whitespace nil
- "Remove leading whitespace in headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-hide-headers 'head
- "Hide headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-hide-boring-headers nil
- "Hide boring headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-hide-signature nil
- "Hide the signature.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-fill-article nil
- "Fill the article.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-hide-citation nil
- "Hide cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-hide-citation-maybe nil
- "Hide cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-strip-list-identifiers 'head
- "Strip list identifiers from `gnus-list-identifiers`.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(make-obsolete-variable 'gnus-treat-strip-pgp
- "This option is obsolete in Gnus 5.10.")
-
-(defcustom gnus-treat-strip-pem nil
- "Strip PEM signatures.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-strip-banner t
- "Strip banners from articles.
-The banner to be stripped is specified in the `banner' group parameter.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-highlight-headers 'head
- "Highlight the headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-highlight-headers 'highlight t)
-
-(defcustom gnus-treat-highlight-citation t
- "Highlight cited text.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-highlight-citation 'highlight t)
-
-(defcustom gnus-treat-date-ut nil
- "Display the Date in UT (GMT).
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-local nil
- "Display the Date in the local timezone.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-english nil
- "Display the Date in a format that can be read aloud in English.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-lapsed nil
- "Display the Date header in a way that says how much time has elapsed.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-original nil
- "Display the date in the original timezone.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-iso8601 nil
- "Display the date in the ISO8601 format.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-date-user-defined nil
- "Display the date in a user-defined format.
-The format is defined by the `gnus-article-time-format' variable.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-strip-headers-in-body t
- "Strip the X-No-Archive header line from the beginning of the body.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-strip-trailing-blank-lines nil
- "Strip trailing blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details.
-
-When set to t, it also strips trailing blanks in all MIME parts.
-Consider to use `last' instead."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-strip-leading-blank-lines nil
- "Strip leading blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details.
-
-When set to t, it also strips trailing blanks in all MIME parts."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-strip-multiple-blank-lines nil
- "Strip multiple blank lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-unfold-headers 'head
- "Unfold folded header lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-fold-headers nil
- "Fold headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-fold-newsgroups 'head
- "Fold the Newsgroups and Followup-To headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-overstrike t
- "Treat overstrike highlighting.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-overstrike 'highlight t)
-
-(make-obsolete-variable 'gnus-treat-display-xface
- 'gnus-treat-display-x-face)
-
-(defcustom gnus-treat-display-x-face
- (and (not noninteractive)
- (gnus-image-type-available-p 'xbm)
- (if (featurep 'xemacs)
- (featurep 'xface)
- (and (string-match "^0x" (shell-command-to-string "uncompface"))
- (executable-find "icontopbm")))
- 'head)
- "Display X-Face headers.
-Valid values are nil and `head'.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)X-Face' for details."
- :group 'gnus-article-treat
- :version "21.1"
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)X-Face")
- :type gnus-article-treat-head-custom
- :set (lambda (symbol value)
- (set-default
- symbol
- (cond ((or (boundp symbol) (get symbol 'saved-value))
- value)
- ((boundp 'gnus-treat-display-xface)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (default-value 'gnus-treat-display-xface))
- ((get 'gnus-treat-display-xface 'saved-value)
- (message "\
-** gnus-treat-display-xface is an obsolete variable;\
- use gnus-treat-display-x-face instead")
- (eval (car (get 'gnus-treat-display-xface 'saved-value))))
- (t
- value)))))
-(put 'gnus-treat-display-x-face 'highlight t)
-
-(defcustom gnus-treat-display-face
- (and (not noninteractive)
- (gnus-image-type-available-p 'png)
- 'head)
- "Display Face headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)X-Face' for details."
- :group 'gnus-article-treat
- :version "22.1"
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)X-Face")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-display-face 'highlight t)
-
-(defcustom gnus-treat-display-smileys (gnus-image-type-available-p 'xpm)
- "Display smileys.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)Smileys' for details."
- :group 'gnus-article-treat
- :version "21.1"
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)Smileys")
- :type gnus-article-treat-custom)
-(put 'gnus-treat-display-smileys 'highlight t)
-
-(defcustom gnus-treat-from-picon
- (if (and (gnus-image-type-available-p 'xpm)
- (gnus-picons-installed-p))
- 'head nil)
- "Display picons in the From header.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)Picons' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :group 'gnus-picon
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)Picons")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-from-picon 'highlight t)
-
-(defcustom gnus-treat-mail-picon
- (if (and (gnus-image-type-available-p 'xpm)
- (gnus-picons-installed-p))
- 'head nil)
- "Display picons in To and Cc headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)Picons' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :group 'gnus-picon
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)Picons")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-mail-picon 'highlight t)
-
-(defcustom gnus-treat-newsgroups-picon
- (if (and (gnus-image-type-available-p 'xpm)
- (gnus-picons-installed-p))
- 'head nil)
- "Display picons in the Newsgroups and Followup-To headers.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' and Info node
-`(gnus)Picons' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :group 'gnus-picon
- :link '(custom-manual "(gnus)Customizing Articles")
- :link '(custom-manual "(gnus)Picons")
- :type gnus-article-treat-head-custom)
-(put 'gnus-treat-newsgroups-picon 'highlight t)
-
-(defcustom gnus-treat-body-boundary
- (if (or gnus-treat-newsgroups-picon
- gnus-treat-mail-picon
- gnus-treat-from-picon)
- 'head nil)
- "Draw a boundary at the end of the headers.
-Valid values are nil and `head'.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-head-custom)
-
-(defcustom gnus-treat-capitalize-sentences nil
- "Capitalize sentence-starting words.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-wash-html nil
- "Format as HTML.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-fill-long-lines nil
- "Fill long lines.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-play-sounds nil
- "Play sounds.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-translate nil
- "Translate articles from one language to another.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "21.1"
- :group 'gnus-article-treat
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defcustom gnus-treat-x-pgp-sig nil
- "Verify X-PGP-Sig.
-To automatically treat X-PGP-Sig, set it to head.
-Valid values are nil, t, `head', `last', an integer or a predicate.
-See Info node `(gnus)Customizing Articles' for details."
- :version "22.1"
- :group 'gnus-article-treat
- :group 'mime-security
- :link '(custom-manual "(gnus)Customizing Articles")
- :type gnus-article-treat-custom)
-
-(defvar gnus-article-encrypt-protocol-alist
- '(("PGP" . mml2015-self-encrypt)))
-
-;; Set to nil if more than one protocol added to
-;; gnus-article-encrypt-protocol-alist.
-(defcustom gnus-article-encrypt-protocol "PGP"
- "The protocol used for encrypt articles.
-It is a string, such as \"PGP\". If nil, ask user."
- :version "22.1"
- :type 'string
- :group 'mime-security)
-
-(defvar gnus-article-wash-function nil
- "Function used for converting HTML into text.")
-
-;; XEmacs change: Don't calculate a default value
-(defcustom gnus-use-idna nil
- "Whether IDNA decoding of headers is used when viewing messages.
-This requires GNU Libidn, and by default only enabled if it is found."
- :version "22.1"
- :group 'gnus-article-headers
- :type 'boolean)
-
-(defcustom gnus-article-over-scroll nil
- "If non-nil, allow scrolling the article buffer even when there no more text."
- :version "22.1"
- :group 'gnus-article
- :type 'boolean)
-
-;;; Internal variables
-
-(defvar gnus-english-month-names
- '("January" "February" "March" "April" "May" "June" "July" "August"
- "September" "October" "November" "December"))
-
-(defvar article-goto-body-goes-to-point-min-p nil)
-(defvar gnus-article-wash-types nil)
-(defvar gnus-article-emphasis-alist nil)
-(defvar gnus-article-image-alist nil)
-
-(defvar gnus-article-mime-handle-alist-1 nil)
-(defvar gnus-treatment-function-alist
- '((gnus-treat-x-pgp-sig gnus-article-verify-x-pgp-sig)
- (gnus-treat-strip-banner gnus-article-strip-banner)
- (gnus-treat-strip-headers-in-body gnus-article-strip-headers-in-body)
- (gnus-treat-highlight-signature gnus-article-highlight-signature)
- (gnus-treat-buttonize gnus-article-add-buttons)
- (gnus-treat-fill-article gnus-article-fill-cited-article)
- (gnus-treat-fill-long-lines gnus-article-fill-long-lines)
- (gnus-treat-strip-cr gnus-article-remove-cr)
- (gnus-treat-unsplit-urls gnus-article-unsplit-urls)
- (gnus-treat-date-ut gnus-article-date-ut)
- (gnus-treat-date-local gnus-article-date-local)
- (gnus-treat-date-english gnus-article-date-english)
- (gnus-treat-date-original gnus-article-date-original)
- (gnus-treat-date-user-defined gnus-article-date-user)
- (gnus-treat-date-iso8601 gnus-article-date-iso8601)
- (gnus-treat-date-lapsed gnus-article-date-lapsed)
- (gnus-treat-display-x-face gnus-article-display-x-face)
- (gnus-treat-display-face gnus-article-display-face)
- (gnus-treat-hide-headers gnus-article-maybe-hide-headers)
- (gnus-treat-hide-boring-headers gnus-article-hide-boring-headers)
- (gnus-treat-hide-signature gnus-article-hide-signature)
- (gnus-treat-strip-list-identifiers gnus-article-hide-list-identifiers)
- (gnus-treat-leading-whitespace gnus-article-remove-leading-whitespace)
- (gnus-treat-strip-pem gnus-article-hide-pem)
- (gnus-treat-from-picon gnus-treat-from-picon)
- (gnus-treat-mail-picon gnus-treat-mail-picon)
- (gnus-treat-newsgroups-picon gnus-treat-newsgroups-picon)
- (gnus-treat-highlight-headers gnus-article-highlight-headers)
- (gnus-treat-highlight-signature gnus-article-highlight-signature)
- (gnus-treat-strip-trailing-blank-lines
- gnus-article-remove-trailing-blank-lines)
- (gnus-treat-strip-leading-blank-lines
- gnus-article-strip-leading-blank-lines)
- (gnus-treat-strip-multiple-blank-lines
- gnus-article-strip-multiple-blank-lines)
- (gnus-treat-overstrike gnus-article-treat-overstrike)
- (gnus-treat-unfold-headers gnus-article-treat-unfold-headers)
- (gnus-treat-fold-headers gnus-article-treat-fold-headers)
- (gnus-treat-fold-newsgroups gnus-article-treat-fold-newsgroups)
- (gnus-treat-buttonize-head gnus-article-add-buttons-to-head)
- (gnus-treat-display-smileys gnus-treat-smiley)
- (gnus-treat-capitalize-sentences gnus-article-capitalize-sentences)
- (gnus-treat-wash-html gnus-article-wash-html)
- (gnus-treat-emphasize gnus-article-emphasize)
- (gnus-treat-hide-citation gnus-article-hide-citation)
- (gnus-treat-hide-citation-maybe gnus-article-hide-citation-maybe)
- (gnus-treat-highlight-citation gnus-article-highlight-citation)
- (gnus-treat-body-boundary gnus-article-treat-body-boundary)
- (gnus-treat-play-sounds gnus-earcon-display)))
-
-(defvar gnus-article-mime-handle-alist nil)
-(defvar article-lapsed-timer nil)
-(defvar gnus-article-current-summary nil)
-
-(defvar gnus-article-mode-syntax-table
- (let ((table (copy-syntax-table text-mode-syntax-table)))
- ;; This causes the citation match run O(2^n).
- ;; (modify-syntax-entry ?- "w" table)
- (modify-syntax-entry ?> ")<" table)
- (modify-syntax-entry ?< "(>" table)
- ;; make M-. in article buffers work for `foo' strings
- (modify-syntax-entry ?' " " table)
- (modify-syntax-entry ?` " " table)
- table)
- "Syntax table used in article mode buffers.
-Initialized from `text-mode-syntax-table.")
-
-(defvar gnus-save-article-buffer nil)
-
-(defvar gnus-article-mode-line-format-alist
- (nconc '((?w (gnus-article-wash-status) ?s)
- (?m (gnus-article-mime-part-status) ?s))
- gnus-summary-mode-line-format-alist))
-
-(defvar gnus-number-of-articles-to-be-saved nil)
-
-(defvar gnus-inhibit-hiding nil)
-
-(defvar gnus-article-edit-mode nil)
-
-;;; Macros for dealing with the article buffer.
-
-(defmacro gnus-with-article-headers (&rest forms)
- `(save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (case-fold-search t))
- (article-narrow-to-head)
- ,@forms))))
-
-(put 'gnus-with-article-headers 'lisp-indent-function 0)
-(put 'gnus-with-article-headers 'edebug-form-spec '(body))
-
-(defmacro gnus-with-article-buffer (&rest forms)
- `(save-excursion
- (set-buffer gnus-article-buffer)
- (let ((inhibit-read-only t))
- ,@forms)))
-
-(put 'gnus-with-article-buffer 'lisp-indent-function 0)
-(put 'gnus-with-article-buffer 'edebug-form-spec '(body))
-
-(defun gnus-article-goto-header (header)
- "Go to HEADER, which is a regular expression."
- (re-search-forward (concat "^\\(" header "\\):") nil t))
-
-(defsubst gnus-article-hide-text (b e props)
- "Set text PROPS on the B to E region, extending `intangible' 1 past B."
- (gnus-add-text-properties-when 'article-type nil b e props)
- (when (memq 'intangible props)
- (put-text-property
- (max (1- b) (point-min))
- b 'intangible (cddr (memq 'intangible props)))))
-
-(defsubst gnus-article-unhide-text (b e)
- "Remove hidden text properties from region between B and E."
- (remove-text-properties b e gnus-hidden-properties)
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
-
-(defun gnus-article-hide-text-type (b e type)
- "Hide text of TYPE between B and E."
- (gnus-add-wash-type type)
- (gnus-article-hide-text
- b e (cons 'article-type (cons type gnus-hidden-properties))))
-
-(defun gnus-article-unhide-text-type (b e type)
- "Unhide text of TYPE between B and E."
- (gnus-delete-wash-type type)
- (remove-text-properties
- b e (cons 'article-type (cons type gnus-hidden-properties)))
- (when (memq 'intangible gnus-hidden-properties)
- (put-text-property (max (1- b) (point-min))
- b 'intangible nil)))
-
-(defun gnus-article-hide-text-of-type (type)
- "Hide text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min))
- (e (point-max)))
- (while (setq b (text-property-any b e 'article-type type))
- (add-text-properties b (incf b) gnus-hidden-properties)))))
-
-(defun gnus-article-delete-text-of-type (type)
- "Delete text of TYPE in the current buffer."
- (save-excursion
- (let ((b (point-min)))
- (if (eq type 'multipart)
- ;; Remove MIME buttons associated with multipart/alternative parts.
- (progn
- (goto-char b)
- (while (if (get-text-property (point) 'gnus-part)
- (setq b (point))
- (when (setq b (next-single-property-change (point)
- 'gnus-part))
- (goto-char b)
- t))
- (end-of-line)
- (skip-chars-forward "\n")
- (when (eq (get-text-property b 'article-type) 'multipart)
- (delete-region b (point)))))
- (while (setq b (text-property-any b (point-max) 'article-type type))
- (delete-region
- b (or (text-property-not-all b (point-max) 'article-type type)
- (point-max))))))))
-
-(defun gnus-article-delete-invisible-text ()
- "Delete all invisible text in the current buffer."
- (save-excursion
- (let ((b (point-min)))
- (while (setq b (text-property-any b (point-max) 'invisible t))
- (delete-region
- b (or (text-property-not-all b (point-max) 'invisible t)
- (point-max)))))))
-
-(defun gnus-article-text-type-exists-p (type)
- "Say whether any text of type TYPE exists in the buffer."
- (text-property-any (point-min) (point-max) 'article-type type))
-
-(defsubst gnus-article-header-rank ()
- "Give the rank of the string HEADER as given by `gnus-sorted-header-list'."
- (let ((list gnus-sorted-header-list)
- (i 1))
- (while list
- (if (looking-at (car list))
- (setq list nil)
- (setq list (cdr list))
- (incf i)))
- i))
-
-(defun article-hide-headers (&optional arg delete)
- "Hide unwanted headers and possibly sort them as well."
- (interactive)
- ;; This function might be inhibited.
- (unless gnus-inhibit-hiding
- (let ((inhibit-read-only t)
- (case-fold-search t)
- (max (1+ (length gnus-sorted-header-list)))
- (inhibit-point-motion-hooks t)
- (cur (current-buffer))
- ignored visible beg)
- (save-excursion
- ;; `gnus-ignored-headers' and `gnus-visible-headers' may be
- ;; group parameters, so we should go to the summary buffer.
- (when (prog1
- (condition-case nil
- (progn (set-buffer gnus-summary-buffer) t)
- (error nil))
- (setq ignored (when (not gnus-visible-headers)
- (cond ((stringp gnus-ignored-headers)
- gnus-ignored-headers)
- ((listp gnus-ignored-headers)
- (mapconcat 'identity
- gnus-ignored-headers
- "\\|"))))
- visible (cond ((stringp gnus-visible-headers)
- gnus-visible-headers)
- ((and gnus-visible-headers
- (listp gnus-visible-headers))
- (mapconcat 'identity
- gnus-visible-headers
- "\\|")))))
- (set-buffer cur))
- (save-restriction
- ;; First we narrow to just the headers.
- (article-narrow-to-head)
- ;; Hide any "From " lines at the beginning of (mail) articles.
- (while (looking-at "From ")
- (forward-line 1))
- (unless (bobp)
- (delete-region (point-min) (point)))
- ;; Then treat the rest of the header lines.
- ;; Then we use the two regular expressions
- ;; `gnus-ignored-headers' and `gnus-visible-headers' to
- ;; select which header lines is to remain visible in the
- ;; article buffer.
- (while (re-search-forward "^[^ \t:]*:" nil t)
- (beginning-of-line)
- ;; Mark the rank of the header.
- (put-text-property
- (point) (1+ (point)) 'message-rank
- (if (or (and visible (looking-at visible))
- (and ignored
- (not (looking-at ignored))))
- (gnus-article-header-rank)
- (+ 2 max)))
- (forward-line 1))
- (message-sort-headers-1)
- (when (setq beg (text-property-any
- (point-min) (point-max) 'message-rank (+ 2 max)))
- ;; We delete the unwanted headers.
- (gnus-add-wash-type 'headers)
- (add-text-properties (point-min) (+ 5 (point-min))
- '(article-type headers dummy-invisible t))
- (delete-region beg (point-max))))))))
-
-(defun article-hide-boring-headers (&optional arg)
- "Toggle hiding of headers that aren't very interesting.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
- (interactive (gnus-article-hidden-arg))
- (when (and (not (gnus-article-check-hidden-text 'boring-headers arg))
- (not gnus-show-all-headers))
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t)
- (list gnus-boring-article-headers)
- (inhibit-point-motion-hooks t)
- elem)
- (article-narrow-to-head)
- (while list
- (setq elem (pop list))
- (goto-char (point-min))
- (cond
- ;; Hide empty headers.
- ((eq elem 'empty)
- (while (re-search-forward "^[^: \t]+:[ \t]*\n[^ \t]" nil t)
- (forward-line -1)
- (gnus-article-hide-text-type
- (gnus-point-at-bol)
- (progn
- (end-of-line)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (point-max)))
- 'boring-headers)))
- ;; Hide boring Newsgroups header.
- ((eq elem 'newsgroups)
- (when (gnus-string-equal
- (gnus-fetch-field "newsgroups")
- (gnus-group-real-name
- (if (boundp 'gnus-newsgroup-name)
- gnus-newsgroup-name
- "")))
- (gnus-article-hide-header "newsgroups")))
- ((eq elem 'to-address)
- (let ((to (message-fetch-field "to"))
- (to-address
- (gnus-parameter-to-address
- (if (boundp 'gnus-newsgroup-name)
- gnus-newsgroup-name ""))))
- (when (and to to-address
- (ignore-errors
- (gnus-string-equal
- ;; only one address in To
- (nth 1 (mail-extract-address-components to))
- to-address)))
- (gnus-article-hide-header "to"))))
- ((eq elem 'to-list)
- (let ((to (message-fetch-field "to"))
- (to-list
- (gnus-parameter-to-list
- (if (boundp 'gnus-newsgroup-name)
- gnus-newsgroup-name ""))))
- (when (and to to-list
- (ignore-errors
- (gnus-string-equal
- ;; only one address in To
- (nth 1 (mail-extract-address-components to))
- to-list)))
- (gnus-article-hide-header "to"))))
- ((eq elem 'cc-list)
- (let ((cc (message-fetch-field "cc"))
- (to-list
- (gnus-parameter-to-list
- (if (boundp 'gnus-newsgroup-name)
- gnus-newsgroup-name ""))))
- (when (and cc to-list
- (ignore-errors
- (gnus-string-equal
- ;; only one address in CC
- (nth 1 (mail-extract-address-components cc))
- to-list)))
- (gnus-article-hide-header "cc"))))
- ((eq elem 'followup-to)
- (when (gnus-string-equal
- (message-fetch-field "followup-to")
- (message-fetch-field "newsgroups"))
- (gnus-article-hide-header "followup-to")))
- ((eq elem 'reply-to)
- (if (gnus-group-find-parameter
- gnus-newsgroup-name 'broken-reply-to)
- (gnus-article-hide-header "reply-to")
- (let ((from (message-fetch-field "from"))
- (reply-to (message-fetch-field "reply-to")))
- (when
- (and
- from reply-to
- (ignore-errors
- (equal
- (sort (mapcar
- (lambda (x) (downcase (cadr x)))
- (mail-extract-address-components from t))
- 'string<)
- (sort (mapcar
- (lambda (x) (downcase (cadr x)))
- (mail-extract-address-components reply-to t))
- 'string<))))
- (gnus-article-hide-header "reply-to")))))
- ((eq elem 'date)
- (let ((date (with-current-buffer gnus-original-article-buffer
- ;; If date in `gnus-article-buffer' is localized
- ;; (`gnus-treat-date-user-defined'),
- ;; `days-between' might fail.
- (message-fetch-field "date"))))
- (when (and date
- (< (days-between (current-time-string) date)
- 4))
- (gnus-article-hide-header "date"))))
- ((eq elem 'long-to)
- (let ((to (message-fetch-field "to"))
- (cc (message-fetch-field "cc")))
- (when (> (length to) 1024)
- (gnus-article-hide-header "to"))
- (when (> (length cc) 1024)
- (gnus-article-hide-header "cc"))))
- ((eq elem 'many-to)
- (let ((to-count 0)
- (cc-count 0))
- (goto-char (point-min))
- (while (re-search-forward "^to:" nil t)
- (setq to-count (1+ to-count)))
- (when (> to-count 1)
- (while (> to-count 0)
- (goto-char (point-min))
- (save-restriction
- (re-search-forward "^to:" nil nil to-count)
- (forward-line -1)
- (narrow-to-region (point) (point-max))
- (gnus-article-hide-header "to"))
- (setq to-count (1- to-count))))
- (goto-char (point-min))
- (while (re-search-forward "^cc:" nil t)
- (setq cc-count (1+ cc-count)))
- (when (> cc-count 1)
- (while (> cc-count 0)
- (goto-char (point-min))
- (save-restriction
- (re-search-forward "^cc:" nil nil cc-count)
- (forward-line -1)
- (narrow-to-region (point) (point-max))
- (gnus-article-hide-header "cc"))
- (setq cc-count (1- cc-count)))))))))))))
-
-(defun gnus-article-hide-header (header)
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward (concat "^" header ":") nil t)
- (gnus-article-hide-text-type
- (gnus-point-at-bol)
- (progn
- (end-of-line)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (point-max)))
- 'boring-headers))))
-
-(defvar gnus-article-normalized-header-length 40
- "Length of normalized headers.")
-
-(defun article-normalize-headers ()
- "Make all header lines 40 characters long."
- (interactive)
- (let ((inhibit-read-only t)
- column)
- (save-excursion
- (save-restriction
- (article-narrow-to-head)
- (while (not (eobp))
- (cond
- ((< (setq column (- (gnus-point-at-eol) (point)))
- gnus-article-normalized-header-length)
- (end-of-line)
- (insert (make-string
- (- gnus-article-normalized-header-length column)
- ? )))
- ((> column gnus-article-normalized-header-length)
- (gnus-put-text-property
- (progn
- (forward-char gnus-article-normalized-header-length)
- (point))
- (gnus-point-at-eol)
- 'invisible t))
- (t
- ;; Do nothing.
- ))
- (forward-line 1))))))
-
-(defun article-treat-dumbquotes ()
- "Translate M****s*** sm*rtq**t*s and other symbols into proper text.
-Note that this function guesses whether a character is a sm*rtq**t* or
-not, so it should only be used interactively.
-
-Sm*rtq**t*s are M****s***'s unilateral extension to the
-iso-8859-1 character map in an attempt to provide more quoting
-characters. If you see something like \\222 or \\264 where
-you're expecting some kind of apostrophe or quotation mark, then
-try this wash."
- (interactive)
- (article-translate-strings gnus-article-dumbquotes-map))
-
-(defun article-translate-characters (from to)
- "Translate all characters in the body of the article according to FROM and TO.
-FROM is a string of characters to translate from; to is a string of
-characters to translate to."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- (x (make-string 225 ?x))
- (i -1))
- (while (< (incf i) (length x))
- (aset x i i))
- (setq i 0)
- (while (< i (length from))
- (aset x (aref from i) (aref to i))
- (incf i))
- (translate-region (point) (point-max) x)))))
-
-(defun article-translate-strings (map)
- "Translate all string in the body of the article according to MAP.
-MAP is an alist where the elements are on the form (\"from\" \"to\")."
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t)
- elem)
- (while (setq elem (pop map))
- (save-excursion
- (while (search-forward (car elem) nil t)
- (replace-match (cadr elem)))))))))
-
-(defun article-treat-overstrike ()
- "Translate overstrikes into bold text."
- (interactive)
- (save-excursion
- (when (article-goto-body)
- (let ((inhibit-read-only t))
- (while (search-forward "\b" nil t)
- (let ((next (char-after))
- (previous (char-after (- (point) 2))))
- ;; We do the boldification/underlining by hiding the
- ;; overstrikes and putting the proper text property
- ;; on the letters.
- (cond
- ((eq next previous)
- (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
- (put-text-property (point) (1+ (point)) 'face 'bold))
- ((eq next ?_)
- (gnus-article-hide-text-type
- (1- (point)) (1+ (point)) 'overstrike)
- (put-text-property
- (- (point) 2) (1- (point)) 'face 'underline))
- ((eq previous ?_)
- (gnus-article-hide-text-type (- (point) 2) (point) 'overstrike)
- (put-text-property
- (point) (1+ (point)) 'face 'underline)))))))))
-
-(defun gnus-article-treat-unfold-headers ()
- "Unfold folded message headers.
-Only the headers that fit into the current window width will be
-unfolded."
- (interactive)
- (gnus-with-article-headers
- (let (length)
- (while (not (eobp))
- (save-restriction
- (mail-header-narrow-to-field)
- (let ((header (buffer-string)))
- (with-temp-buffer
- (insert header)
- (goto-char (point-min))
- (while (re-search-forward "\n[\t ]" nil t)
- (replace-match " " t t)))
- (setq length (- (point-max) (point-min) 1)))
- (when (< length (window-width))
- (while (re-search-forward "\n[\t ]" nil t)
- (replace-match " " t t)))
- (goto-char (point-max)))))))
-
-(defun gnus-article-treat-fold-headers ()
- "Fold message headers."
- (interactive)
- (gnus-with-article-headers
- (while (not (eobp))
- (save-restriction
- (mail-header-narrow-to-field)
- (mail-header-fold-field)
- (goto-char (point-max))))))
-
-(defun gnus-treat-smiley ()
- "Toggle display of textual emoticons (\"smileys\") as small graphical icons."
- (interactive)
- (gnus-with-article-buffer
- (if (memq 'smiley gnus-article-wash-types)
- (gnus-delete-images 'smiley)
- (article-goto-body)
- (let ((images (smiley-region (point) (point-max))))
- (when images
- (gnus-add-wash-type 'smiley)
- (dolist (image images)
- (gnus-add-image 'smiley image)))))))
-
-(defun gnus-article-remove-images ()
- "Remove all images from the article buffer."
- (interactive)
- (gnus-with-article-buffer
- (dolist (elem gnus-article-image-alist)
- (gnus-delete-images (car elem)))))
-
-(defun gnus-article-treat-fold-newsgroups ()
- "Unfold folded message headers.
-Only the headers that fit into the current window width will be
-unfolded."
- (interactive)
- (gnus-with-article-headers
- (while (gnus-article-goto-header "newsgroups\\|followup-to")
- (save-restriction
- (mail-header-narrow-to-field)
- (while (re-search-forward ", *" nil t)
- (replace-match ", " t t))
- (mail-header-fold-field)
- (goto-char (point-max))))))
-
-(defun gnus-article-treat-body-boundary ()
- "Place a boundary line at the end of the headers."
- (interactive)
- (when (and gnus-body-boundary-delimiter
- (> (length gnus-body-boundary-delimiter) 0))
- (gnus-with-article-headers
- (goto-char (point-max))
- (let ((start (point)))
- (insert "X-Boundary: ")
- (gnus-add-text-properties start (point) '(invisible t intangible t))
- (insert (let (str)
- (while (>= (1- (window-width)) (length str))
- (setq str (concat str gnus-body-boundary-delimiter)))
- (substring str 0 (1- (window-width))))
- "\n")
- (gnus-put-text-property start (point) 'gnus-decoration 'header)))))
-
-(defun article-fill-long-lines ()
- "Fill lines that are wider than the window width."
- (interactive)
- (save-excursion
- (let ((inhibit-read-only t)
- (width (window-width (get-buffer-window (current-buffer)))))
- (save-restriction
- (article-goto-body)
- (let ((adaptive-fill-mode nil)) ;Why? -sm
- (while (not (eobp))
- (end-of-line)
- (when (>= (current-column) (min fill-column width))
- (narrow-to-region (min (1+ (point)) (point-max))
- (gnus-point-at-bol))
- (let ((goback (point-marker)))
- (fill-paragraph nil)
- (goto-char (marker-position goback)))
- (widen))
- (forward-line 1)))))))
-
-(defun article-capitalize-sentences ()
- "Capitalize the first word in each sentence."
- (interactive)
- (save-excursion
- (let ((inhibit-read-only t)
- (paragraph-start "^[\n\^L]"))
- (article-goto-body)
- (while (not (eobp))
- (capitalize-word 1)
- (forward-sentence)))))
-
-(defun article-remove-cr ()
- "Remove trailing CRs and then translate remaining CRs into LFs."
- (interactive)
- (save-excursion
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "\n" t t)))))
-
-(defun article-remove-trailing-blank-lines ()
- "Remove all trailing blank lines from the article."
- (interactive)
- (save-excursion
- (let ((inhibit-read-only t))
- (goto-char (point-max))
- (delete-region
- (point)
- (progn
- (while (and (not (bobp))
- (looking-at "^[ \t]*$")
- (not (gnus-annotation-in-region-p
- (point) (gnus-point-at-eol))))
- (forward-line -1))
- (forward-line 1)
- (point))))))
-
-(defun article-display-face ()
- "Display any Face headers in the header."
- (interactive)
- (let ((wash-face-p buffer-read-only))
- (gnus-with-article-headers
- ;; When displaying parts, this function can be called several times on
- ;; the same article, without any intended toggle semantic (as typing `W
- ;; D d' would have). So face deletion must occur only when we come from
- ;; an interactive command, that is when the *Article* buffer is
- ;; read-only.
- (if (and wash-face-p (memq 'face gnus-article-wash-types))
- (gnus-delete-images 'face)
- (let (face faces from)
- (save-current-buffer
- (when (and wash-face-p
- (gnus-buffer-live-p gnus-original-article-buffer)
- (not (re-search-forward "^Face:[\t ]*" nil t)))
- (set-buffer gnus-original-article-buffer))
- (save-restriction
- (mail-narrow-to-head)
- (while (gnus-article-goto-header "Face")
- (push (mail-header-field-value) faces))))
- (when faces
- (goto-char (point-min))
- (let ((from (gnus-article-goto-header "from"))
- png image)
- (unless from
- (insert "From:")
- (setq from (point))
- (insert "[no `from' set]\n"))
- (while faces
- (when (setq png (gnus-convert-face-to-png (pop faces)))
- (setq image (gnus-create-image png 'png t))
- (goto-char from)
- (gnus-add-wash-type 'face)
- (gnus-add-image 'face image)
- (gnus-put-image image nil 'face))))))))))
-
-(defun article-display-x-face (&optional force)
- "Look for an X-Face header and display it if present."
- (interactive (list 'force))
- (let ((wash-face-p buffer-read-only)) ;; When type `W f'
- (gnus-with-article-headers
- ;; Delete the old process, if any.
- (when (process-status "article-x-face")
- (delete-process "article-x-face"))
- ;; See the comment in `article-display-face'.
- (if (and wash-face-p (memq 'xface gnus-article-wash-types))
- ;; We have already displayed X-Faces, so we remove them
- ;; instead.
- (gnus-delete-images 'xface)
- ;; Display X-Faces.
- (let (x-faces from face)
- (save-current-buffer
- (when (and wash-face-p
- (gnus-buffer-live-p gnus-original-article-buffer)
- (not (re-search-forward "^X-Face:[\t ]*" nil t)))
- ;; If type `W f', use gnus-original-article-buffer,
- ;; otherwise use the current buffer because displaying
- ;; RFC822 parts calls this function too.
- (set-buffer gnus-original-article-buffer))
- (save-restriction
- (mail-narrow-to-head)
- (while (gnus-article-goto-header "X-Face")
- (push (mail-header-field-value) x-faces))
- (setq from (message-fetch-field "from"))))
- ;; Sending multiple EOFs to xv doesn't work, so we only do a
- ;; single external face.
- (when (stringp gnus-article-x-face-command)
- (setq x-faces (list (car x-faces))))
- (when (and x-faces
- gnus-article-x-face-command
- (or force
- ;; Check whether this face is censored.
- (not gnus-article-x-face-too-ugly)
- (and from
- (not (string-match gnus-article-x-face-too-ugly
- from)))))
- (while (setq face (pop x-faces))
- ;; We display the face.
- (cond ((stringp gnus-article-x-face-command)
- ;; The command is a string, so we interpret the command
- ;; as a, well, command, and fork it off.
- (let ((process-connection-type nil))
- (gnus-set-process-query-on-exit-flag
- (start-process
- "article-x-face" nil shell-file-name
- shell-command-switch gnus-article-x-face-command)
- nil)
- (with-temp-buffer
- (insert face)
- (process-send-region "article-x-face"
- (point-min) (point-max)))
- (process-send-eof "article-x-face")))
- ((functionp gnus-article-x-face-command)
- ;; The command is a lisp function, so we call it.
- (funcall gnus-article-x-face-command face))
- (t
- (error "%s is not a function"
- gnus-article-x-face-command))))))))))
-
-(defun article-decode-mime-words ()
- "Decode all MIME-encoded words in the article."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
- (mail-decode-encoded-word-region (point-min) (point-max)))))
-
-(defun article-decode-charset (&optional prompt)
- "Decode charset-encoded text in the article.
-If PROMPT (the prefix), prompt for a coding system to use."
- (interactive "P")
- (let ((inhibit-point-motion-hooks t) (case-fold-search t)
- (inhibit-read-only t)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets))
- ct cte ctl charset format)
- (save-excursion
- (save-restriction
- (article-narrow-to-head)
- (setq ct (message-fetch-field "Content-Type" t)
- cte (message-fetch-field "Content-Transfer-Encoding" t)
- ctl (and ct (mail-header-parse-content-type ct))
- charset (cond
- (prompt
- (mm-read-coding-system "Charset to decode: "))
- (ctl
- (mail-content-type-get ctl 'charset)))
- format (and ctl (mail-content-type-get ctl 'format)))
- (when cte
- (setq cte (mail-header-strip cte)))
- (if (and ctl (not (string-match "/" (car ctl))))
- (setq ctl nil))
- (goto-char (point-max)))
- (forward-line 1)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (when (and (eq mail-parse-charset 'gnus-decoded)
- (eq (mm-body-7-or-8) '8bit))
- ;; The text code could have been decoded.
- (setq charset mail-parse-charset))
- (when (and (or (not ctl)
- (equal (car ctl) "text/plain"))
- (not format)) ;; article with format will decode later.
- (mm-decode-body
- charset (and cte (intern (downcase
- (gnus-strip-whitespace cte))))
- (car ctl)))))))
-
-(defun article-decode-encoded-words ()
- "Remove encoded-word encoding from headers."
- (let ((inhibit-point-motion-hooks t)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets))
- (inhibit-read-only t)
- end start)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil 'move)
- (forward-line -1))
- (setq end (point))
- (while (not (bobp))
- (while (progn
- (forward-line -1)
- (and (not (bobp))
- (memq (char-after) '(?\t ? )))))
- (setq start (point))
- (if (looking-at "\
-\\(?:Resent-\\)?\\(?:From\\|Cc\\|To\\|Bcc\\|\\(?:In-\\)?Reply-To\\|Sender\
-\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\):")
- (funcall gnus-decode-address-function start end)
- (funcall gnus-decode-header-function start end))
- (goto-char (setq end start)))))
-
-(defun article-decode-group-name ()
- "Decode group names in `Newsgroups:'."
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t)
- (method (gnus-find-method-for-group gnus-newsgroup-name)))
- (when (and (or gnus-group-name-charset-method-alist
- gnus-group-name-charset-group-alist)
- (gnus-buffer-live-p gnus-original-article-buffer))
- (save-restriction
- (article-narrow-to-head)
- (with-current-buffer gnus-original-article-buffer
- (goto-char (point-min)))
- (while (re-search-forward
- "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
- (replace-match (save-match-data
- (gnus-decode-newsgroups
- ;; XXX how to use data in article buffer?
- (with-current-buffer gnus-original-article-buffer
- (re-search-forward
- "^Newsgroups:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
- nil t)
- (match-string 1))
- gnus-newsgroup-name method))
- t t nil 1))
- (goto-char (point-min))
- (with-current-buffer gnus-original-article-buffer
- (goto-char (point-min)))
- (while (re-search-forward
- "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]" nil t)
- (replace-match (save-match-data
- (gnus-decode-newsgroups
- ;; XXX how to use data in article buffer?
- (with-current-buffer gnus-original-article-buffer
- (re-search-forward
- "^Followup-To:\\(\\(.\\|\n[\t ]\\)*\\)\n[^\t ]"
- nil t)
- (match-string 1))
- gnus-newsgroup-name method))
- t t nil 1))))))
-
-(autoload 'idna-to-unicode "idna")
-
-(defun article-decode-idna-rhs ()
- "Decode IDNA strings in RHS in various headers in current buffer.
-The following headers are decoded: From:, To:, Cc:, Reply-To:,
-Mail-Reply-To: and Mail-Followup-To:."
- (when gnus-use-idna
- (save-restriction
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (article-narrow-to-head)
- (goto-char (point-min))
- (while (re-search-forward "@[^ \t\n\r,>]*\\(xn--[-A-Za-z0-9.]*\\)[ \t\n\r,>]" nil t)
- (let (ace unicode)
- (when (save-match-data
- (and (setq ace (match-string 1))
- (save-excursion
- (and (re-search-backward "^[^ \t]" nil t)
- (looking-at "From\\|To\\|Cc\\|Reply-To\\|Mail-Reply-To\\|Mail-Followup-To")))
- (setq unicode (idna-to-unicode ace))))
- (unless (string= ace unicode)
- (replace-match unicode nil nil nil 1)))))))))
-
-(defun article-de-quoted-unreadable (&optional force read-charset)
- "Translate a quoted-printable-encoded article.
-If FORCE, decode the article whether it is marked as quoted-printable
-or not.
-If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
- (save-excursion
- (let ((inhibit-read-only t) type charset)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (setq type
- (gnus-fetch-field "content-transfer-encoding"))
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (if (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
- (unless charset
- (setq charset gnus-newsgroup-charset))
- (when (or force
- (and type (let ((case-fold-search t))
- (string-match "quoted-printable" type))))
- (article-goto-body)
- (quoted-printable-decode-region
- (point) (point-max) (mm-charset-to-coding-system charset))))))
-
-(defun article-de-base64-unreadable (&optional force read-charset)
- "Translate a base64 article.
-If FORCE, decode the article whether it is marked as base64 not.
-If READ-CHARSET, ask for a coding system."
- (interactive (list 'force current-prefix-arg))
- (save-excursion
- (let ((inhibit-read-only t) type charset)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (setq type
- (gnus-fetch-field "content-transfer-encoding"))
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (if (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (if read-charset
- (setq charset (mm-read-coding-system "Charset: " charset)))
- (unless charset
- (setq charset gnus-newsgroup-charset))
- (when (or force
- (and type (let ((case-fold-search t))
- (string-match "base64" type))))
- (article-goto-body)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (base64-decode-region (point-min) (point-max))
- (mm-decode-coding-region
- (point-min) (point-max) (mm-charset-to-coding-system charset)))))))
-
-(eval-when-compile
- (require 'rfc1843))
-
-(defun article-decode-HZ ()
- "Translate a HZ-encoded article."
- (interactive)
- (require 'rfc1843)
- (save-excursion
- (let ((inhibit-read-only t))
- (rfc1843-decode-region (point-min) (point-max)))))
-
-(defun article-unsplit-urls ()
- "Remove the newlines that some other mailers insert into URLs."
- (interactive)
- (save-excursion
- (let ((inhibit-read-only t))
- (goto-char (point-min))
- (while (re-search-forward
- "\\(\\(https?\\|ftp\\)://\\S-+\\) *\n\\(\\S-+\\)" nil t)
- (replace-match "\\1\\3" t)))
- (when (interactive-p)
- (gnus-treat-article nil))))
-
-
-(defun article-wash-html (&optional read-charset)
- "Format an HTML article.
-If READ-CHARSET, ask for a coding system. If it is a number, the
-charset defined in `gnus-summary-show-article-charset-alist' is used."
- (interactive "P")
- (save-excursion
- (let ((inhibit-read-only t)
- charset)
- (if read-charset
- (if (or (and (numberp read-charset)
- (setq charset
- (cdr
- (assq read-charset
- gnus-summary-show-article-charset-alist))))
- (setq charset (mm-read-coding-system "Charset: ")))
- (let ((gnus-summary-show-article-charset-alist
- (list (cons 1 charset))))
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-show-article 1)))
- (error "No charset is given"))
- (when (gnus-buffer-live-p gnus-original-article-buffer)
- (with-current-buffer gnus-original-article-buffer
- (let* ((ct (gnus-fetch-field "content-type"))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (setq charset (and ctl
- (mail-content-type-get ctl 'charset)))
- (when (stringp charset)
- (setq charset (intern (downcase charset)))))))
- (unless charset
- (setq charset gnus-newsgroup-charset)))
- (article-goto-body)
- (save-window-excursion
- (save-restriction
- (narrow-to-region (point) (point-max))
- (let* ((func (or gnus-article-wash-function mm-text-html-renderer))
- (entry (assq func mm-text-html-washer-alist)))
- (when entry
- (setq func (cdr entry)))
- (cond
- ((functionp func)
- (funcall func))
- (t
- (apply (car func) (cdr func))))))))))
-
-(defun gnus-article-wash-html-with-w3 ()
- "Wash the current buffer with w3."
- (mm-setup-w3)
- (let ((w3-strict-width (window-width))
- (url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil))
- (condition-case ()
- (w3-region (point-min) (point-max))
- (error))))
-
-(defun gnus-article-wash-html-with-w3m ()
- "Wash the current buffer with emacs-w3m."
- (mm-setup-w3m)
- (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
- w3m-force-redisplay)
- (w3m-region (point-min) (point-max)))
- (when (and mm-inline-text-html-with-w3m-keymap
- (boundp 'w3m-minor-mode-map)
- w3m-minor-mode-map)
- (add-text-properties
- (point-min) (point-max)
- (list 'keymap w3m-minor-mode-map
- ;; Put the mark meaning this part was rendered by emacs-w3m.
- 'mm-inline-text-html-with-w3m t))))
-
-(eval-when-compile (defvar charset)) ;; Bound by `article-wash-html'.
-
-(defun gnus-article-wash-html-with-w3m-standalone ()
- "Wash the current buffer with w3m."
- (if (mm-w3m-standalone-supports-m17n-p)
- (progn
- (unless (mm-coding-system-p charset) ;; Bound by `article-wash-html'.
- ;; The default.
- (setq charset 'iso-8859-1))
- (let ((coding-system-for-write charset)
- (coding-system-for-read charset))
- (call-process-region
- (point-min) (point-max)
- "w3m" t t nil "-dump" "-T" "text/html"
- "-I" (symbol-name charset) "-O" (symbol-name charset))))
- (mm-inline-wash-with-stdin nil "w3m" "-dump" "-T" "text/html")))
-
-(defun article-hide-list-identifiers ()
- "Remove list identifies from the Subject header.
-The `gnus-list-identifiers' variable specifies what to do."
- (interactive)
- (let ((inhibit-point-motion-hooks t)
- (regexp (if (consp gnus-list-identifiers)
- (mapconcat 'identity gnus-list-identifiers " *\\|")
- gnus-list-identifiers))
- (inhibit-read-only t))
- (when regexp
- (save-excursion
- (save-restriction
- (article-narrow-to-head)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
- nil t)
- (delete-region (match-beginning 2) (match-end 0))
- (beginning-of-line))
- (when (re-search-forward
- "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" nil t)
- (delete-region (match-beginning 1) (match-end 1))))))))
-
-(defun article-hide-pem (&optional arg)
- "Toggle hiding of any PEM headers and signatures in the current article.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
- (interactive (gnus-article-hidden-arg))
- (unless (gnus-article-check-hidden-text 'pem arg)
- (save-excursion
- (let ((inhibit-read-only t) end)
- (goto-char (point-min))
- ;; Hide the horrendously ugly "header".
- (when (and (search-forward
- "\n-----BEGIN PRIVACY-ENHANCED MESSAGE-----\n"
- nil t)
- (setq end (1+ (match-beginning 0))))
- (gnus-add-wash-type 'pem)
- (gnus-article-hide-text-type
- end
- (if (search-forward "\n\n" nil t)
- (match-end 0)
- (point-max))
- 'pem)
- ;; Hide the trailer as well
- (when (search-forward "\n-----END PRIVACY-ENHANCED MESSAGE-----\n"
- nil t)
- (gnus-article-hide-text-type
- (match-beginning 0) (match-end 0) 'pem)))))))
-
-(defun article-strip-banner ()
- "Strip the banners specified by the `banner' group parameter and by
-`gnus-article-address-banner-alist'."
- (interactive)
- (save-excursion
- (save-restriction
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-parameter-banner gnus-newsgroup-name)
- (article-really-strip-banner
- (gnus-parameter-banner gnus-newsgroup-name)))
- (when gnus-article-address-banner-alist
- ;; Note that the From header is decoded here, so it is
- ;; required that the *-extract-address-components function
- ;; supports non-ASCII text.
- (let ((from (save-restriction
- (widen)
- (article-narrow-to-head)
- (mail-fetch-field "from"))))
- (when (and from
- (setq from
- (cadr (funcall gnus-extract-address-components
- from))))
- (catch 'found
- (dolist (pair gnus-article-address-banner-alist)
- (when (string-match (car pair) from)
- (throw 'found
- (article-really-strip-banner (cdr pair)))))))))))))
-
-(defun article-really-strip-banner (banner)
- "Strip the banner specified by the argument."
- (save-excursion
- (save-restriction
- (let ((inhibit-point-motion-hooks t)
- (gnus-signature-limit nil)
- (inhibit-read-only t))
- (article-goto-body)
- (cond
- ((eq banner 'signature)
- (when (gnus-article-narrow-to-signature)
- (widen)
- (forward-line -1)
- (delete-region (point) (point-max))))
- ((symbolp banner)
- (if (setq banner (cdr (assq banner gnus-article-banner-alist)))
- (while (re-search-forward banner nil t)
- (delete-region (match-beginning 0) (match-end 0)))))
- ((stringp banner)
- (while (re-search-forward banner nil t)
- (delete-region (match-beginning 0) (match-end 0)))))))))
-
-(defun article-babel ()
- "Translate article using an online translation service."
- (interactive)
- (require 'babel)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (when (article-goto-body)
- (let* ((inhibit-read-only t)
- (start (point))
- (end (point-max))
- (orig (buffer-substring start end))
- (trans (babel-as-string orig)))
- (save-restriction
- (narrow-to-region start end)
- (delete-region start end)
- (insert trans))))))
-
-(defun article-hide-signature (&optional arg)
- "Hide the signature in the current article.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
- (interactive (gnus-article-hidden-arg))
- (unless (gnus-article-check-hidden-text 'signature arg)
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t))
- (when (gnus-article-narrow-to-signature)
- (gnus-article-hide-text-type
- (point-min) (point-max) 'signature))))))
- (gnus-set-mode-line 'article))
-
-(defun article-strip-headers-in-body ()
- "Strip offensive headers from bodies."
- (interactive)
- (save-excursion
- (article-goto-body)
- (let ((case-fold-search t))
- (when (looking-at "x-no-archive:")
- (gnus-delete-line)))))
-
-(defun article-strip-leading-blank-lines ()
- "Remove all blank lines from the beginning of the article."
- (interactive)
- (save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (when (article-goto-body)
- (while (and (not (eobp))
- (looking-at "[ \t]*$"))
- (gnus-delete-line))))))
-
-(defun article-narrow-to-head ()
- "Narrow the buffer to the head of the message.
-Point is left at the beginning of the narrowed-to region."
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil 1)
- (1- (point))
- (point-max)))
- (goto-char (point-min)))
-
-(defun article-goto-body ()
- "Place point at the start of the body."
- (goto-char (point-min))
- (cond
- ;; This variable is only bound when dealing with separate
- ;; MIME body parts.
- (article-goto-body-goes-to-point-min-p
- t)
- ((search-forward "\n\n" nil t)
- t)
- (t
- (goto-char (point-max))
- nil)))
-
-(defun article-strip-multiple-blank-lines ()
- "Replace consecutive blank lines with one empty line."
- (interactive)
- (save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- ;; First make all blank lines empty.
- (article-goto-body)
- (while (re-search-forward "^[ \t]+$" nil t)
- (unless (gnus-annotation-in-region-p
- (match-beginning 0) (match-end 0))
- (replace-match "" nil t)))
- ;; Then replace multiple empty lines with a single empty line.
- (article-goto-body)
- (while (re-search-forward "\n\n\\(\n+\\)" nil t)
- (unless (gnus-annotation-in-region-p
- (match-beginning 0) (match-end 0))
- (delete-region (match-beginning 1) (match-end 1)))))))
-
-(defun article-strip-leading-space ()
- "Remove all white space from the beginning of the lines in the article."
- (interactive)
- (save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (article-goto-body)
- (while (re-search-forward "^[ \t]+" nil t)
- (replace-match "" t t)))))
-
-(defun article-strip-trailing-space ()
- "Remove all white space from the end of the lines in the article."
- (interactive)
- (save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (article-goto-body)
- (while (re-search-forward "[ \t]+$" nil t)
- (replace-match "" t t)))))
-
-(defun article-strip-blank-lines ()
- "Strip leading, trailing and multiple blank lines."
- (interactive)
- (article-strip-leading-blank-lines)
- (article-remove-trailing-blank-lines)
- (article-strip-multiple-blank-lines))
-
-(defun article-strip-all-blank-lines ()
- "Strip all blank lines."
- (interactive)
- (save-excursion
- (let ((inhibit-point-motion-hooks t)
- (inhibit-read-only t))
- (article-goto-body)
- (while (re-search-forward "^[ \t]*\n" nil t)
- (replace-match "" t t)))))
-
-(defun gnus-article-narrow-to-signature ()
- "Narrow to the signature; return t if a signature is found, else nil."
- (let ((inhibit-point-motion-hooks t))
- (when (gnus-article-search-signature)
- (forward-line 1)
- ;; Check whether we have some limits to what we consider
- ;; to be a signature.
- (let ((limits (if (listp gnus-signature-limit) gnus-signature-limit
- (list gnus-signature-limit)))
- limit limited)
- (while (setq limit (pop limits))
- (if (or (and (integerp limit)
- (< (- (point-max) (point)) limit))
- (and (floatp limit)
- (< (count-lines (point) (point-max)) limit))
- (and (functionp limit)
- (funcall limit))
- (and (stringp limit)
- (not (re-search-forward limit nil t))))
- () ; This limit did not succeed.
- (setq limited t
- limits nil)))
- (unless limited
- (narrow-to-region (point) (point-max))
- t)))))
-
-(defun gnus-article-search-signature ()
- "Search the current buffer for the signature separator.
-Put point at the beginning of the signature separator."
- (let ((cur (point)))
- (goto-char (point-max))
- (if (if (stringp gnus-signature-separator)
- (re-search-backward gnus-signature-separator nil t)
- (let ((seps gnus-signature-separator))
- (while (and seps
- (not (re-search-backward (car seps) nil t)))
- (pop seps))
- seps))
- t
- (goto-char cur)
- nil)))
-
-(defun gnus-article-hidden-arg ()
- "Return the current prefix arg as a number, or 0 if no prefix."
- (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- 0)))
-
-(defun gnus-article-check-hidden-text (type arg)
- "Return nil if hiding is necessary.
-Arg can be nil or a number. nil and positive means hide, negative
-means show, 0 means toggle."
- (save-excursion
- (save-restriction
- (let ((hide (gnus-article-hidden-text-p type)))
- (cond
- ((or (null arg)
- (> arg 0))
- nil)
- ((< arg 0)
- (gnus-article-show-hidden-text type)
- t)
- (t
- (if (eq hide 'hidden)
- (progn
- (gnus-article-show-hidden-text type)
- t)
- nil)))))))
-
-(defun gnus-article-hidden-text-p (type)
- "Say whether the current buffer contains hidden text of type TYPE."
- (let ((pos (text-property-any (point-min) (point-max) 'article-type type)))
- (while (and pos
- (not (get-text-property pos 'invisible))
- (not (get-text-property pos 'dummy-invisible)))
- (setq pos
- (text-property-any (1+ pos) (point-max) 'article-type type)))
- (if pos
- 'hidden
- nil)))
-
-(defun gnus-article-show-hidden-text (type &optional dummy)
- "Show all hidden text of type TYPE.
-Originally it is hide instead of DUMMY."
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
- (gnus-remove-text-properties-when
- 'article-type type
- (point-min) (point-max)
- (cons 'article-type (cons type
- gnus-hidden-properties)))
- (gnus-delete-wash-type type)))
-
-(defconst article-time-units
- `((year . ,(* 365.25 24 60 60))
- (week . ,(* 7 24 60 60))
- (day . ,(* 24 60 60))
- (hour . ,(* 60 60))
- (minute . 60)
- (second . 1))
- "Mapping from time units to seconds.")
-
-(defun gnus-article-forward-header ()
- "Move point to the start of the next header.
-If the current header is a continuation header, this can be several
-lines forward."
- (let ((ended nil))
- (while (not ended)
- (forward-line 1)
- (if (looking-at "[ \t]+[^ \t]")
- (forward-line 1)
- (setq ended t)))))
-
-(defun article-date-ut (&optional type highlight)
- "Convert DATE date to universal time in the current article.
-If TYPE is `local', convert to local time; if it is `lapsed', output
-how much time has lapsed since DATE. For `lapsed', the value of
-`gnus-article-date-lapsed-new-header' says whether the \"X-Sent:\" header
-should replace the \"Date:\" one, or should be added below it."
- (interactive (list 'ut t))
- (let* ((tdate-regexp "^Date:[ \t]\\|^X-Sent:[ \t]")
- (date-regexp (cond ((not gnus-article-date-lapsed-new-header)
- tdate-regexp)
- ((eq type 'lapsed)
- "^X-Sent:[ \t]")
- (article-lapsed-timer
- "^Date:[ \t]")
- (t
- tdate-regexp)))
- (case-fold-search t)
- (inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- pos date bface eface)
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (while (or (setq date (get-text-property (setq pos (point))
- 'original-date))
- (when (setq pos (next-single-property-change
- (point) 'original-date))
- (setq date (get-text-property pos 'original-date))
- t))
- (narrow-to-region pos (or (text-property-any pos (point-max)
- 'original-date nil)
- (point-max)))
- (goto-char (point-min))
- (when (re-search-forward tdate-regexp nil t)
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- eface (get-text-property (1- (gnus-point-at-eol)) 'face)))
- (goto-char (point-min))
- (setq pos nil)
- ;; Delete any old Date headers.
- (while (re-search-forward date-regexp nil t)
- (if pos
- (delete-region (gnus-point-at-bol)
- (progn
- (gnus-article-forward-header)
- (point)))
- (delete-region (gnus-point-at-bol)
- (progn
- (gnus-article-forward-header)
- (forward-char -1)
- (point)))
- (setq pos (point))))
- (when (and (not pos)
- (re-search-forward tdate-regexp nil t))
- (forward-line 1))
- (gnus-goto-char pos)
- (insert (article-make-date-line date (or type 'ut)))
- (unless pos
- (insert "\n")
- (forward-line -1))
- ;; Do highlighting.
- (beginning-of-line)
- (when (looking-at "\\([^:]+\\): *\\(.*\\)$")
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'face bface)
- (put-text-property (match-beginning 2) (match-end 2)
- 'face eface))
- (put-text-property (point-min) (1- (point-max)) 'original-date date)
- (goto-char (point-max))
- (widen))))))
-
-(defun article-make-date-line (date type)
- "Return a DATE line of TYPE."
- (unless (memq type '(local ut original user iso8601 lapsed english))
- (error "Unknown conversion type: %s" type))
- (condition-case ()
- (let ((time (date-to-time date)))
- (cond
- ;; Convert to the local timezone.
- ((eq type 'local)
- (let ((tz (car (current-time-zone time))))
- (format "Date: %s %s%02d%02d" (current-time-string time)
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
- (/ (% (abs tz) 3600) 60))))
- ;; Convert to Universal Time.
- ((eq type 'ut)
- (concat "Date: "
- (current-time-string
- (let* ((e (parse-time-string date))
- (tm (apply 'encode-time e))
- (ms (car tm))
- (ls (- (cadr tm) (car (current-time-zone time)))))
- (cond ((< ls 0) (list (1- ms) (+ ls 65536)))
- ((> ls 65535) (list (1+ ms) (- ls 65536)))
- (t (list ms ls)))))
- " UT"))
- ;; Get the original date from the article.
- ((eq type 'original)
- (concat "Date: " (if (string-match "\n+$" date)
- (substring date 0 (match-beginning 0))
- date)))
- ;; Let the user define the format.
- ((eq type 'user)
- (let ((format (or (condition-case nil
- (with-current-buffer gnus-summary-buffer
- gnus-article-time-format)
- (error nil))
- gnus-article-time-format)))
- (if (functionp format)
- (funcall format time)
- (concat "Date: " (format-time-string format time)))))
- ;; ISO 8601.
- ((eq type 'iso8601)
- (let ((tz (car (current-time-zone time))))
- (concat
- "Date: "
- (format-time-string "%Y%m%dT%H%M%S" time)
- (format "%s%02d%02d"
- (if (> tz 0) "+" "-") (/ (abs tz) 3600)
- (/ (% (abs tz) 3600) 60)))))
- ;; Do an X-Sent lapsed format.
- ((eq type 'lapsed)
- ;; If the date is seriously mangled, the timezone functions are
- ;; liable to bug out, so we ignore all errors.
- (let* ((now (current-time))
- (real-time (subtract-time now time))
- (real-sec (and real-time
- (+ (* (float (car real-time)) 65536)
- (cadr real-time))))
- (sec (and real-time (abs real-sec)))
- num prev)
- (cond
- ((null real-time)
- "X-Sent: Unknown")
- ((zerop sec)
- "X-Sent: Now")
- (t
- (concat
- "X-Sent: "
- ;; This is a bit convoluted, but basically we go
- ;; through the time units for years, weeks, etc,
- ;; and divide things to see whether that results
- ;; in positive answers.
- (mapconcat
- (lambda (unit)
- (if (zerop (setq num (ffloor (/ sec (cdr unit)))))
- ;; The (remaining) seconds are too few to
- ;; be divided into this time unit.
- ""
- ;; It's big enough, so we output it.
- (setq sec (- sec (* num (cdr unit))))
- (prog1
- (concat (if prev ", " "") (int-to-string
- (floor num))
- " " (symbol-name (car unit))
- (if (> num 1) "s" ""))
- (setq prev t))))
- article-time-units "")
- ;; If dates are odd, then it might appear like the
- ;; article was sent in the future.
- (if (> real-sec 0)
- " ago"
- " in the future"))))))
- ;; Display the date in proper English
- ((eq type 'english)
- (let ((dtime (decode-time time)))
- (concat
- "Date: the "
- (number-to-string (nth 3 dtime))
- (let ((digit (% (nth 3 dtime) 10)))
- (cond
- ((memq (nth 3 dtime) '(11 12 13)) "th")
- ((= digit 1) "st")
- ((= digit 2) "nd")
- ((= digit 3) "rd")
- (t "th")))
- " of "
- (nth (1- (nth 4 dtime)) gnus-english-month-names)
- " "
- (number-to-string (nth 5 dtime))
- " at "
- (format "%02d" (nth 2 dtime))
- ":"
- (format "%02d" (nth 1 dtime)))))))
- (error
- (format "Date: %s (from Gnus)" date))))
-
-(defun article-date-local (&optional highlight)
- "Convert the current article date to the local timezone."
- (interactive (list t))
- (article-date-ut 'local highlight))
-
-(defun article-date-english (&optional highlight)
- "Convert the current article date to something that is proper English."
- (interactive (list t))
- (article-date-ut 'english highlight))
-
-(defun article-date-original (&optional highlight)
- "Convert the current article date to what it was originally.
-This is only useful if you have used some other date conversion
-function and want to see what the date was before converting."
- (interactive (list t))
- (article-date-ut 'original highlight))
-
-(defun article-date-lapsed (&optional highlight)
- "Convert the current article date to time lapsed since it was sent."
- (interactive (list t))
- (article-date-ut 'lapsed highlight))
-
-(defun article-update-date-lapsed ()
- "Function to be run from a timer to update the lapsed time line."
- (save-match-data
- (let (deactivate-mark)
- (save-excursion
- (ignore-errors
- (walk-windows
- (lambda (w)
- (set-buffer (window-buffer w))
- (when (eq major-mode 'gnus-article-mode)
- (let ((mark (point-marker)))
- (goto-char (point-min))
- (when (re-search-forward "^X-Sent:" nil t)
- (article-date-lapsed t))
- (goto-char (marker-position mark))
- (move-marker mark nil))))
- nil 'visible))))))
-
-(defun gnus-start-date-timer (&optional n)
- "Start a timer to update the X-Sent header in the article buffers.
-The numerical prefix says how frequently (in seconds) the function
-is to run."
- (interactive "p")
- (unless n
- (setq n 1))
- (gnus-stop-date-timer)
- (setq article-lapsed-timer
- (nnheader-run-at-time 1 n 'article-update-date-lapsed)))
-
-(defun gnus-stop-date-timer ()
- "Stop the X-Sent timer."
- (interactive)
- (when article-lapsed-timer
- (nnheader-cancel-timer article-lapsed-timer)
- (setq article-lapsed-timer nil)))
-
-(defun article-date-user (&optional highlight)
- "Convert the current article date to the user-defined format.
-This format is defined by the `gnus-article-time-format' variable."
- (interactive (list t))
- (article-date-ut 'user highlight))
-
-(defun article-date-iso8601 (&optional highlight)
- "Convert the current article date to ISO8601."
- (interactive (list t))
- (article-date-ut 'iso8601 highlight))
-
-(defmacro gnus-article-save-original-date (&rest forms)
- "Save the original date as a text property and evaluate FORMS."
- `(let* ((case-fold-search t)
- (start (progn
- (goto-char (point-min))
- (when (and (re-search-forward "^date:[\t\n ]+" nil t)
- (not (bolp)))
- (match-end 0))))
- (date (when (and start
- (re-search-forward "[\t ]*\n\\([^\t ]\\|\\'\\)"
- nil t))
- (buffer-substring-no-properties start
- (match-beginning 0)))))
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (put-text-property (point-min) (point) 'original-date date)
- ,@forms
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (put-text-property (point-min) (point) 'original-date date)))
-
-;; (defun article-show-all ()
-;; "Show all hidden text in the article buffer."
-;; (interactive)
-;; (save-excursion
-;; (let ((inhibit-read-only t))
-;; (gnus-article-unhide-text (point-min) (point-max)))))
-
-(defun article-remove-leading-whitespace ()
- "Remove excessive whitespace from all headers."
- (interactive)
- (save-excursion
- (save-restriction
- (let ((inhibit-read-only t))
- (article-narrow-to-head)
- (goto-char (point-min))
- (while (re-search-forward "^[^ :]+: \\([ \t]+\\)" nil t)
- (delete-region (match-beginning 1) (match-end 1)))))))
-
-(defun article-emphasize (&optional arg)
- "Emphasize text according to `gnus-emphasis-alist'."
- (interactive (gnus-article-hidden-arg))
- (unless (gnus-article-check-hidden-text 'emphasis arg)
- (save-excursion
- (let ((alist (or
- (condition-case nil
- (with-current-buffer gnus-summary-buffer
- gnus-article-emphasis-alist)
- (error))
- gnus-emphasis-alist))
- (inhibit-read-only t)
- (props (append '(article-type emphasis)
- gnus-hidden-properties))
- regexp elem beg invisible visible face)
- (article-goto-body)
- (setq beg (point))
- (while (setq elem (pop alist))
- (goto-char beg)
- (setq regexp (car elem)
- invisible (nth 1 elem)
- visible (nth 2 elem)
- face (nth 3 elem))
- (while (re-search-forward regexp nil t)
- (when (and (match-beginning visible) (match-beginning invisible))
- (gnus-article-hide-text
- (match-beginning invisible) (match-end invisible) props)
- (gnus-article-unhide-text-type
- (match-beginning visible) (match-end visible) 'emphasis)
- (gnus-put-overlay-excluding-newlines
- (match-beginning visible) (match-end visible) 'face face)
- (gnus-add-wash-type 'emphasis)
- (goto-char (match-end invisible)))))))))
-
-(defun gnus-article-setup-highlight-words (&optional highlight-words)
- "Setup newsgroup emphasis alist."
- (unless gnus-article-emphasis-alist
- (let ((name (and gnus-newsgroup-name
- (gnus-group-real-name gnus-newsgroup-name))))
- (make-local-variable 'gnus-article-emphasis-alist)
- (setq gnus-article-emphasis-alist
- (nconc
- (let ((alist gnus-group-highlight-words-alist) elem highlight)
- (while (setq elem (pop alist))
- (when (and name (string-match (car elem) name))
- (setq alist nil
- highlight (copy-sequence (cdr elem)))))
- highlight)
- (copy-sequence highlight-words)
- (if gnus-newsgroup-name
- (copy-sequence (gnus-group-find-parameter
- gnus-newsgroup-name 'highlight-words t)))
- gnus-emphasis-alist)))))
-
-(eval-when-compile
- (defvar gnus-summary-article-menu)
- (defvar gnus-summary-post-menu))
-
-;;; Saving functions.
-
-(defun gnus-article-save (save-buffer file &optional num)
- "Save the currently selected article."
- (when (or (get gnus-default-article-saver :headers)
- (not gnus-save-all-headers))
- ;; Remove headers according to `gnus-saved-headers' or the value
- ;; of the `:headers' property that the saver function might have.
- (let ((gnus-visible-headers
- (or (symbol-value (get gnus-default-article-saver :headers))
- gnus-saved-headers gnus-visible-headers))
- (gnus-article-buffer save-buffer))
- (save-excursion
- (set-buffer save-buffer)
- (article-hide-headers 1 t))))
- (save-window-excursion
- (if (not gnus-default-article-saver)
- (error "No default saver is defined")
- ;; !!! Magic! The saving functions all save
- ;; `gnus-save-article-buffer' (or so they think), but we
- ;; bind that variable to our save-buffer.
- (set-buffer gnus-article-buffer)
- (let* ((gnus-save-article-buffer save-buffer)
- (filename
- (cond
- ((not gnus-prompt-before-saving) 'default)
- ((eq gnus-prompt-before-saving 'always) nil)
- (t file)))
- (gnus-number-of-articles-to-be-saved
- (when (eq gnus-prompt-before-saving t)
- num))) ; Magic
- (set-buffer gnus-article-current-summary)
- (funcall gnus-default-article-saver filename)))))
-
-(defun gnus-read-save-file-name (prompt &optional filename
- function group headers variable
- dir-var)
- (let ((default-name
- (funcall function group headers (symbol-value variable)))
- result)
- (setq result
- (expand-file-name
- (cond
- ((eq filename 'default)
- default-name)
- ((eq filename t)
- default-name)
- (filename filename)
- (t
- (when (symbol-value dir-var)
- (setq default-name (expand-file-name
- (file-name-nondirectory default-name)
- (symbol-value dir-var))))
- (let* ((split-name (gnus-get-split-value gnus-split-methods))
- (prompt
- (format prompt
- (if (and gnus-number-of-articles-to-be-saved
- (> gnus-number-of-articles-to-be-saved 1))
- (format "these %d articles"
- gnus-number-of-articles-to-be-saved)
- "this article")))
- (file
- ;; Let the split methods have their say.
- (cond
- ;; No split name was found.
- ((null split-name)
- (read-file-name
- (concat prompt " (default "
- (file-name-nondirectory default-name) "): ")
- (file-name-directory default-name)
- default-name))
- ;; A single group name is returned.
- ((stringp split-name)
- (setq default-name
- (funcall function split-name headers
- (symbol-value variable)))
- (read-file-name
- (concat prompt " (default "
- (file-name-nondirectory default-name) "): ")
- (file-name-directory default-name)
- default-name))
- ;; A single split name was found
- ((= 1 (length split-name))
- (let* ((name (expand-file-name
- (car split-name)
- gnus-article-save-directory))
- (dir (cond ((file-directory-p name)
- (file-name-as-directory name))
- ((file-exists-p name) name)
- (t gnus-article-save-directory))))
- (read-file-name
- (concat prompt " (default " name "): ")
- dir name)))
- ;; A list of splits was found.
- (t
- (setq split-name (nreverse split-name))
- (let (result)
- (let ((file-name-history
- (nconc split-name file-name-history)))
- (setq result
- (expand-file-name
- (read-file-name
- (concat prompt " (`M-p' for defaults): ")
- gnus-article-save-directory
- (car split-name))
- gnus-article-save-directory)))
- (car (push result file-name-history)))))))
- ;; Create the directory.
- (gnus-make-directory (file-name-directory file))
- ;; If we have read a directory, we append the default file name.
- (when (file-directory-p file)
- (setq file (expand-file-name (file-name-nondirectory
- default-name)
- (file-name-as-directory file))))
- ;; Possibly translate some characters.
- (nnheader-translate-file-chars file))))))
- (gnus-make-directory (file-name-directory result))
- (when variable
- (set variable result))
- (when dir-var
- (set dir-var (file-name-directory result)))
- result))
-
-(defun gnus-article-archive-name (group)
- "Return the first instance of an \"Archive-name\" in the current buffer."
- (let ((case-fold-search t))
- (when (re-search-forward "archive-name: *\\([^ \n\t]+\\)[ \t]*$" nil t)
- (nnheader-concat gnus-article-save-directory
- (match-string 1)))))
-
-(defun gnus-article-nndoc-name (group)
- "If GROUP is an nndoc group, return the name of the parent group."
- (when (eq (car (gnus-find-method-for-group group)) 'nndoc)
- (gnus-group-get-parameter group 'save-article-group)))
-
-(defun gnus-summary-save-in-rmail (&optional filename)
- "Append this article to Rmail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s in rmail file" filename
- gnus-rmail-save-name gnus-newsgroup-name
- gnus-current-headers 'gnus-newsgroup-last-rmail))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (gnus-output-to-rmail filename))))
- filename)
-
-(defun gnus-summary-save-in-mail (&optional filename)
- "Append this article to Unix mail file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s in Unix mail file" filename
- gnus-mail-save-name gnus-newsgroup-name
- gnus-current-headers 'gnus-newsgroup-last-mail))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (if (and (file-readable-p filename)
- (file-regular-p filename)
- (mail-file-babyl-p filename))
- (rmail-output-to-rmail-file filename t)
- (gnus-output-to-mail filename)))))
- filename)
-
-(put 'gnus-summary-save-in-file :decode t)
-(put 'gnus-summary-save-in-file :headers 'gnus-saved-headers)
-(defun gnus-summary-save-in-file (&optional filename overwrite)
- "Append this article to file.
-Optional argument FILENAME specifies file name.
-Directory to save to is default to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s in file" filename
- gnus-file-save-name gnus-newsgroup-name
- gnus-current-headers 'gnus-newsgroup-last-file))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (when (and overwrite
- (file-exists-p filename))
- (delete-file filename))
- (gnus-output-to-file filename))))
- filename)
-
-(put 'gnus-summary-write-to-file :decode t)
-(put 'gnus-summary-write-to-file :function 'gnus-summary-save-in-file)
-(put 'gnus-summary-write-to-file :headers 'gnus-saved-headers)
-(defun gnus-summary-write-to-file (&optional filename)
- "Write this article to a file, overwriting it if the file exists.
-Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s in file" filename
- gnus-file-save-name gnus-newsgroup-name
- gnus-current-headers nil 'gnus-newsgroup-last-directory))
- (gnus-summary-save-in-file filename t))
-
-(put 'gnus-summary-save-body-in-file :decode t)
-(defun gnus-summary-save-body-in-file (&optional filename overwrite)
- "Append this article body to a file.
-Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s body in file" filename
- gnus-file-save-name gnus-newsgroup-name
- gnus-current-headers 'gnus-newsgroup-last-file))
- (gnus-eval-in-buffer-window gnus-save-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (when (article-goto-body)
- (narrow-to-region (point) (point-max)))
- (when (and overwrite
- (file-exists-p filename))
- (delete-file filename))
- (gnus-output-to-file filename))))
- filename)
-
-(put 'gnus-summary-write-body-to-file :decode t)
-(put 'gnus-summary-write-body-to-file
- :function 'gnus-summary-save-body-in-file)
-(defun gnus-summary-write-body-to-file (&optional filename)
- "Write this article body to a file, overwriting it if the file exists.
-Optional argument FILENAME specifies file name.
-The directory to save in defaults to `gnus-article-save-directory'."
- (setq filename (gnus-read-save-file-name
- "Save %s body in file" filename
- gnus-file-save-name gnus-newsgroup-name
- gnus-current-headers nil 'gnus-newsgroup-last-directory))
- (gnus-summary-save-body-in-file filename t))
-
-(defun gnus-summary-save-in-pipe (&optional command)
- "Pipe this article to subprocess."
- (setq command
- (cond ((and (eq command 'default)
- gnus-last-shell-command)
- gnus-last-shell-command)
- ((stringp command)
- command)
- (t (read-string
- (format
- "Shell command on %s: "
- (if (and gnus-number-of-articles-to-be-saved
- (> gnus-number-of-articles-to-be-saved 1))
- (format "these %d articles"
- gnus-number-of-articles-to-be-saved)
- "this article"))
- gnus-last-shell-command))))
- (when (string-equal command "")
- (if gnus-last-shell-command
- (setq command gnus-last-shell-command)
- (error "A command is required")))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (shell-command-on-region (point-min) (point-max) command nil)))
- (setq gnus-last-shell-command command))
-
-(defmacro gnus-read-string (prompt &optional initial-contents history
- default-value)
- "Like `read-string' but allow for older XEmacsen that don't have the 5th arg."
- (if (and (featurep 'xemacs)
- (< emacs-minor-version 2))
- `(read-string ,prompt ,initial-contents ,history)
- `(read-string ,prompt ,initial-contents ,history ,default-value)))
-
-(defun gnus-summary-pipe-to-muttprint (&optional command)
- "Pipe this article to muttprint."
- (setq command (gnus-read-string
- "Print using command: " gnus-summary-muttprint-program
- nil gnus-summary-muttprint-program))
- (gnus-summary-save-in-pipe command))
-
-;;; Article file names when saving.
-
-(defun gnus-capitalize-newsgroup (newsgroup)
- "Capitalize NEWSGROUP name."
- (when (not (zerop (length newsgroup)))
- (concat (char-to-string (upcase (aref newsgroup 0)))
- (substring newsgroup 1))))
-
-(defun gnus-Numeric-save-name (newsgroup headers &optional last-file)
- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is ~/News/News.group/num.
-Otherwise, it is like ~/News/news/group/num."
- (let ((default
- (expand-file-name
- (concat (if (gnus-use-long-file-name 'not-save)
- (gnus-capitalize-newsgroup newsgroup)
- (gnus-newsgroup-directory-form newsgroup))
- "/" (int-to-string (mail-header-number headers)))
- gnus-article-save-directory)))
- (if (and last-file
- (string-equal (file-name-directory default)
- (file-name-directory last-file))
- (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
- default
- (or last-file default))))
-
-(defun gnus-numeric-save-name (newsgroup headers &optional last-file)
- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/news.group/num. Otherwise, it is like ~/News/news/group/num."
- (let ((default
- (expand-file-name
- (concat (if (gnus-use-long-file-name 'not-save)
- newsgroup
- (gnus-newsgroup-directory-form newsgroup))
- "/" (int-to-string (mail-header-number headers)))
- gnus-article-save-directory)))
- (if (and last-file
- (string-equal (file-name-directory default)
- (file-name-directory last-file))
- (string-match "^[0-9]+$" (file-name-nondirectory last-file)))
- default
- (or last-file default))))
-
-(defun gnus-plain-save-name (newsgroup headers &optional last-file)
- "Generate file name from NEWSGROUP, HEADERS, and optional LAST-FILE.
-If variable `gnus-use-long-file-name' is non-nil, it is
-~/News/news.group. Otherwise, it is like ~/News/news/group/news."
- (or last-file
- (expand-file-name
- (if (gnus-use-long-file-name 'not-save)
- newsgroup
- (file-relative-name
- (expand-file-name "news" (gnus-newsgroup-directory-form newsgroup))
- default-directory))
- gnus-article-save-directory)))
-
-(defun gnus-sender-save-name (newsgroup headers &optional last-file)
- "Generate file name from sender."
- (let ((from (mail-header-from headers)))
- (expand-file-name
- (if (and from (string-match "\\([^ <]+\\)@" from))
- (match-string 1 from)
- "nobody")
- gnus-article-save-directory)))
-
-(defun article-verify-x-pgp-sig ()
- "Verify X-PGP-Sig."
- (interactive)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (let ((sig (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "X-PGP-Sig")))
- items info headers)
- (when (and sig
- mml2015-use
- (mml2015-clear-verify-function))
- (with-temp-buffer
- (insert-buffer-substring gnus-original-article-buffer)
- (setq items (split-string sig))
- (message-narrow-to-head)
- (let ((inhibit-point-motion-hooks t)
- (case-fold-search t))
- ;; Don't verify multiple headers.
- (setq headers (mapconcat (lambda (header)
- (concat header ": "
- (mail-fetch-field header)
- "\n"))
- (split-string (nth 1 items) ",") "")))
- (delete-region (point-min) (point-max))
- (insert "-----BEGIN PGP SIGNED MESSAGE-----\n\n")
- (insert "X-Signed-Headers: " (nth 1 items) "\n")
- (insert headers)
- (widen)
- (forward-line)
- (while (not (eobp))
- (if (looking-at "^-")
- (insert "- "))
- (forward-line))
- (insert "\n-----BEGIN PGP SIGNATURE-----\n")
- (insert "Version: " (car items) "\n\n")
- (insert (mapconcat 'identity (cddr items) "\n"))
- (insert "\n-----END PGP SIGNATURE-----\n")
- (let ((mm-security-handle (list (format "multipart/signed"))))
- (mml2015-clean-buffer)
- (let ((coding-system-for-write (or gnus-newsgroup-charset
- 'iso-8859-1)))
- (funcall (mml2015-clear-verify-function)))
- (setq info
- (or (mm-handle-multipart-ctl-parameter
- mm-security-handle 'gnus-details)
- (mm-handle-multipart-ctl-parameter
- mm-security-handle 'gnus-info)))))
- (when info
- (let ((inhibit-read-only t) bface eface)
- (save-restriction
- (message-narrow-to-head)
- (goto-char (point-max))
- (forward-line -1)
- (setq bface (get-text-property (gnus-point-at-bol) 'face)
- eface (get-text-property (1- (gnus-point-at-eol)) 'face))
- (message-remove-header "X-Gnus-PGP-Verify")
- (if (re-search-forward "^X-PGP-Sig:" nil t)
- (forward-line)
- (goto-char (point-max)))
- (narrow-to-region (point) (point))
- (insert "X-Gnus-PGP-Verify: " info "\n")
- (goto-char (point-min))
- (forward-line)
- (while (not (eobp))
- (if (not (looking-at "^[ \t]"))
- (insert " "))
- (forward-line))
- ;; Do highlighting.
- (goto-char (point-min))
- (when (looking-at "\\([^:]+\\): *")
- (put-text-property (match-beginning 1) (1+ (match-end 1))
- 'face bface)
- (put-text-property (match-end 0) (point-max)
- 'face eface)))))))))
-
-(defun article-verify-cancel-lock ()
- "Verify Cancel-Lock header."
- (interactive)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (canlock-verify gnus-original-article-buffer)))
-
-(eval-and-compile
- (mapcar
- (lambda (func)
- (let (afunc gfunc)
- (if (consp func)
- (setq afunc (car func)
- gfunc (cdr func))
- (setq afunc func
- gfunc (intern (format "gnus-%s" func))))
- (defalias gfunc
- (when (fboundp afunc)
- `(lambda (&optional interactive &rest args)
- ,(documentation afunc t)
- (interactive (list t))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (if interactive
- (call-interactively ',afunc)
- (apply ',afunc args))))))))
- '(article-hide-headers
- article-verify-x-pgp-sig
- article-verify-cancel-lock
- article-hide-boring-headers
- article-treat-overstrike
- article-fill-long-lines
- article-capitalize-sentences
- article-remove-cr
- article-remove-leading-whitespace
- article-display-x-face
- article-display-face
- article-de-quoted-unreadable
- article-de-base64-unreadable
- article-decode-HZ
- article-wash-html
- article-unsplit-urls
- article-hide-list-identifiers
- article-strip-banner
- article-babel
- article-hide-pem
- article-hide-signature
- article-strip-headers-in-body
- article-remove-trailing-blank-lines
- article-strip-leading-blank-lines
- article-strip-multiple-blank-lines
- article-strip-leading-space
- article-strip-trailing-space
- article-strip-blank-lines
- article-strip-all-blank-lines
- article-date-local
- article-date-english
- article-date-iso8601
- article-date-original
- article-date-ut
- article-decode-mime-words
- article-decode-charset
- article-decode-encoded-words
- article-date-user
- article-date-lapsed
- article-emphasize
- article-treat-dumbquotes
- article-normalize-headers
-;; (article-show-all . gnus-article-show-all-headers)
- )))
-\f
-;;;
-;;; Gnus article mode
-;;;
-
-(put 'gnus-article-mode 'mode-class 'special)
-
-(set-keymap-parent gnus-article-mode-map widget-keymap)
-
-(gnus-define-keys gnus-article-mode-map
- " " gnus-article-goto-next-page
- "\177" gnus-article-goto-prev-page
- [delete] gnus-article-goto-prev-page
- [backspace] gnus-article-goto-prev-page
- "\C-c^" gnus-article-refer-article
- "h" gnus-article-show-summary
- "s" gnus-article-show-summary
- "\C-c\C-m" gnus-article-mail
- "?" gnus-article-describe-briefly
- "e" gnus-summary-edit-article
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug
- "R" gnus-article-reply-with-original
- "F" gnus-article-followup-with-original
- "\C-hk" gnus-article-describe-key
- "\C-hc" gnus-article-describe-key-briefly
-
- "\C-d" gnus-article-read-summary-keys
- "\M-*" gnus-article-read-summary-keys
- "\M-#" gnus-article-read-summary-keys
- "\M-^" gnus-article-read-summary-keys
- "\M-g" gnus-article-read-summary-keys)
-
-(substitute-key-definition
- 'undefined 'gnus-article-read-summary-keys gnus-article-mode-map)
-
-(defun gnus-article-make-menu-bar ()
- (unless (boundp 'gnus-article-commands-menu)
- (gnus-summary-make-menu-bar))
- (gnus-turn-off-edit-menu 'article)
- (unless (boundp 'gnus-article-article-menu)
- (easy-menu-define
- gnus-article-article-menu gnus-article-mode-map ""
- '("Article"
- ["Scroll forwards" gnus-article-goto-next-page t]
- ["Scroll backwards" gnus-article-goto-prev-page t]
- ["Show summary" gnus-article-show-summary t]
- ["Fetch Message-ID at point" gnus-article-refer-article t]
- ["Mail to address at point" gnus-article-mail t]
- ["Send a bug report" gnus-bug t]))
-
- (easy-menu-define
- gnus-article-treatment-menu gnus-article-mode-map ""
- ;; Fixme: this should use :active (and maybe :visible).
- '("Treatment"
- ["Hide headers" gnus-article-hide-headers t]
- ["Hide signature" gnus-article-hide-signature t]
- ["Hide citation" gnus-article-hide-citation t]
- ["Treat overstrike" gnus-article-treat-overstrike t]
- ["Remove carriage return" gnus-article-remove-cr t]
- ["Remove leading whitespace" gnus-article-remove-leading-whitespace t]
- ["Remove quoted-unreadable" gnus-article-de-quoted-unreadable t]
- ["Remove base64" gnus-article-de-base64-unreadable t]
- ["Treat html" gnus-article-wash-html t]
- ["Remove newlines from within URLs" gnus-article-unsplit-urls t]
- ["Decode HZ" gnus-article-decode-HZ t]))
-
- ;; Note "Commands" menu is defined in gnus-sum.el for consistency
-
- ;; Note "Post" menu is defined in gnus-sum.el for consistency
-
- (gnus-run-hooks 'gnus-article-menu-hook)))
-
-(defun gnus-article-mode ()
- "Major mode for displaying an article.
-
-All normal editing commands are switched off.
-
-The following commands are available in addition to all summary mode
-commands:
-\\<gnus-article-mode-map>
-\\[gnus-article-next-page]\t Scroll the article one page forwards
-\\[gnus-article-prev-page]\t Scroll the article one page backwards
-\\[gnus-article-refer-article]\t Go to the article referred to by an article id near point
-\\[gnus-article-show-summary]\t Display the summary buffer
-\\[gnus-article-mail]\t Send a reply to the address near point
-\\[gnus-article-describe-briefly]\t Describe the current mode briefly
-\\[gnus-info-find-node]\t Go to the Gnus info node"
- (interactive)
- (kill-all-local-variables)
- (gnus-simplify-mode-line)
- (setq mode-name "Article")
- (setq major-mode 'gnus-article-mode)
- (make-local-variable 'minor-mode-alist)
- (use-local-map gnus-article-mode-map)
- (when (gnus-visual-p 'article-menu 'menu)
- (gnus-article-make-menu-bar)
- (when gnus-summary-tool-bar-map
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map)))
- (gnus-update-format-specifications nil 'article-mode)
- (set (make-local-variable 'page-delimiter) gnus-page-delimiter)
- (set (make-local-variable 'gnus-page-broken) nil)
- (make-local-variable 'gnus-button-marker-list)
- (make-local-variable 'gnus-article-current-summary)
- (make-local-variable 'gnus-article-mime-handles)
- (make-local-variable 'gnus-article-decoded-p)
- (make-local-variable 'gnus-article-mime-handle-alist)
- (make-local-variable 'gnus-article-wash-types)
- (make-local-variable 'gnus-article-image-alist)
- (make-local-variable 'gnus-article-charset)
- (make-local-variable 'gnus-article-ignored-charsets)
- ;; Prevent Emacs 22 from displaying non-break space with `nobreak-space'
- ;; face.
- (set (make-local-variable 'nobreak-char-display) nil)
- (setq cursor-in-non-selected-windows nil)
- (gnus-set-default-directory)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (set-syntax-table gnus-article-mode-syntax-table)
- (mm-enable-multibyte)
- (gnus-run-mode-hooks 'gnus-article-mode-hook))
-
-;; Internal variables. Are `gnus-button-regexp' and `gnus-button-last' used
-;; at all?
-(defvar gnus-button-regexp nil)
-(defvar gnus-button-marker-list nil
- "Regexp matching any of the regexps from `gnus-button-alist'.")
-(defvar gnus-button-last nil
- "The value of `gnus-button-alist' when `gnus-button-regexp' was build.")
-
-(defun gnus-article-setup-buffer ()
- "Initialize the article buffer."
- (let* ((name (if gnus-single-article-buffer "*Article*"
- (concat "*Article " gnus-newsgroup-name "*")))
- (original
- (progn (string-match "\\*Article" name)
- (concat " *Original Article"
- (substring name (match-end 0))))))
- (setq gnus-article-buffer name)
- (setq gnus-original-article-buffer original)
- (setq gnus-article-mime-handle-alist nil)
- ;; This might be a variable local to the summary buffer.
- (unless gnus-single-article-buffer
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (setq gnus-article-buffer name)
- (setq gnus-original-article-buffer original)
- (gnus-set-global-variables)))
- (gnus-article-setup-highlight-words)
- ;; Init original article buffer.
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
- (mm-enable-multibyte)
- (setq major-mode 'gnus-original-article-mode)
- (make-local-variable 'gnus-original-article))
- (if (and (get-buffer name)
- (with-current-buffer name
- (if gnus-article-edit-mode
- (if (y-or-n-p "Article mode edit in progress; discard? ")
- (progn
- (set-buffer-modified-p nil)
- (gnus-kill-buffer name)
- (message "")
- nil)
- (error "Action aborted"))
- t)))
- (save-excursion
- (set-buffer name)
- (set (make-local-variable 'gnus-article-edit-mode) nil)
- (when gnus-article-mime-handles
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handles nil))
- ;; Set it to nil in article-buffer!
- (setq gnus-article-mime-handle-alist nil)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- ;; This list just keeps growing if we don't reset it.
- (setq gnus-button-marker-list nil)
- (unless (eq major-mode 'gnus-article-mode)
- (gnus-article-mode))
- (current-buffer))
- (save-excursion
- (set-buffer (gnus-get-buffer-create name))
- (gnus-article-mode)
- (make-local-variable 'gnus-summary-buffer)
- (gnus-summary-set-local-parameters gnus-newsgroup-name)
- (current-buffer)))))
-
-;; Set article window start at LINE, where LINE is the number of lines
-;; from the head of the article.
-(defun gnus-article-set-window-start (&optional line)
- (set-window-start
- (gnus-get-buffer-window gnus-article-buffer t)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (if (not line)
- (point-min)
- (gnus-message 6 "Moved to bookmark")
- (search-forward "\n\n" nil t)
- (forward-line line)
- (point)))))
-
-(defun gnus-article-prepare (article &optional all-headers header)
- "Prepare ARTICLE in article mode buffer.
-ARTICLE should either be an article number or a Message-ID.
-If ARTICLE is an id, HEADER should be the article headers.
-If ALL-HEADERS is non-nil, no headers are hidden."
- (save-excursion
- ;; Make sure we start in a summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
- (set-buffer gnus-summary-buffer))
- (setq gnus-summary-buffer (current-buffer))
- (let* ((gnus-article (if header (mail-header-number header) article))
- (summary-buffer (current-buffer))
- (gnus-tmp-internal-hook gnus-article-internal-prepare-hook)
- (group gnus-newsgroup-name)
- result)
- (save-excursion
- (gnus-article-setup-buffer)
- (set-buffer gnus-article-buffer)
- ;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
- (setq mark-active nil))
- (if (not (setq result (let ((inhibit-read-only t))
- (gnus-request-article-this-buffer
- article group))))
- ;; There is no such article.
- (save-excursion
- (when (and (numberp article)
- (not (memq article gnus-newsgroup-sparse)))
- (setq gnus-article-current
- (cons gnus-newsgroup-name article))
- (set-buffer gnus-summary-buffer)
- (setq gnus-current-article article)
- (if (and (memq article gnus-newsgroup-undownloaded)
- (not (gnus-online (gnus-find-method-for-group
- gnus-newsgroup-name))))
- (progn
- (gnus-summary-set-agent-mark article)
- (message "Message marked for downloading"))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (unless (memq article gnus-newsgroup-sparse)
- (gnus-error 1 "No such article (may have expired or been canceled)")))))
- (if (or (eq result 'pseudo)
- (eq result 'nneething))
- (progn
- (save-excursion
- (set-buffer summary-buffer)
- (push article gnus-newsgroup-history)
- (setq gnus-last-article gnus-current-article
- gnus-current-article 0
- gnus-current-headers nil
- gnus-article-current nil)
- (if (eq result 'nneething)
- (gnus-configure-windows 'summary)
- (gnus-configure-windows 'article))
- (gnus-set-global-variables))
- (let ((gnus-article-mime-handle-alist-1
- gnus-article-mime-handle-alist))
- (gnus-set-mode-line 'article)))
- ;; The result from the `request' was an actual article -
- ;; or at least some text that is now displayed in the
- ;; article buffer.
- (when (and (numberp article)
- (not (eq article gnus-current-article)))
- ;; Seems like a new article has been selected.
- ;; `gnus-current-article' must be an article number.
- (save-excursion
- (set-buffer summary-buffer)
- (push article gnus-newsgroup-history)
- (setq gnus-last-article gnus-current-article
- gnus-current-article article
- gnus-current-headers
- (gnus-summary-article-header gnus-current-article)
- gnus-article-current
- (cons gnus-newsgroup-name gnus-current-article))
- (unless (vectorp gnus-current-headers)
- (setq gnus-current-headers nil))
- (gnus-summary-goto-subject gnus-current-article)
- (when (gnus-summary-show-thread)
- ;; If the summary buffer really was folded, the
- ;; previous goto may not actually have gone to
- ;; the right article, but the thread root instead.
- ;; So we go again.
- (gnus-summary-goto-subject gnus-current-article))
- (gnus-run-hooks 'gnus-mark-article-hook)
- (gnus-set-mode-line 'summary)
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-run-hooks 'gnus-visual-mark-article-hook))
- ;; Set the global newsgroup variables here.
- (gnus-set-global-variables)
- (setq gnus-have-all-headers
- (or all-headers gnus-show-all-headers))))
- (save-excursion
- (gnus-configure-windows 'article))
- (when (or (numberp article)
- (stringp article))
- (gnus-article-prepare-display)
- ;; Do page break.
- (goto-char (point-min))
- (when gnus-break-pages
- (gnus-narrow-to-page)))
- (let ((gnus-article-mime-handle-alist-1
- gnus-article-mime-handle-alist))
- (gnus-set-mode-line 'article))
- (article-goto-body)
- (unless (bobp)
- (forward-line -1))
- (set-window-point (get-buffer-window (current-buffer)) (point))
- (gnus-configure-windows 'article)
- t))))))
-
-;;;###autoload
-(defun gnus-article-prepare-display ()
- "Make the current buffer look like a nice article."
- ;; Hooks for getting information from the article.
- ;; This hook must be called before being narrowed.
- (let ((gnus-article-buffer (current-buffer))
- buffer-read-only
- (inhibit-read-only t))
- (unless (eq major-mode 'gnus-article-mode)
- (gnus-article-mode))
- (setq buffer-read-only nil
- gnus-article-wash-types nil
- gnus-article-image-alist nil)
- (gnus-run-hooks 'gnus-tmp-internal-hook)
- (when gnus-display-mime-function
- (funcall gnus-display-mime-function))
- (gnus-run-hooks 'gnus-article-prepare-hook)))
-
-;;;
-;;; Gnus MIME viewing functions
-;;;
-
-(defvar gnus-mime-button-line-format "%{%([%p. %d%T]%)%}%e\n"
- "Format of the MIME buttons.
-
-Valid specifiers include:
-%t The MIME type
-%T MIME type, along with additional info
-%n The `name' parameter
-%d The description, if any
-%l The length of the encoded part
-%p The part identifier number
-%e Dots if the part isn't displayed
-
-General format specifiers can also be used. See Info node
-`(gnus)Formatting Variables'.")
-
-(defvar gnus-mime-button-line-format-alist
- '((?t gnus-tmp-type ?s)
- (?T gnus-tmp-type-long ?s)
- (?n gnus-tmp-name ?s)
- (?d gnus-tmp-description ?s)
- (?p gnus-tmp-id ?s)
- (?l gnus-tmp-length ?d)
- (?e gnus-tmp-dots ?s)))
-
-(defvar gnus-mime-button-commands
- '((gnus-article-press-button "\r" "Toggle Display")
- (gnus-mime-view-part "v" "View Interactively...")
- (gnus-mime-view-part-as-type "t" "View As Type...")
- (gnus-mime-view-part-as-charset "C" "View As charset...")
- (gnus-mime-save-part "o" "Save...")
- (gnus-mime-save-part-and-strip "\C-o" "Save and Strip")
- (gnus-mime-delete-part "d" "Delete part")
- (gnus-mime-copy-part "c" "View As Text, In Other Buffer")
- (gnus-mime-inline-part "i" "View As Text, In This Buffer")
- (gnus-mime-view-part-internally "E" "View Internally")
- (gnus-mime-view-part-externally "e" "View Externally")
- (gnus-mime-print-part "p" "Print")
- (gnus-mime-pipe-part "|" "Pipe To Command...")
- (gnus-mime-action-on-part "." "Take action on the part...")))
-
-(defun gnus-article-mime-part-status ()
- (if gnus-article-mime-handle-alist-1
- (if (eq 1 (length gnus-article-mime-handle-alist-1))
- " (1 part)"
- (format " (%d parts)" (length gnus-article-mime-handle-alist-1)))
- ""))
-
-(defvar gnus-mime-button-map
- (let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map gnus-article-mode-map))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map gnus-down-mouse-3 'gnus-mime-button-menu)
- (dolist (c gnus-mime-button-commands)
- (define-key map (cadr c) (car c)))
- map))
-
-(easy-menu-define
- gnus-mime-button-menu gnus-mime-button-map "MIME button menu."
- `("MIME Part"
- ,@(mapcar (lambda (c)
- (vector (caddr c) (car c) :enable t))
- gnus-mime-button-commands)))
-
-(eval-when-compile
- (define-compiler-macro popup-menu (&whole form
- menu &optional position prefix)
- (if (and (fboundp 'popup-menu)
- (not (memq 'popup-menu (assoc "lmenu" load-history))))
- form
- ;; Gnus is probably running under Emacs 20.
- `(let* ((menu (cdr ,menu))
- (response (x-popup-menu
- t (list (car menu)
- (cons "" (mapcar (lambda (c)
- (cons (caddr c) (car c)))
- (cdr menu)))))))
- (if response
- (call-interactively (nth 3 (assq response menu))))))))
-
-(defun gnus-mime-button-menu (event prefix)
- "Construct a context-sensitive menu of MIME commands."
- (interactive "e\nP")
- (save-window-excursion
- (let ((pos (event-start event)))
- (select-window (posn-window pos))
- (goto-char (posn-point pos))
- (gnus-article-check-buffer)
- (popup-menu gnus-mime-button-menu nil prefix))))
-
-(defun gnus-mime-view-all-parts (&optional handles)
- "View all the MIME parts."
- (interactive)
- (save-current-buffer
- (set-buffer gnus-article-buffer)
- (let ((handles (or handles gnus-article-mime-handles))
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets)))
- (when handles
- (mm-remove-parts handles)
- (goto-char (point-min))
- (or (search-forward "\n\n") (goto-char (point-max)))
- (let ((inhibit-read-only t))
- (delete-region (point) (point-max))
- (mm-display-parts handles))))))
-
-(defun gnus-mime-save-part-and-strip ()
- "Save the MIME part under point then replace it with an external body."
- (interactive)
- (gnus-article-check-buffer)
- (when (gnus-group-read-only-p)
- (error "The current group does not support deleting of parts"))
- (when (mm-complicated-handles gnus-article-mime-handles)
- (error "\
-The current article has a complicated MIME structure, giving up..."))
- (when (gnus-yes-or-no-p "\
-Deleting parts may malfunction or destroy the article; continue? ")
- (let* ((data (get-text-property (point) 'gnus-data))
- file param
- (handles gnus-article-mime-handles))
- (setq file (and data (mm-save-part data)))
- (when file
- (with-current-buffer (mm-handle-buffer data)
- (erase-buffer)
- (insert "Content-Type: " (mm-handle-media-type data))
- (mml-insert-parameter-string (cdr (mm-handle-type data))
- '(charset))
- ;; Add a filename for the sake of saving the part again.
- (mml-insert-parameter
- (mail-header-encode-parameter "name" (file-name-nondirectory file)))
- (insert "\n")
- (insert "Content-ID: " (message-make-message-id) "\n")
- (insert "Content-Transfer-Encoding: binary\n")
- (insert "\n"))
- (setcdr data
- (cdr (mm-make-handle nil
- `("message/external-body"
- (access-type . "LOCAL-FILE")
- (name . ,file)))))
- (set-buffer gnus-summary-buffer)
- (gnus-article-edit-article
- `(lambda ()
- (erase-buffer)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- (mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- (insert-buffer-substring gnus-original-article-buffer)
- (mime-to-mml ',handles)
- (setq gnus-article-mime-handles nil)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
- (gnus-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
- `(lambda (no-highlight)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (message-options message-options)
- (message-options-set-recipient)
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets)))
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- 'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list))
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight)))))))
-
-(defun gnus-mime-delete-part ()
- "Delete the MIME part under point.
-Replace it with some information about the removed part."
- (interactive)
- (gnus-article-check-buffer)
- (when (gnus-group-read-only-p)
- (error "The current group does not support deleting of parts"))
- (when (mm-complicated-handles gnus-article-mime-handles)
- (error "\
-The current article has a complicated MIME structure, giving up..."))
- (when (gnus-yes-or-no-p "\
-Deleting parts may malfunction or destroy the article; continue? ")
- (let* ((data (get-text-property (point) 'gnus-data))
- (handles gnus-article-mime-handles)
- (none "(none)")
- (description
- (mail-decode-encoded-word-string (or (mm-handle-description data)
- none)))
- (filename
- (or (mail-content-type-get (mm-handle-disposition data) 'filename)
- none))
- (type (mm-handle-media-type data)))
- (unless data
- (error "No MIME part under point"))
- (with-current-buffer (mm-handle-buffer data)
- (let ((bsize (format "%s" (buffer-size))))
- (erase-buffer)
- (insert
- (concat
- ",----\n"
- "| The following attachment has been deleted:\n"
- "|\n"
- "| Type: " type "\n"
- "| Filename: " filename "\n"
- "| Size (encoded): " bsize " Byte\n"
- "| Description: " description "\n"
- "`----\n"))
- (setcdr data
- (cdr (mm-make-handle
- nil `("text/plain") nil nil
- (list "attachment")
- (format "Deleted attachment (%s bytes)" bsize))))))
- (set-buffer gnus-summary-buffer)
- ;; FIXME: maybe some of the following code (borrowed from
- ;; `gnus-mime-save-part-and-strip') isn't necessary?
- (gnus-article-edit-article
- `(lambda ()
- (erase-buffer)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- (mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- (insert-buffer-substring gnus-original-article-buffer)
- (mime-to-mml ',handles)
- (setq gnus-article-mime-handles nil)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
- (gnus-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t)))
- `(lambda (no-highlight)
- (let ((mail-parse-charset (or gnus-article-charset
- ',gnus-newsgroup-charset))
- (message-options message-options)
- (message-options-set-recipient)
- (mail-parse-ignored-charsets
- (or gnus-article-ignored-charsets
- ',gnus-newsgroup-ignored-charsets)))
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- 'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list))
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight))))
- ;; Not in `gnus-mime-save-part-and-strip':
- (gnus-article-edit-done)
- (gnus-summary-expand-window)
- (gnus-summary-show-article)))
-
-(defun gnus-mime-save-part ()
- "Save the MIME part under point."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (mm-save-part data))))
-
-(defun gnus-mime-pipe-part ()
- "Pipe the MIME part under point to a process."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (mm-pipe-part data))))
-
-(defun gnus-mime-view-part ()
- "Interactively choose a viewing method for the MIME part under point."
- (interactive)
- (gnus-article-check-buffer)
- (let ((data (get-text-property (point) 'gnus-data)))
- (when data
- (setq gnus-article-mime-handles
- (mm-merge-handles
- gnus-article-mime-handles (setq data (copy-sequence data))))
- (mm-interactively-view-part data))))
-
-(defun gnus-mime-view-part-as-type-internal ()
- (gnus-article-check-buffer)
- (let* ((handle (get-text-property (point) 'gnus-data))
- (name (or
- ;; Content-Type: foo/bar; name=...
- (mail-content-type-get (mm-handle-type handle) 'name)
- ;; Content-Disposition: attachment; filename=...
- (cdr (assq 'filename (cdr (mm-handle-disposition handle))))))
- (def-type (and name (mm-default-file-encoding name))))
- (and def-type (cons def-type 0))))
-
-(defun gnus-mime-view-part-as-type (&optional mime-type pred)
- "Choose a MIME media type, and view the part as such.
-If non-nil, PRED is a predicate to use during completion to limit the
-available media-types."
- (interactive)
- (unless mime-type
- (setq mime-type
- (let ((default (gnus-mime-view-part-as-type-internal)))
- (completing-read
- (format "View as MIME type (default %s): "
- (car default))
- (mapcar #'list (mailcap-mime-types))
- pred nil nil nil
- (car default)))))
- (gnus-article-check-buffer)
- (let ((handle (get-text-property (point) 'gnus-data)))
- (when handle
- (when (equal (mm-handle-media-type handle) "message/external-body")
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (setq handle (mm-handle-cache handle)))
- (setq handle
- (mm-make-handle (mm-handle-buffer handle)
- (cons mime-type (cdr (mm-handle-type handle)))
- (mm-handle-encoding handle)
- (mm-handle-undisplayer handle)
- (mm-handle-disposition handle)
- (mm-handle-description handle)
- nil
- (mm-handle-id handle)))
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handle))
- (gnus-mm-display-part handle))))
-
-(eval-when-compile
- (require 'jka-compr))
-
-;; jka-compr.el uses a "sh -c" to direct stderr to err-file, but these days
-;; emacs can do that itself.
-;;
-(defun gnus-mime-jka-compr-maybe-uncompress ()
- "Uncompress the current buffer if `auto-compression-mode' is enabled.
-The uncompress method used is derived from `buffer-file-name'."
- (when (and (fboundp 'jka-compr-installed-p)
- (jka-compr-installed-p))
- (let ((info (jka-compr-get-compression-info buffer-file-name)))
- (when info
- (let ((basename (file-name-nondirectory buffer-file-name))
- (args (jka-compr-info-uncompress-args info))
- (prog (jka-compr-info-uncompress-program info))
- (message (jka-compr-info-uncompress-message info))
- (err-file (jka-compr-make-temp-name)))
- (if message
- (message "%s %s..." message basename))
- (unwind-protect
- (unless (memq (apply 'call-process-region
- (point-min) (point-max)
- prog
- t (list t err-file) nil
- args)
- jka-compr-acceptable-retval-list)
- (jka-compr-error prog args basename message err-file))
- (jka-compr-delete-temp-file err-file)))))))
-
-(defun gnus-mime-copy-part (&optional handle)
- "Put the MIME part under point into a new buffer.
-If `auto-compression-mode' is enabled, compressed files like .gz and .bz2
-are decompressed."
- (interactive)
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (and handle (mm-get-part handle)))
- (base (and handle
- (file-name-nondirectory
- (or
- (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-disposition handle)
- 'filename)
- "*decoded*"))))
- (buffer (and base (generate-new-buffer base))))
- (when contents
- (switch-to-buffer buffer)
- (insert contents)
- ;; We do it this way to make `normal-mode' set the appropriate mode.
- (unwind-protect
- (progn
- (setq buffer-file-name (expand-file-name base))
- (gnus-mime-jka-compr-maybe-uncompress)
- (normal-mode))
- (setq buffer-file-name nil))
- (goto-char (point-min)))))
-
-(defun gnus-mime-print-part (&optional handle filename)
- "Print the MIME part under point."
- (interactive (list nil (ps-print-preprint current-prefix-arg)))
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (contents (and handle (mm-get-part handle)))
- (file (mm-make-temp-file (expand-file-name "mm." mm-tmp-directory)))
- (printer (mailcap-mime-info (mm-handle-media-type handle) "print")))
- (when contents
- (if printer
- (unwind-protect
- (progn
- (mm-save-part-to-file handle file)
- (call-process shell-file-name nil
- (generate-new-buffer " *mm*")
- nil
- shell-command-switch
- (mm-mailcap-command
- printer file (mm-handle-type handle))))
- (delete-file file))
- (with-temp-buffer
- (insert contents)
- (gnus-print-buffer))
- (ps-despool filename)))))
-
-(defun gnus-mime-inline-part (&optional handle arg)
- "Insert the MIME part under point into the current buffer."
- (interactive (list nil current-prefix-arg))
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- contents charset
- (b (point))
- (inhibit-read-only t))
- (when handle
- (if (and (not arg) (mm-handle-undisplayer handle))
- (mm-remove-part handle)
- (setq contents (mm-get-part handle))
- (cond
- ((not arg)
- (setq charset (or (mail-content-type-get
- (mm-handle-type handle) 'charset)
- gnus-newsgroup-charset)))
- ((numberp arg)
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (setq charset
- (or (cdr (assq arg
- gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: "))))
- (t
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))))
- (forward-line 2)
- (mm-insert-inline
- handle
- (if (and charset
- (setq charset (mm-charset-to-coding-system
- charset))
- (not (eq charset 'ascii)))
- (mm-decode-coding-string contents charset)
- (mm-string-to-multibyte contents)))
- (goto-char b)))))
-
-(defun gnus-mime-strip-charset-parameters (handle)
- "Strip charset parameters from HANDLE."
- (if (stringp (car handle))
- (mapc #'gnus-mime-strip-charset-parameters (cdr handle))
- (let* ((type (mm-handle-type (if (equal (mm-handle-media-type handle)
- "message/external-body")
- (progn
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (mm-handle-cache handle))
- handle)))
- (charset (assq 'charset (cdr type))))
- (when charset
- (delq charset type)))))
-
-(defun gnus-mime-view-part-as-charset (&optional handle arg)
- "Insert the MIME part under point into the current buffer using the
-specified charset."
- (interactive (list nil current-prefix-arg))
- (gnus-article-check-buffer)
- (let ((handle (or handle (get-text-property (point) 'gnus-data)))
- (fun (get-text-property (point) 'gnus-callback))
- (gnus-newsgroup-ignored-charsets 'gnus-all)
- gnus-newsgroup-charset form preferred parts)
- (when handle
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle))
- (when fun
- (setq gnus-newsgroup-charset
- (or (cdr (assq arg gnus-summary-show-article-charset-alist))
- (mm-read-coding-system "Charset: ")))
- (gnus-mime-strip-charset-parameters handle)
- (when (and (consp (setq form (cdr-safe fun)))
- (setq form (ignore-errors
- (assq 'gnus-mime-display-alternative form)))
- (setq preferred (caddr form))
- (progn
- (when (eq (car preferred) 'quote)
- (setq preferred (cadr preferred)))
- (not (equal preferred
- (get-text-property (point) 'gnus-data))))
- (setq parts (get-text-property (point) 'gnus-part))
- (setq parts (cdr (assq parts
- gnus-article-mime-handle-alist)))
- (equal (mm-handle-media-type parts) "multipart/alternative")
- (setq parts (reverse (cdr parts))))
- (setcar (cddr form)
- (list 'quote (or (cadr (member preferred parts))
- (car parts)))))
- (funcall fun handle)))))
-
-(defun gnus-mime-view-part-externally (&optional handle)
- "View the MIME part under point with an external viewer."
- (interactive)
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-user-display-methods nil)
- (mm-inlined-types nil)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets))
- (type (mm-handle-media-type handle))
- (method (mailcap-mime-info type))
- (mm-enable-external t))
- (if (not (stringp method))
- (gnus-mime-view-part-as-type
- nil (lambda (types) (stringp (mailcap-mime-info (car types)))))
- (when handle
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))))
-
-(defun gnus-mime-view-part-internally (&optional handle)
- "View the MIME part under point with an internal viewer.
-If no internal viewer is available, use an external viewer."
- (interactive)
- (gnus-article-check-buffer)
- (let* ((handle (or handle (get-text-property (point) 'gnus-data)))
- (mm-inlined-types '(".*"))
- (mm-inline-large-images t)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (with-current-buffer gnus-summary-buffer
- gnus-newsgroup-ignored-charsets))
- (inhibit-read-only t))
- (if (not (mm-inlinable-p handle))
- (gnus-mime-view-part-as-type
- nil (lambda (types) (mm-inlinable-p handle (car types))))
- (when handle
- (if (mm-handle-undisplayer handle)
- (mm-remove-part handle)
- (mm-display-part handle))))))
-
-(defun gnus-mime-action-on-part (&optional action)
- "Do something with the MIME attachment at \(point\)."
- (interactive
- (list (completing-read "Action: " gnus-mime-action-alist nil t)))
- (gnus-article-check-buffer)
- (let ((action-pair (assoc action gnus-mime-action-alist)))
- (if action-pair
- (funcall (cdr action-pair)))))
-
-(defun gnus-article-part-wrapper (n function)
- (let ((window (get-buffer-window gnus-article-buffer 'visible))
- frame)
- (when window
- ;; It is necessary to select the article window so that
- ;; `gnus-article-goto-part' may really move the point.
- (setq frame (selected-frame))
- (gnus-select-frame-set-input-focus (window-frame window))
- (unwind-protect
- (save-window-excursion
- (select-window window)
- (when (> n (length gnus-article-mime-handle-alist))
- (error "No such part"))
- (gnus-article-goto-part n)
- (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
- (funcall function handle)))
- (gnus-select-frame-set-input-focus frame)))))
-
-(defun gnus-article-pipe-part (n)
- "Pipe MIME part N, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'mm-pipe-part))
-
-(defun gnus-article-save-part (n)
- "Save MIME part N, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'mm-save-part))
-
-(defun gnus-article-interactively-view-part (n)
- "View MIME part N interactively, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'mm-interactively-view-part))
-
-(defun gnus-article-copy-part (n)
- "Copy MIME part N, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-copy-part))
-
-(defun gnus-article-view-part-as-charset (n)
- "View MIME part N using a specified charset.
-N is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-view-part-as-charset))
-
-(defun gnus-article-view-part-externally (n)
- "View MIME part N externally, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-view-part-externally))
-
-(defun gnus-article-inline-part (n)
- "Inline MIME part N, which is the numerical prefix."
- (interactive "p")
- (gnus-article-part-wrapper n 'gnus-mime-inline-part))
-
-(defun gnus-article-mime-match-handle-first (condition)
- (if condition
- (let ((alist gnus-article-mime-handle-alist) ihandle n)
- (while (setq ihandle (pop alist))
- (if (and (cond
- ((functionp condition)
- (funcall condition (cdr ihandle)))
- ((eq condition 'undisplayed)
- (not (or (mm-handle-undisplayer (cdr ihandle))
- (equal (mm-handle-media-type (cdr ihandle))
- "multipart/alternative"))))
- ((eq condition 'undisplayed-alternative)
- (not (mm-handle-undisplayer (cdr ihandle))))
- (t t))
- (gnus-article-goto-part (car ihandle))
- (or (not n) (< (car ihandle) n)))
- (setq n (car ihandle))))
- (or n 1))
- 1))
-
-(defun gnus-article-view-part (&optional n)
- "View MIME part N, which is the numerical prefix."
- (interactive "P")
- (save-current-buffer
- (set-buffer gnus-article-buffer)
- (or (numberp n) (setq n (gnus-article-mime-match-handle-first
- gnus-article-mime-match-handle-function)))
- (when (> n (length gnus-article-mime-handle-alist))
- (error "No such part"))
- (let ((handle (cdr (assq n gnus-article-mime-handle-alist))))
- (when (gnus-article-goto-part n)
- (if (equal (car handle) "multipart/alternative")
- (gnus-article-press-button)
- (when (eq (gnus-mm-display-part handle) 'internal)
- (gnus-set-window-start)))))))
-
-(defsubst gnus-article-mime-total-parts ()
- (if (bufferp (car gnus-article-mime-handles))
- 1 ;; single part
- (1- (length gnus-article-mime-handles))))
-
-(defun gnus-mm-display-part (handle)
- "Display HANDLE and fix MIME button."
- (let ((id (get-text-property (point) 'gnus-part))
- (point (point))
- (inhibit-read-only t))
- (forward-line 1)
- (prog1
- (let ((window (selected-window))
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (if (gnus-buffer-live-p gnus-summary-buffer)
- (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)
- nil)))
- (save-excursion
- (unwind-protect
- (let ((win (gnus-get-buffer-window (current-buffer) t))
- (beg (point)))
- (when win
- (select-window win))
- (goto-char point)
- (forward-line)
- (if (mm-handle-displayed-p handle)
- ;; This will remove the part.
- (mm-display-part handle)
- (save-restriction
- (narrow-to-region (point)
- (if (eobp) (point) (1+ (point))))
- (mm-display-part handle)
- ;; We narrow to the part itself and
- ;; then call the treatment functions.
- (goto-char (point-min))
- (forward-line 1)
- (narrow-to-region (point) (point-max))
- (gnus-treat-article
- nil id
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))
- (if (window-live-p window)
- (select-window window)))))
- (goto-char point)
- (gnus-delete-line)
- (gnus-insert-mime-button
- handle id (list (mm-handle-displayed-p handle)))
- (goto-char point))))
-
-(defun gnus-article-goto-part (n)
- "Go to MIME part N."
- (gnus-goto-char (text-property-any (point-min) (point-max) 'gnus-part n)))
-
-(defun gnus-insert-mime-button (handle gnus-tmp-id &optional displayed)
- (let ((gnus-tmp-name
- (or (mail-content-type-get (mm-handle-type handle) 'name)
- (mail-content-type-get (mm-handle-disposition handle) 'filename)
- (mail-content-type-get (mm-handle-type handle) 'url)
- ""))
- (gnus-tmp-type (mm-handle-media-type handle))
- (gnus-tmp-description
- (mail-decode-encoded-word-string (or (mm-handle-description handle)
- "")))
- (gnus-tmp-dots
- (if (if displayed (car displayed)
- (mm-handle-displayed-p handle))
- "" "..."))
- (gnus-tmp-length (with-current-buffer (mm-handle-buffer handle)
- (buffer-size)))
- gnus-tmp-type-long b e)
- (when (string-match ".*/" gnus-tmp-name)
- (setq gnus-tmp-name (replace-match "" t t gnus-tmp-name)))
- (setq gnus-tmp-type-long (concat gnus-tmp-type
- (and (not (equal gnus-tmp-name ""))
- (concat "; " gnus-tmp-name))))
- (unless (equal gnus-tmp-description "")
- (setq gnus-tmp-type-long (concat " --- " gnus-tmp-type-long)))
- (unless (bolp)
- (insert "\n"))
- (setq b (point))
- (gnus-eval-format
- gnus-mime-button-line-format gnus-mime-button-line-format-alist
- `(,@(gnus-local-map-property gnus-mime-button-map)
- gnus-callback gnus-mm-display-part
- gnus-part ,gnus-tmp-id
- article-type annotation
- gnus-data ,handle))
- (setq e (if (bolp)
- ;; Exclude a newline.
- (1- (point))
- (point)))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-button-map
- :help-echo
- (lambda (widget/window &optional overlay pos)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (if (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
- (format
- "%S: %s the MIME part; %S: more options"
- (aref gnus-mouse-2 0)
- ;; XEmacs will get a single widget arg; Emacs 21 will get
- ;; window, overlay, position.
- (if (mm-handle-displayed-p
- (if overlay
- (with-current-buffer (gnus-overlay-buffer overlay)
- (widget-get (widget-at (gnus-overlay-start overlay))
- :mime-handle))
- (widget-get widget/window :mime-handle)))
- "hide" "show")
- (aref gnus-down-mouse-3 0))))))
-
-(defun gnus-widget-press-button (elems el)
- (goto-char (widget-get elems :from))
- (gnus-article-press-button))
-
-(defvar gnus-displaying-mime nil)
-
-(defun gnus-display-mime (&optional ihandles)
- "Display the MIME parts."
- (save-excursion
- (save-selected-window
- (let ((window (get-buffer-window gnus-article-buffer))
- (point (point)))
- (when window
- (select-window window)
- ;; We have to do this since selecting the window
- ;; may change the point. So we set the window point.
- (set-window-point window point)))
- (let ((handles ihandles)
- (inhibit-read-only t)
- handle)
- (cond (handles)
- ((setq handles (mm-dissect-buffer nil gnus-article-loose-mime))
- (when gnus-article-emulate-mime
- (mm-uu-dissect-text-parts handles)))
- (gnus-article-emulate-mime
- (setq handles (mm-uu-dissect))))
- (when (and (not ihandles)
- (not gnus-displaying-mime))
- ;; Top-level call; we clean up.
- (when gnus-article-mime-handles
- (mm-destroy-parts gnus-article-mime-handles)
- (setq gnus-article-mime-handle-alist nil));; A trick.
- (setq gnus-article-mime-handles handles)
- ;; We allow users to glean info from the handles.
- (when gnus-article-mime-part-function
- (gnus-mime-part-function handles)))
- (if (and handles
- (or (not (stringp (car handles)))
- (cdr handles)))
- (progn
- (when (and (not ihandles)
- (not gnus-displaying-mime))
- ;; Clean up for mime parts.
- (article-goto-body)
- (delete-region (point) (point-max)))
- (let ((gnus-displaying-mime t))
- (gnus-mime-display-part handles)))
- (save-restriction
- (article-goto-body)
- (narrow-to-region (point) (point-max))
- (gnus-treat-article nil 1 1)
- (widen)))
- (unless ihandles
- ;; Highlight the headers.
- (save-excursion
- (save-restriction
- (article-goto-body)
- (narrow-to-region (point-min) (point))
- (gnus-article-save-original-date
- (gnus-treat-article 'head)))))))
- ;; Cope with broken MIME messages.
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))))
-
-(defcustom gnus-mime-display-multipart-as-mixed nil
- "Display \"multipart\" parts as \"multipart/mixed\".
-
-If t, it overrides nil values of
-`gnus-mime-display-multipart-alternative-as-mixed' and
-`gnus-mime-display-multipart-related-as-mixed'."
- :group 'gnus-article-mime
- :type 'boolean)
-
-(defcustom gnus-mime-display-multipart-alternative-as-mixed nil
- "Display \"multipart/alternative\" parts as \"multipart/mixed\"."
- :version "22.1"
- :group 'gnus-article-mime
- :type 'boolean)
-
-(defcustom gnus-mime-display-multipart-related-as-mixed nil
- "Display \"multipart/related\" parts as \"multipart/mixed\".
-
-If displaying \"text/html\" is discouraged \(see
-`mm-discouraged-alternatives'\) images or other material inside a
-\"multipart/related\" part might be overlooked when this variable is nil."
- :version "22.1"
- :group 'gnus-article-mime
- :type 'boolean)
-
-(defun gnus-mime-display-part (handle)
- (cond
- ;; Maybe a broken MIME message.
- ((null handle))
- ;; Single part.
- ((not (stringp (car handle)))
- (gnus-mime-display-single handle))
- ;; User-defined multipart
- ((cdr (assoc (car handle) gnus-mime-multipart-functions))
- (funcall (cdr (assoc (car handle) gnus-mime-multipart-functions))
- handle))
- ;; multipart/alternative
- ((and (equal (car handle) "multipart/alternative")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-alternative-as-mixed)))
- (let ((id (1+ (length gnus-article-mime-handle-alist))))
- (push (cons id handle) gnus-article-mime-handle-alist)
- (gnus-mime-display-alternative (cdr handle) nil nil id)))
- ;; multipart/related
- ((and (equal (car handle) "multipart/related")
- (not (or gnus-mime-display-multipart-as-mixed
- gnus-mime-display-multipart-related-as-mixed)))
- ;;;!!!We should find the start part, but we just default
- ;;;!!!to the first part.
- ;;(gnus-mime-display-part (cadr handle))
- ;;;!!! Most multipart/related is an HTML message plus images.
- ;;;!!! Unfortunately we are unable to let W3 display those
- ;;;!!! included images, so we just display it as a mixed multipart.
- ;;(gnus-mime-display-mixed (cdr handle))
- ;;;!!! No, w3 can display everything just fine.
- (gnus-mime-display-part (cadr handle)))
- ((equal (car handle) "multipart/signed")
- (gnus-add-wash-type 'signed)
- (gnus-mime-display-security handle))
- ((equal (car handle) "multipart/encrypted")
- (gnus-add-wash-type 'encrypted)
- (gnus-mime-display-security handle))
- ;; Other multiparts are handled like multipart/mixed.
- (t
- (gnus-mime-display-mixed (cdr handle)))))
-
-(defun gnus-mime-part-function (handles)
- (if (stringp (car handles))
- (mapcar 'gnus-mime-part-function (cdr handles))
- (funcall gnus-article-mime-part-function handles)))
-
-(defun gnus-mime-display-mixed (handles)
- (mapcar 'gnus-mime-display-part handles))
-
-(defun gnus-mime-display-single (handle)
- (let ((type (mm-handle-media-type handle))
- (ignored gnus-ignored-mime-types)
- (not-attachment t)
- (move nil)
- display text)
- (catch 'ignored
- (progn
- (while ignored
- (when (string-match (pop ignored) type)
- (throw 'ignored nil)))
- (if (and (setq not-attachment
- (and (not (mm-inline-override-p handle))
- (or (not (mm-handle-disposition handle))
- (equal (car (mm-handle-disposition handle))
- "inline")
- (mm-attachment-override-p handle))))
- (mm-automatic-display-p handle)
- (or (and
- (mm-inlinable-p handle)
- (mm-inlined-p handle))
- (mm-automatic-external-display-p type)))
- (setq display t)
- (when (equal (mm-handle-media-supertype handle) "text")
- (setq text t)))
- (let ((id (1+ (length gnus-article-mime-handle-alist)))
- beg)
- (push (cons id handle) gnus-article-mime-handle-alist)
- (when (and display
- (equal (mm-handle-media-supertype handle) "message"))
- (insert-char
- ?\n
- (cond ((not (bolp)) 2)
- ((or (bobp) (eq (char-before (1- (point))) ?\n)) 0)
- (t 1))))
- (when (or (not display)
- (not (gnus-unbuttonized-mime-type-p type)))
- (gnus-insert-mime-button
- handle id (list (or display (and not-attachment text))))
- (gnus-article-insert-newline)
- ;; Remember modify the number of forward lines.
- (setq move t))
- (setq beg (point))
- (cond
- (display
- (when move
- (forward-line -1)
- (setq beg (point)))
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (condition-case ()
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets)))
- (mm-display-part handle t))
- (goto-char (point-max)))
- ((and text not-attachment)
- (when move
- (forward-line -1)
- (setq beg (point)))
- (gnus-article-insert-newline)
- (mm-insert-inline
- handle
- (let ((charset (mail-content-type-get (mm-handle-type handle)
- 'charset)))
- (cond ((not charset)
- (mm-string-as-multibyte (mm-get-part handle)))
- ((eq charset 'gnus-decoded)
- (with-current-buffer (mm-handle-buffer handle)
- (buffer-string)))
- (t
- (mm-decode-string (mm-get-part handle) charset)))))
- (goto-char (point-max))))
- ;; Do highlighting.
- (save-excursion
- (save-restriction
- (narrow-to-region beg (point))
- (gnus-treat-article
- nil id
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle)))))))))
-
-(defun gnus-unbuttonized-mime-type-p (type)
- "Say whether TYPE is to be unbuttonized."
- (unless gnus-inhibit-mime-unbuttonizing
- (when (catch 'found
- (let ((types gnus-unbuttonized-mime-types))
- (while types
- (when (string-match (pop types) type)
- (throw 'found t)))))
- (not (catch 'found
- (let ((types gnus-buttonized-mime-types))
- (while types
- (when (string-match (pop types) type)
- (throw 'found t)))))))))
-
-(defun gnus-article-insert-newline ()
- "Insert a newline, but mark it as undeletable."
- (gnus-put-text-property
- (point) (progn (insert "\n") (point)) 'gnus-undeletable t))
-
-(defun gnus-mime-display-alternative (handles &optional preferred ibegend id)
- (let* ((preferred (or preferred (mm-preferred-alternative handles)))
- (ihandles handles)
- (point (point))
- handle (inhibit-read-only t) from props begend not-pref)
- (save-window-excursion
- (save-restriction
- (when ibegend
- (narrow-to-region (car ibegend)
- (or (cdr ibegend)
- (progn
- (goto-char (car ibegend))
- (forward-line 2)
- (point))))
- (delete-region (point-min) (point-max))
- (mm-remove-parts handles))
- (setq begend (list (point-marker)))
- ;; Do the toggle.
- (unless (setq not-pref (cadr (member preferred ihandles)))
- (setq not-pref (car ihandles)))
- (when (or ibegend
- (not preferred)
- (not (gnus-unbuttonized-mime-type-p
- "multipart/alternative")))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "%d. " id))
- (point))
- `(gnus-callback
- (lambda (handles)
- (unless ,(not ibegend)
- (setq gnus-article-mime-handle-alist
- ',gnus-article-mime-handle-alist))
- (gnus-mime-display-alternative
- ',ihandles ',not-pref ',begend ,id))
- ,@(gnus-local-map-property gnus-mime-button-map)
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
- face ,gnus-article-button-face
- gnus-part ,id
- article-type multipart))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- ;; Do the handles
- (while (setq handle (pop handles))
- (gnus-add-text-properties
- (setq from (point))
- (progn
- (insert (format "(%c) %-18s"
- (if (equal handle preferred) ?* ? )
- (mm-handle-media-type handle)))
- (point))
- `(gnus-callback
- (lambda (handles)
- (unless ,(not ibegend)
- (setq gnus-article-mime-handle-alist
- ',gnus-article-mime-handle-alist))
- (gnus-mime-display-alternative
- ',ihandles ',handle ',begend ,id))
- ,@(gnus-local-map-property gnus-mime-button-map)
- ,gnus-mouse-face-prop ,gnus-article-mouse-face
- face ,gnus-article-button-face
- gnus-part ,id
- gnus-data ,handle))
- (widget-convert-button 'link from (point)
- :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap)
- (insert " "))
- (insert "\n\n"))
- (when preferred
- (if (stringp (car preferred))
- (gnus-display-mime preferred)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
- (mm-display-part preferred)
- ;; Do highlighting.
- (save-excursion
- (save-restriction
- (narrow-to-region (car begend) (point-max))
- (gnus-treat-article
- nil (length gnus-article-mime-handle-alist)
- (gnus-article-mime-total-parts)
- (mm-handle-media-type handle))))))
- (goto-char (point-max))
- (setcdr begend (point-marker)))))
- (when ibegend
- (goto-char point))))
-
-(defconst gnus-article-wash-status-strings
- (let ((alist '((cite "c" "Possible hidden citation text"
- " " "All citation text visible")
- (headers "h" "Hidden headers"
- " " "All headers visible.")
- (pgp "p" "Encrypted or signed message status hidden"
- " " "No hidden encryption nor digital signature status")
- (signature "s" "Signature has been hidden"
- " " "Signature is visible")
- (overstrike "o" "Overstrike (^H) characters applied"
- " " "No overstrike characters applied")
- (emphasis "e" "/*_Emphasis_*/ characters applied"
- " " "No /*_emphasis_*/ characters applied")))
- result)
- (dolist (entry alist result)
- (let ((key (nth 0 entry))
- (on (copy-sequence (nth 1 entry)))
- (on-help (nth 2 entry))
- (off (copy-sequence (nth 3 entry)))
- (off-help (nth 4 entry)))
- (put-text-property 0 1 'help-echo on-help on)
- (put-text-property 0 1 'help-echo off-help off)
- (push (list key on off) result))))
- "Alist of strings describing wash status in the mode line.
-Each entry has the form (KEY ON OF), where the KEY is a symbol
-representing the particular washing function, ON is the string to use
-in the article mode line when the washing function is active, and OFF
-is the string to use when it is inactive.")
-
-(defun gnus-article-wash-status-entry (key value)
- (let ((entry (assoc key gnus-article-wash-status-strings)))
- (if value (nth 1 entry) (nth 2 entry))))
-
-(defun gnus-article-wash-status ()
- "Return a string which display status of article washing."
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((cite (memq 'cite gnus-article-wash-types))
- (headers (memq 'headers gnus-article-wash-types))
- (boring (memq 'boring-headers gnus-article-wash-types))
- (pgp (memq 'pgp gnus-article-wash-types))
- (pem (memq 'pem gnus-article-wash-types))
- (signed (memq 'signed gnus-article-wash-types))
- (encrypted (memq 'encrypted gnus-article-wash-types))
- (signature (memq 'signature gnus-article-wash-types))
- (overstrike (memq 'overstrike gnus-article-wash-types))
- (emphasis (memq 'emphasis gnus-article-wash-types)))
- (concat
- (gnus-article-wash-status-entry 'cite cite)
- (gnus-article-wash-status-entry 'headers (or headers boring))
- (gnus-article-wash-status-entry 'pgp (or pgp pem signed encrypted))
- (gnus-article-wash-status-entry 'signature signature)
- (gnus-article-wash-status-entry 'overstrike overstrike)
- (gnus-article-wash-status-entry 'emphasis emphasis)))))
-
-(defun gnus-add-wash-type (type)
- "Add a washing of TYPE to the current status."
- (add-to-list 'gnus-article-wash-types type))
-
-(defun gnus-delete-wash-type (type)
- "Add a washing of TYPE to the current status."
- (setq gnus-article-wash-types (delq type gnus-article-wash-types)))
-
-(defun gnus-add-image (category image)
- "Add IMAGE of CATEGORY to the list of displayed images."
- (let ((entry (assq category gnus-article-image-alist)))
- (unless entry
- (setq entry (list category))
- (push entry gnus-article-image-alist))
- (nconc entry (list image))))
-
-(defun gnus-delete-images (category)
- "Delete all images in CATEGORY."
- (let ((entry (assq category gnus-article-image-alist)))
- (dolist (image (cdr entry))
- (gnus-remove-image image category))
- (setq gnus-article-image-alist (delq entry gnus-article-image-alist))
- (gnus-delete-wash-type category)))
-
-(defalias 'gnus-article-hide-headers-if-wanted 'gnus-article-maybe-hide-headers)
-
-(defun gnus-article-maybe-hide-headers ()
- "Hide unwanted headers if `gnus-have-all-headers' is nil.
-Provided for backwards compatibility."
- (when (and (or (not (gnus-buffer-live-p gnus-summary-buffer))
- (not (save-excursion (set-buffer gnus-summary-buffer)
- gnus-have-all-headers)))
- (not gnus-inhibit-hiding))
- (gnus-article-hide-headers)))
-
-;;; Article savers.
-
-(defun gnus-output-to-file (file-name)
- "Append the current article to a file named FILE-NAME.
-If `gnus-article-save-coding-system' is non-nil, it is used to encode
-text and used as the value of the coding cookie which is added to the
-top of a file. Otherwise, this function saves a raw article without
-the coding cookie."
- (let* ((artbuf (current-buffer))
- (file-name-coding-system nnmail-pathname-coding-system)
- (coding gnus-article-save-coding-system)
- (coding-system-for-read (if coding
- nil ;; Rely on the coding cookie.
- mm-text-coding-system))
- (coding-system-for-write (or coding
- mm-text-coding-system-for-write
- mm-text-coding-system))
- (exists (file-exists-p file-name)))
- (with-temp-buffer
- (when exists
- (insert-file-contents file-name)
- (goto-char (point-min))
- ;; Remove the existing coding cookie.
- (when (looking-at "X-Gnus-Coding-System: .+\n\n")
- (delete-region (match-beginning 0) (match-end 0))))
- (goto-char (point-max))
- (insert-buffer-substring artbuf)
- ;; Append newline at end of the buffer as separator, and then
- ;; save it to file.
- (goto-char (point-max))
- (insert "\n")
- (when coding
- ;; If the coding system is not suitable to encode the text,
- ;; ask a user for a proper one.
- (when (fboundp 'select-safe-coding-system)
- (setq coding (coding-system-base
- (save-window-excursion
- (select-safe-coding-system (point-min) (point-max)
- coding))))
- (setq coding-system-for-write
- (or (cdr (assq coding '((mule-utf-8 . utf-8))))
- coding)))
- (goto-char (point-min))
- ;; Add the coding cookie.
- (insert (format "X-Gnus-Coding-System: -*- coding: %s; -*-\n\n"
- coding-system-for-write)))
- (if exists
- (progn
- (write-region (point-min) (point-max) file-name nil 'no-message)
- (message "Appended to %s" file-name))
- (write-region (point-min) (point-max) file-name))))
- t)
-
-(defun gnus-narrow-to-page (&optional arg)
- "Narrow the article buffer to a page.
-If given a numerical ARG, move forward ARG pages."
- (interactive "P")
- (setq arg (if arg (prefix-numeric-value arg) 0))
- (with-current-buffer gnus-article-buffer
- (widen)
- ;; Remove any old next/prev buttons.
- (when (gnus-visual-p 'page-marker)
- (let ((inhibit-read-only t))
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)))
- (let (st nd pt)
- (when (save-excursion
- (cond ((< arg 0)
- (if (re-search-backward page-delimiter nil 'move (abs arg))
- (prog1
- (setq nd (match-beginning 0)
- pt nd)
- (when (re-search-backward page-delimiter nil t)
- (setq st (match-end 0))))
- (when (re-search-forward page-delimiter nil t)
- (setq nd (match-beginning 0)
- pt (point-min)))))
- ((> arg 0)
- (if (re-search-forward page-delimiter nil 'move arg)
- (prog1
- (setq st (match-end 0)
- pt st)
- (when (re-search-forward page-delimiter nil t)
- (setq nd (match-beginning 0))))
- (when (re-search-backward page-delimiter nil t)
- (setq st (match-end 0)
- pt (point-max)))))
- (t
- (when (re-search-backward page-delimiter nil t)
- (goto-char (setq st (match-end 0))))
- (when (re-search-forward page-delimiter nil t)
- (setq nd (match-beginning 0)))
- (or st nd))))
- (setq gnus-page-broken t)
- (when pt (goto-char pt))
- (narrow-to-region (or st (point-min)) (or nd (point-max)))
- (when (gnus-visual-p 'page-marker)
- (save-excursion
- (when nd
- (goto-char nd)
- (gnus-insert-next-page-button))
- (when st
- (goto-char st)
- (gnus-insert-prev-page-button))))))))
-
-;; Article mode commands
-
-(defun gnus-article-goto-next-page ()
- "Show the next page of the article."
- (interactive)
- (when (gnus-article-next-page)
- (goto-char (point-min))
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?n))))
-
-
-(defun gnus-article-goto-prev-page ()
- "Show the previous page of the article."
- (interactive)
- (if (save-restriction (widen) (bobp)) ;; Real beginning-of-buffer?
- (gnus-article-read-summary-keys nil (gnus-character-to-event ?p))
- (gnus-article-prev-page nil)))
-
-;; This is cleaner but currently breaks `gnus-pick-mode':
-;;
-;; (defun gnus-article-goto-next-page ()
-;; "Show the next page of the article."
-;; (interactive)
-;; (gnus-eval-in-buffer-window gnus-summary-buffer
-;; (gnus-summary-next-page)))
-;;
-;; (defun gnus-article-goto-prev-page ()
-;; "Show the next page of the article."
-;; (interactive)
-;; (gnus-eval-in-buffer-window gnus-summary-buffer
-;; (gnus-summary-prev-page)))
-
-(defun gnus-article-next-page (&optional lines)
- "Show the next page of the current article.
-If end of article, return non-nil. Otherwise return nil.
-Argument LINES specifies lines to be scrolled up."
- (interactive "p")
- (move-to-window-line -1)
- (if (save-excursion
- (end-of-line)
- (and (pos-visible-in-window-p) ;Not continuation line.
- (>= (1+ (point)) (point-max)))) ;Allow for trailing newline.
- ;; Nothing in this page.
- (if (or (not gnus-page-broken)
- (save-excursion
- (save-restriction
- (widen)
- (forward-line)
- (eobp)))) ;Real end-of-buffer?
- (progn
- (when gnus-article-over-scroll
- (gnus-article-next-page-1 lines))
- t) ;Nothing more.
- (gnus-narrow-to-page 1) ;Go to next page.
- nil)
- ;; More in this page.
- (gnus-article-next-page-1 lines)
- nil))
-
-(defmacro gnus-article-beginning-of-window ()
- "Move point to the beginning of the window.
-In Emacs, the point is placed at the line number which `scroll-margin'
-specifies."
- (if (featurep 'xemacs)
- '(move-to-window-line 0)
- '(move-to-window-line
- (min (max 0 scroll-margin)
- (max 1 (- (window-height)
- (if mode-line-format 1 0)
- (if (and (boundp 'header-line-format)
- (symbol-value 'header-line-format))
- 1 0)))))))
-
-(defun gnus-article-next-page-1 (lines)
- (when (and (not (featurep 'xemacs))
- (numberp lines)
- (> lines 0)
- (numberp (symbol-value 'scroll-margin))
- (> (symbol-value 'scroll-margin) 0))
- ;; Protect against the bug that Emacs 21.x hangs up when scrolling up for
- ;; too many number of lines if `scroll-margin' is set as two or greater.
- (setq lines (min lines
- (max 0 (- (count-lines (window-start) (point-max))
- (symbol-value 'scroll-margin))))))
- (condition-case ()
- (let ((scroll-in-place nil))
- (scroll-up lines))
- (end-of-buffer
- ;; Long lines may cause an end-of-buffer error.
- (goto-char (point-max))))
- (gnus-article-beginning-of-window))
-
-(defun gnus-article-prev-page (&optional lines)
- "Show previous page of current article.
-Argument LINES specifies lines to be scrolled down."
- (interactive "p")
- (move-to-window-line 0)
- (if (and gnus-page-broken
- (bobp)
- (not (save-restriction (widen) (bobp)))) ;Real beginning-of-buffer?
- (progn
- (gnus-narrow-to-page -1) ;Go to previous page.
- (goto-char (point-max))
- (recenter -1))
- (prog1
- (condition-case ()
- (let ((scroll-in-place nil))
- (scroll-down lines))
- (beginning-of-buffer
- (goto-char (point-min))))
- (gnus-article-beginning-of-window))))
-
-(defun gnus-article-only-boring-p ()
- "Decide whether there is only boring text remaining in the article.
-Something \"interesting\" is a word of at least two letters that does
-not have a face in `gnus-article-boring-faces'."
- (when (and gnus-article-skip-boring
- (boundp 'gnus-article-boring-faces)
- (symbol-value 'gnus-article-boring-faces))
- (save-excursion
- (let ((inhibit-point-motion-hooks t))
- (catch 'only-boring
- (while (re-search-forward "\\b\\w\\w" nil t)
- (forward-char -1)
- (when (not (gnus-intersection
- (gnus-faces-at (point))
- (symbol-value 'gnus-article-boring-faces)))
- (throw 'only-boring nil)))
- (throw 'only-boring t))))))
-
-(defun gnus-article-refer-article ()
- "Read article specified by message-id around point."
- (interactive)
- (save-excursion
- (re-search-backward "[ \t]\\|^" (gnus-point-at-bol) t)
- (re-search-forward "<?news:<?\\|<" (gnus-point-at-eol) t)
- (if (re-search-forward "[^@ ]+@[^ \t>]+" (gnus-point-at-eol) t)
- (let ((msg-id (concat "<" (match-string 0) ">")))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article msg-id))
- (error "No references around point"))))
-
-(defun gnus-article-show-summary ()
- "Reconfigure windows to show summary buffer."
- (interactive)
- (if (not (gnus-buffer-live-p gnus-summary-buffer))
- (error "There is no summary buffer for this article buffer")
- (gnus-article-set-globals)
- (gnus-configure-windows 'article)
- (gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-position-point)))
-
-(defun gnus-article-describe-briefly ()
- "Describe article mode commands briefly."
- (interactive)
- (gnus-message 6 (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."
- (interactive)
- (let ((obuf (current-buffer))
- (owin (current-window-configuration))
- func)
- (switch-to-buffer gnus-article-current-summary 'norecord)
- (setq func (lookup-key (current-local-map) (this-command-keys)))
- (call-interactively func)
- (set-buffer obuf)
- (set-window-configuration owin)
- (set-window-point (get-buffer-window (current-buffer)) (point))))
-
-(defun gnus-article-summary-command-nosave ()
- "Execute the last keystroke in the summary buffer."
- (interactive)
- (let (func)
- (pop-to-buffer gnus-article-current-summary)
- (setq func (lookup-key (current-local-map) (this-command-keys)))
- (call-interactively func)))
-
-(defun gnus-article-check-buffer ()
- "Beep if not in an article buffer."
- (unless (equal major-mode 'gnus-article-mode)
- (error "Command invoked outside of a Gnus article buffer")))
-
-(defun gnus-article-read-summary-keys (&optional arg key not-restore-window)
- "Read a summary buffer key sequence and execute it from the article buffer."
- (interactive "P")
- (gnus-article-check-buffer)
- (let ((nosaves
- '("q" "Q" "c" "r" "\C-c\C-f" "m" "a" "f"
- "Zc" "ZC" "ZE" "ZQ" "ZZ" "Zn" "ZR" "ZG" "ZN" "ZP"
- "=" "^" "\M-^" "|"))
- (nosave-but-article
- '("A\r"))
- (nosave-in-article
- '("\C-d"))
- (up-to-top
- '("n" "Gn" "p" "Gp"))
- keys new-sum-point)
- (save-excursion
- (set-buffer gnus-article-current-summary)
- (let (gnus-pick-mode)
- (push (or key last-command-event) unread-command-events)
- (setq keys (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence nil))
- (read-key-sequence nil)))))
-
- (message "")
-
- (if (or (member keys nosaves)
- (member keys nosave-but-article)
- (member keys nosave-in-article))
- (let (func)
- (save-window-excursion
- (pop-to-buffer gnus-article-current-summary)
- ;; We disable the pick minor mode commands.
- (let (gnus-pick-mode)
- (setq func (lookup-key (current-local-map) keys))))
- (if (or (not func)
- (numberp func))
- (ding)
- (unless (member keys nosave-in-article)
- (set-buffer gnus-article-current-summary))
- (call-interactively func)
- (setq new-sum-point (point)))
- (when (member keys nosave-but-article)
- (pop-to-buffer gnus-article-buffer)))
- ;; These commands should restore window configuration.
- (let ((obuf (current-buffer))
- (owin (current-window-configuration))
- (opoint (point))
- win func in-buffer selected new-sum-start new-sum-hscroll)
- (cond (not-restore-window
- (pop-to-buffer gnus-article-current-summary))
- ((setq win (get-buffer-window gnus-article-current-summary))
- (select-window win))
- (t
- (switch-to-buffer gnus-article-current-summary 'norecord)))
- (setq in-buffer (current-buffer))
- ;; We disable the pick minor mode commands.
- (if (and (setq func (let (gnus-pick-mode)
- (lookup-key (current-local-map) keys)))
- (functionp func))
- (progn
- (call-interactively func)
- (when (eq win (selected-window))
- (setq new-sum-point (point)
- new-sum-start (window-start win)
- new-sum-hscroll (window-hscroll win)))
- (when (eq in-buffer (current-buffer))
- (setq selected (gnus-summary-select-article))
- (set-buffer obuf)
- (unless not-restore-window
- (set-window-configuration owin))
- (when (eq selected 'old)
- (article-goto-body)
- (set-window-start (get-buffer-window (current-buffer))
- 1)
- (set-window-point (get-buffer-window (current-buffer))
- (point)))
- (when (and (not not-restore-window)
- new-sum-point)
- (set-window-point win new-sum-point)
- (set-window-start win new-sum-start)
- (set-window-hscroll win new-sum-hscroll))))
- (set-window-configuration owin)
- (ding))))))
-
-(defun gnus-article-describe-key (key)
- "Display documentation of the function invoked by KEY. KEY is a string."
- (interactive "kDescribe key: ")
- (gnus-article-check-buffer)
- (if (eq (key-binding key) 'gnus-article-read-summary-keys)
- (save-excursion
- (set-buffer gnus-article-current-summary)
- (let (gnus-pick-mode)
- (if (featurep 'xemacs)
- (progn
- (push (elt key 0) unread-command-events)
- (setq key (events-to-keys
- (read-key-sequence "Describe key: "))))
- (setq unread-command-events
- (mapcar
- (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
- (string-to-list key)))
- (setq key (read-key-sequence "Describe key: "))))
- (describe-key key))
- (describe-key key)))
-
-(defun gnus-article-describe-key-briefly (key &optional insert)
- "Display documentation of the function invoked by KEY. KEY is a string."
- (interactive "kDescribe key: \nP")
- (gnus-article-check-buffer)
- (if (eq (key-binding key) 'gnus-article-read-summary-keys)
- (save-excursion
- (set-buffer gnus-article-current-summary)
- (let (gnus-pick-mode)
- (if (featurep 'xemacs)
- (progn
- (push (elt key 0) unread-command-events)
- (setq key (events-to-keys
- (read-key-sequence "Describe key: "))))
- (setq unread-command-events
- (mapcar
- (lambda (x) (if (>= x 128) (list 'meta (- x 128)) x))
- (string-to-list key)))
- (setq key (read-key-sequence "Describe key: "))))
- (describe-key-briefly key insert))
- (describe-key-briefly key insert)))
-
-(defun gnus-article-reply-with-original (&optional wide)
- "Start composing a reply mail to the current message.
-The text in the region will be yanked. If the region isn't active,
-the entire article will be yanked."
- (interactive "P")
- (let ((article (cdr gnus-article-current))
- contents)
- (if (not (gnus-mark-active-p))
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-reply (list (list article)) wide))
- (setq contents (buffer-substring (point) (mark t)))
- ;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
- (setq mark-active nil))
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-reply
- (list (list article contents)) wide)))))
-
-(defun gnus-article-followup-with-original ()
- "Compose a followup to the current article.
-The text in the region will be yanked. If the region isn't active,
-the entire article will be yanked."
- (interactive)
- (let ((article (cdr gnus-article-current))
- contents)
- (if (not (gnus-mark-active-p))
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-followup (list (list article))))
- (setq contents (buffer-substring (point) (mark t)))
- ;; Deactivate active regions.
- (when (and (boundp 'transient-mark-mode)
- transient-mark-mode)
- (setq mark-active nil))
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-followup
- (list (list article contents)))))))
-
-(defun gnus-article-hide (&optional arg force)
- "Hide all the gruft in the current article.
-This means that signatures, cited text and (some) headers will be
-hidden.
-If given a prefix, show the hidden text instead."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
- (gnus-article-hide-headers arg)
- (gnus-article-hide-list-identifiers arg)
- (gnus-article-hide-citation-maybe arg force)
- (gnus-article-hide-signature arg))
-
-(defun gnus-article-maybe-highlight ()
- "Do some article highlighting if article highlighting is requested."
- (when (gnus-visual-p 'article-highlight 'highlight)
- (gnus-article-highlight-some)))
-
-(defun gnus-check-group-server ()
- ;; Make sure the connection to the server is alive.
- (unless (gnus-server-opened
- (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
- (gnus-request-group gnus-newsgroup-name t)))
-
-(eval-when-compile
- (autoload 'nneething-get-file-name "nneething"))
-
-(defun gnus-request-article-this-buffer (article group)
- "Get an article and insert it into this buffer."
- (let (do-update-line sparse-header)
- (prog1
- (save-excursion
- (erase-buffer)
- (gnus-kill-all-overlays)
- (setq group (or group gnus-newsgroup-name))
-
- ;; Using `gnus-request-article' directly will insert the article into
- ;; `nntp-server-buffer' - so we'll save some time by not having to
- ;; copy it from the server buffer into the article buffer.
-
- ;; We only request an article by message-id when we do not have the
- ;; headers for it, so we'll have to get those.
- (when (stringp article)
- (gnus-read-header article))
-
- ;; If the article number is negative, that means that this article
- ;; doesn't belong in this newsgroup (possibly), so we find its
- ;; message-id and request it by id instead of number.
- (when (and (numberp article)
- gnus-summary-buffer
- (get-buffer gnus-summary-buffer)
- (gnus-buffer-exists-p gnus-summary-buffer))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((header (gnus-summary-article-header article)))
- (when (< article 0)
- (cond
- ((memq article gnus-newsgroup-sparse)
- ;; This is a sparse gap article.
- (setq do-update-line article)
- (setq article (mail-header-id header))
- (setq sparse-header (gnus-read-header article))
- (setq gnus-newsgroup-sparse
- (delq article gnus-newsgroup-sparse)))
- ((vectorp header)
- ;; It's a real article.
- (setq article (mail-header-id header)))
- (t
- ;; It is an extracted pseudo-article.
- (setq article 'pseudo)
- (gnus-request-pseudo-article header))))
-
- (let ((method (gnus-find-method-for-group
- gnus-newsgroup-name)))
- (when (and (eq (car method) 'nneething)
- (vectorp header))
- (let ((dir (nneething-get-file-name
- (mail-header-id header))))
- (when (and (stringp dir)
- (file-directory-p dir))
- (setq article 'nneething)
- (gnus-group-enter-directory dir))))))))
-
- (cond
- ;; Refuse to select canceled articles.
- ((and (numberp article)
- gnus-summary-buffer
- (get-buffer gnus-summary-buffer)
- (gnus-buffer-exists-p gnus-summary-buffer)
- (eq (cdr (save-excursion
- (set-buffer gnus-summary-buffer)
- (assq article gnus-newsgroup-reads)))
- gnus-canceled-mark))
- nil)
- ;; We first check `gnus-original-article-buffer'.
- ((and (get-buffer gnus-original-article-buffer)
- (numberp article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (and (equal (car gnus-original-article) group)
- (eq (cdr gnus-original-article) article))))
- (insert-buffer-substring gnus-original-article-buffer)
- 'article)
- ;; Check the backlog.
- ((and gnus-keep-backlog
- (gnus-backlog-request-article group article (current-buffer)))
- 'article)
- ;; Check asynchronous pre-fetch.
- ((gnus-async-request-fetched-article group article (current-buffer))
- (gnus-async-prefetch-next group article gnus-summary-buffer)
- (when (and (numberp article) gnus-keep-backlog)
- (gnus-backlog-enter-article group article (current-buffer)))
- 'article)
- ;; Check the cache.
- ((and gnus-use-cache
- (numberp article)
- (gnus-cache-request-article article group))
- 'article)
- ;; Check the agent cache.
- ((gnus-agent-request-article article group)
- 'article)
- ;; Get the article and put into the article buffer.
- ((or (stringp article)
- (numberp article))
- (let ((gnus-override-method gnus-override-method)
- (methods (and (stringp article)
- gnus-refer-article-method))
- (backend (car (gnus-find-method-for-group
- gnus-newsgroup-name)))
- result
- (inhibit-read-only t))
- (if (or (not (listp methods))
- (and (symbolp (car methods))
- (assq (car methods) nnoo-definition-alist)))
- (setq methods (list methods)))
- (when (and (null gnus-override-method)
- methods)
- (setq gnus-override-method (pop methods)))
- (while (not result)
- (when (eq gnus-override-method 'current)
- (setq gnus-override-method
- (with-current-buffer gnus-summary-buffer
- gnus-current-select-method)))
- (erase-buffer)
- (gnus-kill-all-overlays)
- (let ((gnus-newsgroup-name group))
- (gnus-check-group-server))
- (cond
- ((gnus-request-article article group (current-buffer))
- (when (numberp article)
- (gnus-async-prefetch-next group article
- gnus-summary-buffer)
- (when gnus-keep-backlog
- (gnus-backlog-enter-article
- group article (current-buffer))))
- (setq result 'article))
- (methods
- (setq gnus-override-method (pop methods)))
- ((not (string-match "^400 "
- (nnheader-get-report backend)))
- ;; If we get 400 server disconnect, reconnect and
- ;; retry; otherwise, assume the article has expired.
- (setq result 'done))))
- (and (eq result 'article) 'article)))
- ;; It was a pseudo.
- (t article)))
-
- ;; Associate this article with the current summary buffer.
- (setq gnus-article-current-summary gnus-summary-buffer)
-
- ;; Take the article from the original article buffer
- ;; and place it in the buffer it's supposed to be in.
- (when (and (get-buffer gnus-article-buffer)
- (equal (buffer-name (current-buffer))
- (buffer-name (get-buffer gnus-article-buffer))))
- (save-excursion
- (if (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (set-buffer (gnus-get-buffer-create gnus-original-article-buffer))
- (buffer-disable-undo)
- (setq major-mode 'gnus-original-article-mode)
- (setq buffer-read-only t))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert-buffer-substring gnus-article-buffer))
- (setq gnus-original-article (cons group article)))
-
- ;; Decode charsets.
- (run-hooks 'gnus-article-decode-hook)
- ;; Mark article as decoded or not.
- (setq gnus-article-decoded-p gnus-article-decode-hook))
-
- ;; Update sparse articles.
- (when (and do-update-line
- (or (numberp article)
- (stringp article)))
- (let ((buf (current-buffer)))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-update-article do-update-line sparse-header)
- (gnus-summary-goto-subject do-update-line nil t)
- (set-window-point (gnus-get-buffer-window (current-buffer) t)
- (point))
- (set-buffer buf))))))
-
-;;;
-;;; Article editing
-;;;
-
-(defcustom gnus-article-edit-mode-hook nil
- "Hook run in article edit mode buffers."
- :group 'gnus-article-various
- :type 'hook)
-
-(defvar gnus-article-edit-done-function nil)
-
-(defvar gnus-article-edit-mode-map nil)
-(defvar gnus-article-edit-mode nil)
-
-;; Should we be using derived.el for this?
-(unless gnus-article-edit-mode-map
- (setq gnus-article-edit-mode-map (make-keymap))
- (set-keymap-parent gnus-article-edit-mode-map text-mode-map)
-
- (gnus-define-keys gnus-article-edit-mode-map
- "\C-c?" describe-mode
- "\C-c\C-c" gnus-article-edit-done
- "\C-c\C-k" gnus-article-edit-exit
- "\C-c\C-f\C-t" message-goto-to
- "\C-c\C-f\C-o" message-goto-from
- "\C-c\C-f\C-b" message-goto-bcc
- ;;"\C-c\C-f\C-w" message-goto-fcc
- "\C-c\C-f\C-c" message-goto-cc
- "\C-c\C-f\C-s" message-goto-subject
- "\C-c\C-f\C-r" message-goto-reply-to
- "\C-c\C-f\C-n" message-goto-newsgroups
- "\C-c\C-f\C-d" message-goto-distribution
- "\C-c\C-f\C-f" message-goto-followup-to
- "\C-c\C-f\C-m" message-goto-mail-followup-to
- "\C-c\C-f\C-k" message-goto-keywords
- "\C-c\C-f\C-u" message-goto-summary
- "\C-c\C-f\C-i" message-insert-or-toggle-importance
- "\C-c\C-f\C-a" message-generate-unsubscribed-mail-followup-to
- "\C-c\C-b" message-goto-body
- "\C-c\C-i" message-goto-signature
-
- "\C-c\C-t" message-insert-to
- "\C-c\C-n" message-insert-newsgroups
- "\C-c\C-o" message-sort-headers
- "\C-c\C-e" message-elide-region
- "\C-c\C-v" message-delete-not-region
- "\C-c\C-z" message-kill-to-signature
- "\M-\r" message-newline-and-reformat
- "\C-c\C-a" mml-attach-file
- "\C-a" message-beginning-of-line
- "\t" message-tab
- "\M-;" comment-region)
-
- (gnus-define-keys (gnus-article-edit-wash-map
- "\C-c\C-w" gnus-article-edit-mode-map)
- "f" gnus-article-edit-full-stops))
-
-(easy-menu-define
- gnus-article-edit-mode-field-menu gnus-article-edit-mode-map ""
- '("Field"
- ["Fetch To" message-insert-to t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- "----"
- ["To" message-goto-to t]
- ["From" message-goto-from t]
- ["Subject" message-goto-subject t]
- ["Cc" message-goto-cc t]
- ["Reply-To" message-goto-reply-to t]
- ["Summary" message-goto-summary t]
- ["Keywords" message-goto-keywords t]
- ["Newsgroups" message-goto-newsgroups t]
- ["Followup-To" message-goto-followup-to t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
- ["Distribution" message-goto-distribution t]
- ["Body" message-goto-body t]
- ["Signature" message-goto-signature t]))
-
-(define-derived-mode gnus-article-edit-mode message-mode "Article Edit"
- "Major mode for editing articles.
-This is an extended text-mode.
-
-\\{gnus-article-edit-mode-map}"
- (make-local-variable 'gnus-article-edit-done-function)
- (make-local-variable 'gnus-prev-winconf)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
- (set (make-local-variable 'mail-header-separator) "")
- (set (make-local-variable 'gnus-article-edit-mode) t)
- (easy-menu-add message-mode-field-menu message-mode-map)
- (mml-mode)
- (setq buffer-read-only nil)
- (buffer-enable-undo)
- (widen))
-
-(defun gnus-article-edit (&optional force)
- "Edit the current article.
-This will have permanent effect only in mail groups.
-If FORCE is non-nil, allow editing of articles even in read-only
-groups."
- (interactive "P")
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- (gnus-article-date-original)
- (gnus-article-edit-article
- 'ignore
- `(lambda (no-highlight)
- 'ignore
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p) ,gnus-summary-buffer no-highlight))))
-
-(defun gnus-article-edit-article (start-func exit-func)
- "Start editing the contents of the current article buffer."
- (let ((winconf (current-window-configuration)))
- (set-buffer gnus-article-buffer)
- (let ((message-auto-save-directory
- ;; Don't associate the article buffer with a draft file.
- nil))
- (gnus-article-edit-mode))
- (funcall start-func)
- (set-buffer-modified-p nil)
- (gnus-configure-windows 'edit-article)
- (setq gnus-article-edit-done-function exit-func)
- (setq gnus-prev-winconf winconf)
- (gnus-message 6 "C-c C-c to end edits")))
-
-(defun gnus-article-edit-done (&optional arg)
- "Update the article edits and exit."
- (interactive "P")
- (let ((func gnus-article-edit-done-function)
- (buf (current-buffer))
- (start (window-start))
- (p (point))
- (winconf gnus-prev-winconf))
- (widen) ;; Widen it in case that users narrowed the buffer.
- (funcall func arg)
- (set-buffer buf)
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; Flush original article as well.
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))
- ;; We remove all text props from the article buffer.
- (kill-all-local-variables)
- (gnus-set-text-properties (point-min) (point-max) nil)
- (gnus-article-mode)
- (set-window-configuration winconf)
- (set-buffer buf)
- (set-window-start (get-buffer-window buf) start)
- (set-window-point (get-buffer-window buf) (point)))
- (gnus-summary-show-article))
-
-(defun gnus-article-edit-exit ()
- "Exit the article editing without updating."
- (interactive)
- (when (or (not (buffer-modified-p))
- (yes-or-no-p "Article modified; kill anyway? "))
- (let ((curbuf (current-buffer))
- (p (point))
- (window-start (window-start)))
- (erase-buffer)
- (if (gnus-buffer-live-p gnus-original-article-buffer)
- (insert-buffer-substring gnus-original-article-buffer))
- (let ((winconf gnus-prev-winconf))
- (kill-all-local-variables)
- (gnus-article-mode)
- (set-window-configuration winconf)
- ;; Tippy-toe some to make sure that point remains where it was.
- (save-current-buffer
- (set-buffer curbuf)
- (set-window-start (get-buffer-window (current-buffer)) window-start)
- (goto-char p))))
- (gnus-summary-show-article)))
-
-(defun gnus-article-edit-full-stops ()
- "Interactively repair spacing at end of sentences."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (search-forward-regexp "^$" nil t)
- (let ((case-fold-search nil))
- (query-replace-regexp "\\([.!?][])}]* \\)\\([[({A-Z]\\)" "\\1 \\2"))))
-
-;;;
-;;; Article highlights
-;;;
-
-;; Written by Per Abrahamsen <abraham@iesd.auc.dk>.
-
-;;; Internal Variables:
-
-(defcustom gnus-button-url-regexp
- (if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?[-a-z0-9_=!?#$@~%&*+\\/:;.,[:word:]]+[-a-z0-9_=#$@~%&*+\\/[:word:]]\\)"
- "\\b\\(\\(www\\.\\|\\(s?https?\\|ftp\\|file\\|gopher\\|nntp\\|news\\|telnet\\|wais\\|mailto\\|info\\):\\)\\(//[-a-z0-9_.]+:[0-9]*\\)?\\([-a-z0-9_=!?#$@~%&*+\\/:;.,]\\|\\w\\)+\\([-a-z0-9_=#$@~%&*+\\/]\\|\\w\\)\\)")
- "Regular expression that matches URLs."
- :group 'gnus-article-buttons
- :type 'regexp)
-
-(defcustom gnus-button-valid-fqdn-regexp
- message-valid-fqdn-regexp
- "Regular expression that matches a valid FQDN."
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'regexp)
-
-;; Regexp suggested by Felix Wiemann in <87oeuomcz9.fsf@news2.ososo.de>
-(defcustom gnus-button-valid-localpart-regexp
- "[a-z0-9$%(*-=?[_][^<>\")!;:,{}\n\t @]*"
- "Regular expression that matches a localpart of mail addresses or MIDs."
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'regexp)
-
-(defcustom gnus-button-man-handler 'manual-entry
- "Function to use for displaying man pages.
-The function must take at least one argument with a string naming the
-man page."
- :version "22.1"
- :type '(choice (function-item :tag "Man" manual-entry)
- (function-item :tag "Woman" woman)
- (function :tag "Other"))
- :group 'gnus-article-buttons)
-
-(defcustom gnus-ctan-url "http://tug.ctan.org/tex-archive/"
- "Top directory of a CTAN \(Comprehensive TeX Archive Network\) archive.
-If the default site is too slow, try to find a CTAN mirror, see
-<URL:http://tug.ctan.org/tex-archive/CTAN.sites?action=/index.html>. See also
-the variable `gnus-button-handle-ctan'."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type '(choice (const "http://www.tex.ac.uk/tex-archive/")
- (const "http://tug.ctan.org/tex-archive/")
- (const "http://www.dante.de/CTAN/")
- (string :tag "Other")))
-
-(defcustom gnus-button-ctan-handler 'browse-url
- "Function to use for displaying CTAN links.
-The function must take one argument, the string naming the URL."
- :version "22.1"
- :type '(choice (function-item :tag "Browse Url" browse-url)
- (function :tag "Other"))
- :group 'gnus-article-buttons)
-
-(defcustom gnus-button-handle-ctan-bogus-regexp "^/?tex-archive/\\|^/"
- "Bogus strings removed from CTAN URLs."
- :version "22.1"
- :group 'gnus-article-buttons
- :type '(choice (const "^/?tex-archive/\\|/")
- (regexp :tag "Other")))
-
-(defcustom gnus-button-ctan-directory-regexp
- (regexp-opt
- (list "archive-tools" "biblio" "bibliography" "digests" "documentation"
- "dviware" "fonts" "graphics" "help" "indexing" "info" "language"
- "languages" "macros" "nonfree" "obsolete" "support" "systems"
- "tds" "tools" "usergrps" "web") t)
- "Regular expression for ctan directories.
-It should match all directories in the top level of `gnus-ctan-url'."
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'regexp)
-
-(defcustom gnus-button-mid-or-mail-regexp
- (concat "\\b\\(<?" gnus-button-valid-localpart-regexp "@"
- gnus-button-valid-fqdn-regexp
- ">?\\)\\b")
- "Regular expression that matches a message ID or a mail address."
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'regexp)
-
-(defcustom gnus-button-prefer-mid-or-mail 'gnus-button-mid-or-mail-heuristic
- "What to do when the button on a string as \"foo123@bar.invalid\" is pushed.
-Strings like this can be either a message ID or a mail address. If it is one
-of the symbols `mid' or `mail', Gnus will always assume that the string is a
-message ID or a mail address, respectively. If this variable is set to the
-symbol `ask', always query the user what do do. If it is a function, this
-function will be called with the string as its only argument. The function
-must return `mid', `mail', `invalid' or `ask'."
- :version "22.1"
- :group 'gnus-article-buttons
- :type '(choice (function-item :tag "Heuristic function"
- gnus-button-mid-or-mail-heuristic)
- (const ask)
- (const mid)
- (const mail)))
-
-(defcustom gnus-button-mid-or-mail-heuristic-alist
- '((-10.0 . ".+\\$.+@")
- (-10.0 . "#")
- (-10.0 . "\\*")
- (-5.0 . "\\+[^+]*\\+.*@") ;; # two plus signs
- (-5.0 . "@[Nn][Ee][Ww][Ss]") ;; /\@news/i
- (-5.0 . "@.*[Dd][Ii][Aa][Ll][Uu][Pp]") ;; /\@.*dialup/i;
- (-1.0 . "^[^a-z]+@")
- ;;
- (-5.0 . "\\.[0-9][0-9]+.*@") ;; "\.[0-9]{2,}.*\@"
- (-5.0 . "[a-z].*[A-Z].*[a-z].*[A-Z].*@") ;; "([a-z].*[A-Z].*){2,}\@"
- (-3.0 . "[A-Z][A-Z][a-z][a-z].*@")
- (-5.0 . "\\...?.?@") ;; (-5.0 . "\..{1,3}\@")
- ;;
- (-2.0 . "^[0-9]")
- (-1.0 . "^[0-9][0-9]")
- ;;
- ;; -3.0 /^[0-9][0-9a-fA-F]{2,2}/;
- (-3.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
- ;; -5.0 /^[0-9][0-9a-fA-F]{3,3}/;
- (-5.0 . "^[0-9][0-9a-fA-F][0-9a-fA-F][0-9a-fA-F][^0-9a-fA-F]")
- ;;
- (-3.0 . "[0-9][0-9][0-9][0-9][0-9][^0-9].*@") ;; "[0-9]{5,}.*\@"
- (-3.0 . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][^0-9].*@")
- ;; "[0-9]{8,}.*\@"
- (-3.0
- . "[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9].*@")
- ;; "[0-9]{12,}.*\@"
- ;; compensation for TDMA dated mail addresses:
- (25.0 . "-dated-[0-9][0-9][0-9][0-9][0-9][0-9][0-9][0-9]+.*@")
- ;;
- (-20.0 . "\\.fsf@") ;; Gnus
- (-20.0 . "^slrn")
- (-20.0 . "^Pine")
- (-20.0 . "_-_") ;; Subject change in thread
- ;;
- (-20.0 . "\\.ln@") ;; leafnode
- (-30.0 . "@ID-[0-9]+\\.[a-zA-Z]+\\.dfncis\\.de")
- (-30.0 . "@4[Aa][Xx]\\.com") ;; Forte Agent
- ;;
- ;; (5.0 . "") ;; $local_part_len <= 7
- (10.0 . "^[^0-9]+@")
- (3.0 . "^[^0-9]+[0-9][0-9]?[0-9]?@")
- ;; ^[^0-9]+[0-9]{1,3}\@ digits only at end of local part
- (3.0 . "\@stud")
- ;;
- (2.0 . "[a-z][a-z][._-][A-Z][a-z].*@")
- ;;
- (0.5 . "^[A-Z][a-z]")
- (0.5 . "^[A-Z][a-z][a-z]")
- (1.5 . "^[A-Z][a-z][A-Z][a-z][^a-z]") ;; ^[A-Z][a-z]{3,3}
- (2.0 . "^[A-Z][a-z][A-Z][a-z][a-z][^a-z]")) ;; ^[A-Z][a-z]{4,4}
- "An alist of \(RATE . REGEXP\) pairs for `gnus-button-mid-or-mail-heuristic'.
-
-A negative RATE indicates a message IDs, whereas a positive indicates a mail
-address. The REGEXP is processed with `case-fold-search' set to nil."
- :version "22.1"
- :group 'gnus-article-buttons
- :type '(repeat (cons (number :tag "Rate")
- (regexp :tag "Regexp"))))
-
-(defun gnus-button-mid-or-mail-heuristic (mid-or-mail)
- "Guess whether MID-OR-MAIL is a message ID or a mail address.
-Returns `mid' if MID-OR-MAIL is a message IDs, `mail' if it's a mail
-address, `ask' if unsure and `invalid' if the string is invalid."
- (let ((case-fold-search nil)
- (list gnus-button-mid-or-mail-heuristic-alist)
- (result 0) rate regexp lpartlen elem)
- (setq lpartlen
- (length (gnus-replace-in-string mid-or-mail "^\\(.*\\)@.*$" "\\1")))
- (gnus-message 8 "`%s', length of local part=`%s'." mid-or-mail lpartlen)
- ;; Certain special cases...
- (when (string-match
- (concat
- "^0[0-9]+-[0-9][0-9][0-9][0-9]@t-online\\.de$\\|"
- "^[0-9]+\\.[0-9]+@compuserve\\|"
- "@public\\.gmane\\.org")
- mid-or-mail)
- (gnus-message 8 "`%s' is a known mail address." mid-or-mail)
- (setq result 'mail))
- (when (string-match "@.*@\\| " mid-or-mail)
- (gnus-message 8 "`%s' is invalid." mid-or-mail)
- (setq result 'invalid))
- ;; Nothing more to do, if result is not a number here...
- (when (numberp result)
- (while list
- (setq elem (car list)
- rate (car elem)
- regexp (cdr elem)
- list (cdr list))
- (when (string-match regexp mid-or-mail)
- (setq result (+ result rate))
- (gnus-message
- 9 "`%s' matched `%s', rate `%s', result `%s'."
- mid-or-mail regexp rate result)))
- (when (<= lpartlen 7)
- (setq result (+ result 5.0))
- (gnus-message 9 "`%s' matched (<= lpartlen 7), result `%s'."
- mid-or-mail result))
- (when (>= lpartlen 12)
- (gnus-message 9 "`%s' matched (>= lpartlen 12)" mid-or-mail)
- (cond
- ((string-match "[0-9][^0-9]+[0-9].*@" mid-or-mail)
- ;; Long local part should contain realname if e-mail address,
- ;; too many digits: message-id.
- ;; $score -= 5.0 + 0.1 * $local_part_len;
- (setq rate (* -1.0 (+ 5.0 (* 0.1 lpartlen))))
- (setq result (+ result rate))
- (gnus-message
- 9 "Many digits in `%s', rate `%s', result `%s'."
- mid-or-mail rate result))
- ((string-match "[^aeiouy][^aeiouy][^aeiouy][^aeiouy]+.*\@"
- mid-or-mail)
- ;; Too few vowels [^aeiouy]{4,}.*\@
- (setq result (+ result -5.0))
- (gnus-message
- 9 "Few vowels in `%s', rate `%s', result `%s'."
- mid-or-mail -5.0 result))
- (t
- (setq result (+ result 5.0))
- (gnus-message
- 9 "`%s', rate `%s', result `%s'." mid-or-mail 5.0 result)))))
- (gnus-message 8 "`%s': Final rate is `%s'." mid-or-mail result)
- ;; Maybe we should make this a customizable alist: (condition . 'result)
- (cond
- ((symbolp result) result)
- ;; Now convert number into proper results:
- ((< result -10.0) 'mid)
- ((> result 10.0) 'mail)
- (t 'ask))))
-
-(defun gnus-button-handle-mid-or-mail (mid-or-mail)
- (let* ((pref gnus-button-prefer-mid-or-mail) guessed
- (url-mid (concat "news" ":" mid-or-mail))
- (url-mailto (concat "mailto" ":" mid-or-mail)))
- (gnus-message 9 "mid-or-mail=%s" mid-or-mail)
- (when (fboundp pref)
- (setq guessed
- ;; get rid of surrounding angles...
- (funcall pref
- (gnus-replace-in-string mid-or-mail "^<\\|>$" "")))
- (if (or (eq 'mid guessed) (eq 'mail guessed))
- (setq pref guessed)
- (setq pref 'ask)))
- (if (eq pref 'ask)
- (save-window-excursion
- (if (y-or-n-p (concat "Is <" mid-or-mail "> a mail address? "))
- (setq pref 'mail)
- (setq pref 'mid))))
- (cond ((eq pref 'mid)
- (gnus-message 8 "calling `gnus-button-handle-news' %s" url-mid)
- (gnus-button-handle-news url-mid))
- ((eq pref 'mail)
- (gnus-message 8 "calling `gnus-url-mailto' %s" url-mailto)
- (gnus-url-mailto url-mailto))
- (t (gnus-message 3 "Invalid string.")))))
-
-(defun gnus-button-handle-custom (url)
- "Follow a Custom URL."
- (customize-apropos (gnus-url-unhex-string url)))
-
-(defvar gnus-button-handle-describe-prefix "^\\(C-h\\|<?[Ff]1>?\\)")
-
-;; FIXME: Maybe we should merge some of the functions that do quite similar
-;; stuff?
-
-(defun gnus-button-handle-describe-function (url)
- "Call `describe-function' when pushing the corresponding URL button."
- (describe-function
- (intern
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
-
-(defun gnus-button-handle-describe-variable (url)
- "Call `describe-variable' when pushing the corresponding URL button."
- (describe-variable
- (intern
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))))
-
-(defun gnus-button-handle-symbol (url)
-"Display help on variable or function.
-Calls `describe-variable' or `describe-function'."
- (let ((sym (intern url)))
- (cond
- ((fboundp sym) (describe-function sym))
- ((boundp sym) (describe-variable sym))
- (t (gnus-message 3 "`%s' is not a known function of variable." url)))))
-
-(defun gnus-button-handle-describe-key (url)
- "Call `describe-key' when pushing the corresponding URL button."
- (let* ((key-string
- (gnus-replace-in-string url gnus-button-handle-describe-prefix ""))
- (keys (ignore-errors (eval `(kbd ,key-string)))))
- (if keys
- (describe-key keys)
- (gnus-message 3 "Invalid key sequence in button: %s" key-string))))
-
-(defun gnus-button-handle-apropos (url)
- "Call `apropos' when pushing the corresponding URL button."
- (apropos (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
-
-(defun gnus-button-handle-apropos-command (url)
- "Call `apropos' when pushing the corresponding URL button."
- (apropos-command
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
-
-(defun gnus-button-handle-apropos-variable (url)
- "Call `apropos' when pushing the corresponding URL button."
- (funcall
- (if (fboundp 'apropos-variable) 'apropos-variable 'apropos)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
-
-(defun gnus-button-handle-apropos-documentation (url)
- "Call `apropos' when pushing the corresponding URL button."
- (funcall
- (if (fboundp 'apropos-documentation) 'apropos-documentation 'apropos)
- (gnus-replace-in-string url gnus-button-handle-describe-prefix "")))
-
-(defun gnus-button-handle-library (url)
- "Call `locate-library' when pushing the corresponding URL button."
- (gnus-message 9 "url=`%s'" url)
- (let* ((lib (locate-library url))
- (file (gnus-replace-in-string (or lib "") "\.elc" ".el")))
- (if (not lib)
- (gnus-message 1 "Cannot locale library `%s'." url)
- (find-file-read-only file))))
-
-(defun gnus-button-handle-ctan (url)
- "Call `browse-url' when pushing a CTAN URL button."
- (funcall
- gnus-button-ctan-handler
- (concat
- gnus-ctan-url
- (gnus-replace-in-string url gnus-button-handle-ctan-bogus-regexp ""))))
-
-(defcustom gnus-button-tex-level 5
- "*Integer that says how many TeX-related buttons Gnus will show.
-The higher the number, the more buttons will appear and the more false
-positives are possible. Note that you can set this variable local to
-specific groups. Setting it higher in TeX groups is probably a good idea.
-See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
-how to set variables in specific groups."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type 'integer)
-
-(defcustom gnus-button-man-level 5
- "*Integer that says how many man-related buttons Gnus will show.
-The higher the number, the more buttons will appear and the more false
-positives are possible. Note that you can set this variable local to
-specific groups. Setting it higher in Unix groups is probably a good idea.
-See Info node `(gnus)Group Parameters' and the variable `gnus-parameters' on
-how to set variables in specific groups."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type 'integer)
-
-(defcustom gnus-button-emacs-level 5
- "*Integer that says how many emacs-related buttons Gnus will show.
-The higher the number, the more buttons will appear and the more false
-positives are possible. Note that you can set this variable local to
-specific groups. Setting it higher in Emacs or Gnus related groups is
-probably a good idea. See Info node `(gnus)Group Parameters' and the variable
-`gnus-parameters' on how to set variables in specific groups."
- :version "22.1"
- :group 'gnus-article-buttons
- :link '(custom-manual "(gnus)Group Parameters")
- :type 'integer)
-
-(defcustom gnus-button-message-level 5
- "*Integer that says how many buttons for news or mail messages will appear.
-The higher the number, the more buttons will appear and the more false
-positives are possible."
- ;; mail addresses, MIDs, URLs for news, ...
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'integer)
-
-(defcustom gnus-button-browse-level 5
- "*Integer that says how many buttons for browsing will appear.
-The higher the number, the more buttons will appear and the more false
-positives are possible."
- ;; stuff handled by `browse-url' or `gnus-button-embedded-url'
- :version "22.1"
- :group 'gnus-article-buttons
- :type 'integer)
-
-(defcustom gnus-button-alist
- '(("<\\(url:[>\n\t ]*?\\)?\\(nntp\\|news\\):[>\n\t ]*\\([^>\n\t ]*@[^>\n\t ]*\\)>"
- 0 (>= gnus-button-message-level 0) gnus-button-handle-news 3)
- ((concat "\\b\\(nntp\\|news\\):\\("
- gnus-button-valid-localpart-regexp "@[a-z0-9.-]+[a-z]\\)")
- 0 t gnus-button-handle-news 2)
- ("\\(\\b<\\(url:[>\n\t ]*\\)?\\(nntp\\|news\\):[>\n\t ]*\\(//\\)?\\([^>\n\t ]*\\)>\\)"
- 1 (>= gnus-button-message-level 0) gnus-button-fetch-group 5)
- ("\\b\\(nntp\\|news\\):\\(//\\)?\\([^'\">\n\t ]+\\)"
- 0 (>= gnus-button-message-level 0) gnus-button-fetch-group 3)
- ;; RFC 2392 (Don't allow `/' in domain part --> CID)
- ("\\bmid:\\(//\\)?\\([^'\">\n\t ]+@[^'\">\n\t /]+\\)"
- 0 (>= gnus-button-message-level 0) gnus-button-message-id 2)
- ("\\bin\\( +article\\| +message\\)? +\\(<\\([^\n @<>]+@[^\n @<>]+\\)>\\)"
- 2 (>= gnus-button-message-level 0) gnus-button-message-id 3)
- ("\\(<URL: *\\)mailto: *\\([^> \n\t]+\\)>"
- 0 (>= gnus-button-message-level 0) gnus-url-mailto 2)
- ;; RFC 2368 (The mailto URL scheme)
- ("\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
- 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
- ("\\bmailto:\\([^ \n\t]+\\)"
- 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
- ;; CTAN
- ((concat "\\bCTAN:[ \t\n]?[^>)!;:,'\n\t ]*\\("
- gnus-button-ctan-directory-regexp
- "[^][>)!;:,'\n\t ]+\\)")
- 0 (>= gnus-button-tex-level 1) gnus-button-handle-ctan 1)
- ((concat "\\btex-archive/\\("
- gnus-button-ctan-directory-regexp
- "/[-_.a-z0-9/]+[-_./a-z0-9]+[/a-z0-9]\\)")
- 1 (>= gnus-button-tex-level 6) gnus-button-handle-ctan 1)
- ((concat
- "\\b\\("
- gnus-button-ctan-directory-regexp
- "/[-_.a-z0-9]+/[-_./a-z0-9]+[/a-z0-9]\\)")
- 1 (>= gnus-button-tex-level 8) gnus-button-handle-ctan 1)
- ;; This is info (home-grown style) <info://foo/bar+baz>
- ("\\binfo://\\([^'\">\n\t ]+\\)"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 1)
- ;; Info GNOME style <info:foo#bar_baz>
- ("\\binfo:\\([^('\n\t\r \"><][^'\n\t\r \"><]*\\)"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-gnome 1)
- ;; Info KDE style <info:(foo)bar baz>
- ("<\\(info:\\(([^)]+)[^>\n\r]*\\)\\)>"
- 1 (>= gnus-button-emacs-level 1) gnus-button-handle-info-url-kde 2)
- ("\\((Info-goto-node\\|(info\\)[ \t\n]*\\(\"[^\"]*\"\\))" 0
- (>= gnus-button-emacs-level 1) gnus-button-handle-info-url 2)
- ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+i[ \t\n]+d?[ \t\n]?m[ \t\n]+\\([^ ]+ ?[^ ]+\\)[ \t\n]+RET"
- ;; Info links like `C-h i d m CC Mode RET'
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-info-keystrokes 2)
- ;; This is custom
- ("\\bcustom:\\(//\\)?\\([^'\">\n\t ]+\\)"
- 0 (>= gnus-button-emacs-level 5) gnus-button-handle-custom 2)
- ("M-x[ \t\n]customize-[^ ]+[ \t\n]RET[ \t\n]\\([^ ]+\\)[ \t\n]RET" 0
- (>= gnus-button-emacs-level 1) gnus-button-handle-custom 1)
- ;; Emacs help commands
- ("M-x[ \t\n]+apropos[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- ;; regexp doesn't match arguments containing ` '.
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos 1)
- ("M-x[ \t\n]+apropos-command[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-command 1)
- ("M-x[ \t\n]+apropos-variable[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-variable 1)
- ("M-x[ \t\n]+apropos-documentation[ \t\n]+RET[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-apropos-documentation 1)
- ;; The following entries may lead to many false positives so don't enable
- ;; them by default (use a high button level).
- ("/\\([a-z][-a-z0-9]+\\.el\\)\\>[^.?]"
- ;; Exclude [.?] for URLs in gmane.emacs.cvs
- 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][-a-z0-9]+\\.el\\)'"
- 1 (>= gnus-button-emacs-level 8) gnus-button-handle-library 1)
- ("`\\([a-z][a-z0-9]+-[a-z]+-[-a-z]+\\|\\(gnus\\|message\\)-[-a-z]+\\)'"
- 0 (>= gnus-button-emacs-level 8) gnus-button-handle-symbol 1)
- ("`\\([a-z][a-z0-9]+-[a-z]+\\)'"
- 0 (>= gnus-button-emacs-level 9) gnus-button-handle-symbol 1)
- ("(setq[ \t\n]+\\([a-z][a-z0-9]+-[-a-z0-9]+\\)[ \t\n]+.+)"
- 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-variable 1)
- ("\\bM-x[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 1 (>= gnus-button-emacs-level 7) gnus-button-handle-describe-function 1)
- ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+f[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-function 2)
- ("\\b\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+v[ \t\n]+\\([^ \t\n]+\\)[ \t\n]+RET"
- 0 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-variable 2)
- ("`\\(\\(C-h\\|<?[Ff]1>?\\)[ \t\n]+k[ \t\n]+\\([^']+\\)\\)'"
- ;; Unlike the other regexps we really have to require quoting
- ;; here to determine where it ends.
- 1 (>= gnus-button-emacs-level 1) gnus-button-handle-describe-key 3)
- ;; This is how URLs _should_ be embedded in text (RFC 1738, RFC 2396)...
- ("<URL: *\\([^<>]*\\)>"
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; RFC 2396 (2.4.3., delims) ...
- ("\"URL: *\\([^\"]*\\)\""
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; RFC 2396 (2.4.3., delims) ...
- ("\"URL: *\\([^\"]*\\)\""
- 1 (>= gnus-button-browse-level 0) gnus-button-embedded-url 1)
- ;; Raw URLs.
- (gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
- ;; man pages
- ("\\b\\([a-z][a-z]+([1-9])\\)\\W"
- 0 (and (>= gnus-button-man-level 1) (< gnus-button-man-level 3))
- gnus-button-handle-man 1)
- ;; more man pages: resolv.conf(5), iso_8859-1(7), xterm(1x)
- ("\\b\\([a-z][-_.a-z0-9]+([1-9])\\)\\W"
- 0 (and (>= gnus-button-man-level 3) (< gnus-button-man-level 5))
- gnus-button-handle-man 1)
- ;; even more: Apache::PerlRun(3pm), PDL::IO::FastRaw(3pm),
- ;; SoWWWAnchor(3iv), XSelectInput(3X11), X(1), X(7)
- ("\\b\\(\\(?:[a-z][-+_.:a-z0-9]+([1-9][X1a-z]*)\\)\\|\\b\\(?:X([1-9])\\)\\)\\W"
- 0 (>= gnus-button-man-level 5) gnus-button-handle-man 1)
- ;; MID or mail: To avoid too many false positives we don't try to catch
- ;; all kind of allowed MIDs or mail addresses. Domain part must contain
- ;; at least one dot. TLD must contain two or three chars or be a know TLD
- ;; (info|name|...). Put this entry near the _end_ of `gnus-button-alist'
- ;; so that non-ambiguous entries (see above) match first.
- (gnus-button-mid-or-mail-regexp
- 0 (>= gnus-button-message-level 5) gnus-button-handle-mid-or-mail 1))
- "*Alist of regexps matching buttons in article bodies.
-
-Each entry has the form (REGEXP BUTTON FORM CALLBACK PAR...), where
-REGEXP: is the string (case insensitive) matching text around the button (can
-also be Lisp expression evaluating to a string),
-BUTTON: is the number of the regexp grouping actually matching the button,
-FORM: is a Lisp expression which must eval to true for the button to
-be added,
-CALLBACK: is the function to call when the user push this button, and each
-PAR: is a number of a regexp grouping whose text will be passed to CALLBACK.
-
-CALLBACK can also be a variable, in that case the value of that
-variable it the real callback function."
- :group 'gnus-article-buttons
- :type '(repeat (list (choice regexp variable sexp)
- (integer :tag "Button")
- (sexp :tag "Form")
- (function :tag "Callback")
- (repeat :tag "Par"
- :inline t
- (integer :tag "Regexp group")))))
-(put 'gnus-button-alist 'risky-local-variable t)
-
-(defcustom gnus-header-button-alist
- '(("^\\(References\\|Message-I[Dd]\\|^In-Reply-To\\):" "<[^<>]+>"
- 0 (>= gnus-button-message-level 0) gnus-button-message-id 0)
- ("^\\(From\\|Reply-To\\):" ": *\\(.+\\)$"
- 1 (>= gnus-button-message-level 0) gnus-button-reply 1)
- ("^\\(Cc\\|To\\):" "[^ \t\n<>,()\"]+@[^ \t\n<>,()\"]+"
- 0 (>= gnus-button-message-level 0) gnus-msg-mail 0)
- ("^X-[Uu][Rr][Ll]:" gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
- ("^Subject:" gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
- ("^[^:]+:" gnus-button-url-regexp
- 0 (>= gnus-button-browse-level 0) browse-url 0)
- ("^[^:]+:" "\\bmailto:\\([-a-z.@_+0-9%=?&/]+\\)"
- 0 (>= gnus-button-message-level 0) gnus-url-mailto 1)
- ("^[^:]+:" "\\(<\\(url: \\)?\\(nntp\\|news\\):\\([^>\n ]*\\)>\\)"
- 1 (>= gnus-button-message-level 0) gnus-button-message-id 4))
- "*Alist of headers and regexps to match buttons in article heads.
-
-This alist is very similar to `gnus-button-alist', except that each
-alist has an additional HEADER element first in each entry:
-
-\(HEADER REGEXP BUTTON FORM CALLBACK PAR)
-
-HEADER is a regexp to match a header. For a fuller explanation, see
-`gnus-button-alist'."
- :group 'gnus-article-buttons
- :group 'gnus-article-headers
- :type '(repeat (list (regexp :tag "Header")
- (choice regexp variable)
- (integer :tag "Button")
- (sexp :tag "Form")
- (function :tag "Callback")
- (repeat :tag "Par"
- :inline t
- (integer :tag "Regexp group")))))
-(put 'gnus-header-button-alist 'risky-local-variable t)
-
-;;; Commands:
-
-(defun gnus-article-push-button (event)
- "Check text under the mouse pointer for a callback function.
-If the text under the mouse pointer has a `gnus-callback' property,
-call it with the value of the `gnus-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 'gnus-data))
- (fun (get-text-property pos 'gnus-callback)))
- (goto-char pos)
- (when fun
- (funcall fun data))))
-
-(defun gnus-article-press-button ()
- "Check text at point for a callback function.
-If the text at point has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
- (interactive)
- (let ((data (get-text-property (point) 'gnus-data))
- (fun (get-text-property (point) 'gnus-callback)))
- (when fun
- (funcall fun data))))
-
-(defun gnus-article-highlight (&optional force)
- "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-citation',
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
- (gnus-article-highlight-headers)
- (gnus-article-highlight-citation force)
- (gnus-article-highlight-signature)
- (gnus-article-add-buttons force)
- (gnus-article-add-buttons-to-head))
-
-(defun gnus-article-highlight-some (&optional force)
- "Highlight current article.
-This function calls `gnus-article-highlight-headers',
-`gnus-article-highlight-signature', and `gnus-article-add-buttons' to
-do the highlighting. See the documentation for those functions."
- (interactive (list 'force))
- (gnus-article-highlight-headers)
- (gnus-article-highlight-signature)
- (gnus-article-add-buttons))
-
-(defun gnus-article-highlight-headers ()
- "Highlight article headers as specified by `gnus-header-face-alist'."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((alist gnus-header-face-alist)
- (inhibit-read-only t)
- (case-fold-search t)
- (inhibit-point-motion-hooks t)
- entry regexp header-face field-face from hpoints fpoints)
- (article-narrow-to-head)
- (while (setq entry (pop alist))
- (goto-char (point-min))
- (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 (eobp)))
- (beginning-of-line)
- (setq from (point))
- (unless (search-forward ":" nil t)
- (forward-char 1))
- (when (and header-face
- (not (memq (point) hpoints)))
- (push (point) hpoints)
- (gnus-put-text-property from (point) 'face header-face))
- (when (and field-face
- (not (memq (setq from (point)) fpoints)))
- (push from fpoints)
- (if (re-search-forward "^[^ \t]" nil t)
- (forward-char -2)
- (goto-char (point-max)))
- (gnus-put-text-property from (point) 'face field-face))))))))
-
-(defun gnus-article-highlight-signature ()
- "Highlight the signature in an article.
-It does this by highlighting everything after
-`gnus-signature-separator' using the face `gnus-signature'."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
- (save-restriction
- (when (and gnus-signature-face
- (gnus-article-narrow-to-signature))
- (gnus-overlay-put (gnus-make-overlay (point-min) (point-max))
- 'face gnus-signature-face)
- (widen)
- (gnus-article-search-signature)
- (let ((start (match-beginning 0))
- (end (set-marker (make-marker) (1+ (match-end 0)))))
- (gnus-article-add-button start (1- end) 'gnus-signature-toggle
- end)))))))
-
-(defun gnus-button-in-region-p (b e prop)
- "Say whether PROP exists in the region."
- (text-property-not-all b e prop nil))
-
-(defun gnus-article-add-buttons (&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))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (case-fold-search t)
- (alist gnus-button-alist)
- beg entry regexp)
- ;; Remove all old markers.
- (let (marker entry new-list)
- (while (setq marker (pop gnus-button-marker-list))
- (if (or (< marker (point-min)) (>= marker (point-max)))
- (push marker new-list)
- (goto-char marker)
- (when (setq entry (gnus-button-entry))
- (put-text-property (match-beginning (nth 1 entry))
- (match-end (nth 1 entry))
- 'gnus-callback nil))
- (set-marker marker nil)))
- (setq gnus-button-marker-list new-list))
- ;; We skip the headers.
- (article-goto-body)
- (setq beg (point))
- (while (setq entry (pop alist))
- (setq regexp (eval (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))))
- (from (match-beginning 0)))
- (when (and (or (eq t (nth 2 entry))
- (eval (nth 2 entry)))
- (not (gnus-button-in-region-p
- start end 'gnus-callback)))
- ;; 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."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (save-restriction
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t)
- (case-fold-search t)
- (alist gnus-header-button-alist)
- entry beg end)
- (article-narrow-to-head)
- (while alist
- ;; Each alist entry.
- (setq entry (car alist)
- alist (cdr alist))
- (goto-char (point-min))
- (while (re-search-forward (car entry) nil t)
- ;; Each header matching the entry.
- (setq beg (match-beginning 0))
- (setq end (or (and (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0))
- (point-max)))
- (goto-char beg)
- (while (re-search-forward (eval (nth 1 entry)) end t)
- ;; Each match within a header.
- (let* ((entry (cdr entry))
- (start (match-beginning (nth 1 entry)))
- (end (match-end (nth 1 entry)))
- (form (nth 2 entry)))
- (goto-char (match-end 0))
- (when (eval form)
- (gnus-article-add-button
- start end (nth 3 entry)
- (buffer-substring (match-beginning (nth 4 entry))
- (match-end (nth 4 entry)))))))
- (goto-char end)))))))
-
-;;; External functions:
-
-(defun gnus-article-add-button (from to fun &optional data)
- "Create a button between FROM and TO with callback FUN and data DATA."
- (when 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))))
- (widget-convert-button 'link from to :action 'gnus-widget-press-button
- :button-keymap gnus-widget-button-keymap))
-
-;;; Internal functions:
-
-(defun gnus-article-set-globals ()
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables)))
-
-(defun gnus-signature-toggle (end)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((inhibit-read-only t)
- (inhibit-point-motion-hooks t))
- (if (text-property-any end (point-max) 'article-type 'signature)
- (progn
- (gnus-delete-wash-type 'signature)
- (gnus-remove-text-properties-when
- 'article-type 'signature end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties))))
- (gnus-add-wash-type 'signature)
- (gnus-add-text-properties-when
- 'article-type nil end (point-max)
- (cons 'article-type (cons 'signature
- gnus-hidden-properties)))))
- (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
- (gnus-set-mode-line 'article))))
-
-(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 (pop alist))
- (if (looking-at (eval (car entry)))
- (setq alist nil)
- (setq entry nil)))
- entry))
-
-(defun gnus-button-push (marker)
- ;; Push button starting at MARKER.
- (save-excursion
- (goto-char marker)
- (let* ((entry (gnus-button-entry))
- (inhibit-point-motion-hooks t)
- (fun (nth 3 entry))
- (args (mapcar (lambda (group)
- (let ((string (match-string group)))
- (gnus-set-text-properties
- 0 (length string) nil string)
- string))
- (nthcdr 4 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)))))))
-
-(defun gnus-parse-news-url (url)
- (let (scheme server port group message-id articles)
- (with-temp-buffer
- (insert url)
- (goto-char (point-min))
- (when (looking-at "\\([A-Za-z]+\\):")
- (setq scheme (match-string 1))
- (goto-char (match-end 0)))
- (when (looking-at "//\\([^:/]+\\)\\(:?\\)\\([0-9]+\\)?/")
- (setq server (match-string 1))
- (setq port (if (stringp (match-string 3))
- (string-to-number (match-string 3))
- (match-string 3)))
- (goto-char (match-end 0)))
-
- (cond
- ((looking-at "\\(.*@.*\\)")
- (setq message-id (match-string 1)))
- ((looking-at "\\([^/]+\\)/\\([-0-9]+\\)")
- (setq group (match-string 1)
- articles (split-string (match-string 2) "-")))
- ((looking-at "\\([^/]+\\)/?")
- (setq group (match-string 1)))
- (t
- (error "Unknown news URL syntax"))))
- (list scheme server port group message-id articles)))
-
-(defun gnus-button-handle-news (url)
- "Fetch a news URL."
- (destructuring-bind (scheme server port group message-id articles)
- (gnus-parse-news-url url)
- (cond
- (message-id
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (if server
- (let ((gnus-refer-article-method
- (nconc (list (list 'nntp server))
- gnus-refer-article-method))
- (nntp-port-number (or port "nntp")))
- (gnus-message 7 "Fetching %s with %s"
- message-id gnus-refer-article-method)
- (gnus-summary-refer-article message-id))
- (gnus-summary-refer-article message-id))))
- (group
- (gnus-button-fetch-group url)))))
-
-(defun gnus-button-handle-man (url)
- "Fetch a man page."
- (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
- (when (eq gnus-button-man-handler 'woman)
- (setq url (gnus-replace-in-string url "([1-9][X1a-z]*).*\\'" "")))
- (gnus-message 9 "`%s' `%s'" gnus-button-man-handler url)
- (funcall gnus-button-man-handler url))
-
-(defun gnus-button-handle-info-url (url)
- "Fetch an info URL."
- (setq url (mm-subst-char-in-string ?+ ?\ url))
- (cond
- ((string-match "^\\([^:/]+\\)?/\\(.*\\)" url)
- (gnus-info-find-node
- (concat "(" (or (gnus-url-unhex-string (match-string 1 url))
- "Gnus")
- ")" (gnus-url-unhex-string (match-string 2 url)))))
- ((string-match "([^)\"]+)[^\"]+" url)
- (setq url
- (gnus-replace-in-string
- (gnus-replace-in-string url "[\n\t ]+" " ") "\"" ""))
- (gnus-info-find-node url))
- (t (error "Can't parse %s" url))))
-
-(defun gnus-button-handle-info-url-gnome (url)
- "Fetch GNOME style info URL."
- (setq url (mm-subst-char-in-string ?_ ?\ url))
- (if (string-match "\\([^#]+\\)#?\\(.*\\)" url)
- (gnus-info-find-node
- (concat "("
- (gnus-url-unhex-string
- (match-string 1 url))
- ")"
- (or (gnus-url-unhex-string
- (match-string 2 url))
- "Top")))
- (error "Can't parse %s" url)))
-
-(defun gnus-button-handle-info-url-kde (url)
- "Fetch KDE style info URL."
- (gnus-info-find-node (gnus-url-unhex-string url)))
-
-(defun gnus-button-handle-info-keystrokes (url)
- "Call `info' when pushing the corresponding URL button."
- ;; For links like `C-h i d m gnus RET', `C-h i d m CC Mode RET'.
- (info)
- (Info-directory)
- (Info-menu url))
-
-(defun gnus-button-message-id (message-id)
- "Fetch MESSAGE-ID."
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-refer-article message-id)))
-
-(defun gnus-button-fetch-group (address)
- "Fetch GROUP specified by ADDRESS."
- (if (not (string-match "[:/]" address))
- ;; This is just a simple group url.
- (gnus-group-read-ephemeral-group address gnus-select-method)
- (if (not
- (string-match
- "^\\([^:/]+\\)\\(:\\([^/]+\\)\\)?/\\([^/]+\\)\\(/\\([0-9]+\\)\\)?"
- address))
- (error "Can't parse %s" address)
- (gnus-group-read-ephemeral-group
- (match-string 4 address)
- `(nntp ,(match-string 1 address)
- (nntp-address ,(match-string 1 address))
- (nntp-port-number ,(if (match-end 3)
- (match-string 3 address)
- "nntp")))
- nil nil nil
- (and (match-end 6) (list (string-to-number (match-string 6 address))))))))
-
-(defun gnus-url-parse-query-string (query &optional downcase)
- (let (retval pairs cur key val)
- (setq pairs (split-string query "&"))
- (while pairs
- (setq cur (car pairs)
- pairs (cdr pairs))
- (if (not (string-match "=" cur))
- nil ; Grace
- (setq key (gnus-url-unhex-string (substring cur 0 (match-beginning 0)))
- val (gnus-url-unhex-string (substring cur (match-end 0) nil) t))
- (if downcase
- (setq key (downcase key)))
- (setq cur (assoc key retval))
- (if cur
- (setcdr cur (cons val (cdr cur)))
- (setq retval (cons (list key val) retval)))))
- retval))
-
-(defun gnus-url-mailto (url)
- ;; Send mail to someone
- (when (string-match "mailto:/*\\(.*\\)" url)
- (setq url (substring url (match-beginning 1) nil)))
- (let (to args subject func)
- (setq args (gnus-url-parse-query-string
- (if (string-match "^\\?" url)
- (substring url 1)
- (if (string-match "^\\([^?]+\\)\\?\\(.*\\)" url)
- (concat "to=" (match-string 1 url) "&"
- (match-string 2 url))
- (concat "to=" url)))
- t)
- subject (cdr-safe (assoc "subject" args)))
- (gnus-msg-mail)
- (while args
- (setq func (intern-soft (concat "message-goto-" (downcase (caar args)))))
- (if (fboundp func)
- (funcall func)
- (message-position-on-field (caar args)))
- (insert (gnus-replace-in-string
- (mapconcat 'identity (reverse (cdar args)) ", ")
- "\r\n" "\n" t))
- (setq args (cdr args)))
- (if subject
- (message-goto-body)
- (message-goto-subject))))
-
-(defun gnus-button-embedded-url (address)
- "Activate ADDRESS with `browse-url'."
- (browse-url (gnus-strip-whitespace address)))
-
-;;; Next/prev buttons in the article buffer.
-
-(defvar gnus-next-page-line-format "%{%(Next page...%)%}\n")
-(defvar gnus-prev-page-line-format "%{%(Previous page...%)%}\n")
-
-(defvar gnus-prev-page-map
- (let ((map (make-sparse-keymap)))
- (unless (>= emacs-major-version 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map gnus-article-mode-map))
- (define-key map gnus-mouse-2 'gnus-button-prev-page)
- (define-key map "\r" 'gnus-button-prev-page)
- map))
-
-(defvar gnus-next-page-map
- (let ((map (make-sparse-keymap)))
- (unless (>= emacs-major-version 21)
- ;; XEmacs doesn't care.
- (set-keymap-parent map gnus-article-mode-map))
- (define-key map gnus-mouse-2 'gnus-button-next-page)
- (define-key map "\r" 'gnus-button-next-page)
- map))
-
-(defun gnus-insert-prev-page-button ()
- (let ((b (point))
- (inhibit-read-only t))
- (gnus-eval-format
- gnus-prev-page-line-format nil
- `(,@(gnus-local-map-property gnus-prev-page-map)
- gnus-prev t
- gnus-callback gnus-article-button-prev-page
- article-type annotation))
- (widget-convert-button
- 'link b (if (bolp)
- ;; Exclude a newline.
- (1- (point))
- (point))
- :action 'gnus-button-prev-page
- :button-keymap gnus-prev-page-map)))
-
-(defun gnus-button-next-page (&optional args more-args)
- "Go to the next page."
- (interactive)
- (let ((win (selected-window)))
- (select-window (gnus-get-buffer-window gnus-article-buffer t))
- (gnus-article-next-page)
- (select-window win)))
-
-(defun gnus-button-prev-page (&optional args more-args)
- "Go to the prev page."
- (interactive)
- (let ((win (selected-window)))
- (select-window (gnus-get-buffer-window gnus-article-buffer t))
- (gnus-article-prev-page)
- (select-window win)))
-
-(defun gnus-insert-next-page-button ()
- (let ((b (point))
- (inhibit-read-only t))
- (gnus-eval-format gnus-next-page-line-format nil
- `(,@(gnus-local-map-property gnus-next-page-map)
- gnus-next t
- gnus-callback gnus-article-button-next-page
- article-type annotation))
- (widget-convert-button
- 'link b (if (bolp)
- ;; Exclude a newline.
- (1- (point))
- (point))
- :action 'gnus-button-next-page
- :button-keymap gnus-next-page-map)))
-
-(defun gnus-article-button-next-page (arg)
- "Go to the next page."
- (interactive "P")
- (let ((win (selected-window)))
- (select-window (gnus-get-buffer-window gnus-article-buffer t))
- (gnus-article-next-page)
- (select-window win)))
-
-(defun gnus-article-button-prev-page (arg)
- "Go to the prev page."
- (interactive "P")
- (let ((win (selected-window)))
- (select-window (gnus-get-buffer-window gnus-article-buffer t))
- (gnus-article-prev-page)
- (select-window win)))
-
-(defvar gnus-decode-header-methods
- '(mail-decode-encoded-word-region)
- "List of methods used to decode headers.
-
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
-is FUNCTION, FUNCTION will be applied to all newsgroups. If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to the newsgroups
-whose names match REGEXP.
-
-For example:
-\((\"chinese\" . gnus-decode-encoded-word-region-by-guess)
- mail-decode-encoded-word-region
- (\"chinese\" . rfc1843-decode-region))
-")
-
-(defvar gnus-decode-header-methods-cache nil)
-
-(defun gnus-multi-decode-header (start end)
- "Apply the functions from `gnus-encoded-word-methods' that match."
- (unless (and gnus-decode-header-methods-cache
- (eq gnus-newsgroup-name
- (car gnus-decode-header-methods-cache)))
- (setq gnus-decode-header-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-header-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-header-methods-cache
- (list (cdr x))))))
- gnus-decode-header-methods))
- (let ((xlist gnus-decode-header-methods-cache))
- (pop xlist)
- (save-restriction
- (narrow-to-region start end)
- (while xlist
- (funcall (pop xlist) (point-min) (point-max))))))
-
-;;;
-;;; Treatment top-level handling.
-;;;
-
-(defun gnus-treat-article (condition &optional part-number total-parts type)
- (let ((length (- (point-max) (point-min)))
- (alist gnus-treatment-function-alist)
- (article-goto-body-goes-to-point-min-p t)
- (treated-type
- (or (not type)
- (catch 'found
- (let ((list gnus-article-treat-types))
- (while list
- (when (string-match (pop list) type)
- (throw 'found t)))))))
- (highlightp (gnus-visual-p 'article-highlight 'highlight))
- val elem)
- (gnus-run-hooks 'gnus-part-display-hook)
- (dolist (elem alist)
- (setq val
- (save-excursion
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-summary-buffer))
- (symbol-value (car elem))))
- (when (and (or (consp val)
- treated-type)
- (gnus-treat-predicate val)
- (or (not (get (car elem) 'highlight))
- highlightp))
- (save-restriction
- (funcall (cadr elem)))))))
-
-;; Dynamic variables.
-(eval-when-compile
- (defvar part-number)
- (defvar total-parts)
- (defvar type)
- (defvar condition)
- (defvar length))
-
-(defun gnus-treat-predicate (val)
- (cond
- ((null val)
- nil)
- (condition
- (eq condition val))
- ((and (listp val)
- (stringp (car val)))
- (apply 'gnus-or (mapcar `(lambda (s)
- (string-match s ,(or gnus-newsgroup-name "")))
- val)))
- ((listp val)
- (let ((pred (pop val)))
- (cond
- ((eq pred 'or)
- (apply 'gnus-or (mapcar 'gnus-treat-predicate val)))
- ((eq pred 'and)
- (apply 'gnus-and (mapcar 'gnus-treat-predicate val)))
- ((eq pred 'not)
- (not (gnus-treat-predicate (car val))))
- ((eq pred 'typep)
- (equal (car val) type))
- (t
- (error "%S is not a valid predicate" pred)))))
- ((eq val t)
- t)
- ((eq val 'head)
- nil)
- ((eq val 'last)
- (eq part-number total-parts))
- ((numberp val)
- (< length val))
- (t
- (error "%S is not a valid value" val))))
-
-(defun gnus-article-encrypt-body (protocol &optional n)
- "Encrypt the article body."
- (interactive
- (list
- (or gnus-article-encrypt-protocol
- (completing-read "Encrypt protocol: "
- gnus-article-encrypt-protocol-alist
- nil t))
- current-prefix-arg))
- (let ((func (cdr (assoc protocol gnus-article-encrypt-protocol-alist))))
- (unless func
- (error "Can't find the encrypt protocol %s" protocol))
- (if (member gnus-newsgroup-name '("nndraft:delayed"
- "nndraft:drafts"
- "nndraft:queue"))
- (error "Can't encrypt the article in group %s"
- gnus-newsgroup-name))
- (gnus-summary-iterate n
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
- (summary-buffer gnus-summary-buffer)
- references point)
- (gnus-set-global-variables)
- (when (gnus-group-read-only-p)
- (error "The current newsgroup does not support article encrypt"))
- (gnus-summary-show-article t)
- (setq references
- (or (mail-header-references gnus-current-headers) ""))
- (set-buffer gnus-article-buffer)
- (let* ((inhibit-read-only t)
- (headers
- (mapcar (lambda (field)
- (and (save-restriction
- (message-narrow-to-head)
- (goto-char (point-min))
- (search-forward field nil t))
- (prog2
- (message-narrow-to-field)
- (buffer-string)
- (delete-region (point-min) (point-max))
- (widen))))
- '("Content-Type:" "Content-Transfer-Encoding:"
- "Content-Disposition:"))))
- (message-narrow-to-head)
- (message-remove-header "MIME-Version")
- (goto-char (point-max))
- (setq point (point))
- (insert (apply 'concat headers))
- (widen)
- (narrow-to-region point (point-max))
- (let ((message-options message-options))
- (message-options-set 'message-sender user-mail-address)
- (message-options-set 'message-recipients user-mail-address)
- (message-options-set 'message-sign-encrypt 'not)
- (funcall func))
- (goto-char (point-min))
- (insert "MIME-Version: 1.0\n")
- (widen)
- (gnus-summary-edit-article-done
- references nil summary-buffer t))
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (save-excursion
- (when (get-buffer gnus-original-article-buffer)
- (set-buffer gnus-original-article-buffer)
- (setq gnus-original-article nil)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current))))))))
-
-(defvar gnus-mime-security-button-line-format "%{%([[%t:%i]%D]%)%}\n"
- "The following specs can be used:
-%t The security MIME type
-%i Additional info
-%d Details
-%D Details if button is pressed")
-
-(defvar gnus-mime-security-button-end-line-format "%{%([[End of %t]%D]%)%}\n"
- "The following specs can be used:
-%t The security MIME type
-%i Additional info
-%d Details
-%D Details if button is pressed")
-
-(defvar gnus-mime-security-button-line-format-alist
- '((?t gnus-tmp-type ?s)
- (?i gnus-tmp-info ?s)
- (?d gnus-tmp-details ?s)
- (?D gnus-tmp-pressed-details ?s)))
-
-(defvar gnus-mime-security-button-map
- (let ((map (make-sparse-keymap)))
- (unless (>= (string-to-number emacs-version) 21)
- (set-keymap-parent map gnus-article-mode-map))
- (define-key map gnus-mouse-2 'gnus-article-push-button)
- (define-key map "\r" 'gnus-article-press-button)
- map))
-
-(defvar gnus-mime-security-details-buffer nil)
-
-(defvar gnus-mime-security-button-pressed nil)
-
-(defvar gnus-mime-security-show-details-inline t
- "If non-nil, show details in the article buffer.")
-
-(defun gnus-mime-security-verify-or-decrypt (handle)
- (mm-remove-parts (cdr handle))
- (let ((region (mm-handle-multipart-ctl-parameter handle 'gnus-region))
- point (inhibit-read-only t))
- (if region
- (goto-char (car region)))
- (save-restriction
- (narrow-to-region (point) (point))
- (with-current-buffer (mm-handle-multipart-original-buffer handle)
- (let* ((mm-verify-option 'known)
- (mm-decrypt-option 'known)
- (nparts (mm-possibly-verify-or-decrypt (cdr handle) handle)))
- (unless (eq nparts (cdr handle))
- (mm-destroy-parts (cdr handle))
- (setcdr handle nparts))))
- (setq point (point))
- (gnus-mime-display-security handle)
- (goto-char (point-max)))
- (when region
- (delete-region (point) (cdr region))
- (set-marker (car region) nil)
- (set-marker (cdr region) nil))
- (goto-char point)))
-
-(defun gnus-mime-security-show-details (handle)
- (let ((details (mm-handle-multipart-ctl-parameter handle 'gnus-details)))
- (if (not details)
- (gnus-message 5 "No details.")
- (if gnus-mime-security-show-details-inline
- (let ((gnus-mime-security-button-pressed
- (not (get-text-property (point) 'gnus-mime-details)))
- (gnus-mime-security-button-line-format
- (get-text-property (point) 'gnus-line-format))
- (inhibit-read-only t))
- (forward-char -1)
- (while (eq (get-text-property (point) 'gnus-line-format)
- gnus-mime-security-button-line-format)
- (forward-char -1))
- (forward-char)
- (save-restriction
- (narrow-to-region (point) (point))
- (gnus-insert-mime-security-button handle))
- (delete-region (point)
- (or (text-property-not-all
- (point) (point-max)
- 'gnus-line-format
- gnus-mime-security-button-line-format)
- (point-max))))
- ;; Not inlined.
- (if (gnus-buffer-live-p gnus-mime-security-details-buffer)
- (with-current-buffer gnus-mime-security-details-buffer
- (erase-buffer)
- t)
- (setq gnus-mime-security-details-buffer
- (gnus-get-buffer-create "*MIME Security Details*")))
- (with-current-buffer gnus-mime-security-details-buffer
- (insert details)
- (goto-char (point-min)))
- (pop-to-buffer gnus-mime-security-details-buffer)))))
-
-(defun gnus-mime-security-press-button (handle)
- (save-excursion
- (if (mm-handle-multipart-ctl-parameter handle 'gnus-info)
- (gnus-mime-security-show-details handle)
- (gnus-mime-security-verify-or-decrypt handle))))
-
-(defun gnus-insert-mime-security-button (handle &optional displayed)
- (let* ((protocol (mm-handle-multipart-ctl-parameter handle 'protocol))
- (gnus-tmp-type
- (concat
- (or (nth 2 (assoc protocol mm-verify-function-alist))
- (nth 2 (assoc protocol mm-decrypt-function-alist))
- "Unknown")
- (if (equal (car handle) "multipart/signed")
- " Signed" " Encrypted")
- " Part"))
- (gnus-tmp-info
- (or (mm-handle-multipart-ctl-parameter handle 'gnus-info)
- "Undecided"))
- (gnus-tmp-details
- (mm-handle-multipart-ctl-parameter handle 'gnus-details))
- gnus-tmp-pressed-details
- b e)
- (setq gnus-tmp-details
- (if gnus-tmp-details
- (concat "\n" gnus-tmp-details)
- ""))
- (setq gnus-tmp-pressed-details
- (if gnus-mime-security-button-pressed gnus-tmp-details ""))
- (unless (bolp)
- (insert "\n"))
- (setq b (point))
- (gnus-eval-format
- gnus-mime-security-button-line-format
- gnus-mime-security-button-line-format-alist
- `(,@(gnus-local-map-property gnus-mime-security-button-map)
- gnus-callback gnus-mime-security-press-button
- gnus-line-format ,gnus-mime-security-button-line-format
- gnus-mime-details ,gnus-mime-security-button-pressed
- article-type annotation
- gnus-data ,handle))
- (setq e (if (bolp)
- ;; Exclude a newline.
- (1- (point))
- (point)))
- (widget-convert-button
- 'link b e
- :mime-handle handle
- :action 'gnus-widget-press-button
- :button-keymap gnus-mime-security-button-map
- :help-echo
- (lambda (widget/window &optional overlay pos)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (when (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
- (format
- "%S: show detail"
- (aref gnus-mouse-2 0))))))
-
-(defun gnus-mime-display-security (handle)
- (save-restriction
- (narrow-to-region (point) (point))
- (unless (gnus-unbuttonized-mime-type-p (car handle))
- (gnus-insert-mime-security-button handle))
- (gnus-mime-display-mixed (cdr handle))
- (unless (bolp)
- (insert "\n"))
- (unless (gnus-unbuttonized-mime-type-p (car handle))
- (let ((gnus-mime-security-button-line-format
- gnus-mime-security-button-end-line-format))
- (gnus-insert-mime-security-button handle)))
- (mm-set-handle-multipart-parameter
- handle 'gnus-region
- (cons (set-marker (make-marker) (point-min))
- (set-marker (make-marker) (point-max))))))
-
-(gnus-ems-redefine)
-
-(provide 'gnus-art)
-
-(run-hooks 'gnus-art-load-hook)
-
-;;; arch-tag: 2654516f-6279-48f9-a83b-05c1fa450c33
-;;; gnus-art.el ends here
+++ /dev/null
-;;; gnus-async.el --- asynchronous support for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'nntp)
-
-(eval-when-compile
- (when (featurep 'xemacs)
- (require 'timer-funcs)))
-
-(defgroup gnus-asynchronous nil
- "Support for asynchronous operations."
- :group 'gnus)
-
-(defcustom gnus-use-article-prefetch 30
- "*If non-nil, prefetch articles in groups that allow this.
-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)
- (const :tag "all" t)
- (integer :tag "some" 0)))
-
-(defcustom gnus-asynchronous nil
- "*If nil, inhibit all Gnus asynchronicity.
-If non-nil, let the other asynch variables be heeded."
- :group 'gnus-asynchronous
- :type 'boolean)
-
-(defcustom gnus-prefetched-article-deletion-strategy '(read exit)
- "List of symbols that say when to remove articles from the prefetch buffer.
-Possible values in this list are `read', which means that
-articles are removed as they are read, and `exit', which means
-that all articles belonging to a group are removed on exit
-from that group."
- :group 'gnus-asynchronous
- :type '(set (const read) (const exit)))
-
-(defcustom gnus-use-header-prefetch nil
- "*If non-nil, prefetch the headers to the next group."
- :group 'gnus-asynchronous
- :type 'boolean)
-
-(defcustom gnus-async-prefetch-article-p 'gnus-async-unread-p
- "Function called to say whether an article should be prefetched or not.
-The function is called with one parameter -- the article data.
-It should return non-nil if the article is to be prefetched."
- :group 'gnus-asynchronous
- :type 'function)
-
-;;; Internal variables.
-
-(defvar gnus-async-prefetch-article-buffer " *Async Prefetch Article*")
-(defvar gnus-async-article-alist nil)
-(defvar gnus-async-article-semaphore '(nil))
-(defvar gnus-async-fetch-list 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)
-
-;;; Utility functions.
-
-(defun gnus-group-asynchronous-p (group)
- "Say whether GROUP is fetched from a server that supports asynchronicity."
- (gnus-asynchronous-p (gnus-find-method-for-group group)))
-
-;;; Somewhat bogus semaphores.
-
-(defun gnus-async-get-semaphore (semaphore)
- "Wait until SEMAPHORE is released."
- (while (/= (length (nconc (symbol-value semaphore) (list nil))) 2)
- (sleep-for 1)))
-
-(defun gnus-async-release-semaphore (semaphore)
- "Release SEMAPHORE."
- (setcdr (symbol-value semaphore) nil))
-
-(defmacro gnus-async-with-semaphore (&rest forms)
- `(unwind-protect
- (progn
- (gnus-async-get-semaphore 'gnus-async-article-semaphore)
- ,@forms)
- (gnus-async-release-semaphore 'gnus-async-article-semaphore)))
-
-(put 'gnus-async-with-semaphore 'lisp-indent-function 0)
-(put 'gnus-async-with-semaphore 'edebug-form-spec '(body))
-
-;;;
-;;; Article prefetch
-;;;
-
-(gnus-add-shutdown 'gnus-async-close 'gnus)
-(defun gnus-async-close ()
- (gnus-kill-buffer gnus-async-prefetch-article-buffer)
- (gnus-kill-buffer gnus-async-prefetch-headers-buffer)
- (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-async-hashtb
- (setq gnus-async-hashtb (gnus-make-hashtable 1023))))
-
-(defun gnus-async-halt-prefetch ()
- "Stop prefetching."
- (setq gnus-async-fetch-list nil))
-
-(defun gnus-async-prefetch-next (group article summary)
- "Possibly prefetch several articles starting with the article after ARTICLE."
- (when (and (gnus-buffer-live-p summary)
- gnus-asynchronous
- (gnus-group-asynchronous-p group))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((next (caadr (gnus-data-find-list article))))
- (when next
- (if (not (fboundp 'run-with-idle-timer))
- ;; This is either an older Emacs or XEmacs, so we
- ;; do this, which leads to slightly slower article
- ;; buffer display.
- (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))
- (when (and gnus-asynchronous
- (gnus-alive-p))
- (when next
- (gnus-async-with-semaphore
- (pop gnus-async-fetch-list)))
- (let ((do-fetch next)
- (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))))
-
- (when (and do-fetch article)
- ;; We want to fetch some more articles.
- (save-excursion
- (set-buffer summary)
- (let (mark)
- (gnus-async-set-buffer)
- (goto-char (point-max))
- (setq mark (point-marker))
- (let ((nnheader-callback-function
- (gnus-make-async-article-function
- group article mark summary next))
- (nntp-server-buffer
- (get-buffer gnus-async-prefetch-article-buffer)))
- (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)
- (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."
- (gnus-data-unread-p data))
-
-(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
- (gnus-async-set-buffer)
- (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-prefetched-entry entry))
- t)))))
-
-(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)
- (setq tries 0))
- (when (and (not nntp-have-messaged)
- (= tries 3))
- (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 (> tries 3)
- (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))))
-
-(defun gnus-async-prefetch-remove-group (group)
- "Remove all articles belonging to GROUP from the prefetch buffer."
- (when (and (gnus-group-asynchronous-p group)
- (memq 'exit gnus-prefetched-article-deletion-strategy))
- (let ((alist gnus-async-article-alist))
- (save-excursion
- (gnus-async-set-buffer)
- (while alist
- (when (equal group (nth 3 (car alist)))
- (gnus-async-delete-prefetched-entry (car alist)))
- (pop alist))))))
-
-(defun gnus-async-prefetched-article-entry (group article)
- "Return the entry for ARTICLE in GROUP if it has been prefetched."
- (let ((entry (save-excursion
- (gnus-async-set-buffer)
- (assq (intern (format "%s-%d" group article)
- gnus-async-hashtb)
- gnus-async-article-alist))))
- ;; Perhaps something has emptied the buffer?
- (if (and entry
- (= (cadr entry) (caddr entry)))
- (progn
- (ignore-errors
- (set-marker (cadr entry) nil)
- (set-marker (caddr entry) nil))
- (setq gnus-async-article-alist
- (delq entry gnus-async-article-alist))
- nil)
- entry)))
-
-;;;
-;;; Header prefetch
-;;;
-
-(defun gnus-async-prefetch-headers (group)
- "Prefetch the headers for group GROUP."
- (save-excursion
- (let (unread)
- (when (and gnus-use-header-prefetch
- gnus-asynchronous
- (gnus-group-asynchronous-p group)
- (listp gnus-async-header-prefetched)
- (setq unread (gnus-list-of-unread-articles group)))
- ;; Mark that a fetch is in progress.
- (setq gnus-async-header-prefetched t)
- (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
- (erase-buffer)
- (let ((nntp-server-buffer (current-buffer))
- (nnheader-callback-function
- `(lambda (arg)
- (setq gnus-async-header-prefetched
- ,(cons group unread)))))
- (gnus-retrieve-headers unread group gnus-fetch-old-headers))))))
-
-(defun gnus-async-retrieve-fetched-headers (articles group)
- "See whether we have prefetched headers."
- (when (and gnus-use-header-prefetch
- (gnus-group-asynchronous-p group)
- (listp gnus-async-header-prefetched)
- (equal group (car gnus-async-header-prefetched))
- (equal articles (cdr gnus-async-header-prefetched)))
- (save-excursion
- (nnheader-set-temp-buffer gnus-async-prefetch-headers-buffer t)
- (nntp-decode-text)
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- (erase-buffer)
- (setq gnus-async-header-prefetched nil)
- t)))
-
-(provide 'gnus-async)
-
-;;; arch-tag: fee61de5-3ea2-4de6-8578-2f90ce89391d
-;;; gnus-async.el ends here
+++ /dev/null
-;;; gnus-audio.el --- Sound effects for Gnus
-
-;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Steven L. Baur <steve@miranova.com>
-;; Keywords: news, mail, multimedia
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file provides access to sound effects in Gnus.
-;; This file is partially stripped to support earcons.el.
-
-;;; Code:
-
-(require 'nnheader)
-
-(defgroup gnus-audio nil
- "Playing sound in Gnus."
- :version "21.1"
- :group 'gnus-visual
- :group 'multimedia)
-
-(defvar gnus-audio-inline-sound
- (or (if (fboundp 'device-sound-enabled-p)
- (device-sound-enabled-p)) ; XEmacs
- (fboundp 'play-sound)) ; Emacs 21
- "Non-nil means try to play sounds without using an external program.")
-
-(defcustom gnus-audio-directory (nnheader-find-etc-directory "sounds")
- "The directory containing the Sound Files."
- :type '(choice directory (const nil))
- :group 'gnus-audio)
-
-(defcustom gnus-audio-au-player (executable-find "play")
- "Executable program for playing sun AU format sound files."
- :group 'gnus-audio
- :type '(choice file (const nil)))
-
-(defcustom gnus-audio-wav-player (executable-find "play")
- "Executable program for playing WAV files."
- :group 'gnus-audio
- :type '(choice file (const nil)))
-
-;;; 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.")
-
-
-;;;###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))
-
-;;;###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))
-
-;;;###autoload
-(defun gnus-audio-play (file)
- "Play a sound FILE through the speaker."
- (interactive "fSound file name: ")
- (let ((sound-file (if (file-exists-p file)
- file
- (expand-file-name file gnus-audio-directory))))
- (when (file-exists-p sound-file)
- (cond ((and gnus-audio-inline-sound
- (condition-case nil
- ;; Even if we have audio, we may fail with the
- ;; wrong sort of sound file.
- (progn (play-sound-file sound-file)
- t)
- (error nil))))
- ;; If we don't have built-in sound, or playing it failed,
- ;; try with external program.
- ((equal "wav" (file-name-extension sound-file))
- (call-process gnus-audio-wav-player
- sound-file
- 0
- nil
- sound-file))
- ((equal "au" (file-name-extension sound-file))
- (call-process gnus-audio-au-player
- sound-file
- 0
- nil
- sound-file))))))
-
-
-;;; 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))
-;;;***
-
-(defvar gnus-startup-jingle "Tuxedomoon.Jingle4.au"
- "Name of the Gnus startup jingle file.")
-
-(defun gnus-play-jingle ()
- "Play the Gnus startup jingle, unless that's inhibited."
- (interactive)
- (gnus-audio-play gnus-startup-jingle))
-
-(provide 'gnus-audio)
-
-(run-hooks 'gnus-audio-load-hook)
-
-;;; arch-tag: 6f129e78-3416-4fc9-973f-6cf5ac8d654b
-;;; gnus-audio.el ends here
+++ /dev/null
-;;; gnus-bcklg.el --- backlog functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-
-;;;
-;;; Buffering of read articles.
-;;;
-
-(defvar gnus-backlog-buffer " *Gnus Backlog*")
-(defvar gnus-backlog-articles nil)
-(defvar gnus-backlog-hashtb nil)
-
-(defun gnus-backlog-buffer ()
- "Return the backlog buffer."
- (or (get-buffer gnus-backlog-buffer)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-backlog-buffer))
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (get-buffer gnus-backlog-buffer))))
-
-(defun gnus-backlog-setup ()
- "Initialize backlog variables."
- (unless gnus-backlog-hashtb
- (setq gnus-backlog-hashtb (gnus-make-hashtable 1024))))
-
-(gnus-add-shutdown 'gnus-backlog-shutdown 'gnus)
-
-(defun gnus-backlog-shutdown ()
- "Clear all backlog variables and buffers."
- (interactive)
- (when (get-buffer gnus-backlog-buffer)
- (gnus-kill-buffer gnus-backlog-buffer))
- (setq gnus-backlog-hashtb nil
- gnus-backlog-articles nil))
-
-(defun gnus-backlog-enter-article (group number buffer)
- (when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
- (gnus-backlog-setup)
- (let ((ident (intern (concat group ":" (int-to-string number))
- gnus-backlog-hashtb))
- b)
- (if (memq ident gnus-backlog-articles)
- () ; It's already kept.
- ;; Remove the oldest article, if necessary.
- (and (numberp gnus-keep-backlog)
- (>= (length gnus-backlog-articles) gnus-keep-backlog)
- (gnus-backlog-remove-oldest-article))
- (push ident gnus-backlog-articles)
- ;; Insert the new article.
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (let (buffer-read-only)
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (setq b (point))
- (insert-buffer-substring buffer)
- ;; Tag the beginning of the article with the ident.
- (if (> (point-max) b)
- (gnus-put-text-property b (1+ b) 'gnus-backlog ident)
- (gnus-error 3 "Article %d is blank" number))))))))
-
-(defun gnus-backlog-remove-oldest-article ()
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (goto-char (point-min))
- (if (zerop (buffer-size))
- () ; The buffer is empty.
- (let ((ident (get-text-property (point) 'gnus-backlog))
- buffer-read-only)
- ;; Remove the ident from the list of articles.
- (when ident
- (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
- ;; Delete the article itself.
- (delete-region
- (point) (next-single-property-change
- (1+ (point)) 'gnus-backlog nil (point-max)))))))
-
-(defun gnus-backlog-remove-article (group number)
- "Remove article NUMBER in GROUP from the backlog."
- (when (numberp number)
- (gnus-backlog-setup)
- (let ((ident (intern (concat group ":" (int-to-string number))
- gnus-backlog-hashtb))
- beg end)
- (when (memq ident gnus-backlog-articles)
- ;; It was in the backlog.
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (let (buffer-read-only)
- (when (setq beg (text-property-any
- (point-min) (point-max) 'gnus-backlog
- ident))
- ;; Find the end (i. e., the beginning of the next article).
- (setq end
- (next-single-property-change
- (1+ beg) 'gnus-backlog (current-buffer) (point-max)))
- (delete-region beg end)
- ;; Return success.
- t))
- (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))))))
-
-(defun gnus-backlog-request-article (group number &optional buffer)
- (when (and (numberp number)
- (not (string-match "^nnvirtual" group)))
- (gnus-backlog-setup)
- (let ((ident (intern (concat group ":" (int-to-string number))
- gnus-backlog-hashtb))
- beg end)
- (when (memq ident gnus-backlog-articles)
- ;; It was in the backlog.
- (save-excursion
- (set-buffer (gnus-backlog-buffer))
- (if (not (setq beg (text-property-any
- (point-min) (point-max) 'gnus-backlog
- ident)))
- ;; It wasn't in the backlog after all.
- (ignore
- (setq gnus-backlog-articles (delq ident gnus-backlog-articles)))
- ;; Find the end (i. e., the beginning of the next article).
- (setq end
- (next-single-property-change
- (1+ beg) 'gnus-backlog (current-buffer) (point-max)))))
- (save-excursion
- (and buffer (set-buffer buffer))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert-buffer-substring gnus-backlog-buffer beg end)))
- t))))
-
-(provide 'gnus-bcklg)
-
-;;; arch-tag: 66259e56-505a-4bba-8a0d-3552c5b94e39
-;;; gnus-bcklg.el ends here
+++ /dev/null
-;;; gnus-cache.el --- cache interface for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-int)
-(require 'gnus-range)
-(require 'gnus-start)
-(eval-when-compile
- (if (not (fboundp 'gnus-agent-load-alist))
- (defun gnus-agent-load-alist (group)))
- (require 'gnus-sum))
-
-(defcustom gnus-cache-active-file
- (expand-file-name "active" gnus-cache-directory)
- "*The cache active file."
- :group 'gnus-cache
- :type 'file)
-
-(defcustom gnus-cache-enter-articles '(ticked dormant)
- "Classes of articles to enter into the cache."
- :group 'gnus-cache
- :type '(set (const ticked) (const dormant) (const unread) (const read)))
-
-(defcustom gnus-cache-remove-articles '(read)
- "Classes of articles to remove from the cache."
- :group 'gnus-cache
- :type '(set (const ticked) (const dormant) (const unread) (const read)))
-
-(defcustom gnus-cacheable-groups nil
- "*Groups that match this regexp will be cached.
-
-If you only want to cache your nntp groups, you could set this
-variable to \"^nntp\".
-
-If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
-it's not cached."
- :group 'gnus-cache
- :type '(choice (const :tag "off" nil)
- regexp))
-
-(defcustom gnus-uncacheable-groups nil
- "*Groups that match this regexp will not be cached.
-
-If you want to avoid caching your nnml groups, you could set this
-variable to \"^nnml\".
-
-If a group matches both gnus-cacheable-groups and gnus-uncacheable-groups
-it's not cached."
- :group 'gnus-cache
- :type '(choice (const :tag "off" nil)
- regexp))
-
-(defvar gnus-cache-overview-coding-system 'raw-text
- "Coding system used on Gnus cache files.")
-
-(defvar gnus-cache-coding-system 'raw-text
- "Coding system used on Gnus cache files.")
-
-\f
-
-;;; Internal variables.
-
-(defvar gnus-cache-removable-articles nil)
-(defvar gnus-cache-buffer nil)
-(defvar gnus-cache-active-hashtb nil)
-(defvar gnus-cache-active-altered nil)
-
-(eval-and-compile
- (autoload 'nnml-generate-nov-databases-1 "nnml")
- (autoload 'nnvirtual-find-group-art "nnvirtual"))
-
-\f
-
-;;; Functions called from Gnus.
-
-(defun gnus-cache-open ()
- "Initialize the cache."
- (when (or (file-exists-p gnus-cache-directory)
- (and gnus-use-cache
- (not (eq gnus-use-cache 'passive))))
- (gnus-cache-read-active)))
-
-;; Complexities of byte-compiling make this kludge necessary. Eeek.
-(ignore-errors
- (gnus-add-shutdown 'gnus-cache-close 'gnus))
-
-(defun gnus-cache-close ()
- "Shut down the cache."
- (gnus-cache-write-active)
- (gnus-cache-save-buffers)
- (setq gnus-cache-active-hashtb nil))
-
-(defun gnus-cache-save-buffers ()
- ;; save the overview buffer if it exists and has been modified
- ;; delete empty cache subdirectories
- (when gnus-cache-buffer
- (let ((buffer (cdr gnus-cache-buffer))
- (overview-file (gnus-cache-file-name
- (car gnus-cache-buffer) ".overview")))
- ;; write the overview only if it was modified
- (when (and (buffer-live-p buffer) (buffer-modified-p buffer))
- (with-current-buffer buffer
- (if (> (buffer-size) 0)
- ;; Non-empty overview, write it to a file.
- (let ((coding-system-for-write
- gnus-cache-overview-coding-system))
- (gnus-write-buffer overview-file))
- ;; Empty overview file, remove it
- (when (file-exists-p overview-file)
- (delete-file overview-file))
- ;; If possible, remove group's cache subdirectory.
- (condition-case nil
- ;; FIXME: we can detect the error type and warn the user
- ;; of any inconsistencies (articles w/o nov entries?).
- ;; for now, just be conservative...delete only if safe -- sj
- (delete-directory (file-name-directory overview-file))
- (error nil)))))
- ;; Kill the buffer -- it's either unmodified or saved.
- (gnus-kill-buffer buffer)
- (setq gnus-cache-buffer nil))))
-
-(defun gnus-cache-possibly-enter-article
- (group article ticked dormant unread &optional force)
- (when (and (or force (not (eq gnus-use-cache 'passive)))
- (numberp article)
- (> article 0)) ; This might be a dummy article.
- (let ((number article) file headers)
- ;; If this is a virtual group, we find the real group.
- (when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
- (setq group (car result)
- number (cdr result))))
- (when (and number
- (> number 0) ; Reffed article.
- (or force
- (and (gnus-cache-fully-p group)
- (gnus-cache-member-of-class
- gnus-cache-enter-articles ticked dormant unread)))
- (not (file-exists-p (setq file (gnus-cache-file-name
- group number)))))
- ;; Possibly create the cache directory.
- (gnus-make-directory (file-name-directory file))
- ;; Save the article in the cache.
- (if (file-exists-p file)
- t ; The article already is saved.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (require 'gnus-art)
- (let ((gnus-use-cache nil)
- (gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer number group))
- (when (> (buffer-size) 0)
- (let ((coding-system-for-write gnus-cache-coding-system))
- (gnus-write-buffer file))
- (nnheader-remove-body)
- (setq headers (nnheader-parse-naked-head))
- (mail-header-set-number headers number)
- (gnus-cache-change-buffer group)
- (set-buffer (cdr gnus-cache-buffer))
- (goto-char (point-max))
- (forward-line -1)
- (while (condition-case ()
- (when (not (bobp))
- (> (read (current-buffer)) number))
- (error
- ;; The line was malformed, so we just remove it!!
- (gnus-delete-line)
- t))
- (forward-line -1))
- (if (bobp)
- (if (not (eobp))
- (progn
- (beginning-of-line)
- (when (< (read (current-buffer)) number)
- (forward-line 1)))
- (beginning-of-line))
- (forward-line 1))
- (beginning-of-line)
- (nnheader-insert-nov headers)
- ;; Update the active info.
- (set-buffer gnus-summary-buffer)
- (gnus-cache-possibly-update-active group (cons number number))
- (setq gnus-newsgroup-cached
- (gnus-add-to-sorted-list gnus-newsgroup-cached article))
- (gnus-summary-update-secondary-mark article))
- t))))))
-
-(defun gnus-cache-enter-remove-article (article)
- "Mark ARTICLE for later possible removal."
- (when article
- (push article gnus-cache-removable-articles)))
-
-(defun gnus-cache-possibly-remove-articles ()
- "Possibly remove some of the removable articles."
- (if (not (gnus-virtual-group-p gnus-newsgroup-name))
- (gnus-cache-possibly-remove-articles-1)
- (let ((arts gnus-cache-removable-articles)
- ga)
- (while arts
- (when (setq ga (nnvirtual-find-group-art
- (gnus-group-real-name gnus-newsgroup-name) (pop arts)))
- (let ((gnus-cache-removable-articles (list (cdr ga)))
- (gnus-newsgroup-name (car ga)))
- (gnus-cache-possibly-remove-articles-1)))))
- (setq gnus-cache-removable-articles nil)))
-
-(defun gnus-cache-possibly-remove-articles-1 ()
- "Possibly remove some of the removable articles."
- (when (gnus-cache-fully-p gnus-newsgroup-name)
- (let ((articles gnus-cache-removable-articles)
- (cache-articles gnus-newsgroup-cached)
- article)
- (gnus-cache-change-buffer gnus-newsgroup-name)
- (while articles
- (when (memq (setq article (pop articles)) cache-articles)
- ;; The article was in the cache, so we see whether we are
- ;; supposed to remove it from the cache.
- (gnus-cache-possibly-remove-article
- article (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (or (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected))))))
- ;; The overview file might have been modified, save it
- ;; safe because we're only called at group exit anyway.
- (gnus-cache-save-buffers)))
-
-(defun gnus-cache-request-article (article group)
- "Retrieve ARTICLE in GROUP from the cache."
- (let ((file (gnus-cache-file-name group article))
- (buffer-read-only nil))
- (when (file-exists-p file)
- (erase-buffer)
- (gnus-kill-all-overlays)
- (let ((coding-system-for-read gnus-cache-coding-system))
- (insert-file-contents file))
- t)))
-
-(defun gnus-cache-possibly-alter-active (group active)
- "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
- (when gnus-cache-active-hashtb
- (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (when cache-active
- (when (< (car cache-active) (car active))
- (setcar active (car cache-active)))
- (when (> (cdr cache-active) (cdr active))
- (setcdr active (cdr cache-active)))))))
-
-(defun gnus-cache-retrieve-headers (articles group &optional fetch-old)
- "Retrieve the headers for ARTICLES in GROUP."
- (let ((cached
- (setq gnus-newsgroup-cached (gnus-cache-articles-in-group group))))
- (if (not cached)
- ;; No cached articles here, so we just retrieve them
- ;; the normal way.
- (let ((gnus-use-cache nil))
- (gnus-retrieve-headers articles group fetch-old))
- (let ((uncached-articles (gnus-sorted-difference articles cached))
- (cache-file (gnus-cache-file-name group ".overview"))
- type)
- ;; We first retrieve all the headers that we don't have in
- ;; the cache.
- (let ((gnus-use-cache nil))
- (when uncached-articles
- (setq type (and articles
- (gnus-retrieve-headers
- uncached-articles group fetch-old)))))
- (gnus-cache-save-buffers)
- ;; Then we insert the cached headers.
- (save-excursion
- (cond
- ((not (file-exists-p cache-file))
- ;; There are no cached headers.
- type)
- ((null type)
- ;; There were no uncached headers (or retrieval was
- ;; unsuccessful), so we use the cached headers exclusively.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((coding-system-for-read
- gnus-cache-overview-coding-system))
- (insert-file-contents cache-file))
- 'nov)
- ((eq type 'nov)
- ;; We have both cached and uncached NOV headers, so we
- ;; braid them.
- (gnus-cache-braid-nov group cached)
- type)
- (t
- ;; We braid HEADs.
- (gnus-cache-braid-heads group (gnus-sorted-intersection
- cached articles))
- type)))))))
-
-(defun gnus-cache-enter-article (&optional n)
- "Enter the next N articles into the cache.
-If not given a prefix, use the process marked articles instead.
-Returns the list of articles entered."
- (interactive "P")
- (let ((articles (gnus-summary-work-articles n))
- article out)
- (while (setq article (pop articles))
- (gnus-summary-remove-process-mark article)
- (if (natnump article)
- (when (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- nil nil nil t)
- (setq gnus-newsgroup-undownloaded (delq article gnus-newsgroup-undownloaded))
- (push article out))
- (gnus-message 2 "Can't cache article %d" article))
- (gnus-summary-update-download-mark article)
- (gnus-summary-update-secondary-mark article))
- (gnus-summary-next-subject 1)
- (gnus-summary-position-point)
- (nreverse out)))
-
-(defun gnus-cache-remove-article (&optional n)
- "Remove the next N articles from the cache.
-If not given a prefix, use the process marked articles instead.
-Returns the list of articles removed."
- (interactive "P")
- (gnus-cache-change-buffer gnus-newsgroup-name)
- (let ((articles (gnus-summary-work-articles n))
- article out)
- (while articles
- (setq article (pop articles))
- (gnus-summary-remove-process-mark article)
- (when (gnus-cache-possibly-remove-article article nil nil nil t)
- (when gnus-newsgroup-agentized
- (let ((alist (gnus-agent-load-alist gnus-newsgroup-name)))
- (unless (cdr (assoc article alist))
- (setq gnus-newsgroup-undownloaded
- (gnus-add-to-sorted-list
- gnus-newsgroup-undownloaded article)))))
- (push article out))
- (gnus-summary-update-download-mark article)
- (gnus-summary-update-secondary-mark article))
- (gnus-summary-next-subject 1)
- (gnus-summary-position-point)
- (nreverse out)))
-
-(defun gnus-cached-article-p (article)
- "Say whether ARTICLE is cached in the current group."
- (memq article gnus-newsgroup-cached))
-
-(defun gnus-summary-insert-cached-articles ()
- "Insert all the articles cached for this group into the current buffer."
- (interactive)
- (let ((gnus-verbose (max 6 gnus-verbose)))
- (if (not gnus-newsgroup-cached)
- (gnus-message 3 "No cached articles for this group")
- (gnus-summary-goto-subjects gnus-newsgroup-cached))))
-
-(defun gnus-summary-limit-include-cached ()
- "Limit the summary buffer to articles that are cached."
- (interactive)
- (let ((gnus-verbose (max 6 gnus-verbose)))
- (if gnus-newsgroup-cached
- (progn
- (gnus-summary-limit gnus-newsgroup-cached)
- (gnus-summary-position-point))
- (gnus-message 3 "No cached articles for this group"))))
-
-;;; Internal functions.
-
-(defun gnus-cache-change-buffer (group)
- (and gnus-cache-buffer
- ;; See if the current group's overview cache has been loaded.
- (or (string= group (car gnus-cache-buffer))
- ;; Another overview cache is current, save it.
- (gnus-cache-save-buffers)))
- ;; if gnus-cache buffer is nil, create it
- (unless gnus-cache-buffer
- ;; Create cache buffer
- (save-excursion
- (setq gnus-cache-buffer
- (cons group
- (set-buffer (gnus-get-buffer-create
- " *gnus-cache-overview*"))))
- ;; Insert the contents of this group's cache overview.
- (erase-buffer)
- (let ((file (gnus-cache-file-name group ".overview")))
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)))
- ;; We have a fresh (empty/just loaded) buffer,
- ;; mark it as unmodified to save a redundant write later.
- (set-buffer-modified-p nil))))
-
-;; Return whether an article is a member of a class.
-(defun gnus-cache-member-of-class (class ticked dormant unread)
- (or (and ticked (memq 'ticked class))
- (and dormant (memq 'dormant class))
- (and unread (memq 'unread class))
- (and (not unread) (not ticked) (not dormant) (memq 'read class))))
-
-(defun gnus-cache-file-name (group article)
- (setq group (gnus-group-decoded-name group))
- (expand-file-name
- (if (stringp article) article (int-to-string article))
- (file-name-as-directory
- (expand-file-name
- (nnheader-translate-file-chars
- (if (gnus-use-long-file-name 'not-cache)
- group
- (let ((group (nnheader-replace-duplicate-chars-in-string
- (nnheader-replace-chars-in-string group ?/ ?_)
- ?. ?_)))
- ;; Translate the first colon into a slash.
- (when (string-match ":" group)
- (setq group (concat (substring group 0 (match-beginning 0))
- "/" (substring group (match-end 0)))))
- (nnheader-replace-chars-in-string group ?. ?/)))
- t)
- gnus-cache-directory))))
-
-(defun gnus-cache-update-article (group article)
- "If ARTICLE is in the cache, remove it and re-enter it."
- (gnus-cache-change-buffer group)
- (when (gnus-cache-possibly-remove-article article nil nil nil t)
- (let ((gnus-use-cache nil))
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- nil nil nil t))))
-
-(defun gnus-cache-possibly-remove-article (article ticked dormant unread
- &optional force)
- "Possibly remove ARTICLE from the cache."
- (let ((group gnus-newsgroup-name)
- (number article)
- file)
- ;; If this is a virtual group, we find the real group.
- (when (gnus-virtual-group-p group)
- (let ((result (nnvirtual-find-group-art
- (gnus-group-real-name group) article)))
- (setq group (car result)
- number (cdr result))))
- (setq file (gnus-cache-file-name group number))
- (when (and (file-exists-p file)
- (or force
- (gnus-cache-member-of-class
- gnus-cache-remove-articles ticked dormant unread)))
- (save-excursion
- (delete-file file)
- (set-buffer (cdr gnus-cache-buffer))
- (goto-char (point-min))
- (when (or (looking-at (concat (int-to-string number) "\t"))
- (search-forward (concat "\n" (int-to-string number) "\t")
- (point-max) t))
- (gnus-delete-line)))
- (unless (setq gnus-newsgroup-cached
- (delq article gnus-newsgroup-cached))
- (gnus-sethash gnus-newsgroup-name nil gnus-cache-active-hashtb)
- (setq gnus-cache-active-altered t))
- (gnus-summary-update-secondary-mark article)
- t)))
-
-(defun gnus-cache-articles-in-group (group)
- "Return a sorted list of cached articles in GROUP."
- (let ((dir (file-name-directory (gnus-cache-file-name group 1)))
- articles)
- (when (file-exists-p dir)
- (setq articles
- (sort (mapcar (lambda (name) (string-to-number name))
- (directory-files dir nil "^[0-9]+$" t))
- '<))
- ;; Update the cache active file, just to synch more.
- (if articles
- (progn
- (gnus-cache-update-active group (car articles) t)
- (gnus-cache-update-active group (car (last articles))))
- (when (gnus-gethash group gnus-cache-active-hashtb)
- (gnus-sethash group nil gnus-cache-active-hashtb)
- (setq gnus-cache-active-altered t)))
- articles)))
-
-(defun gnus-cache-braid-nov (group cached &optional file)
- (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*"))
- beg end)
- (gnus-cache-save-buffers)
- (save-excursion
- (set-buffer cache-buf)
- (erase-buffer)
- (let ((coding-system-for-read
- gnus-cache-overview-coding-system))
- (insert-file-contents
- (or file (gnus-cache-file-name group ".overview"))))
- (goto-char (point-min))
- (insert "\n")
- (goto-char (point-min)))
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while cached
- (while (and (not (eobp))
- (< (read (current-buffer)) (car cached)))
- (forward-line 1))
- (beginning-of-line)
- (set-buffer cache-buf)
- (if (search-forward (concat "\n" (int-to-string (car cached)) "\t")
- nil t)
- (setq beg (gnus-point-at-bol)
- end (progn (end-of-line) (point)))
- (setq beg nil))
- (set-buffer nntp-server-buffer)
- (when beg
- (insert-buffer-substring cache-buf beg end)
- (insert "\n"))
- (setq cached (cdr cached)))
- (kill-buffer cache-buf)))
-
-(defun gnus-cache-braid-heads (group cached)
- (let ((cache-buf (gnus-get-buffer-create " *gnus-cache*")))
- (save-excursion
- (set-buffer cache-buf)
- (erase-buffer))
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while cached
- (while (and (not (eobp))
- (looking-at "2.. +\\([0-9]+\\) ")
- (< (progn (goto-char (match-beginning 1))
- (read (current-buffer)))
- (car cached)))
- (search-forward "\n.\n" nil 'move))
- (beginning-of-line)
- (set-buffer cache-buf)
- (erase-buffer)
- (let ((coding-system-for-read
- gnus-cache-coding-system))
- (insert-file-contents (gnus-cache-file-name group (car cached))))
- (goto-char (point-min))
- (insert "220 ")
- (princ (car cached) (current-buffer))
- (insert " Article retrieved.\n")
- (search-forward "\n\n" nil 'move)
- (delete-region (point) (point-max))
- (forward-char -1)
- (insert ".")
- (set-buffer nntp-server-buffer)
- (insert-buffer-substring cache-buf)
- (setq cached (cdr cached)))
- (kill-buffer cache-buf)))
-
-;;;###autoload
-(defun gnus-jog-cache ()
- "Go through all groups and put the articles into the cache.
-
-Usage:
-$ emacs -batch -l ~/.emacs -l gnus -f gnus-jog-cache"
- (interactive)
- (let ((gnus-mark-article-hook nil)
- (gnus-expert-user t)
- (nnmail-spool-file nil)
- (mail-sources nil)
- (gnus-use-dribble-file nil)
- (gnus-novice-user nil)
- (gnus-large-newsgroup nil))
- ;; Start Gnus.
- (gnus)
- ;; Go through all groups...
- (gnus-group-mark-buffer)
- (gnus-group-iterate nil
- (lambda (group)
- (let (gnus-auto-select-next)
- (gnus-summary-read-group group nil t)
- ;; ... and enter the articles into the cache.
- (when (eq major-mode 'gnus-summary-mode)
- (gnus-uu-mark-buffer)
- (gnus-cache-enter-article)
- (kill-buffer (current-buffer))))))))
-
-(defun gnus-cache-read-active (&optional force)
- "Read the cache active file."
- (gnus-make-directory gnus-cache-directory)
- (if (or (not (file-exists-p gnus-cache-active-file))
- (zerop (nth 7 (file-attributes gnus-cache-active-file)))
- force)
- ;; There is no active file, so we generate one.
- (gnus-cache-generate-active)
- ;; We simply read the active file.
- (save-excursion
- (gnus-set-work-buffer)
- (nnheader-insert-file-contents gnus-cache-active-file)
- (gnus-active-to-gnus-format
- nil (setq gnus-cache-active-hashtb
- (gnus-make-hashtable
- (count-lines (point-min) (point-max)))))
- (setq gnus-cache-active-altered nil))))
-
-(defun gnus-cache-write-active (&optional force)
- "Write the active hashtb to the active file."
- (when (or force
- (and gnus-cache-active-hashtb
- gnus-cache-active-altered))
- (gnus-write-active-file gnus-cache-active-file gnus-cache-active-hashtb t)
- ;; Mark the active hashtb as unaltered.
- (setq gnus-cache-active-altered nil)))
-
-(defun gnus-cache-possibly-update-active (group active)
- "Update active info bounds of GROUP with ACTIVE if necessary.
-The update is performed if ACTIVE contains a higher or lower bound
-than the current."
- (let ((lower t) (higher t))
- (if gnus-cache-active-hashtb
- (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (when cache-active
- (unless (< (car active) (car cache-active))
- (setq lower nil))
- (unless (> (cdr active) (cdr cache-active))
- (setq higher nil))))
- (gnus-cache-read-active))
- (when lower
- (gnus-cache-update-active group (car active) t))
- (when higher
- (gnus-cache-update-active group (cdr active)))))
-
-(defun gnus-cache-update-active (group number &optional low)
- "Update the upper bound of the active info of GROUP to NUMBER.
-If LOW, update the lower bound instead."
- (let ((active (gnus-gethash group gnus-cache-active-hashtb)))
- (if (null active)
- ;; We just create a new active entry for this group.
- (gnus-sethash group (cons number number) gnus-cache-active-hashtb)
- ;; Update the lower or upper bound.
- (if low
- (setcar active number)
- (setcdr active number)))
- ;; Mark the active hashtb as altered.
- (setq gnus-cache-active-altered t)))
-
-;;;###autoload
-(defun gnus-cache-generate-active (&optional directory)
- "Generate the cache active file."
- (interactive)
- (let* ((top (null directory))
- (directory (expand-file-name (or directory gnus-cache-directory)))
- (files (directory-files directory 'full))
- (group
- (if top
- ""
- (string-match
- (concat "^" (regexp-quote
- (file-name-as-directory
- (expand-file-name gnus-cache-directory))))
- (directory-file-name directory))
- (nnheader-replace-chars-in-string
- (substring (directory-file-name directory) (match-end 0))
- ?/ ?.)))
- nums alphs)
- (when top
- (gnus-message 5 "Generating the cache active file...")
- (setq gnus-cache-active-hashtb (gnus-make-hashtable 123)))
- (when (string-match "^\\(nn[^_]+\\)_" group)
- (setq group (replace-match "\\1:" t nil group)))
- ;; Separate articles from all other files and directories.
- (while files
- (if (string-match "^[0-9]+$" (file-name-nondirectory (car files)))
- (push (string-to-number (file-name-nondirectory (pop files))) nums)
- (push (pop files) alphs)))
- ;; If we have nums, then this is probably a valid group.
- (when (setq nums (sort nums '<))
- (gnus-sethash group (cons (car nums) (gnus-last-element nums))
- gnus-cache-active-hashtb))
- ;; Go through all the other files.
- (while alphs
- (when (and (file-directory-p (car alphs))
- (not (string-match "^\\."
- (file-name-nondirectory (car alphs)))))
- ;; We descend directories.
- (gnus-cache-generate-active (car alphs)))
- (setq alphs (cdr alphs)))
- ;; Write the new active file.
- (when top
- (gnus-cache-write-active t)
- (gnus-message 5 "Generating the cache active file...done"))))
-
-;;;###autoload
-(defun gnus-cache-generate-nov-databases (dir)
- "Generate NOV files recursively starting in DIR."
- (interactive (list gnus-cache-directory))
- (gnus-cache-close)
- (let ((nnml-generate-active-function 'identity))
- (nnml-generate-nov-databases-1 dir))
- (gnus-cache-open))
-
-(defun gnus-cache-move-cache (dir)
- "Move the cache tree to somewhere else."
- (interactive "FMove the cache tree to: ")
- (rename-file gnus-cache-directory dir))
-
-(defun gnus-cache-fully-p (&optional group)
- "Returns non-nil if the cache should be fully used.
-If GROUP is non-nil, also cater to `gnus-cacheable-groups' and
-`gnus-uncacheable-groups'."
- (and gnus-use-cache
- (not (eq gnus-use-cache 'passive))
- (if (null group)
- t
- (and (or (not gnus-cacheable-groups)
- (string-match gnus-cacheable-groups group))
- (or (not gnus-uncacheable-groups)
- (not (string-match gnus-uncacheable-groups group)))))))
-
-;;;###autoload
-(defun gnus-cache-rename-group (old-group new-group)
- "Rename OLD-GROUP as NEW-GROUP.
-Always updates the cache, even when disabled, as the old cache
-files would corrupt Gnus when the cache was next enabled. It
-depends on the caller to determine whether group renaming is
-supported."
- (let ((old-dir (gnus-cache-file-name old-group ""))
- (new-dir (gnus-cache-file-name new-group "")))
- (gnus-rename-file old-dir new-dir t))
-
- (let ((no-save gnus-cache-active-hashtb))
- (unless gnus-cache-active-hashtb
- (gnus-cache-read-active))
- (let* ((old-group-hash-value
- (gnus-gethash old-group gnus-cache-active-hashtb))
- (new-group-hash-value
- (gnus-gethash new-group gnus-cache-active-hashtb))
- (delta
- (or old-group-hash-value new-group-hash-value)))
- (gnus-sethash new-group old-group-hash-value gnus-cache-active-hashtb)
- (gnus-sethash old-group nil gnus-cache-active-hashtb)
-
- (if no-save
- (setq gnus-cache-active-altered delta)
- (gnus-cache-write-active delta)))))
-
-;;;###autoload
-(defun gnus-cache-delete-group (group)
- "Delete GROUP from the cache.
-Always updates the cache, even when disabled, as the old cache
-files would corrupt gnus when the cache was next enabled.
-Depends upon the caller to determine whether group deletion is
-supported."
- (let ((dir (gnus-cache-file-name group "")))
- (gnus-delete-directory dir))
-
- (let ((no-save gnus-cache-active-hashtb))
- (unless gnus-cache-active-hashtb
- (gnus-cache-read-active))
- (let* ((group-hash-value (gnus-gethash group gnus-cache-active-hashtb)))
- (gnus-sethash group nil gnus-cache-active-hashtb)
-
- (if no-save
- (setq gnus-cache-active-altered group-hash-value)
- (gnus-cache-write-active group-hash-value)))))
-
-(provide 'gnus-cache)
-
-;;; arch-tag: 05a79442-8c58-4e65-bd0a-3cbb1b89a33a
-;;; gnus-cache.el ends here
+++ /dev/null
-;;; gnus-cite.el --- parse citations in articles for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Per Abhiddenware
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-range)
-(require 'gnus-art)
-(require 'message) ; for message-cite-prefix-regexp
-
-;;; Customization:
-
-(defgroup gnus-cite nil
- "Citation."
- :prefix "gnus-cite-"
- :link '(custom-manual "(gnus)Article Highlighting")
- :group 'gnus-article)
-
-(defcustom gnus-cited-opened-text-button-line-format "%(%{[-]%}%)\n"
- "Format of opened cited text buttons."
- :group 'gnus-cite
- :type 'string)
-
-(defcustom gnus-cited-closed-text-button-line-format "%(%{[+]%}%)\n"
- "Format of closed cited text buttons."
- :group 'gnus-cite
- :type 'string)
-
-(defcustom gnus-cited-lines-visible nil
- "The number of lines of hidden cited text to remain visible.
-Or a pair (cons) of numbers which are the number of lines at the top
-and bottom of the text, respectively, to remain visible."
- :group 'gnus-cite
- :type '(choice (const :tag "none" nil)
- integer
- (cons :tag "Top and Bottom" integer integer)))
-
-(defcustom gnus-cite-parse-max-size 25000
- "Maximum article size (in bytes) where parsing citations is allowed.
-Set it to nil to parse all articles."
- :group 'gnus-cite
- :type '(choice (const :tag "all" nil)
- integer))
-
-(defcustom gnus-cite-max-prefix 20
- "Maximum possible length for a citation prefix."
- :group 'gnus-cite
- :type 'integer)
-
-(defcustom gnus-supercite-regexp
- (concat "^\\(" message-cite-prefix-regexp "\\)? *"
- ">>>>> +\"\\([^\"\n]+\\)\" +==")
- "*Regexp matching normal Supercite attribution lines.
-The first grouping must match prefixes added by other packages."
- :group 'gnus-cite
- :type 'regexp)
-
-(defcustom gnus-supercite-secondary-regexp "^.*\"\\([^\"\n]+\\)\" +=="
- "Regexp matching mangled Supercite attribution lines.
-The first regexp group should match the Supercite attribution."
- :group 'gnus-cite
- :type 'regexp)
-
-(defcustom gnus-cite-minimum-match-count 2
- "Minimum number of identical prefixes before we believe it's a citation."
- :group 'gnus-cite
- :type 'integer)
-
-;; Some Microsoft products put in a citation that extends to the
-;; remainder of the message:
-;;
-;; -----Original Message-----
-;; From: ...
-;; To: ...
-;; Sent: ... [date, in non-RFC-2822 format]
-;; Subject: ...
-;;
-;; Cited message, with no prefixes
-;;
-;; The four headers are always the same. But note they are prone to
-;; folding without additional indentation.
-;;
-;; Others use "----- Original Message -----" instead, and properly quote
-;; the body using "> ". This style is handled without special cases.
-
-(defcustom gnus-cite-attribution-prefix
- "In article\\|in <\\|On \\(Mon\\|Tue\\|Wed\\|Thu\\|Fri\\|Sat\\|Sun\\),\\|----- ?Original Message ?-----"
- "*Regexp matching the beginning of an attribution line."
- :group 'gnus-cite
- :type 'regexp)
-
-(defcustom gnus-cite-attribution-suffix
- "\\(\\(wrote\\|writes\\|said\\|says\\|>\\)\\(:\\|\\.\\.\\.\\)\\|----- ?Original Message ?-----\\)[ \t]*$"
- "*Regexp matching the end of an attribution line.
-The text matching the first grouping will be used as a button."
- :group 'gnus-cite
- :type 'regexp)
-
-(defcustom gnus-cite-unsightly-citation-regexp
- "^-----Original Message-----\nFrom: \\(.+\n\\)+\n"
- "Regexp matching Microsoft-type rest-of-message citations."
- :version "22.1"
- :group 'gnus-cite
- :type 'regexp)
-
-(defcustom gnus-cite-ignore-quoted-from t
- "Non-nil means don't regard lines beginning with \">From \" as cited text.
-Those lines may have been quoted by MTAs in order not to mix up with
-the envelope From line."
- :version "22.1"
- :group 'gnus-cite
- :type 'boolean)
-
-(defface gnus-cite-attribution '((t (:italic t)))
- "Face used for attribution lines."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-attribution-face 'face-alias 'gnus-cite-attribution)
-
-(defcustom gnus-cite-attribution-face 'gnus-cite-attribution
- "Face used for attribution lines.
-It is merged with the face for the cited text belonging to the attribution."
- :version "22.1"
- :group 'gnus-cite
- :type 'face)
-
-(defface gnus-cite-1 '((((class color)
- (background dark))
- (:foreground "light blue"))
- (((class color)
- (background light))
- (:foreground "MidnightBlue"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-1 'face-alias 'gnus-cite-1)
-
-(defface gnus-cite-2 '((((class color)
- (background dark))
- (:foreground "light cyan"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-2 'face-alias 'gnus-cite-2)
-
-(defface gnus-cite-3 '((((class color)
- (background dark))
- (:foreground "light yellow"))
- (((class color)
- (background light))
- (:foreground "dark green"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-3 'face-alias 'gnus-cite-3)
-
-(defface gnus-cite-4 '((((class color)
- (background dark))
- (:foreground "light pink"))
- (((class color)
- (background light))
- (:foreground "OrangeRed"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-4 'face-alias 'gnus-cite-4)
-
-(defface gnus-cite-5 '((((class color)
- (background dark))
- (:foreground "pale green"))
- (((class color)
- (background light))
- (:foreground "dark khaki"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-5 'face-alias 'gnus-cite-5)
-
-(defface gnus-cite-6 '((((class color)
- (background dark))
- (:foreground "beige"))
- (((class color)
- (background light))
- (:foreground "dark violet"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-6 'face-alias 'gnus-cite-6)
-
-(defface gnus-cite-7 '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "SteelBlue4"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-7 'face-alias 'gnus-cite-7)
-
-(defface gnus-cite-8 '((((class color)
- (background dark))
- (:foreground "magenta"))
- (((class color)
- (background light))
- (:foreground "magenta"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-8 'face-alias 'gnus-cite-8)
-
-(defface gnus-cite-9 '((((class color)
- (background dark))
- (:foreground "violet"))
- (((class color)
- (background light))
- (:foreground "violet"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-9 'face-alias 'gnus-cite-9)
-
-(defface gnus-cite-10 '((((class color)
- (background dark))
- (:foreground "medium purple"))
- (((class color)
- (background light))
- (:foreground "medium purple"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-10 'face-alias 'gnus-cite-10)
-
-(defface gnus-cite-11 '((((class color)
- (background dark))
- (:foreground "turquoise"))
- (((class color)
- (background light))
- (:foreground "turquoise"))
- (t
- (:italic t)))
- "Citation face."
- :group 'gnus-cite)
-;; backward-compatibility alias
-(put 'gnus-cite-face-11 'face-alias 'gnus-cite-11)
-
-(defcustom gnus-cite-face-list
- '(gnus-cite-1 gnus-cite-2 gnus-cite-3 gnus-cite-4 gnus-cite-5 gnus-cite-6
- gnus-cite-7 gnus-cite-8 gnus-cite-9 gnus-cite-10 gnus-cite-11)
- "*List of faces used for highlighting citations.
-
-When there are citations from multiple articles in the same message,
-Gnus will try to give each citation from each article its own face.
-This should make it easier to see who wrote what."
- :group 'gnus-cite
- :type '(repeat face))
-
-(defcustom gnus-cite-hide-percentage 50
- "Only hide excess citation if above this percentage of the body."
- :group 'gnus-cite
- :type 'number)
-
-(defcustom gnus-cite-hide-absolute 10
- "Only hide excess citation if above this number of lines in the body."
- :group 'gnus-cite
- :type 'integer)
-
-(defcustom gnus-cite-blank-line-after-header t
- "If non-nil, put a blank line between the citation header and the button."
- :group 'gnus-cite
- :type 'boolean)
-
-;; This has to go here because its default value depends on
-;; gnus-cite-face-list.
-(defcustom gnus-article-boring-faces (cons 'gnus-signature gnus-cite-face-list)
- "List of faces that are not worth reading.
-If an article has more pages below the one you are looking at, but
-nothing on those pages is a word of at least three letters that is not
-in a boring face, then the pages will be skipped."
- :type '(repeat face)
- :group 'gnus-article-hiding)
-
-;;; Internal Variables:
-
-(defvar gnus-cite-article nil)
-(defvar gnus-cite-overlay-list nil)
-
-(defvar gnus-cite-prefix-alist nil)
-;; Alist of citation prefixes.
-;; The cdr is a list of lines with that prefix.
-
-(defvar gnus-cite-attribution-alist nil)
-;; Alist of attribution lines.
-;; The car is a line number.
-;; The cdr is the prefix for the citation started by that line.
-
-(defvar gnus-cite-loose-prefix-alist nil)
-;; Alist of citation prefixes that have no matching attribution.
-;; The cdr is a list of lines with that prefix.
-
-(defvar gnus-cite-loose-attribution-alist nil)
-;; Alist of attribution lines that have no matching citation.
-;; Each member has the form (WROTE IN PREFIX TAG), where
-;; WROTE: is the attribution line number
-;; IN: is the line number of the previous line if part of the same attribution,
-;; PREFIX: Is the citation prefix of the attribution line(s), and
-;; TAG: Is a Supercite tag, if any.
-
-(defvar gnus-cited-opened-text-button-line-format-alist
- `((?b (marker-position beg) ?d)
- (?e (marker-position end) ?d)
- (?n (count-lines beg end) ?d)
- (?l (- end beg) ?d)))
-(defvar gnus-cited-opened-text-button-line-format-spec nil)
-(defvar gnus-cited-closed-text-button-line-format-alist
- gnus-cited-opened-text-button-line-format-alist)
-(defvar gnus-cited-closed-text-button-line-format-spec nil)
-
-
-;;; Commands:
-
-(defun gnus-article-highlight-citation (&optional force)
- "Highlight cited text.
-Each citation in the article will be highlighted with a different face.
-The faces are taken from `gnus-cite-face-list'.
-Attribution lines are highlighted with the same face as the
-corresponding citation merged with the face `gnus-cite-attribution'.
-
-Text is considered cited if at least `gnus-cite-minimum-match-count'
-lines matches `message-cite-prefix-regexp' with the same prefix.
-
-Lines matching `gnus-cite-attribution-suffix' and perhaps
-`gnus-cite-attribution-prefix' are considered attribution lines."
- (interactive (list 'force))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe force)
- (let ((buffer-read-only nil)
- (alist gnus-cite-prefix-alist)
- (faces gnus-cite-face-list)
- (inhibit-point-motion-hooks t)
- face entry prefix skip numbers number face-alist)
- ;; Loop through citation prefixes.
- (while alist
- (setq entry (car alist)
- alist (cdr alist)
- prefix (car entry)
- numbers (cdr entry)
- face (car faces)
- faces (or (cdr faces) gnus-cite-face-list)
- face-alist (cons (cons prefix face) face-alist))
- (while numbers
- (setq number (car numbers)
- numbers (cdr numbers))
- (and (not (assq number gnus-cite-attribution-alist))
- (not (assq number gnus-cite-loose-attribution-alist))
- (gnus-cite-add-face number prefix face))))
- ;; Loop through attribution lines.
- (setq alist gnus-cite-attribution-alist)
- (while alist
- (setq entry (car alist)
- alist (cdr alist)
- number (car entry)
- prefix (cdr entry)
- skip (gnus-cite-find-prefix number)
- face (cdr (assoc prefix face-alist)))
- ;; Add attribution button.
- (goto-char (point-min))
- (forward-line (1- number))
- (when (re-search-forward gnus-cite-attribution-suffix
- (gnus-point-at-eol)
- t)
- (gnus-article-add-button (match-beginning 1) (match-end 1)
- 'gnus-cite-toggle prefix))
- ;; Highlight attribution line.
- (gnus-cite-add-face number skip face)
- (gnus-cite-add-face number skip gnus-cite-attribution-face))
- ;; Loop through attribution lines.
- (setq alist gnus-cite-loose-attribution-alist)
- (while alist
- (setq entry (car alist)
- alist (cdr alist)
- number (car entry)
- skip (gnus-cite-find-prefix number))
- (gnus-cite-add-face number skip gnus-cite-attribution-face)))))
-
-(defun gnus-dissect-cited-text ()
- "Dissect the article buffer looking for cited text."
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe nil t)
- (let ((alist gnus-cite-prefix-alist)
- prefix numbers number marks m)
- ;; Loop through citation prefixes.
- (while alist
- (setq numbers (pop alist)
- prefix (pop numbers))
- (while numbers
- (setq number (pop numbers))
- (goto-char (point-min))
- (forward-line number)
- (push (cons (point-marker) "") marks)
- (while (and numbers
- (= (1- number) (car numbers)))
- (setq number (pop numbers)))
- (goto-char (point-min))
- (forward-line (1- number))
- (push (cons (point-marker) prefix) marks)))
- ;; Skip to the beginning of the body.
- (article-goto-body)
- (push (cons (point-marker) "") marks)
- ;; Find the end of the body.
- (goto-char (point-max))
- (gnus-article-search-signature)
- (push (cons (point-marker) "") marks)
- ;; Sort the marks.
- (setq marks (sort marks 'car-less-than-car))
- (let ((omarks marks))
- (setq marks nil)
- (while (cdr omarks)
- (if (= (caar omarks) (caadr omarks))
- (progn
- (unless (equal (cdar omarks) "")
- (push (car omarks) marks))
- (unless (equal (cdadr omarks) "")
- (push (cadr omarks) marks))
- (unless (and (equal (cdar omarks) "")
- (equal (cdadr omarks) "")
- (not (cddr omarks)))
- (setq omarks (cdr omarks))))
- (push (car omarks) marks))
- (setq omarks (cdr omarks)))
- (when (car omarks)
- (push (car omarks) marks))
- (setq marks (setq m (nreverse marks)))
- (while (cddr m)
- (if (and (equal (cdadr m) "")
- (equal (cdar m) (cdaddr m))
- (goto-char (caadr m))
- (forward-line 1)
- (= (point) (caaddr m)))
- (setcdr m (cdddr m))
- (setq m (cdr m))))
- marks))))
-
-(defun gnus-article-fill-cited-article (&optional force width)
- "Do word wrapping in the current article.
-If WIDTH (the numerical prefix), use that text width when filling."
- (interactive (list t current-prefix-arg))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (marks (gnus-dissect-cited-text))
- (adaptive-fill-mode nil)
- (filladapt-mode nil)
- (fill-column (if width (prefix-numeric-value width) fill-column)))
- (save-restriction
- (while (cdr marks)
- (narrow-to-region (caar marks) (caadr marks))
- (let ((adaptive-fill-regexp
- (concat "^" (regexp-quote (cdar marks)) " *"))
- (fill-prefix
- (if (string= (cdar marks) "") ""
- (concat (cdar marks) " ")))
- use-hard-newlines)
- (fill-region (point-min) (point-max)))
- (set-marker (caar marks) nil)
- (setq marks (cdr marks)))
- (when marks
- (set-marker (caar marks) nil))
- ;; All this information is now incorrect.
- (setq gnus-cite-prefix-alist nil
- gnus-cite-attribution-alist nil
- gnus-cite-loose-prefix-alist nil
- gnus-cite-loose-attribution-alist nil
- gnus-cite-article nil)))))
-
-(defun gnus-article-hide-citation (&optional arg force)
- "Toggle hiding of all cited text except attribution lines.
-See the documentation for `gnus-article-highlight-citation'.
-If given a negative prefix, always show; if given a positive prefix,
-always hide."
- (interactive (append (gnus-article-hidden-arg) (list 'force)))
- (gnus-set-format 'cited-opened-text-button t)
- (gnus-set-format 'cited-closed-text-button t)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((buffer-read-only nil)
- marks
- (inhibit-point-motion-hooks t)
- (props (nconc (list 'article-type 'cite)
- gnus-hidden-properties))
- (point (point-min))
- found beg end start)
- (while (setq point
- (text-property-any point (point-max)
- 'gnus-callback
- 'gnus-article-toggle-cited-text))
- (setq found t)
- (goto-char point)
- (gnus-article-toggle-cited-text
- (get-text-property point 'gnus-data) arg)
- (forward-line 1)
- (setq point (point)))
- (unless found
- (setq marks (gnus-dissect-cited-text))
- (while marks
- (setq beg nil
- end nil)
- (while (and marks (string= (cdar marks) ""))
- (setq marks (cdr marks)))
- (when marks
- (setq beg (caar marks)))
- (while (and marks (not (string= (cdar marks) "")))
- (setq marks (cdr marks)))
- (when marks
- (setq end (caar marks)))
- ;; Skip past lines we want to leave visible.
- (when (and beg end gnus-cited-lines-visible)
- (goto-char beg)
- (forward-line (if (consp gnus-cited-lines-visible)
- (car gnus-cited-lines-visible)
- gnus-cited-lines-visible))
- (if (>= (point) end)
- (setq beg nil)
- (setq beg (point-marker))
- (when (consp gnus-cited-lines-visible)
- (goto-char end)
- (forward-line (- (cdr gnus-cited-lines-visible)))
- (if (<= (point) beg)
- (setq beg nil)
- (setq end (point-marker))))))
- (when (and beg end)
- (gnus-add-wash-type 'cite)
- ;; We use markers for the end-points to facilitate later
- ;; wrapping and mangling of text.
- (setq beg (set-marker (make-marker) beg)
- end (set-marker (make-marker) end))
- (gnus-add-text-properties-when 'article-type nil beg end props)
- (goto-char beg)
- (when (and gnus-cite-blank-line-after-header
- (not (save-excursion (search-backward "\n\n" nil t))))
- (insert "\n"))
- (put-text-property
- (setq start (point-marker))
- (progn
- (gnus-article-add-button
- (point)
- (progn (eval gnus-cited-closed-text-button-line-format-spec)
- (point))
- `gnus-article-toggle-cited-text
- (list (cons beg end) start))
- (point))
- 'article-type 'annotation)
- (set-marker beg (point))))))))
-
-(defun gnus-article-toggle-cited-text (args &optional arg)
- "Toggle hiding the text in REGION.
-ARG can be nil or a number. Positive means hide, negative
-means show, nil means toggle."
- (let* ((region (car args))
- (beg (car region))
- (end (cdr region))
- (start (cadr args))
- (hidden
- (text-property-any beg (1- end) 'article-type 'cite))
- (inhibit-point-motion-hooks t)
- buffer-read-only)
- (when (or (null arg)
- (zerop arg)
- (and (> arg 0) (not hidden))
- (and (< arg 0) hidden))
- (if hidden
- (progn
- ;; Can't remove 'cite from g-a-wash-types here because
- ;; multiple citations may be hidden -jas
- (gnus-remove-text-properties-when
- 'article-type 'cite beg end
- (cons 'article-type (cons 'cite
- gnus-hidden-properties))))
- (gnus-add-wash-type 'cite)
- (gnus-add-text-properties-when
- 'article-type nil beg end
- (cons 'article-type (cons 'cite
- gnus-hidden-properties))))
- (let ((gnus-article-mime-handle-alist-1 gnus-article-mime-handle-alist))
- (gnus-set-mode-line 'article))
- (save-excursion
- (goto-char start)
- (gnus-delete-line)
- (put-text-property
- (point)
- (progn
- (gnus-article-add-button
- (point)
- (progn (eval
- (if hidden
- gnus-cited-opened-text-button-line-format-spec
- gnus-cited-closed-text-button-line-format-spec))
- (point))
- `gnus-article-toggle-cited-text
- args)
- (point))
- 'article-type 'annotation)))))
-
-(defun gnus-article-hide-citation-maybe (&optional arg force)
- "Toggle hiding of cited text that has an attribution line.
-If given a negative prefix, always show; if given a positive prefix,
-always hide.
-This will do nothing unless at least `gnus-cite-hide-percentage'
-percent and at least `gnus-cite-hide-absolute' lines of the body is
-cited text with attributions. When called interactively, these two
-variables are ignored.
-See also the documentation for `gnus-article-highlight-citation'."
- (interactive (append (gnus-article-hidden-arg) '(force)))
- (with-current-buffer gnus-article-buffer
- (gnus-delete-wash-type 'cite)
- (unless (gnus-article-check-hidden-text 'cite arg)
- (save-excursion
- (gnus-cite-parse-maybe force)
- (article-goto-body)
- (let ((start (point))
- (atts gnus-cite-attribution-alist)
- (buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden 0)
- total)
- (goto-char (point-max))
- (gnus-article-search-signature)
- (setq total (count-lines start (point)))
- (while atts
- (setq hidden (+ hidden (length (cdr (assoc (cdar atts)
- gnus-cite-prefix-alist))))
- atts (cdr atts)))
- (when (or force
- (and (> (* 100 hidden) (* gnus-cite-hide-percentage total))
- (> hidden gnus-cite-hide-absolute)))
- (gnus-add-wash-type 'cite)
- (setq atts gnus-cite-attribution-alist)
- (while atts
- (setq total (cdr (assoc (cdar atts) gnus-cite-prefix-alist))
- atts (cdr atts))
- (while total
- (setq hidden (car total)
- total (cdr total))
- (goto-char (point-min))
- (forward-line (1- hidden))
- (unless (assq hidden gnus-cite-attribution-alist)
- (gnus-add-text-properties
- (point) (progn (forward-line 1) (point))
- (nconc (list 'article-type 'cite)
- gnus-hidden-properties)))))))))
- (gnus-set-mode-line 'article)))
-
-(defun gnus-article-hide-citation-in-followups ()
- "Hide cited text in non-root articles."
- (interactive)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((article (cdr gnus-article-current)))
- (unless (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-article-displayed-root-p article))
- (gnus-article-hide-citation)))))
-
-;;; Internal functions:
-
-(defun gnus-cite-parse-maybe (&optional force no-overlay)
- "Always parse the buffer."
- (gnus-cite-localize)
- ;;Reset parser information.
- (setq gnus-cite-prefix-alist nil
- gnus-cite-attribution-alist nil
- gnus-cite-loose-prefix-alist nil
- gnus-cite-loose-attribution-alist nil)
- (unless no-overlay
- (gnus-cite-delete-overlays))
- ;; Parse if not too large.
- (if (and gnus-cite-parse-max-size
- (> (buffer-size) gnus-cite-parse-max-size))
- ()
- (setq gnus-cite-article (cons (car gnus-article-current)
- (cdr gnus-article-current)))
- (gnus-cite-parse-wrapper)))
-
-(defun gnus-cite-delete-overlays ()
- (dolist (overlay gnus-cite-overlay-list)
- (ignore-errors
- (when (or (not (gnus-overlay-end overlay))
- (and (>= (gnus-overlay-end overlay) (point-min))
- (<= (gnus-overlay-end overlay) (point-max))))
- (setq gnus-cite-overlay-list (delete overlay gnus-cite-overlay-list))
- (ignore-errors
- (gnus-delete-overlay overlay))))))
-
-(defun gnus-cite-parse-wrapper ()
- ;; Wrap chopped gnus-cite-parse.
- (article-goto-body)
- (let ((inhibit-point-motion-hooks t))
- (save-excursion
- (gnus-cite-parse-attributions))
- (save-excursion
- (gnus-cite-parse))
- (save-excursion
- (gnus-cite-connect-attributions))))
-
-(defun gnus-cite-parse ()
- ;; Parse and connect citation prefixes and attribution lines.
-
- ;; Parse current buffer searching for citation prefixes.
- (let ((line (1+ (count-lines (point-min) (point))))
- (case-fold-search t)
- (max (save-excursion
- (goto-char (point-max))
- (gnus-article-search-signature)
- (point)))
- (prefix-regexp (concat "^\\(" message-cite-prefix-regexp "\\)"))
- alist entry start begin end numbers prefix guess-limit)
- ;; Get all potential prefixes in `alist'.
- (while (< (point) max)
- ;; Each line.
- (setq begin (point)
- guess-limit (progn (skip-chars-forward "^> \t\r\n") (point))
- end (gnus-point-at-bol 2)
- start end)
- (goto-char begin)
- ;; Ignore standard Supercite attribution prefix.
- (when (and (< guess-limit (+ begin gnus-cite-max-prefix))
- (looking-at gnus-supercite-regexp))
- (if (match-end 1)
- (setq end (1+ (match-end 1)))
- (setq end (1+ begin))))
- ;; Ignore very long prefixes.
- (when (> end (+ begin gnus-cite-max-prefix))
- (setq end (+ begin gnus-cite-max-prefix)))
- ;; Ignore quoted envelope From_.
- (when (and gnus-cite-ignore-quoted-from
- (prog2
- (setq case-fold-search nil)
- (looking-at ">From ")
- (setq case-fold-search t)))
- (setq end (1+ begin)))
- (while (re-search-forward prefix-regexp (1- end) t)
- ;; Each prefix.
- (setq end (match-end 0)
- prefix (buffer-substring begin end))
- (gnus-set-text-properties 0 (length prefix) nil prefix)
- (setq entry (assoc prefix alist))
- (if entry
- (setcdr entry (cons line (cdr entry)))
- (push (list prefix line) alist))
- (goto-char begin))
- (goto-char start)
- (setq line (1+ line)))
- ;; Horrible special case for some Microsoft mailers.
- (goto-char (point-min))
- (when (re-search-forward gnus-cite-unsightly-citation-regexp max t)
- (setq begin (count-lines (point-min) (point)))
- (setq end (count-lines (point-min) max))
- (setq entry nil)
- (while (< begin end)
- (push begin entry)
- (setq begin (1+ begin)))
- (push (cons "" entry) alist))
- ;; We got all the potential prefixes. Now create
- ;; `gnus-cite-prefix-alist' containing the oldest prefix for each
- ;; line that appears at least `gnus-cite-minimum-match-count'
- ;; times. First sort them by length. Longer is older.
- (setq alist (sort alist (lambda (a b)
- (> (length (car a)) (length (car b))))))
- (while alist
- (setq entry (car alist)
- prefix (car entry)
- numbers (cdr entry)
- alist (cdr alist))
- (cond ((null numbers)
- ;; No lines with this prefix that wasn't also part of
- ;; a longer prefix.
- )
- ((< (length numbers) gnus-cite-minimum-match-count)
- ;; Too few lines with this prefix. We keep it a bit
- ;; longer in case it is an exact match for an attribution
- ;; line, but we don't remove the line from other
- ;; prefixes.
- (push entry gnus-cite-prefix-alist))
- (t
- (push entry
- gnus-cite-prefix-alist)
- ;; Remove articles from other prefixes.
- (let ((loop alist)
- current)
- (while loop
- (setq current (car loop)
- loop (cdr loop))
- (setcdr current
- (gnus-set-difference (cdr current) numbers)))))))))
-
-(defun gnus-cite-parse-attributions ()
- (let (al-alist)
- ;; Parse attributions
- (while (re-search-forward gnus-cite-attribution-suffix (point-max) t)
- (let* ((start (match-beginning 0))
- (end (match-end 0))
- (wrote (count-lines (point-min) end))
- (prefix (gnus-cite-find-prefix wrote))
- ;; Check previous line for an attribution leader.
- (tag (progn
- (beginning-of-line 1)
- (when (looking-at gnus-supercite-secondary-regexp)
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (in (progn
- (goto-char start)
- (and (re-search-backward gnus-cite-attribution-prefix
- (save-excursion
- (beginning-of-line 0)
- (point))
- t)
- (not (re-search-forward gnus-cite-attribution-suffix
- start t))
- (count-lines (point-min) (1+ (point)))))))
- (when (eq wrote in)
- (setq in nil))
- (goto-char end)
- ;; don't add duplicates
- (let ((al (buffer-substring (save-excursion (beginning-of-line 0)
- (1+ (point)))
- end)))
- (if (not (assoc al al-alist))
- (progn
- (push (list wrote in prefix tag)
- gnus-cite-loose-attribution-alist)
- (push (cons al t) al-alist))))))))
-
-(defun gnus-cite-connect-attributions ()
- ;; Connect attributions to citations
-
- ;; No citations have been connected to attribution lines yet.
- (setq gnus-cite-loose-prefix-alist (append gnus-cite-prefix-alist nil))
-
- ;; Parse current buffer searching for attribution lines.
- ;; Find exact supercite citations.
- (gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (when tag
- (concat "\\`"
- (regexp-quote prefix) "[ \t]*"
- (regexp-quote tag) ">"))))
- ;; Find loose supercite citations after attributions.
- (gnus-cite-match-attributions 'small t
- (lambda (prefix tag)
- (when tag
- (concat "\\<"
- (regexp-quote tag)
- "\\>"))))
- ;; Find loose supercite citations anywhere.
- (gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (when tag
- (concat "\\<"
- (regexp-quote tag)
- "\\>"))))
- ;; Find nested citations after attributions.
- (gnus-cite-match-attributions 'small-if-unique t
- (lambda (prefix tag)
- (concat "\\`" (regexp-quote prefix) ".+")))
- ;; Find nested citations anywhere.
- (gnus-cite-match-attributions 'small nil
- (lambda (prefix tag)
- (concat "\\`" (regexp-quote prefix) ".+")))
- ;; Remove loose prefixes with too few lines.
- (let ((alist gnus-cite-loose-prefix-alist)
- entry)
- (while alist
- (setq entry (car alist)
- alist (cdr alist))
- (when (< (length (cdr entry)) gnus-cite-minimum-match-count)
- (setq gnus-cite-prefix-alist
- (delq entry gnus-cite-prefix-alist)
- gnus-cite-loose-prefix-alist
- (delq entry gnus-cite-loose-prefix-alist)))))
- ;; Find flat attributions.
- (gnus-cite-match-attributions 'first t nil)
- ;; Find any attributions (are we getting desperate yet?).
- (gnus-cite-match-attributions 'first nil nil))
-
-(defun gnus-cite-match-attributions (sort after fun)
- ;; Match all loose attributions and citations (SORT AFTER FUN) .
- ;;
- ;; If SORT is `small', the citation with the shortest prefix will be
- ;; used, if it is `first' the first prefix will be used, if it is
- ;; `small-if-unique' the shortest prefix will be used if the
- ;; attribution line does not share its own prefix with other
- ;; loose attribution lines, otherwise the first prefix will be used.
- ;;
- ;; If AFTER is non-nil, only citations after the attribution line
- ;; will be considered.
- ;;
- ;; If FUN is non-nil, it will be called with the arguments (WROTE
- ;; PREFIX TAG) and expected to return a regular expression. Only
- ;; citations whose prefix matches the regular expression will be
- ;; considered.
- ;;
- ;; WROTE is the attribution line number.
- ;; PREFIX is the attribution line prefix.
- ;; TAG is the Supercite tag on the attribution line.
- (let ((atts gnus-cite-loose-attribution-alist)
- (case-fold-search t)
- att wrote in prefix tag regexp limit smallest best size)
- (while atts
- (setq att (car atts)
- atts (cdr atts)
- wrote (nth 0 att)
- in (nth 1 att)
- prefix (nth 2 att)
- tag (nth 3 att)
- regexp (if fun (funcall fun prefix tag) "")
- size (cond ((eq sort 'small) t)
- ((eq sort 'first) nil)
- (t (< (length (gnus-cite-find-loose prefix)) 2)))
- limit (if after wrote -1)
- smallest 1000000
- best nil)
- (let ((cites gnus-cite-loose-prefix-alist)
- cite candidate numbers first compare)
- (while cites
- (setq cite (car cites)
- cites (cdr cites)
- candidate (car cite)
- numbers (cdr cite)
- first (apply 'min numbers)
- compare (if size (length candidate) first))
- (and (> first limit)
- regexp
- (string-match regexp candidate)
- (< compare smallest)
- (setq best cite
- smallest compare))))
- (if (null best)
- ()
- (setq gnus-cite-loose-attribution-alist
- (delq att gnus-cite-loose-attribution-alist))
- (push (cons wrote (car best)) gnus-cite-attribution-alist)
- (when in
- (push (cons in (car best)) gnus-cite-attribution-alist))
- (when (memq best gnus-cite-loose-prefix-alist)
- (let ((loop gnus-cite-prefix-alist)
- (numbers (cdr best))
- current)
- (setq gnus-cite-loose-prefix-alist
- (delq best gnus-cite-loose-prefix-alist))
- (while loop
- (setq current (car loop)
- loop (cdr loop))
- (if (eq current best)
- ()
- (setcdr current (gnus-set-difference (cdr current) numbers))
- (when (null (cdr current))
- (setq gnus-cite-loose-prefix-alist
- (delq current gnus-cite-loose-prefix-alist)
- atts (delq current atts)))))))))))
-
-(defun gnus-cite-find-loose (prefix)
- ;; Return a list of loose attribution lines prefixed by PREFIX.
- (let* ((atts gnus-cite-loose-attribution-alist)
- att line lines)
- (while atts
- (setq att (car atts)
- line (car att)
- atts (cdr atts))
- (when (string-equal (gnus-cite-find-prefix line) prefix)
- (push line lines)))
- lines))
-
-(defun gnus-cite-add-face (number prefix face)
- ;; At line NUMBER, ignore PREFIX and add FACE to the rest of the line.
- (when face
- (let ((inhibit-point-motion-hooks t)
- from to overlay)
- (goto-char (point-min))
- (when (zerop (forward-line (1- number)))
- (forward-char (length prefix))
- (skip-chars-forward " \t")
- (setq from (point))
- (end-of-line 1)
- (skip-chars-backward " \t")
- (setq to (point))
- (when (< from to)
- (push (setq overlay (gnus-make-overlay from to))
- gnus-cite-overlay-list)
- (gnus-overlay-put overlay 'evaporate t)
- (gnus-overlay-put overlay 'face face))))))
-
-(defun gnus-cite-toggle (prefix)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (gnus-cite-parse-maybe nil t)
- (let ((buffer-read-only nil)
- (numbers (cdr (assoc prefix gnus-cite-prefix-alist)))
- (inhibit-point-motion-hooks t)
- number)
- (while numbers
- (setq number (car numbers)
- numbers (cdr numbers))
- (goto-char (point-min))
- (forward-line (1- number))
- (cond ((get-text-property (point) 'invisible)
- ;; Can't remove 'cite from g-a-wash-types here because
- ;; multiple citations may be hidden -jas
- (remove-text-properties (point) (progn (forward-line 1) (point))
- gnus-hidden-properties))
- ((assq number gnus-cite-attribution-alist))
- (t
- (gnus-add-wash-type 'cite)
- (gnus-add-text-properties
- (point) (progn (forward-line 1) (point))
- (nconc (list 'article-type 'cite)
- gnus-hidden-properties))))
- (let ((gnus-article-mime-handle-alist-1
- gnus-article-mime-handle-alist))
- (gnus-set-mode-line 'article))))))
-
-(defun gnus-cite-find-prefix (line)
- ;; Return citation prefix for LINE.
- (let ((alist gnus-cite-prefix-alist)
- (prefix "")
- entry)
- (while alist
- (setq entry (car alist)
- alist (cdr alist))
- (when (memq line (cdr entry))
- (setq prefix (car entry))))
- prefix))
-
-(defun gnus-cite-localize ()
- "Make the citation variables local to the article buffer."
- (let ((vars '(gnus-cite-article
- gnus-cite-overlay-list gnus-cite-prefix-alist
- gnus-cite-attribution-alist gnus-cite-loose-prefix-alist
- gnus-cite-loose-attribution-alist)))
- (while vars
- (make-local-variable (pop vars)))))
-
-(defun gnus-cited-line-p ()
- "Say whether the current line is a cited line."
- (save-excursion
- (beginning-of-line)
- (let ((found nil))
- (dolist (prefix (mapcar 'car gnus-cite-prefix-alist))
- (when (string= (buffer-substring (point) (+ (length prefix) (point)))
- prefix)
- (setq found t)))
- found)))
-
-(gnus-ems-redefine)
-
-(provide 'gnus-cite)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: 1997b044-6067-471e-8c8f-dc903093098a
-;;; gnus-cite.el ends here
+++ /dev/null
-;;; gnus-cus.el --- customization commands for Gnus
-
-;; Copyright (C) 1996, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@dina.kvl.dk>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'wid-edit)
-(require 'gnus)
-(require 'gnus-agent)
-(require 'gnus-score)
-(require 'gnus-topic)
-(require 'gnus-art)
-
-;;; Widgets:
-
-(defun gnus-custom-mode ()
- "Major mode for editing Gnus customization buffers.
-
-The following commands are available:
-
-\\[widget-forward] Move to next button or editable field.
-\\[widget-backward] Move to previous button or editable field.
-\\[widget-button-click] Activate button under the mouse pointer.
-\\[widget-button-press] Activate button under point.
-
-Entry to this mode calls the value of `gnus-custom-mode-hook'
-if that value is non-nil."
- (kill-all-local-variables)
- (setq major-mode 'gnus-custom-mode
- mode-name "Gnus Customize")
- (use-local-map widget-keymap)
- ;; Emacs 21 stuff:
- (when (and (facep 'custom-button-face)
- (facep 'custom-button-pressed-face))
- (set (make-local-variable 'widget-button-face)
- 'custom-button-face)
- (set (make-local-variable 'widget-button-pressed-face)
- 'custom-button-pressed-face)
- (set (make-local-variable 'widget-mouse-face)
- 'custom-button-pressed-face))
- (when (and (boundp 'custom-raised-buttons)
- (symbol-value 'custom-raised-buttons))
- (set (make-local-variable 'widget-push-button-prefix) "")
- (set (make-local-variable 'widget-push-button-suffix) "")
- (set (make-local-variable 'widget-link-prefix) "")
- (set (make-local-variable 'widget-link-suffix) ""))
- (gnus-run-mode-hooks 'gnus-custom-mode-hook))
-
-;;; Group Customization:
-
-(defconst gnus-group-parameters
- '((extra-aliases (choice
- :tag "Extra Aliases"
- (list
- :tag "List"
- (editable-list
- :inline t
- (gnus-email-address :tag "Address")))
- (gnus-email-address :tag "Address")) "\
-Store messages posted from or to this address in this group.
-
-You must be using gnus-group-split for this to work. The VALUE of the
-nnmail-split-fancy SPLIT generated for this group will match these
-addresses.")
-
- (split-regexp (regexp :tag "gnus-group-split Regular Expression") "\
-Like gnus-group-split Address, but expects a regular expression.")
-
- (split-exclude (list :tag "gnus-group-split Restricts"
- (editable-list
- :inline t (regexp :tag "Restrict"))) "\
-Regular expression that cancels gnus-group-split matches.
-
-Each entry is added to the nnmail-split-fancy SPLIT as a separate
-RESTRICT clause.")
-
- (split-spec (choice :tag "gnus-group-split Overrider"
- (sexp :tag "Fancy Split")
- (const :tag "Catch All" catch-all)
- (const :tag "Ignore" nil)) "\
-Override all other gnus-group-split fields.
-
-In `Fancy Split', you can enter any nnmail-split-fancy SPLIT. Note
-that the name of this group won't be automatically assumed, you have
-to add it to the SPLITs yourself. This means you can use such splits
-to split messages to other groups too.
-
-If you select `Catch All', this group will get postings for any
-messages not matched in any other group. It overrides the variable
-gnus-group-split-default-catch-all-group.
-
-Selecting `Ignore' forces no SPLIT to be generated for this group,
-disabling all other gnus-group-split fields.")
-
- (broken-reply-to (const :tag "Broken Reply To" t) "\
-Ignore `Reply-To' headers in this group.
-
-That can be useful if you're reading a mailing list group where the
-listserv has inserted `Reply-To' headers that point back to the
-listserv itself. This is broken behavior. So there!")
-
- (to-group (string :tag "To Group") "\
-All posts will be sent to the specified group.")
-
- (gcc-self (choice :tag "GCC"
- :value t
- (const :tag "To current group" t)
- (const none)
- (string :format "%v" :hide-front-space t)) "\
-Specify default value for GCC header.
-
-If this symbol is present in the group parameter list and set to t,
-new composed messages will be `Gcc''d to the current group. If it is
-present and set to `none', no `Gcc:' header will be generated, if it
-is present and a string, this string will be inserted literally as a
-`gcc' header (this symbol takes precedence over any default `Gcc'
-rules as described later).")
-
- (expiry-wait (choice :tag "Expire Wait"
- :value never
- (const never)
- (const immediate)
- (number :hide-front-space t
- :format "%v")) "\
-When to expire.
-
-Overrides any `nnmail-expiry-wait' and `nnmail-expiry-wait-function'
-when expiring expirable messages. The value can either be a number of
-days (not necessarily an integer) or the symbols `never' or
-`immediate'.")
-
- (expiry-target (choice :tag "Expiry Target"
- :value delete
- (const delete)
- (function :format "%v" nnmail-)
- string) "\
-Where expired messages end up.
-
-Overrides `nnmail-expiry-target'.")
-
- (score-file (file :tag "Score File") "\
-Make the specified file into the current score file.
-This means that all score commands you issue will end up in this file.")
-
- (adapt-file (file :tag "Adapt File") "\
-Make the specified file into the current adaptive file.
-All adaptive score entries will be put into this file.")
-
- (admin-address (gnus-email-address :tag "Admin Address") "\
-Administration address for a mailing list.
-
-When unsubscribing to a mailing list you should never send the
-unsubscription notice to the mailing list itself. Instead, you'd
-send messages to the administrative address. This parameter allows
-you to put the admin address somewhere convenient.")
-
- (display (choice :tag "Display"
- :value default
- (const all)
- (integer)
- (const default)
- (sexp :tag "Other")) "\
-Which articles to display on entering the group.
-
-`all'
- Display all articles, both read and unread.
-
-`integer'
- Display the last NUMBER articles in the group. This is the same as
- entering the group with C-u NUMBER.
-
-`default'
- Display the default visible articles, which normally includes
- unread and ticked articles.
-
-`Other'
- Display the articles that satisfy the S-expression. The S-expression
- should be in an array form.")
-
- (comment (string :tag "Comment") "\
-An arbitrary comment on the group.")
-
- (visible (const :tag "Permanently visible" t) "\
-Always display this group, even when there are no unread articles in it.")
-
- (highlight-words
- (choice :tag "Highlight words"
- :value nil
- (repeat (list (regexp :tag "Highlight regexp")
- (number :tag "Group for entire word" 0)
- (number :tag "Group for displayed part" 0)
- (symbol :tag "Face"
- gnus-emphasis-highlight-words))))
- "highlight regexps.
-See `gnus-emphasis-alist'.")
-
- (posting-style
- (choice :tag "Posting style"
- :value nil
- (repeat (list
- (choice :tag "Type"
- :value nil
- (const signature)
- (const signature-file)
- (const organization)
- (const address)
- (const x-face-file)
- (const name)
- (const body)
- (symbol)
- (string :tag "Header"))
- (string :format "%v"))))
- "post style.
-See `gnus-posting-styles'."))
- "Alist of valid group or topic parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and
-DOC is a documentation string for the parameter.")
-
-(defconst gnus-extra-topic-parameters
- '((subscribe (regexp :tag "Subscribe") "\
-If `gnus-subscribe-newsgroup-method' or
-`gnus-subscribe-options-newsgroup-method' is set to
-`gnus-subscribe-topics', new groups that matches this regexp will
-automatically be subscribed to this topic")
- (subscribe-level (integer :tag "Subscribe Level" :value 1) "\
-If this topic parameter is set, when new groups are subscribed
-automatically under this topic (via the `subscribe' topic parameter)
-assign this level to the group, rather than the default level
-set in `gnus-level-default-subscribed'"))
- "Alist of topic parameters that are not also group parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and
-DOC is a documentation string for the parameter.")
-
-(defconst gnus-extra-group-parameters
- '((uidvalidity (string :tag "IMAP uidvalidity") "\
-Server-assigned value attached to IMAP groups, used to maintain consistency."))
- "Alist of group parameters that are not also topic parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and
-DOC is a documentation string for the parameter.")
-
-(eval-and-compile
- (defconst gnus-agent-parameters
- '((agent-predicate
- (sexp :tag "Selection Predicate" :value false)
- "Predicate used to automatically select articles for downloading."
- gnus-agent-cat-predicate)
- (agent-score
- (choice :tag "Score File" :value nil
- (const file :tag "Use group's score files")
- (repeat (list (string :format "%v" :tag "File name"))))
- "Which score files to use when using score to select articles to fetch.
-
- `nil'
- All articles will be scored to zero (0).
-
- `file'
- The group's score files will be used to score the articles.
-
- `List'
- A list of score file names."
- gnus-agent-cat-score-file)
- (agent-short-article
- (integer :tag "Max Length of Short Article" :value "")
- "The SHORT predicate will evaluate to true when the article is
-shorter than this length." gnus-agent-cat-length-when-short)
- (agent-long-article
- (integer :tag "Min Length of Long Article" :value "")
- "The LONG predicate will evaluate to true when the article is
-longer than this length." gnus-agent-cat-length-when-long)
- (agent-low-score
- (integer :tag "Low Score Limit" :value "")
- "The LOW predicate will evaluate to true when the article scores
-lower than this limit." gnus-agent-cat-low-score)
- (agent-high-score
- (integer :tag "High Score Limit" :value "")
- "The HIGH predicate will evaluate to true when the article scores
-higher than this limit." gnus-agent-cat-high-score)
- (agent-days-until-old
- (integer :tag "Days Until Old" :value "")
- "The OLD predicate will evaluate to true when the fetched article
-has been stored locally for at least this many days."
- gnus-agent-cat-days-until-old)
- (agent-enable-expiration
- (radio :tag "Expire in this Group or Topic" :value nil
- (const :format "Enable " ENABLE)
- (const :format "Disable " DISABLE))
- "\nEnable, or disable, agent expiration in this group or topic."
- gnus-agent-cat-enable-expiration)
- (agent-enable-undownloaded-faces
- (boolean :tag "Enable Agent Faces")
- "Have the summary buffer use the agent's undownloaded faces.
-These faces, when enabled, act as a warning that an article has not
-been fetched into either the agent nor the cache. This is of most use
-to users who use the agent as a cache (i.e. they only operate on
-articles that have been downloaded). Leave disabled to display normal
-article faces even when the article hasn't been downloaded."
-gnus-agent-cat-enable-undownloaded-faces))
- "Alist of group parameters that are not also topic parameters.
-
-Each entry has the form (NAME TYPE DOC ACCESSOR), where NAME is the
-parameter itself (a symbol), TYPE is the parameters type (a sexp
-widget), DOC is a documentation string for the parameter, and ACCESSOR
-is a function (symbol) that extracts the current value from the
-category."))
-
-(defvar gnus-custom-params)
-(defvar gnus-custom-method)
-(defvar gnus-custom-group)
-(defvar gnus-custom-topic)
-
-(defun gnus-group-customize (group &optional topic)
- "Edit the group or topic on the current line."
- (interactive (list (gnus-group-group-name) (gnus-group-topic-name)))
- (let (info
- (types (mapcar (lambda (entry)
- `(cons :format "%v%h\n"
- :doc ,(nth 2 entry)
- (const :format "" ,(nth 0 entry))
- ,(nth 1 entry)))
- (append (reverse gnus-group-parameters-more)
- gnus-group-parameters
- (if group
- gnus-extra-group-parameters
- gnus-extra-topic-parameters))))
- (agent (mapcar (lambda (entry)
- (let ((type (nth 1 entry))
- vcons)
- (if (listp type)
- (setq type (copy-sequence type)))
-
- (setq vcons (cdr (memq :value type)))
-
- (if (symbolp (car vcons))
- (condition-case nil
- (setcar vcons (symbol-value (car vcons)))
- (error)))
- `(cons :format "%v%h\n"
- :doc ,(nth 2 entry)
- (const :format "" ,(nth 0 entry))
- ,type)))
- (if gnus-agent
- gnus-agent-parameters))))
- (unless (or group topic)
- (error "No group on current line"))
- (when (and group topic)
- (error "Both a group an topic on current line"))
- (unless (or topic (setq info (gnus-get-info group)))
- (error "Killed group; can't be edited"))
- ;; Ready.
- (gnus-kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
- (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
- (gnus-custom-mode)
- (make-local-variable 'gnus-custom-group)
- (setq gnus-custom-group group)
- (make-local-variable 'gnus-custom-topic)
- (setq gnus-custom-topic topic)
- (buffer-disable-undo)
- (widget-insert "Customize the ")
- (if group
- (widget-create 'info-link
- :help-echo "Push me to learn more."
- :tag "group parameters"
- "(gnus)Group Parameters")
- (widget-create 'info-link
- :help-echo "Push me to learn more."
- :tag "topic parameters"
- "(gnus)Topic Parameters"))
- (widget-insert " for <")
- (widget-insert (gnus-group-decoded-name (or group topic)))
- (widget-insert "> and press ")
- (widget-create 'push-button
- :tag "done"
- :help-echo "Push me when done customizing."
- :action 'gnus-group-customize-done)
- (widget-insert ".\n\n")
- (make-local-variable 'gnus-custom-params)
-
- (let ((values (if group
- (gnus-info-params info)
- (gnus-topic-parameters topic))))
-
- ;; The parameters in values may contain duplicates. This is
- ;; normally OK as assq returns the first. However, right here
- ;; every duplicate ends up being displayed. So, rather than
- ;; display them, remove them from the list.
-
- (let ((tmp (setq values (gnus-copy-sequence values)))
- elem)
- (while (cdr tmp)
- (while (setq elem (assq (caar tmp) (cdr tmp)))
- (delq elem tmp))
- (setq tmp (cdr tmp))))
-
- (setq gnus-custom-params
- (apply 'widget-create 'group
- :value values
- (delq nil
- (list `(set :inline t
- :greedy t
- :tag "Parameters"
- :format "%t:\n%h%v"
- :doc "\
-These special parameters are recognized by Gnus.
-Check the [ ] for the parameters you want to apply to this group or
-to the groups in this topic, then edit the value to suit your taste."
- ,@types)
- (when gnus-agent
- `(set :inline t
- :greedy t
- :tag "Agent Parameters"
- :format "%t:\n%h%v"
- :doc "\ These agent parameters are
-recognized by Gnus. They control article selection and expiration for
-use in the unplugged cache. Check the [ ] for the parameters you want
-to apply to this group or to the groups in this topic, then edit the
-value to suit your taste.
-
-For those interested, group parameters override topic parameters while
-topic parameters override agent category parameters. Underlying
-category parameters are the customizable variables." ,@agent))
- '(repeat :inline t
- :tag "Variables"
- :format "%t:\n%h%v%i\n\n"
- :doc "\
-Set variables local to the group you are entering.
-
-If you want to turn threading off in `news.answers', you could put
-`(gnus-show-threads nil)' in the group parameters of that group.
-`gnus-show-threads' will be made into a local variable in the summary
-buffer you enter, and the form nil will be `eval'ed there.
-
-This can also be used as a group-specific hook function, if you'd
-like. If you want to hear a beep when you enter a group, you could
-put something like `(dummy-variable (ding))' in the parameters of that
-group. `dummy-variable' will be set to the result of the `(ding)'
-form, but who cares?"
- (list :format "%v" :value (nil nil)
- (symbol :tag "Variable")
- (sexp :tag
- "Value")))
-
- '(repeat :inline t
- :tag "Unknown entries"
- sexp))))))
- (when group
- (widget-insert "\n\nYou can also edit the ")
- (widget-create 'info-link
- :tag "select method"
- :help-echo "Push me to learn more about select methods."
- "(gnus)Select Methods")
- (widget-insert " for the group.\n")
- (setq gnus-custom-method
- (widget-create 'sexp
- :tag "Method"
- :value (gnus-info-method info))))
- (use-local-map widget-keymap)
- (widget-setup)
- (buffer-enable-undo)
- (goto-char (point-min))))
-
-(defun gnus-group-customize-done (&rest ignore)
- "Apply changes and bury the buffer."
- (interactive)
- (if gnus-custom-topic
- (gnus-topic-set-parameters gnus-custom-topic
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'params gnus-custom-group
- (widget-value gnus-custom-params))
- (gnus-group-edit-group-done 'method gnus-custom-group
- (widget-value gnus-custom-method)))
- (bury-buffer))
-
-;;; Score Customization:
-
-(defconst gnus-score-parameters
- '((mark (number :tag "Mark") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be marked as read.")
-
- (expunge (number :tag "Expunge") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be removed from
-the summary buffer.")
-
- (mark-and-expunge (number :tag "Mark-and-expunge") "\
-The value of this entry should be a number.
-Any articles with a score lower than this number will be marked as
-read and removed from the summary buffer.")
-
- (thread-mark-and-expunge (number :tag "Thread-mark-and-expunge") "\
-The value of this entry should be a number.
-All articles that belong to a thread that has a total score below this
-number will be marked as read and removed from the summary buffer.
-`gnus-thread-score-function' says how to compute the total score
-for a thread.")
-
- (files (repeat :inline t :tag "Files" file) "\
-The value of this entry should be any number of file names.
-These files are assumed to be score files as well, and will be loaded
-the same way this one was.")
-
- (exclude-files (repeat :inline t :tag "Exclude-files" file) "\
-The clue of this entry should be any number of files.
-These files will not be loaded, even though they would normally be so,
-for some reason or other.")
-
- (eval (sexp :tag "Eval" :value nil) "\
-The value of this entry will be `eval'el.
-This element will be ignored when handling global score files.")
-
- (read-only (boolean :tag "Read-only" :value t) "\
-Read-only score files will not be updated or saved.
-Global score files should feature this atom.")
-
- (orphan (number :tag "Orphan") "\
-The value of this entry should be a number.
-Articles that do not have parents will get this number added to their
-scores. Imagine you follow some high-volume newsgroup, like
-`comp.lang.c'. Most likely you will only follow a few of the threads,
-also want to see any new threads.
-
-You can do this with the following two score file entries:
-
- (orphan -500)
- (mark-and-expunge -100)
-
-When you enter the group the first time, you will only see the new
-threads. You then raise the score of the threads that you find
-interesting (with `I T' or `I S'), and ignore (`C y') the rest.
-Next time you enter the group, you will see new articles in the
-interesting threads, plus any new threads.
-
-I.e.---the orphan score atom is for high-volume groups where there
-exist a few interesting threads which can't be found automatically
-by ordinary scoring rules.")
-
- (adapt (choice :tag "Adapt"
- (const t)
- (const ignore)
- (sexp :format "%v"
- :hide-front-space t)) "\
-This entry controls the adaptive scoring.
-If it is t, the default adaptive scoring rules will be used. If it
-is `ignore', no adaptive scoring will be performed on this group. If
-it is a list, this list will be used as the adaptive scoring rules.
-If it isn't present, or is something other than t or `ignore', the
-default adaptive scoring rules will be used. If you want to use
-adaptive scoring on most groups, you'd set `gnus-use-adaptive-scoring'
-to t, and insert an `(adapt ignore)' in the groups where you do not
-want adaptive scoring. If you only want adaptive scoring in a few
-groups, you'd set `gnus-use-adaptive-scoring' to nil, and insert
-`(adapt t)' in the score files of the groups where you want it.")
-
- (adapt-file (file :tag "Adapt-file") "\
-All adaptive score entries will go to the file named by this entry.
-It will also be applied when entering the group. This atom might
-be handy if you want to adapt on several groups at once, using the
-same adaptive file for a number of groups.")
-
- (local (repeat :tag "Local"
- (group :value (nil nil)
- (symbol :tag "Variable")
- (sexp :tag "Value"))) "\
-The value of this entry should be a list of `(VAR VALUE)' pairs.
-Each VAR will be made buffer-local to the current summary buffer,
-and set to the value specified. This is a convenient, if somewhat
-strange, way of setting variables in some groups if you don't like
-hooks much.")
- (touched (sexp :format "Touched\n") "Internal variable."))
- "Alist of valid symbolic score parameters.
-
-Each entry has the form (NAME TYPE DOC), where NAME is the parameter
-itself (a symbol), TYPE is the parameters type (a sexp widget), and DOC is a
-documentation string for the parameter.")
-
-(define-widget 'gnus-score-string 'group
- "Edit score entries for string-valued headers."
- :convert-widget 'gnus-score-string-convert)
-
-(defun gnus-score-string-convert (widget)
- ;; Set args appropriately.
- (let* ((tag (widget-get widget :tag))
- (item `(const :format "" :value ,(downcase tag)))
- (match '(string :tag "Match"))
- (score '(choice :tag "Score"
- (const :tag "default" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (expire '(choice :tag "Expire"
- (const :tag "off" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (type '(choice :tag "Type"
- :value s
- ;; I should really create a forgiving :match
- ;; function for each type below, that only
- ;; looked at the first letter.
- (const :tag "Regexp" r)
- (const :tag "Regexp (fixed case)" R)
- (const :tag "Substring" s)
- (const :tag "Substring (fixed case)" S)
- (const :tag "Exact" e)
- (const :tag "Exact (fixed case)" E)
- (const :tag "Word" w)
- (const :tag "Word (fixed case)" W)
- (const :tag "default" nil)))
- (group `(group ,match ,score ,expire ,type))
- (doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
- " header.\n"))
- "
-You can have an arbitrary number of score entries for this header,
-each score entry has four elements:
-
-1. The \"match element\". This should be the string to look for in the
- header.
-
-2. The \"score element\". This number should be an integer in the
- neginf to posinf interval. This number is added to the score
- of the article if the match is successful. If this element is
- not present, the `gnus-score-interactive-default-score' number
- will be used instead. This is 1000 by default.
-
-3. The \"date element\". This date says when the last time this score
- entry matched, which provides a mechanism for expiring the
- score entries. It this element is not present, the score
- entry is permanent. The date is represented by the number of
- days since December 31, 1 ce.
-
-4. The \"type element\". This element specifies what function should
- be used to see whether this score entry matches the article.
-
- There are the regexp, as well as substring types, and exact match,
- and word match types. If this element is not present, Gnus will
- assume that substring matching should be used. There is case
- sensitive variants of all match types.")))
- (widget-put widget :args `(,item
- (repeat :inline t
- :indent 0
- :tag ,tag
- :doc ,doc
- :format "%t:\n%h%v%i\n\n"
- (choice :format "%v"
- :value ("" nil nil s)
- ,group
- sexp)))))
- widget)
-
-(define-widget 'gnus-score-integer 'group
- "Edit score entries for integer-valued headers."
- :convert-widget 'gnus-score-integer-convert)
-
-(defun gnus-score-integer-convert (widget)
- ;; Set args appropriately.
- (let* ((tag (widget-get widget :tag))
- (item `(const :format "" :value ,(downcase tag)))
- (match '(integer :tag "Match"))
- (score '(choice :tag "Score"
- (const :tag "default" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (expire '(choice :tag "Expire"
- (const :tag "off" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (type '(choice :tag "Type"
- :value <
- (const <)
- (const >)
- (const =)
- (const >=)
- (const <=)))
- (group `(group ,match ,score ,expire ,type))
- (doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
- " header.")))))
- (widget-put widget :args `(,item
- (repeat :inline t
- :indent 0
- :tag ,tag
- :doc ,doc
- :format "%t:\n%h%v%i\n\n"
- ,group))))
- widget)
-
-(define-widget 'gnus-score-date 'group
- "Edit score entries for date-valued headers."
- :convert-widget 'gnus-score-date-convert)
-
-(defun gnus-score-date-convert (widget)
- ;; Set args appropriately.
- (let* ((tag (widget-get widget :tag))
- (item `(const :format "" :value ,(downcase tag)))
- (match '(string :tag "Match"))
- (score '(choice :tag "Score"
- (const :tag "default" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (expire '(choice :tag "Expire"
- (const :tag "off" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (type '(choice :tag "Type"
- :value regexp
- (const regexp)
- (const before)
- (const at)
- (const after)))
- (group `(group ,match ,score ,expire ,type))
- (doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
- " header."))
- "
-For the Date header we have three kinda silly match types: `before',
-`at' and `after'. I can't really imagine this ever being useful, but,
-like, it would feel kinda silly not to provide this function. Just in
-case. You never know. Better safe than sorry. Once burnt, twice
-shy. Don't judge a book by its cover. Never not have sex on a first
-date. (I have been told that at least one person, and I quote,
-\"found this function indispensable\", however.)
-
-A more useful match type is `regexp'. With it, you can match the date
-string using a regular expression. The date is normalized to ISO8601
-compact format first---`YYYYMMDDTHHMMSS'. If you want to match all
-articles that have been posted on April 1st in every year, you could
-use `....0401.........' as a match string, for instance. (Note that
-the date is kept in its original time zone, so this will match
-articles that were posted when it was April 1st where the article was
-posted from. Time zones are such wholesome fun for the whole family,
-eh?")))
- (widget-put widget :args `(,item
- (repeat :inline t
- :indent 0
- :tag ,tag
- :doc ,doc
- :format "%t:\n%h%v%i\n\n"
- ,group))))
- widget)
-
-(define-widget 'gnus-score-extra 'group
- "Edit score entries for extra headers."
- :convert-widget 'gnus-score-extra-convert)
-
-(defun gnus-score-extra-convert (widget)
- ;; Set args appropriately.
- (let* ((tag (widget-get widget :tag))
- (item `(const :format "" :value ,(downcase tag)))
- (match '(string :tag "Match"))
- (score '(choice :tag "Score"
- (const :tag "default" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (expire '(choice :tag "Expire"
- (const :tag "off" nil)
- (integer :format "%v"
- :hide-front-space t)))
- (type '(choice :tag "Type"
- :value s
- ;; I should really create a forgiving :match
- ;; function for each type below, that only
- ;; looked at the first letter.
- (const :tag "Regexp" r)
- (const :tag "Regexp (fixed case)" R)
- (const :tag "Substring" s)
- (const :tag "Substring (fixed case)" S)
- (const :tag "Exact" e)
- (const :tag "Exact (fixed case)" E)
- (const :tag "Word" w)
- (const :tag "Word (fixed case)" W)
- (const :tag "default" nil)))
- (header (if gnus-extra-headers
- (let (name)
- `(choice :tag "Header"
- ,@(mapcar (lambda (h)
- (setq name (symbol-name h))
- (list 'const :tag name name))
- gnus-extra-headers)
- (string :tag "Other" :format "%v")))
- '(string :tag "Header")))
- (group `(group ,match ,score ,expire ,type ,header))
- (doc (concat (or (widget-get widget :doc)
- (concat "Change score based on the " tag
- " header.\n")))))
- (widget-put
- widget :args
- `(,item
- (repeat :inline t
- :indent 0
- :tag ,tag
- :doc ,doc
- :format "%t:\n%h%v%i\n\n"
- (choice :format "%v"
- :value ("" nil nil s
- ,(if gnus-extra-headers
- (symbol-name (car gnus-extra-headers))
- ""))
- ,group
- sexp)))))
- widget)
-
-(defvar gnus-custom-scores)
-(defvar gnus-custom-score-alist)
-
-(defun gnus-score-customize (file)
- "Customize score file FILE.
-When called interactively, FILE defaults to the current score file.
-This can be changed using the `\\[gnus-score-change-score-file]' command."
- (interactive (list gnus-current-score-file))
- (unless file
- (error "No score file for %s"
- (gnus-group-decoded-name gnus-newsgroup-name)))
- (let ((scores (gnus-score-load file))
- (types (mapcar (lambda (entry)
- `(group :format "%v%h\n"
- :doc ,(nth 2 entry)
- (const :format "" ,(nth 0 entry))
- ,(nth 1 entry)))
- gnus-score-parameters)))
- ;; Ready.
- (kill-buffer (gnus-get-buffer-create "*Gnus Customize*"))
- (switch-to-buffer (gnus-get-buffer-create "*Gnus Customize*"))
- (gnus-custom-mode)
- (make-local-variable 'gnus-custom-score-alist)
- (setq gnus-custom-score-alist scores)
- (widget-insert "Customize the ")
- (widget-create 'info-link
- :help-echo "Push me to learn more."
- :tag "score entries"
- "(gnus)Score File Format")
- (widget-insert " for\n\t")
- (widget-insert file)
- (widget-insert "\nand press ")
- (widget-create 'push-button
- :tag "done"
- :help-echo "Push me when done customizing."
- :action 'gnus-score-customize-done)
- (widget-insert ".\n
-Check the [ ] for the entries you want to apply to this score file, then
-edit the value to suit your taste. Don't forget to mark the checkbox,
-if you do all your changes will be lost. ")
- (widget-create 'push-button
- :action (lambda (&rest ignore)
- (require 'gnus-audio)
- (gnus-audio-play "Evil_Laugh.au"))
- "Bhahahah!")
- (widget-insert "\n\n")
- (make-local-variable 'gnus-custom-scores)
- (setq gnus-custom-scores
- (widget-create 'group
- :value scores
- `(checklist :inline t
- :greedy t
- (gnus-score-string :tag "From")
- (gnus-score-string :tag "Subject")
- (gnus-score-string :tag "References")
- (gnus-score-string :tag "Xref")
- (gnus-score-extra :tag "Extra")
- (gnus-score-string :tag "Message-ID")
- (gnus-score-integer :tag "Lines")
- (gnus-score-integer :tag "Chars")
- (gnus-score-date :tag "Date")
- (gnus-score-string :tag "Head"
- :doc "\
-Match all headers in the article.
-
-Using one of `Head', `Body', `All' will slow down scoring considerable.
-")
- (gnus-score-string :tag "Body"
- :doc "\
-Match the body sans header of the article.
-
-Using one of `Head', `Body', `All' will slow down scoring considerable.
-")
- (gnus-score-string :tag "All"
- :doc "\
-Match the entire article, including both headers and body.
-
-Using one of `Head', `Body', `All' will slow down scoring
-considerable.
-")
- (gnus-score-string :tag
- "Followup"
- :doc "\
-Score all followups to the specified authors.
-
-This entry is somewhat special, in that it will match the `From:'
-header, and affect the score of not only the matching articles, but
-also all followups to the matching articles. This allows you
-e.g. increase the score of followups to your own articles, or decrease
-the score of followups to the articles of some known trouble-maker.
-")
- (gnus-score-string :tag "Thread"
- :doc "\
-Add a score entry on all articles that are part of a thread.
-
-This match key works along the same lines as the `Followup' match key.
-If you say that you want to score on a (sub-)thread that is started by
-an article with a `Message-ID' X, then you add a `thread' match. This
-will add a new `thread' match for each article that has X in its
-`References' header. (These new `thread' matches will use the
-`Message-ID's of these matching articles.) This will ensure that you
-can raise/lower the score of an entire thread, even though some
-articles in the thread may not have complete `References' headers.
-Note that using this may lead to undeterministic scores of the
-articles in the thread.
-")
- ,@types)
- '(repeat :inline t
- :tag "Unknown entries"
- sexp)))
- (use-local-map widget-keymap)
- (widget-setup)))
-
-(defun gnus-score-customize-done (&rest ignore)
- "Reset the score alist with the present value."
- (let ((alist gnus-custom-score-alist)
- (value (widget-value gnus-custom-scores)))
- (setcar alist (car value))
- (setcdr alist (cdr value))
- (gnus-score-set 'touched '(t) alist))
- (bury-buffer))
-
-(eval-when-compile
- (defvar category-fields nil)
- (defvar gnus-agent-cat-name)
- (defvar gnus-agent-cat-score-file)
- (defvar gnus-agent-cat-length-when-short)
- (defvar gnus-agent-cat-length-when-long)
- (defvar gnus-agent-cat-low-score)
- (defvar gnus-agent-cat-high-score)
- (defvar gnus-agent-cat-enable-expiration)
- (defvar gnus-agent-cat-days-until-old)
- (defvar gnus-agent-cat-predicate)
- (defvar gnus-agent-cat-groups)
- (defvar gnus-agent-cat-enable-undownloaded-faces)
-)
-
-(defun gnus-trim-whitespace (s)
- (when (string-match "\\`[ \n\t]+" s)
- (setq s (substring s (match-end 0))))
- (when (string-match "[ \n\t]+\\'" s)
- (setq s (substring s 0 (match-beginning 0))))
- s)
-
-(defmacro gnus-agent-cat-prepare-category-field (parameter)
- (let* ((entry (assq parameter gnus-agent-parameters))
- (field (nth 3 entry)))
- `(let* ((type (copy-sequence
- (nth 1 (assq ',parameter gnus-agent-parameters))))
- (val (,field info))
- (deflt (if (,field defaults)
- (concat " [" (gnus-trim-whitespace
- (gnus-pp-to-string (,field defaults)))
- "]")))
- symb)
-
- (if (eq (car type) 'radio)
- (let* ((rtype (nreverse type))
- (rt rtype))
- (while (listp (or (cadr rt) 'not-list))
- (setq rt (cdr rt)))
-
- (setcdr rt (cons '(const :format "Inherit " nil) (cdr rt)))
- (setq type (nreverse rtype))))
-
- (if deflt
- (let ((tag (cdr (memq :tag type))))
- (when (string-match "\n" deflt)
- (while (progn (setq deflt (replace-match "\n " t t
- deflt))
- (string-match "\n" deflt (match-end 0))))
- (setq deflt (concat "\n" deflt)))
-
- (setcar tag (concat (car tag) deflt))))
-
- (widget-insert "\n")
-
- (setq val (if val
- (widget-create type :value val)
- (widget-create type))
- symb (set (make-local-variable ',field) val))
-
- (widget-put symb :default val)
- (widget-put symb :accessor ',field)
- (push symb category-fields))))
-
-(defun gnus-agent-customize-category (category)
- "Edit the CATEGORY."
- (interactive (list (gnus-category-name)))
- (let ((info (assq category gnus-category-alist))
- (defaults (list nil '(agent-predicate . false)
- (cons 'agent-enable-expiration
- gnus-agent-enable-expiration)
- '(agent-days-until-old . 7)
- (cons 'agent-length-when-short
- gnus-agent-short-article)
- (cons 'agent-length-when-long gnus-agent-long-article)
- (cons 'agent-low-score gnus-agent-low-score)
- (cons 'agent-high-score gnus-agent-high-score))))
-
- (let ((old (get-buffer "*Gnus Agent Category Customize*")))
- (when old
- (gnus-kill-buffer old)))
- (switch-to-buffer (gnus-get-buffer-create
- "*Gnus Agent Category Customize*"))
-
- (let ((inhibit-read-only t))
- (gnus-custom-mode)
- (buffer-disable-undo)
-
- (let* ((name (gnus-agent-cat-name info)))
- (widget-insert "Customize the Agent Category '")
- (widget-insert (symbol-name name))
- (widget-insert "' and press ")
- (widget-create
- 'push-button
- :notify
- '(lambda (&rest ignore)
- (let* ((info (assq gnus-agent-cat-name gnus-category-alist))
- (widgets category-fields))
- (while widgets
- (let* ((widget (pop widgets))
- (value (condition-case nil (widget-value widget) (error))))
- (eval `(setf (,(widget-get widget :accessor) ',info)
- ',value)))))
- (gnus-category-write)
- (gnus-kill-buffer (current-buffer))
- (when (get-buffer gnus-category-buffer)
- (switch-to-buffer (get-buffer gnus-category-buffer))
- (gnus-category-list)))
- "Done")
- (widget-insert
- "\n Note: Empty fields default to the customizable global\
- variables.\n\n")
-
- (set (make-local-variable 'gnus-agent-cat-name)
- name))
-
- (set (make-local-variable 'category-fields) nil)
- (gnus-agent-cat-prepare-category-field agent-predicate)
-
- (gnus-agent-cat-prepare-category-field agent-score)
- (gnus-agent-cat-prepare-category-field agent-short-article)
- (gnus-agent-cat-prepare-category-field agent-long-article)
- (gnus-agent-cat-prepare-category-field agent-low-score)
- (gnus-agent-cat-prepare-category-field agent-high-score)
-
- ;; The group list is NOT handled with
- ;; gnus-agent-cat-prepare-category-field as I don't want the
- ;; group list to appear when customizing a topic.
- (widget-insert "\n")
-
- (let ((symb
- (set
- (make-local-variable 'gnus-agent-cat-groups)
- (widget-create
- `(choice
- :format "%[Select Member Groups%]\n%v" :value ignore
- (const :menu-tag "do not change" :tag "" :value ignore)
- (checklist :entry-format "%b %v"
- :menu-tag "display group selectors"
- :greedy t
- :value
- ,(delq nil
- (mapcar
- (lambda (newsrc)
- (car (member
- (gnus-info-group newsrc)
- (gnus-agent-cat-groups info))))
- (cdr gnus-newsrc-alist)))
- ,@(mapcar (lambda (newsrc)
- `(const ,(gnus-info-group newsrc)))
- (cdr gnus-newsrc-alist))))))))
-
- (widget-put symb :default (gnus-agent-cat-groups info))
- (widget-put symb :accessor 'gnus-agent-cat-groups)
- (push symb category-fields))
-
- (widget-insert "\nExpiration Settings ")
-
- (gnus-agent-cat-prepare-category-field agent-enable-expiration)
- (gnus-agent-cat-prepare-category-field agent-days-until-old)
-
- (widget-insert "\nVisual Settings ")
-
- (gnus-agent-cat-prepare-category-field agent-enable-undownloaded-faces)
-
- (use-local-map widget-keymap)
- (widget-setup)
- (buffer-enable-undo))))
-
-;;; The End:
-
-(provide 'gnus-cus)
-
-;;; arch-tag: a37c285a-49bc-4235-8244-804536effeaf
-;;; gnus-cus.el ends here
+++ /dev/null
-;;; gnus-delay.el --- Delayed posting of articles
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Kai Großjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-;; Keywords: mail, news, extensions
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Provide delayed posting of articles.
-
-;;; Todo:
-
-;; * `gnus-delay-send-queue' barfs when group does not exist.
-;; * Integrate gnus-delay.el into the rest of Gnus automatically. How
-;; should this be done? Basically, we need to do what
-;; `gnus-delay-initialize' does. But in which files?
-
-;;; Code:
-
-(require 'nndraft)
-(require 'gnus-draft)
-(autoload 'parse-time-string "parse-time" nil nil)
-
-(defgroup gnus-delay nil
- "Arrange for sending postings later."
- :version "22.1"
- :group 'gnus)
-
-(defcustom gnus-delay-group "delayed"
- "Group name for storing delayed articles."
- :type 'string
- :group 'gnus-delay)
-
-(defcustom gnus-delay-header "X-Gnus-Delayed"
- "Header name for storing info about delayed articles."
- :type 'string
- :group 'gnus-delay)
-
-(defcustom gnus-delay-default-delay "3d"
- "*Default length of delay."
- :type 'string
- :group 'gnus-delay)
-
-(defcustom gnus-delay-default-hour 8
- "*If deadline is given as date, then assume this time of day."
- :version "22.1"
- :type 'integer
- :group 'gnus-delay)
-
-;;;###autoload
-(defun gnus-delay-article (delay)
- "Delay this article by some time.
-DELAY is a string, giving the length of the time. Possible values are:
-
-* <digits><units> for <units> in minutes (`m'), hours (`h'), days (`d'),
- weeks (`w'), months (`M'), or years (`Y');
-
-* YYYY-MM-DD for a specific date. The time of day is given by the
- variable `gnus-delay-default-hour', minute and second are zero.
-
-* hh:mm for a specific time. Use 24h format. If it is later than this
- time, then the deadline is tomorrow, else today."
- (interactive
- (list (read-string
- "Target date (YYYY-MM-DD) or length of delay (units in [mhdwMY]): "
- gnus-delay-default-delay)))
- (let (num unit days year month day hour minute deadline)
- (cond ((string-match
- "\\([0-9][0-9][0-9]?[0-9]?\\)-\\([0-9]+\\)-\\([0-9]+\\)"
- delay)
- (setq year (string-to-number (match-string 1 delay))
- month (string-to-number (match-string 2 delay))
- day (string-to-number (match-string 3 delay)))
- (setq deadline
- (message-make-date
- (encode-time 0 0 ; second and minute
- gnus-delay-default-hour
- day month year))))
- ((string-match "\\([0-9]+\\):\\([0-9]+\\)" delay)
- (setq hour (string-to-number (match-string 1 delay))
- minute (string-to-number (match-string 2 delay)))
- ;; Use current time, except...
- (setq deadline (apply 'vector (decode-time (current-time))))
- ;; ... for minute and hour.
- (aset deadline 1 minute)
- (aset deadline 2 hour)
- ;; Convert to seconds.
- (setq deadline (time-to-seconds (apply 'encode-time
- (append deadline nil))))
- ;; If this time has passed already, add a day.
- (when (< deadline (time-to-seconds (current-time)))
- (setq deadline (+ 3600 deadline))) ;3600 secs/day
- ;; Convert seconds to date header.
- (setq deadline (message-make-date
- (seconds-to-time deadline))))
- ((string-match "\\([0-9]+\\)\\s-*\\([mhdwMY]\\)" delay)
- (setq num (match-string 1 delay))
- (setq unit (match-string 2 delay))
- ;; Start from seconds, then multiply into needed units.
- (setq num (string-to-number num))
- (cond ((string= unit "Y")
- (setq delay (* num 60 60 24 365)))
- ((string= unit "M")
- (setq delay (* num 60 60 24 30)))
- ((string= unit "w")
- (setq delay (* num 60 60 24 7)))
- ((string= unit "d")
- (setq delay (* num 60 60 24)))
- ((string= unit "h")
- (setq delay (* num 60 60)))
- (t
- (setq delay (* num 60))))
- (setq deadline (message-make-date
- (seconds-to-time (+ (time-to-seconds (current-time))
- delay)))))
- (t (error "Malformed delay `%s'" delay)))
- (message-add-header (format "%s: %s" gnus-delay-header deadline)))
- (set-buffer-modified-p t)
- ;; If group does not exist, create it.
- (let ((group (format "nndraft:%s" gnus-delay-group)))
- (gnus-agent-queue-setup gnus-delay-group))
- (message-disassociate-draft)
- (nndraft-request-associate-buffer gnus-delay-group)
- (save-buffer 0)
- (kill-buffer (current-buffer))
- (message-do-actions message-postpone-actions))
-
-;;;###autoload
-(defun gnus-delay-send-queue ()
- "Send all the delayed messages that are due now."
- (interactive)
- (save-excursion
- (let* ((group (format "nndraft:%s" gnus-delay-group))
- (message-send-hook (copy-sequence message-send-hook))
- articles
- article deadline)
- (when (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-activate-group group)
- (add-hook 'message-send-hook
- '(lambda ()
- (message-remove-header gnus-delay-header)))
- (setq articles (nndraft-articles))
- (while (setq article (pop articles))
- (gnus-request-head article group)
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote gnus-delay-header) ":\\s-+")
- nil t)
- (progn
- (setq deadline (nnheader-header-value))
- (setq deadline (apply 'encode-time
- (parse-time-string deadline)))
- (setq deadline (time-since deadline))
- (when (and (>= (nth 0 deadline) 0)
- (>= (nth 1 deadline) 0))
- (message "Sending delayed article %d" article)
- (gnus-draft-send article group)
- (message "Sending delayed article %d...done" article)))
- (message "Delay header missing for article %d" article)))))))
-
-;;;###autoload
-(defun gnus-delay-initialize (&optional no-keymap no-check)
- "Initialize the gnus-delay package.
-This sets up a key binding in `message-mode' to delay a message.
-This tells Gnus to look for delayed messages after getting new news.
-
-The optional arg NO-KEYMAP is ignored.
-Checking delayed messages is skipped if optional arg NO-CHECK is non-nil."
- (unless no-check
- (add-hook 'gnus-get-new-news-hook 'gnus-delay-send-queue)))
-
-(provide 'gnus-delay)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: fb2ad634-a897-4142-a503-f5991ec2349d
-;;; gnus-delay.el ends here
+++ /dev/null
-;;; gnus-demon.el --- daemonic Gnus behaviour
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-int)
-(require 'nnheader)
-(require 'nntp)
-(require 'nnmail)
-(require 'gnus-util)
-(eval-and-compile
- (if (featurep 'xemacs)
- (require 'itimer)
- (require 'timer)))
-
-(autoload 'parse-time-string "parse-time" nil nil)
-
-(defgroup gnus-demon nil
- "Demonic behavior."
- :group 'gnus)
-
-(defcustom gnus-demon-handlers nil
- "Alist of daemonic handlers to be run at intervals.
-Each handler is a list on the form
-
-\(FUNCTION TIME IDLE)
-
-FUNCTION is the function to be called.
-TIME is the number of `gnus-demon-timestep's between each call.
-If nil, never call. If t, call each `gnus-demon-timestep'.
-If IDLE is t, only call if Emacs has been idle for a while. If IDLE
-is a number, only call when Emacs has been idle more than this number
-of `gnus-demon-timestep's. If IDLE is nil, don't care about
-idleness. If IDLE is a number and TIME is nil, then call once each
-time Emacs has been idle for IDLE `gnus-demon-timestep's."
- :group 'gnus-demon
- :type '(repeat (list function
- (choice :tag "Time"
- (const :tag "never" nil)
- (const :tag "one" t)
- (integer :tag "steps" 1))
- (choice :tag "Idle"
- (const :tag "don't care" nil)
- (const :tag "for a while" t)
- (integer :tag "steps" 1)))))
-
-(defcustom gnus-demon-timestep 60
- "*Number of seconds in each demon timestep."
- :group 'gnus-demon
- :type 'integer)
-
-;;; Internal variables.
-
-(defvar gnus-demon-timer nil)
-(defvar gnus-demon-idle-has-been-called nil)
-(defvar gnus-demon-idle-time 0)
-(defvar gnus-demon-handler-state nil)
-(defvar gnus-demon-last-keys nil)
-(defvar gnus-inhibit-demon nil
- "*If non-nil, no daemonic function will be run.")
-
-;;; Functions.
-
-(defun gnus-demon-add-handler (function time idle)
- "Add the handler FUNCTION to be run at TIME and IDLE."
- ;; First remove any old handlers that use this function.
- (gnus-demon-remove-handler function)
- ;; Then add the new one.
- (push (list function time idle) gnus-demon-handlers)
- (gnus-demon-init))
-
-(defun gnus-demon-remove-handler (function &optional no-init)
- "Remove the handler FUNCTION from the list of handlers."
- (gnus-pull function gnus-demon-handlers)
- (unless no-init
- (gnus-demon-init)))
-
-(defun gnus-demon-init ()
- "Initialize the Gnus daemon."
- (interactive)
- (gnus-demon-cancel)
- (when gnus-demon-handlers
- ;; Set up the timer.
- (setq gnus-demon-timer
- (nnheader-run-at-time
- gnus-demon-timestep gnus-demon-timestep 'gnus-demon))
- ;; Reset control variables.
- (setq gnus-demon-handler-state
- (mapcar
- (lambda (handler)
- (list (car handler) (gnus-demon-time-to-step (nth 1 handler))
- (nth 2 handler)))
- gnus-demon-handlers))
- (setq gnus-demon-idle-time 0)
- (setq gnus-demon-idle-has-been-called nil)))
-
-(gnus-add-shutdown 'gnus-demon-cancel 'gnus)
-
-(defun gnus-demon-cancel ()
- "Cancel any Gnus daemons."
- (interactive)
- (when gnus-demon-timer
- (nnheader-cancel-timer gnus-demon-timer))
- (setq gnus-demon-timer nil
- gnus-demon-idle-has-been-called nil)
- (condition-case ()
- (nnheader-cancel-function-timers 'gnus-demon)
- (error t)))
-
-(defun gnus-demon-is-idle-p ()
- "Whether Emacs is idle or not."
- ;; We do this simply by comparing the 100 most recent keystrokes
- ;; with the ones we had last time. If they are the same, one might
- ;; guess that Emacs is indeed idle. This only makes sense if one
- ;; calls this function seldom -- like once a minute, which is what
- ;; we do here.
- (let ((keys (recent-keys)))
- (or (equal keys gnus-demon-last-keys)
- (progn
- (setq gnus-demon-last-keys keys)
- nil))))
-
-(defun gnus-demon-time-to-step (time)
- "Find out how many seconds to TIME, which is on the form \"17:43\"."
- (if (not (stringp time))
- time
- (let* ((now (current-time))
- ;; obtain NOW as discrete components -- make a vector for speed
- (nowParts (decode-time now))
- ;; obtain THEN as discrete components
- (thenParts (parse-time-string time))
- (thenHour (elt thenParts 2))
- (thenMin (elt thenParts 1))
- ;; convert time as elements into number of seconds since EPOCH.
- (then (encode-time 0
- thenMin
- thenHour
- ;; If THEN is earlier than NOW, make it
- ;; same time tomorrow. Doc for encode-time
- ;; says that this is OK.
- (+ (elt nowParts 3)
- (if (or (< thenHour (elt nowParts 2))
- (and (= thenHour (elt nowParts 2))
- (<= thenMin (elt nowParts 1))))
- 1 0))
- (elt nowParts 4)
- (elt nowParts 5)
- (elt nowParts 6)
- (elt nowParts 7)
- (elt nowParts 8)))
- ;; calculate number of seconds between NOW and THEN
- (diff (+ (* 65536 (- (car then) (car now)))
- (- (cadr then) (cadr now)))))
- ;; return number of timesteps in the number of seconds
- (round (/ diff gnus-demon-timestep)))))
-
-(defun gnus-demon ()
- "The Gnus daemon that takes care of running all Gnus handlers."
- ;; Increase or reset the time Emacs has been idle.
- (if (gnus-demon-is-idle-p)
- (incf gnus-demon-idle-time)
- (setq gnus-demon-idle-time 0)
- (setq gnus-demon-idle-has-been-called nil))
- ;; Disable all daemonic stuff if we're in the minibuffer
- (when (and (not (window-minibuffer-p (selected-window)))
- (not gnus-inhibit-demon))
- ;; Then we go through all the handler and call those that are
- ;; sufficiently ripe.
- (let ((handlers gnus-demon-handler-state)
- (gnus-inhibit-demon t)
- ;; Try to avoid dialog boxes, e.g. by Mailcrypt.
- ;; Unfortunately, Emacs 20's `message-or-box...' doesn't
- ;; obey `use-dialog-box'.
- use-dialog-box (last-nonmenu-event 10)
- handler time idle)
- (while handlers
- (setq handler (pop handlers))
- (cond
- ((numberp (setq time (nth 1 handler)))
- ;; These handlers use a regular timeout mechanism. We decrease
- ;; the timer if it hasn't reached zero yet.
- (unless (zerop time)
- (setcar (nthcdr 1 handler) (decf time)))
- (and (zerop time) ; If the timer now is zero...
- ;; Test for appropriate idleness
- (progn
- (setq idle (nth 2 handler))
- (cond
- ((null idle) t) ; Don't care about idle.
- ((numberp idle) ; Numerical idle...
- (< idle gnus-demon-idle-time)) ; Idle timed out.
- (t (< 0 gnus-demon-idle-time)))) ; Or just need to be idle.
- ;; So we call the handler.
- (gnus-with-local-quit
- (ignore-errors (funcall (car handler)))
- ;; And reset the timer.
- (setcar (nthcdr 1 handler)
- (gnus-demon-time-to-step
- (nth 1 (assq (car handler) gnus-demon-handlers)))))))
- ;; These are only supposed to be called when Emacs is idle.
- ((null (setq idle (nth 2 handler)))
- ;; We do nothing.
- )
- ((and (not (numberp idle))
- (gnus-demon-is-idle-p))
- ;; We want to call this handler each and every time that
- ;; Emacs is idle.
- (gnus-with-local-quit
- (ignore-errors (funcall (car handler)))))
- (t
- ;; We want to call this handler only if Emacs has been idle
- ;; for a specified number of timesteps.
- (and (not (memq (car handler) gnus-demon-idle-has-been-called))
- (< idle gnus-demon-idle-time)
- (gnus-demon-is-idle-p)
- (gnus-with-local-quit
- (ignore-errors (funcall (car handler)))
- ;; Make sure the handler won't be called once more in
- ;; this idle-cycle.
- (push (car handler) gnus-demon-idle-has-been-called)))))))))
-
-(defun gnus-demon-add-nocem ()
- "Add daemonic NoCeM handling to Gnus."
- (gnus-demon-add-handler 'gnus-demon-scan-nocem 60 30))
-
-(defun gnus-demon-scan-nocem ()
- "Scan NoCeM groups for NoCeM messages."
- (save-window-excursion
- (gnus-nocem-scan-groups)))
-
-(defun gnus-demon-add-disconnection ()
- "Add daemonic server disconnection to Gnus."
- (gnus-demon-add-handler 'gnus-demon-close-connections nil 30))
-
-(defun gnus-demon-close-connections ()
- (save-window-excursion
- (gnus-close-backends)))
-
-(defun gnus-demon-add-nntp-close-connection ()
- "Add daemonic nntp server disconnection to Gnus.
-If no commands have gone out via nntp during the last five
-minutes, the connection is closed."
- (gnus-demon-add-handler 'gnus-demon-nntp-close-connections 5 nil))
-
-(defun gnus-demon-nntp-close-connection ()
- (save-window-excursion
- (when (time-less-p '(0 300) (time-since nntp-last-command-time))
- (nntp-close-server))))
-
-(defun gnus-demon-add-scanmail ()
- "Add daemonic scanning of mail from the mail backends."
- (gnus-demon-add-handler 'gnus-demon-scan-mail 120 60))
-
-(defun gnus-demon-scan-mail ()
- (save-window-excursion
- (let ((servers gnus-opened-servers)
- server
- (nnmail-fetched-sources (list t)))
- (while (setq server (car (pop servers)))
- (and (gnus-check-backend-function 'request-scan (car server))
- (or (gnus-server-opened server)
- (gnus-open-server server))
- (gnus-request-scan nil server))))))
-
-(defun gnus-demon-add-rescan ()
- "Add daemonic scanning of new articles from all backends."
- (gnus-demon-add-handler 'gnus-demon-scan-news 120 60))
-
-(defun gnus-demon-scan-news ()
- (let ((win (current-window-configuration)))
- (unwind-protect
- (save-window-excursion
- (save-excursion
- (when (gnus-alive-p)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-get-new-news)))))
- (set-window-configuration win))))
-
-(defun gnus-demon-add-scan-timestamps ()
- "Add daemonic updating of timestamps in empty newgroups."
- (gnus-demon-add-handler 'gnus-demon-scan-timestamps nil 30))
-
-(defun gnus-demon-scan-timestamps ()
- "Set the timestamp on all newsgroups with no unread and no ticked articles."
- (when (gnus-alive-p)
- (let ((cur-time (current-time))
- (newsrc (cdr gnus-newsrc-alist))
- info group unread has-ticked)
- (while (setq info (pop newsrc))
- (setq group (gnus-info-group info)
- unread (gnus-group-unread group)
- has-ticked (cdr (assq 'tick (gnus-info-marks info))))
- (when (and (numberp unread)
- (= unread 0)
- (not has-ticked))
- (gnus-group-set-parameter group 'timestamp cur-time))))))
-
-(provide 'gnus-demon)
-
-;;; arch-tag: 8dd5cd3d-6ae4-46b4-9b15-f5fca09fd392
-;;; gnus-demon.el ends here
+++ /dev/null
-;;; gnus-diary.el --- Wrapper around the NNDiary Gnus back end
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Didier Verna <didier@xemacs.org>
-;; Maintainer: Didier Verna <didier@xemacs.org>
-;; Created: Tue Jul 20 10:42:55 1999
-;; Keywords: calendar mail 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-
-;;; Commentary:
-
-;; Contents management by FCM version 0.1.
-
-;; Description:
-;; ===========
-
-;; gnus-diary is a utility toolkit used on top of the nndiary back end. It is
-;; now fully documented in the Gnus manual.
-
-
-;; Bugs / Todo:
-;; ===========
-
-
-;;; Code:
-
-(require 'nndiary)
-(require 'message)
-(require 'gnus-art)
-
-(defgroup gnus-diary nil
- "Utilities on top of the nndiary back end for Gnus."
- :version "22.1"
- :group 'gnus)
-
-(defcustom gnus-diary-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n"
- "*Summary line format for nndiary groups."
- :type 'string
- :group 'gnus-diary
- :group 'gnus-summary-format)
-
-(defcustom gnus-diary-time-format "%a, %b %e %y, %H:%M"
- "*Time format to display appointments in nndiary summary buffers.
-Please refer to `format-time-string' for information on possible values."
- :type 'string
- :group 'gnus-diary)
-
-(defcustom gnus-diary-delay-format-function 'gnus-diary-delay-format-english
- "*Function called to format a diary delay string.
-It is passed two arguments. The first one is non-nil if the delay is in
-the past. The second one is of the form ((NUM . UNIT) ...) where NUM is
-an integer and UNIT is one of 'year 'month 'week 'day 'hour or 'minute.
-It should return strings like \"In 2 months, 3 weeks\", \"3 hours,
-1 minute ago\" and so on.
-
-There are currently two built-in format functions:
-`gnus-diary-delay-format-english' (the default)
-`gnus-diary-delay-format-french'"
- :type '(choice (const :tag "english" gnus-diary-delay-format-english)
- (const :tag "french" gnus-diary-delay-format-french)
- (symbol :tag "other"))
- :group 'gnus-diary)
-
-(defconst gnus-diary-version nndiary-version
- "Current Diary back end version.")
-
-
-;; Compatibility functions ==================================================
-
-(eval-and-compile
- (if (fboundp 'kill-entire-line)
- (defalias 'gnus-diary-kill-entire-line 'kill-entire-line)
- (defun gnus-diary-kill-entire-line ()
- (beginning-of-line)
- (let ((kill-whole-line t))
- (kill-line)))))
-
-
-;; Summary line format ======================================================
-
-(defun gnus-diary-delay-format-french (past delay)
- (if (null delay)
- "maintenant!"
- ;; Keep only a precision of two degrees
- (and (> (length delay) 1) (setcdr (cdr delay) nil))
- (concat (if past "il y a " "dans ")
- (let ((str "")
- del)
- (while (setq del (pop delay))
- (setq str (concat str
- (int-to-string (car del)) " "
- (cond ((eq (cdr del) 'year)
- "an")
- ((eq (cdr del) 'month)
- "mois")
- ((eq (cdr del) 'week)
- "semaine")
- ((eq (cdr del) 'day)
- "jour")
- ((eq (cdr del) 'hour)
- "heure")
- ((eq (cdr del) 'minute)
- "minute"))
- (unless (or (eq (cdr del) 'month)
- (= (car del) 1))
- "s")
- (if delay ", "))))
- str))))
-
-
-(defun gnus-diary-delay-format-english (past delay)
- (if (null delay)
- "now!"
- ;; Keep only a precision of two degrees
- (and (> (length delay) 1) (setcdr (cdr delay) nil))
- (concat (unless past "in ")
- (let ((str "")
- del)
- (while (setq del (pop delay))
- (setq str (concat str
- (int-to-string (car del)) " "
- (symbol-name (cdr del))
- (and (> (car del) 1) "s")
- (if delay ", "))))
- str)
- (and past " ago"))))
-
-
-(defun gnus-diary-header-schedule (headers)
- ;; Same as `nndiary-schedule', but given a set of headers HEADERS
- (mapcar
- (lambda (elt)
- (let ((head (cdr (assoc (intern (format "X-Diary-%s" (car elt)))
- headers))))
- (when head
- (nndiary-parse-schedule-value head (cadr elt) (car (cddr elt))))))
- nndiary-headers))
-
-;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
-;; message, with all fields set to nil here. I don't know what it is for, and
-;; I just ignore it.
-;;;###autoload
-(defun gnus-user-format-function-d (header)
- ;; Returns an aproximative delay string for the next occurence of this
- ;; message. The delay is given only in the first non zero unit.
- ;; Code partly stolen from article-make-date-line
- (let* ((extras (mail-header-extra header))
- (sched (gnus-diary-header-schedule extras))
- (occur (nndiary-next-occurence sched (current-time)))
- (now (current-time))
- (real-time (subtract-time occur now)))
- (if (null real-time)
- "?????"
- (let* ((sec (+ (* (float (car real-time)) 65536) (cadr real-time)))
- (past (< sec 0))
- delay)
- (and past (setq sec (- sec)))
- (unless (zerop sec)
- ;; This is a bit convoluted, but basically we go through the time
- ;; units for years, weeks, etc, and divide things to see whether
- ;; that results in positive answers.
- (let ((units `((year . ,(* 365.25 24 3600))
- (month . ,(* 31 24 3600))
- (week . ,(* 7 24 3600))
- (day . ,(* 24 3600))
- (hour . 3600)
- (minute . 60)))
- unit num)
- (while (setq unit (pop units))
- (unless (zerop (setq num (ffloor (/ sec (cdr unit)))))
- (setq delay (append delay `((,(floor num) . ,(car unit))))))
- (setq sec (- sec (* num (cdr unit)))))))
- (funcall gnus-diary-delay-format-function past delay)))
- ))
-
-;; #### NOTE: Gnus sometimes gives me a HEADER not corresponding to any
-;; message, with all fields set to nil here. I don't know what it is for, and
-;; I just ignore it.
-;;;###autoload
-(defun gnus-user-format-function-D (header)
- ;; Returns a formatted time string for the next occurence of this message.
- (let* ((extras (mail-header-extra header))
- (sched (gnus-diary-header-schedule extras))
- (occur (nndiary-next-occurence sched (current-time))))
- (format-time-string gnus-diary-time-format occur)))
-
-
-;; Article sorting functions ================================================
-
-(defun gnus-article-sort-by-schedule (h1 h2)
- (let* ((now (current-time))
- (e1 (mail-header-extra h1))
- (e2 (mail-header-extra h2))
- (s1 (gnus-diary-header-schedule e1))
- (s2 (gnus-diary-header-schedule e2))
- (o1 (nndiary-next-occurence s1 now))
- (o2 (nndiary-next-occurence s2 now)))
- (if (and (= (car o1) (car o2)) (= (cadr o1) (cadr o2)))
- (< (mail-header-number h1) (mail-header-number h2))
- (time-less-p o1 o2))))
-
-
-(defun gnus-thread-sort-by-schedule (h1 h2)
- (gnus-article-sort-by-schedule (gnus-thread-header h1)
- (gnus-thread-header h2)))
-
-(defun gnus-summary-sort-by-schedule (&optional reverse)
- "Sort nndiary summary buffers by schedule of appointments.
-Optional prefix (or REVERSE argument) means sort in reverse order."
- (interactive "P")
- (gnus-summary-sort 'schedule reverse))
-
-(defvar gnus-summary-misc-menu) ;; Avoid byte compiler warning.
-(add-hook 'gnus-summary-menu-hook
- (lambda ()
- (easy-menu-add-item gnus-summary-misc-menu
- '("Sort")
- ["Sort by schedule"
- gnus-summary-sort-by-schedule
- (eq (car (gnus-find-method-for-group
- gnus-newsgroup-name))
- 'nndiary)]
- "Sort by number")))
-
-
-
-;; Group parameters autosetting =============================================
-
-(defun gnus-diary-update-group-parameters (group)
- ;; Ensure that nndiary groups have convenient group parameters:
- ;; - a posting style containing X-Diary headers
- ;; - a nice summary line format
- ;; - NNDiary specific sorting by schedule functions
- ;; In general, try not to mess with what the user might have modified.
- (let ((posting-style (gnus-group-get-parameter group 'posting-style t)))
- ;; Posting style:
- (mapcar (lambda (elt)
- (let ((header (format "X-Diary-%s" (car elt))))
- (unless (assoc header posting-style)
- (setq posting-style (append posting-style
- `((,header "*")))))
- ))
- nndiary-headers)
- (gnus-group-set-parameter group 'posting-style posting-style)
- ;; Summary line format:
- (unless (gnus-group-get-parameter group 'gnus-summary-line-format t)
- (gnus-group-set-parameter group 'gnus-summary-line-format
- `(,gnus-diary-summary-line-format)))
- ;; Sorting by schedule:
- (unless (gnus-group-get-parameter group 'gnus-article-sort-functions)
- (gnus-group-set-parameter group 'gnus-article-sort-functions
- '((append gnus-article-sort-functions
- (list
- 'gnus-article-sort-by-schedule)))))
- (unless (gnus-group-get-parameter group 'gnus-thread-sort-functions)
- (gnus-group-set-parameter group 'gnus-thread-sort-functions
- '((append gnus-thread-sort-functions
- (list
- 'gnus-thread-sort-by-schedule)))))
- ))
-
-;; Called when a group is subscribed. This is needed because groups created
-;; because of mail splitting are *not* created with the back end function.
-;; Thus, `nndiary-request-create-group-hooks' is inoperative.
-(defun gnus-diary-maybe-update-group-parameters (group)
- (when (eq (car (gnus-find-method-for-group group)) 'nndiary)
- (gnus-diary-update-group-parameters group)))
-
-(add-hook 'nndiary-request-create-group-hooks
- 'gnus-diary-update-group-parameters)
-;; Now that we have `gnus-subscribe-newsgroup-hooks', this is not needed
-;; anymore. Maybe I should remove this completely.
-(add-hook 'nndiary-request-update-info-hooks
- 'gnus-diary-update-group-parameters)
-(add-hook 'gnus-subscribe-newsgroup-hooks
- 'gnus-diary-maybe-update-group-parameters)
-
-
-;; Diary Message Checking ===================================================
-
-(defvar gnus-diary-header-value-history nil
- ;; History variable for header value prompting
- )
-
-(defun gnus-diary-narrow-to-headers ()
- "Narrow the current buffer to the header part.
-Point is left at the beginning of the region.
-The buffer is assumed to contain a message, but the format is unknown."
- (cond ((eq major-mode 'message-mode)
- (message-narrow-to-headers))
- (t
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (narrow-to-region (point-min) (- (point) 1))
- (goto-char (point-min))))
- ))
-
-(defun gnus-diary-add-header (str)
- "Add a header to the current buffer.
-The buffer is assumed to contain a message, but the format is unknown."
- (cond ((eq major-mode 'message-mode)
- (message-add-header str))
- (t
- (save-restriction
- (gnus-diary-narrow-to-headers)
- (goto-char (point-max))
- (if (string-match "\n$" str)
- (insert str)
- (insert str ?\n))))
- ))
-
-(defun gnus-diary-check-message (arg)
- "Ensure that the current message is a valid for NNDiary.
-This function checks that all NNDiary required headers are present and
-valid, and prompts for values / correction otherwise.
-
-If ARG (or prefix) is non-nil, force prompting for all fields."
- (interactive "P")
- (save-excursion
- (mapcar
- (lambda (head)
- (let ((header (concat "X-Diary-" (car head)))
- (ask arg)
- value invalid)
- ;; First, try to find the header, and checks for validity:
- (save-restriction
- (gnus-diary-narrow-to-headers)
- (when (re-search-forward (concat "^" header ":") nil t)
- (unless (eq (char-after) ? )
- (insert " "))
- (setq value (buffer-substring (point) (gnus-point-at-eol)))
- (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" value)
- (setq value (match-string 1 value)))
- (condition-case ()
- (nndiary-parse-schedule-value value
- (nth 1 head) (nth 2 head))
- (t
- (setq invalid t)))
- ;; #### NOTE: this (along with the `gnus-diary-add-header'
- ;; function) could be rewritten in a better way, in particular
- ;; not to blindly remove an already present header and reinsert
- ;; it somewhere else afterwards.
- (when (or ask invalid)
- (gnus-diary-kill-entire-line))
- ))
- ;; Now, loop until a valid value is provided:
- (while (or ask (not value) invalid)
- (let ((prompt (concat (and invalid
- (prog1 "(current value invalid) "
- (beep)))
- header ": ")))
- (setq value
- (if (listp (nth 1 head))
- (completing-read prompt (cons '("*" nil) (nth 1 head))
- nil t value
- gnus-diary-header-value-history)
- (read-string prompt value
- gnus-diary-header-value-history))))
- (setq ask nil)
- (setq invalid nil)
- (condition-case ()
- (nndiary-parse-schedule-value value
- (nth 1 head) (nth 2 head))
- (t
- (setq invalid t))))
- (gnus-diary-add-header (concat header ": " value))
- ))
- nndiary-headers)
- ))
-
-(add-hook 'nndiary-request-accept-article-hooks
- (lambda () (gnus-diary-check-message nil)))
-
-(define-key message-mode-map "\C-cDc" 'gnus-diary-check-message)
-(define-key gnus-article-edit-mode-map "\C-cDc" 'gnus-diary-check-message)
-
-
-;; The end ==================================================================
-
-(defun gnus-diary-version ()
- "Current Diary back end version."
- (interactive)
- (message "NNDiary version %s" nndiary-version))
-
-(define-key message-mode-map "\C-cDv" 'gnus-diary-version)
-(define-key gnus-article-edit-mode-map "\C-cDv" 'gnus-diary-version)
-
-
-(provide 'gnus-diary)
-
-;;; arch-tag: 98467e70-337e-4ddc-b92d-45d403ff1b4b
-;;; gnus-diary.el ends here
+++ /dev/null
-;;; gnus-dired.el --- utility functions where gnus and dired meet
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Authors: Benjamin Rutt <brutt@bloomington.in.us>,
-;; Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: mail, news, extensions
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package provides utility functions for intersections of gnus
-;; and dired. To enable the gnus-dired-mode minor mode which will
-;; have the effect of installing keybindings in dired-mode, place the
-;; following in your ~/.gnus:
-
-;; (require 'gnus-dired) ;, isn't needed due to autoload cookies
-;; (add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
-
-;; Note that if you visit dired buffers before your ~/.gnus file has
-;; been read, those dired buffers won't have the keybindings in
-;; effect. To get around that problem, you may want to add the above
-;; statements to your ~/.emacs instead.
-
-;;; Code:
-
-(require 'dired)
-(require 'gnus-ems)
-(require 'gnus-msg)
-(require 'gnus-util)
-(require 'message)
-(require 'mm-encode)
-(require 'mml)
-
-(defvar gnus-dired-mode nil
- "Minor mode for intersections of gnus and dired.")
-
-(defvar gnus-dired-mode-map nil)
-
-(unless gnus-dired-mode-map
- (setq gnus-dired-mode-map (make-sparse-keymap))
-
- (gnus-define-keys gnus-dired-mode-map
- "\C-c\C-m\C-a" gnus-dired-attach
- "\C-c\C-m\C-l" gnus-dired-find-file-mailcap
- "\C-c\C-m\C-p" gnus-dired-print))
-
-(defun gnus-dired-mode (&optional arg)
- "Minor mode for intersections of gnus and dired.
-
-\\{gnus-dired-mode-map}"
- (interactive "P")
- (when (eq major-mode 'dired-mode)
- (set (make-local-variable 'gnus-dired-mode)
- (if (null arg) (not gnus-dired-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-dired-mode
- (gnus-add-minor-mode 'gnus-dired-mode "" gnus-dired-mode-map)
- (gnus-run-hooks 'gnus-dired-mode-hook))))
-
-;;;###autoload
-(defun turn-on-gnus-dired-mode ()
- "Convenience method to turn on gnus-dired-mode."
- (gnus-dired-mode 1))
-
-;; Method to attach files to a gnus composition.
-(defun gnus-dired-attach (files-to-attach)
- "Attach dired's marked files to a gnus message composition.
-If called non-interactively, FILES-TO-ATTACH should be a list of
-filenames."
- (interactive
- (list
- (delq nil
- (mapcar
- ;; don't attach directories
- (lambda (f) (if (file-directory-p f) nil f))
- (nreverse (dired-map-over-marks (dired-get-filename) nil))))))
- (let ((destination nil)
- (files-str nil)
- (bufs nil))
- ;; warn if user tries to attach without any files marked
- (if (null files-to-attach)
- (error "No files to attach")
- (setq files-str
- (mapconcat
- (lambda (f) (file-name-nondirectory f))
- files-to-attach ", "))
- (setq bufs (message-buffers))
-
- ;; set up destination message buffer
- (if (and bufs
- (y-or-n-p "Attach files to existing message buffer? "))
- (setq destination
- (if (= (length bufs) 1)
- (get-buffer (car bufs))
- (completing-read "Attach to which message buffer: "
- (mapcar
- (lambda (b)
- (cons b (get-buffer b)))
- bufs)
- nil t)))
- ;; setup a new gnus message buffer
- (gnus-setup-message 'message (message-mail))
- (setq destination (current-buffer)))
-
- ;; set buffer to destination buffer, and attach files
- (set-buffer destination)
- (goto-char (point-max)) ;attach at end of buffer
- (while files-to-attach
- (mml-attach-file (car files-to-attach)
- (or (mm-default-file-encoding (car files-to-attach))
- "application/octet-stream") nil)
- (setq files-to-attach (cdr files-to-attach)))
- (message "Attached file(s) %s" files-str))))
-
-(autoload 'mailcap-parse-mailcaps "mailcap" "" t)
-
-(defun gnus-dired-find-file-mailcap (&optional file-name arg)
- "In dired, visit FILE-NAME according to the mailcap file.
-If ARG is non-nil, open it in a new buffer."
- (interactive (list
- (file-name-sans-versions (dired-get-filename) t)
- current-prefix-arg))
- (mailcap-parse-mailcaps)
- (if (file-exists-p file-name)
- (let (mime-type method)
- (if (and (not arg)
- (not (file-directory-p file-name))
- (string-match "\\.[^\\.]+$" file-name)
- (setq mime-type
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- (stringp
- (setq method
- (cdr (assoc 'viewer
- (car (mailcap-mime-info mime-type
- 'all)))))))
- (let ((view-command (mm-mailcap-command method file-name nil)))
- (message "viewing via %s" view-command)
- (start-process "*display*"
- nil
- shell-file-name
- shell-command-switch
- view-command))
- (find-file file-name)))
- (if (file-symlink-p file-name)
- (error "File is a symlink to a nonexistent target")
- (error "File no longer exists; type `g' to update Dired buffer"))))
-
-(defun gnus-dired-print (&optional file-name print-to)
- "In dired, print FILE-NAME according to the mailcap file.
-
-If there is no print command, print in a PostScript image. If the
-optional argument PRINT-TO is nil, send the image to the printer. If
-PRINT-TO is a string, save the PostScript image in a file with that
-name. If PRINT-TO is a number, prompt the user for the name of the
-file to save in."
- (interactive (list
- (file-name-sans-versions (dired-get-filename) t)
- (ps-print-preprint current-prefix-arg)))
- (mailcap-parse-mailcaps)
- (cond
- ((file-directory-p file-name)
- (error "Can't print a directory"))
- ((file-exists-p file-name)
- (let (mime-type method)
- (if (and (string-match "\\.[^\\.]+$" file-name)
- (setq mime-type
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- (stringp
- (setq method (mailcap-mime-info mime-type "print"))))
- (call-process shell-file-name nil
- (generate-new-buffer " *mm*")
- nil
- shell-command-switch
- (mm-mailcap-command method file-name mime-type))
- (with-temp-buffer
- (insert-file-contents file-name)
- (gnus-print-buffer))
- (ps-despool print-to))))
- ((file-symlink-p file-name)
- (error "File is a symlink to a nonexistent target"))
- (t
- (error "File no longer exists; type `g' to update Dired buffer"))))
-
-(provide 'gnus-dired)
-
-;;; arch-tag: 44737731-e445-4638-a31e-713c7590ec76
-;;; gnus-dired.el ends here
+++ /dev/null
-;;; gnus-draft.el --- draft message support for Gnus
-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'message)
-(require 'gnus-msg)
-(require 'nndraft)
-(require 'gnus-agent)
-(eval-when-compile (require 'cl))
-
-;;; Draft minor mode
-
-(defvar gnus-draft-mode nil
- "Minor mode for providing a draft summary buffers.")
-
-(defvar gnus-draft-mode-map nil)
-
-(unless gnus-draft-mode-map
- (setq gnus-draft-mode-map (make-sparse-keymap))
-
- (gnus-define-keys gnus-draft-mode-map
- "Dt" gnus-draft-toggle-sending
- "e" gnus-draft-edit-message ;; Use `B w' for `gnus-summary-edit-article'
- "De" gnus-draft-edit-message
- "Ds" gnus-draft-send-message
- "DS" gnus-draft-send-all-messages))
-
-(defun gnus-draft-make-menu-bar ()
- (unless (boundp 'gnus-draft-menu)
- (easy-menu-define
- gnus-draft-menu gnus-draft-mode-map ""
- '("Drafts"
- ["Toggle whether to send" gnus-draft-toggle-sending t]
- ["Edit" gnus-draft-edit-message t]
- ["Send selected message(s)" gnus-draft-send-message t]
- ["Send all messages" gnus-draft-send-all-messages t]
- ["Delete draft" gnus-summary-delete-article t]))))
-
-(defun gnus-draft-mode (&optional arg)
- "Minor mode for providing a draft summary buffers.
-
-\\{gnus-draft-mode-map}"
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (when (set (make-local-variable 'gnus-draft-mode)
- (if (null arg) (not gnus-draft-mode)
- (> (prefix-numeric-value arg) 0)))
- ;; Set up the menu.
- (when (gnus-visual-p 'draft-menu 'menu)
- (gnus-draft-make-menu-bar))
- (gnus-add-minor-mode 'gnus-draft-mode " Draft" gnus-draft-mode-map)
- (gnus-run-hooks 'gnus-draft-mode-hook))))
-
-;;; Commands
-
-(defun gnus-draft-toggle-sending (article)
- "Toggle whether to send an article or not."
- (interactive (list (gnus-summary-article-number)))
- (if (gnus-draft-article-sendable-p article)
- (progn
- (push article gnus-newsgroup-unsendable)
- (gnus-summary-mark-article article gnus-unsendable-mark))
- (setq gnus-newsgroup-unsendable
- (delq article gnus-newsgroup-unsendable))
- (gnus-summary-mark-article article gnus-unread-mark))
- (gnus-summary-position-point))
-
-(defun gnus-draft-edit-message ()
- "Enter a mail/post buffer to edit and send the draft."
- (interactive)
- (let ((article (gnus-summary-article-number))
- (group gnus-newsgroup-name))
- (gnus-draft-check-draft-articles (list article))
- (gnus-summary-mark-as-read article gnus-canceled-mark)
- (gnus-draft-setup article group t)
- (set-buffer-modified-p t)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "date")))
- (save-buffer)
- (let ((gnus-verbose-backends nil))
- (gnus-request-expire-articles (list article) group t))
- (push
- `((lambda ()
- (when (gnus-buffer-exists-p ,gnus-summary-buffer)
- (save-excursion
- (set-buffer ,gnus-summary-buffer)
- (gnus-cache-possibly-remove-article ,article nil nil nil t)))))
- message-send-actions)))
-
-(defun gnus-draft-send-message (&optional n)
- "Send the current draft(s).
-Obeys the standard process/prefix convention."
- (interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (total (length articles))
- article)
- (gnus-draft-check-draft-articles articles)
- (while (setq article (pop articles))
- (gnus-summary-remove-process-mark article)
- (unless (memq article gnus-newsgroup-unsendable)
- (let ((message-sending-message
- (format "Sending message %d of %d..."
- (- total (length articles)) total)))
- (gnus-draft-send article gnus-newsgroup-name t))
- (gnus-summary-mark-article article gnus-canceled-mark)))))
-
-(defun gnus-draft-send (article &optional group interactive)
- "Send message ARTICLE."
- (let* ((is-queue (or (not group)
- (equal group "nndraft:queue")))
- (message-syntax-checks (if interactive message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (message-hidden-headers nil)
- (message-inhibit-body-encoding (or is-queue
- message-inhibit-body-encoding))
- (message-send-hook (and (not is-queue)
- message-send-hook))
- (message-setup-hook (and (not is-queue)
- message-setup-hook))
- (message-signature (and (not is-queue)
- message-signature))
- (gnus-agent-queue-mail (and (not is-queue)
- gnus-agent-queue-mail))
- (rfc2047-encode-encoded-words nil)
- type method move-to)
- (gnus-draft-setup article (or group "nndraft:queue"))
- ;; We read the meta-information that says how and where
- ;; this message is to be sent.
- (save-restriction
- (message-narrow-to-headers)
- (when (re-search-forward
- (concat "^" (regexp-quote gnus-agent-target-move-group-header)
- ":") nil t)
- (skip-syntax-forward "-")
- (setq move-to (buffer-substring (point) (gnus-point-at-eol)))
- (message-remove-header gnus-agent-target-move-group-header))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote gnus-agent-meta-information-header) ":")
- nil t)
- (setq type (ignore-errors (read (current-buffer)))
- method (ignore-errors (read (current-buffer))))
- (message-remove-header gnus-agent-meta-information-header)))
- ;; Let Agent restore any GCC lines and have message.el perform them.
- (gnus-agent-restore-gcc)
- ;; Then we send it. If we have no meta-information, we just send
- ;; it and let Message figure out how.
- (when (and (or (null method)
- (gnus-server-opened method)
- (gnus-open-server method))
- (if type
- (let ((message-this-is-news (eq type 'news))
- (message-this-is-mail (eq type 'mail))
- (gnus-post-method method)
- (message-post-method method))
- (if move-to
- (gnus-inews-do-gcc move-to)
- (message-send-and-exit)))
- (if move-to
- (gnus-inews-do-gcc move-to)
- (message-send-and-exit))))
- (let ((gnus-verbose-backends nil))
- (gnus-request-expire-articles
- (list article) (or group "nndraft:queue") t)))))
-
-(defun gnus-draft-send-all-messages ()
- "Send all the sendable drafts."
- (interactive)
- (when (or
- gnus-expert-user
- (gnus-y-or-n-p
- "Send all drafts? "))
- (gnus-uu-mark-buffer)
- (gnus-draft-send-message)))
-
-(defun gnus-group-send-queue ()
- "Send all sendable articles from the queue group."
- (interactive)
- (when (or gnus-plugged
- (not gnus-agent-prompt-send-queue)
- (gnus-y-or-n-p "Gnus is unplugged; really send queue? "))
- (gnus-activate-group "nndraft:queue")
- (save-excursion
- (let* ((articles (nndraft-articles))
- (unsendable (gnus-uncompress-range
- (cdr (assq 'unsend
- (gnus-info-marks
- (gnus-get-info "nndraft:queue"))))))
- (gnus-posting-styles nil)
- (total (length articles))
- article)
- (while (setq article (pop articles))
- (unless (memq article unsendable)
- (let ((message-sending-message
- (format "Sending message %d of %d..."
- (- total (length articles)) total)))
- (gnus-draft-send article))))))))
-
-;;;###autoload
-(defun gnus-draft-reminder ()
- "Reminder user if there are unsent drafts."
- (interactive)
- (if (gnus-alive-p)
- (let (active)
- (catch 'continue
- (dolist (group '("nndraft:drafts" "nndraft:queue"))
- (setq active (gnus-activate-group group))
- (if (and active (>= (cdr active) (car active)))
- (if (y-or-n-p "There are unsent drafts. Confirm to exit? ")
- (throw 'continue t)
- (error "Stop!"))))))))
-
-;;; Utility functions
-
-;;;!!!If this is byte-compiled, it fails miserably.
-;;;!!!This is because `gnus-setup-message' uses uninterned symbols.
-;;;!!!This has been fixed in recent versions of Emacs and XEmacs,
-;;;!!!but for the time being, we'll just run this tiny function uncompiled.
-
-(progn
- (defun gnus-draft-setup (narticle group &optional restore)
- (let (ga)
- (gnus-setup-message 'forward
- (let ((article narticle))
- (message-mail)
- (erase-buffer)
- (if (not (gnus-request-restore-buffer article group))
- (error "Couldn't restore the article")
- (when (and restore
- (equal group "nndraft:queue"))
- (mime-to-mml))
- ;; Insert the separator.
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (save-restriction
- (narrow-to-region (point-min) (point))
- (setq ga
- (message-fetch-field gnus-draft-meta-information-header)))
- (insert mail-header-separator)
- (forward-line 1)
- (message-set-auto-save-file-name))))
- (gnus-backlog-remove-article group narticle)
- (when (and ga
- (ignore-errors (setq ga (car (read-from-string ga)))))
- (setq gnus-newsgroup-name
- (if (equal (car ga) "") nil (car ga)))
- (gnus-configure-posting-styles)
- (setq gnus-message-group-art (cons gnus-newsgroup-name (cadr ga)))
- (setq message-post-method
- `(lambda (arg)
- (gnus-post-method arg ,(car ga))))
- (unless (equal (cadr ga) "")
- (dolist (article (cdr ga))
- (message-add-action
- `(progn
- (gnus-add-mark ,(car ga) 'replied ,article)
- (gnus-request-set-mark ,(car ga) (list (list (list ,article)
- 'add '(reply)))))
- 'send)))))))
-
-(defun gnus-draft-article-sendable-p (article)
- "Say whether ARTICLE is sendable."
- (not (memq article gnus-newsgroup-unsendable)))
-
-(defun gnus-draft-check-draft-articles (articles)
- "Check whether the draft articles ARTICLES are under edit."
- (when (equal gnus-newsgroup-name "nndraft:drafts")
- (let ((buffers (buffer-list))
- file buffs buff)
- (save-current-buffer
- (while (and articles
- (not buff))
- (setq file (nndraft-article-filename (pop articles))
- buffs buffers)
- (while buffs
- (set-buffer (setq buff (pop buffs)))
- (if (and buffer-file-name
- (string-equal (file-truename buffer-file-name)
- (file-truename file))
- (buffer-modified-p))
- (setq buffs nil)
- (setq buff nil)))))
- (when buff
- (let* ((window (get-buffer-window buff t))
- (frame (and window (window-frame window))))
- (if frame
- (gnus-select-frame-set-input-focus frame)
- (pop-to-buffer buff t)))
- (error "The draft %s is under edit" file)))))
-
-(provide 'gnus-draft)
-
-;;; arch-tag: 3d92af58-8c97-4a5c-9db4-a98e85198022
-;;; gnus-draft.el ends here
+++ /dev/null
-;;; gnus-dup.el --- suppression of duplicate articles in Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package tries to mark articles as read the second time the
-;; user reads a copy. This is useful if the server doesn't support
-;; Xref properly, or if the user reads the same group from several
-;; servers.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-
-(defgroup gnus-duplicate nil
- "Suppression of duplicate articles."
- :group 'gnus)
-
-(defcustom gnus-save-duplicate-list nil
- "*If non-nil, save the duplicate list when shutting down Gnus.
-If nil, duplicate suppression will only work on duplicates
-seen in the same session."
- :group 'gnus-duplicate
- :type 'boolean)
-
-(defcustom gnus-duplicate-list-length 10000
- "*The number of Message-IDs to keep in the duplicate suppression list."
- :group 'gnus-duplicate
- :type 'integer)
-
-(defcustom gnus-duplicate-file (nnheader-concat gnus-directory "suppression")
- "*The name of the file to store the duplicate suppression list."
- :group 'gnus-duplicate
- :type 'file)
-
-;;; Internal variables
-
-(defvar gnus-dup-list nil)
-(defvar gnus-dup-hashtb nil)
-
-(defvar gnus-dup-list-dirty nil)
-
-;;;
-;;; Starting and stopping
-;;;
-
-(gnus-add-shutdown 'gnus-dup-close 'gnus)
-
-(defun gnus-dup-close ()
- "Possibly save the duplicate suppression list and shut down the subsystem."
- (gnus-dup-save)
- (setq gnus-dup-list nil
- gnus-dup-hashtb nil
- gnus-dup-list-dirty nil))
-
-(defun gnus-dup-open ()
- "Possibly read the duplicate suppression list and start the subsystem."
- (if gnus-save-duplicate-list
- (gnus-dup-read)
- (setq gnus-dup-list nil))
- (setq gnus-dup-hashtb (gnus-make-hashtable gnus-duplicate-list-length))
- ;; Enter all Message-IDs into the hash table.
- (let ((list gnus-dup-list)
- (obarray gnus-dup-hashtb))
- (while list
- (intern (pop list)))))
-
-(defun gnus-dup-read ()
- "Read the duplicate suppression list."
- (setq gnus-dup-list nil)
- (when (file-exists-p gnus-duplicate-file)
- (load gnus-duplicate-file t t t)))
-
-(defun gnus-dup-save ()
- "Save the duplicate suppression list."
- (when (and gnus-save-duplicate-list
- gnus-dup-list-dirty)
- (with-temp-file gnus-duplicate-file
- (gnus-prin1 `(setq gnus-dup-list ',gnus-dup-list))))
- (setq gnus-dup-list-dirty nil))
-
-;;;
-;;; Interface functions
-;;;
-
-(defun gnus-dup-enter-articles ()
- "Enter articles from the current group for future duplicate suppression."
- (unless gnus-dup-list
- (gnus-dup-open))
- (setq gnus-dup-list-dirty t) ; mark list for saving
- (let ((data gnus-newsgroup-data)
- datum msgid)
- ;; Enter the Message-IDs of all read articles into the list
- ;; and hash table.
- (while (setq datum (pop data))
- (when (and (not (gnus-data-pseudo-p datum))
- (> (gnus-data-number datum) 0)
- (not (memq (gnus-data-number datum) gnus-newsgroup-unreads))
- (not (= (gnus-data-mark datum) gnus-canceled-mark))
- (setq msgid (mail-header-id (gnus-data-header datum)))
- (not (nnheader-fake-message-id-p msgid))
- (not (intern-soft msgid gnus-dup-hashtb)))
- (push msgid gnus-dup-list)
- (intern msgid gnus-dup-hashtb))))
- ;; Chop off excess Message-IDs from the list.
- (let ((end (nthcdr gnus-duplicate-list-length gnus-dup-list)))
- (when end
- (setcdr end nil))))
-
-(defun gnus-dup-suppress-articles ()
- "Mark duplicate articles as read."
- (unless gnus-dup-list
- (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)
- (gnus-summary-article-unread-p (mail-header-number header)))
- (setq gnus-newsgroup-unreads
- (delq (setq number (mail-header-number header))
- gnus-newsgroup-unreads))
- (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)
- "Stop suppression of ARTICLE."
- (let ((id (mail-header-id (gnus-data-header (gnus-data-find article)))))
- (when id
- (setq gnus-dup-list-dirty t)
- (setq gnus-dup-list (delete id gnus-dup-list))
- (unintern id gnus-dup-hashtb))))
-
-(provide 'gnus-dup)
-
-;;; arch-tag: 903e94db-7b00-4d19-83ee-cf34a81fa5fb
-;;; gnus-dup.el ends here
+++ /dev/null
-;;; gnus-eform.el --- a mode for editing forms for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-win)
-
-;;;
-;;; Editing forms
-;;;
-
-(defgroup gnus-edit-form nil
- "A mode for editing forms."
- :group 'gnus)
-
-(defcustom gnus-edit-form-mode-hook nil
- "Hook run in `gnus-edit-form-mode' buffers."
- :group 'gnus-edit-form
- :type 'hook)
-
-(defcustom gnus-edit-form-menu-hook nil
- "Hook run when creating menus in `gnus-edit-form-mode' buffers."
- :group 'gnus-edit-form
- :type 'hook)
-
-;;; Internal variables
-
-(defvar gnus-edit-form-buffer "*Gnus edit form*")
-(defvar gnus-edit-form-done-function nil)
-
-(defvar gnus-edit-form-mode-map nil)
-(unless gnus-edit-form-mode-map
- (setq gnus-edit-form-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-edit-form-mode-map emacs-lisp-mode-map)
- (gnus-define-keys gnus-edit-form-mode-map
- "\C-c\C-c" gnus-edit-form-done
- "\C-c\C-k" gnus-edit-form-exit))
-
-(defun gnus-edit-form-make-menu-bar ()
- (unless (boundp 'gnus-edit-form-menu)
- (easy-menu-define
- gnus-edit-form-menu gnus-edit-form-mode-map ""
- '("Edit Form"
- ["Exit and save changes" gnus-edit-form-done t]
- ["Exit" gnus-edit-form-exit t]))
- (gnus-run-hooks 'gnus-edit-form-menu-hook)))
-
-(defun gnus-edit-form-mode ()
- "Major mode for editing forms.
-It is a slightly enhanced emacs-lisp-mode.
-
-\\{gnus-edit-form-mode-map}"
- (interactive)
- (when (gnus-visual-p 'group-menu 'menu)
- (gnus-edit-form-make-menu-bar))
- (kill-all-local-variables)
- (setq major-mode 'gnus-edit-form-mode)
- (setq mode-name "Edit Form")
- (use-local-map gnus-edit-form-mode-map)
- (make-local-variable 'gnus-edit-form-done-function)
- (make-local-variable 'gnus-prev-winconf)
- (gnus-run-mode-hooks 'gnus-edit-form-mode-hook))
-
-(defun gnus-edit-form (form documentation exit-func)
- "Edit FORM in a new buffer.
-Call EXIT-FUNC on exit. Display DOCUMENTATION in the beginning
-of the buffer."
- (let ((winconf (current-window-configuration)))
- (set-buffer (gnus-get-buffer-create gnus-edit-form-buffer))
- (gnus-configure-windows 'edit-form)
- (gnus-edit-form-mode)
- (setq gnus-prev-winconf winconf)
- (setq gnus-edit-form-done-function exit-func)
- (erase-buffer)
- (insert documentation)
- (unless (bolp)
- (insert "\n"))
- (goto-char (point-min))
- (while (not (eobp))
- (insert ";;; ")
- (forward-line 1))
- (insert ";; Type `C-c C-c' after you've finished editing.\n")
- (insert "\n")
- (let ((p (point)))
- (gnus-pp form)
- (insert "\n")
- (goto-char p))))
-
-(defun gnus-edit-form-done ()
- "Update changes and kill the current buffer."
- (interactive)
- (goto-char (point-min))
- (let ((form (condition-case nil
- (read (current-buffer))
- (end-of-file nil)))
- (func gnus-edit-form-done-function))
- (gnus-edit-form-exit)
- (funcall func form)))
-
-(defun gnus-edit-form-exit ()
- "Kill the current buffer."
- (interactive)
- (let ((winconf gnus-prev-winconf))
- (kill-buffer (current-buffer))
- (set-window-configuration winconf)))
-
-(provide 'gnus-eform)
-
-;;; arch-tag: ef50678c-2c28-49ef-affc-e53b3b2c0bf6
-;;; gnus-eform.el ends here
+++ /dev/null
-;;; gnus-ems.el --- functions for making Gnus work under different Emacsen
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'ring))
-
-;;; Function aliases later to be redefined for XEmacs usage.
-
-(defvar gnus-mouse-2 [mouse-2])
-(defvar gnus-down-mouse-3 [down-mouse-3])
-(defvar gnus-down-mouse-2 [down-mouse-2])
-(defvar gnus-widget-button-keymap nil)
-(defvar gnus-mode-line-modified
- (if (or (featurep 'xemacs)
- (< emacs-major-version 20))
- '("--**-" . "-----")
- '("**" "--")))
-
-(eval-and-compile
- (autoload 'gnus-xmas-define "gnus-xmas")
- (autoload 'gnus-xmas-redefine "gnus-xmas")
- (autoload 'appt-select-lowest-window "appt")
- (autoload 'gnus-get-buffer-create "gnus")
- (autoload 'nnheader-find-etc-directory "nnheader"))
-
-(autoload 'smiley-region "smiley")
-;; Fixme: shouldn't require message
-(autoload 'message-text-with-property "message")
-
-(defun gnus-kill-all-overlays ()
- "Delete all overlays in the current buffer."
- (let* ((overlayss (overlay-lists))
- (buffer-read-only nil)
- (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
- (while overlays
- (delete-overlay (pop overlays)))))
-
-;;; Mule functions.
-
-(defun gnus-mule-max-width-function (el max-width)
- `(let* ((val (eval (, el)))
- (valstr (if (numberp val)
- (int-to-string val) val)))
- (if (> (length valstr) ,max-width)
- (truncate-string-to-width valstr ,max-width)
- valstr)))
-
-(eval-and-compile
- (defalias 'gnus-char-width
- (if (fboundp 'char-width)
- 'char-width
- (lambda (ch) 1)))) ;; A simple hack.
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (gnus-xmas-define)
- (defvar gnus-mouse-face-prop 'mouse-face
- "Property used for highlighting mouse regions.")))
-
-(eval-when-compile
- (defvar gnus-tmp-unread)
- (defvar gnus-tmp-replied)
- (defvar gnus-tmp-score-char)
- (defvar gnus-tmp-indentation)
- (defvar gnus-tmp-opening-bracket)
- (defvar gnus-tmp-lines)
- (defvar gnus-tmp-name)
- (defvar gnus-tmp-closing-bracket)
- (defvar gnus-tmp-subject-or-nil)
- (defvar gnus-check-before-posting)
- (defvar gnus-mouse-face)
- (defvar gnus-group-buffer))
-
-(defun gnus-ems-redefine ()
- (cond
- ((featurep 'xemacs)
- (gnus-xmas-redefine))
-
- ((featurep 'mule)
- ;; Mule and new Emacs definitions
-
- ;; [Note] Now there are three kinds of mule implementations,
- ;; original MULE, XEmacs/mule and Emacs 20+ including
- ;; MULE features. Unfortunately these APIs are different. In
- ;; particular, Emacs (including original Mule) and XEmacs are
- ;; quite different. However, this version of Gnus doesn't support
- ;; anything other than XEmacs 20+ and Emacs 20.3+.
-
- ;; Predicates to check are following:
- ;; (boundp 'MULE) is t only if Mule (original; anything older than
- ;; Mule 2.3) is running.
- ;; (featurep 'mule) is t when other mule variants are running.
-
- ;; It is possible to detect XEmacs/mule by (featurep 'mule) and
- ;; (featurep 'xemacs). In this case, the implementation for
- ;; XEmacs/mule may be shareable between XEmacs and XEmacs/mule.
-
- (defvar gnus-summary-display-table nil
- "Display table used in summary mode buffers.")
- (defalias 'gnus-max-width-function 'gnus-mule-max-width-function)
-
- (when (boundp 'gnus-check-before-posting)
- (setq gnus-check-before-posting
- (delq 'long-lines
- (delq 'control-chars gnus-check-before-posting))))
-
- (defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (put-text-property
- (point)
- (progn
- (insert
- gnus-tmp-opening-bracket
- (format "%4d: %-20s"
- gnus-tmp-lines
- (if (> (length gnus-tmp-name) 20)
- (truncate-string-to-width gnus-tmp-name 20)
- gnus-tmp-name))
- gnus-tmp-closing-bracket)
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n")))))
-
-(defun gnus-region-active-p ()
- "Say whether the region is active."
- (and (boundp 'transient-mark-mode)
- transient-mark-mode
- (boundp 'mark-active)
- mark-active))
-
-(defun gnus-mark-active-p ()
- "Non-nil means the mark and region are currently active in this buffer."
- mark-active) ; aliased to region-exists-p in XEmacs.
-
-(if (fboundp 'add-minor-mode)
- (defalias 'gnus-add-minor-mode 'add-minor-mode)
- (defun gnus-add-minor-mode (mode name map &rest rest)
- (set (make-local-variable mode) t)
- (unless (assq mode minor-mode-alist)
- (push `(,mode ,name) minor-mode-alist))
- (unless (assq mode minor-mode-map-alist)
- (push (cons mode map)
- minor-mode-map-alist))))
-
-(defun gnus-x-splash ()
- "Show a splash screen using a pixmap in the current buffer."
- (interactive)
- (unless window-system
- (error "`gnus-x-splash' requires running on the window system"))
- (switch-to-buffer (gnus-get-buffer-create (if (or (gnus-alive-p)
- (interactive-p))
- "*gnus-x-splash*"
- gnus-group-buffer)))
- (let ((inhibit-read-only t)
- (file (nnheader-find-etc-directory "images/gnus/x-splash" t))
- pixmap fcw fch width height fringes sbars left yoffset top ls)
- (erase-buffer)
- (sit-for 0) ;; Necessary for measuring the window size correctly.
- (when (and file
- (ignore-errors
- (let ((coding-system-for-read 'raw-text)
- default-enable-multibyte-characters)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq pixmap (read (current-buffer)))))))
- (setq fcw (float (frame-char-width))
- fch (float (frame-char-height))
- width (/ (car pixmap) fcw)
- height (/ (cadr pixmap) fch)
- fringes (if (fboundp 'window-fringes)
- (eval '(window-fringes))
- '(10 11 nil))
- sbars (frame-parameter nil 'vertical-scroll-bars))
- (cond ((eq sbars 'right)
- (setq sbars
- (cons 0 (/ (or (frame-parameter nil 'scroll-bar-width) 14)
- fcw))))
- (sbars
- (setq sbars
- (cons (/ (or (frame-parameter nil 'scroll-bar-width) 14)
- fcw)
- 0)))
- (t
- (setq sbars '(0 . 0))))
- (setq left (- (* (round (/ (1- (/ (+ (window-width)
- (car sbars) (cdr sbars)
- (/ (+ (or (car fringes) 0)
- (or (cadr fringes) 0))
- fcw))
- width))
- 2))
- width)
- (car sbars)
- (/ (or (car fringes) 0) fcw))
- yoffset (cadr (window-edges))
- top (max 0 (- (* (max (if (and tool-bar-mode
- (not (featurep 'gtk))
- (eq (frame-first-window)
- (selected-window)))
- 1 0)
- (round (/ (1- (/ (+ (1- (window-height))
- (* 2 yoffset))
- height))
- 2)))
- height)
- yoffset))
- ls (/ (or line-spacing 0) fch)
- height (max 0 (- height ls)))
- (cond ((>= (- top ls) 1)
- (insert
- (propertize
- " "
- 'display `(space :width 0 :ascent 100))
- "\n"
- (propertize
- " "
- 'display `(space :width 0 :height ,(- top ls 1) :ascent 100))
- "\n"))
- ((> (- top ls) 0)
- (insert
- (propertize
- " "
- 'display `(space :width 0 :height ,(- top ls) :ascent 100))
- "\n")))
- (if (and (> width 0) (> left 0))
- (insert (propertize
- " "
- 'display `(space :width ,left :height ,height :ascent 0)))
- (setq width (+ width left)))
- (when (> width 0)
- (insert (propertize
- " "
- 'display `(space :width ,width :height ,height :ascent 0)
- 'face `(gnus-splash :stipple ,pixmap))))
- (goto-char (if (<= (- top ls) 0) (1- (point)) (point-min)))
- (redraw-frame (selected-frame))
- (sit-for 0))))
-
-;;; Image functions.
-
-(defun gnus-image-type-available-p (type)
- (and (fboundp 'image-type-available-p)
- (image-type-available-p type)
- (if (fboundp 'display-images-p)
- (display-images-p)
- t)))
-
-(defun gnus-create-image (file &optional type data-p &rest props)
- (let ((face (plist-get props :face)))
- (when face
- (setq props (plist-put props :foreground (face-foreground face)))
- (setq props (plist-put props :background (face-background face))))
- (apply 'create-image file type data-p props)))
-
-(defun gnus-put-image (glyph &optional string category)
- (let ((point (point)))
- (insert-image glyph (or string " "))
- (put-text-property point (point) 'gnus-image-category category)
- (unless string
- (put-text-property (1- (point)) (point)
- 'gnus-image-text-deletable t))
- glyph))
-
-(defun gnus-remove-image (image &optional category)
- (dolist (position (message-text-with-property 'display))
- (when (and (equal (get-text-property position 'display) image)
- (equal (get-text-property position 'gnus-image-category)
- category))
- (put-text-property position (1+ position) 'display nil)
- (when (get-text-property position 'gnus-image-text-deletable)
- (delete-region position (1+ position))))))
-
-(provide 'gnus-ems)
-
-;;; arch-tag: e7360b45-14b5-4171-aa39-69a44aed3cdb
-;;; gnus-ems.el ends here
+++ /dev/null
-;;; gnus-fun.el --- various frivolous extension functions to Gnus
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(require 'mm-util)
-(require 'gnus-ems)
-(require 'gnus-util)
-(require 'gnus)
-
-(defcustom gnus-x-face-directory (expand-file-name "x-faces" gnus-directory)
- "*Directory where X-Face PBM files are stored."
- :version "22.1"
- :group 'gnus-fun
- :type 'directory)
-
-(defcustom gnus-convert-pbm-to-x-face-command "pbmtoxbm %s | compface"
- "Command for converting a PBM to an X-Face."
- :version "22.1"
- :group 'gnus-fun
- :type 'string)
-
-(defcustom gnus-convert-image-to-x-face-command "giftopnm %s | ppmnorm | pnmscale -width 48 -height 48 | ppmtopgm | pgmtopbm | pbmtoxbm | compface"
- "Command for converting an image to an X-Face.
-By default it takes a GIF filename and output the X-Face header data
-on stdout."
- :version "22.1"
- :group 'gnus-fun
- :type 'string)
-
-(defcustom gnus-convert-image-to-face-command "djpeg %s | ppmnorm | pnmscale -width 48 -height 48 | ppmquant %d | pnmtopng"
- "Command for converting an image to a Face.
-By default it takes a JPEG filename and output the Face header data
-on stdout."
- :version "22.1"
- :group 'gnus-fun
- :type 'string)
-
-(defun gnus-shell-command-to-string (command)
- "Like `shell-command-to-string' except not mingling ERROR."
- (with-output-to-string
- (call-process shell-file-name nil (list standard-output nil)
- nil shell-command-switch command)))
-
-(defun gnus-shell-command-on-region (start end command)
- "A simplified `shell-command-on-region'.
-Output to the current buffer, replace text, and don't mingle error."
- (call-process-region start end shell-file-name t
- (list (current-buffer) nil)
- nil shell-command-switch command))
-
-;;;###autoload
-(defun gnus-random-x-face ()
- "Return X-Face header data chosen randomly from `gnus-x-face-directory'."
- (interactive)
- (when (file-exists-p gnus-x-face-directory)
- (let* ((files (directory-files gnus-x-face-directory t "\\.pbm$"))
- (file (nth (random (length files)) files)))
- (when file
- (gnus-shell-command-to-string
- (format gnus-convert-pbm-to-x-face-command
- (shell-quote-argument file)))))))
-
-;;;###autoload
-(defun gnus-insert-random-x-face-header ()
- "Insert a random X-Face header from `gnus-x-face-directory'."
- (interactive)
- (let ((data (gnus-random-x-face)))
- (save-excursion
- (message-goto-eoh)
- (if data
- (insert "X-Face: " data)
- (message
- "No face returned by `gnus-random-x-face'. Does %s/*.pbm exist?"
- gnus-x-face-directory)))))
-
-;;;###autoload
-(defun gnus-x-face-from-file (file)
- "Insert an X-Face header based on an image file."
- (interactive "fImage file name (by default GIF): ")
- (when (file-exists-p file)
- (gnus-shell-command-to-string
- (format gnus-convert-image-to-x-face-command
- (shell-quote-argument (expand-file-name file))))))
-
-;;;###autoload
-(defun gnus-face-from-file (file)
- "Return a Face header based on an image file."
- (interactive "fImage file name (by default JPEG): ")
- (when (file-exists-p file)
- (let ((done nil)
- (attempt "")
- (quant 16))
- (while (and (not done)
- (> quant 1))
- (setq attempt
- (let ((coding-system-for-read 'binary))
- (gnus-shell-command-to-string
- (format gnus-convert-image-to-face-command
- (shell-quote-argument (expand-file-name file))
- quant))))
- (if (> (length attempt) 726)
- (progn
- (setq quant (- quant 2))
- (gnus-message 9 "Length %d; trying quant %d"
- (length attempt) quant))
- (setq done t)))
- (if done
- (mm-with-unibyte-buffer
- (insert attempt)
- (gnus-face-encode))
- nil))))
-
-(defun gnus-face-encode ()
- (let ((step 72))
- (base64-encode-region (point-min) (point-max))
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (> (- (point-max) (point))
- step)
- (forward-char step)
- (insert "\n ")
- (setq step 76))
- (buffer-string)))
-
-;;;###autoload
-(defun gnus-convert-face-to-png (face)
- "Convert FACE (which is base64-encoded) to a PNG.
-The PNG is returned as a string."
- (mm-with-unibyte-buffer
- (insert face)
- (ignore-errors
- (base64-decode-region (point-min) (point-max)))
- (buffer-string)))
-
-;;;###autoload
-(defun gnus-convert-png-to-face (file)
- "Convert FILE to a Face.
-FILE should be a PNG file that's 48x48 and smaller than or equal to
-726 bytes."
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (when (> (buffer-size) 726)
- (error "The file is %d bytes long, which is too long"
- (buffer-size)))
- (gnus-face-encode)))
-
-(defface gnus-x-face '((t (:foreground "black" :background "white")))
- "Face to show X-Face.
-The colors from this face are used as the foreground and background
-colors of the displayed X-Faces."
- :group 'gnus-article-headers)
-
-(defun gnus-display-x-face-in-from (data)
- "Display the X-Face DATA in the From header."
- (let ((default-enable-multibyte-characters nil)
- pbm)
- (when (or (gnus-image-type-available-p 'xface)
- (and (gnus-image-type-available-p 'pbm)
- (setq pbm (uncompface data))))
- (save-excursion
- (save-restriction
- (article-narrow-to-head)
- (gnus-article-goto-header "from")
- (when (bobp)
- (insert "From: [no `from' set]\n")
- (forward-char -17))
- (gnus-add-image
- 'xface
- (gnus-put-image
- (if (gnus-image-type-available-p 'xface)
- (gnus-create-image
- (concat "X-Face: " data)
- 'xface t :face 'gnus-x-face)
- (gnus-create-image
- pbm 'pbm t :face 'gnus-x-face)) nil 'xface))
- (gnus-add-wash-type 'xface))))))
-
-(defun gnus-grab-cam-x-face ()
- "Grab a picture off the camera and make it into an X-Face."
- (interactive)
- (shell-command "xawtv-remote snap ppm")
- (let ((file nil))
- (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
- t "snap.*ppm")))
- (sleep-for 1))
- (setq file (car file))
- (with-temp-buffer
- (shell-command
- (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | ppmnorm 2>/dev/null | pnmscale -width 48 | ppmtopgm | pgmtopbm -threshold -value 0.92 | pbmtoxbm | compface"
- file)
- (current-buffer))
- ;;(sleep-for 3)
- (delete-file file)
- (buffer-string))))
-
-(defun gnus-grab-cam-face ()
- "Grab a picture off the camera and make it into an X-Face."
- (interactive)
- (shell-command "xawtv-remote snap ppm")
- (let ((file nil)
- (tempfile (make-temp-file "gnus-face-" nil ".ppm"))
- result)
- (while (null (setq file (directory-files "/tftpboot/sparky/tmp"
- t "snap.*ppm")))
- (sleep-for 1))
- (setq file (car file))
- (shell-command
- (format "pnmcut -left 110 -top 30 -width 144 -height 144 '%s' | pnmscale -width 48 -height 48 | ppmtopgm > %s"
- file tempfile))
- (let ((gnus-convert-image-to-face-command
- (format "cat '%%s' | ppmquant %%d | ppmchange %s | pnmtopng"
- (gnus-fun-ppm-change-string))))
- (setq result (gnus-face-from-file tempfile)))
- (delete-file file)
- ;;(delete-file tempfile) ; FIXME why are we not deleting it?!
- result))
-
-(defun gnus-fun-ppm-change-string ()
- (let* ((possibilites '("%02x0000" "00%02x00" "0000%02x"
- "%02x%02x00" "00%02x%02x" "%02x00%02x"))
- (format (concat "'#%02x%02x%02x' '#"
- (nth (random 6) possibilites)
- "'"))
- (values nil))
- (dotimes (i 255)
- (push (format format i i i i i i)
- values))
- (mapconcat 'identity values " ")))
-
-(provide 'gnus-fun)
-
-;;; arch-tag: 9d000a69-15cc-4491-9dc0-4627484f50c1
-;;; gnus-fun.el ends here
+++ /dev/null
-;;; gnus-gl.el --- an interface to GroupLens for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Brad Miller <bmiller@cs.umn.edu>
-;; Keywords: news, score
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; GroupLens software and documentation is copyright (c) 1995 by Paul
-;; Resnick (Massachusetts Institute of Technology); Brad Miller, John
-;; Riedl, Jon Herlocker, and Joseph Konstan (University of Minnesota),
-;; and David Maltz (Carnegie-Mellon University).
-;;
-;; Permission to use, copy, modify, and distribute this documentation
-;; for non-commercial and commercial purposes without fee is hereby
-;; granted provided that this copyright notice and permission notice
-;; appears in all copies and that the names of the individuals and
-;; institutions holding this copyright are not used in advertising or
-;; publicity pertaining to this software without specific, written
-;; prior permission. The copyright holders make no representations
-;; about the suitability of this software and documentation for any
-;; purpose. It is provided ``as is'' without express or implied
-;; warranty.
-;;
-;; The copyright holders request that they be notified of
-;; modifications of this code. Please send electronic mail to
-;; grouplens@cs.umn.edu for more information or to announce derived
-;; works.
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Author: Brad Miller
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; User Documentation:
-;; To use GroupLens you must load this file.
-;; You must also register a pseudonym with the Better Bit Bureau.
-;; http://www.cs.umn.edu/Research/GroupLens
-;;
-;; ---------------- For your .emacs or .gnus file ----------------
-;;
-;; As of version 2.5, grouplens now works as a minor mode of
-;; gnus-summary-mode. To get make that work you just need a couple of
-;; hooks.
-;; (setq gnus-use-grouplens t)
-;; (setq grouplens-pseudonym "")
-;; (setq grouplens-bbb-host "grouplens.cs.umn.edu")
-;;
-;; (setq gnus-summary-default-score 0)
-;;
-;; USING GROUPLENS
-;; How do I Rate an article??
-;; Before you type n to go to the next article, hit a number from 1-5
-;; Type r in the summary buffer and you will be prompted.
-;; Note that when you're in grouplens-minor-mode 'r' masks the
-;; usual reply binding for 'r'
-;;
-;; What if, Gasp, I find a bug???
-;; Please type M-x gnus-gl-submit-bug-report. This will set up a
-;; mail buffer with the state of variables and buffers that will help
-;; me debug the problem. A short description up front would help too!
-;;
-;; How do I display the prediction for an article:
-;; If you set the gnus-summary-line-format as shown above, the score
-;; (prediction) will be shown automatically.
-;;
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Programmer Notes
-;; 10/9/95
-;; gnus-scores-articles contains the articles
-;; When scoring is done, the call tree looks something like:
-;; gnus-possibly-score-headers
-;; ==> gnus-score-headers
-;; ==> gnus-score-load-file
-;; ==> get-all-mids (from the eval form)
-;;
-;; it would be nice to have one that gets called after all the other
-;; headers have been scored.
-;; we may want a variable gnus-grouplens-scale-factor
-;; and gnus-grouplens-offset this would probably be either -3 or 0
-;; to make the scores centered around zero or not.
-;; Notes 10/12/95
-;; According to Lars, Norse god of gnus, the simple way to insert a
-;; call to an external function is to have a function added to the
-;; variable gnus-score-find-files-function This new function
-;; gnus-grouplens-score-alist will return a core alist that
-;; has (("message-id" ("<message-id-xxxx>" score) ("<message-id-xxxy>" score))
-;; This seems like it would be pretty inefficient, though workable.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; TODO
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-;; 3. Add some more ways to rate messages
-;; 4. Better error handling for token timeouts.
-;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; bugs
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus-score)
-(require 'gnus)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; User variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar gnus-summary-grouplens-line-format
- "%U\%R\%z%l%I\%(%[%4L: %-23,23n%]%) %s\n"
- "*The line format spec in summary GroupLens mode buffers.")
-
-(defvar grouplens-pseudonym ""
- "User's pseudonym.
-This pseudonym is obtained during the registration process")
-
-(defvar grouplens-bbb-host "grouplens.cs.umn.edu"
- "Host where the bbbd is running.")
-
-(defvar grouplens-bbb-port 9000
- "Port where the bbbd is listening.")
-
-(defvar grouplens-newsgroups
- '("comp.groupware" "comp.human-factors" "comp.lang.c++"
- "comp.lang.java" "comp.os.linux.admin" "comp.os.linux.advocacy"
- "comp.os.linux.announce" "comp.os.linux.answers"
- "comp.os.linux.development" "comp.os.linux.development.apps"
- "comp.os.linux.development.system" "comp.os.linux.hardware"
- "comp.os.linux.help" "comp.os.linux.m68k" "comp.os.linux.misc"
- "comp.os.linux.networking" "comp.os.linux.setup" "comp.os.linux.x"
- "mn.general" "rec.arts.movies" "rec.arts.movies.current-films"
- "rec.food.recipes" "rec.humor")
- "*Groups that are part of the GroupLens experiment.")
-
-(defvar grouplens-prediction-display 'prediction-spot
- "valid values are:
- prediction-spot -- an * corresponding to the prediction between 1 and 5,
- confidence-interval -- a numeric confidence interval
- prediction-bar -- |##### | the longer the bar, the better the article,
- confidence-bar -- | ----- } the prediction is in the middle of the bar,
- confidence-spot -- ) * | the spot gets bigger with more confidence,
- prediction-num -- plain-old numeric value,
- confidence-plus-minus -- prediction +/i confidence")
-
-(defvar grouplens-score-offset 0
- "Offset the prediction by this value.
-Setting this variable to -2 would have the following effect on
-GroupLens scores:
-
- 1 --> -2
- 2 --> -1
- 3 --> 0
- 4 --> 1
- 5 --> 2
-
-The reason is that a user might want to do this is to combine
-GroupLens predictions with scores calculated by other score methods.")
-
-(defvar grouplens-score-scale-factor 1
- "This variable allows the user to magnify the effect of GroupLens scores.
-The scale factor is applied after the offset.")
-
-(defvar gnus-grouplens-override-scoring 'override
- "Tell GroupLens to override the normal Gnus scoring mechanism.
-GroupLens scores can be combined with gnus scores in one of three ways.
-'override -- just use grouplens predictions for grouplens groups
-'combine -- combine grouplens scores with gnus scores
-'separate -- treat grouplens scores completely separate from gnus")
-
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Program global variables
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar grouplens-bbb-token nil
- "Current session token number.")
-
-(defvar grouplens-bbb-process nil
- "Process Id of current bbbd network stream process.")
-
-(defvar grouplens-bbb-buffer nil
- "Buffer associated with the BBBD process.")
-
-(defvar grouplens-rating-alist nil
- "Current set of message-id rating pairs.")
-
-(defvar grouplens-current-hashtable nil
- "A hashtable to hold predictions from the BBB.")
-
-(defvar grouplens-current-group nil)
-
-;;(defvar bbb-alist nil)
-
-(defvar bbb-timeout-secs 10
- "Number of seconds to wait for some response from the BBB.
-If this times out we give up and assume that something has died..." )
-
-(defvar grouplens-previous-article nil
- "Message-ID of the last article read.")
-
-(defvar bbb-read-point)
-(defvar bbb-response-point)
-
-(defun bbb-renew-hash-table ()
- (setq grouplens-current-hashtable (make-vector 100 0)))
-
-(bbb-renew-hash-table)
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Utility Functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun bbb-connect-to-bbbd (host port)
- (unless grouplens-bbb-buffer
- (setq grouplens-bbb-buffer
- (gnus-get-buffer-create (format " *BBBD trace: %s*" host)))
- (save-excursion
- (set-buffer grouplens-bbb-buffer)
- (make-local-variable 'bbb-read-point)
- (make-local-variable 'bbb-response-point)
- (setq bbb-read-point (point-min))))
-
- ;; if an old process is still running for some reason, kill it
- (when grouplens-bbb-process
- (ignore-errors
- (when (eq 'open (process-status grouplens-bbb-process))
- (set-process-buffer grouplens-bbb-process nil)
- (delete-process grouplens-bbb-process))))
-
- ;; clear the trace buffer of old output
- (save-excursion
- (set-buffer grouplens-bbb-buffer)
- (erase-buffer))
-
- ;; open the connection to the server
- (catch 'done
- (condition-case error
- (setq grouplens-bbb-process
- (open-network-stream "BBBD" grouplens-bbb-buffer host port))
- (error (gnus-message 3 "Error: Failed to connect to BBB")
- nil))
- (and (null grouplens-bbb-process)
- (throw 'done nil))
- (save-excursion
- (set-buffer grouplens-bbb-buffer)
- (setq bbb-read-point (point-min))
- (or (bbb-read-response grouplens-bbb-process)
- (throw 'done nil))))
-
- ;; return the process
- grouplens-bbb-process)
-
-(defun bbb-send-command (process command)
- (goto-char (point-max))
- (insert command)
- (insert "\r\n")
- (setq bbb-read-point (point))
- (setq bbb-response-point (point))
- (set-marker (process-mark process) (point)) ; process output also comes here
- (process-send-string process command)
- (process-send-string process "\r\n")
- (process-send-eof process))
-
-(defun bbb-read-response (process)
- "This function eats the initial response of OK or ERROR from the BBB."
- (let ((case-fold-search nil)
- match-end)
- (goto-char bbb-read-point)
- (while (and (not (search-forward "\r\n" nil t))
- (accept-process-output process bbb-timeout-secs))
- (goto-char bbb-read-point))
- (setq match-end (point))
- (goto-char bbb-read-point)
- (setq bbb-read-point match-end)
- (looking-at "OK")))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Login Functions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun bbb-login ()
- "return the token number if login is successful, otherwise return nil."
- (interactive)
- (setq grouplens-bbb-token nil)
- (if (not (equal grouplens-pseudonym ""))
- (let ((bbb-process
- (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
- (if bbb-process
- (save-excursion
- (set-buffer (process-buffer bbb-process))
- (bbb-send-command bbb-process
- (concat "login " grouplens-pseudonym))
- (if (bbb-read-response bbb-process)
- (setq grouplens-bbb-token (bbb-extract-token-number))
- (gnus-message 3 "Error: GroupLens login failed")))))
- (gnus-message 3 "Error: you must set a pseudonym"))
- grouplens-bbb-token)
-
-(defun bbb-extract-token-number ()
- (let ((token-pos (search-forward "token=" nil t)))
- (when (looking-at "[0-9]+")
- (buffer-substring token-pos (match-end 0)))))
-
-(gnus-add-shutdown 'bbb-logout 'gnus)
-
-(defun bbb-logout ()
- "logout of bbb session."
- (when grouplens-bbb-token
- (let ((bbb-process
- (bbb-connect-to-bbbd grouplens-bbb-host grouplens-bbb-port)))
- (when bbb-process
- (save-excursion
- (set-buffer (process-buffer bbb-process))
- (bbb-send-command bbb-process (concat "logout " grouplens-bbb-token))
- (bbb-read-response bbb-process))))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Get Predictions
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun bbb-build-mid-scores-alist (groupname)
- "this function can be called as part of the function to return the list of score files to use.
-See the gnus variable `gnus-score-find-score-files-function'.
-
-*Note:* If you want to use grouplens scores along with calculated scores,
-you should see the offset and scale variables. At this point, I don't
-recommend using both scores and grouplens predictions together."
- (setq grouplens-current-group groupname)
- (when (member groupname grouplens-newsgroups)
- (setq grouplens-previous-article nil)
- ;; scores-alist should be a list of lists:
- ;; ((("message-id" ("<mid1>" score1 nil s) ("<mid2> score2 nil s))))
- ;;`((("message-id" . ,predict-list))) ; Yes, this is the return value
- (list
- (list
- (list (append (list "message-id")
- (bbb-get-predictions (bbb-get-all-mids) groupname)))))))
-
-(defun bbb-get-predictions (midlist groupname)
- "Ask the bbb for predictions, and build up the score alist."
- (gnus-message 5 "Fetching Predictions...")
- (if grouplens-bbb-token
- (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
- grouplens-bbb-port)))
- (when bbb-process
- (save-excursion
- (set-buffer (process-buffer bbb-process))
- (bbb-send-command bbb-process
- (bbb-build-predict-command midlist groupname
- grouplens-bbb-token))
- (if (bbb-read-response bbb-process)
- (bbb-get-prediction-response bbb-process)
- (gnus-message 1 "Invalid Token, login and try again")
- (ding)))))
- (gnus-message 3 "Error: You are not logged in to a BBB")
- (ding)))
-
-(defun bbb-get-all-mids ()
- (mapcar (function (lambda (x) (mail-header-id x))) gnus-newsgroup-headers))
-
-(defun bbb-build-predict-command (mlist grpname token)
- (concat "getpredictions " token " " grpname "\r\n"
- (mapconcat 'identity mlist "\r\n") "\r\n.\r\n"))
-
-(defun bbb-get-prediction-response (process)
- (let ((case-fold-search nil))
- (goto-char bbb-read-point)
- (while (and (not (search-forward ".\r\n" nil t))
- (accept-process-output process bbb-timeout-secs))
- (goto-char bbb-read-point))
- (goto-char (+ bbb-response-point 4));; we ought to be right before OK
- (bbb-build-response-alist)))
-
-;; build-response-alist assumes that the cursor has been positioned at
-;; the first line of the list of mid/rating pairs.
-(defun bbb-build-response-alist ()
- (let (resp mid pred)
- (while
- (cond
- ((looking-at "\\(<.*>\\) :nopred=")
- ;;(push `(,(bbb-get-mid) ,gnus-summary-default-score nil s) resp)
- (forward-line 1)
- t)
- ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\) :conflow=\\([0-9]\.[0-9][0-9]\\) :confhigh=\\([0-9]\.[0-9][0-9]\\)")
- (setq mid (bbb-get-mid)
- pred (bbb-get-pred))
- (push `(,mid ,pred nil s) resp)
- (gnus-sethash mid (list pred (bbb-get-confl) (bbb-get-confh))
- grouplens-current-hashtable)
- (forward-line 1)
- t)
- ((looking-at "\\(<.*>\\) :pred=\\([0-9]\.[0-9][0-9]\\)")
- (setq mid (bbb-get-mid)
- pred (bbb-get-pred))
- (push `(,mid ,pred nil s) resp)
- (gnus-sethash mid (list pred 0 0) grouplens-current-hashtable)
- (forward-line 1)
- t)
- (t nil)))
- resp))
-
-;; these "get" functions assume that there is an active match lying
-;; around. Where the first parenthesized expression is the
-;; message-id, and the second is the prediction, the third and fourth
-;; are the confidence interval
-;;
-;; Since gnus assumes that scores are integer values?? we round the
-;; prediction.
-(defun bbb-get-mid ()
- (buffer-substring (match-beginning 1) (match-end 1)))
-
-(defun bbb-get-pred ()
- (let ((tpred (string-to-number (buffer-substring (match-beginning 2)
- (match-end 2)))))
- (if (> tpred 0)
- (round (* grouplens-score-scale-factor
- (+ grouplens-score-offset tpred)))
- 1)))
-
-(defun bbb-get-confl ()
- (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
-
-(defun bbb-get-confh ()
- (string-to-number (buffer-substring (match-beginning 4) (match-end 4))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Prediction Display
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defconst grplens-rating-range 4.0)
-(defconst grplens-maxrating 5)
-(defconst grplens-minrating 1)
-(defconst grplens-predstringsize 12)
-
-(defvar gnus-tmp-score)
-(defun bbb-grouplens-score (header)
- (if (eq gnus-grouplens-override-scoring 'separate)
- (bbb-grouplens-other-score header)
- (let* ((rate-string (make-string 12 ?\ ))
- (mid (mail-header-id header))
- (hashent (gnus-gethash mid grouplens-current-hashtable))
- (iscore gnus-tmp-score)
- (low (car (cdr hashent)))
- (high (car (cdr (cdr hashent)))))
- (aset rate-string 0 ?|)
- (aset rate-string 11 ?|)
- (unless (member grouplens-current-group grouplens-newsgroups)
- (unless (equal grouplens-prediction-display 'prediction-num)
- (cond ((< iscore 0)
- (setq iscore 1))
- ((> iscore 5)
- (setq iscore 5))))
- (setq low 0)
- (setq high 0))
- (if (and (bbb-valid-score iscore)
- (not (null mid)))
- (cond
- ;; prediction-spot
- ((equal grouplens-prediction-display 'prediction-spot)
- (setq rate-string (bbb-fmt-prediction-spot rate-string iscore)))
- ;; confidence-interval
- ((equal grouplens-prediction-display 'confidence-interval)
- (setq rate-string (bbb-fmt-confidence-interval iscore low high)))
- ;; prediction-bar
- ((equal grouplens-prediction-display 'prediction-bar)
- (setq rate-string (bbb-fmt-prediction-bar rate-string iscore)))
- ;; confidence-bar
- ((equal grouplens-prediction-display 'confidence-bar)
- (setq rate-string (format "| %4.2f |" iscore)))
- ;; confidence-spot
- ((equal grouplens-prediction-display 'confidence-spot)
- (setq rate-string (format "| %4.2f |" iscore)))
- ;; prediction-num
- ((equal grouplens-prediction-display 'prediction-num)
- (setq rate-string (bbb-fmt-prediction-num iscore)))
- ;; confidence-plus-minus
- ((equal grouplens-prediction-display 'confidence-plus-minus)
- (setq rate-string (bbb-fmt-confidence-plus-minus iscore low high))
- )
- (t (gnus-message 3 "Invalid prediction display type")))
- (aset rate-string 5 ?N) (aset rate-string 6 ?A))
- rate-string)))
-
-;; Gnus user format function that doesn't depend on
-;; bbb-build-mid-scores-alist being used as the score function, but is
-;; instead called from gnus-select-group-hook. -- LAB
-(defun bbb-grouplens-other-score (header)
- (if (not (member grouplens-current-group grouplens-newsgroups))
- ;; Return an empty string
- ""
- (let* ((rate-string (make-string 12 ?\ ))
- (mid (mail-header-id header))
- (hashent (gnus-gethash mid grouplens-current-hashtable))
- (pred (or (nth 0 hashent) 0))
- (low (nth 1 hashent))
- (high (nth 2 hashent)))
- ;; Init rate-string
- (aset rate-string 0 ?|)
- (aset rate-string 11 ?|)
- (unless (equal grouplens-prediction-display 'prediction-num)
- (cond ((< pred 0)
- (setq pred 1))
- ((> pred 5)
- (setq pred 5))))
- ;; If no entry in BBB hash mark rate string as NA and return
- (cond
- ((null hashent)
- (aset rate-string 5 ?N)
- (aset rate-string 6 ?A)
- rate-string)
-
- ((equal grouplens-prediction-display 'prediction-spot)
- (bbb-fmt-prediction-spot rate-string pred))
-
- ((equal grouplens-prediction-display 'confidence-interval)
- (bbb-fmt-confidence-interval pred low high))
-
- ((equal grouplens-prediction-display 'prediction-bar)
- (bbb-fmt-prediction-bar rate-string pred))
-
- ((equal grouplens-prediction-display 'confidence-bar)
- (format "| %4.2f |" pred))
-
- ((equal grouplens-prediction-display 'confidence-spot)
- (format "| %4.2f |" pred))
-
- ((equal grouplens-prediction-display 'prediction-num)
- (bbb-fmt-prediction-num pred))
-
- ((equal grouplens-prediction-display 'confidence-plus-minus)
- (bbb-fmt-confidence-plus-minus pred low high))
-
- (t
- (gnus-message 3 "Invalid prediction display type")
- (aset rate-string 0 ?|)
- (aset rate-string 11 ?|)
- rate-string)))))
-
-(defun bbb-valid-score (score)
- (or (equal grouplens-prediction-display 'prediction-num)
- (and (>= score grplens-minrating)
- (<= score grplens-maxrating))))
-
-(defun bbb-requires-confidence (format-type)
- (or (equal format-type 'confidence-plus-minus)
- (equal format-type 'confidence-spot)
- (equal format-type 'confidence-interval)))
-
-(defun bbb-have-confidence (clow chigh)
- (not (or (null clow)
- (null chigh))))
-
-(defun bbb-fmt-prediction-spot (rate-string score)
- (aset rate-string
- (round (* (/ (- score grplens-minrating) grplens-rating-range)
- (+ (- grplens-predstringsize 4) 1.49)))
- ?*)
- rate-string)
-
-(defun bbb-fmt-confidence-interval (score low high)
- (if (bbb-have-confidence low high)
- (format "|%4.2f-%4.2f |" low high)
- (bbb-fmt-prediction-num score)))
-
-(defun bbb-fmt-confidence-plus-minus (score low high)
- (if (bbb-have-confidence low high)
- (format "|%3.1f+/-%4.2f|" score (/ (- high low) 2.0))
- (bbb-fmt-prediction-num score)))
-
-(defun bbb-fmt-prediction-bar (rate-string score)
- (let* ((i 1)
- (step (/ grplens-rating-range (- grplens-predstringsize 4)))
- (half-step (/ step 2))
- (loc (- grplens-minrating half-step)))
- (while (< i (- grplens-predstringsize 2))
- (if (> score loc)
- (aset rate-string i ?#)
- (aset rate-string i ?\ ))
- (setq i (+ i 1))
- (setq loc (+ loc step)))
- )
- rate-string)
-
-(defun bbb-fmt-prediction-num (score)
- (format "| %4.2f |" score))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;; Put Ratings
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun bbb-put-ratings ()
- (if (and grouplens-bbb-token
- grouplens-rating-alist
- (member gnus-newsgroup-name grouplens-newsgroups))
- (let ((bbb-process (bbb-connect-to-bbbd grouplens-bbb-host
- grouplens-bbb-port))
- (rate-command (bbb-build-rate-command grouplens-rating-alist)))
- (if bbb-process
- (save-excursion
- (set-buffer (process-buffer bbb-process))
- (gnus-message 5 "Sending Ratings...")
- (bbb-send-command bbb-process rate-command)
- (if (bbb-read-response bbb-process)
- (setq grouplens-rating-alist nil)
- (gnus-message 1
- "Token timed out: call bbb-login and quit again")
- (ding))
- (gnus-message 5 "Sending Ratings...Done"))
- (gnus-message 3 "No BBB connection")))
- (setq grouplens-rating-alist nil)))
-
-(defun bbb-build-rate-command (rate-alist)
- (concat "putratings " grouplens-bbb-token " " grouplens-current-group " \r\n"
- (mapconcat (lambda (this) ; form (mid . (score . time))
- (concat (car this)
- " :rating=" (cadr this) ".00"
- " :time=" (cddr this)))
- rate-alist "\r\n")
- "\r\n.\r\n"))
-
-;; Interactive rating functions.
-(defun bbb-summary-rate-article (rating &optional midin)
- (interactive "nRating: ")
- (when (member gnus-newsgroup-name grouplens-newsgroups)
- (let ((mid (or midin (bbb-get-current-id))))
- (if (and rating
- (>= rating grplens-minrating)
- (<= rating grplens-maxrating)
- mid)
- (let ((oldrating (assoc mid grouplens-rating-alist)))
- (if oldrating
- (setcdr oldrating (cons rating 0))
- (push `(,mid . (,rating . 0)) grouplens-rating-alist))
- (gnus-summary-mark-article nil (int-to-string rating)))
- (gnus-message 3 "Invalid rating")))))
-
-(defun grouplens-next-unread-article (rating)
- "Select unread article after current one."
- (interactive "P")
- (when rating
- (bbb-summary-rate-article rating))
- (gnus-summary-next-unread-article))
-
-(defun grouplens-best-unread-article (rating)
- "Select unread article after current one."
- (interactive "P")
- (when rating
- (bbb-summary-rate-article rating))
- (gnus-summary-best-unread-article))
-
-(defun grouplens-summary-catchup-and-exit (rating)
- "Mark all articles not marked as unread in this newsgroup as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read."
- (interactive "P")
- (when rating
- (bbb-summary-rate-article rating))
- (if (numberp rating)
- (gnus-summary-catchup-and-exit)
- (gnus-summary-catchup-and-exit rating)))
-
-(defun grouplens-score-thread (score)
- "Raise the score of the articles in the current thread with SCORE."
- (interactive "nRating: ")
- (let (e)
- (save-excursion
- (let ((articles (gnus-summary-articles-in-thread))
- article)
- (while (setq article (pop articles))
- (gnus-summary-goto-subject article)
- (bbb-summary-rate-article score
- (mail-header-id
- (gnus-summary-article-header article)))))
- (setq e (point)))
- (let ((gnus-summary-check-current t))
- (or (zerop (gnus-summary-next-subject 1 t))
- (goto-char e))))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary))
-
-(defun bbb-exit-group ()
- (bbb-put-ratings)
- (bbb-renew-hash-table))
-
-(defun bbb-get-current-id ()
- (if gnus-current-headers
- (mail-header-id gnus-current-headers)
- (gnus-message 3 "You must select an article before you rate it")))
-
-(defun bbb-grouplens-group-p (group)
- "Say whether GROUP is a GroupLens group."
- (if (member group grouplens-newsgroups) " (GroupLens Enhanced)" ""))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; TIME SPENT READING
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defvar grouplens-current-starting-time nil)
-
-(defun grouplens-start-timer ()
- (setq grouplens-current-starting-time (current-time)))
-
-(defun grouplens-elapsed-time ()
- (let ((et (bbb-time-float (current-time))))
- (- et (bbb-time-float grouplens-current-starting-time))))
-
-(defun bbb-time-float (timeval)
- (+ (* (car timeval) 65536)
- (cadr timeval)))
-
-(defun grouplens-do-time ()
- (when (member gnus-newsgroup-name grouplens-newsgroups)
- (when grouplens-previous-article
- (let ((elapsed-time (grouplens-elapsed-time))
- (oldrating (assoc grouplens-previous-article
- grouplens-rating-alist)))
- (if (not oldrating)
- (push `(,grouplens-previous-article . (0 . ,elapsed-time))
- grouplens-rating-alist)
- (setcdr oldrating (cons (cadr oldrating) elapsed-time)))))
- (grouplens-start-timer)
- (setq grouplens-previous-article (bbb-get-current-id))))
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; BUG REPORTING
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defconst gnus-gl-version "gnus-gl.el 2.50")
-(defconst gnus-gl-maintainer-address "grouplens-bug@cs.umn.edu")
-(defun gnus-gl-submit-bug-report ()
- "Submit via mail a bug report on gnus-gl."
- (interactive)
- (require 'reporter)
- (reporter-submit-bug-report gnus-gl-maintainer-address
- (concat "gnus-gl.el " gnus-gl-version)
- (list 'grouplens-pseudonym
- 'grouplens-bbb-host
- 'grouplens-bbb-port
- 'grouplens-newsgroups
- 'grouplens-bbb-token
- 'grouplens-bbb-process
- 'grouplens-current-group
- 'grouplens-previous-article)
- nil
- 'gnus-gl-get-trace))
-
-(defun gnus-gl-get-trace ()
- "Insert the contents of the BBBD trace buffer."
- (when grouplens-bbb-buffer
- (insert-buffer-substring grouplens-bbb-buffer)))
-
-;;
-;; GroupLens minor mode
-;;
-
-(defvar gnus-grouplens-mode nil
- "Minor mode for providing a GroupLens interface in Gnus summary buffers.")
-
-(defvar gnus-grouplens-mode-map nil)
-
-(unless gnus-grouplens-mode-map
- (setq gnus-grouplens-mode-map (make-keymap))
- (gnus-define-keys
- gnus-grouplens-mode-map
- "n" grouplens-next-unread-article
- "r" bbb-summary-rate-article
- "k" grouplens-score-thread
- "c" grouplens-summary-catchup-and-exit
- "," grouplens-best-unread-article))
-
-(defun gnus-grouplens-make-menu-bar ()
- (unless (boundp 'gnus-grouplens-menu)
- (easy-menu-define
- gnus-grouplens-menu gnus-grouplens-mode-map ""
- '("GroupLens"
- ["Login" bbb-login t]
- ["Rate" bbb-summary-rate-article t]
- ["Next article" grouplens-next-unread-article t]
- ["Best article" grouplens-best-unread-article t]
- ["Raise thread" grouplens-score-thread t]
- ["Report bugs" gnus-gl-submit-bug-report t]))))
-
-(defun gnus-grouplens-mode (&optional arg)
- "Minor mode for providing a GroupLens interface in Gnus summary buffers."
- (interactive "P")
- (when (and (eq major-mode 'gnus-summary-mode)
- (member gnus-newsgroup-name grouplens-newsgroups))
- (make-local-variable 'gnus-grouplens-mode)
- (setq gnus-grouplens-mode
- (if (null arg) (not gnus-grouplens-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-grouplens-mode
- (gnus-make-local-hook 'gnus-select-article-hook)
- (add-hook 'gnus-select-article-hook 'grouplens-do-time nil 'local)
- (gnus-make-local-hook 'gnus-exit-group-hook)
- (add-hook 'gnus-exit-group-hook 'bbb-exit-group nil 'local)
- (make-local-variable 'gnus-score-find-score-files-function)
-
- (cond
- ((eq gnus-grouplens-override-scoring 'combine)
- ;; either add bbb-buld-mid-scores-alist to a list
- ;; or make a list
- (if (listp gnus-score-find-score-files-function)
- (setq gnus-score-find-score-files-function
- (append 'bbb-build-mid-scores-alist
- gnus-score-find-score-files-function))
- (setq gnus-score-find-score-files-function
- (list gnus-score-find-score-files-function
- 'bbb-build-mid-scores-alist))))
- ;; leave the gnus-score-find-score-files variable alone
- ((eq gnus-grouplens-override-scoring 'separate)
- (add-hook 'gnus-select-group-hook
- (lambda ()
- (bbb-get-predictions (bbb-get-all-mids)
- gnus-newsgroup-name))))
- ;; default is to override
- (t
- (setq gnus-score-find-score-files-function
- 'bbb-build-mid-scores-alist)))
-
- ;; Change how summary lines look
- (make-local-variable 'gnus-summary-line-format)
- (make-local-variable 'gnus-summary-line-format-spec)
- (setq gnus-summary-line-format gnus-summary-grouplens-line-format)
- (setq gnus-summary-line-format-spec nil)
- (gnus-update-format-specifications nil 'summary)
- (gnus-update-summary-mark-positions)
-
- ;; Set up the menu.
- (when (and menu-bar-mode
- (gnus-visual-p 'grouplens-menu 'menu))
- (gnus-grouplens-make-menu-bar))
- (gnus-add-minor-mode
- 'gnus-grouplens-mode " GroupLens" gnus-grouplens-mode-map)
- (gnus-run-hooks 'gnus-grouplens-mode-hook))))
-
-(provide 'gnus-gl)
-
-;;; arch-tag: 6f1bab2c-c2a3-4764-9ef6-0714cd5902a4
-;;; gnus-gl.el ends here
+++ /dev/null
-;;; gnus-group.el --- group mode commands for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (defvar tool-bar-mode))
-
-(require 'gnus)
-(require 'gnus-start)
-(require 'nnmail)
-(require 'gnus-spec)
-(require 'gnus-int)
-(require 'gnus-range)
-(require 'gnus-win)
-(require 'gnus-undo)
-(require 'gmm-utils)
-(require 'time-date)
-(require 'gnus-ems)
-
-(eval-when-compile
- (require 'mm-url)
- (let ((features (cons 'gnus-group features)))
- (require 'gnus-sum))
- (defvar gnus-cache-active-hashtb))
-
-(defcustom gnus-group-archive-directory
- "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list/"
- "*The address of the (ding) archives."
- :group 'gnus-group-foreign
- :type 'directory)
-
-(defcustom gnus-group-recent-archive-directory
- "/ftp@ftp.hpc.uh.edu:/pub/emacs/ding-list-recent/"
- "*The address of the most recent (ding) articles."
- :group 'gnus-group-foreign
- :type 'directory)
-
-(defcustom gnus-no-groups-message "No gnus is bad news"
- "*Message displayed by Gnus when no groups are available."
- :group 'gnus-start
- :type 'string)
-
-(defcustom gnus-keep-same-level nil
- "*Non-nil means that the next newsgroup after the current will be on the same level.
-When you type, for instance, `n' after reading the last article in the
-current newsgroup, you will go to the next newsgroup. If this variable
-is nil, the next newsgroup will be the next from the group
-buffer.
-If this variable is non-nil, Gnus will either put you in the
-next newsgroup with the same level, or, if no such newsgroup is
-available, the next newsgroup with the lowest possible level higher
-than the current level.
-If this variable is `best', Gnus will make the next newsgroup the one
-with the best level."
- :group 'gnus-group-levels
- :type '(choice (const nil)
- (const best)
- (sexp :tag "other" t)))
-
-(defcustom gnus-group-goto-unread t
- "*If non-nil, movement commands will go to the next unread and subscribed group."
- :link '(custom-manual "(gnus)Group Maneuvering")
- :group 'gnus-group-various
- :type 'boolean)
-
-(defcustom gnus-goto-next-group-when-activating t
- "*If non-nil, the \\<gnus-group-mode-map>\\[gnus-group-get-new-news-this-group] command will advance point to the next group."
- :link '(custom-manual "(gnus)Scanning New Messages")
- :group 'gnus-group-various
- :type 'boolean)
-
-(defcustom gnus-permanently-visible-groups nil
- "*Regexp to match groups that should always be listed in the group buffer.
-This means that they will still be listed even when there are no
-unread articles in the groups.
-
-If nil, no groups are permanently visible."
- :group 'gnus-group-listing
- :type '(choice regexp (const nil)))
-
-(defcustom gnus-list-groups-with-ticked-articles t
- "*If non-nil, list groups that have only ticked articles.
-If nil, only list groups that have unread articles."
- :group 'gnus-group-listing
- :type 'boolean)
-
-(defcustom gnus-group-default-list-level gnus-level-subscribed
- "*Default listing level.
-Ignored if `gnus-group-use-permanent-levels' is non-nil."
- :group 'gnus-group-listing
- :type 'integer)
-
-(defcustom gnus-group-list-inactive-groups t
- "*If non-nil, inactive groups will be listed."
- :group 'gnus-group-listing
- :group 'gnus-group-levels
- :type 'boolean)
-
-(defcustom gnus-group-sort-function 'gnus-group-sort-by-alphabet
- "*Function used for sorting the group buffer.
-This function will be called with group info entries as the arguments
-for the groups to be sorted. Pre-made functions include
-`gnus-group-sort-by-alphabet', `gnus-group-sort-by-real-name',
-`gnus-group-sort-by-unread', `gnus-group-sort-by-level',
-`gnus-group-sort-by-score', `gnus-group-sort-by-method',
-`gnus-group-sort-by-server', and `gnus-group-sort-by-rank'.
-
-This variable can also be a list of sorting functions. In that case,
-the most significant sort function should be the last function in the
-list."
- :group 'gnus-group-listing
- :link '(custom-manual "(gnus)Sorting Groups")
- :type '(repeat :value-to-internal (lambda (widget value)
- (if (listp value) value (list value)))
- :match (lambda (widget value)
- (or (symbolp value)
- (widget-editable-list-match widget value)))
- (choice (function-item gnus-group-sort-by-alphabet)
- (function-item gnus-group-sort-by-real-name)
- (function-item gnus-group-sort-by-unread)
- (function-item gnus-group-sort-by-level)
- (function-item gnus-group-sort-by-score)
- (function-item gnus-group-sort-by-method)
- (function-item gnus-group-sort-by-server)
- (function-item gnus-group-sort-by-rank)
- (function :tag "other" nil))))
-
-(defcustom gnus-group-line-format "%M\%S\%p\%P\%5y:%B%(%g%)%l %O\n"
- "*Format of group lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%M Only marked articles (character, \"*\" or \" \")
-%S Whether the group is subscribed (character, \"U\", \"K\", \"Z\" or \" \")
-%L Level of subscribedness (integer)
-%N Number of unread articles (integer)
-%I Number of dormant articles (integer)
-%i Number of ticked and dormant (integer)
-%T Number of ticked articles (integer)
-%R Number of read articles (integer)
-%U Number of unseen articles (integer)
-%t Estimated total number of articles (integer)
-%y Number of unread, unticked articles (integer)
-%G Group name (string)
-%g Qualified group name (string)
-%c Short (collapsed) group name. See `gnus-group-uncollapsed-levels'.
-%C Group comment (string)
-%D Group description (string)
-%s Select method (string)
-%o Moderated group (char, \"m\")
-%p Process mark (char)
-%B Whether a summary buffer for the group is open (char, \"*\")
-%O Moderated group (string, \"(m)\" or \"\")
-%P Topic indentation (string)
-%m Whether there is new(ish) mail in the group (char, \"%\")
-%l Whether there are GroupLens predictions for this group (string)
-%n Select from where (string)
-%z A string that look like `<%s:%n>' if a foreign select method is used
-%d The date the group was last entered.
-%E Icon as defined by `gnus-group-icon-list'.
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed a
- single dummy parameter as argument. The function should return a
- string, which will be inserted into the buffer just like information
- from any other group specifier.
-
-Note that this format specification is not always respected. For
-reasons of efficiency, when listing killed groups, this specification
-is ignored altogether. If the spec is changed considerably, your
-output may end up looking strange when listing both alive and killed
-groups.
-
-If you use %o or %O, reading the active file will be slower and quite
-a bit of extra memory will be used. %D will also worsen performance.
-Also note that if you change the format specification to include any
-of these specs, you must probably re-start Gnus to see them go into
-effect.
-
-General format specifiers can also be used.
-See Info node `(gnus)Formatting Variables'."
- :link '(custom-manual "(gnus)Formatting Variables")
- :group 'gnus-group-visual
- :type 'string)
-
-(defcustom gnus-group-mode-line-format "Gnus: %%b {%M\%:%S}"
- "*The format specification for the group mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%S The native news server.
-%M The native select method.
-%: \":\" if %S isn't \"\"."
- :group 'gnus-group-visual
- :type 'string)
-
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-group-mode-hook 'gnus-xmas-group-menu-add)
- (add-hook 'gnus-group-mode-hook 'gnus-xmas-setup-group-toolbar))
-
-(defcustom gnus-group-menu-hook nil
- "Hook run after the creation of the group mode menu."
- :group 'gnus-group-various
- :type 'hook)
-
-(defcustom gnus-group-catchup-group-hook nil
- "Hook run when catching up a group from the group buffer."
- :group 'gnus-group-various
- :link '(custom-manual "(gnus)Group Data")
- :type 'hook)
-
-(defcustom gnus-group-update-group-hook nil
- "Hook called when updating group lines."
- :group 'gnus-group-visual
- :type 'hook)
-
-(defcustom gnus-group-prepare-function 'gnus-group-prepare-flat
- "*A function that is called to generate the group buffer.
-The function is called with three arguments: The first is a number;
-all group with a level less or equal to that number should be listed,
-if the second is non-nil, empty groups should also be displayed. If
-the third is non-nil, it is a number. No groups with a level lower
-than this number should be displayed.
-
-The only current function implemented is `gnus-group-prepare-flat'."
- :group 'gnus-group-listing
- :type 'function)
-
-(defcustom gnus-group-prepare-hook nil
- "Hook called after the group buffer has been generated.
-If you want to modify the group buffer, you can use this hook."
- :group 'gnus-group-listing
- :type 'hook)
-
-(defcustom gnus-suspend-gnus-hook nil
- "Hook called when suspending (not exiting) Gnus."
- :group 'gnus-exit
- :type 'hook)
-
-(defcustom gnus-exit-gnus-hook nil
- "Hook called when exiting Gnus."
- :group 'gnus-exit
- :type 'hook)
-
-(defcustom gnus-after-exiting-gnus-hook nil
- "Hook called after exiting Gnus."
- :group 'gnus-exit
- :type 'hook)
-
-(defcustom gnus-group-update-hook '(gnus-group-highlight-line)
- "Hook called when a group line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-group-highlight-line' will
-highlight the line according to the `gnus-group-highlight'
-variable."
- :group 'gnus-group-visual
- :type 'hook)
-
-(defcustom gnus-useful-groups
- '(("(ding) mailing list mirrored at gmane.org"
- "gmane.emacs.gnus.general"
- (nntp "Gmane"
- (nntp-address "news.gmane.org")))
- ("Gnus bug archive"
- "gnus.gnus-bug"
- (nntp "news.gnus.org"
- (nntp-address "news.gnus.org")))
- ("Local Gnus help group"
- "gnus-help"
- (nndoc "gnus-help"
- (nndoc-article-type mbox)
- (eval `(nndoc-address
- ,(let ((file (nnheader-find-etc-directory
- "gnus-tut.txt" t)))
- (unless file
- (error "Couldn't find doc group"))
- file))))))
- "*Alist of useful group-server pairs."
- :group 'gnus-group-listing
- :type '(repeat (list (string :tag "Description")
- (string :tag "Name")
- (sexp :tag "Method"))))
-
-(defcustom gnus-group-highlight
- '(;; Mail.
- ((and mailp (= unread 0) (eq level 1)) .
- gnus-group-mail-1-empty)
- ((and mailp (eq level 1)) .
- gnus-group-mail-1)
- ((and mailp (= unread 0) (eq level 2)) .
- gnus-group-mail-2-empty)
- ((and mailp (eq level 2)) .
- gnus-group-mail-2)
- ((and mailp (= unread 0) (eq level 3)) .
- gnus-group-mail-3-empty)
- ((and mailp (eq level 3)) .
- gnus-group-mail-3)
- ((and mailp (= unread 0)) .
- gnus-group-mail-low-empty)
- ((and mailp) .
- gnus-group-mail-low)
- ;; News.
- ((and (= unread 0) (eq level 1)) .
- gnus-group-news-1-empty)
- ((and (eq level 1)) .
- gnus-group-news-1)
- ((and (= unread 0) (eq level 2)) .
- gnus-group-news-2-empty)
- ((and (eq level 2)) .
- gnus-group-news-2)
- ((and (= unread 0) (eq level 3)) .
- gnus-group-news-3-empty)
- ((and (eq level 3)) .
- gnus-group-news-3)
- ((and (= unread 0) (eq level 4)) .
- gnus-group-news-4-empty)
- ((and (eq level 4)) .
- gnus-group-news-4)
- ((and (= unread 0) (eq level 5)) .
- gnus-group-news-5-empty)
- ((and (eq level 5)) .
- gnus-group-news-5)
- ((and (= unread 0) (eq level 6)) .
- gnus-group-news-6-empty)
- ((and (eq level 6)) .
- gnus-group-news-6)
- ((and (= unread 0)) .
- gnus-group-news-low-empty)
- (t .
- gnus-group-news-low))
- "*Controls the highlighting of group buffer lines.
-
-Below is a list of `Form'/`Face' pairs. When deciding how a a
-particular group line should be displayed, each form is
-evaluated. The content of the face field after the first true form is
-used. You can change how those group lines are displayed by
-editing the face field.
-
-It is also possible to change and add form fields, but currently that
-requires an understanding of Lisp expressions. Hopefully this will
-change in a future release. For now, you can use the following
-variables in the Lisp expression:
-
-group: The name of the group.
-unread: The number of unread articles in the group.
-method: The select method used.
-mailp: Whether it's a mail group or not.
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles."
- :group 'gnus-group-visual
- :type '(repeat (cons (sexp :tag "Form") face)))
-(put 'gnus-group-highlight 'risky-local-variable t)
-
-(defcustom gnus-new-mail-mark ?%
- "Mark used for groups with new mail."
- :group 'gnus-group-visual
- :type 'character)
-
-(defgroup gnus-group-icons nil
- "Add Icons to your group buffer."
- :group 'gnus-group-visual)
-
-(defcustom gnus-group-icon-list
- nil
- "*Controls the insertion of icons into group buffer lines.
-
-Below is a list of `Form'/`File' pairs. When deciding how a
-particular group line should be displayed, each form is evaluated.
-The icon from the file field after the first true form is used. You
-can change how those group lines are displayed by editing the file
-field. The File will either be found in the
-`gnus-group-glyph-directory' or by designating absolute name of the
-file.
-
-It is also possible to change and add form fields, but currently that
-requires an understanding of Lisp expressions. Hopefully this will
-change in a future release. For now, you can use the following
-variables in the Lisp expression:
-
-group: The name of the group.
-unread: The number of unread articles in the group.
-method: The select method used.
-mailp: Whether it's a mail group or not.
-newsp: Whether it's a news group or not
-level: The level of the group.
-score: The score of the group.
-ticked: The number of ticked articles."
- :group 'gnus-group-icons
- :type '(repeat (cons (sexp :tag "Form") file)))
-(put 'gnus-group-icon-list 'risky-local-variable t)
-
-(defcustom gnus-group-name-charset-method-alist nil
- "Alist of method and the charset for group names.
-
-For example:
- (((nntp \"news.com.cn\") . cn-gb-2312))"
- :version "21.1"
- :group 'gnus-charset
- :type '(repeat (cons (sexp :tag "Method") (symbol :tag "Charset"))))
-
-(defcustom gnus-group-name-charset-group-alist
- (if (or (and (fboundp 'find-coding-system) (find-coding-system 'utf-8))
- (mm-coding-system-p 'utf-8))
- '((".*" . utf-8))
- nil)
- "Alist of group regexp and the charset for group names.
-
-For example:
- ((\"\\.com\\.cn:\" . cn-gb-2312))"
- :group 'gnus-charset
- :type '(repeat (cons (regexp :tag "Group") (symbol :tag "Charset"))))
-
-(defcustom gnus-group-jump-to-group-prompt nil
- "Default prompt for `gnus-group-jump-to-group'.
-If non-nil, the value should be a string, e.g. \"nnml:\",
-in which case `gnus-group-jump-to-group' offers \"Group: nnml:\"
-in the minibuffer prompt."
- :version "22.1"
- :group 'gnus-group-various
- :type '(choice (string :tag "Prompt string")
- (const :tag "Empty" nil)))
-
-(defvar gnus-group-listing-limit 1000
- "*A limit of the number of groups when listing.
-If the number of groups is larger than the limit, list them in a
-simple manner.")
-
-;;; Internal variables
-
-(defvar gnus-group-is-exiting-p nil)
-(defvar gnus-group-is-exiting-without-update-p nil)
-(defvar gnus-group-sort-alist-function 'gnus-group-sort-flat
- "Function for sorting the group buffer.")
-
-(defvar gnus-group-sort-selected-function 'gnus-group-sort-selected-flat
- "Function for sorting the selected groups in the group buffer.")
-
-(defvar gnus-group-indentation-function nil)
-(defvar gnus-goto-missing-group-function nil)
-(defvar gnus-group-update-group-function nil)
-(defvar gnus-group-goto-next-group-function nil
- "Function to override finding the next group after listing groups.")
-
-(defvar gnus-group-edit-buffer nil)
-
-(defvar gnus-group-line-format-alist
- `((?M gnus-tmp-marked-mark ?c)
- (?S gnus-tmp-subscribed ?c)
- (?L gnus-tmp-level ?d)
- (?N (cond ((eq number t) "*" )
- ((numberp number)
- (int-to-string
- (+ number
- (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))))))
- (t number)) ?s)
- (?R gnus-tmp-number-of-read ?s)
- (?U (gnus-number-of-unseen-articles-in-group gnus-tmp-group) ?d)
- (?t gnus-tmp-number-total ?d)
- (?y gnus-tmp-number-of-unread ?s)
- (?I (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked))) ?d)
- (?T (gnus-range-length (cdr (assq 'tick gnus-tmp-marked))) ?d)
- (?i (+ (gnus-range-length (cdr (assq 'dormant gnus-tmp-marked)))
- (gnus-range-length (cdr (assq 'tick gnus-tmp-marked)))) ?d)
- (?g (if (boundp 'gnus-tmp-decoded-group)
- gnus-tmp-decoded-group
- gnus-tmp-group)
- ?s)
- (?G gnus-tmp-qualified-group ?s)
- (?c (gnus-short-group-name (if (boundp 'gnus-tmp-decoded-group)
- gnus-tmp-decoded-group
- gnus-tmp-group))
- ?s)
- (?C gnus-tmp-comment ?s)
- (?D gnus-tmp-newsgroup-description ?s)
- (?o gnus-tmp-moderated ?c)
- (?O gnus-tmp-moderated-string ?s)
- (?p gnus-tmp-process-marked ?c)
- (?s gnus-tmp-news-server ?s)
- (?n ,(if (featurep 'xemacs)
- '(symbol-name gnus-tmp-news-method)
- 'gnus-tmp-news-method)
- ?s)
- (?P gnus-group-indentation ?s)
- (?E gnus-tmp-group-icon ?s)
- (?B gnus-tmp-summary-live ?c)
- (?l gnus-tmp-grouplens ?s)
- (?z gnus-tmp-news-method-string ?s)
- (?m (gnus-group-new-mail gnus-tmp-group) ?c)
- (?d (gnus-group-timestamp-string gnus-tmp-group) ?s)
- (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-group-mode-line-format-alist
- `((?S gnus-tmp-news-server ?s)
- (?M gnus-tmp-news-method ?s)
- (?u gnus-tmp-user-defined ?s)
- (?: gnus-tmp-colon ?s)))
-
-(defvar gnus-topic-topology nil
- "The complete topic hierarchy.")
-
-(defvar gnus-topic-alist nil
- "The complete topic-group alist.")
-
-(defvar gnus-group-marked nil)
-
-(defvar gnus-group-list-mode nil)
-
-
-(defvar gnus-group-icon-cache nil)
-
-(defvar gnus-group-listed-groups nil)
-(defvar gnus-group-list-option nil)
-
-;;;
-;;; Gnus group mode
-;;;
-
-(put 'gnus-group-mode 'mode-class 'special)
-
-(gnus-define-keys gnus-group-mode-map
- " " gnus-group-read-group
- "=" gnus-group-select-group
- "\r" gnus-group-select-group
- "\M-\r" gnus-group-quick-select-group
- "\M- " gnus-group-visible-select-group
- [(meta control return)] gnus-group-select-group-ephemerally
- "j" gnus-group-jump-to-group
- "n" gnus-group-next-unread-group
- "p" gnus-group-prev-unread-group
- "\177" gnus-group-prev-unread-group
- [delete] gnus-group-prev-unread-group
- [backspace] gnus-group-prev-unread-group
- "N" gnus-group-next-group
- "P" gnus-group-prev-group
- "\M-n" gnus-group-next-unread-group-same-level
- "\M-p" gnus-group-prev-unread-group-same-level
- "," gnus-group-best-unread-group
- "." gnus-group-first-unread-group
- "u" gnus-group-unsubscribe-current-group
- "U" gnus-group-unsubscribe-group
- "c" gnus-group-catchup-current
- "C" gnus-group-catchup-current-all
- "\M-c" gnus-group-clear-data
- "l" gnus-group-list-groups
- "L" gnus-group-list-all-groups
- "m" gnus-group-mail
- "i" gnus-group-news
- "g" gnus-group-get-new-news
- "\M-g" gnus-group-get-new-news-this-group
- "R" gnus-group-restart
- "r" gnus-group-read-init-file
- "B" gnus-group-browse-foreign-server
- "b" gnus-group-check-bogus-groups
- "F" gnus-group-find-new-groups
- "\C-c\C-d" gnus-group-describe-group
- "\M-d" gnus-group-describe-all-groups
- "\C-c\C-a" gnus-group-apropos
- "\C-c\M-\C-a" gnus-group-description-apropos
- "a" gnus-group-post-news
- "\ek" gnus-group-edit-local-kill
- "\eK" gnus-group-edit-global-kill
- "\C-k" gnus-group-kill-group
- "\C-y" gnus-group-yank-group
- "\C-w" gnus-group-kill-region
- "\C-x\C-t" gnus-group-transpose-groups
- "\C-c\C-l" gnus-group-list-killed
- "\C-c\C-x" gnus-group-expire-articles
- "\C-c\M-\C-x" gnus-group-expire-all-groups
- "V" gnus-version
- "s" gnus-group-save-newsrc
- "z" gnus-group-suspend
- "q" gnus-group-exit
- "Q" gnus-group-quit
- "?" gnus-group-describe-briefly
- "\C-c\C-i" gnus-info-find-node
- "\M-e" gnus-group-edit-group-method
- "^" gnus-group-enter-server-mode
- gnus-mouse-2 gnus-mouse-pick-group
- [follow-link] mouse-face
- "<" beginning-of-buffer
- ">" end-of-buffer
- "\C-c\C-b" gnus-bug
- "\C-c\C-s" gnus-group-sort-groups
- "t" gnus-topic-mode
- "\C-c\M-g" gnus-activate-all-groups
- "\M-&" gnus-group-universal-argument
- "#" gnus-group-mark-group
- "\M-#" gnus-group-unmark-group)
-
-(gnus-define-keys (gnus-group-mark-map "M" gnus-group-mode-map)
- "m" gnus-group-mark-group
- "u" gnus-group-unmark-group
- "w" gnus-group-mark-region
- "b" gnus-group-mark-buffer
- "r" gnus-group-mark-regexp
- "U" gnus-group-unmark-all-groups)
-
-(gnus-define-keys (gnus-group-sieve-map "D" gnus-group-mode-map)
- "u" gnus-sieve-update
- "g" gnus-sieve-generate)
-
-(gnus-define-keys (gnus-group-group-map "G" gnus-group-mode-map)
- "d" gnus-group-make-directory-group
- "h" gnus-group-make-help-group
- "u" gnus-group-make-useful-group
- "a" gnus-group-make-archive-group
- "k" gnus-group-make-kiboze-group
- "l" gnus-group-nnimap-edit-acl
- "m" gnus-group-make-group
- "E" gnus-group-edit-group
- "e" gnus-group-edit-group-method
- "p" gnus-group-edit-group-parameters
- "v" gnus-group-add-to-virtual
- "V" gnus-group-make-empty-virtual
- "D" gnus-group-enter-directory
- "f" gnus-group-make-doc-group
- "w" gnus-group-make-web-group
- "M" gnus-group-read-ephemeral-group
- "r" gnus-group-rename-group
- "R" gnus-group-make-rss-group
- "c" gnus-group-customize
- "x" gnus-group-nnimap-expunge
- "\177" gnus-group-delete-group
- [delete] gnus-group-delete-group)
-
-(gnus-define-keys (gnus-group-soup-map "s" gnus-group-group-map)
- "b" gnus-group-brew-soup
- "w" gnus-soup-save-areas
- "s" gnus-soup-send-replies
- "p" gnus-soup-pack-packet
- "r" nnsoup-pack-replies)
-
-(gnus-define-keys (gnus-group-sort-map "S" gnus-group-group-map)
- "s" gnus-group-sort-groups
- "a" gnus-group-sort-groups-by-alphabet
- "u" gnus-group-sort-groups-by-unread
- "l" gnus-group-sort-groups-by-level
- "v" gnus-group-sort-groups-by-score
- "r" gnus-group-sort-groups-by-rank
- "m" gnus-group-sort-groups-by-method
- "n" gnus-group-sort-groups-by-real-name)
-
-(gnus-define-keys (gnus-group-sort-selected-map "P" gnus-group-group-map)
- "s" gnus-group-sort-selected-groups
- "a" gnus-group-sort-selected-groups-by-alphabet
- "u" gnus-group-sort-selected-groups-by-unread
- "l" gnus-group-sort-selected-groups-by-level
- "v" gnus-group-sort-selected-groups-by-score
- "r" gnus-group-sort-selected-groups-by-rank
- "m" gnus-group-sort-selected-groups-by-method
- "n" gnus-group-sort-selected-groups-by-real-name)
-
-(gnus-define-keys (gnus-group-list-map "A" gnus-group-mode-map)
- "k" gnus-group-list-killed
- "z" gnus-group-list-zombies
- "s" gnus-group-list-groups
- "u" gnus-group-list-all-groups
- "A" gnus-group-list-active
- "a" gnus-group-apropos
- "d" gnus-group-description-apropos
- "m" gnus-group-list-matching
- "M" gnus-group-list-all-matching
- "l" gnus-group-list-level
- "c" gnus-group-list-cached
- "?" gnus-group-list-dormant)
-
-(gnus-define-keys (gnus-group-list-limit-map "/" gnus-group-list-map)
- "k" gnus-group-list-limit
- "z" gnus-group-list-limit
- "s" gnus-group-list-limit
- "u" gnus-group-list-limit
- "A" gnus-group-list-limit
- "m" gnus-group-list-limit
- "M" gnus-group-list-limit
- "l" gnus-group-list-limit
- "c" gnus-group-list-limit
- "?" gnus-group-list-limit)
-
-(gnus-define-keys (gnus-group-list-flush-map "f" gnus-group-list-map)
- "k" gnus-group-list-flush
- "z" gnus-group-list-flush
- "s" gnus-group-list-flush
- "u" gnus-group-list-flush
- "A" gnus-group-list-flush
- "m" gnus-group-list-flush
- "M" gnus-group-list-flush
- "l" gnus-group-list-flush
- "c" gnus-group-list-flush
- "?" gnus-group-list-flush)
-
-(gnus-define-keys (gnus-group-list-plus-map "p" gnus-group-list-map)
- "k" gnus-group-list-plus
- "z" gnus-group-list-plus
- "s" gnus-group-list-plus
- "u" gnus-group-list-plus
- "A" gnus-group-list-plus
- "m" gnus-group-list-plus
- "M" gnus-group-list-plus
- "l" gnus-group-list-plus
- "c" gnus-group-list-plus
- "?" gnus-group-list-plus)
-
-(gnus-define-keys (gnus-group-score-map "W" gnus-group-mode-map)
- "f" gnus-score-flush-cache)
-
-(gnus-define-keys (gnus-group-help-map "H" gnus-group-mode-map)
- "c" gnus-group-fetch-charter
- "C" gnus-group-fetch-control
- "d" gnus-group-describe-group
- "f" gnus-group-fetch-faq
- "v" gnus-version)
-
-(gnus-define-keys (gnus-group-sub-map "S" gnus-group-mode-map)
- "l" gnus-group-set-current-level
- "t" gnus-group-unsubscribe-current-group
- "s" gnus-group-unsubscribe-group
- "k" gnus-group-kill-group
- "y" gnus-group-yank-group
- "w" gnus-group-kill-region
- "\C-k" gnus-group-kill-level
- "z" gnus-group-kill-all-zombies)
-
-(defun gnus-topic-mode-p ()
- "Return non-nil in `gnus-topic-mode'."
- (and (boundp 'gnus-topic-mode)
- (symbol-value 'gnus-topic-mode)))
-
-(defun gnus-group-make-menu-bar ()
- (gnus-turn-off-edit-menu 'group)
- (unless (boundp 'gnus-group-reading-menu)
-
- (easy-menu-define
- gnus-group-reading-menu gnus-group-mode-map ""
- `("Group"
- ["Read" gnus-group-read-group
- :included (not (gnus-topic-mode-p))
- :active (gnus-group-group-name)]
- ["Read " gnus-topic-read-group
- :included (gnus-topic-mode-p)]
- ["Select" gnus-group-select-group
- :included (not (gnus-topic-mode-p))
- :active (gnus-group-group-name)]
- ["Select " gnus-topic-select-group
- :included (gnus-topic-mode-p)]
- ["See old articles" (gnus-group-select-group 'all)
- :keys "C-u SPC" :active (gnus-group-group-name)]
- ["Catch up" gnus-group-catchup-current
- :included (not (gnus-topic-mode-p))
- :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark unread articles in the current group as read"))]
- ["Catch up " gnus-topic-catchup-articles
- :included (gnus-topic-mode-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark unread articles in the current group or topic as read"))]
- ["Catch up all articles" gnus-group-catchup-current-all
- (gnus-group-group-name)]
- ["Check for new articles" gnus-group-get-new-news-this-group
- :included (not (gnus-topic-mode-p))
- :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Check for new messages in current group"))]
- ["Check for new articles " gnus-topic-get-new-news-this-topic
- :included (gnus-topic-mode-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Check for new messages in current group or topic"))]
- ["Toggle subscription" gnus-group-unsubscribe-current-group
- (gnus-group-group-name)]
- ["Kill" gnus-group-kill-group :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Kill (remove) current group"))]
- ["Yank" gnus-group-yank-group gnus-list-of-killed-groups]
- ["Describe" gnus-group-describe-group :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Display description of the current group"))]
- ["Fetch FAQ" gnus-group-fetch-faq (gnus-group-group-name)]
- ["Fetch charter" gnus-group-fetch-charter
- :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the charter of the current group"))]
- ["Fetch control message" gnus-group-fetch-control
- :active (gnus-group-group-name)
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the archived control message for the current group"))]
- ;; Actually one should check, if any of the marked groups gives t for
- ;; (gnus-check-backend-function 'request-expire-articles ...)
- ["Expire articles" gnus-group-expire-articles
- :included (not (gnus-topic-mode-p))
- :active (or (and (gnus-group-group-name)
- (gnus-check-backend-function
- 'request-expire-articles
- (gnus-group-group-name))) gnus-group-marked)]
- ["Expire articles " gnus-topic-expire-articles
- :included (gnus-topic-mode-p)]
- ["Set group level..." gnus-group-set-current-level
- (gnus-group-group-name)]
- ["Select quick" gnus-group-quick-select-group (gnus-group-group-name)]
- ["Customize" gnus-group-customize (gnus-group-group-name)]
- ("Edit"
- ["Parameters" gnus-group-edit-group-parameters
- :included (not (gnus-topic-mode-p))
- :active (gnus-group-group-name)]
- ["Parameters " gnus-topic-edit-parameters
- :included (gnus-topic-mode-p)]
- ["Select method" gnus-group-edit-group-method
- (gnus-group-group-name)]
- ["Info" gnus-group-edit-group (gnus-group-group-name)]
- ["Local kill file" gnus-group-edit-local-kill (gnus-group-group-name)]
- ["Global kill file" gnus-group-edit-global-kill t])))
-
- (easy-menu-define
- gnus-group-group-menu gnus-group-mode-map ""
- '("Groups"
- ("Listing"
- ["List unread subscribed groups" gnus-group-list-groups t]
- ["List (un)subscribed groups" gnus-group-list-all-groups t]
- ["List killed groups" gnus-group-list-killed gnus-killed-list]
- ["List zombie groups" gnus-group-list-zombies gnus-zombie-list]
- ["List level..." gnus-group-list-level t]
- ["Describe all groups" gnus-group-describe-all-groups t]
- ["Group apropos..." gnus-group-apropos t]
- ["Group and description apropos..." gnus-group-description-apropos t]
- ["List groups matching..." gnus-group-list-matching t]
- ["List all groups matching..." gnus-group-list-all-matching t]
- ["List active file" gnus-group-list-active t]
- ["List groups with cached" gnus-group-list-cached t]
- ["List groups with dormant" gnus-group-list-dormant t])
- ("Sort"
- ["Default sort" gnus-group-sort-groups t]
- ["Sort by method" gnus-group-sort-groups-by-method t]
- ["Sort by rank" gnus-group-sort-groups-by-rank t]
- ["Sort by score" gnus-group-sort-groups-by-score t]
- ["Sort by level" gnus-group-sort-groups-by-level t]
- ["Sort by unread" gnus-group-sort-groups-by-unread t]
- ["Sort by name" gnus-group-sort-groups-by-alphabet t]
- ["Sort by real name" gnus-group-sort-groups-by-real-name t])
- ("Sort process/prefixed"
- ["Default sort" gnus-group-sort-selected-groups
- (not (gnus-topic-mode-p))]
- ["Sort by method" gnus-group-sort-selected-groups-by-method
- (not (gnus-topic-mode-p))]
- ["Sort by rank" gnus-group-sort-selected-groups-by-rank
- (not (gnus-topic-mode-p))]
- ["Sort by score" gnus-group-sort-selected-groups-by-score
- (not (gnus-topic-mode-p))]
- ["Sort by level" gnus-group-sort-selected-groups-by-level
- (not (gnus-topic-mode-p))]
- ["Sort by unread" gnus-group-sort-selected-groups-by-unread
- (not (gnus-topic-mode-p))]
- ["Sort by name" gnus-group-sort-selected-groups-by-alphabet
- (not (gnus-topic-mode-p))]
- ["Sort by real name" gnus-group-sort-selected-groups-by-real-name
- (not (gnus-topic-mode-p))])
- ("Mark"
- ["Mark group" gnus-group-mark-group
- (and (gnus-group-group-name)
- (not (memq (gnus-group-group-name) gnus-group-marked)))]
- ["Unmark group" gnus-group-unmark-group
- (and (gnus-group-group-name)
- (memq (gnus-group-group-name) gnus-group-marked))]
- ["Unmark all" gnus-group-unmark-all-groups gnus-group-marked]
- ["Mark regexp..." gnus-group-mark-regexp t]
- ["Mark region" gnus-group-mark-region :active (gnus-mark-active-p)]
- ["Mark buffer" gnus-group-mark-buffer t]
- ["Execute command" gnus-group-universal-argument
- (or gnus-group-marked (gnus-group-group-name))])
- ("Subscribe"
- ["Subscribe to a group..." gnus-group-unsubscribe-group t]
- ["Kill all newsgroups in region" gnus-group-kill-region
- :active (gnus-mark-active-p)]
- ["Kill all zombie groups" gnus-group-kill-all-zombies
- gnus-zombie-list]
- ["Kill all groups on level..." gnus-group-kill-level t])
- ("Foreign groups"
- ["Make a foreign group..." gnus-group-make-group t]
- ["Add a directory group..." gnus-group-make-directory-group t]
- ["Add the help group" gnus-group-make-help-group t]
- ["Add the archive group" gnus-group-make-archive-group t]
- ["Make a doc group..." gnus-group-make-doc-group t]
- ["Make a web group..." gnus-group-make-web-group t]
- ["Make a kiboze group..." gnus-group-make-kiboze-group t]
- ["Make a virtual group..." gnus-group-make-empty-virtual t]
- ["Add a group to a virtual..." gnus-group-add-to-virtual t]
- ["Make an ephemeral group..." gnus-group-read-ephemeral-group t]
- ["Make an RSS group..." gnus-group-make-rss-group t]
- ["Rename group..." gnus-group-rename-group
- (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))]
- ["Delete group" gnus-group-delete-group
- (gnus-check-backend-function
- 'request-delete-group (gnus-group-group-name))])
- ("Move"
- ["Next" gnus-group-next-group t]
- ["Previous" gnus-group-prev-group t]
- ["Next unread" gnus-group-next-unread-group t]
- ["Previous unread" gnus-group-prev-unread-group t]
- ["Next unread same level" gnus-group-next-unread-group-same-level t]
- ["Previous unread same level"
- gnus-group-prev-unread-group-same-level t]
- ["Jump to group..." gnus-group-jump-to-group t]
- ["First unread group" gnus-group-first-unread-group t]
- ["Best unread group" gnus-group-best-unread-group t])
- ("Sieve"
- ["Generate" gnus-sieve-generate t]
- ["Generate and update" gnus-sieve-update t])
- ["Delete bogus groups" gnus-group-check-bogus-groups t]
- ["Find new newsgroups" gnus-group-find-new-groups t]
- ["Transpose" gnus-group-transpose-groups
- (gnus-group-group-name)]
- ["Read a directory as a group..." gnus-group-enter-directory t]))
-
- (easy-menu-define
- gnus-group-misc-menu gnus-group-mode-map ""
- `("Gnus"
- ("SOUP"
- ["Pack replies" nnsoup-pack-replies (fboundp 'nnsoup-request-group)]
- ["Send replies" gnus-soup-send-replies
- (fboundp 'gnus-soup-pack-packet)]
- ["Pack packet" gnus-soup-pack-packet (fboundp 'gnus-soup-pack-packet)]
- ["Save areas" gnus-soup-save-areas (fboundp 'gnus-soup-pack-packet)]
- ["Brew SOUP" gnus-group-brew-soup (fboundp 'gnus-soup-pack-packet)])
- ["Send a mail" gnus-group-mail t]
- ["Send a message (mail or news)" gnus-group-post-news t]
- ["Create a local message" gnus-group-news t]
- ["Check for new news" gnus-group-get-new-news
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Get newly arrived articles"))
- ]
- ["Send queued messages" gnus-delay-send-queue
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Send all messages that are scheduled to be sent now"))
- ]
- ["Activate all groups" gnus-activate-all-groups t]
- ["Restart Gnus" gnus-group-restart t]
- ["Read init file" gnus-group-read-init-file t]
- ["Browse foreign server..." gnus-group-browse-foreign-server t]
- ["Enter server buffer" gnus-group-enter-server-mode t]
- ["Expire all expirable articles" gnus-group-expire-all-groups t]
- ["Generate any kiboze groups" nnkiboze-generate-groups t]
- ["Gnus version" gnus-version t]
- ["Save .newsrc files" gnus-group-save-newsrc t]
- ["Suspend Gnus" gnus-group-suspend t]
- ["Clear dribble buffer" gnus-group-clear-dribble t]
- ["Read manual" gnus-info-find-node t]
- ["Flush score cache" gnus-score-flush-cache t]
- ["Toggle topics" gnus-topic-mode t]
- ["Send a bug report" gnus-bug t]
- ["Exit from Gnus" gnus-group-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Quit reading news"))]
- ["Exit without saving" gnus-group-quit t]))
-
- (gnus-run-hooks 'gnus-group-menu-hook)))
-
-
-(defvar gnus-group-tool-bar-map nil)
-
-(defun gnus-group-tool-bar-update (&optional symbol value)
- "Update group buffer toolbar.
-Setter function for custom variables."
- (when symbol
- (set-default symbol value))
- ;; (setq-default gnus-group-tool-bar-map nil)
- ;; (use-local-map gnus-group-mode-map)
- (when (gnus-alive-p)
- (with-current-buffer gnus-group-buffer
- (gnus-group-make-tool-bar t))))
-
-(defcustom gnus-group-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'gnus-group-tool-bar-gnome
- 'gnus-group-tool-bar-retro)
- "Specifies the Gnus group tool bar.
-
-It can be either a list or a symbol refering to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `gnus-group-mode-map'.
-
-Pre-defined symbols include `gnus-group-tool-bar-gnome' and
-`gnus-group-tool-bar-retro'."
- :type '(choice (const :tag "GNOME style" gnus-group-tool-bar-gnome)
- (const :tag "Retro look" gnus-group-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
-
-(defcustom gnus-group-tool-bar-gnome
- '((gnus-group-post-news "mail/compose")
- ;; Some useful agent icons? I don't use the agent so agent users should
- ;; suggest useful commands:
- (gnus-agent-toggle-plugged "disconnect" t
- :help "Gnus is currently unplugged. Click to work online."
- :visible (and gnus-agent (not gnus-plugged)))
- (gnus-agent-toggle-plugged "connect" t
- :help "Gnus is currently plugged. Click to work offline."
- :visible (and gnus-agent gnus-plugged))
- ;; FIXME: gnus-agent-toggle-plugged (in gnus-agent-group-make-menu-bar)
- ;; should have a better help text.
- (gnus-group-send-queue "mail/outbox" t
- :visible (and gnus-agent gnus-plugged)
- :help "Send articles from the queue group")
- (gnus-group-get-new-news "mail/inbox" nil
- :visible (or (not gnus-agent)
- gnus-plugged))
- ;; FIXME: gnus-*-read-group should have a better help text.
- (gnus-topic-read-group "open" nil
- :visible (and (boundp 'gnus-topic-mode)
- gnus-topic-mode))
- (gnus-group-read-group "open" nil
- :visible (not (and (boundp 'gnus-topic-mode)
- gnus-topic-mode)))
- ;; (gnus-group-find-new-groups "???" nil)
- (gnus-group-save-newsrc "save")
- (gnus-group-describe-group "describe")
- (gnus-group-unsubscribe-current-group "gnus/toggle-subscription")
- (gnus-group-prev-unread-group "left-arrow")
- (gnus-group-next-unread-group "right-arrow")
- (gnus-group-exit "exit")
- (gmm-customize-mode "preferences" t :help "Edit mode preferences")
- (gnus-info-find-node "help"))
- "List of functions for the group tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
-
-(defcustom gnus-group-tool-bar-retro
- '((gnus-group-get-new-news "gnus/get-news")
- (gnus-group-get-new-news-this-group "gnus/gnntg")
- (gnus-group-catchup-current "gnus/catchup")
- (gnus-group-describe-group "gnus/describe-group")
- (gnus-group-subscribe "gnus/subscribe" t
- :help "Subscribe to the current group")
- (gnus-group-unsubscribe "gnus/unsubscribe" t
- :help "Unsubscribe from the current group")
- (gnus-group-exit "gnus/exit-gnus" gnus-group-mode-map))
- "List of functions for the group tool bar (retro look).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
-
-(defcustom gnus-group-tool-bar-zap-list t
- "List of icon items from the global tool bar.
-These items are not displayed in the Gnus group mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-group-tool-bar-update
- :group 'gnus-group)
-
-(defvar image-load-path)
-
-(defun gnus-group-make-tool-bar (&optional force)
- "Make a group mode tool bar from `gnus-group-tool-bar'.
-When FORCE, rebuild the tool bar."
- (when (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
- tool-bar-mode
- ;; The Gnus 5.10.6 code checked (default-value 'tool-bar-mode).
- ;; Why? --rsteib
- (or (not gnus-group-tool-bar-map) force))
- (let* ((load-path
- (gmm-image-load-path-for-library "gnus"
- "gnus/toggle-subscription.xpm"
- nil t))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path)))
- (map (gmm-tool-bar-from-list gnus-group-tool-bar
- gnus-group-tool-bar-zap-list
- 'gnus-group-mode-map)))
- (if map
- (set (make-local-variable 'tool-bar-map) map))))
- gnus-group-tool-bar-map)
-
-(defun gnus-group-mode ()
- "Major mode for reading news.
-
-All normal editing commands are switched off.
-\\<gnus-group-mode-map>
-The group buffer lists (some of) the groups available. For instance,
-`\\[gnus-group-list-groups]' will list all subscribed groups with unread articles, while `\\[gnus-group-list-zombies]'
-lists all zombie groups.
-
-Groups that are displayed can be entered with `\\[gnus-group-read-group]'. To subscribe
-to a group not displayed, type `\\[gnus-group-unsubscribe-group]'.
-
-For more in-depth information on this mode, read the manual (`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-group-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (when (gnus-visual-p 'group-menu 'menu)
- (gnus-group-make-menu-bar)
- (gnus-group-make-tool-bar))
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-group-mode)
- (setq mode-name "Group")
- (gnus-group-set-mode-line)
- (setq mode-line-process nil)
- (use-local-map gnus-group-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (gnus-set-default-directory)
- (gnus-update-format-specifications nil 'group 'group-mode)
- (gnus-update-group-mark-positions)
- (when gnus-use-undo
- (gnus-undo-mode 1))
- (when gnus-slave
- (gnus-slave-mode))
- (gnus-run-mode-hooks 'gnus-group-mode-hook))
-
-(defun gnus-update-group-mark-positions ()
- (save-excursion
- (let ((gnus-process-mark ?\200)
- (gnus-group-update-hook nil)
- (gnus-group-marked '("dummy.group"))
- (gnus-active-hashtb (make-vector 10 0))
- (topic ""))
- (gnus-set-active "dummy.group" '(0 . 0))
- (gnus-set-work-buffer)
- (gnus-group-insert-group-line "dummy.group" 0 nil 0 nil)
- (goto-char (point-min))
- (setq gnus-group-mark-positions
- (list (cons 'process (and (search-forward
- (mm-string-as-multibyte "\200") nil t)
- (- (point) 2))))))))
-
-(defun gnus-mouse-pick-group (e)
- "Enter the group under the mouse pointer."
- (interactive "e")
- (mouse-set-point e)
- (gnus-group-read-group nil))
-
-;; Look at LEVEL and find out what the level is really supposed to be.
-;; If LEVEL is non-nil, LEVEL will be returned, if not, what happens
-;; will depend on whether `gnus-group-use-permanent-levels' is used.
-(defun gnus-group-default-level (&optional level number-or-nil)
- (cond
- (gnus-group-use-permanent-levels
- (or (setq gnus-group-use-permanent-levels
- (or level (if (numberp gnus-group-use-permanent-levels)
- gnus-group-use-permanent-levels
- (or gnus-group-default-list-level
- gnus-level-subscribed))))
- gnus-group-default-list-level gnus-level-subscribed))
- (number-or-nil
- level)
- (t
- (or level gnus-group-default-list-level gnus-level-subscribed))))
-
-(defun gnus-group-setup-buffer ()
- (set-buffer (gnus-get-buffer-create gnus-group-buffer))
- (unless (eq major-mode 'gnus-group-mode)
- (gnus-group-mode)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'group))))
-
-(defun gnus-group-name-charset (method group)
- (if (null method)
- (setq method (gnus-find-method-for-group group)))
- (let ((item (assoc method gnus-group-name-charset-method-alist))
- (alist gnus-group-name-charset-group-alist)
- result)
- (if item
- (cdr item)
- (while (setq item (pop alist))
- (if (string-match (car item) group)
- (setq alist nil
- result (cdr item))))
- result)))
-
-(defun gnus-group-name-decode (string charset)
- ;; Fixme: Don't decode in unibyte mode.
- (if (and string charset (featurep 'mule))
- (mm-decode-coding-string string charset)
- string))
-
-(defun gnus-group-decoded-name (string)
- (let ((charset (gnus-group-name-charset nil string)))
- (gnus-group-name-decode string charset)))
-
-(defun gnus-group-list-groups (&optional level unread lowest)
- "List newsgroups with level LEVEL or lower that have unread articles.
-Default is all subscribed groups.
-If argument UNREAD is non-nil, groups with no unread articles are also
-listed.
-
-Also see the `gnus-group-use-permanent-levels' variable."
- (interactive
- (list (if current-prefix-arg
- (prefix-numeric-value current-prefix-arg)
- (or
- (gnus-group-default-level nil t)
- gnus-group-default-list-level
- gnus-level-subscribed))))
- (unless level
- (setq level (car gnus-group-list-mode)
- unread (cdr gnus-group-list-mode)))
- (setq level (gnus-group-default-level level))
- (gnus-group-setup-buffer)
- (gnus-update-format-specifications nil 'group 'group-mode)
- (let ((case-fold-search nil)
- (props (text-properties-at (gnus-point-at-bol)))
- (empty (= (point-min) (point-max)))
- (group (gnus-group-group-name))
- number)
- (set-buffer gnus-group-buffer)
- (setq number (funcall gnus-group-prepare-function level unread lowest))
- (when (or (and (numberp number)
- (zerop number))
- (zerop (buffer-size)))
- ;; No groups in the buffer.
- (gnus-message 5 gnus-no-groups-message))
- ;; We have some groups displayed.
- (goto-char (point-max))
- (when (or (not gnus-group-goto-next-group-function)
- (not (funcall gnus-group-goto-next-group-function
- group props)))
- (cond
- (empty
- (goto-char (point-min)))
- ((not group)
- ;; Go to the first group with unread articles.
- (gnus-group-search-forward t))
- (t
- ;; Find the right group to put point on. If the current group
- ;; has disappeared in the new listing, try to find the next
- ;; one. If no next one can be found, just leave point at the
- ;; first newsgroup in the buffer.
- (when (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe
- group gnus-active-hashtb))))
- (let ((newsrc (cdddr (gnus-gethash group gnus-newsrc-hashtb))))
- (while (and newsrc
- (not (gnus-goto-char
- (text-property-any
- (point-min) (point-max) 'gnus-group
- (gnus-intern-safe
- (caar newsrc) gnus-active-hashtb)))))
- (setq newsrc (cdr newsrc)))
- (unless newsrc
- (goto-char (point-max))
- (forward-line -1)))))))
- ;; Adjust cursor point.
- (gnus-group-position-point)))
-
-(defun gnus-group-list-level (level &optional all)
- "List groups on LEVEL.
-If ALL (the prefix), also list groups that have no unread articles."
- (interactive "nList groups on level: \nP")
- (gnus-group-list-groups level all level))
-
-(defun gnus-group-prepare-logic (group test)
- (or (and gnus-group-listed-groups
- (null gnus-group-list-option)
- (member group gnus-group-listed-groups))
- (cond
- ((null gnus-group-listed-groups) test)
- ((null gnus-group-list-option) test)
- (t (and (member group gnus-group-listed-groups)
- (if (eq gnus-group-list-option 'flush)
- (not test)
- test))))))
-
-(defun gnus-group-prepare-flat (level &optional predicate lowest regexp)
- "List all newsgroups with unread articles of level LEVEL or lower.
-If PREDICATE is a function, list groups that the function returns non-nil;
-if it is t, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher.
-If REGEXP is a function, list dead groups that the function returns non-nil;
-if it is a string, only list groups matching REGEXP."
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
- (newsrc (cdr gnus-newsrc-alist))
- (lowest (or lowest 1))
- (not-in-list (and gnus-group-listed-groups
- (copy-sequence gnus-group-listed-groups)))
- info clevel unread group params)
- (erase-buffer)
- (when (or (< lowest gnus-level-zombie)
- gnus-group-listed-groups)
- ;; List living groups.
- (while newsrc
- (setq info (car newsrc)
- group (gnus-info-group info)
- params (gnus-info-params info)
- newsrc (cdr newsrc)
- unread (car (gnus-gethash group gnus-newsrc-hashtb)))
- (when not-in-list
- (setq not-in-list (delete group not-in-list)))
- (when (gnus-group-prepare-logic
- group
- (and unread ; This group might be unchecked
- (or (not (stringp regexp))
- (string-match regexp group))
- (<= (setq clevel (gnus-info-level info)) level)
- (>= clevel lowest)
- (cond
- ((functionp predicate)
- (funcall predicate info))
- (predicate t) ; We list all groups?
- (t
- (or
- (if (eq unread t) ; Unactivated?
- gnus-group-list-inactive-groups
- ; We list unactivated
- (> unread 0))
- ; We list groups with unread articles
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
- ; And groups with tickeds
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups
- group))
- (memq 'visible params)
- (cdr (assq 'visible params)))))))
- (gnus-group-insert-group-line
- group (gnus-info-level info)
- (gnus-info-marks info) unread (gnus-info-method info)))))
-
- ;; List dead groups.
- (when (or gnus-group-listed-groups
- (and (>= level gnus-level-zombie)
- (<= lowest gnus-level-zombie)))
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
- (when not-in-list
- (dolist (group gnus-zombie-list)
- (setq not-in-list (delete group not-in-list))))
- (when (or gnus-group-listed-groups
- (and (>= level gnus-level-killed) (<= lowest gnus-level-killed)))
- (gnus-group-prepare-flat-list-dead
- (gnus-union
- not-in-list
- (setq gnus-killed-list (sort gnus-killed-list 'string<)))
- gnus-level-killed ?K regexp))
-
- (gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level predicate))
- (gnus-run-hooks 'gnus-group-prepare-hook)
- t))
-
-(defun gnus-group-prepare-flat-list-dead (groups level mark regexp)
- ;; List zombies and killed lists somewhat faster, which was
- ;; suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>. It does
- ;; this by ignoring the group format specification altogether.
- (let (group)
- (if (> (length groups) gnus-group-listing-limit)
- (while groups
- (setq group (pop groups))
- (when (gnus-group-prepare-logic
- group
- (or (not regexp)
- (and (stringp regexp) (string-match regexp group))
- (and (functionp regexp) (funcall regexp group))))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " " mark " *: "
- (gnus-group-decoded-name group)
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level level))))
- (while groups
- (setq group (pop groups))
- (when (gnus-group-prepare-logic
- group
- (or (not regexp)
- (and (stringp regexp) (string-match regexp group))
- (and (functionp regexp) (funcall regexp group))))
- (gnus-group-insert-group-line
- group level nil
- (let ((active (gnus-active group)))
- (if active
- (if (zerop (cdr active))
- 0
- (- (1+ (cdr active)) (car active)))
- nil))
- (gnus-method-simplify (gnus-find-method-for-group group))))))))
-
-(defun gnus-group-update-group-line ()
- "Update the current line in the group buffer."
- (let* ((buffer-read-only nil)
- (group (gnus-group-group-name))
- (entry (and group (gnus-gethash group gnus-newsrc-hashtb)))
- gnus-group-indentation)
- (when group
- (and entry
- (not (gnus-ephemeral-group-p group))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (nth 2 entry))
- ")")))
- (setq gnus-group-indentation (gnus-group-group-indentation))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (forward-line -1)
- (gnus-group-position-point))))
-
-(defun gnus-group-insert-group-line-info (group)
- "Insert GROUP on the current line."
- (let ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (gnus-group-indentation (gnus-group-group-indentation))
- active info)
- (if entry
- (progn
- ;; (Un)subscribed group.
- (setq info (nth 2 entry))
- (gnus-group-insert-group-line
- group (gnus-info-level info) (gnus-info-marks info)
- (or (car entry) t) (gnus-info-method info)))
- ;; This group is dead.
- (gnus-group-insert-group-line
- group
- (if (member group gnus-zombie-list) gnus-level-zombie gnus-level-killed)
- nil
- (if (setq active (gnus-active group))
- (if (zerop (cdr active))
- 0
- (- (1+ (cdr active)) (car active)))
- nil)
- (gnus-method-simplify (gnus-find-method-for-group group))))))
-
-(defun gnus-number-of-unseen-articles-in-group (group)
- (let* ((info (nth 2 (gnus-group-entry group)))
- (marked (gnus-info-marks info))
- (seen (cdr (assq 'seen marked)))
- (active (gnus-active group)))
- (if (not active)
- 0
- (length (gnus-uncompress-range
- (gnus-range-difference
- (gnus-range-difference (list active) (gnus-info-read info))
- seen))))))
-
-;; Moving through the Group buffer (in topic mode) e.g. with C-n doesn't
-;; update the state (enabled/disabled) of the icon `gnus-group-describe-group'
-;; automatically. After `C-l' the state is correct. See the following report
-;; on emacs-devel
-;; <http://thread.gmane.org/v9acdmrcse.fsf@marauder.physik.uni-ulm.de>:
-;; From: Reiner Steib
-;; Subject: tool bar icons not updated according to :active condition
-;; Newsgroups: gmane.emacs.devel
-;; Date: Mon, 23 Jan 2006 19:59:13 +0100
-;; Message-ID: <v9acdmrcse.fsf@marauder.physik.uni-ulm.de>
-
-(defcustom gnus-group-update-tool-bar
- (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
- tool-bar-mode
- ;; Using `redraw-frame' (see `gnus-tool-bar-update') in Emacs 21 might
- ;; be confusing, so maybe we shouldn't call it by default.
- (fboundp 'force-window-update))
- "Force updating the group buffer tool bar."
- :group 'gnus-group
- :version "22.1"
- :initialize 'custom-initialize-default
- :set (lambda (symbol value)
- (set-default symbol value)
- (when (gnus-alive-p)
- (with-current-buffer gnus-group-buffer
- ;; FIXME: Is there a better way to redraw the group buffer?
- (gnus-group-get-new-news 0))))
- :type 'boolean)
-
-(defun gnus-group-insert-group-line (gnus-tmp-group gnus-tmp-level
- gnus-tmp-marked number
- gnus-tmp-method)
- "Insert a group line in the group buffer."
- (let* ((gnus-tmp-method
- (gnus-server-get-method gnus-tmp-group gnus-tmp-method))
- (group-name-charset (gnus-group-name-charset gnus-tmp-method
- gnus-tmp-group))
- (gnus-tmp-active (gnus-active gnus-tmp-group))
- (gnus-tmp-number-total
- (if gnus-tmp-active
- (1+ (- (cdr gnus-tmp-active) (car gnus-tmp-active)))
- 0))
- (gnus-tmp-number-of-unread
- (if (numberp number) (int-to-string (max 0 number))
- "*"))
- (gnus-tmp-number-of-read
- (if (numberp number)
- (int-to-string (max 0 (- gnus-tmp-number-total number)))
- "*"))
- (gnus-tmp-subscribed
- (cond ((<= gnus-tmp-level gnus-level-subscribed) ? )
- ((<= gnus-tmp-level gnus-level-unsubscribed) ?U)
- ((= gnus-tmp-level gnus-level-zombie) ?Z)
- (t ?K)))
- (gnus-tmp-qualified-group
- (gnus-group-name-decode (gnus-group-real-name gnus-tmp-group)
- group-name-charset))
- (gnus-tmp-comment
- (or (gnus-group-get-parameter gnus-tmp-group 'comment t)
- gnus-tmp-group))
- (gnus-tmp-newsgroup-description
- (if gnus-description-hashtb
- (or (gnus-group-name-decode
- (gnus-gethash gnus-tmp-group gnus-description-hashtb)
- group-name-charset) "")
- ""))
- (gnus-tmp-moderated
- (if (and gnus-moderated-hashtb
- (gnus-gethash gnus-tmp-group gnus-moderated-hashtb))
- ?m ? ))
- (gnus-tmp-moderated-string
- (if (eq gnus-tmp-moderated ?m) "(m)" ""))
- (gnus-tmp-group-icon "==&&==")
- (gnus-tmp-news-server (or (cadr gnus-tmp-method) ""))
- (gnus-tmp-news-method (or (car gnus-tmp-method) ""))
- (gnus-tmp-news-method-string
- (if gnus-tmp-method
- (format "(%s:%s)" (car gnus-tmp-method)
- (cadr gnus-tmp-method)) ""))
- (gnus-tmp-marked-mark
- (if (and (numberp number)
- (zerop number)
- (cdr (assq 'tick gnus-tmp-marked)))
- ?* ? ))
- (gnus-tmp-summary-live
- (if (and (not gnus-group-is-exiting-p)
- (gnus-buffer-live-p (gnus-summary-buffer-name
- gnus-tmp-group)))
- ?* ? ))
- (gnus-tmp-process-marked
- (if (member gnus-tmp-group gnus-group-marked)
- gnus-process-mark ? ))
- (gnus-tmp-grouplens
- (or (and gnus-use-grouplens
- (bbb-grouplens-group-p gnus-tmp-group))
- ""))
- (buffer-read-only nil)
- beg end
- header gnus-tmp-header) ; passed as parameter to user-funcs.
- (beginning-of-line)
- (setq beg (point))
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- ;; Insert the text.
- (let ((gnus-tmp-decoded-group (gnus-group-name-decode
- gnus-tmp-group group-name-charset)))
- (eval gnus-group-line-format-spec)))
- `(gnus-group ,(gnus-intern-safe gnus-tmp-group gnus-active-hashtb)
- gnus-unread ,(if (numberp number)
- (string-to-number gnus-tmp-number-of-unread)
- t)
- gnus-marked ,gnus-tmp-marked-mark
- gnus-indentation ,gnus-group-indentation
- gnus-level ,gnus-tmp-level))
- (setq end (point))
- (when gnus-group-update-tool-bar
- (gnus-put-text-property beg end 'point-entered
- 'gnus-tool-bar-update)
- (gnus-put-text-property beg end 'point-left
- 'gnus-tool-bar-update))
- (forward-line -1)
- (when (inline (gnus-visual-p 'group-highlight 'highlight))
- (gnus-run-hooks 'gnus-group-update-hook))
- (forward-line)
- ;; Allow XEmacs to remove front-sticky text properties.
- (gnus-group-remove-excess-properties)))
-
-(defun gnus-group-highlight-line ()
- "Highlight the current line according to `gnus-group-highlight'."
- (let* ((list gnus-group-highlight)
- (p (point))
- (end (gnus-point-at-eol))
- ;; 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))
- (active (gnus-active group))
- (total (if active (1+ (- (cdr active) (car active))) 0))
- (info (nth 2 entry))
- (method (inline (gnus-server-get-method group (gnus-info-method info))))
- (marked (gnus-info-marks info))
- (mailp (apply 'append
- (mapcar
- (lambda (x)
- (memq x (assoc (symbol-name
- (car (or method gnus-select-method)))
- gnus-valid-select-methods)))
- '(mail post-mail))))
- (level (or (gnus-info-level info) gnus-level-killed))
- (score (or (gnus-info-score info) 0))
- (ticked (gnus-range-length (cdr (assq 'tick marked))))
- (group-age (gnus-group-timestamp-delta group))
- (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))
- (gnus-put-text-property-excluding-characters-with-faces
- beg end 'face
- (setq face (if (boundp face) (symbol-value face) face)))
- (gnus-extent-start-open beg)))
- (goto-char p)))
-
-(defun gnus-group-update-group (group &optional visible-only)
- "Update all lines where GROUP appear.
-If VISIBLE-ONLY is non-nil, the group won't be displayed if it isn't
-already."
- ;; Can't use `save-excursion' here, so we do it manually.
- (let ((buf (current-buffer))
- mark)
- (set-buffer gnus-group-buffer)
- (setq mark (point-marker))
- ;; The buffer may be narrowed.
- (save-restriction
- (widen)
- (let ((ident (gnus-intern-safe group gnus-active-hashtb))
- (loc (point-min))
- found buffer-read-only)
- ;; Enter the current status into the dribble buffer.
- (let ((entry (gnus-gethash group gnus-newsrc-hashtb)))
- (when (and entry
- (not (gnus-ephemeral-group-p group)))
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (nth 2 entry))
- ")"))))
- ;; Find all group instances. If topics are in use, each group
- ;; may be listed in more than once.
- (while (setq loc (text-property-any
- loc (point-max) 'gnus-group ident))
- (setq found t)
- (goto-char loc)
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-delete-line)
- (gnus-group-insert-group-line-info group)
- (save-excursion
- (forward-line -1)
- (gnus-run-hooks 'gnus-group-update-group-hook)))
- (setq loc (1+ loc)))
- (unless (or found visible-only)
- ;; No such line in the buffer, find out where it's supposed to
- ;; go, and insert it there (or at the end of the buffer).
- (if gnus-goto-missing-group-function
- (funcall gnus-goto-missing-group-function group)
- (let ((entry (cddr (gnus-gethash group gnus-newsrc-hashtb))))
- (while (and entry (car entry)
- (not
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe
- (caar entry) gnus-active-hashtb)))))
- (setq entry (cdr entry)))
- (or entry (goto-char (point-max)))))
- ;; Finally insert the line.
- (let ((gnus-group-indentation (gnus-group-group-indentation)))
- (gnus-group-insert-group-line-info group)
- (save-excursion
- (forward-line -1)
- (gnus-run-hooks 'gnus-group-update-group-hook))))
- (when gnus-group-update-group-function
- (funcall gnus-group-update-group-function group))
- (gnus-group-set-mode-line)))
- (goto-char mark)
- (set-marker mark nil)
- (set-buffer buf)))
-
-(defun gnus-group-set-mode-line ()
- "Update the mode line in the group buffer."
- (when (memq 'group gnus-updated-mode-lines)
- ;; Yes, we want to keep this mode line updated.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let* ((gformat (or gnus-group-mode-line-format-spec
- (gnus-set-format 'group-mode)))
- (gnus-tmp-news-server (cadr gnus-select-method))
- (gnus-tmp-news-method (car gnus-select-method))
- (gnus-tmp-colon (if (equal gnus-tmp-news-server "") "" ":"))
- (max-len 60)
- gnus-tmp-header ;Dummy binding for user-defined formats
- ;; Get the resulting string.
- (modified
- (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer)
- (buffer-modified-p gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (not (zerop (buffer-size))))))
- (mode-string (eval gformat)))
- ;; Say whether the dribble buffer has been modified.
- (setq mode-line-modified
- (if modified (car gnus-mode-line-modified)
- (cdr gnus-mode-line-modified)))
- ;; If the line is too long, we chop it off.
- (when (> (length mode-string) max-len)
- (setq mode-string (substring mode-string 0 (- max-len 4))))
- (prog1
- (setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification
- (list mode-string)))
- (set-buffer-modified-p modified))))))
-
-(defun gnus-group-group-name ()
- "Get the name of the newsgroup on the current line."
- (let ((group (get-text-property (gnus-point-at-bol) 'gnus-group)))
- (when group
- (symbol-name group))))
-
-(defun gnus-group-group-level ()
- "Get the level of the newsgroup on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-level))
-
-(defun gnus-group-group-indentation ()
- "Get the indentation of the newsgroup on the current line."
- (or (get-text-property (gnus-point-at-bol) 'gnus-indentation)
- (and gnus-group-indentation-function
- (funcall gnus-group-indentation-function))
- ""))
-
-(defun gnus-group-group-unread ()
- "Get the number of unread articles of the newsgroup on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-unread))
-
-(defun gnus-group-new-mail (group)
- (if (nnmail-new-mail-p (gnus-group-real-name group))
- gnus-new-mail-mark
- ? ))
-
-(defun gnus-group-level (group)
- "Return the estimated level of GROUP."
- (or (gnus-info-level (gnus-get-info group))
- (and (member group gnus-zombie-list) gnus-level-zombie)
- gnus-level-killed))
-
-(defun gnus-group-search-forward (&optional backward all level first-too)
- "Find the next newsgroup with unread articles.
-If BACKWARD is non-nil, find the previous newsgroup instead.
-If ALL is non-nil, just find any newsgroup.
-If LEVEL is non-nil, find group with level LEVEL, or higher if no such
-group exists.
-If FIRST-TOO, the current line is also eligible as a target."
- (let ((way (if backward -1 1))
- (low gnus-level-killed)
- (beg (point))
- pos found lev)
- (if (and backward (progn (beginning-of-line)) (bobp))
- nil
- (unless first-too
- (forward-line way))
- (while (and
- (not (eobp))
- (not (setq
- found
- (and
- (get-text-property (point) 'gnus-group)
- (or all
- (and
- (let ((unread
- (get-text-property (point) 'gnus-unread)))
- (and (numberp unread) (> unread 0)))
- (setq lev (get-text-property (point)
- 'gnus-level))
- (<= lev gnus-level-subscribed)))
- (or (not level)
- (and (setq lev (get-text-property (point)
- 'gnus-level))
- (or (= lev level)
- (and (< lev low)
- (< level lev)
- (progn
- (setq low lev)
- (setq pos (point))
- nil))))))))
- (zerop (forward-line way)))))
- (if found
- (progn (gnus-group-position-point) t)
- (goto-char (or pos beg))
- (and pos t))))
-
-;;; Gnus group mode commands
-
-;; Group marking.
-
-(defun gnus-group-mark-line-p ()
- (save-excursion
- (beginning-of-line)
- (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
- (eq (char-after) gnus-process-mark)))
-
-(defun gnus-group-mark-group (n &optional unmark no-advance)
- "Mark the current group."
- (interactive "p")
- (let ((buffer-read-only nil)
- group)
- (while (and (> n 0)
- (not (eobp)))
- (when (setq group (gnus-group-group-name))
- ;; Go to the mark position.
- (beginning-of-line)
- (forward-char (or (cdr (assq 'process gnus-group-mark-positions)) 2))
- (subst-char-in-region
- (point) (1+ (point)) (char-after)
- (if unmark
- (progn
- (setq gnus-group-marked (delete group gnus-group-marked))
- ? )
- (setq gnus-group-marked
- (cons group (delete group gnus-group-marked)))
- gnus-process-mark)))
- (unless no-advance
- (gnus-group-next-group 1))
- (decf n))
- (gnus-summary-position-point)
- n))
-
-(defun gnus-group-unmark-group (n)
- "Remove the mark from the current group."
- (interactive "p")
- (gnus-group-mark-group n 'unmark)
- (gnus-group-position-point))
-
-(defun gnus-group-unmark-all-groups ()
- "Unmark all groups."
- (interactive)
- (let ((groups gnus-group-marked))
- (save-excursion
- (while groups
- (gnus-group-remove-mark (pop groups)))))
- (gnus-group-position-point))
-
-(defun gnus-group-mark-region (unmark beg end)
- "Mark all groups between point and mark.
-If UNMARK, remove the mark instead."
- (interactive "P\nr")
- (let ((num (count-lines beg end)))
- (save-excursion
- (goto-char beg)
- (- num (gnus-group-mark-group num unmark)))))
-
-(defun gnus-group-mark-buffer (&optional unmark)
- "Mark all groups in the buffer.
-If UNMARK, remove the mark instead."
- (interactive "P")
- (gnus-group-mark-region unmark (point-min) (point-max)))
-
-(defun gnus-group-mark-regexp (regexp)
- "Mark all groups that match some regexp."
- (interactive "sMark (regexp): ")
- (let ((alist (cdr gnus-newsrc-alist))
- group)
- (save-excursion
- (while alist
- (when (string-match regexp (setq group (gnus-info-group (pop alist))))
- (gnus-group-jump-to-group group)
- (gnus-group-set-mark group)))))
- (gnus-group-position-point))
-
-(defun gnus-group-remove-mark (group &optional test-marked)
- "Remove the process mark from GROUP and move point there.
-Return nil if the group isn't displayed."
- (if (gnus-group-goto-group group nil test-marked)
- (save-excursion
- (gnus-group-mark-group 1 'unmark t)
- t)
- (setq gnus-group-marked
- (delete group gnus-group-marked))
- nil))
-
-(defun gnus-group-set-mark (group)
- "Set the process mark on GROUP."
- (if (gnus-group-goto-group group)
- (save-excursion
- (gnus-group-mark-group 1 nil t))
- (setq gnus-group-marked (cons group (delete group gnus-group-marked)))))
-
-(defun gnus-group-universal-argument (arg &optional groups func)
- "Perform any command on all groups according to the process/prefix convention."
- (interactive "P")
- (if (eq (setq func (or func
- (key-binding
- (read-key-sequence
- (substitute-command-keys
- "\\<gnus-group-mode-map>\\[gnus-group-universal-argument]")))))
- 'undefined)
- (gnus-error 1 "Undefined key")
- (gnus-group-iterate arg
- (lambda (group)
- (command-execute func))))
- (gnus-group-position-point))
-
-(defun gnus-group-process-prefix (n)
- "Return a list of groups to work on.
-Take into consideration N (the prefix) and the list of marked groups."
- (cond
- (n
- (setq n (prefix-numeric-value n))
- ;; There is a prefix, so we return a list of the N next
- ;; groups.
- (let ((way (if (< n 0) -1 1))
- (n (abs n))
- group groups)
- (save-excursion
- (while (> n 0)
- (if (setq group (gnus-group-group-name))
- (push group groups))
- (setq n (1- n))
- (gnus-group-next-group way)))
- (nreverse groups)))
- ((and (gnus-region-active-p) (mark))
- ;; Work on the region between point and mark.
- (let ((max (max (point) (mark)))
- groups)
- (save-excursion
- (goto-char (min (point) (mark)))
- (while
- (and
- (push (gnus-group-group-name) groups)
- (zerop (gnus-group-next-group 1))
- (< (point) max)))
- (nreverse groups))))
- (gnus-group-marked
- ;; No prefix, but a list of marked articles.
- (reverse gnus-group-marked))
- (t
- ;; Neither marked articles or a prefix, so we return the
- ;; current group.
- (let ((group (gnus-group-group-name)))
- (and group (list group))))))
-
-;;; !!!Surely gnus-group-iterate should be a macro instead? I can't
-;;; imagine why I went through these contortions...
-(eval-and-compile
- (let ((function (make-symbol "gnus-group-iterate-function"))
- (window (make-symbol "gnus-group-iterate-window"))
- (groups (make-symbol "gnus-group-iterate-groups"))
- (group (make-symbol "gnus-group-iterate-group")))
- (eval
- `(defun gnus-group-iterate (arg ,function)
- "Iterate FUNCTION over all process/prefixed groups.
-FUNCTION will be called with the group name as the parameter
-and with point over the group in question."
- (let ((,groups (gnus-group-process-prefix arg))
- (,window (selected-window))
- ,group)
- (while ,groups
- (setq ,group (car ,groups)
- ,groups (cdr ,groups))
- (select-window ,window)
- (gnus-group-remove-mark ,group)
- (save-selected-window
- (save-excursion
- (funcall ,function ,group)))))))))
-
-(put 'gnus-group-iterate 'lisp-indent-function 1)
-
-;; Selecting groups.
-
-(defun gnus-group-read-group (&optional all no-article group select-articles)
- "Read news in this newsgroup.
-If the prefix argument ALL is non-nil, already read articles become
-readable.
-
-If ALL is a positive number, fetch this number of the latest
-articles in the group. If ALL is a negative number, fetch this
-number of the earliest articles in the group.
-
-If the optional argument NO-ARTICLE is non-nil, no article will
-be auto-selected upon group entry. If GROUP is non-nil, fetch
-that group."
- (interactive "P")
- (let ((no-display (eq all 0))
- (group (or group (gnus-group-group-name)))
- number active marked entry)
- (when (eq all 0)
- (setq all nil))
- (unless group
- (error "No group on current line"))
- (setq marked (gnus-info-marks
- (nth 2 (setq entry (gnus-gethash
- group gnus-newsrc-hashtb)))))
- ;; This group might be a dead group. In that case we have to get
- ;; the number of unread articles from `gnus-active-hashtb'.
- (setq number
- (cond ((numberp all) all)
- (entry (car entry))
- ((setq active (gnus-active group))
- (- (1+ (cdr active)) (car active)))))
- (gnus-summary-read-group
- group (or all (and (numberp number)
- (zerop (+ number (gnus-range-length
- (cdr (assq 'tick marked)))
- (gnus-range-length
- (cdr (assq 'dormant marked)))))))
- no-article nil no-display nil select-articles)))
-
-(defun gnus-group-select-group (&optional all)
- "Select this newsgroup.
-No article is selected automatically.
-If the group is opened, just switch the summary buffer.
-If ALL is non-nil, already read articles become readable.
-If ALL is a positive number, fetch this number of the latest
-articles in the group.
-If ALL is a negative number, fetch this number of the earliest
-articles in the group."
- (interactive "P")
- (when (and (eobp) (not (gnus-group-group-name)))
- (forward-line -1))
- (gnus-group-read-group all t))
-
-(defun gnus-group-quick-select-group (&optional all)
- "Select the current group \"quickly\".
-This means that no highlighting or scoring will be performed.
-If ALL (the prefix argument) is 0, don't even generate the summary
-buffer.
-
-This might be useful if you want to toggle threading
-before entering the group."
- (interactive "P")
- (require 'gnus-score)
- (let (gnus-visual
- gnus-score-find-score-files-function
- gnus-home-score-file
- gnus-apply-kill-hook
- gnus-summary-expunge-below)
- (gnus-group-read-group all t)))
-
-(defun gnus-group-visible-select-group (&optional all)
- "Select the current group without hiding any articles."
- (interactive "P")
- (let ((gnus-inhibit-limiting t))
- (gnus-group-read-group all t)))
-
-(defun gnus-group-select-group-ephemerally ()
- "Select the current group without doing any processing whatsoever.
-You will actually be entered into a group that's a copy of
-the current group; no changes you make while in this group will
-be permanent."
- (interactive)
- (require 'gnus-score)
- (let* (gnus-visual
- gnus-score-find-score-files-function gnus-apply-kill-hook
- gnus-summary-expunge-below gnus-show-threads gnus-suppress-duplicates
- gnus-summary-mode-hook gnus-select-group-hook
- (group (gnus-group-group-name))
- (method (gnus-find-method-for-group group)))
- (gnus-group-read-ephemeral-group
- (gnus-group-prefixed-name group method) method)))
-
-;;;###autoload
-(defun gnus-fetch-group (group &optional articles)
- "Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not."
- (interactive (list (completing-read "Group name: " gnus-active-hashtb)))
- (unless (get-buffer gnus-group-buffer)
- (gnus-no-server))
- (gnus-group-read-group articles nil group))
-
-;;;###autoload
-(defun gnus-fetch-group-other-frame (group)
- "Pop up a frame and enter GROUP."
- (interactive "P")
- (let ((window (get-buffer-window gnus-group-buffer)))
- (cond (window
- (select-frame (window-frame window)))
- ((= (length (frame-list)) 1)
- (select-frame (make-frame)))
- (t
- (other-frame 1))))
- (gnus-fetch-group group))
-
-(defvar gnus-ephemeral-group-server 0)
-
-(defcustom gnus-large-ephemeral-newsgroup 200
- "The number of articles which indicates a large ephemeral newsgroup.
-Same as `gnus-large-newsgroup', but only used for ephemeral newsgroups.
-
-If the number of articles in a newsgroup is greater than this value,
-confirmation is required for selecting the newsgroup. If it is nil, no
-confirmation is required."
- :version "22.1"
- :group 'gnus-group-select
- :type '(choice (const :tag "No limit" nil)
- integer))
-
-(defcustom gnus-fetch-old-ephemeral-headers nil
- "Same as `gnus-fetch-old-headers', but only used for ephemeral newsgroups."
- :version "22.1"
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const some)
- number
- (sexp :menu-tag "other" t)))
-
-;; Enter a group that is not in the group buffer. Non-nil is returned
-;; if selection was successful.
-(defun gnus-group-read-ephemeral-group (group method &optional activate
- quit-config request-only
- select-articles
- parameters
- number)
- "Read GROUP from METHOD as an ephemeral group.
-If ACTIVATE, request the group first.
-If QUIT-CONFIG, use that window configuration when exiting from the
-ephemeral group.
-If REQUEST-ONLY, don't actually read the group; just request it.
-If SELECT-ARTICLES, only select those articles.
-If PARAMETERS, use those as the group parameters.
-If NUMBER, fetch this number of articles.
-
-Return the name of the group if selection was successful."
- (interactive
- (list
- ;; (gnus-read-group "Group name: ")
- (completing-read
- "Group: " gnus-active-hashtb
- nil nil nil
- 'gnus-group-history)
- (gnus-read-method "From method: ")))
- ;; Transform the select method into a unique server.
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- (setq method
- `(,(car method) ,(concat (cadr method) "-ephemeral")
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method)))
- (let ((group (if (gnus-group-foreign-p group) group
- (gnus-group-prefixed-name (gnus-group-real-name group)
- method))))
- (gnus-sethash
- group
- `(-1 nil (,group
- ,gnus-level-default-subscribed nil nil ,method
- ,(cons
- (if quit-config
- (cons 'quit-config quit-config)
- (cons 'quit-config
- (cons gnus-summary-buffer
- gnus-current-window-configuration)))
- parameters)))
- gnus-newsrc-hashtb)
- (push method gnus-ephemeral-servers)
- (set-buffer gnus-group-buffer)
- (unless (gnus-check-server method)
- (error "Unable to contact server: %s" (gnus-status-message method)))
- (when activate
- (gnus-activate-group group 'scan)
- (unless (gnus-request-group group)
- (error "Couldn't request group: %s"
- (nnheader-get-report (car method)))))
- (if request-only
- group
- (condition-case ()
- (when (let ((gnus-large-newsgroup gnus-large-ephemeral-newsgroup)
- (gnus-fetch-old-headers
- gnus-fetch-old-ephemeral-headers))
- (gnus-group-read-group (or number t) t group select-articles))
- group)
- ;;(error nil)
- (quit
- (message "Quit reading the ephemeral group")
- nil)))))
-
-(defun gnus-group-jump-to-group (group)
- "Jump to newsgroup GROUP."
- (interactive
- (list (mm-string-make-unibyte
- (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- gnus-group-jump-to-group-prompt
- 'gnus-group-history))))
-
- (when (equal group "")
- (error "Empty group name"))
-
- (unless (gnus-ephemeral-group-p group)
- ;; Either go to the line in the group buffer...
- (unless (gnus-group-goto-group group)
- ;; ... or insert the line.
- (gnus-group-update-group group)
- (gnus-group-goto-group group)))
- ;; Adjust cursor point.
- (gnus-group-position-point))
-
-(defun gnus-group-goto-group (group &optional far test-marked)
- "Goto to newsgroup GROUP.
-If FAR, it is likely that the group is not on the current line.
-If TEST-MARKED, the line must be marked."
- (when group
- (beginning-of-line)
- (cond
- ;; It's quite likely that we are on the right line, so
- ;; we check the current line first.
- ((and (not far)
- (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb))
- (or (not test-marked) (gnus-group-mark-line-p)))
- (point))
- ;; Previous and next line are also likely, so we check them as well.
- ((and (not far)
- (save-excursion
- (forward-line -1)
- (and (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb))
- (or (not test-marked) (gnus-group-mark-line-p)))))
- (forward-line -1)
- (point))
- ((and (not far)
- (save-excursion
- (forward-line 1)
- (and (eq (get-text-property (point) 'gnus-group)
- (gnus-intern-safe group gnus-active-hashtb))
- (or (not test-marked) (gnus-group-mark-line-p)))))
- (forward-line 1)
- (point))
- (test-marked
- (goto-char (point-min))
- (let (found)
- (while (and (not found)
- (gnus-goto-char
- (text-property-any
- (point) (point-max)
- 'gnus-group
- (gnus-intern-safe group gnus-active-hashtb))))
- (if (gnus-group-mark-line-p)
- (setq found t)
- (forward-line 1)))
- found))
- (t
- ;; Search through the entire buffer.
- (gnus-goto-char
- (text-property-any
- (point-min) (point-max)
- 'gnus-group (gnus-intern-safe group gnus-active-hashtb)))))))
-
-(defun gnus-group-next-group (n &optional silent)
- "Go to next N'th newsgroup.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group n t nil silent))
-
-(defun gnus-group-next-unread-group (n &optional all level silent)
- "Go to next N'th unread newsgroup.
-If N is negative, search backward instead.
-If ALL is non-nil, choose any newsgroup, unread or not.
-If LEVEL is non-nil, choose the next group with level LEVEL, or, if no
-such group can be found, the next group with a level higher than
-LEVEL.
-Returns the difference between N and the number of skips actually
-made."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and (> n 0)
- (gnus-group-search-forward
- backward (or (not gnus-group-goto-unread) all) level))
- (setq n (1- n)))
- (when (and (/= 0 n)
- (not silent))
- (gnus-message 7 "No more%s newsgroups%s" (if all "" " unread")
- (if level " on this level or higher" "")))
- n))
-
-(defun gnus-group-prev-group (n)
- "Go to previous N'th newsgroup.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n) t))
-
-(defun gnus-group-prev-unread-group (n)
- "Go to previous N'th unread newsgroup.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n)))
-
-(defun gnus-group-next-unread-group-same-level (n)
- "Go to next N'th unread newsgroup on the same level.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group n t (gnus-group-group-level))
- (gnus-group-position-point))
-
-(defun gnus-group-prev-unread-group-same-level (n)
- "Go to next N'th unread newsgroup on the same level.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-group-next-unread-group (- n) t (gnus-group-group-level))
- (gnus-group-position-point))
-
-(defun gnus-group-best-unread-group (&optional exclude-group)
- "Go to the group with the highest level.
-If EXCLUDE-GROUP, do not go to that group."
- (interactive)
- (goto-char (point-min))
- (let ((best 100000)
- unread best-point)
- (while (not (eobp))
- (setq unread (get-text-property (point) 'gnus-unread))
- (when (and (numberp unread) (> unread 0))
- (when (and (get-text-property (point) 'gnus-level)
- (< (get-text-property (point) 'gnus-level) best)
- (or (not exclude-group)
- (not (equal exclude-group (gnus-group-group-name)))))
- (setq best (get-text-property (point) 'gnus-level))
- (setq best-point (point))))
- (forward-line 1))
- (when best-point
- (goto-char best-point))
- (gnus-group-position-point)
- (and best-point (gnus-group-group-name))))
-
-(defun gnus-group-first-unread-group ()
- "Go to the first group with unread articles."
- (interactive)
- (prog1
- (let ((opoint (point))
- unread)
- (goto-char (point-min))
- (if (or (eq (setq unread (gnus-group-group-unread)) t) ; Not active.
- (and (numberp unread) ; Not a topic.
- (not (zerop unread))) ; Has unread articles.
- (zerop (gnus-group-next-unread-group 1))) ; Next unread group.
- (point) ; Success.
- (goto-char opoint)
- nil)) ; Not success.
- (gnus-group-position-point)))
-
-(defun gnus-group-enter-server-mode ()
- "Jump to the server buffer."
- (interactive)
- (gnus-enter-server-buffer))
-
-(defun gnus-group-make-group (name &optional method address args)
- "Add a new newsgroup.
-The user will be prompted for a NAME, for a select METHOD, and an
-ADDRESS."
- (interactive
- (list
- (gnus-read-group "Group name: ")
- (gnus-read-method "From method: ")))
-
- (when (stringp method)
- (setq method (or (gnus-server-to-method method) method)))
- (let* ((meth (gnus-method-simplify
- (when (and method
- (not (gnus-server-equal method gnus-select-method)))
- (if address (list (intern method) address)
- method))))
- (nname (if method (gnus-group-prefixed-name name meth) name))
- backend info)
- (when (gnus-gethash nname gnus-newsrc-hashtb)
- (error "Group %s already exists" (gnus-group-decoded-name nname)))
- ;; Subscribe to the new group.
- (gnus-group-change-level
- (setq info (list t nname gnus-level-default-subscribed nil nil meth))
- gnus-level-default-subscribed gnus-level-killed
- (and (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name)
- gnus-newsrc-hashtb))
- t)
- ;; Make it active.
- (gnus-set-active nname (cons 1 0))
- (unless (gnus-ephemeral-group-p name)
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (cdr info)) ")")))
- ;; Insert the line.
- (gnus-group-insert-group-line-info nname)
- (forward-line -1)
- (gnus-group-position-point)
-
- ;; Load the back end and try to make the back end create
- ;; the group as well.
- (when (assoc (symbol-name (setq backend (car (gnus-server-get-method
- nil meth))))
- gnus-valid-select-methods)
- (require backend))
- (gnus-check-server meth)
- (when (gnus-check-backend-function 'request-create-group nname)
- (unless (gnus-request-create-group nname nil args)
- (error "Could not create group on server: %s"
- (nnheader-get-report backend))))
- t))
-
-(defun gnus-group-delete-groups (&optional arg)
- "Delete the current group. Only meaningful with editable groups."
- (interactive "P")
- (let ((n (length (gnus-group-process-prefix arg))))
- (when (gnus-yes-or-no-p
- (if (= n 1)
- "Delete this 1 group? "
- (format "Delete these %d groups? " n)))
- (gnus-group-iterate arg
- (lambda (group)
- (gnus-group-delete-group group nil t))))))
-
-(defun gnus-group-delete-group (group &optional force no-prompt)
- "Delete the current group. Only meaningful with editable groups.
-If FORCE (the prefix) is non-nil, all the articles in the group will
-be deleted. This is \"deleted\" as in \"removed forever from the face
-of the Earth\". There is no undo. The user will be prompted before
-doing the deletion.
-Note that you also have to specify FORCE if you want the group to
-be removed from the server, even when it's empty."
- (interactive
- (list (gnus-group-group-name)
- current-prefix-arg))
- (unless group
- (error "No group to delete"))
- (unless (gnus-check-backend-function 'request-delete-group group)
- (error "This back end does not support group deletion"))
- (prog1
- (let ((group-decoded (gnus-group-decoded-name group)))
- (if (and (not no-prompt)
- (not (gnus-yes-or-no-p
- (format
- "Do you really want to delete %s%s? "
- group-decoded (if force " and all its contents" "")))))
- () ; Whew!
- (gnus-message 6 "Deleting group %s..." group-decoded)
- (if (not (gnus-request-delete-group group force))
- (gnus-error 3 "Couldn't delete group %s" group-decoded)
- (gnus-message 6 "Deleting group %s...done" group-decoded)
- (gnus-group-goto-group group)
- (gnus-group-kill-group 1 t)
- (gnus-sethash group nil gnus-active-hashtb)
- t)))
- (gnus-group-position-point)))
-
-(defun gnus-group-rename-group (group new-name)
- "Rename group from GROUP to NEW-NAME.
-When used interactively, GROUP is the group under point
-and NEW-NAME will be prompted for."
- (interactive
- (list
- (gnus-group-group-name)
- (progn
- (unless (gnus-check-backend-function
- 'request-rename-group (gnus-group-group-name))
- (error "This back end does not support renaming groups"))
- (gnus-read-group "Rename group to: "
- (gnus-group-real-name (gnus-group-group-name))))))
-
- (unless (gnus-check-backend-function 'request-rename-group group)
- (error "This back end does not support renaming groups"))
- (unless group
- (error "No group to rename"))
- (when (equal (gnus-group-real-name group) new-name)
- (error "Can't rename to the same name"))
-
- ;; We find the proper prefixed name.
- (setq new-name
- (if (gnus-group-native-p group)
- ;; Native group.
- new-name
- ;; Foreign group.
- (gnus-group-prefixed-name
- (gnus-group-real-name new-name)
- (gnus-info-method (gnus-get-info group)))))
-
- (when (gnus-active new-name)
- (error "The group %s already exists" new-name))
-
- (gnus-message 6 "Renaming group %s to %s..." group new-name)
- (prog1
- (if (progn
- (gnus-group-goto-group group)
- (not (when (< (gnus-group-group-level) gnus-level-zombie)
- (gnus-request-rename-group group new-name))))
- (gnus-error 3 "Couldn't rename group %s to %s" group new-name)
- ;; We rename the group internally by killing it...
- (gnus-group-kill-group)
- ;; ... changing its name ...
- (setcar (cdar gnus-list-of-killed-groups) new-name)
- ;; ... and then yanking it. Magic!
- (gnus-group-yank-group)
- (gnus-set-active new-name (gnus-active group))
- (gnus-message 6 "Renaming group %s to %s...done" group new-name)
- new-name)
- (setq gnus-killed-list (delete group gnus-killed-list))
- (gnus-set-active group nil)
- (gnus-dribble-touch)
- (gnus-group-position-point)))
-
-(defun gnus-group-edit-group (group &optional part)
- "Edit the group on the current line."
- (interactive (list (gnus-group-group-name)))
- (let ((part (or part 'info))
- info)
- (unless group
- (error "No group on current line"))
- (unless (setq info (gnus-get-info group))
- (error "Killed group; can't be edited"))
- (ignore-errors
- (gnus-close-group group))
- (gnus-edit-form
- ;; Find the proper form to edit.
- (cond ((eq part 'method)
- (or (gnus-info-method info) "native"))
- ((eq part 'params)
- (gnus-info-params info))
- (t info))
- ;; The proper documentation.
- (format
- "Editing the %s for `%s'."
- (cond
- ((eq part 'method) "select method")
- ((eq part 'params) "group parameters")
- (t "group info"))
- (gnus-group-decoded-name group))
- `(lambda (form)
- (gnus-group-edit-group-done ',part ,group form)))
- (local-set-key
- "\C-c\C-i"
- (gnus-create-info-command
- (cond
- ((eq part 'method)
- "(gnus)Select Methods")
- ((eq part 'params)
- "(gnus)Group Parameters")
- (t
- "(gnus)Group Info"))))))
-
-(defun gnus-group-edit-group-method (group)
- "Edit the select method of GROUP."
- (interactive (list (gnus-group-group-name)))
- (gnus-group-edit-group group 'method))
-
-(defun gnus-group-edit-group-parameters (group)
- "Edit the group parameters of GROUP."
- (interactive (list (gnus-group-group-name)))
- (gnus-group-edit-group group 'params))
-
-(defun gnus-group-edit-group-done (part group form)
- "Update variables."
- (let* ((method (cond ((eq part 'info) (nth 4 form))
- ((eq part 'method) form)
- (t nil)))
- (info (cond ((eq part 'info) form)
- ((eq part 'method) (gnus-get-info group))
- (t nil)))
- (new-group (if info
- (if (or (not method)
- (gnus-server-equal
- gnus-select-method method))
- (gnus-group-real-name (car info))
- (gnus-group-prefixed-name
- (gnus-group-real-name (car info)) method))
- nil)))
- (when (and new-group
- (not (equal new-group group)))
- (when (gnus-group-goto-group group)
- (gnus-group-kill-group 1))
- (gnus-activate-group new-group))
- ;; Set the info.
- (if (not (and info new-group))
- (gnus-group-set-info form (or new-group group) part)
- (setq info (gnus-copy-sequence info))
- (setcar info new-group)
- (unless (gnus-server-equal method "native")
- (unless (nthcdr 3 info)
- (nconc info (list nil nil)))
- (unless (nthcdr 4 info)
- (nconc info (list nil)))
- (gnus-info-set-method info method))
- (gnus-group-set-info info))
- (gnus-group-update-group (or new-group group))
- (gnus-group-position-point)))
-
-(defun gnus-group-make-useful-group (group method)
- "Create one of the groups described in `gnus-useful-groups'."
- (interactive
- (let ((entry (assoc (completing-read "Create group: " gnus-useful-groups
- nil t)
- gnus-useful-groups)))
- (list (cadr entry) (caddr entry))))
- (setq method (gnus-copy-sequence method))
- (let (entry)
- (while (setq entry (memq (assq 'eval method) method))
- (setcar entry (eval (cadar entry)))))
- (gnus-group-make-group group method))
-
-(defun gnus-group-make-help-group (&optional noerror)
- "Create the Gnus documentation group.
-Optional argument NOERROR modifies the behavior of this function when the
-group already exists:
-- if not given, and error is signaled,
-- if t, stay silent,
-- if anything else, just print a message."
- (interactive)
- (let ((name (gnus-group-prefixed-name "gnus-help" '(nndoc "gnus-help")))
- (file (nnheader-find-etc-directory "gnus-tut.txt" t)))
- (if (gnus-gethash name gnus-newsrc-hashtb)
- (cond ((eq noerror nil)
- (error "Documentation group already exists"))
- ((eq noerror t)
- ;; stay silent
- )
- (t
- (gnus-message 1 "Documentation group already exists")))
- ;; else:
- (if (not file)
- (gnus-message 1 "Couldn't find doc group")
- (gnus-group-make-group
- (gnus-group-real-name name)
- (list 'nndoc "gnus-help"
- (list 'nndoc-address file)
- (list 'nndoc-article-type 'mbox))))
- ))
- (gnus-group-position-point))
-
-(defun gnus-group-make-doc-group (file type)
- "Create a group that uses a single file as the source.
-
-If called with a prefix argument, ask for the file type."
- (interactive
- (list (read-file-name "File name: ")
- (and current-prefix-arg 'ask)))
- (when (eq type 'ask)
- (let ((err "")
- char found)
- (while (not found)
- (message
- "%sFile type (mbox, babyl, digest, forward, mmdf, guess) [m, b, d, f, a, g]: "
- err)
- (setq found (cond ((= (setq char (read-char)) ?m) 'mbox)
- ((= char ?b) 'babyl)
- ((= char ?d) 'digest)
- ((= char ?f) 'forward)
- ((= char ?a) 'mmfd)
- ((= char ?g) 'guess)
- (t (setq err (format "%c unknown. " char))
- nil))))
- (setq type found)))
- (setq file (expand-file-name file))
- (let ((name (gnus-generate-new-group-name
- (gnus-group-prefixed-name
- (file-name-nondirectory file) '(nndoc ""))))
- (encodable (mm-coding-system-p 'utf-8)))
- (gnus-group-make-group
- (if encodable
- (mm-encode-coding-string (gnus-group-real-name name) 'utf-8)
- (gnus-group-real-name name))
- (list 'nndoc (if encodable
- (mm-encode-coding-string file 'utf-8)
- file)
- (list 'nndoc-address file)
- (list 'nndoc-article-type (or type 'guess))))))
-
-(defvar nnweb-type-definition)
-(defvar gnus-group-web-type-history nil)
-(defvar gnus-group-web-search-history nil)
-(defun gnus-group-make-web-group (&optional solid)
- "Create an ephemeral nnweb group.
-If SOLID (the prefix), create a solid group."
- (interactive "P")
- (require 'nnweb)
- (let* ((group
- (if solid (gnus-read-group "Group name: ")
- (message-unique-id)))
- (default-type (or (car gnus-group-web-type-history)
- (symbol-name (caar nnweb-type-definition))))
- (type
- (gnus-string-or
- (completing-read
- (format "Search engine type (default %s): " default-type)
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
- nnweb-type-definition)
- nil t nil 'gnus-group-web-type-history)
- default-type))
- (search
- (read-string
- "Search string: "
- (cons (or (car gnus-group-web-search-history) "") 0)
- 'gnus-group-web-search-history))
- (method
- `(nnweb ,group (nnweb-search ,search)
- (nnweb-type ,(intern type))
- (nnweb-ephemeral-p t))))
- (if solid
- (progn
- (gnus-pull 'nnweb-ephemeral-p method)
- (gnus-group-make-group group method))
- (gnus-group-read-ephemeral-group
- group method t
- (cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode) 'summary 'group))))))
-
-(eval-when-compile
- (defvar nnrss-group-alist)
- (defun nnrss-discover-feed (arg))
- (defun nnrss-save-server-data (arg)))
-(defun gnus-group-make-rss-group (&optional url)
- "Given a URL, discover if there is an RSS feed.
-If there is, use Gnus to create an nnrss group"
- (interactive)
- (require 'nnrss)
- (if (not url)
- (setq url (read-from-minibuffer "URL to Search for RSS: ")))
- (let ((feedinfo (nnrss-discover-feed url)))
- (if feedinfo
- (let ((title (gnus-newsgroup-savable-name
- (read-from-minibuffer "Title: "
- (gnus-newsgroup-savable-name
- (or (cdr (assoc 'title
- feedinfo))
- "")))))
- (desc (read-from-minibuffer "Description: "
- (cdr (assoc 'description
- feedinfo))))
- (href (cdr (assoc 'href feedinfo)))
- (encodable (mm-coding-system-p 'utf-8)))
- (when encodable
- ;; Unify non-ASCII text.
- (setq title (mm-decode-coding-string
- (mm-encode-coding-string title 'utf-8) 'utf-8)))
- (gnus-group-make-group (if encodable
- (mm-encode-coding-string title 'utf-8)
- title)
- '(nnrss ""))
- (push (list title href desc) nnrss-group-alist)
- (nnrss-save-server-data nil))
- (error "No feeds found for %s" url))))
-
-(defvar nnwarchive-type-definition)
-(defvar gnus-group-warchive-type-history nil)
-(defvar gnus-group-warchive-login-history nil)
-(defvar gnus-group-warchive-address-history nil)
-
-(defun gnus-group-make-warchive-group ()
- "Create a nnwarchive group."
- (interactive)
- (require 'nnwarchive)
- (let* ((group (gnus-read-group "Group name: "))
- (default-type (or (car gnus-group-warchive-type-history)
- (symbol-name (caar nnwarchive-type-definition))))
- (type
- (gnus-string-or
- (completing-read
- (format "Warchive type (default %s): " default-type)
- (mapcar (lambda (elem) (list (symbol-name (car elem))))
- nnwarchive-type-definition)
- nil t nil 'gnus-group-warchive-type-history)
- default-type))
- (address (read-string "Warchive address: "
- nil 'gnus-group-warchive-address-history))
- (default-login (or (car gnus-group-warchive-login-history)
- user-mail-address))
- (login
- (gnus-string-or
- (read-string
- (format "Warchive login (default %s): " user-mail-address)
- default-login 'gnus-group-warchive-login-history)
- user-mail-address))
- (method
- `(nnwarchive ,address
- (nnwarchive-type ,(intern type))
- (nnwarchive-login ,login))))
- (gnus-group-make-group group method)))
-
-(defun gnus-group-make-archive-group (&optional all)
- "Create the (ding) Gnus archive group of the most recent articles.
-Given a prefix, create a full group."
- (interactive "P")
- (let ((group (gnus-group-prefixed-name
- (if all "ding.archives" "ding.recent") '(nndir ""))))
- (when (gnus-gethash group gnus-newsrc-hashtb)
- (error "Archive group already exists"))
- (gnus-group-make-group
- (gnus-group-real-name group)
- (list 'nndir (if all "hpc" "edu")
- (list 'nndir-directory
- (if all gnus-group-archive-directory
- gnus-group-recent-archive-directory))))
- (gnus-group-add-parameter group (cons 'to-address "ding@gnus.org"))))
-
-(defun gnus-group-make-directory-group (dir)
- "Create an nndir group.
-The user will be prompted for a directory. The contents of this
-directory will be used as a newsgroup. The directory should contain
-mail messages or news articles in files that have numeric names."
- (interactive
- (list (read-file-name "Create group from directory: ")))
- (unless (file-exists-p dir)
- (error "No such directory"))
- (unless (file-directory-p dir)
- (error "Not a directory"))
- (let ((ext "")
- (i 0)
- group)
- (while (or (not group) (gnus-gethash group gnus-newsrc-hashtb))
- (setq group
- (gnus-group-prefixed-name
- (expand-file-name ext dir)
- '(nndir "")))
- (setq ext (format "<%d>" (setq i (1+ i)))))
- (gnus-group-make-group
- (gnus-group-real-name group)
- (list 'nndir (gnus-group-real-name group) (list 'nndir-directory dir)))))
-
-(defvar nnkiboze-score-file)
-(defun gnus-group-make-kiboze-group (group address scores)
- "Create an nnkiboze group.
-The user will be prompted for a name, a regexp to match groups, and
-score file entries for articles to include in the group."
- (interactive
- (list
- (read-string "nnkiboze group name: ")
- (read-string "Source groups (regexp): ")
- (let ((headers (mapcar (lambda (group) (list group))
- '("subject" "from" "number" "date" "message-id"
- "references" "chars" "lines" "xref"
- "followup" "all" "body" "head")))
- scores header regexp regexps)
- (while (not (equal "" (setq header (completing-read
- "Match on header: " headers nil t))))
- (setq regexps nil)
- (while (not (equal "" (setq regexp (read-string
- (format "Match on %s (regexp): "
- header)))))
- (push (list regexp nil nil 'r) regexps))
- (push (cons header regexps) scores))
- scores)))
- (gnus-group-make-group group "nnkiboze" address)
- (let* ((nnkiboze-current-group group)
- (score-file (car (nnkiboze-score-file "")))
- (score-dir (file-name-directory score-file)))
- (unless (file-exists-p score-dir)
- (make-directory score-dir))
- (with-temp-file score-file
- (let (emacs-lisp-mode-hook)
- (gnus-pp scores)))))
-
-(defun gnus-group-add-to-virtual (n vgroup)
- "Add the current group to a virtual group."
- (interactive
- (list current-prefix-arg
- (completing-read "Add to virtual group: " gnus-newsrc-hashtb nil t
- "nnvirtual:")))
- (unless (eq (car (gnus-find-method-for-group vgroup)) 'nnvirtual)
- (error "%s is not an nnvirtual group" vgroup))
- (gnus-close-group vgroup)
- (let* ((groups (gnus-group-process-prefix n))
- (method (gnus-info-method (gnus-get-info vgroup))))
- (setcar (cdr method)
- (concat
- (nth 1 method) "\\|"
- (mapconcat
- (lambda (s)
- (gnus-group-remove-mark s)
- (concat "\\(^" (regexp-quote s) "$\\)"))
- groups "\\|"))))
- (gnus-group-position-point))
-
-(defun gnus-group-make-empty-virtual (group)
- "Create a new, fresh, empty virtual group."
- (interactive "sCreate new, empty virtual group: ")
- (let* ((method (list 'nnvirtual "^$"))
- (pgroup (gnus-group-prefixed-name group method)))
- ;; Check whether it exists already.
- (when (gnus-gethash pgroup gnus-newsrc-hashtb)
- (error "Group %s already exists" pgroup))
- ;; Subscribe the new group after the group on the current line.
- (gnus-subscribe-group pgroup (gnus-group-group-name) method)
- (gnus-group-update-group pgroup)
- (forward-line -1)
- (gnus-group-position-point)))
-
-(defun gnus-group-enter-directory (dir)
- "Enter an ephemeral nneething group."
- (interactive "DDirectory to read: ")
- (let* ((method (list 'nneething dir '(nneething-read-only t)))
- (leaf (gnus-group-prefixed-name
- (file-name-nondirectory (directory-file-name dir))
- method))
- (name (gnus-generate-new-group-name leaf)))
- (unless (gnus-group-read-ephemeral-group
- name method t
- (cons (current-buffer)
- (if (eq major-mode 'gnus-summary-mode)
- 'summary 'group)))
- (error "Couldn't enter %s" dir))))
-
-(eval-and-compile
- (autoload 'nnimap-expunge "nnimap")
- (autoload 'nnimap-acl-get "nnimap")
- (autoload 'nnimap-acl-edit "nnimap"))
-
-(defun gnus-group-nnimap-expunge (group)
- "Expunge deleted articles in current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
- (let ((mailbox (gnus-group-real-name group)) method)
- (unless group
- (error "No group on current line"))
- (unless (gnus-get-info group)
- (error "Killed group; can't be edited"))
- (unless (eq 'nnimap (car (setq method (gnus-find-method-for-group group))))
- (error "%s is not an nnimap group" group))
- (nnimap-expunge mailbox (cadr method))))
-
-(defun gnus-group-nnimap-edit-acl (group)
- "Edit the Access Control List of current nnimap GROUP."
- (interactive (list (gnus-group-group-name)))
- (let ((mailbox (gnus-group-real-name group)) method acl)
- (unless group
- (error "No group on current line"))
- (unless (gnus-get-info group)
- (error "Killed group; can't be edited"))
- (unless (eq (car (setq method (gnus-find-method-for-group group))) 'nnimap)
- (error "%s is not an nnimap group" group))
- (unless (setq acl (nnimap-acl-get mailbox (cadr method)))
- (error "Server does not support ACL's"))
- (gnus-edit-form acl (format "Editing the access control list for `%s'.
-
- An access control list is a list of (identifier . rights) elements.
-
- The identifier string specifies the corresponding user. The
- identifier \"anyone\" is reserved to refer to the universal identity.
-
- Rights is a string listing a (possibly empty) set of alphanumeric
- characters, each character listing a set of operations which is being
- controlled. Letters are reserved for ``standard'' rights, listed
- below. Digits are reserved for implementation or site defined rights.
-
- l - lookup (mailbox is visible to LIST/LSUB commands)
- r - read (SELECT the mailbox, perform CHECK, FETCH, PARTIAL,
- SEARCH, COPY from mailbox)
- s - keep seen/unseen information across sessions (STORE \\SEEN flag)
- w - write (STORE flags other than \\SEEN and \\DELETED)
- i - insert (perform APPEND, COPY into mailbox)
- p - post (send mail to submission address for mailbox,
- not enforced by IMAP4 itself)
- c - create and delete mailbox (CREATE new sub-mailboxes in any
- implementation-defined hierarchy, RENAME or DELETE mailbox)
- d - delete messages (STORE \\DELETED flag, perform EXPUNGE)
- a - administer (perform SETACL)" group)
- `(lambda (form)
- (nnimap-acl-edit
- ,mailbox ',method ',acl form)))))
-
-;; Group sorting commands
-;; Suggested by Joe Hildebrand <hildjj@idaho.fuentez.com>.
-
-(defun gnus-group-sort-groups (func &optional reverse)
- "Sort the group buffer according to FUNC.
-When used interactively, the sorting function used will be
-determined by the `gnus-group-sort-function' variable.
-If REVERSE (the prefix), reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
- (funcall gnus-group-sort-alist-function
- (gnus-make-sort-function func) reverse)
- (gnus-group-unmark-all-groups)
- (gnus-group-list-groups)
- (gnus-dribble-touch))
-
-(defun gnus-group-sort-flat (func reverse)
- ;; We peel off the dummy group from the alist.
- (when func
- (when (equal (gnus-info-group (car gnus-newsrc-alist)) "dummy.group")
- (pop gnus-newsrc-alist))
- ;; Do the sorting.
- (setq gnus-newsrc-alist
- (sort gnus-newsrc-alist func))
- (when reverse
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist)))
- ;; Regenerate the hash table.
- (gnus-make-hashtable-from-newsrc-alist)))
-
-(defun gnus-group-sort-groups-by-alphabet (&optional reverse)
- "Sort the group buffer alphabetically by group name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-alphabet reverse))
-
-(defun gnus-group-sort-groups-by-real-name (&optional reverse)
- "Sort the group buffer alphabetically by real (unprefixed) group name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-real-name reverse))
-
-(defun gnus-group-sort-groups-by-unread (&optional reverse)
- "Sort the group buffer by number of unread articles.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-unread reverse))
-
-(defun gnus-group-sort-groups-by-level (&optional reverse)
- "Sort the group buffer by group level.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-level reverse))
-
-(defun gnus-group-sort-groups-by-score (&optional reverse)
- "Sort the group buffer by group score.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-score reverse))
-
-(defun gnus-group-sort-groups-by-rank (&optional reverse)
- "Sort the group buffer by group rank.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-rank reverse))
-
-(defun gnus-group-sort-groups-by-method (&optional reverse)
- "Sort the group buffer alphabetically by back end name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-method reverse))
-
-(defun gnus-group-sort-groups-by-server (&optional reverse)
- "Sort the group buffer alphabetically by server name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-group-sort-groups 'gnus-group-sort-by-server reverse))
-
-;;; Selected group sorting.
-
-(defun gnus-group-sort-selected-groups (n func &optional reverse)
- "Sort the process/prefixed groups."
- (interactive (list current-prefix-arg gnus-group-sort-function))
- (let ((groups (gnus-group-process-prefix n)))
- (funcall gnus-group-sort-selected-function
- groups (gnus-make-sort-function func) reverse)
- (gnus-group-unmark-all-groups)
- (gnus-group-list-groups)
- (gnus-dribble-touch)))
-
-(defun gnus-group-sort-selected-flat (groups func reverse)
- (let (entries infos)
- ;; First find all the group entries for these groups.
- (while groups
- (push (nthcdr 2 (gnus-gethash (pop groups) gnus-newsrc-hashtb))
- entries))
- ;; Then sort the infos.
- (setq infos
- (sort
- (mapcar
- (lambda (entry) (car entry))
- (setq entries (nreverse entries)))
- func))
- (when reverse
- (setq infos (nreverse infos)))
- ;; Go through all the infos and replace the old entries
- ;; with the new infos.
- (while infos
- (setcar (car entries) (pop infos))
- (pop entries))
- ;; Update the hashtable.
- (gnus-make-hashtable-from-newsrc-alist)))
-
-(defun gnus-group-sort-selected-groups-by-alphabet (&optional n reverse)
- "Sort the group buffer alphabetically by group name.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-alphabet reverse))
-
-(defun gnus-group-sort-selected-groups-by-real-name (&optional n reverse)
- "Sort the group buffer alphabetically by real group name.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-real-name reverse))
-
-(defun gnus-group-sort-selected-groups-by-unread (&optional n reverse)
- "Sort the group buffer by number of unread articles.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-unread reverse))
-
-(defun gnus-group-sort-selected-groups-by-level (&optional n reverse)
- "Sort the group buffer by group level.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-level reverse))
-
-(defun gnus-group-sort-selected-groups-by-score (&optional n reverse)
- "Sort the group buffer by group score.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-score reverse))
-
-(defun gnus-group-sort-selected-groups-by-rank (&optional n reverse)
- "Sort the group buffer by group rank.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-rank reverse))
-
-(defun gnus-group-sort-selected-groups-by-method (&optional n reverse)
- "Sort the group buffer alphabetically by back end name.
-Obeys the process/prefix convention. If REVERSE (the symbolic prefix),
-sort in reverse order."
- (interactive (gnus-interactive "P\ny"))
- (gnus-group-sort-selected-groups n 'gnus-group-sort-by-method reverse))
-
-;;; Sorting predicates.
-
-(defun gnus-group-sort-by-alphabet (info1 info2)
- "Sort alphabetically."
- (string< (gnus-info-group info1) (gnus-info-group info2)))
-
-(defun gnus-group-sort-by-real-name (info1 info2)
- "Sort alphabetically on real (unprefixed) names."
- (string< (gnus-group-real-name (gnus-info-group info1))
- (gnus-group-real-name (gnus-info-group info2))))
-
-(defun gnus-group-sort-by-unread (info1 info2)
- "Sort by number of unread articles."
- (let ((n1 (car (gnus-gethash (gnus-info-group info1) gnus-newsrc-hashtb)))
- (n2 (car (gnus-gethash (gnus-info-group info2) gnus-newsrc-hashtb))))
- (< (or (and (numberp n1) n1) 0)
- (or (and (numberp n2) n2) 0))))
-
-(defun gnus-group-sort-by-level (info1 info2)
- "Sort by level."
- (< (gnus-info-level info1) (gnus-info-level info2)))
-
-(defun gnus-group-sort-by-method (info1 info2)
- "Sort alphabetically by back end name."
- (string< (car (gnus-find-method-for-group
- (gnus-info-group info1) info1))
- (car (gnus-find-method-for-group
- (gnus-info-group info2) info2))))
-
-(defun gnus-group-sort-by-server (info1 info2)
- "Sort alphabetically by server name."
- (string< (gnus-method-to-full-server-name
- (gnus-find-method-for-group
- (gnus-info-group info1) info1))
- (gnus-method-to-full-server-name
- (gnus-find-method-for-group
- (gnus-info-group info2) info2))))
-
-(defun gnus-group-sort-by-score (info1 info2)
- "Sort by group score."
- (> (gnus-info-score info1) (gnus-info-score info2)))
-
-(defun gnus-group-sort-by-rank (info1 info2)
- "Sort by level and score."
- (let ((level1 (gnus-info-level info1))
- (level2 (gnus-info-level info2)))
- (or (< level1 level2)
- (and (= level1 level2)
- (> (gnus-info-score info1) (gnus-info-score info2))))))
-
-;;; Clearing data
-
-(defun gnus-group-clear-data (&optional arg)
- "Clear all marks and read ranges from the current group.
-Obeys the process/prefix convention."
- (interactive "P")
- (gnus-group-iterate arg
- (lambda (group)
- (let (info)
- (gnus-info-clear-data (setq info (gnus-get-info group)))
- (gnus-get-unread-articles-in-group info (gnus-active group) t)
- (when (gnus-group-goto-group group)
- (gnus-group-update-group-line))))))
-
-(defun gnus-group-clear-data-on-native-groups ()
- "Clear all marks and read ranges from all native groups."
- (interactive)
- (when (gnus-yes-or-no-p "Really clear all data from almost all groups? ")
- (let ((alist (cdr gnus-newsrc-alist))
- info)
- (while (setq info (pop alist))
- (when (gnus-group-native-p (gnus-info-group info))
- (gnus-info-clear-data info)))
- (gnus-get-unread-articles)
- (gnus-dribble-touch)
- (when (gnus-y-or-n-p
- "Move the cache away to avoid problems in the future? ")
- (call-interactively 'gnus-cache-move-cache)))))
-
-(defun gnus-info-clear-data (info)
- "Clear all marks and read ranges from INFO."
- (let ((group (gnus-info-group info))
- action)
- (dolist (el (gnus-info-marks info))
- (push `(,(cdr el) add (,(car el))) action))
- (push `(,(gnus-info-read info) add (read)) action)
- (gnus-undo-register
- `(progn
- (gnus-request-set-mark ,group ',action)
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (when (gnus-group-goto-group ,group)
- (gnus-get-unread-articles-in-group ',info ',(gnus-active group) t)
- (gnus-group-update-group-line))))
- (setq action (mapcar (lambda (el) (list (nth 0 el) 'del (nth 2 el)))
- action))
- (gnus-request-set-mark group action)
- (gnus-info-set-read info nil)
- (when (gnus-info-marks info)
- (gnus-info-set-marks info nil))))
-
-;; Group catching up.
-
-(defun gnus-group-catchup-current (&optional n all)
- "Mark all unread articles in the current newsgroup as read.
-If prefix argument N is numeric, the next N newsgroups will be
-caught up. If ALL is non-nil, marked articles will also be marked as
-read. Cross references (Xref: header) of articles are ignored.
-The number of newsgroups that this function was unable to catch
-up is returned."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n))
- (ret 0)
- group)
- (unless groups (error "No groups selected"))
- (if (not
- (or (not gnus-interactive-catchup) ;Without confirmation?
- gnus-expert-user
- (gnus-y-or-n-p
- (format
- (if all
- "Do you really want to mark all articles in %s as read? "
- "Mark all unread articles in %s as read? ")
- (if (= (length groups) 1)
- (gnus-group-decoded-name (car groups))
- (format "these %d groups" (length groups)))))))
- n
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- ;; Virtual groups have to be given special treatment.
- (let ((method (gnus-find-method-for-group group)))
- (when (eq 'nnvirtual (car method))
- (nnvirtual-catchup-group
- (gnus-group-real-name group) (nth 1 method) all)))
- (if (>= (gnus-group-level group) gnus-level-zombie)
- (gnus-message 2 "Dead groups can't be caught up")
- (if (prog1
- (gnus-group-goto-group group)
- (gnus-group-catchup group all))
- (gnus-group-update-group-line)
- (setq ret (1+ ret)))))
- (gnus-group-next-unread-group 1)
- ret)))
-
-(defun gnus-group-catchup-current-all (&optional n)
- "Mark all articles in current newsgroup as read.
-Cross references (Xref: header) of articles are ignored."
- (interactive "P")
- (gnus-group-catchup-current n 'all))
-
-(defun gnus-group-catchup (group &optional all)
- "Mark all articles in GROUP as read.
-If ALL is non-nil, all articles are marked as read.
-The return value is the number of articles that were marked as read,
-or nil if no action could be taken."
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (num (car entry))
- (marks (nth 3 (nth 2 entry)))
- (unread (gnus-sequence-of-unread-articles group)))
- ;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
- ;; Do the updating only if the newsgroup isn't killed.
- (if (not (numberp (car entry)))
- (gnus-message 1 "Can't catch up %s; non-active group" group)
- (gnus-update-read-articles group nil)
- (when all
- ;; Nix out the lists of marks and dormants.
- (gnus-request-set-mark group (list (list (cdr (assq 'tick marks))
- 'del '(tick))
- (list (cdr (assq 'dormant marks))
- 'del '(dormant))))
- (setq unread (gnus-range-add (gnus-range-add
- unread (cdr (assq 'dormant marks)))
- (cdr (assq 'tick marks))))
- (gnus-add-marked-articles group 'tick nil nil 'force)
- (gnus-add-marked-articles group 'dormant nil nil 'force))
- ;; Do auto-expirable marks if that's required.
- (when (gnus-group-auto-expirable-p group)
- (gnus-range-map (lambda (article)
- (gnus-add-marked-articles group 'expire (list article))
- (gnus-request-set-mark group (list (list (list article) 'add '(expire)))))
- unread))
- (let ((gnus-newsgroup-name group))
- (gnus-run-hooks 'gnus-group-catchup-group-hook))
- num)))
-
-(defun gnus-group-expire-articles (&optional n)
- "Expire all expirable articles in the current newsgroup.
-Uses the process/prefix convention."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n))
- group)
- (unless groups
- (error "No groups to expire"))
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (gnus-group-expire-articles-1 group)
- (gnus-dribble-touch)
- (gnus-group-position-point))))
-
-(defun gnus-group-expire-articles-1 (group)
- (when (gnus-check-backend-function 'request-expire-articles group)
- (gnus-message 6 "Expiring articles in %s..."
- (gnus-group-decoded-name group))
- (let* ((info (gnus-get-info group))
- (expirable (if (gnus-group-total-expirable-p group)
- (cons nil (gnus-list-of-read-articles group))
- (assq 'expire (gnus-info-marks info))))
- (expiry-wait (gnus-group-find-parameter group 'expiry-wait))
- (nnmail-expiry-target
- (or (gnus-group-find-parameter group 'expiry-target)
- nnmail-expiry-target)))
- (when expirable
- (gnus-check-group group)
- (setcdr
- expirable
- (gnus-compress-sequence
- (if expiry-wait
- ;; We set the expiry variables to the group
- ;; parameter.
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))
- ;; Just expire using the normal expiry values.
- (gnus-request-expire-articles
- (gnus-uncompress-sequence (cdr expirable)) group))))
- (gnus-close-group group))
- (gnus-message 6 "Expiring articles in %s...done"
- (gnus-group-decoded-name group))
- ;; Return the list of un-expired articles.
- (cdr expirable))))
-
-(defun gnus-group-expire-all-groups ()
- "Expire all expirable articles in all newsgroups."
- (interactive)
- (save-excursion
- (gnus-message 5 "Expiring...")
- (let ((gnus-group-marked (mapcar (lambda (info) (gnus-info-group info))
- (cdr gnus-newsrc-alist))))
- (gnus-group-expire-articles nil)))
- (gnus-group-position-point)
- (gnus-message 5 "Expiring...done"))
-
-(defun gnus-group-set-current-level (n level)
- "Set the level of the next N groups to LEVEL."
- (interactive
- (list
- current-prefix-arg
- (progn
- (unless (gnus-group-process-prefix current-prefix-arg)
- (error "No group on the current line"))
- (string-to-number
- (let ((s (read-string
- (format "Level (default %s): "
- (or (gnus-group-group-level)
- gnus-level-default-subscribed)))))
- (if (string-match "^\\s-*$" s)
- (int-to-string (or (gnus-group-group-level)
- gnus-level-default-subscribed))
- s))))))
- (unless (and (>= level 1) (<= level gnus-level-killed))
- (error "Invalid level: %d" level))
- (let ((groups (gnus-group-process-prefix n))
- group)
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- (gnus-message 6 "Changed level of %s from %d to %d"
- (gnus-group-decoded-name group)
- (or (gnus-group-group-level) gnus-level-killed)
- level)
- (gnus-group-change-level
- group level (or (gnus-group-group-level) gnus-level-killed))
- (gnus-group-update-group-line)))
- (gnus-group-position-point))
-
-(defun gnus-group-unsubscribe (&optional n)
- "Unsubscribe the current group."
- (interactive "P")
- (gnus-group-unsubscribe-current-group n 'unsubscribe))
-
-(defun gnus-group-subscribe (&optional n)
- "Subscribe the current group."
- (interactive "P")
- (gnus-group-unsubscribe-current-group n 'subscribe))
-
-(defun gnus-group-unsubscribe-current-group (&optional n do-sub)
- "Toggle subscription of the current group.
-If given numerical prefix, toggle the N next groups."
- (interactive "P")
- (dolist (group (gnus-group-process-prefix n))
- (gnus-group-remove-mark group)
- (gnus-group-unsubscribe-group
- group
- (cond
- ((eq do-sub 'unsubscribe)
- gnus-level-default-unsubscribed)
- ((eq do-sub 'subscribe)
- gnus-level-default-subscribed)
- ((<= (gnus-group-group-level) gnus-level-subscribed)
- gnus-level-default-unsubscribed)
- (t
- gnus-level-default-subscribed))
- t)
- (gnus-group-update-group-line))
- (gnus-group-next-group 1))
-
-(defun gnus-group-unsubscribe-group (group &optional level silent)
- "Toggle subscription to GROUP.
-Killed newsgroups are subscribed. If SILENT, don't try to update the
-group line."
- (interactive
- (list (completing-read
- "Group: " gnus-active-hashtb nil
- (gnus-read-active-file-p)
- nil
- 'gnus-group-history)))
- (let ((newsrc (gnus-gethash group gnus-newsrc-hashtb)))
- (cond
- ((string-match "^[ \t]*$" group)
- (error "Empty group name"))
- (newsrc
- ;; Toggle subscription flag.
- (gnus-group-change-level
- newsrc (if level level (if (<= (gnus-info-level (nth 2 newsrc))
- gnus-level-subscribed)
- (1+ gnus-level-subscribed)
- gnus-level-default-subscribed)))
- (unless silent
- (gnus-group-update-group group)))
- ((and (stringp group)
- (or (not (gnus-read-active-file-p))
- (gnus-active group)))
- ;; Add new newsgroup.
- (gnus-group-change-level
- group
- (if level level gnus-level-default-subscribed)
- (or (and (member group gnus-zombie-list)
- gnus-level-zombie)
- gnus-level-killed)
- (when (gnus-group-group-name)
- (gnus-gethash (gnus-group-group-name) gnus-newsrc-hashtb)))
- (unless silent
- (gnus-group-update-group group)))
- (t (error "No such newsgroup: %s" group)))
- (gnus-group-position-point)))
-
-(defun gnus-group-transpose-groups (n)
- "Move the current newsgroup up N places.
-If given a negative prefix, move down instead. The difference between
-N and the number of steps taken is returned."
- (interactive "p")
- (unless (gnus-group-group-name)
- (error "No group on current line"))
- (gnus-group-kill-group 1)
- (prog1
- (forward-line (- n))
- (gnus-group-yank-group)
- (gnus-group-position-point)))
-
-(defun gnus-group-kill-all-zombies (&optional dummy)
- "Kill all zombie newsgroups.
-The optional DUMMY should always be nil."
- (interactive (list (not (gnus-yes-or-no-p "Really kill all zombies? "))))
- (unless dummy
- (setq gnus-killed-list (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil)
- (gnus-dribble-touch)
- (gnus-group-list-groups)))
-
-(defun gnus-group-kill-region (begin end)
- "Kill newsgroups in current region (excluding current point).
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group]."
- (interactive "r")
- (let ((lines
- ;; Count lines.
- (save-excursion
- (count-lines
- (progn
- (goto-char begin)
- (beginning-of-line)
- (point))
- (progn
- (goto-char end)
- (beginning-of-line)
- (point))))))
- (goto-char begin)
- (beginning-of-line) ;Important when LINES < 1
- (gnus-group-kill-group lines)))
-
-(defun gnus-group-kill-group (&optional n discard)
- "Kill the next N groups.
-The killed newsgroups can be yanked by using \\[gnus-group-yank-group].
-However, only groups that were alive can be yanked; already killed
-groups or zombie groups can't be yanked.
-The return value is the name of the group that was killed, or a list
-of groups killed."
- (interactive "P")
- (let ((buffer-read-only nil)
- (groups (gnus-group-process-prefix n))
- group entry level out)
- (if (< (length groups) 10)
- ;; This is faster when there are few groups.
- (while groups
- (push (setq group (pop groups)) out)
- (gnus-group-remove-mark group)
- (setq level (gnus-group-group-level))
- (gnus-delete-line)
- (when (and (not discard)
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)))
- (gnus-undo-register
- `(progn
- (gnus-group-goto-group ,(gnus-group-group-name))
- (gnus-group-yank-group)))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups))
- (gnus-group-change-level
- (if entry entry group) gnus-level-killed (if entry nil level))
- (message "Killed group %s" (gnus-group-decoded-name group)))
- ;; If there are lots and lots of groups to be killed, we use
- ;; this thing instead.
- (dolist (group (nreverse groups))
- (gnus-group-remove-mark group)
- (gnus-delete-line)
- (push group gnus-killed-list)
- (setq gnus-newsrc-alist
- (delq (assoc group gnus-newsrc-alist)
- gnus-newsrc-alist))
- (when gnus-group-change-level-function
- (funcall gnus-group-change-level-function
- group gnus-level-killed 3))
- (cond
- ((setq entry (gnus-gethash group gnus-newsrc-hashtb))
- (push (cons (car entry) (nth 2 entry))
- gnus-list-of-killed-groups)
- (setcdr (cdr entry) (cdddr entry)))
- ((member group gnus-zombie-list)
- (setq gnus-zombie-list (delete group gnus-zombie-list))))
- ;; There may be more than one instance displayed.
- (while (gnus-group-goto-group group)
- (gnus-delete-line)))
- (gnus-make-hashtable-from-newsrc-alist))
-
- (gnus-group-position-point)
- (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-yank-group (&optional arg)
- "Yank the last newsgroups killed with \\[gnus-group-kill-group], inserting it before the current newsgroup.
-The numeric ARG specifies how many newsgroups are to be yanked. The
-name of the newsgroup yanked is returned, or (if several groups are
-yanked) a list of yanked groups is returned."
- (interactive "p")
- (setq arg (or arg 1))
- (let (info group prev out)
- (while (>= (decf arg) 0)
- (when (not (setq info (pop gnus-list-of-killed-groups)))
- (error "No more newsgroups to yank"))
- (push (setq group (nth 1 info)) out)
- ;; Find which newsgroup to insert this one before - search
- ;; backward until something suitable is found. If there are no
- ;; other newsgroups in this buffer, just make this newsgroup the
- ;; first newsgroup.
- (setq prev (gnus-group-group-name))
- (gnus-group-change-level
- info (gnus-info-level (cdr info)) gnus-level-killed
- (and prev (gnus-gethash prev gnus-newsrc-hashtb))
- t)
- (gnus-group-insert-group-line-info group)
- (gnus-undo-register
- `(when (gnus-group-goto-group ,group)
- (gnus-group-kill-group 1))))
- (forward-line -1)
- (gnus-group-position-point)
- (if (< (length out) 2) (car out) (nreverse out))))
-
-(defun gnus-group-kill-level (level)
- "Kill all groups that is on a certain LEVEL."
- (interactive "nKill all groups on level: ")
- (cond
- ((= level gnus-level-zombie)
- (setq gnus-killed-list
- (nconc gnus-zombie-list gnus-killed-list))
- (setq gnus-zombie-list nil))
- ((and (< level gnus-level-zombie)
- (> level 0)
- (or gnus-expert-user
- (gnus-yes-or-no-p
- (format
- "Do you really want to kill all groups on level %d? "
- level))))
- (let* ((prev gnus-newsrc-alist)
- (alist (cdr prev)))
- (while alist
- (if (= (gnus-info-level (car alist)) level)
- (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)
- (gnus-group-list-groups)))
- (t
- (error "Can't kill; invalid level: %d" level))))
-
-(defun gnus-group-list-all-groups (&optional arg)
- "List all newsgroups with level ARG or lower.
-Default is `gnus-level-unsubscribed', which lists all subscribed and most
-unsubscribed groups."
- (interactive "P")
- (gnus-group-list-groups (or arg gnus-level-unsubscribed) t))
-
-;; Redefine this to list ALL killed groups if prefix arg used.
-;; Rewritten by engstrom@src.honeywell.com (Eric Engstrom).
-(defun gnus-group-list-killed (&optional arg)
- "List all killed newsgroups in the group buffer.
-If ARG is non-nil, list ALL killed groups known to Gnus. This may
-entail asking the server for the groups."
- (interactive "P")
- ;; Find all possible killed newsgroups if arg.
- (when arg
- (gnus-get-killed-groups))
- (if (not gnus-killed-list)
- (gnus-message 6 "No killed groups")
- (let (gnus-group-list-mode)
- (funcall gnus-group-prepare-function
- gnus-level-killed t gnus-level-killed))
- (goto-char (point-min)))
- (gnus-group-position-point))
-
-(defun gnus-group-list-zombies ()
- "List all zombie newsgroups in the group buffer."
- (interactive)
- (if (not gnus-zombie-list)
- (gnus-message 6 "No zombie groups")
- (let (gnus-group-list-mode)
- (funcall gnus-group-prepare-function
- gnus-level-zombie t gnus-level-zombie))
- (goto-char (point-min)))
- (gnus-group-position-point))
-
-(defun gnus-group-list-active ()
- "List all groups that are available from the server(s)."
- (interactive)
- ;; First we make sure that we have really read the active file.
- (unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t)
- (gnus-agent gnus-plugged)); If we're actually plugged, store the active file in the agent.
- (gnus-read-active-file)))
- ;; Find all groups and sort them.
- (let ((groups
- (sort
- (let (list)
- (mapatoms
- (lambda (sym)
- (and (boundp sym)
- (symbol-value sym)
- (push (symbol-name sym) list)))
- gnus-active-hashtb)
- list)
- 'string<))
- (buffer-read-only nil)
- group)
- (erase-buffer)
- (while groups
- (setq group (pop groups))
- (gnus-add-text-properties
- (point) (prog1 (1+ (point))
- (insert " *: "
- (gnus-group-decoded-name group)
- "\n"))
- (list 'gnus-group (gnus-intern-safe group gnus-active-hashtb)
- 'gnus-unread t
- 'gnus-level (inline (gnus-group-level group)))))
- (goto-char (point-min))))
-
-(defun gnus-activate-all-groups (level)
- "Activate absolutely all groups."
- (interactive (list gnus-level-unsubscribed))
- (let ((gnus-activate-level level)
- (gnus-activate-foreign-newsgroups level))
- (gnus-group-get-new-news)))
-
-(defun gnus-group-get-new-news (&optional arg)
- "Get newly arrived articles.
-If ARG is a number, it specifies which levels you are interested in
-re-scanning. If ARG is non-nil and not a number, this will force
-\"hard\" re-reading of the active files from all servers."
- (interactive "P")
- (require 'nnmail)
- (let ((gnus-inhibit-demon t)
- ;; Binding this variable will inhibit multiple fetchings
- ;; of the same mail source.
- (nnmail-fetched-sources (list t)))
- (gnus-run-hooks 'gnus-get-top-new-news-hook)
- (gnus-run-hooks 'gnus-get-new-news-hook)
-
- ;; Read any slave files.
- (unless gnus-slave
- (gnus-master-read-slave-newsrc))
-
- ;; We might read in new NoCeM messages here.
- (when (and gnus-use-nocem
- (or (and (numberp gnus-use-nocem)
- (numberp arg)
- (>= arg gnus-use-nocem))
- (not arg)))
- (gnus-nocem-scan-groups))
- ;; If ARG is not a number, then we read the active file.
- (when (and arg (not (numberp arg)))
- (let ((gnus-read-active-file t))
- (gnus-read-active-file))
- (setq arg nil)
-
- ;; If the user wants it, we scan for new groups.
- (when (eq gnus-check-new-newsgroups 'always)
- (gnus-find-new-newsgroups)))
-
- (setq arg (gnus-group-default-level arg t))
- (if (and gnus-read-active-file (not arg))
- (progn
- (gnus-read-active-file)
- (gnus-get-unread-articles arg))
- (let ((gnus-read-active-file (if arg nil gnus-read-active-file)))
- (gnus-get-unread-articles arg)))
- (gnus-run-hooks 'gnus-after-getting-new-news-hook)
- (gnus-group-list-groups (and (numberp arg)
- (max (car gnus-group-list-mode) arg)))))
-
-(defun gnus-group-get-new-news-this-group (&optional n dont-scan)
- "Check for newly arrived news in the current group (and the N-1 next groups).
-The difference between N and the number of newsgroup checked is returned.
-If N is negative, this group and the N-1 previous groups will be checked.
-If DONT-SCAN is non-nil, scan non-activated groups as well."
- (interactive "P")
- (let* ((groups (gnus-group-process-prefix n))
- (ret (if (numberp n) (- n (length groups)) 0))
- (beg (unless n
- (point)))
- group method
- (gnus-inhibit-demon t)
- ;; Binding this variable will inhibit multiple fetchings
- ;; of the same mail source.
- (nnmail-fetched-sources (list t)))
- (gnus-run-hooks 'gnus-get-new-news-hook)
- (while (setq group (pop groups))
- (gnus-group-remove-mark group)
- ;; Bypass any previous denials from the server.
- (gnus-remove-denial (setq method (gnus-find-method-for-group group)))
- (if (gnus-activate-group group (if dont-scan nil 'scan))
- (progn
- (gnus-get-unread-articles-in-group
- (gnus-get-info group) (gnus-active group) t)
- (unless (gnus-virtual-group-p group)
- (gnus-close-group group))
- (when gnus-agent
- (gnus-agent-save-group-info
- method (gnus-group-real-name group) (gnus-active group)))
- (gnus-group-update-group group))
- (if (eq (gnus-server-status (gnus-find-method-for-group group))
- 'denied)
- (gnus-error 3 "Server denied access")
- (gnus-error 3 "%s error: %s" group (gnus-status-message group)))))
- (when beg
- (goto-char beg))
- (when gnus-goto-next-group-when-activating
- (gnus-group-next-unread-group 1 t))
- (gnus-summary-position-point)
- ret))
-
-(defun gnus-group-fetch-faq (group &optional faq-dir)
- "Fetch the FAQ for the current group.
-If given a prefix argument, prompt for the FAQ dir
-to use."
- (interactive
- (list
- (gnus-group-group-name)
- (when current-prefix-arg
- (completing-read
- "FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar #'list
- gnus-group-faq-directory))))))
- (unless group
- (error "No group name given"))
- (let ((dirs (or faq-dir gnus-group-faq-directory))
- dir found file)
- (unless (listp dirs)
- (setq dirs (list dirs)))
- (while (and (not found)
- (setq dir (pop dirs)))
- (let ((name (gnus-group-real-name group)))
- (setq file (expand-file-name name dir)))
- (if (not (file-exists-p file))
- (gnus-message 1 "No such file: %s" file)
- (let ((enable-local-variables nil))
- (find-file file)
- (setq found t))))))
-
-(defun gnus-group-fetch-charter (group)
- "Fetch the charter for the current group.
-If given a prefix argument, prompt for a group."
- (interactive
- (list (or (when current-prefix-arg
- (completing-read "Group: " gnus-active-hashtb))
- (gnus-group-group-name)
- gnus-newsgroup-name)))
- (unless group
- (error "No group name given"))
- (require 'mm-url)
- (condition-case nil (require 'url-http) (error nil))
- (let ((name (mm-url-form-encode-xwfu (gnus-group-real-name group)))
- url hierarchy)
- (when (string-match "\\(^[^\\.]+\\)\\..*" name)
- (setq hierarchy (match-string 1 name))
- (if (and (setq url (cdr (assoc hierarchy gnus-group-charter-alist)))
- (if (fboundp 'url-http-file-exists-p)
- (url-http-file-exists-p (eval url))
- t))
- (browse-url (eval url))
- (setq url (concat "http://" hierarchy
- ".news-admin.org/charters/" name))
- (if (and (fboundp 'url-http-file-exists-p)
- (url-http-file-exists-p url))
- (browse-url url)
- (gnus-group-fetch-control group))))))
-
-(defun gnus-group-fetch-control (group)
- "Fetch the archived control messages for the current group.
-If given a prefix argument, prompt for a group."
- (interactive
- (list (or (when current-prefix-arg
- (completing-read "Group: " gnus-active-hashtb))
- (gnus-group-group-name)
- gnus-newsgroup-name)))
- (unless group
- (error "No group name given"))
- (let ((name (gnus-group-real-name group))
- hierarchy)
- (when (string-match "\\(^[^\\.]+\\)\\..*" name)
- (setq hierarchy (match-string 1 name))
- (if gnus-group-fetch-control-use-browse-url
- (browse-url (concat "ftp://ftp.isc.org/usenet/control/"
- hierarchy "/" name ".gz"))
- (let ((enable-local-variables nil))
- (gnus-group-read-ephemeral-group
- group
- `(nndoc ,group (nndoc-address
- ,(find-file-noselect
- (concat "/ftp@ftp.isc.org:/usenet/control/"
- hierarchy "/" name ".gz")))
- (nndoc-article-type mbox)) t nil nil))))))
-
-(defun gnus-group-describe-group (force &optional group)
- "Display a description of the current newsgroup."
- (interactive (list current-prefix-arg (gnus-group-group-name)))
- (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))
- (unless group
- (error "No group name given"))
- (when (or (and gnus-description-hashtb
- ;; We check whether this group's method has been
- ;; queried for a description file.
- (gnus-gethash mname gnus-description-hashtb))
- (setq desc (gnus-group-get-description group))
- (gnus-read-descriptions-file method))
- (gnus-message 1
- (or desc (gnus-gethash group gnus-description-hashtb)
- "No description available")))))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-group-describe-all-groups (&optional force)
- "Pop up a buffer with descriptions of all newsgroups."
- (interactive "P")
- (when force
- (setq gnus-description-hashtb nil))
- (when (not (or gnus-description-hashtb
- (gnus-read-all-descriptions-files)))
- (error "Couldn't request descriptions file"))
- (let ((buffer-read-only nil)
- b)
- (erase-buffer)
- (mapatoms
- (lambda (group)
- (setq b (point))
- (let ((charset (gnus-group-name-charset nil (symbol-name group))))
- (insert (format " *: %-20s %s\n"
- (gnus-group-name-decode
- (symbol-name group) charset)
- (gnus-group-name-decode
- (symbol-value group) charset))))
- (gnus-add-text-properties
- b (1+ b) (list 'gnus-group group
- 'gnus-unread t 'gnus-marked nil
- 'gnus-level (1+ gnus-level-subscribed))))
- gnus-description-hashtb)
- (goto-char (point-min))
- (gnus-group-position-point)))
-
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-group-apropos (regexp &optional search-description)
- "List all newsgroups that have names that match a regexp."
- (interactive "sGnus apropos (regexp): ")
- (let ((prev "")
- (obuf (current-buffer))
- groups des)
- ;; Go through all newsgroups that are known to Gnus.
- (mapatoms
- (lambda (group)
- (and (symbol-name group)
- (string-match regexp (symbol-name group))
- (symbol-value group)
- (push (symbol-name group) groups)))
- gnus-active-hashtb)
- ;; Also go through all descriptions that are known to Gnus.
- (when search-description
- (mapatoms
- (lambda (group)
- (and (string-match regexp (symbol-value group))
- (push (symbol-name group) groups)))
- gnus-description-hashtb))
- (if (not groups)
- (gnus-message 3 "No groups matched \"%s\"." regexp)
- ;; Print out all the groups.
- (save-excursion
- (pop-to-buffer "*Gnus Help*")
- (buffer-disable-undo)
- (erase-buffer)
- (setq groups (sort groups 'string<))
- (while groups
- ;; Groups may be entered twice into the list of groups.
- (when (not (string= (car groups) prev))
- (setq prev (car groups))
- (let ((charset (gnus-group-name-charset nil prev)))
- (insert (gnus-group-name-decode prev charset) "\n")
- (when (and gnus-description-hashtb
- (setq des (gnus-gethash (car groups)
- gnus-description-hashtb)))
- (insert " " (gnus-group-name-decode des charset) "\n"))))
- (setq groups (cdr groups)))
- (goto-char (point-min))))
- (pop-to-buffer obuf)))
-
-(defun gnus-group-description-apropos (regexp)
- "List all newsgroups that have names or descriptions that match REGEXP."
- (interactive "sGnus description apropos (regexp): ")
- (when (not (or gnus-description-hashtb
- (gnus-read-all-descriptions-files)))
- (error "Couldn't request descriptions file"))
- (gnus-group-apropos regexp t))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-group-list-matching (level regexp &optional all lowest)
- "List all groups with unread articles that match REGEXP.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If ALL, also list groups with no unread articles.
-If LOWEST, don't list groups with level lower than LOWEST.
-
-This command may read the active file."
- (interactive "P\nsList newsgroups matching: ")
- ;; First make sure active file has been read.
- (when (and level
- (> (prefix-numeric-value level) gnus-level-killed))
- (gnus-get-killed-groups))
- (funcall gnus-group-prepare-function
- (or level gnus-level-subscribed) (and all t) (or lowest 1) regexp)
- (goto-char (point-min))
- (gnus-group-position-point))
-
-(defun gnus-group-list-all-matching (level regexp &optional lowest)
- "List all groups that match REGEXP.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If LOWEST, don't list groups with level lower than LOWEST."
- (interactive "P\nsList newsgroups matching: ")
- (when level
- (setq level (prefix-numeric-value level)))
- (gnus-group-list-matching (or level gnus-level-killed) regexp t lowest))
-
-;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-group-save-newsrc (&optional force)
- "Save the Gnus startup files.
-If FORCE, force saving whether it is necessary or not."
- (interactive "P")
- (gnus-save-newsrc-file force))
-
-(defun gnus-group-restart (&optional arg)
- "Force Gnus to read the .newsrc file."
- (interactive "P")
- (when (gnus-yes-or-no-p
- (format "Are you sure you want to restart Gnus? "))
- (gnus-save-newsrc-file)
- (gnus-clear-system)
- (gnus)))
-
-(defun gnus-group-read-init-file ()
- "Read the Gnus elisp init file."
- (interactive)
- (gnus-read-init-file)
- (gnus-message 5 "Read %s" gnus-init-file))
-
-(defun gnus-group-check-bogus-groups (&optional silent)
- "Check bogus newsgroups.
-If given a prefix, don't ask for confirmation before removing a bogus
-group."
- (interactive "P")
- (gnus-check-bogus-newsgroups (and (not silent) (not gnus-expert-user)))
- (gnus-group-list-groups))
-
-(defun gnus-group-find-new-groups (&optional arg)
- "Search for new groups and add them.
-Each new group will be treated with `gnus-subscribe-newsgroup-method'.
-With 1 C-u, use the `ask-server' method to query the server for new
-groups.
-With 2 C-u's, use most complete method possible to query the server
-for new groups, and subscribe the new groups as zombies."
- (interactive "p")
- (gnus-find-new-newsgroups (or arg 1))
- (gnus-group-list-groups))
-
-(defun gnus-group-edit-global-kill (&optional article group)
- "Edit the global kill file.
-If GROUP, edit that local kill file instead."
- (interactive "P")
- (setq gnus-current-kill-article article)
- (gnus-kill-file-edit-file group)
- (gnus-message
- 6
- (substitute-command-keys
- (format "Editing a %s kill file (Type \\[gnus-kill-file-exit] to exit)"
- (if group "local" "global")))))
-
-(defun gnus-group-edit-local-kill (article group)
- "Edit a local kill file."
- (interactive (list nil (gnus-group-group-name)))
- (gnus-group-edit-global-kill article group))
-
-(defun gnus-group-force-update ()
- "Update `.newsrc' file."
- (interactive)
- (gnus-save-newsrc-file))
-
-(defvar gnus-backlog-articles)
-
-(defun gnus-group-suspend ()
- "Suspend the current Gnus session.
-In fact, cleanup buffers except for group mode buffer.
-The hook `gnus-suspend-gnus-hook' is called before actually suspending."
- (interactive)
- (gnus-run-hooks 'gnus-suspend-gnus-hook)
- (gnus-offer-save-summaries)
- ;; Kill Gnus buffers except for group mode buffer.
- (let ((group-buf (get-buffer gnus-group-buffer)))
- (mapcar (lambda (buf)
- (unless (or (member buf (list group-buf gnus-dribble-buffer))
- (progn
- (save-excursion
- (set-buffer buf)
- (eq major-mode 'message-mode))))
- (gnus-kill-buffer buf)))
- (gnus-buffers))
- (setq gnus-backlog-articles nil)
- (gnus-kill-gnus-frames)
- (when group-buf
- (bury-buffer group-buf)
- (delete-windows-on group-buf t))))
-
-(defun gnus-group-clear-dribble ()
- "Clear all information from the dribble buffer."
- (interactive)
- (gnus-dribble-clear)
- (gnus-message 7 "Cleared dribble buffer"))
-
-(defun gnus-group-exit ()
- "Quit reading news after updating .newsrc.eld and .newsrc.
-The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
- (when
- (or noninteractive ;For gnus-batch-kill
- (not gnus-interactive-exit) ;Without confirmation
- gnus-expert-user
- (gnus-y-or-n-p "Are you sure you want to quit reading news? "))
- (gnus-run-hooks 'gnus-exit-gnus-hook)
- ;; Offer to save data from non-quitted summary buffers.
- (gnus-offer-save-summaries)
- ;; Save the newsrc file(s).
- (gnus-save-newsrc-file)
- ;; Kill-em-all.
- (gnus-close-backends)
- ;; Reset everything.
- (gnus-clear-system)
- ;; Allow the user to do things after cleaning up.
- (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
-
-(defun gnus-group-quit ()
- "Quit reading news without updating .newsrc.eld or .newsrc.
-The hook `gnus-exit-gnus-hook' is called before actually exiting."
- (interactive)
- (when (or noninteractive ;For gnus-batch-kill
- (zerop (buffer-size))
- (not (gnus-server-opened gnus-select-method))
- gnus-expert-user
- (not gnus-current-startup-file)
- (gnus-yes-or-no-p
- (format "Quit reading news without saving %s? "
- (file-name-nondirectory gnus-current-startup-file))))
- (gnus-run-hooks 'gnus-exit-gnus-hook)
- (gnus-configure-windows 'group t)
- (when (and (gnus-buffer-live-p gnus-dribble-buffer)
- (not (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
- (buffer-size)))))
- (gnus-dribble-enter
- ";;; Gnus was exited on purpose without saving the .newsrc files."))
- (gnus-dribble-save)
- (gnus-close-backends)
- (gnus-clear-system)
- (gnus-kill-buffer gnus-group-buffer)
- ;; Allow the user to do things after cleaning up.
- (gnus-run-hooks 'gnus-after-exiting-gnus-hook)))
-
-(defun gnus-group-describe-briefly ()
- "Give a one line description of the group mode commands."
- (interactive)
- (gnus-message 7 (substitute-command-keys "\\<gnus-group-mode-map>\\[gnus-group-read-group]:Select \\[gnus-group-next-unread-group]:Forward \\[gnus-group-prev-unread-group]:Backward \\[gnus-group-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-group-describe-briefly]:This help")))
-
-(defun gnus-group-browse-foreign-server (method)
- "Browse a foreign news server.
-If called interactively, this function will ask for a select method
- (nntp, nnspool, etc.) and a server address (eg. nntp.some.where).
-If not, METHOD should be a list where the first element is the method
-and the second element is the address."
- (interactive
- (list (let ((how (completing-read
- "Which back end: "
- (append gnus-valid-select-methods gnus-server-alist)
- nil t (cons "nntp" 0) 'gnus-method-history)))
- ;; We either got a back end name or a virtual server name.
- ;; If the first, we also need an address.
- (if (assoc how gnus-valid-select-methods)
- (list (intern how)
- ;; Suggested by mapjph@bath.ac.uk.
- (completing-read
- "Address: "
- (mapcar (lambda (server) (list server))
- gnus-secondary-servers)))
- ;; We got a server name.
- how))))
- (gnus-browse-foreign-server method))
-
-(defun gnus-group-set-info (info &optional method-only-group part)
- (when (or info part)
- (let* ((entry (gnus-gethash
- (or method-only-group (gnus-info-group info))
- gnus-newsrc-hashtb))
- (part-info info)
- (info (if method-only-group (nth 2 entry) info))
- method)
- (when method-only-group
- (unless entry
- (error "Trying to change non-existent group %s" method-only-group))
- ;; We have received parts of the actual group info - either the
- ;; select method or the group parameters. We first check
- ;; whether we have to extend the info, and if so, do that.
- (let ((len (length info))
- (total (if (eq part 'method) 5 6)))
- (when (< len total)
- (setcdr (nthcdr (1- len) info)
- (make-list (- total len) nil)))
- ;; Then we enter the new info.
- (setcar (nthcdr (1- total) info) part-info)))
- (unless entry
- ;; This is a new group, so we just create it.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (setq method (gnus-info-method info))
- (when (gnus-server-equal method "native")
- (setq method nil))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (if method
- ;; It's a foreign group...
- (gnus-group-make-group
- (gnus-group-real-name (gnus-info-group info))
- (if (stringp method) method
- (prin1-to-string (car method)))
- (and (consp method)
- (nth 1 (gnus-info-method info))))
- ;; It's a native group.
- (gnus-group-make-group (gnus-info-group info))))
- (gnus-message 6 "Note: New group created")
- (setq entry
- (gnus-gethash (gnus-group-prefixed-name
- (gnus-group-real-name (gnus-info-group info))
- (or (gnus-info-method info) gnus-select-method))
- gnus-newsrc-hashtb))))
- ;; Whether it was a new group or not, we now have the entry, so we
- ;; can do the update.
- (if entry
- (progn
- (setcar (nthcdr 2 entry) info)
- (when (and (not (eq (car entry) t))
- (gnus-active (gnus-info-group info)))
- (setcar entry (length
- (gnus-list-of-unread-articles (car info))))))
- (error "No such group: %s" (gnus-info-group info))))))
-
-(defun gnus-group-set-method-info (group select-method)
- (gnus-group-set-info select-method group 'method))
-
-(defun gnus-group-set-params-info (group params)
- (gnus-group-set-info params group 'params))
-
-(defun gnus-add-marked-articles (group type articles &optional info force)
- ;; Add ARTICLES of TYPE to the info of GROUP.
- ;; If INFO is non-nil, use that info. If FORCE is non-nil, don't
- ;; add, but replace marked articles of TYPE with ARTICLES.
- (let ((info (or info (gnus-get-info group)))
- marked m)
- (or (not info)
- (and (not (setq marked (nthcdr 3 info)))
- (or (null articles)
- (setcdr (nthcdr 2 info)
- (list (list (cons type (gnus-compress-sequence
- articles t)))))))
- (and (not (setq m (assq type (car marked))))
- (or (null articles)
- (setcar marked
- (cons (cons type (gnus-compress-sequence articles t) )
- (car marked)))))
- (if force
- (if (null articles)
- (setcar (nthcdr 3 info)
- (gnus-delete-alist type (car marked)))
- (setcdr m (gnus-compress-sequence articles t)))
- (setcdr m (gnus-compress-sequence
- (sort (nconc (gnus-uncompress-range (cdr m))
- (copy-sequence articles)) '<) t))))))
-
-(defun gnus-add-mark (group mark article)
- "Mark ARTICLE in GROUP with MARK, whether the group is displayed or not."
- (let ((buffer (gnus-summary-buffer-name group)))
- (if (gnus-buffer-live-p buffer)
- (save-excursion
- (set-buffer (get-buffer buffer))
- (gnus-summary-add-mark article mark))
- (gnus-add-marked-articles group (cdr (assq mark gnus-article-mark-lists))
- (list article)))))
-
-;;;
-;;; Group timestamps
-;;;
-
-(defun gnus-group-set-timestamp ()
- "Change the timestamp of the current group to the current time.
-This function can be used in hooks like `gnus-select-group-hook'
-or `gnus-group-catchup-group-hook'."
- (when gnus-newsgroup-name
- (let ((time (current-time)))
- (setcdr (cdr time) nil)
- (gnus-group-set-parameter gnus-newsgroup-name 'timestamp time))))
-
-(defsubst gnus-group-timestamp (group)
- "Return the timestamp for GROUP."
- (gnus-group-get-parameter group 'timestamp t))
-
-(defun gnus-group-timestamp-delta (group)
- "Return the offset in seconds from the timestamp for GROUP to the current time, as a floating point number."
- (let* ((time (or (gnus-group-timestamp group)
- (list 0 0)))
- (delta (subtract-time (current-time) time)))
- (+ (* (nth 0 delta) 65536.0)
- (nth 1 delta))))
-
-(defun gnus-group-timestamp-string (group)
- "Return a string of the timestamp for GROUP."
- (let ((time (gnus-group-timestamp group)))
- (if (not time)
- ""
- (gnus-time-iso8601 time))))
-
-(defun gnus-group-list-cached (level &optional lowest)
- "List all groups with cached articles.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If LOWEST, don't list groups with level lower than LOWEST.
-
-This command may read the active file."
- (interactive "P")
- (when level
- (setq level (prefix-numeric-value level)))
- (when (or (not level) (>= level gnus-level-zombie))
- (gnus-cache-open))
- (funcall gnus-group-prepare-function
- (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'cache marks)))
- lowest
- #'(lambda (group)
- (or (gnus-gethash group
- gnus-cache-active-hashtb)
- ;; Cache active file might use "."
- ;; instead of ":".
- (gnus-gethash
- (mapconcat 'identity
- (split-string group ":")
- ".")
- gnus-cache-active-hashtb))))
- (goto-char (point-min))
- (gnus-group-position-point))
-
-(defun gnus-group-list-dormant (level &optional lowest)
- "List all groups with dormant articles.
-If the prefix LEVEL is non-nil, it should be a number that says which
-level to cut off listing groups.
-If LOWEST, don't list groups with level lower than LOWEST.
-
-This command may read the active file."
- (interactive "P")
- (when level
- (setq level (prefix-numeric-value level)))
- (when (or (not level) (>= level gnus-level-zombie))
- (gnus-cache-open))
- (funcall gnus-group-prepare-function
- (or level gnus-level-subscribed)
- #'(lambda (info)
- (let ((marks (gnus-info-marks info)))
- (assq 'dormant marks)))
- lowest
- 'ignore)
- (goto-char (point-min))
- (gnus-group-position-point))
-
-(defun gnus-group-listed-groups ()
- "Return a list of listed groups."
- (let (point groups)
- (goto-char (point-min))
- (while (setq point (text-property-not-all (point) (point-max)
- 'gnus-group nil))
- (goto-char point)
- (push (symbol-name (get-text-property point 'gnus-group)) groups)
- (forward-char 1))
- groups))
-
-(defun gnus-group-list-plus (&optional args)
- "List groups plus the current selection."
- (interactive "P")
- (let ((gnus-group-listed-groups (gnus-group-listed-groups))
- (gnus-group-list-mode gnus-group-list-mode) ;; Save it.
- func)
- (push last-command-event unread-command-events)
- (if (featurep 'xemacs)
- (push (make-event 'key-press '(key ?A)) unread-command-events)
- (push ?A unread-command-events))
- (let (gnus-pick-mode keys)
- (setq keys (if (featurep 'xemacs)
- (events-to-keys (read-key-sequence nil))
- (read-key-sequence nil)))
- (setq func (lookup-key (current-local-map) keys)))
- (if (or (not func)
- (numberp func))
- (ding)
- (call-interactively func))))
-
-(defun gnus-group-list-flush (&optional args)
- "Flush groups from the current selection."
- (interactive "P")
- (let ((gnus-group-list-option 'flush))
- (gnus-group-list-plus args)))
-
-(defun gnus-group-list-limit (&optional args)
- "List groups limited within the current selection."
- (interactive "P")
- (let ((gnus-group-list-option 'limit))
- (gnus-group-list-plus args)))
-
-(defun gnus-group-mark-article-read (group article)
- "Mark ARTICLE read."
- (let ((buffer (gnus-summary-buffer-name group))
- (mark gnus-read-mark)
- active n)
- (if (get-buffer buffer)
- (with-current-buffer buffer
- (setq active gnus-newsgroup-active)
- (gnus-activate-group group)
- (when gnus-newsgroup-prepared
- (when (and gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
- (setq mark gnus-expirable-mark))
- (setq mark (gnus-request-update-mark
- group article mark))
- (gnus-mark-article-as-read article mark)
- (setq gnus-newsgroup-active (gnus-active group))
- (when active
- (setq n (1+ (cdr active)))
- (while (<= n (cdr gnus-newsgroup-active))
- (unless (eq n article)
- (push n gnus-newsgroup-unselected))
- (setq n (1+ n)))
- (setq gnus-newsgroup-unselected
- (nreverse gnus-newsgroup-unselected)))))
- (gnus-activate-group group)
- (gnus-group-make-articles-read group (list article))
- (when (gnus-group-auto-expirable-p group)
- (gnus-add-marked-articles
- group 'expire (list article))))))
-
-(provide 'gnus-group)
-
-;;; arch-tag: 2eb5440f-0bca-4091-814c-e37817536af6
-;;; gnus-group.el ends here
+++ /dev/null
-;;; gnus-int.el --- backend interface functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'message)
-(require 'gnus-range)
-
-(autoload 'gnus-agent-expire "gnus-agent")
-(autoload 'gnus-agent-regenerate-group "gnus-agent")
-(autoload 'gnus-agent-read-servers-validate-native "gnus-agent")
-
-(defcustom gnus-open-server-hook nil
- "Hook called just before opening connection to the news server."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-server-unopen-status nil
- "The default status if the server is not able to open.
-If the server is covered by Gnus agent, the possible values are
-`denied', set the server denied; `offline', set the server offline;
-nil, ask user. If the server is not covered by Gnus agent, set the
-server denied."
- :version "22.1"
- :group 'gnus-start
- :type '(choice (const :tag "Ask" nil)
- (const :tag "Deny server" denied)
- (const :tag "Unplug Agent" offline)))
-
-(defvar gnus-internal-registry-spool-current-method nil
- "The current method, for the registry.")
-
-;;;
-;;; Server Communication
-;;;
-
-(defun gnus-start-news-server (&optional confirm)
- "Open a method for getting news.
-If CONFIRM is non-nil, the user will be asked for an NNTP server."
- (let (how)
- (if gnus-current-select-method
- ;; Stream is already opened.
- nil
- ;; Open NNTP server.
- (unless gnus-nntp-service
- (setq gnus-nntp-server nil))
- (when confirm
- ;; Read server name with completion.
- (setq gnus-nntp-server
- (completing-read "NNTP server: "
- (mapcar (lambda (server) (list server))
- (cons (list gnus-nntp-server)
- gnus-secondary-servers))
- nil nil gnus-nntp-server)))
-
- (when (and gnus-nntp-server
- (stringp gnus-nntp-server)
- (not (string= gnus-nntp-server "")))
- (setq gnus-select-method
- (cond ((or (string= gnus-nntp-server "")
- (string= gnus-nntp-server "::"))
- (list 'nnspool (system-name)))
- ((string-match "^:" gnus-nntp-server)
- (list 'nnmh gnus-nntp-server
- (list 'nnmh-directory
- (file-name-as-directory
- (expand-file-name
- (substring gnus-nntp-server 1) "~/")))
- (list 'nnmh-get-new-mail nil)))
- (t
- (list 'nntp gnus-nntp-server)))))
-
- (setq how (car gnus-select-method))
- (cond
- ((eq how 'nnspool)
- (require 'nnspool)
- (gnus-message 5 "Looking up local news spool..."))
- ((eq how 'nnmh)
- (require 'nnmh)
- (gnus-message 5 "Looking up mh spool..."))
- (t
- (require 'nntp)))
- (setq gnus-current-select-method gnus-select-method)
- (gnus-run-hooks 'gnus-open-server-hook)
-
- ;; Partially validate agent covered methods now that the
- ;; gnus-select-method is known.
-
- (if gnus-agent
- ;; NOTE: This is here for one purpose only. By validating
- ;; the current select method, it converts the old 5.10.3,
- ;; and earlier, format to the current format. That enables
- ;; the agent code within gnus-open-server to function
- ;; correctly.
- (gnus-agent-read-servers-validate-native gnus-select-method))
-
- (or
- ;; gnus-open-server-hook might have opened it
- (gnus-server-opened gnus-select-method)
- (gnus-open-server gnus-select-method)
- gnus-batch-mode
- (gnus-y-or-n-p
- (format
- "%s (%s) open error: '%s'. Continue? "
- (car gnus-select-method) (cadr gnus-select-method)
- (gnus-status-message gnus-select-method)))
- (gnus-error 1 "Couldn't open server on %s"
- (nth 1 gnus-select-method))))))
-
-(defun gnus-check-group (group)
- "Try to make sure that the server where GROUP exists is alive."
- (let ((method (gnus-find-method-for-group group)))
- (or (gnus-server-opened method)
- (gnus-open-server method))))
-
-(defun gnus-check-server (&optional method silent)
- "Check whether the connection to METHOD is down.
-If METHOD is nil, use `gnus-select-method'.
-If it is down, start it up (again)."
- (let ((method (or method gnus-select-method))
- result)
- ;; Transform virtual server names into select methods.
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- (if (gnus-server-opened method)
- ;; The stream is already opened.
- t
- ;; Open the server.
- (unless silent
- (gnus-message 5 "Opening %s server%s..." (car method)
- (if (equal (nth 1 method) "") ""
- (format " on %s" (nth 1 method)))))
- (gnus-run-hooks 'gnus-open-server-hook)
- (prog1
- (condition-case ()
- (setq result (gnus-open-server method))
- (quit (message "Quit gnus-check-server")
- nil))
- (unless silent
- (gnus-message 5 "Opening %s server%s...%s" (car method)
- (if (equal (nth 1 method) "") ""
- (format " on %s" (nth 1 method)))
- (if result "done" "failed")))))))
-
-(defun gnus-get-function (method function &optional noerror)
- "Return a function symbol based on METHOD and FUNCTION."
- ;; Translate server names into methods.
- (unless method
- (error "Attempted use of a nil select method"))
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- ;; Check cache of constructed names.
- (let* ((method-sym (if gnus-agent
- (inline (gnus-agent-get-function method))
- (car method)))
- (method-fns (get method-sym 'gnus-method-functions))
- (func (let ((method-fnlist-elt (assq function method-fns)))
- (unless method-fnlist-elt
- (setq method-fnlist-elt
- (cons function
- (intern (format "%s-%s" method-sym function))))
- (put method-sym 'gnus-method-functions
- (cons method-fnlist-elt method-fns)))
- (cdr method-fnlist-elt))))
- ;; Maybe complain if there is no function.
- (unless (fboundp func)
- (unless (car method)
- (error "Trying to require a method that doesn't exist"))
- (require (car method))
- (when (not (fboundp func))
- (if noerror
- (setq func nil)
- (error "No such function: %s" func))))
- func))
-
-\f
-;;;
-;;; Interface functions to the backends.
-;;;
-
-(defun gnus-open-server (gnus-command-method)
- "Open a connection to GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let ((elem (assoc gnus-command-method gnus-opened-servers)))
- ;; If this method was previously denied, we just return nil.
- (if (eq (nth 1 elem) 'denied)
- (progn
- (gnus-message 1 "Denied server")
- nil)
- ;; Open the server.
- (let* ((open-server-function (gnus-get-function gnus-command-method 'open-server))
- (result
- (condition-case err
- (funcall open-server-function
- (nth 1 gnus-command-method)
- (nthcdr 2 gnus-command-method))
- (error
- (gnus-message 1 (format
- "Unable to open server due to: %s"
- (error-message-string err)))
- nil)
- (quit
- (gnus-message 1 "Quit trying to open server")
- nil)))
- open-offline)
- ;; If this hasn't been opened before, we add it to the list.
- (unless elem
- (setq elem (list gnus-command-method nil)
- gnus-opened-servers (cons elem gnus-opened-servers)))
- ;; Set the status of this server.
- (setcar (cdr elem)
- (cond (result
- (if (eq open-server-function #'nnagent-open-server)
- ;; The agent's backend has a "special" status
- 'offline
- 'ok))
- ((and gnus-agent
- (gnus-agent-method-p gnus-command-method))
- (cond (gnus-server-unopen-status
- ;; Set the server's status to the unopen
- ;; status. If that status is offline,
- ;; recurse to open the agent's backend.
- (setq open-offline (eq gnus-server-unopen-status 'offline))
- gnus-server-unopen-status)
- ((and
- (not gnus-batch-mode)
- (gnus-y-or-n-p
- (format "Unable to open %s:%s, go offline? "
- (car gnus-command-method)
- (cadr gnus-command-method))))
- (setq open-offline t)
- 'offline)
- (t
- ;; This agentized server was still denied
- 'denied)))
- (t
- ;; This unagentized server must be denied
- 'denied)))
-
- ;; NOTE: I MUST set the server's status to offline before this
- ;; recursive call as this status will drive the
- ;; gnus-get-function (called above) to return the agent's
- ;; backend.
- (if open-offline
- ;; Recursively open this offline server to perform the
- ;; open-server function of the agent's backend.
- (let ((gnus-server-unopen-status 'denied))
- ;; Bind gnus-server-unopen-status to avoid recursively
- ;; prompting with "go offline?". This is only a concern
- ;; when the agent's backend fails to open the server.
- (gnus-open-server gnus-command-method))
- result)))))
-
-(defun gnus-close-server (gnus-command-method)
- "Close the connection to GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'close-server)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-list (gnus-command-method)
- "Request the active file from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-list)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-list-newsgroups (gnus-command-method)
- "Request the newsgroups file from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-list-newsgroups)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-newgroups (date gnus-command-method)
- "Request all new groups since DATE from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let ((func (gnus-get-function gnus-command-method 'request-newgroups t)))
- (when func
- (funcall func date (nth 1 gnus-command-method)))))
-
-(defun gnus-server-opened (gnus-command-method)
- "Check whether a connection to GNUS-COMMAND-METHOD has been opened."
- (unless (eq (gnus-server-status gnus-command-method)
- 'denied)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (inline (gnus-get-function gnus-command-method 'server-opened))
- (nth 1 gnus-command-method))))
-
-(defun gnus-status-message (gnus-command-method)
- "Return the status message from GNUS-COMMAND-METHOD.
-If GNUS-COMMAND-METHOD is a string, it is interpreted as a group
-name. The method this group uses will be queried."
- (let ((gnus-command-method
- (if (stringp gnus-command-method)
- (gnus-find-method-for-group gnus-command-method)
- gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'status-message)
- (nth 1 gnus-command-method))))
-
-(defun gnus-request-regenerate (gnus-command-method)
- "Request a data generation from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-regenerate)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-group (group &optional dont-check gnus-command-method)
- "Request GROUP. If DONT-CHECK, no information is required."
- (let ((gnus-command-method
- (or gnus-command-method (inline (gnus-find-method-for-group group)))))
- (when (stringp gnus-command-method)
- (setq gnus-command-method
- (inline (gnus-server-to-method gnus-command-method))))
- (funcall (inline (gnus-get-function gnus-command-method 'request-group))
- (gnus-group-real-name group) (nth 1 gnus-command-method)
- dont-check)))
-
-(defun gnus-list-active-group (group)
- "Request active information on GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'list-active-group))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
-(defun gnus-request-group-description (group)
- "Request a description of GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-description))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
-(defun gnus-request-group-articles (group)
- "Request a list of existing articles in GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group))
- (func 'request-group-articles))
- (when (gnus-check-backend-function func group)
- (funcall (gnus-get-function gnus-command-method func)
- (gnus-group-real-name group) (nth 1 gnus-command-method)))))
-
-(defun gnus-close-group (group)
- "Request the GROUP be closed."
- (let ((gnus-command-method (inline (gnus-find-method-for-group group))))
- (funcall (gnus-get-function gnus-command-method 'close-group)
- (gnus-group-real-name group) (nth 1 gnus-command-method))))
-
-(defun gnus-retrieve-headers (articles group &optional fetch-old)
- "Request headers for ARTICLES in GROUP.
-If FETCH-OLD, retrieve all headers (or some subset thereof) in the group."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (cond
- ((and gnus-use-cache (numberp (car articles)))
- (gnus-cache-retrieve-headers articles group fetch-old))
- ((and gnus-agent (gnus-online gnus-command-method)
- (gnus-agent-method-p gnus-command-method))
- (gnus-agent-retrieve-headers articles group fetch-old))
- (t
- (funcall (gnus-get-function gnus-command-method 'retrieve-headers)
- articles (gnus-group-real-name group)
- (nth 1 gnus-command-method) fetch-old)))))
-
-(defun gnus-retrieve-articles (articles group)
- "Request ARTICLES in GROUP."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'retrieve-articles)
- articles (gnus-group-real-name group)
- (nth 1 gnus-command-method))))
-
-(defun gnus-retrieve-groups (groups gnus-command-method)
- "Request active information on GROUPS from GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'retrieve-groups)
- groups (nth 1 gnus-command-method)))
-
-(defun gnus-request-type (group &optional article)
- "Return the type (`post' or `mail') of GROUP (and ARTICLE)."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (if (not (gnus-check-backend-function
- 'request-type (car gnus-command-method)))
- 'unknown
- (funcall (gnus-get-function gnus-command-method 'request-type)
- (gnus-group-real-name group) article))))
-
-(defun gnus-request-set-mark (group action)
- "Set marks on articles in the back end."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (if (not (gnus-check-backend-function
- 'request-set-mark (car gnus-command-method)))
- action
- (funcall (gnus-get-function gnus-command-method 'request-set-mark)
- (gnus-group-real-name group) action
- (nth 1 gnus-command-method)))))
-
-(defun gnus-request-update-mark (group article mark)
- "Allow the back end to change the mark the user tries to put on an article."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (if (not (gnus-check-backend-function
- 'request-update-mark (car gnus-command-method)))
- mark
- (funcall (gnus-get-function gnus-command-method 'request-update-mark)
- (gnus-group-real-name group) article mark))))
-
-(defun gnus-request-article (article group &optional buffer)
- "Request the ARTICLE in GROUP.
-ARTICLE can either be an article number or an article Message-ID.
-If BUFFER, insert the article in that group."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-article)
- article (gnus-group-real-name group)
- (nth 1 gnus-command-method) buffer)))
-
-(defun gnus-request-head (article group)
- "Request the head of ARTICLE in GROUP."
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (head (gnus-get-function gnus-command-method 'request-head t))
- res clean-up)
- (cond
- ;; Check the cache.
- ((and gnus-use-cache
- (numberp article)
- (gnus-cache-request-article article group))
- (setq res (cons group article)
- clean-up t))
- ;; Check the agent cache.
- ((gnus-agent-request-article article group)
- (setq res (cons group article)
- clean-up t))
- ;; Use `head' function.
- ((fboundp head)
- (setq res (funcall head article (gnus-group-real-name group)
- (nth 1 gnus-command-method))))
- ;; Use `article' function.
- (t
- (setq res (gnus-request-article article group)
- clean-up t)))
- (when clean-up
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
- (nnheader-fold-continuation-lines)))
- res))
-
-(defun gnus-request-body (article group)
- "Request the body of ARTICLE in GROUP."
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (head (gnus-get-function gnus-command-method 'request-body t))
- res clean-up)
- (cond
- ;; Check the cache.
- ((and gnus-use-cache
- (numberp article)
- (gnus-cache-request-article article group))
- (setq res (cons group article)
- clean-up t))
- ;; Check the agent cache.
- ((gnus-agent-request-article article group)
- (setq res (cons group article)
- clean-up t))
- ;; Use `head' function.
- ((fboundp head)
- (setq res (funcall head article (gnus-group-real-name group)
- (nth 1 gnus-command-method))))
- ;; Use `article' function.
- (t
- (setq res (gnus-request-article article group)
- clean-up t)))
- (when clean-up
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (1- (point))))))
- res))
-
-(defun gnus-request-post (gnus-command-method)
- "Post the current buffer using GNUS-COMMAND-METHOD."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (funcall (gnus-get-function gnus-command-method 'request-post)
- (nth 1 gnus-command-method)))
-
-(defun gnus-request-scan (group gnus-command-method)
- "Request a SCAN being performed in GROUP from GNUS-COMMAND-METHOD.
-If GROUP is nil, all groups on GNUS-COMMAND-METHOD are scanned."
- (let ((gnus-command-method
- (if group (gnus-find-method-for-group group) gnus-command-method))
- (gnus-inhibit-demon t)
- (mail-source-plugged gnus-plugged))
- (if (or gnus-plugged (not (gnus-agent-method-p gnus-command-method)))
- (progn
- (setq gnus-internal-registry-spool-current-method gnus-command-method)
- (funcall (gnus-get-function gnus-command-method 'request-scan)
- (and group (gnus-group-real-name group))
- (nth 1 gnus-command-method))))))
-
-(defsubst gnus-request-update-info (info gnus-command-method)
- "Request that GNUS-COMMAND-METHOD update INFO."
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (when (gnus-check-backend-function
- 'request-update-info (car gnus-command-method))
- (let ((group (gnus-info-group info)))
- (and (funcall (gnus-get-function gnus-command-method
- 'request-update-info)
- (gnus-group-real-name group)
- info (nth 1 gnus-command-method))
- ;; If the minimum article number is greater than 1, then all
- ;; smaller article numbers are known not to exist; we'll
- ;; artificially add those to the 'read range.
- (let* ((active (gnus-active group))
- (min (car active)))
- (when (> min 1)
- (let* ((range (if (= min 2) 1 (cons 1 (1- min))))
- (read (gnus-info-read info))
- (new-read (gnus-range-add read (list range))))
- (gnus-info-set-read info new-read)))
- info)))))
-
-(defun gnus-request-expire-articles (articles group &optional force)
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (not-deleted
- (funcall
- (gnus-get-function gnus-command-method 'request-expire-articles)
- articles (gnus-group-real-name group) (nth 1 gnus-command-method)
- force)))
- (when (and gnus-agent
- (gnus-agent-method-p gnus-command-method))
- (let ((expired-articles (gnus-sorted-difference articles not-deleted)))
- (when expired-articles
- (gnus-agent-expire expired-articles group 'force))))
- not-deleted))
-
-(defun gnus-request-move-article (article group server accept-function
- &optional last)
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (result (funcall (gnus-get-function gnus-command-method
- 'request-move-article)
- article (gnus-group-real-name group)
- (nth 1 gnus-command-method) accept-function last)))
- (when (and result gnus-agent
- (gnus-agent-method-p gnus-command-method))
- (gnus-agent-unfetch-articles group (list article)))
- result))
-
-(defun gnus-request-accept-article (group &optional gnus-command-method last
- no-encode)
- ;; Make sure there's a newline at the end of the article.
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (when (and (not gnus-command-method)
- (stringp group))
- (setq gnus-command-method (or (gnus-find-method-for-group group)
- (gnus-group-name-to-method group))))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (unless no-encode
- (let ((message-options message-options))
- (message-options-set-recipient)
- (save-restriction
- (message-narrow-to-head)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (message-encode-message-body)))
-(let ((gnus-command-method (or gnus-command-method
- (gnus-find-method-for-group group)))
- (result
- (funcall
- (gnus-get-function gnus-command-method 'request-accept-article)
- (if (stringp group) (gnus-group-real-name group) group)
- (cadr gnus-command-method)
- last)))
- (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
- (gnus-agent-regenerate-group group (list (cdr result))))
- result))
-
-(defun gnus-request-replace-article (article group buffer &optional no-encode)
- (unless no-encode
- (let ((message-options message-options))
- (message-options-set-recipient)
- (save-restriction
- (message-narrow-to-head)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (message-encode-message-body)))
- (let* ((func (car (gnus-group-name-to-method group)))
- (result (funcall (intern (format "%s-request-replace-article" func))
- article (gnus-group-real-name group) buffer)))
- (when (and gnus-agent (gnus-agent-method-p gnus-command-method))
- (gnus-agent-regenerate-group group (list article)))
- result))
-
-(defun gnus-request-associate-buffer (group)
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-associate-buffer)
- (gnus-group-real-name group))))
-
-(defun gnus-request-restore-buffer (article group)
- "Request a new buffer restored to the state of ARTICLE."
- (let ((gnus-command-method (gnus-find-method-for-group group)))
- (funcall (gnus-get-function gnus-command-method 'request-restore-buffer)
- article (gnus-group-real-name group)
- (nth 1 gnus-command-method))))
-
-(defun gnus-request-create-group (group &optional gnus-command-method args)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let ((gnus-command-method
- (or gnus-command-method (gnus-find-method-for-group group))))
- (funcall (gnus-get-function gnus-command-method 'request-create-group)
- (gnus-group-real-name group) (nth 1 gnus-command-method) args)))
-
-(defun gnus-request-delete-group (group &optional force)
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (result
- (funcall (gnus-get-function gnus-command-method 'request-delete-group)
- (gnus-group-real-name group) force (nth 1 gnus-command-method))))
- (when result
- (gnus-cache-delete-group group)
- (gnus-agent-delete-group group))
- result))
-
-(defun gnus-request-rename-group (group new-name)
- (let* ((gnus-command-method (gnus-find-method-for-group group))
- (result
- (funcall (gnus-get-function gnus-command-method 'request-rename-group)
- (gnus-group-real-name group)
- (gnus-group-real-name new-name) (nth 1 gnus-command-method))))
- (when result
- (gnus-cache-rename-group group new-name)
- (gnus-agent-rename-group group new-name))
- result))
-
-(defun gnus-close-backends ()
- ;; Send a close request to all backends that support such a request.
- (let ((methods gnus-valid-select-methods)
- (gnus-inhibit-demon t)
- func gnus-command-method)
- (while (setq gnus-command-method (pop methods))
- (when (fboundp (setq func (intern
- (concat (car gnus-command-method)
- "-request-close"))))
- (funcall func)))))
-
-(defun gnus-asynchronous-p (gnus-command-method)
- (let ((func (gnus-get-function gnus-command-method 'asynchronous-p t)))
- (when (fboundp func)
- (funcall func))))
-
-(defun gnus-remove-denial (gnus-command-method)
- (when (stringp gnus-command-method)
- (setq gnus-command-method (gnus-server-to-method gnus-command-method)))
- (let* ((elem (assoc gnus-command-method gnus-opened-servers))
- (status (cadr elem)))
- ;; If this hasn't been opened before, we add it to the list.
- (when (eq status 'denied)
- ;; Set the status of this server.
- (setcar (cdr elem) 'closed))))
-
-(provide 'gnus-int)
-
-;;; arch-tag: bbc90087-9b7f-4017-a92c-3abf180ac86d
-;;; gnus-int.el ends here
+++ /dev/null
-;;; gnus-kill.el --- kill commands for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-(require 'gnus-range)
-
-(defcustom gnus-kill-file-mode-hook nil
- "Hook for Gnus kill file mode."
- :group 'gnus-score-kill
- :type 'hook)
-
-(defcustom gnus-kill-expiry-days 7
- "*Number of days before expiring unused kill file entries."
- :group 'gnus-score-kill
- :group 'gnus-score-expire
- :type 'integer)
-
-(defcustom gnus-kill-save-kill-file nil
- "*If non-nil, will save kill files after processing them."
- :group 'gnus-score-kill
- :type 'boolean)
-
-(defcustom gnus-winconf-kill-file nil
- "What does this do, Lars?
-I don't know, Per."
- :group 'gnus-score-kill
- :type 'sexp)
-
-(defcustom gnus-kill-killed t
- "*If non-nil, Gnus will apply kill files to already killed articles.
-If it is nil, Gnus will never apply kill files to articles that have
-already been through the scoring process, which might very well save lots
-of time."
- :group 'gnus-score-kill
- :type 'boolean)
-
-\f
-
-(defmacro gnus-raise (field expression level)
- `(gnus-kill ,field ,expression
- (function (gnus-summary-raise-score ,level)) t))
-
-(defmacro gnus-lower (field expression level)
- `(gnus-kill ,field ,expression
- (function (gnus-summary-raise-score (- ,level))) t))
-
-;;;
-;;; Gnus Kill File Mode
-;;;
-
-(defvar gnus-kill-file-mode-map nil)
-
-(unless gnus-kill-file-mode-map
- (gnus-define-keymap (setq gnus-kill-file-mode-map
- (copy-keymap emacs-lisp-mode-map))
- "\C-c\C-k\C-s" gnus-kill-file-kill-by-subject
- "\C-c\C-k\C-a" gnus-kill-file-kill-by-author
- "\C-c\C-k\C-t" gnus-kill-file-kill-by-thread
- "\C-c\C-k\C-x" gnus-kill-file-kill-by-xref
- "\C-c\C-a" gnus-kill-file-apply-buffer
- "\C-c\C-e" gnus-kill-file-apply-last-sexp
- "\C-c\C-c" gnus-kill-file-exit))
-
-(defun gnus-kill-file-mode ()
- "Major mode for editing kill files.
-
-If you are using this mode - you probably shouldn't. Kill files
-perform badly and paint with a pretty broad brush. Score files, on
-the other hand, are vastly faster (40x speedup) and give you more
-control over what to do.
-
-In addition to Emacs-Lisp Mode, the following commands are available:
-
-\\{gnus-kill-file-mode-map}
-
- A kill file contains Lisp expressions to be applied to a selected
-newsgroup. The purpose is to mark articles as read on the basis of
-some set of regexps. A global kill file is applied to every newsgroup,
-and a local kill file is applied to a specified newsgroup. Since a
-global kill file is applied to every newsgroup, for better performance
-use a local one.
-
- A kill file can contain any kind of Emacs Lisp expressions expected
-to be evaluated in the Summary buffer. Writing Lisp programs for this
-purpose is not so easy because the internal working of Gnus must be
-well-known. For this reason, Gnus provides a general function which
-does this easily for non-Lisp programmers.
-
- The `gnus-kill' function executes commands available in Summary Mode
-by their key sequences. `gnus-kill' should be called with FIELD,
-REGEXP and optional COMMAND and ALL. FIELD is a string representing
-the header field or an empty string. If FIELD is an empty string, the
-entire article body is searched for. REGEXP is a string which is
-compared with FIELD value. COMMAND is a string representing a valid
-key sequence in Summary mode or Lisp expression. COMMAND defaults to
-'(gnus-summary-mark-as-read nil \"X\"). Make sure that COMMAND is
-executed in the Summary buffer. If the second optional argument ALL
-is non-nil, the COMMAND is applied to articles which are already
-marked as read or unread. Articles which are marked are skipped over
-by default.
-
- For example, if you want to mark articles of which subjects contain
-the string `AI' as read, a possible kill file may look like:
-
- (gnus-kill \"Subject\" \"AI\")
-
- If you want to mark articles with `D' instead of `X', you can use
-the following expression:
-
- (gnus-kill \"Subject\" \"AI\" \"d\")
-
-In this example it is assumed that the command
-`gnus-summary-mark-as-read-forward' is assigned to `d' in Summary Mode.
-
- It is possible to delete unnecessary headers which are marked with
-`X' in a kill file as follows:
-
- (gnus-expunge \"X\")
-
- If the Summary buffer is empty after applying kill files, Gnus will
-exit the selected newsgroup normally. If headers which are marked
-with `D' are deleted in a kill file, it is impossible to read articles
-which are marked as read in the previous Gnus sessions. Marks other
-than `D' should be used for articles which should really be deleted.
-
-Entry to this mode calls emacs-lisp-mode-hook and
-gnus-kill-file-mode-hook with no arguments, if that value is non-nil."
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-kill-file-mode-map)
- (set-syntax-table emacs-lisp-mode-syntax-table)
- (setq major-mode 'gnus-kill-file-mode)
- (setq mode-name "Kill")
- (lisp-mode-variables nil)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-kill-file-mode-hook))
-
-(defun gnus-kill-file-edit-file (newsgroup)
- "Begin editing a kill file for NEWSGROUP.
-If NEWSGROUP is nil, the global kill file is selected."
- (interactive "sNewsgroup: ")
- (let ((file (gnus-newsgroup-kill-file newsgroup)))
- (gnus-make-directory (file-name-directory file))
- ;; Save current window configuration if this is first invocation.
- (or (and (get-file-buffer file)
- (get-buffer-window (get-file-buffer file)))
- (setq gnus-winconf-kill-file (current-window-configuration)))
- ;; Hack windows.
- (let ((buffer (find-file-noselect file)))
- (cond ((get-buffer-window buffer)
- (pop-to-buffer buffer))
- ((eq major-mode 'gnus-group-mode)
- (gnus-configure-windows 'group) ;Take all windows.
- (pop-to-buffer buffer))
- ((eq major-mode 'gnus-summary-mode)
- (gnus-configure-windows 'article)
- (pop-to-buffer gnus-article-buffer)
- (bury-buffer gnus-article-buffer)
- (switch-to-buffer buffer))
- (t ;No good rules.
- (find-file-other-window file))))
- (gnus-kill-file-mode)))
-
-;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>.
-(defun gnus-kill-set-kill-buffer ()
- (let* ((file (gnus-newsgroup-kill-file gnus-newsgroup-name))
- (buffer (find-file-noselect file)))
- (set-buffer buffer)
- (gnus-kill-file-mode)
- (bury-buffer buffer)))
-
-(defun gnus-kill-file-enter-kill (field regexp &optional dont-move)
- ;; Enter kill file entry.
- ;; FIELD: String containing the name of the header field to kill.
- ;; REGEXP: The string to kill.
- (save-excursion
- (let (string)
- (unless (eq major-mode 'gnus-kill-file-mode)
- (gnus-kill-set-kill-buffer))
- (unless dont-move
- (goto-char (point-max)))
- (insert (setq string (format "(gnus-kill %S %S)\n" field regexp)))
- (gnus-kill-file-apply-string string))))
-
-(defun gnus-kill-file-kill-by-subject ()
- "Kill by subject."
- (interactive)
- (gnus-kill-file-enter-kill
- "Subject"
- (if (vectorp gnus-current-headers)
- (regexp-quote
- (gnus-simplify-subject (mail-header-subject gnus-current-headers)))
- "")
- t))
-
-(defun gnus-kill-file-kill-by-author ()
- "Kill by author."
- (interactive)
- (gnus-kill-file-enter-kill
- "From"
- (if (vectorp gnus-current-headers)
- (regexp-quote (mail-header-from gnus-current-headers))
- "") t))
-
-(defun gnus-kill-file-kill-by-thread ()
- "Kill by author."
- (interactive)
- (gnus-kill-file-enter-kill
- "References"
- (if (vectorp gnus-current-headers)
- (regexp-quote (mail-header-id gnus-current-headers))
- "")))
-
-(defun gnus-kill-file-kill-by-xref ()
- "Kill by Xref."
- (interactive)
- (let ((xref (and (vectorp gnus-current-headers)
- (mail-header-xref gnus-current-headers)))
- (start 0)
- group)
- (if xref
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-kill-file-enter-kill
- "Xref" (concat " " (regexp-quote group) ":") t)))
- (gnus-kill-file-enter-kill "Xref" "" t))))
-
-(defun gnus-kill-file-raise-followups-to-author (level)
- "Raise score for all followups to the current author."
- (interactive "p")
- (let ((name (mail-header-from gnus-current-headers))
- string)
- (save-excursion
- (gnus-kill-set-kill-buffer)
- (goto-char (point-min))
- (setq name (read-string (concat "Add " level
- " to followup articles to: ")
- (regexp-quote name)))
- (setq
- string
- (format
- "(gnus-kill %S %S '(gnus-summary-temporarily-raise-by-thread %S))\n"
- "From" name level))
- (insert string)
- (gnus-kill-file-apply-string string))
- (gnus-message
- 6 "Added temporary score file entry for followups to %s." name)))
-
-(defun gnus-kill-file-apply-buffer ()
- "Apply current buffer to current newsgroup."
- (interactive)
- (if (and gnus-current-kill-article
- (get-buffer gnus-summary-buffer))
- ;; Assume newsgroup is selected.
- (gnus-kill-file-apply-string (buffer-string))
- (ding) (gnus-message 2 "No newsgroup is selected.")))
-
-(defun gnus-kill-file-apply-string (string)
- "Apply STRING to current newsgroup."
- (interactive)
- (let ((string (concat "(progn \n" string "\n)")))
- (save-excursion
- (save-window-excursion
- (pop-to-buffer gnus-summary-buffer)
- (eval (car (read-from-string string)))))))
-
-(defun gnus-kill-file-apply-last-sexp ()
- "Apply sexp before point in current buffer to current newsgroup."
- (interactive)
- (if (and gnus-current-kill-article
- (get-buffer gnus-summary-buffer))
- ;; Assume newsgroup is selected.
- (let ((string
- (buffer-substring
- (save-excursion (forward-sexp -1) (point)) (point))))
- (save-excursion
- (save-window-excursion
- (pop-to-buffer gnus-summary-buffer)
- (eval (car (read-from-string string))))))
- (ding) (gnus-message 2 "No newsgroup is selected.")))
-
-(defun gnus-kill-file-exit ()
- "Save a kill file, then return to the previous buffer."
- (interactive)
- (save-buffer)
- (let ((killbuf (current-buffer)))
- ;; We don't want to return to article buffer.
- (when (get-buffer gnus-article-buffer)
- (bury-buffer gnus-article-buffer))
- ;; Delete the KILL file windows.
- (delete-windows-on killbuf)
- ;; Restore last window configuration if available.
- (when gnus-winconf-kill-file
- (set-window-configuration gnus-winconf-kill-file))
- (setq gnus-winconf-kill-file nil)
- ;; Kill the KILL file buffer. Suggested by tale@pawl.rpi.edu.
- (kill-buffer killbuf)))
-
-;; For kill files
-
-(defun gnus-Newsgroup-kill-file (newsgroup)
- "Return the name of a kill file for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file instead."
- (cond ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global kill file is placed at top of the directory.
- (expand-file-name gnus-kill-file-name gnus-kill-files-directory))
- (gnus-use-long-file-name
- ;; Append ".KILL" to capitalized newsgroup name.
- (expand-file-name (concat (gnus-capitalize-newsgroup newsgroup)
- "." gnus-kill-file-name)
- gnus-kill-files-directory))
- (t
- ;; Place "KILL" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" gnus-kill-file-name)
- gnus-kill-files-directory))))
-
-(defun gnus-expunge (marks)
- "Remove lines marked with MARKS."
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-limit-to-marks marks 'reverse)))
-
-(defun gnus-apply-kill-file-unless-scored ()
- "Apply .KILL file, unless a .SCORE file for the same newsgroup exists."
- (cond ((file-exists-p (gnus-score-file-name gnus-newsgroup-name))
- ;; Ignores global KILL.
- (when (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name))
- (gnus-message 3 "Note: Ignoring %s.KILL; preferring .SCORE"
- gnus-newsgroup-name))
- 0)
- ((or (file-exists-p (gnus-newsgroup-kill-file nil))
- (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
- (gnus-apply-kill-file-internal))
- (t
- 0)))
-
-(defun gnus-apply-kill-file-internal ()
- "Apply a kill file to the current newsgroup.
-Returns the number of articles marked as read."
- (let* ((kill-files (list (gnus-newsgroup-kill-file nil)
- (gnus-newsgroup-kill-file gnus-newsgroup-name)))
- (unreads (length gnus-newsgroup-unreads))
- (gnus-summary-inhibit-highlight t)
- beg)
- (setq gnus-newsgroup-kill-headers nil)
- ;; If there are any previously scored articles, we remove these
- ;; from the `gnus-newsgroup-headers' list that the score functions
- ;; will see. This is probably pretty wasteful when it comes to
- ;; conses, but is, I think, faster than having to assq in every
- ;; single score function.
- (let ((files kill-files))
- (while files
- (if (file-exists-p (car files))
- (let ((headers gnus-newsgroup-headers))
- (if gnus-kill-killed
- (setq gnus-newsgroup-kill-headers
- (mapcar (lambda (header) (mail-header-number header))
- headers))
- (while headers
- (unless (gnus-member-of-range
- (mail-header-number (car headers))
- gnus-newsgroup-killed)
- (push (mail-header-number (car headers))
- gnus-newsgroup-kill-headers))
- (setq headers (cdr headers))))
- (setq files nil))
- (setq files (cdr files)))))
- (if (not gnus-newsgroup-kill-headers)
- ()
- (save-window-excursion
- (save-excursion
- (while kill-files
- (if (not (file-exists-p (car kill-files)))
- ()
- (gnus-message 6 "Processing kill file %s..." (car kill-files))
- (find-file (car kill-files))
- (goto-char (point-min))
-
- (if (consp (ignore-errors (read (current-buffer))))
- (gnus-kill-parse-gnus-kill-file)
- (gnus-kill-parse-rn-kill-file))
-
- (gnus-message
- 6 "Processing kill file %s...done" (car kill-files)))
- (setq kill-files (cdr kill-files)))))
-
- (gnus-set-mode-line 'summary)
-
- (if beg
- (let ((nunreads (- unreads (length gnus-newsgroup-unreads))))
- (or (eq nunreads 0)
- (gnus-message 6 "Marked %d articles as read" nunreads))
- nunreads)
- 0))))
-
-;; Parse a Gnus killfile.
-(defun gnus-kill-parse-gnus-kill-file ()
- (goto-char (point-min))
- (gnus-kill-file-mode)
- (let (beg form)
- (while (progn
- (setq beg (point))
- (setq form (ignore-errors (read (current-buffer)))))
- (unless (listp form)
- (error "Invalid kill entry (possibly rn kill file?): %s" form))
- (if (or (eq (car form) 'gnus-kill)
- (eq (car form) 'gnus-raise)
- (eq (car form) 'gnus-lower))
- (progn
- (delete-region beg (point))
- (insert (or (eval form) "")))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (ignore-errors (eval form)))))
- (and (buffer-modified-p)
- gnus-kill-save-kill-file
- (save-buffer))
- (set-buffer-modified-p nil)))
-
-;; Parse an rn killfile.
-(defun gnus-kill-parse-rn-kill-file ()
- (goto-char (point-min))
- (gnus-kill-file-mode)
- (let ((mod-to-header
- '((?a . "")
- (?h . "")
- (?f . "from")
- (?: . "subject")))
- ;;(com-to-com
- ;; '((?m . " ")
- ;; (?j . "X")))
- pattern modifier commands)
- (while (not (eobp))
- (if (not (looking-at "[ \t]*/\\([^/]*\\)/\\([ahfcH]\\)?:\\([a-z=:]*\\)"))
- ()
- (setq pattern (buffer-substring (match-beginning 1) (match-end 1)))
- (setq modifier (if (match-beginning 2) (char-after (match-beginning 2))
- ?s))
- (setq commands (buffer-substring (match-beginning 3) (match-end 3)))
-
- ;; The "f:+" command marks everything *but* the matches as read,
- ;; so we simply first match everything as read, and then unmark
- ;; PATTERN later.
- (when (string-match "\\+" commands)
- (gnus-kill "from" ".")
- (setq commands "m"))
-
- (gnus-kill
- (or (cdr (assq modifier mod-to-header)) "subject")
- pattern
- (if (string-match "m" commands)
- '(gnus-summary-mark-as-unread nil " ")
- '(gnus-summary-mark-as-read nil "X"))
- nil t))
- (forward-line 1))))
-
-;; Kill changes and new format by suggested by JWZ and Sudish Joseph
-;; <joseph@cis.ohio-state.edu>.
-(defun gnus-kill (field regexp &optional exe-command all silent)
- "If FIELD of an article matches REGEXP, execute COMMAND.
-Optional 1st argument COMMAND is default to
- (gnus-summary-mark-as-read nil \"X\").
-If optional 2nd argument ALL is non-nil, articles marked are also applied to.
-If FIELD is an empty string (or nil), entire article body is searched for.
-COMMAND must be a lisp expression or a string representing a key sequence."
- ;; We don't want to change current point nor window configuration.
- (let ((old-buffer (current-buffer)))
- (save-excursion
- (save-window-excursion
- ;; Selected window must be summary buffer to execute keyboard
- ;; macros correctly. See command_loop_1.
- (switch-to-buffer gnus-summary-buffer 'norecord)
- (goto-char (point-min)) ;From the beginning.
- (let ((kill-list regexp)
- (date (current-time-string))
- (command (or exe-command '(gnus-summary-mark-as-read
- nil gnus-kill-file-mark)))
- kill kdate prev)
- (if (listp kill-list)
- ;; It is a list.
- (if (not (consp (cdr kill-list)))
- ;; It's of the form (regexp . date).
- (if (zerop (gnus-execute field (car kill-list)
- command nil (not all)))
- (when (> (days-between date (cdr kill-list))
- gnus-kill-expiry-days)
- (setq regexp nil))
- (setcdr kill-list date))
- (while (setq kill (car kill-list))
- (if (consp kill)
- ;; It's a temporary kill.
- (progn
- (setq kdate (cdr kill))
- (if (zerop (gnus-execute
- field (car kill) command nil (not all)))
- (when (> (days-between date kdate)
- gnus-kill-expiry-days)
- ;; Time limit has been exceeded, so we
- ;; remove the match.
- (if prev
- (setcdr prev (cdr kill-list))
- (setq regexp (cdr regexp))))
- ;; Successful kill. Set the date to today.
- (setcdr kill date)))
- ;; It's a permanent kill.
- (gnus-execute field kill command nil (not all)))
- (setq prev kill-list)
- (setq kill-list (cdr kill-list))))
- (gnus-execute field kill-list command nil (not all))))))
- (switch-to-buffer old-buffer)
- (when (and (eq major-mode 'gnus-kill-file-mode) regexp (not silent))
- (gnus-pp-gnus-kill
- (nconc (list 'gnus-kill field
- (if (consp regexp) (list 'quote regexp) regexp))
- (when (or exe-command all)
- (list (list 'quote exe-command)))
- (if all (list t) nil))))))
-
-(defun gnus-pp-gnus-kill (object)
- (if (or (not (consp (nth 2 object)))
- (not (consp (cdr (nth 2 object))))
- (and (eq 'quote (car (nth 2 object)))
- (not (consp (cdadr (nth 2 object))))))
- (concat "\n" (gnus-prin1-to-string object))
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*Gnus PP*"))
- (buffer-disable-undo)
- (erase-buffer)
- (insert (format "\n(%S %S\n '(" (nth 0 object) (nth 1 object)))
- (let ((klist (cadr (nth 2 object)))
- (first t))
- (while klist
- (insert (if first (progn (setq first nil) "") "\n ")
- (gnus-prin1-to-string (car klist)))
- (setq klist (cdr klist))))
- (insert ")")
- (and (nth 3 object)
- (insert "\n "
- (if (and (consp (nth 3 object))
- (not (eq 'quote (car (nth 3 object)))))
- "'" "")
- (gnus-prin1-to-string (nth 3 object))))
- (when (nth 4 object)
- (insert "\n t"))
- (insert ")")
- (prog1
- (buffer-string)
- (kill-buffer (current-buffer))))))
-
-(defun gnus-execute-1 (function regexp form header)
- (save-excursion
- (let (did-kill)
- (if (null header)
- nil ;Nothing to do.
- (if function
- ;; Compare with header field.
- (let (value)
- (and header
- (progn
- (setq value (funcall function header))
- ;; Number (Lines:) or symbol must be converted to string.
- (unless (stringp value)
- (setq value (gnus-prin1-to-string value)))
- (setq did-kill (string-match regexp value)))
- (cond ((stringp form) ;Keyboard macro.
- (execute-kbd-macro form))
- ((functionp form)
- (funcall form))
- (t
- (eval form)))))
- ;; Search article body.
- (let ((gnus-current-article nil) ;Save article pointer.
- (gnus-last-article nil)
- (gnus-break-pages nil) ;No need to break pages.
- (gnus-mark-article-hook nil)) ;Inhibit marking as read.
- (gnus-message
- 6 "Searching for article: %d..." (mail-header-number header))
- (gnus-article-setup-buffer)
- (gnus-article-prepare (mail-header-number header) t)
- (when (save-excursion
- (set-buffer gnus-article-buffer)
- (goto-char (point-min))
- (setq did-kill (re-search-forward regexp nil t)))
- (cond ((stringp form) ;Keyboard macro.
- (execute-kbd-macro form))
- ((functionp form)
- (funcall form))
- (t
- (eval form)))))))
- did-kill)))
-
-(defun gnus-execute (field regexp form &optional backward unread)
- "If FIELD of article header matches REGEXP, execute lisp FORM (or a string).
-If FIELD is an empty string (or nil), entire article body is searched for.
-If optional 1st argument BACKWARD is non-nil, do backward instead.
-If optional 2nd argument UNREAD is non-nil, articles which are
-marked as read or ticked are ignored."
- (save-excursion
- (let ((killed-no 0)
- function article header extras)
- (cond
- ;; Search body.
- ((or (null field)
- (string-equal field ""))
- (setq function nil))
- ;; Get access function of header field.
- ((cond ((fboundp
- (setq function
- (intern-soft
- (concat "mail-header-" (downcase field)))))
- (setq function `(lambda (h) (,function h))))
- ((when (setq extras
- (member (downcase field)
- (mapcar (lambda (header)
- (downcase (symbol-name header)))
- gnus-extra-headers)))
- (setq function
- `(lambda (h)
- (gnus-extra-header
- (quote ,(nth (- (length gnus-extra-headers)
- (length extras))
- gnus-extra-headers))
- h)))))))
- ;; Signal error.
- (t
- (error "Unknown header field: \"%s\"" field)))
- ;; Starting from the current article.
- (while (or
- ;; First article.
- (and (not article)
- (setq article (gnus-summary-article-number)))
- ;; Find later articles.
- (setq article
- (gnus-summary-search-forward unread nil backward)))
- (and (or (null gnus-newsgroup-kill-headers)
- (memq article gnus-newsgroup-kill-headers))
- (vectorp (setq header (gnus-summary-article-header article)))
- (gnus-execute-1 function regexp form header)
- (setq killed-no (1+ killed-no))))
- ;; Return the number of killed articles.
- killed-no)))
-
-;;;###autoload
-(defalias 'gnus-batch-kill 'gnus-batch-score)
-;;;###autoload
-(defun gnus-batch-score ()
- "Run batched scoring.
-Usage: emacs -batch -l ~/.emacs -l gnus -f gnus-batch-score"
- (interactive)
- (let* ((gnus-newsrc-options-n
- (gnus-newsrc-parse-options
- (concat "options -n "
- (mapconcat 'identity command-line-args-left " "))))
- (gnus-expert-user t)
- (nnmail-spool-file nil)
- (mail-sources nil)
- (gnus-use-dribble-file nil)
- (gnus-batch-mode t)
- info group newsrc entry
- ;; Disable verbose message.
- gnus-novice-user gnus-large-newsgroup
- gnus-options-subscribe gnus-auto-subscribed-groups
- gnus-options-not-subscribe)
- ;; Eat all arguments.
- (setq command-line-args-left nil)
- (gnus-slave)
- ;; Apply kills to specified newsgroups in command line arguments.
- (setq newsrc (cdr gnus-newsrc-alist))
- (while (setq info (pop newsrc))
- (setq group (gnus-info-group info)
- entry (gnus-gethash group gnus-newsrc-hashtb))
- (when (and (<= (gnus-info-level info) gnus-level-subscribed)
- (and (car entry)
- (or (eq (car entry) t)
- (not (zerop (car entry))))))
- (ignore-errors
- (gnus-summary-read-group group nil t nil t))
- (when (eq (current-buffer) (get-buffer gnus-summary-buffer))
- (gnus-summary-exit))))
- ;; Exit Emacs.
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-save-newsrc)))
-
-(provide 'gnus-kill)
-
-;;; arch-tag: b30c0f53-df1a-490b-b81e-17b13474f395
-;;; gnus-kill.el ends here
+++ /dev/null
-
-(provide 'gnus-load)
-
-;;; Local Variables:
-;;; version-control: never
-;;; no-byte-compile: t
-;;; no-update-autoloads: t
-;;; End:
-;;; gnus-load.el ends here
\ No newline at end of file
+++ /dev/null
-;;; gnus-logic.el --- advanced scoring code for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-score)
-(require 'gnus-util)
-
-;;; Internal variables.
-
-(defvar gnus-advanced-headers nil)
-
-;; To avoid having 8-bit characters in the source file.
-(defvar gnus-advanced-not (intern (format "%c" 172)))
-
-(defconst gnus-advanced-index
- ;; Name to index alist.
- '(("number" 0 gnus-advanced-integer)
- ("subject" 1 gnus-advanced-string)
- ("from" 2 gnus-advanced-string)
- ("date" 3 gnus-advanced-date)
- ("message-id" 4 gnus-advanced-string)
- ("references" 5 gnus-advanced-string)
- ("chars" 6 gnus-advanced-integer)
- ("lines" 7 gnus-advanced-integer)
- ("xref" 8 gnus-advanced-string)
- ("head" nil gnus-advanced-body)
- ("body" nil gnus-advanced-body)
- ("all" nil gnus-advanced-body)))
-
-(eval-and-compile
- (autoload 'parse-time-string "parse-time"))
-
-(defun gnus-score-advanced (rule &optional trace)
- "Apply advanced scoring RULE to all the articles in the current group."
- (let (new-score score multiple)
- (dolist (gnus-advanced-headers gnus-newsgroup-headers)
- (when (setq multiple (gnus-advanced-score-rule (car rule)))
- (setq new-score (or (nth 1 rule)
- gnus-score-interactive-default-score))
- (when (numberp multiple)
- (setq new-score (* multiple new-score)))
- ;; This rule was successful, so we add the score to this
- ;; article.
- (if (setq score (assq (mail-header-number gnus-advanced-headers)
- gnus-newsgroup-scored))
- (setcdr score
- (+ (cdr score) new-score))
- (push (cons (mail-header-number gnus-advanced-headers)
- new-score)
- gnus-newsgroup-scored)
- (when trace
- (push (cons "A file" rule)
- ;; Must be synced with `gnus-score-edit-file-at-point'.
- gnus-score-trace)))))))
-
-(defun gnus-advanced-score-rule (rule)
- "Apply RULE to `gnus-advanced-headers'."
- (let ((type (car rule)))
- (cond
- ;; "And" rule.
- ((or (eq type '&) (eq type 'and))
- (pop rule)
- (if (not rule)
- t ; Empty rule is true.
- (while (and rule
- (gnus-advanced-score-rule (car rule)))
- (pop rule))
- ;; If all the rules were true, then `rule' should be nil.
- (not rule)))
- ;; "Or" rule.
- ((or (eq type '|) (eq type 'or))
- (pop rule)
- (if (not rule)
- nil
- (while (and rule
- (not (gnus-advanced-score-rule (car rule))))
- (pop rule))
- ;; If one of the rules returned true, then `rule' should be non-nil.
- rule))
- ;; "Not" rule.
- ((or (eq type '!) (eq type 'not) (eq type gnus-advanced-not))
- (not (gnus-advanced-score-rule (nth 1 rule))))
- ;; This is a `1-'-type redirection rule.
- ((and (symbolp type)
- (string-match "^[0-9]+-$\\|^\\^+$" (symbol-name type)))
- (let ((gnus-advanced-headers
- (gnus-parent-headers
- gnus-advanced-headers
- (if (string-match "^\\([0-9]+\\)-$" (symbol-name type))
- ;; 1- type redirection.
- (string-to-number
- (substring (symbol-name type)
- (match-beginning 1) (match-end 1)))
- ;; ^^^ type redirection.
- (length (symbol-name type))))))
- (when gnus-advanced-headers
- (gnus-advanced-score-rule (nth 1 rule)))))
- ;; Plain scoring rule.
- ((stringp type)
- (gnus-advanced-score-article rule))
- ;; Bug-out time!
- (t
- (error "Unknown advanced score type: %s" rule)))))
-
-(defun gnus-advanced-score-article (rule)
- ;; `rule' is a semi-normal score rule, so we find out what function
- ;; that's supposed to do the actual processing.
- (let* ((header (car rule))
- (func (assoc (downcase header) gnus-advanced-index)))
- (if (not func)
- (error "No such header: %s" rule)
- ;; Call the score function.
- (funcall (caddr func) (or (cadr func) header)
- (cadr rule) (caddr rule)))))
-
-(defun gnus-advanced-string (index match type)
- "See whether string MATCH of TYPE matches `gnus-advanced-headers' in INDEX."
- (let* ((type (or type 's))
- (case-fold-search (not (eq (downcase (symbol-name type))
- (symbol-name type))))
- (header (or (aref gnus-advanced-headers index) "")))
- (cond
- ((memq type '(r R regexp Regexp))
- (string-match match header))
- ((memq type '(s S string String))
- (string-match (regexp-quote match) header))
- ((memq type '(e E exact Exact))
- (string= match header))
- ((memq type '(f F fuzzy Fuzzy))
- (string-match (regexp-quote (gnus-simplify-subject-fuzzy match))
- header))
- (t
- (error "No such string match type: %s" type)))))
-
-(defun gnus-advanced-integer (index match type)
- (if (not (memq type '(< > <= >= =)))
- (error "No such integer score type: %s" type)
- (funcall type (or (aref gnus-advanced-headers index) 0) match)))
-
-(defun gnus-advanced-date (index match type)
- (let ((date (apply 'encode-time (parse-time-string
- (aref gnus-advanced-headers index))))
- (match (apply 'encode-time (parse-time-string match))))
- (cond
- ((eq type 'at)
- (equal date match))
- ((eq type 'before)
- (time-less-p match date))
- ((eq type 'after)
- (time-less-p date match))
- (t
- (error "No such date score type: %s" type)))))
-
-(defun gnus-advanced-body (header match type)
- (when (string= header "all")
- (setq header "article"))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let* ((request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- ofunc article)
- ;; Not all backends support partial fetching. In that case, we
- ;; just fetch the entire article.
- (unless (gnus-check-backend-function
- (intern (concat "request-" header))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
- (setq article (mail-header-number gnus-advanced-headers))
- (gnus-message 7 "Scoring article %s..." article)
- (when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched and the
- ;; backend didn't support partial fetching, we just narrow to
- ;; the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (let* ((case-fold-search (not (eq (downcase (symbol-name type))
- (symbol-name type))))
- (search-func
- (cond ((memq type '(r R regexp Regexp))
- 're-search-forward)
- ((memq type '(s S string String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (prog1
- (funcall search-func match nil t)
- (widen)))))))
-
-(provide 'gnus-logic)
-
-;;; arch-tag: 9651a100-4a59-4b69-a55b-e511e67c0f8d
-;;; gnus-logic.el ends here
+++ /dev/null
-;;; gnus-mh.el --- mh-e interface for Gnus
-
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Send mail using mh-e.
-
-;; The following mh-e interface is all cooperative works of
-;; tanaka@flab.fujitsu.CO.JP (TANAKA Hiroshi), kawabe@sra.CO.JP
-;; (Yoshikatsu Kawabe), and shingu@casund.cpr.canon.co.jp (Toshiaki
-;; SHINGU).
-
-;;; Code:
-
-(require 'gnus)
-(require 'mh-e)
-(require 'mh-comp)
-(require 'gnus-msg)
-(require 'gnus-sum)
-
-(eval-when-compile
- (defvar mh-lib-progs))
-
-(defun gnus-summary-save-article-folder (&optional arg)
- "Append the current article to an mh folder.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-folder))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-in-folder (&optional folder)
- "Save this article to MH folder (using `rcvstore' in MH library).
-Optional argument FOLDER specifies folder name."
- ;; Thanks to yuki@flab.Fujitsu.JUNET and ohm@kaba.junet.
- (mh-find-path)
- (let ((folder
- (cond ((and (eq folder 'default)
- gnus-newsgroup-last-folder)
- gnus-newsgroup-last-folder)
- (folder folder)
- (t (mh-prompt-for-folder
- "Save article in"
- (funcall gnus-folder-save-name gnus-newsgroup-name
- gnus-current-headers gnus-newsgroup-last-folder)
- t))))
- (errbuf (gnus-get-buffer-create " *Gnus rcvstore*"))
- ;; Find the rcvstore program.
- (exec-path (cond
- ((and (boundp 'mh-lib-progs) mh-lib-progs)
- (cons mh-lib-progs exec-path))
- (mh-lib (cons mh-lib exec-path))
- (t exec-path))))
- (with-current-buffer gnus-original-article-buffer
- (save-restriction
- (widen)
- (unwind-protect
- (call-process-region
- (point-min) (point-max) "rcvstore" nil errbuf nil folder)
- (set-buffer errbuf)
- (if (zerop (buffer-size))
- (message "Article saved in folder: %s" folder)
- (message "%s" (buffer-string)))
- (kill-buffer errbuf))))
- (setq gnus-newsgroup-last-folder folder)))
-
-(defun gnus-Folder-save-name (newsgroup headers &optional last-folder)
- "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +News.group.
-Otherwise, it is like +news/group."
- (or last-folder
- (concat "+"
- (if gnus-use-long-file-name
- (gnus-capitalize-newsgroup newsgroup)
- (gnus-newsgroup-directory-form newsgroup)))))
-
-(defun gnus-folder-save-name (newsgroup headers &optional last-folder)
- "Generate folder name from NEWSGROUP, HEADERS, and optional LAST-FOLDER.
-If variable `gnus-use-long-file-name' is nil, it is +news.group.
-Otherwise, it is like +news/group."
- (or last-folder
- (concat "+"
- (if gnus-use-long-file-name
- newsgroup
- (gnus-newsgroup-directory-form newsgroup)))))
-
-(provide 'gnus-mh)
-
-;;; arch-tag: 2d5696d3-b363-48e5-8749-c256be56acca
-;;; gnus-mh.el ends here
+++ /dev/null
-;;; gnus-ml.el --- Mailing list minor mode for Gnus
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Julien Gilles <jgilles@free.fr>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; implement (small subset of) RFC 2369
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-msg)
-(eval-when-compile (require 'cl))
-
-;;; Mailing list minor mode
-
-(defvar gnus-mailing-list-mode nil
- "Minor mode for providing mailing-list commands.")
-
-(defvar gnus-mailing-list-mode-map nil)
-
-(defvar gnus-mailing-list-menu)
-
-(unless gnus-mailing-list-mode-map
- (setq gnus-mailing-list-mode-map (make-sparse-keymap))
-
- (gnus-define-keys gnus-mailing-list-mode-map
- "\C-c\C-nh" gnus-mailing-list-help
- "\C-c\C-ns" gnus-mailing-list-subscribe
- "\C-c\C-nu" gnus-mailing-list-unsubscribe
- "\C-c\C-np" gnus-mailing-list-post
- "\C-c\C-no" gnus-mailing-list-owner
- "\C-c\C-na" gnus-mailing-list-archive))
-
-(defun gnus-mailing-list-make-menu-bar ()
- (unless (boundp 'gnus-mailing-list-menu)
- (easy-menu-define
- gnus-mailing-list-menu gnus-mailing-list-mode-map ""
- '("Mailing-Lists"
- ["Get help" gnus-mailing-list-help t]
- ["Subscribe" gnus-mailing-list-subscribe t]
- ["Unsubscribe" gnus-mailing-list-unsubscribe t]
- ["Post a message" gnus-mailing-list-post t]
- ["Mail to owner" gnus-mailing-list-owner t]
- ["Browse archive" gnus-mailing-list-archive t]))))
-
-;;;###autoload
-(defun turn-on-gnus-mailing-list-mode ()
- (when (gnus-group-find-parameter gnus-newsgroup-name 'to-list)
- (gnus-mailing-list-mode 1)))
-
-;;;###autoload
-(defun gnus-mailing-list-insinuate (&optional force)
- "Setup group parameters from List-Post header.
-If FORCE is non-nil, replace the old ones."
- (interactive "P")
- (let ((list-post
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-post"))))
- (if list-post
- (if (and (not force)
- (gnus-group-get-parameter gnus-newsgroup-name 'to-list))
- (gnus-message 1 "to-list is non-nil.")
- (if (string-match "<mailto:\\([^>]*\\)>" list-post)
- (setq list-post (match-string 1 list-post)))
- (gnus-group-add-parameter gnus-newsgroup-name
- (cons 'to-list list-post))
- (gnus-mailing-list-mode 1))
- (gnus-message 1 "no list-post in this message."))))
-
-;;;###autoload
-(defun gnus-mailing-list-mode (&optional arg)
- "Minor mode for providing mailing-list commands.
-
-\\{gnus-mailing-list-mode-map}"
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (when (set (make-local-variable 'gnus-mailing-list-mode)
- (if (null arg) (not gnus-mailing-list-mode)
- (> (prefix-numeric-value arg) 0)))
- ;; Set up the menu.
- (when (gnus-visual-p 'mailing-list-menu 'menu)
- (gnus-mailing-list-make-menu-bar))
- (gnus-add-minor-mode 'gnus-mailing-list-mode " Mailing-List"
- gnus-mailing-list-mode-map)
- (gnus-run-hooks 'gnus-mailing-list-mode-hook))))
-
-;;; Commands
-
-(defun gnus-mailing-list-help ()
- "Get help from mailing list server."
- (interactive)
- (let ((list-help
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-help"))))
- (cond (list-help (gnus-mailing-list-message list-help))
- (t (gnus-message 1 "no list-help in this group")))))
-
-(defun gnus-mailing-list-subscribe ()
- "Subscribe to mailing list."
- (interactive)
- (let ((list-subscribe
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-subscribe"))))
- (cond (list-subscribe (gnus-mailing-list-message list-subscribe))
- (t (gnus-message 1 "no list-subscribe in this group")))))
-
-(defun gnus-mailing-list-unsubscribe ()
- "Unsubscribe from mailing list."
- (interactive)
- (let ((list-unsubscribe
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-unsubscribe"))))
- (cond (list-unsubscribe (gnus-mailing-list-message list-unsubscribe))
- (t (gnus-message 1 "no list-unsubscribe in this group")))))
-
-(defun gnus-mailing-list-post ()
- "Post message (really useful ?)"
- (interactive)
- (let ((list-post
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-post"))))
- (cond (list-post (gnus-mailing-list-message list-post))
- (t (gnus-message 1 "no list-post in this group")))))
-
-(defun gnus-mailing-list-owner ()
- "Mail to the mailing list owner."
- (interactive)
- (let ((list-owner
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-owner"))))
- (cond (list-owner (gnus-mailing-list-message list-owner))
- (t (gnus-message 1 "no list-owner in this group")))))
-
-(defun gnus-mailing-list-archive ()
- "Browse archive."
- (interactive)
- (require 'browse-url)
- (let ((list-archive
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field "list-archive"))))
- (cond (list-archive
- (if (string-match "<\\(http:[^>]*\\)>" list-archive)
- (browse-url (match-string 1 list-archive))
- (browse-url list-archive)))
- (t (gnus-message 1 "no list-archive in this group")))))
-
-;;; Utility functions
-
-(defun gnus-mailing-list-message (address)
- "Send message to ADDRESS.
-ADDRESS is specified by a \"mailto:\" URL."
- (cond
- ((string-match "<\\(mailto:[^>]*\\)>" address)
- (require 'gnus-art)
- (gnus-url-mailto (match-string 1 address)))
- ;; other case <http://...> to be done.
- (t nil)))
-
-(provide 'gnus-ml)
-
-;;; arch-tag: 936c0fe6-acce-4c16-87d0-eded88078896
-;;; gnus-ml.el ends here
+++ /dev/null
-;;; gnus-mlspl.el --- a group params-based mail splitting mechanism
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Alexandre Oliva <oliva@lsd.ic.unicamp.br>
-;; Keywords: news, mail
-
-;; 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 3, 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 this program; see the file COPYING. If not, write to
-;; the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'gnus)
-(require 'gnus-sum)
-(require 'gnus-group)
-(require 'nnmail)
-
-(defvar gnus-group-split-updated-hook nil
- "Hook called just after nnmail-split-fancy is updated by
-gnus-group-split-update.")
-
-(defvar gnus-group-split-default-catch-all-group "mail.misc"
- "Group name (or arbitrary fancy split) with default splitting rules.
-Used by gnus-group-split and gnus-group-split-update as a fallback
-split, in case none of the group-based splits matches.")
-
-;;;###autoload
-(defun gnus-group-split-setup (&optional auto-update catch-all)
- "Set up the split for nnmail-split-fancy.
-Sets things up so that nnmail-split-fancy is used for mail
-splitting, and defines the variable nnmail-split-fancy according with
-group parameters.
-
-If AUTO-UPDATE is non-nil (prefix argument accepted, if called
-interactively), it makes sure nnmail-split-fancy is re-computed before
-getting new mail, by adding gnus-group-split-update to
-nnmail-pre-get-new-mail-hook.
-
-A non-nil CATCH-ALL replaces the current value of
-gnus-group-split-default-catch-all-group. This variable is only used
-by gnus-group-split-update, and only when its CATCH-ALL argument is
-nil. This argument may contain any fancy split, that will be added as
-the last split in a `|' split produced by gnus-group-split-fancy,
-unless overridden by any group marked as a catch-all group. Typical
-uses are as simple as the name of a default mail group, but more
-elaborate fancy splits may also be useful to split mail that doesn't
-match any of the group-specified splitting rules. See
-`gnus-group-split-fancy' for details."
- (interactive "P")
- (setq nnmail-split-methods 'nnmail-split-fancy)
- (when catch-all
- (setq gnus-group-split-default-catch-all-group catch-all))
- (gnus-group-split-update)
- (when auto-update
- (add-hook 'nnmail-pre-get-new-mail-hook 'gnus-group-split-update)))
-
-;;;###autoload
-(defun gnus-group-split-update (&optional catch-all)
- "Computes nnmail-split-fancy from group params and CATCH-ALL.
-It does this by calling by calling (gnus-group-split-fancy nil
-nil CATCH-ALL).
-
-If CATCH-ALL is nil, gnus-group-split-default-catch-all-group is used
-instead. This variable is set by gnus-group-split-setup."
- (interactive)
- (setq nnmail-split-fancy
- (gnus-group-split-fancy
- nil (null nnmail-crosspost)
- (or catch-all gnus-group-split-default-catch-all-group)))
- (run-hooks 'gnus-group-split-updated-hook))
-
-;;;###autoload
-(defun gnus-group-split ()
- "Uses information from group parameters in order to split mail.
-See `gnus-group-split-fancy' for more information.
-
-gnus-group-split is a valid value for nnmail-split-methods."
- (let (nnmail-split-fancy)
- (gnus-group-split-update)
- (nnmail-split-fancy)))
-
-;;;###autoload
-(defun gnus-group-split-fancy
- (&optional groups no-crosspost catch-all)
- "Uses information from group parameters in order to split mail.
-It can be embedded into `nnmail-split-fancy' lists with the SPLIT
-
-\(: gnus-group-split-fancy GROUPS NO-CROSSPOST CATCH-ALL\)
-
-GROUPS may be a regular expression or a list of group names, that will
-be used to select candidate groups. If it is omitted or nil, all
-existing groups are considered.
-
-if NO-CROSSPOST is omitted or nil, a & split will be returned,
-otherwise, a | split, that does not allow crossposting, will be
-returned.
-
-For each selected group, a SPLIT is composed like this: if SPLIT-SPEC
-is specified, this split is returned as-is (unless it is nil: in this
-case, the group is ignored). Otherwise, if TO-ADDRESS, TO-LIST and/or
-EXTRA-ALIASES are specified, a regexp that matches any of them is
-constructed (extra-aliases may be a list). Additionally, if
-SPLIT-REGEXP is specified, the regexp will be extended so that it
-matches this regexp too, and if SPLIT-EXCLUDE is specified, RESTRICT
-clauses will be generated.
-
-If CATCH-ALL is nil, no catch-all handling is performed, regardless of
-catch-all marks in group parameters. Otherwise, if there is no
-selected group whose SPLIT-REGEXP matches the empty string, nor is
-there a selected group whose SPLIT-SPEC is 'catch-all, this fancy
-split (say, a group name) will be appended to the returned SPLIT list,
-as the last element of a '| SPLIT.
-
-For example, given the following group parameters:
-
-nnml:mail.bar:
-\((to-address . \"bar@femail.com\")
- (split-regexp . \".*@femail\\\\.com\"))
-nnml:mail.foo:
-\((to-list . \"foo@nowhere.gov\")
- (extra-aliases \"foo@localhost\" \"foo-redist@home\")
- (split-exclude \"bugs-foo\" \"rambling-foo\")
- (admin-address . \"foo-request@nowhere.gov\"))
-nnml:mail.others:
-\((split-spec . catch-all))
-
-Calling (gnus-group-split-fancy nil nil \"mail.others\") returns:
-
-\(| (& (any \"\\\\(bar@femail\\\\.com\\\\|.*@femail\\\\.com\\\\)\"
- \"mail.bar\")
- (any \"\\\\(foo@nowhere\\\\.gov\\\\|foo@localhost\\\\|foo-redist@home\\\\)\"
- - \"bugs-foo\" - \"rambling-foo\" \"mail.foo\"))
- \"mail.others\")"
- (let* ((newsrc (cdr gnus-newsrc-alist))
- split)
- (dolist (info newsrc)
- (let ((group (gnus-info-group info))
- (params (gnus-info-params info)))
- ;; For all GROUPs that match the specified GROUPS
- (when (or (not groups)
- (and (listp groups)
- (memq group groups))
- (and (stringp groups)
- (string-match groups group)))
- (let ((split-spec (assoc 'split-spec params)) group-clean)
- ;; Remove backend from group name
- (setq group-clean (string-match ":" group))
- (setq group-clean
- (if group-clean
- (substring group (1+ group-clean))
- group))
- (if split-spec
- (when (setq split-spec (cdr split-spec))
- (if (eq split-spec 'catch-all)
- ;; Emit catch-all only when requested
- (when catch-all
- (setq catch-all group-clean))
- ;; Append split-spec to the main split
- (push split-spec split)))
- ;; Let's deduce split-spec from other params
- (let ((to-address (cdr (assoc 'to-address params)))
- (to-list (cdr (assoc 'to-list params)))
- (extra-aliases (cdr (assoc 'extra-aliases params)))
- (split-regexp (cdr (assoc 'split-regexp params)))
- (split-exclude (cdr (assoc 'split-exclude params))))
- (when (or to-address to-list extra-aliases split-regexp)
- ;; regexp-quote to-address, to-list and extra-aliases
- ;; and add them all to split-regexp
- (setq split-regexp
- (concat
- "\\("
- (mapconcat
- 'identity
- (append
- (and to-address (list (regexp-quote to-address)))
- (and to-list (list (regexp-quote to-list)))
- (and extra-aliases
- (if (listp extra-aliases)
- (mapcar 'regexp-quote extra-aliases)
- (list extra-aliases)))
- (and split-regexp (list split-regexp)))
- "\\|")
- "\\)"))
- ;; Now create the new SPLIT
- (push (append
- (list 'any split-regexp)
- ;; Generate RESTRICTs for SPLIT-EXCLUDEs.
- (if (listp split-exclude)
- (apply #'append
- (mapcar (lambda (arg) (list '- arg))
- split-exclude))
- (list '- split-exclude))
- (list group-clean))
- split)
- ;; If it matches the empty string, it is a catch-all
- (when (string-match split-regexp "")
- (setq catch-all nil)))))))))
- ;; Add catch-all if not crossposting
- (if (and catch-all no-crosspost)
- (push catch-all split))
- ;; Move it to the tail, while arranging that SPLITs appear in the
- ;; same order as groups.
- (setq split (reverse split))
- ;; Decide whether to accept cross-postings or not.
- (push (if no-crosspost '| '&) split)
- ;; Even if we can cross-post, catch-all should not get
- ;; cross-posts.
- (if (and catch-all (not no-crosspost))
- (setq split (list '| split catch-all)))
- split))
-
-(provide 'gnus-mlspl)
-
-;;; arch-tag: 62b3381f-1e45-4b61-be1a-29fb27703322
-;;; gnus-mlspl.el ends here
+++ /dev/null
-;;; gnus-move.el --- commands for moving Gnus from one server to another
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-start)
-(require 'gnus-int)
-(require 'gnus-range)
-
-;;;
-;;; Moving by comparing Message-ID's.
-;;;
-
-;;;###autoload
-(defun gnus-change-server (from-server to-server)
- "Move from FROM-SERVER to TO-SERVER.
-Update the .newsrc.eld file to reflect the change of nntp server."
- (interactive
- (list gnus-select-method (gnus-read-method "Move to method: ")))
-
- ;; First start Gnus.
- (let ((gnus-activate-level 0)
- (mail-sources nil)
- (nnmail-spool-file nil))
- (gnus))
-
- (save-excursion
- ;; Go through all groups and translate.
- (let ((newsrc gnus-newsrc-alist)
- (nntp-nov-gap nil)
- info)
- (while (setq info (pop newsrc))
- (when (gnus-group-native-p (gnus-info-group info))
- (gnus-move-group-to-server info from-server to-server))))))
-
-(defun gnus-move-group-to-server (info from-server to-server)
- "Move group INFO from FROM-SERVER to TO-SERVER."
- (let ((group (gnus-info-group info))
- to-active hashtb type mark marks
- to-article to-reads to-marks article
- act-articles)
- (gnus-message 7 "Translating %s..." group)
- (when (gnus-request-group group nil to-server)
- (setq to-active (gnus-parse-active)
- hashtb (gnus-make-hashtable 1024)
- act-articles (gnus-uncompress-range to-active))
- ;; Fetch the headers from the `to-server'.
- (when (and to-active
- act-articles
- (setq type (gnus-retrieve-headers
- act-articles
- group to-server)))
- ;; Convert HEAD headers. I don't care.
- (when (eq type 'headers)
- (nnvirtual-convert-headers))
- ;; Create a mapping from Message-ID to article number.
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (gnus-sethash
- (buffer-substring (match-beginning 1) (match-end 1))
- (read (current-buffer))
- hashtb)
- (forward-line 1))
- ;; Then we read the headers from the `from-server'.
- (when (and (gnus-request-group group nil from-server)
- (gnus-active group)
- (gnus-uncompress-range
- (gnus-active group))
- (setq type (gnus-retrieve-headers
- (gnus-uncompress-range
- (gnus-active group))
- group from-server)))
- ;; Make it easier to map marks.
- (let ((mark-lists (gnus-info-marks info))
- ms type m)
- (while mark-lists
- (setq type (caar mark-lists)
- ms (gnus-uncompress-range (cdr (pop mark-lists))))
- (while ms
- (if (setq m (assq (car ms) marks))
- (setcdr m (cons type (cdr m)))
- (push (list (car ms) type) marks))
- (pop ms))))
- ;; Convert.
- (when (eq type 'headers)
- (nnvirtual-convert-headers))
- ;; Go through the headers and map away.
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (while (looking-at
- "^[0-9]+\t[^\t]*\t[^\t]*\t[^\t]*\t\\([^\t]*\\)\t")
- (when (setq to-article
- (gnus-gethash
- (buffer-substring (match-beginning 1) (match-end 1))
- hashtb))
- ;; Add this article to the list of read articles.
- (push to-article to-reads)
- ;; See if there are any marks and then add them.
- (when (setq mark (assq (read (current-buffer)) marks))
- (setq marks (delq mark marks))
- (setcar mark to-article)
- (push mark to-marks))
- (forward-line 1)))
- ;; Now we know what the read articles are and what the
- ;; article marks are. We transform the information
- ;; into the Gnus info format.
- (setq to-reads
- (gnus-range-add
- (gnus-compress-sequence
- (and (setq to-reads (delq nil to-reads))
- (sort to-reads '<))
- t)
- (cons 1 (1- (car to-active)))))
- (gnus-info-set-read info to-reads)
- ;; Do the marks. I'm sure y'all understand what's
- ;; going on down below, so I won't bother with any
- ;; further comments. <duck>
- (let ((mlists gnus-article-mark-lists)
- lists ms a)
- (while mlists
- (push (list (cdr (pop mlists))) lists))
- (while (setq ms (pop marks))
- (setq article (pop ms))
- (while ms
- (setcdr (setq a (assq (pop ms) lists))
- (cons article (cdr a)))))
- (setq a lists)
- (while a
- (setcdr (car a) (gnus-compress-sequence
- (and (cdar a) (sort (cdar a) '<))))
- (pop a))
- (gnus-info-set-marks info lists t)))))
- (gnus-message 7 "Translating %s...done" group)))
-
-(defun gnus-group-move-group-to-server (info from-server to-server)
- "Move the group on the current line from FROM-SERVER to TO-SERVER."
- (interactive
- (let ((info (gnus-get-info (gnus-group-group-name))))
- (list info (gnus-find-method-for-group (gnus-info-group info))
- (gnus-read-method (format "Move group %s to method: "
- (gnus-info-group info))))))
- (save-excursion
- (gnus-move-group-to-server info from-server to-server)
- ;; We have to update the group info to point use the right server.
- (gnus-info-set-method info to-server t)
- ;; We also have to change the name of the group and stuff.
- (let* ((group (gnus-info-group info))
- (new-name (gnus-group-prefixed-name
- (gnus-group-real-name group) to-server)))
- (gnus-info-set-group info new-name)
- (gnus-sethash new-name (gnus-gethash group gnus-newsrc-hashtb)
- gnus-newsrc-hashtb)
- (gnus-sethash group nil gnus-newsrc-hashtb))))
-
-(provide 'gnus-move)
-
-;;; arch-tag: 503742b8-7d66-4d79-bb31-4a698070707b
-;;; gnus-move.el ends here
+++ /dev/null
-;;; gnus-msg.el --- mail and post interface for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-ems)
-(require 'message)
-(require 'gnus-art)
-(require 'gnus-util)
-
-(defcustom gnus-post-method 'current
- "*Preferred method for posting USENET news.
-
-If this variable is `current' (which is the default), Gnus will use
-the \"current\" select method when posting. If it is `native', Gnus
-will use the native select method when posting.
-
-This method will not be used in mail groups and the like, only in
-\"real\" newsgroups.
-
-If not `native' nor `current', the value must be a valid method as discussed
-in the documentation of `gnus-select-method'. It can also be a list of
-methods. If that is the case, the user will be queried for what select
-method to use when posting."
- :group 'gnus-group-foreign
- :link '(custom-manual "(gnus)Posting Server")
- :type `(choice (const native)
- (const current)
- (sexp :tag "Methods" ,gnus-select-method)))
-
-(defcustom gnus-outgoing-message-group nil
- "*All outgoing messages will be put in this group.
-If you want to store all your outgoing mail and articles in the group
-\"nnml:archive\", you set this variable to that value. This variable
-can also be a list of group names.
-
-If you want to have greater control over what group to put each
-message in, you can set this variable to a function that checks the
-current newsgroup name and then returns a suitable group name (or list
-of names)."
- :group 'gnus-message
- :type '(choice (const nil)
- (function)
- (string :tag "Group")
- (repeat :tag "List of groups" (string :tag "Group"))))
-
-(defcustom gnus-mailing-list-groups nil
- "*If non-nil a regexp matching groups that are really mailing lists.
-This is useful when you're reading a mailing list that has been
-gatewayed to a newsgroup, and you want to followup to an article in
-the group."
- :group 'gnus-message
- :type '(choice (regexp)
- (const nil)))
-
-(defcustom gnus-add-to-list nil
- "*If non-nil, add a `to-list' parameter automatically."
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-crosspost-complaint
- "Hi,
-
-You posted the article below with the following Newsgroups header:
-
-Newsgroups: %s
-
-The %s group, at least, was an inappropriate recipient
-of this message. Please trim your Newsgroups header to exclude this
-group before posting in the future.
-
-Thank you.
-
-"
- "Format string to be inserted when complaining about crossposts.
-The first %s will be replaced by the Newsgroups header;
-the second with the current group name."
- :group 'gnus-message
- :type 'string)
-
-(defcustom gnus-message-setup-hook nil
- "Hook run after setting up a message buffer."
- :group 'gnus-message
- :type 'hook)
-
-(defcustom gnus-bug-create-help-buffer t
- "*Should we create the *Gnus Help Bug* buffer?"
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-posting-styles nil
- "*Alist of styles to use when posting.
-See Info node `(gnus)Posting Styles'."
- :group 'gnus-message
- :link '(custom-manual "(gnus)Posting Styles")
- :type '(repeat (cons (choice (regexp)
- (variable)
- (list (const header)
- (string :tag "Header")
- (regexp :tag "Regexp"))
- (function)
- (sexp))
- (repeat (list
- (choice (const signature)
- (const signature-file)
- (const organization)
- (const address)
- (const x-face-file)
- (const name)
- (const body)
- (symbol)
- (string :tag "Header"))
- (choice (string)
- (function)
- (variable)
- (sexp)))))))
-
-(defcustom gnus-gcc-mark-as-read nil
- "If non-nil, automatically mark Gcc articles as read."
- :version "22.1"
- :group 'gnus-message
- :type 'boolean)
-
-(make-obsolete-variable 'gnus-inews-mark-gcc-as-read
- 'gnus-gcc-mark-as-read)
-
-(defcustom gnus-gcc-externalize-attachments nil
- "Should local-file attachments be included as external parts in Gcc copies?
-If it is `all', attach files as external parts;
-if a regexp and matches the Gcc group name, attach files as external parts;
-if nil, attach files as normal parts."
- :version "22.1"
- :group 'gnus-message
- :type '(choice (const nil :tag "None")
- (const all :tag "Any")
- (string :tag "Regexp")))
-
-(gnus-define-group-parameter
- posting-charset-alist
- :type list
- :function-document
- "Return the permitted unencoded charsets for posting of GROUP."
- :variable gnus-group-posting-charset-alist
- :variable-default
- '(("^\\(no\\|fr\\)\\.[^,]*\\(,[ \t\n]*\\(no\\|fr\\)\\.[^,]*\\)*$" iso-8859-1 (iso-8859-1))
- ("^\\(fido7\\|relcom\\)\\.[^,]*\\(,[ \t\n]*\\(fido7\\|relcom\\)\\.[^,]*\\)*$" koi8-r (koi8-r))
- (message-this-is-mail nil nil)
- (message-this-is-news nil t))
- :variable-document
- "Alist of regexps and permitted unencoded charsets for posting.
-Each element of the alist has the form (TEST HEADER BODY-LIST), where
-TEST is either a regular expression matching the newsgroup header or a
-variable to query,
-HEADER is the charset which may be left unencoded in the header (nil
-means encode all charsets),
-BODY-LIST is a list of charsets which may be encoded using 8bit
-content-transfer encoding in the body, or one of the special values
-nil (always encode using quoted-printable) or t (always use 8bit).
-
-Note that any value other than nil for HEADER infringes some RFCs, so
-use this option with care."
- :variable-group gnus-charset
- :variable-type
- '(repeat (list :tag "Permitted unencoded charsets"
- (choice :tag "Where"
- (regexp :tag "Group")
- (const :tag "Mail message" :value message-this-is-mail)
- (const :tag "News article" :value message-this-is-news))
- (choice :tag "Header"
- (const :tag "None" nil)
- (symbol :tag "Charset"))
- (choice :tag "Body"
- (const :tag "Any" :value t)
- (const :tag "None" :value nil)
- (repeat :tag "Charsets"
- (symbol :tag "Charset")))))
- :parameter-type '(choice :tag "Permitted unencoded charsets"
- :value nil
- (repeat (symbol)))
- :parameter-document "\
-List of charsets that are permitted to be unencoded.")
-
-(defcustom gnus-debug-files
- '("gnus.el" "gnus-sum.el" "gnus-group.el"
- "gnus-art.el" "gnus-start.el" "gnus-async.el"
- "gnus-msg.el" "gnus-score.el" "gnus-win.el" "gnus-topic.el"
- "gnus-agent.el" "gnus-cache.el" "gnus-srvr.el"
- "mm-util.el" "mm-decode.el" "nnmail.el" "message.el")
- "Files whose variables will be reported in `gnus-bug'."
- :version "22.1"
- :group 'gnus-message
- :type '(repeat (string :tag "File")))
-
-(defcustom gnus-debug-exclude-variables
- '(mm-mime-mule-charset-alist
- nnmail-split-fancy message-minibuffer-local-map)
- "Variables that should not be reported in `gnus-bug'."
- :version "22.1"
- :group 'gnus-message
- :type '(repeat (symbol :tag "Variable")))
-
-(defcustom gnus-discouraged-post-methods
- '(nndraft nnml nnimap nnmaildir nnmh nnfolder nndir)
- "A list of back ends that are not used in \"real\" newsgroups.
-This variable is used only when `gnus-post-method' is `current'."
- :version "22.1"
- :group 'gnus-group-foreign
- :type '(repeat (symbol :tag "Back end")))
-
-(defcustom gnus-message-replysign
- nil
- "Automatically sign replies to signed messages.
-See also the `mml-default-sign-method' variable."
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-message-replyencrypt
- nil
- "Automatically encrypt replies to encrypted messages.
-See also the `mml-default-encrypt-method' variable."
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-message-replysignencrypted
- t
- "Setting this causes automatically encrypted messages to also be signed."
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-confirm-mail-reply-to-news nil
- "If non-nil, Gnus requests confirmation when replying to news.
-This is done because new users often reply by mistake when reading
-news.
-This can also be a function receiving the group name as the only
-parameter, which should return non-nil if a confirmation is needed; or
-a regexp, in which case a confirmation is asked for if the group name
-matches the regexp."
- :version "22.1"
- :group 'gnus-message
- :type '(choice (const :tag "No" nil)
- (const :tag "Yes" t)
- (regexp :tag "If group matches regexp")
- (function :tag "If function evaluates to non-nil")))
-
-(defcustom gnus-confirm-treat-mail-like-news
- nil
- "If non-nil, Gnus will treat mail like news with regard to confirmation
-when replying by mail. See the `gnus-confirm-mail-reply-to-news' variable
-for fine-tuning this.
-If nil, Gnus will never ask for confirmation if replying to mail."
- :version "22.1"
- :group 'gnus-message
- :type 'boolean)
-
-(defcustom gnus-summary-resend-default-address t
- "If non-nil, Gnus tries to suggest a default address to resend to.
-If nil, the address field will always be empty after invoking
-`gnus-summary-resend-message'."
- :version "22.1"
- :group 'gnus-message
- :type 'boolean)
-
-;;; Internal variables.
-
-(defvar gnus-inhibit-posting-styles nil
- "Inhibit the use of posting styles.")
-
-(defvar gnus-article-yanked-articles nil)
-(defvar gnus-message-buffer "*Mail Gnus*")
-(defvar gnus-article-copy nil)
-(defvar gnus-check-before-posting nil)
-(defvar gnus-last-posting-server nil)
-(defvar gnus-message-group-art nil)
-
-(defvar gnus-msg-force-broken-reply-to nil)
-
-(defconst gnus-bug-message
- "Sending a bug report to the Gnus Towers.
-========================================
-
-The buffer below is a mail buffer. When you press `C-c C-c', it will
-be sent to the Gnus Bug Exterminators.
-
-The thing near the bottom of the buffer is how the environment
-settings will be included in the mail. Please do not delete that.
-They will tell the Bug People what your environment is, so that it
-will be easier to locate the bugs.
-
-If you have found a bug that makes Emacs go \"beep\", set
-debug-on-error to t (`M-x set-variable RET debug-on-error RET t RET')
-and include the backtrace in your bug report.
-
-Please describe the bug in annoying, painstaking detail.
-
-Thank you for your help in stamping out bugs.
-")
-
-(eval-and-compile
- (autoload 'gnus-uu-post-news "gnus-uu" nil t)
- (autoload 'news-setup "rnewspost")
- (autoload 'news-reply-mode "rnewspost")
- (autoload 'rmail-dont-reply-to "mail-utils")
- (autoload 'rmail-output "rmailout"))
-
-\f
-;;;
-;;; Gnus Posting Functions
-;;;
-
-(gnus-define-keys (gnus-summary-send-map "S" gnus-summary-mode-map)
- "p" gnus-summary-post-news
- "i" gnus-summary-news-other-window
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "c" gnus-summary-cancel-article
- "s" gnus-summary-supersede-article
- "r" gnus-summary-reply
- "y" gnus-summary-yank-message
- "R" gnus-summary-reply-with-original
- "w" gnus-summary-wide-reply
- "W" gnus-summary-wide-reply-with-original
- "v" gnus-summary-very-wide-reply
- "V" gnus-summary-very-wide-reply-with-original
- "n" gnus-summary-followup-to-mail
- "N" gnus-summary-followup-to-mail-with-original
- "m" gnus-summary-mail-other-window
- "u" gnus-uu-post-news
- "\M-c" gnus-summary-mail-crosspost-complaint
- "Br" gnus-summary-reply-broken-reply-to
- "BR" gnus-summary-reply-broken-reply-to-with-original
- "om" gnus-summary-mail-forward
- "op" gnus-summary-post-forward
- "Om" gnus-uu-digest-mail-forward
- "Op" gnus-uu-digest-post-forward)
-
-(gnus-define-keys (gnus-send-bounce-map "D" gnus-summary-send-map)
- "b" gnus-summary-resend-bounced-mail
- ;; "c" gnus-summary-send-draft
- "r" gnus-summary-resend-message
- "e" gnus-summary-resend-message-edit)
-
-;;; Internal functions.
-
-(defun gnus-inews-make-draft ()
- `(lambda ()
- (gnus-inews-make-draft-meta-information
- ,gnus-newsgroup-name ',gnus-article-reply)))
-
-(defvar gnus-article-reply nil)
-(defmacro gnus-setup-message (config &rest forms)
- (let ((winconf (make-symbol "gnus-setup-message-winconf"))
- (buffer (make-symbol "gnus-setup-message-buffer"))
- (article (make-symbol "gnus-setup-message-article"))
- (yanked (make-symbol "gnus-setup-yanked-articles"))
- (group (make-symbol "gnus-setup-message-group")))
- `(let ((,winconf (current-window-configuration))
- (,buffer (buffer-name (current-buffer)))
- (,article gnus-article-reply)
- (,yanked gnus-article-yanked-articles)
- (,group gnus-newsgroup-name)
- (message-header-setup-hook
- (copy-sequence message-header-setup-hook))
- (mbl mml-buffer-list)
- (message-mode-hook (copy-sequence message-mode-hook)))
- (setq mml-buffer-list nil)
- (add-hook 'message-header-setup-hook 'gnus-inews-insert-gcc)
- (add-hook 'message-header-setup-hook 'gnus-inews-insert-archive-gcc)
- ;; message-newsreader and message-mailer were formerly set in
- ;; gnus-inews-add-send-actions, but this is too late when
- ;; message-generate-headers-first is used. --ansel
- (add-hook 'message-mode-hook
- (lambda nil
- (setq message-newsreader
- (setq message-mailer (gnus-extended-version)))))
- ;; #### FIXME: for a reason that I did not manage to identify yet,
- ;; the variable `gnus-newsgroup-name' does not honor a dynamically
- ;; scoped or setq'ed value from a caller like `C-u gnus-summary-mail'.
- ;; After evaluation of @forms below, it gets the value we actually want
- ;; to override, and the posting styles are used. For that reason, I've
- ;; added an optional argument to `gnus-configure-posting-styles' to
- ;; make sure that the correct value for the group name is used. -- drv
- (add-hook 'message-mode-hook
- (if (memq ,config '(reply-yank reply))
- (lambda ()
- (gnus-configure-posting-styles ,group))
- (lambda ()
- ;; There may be an old " *gnus article copy*" buffer.
- (let (gnus-article-copy)
- (gnus-configure-posting-styles ,group)))))
- (gnus-pull ',(intern gnus-draft-meta-information-header)
- message-required-headers)
- (when (and ,group
- (not (string= ,group "")))
- (push (cons
- (intern gnus-draft-meta-information-header)
- (gnus-inews-make-draft))
- message-required-headers))
- (unwind-protect
- (progn
- ,@forms)
- (gnus-inews-add-send-actions ,winconf ,buffer ,article ,config
- ,yanked)
- (setq gnus-message-buffer (current-buffer))
- (set (make-local-variable 'gnus-message-group-art)
- (cons ,group ,article))
- (set (make-local-variable 'gnus-newsgroup-name) ,group)
- (gnus-run-hooks 'gnus-message-setup-hook)
- (if (eq major-mode 'message-mode)
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl) ;; Global value
- (set (make-local-variable 'mml-buffer-list) mbl1);; Local value
- (gnus-make-local-hook 'kill-buffer-hook)
- (gnus-make-local-hook 'change-major-mode-hook)
- (add-hook 'change-major-mode-hook 'mml-destroy-buffers nil t)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))
- (mml-destroy-buffers)
- (setq mml-buffer-list mbl)))
- (message-hide-headers)
- (gnus-add-buffer)
- (gnus-configure-windows ,config t)
- (run-hooks 'post-command-hook)
- (set-buffer-modified-p nil))))
-
-(defun gnus-inews-make-draft-meta-information (group article)
- (concat "(\"" group "\" "
- (if article (number-to-string
- (if (listp article)
- (car article)
- article)) "\"\"")
- ")"))
-
-;;;###autoload
-(defun gnus-msg-mail (&optional to subject other-headers continue
- switch-action yank-action send-actions)
- "Start editing a mail message to be sent.
-Like `message-mail', but with Gnus paraphernalia, particularly the
-Gcc: header for archiving purposes."
- (interactive)
- (let ((buf (current-buffer))
- mail-buf)
- (gnus-setup-message 'message
- (message-mail to subject other-headers continue
- nil yank-action send-actions))
- (when switch-action
- (setq mail-buf (current-buffer))
- (switch-to-buffer buf)
- (apply switch-action mail-buf nil)))
- ;; COMPOSEFUNC should return t if succeed. Undocumented ???
- t)
-
-;;;###autoload
-(defun gnus-button-mailto (address)
- "Mail to ADDRESS."
- (set-buffer (gnus-copy-article-buffer))
- (gnus-setup-message 'message
- (message-reply address)))
-
-;;;###autoload
-(defun gnus-button-reply (&optional to-address wide)
- "Like `message-reply'."
- (interactive)
- (gnus-setup-message 'message
- (message-reply to-address wide)))
-
-;;;###autoload
-(define-mail-user-agent 'gnus-user-agent
- 'gnus-msg-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook)
-
-(defun gnus-setup-posting-charset (group)
- (let ((alist gnus-group-posting-charset-alist)
- (group (or group ""))
- elem)
- (when group
- (catch 'found
- (while (setq elem (pop alist))
- (when (or (and (stringp (car elem))
- (string-match (car elem) group))
- (and (functionp (car elem))
- (funcall (car elem) group))
- (and (symbolp (car elem))
- (symbol-value (car elem))))
- (throw 'found (cons (cadr elem) (caddr elem)))))))))
-
-(defun gnus-inews-add-send-actions (winconf buffer article
- &optional config yanked)
- (gnus-make-local-hook 'message-sent-hook)
- (add-hook 'message-sent-hook (if gnus-agent 'gnus-agent-possibly-do-gcc
- 'gnus-inews-do-gcc) nil t)
- (when gnus-agent
- (gnus-make-local-hook 'message-header-hook)
- (add-hook 'message-header-hook 'gnus-agent-possibly-save-gcc nil t))
- (setq message-post-method
- `(lambda (arg)
- (gnus-post-method arg ,gnus-newsgroup-name)))
- (message-add-action
- `(when (gnus-buffer-exists-p ,buffer)
- (set-window-configuration ,winconf))
- 'exit 'postpone 'kill)
- (let ((to-be-marked (cond
- (yanked
- (mapcar
- (lambda (x) (if (listp x) (car x) x)) yanked))
- (article (if (listp article) article (list article)))
- (t nil))))
- (message-add-action
- `(when (gnus-buffer-exists-p ,buffer)
- (save-excursion
- (set-buffer ,buffer)
- ,(when to-be-marked
- (if (eq config 'forward)
- `(gnus-summary-mark-article-as-forwarded ',to-be-marked)
- `(gnus-summary-mark-article-as-replied ',to-be-marked)))))
- 'send)))
-
-(put 'gnus-setup-message 'lisp-indent-function 1)
-(put 'gnus-setup-message 'edebug-form-spec '(form body))
-
-;;; Post news commands of Gnus group mode and summary mode
-
-(defun gnus-group-mail (&optional arg)
- "Start composing a mail.
-If ARG, use the group under the point to find a posting style.
-If ARG is 1, prompt for a group name to find the posting style."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Use posting style of group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (save-excursion
- (set-buffer buffer)
- (setq gnus-newsgroup-name group)))))
-
-(defun gnus-group-news (&optional arg)
- "Start composing a news.
-If ARG, post to group under point.
-If ARG is 1, prompt for group name to post to.
-
-This function prepares a news even when using mail groups. This is useful
-for posting messages to mail groups without actually sending them over the
-network. The corresponding back end must have a 'request-post method."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- ""))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message
- (message-news (gnus-group-real-name gnus-newsgroup-name))))
- (save-excursion
- (set-buffer buffer)
- (setq gnus-newsgroup-name group)))))
-
-(defun gnus-group-post-news (&optional arg)
- "Start composing a message (a news by default).
-If ARG, post to group under point. If ARG is 1, prompt for group name.
-Depending on the selected group, the message might be either a mail or
-a news."
- (interactive "P")
- ;; Bind this variable here to make message mode hooks work ok.
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Newsgroup: " gnus-active-hashtb nil
- (gnus-read-active-file-p))
- (gnus-group-group-name))
- ""))
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy))
- (gnus-post-news 'post gnus-newsgroup-name nil nil nil nil
- (string= gnus-newsgroup-name ""))))
-
-(defun gnus-summary-mail-other-window (&optional arg)
- "Start composing a mail in another window.
-Use the posting of the current group by default.
-If ARG, don't do that. If ARG is 1, prompt for group name to find the
-posting style."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message (message-mail)))
- (save-excursion
- (set-buffer buffer)
- (setq gnus-newsgroup-name group)))))
-
-(defun gnus-summary-news-other-window (&optional arg)
- "Start composing a news in another window.
-Post to the current group by default.
-If ARG, don't do that. If ARG is 1, prompt for group name to post to.
-
-This function prepares a news even when using mail groups. This is useful
-for posting messages to mail groups without actually sending them over the
-network. The corresponding back end must have a 'request-post method."
- (interactive "P")
- ;; We can't `let' gnus-newsgroup-name here, since that leads
- ;; to local variables leaking.
- (let ((group gnus-newsgroup-name)
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy)
- (buffer (current-buffer)))
- (unwind-protect
- (progn
- (setq gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Use group: "
- gnus-active-hashtb nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name))
- ;; #### see comment in gnus-setup-message -- drv
- (gnus-setup-message 'message
- (progn
- (message-news (gnus-group-real-name gnus-newsgroup-name))
- (set (make-local-variable 'gnus-discouraged-post-methods)
- (delq
- (car (gnus-find-method-for-group gnus-newsgroup-name))
- (copy-sequence gnus-discouraged-post-methods))))))
- (save-excursion
- (set-buffer buffer)
- (setq gnus-newsgroup-name group)))))
-
-(defun gnus-summary-post-news (&optional arg)
- "Start composing a message. Post to the current group by default.
-If ARG, don't do that. If ARG is 1, prompt for a group name to post to.
-Depending on the selected group, the message might be either a mail or
-a news."
- (interactive "P")
- ;; Bind this variable here to make message mode hooks work ok.
- (let ((gnus-newsgroup-name
- (if arg
- (if (= 1 (prefix-numeric-value arg))
- (completing-read "Newsgroup: " gnus-active-hashtb nil
- (gnus-read-active-file-p))
- "")
- gnus-newsgroup-name))
- ;; make sure last viewed article doesn't affect posting styles:
- (gnus-article-copy))
- (gnus-post-news 'post gnus-newsgroup-name)))
-
-
-(defun gnus-summary-followup (yank &optional force-news)
- "Compose a followup to an article.
-If prefix argument YANK is non-nil, the original article is yanked
-automatically.
-YANK is a list of elements, where the car of each element is the
-article number, and the cdr is the string to be yanked."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (when yank
- (gnus-summary-goto-subject
- (if (listp (car yank))
- (caar yank)
- (car yank))))
- (save-window-excursion
- (gnus-summary-select-article))
- (let ((headers (gnus-summary-article-header (gnus-summary-article-number)))
- (gnus-newsgroup-name gnus-newsgroup-name))
- ;; Send a followup.
- (gnus-post-news nil gnus-newsgroup-name
- headers gnus-article-buffer
- yank nil force-news)
- (gnus-summary-handle-replysign)))
-
-(defun gnus-summary-followup-with-original (n &optional force-news)
- "Compose a followup to an article and include the original article.
-The text in the region will be yanked. If the region isn't
-active, the entire article will be yanked."
- (interactive "P")
- (gnus-summary-followup (gnus-summary-work-articles n) force-news))
-
-(defun gnus-summary-followup-to-mail (&optional arg)
- "Followup to the current mail message via news."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (gnus-summary-followup arg t))
-
-(defun gnus-summary-followup-to-mail-with-original (&optional arg)
- "Followup to the current mail message via news."
- (interactive "P")
- (gnus-summary-followup (gnus-summary-work-articles arg) t))
-
-(defun gnus-inews-yank-articles (articles)
- (let (beg article yank-string)
- (message-goto-body)
- (while (setq article (pop articles))
- (when (listp article)
- (setq yank-string (nth 1 article)
- article (nth 0 article)))
- (save-window-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-select-article nil nil nil article)
- (gnus-summary-remove-process-mark article))
- (gnus-copy-article-buffer nil yank-string)
- (let ((message-reply-buffer gnus-article-copy)
- (message-reply-headers
- ;; The headers are decoded.
- (with-current-buffer gnus-article-copy
- (save-restriction
- (nnheader-narrow-to-headers)
- (nnheader-parse-naked-head)))))
- (message-yank-original)
- (message-exchange-point-and-mark)
- (setq beg (or beg (mark t))))
- (when articles
- (insert "\n")))
- (push-mark)
- (goto-char beg)))
-
-(defun gnus-summary-cancel-article (&optional n symp)
- "Cancel an article you posted.
-Uses the process-prefix convention. If given the symbolic
-prefix `a', cancel using the standard posting method; if not
-post using the current select method."
- (interactive (gnus-interactive "P\ny"))
- (let ((articles (gnus-summary-work-articles n))
- (message-post-method
- `(lambda (arg)
- (gnus-post-method (eq ',symp 'a) ,gnus-newsgroup-name)))
- article)
- (while (setq article (pop articles))
- (when (gnus-summary-select-article t nil nil article)
- (when (gnus-eval-in-buffer-window gnus-original-article-buffer
- (message-cancel-news))
- (gnus-summary-mark-as-read article gnus-canceled-mark)
- (gnus-cache-remove-article 1))
- (gnus-article-hide-headers-if-wanted))
- (gnus-summary-remove-process-mark article))))
-
-(defun gnus-summary-supersede-article ()
- "Compose an article that will supersede a previous article.
-This is done simply by taking the old article and adding a Supersedes
-header line with the old Message-ID."
- (interactive)
- (let ((article (gnus-summary-article-number)))
- (gnus-setup-message 'reply-yank
- (gnus-summary-select-article t)
- (set-buffer gnus-original-article-buffer)
- (message-supersede)
- (push
- `((lambda ()
- (when (gnus-buffer-exists-p ,gnus-summary-buffer)
- (save-excursion
- (set-buffer ,gnus-summary-buffer)
- (gnus-cache-possibly-remove-article ,article nil nil nil t)
- (gnus-summary-mark-as-read ,article gnus-canceled-mark)))))
- message-send-actions)
- ;; Add Gcc header.
- (gnus-inews-insert-archive-gcc)
- (gnus-inews-insert-gcc))))
-
-\f
-
-(defun gnus-copy-article-buffer (&optional article-buffer yank-string)
- ;; make a copy of the article buffer with all text properties removed
- ;; this copy is in the buffer gnus-article-copy.
- ;; if ARTICLE-BUFFER is nil, gnus-article-buffer is used
- ;; this buffer should be passed to all mail/news reply/post routines.
- (setq gnus-article-copy (gnus-get-buffer-create " *gnus article copy*"))
- (save-excursion
- (set-buffer gnus-article-copy)
- (mm-enable-multibyte))
- (let ((article-buffer (or article-buffer gnus-article-buffer))
- end beg)
- (if (not (and (get-buffer article-buffer)
- (gnus-buffer-exists-p article-buffer)))
- (error "Can't find any article buffer")
- (save-excursion
- (set-buffer article-buffer)
- (let ((gnus-newsgroup-charset (or gnus-article-charset
- gnus-newsgroup-charset))
- (gnus-newsgroup-ignored-charsets
- (or gnus-article-ignored-charsets
- gnus-newsgroup-ignored-charsets)))
- (save-restriction
- ;; Copy over the (displayed) article buffer, delete
- ;; hidden text and remove text properties.
- (widen)
- (copy-to-buffer gnus-article-copy (point-min) (point-max))
- (set-buffer gnus-article-copy)
- (when yank-string
- (message-goto-body)
- (delete-region (point) (point-max))
- (insert yank-string))
- (gnus-article-delete-text-of-type 'annotation)
- (gnus-article-delete-text-of-type 'multipart)
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next)
- (gnus-remove-text-with-property 'gnus-decoration)
- (insert
- (prog1
- (buffer-substring-no-properties (point-min) (point-max))
- (erase-buffer)))
- ;; Find the original headers.
- (set-buffer gnus-original-article-buffer)
- (goto-char (point-min))
- (while (looking-at message-unix-mail-delimiter)
- (forward-line 1))
- (let ((mail-header-separator ""))
- (setq beg (point)
- end (or (message-goto-body)
- ;; There may be just a header.
- (point-max))))
- ;; Delete the headers from the displayed articles.
- (set-buffer gnus-article-copy)
- (let ((mail-header-separator ""))
- (delete-region (goto-char (point-min))
- (or (message-goto-body) (point-max))))
- ;; Insert the original article headers.
- (insert-buffer-substring gnus-original-article-buffer beg end)
- ;; Decode charsets.
- (let ((gnus-article-decode-hook
- (delq 'article-decode-charset
- (copy-sequence gnus-article-decode-hook)))
- (rfc2047-quote-decoded-words-containing-tspecials t))
- (run-hooks 'gnus-article-decode-hook)))))
- gnus-article-copy)))
-
-(defun gnus-post-news (post &optional group header article-buffer yank subject
- force-news)
- (when article-buffer
- (gnus-copy-article-buffer))
- (let ((gnus-article-reply (and article-buffer (gnus-summary-article-number)))
- (gnus-article-yanked-articles yank)
- (add-to-list gnus-add-to-list))
- (gnus-setup-message (cond (yank 'reply-yank)
- (article-buffer 'reply)
- (t 'message))
- (let* ((group (or group gnus-newsgroup-name))
- (charset (gnus-group-name-charset nil group))
- (pgroup group)
- to-address to-group mailing-list to-list
- newsgroup-p)
- (when group
- (setq to-address (gnus-parameter-to-address group)
- to-group (gnus-group-find-parameter group 'to-group)
- to-list (gnus-parameter-to-list group)
- newsgroup-p (gnus-group-find-parameter group 'newsgroup)
- mailing-list (when gnus-mailing-list-groups
- (string-match gnus-mailing-list-groups group))
- group (gnus-group-name-decode (gnus-group-real-name group)
- charset)))
- (if (or (and to-group
- (gnus-news-group-p to-group))
- newsgroup-p
- force-news
- (and (gnus-news-group-p
- (or pgroup gnus-newsgroup-name)
- (or header gnus-current-article))
- (not mailing-list)
- (not to-list)
- (not to-address)))
- ;; This is news.
- (if post
- (message-news
- (or to-group
- (and (not (gnus-virtual-group-p pgroup)) group)))
- (set-buffer gnus-article-copy)
- (gnus-msg-treat-broken-reply-to)
- (message-followup (if (or newsgroup-p force-news)
- (if (save-restriction
- (article-narrow-to-head)
- (message-fetch-field "newsgroups"))
- nil
- "")
- to-group)))
- ;; The is mail.
- (if post
- (progn
- (message-mail (or to-address to-list))
- ;; Arrange for mail groups that have no `to-address' to
- ;; get that when the user sends off the mail.
- (when (and (not to-list)
- (not to-address)
- add-to-list)
- (push (list 'gnus-inews-add-to-address pgroup)
- message-send-actions)))
- (set-buffer gnus-article-copy)
- (gnus-msg-treat-broken-reply-to)
- (message-wide-reply to-address)))
- (when yank
- (gnus-inews-yank-articles yank))))))
-
-(defun gnus-msg-treat-broken-reply-to (&optional force)
- "Remove the Reply-to header if broken-reply-to."
- (when (or force
- (gnus-group-find-parameter
- gnus-newsgroup-name 'broken-reply-to))
- (save-restriction
- (message-narrow-to-head)
- (message-remove-header "reply-to"))))
-
-(defun gnus-post-method (arg group &optional silent)
- "Return the posting method based on GROUP and ARG.
-If SILENT, don't prompt the user."
- (let ((gnus-post-method (or (gnus-parameter-post-method group)
- gnus-post-method))
- (group-method (gnus-find-method-for-group group)))
- (cond
- ;; If the group-method is nil (which shouldn't happen) we use
- ;; the default method.
- ((null group-method)
- (or (and (listp gnus-post-method) ;If not current/native/nil
- (not (listp (car gnus-post-method))) ; and not a list of methods
- gnus-post-method) ;then use it.
- gnus-select-method
- message-post-method))
- ;; We want the inverse of the default
- ((and arg (not (eq arg 0)))
- (if (eq gnus-post-method 'current)
- gnus-select-method
- group-method))
- ;; We query the user for a post method.
- ((or arg
- (and (listp gnus-post-method)
- (listp (car gnus-post-method))))
- (let* ((methods
- ;; Collect all methods we know about.
- (append
- (when (listp gnus-post-method)
- (if (listp (car gnus-post-method))
- gnus-post-method
- (list gnus-post-method)))
- gnus-secondary-select-methods
- (mapcar 'cdr gnus-server-alist)
- (mapcar 'car gnus-opened-servers)
- (list gnus-select-method)
- (list group-method)))
- method-alist post-methods method)
- ;; Weed out all mail methods.
- (while methods
- (setq method (gnus-server-get-method "" (pop methods)))
- (when (and (or (gnus-method-option-p method 'post)
- (gnus-method-option-p method 'post-mail))
- (not (member method post-methods)))
- (push method post-methods)))
- ;; Create a name-method alist.
- (setq method-alist
- (mapcar
- (lambda (m)
- (if (equal (cadr m) "")
- (list (symbol-name (car m)) m)
- (list (concat (cadr m) " (" (symbol-name (car m)) ")") m)))
- post-methods))
- ;; Query the user.
- (cadr
- (assoc
- (setq gnus-last-posting-server
- (if (and silent
- gnus-last-posting-server)
- ;; Just use the last value.
- gnus-last-posting-server
- (completing-read
- "Posting method: " method-alist nil t
- (cons (or gnus-last-posting-server "") 0))))
- method-alist))))
- ;; Override normal method.
- ((and (eq gnus-post-method 'current)
- (not (memq (car group-method) gnus-discouraged-post-methods))
- (gnus-get-function group-method 'request-post t))
- (assert (not arg))
- group-method)
- ;; Use gnus-post-method.
- ((listp gnus-post-method) ;A method...
- (assert (not (listp (car gnus-post-method)))) ;... not a list of methods.
- gnus-post-method)
- ;; Use the normal select method (nil or native).
- (t gnus-select-method))))
-
-\f
-
-(defun gnus-extended-version ()
- "Stringified Gnus version and Emacs version.
-See the variable `gnus-user-agent'."
- (interactive)
- (if (stringp gnus-user-agent)
- gnus-user-agent
- ;; `gnus-user-agent' is a list:
- (let* ((float-output-format nil)
- (gnus-v
- (when (memq 'gnus gnus-user-agent)
- (concat "Gnus/"
- (prin1-to-string (gnus-continuum-version gnus-version) t)
- " (" gnus-version ")")))
- (emacs-v (gnus-emacs-version)))
- (concat gnus-v (when (and gnus-v emacs-v) " ")
- emacs-v))))
-
-\f
-;;;
-;;; Gnus Mail Functions
-;;;
-
-;;; Mail reply commands of Gnus summary mode
-
-(defun gnus-summary-reply (&optional yank wide very-wide)
- "Start composing a mail reply to the current message.
-If prefix argument YANK is non-nil, the original article is yanked
-automatically.
-If WIDE, make a wide reply.
-If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- ;; Allow user to require confirmation before replying by mail to the
- ;; author of a news article (or mail message).
- (when (or
- (not (or (gnus-news-group-p gnus-newsgroup-name)
- gnus-confirm-treat-mail-like-news))
- (not (cond ((stringp gnus-confirm-mail-reply-to-news)
- (string-match gnus-confirm-mail-reply-to-news
- gnus-newsgroup-name))
- ((functionp gnus-confirm-mail-reply-to-news)
- (funcall gnus-confirm-mail-reply-to-news gnus-newsgroup-name))
- (t gnus-confirm-mail-reply-to-news)))
- (y-or-n-p "Really reply by mail to article author? "))
- (let* ((article
- (if (listp (car yank))
- (caar yank)
- (car yank)))
- (gnus-article-reply (or article (gnus-summary-article-number)))
- (gnus-article-yanked-articles yank)
- (headers ""))
- ;; Stripping headers should be specified with mail-yank-ignored-headers.
- (when yank
- (gnus-summary-goto-subject article))
- (gnus-setup-message (if yank 'reply-yank 'reply)
- (if (not very-wide)
- (gnus-summary-select-article)
- (dolist (article very-wide)
- (gnus-summary-select-article nil nil nil article)
- (save-excursion
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (setq headers (concat headers (buffer-string)))))))
- (set-buffer (gnus-copy-article-buffer))
- (gnus-msg-treat-broken-reply-to gnus-msg-force-broken-reply-to)
- (save-restriction
- (message-narrow-to-head)
- (when very-wide
- (erase-buffer)
- (insert headers))
- (goto-char (point-max)))
- (mml-quote-region (point) (point-max))
- (message-reply nil wide)
- (when yank
- (gnus-inews-yank-articles yank))
- (gnus-summary-handle-replysign)))))
-
-(defun gnus-summary-handle-replysign ()
- "Check the various replysign variables and take action accordingly."
- (when (or gnus-message-replysign gnus-message-replyencrypt)
- (let (signed encrypted)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (setq signed (memq 'signed gnus-article-wash-types))
- (setq encrypted (memq 'encrypted gnus-article-wash-types)))
- (cond ((and gnus-message-replyencrypt encrypted)
- (mml-secure-message mml-default-encrypt-method
- (if gnus-message-replysignencrypted
- 'signencrypt
- 'encrypt)))
- ((and gnus-message-replysign signed)
- (mml-secure-message mml-default-sign-method 'sign))))))
-
-(defun gnus-summary-reply-with-original (n &optional wide)
- "Start composing a reply mail to the current message.
-The original article will be yanked."
- (interactive "P")
- (gnus-summary-reply (gnus-summary-work-articles n) wide))
-
-(defun gnus-summary-reply-broken-reply-to (&optional yank wide very-wide)
- "Like `gnus-summary-reply' except removing reply-to field.
-If prefix argument YANK is non-nil, the original article is yanked
-automatically.
-If WIDE, make a wide reply.
-If VERY-WIDE, make a very wide reply."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (let ((gnus-msg-force-broken-reply-to t))
- (gnus-summary-reply yank wide very-wide)))
-
-(defun gnus-summary-reply-broken-reply-to-with-original (n &optional wide)
- "Like `gnus-summary-reply-with-original' except removing reply-to field.
-The original article will be yanked."
- (interactive "P")
- (gnus-summary-reply-broken-reply-to (gnus-summary-work-articles n) wide))
-
-(defun gnus-summary-wide-reply (&optional yank)
- "Start composing a wide reply mail to the current message.
-If prefix argument YANK is non-nil, the original article is yanked
-automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (gnus-summary-reply yank t))
-
-(defun gnus-summary-wide-reply-with-original (n)
- "Start composing a wide reply mail to the current message.
-The original article will be yanked.
-Uses the process/prefix convention."
- (interactive "P")
- (gnus-summary-reply-with-original n t))
-
-(defun gnus-summary-very-wide-reply (&optional yank)
- "Start composing a very wide reply mail to the current message.
-If prefix argument YANK is non-nil, the original article is yanked
-automatically."
- (interactive
- (list (and current-prefix-arg
- (gnus-summary-work-articles 1))))
- (gnus-summary-reply yank t (gnus-summary-work-articles yank)))
-
-(defun gnus-summary-very-wide-reply-with-original (n)
- "Start composing a very wide reply mail to the current message.
-The original article will be yanked."
- (interactive "P")
- (gnus-summary-reply
- (gnus-summary-work-articles n) t (gnus-summary-work-articles n)))
-
-(defun gnus-summary-mail-forward (&optional arg post)
- "Forward the current message(s) to another user.
-If process marks exist, forward all marked messages;
-if ARG is nil, see `message-forward-as-mime' and `message-forward-show-mml';
-if ARG is 1, decode the message and forward directly inline;
-if ARG is 2, forward message as an rfc822 MIME section;
-if ARG is 3, decode message and forward as an rfc822 MIME section;
-if ARG is 4, forward message directly inline;
-otherwise, use flipped `message-forward-as-mime'.
-If POST, post instead of mail.
-For the `inline' alternatives, also see the variable
-`message-forward-ignored-headers'."
- (interactive "P")
- (if (cdr (gnus-summary-work-articles nil))
- ;; Process marks are given.
- (gnus-uu-digest-mail-forward arg post)
- ;; No process marks.
- (let ((message-forward-as-mime message-forward-as-mime)
- (message-forward-show-mml message-forward-show-mml))
- (cond
- ((null arg))
- ((eq arg 1)
- (setq message-forward-as-mime nil
- message-forward-show-mml t))
- ((eq arg 2)
- (setq message-forward-as-mime t
- message-forward-show-mml nil))
- ((eq arg 3)
- (setq message-forward-as-mime t
- message-forward-show-mml t))
- ((eq arg 4)
- (setq message-forward-as-mime nil
- message-forward-show-mml nil))
- (t
- (setq message-forward-as-mime (not message-forward-as-mime))))
- (let* ((gnus-article-reply (gnus-summary-article-number))
- (gnus-article-yanked-articles (list gnus-article-reply)))
- (gnus-setup-message 'forward
- (gnus-summary-select-article)
- (let ((mail-parse-charset
- (or (and (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- gnus-article-charset))
- gnus-newsgroup-charset))
- (mail-parse-ignored-charsets
- gnus-newsgroup-ignored-charsets))
- (set-buffer gnus-original-article-buffer)
- (message-forward post)))))))
-
-(defun gnus-summary-resend-message (address n)
- "Resend the current article to ADDRESS."
- (interactive
- (list (message-read-from-minibuffer
- "Resend message(s) to: "
- (when (and gnus-summary-resend-default-address
- (gnus-buffer-live-p gnus-original-article-buffer))
- ;; If some other article is currently selected, the
- ;; initial-contents is wrong. Whatever, it is just the
- ;; initial-contents.
- (with-current-buffer gnus-original-article-buffer
- (nnmail-fetch-field "to"))))
- current-prefix-arg))
- (let ((articles (gnus-summary-work-articles n))
- article)
- (while (setq article (pop articles))
- (gnus-summary-select-article nil nil nil article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (message-resend address))
- (gnus-summary-mark-article-as-forwarded article))))
-
-;; From: Matthieu Moy <Matthieu.Moy@imag.fr>
-(defun gnus-summary-resend-message-edit ()
- "Resend an article that has already been sent.
-A new buffer will be created to allow the user to modify body and
-contents of the message, and then, everything will happen as when
-composing a new message."
- (interactive)
- (let ((article (gnus-summary-article-number)))
- (gnus-setup-message 'reply-yank
- (gnus-summary-select-article t)
- (set-buffer gnus-original-article-buffer)
- (let ((cur (current-buffer))
- (to (message-fetch-field "to")))
- ;; Get a normal message buffer.
- (message-pop-to-buffer (message-buffer-name "Resend" to))
- (insert-buffer-substring cur)
- (mime-to-mml)
- (message-narrow-to-head-1)
- ;; Gnus will generate a new one when sending.
- (message-remove-header "Message-ID")
- ;; Remove unwanted headers.
- (message-remove-header message-ignored-resent-headers t)
- (goto-char (point-max))
- (insert mail-header-separator)
- ;; Add Gcc header.
- (gnus-inews-insert-archive-gcc)
- (gnus-inews-insert-gcc)
- (goto-char (point-min))
- (when (re-search-forward "^To:\\|^Newsgroups:" nil 'move)
- (forward-char 1))
- (widen)))))
-
-(defun gnus-summary-post-forward (&optional arg)
- "Forward the current article to a newsgroup.
-See `gnus-summary-mail-forward' for ARG."
- (interactive "P")
- (gnus-summary-mail-forward arg t))
-
-(defvar gnus-nastygram-message
- "The following article was inappropriately posted to %s.\n\n"
- "Format string to insert in nastygrams.
-The current group name will be inserted at \"%s\".")
-
-(defun gnus-summary-mail-nastygram (n)
- "Send a nastygram to the author of the current article."
- (interactive "P")
- (when (or gnus-expert-user
- (gnus-y-or-n-p
- "Really send a nastygram to the author of the current article? "))
- (let ((group gnus-newsgroup-name))
- (gnus-summary-reply-with-original n)
- (set-buffer gnus-message-buffer)
- (message-goto-body)
- (insert (format gnus-nastygram-message group))
- (message-send-and-exit))))
-
-(defun gnus-summary-mail-crosspost-complaint (n)
- "Send a complaint about crossposting to the current article(s)."
- (interactive "P")
- (let ((articles (gnus-summary-work-articles n))
- article)
- (while (setq article (pop articles))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-goto-subject article)
- (let ((group (gnus-group-real-name gnus-newsgroup-name))
- newsgroups followup-to)
- (gnus-summary-select-article)
- (set-buffer gnus-original-article-buffer)
- (if (and (<= (length (message-tokenize-header
- (setq newsgroups
- (mail-fetch-field "newsgroups"))
- ", "))
- 1)
- (or (not (setq followup-to (mail-fetch-field "followup-to")))
- (not (member group (message-tokenize-header
- followup-to ", ")))))
- (if followup-to
- (gnus-message 1 "Followup-to restricted")
- (gnus-message 1 "Not a crossposted article"))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-reply-with-original 1)
- (set-buffer gnus-message-buffer)
- (message-goto-body)
- (insert (format gnus-crosspost-complaint newsgroups group))
- (message-goto-subject)
- (re-search-forward " *$")
- (replace-match " (crosspost notification)" t t)
- (gnus-deactivate-mark)
- (when (gnus-y-or-n-p "Send this complaint? ")
- (message-send-and-exit)))))))
-
-(defun gnus-mail-parse-comma-list ()
- (let (accumulated
- beg)
- (skip-chars-forward " ")
- (while (not (eobp))
- (setq beg (point))
- (skip-chars-forward "^,")
- (while (zerop
- (save-excursion
- (save-restriction
- (let ((i 0))
- (narrow-to-region beg (point))
- (goto-char beg)
- (logand (progn
- (while (search-forward "\"" nil t)
- (incf i))
- (if (zerop i) 2 i))
- 2)))))
- (skip-chars-forward ",")
- (skip-chars-forward "^,"))
- (skip-chars-backward " ")
- (push (buffer-substring beg (point))
- accumulated)
- (skip-chars-forward "^,")
- (skip-chars-forward ", "))
- accumulated))
-
-(defun gnus-inews-add-to-address (group)
- (let ((to-address (mail-fetch-field "to")))
- (when (and to-address
- (gnus-alive-p))
- ;; This mail group doesn't have a `to-list', so we add one
- ;; here. Magic!
- (when (gnus-y-or-n-p
- (format "Do you want to add this as `to-list': %s? " to-address))
- (gnus-group-add-parameter group (cons 'to-list to-address))))))
-
-(defun gnus-put-message ()
- "Put the current message in some group and return to Gnus."
- (interactive)
- (let ((reply gnus-article-reply)
- (winconf gnus-prev-winconf)
- (group gnus-newsgroup-name))
- (unless (and group
- (not (gnus-group-read-only-p group)))
- (setq group (read-string "Put in group: " nil (gnus-writable-groups))))
-
- (when (gnus-gethash group gnus-newsrc-hashtb)
- (error "No such group: %s" group))
- (save-excursion
- (save-restriction
- (widen)
- (message-narrow-to-headers)
- (let ((gnus-deletable-headers nil))
- (message-generate-headers
- (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers)))
- (goto-char (point-max))
- (if (string-match " " group)
- (insert "Gcc: \"" group "\"\n")
- (insert "Gcc: " group "\n"))
- (widen)))
- (gnus-inews-do-gcc)
- (when (and (get-buffer gnus-group-buffer)
- (gnus-buffer-exists-p (car-safe reply))
- (cdr reply))
- (set-buffer (car reply))
- (gnus-summary-mark-article-as-replied (cdr reply)))
- (when winconf
- (set-window-configuration winconf))))
-
-(defun gnus-article-mail (yank)
- "Send a reply to the address near point.
-If YANK is non-nil, include the original article."
- (interactive "P")
- (let ((address
- (buffer-substring
- (save-excursion (re-search-backward "[ \t\n]" nil t) (1+ (point)))
- (save-excursion (re-search-forward "[ \t\n]" nil t) (1- (point))))))
- (when address
- (gnus-msg-mail address)
- (when yank
- (gnus-inews-yank-articles (list (cdr gnus-article-current)))))))
-
-(defvar nntp-server-type)
-(defun gnus-bug ()
- "Send a bug report to the Gnus maintainers."
- (interactive)
- (unless (gnus-alive-p)
- (error "Gnus has been shut down"))
- (gnus-setup-message (if (message-mail-user-agent) 'message 'bug)
- (unless (message-mail-user-agent)
- (delete-other-windows)
- (when gnus-bug-create-help-buffer
- (switch-to-buffer "*Gnus Help Bug*")
- (erase-buffer)
- (insert gnus-bug-message)
- (goto-char (point-min)))
- (message-pop-to-buffer "*Gnus Bug*"))
- (let ((message-this-is-mail t))
- (message-setup `((To . ,gnus-maintainer) (Subject . ""))))
- (when gnus-bug-create-help-buffer
- (push `(gnus-bug-kill-buffer) message-send-actions))
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (insert (gnus-version) "\n"
- (emacs-version) "\n")
- (when (and (boundp 'nntp-server-type)
- (stringp nntp-server-type))
- (insert nntp-server-type))
- (insert "\n\n\n\n\n")
- (let (text)
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus environment info*"))
- (erase-buffer)
- (gnus-debug)
- (setq text (buffer-string)))
- (insert "<#part type=application/emacs-lisp disposition=inline description=\"User settings\">\n" text "\n<#/part>"))
- (goto-char (point-min))
- (search-forward "Subject: " nil t)
- (message "")))
-
-(defun gnus-bug-kill-buffer ()
- (when (get-buffer "*Gnus Help Bug*")
- (kill-buffer "*Gnus Help Bug*")))
-
-(defun gnus-summary-yank-message (buffer n)
- "Yank the current article into a composed message."
- (interactive
- (list (completing-read "Buffer: " (mapcar 'list (message-buffers)) nil t)
- current-prefix-arg))
- (gnus-summary-iterate n
- (let ((gnus-inhibit-treatment t))
- (gnus-summary-select-article))
- (save-excursion
- (set-buffer buffer)
- (message-yank-buffer gnus-article-buffer))))
-
-(defun gnus-debug ()
- "Attempts to go through the Gnus source file and report what variables have been changed.
-The source file has to be in the Emacs load path."
- (interactive)
- (let ((files gnus-debug-files)
- (point (point))
- file expr olist sym)
- (gnus-message 4 "Please wait while we snoop your variables...")
- (sit-for 0)
- ;; Go through all the files looking for non-default values for variables.
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus bug info*"))
- (while files
- (erase-buffer)
- (when (and (setq file (locate-library (pop files)))
- (file-exists-p file))
- (insert-file-contents file)
- (goto-char (point-min))
- (if (not (re-search-forward "^;;* *Internal variables" nil t))
- (gnus-message 4 "Malformed sources in file %s" file)
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (setq expr (ignore-errors (read (current-buffer))))
- (ignore-errors
- (and (or (eq (car expr) 'defvar)
- (eq (car expr) 'defcustom))
- (stringp (nth 3 expr))
- (not (memq (nth 1 expr) gnus-debug-exclude-variables))
- (or (not (boundp (nth 1 expr)))
- (not (equal (eval (nth 2 expr))
- (symbol-value (nth 1 expr)))))
- (push (nth 1 expr) olist)))))))
- (kill-buffer (current-buffer)))
- (when (setq olist (nreverse olist))
- (insert "------------------ Environment follows ------------------\n\n"))
- (while olist
- (if (boundp (car olist))
- (ignore-errors
- (gnus-pp
- `(setq ,(car olist)
- ,(if (or (consp (setq sym (symbol-value (car olist))))
- (and (symbolp sym)
- (not (or (eq sym nil)
- (eq sym t)))))
- (list 'quote (symbol-value (car olist)))
- (symbol-value (car olist))))))
- (insert ";; (makeunbound '" (symbol-name (car olist)) ")\n"))
- (setq olist (cdr olist)))
- (insert "\n\n")
- ;; Remove any control chars - they seem to cause trouble for some
- ;; mailers. (Byte-compiled output from the stuff above.)
- (goto-char point)
- (while (re-search-forward (mm-string-as-multibyte
- "[\000-\010\013-\037\200-\237]") nil t)
- (replace-match (format "\\%03o" (string-to-char (match-string 0)))
- t t))))
-
-;;; Treatment of rejected articles.
-;;; Bounced mail.
-
-(defun gnus-summary-resend-bounced-mail (&optional fetch)
- "Re-mail the current message.
-This only makes sense if the current message is a bounce message that
-contains some mail you have written which has been bounced back to
-you.
-If FETCH, try to fetch the article that this is a reply to, if indeed
-this is a reply."
- (interactive "P")
- (gnus-summary-select-article t)
- (let (summary-buffer parent)
- (if fetch
- (progn
- (setq summary-buffer (current-buffer))
- (set-buffer gnus-original-article-buffer)
- (article-goto-body)
- (when (re-search-forward "^References:\n?" nil t)
- (while (memq (char-after) '(?\t ? ))
- (forward-line 1))
- (skip-chars-backward "\t\n ")
- (setq parent
- (gnus-parent-id (buffer-substring (match-end 0) (point))))))
- (set-buffer gnus-original-article-buffer))
- (gnus-setup-message 'compose-bounce
- (message-bounce)
- ;; Add Gcc header.
- (gnus-inews-insert-archive-gcc)
- (gnus-inews-insert-gcc)
- ;; If there are references, we fetch the article we answered to.
- (when parent
- (with-current-buffer summary-buffer
- (gnus-summary-refer-article parent)
- (gnus-summary-show-all-headers))))))
-
-;;; Gcc handling.
-
-(defun gnus-inews-group-method (group)
- (cond
- ;; If the group doesn't exist, we assume
- ;; it's an archive group...
- ((and (null (gnus-get-info group))
- (eq (car (gnus-server-to-method gnus-message-archive-method))
- (car (gnus-server-to-method (gnus-group-method group)))))
- gnus-message-archive-method)
- ;; Use the method.
- ((gnus-info-method (gnus-get-info group))
- (gnus-info-method (gnus-get-info group)))
- ;; Find the method.
- (t (gnus-server-to-method (gnus-group-method group)))))
-
-;; Do Gcc handling, which copied the message over to some group.
-(defun gnus-inews-do-gcc (&optional gcc)
- (interactive)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((gcc (or gcc (mail-fetch-field "gcc" nil t)))
- (cur (current-buffer))
- groups group method group-art
- mml-externalize-attachments)
- (when gcc
- (message-remove-header "gcc")
- (widen)
- (setq groups (message-unquote-tokens
- (message-tokenize-header gcc " ,")))
- ;; Copy the article over to some group(s).
- (while (setq group (pop groups))
- (unless (gnus-check-server
- (setq method (gnus-inews-group-method group)))
- (error "Can't open server %s" (if (stringp method) method
- (car method))))
- (unless (gnus-request-group group nil method)
- (gnus-request-create-group group method))
- (setq mml-externalize-attachments
- (if (stringp gnus-gcc-externalize-attachments)
- (string-match gnus-gcc-externalize-attachments group)
- gnus-gcc-externalize-attachments))
- (save-excursion
- (nnheader-set-temp-buffer " *acc*")
- (insert-buffer-substring cur)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (let* ((mail-parse-charset message-default-charset)
- (newsgroups-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- (followup-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Followup-To")))
- ;; BUG: We really need to get the charset for
- ;; each name in the Newsgroups and Followup-To
- ;; lines to allow crossposting between group
- ;; namess with incompatible character sets.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
- (group-field-charset
- (gnus-group-name-charset
- method (or newsgroups-field "")))
- (followup-field-charset
- (gnus-group-name-charset
- method (or followup-field "")))
- (rfc2047-header-encoding-alist
- (append
- (when group-field-charset
- (list (cons "Newsgroups" group-field-charset)))
- (when followup-field-charset
- (list (cons "Followup-To" followup-field-charset)))
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- (unless (setq group-art
- (gnus-request-accept-article group method t t))
- (gnus-message 1 "Couldn't store article in group %s: %s"
- group (gnus-status-message method))
- (sit-for 2))
- (when (and group-art
- ;; FIXME: Should gcc-mark-as-read work when
- ;; Gnus is not running?
- (gnus-alive-p)
- (or gnus-gcc-mark-as-read
- (and
- (boundp 'gnus-inews-mark-gcc-as-read)
- (symbol-value 'gnus-inews-mark-gcc-as-read))))
- (gnus-group-mark-article-read group (cdr group-art)))
- (kill-buffer (current-buffer)))))))))
-
-(defun gnus-inews-insert-gcc ()
- "Insert Gcc headers based on `gnus-outgoing-message-group'."
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let* ((group gnus-outgoing-message-group)
- (gcc (cond
- ((functionp group)
- (funcall group))
- ((or (stringp group) (listp group))
- group))))
- (when gcc
- (insert "Gcc: "
- (if (stringp gcc)
- (if (string-match " " gcc)
- (concat "\"" gcc "\"")
- gcc)
- (mapconcat (lambda (group)
- (if (string-match " " group)
- (concat "\"" group "\"")
- group))
- gcc " "))
- "\n"))))))
-
-(defun gnus-inews-insert-archive-gcc (&optional group)
- "Insert the Gcc to say where the article is to be archived."
- (let* ((var gnus-message-archive-group)
- (group (or group gnus-newsgroup-name ""))
- (gcc-self-val
- (and gnus-newsgroup-name
- (not (equal gnus-newsgroup-name ""))
- (gnus-group-find-parameter
- gnus-newsgroup-name 'gcc-self)))
- result
- (groups
- (cond
- ((null gnus-message-archive-method)
- ;; Ignore.
- nil)
- ((stringp var)
- ;; Just a single group.
- (list var))
- ((null var)
- ;; We don't want this.
- nil)
- ((and (listp var) (stringp (car var)))
- ;; A list of groups.
- var)
- ((functionp var)
- ;; A function.
- (funcall var group))
- (t
- ;; An alist of regexps/functions/forms.
- (while (and var
- (not
- (setq result
- (cond
- ((stringp (caar var))
- ;; Regexp.
- (when (string-match (caar var) group)
- (cdar var)))
- ((functionp (car var))
- ;; Function.
- (funcall (car var) group))
- (t
- (eval (car var)))))))
- (setq var (cdr var)))
- result)))
- name)
- (when (or groups gcc-self-val)
- (when (stringp groups)
- (setq groups (list groups)))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (goto-char (point-max))
- (insert "Gcc: ")
- (if gcc-self-val
- ;; Use the `gcc-self' param value instead.
- (progn
- (insert
- (if (stringp gcc-self-val)
- (if (string-match " " gcc-self-val)
- (concat "\"" gcc-self-val "\"")
- gcc-self-val)
- ;; In nndoc groups, we use the parent group name
- ;; instead of the current group.
- (let ((group (or (gnus-group-find-parameter
- gnus-newsgroup-name 'parent-group)
- group)))
- (if (string-match " " group)
- (concat "\"" group "\"")
- group))))
- (if (not (eq gcc-self-val 'none))
- (insert "\n")
- (gnus-delete-line)))
- ;; Use the list of groups.
- (while (setq name (pop groups))
- (let ((str (if (string-match ":" name)
- name
- (gnus-group-prefixed-name
- name gnus-message-archive-method))))
- (insert (if (string-match " " str)
- (concat "\"" str "\"")
- str)))
- (when groups
- (insert " ")))
- (insert "\n")))))))
-
-(defun gnus-mailing-list-followup-to ()
- "Look at the headers in the current buffer and return a Mail-Followup-To address."
- (let ((x-been-there (gnus-fetch-original-field "x-beenthere"))
- (list-post (gnus-fetch-original-field "list-post")))
- (when (and list-post
- (string-match "mailto:\\([^>]+\\)" list-post))
- (setq list-post (match-string 1 list-post)))
- (or list-post
- x-been-there)))
-
-;;; Posting styles.
-
-(defun gnus-configure-posting-styles (&optional group-name)
- "Configure posting styles according to `gnus-posting-styles'."
- (unless gnus-inhibit-posting-styles
- (let ((group (or group-name gnus-newsgroup-name ""))
- (styles gnus-posting-styles)
- style match attribute value v results
- filep name address element)
- ;; If the group has a posting-style parameter, add it at the end with a
- ;; regexp matching everything, to be sure it takes precedence over all
- ;; the others.
- (when gnus-newsgroup-name
- (let ((tmp-style (gnus-group-find-parameter group 'posting-style t)))
- (when tmp-style
- (setq styles (append styles (list (cons ".*" tmp-style)))))))
- ;; Go through all styles and look for matches.
- (dolist (style styles)
- (setq match (pop style))
- (goto-char (point-min))
- (when (cond
- ((stringp match)
- ;; Regexp string match on the group name.
- (string-match match group))
- ((eq match 'header)
- ;; Obsolete format of header match.
- (and (gnus-buffer-live-p gnus-article-copy)
- (with-current-buffer gnus-article-copy
- (save-restriction
- (nnheader-narrow-to-headers)
- (let ((header (message-fetch-field (pop style))))
- (and header
- (string-match (pop style) header)))))))
- ((or (symbolp match)
- (functionp match))
- (cond
- ((functionp match)
- ;; Function to be called.
- (funcall match))
- ((boundp match)
- ;; Variable to be checked.
- (symbol-value match))))
- ((listp match)
- (cond
- ((eq (car match) 'header)
- ;; New format of header match.
- (and (gnus-buffer-live-p gnus-article-copy)
- (with-current-buffer gnus-article-copy
- (save-restriction
- (nnheader-narrow-to-headers)
- (let ((header (message-fetch-field (nth 1 match))))
- (and header
- (string-match (nth 2 match) header)))))))
- (t
- ;; This is a form to be evaled.
- (eval match)))))
- ;; We have a match, so we set the variables.
- (dolist (attribute style)
- (setq element (pop attribute)
- filep nil)
- (setq value
- (cond
- ((eq (car attribute) :file)
- (setq filep t)
- (cadr attribute))
- ((eq (car attribute) :value)
- (cadr attribute))
- (t
- (car attribute))))
- ;; We get the value.
- (setq v
- (cond
- ((stringp value)
- value)
- ((or (symbolp value)
- (functionp value))
- (cond ((functionp value)
- (funcall value))
- ((boundp value)
- (symbol-value value))))
- ((listp value)
- (eval value))))
- ;; Translate obsolescent value.
- (cond
- ((eq element 'signature-file)
- (setq element 'signature
- filep t))
- ((eq element 'x-face-file)
- (setq element 'x-face
- filep t)))
- ;; Get the contents of file elems.
- (when (and filep v)
- (setq v (with-temp-buffer
- (insert-file-contents v)
- (buffer-substring
- (point-min)
- (progn
- (goto-char (point-max))
- (if (zerop (skip-chars-backward "\n"))
- (point)
- (1+ (point))))))))
- (setq results (delq (assoc element results) results))
- (push (cons element v) results))))
- ;; Now we have all the styles, so we insert them.
- (setq name (assq 'name results)
- address (assq 'address results))
- (setq results (delq name (delq address results)))
- (gnus-make-local-hook 'message-setup-hook)
- (setq results (sort results (lambda (x y)
- (string-lessp (car x) (car y)))))
- (dolist (result results)
- (add-hook 'message-setup-hook
- (cond
- ((eq 'eval (car result))
- 'ignore)
- ((eq 'body (car result))
- `(lambda ()
- (save-excursion
- (message-goto-body)
- (insert ,(cdr result)))))
- ((eq 'signature (car result))
- (set (make-local-variable 'message-signature) nil)
- (set (make-local-variable 'message-signature-file) nil)
- (if (not (cdr result))
- 'ignore
- `(lambda ()
- (save-excursion
- (let ((message-signature ,(cdr result)))
- (when message-signature
- (message-insert-signature)))))))
- (t
- (let ((header
- (if (symbolp (car result))
- (capitalize (symbol-name (car result)))
- (car result))))
- `(lambda ()
- (save-excursion
- (message-remove-header ,header)
- (let ((value ,(cdr result)))
- (when value
- (message-goto-eoh)
- (insert ,header ": " value)
- (unless (bolp)
- (insert "\n")))))))))
- nil 'local))
- (when (or name address)
- (add-hook 'message-setup-hook
- `(lambda ()
- (set (make-local-variable 'user-mail-address)
- ,(or (cdr address) user-mail-address))
- (let ((user-full-name ,(or (cdr name) (user-full-name)))
- (user-mail-address
- ,(or (cdr address) user-mail-address)))
- (save-excursion
- (message-remove-header "From")
- (message-goto-eoh)
- (insert "From: " (message-make-from) "\n"))))
- nil 'local)))))
-
-;;; Allow redefinition of functions.
-
-(gnus-ems-redefine)
-
-(provide 'gnus-msg)
-
-;;; arch-tag: 9f22b2f5-1c0a-49de-916e-4c88e984852b
-;;; gnus-msg.el ends here
+++ /dev/null
-;;; gnus-nocem.el --- NoCeM pseudo-cancellation treatment
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'nnmail)
-(require 'gnus-art)
-(require 'gnus-sum)
-(require 'gnus-range)
-
-(defgroup gnus-nocem nil
- "NoCeM pseudo-cancellation treatment."
- :group 'gnus-score)
-
-(defcustom gnus-nocem-groups
- '("news.lists.filters" "news.admin.net-abuse.bulletins"
- "alt.nocem.misc" "news.admin.net-abuse.announce")
- "*List of groups that will be searched for NoCeM messages."
- :group 'gnus-nocem
- :type '(repeat (string :tag "Group")))
-
-(defcustom gnus-nocem-issuers
- '("AutoMoose-1" ; CancelMoose[tm]
- "clewis@ferret.ocunix" ; Chris Lewis
- "cosmo.roadkill"
- "SpamHippo"
- "hweede@snafu.de")
- "*List of NoCeM issuers to pay attention to.
-
-This can also be a list of `(ISSUER CONDITION ...)' elements.
-
-See <URL:http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html> for an
-issuer registry."
- :group 'gnus-nocem
- :link '(url-link "http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html")
- :type '(repeat (choice string sexp)))
-
-(defcustom gnus-nocem-directory
- (nnheader-concat gnus-article-save-directory "NoCeM/")
- "*Directory where NoCeM files will be stored."
- :group 'gnus-nocem
- :type 'directory)
-
-(defcustom gnus-nocem-expiry-wait 15
- "*Number of days to keep NoCeM headers in the cache."
- :group 'gnus-nocem
- :type 'integer)
-
-(defcustom gnus-nocem-verifyer 'pgg-verify
- "*Function called to verify that the NoCeM message is valid.
-One likely value is `pgg-verify'. If the function in this variable
-isn't bound, the message will be used unconditionally."
- :group 'gnus-nocem
- :type '(radio (function-item pgg-verify)
- (function-item mc-verify)
- (function :tag "other")))
-
-(defcustom gnus-nocem-liberal-fetch nil
- "*If t try to fetch all messages which have @@NCM in the subject.
-Otherwise don't fetch messages which have references or whose message-id
-matches a previously scanned and verified nocem message."
- :group 'gnus-nocem
- :type 'boolean)
-
-(defcustom gnus-nocem-check-article-limit 500
- "*If non-nil, the maximum number of articles to check in any NoCeM group."
- :group 'gnus-nocem
- :version "21.1"
- :type '(choice (const :tag "unlimited" nil)
- (integer 1000)))
-
-(defcustom gnus-nocem-check-from t
- "Non-nil means check for valid issuers in message bodies.
-Otherwise don't bother fetching articles unless their author matches a
-valid issuer, which is much faster if you are selective about the issuers."
- :group 'gnus-nocem
- :version "21.1"
- :type 'boolean)
-
-;;; Internal variables
-
-(defvar gnus-nocem-active nil)
-(defvar gnus-nocem-alist nil)
-(defvar gnus-nocem-touched-alist nil)
-(defvar gnus-nocem-hashtb nil)
-(defvar gnus-nocem-seen-message-ids nil)
-
-;;; Functions
-
-(defun gnus-nocem-active-file ()
- (concat (file-name-as-directory gnus-nocem-directory) "active"))
-
-(defun gnus-nocem-cache-file ()
- (concat (file-name-as-directory gnus-nocem-directory) "cache"))
-
-;;
-;; faster lookups for group names:
-;;
-
-(defvar gnus-nocem-real-group-hashtb nil
- "Real-name mappings of subscribed groups.")
-
-(defun gnus-fill-real-hashtb ()
- "Fill up a hash table with the real-name mappings from the user's active file."
- (setq gnus-nocem-real-group-hashtb (gnus-make-hashtable
- (length gnus-newsrc-alist)))
- (mapcar (lambda (group)
- (setq group (gnus-group-real-name (car group)))
- (gnus-sethash group t gnus-nocem-real-group-hashtb))
- gnus-newsrc-alist))
-
-;;;###autoload
-(defun gnus-nocem-scan-groups ()
- "Scan all NoCeM groups for new NoCeM messages."
- (interactive)
- (let ((groups gnus-nocem-groups)
- (gnus-inhibit-demon t)
- group active gactive articles check-headers)
- (gnus-make-directory gnus-nocem-directory)
- ;; Load any previous NoCeM headers.
- (gnus-nocem-load-cache)
- ;; Get the group name mappings:
- (gnus-fill-real-hashtb)
- ;; Read the active file if it hasn't been read yet.
- (and (file-exists-p (gnus-nocem-active-file))
- (not gnus-nocem-active)
- (ignore-errors
- (load (gnus-nocem-active-file) t t t)))
- ;; Go through all groups and see whether new articles have
- ;; arrived.
- (while (setq group (pop groups))
- (if (not (setq gactive (gnus-activate-group group)))
- () ; This group doesn't exist.
- (setq active (nth 1 (assoc group gnus-nocem-active)))
- (when (and (not (< (cdr gactive) (car gactive))) ; Empty group.
- (or (not active)
- (< (cdr active) (cdr gactive))))
- ;; Ok, there are new articles in this group, se we fetch the
- ;; headers.
- (save-excursion
- (let ((dependencies (make-vector 10 nil))
- headers header)
- (with-temp-buffer
- (setq headers
- (if (eq 'nov
- (gnus-retrieve-headers
- (setq articles
- (gnus-uncompress-range
- (cons
- (if active (1+ (cdr active))
- (car gactive))
- (cdr gactive))))
- group))
- (gnus-get-newsgroup-headers-xover
- articles nil dependencies)
- (gnus-get-newsgroup-headers dependencies)))
- (while (setq header (pop headers))
- ;; We take a closer look on all articles that have
- ;; "@@NCM" in the subject. Unless we already read
- ;; this cross posted message. Nocem messages
- ;; are not allowed to have references, so we can
- ;; ignore scanning followups.
- (and (string-match "@@NCM" (mail-header-subject header))
- (and gnus-nocem-check-from
- (let ((case-fold-search t))
- (catch 'ok
- (mapcar
- (lambda (author)
- (if (consp author)
- (setq author (car author)))
- (if (string-match
- author (mail-header-from header))
- (throw 'ok t)))
- gnus-nocem-issuers)
- nil)))
- (or gnus-nocem-liberal-fetch
- (and (or (string= "" (mail-header-references
- header))
- (null (mail-header-references header)))
- (not (member (mail-header-message-id header)
- gnus-nocem-seen-message-ids))))
- (push header check-headers)))
- (setq check-headers (last (nreverse check-headers)
- gnus-nocem-check-article-limit))
- (let ((i 0)
- (len (length check-headers)))
- (dolist (h check-headers)
- (gnus-message
- 7 "Checking article %d in %s for NoCeM (%d of %d)..."
- (mail-header-number h) group (incf i) len)
- (gnus-nocem-check-article group h)))))))
- (setq gnus-nocem-active
- (cons (list group gactive)
- (delq (assoc group gnus-nocem-active)
- gnus-nocem-active)))))
- ;; Save the results, if any.
- (gnus-nocem-save-cache)
- (gnus-nocem-save-active)))
-
-(defun gnus-nocem-check-article (group header)
- "Check whether the current article is an NCM article and that we want it."
- ;; Get the article.
- (let ((date (mail-header-date header))
- (gnus-newsgroup-name group)
- issuer b e type)
- (when (or (not date)
- (time-less-p
- (time-since (date-to-time date))
- (days-to-time gnus-nocem-expiry-wait)))
- (gnus-request-article-this-buffer (mail-header-number header) group)
- (goto-char (point-min))
- (when (re-search-forward
- "-----BEGIN PGP\\( SIGNED\\)? MESSAGE-----"
- nil t)
- (delete-region (point-min) (match-beginning 0)))
- (when (re-search-forward
- "-----END PGP \\(MESSAGE\\|SIGNATURE\\)-----\n?"
- nil t)
- (delete-region (match-end 0) (point-max)))
- (goto-char (point-min))
- ;; The article has to have proper NoCeM headers.
- (when (and (setq b (search-forward "\n@@BEGIN NCM HEADERS\n" nil t))
- (setq e (search-forward "\n@@BEGIN NCM BODY\n" nil t)))
- ;; We get the name of the issuer.
- (narrow-to-region b e)
- (setq issuer (mail-fetch-field "issuer")
- type (mail-fetch-field "type"))
- (widen)
- (if (not (gnus-nocem-message-wanted-p issuer type))
- (message "invalid NoCeM issuer: %s" issuer)
- (and (gnus-nocem-verify-issuer issuer) ; She is who she says she is.
- (gnus-nocem-enter-article) ; We gobble the message.
- (push (mail-header-message-id header) ; But don't come back for
- gnus-nocem-seen-message-ids))))))) ; second helpings.
-
-(defun gnus-nocem-message-wanted-p (issuer type)
- (let ((issuers gnus-nocem-issuers)
- wanted conditions condition)
- (cond
- ;; Do the quick check first.
- ((member issuer issuers)
- t)
- ((setq conditions (cdr (assoc issuer issuers)))
- ;; Check whether we want this type.
- (while (setq condition (pop conditions))
- (cond
- ((stringp condition)
- (when (string-match condition type)
- (setq wanted t)))
- ((and (consp condition)
- (eq (car condition) 'not)
- (stringp (cadr condition)))
- (when (string-match (cadr condition) type)
- (setq wanted nil)))
- (t
- (error "Invalid NoCeM condition: %S" condition))))
- wanted))))
-
-(defun gnus-nocem-verify-issuer (person)
- "Verify using PGP that the canceler is who she says she is."
- (if (functionp gnus-nocem-verifyer)
- (ignore-errors
- (funcall gnus-nocem-verifyer))
- ;; If we don't have Mailcrypt, then we use the message anyway.
- t))
-
-(defun gnus-nocem-enter-article ()
- "Enter the current article into the NoCeM cache."
- (goto-char (point-min))
- (let ((b (search-forward "\n@@BEGIN NCM BODY\n" nil t))
- (e (search-forward "\n@@END NCM BODY\n" nil t))
- (buf (current-buffer))
- ncm id group)
- (when (and b e)
- (narrow-to-region b (1+ (match-beginning 0)))
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (cond
- ((not (ignore-errors
- (setq group (let ((obarray gnus-nocem-real-group-hashtb))
- (read buf)))))
- ;; An error.
- )
- ((not (symbolp group))
- ;; Ignore invalid entries.
- )
- ((not (boundp group))
- ;; Make sure all entries in the hashtb are bound.
- (set group nil))
- (t
- (when (gnus-gethash (gnus-group-real-name (symbol-name group))
- gnus-nocem-real-group-hashtb)
- ;; Valid group.
- (beginning-of-line)
- (while (eq (char-after) ?\t)
- (forward-line -1))
- (setq id (buffer-substring (point) (1- (search-forward "\t"))))
- (unless (if gnus-nocem-hashtb
- (gnus-gethash id gnus-nocem-hashtb)
- (setq gnus-nocem-hashtb (gnus-make-hashtable))
- nil)
- ;; only store if not already present
- (gnus-sethash id t gnus-nocem-hashtb)
- (push id ncm))
- (forward-line 1)
- (while (eq (char-after) ?\t)
- (forward-line 1))))))
- (when ncm
- (setq gnus-nocem-touched-alist t)
- (push (cons (let ((time (current-time))) (setcdr (cdr time) nil) time)
- ncm)
- gnus-nocem-alist))
- t)))
-
-;;;###autoload
-(defun gnus-nocem-load-cache ()
- "Load the NoCeM cache."
- (interactive)
- (unless gnus-nocem-alist
- ;; The buffer doesn't exist, so we create it and load the NoCeM
- ;; cache.
- (when (file-exists-p (gnus-nocem-cache-file))
- (load (gnus-nocem-cache-file) t t t)
- (gnus-nocem-alist-to-hashtb))))
-
-(defun gnus-nocem-save-cache ()
- "Save the NoCeM cache."
- (when (and gnus-nocem-alist
- gnus-nocem-touched-alist)
- (with-temp-file (gnus-nocem-cache-file)
- (gnus-prin1 `(setq gnus-nocem-alist ',gnus-nocem-alist)))
- (setq gnus-nocem-touched-alist nil)))
-
-(defun gnus-nocem-save-active ()
- "Save the NoCeM active file."
- (with-temp-file (gnus-nocem-active-file)
- (gnus-prin1 `(setq gnus-nocem-active ',gnus-nocem-active))))
-
-(defun gnus-nocem-alist-to-hashtb ()
- "Create a hashtable from the Message-IDs we have."
- (let* ((alist gnus-nocem-alist)
- (pprev (cons nil alist))
- (prev pprev)
- (expiry (days-to-time gnus-nocem-expiry-wait))
- entry)
- (setq gnus-nocem-hashtb (gnus-make-hashtable (* (length alist) 51)))
- (while (setq entry (car alist))
- (if (not (time-less-p (time-since (car entry)) expiry))
- ;; This entry has expired, so we remove it.
- (setcdr prev (cdr alist))
- (setq prev alist)
- ;; This is ok, so we enter it into the hashtable.
- (setq entry (cdr entry))
- (while entry
- (gnus-sethash (car entry) t gnus-nocem-hashtb)
- (setq entry (cdr entry))))
- (setq alist (cdr alist)))))
-
-(gnus-add-shutdown 'gnus-nocem-close 'gnus)
-
-(defun gnus-nocem-close ()
- "Clear internal NoCeM variables."
- (setq gnus-nocem-alist nil
- gnus-nocem-hashtb nil
- gnus-nocem-active nil
- gnus-nocem-touched-alist nil
- gnus-nocem-seen-message-ids nil
- gnus-nocem-real-group-hashtb nil))
-
-(defun gnus-nocem-unwanted-article-p (id)
- "Say whether article ID in the current group is wanted."
- (and gnus-nocem-hashtb
- (gnus-gethash id gnus-nocem-hashtb)))
-
-(provide 'gnus-nocem)
-
-;;; arch-tag: 0e0c74ea-2f8e-4f3e-8fff-09f767c1adef
-;;; gnus-nocem.el ends here
+++ /dev/null
-;;; gnus-picon.el --- displaying pretty icons in Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news xpm annotation glyph faces
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; There are three picon types relevant to Gnus:
-;;
-;; Persons: person@subdomain.dom
-;; users/dom/subdomain/person/face.gif
-;; usenix/dom/subdomain/person/face.gif
-;; misc/MISC/person/face.gif
-;; Domains: subdomain.dom
-;; domain/dom/subdomain/unknown/face.gif
-;; Groups: comp.lang.lisp
-;; news/comp/lang/lisp/unknown/face.gif
-;;
-;; Original implementation by Wes Hardaker <hardaker@ece.ucdavis.edu>.
-;;
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-
-;;; User variables:
-
-(defcustom gnus-picon-news-directories '("news")
- "*List of directories to search for newsgroups faces."
- :type '(repeat string)
- :group 'gnus-picon)
-
-(defcustom gnus-picon-user-directories '("users" "usenix" "local" "misc")
- "*List of directories to search for user faces."
- :type '(repeat string)
- :group 'gnus-picon)
-
-(defcustom gnus-picon-domain-directories '("domains")
- "*List of directories to search for domain faces.
-Some people may want to add \"unknown\" to this list."
- :type '(repeat string)
- :group 'gnus-picon)
-
-(defcustom gnus-picon-file-types
- (let ((types (list "xbm")))
- (when (gnus-image-type-available-p 'gif)
- (push "gif" types))
- (when (gnus-image-type-available-p 'xpm)
- (push "xpm" types))
- types)
- "*List of suffixes on picon file names to try."
- :type '(repeat string)
- :group 'gnus-picon)
-
-(defface gnus-picon-xbm '((t (:foreground "black" :background "white")))
- "Face to show xbm picon in."
- :group 'gnus-picon)
-;; backward-compatibility alias
-(put 'gnus-picon-xbm-face 'face-alias 'gnus-picon-xbm)
-
-(defface gnus-picon '((t (:foreground "black" :background "white")))
- "Face to show picon in."
- :group 'gnus-picon)
-;; backward-compatibility alias
-(put 'gnus-picon-face 'face-alias 'gnus-picon)
-
-;;; Internal variables:
-
-(defvar gnus-picon-setup-p nil)
-(defvar gnus-picon-glyph-alist nil
- "Picon glyphs cache.
-List of pairs (KEY . GLYPH) where KEY is either a filename or an URL.")
-(defvar gnus-picon-cache nil)
-
-;;; Functions:
-
-(defsubst gnus-picon-split-address (address)
- (setq address (split-string address "@"))
- (if (stringp (cadr address))
- (cons (car address) (split-string (cadr address) "\\."))
- (if (stringp (car address))
- (split-string (car address) "\\."))))
-
-(defun gnus-picon-find-face (address directories &optional exact)
- (let* ((address (gnus-picon-split-address address))
- (user (pop address))
- (faddress address)
- database directory result instance base)
- (catch 'found
- (dolist (database gnus-picon-databases)
- (dolist (directory directories)
- (setq address faddress
- base (expand-file-name directory database))
- (while address
- (when (setq result (gnus-picon-find-image
- (concat base "/" (mapconcat 'downcase
- (reverse address)
- "/")
- "/" (downcase user) "/")))
- (throw 'found result))
- (if exact
- (setq address nil)
- (pop address)))
- ;; Kludge to search MISC as well. But not in "news".
- (unless (string= directory "news")
- (when (setq result (gnus-picon-find-image
- (concat base "/MISC/" user "/")))
- (throw 'found result))))))))
-
-(defun gnus-picon-find-image (directory)
- (let ((types gnus-picon-file-types)
- found type file)
- (while (and (not found)
- (setq type (pop types)))
- (setq found (file-exists-p (setq file (concat directory "face." type)))))
- (if found
- file
- nil)))
-
-(defun gnus-picon-insert-glyph (glyph category)
- "Insert GLYPH into the buffer.
-GLYPH can be either a glyph or a string."
- (if (stringp glyph)
- (insert glyph)
- (gnus-add-wash-type category)
- (gnus-add-image category (car glyph))
- (gnus-put-image (car glyph) (cdr glyph) category)))
-
-(defun gnus-picon-create-glyph (file)
- (or (cdr (assoc file gnus-picon-glyph-alist))
- (cdar (push (cons file (gnus-create-image file))
- gnus-picon-glyph-alist))))
-
-;;; Functions that does picon transformations:
-
-(defun gnus-picon-transform-address (header category)
- (gnus-with-article-headers
- (let ((addresses
- (mail-header-parse-addresses
- ;; mail-header-parse-addresses does not work (reliably) on
- ;; decoded headers.
- (or
- (ignore-errors
- (mail-encode-encoded-word-string
- (or (mail-fetch-field header) "")))
- (mail-fetch-field header))))
- spec file point cache)
- (dolist (address addresses)
- (setq address (car address))
- (when (and (stringp address)
- (setq spec (gnus-picon-split-address address)))
- (if (setq cache (cdr (assoc address gnus-picon-cache)))
- (setq spec cache)
- (when (setq file (or (gnus-picon-find-face
- address gnus-picon-user-directories)
- (gnus-picon-find-face
- (concat "unknown@"
- (mapconcat
- 'identity (cdr spec) "."))
- gnus-picon-user-directories)))
- (setcar spec (cons (gnus-picon-create-glyph file)
- (car spec))))
-
- (dotimes (i (1- (length spec)))
- (when (setq file (gnus-picon-find-face
- (concat "unknown@"
- (mapconcat
- 'identity (nthcdr (1+ i) spec) "."))
- gnus-picon-domain-directories t))
- (setcar (nthcdr (1+ i) spec)
- (cons (gnus-picon-create-glyph file)
- (nth (1+ i) spec)))))
- (setq spec (nreverse spec))
- (push (cons address spec) gnus-picon-cache))
-
- (gnus-article-goto-header header)
- (mail-header-narrow-to-field)
- (when (search-forward address nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (setq point (point))
- (while spec
- (goto-char point)
- (if (> (length spec) 2)
- (insert ".")
- (if (= (length spec) 2)
- (insert "@")))
- (gnus-picon-insert-glyph (pop spec) category))))))))
-
-(defun gnus-picon-transform-newsgroups (header)
- (interactive)
- (gnus-with-article-headers
- (gnus-article-goto-header header)
- (mail-header-narrow-to-field)
- (let ((groups (message-tokenize-header (mail-fetch-field header)))
- spec file point)
- (dolist (group groups)
- (unless (setq spec (cdr (assoc group gnus-picon-cache)))
- (setq spec (nreverse (split-string group "[.]")))
- (dotimes (i (length spec))
- (when (setq file (gnus-picon-find-face
- (concat "unknown@"
- (mapconcat
- 'identity (nthcdr i spec) "."))
- gnus-picon-news-directories t))
- (setcar (nthcdr i spec)
- (cons (gnus-picon-create-glyph file)
- (nth i spec)))))
- (push (cons group spec) gnus-picon-cache))
- (when (search-forward group nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (save-restriction
- (narrow-to-region (point) (point))
- (while spec
- (goto-char (point-min))
- (if (> (length spec) 1)
- (insert "."))
- (gnus-picon-insert-glyph (pop spec) 'newsgroups-picon))
- (goto-char (point-max))))))))
-
-;;; Commands:
-
-;; #### NOTE: the test for buffer-read-only is the same as in
-;; article-display-[x-]face. See the comment up there.
-
-;;;###autoload
-(defun gnus-treat-from-picon ()
- "Display picons in the From header.
-If picons are already displayed, remove them."
- (interactive)
- (let ((wash-picon-p buffer-read-only))
- (gnus-with-article-buffer
- (if (and wash-picon-p (memq 'from-picon gnus-article-wash-types))
- (gnus-delete-images 'from-picon)
- (gnus-picon-transform-address "from" 'from-picon)))
- ))
-
-;;;###autoload
-(defun gnus-treat-mail-picon ()
- "Display picons in the Cc and To headers.
-If picons are already displayed, remove them."
- (interactive)
- (let ((wash-picon-p buffer-read-only))
- (gnus-with-article-buffer
- (if (and wash-picon-p (memq 'mail-picon gnus-article-wash-types))
- (gnus-delete-images 'mail-picon)
- (gnus-picon-transform-address "cc" 'mail-picon)
- (gnus-picon-transform-address "to" 'mail-picon)))
- ))
-
-;;;###autoload
-(defun gnus-treat-newsgroups-picon ()
- "Display picons in the Newsgroups and Followup-To headers.
-If picons are already displayed, remove them."
- (interactive)
- (let ((wash-picon-p buffer-read-only))
- (gnus-with-article-buffer
- (if (and wash-picon-p (memq 'newsgroups-picon gnus-article-wash-types))
- (gnus-delete-images 'newsgroups-picon)
- (gnus-picon-transform-newsgroups "newsgroups")
- (gnus-picon-transform-newsgroups "followup-to")))
- ))
-
-(provide 'gnus-picon)
-
-;;; arch-tag: fe9aede0-1b1b-463a-b4ab-807f98bcb31f
-;;; gnus-picon.el ends here
+++ /dev/null
-;;; gnus-range.el --- range and sequence functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-;;; List and range functions
-
-(defsubst gnus-range-normalize (range)
- "Normalize RANGE.
-If RANGE is a single range, return (RANGE). Otherwise, return RANGE."
- (if (listp (cdr-safe range)) range (list range)))
-
-(defun gnus-last-element (list)
- "Return last element of LIST."
- (while (cdr list)
- (setq list (cdr list)))
- (car list))
-
-(defun gnus-copy-sequence (list)
- "Do a complete, total copy of a list."
- (let (out)
- (while (consp list)
- (if (consp (car list))
- (push (gnus-copy-sequence (pop list)) out)
- (push (pop list) out)))
- (if list
- (nconc (nreverse out) list)
- (nreverse out))))
-
-(defun gnus-set-difference (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2."
- (let ((list1 (copy-sequence list1)))
- (while list2
- (setq list1 (delq (car list2) list1))
- (setq list2 (cdr list2)))
- list1))
-
-(defun gnus-range-difference (range1 range2)
- "Return the range of elements in RANGE1 that do not appear in RANGE2.
-Both ranges must be in ascending order."
- (setq range1 (gnus-range-normalize range1))
- (setq range2 (gnus-range-normalize range2))
- (let* ((new-range (cons nil (copy-sequence range1)))
- (r new-range)
- (safe t))
- (while (cdr r)
- (let* ((r1 (cadr r))
- (r2 (car range2))
- (min1 (if (numberp r1) r1 (car r1)))
- (max1 (if (numberp r1) r1 (cdr r1)))
- (min2 (if (numberp r2) r2 (car r2)))
- (max2 (if (numberp r2) r2 (cdr r2))))
-
- (cond ((> min1 max1)
- ;; Invalid range: may result from overlap condition (below)
- ;; remove Invalid range
- (setcdr r (cddr r)))
- ((and (= min1 max1)
- (listp r1))
- ;; Inefficient representation: may result from overlap condition (below)
- (setcar (cdr r) min1))
- ((not min2)
- ;; All done with range2
- (setq r nil))
- ((< max1 min2)
- ;; No overlap: range1 preceeds range2
- (pop r))
- ((< max2 min1)
- ;; No overlap: range2 preceeds range1
- (pop range2))
- ((and (<= min2 min1) (<= max1 max2))
- ;; Complete overlap: range1 removed
- (setcdr r (cddr r)))
- (t
- (setcdr r (nconc (list (cons min1 (1- min2)) (cons (1+ max2) max1)) (cddr r)))))))
- (cdr new-range)))
-
-
-
-;;;###autoload
-(defun gnus-sorted-difference (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2.
-Both lists have to be sorted over <.
-The tail of LIST1 is not copied."
- (let (out)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq out (cons (car list1) out))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (nconc (nreverse out) list1)))
-
-;;;###autoload
-(defun gnus-sorted-ndifference (list1 list2)
- "Return a list of elements of LIST1 that do not appear in LIST2.
-Both lists have to be sorted over <.
-LIST1 is modified."
- (let* ((top (cons nil list1))
- (prev top))
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setcdr prev (cdr list1))
- (setq list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (cdr top)))
-
-;;;###autoload
-(defun gnus-sorted-complement (list1 list2)
- "Return a list of elements that are in LIST1 or LIST2 but not both.
-Both lists have to be sorted over <."
- (let (out)
- (if (or (null list1) (null list2))
- (or list1 list2)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq out (cons (car list1) out))
- (setq list1 (cdr list1)))
- (t
- (setq out (cons (car list2) out))
- (setq list2 (cdr list2)))))
- (nconc (nreverse out) (or list1 list2)))))
-
-;;;###autoload
-(defun gnus-intersection (list1 list2)
- (let ((result nil))
- (while list2
- (when (memq (car list2) list1)
- (setq result (cons (car list2) result)))
- (setq list2 (cdr list2)))
- result))
-
-;;;###autoload
-(defun gnus-sorted-intersection (list1 list2)
- "Return intersection of LIST1 and LIST2.
-LIST1 and LIST2 have to be sorted over <."
- (let (out)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq out (cons (car list1) out)
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (nreverse out)))
-
-;;;###autoload
-(defun gnus-sorted-range-intersection (range1 range2)
- "Return intersection of RANGE1 and RANGE2.
-RANGE1 and RANGE2 have to be sorted over <."
- (let* (out
- (min1 (car range1))
- (max1 (if (numberp min1)
- (if (numberp (cdr range1))
- (prog1 (cdr range1)
- (setq range1 nil)) min1)
- (prog1 (cdr min1)
- (setq min1 (car min1)))))
- (min2 (car range2))
- (max2 (if (numberp min2)
- (if (numberp (cdr range2))
- (prog1 (cdr range2)
- (setq range2 nil)) min2)
- (prog1 (cdr min2)
- (setq min2 (car min2))))))
- (setq range1 (cdr range1)
- range2 (cdr range2))
- (while (and min1 min2)
- (cond ((< max1 min2) ; range1 preceeds range2
- (setq range1 (cdr range1)
- min1 nil))
- ((< max2 min1) ; range2 preceeds range1
- (setq range2 (cdr range2)
- min2 nil))
- (t ; some sort of overlap is occurring
- (let ((min (max min1 min2))
- (max (min max1 max2)))
- (setq out (if (= min max)
- (cons min out)
- (cons (cons min max) out))))
- (if (< max1 max2) ; range1 ends before range2
- (setq min1 nil) ; incr range1
- (setq min2 nil)))) ; incr range2
- (unless min1
- (setq min1 (car range1)
- max1 (if (numberp min1) min1 (prog1 (cdr min1) (setq min1 (car min1))))
- range1 (cdr range1)))
- (unless min2
- (setq min2 (car range2)
- max2 (if (numberp min2) min2 (prog1 (cdr min2) (setq min2 (car min2))))
- range2 (cdr range2))))
- (cond ((cdr out)
- (nreverse out))
- ((numberp (car out))
- out)
- (t
- (car out)))))
-
-;;;###autoload
-(defalias 'gnus-set-sorted-intersection 'gnus-sorted-nintersection)
-
-;;;###autoload
-(defun gnus-sorted-nintersection (list1 list2)
- "Return intersection of LIST1 and LIST2 by modifying cdr pointers of LIST1.
-LIST1 and LIST2 have to be sorted over <."
- (let* ((top (cons nil list1))
- (prev top))
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setcdr prev (cdr list1))
- (setq list1 (cdr list1)))
- (t
- (setq list2 (cdr list2)))))
- (setcdr prev nil)
- (cdr top)))
-
-;;;###autoload
-(defun gnus-sorted-union (list1 list2)
- "Return union of LIST1 and LIST2.
-LIST1 and LIST2 have to be sorted over <."
- (let (out)
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq out (cons (car list1) out)
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq out (cons (car list1) out)
- list1 (cdr list1)))
- (t
- (setq out (cons (car list2) out)
- list2 (cdr list2)))))
- (while list1
- (setq out (cons (car list1) out)
- list1 (cdr list1)))
- (while list2
- (setq out (cons (car list2) out)
- list2 (cdr list2)))
- (nreverse out)))
-
-;;;###autoload
-(defun gnus-sorted-nunion (list1 list2)
- "Return union of LIST1 and LIST2 by modifying cdr pointers of LIST1.
-LIST1 and LIST2 have to be sorted over <."
- (let* ((top (cons nil list1))
- (prev top))
- (while (and list1 list2)
- (cond ((= (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)
- list2 (cdr list2)))
- ((< (car list1) (car list2))
- (setq prev list1
- list1 (cdr list1)))
- (t
- (setcdr prev (list (car list2)))
- (setq prev (cdr prev)
- list2 (cdr list2))
- (setcdr prev list1))))
- (while list2
- (setcdr prev (list (car list2)))
- (setq prev (cdr prev)
- list2 (cdr list2)))
- (cdr top)))
-
-(defun gnus-compress-sequence (numbers &optional always-list)
- "Convert list of numbers to a list of ranges or a single range.
-If ALWAYS-LIST is non-nil, this function will always release a list of
-ranges."
- (let* ((first (car numbers))
- (last (car numbers))
- result)
- (if (null numbers)
- nil
- (if (not (listp (cdr numbers)))
- numbers
- (while numbers
- (cond ((= last (car numbers)) nil) ;Omit duplicated number
- ((= (1+ last) (car numbers)) ;Still in sequence
- (setq last (car numbers)))
- (t ;End of one sequence
- (setq result
- (cons (if (= first last) first
- (cons first last))
- result))
- (setq first (car numbers))
- (setq last (car numbers))))
- (setq numbers (cdr numbers)))
- (if (and (not always-list) (null result))
- (if (= first last) (list first) (cons first last))
- (nreverse (cons (if (= first last) first (cons first last))
- result)))))))
-
-(defalias 'gnus-uncompress-sequence 'gnus-uncompress-range)
-(defun gnus-uncompress-range (ranges)
- "Expand a list of ranges into a list of numbers.
-RANGES is either a single range on the form `(num . num)' or a list of
-these ranges."
- (let (first last result)
- (cond
- ((null ranges)
- nil)
- ((not (listp (cdr ranges)))
- (setq first (car ranges))
- (setq last (cdr ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first)))
- (nreverse result))
- (t
- (while ranges
- (if (atom (car ranges))
- (when (numberp (car ranges))
- (setq result (cons (car ranges) result)))
- (setq first (caar ranges))
- (setq last (cdar ranges))
- (while (<= first last)
- (setq result (cons first result))
- (setq first (1+ first))))
- (setq ranges (cdr ranges)))
- (nreverse result)))))
-
-(defun gnus-add-to-range (ranges list)
- "Return a list of ranges that has all articles from both RANGES and LIST.
-Note: LIST has to be sorted over `<'."
- (if (not ranges)
- (gnus-compress-sequence list t)
- (setq list (copy-sequence list))
- (unless (listp (cdr ranges))
- (setq ranges (list ranges)))
- (let ((out ranges)
- ilist lowest highest temp)
- (while (and ranges list)
- (setq ilist list)
- (setq lowest (or (and (atom (car ranges)) (car ranges))
- (caar ranges)))
- (while (and list (cdr list) (< (cadr list) lowest))
- (setq list (cdr list)))
- (when (< (car ilist) lowest)
- (setq temp list)
- (setq list (cdr list))
- (setcdr temp nil)
- (setq out (nconc (gnus-compress-sequence ilist t) out)))
- (setq highest (or (and (atom (car ranges)) (car ranges))
- (cdar ranges)))
- (while (and list (<= (car list) highest))
- (setq list (cdr list)))
- (setq ranges (cdr ranges)))
- (when list
- (setq out (nconc (gnus-compress-sequence list t) out)))
- (setq out (sort out (lambda (r1 r2)
- (< (or (and (atom r1) r1) (car r1))
- (or (and (atom r2) r2) (car r2))))))
- (setq ranges out)
- (while ranges
- (if (atom (car ranges))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (car ranges)) (cadr ranges))
- (setcar ranges (cons (car ranges)
- (cadr ranges)))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (car ranges)) (caadr ranges))
- (setcar (cadr ranges) (car ranges))
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges)))))
- (when (cdr ranges)
- (if (atom (cadr ranges))
- (when (= (1+ (cdar ranges)) (cadr ranges))
- (setcdr (car ranges) (cadr ranges))
- (setcdr ranges (cddr ranges)))
- (when (= (1+ (cdar ranges)) (caadr ranges))
- (setcdr (car ranges) (cdadr ranges))
- (setcdr ranges (cddr ranges))))))
- (setq ranges (cdr ranges)))
- out)))
-
-(defun gnus-remove-from-range (range1 range2)
- "Return a range that has all articles from RANGE2 removed from RANGE1.
-The returned range is always a list. RANGE2 can also be a unsorted
-list of articles. RANGE1 is modified by side effects, RANGE2 is not
-modified."
- (if (or (null range1) (null range2))
- range1
- (let (out r1 r2 r1_min r1_max r2_min r2_max
- (range2 (gnus-copy-sequence range2)))
- (setq range1 (if (listp (cdr range1)) range1 (list range1))
- range2 (sort (if (listp (cdr range2)) range2 (list range2))
- (lambda (e1 e2)
- (< (if (consp e1) (car e1) e1)
- (if (consp e2) (car e2) e2))))
- r1 (car range1)
- r2 (car range2)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2))
- (while (and range1 range2)
- (cond ((< r2_max r1_min) ; r2 < r1
- (pop range2)
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_min) (<= r1_max r2_max)) ; r2 overlap r1
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((and (<= r2_min r1_min) (<= r2_max r1_max)) ; r2 overlap min r1
- (pop range2)
- (setq r1_min (1+ r2_max)
- r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r1_min r2_min) (<= r2_max r1_max)) ; r2 contained in r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range2)
- (if (< r2_max r1_max) ; finished with r1?
- (setq r1_min (1+ r2_max))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- (setq r2 (car range2)
- r2_min (if (consp r2) (car r2) r2)
- r2_max (if (consp r2) (cdr r2) r2)))
- ((and (<= r2_min r1_max) (<= r1_max r2_max)) ; r2 overlap max r1
- (if (eq r1_min (1- r2_min))
- (push r1_min out)
- (push (cons r1_min (1- r2_min)) out))
- (pop range1)
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))
- ((< r1_max r2_min) ; r2 > r1
- (pop range1)
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (setq r1 (car range1)
- r1_min (if (consp r1) (car r1) r1)
- r1_max (if (consp r1) (cdr r1) r1)))))
- (when r1
- (if (eq r1_min r1_max)
- (push r1_min out)
- (push (cons r1_min r1_max) out))
- (pop range1))
- (while range1
- (push (pop range1) out))
- (nreverse out))))
-
-(defun gnus-member-of-range (number ranges)
- (if (not (listp (cdr ranges)))
- (and (>= number (car ranges))
- (<= number (cdr ranges)))
- (let ((not-stop t))
- (while (and ranges
- (if (numberp (car ranges))
- (>= number (car ranges))
- (>= number (caar ranges)))
- not-stop)
- (when (if (numberp (car ranges))
- (= number (car ranges))
- (and (>= number (caar ranges))
- (<= number (cdar ranges))))
- (setq not-stop nil))
- (setq ranges (cdr ranges)))
- (not not-stop))))
-
-(defun gnus-list-range-intersection (list ranges)
- "Return a list of numbers in LIST that are members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (and ranges
- (if (numberp (car ranges))
- (= (car ranges) number)
- ;; (caar ranges) <= number <= (cdar ranges)
- (>= number (caar ranges))))
- (push number result)))
- (nreverse result)))
-
-(defalias 'gnus-inverse-list-range-intersection 'gnus-list-range-difference)
-
-(defun gnus-list-range-difference (list ranges)
- "Return a list of numbers in LIST that are not members of RANGES.
-LIST is a sorted list."
- (setq ranges (gnus-range-normalize ranges))
- (let (number result)
- (while (setq number (pop list))
- (while (and ranges
- (if (numberp (car ranges))
- (< (car ranges) number)
- (< (cdar ranges) number)))
- (setq ranges (cdr ranges)))
- (when (or (not ranges)
- (if (numberp (car ranges))
- (not (= (car ranges) number))
- ;; not ((caar ranges) <= number <= (cdar ranges))
- (< number (caar ranges))))
- (push number result)))
- (nreverse result)))
-
-(defun gnus-range-length (range)
- "Return the length RANGE would have if uncompressed."
- (cond
- ((null range)
- 0)
- ((not (listp (cdr range)))
- (- (cdr range) (car range) -1))
- (t
- (let ((sum 0))
- (dolist (x range sum)
- (setq sum
- (+ sum (if (consp x) (- (cdr x) (car x) -1) 1))))))))
-
-(defun gnus-sublist-p (list sublist)
- "Test whether all elements in SUBLIST are members of LIST."
- (let ((sublistp t))
- (while sublist
- (unless (memq (pop sublist) list)
- (setq sublistp nil
- sublist nil)))
- sublistp))
-
-(defun gnus-range-add (range1 range2)
- "Add RANGE2 to RANGE1 (nondestructively)."
- (unless (listp (cdr range1))
- (setq range1 (list range1)))
- (unless (listp (cdr range2))
- (setq range2 (list range2)))
- (let ((item1 (pop range1))
- (item2 (pop range2))
- range item selector)
- (while (or item1 item2)
- (setq selector
- (cond
- ((null item1) nil)
- ((null item2) t)
- ((and (numberp item1) (numberp item2)) (< item1 item2))
- ((numberp item1) (< item1 (car item2)))
- ((numberp item2) (< (car item1) item2))
- (t (< (car item1) (car item2)))))
- (setq item
- (or
- (let ((tmp1 item) (tmp2 (if selector item1 item2)))
- (cond
- ((null tmp1) tmp2)
- ((null tmp2) tmp1)
- ((and (numberp tmp1) (numberp tmp2))
- (cond
- ((eq tmp1 tmp2) tmp1)
- ((eq (1+ tmp1) tmp2) (cons tmp1 tmp2))
- ((eq (1+ tmp2) tmp1) (cons tmp2 tmp1))
- (t nil)))
- ((numberp tmp1)
- (cond
- ((and (>= tmp1 (car tmp2)) (<= tmp1 (cdr tmp2))) tmp2)
- ((eq (1+ tmp1) (car tmp2)) (cons tmp1 (cdr tmp2)))
- ((eq (1- tmp1) (cdr tmp2)) (cons (car tmp2) tmp1))
- (t nil)))
- ((numberp tmp2)
- (cond
- ((and (>= tmp2 (car tmp1)) (<= tmp2 (cdr tmp1))) tmp1)
- ((eq (1+ tmp2) (car tmp1)) (cons tmp2 (cdr tmp1)))
- ((eq (1- tmp2) (cdr tmp1)) (cons (car tmp1) tmp2))
- (t nil)))
- ((< (1+ (cdr tmp1)) (car tmp2)) nil)
- ((< (1+ (cdr tmp2)) (car tmp1)) nil)
- (t (cons (min (car tmp1) (car tmp2))
- (max (cdr tmp1) (cdr tmp2))))))
- (progn
- (if item (push item range))
- (if selector item1 item2))))
- (if selector
- (setq item1 (pop range1))
- (setq item2 (pop range2))))
- (if item (push item range))
- (reverse range)))
-
-;;;###autoload
-(defun gnus-add-to-sorted-list (list num)
- "Add NUM into sorted LIST by side effect."
- (let* ((top (cons nil list))
- (prev top))
- (while (and list (< (car list) num))
- (setq prev list
- list (cdr list)))
- (unless (eq (car list) num)
- (setcdr prev (cons num list)))
- (cdr top)))
-
-(defun gnus-range-map (func range)
- "Apply FUNC to each value contained by RANGE."
- (setq range (gnus-range-normalize range))
- (while range
- (let ((span (pop range)))
- (if (numberp span)
- (funcall func span)
- (let ((first (car span))
- (last (cdr span)))
- (while (<= first last)
- (funcall func first)
- (setq first (1+ first))))))))
-
-(provide 'gnus-range)
-
-;;; arch-tag: 4780bdd8-5a15-4aff-be28-18727895b6ad
-;;; gnus-range.el ends here
+++ /dev/null
-;;; gnus-registry.el --- article registry for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Ted Zlatanov <tzz@lifelogs.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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This is the gnus-registry.el package, works with other backends
-;; besides nnmail. The major issue is that it doesn't go across
-;; backends, so for instance if an article is in nnml:sys and you see
-;; a reference to it in nnimap splitting, the article will end up in
-;; nnimap:sys
-
-;; gnus-registry.el intercepts article respooling, moving, deleting,
-;; and copying for all backends. If it doesn't work correctly for
-;; you, submit a bug report and I'll be glad to fix it. It needs
-;; documentation in the manual (also on my to-do list).
-
-;; Put this in your startup file (~/.gnus.el for instance)
-
-;; (setq gnus-registry-max-entries 2500
-;; gnus-registry-use-long-group-names t)
-
-;; (gnus-registry-initialize)
-
-;; Then use this in your fancy-split:
-
-;; (: gnus-registry-split-fancy-with-parent)
-
-;; TODO:
-
-;; - get the correct group on spool actions
-
-;; - articles that are spooled to a different backend should be handled
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-int)
-(require 'gnus-sum)
-(require 'gnus-util)
-(require 'nnmail)
-
-(defvar gnus-registry-dirty t
- "Boolean set to t when the registry is modified")
-
-(defgroup gnus-registry nil
- "The Gnus registry."
- :version "22.1"
- :group 'gnus)
-
-(defvar gnus-registry-hashtb nil
- "*The article registry by Message ID.")
-
-(defcustom gnus-registry-unfollowed-groups '("delayed" "drafts" "queue")
- "List of groups that gnus-registry-split-fancy-with-parent won't follow.
-The group names are matched, they don't have to be fully qualified."
- :group 'gnus-registry
- :type '(repeat string))
-
-(defcustom gnus-registry-install nil
- "Whether the registry should be installed."
- :group 'gnus-registry
- :type 'boolean)
-
-(defcustom gnus-registry-clean-empty t
- "Whether the empty registry entries should be deleted.
-Registry entries are considered empty when they have no groups."
- :group 'gnus-registry
- :type 'boolean)
-
-(defcustom gnus-registry-use-long-group-names nil
- "Whether the registry should use long group names (BUGGY)."
- :group 'gnus-registry
- :type 'boolean)
-
-(defcustom gnus-registry-track-extra nil
- "Whether the registry should track extra data about a message.
-The Subject and Sender (From:) headers are currently tracked this
-way."
- :group 'gnus-registry
- :type
- '(set :tag "Tracking choices"
- (const :tag "Track by subject (Subject: header)" subject)
- (const :tag "Track by sender (From: header)" sender)))
-
-(defcustom gnus-registry-entry-caching t
- "Whether the registry should cache extra information."
- :group 'gnus-registry
- :type 'boolean)
-
-(defcustom gnus-registry-minimum-subject-length 5
- "The minimum length of a subject before it's considered trackable."
- :group 'gnus-registry
- :type 'integer)
-
-(defcustom gnus-registry-trim-articles-without-groups t
- "Whether the registry should clean out message IDs without groups."
- :group 'gnus-registry
- :type 'boolean)
-
-(defcustom gnus-registry-cache-file "~/.gnus.registry.eld"
- "File where the Gnus registry will be stored."
- :group 'gnus-registry
- :type 'file)
-
-(defcustom gnus-registry-max-entries nil
- "Maximum number of entries in the registry, nil for unlimited."
- :group 'gnus-registry
- :type '(radio (const :format "Unlimited " nil)
- (integer :format "Maximum number: %v")))
-
-;; Function(s) missing in Emacs 20
-(when (memq nil (mapcar 'fboundp '(puthash)))
- (require 'cl)
- (unless (fboundp 'puthash)
- ;; alias puthash is missing from Emacs 20 cl-extra.el
- (defalias 'puthash 'cl-puthash)))
-
-(defun gnus-registry-track-subject-p ()
- (memq 'subject gnus-registry-track-extra))
-
-(defun gnus-registry-track-sender-p ()
- (memq 'sender gnus-registry-track-extra))
-
-(defun gnus-registry-cache-read ()
- "Read the registry cache file."
- (interactive)
- (let ((file gnus-registry-cache-file))
- (when (file-exists-p file)
- (gnus-message 5 "Reading %s..." file)
- (gnus-load file)
- (gnus-message 5 "Reading %s...done" file))))
-
-;; FIXME: Get rid of duplicated code, cf. `gnus-save-newsrc-file' in
-;; `gnus-start.el'. --rsteib
-(defun gnus-registry-cache-save ()
- "Save the registry cache file."
- (interactive)
- (let ((file gnus-registry-cache-file))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *Gnus-registry-cache*"))
- (make-local-variable 'version-control)
- (setq version-control gnus-backup-startup-file)
- (setq buffer-file-name file)
- (setq default-directory (file-name-directory buffer-file-name))
- (buffer-disable-undo)
- (erase-buffer)
- (gnus-message 5 "Saving %s..." file)
- (if gnus-save-startup-file-via-temp-buffer
- (let ((coding-system-for-write gnus-ding-file-coding-system)
- (standard-output (current-buffer)))
- (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist)
- (gnus-registry-cache-whitespace file)
- (save-buffer))
- (let ((coding-system-for-write gnus-ding-file-coding-system)
- (version-control gnus-backup-startup-file)
- (startup-file file)
- (working-dir (file-name-directory file))
- working-file
- (i -1))
- ;; Generate the name of a non-existent file.
- (while (progn (setq working-file
- (format
- (if (and (eq system-type 'ms-dos)
- (not (gnus-long-file-names)))
- "%s#%d.tm#" ; MSDOS limits files to 8+3
- (if (memq system-type '(vax-vms axp-vms))
- "%s$tmp$%d"
- "%s#tmp#%d"))
- working-dir (setq i (1+ i))))
- (file-exists-p working-file)))
-
- (unwind-protect
- (progn
- (gnus-with-output-to-file working-file
- (gnus-gnus-to-quick-newsrc-format t "gnus registry startup file" 'gnus-registry-alist))
-
- ;; These bindings will mislead the current buffer
- ;; into thinking that it is visiting the startup
- ;; file.
- (let ((buffer-backed-up nil)
- (buffer-file-name startup-file)
- (file-precious-flag t)
- (setmodes (file-modes startup-file)))
- ;; Backup the current version of the startup file.
- (backup-buffer)
-
- ;; Replace the existing startup file with the temp file.
- (rename-file working-file startup-file t)
- (set-file-modes startup-file setmodes)))
- (condition-case nil
- (delete-file working-file)
- (file-error nil)))))
-
- (gnus-kill-buffer (current-buffer))
- (gnus-message 5 "Saving %s...done" file))))
-
-;; Idea from Dan Christensen <jdc@chow.mat.jhu.edu>
-;; Save the gnus-registry file with extra line breaks.
-(defun gnus-registry-cache-whitespace (filename)
- (gnus-message 5 "Adding whitespace to %s" filename)
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^(\\|(\\\"" nil t)
- (replace-match "\n\\&" t))
- (goto-char (point-min))
- (while (re-search-forward " $" nil t)
- (replace-match "" t t))))
-
-(defun gnus-registry-save (&optional force)
- (when (or gnus-registry-dirty force)
- (let ((caching gnus-registry-entry-caching))
- ;; turn off entry caching, so mtime doesn't get recorded
- (setq gnus-registry-entry-caching nil)
- ;; remove entry caches
- (maphash
- (lambda (key value)
- (if (hash-table-p value)
- (remhash key gnus-registry-hashtb)))
- gnus-registry-hashtb)
- ;; remove empty entries
- (when gnus-registry-clean-empty
- (gnus-registry-clean-empty-function))
- ;; now trim the registry appropriately
- (setq gnus-registry-alist (gnus-registry-trim
- (gnus-hashtable-to-alist
- gnus-registry-hashtb)))
- ;; really save
- (gnus-registry-cache-save)
- (setq gnus-registry-entry-caching caching)
- (setq gnus-registry-dirty nil))))
-
-(defun gnus-registry-clean-empty-function ()
- "Remove all empty entries from the registry. Returns count thereof."
- (let ((count 0))
- (maphash
- (lambda (key value)
- (unless (gnus-registry-fetch-group key)
- (incf count)
- (remhash key gnus-registry-hashtb)))
- gnus-registry-hashtb)
- count))
-
-(defun gnus-registry-read ()
- (gnus-registry-cache-read)
- (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist))
- (setq gnus-registry-dirty nil))
-
-(defun gnus-registry-trim (alist)
- "Trim alist to size, using gnus-registry-max-entries."
- (if (null gnus-registry-max-entries)
- alist ; just return the alist
- ;; else, when given max-entries, trim the alist
- (let* ((timehash (make-hash-table
- :size 4096
- :test 'equal))
- (trim-length (- (length alist) gnus-registry-max-entries))
- (trim-length (if (natnump trim-length) trim-length 0)))
- (maphash
- (lambda (key value)
- (puthash key (gnus-registry-fetch-extra key 'mtime) timehash))
- gnus-registry-hashtb)
-
- ;; we use the return value of this setq, which is the trimmed alist
- (setq alist
- (nthcdr
- trim-length
- (sort alist
- (lambda (a b)
- (time-less-p
- (cdr (gethash (car a) timehash))
- (cdr (gethash (car b) timehash))))))))))
-
-(defun gnus-registry-action (action data-header from &optional to method)
- (let* ((id (mail-header-id data-header))
- (subject (gnus-registry-simplify-subject
- (mail-header-subject data-header)))
- (sender (mail-header-from data-header))
- (from (gnus-group-guess-full-name-from-command-method from))
- (to (if to (gnus-group-guess-full-name-from-command-method to) nil))
- (to-name (if to to "the Bit Bucket"))
- (old-entry (gethash id gnus-registry-hashtb)))
- (gnus-message 5 "Registry: article %s %s from %s to %s"
- id
- (if method "respooling" "going")
- from
- to)
-
- ;; All except copy will need a delete
- (gnus-registry-delete-group id from)
-
- (when (equal 'copy action)
- (gnus-registry-add-group id from subject sender)) ; undo the delete
-
- (gnus-registry-add-group id to subject sender)))
-
-(defun gnus-registry-spool-action (id group &optional subject sender)
- (let ((group (gnus-group-guess-full-name-from-command-method group)))
- (when (and (stringp id) (string-match "\r$" id))
- (setq id (substring id 0 -1)))
- (gnus-message 5 "Registry: article %s spooled to %s"
- id
- group)
- (gnus-registry-add-group id group subject sender)))
-
-;; Function for nn{mail|imap}-split-fancy: look up all references in
-;; the cache and if a match is found, return that group.
-(defun gnus-registry-split-fancy-with-parent ()
- "Split this message into the same group as its parent. The parent
-is obtained from the registry. This function can be used as an entry
-in `nnmail-split-fancy' or `nnimap-split-fancy', for example like
-this: (: gnus-registry-split-fancy-with-parent)
-
-For a message to be split, it looks for the parent message in the
-References or In-Reply-To header and then looks in the registry to
-see which group that message was put in. This group is returned.
-
-See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (let ((refstr (or (message-fetch-field "references")
- (message-fetch-field "in-reply-to")))
- (nnmail-split-fancy-with-parent-ignore-groups
- (if (listp nnmail-split-fancy-with-parent-ignore-groups)
- nnmail-split-fancy-with-parent-ignore-groups
- (list nnmail-split-fancy-with-parent-ignore-groups)))
- references res)
- (if refstr
- (progn
- (setq references (nreverse (gnus-split-references refstr)))
- (mapcar (lambda (x)
- (setq res (or (gnus-registry-fetch-group x) res))
- (when (or (gnus-registry-grep-in-list
- res
- gnus-registry-unfollowed-groups)
- (gnus-registry-grep-in-list
- res
- nnmail-split-fancy-with-parent-ignore-groups))
- (setq res nil)))
- references))
-
- ;; else: there were no references, now try the extra tracking
- (let ((sender (message-fetch-field "from"))
- (subject (gnus-registry-simplify-subject
- (message-fetch-field "subject")))
- (single-match t))
- (when (and single-match
- (gnus-registry-track-sender-p)
- sender)
- (maphash
- (lambda (key value)
- (let ((this-sender (cdr
- (gnus-registry-fetch-extra key 'sender))))
- (when (and single-match
- this-sender
- (equal sender this-sender))
- ;; too many matches, bail
- (unless (equal res (gnus-registry-fetch-group key))
- (setq single-match nil))
- (setq res (gnus-registry-fetch-group key))
- (gnus-message
- ;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 5 9)
- "%s (extra tracking) traced sender %s to group %s"
- "gnus-registry-split-fancy-with-parent"
- sender
- (if res res "nil")))))
- gnus-registry-hashtb))
- (when (and single-match
- (gnus-registry-track-subject-p)
- subject
- (< gnus-registry-minimum-subject-length (length subject)))
- (maphash
- (lambda (key value)
- (let ((this-subject (cdr
- (gnus-registry-fetch-extra key 'subject))))
- (when (and single-match
- this-subject
- (equal subject this-subject))
- ;; too many matches, bail
- (unless (equal res (gnus-registry-fetch-group key))
- (setq single-match nil))
- (setq res (gnus-registry-fetch-group key))
- (gnus-message
- ;; raise level of messaging if gnus-registry-track-extra
- (if gnus-registry-track-extra 5 9)
- "%s (extra tracking) traced subject %s to group %s"
- "gnus-registry-split-fancy-with-parent"
- subject
- (if res res "nil")))))
- gnus-registry-hashtb))
- (unless single-match
- (gnus-message
- 5
- "gnus-registry-split-fancy-with-parent: too many extra matches for %s"
- refstr)
- (setq res nil))))
- (gnus-message
- 5
- "gnus-registry-split-fancy-with-parent traced %s to group %s"
- refstr (if res res "nil"))
-
- (when (and res gnus-registry-use-long-group-names)
- (let ((m1 (gnus-find-method-for-group res))
- (m2 (or gnus-command-method
- (gnus-find-method-for-group gnus-newsgroup-name)))
- (short-res (gnus-group-short-name res)))
- (if (gnus-methods-equal-p m1 m2)
- (progn
- (gnus-message
- 9
- "gnus-registry-split-fancy-with-parent stripped group %s to %s"
- res
- short-res)
- (setq res short-res))
- ;; else...
- (gnus-message
- 5
- "gnus-registry-split-fancy-with-parent ignored foreign group %s"
- res)
- (setq res nil))))
- res))
-
-(defun gnus-registry-register-message-ids ()
- "Register the Message-ID of every article in the group"
- (unless (gnus-parameter-registry-ignore gnus-newsgroup-name)
- (dolist (article gnus-newsgroup-articles)
- (let ((id (gnus-registry-fetch-message-id-fast article)))
- (unless (gnus-registry-fetch-group id)
- (gnus-message 9 "Registry: Registering article %d with group %s"
- article gnus-newsgroup-name)
- (gnus-registry-add-group
- (gnus-registry-fetch-message-id-fast article)
- gnus-newsgroup-name
- (gnus-registry-fetch-simplified-message-subject-fast article)
- (gnus-registry-fetch-sender-fast article)))))))
-
-(defun gnus-registry-fetch-message-id-fast (article)
- "Fetch the Message-ID quickly, using the internal gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (mail-header-id (gnus-data-header (assoc article (gnus-data-list nil))))
- nil))
-
-(defun gnus-registry-simplify-subject (subject)
- (if (stringp subject)
- (gnus-simplify-subject subject)
- nil))
-
-(defun gnus-registry-fetch-simplified-message-subject-fast (article)
- "Fetch the Subject quickly, using the internal gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (gnus-registry-simplify-subject
- (mail-header-subject (gnus-data-header
- (assoc article (gnus-data-list nil)))))
- nil))
-
-(defun gnus-registry-fetch-sender-fast (article)
- "Fetch the Sender quickly, using the internal gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (mail-header-from (gnus-data-header
- (assoc article (gnus-data-list nil))))
- nil))
-
-(defun gnus-registry-grep-in-list (word list)
- (when word
- (memq nil
- (mapcar 'not
- (mapcar
- (lambda (x)
- (string-match x word))
- list)))))
-
-(defun gnus-registry-fetch-extra (id &optional entry)
- "Get the extra data of a message, based on the message ID.
-Returns the first place where the trail finds a nonstring."
- (let ((entry-cache (gethash entry gnus-registry-hashtb)))
- (if (and entry
- (hash-table-p entry-cache)
- (gethash id entry-cache))
- (gethash id entry-cache)
- ;; else, if there is no caching possible...
- (let ((trail (gethash id gnus-registry-hashtb)))
- (when (listp trail)
- (dolist (crumb trail)
- (unless (stringp crumb)
- (return (gnus-registry-fetch-extra-entry crumb entry id)))))))))
-
-(defun gnus-registry-fetch-extra-entry (alist &optional entry id)
- "Get the extra data of a message, or a specific entry in it.
-Update the entry cache if needed."
- (if (and entry id)
- (let ((entry-cache (gethash entry gnus-registry-hashtb))
- entree)
- (when gnus-registry-entry-caching
- ;; create the hash table
- (unless (hash-table-p entry-cache)
- (setq entry-cache (make-hash-table
- :size 4096
- :test 'equal))
- (puthash entry entry-cache gnus-registry-hashtb))
-
- ;; get the entree from the hash table or from the alist
- (setq entree (gethash id entry-cache)))
-
- (unless entree
- (setq entree (assq entry alist))
- (when gnus-registry-entry-caching
- (puthash id entree entry-cache)))
- entree)
- alist))
-
-(defun gnus-registry-store-extra (id extra)
- "Store the extra data of a message, based on the message ID.
-The message must have at least one group name."
- (when (gnus-registry-group-count id)
- ;; we now know the trail has at least 1 group name, so it's not empty
- (let ((trail (gethash id gnus-registry-hashtb))
- (old-extra (gnus-registry-fetch-extra id))
- entry-cache)
- (dolist (crumb trail)
- (unless (stringp crumb)
- (dolist (entry crumb)
- (setq entry-cache (gethash (car entry) gnus-registry-hashtb))
- (when entry-cache
- (remhash id entry-cache))))
- (puthash id (cons extra (delete old-extra trail))
- gnus-registry-hashtb)
- (setq gnus-registry-dirty t)))))
-
-(defun gnus-registry-store-extra-entry (id key value)
- "Put a specific entry in the extras field of the registry entry for id."
- (let* ((extra (gnus-registry-fetch-extra id))
- (alist (cons (cons key value)
- (gnus-assq-delete-all key (gnus-registry-fetch-extra id)))))
- (gnus-registry-store-extra id alist)))
-
-(defun gnus-registry-fetch-group (id)
- "Get the group of a message, based on the message ID.
-Returns the first place where the trail finds a group name."
- (when (gnus-registry-group-count id)
- ;; we now know the trail has at least 1 group name
- (let ((trail (gethash id gnus-registry-hashtb)))
- (dolist (crumb trail)
- (when (stringp crumb)
- (return (if gnus-registry-use-long-group-names
- crumb
- (gnus-group-short-name crumb))))))))
-
-(defun gnus-registry-group-count (id)
- "Get the number of groups of a message, based on the message ID."
- (let ((trail (gethash id gnus-registry-hashtb)))
- (if (and trail (listp trail))
- (apply '+ (mapcar (lambda (x) (if (stringp x) 1 0)) trail))
- 0)))
-
-(defun gnus-registry-delete-group (id group)
- "Delete a group for a message, based on the message ID."
- (when group
- (when id
- (let ((trail (gethash id gnus-registry-hashtb))
- (group (gnus-group-short-name group)))
- (puthash id (if trail
- (delete group trail)
- nil)
- gnus-registry-hashtb))
- ;; now, clear the entry if there are no more groups
- (when gnus-registry-trim-articles-without-groups
- (unless (gnus-registry-group-count id)
- (gnus-registry-delete-id id)))
- ;; is this ID still in the registry?
- (when (gethash id gnus-registry-hashtb)
- (gnus-registry-store-extra-entry id 'mtime (current-time))))))
-
-(defun gnus-registry-delete-id (id)
- "Delete a message ID from the registry."
- (when (stringp id)
- (remhash id gnus-registry-hashtb)
- (maphash
- (lambda (key value)
- (when (hash-table-p value)
- (remhash id value)))
- gnus-registry-hashtb)))
-
-(defun gnus-registry-add-group (id group &optional subject sender)
- "Add a group for a message, based on the message ID."
- (when group
- (when (and id
- (not (string-match "totally-fudged-out-message-id" id)))
- (let ((full-group group)
- (group (if gnus-registry-use-long-group-names
- group
- (gnus-group-short-name group))))
- (gnus-registry-delete-group id group)
-
- (unless gnus-registry-use-long-group-names ;; unnecessary in this case
- (gnus-registry-delete-group id full-group))
-
- (let ((trail (gethash id gnus-registry-hashtb)))
- (puthash id (if trail
- (cons group trail)
- (list group))
- gnus-registry-hashtb)
-
- (when (and (gnus-registry-track-subject-p)
- subject)
- (gnus-registry-store-extra-entry
- id
- 'subject
- (gnus-registry-simplify-subject subject)))
- (when (and (gnus-registry-track-sender-p)
- sender)
- (gnus-registry-store-extra-entry
- id
- 'sender
- sender))
-
- (gnus-registry-store-extra-entry id 'mtime (current-time)))))))
-
-(defun gnus-registry-clear ()
- "Clear the Gnus registry."
- (interactive)
- (setq gnus-registry-alist nil)
- (setq gnus-registry-hashtb (gnus-alist-to-hashtable gnus-registry-alist))
- (setq gnus-registry-dirty t))
-
-;;;###autoload
-(defun gnus-registry-initialize ()
- (interactive)
- (setq gnus-registry-install t)
- (gnus-registry-install-hooks)
- (gnus-registry-read))
-
-;;;###autoload
-(defun gnus-registry-install-hooks ()
- "Install the registry hooks."
- (interactive)
- (add-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (add-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (add-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
-
- (add-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (add-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
-
- (add-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
-
-(defun gnus-registry-unload-hook ()
- "Uninstall the registry hooks."
- (interactive)
- (remove-hook 'gnus-summary-article-move-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-delete-hook 'gnus-registry-action)
- (remove-hook 'gnus-summary-article-expire-hook 'gnus-registry-action)
- (remove-hook 'nnmail-spool-hook 'gnus-registry-spool-action)
-
- (remove-hook 'gnus-save-newsrc-hook 'gnus-registry-save)
- (remove-hook 'gnus-read-newsrc-el-hook 'gnus-registry-read)
-
- (remove-hook 'gnus-summary-prepare-hook 'gnus-registry-register-message-ids))
-
-(add-hook 'gnus-registry-unload-hook 'gnus-registry-unload-hook)
-
-(when gnus-registry-install
- (gnus-registry-install-hooks)
- (gnus-registry-read))
-
-;; TODO: a lot of things
-
-(provide 'gnus-registry)
-
-;;; arch-tag: 5cba0a32-718a-4a97-8c91-0a15af21da94
-;;; gnus-registry.el ends here
+++ /dev/null
-;;; gnus-salt.el --- alternate summary mode interfaces for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'gnus-win)
-
-;;;
-;;; gnus-pick-mode
-;;;
-
-(defvar gnus-pick-mode nil
- "Minor mode for providing a pick-and-read interface in Gnus
-summary buffers.")
-
-(defcustom gnus-pick-display-summary nil
- "*Display summary while reading."
- :type 'boolean
- :group 'gnus-summary-pick)
-
-(defcustom gnus-pick-mode-hook nil
- "Hook run in summary pick mode buffers."
- :type 'hook
- :group 'gnus-summary-pick)
-
-(when (featurep 'xemacs)
- (add-hook 'gnus-pick-mode-hook 'gnus-xmas-pick-menu-add))
-
-(defcustom gnus-mark-unpicked-articles-as-read nil
- "*If non-nil, mark all unpicked articles as read."
- :type 'boolean
- :group 'gnus-summary-pick)
-
-(defcustom gnus-pick-elegant-flow t
- "If non-nil, `gnus-pick-start-reading' runs
- `gnus-summary-next-group' when no articles have been picked."
- :type 'boolean
- :group 'gnus-summary-pick)
-
-(defcustom gnus-summary-pick-line-format
- "%-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
- :group 'gnus-summary-pick)
-
-;;; Internal variables.
-
-(defvar gnus-pick-mode-map nil)
-
-(unless gnus-pick-mode-map
- (setq gnus-pick-mode-map (make-sparse-keymap))
-
- (gnus-define-keys gnus-pick-mode-map
- " " gnus-pick-next-page
- "u" gnus-pick-unmark-article-or-thread
- "." gnus-pick-article-or-thread
- gnus-down-mouse-2 gnus-pick-mouse-pick-region
- "\r" gnus-pick-start-reading))
-
-(defun gnus-pick-make-menu-bar ()
- (unless (boundp 'gnus-pick-menu)
- (easy-menu-define
- gnus-pick-menu gnus-pick-mode-map ""
- '("Pick"
- ("Pick"
- ["Article" gnus-summary-mark-as-processable t]
- ["Thread" gnus-uu-mark-thread t]
- ["Region" gnus-uu-mark-region t]
- ["Regexp" gnus-uu-mark-by-regexp t]
- ["Buffer" gnus-uu-mark-buffer t])
- ("Unpick"
- ["Article" gnus-summary-unmark-as-processable t]
- ["Thread" gnus-uu-unmark-thread t]
- ["Region" gnus-uu-unmark-region t]
- ["Regexp" gnus-uu-unmark-by-regexp t]
- ["Buffer" gnus-summary-unmark-all-processable t])
- ["Start reading" gnus-pick-start-reading t]
- ["Switch pick mode off" gnus-pick-mode gnus-pick-mode]))))
-
-(defun gnus-pick-mode (&optional arg)
- "Minor mode for providing a pick-and-read interface in Gnus summary buffers.
-
-\\{gnus-pick-mode-map}"
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (if (not (set (make-local-variable 'gnus-pick-mode)
- (if (null arg) (not gnus-pick-mode)
- (> (prefix-numeric-value arg) 0))))
- (remove-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
- ;; Make sure that we don't select any articles upon group entry.
- (set (make-local-variable 'gnus-auto-select-first) nil)
- ;; Change line format.
- (setq gnus-summary-line-format gnus-summary-pick-line-format)
- (setq gnus-summary-line-format-spec nil)
- (gnus-update-format-specifications nil 'summary)
- (gnus-update-summary-mark-positions)
- (add-hook 'gnus-message-setup-hook 'gnus-pick-setup-message)
- (set (make-local-variable 'gnus-summary-goto-unread) 'never)
- ;; Set up the menu.
- (when (gnus-visual-p 'pick-menu 'menu)
- (gnus-pick-make-menu-bar))
- (gnus-add-minor-mode 'gnus-pick-mode " Pick" gnus-pick-mode-map)
- (gnus-run-hooks 'gnus-pick-mode-hook))))
-
-(defun gnus-pick-setup-message ()
- "Make Message do the right thing on exit."
- (when (and (gnus-buffer-live-p gnus-summary-buffer)
- (with-current-buffer gnus-summary-buffer
- gnus-pick-mode))
- (message-add-action
- `(gnus-configure-windows ,gnus-current-window-configuration t)
- 'send 'exit 'postpone 'kill)))
-
-(defvar gnus-pick-line-number 1)
-(defun gnus-pick-line-number ()
- "Return the current line number."
- (if (bobp)
- (setq gnus-pick-line-number 1)
- (incf gnus-pick-line-number)))
-
-(defun gnus-pick-start-reading (&optional catch-up)
- "Start reading the picked articles.
-If given a prefix, mark all unpicked articles as read."
- (interactive "P")
- (if gnus-newsgroup-processable
- (progn
- (gnus-summary-limit-to-articles nil)
- (when (or catch-up gnus-mark-unpicked-articles-as-read)
- (gnus-summary-limit-mark-excluded-as-read))
- (gnus-summary-first-article)
- (gnus-configure-windows
- (if gnus-pick-display-summary 'article 'pick) t))
- (if gnus-pick-elegant-flow
- (progn
- (when (or catch-up gnus-mark-unpicked-articles-as-read)
- (gnus-summary-catchup nil t))
- (if (gnus-group-quit-config gnus-newsgroup-name)
- (gnus-summary-exit)
- (gnus-summary-next-group)))
- (error "No articles have been picked"))))
-
-(defun gnus-pick-goto-article (arg)
- "Go to the article number indicated by ARG.
-If ARG is an invalid article number, then stay on current line."
- (let (pos)
- (save-excursion
- (goto-char (point-min))
- (when (zerop (forward-line (1- (prefix-numeric-value arg))))
- (setq pos (point))))
- (if (not pos)
- (gnus-error 2 "No such line: %s" arg)
- (goto-char pos))))
-
-(defun gnus-pick-article (&optional arg)
- "Pick the article on the current line.
-If ARG, pick the article on that line instead."
- (interactive "P")
- (when arg
- (gnus-pick-goto-article arg))
- (gnus-summary-mark-as-processable 1))
-
-(defun gnus-pick-article-or-thread (&optional arg)
- "If `gnus-thread-hide-subtree' is t, then pick the thread on the current line.
-Otherwise pick the article on the current line.
-If ARG, pick the article/thread on that line instead."
- (interactive "P")
- (when arg
- (gnus-pick-goto-article arg))
- (if gnus-thread-hide-subtree
- (progn
- (save-excursion
- (gnus-uu-mark-thread))
- (forward-line 1))
- (gnus-summary-mark-as-processable 1)))
-
-(defun gnus-pick-unmark-article-or-thread (&optional arg)
- "If `gnus-thread-hide-subtree' is t, then unmark the thread on current line.
-Otherwise unmark the article on current line.
-If ARG, unmark thread/article on that line instead."
- (interactive "P")
- (when arg
- (gnus-pick-goto-article arg))
- (if gnus-thread-hide-subtree
- (save-excursion
- (gnus-uu-unmark-thread))
- (gnus-summary-unmark-as-processable 1)))
-
-(defun gnus-pick-mouse-pick (e)
- (interactive "e")
- (mouse-set-point e)
- (save-excursion
- (gnus-summary-mark-as-processable 1)))
-
-(defun gnus-pick-mouse-pick-region (start-event)
- "Pick articles that the mouse is dragged over.
-This must be bound to a button-down mouse event."
- (interactive "e")
- (mouse-minibuffer-check start-event)
- (let* ((echo-keystrokes 0)
- (start-posn (event-start start-event))
- (start-point (posn-point start-posn))
- (start-line (1+ (count-lines (point-min) start-point)))
- (start-window (posn-window start-posn))
- (bounds (gnus-window-edges start-window))
- (top (nth 1 bounds))
- (bottom (if (window-minibuffer-p start-window)
- (nth 3 bounds)
- ;; Don't count the mode line.
- (1- (nth 3 bounds))))
- (click-count (1- (event-click-count start-event))))
- (setq mouse-selection-click-count click-count)
- (setq mouse-selection-click-count-buffer (current-buffer))
- (mouse-set-point start-event)
- ;; In case the down click is in the middle of some intangible text,
- ;; use the end of that text, and put it in START-POINT.
- (when (< (point) start-point)
- (goto-char start-point))
- (gnus-pick-article)
- (setq start-point (point))
- ;; end-of-range is used only in the single-click case.
- ;; It is the place where the drag has reached so far
- ;; (but not outside the window where the drag started).
- (let (event end end-point (end-of-range (point)))
- (track-mouse
- (while (progn
- (setq event (cdr (gnus-read-event-char)))
- (or (mouse-movement-p event)
- (eq (car-safe event) 'switch-frame)))
- (if (eq (car-safe event) 'switch-frame)
- nil
- (setq end (event-end event)
- end-point (posn-point end))
-
- (cond
- ;; Are we moving within the original window?
- ((and (eq (posn-window end) start-window)
- (integer-or-marker-p end-point))
- ;; Go to START-POINT first, so that when we move to END-POINT,
- ;; if it's in the middle of intangible text,
- ;; point jumps in the direction away from START-POINT.
- (goto-char start-point)
- (goto-char end-point)
- (gnus-pick-article)
- ;; In case the user moved his mouse really fast, pick
- ;; articles on the line between this one and the last one.
- (let* ((this-line (1+ (count-lines (point-min) end-point)))
- (min-line (min this-line start-line))
- (max-line (max this-line start-line)))
- ;; Why not use `forward-line'? --Stef
- (while (< min-line max-line)
- (goto-line min-line)
- (gnus-pick-article)
- (setq min-line (1+ min-line)))
- (setq start-line this-line))
- (when (zerop (% click-count 3))
- (setq end-of-range (point))))
- (t
- (let ((mouse-row (cdr (cdr (mouse-position)))))
- (cond
- ((null mouse-row))
- ((< mouse-row top)
- (mouse-scroll-subr start-window (- mouse-row top)))
- ((>= mouse-row bottom)
- (mouse-scroll-subr start-window
- (1+ (- mouse-row bottom)))))))))))
- (when (consp 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,
- ;; 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.
- (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.
- (push event unread-command-events))))))))
-
-(defun gnus-pick-next-page ()
- "Go to the next page. If at the end of the buffer, start reading articles."
- (interactive)
- (let ((scroll-in-place nil))
- (condition-case nil
- (scroll-up)
- (end-of-buffer (gnus-pick-start-reading)))))
-
-;;;
-;;; gnus-binary-mode
-;;;
-
-(defvar gnus-binary-mode nil
- "Minor mode for providing a binary group interface in Gnus summary buffers.")
-
-(defvar gnus-binary-mode-hook nil
- "Hook run in summary binary mode buffers.")
-
-(defvar gnus-binary-mode-map nil)
-
-(unless gnus-binary-mode-map
- (setq gnus-binary-mode-map (make-sparse-keymap))
-
- (gnus-define-keys
- gnus-binary-mode-map
- "g" gnus-binary-show-article))
-
-(defun gnus-binary-make-menu-bar ()
- (unless (boundp 'gnus-binary-menu)
- (easy-menu-define
- gnus-binary-menu gnus-binary-mode-map ""
- '("Pick"
- ["Switch binary mode off" gnus-binary-mode t]))))
-
-(defun gnus-binary-mode (&optional arg)
- "Minor mode for providing a binary group interface in Gnus summary buffers."
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (make-local-variable 'gnus-binary-mode)
- (setq gnus-binary-mode
- (if (null arg) (not gnus-binary-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-binary-mode
- ;; Make sure that we don't select any articles upon group entry.
- (make-local-variable 'gnus-auto-select-first)
- (setq gnus-auto-select-first nil)
- (make-local-variable 'gnus-summary-display-article-function)
- (setq gnus-summary-display-article-function 'gnus-binary-display-article)
- ;; Set up the menu.
- (when (gnus-visual-p 'binary-menu 'menu)
- (gnus-binary-make-menu-bar))
- (gnus-add-minor-mode 'gnus-binary-mode " Binary" gnus-binary-mode-map)
- (gnus-run-hooks 'gnus-binary-mode-hook))))
-
-(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)))
- (gnus-uu-decode-uu))))
-
-(defun gnus-binary-show-article (&optional arg)
- "Bypass the binary functions and show the article."
- (interactive "P")
- (let (gnus-summary-display-article-function)
- (gnus-summary-show-article arg)))
-
-;;;
-;;; gnus-tree-mode
-;;;
-
-(defcustom gnus-tree-line-format "%(%[%3,3n%]%)"
- "Format of tree elements."
- :type 'string
- :group 'gnus-summary-tree)
-
-(defcustom gnus-tree-minimize-window t
- "If non-nil, minimize the tree buffer window.
-If a number, never let the tree buffer grow taller than that number of
-lines."
- :type '(choice boolean
- integer)
- :group 'gnus-summary-tree)
-
-(defcustom gnus-selected-tree-face 'modeline
- "*Face used for highlighting selected articles in the thread tree."
- :type 'face
- :group 'gnus-summary-tree)
-
-(defvar gnus-tree-brackets '((?\[ . ?\]) (?\( . ?\))
- (?\{ . ?\}) (?< . ?>))
- "Brackets used in tree nodes.")
-
-(defvar gnus-tree-parent-child-edges '(?- ?\\ ?|)
- "Characters used to connect parents with children.")
-
-(defcustom gnus-tree-mode-line-format "Gnus: %%b %S %Z"
- "*The format specification for the tree mode line."
- :type 'string
- :group 'gnus-summary-tree)
-
-(defcustom gnus-generate-tree-function 'gnus-generate-vertical-tree
- "*Function for generating a thread tree.
-Two predefined functions are available:
-`gnus-generate-horizontal-tree' and `gnus-generate-vertical-tree'."
- :type '(radio (function-item gnus-generate-vertical-tree)
- (function-item gnus-generate-horizontal-tree)
- (function :tag "Other" nil))
- :group 'gnus-summary-tree)
-
-(defcustom gnus-tree-mode-hook nil
- "*Hook run in tree mode buffers."
- :type 'hook
- :group 'gnus-summary-tree)
-
-(when (featurep 'xemacs)
- (add-hook 'gnus-tree-mode-hook 'gnus-xmas-tree-menu-add)
- (add-hook 'gnus-tree-mode-hook 'gnus-xmas-switch-horizontal-scrollbar-off))
-
-
-;;; Internal variables.
-
-(defvar gnus-tree-line-format-alist
- `((?n gnus-tmp-name ?s)
- (?f gnus-tmp-from ?s)
- (?N gnus-tmp-number ?d)
- (?\[ gnus-tmp-open-bracket ?c)
- (?\] gnus-tmp-close-bracket ?c)
- (?s gnus-tmp-subject ?s)))
-
-(defvar gnus-tree-mode-line-format-alist gnus-summary-mode-line-format-alist)
-
-(defvar gnus-tree-mode-line-format-spec nil)
-(defvar gnus-tree-line-format-spec nil)
-
-(defvar gnus-tree-node-length nil)
-(defvar gnus-selected-tree-overlay nil)
-
-(defvar gnus-tree-displayed-thread nil)
-(defvar gnus-tree-inhibit nil)
-
-(defvar gnus-tree-mode-map nil)
-(put 'gnus-tree-mode 'mode-class 'special)
-
-(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)
-
- (substitute-key-definition
- 'undefined 'gnus-tree-read-summary-keys gnus-tree-mode-map))
-
-(defun gnus-tree-make-menu-bar ()
- (unless (boundp 'gnus-tree-menu)
- (easy-menu-define
- gnus-tree-menu gnus-tree-mode-map ""
- '("Tree"
- ["Select article" gnus-tree-select-article t]))))
-
-(defun gnus-tree-mode ()
- "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
- (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))
-
-(defun gnus-tree-read-summary-keys (&optional arg)
- "Read a summary buffer key sequence and execute it."
- (interactive "P")
- (unless gnus-tree-inhibit
- (let ((buf (current-buffer))
- (gnus-tree-inhibit t)
- win)
- (set-buffer gnus-article-buffer)
- (gnus-article-read-summary-keys arg nil t)
- (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)))
- (gnus-tree-minimize)))))
-
-(defun gnus-tree-show-summary ()
- "Reconfigure windows to show summary buffer."
- (interactive)
- (if (not (gnus-buffer-live-p gnus-summary-buffer))
- (error "There is no summary buffer for this tree buffer")
- (gnus-configure-windows 'article)
- (gnus-summary-goto-subject gnus-current-article)))
-
-(defun gnus-tree-select-article (article)
- "Select the article under point, if any."
- (interactive (list (gnus-tree-article-number)))
- (let ((buf (current-buffer)))
- (when article
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-goto-article article))
- (select-window (get-buffer-window buf)))))
-
-(defun gnus-tree-pick-article (e)
- "Select the article under the mouse pointer."
- (interactive "e")
- (mouse-set-point e)
- (gnus-tree-select-article (gnus-tree-article-number)))
-
-(defun gnus-tree-article-number ()
- (get-text-property (point) 'gnus-number))
-
-(defun gnus-tree-article-region (article)
- "Return a cons with BEG and END of the article region."
- (let ((pos (text-property-any
- (point-min) (point-max) 'gnus-number article)))
- (when pos
- (cons pos (next-single-property-change pos 'gnus-number)))))
-
-(defun gnus-tree-goto-article (article)
- (let ((pos (text-property-any
- (point-min) (point-max) 'gnus-number article)))
- (when pos
- (goto-char pos))))
-
-(defun gnus-tree-recenter ()
- "Center point in the tree window."
- (let ((selected (selected-window))
- (tree-window (gnus-get-buffer-window gnus-tree-buffer t)))
- (when tree-window
- (select-window tree-window)
- (when gnus-selected-tree-overlay
- (goto-char (or (gnus-overlay-end gnus-selected-tree-overlay) 1)))
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t 2)))
- (height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point))))
- ;; Set the window start to either `bottom', which is the biggest
- ;; possible valid number, or the second line from the top,
- ;; whichever is the least.
- (set-window-start
- tree-window (min bottom (save-excursion
- (forward-line (- top)) (point)))))
- (select-window selected))))
-
-(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)
- (gnus-tree-mode))
- (current-buffer)))
-
-(defun gnus-tree-minimize ()
- (when (and gnus-tree-minimize-window
- (not (one-window-p)))
- (let ((windows 0)
- tot-win-height)
- (walk-windows (lambda (window) (incf windows)))
- (setq tot-win-height
- (- (frame-height)
- (* window-min-height (1- windows))
- 2))
- (let* ((window-min-height 2)
- (height (count-lines (point-min) (point-max)))
- (min (max (1- window-min-height) height))
- (tot (if (numberp gnus-tree-minimize-window)
- (min gnus-tree-minimize-window min)
- min))
- (win (get-buffer-window (current-buffer)))
- (wh (and win (1- (window-height win)))))
- (setq tot (min tot tot-win-height))
- (when (and win
- (not (eq tot wh)))
- (let ((selected (selected-window)))
- (when (ignore-errors (select-window win))
- (enlarge-window (- tot wh))
- (select-window selected))))))))
-
-;;; Generating the tree.
-
-(defun gnus-tree-node-insert (header sparse &optional adopted)
- (let* ((dummy (stringp header))
- (header (if (vectorp header) header
- (progn
- (setq header (make-mail-header "*****"))
- (mail-header-set-number header 0)
- (mail-header-set-lines header 0)
- (mail-header-set-chars header 0)
- header)))
- (gnus-tmp-from (mail-header-from header))
- (gnus-tmp-subject (mail-header-subject header))
- (gnus-tmp-number (mail-header-number header))
- (gnus-tmp-name
- (cond
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
- ((string-match "<[^>]+> *$" gnus-tmp-from)
- (let ((beg (match-beginning 0)))
- (or (and (string-match "^\"[^\"]*\"" gnus-tmp-from)
- (substring gnus-tmp-from (1+ (match-beginning 0))
- (1- (match-end 0))))
- (substring gnus-tmp-from 0 beg))))
- ((memq gnus-tmp-number sparse)
- "***")
- (t gnus-tmp-from)))
- (gnus-tmp-open-bracket
- (cond ((memq gnus-tmp-number sparse)
- (caadr gnus-tree-brackets))
- (dummy (caaddr gnus-tree-brackets))
- (adopted (car (nth 3 gnus-tree-brackets)))
- (t (caar gnus-tree-brackets))))
- (gnus-tmp-close-bracket
- (cond ((memq gnus-tmp-number sparse)
- (cdadr gnus-tree-brackets))
- (adopted (cdr (nth 3 gnus-tree-brackets)))
- (dummy
- (cdaddr gnus-tree-brackets))
- (t (cdar gnus-tree-brackets))))
- (buffer-read-only nil)
- beg end)
- (gnus-add-text-properties
- (setq beg (point))
- (setq end (progn (eval gnus-tree-line-format-spec) (point)))
- (list 'gnus-number gnus-tmp-number))
- (when (or t (gnus-visual-p 'tree-highlight 'highlight))
- (gnus-tree-highlight-node gnus-tmp-number beg end))))
-
-(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))
- 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))
- (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)))))
- (unless (eq (setq face (cdar list)) (get-text-property beg 'face))
- (gnus-put-text-property-excluding-characters-with-faces
- beg end 'face
- (if (boundp face) (symbol-value face) face)))))
-
-(defun gnus-tree-indent (level)
- (insert (make-string (1- (* (1+ gnus-tree-node-length) level)) ? )))
-
-(defvar gnus-tmp-limit)
-(defvar gnus-tmp-sparse)
-(defvar gnus-tmp-indent)
-
-(defun gnus-generate-tree (thread)
- "Generate a thread tree for THREAD."
- (with-current-buffer (gnus-get-tree-buffer)
- (let ((buffer-read-only nil)
- (gnus-tmp-indent 0))
- (erase-buffer)
- (funcall gnus-generate-tree-function thread 0)
- (gnus-set-mode-line 'tree)
- (goto-char (point-min))
- (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))))))
-
-(defun gnus-generate-horizontal-tree (thread level &optional dummyp adopted)
- "Generate a horizontal tree."
- (let* ((dummy (stringp (car thread)))
- (do (or dummy
- (and (car thread)
- (memq (mail-header-number (car thread))
- gnus-tmp-limit))))
- col beg)
- (if (not do)
- ;; We don't want this article.
- (setq thread (cdr thread))
- (if (not (bolp))
- ;; Not the first article on the line, so we insert a "-".
- (insert (car gnus-tree-parent-child-edges))
- ;; If the level isn't zero, then we insert some indentation.
- (unless (zerop level)
- (gnus-tree-indent level)
- (insert (cadr gnus-tree-parent-child-edges))
- (setq col (- (setq beg (point)) (gnus-point-at-bol) 1))
- ;; Draw "|" lines upwards.
- (while (progn
- (forward-line -1)
- (forward-char col)
- (eq (char-after) ? ))
- (delete-char 1)
- (insert (caddr gnus-tree-parent-child-edges)))
- (goto-char beg)))
- (setq dummyp nil)
- ;; Insert the article node.
- (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted))
- (if (null thread)
- ;; End of the thread, so we go to the next line.
- (unless (bolp)
- (insert "\n"))
- ;; Recurse downwards in all children of this article.
- (while thread
- (gnus-generate-horizontal-tree
- (pop thread) (if do (1+ level) level)
- (or dummyp dummy) dummy)))))
-
-(defsubst gnus-tree-indent-vertical ()
- (let ((len (- (* (1+ gnus-tree-node-length) gnus-tmp-indent)
- (- (point) (gnus-point-at-bol)))))
- (when (> len 0)
- (insert (make-string len ? )))))
-
-(defsubst gnus-tree-forward-line (n)
- (while (>= (decf n) 0)
- (unless (zerop (forward-line 1))
- (end-of-line)
- (insert "\n")))
- (end-of-line))
-
-(defun gnus-generate-vertical-tree (thread level &optional dummyp adopted)
- "Generate a vertical tree."
- (let* ((dummy (stringp (car thread)))
- (do (or dummy
- (and (car thread)
- (memq (mail-header-number (car thread))
- gnus-tmp-limit))))
- beg)
- (if (not do)
- ;; We don't want this article.
- (setq thread (cdr thread))
- (if (not (save-excursion (beginning-of-line) (bobp)))
- ;; Not the first article on the line, so we insert a "-".
- (progn
- (gnus-tree-indent-vertical)
- (insert (make-string (/ gnus-tree-node-length 2) ? ))
- (insert (caddr gnus-tree-parent-child-edges))
- (gnus-tree-forward-line 1))
- ;; If the level isn't zero, then we insert some indentation.
- (unless (zerop gnus-tmp-indent)
- (gnus-tree-forward-line (1- (* 2 level)))
- (gnus-tree-indent-vertical)
- (delete-char -1)
- (insert (cadr gnus-tree-parent-child-edges))
- (setq beg (point))
- (forward-char -1)
- ;; Draw "-" lines leftwards.
- (while (and (not (bobp))
- (eq (char-after (1- (point))) ? ))
- (delete-char -1)
- (insert (car gnus-tree-parent-child-edges))
- (forward-char -1))
- (goto-char beg)
- (gnus-tree-forward-line 1)))
- (setq dummyp nil)
- ;; Insert the article node.
- (gnus-tree-indent-vertical)
- (gnus-tree-node-insert (pop thread) gnus-tmp-sparse adopted)
- (gnus-tree-forward-line 1))
- (if (null thread)
- ;; End of the thread, so we go to the next line.
- (progn
- (goto-char (point-min))
- (end-of-line)
- (incf gnus-tmp-indent))
- ;; Recurse downwards in all children of this article.
- (while thread
- (gnus-generate-vertical-tree
- (pop thread) (if do (1+ level) level)
- (or dummyp dummy) dummy)))))
-
-;;; Interface functions.
-
-(defun gnus-possibly-generate-tree (article &optional force)
- "Generate the thread tree for ARTICLE if it isn't displayed already."
- (when (with-current-buffer gnus-summary-buffer
- (and gnus-use-trees
- gnus-show-threads
- (vectorp (gnus-summary-article-header article))))
- (save-excursion
- (let ((top (with-current-buffer gnus-summary-buffer
- (gnus-cut-thread
- (gnus-remove-thread
- (mail-header-id
- (gnus-summary-article-header article))
- t))))
- (gnus-tmp-limit gnus-newsgroup-limit)
- (gnus-tmp-sparse gnus-newsgroup-sparse))
- (when (or force
- (not (eq top gnus-tree-displayed-thread)))
- (gnus-generate-tree top)
- (setq gnus-tree-displayed-thread top))))))
-
-(defun gnus-tree-open (group)
- (gnus-get-tree-buffer))
-
-(defun gnus-tree-close (group)
- (gnus-kill-buffer gnus-tree-buffer))
-
-(defun gnus-tree-perhaps-minimize ()
- (when (and gnus-tree-minimize-window
- (get-buffer gnus-tree-buffer))
- (with-current-buffer gnus-tree-buffer
- (gnus-tree-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)))
-
-(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))))))
-
-;;;
-;;; gnus-carpal
-;;;
-
-(defvar gnus-carpal-group-buffer-buttons
- '(("next" . gnus-group-next-unread-group)
- ("prev" . gnus-group-prev-unread-group)
- ("read" . gnus-group-read-group)
- ("select" . gnus-group-select-group)
- ("catch-up" . gnus-group-catchup-current)
- ("new-news" . gnus-group-get-new-news-this-group)
- ("toggle-sub" . gnus-group-unsubscribe-current-group)
- ("subscribe" . gnus-group-unsubscribe-group)
- ("kill" . gnus-group-kill-group)
- ("yank" . gnus-group-yank-group)
- ("describe" . gnus-group-describe-group)
- "list"
- ("subscribed" . gnus-group-list-groups)
- ("all" . gnus-group-list-all-groups)
- ("killed" . gnus-group-list-killed)
- ("zombies" . gnus-group-list-zombies)
- ("matching" . gnus-group-list-matching)
- ("post" . gnus-group-post-news)
- ("mail" . gnus-group-mail)
- ("local" . (lambda () (interactive) (gnus-group-news 0)))
- ("rescan" . gnus-group-get-new-news)
- ("browse-foreign" . gnus-group-browse-foreign)
- ("exit" . gnus-group-exit)))
-
-(defvar gnus-carpal-summary-buffer-buttons
- '("mark"
- ("read" . gnus-summary-mark-as-read-forward)
- ("tick" . gnus-summary-tick-article-forward)
- ("clear" . gnus-summary-clear-mark-forward)
- ("expirable" . gnus-summary-mark-as-expirable)
- "move"
- ("scroll" . gnus-summary-next-page)
- ("next-unread" . gnus-summary-next-unread-article)
- ("prev-unread" . gnus-summary-prev-unread-article)
- ("first" . gnus-summary-first-unread-article)
- ("best" . gnus-summary-best-unread-article)
- "article"
- ("headers" . gnus-summary-toggle-header)
- ("uudecode" . gnus-uu-decode-uu)
- ("enter-digest" . gnus-summary-enter-digest-group)
- ("fetch-parent" . gnus-summary-refer-parent-article)
- "mail"
- ("move" . gnus-summary-move-article)
- ("copy" . gnus-summary-copy-article)
- ("respool" . gnus-summary-respool-article)
- "threads"
- ("lower" . gnus-summary-lower-thread)
- ("kill" . gnus-summary-kill-thread)
- "post"
- ("post" . gnus-summary-post-news)
- ("local" . gnus-summary-news-other-window)
- ("mail" . gnus-summary-mail-other-window)
- ("followup" . gnus-summary-followup-with-original)
- ("reply" . gnus-summary-reply-with-original)
- ("cancel" . gnus-summary-cancel-article)
- "misc"
- ("exit" . gnus-summary-exit)
- ("fed-up" . gnus-summary-catchup-and-goto-next-group)))
-
-(defvar gnus-carpal-server-buffer-buttons
- '(("add" . gnus-server-add-server)
- ("browse" . gnus-server-browse-server)
- ("list" . gnus-server-list-servers)
- ("kill" . gnus-server-kill-server)
- ("yank" . gnus-server-yank-server)
- ("copy" . gnus-server-copy-server)
- ("exit" . gnus-server-exit)))
-
-(defvar gnus-carpal-browse-buffer-buttons
- '(("subscribe" . gnus-browse-unsubscribe-current-group)
- ("exit" . gnus-browse-exit)))
-
-(defvar gnus-carpal-group-buffer "*Carpal Group*")
-(defvar gnus-carpal-summary-buffer "*Carpal Summary*")
-(defvar gnus-carpal-server-buffer "*Carpal Server*")
-(defvar gnus-carpal-browse-buffer "*Carpal Browse*")
-
-(defvar gnus-carpal-attached-buffer nil)
-
-(defvar gnus-carpal-mode-hook nil
- "*Hook run in carpal mode buffers.")
-
-(defvar gnus-carpal-button-face 'bold
- "*Face used on carpal buttons.")
-
-(defvar gnus-carpal-header-face 'bold-italic
- "*Face used on carpal buffer headers.")
-
-(defvar gnus-carpal-mode-map nil)
-(put 'gnus-carpal-mode 'mode-class 'special)
-
-(if gnus-carpal-mode-map
- nil
- (setq gnus-carpal-mode-map (make-keymap))
- (suppress-keymap gnus-carpal-mode-map)
- (define-key gnus-carpal-mode-map " " 'gnus-carpal-select)
- (define-key gnus-carpal-mode-map "\r" 'gnus-carpal-select)
- (define-key gnus-carpal-mode-map gnus-mouse-2 'gnus-carpal-mouse-select))
-
-(defun gnus-carpal-mode ()
- "Major mode for clicking buttons.
-
-All normal editing commands are switched off.
-\\<gnus-carpal-mode-map>
-The following commands are available:
-
-\\{gnus-carpal-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq mode-line-modified (cdr gnus-mode-line-modified))
- (setq major-mode 'gnus-carpal-mode)
- (setq mode-name "Gnus Carpal")
- (setq mode-line-process nil)
- (use-local-map gnus-carpal-mode-map)
- (buffer-disable-undo)
- (setq buffer-read-only t)
- (make-local-variable 'gnus-carpal-attached-buffer)
- (gnus-run-mode-hooks 'gnus-carpal-mode-hook))
-
-(defun gnus-carpal-setup-buffer (type)
- (let ((buffer (symbol-value (intern (format "gnus-carpal-%s-buffer" type)))))
- (if (get-buffer buffer)
- ()
- (with-current-buffer (gnus-get-buffer-create buffer)
- (gnus-carpal-mode)
- (setq gnus-carpal-attached-buffer
- (intern (format "gnus-%s-buffer" type)))
- (let ((buttons (symbol-value
- (intern (format "gnus-carpal-%s-buffer-buttons"
- type))))
- (buffer-read-only nil)
- button)
- (while buttons
- (setq button (car buttons)
- buttons (cdr buttons))
- (if (stringp button)
- (gnus-set-text-properties
- (point)
- (prog2 (insert button) (point) (insert " "))
- (list 'face gnus-carpal-header-face))
- (gnus-set-text-properties
- (point)
- (prog2 (insert (car button)) (point) (insert " "))
- (list 'gnus-callback (cdr button)
- 'face gnus-carpal-button-face
- gnus-mouse-face-prop 'highlight))))
- (let ((fill-column (- (window-width) 2)))
- (fill-region (point-min) (point-max)))
- (set-window-point (get-buffer-window (current-buffer))
- (point-min)))))))
-
-(defun gnus-carpal-select ()
- "Select the button under point."
- (interactive)
- (let ((func (get-text-property (point) 'gnus-callback)))
- (if (null func)
- ()
- (pop-to-buffer (symbol-value gnus-carpal-attached-buffer))
- (call-interactively func))))
-
-(defun gnus-carpal-mouse-select (event)
- "Select the button under the mouse pointer."
- (interactive "e")
- (mouse-set-point event)
- (gnus-carpal-select))
-
-;;; Allow redefinition of functions.
-(gnus-ems-redefine)
-
-(provide 'gnus-salt)
-
-;; arch-tag: 35449164-77b3-4398-bcbd-a2e3e998f810
-;;; gnus-salt.el ends here
+++ /dev/null
-;;; gnus-score.el --- scoring code for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <amanda@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'gnus-range)
-(require 'gnus-win)
-(require 'message)
-(require 'score-mode)
-
-(autoload 'ffap-string-at-point "ffap")
-
-(defcustom gnus-global-score-files nil
- "List of global score files and directories.
-Set this variable if you want to use people's score files. One entry
-for each score file or each score file directory. Gnus will decide
-by itself what score files are applicable to which group.
-
-Say you want to use the single score file
-\"/ftp.gnus.org@ftp:/pub/larsi/ding/score/soc.motss.SCORE\" and all
-score files in the \"/ftp.some-where:/pub/score\" directory.
-
- (setq gnus-global-score-files
- '(\"/ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE\"
- \"/ftp.some-where:/pub/score\"))"
- :group 'gnus-score-files
- :type '(repeat file))
-
-(defcustom gnus-score-file-single-match-alist nil
- "Alist mapping regexps to lists of score files.
-Each element of this alist should be of the form
- (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
-
-If the name of a group is matched by REGEXP, the corresponding scorefiles
-will be used for that group.
-The first match found is used, subsequent matching entries are ignored (to
-use multiple matches, see `gnus-score-file-multiple-match-alist').
-
-These score files are loaded in addition to any files returned by
-`gnus-score-find-score-files-function'."
- :group 'gnus-score-files
- :type '(repeat (cons regexp (repeat file))))
-
-(defcustom gnus-score-file-multiple-match-alist nil
- "Alist mapping regexps to lists of score files.
-Each element of this alist should be of the form
- (\"REGEXP\" [ \"SCORE-FILE-1\" ] [ \"SCORE-FILE-2\" ] ... )
-
-If the name of a group is matched by REGEXP, the corresponding scorefiles
-will be used for that group.
-If multiple REGEXPs match a group, the score files corresponding to each
-match will be used (for only one match to be used, see
-`gnus-score-file-single-match-alist').
-
-These score files are loaded in addition to any files returned by
-`gnus-score-find-score-files-function'."
- :group 'gnus-score-files
- :type '(repeat (cons regexp (repeat file))))
-
-(defcustom gnus-score-file-suffix "SCORE"
- "Suffix of the score files."
- :group 'gnus-score-files
- :type 'string)
-
-(defcustom gnus-adaptive-file-suffix "ADAPT"
- "Suffix of the adaptive score files."
- :group 'gnus-score-files
- :group 'gnus-score-adapt
- :type 'string)
-
-(defcustom gnus-score-find-score-files-function 'gnus-score-find-bnews
- "Function used to find score files.
-The function will be called with the group name as the argument, and
-should return a list of score files to apply to that group. The score
-files do not actually have to exist.
-
-Predefined values are:
-
-`gnus-score-find-single': Only apply the group's own score file.
-`gnus-score-find-hierarchical': Also apply score files from parent groups.
-`gnus-score-find-bnews': Apply score files whose names matches.
-
-See the documentation to these functions for more information.
-
-This variable can also be a list of functions to be called. Each
-function is given the group name as argument and should either return
-a list of score files, or a list of score alists.
-
-If functions other than these pre-defined functions are used,
-the `a' symbolic prefix to the score commands will always use
-\"all.SCORE\"."
- :group 'gnus-score-files
- :type '(radio (function-item gnus-score-find-single)
- (function-item gnus-score-find-hierarchical)
- (function-item gnus-score-find-bnews)
- (repeat :tag "List of functions"
- (choice (function :tag "Other" :value 'ignore)
- (function-item gnus-score-find-single)
- (function-item gnus-score-find-hierarchical)
- (function-item gnus-score-find-bnews)))
- (function :tag "Other" :value 'ignore)))
-
-(defcustom gnus-score-interactive-default-score 1000
- "*Scoring commands will raise/lower the score with this number as the default."
- :group 'gnus-score-default
- :type 'integer)
-
-(defcustom gnus-score-expiry-days 7
- "*Number of days before unused score file entries are expired.
-If this variable is nil, no score file entries will be expired."
- :group 'gnus-score-expire
- :type '(choice (const :tag "never" nil)
- number))
-
-(defcustom gnus-update-score-entry-dates t
- "*If non-nil, update matching score entry dates.
-If this variable is nil, then score entries that provide matches
-will be expired along with non-matching score entries."
- :group 'gnus-score-expire
- :type 'boolean)
-
-(defcustom gnus-decay-scores nil
- "*If non-nil, decay non-permanent scores."
- :group 'gnus-score-decay
- :type 'boolean)
-
-(defcustom gnus-decay-score-function 'gnus-decay-score
- "*Function called to decay a score.
-It is called with one parameter -- the score to be decayed."
- :group 'gnus-score-decay
- :type '(radio (function-item gnus-decay-score)
- (function :tag "Other")))
-
-(defcustom gnus-score-decay-constant 3
- "*Decay all \"small\" scores with this amount."
- :group 'gnus-score-decay
- :type 'integer)
-
-(defcustom gnus-score-decay-scale .05
- "*Decay all \"big\" scores with this factor."
- :group 'gnus-score-decay
- :type 'number)
-
-(defcustom gnus-home-score-file nil
- "Variable to control where interactive score entries are to go.
-It can be:
-
- * A string
- This file will be used as the home score file.
-
- * A function
- The result of this function will be used as the home score file.
- The function will be passed the name of the group as its
- parameter.
-
- * A list
- The elements in this list can be:
-
- * `(regexp file-name ...)'
- If the `regexp' matches the group name, the first `file-name'
- will be used as the home score file. (Multiple filenames are
- allowed so that one may use gnus-score-file-single-match-alist to
- set this variable.)
-
- * A function.
- If the function returns non-nil, the result will be used
- as the home score file. The function will be passed the
- name of the group as its parameter.
-
- * A string. Use the string as the home score file.
-
- The list will be traversed from the beginning towards the end looking
- for matches."
- :group 'gnus-score-files
- :type '(choice string
- (repeat (choice string
- (cons regexp (repeat file))
- function))
- (function-item gnus-hierarchial-home-score-file)
- (function-item gnus-current-home-score-file)
- function))
-
-(defcustom gnus-home-adapt-file nil
- "Variable to control where new adaptive score entries are to go.
-This variable allows the same syntax as `gnus-home-score-file'."
- :group 'gnus-score-adapt
- :group 'gnus-score-files
- :type '(choice string
- (repeat (choice string
- (cons regexp (repeat file))
- function))
- function))
-
-(defcustom gnus-default-adaptive-score-alist
- `((gnus-kill-file-mark)
- (gnus-unread-mark)
- (gnus-read-mark
- (from , (+ 2 gnus-score-decay-constant))
- (subject , (+ 27 gnus-score-decay-constant)))
- (gnus-catchup-mark
- (subject , (+ -7 (* -1 gnus-score-decay-constant))))
- (gnus-killed-mark
- (from , (- -1 gnus-score-decay-constant))
- (subject , (+ -17 (* -1 gnus-score-decay-constant))))
- (gnus-del-mark
- (from , (- -1 gnus-score-decay-constant))
- (subject , (+ -12 (* -1 gnus-score-decay-constant)))))
- "Alist of marks and scores.
-If you use score decays, you might want to set values higher than
-`gnus-score-decay-constant'."
- :group 'gnus-score-adapt
- :type '(repeat (cons (symbol :tag "Mark")
- (repeat (list (choice :tag "Header"
- (const from)
- (const subject)
- (symbol :tag "other"))
- (integer :tag "Score"))))))
-
-(defcustom gnus-adaptive-word-length-limit nil
- "*Words of a length lesser than this limit will be ignored when doing adaptive scoring."
- :version "22.1"
- :group 'gnus-score-adapt
- :type '(radio (const :format "Unlimited " nil)
- (integer :format "Maximum length: %v")))
-
-(defcustom gnus-ignored-adaptive-words nil
- "List of words to be ignored when doing adaptive word scoring."
- :group 'gnus-score-adapt
- :type '(repeat string))
-
-(defcustom gnus-default-ignored-adaptive-words
- '("a" "i" "the" "to" "of" "and" "in" "is" "it" "for" "that" "if" "you"
- "this" "be" "on" "with" "not" "have" "are" "or" "as" "from" "can"
- "but" "by" "at" "an" "will" "no" "all" "was" "do" "there" "my" "one"
- "so" "we" "they" "what" "would" "any" "which" "about" "get" "your"
- "use" "some" "me" "then" "name" "like" "out" "when" "up" "time"
- "other" "more" "only" "just" "end" "also" "know" "how" "new" "should"
- "been" "than" "them" "he" "who" "make" "may" "people" "these" "now"
- "their" "here" "into" "first" "could" "way" "had" "see" "work" "well"
- "were" "two" "very" "where" "while" "us" "because" "good" "same"
- "even" "much" "most" "many" "such" "long" "his" "over" "last" "since"
- "right" "before" "our" "without" "too" "those" "why" "must" "part"
- "being" "current" "back" "still" "go" "point" "value" "each" "did"
- "both" "true" "off" "say" "another" "state" "might" "under" "start"
- "try" "re")
- "*Default list of words to be ignored when doing adaptive word scoring."
- :group 'gnus-score-adapt
- :type '(repeat string))
-
-(defcustom gnus-default-adaptive-word-score-alist
- `((,gnus-read-mark . 30)
- (,gnus-catchup-mark . -10)
- (,gnus-killed-mark . -20)
- (,gnus-del-mark . -15))
- "*Alist of marks and scores."
- :group 'gnus-score-adapt
- :type '(repeat (cons (character :tag "Mark")
- (integer :tag "Score"))))
-
-(defcustom gnus-adaptive-word-minimum nil
- "If a number, this is the minimum score value that can be assigned to a word."
- :group 'gnus-score-adapt
- :type '(choice (const nil) integer))
-
-(defcustom gnus-adaptive-word-no-group-words nil
- "If t, don't adaptively score words included in the group name."
- :group 'gnus-score-adapt
- :type 'boolean)
-
-(defcustom gnus-score-mimic-keymap nil
- "*Have the score entry functions pretend that they are a keymap."
- :group 'gnus-score-default
- :type 'boolean)
-
-(defcustom gnus-score-exact-adapt-limit 10
- "*Number that says how long a match has to be before using substring matching.
-When doing adaptive scoring, one normally uses fuzzy or substring
-matching. However, if the header one matches is short, the possibility
-for false positives is great, so if the length of the match is less
-than this variable, exact matching will be used.
-
-If this variable is nil, exact matching will always be used."
- :group 'gnus-score-adapt
- :type '(choice (const nil) integer))
-
-(defcustom gnus-score-uncacheable-files "ADAPT$"
- "All score files that match this regexp will not be cached."
- :group 'gnus-score-adapt
- :group 'gnus-score-files
- :type 'regexp)
-
-(defcustom 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
- e: `extra' (non-standard overview)
- l: lines
- d: date
- f: followup
-
-If nil, the user will be asked for a header."
- :group 'gnus-score-default
- :type '(choice (const :tag "from" a)
- (const :tag "subject" s)
- (const :tag "body" b)
- (const :tag "head" h)
- (const :tag "message-id" i)
- (const :tag "references" t)
- (const :tag "xref" x)
- (const :tag "extra" e)
- (const :tag "lines" l)
- (const :tag "date" d)
- (const :tag "followup" f)
- (const :tag "ask" nil)))
-
-(defcustom 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: after date
- n: this date
- <: less than number
- >: greater than number
- =: equal to number
-
-If nil, the user will be asked for a match type."
- :group 'gnus-score-default
- :type '(choice (const :tag "substring" s)
- (const :tag "exact string" e)
- (const :tag "fuzzy string" f)
- (const :tag "regexp string" r)
- (const :tag "before date" b)
- (const :tag "after date" a)
- (const :tag "this date" n)
- (const :tag "less than number" <)
- (const :tag "greater than number" >)
- (const :tag "equal than number" =)
- (const :tag "ask" nil)))
-
-(defcustom gnus-score-default-fold nil
- "Non-nil means use case folding for new score file entries."
- :group 'gnus-score-default
- :type 'boolean)
-
-(defcustom 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."
- :group 'gnus-score-default
- :type '(choice (const :tag "temporary" t)
- (const :tag "permanent" p)
- (const :tag "immediate" i)
- (const :tag "ask" nil)))
-
-(defcustom gnus-score-after-write-file-function nil
- "Function called with the name of the score file just written to disk."
- :group 'gnus-score-files
- :type '(choice (const nil) function))
-
-(defcustom gnus-score-thread-simplify nil
- "If non-nil, subjects will simplified as in threading."
- :group 'gnus-score-various
- :type 'boolean)
-
-\f
-
-;; Internal variables.
-
-(defvar gnus-score-use-all-scores t
- "If nil, only `gnus-score-find-score-files-function' is used.")
-
-(defvar gnus-adaptive-word-syntax-table
- (let ((table (copy-syntax-table (standard-syntax-table)))
- (numbers '(?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9)))
- (while numbers
- (modify-syntax-entry (pop numbers) " " table))
- (modify-syntax-entry ?' "w" table)
- table)
- "Syntax table used when doing adaptive word scoring.")
-
-(defvar gnus-scores-exclude-files nil)
-(defvar gnus-internal-global-score-files nil)
-(defvar gnus-score-file-list nil)
-
-(defvar gnus-short-name-score-file-cache nil)
-
-(defvar gnus-score-help-winconf nil)
-(defvar gnus-adaptive-score-alist gnus-default-adaptive-score-alist)
-(defvar gnus-adaptive-word-score-alist gnus-default-adaptive-word-score-alist)
-(defvar gnus-score-trace nil)
-(defvar gnus-score-edit-buffer nil)
-
-(defvar gnus-score-alist nil
- "Alist containing score information.
-The keys can be symbols or strings. The following symbols are defined.
-
-touched: If this alist has been modified.
-mark: Automatically mark articles below this.
-expunge: Automatically expunge articles below this.
-files: List of other score files to load when loading this one.
-eval: Sexp to be evaluated when the score file is loaded.
-
-String entries have the form (HEADER (MATCH TYPE SCORE DATE) ...)
-where HEADER is the header being scored, MATCH is the string we are
-looking for, TYPE is a flag indicating whether it should use regexp or
-substring matching, SCORE is the score to add and DATE is the date
-of the last successful match.")
-
-(defvar gnus-score-cache nil)
-(defvar gnus-scores-articles nil)
-(defvar gnus-score-index nil)
-
-
-(defconst gnus-header-index
- ;; Name to index alist.
- '(("number" 0 gnus-score-integer)
- ("subject" 1 gnus-score-string)
- ("from" 2 gnus-score-string)
- ("date" 3 gnus-score-date)
- ("message-id" 4 gnus-score-string)
- ("references" 5 gnus-score-string)
- ("chars" 6 gnus-score-integer)
- ("lines" 7 gnus-score-integer)
- ("xref" 8 gnus-score-string)
- ("extra" 9 gnus-score-string)
- ("head" -1 gnus-score-body)
- ("body" -1 gnus-score-body)
- ("all" -1 gnus-score-body)
- ("followup" 2 gnus-score-followup)
- ("thread" 5 gnus-score-thread)))
-
-;;; Summary mode score maps.
-
-(gnus-define-keys (gnus-summary-score-map "V" gnus-summary-mode-map)
- "s" gnus-summary-set-score
- "S" gnus-summary-current-score
- "c" gnus-score-change-score-file
- "C" gnus-score-customize
- "m" gnus-score-set-mark-below
- "x" gnus-score-set-expunge-below
- "R" gnus-summary-rescore
- "e" gnus-score-edit-current-scores
- "f" gnus-score-edit-file
- "F" gnus-score-flush-cache
- "t" gnus-score-find-trace
- "w" gnus-score-find-favourite-words)
-
-;; Summary score file commands
-
-;; Much modification of the kill (ahem, score) code and lots of the
-;; functions are written by Per Abrahamsen <amanda@iesd.auc.dk>.
-
-(defun gnus-summary-lower-score (&optional score symp)
- "Make a score entry based on the current article.
-The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
- (interactive (gnus-interactive "P\ny"))
- (gnus-summary-increase-score (- (gnus-score-delta-default score)) symp))
-
-(defun gnus-score-kill-help-buffer ()
- (when (get-buffer "*Score Help*")
- (kill-buffer "*Score Help*")
- (when gnus-score-help-winconf
- (set-window-configuration gnus-score-help-winconf))))
-
-(defun gnus-summary-increase-score (&optional score symp)
- "Make a score entry based on the current article.
-The user will be prompted for header to score on, match type,
-permanence, and the string to be used. The numerical prefix will be
-used as score. A symbolic prefix of `a' says to use the `all.SCORE'
-file for the command instead of the current score file."
- (interactive (gnus-interactive "P\ny"))
- (let* ((nscore (gnus-score-delta-default score))
- (prefix (if (< nscore 0) ?L ?I))
- (increase (> nscore 0))
- (char-to-header
- '((?a "from" nil nil string)
- (?s "subject" nil nil string)
- (?b "body" "" nil body-string)
- (?h "head" "" nil body-string)
- (?i "message-id" nil nil string)
- (?r "references" "message-id" nil string)
- (?x "xref" nil nil string)
- (?e "extra" nil nil string)
- (?l "lines" nil nil number)
- (?d "date" nil nil date)
- (?f "followup" nil nil string)
- (?t "thread" "message-id" nil string)))
- (char-to-type
- '((?s s "substring" string)
- (?e e "exact string" string)
- (?f f "fuzzy string" string)
- (?r r "regexp string" string)
- (?z s "substring" body-string)
- (?p r "regexp string" body-string)
- (?b before "before date" date)
- (?a after "after date" date)
- (?n at "this date" date)
- (?< < "less than number" number)
- (?> > "greater than number" number)
- (?= = "equal to number" number)))
- (current-score-file gnus-current-score-file)
- (char-to-perm
- (list (list ?t (current-time-string) "temporary")
- '(?p perm "permanent") '(?i now "immediate")))
- (mimic gnus-score-mimic-keymap)
- (hchar (and gnus-score-default-header
- (aref (symbol-name gnus-score-default-header) 0)))
- (tchar (and gnus-score-default-type
- (aref (symbol-name gnus-score-default-type) 0)))
- (pchar (and gnus-score-default-duration
- (aref (symbol-name gnus-score-default-duration) 0)))
- entry temporary type match extra)
-
- (unwind-protect
- (progn
-
- ;; First we read the header to score.
- (while (not hchar)
- (if mimic
- (progn
- (sit-for 1)
- (message "%c-" prefix))
- (message "%s header (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-header "")))
- (setq hchar (read-char))
- (when (or (= hchar ??) (= hchar ?\C-h))
- (setq hchar nil)
- (gnus-score-insert-help "Match on header" char-to-header 1)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq entry (assq (downcase hchar) char-to-header))
- (if mimic (error "%c %c" prefix hchar)
- (error "Invalid header type")))
-
- (when (/= (downcase hchar) hchar)
- ;; This was a majuscule, so we end reading and set the defaults.
- (if mimic (message "%c %c" prefix hchar) (message ""))
- (setq tchar (or tchar ?s)
- pchar (or pchar ?t)))
-
- (let ((legal-types
- (delq nil
- (mapcar (lambda (s)
- (if (eq (nth 4 entry)
- (nth 3 s))
- s nil))
- char-to-type))))
- ;; We continue reading - the type.
- (while (not tchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c-" prefix hchar))
- (message "%s header '%s' with match type (%s?): "
- (if increase "Increase" "Lower")
- (nth 1 entry)
- (mapconcat (lambda (s) (char-to-string (car s)))
- legal-types "")))
- (setq tchar (read-char))
- (when (or (= tchar ??) (= tchar ?\C-h))
- (setq tchar nil)
- (gnus-score-insert-help "Match type" legal-types 2)))
-
- (gnus-score-kill-help-buffer)
- (unless (setq type (nth 1 (assq (downcase tchar) legal-types)))
- (if mimic (error "%c %c" prefix hchar)
- (error "Invalid match type"))))
-
- (when (/= (downcase tchar) tchar)
- ;; It was a majuscule, so we end reading and use the default.
- (if mimic (message "%c %c %c" prefix hchar tchar)
- (message ""))
- (setq pchar (or pchar ?t)))
-
- ;; We continue reading.
- (while (not pchar)
- (if mimic
- (progn
- (sit-for 1) (message "%c %c %c-" prefix hchar tchar))
- (message "%s permanence (%s?): " (if increase "Increase" "Lower")
- (mapconcat (lambda (s) (char-to-string (car s)))
- char-to-perm "")))
- (setq pchar (read-char))
- (when (or (= pchar ??) (= pchar ?\C-h))
- (setq pchar nil)
- (gnus-score-insert-help "Match permanence" char-to-perm 2)))
-
- (gnus-score-kill-help-buffer)
- (if mimic (message "%c %c %c %c" prefix hchar tchar pchar)
- (message ""))
- (unless (setq temporary (cadr (assq pchar char-to-perm)))
- ;; Deal with der(r)ided superannuated paradigms.
- (when (and (eq (1+ prefix) 77)
- (eq (+ hchar 12) 109)
- (eq (1- tchar) 113)
- (eq (- pchar 4) 111))
- (error "You rang?"))
- (if mimic
- (error "%c %c %c %c" prefix hchar tchar pchar)
- (error "Invalid match duration"))))
- ;; Always kill the score help buffer.
- (gnus-score-kill-help-buffer))
-
- ;; If scoring an extra (non-standard overview) header,
- ;; we must find out which header is in question.
- (setq extra
- (and gnus-extra-headers
- (equal (nth 1 entry) "extra")
- (intern ; need symbol
- (gnus-completing-read-with-default
- (symbol-name (car gnus-extra-headers)) ; default response
- "Score extra header" ; prompt
- (mapcar (lambda (x) ; completion list
- (cons (symbol-name x) x))
- gnus-extra-headers)
- nil ; no completion limit
- t)))) ; require match
- ;; extra is now nil or a symbol.
-
- ;; We have all the data, so we enter this score.
- (setq match (if (string= (nth 2 entry) "") ""
- (gnus-summary-header (or (nth 2 entry) (nth 1 entry))
- nil extra)))
-
- ;; Modify the match, perhaps.
- (cond
- ((equal (nth 1 entry) "xref")
- (when (string-match "^Xref: *" match)
- (setq match (substring match (match-end 0))))
- (when (string-match "^[^:]* +" match)
- (setq match (substring match (match-end 0))))))
-
- (when (memq type '(r R regexp Regexp))
- (setq match (regexp-quote match)))
-
- ;; Change score file to the "all.SCORE" file.
- (when (eq symp 'a)
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-score-load-file
- ;; This is a kludge; yes...
- (cond
- ((eq gnus-score-find-score-files-function
- 'gnus-score-find-hierarchical)
- (gnus-score-file-name ""))
- ((eq gnus-score-find-score-files-function 'gnus-score-find-single)
- current-score-file)
- (t
- (gnus-score-file-name "all"))))))
-
- (gnus-summary-score-entry
- (nth 1 entry) ; Header
- match ; Match
- type ; Type
- (if (eq score 's) nil score) ; Score
- (if (eq temporary 'perm) ; Temp
- nil
- temporary)
- (not (nth 3 entry)) ; Prompt
- nil ; not silent
- extra) ; non-standard overview.
-
- (when (eq symp 'a)
- ;; We change the score file back to the previous one.
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-score-load-file current-score-file)))))
-
-(defun gnus-score-insert-help (string alist idx)
- (setq gnus-score-help-winconf (current-window-configuration))
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*Score Help*"))
- (buffer-disable-undo)
- (delete-windows-on (current-buffer))
- (erase-buffer)
- (insert string ":\n\n")
- (let ((max -1)
- (list alist)
- (i 0)
- n width pad format)
- ;; find the longest string to display
- (while list
- (setq n (length (nth idx (car list))))
- (unless (> max n)
- (setq max n))
- (setq list (cdr list)))
- (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
- (setq n (/ (1- (window-width)) max)) ; items per line
- (setq width (/ (1- (window-width)) n)) ; width of each item
- ;; insert `n' items, each in a field of width `width'
- (while alist
- (if (< i n)
- ()
- (setq i 0)
- (delete-char -1) ; the `\n' takes a char
- (insert "\n"))
- (setq pad (- width 3))
- (setq format (concat "%c: %-" (int-to-string pad) "s"))
- (insert (format format (caar alist) (nth idx (car alist))))
- (setq alist (cdr alist))
- (setq i (1+ i))))
- (goto-char (point-min))
- ;; display ourselves in a small window at the bottom
- (gnus-appt-select-lowest-window)
- (if (< (/ (window-height) 2) window-min-height)
- (switch-to-buffer "*Score Help*")
- (split-window)
- (pop-to-buffer "*Score Help*"))
- (let ((window-min-height 1))
- (shrink-window-if-larger-than-buffer))
- (select-window (gnus-get-buffer-window gnus-summary-buffer t))))
-
-(defun gnus-summary-header (header &optional no-err extra)
- ;; Return HEADER for current articles, or error.
- (let ((article (gnus-summary-article-number))
- headers)
- (if article
- (if (and (setq headers (gnus-summary-article-header article))
- (vectorp headers))
- (if extra ; `header' must be "extra"
- (or (cdr (assq extra (mail-header-extra headers))) "")
- (aref headers (nth 1 (assoc header gnus-header-index))))
- (if no-err
- nil
- (error "Pseudo-articles can't be scored")))
- (if no-err
- (error "No article on current line")
- nil))))
-
-(defun gnus-newsgroup-score-alist ()
- (or
- (let ((param-file (gnus-group-find-parameter
- gnus-newsgroup-name 'score-file)))
- (when param-file
- (gnus-score-load param-file)))
- (gnus-score-load
- (gnus-score-file-name gnus-newsgroup-name)))
- gnus-score-alist)
-
-(defsubst gnus-score-get (symbol &optional alist)
- ;; Get SYMBOL's definition in ALIST.
- (cdr (assoc symbol
- (or alist
- gnus-score-alist
- (gnus-newsgroup-score-alist)))))
-
-(defun gnus-summary-score-entry (header match type score date
- &optional prompt silent extra)
- "Enter score file entry.
-HEADER is the header being scored.
-MATCH is the string we are looking for.
-TYPE is the match type: substring, regexp, exact, fuzzy.
-SCORE is the score to add.
-DATE is the expire date, or nil for no expire, or 'now for immediate expire.
-If optional argument `PROMPT' is non-nil, allow user to edit match.
-If optional argument `SILENT' is nil, show effect of score entry.
-If optional argument `EXTRA' is non-nil, it's a non-standard overview header."
- ;; Regexp is the default type.
- (when (eq type t)
- (setq type 'r))
- ;; Simplify matches...
- (cond ((or (eq type 'r) (eq type 's) (eq type nil))
- (setq match (if match (gnus-simplify-subject-re match) "")))
- ((eq type 'f)
- (setq match (gnus-simplify-subject-fuzzy match))))
- (let ((score (gnus-score-delta-default score))
- (header (downcase header))
- new)
- (set-text-properties 0 (length header) nil header)
- (when prompt
- (setq match (read-string
- (format "Match %s on %s, %s: "
- (cond ((eq date 'now)
- "now")
- ((stringp date)
- "temp")
- (t "permanent"))
- header
- (if (< score 0) "lower" "raise"))
- (if (numberp match)
- (int-to-string match)
- match))))
-
- ;; If this is an integer comparison, we transform from string to int.
- (if (eq (nth 2 (assoc header gnus-header-index)) 'gnus-score-integer)
- (if (stringp match)
- (setq match (string-to-number match)))
- (set-text-properties 0 (length match) nil match))
-
- (unless (eq date 'now)
- ;; Add the score entry to the score file.
- (when (= score gnus-score-interactive-default-score)
- (setq score nil))
- (let ((old (gnus-score-get header))
- elem)
- (setq new
- (cond
- (extra
- (list match score
- (and date (if (numberp date) date
- (date-to-day date)))
- type (symbol-name extra)))
- (type
- (list match score
- (and date (if (numberp date) date
- (date-to-day date)))
- type))
- (date (list match score (date-to-day date)))
- (score (list match score))
- (t (list match))))
- ;; We see whether we can collapse some score entries.
- ;; This isn't quite correct, because there may be more elements
- ;; later on with the same key that have matching elems... Hm.
- (if (and old
- (setq elem (assoc match old))
- (eq (nth 3 elem) (nth 3 new))
- (or (and (numberp (nth 2 elem)) (numberp (nth 2 new)))
- (and (not (nth 2 elem)) (not (nth 2 new)))))
- ;; Yup, we just add this new score to the old elem.
- (setcar (cdr elem) (+ (or (nth 1 elem)
- gnus-score-interactive-default-score)
- (or (nth 1 new)
- gnus-score-interactive-default-score)))
- ;; Nope, we have to add a new elem.
- (gnus-score-set header (if old (cons new old) (list new)) nil t))
- (gnus-score-set 'touched '(t))))
-
- ;; Score the current buffer.
- (unless silent
- (if (and (>= (nth 1 (assoc header gnus-header-index)) 0)
- (eq (nth 2 (assoc header gnus-header-index))
- 'gnus-score-string))
- (gnus-summary-score-effect header match type score extra)
- (gnus-summary-rescore)))
-
- ;; Return the new scoring rule.
- new))
-
-(defun gnus-summary-score-effect (header match type score &optional extra)
- "Simulate the effect of a score file entry.
-HEADER is the header being scored.
-MATCH is the string we are looking for.
-TYPE is the score type.
-SCORE is the score to add.
-EXTRA is the possible non-standard header."
- (interactive (list (completing-read "Header: "
- gnus-header-index
- (lambda (x) (fboundp (nth 2 x)))
- t)
- (read-string "Match: ")
- (if (y-or-n-p "Use regexp match? ") 'r 's)
- (string-to-number (read-string "Score: "))))
- (save-excursion
- (unless (and (stringp match) (> (length match) 0))
- (error "No match"))
- (goto-char (point-min))
- (let ((regexp (cond ((eq type 'f)
- (gnus-simplify-subject-fuzzy match))
- ((eq type 'r)
- match)
- ((eq type 'e)
- (concat "\\`" (regexp-quote match) "\\'"))
- (t
- (regexp-quote match)))))
- (while (not (eobp))
- (let ((content (gnus-summary-header header 'noerr extra))
- (case-fold-search t))
- (and content
- (when (if (eq type 'f)
- (string-equal (gnus-simplify-subject-fuzzy content)
- regexp)
- (string-match regexp content))
- (gnus-summary-raise-score score))))
- (beginning-of-line 2))))
- (gnus-set-mode-line 'summary))
-
-(defun gnus-summary-score-crossposting (score date)
- ;; Enter score file entry for current crossposting.
- ;; SCORE is the score to add.
- ;; DATE is the expire date.
- (let ((xref (gnus-summary-header "xref"))
- (start 0)
- group)
- (unless xref
- (error "This article is not crossposted"))
- (while (string-match " \\([^ \t]+\\):" xref start)
- (setq start (match-end 0))
- (when (not (string=
- (setq group
- (substring xref (match-beginning 1) (match-end 1)))
- gnus-newsgroup-name))
- (gnus-summary-score-entry
- "xref" (concat " " group ":") nil score date t)))))
-
-\f
-;;;
-;;; Gnus Score Files
-;;;
-
-;; All score code written by Per Abrahamsen <abraham@iesd.auc.dk>.
-
-(defun gnus-score-set-mark-below (score)
- "Automatically mark articles with score below SCORE as read."
- (interactive
- (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Mark below: ")))))
- (setq score (or score gnus-summary-default-score 0))
- (gnus-score-set 'mark (list score))
- (gnus-score-set 'touched '(t))
- (setq gnus-summary-mark-below score)
- (gnus-score-update-lines))
-
-(defun gnus-score-update-lines ()
- "Update all lines in the summary buffer."
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (gnus-summary-update-line)
- (forward-line 1))))
-
-(defun gnus-score-update-all-lines ()
- "Update all lines in the summary buffer, even the hidden ones."
- (save-excursion
- (goto-char (point-min))
- (let (hidden)
- (while (not (eobp))
- (when (gnus-summary-show-thread)
- (push (point) hidden))
- (gnus-summary-update-line)
- (forward-line 1))
- ;; Re-hide the hidden threads.
- (while hidden
- (goto-char (pop hidden))
- (gnus-summary-hide-thread)))))
-
-(defun gnus-score-set-expunge-below (score)
- "Automatically expunge articles with score below SCORE."
- (interactive
- (list (or (and current-prefix-arg (prefix-numeric-value current-prefix-arg))
- (string-to-number (read-string "Set expunge below: ")))))
- (setq score (or score gnus-summary-default-score 0))
- (gnus-score-set 'expunge (list score))
- (gnus-score-set 'touched '(t)))
-
-(defun gnus-score-followup-article (&optional score)
- "Add SCORE to all followups to the article in the current buffer."
- (interactive "P")
- (setq score (gnus-score-delta-default score))
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (let ((id (mail-fetch-field "message-id")))
- (when id
- (set-buffer gnus-summary-buffer)
- (gnus-summary-score-entry
- "references" (concat id "[ \t]*$") 'r
- score (current-time-string) nil t)))))))
-
-(defun gnus-score-followup-thread (&optional score)
- "Add SCORE to all later articles in the thread the current buffer is part of."
- (interactive "P")
- (setq score (gnus-score-delta-default score))
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (let ((id (mail-fetch-field "message-id")))
- (when id
- (set-buffer gnus-summary-buffer)
- (gnus-summary-score-entry
- "references" id 's
- score (current-time-string))))))))
-
-(defun gnus-score-set (symbol value &optional alist warn)
- ;; Set SYMBOL to VALUE in ALIST.
- (let* ((alist
- (or alist
- gnus-score-alist
- (gnus-newsgroup-score-alist)))
- (entry (assoc symbol alist)))
- (cond ((gnus-score-get 'read-only alist)
- ;; This is a read-only score file, so we do nothing.
- (when warn
- (gnus-message 4 "Note: read-only score file; entry discarded")))
- (entry
- (setcdr entry value))
- ((null alist)
- (error "Empty alist"))
- (t
- (setcdr alist
- (cons (cons symbol value) (cdr alist)))))))
-
-(defun gnus-summary-raise-score (n)
- "Raise the score of the current article by N."
- (interactive "p")
- (gnus-summary-set-score (+ (gnus-summary-article-score)
- (or n gnus-score-interactive-default-score ))))
-
-(defun gnus-summary-set-score (n)
- "Set the score of the current article to N."
- (interactive "p")
- (save-excursion
- (gnus-summary-show-thread)
- (let ((buffer-read-only nil))
- ;; Set score.
- (gnus-summary-update-mark
- (if (= n (or gnus-summary-default-score 0)) ? ;Whitespace
- (if (< n (or gnus-summary-default-score 0))
- gnus-score-below-mark gnus-score-over-mark))
- 'score))
- (let* ((article (gnus-summary-article-number))
- (score (assq article gnus-newsgroup-scored)))
- (if score (setcdr score n)
- (push (cons article n) gnus-newsgroup-scored)))
- (gnus-summary-update-line)))
-
-(defun gnus-summary-current-score ()
- "Return the score of the current article."
- (interactive)
- (gnus-message 1 "%s" (gnus-summary-article-score)))
-
-(defun gnus-score-change-score-file (file)
- "Change current score alist."
- (interactive
- (list (read-file-name "Change to score file: " gnus-kill-files-directory)))
- (gnus-score-load-file file)
- (gnus-set-mode-line 'summary))
-
-(defvar gnus-score-edit-exit-function)
-(defun gnus-score-edit-current-scores (file)
- "Edit the current score alist."
- (interactive (list gnus-current-score-file))
- (if (not gnus-current-score-file)
- (error "No current score file")
- (let ((winconf (current-window-configuration)))
- (when (buffer-name gnus-summary-buffer)
- (gnus-score-save))
- (gnus-make-directory (file-name-directory file))
- (setq gnus-score-edit-buffer (find-file-noselect file))
- (gnus-configure-windows 'edit-score)
- (gnus-score-mode)
- (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits"))))
-
-(defun gnus-score-edit-file (file)
- "Edit a score file."
- (interactive
- (list (read-file-name "Edit score file: " gnus-kill-files-directory)))
- (gnus-make-directory (file-name-directory file))
- (when (buffer-name gnus-summary-buffer)
- (gnus-score-save))
- (let ((winconf (current-window-configuration)))
- (setq gnus-score-edit-buffer (find-file-noselect file))
- (gnus-configure-windows 'edit-score)
- (gnus-score-mode)
- (setq gnus-score-edit-exit-function 'gnus-score-edit-done)
- (make-local-variable 'gnus-prev-winconf)
- (setq gnus-prev-winconf winconf))
- (gnus-message
- 4 (substitute-command-keys
- "\\<gnus-score-mode-map>\\[gnus-score-edit-exit] to save edits")))
-
-(defun gnus-score-edit-file-at-point (&optional format)
- "Edit score file at point in Score Trace buffers.
-If FORMAT, also format the current score file."
- (let* ((rule (save-excursion
- (beginning-of-line)
- (read (current-buffer))))
- (sep "[ \n\r\t]*")
- ;; Must be synced with `gnus-score-find-trace':
- (reg " -> +")
- (file (save-excursion
- (end-of-line)
- (if (and (re-search-backward reg (gnus-point-at-bol) t)
- (re-search-forward reg (gnus-point-at-eol) t))
- (buffer-substring (point) (gnus-point-at-eol))
- nil))))
- (if (or (not file)
- (string-match "\\<\\(non-file rule\\|A file\\)\\>" file)
- ;; (see `gnus-score-find-trace' and `gnus-score-advanced')
- (string= "" file))
- (gnus-error 3 "Can't find a score file in current line.")
- (gnus-score-edit-file file)
- (when format
- (gnus-score-pretty-print))
- (when (consp rule) ;; the rule exists
- (setq rule (mapconcat #'(lambda (obj)
- (regexp-quote (format "%S" obj)))
- rule
- sep))
- (goto-char (point-min))
- (re-search-forward rule nil t)
- ;; make it easy to use `kill-sexp':
- (goto-char (1- (match-beginning 0)))))))
-
-(defun gnus-score-load-file (file)
- ;; Load score file FILE. Returns a list a retrieved score-alists.
- (let* ((file (expand-file-name
- (or (and (string-match
- (concat "^" (regexp-quote
- (expand-file-name
- gnus-kill-files-directory)))
- (expand-file-name file))
- file)
- (expand-file-name file gnus-kill-files-directory))))
- (cached (assoc file gnus-score-cache))
- (global (member file gnus-internal-global-score-files))
- lists alist)
- (if cached
- ;; The score file was already loaded.
- (setq alist (cdr cached))
- ;; We load the score file.
- (setq gnus-score-alist nil)
- (setq alist (gnus-score-load-score-alist file))
- ;; We add '(touched) to the alist to signify that it hasn't been
- ;; touched (yet).
- (unless (assq 'touched alist)
- (push (list 'touched nil) alist))
- ;; If it is a global score file, we make it read-only.
- (and global
- (not (assq 'read-only alist))
- (push (list 'read-only t) alist))
- (push (cons file alist) gnus-score-cache))
- (let ((a alist)
- found)
- (while a
- ;; Downcase all header names.
- (cond
- ((stringp (caar a))
- (setcar (car a) (downcase (caar a)))
- (setq found t))
- ;; Advanced scoring.
- ((consp (caar a))
- (setq found t)))
- (pop a))
- ;; If there are actual scores in the alist, we add it to the
- ;; return value of this function.
- (when found
- (setq lists (list alist))))
- ;; Treat the other possible atoms in the score alist.
- (let ((mark (car (gnus-score-get 'mark alist)))
- (expunge (car (gnus-score-get 'expunge alist)))
- (mark-and-expunge (car (gnus-score-get 'mark-and-expunge alist)))
- (files (gnus-score-get 'files alist))
- (exclude-files (gnus-score-get 'exclude-files alist))
- (orphan (car (gnus-score-get 'orphan alist)))
- (adapt (gnus-score-get 'adapt alist))
- (thread-mark-and-expunge
- (car (gnus-score-get 'thread-mark-and-expunge alist)))
- (adapt-file (car (gnus-score-get 'adapt-file alist)))
- (local (gnus-score-get 'local alist))
- (decay (car (gnus-score-get 'decay alist)))
- (eval (car (gnus-score-get 'eval alist))))
- ;; Perform possible decays.
- (when (and gnus-decay-scores
- (or cached (file-exists-p file))
- (or (not decay)
- (gnus-decay-scores alist decay)))
- (gnus-score-set 'touched '(t) alist)
- (gnus-score-set 'decay (list (time-to-days (current-time))) alist))
- ;; We do not respect eval and files atoms from global score
- ;; files.
- (when (and files (not global))
- (setq lists (apply 'append lists
- (mapcar (lambda (file)
- (gnus-score-load-file file))
- (if adapt-file (cons adapt-file files)
- files)))))
- (when (and eval (not global))
- (eval eval))
- ;; We then expand any exclude-file directives.
- (setq gnus-scores-exclude-files
- (nconc
- (apply
- 'nconc
- (mapcar
- (lambda (sfile)
- (list
- (expand-file-name sfile (file-name-directory file))
- (expand-file-name sfile gnus-kill-files-directory)))
- exclude-files))
- gnus-scores-exclude-files))
- (when local
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (while local
- (and (consp (car local))
- (symbolp (caar local))
- (progn
- (make-local-variable (caar local))
- (set (caar local) (nth 1 (car local)))))
- (setq local (cdr local)))))
- (when orphan
- (setq gnus-orphan-score orphan))
- (setq gnus-adaptive-score-alist
- (cond ((equal adapt '(t))
- (setq gnus-newsgroup-adaptive t)
- gnus-default-adaptive-score-alist)
- ((equal adapt '(ignore))
- (setq gnus-newsgroup-adaptive nil))
- ((consp adapt)
- (setq gnus-newsgroup-adaptive t)
- adapt)
- (t
- gnus-default-adaptive-score-alist)))
- (setq gnus-thread-expunge-below
- (or thread-mark-and-expunge gnus-thread-expunge-below))
- (setq gnus-summary-mark-below
- (or mark mark-and-expunge gnus-summary-mark-below))
- (setq gnus-summary-expunge-below
- (or expunge mark-and-expunge gnus-summary-expunge-below))
- (setq gnus-newsgroup-adaptive-score-file
- (or adapt-file gnus-newsgroup-adaptive-score-file)))
- (setq gnus-current-score-file file)
- (setq gnus-score-alist alist)
- lists))
-
-(defun gnus-score-load (file)
- ;; Load score FILE.
- (let ((cache (assoc file gnus-score-cache)))
- (if cache
- (setq gnus-score-alist (cdr cache))
- (setq gnus-score-alist nil)
- (gnus-score-load-score-alist file)
- (unless gnus-score-alist
- (setq gnus-score-alist (copy-alist '((touched nil)))))
- (push (cons file gnus-score-alist) gnus-score-cache))))
-
-(defun gnus-score-remove-from-cache (file)
- (setq gnus-score-cache
- (delq (assoc file gnus-score-cache) gnus-score-cache)))
-
-(defun gnus-score-load-score-alist (file)
- "Read score FILE."
- (let (alist)
- (if (not (file-readable-p file))
- ;; Couldn't read file.
- (setq gnus-score-alist nil)
- ;; Read file.
- (with-temp-buffer
- (let ((coding-system-for-read score-mode-coding-system))
- (insert-file-contents file))
- (goto-char (point-min))
- ;; Only do the loading if the score file isn't empty.
- (when (save-excursion (re-search-forward "[()0-9a-zA-Z]" nil t))
- (setq alist
- (condition-case ()
- (read (current-buffer))
- (error
- (gnus-error 3.2 "Problem with score file %s" file))))))
- (cond
- ((and alist
- (atom alist))
- ;; Bogus score file.
- (error "Invalid syntax with score file %s" file))
- ((eq (car alist) 'setq)
- ;; This is an old-style score file.
- (setq gnus-score-alist (gnus-score-transform-old-to-new alist)))
- (t
- (setq gnus-score-alist alist)))
- ;; Check the syntax of the score file.
- (setq gnus-score-alist
- (gnus-score-check-syntax gnus-score-alist file)))))
-
-(defun gnus-score-check-syntax (alist file)
- "Check the syntax of the score ALIST."
- (cond
- ((null alist)
- nil)
- ((not (consp alist))
- (gnus-message 1 "Score file is not a list: %s" file)
- (ding)
- nil)
- (t
- (let ((a alist)
- sr err s type)
- (while (and a (not err))
- (setq
- err
- (cond
- ((not (listp (car a)))
- (format "Invalid score element %s in %s" (car a) file))
- ((stringp (caar a))
- (cond
- ((not (listp (setq sr (cdar a))))
- (format "Invalid header match %s in %s" (nth 1 (car a)) file))
- (t
- (setq type (caar a))
- (while (and sr (not err))
- (setq s (pop sr))
- (setq
- err
- (cond
- ((if (member (downcase type) '("lines" "chars"))
- (not (numberp (car s)))
- (not (stringp (car s))))
- (format "Invalid match %s in %s" (car s) file))
- ((and (cadr s) (not (integerp (cadr s))))
- (format "Non-integer score %s in %s" (cadr s) file))
- ((and (caddr s) (not (integerp (caddr s))))
- (format "Non-integer date %s in %s" (caddr s) file))
- ((and (cadddr s) (not (symbolp (cadddr s))))
- (format "Non-symbol match type %s in %s" (cadddr s) file)))))
- err)))))
- (setq a (cdr a)))
- (if err
- (progn
- (ding)
- (gnus-message 3 err)
- (sit-for 2)
- nil)
- alist)))))
-
-(defun gnus-score-transform-old-to-new (alist)
- (let* ((alist (nth 2 alist))
- out entry)
- (when (eq (car alist) 'quote)
- (setq alist (nth 1 alist)))
- (while alist
- (setq entry (car alist))
- (if (stringp (car entry))
- (let ((scor (cdr entry)))
- (push entry out)
- (while scor
- (setcar scor
- (list (caar scor) (nth 2 (car scor))
- (and (nth 3 (car scor))
- (date-to-day (nth 3 (car scor))))
- (if (nth 1 (car scor)) 'r 's)))
- (setq scor (cdr scor))))
- (push (if (not (listp (cdr entry)))
- (list (car entry) (cdr entry))
- entry)
- out))
- (setq alist (cdr alist)))
- (cons (list 'touched t) (nreverse out))))
-
-(defun gnus-score-save ()
- ;; Save all score information.
- (let ((cache gnus-score-cache)
- entry score file)
- (save-excursion
- (setq gnus-score-alist nil)
- (nnheader-set-temp-buffer " *Gnus Scores*")
- (while cache
- (current-buffer)
- (setq entry (pop cache)
- file (nnheader-translate-file-chars (car entry) t)
- score (cdr entry))
- (if (or (not (equal (gnus-score-get 'touched score) '(t)))
- (gnus-score-get 'read-only score)
- (and (file-exists-p file)
- (not (file-writable-p file))))
- ()
- (setq score (setcdr entry (gnus-delete-alist 'touched score)))
- (erase-buffer)
- (let (emacs-lisp-mode-hook)
- (if (string-match
- (concat (regexp-quote gnus-adaptive-file-suffix) "$")
- file)
- ;; This is an adaptive score file, so we do not run
- ;; it through `pp'. These files can get huge, and
- ;; are not meant to be edited by human hands.
- (gnus-prin1 score)
- ;; This is a normal score file, so we print it very
- ;; prettily.
- (let ((lisp-mode-syntax-table score-mode-syntax-table))
- (gnus-pp score))))
- (gnus-make-directory (file-name-directory file))
- ;; If the score file is empty, we delete it.
- (if (zerop (buffer-size))
- (delete-file file)
- ;; There are scores, so we write the file.
- (when (file-writable-p file)
- (let ((coding-system-for-write score-mode-coding-system))
- (gnus-write-buffer file))
- (when gnus-score-after-write-file-function
- (funcall gnus-score-after-write-file-function file)))))
- (and gnus-score-uncacheable-files
- (string-match gnus-score-uncacheable-files file)
- (gnus-score-remove-from-cache file)))
- (kill-buffer (current-buffer)))))
-
-(defun gnus-score-load-files (score-files)
- "Load all score files in SCORE-FILES."
- ;; Load the score files.
- (let (scores)
- (while score-files
- (if (stringp (car score-files))
- ;; It is a string, which means that it's a score file name,
- ;; so we load the score file and add the score alist to
- ;; the list of alists.
- (setq scores (nconc (gnus-score-load-file (car score-files)) scores))
- ;; It is an alist, so we just add it to the list directly.
- (setq scores (nconc (car score-files) scores)))
- (setq score-files (cdr score-files)))
- ;; Prune the score files that are to be excluded, if any.
- (when gnus-scores-exclude-files
- (let ((s scores)
- c)
- (while s
- (and (setq c (rassq (car s) gnus-score-cache))
- (member (car c) gnus-scores-exclude-files)
- (setq scores (delq (car s) scores)))
- (setq s (cdr s)))))
- scores))
-
-(defun gnus-score-headers (score-files &optional trace)
- ;; Score `gnus-newsgroup-headers'.
- (let (scores news)
- ;; PLM: probably this is not the best place to clear orphan-score
- (setq gnus-orphan-score nil
- gnus-scores-articles nil
- gnus-scores-exclude-files nil
- scores (gnus-score-load-files score-files))
- (setq news scores)
- ;; Do the scoring.
- (while news
- (setq scores news
- news nil)
- (when (and gnus-summary-default-score
- scores)
- (let* ((entries gnus-header-index)
- (now (date-to-day (current-time-string)))
- (expire (and gnus-score-expiry-days
- (- now gnus-score-expiry-days)))
- (headers gnus-newsgroup-headers)
- (current-score-file gnus-current-score-file)
- entry header new)
- (gnus-message 7 "Scoring...")
- ;; Create articles, an alist of the form `(HEADER . SCORE)'.
- (while (setq header (pop headers))
- ;; WARNING: The assq makes the function O(N*S) while it could
- ;; be written as O(N+S), where N is (length gnus-newsgroup-headers)
- ;; and S is (length gnus-newsgroup-scored).
- (unless (assq (mail-header-number header) gnus-newsgroup-scored)
- (setq gnus-scores-articles ;Total of 2 * N cons-cells used.
- (cons (cons header (or gnus-summary-default-score 0))
- gnus-scores-articles))))
-
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*Headers*"))
- (buffer-disable-undo)
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (message-clone-locals gnus-summary-buffer))
-
- ;; Set the global variant of this variable.
- (setq gnus-current-score-file current-score-file)
- ;; score orphans
- (when gnus-orphan-score
- (setq gnus-score-index
- (nth 1 (assoc "references" gnus-header-index)))
- (gnus-score-orphans gnus-orphan-score))
- ;; Run each header through the score process.
- (while entries
- (setq entry (pop entries)
- header (nth 0 entry)
- gnus-score-index (nth 1 (assoc header gnus-header-index)))
- (when (< 0 (apply 'max (mapcar
- (lambda (score)
- (length (gnus-score-get header score)))
- scores)))
- ;; Call the scoring function for this type of "header".
- (when (setq new (funcall (nth 2 entry) scores header
- now expire trace))
- (push new news))))
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (let ((scored gnus-newsgroup-scored))
- (with-current-buffer gnus-summary-buffer
- (setq gnus-newsgroup-scored scored))))
- ;; Remove the buffer.
- (gnus-kill-buffer (current-buffer)))
-
- ;; Add articles to `gnus-newsgroup-scored'.
- (while gnus-scores-articles
- (when (or (/= gnus-summary-default-score
- (cdar gnus-scores-articles))
- gnus-save-score)
- (push (cons (mail-header-number (caar gnus-scores-articles))
- (cdar gnus-scores-articles))
- gnus-newsgroup-scored))
- (setq gnus-scores-articles (cdr gnus-scores-articles)))
-
- (let (score)
- (while (setq score (pop scores))
- (while score
- (when (consp (caar score))
- (gnus-score-advanced (car score) trace))
- (pop score))))
-
- (gnus-message 7 "Scoring...done"))))))
-
-(defun gnus-score-lower-thread (thread score-adjust)
- "Lower the score on THREAD with SCORE-ADJUST.
-THREAD is expected to contain a list of the form `(PARENT [CHILD1
-CHILD2 ...])' where PARENT is a header array and each CHILD is a list
-of the same form as THREAD. The empty list nil is valid. For each
-article in the tree, the score of the corresponding entry in
-`gnus-newsgroup-scored' is adjusted by SCORE-ADJUST."
- (while thread
- (let ((head (car thread)))
- (if (listp head)
- ;; handle a child and its descendants
- (gnus-score-lower-thread head score-adjust)
- ;; handle the parent
- (let* ((article (mail-header-number head))
- (score (assq article gnus-newsgroup-scored)))
- (if score (setcdr score (+ (cdr score) score-adjust))
- (push (cons article score-adjust) gnus-newsgroup-scored)))))
- (setq thread (cdr thread))))
-
-(defun gnus-score-orphans (score)
- "Score orphans.
-A root is an article with no references. An orphan is an article
-which has references, but is not connected via its references to a
-root article. This function finds all the orphans, and adjusts their
-score in `gnus-newsgroup-scored' by SCORE."
- ;; gnus-make-threads produces a list, where each entry is a "thread"
- ;; as described in the gnus-score-lower-thread docs. This function
- ;; will be called again (after limiting has been done) if the display
- ;; is threaded. It would be nice to somehow save this info and use
- ;; it later.
- (dolist (thread (gnus-make-threads))
- (let ((id (aref (car thread) gnus-score-index)))
- ;; If the parent of the thread is not a root, lower the score of
- ;; it and its descendants. Note that some roots seem to satisfy
- ;; (eq id nil) and some (eq id ""); not sure why.
- (when (and id
- (not (string= id "")))
- (gnus-score-lower-thread thread score)))))
-
-(defun gnus-score-integer (scores header now expire &optional trace)
- (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
- entries alist)
- ;; Find matches.
- (while scores
- (setq alist (car scores)
- scores (cdr scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (match (nth 0 kill))
- (type (or (nth 3 kill) '>))
- (score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (match-func (if (or (eq type '>) (eq type '<) (eq type '<=)
- (eq type '>=) (eq type '=))
- type
- (error "Invalid match type: %s" type)))
- (articles gnus-scores-articles))
- ;; Instead of doing all the clever stuff that
- ;; `gnus-score-string' does to minimize searches and stuff,
- ;; I will assume that people generally will put so few
- ;; matches on numbers that any cleverness will take more
- ;; time than one would gain.
- (while articles
- (when (funcall match-func
- (or (aref (caar articles) gnus-score-index) 0)
- match)
- (when trace
- (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
- gnus-score-trace))
- (setq found t)
- (setcdr (car articles) (+ score (cdar articles))))
- (setq articles (cdr articles)))
- ;; Update expire date
- (cond ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates) ;Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries)))
- (setq entries rest)))))
- nil)
-
-(defun gnus-score-date (scores header now expire &optional trace)
- (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
- entries alist match match-func article)
- ;; Find matches.
- (while scores
- (setq alist (car scores)
- scores (cdr scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (type (or (nth 3 kill) 'before))
- (score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (articles gnus-scores-articles)
- l)
- (cond
- ((eq type 'after)
- (setq match-func 'string<
- match (gnus-date-iso8601 (nth 0 kill))))
- ((eq type 'before)
- (setq match-func 'gnus-string>
- match (gnus-date-iso8601 (nth 0 kill))))
- ((eq type 'at)
- (setq match-func 'string=
- match (gnus-date-iso8601 (nth 0 kill))))
- ((eq type 'regexp)
- (setq match-func 'string-match
- match (nth 0 kill)))
- (t (error "Invalid match type: %s" type)))
- ;; Instead of doing all the clever stuff that
- ;; `gnus-score-string' does to minimize searches and stuff,
- ;; I will assume that people generally will put so few
- ;; matches on numbers that any cleverness will take more
- ;; time than one would gain.
- (while (setq article (pop articles))
- (when (and
- (setq l (aref (car article) gnus-score-index))
- (funcall match-func match (gnus-date-iso8601 l)))
- (when trace
- (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
- gnus-score-trace))
- (setq found t)
- (setcdr article (+ score (cdr article)))))
- ;; Update expire date
- (cond ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates) ;Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries)))
- (setq entries rest)))))
- nil)
-
-(defun gnus-score-body (scores header now expire &optional trace)
- (if gnus-agent-fetching
- nil
- (save-excursion
- (setq gnus-scores-articles
- (sort gnus-scores-articles
- (lambda (a1 a2)
- (< (mail-header-number (car a1))
- (mail-header-number (car a2))))))
- (set-buffer nntp-server-buffer)
- (save-restriction
- (let* ((buffer-read-only nil)
- (articles gnus-scores-articles)
- (all-scores scores)
- (request-func (cond ((string= "head" header)
- 'gnus-request-head)
- ((string= "body" header)
- 'gnus-request-body)
- (t 'gnus-request-article)))
- entries alist ofunc article last)
- (when articles
- (setq last (mail-header-number (caar (last articles))))
- ;; Not all backends support partial fetching. In that case,
- ;; we just fetch the entire article.
- (unless (gnus-check-backend-function
- (and (string-match "^gnus-" (symbol-name request-func))
- (intern (substring (symbol-name request-func)
- (match-end 0))))
- gnus-newsgroup-name)
- (setq ofunc request-func)
- (setq request-func 'gnus-request-article))
- (while articles
- (setq article (mail-header-number (caar articles)))
- (gnus-message 7 "Scoring article %s of %s..." article last)
- (widen)
- (when (funcall request-func article gnus-newsgroup-name)
- (goto-char (point-min))
- ;; If just parts of the article is to be searched, but the
- ;; backend didn't support partial fetching, we just narrow
- ;; to the relevant parts.
- (when ofunc
- (if (eq ofunc 'gnus-request-head)
- (narrow-to-region
- (point)
- (or (search-forward "\n\n" nil t) (point-max)))
- (narrow-to-region
- (or (search-forward "\n\n" nil t) (point))
- (point-max))))
- (setq scores all-scores)
- ;; Find matches.
- (while scores
- (setq alist (pop scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (match (nth 0 kill))
- (type (or (nth 3 kill) 's))
- (score (or (nth 1 kill)
- gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (case-fold-search
- (not (or (eq type 'R) (eq type 'S)
- (eq type 'Regexp) (eq type 'String))))
- (search-func
- (cond ((or (eq type 'r) (eq type 'R)
- (eq type 'regexp) (eq type 'Regexp))
- 're-search-forward)
- ((or (eq type 's) (eq type 'S)
- (eq type 'string) (eq type 'String))
- 'search-forward)
- (t
- (error "Invalid match type: %s" type)))))
- (goto-char (point-min))
- (when (funcall search-func match nil t)
- ;; Found a match, update scores.
- (setcdr (car articles) (+ score (cdar articles)))
- (setq found t)
- (when trace
- (push
- (cons (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace)))
- ;; Update expire date
- (unless trace
- (cond
- ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
- ;; Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries))))
- (setq entries rest)))))
- (setq articles (cdr articles)))))))
- nil))
-
-(defun gnus-score-thread (scores header now expire &optional trace)
- (gnus-score-followup scores header now expire trace t))
-
-(defun gnus-score-followup (scores header now expire &optional trace thread)
- (if gnus-agent-fetching
- ;; FIXME: It seems doable in fetching mode.
- nil
- ;; Insert the unique article headers in the buffer.
- (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
- (current-score-file gnus-current-score-file)
- (all-scores scores)
- ;; gnus-score-index is used as a free variable.
- alike last this art entries alist articles
- new news)
-
- ;; Change score file to the adaptive score file. All entries that
- ;; this function makes will be put into this file.
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-score-load-file
- (or gnus-newsgroup-adaptive-score-file
- (gnus-score-file-name
- gnus-newsgroup-name gnus-adaptive-file-suffix))))
-
- (setq gnus-scores-articles (sort gnus-scores-articles
- 'gnus-score-string<)
- articles gnus-scores-articles)
-
- (erase-buffer)
- (while articles
- (setq art (car articles)
- this (aref (car art) gnus-score-index)
- articles (cdr articles))
- (if (equal last this)
- (push art alike)
- (when last
- (insert last ?\n)
- (put-text-property (1- (point)) (point) 'articles alike))
- (setq alike (list art)
- last this)))
- (when last ; Bwadr, duplicate code.
- (insert last ?\n)
- (put-text-property (1- (point)) (point) 'articles alike))
-
- ;; Find matches.
- (while scores
- (setq alist (car scores)
- scores (cdr scores)
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((rest (cdr entries))
- (kill (car rest))
- (match (nth 0 kill))
- (type (or (nth 3 kill) 's))
- (score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (found nil)
- (mt (aref (symbol-name type) 0))
- (case-fold-search
- (not (or (= mt ?R) (= mt ?S) (= mt ?E) (= mt ?F))))
- (dmt (downcase mt))
- (search-func
- (cond ((= dmt ?r) 're-search-forward)
- ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
- (t (error "Invalid match type: %s" type))))
- arts art)
- (goto-char (point-min))
- (if (= dmt ?e)
- (while (funcall search-func match nil t)
- (and (= (gnus-point-at-bol)
- (match-beginning 0))
- (= (progn (end-of-line) (point))
- (match-end 0))
- (progn
- (setq found (setq arts (get-text-property
- (point) 'articles)))
- ;; Found a match, update scores.
- (while arts
- (setq art (car arts)
- arts (cdr arts))
- (gnus-score-add-followups
- (car art) score all-scores thread))))
- (end-of-line))
- (while (funcall search-func match nil t)
- (end-of-line)
- (setq found (setq arts (get-text-property (point) 'articles)))
- ;; Found a match, update scores.
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))
- (when trace
- (push (cons
- (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace))
- (when (setq new (gnus-score-add-followups
- (car art) score all-scores thread))
- (push new news)))))
- ;; Update expire date
- (cond ((null date)) ;Permanent entry.
- ((and found gnus-update-score-entry-dates)
- ;Match, update date.
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now))
- ((and expire (< date expire)) ;Old entry, remove.
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cdr rest))
- (setq rest entries)))
- (setq entries rest))))
- ;; We change the score file back to the previous one.
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-score-load-file current-score-file))
- (list (cons "references" news)))))
-
-(defun gnus-score-add-followups (header score scores &optional thread)
- "Add a score entry to the adapt file."
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let* ((id (mail-header-id header))
- (scores (car scores))
- entry dont)
- ;; Don't enter a score if there already is one.
- (while (setq entry (pop scores))
- (and (equal "references" (car entry))
- (or (null (nth 3 (cadr entry)))
- (eq 's (nth 3 (cadr entry))))
- (assoc id entry)
- (setq dont t)))
- (unless dont
- (gnus-summary-score-entry
- (if thread "thread" "references")
- id 's score (current-time-string) nil t)))))
-
-(defun gnus-score-string (score-list header now expire &optional trace)
- ;; Score ARTICLES according to HEADER in SCORE-LIST.
- ;; Update matching entries to NOW and remove unmatched entries older
- ;; than EXPIRE.
-
- ;; Insert the unique article headers in the buffer.
- (let ((gnus-score-index (nth 1 (assoc header gnus-header-index)))
- ;; gnus-score-index is used as a free variable.
- (simplify (and gnus-score-thread-simplify
- (string= "subject" header)))
- alike last this art entries alist articles
- fuzzies arts words kill)
-
- ;; Sorting the articles costs os O(N*log N) but will allow us to
- ;; only match with each unique header. Thus the actual matching
- ;; will be O(M*U) where M is the number of strings to match with,
- ;; and U is the number of unique headers. It is assumed (but
- ;; untested) this will be a net win because of the large constant
- ;; factor involved with string matching.
- (setq gnus-scores-articles
- ;; We cannot string-sort the extra headers list. *sigh*
- (if (= gnus-score-index 9)
- gnus-scores-articles
- (sort gnus-scores-articles 'gnus-score-string<))
- articles gnus-scores-articles)
-
- (erase-buffer)
- (while (setq art (pop articles))
- (setq this (aref (car art) gnus-score-index))
-
- ;; If we're working with non-standard headers, we are stuck
- ;; with working on them as a group. What a hassle.
- ;; Just wait 'til you see what horrors we commit against `match'...
- (if (= gnus-score-index 9)
- (setq this (gnus-prin1-to-string this))) ; ick.
-
- (if simplify
- (setq this (gnus-map-function gnus-simplify-subject-functions this)))
- (if (equal last this)
- ;; O(N*H) cons-cells used here, where H is the number of
- ;; headers.
- (push art alike)
- (when last
- ;; Insert the line, with a text property on the
- ;; terminating newline referring to the articles with
- ;; this line.
- (insert last ?\n)
- (put-text-property (1- (point)) (point) 'articles alike))
- (setq alike (list art)
- last this)))
- (when last ; Bwadr, duplicate code.
- (insert last ?\n)
- (put-text-property (1- (point)) (point) 'articles alike))
-
- ;; Go through all the score alists and pick out the entries
- ;; for this header.
- (while score-list
- (setq alist (pop score-list)
- ;; There's only one instance of this header for
- ;; each score alist.
- entries (assoc header alist))
- (while (cdr entries) ;First entry is the header index.
- (let* ((kill (cadr entries))
- (type (or (nth 3 kill) 's))
- (score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (extra (nth 4 kill)) ; non-standard header; string.
- (found nil)
- (mt (aref (symbol-name type) 0))
- (case-fold-search (not (memq mt '(?R ?S ?E ?F))))
- (dmt (downcase mt))
- ;; Assume user already simplified regexp and fuzzies
- (match (if (and simplify (not (memq dmt '(?f ?r))))
- (gnus-map-function
- gnus-simplify-subject-functions
- (nth 0 kill))
- (nth 0 kill)))
- (search-func
- (cond ((= dmt ?r) 're-search-forward)
- ((or (= dmt ?e) (= dmt ?s) (= dmt ?f)) 'search-forward)
- ((= dmt ?w) nil)
- (t (error "Invalid match type: %s" type)))))
-
- ;; Evil hackery to make match usable in non-standard headers.
- (when extra
- (setq match (concat "[ (](" extra " \\. \"[^)]*"
- match "[^\"]*\")[ )]")
- search-func 're-search-forward)) ; XXX danger?!?
-
- (cond
- ;; Fuzzy matches. We save these for later.
- ((= dmt ?f)
- (push (cons entries alist) fuzzies)
- (setq entries (cdr entries)))
- ;; Word matches. Save these for even later.
- ((= dmt ?w)
- (push (cons entries alist) words)
- (setq entries (cdr entries)))
- ;; Exact matches.
- ((= dmt ?e)
- ;; Do exact matching.
- (goto-char (point-min))
- (while (and (not (eobp))
- (funcall search-func match nil t))
- ;; Is it really exact?
- (and (eolp)
- (= (gnus-point-at-bol) (match-beginning 0))
- ;; Yup.
- (progn
- (setq found (setq arts (get-text-property
- (point) 'articles)))
- ;; Found a match, update scores.
- (if trace
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))
- (push
- (cons
- (car-safe (rassq alist gnus-score-cache))
- kill)
- gnus-score-trace))
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))))))
- (forward-line 1))
- ;; Update expiry date
- (if trace
- (setq entries (cdr entries))
- (cond
- ;; Permanent entry.
- ((null date)
- (setq entries (cdr entries)))
- ;; We have a match, so we update the date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now)
- (setq entries (cdr entries)))
- ;; This entry has expired, so we remove it.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cddr entries)))
- ;; No match; go to next entry.
- (t
- (setq entries (cdr entries))))))
- ;; Regexp and substring matching.
- (t
- (goto-char (point-min))
- (when (string= match "")
- (setq match "\n"))
- (while (and (not (eobp))
- (funcall search-func match nil t))
- (goto-char (match-beginning 0))
- (end-of-line)
- (setq found (setq arts (get-text-property (point) 'articles)))
- ;; Found a match, update scores.
- (if trace
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))
- (push (cons (car-safe (rassq alist gnus-score-cache)) kill)
- gnus-score-trace))
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))))
- (forward-line 1))
- ;; Update expiry date
- (if trace
- (setq entries (cdr entries))
- (cond
- ;; Permanent entry.
- ((null date)
- (setq entries (cdr entries)))
- ;; We have a match, so we update the date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) alist)
- (setcar (nthcdr 2 kill) now)
- (setq entries (cdr entries)))
- ;; This entry has expired, so we remove it.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) alist)
- (setcdr entries (cddr entries)))
- ;; No match; go to next entry.
- (t
- (setq entries (cdr entries))))))))))
-
- ;; Find fuzzy matches.
- (when fuzzies
- ;; Simplify the entire buffer for easy matching.
- (gnus-simplify-buffer-fuzzy)
- (while (setq kill (cadaar fuzzies))
- (let* ((match (nth 0 kill))
- (type (nth 3 kill))
- (score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- (mt (aref (symbol-name type) 0))
- (case-fold-search (not (= mt ?F)))
- found)
- (goto-char (point-min))
- (while (and (not (eobp))
- (search-forward match nil t))
- (when (and (= (gnus-point-at-bol) (match-beginning 0))
- (eolp))
- (setq found (setq arts (get-text-property (point) 'articles)))
- (if trace
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))
- (push (cons
- (car-safe (rassq (cdar fuzzies) gnus-score-cache))
- kill)
- gnus-score-trace))
- ;; Found a match, update scores.
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art))))))
- (forward-line 1))
- ;; Update expiry date
- (if (not trace)
- (cond
- ;; Permanent.
- ((null date)
- ;; Do nothing.
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar fuzzies))
- (setcdr (caar fuzzies) (cddaar fuzzies)))))
- (setq fuzzies (cdr fuzzies)))))
-
- (when words
- ;; Enter all words into the hashtb.
- (let ((hashtb (gnus-make-hashtable
- (* 10 (count-lines (point-min) (point-max))))))
- (gnus-enter-score-words-into-hashtb hashtb)
- (while (setq kill (cadaar words))
- (let* ((score (or (nth 1 kill) gnus-score-interactive-default-score))
- (date (nth 2 kill))
- found)
- (when (setq arts (intern-soft (nth 0 kill) hashtb))
- (setq arts (symbol-value arts))
- (setq found t)
- (if trace
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art)))
- (push (cons
- (car-safe (rassq (cdar words) gnus-score-cache))
- kill)
- gnus-score-trace))
- ;; Found a match, update scores.
- (while (setq art (pop arts))
- (setcdr art (+ score (cdr art))))))
- ;; Update expiry date
- (if (not trace)
- (cond
- ;; Permanent.
- ((null date)
- ;; Do nothing.
- )
- ;; Match, update date.
- ((and found gnus-update-score-entry-dates)
- (gnus-score-set 'touched '(t) (cdar words))
- (setcar (nthcdr 2 kill) now))
- ;; Old entry, remove.
- ((and expire (< date expire))
- (gnus-score-set 'touched '(t) (cdar words))
- (setcdr (caar words) (cddaar words)))))
- (setq words (cdr words))))))
- nil))
-
-(defun gnus-enter-score-words-into-hashtb (hashtb)
- ;; Find all the words in the buffer and enter them into
- ;; the hashtable.
- (let ((syntab (syntax-table))
- word val)
- (goto-char (point-min))
- (unwind-protect
- (progn
- (set-syntax-table gnus-adaptive-word-syntax-table)
- (while (re-search-forward "\\b\\w+\\b" nil t)
- (setq val
- (gnus-gethash
- (setq word (downcase (buffer-substring
- (match-beginning 0) (match-end 0))))
- hashtb))
- (gnus-sethash
- word
- (append (get-text-property (gnus-point-at-eol) 'articles) val)
- hashtb)))
- (set-syntax-table syntab))
- ;; Make all the ignorable words ignored.
- (let ((ignored (append gnus-ignored-adaptive-words
- (if gnus-adaptive-word-no-group-words
- (message-tokenize-header
- (gnus-group-real-name gnus-newsgroup-name)
- "."))
- gnus-default-ignored-adaptive-words)))
- (while ignored
- (gnus-sethash (pop ignored) nil hashtb)))))
-
-(defun gnus-score-string< (a1 a2)
- ;; Compare headers in articles A2 and A2.
- ;; The header index used is the free variable `gnus-score-index'.
- (string-lessp (aref (car a1) gnus-score-index)
- (aref (car a2) gnus-score-index)))
-
-(defun gnus-current-score-file-nondirectory (&optional score-file)
- (let ((score-file (or score-file gnus-current-score-file)))
- (if score-file
- (gnus-short-group-name (file-name-nondirectory score-file))
- "none")))
-
-(defun gnus-score-adaptive ()
- "Create adaptive score rules for this newsgroup."
- (when gnus-newsgroup-adaptive
- ;; We change the score file to the adaptive score file.
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-score-load-file
- (or gnus-newsgroup-adaptive-score-file
- (gnus-home-score-file gnus-newsgroup-name t)
- (gnus-score-file-name
- gnus-newsgroup-name gnus-adaptive-file-suffix))))
- ;; Perform ordinary line scoring.
- (when (or (not (listp gnus-newsgroup-adaptive))
- (memq 'line gnus-newsgroup-adaptive))
- (save-excursion
- (let* ((malist (gnus-copy-sequence gnus-adaptive-score-alist))
- (alist malist)
- (date (current-time-string))
- (data gnus-newsgroup-data)
- elem headers match func)
- ;; First we transform the adaptive rule alist into something
- ;; that's faster to process.
- (while malist
- (setq elem (car malist))
- (when (symbolp (car elem))
- (setcar elem (symbol-value (car elem))))
- (setq elem (cdr elem))
- (while elem
- (when (fboundp
- (setq func
- (intern
- (concat "mail-header-"
- (if (eq (caar elem) 'followup)
- "message-id"
- (downcase (symbol-name (caar elem))))))))
- (setcdr (car elem)
- (cons (if (eq (caar elem) 'followup)
- "references"
- (symbol-name (caar elem)))
- (cdar elem)))
- (setcar (car elem)
- `(lambda (h)
- (,func h))))
- (setq elem (cdr elem)))
- (setq malist (cdr malist)))
- ;; Then we score away.
- (while data
- (setq elem (cdr (assq (gnus-data-mark (car data)) alist)))
- (if (or (not elem)
- (gnus-data-pseudo-p (car data)))
- ()
- (when (setq headers (gnus-data-header (car data)))
- (while elem
- (setq match (funcall (caar elem) headers))
- (gnus-summary-score-entry
- (nth 1 (car elem)) match
- (cond
- ((numberp match)
- '=)
- ((equal (nth 1 (car elem)) "date")
- 'a)
- (t
- ;; Whether we use substring or exact matches is
- ;; controlled here.
- (if (or (not gnus-score-exact-adapt-limit)
- (< (length match) gnus-score-exact-adapt-limit))
- 'e
- (if (equal (nth 1 (car elem)) "subject")
- 'f 's))))
- (nth 2 (car elem)) date nil t)
- (setq elem (cdr elem)))))
- (setq data (cdr data))))))
-
- ;; Perform adaptive word scoring.
- (when (and (listp gnus-newsgroup-adaptive)
- (memq 'word gnus-newsgroup-adaptive))
- (with-temp-buffer
- (let* ((hashtb (gnus-make-hashtable 1000))
- (date (date-to-day (current-time-string)))
- (data gnus-newsgroup-data)
- (syntab (syntax-table))
- word d score val)
- (unwind-protect
- (progn
- (set-syntax-table gnus-adaptive-word-syntax-table)
- ;; Go through all articles.
- (while (setq d (pop data))
- (when (and
- (not (gnus-data-pseudo-p d))
- (setq score
- (cdr (assq
- (gnus-data-mark d)
- gnus-adaptive-word-score-alist))))
- ;; This article has a mark that should lead to
- ;; adaptive word rules, so we insert the subject
- ;; and find all words in that string.
- (insert (mail-header-subject (gnus-data-header d)))
- (downcase-region (point-min) (point-max))
- (goto-char (point-min))
- (while (re-search-forward "\\b\\w+\\b" nil t)
- ;; Put the word and score into the hashtb.
- (setq val (gnus-gethash (setq word (match-string 0))
- hashtb))
- (when (or (not gnus-adaptive-word-length-limit)
- (> (length word)
- gnus-adaptive-word-length-limit))
- (setq val (+ score (or val 0)))
- (if (and gnus-adaptive-word-minimum
- (< val gnus-adaptive-word-minimum))
- (setq val gnus-adaptive-word-minimum))
- (gnus-sethash word val hashtb)))
- (erase-buffer))))
- (set-syntax-table syntab))
- ;; Make all the ignorable words ignored.
- (let ((ignored (append gnus-ignored-adaptive-words
- (if gnus-adaptive-word-no-group-words
- (message-tokenize-header
- (gnus-group-real-name
- gnus-newsgroup-name)
- "."))
- gnus-default-ignored-adaptive-words)))
- (while ignored
- (gnus-sethash (pop ignored) nil hashtb)))
- ;; Now we have all the words and scores, so we
- ;; add these rules to the ADAPT file.
- (set-buffer gnus-summary-buffer)
- (mapatoms
- (lambda (word)
- (when (symbol-value word)
- (gnus-summary-score-entry
- "subject" (symbol-name word) 'w (symbol-value word)
- date nil t)))
- hashtb))))))
-
-(defun gnus-score-edit-done ()
- (let ((bufnam (buffer-file-name (current-buffer)))
- (winconf gnus-prev-winconf))
- (when winconf
- (set-window-configuration winconf))
- (gnus-score-remove-from-cache bufnam)
- (gnus-score-load-file bufnam)))
-
-(defun gnus-score-find-trace ()
- "Find all score rules that applies to the current article."
- (interactive)
- (let ((old-scored gnus-newsgroup-scored))
- (let ((gnus-newsgroup-headers
- (list (gnus-summary-article-header)))
- (gnus-newsgroup-scored nil)
- ;; Must be synced with `gnus-score-edit-file-at-point':
- (frmt "%S [%s] -> %s\n")
- trace
- file)
- (save-excursion
- (nnheader-set-temp-buffer "*Score Trace*"))
- (setq gnus-score-trace nil)
- (gnus-possibly-score-headers 'trace)
- (if (not (setq trace gnus-score-trace))
- (gnus-error
- 1 "No score rules apply to the current article (default score %d)."
- gnus-summary-default-score)
- (set-buffer "*Score Trace*")
- ;; Use a keymap instead?
- (local-set-key "q"
- (lambda ()
- (interactive)
- (bury-buffer nil)
- (gnus-summary-expand-window)))
- (local-set-key "e" (lambda ()
- "Run `gnus-score-edit-file-at-point'."
- (interactive)
- (gnus-score-edit-file-at-point)))
- (local-set-key "f" (lambda ()
- "Run `gnus-score-edit-file-at-point'."
- (interactive)
- (gnus-score-edit-file-at-point 'format)))
- (local-set-key "t" 'toggle-truncate-lines)
- (setq truncate-lines t)
- (dolist (entry trace)
- (setq file (or (car entry)
- ;; Must be synced with
- ;; `gnus-score-edit-file-at-point':
- "(non-file rule)"))
- (insert
- (format frmt
- (cdr entry)
- ;; Don't use `file-name-sans-extension' to see .SCORE and
- ;; .ADAPT directly:
- (file-name-nondirectory file)
- (abbreviate-file-name file))))
- (insert
- "\n\nQuick help:
-
-Type `e' to edit score file corresponding to the score rule on current line,
-`f' to format (pretty print) the score file and edit it,
-`t' toggle to truncate long lines in this buffer,
-`q' to quit.
-
-The first sexp on each line is the score rule, followed by the file name of
-the score file and its full name, including the directory.")
- (goto-char (point-min))
- (gnus-configure-windows 'score-trace)))
- (set-buffer gnus-summary-buffer)
- (setq gnus-newsgroup-scored old-scored)))
-
-(defun gnus-score-find-favourite-words ()
- "List words used in scoring."
- (interactive)
- (let ((alists (gnus-score-load-files (gnus-all-score-files)))
- alist rule rules kill)
- ;; Go through all the score alists for this group
- ;; and find all `w' rules.
- (while (setq alist (pop alists))
- (while (setq rule (pop alist))
- (when (and (stringp (car rule))
- (equal "subject" (downcase (pop rule))))
- (while (setq kill (pop rule))
- (when (memq (nth 3 kill) '(w W word Word))
- (push (cons (or (nth 1 kill)
- gnus-score-interactive-default-score)
- (car kill))
- rules))))))
- (setq rules (sort rules (lambda (r1 r2)
- (string-lessp (cdr r1) (cdr r2)))))
- ;; Add up words that have appeared several times.
- (let ((r rules))
- (while (cdr r)
- (if (equal (cdar r) (cdadr r))
- (progn
- (setcar (car r) (+ (caar r) (caadr r)))
- (setcdr r (cddr r)))
- (pop r))))
- ;; Insert the words.
- (nnheader-set-temp-buffer "*Score Words*")
- (if (not (setq rules (sort rules (lambda (r1 r2) (> (car r1) (car r2))))))
- (gnus-error 3 "No word score rules")
- (while rules
- (insert (format "%-5d: %s\n" (caar rules) (cdar rules)))
- (pop rules))
- (goto-char (point-min))
- (gnus-configure-windows 'score-words))))
-
-(defun gnus-summary-rescore ()
- "Redo the entire scoring process in the current summary."
- (interactive)
- (gnus-score-save)
- (setq gnus-score-cache nil)
- (setq gnus-newsgroup-scored nil)
- (gnus-possibly-score-headers)
- (gnus-score-update-all-lines))
-
-(defun gnus-score-flush-cache ()
- "Flush the cache of score files."
- (interactive)
- (gnus-score-save)
- (setq gnus-score-cache nil
- gnus-score-alist nil
- gnus-short-name-score-file-cache nil)
- (gnus-message 6 "The score cache is now flushed"))
-
-(gnus-add-shutdown 'gnus-score-close 'gnus)
-
-(defvar gnus-score-file-alist-cache nil)
-
-(defun gnus-score-close ()
- "Clear all internal score variables."
- (setq gnus-score-cache nil
- gnus-internal-global-score-files nil
- gnus-score-file-list nil
- gnus-score-file-alist-cache nil))
-
-;; Summary score marking commands.
-
-(defun gnus-summary-raise-same-subject-and-select (score)
- "Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
- (let ((subject (gnus-summary-article-subject)))
- (gnus-summary-raise-score score)
- (while (gnus-summary-find-subject subject)
- (gnus-summary-raise-score score))
- (gnus-summary-next-article t)))
-
-(defun gnus-summary-raise-same-subject (score)
- "Raise articles which has the same subject with SCORE."
- (interactive "p")
- (let ((subject (gnus-summary-article-subject)))
- (gnus-summary-raise-score score)
- (while (gnus-summary-find-subject subject)
- (gnus-summary-raise-score score))
- (gnus-summary-next-subject 1 t)))
-
-(defun gnus-score-delta-default (level)
- (if level (prefix-numeric-value level)
- gnus-score-interactive-default-score))
-
-(defun gnus-summary-raise-thread (&optional score)
- "Raise the score of the articles in the current thread with SCORE."
- (interactive "P")
- (setq score (gnus-score-delta-default score))
- (let (e)
- (save-excursion
- (let ((articles (gnus-summary-articles-in-thread)))
- (while articles
- (gnus-summary-goto-subject (car articles))
- (gnus-summary-raise-score score)
- (setq articles (cdr articles))))
- (setq e (point)))
- (let ((gnus-summary-check-current t))
- (unless (zerop (gnus-summary-next-subject 1 t))
- (goto-char e))))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary))
-
-(defun gnus-summary-lower-same-subject-and-select (score)
- "Raise articles which has the same subject with SCORE and select the next."
- (interactive "p")
- (gnus-summary-raise-same-subject-and-select (- score)))
-
-(defun gnus-summary-lower-same-subject (score)
- "Raise articles which has the same subject with SCORE."
- (interactive "p")
- (gnus-summary-raise-same-subject (- score)))
-
-(defun gnus-summary-lower-thread (&optional score)
- "Lower score of articles in the current thread with SCORE."
- (interactive "P")
- (gnus-summary-raise-thread (- (gnus-score-delta-default score))))
-
-;;; Finding score files.
-
-(defun gnus-score-score-files (group)
- "Return a list of all possible score files."
- ;; Search and set any global score files.
- (when gnus-global-score-files
- (unless gnus-internal-global-score-files
- (gnus-score-search-global-directories gnus-global-score-files)))
- ;; Fix the kill-file dir variable.
- (setq gnus-kill-files-directory
- (file-name-as-directory gnus-kill-files-directory))
- ;; If we can't read it, there are no score files.
- (if (not (file-exists-p (expand-file-name gnus-kill-files-directory)))
- (setq gnus-score-file-list nil)
- (if (not (gnus-use-long-file-name 'not-score))
- ;; We do not use long file names, so we have to do some
- ;; directory traversing.
- (setq gnus-score-file-list
- (cons nil
- (or gnus-short-name-score-file-cache
- (prog2
- (gnus-message 6 "Finding all score files...")
- (setq gnus-short-name-score-file-cache
- (gnus-score-score-files-1
- gnus-kill-files-directory))
- (gnus-message 6 "Finding all score files...done")))))
- ;; We want long file names.
- (when (or (not gnus-score-file-list)
- (not (car gnus-score-file-list))
- (gnus-file-newer-than gnus-kill-files-directory
- (car gnus-score-file-list)))
- (setq gnus-score-file-list
- (cons (nth 5 (file-attributes gnus-kill-files-directory))
- (nreverse
- (directory-files
- gnus-kill-files-directory t
- (gnus-score-file-regexp)))))))
- (cdr gnus-score-file-list)))
-
-(defun gnus-score-score-files-1 (dir)
- "Return all possible score files under DIR."
- (let ((files (list (expand-file-name dir)))
- (regexp (gnus-score-file-regexp))
- (case-fold-search nil)
- seen out file)
- (while (setq file (pop files))
- (cond
- ;; Ignore files that start with a dot.
- ((string-match "^\\." (file-name-nondirectory file))
- nil)
- ;; Add subtrees of directory to also be searched.
- ((and (file-directory-p file)
- (not (member (file-truename file) seen)))
- (push (file-truename file) seen)
- (setq files (nconc (directory-files file t nil t) files)))
- ;; Add files to the list of score files.
- ((string-match regexp file)
- (push file out))))
- (or out
- ;; Return a dummy value.
- (list (expand-file-name "this.file.does.not.exist.SCORE"
- gnus-kill-files-directory)))))
-
-(defun gnus-score-file-regexp ()
- "Return a regexp that match all score files."
- (concat "\\(" (regexp-quote gnus-score-file-suffix )
- "\\|" (regexp-quote gnus-adaptive-file-suffix) "\\)\\'"))
-
-(defun gnus-score-find-bnews (group)
- "Return a list of score files for GROUP.
-The score files are those files in the ~/News/ directory which matches
-GROUP using BNews sys file syntax."
- (let* ((sfiles (append (gnus-score-score-files group)
- gnus-internal-global-score-files))
- (kill-dir (file-name-as-directory
- (expand-file-name gnus-kill-files-directory)))
- (klen (length kill-dir))
- (score-regexp (gnus-score-file-regexp))
- (trans (cdr (assq ?: nnheader-file-name-translation-alist)))
- (group-trans (nnheader-translate-file-chars group t))
- ofiles not-match regexp)
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*gnus score files*"))
- (buffer-disable-undo)
- ;; Go through all score file names and create regexp with them
- ;; as the source.
- (while sfiles
- (erase-buffer)
- (insert (car sfiles))
- (goto-char (point-min))
- ;; First remove the suffix itself.
- (when (re-search-forward (concat "." score-regexp) nil t)
- (replace-match "" t t)
- (goto-char (point-min))
- (if (looking-at (regexp-quote kill-dir))
- ;; If the file name was just "SCORE", `klen' is one character
- ;; too much.
- (delete-char (min (1- (point-max)) klen))
- (goto-char (point-max))
- (if (re-search-backward gnus-directory-sep-char-regexp nil t)
- (delete-region (1+ (point)) (point-min))
- (gnus-message 1 "Can't find directory separator in %s"
- (car sfiles))))
- ;; If short file names were used, we have to translate slashes.
- (goto-char (point-min))
- (let ((regexp (concat
- "[/:" (if trans (char-to-string trans)) "]")))
- (while (re-search-forward regexp nil t)
- (replace-match "." t t)))
- ;; Kludge to get rid of "nntp+" problems.
- (goto-char (point-min))
- (when (looking-at "nn[a-z]+\\+")
- (search-forward "+")
- (forward-char -1)
- (insert "\\")
- (forward-char 1))
- ;; Kludge to deal with "++".
- (while (search-forward "+" nil t)
- (replace-match "\\+" t t))
- ;; Translate "all" to ".*".
- (goto-char (point-min))
- (while (search-forward "all" nil t)
- (replace-match ".*" t t))
- (goto-char (point-min))
- ;; Deal with "not."s.
- (if (looking-at "not.")
- (progn
- (setq not-match t)
- (setq regexp
- (concat "^" (buffer-substring 5 (point-max)) "$")))
- (setq regexp (concat "^" (buffer-substring 1 (point-max)) "$"))
- (setq not-match nil))
- ;; Finally - if this resulting regexp matches the group name,
- ;; we add this score file to the list of score files
- ;; applicable to this group.
- (when (or (and not-match
- (ignore-errors
- (not (string-match regexp group-trans))))
- (and (not not-match)
- (ignore-errors (string-match regexp group-trans))))
- (push (car sfiles) ofiles)))
- (setq sfiles (cdr sfiles)))
- (gnus-kill-buffer (current-buffer))
- ;; Slight kludge here - the last score file returned should be
- ;; the local score file, whether it exists or not. This is so
- ;; that any score commands the user enters will go to the right
- ;; file, and not end up in some global score file.
- (let ((localscore (gnus-score-file-name group)))
- (setq ofiles (cons localscore (delete localscore ofiles))))
- (gnus-sort-score-files (nreverse ofiles)))))
-
-(defun gnus-score-find-single (group)
- "Return list containing the score file for GROUP."
- (list (or gnus-newsgroup-adaptive-score-file
- (gnus-score-file-name group gnus-adaptive-file-suffix))
- (gnus-score-file-name group)))
-
-(defun gnus-score-find-hierarchical (group)
- "Return list of score files for GROUP.
-This includes the score file for the group and all its parents."
- (let* ((prefix (gnus-group-real-prefix group))
- (all (list nil))
- (group (gnus-group-real-name group))
- (start 0))
- (while (string-match "\\." group (1+ start))
- (setq start (match-beginning 0))
- (push (substring group 0 start) all))
- (push group all)
- (setq all
- (nconc
- (mapcar (lambda (group)
- (gnus-score-file-name group gnus-adaptive-file-suffix))
- (setq all (nreverse all)))
- (mapcar 'gnus-score-file-name all)))
- (if (equal prefix "")
- all
- (mapcar
- (lambda (file)
- (nnheader-translate-file-chars
- (concat (file-name-directory file) prefix
- (file-name-nondirectory file))))
- all))))
-
-(defun gnus-score-file-rank (file)
- "Return a number that says how specific score FILE is.
-Destroys the current buffer."
- (if (member file gnus-internal-global-score-files)
- 0
- (when (string-match
- (concat "^" (regexp-quote
- (expand-file-name
- (file-name-as-directory gnus-kill-files-directory))))
- file)
- (setq file (substring file (match-end 0))))
- (insert file)
- (goto-char (point-min))
- (let ((beg (point))
- elems)
- (while (re-search-forward "[./]" nil t)
- (push (buffer-substring beg (1- (point)))
- elems))
- (erase-buffer)
- (setq elems (delete "all" elems))
- (length elems))))
-
-(defun gnus-sort-score-files (files)
- "Sort FILES so that the most general files come first."
- (with-temp-buffer
- (let ((alist
- (mapcar
- (lambda (file)
- (cons (inline (gnus-score-file-rank file)) file))
- files)))
- (mapcar
- (lambda (f) (cdr f))
- (sort alist 'car-less-than-car)))))
-
-(defun gnus-score-find-alist (group)
- "Return list of score files for GROUP.
-The list is determined from the variable `gnus-score-file-alist'."
- (let ((alist gnus-score-file-multiple-match-alist)
- score-files)
- ;; if this group has been seen before, return the cached entry
- (if (setq score-files (assoc group gnus-score-file-alist-cache))
- (cdr score-files) ;ensures caching groups with no matches
- ;; handle the multiple match alist
- (while alist
- (when (string-match (caar alist) group)
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist)))))
- (setq alist (cdr alist)))
- (setq alist gnus-score-file-single-match-alist)
- ;; handle the single match alist
- (while alist
- (when (string-match (caar alist) group)
- ;; progn used just in case ("regexp") has no files
- ;; and score-files is still nil. -sj
- ;; this can be construed as a "stop searching here" feature :>
- ;; and used to simplify regexps in the single-alist
- (setq score-files
- (nconc score-files (copy-sequence (cdar alist))))
- (setq alist nil))
- (setq alist (cdr alist)))
- ;; cache the score files
- (push (cons group score-files) gnus-score-file-alist-cache)
- score-files)))
-
-(defun gnus-all-score-files (&optional group)
- "Return a list of all score files for the current group."
- (let ((funcs gnus-score-find-score-files-function)
- (group (or group gnus-newsgroup-name))
- score-files)
- (when group
- ;; Make sure funcs is a list.
- (and funcs
- (not (listp funcs))
- (setq funcs (list funcs)))
- (when gnus-score-use-all-scores
- ;; Get the initial score files for this group.
- (when funcs
- (setq score-files (nreverse (gnus-score-find-alist group))))
- ;; Add any home adapt files.
- (let ((home (gnus-home-score-file group t)))
- (when home
- (push home score-files)
- (setq gnus-newsgroup-adaptive-score-file home)))
- ;; Check whether there is a `adapt-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'adapt-file)))
- (when param-file
- (push param-file score-files)
- (setq gnus-newsgroup-adaptive-score-file param-file))))
- ;; Go through all the functions for finding score files (or actual
- ;; scores) and add them to a list.
- (while funcs
- (when (functionp (car funcs))
- (setq score-files
- (append score-files
- (nreverse (funcall (car funcs) group)))))
- (setq funcs (cdr funcs)))
- (when gnus-score-use-all-scores
- ;; Add any home score files.
- (let ((home (gnus-home-score-file group)))
- (when home
- (push home score-files)))
- ;; Check whether there is a `score-file' group parameter.
- (let ((param-file (gnus-group-find-parameter group 'score-file)))
- (when param-file
- (push param-file score-files))))
- ;; Expand all files names.
- (let ((files score-files))
- (while files
- (when (stringp (car files))
- (setcar files (expand-file-name
- (car files) gnus-kill-files-directory)))
- (pop files)))
- (setq score-files (nreverse score-files))
- ;; Remove any duplicate score files.
- (while (and score-files
- (member (car score-files) (cdr score-files)))
- (pop score-files))
- (let ((files score-files))
- (while (cdr files)
- (if (member (cadr files) (cddr files))
- (setcdr files (cddr files))
- (pop files))))
- ;; Do the scoring if there are any score files for this group.
- score-files)))
-
-(defun gnus-possibly-score-headers (&optional trace)
- "Do scoring if scoring is required."
- (let ((score-files (gnus-all-score-files)))
- (when score-files
- (gnus-score-headers score-files trace))))
-
-(defun gnus-score-file-name (newsgroup &optional suffix)
- "Return the name of a score file for NEWSGROUP."
- (let ((suffix (or suffix gnus-score-file-suffix)))
- (nnheader-translate-file-chars
- (cond
- ((or (null newsgroup)
- (string-equal newsgroup ""))
- ;; The global score file is placed at top of the directory.
- (expand-file-name suffix gnus-kill-files-directory))
- ((gnus-use-long-file-name 'not-score)
- ;; Append ".SCORE" to newsgroup name.
- (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
- "." suffix)
- gnus-kill-files-directory))
- (t
- ;; Place "SCORE" under the hierarchical directory.
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" suffix)
- gnus-kill-files-directory))))))
-
-(defun gnus-score-search-global-directories (files)
- "Scan all global score directories for score files."
- ;; Set the variable `gnus-internal-global-score-files' to all
- ;; available global score files.
- (interactive (list gnus-global-score-files))
- (let (out)
- (while files
- ;; #### /$ Unix-specific?
- (if (file-directory-p (car files))
- (setq out (nconc (directory-files
- (car files) t
- (concat (gnus-score-file-regexp) "$"))))
- (push (car files) out))
- (setq files (cdr files)))
- (setq gnus-internal-global-score-files out)))
-
-(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
- (gnus-message 1 "New score file entries will be case insensitive.")
- (gnus-message 1 "New score file entries will be case sensitive.")))
-
-;;; Home score file.
-
-(defun gnus-home-score-file (group &optional adapt)
- "Return the home score file for GROUP.
-If ADAPT, return the home adaptive file instead."
- (let ((list (if adapt gnus-home-adapt-file gnus-home-score-file))
- elem found)
- ;; Make sure we have a list.
- (unless (listp list)
- (setq list (list list)))
- ;; Go through the list and look for matches.
- (while (and (not found)
- (setq elem (pop list)))
- (setq found
- (cond
- ;; Simple string.
- ((stringp elem)
- elem)
- ;; Function.
- ((functionp elem)
- (funcall elem group))
- ;; Regexp-file cons.
- ((consp elem)
- (when (string-match (gnus-globalify-regexp (car elem)) group)
- (replace-match (cadr elem) t nil group))))))
- (when found
- (setq found (nnheader-translate-file-chars found))
- (if (file-name-absolute-p found)
- found
- (nnheader-concat gnus-kill-files-directory found)))))
-
-(defun gnus-hierarchial-home-score-file (group)
- "Return the score file of the top-level hierarchy of GROUP."
- (if (string-match "^[^.]+\\." group)
- (concat (match-string 0 group) gnus-score-file-suffix)
- ;; Group name without any dots.
- (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
- gnus-score-file-suffix)))
-
-(defun gnus-hierarchial-home-adapt-file (group)
- "Return the adapt file of the top-level hierarchy of GROUP."
- (if (string-match "^[^.]+\\." group)
- (concat (match-string 0 group) gnus-adaptive-file-suffix)
- ;; Group name without any dots.
- (concat group (if (gnus-use-long-file-name 'not-score) "." "/")
- gnus-adaptive-file-suffix)))
-
-(defun gnus-current-home-score-file (group)
- "Return the \"current\" regular score file."
- (car (nreverse (gnus-score-find-alist group))))
-
-;;;
-;;; Score decays
-;;;
-
-(defun gnus-decay-score (score)
- "Decay SCORE according to `gnus-score-decay-constant' and `gnus-score-decay-scale'."
- (let ((n (- score
- (* (if (< score 0) -1 1)
- (min (abs score)
- (max gnus-score-decay-constant
- (* (abs score)
- gnus-score-decay-scale)))))))
- (if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
- ;; number below the half of the maximum integer.
- (> (abs n) (lsh -1 -2)))
- (string-to-number
- (car (split-string (number-to-string n) "\\.")))
- (floor n))))
-
-(defun gnus-decay-scores (alist day)
- "Decay non-permanent scores in ALIST."
- (let ((times (- (time-to-days (current-time)) day))
- kill entry updated score n)
- (unless (zerop times) ;Done decays today already?
- (while (setq entry (pop alist))
- (when (stringp (car entry))
- (setq entry (cdr entry))
- (while (setq kill (pop entry))
- (when (nth 2 kill)
- (setq updated t)
- (setq score (or (nth 1 kill)
- gnus-score-interactive-default-score)
- n times)
- (while (natnump (decf n))
- (setq score (funcall gnus-decay-score-function score)))
- (setcdr kill (cons score
- (cdr (cdr kill)))))))))
- ;; Return whether this score file needs to be saved. By Je-haysuss!
- updated))
-
-(defun gnus-score-regexp-bad-p (regexp)
- "Test whether REGEXP is safe for Gnus scoring.
-A regexp is unsafe if it matches newline or a buffer boundary.
-
-If the regexp is good, return nil. If the regexp is bad, return a
-cons cell (SYM . STRING), where the symbol SYM is `new' or `bad'.
-In the `new' case, the string is a safe replacement for REGEXP.
-In the `bad' case, the string is a unsafe subexpression of REGEXP,
-and we do not have a simple replacement to suggest.
-
-See Info node `(gnus)Scoring Tips' for examples of good regular expressions."
- (let (case-fold-search)
- (and
- ;; First, try a relatively fast necessary condition.
- ;; Notice ranges (like [^:] or [\t-\r]), \s>, \Sw, \W, \', \`:
- (string-match "\n\\|\\\\[SsW`']\\|\\[\\^\\|[\0-\n]-" regexp)
- ;; Now break the regexp into tokens, and check each:
- (let ((tail regexp) ; remaining regexp to check
- tok ; current token
- bad ; nil, or bad subexpression
- new ; nil, or replacement regexp so far
- end) ; length of current token
- (while (and (not bad)
- (string-match
- "\\`\\(\\\\[sS]?.\\|\\[\\^?]?[^]]*]\\|[^\\]\\)"
- tail))
- (setq end (match-end 0)
- tok (substring tail 0 end)
- tail (substring tail end))
- (if;; Is token `bad' (matching newline or buffer ends)?
- (or (member tok '("\n" "\\W" "\\`" "\\'"))
- ;; This next handles "[...]", "\\s.", and "\\S.":
- (and (> end 2) (string-match tok "\n")))
- (let ((newtok
- ;; Try to suggest a replacement for tok ...
- (cond ((string-equal tok "\\`") "^") ; or "\\(^\\)"
- ((string-equal tok "\\'") "$") ; or "\\($\\)"
- ((string-match "\\[\\^" tok) ; very common
- (concat (substring tok 0 -1) "\n]")))))
- (if newtok
- (setq new
- (concat
- (or new
- ;; good prefix so far:
- (substring regexp 0 (- (+ (length tail) end))))
- newtok))
- ;; No replacement idea, so give up:
- (setq bad tok)))
- ;; tok is good, may need to extend new
- (and new (setq new (concat new tok)))))
- ;; Now return a value:
- (cond
- (bad (cons 'bad bad))
- (new (cons 'new new))
- (t nil))))))
-
-(provide 'gnus-score)
-
-;;; arch-tag: d3922589-764d-46ae-9954-9330fd192634
-;;; gnus-score.el ends here
+++ /dev/null
-;;; gnus-setup.el --- Initialization & Setup for Gnus 5
-
-;; Copyright (C) 1995, 1996, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-;; My head is starting to spin with all the different mail/news packages.
-;; Stop The Madness!
-
-;; Given that Emacs Lisp byte codes may be diverging, it is probably best
-;; not to byte compile this, and just arrange to have the .el loaded out
-;; of .emacs.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defvar gnus-use-installed-gnus t
- "*If non-nil use installed version of Gnus.")
-
-(defvar gnus-use-installed-mailcrypt (featurep 'xemacs)
- "*If non-nil use installed version of mailcrypt.")
-
-(defvar gnus-emacs-lisp-directory (if (featurep 'xemacs)
- "/usr/local/lib/xemacs/"
- "/usr/local/share/emacs/")
- "Directory where Emacs site lisp is located.")
-
-(defvar gnus-gnus-lisp-directory (concat gnus-emacs-lisp-directory
- "gnus/lisp/")
- "Directory where Gnus Emacs lisp is found.")
-
-(defvar gnus-mailcrypt-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/mailcrypt/")
- "Directory where Mailcrypt Emacs Lisp is found.")
-
-(defvar gnus-bbdb-lisp-directory (concat gnus-emacs-lisp-directory
- "site-lisp/bbdb/")
- "Directory where Big Brother Database is found.")
-
-(defvar gnus-use-mhe nil
- "Set this if you want to use MH-E for mail reading.")
-(defvar gnus-use-rmail nil
- "Set this if you want to use RMAIL for mail reading.")
-(defvar gnus-use-sendmail t
- "Set this if you want to use SENDMAIL for mail reading.")
-(defvar gnus-use-vm nil
- "Set this if you want to use the VM package for mail reading.")
-(defvar gnus-use-sc nil
- "Set this if you want to use Supercite.")
-(defvar gnus-use-mailcrypt t
- "Set this if you want to use Mailcrypt for dealing with PGP messages.")
-(defvar gnus-use-bbdb nil
- "Set this if you want to use the Big Brother DataBase.")
-
-(when (and (not gnus-use-installed-gnus)
- (null (member gnus-gnus-lisp-directory load-path)))
- (push gnus-gnus-lisp-directory load-path))
-
-;;; We can't do this until we know where Gnus is.
-(require 'message)
-
-;;; Mailcrypt by
-;;; Jin Choi <jin@atype.com>
-;;; Patrick LoPresti <patl@lcs.mit.edu>
-
-(when gnus-use-mailcrypt
- (when (and (not gnus-use-installed-mailcrypt)
- (null (member gnus-mailcrypt-lisp-directory load-path)))
- (setq load-path (cons gnus-mailcrypt-lisp-directory load-path)))
- (autoload 'mc-install-write-mode "mailcrypt" nil t)
- (autoload 'mc-install-read-mode "mailcrypt" nil t)
-;;; (add-hook 'message-mode-hook 'mc-install-write-mode)
-;;; (add-hook 'gnus-summary-mode-hook 'mc-install-read-mode)
- (when gnus-use-mhe
- (add-hook 'mh-folder-mode-hook 'mc-install-read-mode)
- (add-hook 'mh-letter-mode-hook 'mc-install-write-mode)))
-
-;;; BBDB by
-;;; Jamie Zawinski <jwz@lucid.com>
-
-(when gnus-use-bbdb
- ;; bbdb will never be installed with emacs.
- (when (null (member gnus-bbdb-lisp-directory load-path))
- (setq load-path (cons gnus-bbdb-lisp-directory load-path)))
- (autoload 'bbdb "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-name "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-company "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-net "bbdb-com"
- "Insidious Big Brother Database" t)
- (autoload 'bbdb-notes "bbdb-com"
- "Insidious Big Brother Database" t)
-
- (when gnus-use-vm
- (autoload 'bbdb-insinuate-vm "bbdb-vm"
- "Hook BBDB into VM" t))
-
- (when gnus-use-rmail
- (autoload 'bbdb-insinuate-rmail "bbdb-rmail"
- "Hook BBDB into RMAIL" t)
- (add-hook 'rmail-mode-hook 'bbdb-insinuate-rmail))
-
- (when gnus-use-mhe
- (autoload 'bbdb-insinuate-mh "bbdb-mh"
- "Hook BBDB into MH-E" t)
- (add-hook 'mh-folder-mode-hook 'bbdb-insinuate-mh))
-
- (autoload 'bbdb-insinuate-gnus "bbdb-gnus"
- "Hook BBDB into Gnus" t)
- (add-hook 'gnus-startup-hook 'bbdb-insinuate-gnus)
-
- (when gnus-use-sendmail
- (autoload 'bbdb-insinuate-sendmail "bbdb"
- "Insidious Big Brother Database" t)
- (add-hook 'mail-setup-hook 'bbdb-insinuate-sendmail)
- (add-hook 'message-setup-hook 'bbdb-insinuate-sendmail)))
-
-(when gnus-use-sc
- (add-hook 'mail-citation-hook 'sc-cite-original)
- (setq message-cite-function 'sc-cite-original)
- (autoload 'sc-cite-original "supercite"))
-\f
-;;;### (autoloads (gnus gnus-slave gnus-no-server) "gnus" "lisp/gnus.el" (12473 2137))
-;;; Generated autoloads from lisp/gnus.el
-
-;; Don't redo this if autoloads already exist
-(unless (fboundp 'gnus)
- (autoload 'gnus-slave-no-server "gnus" "\
-Read network news as a slave without connecting to local server." t nil)
-
- (autoload 'gnus-no-server "gnus" "\
-Read network news.
-If ARG is a positive number, Gnus will use that as the
-startup level. If ARG is nil, Gnus will be started at level 2.
-If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local server." t nil)
-
- (autoload 'gnus-slave "gnus" "\
-Read news as a slave." t nil)
-
- (autoload 'gnus "gnus" "\
-Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use." t nil)
-
-;;;***
-
-;;; These have moved out of gnus.el into other files.
-;;; FIX FIX FIX: should other things be in gnus-setup? or these not in it?
- (autoload 'gnus-update-format "gnus-spec" "\
-Update the format specification near point." t nil)
-
- (autoload 'gnus-fetch-group "gnus-group" "\
-Start Gnus if necessary and enter GROUP.
-Returns whether the fetching was successful or not." t nil)
-
- (defalias 'gnus-batch-kill 'gnus-batch-score)
-
- (autoload 'gnus-batch-score "gnus-kill" "\
-Run batched scoring.
-Usage: emacs -batch -l gnus -f gnus-batch-score <newsgroups> ...
-Newsgroups is a list of strings in Bnews format. If you want to score
-the comp hierarchy, you'd say \"comp.all\". If you would not like to
-score the alt hierarchy, you'd say \"!alt.all\"." t nil))
-
-(provide 'gnus-setup)
-
-(run-hooks 'gnus-setup-load-hook)
-
-;;; arch-tag: 08e4af93-8565-46bf-905c-36229400609d
-;;; gnus-setup.el ends here
+++ /dev/null
-;;; gnus-sieve.el --- Utilities to manage sieve scripts for Gnus
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: NAGY Andras <nagya@inf.elte.hu>,
-;; Simon Josefsson <simon@josefsson.org>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Gnus glue to generate complete Sieve scripts from Gnus Group
-;; Parameters with "if" test predicates.
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-sum)
-(require 'format-spec)
-(autoload 'sieve-mode "sieve-mode")
-(eval-when-compile
- (require 'sieve))
-
-;; Variables
-
-(defgroup gnus-sieve nil
- "Manage sieve scripts in Gnus."
- :group 'gnus)
-
-(defcustom gnus-sieve-file "~/.sieve"
- "Path to your Sieve script."
- :type 'file
- :group 'gnus-sieve)
-
-(defcustom gnus-sieve-region-start "\n## Begin Gnus Sieve Script\n"
- "Line indicating the start of the autogenerated region in
-your Sieve script."
- :type 'string
- :group 'gnus-sieve)
-
-(defcustom gnus-sieve-region-end "\n## End Gnus Sieve Script\n"
- "Line indicating the end of the autogenerated region in
-your Sieve script."
- :type 'string
- :group 'gnus-sieve)
-
-(defcustom gnus-sieve-select-method nil
- "Which select method we generate the Sieve script for.
-
-For example: \"nnimap:mailbox\""
- :group 'gnus-sieve)
-
-(defcustom gnus-sieve-crosspost t
- "Whether the generated Sieve script should do crossposting."
- :type 'boolean
- :group 'gnus-sieve)
-
-(defcustom gnus-sieve-update-shell-command "echo put %f | sieveshell %s"
- "Shell command to execute after updating your Sieve script. The following
-formatting characters are recognized:
-
-%f Script's file name (gnus-sieve-file)
-%s Server name (from gnus-sieve-select-method)"
- :type 'string
- :group 'gnus-sieve)
-
-;;;###autoload
-(defun gnus-sieve-update ()
- "Update the Sieve script in gnus-sieve-file, by replacing the region
-between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\), then
-execute gnus-sieve-update-shell-command.
-See the documentation for these variables and functions for details."
- (interactive)
- (gnus-sieve-generate)
- (save-buffer)
- (shell-command
- (format-spec gnus-sieve-update-shell-command
- (format-spec-make ?f gnus-sieve-file
- ?s (or (cadr (gnus-server-get-method
- nil gnus-sieve-select-method))
- "")))))
-
-;;;###autoload
-(defun gnus-sieve-generate ()
- "Generate the Sieve script in gnus-sieve-file, by replacing the region
-between gnus-sieve-region-start and gnus-sieve-region-end with
-\(gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost\).
-See the documentation for these variables and functions for details."
- (interactive)
- (require 'sieve)
- (find-file gnus-sieve-file)
- (goto-char (point-min))
- (if (re-search-forward (regexp-quote gnus-sieve-region-start) nil t)
- (delete-region (match-beginning 0)
- (or (re-search-forward (regexp-quote
- gnus-sieve-region-end) nil t)
- (point)))
- (insert sieve-template))
- (insert gnus-sieve-region-start
- (gnus-sieve-script gnus-sieve-select-method gnus-sieve-crosspost)
- gnus-sieve-region-end))
-
-(defun gnus-sieve-guess-rule-for-article ()
- "Guess a sieve rule based on RFC822 article in buffer.
-Return nil if no rule could be guessed."
- (when (message-fetch-field "sender")
- `(sieve address "sender" ,(message-fetch-field "sender"))))
-
-;;;###autoload
-(defun gnus-sieve-article-add-rule ()
- (interactive)
- (gnus-summary-select-article nil 'force)
- (with-current-buffer gnus-original-article-buffer
- (let ((rule (gnus-sieve-guess-rule-for-article))
- (info (gnus-get-info gnus-newsgroup-name)))
- (if (null rule)
- (error "Could not guess rule for article")
- (gnus-info-set-params info (cons rule (gnus-info-params info)))
- (message "Added rule in group %s for article: %s" gnus-newsgroup-name
- rule)))))
-
-;; Internals
-
-;; FIXME: do proper quoting of " etc
-(defun gnus-sieve-string-list (list)
- "Convert an elisp string list to a Sieve string list.
-
-For example:
-\(gnus-sieve-string-list '(\"to\" \"cc\"))
- => \"[\\\"to\\\", \\\"cc\\\"]\"
-"
- (concat "[\"" (mapconcat 'identity list "\", \"") "\"]"))
-
-(defun gnus-sieve-test-list (list)
- "Convert an elisp test list to a Sieve test list.
-
-For example:
-\(gnus-sieve-test-list '((address \"sender\" \"boss@company.com\") (size :over 4K)))
- => \"(address \\\"sender\\\" \\\"boss@company.com\\\", size :over 4K)\""
- (concat "(" (mapconcat 'gnus-sieve-test list ", ") ")"))
-
-;; FIXME: do proper quoting
-(defun gnus-sieve-test-token (token)
- "Convert an elisp test token to a Sieve test token.
-
-For example:
-\(gnus-sieve-test-token 'address)
- => \"address\"
-
-\(gnus-sieve-test-token \"sender\")
- => \"\\\"sender\\\"\"
-
-\(gnus-sieve-test-token '(\"to\" \"cc\"))
- => \"[\\\"to\\\", \\\"cc\\\"]\""
- (cond
- ((symbolp token) ;; Keyword
- (symbol-name token))
-
- ((stringp token) ;; String
- (concat "\"" token "\""))
-
- ((and (listp token) ;; String list
- (stringp (car token)))
- (gnus-sieve-string-list token))
-
- ((and (listp token) ;; Test list
- (listp (car token)))
- (gnus-sieve-test-list token))))
-
-(defun gnus-sieve-test (test)
- "Convert an elisp test to a Sieve test.
-
-For example:
-\(gnus-sieve-test '(address \"sender\" \"sieve-admin@extundo.com\"))
- => \"address \\\"sender\\\" \\\"sieve-admin@extundo.com\\\"\"
-
-\(gnus-sieve-test '(anyof ((header :contains (\"to\" \"cc\") \"my@address.com\")
- (size :over 100K))))
- => \"anyof (header :contains [\\\"to\\\", \\\"cc\\\"] \\\"my@address.com\\\",
- size :over 100K)\""
- (mapconcat 'gnus-sieve-test-token test " "))
-
-(defun gnus-sieve-script (&optional method crosspost)
- "Generate a Sieve script based on groups with select method METHOD
-\(or all groups if nil\). Only groups having a `sieve' parameter are
-considered. This parameter should contain an elisp test
-\(see the documentation of gnus-sieve-test for details\). For each
-such group, a Sieve IF control structure is generated, having the
-test as the condition and { fileinto \"group.name\"; } as the body.
-
-If CROSSPOST is nil, each conditional body contains a \"stop\" command
-which stops execution after a match is found.
-
-For example: If the INBOX.list.sieve group has the
-
- (sieve address \"sender\" \"sieve-admin@extundo.com\")
-
-group parameter, (gnus-sieve-script) results in:
-
- if address \"sender\" \"sieve-admin@extundo.com\" {
- fileinto \"INBOX.list.sieve\";
- }
-
-This is returned as a string."
- (let* ((newsrc (cdr gnus-newsrc-alist))
- script)
- (dolist (info newsrc)
- (when (or (not method)
- (gnus-server-equal method (gnus-info-method info)))
- (let* ((group (gnus-info-group info))
- (spec (gnus-group-find-parameter group 'sieve t)))
- (when spec
- (push (concat "if " (gnus-sieve-test spec) " {\n"
- "\tfileinto \"" (gnus-group-real-name group) "\";\n"
- (if crosspost
- ""
- "\tstop;\n")
- "}")
- script)))))
- (mapconcat 'identity script "\n")))
-
-(provide 'gnus-sieve)
-
-;;; arch-tag: 3b906527-c7f3-4c86-9e82-62e2697998a3
-;;; gnus-sieve.el ends here
+++ /dev/null
-;;; gnus-soup.el --- SOUP packet writing support for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Per Abrahamsen <abraham@iesd.auc.dk>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-(require 'message)
-(require 'gnus-start)
-(require 'gnus-range)
-
-(defgroup gnus-soup nil
- "SOUP packet writing support for Gnus."
- :group 'gnus)
-
-;;; User Variables:
-
-(defcustom gnus-soup-directory (nnheader-concat gnus-home-directory "SoupBrew/")
- "Directory containing an unpacked SOUP packet."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-replies-directory
- (nnheader-concat gnus-soup-directory "SoupReplies/")
- "Directory where Gnus will do processing of replies."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-prefix-file "gnus-prefix"
- "Name of the file where Gnus stores the last used prefix."
- :version "22.1" ;; Gnus 5.10.9
- :type 'file
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packer "tar cf - %s | gzip > $HOME/Soupout%d.tgz"
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-unpacker "gunzip -c %s | tar xvf -"
- "Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s."
- :version "22.1" ;; Gnus 5.10.9
- :type 'string
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-directory gnus-home-directory
- "Where gnus-soup will look for REPLIES packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'directory
- :group 'gnus-soup)
-
-(defcustom gnus-soup-packet-regexp "Soupin"
- "Regular expression matching SOUP REPLIES packets in `gnus-soup-packet-directory'."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-(defcustom gnus-soup-ignored-headers "^Xref:"
- "Regexp to match headers to be removed when brewing SOUP packets."
- :version "22.1" ;; Gnus 5.10.9
- :type 'regexp
- :group 'gnus-soup)
-
-;;; Internal Variables:
-
-(defvar gnus-soup-encoding-type ?u
- "*Soup encoding type.
-`u' is USENET news format, `m' is Unix mbox format, and `M' is MMDF mailbox
-format.")
-
-(defvar gnus-soup-index-type ?c
- "*Soup index type.
-`n' means no index file and `c' means standard Cnews overview
-format.")
-
-(defvar gnus-soup-areas nil)
-(defvar gnus-soup-last-prefix nil)
-(defvar gnus-soup-prev-prefix nil)
-(defvar gnus-soup-buffers nil)
-
-;;; Access macros:
-
-(defmacro gnus-soup-area-prefix (area)
- `(aref ,area 0))
-(defmacro gnus-soup-set-area-prefix (area prefix)
- `(aset ,area 0 ,prefix))
-(defmacro gnus-soup-area-name (area)
- `(aref ,area 1))
-(defmacro gnus-soup-area-encoding (area)
- `(aref ,area 2))
-(defmacro gnus-soup-area-description (area)
- `(aref ,area 3))
-(defmacro gnus-soup-area-number (area)
- `(aref ,area 4))
-(defmacro gnus-soup-area-set-number (area value)
- `(aset ,area 4 ,value))
-
-(defmacro gnus-soup-encoding-format (encoding)
- `(aref ,encoding 0))
-(defmacro gnus-soup-encoding-index (encoding)
- `(aref ,encoding 1))
-(defmacro gnus-soup-encoding-kind (encoding)
- `(aref ,encoding 2))
-
-(defmacro gnus-soup-reply-prefix (reply)
- `(aref ,reply 0))
-(defmacro gnus-soup-reply-kind (reply)
- `(aref ,reply 1))
-(defmacro gnus-soup-reply-encoding (reply)
- `(aref ,reply 2))
-
-;;; Commands:
-
-(defun gnus-soup-send-replies ()
- "Unpack and send all replies in the reply packet."
- (interactive)
- (let ((packets (directory-files
- gnus-soup-packet-directory t gnus-soup-packet-regexp)))
- (while packets
- (when (gnus-soup-send-packet (car packets))
- (delete-file (car packets)))
- (setq packets (cdr packets)))))
-
-(defun gnus-soup-add-article (n)
- "Add the current article to SOUP packet.
-If N is a positive number, add the N next articles.
-If N is a negative number, add the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead."
- (interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (tmp-buf (gnus-get-buffer-create "*soup work*"))
- (area (gnus-soup-area gnus-newsgroup-name))
- (prefix (gnus-soup-area-prefix area))
- headers)
- (buffer-disable-undo tmp-buf)
- (save-excursion
- (while articles
- ;; Put the article in a buffer.
- (set-buffer tmp-buf)
- (when (gnus-request-article-this-buffer
- (car articles) gnus-newsgroup-name)
- (setq headers (nnheader-parse-head t))
- (save-restriction
- (message-narrow-to-head)
- (message-remove-header gnus-soup-ignored-headers t))
- (gnus-soup-store gnus-soup-directory prefix headers
- gnus-soup-encoding-type
- gnus-soup-index-type)
- (gnus-soup-area-set-number
- area (1+ (or (gnus-soup-area-number area) 0)))
- ;; Mark article as read.
- (set-buffer gnus-summary-buffer)
- (gnus-summary-mark-as-read (car articles) gnus-souped-mark))
- (gnus-summary-remove-process-mark (car articles))
- (setq articles (cdr articles)))
- (kill-buffer tmp-buf))
- (gnus-soup-save-areas)
- (gnus-set-mode-line 'summary)))
-
-(defun gnus-soup-pack-packet ()
- "Make a SOUP packet from the SOUP areas."
- (interactive)
- (gnus-soup-read-areas)
- (if (file-exists-p gnus-soup-directory)
- (if (directory-files gnus-soup-directory nil "\\.MSG$")
- (gnus-soup-pack gnus-soup-directory gnus-soup-packer)
- (message "No files to pack."))
- (message "No such directory: %s" gnus-soup-directory)))
-
-(defun gnus-group-brew-soup (n)
- "Make a soup packet from the current group.
-Uses the process/prefix convention."
- (interactive "P")
- (let ((groups (gnus-group-process-prefix n)))
- (while groups
- (gnus-group-remove-mark (car groups))
- (gnus-soup-group-brew (car groups) t)
- (setq groups (cdr groups)))
- (gnus-soup-save-areas)))
-
-(defun gnus-brew-soup (&optional level)
- "Go through all groups on LEVEL or less and make a soup packet."
- (interactive "P")
- (let ((level (or level gnus-level-subscribed))
- (newsrc (cdr gnus-newsrc-alist)))
- (while newsrc
- (when (<= (nth 1 (car newsrc)) level)
- (gnus-soup-group-brew (caar newsrc) t))
- (setq newsrc (cdr newsrc)))
- (gnus-soup-save-areas)))
-
-;;;###autoload
-(defun gnus-batch-brew-soup ()
- "Brew a SOUP packet from groups mention on the command line.
-Will use the remaining command line arguments as regular expressions
-for matching on group names.
-
-For instance, if you want to brew on all the nnml groups, as well as
-groups with \"emacs\" in the name, you could say something like:
-
-$ emacs -batch -f gnus-batch-brew-soup ^nnml \".*emacs.*\"
-
-Note -- this function hasn't been implemented yet."
- (interactive)
- nil)
-
-;;; Internal Functions:
-
-;; Store the current buffer.
-(defun gnus-soup-store (directory prefix headers format index)
- ;; Create the directory, if needed.
- (gnus-make-directory directory)
- (let* ((msg-buf (nnheader-find-file-noselect
- (concat directory prefix ".MSG")))
- (idx-buf (if (= index ?n)
- nil
- (nnheader-find-file-noselect
- (concat directory prefix ".IDX"))))
- (article-buf (current-buffer))
- from head-line beg type)
- (setq gnus-soup-buffers (cons msg-buf (delq msg-buf gnus-soup-buffers)))
- (buffer-disable-undo msg-buf)
- (when idx-buf
- (push idx-buf gnus-soup-buffers)
- (buffer-disable-undo idx-buf))
- (save-excursion
- ;; Make sure the last char in the buffer is a newline.
- (goto-char (point-max))
- (unless (= (current-column) 0)
- (insert "\n"))
- ;; Find the "from".
- (goto-char (point-min))
- (setq from
- (gnus-mail-strip-quoted-names
- (or (mail-fetch-field "from")
- (mail-fetch-field "really-from")
- (mail-fetch-field "sender"))))
- (goto-char (point-min))
- ;; Depending on what encoding is supposed to be used, we make
- ;; a soup header.
- (setq head-line
- (cond
- ((or (= gnus-soup-encoding-type ?u)
- (= gnus-soup-encoding-type ?n)) ;;Gnus back compatibility.
- (format "#! rnews %d\n" (buffer-size)))
- ((= gnus-soup-encoding-type ?m)
- (while (search-forward "\nFrom " nil t)
- (replace-match "\n>From " t t))
- (concat "From " (or from "unknown")
- " " (current-time-string) "\n"))
- ((= gnus-soup-encoding-type ?M)
- "\^a\^a\^a\^a\n")
- (t (error "Unsupported type: %c" gnus-soup-encoding-type))))
- ;; Insert the soup header and the article in the MSG buf.
- (set-buffer msg-buf)
- (goto-char (point-max))
- (insert head-line)
- (setq beg (point))
- (insert-buffer-substring article-buf)
- ;; Insert the index in the IDX buf.
- (cond ((= index ?c)
- (set-buffer idx-buf)
- (gnus-soup-insert-idx beg headers))
- ((/= index ?n)
- (error "Unknown index type: %c" type)))
- ;; Return the MSG buf.
- msg-buf)))
-
-(defun gnus-soup-group-brew (group &optional not-all)
- "Enter GROUP and add all articles to a SOUP package.
-If NOT-ALL, don't pack ticked articles."
- (let ((gnus-expert-user t)
- (gnus-large-newsgroup nil)
- (entry (gnus-gethash group gnus-newsrc-hashtb)))
- (when (or (null entry)
- (eq (car entry) t)
- (and (car entry)
- (> (car entry) 0))
- (and (not not-all)
- (gnus-range-length (cdr (assq 'tick (gnus-info-marks
- (nth 2 entry)))))))
- (when (gnus-summary-read-group group nil t)
- (setq gnus-newsgroup-processable
- (reverse
- (if (not not-all)
- (append gnus-newsgroup-marked gnus-newsgroup-unreads)
- gnus-newsgroup-unreads)))
- (gnus-soup-add-article nil)
- (gnus-summary-exit)))))
-
-(defun gnus-soup-insert-idx (offset header)
- ;; [number subject from date id references chars lines xref]
- (goto-char (point-max))
- (insert
- (format "%d\t%s\t%s\t%s\t%s\t%s\t%d\t%s\t\t\n"
- offset
- (or (mail-header-subject header) "(none)")
- (or (mail-header-from header) "(nobody)")
- (or (mail-header-date header) "")
- (or (mail-header-id header)
- (concat "soup-dummy-id-"
- (mapconcat
- (lambda (time) (int-to-string time))
- (current-time) "-")))
- (or (mail-header-references header) "")
- (or (mail-header-chars header) 0)
- (or (mail-header-lines header) "0"))))
-
-(defun gnus-soup-save-areas ()
- "Write all SOUP buffers."
- (interactive)
- (gnus-soup-write-areas)
- (save-excursion
- (let (buf)
- (while gnus-soup-buffers
- (setq buf (car gnus-soup-buffers)
- gnus-soup-buffers (cdr gnus-soup-buffers))
- (if (not (buffer-name buf))
- ()
- (set-buffer buf)
- (when (buffer-modified-p)
- (save-buffer))
- (kill-buffer (current-buffer)))))
- (gnus-soup-write-prefixes)))
-
-(defun gnus-soup-write-prefixes ()
- (let ((prefixes gnus-soup-last-prefix)
- prefix)
- (save-excursion
- (gnus-set-work-buffer)
- (while (setq prefix (pop prefixes))
- (erase-buffer)
- (insert (format "(setq gnus-soup-prev-prefix %d)\n" (cdr prefix)))
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer (concat (car prefix) gnus-soup-prefix-file)))))))
-
-(defun gnus-soup-pack (dir packer)
- (let* ((files (mapconcat 'identity
- '("AREAS" "*.MSG" "*.IDX" "INFO"
- "LIST" "REPLIES" "COMMANDS" "ERRORS")
- " "))
- (packer (if (< (string-match "%s" packer)
- (string-match "%d" packer))
- (format packer files
- (string-to-number (gnus-soup-unique-prefix dir)))
- (format packer
- (string-to-number (gnus-soup-unique-prefix dir))
- files)))
- (dir (expand-file-name dir)))
- (gnus-make-directory dir)
- (setq gnus-soup-areas nil)
- (gnus-message 4 "Packing %s..." packer)
- (if (eq 0 (call-process shell-file-name
- nil nil nil shell-command-switch
- (concat "cd " dir " ; " packer)))
- (progn
- (call-process shell-file-name nil nil nil shell-command-switch
- (concat "cd " dir " ; rm " files))
- (gnus-message 4 "Packing...done" packer))
- (error "Couldn't pack packet"))))
-
-(defun gnus-soup-parse-areas (file)
- "Parse soup area file FILE.
-The result is a of vectors, each containing one entry from the AREA file.
-The vector contain five strings,
- [prefix name encoding description number]
-though the two last may be nil if they are missing."
- (let (areas)
- (when (file-exists-p file)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file 'force))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field)
- (gnus-soup-field)
- (gnus-soup-field)
- (and (eq (preceding-char) ?\t)
- (gnus-soup-field))
- (and (eq (preceding-char) ?\t)
- (string-to-number (gnus-soup-field))))
- areas)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer))))
- areas))
-
-(defun gnus-soup-parse-replies (file)
- "Parse soup REPLIES file FILE.
-The result is a of vectors, each containing one entry from the REPLIES
-file. The vector contain three strings, [prefix name encoding]."
- (let (replies)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect file))
- (buffer-disable-undo)
- (goto-char (point-min))
- (while (not (eobp))
- (push (vector (gnus-soup-field) (gnus-soup-field)
- (gnus-soup-field))
- replies)
- (when (eq (preceding-char) ?\t)
- (beginning-of-line 2)))
- (kill-buffer (current-buffer)))
- replies))
-
-(defun gnus-soup-field ()
- (prog1
- (buffer-substring (point) (progn (skip-chars-forward "^\t\n") (point)))
- (forward-char 1)))
-
-(defun gnus-soup-read-areas ()
- (or gnus-soup-areas
- (setq gnus-soup-areas
- (gnus-soup-parse-areas (concat gnus-soup-directory "AREAS")))))
-
-(defun gnus-soup-write-areas ()
- "Write the AREAS file."
- (interactive)
- (when gnus-soup-areas
- (with-temp-file (concat gnus-soup-directory "AREAS")
- (let ((areas gnus-soup-areas)
- area)
- (while (setq area (pop areas))
- (insert
- (format
- "%s\t%s\t%s%s\n"
- (gnus-soup-area-prefix area)
- (gnus-soup-area-name area)
- (gnus-soup-area-encoding area)
- (if (or (gnus-soup-area-description area)
- (gnus-soup-area-number area))
- (concat "\t" (or (gnus-soup-area-description
- area) "")
- (if (gnus-soup-area-number area)
- (concat "\t" (int-to-string
- (gnus-soup-area-number area)))
- "")) ""))))))))
-
-(defun gnus-soup-write-replies (dir areas)
- "Write a REPLIES file in DIR containing AREAS."
- (with-temp-file (concat dir "REPLIES")
- (let (area)
- (while (setq area (pop areas))
- (insert (format "%s\t%s\t%s\n"
- (gnus-soup-reply-prefix area)
- (gnus-soup-reply-kind area)
- (gnus-soup-reply-encoding area)))))))
-
-(defun gnus-soup-area (group)
- (gnus-soup-read-areas)
- (let ((areas gnus-soup-areas)
- (real-group (gnus-group-real-name group))
- area result)
- (while areas
- (setq area (car areas)
- areas (cdr areas))
- (when (equal (gnus-soup-area-name area) real-group)
- (setq result area)))
- (unless result
- (setq result
- (vector (gnus-soup-unique-prefix)
- real-group
- (format "%c%c%c"
- gnus-soup-encoding-type
- gnus-soup-index-type
- (if (gnus-member-of-valid 'mail group) ?m ?n))
- nil nil)
- gnus-soup-areas (cons result gnus-soup-areas)))
- result))
-
-(defun gnus-soup-unique-prefix (&optional dir)
- (let* ((dir (file-name-as-directory (or dir gnus-soup-directory)))
- (entry (assoc dir gnus-soup-last-prefix))
- gnus-soup-prev-prefix)
- (if entry
- ()
- (when (file-exists-p (concat dir gnus-soup-prefix-file))
- (ignore-errors
- (load (concat dir gnus-soup-prefix-file) nil t t)))
- (push (setq entry (cons dir (or gnus-soup-prev-prefix 0)))
- gnus-soup-last-prefix))
- (setcdr entry (1+ (cdr entry)))
- (gnus-soup-write-prefixes)
- (int-to-string (cdr entry))))
-
-(defun gnus-soup-unpack-packet (dir unpacker packet)
- "Unpack PACKET into DIR using UNPACKER.
-Return whether the unpacking was successful."
- (gnus-make-directory dir)
- (gnus-message 4 "Unpacking: %s" (format unpacker packet))
- (prog1
- (eq 0 (call-process
- shell-file-name nil nil nil shell-command-switch
- (format "cd %s ; %s" (expand-file-name dir)
- (format unpacker packet))))
- (gnus-message 4 "Unpacking...done")))
-
-(defun gnus-soup-send-packet (packet)
- (gnus-soup-unpack-packet
- gnus-soup-replies-directory gnus-soup-unpacker packet)
- (let ((replies (gnus-soup-parse-replies
- (concat gnus-soup-replies-directory "REPLIES"))))
- (save-excursion
- (while replies
- (let* ((msg-file (concat gnus-soup-replies-directory
- (gnus-soup-reply-prefix (car replies))
- ".MSG"))
- (msg-buf (and (file-exists-p msg-file)
- (nnheader-find-file-noselect msg-file)))
- (tmp-buf (gnus-get-buffer-create " *soup send*"))
- beg end)
- (cond
- ((and (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?u)
- (/= (gnus-soup-encoding-format
- (gnus-soup-reply-encoding (car replies)))
- ?n)) ;; Gnus back compatibility.
- (error "Unsupported encoding"))
- ((null msg-buf)
- t)
- (t
- (buffer-disable-undo msg-buf)
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (not (eobp))
- (unless (looking-at "#! *rnews +\\([0-9]+\\)")
- (error "Bad header"))
- (forward-line 1)
- (setq beg (point)
- end (+ (point) (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1)))))
- (switch-to-buffer tmp-buf)
- (erase-buffer)
- (mm-disable-multibyte)
- (insert-buffer-substring msg-buf beg end)
- (cond
- ((string= (gnus-soup-reply-kind (car replies)) "news")
- (gnus-message 5 "Sending news message to %s..."
- (mail-fetch-field "newsgroups"))
- (sit-for 1)
- (let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me)
- (method (if (functionp message-post-method)
- (funcall message-post-method)
- message-post-method))
- result)
- (run-hooks 'message-send-news-hook)
- (gnus-open-server method)
- (message "Sending news via %s..."
- (gnus-server-string method))
- (unless (let ((mail-header-separator ""))
- (gnus-request-post method))
- (message "Couldn't send message via news: %s"
- (nnheader-get-report (car method))))))
- ((string= (gnus-soup-reply-kind (car replies)) "mail")
- (gnus-message 5 "Sending mail to %s..."
- (mail-fetch-field "to"))
- (sit-for 1)
- (let ((mail-header-separator ""))
- (mm-with-unibyte-current-buffer
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))))
- (t
- (error "Unknown reply kind")))
- (set-buffer msg-buf)
- (goto-char end))
- (delete-file (buffer-file-name))
- (kill-buffer msg-buf)
- (kill-buffer tmp-buf)
- (gnus-message 4 "Sent packet"))))
- (setq replies (cdr replies)))
- t)))
-
-(provide 'gnus-soup)
-
-;;; arch-tag: eddfa69d-13e8-4aea-84ef-62a526ef185c
-;;; gnus-soup.el ends here
+++ /dev/null
-;;; gnus-spec.el --- format spec functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(defvar gnus-newsrc-file-version)
-
-(require 'gnus)
-
-(defcustom gnus-use-correct-string-widths (featurep 'xemacs)
- "*If non-nil, use correct functions for dealing with wide characters."
- :version "22.1"
- :group 'gnus-format
- :type 'boolean)
-
-(defcustom gnus-make-format-preserve-properties (featurep 'xemacs)
- "*If non-nil, use a replacement `format' function which preserves
-text properties. This is only needed on XEmacs, as FSF Emacs does this anyway."
- :version "22.1"
- :group 'gnus-format
- :type 'boolean)
-
-;;; Internal variables.
-
-(defvar gnus-summary-mark-positions nil)
-(defvar gnus-group-mark-positions nil)
-(defvar gnus-group-indentation "")
-
-;; Format specs. The chunks below are the machine-generated forms
-;; that are to be evaled as the result of the default format strings.
-;; We write them in here to get them byte-compiled. That way the
-;; default actions will be quite fast, while still retaining the full
-;; flexibility of the user-defined format specs.
-
-;; First we have lots of dummy defvars to let the compiler know these
-;; are really dynamic variables.
-
-(defvar gnus-tmp-unread)
-(defvar gnus-tmp-replied)
-(defvar gnus-tmp-score-char)
-(defvar gnus-tmp-indentation)
-(defvar gnus-tmp-opening-bracket)
-(defvar gnus-tmp-lines)
-(defvar gnus-tmp-name)
-(defvar gnus-tmp-closing-bracket)
-(defvar gnus-tmp-subject-or-nil)
-(defvar gnus-tmp-subject)
-(defvar gnus-tmp-marked)
-(defvar gnus-tmp-marked-mark)
-(defvar gnus-tmp-subscribed)
-(defvar gnus-tmp-process-marked)
-(defvar gnus-tmp-number-of-unread)
-(defvar gnus-tmp-group-name)
-(defvar gnus-tmp-group)
-(defvar gnus-tmp-article-number)
-(defvar gnus-tmp-unread-and-unselected)
-(defvar gnus-tmp-news-method)
-(defvar gnus-tmp-news-server)
-(defvar gnus-tmp-article-number)
-(defvar gnus-mouse-face)
-(defvar gnus-mouse-face-prop)
-(defvar gnus-tmp-header)
-(defvar gnus-tmp-from)
-
-(defun gnus-summary-line-format-spec ()
- (insert gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-score-char gnus-tmp-indentation)
- (gnus-put-text-property
- (point)
- (progn
- (insert
- (format "%c%4s: %-23s%c" gnus-tmp-opening-bracket gnus-tmp-lines
- (let ((val
- (inline
- (gnus-summary-from-or-to-or-newsgroups
- gnus-tmp-header gnus-tmp-from))))
- (if (> (length val) 23)
- (substring val 0 23)
- val))
- gnus-tmp-closing-bracket))
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject-or-nil "\n"))
-
-(defvar gnus-summary-line-format-spec
- (gnus-byte-code 'gnus-summary-line-format-spec))
-
-(defun gnus-summary-dummy-line-format-spec ()
- (insert "* ")
- (gnus-put-text-property
- (point)
- (progn
- (insert ": :")
- (point))
- gnus-mouse-face-prop gnus-mouse-face)
- (insert " " gnus-tmp-subject "\n"))
-
-(defvar gnus-summary-dummy-line-format-spec
- (gnus-byte-code 'gnus-summary-dummy-line-format-spec))
-
-(defun gnus-group-line-format-spec ()
- (insert gnus-tmp-marked-mark gnus-tmp-subscribed
- gnus-tmp-process-marked
- gnus-group-indentation
- (format "%5s: " gnus-tmp-number-of-unread))
- (gnus-put-text-property
- (point)
- (progn
- (insert gnus-tmp-group "\n")
- (1- (point)))
- gnus-mouse-face-prop gnus-mouse-face))
-(defvar gnus-group-line-format-spec
- (gnus-byte-code 'gnus-group-line-format-spec))
-
-(defvar gnus-format-specs
- `((version . ,emacs-version)
- (gnus-version . ,(gnus-continuum-version))
- (group "%M\%S\%p\%P\%5y: %(%g%)%l\n" ,gnus-group-line-format-spec)
- (summary-dummy "* %(: :%) %S\n"
- ,gnus-summary-dummy-line-format-spec)
- (summary "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
- ,gnus-summary-line-format-spec))
- "Alist of format specs.")
-
-(defvar gnus-default-format-specs gnus-format-specs)
-
-(defvar gnus-article-mode-line-format-spec nil)
-(defvar gnus-summary-mode-line-format-spec nil)
-(defvar gnus-group-mode-line-format-spec nil)
-
-;;; Phew. All that gruft is over with, fortunately.
-
-;;;###autoload
-(defun gnus-update-format (var)
- "Update the format specification near point."
- (interactive
- (list
- (save-excursion
- (eval-defun nil)
- ;; Find the end of the current word.
- (re-search-forward "[ \t\n]" nil t)
- ;; Search backward.
- (when (re-search-backward "\\(gnus-[-a-z]+-line-format\\)" nil t)
- (match-string 1)))))
- (let* ((type (intern (progn (string-match "gnus-\\([-a-z]+\\)-line" var)
- (match-string 1 var))))
- (entry (assq type gnus-format-specs))
- value spec)
- (when entry
- (setq gnus-format-specs (delq entry gnus-format-specs)))
- (set
- (intern (format "%s-spec" var))
- (gnus-parse-format (setq value (symbol-value (intern var)))
- (symbol-value (intern (format "%s-alist" var)))
- (not (string-match "mode" var))))
- (setq spec (symbol-value (intern (format "%s-spec" var))))
- (push (list type value spec) gnus-format-specs)
-
- (pop-to-buffer "*Gnus Format*")
- (erase-buffer)
- (lisp-interaction-mode)
- (insert (gnus-pp-to-string spec))))
-
-(defun gnus-update-format-specifications (&optional force &rest types)
- "Update all (necessary) format specifications.
-Return a list of updated types."
- ;; Make the indentation array.
- ;; See whether all the stored info needs to be flushed.
- (when (or force
- (not gnus-newsrc-file-version)
- (not (equal (gnus-continuum-version)
- (gnus-continuum-version gnus-newsrc-file-version)))
- (not (equal emacs-version
- (cdr (assq 'version gnus-format-specs)))))
- (setq gnus-format-specs nil))
- ;; Flush the group format spec cache if it doesn't support decoded
- ;; group names.
- (when (memq 'group types)
- (let ((spec (assq 'group gnus-format-specs)))
- (unless (string-match " gnus-tmp-decoded-group[ )]"
- (gnus-prin1-to-string (nth 2 spec)))
- (setq gnus-format-specs (delq spec gnus-format-specs)))))
-
- ;; Go through all the formats and see whether they need updating.
- (let (new-format entry type val updated)
- (while (setq type (pop types))
- ;; Jump to the proper buffer to find out the value of the
- ;; variable, if possible. (It may be buffer-local.)
- (save-excursion
- (let ((buffer (intern (format "gnus-%s-buffer" type))))
- (when (and (boundp buffer)
- (setq val (symbol-value buffer))
- (gnus-buffer-exists-p val))
- (set-buffer val))
- (setq new-format (symbol-value
- (intern (format "gnus-%s-line-format" type)))))
- (setq entry (cdr (assq type gnus-format-specs)))
- (if (and (car entry)
- (equal (car entry) new-format))
- ;; Use the old format.
- (set (intern (format "gnus-%s-line-format-spec" type))
- (cadr entry))
- ;; This is a new format.
- (setq val
- (if (not (stringp new-format))
- ;; This is a function call or something.
- new-format
- ;; This is a "real" format.
- (gnus-parse-format
- new-format
- (symbol-value
- (intern (format "gnus-%s-line-format-alist" type)))
- (not (string-match "mode$" (symbol-name type))))))
- ;; Enter the new format spec into the list.
- (if entry
- (progn
- (setcar (cdr entry) val)
- (setcar entry new-format))
- (push (list type new-format val) gnus-format-specs))
- (set (intern (format "gnus-%s-line-format-spec" type)) val)
- (push type updated))))
-
- (unless (assq 'version gnus-format-specs)
- (push (cons 'version emacs-version) gnus-format-specs))
- updated))
-
-(defvar gnus-mouse-face-0 'highlight)
-(defvar gnus-mouse-face-1 'highlight)
-(defvar gnus-mouse-face-2 'highlight)
-(defvar gnus-mouse-face-3 'highlight)
-(defvar gnus-mouse-face-4 'highlight)
-
-(defun gnus-mouse-face-function (form type)
- `(gnus-put-text-property
- (point) (progn ,@form (point))
- gnus-mouse-face-prop
- ,(if (equal type 0)
- 'gnus-mouse-face
- `(quote ,(symbol-value (intern (format "gnus-mouse-face-%d" type)))))))
-
-(defvar gnus-face-0 'bold)
-(defvar gnus-face-1 'italic)
-(defvar gnus-face-2 'bold-italic)
-(defvar gnus-face-3 'bold)
-(defvar gnus-face-4 'bold)
-
-(defun gnus-face-face-function (form type)
- `(gnus-add-text-properties
- (point) (progn ,@form (point))
- '(gnus-face t face ,(symbol-value (intern (format "gnus-face-%d" type))))))
-
-(defun gnus-balloon-face-function (form type)
- `(gnus-put-text-property
- (point) (progn ,@form (point))
- ,(if (fboundp 'balloon-help-mode)
- ''balloon-help
- ''help-echo)
- ,(intern (format "gnus-balloon-face-%d" type))))
-
-(defun gnus-spec-tab (column)
- (if (> column 0)
- `(insert-char ? (max (- ,column (current-column)) 0))
- (let ((column (abs column)))
- `(if (> (current-column) ,column)
- (let ((end (point)))
- (if (= (move-to-column ,column) ,column)
- (delete-region (point) end)
- (delete-region (1- (point)) end)
- (insert " ")))
- (insert-char ? (max (- ,column (current-column)) 0))))))
-
-(defun gnus-correct-length (string)
- "Return the correct width of STRING."
- (let ((length 0))
- (mapcar (lambda (char) (incf length (gnus-char-width char))) string)
- length))
-
-(defun gnus-correct-substring (string start &optional end)
- (let ((wstart 0)
- (wend 0)
- (wseek 0)
- (seek 0)
- (length (length string))
- (string (concat string "\0")))
- ;; Find the start position.
- (while (and (< seek length)
- (< wseek start))
- (incf wseek (gnus-char-width (aref string seek)))
- (incf seek))
- (setq wstart seek)
- ;; Find the end position.
- (while (and (<= seek length)
- (or (not end)
- (<= wseek end)))
- (incf wseek (gnus-char-width (aref string seek)))
- (incf seek))
- (setq wend seek)
- (substring string wstart (1- wend))))
-
-(defun gnus-string-width-function ()
- (cond
- (gnus-use-correct-string-widths
- 'gnus-correct-length)
- ((fboundp 'string-width)
- 'string-width)
- (t
- 'length)))
-
-(defun gnus-substring-function ()
- (cond
- (gnus-use-correct-string-widths
- 'gnus-correct-substring)
- ((fboundp 'string-width)
- 'gnus-correct-substring)
- (t
- 'substring)))
-
-(defun gnus-tilde-max-form (el max-width)
- "Return a form that limits EL to MAX-WIDTH."
- (let ((max (abs max-width))
- (length-fun (gnus-string-width-function))
- (substring-fun (gnus-substring-function)))
- (if (symbolp el)
- `(if (> (,length-fun ,el) ,max)
- ,(if (< max-width 0)
- `(,substring-fun ,el (- (,length-fun ,el) ,max))
- `(,substring-fun ,el 0 ,max))
- ,el)
- `(let ((val (eval ,el)))
- (if (> (,length-fun val) ,max)
- ,(if (< max-width 0)
- `(,substring-fun val (- (,length-fun val) ,max))
- `(,substring-fun val 0 ,max))
- val)))))
-
-(defun gnus-tilde-cut-form (el cut-width)
- "Return a form that cuts CUT-WIDTH off of EL."
- (let ((cut (abs cut-width))
- (length-fun (gnus-string-width-function))
- (substring-fun (gnus-substring-function)))
- (if (symbolp el)
- `(if (> (,length-fun ,el) ,cut)
- ,(if (< cut-width 0)
- `(,substring-fun ,el 0 (- (,length-fun ,el) ,cut))
- `(,substring-fun ,el ,cut))
- ,el)
- `(let ((val (eval ,el)))
- (if (> (,length-fun val) ,cut)
- ,(if (< cut-width 0)
- `(,substring-fun val 0 (- (,length-fun val) ,cut))
- `(,substring-fun val ,cut))
- val)))))
-
-(defun gnus-tilde-ignore-form (el ignore-value)
- "Return a form that is blank when EL is IGNORE-VALUE."
- (if (symbolp el)
- `(if (equal ,el ,ignore-value)
- "" ,el)
- `(let ((val (eval ,el)))
- (if (equal val ,ignore-value)
- "" val))))
-
-(defun gnus-pad-form (el pad-width)
- "Return a form that pads EL to PAD-WIDTH accounting for multi-column
-characters correctly. This is because `format' may pad to columns or to
-characters when given a pad value."
- (let ((pad (abs pad-width))
- (side (< 0 pad-width))
- (length-fun (gnus-string-width-function)))
- (if (symbolp el)
- `(let ((need (- ,pad (,length-fun ,el))))
- (if (> need 0)
- (concat ,(when side '(make-string need ?\ ))
- ,el
- ,(when (not side) '(make-string need ?\ )))
- ,el))
- `(let* ((val (eval ,el))
- (need (- ,pad (,length-fun val))))
- (if (> need 0)
- (concat ,(when side '(make-string need ?\ ))
- val
- ,(when (not side) '(make-string need ?\ )))
- val)))))
-
-(defun gnus-parse-format (format spec-alist &optional insert)
- ;; This function parses the FORMAT string with the help of the
- ;; SPEC-ALIST and returns a list that can be eval'ed to return the
- ;; string. If the FORMAT string contains the specifiers %( and %)
- ;; the text between them will have the mouse-face text property.
- ;; If the FORMAT string contains the specifiers %[ and %], the text between
- ;; them will have the balloon-help text property.
- (let ((case-fold-search nil))
- (if (string-match
- "\\`\\(.*\\)%[0-9]?[{(«]\\(.*\\)%[0-9]?[»})]\\(.*\n?\\)\\'\\|%[-0-9]*=\\|%[-0-9]*\\*"
- format)
- (gnus-parse-complex-format format spec-alist)
- ;; This is a simple format.
- (gnus-parse-simple-format format spec-alist insert))))
-
-(defun gnus-parse-complex-format (format spec-alist)
- (let ((cursor-spec nil))
- (save-excursion
- (gnus-set-work-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "\"" nil t)
- (replace-match "\\\"" nil t))
- (goto-char (point-min))
- (insert "(\"")
- ;; Convert all font specs into font spec lists.
- (while (re-search-forward "%\\([0-9]+\\)?\\([«»{}()]\\)" nil t)
- (let ((number (if (match-beginning 1)
- (match-string 1) "0"))
- (delim (aref (match-string 2) 0)))
- (if (or (= delim ?\()
- (= delim ?\{)
- (= delim ?\«))
- (replace-match (concat "\"("
- (cond ((= delim ?\() "mouse")
- ((= delim ?\{) "face")
- (t "balloon"))
- " " number " \"")
- t t)
- (replace-match "\")\""))))
- (goto-char (point-max))
- (insert "\")")
- ;; Convert point position commands.
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (while (re-search-forward "%\\([-0-9]+\\)?\\*" nil t)
- (replace-match "\"(point)\"" t t)
- (setq cursor-spec t)))
- ;; Convert TAB commands.
- (goto-char (point-min))
- (while (re-search-forward "%\\([-0-9]+\\)=" nil t)
- (replace-match (format "\"(tab %s)\"" (match-string 1)) t t))
- ;; Convert the buffer into the spec.
- (goto-char (point-min))
- (let ((form (read (current-buffer))))
- (if cursor-spec
- `(let (gnus-position)
- ,@(gnus-complex-form-to-spec form spec-alist)
- (if gnus-position
- (gnus-put-text-property gnus-position (1+ gnus-position)
- 'gnus-position t)))
- `(progn
- ,@(gnus-complex-form-to-spec form spec-alist)))))))
-
-(defun gnus-complex-form-to-spec (form spec-alist)
- (delq nil
- (mapcar
- (lambda (sform)
- (cond
- ((stringp sform)
- (gnus-parse-simple-format sform spec-alist t))
- ((eq (car sform) 'point)
- '(setq gnus-position (point)))
- ((eq (car sform) 'tab)
- (gnus-spec-tab (cadr sform)))
- (t
- (funcall (intern (format "gnus-%s-face-function" (car sform)))
- (gnus-complex-form-to-spec (cddr sform) spec-alist)
- (nth 1 sform)))))
- form)))
-
-
-(defun gnus-xmas-format (fstring &rest args)
- "A version of `format' which preserves text properties.
-
-Required for XEmacs, where the built in `format' function strips all text
-properties from both the format string and any inserted strings.
-
-Only supports the format sequence %s, and %% for inserting
-literal % characters. A pad width and an optional - (to right pad)
-are supported for %s."
- (let ((re "%%\\|%\\(-\\)?\\([1-9][0-9]*\\)?s")
- (n (length args)))
- (with-temp-buffer
- (insert fstring)
- (goto-char (point-min))
- (while (re-search-forward re nil t)
- (goto-char (match-end 0))
- (cond
- ((string= (match-string 0) "%%")
- (delete-char -1))
- (t
- (if (null args)
- (error 'wrong-number-of-arguments #'my-format n fstring))
- (let* ((minlen (string-to-number (or (match-string 2) "")))
- (arg (car args))
- (str (if (stringp arg) arg (format "%s" arg)))
- (lpad (null (match-string 1)))
- (padlen (max 0 (- minlen (length str)))))
- (replace-match "")
- (if lpad (insert-char ?\ padlen))
- (insert str)
- (unless lpad (insert-char ?\ padlen))
- (setq args (cdr args))))))
- (buffer-string))))
-
-(defun gnus-parse-simple-format (format spec-alist &optional insert)
- ;; This function parses the FORMAT string with the help of the
- ;; SPEC-ALIST and returns a list that can be eval'ed to return a
- ;; string.
- (let ((max-width 0)
- spec flist fstring elem result dontinsert user-defined
- type value pad-width spec-beg cut-width ignore-value
- tilde-form tilde elem-type extended-spec)
- (save-excursion
- (gnus-set-work-buffer)
- (insert format)
- (goto-char (point-min))
- (while (re-search-forward "%" nil t)
- (setq user-defined nil
- spec-beg nil
- pad-width nil
- max-width nil
- cut-width nil
- ignore-value nil
- tilde-form nil
- extended-spec nil)
- (setq spec-beg (1- (point)))
-
- ;; Parse this spec fully.
- (while
- (cond
- ((looking-at "\\([-.0-9]+\\)\\(,[-0-9]+\\)?")
- (setq pad-width (string-to-number (match-string 1)))
- (when (match-beginning 2)
- (setq max-width (string-to-number (buffer-substring
- (1+ (match-beginning 2))
- (match-end 2)))))
- (goto-char (match-end 0)))
- ((looking-at "~")
- (forward-char 1)
- (setq tilde (read (current-buffer))
- type (car tilde)
- value (cadr tilde))
- (cond
- ((memq type '(pad pad-left))
- (setq pad-width value))
- ((eq type 'pad-right)
- (setq pad-width (- value)))
- ((memq type '(max-right max))
- (setq max-width value))
- ((eq type 'max-left)
- (setq max-width (- value)))
- ((memq type '(cut cut-left))
- (setq cut-width value))
- ((eq type 'cut-right)
- (setq cut-width (- value)))
- ((eq type 'ignore)
- (setq ignore-value
- (if (stringp value) value (format "%s" value))))
- ((eq type 'form)
- (setq tilde-form value))
- (t
- (error "Unknown tilde type: %s" tilde)))
- t)
- (t
- nil)))
- (cond
- ;; User-defined spec -- find the spec name.
- ((eq (setq spec (char-after)) ?u)
- (forward-char 1)
- (when (and (eq (setq user-defined (char-after)) ?&)
- (looking-at "&\\([^;]+\\);"))
- (setq user-defined (match-string 1))
- (goto-char (match-end 1))))
- ;; extended spec
- ((and (eq spec ?&) (looking-at "&\\([^;]+\\);"))
- (setq extended-spec (intern (match-string 1)))
- (goto-char (match-end 1))))
- (forward-char 1)
- (delete-region spec-beg (point))
-
- ;; Now we have all the relevant data on this spec, so
- ;; we start doing stuff.
- (insert "%")
- (if (eq spec ?%)
- ;; "%%" just results in a "%".
- (insert "%")
- (cond
- ;; Do tilde forms.
- ((eq spec ?@)
- (setq elem (list tilde-form ?s)))
- ;; Treat user defined format specifiers specially.
- (user-defined
- (setq elem
- (list
- (list (intern (format
- (if (stringp user-defined)
- "gnus-user-format-function-%s"
- "gnus-user-format-function-%c")
- user-defined))
- 'gnus-tmp-header)
- ?s)))
- ;; Find the specification from `spec-alist'.
- ((setq elem (cdr (assq (or extended-spec spec) spec-alist))))
- (t
- (setq elem '("*" ?s))))
- (setq elem-type (cadr elem))
- ;; Insert the new format elements.
- (when (and pad-width
- (not (and (featurep 'xemacs)
- gnus-use-correct-string-widths)))
- (insert (number-to-string pad-width)))
- ;; Create the form to be evaled.
- (if (or max-width cut-width ignore-value
- (and (featurep 'xemacs)
- gnus-use-correct-string-widths))
- (progn
- (insert ?s)
- (let ((el (car elem)))
- (cond ((= (cadr elem) ?c)
- (setq el (list 'char-to-string el)))
- ((= (cadr elem) ?d)
- (setq el (list 'int-to-string el))))
- (when ignore-value
- (setq el (gnus-tilde-ignore-form el ignore-value)))
- (when cut-width
- (setq el (gnus-tilde-cut-form el cut-width)))
- (when max-width
- (setq el (gnus-tilde-max-form el max-width)))
- (when pad-width
- (setq el (gnus-pad-form el pad-width)))
- (push el flist)))
- (insert elem-type)
- (push (car elem) flist))))
- (setq fstring (buffer-substring-no-properties (point-min) (point-max))))
-
- ;; Do some postprocessing to increase efficiency.
- (setq
- result
- (cond
- ;; Emptiness.
- ((string= fstring "")
- nil)
- ;; Not a format string.
- ((not (string-match "%" fstring))
- (list fstring))
- ;; A format string with just a single string spec.
- ((string= fstring "%s")
- (list (car flist)))
- ;; A single character.
- ((string= fstring "%c")
- (list (car flist)))
- ;; A single number.
- ((string= fstring "%d")
- (setq dontinsert t)
- (if insert
- (list `(princ ,(car flist)))
- (list `(int-to-string ,(car flist)))))
- ;; Just lots of chars and strings.
- ((string-match "\\`\\(%[cs]\\)+\\'" fstring)
- (nreverse flist))
- ;; A single string spec at the beginning of the spec.
- ((string-match "\\`%[sc][^%]+\\'" fstring)
- (list (car flist) (substring fstring 2)))
- ;; A single string spec in the middle of the spec.
- ((string-match "\\`\\([^%]+\\)%[sc]\\([^%]+\\)\\'" fstring)
- (list (match-string 1 fstring) (car flist) (match-string 2 fstring)))
- ;; A single string spec in the end of the spec.
- ((string-match "\\`\\([^%]+\\)%[sc]\\'" fstring)
- (list (match-string 1 fstring) (car flist)))
- ;; Only string (and %) specs (XEmacs only!)
- ((and (featurep 'xemacs)
- gnus-make-format-preserve-properties
- (string-match
- "\\`\\([^%]*\\(%%\\|%-?\\([1-9][0-9]*\\)?s\\)\\)*[^%]*\\'"
- fstring))
- (list (cons 'gnus-xmas-format (cons fstring (nreverse flist)))))
- ;; A more complex spec.
- (t
- (list (cons 'format (cons fstring (nreverse flist)))))))
-
- (if insert
- (when result
- (if dontinsert
- result
- (cons 'insert result)))
- (cond ((stringp result)
- result)
- ((consp result)
- (cons 'concat result))
- (t "")))))
-
-(defun gnus-eval-format (format &optional alist props)
- "Eval the format variable FORMAT, using ALIST.
-If PROPS, insert the result."
- (let ((form (gnus-parse-format format alist props)))
- (if props
- (gnus-add-text-properties (point) (progn (eval form) (point)) props)
- (eval form))))
-
-(defun gnus-compile ()
- "Byte-compile the user-defined format specs."
- (interactive)
- (require 'bytecomp)
- (let ((entries gnus-format-specs)
- (byte-compile-warnings '(unresolved callargs redefine))
- entry gnus-tmp-func)
- (save-excursion
- (gnus-message 7 "Compiling format specs...")
-
- (while entries
- (setq entry (pop entries))
- (if (memq (car entry) '(gnus-version version))
- (setq gnus-format-specs (delq entry gnus-format-specs))
- (let ((form (caddr entry)))
- (when (and (listp form)
- ;; Under GNU Emacs, it's (byte-code ...)
- (not (eq 'byte-code (car form)))
- ;; Under XEmacs, it's (funcall #<compiled-function ...>)
- (not (and (eq 'funcall (car form))
- (byte-code-function-p (cadr form)))))
- (defalias 'gnus-tmp-func `(lambda () ,form))
- (byte-compile 'gnus-tmp-func)
- (setcar (cddr entry) (gnus-byte-code 'gnus-tmp-func))))))
-
- (push (cons 'version emacs-version) gnus-format-specs)
- ;; Mark the .newsrc.eld file as "dirty".
- (gnus-dribble-touch)
- (gnus-message 7 "Compiling user specs...done"))))
-
-(defun gnus-set-format (type &optional insertable)
- (set (intern (format "gnus-%s-line-format-spec" type))
- (gnus-parse-format
- (symbol-value (intern (format "gnus-%s-line-format" type)))
- (symbol-value (intern (format "gnus-%s-line-format-alist" type)))
- insertable)))
-
-(provide 'gnus-spec)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: a4328fa1-1f84-4b09-97ad-4b5767cfd50f
-;;; gnus-spec.el ends here
+++ /dev/null
-;;; gnus-srvr.el --- virtual server support for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-spec)
-(require 'gnus-group)
-(require 'gnus-int)
-(require 'gnus-range)
-
-(defcustom gnus-server-mode-hook nil
- "Hook run in `gnus-server-mode' buffers."
- :group 'gnus-server
- :type 'hook)
-
-(defcustom gnus-server-exit-hook nil
- "Hook run when exiting the server buffer."
- :group 'gnus-server
- :type 'hook)
-
-(defcustom gnus-server-line-format " {%(%h:%w%)} %s%a\n"
- "Format of server lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-The following specs are understood:
-
-%h backend
-%n name
-%w address
-%s status
-%a agent covered
-
-General format specifiers can also be used.
-See Info node `(gnus)Formatting Variables'."
- :link '(custom-manual "(gnus)Formatting Variables")
- :group 'gnus-server-visual
- :type 'string)
-
-(defcustom gnus-server-mode-line-format "Gnus: %%b"
- "The format specification for the server mode line."
- :group 'gnus-server-visual
- :type 'string)
-
-(defcustom gnus-server-browse-in-group-buffer nil
- "Whether server browsing should take place in the group buffer.
-If nil, a faster, but more primitive, buffer is used instead."
- :version "22.1"
- :group 'gnus-server-visual
- :type 'boolean)
-
-;;; Internal variables.
-
-(defvar gnus-inserted-opened-servers nil)
-
-(defvar gnus-server-line-format-alist
- `((?h gnus-tmp-how ?s)
- (?n gnus-tmp-name ?s)
- (?w gnus-tmp-where ?s)
- (?s gnus-tmp-status ?s)
- (?a gnus-tmp-agent ?s)))
-
-(defvar gnus-server-mode-line-format-alist
- `((?S gnus-tmp-news-server ?s)
- (?M gnus-tmp-news-method ?s)
- (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-server-line-format-spec nil)
-(defvar gnus-server-mode-line-format-spec nil)
-(defvar gnus-server-killed-servers nil)
-
-(defvar gnus-server-mode-map)
-
-(defvar gnus-server-menu-hook nil
- "*Hook run after the creation of the server mode menu.")
-
-(defun gnus-server-make-menu-bar ()
- (gnus-turn-off-edit-menu 'server)
- (unless (boundp 'gnus-server-server-menu)
- (easy-menu-define
- gnus-server-server-menu gnus-server-mode-map ""
- '("Server"
- ["Add..." gnus-server-add-server t]
- ["Browse" gnus-server-read-server t]
- ["Scan" gnus-server-scan-server t]
- ["List" gnus-server-list-servers t]
- ["Kill" gnus-server-kill-server t]
- ["Yank" gnus-server-yank-server t]
- ["Copy" gnus-server-copy-server t]
- ["Edit" gnus-server-edit-server t]
- ["Regenerate" gnus-server-regenerate-server t]
- ["Exit" gnus-server-exit t]))
-
- (easy-menu-define
- gnus-server-connections-menu gnus-server-mode-map ""
- '("Connections"
- ["Open" gnus-server-open-server t]
- ["Close" gnus-server-close-server t]
- ["Offline" gnus-server-offline-server t]
- ["Deny" gnus-server-deny-server t]
- "---"
- ["Open All" gnus-server-open-all-servers t]
- ["Close All" gnus-server-close-all-servers t]
- ["Reset All" gnus-server-remove-denials t]))
-
- (gnus-run-hooks 'gnus-server-menu-hook)))
-
-(defvar gnus-server-mode-map nil)
-(put 'gnus-server-mode 'mode-class 'special)
-
-(unless gnus-server-mode-map
- (setq gnus-server-mode-map (make-sparse-keymap))
- (suppress-keymap gnus-server-mode-map)
-
- (gnus-define-keys gnus-server-mode-map
- " " gnus-server-read-server-in-server-buffer
- "\r" gnus-server-read-server
- gnus-mouse-2 gnus-server-pick-server
- "q" gnus-server-exit
- "l" gnus-server-list-servers
- "k" gnus-server-kill-server
- "y" gnus-server-yank-server
- "c" gnus-server-copy-server
- "a" gnus-server-add-server
- "e" gnus-server-edit-server
- "s" gnus-server-scan-server
-
- "O" gnus-server-open-server
- "\M-o" gnus-server-open-all-servers
- "C" gnus-server-close-server
- "\M-c" gnus-server-close-all-servers
- "D" gnus-server-deny-server
- "L" gnus-server-offline-server
- "R" gnus-server-remove-denials
-
- "n" next-line
- "p" previous-line
-
- "g" gnus-server-regenerate-server
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
-
-(defface gnus-server-agent
- '((((class color) (background light)) (:foreground "PaleTurquoise" :bold t))
- (((class color) (background dark)) (:foreground "PaleTurquoise" :bold t))
- (t (:bold t)))
- "Face used for displaying AGENTIZED servers"
- :group 'gnus-server-visual)
-;; backward-compatibility alias
-(put 'gnus-server-agent-face 'face-alias 'gnus-server-agent)
-
-(defface gnus-server-opened
- '((((class color) (background light)) (:foreground "Green3" :bold t))
- (((class color) (background dark)) (:foreground "Green1" :bold t))
- (t (:bold t)))
- "Face used for displaying OPENED servers"
- :group 'gnus-server-visual)
-;; backward-compatibility alias
-(put 'gnus-server-opened-face 'face-alias 'gnus-server-opened)
-
-(defface gnus-server-closed
- '((((class color) (background light)) (:foreground "Steel Blue" :italic t))
- (((class color) (background dark))
- (:foreground "Light Steel Blue" :italic t))
- (t (:italic t)))
- "Face used for displaying CLOSED servers"
- :group 'gnus-server-visual)
-;; backward-compatibility alias
-(put 'gnus-server-closed-face 'face-alias 'gnus-server-closed)
-
-(defface gnus-server-denied
- '((((class color) (background light)) (:foreground "Red" :bold t))
- (((class color) (background dark)) (:foreground "Pink" :bold t))
- (t (:inverse-video t :bold t)))
- "Face used for displaying DENIED servers"
- :group 'gnus-server-visual)
-;; backward-compatibility alias
-(put 'gnus-server-denied-face 'face-alias 'gnus-server-denied)
-
-(defface gnus-server-offline
- '((((class color) (background light)) (:foreground "Orange" :bold t))
- (((class color) (background dark)) (:foreground "Yellow" :bold t))
- (t (:inverse-video t :bold t)))
- "Face used for displaying OFFLINE servers"
- :group 'gnus-server-visual)
-;; backward-compatibility alias
-(put 'gnus-server-offline-face 'face-alias 'gnus-server-offline)
-
-(defvar gnus-server-font-lock-keywords
- '(("(\\(agent\\))" 1 'gnus-server-agent)
- ("(\\(opened\\))" 1 'gnus-server-opened)
- ("(\\(closed\\))" 1 'gnus-server-closed)
- ("(\\(offline\\))" 1 'gnus-server-offline)
- ("(\\(denied\\))" 1 'gnus-server-denied)))
-
-(defun gnus-server-mode ()
- "Major mode for listing and editing servers.
-
-All normal editing commands are switched off.
-\\<gnus-server-mode-map>
-For more in-depth information on this mode, read the manual
-\(`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-server-mode-map}"
- (interactive)
- (when (gnus-visual-p 'server-menu 'menu)
- (gnus-server-make-menu-bar))
- (kill-all-local-variables)
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-server-mode)
- (setq mode-name "Server")
- (gnus-set-default-directory)
- (setq mode-line-process nil)
- (use-local-map gnus-server-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (if (featurep 'xemacs)
- (put 'gnus-server-mode 'font-lock-defaults '(gnus-server-font-lock-keywords t))
- (set (make-local-variable 'font-lock-defaults)
- '(gnus-server-font-lock-keywords t)))
- (gnus-run-mode-hooks 'gnus-server-mode-hook))
-
-(defun gnus-server-insert-server-line (gnus-tmp-name method)
- (let* ((gnus-tmp-how (car method))
- (gnus-tmp-where (nth 1 method))
- (elem (assoc method gnus-opened-servers))
- (gnus-tmp-status
- (cond
- ((eq (nth 1 elem) 'denied) "(denied)")
- ((eq (nth 1 elem) 'offline) "(offline)")
- (t
- (condition-case nil
- (if (or (gnus-server-opened method)
- (eq (nth 1 elem) 'ok))
- "(opened)"
- "(closed)")
- ((error) "(error)")))))
- (gnus-tmp-agent (if (and gnus-agent
- (gnus-agent-method-p method))
- " (agent)"
- "")))
- (beginning-of-line)
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- ;; Insert the text.
- (eval gnus-server-line-format-spec))
- (list 'gnus-server (intern gnus-tmp-name)
- 'gnus-named-server (intern (gnus-method-to-server method))))))
-
-(defun gnus-enter-server-buffer ()
- "Set up the server buffer."
- (gnus-server-setup-buffer)
- (gnus-configure-windows 'server)
- (gnus-server-prepare))
-
-(defun gnus-server-setup-buffer ()
- "Initialize the server buffer."
- (unless (get-buffer gnus-server-buffer)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-server-buffer))
- (gnus-server-mode)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'server)))))
-
-(defun gnus-server-prepare ()
- (gnus-set-format 'server-mode)
- (gnus-set-format 'server t)
- (let ((alist gnus-server-alist)
- (buffer-read-only nil)
- (opened gnus-opened-servers)
- done server op-ser)
- (erase-buffer)
- (setq gnus-inserted-opened-servers nil)
- ;; First we do the real list of servers.
- (while alist
- (unless (member (cdar alist) done)
- (push (cdar alist) done)
- (setq server (pop alist))
- (when (and server (car server) (cdr server))
- (gnus-server-insert-server-line (car server) (cdr server))))
- (when (member (cdar alist) done)
- (pop alist)))
- ;; Then we insert the list of servers that have been opened in
- ;; this session.
- (while opened
- (when (and (not (member (caar opened) done))
- ;; Just ignore ephemeral servers.
- (not (member (caar opened) gnus-ephemeral-servers)))
- (push (caar opened) done)
- (gnus-server-insert-server-line
- (setq op-ser (format "%s:%s" (caaar opened) (nth 1 (caar opened))))
- (caar opened))
- (push (list op-ser (caar opened)) gnus-inserted-opened-servers))
- (setq opened (cdr opened))))
- (goto-char (point-min))
- (gnus-server-position-point))
-
-(defun gnus-server-server-name ()
- (let ((server (get-text-property (gnus-point-at-bol) 'gnus-server)))
- (and server (symbol-name server))))
-
-(defun gnus-server-named-server ()
- "Returns a server name that matches one of the names returned by
-gnus-method-to-server."
- (let ((server (get-text-property (gnus-point-at-bol) 'gnus-named-server)))
- (and server (symbol-name server))))
-
-(defalias 'gnus-server-position-point 'gnus-goto-colon)
-
-(defconst gnus-server-edit-buffer "*Gnus edit server*")
-
-(defun gnus-server-update-server (server)
- (save-excursion
- (set-buffer gnus-server-buffer)
- (let* ((buffer-read-only nil)
- (entry (assoc server gnus-server-alist))
- (oentry (assoc (gnus-server-to-method server)
- gnus-opened-servers)))
- (when entry
- (gnus-dribble-enter
- (concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string (cdr entry)) ")\n")))
- (when (or entry oentry)
- ;; Buffer may be narrowed.
- (save-restriction
- (widen)
- (when (gnus-server-goto-server server)
- (gnus-delete-line))
- (if entry
- (gnus-server-insert-server-line (car entry) (cdr entry))
- (gnus-server-insert-server-line
- (format "%s:%s" (caar oentry) (nth 1 (car oentry)))
- (car oentry)))
- (gnus-server-position-point))))))
-
-(defun gnus-server-set-info (server info)
- ;; Enter a select method into the virtual server alist.
- (when (and server info)
- (gnus-dribble-enter
- (concat "(gnus-server-set-info \"" server "\" '"
- (gnus-prin1-to-string info) ")"))
- (let* ((server (nth 1 info))
- (entry (assoc server gnus-server-alist))
- (cached (assoc server gnus-server-method-cache)))
- (if cached
- (setq gnus-server-method-cache
- (delq cached gnus-server-method-cache)))
- (if entry (setcdr entry info)
- (setq gnus-server-alist
- (nconc gnus-server-alist (list (cons server info))))))))
-
-;;; Interactive server functions.
-
-(defun gnus-server-kill-server (server)
- "Kill the server on the current line."
- (interactive (list (gnus-server-server-name)))
- (unless (gnus-server-goto-server server)
- (if server (error "No such server: %s" server)
- (error "No server on the current line")))
- (unless (assoc server gnus-server-alist)
- (error "Read-only server %s" server))
- (gnus-dribble-touch)
- (let ((buffer-read-only nil))
- (gnus-delete-line))
- (push (assoc server gnus-server-alist) gnus-server-killed-servers)
- (setq gnus-server-alist (delq (car gnus-server-killed-servers)
- gnus-server-alist))
- (let ((groups (gnus-groups-from-server server)))
- (when (and groups
- (gnus-yes-or-no-p
- (format "Kill all %s groups from this server? "
- (length groups))))
- (dolist (group groups)
- (setq gnus-newsrc-alist
- (delq (assoc group gnus-newsrc-alist)
- gnus-newsrc-alist))
- (when gnus-group-change-level-function
- (funcall gnus-group-change-level-function
- group gnus-level-killed 3)))))
- (gnus-server-position-point))
-
-(defun gnus-server-yank-server ()
- "Yank the previously killed server."
- (interactive)
- (unless gnus-server-killed-servers
- (error "No killed servers to be yanked"))
- (let ((alist gnus-server-alist)
- (server (gnus-server-server-name))
- (killed (car gnus-server-killed-servers)))
- (if (not server)
- (setq gnus-server-alist (nconc gnus-server-alist (list killed)))
- (if (string= server (caar gnus-server-alist))
- (push killed gnus-server-alist)
- (while (and (cdr alist)
- (not (string= server (caadr alist))))
- (setq alist (cdr alist)))
- (if alist
- (setcdr alist (cons killed (cdr alist)))
- (setq gnus-server-alist (list killed)))))
- (gnus-server-update-server (car killed))
- (setq gnus-server-killed-servers (cdr gnus-server-killed-servers))
- (gnus-server-position-point)))
-
-(defun gnus-server-exit ()
- "Return to the group buffer."
- (interactive)
- (gnus-run-hooks 'gnus-server-exit-hook)
- (gnus-kill-buffer (current-buffer))
- (gnus-configure-windows 'group t))
-
-(defun gnus-server-list-servers ()
- "List all available servers."
- (interactive)
- (let ((cur (gnus-server-server-name)))
- (gnus-server-prepare)
- (if cur (gnus-server-goto-server cur)
- (goto-char (point-max))
- (forward-line -1))
- (gnus-server-position-point)))
-
-(defun gnus-server-set-status (method status)
- "Make METHOD have STATUS."
- (let ((entry (assoc method gnus-opened-servers)))
- (if entry
- (setcar (cdr entry) status)
- (push (list method status) gnus-opened-servers))))
-
-(defun gnus-opened-servers-remove (method)
- "Remove METHOD from the list of opened servers."
- (setq gnus-opened-servers (delq (assoc method gnus-opened-servers)
- gnus-opened-servers)))
-
-(defun gnus-server-open-server (server)
- "Force an open of SERVER."
- (interactive (list (gnus-server-server-name)))
- (let ((method (gnus-server-to-method server)))
- (unless method
- (error "No such server: %s" server))
- (gnus-server-set-status method 'ok)
- (prog1
- (or (gnus-open-server method)
- (progn (message "Couldn't open %s" server) nil))
- (gnus-server-update-server server)
- (gnus-server-position-point))))
-
-(defun gnus-server-open-all-servers ()
- "Open all servers."
- (interactive)
- (let ((servers gnus-inserted-opened-servers))
- (while servers
- (gnus-server-open-server (car (pop servers))))))
-
-(defun gnus-server-close-server (server)
- "Close SERVER."
- (interactive (list (gnus-server-server-name)))
- (let ((method (gnus-server-to-method server)))
- (unless method
- (error "No such server: %s" server))
- (gnus-server-set-status method 'closed)
- (prog1
- (gnus-close-server method)
- (gnus-server-update-server server)
- (gnus-server-position-point))))
-
-(defun gnus-server-offline-server (server)
- "Set SERVER to offline."
- (interactive (list (gnus-server-server-name)))
- (let ((method (gnus-server-to-method server)))
- (unless method
- (error "No such server: %s" server))
- (prog1
- (gnus-close-server method)
- (gnus-server-set-status method 'offline)
- (gnus-server-update-server server)
- (gnus-server-position-point))))
-
-(defun gnus-server-close-all-servers ()
- "Close all servers."
- (interactive)
- (dolist (server gnus-inserted-opened-servers)
- (gnus-server-close-server (car server))))
-
-(defun gnus-server-deny-server (server)
- "Make sure SERVER will never be attempted opened."
- (interactive (list (gnus-server-server-name)))
- (let ((method (gnus-server-to-method server)))
- (unless method
- (error "No such server: %s" server))
- (gnus-server-set-status method 'denied))
- (gnus-server-update-server server)
- (gnus-server-position-point)
- t)
-
-(defun gnus-server-remove-denials ()
- "Make all denied servers into closed servers."
- (interactive)
- (dolist (server gnus-opened-servers)
- (when (eq (nth 1 server) 'denied)
- (setcar (nthcdr 1 server) 'closed)))
- (gnus-server-list-servers))
-
-(defun gnus-server-copy-server (from to)
- (interactive
- (list
- (or (gnus-server-server-name)
- (error "No server on the current line"))
- (read-string "Copy to: ")))
- (unless from
- (error "No server on current line"))
- (unless (and to (not (string= to "")))
- (error "No name to copy to"))
- (when (assoc to gnus-server-alist)
- (error "%s already exists" to))
- (unless (gnus-server-to-method from)
- (error "%s: no such server" from))
- (let ((to-entry (cons from (gnus-copy-sequence
- (gnus-server-to-method from)))))
- (setcar to-entry to)
- (setcar (nthcdr 2 to-entry) to)
- (push to-entry gnus-server-killed-servers)
- (gnus-server-yank-server)))
-
-(defun gnus-server-add-server (how where)
- (interactive
- (list (intern (completing-read "Server method: "
- gnus-valid-select-methods nil t))
- (read-string "Server name: ")))
- (when (assq where gnus-server-alist)
- (error "Server with that name already defined"))
- (push (list where how where) gnus-server-killed-servers)
- (gnus-server-yank-server))
-
-(defun gnus-server-goto-server (server)
- "Jump to a server line."
- (interactive
- (list (completing-read "Goto server: " gnus-server-alist nil t)))
- (let ((to (text-property-any (point-min) (point-max)
- 'gnus-server (intern server))))
- (when to
- (goto-char to)
- (gnus-server-position-point))))
-
-(defun gnus-server-edit-server (server)
- "Edit the server on the current line."
- (interactive (list (gnus-server-server-name)))
- (unless server
- (error "No server on current line"))
- (unless (assoc server gnus-server-alist)
- (error "This server can't be edited"))
- (let ((info (cdr (assoc server gnus-server-alist))))
- (gnus-close-server info)
- (gnus-edit-form
- info "Editing the server."
- `(lambda (form)
- (gnus-server-set-info ,server form)
- (gnus-server-list-servers)
- (gnus-server-position-point)))))
-
-(defun gnus-server-scan-server (server)
- "Request a scan from the current server."
- (interactive (list (gnus-server-server-name)))
- (let ((method (gnus-server-to-method server)))
- (if (not (gnus-get-function method 'request-scan))
- (error "Server %s can't scan" (car method))
- (gnus-message 3 "Scanning %s..." server)
- (gnus-request-scan nil method)
- (gnus-message 3 "Scanning %s...done" server))))
-
-(defun gnus-server-read-server-in-server-buffer (server)
- "Browse a server in server buffer."
- (interactive (list (gnus-server-server-name)))
- (let (gnus-server-browse-in-group-buffer)
- (gnus-server-read-server server)))
-
-(defun gnus-server-read-server (server)
- "Browse a server."
- (interactive (list (gnus-server-server-name)))
- (let ((buf (current-buffer)))
- (prog1
- (gnus-browse-foreign-server server buf)
- (save-excursion
- (set-buffer buf)
- (gnus-server-update-server (gnus-server-server-name))
- (gnus-server-position-point)))))
-
-(defun gnus-server-pick-server (e)
- (interactive "e")
- (mouse-set-point e)
- (gnus-server-read-server (gnus-server-server-name)))
-
-\f
-;;;
-;;; Browse Server Mode
-;;;
-
-(defvar gnus-browse-menu-hook nil
- "*Hook run after the creation of the browse mode menu.")
-
-(defvar gnus-browse-mode-hook nil)
-(defvar gnus-browse-mode-map nil)
-(put 'gnus-browse-mode 'mode-class 'special)
-
-(unless gnus-browse-mode-map
- (setq gnus-browse-mode-map (make-keymap))
- (suppress-keymap gnus-browse-mode-map)
-
- (gnus-define-keys
- gnus-browse-mode-map
- " " gnus-browse-read-group
- "=" gnus-browse-select-group
- "n" gnus-browse-next-group
- "p" gnus-browse-prev-group
- "\177" gnus-browse-prev-group
- [delete] gnus-browse-prev-group
- "N" gnus-browse-next-group
- "P" gnus-browse-prev-group
- "\M-n" gnus-browse-next-group
- "\M-p" gnus-browse-prev-group
- "\r" gnus-browse-select-group
- "u" gnus-browse-unsubscribe-current-group
- "l" gnus-browse-exit
- "L" gnus-browse-exit
- "q" gnus-browse-exit
- "Q" gnus-browse-exit
- "d" gnus-browse-describe-group
- "\C-c\C-c" gnus-browse-exit
- "?" gnus-browse-describe-briefly
-
- "\C-c\C-i" gnus-info-find-node
- "\C-c\C-b" gnus-bug))
-
-(defun gnus-browse-make-menu-bar ()
- (gnus-turn-off-edit-menu 'browse)
- (unless (boundp 'gnus-browse-menu)
- (easy-menu-define
- gnus-browse-menu gnus-browse-mode-map ""
- '("Browse"
- ["Subscribe" gnus-browse-unsubscribe-current-group t]
- ["Read" gnus-browse-read-group t]
- ["Select" gnus-browse-select-group t]
- ["Describe" gnus-browse-describe-group t]
- ["Next" gnus-browse-next-group t]
- ["Prev" gnus-browse-prev-group t]
- ["Exit" gnus-browse-exit t]))
- (gnus-run-hooks 'gnus-browse-menu-hook)))
-
-(defvar gnus-browse-current-method nil)
-(defvar gnus-browse-return-buffer nil)
-
-(defvar gnus-browse-buffer "*Gnus Browse Server*")
-
-(defun gnus-browse-foreign-server (server &optional return-buffer)
- "Browse the server SERVER."
- (setq gnus-browse-current-method (gnus-server-to-method server))
- (setq gnus-browse-return-buffer return-buffer)
- (let* ((method gnus-browse-current-method)
- (orig-select-method gnus-select-method)
- (gnus-select-method method)
- groups group)
- (gnus-message 5 "Connecting to %s..." (nth 1 method))
- (cond
- ((not (gnus-check-server method))
- (gnus-message
- 1 "Unable to contact server %s: %s" (nth 1 method)
- (gnus-status-message method))
- nil)
- ((not
- (prog2
- (gnus-message 6 "Reading active file...")
- (gnus-request-list method)
- (gnus-message 6 "Reading active file...done")))
- (gnus-message
- 1 "Couldn't request list: %s" (gnus-status-message method))
- nil)
- (t
- (with-current-buffer nntp-server-buffer
- (let ((cur (current-buffer)))
- (goto-char (point-min))
- (unless (string= gnus-ignored-newsgroups "")
- (delete-matching-lines gnus-ignored-newsgroups))
- ;; We treat NNTP as a special case to avoid problems with
- ;; garbage group names like `"foo' that appear in some badly
- ;; managed active files. -jh.
- (if (eq (car method) 'nntp)
- (while (not (eobp))
- (ignore-errors
- (push (cons
- (buffer-substring
- (point)
- (progn
- (skip-chars-forward "^ \t")
- (point)))
- (let ((last (read cur)))
- (cons (read cur) last)))
- groups))
- (forward-line))
- (while (not (eobp))
- (ignore-errors
- (push (cons
- (if (eq (char-after) ?\")
- (read cur)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^ \t\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^ \t\\\\")
- (setq name (concat name (buffer-substring
- p (point)))))
- name))
- (let ((last (read cur)))
- (cons (read cur) last)))
- groups))
- (forward-line)))))
- (setq groups (sort groups
- (lambda (l1 l2)
- (string< (car l1) (car l2)))))
- (if gnus-server-browse-in-group-buffer
- (let* ((gnus-select-method orig-select-method)
- (gnus-group-listed-groups
- (mapcar (lambda (group)
- (let ((name
- (gnus-group-prefixed-name
- (car group) method)))
- (gnus-set-active name (cdr group))
- name))
- groups)))
- (gnus-configure-windows 'group)
- (funcall gnus-group-prepare-function
- gnus-level-killed 'ignore 1 'ignore))
- (gnus-get-buffer-create gnus-browse-buffer)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'browse))
- (gnus-configure-windows 'browse)
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer))
- (gnus-browse-mode)
- (setq mode-line-buffer-identification
- (list
- (format
- "Gnus: %%b {%s:%s}" (car method) (cadr method))))
- (let ((buffer-read-only nil)
- name
- (prefix (let ((gnus-select-method orig-select-method))
- (gnus-group-prefixed-name "" method))))
- (while (setq group (pop groups))
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- (insert
- (format "%c%7d: %s\n"
- (let ((level (gnus-group-level
- (concat prefix (setq name (car group))))))
- (cond
- ((<= level gnus-level-subscribed) ? )
- ((<= level gnus-level-unsubscribed) ?U)
- ((= level gnus-level-zombie) ?Z)
- (t ?K)))
- (max 0 (- (1+ (cddr group)) (cadr group)))
- (mm-decode-coding-string
- name
- (inline (gnus-group-name-charset method name))))))
- (list 'gnus-group name))))
- (switch-to-buffer (current-buffer)))
- (goto-char (point-min))
- (gnus-group-position-point)
- (gnus-message 5 "Connecting to %s...done" (nth 1 method))
- t))))
-
-(defun gnus-browse-mode ()
- "Major mode for browsing a foreign server.
-
-All normal editing commands are switched off.
-
-\\<gnus-browse-mode-map>
-The only things you can do in this buffer is
-
-1) `\\[gnus-browse-unsubscribe-current-group]' to subscribe to a group.
-The group will be inserted into the group buffer upon exit from this
-buffer.
-
-2) `\\[gnus-browse-read-group]' to read a group ephemerally.
-
-3) `\\[gnus-browse-exit]' to return to the group buffer."
- (interactive)
- (kill-all-local-variables)
- (when (gnus-visual-p 'browse-menu 'menu)
- (gnus-browse-make-menu-bar))
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-browse-mode)
- (setq mode-name "Browse Server")
- (setq mode-line-process nil)
- (use-local-map gnus-browse-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (gnus-set-default-directory)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'gnus-browse-mode-hook))
-
-(defun gnus-browse-read-group (&optional no-article number)
- "Enter the group at the current line.
-If NUMBER, fetch this number of articles."
- (interactive "P")
- (let ((group (gnus-browse-group-name)))
- (if (or (not (gnus-get-info group))
- (gnus-ephemeral-group-p group))
- (unless (gnus-group-read-ephemeral-group
- group gnus-browse-current-method nil
- (cons (current-buffer) 'browse)
- nil nil nil number)
- (error "Couldn't enter %s" group))
- (unless (gnus-group-read-group nil no-article group)
- (error "Couldn't enter %s" group)))))
-
-(defun gnus-browse-select-group (&optional number)
- "Select the current group.
-If NUMBER, fetch this number of articles."
- (interactive "P")
- (gnus-browse-read-group 'no number))
-
-(defun gnus-browse-next-group (n)
- "Go to the next group."
- (interactive "p")
- (prog1
- (forward-line n)
- (gnus-group-position-point)))
-
-(defun gnus-browse-prev-group (n)
- "Go to the next group."
- (interactive "p")
- (gnus-browse-next-group (- n)))
-
-(defun gnus-browse-unsubscribe-current-group (arg)
- "(Un)subscribe to the next ARG groups."
- (interactive "p")
- (when (eobp)
- (error "No group at current line"))
- (let ((ward (if (< arg 0) -1 1))
- (arg (abs arg)))
- (while (and (> arg 0)
- (not (eobp))
- (gnus-browse-unsubscribe-group)
- (zerop (gnus-browse-next-group ward)))
- (decf arg))
- (gnus-group-position-point)
- (when (/= 0 arg)
- (gnus-message 7 "No more newsgroups"))
- arg))
-
-(defun gnus-browse-group-name ()
- (save-excursion
- (beginning-of-line)
- (let ((name (get-text-property (point) 'gnus-group)))
- (when (re-search-forward ": \\(.*\\)$" (gnus-point-at-eol) t)
- (concat (gnus-method-to-server-name gnus-browse-current-method) ":"
- (or name
- (match-string-no-properties 1)))))))
-
-(defun gnus-browse-describe-group (group)
- "Describe the current group."
- (interactive (list (gnus-browse-group-name)))
- (gnus-group-describe-group nil group))
-
-(defun gnus-browse-unsubscribe-group ()
- "Toggle subscription of the current group in the browse buffer."
- (let ((sub nil)
- (buffer-read-only nil)
- group)
- (save-excursion
- (beginning-of-line)
- ;; If this group it killed, then we want to subscribe it.
- (unless (eq (char-after) ? )
- (setq sub t))
- (setq group (gnus-browse-group-name))
- (when (gnus-server-equal gnus-browse-current-method "native")
- (setq group (gnus-group-real-name group)))
- (if sub
- (progn
- ;; Make sure the group has been properly removed before we
- ;; subscribe to it.
- (if (gnus-ephemeral-group-p group)
- (gnus-kill-ephemeral-group group))
- ;; We need to discern between killed/zombie groups and
- ;; just unsubscribed ones.
- (gnus-group-change-level
- (or (gnus-group-entry group)
- (list t group gnus-level-default-subscribed
- nil nil (if (gnus-server-equal
- gnus-browse-current-method "native")
- nil
- (gnus-method-simplify
- gnus-browse-current-method))))
- gnus-level-default-subscribed (gnus-group-level group)
- (and (car (nth 1 gnus-newsrc-alist))
- (gnus-gethash (car (nth 1 gnus-newsrc-alist))
- gnus-newsrc-hashtb))
- (null (gnus-group-entry group)))
- (delete-char 1)
- (insert ? ))
- (gnus-group-change-level
- group gnus-level-unsubscribed gnus-level-default-subscribed)
- (delete-char 1)
- (insert ?U)))
- t))
-
-(defun gnus-browse-exit ()
- "Quit browsing and return to the group buffer."
- (interactive)
- (when (eq major-mode 'gnus-browse-mode)
- (gnus-kill-buffer (current-buffer)))
- ;; Insert the newly subscribed groups in the group buffer.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-list-groups nil))
- (if gnus-browse-return-buffer
- (gnus-configure-windows 'server 'force)
- (gnus-configure-windows 'group 'force)))
-
-(defun gnus-browse-describe-briefly ()
- "Give a one line description of the group mode commands."
- (interactive)
- (gnus-message 6
- (substitute-command-keys "\\<gnus-browse-mode-map>\\[gnus-group-next-group]:Forward \\[gnus-group-prev-group]:Backward \\[gnus-browse-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-browse-describe-briefly]:This help")))
-
-(defun gnus-server-regenerate-server ()
- "Issue a command to the server to regenerate all its data structures."
- (interactive)
- (let ((server (gnus-server-server-name)))
- (unless server
- (error "No server on the current line"))
- (condition-case ()
- (gnus-get-function (gnus-server-to-method server)
- 'request-regenerate)
- (error
- (error "This backend doesn't support regeneration")))
- (gnus-message 5 "Requesting regeneration of %s..." server)
- (unless (gnus-open-server server)
- (error "Couldn't open server"))
- (if (gnus-request-regenerate server)
- (gnus-message 5 "Requesting regeneration of %s...done" server)
- (gnus-message 5 "Couldn't regenerate %s" server))))
-
-(provide 'gnus-srvr)
-
-;;; arch-tag: c0117f64-27ca-475d-9406-8da6854c7a25
-;;; gnus-srvr.el ends here
+++ /dev/null
-;;; gnus-start.el --- startup functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'gnus)
-(require 'gnus-win)
-(require 'gnus-int)
-(require 'gnus-spec)
-(require 'gnus-range)
-(require 'gnus-util)
-(autoload 'message-make-date "message")
-(autoload 'gnus-agent-read-servers-validate "gnus-agent")
-(autoload 'gnus-agent-save-local "gnus-agent")
-(autoload 'gnus-agent-possibly-alter-active "gnus-agent")
-
-(eval-when-compile
- (require 'cl)
-
- (defvar gnus-agent-covered-methods nil)
- (defvar gnus-agent-file-loading-local nil)
- (defvar gnus-agent-file-loading-cache nil))
-
-(defcustom gnus-startup-file (nnheader-concat gnus-home-directory ".newsrc")
- "Your `.newsrc' file.
-`.newsrc-SERVER' will be used instead if that exists."
- :group 'gnus-start
- :type 'file)
-
-(defcustom gnus-backup-startup-file 'never
- "Whether to create backup files.
-This variable takes the same values as the `version-control'
-variable."
- :version "22.1"
- :group 'gnus-start
- :type '(choice (const :tag "Never" never)
- (const :tag "If existing" nil)
- (other :tag "Always" t)))
-
-(defcustom gnus-save-startup-file-via-temp-buffer t
- "Whether to write the startup file contents to a buffer then save
-the buffer or write directly to the file. The buffer is faster
-because all of the contents are written at once. The direct write
-uses considerably less memory."
- :version "22.1"
- :group 'gnus-start
- :type '(choice (const :tag "Write via buffer" t)
- (const :tag "Write directly to file" nil)))
-
-(defcustom gnus-init-file (nnheader-concat gnus-home-directory ".gnus")
- "Your Gnus Emacs-Lisp startup file name.
-If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
- :group 'gnus-start
- :type 'file)
-
-(defcustom gnus-site-init-file
- (condition-case nil
- (concat (file-name-directory
- (directory-file-name installation-directory))
- "site-lisp/gnus-init")
- (error nil))
- "The site-wide Gnus Emacs-Lisp startup file name, or nil if none.
-If a file with the `.el' or `.elc' suffixes exists, it will be read instead."
- :group 'gnus-start
- :type '(choice file (const nil)))
-
-(defcustom gnus-default-subscribed-newsgroups nil
- "List of newsgroups to subscribe, when a user runs Gnus the first time.
-The value should be a list of strings.
-If it is t, Gnus will not do anything special the first time it is
-started; it'll just use the normal newsgroups subscription methods."
- :group 'gnus-start
- :type '(choice (repeat string) (const :tag "Nothing special" t)))
-
-(defcustom gnus-use-dribble-file t
- "*Non-nil means that Gnus will use a dribble file to store user updates.
-If Emacs should crash without saving the .newsrc files, complete
-information can be restored from the dribble file."
- :group 'gnus-dribble-file
- :type 'boolean)
-
-(defcustom gnus-dribble-directory nil
- "*The directory where dribble files will be saved.
-If this variable is nil, the directory where the .newsrc files are
-saved will be used."
- :group 'gnus-dribble-file
- :type '(choice directory (const nil)))
-
-(defcustom gnus-check-new-newsgroups 'ask-server
- "*Non-nil means that Gnus will run `gnus-find-new-newsgroups' at startup.
-This normally finds new newsgroups by comparing the active groups the
-servers have already reported with those Gnus already knows, either alive
-or killed.
-
-When any of the following are true, `gnus-find-new-newsgroups' will instead
-ask the servers (primary, secondary, and archive servers) to list new
-groups since the last time it checked:
- 1. This variable is `ask-server'.
- 2. This variable is a list of select methods (see below).
- 3. `gnus-read-active-file' is nil or `some'.
- 4. A prefix argument is given to `gnus-find-new-newsgroups' interactively.
-
-Thus, if this variable is `ask-server' or a list of select methods or
-`gnus-read-active-file' is nil or `some', then the killed list is no
-longer necessary, so you could safely set `gnus-save-killed-list' to nil.
-
-This variable can be a list of select methods which Gnus will query with
-the `ask-server' method in addition to the primary, secondary, and archive
-servers.
-
-Eg.
- (setq gnus-check-new-newsgroups
- '((nntp \"some.server\") (nntp \"other.server\")))
-
-If this variable is nil, then you have to tell Gnus explicitly to
-check for new newsgroups with \\<gnus-group-mode-map>\\[gnus-find-new-newsgroups]."
- :group 'gnus-start
- :type '(choice (const :tag "no" nil)
- (const :tag "by brute force" t)
- (const :tag "ask servers" ask-server)
- (repeat :menu-tag "ask additional servers"
- :tag "ask additional servers"
- :value ((nntp ""))
- (sexp :format "%v"))))
-
-(defcustom gnus-check-bogus-newsgroups nil
- "*Non-nil means that Gnus will check and remove bogus newsgroup at startup.
-If this variable is nil, then you have to tell Gnus explicitly to
-check for bogus newsgroups with \\<gnus-group-mode-map>\\[gnus-group-check-bogus-groups]."
- :group 'gnus-start-server
- :type 'boolean)
-
-(defcustom gnus-read-active-file 'some
- "*Non-nil means that Gnus will read the entire active file at startup.
-If this variable is nil, Gnus will only know about the groups in your
-`.newsrc' file.
-
-If this variable is `some', Gnus will try to only read the relevant
-parts of the active file from the server. Not all servers support
-this, and it might be quite slow with other servers, but this should
-generally be faster than both the t and nil value.
-
-If you set this variable to nil or `some', you probably still want to
-be told about new newsgroups that arrive. To do that, set
-`gnus-check-new-newsgroups' to `ask-server'. This may not work
-properly with all servers."
- :group 'gnus-start-server
- :type '(choice (const nil)
- (const some)
- (const t)))
-
-(defconst gnus-level-subscribed 5
- "Groups with levels less than or equal to this variable are subscribed.")
-
-(defconst gnus-level-unsubscribed 7
- "Groups with levels less than or equal to this variable are unsubscribed.
-
-Groups with levels less than `gnus-level-subscribed', which
-should be less than this variable, are subscribed. Groups with
-levels from `gnus-level-subscribed' (exclusive) upto this
-variable (inclusive) are unsubscribed. See also
-`gnus-level-zombie', `gnus-level-killed' and the Info node `Group
-Levels' for details.")
-
-(defconst gnus-level-zombie 8
- "Groups with this level are zombie groups.")
-
-(defconst gnus-level-killed 9
- "Groups with this level are killed.")
-
-(defcustom gnus-level-default-subscribed 3
- "*New subscribed groups will be subscribed at this level."
- :group 'gnus-group-levels
- :type 'integer)
-
-(defcustom gnus-level-default-unsubscribed 6
- "*New unsubscribed groups will be unsubscribed at this level."
- :group 'gnus-group-levels
- :type 'integer)
-
-(defcustom gnus-activate-level (1+ gnus-level-subscribed)
- "*Groups higher than this level won't be activated on startup.
-Setting this variable to something low might save lots of time when
-you have many groups that you aren't interested in."
- :group 'gnus-group-levels
- :type 'integer)
-
-(defcustom gnus-activate-foreign-newsgroups 4
- "*If nil, Gnus will not check foreign newsgroups at startup.
-If it is non-nil, it should be a number between one and nine. Foreign
-newsgroups that have a level lower or equal to this number will be
-activated on startup. For instance, if you want to active all
-subscribed newsgroups, but not the rest, you'd set this variable to
-`gnus-level-subscribed'.
-
-If you subscribe to lots of newsgroups from different servers, startup
-might take a while. By setting this variable to nil, you'll save time,
-but you won't be told how many unread articles there are in the
-groups."
- :group 'gnus-group-levels
- :type '(choice integer
- (const :tag "none" nil)))
-
-(defcustom gnus-read-newsrc-file t
- "*Non-nil means that Gnus will read the `.newsrc' file.
-Gnus always reads its own startup file, which is called
-\".newsrc.eld\". The file called \".newsrc\" is in a format that can
-be readily understood by other newsreaders. If you don't plan on
-using other newsreaders, set this variable to nil to save some time on
-entry."
- :version "21.1"
- :group 'gnus-newsrc
- :type 'boolean)
-
-(defcustom gnus-save-newsrc-file t
- "*Non-nil means that Gnus will save the `.newsrc' file.
-Gnus always saves its own startup file, which is called
-\".newsrc.eld\". The file called \".newsrc\" is in a format that can
-be readily understood by other newsreaders. If you don't plan on
-using other newsreaders, set this variable to nil to save some time on
-exit."
- :group 'gnus-newsrc
- :type 'boolean)
-
-(defcustom gnus-save-killed-list t
- "*If non-nil, save the list of killed groups to the startup file.
-If you set this variable to nil, you'll save both time (when starting
-and quitting) and space (both memory and disk), but it will also mean
-that Gnus has no record of which groups are new and which are old, so
-the automatic new newsgroups subscription methods become meaningless.
-
-You should always set `gnus-check-new-newsgroups' to `ask-server' or
-nil if you set this variable to nil.
-
-This variable can also be a regexp. In that case, all groups that do
-not match this regexp will be removed before saving the list."
- :group 'gnus-newsrc
- :type '(radio (sexp :format "Non-nil\n"
- :match (lambda (widget value)
- (and value (not (stringp value))))
- :value t)
- (const nil)
- regexp))
-
-(defcustom gnus-ignored-newsgroups
- (mapconcat 'identity
- '("^to\\." ; not "real" groups
- "^[0-9. \t]+\\( \\|$\\)" ; all digits in name
- "^[\"][]\"[#'()]" ; bogus characters
- )
- "\\|")
- "*A regexp to match uninteresting newsgroups in the active file.
-Any lines in the active file matching this regular expression are
-removed from the newsgroup list before anything else is done to it,
-thus making them effectively non-existent."
- :group 'gnus-group-new
- :type 'regexp)
-
-(defcustom gnus-subscribe-newsgroup-method 'gnus-subscribe-zombies
- "*Function(s) called with a group name when new group is detected.
-A few pre-made functions are supplied: `gnus-subscribe-randomly'
-inserts new groups at the beginning of the list of groups;
-`gnus-subscribe-alphabetically' inserts new groups in strict
-alphabetic order; `gnus-subscribe-hierarchically' inserts new groups
-in hierarchical newsgroup order; `gnus-subscribe-interactively' asks
-for your decision; `gnus-subscribe-killed' kills all new groups;
-`gnus-subscribe-zombies' will make all new groups into zombies;
-`gnus-subscribe-topics' will enter groups into the topics that
-claim them."
- :group 'gnus-group-new
- :type '(radio (function-item gnus-subscribe-randomly)
- (function-item gnus-subscribe-alphabetically)
- (function-item gnus-subscribe-hierarchically)
- (function-item gnus-subscribe-interactively)
- (function-item gnus-subscribe-killed)
- (function-item gnus-subscribe-zombies)
- (function-item gnus-subscribe-topics)
- function
- (repeat function)))
-
-(defcustom gnus-subscribe-newsgroup-hooks nil
- "*Hooks run after you subscribe to a new group.
-The hooks will be called with new group's name as argument."
- :version "22.1"
- :group 'gnus-group-new
- :type 'hook)
-
-(defcustom gnus-subscribe-options-newsgroup-method
- 'gnus-subscribe-alphabetically
- "*Function(s) called to subscribe newsgroups mentioned on \"options -n\" lines.
-If, for instance, you want to subscribe to all newsgroups in the
-\"no\" and \"alt\" hierarchies, you'd put the following in your
-.newsrc file:
-
-options -n no.all alt.all
-
-Gnus will then subscribe all new newsgroups in these hierarchies
-with the subscription method in this variable."
- :group 'gnus-group-new
- :type '(radio (function-item gnus-subscribe-randomly)
- (function-item gnus-subscribe-alphabetically)
- (function-item gnus-subscribe-hierarchically)
- (function-item gnus-subscribe-interactively)
- (function-item gnus-subscribe-killed)
- (function-item gnus-subscribe-zombies)
- (function-item gnus-subscribe-topics)
- function
- (repeat function)))
-
-(defcustom gnus-subscribe-hierarchical-interactive nil
- "*If non-nil, Gnus will offer to subscribe hierarchically.
-When a new hierarchy appears, Gnus will ask the user:
-
-'alt.binaries': Do you want to subscribe to this hierarchy? ([d]ys):
-
-If the user pressed `d', Gnus will descend the hierarchy, `y' will
-subscribe to all newsgroups in the hierarchy and `s' will skip this
-hierarchy in its entirety."
- :group 'gnus-group-new
- :type 'boolean)
-
-(defcustom gnus-auto-subscribed-groups
- "^nnml\\|^nnfolder\\|^nnmbox\\|^nnmh\\|^nnbabyl\\|^nnmaildir"
- "*All new groups that match this regexp will be subscribed automatically.
-Note that this variable only deals with new groups. It has no effect
-whatsoever on old groups.
-
-New groups that match this regexp will not be handled by
-`gnus-subscribe-newsgroup-method'. Instead, they will
-be subscribed using `gnus-subscribe-options-newsgroup-method'."
- :group 'gnus-group-new
- :type 'regexp)
-
-(defcustom gnus-options-subscribe nil
- "*All new groups matching this regexp will be subscribed unconditionally.
-Note that this variable deals only with new newsgroups. This variable
-does not affect old newsgroups.
-
-New groups that match this regexp will not be handled by
-`gnus-subscribe-newsgroup-method'. Instead, they will
-be subscribed using `gnus-subscribe-options-newsgroup-method'."
- :group 'gnus-group-new
- :type '(choice regexp
- (const :tag "none" nil)))
-
-(defcustom gnus-options-not-subscribe nil
- "*All new groups matching this regexp will be ignored.
-Note that this variable deals only with new newsgroups. This variable
-does not affect old (already subscribed) newsgroups."
- :group 'gnus-group-new
- :type '(choice regexp
- (const :tag "none" nil)))
-
-(defcustom gnus-modtime-botch nil
- "*Non-nil means .newsrc should be deleted prior to save.
-Its use is due to the bogus appearance that .newsrc was modified on
-disc."
- :group 'gnus-newsrc
- :type 'boolean)
-
-(defcustom gnus-check-bogus-groups-hook nil
- "A hook run after removing bogus groups."
- :group 'gnus-start-server
- :type 'hook)
-
-(defcustom gnus-startup-hook nil
- "A hook called at startup.
-This hook is called after Gnus is connected to the NNTP server."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-before-startup-hook nil
- "A hook called at before startup.
-This hook is called as the first thing when Gnus is started."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-started-hook nil
- "A hook called as the last thing after startup."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-setup-news-hook
- '(gnus-fixup-nnimap-unread-after-getting-new-news)
- "A hook after reading the .newsrc file, but before generating the buffer."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-get-top-new-news-hook nil
- "A hook run just before Gnus checks for new news globally."
- :version "22.1"
- :group 'gnus-group-new
- :type 'hook)
-
-(defcustom gnus-get-new-news-hook nil
- "A hook run just before Gnus checks for new news."
- :group 'gnus-group-new
- :type 'hook)
-
-(defcustom gnus-after-getting-new-news-hook
- '(gnus-display-time-event-handler
- gnus-fixup-nnimap-unread-after-getting-new-news)
- "*A hook run after Gnus checks for new news when Gnus is already running."
- :group 'gnus-group-new
- :type 'hook)
-
-(defcustom gnus-read-newsrc-el-hook nil
- "A hook called after reading the newsrc.eld? file."
- :group 'gnus-newsrc
- :type 'hook)
-
-(defcustom gnus-save-newsrc-hook nil
- "A hook called before saving any of the newsrc files."
- :group 'gnus-newsrc
- :type 'hook)
-
-(defcustom gnus-save-quick-newsrc-hook nil
- "A hook called just before saving the quick newsrc file.
-Can be used to turn version control on or off."
- :group 'gnus-newsrc
- :type 'hook)
-
-(defcustom gnus-save-standard-newsrc-hook nil
- "A hook called just before saving the standard newsrc file.
-Can be used to turn version control on or off."
- :group 'gnus-newsrc
- :type 'hook)
-
-(defcustom gnus-group-mode-hook nil
- "Hook for Gnus group mode."
- :group 'gnus-group-various
- :options '(gnus-topic-mode)
- :type 'hook)
-
-(defcustom gnus-always-read-dribble-file nil
- "Unconditionally read the dribble file."
- :group 'gnus-newsrc
- :type 'boolean)
-
-;;; Internal variables
-
-(defvar gnus-ding-file-coding-system mm-universal-coding-system
- "Coding system for ding file.")
-
-(defvar gnus-newsrc-file-version nil)
-(defvar gnus-override-subscribe-method nil)
-(defvar gnus-dribble-buffer nil)
-(defvar gnus-newsrc-options nil
- "Options line in the .newsrc file.")
-
-(defvar gnus-newsrc-options-n nil
- "List of regexps representing groups to be subscribed/ignored unconditionally.")
-
-(defvar gnus-newsrc-last-checked-date nil
- "Date Gnus last asked server for new newsgroups.")
-
-(defvar gnus-current-startup-file nil
- "Startup file for the current host.")
-
-;; Byte-compiler warning.
-(defvar gnus-group-line-format)
-
-;; Suggested by Brian Edmonds <edmonds@cs.ubc.ca>.
-(defvar gnus-init-inhibit nil)
-(defun gnus-read-init-file (&optional inhibit-next)
- ;; Don't load .gnus if the -q option was used.
- (when init-file-user
- (if gnus-init-inhibit
- (setq gnus-init-inhibit nil)
- (setq gnus-init-inhibit inhibit-next)
- (dolist (file (list gnus-site-init-file gnus-init-file))
- (when (and file
- (locate-library file))
- (if (or debug-on-error debug-on-quit)
- (load file nil t)
- (condition-case var
- (load file nil t)
- (error
- (error "Error in %s: %s" file (cadr var))))))))))
-
-;; For subscribing new newsgroup
-
-(defun gnus-subscribe-hierarchical-interactive (groups)
- (let ((groups (sort groups 'string<))
- prefixes prefix start ans group starts)
- (while groups
- (setq prefixes (list "^"))
- (while (and groups prefixes)
- (while (not (string-match (car prefixes) (car groups)))
- (setq prefixes (cdr prefixes)))
- (setq prefix (car prefixes))
- (setq start (1- (length prefix)))
- (if (and (string-match "[^\\.]\\." (car groups) start)
- (cdr groups)
- (setq prefix
- (concat "^" (substring (car groups) 0 (match-end 0))))
- (string-match prefix (cadr groups)))
- (progn
- (push prefix prefixes)
- (message "Descend hierarchy %s? ([y]nsq): "
- (substring prefix 1 (1- (length prefix))))
- (while (not (memq (setq ans (read-char-exclusive))
- '(?y ?\n ?\r ?n ?s ?q)))
- (ding)
- (message "Descend hierarchy %s? ([y]nsq): "
- (substring prefix 1 (1- (length prefix)))))
- (cond ((= ans ?n)
- (while (and groups
- (string-match prefix
- (setq group (car groups))))
- (push group gnus-killed-list)
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups)))
- (setq starts (cdr starts)))
- ((= ans ?s)
- (while (and groups
- (string-match prefix
- (setq group (car groups))))
- (gnus-sethash group group gnus-killed-hashtb)
- (gnus-subscribe-alphabetically (car groups))
- (setq groups (cdr groups)))
- (setq starts (cdr starts)))
- ((= ans ?q)
- (while groups
- (setq group (car groups))
- (push group gnus-killed-list)
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups))))
- (t nil)))
- (message "Subscribe %s? ([n]yq)" (car groups))
- (while (not (memq (setq ans (read-char-exclusive))
- '(?y ?\n ?\r ?q ?n)))
- (ding)
- (message "Subscribe %s? ([n]yq)" (car groups)))
- (setq group (car groups))
- (cond ((= ans ?y)
- (gnus-subscribe-alphabetically (car groups))
- (gnus-sethash group group gnus-killed-hashtb))
- ((= ans ?q)
- (while groups
- (setq group (car groups))
- (push group gnus-killed-list)
- (gnus-sethash group group gnus-killed-hashtb)
- (setq groups (cdr groups))))
- (t
- (push group gnus-killed-list)
- (gnus-sethash group group gnus-killed-hashtb)))
- (setq groups (cdr groups)))))))
-
-(defun gnus-subscribe-randomly (newsgroup)
- "Subscribe new NEWSGROUP by making it the first newsgroup."
- (gnus-subscribe-newsgroup newsgroup))
-
-(defun gnus-subscribe-alphabetically (newgroup)
- "Subscribe new NEWGROUP and insert it in alphabetical order."
- (let ((groups (cdr gnus-newsrc-alist))
- before)
- (while (and (not before) groups)
- (if (string< newgroup (caar groups))
- (setq before (caar groups))
- (setq groups (cdr groups))))
- (gnus-subscribe-newsgroup newgroup before)))
-
-(defun gnus-subscribe-hierarchically (newgroup)
- "Subscribe new NEWGROUP and insert it in hierarchical newsgroup order."
- ;; Basic ideas by mike-w@cs.aukuni.ac.nz (Mike Williams)
- (save-excursion
- (set-buffer (nnheader-find-file-noselect gnus-current-startup-file))
- (prog1
- (let ((groupkey newgroup) before)
- (while (and (not before) groupkey)
- (goto-char (point-min))
- (let ((groupkey-re
- (concat "^\\(" (regexp-quote groupkey) ".*\\)[!:]")))
- (while (and (re-search-forward groupkey-re nil t)
- (progn
- (setq before (match-string 1))
- (string< before newgroup)))))
- ;; Remove tail of newsgroup name (eg. a.b.c -> a.b)
- (setq groupkey
- (when (string-match "^\\(.*\\)\\.[^.]+$" groupkey)
- (substring groupkey (match-beginning 1) (match-end 1)))))
- (gnus-subscribe-newsgroup newgroup before))
- (kill-buffer (current-buffer)))))
-
-(defun gnus-subscribe-interactively (group)
- "Subscribe the new GROUP interactively.
-It is inserted in hierarchical newsgroup order if subscribed. If not,
-it is killed."
- (if (gnus-y-or-n-p (format "Subscribe new newsgroup %s? " group))
- (gnus-subscribe-hierarchically group)
- (push group gnus-killed-list)))
-
-(defun gnus-subscribe-zombies (group)
- "Make the new GROUP into a zombie group."
- (push group gnus-zombie-list))
-
-(defun gnus-subscribe-killed (group)
- "Make the new GROUP a killed group."
- (push group gnus-killed-list))
-
-(defun gnus-subscribe-newsgroup (newsgroup &optional next)
- "Subscribe new NEWSGROUP.
-If NEXT is non-nil, it is inserted before NEXT. Otherwise it is made
-the first newsgroup."
- (save-excursion
- (goto-char (point-min))
- ;; We subscribe the group by changing its level to `subscribed'.
- (gnus-group-change-level
- newsgroup gnus-level-default-subscribed
- gnus-level-killed (gnus-gethash (or next "dummy.group")
- gnus-newsrc-hashtb))
- (gnus-message 5 "Subscribe newsgroup: %s" newsgroup)
- (run-hook-with-args 'gnus-subscribe-newsgroup-hooks newsgroup)
- t))
-
-(defun gnus-read-active-file-p ()
- "Say whether the active file has been read from `gnus-select-method'."
- (memq gnus-select-method gnus-have-read-active-file))
-
-;;; General various misc type functions.
-
-;; Silence byte-compiler.
-(eval-when-compile
- (defvar gnus-current-headers)
- (defvar gnus-thread-indent-array)
- (defvar gnus-newsgroup-name)
- (defvar gnus-newsgroup-headers)
- (defvar gnus-group-list-mode)
- (defvar gnus-group-mark-positions)
- (defvar gnus-newsgroup-data)
- (defvar gnus-newsgroup-unreads)
- (defvar nnoo-state-alist)
- (defvar gnus-current-select-method)
- (defvar mail-sources)
- (defvar nnmail-scan-directory-mail-source-once)
- (defvar nnmail-split-history)
- (defvar nnmail-spool-file))
-
-(defun gnus-close-all-servers ()
- "Close all servers."
- (interactive)
- (dolist (server gnus-opened-servers)
- (gnus-close-server (car server))))
-
-(defun gnus-clear-system ()
- "Clear all variables and buffers."
- ;; Clear Gnus variables.
- (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
- (while variables
- (set (car variables) nil)
- (setq variables (cdr variables))))
- ;; Clear other internal variables.
- (setq gnus-list-of-killed-groups nil
- gnus-have-read-active-file nil
- gnus-agent-covered-methods nil
- gnus-agent-file-loading-local nil
- gnus-agent-file-loading-cache nil
- gnus-server-method-cache nil
- gnus-newsrc-alist nil
- gnus-newsrc-hashtb nil
- gnus-killed-list nil
- gnus-zombie-list nil
- gnus-killed-hashtb nil
- gnus-active-hashtb nil
- gnus-moderated-hashtb nil
- gnus-description-hashtb nil
- gnus-current-headers nil
- gnus-thread-indent-array nil
- gnus-newsgroup-headers nil
- gnus-newsgroup-name nil
- gnus-server-alist nil
- gnus-group-list-mode nil
- gnus-opened-servers nil
- gnus-group-mark-positions nil
- gnus-newsgroup-data nil
- gnus-newsgroup-unreads nil
- nnoo-state-alist nil
- gnus-current-select-method nil
- nnmail-split-history nil
- gnus-ephemeral-servers nil)
- (gnus-shutdown 'gnus)
- ;; Kill the startup file.
- (and gnus-current-startup-file
- (get-file-buffer gnus-current-startup-file)
- (kill-buffer (get-file-buffer gnus-current-startup-file)))
- ;; Clear the dribble buffer.
- (gnus-dribble-clear)
- ;; Kill global KILL file buffer.
- (when (get-file-buffer (gnus-newsgroup-kill-file nil))
- (kill-buffer (get-file-buffer (gnus-newsgroup-kill-file nil))))
- (gnus-kill-buffer nntp-server-buffer)
- ;; Kill Gnus buffers.
- (dolist (buffer (gnus-buffers))
- (gnus-kill-buffer buffer))
- ;; Remove Gnus frames.
- (gnus-kill-gnus-frames))
-
-(defun gnus-no-server-1 (&optional arg slave)
- "Read network news.
-If ARG is a positive number, Gnus will use that as the startup
-level. If ARG is nil, Gnus will be started at level 2
-\(`gnus-level-default-subscribed' minus one). If ARG is non-nil
-and not a positive number, Gnus will prompt the user for the name
-of an NNTP server to use. As opposed to \\[gnus], this command
-will not connect to the local server."
- (interactive "P")
- (let ((val (or arg (1- gnus-level-default-subscribed))))
- (gnus val t slave)
- (make-local-variable 'gnus-group-use-permanent-levels)
- (setq gnus-group-use-permanent-levels val)))
-
-(defun gnus-1 (&optional arg dont-connect slave)
- "Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use."
- (interactive "P")
-
- (if (gnus-alive-p)
- (progn
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-get-new-news
- (and (numberp arg)
- (> arg 0)
- (max (car gnus-group-list-mode) arg))))
-
- (gnus-clear-system)
- (gnus-splash)
- (gnus-run-hooks 'gnus-before-startup-hook)
- (nnheader-init-server-buffer)
- (setq gnus-slave slave)
- (gnus-read-init-file)
- (if gnus-agent
- (gnus-agentize))
-
- (when gnus-simple-splash
- (setq gnus-simple-splash nil)
- (cond
- ((featurep 'xemacs)
- (gnus-xmas-splash))
- (window-system
- (gnus-x-splash))))
-
- (let ((level (and (numberp arg) (> arg 0) arg))
- did-connect)
- (unwind-protect
- (progn
- (unless dont-connect
- (setq did-connect
- (gnus-start-news-server (and arg (not level))))))
- (if (and (not dont-connect)
- (not did-connect))
- (gnus-group-quit)
- (gnus-run-hooks 'gnus-startup-hook)
- ;; NNTP server is successfully open.
-
- ;; Find the current startup file name.
- (setq gnus-current-startup-file
- (gnus-make-newsrc-file gnus-startup-file))
-
- ;; Read the dribble file.
- (when (or gnus-slave gnus-use-dribble-file)
- (gnus-dribble-read-file))
-
- ;; Allow using GroupLens predictions.
- (when gnus-use-grouplens
- (bbb-login)
- (add-hook 'gnus-summary-mode-hook 'gnus-grouplens-mode))
-
- ;; Do the actual startup.
- (if gnus-agent
- (gnus-request-create-group "queue" '(nndraft "")))
- (gnus-request-create-group "drafts" '(nndraft ""))
- (gnus-setup-news nil level dont-connect)
- (gnus-run-hooks 'gnus-setup-news-hook)
- (gnus-start-draft-setup)
- ;; Generate the group buffer.
- (gnus-group-list-groups level)
- (gnus-group-first-unread-group)
- (gnus-configure-windows 'group)
- (gnus-group-set-mode-line)
- (gnus-run-hooks 'gnus-started-hook))))))
-
-(defun gnus-start-draft-setup ()
- "Make sure the draft group exists."
- (gnus-request-create-group "drafts" '(nndraft ""))
- (unless (gnus-gethash "nndraft:drafts" gnus-newsrc-hashtb)
- (gnus-message 3 "Subscribing drafts group")
- (let ((gnus-level-default-subscribed 1))
- (gnus-subscribe-group "nndraft:drafts" nil '(nndraft ""))))
- (unless (equal (gnus-group-get-parameter "nndraft:drafts" 'gnus-dummy t)
- '((gnus-draft-mode)))
- (gnus-message 3 "Setting up drafts group")
- (gnus-group-set-parameter
- "nndraft:drafts" 'gnus-dummy '((gnus-draft-mode)))))
-
-\f
-;;;
-;;; Dribble file
-;;;
-
-(defvar gnus-dribble-ignore nil)
-(defvar gnus-dribble-eval-file nil)
-
-(defun gnus-dribble-file-name ()
- "Return the dribble file for the current .newsrc."
- (concat
- (if gnus-dribble-directory
- (concat (file-name-as-directory gnus-dribble-directory)
- (file-name-nondirectory gnus-current-startup-file))
- gnus-current-startup-file)
- "-dribble"))
-
-(defun gnus-dribble-enter (string)
- "Enter STRING into the dribble buffer."
- (when (and (not gnus-dribble-ignore)
- gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer))
- (let ((obuf (current-buffer)))
- (set-buffer gnus-dribble-buffer)
- (goto-char (point-max))
- (insert string "\n")
- ;; This has been commented by Josh Huber <huber@alum.wpi.edu>
- ;; It causes problems with both XEmacs and Emacs 21, and doesn't
- ;; seem to be of much value. (FIXME: remove this after we make sure
- ;; it's not needed).
- ;; (set-window-point (get-buffer-window (current-buffer)) (point-max))
- (bury-buffer gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-set-mode-line))
- (set-buffer obuf))))
-
-(defun gnus-dribble-touch ()
- "Touch the dribble buffer."
- (gnus-dribble-enter ""))
-
-(defun gnus-dribble-read-file ()
- "Read the dribble file from disk."
- (let ((dribble-file (gnus-dribble-file-name)))
- (save-excursion
- (set-buffer (setq gnus-dribble-buffer
- (gnus-get-buffer-create
- (file-name-nondirectory dribble-file))))
- (set (make-local-variable 'file-precious-flag) t)
- (erase-buffer)
- (setq buffer-file-name dribble-file)
- (auto-save-mode t)
- (buffer-disable-undo)
- (bury-buffer (current-buffer))
- (set-buffer-modified-p nil)
- (let ((auto (make-auto-save-file-name))
- (gnus-dribble-ignore t)
- (purpose nil)
- modes)
- (when (or (file-exists-p auto) (file-exists-p dribble-file))
- ;; Load whichever file is newest -- the auto save file
- ;; or the "real" file.
- (if (file-newer-than-file-p auto dribble-file)
- (nnheader-insert-file-contents auto)
- (nnheader-insert-file-contents dribble-file))
- (unless (zerop (buffer-size))
- (set-buffer-modified-p t))
- ;; Set the file modes to reflect the .newsrc file modes.
- (save-buffer)
- (when (and (file-exists-p gnus-current-startup-file)
- (file-exists-p dribble-file)
- (setq modes (file-modes gnus-current-startup-file)))
- (set-file-modes dribble-file modes))
- (goto-char (point-min))
- (when (search-forward "Gnus was exited on purpose" nil t)
- (setq purpose t))
- ;; Possibly eval the file later.
- (when (or gnus-always-read-dribble-file
- (gnus-y-or-n-p
- (if purpose
- "Gnus exited on purpose without saving; read auto-save file anyway? "
- "Gnus auto-save file exists. Do you want to read it? ")))
- (setq gnus-dribble-eval-file t)))))))
-
-(defun gnus-dribble-eval-file ()
- (when gnus-dribble-eval-file
- (setq gnus-dribble-eval-file nil)
- (save-excursion
- (let ((gnus-dribble-ignore t))
- (set-buffer gnus-dribble-buffer)
- (eval-buffer (current-buffer))))))
-
-(defun gnus-dribble-delete-file ()
- (when (file-exists-p (gnus-dribble-file-name))
- (delete-file (gnus-dribble-file-name)))
- (when gnus-dribble-buffer
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (let ((auto (make-auto-save-file-name)))
- (when (file-exists-p auto)
- (delete-file auto))
- (erase-buffer)
- (set-buffer-modified-p nil)))))
-
-(defun gnus-dribble-save ()
- (when (and gnus-dribble-buffer
- (buffer-name gnus-dribble-buffer))
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (save-buffer))))
-
-(defun gnus-dribble-clear ()
- (when (gnus-buffer-exists-p gnus-dribble-buffer)
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (erase-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-saved-size (buffer-size)))))
-
-\f
-;;;
-;;; Active & Newsrc File Handling
-;;;
-
-(defun gnus-setup-news (&optional rawfile level dont-connect)
- "Setup news information.
-If RAWFILE is non-nil, the .newsrc file will also be read.
-If LEVEL is non-nil, the news will be set up at level LEVEL."
- (require 'nnmail)
- (let ((init (not (and gnus-newsrc-alist gnus-active-hashtb (not rawfile))))
- ;; Binding this variable will inhibit multiple fetchings
- ;; of the same mail source.
- (nnmail-fetched-sources (list t)))
-
- (when init
- ;; Clear some variables to re-initialize news information.
- (setq gnus-newsrc-alist nil
- gnus-active-hashtb nil)
- ;; Read the newsrc file and create `gnus-newsrc-hashtb'.
- (gnus-read-newsrc-file rawfile))
-
- ;; Make sure the archive server is available to all and sundry.
- (when gnus-message-archive-method
- (unless (assoc "archive" gnus-server-alist)
- (let ((method (or (and (stringp gnus-message-archive-method)
- (gnus-server-to-method
- gnus-message-archive-method))
- gnus-message-archive-method)))
- ;; Check whether the archive method is writable.
- (unless (or (stringp method)
- (memq 'respool (assoc (format "%s" (car method))
- gnus-valid-select-methods)))
- (setq method "archive")) ;; The default.
- (push (if (stringp method)
- `("archive"
- nnfolder
- ,method
- (nnfolder-directory
- ,(nnheader-concat message-directory method))
- (nnfolder-active-file
- ,(nnheader-concat message-directory
- (concat method "/active")))
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
- (cons "archive" method))
- gnus-server-alist))))
-
- ;; If we don't read the complete active file, we fill in the
- ;; hashtb here.
- (when (or (null gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- (gnus-update-active-hashtb-from-killed))
-
- ;; Validate agent covered methods now that gnus-server-alist has
- ;; been initialized.
- ;; NOTE: This is here for one purpose only. By validating the
- ;; agentized server's, it converts the old 5.10.3, and earlier,
- ;; format to the current format. That enables the agent code
- ;; within gnus-read-active-file to function correctly.
- (if gnus-agent
- (gnus-agent-read-servers-validate))
-
- ;; Read the active file and create `gnus-active-hashtb'.
- ;; If `gnus-read-active-file' is nil, then we just create an empty
- ;; hash table. The partial filling out of the hash table will be
- ;; done in `gnus-get-unread-articles'.
- (and gnus-read-active-file
- (not level)
- (gnus-read-active-file nil dont-connect))
-
- (unless gnus-active-hashtb
- (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
-
- ;; Initialize the cache.
- (when gnus-use-cache
- (gnus-cache-open))
-
- ;; Possibly eval the dribble file.
- (and init
- (or gnus-use-dribble-file gnus-slave)
- (gnus-dribble-eval-file))
-
- ;; Slave Gnusii should then clear the dribble buffer.
- (when (and init gnus-slave)
- (gnus-dribble-clear))
-
- (gnus-update-format-specifications)
-
- ;; See whether we need to read the description file.
- (when (and (boundp 'gnus-group-line-format)
- (stringp gnus-group-line-format)
- (let ((case-fold-search nil))
- (string-match "%[-,0-9]*D" gnus-group-line-format))
- (not gnus-description-hashtb)
- (not dont-connect)
- gnus-read-active-file)
- (gnus-read-all-descriptions-files))
-
- ;; Find new newsgroups and treat them.
- (when (and init gnus-check-new-newsgroups (not level)
- (gnus-check-server gnus-select-method)
- (not gnus-slave)
- gnus-plugged)
- (gnus-find-new-newsgroups))
-
- ;; Check and remove bogus newsgroups.
- (when (and init gnus-check-bogus-newsgroups
- gnus-read-active-file (not level)
- (gnus-server-opened gnus-select-method))
- (gnus-check-bogus-newsgroups))
-
- ;; We might read in new NoCeM messages here.
- (when (and (not dont-connect)
- gnus-use-nocem
- (or (and (numberp gnus-use-nocem)
- (numberp level)
- (>= level gnus-use-nocem))
- (not level)))
- (gnus-nocem-scan-groups))
-
- ;; Read any slave files.
- (gnus-master-read-slave-newsrc)
-
- ;; Find the number of unread articles in each non-dead group.
- (let ((gnus-read-active-file (and (not level) gnus-read-active-file)))
- (gnus-get-unread-articles level))))
-
-(defun gnus-call-subscribe-functions (method group)
- "Call METHOD to subscribe GROUP.
-If no function returns `non-nil', call `gnus-subscribe-zombies'."
- (unless (cond
- ((functionp method)
- (funcall method group))
- ((listp method)
- (catch 'found
- (dolist (func method)
- (if (funcall func group)
- (throw 'found t)))
- nil))
- (t nil))
- (gnus-subscribe-zombies group)))
-
-(defun gnus-find-new-newsgroups (&optional arg)
- "Search for new newsgroups and add them.
-Each new newsgroup will be treated with `gnus-subscribe-newsgroup-method'.
-The `-n' option line from .newsrc is respected.
-
-With 1 C-u, use the `ask-server' method to query the server for new
-groups.
-With 2 C-u's, use most complete method possible to query the server
-for new groups, and subscribe the new groups as zombies."
- (interactive "p")
- (let* ((gnus-subscribe-newsgroup-method
- gnus-subscribe-newsgroup-method)
- (check (cond
- ((or (and (= (or arg 1) 4)
- (not (listp gnus-check-new-newsgroups)))
- (null gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- 'ask-server)
- ((= (or arg 1) 16)
- (setq gnus-subscribe-newsgroup-method
- 'gnus-subscribe-zombies)
- t)
- (t gnus-check-new-newsgroups))))
- (unless (gnus-check-first-time-used)
- (if (or (consp check)
- (eq check 'ask-server))
- ;; Ask the server for new groups.
- (gnus-ask-server-for-new-groups)
- ;; Go through the active hashtb and look for new groups.
- (let ((groups 0)
- group new-newsgroups)
- (gnus-message 5 "Looking for new newsgroups...")
- (unless gnus-have-read-active-file
- (gnus-read-active-file))
- (setq gnus-newsrc-last-checked-date (message-make-date))
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- ;; Go though every newsgroup in `gnus-active-hashtb' and compare
- ;; with `gnus-newsrc-hashtb' and `gnus-killed-hashtb'.
- (mapatoms
- (lambda (sym)
- (if (or (null (setq group (symbol-name sym)))
- (not (boundp sym))
- (null (symbol-value sym))
- (gnus-gethash group gnus-killed-hashtb)
- (gnus-gethash group gnus-newsrc-hashtb))
- ()
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (setq groups (1+ groups))
- (gnus-sethash group group gnus-killed-hashtb)
- (gnus-call-subscribe-functions
- gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (setq groups (1+ groups))
- (gnus-sethash group group gnus-killed-hashtb)
- (if gnus-subscribe-hierarchical-interactive
- (push group new-newsgroups)
- (gnus-call-subscribe-functions
- gnus-subscribe-newsgroup-method group)))))))
- gnus-active-hashtb)
- (when new-newsgroups
- (gnus-subscribe-hierarchical-interactive new-newsgroups))
- (if (> groups 0)
- (gnus-message 5 "%d new newsgroup%s arrived."
- groups (if (> groups 1) "s have" " has"))
- (gnus-message 5 "No new newsgroups.")))))))
-
-(defun gnus-matches-options-n (group)
- ;; Returns `subscribe' if the group is to be unconditionally
- ;; subscribed, `ignore' if it is to be ignored, and nil if there is
- ;; no match for the group.
-
- ;; First we check the two user variables.
- (cond
- ((and gnus-options-subscribe
- (string-match gnus-options-subscribe group))
- 'subscribe)
- ((and gnus-auto-subscribed-groups
- (string-match gnus-auto-subscribed-groups group))
- 'subscribe)
- ((and gnus-options-not-subscribe
- (string-match gnus-options-not-subscribe group))
- 'ignore)
- ;; Then we go through the list that was retrieved from the .newsrc
- ;; file. This list has elements on the form
- ;; `(REGEXP . {ignore,subscribe})'. The first match found (the list
- ;; is in the reverse order of the options line) is returned.
- (t
- (let ((regs gnus-newsrc-options-n))
- (while (and regs
- (not (string-match (caar regs) group)))
- (setq regs (cdr regs)))
- (and regs (cdar regs))))))
-
-(defun gnus-ask-server-for-new-groups ()
- (let* ((new-date (message-make-date))
- (date (or gnus-newsrc-last-checked-date new-date))
- (methods (cons gnus-select-method
- (nconc
- (when (gnus-archive-server-wanted-p)
- (list "archive"))
- (append
- (and (consp gnus-check-new-newsgroups)
- gnus-check-new-newsgroups)
- gnus-secondary-select-methods))))
- (groups 0)
- group new-newsgroups got-new method hashtb
- gnus-override-subscribe-method)
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- ;; Go through both primary and secondary select methods and
- ;; request new newsgroups.
- (while (setq method (gnus-server-get-method nil (pop methods)))
- (setq new-newsgroups nil
- gnus-override-subscribe-method method)
- (when (and (gnus-check-server method)
- (gnus-request-newgroups date method))
- (save-excursion
- (setq got-new t
- hashtb (gnus-make-hashtable 100))
- (set-buffer nntp-server-buffer)
- ;; Enter all the new groups into a hashtable.
- (gnus-active-to-gnus-format method hashtb 'ignore))
- ;; Now all new groups from `method' are in `hashtb'.
- (mapatoms
- (lambda (group-sym)
- (if (or (null (setq group (symbol-name group-sym)))
- (not (boundp group-sym))
- (null (symbol-value group-sym))
- (gnus-gethash group gnus-newsrc-hashtb)
- (member group gnus-zombie-list)
- (member group gnus-killed-list))
- ;; The group is already known.
- ()
- ;; Make this group active.
- (when (symbol-value group-sym)
- (gnus-set-active group (symbol-value group-sym)))
- ;; Check whether we want it or not.
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (gnus-call-subscribe-functions
- gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (incf groups)
- (gnus-sethash group group gnus-killed-hashtb)
- (if gnus-subscribe-hierarchical-interactive
- (push group new-newsgroups)
- (gnus-call-subscribe-functions
- gnus-subscribe-newsgroup-method group)))))))
- hashtb))
- (when new-newsgroups
- (gnus-subscribe-hierarchical-interactive new-newsgroups)))
- (if (> groups 0)
- (gnus-message 5 "%d new newsgroup%s arrived"
- groups (if (> groups 1) "s have" " has"))
- (gnus-message 5 "No new newsgroups"))
- (when got-new
- (setq gnus-newsrc-last-checked-date new-date))
- got-new))
-
-(defun gnus-check-first-time-used ()
- (catch 'ended
- ;; First check if any of the following files exist. If they do,
- ;; it's not the first time the user has used Gnus.
- (dolist (file (list (concat gnus-current-startup-file ".el")
- (concat gnus-current-startup-file ".eld")
- (concat gnus-startup-file ".el")
- (concat gnus-startup-file ".eld")))
- (when (file-exists-p file)
- (throw 'ended nil)))
- (gnus-message 6 "First time user; subscribing you to default groups")
- (unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
- (setq gnus-newsrc-last-checked-date (message-make-date))
- ;; Subscribe to the default newsgroups.
- (let ((groups (or gnus-default-subscribed-newsgroups
- gnus-backup-default-subscribed-newsgroups))
- group)
- (if (eq groups t)
- ;; If t, we subscribe (or not) all groups as if they were new.
- (mapatoms
- (lambda (sym)
- (when (setq group (symbol-name sym))
- (let ((do-sub (gnus-matches-options-n group)))
- (cond
- ((eq do-sub 'subscribe)
- (gnus-sethash group group gnus-killed-hashtb)
- (gnus-call-subscribe-functions
- gnus-subscribe-options-newsgroup-method group))
- ((eq do-sub 'ignore)
- nil)
- (t
- (push group gnus-killed-list))))))
- gnus-active-hashtb)
- (dolist (group groups)
- ;; Only subscribe the default groups that are activated.
- (when (gnus-active group)
- (gnus-group-change-level
- group gnus-level-default-subscribed gnus-level-killed)))
- (save-excursion
- (set-buffer gnus-group-buffer)
- ;; Don't error if the group already exists. This happens when a
- ;; first-time user types 'F'. -- didier
- (gnus-group-make-help-group t))
- (when gnus-novice-user
- (gnus-message 7 "`A k' to list killed groups"))))))
-
-(defun gnus-subscribe-group (group &optional previous method)
- "Subscribe GROUP and put it after PREVIOUS."
- (gnus-group-change-level
- (if method
- (list t group gnus-level-default-subscribed nil nil method)
- group)
- gnus-level-default-subscribed gnus-level-killed previous t)
- t)
-
-;; `gnus-group-change-level' is the fundamental function for changing
-;; subscription levels of newsgroups. This might mean just changing
-;; from level 1 to 2, which is pretty trivial, from 2 to 6 or back
-;; again, which subscribes/unsubscribes a group, which is equally
-;; trivial. Changing from 1-7 to 8-9 means that you kill a group, and
-;; from 8-9 to 1-7 means that you remove the group from the list of
-;; killed (or zombie) groups and add them to the (kinda) subscribed
-;; groups. And last but not least, moving from 8 to 9 and 9 to 8,
-;; which is trivial.
-;; ENTRY can either be a string (newsgroup name) or a list (if
-;; FROMKILLED is t, it's a list on the format (NUM INFO-LIST),
-;; otherwise it's a list in the format of the `gnus-newsrc-hashtb'
-;; entries.
-;; LEVEL is the new level of the group, OLDLEVEL is the old level and
-;; PREVIOUS is the group (in hashtb entry format) to insert this group
-;; after.
-(defun gnus-group-change-level (entry level &optional oldlevel
- previous fromkilled)
- (let (group info active num)
- ;; Glean what info we can from the arguments
- (if (consp entry)
- (if fromkilled (setq group (nth 1 entry))
- (setq group (car (nth 2 entry))))
- (setq group entry))
- (when (and (stringp entry)
- oldlevel
- (< oldlevel gnus-level-zombie))
- (setq entry (gnus-gethash entry gnus-newsrc-hashtb)))
- (if (and (not oldlevel)
- (consp entry))
- (setq oldlevel (gnus-info-level (nth 2 entry)))
- (setq oldlevel (or oldlevel gnus-level-killed)))
- (when (stringp previous)
- (setq previous (gnus-gethash previous gnus-newsrc-hashtb)))
-
- (if (and (>= oldlevel gnus-level-zombie)
- (gnus-gethash group gnus-newsrc-hashtb))
- ;; We are trying to subscribe a group that is already
- ;; subscribed.
- () ; Do nothing.
-
- (unless (gnus-ephemeral-group-p group)
- (gnus-dribble-enter
- (format "(gnus-group-change-level %S %S %S %S %S)"
- group level oldlevel (car (nth 2 previous)) fromkilled)))
-
- ;; Then we remove the newgroup from any old structures, if needed.
- ;; If the group was killed, we remove it from the killed or zombie
- ;; list. If not, and it is in fact going to be killed, we remove
- ;; it from the newsrc hash table and assoc.
- (cond
- ((>= oldlevel gnus-level-zombie)
- ;; oldlevel could be wrong.
- (setq gnus-zombie-list (delete group gnus-zombie-list))
- (setq gnus-killed-list (delete group gnus-killed-list)))
- (t
- (when (and (>= level gnus-level-zombie)
- entry)
- (gnus-sethash (car (nth 2 entry)) nil gnus-newsrc-hashtb)
- (when (nth 3 entry)
- (setcdr (gnus-gethash (car (nth 3 entry))
- gnus-newsrc-hashtb)
- (cdr entry)))
- (setcdr (cdr entry) (cdddr entry)))))
-
- ;; Finally we enter (if needed) the list where it is supposed to
- ;; go, and change the subscription level. If it is to be killed,
- ;; we enter it into the killed or zombie list.
- (cond
- ((>= level gnus-level-zombie)
- ;; Remove from the hash table.
- (gnus-sethash group nil gnus-newsrc-hashtb)
- ;; We do not enter foreign groups into the list of dead
- ;; groups.
- (unless (gnus-group-foreign-p group)
- (if (= level gnus-level-zombie)
- (push group gnus-zombie-list)
- (if (= oldlevel gnus-level-killed)
- ;; Remove from active hashtb.
- (unintern group gnus-active-hashtb)
- ;; Don't add it into killed-list if it was killed.
- (push group gnus-killed-list)))))
- (t
- ;; If the list is to be entered into the newsrc assoc, and
- ;; it was killed, we have to create an entry in the newsrc
- ;; hashtb format and fix the pointers in the newsrc assoc.
- (if (< oldlevel gnus-level-zombie)
- ;; It was alive, and it is going to stay alive, so we
- ;; just change the level and don't change any pointers or
- ;; hash table entries.
- (setcar (cdaddr entry) level)
- (if (listp entry)
- (setq info (cdr entry)
- num (car entry))
- (setq active (gnus-active group))
- (setq num
- (if active (- (1+ (cdr active)) (car active)) t))
- ;; Shorten the select method if possible, if we need to
- ;; store it at all (native groups).
- (let ((method (gnus-method-simplify
- (or gnus-override-subscribe-method
- (gnus-group-method group)))))
- (if method
- (setq info (list group level nil nil method))
- (setq info (list group level nil)))))
- (unless previous
- (setq previous
- (let ((p gnus-newsrc-alist))
- (while (cddr p)
- (setq p (cdr p)))
- p)))
- (setq entry (cons info (cddr previous)))
- (if (cdr previous)
- (progn
- (setcdr (cdr previous) entry)
- (gnus-sethash group (cons num (cdr previous))
- gnus-newsrc-hashtb))
- (setcdr previous entry)
- (gnus-sethash group (cons num previous)
- gnus-newsrc-hashtb))
- (when (cdr entry)
- (setcdr (gnus-gethash (caadr entry) gnus-newsrc-hashtb) entry))
- (gnus-dribble-enter
- (format
- "(gnus-group-set-info '%S)" info)))))
- (when gnus-group-change-level-function
- (funcall gnus-group-change-level-function
- group level oldlevel previous)))))
-
-(defun gnus-kill-newsgroup (newsgroup)
- "Obsolete function. Kills a newsgroup."
- (gnus-group-change-level
- (gnus-gethash newsgroup gnus-newsrc-hashtb) gnus-level-killed))
-
-(defun gnus-check-bogus-newsgroups (&optional confirm)
- "Remove bogus newsgroups.
-If CONFIRM is non-nil, the user has to confirm the deletion of every
-newsgroup."
- (let ((newsrc (cdr gnus-newsrc-alist))
- bogus group entry info)
- (gnus-message 5 "Checking bogus newsgroups...")
- (unless (gnus-read-active-file-p)
- (gnus-read-active-file t))
- (when (gnus-read-active-file-p)
- ;; Find all bogus newsgroup that are subscribed.
- (while newsrc
- (setq info (pop newsrc)
- group (gnus-info-group info))
- (unless (or (gnus-active group) ; Active
- (and (gnus-info-method info)
- (not (gnus-secondary-method-p
- (gnus-info-method info))))) ; Foreign
- ;; Found a bogus newsgroup.
- (push group bogus)))
- (if confirm
- (map-y-or-n-p
- "Remove bogus group %s? "
- (lambda (group)
- ;; Remove all bogus subscribed groups by first killing them, and
- ;; then removing them from the list of killed groups.
- (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
- (gnus-group-change-level entry gnus-level-killed)
- (setq gnus-killed-list (delete group gnus-killed-list))))
- bogus '("group" "groups" "remove"))
- (while (setq group (pop bogus))
- ;; Remove all bogus subscribed groups by first killing them, and
- ;; then removing them from the list of killed groups.
- (when (setq entry (gnus-gethash group gnus-newsrc-hashtb))
- (gnus-group-change-level entry gnus-level-killed)
- (setq gnus-killed-list (delete group gnus-killed-list)))))
- ;; Then we remove all bogus groups from the list of killed and
- ;; zombie groups. They are removed without confirmation.
- (let ((dead-lists '(gnus-killed-list gnus-zombie-list))
- killed)
- (while dead-lists
- (setq killed (symbol-value (car dead-lists)))
- (while killed
- (unless (gnus-active (setq group (pop killed)))
- ;; The group is bogus.
- ;; !!!Slow as hell.
- (set (car dead-lists)
- (delete group (symbol-value (car dead-lists))))))
- (setq dead-lists (cdr dead-lists))))
- (gnus-run-hooks 'gnus-check-bogus-groups-hook)
- (gnus-message 5 "Checking bogus newsgroups...done"))))
-
-(defun gnus-check-duplicate-killed-groups ()
- "Remove duplicates from the list of killed groups."
- (interactive)
- (let ((killed gnus-killed-list))
- (while killed
- (gnus-message 9 "%d" (length killed))
- (setcdr killed (delete (car killed) (cdr killed)))
- (setq killed (cdr killed)))))
-
-;; We want to inline a function from gnus-cache, so we cheat here:
-(eval-when-compile
- (defvar gnus-cache-active-hashtb)
- (defun gnus-cache-possibly-alter-active (group active)
- "Alter the ACTIVE info for GROUP to reflect the articles in the cache."
- (when gnus-cache-active-hashtb
- (let ((cache-active (gnus-gethash group gnus-cache-active-hashtb)))
- (when cache-active
- (when (< (car cache-active) (car active))
- (setcar active (car cache-active)))
- (when (> (cdr cache-active) (cdr active))
- (setcdr active (cdr cache-active))))))))
-
-(defun gnus-activate-group (group &optional scan dont-check method)
- "Check whether a group has been activated or not.
-If SCAN, request a scan of that group as well."
- (let ((method (or method (inline (gnus-find-method-for-group group))))
- active)
- (and (inline (gnus-check-server method))
- ;; We escape all bugs and quit here to make it possible to
- ;; continue if a group is so out-there that it reports bugs
- ;; and stuff.
- (progn
- (and scan
- (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan group method))
- t)
- (if (or debug-on-error debug-on-quit)
- (inline (gnus-request-group group dont-check method))
- (condition-case nil
- (inline (gnus-request-group group dont-check method))
- ;;(error nil)
- (quit
- (message "Quit activating %s" group)
- nil)))
- (unless dont-check
- (setq active (gnus-parse-active))
- ;; If there are no articles in the group, the GROUP
- ;; command may have responded with the `(0 . 0)'. We
- ;; ignore this if we already have an active entry
- ;; for the group.
- (if (and (zerop (car active))
- (zerop (cdr active))
- (gnus-active group))
- (gnus-active group)
-
- ;; If a cache is present, we may have to alter the active info.
- (when gnus-use-cache
- (inline (gnus-cache-possibly-alter-active
- group active)))
-
- ;; If the agent is enabled, we may have to alter the active info.
- (when gnus-agent
- (gnus-agent-possibly-alter-active group active))
-
- (gnus-set-active group active)
- ;; Return the new active info.
- active)))))
-
-(defun gnus-get-unread-articles-in-group (info active &optional update)
- (when (and info active)
- ;; Allow the backend to update the info in the group.
- (when (and update
- (gnus-request-update-info
- info (inline (gnus-find-method-for-group
- (gnus-info-group info)))))
- (gnus-activate-group (gnus-info-group info) nil t))
-
- (let* ((range (gnus-info-read info))
- (num 0))
-
- ;; These checks are present in gnus-activate-group but skipped
- ;; due to setting dont-check in the preceeding call.
-
- ;; If a cache is present, we may have to alter the active info.
- (when (and gnus-use-cache info)
- (inline (gnus-cache-possibly-alter-active
- (gnus-info-group info) active)))
-
- ;; If the agent is enabled, we may have to alter the active info.
- (when (and gnus-agent info)
- (gnus-agent-possibly-alter-active (gnus-info-group info) active info))
-
- ;; Modify the list of read articles according to what articles
- ;; are available; then tally the unread articles and add the
- ;; number to the group hash table entry.
- (cond
- ((zerop (cdr active))
- (setq num 0))
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- ;; Fix a single (num . num) range according to the
- ;; active hash table.
- ;; Fix by Carsten Bormann <cabo@Informatik.Uni-Bremen.DE>.
- (and (< (cdr range) (car active)) (setcdr range (1- (car active))))
- (and (> (cdr range) (cdr active)) (setcdr range (cdr active)))
- ;; Compute number of unread articles.
- (setq num (max 0 (- (cdr active) (- (1+ (cdr range)) (car range))))))
- (t
- ;; The read list is a list of ranges. Fix them according to
- ;; the active hash table.
- ;; First peel off any elements that are below the lower
- ;; active limit.
- (while (and (cdr range)
- (>= (car active)
- (or (and (atom (cadr range)) (cadr range))
- (caadr range))))
- (if (numberp (car range))
- (setcar range
- (cons (car range)
- (or (and (numberp (cadr range))
- (cadr range))
- (cdadr range))))
- (setcdr (car range)
- (or (and (numberp (nth 1 range)) (nth 1 range))
- (cdadr range))))
- (setcdr range (cddr range)))
- ;; Adjust the first element to be the same as the lower limit.
- (when (and (not (atom (car range)))
- (< (cdar range) (car active)))
- (setcdr (car range) (1- (car active))))
- ;; Then we want to peel off any elements that are higher
- ;; than the upper active limit.
- (let ((srange range))
- ;; Go past all valid elements.
- (while (and (cdr srange)
- (<= (or (and (atom (cadr srange))
- (cadr srange))
- (caadr srange))
- (cdr active)))
- (setq srange (cdr srange)))
- (when (cdr srange)
- ;; Nuke all remaining invalid elements.
- (setcdr srange nil))
-
- ;; Adjust the final element.
- (when (and (not (atom (car srange)))
- (> (cdar srange) (cdr active)))
- (setcdr (car srange) (cdr active))))
- ;; Compute the number of unread articles.
- (while range
- (setq num (+ num (- (1+ (or (and (atom (car range)) (car range))
- (cdar range)))
- (or (and (atom (car range)) (car range))
- (caar range)))))
- (setq range (cdr range)))
- (setq num (max 0 (- (cdr active) num)))))
- ;; Set the number of unread articles.
- (when (and info
- (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb))
- (setcar (gnus-gethash (gnus-info-group info) gnus-newsrc-hashtb) num))
- num)))
-
-;; Go though `gnus-newsrc-alist' and compare with `gnus-active-hashtb'
-;; and compute how many unread articles there are in each group.
-(defun gnus-get-unread-articles (&optional level)
- (setq gnus-server-method-cache nil)
- (let* ((newsrc (cdr gnus-newsrc-alist))
- (level (or level gnus-activate-level (1+ gnus-level-subscribed)))
- (foreign-level
- (min
- (cond ((and gnus-activate-foreign-newsgroups
- (not (numberp gnus-activate-foreign-newsgroups)))
- (1+ gnus-level-subscribed))
- ((numberp gnus-activate-foreign-newsgroups)
- gnus-activate-foreign-newsgroups)
- (t 0))
- level))
- (methods-cache nil)
- (type-cache nil)
- scanned-methods info group active method retrieve-groups cmethod
- method-type)
- (gnus-message 6 "Checking new news...")
-
- (while newsrc
- (setq active (gnus-active (setq group (gnus-info-group
- (setq info (pop newsrc))))))
-
- ;; Check newsgroups. If the user doesn't want to check them, or
- ;; they can't be checked (for instance, if the news server can't
- ;; be reached) we just set the number of unread articles in this
- ;; newsgroup to t. This means that Gnus thinks that there are
- ;; unread articles, but it has no idea how many.
-
- ;; To be more explicit:
- ;; >0 for an active group with messages
- ;; 0 for an active group with no unread messages
- ;; nil for non-foreign groups that the user has requested not be checked
- ;; t for unchecked foreign groups or bogus groups, or groups that can't
- ;; be checked, for one reason or other.
- (when (setq method (gnus-info-method info))
- (if (setq cmethod (assoc method methods-cache))
- (setq method (cdr cmethod))
- (setq cmethod (inline (gnus-server-get-method nil method)))
- (push (cons method cmethod) methods-cache)
- (setq method cmethod)))
- (when (and method
- (not (setq method-type (cdr (assoc method type-cache)))))
- (setq method-type
- (cond
- ((gnus-secondary-method-p method)
- 'secondary)
- ((inline (gnus-server-equal gnus-select-method method))
- 'primary)
- (t
- 'foreign)))
- (push (cons method method-type) type-cache))
-
- (cond ((and method (eq method-type 'foreign))
- ;; These groups are foreign. Check the level.
- (when (and (<= (gnus-info-level info) foreign-level)
- (setq active (gnus-activate-group group 'scan)))
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent active (gnus-online method))
- (gnus-agent-save-group-info
- method (gnus-group-real-name group) active))
- (unless (inline (gnus-virtual-group-p group))
- (inline (gnus-close-group group)))
- (when (fboundp (intern (concat (symbol-name (car method))
- "-request-update-info")))
- (inline (gnus-request-update-info info method)))))
- ;; These groups are native or secondary.
- ((> (gnus-info-level info) level)
- ;; We don't want these groups.
- (setq active 'ignore))
- ;; Activate groups.
- ((not gnus-read-active-file)
- (if (gnus-check-backend-function 'retrieve-groups group)
- ;; if server support gnus-retrieve-groups we push
- ;; the group onto retrievegroups for later checking
- (if (assoc method retrieve-groups)
- (setcdr (assoc method retrieve-groups)
- (cons group (cdr (assoc method retrieve-groups))))
- (push (list method group) retrieve-groups))
- ;; hack: `nnmail-get-new-mail' changes the mail-source depending
- ;; on the group, so we must perform a scan for every group
- ;; if the users has any directory mail sources.
- ;; hack: if `nnmail-scan-directory-mail-source-once' is non-nil,
- ;; for it scan all spool files even when the groups are
- ;; not required.
- (if (and
- (or nnmail-scan-directory-mail-source-once
- (null (assq 'directory
- (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))))
- (member method scanned-methods))
- (setq active (gnus-activate-group group))
- (setq active (gnus-activate-group group 'scan))
- (push method scanned-methods))
- (when active
- (gnus-close-group group)))))
-
- ;; Get the number of unread articles in the group.
- (cond
- ((eq active 'ignore)
- ;; Don't do anything.
- )
- (active
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (let ((tmp (gnus-gethash group gnus-newsrc-hashtb)))
- (when tmp
- (setcar tmp t))))))
-
- ;; iterate through groups on methods which support gnus-retrieve-groups
- ;; and fetch a partial active file and use it to find new news.
- (dolist (rg retrieve-groups)
- (let ((method (or (car rg) gnus-select-method))
- (groups (cdr rg)))
- (when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (gnus-read-active-file-2
- (mapcar (lambda (group) (gnus-group-real-name group)) groups)
- method)
- (dolist (group groups)
- (cond
- ((setq active (gnus-active (gnus-info-group
- (setq info (gnus-get-info group)))))
- (inline (gnus-get-unread-articles-in-group info active t)))
- (t
- ;; The group couldn't be reached, so we nix out the number of
- ;; unread articles and stuff.
- (gnus-set-active group nil)
- (setcar (gnus-gethash group gnus-newsrc-hashtb) t)))))))
-
- (gnus-message 6 "Checking new news...done")))
-
-;; Create a hash table out of the newsrc alist. The `car's of the
-;; alist elements are used as keys.
-(defun gnus-make-hashtable-from-newsrc-alist ()
- (let ((alist gnus-newsrc-alist)
- (ohashtb gnus-newsrc-hashtb)
- prev)
- (setq gnus-newsrc-hashtb (gnus-make-hashtable (length alist)))
- (setq alist
- (setq prev (setq gnus-newsrc-alist
- (if (equal (caar gnus-newsrc-alist)
- "dummy.group")
- gnus-newsrc-alist
- (cons (list "dummy.group" 0 nil) alist)))))
- (while alist
- (gnus-sethash
- (caar alist)
- ;; Preserve number of unread articles in groups.
- (cons (and ohashtb (car (gnus-gethash (caar alist) ohashtb)))
- prev)
- gnus-newsrc-hashtb)
- (setq prev alist
- alist (cdr alist)))))
-
-(defun gnus-make-hashtable-from-killed ()
- "Create a hash table from the killed and zombie lists."
- (let ((lists '(gnus-killed-list gnus-zombie-list))
- list)
- (setq gnus-killed-hashtb
- (gnus-make-hashtable
- (+ (length gnus-killed-list) (length gnus-zombie-list))))
- (while lists
- (setq list (symbol-value (pop lists)))
- (while list
- (gnus-sethash (car list) (pop list) gnus-killed-hashtb)))))
-
-(defun gnus-parse-active ()
- "Parse active info in the nntp server buffer."
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- ;; Parse the result we got from `gnus-request-group'.
- (when (looking-at "[0-9]+ [0-9]+ \\([0-9]+\\) [0-9]+")
- (goto-char (match-beginning 1))
- (cons (read (current-buffer))
- (read (current-buffer))))))
-
-(defun gnus-make-articles-unread (group articles)
- "Mark ARTICLES in GROUP as unread."
- (let* ((info (nth 2 (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash (gnus-group-real-name group)
- gnus-newsrc-hashtb))))
- (ranges (gnus-info-read info))
- news article)
- (while articles
- (when (gnus-member-of-range
- (setq article (pop articles)) ranges)
- (push article news)))
- (when news
- ;; Enter this list into the group info.
- (gnus-info-set-read
- info (gnus-remove-from-range (gnus-info-read info) (nreverse news)))
-
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
-
- ;; Insert the change into the group buffer and the dribble file.
- (gnus-group-update-group group t))))
-
-(defun gnus-make-ascending-articles-unread (group articles)
- "Mark ascending ARTICLES in GROUP as unread."
- (let* ((entry (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash (gnus-group-real-name group)
- gnus-newsrc-hashtb)))
- (info (nth 2 entry))
- (ranges (gnus-info-read info))
- (r ranges)
- modified)
-
- (while articles
- (let ((article (pop articles))) ; get the next article to remove from ranges
- (while (let ((range (car ranges))) ; note the current range
- (if (atom range) ; single value range
- (cond ((not range)
- ;; the articles extend past the end of the ranges
- ;; OK - I'm done
- (setq articles nil))
- ((< range article)
- ;; this range preceeds the article. Leave the range unmodified.
- (pop ranges)
- ranges)
- ((= range article)
- ;; this range exactly matches the article; REMOVE THE RANGE.
- ;; NOTE: When the range being removed is the last range, the list is corrupted by inserting null at its end.
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges))
- (setq modified (if (car ranges) t 'remove-null))
- nil))
- (let ((min (car range))
- (max (cdr range)))
- ;; I have a min/max range to consider
- (cond ((> min max) ; invalid range introduced by splitter
- (setcar ranges (cadr ranges))
- (setcdr ranges (cddr ranges))
- (setq modified (if (car ranges) t 'remove-null))
- ranges)
- ((= min max)
- ;; replace min/max range with a single-value range
- (setcar ranges min)
- ranges)
- ((< max article)
- ;; this range preceeds the article. Leave the range unmodified.
- (pop ranges)
- ranges)
- ((< article min)
- ;; this article preceeds the range. Return null to move to the
- ;; next article
- nil)
- (t
- ;; this article splits the range into two parts
- (setcdr ranges (cons (cons (1+ article) max) (cdr ranges)))
- (setcdr range (1- article))
- (setq modified t)
- ranges))))))))
-
- (when modified
- (when (eq modified 'remove-null)
- (setq r (delq nil r)))
- ;; Enter this list into the group info.
- (gnus-info-set-read info r)
-
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
-
- ;; Insert the change into the group buffer and the dribble file.
- (gnus-group-update-group group t))))
-
-;; Enter all dead groups into the hashtb.
-(defun gnus-update-active-hashtb-from-killed ()
- (let ((hashtb (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
- (lists (list gnus-killed-list gnus-zombie-list))
- killed)
- (while lists
- (setq killed (car lists))
- (while killed
- (gnus-sethash (car killed) nil hashtb)
- (setq killed (cdr killed)))
- (setq lists (cdr lists)))))
-
-(defun gnus-get-killed-groups ()
- "Go through the active hashtb and mark all unknown groups as killed."
- ;; First make sure active file has been read.
- (unless (gnus-read-active-file-p)
- (let ((gnus-read-active-file t))
- (gnus-read-active-file)))
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- ;; Go through all newsgroups that are known to Gnus - enlarge kill list.
- (mapatoms
- (lambda (sym)
- (let ((groups 0)
- (group (symbol-name sym)))
- (if (or (null group)
- (gnus-gethash group gnus-killed-hashtb)
- (gnus-gethash group gnus-newsrc-hashtb))
- ()
- (let ((do-sub (gnus-matches-options-n group)))
- (if (or (eq do-sub 'subscribe) (eq do-sub 'ignore))
- ()
- (setq groups (1+ groups))
- (push group gnus-killed-list)
- (gnus-sethash group group gnus-killed-hashtb))))))
- gnus-active-hashtb)
- (gnus-dribble-touch))
-
-;; Get the active file(s) from the backend(s).
-(defun gnus-read-active-file (&optional force not-native)
- (gnus-group-set-mode-line)
- (let ((methods
- (mapcar
- (lambda (m) (if (stringp m) (gnus-server-get-method nil m) m))
- (append
- (if (and (not not-native)
- (gnus-check-server gnus-select-method))
- ;; The native server is available.
- (cons gnus-select-method gnus-secondary-select-methods)
- ;; The native server is down, so we just do the
- ;; secondary ones.
- gnus-secondary-select-methods)
- ;; Also read from the archive server.
- (when (gnus-archive-server-wanted-p)
- (list "archive")))))
- method)
- (setq gnus-have-read-active-file nil)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (while (setq method (pop methods))
- ;; Only do each method once, in case the methods appear more
- ;; than once in this list.
- (unless (member method methods)
- (if (or debug-on-error debug-on-quit)
- (gnus-read-active-file-1 method force)
- (condition-case ()
- (gnus-read-active-file-1 method force)
- ;; We catch C-g so that we can continue past servers
- ;; that do not respond.
- (quit
- (message "Quit reading the active file")
- nil))))))))
-
-(defun gnus-read-active-file-1 (method force)
- (let (where mesg)
- (setq where (nth 1 method)
- mesg (format "Reading active file%s via %s..."
- (if (and where (not (zerop (length where))))
- (concat " from " where) "")
- (car method)))
- (gnus-message 5 mesg)
- (when (gnus-check-server method)
- ;; Request that the backend scan its incoming messages.
- (when (gnus-check-backend-function 'request-scan (car method))
- (gnus-request-scan nil method))
- (cond
- ((and (eq gnus-read-active-file 'some)
- (gnus-check-backend-function 'retrieve-groups (car method))
- (not force))
- (let ((newsrc (cdr gnus-newsrc-alist))
- (gmethod (gnus-server-get-method nil method))
- groups info)
- (while (setq info (pop newsrc))
- (when (inline
- (gnus-server-equal
- (inline
- (gnus-find-method-for-group
- (gnus-info-group info) info))
- gmethod))
- (push (gnus-group-real-name (gnus-info-group info))
- groups)))
- (gnus-read-active-file-2 groups method)))
- ((null method)
- t)
- (t
- (if (not (gnus-request-list method))
- (unless (equal method gnus-message-archive-method)
- (gnus-error 1 "Cannot read active file from %s server"
- (car method)))
- (gnus-message 5 mesg)
- (gnus-active-to-gnus-format method gnus-active-hashtb nil t)
- ;; We mark this active file as read.
- (push method gnus-have-read-active-file)
- (gnus-message 5 "%sdone" mesg)))))))
-
-(defun gnus-read-active-file-2 (groups method)
- "Read an active file for GROUPS in METHOD using `gnus-retrieve-groups'."
- (when groups
- (save-excursion
- (set-buffer nntp-server-buffer)
- (gnus-check-server method)
- (let ((list-type (gnus-retrieve-groups groups method)))
- (cond ((not list-type)
- (gnus-error
- 1.2 "Cannot read partial active file from %s server."
- (car method)))
- ((eq list-type 'active)
- (gnus-active-to-gnus-format method gnus-active-hashtb nil t))
- (t
- (gnus-groups-to-gnus-format method gnus-active-hashtb t)))))))
-
-;; Read an active file and place the results in `gnus-active-hashtb'.
-(defun gnus-active-to-gnus-format (&optional method hashtb ignore-errors
- real-active)
- (unless method
- (setq method gnus-select-method))
- (let ((cur (current-buffer))
- (hashtb (or hashtb
- (if (and gnus-active-hashtb
- (not (equal method gnus-select-method)))
- gnus-active-hashtb
- (setq gnus-active-hashtb
- (if (equal method gnus-select-method)
- (gnus-make-hashtable
- (count-lines (point-min) (point-max)))
- (gnus-make-hashtable 4096)))))))
- ;; Delete unnecessary lines.
- (goto-char (point-min))
- (cond
- ((string= gnus-ignored-newsgroups "")
- (delete-matching-lines "^to\\."))
- (t
- (delete-matching-lines (concat "^to\\.\\|" gnus-ignored-newsgroups))))
-
- (goto-char (point-min))
- (unless (re-search-forward "[\\\"]" nil t)
- ;; Make the group names readable as a lisp expression even if they
- ;; contain special characters.
- (goto-char (point-max))
- (while (re-search-backward "[][';?()#]" nil t)
- (insert ?\\)))
-
- ;; Let the Gnus agent save the active file.
- (when (and gnus-agent real-active (gnus-online method))
- (gnus-agent-save-active method))
-
- ;; If these are groups from a foreign select method, we insert the
- ;; group prefix in front of the group names.
- (when (not (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method nil gnus-select-method)))
- (let ((prefix (gnus-group-prefixed-name "" method)))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn
- (when (= (following-char) ?\")
- (forward-char 1))
- (insert prefix)
- (zerop (forward-line 1)))))))
- ;; Store the active file in a hash table.
- (goto-char (point-min))
- (let (group max min)
- (while (not (eobp))
- (condition-case ()
- (progn
- (narrow-to-region (point) (gnus-point-at-eol))
- ;; group gets set to a symbol interned in the hash table
- ;; (what a hack!!) - jwz
- (setq group (let ((obarray hashtb)) (read cur)))
- ;; ### The extended group name scheme makes
- ;; the previous optimization strategy sort of pointless...
- (when (stringp group)
- (setq group (intern group hashtb)))
- (if (and (numberp (setq max (read cur)))
- (numberp (setq min (read cur)))
- (progn
- (skip-chars-forward " \t")
- (not
- (or (eq (char-after) ?=)
- (eq (char-after) ?x)
- (eq (char-after) ?j)))))
- (progn
- (set group (cons min max))
- ;; if group is moderated, stick in moderation table
- (when (eq (char-after) ?m)
- (unless gnus-moderated-hashtb
- (setq gnus-moderated-hashtb (gnus-make-hashtable)))
- (gnus-sethash (symbol-name group) t
- gnus-moderated-hashtb)))
- (set group nil)))
- (error
- (and group
- (symbolp group)
- (set group nil))
- (unless ignore-errors
- (gnus-message 3 "Warning - invalid active: %s"
- (buffer-substring
- (gnus-point-at-bol) (gnus-point-at-eol))))))
- (widen)
- (forward-line 1)))))
-
-(defun gnus-groups-to-gnus-format (method &optional hashtb real-active)
- ;; Parse a "groups" active file.
- (let ((cur (current-buffer))
- (hashtb (or hashtb
- (if (and method gnus-active-hashtb)
- gnus-active-hashtb
- (setq gnus-active-hashtb
- (gnus-make-hashtable
- (count-lines (point-min) (point-max)))))))
- (prefix (and method
- (not (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method nil gnus-select-method)))
- (gnus-group-prefixed-name "" method))))
-
- ;; Let the Gnus agent save the active file.
- (if (and gnus-agent
- real-active
- (gnus-online method)
- (gnus-agent-method-p method))
- (progn
- (gnus-agent-save-active method)
- (gnus-active-to-gnus-format method hashtb nil real-active))
-
- (goto-char (point-min))
- ;; We split this into to separate loops, one with the prefix
- ;; and one without to speed the reading up somewhat.
- (if prefix
- (let (min max opoint group)
- (while (not (eobp))
- (condition-case ()
- (progn
- (read cur) (read cur)
- (setq min (read cur)
- max (read cur)
- opoint (point))
- (skip-chars-forward " \t")
- (insert prefix)
- (goto-char opoint)
- (set (let ((obarray hashtb)) (read cur))
- (cons min max)))
- (error (and group (symbolp group) (set group nil))))
- (forward-line 1)))
- (let (min max group)
- (while (not (eobp))
- (condition-case ()
- (when (eq (char-after) ?2)
- (read cur) (read cur)
- (setq min (read cur)
- max (read cur))
- (set (setq group (let ((obarray hashtb)) (read cur)))
- (cons min max)))
- (error (and group (symbolp group) (set group nil))))
- (forward-line 1)))))))
-
-(defun gnus-read-newsrc-file (&optional force)
- "Read startup file.
-If FORCE is non-nil, the .newsrc file is read."
- ;; Reset variables that might be defined in the .newsrc.eld file.
- (let ((variables (remove 'gnus-format-specs gnus-variable-list)))
- (while variables
- (set (car variables) nil)
- (setq variables (cdr variables))))
- (let* ((newsrc-file gnus-current-startup-file)
- (quick-file (concat newsrc-file ".el")))
- (save-excursion
- ;; We always load the .newsrc.eld file. If always contains
- ;; much information that can not be gotten from the .newsrc
- ;; file (ticked articles, killed groups, foreign methods, etc.)
- (gnus-read-newsrc-el-file quick-file)
-
- (when (and gnus-read-newsrc-file
- (file-exists-p gnus-current-startup-file)
- (or force
- (and (file-newer-than-file-p newsrc-file quick-file)
- (file-newer-than-file-p newsrc-file
- (concat quick-file "d")))
- (not gnus-newsrc-alist)))
- ;; We read the .newsrc file. Note that if there if a
- ;; .newsrc.eld file exists, it has already been read, and
- ;; the `gnus-newsrc-hashtb' has been created. While reading
- ;; the .newsrc file, Gnus will only use the information it
- ;; can find there for changing the data already read -
- ;; i. e., reading the .newsrc file will not trash the data
- ;; already read (except for read articles).
- (save-excursion
- (gnus-message 5 "Reading %s..." newsrc-file)
- (set-buffer (nnheader-find-file-noselect newsrc-file))
- (buffer-disable-undo)
- (gnus-newsrc-to-gnus-format)
- (kill-buffer (current-buffer))
- (gnus-message 5 "Reading %s...done" newsrc-file)))
-
- ;; Convert old to new.
- (gnus-convert-old-newsrc))))
-
-(defun gnus-convert-old-newsrc ()
- "Convert old newsrc formats into the current format, if needed."
- (let ((fcv (and gnus-newsrc-file-version
- (gnus-continuum-version gnus-newsrc-file-version)))
- (gcv (gnus-continuum-version)))
- (when fcv
- ;; A newsrc file was loaded.
- (let (prompt-displayed
- (converters
- (sort
- (mapcar (lambda (date-func)
- (cons (gnus-continuum-version (car date-func))
- date-func))
- ;; This is a list of converters that must be run
- ;; to bring the newsrc file up to the current
- ;; version. If you create an incompatibility
- ;; with older versions, you should create an
- ;; entry here. The entry should consist of the
- ;; current gnus version (hardcoded so that it
- ;; doesn't change with each release) and the
- ;; function that must be applied to convert the
- ;; previous version into the current version.
- '(("September Gnus v0.1" nil
- gnus-convert-old-ticks)
- ("Oort Gnus v0.08" "legacy-gnus-agent"
- gnus-agent-convert-to-compressed-agentview)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unlist-expire-days)
- ("Gnus v5.10.7" "legacy-gnus-agent"
- gnus-agent-unhook-expire-days)))
- #'car-less-than-car)))
- ;; Skip converters older than the file version
- (while (and converters (>= fcv (caar converters)))
- (pop converters))
-
- ;; Perform converters to bring older version up to date.
- (when (and converters (< fcv (caar converters)))
- (while (and converters (< fcv (caar converters))
- (<= (caar converters) gcv))
- (let* ((converter-spec (pop converters))
- (convert-to (nth 1 converter-spec))
- (load-from (nth 2 converter-spec))
- (func (nth 3 converter-spec)))
- (when (and load-from
- (not (fboundp func)))
- (load load-from t))
- (or prompt-displayed
- (not (gnus-convert-converter-needs-prompt func))
- (while (let (c
- (cursor-in-echo-area t)
- (echo-keystrokes 0))
- (message "Convert gnus from version '%s' to '%s'? (n/y/?)"
- gnus-newsrc-file-version gnus-version)
- (setq c (read-char-exclusive))
-
- (cond ((or (eq c ?n) (eq c ?N))
- (error "Can not start gnus without converting"))
- ((or (eq c ?y) (eq c ?Y))
- (setq prompt-displayed t)
- nil)
- ((eq c ?\?)
- (message "This conversion is irreversible. \
- To be safe, you should backup your files before proceeding.")
- (sit-for 5)
- t)
- (t
- (gnus-message 3 "Ignoring unexpected input")
- (sit-for 3)
- t)))))
-
- (funcall func convert-to)))
- (gnus-dribble-enter
- (format ";Converted gnus from version '%s' to '%s'."
- gnus-newsrc-file-version gnus-version)))))))
-
-(defun gnus-convert-mark-converter-prompt (converter no-prompt)
- "Indicate whether CONVERTER requires gnus-convert-old-newsrc to
- display the conversion prompt. NO-PROMPT may be nil (prompt),
- t (no prompt), or any form that can be called as a function.
- The form should return either t or nil."
- (put converter 'gnus-convert-no-prompt no-prompt))
-
-(defun gnus-convert-converter-needs-prompt (converter)
- (let ((no-prompt (get converter 'gnus-convert-no-prompt)))
- (not (if (memq no-prompt '(t nil))
- no-prompt
- (funcall no-prompt)))))
-
-(defun gnus-convert-old-ticks (converting-to)
- (let ((newsrc (cdr gnus-newsrc-alist))
- marks info dormant ticked)
- (while (setq info (pop newsrc))
- (when (setq marks (gnus-info-marks info))
- (setq dormant (cdr (assq 'dormant marks))
- ticked (cdr (assq 'tick marks)))
- (when (or dormant ticked)
- (gnus-info-set-read
- info
- (gnus-add-to-range
- (gnus-info-read info)
- (nconc (gnus-uncompress-range dormant)
- (gnus-uncompress-range ticked)))))))))
-
-(defun gnus-load (file)
- "Load FILE, but in such a way that read errors can be reported."
- (with-temp-buffer
- (insert-file-contents file)
- (while (not (eobp))
- (condition-case type
- (let ((form (read (current-buffer))))
- (eval form))
- (error
- (unless (eq (car type) 'end-of-file)
- (let ((error (format "Error in %s line %d" file
- (count-lines (point-min) (point)))))
- (ding)
- (unless (gnus-yes-or-no-p (concat error "; continue? "))
- (error "%s" error)))))))))
-
-(defun gnus-read-newsrc-el-file (file)
- (let ((ding-file (concat file "d")))
- (when (file-exists-p ding-file)
- ;; We always, always read the .eld file.
- (gnus-message 5 "Reading %s..." ding-file)
- (let (gnus-newsrc-assoc)
- (let ((coding-system-for-read gnus-ding-file-coding-system))
- (gnus-load ding-file))
- ;; Older versions of `gnus-format-specs' are no longer valid
- ;; in Oort Gnus 0.01.
- (let ((version
- (and gnus-newsrc-file-version
- (gnus-continuum-version gnus-newsrc-file-version))))
- (when (or (not version)
- (< version 5.090009))
- (setq gnus-format-specs gnus-default-format-specs)))
- (when gnus-newsrc-assoc
- (setq gnus-newsrc-alist gnus-newsrc-assoc))))
- (gnus-make-hashtable-from-newsrc-alist)
- (when (file-newer-than-file-p file ding-file)
- ;; Old format quick file
- (gnus-message 5 "Reading %s..." file)
- ;; The .el file is newer than the .eld file, so we read that one
- ;; as well.
- (gnus-read-old-newsrc-el-file file)))
- (gnus-run-hooks 'gnus-read-newsrc-el-hook))
-
-;; Parse the old-style quick startup file
-(defun gnus-read-old-newsrc-el-file (file)
- (let (newsrc killed marked group m info)
- (prog1
- (let ((gnus-killed-assoc nil)
- gnus-marked-assoc gnus-newsrc-alist gnus-newsrc-assoc)
- (prog1
- (ignore-errors
- (load file t t t))
- (setq newsrc gnus-newsrc-assoc
- killed gnus-killed-assoc
- marked gnus-marked-assoc)))
- (setq gnus-newsrc-alist nil)
- (while (setq group (pop newsrc))
- (if (setq info (gnus-get-info (car group)))
- (progn
- (gnus-info-set-read info (cddr group))
- (gnus-info-set-level
- info (if (nth 1 group) gnus-level-default-subscribed
- gnus-level-default-unsubscribed))
- (push info gnus-newsrc-alist))
- (push (setq info
- (list (car group)
- (if (nth 1 group) gnus-level-default-subscribed
- gnus-level-default-unsubscribed)
- (cddr group)))
- gnus-newsrc-alist))
- ;; Copy marks into info.
- (when (setq m (assoc (car group) marked))
- (unless (nthcdr 3 info)
- (nconc info (list nil)))
- (gnus-info-set-marks
- info (list (cons 'tick (gnus-compress-sequence
- (sort (cdr m) '<) t))))))
- (setq newsrc killed)
- (while newsrc
- (setcar newsrc (caar newsrc))
- (setq newsrc (cdr newsrc)))
- (setq gnus-killed-list killed))
- ;; The .el file version of this variable does not begin with
- ;; "options", while the .eld version does, so we just add it if it
- ;; isn't there.
- (when
- gnus-newsrc-options
- (when (not (string-match "^ *options" gnus-newsrc-options))
- (setq gnus-newsrc-options (concat "options " gnus-newsrc-options)))
- (when (not (string-match "\n$" gnus-newsrc-options))
- (setq gnus-newsrc-options (concat gnus-newsrc-options "\n")))
- ;; Finally, if we read some options lines, we parse them.
- (unless (string= gnus-newsrc-options "")
- (gnus-newsrc-parse-options gnus-newsrc-options)))
-
- (setq gnus-newsrc-alist (nreverse gnus-newsrc-alist))
- (gnus-make-hashtable-from-newsrc-alist)))
-
-(defun gnus-make-newsrc-file (file)
- "Make server dependent file name by catenating FILE and server host name."
- (let* ((file (expand-file-name file nil))
- (real-file (concat file "-" (nth 1 gnus-select-method))))
- (if (or (file-exists-p real-file)
- (file-exists-p (concat real-file ".el"))
- (file-exists-p (concat real-file ".eld")))
- real-file
- file)))
-
-(defun gnus-newsrc-to-gnus-format ()
- (setq gnus-newsrc-options "")
- (setq gnus-newsrc-options-n nil)
-
- (unless gnus-active-hashtb
- (setq gnus-active-hashtb (gnus-make-hashtable 4096)))
- (let ((buf (current-buffer))
- (already-read (> (length gnus-newsrc-alist) 1))
- group subscribed options-symbol newsrc Options-symbol
- symbol reads num1)
- (goto-char (point-min))
- ;; We intern the symbol `options' in the active hashtb so that we
- ;; can `eq' against it later.
- (set (setq options-symbol (intern "options" gnus-active-hashtb)) nil)
- (set (setq Options-symbol (intern "Options" gnus-active-hashtb)) nil)
-
- (while (not (eobp))
- ;; We first read the first word on the line by narrowing and
- ;; then reading into `gnus-active-hashtb'. Most groups will
- ;; already exist in that hashtb, so this will save some string
- ;; space.
- (narrow-to-region
- (point)
- (progn (skip-chars-forward "^ \t!:\n") (point)))
- (goto-char (point-min))
- (setq symbol
- (and (/= (point-min) (point-max))
- (let ((obarray gnus-active-hashtb)) (read buf))))
- (widen)
- ;; Now, the symbol we have read is either `options' or a group
- ;; name. If it is an options line, we just add it to a string.
- (cond
- ((or (eq symbol options-symbol)
- (eq symbol Options-symbol))
- (setq gnus-newsrc-options
- ;; This concating is quite inefficient, but since our
- ;; thorough studies show that approx 99.37% of all
- ;; .newsrc files only contain a single options line, we
- ;; don't give a damn, frankly, my dear.
- (concat gnus-newsrc-options
- (buffer-substring
- (gnus-point-at-bol)
- ;; Options may continue on the next line.
- (or (and (re-search-forward "^[^ \t]" nil 'move)
- (progn (beginning-of-line) (point)))
- (point)))))
- (forward-line -1))
- (symbol
- ;; Group names can be just numbers.
- (when (numberp symbol)
- (setq symbol (intern (int-to-string symbol) gnus-active-hashtb)))
- (unless (boundp symbol)
- (set symbol nil))
- ;; It was a group name.
- (setq subscribed (eq (char-after) ?:)
- group (symbol-name symbol)
- reads nil)
- (if (eolp)
- ;; If the line ends here, this is clearly a buggy line, so
- ;; we put point a the beginning of line and let the cond
- ;; below do the error handling.
- (beginning-of-line)
- ;; We skip to the beginning of the ranges.
- (skip-chars-forward "!: \t"))
- ;; We are now at the beginning of the list of read articles.
- ;; We read them range by range.
- (while
- (cond
- ((looking-at "[0-9]+")
- ;; We narrow and read a number instead of buffer-substring/
- ;; string-to-number because it's faster. narrow/widen is
- ;; faster than save-restriction/narrow, and save-restriction
- ;; produces a garbage object.
- (setq num1 (progn
- (narrow-to-region (match-beginning 0) (match-end 0))
- (read buf)))
- (widen)
- ;; If the next character is a dash, then this is a range.
- (if (eq (char-after) ?-)
- (progn
- ;; We read the upper bound of the range.
- (forward-char 1)
- (if (not (looking-at "[0-9]+"))
- ;; This is a buggy line, by we pretend that
- ;; it's kinda OK. Perhaps the user should be
- ;; dinged?
- (push num1 reads)
- (push
- (cons num1
- (progn
- (narrow-to-region (match-beginning 0)
- (match-end 0))
- (read buf)))
- reads)
- (widen)))
- ;; It was just a simple number, so we add it to the
- ;; list of ranges.
- (push num1 reads))
- ;; If the next char in ?\n, then we have reached the end
- ;; of the line and return nil.
- (not (eq (char-after) ?\n)))
- ((eq (char-after) ?\n)
- ;; End of line, so we end.
- nil)
- (t
- ;; Not numbers and not eol, so this might be a buggy
- ;; line...
- (unless (eobp)
- ;; If it was eob instead of ?\n, we allow it.
- ;; The line was buggy.
- (setq group nil)
- (gnus-error 3.1 "Mangled line: %s"
- (buffer-substring (gnus-point-at-bol)
- (gnus-point-at-eol))))
- nil))
- ;; Skip past ", ". Spaces are invalid in these ranges, but
- ;; we allow them, because it's a common mistake to put a
- ;; space after the comma.
- (skip-chars-forward ", "))
-
- ;; We have already read .newsrc.eld, so we gently update the
- ;; data in the hash table with the information we have just
- ;; read.
- (when group
- (let ((info (gnus-get-info group))
- level)
- (if info
- ;; There is an entry for this file in the alist.
- (progn
- (gnus-info-set-read info (nreverse reads))
- ;; We update the level very gently. In fact, we
- ;; only change it if there's been a status change
- ;; from subscribed to unsubscribed, or vice versa.
- (setq level (gnus-info-level info))
- (cond ((and (<= level gnus-level-subscribed)
- (not subscribed))
- (setq level (if reads
- gnus-level-default-unsubscribed
- (1+ gnus-level-default-unsubscribed))))
- ((and (> level gnus-level-subscribed) subscribed)
- (setq level gnus-level-default-subscribed)))
- (gnus-info-set-level info level))
- ;; This is a new group.
- (setq info (list group
- (if subscribed
- gnus-level-default-subscribed
- (if reads
- (1+ gnus-level-subscribed)
- gnus-level-default-unsubscribed))
- (nreverse reads))))
- (push info newsrc)))))
- (forward-line 1))
-
- (setq newsrc (nreverse newsrc))
-
- (if (not already-read)
- ()
- ;; We now have two newsrc lists - `newsrc', which is what we
- ;; have read from .newsrc, and `gnus-newsrc-alist', which is
- ;; what we've read from .newsrc.eld. We have to merge these
- ;; lists. We do this by "attaching" any (foreign) groups in the
- ;; gnus-newsrc-alist to the (native) group that precedes them.
- (let ((rc (cdr gnus-newsrc-alist))
- (prev gnus-newsrc-alist)
- entry mentry)
- (while rc
- (or (null (nth 4 (car rc))) ; It's a native group.
- (assoc (caar rc) newsrc) ; It's already in the alist.
- (if (setq entry (assoc (caar prev) newsrc))
- (setcdr (setq mentry (memq entry newsrc))
- (cons (car rc) (cdr mentry)))
- (push (car rc) newsrc)))
- (setq prev rc
- rc (cdr rc)))))
-
- (setq gnus-newsrc-alist newsrc)
- ;; We make the newsrc hashtb.
- (gnus-make-hashtable-from-newsrc-alist)
-
- ;; Finally, if we read some options lines, we parse them.
- (unless (string= gnus-newsrc-options "")
- (gnus-newsrc-parse-options gnus-newsrc-options))))
-
-;; Parse options lines to find "options -n !all rec.all" and stuff.
-;; The return value will be a list on the form
-;; ((regexp1 . ignore)
-;; (regexp2 . subscribe)...)
-;; When handling new newsgroups, groups that match a `ignore' regexp
-;; will be ignored, and groups that match a `subscribe' regexp will be
-;; subscribed. A line like
-;; options -n !all rec.all
-;; will lead to a list that looks like
-;; (("^rec\\..+" . subscribe)
-;; ("^.+" . ignore))
-;; So all "rec.*" groups will be subscribed, while all the other
-;; groups will be ignored. Note that "options -n !all rec.all" is very
-;; different from "options -n rec.all !all".
-(defun gnus-newsrc-parse-options (options)
- (let (out eol)
- (save-excursion
- (gnus-set-work-buffer)
- (insert (regexp-quote options))
- ;; First we treat all continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t))
- ;; Then we transform all "all"s into ".+"s.
- (goto-char (point-min))
- (while (re-search-forward "\\ball\\b" nil t)
- (replace-match ".+" t t))
- (goto-char (point-min))
- ;; We remove all other options than the "-n" ones.
- (while (re-search-forward "[ \t]-[^n][^-]*" nil t)
- (replace-match " ")
- (forward-char -1))
- (goto-char (point-min))
-
- ;; We are only interested in "options -n" lines - we
- ;; ignore the other option lines.
- (while (re-search-forward "[ \t]-n" nil t)
- (setq eol
- (or (save-excursion
- (and (re-search-forward "[ \t]-n" (gnus-point-at-eol) t)
- (- (point) 2)))
- (gnus-point-at-eol)))
- ;; Search for all "words"...
- (while (re-search-forward "[^ \t,\n]+" eol t)
- (if (eq (char-after (match-beginning 0)) ?!)
- ;; If the word begins with a bang (!), this is a "not"
- ;; spec. We put this spec (minus the bang) and the
- ;; symbol `ignore' into the list.
- (push (cons (concat
- "^" (buffer-substring
- (1+ (match-beginning 0))
- (match-end 0))
- "\\($\\|\\.\\)")
- 'ignore)
- out)
- ;; There was no bang, so this is a "yes" spec.
- (push (cons (concat "^" (match-string 0) "\\($\\|\\.\\)")
- 'subscribe)
- out))))
-
- (setq gnus-newsrc-options-n out))))
-
-(eval-and-compile
- (defalias 'gnus-long-file-names
- (if (fboundp 'msdos-long-file-names)
- 'msdos-long-file-names
- (lambda () t))))
-
-(defun gnus-save-newsrc-file (&optional force)
- "Save .newsrc file."
- ;; Note: We cannot save .newsrc file if all newsgroups are removed
- ;; from the variable gnus-newsrc-alist.
- (when (and (or gnus-newsrc-alist gnus-killed-list)
- gnus-current-startup-file)
- ;; Save agent range limits for the currently active method.
- (when gnus-agent
- (gnus-agent-save-local force))
-
- (save-excursion
- (if (and (or gnus-use-dribble-file gnus-slave)
- (not force)
- (or (not gnus-dribble-buffer)
- (not (buffer-name gnus-dribble-buffer))
- (zerop (save-excursion
- (set-buffer gnus-dribble-buffer)
- (buffer-size)))))
- (gnus-message 4 "(No changes need to be saved)")
- (gnus-run-hooks 'gnus-save-newsrc-hook)
- (if gnus-slave
- (gnus-slave-save-newsrc)
- ;; Save .newsrc.
- (when gnus-save-newsrc-file
- (gnus-message 8 "Saving %s..." gnus-current-startup-file)
- (gnus-gnus-to-newsrc-format)
- (gnus-message 8 "Saving %s...done" gnus-current-startup-file))
-
- ;; Save .newsrc.eld.
- (set-buffer (gnus-get-buffer-create " *Gnus-newsrc*"))
- (make-local-variable 'version-control)
- (setq version-control gnus-backup-startup-file)
- (setq buffer-file-name
- (concat gnus-current-startup-file ".eld"))
- (setq default-directory (file-name-directory buffer-file-name))
- (buffer-disable-undo)
- (erase-buffer)
- (gnus-message 5 "Saving %s.eld..." gnus-current-startup-file)
-
- (if gnus-save-startup-file-via-temp-buffer
- (let ((coding-system-for-write gnus-ding-file-coding-system)
- (standard-output (current-buffer)))
- (gnus-gnus-to-quick-newsrc-format)
- (gnus-run-hooks 'gnus-save-quick-newsrc-hook)
- (save-buffer))
- (let ((coding-system-for-write gnus-ding-file-coding-system)
- (version-control gnus-backup-startup-file)
- (startup-file (concat gnus-current-startup-file ".eld"))
- (working-dir (file-name-directory gnus-current-startup-file))
- working-file
- (i -1))
- ;; Generate the name of a non-existent file.
- (while (progn (setq working-file
- (format
- (if (and (eq system-type 'ms-dos)
- (not (gnus-long-file-names)))
- "%s#%d.tm#" ; MSDOS limits files to 8+3
- (if (memq system-type '(vax-vms axp-vms))
- "%s$tmp$%d"
- "%s#tmp#%d"))
- working-dir (setq i (1+ i))))
- (file-exists-p working-file)))
-
- (unwind-protect
- (progn
- (gnus-with-output-to-file working-file
- (gnus-gnus-to-quick-newsrc-format)
- (gnus-run-hooks 'gnus-save-quick-newsrc-hook))
-
- ;; These bindings will mislead the current buffer
- ;; into thinking that it is visiting the startup
- ;; file.
- (let ((buffer-backed-up nil)
- (buffer-file-name startup-file)
- (file-precious-flag t)
- (setmodes (file-modes startup-file)))
- ;; Backup the current version of the startup file.
- (backup-buffer)
-
- ;; Replace the existing startup file with the temp file.
- (rename-file working-file startup-file t)
- (set-file-modes startup-file setmodes)))
- (condition-case nil
- (delete-file working-file)
- (file-error nil)))))
-
- (gnus-kill-buffer (current-buffer))
- (gnus-message
- 5 "Saving %s.eld...done" gnus-current-startup-file))
- (gnus-dribble-delete-file)
- (gnus-group-set-mode-line)))))
-
-(defun gnus-gnus-to-quick-newsrc-format (&optional minimal name &rest specific-variables)
- "Print Gnus variables such as `gnus-newsrc-alist' in Lisp format."
- (princ ";; -*- emacs-lisp -*-\n")
- (if name
- (princ (format ";; %s\n" name))
- (princ ";; Gnus startup file.\n"))
-
- (unless minimal
- (princ "\
-;; Never delete this file -- if you want to force Gnus to read the
-;; .newsrc file (if you have one), touch .newsrc instead.\n")
- (princ "(setq gnus-newsrc-file-version ")
- (princ (gnus-prin1-to-string gnus-version))
- (princ ")\n"))
-
- (let* ((print-quoted t)
- (print-readably t)
- (print-escape-multibyte nil)
- (print-escape-nonascii t)
- (print-length nil)
- (print-level nil)
- (print-circle nil)
- (print-escape-newlines t)
- (gnus-killed-list
- (if (and gnus-save-killed-list
- (stringp gnus-save-killed-list))
- (gnus-strip-killed-list)
- gnus-killed-list))
- (variables
- (or specific-variables
- (if gnus-save-killed-list gnus-variable-list
- ;; Remove the `gnus-killed-list' from the list of variables
- ;; to be saved, if required.
- (delq 'gnus-killed-list (copy-sequence gnus-variable-list)))))
- ;; Peel off the "dummy" group.
- (gnus-newsrc-alist (cdr gnus-newsrc-alist))
- variable)
- ;; Insert the variables into the file.
- (while variables
- (when (and (boundp (setq variable (pop variables)))
- (symbol-value variable))
- (princ "(setq ")
- (princ (symbol-name variable))
- (princ " '")
- (prin1 (symbol-value variable))
- (princ ")\n")))))
-
-(defun gnus-strip-killed-list ()
- "Return the killed list minus the groups that match `gnus-save-killed-list'."
- (let ((list gnus-killed-list)
- olist)
- (while list
- (when (string-match gnus-save-killed-list (car list))
- (push (car list) olist))
- (pop list))
- (nreverse olist)))
-
-(defun gnus-gnus-to-newsrc-format ()
- ;; Generate and save the .newsrc file.
- (save-excursion
- (set-buffer (create-file-buffer gnus-current-startup-file))
- (let ((newsrc (cdr gnus-newsrc-alist))
- (standard-output (current-buffer))
- info ranges range method)
- (setq buffer-file-name gnus-current-startup-file)
- (setq default-directory (file-name-directory buffer-file-name))
- (buffer-disable-undo)
- (erase-buffer)
- ;; Write options.
- (when gnus-newsrc-options
- (insert gnus-newsrc-options))
- ;; Write subscribed and unsubscribed.
- (while (setq info (pop newsrc))
- ;; Don't write foreign groups to .newsrc.
- (when (or (null (setq method (gnus-info-method info)))
- (equal method "native")
- (inline (gnus-server-equal method gnus-select-method)))
- (insert (gnus-info-group info)
- (if (> (gnus-info-level info) gnus-level-subscribed)
- "!" ":"))
- (when (setq ranges (gnus-info-read info))
- (insert " ")
- (if (not (listp (cdr ranges)))
- (if (= (car ranges) (cdr ranges))
- (princ (car ranges))
- (princ (car ranges))
- (insert "-")
- (princ (cdr ranges)))
- (while (setq range (pop ranges))
- (if (or (atom range) (= (car range) (cdr range)))
- (princ (or (and (atom range) range) (car range)))
- (princ (car range))
- (insert "-")
- (princ (cdr range)))
- (when ranges
- (insert ",")))))
- (insert "\n")))
- (make-local-variable 'version-control)
- (setq version-control 'never)
- ;; It has been reported that sometime the modtime on the .newsrc
- ;; file seems to be off. We really do want to overwrite it, so
- ;; we clear the modtime here before saving. It's a bit odd,
- ;; though...
- ;; sometimes the modtime clear isn't sufficient. most brute force:
- ;; delete the silly thing entirely first. but this fails to provide
- ;; such niceties as .newsrc~ creation.
- (if gnus-modtime-botch
- (delete-file gnus-startup-file)
- (clear-visited-file-modtime))
- (gnus-run-hooks 'gnus-save-standard-newsrc-hook)
- (save-buffer)
- (kill-buffer (current-buffer)))))
-
-\f
-;;;
-;;; Slave functions.
-;;;
-
-(defvar gnus-slave-mode nil)
-
-(defun gnus-slave-mode ()
- "Minor mode for slave Gnusae."
- (gnus-add-minor-mode 'gnus-slave-mode " Slave" (make-sparse-keymap))
- (gnus-run-hooks 'gnus-slave-mode-hook))
-
-(defun gnus-slave-save-newsrc ()
- (save-excursion
- (set-buffer gnus-dribble-buffer)
- (let ((slave-name
- (mm-make-temp-file (concat gnus-current-startup-file "-slave-")))
- (modes (ignore-errors
- (file-modes (concat gnus-current-startup-file ".eld")))))
- (let ((coding-system-for-write gnus-ding-file-coding-system))
- (gnus-write-buffer slave-name))
- (when modes
- (set-file-modes slave-name modes)))))
-
-(defun gnus-master-read-slave-newsrc ()
- (let ((slave-files
- (directory-files
- (file-name-directory gnus-current-startup-file)
- t (concat
- "^" (regexp-quote
- (concat
- (file-name-nondirectory gnus-current-startup-file)
- "-slave-")))
- t))
- file)
- (if (not slave-files)
- () ; There are no slave files to read.
- (gnus-message 7 "Reading slave newsrcs...")
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *gnus slave*"))
- (setq slave-files
- (sort (mapcar (lambda (file)
- (list (nth 5 (file-attributes file)) file))
- slave-files)
- (lambda (f1 f2)
- (or (< (caar f1) (caar f2))
- (< (nth 1 (car f1)) (nth 1 (car f2)))))))
- (while slave-files
- (erase-buffer)
- (setq file (nth 1 (car slave-files)))
- (nnheader-insert-file-contents file)
- (when (condition-case ()
- (progn
- (eval-buffer (current-buffer))
- t)
- (error
- (gnus-error 3.2 "Possible error in %s" file)
- nil))
- (unless gnus-slave ; Slaves shouldn't delete these files.
- (ignore-errors
- (delete-file file))))
- (setq slave-files (cdr slave-files))))
- (gnus-dribble-touch)
- (gnus-message 7 "Reading slave newsrcs...done"))))
-
-\f
-;;;
-;;; Group description.
-;;;
-
-(defun gnus-read-all-descriptions-files ()
- (let ((methods (cons gnus-select-method
- (nconc
- (when (gnus-archive-server-wanted-p)
- (list "archive"))
- gnus-secondary-select-methods))))
- (while methods
- (gnus-read-descriptions-file (car methods))
- (setq methods (cdr methods)))
- t))
-
-(defun gnus-read-descriptions-file (&optional method)
- (let ((method (or method gnus-select-method))
- group)
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- ;; We create the hashtable whether we manage to read the desc file
- ;; to avoid trying to re-read after a failed read.
- (unless gnus-description-hashtb
- (setq gnus-description-hashtb
- (gnus-make-hashtable (length gnus-active-hashtb))))
- ;; Mark this method's desc file as read.
- (gnus-sethash (gnus-group-prefixed-name "" method) "Has read"
- gnus-description-hashtb)
-
- (gnus-message 5 "Reading descriptions file via %s..." (car method))
- (cond
- ((null (gnus-get-function method 'request-list-newsgroups t))
- t)
- ((not (gnus-check-server method))
- (gnus-message 1 "Couldn't open server")
- nil)
- ((not (gnus-request-list-newsgroups method))
- (gnus-message 1 "Couldn't read newsgroups descriptions")
- nil)
- (t
- (save-excursion
- (save-restriction
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (or (search-forward "\n.\n" nil t)
- (goto-char (point-max)))
- (beginning-of-line)
- (narrow-to-region (point-min) (point)))
- ;; If these are groups from a foreign select method, we insert the
- ;; group prefix in front of the group names.
- (and method (not (inline
- (gnus-server-equal
- (gnus-server-get-method nil method)
- (gnus-server-get-method
- nil gnus-select-method))))
- (let ((prefix (gnus-group-prefixed-name "" method)))
- (goto-char (point-min))
- (while (and (not (eobp))
- (progn (insert prefix)
- (zerop (forward-line 1)))))))
- (goto-char (point-min))
- (while (not (eobp))
- ;; If we get an error, we set group to 0, which is not a
- ;; symbol...
- (setq group
- (condition-case ()
- (let ((obarray gnus-description-hashtb))
- ;; Group is set to a symbol interned in this
- ;; hash table.
- (read nntp-server-buffer))
- (error 0)))
- (skip-chars-forward " \t")
- ;; ... which leads to this line being effectively ignored.
- (when (symbolp group)
- (let* ((str (buffer-substring
- (point) (progn (end-of-line) (point))))
- (name (symbol-name group))
- (charset
- (or (gnus-group-name-charset method name)
- (gnus-parameter-charset name)
- gnus-default-charset)))
- ;; Fixme: Don't decode in unibyte mode.
- (when (and str charset (featurep 'mule))
- (setq str (mm-decode-coding-string str charset)))
- (set group str)))
- (forward-line 1))))
- (gnus-message 5 "Reading descriptions file...done")
- t))))
-
-(defun gnus-group-get-description (group)
- "Get the description of a group by sending XGTITLE to the server."
- (when (gnus-request-group-description group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (looking-at "[^ \t]+[ \t]+\\(.*\\)")
- (match-string 1)))))
-
-;;;###autoload
-(defun gnus-declare-backend (name &rest abilities)
- "Declare back end NAME with ABILITIES as a Gnus back end."
- (setq gnus-valid-select-methods
- (nconc gnus-valid-select-methods
- (list (apply 'list name abilities))))
- (gnus-redefine-select-method-widget))
-
-(defun gnus-set-default-directory ()
- "Set the default directory in the current buffer to `gnus-default-directory'.
-If this variable is nil, don't do anything."
- (setq default-directory
- (if (and gnus-default-directory
- (file-exists-p gnus-default-directory))
- (file-name-as-directory (expand-file-name gnus-default-directory))
- default-directory)))
-
-(defun gnus-display-time-event-handler ()
- (if (and (fboundp 'display-time-event-handler)
- (gnus-boundp 'display-time-timer))
- (display-time-event-handler)))
-
-;;;###autoload
-(defun gnus-fixup-nnimap-unread-after-getting-new-news ()
- (let (server group info)
- (mapatoms
- (lambda (sym)
- (when (and (setq group (symbol-name sym))
- (gnus-group-entry group)
- (setq info (symbol-value sym)))
- (gnus-sethash group (cons (nth 2 info) (cdr (gnus-group-entry group)))
- gnus-newsrc-hashtb)))
- (if (boundp 'nnimap-mailbox-info)
- (symbol-value 'nnimap-mailbox-info)
- (make-vector 1 0)))))
-
-
-(provide 'gnus-start)
-
-;; arch-tag: f4584a22-b7b7-4853-abfc-a637329af5d2
-;;; gnus-start.el ends here
-
-
+++ /dev/null
-;;; gnus-sum.el --- summary mode commands for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (defvar tool-bar-mode))
-
-(require 'gnus)
-(require 'gnus-group)
-(require 'gnus-spec)
-(require 'gnus-range)
-(require 'gnus-int)
-(require 'gnus-undo)
-(require 'gnus-util)
-(require 'gmm-utils)
-(require 'mm-decode)
-(require 'nnoo)
-
-(autoload 'gnus-summary-limit-include-cached "gnus-cache" nil t)
-(autoload 'gnus-cache-write-active "gnus-cache")
-(autoload 'gnus-mailing-list-insinuate "gnus-ml" nil t)
-(autoload 'turn-on-gnus-mailing-list-mode "gnus-ml" nil t)
-(autoload 'gnus-pick-line-number "gnus-salt" nil t)
-(autoload 'mm-uu-dissect "mm-uu")
-(autoload 'gnus-article-outlook-deuglify-article "deuglify"
- "Deuglify broken Outlook (Express) articles and redisplay."
- t)
-(autoload 'gnus-article-outlook-unwrap-lines "deuglify" nil t)
-(autoload 'gnus-article-outlook-repair-attribution "deuglify" nil t)
-(autoload 'gnus-article-outlook-rearrange-citation "deuglify" nil t)
-
-(defun-when-void put-display-table (range value display-table)
- "Set the value for char RANGE to VALUE in DISPLAY-TABLE. "
- (ecase (type-of display-table)
- (vector
- (aset display-table range value))
- (char-table
- (put-char-table range value display-table))))
-
-(defun-when-void get-display-table (character display-table)
- "Find value for CHARACTER in DISPLAY-TABLE. "
- (ecase (type-of display-table)
- (vector
- (aref display-table character))
- (char-table
- (get-char-table character display-table))))
-
-(defcustom gnus-kill-summary-on-exit t
- "*If non-nil, kill the summary buffer when you exit from it.
-If nil, the summary will become a \"*Dead Summary*\" buffer, and
-it will be killed sometime later."
- :group 'gnus-summary-exit
- :type 'boolean)
-
-(defcustom gnus-fetch-old-headers nil
- "*Non-nil means that Gnus will try to build threads by grabbing old headers.
-If an unread article in the group refers to an older, already read (or
-just marked as read) article, the old article will not normally be
-displayed in the Summary buffer. If this variable is t, Gnus
-will attempt to grab the headers to the old articles, and thereby
-build complete threads. If it has the value `some', only enough
-headers to connect otherwise loose threads will be displayed. This
-variable can also be a number. In that case, no more than that number
-of old headers will be fetched. If it has the value `invisible', all
-old headers will be fetched, but none will be displayed.
-
-The server has to support NOV for any of this to work."
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const :tag "on" t)
- (const some)
- (const invisible)
- number
- (sexp :menu-tag "other" t)))
-
-(defcustom gnus-refer-thread-limit 200
- "*The number of old headers to fetch when doing \\<gnus-summary-mode-map>\\[gnus-summary-refer-thread].
-If t, fetch all the available old headers."
- :group 'gnus-thread
- :type '(choice number
- (sexp :menu-tag "other" t)))
-
-(defcustom gnus-summary-make-false-root 'adopt
- "*nil means that Gnus won't gather loose threads.
-If the root of a thread has expired or been read in a previous
-session, the information necessary to build a complete thread has been
-lost. Instead of having many small sub-threads from this original thread
-scattered all over the summary buffer, Gnus can gather them.
-
-If non-nil, Gnus will try to gather all loose sub-threads from an
-original thread into one large thread.
-
-If this variable is non-nil, it should be one of `none', `adopt',
-`dummy' or `empty'.
-
-If this variable is `none', Gnus will not make a false root, but just
-present the sub-threads after another.
-If this variable is `dummy', Gnus will create a dummy root that will
-have all the sub-threads as children.
-If this variable is `adopt', Gnus will make one of the \"children\"
-the parent and mark all the step-children as such.
-If this variable is `empty', the \"children\" are printed with empty
-subject fields. (Or rather, they will be printed with a string
-given by the `gnus-summary-same-subject' variable.)"
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const none)
- (const dummy)
- (const adopt)
- (const empty)))
-
-(defcustom gnus-summary-make-false-root-always nil
- "Always make a false dummy root."
- :version "22.1"
- :group 'gnus-thread
- :type 'boolean)
-
-(defcustom gnus-summary-gather-exclude-subject "^ *$\\|^(none)$"
- "*A regexp to match subjects to be excluded from loose thread gathering.
-As loose thread gathering is done on subjects only, that means that
-there can be many false gatherings performed. By rooting out certain
-common subjects, gathering might become saner."
- :group 'gnus-thread
- :type 'regexp)
-
-(defcustom gnus-summary-gather-subject-limit nil
- "*Maximum length of subject comparisons when gathering loose threads.
-Use nil to compare full subjects. Setting this variable to a low
-number will help gather threads that have been corrupted by
-newsreaders chopping off subject lines, but it might also mean that
-unrelated articles that have subject that happen to begin with the
-same few characters will be incorrectly gathered.
-
-If this variable is `fuzzy', Gnus will use a fuzzy algorithm when
-comparing subjects."
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const fuzzy)
- (sexp :menu-tag "on" t)))
-
-(defcustom gnus-simplify-subject-functions nil
- "List of functions taking a string argument that simplify subjects.
-The functions are applied recursively.
-
-Useful functions to put in this list include:
-`gnus-simplify-subject-re', `gnus-simplify-subject-fuzzy',
-`gnus-simplify-whitespace', and `gnus-simplify-all-whitespace'."
- :group 'gnus-thread
- :type '(repeat function))
-
-(defcustom gnus-simplify-ignored-prefixes nil
- "*Remove matches for this regexp from subject lines when simplifying fuzzily."
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- regexp))
-
-(defcustom gnus-build-sparse-threads nil
- "*If non-nil, fill in the gaps in threads.
-If `some', only fill in the gaps that are needed to tie loose threads
-together. If `more', fill in all leaf nodes that Gnus can find. If
-non-nil and non-`some', fill in all gaps that Gnus manages to guess."
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const some)
- (const more)
- (sexp :menu-tag "all" t)))
-
-(defcustom gnus-summary-thread-gathering-function
- 'gnus-gather-threads-by-subject
- "*Function used for gathering loose threads.
-There are two pre-defined functions: `gnus-gather-threads-by-subject',
-which only takes Subjects into consideration; and
-`gnus-gather-threads-by-references', which compared the References
-headers of the articles to find matches."
- :group 'gnus-thread
- :type '(radio (function-item gnus-gather-threads-by-subject)
- (function-item gnus-gather-threads-by-references)
- (function :tag "other")))
-
-(defcustom gnus-summary-same-subject ""
- "*String indicating that the current article has the same subject as the previous.
-This variable will only be used if the value of
-`gnus-summary-make-false-root' is `empty'."
- :group 'gnus-summary-format
- :type 'string)
-
-(defcustom gnus-summary-goto-unread t
- "*If t, many commands will go to the next unread article.
-This applies to marking commands as well as other commands that
-\"naturally\" select the next article, like, for instance, `SPC' at
-the end of an article.
-
-If nil, the marking commands do NOT go to the next unread article
-\(they go to the next article instead). If `never', commands that
-usually go to the next unread article, will go to the next article,
-whether it is read or not."
- :group 'gnus-summary-marks
- :link '(custom-manual "(gnus)Setting Marks")
- :type '(choice (const :tag "off" nil)
- (const never)
- (sexp :menu-tag "on" t)))
-
-(defcustom gnus-summary-default-score 0
- "*Default article score level.
-All scores generated by the score files will be added to this score.
-If this variable is nil, scoring will be disabled."
- :group 'gnus-score-default
- :type '(choice (const :tag "disable")
- integer))
-
-(defcustom gnus-summary-default-high-score 0
- "*Default threshold for a high scored article.
-An article will be highlighted as high scored if its score is greater
-than this score."
- :version "22.1"
- :group 'gnus-score-default
- :type 'integer)
-
-(defcustom gnus-summary-default-low-score 0
- "*Default threshold for a low scored article.
-An article will be highlighted as low scored if its score is smaller
-than this score."
- :version "22.1"
- :group 'gnus-score-default
- :type 'integer)
-
-(defcustom gnus-summary-zcore-fuzz 0
- "*Fuzziness factor for the zcore in the summary buffer.
-Articles with scores closer than this to `gnus-summary-default-score'
-will not be marked."
- :group 'gnus-summary-format
- :type 'integer)
-
-(defcustom gnus-simplify-subject-fuzzy-regexp nil
- "*Strings to be removed when doing fuzzy matches.
-This can either be a regular expression or list of regular expressions
-that will be removed from subject strings if fuzzy subject
-simplification is selected."
- :group 'gnus-thread
- :type '(repeat regexp))
-
-(defcustom gnus-show-threads t
- "*If non-nil, display threads in summary mode."
- :group 'gnus-thread
- :type 'boolean)
-
-(defcustom gnus-thread-hide-subtree nil
- "*If non-nil, hide all threads initially.
-This can be a predicate specifier which says which threads to hide.
-If threads are hidden, you have to run the command
-`gnus-summary-show-thread' by hand or select an article."
- :group 'gnus-thread
- :type '(radio (sexp :format "Non-nil\n"
- :match (lambda (widget value)
- (not (or (consp value) (functionp value))))
- :value t)
- (const nil)
- (sexp :tag "Predicate specifier")))
-
-(defcustom gnus-thread-hide-killed t
- "*If non-nil, hide killed threads automatically."
- :group 'gnus-thread
- :type 'boolean)
-
-(defcustom gnus-thread-ignore-subject t
- "*If non-nil, which is the default, ignore subjects and do all threading based on the Reference header.
-If nil, articles that have different subjects from their parents will
-start separate threads."
- :group 'gnus-thread
- :type 'boolean)
-
-(defcustom gnus-thread-operation-ignore-subject t
- "*If non-nil, subjects will be ignored when doing thread commands.
-This affects commands like `gnus-summary-kill-thread' and
-`gnus-summary-lower-thread'.
-
-If this variable is nil, articles in the same thread with different
-subjects will not be included in the operation in question. If this
-variable is `fuzzy', only articles that have subjects that are fuzzily
-equal will be included."
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- (const fuzzy)
- (sexp :tag "on" t)))
-
-(defcustom gnus-thread-indent-level 4
- "*Number that says how much each sub-thread should be indented."
- :group 'gnus-thread
- :type 'integer)
-
-(defcustom gnus-auto-extend-newsgroup t
- "*If non-nil, extend newsgroup forward and backward when requested."
- :group 'gnus-summary-choose
- :type 'boolean)
-
-(defcustom gnus-auto-select-first t
- "If non-nil, select an article on group entry.
-An article is selected automatically when entering a group
-e.g. with \\<gnus-group-mode-map>\\[gnus-group-read-group], or via `gnus-summary-next-page' or
-`gnus-summary-catchup-and-goto-next-group'.
-
-Which article is selected is controlled by the variable
-`gnus-auto-select-subject'.
-
-If you want to prevent automatic selection of articles in some
-newsgroups, set the variable to nil in `gnus-select-group-hook'."
- ;; Commands include...
- ;; \\<gnus-group-mode-map>\\[gnus-group-read-group]
- ;; \\<gnus-summary-mode-map>\\[gnus-summary-next-page]
- ;; \\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]
- :group 'gnus-group-select
- :type '(choice (const :tag "none" nil)
- (sexp :menu-tag "first" t)))
-
-(defcustom gnus-auto-select-subject 'unread
- "*Says what subject to place under point when entering a group.
-
-This variable can either be the symbols `first' (place point on the
-first subject), `unread' (place point on the subject line of the first
-unread article), `best' (place point on the subject line of the
-higest-scored article), `unseen' (place point on the subject line of
-the first unseen article), `unseen-or-unread' (place point on the subject
-line of the first unseen article or, if all article have been seen, on the
-subject line of the first unread article), or a function to be called to
-place point on some subject line."
- :version "22.1"
- :group 'gnus-group-select
- :type '(choice (const best)
- (const unread)
- (const first)
- (const unseen)
- (const unseen-or-unread)))
-
-(defcustom gnus-auto-select-next t
- "*If non-nil, offer to go to the next group from the end of the previous.
-If the value is t and the next newsgroup is empty, Gnus will exit
-summary mode and go back to group mode. If the value is neither nil
-nor t, Gnus will select the following unread newsgroup. In
-particular, if the value is the symbol `quietly', the next unread
-newsgroup will be selected without any confirmation, and if it is
-`almost-quietly', the next group will be selected without any
-confirmation if you are located on the last article in the group.
-Finally, if this variable is `slightly-quietly', the `\\<gnus-summary-mode-map>\\[gnus-summary-catchup-and-goto-next-group]' command
-will go to the next group without confirmation."
- :group 'gnus-summary-maneuvering
- :type '(choice (const :tag "off" nil)
- (const quietly)
- (const almost-quietly)
- (const slightly-quietly)
- (sexp :menu-tag "on" t)))
-
-(defcustom gnus-auto-select-same nil
- "*If non-nil, select the next article with the same subject.
-If there are no more articles with the same subject, go to
-the first unread article."
- :group 'gnus-summary-maneuvering
- :type 'boolean)
-
-(defcustom gnus-auto-goto-ignores 'unfetched
- "*Says how to handle unfetched articles when maneuvering.
-
-This variable can either be the symbols nil (maneuver to any
-article), `undownloaded' (maneuvering while unplugged ignores articles
-that have not been fetched), `always-undownloaded' (maneuvering always
-ignores articles that have not been fetched), `unfetched' (maneuvering
-ignores articles whose headers have not been fetched).
-
-NOTE: The list of unfetched articles will always be nil when plugged
-and, when unplugged, a subset of the undownloaded article list."
- :version "22.1"
- :group 'gnus-summary-maneuvering
- :type '(choice (const :tag "None" nil)
- (const :tag "Undownloaded when unplugged" undownloaded)
- (const :tag "Undownloaded" always-undownloaded)
- (const :tag "Unfetched" unfetched)))
-
-(defcustom gnus-summary-check-current nil
- "*If non-nil, consider the current article when moving.
-The \"unread\" movement commands will stay on the same line if the
-current article is unread."
- :group 'gnus-summary-maneuvering
- :type 'boolean)
-
-(defcustom gnus-auto-center-summary t
- "*If non-nil, always center the current summary buffer.
-In particular, if `vertical' do only vertical recentering. If non-nil
-and non-`vertical', do both horizontal and vertical recentering."
- :group 'gnus-summary-maneuvering
- :type '(choice (const :tag "none" nil)
- (const vertical)
- (integer :tag "height")
- (sexp :menu-tag "both" t)))
-
-(defvar gnus-auto-center-group t
- "*If non-nil, always center the group buffer.")
-
-(defcustom gnus-show-all-headers nil
- "*If non-nil, don't hide any headers."
- :group 'gnus-article-hiding
- :group 'gnus-article-headers
- :type 'boolean)
-
-(defcustom gnus-summary-ignore-duplicates nil
- "*If non-nil, ignore articles with identical Message-ID headers."
- :group 'gnus-summary
- :type 'boolean)
-
-(defcustom gnus-single-article-buffer t
- "*If non-nil, display all articles in the same buffer.
-If nil, each group will get its own article buffer."
- :group 'gnus-article-various
- :type 'boolean)
-
-(defcustom gnus-break-pages t
- "*If non-nil, do page breaking on articles.
-The page delimiter is specified by the `gnus-page-delimiter'
-variable."
- :group 'gnus-article-various
- :type 'boolean)
-
-(defcustom gnus-move-split-methods nil
- "*Variable used to suggest where articles are to be moved to.
-It uses the same syntax as the `gnus-split-methods' variable.
-However, whereas `gnus-split-methods' specifies file names as targets,
-this variable specifies group names."
- :group 'gnus-summary-mail
- :type '(repeat (choice (list :value (fun) function)
- (cons :value ("" "") regexp (repeat string))
- (sexp :value nil))))
-
-;; FIXME: Although the custom type is `character' for the following variables,
-;; using multibyte characters (Latin-1, UTF-8) doesn't work. -- rs
-
-(defcustom gnus-unread-mark ? ;Whitespace
- "*Mark used for unread articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-ticked-mark ?!
- "*Mark used for ticked articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-dormant-mark ??
- "*Mark used for dormant articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-del-mark ?r
- "*Mark used for del'd articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-read-mark ?R
- "*Mark used for read articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-expirable-mark ?E
- "*Mark used for expirable articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-killed-mark ?K
- "*Mark used for killed articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-spam-mark ?$
- "*Mark used for spam articles."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-souped-mark ?F
- "*Mark used for souped articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-kill-file-mark ?X
- "*Mark used for articles killed by kill files."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-low-score-mark ?Y
- "*Mark used for articles with a low score."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-catchup-mark ?C
- "*Mark used for articles that are caught up."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-replied-mark ?A
- "*Mark used for articles that have been replied to."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-forwarded-mark ?F
- "*Mark used for articles that have been forwarded."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-recent-mark ?N
- "*Mark used for articles that are recent."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-cached-mark ?*
- "*Mark used for articles that are in the cache."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-saved-mark ?S
- "*Mark used for articles that have been saved."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-unseen-mark ?.
- "*Mark used for articles that haven't been seen."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-no-mark ? ;Whitespace
- "*Mark used for articles that have no other secondary mark."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-ancient-mark ?O
- "*Mark used for ancient articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-sparse-mark ?Q
- "*Mark used for sparsely reffed articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-canceled-mark ?G
- "*Mark used for canceled articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-duplicate-mark ?M
- "*Mark used for duplicate articles."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-undownloaded-mark ?-
- "*Mark used for articles that weren't downloaded."
- :version "22.1"
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-downloaded-mark ?+
- "*Mark used for articles that were downloaded."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-downloadable-mark ?%
- "*Mark used for articles that are to be downloaded."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-unsendable-mark ?=
- "*Mark used for articles that won't be sent."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-score-over-mark ?+
- "*Score mark used for articles with high scores."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-score-below-mark ?-
- "*Score mark used for articles with low scores."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-empty-thread-mark ? ;Whitespace
- "*There is no thread under the article."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-not-empty-thread-mark ?=
- "*There is a thread under the article."
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-view-pseudo-asynchronously nil
- "*If non-nil, Gnus will view pseudo-articles asynchronously."
- :group 'gnus-extract-view
- :type 'boolean)
-
-(defcustom gnus-auto-expirable-marks
- (list gnus-killed-mark gnus-del-mark gnus-catchup-mark
- gnus-low-score-mark gnus-ancient-mark gnus-read-mark
- gnus-souped-mark gnus-duplicate-mark)
- "*The list of marks converted into expiration if a group is auto-expirable."
- :version "21.1"
- :group 'gnus-summary
- :type '(repeat character))
-
-(defcustom gnus-inhibit-user-auto-expire t
- "*If non-nil, user marking commands will not mark an article as expirable, even if the group has auto-expire turned on."
- :version "21.1"
- :group 'gnus-summary
- :type 'boolean)
-
-(defcustom gnus-view-pseudos nil
- "*If `automatic', pseudo-articles will be viewed automatically.
-If `not-confirm', pseudos will be viewed automatically, and the user
-will not be asked to confirm the command."
- :group 'gnus-extract-view
- :type '(choice (const :tag "off" nil)
- (const automatic)
- (const not-confirm)))
-
-(defcustom gnus-view-pseudos-separately t
- "*If non-nil, one pseudo-article will be created for each file to be viewed.
-If nil, all files that use the same viewing command will be given as a
-list of parameters to that command."
- :group 'gnus-extract-view
- :type 'boolean)
-
-(defcustom gnus-insert-pseudo-articles t
- "*If non-nil, insert pseudo-articles when decoding articles."
- :group 'gnus-extract-view
- :type 'boolean)
-
-(defcustom gnus-summary-dummy-line-format
- " %(: :%) %S\n"
- "*The format specification for the dummy roots in the summary buffer.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%S The subject
-
-General format specifiers can also be used.
-See `(gnus)Formatting Variables'."
- :link '(custom-manual "(gnus)Formatting Variables")
- :group 'gnus-threading
- :type 'string)
-
-(defcustom gnus-summary-mode-line-format "Gnus: %g [%A] %Z"
- "*The format specification for the summary mode line.
-It works along the same lines as a normal formatting string,
-with some simple extensions:
-
-%G Group name
-%p Unprefixed group name
-%A Current article number
-%z Current article score
-%V Gnus version
-%U Number of unread articles in the group
-%e Number of unselected articles in the group
-%Z A string with unread/unselected article counts
-%g Shortish group name
-%S Subject of the current article
-%u User-defined spec
-%s Current score file name
-%d Number of dormant articles
-%r Number of articles that have been marked as read in this session
-%E Number of articles expunged by the score files"
- :group 'gnus-summary-format
- :type 'string)
-
-(defcustom gnus-list-identifiers nil
- "Regexp that matches list identifiers to be removed from subject.
-This can also be a list of regexps."
- :version "21.1"
- :group 'gnus-summary-format
- :group 'gnus-article-hiding
- :type '(choice (const :tag "none" nil)
- (regexp :value ".*")
- (repeat :value (".*") regexp)))
-
-(defcustom gnus-summary-mark-below 0
- "*Mark all articles with a score below this variable as read.
-This variable is local to each summary buffer and usually set by the
-score file."
- :group 'gnus-score-default
- :type 'integer)
-
-(defcustom gnus-article-sort-functions '(gnus-article-sort-by-number)
- "*List of functions used for sorting articles in the summary buffer.
-
-Each function takes two articles and returns non-nil if the first
-article should be sorted before the other. If you use more than one
-function, the primary sort function should be the last. You should
-probably always include `gnus-article-sort-by-number' in the list of
-sorting functions -- preferably first. Also note that sorting by date
-is often much slower than sorting by number, and the sorting order is
-very similar. (Sorting by date means sorting by the time the message
-was sent, sorting by number means sorting by arrival time.)
-
-Ready-made functions include `gnus-article-sort-by-number',
-`gnus-article-sort-by-author', `gnus-article-sort-by-subject',
-`gnus-article-sort-by-date', `gnus-article-sort-by-random'
-and `gnus-article-sort-by-score'.
-
-When threading is turned on, the variable `gnus-thread-sort-functions'
-controls how articles are sorted."
- :group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-article-sort-by-number)
- (function-item gnus-article-sort-by-author)
- (function-item gnus-article-sort-by-subject)
- (function-item gnus-article-sort-by-date)
- (function-item gnus-article-sort-by-score)
- (function-item gnus-article-sort-by-random)
- (function :tag "other"))))
-
-(defcustom gnus-thread-sort-functions '(gnus-thread-sort-by-number)
- "*List of functions used for sorting threads in the summary buffer.
-By default, threads are sorted by article number.
-
-Each function takes two threads and returns non-nil if the first
-thread should be sorted before the other. If you use more than one
-function, the primary sort function should be the last. You should
-probably always include `gnus-thread-sort-by-number' in the list of
-sorting functions -- preferably first. Also note that sorting by date
-is often much slower than sorting by number, and the sorting order is
-very similar. (Sorting by date means sorting by the time the message
-was sent, sorting by number means sorting by arrival time.)
-
-Ready-made functions include `gnus-thread-sort-by-number',
-`gnus-thread-sort-by-author', `gnus-thread-sort-by-subject',
-`gnus-thread-sort-by-date', `gnus-thread-sort-by-score',
-`gnus-thread-sort-by-most-recent-number',
-`gnus-thread-sort-by-most-recent-date',
-`gnus-thread-sort-by-random', and
-`gnus-thread-sort-by-total-score' (see `gnus-thread-score-function').
-
-When threading is turned off, the variable
-`gnus-article-sort-functions' controls how articles are sorted."
- :group 'gnus-summary-sort
- :type '(repeat (choice (function-item gnus-thread-sort-by-number)
- (function-item gnus-thread-sort-by-author)
- (function-item gnus-thread-sort-by-subject)
- (function-item gnus-thread-sort-by-date)
- (function-item gnus-thread-sort-by-score)
- (function-item gnus-thread-sort-by-total-score)
- (function-item gnus-thread-sort-by-random)
- (function :tag "other"))))
-
-(defcustom gnus-thread-score-function '+
- "*Function used for calculating the total score of a thread.
-
-The function is called with the scores of the article and each
-subthread and should then return the score of the thread.
-
-Some functions you can use are `+', `max', or `min'."
- :group 'gnus-summary-sort
- :type 'function)
-
-(defcustom gnus-summary-expunge-below nil
- "All articles that have a score less than this variable will be expunged.
-This variable is local to the summary buffers."
- :group 'gnus-score-default
- :type '(choice (const :tag "off" nil)
- integer))
-
-(defcustom gnus-thread-expunge-below nil
- "All threads that have a total score less than this variable will be expunged.
-See `gnus-thread-score-function' for en explanation of what a
-\"thread score\" is.
-
-This variable is local to the summary buffers."
- :group 'gnus-threading
- :group 'gnus-score-default
- :type '(choice (const :tag "off" nil)
- integer))
-
-(defcustom gnus-summary-mode-hook nil
- "*A hook for Gnus summary mode.
-This hook is run before any variables are set in the summary buffer."
- :options '(turn-on-gnus-mailing-list-mode gnus-pick-mode)
- :group 'gnus-summary-various
- :type 'hook)
-
-;; Extracted from gnus-xmas-redefine in order to preserve user settings
-(when (featurep 'xemacs)
- (add-hook 'gnus-summary-mode-hook 'gnus-xmas-summary-menu-add)
- (add-hook 'gnus-summary-mode-hook 'gnus-xmas-setup-summary-toolbar)
- (add-hook 'gnus-summary-mode-hook
- 'gnus-xmas-switch-horizontal-scrollbar-off))
-
-(defcustom gnus-summary-menu-hook nil
- "*Hook run after the creation of the summary mode menu."
- :group 'gnus-summary-visual
- :type 'hook)
-
-(defcustom gnus-summary-exit-hook nil
- "*A hook called on exit from the summary buffer.
-It will be called with point in the group buffer."
- :group 'gnus-summary-exit
- :type 'hook)
-
-(defcustom gnus-summary-prepare-hook nil
- "*A hook called after the summary buffer has been generated.
-If you want to modify the summary buffer, you can use this hook."
- :group 'gnus-summary-various
- :type 'hook)
-
-(defcustom gnus-summary-prepared-hook nil
- "*A hook called as the last thing after the summary buffer has been generated."
- :group 'gnus-summary-various
- :type 'hook)
-
-(defcustom gnus-summary-generate-hook nil
- "*A hook run just before generating the summary buffer.
-This hook is commonly used to customize threading variables and the
-like."
- :group 'gnus-summary-various
- :type 'hook)
-
-(defcustom gnus-select-group-hook nil
- "*A hook called when a newsgroup is selected.
-
-If you'd like to simplify subjects like the
-`gnus-summary-next-same-subject' command does, you can use the
-following hook:
-
- (add-hook gnus-select-group-hook
- (lambda ()
- (mapcar (lambda (header)
- (mail-header-set-subject
- header
- (gnus-simplify-subject
- (mail-header-subject header) 're-only)))
- gnus-newsgroup-headers)))"
- :group 'gnus-group-select
- :type 'hook)
-
-(defcustom gnus-select-article-hook nil
- "*A hook called when an article is selected."
- :group 'gnus-summary-choose
- :options '(gnus-agent-fetch-selected-article)
- :type 'hook)
-
-(defcustom gnus-visual-mark-article-hook
- (list 'gnus-highlight-selected-summary)
- "*Hook run after selecting an article in the summary buffer.
-It is meant to be used for highlighting the article in some way. It
-is not run if `gnus-visual' is nil."
- :group 'gnus-summary-visual
- :type 'hook)
-
-(defcustom gnus-parse-headers-hook nil
- "*A hook called before parsing the headers."
- :group 'gnus-various
- :type 'hook)
-
-(defcustom gnus-exit-group-hook nil
- "*A hook called when exiting summary mode.
-This hook is not called from the non-updating exit commands like `Q'."
- :group 'gnus-various
- :type 'hook)
-
-(defcustom gnus-summary-update-hook
- (list 'gnus-summary-highlight-line)
- "*A hook called when a summary line is changed.
-The hook will not be called if `gnus-visual' is nil.
-
-The default function `gnus-summary-highlight-line' will
-highlight the line according to the `gnus-summary-highlight'
-variable."
- :group 'gnus-summary-visual
- :type 'hook)
-
-(defcustom gnus-mark-article-hook '(gnus-summary-mark-read-and-unread-as-read)
- "*A hook called when an article is selected for the first time.
-The hook is intended to mark an article as read (or unread)
-automatically when it is selected."
- :group 'gnus-summary-choose
- :type 'hook)
-
-(defcustom gnus-group-no-more-groups-hook nil
- "*A hook run when returning to group mode having no more (unread) groups."
- :group 'gnus-group-select
- :type 'hook)
-
-(defcustom gnus-ps-print-hook nil
- "*A hook run before ps-printing something from Gnus."
- :group 'gnus-summary
- :type 'hook)
-
-(defcustom gnus-summary-article-move-hook nil
- "*A hook called after an article is moved, copied, respooled, or crossposted."
- :version "22.1"
- :group 'gnus-summary
- :type 'hook)
-
-(defcustom gnus-summary-article-delete-hook nil
- "*A hook called after an article is deleted."
- :version "22.1"
- :group 'gnus-summary
- :type 'hook)
-
-(defcustom gnus-summary-article-expire-hook nil
- "*A hook called after an article is expired."
- :version "22.1"
- :group 'gnus-summary
- :type 'hook)
-
-(defcustom gnus-summary-display-arrow
- (and (fboundp 'display-graphic-p)
- (display-graphic-p))
- "*If non-nil, display an arrow highlighting the current article."
- :version "22.1"
- :group 'gnus-summary
- :type 'boolean)
-
-(defcustom gnus-summary-selected-face 'gnus-summary-selected
- "Face used for highlighting the current article in the summary buffer."
- :group 'gnus-summary-visual
- :type 'face)
-
-(defvar gnus-tmp-downloaded nil)
-
-(defcustom gnus-summary-highlight
- '(((eq mark gnus-canceled-mark)
- . gnus-summary-cancelled)
- ((and uncached (> score default-high))
- . gnus-summary-high-undownloaded)
- ((and uncached (< score default-low))
- . gnus-summary-low-undownloaded)
- (uncached
- . gnus-summary-normal-undownloaded)
- ((and (> score default-high)
- (or (eq mark gnus-dormant-mark)
- (eq mark gnus-ticked-mark)))
- . gnus-summary-high-ticked)
- ((and (< score default-low)
- (or (eq mark gnus-dormant-mark)
- (eq mark gnus-ticked-mark)))
- . gnus-summary-low-ticked)
- ((or (eq mark gnus-dormant-mark)
- (eq mark gnus-ticked-mark))
- . gnus-summary-normal-ticked)
- ((and (> score default-high) (eq mark gnus-ancient-mark))
- . gnus-summary-high-ancient)
- ((and (< score default-low) (eq mark gnus-ancient-mark))
- . gnus-summary-low-ancient)
- ((eq mark gnus-ancient-mark)
- . gnus-summary-normal-ancient)
- ((and (> score default-high) (eq mark gnus-unread-mark))
- . gnus-summary-high-unread)
- ((and (< score default-low) (eq mark gnus-unread-mark))
- . gnus-summary-low-unread)
- ((eq mark gnus-unread-mark)
- . gnus-summary-normal-unread)
- ((> score default-high)
- . gnus-summary-high-read)
- ((< score default-low)
- . gnus-summary-low-read)
- (t
- . gnus-summary-normal-read))
- "*Controls the highlighting of summary buffer lines.
-
-A list of (FORM . FACE) pairs. When deciding how a particular
-summary line should be displayed, each form is evaluated. The content
-of the face field after the first true form is used. You can change
-how those summary lines are displayed, by editing the face field.
-
-You can use the following variables in the FORM field.
-
-score: The article's score.
-default: The default article score.
-default-high: The default score for high scored articles.
-default-low: The default score for low scored articles.
-below: The score below which articles are automatically marked as read.
-mark: The article's mark.
-uncached: Non-nil if the article is uncached."
- :group 'gnus-summary-visual
- :type '(repeat (cons (sexp :tag "Form" nil)
- face)))
-(put 'gnus-summary-highlight 'risky-local-variable t)
-
-(defcustom gnus-alter-header-function nil
- "Function called to allow alteration of article header structures.
-The function is called with one parameter, the article header vector,
-which it may alter in any way."
- :type '(choice (const :tag "None" nil)
- function)
- :group 'gnus-summary)
-
-(defvar gnus-decode-encoded-word-function 'mail-decode-encoded-word-string
- "Function used to decode a string with encoded words.")
-
-(defvar gnus-decode-encoded-address-function
- 'mail-decode-encoded-address-string
- "Function used to decode addresses with encoded words.")
-
-(defcustom gnus-extra-headers '(To Newsgroups)
- "*Extra headers to parse."
- :version "21.1"
- :group 'gnus-summary
- :type '(repeat symbol))
-
-(defcustom gnus-ignored-from-addresses
- (and user-mail-address
- (not (string= user-mail-address ""))
- (regexp-quote user-mail-address))
- "*Regexp of From headers that may be suppressed in favor of To headers."
- :version "21.1"
- :group 'gnus-summary
- :type 'regexp)
-
-(defcustom gnus-newsgroup-ignored-charsets '(unknown-8bit x-unknown)
- "List of charsets that should be ignored.
-When these charsets are used in the \"charset\" parameter, the
-default charset will be used instead."
- :version "21.1"
- :type '(repeat symbol)
- :group 'gnus-charset)
-
-(defcustom gnus-newsgroup-maximum-articles nil
- "The maximum number of articles a newsgroup.
-If this is a number, old articles in a newsgroup exceeding this number
-are silently ignored. If it is nil, no article is ignored. Note that
-setting this variable to a number might prevent you from reading very
-old articles."
- :group 'gnus-group-select
- :version "22.2"
- :type '(choice (const :tag "No limit" nil)
- integer))
-
-(gnus-define-group-parameter
- ignored-charsets
- :type list
- :function-document
- "Return the ignored charsets of GROUP."
- :variable gnus-group-ignored-charsets-alist
- :variable-default
- '(("alt\\.chinese\\.text" iso-8859-1))
- :variable-document
- "Alist of regexps (to match group names) and charsets that should be ignored.
-When these charsets are used in the \"charset\" parameter, the
-default charset will be used instead."
- :variable-group gnus-charset
- :variable-type '(repeat (cons (regexp :tag "Group")
- (repeat symbol)))
- :parameter-type '(choice :tag "Ignored charsets"
- :value nil
- (repeat (symbol)))
- :parameter-document "\
-List of charsets that should be ignored.
-
-When these charsets are used in the \"charset\" parameter, the
-default charset will be used instead.")
-
-(defcustom gnus-group-highlight-words-alist nil
- "Alist of group regexps and highlight regexps.
-This variable uses the same syntax as `gnus-emphasis-alist'."
- :version "21.1"
- :type '(repeat (cons (regexp :tag "Group")
- (repeat (list (regexp :tag "Highlight regexp")
- (number :tag "Group for entire word" 0)
- (number :tag "Group for displayed part" 0)
- (symbol :tag "Face"
- gnus-emphasis-highlight-words)))))
- :group 'gnus-summary-visual)
-
-(defcustom gnus-summary-show-article-charset-alist
- nil
- "Alist of number and charset.
-The article will be shown with the charset corresponding to the
-numbered argument.
-For example: ((1 . cn-gb-2312) (2 . big5))."
- :version "21.1"
- :type '(repeat (cons (number :tag "Argument" 1)
- (symbol :tag "Charset")))
- :group 'gnus-charset)
-
-(defcustom gnus-preserve-marks t
- "Whether marks are preserved when moving, copying and respooling messages."
- :version "21.1"
- :type 'boolean
- :group 'gnus-summary-marks)
-
-(defcustom gnus-alter-articles-to-read-function nil
- "Function to be called to alter the list of articles to be selected."
- :type '(choice (const nil) function)
- :group 'gnus-summary)
-
-(defcustom gnus-orphan-score nil
- "*All orphans get this score added. Set in the score file."
- :group 'gnus-score-default
- :type '(choice (const nil)
- integer))
-
-(defcustom gnus-summary-save-parts-default-mime "image/.*"
- "*A regexp to match MIME parts when saving multiple parts of a
-message with `gnus-summary-save-parts' (\\<gnus-summary-mode-map>\\[gnus-summary-save-parts]).
-This regexp will be used by default when prompting the user for which
-type of files to save."
- :group 'gnus-summary
- :type 'regexp)
-
-(defcustom gnus-read-all-available-headers nil
- "Whether Gnus should parse all headers made available to it.
-This is mostly relevant for slow back ends where the user may
-wish to widen the summary buffer to include all headers
-that were fetched. Say, for nnultimate groups."
- :version "22.1"
- :group 'gnus-summary
- :type '(choice boolean regexp))
-
-(defcustom gnus-summary-muttprint-program "muttprint"
- "Command (and optional arguments) used to run Muttprint."
- :version "22.1"
- :group 'gnus-summary
- :type 'string)
-
-(defcustom gnus-article-loose-mime nil
- "If non-nil, don't require MIME-Version header.
-Some brain-damaged MUA/MTA, e.g. Lotus Domino 5.0.6 clients, does not
-supply the MIME-Version header or deliberately strip it from the mail.
-Set it to non-nil, Gnus will treat some articles as MIME even if
-the MIME-Version header is missed."
- :version "22.1"
- :type 'boolean
- :group 'gnus-article-mime)
-
-(defcustom gnus-article-emulate-mime t
- "If non-nil, use MIME emulation for uuencode and the like.
-This means that Gnus will search message bodies for text that look
-like uuencoded bits, yEncoded bits, and so on, and present that using
-the normal Gnus MIME machinery."
- :version "22.1"
- :type 'boolean
- :group 'gnus-article-mime)
-
-;;; Internal variables
-
-(defvar gnus-summary-display-cache nil)
-(defvar gnus-article-mime-handles nil)
-(defvar gnus-article-decoded-p nil)
-(defvar gnus-article-charset nil)
-(defvar gnus-article-ignored-charsets nil)
-(defvar gnus-scores-exclude-files nil)
-(defvar gnus-page-broken nil)
-
-(defvar gnus-original-article nil)
-(defvar gnus-article-internal-prepare-hook nil)
-(defvar gnus-newsgroup-process-stack nil)
-
-(defvar gnus-thread-indent-array nil)
-(defvar gnus-thread-indent-array-level gnus-thread-indent-level)
-(defvar gnus-sort-gathered-threads-function 'gnus-thread-sort-by-number
- "Function called to sort the articles within a thread after it has been gathered together.")
-
-(defvar gnus-summary-save-parts-type-history nil)
-(defvar gnus-summary-save-parts-last-directory mm-default-directory)
-
-;; Avoid highlighting in kill files.
-(defvar gnus-summary-inhibit-highlight nil)
-(defvar gnus-newsgroup-selected-overlay nil)
-(defvar gnus-inhibit-limiting nil)
-(defvar gnus-newsgroup-adaptive-score-file nil)
-(defvar gnus-current-score-file nil)
-(defvar gnus-current-move-group nil)
-(defvar gnus-current-copy-group nil)
-(defvar gnus-current-crosspost-group nil)
-(defvar gnus-newsgroup-display nil)
-
-(defvar gnus-newsgroup-dependencies nil)
-(defvar gnus-newsgroup-adaptive nil)
-(defvar gnus-summary-display-article-function nil)
-(defvar gnus-summary-highlight-line-function nil
- "Function called after highlighting a summary line.")
-
-(defvar gnus-summary-line-format-alist
- `((?N ,(macroexpand '(mail-header-number gnus-tmp-header)) ?d)
- (?S ,(macroexpand '(mail-header-subject gnus-tmp-header)) ?s)
- (?s gnus-tmp-subject-or-nil ?s)
- (?n gnus-tmp-name ?s)
- (?A (car (cdr (funcall gnus-extract-address-components gnus-tmp-from)))
- ?s)
- (?a (or (car (funcall gnus-extract-address-components gnus-tmp-from))
- gnus-tmp-from) ?s)
- (?F gnus-tmp-from ?s)
- (?x ,(macroexpand '(mail-header-xref gnus-tmp-header)) ?s)
- (?D ,(macroexpand '(mail-header-date gnus-tmp-header)) ?s)
- (?d (gnus-dd-mmm (mail-header-date gnus-tmp-header)) ?s)
- (?o (gnus-date-iso8601 (mail-header-date gnus-tmp-header)) ?s)
- (?M ,(macroexpand '(mail-header-id gnus-tmp-header)) ?s)
- (?r ,(macroexpand '(mail-header-references gnus-tmp-header)) ?s)
- (?c (or (mail-header-chars gnus-tmp-header) 0) ?d)
- (?k (gnus-summary-line-message-size gnus-tmp-header) ?s)
- (?L gnus-tmp-lines ?s)
- (?O gnus-tmp-downloaded ?c)
- (?I gnus-tmp-indentation ?s)
- (?T (if (= gnus-tmp-level 0) "" (make-string (frame-width) ? )) ?s)
- (?R gnus-tmp-replied ?c)
- (?\[ gnus-tmp-opening-bracket ?c)
- (?\] gnus-tmp-closing-bracket ?c)
- (?\> (make-string gnus-tmp-level ? ) ?s)
- (?\< (make-string (max 0 (- 20 gnus-tmp-level)) ? ) ?s)
- (?i gnus-tmp-score ?d)
- (?z gnus-tmp-score-char ?c)
- (?l (bbb-grouplens-score gnus-tmp-header) ?s)
- (?V (gnus-thread-total-score (and (boundp 'thread) (car thread))) ?d)
- (?U gnus-tmp-unread ?c)
- (?f (gnus-summary-from-or-to-or-newsgroups gnus-tmp-header gnus-tmp-from)
- ?s)
- (?t (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level)
- ?d)
- (?e (gnus-summary-number-of-articles-in-thread
- (and (boundp 'thread) (car thread)) gnus-tmp-level t)
- ?c)
- (?u gnus-tmp-user-defined ?s)
- (?P (gnus-pick-line-number) ?d)
- (?B gnus-tmp-thread-tree-header-string ?s)
- (user-date (gnus-user-date
- ,(macroexpand '(mail-header-date gnus-tmp-header))) ?s))
- "An alist of format specifications that can appear in summary lines.
-These are paired with what variables they correspond with, along with
-the type of the variable (string, integer, character, etc).")
-
-(defvar gnus-summary-dummy-line-format-alist
- `((?S gnus-tmp-subject ?s)
- (?N gnus-tmp-number ?d)
- (?u gnus-tmp-user-defined ?s)))
-
-(defvar gnus-summary-mode-line-format-alist
- `((?G gnus-tmp-group-name ?s)
- (?g (gnus-short-group-name gnus-tmp-group-name) ?s)
- (?p (gnus-group-real-name gnus-tmp-group-name) ?s)
- (?A gnus-tmp-article-number ?d)
- (?Z gnus-tmp-unread-and-unselected ?s)
- (?V gnus-version ?s)
- (?U gnus-tmp-unread-and-unticked ?d)
- (?S gnus-tmp-subject ?s)
- (?e gnus-tmp-unselected ?d)
- (?u gnus-tmp-user-defined ?s)
- (?d (length gnus-newsgroup-dormant) ?d)
- (?t (length gnus-newsgroup-marked) ?d)
- (?h (length gnus-newsgroup-spam-marked) ?d)
- (?r (length gnus-newsgroup-reads) ?d)
- (?z (gnus-summary-article-score gnus-tmp-article-number) ?d)
- (?E gnus-newsgroup-expunged-tally ?d)
- (?s (gnus-current-score-file-nondirectory) ?s)))
-
-(defvar gnus-last-search-regexp nil
- "Default regexp for article search command.")
-
-(defvar gnus-last-shell-command nil
- "Default shell command on article.")
-
-(defvar gnus-newsgroup-agentized nil
- "Locally bound in each summary buffer to indicate whether the server has been agentized.")
-(defvar gnus-newsgroup-begin nil)
-(defvar gnus-newsgroup-end nil)
-(defvar gnus-newsgroup-last-rmail nil)
-(defvar gnus-newsgroup-last-mail nil)
-(defvar gnus-newsgroup-last-folder nil)
-(defvar gnus-newsgroup-last-file nil)
-(defvar gnus-newsgroup-last-directory nil)
-(defvar gnus-newsgroup-auto-expire nil)
-(defvar gnus-newsgroup-active nil)
-
-(defvar gnus-newsgroup-data nil)
-(defvar gnus-newsgroup-data-reverse nil)
-(defvar gnus-newsgroup-limit nil)
-(defvar gnus-newsgroup-limits nil)
-(defvar gnus-summary-use-undownloaded-faces nil)
-
-(defvar gnus-newsgroup-unreads nil
- "Sorted list of unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-unselected nil
- "Sorted list of unselected unread articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-reads nil
- "Alist of read articles and article marks in the current newsgroup.")
-
-(defvar gnus-newsgroup-expunged-tally nil)
-
-(defvar gnus-newsgroup-marked nil
- "Sorted list of ticked articles in the current newsgroup (a subset of unread art).")
-
-(defvar gnus-newsgroup-spam-marked nil
- "List of ranges of articles that have been marked as spam.")
-
-(defvar gnus-newsgroup-killed nil
- "List of ranges of articles that have been through the scoring process.")
-
-(defvar gnus-newsgroup-cached nil
- "Sorted list of articles that come from the article cache.")
-
-(defvar gnus-newsgroup-saved nil
- "List of articles that have been saved.")
-
-(defvar gnus-newsgroup-kill-headers nil)
-
-(defvar gnus-newsgroup-replied nil
- "List of articles that have been replied to in the current newsgroup.")
-
-(defvar gnus-newsgroup-forwarded nil
- "List of articles that have been forwarded in the current newsgroup.")
-
-(defvar gnus-newsgroup-recent nil
- "List of articles that have are recent in the current newsgroup.")
-
-(defvar gnus-newsgroup-expirable nil
- "Sorted list of articles in the current newsgroup that can be expired.")
-
-(defvar gnus-newsgroup-processable nil
- "List of articles in the current newsgroup that can be processed.")
-
-(defvar gnus-newsgroup-downloadable nil
- "Sorted list of articles in the current newsgroup that can be processed.")
-
-(defvar gnus-newsgroup-unfetched nil
- "Sorted list of articles in the current newsgroup whose headers have
-not been fetched into the agent.
-
-This list will always be a subset of gnus-newsgroup-undownloaded.")
-
-(defvar gnus-newsgroup-undownloaded nil
- "List of articles in the current newsgroup that haven't been downloaded.")
-
-(defvar gnus-newsgroup-unsendable nil
- "List of articles in the current newsgroup that won't be sent.")
-
-(defvar gnus-newsgroup-bookmarks nil
- "List of articles in the current newsgroup that have bookmarks.")
-
-(defvar gnus-newsgroup-dormant nil
- "Sorted list of dormant articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-unseen nil
- "List of unseen articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-seen nil
- "Range of seen articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-articles nil
- "List of articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-scored nil
- "List of scored articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-headers nil
- "List of article headers in the current newsgroup.")
-
-(defvar gnus-newsgroup-threads nil)
-
-(defvar gnus-newsgroup-prepared nil
- "Whether the current group has been prepared properly.")
-
-(defvar gnus-newsgroup-ancient nil
- "List of `gnus-fetch-old-headers' articles in the current newsgroup.")
-
-(defvar gnus-newsgroup-sparse nil)
-
-(defvar gnus-current-article nil)
-(defvar gnus-article-current nil)
-(defvar gnus-current-headers nil)
-(defvar gnus-have-all-headers nil)
-(defvar gnus-last-article nil)
-(defvar gnus-newsgroup-history nil)
-(defvar gnus-newsgroup-charset nil)
-(defvar gnus-newsgroup-ephemeral-charset nil)
-(defvar gnus-newsgroup-ephemeral-ignored-charsets nil)
-
-(defvar gnus-article-before-search nil)
-
-(defvar gnus-summary-local-variables
- '(gnus-newsgroup-name
- gnus-newsgroup-begin gnus-newsgroup-end
- gnus-newsgroup-last-rmail gnus-newsgroup-last-mail
- gnus-newsgroup-last-folder gnus-newsgroup-last-file
- gnus-newsgroup-last-directory
- gnus-newsgroup-auto-expire gnus-newsgroup-unreads
- gnus-newsgroup-unselected gnus-newsgroup-marked
- gnus-newsgroup-spam-marked
- gnus-newsgroup-reads gnus-newsgroup-saved
- gnus-newsgroup-replied gnus-newsgroup-forwarded
- gnus-newsgroup-recent
- gnus-newsgroup-expirable
- gnus-newsgroup-processable gnus-newsgroup-killed
- gnus-newsgroup-downloadable gnus-newsgroup-undownloaded
- gnus-newsgroup-unfetched
- gnus-newsgroup-unsendable gnus-newsgroup-unseen
- gnus-newsgroup-seen gnus-newsgroup-articles
- gnus-newsgroup-bookmarks gnus-newsgroup-dormant
- gnus-newsgroup-headers gnus-newsgroup-threads
- gnus-newsgroup-prepared gnus-summary-highlight-line-function
- gnus-current-article gnus-current-headers gnus-have-all-headers
- gnus-last-article gnus-article-internal-prepare-hook
- gnus-newsgroup-dependencies gnus-newsgroup-selected-overlay
- gnus-newsgroup-scored gnus-newsgroup-kill-headers
- gnus-thread-expunge-below
- gnus-score-alist gnus-current-score-file
- (gnus-summary-expunge-below . global)
- (gnus-summary-mark-below . global)
- (gnus-orphan-score . global)
- gnus-newsgroup-active gnus-scores-exclude-files
- gnus-newsgroup-history gnus-newsgroup-ancient
- gnus-newsgroup-sparse gnus-newsgroup-process-stack
- (gnus-newsgroup-adaptive . gnus-use-adaptive-scoring)
- gnus-newsgroup-adaptive-score-file (gnus-reffed-article-number . -1)
- (gnus-newsgroup-expunged-tally . 0)
- gnus-cache-removable-articles gnus-newsgroup-cached
- gnus-newsgroup-data gnus-newsgroup-data-reverse
- gnus-newsgroup-limit gnus-newsgroup-limits
- gnus-newsgroup-charset gnus-newsgroup-display
- gnus-summary-use-undownloaded-faces)
- "Variables that are buffer-local to the summary buffers.")
-
-(defvar gnus-newsgroup-variables nil
- "A list of variables that have separate values in different newsgroups.
-A list of newsgroup (summary buffer) local variables, or cons of
-variables and their default expressions to be evalled (when the default
-values are not nil), that should be made global while the summary buffer
-is active.
-
-Note: The default expressions will be evaluated (using function `eval')
-before assignment to the local variable rather than just assigned to it.
-If the default expression is the symbol `global', that symbol will not
-be evaluated but the global value of the local variable will be used
-instead.
-
-These variables can be used to set variables in the group parameters
-while still allowing them to affect operations done in other buffers.
-For example:
-
-\(setq gnus-newsgroup-variables
- '(message-use-followup-to
- (gnus-visible-headers .
- \"^From:\\\\|^Newsgroups:\\\\|^Subject:\\\\|^Date:\\\\|^To:\")))
-")
-
-;; Byte-compiler warning.
-(eval-when-compile
- ;; Bind features so that require will believe that gnus-sum has
- ;; already been loaded (avoids infinite recursion)
- (let ((features (cons 'gnus-sum features)))
- ;; Several of the declarations in gnus-sum are needed to load the
- ;; following files. Right now, these definitions have been
- ;; compiled but not defined (evaluated). We could either do a
- ;; eval-and-compile about all of the declarations or evaluate the
- ;; source file.
- (if (boundp 'gnus-newsgroup-variables)
- nil
- (load "gnus-sum.el" t t t))
- (require 'gnus)
- (require 'gnus-agent)
- (require 'gnus-art)))
-
-;; MIME stuff.
-
-(defvar gnus-decode-encoded-word-methods
- '(mail-decode-encoded-word-string)
- "List of methods used to decode encoded words.
-
-This variable is a list of FUNCTION or (REGEXP . FUNCTION). If item
-is FUNCTION, FUNCTION will be apply to all newsgroups. If item is a
-\(REGEXP . FUNCTION), FUNCTION will be only apply to thes newsgroups
-whose names match REGEXP.
-
-For example:
-\((\"chinese\" . gnus-decode-encoded-word-string-by-guess)
- mail-decode-encoded-word-string
- (\"chinese\" . rfc1843-decode-string))")
-
-(defvar gnus-decode-encoded-word-methods-cache nil)
-
-(defun gnus-multi-decode-encoded-word-string (string)
- "Apply the functions from `gnus-encoded-word-methods' that match."
- (unless (and gnus-decode-encoded-word-methods-cache
- (eq gnus-newsgroup-name
- (car gnus-decode-encoded-word-methods-cache)))
- (setq gnus-decode-encoded-word-methods-cache (list gnus-newsgroup-name))
- (mapcar (lambda (x)
- (if (symbolp x)
- (nconc gnus-decode-encoded-word-methods-cache (list x))
- (if (and gnus-newsgroup-name
- (string-match (car x) gnus-newsgroup-name))
- (nconc gnus-decode-encoded-word-methods-cache
- (list (cdr x))))))
- gnus-decode-encoded-word-methods))
- (let ((xlist gnus-decode-encoded-word-methods-cache))
- (pop xlist)
- (while xlist
- (setq string (funcall (pop xlist) string))))
- string)
-
-;; Subject simplification.
-
-(defun gnus-simplify-whitespace (str)
- "Remove excessive whitespace from STR."
- ;; Multiple spaces.
- (while (string-match "[ \t][ \t]+" str)
- (setq str (concat (substring str 0 (match-beginning 0))
- " "
- (substring str (match-end 0)))))
- ;; Leading spaces.
- (when (string-match "^[ \t]+" str)
- (setq str (substring str (match-end 0))))
- ;; Trailing spaces.
- (when (string-match "[ \t]+$" str)
- (setq str (substring str 0 (match-beginning 0))))
- str)
-
-(defun gnus-simplify-all-whitespace (str)
- "Remove all whitespace from STR."
- (while (string-match "[ \t\n]+" str)
- (setq str (replace-match "" nil nil str)))
- str)
-
-(defsubst gnus-simplify-subject-re (subject)
- "Remove \"Re:\" from subject lines."
- (if (string-match message-subject-re-regexp subject)
- (substring subject (match-end 0))
- subject))
-
-(defun gnus-simplify-subject (subject &optional re-only)
- "Remove `Re:' and words in parentheses.
-If RE-ONLY is non-nil, strip leading `Re:'s only."
- (let ((case-fold-search t)) ;Ignore case.
- ;; Remove `Re:', `Re^N:', `Re(n)', and `Re[n]:'.
- (when (string-match "\\`\\(re\\([[(^][0-9]+[])]?\\)?:[ \t]*\\)+" subject)
- (setq subject (substring subject (match-end 0))))
- ;; Remove uninteresting prefixes.
- (when (and (not re-only)
- gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
- ;; Remove words in parentheses from end.
- (unless re-only
- (while (string-match "[ \t\n]*([^()]*)[ \t\n]*\\'" subject)
- (setq subject (substring subject 0 (match-beginning 0)))))
- ;; Return subject string.
- subject))
-
-;; Remove any leading "re:"s, any trailing paren phrases, and simplify
-;; all whitespace.
-(defsubst gnus-simplify-buffer-fuzzy-step (regexp &optional newtext)
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match (or newtext ""))))
-
-(defun gnus-simplify-buffer-fuzzy ()
- "Simplify string in the buffer fuzzily.
-The string in the accessible portion of the current buffer is simplified.
-It is assumed to be a single-line subject.
-Whitespace is generally cleaned up, and miscellaneous leading/trailing
-matter is removed. Additional things can be deleted by setting
-`gnus-simplify-subject-fuzzy-regexp'."
- (let ((case-fold-search t)
- (modified-tick))
- (gnus-simplify-buffer-fuzzy-step "\t" " ")
-
- (while (not (eq modified-tick (buffer-modified-tick)))
- (setq modified-tick (buffer-modified-tick))
- (cond
- ((listp gnus-simplify-subject-fuzzy-regexp)
- (mapcar 'gnus-simplify-buffer-fuzzy-step
- gnus-simplify-subject-fuzzy-regexp))
- (gnus-simplify-subject-fuzzy-regexp
- (gnus-simplify-buffer-fuzzy-step gnus-simplify-subject-fuzzy-regexp)))
- (gnus-simplify-buffer-fuzzy-step "^ *\\[[-+?*!][-+?*!]\\] *")
- (gnus-simplify-buffer-fuzzy-step
- "^ *\\(re\\|fw\\|fwd\\)[[{(^0-9]*[])}]?[:;] *")
- (gnus-simplify-buffer-fuzzy-step "^[[].*:\\( .*\\)[]]$" "\\1"))
-
- (gnus-simplify-buffer-fuzzy-step " *[[{(][^()\n]*[]})] *$")
- (gnus-simplify-buffer-fuzzy-step " +" " ")
- (gnus-simplify-buffer-fuzzy-step " $")
- (gnus-simplify-buffer-fuzzy-step "^ +")))
-
-(defun gnus-simplify-subject-fuzzy (subject)
- "Simplify a subject string fuzzily.
-See `gnus-simplify-buffer-fuzzy' for details."
- (save-excursion
- (gnus-set-work-buffer)
- (let ((case-fold-search t))
- ;; Remove uninteresting prefixes.
- (when (and gnus-simplify-ignored-prefixes
- (string-match gnus-simplify-ignored-prefixes subject))
- (setq subject (substring subject (match-end 0))))
- (insert subject)
- (inline (gnus-simplify-buffer-fuzzy))
- (buffer-string))))
-
-(defsubst gnus-simplify-subject-fully (subject)
- "Simplify a subject string according to `gnus-summary-gather-subject-limit'."
- (cond
- (gnus-simplify-subject-functions
- (gnus-map-function gnus-simplify-subject-functions subject))
- ((null gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-re subject))
- ((eq gnus-summary-gather-subject-limit 'fuzzy)
- (gnus-simplify-subject-fuzzy subject))
- ((numberp gnus-summary-gather-subject-limit)
- (gnus-limit-string (gnus-simplify-subject-re subject)
- gnus-summary-gather-subject-limit))
- (t
- subject)))
-
-(defsubst gnus-subject-equal (s1 s2 &optional simple-first)
- "Check whether two subjects are equal.
-If optional argument SIMPLE-FIRST is t, first argument is already
-simplified."
- (cond
- ((null simple-first)
- (equal (gnus-simplify-subject-fully s1)
- (gnus-simplify-subject-fully s2)))
- (t
- (equal s1
- (gnus-simplify-subject-fully s2)))))
-
-(defun gnus-summary-bubble-group ()
- "Increase the score of the current group.
-This is a handy function to add to `gnus-summary-exit-hook' to
-increase the score of each group you read."
- (gnus-group-add-score gnus-newsgroup-name))
-
-\f
-;;;
-;;; Gnus summary mode
-;;;
-
-(put 'gnus-summary-mode 'mode-class 'special)
-
-(defvar gnus-article-commands-menu)
-
-;; Non-orthogonal keys
-
-(gnus-define-keys gnus-summary-mode-map
- " " gnus-summary-next-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- [backspace] gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\M-\C-n" gnus-summary-next-same-subject
- "\M-\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "." gnus-summary-first-unread-article
- "," gnus-summary-best-unread-article
- "\M-s" gnus-summary-search-article-forward
- "\M-r" gnus-summary-search-article-backward
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "j" gnus-summary-goto-article
- "^" gnus-summary-refer-parent-article
- "\M-^" gnus-summary-refer-article
- "u" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "U" gnus-summary-tick-article-backward
- "d" gnus-summary-mark-as-read-forward
- "D" gnus-summary-mark-as-read-backward
- "E" gnus-summary-mark-as-expirable
- "\M-u" gnus-summary-clear-mark-forward
- "\M-U" gnus-summary-clear-mark-backward
- "k" gnus-summary-kill-same-subject-and-select
- "\C-k" gnus-summary-kill-same-subject
- "\M-\C-k" gnus-summary-kill-thread
- "\M-\C-l" gnus-summary-lower-thread
- "e" gnus-summary-edit-article
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "\M-\C-t" gnus-summary-toggle-threads
- "\M-\C-s" gnus-summary-show-thread
- "\M-\C-h" gnus-summary-hide-thread
- "\M-\C-f" gnus-summary-next-thread
- "\M-\C-b" gnus-summary-prev-thread
- [(meta down)] gnus-summary-next-thread
- [(meta up)] gnus-summary-prev-thread
- "\M-\C-u" gnus-summary-up-thread
- "\M-\C-d" gnus-summary-down-thread
- "&" gnus-summary-execute-command
- "c" gnus-summary-catchup-and-exit
- "\C-w" gnus-summary-mark-region-as-read
- "\C-t" gnus-summary-toggle-truncation
- "?" gnus-summary-mark-as-dormant
- "\C-c\M-\C-s" gnus-summary-limit-include-expunged
- "\C-c\C-s\C-n" gnus-summary-sort-by-number
- "\C-c\C-s\C-l" gnus-summary-sort-by-lines
- "\C-c\C-s\C-c" gnus-summary-sort-by-chars
- "\C-c\C-s\C-a" gnus-summary-sort-by-author
- "\C-c\C-s\C-s" gnus-summary-sort-by-subject
- "\C-c\C-s\C-d" gnus-summary-sort-by-date
- "\C-c\C-s\C-i" gnus-summary-sort-by-score
- "\C-c\C-s\C-o" gnus-summary-sort-by-original
- "\C-c\C-s\C-r" gnus-summary-sort-by-random
- "=" gnus-summary-expand-window
- "\C-x\C-s" gnus-summary-reselect-current-group
- "\M-g" gnus-summary-rescan-group
- "w" gnus-summary-stop-page-breaking
- "\C-c\C-r" gnus-summary-caesar-message
- "f" gnus-summary-followup
- "F" gnus-summary-followup-with-original
- "C" gnus-summary-cancel-article
- "r" gnus-summary-reply
- "R" gnus-summary-reply-with-original
- "\C-c\C-f" gnus-summary-mail-forward
- "o" gnus-summary-save-article
- "\C-o" gnus-summary-save-article-mail
- "|" gnus-summary-pipe-output
- "\M-k" gnus-summary-edit-local-kill
- "\M-K" gnus-summary-edit-global-kill
- ;; "V" gnus-version
- "\C-c\C-d" gnus-summary-describe-group
- "q" gnus-summary-exit
- "Q" gnus-summary-exit-no-update
- "\C-c\C-i" gnus-info-find-node
- gnus-mouse-2 gnus-mouse-pick-article
- [follow-link] mouse-face
- "m" gnus-summary-mail-other-window
- "a" gnus-summary-post-news
- "i" gnus-summary-news-other-window
- "x" gnus-summary-limit-to-unread
- "s" gnus-summary-isearch-article
- "t" gnus-summary-toggle-header
- "g" gnus-summary-show-article
- "l" gnus-summary-goto-last-article
- "\C-c\C-v\C-v" gnus-uu-decode-uu-view
- "\C-d" gnus-summary-enter-digest-group
- "\M-\C-d" gnus-summary-read-document
- "\M-\C-e" gnus-summary-edit-parameters
- "\M-\C-a" gnus-summary-customize-parameters
- "\C-c\C-b" gnus-bug
- "*" gnus-cache-enter-article
- "\M-*" gnus-cache-remove-article
- "\M-&" gnus-summary-universal-argument
- "\C-l" gnus-recenter
- "I" gnus-summary-increase-score
- "L" gnus-summary-lower-score
- "\M-i" gnus-symbolic-argument
- "h" gnus-summary-select-article-buffer
-
- "b" gnus-article-view-part
- "\M-t" gnus-summary-toggle-display-buttonized
-
- "V" gnus-summary-score-map
- "X" gnus-uu-extract-map
- "S" gnus-summary-send-map)
-
-;; Sort of orthogonal keymap
-(gnus-define-keys (gnus-summary-mark-map "M" gnus-summary-mode-map)
- "t" gnus-summary-tick-article-forward
- "!" gnus-summary-tick-article-forward
- "d" gnus-summary-mark-as-read-forward
- "r" gnus-summary-mark-as-read-forward
- "c" gnus-summary-clear-mark-forward
- " " gnus-summary-clear-mark-forward
- "e" gnus-summary-mark-as-expirable
- "x" gnus-summary-mark-as-expirable
- "?" gnus-summary-mark-as-dormant
- "b" gnus-summary-set-bookmark
- "B" gnus-summary-remove-bookmark
- "#" gnus-summary-mark-as-processable
- "\M-#" gnus-summary-unmark-as-processable
- "S" gnus-summary-limit-include-expunged
- "C" gnus-summary-catchup
- "H" gnus-summary-catchup-to-here
- "h" gnus-summary-catchup-from-here
- "\C-c" gnus-summary-catchup-all
- "k" gnus-summary-kill-same-subject-and-select
- "K" gnus-summary-kill-same-subject
- "P" gnus-uu-mark-map)
-
-(gnus-define-keys (gnus-summary-mscore-map "V" gnus-summary-mark-map)
- "c" gnus-summary-clear-above
- "u" gnus-summary-tick-above
- "m" gnus-summary-mark-above
- "k" gnus-summary-kill-below)
-
-(gnus-define-keys (gnus-summary-limit-map "/" gnus-summary-mode-map)
- "/" gnus-summary-limit-to-subject
- "n" gnus-summary-limit-to-articles
- "w" gnus-summary-pop-limit
- "s" gnus-summary-limit-to-subject
- "a" gnus-summary-limit-to-author
- "u" gnus-summary-limit-to-unread
- "m" gnus-summary-limit-to-marks
- "M" gnus-summary-limit-exclude-marks
- "v" gnus-summary-limit-to-score
- "*" gnus-summary-limit-include-cached
- "D" gnus-summary-limit-include-dormant
- "T" gnus-summary-limit-include-thread
- "d" gnus-summary-limit-exclude-dormant
- "t" gnus-summary-limit-to-age
- "." gnus-summary-limit-to-unseen
- "x" gnus-summary-limit-to-extra
- "p" gnus-summary-limit-to-display-predicate
- "E" gnus-summary-limit-include-expunged
- "c" gnus-summary-limit-exclude-childless-dormant
- "C" gnus-summary-limit-mark-excluded-as-read
- "o" gnus-summary-insert-old-articles
- "N" gnus-summary-insert-new-articles)
-
-(gnus-define-keys (gnus-summary-goto-map "G" gnus-summary-mode-map)
- "n" gnus-summary-next-unread-article
- "p" gnus-summary-prev-unread-article
- "N" gnus-summary-next-article
- "P" gnus-summary-prev-article
- "\C-n" gnus-summary-next-same-subject
- "\C-p" gnus-summary-prev-same-subject
- "\M-n" gnus-summary-next-unread-subject
- "\M-p" gnus-summary-prev-unread-subject
- "f" gnus-summary-first-unread-article
- "b" gnus-summary-best-unread-article
- "j" gnus-summary-goto-article
- "g" gnus-summary-goto-subject
- "l" gnus-summary-goto-last-article
- "o" gnus-summary-pop-article)
-
-(gnus-define-keys (gnus-summary-thread-map "T" gnus-summary-mode-map)
- "k" gnus-summary-kill-thread
- "l" gnus-summary-lower-thread
- "i" gnus-summary-raise-thread
- "T" gnus-summary-toggle-threads
- "t" gnus-summary-rethread-current
- "^" gnus-summary-reparent-thread
- "s" gnus-summary-show-thread
- "S" gnus-summary-show-all-threads
- "h" gnus-summary-hide-thread
- "H" gnus-summary-hide-all-threads
- "n" gnus-summary-next-thread
- "p" gnus-summary-prev-thread
- "u" gnus-summary-up-thread
- "o" gnus-summary-top-thread
- "d" gnus-summary-down-thread
- "#" gnus-uu-mark-thread
- "\M-#" gnus-uu-unmark-thread)
-
-(gnus-define-keys (gnus-summary-buffer-map "Y" gnus-summary-mode-map)
- "g" gnus-summary-prepare
- "c" gnus-summary-insert-cached-articles
- "d" gnus-summary-insert-dormant-articles)
-
-(gnus-define-keys (gnus-summary-exit-map "Z" gnus-summary-mode-map)
- "c" gnus-summary-catchup-and-exit
- "C" gnus-summary-catchup-all-and-exit
- "E" gnus-summary-exit-no-update
- "Q" gnus-summary-exit
- "Z" gnus-summary-exit
- "n" gnus-summary-catchup-and-goto-next-group
- "R" gnus-summary-reselect-current-group
- "G" gnus-summary-rescan-group
- "N" gnus-summary-next-group
- "s" gnus-summary-save-newsrc
- "P" gnus-summary-prev-group)
-
-(gnus-define-keys (gnus-summary-article-map "A" gnus-summary-mode-map)
- " " gnus-summary-next-page
- "n" gnus-summary-next-page
- "\177" gnus-summary-prev-page
- [delete] gnus-summary-prev-page
- "p" gnus-summary-prev-page
- "\r" gnus-summary-scroll-up
- "\M-\r" gnus-summary-scroll-down
- "<" gnus-summary-beginning-of-article
- ">" gnus-summary-end-of-article
- "b" gnus-summary-beginning-of-article
- "e" gnus-summary-end-of-article
- "^" gnus-summary-refer-parent-article
- "r" gnus-summary-refer-parent-article
- "D" gnus-summary-enter-digest-group
- "R" gnus-summary-refer-references
- "T" gnus-summary-refer-thread
- "g" gnus-summary-show-article
- "s" gnus-summary-isearch-article
- "P" gnus-summary-print-article
- "M" gnus-mailing-list-insinuate
- "t" gnus-article-babel)
-
-(gnus-define-keys (gnus-summary-wash-map "W" gnus-summary-mode-map)
- "b" gnus-article-add-buttons
- "B" gnus-article-add-buttons-to-head
- "o" gnus-article-treat-overstrike
- "e" gnus-article-emphasize
- "w" gnus-article-fill-cited-article
- "Q" gnus-article-fill-long-lines
- "C" gnus-article-capitalize-sentences
- "c" gnus-article-remove-cr
- "q" gnus-article-de-quoted-unreadable
- "6" gnus-article-de-base64-unreadable
- "Z" gnus-article-decode-HZ
- "h" gnus-article-wash-html
- "u" gnus-article-unsplit-urls
- "s" gnus-summary-force-verify-and-decrypt
- "f" gnus-article-display-x-face
- "l" gnus-summary-stop-page-breaking
- "r" gnus-summary-caesar-message
- "m" gnus-summary-morse-message
- "t" gnus-summary-toggle-header
- "g" gnus-treat-smiley
- "v" gnus-summary-verbose-headers
- "a" gnus-article-strip-headers-in-body ;; mnemonic: wash archive
- "p" gnus-article-verify-x-pgp-sig
- "d" gnus-article-treat-dumbquotes)
-
-(gnus-define-keys (gnus-summary-wash-deuglify-map "Y" gnus-summary-wash-map)
- ;; mnemonic: deuglif*Y*
- "u" gnus-article-outlook-unwrap-lines
- "a" gnus-article-outlook-repair-attribution
- "c" gnus-article-outlook-rearrange-citation
- "f" gnus-article-outlook-deuglify-article) ;; mnemonic: full deuglify
-
-(gnus-define-keys (gnus-summary-wash-hide-map "W" gnus-summary-wash-map)
- "a" gnus-article-hide
- "h" gnus-article-hide-headers
- "b" gnus-article-hide-boring-headers
- "s" gnus-article-hide-signature
- "c" gnus-article-hide-citation
- "C" gnus-article-hide-citation-in-followups
- "l" gnus-article-hide-list-identifiers
- "B" gnus-article-strip-banner
- "P" gnus-article-hide-pem
- "\C-c" gnus-article-hide-citation-maybe)
-
-(gnus-define-keys (gnus-summary-wash-highlight-map "H" gnus-summary-wash-map)
- "a" gnus-article-highlight
- "h" gnus-article-highlight-headers
- "c" gnus-article-highlight-citation
- "s" gnus-article-highlight-signature)
-
-(gnus-define-keys (gnus-summary-wash-header-map "G" gnus-summary-wash-map)
- "f" gnus-article-treat-fold-headers
- "u" gnus-article-treat-unfold-headers
- "n" gnus-article-treat-fold-newsgroups)
-
-(gnus-define-keys (gnus-summary-wash-display-map "D" gnus-summary-wash-map)
- "x" gnus-article-display-x-face
- "d" gnus-article-display-face
- "s" gnus-treat-smiley
- "D" gnus-article-remove-images
- "f" gnus-treat-from-picon
- "m" gnus-treat-mail-picon
- "n" gnus-treat-newsgroups-picon)
-
-(gnus-define-keys (gnus-summary-wash-mime-map "M" gnus-summary-wash-map)
- "w" gnus-article-decode-mime-words
- "c" gnus-article-decode-charset
- "v" gnus-mime-view-all-parts
- "b" gnus-article-view-part)
-
-(gnus-define-keys (gnus-summary-wash-time-map "T" gnus-summary-wash-map)
- "z" gnus-article-date-ut
- "u" gnus-article-date-ut
- "l" gnus-article-date-local
- "p" gnus-article-date-english
- "e" gnus-article-date-lapsed
- "o" gnus-article-date-original
- "i" gnus-article-date-iso8601
- "s" gnus-article-date-user)
-
-(gnus-define-keys (gnus-summary-wash-empty-map "E" gnus-summary-wash-map)
- "t" gnus-article-remove-trailing-blank-lines
- "l" gnus-article-strip-leading-blank-lines
- "m" gnus-article-strip-multiple-blank-lines
- "a" gnus-article-strip-blank-lines
- "A" gnus-article-strip-all-blank-lines
- "s" gnus-article-strip-leading-space
- "e" gnus-article-strip-trailing-space
- "w" gnus-article-remove-leading-whitespace)
-
-(gnus-define-keys (gnus-summary-help-map "H" gnus-summary-mode-map)
- "v" gnus-version
- "f" gnus-summary-fetch-faq
- "d" gnus-summary-describe-group
- "h" gnus-summary-describe-briefly
- "i" gnus-info-find-node
- "c" gnus-group-fetch-charter
- "C" gnus-group-fetch-control)
-
-(gnus-define-keys (gnus-summary-backend-map "B" gnus-summary-mode-map)
- "e" gnus-summary-expire-articles
- "\M-\C-e" gnus-summary-expire-articles-now
- "\177" gnus-summary-delete-article
- [delete] gnus-summary-delete-article
- [backspace] gnus-summary-delete-article
- "m" gnus-summary-move-article
- "r" gnus-summary-respool-article
- "w" gnus-summary-edit-article
- "c" gnus-summary-copy-article
- "B" gnus-summary-crosspost-article
- "q" gnus-summary-respool-query
- "t" gnus-summary-respool-trace
- "i" gnus-summary-import-article
- "I" gnus-summary-create-article
- "p" gnus-summary-article-posted-p)
-
-(gnus-define-keys (gnus-summary-save-map "O" gnus-summary-mode-map)
- "o" gnus-summary-save-article
- "m" gnus-summary-save-article-mail
- "F" gnus-summary-write-article-file
- "r" gnus-summary-save-article-rmail
- "f" gnus-summary-save-article-file
- "b" gnus-summary-save-article-body-file
- "B" gnus-summary-write-article-body-file
- "h" gnus-summary-save-article-folder
- "v" gnus-summary-save-article-vm
- "p" gnus-summary-pipe-output
- "P" gnus-summary-muttprint
- "s" gnus-soup-add-article)
-
-(gnus-define-keys (gnus-summary-mime-map "K" gnus-summary-mode-map)
- "b" gnus-summary-display-buttonized
- "m" gnus-summary-repair-multipart
- "v" gnus-article-view-part
- "o" gnus-article-save-part
- "c" gnus-article-copy-part
- "C" gnus-article-view-part-as-charset
- "e" gnus-article-view-part-externally
- "E" gnus-article-encrypt-body
- "i" gnus-article-inline-part
- "|" gnus-article-pipe-part)
-
-(gnus-define-keys (gnus-uu-mark-map "P" gnus-summary-mark-map)
- "p" gnus-summary-mark-as-processable
- "u" gnus-summary-unmark-as-processable
- "U" gnus-summary-unmark-all-processable
- "v" gnus-uu-mark-over
- "s" gnus-uu-mark-series
- "r" gnus-uu-mark-region
- "g" gnus-uu-unmark-region
- "R" gnus-uu-mark-by-regexp
- "G" gnus-uu-unmark-by-regexp
- "t" gnus-uu-mark-thread
- "T" gnus-uu-unmark-thread
- "a" gnus-uu-mark-all
- "b" gnus-uu-mark-buffer
- "S" gnus-uu-mark-sparse
- "k" gnus-summary-kill-process-mark
- "y" gnus-summary-yank-process-mark
- "w" gnus-summary-save-process-mark
- "i" gnus-uu-invert-processable)
-
-(gnus-define-keys (gnus-uu-extract-map "X" gnus-summary-mode-map)
- ;;"x" gnus-uu-extract-any
- "m" gnus-summary-save-parts
- "u" gnus-uu-decode-uu
- "U" gnus-uu-decode-uu-and-save
- "s" gnus-uu-decode-unshar
- "S" gnus-uu-decode-unshar-and-save
- "o" gnus-uu-decode-save
- "O" gnus-uu-decode-save
- "b" gnus-uu-decode-binhex
- "B" gnus-uu-decode-binhex
- "p" gnus-uu-decode-postscript
- "P" gnus-uu-decode-postscript-and-save)
-
-(gnus-define-keys
- (gnus-uu-extract-view-map "v" gnus-uu-extract-map)
- "u" gnus-uu-decode-uu-view
- "U" gnus-uu-decode-uu-and-save-view
- "s" gnus-uu-decode-unshar-view
- "S" gnus-uu-decode-unshar-and-save-view
- "o" gnus-uu-decode-save-view
- "O" gnus-uu-decode-save-view
- "b" gnus-uu-decode-binhex-view
- "B" gnus-uu-decode-binhex-view
- "p" gnus-uu-decode-postscript-view
- "P" gnus-uu-decode-postscript-and-save-view)
-
-(defvar gnus-article-post-menu nil)
-
-(defconst gnus-summary-menu-maxlen 20)
-
-(defun gnus-summary-menu-split (menu)
- ;; If we have lots of elements, divide them into groups of 20
- ;; and make a pane (or submenu) for each one.
- (if (> (length menu) (/ (* gnus-summary-menu-maxlen 3) 2))
- (let ((menu menu) sublists next
- (i 1))
- (while menu
- ;; Pull off the next gnus-summary-menu-maxlen elements
- ;; and make them the next element of sublist.
- (setq next (nthcdr gnus-summary-menu-maxlen menu))
- (if next
- (setcdr (nthcdr (1- gnus-summary-menu-maxlen) menu)
- nil))
- (setq sublists (cons (cons (format "%s ... %s" (aref (car menu) 0)
- (aref (car (last menu)) 0)) menu)
- sublists))
- (setq i (1+ i))
- (setq menu next))
- (nreverse sublists))
- ;; Few elements--put them all in one pane.
- menu))
-
-(defun gnus-summary-make-menu-bar ()
- (gnus-turn-off-edit-menu 'summary)
-
- (unless (boundp 'gnus-summary-misc-menu)
-
- (easy-menu-define
- gnus-summary-kill-menu gnus-summary-mode-map ""
- (cons
- "Score"
- (nconc
- (list
- ["Customize" gnus-score-customize t])
- (gnus-make-score-map 'increase)
- (gnus-make-score-map 'lower)
- '(("Mark"
- ["Kill below" gnus-summary-kill-below t]
- ["Mark above" gnus-summary-mark-above t]
- ["Tick above" gnus-summary-tick-above t]
- ["Clear above" gnus-summary-clear-above t])
- ["Current score" gnus-summary-current-score t]
- ["Set score" gnus-summary-set-score t]
- ["Switch current score file..." gnus-score-change-score-file t]
- ["Set mark below..." gnus-score-set-mark-below t]
- ["Set expunge below..." gnus-score-set-expunge-below t]
- ["Edit current score file" gnus-score-edit-current-scores t]
- ["Edit score file..." gnus-score-edit-file t]
- ["Trace score" gnus-score-find-trace t]
- ["Find words" gnus-score-find-favourite-words t]
- ["Rescore buffer" gnus-summary-rescore t]
- ["Increase score..." gnus-summary-increase-score t]
- ["Lower score..." gnus-summary-lower-score t]))))
-
- ;; Define both the Article menu in the summary buffer and the
- ;; equivalent Commands menu in the article buffer here for
- ;; consistency.
- (let ((innards
- `(("Hide"
- ["All" gnus-article-hide t]
- ["Headers" gnus-article-hide-headers t]
- ["Signature" gnus-article-hide-signature t]
- ["Citation" gnus-article-hide-citation t]
- ["List identifiers" gnus-article-hide-list-identifiers t]
- ["Banner" gnus-article-strip-banner t]
- ["Boring headers" gnus-article-hide-boring-headers t])
- ("Highlight"
- ["All" gnus-article-highlight t]
- ["Headers" gnus-article-highlight-headers t]
- ["Signature" gnus-article-highlight-signature t]
- ["Citation" gnus-article-highlight-citation t])
- ("MIME"
- ["Words" gnus-article-decode-mime-words t]
- ["Charset" gnus-article-decode-charset t]
- ["QP" gnus-article-de-quoted-unreadable t]
- ["Base64" gnus-article-de-base64-unreadable t]
- ["View MIME buttons" gnus-summary-display-buttonized t]
- ["View all" gnus-mime-view-all-parts t]
- ["Verify and Decrypt" gnus-summary-force-verify-and-decrypt t]
- ["Encrypt body" gnus-article-encrypt-body
- :active (not (gnus-group-read-only-p))
- ,@(if (featurep 'xemacs) nil
- '(:help "Encrypt the message body on disk"))]
- ["Extract all parts..." gnus-summary-save-parts t]
- ("Multipart"
- ["Repair multipart" gnus-summary-repair-multipart t]
- ["Pipe part..." gnus-article-pipe-part t]
- ["Inline part" gnus-article-inline-part t]
- ["Encrypt body" gnus-article-encrypt-body
- :active (not (gnus-group-read-only-p))
- ,@(if (featurep 'xemacs) nil
- '(:help "Encrypt the message body on disk"))]
- ["View part externally" gnus-article-view-part-externally t]
- ["View part with charset..." gnus-article-view-part-as-charset t]
- ["Copy part" gnus-article-copy-part t]
- ["Save part..." gnus-article-save-part t]
- ["View part" gnus-article-view-part t]))
- ("Date"
- ["Local" gnus-article-date-local t]
- ["ISO8601" gnus-article-date-iso8601 t]
- ["UT" gnus-article-date-ut t]
- ["Original" gnus-article-date-original t]
- ["Lapsed" gnus-article-date-lapsed t]
- ["User-defined" gnus-article-date-user t])
- ("Display"
- ["Remove images" gnus-article-remove-images t]
- ["Toggle smiley" gnus-treat-smiley t]
- ["Show X-Face" gnus-article-display-x-face t]
- ["Show picons in From" gnus-treat-from-picon t]
- ["Show picons in mail headers" gnus-treat-mail-picon t]
- ["Show picons in news headers" gnus-treat-newsgroups-picon t]
- ("View as different encoding"
- ,@(gnus-summary-menu-split
- (mapcar
- (lambda (cs)
- ;; Since easymenu under Emacs doesn't allow
- ;; lambda forms for menu commands, we should
- ;; provide intern'ed function symbols.
- (let ((command (intern (format "\
-gnus-summary-show-article-from-menu-as-charset-%s" cs))))
- (fset command
- `(lambda ()
- (interactive)
- (let ((gnus-summary-show-article-charset-alist
- '((1 . ,cs))))
- (gnus-summary-show-article 1))))
- `[,(symbol-name cs) ,command t]))
- (sort (if (fboundp 'coding-system-list)
- (coding-system-list)
- (mapcar 'car mm-mime-mule-charset-alist))
- 'string<)))))
- ("Washing"
- ("Remove Blanks"
- ["Leading" gnus-article-strip-leading-blank-lines t]
- ["Multiple" gnus-article-strip-multiple-blank-lines t]
- ["Trailing" gnus-article-remove-trailing-blank-lines t]
- ["All of the above" gnus-article-strip-blank-lines t]
- ["All" gnus-article-strip-all-blank-lines t]
- ["Leading space" gnus-article-strip-leading-space t]
- ["Trailing space" gnus-article-strip-trailing-space t]
- ["Leading space in headers"
- gnus-article-remove-leading-whitespace t])
- ["Overstrike" gnus-article-treat-overstrike t]
- ["Dumb quotes" gnus-article-treat-dumbquotes t]
- ["Emphasis" gnus-article-emphasize t]
- ["Word wrap" gnus-article-fill-cited-article t]
- ["Fill long lines" gnus-article-fill-long-lines t]
- ["Capitalize sentences" gnus-article-capitalize-sentences t]
- ["Remove CR" gnus-article-remove-cr t]
- ["Quoted-Printable" gnus-article-de-quoted-unreadable t]
- ["Base64" gnus-article-de-base64-unreadable t]
- ["Rot 13" gnus-summary-caesar-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "\"Caesar rotate\" article by 13"))]
- ["Morse decode" gnus-summary-morse-message t]
- ["Unix pipe..." gnus-summary-pipe-message t]
- ["Add buttons" gnus-article-add-buttons t]
- ["Add buttons to head" gnus-article-add-buttons-to-head t]
- ["Stop page breaking" gnus-summary-stop-page-breaking t]
- ["Verbose header" gnus-summary-verbose-headers t]
- ["Toggle header" gnus-summary-toggle-header t]
- ["Unfold headers" gnus-article-treat-unfold-headers t]
- ["Fold newsgroups" gnus-article-treat-fold-newsgroups t]
- ["Html" gnus-article-wash-html t]
- ["Unsplit URLs" gnus-article-unsplit-urls t]
- ["Verify X-PGP-Sig" gnus-article-verify-x-pgp-sig t]
- ["Decode HZ" gnus-article-decode-HZ t]
- ("(Outlook) Deuglify"
- ["Unwrap lines" gnus-article-outlook-unwrap-lines t]
- ["Repair attribution" gnus-article-outlook-repair-attribution t]
- ["Rearrange citation" gnus-article-outlook-rearrange-citation t]
- ["Full (Outlook) deuglify"
- gnus-article-outlook-deuglify-article t])
- )
- ("Output"
- ["Save in default format..." gnus-summary-save-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Save article using default method"))]
- ["Save in file..." gnus-summary-save-article-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Save article in file"))]
- ["Save in Unix mail format..." gnus-summary-save-article-mail t]
- ["Save in MH folder..." gnus-summary-save-article-folder t]
- ["Save in VM folder..." gnus-summary-save-article-vm t]
- ["Save in RMAIL mbox..." gnus-summary-save-article-rmail t]
- ["Save body in file..." gnus-summary-save-article-body-file t]
- ["Pipe through a filter..." gnus-summary-pipe-output t]
- ["Add to SOUP packet" gnus-soup-add-article t]
- ["Print with Muttprint..." gnus-summary-muttprint t]
- ["Print" gnus-summary-print-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Generate and print a PostScript image"))])
- ("Copy, move,... (Backend)"
- ,@(if (featurep 'xemacs) nil
- '(:help "Copying, moving, expiring articles..."))
- ["Respool article..." gnus-summary-respool-article t]
- ["Move article..." gnus-summary-move-article
- (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)]
- ["Copy article..." gnus-summary-copy-article t]
- ["Crosspost article..." gnus-summary-crosspost-article
- (gnus-check-backend-function
- 'request-replace-article gnus-newsgroup-name)]
- ["Import file..." gnus-summary-import-article
- (gnus-check-backend-function
- 'request-accept-article gnus-newsgroup-name)]
- ["Create article..." gnus-summary-create-article
- (gnus-check-backend-function
- 'request-accept-article gnus-newsgroup-name)]
- ["Check if posted" gnus-summary-article-posted-p t]
- ["Edit article" gnus-summary-edit-article
- (not (gnus-group-read-only-p))]
- ["Delete article" gnus-summary-delete-article
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Query respool" gnus-summary-respool-query t]
- ["Trace respool" gnus-summary-respool-trace t]
- ["Delete expirable articles" gnus-summary-expire-articles-now
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)])
- ("Extract"
- ["Uudecode" gnus-uu-decode-uu
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Decode uuencoded article(s)"))]
- ["Uudecode and save" gnus-uu-decode-uu-and-save t]
- ["Unshar" gnus-uu-decode-unshar t]
- ["Unshar and save" gnus-uu-decode-unshar-and-save t]
- ["Save" gnus-uu-decode-save t]
- ["Binhex" gnus-uu-decode-binhex t]
- ["Postscript" gnus-uu-decode-postscript t]
- ["All MIME parts" gnus-summary-save-parts t])
- ("Cache"
- ["Enter article" gnus-cache-enter-article t]
- ["Remove article" gnus-cache-remove-article t])
- ["Translate" gnus-article-babel t]
- ["Select article buffer" gnus-summary-select-article-buffer t]
- ["Enter digest buffer" gnus-summary-enter-digest-group t]
- ["Isearch article..." gnus-summary-isearch-article t]
- ["Beginning of the article" gnus-summary-beginning-of-article t]
- ["End of the article" gnus-summary-end-of-article t]
- ["Fetch parent of article" gnus-summary-refer-parent-article t]
- ["Fetch referenced articles" gnus-summary-refer-references t]
- ["Fetch current thread" gnus-summary-refer-thread t]
- ["Fetch article with id..." gnus-summary-refer-article t]
- ["Setup Mailing List Params" gnus-mailing-list-insinuate t]
- ["Redisplay" gnus-summary-show-article t]
- ["Raw article" gnus-summary-show-raw-article :keys "C-u g"])))
- (easy-menu-define
- gnus-summary-article-menu gnus-summary-mode-map ""
- (cons "Article" innards))
-
- (if (not (keymapp gnus-summary-article-menu))
- (easy-menu-define
- gnus-article-commands-menu gnus-article-mode-map ""
- (cons "Commands" innards))
- ;; in Emacs, don't share menu.
- (setq gnus-article-commands-menu
- (copy-keymap gnus-summary-article-menu))
- (define-key gnus-article-mode-map [menu-bar commands]
- (cons "Commands" gnus-article-commands-menu))))
-
- (easy-menu-define
- gnus-summary-thread-menu gnus-summary-mode-map ""
- '("Threads"
- ["Find all messages in thread" gnus-summary-refer-thread t]
- ["Toggle threading" gnus-summary-toggle-threads t]
- ["Hide threads" gnus-summary-hide-all-threads t]
- ["Show threads" gnus-summary-show-all-threads t]
- ["Hide thread" gnus-summary-hide-thread t]
- ["Show thread" gnus-summary-show-thread t]
- ["Go to next thread" gnus-summary-next-thread t]
- ["Go to previous thread" gnus-summary-prev-thread t]
- ["Go down thread" gnus-summary-down-thread t]
- ["Go up thread" gnus-summary-up-thread t]
- ["Top of thread" gnus-summary-top-thread t]
- ["Mark thread as read" gnus-summary-kill-thread t]
- ["Lower thread score" gnus-summary-lower-thread t]
- ["Raise thread score" gnus-summary-raise-thread t]
- ["Rethread current" gnus-summary-rethread-current t]))
-
- (easy-menu-define
- gnus-summary-post-menu gnus-summary-mode-map ""
- `("Post"
- ["Send a message (mail or news)" gnus-summary-post-news
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Compose a new message (mail or news)"))]
- ["Followup" gnus-summary-followup
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Post followup to this article"))]
- ["Followup and yank" gnus-summary-followup-with-original
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Post followup to this article, quoting its contents"))]
- ["Supersede article" gnus-summary-supersede-article t]
- ["Cancel article" gnus-summary-cancel-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Cancel an article you posted"))]
- ["Reply" gnus-summary-reply t]
- ["Reply and yank" gnus-summary-reply-with-original t]
- ["Wide reply" gnus-summary-wide-reply t]
- ["Wide reply and yank" gnus-summary-wide-reply-with-original
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mail a reply, quoting this article"))]
- ["Very wide reply" gnus-summary-very-wide-reply t]
- ["Very wide reply and yank" gnus-summary-very-wide-reply-with-original
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mail a very wide reply, quoting this article"))]
- ["Mail forward" gnus-summary-mail-forward t]
- ["Post forward" gnus-summary-post-forward t]
- ["Digest and mail" gnus-uu-digest-mail-forward t]
- ["Digest and post" gnus-uu-digest-post-forward t]
- ["Resend message" gnus-summary-resend-message t]
- ["Resend message edit" gnus-summary-resend-message-edit t]
- ["Send bounced mail" gnus-summary-resend-bounced-mail t]
- ["Send a mail" gnus-summary-mail-other-window t]
- ["Create a local message" gnus-summary-news-other-window t]
- ["Uuencode and post" gnus-uu-post-news
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Post a uuencoded article"))]
- ["Followup via news" gnus-summary-followup-to-mail t]
- ["Followup via news and yank"
- gnus-summary-followup-to-mail-with-original t]
- ;;("Draft"
- ;;["Send" gnus-summary-send-draft t]
- ;;["Send bounced" gnus-resend-bounced-mail t])
- ))
-
- (cond
- ((not (keymapp gnus-summary-post-menu))
- (setq gnus-article-post-menu gnus-summary-post-menu))
- ((not gnus-article-post-menu)
- ;; Don't share post menu.
- (setq gnus-article-post-menu
- (copy-keymap gnus-summary-post-menu))))
- (define-key gnus-article-mode-map [menu-bar post]
- (cons "Post" gnus-article-post-menu))
-
- (easy-menu-define
- gnus-summary-misc-menu gnus-summary-mode-map ""
- `("Gnus"
- ("Mark Read"
- ["Mark as read" gnus-summary-mark-as-read-forward t]
- ["Mark same subject and select"
- gnus-summary-kill-same-subject-and-select t]
- ["Mark same subject" gnus-summary-kill-same-subject t]
- ["Catchup" gnus-summary-catchup
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark unread articles in this group as read"))]
- ["Catchup all" gnus-summary-catchup-all t]
- ["Catchup to here" gnus-summary-catchup-to-here t]
- ["Catchup from here" gnus-summary-catchup-from-here t]
- ["Catchup region" gnus-summary-mark-region-as-read
- (gnus-mark-active-p)]
- ["Mark excluded" gnus-summary-limit-mark-excluded-as-read t])
- ("Mark Various"
- ["Tick" gnus-summary-tick-article-forward t]
- ["Mark as dormant" gnus-summary-mark-as-dormant t]
- ["Remove marks" gnus-summary-clear-mark-forward t]
- ["Set expirable mark" gnus-summary-mark-as-expirable t]
- ["Set bookmark" gnus-summary-set-bookmark t]
- ["Remove bookmark" gnus-summary-remove-bookmark t])
- ("Limit to"
- ["Marks..." gnus-summary-limit-to-marks t]
- ["Subject..." gnus-summary-limit-to-subject t]
- ["Author..." gnus-summary-limit-to-author t]
- ["Age..." gnus-summary-limit-to-age t]
- ["Extra..." gnus-summary-limit-to-extra t]
- ["Score..." gnus-summary-limit-to-score t]
- ["Display Predicate" gnus-summary-limit-to-display-predicate t]
- ["Unread" gnus-summary-limit-to-unread t]
- ["Unseen" gnus-summary-limit-to-unseen t]
- ["Non-dormant" gnus-summary-limit-exclude-dormant t]
- ["Next or process marked articles" gnus-summary-limit-to-articles t]
- ["Pop limit" gnus-summary-pop-limit t]
- ["Show dormant" gnus-summary-limit-include-dormant t]
- ["Hide childless dormant"
- gnus-summary-limit-exclude-childless-dormant t]
- ;;["Hide thread" gnus-summary-limit-exclude-thread t]
- ["Hide marked" gnus-summary-limit-exclude-marks t]
- ["Show expunged" gnus-summary-limit-include-expunged t])
- ("Process Mark"
- ["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 (gnus-mark-active-p)]
- ["Unmark region" gnus-uu-unmark-region (gnus-mark-active-p)]
- ["Mark by regexp..." gnus-uu-mark-by-regexp t]
- ["Unmark by regexp..." gnus-uu-unmark-by-regexp t]
- ["Mark all" gnus-uu-mark-all t]
- ["Mark buffer" gnus-uu-mark-buffer t]
- ["Mark sparse" gnus-uu-mark-sparse t]
- ["Mark thread" gnus-uu-mark-thread t]
- ["Unmark thread" gnus-uu-unmark-thread t]
- ("Process Mark Sets"
- ["Kill" gnus-summary-kill-process-mark t]
- ["Yank" gnus-summary-yank-process-mark
- gnus-newsgroup-process-stack]
- ["Save" gnus-summary-save-process-mark t]
- ["Run command on marked..." gnus-summary-universal-argument t]))
- ("Scroll article"
- ["Page forward" gnus-summary-next-page
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Show next page of article"))]
- ["Page backward" gnus-summary-prev-page
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Show previous page of article"))]
- ["Line forward" gnus-summary-scroll-up t])
- ("Move"
- ["Next unread article" gnus-summary-next-unread-article t]
- ["Previous unread article" gnus-summary-prev-unread-article t]
- ["Next article" gnus-summary-next-article t]
- ["Previous article" gnus-summary-prev-article t]
- ["Next unread subject" gnus-summary-next-unread-subject t]
- ["Previous unread subject" gnus-summary-prev-unread-subject t]
- ["Next article same subject" gnus-summary-next-same-subject t]
- ["Previous article same subject" gnus-summary-prev-same-subject t]
- ["First unread article" gnus-summary-first-unread-article t]
- ["Best unread article" gnus-summary-best-unread-article t]
- ["Go to subject number..." gnus-summary-goto-subject t]
- ["Go to article number..." gnus-summary-goto-article t]
- ["Go to the last article" gnus-summary-goto-last-article t]
- ["Pop article off history" gnus-summary-pop-article t])
- ("Sort"
- ["Sort by number" gnus-summary-sort-by-number t]
- ["Sort by author" gnus-summary-sort-by-author t]
- ["Sort by subject" gnus-summary-sort-by-subject t]
- ["Sort by date" gnus-summary-sort-by-date t]
- ["Sort by score" gnus-summary-sort-by-score t]
- ["Sort by lines" gnus-summary-sort-by-lines t]
- ["Sort by characters" gnus-summary-sort-by-chars t]
- ["Randomize" gnus-summary-sort-by-random t]
- ["Original sort" gnus-summary-sort-by-original t])
- ("Help"
- ["Fetch group FAQ" gnus-summary-fetch-faq t]
- ["Describe group" gnus-summary-describe-group t]
- ["Fetch charter" gnus-group-fetch-charter
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the charter of the current group"))]
- ["Fetch control message" gnus-group-fetch-control
- ,@(if (featurep 'xemacs) nil
- '(:help "Display the archived control message for the current group"))]
- ["Read manual" gnus-info-find-node t])
- ("Modes"
- ["Pick and read" gnus-pick-mode t]
- ["Binary" gnus-binary-mode t])
- ("Regeneration"
- ["Regenerate" gnus-summary-prepare t]
- ["Insert cached articles" gnus-summary-insert-cached-articles t]
- ["Insert dormant articles" gnus-summary-insert-dormant-articles t]
- ["Toggle threading" gnus-summary-toggle-threads t])
- ["See old articles" gnus-summary-insert-old-articles t]
- ["See new articles" gnus-summary-insert-new-articles t]
- ["Filter articles..." gnus-summary-execute-command t]
- ["Run command on articles..." gnus-summary-universal-argument t]
- ["Search articles forward..." gnus-summary-search-article-forward t]
- ["Search articles backward..." gnus-summary-search-article-backward t]
- ["Toggle line truncation" gnus-summary-toggle-truncation t]
- ["Expand window" gnus-summary-expand-window t]
- ["Expire expirable articles" gnus-summary-expire-articles
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name)]
- ["Edit local kill file" gnus-summary-edit-local-kill t]
- ["Edit main kill file" gnus-summary-edit-global-kill t]
- ["Edit group parameters" gnus-summary-edit-parameters t]
- ["Customize group parameters" gnus-summary-customize-parameters t]
- ["Send a bug report" gnus-bug t]
- ("Exit"
- ["Catchup and exit" gnus-summary-catchup-and-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark unread articles in this group as read, then exit"))]
- ["Catchup all and exit" gnus-summary-catchup-all-and-exit t]
- ["Catchup and goto next" gnus-summary-catchup-and-goto-next-group t]
- ["Exit group" gnus-summary-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Exit current group, return to group selection mode"))]
- ["Exit group without updating" gnus-summary-exit-no-update t]
- ["Exit and goto next group" gnus-summary-next-group t]
- ["Exit and goto prev group" gnus-summary-prev-group t]
- ["Reselect group" gnus-summary-reselect-current-group t]
- ["Rescan group" gnus-summary-rescan-group t]
- ["Update dribble" gnus-summary-save-newsrc t])))
-
- (gnus-run-hooks 'gnus-summary-menu-hook)))
-
-(defvar gnus-summary-tool-bar-map nil)
-
-;; Note: The :set function in the `gnus-summary-tool-bar*' variables will only
-;; affect _new_ message buffers. We might add a function that walks thru all
-;; summary-mode buffers and force the update.
-(defun gnus-summary-tool-bar-update (&optional symbol value)
- "Update summary mode toolbar.
-Setter function for custom variables."
- (setq-default gnus-summary-tool-bar-map nil)
- (when symbol
- ;; When used as ":set" function:
- (set-default symbol value))
- (when (gnus-buffer-live-p gnus-summary-buffer)
- (with-current-buffer gnus-summary-buffer
- (gnus-summary-make-tool-bar))))
-
-(defcustom gnus-summary-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'gnus-summary-tool-bar-gnome
- 'gnus-summary-tool-bar-retro)
- "Specifies the Gnus summary tool bar.
-
-It can be either a list or a symbol refering to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `gnus-summary-mode-map'.
-
-Pre-defined symbols include `gnus-summary-tool-bar-gnome' and
-`gnus-summary-tool-bar-retro'."
- :type '(choice (const :tag "GNOME style" gnus-summary-tool-bar-gnome)
- (const :tag "Retro look" gnus-summary-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
-
-(defcustom gnus-summary-tool-bar-gnome
- '((gnus-summary-post-news "mail/compose" nil)
- (gnus-summary-insert-new-articles "mail/inbox" nil
- :visible (or (not gnus-agent)
- gnus-plugged))
- (gnus-summary-reply-with-original "mail/reply")
- (gnus-summary-reply "mail/reply" nil :visible nil)
- (gnus-summary-followup-with-original "mail/reply-all")
- (gnus-summary-followup "mail/reply-all" nil :visible nil)
- (gnus-summary-mail-forward "mail/forward")
- (gnus-summary-save-article "mail/save")
- (gnus-summary-search-article-forward "search" nil :visible nil)
- (gnus-summary-print-article "print")
- (gnus-summary-tick-article-forward "flag-followup" nil :visible nil)
- ;; Some new commands that may need more suitable icons:
- (gnus-summary-save-newsrc "save" nil :visible nil)
- ;; (gnus-summary-show-article "stock_message-display" nil :visible nil)
- (gnus-summary-prev-article "left-arrow")
- (gnus-summary-next-article "right-arrow")
- (gnus-summary-next-page "next-page")
- ;; (gnus-summary-enter-digest-group "right_arrow" nil :visible nil)
- ;;
- ;; Maybe some sort-by-... could be added:
- ;; (gnus-summary-sort-by-author "sort-a-z" nil :visible nil)
- ;; (gnus-summary-sort-by-date "sort-1-9" nil :visible nil)
- (gnus-summary-mark-as-expirable
- "delete" nil
- :visible (gnus-check-backend-function 'request-expire-articles
- gnus-newsgroup-name))
- (gnus-summary-mark-as-spam
- "mail/spam" t
- :visible (and (fboundp 'spam-group-ham-contents-p)
- (spam-group-ham-contents-p gnus-newsgroup-name))
- :help "Mark as spam")
- (gnus-summary-mark-as-read-forward
- "mail/not-spam" nil
- :visible (and (fboundp 'spam-group-spam-contents-p)
- (spam-group-spam-contents-p gnus-newsgroup-name)))
- ;;
- (gnus-summary-exit "exit")
- (gmm-customize-mode "preferences" t :help "Edit mode preferences")
- (gnus-info-find-node "help"))
- "List of functions for the summary tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
-
-(defcustom gnus-summary-tool-bar-retro
- '((gnus-summary-prev-unread-article "gnus/prev-ur")
- (gnus-summary-next-unread-article "gnus/next-ur")
- (gnus-summary-post-news "gnus/post")
- (gnus-summary-followup-with-original "gnus/fuwo")
- (gnus-summary-followup "gnus/followup")
- (gnus-summary-reply-with-original "gnus/reply-wo")
- (gnus-summary-reply "gnus/reply")
- (gnus-summary-caesar-message "gnus/rot13")
- (gnus-uu-decode-uu "gnus/uu-decode")
- (gnus-summary-save-article-file "gnus/save-aif")
- (gnus-summary-save-article "gnus/save-art")
- (gnus-uu-post-news "gnus/uu-post")
- (gnus-summary-catchup "gnus/catchup")
- (gnus-summary-catchup-and-exit "gnus/cu-exit")
- (gnus-summary-exit "gnus/exit-summ")
- ;; Some new command that may need more suitable icons:
- (gnus-summary-print-article "gnus/print" nil :visible nil)
- (gnus-summary-mark-as-expirable "gnus/close" nil :visible nil)
- (gnus-summary-save-newsrc "gnus/save" nil :visible nil)
- ;; (gnus-summary-enter-digest-group "gnus/right_arrow" nil :visible nil)
- (gnus-summary-search-article-forward "gnus/search" nil :visible nil)
- ;; (gnus-summary-insert-new-articles "gnus/paste" nil :visible nil)
- ;; (gnus-summary-toggle-threads "gnus/open" nil :visible nil)
- ;;
- (gnus-info-find-node "gnus/help" nil :visible nil))
- "List of functions for the summary tool bar (retro look).
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
-
-(defcustom gnus-summary-tool-bar-zap-list t
- "List of icon items from the global tool bar.
-These items are not displayed in the Gnus summary mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'gnus-summary-tool-bar-update
- :group 'gnus-summary)
-
-(defvar image-load-path)
-
-(defun gnus-summary-make-tool-bar (&optional force)
- "Make a summary mode tool bar from `gnus-summary-tool-bar'.
-When FORCE, rebuild the tool bar."
- (when (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
- tool-bar-mode
- (or (not gnus-summary-tool-bar-map) force))
- (let* ((load-path
- (gmm-image-load-path-for-library "gnus"
- "mail/save.xpm"
- nil t))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path)))
- (map (gmm-tool-bar-from-list gnus-summary-tool-bar
- gnus-summary-tool-bar-zap-list
- 'gnus-summary-mode-map)))
- (when map
- ;; Need to set `gnus-summary-tool-bar-map' because `gnus-article-mode'
- ;; uses it's value.
- (setq gnus-summary-tool-bar-map map))))
- (set (make-local-variable 'tool-bar-map) gnus-summary-tool-bar-map))
-
-(defun gnus-score-set-default (var value)
- "A version of set that updates the GNU Emacs menu-bar."
- (set var value)
- ;; It is the message that forces the active status to be updated.
- (message ""))
-
-(defun gnus-make-score-map (type)
- "Make a summary score map of type TYPE."
- (if t
- nil
- (let ((headers '(("author" "from" string)
- ("subject" "subject" string)
- ("article body" "body" string)
- ("article head" "head" string)
- ("xref" "xref" string)
- ("extra header" "extra" string)
- ("lines" "lines" number)
- ("followups to author" "followup" string)))
- (types '((number ("less than" <)
- ("greater than" >)
- ("equal" =))
- (string ("substring" s)
- ("exact string" e)
- ("fuzzy string" f)
- ("regexp" r))))
- (perms '(("temporary" (current-time-string))
- ("permanent" nil)
- ("immediate" now)))
- header)
- (list
- (apply
- 'nconc
- (list
- (if (eq type 'lower)
- "Lower score"
- "Increase score"))
- (let (outh)
- (while headers
- (setq header (car headers))
- (setq outh
- (cons
- (apply
- 'nconc
- (list (car header))
- (let ((ts (cdr (assoc (nth 2 header) types)))
- outt)
- (while ts
- (setq outt
- (cons
- (apply
- 'nconc
- (list (caar ts))
- (let ((ps perms)
- outp)
- (while ps
- (setq outp
- (cons
- (vector
- (caar ps)
- (list
- 'gnus-summary-score-entry
- (nth 1 header)
- (if (or (string= (nth 1 header)
- "head")
- (string= (nth 1 header)
- "body"))
- ""
- (list 'gnus-summary-header
- (nth 1 header)))
- (list 'quote (nth 1 (car ts)))
- (list 'gnus-score-delta-default
- nil)
- (nth 1 (car ps))
- t)
- t)
- outp))
- (setq ps (cdr ps)))
- (list (nreverse outp))))
- outt))
- (setq ts (cdr ts)))
- (list (nreverse outt))))
- outh))
- (setq headers (cdr headers)))
- (list (nreverse outh))))))))
-
-\f
-
-(defun gnus-summary-mode (&optional group)
- "Major mode for reading articles.
-
-All normal editing commands are switched off.
-\\<gnus-summary-mode-map>
-Each line in this buffer represents one article. To read an
-article, you can, for instance, type `\\[gnus-summary-next-page]'. To move forwards
-and backwards while displaying articles, type `\\[gnus-summary-next-unread-article]' and `\\[gnus-summary-prev-unread-article]',
-respectively.
-
-You can also post articles and send mail from this buffer. To
-follow up an article, type `\\[gnus-summary-followup]'. To mail a reply to the author
-of an article, type `\\[gnus-summary-reply]'.
-
-There are approx. one gazillion commands you can execute in this
-buffer; read the info pages for more information (`\\[gnus-info-find-node]').
-
-The following commands are available:
-
-\\{gnus-summary-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (when (gnus-visual-p 'summary-menu 'menu)
- (gnus-summary-make-menu-bar)
- (gnus-summary-make-tool-bar))
- (gnus-summary-make-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-make-local-variables))
- (gnus-make-thread-indent-array)
- (gnus-simplify-mode-line)
- (setq major-mode 'gnus-summary-mode)
- (setq mode-name "Summary")
- (make-local-variable 'minor-mode-alist)
- (use-local-map gnus-summary-mode-map)
- (buffer-disable-undo)
- (setq buffer-read-only t) ;Disable modification
- (setq truncate-lines t)
- (setq selective-display t)
- (setq selective-display-ellipses t) ;Display `...'
- (gnus-summary-set-display-table)
- (gnus-set-default-directory)
- (setq gnus-newsgroup-name group)
- (make-local-variable 'gnus-summary-line-format)
- (make-local-variable 'gnus-summary-line-format-spec)
- (make-local-variable 'gnus-summary-dummy-line-format)
- (make-local-variable 'gnus-summary-dummy-line-format-spec)
- (make-local-variable 'gnus-summary-mark-positions)
- (gnus-make-local-hook 'pre-command-hook)
- (add-hook 'pre-command-hook 'gnus-set-global-variables nil t)
- (gnus-run-mode-hooks 'gnus-summary-mode-hook)
- (turn-on-gnus-mailing-list-mode)
- (mm-enable-multibyte)
- (gnus-update-format-specifications nil 'summary 'summary-mode 'summary-dummy)
- (gnus-update-summary-mark-positions))
-
-(defun gnus-summary-make-local-variables ()
- "Make all the local summary buffer variables."
- (let (global)
- (dolist (local gnus-summary-local-variables)
- (if (consp local)
- (progn
- (if (eq (cdr local) 'global)
- ;; Copy the global value of the variable.
- (setq global (symbol-value (car local)))
- ;; Use the value from the list.
- (setq global (eval (cdr local))))
- (set (make-local-variable (car local)) global))
- ;; Simple nil-valued local variable.
- (set (make-local-variable local) nil)))))
-
-(defun gnus-summary-clear-local-variables ()
- (let ((locals gnus-summary-local-variables))
- (while locals
- (if (consp (car locals))
- (and (vectorp (caar locals))
- (set (caar locals) nil))
- (and (vectorp (car locals))
- (set (car locals) nil)))
- (setq locals (cdr locals)))))
-
-;; Summary data functions.
-
-(defmacro gnus-data-number (data)
- `(car ,data))
-
-(defmacro gnus-data-set-number (data number)
- `(setcar ,data ,number))
-
-(defmacro gnus-data-mark (data)
- `(nth 1 ,data))
-
-(defmacro gnus-data-set-mark (data mark)
- `(setcar (nthcdr 1 ,data) ,mark))
-
-(defmacro gnus-data-pos (data)
- `(nth 2 ,data))
-
-(defmacro gnus-data-set-pos (data pos)
- `(setcar (nthcdr 2 ,data) ,pos))
-
-(defmacro gnus-data-header (data)
- `(nth 3 ,data))
-
-(defmacro gnus-data-set-header (data header)
- `(setf (nth 3 ,data) ,header))
-
-(defmacro gnus-data-level (data)
- `(nth 4 ,data))
-
-(defmacro gnus-data-unread-p (data)
- `(= (nth 1 ,data) gnus-unread-mark))
-
-(defmacro gnus-data-read-p (data)
- `(/= (nth 1 ,data) gnus-unread-mark))
-
-(defmacro gnus-data-pseudo-p (data)
- `(consp (nth 3 ,data)))
-
-(defmacro gnus-data-find (number)
- `(assq ,number gnus-newsgroup-data))
-
-(defmacro gnus-data-find-list (number &optional data)
- `(let ((bdata ,(or data 'gnus-newsgroup-data)))
- (memq (assq ,number bdata)
- bdata)))
-
-(defmacro gnus-data-make (number mark pos header level)
- `(list ,number ,mark ,pos ,header ,level))
-
-(defun gnus-data-enter (after-article number mark pos header level offset)
- (let ((data (gnus-data-find-list after-article)))
- (unless data
- (error "No such article: %d" after-article))
- (setcdr data (cons (gnus-data-make number mark pos header level)
- (cdr data)))
- (setq gnus-newsgroup-data-reverse nil)
- (gnus-data-update-list (cddr data) offset)))
-
-(defun gnus-data-enter-list (after-article list &optional offset)
- (when list
- (let ((data (and after-article (gnus-data-find-list after-article)))
- (ilist list))
- (if (not (or data
- after-article))
- (let ((odata gnus-newsgroup-data))
- (setq gnus-newsgroup-data (nconc list gnus-newsgroup-data))
- (when offset
- (gnus-data-update-list odata offset)))
- ;; Find the last element in the list to be spliced into the main
- ;; list.
- (while (cdr list)
- (setq list (cdr list)))
- (if (not data)
- (progn
- (setcdr list gnus-newsgroup-data)
- (setq gnus-newsgroup-data ilist)
- (when offset
- (gnus-data-update-list (cdr list) offset)))
- (setcdr list (cdr data))
- (setcdr data ilist)
- (when offset
- (gnus-data-update-list (cdr list) offset))))
- (setq gnus-newsgroup-data-reverse nil))))
-
-(defun gnus-data-remove (article &optional offset)
- (let ((data gnus-newsgroup-data))
- (if (= (gnus-data-number (car data)) article)
- (progn
- (setq gnus-newsgroup-data (cdr gnus-newsgroup-data)
- gnus-newsgroup-data-reverse nil)
- (when offset
- (gnus-data-update-list gnus-newsgroup-data offset)))
- (while (cdr data)
- (when (= (gnus-data-number (cadr data)) article)
- (setcdr data (cddr data))
- (when offset
- (gnus-data-update-list (cdr data) offset))
- (setq data nil
- gnus-newsgroup-data-reverse nil))
- (setq data (cdr data))))))
-
-(defmacro gnus-data-list (backward)
- `(if ,backward
- (or gnus-newsgroup-data-reverse
- (setq gnus-newsgroup-data-reverse
- (reverse gnus-newsgroup-data)))
- gnus-newsgroup-data))
-
-(defun gnus-data-update-list (data offset)
- "Add OFFSET to the POS of all data entries in DATA."
- (setq gnus-newsgroup-data-reverse nil)
- (while data
- (setcar (nthcdr 2 (car data)) (+ offset (nth 2 (car data))))
- (setq data (cdr data))))
-
-(defun gnus-summary-article-pseudo-p (article)
- "Say whether this article is a pseudo article or not."
- (not (vectorp (gnus-data-header (gnus-data-find article)))))
-
-(defmacro gnus-summary-article-sparse-p (article)
- "Say whether this article is a sparse article or not."
- `(memq ,article gnus-newsgroup-sparse))
-
-(defmacro gnus-summary-article-ancient-p (article)
- "Say whether this article is a sparse article or not."
- `(memq ,article gnus-newsgroup-ancient))
-
-(defun gnus-article-parent-p (number)
- "Say whether this article is a parent or not."
- (let ((data (gnus-data-find-list number)))
- (and (cdr data) ; There has to be an article after...
- (< (gnus-data-level (car data)) ; And it has to have a higher level.
- (gnus-data-level (nth 1 data))))))
-
-(defun gnus-article-children (number)
- "Return a list of all children to NUMBER."
- (let* ((data (gnus-data-find-list number))
- (level (gnus-data-level (car data)))
- children)
- (setq data (cdr data))
- (while (and data
- (= (gnus-data-level (car data)) (1+ level)))
- (push (gnus-data-number (car data)) children)
- (setq data (cdr data)))
- children))
-
-(defmacro gnus-summary-skip-intangible ()
- "If the current article is intangible, then jump to a different article."
- '(let ((to (get-text-property (point) 'gnus-intangible)))
- (and to (gnus-summary-goto-subject to))))
-
-(defmacro gnus-summary-article-intangible-p ()
- "Say whether this article is intangible or not."
- '(get-text-property (point) 'gnus-intangible))
-
-(defun gnus-article-read-p (article)
- "Say whether ARTICLE is read or not."
- (not (or (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-spam-marked)
- (memq article gnus-newsgroup-unreads)
- (memq article gnus-newsgroup-unselected)
- (memq article gnus-newsgroup-dormant))))
-
-;; Some summary mode macros.
-
-(defmacro gnus-summary-article-number ()
- "The article number of the article on the current line.
-If there isn't an article number here, then we return the current
-article number."
- '(progn
- (gnus-summary-skip-intangible)
- (or (get-text-property (point) 'gnus-number)
- (gnus-summary-last-subject))))
-
-(defmacro gnus-summary-article-header (&optional number)
- "Return the header of article NUMBER."
- `(gnus-data-header (gnus-data-find
- ,(or number '(gnus-summary-article-number)))))
-
-(defmacro gnus-summary-thread-level (&optional number)
- "Return the level of thread that starts with article NUMBER."
- `(if (and (eq gnus-summary-make-false-root 'dummy)
- (get-text-property (point) 'gnus-intangible))
- 0
- (gnus-data-level (gnus-data-find
- ,(or number '(gnus-summary-article-number))))))
-
-(defmacro gnus-summary-article-mark (&optional number)
- "Return the mark of article NUMBER."
- `(gnus-data-mark (gnus-data-find
- ,(or number '(gnus-summary-article-number)))))
-
-(defmacro gnus-summary-article-pos (&optional number)
- "Return the position of the line of article NUMBER."
- `(gnus-data-pos (gnus-data-find
- ,(or number '(gnus-summary-article-number)))))
-
-(defalias 'gnus-summary-subject-string 'gnus-summary-article-subject)
-(defmacro gnus-summary-article-subject (&optional number)
- "Return current subject string or nil if nothing."
- `(let ((headers
- ,(if number
- `(gnus-data-header (assq ,number gnus-newsgroup-data))
- '(gnus-data-header (assq (gnus-summary-article-number)
- gnus-newsgroup-data)))))
- (and headers
- (vectorp headers)
- (mail-header-subject headers))))
-
-(defmacro gnus-summary-article-score (&optional number)
- "Return current article score."
- `(or (cdr (assq ,(or number '(gnus-summary-article-number))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))
-
-(defun gnus-summary-article-children (&optional number)
- "Return a list of article numbers that are children of article NUMBER."
- (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))))
- (level (gnus-data-level (car data)))
- l children)
- (while (and (setq data (cdr data))
- (> (setq l (gnus-data-level (car data))) level))
- (and (= (1+ level) l)
- (push (gnus-data-number (car data))
- children)))
- (nreverse children)))
-
-(defun gnus-summary-article-parent (&optional number)
- "Return the article number of the parent of article NUMBER."
- (let* ((data (gnus-data-find-list (or number (gnus-summary-article-number))
- (gnus-data-list t)))
- (level (gnus-data-level (car data))))
- (if (zerop level)
- () ; This is a root.
- ;; We search until we find an article with a level less than
- ;; this one. That function has to be the parent.
- (while (and (setq data (cdr data))
- (not (< (gnus-data-level (car data)) level))))
- (and data (gnus-data-number (car data))))))
-
-(defun gnus-unread-mark-p (mark)
- "Say whether MARK is the unread mark."
- (= mark gnus-unread-mark))
-
-(defun gnus-read-mark-p (mark)
- "Say whether MARK is one of the marks that mark as read.
-This is all marks except unread, ticked, dormant, and expirable."
- (not (or (= mark gnus-unread-mark)
- (= mark gnus-ticked-mark)
- (= mark gnus-spam-mark)
- (= mark gnus-dormant-mark)
- (= mark gnus-expirable-mark))))
-
-(defmacro gnus-article-mark (number)
- "Return the MARK of article NUMBER.
-This macro should only be used when computing the mark the \"first\"
-time; i.e., when generating the summary lines. After that,
-`gnus-summary-article-mark' should be used to examine the
-marks of articles."
- `(cond
- ((memq ,number gnus-newsgroup-unsendable) gnus-unsendable-mark)
- ((memq ,number gnus-newsgroup-downloadable) gnus-downloadable-mark)
- ((memq ,number gnus-newsgroup-unreads) gnus-unread-mark)
- ((memq ,number gnus-newsgroup-marked) gnus-ticked-mark)
- ((memq ,number gnus-newsgroup-spam-marked) gnus-spam-mark)
- ((memq ,number gnus-newsgroup-dormant) gnus-dormant-mark)
- ((memq ,number gnus-newsgroup-expirable) gnus-expirable-mark)
- (t (or (cdr (assq ,number gnus-newsgroup-reads))
- gnus-ancient-mark))))
-
-;; Saving hidden threads.
-
-(defmacro gnus-save-hidden-threads (&rest forms)
- "Save hidden threads, eval FORMS, and restore the hidden threads."
- (let ((config (make-symbol "config")))
- `(let ((,config (gnus-hidden-threads-configuration)))
- (unwind-protect
- (save-excursion
- ,@forms)
- (gnus-restore-hidden-threads-configuration ,config)))))
-(put 'gnus-save-hidden-threads 'lisp-indent-function 0)
-(put 'gnus-save-hidden-threads 'edebug-form-spec '(body))
-
-(defun gnus-data-compute-positions ()
- "Compute the positions of all articles."
- (setq gnus-newsgroup-data-reverse nil)
- (let ((data gnus-newsgroup-data))
- (save-excursion
- (gnus-save-hidden-threads
- (gnus-summary-show-all-threads)
- (goto-char (point-min))
- (while data
- (while (get-text-property (point) 'gnus-intangible)
- (forward-line 1))
- (gnus-data-set-pos (car data) (+ (point) 3))
- (setq data (cdr data))
- (forward-line 1))))))
-
-(defun gnus-hidden-threads-configuration ()
- "Return the current hidden threads configuration."
- (save-excursion
- (let (config)
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (push (1- (point)) config))
- config)))
-
-(defun gnus-restore-hidden-threads-configuration (config)
- "Restore hidden threads configuration from CONFIG."
- (save-excursion
- (let (point buffer-read-only)
- (while (setq point (pop config))
- (when (and (< point (point-max))
- (goto-char point)
- (eq (char-after) ?\n))
- (subst-char-in-region point (1+ point) ?\n ?\r))))))
-
-;; Various summary mode internalish functions.
-
-(defun gnus-mouse-pick-article (e)
- (interactive "e")
- (mouse-set-point e)
- (gnus-summary-next-page nil t))
-
-(defun gnus-summary-set-display-table ()
- "Change the display table.
-Odd characters have a tendency to mess
-up nicely formatted displays - we make all possible glyphs
-display only a single character."
-
- ;; We start from the standard display table, if any.
- (let ((table (or (copy-sequence standard-display-table)
- (make-display-table)))
- (i 32))
- ;; Nix out all the control chars...
- (while (>= (setq i (1- i)) 0)
- (put-display-table i [??] table))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (put-display-table ?\n nil table)
- (put-display-table ?\r nil table)
- ;; We keep TAB as well.
- (put-display-table ?\t nil table)
- ;; We nix out any glyphs 127 through 255, or 127 through 159 in
- ;; Emacs 23 (unicode), that are not set already.
- (let ((i (if (ignore-errors (= (make-char 'latin-iso8859-1 160) 160))
- 160
- 256)))
- (while (>= (setq i (1- i)) 127)
- ;; Only modify if the entry is nil.
- (unless (get-display-table i table)
- (put-display-table i [??] table))))
- (setq buffer-display-table table)))
-
-(defun gnus-summary-set-article-display-arrow (pos)
- "Update the overlay arrow to point to line at position POS."
- (when (and gnus-summary-display-arrow
- (boundp 'overlay-arrow-position)
- (boundp 'overlay-arrow-string))
- (save-excursion
- (goto-char pos)
- (beginning-of-line)
- (unless overlay-arrow-position
- (setq overlay-arrow-position (make-marker)))
- (setq overlay-arrow-string "=>"
- overlay-arrow-position (set-marker overlay-arrow-position
- (point)
- (current-buffer))))))
-
-(defun gnus-summary-setup-buffer (group)
- "Initialize summary buffer."
- (let ((buffer (gnus-summary-buffer-name group))
- (dead-name (concat "*Dead Summary "
- (gnus-group-decoded-name group) "*")))
- ;; If a dead summary buffer exists, we kill it.
- (when (gnus-buffer-live-p dead-name)
- (gnus-kill-buffer dead-name))
- (if (get-buffer buffer)
- (progn
- (set-buffer buffer)
- (setq gnus-summary-buffer (current-buffer))
- (not gnus-newsgroup-prepared))
- ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
- (setq gnus-summary-buffer (set-buffer (gnus-get-buffer-create buffer)))
- (gnus-summary-mode group)
- (when gnus-carpal
- (gnus-carpal-setup-buffer 'summary))
- (unless gnus-single-article-buffer
- (make-local-variable 'gnus-article-buffer)
- (make-local-variable 'gnus-article-current)
- (make-local-variable 'gnus-original-article-buffer))
- (setq gnus-newsgroup-name group)
- ;; Set any local variables in the group parameters.
- (gnus-summary-set-local-parameters gnus-newsgroup-name)
- t)))
-
-(defun gnus-set-global-variables ()
- "Set the global equivalents of the buffer-local variables.
-They are set to the latest values they had. These reflect the summary
-buffer that was in action when the last article was fetched."
- (when (eq major-mode 'gnus-summary-mode)
- (setq gnus-summary-buffer (current-buffer))
- (let ((name gnus-newsgroup-name)
- (marked gnus-newsgroup-marked)
- (spam gnus-newsgroup-spam-marked)
- (unread gnus-newsgroup-unreads)
- (headers gnus-current-headers)
- (data gnus-newsgroup-data)
- (summary gnus-summary-buffer)
- (article-buffer gnus-article-buffer)
- (original gnus-original-article-buffer)
- (gac gnus-article-current)
- (reffed gnus-reffed-article-number)
- (score-file gnus-current-score-file)
- (default-charset gnus-newsgroup-charset)
- vlist)
- (let ((locals gnus-newsgroup-variables))
- (while locals
- (if (consp (car locals))
- (push (eval (caar locals)) vlist)
- (push (eval (car locals)) vlist))
- (setq locals (cdr locals)))
- (setq vlist (nreverse vlist)))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (setq gnus-newsgroup-name name
- gnus-newsgroup-marked marked
- gnus-newsgroup-spam-marked spam
- gnus-newsgroup-unreads unread
- gnus-current-headers headers
- gnus-newsgroup-data data
- gnus-article-current gac
- gnus-summary-buffer summary
- gnus-article-buffer article-buffer
- gnus-original-article-buffer original
- gnus-reffed-article-number reffed
- gnus-current-score-file score-file
- gnus-newsgroup-charset default-charset)
- (let ((locals gnus-newsgroup-variables))
- (while locals
- (if (consp (car locals))
- (set (caar locals) (pop vlist))
- (set (car locals) (pop vlist)))
- (setq locals (cdr locals))))
- ;; The article buffer also has local variables.
- (when (gnus-buffer-live-p gnus-article-buffer)
- (set-buffer gnus-article-buffer)
- (setq gnus-summary-buffer summary))))))
-
-(defun gnus-summary-article-unread-p (article)
- "Say whether ARTICLE is unread or not."
- (memq article gnus-newsgroup-unreads))
-
-(defun gnus-summary-first-article-p (&optional article)
- "Return whether ARTICLE is the first article in the buffer."
- (if (not (setq article (or article (gnus-summary-article-number))))
- nil
- (eq article (caar gnus-newsgroup-data))))
-
-(defun gnus-summary-last-article-p (&optional article)
- "Return whether ARTICLE is the last article in the buffer."
- (if (not (setq article (or article (gnus-summary-article-number))))
- ;; All non-existent numbers are the last article. :-)
- t
- (not (cdr (gnus-data-find-list article)))))
-
-(defun gnus-make-thread-indent-array (&optional n)
- (when (or n
- (progn (setq n 200) nil)
- (null gnus-thread-indent-array)
- (/= gnus-thread-indent-level gnus-thread-indent-array-level))
- (setq gnus-thread-indent-array (make-vector (1+ n) "")
- gnus-thread-indent-array-level gnus-thread-indent-level)
- (while (>= n 0)
- (aset gnus-thread-indent-array n
- (make-string (* n gnus-thread-indent-level) ? ))
- (setq n (1- n)))))
-
-(defun gnus-update-summary-mark-positions ()
- "Compute where the summary marks are to go."
- (save-excursion
- (when (gnus-buffer-exists-p gnus-summary-buffer)
- (set-buffer gnus-summary-buffer))
- (let ((spec gnus-summary-line-format-spec)
- pos)
- (save-excursion
- (gnus-set-work-buffer)
- (let ((gnus-tmp-unread ?Z)
- (gnus-replied-mark ?Z)
- (gnus-score-below-mark ?Z)
- (gnus-score-over-mark ?Z)
- (gnus-undownloaded-mark ?Z)
- (gnus-summary-line-format-spec spec)
- (gnus-newsgroup-downloadable '(0))
- (header [0 "" "" "05 Apr 2001 23:33:09 +0400" "" "" 0 0 "" nil])
- case-fold-search ignores)
- ;; Here, all marks are bound to Z.
- (gnus-summary-insert-line header
- 0 nil t gnus-tmp-unread t nil "" nil 1)
- (goto-char (point-min))
- ;; Memorize the positions of the same characters as dummy marks.
- (while (re-search-forward "[A-D]" nil t)
- (push (point) ignores))
- (erase-buffer)
- ;; We use A-D as dummy marks in order to know column positions
- ;; where marks should be inserted.
- (setq gnus-tmp-unread ?A
- gnus-replied-mark ?B
- gnus-score-below-mark ?C
- gnus-score-over-mark ?C
- gnus-undownloaded-mark ?D)
- (gnus-summary-insert-line header
- 0 nil t gnus-tmp-unread t nil "" nil 1)
- ;; Ignore characters which aren't dummy marks.
- (dolist (p ignores)
- (delete-region (goto-char (1- p)) p)
- (insert ?Z))
- (goto-char (point-min))
- (setq pos (list (cons 'unread
- (and (search-forward "A" nil t)
- (- (point) (point-min) 1)))))
- (goto-char (point-min))
- (push (cons 'replied (and (search-forward "B" nil t)
- (- (point) (point-min) 1)))
- pos)
- (goto-char (point-min))
- (push (cons 'score (and (search-forward "C" nil t)
- (- (point) (point-min) 1)))
- pos)
- (goto-char (point-min))
- (push (cons 'download (and (search-forward "D" nil t)
- (- (point) (point-min) 1)))
- pos)))
- (setq gnus-summary-mark-positions pos))))
-
-(defun gnus-summary-insert-dummy-line (gnus-tmp-subject gnus-tmp-number)
- "Insert a dummy root in the summary buffer."
- (beginning-of-line)
- (gnus-add-text-properties
- (point) (progn (eval gnus-summary-dummy-line-format-spec) (point))
- (list 'gnus-number gnus-tmp-number 'gnus-intangible gnus-tmp-number)))
-
-(defun gnus-summary-extract-address-component (from)
- (or (car (funcall gnus-extract-address-components from))
- from))
-
-(defun gnus-summary-from-or-to-or-newsgroups (header gnus-tmp-from)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- ; Is it really necessary to do this next part for each summary line?
- ; Luckily, doesn't seem to slow things down much.
- (mail-parse-ignored-charsets
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-ignored-charsets)))
- (or
- (and gnus-ignored-from-addresses
- (string-match gnus-ignored-from-addresses gnus-tmp-from)
- (let ((extra-headers (mail-header-extra header))
- to
- newsgroups)
- (cond
- ((setq to (cdr (assq 'To extra-headers)))
- (concat "-> "
- (inline
- (gnus-summary-extract-address-component
- (funcall gnus-decode-encoded-address-function to)))))
- ((setq newsgroups (cdr (assq 'Newsgroups extra-headers)))
- (concat "=> " newsgroups)))))
- (inline (gnus-summary-extract-address-component gnus-tmp-from)))))
-
-(defun gnus-summary-insert-line (gnus-tmp-header
- gnus-tmp-level gnus-tmp-current
- undownloaded gnus-tmp-unread gnus-tmp-replied
- gnus-tmp-expirable gnus-tmp-subject-or-nil
- &optional gnus-tmp-dummy gnus-tmp-score
- gnus-tmp-process)
- (if (>= gnus-tmp-level (length gnus-thread-indent-array))
- (gnus-make-thread-indent-array (max (* 2 (length gnus-thread-indent-array))
- gnus-tmp-level)))
- (let* ((gnus-tmp-indentation (aref gnus-thread-indent-array gnus-tmp-level))
- (gnus-tmp-lines (mail-header-lines gnus-tmp-header))
- (gnus-tmp-score (or gnus-tmp-score gnus-summary-default-score 0))
- (gnus-tmp-score-char
- (if (or (null gnus-summary-default-score)
- (<= (abs (- gnus-tmp-score gnus-summary-default-score))
- gnus-summary-zcore-fuzz))
- ? ;Whitespace
- (if (< gnus-tmp-score gnus-summary-default-score)
- gnus-score-below-mark gnus-score-over-mark)))
- (gnus-tmp-number (mail-header-number gnus-tmp-header))
- (gnus-tmp-replied
- (cond (gnus-tmp-process gnus-process-mark)
- ((memq gnus-tmp-current gnus-newsgroup-cached)
- gnus-cached-mark)
- (gnus-tmp-replied gnus-replied-mark)
- ((memq gnus-tmp-current gnus-newsgroup-forwarded)
- gnus-forwarded-mark)
- ((memq gnus-tmp-current gnus-newsgroup-saved)
- gnus-saved-mark)
- ((memq gnus-tmp-number gnus-newsgroup-recent)
- gnus-recent-mark)
- ((memq gnus-tmp-number gnus-newsgroup-unseen)
- gnus-unseen-mark)
- (t gnus-no-mark)))
- (gnus-tmp-downloaded
- (cond (undownloaded
- gnus-undownloaded-mark)
- (gnus-newsgroup-agentized
- gnus-downloaded-mark)
- (t
- gnus-no-mark)))
- (gnus-tmp-from (mail-header-from gnus-tmp-header))
- (gnus-tmp-name
- (cond
- ((string-match "<[^>]+> *$" gnus-tmp-from)
- (let ((beg (match-beginning 0)))
- (or (and (string-match "^\".+\"" gnus-tmp-from)
- (substring gnus-tmp-from 1 (1- (match-end 0))))
- (substring gnus-tmp-from 0 beg))))
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
- (t gnus-tmp-from)))
- (gnus-tmp-subject (mail-header-subject gnus-tmp-header))
- (gnus-tmp-opening-bracket (if gnus-tmp-dummy ?\< ?\[))
- (gnus-tmp-closing-bracket (if gnus-tmp-dummy ?\> ?\]))
- (buffer-read-only nil))
- (when (string= gnus-tmp-name "")
- (setq gnus-tmp-name gnus-tmp-from))
- (unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines -1))
- (if (= gnus-tmp-lines -1)
- (setq gnus-tmp-lines "?")
- (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number gnus-tmp-number)
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
- (forward-line 1))))
-
-(defun gnus-summary-update-line (&optional dont-update)
- "Update summary line after change."
- (when (and gnus-summary-default-score
- (not gnus-summary-inhibit-highlight))
- (let* ((gnus-summary-inhibit-highlight t) ; Prevent recursion.
- (article (gnus-summary-article-number))
- (score (gnus-summary-article-score article)))
- (unless dont-update
- (if (and gnus-summary-mark-below
- (< (gnus-summary-article-score)
- gnus-summary-mark-below))
- ;; This article has a low score, so we mark it as read.
- (when (memq article gnus-newsgroup-unreads)
- (gnus-summary-mark-article-as-read gnus-low-score-mark))
- (when (eq (gnus-summary-article-mark) gnus-low-score-mark)
- ;; This article was previously marked as read on account
- ;; of a low score, but now it has risen, so we mark it as
- ;; unread.
- (gnus-summary-mark-article-as-unread gnus-unread-mark)))
- (gnus-summary-update-mark
- (if (or (null gnus-summary-default-score)
- (<= (abs (- score gnus-summary-default-score))
- gnus-summary-zcore-fuzz))
- ? ;Whitespace
- (if (< score gnus-summary-default-score)
- gnus-score-below-mark gnus-score-over-mark))
- 'score))
- ;; Do visual highlighting.
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (gnus-run-hooks 'gnus-summary-update-hook)))))
-
-(defvar gnus-tmp-new-adopts nil)
-
-(defun gnus-summary-number-of-articles-in-thread (thread &optional level char)
- "Return the number of articles in THREAD.
-This may be 0 in some cases -- if none of the articles in
-the thread are to be displayed."
- (let* ((number
- ;; Fix by Luc Van Eycken <Luc.VanEycken@esat.kuleuven.ac.be>.
- (cond
- ((not (listp thread))
- 1)
- ((and (consp thread) (cdr thread))
- (apply
- '+ 1 (mapcar
- 'gnus-summary-number-of-articles-in-thread (cdr thread))))
- ((null thread)
- 1)
- ((memq (mail-header-number (car thread)) gnus-newsgroup-limit)
- 1)
- (t 0))))
- (when (and level (zerop level) gnus-tmp-new-adopts)
- (incf number
- (apply '+ (mapcar
- 'gnus-summary-number-of-articles-in-thread
- gnus-tmp-new-adopts))))
- (if char
- (if (> number 1) gnus-not-empty-thread-mark
- gnus-empty-thread-mark)
- number)))
-
-(defsubst gnus-summary-line-message-size (head)
- "Return pretty-printed version of message size.
-This function is intended to be used in
-`gnus-summary-line-format-alist'."
- (let ((c (or (mail-header-chars head) -1)))
- (cond ((< c 0) "n/a") ; chars not available
- ((< c (* 1000 10)) (format "%1.1fk" (/ c 1024.0)))
- ((< c (* 1000 100)) (format "%dk" (/ c 1024.0)))
- ((< c (* 1000 10000)) (format "%1.1fM" (/ c (* 1024.0 1024))))
- (t (format "%dM" (/ c (* 1024.0 1024)))))))
-
-
-(defun gnus-summary-set-local-parameters (group)
- "Go through the local params of GROUP and set all variable specs in that list."
- (let ((params (gnus-group-find-parameter group))
- (vars '(quit-config)) ; Ignore quit-config.
- elem)
- (while params
- (setq elem (car params)
- params (cdr params))
- (and (consp elem) ; Has to be a cons.
- (consp (cdr elem)) ; The cdr has to be a list.
- (symbolp (car elem)) ; Has to be a symbol in there.
- (not (memq (car elem) vars))
- (ignore-errors ; So we set it.
- (push (car elem) vars)
- (make-local-variable (car elem))
- (set (car elem) (eval (nth 1 elem))))))))
-
-(defun gnus-summary-read-group (group &optional show-all no-article
- kill-buffer no-display backward
- select-articles)
- "Start reading news in newsgroup GROUP.
-If SHOW-ALL is non-nil, already read articles are also listed.
-If NO-ARTICLE is non-nil, no article is selected initially.
-If NO-DISPLAY, don't generate a summary buffer."
- (let (result)
- (while (and group
- (null (setq result
- (let ((gnus-auto-select-next nil))
- (or (gnus-summary-read-group-1
- group show-all no-article
- kill-buffer no-display
- select-articles)
- (setq show-all nil
- select-articles nil)))))
- (eq gnus-auto-select-next 'quietly))
- (set-buffer gnus-group-buffer)
- ;; The entry function called above goes to the next
- ;; group automatically, so we go two groups back
- ;; if we are searching for the previous group.
- (when backward
- (gnus-group-prev-unread-group 2))
- (if (not (equal group (gnus-group-group-name)))
- (setq group (gnus-group-group-name))
- (setq group nil)))
- result))
-
-(defun gnus-summary-read-group-1 (group show-all no-article
- kill-buffer no-display
- &optional select-articles)
- ;; Killed foreign groups can't be entered.
- ;; (when (and (not (gnus-group-native-p group))
- ;; (not (gnus-gethash group gnus-newsrc-hashtb)))
- ;; (error "Dead non-native groups can't be entered"))
- (gnus-message 5 "Retrieving newsgroup: %s..."
- (gnus-group-decoded-name group))
- (let* ((new-group (gnus-summary-setup-buffer group))
- (quit-config (gnus-group-quit-config group))
- (did-select (and new-group (gnus-select-newsgroup
- group show-all select-articles))))
- (cond
- ;; This summary buffer exists already, so we just select it.
- ((not new-group)
- (gnus-set-global-variables)
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
- (gnus-configure-windows 'summary 'force)
- (gnus-set-mode-line 'summary)
- (gnus-summary-position-point)
- (message "")
- t)
- ;; We couldn't select this group.
- ((null did-select)
- (when (and (eq major-mode 'gnus-summary-mode)
- (not (equal (current-buffer) kill-buffer)))
- (kill-buffer (current-buffer))
- (if (not quit-config)
- (progn
- ;; Update the info -- marks might need to be removed,
- ;; for instance.
- (gnus-summary-update-info)
- (set-buffer gnus-group-buffer)
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1))
- (gnus-handle-ephemeral-exit quit-config)))
- (let ((grpinfo (gnus-get-info group)))
- (if (null (gnus-info-read grpinfo))
- (gnus-message 3 "Group %s contains no messages"
- (gnus-group-decoded-name group))
- (gnus-message 3 "Can't select group")))
- nil)
- ;; The user did a `C-g' while prompting for number of articles,
- ;; so we exit this group.
- ((eq did-select 'quit)
- (and (eq major-mode 'gnus-summary-mode)
- (not (equal (current-buffer) kill-buffer))
- (kill-buffer (current-buffer)))
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
- (if (not quit-config)
- (progn
- (set-buffer gnus-group-buffer)
- (gnus-group-jump-to-group group)
- (gnus-group-next-unread-group 1)
- (gnus-configure-windows 'group 'force))
- (gnus-handle-ephemeral-exit quit-config))
- ;; Finally signal the quit.
- (signal 'quit nil))
- ;; The group was successfully selected.
- (t
- (gnus-set-global-variables)
- ;; Save the active value in effect when the group was entered.
- (setq gnus-newsgroup-active
- (gnus-copy-sequence
- (gnus-active gnus-newsgroup-name)))
- ;; You can change the summary buffer in some way with this hook.
- (gnus-run-hooks 'gnus-select-group-hook)
- (when (memq 'summary (gnus-update-format-specifications
- nil 'summary 'summary-mode 'summary-dummy))
- ;; The format specification for the summary line was updated,
- ;; so we need to update the mark positions as well.
- (gnus-update-summary-mark-positions))
- ;; Do score processing.
- (when gnus-use-scoring
- (gnus-possibly-score-headers))
- ;; Check whether to fill in the gaps in the threads.
- (when gnus-build-sparse-threads
- (gnus-build-sparse-threads))
- ;; Find the initial limit.
- (if show-all
- (let ((gnus-newsgroup-dormant nil))
- (gnus-summary-initial-limit show-all))
- (gnus-summary-initial-limit show-all))
- ;; Generate the summary buffer.
- (unless no-display
- (gnus-summary-prepare))
- (when gnus-use-trees
- (gnus-tree-open group)
- (setq gnus-summary-highlight-line-function
- 'gnus-tree-highlight-article))
- ;; If the summary buffer is empty, but there are some low-scored
- ;; articles or some excluded dormants, we include these in the
- ;; buffer.
- (when (and (zerop (buffer-size))
- (not no-display))
- (cond (gnus-newsgroup-dormant
- (gnus-summary-limit-include-dormant))
- ((and gnus-newsgroup-scored show-all)
- (gnus-summary-limit-include-expunged t))))
- ;; Function `gnus-apply-kill-file' must be called in this hook.
- (gnus-run-hooks 'gnus-apply-kill-hook)
- (if (and (zerop (buffer-size))
- (not no-display))
- (progn
- ;; This newsgroup is empty.
- (gnus-summary-catchup-and-exit nil t)
- (gnus-message 6 "No unread news")
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
- ;; Return nil from this function.
- nil)
- ;; Hide conversation thread subtrees. We cannot do this in
- ;; gnus-summary-prepare-hook since kill processing may not
- ;; work with hidden articles.
- (gnus-summary-maybe-hide-threads)
- (when kill-buffer
- (gnus-kill-or-deaden-summary kill-buffer))
- (gnus-summary-auto-select-subject)
- ;; Show first unread article if requested.
- (if (and (not no-article)
- (not no-display)
- gnus-newsgroup-unreads
- gnus-auto-select-first)
- (progn
- (gnus-configure-windows 'summary)
- (let ((art (gnus-summary-article-number)))
- (unless (and (not gnus-plugged)
- (or (memq art gnus-newsgroup-undownloaded)
- (memq art gnus-newsgroup-downloadable)))
- (gnus-summary-goto-article art))))
- ;; Don't select any articles.
- (gnus-summary-position-point)
- (gnus-configure-windows 'summary 'force)
- (gnus-set-mode-line 'summary))
- (when (and gnus-auto-center-group
- (get-buffer-window gnus-group-buffer t))
- ;; Gotta use windows, because recenter does weird stuff if
- ;; the current buffer ain't the displayed window.
- (let ((owin (selected-window)))
- (select-window (get-buffer-window gnus-group-buffer t))
- (when (gnus-group-goto-group group)
- (recenter))
- (select-window owin)))
- ;; Mark this buffer as "prepared".
- (setq gnus-newsgroup-prepared t)
- (gnus-run-hooks 'gnus-summary-prepared-hook)
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
- t)))))
-
-(defun gnus-summary-auto-select-subject ()
- "Select the subject line on initial group entry."
- (goto-char (point-min))
- (cond
- ((eq gnus-auto-select-subject 'best)
- (gnus-summary-best-unread-subject))
- ((eq gnus-auto-select-subject 'unread)
- (gnus-summary-first-unread-subject))
- ((eq gnus-auto-select-subject 'unseen)
- (gnus-summary-first-unseen-subject))
- ((eq gnus-auto-select-subject 'unseen-or-unread)
- (gnus-summary-first-unseen-or-unread-subject))
- ((eq gnus-auto-select-subject 'first)
- ;; Do nothing.
- )
- ((functionp gnus-auto-select-subject)
- (funcall gnus-auto-select-subject))))
-
-(defun gnus-summary-prepare ()
- "Generate the summary buffer."
- (interactive)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (setq gnus-newsgroup-data nil
- gnus-newsgroup-data-reverse nil)
- (gnus-run-hooks 'gnus-summary-generate-hook)
- ;; Generate the buffer, either with threads or without.
- (when gnus-newsgroup-headers
- (gnus-summary-prepare-threads
- (if gnus-show-threads
- (gnus-sort-gathered-threads
- (funcall gnus-summary-thread-gathering-function
- (gnus-sort-threads
- (gnus-cut-threads (gnus-make-threads)))))
- ;; Unthreaded display.
- (gnus-sort-articles gnus-newsgroup-headers))))
- (setq gnus-newsgroup-data (nreverse gnus-newsgroup-data))
- ;; Call hooks for modifying summary buffer.
- (goto-char (point-min))
- (gnus-run-hooks 'gnus-summary-prepare-hook)))
-
-(defsubst gnus-general-simplify-subject (subject)
- "Simplify subject by the same rules as `gnus-gather-threads-by-subject'."
- (setq subject
- (cond
- ;; Truncate the subject.
- (gnus-simplify-subject-functions
- (gnus-map-function gnus-simplify-subject-functions subject))
- ((numberp gnus-summary-gather-subject-limit)
- (setq subject (gnus-simplify-subject-re subject))
- (if (> (length subject) gnus-summary-gather-subject-limit)
- (substring subject 0 gnus-summary-gather-subject-limit)
- subject))
- ;; Fuzzily simplify it.
- ((eq 'fuzzy gnus-summary-gather-subject-limit)
- (gnus-simplify-subject-fuzzy subject))
- ;; Just remove the leading "Re:".
- (t
- (gnus-simplify-subject-re subject))))
-
- (if (and gnus-summary-gather-exclude-subject
- (string-match gnus-summary-gather-exclude-subject subject))
- nil ; This article shouldn't be gathered
- subject))
-
-(defun gnus-summary-simplify-subject-query ()
- "Query where the respool algorithm would put this article."
- (interactive)
- (gnus-summary-select-article)
- (message (gnus-general-simplify-subject (gnus-summary-article-subject))))
-
-(defun gnus-gather-threads-by-subject (threads)
- "Gather threads by looking at Subject headers."
- (if (not gnus-summary-make-false-root)
- threads
- (let ((hashtb (gnus-make-hashtable 1024))
- (prev threads)
- (result threads)
- subject hthread whole-subject)
- (while threads
- (setq subject (gnus-general-simplify-subject
- (setq whole-subject (mail-header-subject
- (caar threads)))))
- (when subject
- (if (setq hthread (gnus-gethash subject hashtb))
- (progn
- ;; We enter a dummy root into the thread, if we
- ;; haven't done that already.
- (unless (stringp (caar hthread))
- (setcar hthread (list whole-subject (car hthread))))
- ;; We add this new gathered thread to this gathered
- ;; thread.
- (setcdr (car hthread)
- (nconc (cdar hthread) (list (car threads))))
- ;; Remove it from the list of threads.
- (setcdr prev (cdr threads))
- (setq threads prev))
- ;; Enter this thread into the hash table.
- (gnus-sethash subject
- (if gnus-summary-make-false-root-always
- (progn
- ;; If you want a dummy root above all
- ;; threads...
- (setcar threads (list whole-subject
- (car threads)))
- threads)
- threads)
- hashtb)))
- (setq prev threads)
- (setq threads (cdr threads)))
- result)))
-
-(defun gnus-gather-threads-by-references (threads)
- "Gather threads by looking at References headers."
- (let ((idhashtb (gnus-make-hashtable 1024))
- (thhashtb (gnus-make-hashtable 1024))
- (prev threads)
- (result threads)
- ids references id gthread gid entered ref)
- (while threads
- (when (setq references (mail-header-references (caar threads)))
- (setq id (mail-header-id (caar threads))
- ids (inline (gnus-split-references references))
- entered nil)
- (while (setq ref (pop ids))
- (setq ids (delete ref ids))
- (if (not (setq gid (gnus-gethash ref idhashtb)))
- (progn
- (gnus-sethash ref id idhashtb)
- (gnus-sethash id threads thhashtb))
- (setq gthread (gnus-gethash gid thhashtb))
- (unless entered
- ;; We enter a dummy root into the thread, if we
- ;; haven't done that already.
- (unless (stringp (caar gthread))
- (setcar gthread (list (mail-header-subject (caar gthread))
- (car gthread))))
- ;; We add this new gathered thread to this gathered
- ;; thread.
- (setcdr (car gthread)
- (nconc (cdar gthread) (list (car threads)))))
- ;; Add it into the thread hash table.
- (gnus-sethash id gthread thhashtb)
- (setq entered t)
- ;; Remove it from the list of threads.
- (setcdr prev (cdr threads))
- (setq threads prev))))
- (setq prev threads)
- (setq threads (cdr threads)))
- result))
-
-(defun gnus-sort-gathered-threads (threads)
- "Sort subtreads inside each gathered thread by `gnus-sort-gathered-threads-function'."
- (let ((result threads))
- (while threads
- (when (stringp (caar threads))
- (setcdr (car threads)
- (sort (cdar threads) gnus-sort-gathered-threads-function)))
- (setq threads (cdr threads)))
- result))
-
-(defun gnus-thread-loop-p (root thread)
- "Say whether ROOT is in THREAD."
- (let ((stack (list thread))
- (infloop 0)
- th)
- (while (setq thread (pop stack))
- (setq th (cdr thread))
- (while (and th
- (not (eq (caar th) root)))
- (pop th))
- (if th
- ;; We have found a loop.
- (let (ref-dep)
- (setcdr thread (delq (car th) (cdr thread)))
- (if (boundp (setq ref-dep (intern "none"
- gnus-newsgroup-dependencies)))
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (car th))))
- (set ref-dep (list nil (car th))))
- (setq infloop 1
- stack nil))
- ;; Push all the subthreads onto the stack.
- (push (cdr thread) stack)))
- infloop))
-
-(defun gnus-make-threads ()
- "Go through the dependency hashtb and find the roots. Return all threads."
- (let (threads)
- (while (catch 'infloop
- (mapatoms
- (lambda (refs)
- ;; Deal with self-referencing References loops.
- (when (and (car (symbol-value refs))
- (not (zerop
- (apply
- '+
- (mapcar
- (lambda (thread)
- (gnus-thread-loop-p
- (car (symbol-value refs)) thread))
- (cdr (symbol-value refs)))))))
- (setq threads nil)
- (throw 'infloop t))
- (unless (car (symbol-value refs))
- ;; These threads do not refer back to any other
- ;; articles, so they're roots.
- (setq threads (append (cdr (symbol-value refs)) threads))))
- gnus-newsgroup-dependencies)))
- threads))
-
-;; Build the thread tree.
-(defsubst gnus-dependencies-add-header (header dependencies force-new)
- "Enter HEADER into the DEPENDENCIES table if it is not already there.
-
-If FORCE-NEW is not nil, enter HEADER into the DEPENDENCIES table even
-if it was already present.
-
-If `gnus-summary-ignore-duplicates' is nil then duplicate Message-IDs
-will not be entered in the DEPENDENCIES table. Otherwise duplicate
-Message-IDs will be renamed to a unique Message-ID before being
-entered.
-
-Returns HEADER if it was entered in the DEPENDENCIES. Returns nil otherwise."
- (let* ((id (mail-header-id header))
- (id-dep (and id (intern id dependencies)))
- parent-id ref ref-dep ref-header replaced)
- ;; Enter this `header' in the `dependencies' table.
- (cond
- ((not id-dep)
- (setq header nil))
- ;; The first two cases do the normal part: enter a new `header'
- ;; in the `dependencies' table.
- ((not (boundp id-dep))
- (set id-dep (list header)))
- ((null (car (symbol-value id-dep)))
- (setcar (symbol-value id-dep) header))
-
- ;; From here the `header' was already present in the
- ;; `dependencies' table.
- (force-new
- ;; Overrides an existing entry;
- ;; just set the header part of the entry.
- (setcar (symbol-value id-dep) header)
- (setq replaced t))
-
- ;; Renames the existing `header' to a unique Message-ID.
- ((not gnus-summary-ignore-duplicates)
- ;; An article with this Message-ID has already been seen.
- ;; We rename the Message-ID.
- (set (setq id-dep (intern (setq id (nnmail-message-id)) dependencies))
- (list header))
- (mail-header-set-id header id))
-
- ;; The last case ignores an existing entry, except it adds any
- ;; additional Xrefs (in case the two articles came from different
- ;; servers.
- ;; Also sets `header' to `nil' meaning that the `dependencies'
- ;; table was *not* modified.
- (t
- (mail-header-set-xref
- (car (symbol-value id-dep))
- (concat (or (mail-header-xref (car (symbol-value id-dep)))
- "")
- (or (mail-header-xref header) "")))
- (setq header nil)))
-
- (when (and header (not replaced))
- ;; First check that we are not creating a References loop.
- (setq parent-id (gnus-parent-id (mail-header-references header)))
- (setq ref parent-id)
- (while (and ref
- (setq ref-dep (intern-soft ref dependencies))
- (boundp ref-dep)
- (setq ref-header (car (symbol-value ref-dep))))
- (if (string= id ref)
- ;; Yuk! This is a reference loop. Make the article be a
- ;; root article.
- (progn
- (mail-header-set-references (car (symbol-value id-dep)) "none")
- (setq ref nil)
- (setq parent-id nil))
- (setq ref (gnus-parent-id (mail-header-references ref-header)))))
- (setq ref-dep (intern (or parent-id "none") dependencies))
- (if (boundp ref-dep)
- (setcdr (symbol-value ref-dep)
- (nconc (cdr (symbol-value ref-dep))
- (list (symbol-value id-dep))))
- (set ref-dep (list nil (symbol-value id-dep)))))
- header))
-
-(defun gnus-extract-message-id-from-in-reply-to (string)
- (if (string-match "<[^>]+>" string)
- (substring string (match-beginning 0) (match-end 0))
- nil))
-
-(defun gnus-build-sparse-threads ()
- (let ((headers gnus-newsgroup-headers)
- (mail-parse-charset gnus-newsgroup-charset)
- (gnus-summary-ignore-duplicates t)
- header references generation relations
- subject child end new-child date)
- ;; First we create an alist of generations/relations, where
- ;; generations is how much we trust the relation, and the relation
- ;; is parent/child.
- (gnus-message 7 "Making sparse threads...")
- (save-excursion
- (nnheader-set-temp-buffer " *gnus sparse threads*")
- (while (setq header (pop headers))
- (when (and (setq references (mail-header-references header))
- (not (string= references "")))
- (insert references)
- (setq child (mail-header-id header)
- subject (mail-header-subject header)
- date (mail-header-date header)
- generation 0)
- (while (search-backward ">" nil t)
- (setq end (1+ (point)))
- (when (search-backward "<" nil t)
- (setq new-child (buffer-substring (point) end))
- (push (list (incf generation)
- child (setq child new-child)
- subject date)
- relations)))
- (when child
- (push (list (1+ generation) child nil subject) relations))
- (erase-buffer)))
- (kill-buffer (current-buffer)))
- ;; Sort over trustworthiness.
- (mapcar
- (lambda (relation)
- (when (gnus-dependencies-add-header
- (make-full-mail-header
- gnus-reffed-article-number
- (nth 3 relation) "" (or (nth 4 relation) "")
- (nth 1 relation)
- (or (nth 2 relation) "") 0 0 "")
- gnus-newsgroup-dependencies nil)
- (push gnus-reffed-article-number gnus-newsgroup-limit)
- (push gnus-reffed-article-number gnus-newsgroup-sparse)
- (push (cons gnus-reffed-article-number gnus-sparse-mark)
- gnus-newsgroup-reads)
- (decf gnus-reffed-article-number)))
- (sort relations 'car-less-than-car))
- (gnus-message 7 "Making sparse threads...done")))
-
-(defun gnus-build-old-threads ()
- ;; Look at all the articles that refer back to old articles, and
- ;; fetch the headers for the articles that aren't there. This will
- ;; build complete threads - if the roots haven't been expired by the
- ;; server, that is.
- (let ((mail-parse-charset gnus-newsgroup-charset)
- id heads)
- (mapatoms
- (lambda (refs)
- (when (not (car (symbol-value refs)))
- (setq heads (cdr (symbol-value refs)))
- (while heads
- (if (memq (mail-header-number (caar heads))
- gnus-newsgroup-dormant)
- (setq heads (cdr heads))
- (setq id (symbol-name refs))
- (while (and (setq id (gnus-build-get-header id))
- (not (car (gnus-id-to-thread id)))))
- (setq heads nil)))))
- gnus-newsgroup-dependencies)))
-
-(defsubst gnus-remove-odd-characters (string)
- "Translate STRING into something that doesn't contain weird characters."
- (mm-subst-char-in-string
- ?\r ?\-
- (mm-subst-char-in-string
- ?\n ?\- string)))
-
-;; This function has to be called with point after the article number
-;; on the beginning of the line.
-(defsubst gnus-nov-parse-line (number dependencies &optional force-new)
- (let ((eol (gnus-point-at-eol))
- (buffer (current-buffer))
- header references in-reply-to)
-
- ;; overview: [num subject from date id refs chars lines misc]
- (unwind-protect
- (let (x)
- (narrow-to-region (point) eol)
- (unless (eobp)
- (forward-char))
-
- (setq header
- (make-full-mail-header
- number ; number
- (condition-case () ; subject
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-word-function
- (setq x (nnheader-nov-field))))
- (error x))
- (condition-case () ; from
- (gnus-remove-odd-characters
- (funcall gnus-decode-encoded-address-function
- (setq x (nnheader-nov-field))))
- (error x))
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id) ; id
- (setq references (nnheader-nov-field)) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (unless (eobp)
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
-
- (widen))
-
- (when (and (string= references "")
- (setq in-reply-to (mail-header-extra header))
- (setq in-reply-to (cdr (assq 'In-Reply-To in-reply-to))))
- (mail-header-set-references
- header (gnus-extract-message-id-from-in-reply-to in-reply-to)))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header))
- (gnus-dependencies-add-header header dependencies force-new)))
-
-(defun gnus-build-get-header (id)
- "Look through the buffer of NOV lines and find the header to ID.
-Enter this line into the dependencies hash table, and return
-the id of the parent article (if any)."
- (let ((deps gnus-newsgroup-dependencies)
- found header)
- (prog1
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((case-fold-search nil))
- (goto-char (point-min))
- (while (and (not found)
- (search-forward id nil t))
- (beginning-of-line)
- (setq found (looking-at
- (format "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t%s"
- (regexp-quote id))))
- (or found (beginning-of-line 2)))
- (when found
- (beginning-of-line)
- (and
- (setq header (gnus-nov-parse-line
- (read (current-buffer)) deps))
- (gnus-parent-id (mail-header-references header))))))
- (when header
- (let ((number (mail-header-number header)))
- (push number gnus-newsgroup-limit)
- (push header gnus-newsgroup-headers)
- (if (memq number gnus-newsgroup-unselected)
- (progn
- (setq gnus-newsgroup-unreads
- (gnus-add-to-sorted-list gnus-newsgroup-unreads
- number))
- (setq gnus-newsgroup-unselected
- (delq number gnus-newsgroup-unselected)))
- (push number gnus-newsgroup-ancient)))))))
-
-(defun gnus-build-all-threads ()
- "Read all the headers."
- (let ((gnus-summary-ignore-duplicates t)
- (mail-parse-charset gnus-newsgroup-charset)
- (dependencies gnus-newsgroup-dependencies)
- header article)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((case-fold-search nil))
- (goto-char (point-min))
- (while (not (eobp))
- (ignore-errors
- (setq article (read (current-buffer))
- header (gnus-nov-parse-line article dependencies)))
- (when header
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (push header gnus-newsgroup-headers)
- (if (memq (setq article (mail-header-number header))
- gnus-newsgroup-unselected)
- (progn
- (setq gnus-newsgroup-unreads
- (gnus-add-to-sorted-list
- gnus-newsgroup-unreads article))
- (setq gnus-newsgroup-unselected
- (delq article gnus-newsgroup-unselected)))
- (push article gnus-newsgroup-ancient)))
- (forward-line 1)))))))
-
-(defun gnus-summary-update-article-line (article header)
- "Update the line for ARTICLE using HEADER."
- (let* ((id (mail-header-id header))
- (thread (gnus-id-to-thread id)))
- (unless thread
- (error "Article in no thread"))
- ;; Update the thread.
- (setcar thread header)
- (gnus-summary-goto-subject article)
- (let* ((datal (gnus-data-find-list article))
- (data (car datal))
- (buffer-read-only nil)
- (level (gnus-summary-thread-level)))
- (gnus-delete-line)
- (let ((inserted (- (point)
- (progn
- (gnus-summary-insert-line
- header level nil
- (memq article gnus-newsgroup-undownloaded)
- (gnus-article-mark article)
- (memq article gnus-newsgroup-replied)
- (memq article gnus-newsgroup-expirable)
- ;; Only insert the Subject string when it's different
- ;; from the previous Subject string.
- (if (and
- gnus-show-threads
- (gnus-subject-equal
- (condition-case ()
- (mail-header-subject
- (gnus-data-header
- (cadr
- (gnus-data-find-list
- article
- (gnus-data-list t)))))
- ;; Error on the side of excessive subjects.
- (error ""))
- (mail-header-subject header)))
- ""
- (mail-header-subject header))
- nil (cdr (assq article gnus-newsgroup-scored))
- (memq article gnus-newsgroup-processable))
- (point)))))
- (when (cdr datal)
- (gnus-data-update-list
- (cdr datal)
- (- (gnus-data-pos data) (gnus-data-pos (cadr datal)) inserted)))))))
-
-(defun gnus-summary-update-article (article &optional iheader)
- "Update ARTICLE in the summary buffer."
- (set-buffer gnus-summary-buffer)
- (let* ((header (gnus-summary-article-header article))
- (id (mail-header-id header))
- (data (gnus-data-find article))
- (thread (gnus-id-to-thread id))
- (references (mail-header-references header))
- (parent
- (gnus-id-to-thread
- (or (gnus-parent-id
- (when (and references
- (not (equal "" references)))
- references))
- "none")))
- (buffer-read-only nil)
- (old (car thread)))
- (when thread
- (unless iheader
- (setcar thread nil)
- (when parent
- (delq thread parent)))
- (if (gnus-summary-insert-subject id header)
- ;; Set the (possibly) new article number in the data structure.
- (gnus-data-set-number data (gnus-id-to-article id))
- (setcar thread old)
- nil))))
-
-(defun gnus-rebuild-thread (id &optional line)
- "Rebuild the thread containing ID.
-If LINE, insert the rebuilt thread starting on line LINE."
- (let ((buffer-read-only nil)
- old-pos current thread data)
- (if (not gnus-show-threads)
- (setq thread (list (car (gnus-id-to-thread id))))
- ;; Get the thread this article is part of.
- (setq thread (gnus-remove-thread id)))
- (setq old-pos (gnus-point-at-bol))
- (setq current (save-excursion
- (and (re-search-backward "[\r\n]" nil t)
- (gnus-summary-article-number))))
- ;; If this is a gathered thread, we have to go some re-gathering.
- (when (stringp (car thread))
- (let ((subject (car thread))
- roots thr)
- (setq thread (cdr thread))
- (while thread
- (unless (memq (setq thr (gnus-id-to-thread
- (gnus-root-id
- (mail-header-id (caar thread)))))
- roots)
- (push thr roots))
- (setq thread (cdr thread)))
- ;; We now have all (unique) roots.
- (if (= (length roots) 1)
- ;; All the loose roots are now one solid root.
- (setq thread (car roots))
- (setq thread (cons subject (gnus-sort-threads roots))))))
- (let (threads)
- ;; We then insert this thread into the summary buffer.
- (when line
- (goto-char (point-min))
- (forward-line (1- line)))
- (let (gnus-newsgroup-data gnus-newsgroup-threads)
- (if gnus-show-threads
- (gnus-summary-prepare-threads (gnus-cut-threads (list thread)))
- (gnus-summary-prepare-unthreaded thread))
- (setq data (nreverse gnus-newsgroup-data))
- (setq threads gnus-newsgroup-threads))
- ;; We splice the new data into the data structure.
- ;;!!! This is kinda bogus. We assume that in LINE is non-nil,
- ;;!!! then we want to insert at the beginning of the buffer.
- ;;!!! That happens to be true with Gnus now, but that may
- ;;!!! change in the future. Perhaps.
- (gnus-data-enter-list
- (if line nil current) data (- (point) old-pos))
- (setq gnus-newsgroup-threads
- (nconc threads gnus-newsgroup-threads))
- (gnus-data-compute-positions))))
-
-(defun gnus-number-to-header (number)
- "Return the header for article NUMBER."
- (let ((headers gnus-newsgroup-headers))
- (while (and headers
- (not (= number (mail-header-number (car headers)))))
- (pop headers))
- (when headers
- (car headers))))
-
-(defun gnus-parent-headers (in-headers &optional generation)
- "Return the headers of the GENERATIONeth parent of HEADERS."
- (unless generation
- (setq generation 1))
- (let ((parent t)
- (headers in-headers)
- references)
- (while (and parent
- (not (zerop generation))
- (setq references (mail-header-references headers)))
- (setq headers (if (and references
- (setq parent (gnus-parent-id references)))
- (car (gnus-id-to-thread parent))
- nil))
- (decf generation))
- (and (not (eq headers in-headers))
- headers)))
-
-(defun gnus-id-to-thread (id)
- "Return the (sub-)thread where ID appears."
- (gnus-gethash id gnus-newsgroup-dependencies))
-
-(defun gnus-id-to-article (id)
- "Return the article number of ID."
- (let ((thread (gnus-id-to-thread id)))
- (when (and thread
- (car thread))
- (mail-header-number (car thread)))))
-
-(defun gnus-id-to-header (id)
- "Return the article headers of ID."
- (car (gnus-id-to-thread id)))
-
-(defun gnus-article-displayed-root-p (article)
- "Say whether ARTICLE is a root(ish) article."
- (let ((level (gnus-summary-thread-level article))
- (refs (mail-header-references (gnus-summary-article-header article)))
- particle)
- (cond
- ((null level) nil)
- ((zerop level) t)
- ((null refs) t)
- ((null (gnus-parent-id refs)) t)
- ((and (= 1 level)
- (null (setq particle (gnus-id-to-article
- (gnus-parent-id refs))))
- (null (gnus-summary-thread-level particle)))))))
-
-(defun gnus-root-id (id)
- "Return the id of the root of the thread where ID appears."
- (let (last-id prev)
- (while (and id (setq prev (car (gnus-id-to-thread id))))
- (setq last-id id
- id (gnus-parent-id (mail-header-references prev))))
- last-id))
-
-(defun gnus-articles-in-thread (thread)
- "Return the list of articles in THREAD."
- (cons (mail-header-number (car thread))
- (apply 'nconc (mapcar 'gnus-articles-in-thread (cdr thread)))))
-
-(defun gnus-remove-thread (id &optional dont-remove)
- "Remove the thread that has ID in it."
- (let (headers thread last-id)
- ;; First go up in this thread until we find the root.
- (setq last-id (gnus-root-id id)
- headers (message-flatten-list (gnus-id-to-thread last-id)))
- ;; We have now found the real root of this thread. It might have
- ;; been gathered into some loose thread, so we have to search
- ;; through the threads to find the thread we wanted.
- (let ((threads gnus-newsgroup-threads)
- sub)
- (while threads
- (setq sub (car threads))
- (if (stringp (car sub))
- ;; This is a gathered thread, so we look at the roots
- ;; below it to find whether this article is in this
- ;; gathered root.
- (progn
- (setq sub (cdr sub))
- (while sub
- (when (member (caar sub) headers)
- (setq thread (car threads)
- threads nil
- sub nil))
- (setq sub (cdr sub))))
- ;; It's an ordinary thread, so we check it.
- (when (eq (car sub) (car headers))
- (setq thread sub
- threads nil)))
- (setq threads (cdr threads)))
- ;; If this article is in no thread, then it's a root.
- (if thread
- (unless dont-remove
- (setq gnus-newsgroup-threads (delq thread gnus-newsgroup-threads)))
- (setq thread (gnus-id-to-thread last-id)))
- (when thread
- (prog1
- thread ; We return this thread.
- (unless dont-remove
- (if (stringp (car thread))
- (progn
- ;; If we use dummy roots, then we have to remove the
- ;; dummy root as well.
- (when (eq gnus-summary-make-false-root 'dummy)
- ;; We go to the dummy root by going to
- ;; the first sub-"thread", and then one line up.
- (gnus-summary-goto-article
- (mail-header-number (caadr thread)))
- (forward-line -1)
- (gnus-delete-line)
- (gnus-data-compute-positions))
- (setq thread (cdr thread))
- (while thread
- (gnus-remove-thread-1 (car thread))
- (setq thread (cdr thread))))
- (gnus-remove-thread-1 thread))))))))
-
-(defun gnus-remove-thread-1 (thread)
- "Remove the thread THREAD recursively."
- (let ((number (mail-header-number (pop thread)))
- d)
- (setq thread (reverse thread))
- (while thread
- (gnus-remove-thread-1 (pop thread)))
- (when (setq d (gnus-data-find number))
- (goto-char (gnus-data-pos d))
- (gnus-summary-show-thread)
- (gnus-data-remove
- number
- (- (gnus-point-at-bol)
- (prog1
- (1+ (gnus-point-at-eol))
- (gnus-delete-line)))))))
-
-(defun gnus-sort-threads-recursive (threads func)
- (sort (mapcar (lambda (thread)
- (cons (car thread)
- (and (cdr thread)
- (gnus-sort-threads-recursive (cdr thread) func))))
- threads) func))
-
-(defun gnus-sort-threads-loop (threads func)
- (let* ((superthread (cons nil threads))
- (stack (list (cons superthread threads)))
- remaining-threads thread)
- (while stack
- (setq remaining-threads (cdr (car stack)))
- (if remaining-threads
- (progn (setq thread (car remaining-threads))
- (setcdr (car stack) (cdr remaining-threads))
- (if (cdr thread)
- (push (cons thread (cdr thread)) stack)))
- (setq thread (caar stack))
- (setcdr thread (sort (cdr thread) func))
- (pop stack)))
- (cdr superthread)))
-
-(defun gnus-sort-threads (threads)
- "Sort THREADS."
- (if (not gnus-thread-sort-functions)
- threads
- (gnus-message 8 "Sorting threads...")
- (prog1
- (condition-case nil
- (let ((max-lisp-eval-depth (max max-lisp-eval-depth 5000)))
- (gnus-sort-threads-recursive
- threads (gnus-make-sort-function gnus-thread-sort-functions)))
- ;; Even after binding max-lisp-eval-depth, the recursive
- ;; sorter might fail for very long threads. In that case,
- ;; try using a (less well-tested) non-recursive sorter.
- (error (gnus-sort-threads-loop
- threads (gnus-make-sort-function
- gnus-thread-sort-functions))))
- (gnus-message 8 "Sorting threads...done"))))
-
-(defun gnus-sort-articles (articles)
- "Sort ARTICLES."
- (when gnus-article-sort-functions
- (gnus-message 7 "Sorting articles...")
- (prog1
- (setq gnus-newsgroup-headers
- (sort articles (gnus-make-sort-function
- gnus-article-sort-functions)))
- (gnus-message 7 "Sorting articles...done"))))
-
-;; Written by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(defmacro gnus-thread-header (thread)
- "Return header of first article in THREAD.
-Note that THREAD must never, ever be anything else than a variable -
-using some other form will lead to serious barfage."
- (or (symbolp thread) (signal 'wrong-type-argument '(symbolp thread)))
- ;; (8% speedup to gnus-summary-prepare, just for fun :-)
- (list 'byte-code "\10\211:\203\17\0\211@;\203\16\0A@@\207"
- (vector thread) 2))
-
-(defsubst gnus-article-sort-by-number (h1 h2)
- "Sort articles by article number."
- (< (mail-header-number h1)
- (mail-header-number h2)))
-
-(defun gnus-thread-sort-by-number (h1 h2)
- "Sort threads by root article number."
- (gnus-article-sort-by-number
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-random (h1 h2)
- "Sort articles randomly."
- (zerop (random 2)))
-
-(defun gnus-thread-sort-by-random (h1 h2)
- "Sort threads randomly."
- (gnus-article-sort-by-random
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-lines (h1 h2)
- "Sort articles by article Lines header."
- (< (mail-header-lines h1)
- (mail-header-lines h2)))
-
-(defun gnus-thread-sort-by-lines (h1 h2)
- "Sort threads by root article Lines header."
- (gnus-article-sort-by-lines
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-chars (h1 h2)
- "Sort articles by octet length."
- (< (mail-header-chars h1)
- (mail-header-chars h2)))
-
-(defun gnus-thread-sort-by-chars (h1 h2)
- "Sort threads by root article octet length."
- (gnus-article-sort-by-chars
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-author (h1 h2)
- "Sort articles by root author."
- (gnus-string<
- (let ((extract (funcall
- gnus-extract-address-components
- (mail-header-from h1))))
- (or (car extract) (cadr extract) ""))
- (let ((extract (funcall
- gnus-extract-address-components
- (mail-header-from h2))))
- (or (car extract) (cadr extract) ""))))
-
-(defun gnus-thread-sort-by-author (h1 h2)
- "Sort threads by root author."
- (gnus-article-sort-by-author
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-subject (h1 h2)
- "Sort articles by root subject."
- (gnus-string<
- (downcase (gnus-simplify-subject-re (mail-header-subject h1)))
- (downcase (gnus-simplify-subject-re (mail-header-subject h2)))))
-
-(defun gnus-thread-sort-by-subject (h1 h2)
- "Sort threads by root subject."
- (gnus-article-sort-by-subject
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-date (h1 h2)
- "Sort articles by root article date."
- (time-less-p
- (gnus-date-get-time (mail-header-date h1))
- (gnus-date-get-time (mail-header-date h2))))
-
-(defun gnus-thread-sort-by-date (h1 h2)
- "Sort threads by root article date."
- (gnus-article-sort-by-date
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defsubst gnus-article-sort-by-score (h1 h2)
- "Sort articles by root article score.
-Unscored articles will be counted as having a score of zero."
- (> (or (cdr (assq (mail-header-number h1)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- (or (cdr (assq (mail-header-number h2)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)))
-
-(defun gnus-thread-sort-by-score (h1 h2)
- "Sort threads by root article score."
- (gnus-article-sort-by-score
- (gnus-thread-header h1) (gnus-thread-header h2)))
-
-(defun gnus-thread-sort-by-total-score (h1 h2)
- "Sort threads by the sum of all scores in the thread.
-Unscored articles will be counted as having a score of zero."
- (> (gnus-thread-total-score h1) (gnus-thread-total-score h2)))
-
-(defun gnus-thread-total-score (thread)
- ;; This function find the total score of THREAD.
- (cond
- ((null thread)
- 0)
- ((consp thread)
- (if (stringp (car thread))
- (apply gnus-thread-score-function 0
- (mapcar 'gnus-thread-total-score-1 (cdr thread)))
- (gnus-thread-total-score-1 thread)))
- (t
- (gnus-thread-total-score-1 (list thread)))))
-
-(defun gnus-thread-sort-by-most-recent-number (h1 h2)
- "Sort threads such that the thread with the most recently arrived article comes first."
- (> (gnus-thread-highest-number h1) (gnus-thread-highest-number h2)))
-
-(defun gnus-thread-highest-number (thread)
- "Return the highest article number in THREAD."
- (apply 'max (mapcar (lambda (header)
- (mail-header-number header))
- (message-flatten-list thread))))
-
-(defun gnus-thread-sort-by-most-recent-date (h1 h2)
- "Sort threads such that the thread with the most recently dated article comes first."
- (> (gnus-thread-latest-date h1) (gnus-thread-latest-date h2)))
-
-(defun gnus-thread-latest-date (thread)
- "Return the highest article date in THREAD."
- (let ((previous-time 0))
- (apply 'max
- (mapcar
- (lambda (header)
- (setq previous-time
- (condition-case ()
- (time-to-seconds (mail-header-parse-date
- (mail-header-date header)))
- (error previous-time))))
- (sort
- (message-flatten-list thread)
- (lambda (h1 h2)
- (< (mail-header-number h1)
- (mail-header-number h2))))))))
-
-(defun gnus-thread-total-score-1 (root)
- ;; This function find the total score of the thread below ROOT.
- (setq root (car root))
- (apply gnus-thread-score-function
- (or (append
- (mapcar 'gnus-thread-total-score
- (cdr (gnus-id-to-thread (mail-header-id root))))
- (when (> (mail-header-number root) 0)
- (list (or (cdr (assq (mail-header-number root)
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))))
- (list gnus-summary-default-score)
- '(0))))
-
-;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defvar gnus-tmp-prev-subject nil)
-(defvar gnus-tmp-false-parent nil)
-(defvar gnus-tmp-root-expunged nil)
-(defvar gnus-tmp-dummy-line nil)
-
-(eval-when-compile (defvar gnus-tmp-header))
-(defun gnus-extra-header (type &optional header)
- "Return the extra header of TYPE."
- (or (cdr (assq type (mail-header-extra (or header gnus-tmp-header))))
- ""))
-
-(defvar gnus-tmp-thread-tree-header-string "")
-
-(defcustom gnus-sum-thread-tree-root "> "
- "With %B spec, used for the root of a thread.
-If nil, use subject instead."
- :version "22.1"
- :type '(radio (const :format "%v " nil) string)
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-false-root "> "
- "With %B spec, used for a false root of a thread.
-If nil, use subject instead."
- :version "22.1"
- :type '(radio (const :format "%v " nil) string)
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-single-indent ""
- "With %B spec, used for a thread with just one message.
-If nil, use subject instead."
- :version "22.1"
- :type '(radio (const :format "%v " nil) string)
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-vertical "| "
- "With %B spec, used for drawing a vertical line."
- :version "22.1"
- :type 'string
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-indent " "
- "With %B spec, used for indenting."
- :version "22.1"
- :type 'string
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-leaf-with-other "+-> "
- "With %B spec, used for a leaf with brothers."
- :version "22.1"
- :type 'string
- :group 'gnus-thread)
-(defcustom gnus-sum-thread-tree-single-leaf "\\-> "
- "With %B spec, used for a leaf without brothers."
- :version "22.1"
- :type 'string
- :group 'gnus-thread)
-
-(defun gnus-summary-prepare-threads (threads)
- "Prepare summary buffer from THREADS and indentation LEVEL.
-THREADS is either a list of `(PARENT [(CHILD1 [(GRANDCHILD ...]...) ...])'
-or a straight list of headers."
- (gnus-message 7 "Generating summary...")
-
- (setq gnus-newsgroup-threads threads)
- (beginning-of-line)
-
- (let ((gnus-tmp-level 0)
- (default-score (or gnus-summary-default-score 0))
- (gnus-visual-p (gnus-visual-p 'summary-highlight 'highlight))
- (building-line-count gnus-summary-display-while-building)
- (building-count (integerp gnus-summary-display-while-building))
- thread number subject stack state gnus-tmp-gathered beg-match
- new-roots gnus-tmp-new-adopts thread-end simp-subject
- gnus-tmp-header gnus-tmp-unread gnus-tmp-downloaded
- gnus-tmp-replied gnus-tmp-subject-or-nil
- gnus-tmp-dummy gnus-tmp-indentation gnus-tmp-lines gnus-tmp-score
- gnus-tmp-score-char gnus-tmp-from gnus-tmp-name
- gnus-tmp-number gnus-tmp-opening-bracket gnus-tmp-closing-bracket
- tree-stack)
-
- (setq gnus-tmp-prev-subject nil
- gnus-tmp-thread-tree-header-string "")
-
- (if (vectorp (car threads))
- ;; If this is a straight (sic) list of headers, then a
- ;; threaded summary display isn't required, so we just create
- ;; an unthreaded one.
- (gnus-summary-prepare-unthreaded threads)
-
- ;; Do the threaded display.
-
- (if gnus-summary-display-while-building
- (switch-to-buffer (buffer-name)))
- (while (or threads stack gnus-tmp-new-adopts new-roots)
-
- (if (and (= gnus-tmp-level 0)
- (or (not stack)
- (= (caar stack) 0))
- (not gnus-tmp-false-parent)
- (or gnus-tmp-new-adopts new-roots))
- (if gnus-tmp-new-adopts
- (setq gnus-tmp-level (if gnus-tmp-root-expunged 0 1)
- thread (list (car gnus-tmp-new-adopts))
- gnus-tmp-header (caar thread)
- gnus-tmp-new-adopts (cdr gnus-tmp-new-adopts))
- (when new-roots
- (setq thread (list (car new-roots))
- gnus-tmp-header (caar thread)
- new-roots (cdr new-roots))))
-
- (if threads
- ;; If there are some threads, we do them before the
- ;; threads on the stack.
- (setq thread threads
- gnus-tmp-header (caar thread))
- ;; There were no current threads, so we pop something off
- ;; the stack.
- (setq state (car stack)
- gnus-tmp-level (car state)
- tree-stack (cadr state)
- thread (caddr state)
- stack (cdr stack)
- gnus-tmp-header (caar thread))))
-
- (setq gnus-tmp-false-parent nil)
- (setq gnus-tmp-root-expunged nil)
- (setq thread-end nil)
-
- (if (stringp gnus-tmp-header)
- ;; The header is a dummy root.
- (cond
- ((eq gnus-summary-make-false-root 'adopt)
- ;; We let the first article adopt the rest.
- (setq gnus-tmp-new-adopts (nconc gnus-tmp-new-adopts
- (cddar thread)))
- (setq gnus-tmp-gathered
- (nconc (mapcar
- (lambda (h) (mail-header-number (car h)))
- (cddar thread))
- gnus-tmp-gathered))
- (setq thread (cons (list (caar thread)
- (cadar thread))
- (cdr thread)))
- (setq gnus-tmp-level -1
- gnus-tmp-false-parent t))
- ((eq gnus-summary-make-false-root 'empty)
- ;; We print adopted articles with empty subject fields.
- (setq gnus-tmp-gathered
- (nconc (mapcar
- (lambda (h) (mail-header-number (car h)))
- (cddar thread))
- gnus-tmp-gathered))
- (setq gnus-tmp-level -1))
- ((eq gnus-summary-make-false-root 'dummy)
- ;; We remember that we probably want to output a dummy
- ;; root.
- (setq gnus-tmp-dummy-line gnus-tmp-header)
- (setq gnus-tmp-prev-subject gnus-tmp-header))
- (t
- ;; We do not make a root for the gathered
- ;; sub-threads at all.
- (setq gnus-tmp-level -1)))
-
- (setq number (mail-header-number gnus-tmp-header)
- subject (mail-header-subject gnus-tmp-header)
- simp-subject (gnus-simplify-subject-fully subject))
-
- (cond
- ;; If the thread has changed subject, we might want to make
- ;; this subthread into a root.
- ((and (null gnus-thread-ignore-subject)
- (not (zerop gnus-tmp-level))
- gnus-tmp-prev-subject
- (not (string= gnus-tmp-prev-subject simp-subject)))
- (setq new-roots (nconc new-roots (list (car thread)))
- thread-end t
- gnus-tmp-header nil))
- ;; If the article lies outside the current limit,
- ;; then we do not display it.
- ((not (memq number gnus-newsgroup-limit))
- (setq gnus-tmp-gathered
- (nconc (mapcar
- (lambda (h) (mail-header-number (car h)))
- (cdar thread))
- gnus-tmp-gathered))
- (setq gnus-tmp-new-adopts (if (cdar thread)
- (append gnus-tmp-new-adopts
- (cdar thread))
- gnus-tmp-new-adopts)
- thread-end t
- gnus-tmp-header nil)
- (when (zerop gnus-tmp-level)
- (setq gnus-tmp-root-expunged t)))
- ;; Perhaps this article is to be marked as read?
- ((and gnus-summary-mark-below
- (< (or (cdr (assq number gnus-newsgroup-scored))
- default-score)
- gnus-summary-mark-below)
- ;; Don't touch sparse articles.
- (not (gnus-summary-article-sparse-p number))
- (not (gnus-summary-article-ancient-p number)))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- (if gnus-newsgroup-auto-expire
- (setq gnus-newsgroup-expirable
- (gnus-add-to-sorted-list
- gnus-newsgroup-expirable number))
- (push (cons number gnus-low-score-mark)
- gnus-newsgroup-reads))))
-
- (when gnus-tmp-header
- ;; We may have an old dummy line to output before this
- ;; article.
- (when (and gnus-tmp-dummy-line
- (gnus-subject-equal
- gnus-tmp-dummy-line
- (mail-header-subject gnus-tmp-header)))
- (gnus-summary-insert-dummy-line
- gnus-tmp-dummy-line (mail-header-number gnus-tmp-header))
- (setq gnus-tmp-dummy-line nil))
-
- ;; Compute the mark.
- (setq gnus-tmp-unread (gnus-article-mark number))
-
- (push (gnus-data-make number gnus-tmp-unread (1+ (point))
- gnus-tmp-header gnus-tmp-level)
- gnus-newsgroup-data)
-
- ;; Actually insert the line.
- (setq
- gnus-tmp-subject-or-nil
- (cond
- ((and gnus-thread-ignore-subject
- gnus-tmp-prev-subject
- (not (string= gnus-tmp-prev-subject simp-subject)))
- subject)
- ((zerop gnus-tmp-level)
- (if (and (eq gnus-summary-make-false-root 'empty)
- (memq number gnus-tmp-gathered)
- gnus-tmp-prev-subject
- (string= gnus-tmp-prev-subject simp-subject))
- gnus-summary-same-subject
- subject))
- (t gnus-summary-same-subject)))
- (if (and (eq gnus-summary-make-false-root 'adopt)
- (= gnus-tmp-level 1)
- (memq number gnus-tmp-gathered))
- (setq gnus-tmp-opening-bracket ?\<
- gnus-tmp-closing-bracket ?\>)
- (setq gnus-tmp-opening-bracket ?\[
- gnus-tmp-closing-bracket ?\]))
- (if (>= gnus-tmp-level (length gnus-thread-indent-array))
- (gnus-make-thread-indent-array
- (max (* 2 (length gnus-thread-indent-array))
- gnus-tmp-level)))
- (setq
- gnus-tmp-indentation
- (aref gnus-thread-indent-array gnus-tmp-level)
- gnus-tmp-lines (mail-header-lines gnus-tmp-header)
- gnus-tmp-score (or (cdr (assq number gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-tmp-score-char
- (if (or (null gnus-summary-default-score)
- (<= (abs (- gnus-tmp-score gnus-summary-default-score))
- gnus-summary-zcore-fuzz))
- ? ;Whitespace
- (if (< gnus-tmp-score gnus-summary-default-score)
- gnus-score-below-mark gnus-score-over-mark))
- gnus-tmp-replied
- (cond ((memq number gnus-newsgroup-processable)
- gnus-process-mark)
- ((memq number gnus-newsgroup-cached)
- gnus-cached-mark)
- ((memq number gnus-newsgroup-replied)
- gnus-replied-mark)
- ((memq number gnus-newsgroup-forwarded)
- gnus-forwarded-mark)
- ((memq number gnus-newsgroup-saved)
- gnus-saved-mark)
- ((memq number gnus-newsgroup-recent)
- gnus-recent-mark)
- ((memq number gnus-newsgroup-unseen)
- gnus-unseen-mark)
- (t gnus-no-mark))
- gnus-tmp-downloaded
- (cond ((memq number gnus-newsgroup-undownloaded)
- gnus-undownloaded-mark)
- (gnus-newsgroup-agentized
- gnus-downloaded-mark)
- (t
- gnus-no-mark))
- gnus-tmp-from (mail-header-from gnus-tmp-header)
- gnus-tmp-name
- (cond
- ((string-match "<[^>]+> *$" gnus-tmp-from)
- (setq beg-match (match-beginning 0))
- (or (and (string-match "^\".+\"" gnus-tmp-from)
- (substring gnus-tmp-from 1 (1- (match-end 0))))
- (substring gnus-tmp-from 0 beg-match)))
- ((string-match "(.+)" gnus-tmp-from)
- (substring gnus-tmp-from
- (1+ (match-beginning 0)) (1- (match-end 0))))
- (t gnus-tmp-from))
-
- ;; Do the %B string
- gnus-tmp-thread-tree-header-string
- (cond
- ((not gnus-show-threads) "")
- ((zerop gnus-tmp-level)
- (cond ((cdar thread)
- (or gnus-sum-thread-tree-root subject))
- (gnus-tmp-new-adopts
- (or gnus-sum-thread-tree-false-root subject))
- (t
- (or gnus-sum-thread-tree-single-indent subject))))
- (t
- (concat (apply 'concat
- (mapcar (lambda (item)
- (if (= item 1)
- gnus-sum-thread-tree-vertical
- gnus-sum-thread-tree-indent))
- (cdr (reverse tree-stack))))
- (if (nth 1 thread)
- gnus-sum-thread-tree-leaf-with-other
- gnus-sum-thread-tree-single-leaf)))))
- (when (string= gnus-tmp-name "")
- (setq gnus-tmp-name gnus-tmp-from))
- (unless (numberp gnus-tmp-lines)
- (setq gnus-tmp-lines -1))
- (if (= gnus-tmp-lines -1)
- (setq gnus-tmp-lines "?")
- (setq gnus-tmp-lines (number-to-string gnus-tmp-lines)))
- (gnus-put-text-property
- (point)
- (progn (eval gnus-summary-line-format-spec) (point))
- 'gnus-number number)
- (when gnus-visual-p
- (forward-line -1)
- (gnus-run-hooks 'gnus-summary-update-hook)
- (forward-line 1))
-
- (setq gnus-tmp-prev-subject simp-subject)))
-
- (when (nth 1 thread)
- (push (list (max 0 gnus-tmp-level)
- (copy-sequence tree-stack)
- (nthcdr 1 thread))
- stack))
- (push (if (nth 1 thread) 1 0) tree-stack)
- (incf gnus-tmp-level)
- (setq threads (if thread-end nil (cdar thread)))
- (if gnus-summary-display-while-building
- (if building-count
- (progn
- ;; use a set frequency
- (setq building-line-count (1- building-line-count))
- (when (= building-line-count 0)
- (sit-for 0)
- (setq building-line-count
- gnus-summary-display-while-building)))
- ;; always
- (sit-for 0)))
- (unless threads
- (setq gnus-tmp-level 0)))))
- (gnus-message 7 "Generating summary...done"))
-
-(defun gnus-summary-prepare-unthreaded (headers)
- "Generate an unthreaded summary buffer based on HEADERS."
- (let (header number mark)
-
- (beginning-of-line)
-
- (while headers
- ;; We may have to root out some bad articles...
- (when (memq (setq number (mail-header-number
- (setq header (pop headers))))
- gnus-newsgroup-limit)
- ;; Mark article as read when it has a low score.
- (when (and gnus-summary-mark-below
- (< (or (cdr (assq number gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- gnus-summary-mark-below)
- (not (gnus-summary-article-ancient-p number)))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- (if gnus-newsgroup-auto-expire
- (push number gnus-newsgroup-expirable)
- (push (cons number gnus-low-score-mark)
- gnus-newsgroup-reads)))
-
- (setq mark (gnus-article-mark number))
- (push (gnus-data-make number mark (1+ (point)) header 0)
- gnus-newsgroup-data)
- (gnus-summary-insert-line
- header 0 number
- (memq number gnus-newsgroup-undownloaded)
- mark (memq number gnus-newsgroup-replied)
- (memq number gnus-newsgroup-expirable)
- (mail-header-subject header) nil
- (cdr (assq number gnus-newsgroup-scored))
- (memq number gnus-newsgroup-processable))))))
-
-(defun gnus-summary-remove-list-identifiers ()
- "Remove list identifiers in `gnus-list-identifiers' from articles in the current group."
- (let ((regexp (if (consp gnus-list-identifiers)
- (mapconcat 'identity gnus-list-identifiers " *\\|")
- gnus-list-identifiers))
- changed subject)
- (when regexp
- (dolist (header gnus-newsgroup-headers)
- (setq subject (mail-header-subject header)
- changed nil)
- (while (string-match
- (concat "^\\(R[Ee]: +\\)*\\(" regexp " *\\)")
- subject)
- (setq subject
- (concat (substring subject 0 (match-beginning 2))
- (substring subject (match-end 0)))
- changed t))
- (when (and changed
- (string-match
- "^\\(\\(R[Ee]: +\\)+\\)R[Ee]: +" subject))
- (setq subject
- (concat (substring subject 0 (match-beginning 1))
- (substring subject (match-end 1)))))
- (when changed
- (mail-header-set-subject header subject))))))
-
-(defun gnus-fetch-headers (articles)
- "Fetch headers of ARTICLES."
- (let ((name (gnus-group-decoded-name gnus-newsgroup-name)))
- (gnus-message 5 "Fetching headers for %s..." name)
- (prog1
- (if (eq 'nov
- (setq gnus-headers-retrieved-by
- (gnus-retrieve-headers
- articles gnus-newsgroup-name
- ;; We might want to fetch old headers, but
- ;; not if there is only 1 article.
- (and (or (and
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers)))
- (> (length articles) 1))
- gnus-fetch-old-headers))))
- (gnus-get-newsgroup-headers-xover
- articles nil nil gnus-newsgroup-name t)
- (gnus-get-newsgroup-headers))
- (gnus-message 5 "Fetching headers for %s...done" name))))
-
-(defun gnus-select-newsgroup (group &optional read-all select-articles)
- "Select newsgroup GROUP.
-If READ-ALL is non-nil, all articles in the group are selected.
-If SELECT-ARTICLES, only select those articles from GROUP."
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
- ;;!!! Dirty hack; should be removed.
- (gnus-summary-ignore-duplicates
- (if (eq (car (gnus-find-method-for-group group)) 'nnvirtual)
- t
- gnus-summary-ignore-duplicates))
- (info (nth 2 entry))
- articles fetched-articles cached)
-
- (unless (gnus-check-server
- (set (make-local-variable 'gnus-current-select-method)
- (gnus-find-method-for-group group)))
- (error "Couldn't open server"))
-
- (or (and entry (not (eq (car entry) t))) ; Either it's active...
- (gnus-activate-group group) ; Or we can activate it...
- (progn ; Or we bug out.
- (when (equal major-mode 'gnus-summary-mode)
- (gnus-kill-buffer (current-buffer)))
- (error "Couldn't activate group %s: %s"
- (gnus-group-decoded-name group) (gnus-status-message group))))
-
- (unless (gnus-request-group group t)
- (when (equal major-mode 'gnus-summary-mode)
- (gnus-kill-buffer (current-buffer)))
- (error "Couldn't request group %s: %s"
- (gnus-group-decoded-name group) (gnus-status-message group)))
-
- (when gnus-agent
- (gnus-agent-possibly-alter-active group (gnus-active group) info)
-
- (setq gnus-summary-use-undownloaded-faces
- (gnus-agent-find-parameter
- group
- 'agent-enable-undownloaded-faces)))
-
- (setq gnus-newsgroup-name group
- gnus-newsgroup-unselected nil
- gnus-newsgroup-unreads (gnus-list-of-unread-articles group))
-
- (let ((display (gnus-group-find-parameter group 'display)))
- (setq gnus-newsgroup-display
- (cond
- ((not (zerop (or (car-safe read-all) 0)))
- ;; The user entered the group with C-u SPC/RET, let's show
- ;; all articles.
- 'gnus-not-ignore)
- ((eq display 'all)
- 'gnus-not-ignore)
- ((arrayp display)
- (gnus-summary-display-make-predicate (mapcar 'identity display)))
- ((numberp display)
- ;; The following is probably the "correct" solution, but
- ;; it makes Gnus fetch all headers and then limit the
- ;; articles (which is slow), so instead we hack the
- ;; select-articles parameter instead. -- Simon Josefsson
- ;; <jas@kth.se>
- ;;
- ;; (gnus-byte-compile
- ;; `(lambda () (> number ,(- (cdr (gnus-active group))
- ;; display)))))
- (setq select-articles
- (gnus-uncompress-range
- (cons (let ((tmp (- (cdr (gnus-active group)) display)))
- (if (> tmp 0)
- tmp
- 1))
- (cdr (gnus-active group)))))
- nil)
- (t
- nil))))
-
- (gnus-summary-setup-default-charset)
-
- ;; Kludge to avoid having cached articles nixed out in virtual groups.
- (when (gnus-virtual-group-p group)
- (setq cached gnus-newsgroup-cached))
-
- (setq gnus-newsgroup-unreads
- (gnus-sorted-ndifference
- (gnus-sorted-ndifference gnus-newsgroup-unreads
- gnus-newsgroup-marked)
- gnus-newsgroup-dormant))
-
- (setq gnus-newsgroup-processable nil)
-
- (gnus-update-read-articles group gnus-newsgroup-unreads)
-
- ;; Adjust and set lists of article marks.
- (when info
- (gnus-adjust-marked-articles info))
- (if (setq articles select-articles)
- (setq gnus-newsgroup-unselected
- (gnus-sorted-difference gnus-newsgroup-unreads articles))
- (setq articles (gnus-articles-to-read group read-all)))
-
- (cond
- ((null articles)
- ;;(gnus-message 3 "Couldn't select newsgroup -- no articles to display")
- 'quit)
- ((eq articles 0) nil)
- (t
- ;; Init the dependencies hash table.
- (setq gnus-newsgroup-dependencies
- (gnus-make-hashtable (length articles)))
- (gnus-set-global-variables)
- ;; Retrieve the headers and read them in.
-
- (setq gnus-newsgroup-headers (gnus-fetch-headers articles))
-
- ;; Kludge to avoid having cached articles nixed out in virtual groups.
- (when cached
- (setq gnus-newsgroup-cached cached))
-
- ;; Suppress duplicates?
- (when gnus-suppress-duplicates
- (gnus-dup-suppress-articles))
-
- ;; Set the initial limit.
- (setq gnus-newsgroup-limit (copy-sequence articles))
- ;; Remove canceled articles from the list of unread articles.
- (setq fetched-articles
- (mapcar (lambda (headers) (mail-header-number headers))
- gnus-newsgroup-headers))
- (setq gnus-newsgroup-articles fetched-articles)
- (setq gnus-newsgroup-unreads
- (gnus-sorted-nintersection
- gnus-newsgroup-unreads fetched-articles))
- (gnus-compute-unseen-list)
-
- ;; Removed marked articles that do not exist.
- (gnus-update-missing-marks
- (gnus-sorted-difference articles fetched-articles))
- ;; We might want to build some more threads first.
- (when (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov))
- (if (eq gnus-fetch-old-headers 'invisible)
- (gnus-build-all-threads)
- (gnus-build-old-threads)))
- ;; Let the Gnus agent mark articles as read.
- (when gnus-agent
- (gnus-agent-get-undownloaded-list))
- ;; Remove list identifiers from subject
- (when gnus-list-identifiers
- (gnus-summary-remove-list-identifiers))
- ;; Check whether auto-expire is to be done in this group.
- (setq gnus-newsgroup-auto-expire
- (gnus-group-auto-expirable-p group))
- ;; Set up the article buffer now, if necessary.
- (unless gnus-single-article-buffer
- (gnus-article-setup-buffer))
- ;; First and last article in this newsgroup.
- (when gnus-newsgroup-headers
- (setq gnus-newsgroup-begin
- (mail-header-number (car gnus-newsgroup-headers))
- gnus-newsgroup-end
- (mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
- ;; GROUP is successfully selected.
- (or gnus-newsgroup-headers t)))))
-
-(defun gnus-compute-unseen-list ()
- ;; The `seen' marks are treated specially.
- (if (not gnus-newsgroup-seen)
- (setq gnus-newsgroup-unseen gnus-newsgroup-articles)
- (setq gnus-newsgroup-unseen
- (gnus-inverse-list-range-intersection
- gnus-newsgroup-articles gnus-newsgroup-seen))))
-
-(defun gnus-summary-display-make-predicate (display)
- (require 'gnus-agent)
- (when (= (length display) 1)
- (setq display (car display)))
- (unless gnus-summary-display-cache
- (dolist (elem (append '((unread . unread)
- (read . read)
- (unseen . unseen))
- gnus-article-mark-lists))
- (push (cons (cdr elem)
- (gnus-byte-compile
- `(lambda () (gnus-article-marked-p ',(cdr elem)))))
- gnus-summary-display-cache)))
- (let ((gnus-category-predicate-alist gnus-summary-display-cache)
- (gnus-category-predicate-cache gnus-summary-display-cache))
- (gnus-get-predicate display)))
-
-;; Uses the dynamically bound `number' variable.
-(eval-when-compile
- (defvar number))
-(defun gnus-article-marked-p (type &optional article)
- (let ((article (or article number)))
- (cond
- ((eq type 'tick)
- (memq article gnus-newsgroup-marked))
- ((eq type 'spam)
- (memq article gnus-newsgroup-spam-marked))
- ((eq type 'unsend)
- (memq article gnus-newsgroup-unsendable))
- ((eq type 'undownload)
- (memq article gnus-newsgroup-undownloaded))
- ((eq type 'download)
- (memq article gnus-newsgroup-downloadable))
- ((eq type 'unread)
- (memq article gnus-newsgroup-unreads))
- ((eq type 'read)
- (memq article gnus-newsgroup-reads))
- ((eq type 'dormant)
- (memq article gnus-newsgroup-dormant) )
- ((eq type 'expire)
- (memq article gnus-newsgroup-expirable))
- ((eq type 'reply)
- (memq article gnus-newsgroup-replied))
- ((eq type 'killed)
- (memq article gnus-newsgroup-killed))
- ((eq type 'bookmark)
- (assq article gnus-newsgroup-bookmarks))
- ((eq type 'score)
- (assq article gnus-newsgroup-scored))
- ((eq type 'save)
- (memq article gnus-newsgroup-saved))
- ((eq type 'cache)
- (memq article gnus-newsgroup-cached))
- ((eq type 'forward)
- (memq article gnus-newsgroup-forwarded))
- ((eq type 'seen)
- (not (memq article gnus-newsgroup-unseen)))
- ((eq type 'recent)
- (memq article gnus-newsgroup-recent))
- (t t))))
-
-(defun gnus-articles-to-read (group &optional read-all)
- "Find out what articles the user wants to read."
- (let* ((articles
- ;; Select all articles if `read-all' is non-nil, or if there
- ;; are no unread articles.
- (if (or read-all
- (and (zerop (length gnus-newsgroup-marked))
- (zerop (length gnus-newsgroup-unreads)))
- ;; Fetch all if the predicate is non-nil.
- gnus-newsgroup-display)
- ;; We want to select the headers for all the articles in
- ;; the group, so we select either all the active
- ;; articles in the group, or (if that's nil), the
- ;; articles in the cache.
- (or
- (if gnus-newsgroup-maximum-articles
- (let ((active (gnus-active group)))
- (gnus-uncompress-range
- (cons (max (car active)
- (- (cdr active)
- gnus-newsgroup-maximum-articles
- -1))
- (cdr active))))
- (gnus-uncompress-range (gnus-active group)))
- (gnus-cache-articles-in-group group))
- ;; Select only the "normal" subset of articles.
- (gnus-sorted-nunion
- (gnus-sorted-union gnus-newsgroup-dormant gnus-newsgroup-marked)
- gnus-newsgroup-unreads)))
- (scored-list (gnus-killed-articles gnus-newsgroup-killed articles))
- (scored (length scored-list))
- (number (length articles))
- (marked (+ (length gnus-newsgroup-marked)
- (length gnus-newsgroup-dormant)))
- (select
- (cond
- ((numberp read-all)
- read-all)
- ((numberp gnus-newsgroup-display)
- gnus-newsgroup-display)
- (t
- (condition-case ()
- (cond
- ((and (or (<= scored marked) (= scored number))
- (numberp gnus-large-newsgroup)
- (> number gnus-large-newsgroup))
- (let* ((cursor-in-echo-area nil)
- (initial (gnus-parameter-large-newsgroup-initial
- gnus-newsgroup-name))
- (input
- (read-string
- (format
- "How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name)
- 35)
- (if initial "max" "default")
- number)
- (if initial
- (cons (number-to-string initial)
- 0)))))
- (if (string-match "^[ \t]*$" input) number input)))
- ((and (> scored marked) (< scored number)
- (> (- scored number) 20))
- (let ((input
- (read-string
- (format "%s %s (%d scored, %d total): "
- "How many articles from"
- (gnus-group-decoded-name group)
- scored number))))
- (if (string-match "^[ \t]*$" input)
- number input)))
- (t number))
- (quit
- (message "Quit getting the articles to read")
- nil))))))
- (setq select (if (stringp select) (string-to-number select) select))
- (if (or (null select) (zerop select))
- select
- (if (and (not (zerop scored)) (<= (abs select) scored))
- (progn
- (setq articles (sort scored-list '<))
- (setq number (length articles)))
- (setq articles (copy-sequence articles)))
-
- (when (< (abs select) number)
- (if (< select 0)
- ;; Select the N oldest articles.
- (setcdr (nthcdr (1- (abs select)) articles) nil)
- ;; Select the N most recent articles.
- (setq articles (nthcdr (- number select) articles))))
- (setq gnus-newsgroup-unselected
- (gnus-sorted-difference gnus-newsgroup-unreads articles))
- (when gnus-alter-articles-to-read-function
- (setq articles
- (sort
- (funcall gnus-alter-articles-to-read-function
- gnus-newsgroup-name articles)
- '<)))
- articles)))
-
-(defun gnus-killed-articles (killed articles)
- (let (out)
- (while articles
- (when (inline (gnus-member-of-range (car articles) killed))
- (push (car articles) out))
- (setq articles (cdr articles)))
- out))
-
-(defun gnus-uncompress-marks (marks)
- "Uncompress the mark ranges in MARKS."
- (let ((uncompressed '(score bookmark))
- out)
- (while marks
- (if (memq (caar marks) uncompressed)
- (push (car marks) out)
- (push (cons (caar marks) (gnus-uncompress-range (cdar marks))) out))
- (setq marks (cdr marks)))
- out))
-
-(defun gnus-article-mark-to-type (mark)
- "Return the type of MARK."
- (or (cadr (assq mark gnus-article-special-mark-lists))
- 'list))
-
-(defun gnus-article-unpropagatable-p (mark)
- "Return whether MARK should be propagated to back end."
- (memq mark gnus-article-unpropagated-mark-lists))
-
-(defun gnus-adjust-marked-articles (info)
- "Set all article lists and remove all marks that are no longer valid."
- (let* ((marked-lists (gnus-info-marks info))
- (active (gnus-active (gnus-info-group info)))
- (min (car active))
- (max (cdr active))
- (types gnus-article-mark-lists)
- marks var articles article mark mark-type
- bgn end)
-
- (dolist (marks marked-lists)
- (setq mark (car marks)
- mark-type (gnus-article-mark-to-type mark)
- var (intern (format "gnus-newsgroup-%s" (car (rassq mark types)))))
-
- ;; We set the variable according to the type of the marks list,
- ;; and then adjust the marks to a subset of the active articles.
- (cond
- ;; Adjust "simple" lists - compressed yet unsorted
- ((eq mark-type 'list)
- ;; Simultaneously uncompress and clip to active range
- ;; See gnus-uncompress-range for a description of possible marks
- (let (l lh)
- (if (not (cadr marks))
- (set var nil)
- (setq articles (if (numberp (cddr marks))
- (list (cdr marks))
- (cdr marks))
- lh (cons nil nil)
- l lh)
-
- (while (setq article (pop articles))
- (cond ((consp article)
- (setq bgn (max (car article) min)
- end (min (cdr article) max))
- (while (<= bgn end)
- (setq l (setcdr l (cons bgn nil))
- bgn (1+ bgn))))
- ((and (<= min article)
- (>= max article))
- (setq l (setcdr l (cons article nil))))))
- (set var (cdr lh)))))
- ;; Adjust assocs.
- ((eq mark-type 'tuple)
- (set var (setq articles (cdr marks)))
- (when (not (listp (cdr (symbol-value var))))
- (set var (list (symbol-value var))))
- (when (not (listp (cdr articles)))
- (setq articles (list articles)))
- (while articles
- (when (or (not (consp (setq article (pop articles))))
- (< (car article) min)
- (> (car article) max))
- (set var (delq article (symbol-value var))))))
- ;; Adjust ranges (sloppily).
- ((eq mark-type 'range)
- (cond
- ((eq mark 'seen)
- ;; Fix the record for `seen' if it looks like (seen NUM1 . NUM2).
- ;; It should be (seen (NUM1 . NUM2)).
- (when (numberp (cddr marks))
- (setcdr marks (list (cdr marks))))
- (setq articles (cdr marks))
- (while (and articles
- (or (and (consp (car articles))
- (> min (cdar articles)))
- (and (numberp (car articles))
- (> min (car articles)))))
- (pop articles))
- (set var articles))))))))
-
-(defun gnus-update-missing-marks (missing)
- "Go through the list of MISSING articles and remove them from the mark lists."
- (when missing
- (let (var m)
- ;; Go through all types.
- (dolist (elem gnus-article-mark-lists)
- (when (eq (gnus-article-mark-to-type (cdr elem)) 'list)
- (setq var (intern (format "gnus-newsgroup-%s" (car elem))))
- (when (symbol-value var)
- ;; This list has articles. So we delete all missing
- ;; articles from it.
- (setq m missing)
- (while m
- (set var (delq (pop m) (symbol-value var))))))))))
-
-(defun gnus-update-marks ()
- "Enter the various lists of marked articles into the newsgroup info list."
- (let ((types gnus-article-mark-lists)
- (info (gnus-get-info gnus-newsgroup-name))
- type list newmarked symbol delta-marks)
- (when info
- ;; Add all marks lists to the list of marks lists.
- (while (setq type (pop types))
- (setq list (symbol-value
- (setq symbol
- (intern (format "gnus-newsgroup-%s" (car type))))))
-
- (when list
- ;; Get rid of the entries of the articles that have the
- ;; default score.
- (when (and (eq (cdr type) 'score)
- gnus-save-score
- list)
- (let* ((arts list)
- (prev (cons nil list))
- (all prev))
- (while arts
- (if (or (not (consp (car arts)))
- (= (cdar arts) gnus-summary-default-score))
- (setcdr prev (cdr arts))
- (setq prev arts))
- (setq arts (cdr arts)))
- (setq list (cdr all)))))
-
- (when (eq (cdr type) 'seen)
- (setq list (gnus-range-add list gnus-newsgroup-unseen)))
-
- (when (eq (gnus-article-mark-to-type (cdr type)) 'list)
- (setq list (gnus-compress-sequence (set symbol (sort list '<)) t)))
-
- (when (and (gnus-check-backend-function
- 'request-set-mark gnus-newsgroup-name)
- (not (gnus-article-unpropagatable-p (cdr type))))
- (let* ((old (cdr (assq (cdr type) (gnus-info-marks info))))
- (del (gnus-remove-from-range (gnus-copy-sequence old) list))
- (add (gnus-remove-from-range
- (gnus-copy-sequence list) old)))
- (when add
- (push (list add 'add (list (cdr type))) delta-marks))
- (when del
- (push (list del 'del (list (cdr type))) delta-marks))))
-
- (when list
- (push (cons (cdr type) list) newmarked)))
-
- (when delta-marks
- (unless (gnus-check-group gnus-newsgroup-name)
- (error "Can't open server for %s" gnus-newsgroup-name))
- (gnus-request-set-mark gnus-newsgroup-name delta-marks))
-
- ;; Enter these new marks into the info of the group.
- (if (nthcdr 3 info)
- (setcar (nthcdr 3 info) newmarked)
- ;; Add the marks lists to the end of the info.
- (when newmarked
- (setcdr (nthcdr 2 info) (list newmarked))))
-
- ;; Cut off the end of the info if there's nothing else there.
- (let ((i 5))
- (while (and (> i 2)
- (not (nth i info)))
- (when (nthcdr (decf i) info)
- (setcdr (nthcdr i info) nil)))))))
-
-(defun gnus-set-mode-line (where)
- "Set the mode line of the article or summary buffers.
-If WHERE is `summary', the summary mode line format will be used."
- ;; Is this mode line one we keep updated?
- (when (and (memq where gnus-updated-mode-lines)
- (symbol-value
- (intern (format "gnus-%s-mode-line-format-spec" where))))
- (let (mode-string)
- (save-excursion
- ;; We evaluate this in the summary buffer since these
- ;; variables are buffer-local to that buffer.
- (set-buffer gnus-summary-buffer)
- ;; We bind all these variables that are used in the `eval' form
- ;; below.
- (let* ((mformat (symbol-value
- (intern
- (format "gnus-%s-mode-line-format-spec" where))))
- (gnus-tmp-group-name (gnus-mode-string-quote
- (gnus-group-decoded-name
- gnus-newsgroup-name)))
- (gnus-tmp-article-number (or gnus-current-article 0))
- (gnus-tmp-unread gnus-newsgroup-unreads)
- (gnus-tmp-unread-and-unticked (length gnus-newsgroup-unreads))
- (gnus-tmp-unselected (length gnus-newsgroup-unselected))
- (gnus-tmp-unread-and-unselected
- (cond ((and (zerop gnus-tmp-unread-and-unticked)
- (zerop gnus-tmp-unselected))
- "")
- ((zerop gnus-tmp-unselected)
- (format "{%d more}" gnus-tmp-unread-and-unticked))
- (t (format "{%d(+%d) more}"
- gnus-tmp-unread-and-unticked
- gnus-tmp-unselected))))
- (gnus-tmp-subject
- (if (and gnus-current-headers
- (vectorp gnus-current-headers))
- (gnus-mode-string-quote
- (mail-header-subject gnus-current-headers))
- ""))
- bufname-length max-len
- gnus-tmp-header) ;; passed as argument to any user-format-funcs
- (setq mode-string (eval mformat))
- (setq bufname-length (if (string-match "%b" mode-string)
- (- (length
- (buffer-name
- (if (eq where 'summary)
- nil
- (get-buffer gnus-article-buffer))))
- 2)
- 0))
- (setq max-len (max 4 (if gnus-mode-non-string-length
- (- (window-width)
- gnus-mode-non-string-length
- bufname-length)
- (length mode-string))))
- ;; We might have to chop a bit of the string off...
- (when (> (length mode-string) max-len)
- (setq mode-string
- (concat (truncate-string-to-width mode-string (- max-len 3))
- "...")))
- ;; Pad the mode string a bit.
- (setq mode-string (format (format "%%-%ds" max-len) mode-string))))
- ;; Update the mode line.
- (setq mode-line-buffer-identification
- (gnus-mode-line-buffer-identification (list mode-string)))
- (set-buffer-modified-p t))))
-
-(defun gnus-create-xref-hashtb (from-newsgroup headers unreads)
- "Go through the HEADERS list and add all Xrefs to a hash table.
-The resulting hash table is returned, or nil if no Xrefs were found."
- (let* ((virtual (gnus-virtual-group-p from-newsgroup))
- (prefix (if virtual "" (gnus-group-real-prefix from-newsgroup)))
- (xref-hashtb (gnus-make-hashtable))
- start group entry number xrefs header)
- (while headers
- (setq header (pop headers))
- (when (and (setq xrefs (mail-header-xref header))
- (not (memq (setq number (mail-header-number header))
- unreads)))
- (setq start 0)
- (while (string-match "\\([^ ]+\\)[:/]\\([0-9]+\\)" xrefs start)
- (setq start (match-end 0))
- (setq group (if prefix
- (concat prefix (substring xrefs (match-beginning 1)
- (match-end 1)))
- (substring xrefs (match-beginning 1) (match-end 1))))
- (setq number
- (string-to-number (substring xrefs (match-beginning 2)
- (match-end 2))))
- (if (setq entry (gnus-gethash group xref-hashtb))
- (setcdr entry (cons number (cdr entry)))
- (gnus-sethash group (cons number nil) xref-hashtb)))))
- (and start xref-hashtb)))
-
-(defun gnus-mark-xrefs-as-read (from-newsgroup headers unreads)
- "Look through all the headers and mark the Xrefs as read."
- (let ((virtual (gnus-virtual-group-p from-newsgroup))
- name entry info xref-hashtb idlist method nth4)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (when (setq xref-hashtb
- (gnus-create-xref-hashtb from-newsgroup headers unreads))
- (mapatoms
- (lambda (group)
- (unless (string= from-newsgroup (setq name (symbol-name group)))
- (setq idlist (symbol-value group))
- ;; Dead groups are not updated.
- (and (prog1
- (setq entry (gnus-gethash name gnus-newsrc-hashtb)
- info (nth 2 entry))
- (when (stringp (setq nth4 (gnus-info-method info)))
- (setq nth4 (gnus-server-to-method nth4))))
- ;; Only do the xrefs if the group has the same
- ;; select method as the group we have just read.
- (or (gnus-methods-equal-p
- nth4 (gnus-find-method-for-group from-newsgroup))
- virtual
- (equal nth4 (setq method (gnus-find-method-for-group
- from-newsgroup)))
- (and (equal (car nth4) (car method))
- (equal (nth 1 nth4) (nth 1 method))))
- gnus-use-cross-reference
- (or (not (eq gnus-use-cross-reference t))
- virtual
- ;; Only do cross-references on subscribed
- ;; groups, if that is what is wanted.
- (<= (gnus-info-level info) gnus-level-subscribed))
- (gnus-group-make-articles-read name idlist))))
- xref-hashtb)))))
-
-(defun gnus-compute-read-articles (group articles)
- (let* ((entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (active (gnus-active group))
- ninfo)
- (when entry
- ;; First peel off all invalid article numbers.
- (when active
- (let ((ids articles)
- id first)
- (while (setq id (pop ids))
- (when (and first (> id (cdr active)))
- ;; We'll end up in this situation in one particular
- ;; obscure situation. If you re-scan a group and get
- ;; a new article that is cross-posted to a different
- ;; group that has not been re-scanned, you might get
- ;; crossposted article that has a higher number than
- ;; Gnus believes possible. So we re-activate this
- ;; group as well. This might mean doing the
- ;; crossposting thingy will *increase* the number
- ;; of articles in some groups. Tsk, tsk.
- (setq active (or (gnus-activate-group group) active)))
- (when (or (> id (cdr active))
- (< id (car active)))
- (setq articles (delq id articles))))))
- ;; If the read list is nil, we init it.
- (if (and active
- (null (gnus-info-read info))
- (> (car active) 1))
- (setq ninfo (cons 1 (1- (car active))))
- (setq ninfo (gnus-info-read info)))
- ;; Then we add the read articles to the range.
- (gnus-add-to-range
- ninfo (setq articles (sort articles '<))))))
-
-(defun gnus-group-make-articles-read (group articles)
- "Update the info of GROUP to say that ARTICLES are read."
- (let* ((num 0)
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (active (gnus-active group))
- range)
- (when entry
- (setq range (gnus-compute-read-articles group articles))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info (gnus-active ,group))
- (gnus-request-set-mark ,group (list (list ',range 'del '(read))))
- (gnus-group-update-group ,group t))))
- ;; Add the read articles to the range.
- (gnus-info-set-read info range)
- (gnus-request-set-mark group (list (list range 'add '(read))))
- ;; Then we have to re-compute how many unread
- ;; articles there are in this group.
- (when active
- (cond
- ((not range)
- (setq num (- (1+ (cdr active)) (car active))))
- ((not (listp (cdr range)))
- (setq num (- (cdr active) (- (1+ (cdr range))
- (car range)))))
- (t
- (while range
- (if (numberp (car range))
- (setq num (1+ num))
- (setq num (+ num (- (1+ (cdar range)) (caar range)))))
- (setq range (cdr range)))
- (setq num (- (cdr active) num))))
- ;; Update the number of unread articles.
- (setcar entry num)
- ;; Update the group buffer.
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group t))))))
-
-(defvar gnus-newsgroup-none-id 0)
-
-(defun gnus-get-newsgroup-headers (&optional dependencies force-new)
- (let ((cur nntp-server-buffer)
- (dependencies
- (or dependencies
- (save-excursion (set-buffer gnus-summary-buffer)
- gnus-newsgroup-dependencies)))
- headers id end ref
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets
- (save-excursion (condition-case nil
- (set-buffer gnus-summary-buffer)
- (error))
- gnus-newsgroup-ignored-charsets)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- ;; Translate all TAB characters into SPACE characters.
- (subst-char-in-region (point-min) (point-max) ?\t ? t)
- (subst-char-in-region (point-min) (point-max) ?\r ? t)
- (ietf-drums-unfold-fws)
- (gnus-run-hooks 'gnus-parse-headers-hook)
- (let ((case-fold-search t)
- in-reply-to header p lines chars)
- (goto-char (point-min))
- ;; Search to the beginning of the next header. Error messages
- ;; do not begin with 2 or 3.
- (while (re-search-forward "^[23][0-9]+ " nil t)
- (setq id nil
- ref nil)
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and
- ;; a case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance
- ;; doesn't always go hand in hand.
- (setq
- header
- (vector
- ;; Number.
- (prog1
- (read cur)
- (end-of-line)
- (setq p (point))
- (narrow-to-region (point)
- (or (and (search-forward "\n.\n" nil t)
- (- (point) 2))
- (point))))
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (funcall gnus-decode-encoded-word-function
- (nnheader-header-value))
- "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (funcall gnus-decode-encoded-address-function
- (nnheader-header-value))
- "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (setq id (if (re-search-forward
- "^message-id: *\\(<[^\n\t> ]+>\\)" nil t)
- ;; We do it this way to make sure the Message-ID
- ;; is (somewhat) syntactically valid.
- (buffer-substring (match-beginning 1)
- (match-end 1))
- ;; If there was no message-id, we just fake one
- ;; to make subsequent routines simpler.
- (nnheader-generate-fake-message-id))))
- ;; References.
- (progn
- (goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (progn
- (setq end (point))
- (prog1
- (nnheader-header-value)
- (setq ref
- (buffer-substring
- (progn
- (end-of-line)
- (search-backward ">" end t)
- (1+ (point)))
- (progn
- (search-backward "<" end t)
- (point))))))
- ;; Get the references from the in-reply-to header if there
- ;; were no references and the in-reply-to header looks
- ;; promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^>]+>" in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- (setq ref nil))))
- ;; Chars.
- (progn
- (goto-char p)
- (if (search-forward "\nchars: " nil t)
- (if (numberp (setq chars (ignore-errors (read cur))))
- chars -1)
- -1))
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (ignore-errors (read cur))))
- lines -1)
- -1))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when gnus-extra-headers
- (let ((extra gnus-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out))))
- (when (equal id ref)
- (setq ref nil))
-
- (when gnus-alter-header-function
- (funcall gnus-alter-header-function header)
- (setq id (mail-header-id header)
- ref (gnus-parent-id (mail-header-references header))))
-
- (when (setq header
- (gnus-dependencies-add-header
- header dependencies force-new))
- (push header headers))
- (goto-char (point-max))
- (widen))
- (nreverse headers)))))
-
-;; Goes through the xover lines and returns a list of vectors
-(defun gnus-get-newsgroup-headers-xover (sequence &optional
- force-new dependencies
- group also-fetch-heads)
- "Parse the news overview data in the server buffer.
-Return a list of headers that match SEQUENCE (see
-`nntp-retrieve-headers')."
- ;; Get the Xref when the users reads the articles since most/some
- ;; NNTP servers do not include Xrefs when using XOVER.
- (setq gnus-article-internal-prepare-hook '(gnus-article-get-xrefs))
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
- (cur nntp-server-buffer)
- (dependencies (or dependencies gnus-newsgroup-dependencies))
- (allp (cond
- ((eq gnus-read-all-available-headers t)
- t)
- ((and (stringp gnus-read-all-available-headers)
- group)
- (string-match gnus-read-all-available-headers group))
- (t
- nil)))
- number headers header)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (subst-char-in-region (point-min) (point-max) ?\r ? t)
- ;; Allow the user to mangle the headers before parsing them.
- (gnus-run-hooks 'gnus-parse-headers-hook)
- (goto-char (point-min))
- (gnus-parse-without-error
- (while (and (or sequence allp)
- (not (eobp)))
- (setq number (read cur))
- (when (not allp)
- (while (and sequence
- (< (car sequence) number))
- (setq sequence (cdr sequence))))
- (when (and (or allp
- (and sequence
- (eq number (car sequence))))
- (progn
- (setq sequence (cdr sequence))
- (setq header (inline
- (gnus-nov-parse-line
- number dependencies force-new)))))
- (push header headers))
- (forward-line 1)))
- ;; A common bug in inn is that if you have posted an article and
- ;; then retrieves the active file, it will answer correctly --
- ;; the new article is included. However, a NOV entry for the
- ;; article may not have been generated yet, so this may fail.
- ;; We work around this problem by retrieving the last few
- ;; headers using HEAD.
- (if (or (not also-fetch-heads)
- (not sequence))
- ;; We (probably) got all the headers.
- (nreverse headers)
- (let ((gnus-nov-is-evil t))
- (nconc
- (nreverse headers)
- (when (eq (gnus-retrieve-headers sequence group) 'headers)
- (gnus-get-newsgroup-headers))))))))
-
-(defun gnus-article-get-xrefs ()
- "Fill in the Xref value in `gnus-current-headers', if necessary.
-This is meant to be called in `gnus-article-internal-prepare-hook'."
- (let ((headers (save-excursion (set-buffer gnus-summary-buffer)
- gnus-current-headers)))
- (or (not gnus-use-cross-reference)
- (not headers)
- (and (mail-header-xref headers)
- (not (string= (mail-header-xref headers) "")))
- (let ((case-fold-search t)
- xref)
- (save-restriction
- (nnheader-narrow-to-headers)
- (goto-char (point-min))
- (when (or (and (not (eobp))
- (eq (downcase (char-after)) ?x)
- (looking-at "Xref:"))
- (search-forward "\nXref:" nil t))
- (goto-char (1+ (match-end 0)))
- (setq xref (buffer-substring (point) (gnus-point-at-eol)))
- (mail-header-set-xref headers xref)))))))
-
-(defun gnus-summary-insert-subject (id &optional old-header use-old-header)
- "Find article ID and insert the summary line for that article.
-OLD-HEADER can either be a header or a line number to insert
-the subject line on."
- (let* ((line (and (numberp old-header) old-header))
- (old-header (and (vectorp old-header) old-header))
- (header (cond ((and old-header use-old-header)
- old-header)
- ((and (numberp id)
- (gnus-number-to-header id))
- (gnus-number-to-header id))
- (t
- (gnus-read-header id))))
- (number (and (numberp id) id))
- d)
- (when header
- ;; Rebuild the thread that this article is part of and go to the
- ;; article we have fetched.
- (when (and (not gnus-show-threads)
- old-header)
- (when (and number
- (setq d (gnus-data-find (mail-header-number old-header))))
- (goto-char (gnus-data-pos d))
- (gnus-data-remove
- number
- (- (gnus-point-at-bol)
- (prog1
- (1+ (gnus-point-at-eol))
- (gnus-delete-line))))))
- ;; Remove list identifiers from subject.
- (when gnus-list-identifiers
- (let ((gnus-newsgroup-headers (list header)))
- (gnus-summary-remove-list-identifiers)))
- (when old-header
- (mail-header-set-number header (mail-header-number old-header)))
- (setq gnus-newsgroup-sparse
- (delq (setq number (mail-header-number header))
- gnus-newsgroup-sparse))
- (setq gnus-newsgroup-ancient (delq number gnus-newsgroup-ancient))
- (push number gnus-newsgroup-limit)
- (gnus-rebuild-thread (mail-header-id header) line)
- (gnus-summary-goto-subject number nil t))
- (when (and (numberp number)
- (> number 0))
- ;; We have to update the boundaries even if we can't fetch the
- ;; article if ID is a number -- so that the next `P' or `N'
- ;; command will fetch the previous (or next) article even
- ;; if the one we tried to fetch this time has been canceled.
- (when (> number gnus-newsgroup-end)
- (setq gnus-newsgroup-end number))
- (when (< number gnus-newsgroup-begin)
- (setq gnus-newsgroup-begin number))
- (setq gnus-newsgroup-unselected
- (delq number gnus-newsgroup-unselected)))
- ;; Report back a success?
- (and header (mail-header-number header))))
-
-;;; Process/prefix in the summary buffer
-
-(defun gnus-summary-work-articles (n)
- "Return a list of articles to be worked upon.
-The prefix argument, the list of process marked articles, and the
-current article will be taken into consideration."
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (cond
- (n
- ;; A numerical prefix has been given.
- (setq n (prefix-numeric-value n))
- (let ((backward (< n 0))
- (n (abs (prefix-numeric-value n)))
- articles article)
- (save-excursion
- (while
- (and (> n 0)
- (push (setq article (gnus-summary-article-number))
- articles)
- (if backward
- (gnus-summary-find-prev nil article)
- (gnus-summary-find-next nil article)))
- (decf n)))
- (nreverse articles)))
- ((and (gnus-region-active-p) (mark))
- (message "region active")
- ;; Work on the region between point and mark.
- (let ((max (max (point) (mark)))
- articles article)
- (save-excursion
- (goto-char (min (point) (mark)))
- (while
- (and
- (push (setq article (gnus-summary-article-number)) articles)
- (gnus-summary-find-next nil article)
- (< (point) max)))
- (nreverse articles))))
- (gnus-newsgroup-processable
- ;; There are process-marked articles present.
- ;; Save current state.
- (gnus-summary-save-process-mark)
- ;; Return the list.
- (reverse gnus-newsgroup-processable))
- (t
- ;; Just return the current article.
- (list (gnus-summary-article-number))))))
-
-(defmacro gnus-summary-iterate (arg &rest forms)
- "Iterate over the process/prefixed articles and do FORMS.
-ARG is the interactive prefix given to the command. FORMS will be
-executed with point over the summary line of the articles."
- (let ((articles (make-symbol "gnus-summary-iterate-articles")))
- `(let ((,articles (gnus-summary-work-articles ,arg)))
- (while ,articles
- (gnus-summary-goto-subject (car ,articles))
- ,@forms
- (pop ,articles)))))
-
-(put 'gnus-summary-iterate 'lisp-indent-function 1)
-(put 'gnus-summary-iterate 'edebug-form-spec '(form body))
-
-(defun gnus-summary-save-process-mark ()
- "Push the current set of process marked articles on the stack."
- (interactive)
- (push (copy-sequence gnus-newsgroup-processable)
- gnus-newsgroup-process-stack))
-
-(defun gnus-summary-kill-process-mark ()
- "Push the current set of process marked articles on the stack and unmark."
- (interactive)
- (gnus-summary-save-process-mark)
- (gnus-summary-unmark-all-processable))
-
-(defun gnus-summary-yank-process-mark ()
- "Pop the last process mark state off the stack and restore it."
- (interactive)
- (unless gnus-newsgroup-process-stack
- (error "Empty mark stack"))
- (gnus-summary-process-mark-set (pop gnus-newsgroup-process-stack)))
-
-(defun gnus-summary-process-mark-set (set)
- "Make SET into the current process marked articles."
- (gnus-summary-unmark-all-processable)
- (while set
- (gnus-summary-set-process-mark (pop set))))
-
-;;; Searching and stuff
-
-(defun gnus-summary-search-group (&optional backward use-level)
- "Search for next unread newsgroup.
-If optional argument BACKWARD is non-nil, search backward instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (when (gnus-group-search-forward
- backward nil (if use-level (gnus-group-group-level) nil))
- (gnus-group-group-name))))
-
-(defun gnus-summary-best-group (&optional exclude-group)
- "Find the name of the best unread group.
-If EXCLUDE-GROUP, do not go to this group."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (save-excursion
- (gnus-group-best-unread-group exclude-group))))
-
-(defun gnus-summary-find-next (&optional unread article backward)
- (if backward
- (gnus-summary-find-prev unread article)
- (let* ((dummy (gnus-summary-article-intangible-p))
- (article (or article (gnus-summary-article-number)))
- (data (gnus-data-find-list article))
- result)
- (when (and (not dummy)
- (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car data)))))
- (setq data (cdr data)))
- (when (setq result
- (if unread
- (progn
- (while data
- (unless (memq (gnus-data-number (car data))
- (cond
- ((eq gnus-auto-goto-ignores
- 'always-undownloaded)
- gnus-newsgroup-undownloaded)
- (gnus-plugged
- nil)
- ((eq gnus-auto-goto-ignores
- 'unfetched)
- gnus-newsgroup-unfetched)
- ((eq gnus-auto-goto-ignores
- 'undownloaded)
- gnus-newsgroup-undownloaded)))
- (when (gnus-data-unread-p (car data))
- (setq result (car data)
- data nil)))
- (setq data (cdr data)))
- result)
- (car data)))
- (goto-char (gnus-data-pos result))
- (gnus-data-number result)))))
-
-(defun gnus-summary-find-prev (&optional unread article)
- (let* ((eobp (eobp))
- (article (or article (gnus-summary-article-number)))
- (data (gnus-data-find-list article (gnus-data-list 'rev)))
- result)
- (when (and (not eobp)
- (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car data)))))
- (setq data (cdr data)))
- (when (setq result
- (if unread
- (progn
- (while data
- (unless (memq (gnus-data-number (car data))
- (cond
- ((eq gnus-auto-goto-ignores
- 'always-undownloaded)
- gnus-newsgroup-undownloaded)
- (gnus-plugged
- nil)
- ((eq gnus-auto-goto-ignores
- 'unfetched)
- gnus-newsgroup-unfetched)
- ((eq gnus-auto-goto-ignores
- 'undownloaded)
- gnus-newsgroup-undownloaded)))
- (when (gnus-data-unread-p (car data))
- (setq result (car data)
- data nil)))
- (setq data (cdr data)))
- result)
- (car data)))
- (goto-char (gnus-data-pos result))
- (gnus-data-number result))))
-
-(defun gnus-summary-find-subject (subject &optional unread backward article)
- (let* ((simp-subject (gnus-simplify-subject-fully subject))
- (article (or article (gnus-summary-article-number)))
- (articles (gnus-data-list backward))
- (arts (gnus-data-find-list article articles))
- result)
- (when (or (not gnus-summary-check-current)
- (not unread)
- (not (gnus-data-unread-p (car arts))))
- (setq arts (cdr arts)))
- (while arts
- (and (or (not unread)
- (gnus-data-unread-p (car arts)))
- (vectorp (gnus-data-header (car arts)))
- (gnus-subject-equal
- simp-subject (mail-header-subject (gnus-data-header (car arts))) t)
- (setq result (car arts)
- arts nil))
- (setq arts (cdr arts)))
- (and result
- (goto-char (gnus-data-pos result))
- (gnus-data-number result))))
-
-(defun gnus-summary-search-forward (&optional unread subject backward)
- "Search forward for an article.
-If UNREAD, look for unread articles. If SUBJECT, look for
-articles with that subject. If BACKWARD, search backward instead."
- (cond (subject (gnus-summary-find-subject subject unread backward))
- (backward (gnus-summary-find-prev unread))
- (t (gnus-summary-find-next unread))))
-
-(defun gnus-recenter (&optional n)
- "Center point in window and redisplay frame.
-Also do horizontal recentering."
- (interactive "P")
- (when (and gnus-auto-center-summary
- (not (eq gnus-auto-center-summary 'vertical)))
- (gnus-horizontal-recenter))
- (recenter n))
-
-(defun gnus-summary-recenter ()
- "Center point in the summary window.
-If `gnus-auto-center-summary' is nil, or the article buffer isn't
-displayed, no centering will be performed."
- ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
- ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
- (interactive)
- ;; The user has to want it.
- (when gnus-auto-center-summary
- (let* ((top (cond ((< (window-height) 4) 0)
- ((< (window-height) 7) 1)
- (t (if (numberp gnus-auto-center-summary)
- gnus-auto-center-summary
- 2))))
- (height (1- (window-height)))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- (when (get-buffer-window gnus-article-buffer)
- ;; Only do recentering when the article buffer is displayed,
- ;; Set the window start to either `bottom', which is the biggest
- ;; possible valid number, or the second line from the top,
- ;; whichever is the least.
- (let ((top-pos (save-excursion (forward-line (- top)) (point))))
- (if (> bottom top-pos)
- ;; Keep the second line from the top visible
- (set-window-start window top-pos t)
- ;; Try to keep the bottom line visible; if it's partially
- ;; obscured, either scroll one more line to make it fully
- ;; visible, or revert to using TOP-POS.
- (save-excursion
- (goto-char (point-max))
- (forward-line -1)
- (let ((last-line-start (point)))
- (goto-char bottom)
- (set-window-start window (point) t)
- (when (not (pos-visible-in-window-p last-line-start window))
- (forward-line 1)
- (set-window-start window (min (point) top-pos) t)))))))
- ;; Do horizontal recentering while we're at it.
- (when (and (get-buffer-window (current-buffer) t)
- (not (eq gnus-auto-center-summary 'vertical)))
- (let ((selected (selected-window)))
- (select-window (get-buffer-window (current-buffer) t))
- (gnus-summary-position-point)
- (gnus-horizontal-recenter)
- (select-window selected))))))
-
-(defun gnus-summary-jump-to-group (newsgroup)
- "Move point to NEWSGROUP in group mode buffer."
- ;; Keep update point of group mode buffer if visible.
- (if (eq (current-buffer) (get-buffer gnus-group-buffer))
- (save-window-excursion
- ;; Take care of tree window mode.
- (when (get-buffer-window gnus-group-buffer)
- (pop-to-buffer gnus-group-buffer))
- (gnus-group-jump-to-group newsgroup))
- (save-excursion
- ;; Take care of tree window mode.
- (if (get-buffer-window gnus-group-buffer)
- (pop-to-buffer gnus-group-buffer)
- (set-buffer gnus-group-buffer))
- (gnus-group-jump-to-group newsgroup))))
-
-;; This function returns a list of article numbers based on the
-;; difference between the ranges of read articles in this group and
-;; the range of active articles.
-(defun gnus-list-of-unread-articles (group)
- (let* ((read (gnus-info-read (gnus-get-info group)))
- (active (or (gnus-active group) (gnus-activate-group group)))
- (last (cdr active))
- (bottom (if gnus-newsgroup-maximum-articles
- (max (car active)
- (- last gnus-newsgroup-maximum-articles -1))
- (car active)))
- first nlast unread)
- ;; If none are read, then all are unread.
- (if (not read)
- (setq first bottom)
- ;; If the range of read articles is a single range, then the
- ;; first unread article is the article after the last read
- ;; article. Sounds logical, doesn't it?
- (if (and (not (listp (cdr read)))
- (or (< (car read) bottom)
- (progn (setq read (list read))
- nil)))
- (setq first (max bottom (1+ (cdr read))))
- ;; `read' is a list of ranges.
- (when (/= (setq nlast (or (and (numberp (car read)) (car read))
- (caar read)))
- 1)
- (setq first bottom))
- (while read
- (when first
- (while (< first nlast)
- (setq unread (cons first unread)
- first (1+ first))))
- (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
- (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
- (setq read (cdr read)))))
- ;; And add the last unread articles.
- (while (<= first last)
- (setq unread (cons first unread)
- first (1+ first)))
- ;; Return the list of unread articles.
- (delq 0 (nreverse unread))))
-
-(defun gnus-list-of-read-articles (group)
- "Return a list of unread, unticked and non-dormant articles."
- (let* ((info (gnus-get-info group))
- (marked (gnus-info-marks info))
- (active (gnus-active group)))
- (and info active
- (gnus-list-range-difference
- (gnus-list-range-difference
- (gnus-sorted-complement
- (gnus-uncompress-range
- (if gnus-newsgroup-maximum-articles
- (cons (max (car active)
- (- (cdr active)
- gnus-newsgroup-maximum-articles
- -1))
- (cdr active))
- active))
- (gnus-list-of-unread-articles group))
- (cdr (assq 'dormant marked)))
- (cdr (assq 'tick marked))))))
-
-;; This function returns a sequence of article numbers based on the
-;; difference between the ranges of read articles in this group and
-;; the range of active articles.
-(defun gnus-sequence-of-unread-articles (group)
- (let* ((read (gnus-info-read (gnus-get-info group)))
- (active (or (gnus-active group) (gnus-activate-group group)))
- (last (cdr active))
- (bottom (if gnus-newsgroup-maximum-articles
- (max (car active)
- (- last gnus-newsgroup-maximum-articles -1))
- (car active)))
- first nlast unread)
- ;; If none are read, then all are unread.
- (if (not read)
- (setq first bottom)
- ;; If the range of read articles is a single range, then the
- ;; first unread article is the article after the last read
- ;; article. Sounds logical, doesn't it?
- (if (and (not (listp (cdr read)))
- (or (< (car read) bottom)
- (progn (setq read (list read))
- nil)))
- (setq first (max bottom (1+ (cdr read))))
- ;; `read' is a list of ranges.
- (when (/= (setq nlast (or (and (numberp (car read)) (car read))
- (caar read)))
- 1)
- (setq first bottom))
- (while read
- (when first
- (push (cons first nlast) unread))
- (setq first (1+ (if (atom (car read)) (car read) (cdar read))))
- (setq nlast (if (atom (cadr read)) (cadr read) (caadr read)))
- (setq read (cdr read)))))
- ;; And add the last unread articles.
- (cond ((not (and first last))
- nil)
- ((< first last)
- (push (cons first last) unread))
- ((= first last)
- (push first unread)))
- ;; Return the sequence of unread articles.
- (delq 0 (nreverse unread))))
-
-;; Various summary commands
-
-(defun gnus-summary-select-article-buffer ()
- "Reconfigure windows to show article buffer."
- (interactive)
- (if (not (gnus-buffer-live-p gnus-article-buffer))
- (error "There is no article buffer for this summary buffer")
- (gnus-configure-windows 'article)
- (select-window (get-buffer-window gnus-article-buffer))))
-
-(defun gnus-summary-universal-argument (arg)
- "Perform any operation on all articles that are process/prefixed."
- (interactive "P")
- (let ((articles (gnus-summary-work-articles arg))
- func article)
- (if (eq
- (setq
- func
- (key-binding
- (read-key-sequence
- (substitute-command-keys
- "\\<gnus-summary-mode-map>\\[gnus-summary-universal-argument]"))))
- 'undefined)
- (gnus-error 1 "Undefined key")
- (save-excursion
- (while articles
- (gnus-summary-goto-subject (setq article (pop articles)))
- (let (gnus-newsgroup-processable)
- (command-execute func))
- (gnus-summary-remove-process-mark article)))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-toggle-truncation (&optional arg)
- "Toggle truncation of summary lines.
-With ARG, turn line truncation on if ARG is positive."
- (interactive "P")
- (setq truncate-lines
- (if (null arg) (not truncate-lines)
- (> (prefix-numeric-value arg) 0)))
- (redraw-display))
-
-(defun gnus-summary-find-for-reselect ()
- "Return the number of an article to stay on across a reselect.
-The current article is considered, then following articles, then previous
-articles. An article is sought which is not cancelled and isn't a temporary
-insertion from another group. If there's no such then return a dummy 0."
- (let (found)
- (dolist (rev '(nil t))
- (unless found ; don't demand the reverse list if we don't need it
- (let ((data (gnus-data-find-list
- (gnus-summary-article-number) (gnus-data-list rev))))
- (while (and data (not found))
- (if (and (< 0 (gnus-data-number (car data)))
- (not (eq gnus-canceled-mark (gnus-data-mark (car data)))))
- (setq found (gnus-data-number (car data))))
- (setq data (cdr data))))))
- (or found 0)))
-
-(defun gnus-summary-reselect-current-group (&optional all rescan)
- "Exit and then reselect the current newsgroup.
-The prefix argument ALL means to select all articles."
- (interactive "P")
- (when (gnus-ephemeral-group-p gnus-newsgroup-name)
- (error "Ephemeral groups can't be reselected"))
- (let ((current-subject (gnus-summary-find-for-reselect))
- (group gnus-newsgroup-name))
- (setq gnus-newsgroup-begin nil)
- (gnus-summary-exit nil 'leave-hidden)
- ;; We have to adjust the point of group mode buffer because
- ;; point was moved to the next unread newsgroup by exiting.
- (gnus-summary-jump-to-group group)
- (when rescan
- (save-excursion
- (gnus-group-get-new-news-this-group 1)))
- (gnus-group-read-group all t)
- (gnus-summary-goto-subject current-subject nil t)))
-
-(defun gnus-summary-rescan-group (&optional all)
- "Exit the newsgroup, ask for new articles, and select the newsgroup."
- (interactive "P")
- (gnus-summary-reselect-current-group all t))
-
-(defun gnus-summary-update-info (&optional non-destructive)
- (save-excursion
- (let ((group gnus-newsgroup-name))
- (when group
- (when gnus-newsgroup-kill-headers
- (setq gnus-newsgroup-killed
- (gnus-compress-sequence
- (gnus-sorted-union
- (gnus-list-range-intersection
- gnus-newsgroup-unselected gnus-newsgroup-killed)
- gnus-newsgroup-unreads)
- t)))
- (unless (listp (cdr gnus-newsgroup-killed))
- (setq gnus-newsgroup-killed (list gnus-newsgroup-killed)))
- (let ((headers gnus-newsgroup-headers))
- ;; Set the new ranges of read articles.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-undo-force-boundary))
- (gnus-update-read-articles
- group (gnus-sorted-union
- gnus-newsgroup-unreads gnus-newsgroup-unselected))
- ;; Set the current article marks.
- (let ((gnus-newsgroup-scored
- (if (and (not gnus-save-score)
- (not non-destructive))
- nil
- gnus-newsgroup-scored)))
- (save-excursion
- (gnus-update-marks)))
- ;; Do the cross-ref thing.
- (when gnus-use-cross-reference
- (gnus-mark-xrefs-as-read group headers gnus-newsgroup-unreads))
- ;; Do not switch windows but change the buffer to work.
- (set-buffer gnus-group-buffer)
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group)))))))
-
-(defun gnus-summary-save-newsrc (&optional force)
- "Save the current number of read/marked articles in the dribble buffer.
-The dribble buffer will then be saved.
-If FORCE (the prefix), also save the .newsrc file(s)."
- (interactive "P")
- (gnus-summary-update-info t)
- (if force
- (gnus-save-newsrc-file)
- (gnus-dribble-save)))
-
-(defun gnus-summary-exit (&optional temporary leave-hidden)
- "Exit reading current newsgroup, and then return to group selection mode.
-`gnus-exit-group-hook' is called with no arguments if that value is non-nil."
- (interactive)
- (gnus-set-global-variables)
- (when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)
- ;; Set it to nil for safety reason.
- (setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-handles nil)))
- (gnus-kill-save-kill-buffer)
- (gnus-async-halt-prefetch)
- (let* ((group gnus-newsgroup-name)
- (quit-config (gnus-group-quit-config gnus-newsgroup-name))
- (gnus-group-is-exiting-p t)
- (mode major-mode)
- (group-point nil)
- (buf (current-buffer)))
- (unless quit-config
- ;; Do adaptive scoring, and possibly save score files.
- (when gnus-newsgroup-adaptive
- (gnus-score-adaptive))
- (when gnus-use-scoring
- (gnus-score-save)))
- (gnus-run-hooks 'gnus-summary-prepare-exit-hook)
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
- (when gnus-use-cache
- (gnus-cache-possibly-remove-articles)
- (gnus-cache-save-buffers))
- (gnus-async-prefetch-remove-group group)
- (when gnus-suppress-duplicates
- (gnus-dup-enter-articles))
- (when gnus-use-trees
- (gnus-tree-close group))
- (when gnus-use-cache
- (gnus-cache-write-active))
- ;; Remove entries for this group.
- (nnmail-purge-split-history (gnus-group-real-name group))
- ;; Make all changes in this group permanent.
- (unless quit-config
- (gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info))
- (gnus-close-group group)
- ;; Make sure where we were, and go to next newsgroup.
- (set-buffer gnus-group-buffer)
- (unless quit-config
- (gnus-group-jump-to-group group))
- (gnus-run-hooks 'gnus-summary-exit-hook)
- (unless (or quit-config
- ;; If this group has disappeared from the summary
- ;; buffer, don't skip forwards.
- (not (string= group (gnus-group-group-name))))
- (gnus-group-next-unread-group 1))
- (setq group-point (point))
- (if temporary
- nil ;Nothing to do.
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
- (set-buffer buf)
- (if (not gnus-kill-summary-on-exit)
- (progn
- (gnus-deaden-summary)
- (setq mode nil))
- ;; We set all buffer-local variables to nil. It is unclear why
- ;; this is needed, but if we don't, buffer-local variables are
- ;; not garbage-collected, it seems. This would the lead to en
- ;; ever-growing Emacs.
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- (when (get-buffer gnus-article-buffer)
- (bury-buffer gnus-article-buffer))
- ;; We clear the global counterparts of the buffer-local
- ;; variables as well, just to be on the safe side.
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- ;; Return to group mode buffer.
- (when (eq mode 'gnus-summary-mode)
- (gnus-kill-buffer buf)))
- (setq gnus-current-select-method gnus-select-method)
- (set-buffer gnus-group-buffer)
- (if quit-config
- (gnus-handle-ephemeral-exit quit-config)
- (goto-char group-point)
- ;; If gnus-group-buffer is already displayed, make sure we also move
- ;; the cursor in the window that displays it.
- (let ((win (get-buffer-window (current-buffer) 0)))
- (if win (set-window-point win (point))))
- (unless leave-hidden
- (gnus-configure-windows 'group 'force)))
- ;; Clear the current group name.
- (unless quit-config
- (setq gnus-newsgroup-name nil)))))
-
-(defalias 'gnus-summary-quit 'gnus-summary-exit-no-update)
-(defun gnus-summary-exit-no-update (&optional no-questions)
- "Quit reading current newsgroup without updating read article info."
- (interactive)
- (let* ((group gnus-newsgroup-name)
- (gnus-group-is-exiting-p t)
- (gnus-group-is-exiting-without-update-p t)
- (quit-config (gnus-group-quit-config group)))
- (when (or no-questions
- gnus-expert-user
- (gnus-y-or-n-p "Discard changes to this group and exit? "))
- (gnus-async-halt-prefetch)
- (run-hooks 'gnus-summary-prepare-exit-hook)
- (when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)
- ;; Set it to nil for safety reason.
- (setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-handles nil)))
- ;; If we have several article buffers, we kill them at exit.
- (unless gnus-single-article-buffer
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-article-current nil))
- (if (not gnus-kill-summary-on-exit)
- (gnus-deaden-summary)
- (gnus-close-group group)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- (set-buffer gnus-group-buffer)
- (gnus-summary-clear-local-variables)
- (let ((gnus-summary-local-variables gnus-newsgroup-variables))
- (gnus-summary-clear-local-variables))
- (gnus-kill-buffer gnus-summary-buffer))
- (unless gnus-single-article-buffer
- (setq gnus-article-current nil))
- (when gnus-use-trees
- (gnus-tree-close group))
- (gnus-async-prefetch-remove-group group)
- (when (get-buffer gnus-article-buffer)
- (bury-buffer gnus-article-buffer))
- ;; Return to the group buffer.
- (gnus-configure-windows 'group 'force)
- ;; Clear the current group name.
- (setq gnus-newsgroup-name nil)
- (unless (gnus-ephemeral-group-p group)
- (gnus-group-update-group group))
- (when (equal (gnus-group-group-name) group)
- (gnus-group-next-unread-group 1))
- (when quit-config
- (gnus-handle-ephemeral-exit quit-config)))))
-
-(defun gnus-handle-ephemeral-exit (quit-config)
- "Handle movement when leaving an ephemeral group.
-The state which existed when entering the ephemeral is reset."
- (if (not (buffer-name (car quit-config)))
- (gnus-configure-windows 'group 'force)
- (set-buffer (car quit-config))
- (cond ((eq major-mode 'gnus-summary-mode)
- (gnus-set-global-variables))
- ((eq major-mode 'gnus-article-mode)
- (save-excursion
- ;; The `gnus-summary-buffer' variable may point
- ;; to the old summary buffer when using a single
- ;; article buffer.
- (unless (gnus-buffer-live-p gnus-summary-buffer)
- (set-buffer gnus-group-buffer))
- (set-buffer gnus-summary-buffer)
- (gnus-set-global-variables))))
- (if (or (eq (cdr quit-config) 'article)
- (eq (cdr quit-config) 'pick))
- (progn
- ;; The current article may be from the ephemeral group
- ;; thus it is best that we reload this article
- ;;
- ;; If we're exiting from a large digest, this can be
- ;; extremely slow. So, it's better not to reload it. -- jh.
- ;;(gnus-summary-show-article)
- (if (and (boundp 'gnus-pick-mode) (symbol-value 'gnus-pick-mode))
- (gnus-configure-windows 'pick 'force)
- (gnus-configure-windows (cdr quit-config) 'force)))
- (gnus-configure-windows (cdr quit-config) 'force))
- (when (eq major-mode 'gnus-summary-mode)
- (gnus-summary-next-subject 1 nil t)
- (gnus-summary-recenter)
- (gnus-summary-position-point))))
-
-;;; Dead summaries.
-
-(defvar gnus-dead-summary-mode-map nil)
-
-(unless gnus-dead-summary-mode-map
- (setq gnus-dead-summary-mode-map (make-keymap))
- (suppress-keymap gnus-dead-summary-mode-map)
- (substitute-key-definition
- 'undefined 'gnus-summary-wake-up-the-dead gnus-dead-summary-mode-map)
- (dolist (key '("\C-d" "\r" "\177" [delete]))
- (define-key gnus-dead-summary-mode-map
- key 'gnus-summary-wake-up-the-dead))
- (dolist (key '("q" "Q"))
- (define-key gnus-dead-summary-mode-map key 'bury-buffer)))
-
-(defvar gnus-dead-summary-mode nil
- "Minor mode for Gnus summary buffers.")
-
-(defun gnus-dead-summary-mode (&optional arg)
- "Minor mode for Gnus summary buffers."
- (interactive "P")
- (when (eq major-mode 'gnus-summary-mode)
- (make-local-variable 'gnus-dead-summary-mode)
- (setq gnus-dead-summary-mode
- (if (null arg) (not gnus-dead-summary-mode)
- (> (prefix-numeric-value arg) 0)))
- (when gnus-dead-summary-mode
- (gnus-add-minor-mode
- 'gnus-dead-summary-mode " Dead" gnus-dead-summary-mode-map))))
-
-(defun gnus-deaden-summary ()
- "Make the current summary buffer into a dead summary buffer."
- ;; Kill any previous dead summary buffer.
- (when (and gnus-dead-summary
- (buffer-name gnus-dead-summary))
- (save-excursion
- (set-buffer gnus-dead-summary)
- (when gnus-dead-summary-mode
- (kill-buffer (current-buffer)))))
- ;; Make this the current dead summary.
- (setq gnus-dead-summary (current-buffer))
- (gnus-dead-summary-mode 1)
- (let ((name (buffer-name)))
- (when (string-match "Summary" name)
- (rename-buffer
- (concat (substring name 0 (match-beginning 0)) "Dead "
- (substring name (match-beginning 0)))
- t)
- (bury-buffer))))
-
-(defun gnus-kill-or-deaden-summary (buffer)
- "Kill or deaden the summary BUFFER."
- (save-excursion
- (when (and (buffer-name buffer)
- (not gnus-single-article-buffer))
- (save-excursion
- (set-buffer buffer)
- (gnus-kill-buffer gnus-article-buffer)
- (gnus-kill-buffer gnus-original-article-buffer)))
- (cond
- ;; Kill the buffer.
- (gnus-kill-summary-on-exit
- (when (and gnus-use-trees
- (gnus-buffer-exists-p buffer))
- (save-excursion
- (set-buffer buffer)
- (gnus-tree-close gnus-newsgroup-name)))
- (gnus-kill-buffer buffer))
- ;; Deaden the buffer.
- ((gnus-buffer-exists-p buffer)
- (save-excursion
- (set-buffer buffer)
- (gnus-deaden-summary))))))
-
-(defun gnus-summary-wake-up-the-dead (&rest args)
- "Wake up the dead summary buffer."
- (interactive)
- (gnus-dead-summary-mode -1)
- (let ((name (buffer-name)))
- (when (string-match "Dead " name)
- (rename-buffer
- (concat (substring name 0 (match-beginning 0))
- (substring name (match-end 0)))
- t)))
- (gnus-message 3 "This dead summary is now alive again"))
-
-;; Suggested by Andrew Eskilsson <pi92ae@pt.hk-r.se>.
-(defun gnus-summary-fetch-faq (&optional faq-dir)
- "Fetch the FAQ for the current group.
-If FAQ-DIR (the prefix), prompt for a directory to search for the faq
-in."
- (interactive
- (list
- (when current-prefix-arg
- (completing-read
- "FAQ dir: " (and (listp gnus-group-faq-directory)
- (mapcar (lambda (file) (list file))
- gnus-group-faq-directory))))))
- (let (gnus-faq-buffer)
- (when (setq gnus-faq-buffer
- (gnus-group-fetch-faq gnus-newsgroup-name faq-dir))
- (gnus-configure-windows 'summary-faq))))
-
-;; Suggested by Per Abrahamsen <amanda@iesd.auc.dk>.
-(defun gnus-summary-describe-group (&optional force)
- "Describe the current newsgroup."
- (interactive "P")
- (gnus-group-describe-group force gnus-newsgroup-name))
-
-(defun gnus-summary-describe-briefly ()
- "Describe summary mode commands briefly."
- (interactive)
- (gnus-message 6 (substitute-command-keys "\\<gnus-summary-mode-map>\\[gnus-summary-next-page]:Select \\[gnus-summary-next-unread-article]:Forward \\[gnus-summary-prev-unread-article]:Backward \\[gnus-summary-exit]:Exit \\[gnus-info-find-node]:Run Info \\[gnus-summary-describe-briefly]:This help")))
-
-;; Walking around group mode buffer from summary mode.
-
-(defun gnus-summary-next-group (&optional no-article target-group backward)
- "Exit current newsgroup and then select next unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected
-initially. If TARGET-GROUP, go to this group. If BACKWARD, go to
-previous group instead."
- (interactive "P")
- ;; Stop pre-fetching.
- (gnus-async-halt-prefetch)
- (let ((current-group gnus-newsgroup-name)
- (current-buffer (current-buffer))
- entered)
- ;; First we semi-exit this group to update Xrefs and all variables.
- ;; We can't do a real exit, because the window conf must remain
- ;; the same in case the user is prompted for info, and we don't
- ;; want the window conf to change before that...
- (gnus-summary-exit t)
- (while (not entered)
- ;; Then we find what group we are supposed to enter.
- (set-buffer gnus-group-buffer)
- (gnus-group-jump-to-group current-group)
- (setq target-group
- (or target-group
- (if (eq gnus-keep-same-level 'best)
- (gnus-summary-best-group gnus-newsgroup-name)
- (gnus-summary-search-group backward gnus-keep-same-level))))
- (if (not target-group)
- ;; There are no further groups, so we return to the group
- ;; buffer.
- (progn
- (gnus-message 5 "Returning to the group buffer")
- (setq entered t)
- (when (gnus-buffer-live-p current-buffer)
- (set-buffer current-buffer)
- (gnus-summary-exit))
- (gnus-run-hooks 'gnus-group-no-more-groups-hook))
- ;; We try to enter the target group.
- (gnus-group-jump-to-group target-group)
- (let ((unreads (gnus-group-group-unread)))
- (if (and (or (eq t unreads)
- (and unreads (not (zerop unreads))))
- (gnus-summary-read-group
- target-group nil no-article
- (and (buffer-name current-buffer) current-buffer)
- nil backward))
- (setq entered t)
- (setq current-group target-group
- target-group nil)))))))
-
-(defun gnus-summary-prev-group (&optional no-article)
- "Exit current newsgroup and then select previous unread newsgroup.
-If prefix argument NO-ARTICLE is non-nil, no article is selected initially."
- (interactive "P")
- (gnus-summary-next-group no-article nil t))
-
-;; Walking around summary lines.
-
-(defun gnus-summary-first-subject (&optional unread undownloaded unseen)
- "Go to the first subject satisfying any non-nil constraint.
-If UNREAD is non-nil, the article should be unread.
-If UNDOWNLOADED is non-nil, the article should be undownloaded.
-If UNSEEN is non-nil, the article should be unseen.
-Returns the article selected or nil if there are no matching articles."
- (interactive "P")
- (cond
- ;; Empty summary.
- ((null gnus-newsgroup-data)
- (gnus-message 3 "No articles in the group")
- nil)
- ;; Pick the first article.
- ((not (or unread undownloaded unseen))
- (goto-char (gnus-data-pos (car gnus-newsgroup-data)))
- (gnus-data-number (car gnus-newsgroup-data)))
- ;; Find the first unread article.
- (t
- (let ((data gnus-newsgroup-data))
- (while (and data
- (let ((num (gnus-data-number (car data))))
- (or (memq num gnus-newsgroup-unfetched)
- (not (or (and unread
- (memq num gnus-newsgroup-unreads))
- (and undownloaded
- (memq num gnus-newsgroup-undownloaded))
- (and unseen
- (memq num gnus-newsgroup-unseen)))))))
- (setq data (cdr data)))
- (prog1
- (if data
- (progn
- (goto-char (gnus-data-pos (car data)))
- (gnus-data-number (car data)))
- (gnus-message 3 "No more%s articles"
- (let* ((r (when unread " unread"))
- (d (when undownloaded " undownloaded"))
- (s (when unseen " unseen"))
- (l (delq nil (list r d s))))
- (cond ((= 3 (length l))
- (concat r "," d ", or" s))
- ((= 2 (length l))
- (concat (car l) ", or" (cadr l)))
- ((= 1 (length l))
- (car l))
- (t
- ""))))
- nil
- )
- (gnus-summary-position-point))))))
-
-(defun gnus-summary-next-subject (n &optional unread dont-display)
- "Go to next N'th summary line.
-If N is negative, go to the previous N'th subject line.
-If UNREAD is non-nil, only unread articles are selected.
-The difference between N and the actual number of steps taken is
-returned."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and (> n 0)
- (if backward
- (gnus-summary-find-prev unread)
- (gnus-summary-find-next unread)))
- (unless (zerop (setq n (1- n)))
- (gnus-summary-show-thread)))
- (when (/= 0 n)
- (gnus-message 7 "No more%s articles"
- (if unread " unread" "")))
- (unless dont-display
- (gnus-summary-recenter)
- (gnus-summary-position-point))
- n))
-
-(defun gnus-summary-next-unread-subject (n)
- "Go to next N'th unread summary line."
- (interactive "p")
- (gnus-summary-next-subject n t))
-
-(defun gnus-summary-prev-subject (n &optional unread)
- "Go to previous N'th summary line.
-If optional argument UNREAD is non-nil, only unread article is selected."
- (interactive "p")
- (gnus-summary-next-subject (- n) unread))
-
-(defun gnus-summary-prev-unread-subject (n)
- "Go to previous N'th unread summary line."
- (interactive "p")
- (gnus-summary-next-subject (- n) t))
-
-(defun gnus-summary-goto-subjects (articles)
- "Insert the subject header for ARTICLES in the current buffer."
- (save-excursion
- (dolist (article articles)
- (gnus-summary-goto-subject article t)))
- (gnus-summary-limit (append articles gnus-newsgroup-limit))
- (gnus-summary-position-point))
-
-(defun gnus-summary-goto-subject (article &optional force silent)
- "Go the subject line of ARTICLE.
-If FORCE, also allow jumping to articles not currently shown."
- (interactive "nArticle number: ")
- (unless (numberp article)
- (error "Article %s is not a number" article))
- (let ((b (point))
- (data (gnus-data-find article)))
- ;; We read in the article if we have to.
- (and (not data)
- force
- (gnus-summary-insert-subject
- article
- (if (or (numberp force) (vectorp force)) force)
- t)
- (setq data (gnus-data-find article)))
- (goto-char b)
- (if (not data)
- (progn
- (unless silent
- (gnus-message 3 "Can't find article %d" article))
- nil)
- (let ((pt (gnus-data-pos data)))
- (goto-char pt)
- (gnus-summary-set-article-display-arrow pt))
- (gnus-summary-position-point)
- article)))
-
-;; Walking around summary lines with displaying articles.
-
-(defun gnus-summary-expand-window (&optional arg)
- "Make the summary buffer take up the entire Emacs frame.
-Given a prefix, will force an `article' buffer configuration."
- (interactive "P")
- (if arg
- (gnus-configure-windows 'article 'force)
- (gnus-configure-windows 'summary 'force)))
-
-(defun gnus-summary-display-article (article &optional all-header)
- "Display ARTICLE in article buffer."
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (mm-enable-multibyte)))
- (gnus-set-global-variables)
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (setq gnus-article-charset gnus-newsgroup-charset)
- (setq gnus-article-ignored-charsets gnus-newsgroup-ignored-charsets)
- (mm-enable-multibyte)))
- (if (null article)
- nil
- (prog1
- (if gnus-summary-display-article-function
- (funcall gnus-summary-display-article-function article all-header)
- (gnus-article-prepare article all-header))
- (gnus-run-hooks 'gnus-select-article-hook)
- (when (and gnus-current-article
- (not (zerop gnus-current-article)))
- (gnus-summary-goto-subject gnus-current-article))
- (gnus-summary-recenter)
- (when (and gnus-use-trees gnus-show-threads)
- (gnus-possibly-generate-tree article)
- (gnus-highlight-selected-tree article))
- ;; Successfully display article.
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks))))))
-
-(defun gnus-summary-select-article (&optional all-headers force pseudo article)
- "Select the current article.
-If ALL-HEADERS is non-nil, show all header fields. If FORCE is
-non-nil, the article will be re-fetched even if it already present in
-the article buffer. If PSEUDO is non-nil, pseudo-articles will also
-be displayed."
- ;; Make sure we are in the summary buffer to work around bbdb bug.
- (unless (eq major-mode 'gnus-summary-mode)
- (set-buffer gnus-summary-buffer))
- (let ((article (or article (gnus-summary-article-number)))
- (all-headers (not (not all-headers))) ;Must be t or nil.
- gnus-summary-display-article-function)
- (and (not pseudo)
- (gnus-summary-article-pseudo-p article)
- (error "This is a pseudo-article"))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (if (or (and gnus-single-article-buffer
- (or (null gnus-current-article)
- (null gnus-article-current)
- (null (get-buffer gnus-article-buffer))
- (not (eq article (cdr gnus-article-current)))
- (not (equal (car gnus-article-current)
- gnus-newsgroup-name))))
- (and (not gnus-single-article-buffer)
- (or (null gnus-current-article)
- (not (eq gnus-current-article article))))
- force)
- ;; The requested article is different from the current article.
- (progn
- (gnus-summary-display-article article all-headers)
- (when (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (if (not gnus-article-decoded-p) ;; a local variable
- (mm-disable-multibyte))))
- (gnus-article-set-window-start
- (cdr (assq article gnus-newsgroup-bookmarks)))
- article)
- 'old))))
-
-(defun gnus-summary-force-verify-and-decrypt ()
- "Display buttons for signed/encrypted parts and verify/decrypt them."
- (interactive)
- (let ((mm-verify-option 'known)
- (mm-decrypt-option 'known)
- (gnus-article-emulate-mime t)
- (gnus-buttonized-mime-types (append (list "multipart/signed"
- "multipart/encrypted")
- gnus-buttonized-mime-types)))
- (gnus-summary-select-article nil 'force)))
-
-(defun gnus-summary-set-current-mark (&optional current-mark)
- "Obsolete function."
- nil)
-
-(defun gnus-summary-next-article (&optional unread subject backward push)
- "Select the next article.
-If UNREAD, only unread articles are selected.
-If SUBJECT, only articles with SUBJECT are selected.
-If BACKWARD, the previous article is selected instead of the next."
- (interactive "P")
- ;; Make sure we are in the summary buffer.
- (unless (eq major-mode 'gnus-summary-mode)
- (set-buffer gnus-summary-buffer))
- (cond
- ;; Is there such an article?
- ((and (gnus-summary-search-forward unread subject backward)
- (or (gnus-summary-display-article (gnus-summary-article-number))
- (eq (gnus-summary-article-mark) gnus-canceled-mark)))
- (gnus-summary-position-point))
- ;; If not, we try the first unread, if that is wanted.
- ((and subject
- gnus-auto-select-same
- (gnus-summary-first-unread-article))
- (gnus-summary-position-point)
- (gnus-message 6 "Wrapped"))
- ;; Try to get next/previous article not displayed in this group.
- ((and gnus-auto-extend-newsgroup
- (not unread) (not subject))
- (gnus-summary-goto-article
- (if backward (1- gnus-newsgroup-begin) (1+ gnus-newsgroup-end))
- nil (count-lines (point-min) (point))))
- ;; Go to next/previous group.
- (t
- (unless (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-summary-jump-to-group gnus-newsgroup-name))
- (let ((cmd last-command-char)
- (point
- (save-excursion
- (set-buffer gnus-group-buffer)
- (point)))
- (group
- (if (eq gnus-keep-same-level 'best)
- (gnus-summary-best-group gnus-newsgroup-name)
- (gnus-summary-search-group backward gnus-keep-same-level))))
- ;; For some reason, the group window gets selected. We change
- ;; it back.
- (select-window (get-buffer-window (current-buffer)))
- ;; Select next unread newsgroup automagically.
- (cond
- ((or (not gnus-auto-select-next)
- (not cmd))
- (gnus-message 7 "No more%s articles" (if unread " unread" "")))
- ((or (eq gnus-auto-select-next 'quietly)
- (and (eq gnus-auto-select-next 'slightly-quietly)
- push)
- (and (eq gnus-auto-select-next 'almost-quietly)
- (gnus-summary-last-article-p)))
- ;; Select quietly.
- (if (gnus-ephemeral-group-p gnus-newsgroup-name)
- (gnus-summary-exit)
- (gnus-message 7 "No more%s articles (%s)..."
- (if unread " unread" "")
- (if group (concat "selecting " group)
- "exiting"))
- (gnus-summary-next-group nil group backward)))
- (t
- (when (gnus-key-press-event-p last-input-event)
- (gnus-summary-walk-group-buffer
- gnus-newsgroup-name cmd unread backward point))))))))
-
-(defun gnus-summary-walk-group-buffer (from-group cmd unread backward start)
- (let ((keystrokes '((?\C-n (gnus-group-next-unread-group 1))
- (?\C-p (gnus-group-prev-unread-group 1))))
- (cursor-in-echo-area t)
- keve key group ended prompt)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (goto-char start)
- (setq group
- (if (eq gnus-keep-same-level 'best)
- (gnus-summary-best-group gnus-newsgroup-name)
- (gnus-summary-search-group backward gnus-keep-same-level))))
- (while (not ended)
- (setq prompt
- (format
- "No more%s articles%s " (if unread " unread" "")
- (if (and group
- (not (gnus-ephemeral-group-p gnus-newsgroup-name)))
- (format " (Type %s for %s [%s])"
- (single-key-description cmd)
- (gnus-group-decoded-name group)
- (car (gnus-gethash group gnus-newsrc-hashtb)))
- (format " (Type %s to exit %s)"
- (single-key-description cmd)
- (gnus-group-decoded-name gnus-newsgroup-name)))))
- ;; Confirm auto selection.
- (setq key (car (setq keve (gnus-read-event-char prompt)))
- ended t)
- (cond
- ((assq key keystrokes)
- (let ((obuf (current-buffer)))
- (switch-to-buffer gnus-group-buffer)
- (when group
- (gnus-group-jump-to-group group))
- (eval (cadr (assq key keystrokes)))
- (setq group (gnus-group-group-name))
- (switch-to-buffer obuf))
- (setq ended nil))
- ((equal key cmd)
- (if (or (not group)
- (gnus-ephemeral-group-p gnus-newsgroup-name))
- (gnus-summary-exit)
- (gnus-summary-next-group nil group backward)))
- (t
- (push (cdr keve) unread-command-events))))))
-
-(defun gnus-summary-next-unread-article ()
- "Select unread article after current one."
- (interactive)
- (gnus-summary-next-article
- (or (not (eq gnus-summary-goto-unread 'never))
- (gnus-summary-last-article-p (gnus-summary-article-number)))
- (and gnus-auto-select-same
- (gnus-summary-article-subject))))
-
-(defun gnus-summary-prev-article (&optional unread subject)
- "Select the article before the current one.
-If UNREAD is non-nil, only unread articles are selected."
- (interactive "P")
- (gnus-summary-next-article unread subject t))
-
-(defun gnus-summary-prev-unread-article ()
- "Select unread article before current one."
- (interactive)
- (gnus-summary-prev-article
- (or (not (eq gnus-summary-goto-unread 'never))
- (gnus-summary-first-article-p (gnus-summary-article-number)))
- (and gnus-auto-select-same
- (gnus-summary-article-subject))))
-
-(defun gnus-summary-next-page (&optional lines circular stop)
- "Show next page of the selected article.
-If at the end of the current article, select the next article.
-LINES says how many lines should be scrolled up.
-
-If CIRCULAR is non-nil, go to the start of the article instead of
-selecting the next article when reaching the end of the current
-article.
-
-If STOP is non-nil, just stop when reaching the end of the message.
-
-Also see the variable `gnus-article-skip-boring'."
- (interactive "P")
- (setq gnus-summary-buffer (current-buffer))
- (gnus-set-global-variables)
- (let ((article (gnus-summary-article-number))
- (article-window (get-buffer-window gnus-article-buffer t))
- endp)
- ;; If the buffer is empty, we have no article.
- (unless article
- (error "No article to select"))
- (gnus-configure-windows 'article)
- (if (eq (cdr (assq article gnus-newsgroup-reads)) gnus-canceled-mark)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-last-article-p article)))
- (gnus-summary-next-article)
- (gnus-summary-next-unread-article))
- (if (or (null gnus-current-article)
- (null gnus-article-current)
- (/= article (cdr gnus-article-current))
- (not (equal (car gnus-article-current) gnus-newsgroup-name)))
- ;; Selected subject is different from current article's.
- (gnus-summary-display-article article)
- (when article-window
- (gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (or (gnus-article-next-page lines)
- (gnus-article-only-boring-p))))
- (when endp
- (cond (stop
- (gnus-message 3 "End of message"))
- (circular
- (gnus-summary-beginning-of-article))
- (lines
- (gnus-message 3 "End of message"))
- ((null lines)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-last-article-p article)))
- (gnus-summary-next-article)
- (gnus-summary-next-unread-article))))))))
- (gnus-summary-recenter)
- (gnus-summary-position-point)))
-
-(defun gnus-summary-prev-page (&optional lines move)
- "Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down.
-If MOVE, move to the previous unread article if point is at
-the beginning of the buffer."
- (interactive "P")
- (let ((article (gnus-summary-article-number))
- (article-window (get-buffer-window gnus-article-buffer t))
- endp)
- (gnus-configure-windows 'article)
- (if (or (null gnus-current-article)
- (null gnus-article-current)
- (/= article (cdr gnus-article-current))
- (not (equal (car gnus-article-current) gnus-newsgroup-name)))
- ;; Selected subject is different from current article's.
- (gnus-summary-display-article article)
- (gnus-summary-recenter)
- (when article-window
- (gnus-eval-in-buffer-window gnus-article-buffer
- (setq endp (gnus-article-prev-page lines)))
- (when (and move endp)
- (cond (lines
- (gnus-message 3 "Beginning of message"))
- ((null lines)
- (if (and (eq gnus-summary-goto-unread 'never)
- (not (gnus-summary-first-article-p article)))
- (gnus-summary-prev-article)
- (gnus-summary-prev-unread-article))))))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-prev-page-or-article (&optional lines)
- "Show previous page of selected article.
-Argument LINES specifies lines to be scrolled down.
-If at the beginning of the article, go to the next article."
- (interactive "P")
- (gnus-summary-prev-page lines t))
-
-(defun gnus-summary-scroll-up (lines)
- "Scroll up (or down) one line current article.
-Argument LINES specifies lines to be scrolled up (or down if negative)."
- (interactive "p")
- (gnus-configure-windows 'article)
- (gnus-summary-show-thread)
- (when (eq (gnus-summary-select-article nil nil 'pseudo) 'old)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (cond ((> lines 0)
- (when (gnus-article-next-page lines)
- (gnus-message 3 "End of message")))
- ((< lines 0)
- (gnus-article-prev-page (- lines))))))
- (gnus-summary-recenter)
- (gnus-summary-position-point))
-
-(defun gnus-summary-scroll-down (lines)
- "Scroll down (or up) one line current article.
-Argument LINES specifies lines to be scrolled down (or up if negative)."
- (interactive "p")
- (gnus-summary-scroll-up (- lines)))
-
-(defun gnus-summary-next-same-subject ()
- "Select next article which has the same subject as current one."
- (interactive)
- (gnus-summary-next-article nil (gnus-summary-article-subject)))
-
-(defun gnus-summary-prev-same-subject ()
- "Select previous article which has the same subject as current one."
- (interactive)
- (gnus-summary-prev-article nil (gnus-summary-article-subject)))
-
-(defun gnus-summary-next-unread-same-subject ()
- "Select next unread article which has the same subject as current one."
- (interactive)
- (gnus-summary-next-article t (gnus-summary-article-subject)))
-
-(defun gnus-summary-prev-unread-same-subject ()
- "Select previous unread article which has the same subject as current one."
- (interactive)
- (gnus-summary-prev-article t (gnus-summary-article-subject)))
-
-(defun gnus-summary-first-unread-article ()
- "Select the first unread article.
-Return nil if there are no unread articles."
- (interactive)
- (prog1
- (when (gnus-summary-first-subject t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t)
- (gnus-summary-display-article (gnus-summary-article-number)))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-first-unread-subject ()
- "Place the point on the subject line of the first unread article.
-Return nil if there are no unread articles."
- (interactive)
- (prog1
- (when (gnus-summary-first-subject t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-first-unseen-subject ()
- "Place the point on the subject line of the first unseen article.
-Return nil if there are no unseen articles."
- (interactive)
- (prog1
- (when (gnus-summary-first-subject nil nil t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject nil nil t))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-first-unseen-or-unread-subject ()
- "Place the point on the subject line of the first unseen article or,
-if all article have been seen, on the subject line of the first unread
-article."
- (interactive)
- (prog1
- (unless (when (gnus-summary-first-subject nil nil t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject nil nil t))
- (when (gnus-summary-first-subject t)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject t)))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-first-article ()
- "Select the first article.
-Return nil if there are no articles."
- (interactive)
- (prog1
- (when (gnus-summary-first-subject)
- (gnus-summary-show-thread)
- (gnus-summary-first-subject)
- (gnus-summary-display-article (gnus-summary-article-number)))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-best-unread-article (&optional arg)
- "Select the unread article with the highest score.
-If given a prefix argument, select the next unread article that has a
-score higher than the default score."
- (interactive "P")
- (let ((article (if arg
- (gnus-summary-better-unread-subject)
- (gnus-summary-best-unread-subject))))
- (if article
- (gnus-summary-goto-article article)
- (error "No unread articles"))))
-
-(defun gnus-summary-best-unread-subject ()
- "Select the unread subject with the highest score."
- (interactive)
- (let ((best -1000000)
- (data gnus-newsgroup-data)
- article score)
- (while data
- (and (gnus-data-unread-p (car data))
- (> (setq score
- (gnus-summary-article-score (gnus-data-number (car data))))
- best)
- (setq best score
- article (gnus-data-number (car data))))
- (setq data (cdr data)))
- (when article
- (gnus-summary-goto-subject article))
- (gnus-summary-position-point)
- article))
-
-(defun gnus-summary-better-unread-subject ()
- "Select the first unread subject that has a score over the default score."
- (interactive)
- (let ((data gnus-newsgroup-data)
- article score)
- (while (and (setq article (gnus-data-number (car data)))
- (or (gnus-data-read-p (car data))
- (not (> (gnus-summary-article-score article)
- gnus-summary-default-score))))
- (setq data (cdr data)))
- (when article
- (gnus-summary-goto-subject article))
- (gnus-summary-position-point)
- article))
-
-(defun gnus-summary-last-subject ()
- "Go to the last displayed subject line in the group."
- (let ((article (gnus-data-number (car (gnus-data-list t)))))
- (when article
- (gnus-summary-goto-subject article))))
-
-(defun gnus-summary-goto-article (article &optional all-headers force)
- "Fetch ARTICLE (article number or Message-ID) and display it if it exists.
-If ALL-HEADERS is non-nil, no header lines are hidden.
-If FORCE, go to the article even if it isn't displayed. If FORCE
-is a number, it is the line the article is to be displayed on."
- (interactive
- (list
- (completing-read
- "Article number or Message-ID: "
- (mapcar (lambda (number) (list (int-to-string number)))
- gnus-newsgroup-limit))
- current-prefix-arg
- t))
- (prog1
- (if (and (stringp article)
- (string-match "@\\|%40" article))
- (gnus-summary-refer-article article)
- (when (stringp article)
- (setq article (string-to-number article)))
- (if (gnus-summary-goto-subject article force)
- (gnus-summary-display-article article all-headers)
- (gnus-message 4 "Couldn't go to article %s" article) nil))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-goto-last-article ()
- "Go to the previously read article."
- (interactive)
- (prog1
- (when gnus-last-article
- (gnus-summary-goto-article gnus-last-article nil t))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-pop-article (number)
- "Pop one article off the history and go to the previous.
-NUMBER articles will be popped off."
- (interactive "p")
- (let (to)
- (setq gnus-newsgroup-history
- (cdr (setq to (nthcdr number gnus-newsgroup-history))))
- (if to
- (gnus-summary-goto-article (car to) nil t)
- (error "Article history empty")))
- (gnus-summary-position-point))
-
-;; Summary commands and functions for limiting the summary buffer.
-
-(defun gnus-summary-limit-to-articles (n)
- "Limit the summary buffer to the next N articles.
-If not given a prefix, use the process marked articles instead."
- (interactive "P")
- (prog1
- (let ((articles (gnus-summary-work-articles n)))
- (setq gnus-newsgroup-processable nil)
- (gnus-summary-limit articles))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-pop-limit (&optional total)
- "Restore the previous limit.
-If given a prefix, remove all limits."
- (interactive "P")
- (when total
- (setq gnus-newsgroup-limits
- (list (mapcar (lambda (h) (mail-header-number h))
- gnus-newsgroup-headers))))
- (unless gnus-newsgroup-limits
- (error "No limit to pop"))
- (prog1
- (gnus-summary-limit nil 'pop)
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-to-subject (subject &optional header not-matching)
- "Limit the summary buffer to articles that have subjects that match a regexp.
-If NOT-MATCHING, excluding articles that have subjects that match a regexp."
- (interactive
- (list (read-string (if current-prefix-arg
- "Exclude subject (regexp): "
- "Limit to subject (regexp): "))
- nil current-prefix-arg))
- (unless header
- (setq header "subject"))
- (when (not (equal "" subject))
- (prog1
- (let ((articles (gnus-summary-find-matching
- (or header "subject") subject 'all nil nil
- not-matching)))
- (unless articles
- (error "Found no matches for \"%s\"" subject))
- (gnus-summary-limit articles))
- (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-to-author (from &optional not-matching)
- "Limit the summary buffer to articles that have authors that match a regexp.
-If NOT-MATCHING, excluding articles that have authors that match a regexp."
- (interactive
- (list (read-string (if current-prefix-arg
- "Exclude author (regexp): "
- "Limit to author (regexp): "))
- current-prefix-arg))
- (gnus-summary-limit-to-subject from "from" not-matching))
-
-(defun gnus-summary-limit-to-age (age &optional younger-p)
- "Limit the summary buffer to articles that are older than (or equal) AGE days.
-If YOUNGER-P (the prefix) is non-nil, limit the summary buffer to
-articles that are younger than AGE days."
- (interactive
- (let ((younger current-prefix-arg)
- (days-got nil)
- days)
- (while (not days-got)
- (setq days (if younger
- (read-string "Limit to articles younger than (in days, older when negative): ")
- (read-string
- "Limit to articles older than (in days, younger when negative): ")))
- (when (> (length days) 0)
- (setq days (read days)))
- (if (numberp days)
- (progn
- (setq days-got t)
- (if (< days 0)
- (progn
- (setq younger (not younger))
- (setq days (* days -1)))))
- (message "Please enter a number.")
- (sleep-for 1)))
- (list days younger)))
- (prog1
- (let ((data gnus-newsgroup-data)
- (cutoff (days-to-time age))
- articles d date is-younger)
- (while (setq d (pop data))
- (when (and (vectorp (gnus-data-header d))
- (setq date (mail-header-date (gnus-data-header d))))
- (setq is-younger (time-less-p
- (time-since (condition-case ()
- (date-to-time date)
- (error '(0 0))))
- cutoff))
- (when (if younger-p
- is-younger
- (not is-younger))
- (push (gnus-data-number d) articles))))
- (gnus-summary-limit (nreverse articles)))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-to-extra (header regexp &optional not-matching)
- "Limit the summary buffer to articles that match an 'extra' header."
- (interactive
- (let ((header
- (intern
- (gnus-completing-read-with-default
- (symbol-name (car gnus-extra-headers))
- (if current-prefix-arg
- "Exclude extra header"
- "Limit extra header")
- (mapcar (lambda (x)
- (cons (symbol-name x) x))
- gnus-extra-headers)
- nil
- t))))
- (list header
- (read-string (format "%s header %s (regexp): "
- (if current-prefix-arg "Exclude" "Limit to")
- header))
- current-prefix-arg)))
- (when (not (equal "" regexp))
- (prog1
- (let ((articles (gnus-summary-find-matching
- (cons 'extra header) regexp 'all nil nil
- not-matching)))
- (unless articles
- (error "Found no matches for \"%s\"" regexp))
- (gnus-summary-limit articles))
- (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-to-display-predicate ()
- "Limit the summary buffer to the predicated in the `display' group parameter."
- (interactive)
- (unless gnus-newsgroup-display
- (error "There is no `display' group parameter"))
- (let (articles)
- (dolist (number gnus-newsgroup-articles)
- (when (funcall gnus-newsgroup-display)
- (push number articles)))
- (gnus-summary-limit articles))
- (gnus-summary-position-point))
-
-(defalias 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-(make-obsolete
- 'gnus-summary-delete-marked-as-read 'gnus-summary-limit-to-unread)
-
-(defun gnus-summary-limit-to-unread (&optional all)
- "Limit the summary buffer to articles that are not marked as read.
-If ALL is non-nil, limit strictly to unread articles."
- (interactive "P")
- (if all
- (gnus-summary-limit-to-marks (char-to-string gnus-unread-mark))
- (gnus-summary-limit-to-marks
- ;; Concat all the marks that say that an article is read and have
- ;; those removed.
- (list gnus-del-mark gnus-read-mark gnus-ancient-mark
- gnus-killed-mark gnus-spam-mark gnus-kill-file-mark
- gnus-low-score-mark gnus-expirable-mark
- gnus-canceled-mark gnus-catchup-mark gnus-sparse-mark
- gnus-duplicate-mark gnus-souped-mark)
- 'reverse)))
-
-(defalias 'gnus-summary-delete-marked-with 'gnus-summary-limit-exclude-marks)
-(make-obsolete 'gnus-summary-delete-marked-with
- 'gnus-summary-limit-exclude-marks)
-
-(defun gnus-summary-limit-exclude-marks (marks &optional reverse)
- "Exclude articles that are marked with MARKS (e.g. \"DK\").
-If REVERSE, limit the summary buffer to articles that are marked
-with MARKS. MARKS can either be a string of marks or a list of marks.
-Returns how many articles were removed."
- (interactive "sMarks: ")
- (gnus-summary-limit-to-marks marks t))
-
-(defun gnus-summary-limit-to-marks (marks &optional reverse)
- "Limit the summary buffer to articles that are marked with MARKS (e.g. \"DK\").
-If REVERSE (the prefix), limit the summary buffer to articles that are
-not marked with MARKS. MARKS can either be a string of marks or a
-list of marks.
-Returns how many articles were removed."
- (interactive "sMarks: \nP")
- (prog1
- (let ((data gnus-newsgroup-data)
- (marks (if (listp marks) marks
- (append marks nil))) ; Transform to list.
- articles)
- (while data
- (when (if reverse (not (memq (gnus-data-mark (car data)) marks))
- (memq (gnus-data-mark (car data)) marks))
- (push (gnus-data-number (car data)) articles))
- (setq data (cdr data)))
- (gnus-summary-limit articles))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-to-score (score)
- "Limit to articles with score at or above SCORE."
- (interactive "NLimit to articles with score of at least: ")
- (let ((data gnus-newsgroup-data)
- articles)
- (while data
- (when (>= (gnus-summary-article-score (gnus-data-number (car data)))
- score)
- (push (gnus-data-number (car data)) articles))
- (setq data (cdr data)))
- (prog1
- (gnus-summary-limit articles)
- (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-to-unseen ()
- "Limit to unseen articles."
- (interactive)
- (prog1
- (gnus-summary-limit gnus-newsgroup-unseen)
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-include-thread (id)
- "Display all the hidden articles that is in the thread with ID in it.
-When called interactively, ID is the Message-ID of the current
-article."
- (interactive (list (mail-header-id (gnus-summary-article-header))))
- (let ((articles (gnus-articles-in-thread
- (gnus-id-to-thread (gnus-root-id id)))))
- (prog1
- (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
- (gnus-summary-limit-include-matching-articles
- "subject"
- (regexp-quote (gnus-simplify-subject-re
- (mail-header-subject (gnus-id-to-header id)))))
- (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-include-matching-articles (header regexp)
- "Display all the hidden articles that have HEADERs that match REGEXP."
- (interactive (list (read-string "Match on header: ")
- (read-string "Regexp: ")))
- (let ((articles (gnus-find-matching-articles header regexp)))
- (prog1
- (gnus-summary-limit (nconc articles gnus-newsgroup-limit))
- (gnus-summary-position-point))))
-
-(defun gnus-summary-insert-dormant-articles ()
- "Insert all the dormant articles for this group into the current buffer."
- (interactive)
- (let ((gnus-verbose (max 6 gnus-verbose)))
- (if (not gnus-newsgroup-dormant)
- (gnus-message 3 "No dormant articles for this group")
- (gnus-summary-goto-subjects gnus-newsgroup-dormant))))
-
-(defun gnus-summary-limit-include-dormant ()
- "Display all the hidden articles that are marked as dormant.
-Note that this command only works on a subset of the articles currently
-fetched for this group."
- (interactive)
- (unless gnus-newsgroup-dormant
- (error "There are no dormant articles in this group"))
- (prog1
- (gnus-summary-limit (append gnus-newsgroup-dormant gnus-newsgroup-limit))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-exclude-dormant ()
- "Hide all dormant articles."
- (interactive)
- (prog1
- (gnus-summary-limit-to-marks (list gnus-dormant-mark) 'reverse)
- (gnus-summary-position-point)))
-
-(defun gnus-summary-limit-exclude-childless-dormant ()
- "Hide all dormant articles that have no children."
- (interactive)
- (let ((data (gnus-data-list t))
- articles d children)
- ;; Find all articles that are either not dormant or have
- ;; children.
- (while (setq d (pop data))
- (when (or (not (= (gnus-data-mark d) gnus-dormant-mark))
- (and (setq children
- (gnus-article-children (gnus-data-number d)))
- (let (found)
- (while children
- (when (memq (car children) articles)
- (setq children nil
- found t))
- (pop children))
- found)))
- (push (gnus-data-number d) articles)))
- ;; Do the limiting.
- (prog1
- (gnus-summary-limit articles)
- (gnus-summary-position-point))))
-
-(defun gnus-summary-limit-mark-excluded-as-read (&optional all)
- "Mark all unread excluded articles as read.
-If ALL, mark even excluded ticked and dormants as read."
- (interactive "P")
- (setq gnus-newsgroup-limit (sort gnus-newsgroup-limit '<))
- (let ((articles (gnus-sorted-ndifference
- (sort
- (mapcar (lambda (h) (mail-header-number h))
- gnus-newsgroup-headers)
- '<)
- gnus-newsgroup-limit))
- article)
- (setq gnus-newsgroup-unreads
- (gnus-sorted-intersection gnus-newsgroup-unreads
- gnus-newsgroup-limit))
- (if all
- (setq gnus-newsgroup-dormant nil
- gnus-newsgroup-marked nil
- gnus-newsgroup-reads
- (nconc
- (mapcar (lambda (n) (cons n gnus-catchup-mark)) articles)
- gnus-newsgroup-reads))
- (while (setq article (pop articles))
- (unless (or (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-marked))
- (push (cons article gnus-catchup-mark) gnus-newsgroup-reads))))))
-
-(defun gnus-summary-limit (articles &optional pop)
- (if pop
- ;; We pop the previous limit off the stack and use that.
- (setq articles (car gnus-newsgroup-limits)
- gnus-newsgroup-limits (cdr gnus-newsgroup-limits))
- ;; We use the new limit, so we push the old limit on the stack.
- (push gnus-newsgroup-limit gnus-newsgroup-limits))
- ;; Set the limit.
- (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.
- (gnus-summary-prepare)
- ;; Hide any threads, possibly.
- (gnus-summary-maybe-hide-threads)
- ;; Try to return to the article you were at, or one in the
- ;; neighborhood.
- (when data
- ;; We try to find some article after the current one.
- (while data
- (when (gnus-summary-goto-subject (gnus-data-number (car data)) nil t)
- (setq data nil
- found t))
- (setq data (cdr data))))
- (unless found
- ;; If there is no data, that means that we were after the last
- ;; article. The same goes when we can't find any articles
- ;; after the current one.
- (goto-char (point-max))
- (gnus-summary-find-prev))
- (gnus-set-mode-line 'summary)
- ;; We return how many articles were removed from the summary
- ;; buffer as a result of the new limit.
- (- total (length gnus-newsgroup-data))))
-
-(defsubst gnus-invisible-cut-children (threads)
- (let ((num 0))
- (while threads
- (when (memq (mail-header-number (caar threads)) gnus-newsgroup-limit)
- (incf num))
- (pop threads))
- (< num 2)))
-
-(defsubst gnus-cut-thread (thread)
- "Go forwards in the thread until we find an article that we want to display."
- (when (or (eq gnus-fetch-old-headers 'some)
- (eq gnus-fetch-old-headers 'invisible)
- (numberp gnus-fetch-old-headers)
- (eq gnus-build-sparse-threads 'some)
- (eq gnus-build-sparse-threads 'more))
- ;; Deal with old-fetched headers and sparse threads.
- (while (and
- thread
- (or
- (gnus-summary-article-sparse-p (mail-header-number (car thread)))
- (gnus-summary-article-ancient-p
- (mail-header-number (car thread))))
- (if (or (<= (length (cdr thread)) 1)
- (eq gnus-fetch-old-headers 'invisible))
- (setq gnus-newsgroup-limit
- (delq (mail-header-number (car thread))
- gnus-newsgroup-limit)
- thread (cadr thread))
- (when (gnus-invisible-cut-children (cdr thread))
- (let ((th (cdr thread)))
- (while th
- (if (memq (mail-header-number (caar th))
- gnus-newsgroup-limit)
- (setq thread (car th)
- th nil)
- (setq th (cdr th))))))))))
- thread)
-
-(defun gnus-cut-threads (threads)
- "Cut off all uninteresting articles from the beginning of THREADS."
- (when (or (eq gnus-fetch-old-headers 'some)
- (eq gnus-fetch-old-headers 'invisible)
- (numberp gnus-fetch-old-headers)
- (eq gnus-build-sparse-threads 'some)
- (eq gnus-build-sparse-threads 'more))
- (let ((th threads))
- (while th
- (setcar th (gnus-cut-thread (car th)))
- (setq th (cdr th)))))
- ;; Remove nixed out threads.
- (delq nil threads))
-
-(defun gnus-summary-initial-limit (&optional show-if-empty)
- "Figure out what the initial limit is supposed to be on group entry.
-This entails weeding out unwanted dormants, low-scored articles,
-fetch-old-headers verbiage, and so on."
- ;; Most groups have nothing to remove.
- (if (or gnus-inhibit-limiting
- (and (null gnus-newsgroup-dormant)
- (eq gnus-newsgroup-display 'gnus-not-ignore)
- (not (eq gnus-fetch-old-headers 'some))
- (not (numberp gnus-fetch-old-headers))
- (not (eq gnus-fetch-old-headers 'invisible))
- (null gnus-summary-expunge-below)
- (not (eq gnus-build-sparse-threads 'some))
- (not (eq gnus-build-sparse-threads 'more))
- (null gnus-thread-expunge-below)
- (not gnus-use-nocem)))
- () ; Do nothing.
- (push gnus-newsgroup-limit gnus-newsgroup-limits)
- (setq gnus-newsgroup-limit nil)
- (mapatoms
- (lambda (node)
- (unless (car (symbol-value node))
- ;; These threads have no parents -- they are roots.
- (let ((nodes (cdr (symbol-value node)))
- thread)
- (while nodes
- (if (and gnus-thread-expunge-below
- (< (gnus-thread-total-score (car nodes))
- gnus-thread-expunge-below))
- (gnus-expunge-thread (pop nodes))
- (setq thread (pop nodes))
- (gnus-summary-limit-children thread))))))
- gnus-newsgroup-dependencies)
- ;; If this limitation resulted in an empty group, we might
- ;; pop the previous limit and use it instead.
- (when (and (not gnus-newsgroup-limit)
- show-if-empty)
- (setq gnus-newsgroup-limit (pop gnus-newsgroup-limits)))
- gnus-newsgroup-limit))
-
-(defun gnus-summary-limit-children (thread)
- "Return 1 if this subthread is visible and 0 if it is not."
- ;; First we get the number of visible children to this thread. This
- ;; is done by recursing down the thread using this function, so this
- ;; will really go down to a leaf article first, before slowly
- ;; working its way up towards the root.
- (when thread
- (let* ((max-lisp-eval-depth (max 5000 max-lisp-eval-depth))
- (children
- (if (cdr thread)
- (apply '+ (mapcar 'gnus-summary-limit-children
- (cdr thread)))
- 0))
- (number (mail-header-number (car thread)))
- score)
- (if (and
- (not (memq number gnus-newsgroup-marked))
- (or
- ;; If this article is dormant and has absolutely no visible
- ;; children, then this article isn't visible.
- (and (memq number gnus-newsgroup-dormant)
- (zerop children))
- ;; If this is "fetch-old-headered" and there is no
- ;; visible children, then we don't want this article.
- (and (or (eq gnus-fetch-old-headers 'some)
- (numberp gnus-fetch-old-headers))
- (gnus-summary-article-ancient-p number)
- (zerop children))
- ;; If this is "fetch-old-headered" and `invisible', then
- ;; we don't want this article.
- (and (eq gnus-fetch-old-headers 'invisible)
- (gnus-summary-article-ancient-p number))
- ;; If this is a sparsely inserted article with no children,
- ;; we don't want it.
- (and (eq gnus-build-sparse-threads 'some)
- (gnus-summary-article-sparse-p number)
- (zerop children))
- ;; If we use expunging, and this article is really
- ;; low-scored, then we don't want this article.
- (when (and gnus-summary-expunge-below
- (< (setq score
- (or (cdr (assq number gnus-newsgroup-scored))
- gnus-summary-default-score))
- gnus-summary-expunge-below))
- ;; We increase the expunge-tally here, but that has
- ;; nothing to do with the limits, really.
- (incf gnus-newsgroup-expunged-tally)
- ;; We also mark as read here, if that's wanted.
- (when (and gnus-summary-mark-below
- (< score gnus-summary-mark-below))
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- (if gnus-newsgroup-auto-expire
- (push number gnus-newsgroup-expirable)
- (push (cons number gnus-low-score-mark)
- gnus-newsgroup-reads)))
- t)
- ;; Do the `display' group parameter.
- (and gnus-newsgroup-display
- (not (funcall gnus-newsgroup-display)))
- ;; Check NoCeM things.
- (if (and gnus-use-nocem
- (gnus-nocem-unwanted-article-p
- (mail-header-id (car thread))))
- (progn
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- t))))
- ;; Nope, invisible article.
- 0
- ;; Ok, this article is to be visible, so we add it to the limit
- ;; and return 1.
- (push number gnus-newsgroup-limit)
- 1))))
-
-(defun gnus-expunge-thread (thread)
- "Mark all articles in THREAD as read."
- (let* ((number (mail-header-number (car thread))))
- (incf gnus-newsgroup-expunged-tally)
- ;; We also mark as read here, if that's wanted.
- (setq gnus-newsgroup-unreads
- (delq number gnus-newsgroup-unreads))
- (if gnus-newsgroup-auto-expire
- (push number gnus-newsgroup-expirable)
- (push (cons number gnus-low-score-mark)
- gnus-newsgroup-reads)))
- ;; Go recursively through all subthreads.
- (mapcar 'gnus-expunge-thread (cdr thread)))
-
-;; Summary article oriented commands
-
-(defun gnus-summary-refer-parent-article (n)
- "Refer parent article N times.
-If N is negative, go to ancestor -N instead.
-The difference between N and the number of articles fetched is returned."
- (interactive "p")
- (let ((skip 1)
- error header ref)
- (when (not (natnump n))
- (setq skip (abs n)
- n 1))
- (while (and (> n 0)
- (not error))
- (setq header (gnus-summary-article-header))
- (if (and (eq (mail-header-number header)
- (cdr gnus-article-current))
- (equal gnus-newsgroup-name
- (car gnus-article-current)))
- ;; If we try to find the parent of the currently
- ;; displayed article, then we take a look at the actual
- ;; References header, since this is slightly more
- ;; reliable than the References field we got from the
- ;; server.
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (nnheader-narrow-to-headers)
- (unless (setq ref (message-fetch-field "references"))
- (when (setq ref (message-fetch-field "in-reply-to"))
- (setq ref (gnus-extract-message-id-from-in-reply-to ref))))
- (widen))
- (setq ref
- ;; It's not the current article, so we take a bet on
- ;; the value we got from the server.
- (mail-header-references header)))
- (if (and ref
- (not (equal ref "")))
- (unless (gnus-summary-refer-article (gnus-parent-id ref skip))
- (gnus-message 1 "Couldn't find parent"))
- (gnus-message 1 "No references in article %d"
- (gnus-summary-article-number))
- (setq error t))
- (decf n))
- (gnus-summary-position-point)
- n))
-
-(defun gnus-summary-refer-references ()
- "Fetch all articles mentioned in the References header.
-Return the number of articles fetched."
- (interactive)
- (let ((ref (mail-header-references (gnus-summary-article-header)))
- (current (gnus-summary-article-number))
- (n 0))
- (if (or (not ref)
- (equal ref ""))
- (error "No References in the current article")
- ;; For each Message-ID in the References header...
- (while (string-match "<[^>]*>" ref)
- (incf n)
- ;; ... fetch that article.
- (gnus-summary-refer-article
- (prog1 (match-string 0 ref)
- (setq ref (substring ref (match-end 0))))))
- (gnus-summary-goto-subject current)
- (gnus-summary-position-point)
- n)))
-
-(defun gnus-summary-refer-thread (&optional limit)
- "Fetch all articles in the current thread.
-If LIMIT (the numerical prefix), fetch that many old headers instead
-of what's specified by the `gnus-refer-thread-limit' variable."
- (interactive "P")
- (let ((id (mail-header-id (gnus-summary-article-header)))
- (limit (if limit (prefix-numeric-value limit)
- gnus-refer-thread-limit)))
- (unless (eq gnus-fetch-old-headers 'invisible)
- (gnus-message 5 "Fetching headers for %s..." gnus-newsgroup-name)
- ;; Retrieve the headers and read them in.
- (if (eq (if (numberp limit)
- (gnus-retrieve-headers
- (list (min
- (+ (mail-header-number
- (gnus-summary-article-header))
- limit)
- gnus-newsgroup-end))
- gnus-newsgroup-name (* limit 2))
- ;; gnus-refer-thread-limit is t, i.e. fetch _all_
- ;; headers.
- (gnus-retrieve-headers (list gnus-newsgroup-end)
- gnus-newsgroup-name limit))
- 'nov)
- (gnus-build-all-threads)
- (error "Can't fetch thread from back ends that don't support NOV"))
- (gnus-message 5 "Fetching headers for %s...done" gnus-newsgroup-name))
- (gnus-summary-limit-include-thread id)))
-
-(defun gnus-summary-refer-article (message-id)
- "Fetch an article specified by MESSAGE-ID."
- (interactive "sMessage-ID: ")
- (when (and (stringp message-id)
- (not (zerop (length message-id))))
- (setq message-id (gnus-replace-in-string message-id " " ""))
- ;; Construct the correct Message-ID if necessary.
- ;; Suggested by tale@pawl.rpi.edu.
- (unless (string-match "^<" message-id)
- (setq message-id (concat "<" message-id)))
- (unless (string-match ">$" message-id)
- (setq message-id (concat message-id ">")))
- ;; People often post MIDs from URLs, so unhex it:
- (unless (string-match "@" message-id)
- (setq message-id (gnus-url-unhex-string message-id)))
- (let* ((header (gnus-id-to-header message-id))
- (sparse (and header
- (gnus-summary-article-sparse-p
- (mail-header-number header))
- (memq (mail-header-number header)
- gnus-newsgroup-limit)))
- number)
- (cond
- ;; If the article is present in the buffer we just go to it.
- ((and header
- (or (not (gnus-summary-article-sparse-p
- (mail-header-number header)))
- sparse))
- (prog1
- (gnus-summary-goto-article
- (mail-header-number header) nil t)
- (when sparse
- (gnus-summary-update-article (mail-header-number header)))))
- (t
- ;; We fetch the article.
- (catch 'found
- (dolist (gnus-override-method (gnus-refer-article-methods))
- (when (and (gnus-check-server gnus-override-method)
- ;; Fetch the header,
- (setq number (gnus-summary-insert-subject message-id)))
- ;; and display the article.
- (gnus-summary-select-article nil nil nil number)
- (throw 'found t)))
- (gnus-message 3 "Couldn't fetch article %s" message-id)))))))
-
-(defun gnus-refer-article-methods ()
- "Return a list of referable methods."
- (cond
- ;; No method, so we default to current and native.
- ((null gnus-refer-article-method)
- (list gnus-current-select-method gnus-select-method))
- ;; Current.
- ((eq 'current gnus-refer-article-method)
- (list gnus-current-select-method))
- ;; List of select methods.
- ((not (and (symbolp (car gnus-refer-article-method))
- (assq (car gnus-refer-article-method) nnoo-definition-alist)))
- (let (out)
- (dolist (method gnus-refer-article-method)
- (push (if (eq 'current method)
- gnus-current-select-method
- method)
- out))
- (nreverse out)))
- ;; One single select method.
- (t
- (list gnus-refer-article-method))))
-
-(defun gnus-summary-edit-parameters ()
- "Edit the group parameters of the current group."
- (interactive)
- (gnus-group-edit-group gnus-newsgroup-name 'params))
-
-(defun gnus-summary-customize-parameters ()
- "Customize the group parameters of the current group."
- (interactive)
- (gnus-group-customize gnus-newsgroup-name))
-
-(defun gnus-summary-enter-digest-group (&optional force)
- "Enter an nndoc group based on the current article.
-If FORCE, force a digest interpretation. If not, try
-to guess what the document format is."
- (interactive "P")
- (let ((conf gnus-current-window-configuration))
- (save-window-excursion
- (save-excursion
- (let (gnus-article-prepare-hook
- gnus-display-mime-function
- gnus-break-pages)
- (gnus-summary-select-article))))
- (setq gnus-current-window-configuration conf)
- (let* ((name (format "%s-%d"
- (gnus-group-prefixed-name
- gnus-newsgroup-name (list 'nndoc ""))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-current-article)))
- (ogroup gnus-newsgroup-name)
- (params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))
- (list (cons 'parent-group ogroup))
- (list (cons 'save-article-group ogroup))))
- (case-fold-search t)
- (buf (current-buffer))
- dig to-address)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- ;; Have the digest group inherit the main mail address of
- ;; the parent article.
- (when (setq to-address (or (gnus-fetch-field "reply-to")
- (gnus-fetch-field "from")))
- (setq params
- (append
- (list (cons 'to-address
- (funcall gnus-decode-encoded-address-function
- to-address))))))
- (setq dig (nnheader-set-temp-buffer " *gnus digest buffer*"))
- (insert-buffer-substring gnus-original-article-buffer)
- ;; Remove lines that may lead nndoc to misinterpret the
- ;; document type.
- (narrow-to-region
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point)))
- (goto-char (point-min))
- (delete-matching-lines "^Path:\\|^From ")
- (widen))
- (unwind-protect
- (if (let ((gnus-newsgroup-ephemeral-charset gnus-newsgroup-charset)
- (gnus-newsgroup-ephemeral-ignored-charsets
- gnus-newsgroup-ignored-charsets))
- (gnus-group-read-ephemeral-group
- name `(nndoc ,name (nndoc-address ,(get-buffer dig))
- (nndoc-article-type
- ,(if force 'mbox 'guess)))
- t nil nil nil
- `((adapt-file . ,(gnus-score-file-name gnus-newsgroup-name
- "ADAPT")))))
- ;; Make all postings to this group go to the parent group.
- (nconc (gnus-info-params (gnus-get-info name))
- params)
- ;; Couldn't select this doc group.
- (switch-to-buffer buf)
- (gnus-set-global-variables)
- (gnus-configure-windows 'summary)
- (gnus-message 3 "Article couldn't be entered?"))
- (kill-buffer dig)))))
-
-(defun gnus-summary-read-document (n)
- "Open a new group based on the current article(s).
-This will allow you to read digests and other similar
-documents as newsgroups.
-Obeys the standard process/prefix convention."
- (interactive "P")
- (let* ((articles (gnus-summary-work-articles n))
- (ogroup gnus-newsgroup-name)
- (params (append (gnus-info-params (gnus-get-info ogroup))
- (list (cons 'to-group ogroup))))
- article group egroup groups vgroup)
- (while (setq article (pop articles))
- (setq group (format "%s-%d" gnus-newsgroup-name article))
- (gnus-summary-remove-process-mark article)
- (when (gnus-summary-display-article article)
- (save-excursion
- (with-temp-buffer
- (insert-buffer-substring gnus-original-article-buffer)
- ;; Remove some headers that may lead nndoc to make
- ;; the wrong guess.
- (message-narrow-to-head)
- (goto-char (point-min))
- (delete-matching-lines "^\\(Path\\):\\|^From ")
- (widen)
- (if (setq egroup
- (gnus-group-read-ephemeral-group
- group `(nndoc ,group (nndoc-address ,(current-buffer))
- (nndoc-article-type guess))
- t nil t))
- (progn
- ;; Make all postings to this group go to the parent group.
- (nconc (gnus-info-params (gnus-get-info egroup))
- params)
- (push egroup groups))
- ;; Couldn't select this doc group.
- (gnus-error 3 "Article couldn't be entered"))))))
- ;; Now we have selected all the documents.
- (cond
- ((not groups)
- (error "None of the articles could be interpreted as documents"))
- ((gnus-group-read-ephemeral-group
- (setq vgroup (format
- "nnvirtual:%s-%s" gnus-newsgroup-name
- (format-time-string "%Y%m%dT%H%M%S" (current-time))))
- `(nnvirtual ,vgroup (nnvirtual-component-groups ,groups))
- t
- (cons (current-buffer) 'summary)))
- (t
- (error "Couldn't select virtual nndoc group")))))
-
-(defun gnus-summary-isearch-article (&optional regexp-p)
- "Do incremental search forward on the current article.
-If REGEXP-P (the prefix) is non-nil, do regexp isearch."
- (interactive "P")
- (gnus-summary-select-article)
- (gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (isearch-forward regexp-p))))
-
-(defun gnus-summary-search-article-forward (regexp &optional backward)
- "Search for an article containing REGEXP forward.
-If BACKWARD, search backward instead."
- (interactive
- (list (read-string
- (format "Search article %s (regexp%s): "
- (if current-prefix-arg "backward" "forward")
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))
- current-prefix-arg))
- (if (string-equal regexp "")
- (setq regexp (or gnus-last-search-regexp ""))
- (setq gnus-last-search-regexp regexp)
- (setq gnus-article-before-search gnus-current-article))
- ;; Intentionally set gnus-last-article.
- (setq gnus-last-article gnus-article-before-search)
- (let ((gnus-last-article gnus-last-article))
- (if (gnus-summary-search-article regexp backward)
- (gnus-summary-show-thread)
- (signal 'search-failed (list regexp)))))
-
-(defun gnus-summary-search-article-backward (regexp)
- "Search for an article containing REGEXP backward."
- (interactive
- (list (read-string
- (format "Search article backward (regexp%s): "
- (if gnus-last-search-regexp
- (concat ", default " gnus-last-search-regexp)
- "")))))
- (gnus-summary-search-article-forward regexp 'backward))
-
-(defun gnus-summary-search-article (regexp &optional backward)
- "Search for an article containing REGEXP.
-Optional argument BACKWARD means do search for backward.
-`gnus-select-article-hook' is not called during the search."
- ;; We have to require this here to make sure that the following
- ;; dynamic binding isn't shadowed by autoloading.
- (require 'gnus-async)
- (require 'gnus-art)
- (let ((gnus-select-article-hook nil) ;Disable hook.
- (gnus-article-prepare-hook nil)
- (gnus-mark-article-hook nil) ;Inhibit marking as read.
- (gnus-use-article-prefetch nil)
- (gnus-xmas-force-redisplay nil) ;Inhibit XEmacs redisplay.
- (gnus-use-trees nil) ;Inhibit updating tree buffer.
- (gnus-visual nil)
- (gnus-keep-backlog nil)
- (gnus-break-pages nil)
- (gnus-summary-display-arrow nil)
- (gnus-updated-mode-lines nil)
- (gnus-auto-center-summary nil)
- (sum (current-buffer))
- (gnus-display-mime-function nil)
- (found nil)
- point)
- (gnus-save-hidden-threads
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (goto-char (window-point (get-buffer-window (current-buffer))))
- (when backward
- (forward-line -1))
- (while (not found)
- (gnus-message 7 "Searching article: %d..." (cdr gnus-article-current))
- (if (if backward
- (re-search-backward regexp nil t)
- (re-search-forward regexp nil t))
- ;; We found the regexp.
- (progn
- (setq found 'found)
- (beginning-of-line)
- (set-window-start
- (get-buffer-window (current-buffer))
- (point))
- (forward-line 1)
- (set-window-point
- (get-buffer-window (current-buffer))
- (point))
- (set-buffer sum)
- (setq point (point)))
- ;; We didn't find it, so we go to the next article.
- (set-buffer sum)
- (setq found 'not)
- (while (eq found 'not)
- (if (not (if backward (gnus-summary-find-prev)
- (gnus-summary-find-next)))
- ;; No more articles.
- (setq found t)
- ;; Select the next article and adjust point.
- (unless (gnus-summary-article-sparse-p
- (gnus-summary-article-number))
- (setq found nil)
- (gnus-summary-select-article)
- (set-buffer gnus-article-buffer)
- (widen)
- (goto-char (if backward (point-max) (point-min))))))))
- (gnus-message 7 ""))
- ;; Return whether we found the regexp.
- (when (eq found 'found)
- (goto-char point)
- (gnus-summary-show-thread)
- (gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-position-point)
- t)))
-
-(defun gnus-find-matching-articles (header regexp)
- "Return a list of all articles that match REGEXP on HEADER.
-This search includes all articles in the current group that Gnus has
-fetched headers for, whether they are displayed or not."
- (let ((articles nil)
- (func `(lambda (h) (,(intern (concat "mail-header-" header)) h)))
- (case-fold-search t))
- (dolist (header gnus-newsgroup-headers)
- (when (string-match regexp (funcall func header))
- (push (mail-header-number header) articles)))
- (nreverse articles)))
-
-(defun gnus-summary-find-matching (header regexp &optional backward unread
- not-case-fold not-matching)
- "Return a list of all articles that match REGEXP on HEADER.
-The search stars on the current article and goes forwards unless
-BACKWARD is non-nil. If BACKWARD is `all', do all articles.
-If UNREAD is non-nil, only unread articles will
-be taken into consideration. If NOT-CASE-FOLD, case won't be folded
-in the comparisons. If NOT-MATCHING, return a list of all articles that
-not match REGEXP on HEADER."
- (let ((case-fold-search (not not-case-fold))
- articles d func)
- (if (consp header)
- (if (eq (car header) 'extra)
- (setq func
- `(lambda (h)
- (or (cdr (assq ',(cdr header) (mail-header-extra h)))
- "")))
- (error "%s is an invalid header" header))
- (unless (fboundp (intern (concat "mail-header-" header)))
- (error "%s is not a valid header" header))
- (setq func `(lambda (h) (,(intern (concat "mail-header-" header)) h))))
- (dolist (d (if (eq backward 'all)
- gnus-newsgroup-data
- (gnus-data-find-list
- (gnus-summary-article-number)
- (gnus-data-list backward))))
- (when (and (or (not unread) ; We want all articles...
- (gnus-data-unread-p d)) ; Or just unreads.
- (vectorp (gnus-data-header d)) ; It's not a pseudo.
- (if not-matching
- (not (string-match
- regexp
- (funcall func (gnus-data-header d))))
- (string-match regexp
- (funcall func (gnus-data-header d)))))
- (push (gnus-data-number d) articles))) ; Success!
- (nreverse articles)))
-
-(defun gnus-summary-execute-command (header regexp command &optional backward)
- "Search forward for an article whose HEADER matches REGEXP and execute COMMAND.
-If HEADER is an empty string (or nil), the match is done on the entire
-article. If BACKWARD (the prefix) is non-nil, search backward instead."
- (interactive
- (list (let ((completion-ignore-case t))
- (completing-read
- "Header name: "
- (mapcar (lambda (header) (list (format "%s" header)))
- (append
- '("Number" "Subject" "From" "Lines" "Date"
- "Message-ID" "Xref" "References" "Body")
- gnus-extra-headers))
- nil 'require-match))
- (read-string "Regexp: ")
- (read-key-sequence "Command: ")
- current-prefix-arg))
- (when (equal header "Body")
- (setq header ""))
- ;; Hidden thread subtrees must be searched as well.
- (gnus-summary-show-all-threads)
- ;; We don't want to change current point nor window configuration.
- (save-excursion
- (save-window-excursion
- (let (gnus-visual
- gnus-treat-strip-trailing-blank-lines
- gnus-treat-strip-leading-blank-lines
- gnus-treat-strip-multiple-blank-lines
- gnus-treat-hide-boring-headers
- gnus-treat-fold-newsgroups
- gnus-article-prepare-hook)
- (gnus-message 6 "Executing %s..." (key-description command))
- ;; We'd like to execute COMMAND interactively so as to give arguments.
- (gnus-execute header regexp
- `(call-interactively ',(key-binding command))
- backward)
- (gnus-message 6 "Executing %s...done" (key-description command))))))
-
-(defun gnus-summary-beginning-of-article ()
- "Scroll the article back to the beginning."
- (interactive)
- (gnus-summary-select-article)
- (gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (widen)
- (goto-char (point-min))
- (when gnus-break-pages
- (gnus-narrow-to-page))))
-
-(defun gnus-summary-end-of-article ()
- "Scroll to the end of the article."
- (interactive)
- (gnus-summary-select-article)
- (gnus-configure-windows 'article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (widen)
- (goto-char (point-max))
- (recenter -3)
- (when gnus-break-pages
- (gnus-narrow-to-page))))
-
-(defun gnus-summary-print-truncate-and-quote (string &optional len)
- "Truncate to LEN and quote all \"(\"'s in STRING."
- (gnus-replace-in-string (if (and len (> (length string) len))
- (substring string 0 len)
- string)
- "[()]" "\\\\\\&"))
-
-(defun gnus-summary-print-article (&optional filename n)
- "Generate and print a PostScript image of the process-marked (mail) articles.
-
-If used interactively, print the current article if none are
-process-marked. With prefix arg, prompt the user for the name of the
-file to save in.
-
-When used from Lisp, accept two optional args FILENAME and N. N means
-to print the next N articles. If N is negative, print the N previous
-articles. If N is nil and articles have been marked with the process
-mark, print these instead.
-
-If the optional first argument FILENAME is nil, send the image to the
-printer. If FILENAME is a string, save the PostScript image in a file with
-that name. If FILENAME is a number, prompt the user for the name of the file
-to save in."
- (interactive (list (ps-print-preprint current-prefix-arg)))
- (dolist (article (gnus-summary-work-articles n))
- (gnus-summary-select-article nil nil 'pseudo article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (gnus-print-buffer))
- (gnus-summary-remove-process-mark article))
- (ps-despool filename))
-
-(defun gnus-print-buffer ()
- (let ((buffer (generate-new-buffer " *print*")))
- (unwind-protect
- (progn
- (copy-to-buffer buffer (point-min) (point-max))
- (set-buffer buffer)
- (gnus-remove-text-with-property 'gnus-decoration)
- (when (gnus-visual-p 'article-highlight 'highlight)
- ;; Copy-to-buffer doesn't copy overlay. So redo
- ;; highlight.
- (let ((gnus-article-buffer buffer))
- (gnus-article-highlight-citation t)
- (gnus-article-highlight-signature)
- (gnus-article-emphasize)
- (gnus-article-delete-invisible-text)))
- (let ((ps-left-header
- (list
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-subject gnus-current-headers)
- 66) ")")
- (concat "("
- (gnus-summary-print-truncate-and-quote
- (mail-header-from gnus-current-headers)
- 45) ")")))
- (ps-right-header
- (list
- "/pagenumberstring load"
- (concat "("
- (mail-header-date gnus-current-headers) ")"))))
- (gnus-run-hooks 'gnus-ps-print-hook)
- (save-excursion
- (if ps-print-color-p
- (ps-spool-buffer-with-faces)
- (ps-spool-buffer)))))
- (kill-buffer buffer))))
-
-(defun gnus-summary-show-article (&optional arg)
- "Force redisplaying of the current article.
-If ARG (the prefix) is a number, show the article with the charset
-defined in `gnus-summary-show-article-charset-alist', or the charset
-input.
-If ARG (the prefix) is non-nil and not a number, show the raw article
-without any article massaging functions being run. Normally, the key
-strokes are `C-u g'."
- (interactive "P")
- (cond
- ((numberp arg)
- (gnus-summary-show-article t)
- (let ((gnus-newsgroup-charset
- (or (cdr (assq arg gnus-summary-show-article-charset-alist))
- (mm-read-coding-system
- "View as charset: " ;; actually it is coding system.
- (save-excursion
- (set-buffer gnus-article-buffer)
- (mm-detect-coding-region (point) (point-max))))))
- (gnus-newsgroup-ignored-charsets 'gnus-all))
- (gnus-summary-select-article nil 'force)
- (let ((deps gnus-newsgroup-dependencies)
- head header lines)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (save-restriction
- (message-narrow-to-head)
- (setq head (buffer-string))
- (goto-char (point-min))
- (unless (re-search-forward "^lines:[ \t]\\([0-9]+\\)" nil t)
- (goto-char (point-max))
- (widen)
- (setq lines (1- (count-lines (point) (point-max))))))
- (with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
- (insert head)
- (if lines (insert (format "Lines: %d\n" lines)))
- (insert ".\n")
- (let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers deps t))))))
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header)
- (when (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark (cdr gnus-article-current))))))
- ((not arg)
- ;; Select the article the normal way.
- (gnus-summary-select-article nil 'force))
- (t
- ;; We have to require this here to make sure that the following
- ;; dynamic binding isn't shadowed by autoloading.
- (require 'gnus-async)
- (require 'gnus-art)
- ;; Bind the article treatment functions to nil.
- (let ((gnus-have-all-headers t)
- gnus-article-prepare-hook
- gnus-article-decode-hook
- gnus-display-mime-function
- gnus-break-pages)
- ;; Destroy any MIME parts.
- (when (gnus-buffer-live-p gnus-article-buffer)
- (save-excursion
- (set-buffer gnus-article-buffer)
- (mm-destroy-parts gnus-article-mime-handles)
- ;; Set it to nil for safety reason.
- (setq gnus-article-mime-handle-alist nil)
- (setq gnus-article-mime-handles nil)))
- (gnus-summary-select-article nil 'force))))
- (gnus-summary-goto-subject gnus-current-article)
- (gnus-summary-position-point))
-
-(defun gnus-summary-show-raw-article ()
- "Show the raw article without any article massaging functions being run."
- (interactive)
- (gnus-summary-show-article t))
-
-(defun gnus-summary-verbose-headers (&optional arg)
- "Toggle permanent full header display.
-If ARG is a positive number, turn header display on.
-If ARG is a negative number, turn header display off."
- (interactive "P")
- (setq gnus-show-all-headers
- (cond ((or (not (numberp arg))
- (zerop arg))
- (not gnus-show-all-headers))
- ((natnump arg)
- t)))
- (gnus-summary-show-article))
-
-(defun gnus-summary-toggle-header (&optional arg)
- "Show the headers if they are hidden, or hide them if they are shown.
-If ARG is a positive number, show the entire header.
-If ARG is a negative number, hide the unwanted header lines."
- (interactive "P")
- (let ((window (and (gnus-buffer-live-p gnus-article-buffer)
- (get-buffer-window gnus-article-buffer t))))
- (with-current-buffer gnus-article-buffer
- (widen)
- (article-narrow-to-head)
- (let* ((buffer-read-only nil)
- (inhibit-point-motion-hooks t)
- (hidden (if (numberp arg)
- (>= arg 0)
- (or (not (looking-at "[^ \t\n]+:"))
- (gnus-article-hidden-text-p 'headers))))
- s e)
- (delete-region (point-min) (point-max))
- (with-current-buffer gnus-original-article-buffer
- (goto-char (setq s (point-min)))
- (setq e (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- (insert-buffer-substring gnus-original-article-buffer s e)
- (run-hooks 'gnus-article-decode-hook)
- (if hidden
- (let ((gnus-treat-hide-headers nil)
- (gnus-treat-hide-boring-headers nil))
- (gnus-delete-wash-type 'headers)
- (gnus-treat-article 'head))
- (gnus-treat-article 'head))
- (widen)
- (if window
- (set-window-start window (goto-char (point-min))))
- (if gnus-break-pages
- (gnus-narrow-to-page)
- (when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next))))
- (gnus-set-mode-line 'article)))))
-
-(defun gnus-summary-show-all-headers ()
- "Make all header lines visible."
- (interactive)
- (gnus-summary-toggle-header 1))
-
-(defun gnus-summary-caesar-message (&optional arg)
- "Caesar rotate the current article by 13.
-The numerical prefix specifies how many places to rotate each letter
-forward."
- (interactive "P")
- (gnus-summary-select-article)
- (let ((mail-header-separator ""))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (let ((start (window-start))
- buffer-read-only)
- (message-caesar-buffer-body arg)
- (set-window-start (get-buffer-window (current-buffer)) start)))))
- ;; Create buttons and stuff...
- (gnus-treat-article nil))
-
-(autoload 'unmorse-region "morse"
- "Convert morse coded text in region to ordinary ASCII text."
- t)
-
-(defun gnus-summary-morse-message (&optional arg)
- "Morse decode the current article."
- (interactive "P")
- (gnus-summary-select-article)
- (let ((mail-header-separator ""))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (let ((pos (window-start))
- buffer-read-only)
- (goto-char (point-min))
- (when (message-goto-body)
- (gnus-narrow-to-body))
- (goto-char (point-min))
- (while (re-search-forward "·" (point-max) t)
- (replace-match "."))
- (unmorse-region (point-min) (point-max))
- (widen)
- (set-window-start (get-buffer-window (current-buffer)) pos)))))))
-
-(defun gnus-summary-stop-page-breaking ()
- "Stop page breaking in the current article."
- (interactive)
- (gnus-summary-select-article)
- (gnus-eval-in-buffer-window gnus-article-buffer
- (widen)
- (when (gnus-visual-p 'page-marker)
- (let ((buffer-read-only nil))
- (gnus-remove-text-with-property 'gnus-prev)
- (gnus-remove-text-with-property 'gnus-next))
- (setq gnus-page-broken nil))))
-
-(defun gnus-summary-move-article (&optional n to-newsgroup
- select-method action)
- "Move the current article to a different newsgroup.
-If N is a positive number, move the N next articles.
-If N is a negative number, move the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-move those articles instead.
-If TO-NEWSGROUP is string, do not prompt for a newsgroup to move to.
-If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
-re-spool using this method.
-
-When called interactively with TO-NEWSGROUP being nil, the value of
-the variable `gnus-move-split-methods' is used for finding a default
-for the target newsgroup.
-
-For this function to work, both the current newsgroup and the
-newsgroup that you want to move to have to support the `request-move'
-and `request-accept' functions.
-
-ACTION can be either `move' (the default), `crosspost' or `copy'."
- (interactive "P")
- (unless action
- (setq action 'move))
- ;; Check whether the source group supports the required functions.
- (cond ((and (eq action 'move)
- (not (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)))
- (error "The current group does not support article moving"))
- ((and (eq action 'crosspost)
- (not (gnus-check-backend-function
- 'request-replace-article gnus-newsgroup-name)))
- (error "The current group does not support article editing")))
- (let ((articles (gnus-summary-work-articles n))
- (prefix (if (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name)
- (gnus-group-real-prefix gnus-newsgroup-name)
- ""))
- (names '((move "Move" "Moving")
- (copy "Copy" "Copying")
- (crosspost "Crosspost" "Crossposting")))
- (copy-buf (save-excursion
- (nnheader-set-temp-buffer " *copy article*")))
- art-group to-method new-xref article to-groups)
- (unless (assq action names)
- (error "Unknown action %s" action))
- ;; Read the newsgroup name.
- (when (and (not to-newsgroup)
- (not select-method))
- (if (and gnus-move-split-methods
- (not
- (and (memq gnus-current-article articles)
- (gnus-buffer-live-p gnus-original-article-buffer))))
- ;; When `gnus-move-split-methods' is non-nil, we have to
- ;; select an article to give `gnus-read-move-group-name' an
- ;; opportunity to suggest an appropriate default. However,
- ;; we needn't render or mark the article.
- (let ((gnus-display-mime-function nil)
- (gnus-article-prepare-hook nil)
- (gnus-mark-article-hook nil))
- (gnus-summary-select-article nil nil nil (car articles))))
- (setq to-newsgroup
- (gnus-read-move-group-name
- (cadr (assq action names))
- (symbol-value (intern (format "gnus-current-%s-group" action)))
- articles prefix))
- (set (intern (format "gnus-current-%s-group" action)) to-newsgroup))
- (setq to-method (or select-method
- (gnus-server-to-method
- (gnus-group-method to-newsgroup))))
- ;; Check the method we are to move this article to...
- (unless (gnus-check-backend-function
- 'request-accept-article (car to-method))
- (error "%s does not support article copying" (car to-method)))
- (unless (gnus-check-server to-method)
- (error "Can't open server %s" (car to-method)))
- (gnus-message 6 "%s to %s: %s..."
- (caddr (assq action names))
- (or (car select-method) to-newsgroup) articles)
- (while articles
- (setq article (pop articles))
- (setq
- art-group
- (cond
- ;; Move the article.
- ((eq action 'move)
- ;; Remove this article from future suppression.
- (gnus-dup-unsuppress-article article)
- (gnus-request-move-article
- article ; Article to move
- gnus-newsgroup-name ; From newsgroup
- (nth 1 (gnus-find-method-for-group
- gnus-newsgroup-name)) ; Server
- (list 'gnus-request-accept-article
- to-newsgroup (list 'quote select-method)
- (not articles) t) ; Accept form
- (not articles))) ; Only save nov last time
- ;; Copy the article.
- ((eq action 'copy)
- (save-excursion
- (set-buffer copy-buf)
- (when (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (gnus-request-accept-article
- to-newsgroup select-method (not articles) t))))
- ;; Crosspost the article.
- ((eq action 'crosspost)
- (let ((xref (message-tokenize-header
- (mail-header-xref (gnus-summary-article-header article))
- " ")))
- (setq new-xref (concat (gnus-group-real-name gnus-newsgroup-name)
- ":" (number-to-string article)))
- (unless xref
- (setq xref (list (system-name))))
- (setq new-xref
- (concat
- (mapconcat 'identity
- (delete "Xref:" (delete new-xref xref))
- " ")
- " " new-xref))
- (save-excursion
- (set-buffer copy-buf)
- ;; First put the article in the destination group.
- (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (when (consp (setq art-group
- (gnus-request-accept-article
- to-newsgroup select-method (not articles) t)))
- (setq new-xref (concat new-xref " " (car art-group)
- ":"
- (number-to-string (cdr art-group))))
- ;; Now we have the new Xrefs header, so we insert
- ;; it and replace the new article.
- (nnheader-replace-header "Xref" new-xref)
- (gnus-request-replace-article
- (cdr art-group) to-newsgroup (current-buffer) t)
- art-group))))))
- (cond
- ((not art-group)
- (gnus-message 1 "Couldn't %s article %s: %s"
- (cadr (assq action names)) article
- (nnheader-get-report (car to-method))))
- ((eq art-group 'junk)
- (when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark)
- (gnus-message 4 "Deleted article %s" article)
- ;; run the delete hook
- (run-hook-with-args 'gnus-summary-article-delete-hook
- action
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name nil
- select-method)))
- (t
- (let* ((pto-group (gnus-group-prefixed-name
- (car art-group) to-method))
- (entry
- (gnus-gethash pto-group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (to-group (gnus-info-group info))
- to-marks)
- ;; Update the group that has been moved to.
- (when (and info
- (memq action '(move copy)))
- (unless (member to-group to-groups)
- (push to-group to-groups))
-
- (unless (memq article gnus-newsgroup-unreads)
- (push 'read to-marks)
- (gnus-info-set-read
- info (gnus-add-to-range (gnus-info-read info)
- (list (cdr art-group)))))
-
- ;; See whether the article is to be put in the cache.
- (let ((marks (if (gnus-group-auto-expirable-p to-group)
- gnus-article-mark-lists
- (delete '(expirable . expire)
- (copy-sequence gnus-article-mark-lists))))
- (to-article (cdr art-group)))
-
- ;; Enter the article into the cache in the new group,
- ;; if that is required.
- (when gnus-use-cache
- (gnus-cache-possibly-enter-article
- to-group to-article
- (memq article gnus-newsgroup-marked)
- (memq article gnus-newsgroup-dormant)
- (memq article gnus-newsgroup-unreads)))
-
- (when gnus-preserve-marks
- ;; Copy any marks over to the new group.
- (when (and (equal to-group gnus-newsgroup-name)
- (not (memq article gnus-newsgroup-unreads)))
- ;; Mark this article as read in this group.
- (push (cons to-article gnus-read-mark) gnus-newsgroup-reads)
- (setcdr (gnus-active to-group) to-article)
- (setcdr gnus-newsgroup-active to-article))
-
- (while marks
- (when (eq (gnus-article-mark-to-type (cdar marks)) 'list)
- (when (memq article (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))
- (push (cdar marks) to-marks)
- ;; If the other group is the same as this group,
- ;; then we have to add the mark to the list.
- (when (equal to-group gnus-newsgroup-name)
- (set (intern (format "gnus-newsgroup-%s" (caar marks)))
- (cons to-article
- (symbol-value
- (intern (format "gnus-newsgroup-%s"
- (caar marks)))))))
- ;; Copy the marks to other group.
- (gnus-add-marked-articles
- to-group (cdar marks) (list to-article) info)))
- (setq marks (cdr marks)))
-
- (gnus-request-set-mark
- to-group (list (list (list to-article) 'add to-marks))))
-
- (gnus-dribble-enter
- (concat "(gnus-group-set-info '"
- (gnus-prin1-to-string (gnus-get-info to-group))
- ")"))))
-
- ;; Update the Xref header in this article to point to
- ;; the new crossposted article we have just created.
- (when (eq action 'crosspost)
- (save-excursion
- (set-buffer copy-buf)
- (gnus-request-article-this-buffer article gnus-newsgroup-name)
- (nnheader-replace-header "Xref" new-xref)
- (gnus-request-replace-article
- article gnus-newsgroup-name (current-buffer) t)))
-
- ;; run the move/copy/crosspost/respool hook
- (run-hook-with-args 'gnus-summary-article-move-hook
- action
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- to-newsgroup
- select-method))
-
- ;;;!!!Why is this necessary?
- (set-buffer gnus-summary-buffer)
-
- (gnus-summary-goto-subject article)
- (when (eq action 'move)
- (gnus-summary-mark-article article gnus-canceled-mark))))
- (gnus-summary-remove-process-mark article))
- ;; Re-activate all groups that have been moved to.
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let ((gnus-group-marked to-groups))
- (gnus-group-get-new-news-this-group nil t)))
-
- (gnus-kill-buffer copy-buf)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary)))
-
-(defun gnus-summary-copy-article (&optional n to-newsgroup select-method)
- "Copy the current article to some other group.
-If TO-NEWSGROUP is string, do not prompt for a newsgroup to copy to.
-When called interactively, if TO-NEWSGROUP is nil, use the value of
-the variable `gnus-move-split-methods' for finding a default target
-newsgroup.
-If SELECT-METHOD is non-nil, do not move to a specific newsgroup, but
-re-spool using this method."
- (interactive "P")
- (gnus-summary-move-article n to-newsgroup select-method 'copy))
-
-(defun gnus-summary-crosspost-article (&optional n)
- "Crosspost the current article to some other group."
- (interactive "P")
- (gnus-summary-move-article n nil nil 'crosspost))
-
-(defcustom gnus-summary-respool-default-method nil
- "Default method type for respooling an article.
-If nil, use to the current newsgroup method."
- :type 'symbol
- :group 'gnus-summary-mail)
-
-(defcustom gnus-summary-display-while-building nil
- "If non-nil, show and update the summary buffer as it's being built.
-If the value is t, update the buffer after every line is inserted. If
-the value is an integer (N), update the display every N lines."
- :version "22.1"
- :group 'gnus-thread
- :type '(choice (const :tag "off" nil)
- number
- (const :tag "frequently" t)))
-
-(defun gnus-summary-respool-article (&optional n method)
- "Respool the current article.
-The article will be squeezed through the mail spooling process again,
-which means that it will be put in some mail newsgroup or other
-depending on `nnmail-split-methods'.
-If N is a positive number, respool the N next articles.
-If N is a negative number, respool the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-respool those articles instead.
-
-Respooling can be done both from mail groups and \"real\" newsgroups.
-In the former case, the articles in question will be moved from the
-current group into whatever groups they are destined to. In the
-latter case, they will be copied into the relevant groups."
- (interactive
- (list current-prefix-arg
- (let* ((methods (gnus-methods-using 'respool))
- (methname
- (symbol-name (or gnus-summary-respool-default-method
- (car (gnus-find-method-for-group
- gnus-newsgroup-name)))))
- (method
- (gnus-completing-read-with-default
- methname "Backend to use when respooling"
- methods nil t nil 'gnus-mail-method-history))
- ms)
- (cond
- ((zerop (length (setq ms (gnus-servers-using-backend
- (intern method)))))
- (list (intern method) ""))
- ((= 1 (length ms))
- (car ms))
- (t
- (let ((ms-alist (mapcar (lambda (m) (cons (cadr m) m)) ms)))
- (cdr (assoc (completing-read "Server name: " ms-alist nil t)
- ms-alist))))))))
- (unless method
- (error "No method given for respooling"))
- (if (assoc (symbol-name
- (car (gnus-find-method-for-group gnus-newsgroup-name)))
- (gnus-methods-using 'respool))
- (gnus-summary-move-article n nil method)
- (gnus-summary-copy-article n nil method)))
-
-(defun gnus-summary-import-article (file &optional edit)
- "Import an arbitrary file into a mail newsgroup."
- (interactive "fImport file: \nP")
- (let ((group gnus-newsgroup-name)
- (now (current-time))
- atts lines group-art)
- (unless (gnus-check-backend-function 'request-accept-article group)
- (error "%s does not support article importing" group))
- (or (file-readable-p file)
- (not (file-regular-p file))
- (error "Can't read %s" file))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (if (nnheader-article-p)
- (save-restriction
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (narrow-to-region (point-min) (1- (point)))
- (goto-char (point-min))
- (unless (re-search-forward "^date:" nil t)
- (goto-char (point-max))
- (insert "Date: " (message-make-date (nth 5 atts)) "\n")))
- ;; This doesn't look like an article, so we fudge some headers.
- (setq atts (file-attributes file)
- lines (count-lines (point-min) (point-max)))
- (insert "From: " (read-string "From: ") "\n"
- "Subject: " (read-string "Subject: ") "\n"
- "Date: " (message-make-date (nth 5 atts)) "\n"
- "Message-ID: " (message-make-message-id) "\n"
- "Lines: " (int-to-string lines) "\n"
- "Chars: " (int-to-string (nth 7 atts)) "\n\n"))
- (setq group-art (gnus-request-accept-article group nil t))
- (kill-buffer (current-buffer)))
- (setq gnus-newsgroup-active (gnus-activate-group group))
- (forward-line 1)
- (gnus-summary-goto-article (cdr group-art) nil t)
- (when edit
- (gnus-summary-edit-article))))
-
-(defun gnus-summary-create-article ()
- "Create an article in a mail newsgroup."
- (interactive)
- (let ((group gnus-newsgroup-name)
- (now (current-time))
- group-art)
- (unless (gnus-check-backend-function 'request-accept-article group)
- (error "%s does not support article importing" group))
- (save-excursion
- (set-buffer (gnus-get-buffer-create " *import file*"))
- (erase-buffer)
- (goto-char (point-min))
- ;; This doesn't look like an article, so we fudge some headers.
- (insert "From: " (read-string "From: ") "\n"
- "Subject: " (read-string "Subject: ") "\n"
- "Date: " (message-make-date now) "\n"
- "Message-ID: " (message-make-message-id) "\n")
- (setq group-art (gnus-request-accept-article group nil t))
- (kill-buffer (current-buffer)))
- (setq gnus-newsgroup-active (gnus-activate-group group))
- (forward-line 1)
- (gnus-summary-goto-article (cdr group-art) nil t)
- (gnus-summary-edit-article)))
-
-(defun gnus-summary-article-posted-p ()
- "Say whether the current (mail) article is available from news as well.
-This will be the case if the article has both been mailed and posted."
- (interactive)
- (let ((id (mail-header-references (gnus-summary-article-header)))
- (gnus-override-method (car (gnus-refer-article-methods))))
- (if (gnus-request-head id "")
- (gnus-message 2 "The current message was found on %s"
- gnus-override-method)
- (gnus-message 2 "The current message couldn't be found on %s"
- gnus-override-method)
- nil)))
-
-(defun gnus-summary-expire-articles (&optional now)
- "Expire all articles that are marked as expirable in the current group."
- (interactive)
- (when (and (not gnus-group-is-exiting-without-update-p)
- (gnus-check-backend-function
- 'request-expire-articles gnus-newsgroup-name))
- ;; This backend supports expiry.
- (let* ((total (gnus-group-total-expirable-p gnus-newsgroup-name))
- (expirable (if total
- (progn
- ;; We need to update the info for
- ;; this group for `gnus-list-of-read-articles'
- ;; to give us the right answer.
- (gnus-run-hooks 'gnus-exit-group-hook)
- (gnus-summary-update-info)
- (gnus-list-of-read-articles gnus-newsgroup-name))
- (setq gnus-newsgroup-expirable
- (sort gnus-newsgroup-expirable '<))))
- (expiry-wait (if now 'immediate
- (gnus-group-find-parameter
- gnus-newsgroup-name 'expiry-wait)))
- (nnmail-expiry-target
- (or (gnus-group-find-parameter gnus-newsgroup-name 'expiry-target)
- nnmail-expiry-target))
- es)
- (when expirable
- ;; There are expirable articles in this group, so we run them
- ;; through the expiry process.
- (gnus-message 6 "Expiring articles...")
- (unless (gnus-check-group gnus-newsgroup-name)
- (error "Can't open server for %s" gnus-newsgroup-name))
- ;; The list of articles that weren't expired is returned.
- (save-excursion
- (if expiry-wait
- (let ((nnmail-expiry-wait-function nil)
- (nnmail-expiry-wait expiry-wait))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (setq es (gnus-request-expire-articles
- expirable gnus-newsgroup-name)))
- (unless total
- (setq gnus-newsgroup-expirable es))
- ;; We go through the old list of expirable, and mark all
- ;; really expired articles as nonexistent.
- (unless (eq es expirable) ;If nothing was expired, we don't mark.
- (let ((gnus-use-cache nil))
- (dolist (article expirable)
- (when (and (not (memq article es))
- (gnus-data-find article))
- (gnus-summary-mark-article article gnus-canceled-mark)
- (run-hook-with-args 'gnus-summary-article-expire-hook
- 'delete
- (gnus-data-header
- (assoc article (gnus-data-list nil)))
- gnus-newsgroup-name
- nil
- nil))))))
- (gnus-message 6 "Expiring articles...done")))))
-
-(defun gnus-summary-expire-articles-now ()
- "Expunge all expirable articles in the current group.
-This means that *all* articles that are marked as expirable will be
-deleted forever, right now."
- (interactive)
- (or gnus-expert-user
- (gnus-yes-or-no-p
- "Are you really, really sure you want to delete all expirable messages? ")
- (error "Phew!"))
- (gnus-summary-expire-articles t))
-
-;; Suggested by Jack Vinson <vinson@unagi.cis.upenn.edu>.
-(defun gnus-summary-delete-article (&optional n)
- "Delete the N next (mail) articles.
-This command actually deletes articles. This is not a marking
-command. The article will disappear forever from your life, never to
-return.
-
-If N is negative, delete backwards.
-If N is nil and articles have been marked with the process mark,
-delete these instead.
-
-If `gnus-novice-user' is non-nil you will be asked for
-confirmation before the articles are deleted."
- (interactive "P")
- (unless (gnus-check-backend-function 'request-expire-articles
- gnus-newsgroup-name)
- (error "The current newsgroup does not support article deletion"))
- (unless (gnus-check-server (gnus-find-method-for-group gnus-newsgroup-name))
- (error "Couldn't open server"))
- ;; Compute the list of articles to delete.
- (let ((articles (sort (copy-sequence (gnus-summary-work-articles n)) '<))
- (nnmail-expiry-target 'delete)
- not-deleted)
- (if (and gnus-novice-user
- (not (gnus-yes-or-no-p
- (format "Do you really want to delete %s forever? "
- (if (> (length articles) 1)
- (format "these %s articles" (length articles))
- "this article")))))
- ()
- ;; Delete the articles.
- (setq not-deleted (gnus-request-expire-articles
- articles gnus-newsgroup-name 'force))
- (while articles
- (gnus-summary-remove-process-mark (car articles))
- ;; The backend might not have been able to delete the article
- ;; after all.
- (unless (memq (car articles) not-deleted)
- (gnus-summary-mark-article (car articles) gnus-canceled-mark))
- (let* ((article (car articles))
- (id (mail-header-id (gnus-data-header
- (assoc article (gnus-data-list nil))))))
- (run-hook-with-args 'gnus-summary-article-delete-hook
- 'delete id gnus-newsgroup-name nil
- nil))
- (setq articles (cdr articles)))
- (when not-deleted
- (gnus-message 4 "Couldn't delete articles %s" not-deleted)))
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- not-deleted))
-
-(defun gnus-summary-edit-article (&optional arg)
- "Edit the current article.
-This will have permanent effect only in mail groups.
-If ARG is nil, edit the decoded articles.
-If ARG is 1, edit the raw articles.
-If ARG is 2, edit the raw articles even in read-only groups.
-If ARG is 3, edit the articles with the current handles.
-Otherwise, allow editing of articles even in read-only
-groups."
- (interactive "P")
- (let (force raw current-handles)
- (cond
- ((null arg))
- ((eq arg 1)
- (setq raw t))
- ((eq arg 2)
- (setq raw t
- force t))
- ((eq arg 3)
- (setq current-handles
- (and (gnus-buffer-live-p gnus-article-buffer)
- (with-current-buffer gnus-article-buffer
- (prog1
- gnus-article-mime-handles
- (setq gnus-article-mime-handles nil))))))
- (t
- (setq force t)))
- (when (and raw (not force)
- (member gnus-newsgroup-name '("nndraft:delayed"
- "nndraft:drafts"
- "nndraft:queue")))
- (error "Can't edit the raw article in group %s"
- gnus-newsgroup-name))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (let ((mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets))
- (gnus-set-global-variables)
- (when (and (not force)
- (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- (gnus-summary-show-article t)
- (when (and (not raw) (gnus-buffer-live-p gnus-article-buffer))
- (with-current-buffer gnus-article-buffer
- (mm-enable-multibyte)))
- (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
- (setq raw t))
- (gnus-article-edit-article
- (if raw 'ignore
- `(lambda ()
- (let ((mbl mml-buffer-list))
- (setq mml-buffer-list nil)
- (let ((rfc2047-quote-decoded-words-containing-tspecials t))
- (mime-to-mml ,'current-handles))
- (let ((mbl1 mml-buffer-list))
- (setq mml-buffer-list mbl)
- (set (make-local-variable 'mml-buffer-list) mbl1))
- (gnus-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook 'mml-destroy-buffers t t))))
- `(lambda (no-highlight)
- (let ((mail-parse-charset ',gnus-newsgroup-charset)
- (message-options message-options)
- (message-options-set-recipient)
- (mail-parse-ignored-charsets
- ',gnus-newsgroup-ignored-charsets))
- ,(if (not raw) '(progn
- (mml-to-mime)
- (mml-destroy-buffers)
- (remove-hook 'kill-buffer-hook
- 'mml-destroy-buffers t)
- (kill-local-variable 'mml-buffer-list)))
- (gnus-summary-edit-article-done
- ,(or (mail-header-references gnus-current-headers) "")
- ,(gnus-group-read-only-p)
- ,gnus-summary-buffer no-highlight))))))))
-
-(defalias 'gnus-summary-edit-article-postpone 'gnus-article-edit-exit)
-
-(defun gnus-summary-edit-article-done (&optional references read-only buffer
- no-highlight)
- "Make edits to the current article permanent."
- (interactive)
- (save-excursion
- ;; The buffer restriction contains the entire article if it exists.
- (when (article-goto-body)
- (let ((lines (count-lines (point) (point-max)))
- (length (- (point-max) (point)))
- (case-fold-search t)
- (body (copy-marker (point))))
- (goto-char (point-min))
- (when (re-search-forward "^content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward
- "^x-content-length:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string length)))
- (goto-char (point-min))
- (when (re-search-forward "^lines:[ \t]\\([0-9]+\\)" body t)
- (delete-region (match-beginning 1) (match-end 1))
- (insert (number-to-string lines))))))
- ;; Replace the article.
- (let ((buf (current-buffer)))
- (with-temp-buffer
- (insert-buffer-substring buf)
-
- (if (and (not read-only)
- (not (gnus-request-replace-article
- (cdr gnus-article-current) (car gnus-article-current)
- (current-buffer) t)))
- (error "Couldn't replace article")
- ;; Update the summary buffer.
- (if (and references
- (equal (message-tokenize-header references " ")
- (message-tokenize-header
- (or (message-fetch-field "references") "") " ")))
- ;; We only have to update this line.
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (let ((head (buffer-substring-no-properties
- (point-min) (point-max)))
- header)
- (with-temp-buffer
- (insert (format "211 %d Article retrieved.\n"
- (cdr gnus-article-current)))
- (insert head)
- (insert ".\n")
- (let ((nntp-server-buffer (current-buffer)))
- (setq header (car (gnus-get-newsgroup-headers
- nil t))))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-data-set-header
- (gnus-data-find (cdr gnus-article-current))
- header)
- (gnus-summary-update-article-line
- (cdr gnus-article-current) header)
- (if (gnus-summary-goto-subject
- (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))))))
- ;; Update threads.
- (set-buffer (or buffer gnus-summary-buffer))
- (gnus-summary-update-article (cdr gnus-article-current))
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark
- (cdr gnus-article-current))))
- ;; Prettify the article buffer again.
- (unless no-highlight
- (save-excursion
- (set-buffer gnus-article-buffer)
- ;;;!!! Fix this -- article should be rehighlighted.
- ;;;(gnus-run-hooks 'gnus-article-display-hook)
- (set-buffer gnus-original-article-buffer)
- (gnus-request-article
- (cdr gnus-article-current)
- (car gnus-article-current) (current-buffer))))
- ;; Prettify the summary buffer line.
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (gnus-run-hooks 'gnus-visual-mark-article-hook))))))
-
-(defun gnus-summary-edit-wash (key)
- "Perform editing command KEY in the article buffer."
- (interactive
- (list
- (progn
- (message "%s" (concat (this-command-keys) "- "))
- (read-char))))
- (message "")
- (gnus-summary-edit-article)
- (execute-kbd-macro (concat (this-command-keys) key))
- (gnus-article-edit-done))
-
-;;; Respooling
-
-(defun gnus-summary-respool-query (&optional silent trace)
- "Query where the respool algorithm would put this article."
- (interactive)
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article)
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (let ((groups (nnmail-article-group 'identity trace)))
- (unless silent
- (if groups
- (message "This message would go to %s"
- (mapconcat 'car groups ", "))
- (message "This message would go to no groups"))
- groups)))))
-
-(defun gnus-summary-respool-trace ()
- "Trace where the respool algorithm would put this article.
-Display a buffer showing all fancy splitting patterns which matched."
- (interactive)
- (gnus-summary-respool-query nil t))
-
-;; Summary marking commands.
-
-(defun gnus-summary-kill-same-subject-and-select (&optional unmark)
- "Mark articles which has the same subject as read, and then select the next.
-If UNMARK is positive, remove any kind of mark.
-If UNMARK is negative, tick articles."
- (interactive "P")
- (when unmark
- (setq unmark (prefix-numeric-value unmark)))
- (let ((count
- (gnus-summary-mark-same-subject
- (gnus-summary-article-subject) unmark)))
- ;; Select next unread article. If auto-select-same mode, should
- ;; select the first unread article.
- (gnus-summary-next-article t (and gnus-auto-select-same
- (gnus-summary-article-subject)))
- (gnus-message 7 "%d article%s marked as %s"
- count (if (= count 1) " is" "s are")
- (if unmark "unread" "read"))))
-
-(defun gnus-summary-kill-same-subject (&optional unmark)
- "Mark articles which has the same subject as read.
-If UNMARK is positive, remove any kind of mark.
-If UNMARK is negative, tick articles."
- (interactive "P")
- (when unmark
- (setq unmark (prefix-numeric-value unmark)))
- (let ((count
- (gnus-summary-mark-same-subject
- (gnus-summary-article-subject) unmark)))
- ;; If marked as read, go to next unread subject.
- (when (null unmark)
- ;; Go to next unread subject.
- (gnus-summary-next-subject 1 t))
- (gnus-message 7 "%d articles are marked as %s"
- count (if unmark "unread" "read"))))
-
-(defun gnus-summary-mark-same-subject (subject &optional unmark)
- "Mark articles with same SUBJECT as read, and return marked number.
-If optional argument UNMARK is positive, remove any kinds of marks.
-If optional argument UNMARK is negative, mark articles as unread instead."
- (let ((count 1))
- (save-excursion
- (cond
- ((null unmark) ; Mark as read.
- (while (and
- (progn
- (gnus-summary-mark-article-as-read gnus-killed-mark)
- (gnus-summary-show-thread) t)
- (gnus-summary-find-subject subject))
- (setq count (1+ count))))
- ((> unmark 0) ; Tick.
- (while (and
- (progn
- (gnus-summary-mark-article-as-unread gnus-ticked-mark)
- (gnus-summary-show-thread) t)
- (gnus-summary-find-subject subject))
- (setq count (1+ count))))
- (t ; Mark as unread.
- (while (and
- (progn
- (gnus-summary-mark-article-as-unread gnus-unread-mark)
- (gnus-summary-show-thread) t)
- (gnus-summary-find-subject subject))
- (setq count (1+ count)))))
- (gnus-set-mode-line 'summary)
- ;; Return the number of marked articles.
- count)))
-
-(defun gnus-summary-mark-as-processable (n &optional unmark)
- "Set the process mark on the next N articles.
-If N is negative, mark backward instead. If UNMARK is non-nil, remove
-the process mark instead. The difference between N and the actual
-number of articles marked is returned."
- (interactive "P")
- (if (and (null n) (gnus-region-active-p))
- (gnus-uu-mark-region (region-beginning) (region-end) unmark)
- (setq n (prefix-numeric-value n))
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and
- (> n 0)
- (if unmark
- (gnus-summary-remove-process-mark
- (gnus-summary-article-number))
- (gnus-summary-set-process-mark (gnus-summary-article-number)))
- (zerop (gnus-summary-next-subject (if backward -1 1) nil t)))
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more articles"))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- n)))
-
-(defun gnus-summary-unmark-as-processable (n)
- "Remove the process mark from the next N articles.
-If N is negative, unmark backward instead. The difference between N and
-the actual number of articles unmarked is returned."
- (interactive "P")
- (gnus-summary-mark-as-processable n t))
-
-(defun gnus-summary-unmark-all-processable ()
- "Remove the process mark from all articles."
- (interactive)
- (save-excursion
- (while gnus-newsgroup-processable
- (gnus-summary-remove-process-mark (car gnus-newsgroup-processable))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-add-mark (article type)
- "Mark ARTICLE with a mark of TYPE."
- (let ((vtype (car (assq type gnus-article-mark-lists)))
- var)
- (if (not vtype)
- (error "No such mark type: %s" type)
- (setq var (intern (format "gnus-newsgroup-%s" type)))
- (set var (cons article (symbol-value var)))
- (if (memq type '(processable cached replied forwarded recent saved))
- (gnus-summary-update-secondary-mark article)
- ;;; !!! This is bogus. We should find out what primary
- ;;; !!! mark we want to set.
- (gnus-summary-update-mark gnus-del-mark 'unread)))))
-
-(defun gnus-summary-mark-as-expirable (n)
- "Mark N articles forward as expirable.
-If N is negative, mark backward instead. The difference between N and
-the actual number of articles marked is returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-expirable-mark))
-
-(defun gnus-summary-mark-as-spam (n)
- "Mark N articles forward as spam.
-If N is negative, mark backward instead. The difference between N and
-the actual number of articles marked is returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-spam-mark))
-
-(defun gnus-summary-mark-article-as-replied (article)
- "Mark ARTICLE as replied to and update the summary line.
-ARTICLE can also be a list of articles."
- (interactive (list (gnus-summary-article-number)))
- (let ((articles (if (listp article) article (list article))))
- (dolist (article articles)
- (unless (numberp article)
- (error "%s is not a number" article))
- (push article gnus-newsgroup-replied)
- (let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-secondary-mark article))))))
-
-(defun gnus-summary-mark-article-as-forwarded (article)
- "Mark ARTICLE as forwarded and update the summary line.
-ARTICLE can also be a list of articles."
- (let ((articles (if (listp article) article (list article))))
- (dolist (article articles)
- (push article gnus-newsgroup-forwarded)
- (let ((buffer-read-only nil))
- (when (gnus-summary-goto-subject article nil t)
- (gnus-summary-update-secondary-mark article))))))
-
-(defun gnus-summary-set-bookmark (article)
- "Set a bookmark in current article."
- (interactive (list (gnus-summary-article-number)))
- (when (or (not (get-buffer gnus-article-buffer))
- (not gnus-current-article)
- (not gnus-article-current)
- (not (equal gnus-newsgroup-name (car gnus-article-current))))
- (error "No current article selected"))
- ;; Remove old bookmark, if one exists.
- (gnus-pull article gnus-newsgroup-bookmarks)
- ;; Set the new bookmark, which is on the form
- ;; (article-number . line-number-in-body).
- (push
- (cons article
- (save-excursion
- (set-buffer gnus-article-buffer)
- (count-lines
- (min (point)
- (save-excursion
- (article-goto-body)
- (point)))
- (point))))
- gnus-newsgroup-bookmarks)
- (gnus-message 6 "A bookmark has been added to the current article."))
-
-(defun gnus-summary-remove-bookmark (article)
- "Remove the bookmark from the current article."
- (interactive (list (gnus-summary-article-number)))
- ;; Remove old bookmark, if one exists.
- (if (not (assq article gnus-newsgroup-bookmarks))
- (gnus-message 6 "No bookmark in current article.")
- (gnus-pull article gnus-newsgroup-bookmarks)
- (gnus-message 6 "Removed bookmark.")))
-
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defun gnus-summary-mark-as-dormant (n)
- "Mark N articles forward as dormant.
-If N is negative, mark backward instead. The difference between N and
-the actual number of articles marked is returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-dormant-mark))
-
-(defun gnus-summary-set-process-mark (article)
- "Set the process mark on ARTICLE and update the summary line."
- (setq gnus-newsgroup-processable
- (cons article
- (delq article gnus-newsgroup-processable)))
- (when (gnus-summary-goto-subject article)
- (gnus-summary-show-thread)
- (gnus-summary-goto-subject article)
- (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-remove-process-mark (article)
- "Remove the process mark from ARTICLE and update the summary line."
- (setq gnus-newsgroup-processable (delq article gnus-newsgroup-processable))
- (when (gnus-summary-goto-subject article)
- (gnus-summary-show-thread)
- (gnus-summary-goto-subject article)
- (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-set-saved-mark (article)
- "Set the process mark on ARTICLE and update the summary line."
- (push article gnus-newsgroup-saved)
- (when (gnus-summary-goto-subject article)
- (gnus-summary-update-secondary-mark article)))
-
-(defun gnus-summary-mark-forward (n &optional mark no-expire)
- "Mark N articles as read forwards.
-If N is negative, mark backwards instead. Mark with MARK, ?r by default.
-The difference between N and the actual number of articles marked is
-returned.
-If NO-EXPIRE, auto-expiry will be inhibited."
- (interactive "p")
- (gnus-summary-show-thread)
- (let ((backward (< n 0))
- (gnus-summary-goto-unread
- (and gnus-summary-goto-unread
- (not (eq gnus-summary-goto-unread 'never))
- (not (memq mark (list gnus-unread-mark gnus-spam-mark
- gnus-ticked-mark gnus-dormant-mark)))))
- (n (abs n))
- (mark (or mark gnus-del-mark)))
- (while (and (> n 0)
- (gnus-summary-mark-article nil mark no-expire)
- (zerop (gnus-summary-next-subject
- (if backward -1 1)
- (and gnus-summary-goto-unread
- (not (eq gnus-summary-goto-unread 'never)))
- t)))
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- n))
-
-(defun gnus-summary-mark-article-as-read (mark)
- "Mark the current article quickly as read with MARK."
- (let ((article (gnus-summary-article-number)))
- (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (push (cons article mark) gnus-newsgroup-reads)
- ;; Possibly remove from cache, if that is used.
- (when gnus-use-cache
- (gnus-cache-enter-remove-article article))
- ;; Allow the backend to change the mark.
- (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
- ;; Check for auto-expiry.
- (when (and gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
- (setq mark gnus-expirable-mark)
- ;; Let the backend know about the mark change.
- (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
- (push article gnus-newsgroup-expirable))
- ;; Set the mark in the buffer.
- (gnus-summary-update-mark mark 'unread)
- t))
-
-(defun gnus-summary-mark-article-as-unread (mark)
- "Mark the current article quickly as unread with MARK."
- (let* ((article (gnus-summary-article-number))
- (old-mark (gnus-summary-article-mark article)))
- ;; Allow the backend to change the mark.
- (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
- (if (eq mark old-mark)
- t
- (if (<= article 0)
- (progn
- (gnus-error 1 "Can't mark negative article numbers")
- nil)
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-spam-marked
- (delq article gnus-newsgroup-spam-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (setq gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable))
- (setq gnus-newsgroup-reads (delq article gnus-newsgroup-reads))
- (cond ((= mark gnus-ticked-mark)
- (setq gnus-newsgroup-marked
- (gnus-add-to-sorted-list gnus-newsgroup-marked
- article)))
- ((= mark gnus-spam-mark)
- (setq gnus-newsgroup-spam-marked
- (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
- article)))
- ((= mark gnus-dormant-mark)
- (setq gnus-newsgroup-dormant
- (gnus-add-to-sorted-list gnus-newsgroup-dormant
- article)))
- (t
- (setq gnus-newsgroup-unreads
- (gnus-add-to-sorted-list gnus-newsgroup-unreads
- article))))
- (gnus-pull article gnus-newsgroup-reads)
-
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
- t))))
-
-(defun gnus-summary-mark-article (&optional article mark no-expire)
- "Mark ARTICLE with MARK. MARK can be any character.
-Four MARK strings are reserved: `? ' (unread), `?!' (ticked),
-`??' (dormant) and `?E' (expirable).
-If MARK is nil, then the default character `?r' is used.
-If ARTICLE is nil, then the article on the current line will be
-marked.
-If NO-EXPIRE, auto-expiry will be inhibited."
- ;; The mark might be a string.
- (when (stringp mark)
- (setq mark (aref mark 0)))
- ;; If no mark is given, then we check auto-expiring.
- (when (null mark)
- (setq mark gnus-del-mark))
- (when (and (not no-expire)
- gnus-newsgroup-auto-expire
- (memq mark gnus-auto-expirable-marks))
- (setq mark gnus-expirable-mark))
- (let ((article (or article (gnus-summary-article-number)))
- (old-mark (gnus-summary-article-mark article)))
- ;; Allow the backend to change the mark.
- (setq mark (gnus-request-update-mark gnus-newsgroup-name article mark))
- (if (eq mark old-mark)
- t
- (unless article
- (error "No article on current line"))
- (if (not (if (or (= mark gnus-unread-mark)
- (= mark gnus-ticked-mark)
- (= mark gnus-spam-mark)
- (= mark gnus-dormant-mark))
- (gnus-mark-article-as-unread article mark)
- (gnus-mark-article-as-read article mark)))
- t
- ;; See whether the article is to be put in the cache.
- (and gnus-use-cache
- (not (= mark gnus-canceled-mark))
- (vectorp (gnus-summary-article-header article))
- (save-excursion
- (gnus-cache-possibly-enter-article
- gnus-newsgroup-name article
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark) (= mark gnus-unread-mark))))
-
- (when (gnus-summary-goto-subject article nil t)
- (let ((buffer-read-only nil))
- (gnus-summary-show-thread)
- ;; Fix the mark.
- (gnus-summary-update-mark mark 'unread)
- t))))))
-
-(defun gnus-summary-update-secondary-mark (article)
- "Update the secondary (read, process, cache) mark."
- (gnus-summary-update-mark
- (cond ((memq article gnus-newsgroup-processable)
- gnus-process-mark)
- ((memq article gnus-newsgroup-cached)
- gnus-cached-mark)
- ((memq article gnus-newsgroup-replied)
- gnus-replied-mark)
- ((memq article gnus-newsgroup-forwarded)
- gnus-forwarded-mark)
- ((memq article gnus-newsgroup-saved)
- gnus-saved-mark)
- ((memq article gnus-newsgroup-recent)
- gnus-recent-mark)
- ((memq article gnus-newsgroup-unseen)
- gnus-unseen-mark)
- (t gnus-no-mark))
- 'replied)
- (when (gnus-visual-p 'summary-highlight 'highlight)
- (gnus-run-hooks 'gnus-summary-update-hook))
- t)
-
-(defun gnus-summary-update-download-mark (article)
- "Update the download mark."
- (gnus-summary-update-mark
- (cond ((memq article gnus-newsgroup-undownloaded)
- gnus-undownloaded-mark)
- (gnus-newsgroup-agentized
- gnus-downloaded-mark)
- (t
- gnus-no-mark))
- 'download)
- (gnus-summary-update-line t)
- t)
-
-(defun gnus-summary-update-mark (mark type)
- (let ((forward (cdr (assq type gnus-summary-mark-positions)))
- (buffer-read-only nil))
- (re-search-backward "[\n\r]" (gnus-point-at-bol) 'move-to-limit)
- (when forward
- (when (looking-at "\r")
- (incf forward))
- (when (<= (+ forward (point)) (point-max))
- ;; Go to the right position on the line.
- (goto-char (+ forward (point)))
- ;; Replace the old mark with the new mark.
- (subst-char-in-region (point) (1+ (point)) (char-after) mark)
- ;; Optionally update the marks by some user rule.
- (when (eq type 'unread)
- (gnus-data-set-mark
- (gnus-data-find (gnus-summary-article-number)) mark)
- (gnus-summary-update-line (eq mark gnus-unread-mark)))))))
-
-(defun gnus-mark-article-as-read (article &optional mark)
- "Enter ARTICLE in the pertinent lists and remove it from others."
- ;; Make the article expirable.
- (let ((mark (or mark gnus-del-mark)))
- (setq gnus-newsgroup-expirable
- (if (= mark gnus-expirable-mark)
- (gnus-add-to-sorted-list gnus-newsgroup-expirable article)
- (delq article gnus-newsgroup-expirable)))
- ;; Remove from unread and marked lists.
- (setq gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked))
- (setq gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked))
- (setq gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant))
- (push (cons article mark) gnus-newsgroup-reads)
- ;; Possibly remove from cache, if that is used.
- (when gnus-use-cache
- (gnus-cache-enter-remove-article article))
- t))
-
-(defun gnus-mark-article-as-unread (article &optional mark)
- "Enter ARTICLE in the pertinent lists and remove it from others."
- (let ((mark (or mark gnus-ticked-mark)))
- (if (<= article 0)
- (progn
- (gnus-error 1 "Can't mark negative article numbers")
- nil)
- (setq gnus-newsgroup-marked (delq article gnus-newsgroup-marked)
- gnus-newsgroup-spam-marked (delq article gnus-newsgroup-spam-marked)
- gnus-newsgroup-dormant (delq article gnus-newsgroup-dormant)
- gnus-newsgroup-expirable (delq article gnus-newsgroup-expirable)
- gnus-newsgroup-unreads (delq article gnus-newsgroup-unreads))
-
- ;; Unsuppress duplicates?
- (when gnus-suppress-duplicates
- (gnus-dup-unsuppress-article article))
-
- (cond ((= mark gnus-ticked-mark)
- (setq gnus-newsgroup-marked
- (gnus-add-to-sorted-list gnus-newsgroup-marked article)))
- ((= mark gnus-spam-mark)
- (setq gnus-newsgroup-spam-marked
- (gnus-add-to-sorted-list gnus-newsgroup-spam-marked
- article)))
- ((= mark gnus-dormant-mark)
- (setq gnus-newsgroup-dormant
- (gnus-add-to-sorted-list gnus-newsgroup-dormant article)))
- (t
- (setq gnus-newsgroup-unreads
- (gnus-add-to-sorted-list gnus-newsgroup-unreads article))))
- (gnus-pull article gnus-newsgroup-reads)
- t)))
-
-(defalias 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
-(make-obsolete 'gnus-summary-mark-as-unread-forward
- 'gnus-summary-tick-article-forward)
-(defun gnus-summary-tick-article-forward (n)
- "Tick N articles forwards.
-If N is negative, tick backwards instead.
-The difference between N and the number of articles ticked is returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-ticked-mark))
-
-(defalias 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
-(make-obsolete 'gnus-summary-mark-as-unread-backward
- 'gnus-summary-tick-article-backward)
-(defun gnus-summary-tick-article-backward (n)
- "Tick N articles backwards.
-The difference between N and the number of articles ticked is returned."
- (interactive "p")
- (gnus-summary-mark-forward (- n) gnus-ticked-mark))
-
-(defalias 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(make-obsolete 'gnus-summary-mark-as-unread 'gnus-summary-tick-article)
-(defun gnus-summary-tick-article (&optional article clear-mark)
- "Mark current article as unread.
-Optional 1st argument ARTICLE specifies article number to be marked as unread.
-Optional 2nd argument CLEAR-MARK remove any kinds of mark."
- (interactive)
- (gnus-summary-mark-article article (if clear-mark gnus-unread-mark
- gnus-ticked-mark)))
-
-(defun gnus-summary-mark-as-read-forward (n)
- "Mark N articles as read forwards.
-If N is negative, mark backwards instead.
-The difference between N and the actual number of articles marked is
-returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-del-mark gnus-inhibit-user-auto-expire))
-
-(defun gnus-summary-mark-as-read-backward (n)
- "Mark the N articles as read backwards.
-The difference between N and the actual number of articles marked is
-returned."
- (interactive "p")
- (gnus-summary-mark-forward
- (- n) gnus-del-mark gnus-inhibit-user-auto-expire))
-
-(defun gnus-summary-mark-as-read (&optional article mark)
- "Mark current article as read.
-ARTICLE specifies the article to be marked as read.
-MARK specifies a string to be inserted at the beginning of the line."
- (gnus-summary-mark-article article mark))
-
-(defun gnus-summary-clear-mark-forward (n)
- "Clear marks from N articles forward.
-If N is negative, clear backward instead.
-The difference between N and the number of marks cleared is returned."
- (interactive "p")
- (gnus-summary-mark-forward n gnus-unread-mark))
-
-(defun gnus-summary-clear-mark-backward (n)
- "Clear marks from N articles backward.
-The difference between N and the number of marks cleared is returned."
- (interactive "p")
- (gnus-summary-mark-forward (- n) gnus-unread-mark))
-
-(defun gnus-summary-mark-unread-as-read ()
- "Intended to be used by `gnus-mark-article-hook'."
- (when (memq gnus-current-article gnus-newsgroup-unreads)
- (gnus-summary-mark-article gnus-current-article gnus-read-mark)))
-
-(defun gnus-summary-mark-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-mark-article-hook'."
- (let ((mark (gnus-summary-article-mark)))
- (when (or (gnus-unread-mark-p mark)
- (gnus-read-mark-p mark))
- (gnus-summary-mark-article gnus-current-article
- (or new-mark gnus-read-mark)))))
-
-(defun gnus-summary-mark-current-read-and-unread-as-read (&optional new-mark)
- "Intended to be used by `gnus-mark-article-hook'."
- (let ((mark (gnus-summary-article-mark)))
- (when (or (gnus-unread-mark-p mark)
- (gnus-read-mark-p mark))
- (gnus-summary-mark-article (gnus-summary-article-number)
- (or new-mark gnus-read-mark)))))
-
-(defun gnus-summary-mark-unread-as-ticked ()
- "Intended to be used by `gnus-mark-article-hook'."
- (when (memq gnus-current-article gnus-newsgroup-unreads)
- (gnus-summary-mark-article gnus-current-article gnus-ticked-mark)))
-
-(defun gnus-summary-mark-region-as-read (point mark all)
- "Mark all unread articles between point and mark as read.
-If given a prefix, mark all articles between point and mark as read,
-even ticked and dormant ones."
- (interactive "r\nP")
- (save-excursion
- (let (article)
- (goto-char point)
- (beginning-of-line)
- (while (and
- (< (point) mark)
- (progn
- (when (or all
- (memq (setq article (gnus-summary-article-number))
- gnus-newsgroup-unreads))
- (gnus-summary-mark-article article gnus-del-mark))
- t)
- (gnus-summary-find-next))))))
-
-(defun gnus-summary-mark-below (score mark)
- "Mark articles with score less than SCORE with MARK."
- (interactive "P\ncMark: ")
- (setq score (if score
- (prefix-numeric-value score)
- (or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (goto-char (point-min))
- (while
- (progn
- (and (< (gnus-summary-article-score) score)
- (gnus-summary-mark-article nil mark))
- (gnus-summary-find-next)))))
-
-(defun gnus-summary-kill-below (&optional score)
- "Mark articles with score below SCORE as read."
- (interactive "P")
- (gnus-summary-mark-below score gnus-killed-mark))
-
-(defun gnus-summary-clear-above (&optional score)
- "Clear all marks from articles with score above SCORE."
- (interactive "P")
- (gnus-summary-mark-above score gnus-unread-mark))
-
-(defun gnus-summary-tick-above (&optional score)
- "Tick all articles with score above SCORE."
- (interactive "P")
- (gnus-summary-mark-above score gnus-ticked-mark))
-
-(defun gnus-summary-mark-above (score mark)
- "Mark articles with score over SCORE with MARK."
- (interactive "P\ncMark: ")
- (setq score (if score
- (prefix-numeric-value score)
- (or gnus-summary-default-score 0)))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (goto-char (point-min))
- (while (and (progn
- (when (> (gnus-summary-article-score) score)
- (gnus-summary-mark-article nil mark))
- t)
- (gnus-summary-find-next)))))
-
-;; Suggested by Daniel Quinlan <quinlan@best.com>.
-(defalias 'gnus-summary-show-all-expunged 'gnus-summary-limit-include-expunged)
-(defun gnus-summary-limit-include-expunged (&optional no-error)
- "Display all the hidden articles that were expunged for low scores."
- (interactive)
- (let ((buffer-read-only nil))
- (let ((scored gnus-newsgroup-scored)
- headers h)
- (while scored
- (unless (gnus-summary-article-header (caar scored))
- (and (setq h (gnus-number-to-header (caar scored)))
- (< (cdar scored) gnus-summary-expunge-below)
- (push h headers)))
- (setq scored (cdr scored)))
- (if (not headers)
- (when (not no-error)
- (error "No expunged articles hidden"))
- (goto-char (point-min))
- (push gnus-newsgroup-limit gnus-newsgroup-limits)
- (setq gnus-newsgroup-limit (copy-sequence gnus-newsgroup-limit))
- (mapcar (lambda (x) (push (mail-header-number x)
- gnus-newsgroup-limit))
- headers)
- (gnus-summary-prepare-unthreaded (nreverse headers))
- (goto-char (point-min))
- (gnus-summary-position-point)
- t))))
-
-(defun gnus-summary-catchup (&optional all quietly to-here not-mark reverse)
- "Mark all unread articles in this newsgroup as read.
-If prefix argument ALL is non-nil, ticked and dormant articles will
-also be marked as read.
-If QUIETLY is non-nil, no questions will be asked.
-
-If TO-HERE is non-nil, it should be a point in the buffer. All
-articles before (after, if REVERSE is set) this point will be marked
-as read.
-
-Note that this function will only catch up the unread article
-in the current summary buffer limitation.
-
-The number of articles marked as read is returned."
- (interactive "P")
- (prog1
- (save-excursion
- (when (or quietly
- (not gnus-interactive-catchup) ;Without confirmation?
- gnus-expert-user
- (gnus-y-or-n-p
- (if all
- "Mark absolutely all articles as read? "
- "Mark all unread articles as read? ")))
- (if (and not-mark
- (not gnus-newsgroup-adaptive)
- (not gnus-newsgroup-auto-expire)
- (not gnus-suppress-duplicates)
- (or (not gnus-use-cache)
- (eq gnus-use-cache 'passive)))
- (progn
- (when all
- (setq gnus-newsgroup-marked nil
- gnus-newsgroup-spam-marked nil
- gnus-newsgroup-dormant nil))
- (setq gnus-newsgroup-unreads
- (gnus-sorted-nunion
- (gnus-sorted-intersection gnus-newsgroup-unreads
- gnus-newsgroup-downloadable)
- (gnus-sorted-difference gnus-newsgroup-unfetched
- gnus-newsgroup-cached))))
- ;; We actually mark all articles as canceled, which we
- ;; have to do when using auto-expiry or adaptive scoring.
- (gnus-summary-show-all-threads)
- (if (and to-here reverse)
- (progn
- (goto-char to-here)
- (gnus-summary-mark-current-read-and-unread-as-read
- gnus-catchup-mark)
- (while (gnus-summary-find-next (not all))
- (gnus-summary-mark-article-as-read gnus-catchup-mark)))
- (when (gnus-summary-first-subject (not all))
- (while (and
- (if to-here (< (point) to-here) t)
- (gnus-summary-mark-article-as-read gnus-catchup-mark)
- (gnus-summary-find-next (not all))))))
- (gnus-set-mode-line 'summary))
- t))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-catchup-to-here (&optional all)
- "Mark all unticked articles before the current one as read.
-If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
- (save-excursion
- (gnus-save-hidden-threads
- (let ((beg (point)))
- ;; We check that there are unread articles.
- (when (or all (gnus-summary-find-prev))
- (gnus-summary-catchup all t beg)))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-catchup-from-here (&optional all)
- "Mark all unticked articles after (and including) the current one as read.
-If ALL is non-nil, also mark ticked and dormant articles as read."
- (interactive "P")
- (save-excursion
- (gnus-save-hidden-threads
- (let ((beg (point)))
- ;; We check that there are unread articles.
- (when (or all (gnus-summary-find-next))
- (gnus-summary-catchup all t beg nil t)))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-catchup-all (&optional quietly)
- "Mark all articles in this newsgroup as read.
-This command is dangerous. Normally, you want \\[gnus-summary-catchup]
-instead, which marks only unread articles as read."
- (interactive "P")
- (gnus-summary-catchup t quietly))
-
-(defun gnus-summary-catchup-and-exit (&optional all quietly)
- "Mark all unread articles in this group as read, then exit.
-If prefix argument ALL is non-nil, all articles are marked as read.
-If QUIETLY is non-nil, no questions will be asked."
- (interactive "P")
- (when (gnus-summary-catchup all quietly nil 'fast)
- ;; Select next newsgroup or exit.
- (if (and (not (gnus-group-quit-config gnus-newsgroup-name))
- (eq gnus-auto-select-next 'quietly))
- (gnus-summary-next-group nil)
- (gnus-summary-exit))))
-
-(defun gnus-summary-catchup-all-and-exit (&optional quietly)
- "Mark all articles in this newsgroup as read, and then exit.
-This command is dangerous. Normally, you want \\[gnus-summary-catchup-and-exit]
-instead, which marks only unread articles as read."
- (interactive "P")
- (gnus-summary-catchup-and-exit t quietly))
-
-(defun gnus-summary-catchup-and-goto-next-group (&optional all)
- "Mark all articles in this group as read and select the next group.
-If given a prefix, mark all articles, unread as well as ticked, as
-read."
- (interactive "P")
- (save-excursion
- (gnus-summary-catchup all))
- (gnus-summary-next-group))
-
-;;;
-;;; with article
-;;;
-
-(defmacro gnus-with-article (article &rest forms)
- "Select ARTICLE and perform FORMS in the original article buffer.
-Then replace the article with the result."
- `(progn
- ;; We don't want the article to be marked as read.
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil ,article))
- (set-buffer gnus-original-article-buffer)
- ,@forms
- (if (not (gnus-check-backend-function
- 'request-replace-article (car gnus-article-current)))
- (gnus-message 5 "Read-only group; not replacing")
- (unless (gnus-request-replace-article
- ,article (car gnus-article-current)
- (current-buffer) t)
- (error "Couldn't replace article")))
- ;; The cache and backlog have to be flushed somewhat.
- (when gnus-keep-backlog
- (gnus-backlog-remove-article
- (car gnus-article-current) (cdr gnus-article-current)))
- (when gnus-use-cache
- (gnus-cache-update-article
- (car gnus-article-current) (cdr gnus-article-current)))))
-
-(put 'gnus-with-article 'lisp-indent-function 1)
-(put 'gnus-with-article 'edebug-form-spec '(form body))
-
-;; Thread-based commands.
-
-(defun gnus-summary-articles-in-thread (&optional article)
- "Return a list of all articles in the current thread.
-If ARTICLE is non-nil, return all articles in the thread that starts
-with that article."
- (let* ((article (or article (gnus-summary-article-number)))
- (data (gnus-data-find-list article))
- (top-level (gnus-data-level (car data)))
- (top-subject
- (cond ((null gnus-thread-operation-ignore-subject)
- (gnus-simplify-subject-re
- (mail-header-subject (gnus-data-header (car data)))))
- ((eq gnus-thread-operation-ignore-subject 'fuzzy)
- (gnus-simplify-subject-fuzzy
- (mail-header-subject (gnus-data-header (car data)))))
- (t nil)))
- (end-point (save-excursion
- (if (gnus-summary-go-to-next-thread)
- (point) (point-max))))
- articles)
- (while (and data
- (< (gnus-data-pos (car data)) end-point))
- (when (or (not top-subject)
- (string= top-subject
- (if (eq gnus-thread-operation-ignore-subject 'fuzzy)
- (gnus-simplify-subject-fuzzy
- (mail-header-subject
- (gnus-data-header (car data))))
- (gnus-simplify-subject-re
- (mail-header-subject
- (gnus-data-header (car data)))))))
- (push (gnus-data-number (car data)) articles))
- (unless (and (setq data (cdr data))
- (> (gnus-data-level (car data)) top-level))
- (setq data nil)))
- ;; Return the list of articles.
- (nreverse articles)))
-
-(defun gnus-summary-rethread-current ()
- "Rethread the thread the current article is part of."
- (interactive)
- (let* ((gnus-show-threads t)
- (article (gnus-summary-article-number))
- (id (mail-header-id (gnus-summary-article-header)))
- (gnus-newsgroup-threads (list (gnus-id-to-thread (gnus-root-id id)))))
- (unless id
- (error "No article on the current line"))
- (gnus-rebuild-thread id)
- (gnus-summary-goto-subject article)))
-
-(defun gnus-summary-reparent-thread ()
- "Make the current article child of the marked (or previous) article.
-
-Note that the re-threading will only work if `gnus-thread-ignore-subject'
-is non-nil or the Subject: of both articles are the same."
- (interactive)
- (unless (not (gnus-group-read-only-p))
- (error "The current newsgroup does not support article editing"))
- (unless (<= (length gnus-newsgroup-processable) 1)
- (error "No more than one article may be marked"))
- (save-window-excursion
- (let ((gnus-article-buffer " *reparent*")
- (current-article (gnus-summary-article-number))
- ;; First grab the marked article, otherwise one line up.
- (parent-article (if (not (null gnus-newsgroup-processable))
- (car gnus-newsgroup-processable)
- (save-excursion
- (if (eq (forward-line -1) 0)
- (gnus-summary-article-number)
- (error "Beginning of summary buffer"))))))
- (unless (not (eq current-article parent-article))
- (error "An article may not be self-referential"))
- (let ((message-id (mail-header-id
- (gnus-summary-article-header parent-article))))
- (unless (and message-id (not (equal message-id "")))
- (error "No message-id in desired parent"))
- (gnus-with-article current-article
- (save-restriction
- (goto-char (point-min))
- (message-narrow-to-head)
- (if (re-search-forward "^References: " nil t)
- (progn
- (re-search-forward "^[^ \t]" nil t)
- (forward-line -1)
- (end-of-line)
- (insert " " message-id))
- (insert "References: " message-id "\n"))))
- (set-buffer gnus-summary-buffer)
- (gnus-summary-unmark-all-processable)
- (gnus-summary-update-article current-article)
- (if (gnus-summary-goto-subject (cdr gnus-article-current) nil t)
- (gnus-summary-update-secondary-mark (cdr gnus-article-current)))
- (gnus-summary-rethread-current)
- (gnus-message 3 "Article %d is now the child of article %d"
- current-article parent-article)))))
-
-(defun gnus-summary-toggle-threads (&optional arg)
- "Toggle showing conversation threads.
-If ARG is positive number, turn showing conversation threads on."
- (interactive "P")
- (let ((current (or (gnus-summary-article-number) gnus-newsgroup-end)))
- (setq gnus-show-threads
- (if (null arg) (not gnus-show-threads)
- (> (prefix-numeric-value arg) 0)))
- (gnus-summary-prepare)
- (gnus-summary-goto-subject current)
- (gnus-message 6 "Threading is now %s" (if gnus-show-threads "on" "off"))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-show-all-threads ()
- "Show all threads."
- (interactive)
- (save-excursion
- (let ((buffer-read-only nil))
- (subst-char-in-region (point-min) (point-max) ?\^M ?\n t)))
- (gnus-summary-position-point))
-
-(defun gnus-summary-show-thread ()
- "Show thread subtrees.
-Returns nil if no thread was there to be shown."
- (interactive)
- (let ((buffer-read-only nil)
- (orig (point))
- (end (gnus-point-at-eol))
- ;; Leave point at bol
- (beg (progn (beginning-of-line) (point))))
- (prog1
- ;; Any hidden lines here?
- (search-forward "\r" end t)
- (subst-char-in-region beg end ?\^M ?\n t)
- (goto-char orig)
- (gnus-summary-position-point))))
-
-(defun gnus-summary-maybe-hide-threads ()
- "If requested, hide the threads that should be hidden."
- (when (and gnus-show-threads
- gnus-thread-hide-subtree)
- (gnus-summary-hide-all-threads
- (if (or (consp gnus-thread-hide-subtree)
- (functionp gnus-thread-hide-subtree))
- (gnus-make-predicate gnus-thread-hide-subtree)
- nil))))
-
-;;; Hiding predicates.
-
-(defun gnus-article-unread-p (header)
- (memq (mail-header-number header) gnus-newsgroup-unreads))
-
-(defun gnus-article-unseen-p (header)
- (memq (mail-header-number header) gnus-newsgroup-unseen))
-
-(defun gnus-map-articles (predicate articles)
- "Map PREDICATE over ARTICLES and return non-nil if any predicate is non-nil."
- (apply 'gnus-or (mapcar predicate
- (mapcar (lambda (number)
- (gnus-summary-article-header number))
- articles))))
-
-(defun gnus-summary-hide-all-threads (&optional predicate)
- "Hide all thread subtrees.
-If PREDICATE is supplied, threads that satisfy this predicate
-will not be hidden."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (let ((end nil))
- (while (not end)
- (when (or (not predicate)
- (gnus-map-articles
- predicate (gnus-summary-article-children)))
- (gnus-summary-hide-thread))
- (setq end (not (zerop (gnus-summary-next-thread 1 t)))))))
- (gnus-summary-position-point))
-
-(defun gnus-summary-hide-thread ()
- "Hide thread subtrees.
-If PREDICATE is supplied, threads that satisfy this predicate
-will not be hidden.
-Returns nil if no threads were there to be hidden."
- (interactive)
- (let ((buffer-read-only nil)
- (start (point))
- (article (gnus-summary-article-number)))
- (goto-char start)
- ;; Go forward until either the buffer ends or the subthread
- ;; ends.
- (when (and (not (eobp))
- (or (zerop (gnus-summary-next-thread 1 t))
- (goto-char (point-max))))
- (prog1
- (if (and (> (point) start)
- (search-backward "\n" start t))
- (progn
- (subst-char-in-region start (point) ?\n ?\^M)
- (gnus-summary-goto-subject article))
- (goto-char start)
- nil)))))
-
-(defun gnus-summary-go-to-next-thread (&optional previous)
- "Go to the same level (or less) next thread.
-If PREVIOUS is non-nil, go to previous thread instead.
-Return the article number moved to, or nil if moving was impossible."
- (let ((level (gnus-summary-thread-level))
- (way (if previous -1 1))
- (beg (point)))
- (forward-line way)
- (while (and (not (eobp))
- (< level (gnus-summary-thread-level)))
- (forward-line way))
- (if (eobp)
- (progn
- (goto-char beg)
- nil)
- (setq beg (point))
- (prog1
- (gnus-summary-article-number)
- (goto-char beg)))))
-
-(defun gnus-summary-next-thread (n &optional silent)
- "Go to the same level next N'th thread.
-If N is negative, search backward instead.
-Returns the difference between N and the number of skips actually
-done.
-
-If SILENT, don't output messages."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n)))
- (while (and (> n 0)
- (gnus-summary-go-to-next-thread backward))
- (decf n))
- (unless silent
- (gnus-summary-position-point))
- (when (and (not silent) (/= 0 n))
- (gnus-message 7 "No more threads"))
- n))
-
-(defun gnus-summary-prev-thread (n)
- "Go to the same level previous N'th thread.
-Returns the difference between N and the number of skips actually
-done."
- (interactive "p")
- (gnus-summary-next-thread (- n)))
-
-(defun gnus-summary-go-down-thread ()
- "Go down one level in the current thread."
- (let ((children (gnus-summary-article-children)))
- (when children
- (gnus-summary-goto-subject (car children)))))
-
-(defun gnus-summary-go-up-thread ()
- "Go up one level in the current thread."
- (let ((parent (gnus-summary-article-parent)))
- (when parent
- (gnus-summary-goto-subject parent))))
-
-(defun gnus-summary-down-thread (n)
- "Go down thread N steps.
-If N is negative, go up instead.
-Returns the difference between N and how many steps down that were
-taken."
- (interactive "p")
- (let ((up (< n 0))
- (n (abs n)))
- (while (and (> n 0)
- (if up (gnus-summary-go-up-thread)
- (gnus-summary-go-down-thread)))
- (setq n (1- n)))
- (gnus-summary-position-point)
- (when (/= 0 n)
- (gnus-message 7 "Can't go further"))
- n))
-
-(defun gnus-summary-up-thread (n)
- "Go up thread N steps.
-If N is negative, go down instead.
-Returns the difference between N and how many steps down that were
-taken."
- (interactive "p")
- (gnus-summary-down-thread (- n)))
-
-(defun gnus-summary-top-thread ()
- "Go to the top of the thread."
- (interactive)
- (while (gnus-summary-go-up-thread))
- (gnus-summary-article-number))
-
-(defun gnus-summary-kill-thread (&optional unmark)
- "Mark articles under current thread as read.
-If the prefix argument is positive, remove any kinds of marks.
-If the prefix argument is negative, tick articles instead."
- (interactive "P")
- (when unmark
- (setq unmark (prefix-numeric-value unmark)))
- (let ((articles (gnus-summary-articles-in-thread)))
- (save-excursion
- ;; Expand the thread.
- (gnus-summary-show-thread)
- ;; Mark all the articles.
- (while articles
- (gnus-summary-goto-subject (car articles))
- (cond ((null unmark)
- (gnus-summary-mark-article-as-read gnus-killed-mark))
- ((> unmark 0)
- (gnus-summary-mark-article-as-unread gnus-unread-mark))
- (t
- (gnus-summary-mark-article-as-unread gnus-ticked-mark)))
- (setq articles (cdr articles))))
- ;; Hide killed subtrees.
- (and (null unmark)
- gnus-thread-hide-killed
- (gnus-summary-hide-thread))
- ;; If marked as read, go to next unread subject.
- (when (null unmark)
- ;; Go to next unread subject.
- (gnus-summary-next-subject 1 t)))
- (gnus-set-mode-line 'summary))
-
-;; Summary sorting commands
-
-(defun gnus-summary-sort-by-number (&optional reverse)
- "Sort the summary buffer by article number.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'number reverse))
-
-(defun gnus-summary-sort-by-random (&optional reverse)
- "Randomize the order in the summary buffer.
-Argument REVERSE means to randomize in reverse order."
- (interactive "P")
- (gnus-summary-sort 'random reverse))
-
-(defun gnus-summary-sort-by-author (&optional reverse)
- "Sort the summary buffer by author name alphabetically.
-If `case-fold-search' is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'author reverse))
-
-(defun gnus-summary-sort-by-subject (&optional reverse)
- "Sort the summary buffer by subject alphabetically. `Re:'s are ignored.
-If `case-fold-search' is non-nil, case of letters is ignored.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'subject reverse))
-
-(defun gnus-summary-sort-by-date (&optional reverse)
- "Sort the summary buffer by date.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'date reverse))
-
-(defun gnus-summary-sort-by-score (&optional reverse)
- "Sort the summary buffer by score.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'score reverse))
-
-(defun gnus-summary-sort-by-lines (&optional reverse)
- "Sort the summary buffer by the number of lines.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'lines reverse))
-
-(defun gnus-summary-sort-by-chars (&optional reverse)
- "Sort the summary buffer by article length.
-Argument REVERSE means reverse order."
- (interactive "P")
- (gnus-summary-sort 'chars reverse))
-
-(defun gnus-summary-sort-by-original (&optional reverse)
- "Sort the summary buffer using the default sorting method.
-Argument REVERSE means reverse order."
- (interactive "P")
- (let* ((buffer-read-only)
- (gnus-summary-prepare-hook nil))
- ;; We do the sorting by regenerating the threads.
- (gnus-summary-prepare)
- ;; Hide subthreads if needed.
- (gnus-summary-maybe-hide-threads)))
-
-(defun gnus-summary-sort (predicate reverse)
- "Sort summary buffer by PREDICATE. REVERSE means reverse order."
- (let* ((thread (intern (format "gnus-thread-sort-by-%s" predicate)))
- (article (intern (format "gnus-article-sort-by-%s" predicate)))
- (gnus-thread-sort-functions
- (if (not reverse)
- thread
- `(lambda (t1 t2)
- (,thread t2 t1))))
- (gnus-sort-gathered-threads-function
- gnus-thread-sort-functions)
- (gnus-article-sort-functions
- (if (not reverse)
- article
- `(lambda (t1 t2)
- (,article t2 t1))))
- (buffer-read-only)
- (gnus-summary-prepare-hook nil))
- ;; We do the sorting by regenerating the threads.
- (gnus-summary-prepare)
- ;; Hide subthreads if needed.
- (gnus-summary-maybe-hide-threads)))
-
-;; Summary saving commands.
-
-(defun gnus-summary-save-article (&optional n not-saved)
- "Save the current article using the default saver function.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead.
-The variable `gnus-default-article-saver' specifies the saver function.
-
-If the optional second argument NOT-SAVED is non-nil, articles saved
-will not be marked as saved."
- (interactive "P")
- (require 'gnus-art)
- (let* ((articles (gnus-summary-work-articles n))
- (save-buffer (save-excursion
- (nnheader-set-temp-buffer " *Gnus Save*")))
- (num (length articles))
- ;; Whether to save decoded articles or raw articles.
- (decode (when gnus-article-save-coding-system
- (get gnus-default-article-saver :decode)))
- ;; When saving many articles in a single file, use the other
- ;; function to save articles other than the first one.
- (saver2 (get gnus-default-article-saver :function))
- (gnus-prompt-before-saving (if saver2
- t
- gnus-prompt-before-saving))
- (gnus-default-article-saver gnus-default-article-saver)
- header file)
- (dolist (article articles)
- (setq header (gnus-summary-article-header article))
- (if (not (vectorp header))
- ;; This is a pseudo-article.
- (if (assq 'name header)
- (gnus-copy-file (cdr (assq 'name header)))
- (gnus-message 1 "Article %d is unsaveable" article))
- ;; This is a real article.
- (save-window-excursion
- (let ((gnus-display-mime-function (when decode
- gnus-display-mime-function))
- (gnus-article-prepare-hook (when decode
- gnus-article-prepare-hook)))
- (gnus-summary-select-article t nil nil article)
- (gnus-summary-goto-subject article)))
- (save-excursion
- (set-buffer save-buffer)
- (erase-buffer)
- (insert-buffer-substring (if decode
- gnus-article-buffer
- gnus-original-article-buffer)))
- (setq file (gnus-article-save save-buffer file num))
- (gnus-summary-remove-process-mark article)
- (unless not-saved
- (gnus-summary-set-saved-mark article)))
- (when saver2
- (setq gnus-default-article-saver saver2
- saver2 nil)))
- (gnus-kill-buffer save-buffer)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- n))
-
-(defun gnus-summary-pipe-output (&optional arg headers)
- "Pipe the current article to a subprocess.
-If N is a positive number, pipe the N next articles.
-If N is a negative number, pipe the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-pipe those articles instead.
-If HEADERS (the symbolic prefix), include the headers, too."
- (interactive (gnus-interactive "P\ny"))
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-pipe)
- (gnus-save-all-headers (or headers gnus-save-all-headers)))
- (gnus-summary-save-article arg t))
- (let ((buffer (get-buffer "*Shell Command Output*")))
- (when (and buffer
- (not (zerop (buffer-size buffer))))
- (gnus-configure-windows 'pipe))))
-
-(defun gnus-summary-save-article-mail (&optional arg)
- "Append the current article to a Unix mail box file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-mail))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-rmail (&optional arg)
- "Append the current article to an rmail file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-rmail))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-file (&optional arg)
- "Append the current article to a file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-file))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-write-article-file (&optional arg)
- "Write the current article to a file, deleting the previous file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-write-to-file))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-article-body-file (&optional arg)
- "Append the current article body to a file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-body-in-file))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-write-article-body-file (&optional arg)
- "Write the current article body to a file, deleting the previous file.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-write-body-to-file))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-muttprint (&optional arg)
- "Print the current article using Muttprint.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-pipe-to-muttprint))
- (gnus-summary-save-article arg t)))
-
-(defun gnus-summary-pipe-message (program)
- "Pipe the current article through PROGRAM."
- (interactive "sProgram: ")
- (gnus-summary-select-article)
- (let ((mail-header-separator ""))
- (gnus-eval-in-buffer-window gnus-article-buffer
- (save-restriction
- (widen)
- (let ((start (window-start))
- buffer-read-only)
- (message-pipe-buffer-body program)
- (set-window-start (get-buffer-window (current-buffer)) start))))))
-
-(defun gnus-get-split-value (methods)
- "Return a value based on the split METHODS."
- (let (split-name method result match)
- (when methods
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (save-restriction
- (nnheader-narrow-to-headers)
- (while (and methods (not split-name))
- (goto-char (point-min))
- (setq method (pop methods))
- (setq match (car method))
- (when (cond
- ((stringp match)
- ;; Regular expression.
- (ignore-errors
- (re-search-forward match nil t)))
- ((functionp match)
- ;; Function.
- (save-restriction
- (widen)
- (setq result (funcall match gnus-newsgroup-name))))
- ((consp match)
- ;; Form.
- (save-restriction
- (widen)
- (setq result (eval match)))))
- (setq split-name (cdr method))
- (cond ((stringp result)
- (push (expand-file-name
- result gnus-article-save-directory)
- split-name))
- ((consp result)
- (setq split-name (append result split-name)))))))))
- (nreverse split-name)))
-
-(defun gnus-valid-move-group-p (group)
- (and (boundp group)
- (symbol-name group)
- (symbol-value group)
- (gnus-get-function (gnus-find-method-for-group
- (symbol-name group)) 'request-accept-article t)))
-
-(defun gnus-read-move-group-name (prompt default articles prefix)
- "Read a group name."
- (let* ((split-name (gnus-get-split-value gnus-move-split-methods))
- (minibuffer-confirm-incomplete nil) ; XEmacs
- (prom
- (format "%s %s to"
- prompt
- (if (> (length articles) 1)
- (format "these %d articles" (length articles))
- "this article")))
- (to-newsgroup
- (cond
- ((null split-name)
- (gnus-completing-read-with-default
- default prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil prefix
- 'gnus-group-history))
- ((= 1 (length split-name))
- (gnus-completing-read-with-default
- (car split-name) prom
- gnus-active-hashtb
- 'gnus-valid-move-group-p
- nil nil
- 'gnus-group-history))
- (t
- (gnus-completing-read-with-default
- nil prom
- (mapcar (lambda (el) (list el))
- (nreverse split-name))
- nil nil nil
- 'gnus-group-history))))
- (to-method (gnus-server-to-method (gnus-group-method to-newsgroup))))
- (when to-newsgroup
- (if (or (string= to-newsgroup "")
- (string= to-newsgroup prefix))
- (setq to-newsgroup default))
- (unless to-newsgroup
- (error "No group name entered"))
- (or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup nil nil to-method)
- (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
- to-newsgroup))
- (or (and (gnus-request-create-group to-newsgroup to-method)
- (gnus-activate-group
- to-newsgroup nil nil to-method)
- (gnus-subscribe-group to-newsgroup))
- (error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup)))
- to-newsgroup))
-
-(defun gnus-summary-save-parts (type dir n &optional reverse)
- "Save parts matching TYPE to DIR.
-If REVERSE, save parts that do not match TYPE."
- (interactive
- (list (read-string "Save parts of type: "
- (or (car gnus-summary-save-parts-type-history)
- gnus-summary-save-parts-default-mime)
- 'gnus-summary-save-parts-type-history)
- (setq gnus-summary-save-parts-last-directory
- (read-file-name "Save to directory: "
- gnus-summary-save-parts-last-directory
- nil t))
- current-prefix-arg))
- (gnus-summary-iterate n
- (let ((gnus-display-mime-function nil)
- (gnus-inhibit-treatment t))
- (gnus-summary-select-article))
- (save-excursion
- (set-buffer gnus-article-buffer)
- (let ((handles (or gnus-article-mime-handles
- (mm-dissect-buffer nil gnus-article-loose-mime)
- (and gnus-article-emulate-mime
- (mm-uu-dissect)))))
- (when handles
- (gnus-summary-save-parts-1 type dir handles reverse)
- (unless gnus-article-mime-handles ;; Don't destroy this case.
- (mm-destroy-parts handles)))))))
-
-(defun gnus-summary-save-parts-1 (type dir handle reverse)
- (if (stringp (car handle))
- (mapcar (lambda (h) (gnus-summary-save-parts-1 type dir h reverse))
- (cdr handle))
- (when (if reverse
- (not (string-match type (mm-handle-media-type handle)))
- (string-match type (mm-handle-media-type handle)))
- (let ((file (expand-file-name
- (gnus-map-function
- mm-file-name-rewrite-functions
- (file-name-nondirectory
- (or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)
- (concat gnus-newsgroup-name
- "." (number-to-string
- (cdr gnus-article-current))))))
- dir)))
- (unless (file-exists-p file)
- (mm-save-part-to-file handle file))))))
-
-;; Summary extract commands
-
-(defun gnus-summary-insert-pseudos (pslist &optional not-view)
- (let ((buffer-read-only nil)
- (article (gnus-summary-article-number))
- after-article b e)
- (unless (gnus-summary-goto-subject article)
- (error "No such article: %d" article))
- (gnus-summary-position-point)
- ;; If all commands are to be bunched up on one line, we collect
- ;; them here.
- (unless gnus-view-pseudos-separately
- (let ((ps (setq pslist (sort pslist 'gnus-pseudos<)))
- files action)
- (while ps
- (setq action (cdr (assq 'action (car ps))))
- (setq files (list (cdr (assq 'name (car ps)))))
- (while (and ps (cdr ps)
- (string= (or action "1")
- (or (cdr (assq 'action (cadr ps))) "2")))
- (push (cdr (assq 'name (cadr ps))) files)
- (setcdr ps (cddr ps)))
- (when files
- (when (not (string-match "%s" action))
- (push " " files))
- (push " " files)
- (when (assq 'execute (car ps))
- (setcdr (assq 'execute (car ps))
- (funcall (if (string-match "%s" action)
- 'format 'concat)
- action
- (mapconcat
- (lambda (f)
- (if (equal f " ")
- f
- (mm-quote-arg f)))
- files " ")))))
- (setq ps (cdr ps)))))
- (if (and gnus-view-pseudos (not not-view))
- (while pslist
- (when (assq 'execute (car pslist))
- (gnus-execute-command (cdr (assq 'execute (car pslist)))
- (eq gnus-view-pseudos 'not-confirm)))
- (setq pslist (cdr pslist)))
- (save-excursion
- (while pslist
- (setq after-article (or (cdr (assq 'article (car pslist)))
- (gnus-summary-article-number)))
- (gnus-summary-goto-subject after-article)
- (forward-line 1)
- (setq b (point))
- (insert " " (file-name-nondirectory
- (cdr (assq 'name (car pslist))))
- ": " (or (cdr (assq 'execute (car pslist))) "") "\n")
- (setq e (point))
- (forward-line -1) ; back to `b'
- (gnus-add-text-properties
- b (1- e) (list 'gnus-number gnus-reffed-article-number
- gnus-mouse-face-prop gnus-mouse-face))
- (gnus-data-enter
- after-article gnus-reffed-article-number
- gnus-unread-mark b (car pslist) 0 (- e b))
- (setq gnus-newsgroup-unreads
- (gnus-add-to-sorted-list gnus-newsgroup-unreads
- gnus-reffed-article-number))
- (setq gnus-reffed-article-number (1- gnus-reffed-article-number))
- (setq pslist (cdr pslist)))))))
-
-(defun gnus-pseudos< (p1 p2)
- (let ((c1 (cdr (assq 'action p1)))
- (c2 (cdr (assq 'action p2))))
- (and c1 c2 (string< c1 c2))))
-
-(defun gnus-request-pseudo-article (props)
- (cond ((assq 'execute props)
- (gnus-execute-command (cdr (assq 'execute props)))))
- (let ((gnus-current-article (gnus-summary-article-number)))
- (gnus-run-hooks 'gnus-mark-article-hook)))
-
-(defun gnus-execute-command (command &optional automatic)
- (save-excursion
- (gnus-article-setup-buffer)
- (set-buffer gnus-article-buffer)
- (setq buffer-read-only nil)
- (let ((command (if automatic command
- (read-string "Command: " (cons command 0)))))
- (erase-buffer)
- (insert "$ " command "\n\n")
- (if gnus-view-pseudo-asynchronously
- (start-process "gnus-execute" (current-buffer) shell-file-name
- shell-command-switch command)
- (call-process shell-file-name nil t nil
- shell-command-switch command)))))
-
-;; Summary kill commands.
-
-(defun gnus-summary-edit-global-kill (article)
- "Edit the \"global\" kill file."
- (interactive (list (gnus-summary-article-number)))
- (gnus-group-edit-global-kill article))
-
-(defun gnus-summary-edit-local-kill ()
- "Edit a local kill file applied to the current newsgroup."
- (interactive)
- (setq gnus-current-headers (gnus-summary-article-header))
- (gnus-group-edit-local-kill
- (gnus-summary-article-number) gnus-newsgroup-name))
-
-;;; Header reading.
-
-(defun gnus-read-header (id &optional header)
- "Read the headers of article ID and enter them into the Gnus system."
- (let ((group gnus-newsgroup-name)
- (gnus-override-method
- (or
- gnus-override-method
- (and (gnus-news-group-p gnus-newsgroup-name)
- (car (gnus-refer-article-methods)))))
- where)
- ;; First we check to see whether the header in question is already
- ;; fetched.
- (if (stringp id)
- ;; This is a Message-ID.
- (setq header (or header (gnus-id-to-header id)))
- ;; This is an article number.
- (setq header (or header (gnus-summary-article-header id))))
- (if (and header
- (not (gnus-summary-article-sparse-p (mail-header-number header))))
- ;; We have found the header.
- header
- ;; We have to really fetch the header to this article.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (when (setq where (gnus-request-head id group))
- (nnheader-fold-continuation-lines)
- (goto-char (point-max))
- (insert ".\n")
- (goto-char (point-min))
- (insert "211 ")
- (princ (cond
- ((numberp id) id)
- ((cdr where) (cdr where))
- (header (mail-header-number header))
- (t gnus-reffed-article-number))
- (current-buffer))
- (insert " Article retrieved.\n"))
- (if (or (not where)
- (not (setq header (car (gnus-get-newsgroup-headers nil t)))))
- () ; Malformed head.
- (unless (gnus-summary-article-sparse-p (mail-header-number header))
- (when (and (stringp id)
- (not (string= (gnus-group-real-name group)
- (car where))))
- ;; If we fetched by Message-ID and the article came
- ;; from a different group, we fudge some bogus article
- ;; numbers for this article.
- (mail-header-set-number header gnus-reffed-article-number))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (decf gnus-reffed-article-number)
- (gnus-remove-header (mail-header-number header))
- (push header gnus-newsgroup-headers)
- (setq gnus-current-headers header)
- (push (mail-header-number header) gnus-newsgroup-limit)))
- header)))))
-
-(defun gnus-remove-header (number)
- "Remove header NUMBER from `gnus-newsgroup-headers'."
- (if (and gnus-newsgroup-headers
- (= number (mail-header-number (car gnus-newsgroup-headers))))
- (pop gnus-newsgroup-headers)
- (let ((headers gnus-newsgroup-headers))
- (while (and (cdr headers)
- (not (= number (mail-header-number (cadr headers)))))
- (pop headers))
- (when (cdr headers)
- (setcdr headers (cddr headers))))))
-
-;;;
-;;; summary highlights
-;;;
-
-(defun gnus-highlight-selected-summary ()
- "Highlight selected article in summary buffer."
- ;; Added by Per Abrahamsen <amanda@iesd.auc.dk>.
- (when gnus-summary-selected-face
- (save-excursion
- (let* ((beg (gnus-point-at-bol))
- (end (gnus-point-at-eol))
- ;; Fix by Mike Dugan <dugan@bucrf16.bu.edu>.
- (from (if (get-text-property beg gnus-mouse-face-prop)
- beg
- (or (next-single-property-change
- beg gnus-mouse-face-prop nil end)
- beg)))
- (to
- (if (= from end)
- (- from 2)
- (or (next-single-property-change
- from gnus-mouse-face-prop nil end)
- end))))
- ;; If no mouse-face prop on line we will have to = from = end,
- ;; so we highlight the entire line instead.
- (when (= (+ to 2) from)
- (setq from beg)
- (setq to end))
- (if gnus-newsgroup-selected-overlay
- ;; Move old overlay.
- (gnus-move-overlay
- gnus-newsgroup-selected-overlay from to (current-buffer))
- ;; Create new overlay.
- (gnus-overlay-put
- (setq gnus-newsgroup-selected-overlay (gnus-make-overlay from to))
- 'face gnus-summary-selected-face))))))
-
-(defvar gnus-summary-highlight-line-cached nil)
-(defvar gnus-summary-highlight-line-trigger nil)
-
-(defun gnus-summary-highlight-line-0 ()
- (if (and (eq gnus-summary-highlight-line-trigger
- gnus-summary-highlight)
- gnus-summary-highlight-line-cached)
- gnus-summary-highlight-line-cached
- (setq gnus-summary-highlight-line-trigger gnus-summary-highlight
- gnus-summary-highlight-line-cached
- (let* ((cond (list 'cond))
- (c cond)
- (list gnus-summary-highlight))
- (while list
- (setcdr c (cons (list (caar list) (list 'quote (cdar list)))
- nil))
- (setq c (cdr c)
- list (cdr list)))
- (gnus-byte-compile (list 'lambda nil cond))))))
-
-(defun gnus-summary-highlight-line ()
- "Highlight current line according to `gnus-summary-highlight'."
- (let* ((beg (gnus-point-at-bol))
- (article (or (gnus-summary-article-number) gnus-current-article))
- (score (or (cdr (assq article
- gnus-newsgroup-scored))
- gnus-summary-default-score 0))
- (mark (or (gnus-summary-article-mark) gnus-unread-mark))
- (inhibit-read-only t)
- (default gnus-summary-default-score)
- (default-high gnus-summary-default-high-score)
- (default-low gnus-summary-default-low-score)
- (uncached (and gnus-summary-use-undownloaded-faces
- (memq article gnus-newsgroup-undownloaded)
- (not (memq article gnus-newsgroup-cached)))))
- (let ((face (funcall (gnus-summary-highlight-line-0))))
- (unless (eq face (get-text-property beg 'face))
- (gnus-put-text-property-excluding-characters-with-faces
- beg (gnus-point-at-eol) 'face
- (setq face (if (boundp face) (symbol-value face) face)))
- (when gnus-summary-highlight-line-function
- (funcall gnus-summary-highlight-line-function article face))))))
-
-(defun gnus-update-read-articles (group unread &optional compute)
- "Update the list of read articles in GROUP.
-UNREAD is a sorted list."
- (let* ((active (or gnus-newsgroup-active (gnus-active group)))
- (entry (gnus-gethash group gnus-newsrc-hashtb))
- (info (nth 2 entry))
- (prev 1)
- read)
- (if (or (not info) (not active))
- ;; There is no info on this group if it was, in fact,
- ;; killed. Gnus stores no information on killed groups, so
- ;; there's nothing to be done.
- ;; One could store the information somewhere temporarily,
- ;; perhaps... Hmmm...
- ()
- ;; Remove any negative articles numbers.
- (while (and unread (< (car unread) 0))
- (setq unread (cdr unread)))
- ;; Remove any expired article numbers
- (while (and unread (< (car unread) (car active)))
- (setq unread (cdr unread)))
- ;; Compute the ranges of read articles by looking at the list of
- ;; unread articles.
- (while unread
- (when (/= (car unread) prev)
- (push (if (= prev (1- (car unread))) prev
- (cons prev (1- (car unread))))
- read))
- (setq prev (1+ (car unread)))
- (setq unread (cdr unread)))
- (when (<= prev (cdr active))
- (push (cons prev (cdr active)) read))
- (setq read (if (> (length read) 1) (nreverse read) read))
- (if compute
- read
- (save-excursion
- (let (setmarkundo)
- ;; Propagate the read marks to the backend.
- (when (gnus-check-backend-function 'request-set-mark group)
- (let ((del (gnus-remove-from-range (gnus-info-read info) read))
- (add (gnus-remove-from-range read (gnus-info-read info))))
- (when (or add del)
- (unless (gnus-check-group group)
- (error "Can't open server for %s" group))
- (gnus-request-set-mark
- group (delq nil (list (if add (list add 'add '(read)))
- (if del (list del 'del '(read))))))
- (setq setmarkundo
- `(gnus-request-set-mark
- ,group
- ',(delq nil (list
- (if del (list del 'add '(read)))
- (if add (list add 'del '(read))))))))))
- (set-buffer gnus-group-buffer)
- (gnus-undo-register
- `(progn
- (gnus-info-set-marks ',info ',(gnus-info-marks info) t)
- (gnus-info-set-read ',info ',(gnus-info-read info))
- (gnus-get-unread-articles-in-group ',info
- (gnus-active ,group))
- (gnus-group-update-group ,group t)
- ,setmarkundo))))
- ;; Enter this list into the group info.
- (gnus-info-set-read info read)
- ;; Set the number of unread articles in gnus-newsrc-hashtb.
- (gnus-get-unread-articles-in-group info (gnus-active group))
- t))))
-
-(defun gnus-offer-save-summaries ()
- "Offer to save all active summary buffers."
- (let (buffers)
- ;; Go through all buffers and find all summaries.
- (dolist (buffer (buffer-list))
- (when (and (setq buffer (buffer-name buffer))
- (string-match "Summary" buffer)
- (save-excursion
- (set-buffer buffer)
- ;; We check that this is, indeed, a summary buffer.
- (and (eq major-mode 'gnus-summary-mode)
- ;; Also make sure this isn't bogus.
- gnus-newsgroup-prepared
- ;; Also make sure that this isn't a
- ;; dead summary buffer.
- (not gnus-dead-summary-mode))))
- (push buffer buffers)))
- ;; Go through all these summary buffers and offer to save them.
- (when buffers
- (save-excursion
- (map-y-or-n-p
- "Update summary buffer %s? "
- (lambda (buf)
- (switch-to-buffer buf)
- (gnus-summary-exit))
- buffers)))))
-
-(defun gnus-summary-setup-default-charset ()
- "Setup newsgroup default charset."
- (if (member gnus-newsgroup-name '("nndraft:delayed" "nndraft:drafts"))
- (setq gnus-newsgroup-charset nil)
- (let* ((ignored-charsets
- (or gnus-newsgroup-ephemeral-ignored-charsets
- (append
- (and gnus-newsgroup-name
- (gnus-parameter-ignored-charsets gnus-newsgroup-name))
- gnus-newsgroup-ignored-charsets))))
- (setq gnus-newsgroup-charset
- (or gnus-newsgroup-ephemeral-charset
- (and gnus-newsgroup-name
- (gnus-parameter-charset gnus-newsgroup-name))
- gnus-default-charset))
- (set (make-local-variable 'gnus-newsgroup-ignored-charsets)
- ignored-charsets))))
-
-;;;
-;;; Mime Commands
-;;;
-
-(defun gnus-summary-display-buttonized (&optional show-all-parts)
- "Display the current article buffer fully MIME-buttonized.
-If SHOW-ALL-PARTS (the prefix) is non-nil, all multipart/* parts are
-treated as multipart/mixed."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-unbuttonized-mime-types nil)
- (gnus-mime-display-multipart-as-mixed show-all-parts))
- (gnus-summary-show-article)))
-
-(defun gnus-summary-repair-multipart (article)
- "Add a Content-Type header to a multipart article without one."
- (interactive (list (gnus-summary-article-number)))
- (gnus-with-article article
- (message-narrow-to-head)
- (message-remove-header "Mime-Version")
- (goto-char (point-max))
- (insert "Mime-Version: 1.0\n")
- (widen)
- (when (search-forward "\n--" nil t)
- (let ((separator (buffer-substring (point) (gnus-point-at-eol))))
- (message-narrow-to-head)
- (message-remove-header "Content-Type")
- (goto-char (point-max))
- (insert (format "Content-Type: multipart/mixed; boundary=\"%s\"\n"
- separator))
- (widen))))
- (let (gnus-mark-article-hook)
- (gnus-summary-select-article t t nil article)))
-
-(defun gnus-summary-toggle-display-buttonized ()
- "Toggle the buttonizing of the article buffer."
- (interactive)
- (require 'gnus-art)
- (if (setq gnus-inhibit-mime-unbuttonizing
- (not gnus-inhibit-mime-unbuttonizing))
- (let ((gnus-unbuttonized-mime-types nil))
- (gnus-summary-show-article))
- (gnus-summary-show-article)))
-
-;;;
-;;; Generic summary marking commands
-;;;
-
-(defvar gnus-summary-marking-alist
- '((read gnus-del-mark "d")
- (unread gnus-unread-mark "u")
- (ticked gnus-ticked-mark "!")
- (dormant gnus-dormant-mark "?")
- (expirable gnus-expirable-mark "e"))
- "An alist of names/marks/keystrokes.")
-
-(defvar gnus-summary-generic-mark-map (make-sparse-keymap))
-(defvar gnus-summary-mark-map)
-
-(defun gnus-summary-make-all-marking-commands ()
- (define-key gnus-summary-mark-map "M" gnus-summary-generic-mark-map)
- (dolist (elem gnus-summary-marking-alist)
- (apply 'gnus-summary-make-marking-command elem)))
-
-(defun gnus-summary-make-marking-command (name mark keystroke)
- (let ((map (make-sparse-keymap)))
- (define-key gnus-summary-generic-mark-map keystroke map)
- (dolist (lway `((next "next" next nil "n")
- (next-unread "next unread" next t "N")
- (prev "previous" prev nil "p")
- (prev-unread "previous unread" prev t "P")
- (nomove "" nil nil ,keystroke)))
- (let ((func (gnus-summary-make-marking-command-1
- mark (car lway) lway name)))
- (setq func (eval func))
- (define-key map (nth 4 lway) func)))))
-
-(defun gnus-summary-make-marking-command-1 (mark way lway name)
- `(defun ,(intern
- (format "gnus-summary-put-mark-as-%s%s"
- name (if (eq way 'nomove)
- ""
- (concat "-" (symbol-name way)))))
- (n)
- ,(format
- "Mark the current article as %s%s.
-If N, the prefix, then repeat N times.
-If N is negative, move in reverse order.
-The difference between N and the actual number of articles marked is
-returned."
- name (cadr lway))
- (interactive "p")
- (gnus-summary-generic-mark n ,mark ',(nth 2 lway) ,(nth 3 lway))))
-
-(defun gnus-summary-generic-mark (n mark move unread)
- "Mark N articles with MARK."
- (unless (eq major-mode 'gnus-summary-mode)
- (error "This command can only be used in the summary buffer"))
- (gnus-summary-show-thread)
- (let ((nummove
- (cond
- ((eq move 'next) 1)
- ((eq move 'prev) -1)
- (t 0))))
- (if (zerop nummove)
- (setq n 1)
- (when (< n 0)
- (setq n (abs n)
- nummove (* -1 nummove))))
- (while (and (> n 0)
- (gnus-summary-mark-article nil mark)
- (zerop (gnus-summary-next-subject nummove unread t)))
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more %sarticles" (if mark "" "unread ")))
- (gnus-summary-recenter)
- (gnus-summary-position-point)
- (gnus-set-mode-line 'summary)
- n))
-
-(defun gnus-summary-insert-articles (articles)
- (when (setq articles
- (gnus-sorted-difference articles
- (mapcar (lambda (h)
- (mail-header-number h))
- gnus-newsgroup-headers)))
- (setq gnus-newsgroup-headers
- (gnus-merge 'list
- gnus-newsgroup-headers
- (gnus-fetch-headers articles)
- 'gnus-article-sort-by-number))
- ;; Suppress duplicates?
- (when gnus-suppress-duplicates
- (gnus-dup-suppress-articles))
-
- ;; We might want to build some more threads first.
- (when (and gnus-fetch-old-headers
- (eq gnus-headers-retrieved-by 'nov))
- (if (eq gnus-fetch-old-headers 'invisible)
- (gnus-build-all-threads)
- (gnus-build-old-threads)))
- ;; Let the Gnus agent mark articles as read.
- (when gnus-agent
- (gnus-agent-get-undownloaded-list))
- ;; Remove list identifiers from subject
- (when gnus-list-identifiers
- (gnus-summary-remove-list-identifiers))
- ;; First and last article in this newsgroup.
- (when gnus-newsgroup-headers
- (setq gnus-newsgroup-begin
- (mail-header-number (car gnus-newsgroup-headers))
- gnus-newsgroup-end
- (mail-header-number
- (gnus-last-element gnus-newsgroup-headers))))
- (when gnus-use-scoring
- (gnus-possibly-score-headers))))
-
-(defun gnus-summary-insert-old-articles (&optional all)
- "Insert all old articles in this group.
-If ALL is non-nil, already read articles become readable.
-If ALL is a number, fetch this number of articles."
- (interactive "P")
- (prog1
- (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- older len)
- (setq older
- ;; Some nntp servers lie about their active range. When
- ;; this happens, the active range can be in the millions.
- ;; Use a compressed range to avoid creating a huge list.
- (gnus-range-difference (list gnus-newsgroup-active) old))
- (setq len (gnus-range-length older))
- (cond
- ((null older) nil)
- ((numberp all)
- (if (< all len)
- (let ((older-range (nreverse older)))
- (setq older nil)
-
- (while (> all 0)
- (let* ((r (pop older-range))
- (min (if (numberp r) r (car r)))
- (max (if (numberp r) r (cdr r))))
- (while (and (<= min max)
- (> all 0))
- (push max older)
- (setq all (1- all)
- max (1- max))))))
- (setq older (gnus-uncompress-range older))))
- (all
- (setq older (gnus-uncompress-range older)))
- (t
- (when (and (numberp gnus-large-newsgroup)
- (> len gnus-large-newsgroup))
- (let* ((cursor-in-echo-area nil)
- (initial (gnus-parameter-large-newsgroup-initial
- gnus-newsgroup-name))
- (input
- (read-string
- (format
- "How many articles from %s (%s %d): "
- (gnus-limit-string
- (gnus-group-decoded-name gnus-newsgroup-name) 35)
- (if initial "max" "default")
- len)
- (if initial
- (cons (number-to-string initial)
- 0)))))
- (unless (string-match "^[ \t]*$" input)
- (setq all (string-to-number input))
- (if (< all len)
- (let ((older-range (nreverse older)))
- (setq older nil)
-
- (while (> all 0)
- (let* ((r (pop older-range))
- (min (if (numberp r) r (car r)))
- (max (if (numberp r) r (cdr r))))
- (while (and (<= min max)
- (> all 0))
- (push max older)
- (setq all (1- all)
- max (1- max))))))))))
- (setq older (gnus-uncompress-range older))))
- (if (not older)
- (message "No old news.")
- (gnus-summary-insert-articles older)
- (gnus-summary-limit (gnus-sorted-nunion old older))))
- (gnus-summary-position-point)))
-
-(defun gnus-summary-insert-new-articles ()
- "Insert all new articles in this group."
- (interactive)
- (prog1
- (let ((old (sort (mapcar 'car gnus-newsgroup-data) '<))
- (old-active gnus-newsgroup-active)
- (nnmail-fetched-sources (list t))
- i new)
- (setq gnus-newsgroup-active
- (gnus-activate-group gnus-newsgroup-name 'scan))
- (setq i (cdr gnus-newsgroup-active))
- (while (> i (cdr old-active))
- (push i new)
- (decf i))
- (if (not new)
- (message "No gnus is bad news.")
- (gnus-summary-insert-articles new)
- (setq gnus-newsgroup-unreads
- (gnus-sorted-nunion gnus-newsgroup-unreads new))
- (gnus-summary-limit (gnus-sorted-nunion old new))))
- (gnus-summary-position-point)))
-
-(gnus-summary-make-all-marking-commands)
-
-(gnus-ems-redefine)
-
-(provide 'gnus-sum)
-
-(run-hooks 'gnus-sum-load-hook)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: 17c6748f-6d00-4d36-bf01-835c42f31235
-;;; gnus-sum.el ends here
+++ /dev/null
-;;; gnus-topic.el --- a folding minor mode for Gnus group buffers
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Ilja Weis <kult@uni-paderborn.de>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-group)
-(require 'gnus-start)
-(require 'gnus-util)
-
-(defgroup gnus-topic nil
- "Group topics."
- :group 'gnus-group)
-
-(defvar gnus-topic-mode nil
- "Minor mode for Gnus group buffers.")
-
-(defcustom gnus-topic-mode-hook nil
- "Hook run in topic mode buffers."
- :type 'hook
- :group 'gnus-topic)
-
-(when (featurep 'xemacs)
- (add-hook 'gnus-topic-mode-hook 'gnus-xmas-topic-menu-add))
-
-(defcustom gnus-topic-line-format "%i[ %(%{%n%}%) -- %A ]%v\n"
- "Format of topic lines.
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%i Indentation based on topic level.
-%n Topic name.
-%v Nothing if the topic is visible, \"...\" otherwise.
-%g Number of groups in the topic.
-%a Number of unread articles in the groups in the topic.
-%A Number of unread articles in the groups in the topic and its subtopics.
-
-General format specifiers can also be used.
-See Info node `(gnus)Formatting Variables'."
- :link '(custom-manual "(gnus)Formatting Variables")
- :type 'string
- :group 'gnus-topic)
-
-(defcustom gnus-topic-indent-level 2
- "*How much each subtopic should be indented."
- :type 'integer
- :group 'gnus-topic)
-
-(defcustom gnus-topic-display-empty-topics t
- "*If non-nil, display the topic lines even of topics that have no unread articles."
- :type 'boolean
- :group 'gnus-topic)
-
-;; Internal variables.
-
-(defvar gnus-topic-active-topology nil)
-(defvar gnus-topic-active-alist nil)
-(defvar gnus-topic-unreads nil)
-
-(defvar gnus-topology-checked-p nil
- "Whether the topology has been checked in this session.")
-
-(defvar gnus-topic-killed-topics nil)
-(defvar gnus-topic-inhibit-change-level nil)
-
-(defconst gnus-topic-line-format-alist
- `((?n name ?s)
- (?v visible ?s)
- (?i indentation ?s)
- (?g number-of-groups ?d)
- (?a (gnus-topic-articles-in-topic entries) ?d)
- (?A total-number-of-articles ?d)
- (?l level ?d)))
-
-(defvar gnus-topic-line-format-spec nil)
-
-;;; Utility functions
-
-(defun gnus-group-topic-name ()
- "The name of the topic on the current line."
- (let ((topic (get-text-property (gnus-point-at-bol) 'gnus-topic)))
- (and topic (symbol-name topic))))
-
-(defun gnus-group-topic-level ()
- "The level of the topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-level))
-
-(defun gnus-group-topic-unread ()
- "The number of unread articles in topic on the current line."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-unread))
-
-(defun gnus-topic-unread (topic)
- "Return the number of unread articles in TOPIC."
- (or (cdr (assoc topic gnus-topic-unreads))
- 0))
-
-(defun gnus-group-topic-p ()
- "Return non-nil if the current line is a topic."
- (gnus-group-topic-name))
-
-(defun gnus-topic-visible-p ()
- "Return non-nil if the current topic is visible."
- (get-text-property (gnus-point-at-bol) 'gnus-topic-visible))
-
-(defun gnus-topic-articles-in-topic (entries)
- (let ((total 0)
- number)
- (while entries
- (when (numberp (setq number (car (pop entries))))
- (incf total number)))
- total))
-
-(defun gnus-group-topic (group)
- "Return the topic GROUP is a member of."
- (let ((alist gnus-topic-alist)
- out)
- (while alist
- (when (member group (cdar alist))
- (setq out (caar alist)
- alist nil))
- (setq alist (cdr alist)))
- out))
-
-(defun gnus-group-parent-topic (group)
- "Return the topic GROUP is member of by looking at the group buffer."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (if (gnus-group-goto-group group)
- (gnus-current-topic)
- (gnus-group-topic group))))
-
-(defun gnus-topic-goto-topic (topic)
- (when topic
- (gnus-goto-char (text-property-any (point-min) (point-max)
- 'gnus-topic (intern topic)))))
-
-(defun gnus-topic-jump-to-topic (topic)
- "Go to TOPIC."
- (interactive
- (list (completing-read "Go to topic: "
- (mapcar 'list (gnus-topic-list))
- nil t)))
- (dolist (topic (gnus-current-topics topic))
- (gnus-topic-goto-topic topic)
- (gnus-topic-fold t))
- (gnus-topic-goto-topic topic))
-
-(defun gnus-current-topic ()
- "Return the name of the current topic."
- (let ((result
- (or (get-text-property (point) 'gnus-topic)
- (save-excursion
- (and (gnus-goto-char (previous-single-property-change
- (point) 'gnus-topic))
- (get-text-property (max (1- (point)) (point-min))
- 'gnus-topic))))))
- (when result
- (symbol-name result))))
-
-(defun gnus-current-topics (&optional topic)
- "Return a list of all current topics, lowest in hierarchy first.
-If TOPIC, start with that topic."
- (let ((topic (or topic (gnus-current-topic)))
- topics)
- (while topic
- (push topic topics)
- (setq topic (gnus-topic-parent-topic topic)))
- (nreverse topics)))
-
-(defun gnus-group-active-topic-p ()
- "Say whether the current topic comes from the active topics."
- (save-excursion
- (beginning-of-line)
- (get-text-property (point) 'gnus-active)))
-
-(defun gnus-topic-find-groups (topic &optional level all lowest recursive)
- "Return entries for all visible groups in TOPIC.
-If RECURSIVE is t, return groups in its subtopics too."
- (let ((groups (cdr (assoc topic gnus-topic-alist)))
- info clevel unread group params visible-groups entry active)
- (setq lowest (or lowest 1))
- (setq level (or level gnus-level-unsubscribed))
- ;; We go through the newsrc to look for matches.
- (while groups
- (when (setq group (pop groups))
- (setq entry (gnus-gethash group gnus-newsrc-hashtb)
- info (nth 2 entry)
- params (gnus-info-params info)
- active (gnus-active group)
- unread (or (car entry)
- (and (not (equal group "dummy.group"))
- active
- (- (1+ (cdr active)) (car active))))
- clevel (or (gnus-info-level info)
- (if (member group gnus-zombie-list)
- gnus-level-zombie gnus-level-killed))))
- (and
- info ; nil means that the group is dead.
- (<= clevel level)
- (>= clevel lowest) ; Is inside the level we want.
- (or all
- (if (or (eq unread t)
- (eq unread nil))
- gnus-group-list-inactive-groups
- (> unread 0))
- (and gnus-list-groups-with-ticked-articles
- (cdr (assq 'tick (gnus-info-marks info))))
- ;; Has right readedness.
- ;; Check for permanent visibility.
- (and gnus-permanently-visible-groups
- (string-match gnus-permanently-visible-groups group))
- (memq 'visible params)
- (cdr (assq 'visible params)))
- ;; Add this group to the list of visible groups.
- (push (or entry group) visible-groups)))
- (setq visible-groups (nreverse visible-groups))
- (when recursive
- (if (eq recursive t)
- (setq recursive (cdr (gnus-topic-find-topology topic))))
- (mapcar (lambda (topic-topology)
- (setq visible-groups
- (nconc visible-groups
- (gnus-topic-find-groups
- (caar topic-topology)
- level all lowest topic-topology))))
- (cdr recursive)))
- visible-groups))
-
-(defun gnus-topic-goto-previous-topic (n)
- "Go to the N'th previous topic."
- (interactive "p")
- (gnus-topic-goto-next-topic (- n)))
-
-(defun gnus-topic-goto-next-topic (n)
- "Go to the N'th next topic."
- (interactive "p")
- (let ((backward (< n 0))
- (n (abs n))
- (topic (gnus-current-topic)))
- (while (and (> n 0)
- (setq topic
- (if backward
- (gnus-topic-previous-topic topic)
- (gnus-topic-next-topic topic))))
- (gnus-topic-goto-topic topic)
- (setq n (1- n)))
- (when (/= 0 n)
- (gnus-message 7 "No more topics"))
- n))
-
-(defun gnus-topic-previous-topic (topic)
- "Return the previous topic on the same level as TOPIC."
- (let ((top (cddr (gnus-topic-find-topology
- (gnus-topic-parent-topic topic)))))
- (unless (equal topic (caaar top))
- (while (and top (not (equal (caaadr top) topic)))
- (setq top (cdr top)))
- (caaar top))))
-
-(defun gnus-topic-parent-topic (topic &optional topology)
- "Return the parent of TOPIC."
- (unless topology
- (setq topology gnus-topic-topology))
- (let ((parent (car (pop topology)))
- result found)
- (while (and topology
- (not (setq found (equal (caaar topology) topic)))
- (not (setq result (gnus-topic-parent-topic
- topic (car topology)))))
- (setq topology (cdr topology)))
- (or result (and found parent))))
-
-(defun gnus-topic-next-topic (topic &optional previous)
- "Return the next sibling of TOPIC."
- (let ((parentt (cddr (gnus-topic-find-topology
- (gnus-topic-parent-topic topic))))
- prev)
- (while (and parentt
- (not (equal (caaar parentt) topic)))
- (setq prev (caaar parentt)
- parentt (cdr parentt)))
- (if previous
- prev
- (caaadr parentt))))
-
-(defun gnus-topic-forward-topic (num)
- "Go to the next topic on the same level as the current one."
- (let* ((topic (gnus-current-topic))
- (way (if (< num 0) 'gnus-topic-previous-topic
- 'gnus-topic-next-topic))
- (num (abs num)))
- (while (and (not (zerop num))
- (setq topic (funcall way topic)))
- (when (gnus-topic-goto-topic topic)
- (decf num)))
- (unless (zerop num)
- (goto-char (point-max)))
- num))
-
-(defun gnus-topic-find-topology (topic &optional topology level remove)
- "Return the topology of TOPIC."
- (unless topology
- (setq topology gnus-topic-topology)
- (setq level 0))
- (let ((top topology)
- result)
- (if (equal (caar topology) topic)
- (progn
- (when remove
- (delq topology remove))
- (cons level topology))
- (setq topology (cdr topology))
- (while (and topology
- (not (setq result (gnus-topic-find-topology
- topic (car topology) (1+ level)
- (and remove top)))))
- (setq topology (cdr topology)))
- result)))
-
-(defvar gnus-tmp-topics nil)
-(defun gnus-topic-list (&optional topology)
- "Return a list of all topics in the topology."
- (unless topology
- (setq topology gnus-topic-topology
- gnus-tmp-topics nil))
- (push (caar topology) gnus-tmp-topics)
- (mapcar 'gnus-topic-list (cdr topology))
- gnus-tmp-topics)
-
-;;; Topic parameter jazz
-
-(defun gnus-topic-parameters (topic)
- "Return the parameters for TOPIC."
- (let ((top (gnus-topic-find-topology topic)))
- (when top
- (nth 3 (cadr top)))))
-
-(defun gnus-topic-set-parameters (topic parameters)
- "Set the topic parameters of TOPIC to PARAMETERS."
- (let ((top (gnus-topic-find-topology topic)))
- (unless top
- (error "No such topic: %s" topic))
- ;; We may have to extend if there is no parameters here
- ;; to begin with.
- (unless (nthcdr 2 (cadr top))
- (nconc (cadr top) (list nil)))
- (unless (nthcdr 3 (cadr top))
- (nconc (cadr top) (list nil)))
- (setcar (nthcdr 3 (cadr top)) parameters)
- (gnus-dribble-enter
- (format "(gnus-topic-set-parameters %S '%S)" topic parameters))))
-
-(defun gnus-group-topic-parameters (group)
- "Compute the group parameters for GROUP taking into account inheritance from topics."
- (let ((params-list (copy-sequence (gnus-group-get-parameter group))))
- (save-excursion
- (nconc params-list
- (gnus-topic-hierarchical-parameters
- ;; First we try to go to the group within the group
- ;; buffer and find the topic for the group that way.
- ;; This hopefully copes well with groups that are in
- ;; more than one topic. Failing that (i.e. when the
- ;; group isn't visible in the group buffer) we find a
- ;; topic for the group via gnus-group-topic.
- (or (and (gnus-group-goto-group group)
- (gnus-current-topic))
- (gnus-group-topic group)))))))
-
-(defun gnus-topic-hierarchical-parameters (topic)
- "Return a topic list computed for TOPIC."
- (let ((topics (gnus-current-topics topic))
- params-list param out params)
- (while topics
- (push (gnus-topic-parameters (pop topics)) params-list))
- ;; We probably have lots of nil elements here, so
- ;; we remove them. Probably faster than doing this "properly".
- (setq params-list (delq nil params-list))
- ;; Now we have all the parameters, so we go through them
- ;; and do inheritance in the obvious way.
- (while (setq params (pop params-list))
- (while (setq param (pop params))
- (when (atom param)
- (setq param (cons param t)))
- ;; Override any old versions of this param.
- (gnus-pull (car param) out)
- (push param out)))
- ;; Return the resulting parameter list.
- out))
-
-;;; General utility functions
-
-(defun gnus-topic-enter-dribble ()
- (gnus-dribble-enter
- (format "(setq gnus-topic-topology '%S)" gnus-topic-topology)))
-
-;;; Generating group buffers
-
-(defun gnus-group-prepare-topics (level &optional predicate lowest
- regexp list-topic topic-level)
- "List all newsgroups with unread articles of level LEVEL or lower.
-Use the `gnus-group-topics' to sort the groups.
-If PREDICTE is a function, list groups that the function returns non-nil;
-if it is t, list groups that have no unread articles.
-If LOWEST is non-nil, list all newsgroups of level LOWEST or higher."
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil)
- (lowest (or lowest 1))
- (not-in-list
- (and gnus-group-listed-groups
- (copy-sequence gnus-group-listed-groups))))
-
- (gnus-update-format-specifications nil 'topic)
-
- (when (or (not gnus-topic-alist)
- (not gnus-topology-checked-p))
- (gnus-topic-check-topology))
-
- (unless list-topic
- (erase-buffer))
-
- ;; List dead groups?
- (when (or gnus-group-listed-groups
- (and (>= level gnus-level-zombie)
- (<= lowest gnus-level-zombie)))
- (gnus-group-prepare-flat-list-dead
- (setq gnus-zombie-list (sort gnus-zombie-list 'string<))
- gnus-level-zombie ?Z
- regexp))
-
- (when (or gnus-group-listed-groups
- (and (>= level gnus-level-killed)
- (<= lowest gnus-level-killed)))
- (gnus-group-prepare-flat-list-dead
- (setq gnus-killed-list (sort gnus-killed-list 'string<))
- gnus-level-killed ?K regexp)
- (when not-in-list
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- (gnus-group-prepare-flat-list-dead
- (gnus-remove-if (lambda (group)
- (or (gnus-gethash group gnus-newsrc-hashtb)
- (gnus-gethash group gnus-killed-hashtb)))
- not-in-list)
- gnus-level-killed ?K regexp)))
-
- ;; Use topics.
- (prog1
- (when (or (< lowest gnus-level-zombie)
- gnus-group-listed-groups)
- (if list-topic
- (let ((top (gnus-topic-find-topology list-topic)))
- (gnus-topic-prepare-topic (cdr top) (car top)
- (or topic-level level) predicate
- nil lowest regexp))
- (gnus-topic-prepare-topic gnus-topic-topology 0
- (or topic-level level) predicate
- nil lowest regexp)))
- (gnus-group-set-mode-line)
- (setq gnus-group-list-mode (cons level predicate))
- (gnus-run-hooks 'gnus-group-prepare-hook))))
-
-(defun gnus-topic-prepare-topic (topicl level &optional list-level
- predicate silent
- lowest regexp)
- "Insert TOPIC into the group buffer.
-If SILENT, don't insert anything. Return the number of unread
-articles in the topic and its subtopics."
- (let* ((type (pop topicl))
- (entries (gnus-topic-find-groups
- (car type)
- (if gnus-group-listed-groups
- gnus-level-killed
- list-level)
- (or predicate gnus-group-listed-groups
- (cdr (assq 'visible
- (gnus-topic-hierarchical-parameters
- (car type)))))
- (if gnus-group-listed-groups 0 lowest)))
- (visiblep (and (eq (nth 1 type) 'visible) (not silent)))
- (gnus-group-indentation
- (make-string (* gnus-topic-indent-level level) ? ))
- (beg (progn (beginning-of-line) (point)))
- (topicl (reverse topicl))
- (all-entries entries)
- (point-max (point-max))
- (unread 0)
- (topic (car type))
- info entry end active tick)
- ;; Insert any sub-topics.
- (while topicl
- (incf unread
- (gnus-topic-prepare-topic
- (pop topicl) (1+ level) list-level predicate
- (not visiblep) lowest regexp)))
- (setq end (point))
- (goto-char beg)
- ;; Insert all the groups that belong in this topic.
- (while (setq entry (pop entries))
- (when (if (stringp entry)
- (gnus-group-prepare-logic
- entry
- (and
- (or (not gnus-group-listed-groups)
- (if (< list-level gnus-level-zombie) nil
- (let ((entry-level
- (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)))
- (and (<= entry-level list-level)
- (>= entry-level lowest)))))
- (cond
- ((stringp regexp)
- (string-match regexp entry))
- ((functionp regexp)
- (funcall regexp entry))
- ((null regexp) t)
- (t nil))))
- (setq info (nth 2 entry))
- (gnus-group-prepare-logic
- (gnus-info-group info)
- (and (or (not gnus-group-listed-groups)
- (let ((entry-level (gnus-info-level info)))
- (and (<= entry-level list-level)
- (>= entry-level lowest))))
- (or (not (functionp predicate))
- (funcall predicate info))
- (or (not (stringp regexp))
- (string-match regexp (gnus-info-group info))))))
- (when visiblep
- (if (stringp entry)
- ;; Dead groups.
- (gnus-group-insert-group-line
- entry (if (member entry gnus-zombie-list)
- gnus-level-zombie gnus-level-killed)
- nil (- (1+ (cdr (setq active (gnus-active entry))))
- (car active))
- nil)
- ;; Living groups.
- (when (setq info (nth 2 entry))
- (gnus-group-insert-group-line
- (gnus-info-group info)
- (gnus-info-level info) (gnus-info-marks info)
- (car entry) (gnus-info-method info)))))
- (when (and (listp entry)
- (numberp (car entry)))
- (incf unread (car entry)))
- (when (listp entry)
- (setq tick t))))
- (goto-char beg)
- ;; Insert the topic line.
- (when (and (not silent)
- (or gnus-topic-display-empty-topics ;We want empty topics
- (not (zerop unread)) ;Non-empty
- tick ;Ticked articles
- (/= point-max (point-max)))) ;Unactivated groups
- (gnus-extent-start-open (point))
- (gnus-topic-insert-topic-line
- (car type) visiblep
- (not (eq (nth 2 type) 'hidden))
- level all-entries unread))
- (gnus-topic-update-unreads (car type) unread)
- (when gnus-group-update-tool-bar
- (gnus-put-text-property beg end 'point-entered
- 'gnus-tool-bar-update)
- (gnus-put-text-property beg end 'point-left
- 'gnus-tool-bar-update))
- (goto-char end)
- unread))
-
-(defun gnus-topic-remove-topic (&optional insert total-remove hide in-level)
- "Remove the current topic."
- (let ((topic (gnus-group-topic-name))
- (level (gnus-group-topic-level))
- (beg (progn (beginning-of-line) (point)))
- buffer-read-only)
- (when topic
- (while (and (zerop (forward-line 1))
- (> (or (gnus-group-topic-level) (1+ level)) level)))
- (delete-region beg (point))
- ;; Do the change in this rather odd manner because it has been
- ;; reported that some topics share parts of some lists, for some
- ;; reason. I have been unable to determine why this is the
- ;; case, but this hack seems to take care of things.
- (let ((data (cadr (gnus-topic-find-topology topic))))
- (setcdr data
- (list (if insert 'visible 'invisible)
- (caddr data)
- (cadddr data))))
- (if total-remove
- (setq gnus-topic-alist
- (delq (assoc topic gnus-topic-alist) gnus-topic-alist))
- (gnus-topic-insert-topic topic in-level)))))
-
-(defun gnus-topic-insert-topic (topic &optional level)
- "Insert TOPIC."
- (gnus-group-prepare-topics
- (car gnus-group-list-mode) (cdr gnus-group-list-mode)
- nil nil topic level))
-
-(defun gnus-topic-fold (&optional insert topic)
- "Remove/insert the current topic."
- (let ((topic (or topic (gnus-group-topic-name))))
- (when topic
- (save-excursion
- (if (not (gnus-group-active-topic-p))
- (gnus-topic-remove-topic
- (or insert (not (gnus-topic-visible-p))))
- (let ((gnus-topic-topology gnus-topic-active-topology)
- (gnus-topic-alist gnus-topic-active-alist)
- (gnus-group-list-mode (cons 5 t)))
- (gnus-topic-remove-topic
- (or insert (not (gnus-topic-visible-p))) nil nil 9)
- (gnus-topic-enter-dribble)))))))
-
-(defun gnus-topic-insert-topic-line (name visiblep shownp level entries
- &optional unread)
- (let* ((visible (if visiblep "" "..."))
- (indentation (make-string (* gnus-topic-indent-level level) ? ))
- (total-number-of-articles unread)
- (number-of-groups (length entries))
- (active-topic (eq gnus-topic-alist gnus-topic-active-alist))
- gnus-tmp-header)
- (gnus-topic-update-unreads name unread)
- (beginning-of-line)
- ;; Insert the text.
- (if shownp
- (gnus-add-text-properties
- (point)
- (prog1 (1+ (point))
- (eval gnus-topic-line-format-spec))
- (list 'gnus-topic (intern name)
- 'gnus-topic-level level
- 'gnus-topic-unread unread
- 'gnus-active active-topic
- 'gnus-topic-visible visiblep)))))
-
-(defun gnus-topic-update-unreads (topic unreads)
- (setq gnus-topic-unreads (delq (assoc topic gnus-topic-unreads)
- gnus-topic-unreads))
- (push (cons topic unreads) gnus-topic-unreads))
-
-(defun gnus-topic-update-topics-containing-group (group)
- "Update all topics that have GROUP as a member."
- (when (and (eq major-mode 'gnus-group-mode)
- gnus-topic-mode)
- (save-excursion
- (let ((alist gnus-topic-alist))
- ;; This is probably not entirely correct. If a topic
- ;; isn't shown, then it's not updated. But the updating
- ;; should be performed in any case, since the topic's
- ;; parent should be updated. Pfft.
- (while alist
- (when (and (member group (cdar alist))
- (gnus-topic-goto-topic (caar alist)))
- (gnus-topic-update-topic-line (caar alist)))
- (pop alist))))))
-
-(defun gnus-topic-update-topic ()
- "Update all parent topics to the current group."
- (when (and (eq major-mode 'gnus-group-mode)
- gnus-topic-mode)
- (let ((group (gnus-group-group-name))
- (m (point-marker))
- (buffer-read-only nil))
- (when (and group
- (gnus-get-info group)
- (gnus-topic-goto-topic (gnus-current-topic)))
- (gnus-topic-update-topic-line (gnus-group-topic-name))
- (goto-char m)
- (set-marker m nil)
- (gnus-group-position-point)))))
-
-(defun gnus-topic-goto-missing-group (group)
- "Place point where GROUP is supposed to be inserted."
- (let* ((topic (gnus-group-topic group))
- (groups (cdr (assoc topic gnus-topic-alist)))
- (g (cdr (member group groups)))
- (unfound t)
- entry)
- ;; Try to jump to a visible group.
- (while (and g
- (not (gnus-group-goto-group (car g) t)))
- (pop g))
- ;; It wasn't visible, so we try to see where to insert it.
- (when (not g)
- (setq g (cdr (member group (reverse groups))))
- (while (and g unfound)
- (when (gnus-group-goto-group (pop g) t)
- (forward-line 1)
- (setq unfound nil)))
- (when (and unfound
- topic
- (not (gnus-topic-goto-missing-topic topic)))
- (gnus-topic-display-missing-topic topic)))))
-
-(defun gnus-topic-display-missing-topic (topic)
- "Insert topic lines recursively for missing topics."
- (let ((parent (gnus-topic-find-topology
- (gnus-topic-parent-topic topic))))
- (when (and parent
- (not (gnus-topic-goto-missing-topic (caadr parent))))
- (gnus-topic-display-missing-topic (caadr parent))))
- (gnus-topic-goto-missing-topic topic)
- (let* ((top (gnus-topic-find-topology topic))
- (children (cddr top))
- (type (cadr top))
- (unread 0)
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode)))
- entry)
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry))))
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil unread)))
-
-(defun gnus-topic-goto-missing-topic (topic)
- (if (gnus-topic-goto-topic topic)
- (forward-line 1)
- ;; Topic not displayed.
- (let* ((top (gnus-topic-find-topology
- (gnus-topic-parent-topic topic)))
- (tp (reverse (cddr top))))
- (if (not top)
- (gnus-topic-insert-topic-line
- topic t t (car (gnus-topic-find-topology topic)) nil 0)
- (while (not (equal (caaar tp) topic))
- (setq tp (cdr tp)))
- (pop tp)
- (while (and tp
- (not (gnus-topic-goto-topic (caaar tp))))
- (pop tp))
- (if tp
- (gnus-topic-forward-topic 1)
- (gnus-topic-goto-missing-topic (caadr top)))))
- nil))
-
-(defun gnus-topic-update-topic-line (topic-name &optional reads)
- (let* ((top (gnus-topic-find-topology topic-name))
- (type (cadr top))
- (children (cddr top))
- (entries (gnus-topic-find-groups
- (car type) (car gnus-group-list-mode)
- (cdr gnus-group-list-mode)))
- (parent (gnus-topic-parent-topic topic-name))
- (all-entries entries)
- (unread 0)
- old-unread entry new-unread)
- (when (gnus-topic-goto-topic (car type))
- ;; Tally all the groups that belong in this topic.
- (if reads
- (setq unread (- (gnus-group-topic-unread) reads))
- (while children
- (incf unread (gnus-topic-unread (caar (pop children)))))
- (while (setq entry (pop entries))
- (when (numberp (car entry))
- (incf unread (car entry)))))
- (setq old-unread (gnus-group-topic-unread))
- ;; Insert the topic line.
- (gnus-topic-insert-topic-line
- (car type) (gnus-topic-visible-p)
- (not (eq (nth 2 type) 'hidden))
- (gnus-group-topic-level) all-entries unread)
- (gnus-delete-line)
- (forward-line -1)
- (setq new-unread (gnus-group-topic-unread)))
- (when parent
- (forward-line -1)
- (gnus-topic-update-topic-line
- parent
- (- (or old-unread 0) (or new-unread 0))))
- unread))
-
-(defun gnus-topic-group-indentation ()
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (forward-line -1)
- (gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level))
- 0))
- ? ))
-
-;;; Initialization
-
-(gnus-add-shutdown 'gnus-topic-close 'gnus)
-
-(defun gnus-topic-close ()
- (setq gnus-topic-active-topology nil
- gnus-topic-active-alist nil
- gnus-topic-killed-topics nil
- gnus-topology-checked-p nil))
-
-(defun gnus-topic-check-topology ()
- ;; The first time we set the topology to whatever we have
- ;; gotten here, which can be rather random.
- (unless gnus-topic-alist
- (gnus-topic-init-alist))
-
- (setq gnus-topology-checked-p t)
- ;; Go through the topic alist and make sure that all topics
- ;; are in the topic topology.
- (let ((topics (gnus-topic-list))
- (alist gnus-topic-alist)
- changed)
- (while alist
- (unless (member (caar alist) topics)
- (nconc gnus-topic-topology
- (list (list (list (caar alist) 'visible))))
- (setq changed t))
- (setq alist (cdr alist)))
- (when changed
- (gnus-topic-enter-dribble))
- ;; Conversely, go through the topology and make sure that all
- ;; topologies have alists.
- (while topics
- (unless (assoc (car topics) gnus-topic-alist)
- (push (list (car topics)) gnus-topic-alist))
- (pop topics)))
- ;; Go through all living groups and make sure that
- ;; they belong to some topic.
- (let* ((tgroups (apply 'append (mapcar (lambda (entry) (cdr entry))
- gnus-topic-alist)))
- (entry (last (assoc (caar gnus-topic-topology) gnus-topic-alist)))
- (newsrc (cdr gnus-newsrc-alist))
- group)
- (while newsrc
- (unless (member (setq group (gnus-info-group (pop newsrc))) tgroups)
- (setcdr entry (list group))
- (setq entry (cdr entry)))))
- ;; Go through all topics and make sure they contain only living groups.
- (let ((alist gnus-topic-alist)
- topic)
- (while (setq topic (pop alist))
- (while (cdr topic)
- (if (and (cadr topic)
- (gnus-gethash (cadr topic) gnus-newsrc-hashtb))
- (setq topic (cdr topic))
- (setcdr topic (cddr topic)))))))
-
-(defun gnus-topic-init-alist ()
- "Initialize the topic structures."
- (setq gnus-topic-topology
- (cons (list "Gnus" 'visible)
- (mapcar (lambda (topic)
- (list (list (car topic) 'visible)))
- '(("misc")))))
- (setq gnus-topic-alist
- (list (cons "misc"
- (mapcar (lambda (info) (gnus-info-group info))
- (cdr gnus-newsrc-alist)))
- (list "Gnus")))
- (gnus-topic-enter-dribble))
-
-;;; Maintenance
-
-(defun gnus-topic-clean-alist ()
- "Remove bogus groups from the topic alist."
- (let ((topic-alist gnus-topic-alist)
- result topic)
- (unless gnus-killed-hashtb
- (gnus-make-hashtable-from-killed))
- (while (setq topic (pop topic-alist))
- (let ((topic-name (pop topic))
- group filtered-topic)
- (while (setq group (pop topic))
- (when (and (or (gnus-gethash group gnus-active-hashtb)
- (gnus-info-method (gnus-get-info group)))
- (not (gnus-gethash group gnus-killed-hashtb)))
- (push group filtered-topic)))
- (push (cons topic-name (nreverse filtered-topic)) result)))
- (setq gnus-topic-alist (nreverse result))))
-
-(defun gnus-topic-change-level (group level oldlevel &optional previous)
- "Run when changing levels to enter/remove groups from topics."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (let ((buffer-read-only nil))
- (unless gnus-topic-inhibit-change-level
- (gnus-group-goto-group (or (car (nth 2 previous)) group))
- (when (and gnus-topic-mode
- gnus-topic-alist
- (not gnus-topic-inhibit-change-level))
- ;; Remove the group from the topics.
- (if (and (< oldlevel gnus-level-zombie)
- (>= level gnus-level-zombie))
- (let ((alist gnus-topic-alist))
- (while (gnus-group-goto-group group)
- (gnus-delete-line))
- (while alist
- (when (member group (car alist))
- (setcdr (car alist) (delete group (cdar alist))))
- (pop alist)))
- ;; If the group is subscribed we enter it into the topics.
- (when (and (< level gnus-level-zombie)
- (>= oldlevel gnus-level-zombie))
- (let* ((prev (gnus-group-group-name))
- (gnus-topic-inhibit-change-level t)
- (gnus-group-indentation
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level))
- 0))
- ? ))
- (yanked (list group))
- alist talist end)
- ;; Then we enter the yanked groups into the topics
- ;; they belong to.
- (when (setq alist (assoc (save-excursion
- (forward-line -1)
- (or
- (gnus-current-topic)
- (caar gnus-topic-topology)))
- gnus-topic-alist))
- (setq talist alist)
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (and (not end) (cdr alist))
- (when (equal (cadr alist) prev)
- (setcdr alist (nconc yanked (cdr alist)))
- (setq end t))
- (setq alist (cdr alist)))
- (unless end
- (nconc talist yanked))))))
- (gnus-topic-update-topic))))))))
-
-(defun gnus-topic-goto-next-group (group props)
- "Go to group or the next group after group."
- (if (not group)
- (if (not (memq 'gnus-topic props))
- (goto-char (point-max))
- (gnus-topic-goto-topic (symbol-name (cadr (memq 'gnus-topic props)))))
- (if (gnus-group-goto-group group)
- t
- ;; The group is no longer visible.
- (let* ((list (assoc (gnus-group-topic group) gnus-topic-alist))
- (after (cdr (member group (cdr list)))))
- ;; First try to put point on a group after the current one.
- (while (and after
- (not (gnus-group-goto-group (car after))))
- (setq after (cdr after)))
- ;; Then try to put point on a group before point.
- (unless after
- (setq after (cdr (member group (reverse (cdr list)))))
- (while (and after
- (not (gnus-group-goto-group (car after))))
- (setq after (cdr after))))
- ;; Finally, just put point on the topic.
- (if (not (car list))
- (goto-char (point-min))
- (unless after
- (gnus-topic-goto-topic (car list))
- (setq after nil)))
- t))))
-
-;;; Topic-active functions
-
-(defun gnus-topic-grok-active (&optional force)
- "Parse all active groups and create topic structures for them."
- ;; First we make sure that we have really read the active file.
- (when (or force
- (not gnus-topic-active-alist))
- (let (groups)
- ;; Get a list of all groups available.
- (mapatoms (lambda (g) (when (symbol-value g)
- (push (symbol-name g) groups)))
- gnus-active-hashtb)
- (setq groups (sort groups 'string<))
- ;; Init the variables.
- (setq gnus-topic-active-topology (list (list "" 'visible)))
- (setq gnus-topic-active-alist nil)
- ;; Descend the top-level hierarchy.
- (gnus-topic-grok-active-1 gnus-topic-active-topology groups)
- ;; Set the top-level topic names to something nice.
- (setcar (car gnus-topic-active-topology) "Gnus active")
- (setcar (car gnus-topic-active-alist) "Gnus active"))))
-
-(defun gnus-topic-grok-active-1 (topology groups)
- (let* ((name (caar topology))
- (prefix (concat "^" (regexp-quote name)))
- tgroups ntopology group)
- (while (and groups
- (string-match prefix (setq group (car groups))))
- (if (not (string-match "\\." group (match-end 0)))
- ;; There are no further hierarchies here, so we just
- ;; enter this group into the list belonging to this
- ;; topic.
- (push (pop groups) tgroups)
- ;; New sub-hierarchy, so we add it to the topology.
- (nconc topology (list (setq ntopology
- (list (list (substring
- group 0 (match-end 0))
- 'invisible)))))
- ;; Descend the hierarchy.
- (setq groups (gnus-topic-grok-active-1 ntopology groups))))
- ;; We remove the trailing "." from the topic name.
- (setq name
- (if (string-match "\\.$" name)
- (substring name 0 (match-beginning 0))
- name))
- ;; Add this topic and its groups to the topic alist.
- (push (cons name (nreverse tgroups)) gnus-topic-active-alist)
- (setcar (car topology) name)
- ;; We return the rest of the groups that didn't belong
- ;; to this topic.
- groups))
-
-;;; Topic mode, commands and keymap.
-
-(defvar gnus-topic-mode-map nil)
-(defvar gnus-group-topic-map nil)
-
-(unless gnus-topic-mode-map
- (setq gnus-topic-mode-map (make-sparse-keymap))
-
- ;; Override certain group mode keys.
- (gnus-define-keys gnus-topic-mode-map
- "=" gnus-topic-select-group
- "\r" gnus-topic-select-group
- " " gnus-topic-read-group
- "\C-c\C-x" gnus-topic-expire-articles
- "c" gnus-topic-catchup-articles
- "\C-k" gnus-topic-kill-group
- "\C-y" gnus-topic-yank-group
- "\M-g" gnus-topic-get-new-news-this-topic
- "AT" gnus-topic-list-active
- "Gp" gnus-topic-edit-parameters
- "#" gnus-topic-mark-topic
- "\M-#" gnus-topic-unmark-topic
- [tab] gnus-topic-indent
- [(meta tab)] gnus-topic-unindent
- "\C-i" gnus-topic-indent
- "\M-\C-i" gnus-topic-unindent
- gnus-mouse-2 gnus-mouse-pick-topic)
-
- ;; Define a new submap.
- (gnus-define-keys (gnus-group-topic-map "T" gnus-group-mode-map)
- "#" gnus-topic-mark-topic
- "\M-#" gnus-topic-unmark-topic
- "n" gnus-topic-create-topic
- "m" gnus-topic-move-group
- "D" gnus-topic-remove-group
- "c" gnus-topic-copy-group
- "h" gnus-topic-hide-topic
- "s" gnus-topic-show-topic
- "j" gnus-topic-jump-to-topic
- "M" gnus-topic-move-matching
- "C" gnus-topic-copy-matching
- "\M-p" gnus-topic-goto-previous-topic
- "\M-n" gnus-topic-goto-next-topic
- "\C-i" gnus-topic-indent
- [tab] gnus-topic-indent
- "r" gnus-topic-rename
- "\177" gnus-topic-delete
- [delete] gnus-topic-delete
- "H" gnus-topic-toggle-display-empty-topics)
-
- (gnus-define-keys (gnus-topic-sort-map "S" gnus-group-topic-map)
- "s" gnus-topic-sort-groups
- "a" gnus-topic-sort-groups-by-alphabet
- "u" gnus-topic-sort-groups-by-unread
- "l" gnus-topic-sort-groups-by-level
- "e" gnus-topic-sort-groups-by-server
- "v" gnus-topic-sort-groups-by-score
- "r" gnus-topic-sort-groups-by-rank
- "m" gnus-topic-sort-groups-by-method))
-
-(defun gnus-topic-make-menu-bar ()
- (unless (boundp 'gnus-topic-menu)
- (easy-menu-define
- gnus-topic-menu gnus-topic-mode-map ""
- '("Topics"
- ["Toggle topics" gnus-topic-mode t]
- ("Groups"
- ["Copy..." gnus-topic-copy-group t]
- ["Move..." gnus-topic-move-group t]
- ["Remove" gnus-topic-remove-group t]
- ["Copy matching..." gnus-topic-copy-matching t]
- ["Move matching..." gnus-topic-move-matching t])
- ("Topics"
- ["Goto..." gnus-topic-jump-to-topic t]
- ["Show" gnus-topic-show-topic t]
- ["Hide" gnus-topic-hide-topic t]
- ["Delete" gnus-topic-delete t]
- ["Rename..." gnus-topic-rename t]
- ["Create..." gnus-topic-create-topic t]
- ["Mark" gnus-topic-mark-topic t]
- ["Indent" gnus-topic-indent t]
- ["Sort" gnus-topic-sort-topics t]
- ["Previous topic" gnus-topic-goto-previous-topic t]
- ["Next topic" gnus-topic-goto-next-topic t]
- ["Toggle hide empty" gnus-topic-toggle-display-empty-topics t]
- ["Edit parameters" gnus-topic-edit-parameters t])
- ["List active" gnus-topic-list-active t]))))
-
-(defun gnus-topic-mode (&optional arg redisplay)
- "Minor mode for topicsifying Gnus group buffers."
- (interactive (list current-prefix-arg t))
- (when (eq major-mode 'gnus-group-mode)
- (make-local-variable 'gnus-topic-mode)
- (setq gnus-topic-mode
- (if (null arg) (not gnus-topic-mode)
- (> (prefix-numeric-value arg) 0)))
- ;; Infest Gnus with topics.
- (if (not gnus-topic-mode)
- (setq gnus-goto-missing-group-function nil)
- (when (gnus-visual-p 'topic-menu 'menu)
- (gnus-topic-make-menu-bar))
- (gnus-set-format 'topic t)
- (gnus-add-minor-mode 'gnus-topic-mode " Topic" gnus-topic-mode-map)
- (add-hook 'gnus-group-catchup-group-hook 'gnus-topic-update-topic)
- (set (make-local-variable 'gnus-group-prepare-function)
- 'gnus-group-prepare-topics)
- (set (make-local-variable 'gnus-group-get-parameter-function)
- 'gnus-group-topic-parameters)
- (set (make-local-variable 'gnus-group-goto-next-group-function)
- 'gnus-topic-goto-next-group)
- (set (make-local-variable 'gnus-group-indentation-function)
- 'gnus-topic-group-indentation)
- (set (make-local-variable 'gnus-group-update-group-function)
- 'gnus-topic-update-topics-containing-group)
- (set (make-local-variable 'gnus-group-sort-alist-function)
- 'gnus-group-sort-topic)
- (setq gnus-group-change-level-function 'gnus-topic-change-level)
- (setq gnus-goto-missing-group-function 'gnus-topic-goto-missing-group)
- (gnus-make-local-hook 'gnus-check-bogus-groups-hook)
- (add-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist
- nil 'local)
- (setq gnus-topology-checked-p nil)
- ;; We check the topology.
- (when gnus-newsrc-alist
- (gnus-topic-check-topology))
- (gnus-run-hooks 'gnus-topic-mode-hook))
- ;; Remove topic infestation.
- (unless gnus-topic-mode
- (remove-hook 'gnus-summary-exit-hook 'gnus-topic-update-topic)
- (setq gnus-group-change-level-function nil)
- (remove-hook 'gnus-check-bogus-groups-hook 'gnus-topic-clean-alist)
- (setq gnus-group-prepare-function 'gnus-group-prepare-flat)
- (setq gnus-group-sort-alist-function 'gnus-group-sort-flat))
- (when redisplay
- (gnus-group-list-groups))))
-
-(defun gnus-topic-select-group (&optional all)
- "Select this newsgroup.
-No article is selected automatically.
-If the group is opened, just switch the summary buffer.
-If ALL is non-nil, already read articles become readable.
-
-If ALL is a positive number, fetch this number of the latest
-articles in the group. If ALL is a negative number, fetch this
-number of the earliest articles in the group.
-
-If performed over a topic line, toggle folding the topic."
- (interactive "P")
- (when (and (eobp) (not (gnus-group-group-name)))
- (forward-line -1))
- (if (gnus-group-topic-p)
- (let ((gnus-group-list-mode
- (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
- (gnus-topic-fold all)
- (gnus-dribble-touch))
- (gnus-group-select-group all)))
-
-(defun gnus-mouse-pick-topic (e)
- "Select the group or topic under the mouse pointer."
- (interactive "e")
- (mouse-set-point e)
- (gnus-topic-read-group nil))
-
-(defun gnus-topic-expire-articles (topic)
- "Expire articles in this topic or group."
- (interactive (list (gnus-group-topic-name)))
- (if (not topic)
- (call-interactively 'gnus-group-expire-articles)
- (save-excursion
- (gnus-message 5 "Expiring groups in %s..." topic)
- (let ((gnus-group-marked
- (mapcar (lambda (entry) (car (nth 2 entry)))
- (gnus-topic-find-groups topic gnus-level-killed t
- nil t))))
- (gnus-group-expire-articles nil))
- (gnus-message 5 "Expiring groups in %s...done" topic))))
-
-(defun gnus-topic-catchup-articles (topic)
- "Catchup this topic or group.
-Also see `gnus-group-catchup'."
- (interactive (list (gnus-group-topic-name)))
- (if (not topic)
- (call-interactively 'gnus-group-catchup-current)
- (save-excursion
- (let* ((groups
- (mapcar (lambda (entry) (car (nth 2 entry)))
- (gnus-topic-find-groups topic gnus-level-killed t
- nil t)))
- (buffer-read-only nil)
- (gnus-group-marked groups))
- (gnus-group-catchup-current)
- (mapcar 'gnus-topic-update-topics-containing-group groups)))))
-
-(defun gnus-topic-read-group (&optional all no-article group)
- "Read news in this newsgroup.
-If the prefix argument ALL is non-nil, already read articles become
-readable.
-
-If ALL is a positive number, fetch this number of the latest
-articles in the group. If ALL is a negative number, fetch this
-number of the earliest articles in the group.
-
-If the optional argument NO-ARTICLE is non-nil, no article will
-be auto-selected upon group entry. If GROUP is non-nil, fetch
-that group.
-
-If performed over a topic line, toggle folding the topic."
- (interactive "P")
- (if (gnus-group-topic-p)
- (let ((gnus-group-list-mode
- (if all (cons (if (numberp all) all 7) t) gnus-group-list-mode)))
- (gnus-topic-fold all))
- (gnus-group-read-group all no-article group)))
-
-(defun gnus-topic-create-topic (topic parent &optional previous full-topic)
- "Create a new TOPIC under PARENT.
-When used interactively, PARENT will be the topic under point."
- (interactive
- (list
- (read-string "New topic: ")
- (gnus-current-topic)))
- ;; Check whether this topic already exists.
- (when (gnus-topic-find-topology topic)
- (error "Topic already exists"))
- (unless parent
- (setq parent (caar gnus-topic-topology)))
- (let ((top (cdr (gnus-topic-find-topology parent)))
- (full-topic (or full-topic (list (list topic 'visible nil nil)))))
- (unless top
- (error "No such parent topic: %s" parent))
- (if previous
- (progn
- (while (and (cdr top)
- (not (equal (caaadr top) previous)))
- (setq top (cdr top)))
- (setcdr top (cons full-topic (cdr top))))
- (nconc top (list full-topic)))
- (unless (assoc topic gnus-topic-alist)
- (push (list topic) gnus-topic-alist)))
- (gnus-topic-enter-dribble)
- (gnus-group-list-groups)
- (gnus-topic-goto-topic topic))
-
-;; FIXME:
-;; 1. When the marked groups are overlapped with the process
-;; region, the behavior of move or remove is not right.
-;; 2. Can't process on several marked groups with a same name,
-;; because gnus-group-marked only keeps one copy.
-
-(defun gnus-topic-move-group (n topic &optional copyp)
- "Move the next N groups to TOPIC.
-If COPYP, copy the groups instead."
- (interactive
- (list current-prefix-arg
- (gnus-completing-read "Move to topic" gnus-topic-alist nil t
- 'gnus-topic-history)))
- (let ((use-marked (and (not n) (not (gnus-region-active-p))
- gnus-group-marked t))
- (groups (gnus-group-process-prefix n))
- (topicl (assoc topic gnus-topic-alist))
- (start-topic (gnus-group-topic-name))
- (start-group (progn (forward-line 1) (gnus-group-group-name)))
- entry)
- (if (and (not groups) (not copyp) start-topic)
- (gnus-topic-move start-topic topic)
- (mapcar
- (lambda (g)
- (gnus-group-remove-mark g use-marked)
- (when (and
- (setq entry (assoc (gnus-current-topic) gnus-topic-alist))
- (not copyp))
- (setcdr entry (gnus-delete-first g (cdr entry))))
- (nconc topicl (list g)))
- groups)
- (gnus-topic-enter-dribble)
- (if start-group
- (gnus-group-goto-group start-group)
- (gnus-topic-goto-topic start-topic))
- (gnus-group-list-groups))))
-
-(defun gnus-topic-remove-group (&optional n)
- "Remove the current group from the topic."
- (interactive "P")
- (let ((use-marked (and (not n) (not (gnus-region-active-p))
- gnus-group-marked t))
- (groups (gnus-group-process-prefix n)))
- (mapcar
- (lambda (group)
- (gnus-group-remove-mark group use-marked)
- (let ((topicl (assoc (gnus-current-topic) gnus-topic-alist))
- (buffer-read-only nil))
- (when (and topicl group)
- (gnus-delete-line)
- (gnus-delete-first group topicl))
- (gnus-topic-update-topic)))
- groups)
- (gnus-topic-enter-dribble)
- (gnus-group-position-point)))
-
-(defun gnus-topic-copy-group (n topic)
- "Copy the current group to a topic."
- (interactive
- (list current-prefix-arg
- (completing-read "Copy to topic: " gnus-topic-alist nil t)))
- (gnus-topic-move-group n topic t))
-
-(defun gnus-topic-kill-group (&optional n discard)
- "Kill the next N groups."
- (interactive "P")
- (if (gnus-group-topic-p)
- (let ((topic (gnus-group-topic-name)))
- (push (cons
- (gnus-topic-find-topology topic)
- (assoc topic gnus-topic-alist))
- gnus-topic-killed-topics)
- (gnus-topic-remove-topic nil t)
- (gnus-topic-find-topology topic nil nil gnus-topic-topology)
- (gnus-topic-enter-dribble))
- (gnus-group-kill-group n discard)
- (if (not (gnus-group-topic-p))
- (gnus-topic-update-topic)
- ;; Move up one line so that we update the right topic.
- (forward-line -1)
- (gnus-topic-update-topic)
- (forward-line 1))))
-
-(defun gnus-topic-yank-group (&optional arg)
- "Yank the last topic."
- (interactive "p")
- (if gnus-topic-killed-topics
- (let* ((previous
- (or (gnus-group-topic-name)
- (gnus-topic-next-topic (gnus-current-topic))))
- (data (pop gnus-topic-killed-topics))
- (alist (cdr data))
- (item (cdar data)))
- (push alist gnus-topic-alist)
- (gnus-topic-create-topic
- (caar item) (gnus-topic-parent-topic previous) previous
- item)
- (gnus-topic-enter-dribble)
- (gnus-topic-goto-topic (caar item)))
- (let* ((prev (gnus-group-group-name))
- (gnus-topic-inhibit-change-level t)
- (gnus-group-indentation
- (make-string
- (* gnus-topic-indent-level
- (or (save-excursion
- (gnus-topic-goto-topic (gnus-current-topic))
- (gnus-group-topic-level))
- 0))
- ? ))
- yanked alist)
- ;; We first yank the groups the normal way...
- (setq yanked (gnus-group-yank-group arg))
- ;; Then we enter the yanked groups into the topics they belong
- ;; to.
- (setq alist (assoc (save-excursion
- (forward-line -1)
- (gnus-current-topic))
- gnus-topic-alist))
- (when (stringp yanked)
- (setq yanked (list yanked)))
- (if (not prev)
- (nconc alist yanked)
- (if (not (cdr alist))
- (setcdr alist (nconc yanked (cdr alist)))
- (while (cdr alist)
- (when (equal (cadr alist) prev)
- (setcdr alist (nconc yanked (cdr alist)))
- (setq alist nil))
- (setq alist (cdr alist))))))
- (gnus-topic-update-topic)))
-
-(defun gnus-topic-hide-topic (&optional permanent)
- "Hide the current topic.
-If PERMANENT, make it stay hidden in subsequent sessions as well."
- (interactive "P")
- (when (gnus-current-topic)
- (gnus-topic-goto-topic (gnus-current-topic))
- (if permanent
- (setcar (cddr
- (cadr
- (gnus-topic-find-topology (gnus-current-topic))))
- 'hidden))
- (gnus-topic-remove-topic nil nil)))
-
-(defun gnus-topic-show-topic (&optional permanent)
- "Show the hidden topic.
-If PERMANENT, make it stay shown in subsequent sessions as well."
- (interactive "P")
- (when (gnus-group-topic-p)
- (if (not permanent)
- (gnus-topic-remove-topic t nil)
- (let ((topic
- (gnus-topic-find-topology
- (completing-read "Show topic: " gnus-topic-alist nil t))))
- (setcar (cddr (cadr topic)) nil)
- (setcar (cdr (cadr topic)) 'visible)
- (gnus-group-list-groups)))))
-
-(defun gnus-topic-mark-topic (topic &optional unmark non-recursive)
- "Mark all groups in the TOPIC with the process mark.
-If NON-RECURSIVE (which is the prefix) is t, don't mark its subtopics."
- (interactive (list (gnus-group-topic-name)
- nil
- (and current-prefix-arg t)))
- (if (not topic)
- (call-interactively 'gnus-group-mark-group)
- (save-excursion
- (let ((groups (gnus-topic-find-groups topic gnus-level-killed t nil
- (not non-recursive))))
- (while groups
- (funcall (if unmark 'gnus-group-remove-mark 'gnus-group-set-mark)
- (gnus-info-group (nth 2 (pop groups)))))))))
-
-(defun gnus-topic-unmark-topic (topic &optional dummy non-recursive)
- "Remove the process mark from all groups in the TOPIC.
-If NON-RECURSIVE (which is the prefix) is t, don't unmark its subtopics."
- (interactive (list (gnus-group-topic-name)
- nil
- (and current-prefix-arg t)))
- (if (not topic)
- (call-interactively 'gnus-group-unmark-group)
- (gnus-topic-mark-topic topic t non-recursive)))
-
-(defun gnus-topic-get-new-news-this-topic (&optional n)
- "Check for new news in the current topic."
- (interactive "P")
- (if (not (gnus-group-topic-p))
- (gnus-group-get-new-news-this-group n)
- (let* ((topic (gnus-group-topic-name))
- (data (cadr (gnus-topic-find-topology topic))))
- (save-excursion
- (gnus-topic-mark-topic topic nil (and n t))
- (gnus-group-get-new-news-this-group))
- (gnus-topic-remove-topic (eq 'visible (cadr data))))))
-
-(defun gnus-topic-move-matching (regexp topic &optional copyp)
- "Move all groups that match REGEXP to some topic."
- (interactive
- (let (topic)
- (nreverse
- (list
- (setq topic (completing-read "Move to topic: " gnus-topic-alist nil t))
- (read-string (format "Move to %s (regexp): " topic))))))
- (gnus-group-mark-regexp regexp)
- (gnus-topic-move-group nil topic copyp))
-
-(defun gnus-topic-copy-matching (regexp topic &optional copyp)
- "Copy all groups that match REGEXP to some topic."
- (interactive
- (let (topic)
- (nreverse
- (list
- (setq topic (completing-read "Copy to topic: " gnus-topic-alist nil t))
- (read-string (format "Copy to %s (regexp): " topic))))))
- (gnus-topic-move-matching regexp topic t))
-
-(defun gnus-topic-delete (topic)
- "Delete a topic."
- (interactive (list (gnus-group-topic-name)))
- (unless topic
- (error "No topic to be deleted"))
- (let ((entry (assoc topic gnus-topic-alist))
- (buffer-read-only nil))
- (when (cdr entry)
- (error "Topic not empty"))
- ;; Delete if visible.
- (when (gnus-topic-goto-topic topic)
- (gnus-delete-line))
- ;; Remove from alist.
- (setq gnus-topic-alist (delq entry gnus-topic-alist))
- ;; Remove from topology.
- (gnus-topic-find-topology topic nil nil 'delete)
- (gnus-dribble-touch)))
-
-(defun gnus-topic-rename (old-name new-name)
- "Rename a topic."
- (interactive
- (let ((topic (gnus-current-topic)))
- (list topic
- (read-string (format "Rename %s to: " topic) topic))))
- ;; Check whether the new name exists.
- (when (gnus-topic-find-topology new-name)
- (error "Topic '%s' already exists" new-name))
- ;; "nil" is an invalid name, for reasons I'd rather not go
- ;; into here. Trust me.
- (when (equal new-name "nil")
- (error "Invalid name: %s" nil))
- ;; Do the renaming.
- (let ((top (gnus-topic-find-topology old-name))
- (entry (assoc old-name gnus-topic-alist)))
- (when top
- (setcar (cadr top) new-name))
- (when entry
- (setcar entry new-name))
- (forward-line -1)
- (gnus-dribble-touch)
- (gnus-group-list-groups)
- (forward-line 1)))
-
-(defun gnus-topic-indent (&optional unindent)
- "Indent a topic -- make it a sub-topic of the previous topic.
-If UNINDENT, remove an indentation."
- (interactive "P")
- (if unindent
- (gnus-topic-unindent)
- (let* ((topic (gnus-current-topic))
- (parent (gnus-topic-previous-topic topic))
- (buffer-read-only nil))
- (unless parent
- (error "Nothing to indent %s into" topic))
- (when topic
- (gnus-topic-goto-topic topic)
- (gnus-topic-kill-group)
- (push (cdar gnus-topic-killed-topics) gnus-topic-alist)
- (gnus-topic-create-topic
- topic parent nil (cdar (car gnus-topic-killed-topics)))
- (pop gnus-topic-killed-topics)
- (or (gnus-topic-goto-topic topic)
- (gnus-topic-goto-topic parent))))))
-
-(defun gnus-topic-unindent ()
- "Unindent a topic."
- (interactive)
- (let* ((topic (gnus-current-topic))
- (parent (gnus-topic-parent-topic topic))
- (grandparent (gnus-topic-parent-topic parent)))
- (unless grandparent
- (error "Nothing to indent %s into" topic))
- (when topic
- (gnus-topic-goto-topic topic)
- (gnus-topic-kill-group)
- (push (cdar gnus-topic-killed-topics) gnus-topic-alist)
- (gnus-topic-create-topic
- topic grandparent (gnus-topic-next-topic parent)
- (cdar (car gnus-topic-killed-topics)))
- (pop gnus-topic-killed-topics)
- (gnus-topic-goto-topic topic))))
-
-(defun gnus-topic-list-active (&optional force)
- "List all groups that Gnus knows about in a topicsified fashion.
-If FORCE, always re-read the active file."
- (interactive "P")
- (when force
- (gnus-get-killed-groups))
- (gnus-topic-grok-active force)
- (let ((gnus-topic-topology gnus-topic-active-topology)
- (gnus-topic-alist gnus-topic-active-alist)
- gnus-killed-list gnus-zombie-list)
- (gnus-group-list-groups gnus-level-killed nil 1)))
-
-(defun gnus-topic-toggle-display-empty-topics ()
- "Show/hide topics that have no unread articles."
- (interactive)
- (setq gnus-topic-display-empty-topics
- (not gnus-topic-display-empty-topics))
- (gnus-group-list-groups)
- (message "%s empty topics"
- (if gnus-topic-display-empty-topics
- "Showing" "Hiding")))
-
-;;; Topic sorting functions
-
-(defun gnus-topic-edit-parameters (group)
- "Edit the group parameters of GROUP.
-If performed on a topic, edit the topic parameters instead."
- (interactive (list (gnus-group-group-name)))
- (if group
- (gnus-group-edit-group-parameters group)
- (if (not (gnus-group-topic-p))
- (error "Nothing to edit on the current line")
- (let ((topic (gnus-group-topic-name)))
- (gnus-edit-form
- (gnus-topic-parameters topic)
- (format "Editing the topic parameters for `%s'."
- (or group topic))
- `(lambda (form)
- (gnus-topic-set-parameters ,topic form)))))))
-
-(defun gnus-group-sort-topic (func reverse)
- "Sort groups in the topics according to FUNC and REVERSE."
- (let ((alist gnus-topic-alist))
- (while alist
- ;; !!!Sometimes nil elements sneak into the alist,
- ;; for some reason or other.
- (setcar alist (delq nil (car alist)))
- (setcar alist (delete "dummy.group" (car alist)))
- (gnus-topic-sort-topic (pop alist) func reverse))))
-
-(defun gnus-topic-sort-topic (topic func reverse)
- ;; Each topic only lists the name of the group, while
- ;; the sort predicates expect group infos as inputs.
- ;; So we first transform the group names into infos,
- ;; then sort, and then transform back into group names.
- (setcdr
- topic
- (mapcar
- (lambda (info) (gnus-info-group info))
- (sort
- (mapcar
- (lambda (group) (gnus-get-info group))
- (cdr topic))
- func)))
- ;; Do the reversal, if necessary.
- (when reverse
- (setcdr topic (nreverse (cdr topic)))))
-
-(defun gnus-topic-sort-groups (func &optional reverse)
- "Sort the current topic according to FUNC.
-If REVERSE, reverse the sorting order."
- (interactive (list gnus-group-sort-function current-prefix-arg))
- (let ((topic (assoc (gnus-current-topic) gnus-topic-alist)))
- (gnus-topic-sort-topic
- topic (gnus-make-sort-function func) reverse)
- (gnus-group-list-groups)))
-
-(defun gnus-topic-sort-groups-by-alphabet (&optional reverse)
- "Sort the current topic alphabetically by group name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-alphabet reverse))
-
-(defun gnus-topic-sort-groups-by-unread (&optional reverse)
- "Sort the current topic by number of unread articles.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-unread reverse))
-
-(defun gnus-topic-sort-groups-by-level (&optional reverse)
- "Sort the current topic by group level.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-level reverse))
-
-(defun gnus-topic-sort-groups-by-score (&optional reverse)
- "Sort the current topic by group score.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-score reverse))
-
-(defun gnus-topic-sort-groups-by-rank (&optional reverse)
- "Sort the current topic by group rank.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-rank reverse))
-
-(defun gnus-topic-sort-groups-by-method (&optional reverse)
- "Sort the current topic alphabetically by backend name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-method reverse))
-
-(defun gnus-topic-sort-groups-by-server (&optional reverse)
- "Sort the current topic alphabetically by server name.
-If REVERSE, sort in reverse order."
- (interactive "P")
- (gnus-topic-sort-groups 'gnus-group-sort-by-server reverse))
-
-(defun gnus-topic-sort-topics-1 (top reverse)
- (if (cdr top)
- (let ((subtop
- (mapcar (gnus-byte-compile
- `(lambda (top)
- (gnus-topic-sort-topics-1 top ,reverse)))
- (sort (cdr top)
- (lambda (t1 t2)
- (string-lessp (caar t1) (caar t2)))))))
- (setcdr top (if reverse (reverse subtop) subtop))))
- top)
-
-(defun gnus-topic-sort-topics (&optional topic reverse)
- "Sort topics in TOPIC alphabetically by topic name.
-If REVERSE, reverse the sorting order."
- (interactive
- (list (completing-read "Sort topics in : " gnus-topic-alist nil t
- (gnus-current-topic))
- current-prefix-arg))
- (let ((topic-topology (or (and topic (cdr (gnus-topic-find-topology topic)))
- gnus-topic-topology)))
- (gnus-topic-sort-topics-1 topic-topology reverse)
- (gnus-topic-enter-dribble)
- (gnus-group-list-groups)
- (gnus-topic-goto-topic topic)))
-
-(defun gnus-topic-move (current to)
- "Move the CURRENT topic to TO."
- (interactive
- (list
- (gnus-group-topic-name)
- (completing-read "Move to topic: " gnus-topic-alist nil t)))
- (unless (and current to)
- (error "Can't find topic"))
- (let ((current-top (cdr (gnus-topic-find-topology current)))
- (to-top (cdr (gnus-topic-find-topology to))))
- (unless current-top
- (error "Can't find topic `%s'" current))
- (unless to-top
- (error "Can't find topic `%s'" to))
- (if (gnus-topic-find-topology to current-top 0);; Don't care the level
- (error "Can't move `%s' to its sub-level" current))
- (gnus-topic-find-topology current nil nil 'delete)
- (while (cdr to-top)
- (setq to-top (cdr to-top)))
- (setcdr to-top (list current-top))
- (gnus-topic-enter-dribble)
- (gnus-group-list-groups)
- (gnus-topic-goto-topic current)))
-
-(defun gnus-subscribe-topics (newsgroup)
- (catch 'end
- (let (match gnus-group-change-level-function)
- (dolist (topic (gnus-topic-list))
- (when (and (setq match (cdr (assq 'subscribe
- (gnus-topic-parameters topic))))
- (string-match match newsgroup))
- ;; Just subscribe the group.
- (gnus-subscribe-alphabetically newsgroup)
- ;; Add the group to the topic.
- (nconc (assoc topic gnus-topic-alist) (list newsgroup))
- ;; if this topic specifies a default level, use it
- (let ((subscribe-level (cdr (assq 'subscribe-level
- (gnus-topic-parameters topic)))))
- (when subscribe-level
- (gnus-group-change-level newsgroup subscribe-level
- gnus-level-default-subscribed)))
- (throw 'end t)))
- nil)))
-
-(provide 'gnus-topic)
-
-;;; arch-tag: bf176856-f30c-40f0-ae77-e41529a1134c
-;;; gnus-topic.el ends here
+++ /dev/null
-;;; gnus-undo.el --- minor mode for undoing in Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This package allows arbitrary undoing in Gnus buffers. As all the
-;; Gnus buffers aren't very text-oriented (what is in the buffers is
-;; just some arbitrary representation of the actual data), normal Emacs
-;; undoing doesn't work at all for Gnus.
-;;
-;; This package works by letting Gnus register functions for reversing
-;; actions, and then calling these functions when the user pushes the
-;; `undo' key. As with normal `undo', there it is possible to set
-;; undo boundaries and so on.
-;;
-;; Internally, the undo sequence is represented by the
-;; `gnus-undo-actions' list, where each element is a list of functions
-;; to be called, in sequence, to undo some action. (An "action" is a
-;; collection of functions.)
-;;
-;; For instance, a function for killing a group will call
-;; `gnus-undo-register' with a function that un-kills the group. This
-;; package will put that function into an action.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus-util)
-(require 'gnus)
-(require 'custom)
-
-(defgroup gnus-undo nil
- "Undoing in Gnus buffers."
- :group 'gnus)
-
-(defcustom gnus-undo-limit 2000
- "The number of undoable actions recorded."
- :type 'integer
- :group 'gnus-undo)
-
-(defcustom gnus-undo-mode nil
- "Minor mode for undoing in Gnus buffers."
- :type 'boolean
- :group 'gnus-undo)
-
-(defcustom gnus-undo-mode-hook nil
- "Hook called in all `gnus-undo-mode' buffers."
- :type 'hook
- :group 'gnus-undo)
-
-;;; Internal variables.
-
-(defvar gnus-undo-actions nil)
-(defvar gnus-undo-boundary t)
-(defvar gnus-undo-last nil)
-(defvar gnus-undo-boundary-inhibit nil)
-
-;;; Minor mode definition.
-
-(defvar gnus-undo-mode-map nil)
-
-(unless gnus-undo-mode-map
- (setq gnus-undo-mode-map (make-sparse-keymap))
-
- (gnus-define-keys gnus-undo-mode-map
- "\M-\C-_" gnus-undo
- "\C-_" gnus-undo
- "\C-xu" gnus-undo
- ;; many people are used to type `C-/' on X terminals and get `C-_'.
- [(control /)] gnus-undo))
-
-(defun gnus-undo-make-menu-bar ()
- ;; This is disabled for the time being.
- (when nil
- (define-key-after (current-local-map) [menu-bar file gnus-undo]
- (cons "Undo" 'gnus-undo-actions)
- [menu-bar file whatever])))
-
-(defun gnus-undo-mode (&optional arg)
- "Minor mode for providing `undo' in Gnus buffers.
-
-\\{gnus-undo-mode-map}"
- (interactive "P")
- (set (make-local-variable 'gnus-undo-mode)
- (if (null arg) (not gnus-undo-mode)
- (> (prefix-numeric-value arg) 0)))
- (set (make-local-variable 'gnus-undo-actions) nil)
- (set (make-local-variable 'gnus-undo-boundary) t)
- (when gnus-undo-mode
- ;; Set up the menu.
- (when (gnus-visual-p 'undo-menu 'menu)
- (gnus-undo-make-menu-bar))
- (gnus-add-minor-mode 'gnus-undo-mode "" gnus-undo-mode-map)
- (gnus-make-local-hook 'post-command-hook)
- (add-hook 'post-command-hook 'gnus-undo-boundary nil t)
- (gnus-run-hooks 'gnus-undo-mode-hook)))
-
-;;; Interface functions.
-
-(defun gnus-disable-undo (&optional buffer)
- "Disable undoing in the current buffer."
- (interactive)
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (gnus-undo-mode -1)))
-
-(defun gnus-undo-boundary ()
- "Set Gnus undo boundary."
- (if gnus-undo-boundary-inhibit
- (setq gnus-undo-boundary-inhibit nil)
- (setq gnus-undo-boundary t)))
-
-(defun gnus-undo-force-boundary ()
- "Set Gnus undo boundary."
- (setq gnus-undo-boundary-inhibit nil
- gnus-undo-boundary t))
-
-(defun gnus-undo-register (form)
- "Register FORMS as something to be performed to undo a change.
-FORMS may use backtick quote syntax."
- (when gnus-undo-mode
- (gnus-undo-register-1
- `(lambda ()
- ,form))))
-
-(put 'gnus-undo-register 'lisp-indent-function 0)
-(put 'gnus-undo-register 'edebug-form-spec '(body))
-
-(defun gnus-undo-register-1 (function)
- "Register FUNCTION as something to be performed to undo a change."
- (when gnus-undo-mode
- (cond
- ;; We are on a boundary, so we create a new action.
- (gnus-undo-boundary
- (push (list function) gnus-undo-actions)
- (setq gnus-undo-boundary nil))
- ;; Prepend the function to an old action.
- (gnus-undo-actions
- (setcar gnus-undo-actions (cons function (car gnus-undo-actions))))
- ;; Initialize list.
- (t
- (setq gnus-undo-actions (list (list function)))))
- ;; Limit the length of the undo list.
- (let ((next (nthcdr gnus-undo-limit gnus-undo-actions)))
- (when next
- (setcdr next nil)))
- ;; We are not at a boundary...
- (setq gnus-undo-boundary-inhibit t)))
-
-(defun gnus-undo (n)
- "Undo some previous changes in Gnus buffers.
-Repeat this command to undo more changes.
-A numeric argument serves as a repeat count."
- (interactive "p")
- (unless gnus-undo-mode
- (error "Undoing is not enabled in this buffer"))
- (message "%s" last-command)
- (when (or (not (eq last-command 'gnus-undo))
- (not gnus-undo-last))
- (setq gnus-undo-last gnus-undo-actions))
- (let ((action (pop gnus-undo-last)))
- (unless action
- (error "Nothing further to undo"))
- (setq gnus-undo-actions (delq action gnus-undo-actions))
- (setq gnus-undo-boundary t)
- (while action
- (funcall (pop action)))))
-
-(provide 'gnus-undo)
-
-;;; arch-tag: 0d787bc7-787d-499a-837f-211d2cb07f2e
-;;; gnus-undo.el ends here
+++ /dev/null
-;;; gnus-util.el --- utility functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Nothing in this file depends on any other parts of Gnus -- all
-;; functions and macros in this file are utility functions that are
-;; used by Gnus and may be used by any other package without loading
-;; Gnus first.
-
-;; [Unfortunately, it does depend on other parts of Gnus, e.g. the
-;; autoloads below...]
-
-;;; Code:
-
-(require 'custom)
-(eval-when-compile
- (require 'cl)
- ;; Fixme: this should be a gnus variable, not nnmail-.
- (defvar nnmail-pathname-coding-system)
- (defvar nnmail-active-file-coding-system)
-
- ;; Inappropriate references to other parts of Gnus.
- (defvar gnus-emphasize-whitespace-regexp)
- (defvar gnus-original-article-buffer)
- (defvar gnus-user-agent)
- )
-(require 'time-date)
-(require 'netrc)
-
-(eval-and-compile
- (autoload 'message-fetch-field "message")
- (autoload 'gnus-get-buffer-window "gnus-win")
- (autoload 'rmail-insert-rmail-file-header "rmail")
- (autoload 'rmail-count-new-messages "rmail")
- (autoload 'rmail-show-message "rmail")
- (autoload 'nnheader-narrow-to-headers "nnheader")
- (autoload 'nnheader-replace-chars-in-string "nnheader"))
-
-(eval-and-compile
- (cond
- ;; Prefer `replace-regexp-in-string' (present in Emacs, XEmacs 21.5,
- ;; SXEmacs 22.1.4) over `replace-in-string'. The later leads to inf-loops
- ;; on empty matches:
- ;; (replace-in-string "foo" "/*$" "/")
- ;; (replace-in-string "xe" "\\(x\\)?" "")
- ((fboundp 'replace-regexp-in-string)
- (defun gnus-replace-in-string (string regexp newtext &optional literal)
- "Replace all matches for REGEXP with NEWTEXT in STRING.
-If LITERAL is non-nil, insert NEWTEXT literally. Return a new
-string containing the replacements.
-
-This is a compatibility function for different Emacsen."
- (replace-regexp-in-string regexp newtext string nil literal)))
- ((fboundp 'replace-in-string)
- (defalias 'gnus-replace-in-string 'replace-in-string))
- (t
- (defun gnus-replace-in-string (string regexp newtext &optional literal)
- "Replace all matches for REGEXP with NEWTEXT in STRING.
-If LITERAL is non-nil, insert NEWTEXT literally. Return a new
-string containing the replacements.
-
-This is a compatibility function for different Emacsen."
- (let ((start 0) tail)
- (while (string-match regexp string start)
- (setq tail (- (length string) (match-end 0)))
- (setq string (replace-match newtext nil literal string))
- (setq start (- (length string) tail))))
- string))))
-
-;;; bring in the netrc functions as aliases
-(defalias 'gnus-netrc-get 'netrc-get)
-(defalias 'gnus-netrc-machine 'netrc-machine)
-(defalias 'gnus-parse-netrc 'netrc-parse)
-
-(defun gnus-boundp (variable)
- "Return non-nil if VARIABLE is bound and non-nil."
- (and (boundp variable)
- (symbol-value variable)))
-
-(defmacro gnus-eval-in-buffer-window (buffer &rest forms)
- "Pop to BUFFER, evaluate FORMS, and then return to the original window."
- (let ((tempvar (make-symbol "GnusStartBufferWindow"))
- (w (make-symbol "w"))
- (buf (make-symbol "buf")))
- `(let* ((,tempvar (selected-window))
- (,buf ,buffer)
- (,w (gnus-get-buffer-window ,buf 'visible)))
- (unwind-protect
- (progn
- (if ,w
- (progn
- (select-window ,w)
- (set-buffer (window-buffer ,w)))
- (pop-to-buffer ,buf))
- ,@forms)
- (select-window ,tempvar)))))
-
-(put 'gnus-eval-in-buffer-window 'lisp-indent-function 1)
-(put 'gnus-eval-in-buffer-window 'edebug-form-spec '(form body))
-
-(defmacro gnus-intern-safe (string hashtable)
- "Get hash value. Arguments are STRING and HASHTABLE."
- `(let ((symbol (intern ,string ,hashtable)))
- (or (boundp symbol)
- (set symbol nil))
- symbol))
-
-;; Added by Geoffrey T. Dairiki <dairiki@u.washington.edu>. A safe way
-;; to limit the length of a string. This function is necessary since
-;; `(substr "abc" 0 30)' pukes with "Args out of range".
-;; Fixme: Why not `truncate-string-to-width'?
-(defsubst gnus-limit-string (str width)
- (if (> (length str) width)
- (substring str 0 width)
- str))
-
-(defsubst gnus-goto-char (point)
- (and point (goto-char point)))
-
-(defmacro gnus-buffer-exists-p (buffer)
- `(let ((buffer ,buffer))
- (when buffer
- (funcall (if (stringp buffer) 'get-buffer 'buffer-name)
- buffer))))
-
-(defalias 'gnus-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
-(defalias 'gnus-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position))
-
-;; The LOCAL arg to `add-hook' is interpreted differently in Emacs and
-;; XEmacs. In Emacs we don't need to call `make-local-hook' first.
-;; It's harmless, though, so the main purpose of this alias is to shut
-;; up the byte compiler.
-(defalias 'gnus-make-local-hook
- (if (eq (get 'make-local-hook 'byte-compile)
- 'byte-compile-obsolete)
- 'ignore ; Emacs
- 'make-local-hook)) ; XEmacs
-
-(defun gnus-delete-first (elt list)
- "Delete by side effect the first occurrence of ELT as a member of LIST."
- (if (equal (car list) elt)
- (cdr list)
- (let ((total list))
- (while (and (cdr list)
- (not (equal (cadr list) elt)))
- (setq list (cdr list)))
- (when (cdr list)
- (setcdr list (cddr list)))
- total)))
-
-;; Delete the current line (and the next N lines).
-(defmacro gnus-delete-line (&optional n)
- `(delete-region (gnus-point-at-bol)
- (progn (forward-line ,(or n 1)) (point))))
-
-(defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (indirect-function func)))
- (if (byte-code-function-p fval)
- (let ((flist (append fval nil)))
- (setcar flist 'byte-code)
- flist)
- (cons 'progn (cddr fval)))))
-
-(defun gnus-extract-address-components (from)
- "Extract address components from a From header.
-Given an RFC-822 address FROM, extract full name and canonical address.
-Returns a list of the form (FULL-NAME CANONICAL-ADDRESS). Much more simple
-solution than `mail-extract-address-components', which works much better, but
-is slower."
- (let (name address)
- ;; First find the address - the thing with the @ in it. This may
- ;; not be accurate in mail addresses, but does the trick most of
- ;; the time in news messages.
- (cond (;; Check ``<foo@bar>'' first in order to handle the quite common
- ;; form ``"abc@xyz" <foo@bar>'' (i.e. ``@'' as part of a comment)
- ;; correctly.
- (string-match "<\\([^@ \t<>]+[!@][^@ \t<>]+\\)>" from)
- (setq address (substring from (match-beginning 1) (match-end 1))))
- ((string-match "\\b[^@ \t<>]+[!@][^@ \t<>]+\\b" from)
- (setq address (substring from (match-beginning 0) (match-end 0)))))
- ;; Then we check whether the "name <address>" format is used.
- (and address
- ;; Linear white space is not required.
- (string-match (concat "[ \t]*<" (regexp-quote address) ">") from)
- (and (setq name (substring from 0 (match-beginning 0)))
- ;; Strip any quotes from the name.
- (string-match "^\".*\"$" name)
- (setq name (substring name 1 (1- (match-end 0))))))
- ;; If not, then "address (name)" is used.
- (or name
- (and (string-match "(.+)" from)
- (setq name (substring from (1+ (match-beginning 0))
- (1- (match-end 0)))))
- (and (string-match "()" from)
- (setq name address))
- ;; XOVER might not support folded From headers.
- (and (string-match "(.*" from)
- (setq name (substring from (1+ (match-beginning 0))
- (match-end 0)))))
- (list (if (string= name "") nil name) (or address from))))
-
-
-(defun gnus-fetch-field (field)
- "Return the value of the header FIELD of current article."
- (save-excursion
- (save-restriction
- (let ((case-fold-search t)
- (inhibit-point-motion-hooks t))
- (nnheader-narrow-to-headers)
- (message-fetch-field field)))))
-
-(defun gnus-fetch-original-field (field)
- "Fetch FIELD from the original version of the current article."
- (with-current-buffer gnus-original-article-buffer
- (gnus-fetch-field field)))
-
-
-(defun gnus-goto-colon ()
- (beginning-of-line)
- (let ((eol (gnus-point-at-eol)))
- (goto-char (or (text-property-any (point) eol 'gnus-position t)
- (search-forward ":" eol t)
- (point)))))
-
-(defun gnus-decode-newsgroups (newsgroups group &optional method)
- (let ((method (or method (gnus-find-method-for-group group))))
- (mapconcat (lambda (group)
- (gnus-group-name-decode group (gnus-group-name-charset
- method group)))
- (message-tokenize-header newsgroups)
- ",")))
-
-(defun gnus-remove-text-with-property (prop)
- "Delete all text in the current buffer with text property PROP."
- (save-excursion
- (goto-char (point-min))
- (while (not (eobp))
- (while (get-text-property (point) prop)
- (delete-char 1))
- (goto-char (next-single-property-change (point) prop nil (point-max))))))
-
-(defun gnus-newsgroup-directory-form (newsgroup)
- "Make hierarchical directory name from NEWSGROUP name."
- (let* ((newsgroup (gnus-newsgroup-savable-name newsgroup))
- (idx (string-match ":" newsgroup)))
- (concat
- (if idx (substring newsgroup 0 idx))
- (if idx "/")
- (nnheader-replace-chars-in-string
- (if idx (substring newsgroup (1+ idx)) newsgroup)
- ?. ?/))))
-
-(defun gnus-newsgroup-savable-name (group)
- ;; Replace any slashes in a group name (eg. an ange-ftp nndoc group)
- ;; with dots.
- (nnheader-replace-chars-in-string group ?/ ?.))
-
-(defun gnus-string> (s1 s2)
- (not (or (string< s1 s2)
- (string= s1 s2))))
-
-(defun gnus-string< (s1 s2)
- "Return t if first arg string is less than second in lexicographic order.
-Case is significant if and only if `case-fold-search' is nil.
-Symbols are also allowed; their print names are used instead."
- (if case-fold-search
- (string-lessp (downcase (if (symbolp s1) (symbol-name s1) s1))
- (downcase (if (symbolp s2) (symbol-name s2) s2)))
- (string-lessp s1 s2)))
-
-;;; Time functions.
-
-(defun gnus-file-newer-than (file date)
- (let ((fdate (nth 5 (file-attributes file))))
- (or (> (car fdate) (car date))
- (and (= (car fdate) (car date))
- (> (nth 1 fdate) (nth 1 date))))))
-
-;;; Keymap macros.
-
-(defmacro gnus-local-set-keys (&rest plist)
- "Set the keys in PLIST in the current keymap."
- `(gnus-define-keys-1 (current-local-map) ',plist))
-
-(defmacro gnus-define-keys (keymap &rest plist)
- "Define all keys in PLIST in KEYMAP."
- `(gnus-define-keys-1 (quote ,keymap) (quote ,plist)))
-
-(defmacro gnus-define-keys-safe (keymap &rest plist)
- "Define all keys in PLIST in KEYMAP without overwriting previous definitions."
- `(gnus-define-keys-1 (quote ,keymap) (quote ,plist) t))
-
-(put 'gnus-define-keys 'lisp-indent-function 1)
-(put 'gnus-define-keys-safe 'lisp-indent-function 1)
-(put 'gnus-local-set-keys 'lisp-indent-function 1)
-
-(defmacro gnus-define-keymap (keymap &rest plist)
- "Define all keys in PLIST in KEYMAP."
- `(gnus-define-keys-1 ,keymap (quote ,plist)))
-
-(put 'gnus-define-keymap 'lisp-indent-function 1)
-
-(defun gnus-define-keys-1 (keymap plist &optional safe)
- (when (null keymap)
- (error "Can't set keys in a null keymap"))
- (cond ((symbolp keymap)
- (setq keymap (symbol-value keymap)))
- ((keymapp keymap))
- ((listp keymap)
- (set (car keymap) nil)
- (define-prefix-command (car keymap))
- (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
- (setq keymap (symbol-value (car keymap)))))
- (let (key)
- (while plist
- (when (symbolp (setq key (pop plist)))
- (setq key (symbol-value key)))
- (if (or (not safe)
- (eq (lookup-key keymap key) 'undefined))
- (define-key keymap key (pop plist))
- (pop plist)))))
-
-(defun gnus-completing-read-with-default (default prompt &rest args)
- ;; Like `completing-read', except that DEFAULT is the default argument.
- (let* ((prompt (if default
- (concat prompt " (default " default "): ")
- (concat prompt ": ")))
- (answer (apply 'completing-read prompt args)))
- (if (or (null answer) (zerop (length answer)))
- default
- answer)))
-
-;; Two silly functions to ensure that all `y-or-n-p' questions clear
-;; the echo area.
-(defun gnus-y-or-n-p (prompt)
- (prog1
- (y-or-n-p prompt)
- (message "")))
-
-(defun gnus-yes-or-no-p (prompt)
- (prog1
- (yes-or-no-p prompt)
- (message "")))
-
-;; By Frank Schmitt <ich@Frank-Schmitt.net>. Allows to have
-;; age-depending date representations. (e.g. just the time if it's
-;; from today, the day of the week if it's within the last 7 days and
-;; the full date if it's older)
-
-(defun gnus-seconds-today ()
- "Return the number of seconds passed today."
- (let ((now (decode-time (current-time))))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600))))
-
-(defun gnus-seconds-month ()
- "Return the number of seconds passed this month."
- (let ((now (decode-time (current-time))))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
- (* (- (car (nthcdr 3 now)) 1) 3600 24))))
-
-(defun gnus-seconds-year ()
- "Return the number of seconds passed this year."
- (let ((now (decode-time (current-time)))
- (days (format-time-string "%j" (current-time))))
- (+ (car now) (* (car (cdr now)) 60) (* (car (nthcdr 2 now)) 3600)
- (* (- (string-to-number days) 1) 3600 24))))
-
-(defvar gnus-user-date-format-alist
- '(((gnus-seconds-today) . "%k:%M")
- (604800 . "%a %k:%M") ;;that's one week
- ((gnus-seconds-month) . "%a %d")
- ((gnus-seconds-year) . "%b %d")
- (t . "%b %d '%y")) ;;this one is used when no
- ;;other does match
- "Specifies date format depending on age of article.
-This is an alist of items (AGE . FORMAT). AGE can be a number (of
-seconds) or a Lisp expression evaluating to a number. When the age of
-the article is less than this number, then use `format-time-string'
-with the corresponding FORMAT for displaying the date of the article.
-If AGE is not a number or a Lisp expression evaluating to a
-non-number, then the corresponding FORMAT is used as a default value.
-
-Note that the list is processed from the beginning, so it should be
-sorted by ascending AGE. Also note that items following the first
-non-number AGE will be ignored.
-
-You can use the functions `gnus-seconds-today', `gnus-seconds-month'
-and `gnus-seconds-year' in the AGE spec. They return the number of
-seconds passed since the start of today, of this month, of this year,
-respectively.")
-
-(defun gnus-user-date (messy-date)
- "Format the messy-date according to gnus-user-date-format-alist.
-Returns \" ? \" if there's bad input or if an other error occurs.
-Input should look like this: \"Sun, 14 Oct 2001 13:34:39 +0200\"."
- (condition-case ()
- (let* ((messy-date (time-to-seconds (safe-date-to-time messy-date)))
- (now (time-to-seconds (current-time)))
- ;;If we don't find something suitable we'll use this one
- (my-format "%b %d '%y"))
- (let* ((difference (- now messy-date))
- (templist gnus-user-date-format-alist)
- (top (eval (caar templist))))
- (while (if (numberp top) (< top difference) (not top))
- (progn
- (setq templist (cdr templist))
- (setq top (eval (caar templist)))))
- (if (stringp (cdr (car templist)))
- (setq my-format (cdr (car templist)))))
- (format-time-string (eval my-format) (seconds-to-time messy-date)))
- (error " ? ")))
-
-(defun gnus-dd-mmm (messy-date)
- "Return a string like DD-MMM from a big messy string."
- (condition-case ()
- (format-time-string "%d-%b" (safe-date-to-time messy-date))
- (error " - ")))
-
-(defmacro gnus-date-get-time (date)
- "Convert DATE string to Emacs time.
-Cache the result as a text property stored in DATE."
- ;; Either return the cached value...
- `(let ((d ,date))
- (if (equal "" d)
- '(0 0)
- (or (get-text-property 0 'gnus-time d)
- ;; or compute the value...
- (let ((time (safe-date-to-time d)))
- ;; and store it back in the string.
- (put-text-property 0 1 'gnus-time time d)
- time)))))
-
-(defsubst gnus-time-iso8601 (time)
- "Return a string of TIME in YYYYMMDDTHHMMSS format."
- (format-time-string "%Y%m%dT%H%M%S" time))
-
-(defun gnus-date-iso8601 (date)
- "Convert the DATE to YYYYMMDDTHHMMSS."
- (condition-case ()
- (gnus-time-iso8601 (gnus-date-get-time date))
- (error "")))
-
-(defun gnus-mode-string-quote (string)
- "Quote all \"%\"'s in STRING."
- (gnus-replace-in-string string "%" "%%"))
-
-;; Make a hash table (default and minimum size is 256).
-;; Optional argument HASHSIZE specifies the table size.
-(defun gnus-make-hashtable (&optional hashsize)
- (make-vector (if hashsize (max (gnus-create-hash-size hashsize) 256) 256) 0))
-
-;; Make a number that is suitable for hashing; bigger than MIN and
-;; equal to some 2^x. Many machines (such as sparcs) do not have a
-;; hardware modulo operation, so they implement it in software. On
-;; many sparcs over 50% of the time to intern is spent in the modulo.
-;; Yes, it's slower than actually computing the hash from the string!
-;; So we use powers of 2 so people can optimize the modulo to a mask.
-(defun gnus-create-hash-size (min)
- (let ((i 1))
- (while (< i min)
- (setq i (* 2 i)))
- i))
-
-(defcustom gnus-verbose 7
- "*Integer that says how verbose Gnus should be.
-The higher the number, the more messages Gnus will flash to say what
-it's doing. At zero, Gnus will be totally mute; at five, Gnus will
-display most important messages; and at ten, Gnus will keep on
-jabbering all the time."
- :group 'gnus-start
- :type 'integer)
-
-(defun gnus-message (level &rest args)
- "If LEVEL is lower than `gnus-verbose' print ARGS using `message'.
-
-Guideline for numbers:
-1 - error messages, 3 - non-serious error messages, 5 - messages for things
-that take a long time, 7 - not very important messages on stuff, 9 - messages
-inside loops."
- (if (<= level gnus-verbose)
- (apply 'message args)
- ;; We have to do this format thingy here even if the result isn't
- ;; shown - the return value has to be the same as the return value
- ;; from `message'.
- (apply 'format args)))
-
-(defun gnus-error (level &rest args)
- "Beep an error if LEVEL is equal to or less than `gnus-verbose'.
-ARGS are passed to `message'."
- (when (<= (floor level) gnus-verbose)
- (apply 'message args)
- (ding)
- (let (duration)
- (when (and (floatp level)
- (not (zerop (setq duration (* 10 (- level (floor level)))))))
- (sit-for duration))))
- nil)
-
-(defun gnus-split-references (references)
- "Return a list of Message-IDs in REFERENCES."
- (let ((beg 0)
- ids)
- (while (string-match "<[^<]+[^< \t]" references beg)
- (push (substring references (match-beginning 0) (setq beg (match-end 0)))
- ids))
- (nreverse ids)))
-
-(defsubst gnus-parent-id (references &optional n)
- "Return the last Message-ID in REFERENCES.
-If N, return the Nth ancestor instead."
- (when (and references
- (not (zerop (length references))))
- (if n
- (let ((ids (inline (gnus-split-references references))))
- (while (nthcdr n ids)
- (setq ids (cdr ids)))
- (car ids))
- (when (string-match "\\(<[^<]+>\\)[ \t]*\\'" references)
- (match-string 1 references)))))
-
-(defun gnus-buffer-live-p (buffer)
- "Say whether BUFFER is alive or not."
- (and buffer
- (get-buffer buffer)
- (buffer-name (get-buffer buffer))))
-
-(defun gnus-horizontal-recenter ()
- "Recenter the current buffer horizontally."
- (if (< (current-column) (/ (window-width) 2))
- (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0)
- (let* ((orig (point))
- (end (window-end (gnus-get-buffer-window (current-buffer) t)))
- (max 0))
- (when end
- ;; Find the longest line currently displayed in the window.
- (goto-char (window-start))
- (while (and (not (eobp))
- (< (point) end))
- (end-of-line)
- (setq max (max max (current-column)))
- (forward-line 1))
- (goto-char orig)
- ;; Scroll horizontally to center (sort of) the point.
- (if (> max (window-width))
- (set-window-hscroll
- (gnus-get-buffer-window (current-buffer) t)
- (min (- (current-column) (/ (window-width) 3))
- (+ 2 (- max (window-width)))))
- (set-window-hscroll (gnus-get-buffer-window (current-buffer) t) 0))
- max))))
-
-(defun gnus-read-event-char (&optional prompt)
- "Get the next event."
- (let ((event (read-event prompt)))
- ;; should be gnus-characterp, but this can't be called in XEmacs anyway
- (cons (and (numberp event) event) event)))
-
-(defun gnus-sortable-date (date)
- "Make string suitable for sorting from DATE."
- (gnus-time-iso8601 (date-to-time date)))
-
-(defun gnus-copy-file (file &optional to)
- "Copy FILE to TO."
- (interactive
- (list (read-file-name "Copy file: " default-directory)
- (read-file-name "Copy file to: " default-directory)))
- (unless to
- (setq to (read-file-name "Copy file to: " default-directory)))
- (when (file-directory-p to)
- (setq to (concat (file-name-as-directory to)
- (file-name-nondirectory file))))
- (copy-file file to))
-
-(defvar gnus-work-buffer " *gnus work*")
-
-(defun gnus-set-work-buffer ()
- "Put point in the empty Gnus work buffer."
- (if (get-buffer gnus-work-buffer)
- (progn
- (set-buffer gnus-work-buffer)
- (erase-buffer))
- (set-buffer (gnus-get-buffer-create gnus-work-buffer))
- (kill-all-local-variables)
- (mm-enable-multibyte)))
-
-(defmacro gnus-group-real-name (group)
- "Find the real name of a foreign newsgroup."
- `(let ((gname ,group))
- (if (string-match "^[^:]+:" gname)
- (substring gname (match-end 0))
- gname)))
-
-(defmacro gnus-group-server (group)
- "Find the server name of a foreign newsgroup.
-For example, (gnus-group-server \"nnimap+yxa:INBOX.foo\") would
-yield \"nnimap:yxa\"."
- `(let ((gname ,group))
- (if (string-match "^\\([^:+]+\\)\\(?:\\+\\([^:]*\\)\\)?:" gname)
- (format "%s:%s" (match-string 1 gname) (or
- (match-string 2 gname)
- ""))
- (format "%s:%s" (car gnus-select-method) (cadr gnus-select-method)))))
-
-(defun gnus-make-sort-function (funs)
- "Return a composite sort condition based on the functions in FUNS."
- (cond
- ;; Just a simple function.
- ((functionp funs) funs)
- ;; No functions at all.
- ((null funs) funs)
- ;; A list of functions.
- ((or (cdr funs)
- (listp (car funs)))
- (gnus-byte-compile
- `(lambda (t1 t2)
- ,(gnus-make-sort-function-1 (reverse funs)))))
- ;; A list containing just one function.
- (t
- (car funs))))
-
-(defun gnus-make-sort-function-1 (funs)
- "Return a composite sort condition based on the functions in FUNS."
- (let ((function (car funs))
- (first 't1)
- (last 't2))
- (when (consp function)
- (cond
- ;; Reversed spec.
- ((eq (car function) 'not)
- (setq function (cadr function)
- first 't2
- last 't1))
- ((functionp function)
- ;; Do nothing.
- )
- (t
- (error "Invalid sort spec: %s" function))))
- (if (cdr funs)
- `(or (,function ,first ,last)
- (and (not (,function ,last ,first))
- ,(gnus-make-sort-function-1 (cdr funs))))
- `(,function ,first ,last))))
-
-(defun gnus-turn-off-edit-menu (type)
- "Turn off edit menu in `gnus-TYPE-mode-map'."
- (define-key (symbol-value (intern (format "gnus-%s-mode-map" type)))
- [menu-bar edit] 'undefined))
-
-(defmacro gnus-bind-print-variables (&rest forms)
- "Bind print-* variables and evaluate FORMS.
-This macro is used with `prin1', `pp', etc. in order to ensure printed
-Lisp objects are loadable. Bind `print-quoted' and `print-readably'
-to t, and `print-escape-multibyte', `print-escape-newlines',
-`print-escape-nonascii', `print-length', `print-level' and
-`print-string-length' to nil."
- `(let ((print-quoted t)
- (print-readably t)
- ;;print-circle
- ;;print-continuous-numbering
- print-escape-multibyte
- print-escape-newlines
- print-escape-nonascii
- ;;print-gensym
- print-length
- print-level
- print-string-length)
- ,@forms))
-
-(defun gnus-prin1 (form)
- "Use `prin1' on FORM in the current buffer.
-Bind `print-quoted' and `print-readably' to t, and `print-length' and
-`print-level' to nil. See also `gnus-bind-print-variables'."
- (gnus-bind-print-variables (prin1 form (current-buffer))))
-
-(defun gnus-prin1-to-string (form)
- "The same as `prin1'.
-Bind `print-quoted' and `print-readably' to t, and `print-length' and
-`print-level' to nil. See also `gnus-bind-print-variables'."
- (gnus-bind-print-variables (prin1-to-string form)))
-
-(defun gnus-pp (form)
- "Use `pp' on FORM in the current buffer.
-Bind `print-quoted' and `print-readably' to t, and `print-length' and
-`print-level' to nil. See also `gnus-bind-print-variables'."
- (gnus-bind-print-variables (pp form (current-buffer))))
-
-(defun gnus-pp-to-string (form)
- "The same as `pp-to-string'.
-Bind `print-quoted' and `print-readably' to t, and `print-length' and
-`print-level' to nil. See also `gnus-bind-print-variables'."
- (gnus-bind-print-variables (pp-to-string form)))
-
-(defun gnus-make-directory (directory)
- "Make DIRECTORY (and all its parents) if it doesn't exist."
- (require 'nnmail)
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (when (and directory
- (not (file-exists-p directory)))
- (make-directory directory t)))
- t)
-
-(defun gnus-write-buffer (file)
- "Write the current buffer's contents to FILE."
- ;; Make sure the directory exists.
- (gnus-make-directory (file-name-directory file))
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- ;; Write the buffer.
- (write-region (point-min) (point-max) file nil 'quietly)))
-
-(defun gnus-delete-file (file)
- "Delete FILE if it exists."
- (when (file-exists-p file)
- (delete-file file)))
-
-(defun gnus-delete-directory (directory)
- "Delete files in DIRECTORY. Subdirectories remain.
-If there's no subdirectory, delete DIRECTORY as well."
- (when (file-directory-p directory)
- (let ((files (directory-files
- directory t "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*"))
- file dir)
- (while files
- (setq file (pop files))
- (if (eq t (car (file-attributes file)))
- ;; `file' is a subdirectory.
- (setq dir t)
- ;; `file' is a file or a symlink.
- (delete-file file)))
- (unless dir
- (delete-directory directory)))))
-
-;; The following two functions are used in gnus-registry.
-;; They were contributed by Andreas Fuchs <asf@void.at>.
-(defun gnus-alist-to-hashtable (alist)
- "Build a hashtable from the values in ALIST."
- (let ((ht (make-hash-table
- :size 4096
- :test 'equal)))
- (mapc
- (lambda (kv-pair)
- (puthash (car kv-pair) (cdr kv-pair) ht))
- alist)
- ht))
-
-(defun gnus-hashtable-to-alist (hash)
- "Build an alist from the values in HASH."
- (let ((list nil))
- (maphash
- (lambda (key value)
- (setq list (cons (cons key value) list)))
- hash)
- list))
-
-(defun gnus-strip-whitespace (string)
- "Return STRING stripped of all whitespace."
- (while (string-match "[\r\n\t ]+" string)
- (setq string (replace-match "" t t string)))
- string)
-
-(defsubst gnus-put-text-property-excluding-newlines (beg end prop val)
- "The same as `put-text-property', but don't put this prop on any newlines in the region."
- (save-match-data
- (save-excursion
- (save-restriction
- (goto-char beg)
- (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
- (gnus-put-text-property beg (match-beginning 0) prop val)
- (setq beg (point)))
- (gnus-put-text-property beg (point) prop val)))))
-
-(defsubst gnus-put-overlay-excluding-newlines (beg end prop val)
- "The same as `put-text-property', but don't put this prop on any newlines in the region."
- (save-match-data
- (save-excursion
- (save-restriction
- (goto-char beg)
- (while (re-search-forward gnus-emphasize-whitespace-regexp end 'move)
- (gnus-overlay-put
- (gnus-make-overlay beg (match-beginning 0))
- prop val)
- (setq beg (point)))
- (gnus-overlay-put (gnus-make-overlay beg (point)) prop val)))))
-
-(defun gnus-put-text-property-excluding-characters-with-faces (beg end
- prop val)
- "The same as `put-text-property', but don't put props on characters with the `gnus-face' property."
- (let ((b beg))
- (while (/= b end)
- (when (get-text-property b 'gnus-face)
- (setq b (next-single-property-change b 'gnus-face nil end)))
- (when (/= b end)
- (inline
- (gnus-put-text-property
- b (setq b (next-single-property-change b 'gnus-face nil end))
- prop val))))))
-
-(defmacro gnus-faces-at (position)
- "Return a list of faces at POSITION."
- (if (featurep 'xemacs)
- `(let ((pos ,position))
- (mapcar-extents 'extent-face
- nil (current-buffer) pos pos nil 'face))
- `(let ((pos ,position))
- (delq nil (cons (get-text-property pos 'face)
- (mapcar
- (lambda (overlay)
- (overlay-get overlay 'face))
- (overlays-at pos)))))))
-
-;;; Protected and atomic operations. dmoore@ucsd.edu 21.11.1996
-;;; The primary idea here is to try to protect internal datastructures
-;;; from becoming corrupted when the user hits C-g, or if a hook or
-;;; similar blows up. Often in Gnus multiple tables/lists need to be
-;;; updated at the same time, or information can be lost.
-
-(defvar gnus-atomic-be-safe t
- "If t, certain operations will be protected from interruption by C-g.")
-
-(defmacro gnus-atomic-progn (&rest forms)
- "Evaluate FORMS atomically, which means to protect the evaluation
-from being interrupted by the user. An error from the forms themselves
-will return without finishing the operation. Since interrupts from
-the user are disabled, it is recommended that only the most minimal
-operations are performed by FORMS. If you wish to assign many
-complicated values atomically, compute the results into temporary
-variables and then do only the assignment atomically."
- `(let ((inhibit-quit gnus-atomic-be-safe))
- ,@forms))
-
-(put 'gnus-atomic-progn 'lisp-indent-function 0)
-
-(defmacro gnus-atomic-progn-assign (protect &rest forms)
- "Evaluate FORMS, but insure that the variables listed in PROTECT
-are not changed if anything in FORMS signals an error or otherwise
-non-locally exits. The variables listed in PROTECT are updated atomically.
-It is safe to use gnus-atomic-progn-assign with long computations.
-
-Note that if any of the symbols in PROTECT were unbound, they will be
-set to nil on a successful assignment. In case of an error or other
-non-local exit, it will still be unbound."
- (let* ((temp-sym-map (mapcar (lambda (x) (list (make-symbol
- (concat (symbol-name x)
- "-tmp"))
- x))
- protect))
- (sym-temp-map (mapcar (lambda (x) (list (cadr x) (car x)))
- temp-sym-map))
- (temp-sym-let (mapcar (lambda (x) (list (car x)
- `(and (boundp ',(cadr x))
- ,(cadr x))))
- temp-sym-map))
- (sym-temp-let sym-temp-map)
- (temp-sym-assign (apply 'append temp-sym-map))
- (sym-temp-assign (apply 'append sym-temp-map))
- (result (make-symbol "result-tmp")))
- `(let (,@temp-sym-let
- ,result)
- (let ,sym-temp-let
- (setq ,result (progn ,@forms))
- (setq ,@temp-sym-assign))
- (let ((inhibit-quit gnus-atomic-be-safe))
- (setq ,@sym-temp-assign))
- ,result)))
-
-(put 'gnus-atomic-progn-assign 'lisp-indent-function 1)
-;(put 'gnus-atomic-progn-assign 'edebug-form-spec '(sexp body))
-
-(defmacro gnus-atomic-setq (&rest pairs)
- "Similar to setq, except that the real symbols are only assigned when
-there are no errors. And when the real symbols are assigned, they are
-done so atomically. If other variables might be changed via side-effect,
-see gnus-atomic-progn-assign. It is safe to use gnus-atomic-setq
-with potentially long computations."
- (let ((tpairs pairs)
- syms)
- (while tpairs
- (push (car tpairs) syms)
- (setq tpairs (cddr tpairs)))
- `(gnus-atomic-progn-assign ,syms
- (setq ,@pairs))))
-
-;(put 'gnus-atomic-setq 'edebug-form-spec '(body))
-
-
-;;; Functions for saving to babyl/mail files.
-
-(eval-when-compile
- (condition-case nil
- (progn
- (require 'rmail)
- (autoload 'rmail-update-summary "rmailsum"))
- (error
- (define-compiler-macro rmail-select-summary (&rest body)
- ;; Rmail of the XEmacs version is supplied by the package, and
- ;; requires tm and apel packages. However, there may be those
- ;; who haven't installed those packages. This macro helps such
- ;; people even if they install those packages later.
- `(eval '(rmail-select-summary ,@body)))
- ;; If there's rmail but there's no tm (or there's apel of the
- ;; mainstream, not the XEmacs version), loading rmail of the XEmacs
- ;; version fails halfway, however it provides the rmail-select-summary
- ;; macro which uses the following functions:
- (autoload 'rmail-summary-displayed "rmail")
- (autoload 'rmail-maybe-display-summary "rmail")))
- (defvar rmail-default-rmail-file)
- (defvar mm-text-coding-system))
-
-(defun gnus-output-to-rmail (filename &optional ask)
- "Append the current article to an Rmail file named FILENAME."
- (require 'rmail)
- (require 'mm-util)
- ;; Most of these codes are borrowed from rmailout.el.
- (setq filename (expand-file-name filename))
- (setq rmail-default-rmail-file filename)
- (let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
- (save-excursion
- (or (get-file-buffer filename)
- (file-exists-p filename)
- (if (or (not ask)
- (gnus-yes-or-no-p
- (concat "\"" filename "\" does not exist, create it? ")))
- (let ((file-buffer (create-file-buffer filename)))
- (save-excursion
- (set-buffer file-buffer)
- (rmail-insert-rmail-file-header)
- (let ((require-final-newline nil)
- (coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer filename)))
- (kill-buffer file-buffer))
- (error "Output file does not exist")))
- (set-buffer tmpbuf)
- (erase-buffer)
- (insert-buffer-substring artbuf)
- (gnus-convert-article-to-rmail)
- ;; Decide whether to append to a file or to an Emacs buffer.
- (let ((outbuf (get-file-buffer filename)))
- (if (not outbuf)
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (mm-append-to-file (point-min) (point-max) filename))
- ;; File has been visited, in buffer OUTBUF.
- (set-buffer outbuf)
- (let ((buffer-read-only nil)
- (msg (and (boundp 'rmail-current-message)
- (symbol-value 'rmail-current-message))))
- ;; If MSG is non-nil, buffer is in RMAIL mode.
- (when msg
- (widen)
- (narrow-to-region (point-max) (point-max)))
- (insert-buffer-substring tmpbuf)
- (when msg
- (goto-char (point-min))
- (widen)
- (search-backward "\n\^_")
- (narrow-to-region (point) (point-max))
- (rmail-count-new-messages t)
- (when (rmail-summary-exists)
- (rmail-select-summary
- (rmail-update-summary)))
- (rmail-count-new-messages t)
- (rmail-show-message msg))
- (save-buffer)))))
- (kill-buffer tmpbuf)))
-
-(defun gnus-output-to-mail (filename &optional ask)
- "Append the current article to a mail file named FILENAME."
- (setq filename (expand-file-name filename))
- (let ((artbuf (current-buffer))
- (tmpbuf (get-buffer-create " *Gnus-output*")))
- (save-excursion
- ;; Create the file, if it doesn't exist.
- (when (and (not (get-file-buffer filename))
- (not (file-exists-p filename)))
- (if (or (not ask)
- (gnus-y-or-n-p
- (concat "\"" filename "\" does not exist, create it? ")))
- (let ((file-buffer (create-file-buffer filename)))
- (save-excursion
- (set-buffer file-buffer)
- (let ((require-final-newline nil)
- (coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer filename)))
- (kill-buffer file-buffer))
- (error "Output file does not exist")))
- (set-buffer tmpbuf)
- (erase-buffer)
- (insert-buffer-substring artbuf)
- (goto-char (point-min))
- (if (looking-at "From ")
- (forward-line 1)
- (insert "From nobody " (current-time-string) "\n"))
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">")))
- ;; Decide whether to append to a file or to an Emacs buffer.
- (let ((outbuf (get-file-buffer filename)))
- (if (not outbuf)
- (let ((buffer-read-only nil))
- (save-excursion
- (goto-char (point-max))
- (forward-char -2)
- (unless (looking-at "\n\n")
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert "\n"))
- (goto-char (point-max))
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (mm-append-to-file (point-min) (point-max) filename))))
- ;; File has been visited, in buffer OUTBUF.
- (set-buffer outbuf)
- (let ((buffer-read-only nil))
- (goto-char (point-max))
- (unless (eobp)
- (insert "\n"))
- (insert "\n")
- (insert-buffer-substring tmpbuf)))))
- (kill-buffer tmpbuf)))
-
-(defun gnus-convert-article-to-rmail ()
- "Convert article in current buffer to Rmail message format."
- (let ((buffer-read-only nil))
- ;; Convert article directly into Babyl format.
- (goto-char (point-min))
- (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
- (while (search-forward "\n\^_" nil t) ;single char
- (replace-match "\n^_" t t)) ;2 chars: "^" and "_"
- (goto-char (point-max))
- (insert "\^_")))
-
-(defun gnus-map-function (funs arg)
- "Apply the result of the first function in FUNS to the second, and so on.
-ARG is passed to the first function."
- (while funs
- (setq arg (funcall (pop funs) arg)))
- arg)
-
-(defun gnus-run-hooks (&rest funcs)
- "Does the same as `run-hooks', but saves the current buffer."
- (save-current-buffer
- (apply 'run-hooks funcs)))
-
-(defun gnus-run-mode-hooks (&rest funcs)
- "Run `run-mode-hooks' if it is available, otherwise `run-hooks'.
-This function saves the current buffer."
- (if (fboundp 'run-mode-hooks)
- (save-current-buffer (apply 'run-mode-hooks funcs))
- (save-current-buffer (apply 'run-hooks funcs))))
-
-;;; Various
-
-(defvar gnus-group-buffer) ; Compiler directive
-(defun gnus-alive-p ()
- "Say whether Gnus is running or not."
- (and (boundp 'gnus-group-buffer)
- (get-buffer gnus-group-buffer)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (eq major-mode 'gnus-group-mode))))
-
-(defun gnus-remove-if (predicate list)
- "Return a copy of LIST with all items satisfying PREDICATE removed."
- (let (out)
- (while list
- (unless (funcall predicate (car list))
- (push (car list) out))
- (setq list (cdr list)))
- (nreverse out)))
-
-(if (fboundp 'assq-delete-all)
- (defalias 'gnus-delete-alist 'assq-delete-all)
- (defun gnus-delete-alist (key alist)
- "Delete from ALIST all elements whose car is KEY.
-Return the modified alist."
- (let (entry)
- (while (setq entry (assq key alist))
- (setq alist (delq entry alist)))
- alist)))
-
-(defmacro gnus-pull (key alist &optional assoc-p)
- "Modify ALIST to be without KEY."
- (unless (symbolp alist)
- (error "Not a symbol: %s" alist))
- (let ((fun (if assoc-p 'assoc 'assq)))
- `(setq ,alist (delq (,fun ,key ,alist) ,alist))))
-
-(defun gnus-globalify-regexp (re)
- "Return a regexp that matches a whole line, if RE matches a part of it."
- (concat (unless (string-match "^\\^" re) "^.*")
- re
- (unless (string-match "\\$$" re) ".*$")))
-
-(defun gnus-set-window-start (&optional point)
- "Set the window start to POINT, or (point) if nil."
- (let ((win (gnus-get-buffer-window (current-buffer) t)))
- (when win
- (set-window-start win (or point (point))))))
-
-(defun gnus-annotation-in-region-p (b e)
- (if (= b e)
- (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
- (text-property-any b e 'gnus-undeletable t)))
-
-(defun gnus-or (&rest elems)
- "Return non-nil if any of the elements are non-nil."
- (catch 'found
- (while elems
- (when (pop elems)
- (throw 'found t)))))
-
-(defun gnus-and (&rest elems)
- "Return non-nil if all of the elements are non-nil."
- (catch 'found
- (while elems
- (unless (pop elems)
- (throw 'found nil)))
- t))
-
-(defun gnus-write-active-file (file hashtb &optional full-names)
- (let ((coding-system-for-write nnmail-active-file-coding-system))
- (with-temp-file file
- (mapatoms
- (lambda (sym)
- (when (and sym
- (boundp sym)
- (symbol-value sym))
- (insert (format "%S %d %d y\n"
- (if full-names
- sym
- (intern (gnus-group-real-name (symbol-name sym))))
- (or (cdr (symbol-value sym))
- (car (symbol-value sym)))
- (car (symbol-value sym))))))
- hashtb)
- (goto-char (point-max))
- (while (search-backward "\\." nil t)
- (delete-char 1)))))
-
-;; Fixme: Why not use `with-output-to-temp-buffer'?
-(defmacro gnus-with-output-to-file (file &rest body)
- (let ((buffer (make-symbol "output-buffer"))
- (size (make-symbol "output-buffer-size"))
- (leng (make-symbol "output-buffer-length"))
- (append (make-symbol "output-buffer-append")))
- `(let* ((,size 131072)
- (,buffer (make-string ,size 0))
- (,leng 0)
- (,append nil)
- (standard-output
- (lambda (c)
- (aset ,buffer ,leng c)
-
- (if (= ,size (setq ,leng (1+ ,leng)))
- (progn (write-region ,buffer nil ,file ,append 'no-msg)
- (setq ,leng 0
- ,append t))))))
- ,@body
- (when (> ,leng 0)
- (let ((coding-system-for-write 'no-conversion))
- (write-region (substring ,buffer 0 ,leng) nil ,file
- ,append 'no-msg))))))
-
-(put 'gnus-with-output-to-file 'lisp-indent-function 1)
-(put 'gnus-with-output-to-file 'edebug-form-spec '(form body))
-
-(if (fboundp 'union)
- (defalias 'gnus-union 'union)
- (defun gnus-union (l1 l2)
- "Set union of lists L1 and L2."
- (cond ((null l1) l2)
- ((null l2) l1)
- ((equal l1 l2) l1)
- (t
- (or (>= (length l1) (length l2))
- (setq l1 (prog1 l2 (setq l2 l1))))
- (while l2
- (or (member (car l2) l1)
- (push (car l2) l1))
- (pop l2))
- l1))))
-
-(defun gnus-add-text-properties-when
- (property value start end properties &optional object)
- "Like `gnus-add-text-properties', only applied on where PROPERTY is VALUE."
- (let (point)
- (while (and start
- (< start end) ;; XEmacs will loop for every when start=end.
- (setq point (text-property-not-all start end property value)))
- (gnus-add-text-properties start point properties object)
- (setq start (text-property-any point end property value)))
- (if start
- (gnus-add-text-properties start end properties object))))
-
-(defun gnus-remove-text-properties-when
- (property value start end properties &optional object)
- "Like `remove-text-properties', only applied on where PROPERTY is VALUE."
- (let (point)
- (while (and start
- (< start end)
- (setq point (text-property-not-all start end property value)))
- (remove-text-properties start point properties object)
- (setq start (text-property-any point end property value)))
- (if start
- (remove-text-properties start end properties object))
- t))
-
-;; This might use `compare-strings' to reduce consing in the
-;; case-insensitive case, but it has to cope with null args.
-;; (`string-equal' uses symbol print names.)
-(defun gnus-string-equal (x y)
- "Like `string-equal', except it compares case-insensitively."
- (and (= (length x) (length y))
- (or (string-equal x y)
- (string-equal (downcase x) (downcase y)))))
-
-(defcustom gnus-use-byte-compile t
- "If non-nil, byte-compile crucial run-time code.
-Setting it to nil has no effect after the first time `gnus-byte-compile'
-is run."
- :type 'boolean
- :version "22.1"
- :group 'gnus-various)
-
-(defun gnus-byte-compile (form)
- "Byte-compile FORM if `gnus-use-byte-compile' is non-nil."
- (if gnus-use-byte-compile
- (progn
- (condition-case nil
- ;; Work around a bug in XEmacs 21.4
- (require 'byte-optimize)
- (error))
- (require 'bytecomp)
- (defalias 'gnus-byte-compile
- (lambda (form)
- (let ((byte-compile-warnings '(unresolved callargs redefine)))
- (byte-compile form))))
- (gnus-byte-compile form))
- form))
-
-(defun gnus-remassoc (key alist)
- "Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned. If the first member
-of LIST has a car that is `equal' to KEY, there is no way to remove it
-by side effect; therefore, write `(setq foo (gnus-remassoc key foo))' to be
-sure of changing the value of `foo'."
- (when alist
- (if (equal key (caar alist))
- (cdr alist)
- (setcdr alist (gnus-remassoc key (cdr alist)))
- alist)))
-
-(defun gnus-update-alist-soft (key value alist)
- (if value
- (cons (cons key value) (gnus-remassoc key alist))
- (gnus-remassoc key alist)))
-
-(defun gnus-create-info-command (node)
- "Create a command that will go to info NODE."
- `(lambda ()
- (interactive)
- ,(concat "Enter the info system at node " node)
- (Info-goto-node ,node)
- (setq gnus-info-buffer (current-buffer))
- (gnus-configure-windows 'info)))
-
-(defun gnus-not-ignore (&rest args)
- t)
-
-(defvar gnus-directory-sep-char-regexp "/"
- "The regexp of directory separator character.
-If you find some problem with the directory separator character, try
-\"[/\\\\\]\" for some systems.")
-
-(defun gnus-url-unhex (x)
- (if (> x ?9)
- (if (>= x ?a)
- (+ 10 (- x ?a))
- (+ 10 (- x ?A)))
- (- x ?0)))
-
-;; Fixme: Do it like QP.
-(defun gnus-url-unhex-string (str &optional allow-newlines)
- "Remove %XX, embedded spaces, etc in a url.
-If optional second argument ALLOW-NEWLINES is non-nil, then allow the
-decoding of carriage returns and line feeds in the string, which is normally
-forbidden in URL encoding."
- (let ((tmp "")
- (case-fold-search t))
- (while (string-match "%[0-9a-f][0-9a-f]" str)
- (let* ((start (match-beginning 0))
- (ch1 (gnus-url-unhex (elt str (+ start 1))))
- (code (+ (* 16 ch1)
- (gnus-url-unhex (elt str (+ start 2))))))
- (setq tmp (concat
- tmp (substring str 0 start)
- (cond
- (allow-newlines
- (char-to-string code))
- ((or (= code ?\n) (= code ?\r))
- " ")
- (t (char-to-string code))))
- str (substring str (match-end 0)))))
- (setq tmp (concat tmp str))
- tmp))
-
-(defun gnus-make-predicate (spec)
- "Transform SPEC into a function that can be called.
-SPEC is a predicate specifier that contains stuff like `or', `and',
-`not', lists and functions. The functions all take one parameter."
- `(lambda (elem) ,(gnus-make-predicate-1 spec)))
-
-(defun gnus-make-predicate-1 (spec)
- (cond
- ((symbolp spec)
- `(,spec elem))
- ((listp spec)
- (if (memq (car spec) '(or and not))
- `(,(car spec) ,@(mapcar 'gnus-make-predicate-1 (cdr spec)))
- (error "Invalid predicate specifier: %s" spec)))))
-
-(defun gnus-local-map-property (map)
- "Return a list suitable for a text property list specifying keymap MAP."
- (cond
- ((featurep 'xemacs)
- (list 'keymap map))
- ((>= emacs-major-version 21)
- (list 'keymap map))
- (t
- (list 'local-map map))))
-
-(defmacro gnus-completing-read-maybe-default (prompt table &optional predicate
- require-match initial-contents
- history default)
- "Like `completing-read', allowing for non-existent 7th arg in older XEmacsen."
- `(completing-read ,prompt ,table ,predicate ,require-match
- ,initial-contents ,history
- ,@(if (and (featurep 'xemacs) (< emacs-minor-version 2))
- ()
- (list default))))
-
-(defun gnus-completing-read (prompt table &optional predicate require-match
- history)
- (when (and history
- (not (boundp history)))
- (set history nil))
- (gnus-completing-read-maybe-default
- (if (symbol-value history)
- (concat prompt " (" (car (symbol-value history)) "): ")
- (concat prompt ": "))
- table
- predicate
- require-match
- nil
- history
- (car (symbol-value history))))
-
-(defun gnus-graphic-display-p ()
- (or (and (fboundp 'display-graphic-p)
- (display-graphic-p))
- ;;;!!!This is bogus. Fixme!
- (and (featurep 'xemacs)
- t)))
-
-(put 'gnus-parse-without-error 'lisp-indent-function 0)
-(put 'gnus-parse-without-error 'edebug-form-spec '(body))
-
-(defmacro gnus-parse-without-error (&rest body)
- "Allow continuing onto the next line even if an error occurs."
- `(while (not (eobp))
- (condition-case ()
- (progn
- ,@body
- (goto-char (point-max)))
- (error
- (gnus-error 4 "Invalid data on line %d"
- (count-lines (point-min) (point)))
- (forward-line 1)))))
-
-(defun gnus-cache-file-contents (file variable function)
- "Cache the contents of FILE in VARIABLE. The contents come from FUNCTION."
- (let ((time (nth 5 (file-attributes file)))
- contents value)
- (if (or (null (setq value (symbol-value variable)))
- (not (equal (car value) file))
- (not (equal (nth 1 value) time)))
- (progn
- (setq contents (funcall function file))
- (set variable (list file time contents))
- contents)
- (nth 2 value))))
-
-(defun gnus-multiple-choice (prompt choice &optional idx)
- "Ask user a multiple choice question.
-CHOICE is a list of the choice char and help message at IDX."
- (let (tchar buf)
- (save-window-excursion
- (save-excursion
- (while (not tchar)
- (message "%s (%s): "
- prompt
- (concat
- (mapconcat (lambda (s) (char-to-string (car s)))
- choice ", ") ", ?"))
- (setq tchar (read-char))
- (when (not (assq tchar choice))
- (setq tchar nil)
- (setq buf (get-buffer-create "*Gnus Help*"))
- (pop-to-buffer buf)
- (fundamental-mode) ; for Emacs 20.4+
- (buffer-disable-undo)
- (erase-buffer)
- (insert prompt ":\n\n")
- (let ((max -1)
- (list choice)
- (alist choice)
- (idx (or idx 1))
- (i 0)
- n width pad format)
- ;; find the longest string to display
- (while list
- (setq n (length (nth idx (car list))))
- (unless (> max n)
- (setq max n))
- (setq list (cdr list)))
- (setq max (+ max 4)) ; %c, `:', SPACE, a SPACE at end
- (setq n (/ (1- (window-width)) max)) ; items per line
- (setq width (/ (1- (window-width)) n)) ; width of each item
- ;; insert `n' items, each in a field of width `width'
- (while alist
- (if (< i n)
- ()
- (setq i 0)
- (delete-char -1) ; the `\n' takes a char
- (insert "\n"))
- (setq pad (- width 3))
- (setq format (concat "%c: %-" (int-to-string pad) "s"))
- (insert (format format (caar alist) (nth idx (car alist))))
- (setq alist (cdr alist))
- (setq i (1+ i))))))))
- (if (buffer-live-p buf)
- (kill-buffer buf))
- tchar))
-
-(defun gnus-select-frame-set-input-focus (frame)
- "Select FRAME, raise it, and set input focus, if possible."
- (cond ((featurep 'xemacs)
- (if (fboundp 'select-frame-set-input-focus)
- (select-frame-set-input-focus frame)
- (raise-frame frame)
- (select-frame frame)
- (focus-frame frame)))
- ;; `select-frame-set-input-focus' defined in Emacs 21 will not
- ;; set the input focus.
- ((>= emacs-major-version 22)
- (select-frame-set-input-focus frame))
- (t
- (raise-frame frame)
- (select-frame frame)
- (cond ((memq window-system '(x mac))
- (x-focus-frame frame))
- ((eq window-system 'w32)
- (w32-focus-frame frame)))
- (when focus-follows-mouse
- (set-mouse-position frame (1- (frame-width frame)) 0)))))
-
-(defun gnus-frame-or-window-display-name (object)
- "Given a frame or window, return the associated display name.
-Return nil otherwise."
- (if (featurep 'xemacs)
- (device-connection (dfw-device object))
- (if (or (framep object)
- (and (windowp object)
- (setq object (window-frame object))))
- (let ((display (frame-parameter object 'display)))
- (if (and (stringp display)
- ;; Exclude invalid display names.
- (string-match "\\`[^:]*:[0-9]+\\(\\.[0-9]+\\)?\\'"
- display))
- display)))))
-
-(eval-when-compile
- (defvar tool-bar-mode))
-
-(defun gnus-tool-bar-update (&rest ignore)
- "Update the tool bar."
- (when (and (boundp 'tool-bar-mode)
- tool-bar-mode)
- (let* ((args nil)
- (func (cond ((featurep 'xemacs)
- 'ignore)
- ((fboundp 'tool-bar-update)
- 'tool-bar-update)
- ((fboundp 'force-window-update)
- 'force-window-update)
- ((fboundp 'redraw-frame)
- (setq args (list (selected-frame)))
- 'redraw-frame)
- (t 'ignore))))
- (apply func args))))
-
-;; Fixme: This has only one use (in gnus-agent), which isn't worthwhile.
-(defmacro gnus-mapcar (function seq1 &rest seqs2_n)
- "Apply FUNCTION to each element of the sequences, and make a list of the results.
-If there are several sequences, FUNCTION is called with that many arguments,
-and mapping stops as soon as the shortest sequence runs out. With just one
-sequence, this is like `mapcar'. With several, it is like the Common Lisp
-`mapcar' function extended to arbitrary sequence types."
-
- (if seqs2_n
- (let* ((seqs (cons seq1 seqs2_n))
- (cnt 0)
- (heads (mapcar (lambda (seq)
- (make-symbol (concat "head"
- (int-to-string
- (setq cnt (1+ cnt))))))
- seqs))
- (result (make-symbol "result"))
- (result-tail (make-symbol "result-tail")))
- `(let* ,(let* ((bindings (cons nil nil))
- (heads heads))
- (nconc bindings (list (list result '(cons nil nil))))
- (nconc bindings (list (list result-tail result)))
- (while heads
- (nconc bindings (list (list (pop heads) (pop seqs)))))
- (cdr bindings))
- (while (and ,@heads)
- (setcdr ,result-tail (cons (funcall ,function
- ,@(mapcar (lambda (h) (list 'car h))
- heads))
- nil))
- (setq ,result-tail (cdr ,result-tail)
- ,@(apply 'nconc (mapcar (lambda (h) (list h (list 'cdr h))) heads))))
- (cdr ,result)))
- `(mapcar ,function ,seq1)))
-
-(if (fboundp 'merge)
- (defalias 'gnus-merge 'merge)
- ;; Adapted from cl-seq.el
- (defun gnus-merge (type list1 list2 pred)
- "Destructively merge lists LIST1 and LIST2 to produce a new list.
-Argument TYPE is for compatibility and ignored.
-Ordering of the elements is preserved according to PRED, a `less-than'
-predicate on the elements."
- (let ((res nil))
- (while (and list1 list2)
- (if (funcall pred (car list2) (car list1))
- (push (pop list2) res)
- (push (pop list1) res)))
- (nconc (nreverse res) list1 list2))))
-
-(eval-when-compile
- (defvar xemacs-codename)
- (defvar sxemacs-codename)
- (defvar emacs-program-version))
-
-(defun gnus-emacs-version ()
- "Stringified Emacs version."
- (let* ((lst (if (listp gnus-user-agent)
- gnus-user-agent
- '(gnus emacs type)))
- (system-v (cond ((memq 'config lst)
- system-configuration)
- ((memq 'type lst)
- (symbol-name system-type))
- (t nil)))
- codename emacsname)
- (cond ((featurep 'sxemacs)
- (setq emacsname "SXEmacs"
- codename sxemacs-codename))
- ((featurep 'xemacs)
- (setq emacsname "XEmacs"
- codename xemacs-codename))
- (t
- (setq emacsname "Emacs")))
- (cond
- ((not (memq 'emacs lst))
- nil)
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- ;; Emacs:
- (concat "Emacs/" (match-string 1 emacs-version)
- (if system-v
- (concat " (" system-v ")")
- "")))
- ((or (featurep 'sxemacs) (featurep 'xemacs))
- ;; XEmacs or SXEmacs:
- (concat emacsname "/" emacs-program-version
- " ("
- (when (and (memq 'codename lst)
- codename)
- (concat codename
- (when system-v ", ")))
- (when system-v system-v)
- ")"))
- (t emacs-version))))
-
-(defun gnus-rename-file (old-path new-path &optional trim)
- "Rename OLD-PATH as NEW-PATH. If TRIM, recursively delete
-empty directories from OLD-PATH."
- (when (file-exists-p old-path)
- (let* ((old-dir (file-name-directory old-path))
- (old-name (file-name-nondirectory old-path))
- (new-dir (file-name-directory new-path))
- (new-name (file-name-nondirectory new-path))
- temp)
- (gnus-make-directory new-dir)
- (rename-file old-path new-path t)
- (when trim
- (while (progn (setq temp (directory-files old-dir))
- (while (member (car temp) '("." ".."))
- (setq temp (cdr temp)))
- (= (length temp) 0))
- (delete-directory old-dir)
- (setq old-dir (file-name-as-directory
- (file-truename
- (concat old-dir "..")))))))))
-
-(if (fboundp 'set-process-query-on-exit-flag)
- (defalias 'gnus-set-process-query-on-exit-flag
- 'set-process-query-on-exit-flag)
- (defalias 'gnus-set-process-query-on-exit-flag
- 'process-kill-without-query))
-
-(if (fboundp 'with-local-quit)
- (defalias 'gnus-with-local-quit 'with-local-quit)
- (defmacro gnus-with-local-quit (&rest body)
- "Execute BODY, allowing quits to terminate BODY but not escape further.
-When a quit terminates BODY, `gnus-with-local-quit' returns nil but
-requests another quit. That quit will be processed as soon as quitting
-is allowed once again. (Immediately, if `inhibit-quit' is nil.)"
- ;;(declare (debug t) (indent 0))
- `(condition-case nil
- (let ((inhibit-quit nil))
- ,@body)
- (quit (setq quit-flag t)
- ;; This call is to give a chance to handle quit-flag
- ;; in case inhibit-quit is nil.
- ;; Without this, it will not be handled until the next function
- ;; call, and that might allow it to exit thru a condition-case
- ;; that intends to handle the quit signal next time.
- (eval '(ignore nil))))))
-
-(provide 'gnus-util)
-
-;;; arch-tag: f94991af-d32b-4c97-8c26-ca12a934de49
-;;; gnus-util.el ends here
+++ /dev/null
-;;; gnus-uu.el --- extract (uu)encoded files in Gnus
-
-;; Copyright (C) 1985, 1986, 1987, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Created: 2 Oct 1993
-;; Keyword: 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-art)
-(require 'message)
-(require 'gnus-msg)
-(require 'mm-decode)
-
-(defgroup gnus-extract nil
- "Extracting encoded files."
- :prefix "gnus-uu-"
- :group 'gnus)
-
-(defgroup gnus-extract-view nil
- "Viewwing extracted files."
- :group 'gnus-extract)
-
-(defgroup gnus-extract-archive nil
- "Extracting encoded archives."
- :group 'gnus-extract)
-
-(defgroup gnus-extract-post nil
- "Extracting encoded archives."
- :prefix "gnus-uu-post"
- :group 'gnus-extract)
-
-;; Default viewing action rules
-
-(defcustom gnus-uu-default-view-rules
- '(("\\.te?xt$\\|\\.doc$\\|read.*me\\|\\.c?$\\|\\.h$\\|\\.bat$\\|\\.asm$\\|makefile" "cat %s | sed 's/\r$//'")
- ("\\.pas$" "cat %s | sed 's/\r$//'")
- ("\\.[1-9]$" "groff -mandoc -Tascii %s | sed s/\b.//g")
- ("\\.\\(jpe?g\\|gif\\|tiff?\\|p[pgb]m\\|xwd\\|xbm\\|pcx\\)$" "display")
- ("\\.tga$" "tgatoppm %s | ee -")
- ("\\.\\(wav\\|aiff\\|hcom\\|u[blw]\\|s[bfw]\\|voc\\|smp\\)$"
- "sox -v .5 %s -t .au -u - > /dev/audio")
- ("\\.au$" "cat %s > /dev/audio")
- ("\\.midi?$" "playmidi -f")
- ("\\.mod$" "str32")
- ("\\.ps$" "ghostview")
- ("\\.dvi$" "xdvi")
- ("\\.html$" "xmosaic")
- ("\\.mpe?g$" "mpeg_play")
- ("\\.\\(flc\\|fli\\|rle\\|iff\\|pfx\\|avi\\|sme\\|rpza\\|dl\\|qt\\|rsrc\\|mov\\)$" "xanim")
- ("\\.\\(tar\\|arj\\|zip\\|zoo\\|arc\\|gz\\|Z\\|lzh\\|ar\\|lha\\)$"
- "gnus-uu-archive"))
- "*Default actions to be taken when the user asks to view a file.
-To change the behavior, you can either edit this variable or set
-`gnus-uu-user-view-rules' to something useful.
-
-For example:
-
-To make gnus-uu use 'xli' to display JPEG and GIF files, put the
-following in your .emacs file:
-
- (setq gnus-uu-user-view-rules '((\"jpg$\\\\|gif$\" \"xli\")))
-
-Both these variables are lists of lists with two string elements. The
-first string is a regular expression. If the file name matches this
-regular expression, the command in the second string is executed with
-the file as an argument.
-
-If the command string contains \"%s\", the file name will be inserted
-at that point in the command string. If there's no \"%s\" in the
-command string, the file name will be appended to the command string
-before executing.
-
-There are several user variables to tailor the behavior of gnus-uu to
-your needs. First we have `gnus-uu-user-view-rules', which is the
-variable gnus-uu first consults when trying to decide how to view a
-file. If this variable contains no matches, gnus-uu examines the
-default rule variable provided in this package. If gnus-uu finds no
-match here, it uses `gnus-uu-user-view-rules-end' to try to make a
-match."
- :group 'gnus-extract-view
- :type '(repeat (group regexp (string :tag "Command"))))
-
-(defcustom gnus-uu-user-view-rules nil
- "What actions are to be taken to view a file.
-See the documentation on the `gnus-uu-default-view-rules' variable for
-details."
- :group 'gnus-extract-view
- :type '(repeat (group regexp (string :tag "Command"))))
-
-(defcustom gnus-uu-user-view-rules-end
- '(("" "file"))
- "*What actions are to be taken if no rule matched the file name.
-See the documentation on the `gnus-uu-default-view-rules' variable for
-details."
- :group 'gnus-extract-view
- :type '(repeat (group regexp (string :tag "Command"))))
-
-;; Default unpacking commands
-
-(defcustom gnus-uu-default-archive-rules
- '(("\\.tar$" "tar xf")
- ("\\.zip$" "unzip -o")
- ("\\.ar$" "ar x")
- ("\\.arj$" "unarj x")
- ("\\.zoo$" "zoo -e")
- ("\\.\\(lzh\\|lha\\)$" "lha x")
- ("\\.Z$" "uncompress")
- ("\\.gz$" "gunzip")
- ("\\.arc$" "arc -x"))
- "*See `gnus-uu-user-archive-rules'."
- :group 'gnus-extract-archive
- :type '(repeat (group regexp (string :tag "Command"))))
-
-(defvar gnus-uu-destructive-archivers
- (list "uncompress" "gunzip"))
-
-(defcustom gnus-uu-user-archive-rules nil
- "A list that can be set to override the default archive unpacking commands.
-To use, for instance, 'untar' to unpack tar files and 'zip -x' to
-unpack zip files, say the following:
- (setq gnus-uu-user-archive-rules
- '((\"\\\\.tar$\" \"untar\")
- (\"\\\\.zip$\" \"zip -x\")))"
- :group 'gnus-extract-archive
- :type '(repeat (group regexp (string :tag "Command"))))
-
-(defcustom gnus-uu-ignore-files-by-name nil
- "*A regular expression saying what files should not be viewed based on name.
-If, for instance, you want gnus-uu to ignore all .au and .wav files,
-you could say something like
-
- (setq gnus-uu-ignore-files-by-name \"\\\\.au$\\\\|\\\\.wav$\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-type' variable."
- :group 'gnus-extract
- :type '(choice (const :tag "off" nil)
- (regexp :format "%v")))
-
-(defcustom gnus-uu-ignore-files-by-type nil
- "*A regular expression saying what files that shouldn't be viewed, based on MIME file type.
-If, for instance, you want gnus-uu to ignore all audio files and all mpegs,
-you could say something like
-
- (setq gnus-uu-ignore-files-by-type \"audio/\\\\|video/mpeg\")
-
-Note that this variable can be used in conjunction with the
-`gnus-uu-ignore-files-by-name' variable."
- :group 'gnus-extract
- :type '(choice (const :tag "off" nil)
- (regexp :format "%v")))
-
-;; Pseudo-MIME support
-
-(defconst gnus-uu-ext-to-mime-list
- '(("\\.gif$" "image/gif")
- ("\\.jpe?g$" "image/jpeg")
- ("\\.tiff?$" "image/tiff")
- ("\\.xwd$" "image/xwd")
- ("\\.pbm$" "image/pbm")
- ("\\.pgm$" "image/pgm")
- ("\\.ppm$" "image/ppm")
- ("\\.xbm$" "image/xbm")
- ("\\.pcx$" "image/pcx")
- ("\\.tga$" "image/tga")
- ("\\.ps$" "image/postscript")
- ("\\.fli$" "video/fli")
- ("\\.wav$" "audio/wav")
- ("\\.aiff$" "audio/aiff")
- ("\\.hcom$" "audio/hcom")
- ("\\.voc$" "audio/voc")
- ("\\.smp$" "audio/smp")
- ("\\.mod$" "audio/mod")
- ("\\.dvi$" "image/dvi")
- ("\\.mpe?g$" "video/mpeg")
- ("\\.au$" "audio/basic")
- ("\\.\\(te?xt\\|doc\\|c\\|h\\)$" "text/plain")
- ("\\.\\(c\\|h\\)$" "text/source")
- ("read.*me" "text/plain")
- ("\\.html$" "text/html")
- ("\\.bat$" "text/bat")
- ("\\.[1-6]$" "text/man")
- ("\\.flc$" "video/flc")
- ("\\.rle$" "video/rle")
- ("\\.pfx$" "video/pfx")
- ("\\.avi$" "video/avi")
- ("\\.sme$" "video/sme")
- ("\\.rpza$" "video/prza")
- ("\\.dl$" "video/dl")
- ("\\.qt$" "video/qt")
- ("\\.rsrc$" "video/rsrc")
- ("\\..*$" "unknown/unknown")))
-
-;; Various variables users may set
-
-(defcustom gnus-uu-tmp-dir
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/"))
- "*Variable saying where gnus-uu is to do its work.
-Default is \"/tmp/\"."
- :group 'gnus-extract
- :type 'directory)
-
-(defcustom gnus-uu-do-not-unpack-archives nil
- "*Non-nil means that gnus-uu won't peek inside archives looking for files to display.
-Default is nil."
- :group 'gnus-extract-archive
- :type 'boolean)
-
-(defcustom gnus-uu-ignore-default-view-rules nil
- "*Non-nil means that gnus-uu will ignore the default viewing rules.
-Only the user viewing rules will be consulted. Default is nil."
- :group 'gnus-extract-view
- :type 'boolean)
-
-(defcustom gnus-uu-grabbed-file-functions nil
- "Functions run on each file after successful decoding.
-They will be called with the name of the file as the argument.
-Likely functions you can use in this list are `gnus-uu-grab-view'
-and `gnus-uu-grab-move'."
- :group 'gnus-extract
- :options '(gnus-uu-grab-view gnus-uu-grab-move)
- :type 'hook)
-
-(defcustom gnus-uu-ignore-default-archive-rules nil
- "*Non-nil means that gnus-uu will ignore the default archive unpacking commands.
-Only the user unpacking commands will be consulted. Default is nil."
- :group 'gnus-extract-archive
- :type 'boolean)
-
-(defcustom gnus-uu-kill-carriage-return t
- "*Non-nil means that gnus-uu will strip all carriage returns from articles.
-Default is t."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-view-with-metamail nil
- "*Non-nil means that files will be viewed with metamail.
-The gnus-uu viewing functions will be ignored and gnus-uu will try
-to guess at a content-type based on file name suffixes. Default
-it nil."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-unmark-articles-not-decoded nil
- "*Non-nil means that gnus-uu will mark articles that were unsuccessfully decoded as unread.
-Default is nil."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-correct-stripped-uucode nil
- "*Non-nil means that gnus-uu will *try* to fix uuencoded files that have had trailing spaces deleted.
-Default is nil."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-save-in-digest nil
- "*Non-nil means that gnus-uu, when asked to save without decoding, will save in digests.
-If this variable is nil, gnus-uu will just save everything in a
-file without any embellishments. The digesting almost conforms to RFC1153 -
-no easy way to specify any meaningful volume and issue numbers were found,
-so I simply dropped them."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-pre-uudecode-hook nil
- "Hook run before sending a message to uudecode."
- :group 'gnus-extract
- :type 'hook)
-
-(defcustom gnus-uu-digest-headers
- '("^Date:" "^From:" "^To:" "^Cc:" "^Subject:" "^Message-ID:" "^Keywords:"
- "^Summary:" "^References:" "^Content-Type:" "^Content-Transfer-Encoding:"
- "^MIME-Version:" "^Content-Disposition:" "^Content-Description:"
- "^Content-ID:")
- "*List of regexps to match headers included in digested messages.
-The headers will be included in the sequence they are matched. If nil
-include all headers."
- :group 'gnus-extract
- :type '(repeat regexp))
-
-(defcustom gnus-uu-save-separate-articles nil
- "*Non-nil means that gnus-uu will save articles in separate files."
- :group 'gnus-extract
- :type 'boolean)
-
-(defcustom gnus-uu-be-dangerous 'ask
- "*Specifies what to do if unusual situations arise during decoding.
-If nil, be as conservative as possible. If t, ignore things that
-didn't work, and overwrite existing files. Otherwise, ask each time."
- :group 'gnus-extract
- :type '(choice (const :tag "conservative" nil)
- (const :tag "ask" ask)
- (const :tag "liberal" t)))
-
-;; Internal variables
-
-(defvar gnus-uu-saved-article-name nil)
-
-(defvar gnus-uu-begin-string "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defvar gnus-uu-end-string "^end[ \t]*$")
-
-(defvar gnus-uu-body-line "^M")
-(let ((i 61))
- (while (> (setq i (1- i)) 0)
- (setq gnus-uu-body-line (concat gnus-uu-body-line "[^a-z]")))
- (setq gnus-uu-body-line (concat gnus-uu-body-line ".?$")))
-
-;"^M.............................................................?$"
-
-(defvar gnus-uu-shar-begin-string "^#! */bin/sh")
-
-(defvar gnus-uu-shar-file-name nil)
-(defvar gnus-uu-shar-name-marker
- "begin 0?[0-7][0-7][0-7][ \t]+\\(\\(\\w\\|[.\\:]\\)*\\b\\)")
-
-(defvar gnus-uu-postscript-begin-string "^%!PS-")
-(defvar gnus-uu-postscript-end-string "^%%EOF$")
-
-(defvar gnus-uu-file-name nil)
-(defvar gnus-uu-uudecode-process nil)
-(defvar gnus-uu-binhex-article-name nil)
-
-(defvar gnus-uu-work-dir nil)
-
-(defvar gnus-uu-output-buffer-name " *Gnus UU Output*")
-
-(defvar gnus-uu-default-dir gnus-article-save-directory)
-(defvar gnus-uu-digest-from-subject nil)
-(defvar gnus-uu-digest-buffer nil)
-
-;; Commands.
-
-(defun gnus-uu-decode-uu (&optional n)
- "Uudecodes the current article."
- (interactive "P")
- (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n))
-
-(defun gnus-uu-decode-uu-and-save (n dir)
- "Decodes and saves the resulting file."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-file-name "Uudecode and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-uustrip-article n dir nil nil t))
-
-(defun gnus-uu-decode-unshar (&optional n)
- "Unshars the current article."
- (interactive "P")
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n nil nil 'scan t))
-
-(defun gnus-uu-decode-unshar-and-save (n dir)
- "Unshars and saves the current article."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-file-name "Unshar and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-unshar-article n dir nil 'scan t))
-
-(defun gnus-uu-decode-save (n file)
- "Saves the current article."
- (interactive
- (list current-prefix-arg
- (read-file-name
- (if gnus-uu-save-separate-articles
- "Save articles in dir: "
- "Save articles in file: ")
- gnus-uu-default-dir
- gnus-uu-default-dir)))
- (setq gnus-uu-saved-article-name file)
- (gnus-uu-decode-with-method 'gnus-uu-save-article n nil t))
-
-(defun gnus-uu-decode-binhex (n dir)
- "Unbinhexes the current article."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-file-name "Unbinhex and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir))))
- (setq gnus-uu-binhex-article-name
- (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
- (gnus-uu-decode-with-method 'gnus-uu-binhex-article n dir))
-
-(defun gnus-uu-decode-uu-view (&optional n)
- "Uudecodes and views the current article."
- (interactive "P")
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-uu n)))
-
-(defun gnus-uu-decode-uu-and-save-view (n dir)
- "Decodes, views and saves the resulting file."
- (interactive
- (list current-prefix-arg
- (read-file-name "Uudecode, view and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-uu-and-save n dir)))
-
-(defun gnus-uu-decode-unshar-view (&optional n)
- "Unshars and views the current article."
- (interactive "P")
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-unshar n)))
-
-(defun gnus-uu-decode-unshar-and-save-view (n dir)
- "Unshars and saves the current article."
- (interactive
- (list current-prefix-arg
- (read-file-name "Unshar, view and save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-unshar-and-save n dir)))
-
-(defun gnus-uu-decode-save-view (n file)
- "Saves and views the current article."
- (interactive
- (list current-prefix-arg
- (read-file-name (if gnus-uu-save-separate-articles
- "Save articles is dir: "
- "Save articles in file: ")
- gnus-uu-default-dir gnus-uu-default-dir)))
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-save n file)))
-
-(defun gnus-uu-decode-binhex-view (n file)
- "Unbinhexes and views the current article."
- (interactive
- (list current-prefix-arg
- (read-file-name "Unbinhex, view and save in dir: "
- gnus-uu-default-dir gnus-uu-default-dir)))
- (setq gnus-uu-binhex-article-name
- (mm-make-temp-file (expand-file-name "binhex" gnus-uu-work-dir)))
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-binhex n file)))
-
-
-;; Digest and forward articles
-
-(defun gnus-uu-digest-mail-forward (&optional n post)
- "Digests and forwards all articles in this series."
- (interactive "P")
- (let ((gnus-uu-save-in-digest t)
- (file (mm-make-temp-file (nnheader-concat gnus-uu-tmp-dir "forward")))
- (message-forward-as-mime message-forward-as-mime)
- (mail-parse-charset gnus-newsgroup-charset)
- (mail-parse-ignored-charsets gnus-newsgroup-ignored-charsets)
- gnus-uu-digest-buffer subject from)
- (if (and n (not (numberp n)))
- (setq message-forward-as-mime (not message-forward-as-mime)
- n nil))
- (let ((gnus-article-reply (gnus-summary-work-articles n)))
- (gnus-setup-message 'forward
- (setq gnus-uu-digest-from-subject nil)
- (setq gnus-uu-digest-buffer
- (gnus-get-buffer-create " *gnus-uu-forward*"))
- (gnus-uu-decode-save n file)
- (switch-to-buffer gnus-uu-digest-buffer)
- (let ((fs gnus-uu-digest-from-subject))
- (when fs
- (setq from (caar fs)
- subject (gnus-simplify-subject-fuzzy (cdar fs))
- fs (cdr fs))
- (while (and fs (or from subject))
- (when from
- (unless (string= from (caar fs))
- (setq from nil)))
- (when subject
- (unless (string= (gnus-simplify-subject-fuzzy (cdar fs))
- subject)
- (setq subject nil)))
- (setq fs (cdr fs))))
- (unless subject
- (setq subject "Digested Articles"))
- (unless from
- (setq from
- (if (gnus-news-group-p gnus-newsgroup-name)
- gnus-newsgroup-name
- "Various"))))
- (goto-char (point-min))
- (when (re-search-forward "^Subject: ")
- (delete-region (point) (gnus-point-at-eol))
- (insert subject))
- (goto-char (point-min))
- (when (re-search-forward "^From:")
- (delete-region (point) (gnus-point-at-eol))
- (insert " " from))
- (let ((message-forward-decoded-p t))
- (message-forward post t))))
- (setq gnus-uu-digest-from-subject nil)))
-
-(defun gnus-uu-digest-post-forward (&optional n)
- "Digest and forward to a newsgroup."
- (interactive "P")
- (gnus-uu-digest-mail-forward n t))
-
-;; Process marking.
-
-(defun gnus-message-process-mark (unmarkp new-marked)
- (let ((old (- (length gnus-newsgroup-processable) (length new-marked))))
- (message "%d mark%s %s%s"
- (length new-marked)
- (if (= (length new-marked) 1) "" "s")
- (if unmarkp "removed" "added")
- (cond
- ((and (zerop old)
- (not unmarkp))
- "")
- (unmarkp
- (format ", %d remain marked"
- (length gnus-newsgroup-processable)))
- (t
- (format ", %d already marked" old))))))
-
-(defun gnus-new-processable (unmarkp articles)
- (if unmarkp
- (gnus-intersection gnus-newsgroup-processable articles)
- (gnus-set-difference articles gnus-newsgroup-processable)))
-
-(defun gnus-uu-mark-by-regexp (regexp &optional unmark)
- "Set the process mark on articles whose subjects match REGEXP.
-When called interactively, prompt for REGEXP.
-Optional UNMARK non-nil means unmark instead of mark."
- (interactive "sMark (regexp): \nP")
- (save-excursion
- (let* ((articles (gnus-uu-find-articles-matching regexp))
- (new-marked (gnus-new-processable unmark articles)))
- (while articles
- (if unmark
- (gnus-summary-remove-process-mark (pop articles))
- (gnus-summary-set-process-mark (pop articles))))
- (gnus-message-process-mark unmark new-marked)))
- (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-by-regexp (regexp)
- "Remove the process mark from articles whose subjects match REGEXP.
-When called interactively, prompt for REGEXP."
- (interactive "sUnmark (regexp): ")
- (gnus-uu-mark-by-regexp regexp t))
-
-(defun gnus-uu-mark-series ()
- "Mark the current series with the process mark."
- (interactive)
- (let* ((articles (gnus-uu-find-articles-matching))
- (l (length articles)))
- (while articles
- (gnus-summary-set-process-mark (car articles))
- (setq articles (cdr articles)))
- (message "Marked %d articles" l))
- (gnus-summary-position-point))
-
-(defun gnus-uu-mark-region (beg end &optional unmark)
- "Set the process mark on all articles between point and mark."
- (interactive "r")
- (save-excursion
- (goto-char beg)
- (while (< (point) end)
- (if unmark
- (gnus-summary-remove-process-mark (gnus-summary-article-number))
- (gnus-summary-set-process-mark (gnus-summary-article-number)))
- (forward-line 1)))
- (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-region (beg end)
- "Remove the process mark from all articles between point and mark."
- (interactive "r")
- (gnus-uu-mark-region beg end t))
-
-(defun gnus-uu-mark-buffer ()
- "Set the process mark on all articles in the buffer."
- (interactive)
- (gnus-uu-mark-region (point-min) (point-max)))
-
-(defun gnus-uu-unmark-buffer ()
- "Remove the process mark on all articles in the buffer."
- (interactive)
- (gnus-uu-mark-region (point-min) (point-max) t))
-
-(defun gnus-uu-mark-thread ()
- "Marks all articles downwards in this thread."
- (interactive)
- (gnus-save-hidden-threads
- (let ((level (gnus-summary-thread-level)))
- (while (and (gnus-summary-set-process-mark
- (gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1 nil t))
- (> (gnus-summary-thread-level) level)))))
- (gnus-summary-position-point))
-
-(defun gnus-uu-unmark-thread ()
- "Unmarks all articles downwards in this thread."
- (interactive)
- (let ((level (gnus-summary-thread-level)))
- (while (and (gnus-summary-remove-process-mark
- (gnus-summary-article-number))
- (zerop (gnus-summary-next-subject 1))
- (> (gnus-summary-thread-level) level))))
- (gnus-summary-position-point))
-
-(defun gnus-uu-invert-processable ()
- "Invert the list of process-marked articles."
- (interactive)
- (let ((data gnus-newsgroup-data)
- number)
- (save-excursion
- (while data
- (if (memq (setq number (gnus-data-number (pop data)))
- gnus-newsgroup-processable)
- (gnus-summary-remove-process-mark number)
- (gnus-summary-set-process-mark number)))))
- (gnus-summary-position-point))
-
-(defun gnus-uu-mark-over (&optional score)
- "Mark all articles with a score over SCORE (the prefix)."
- (interactive "P")
- (let ((score (or score gnus-summary-default-score 0))
- (data gnus-newsgroup-data))
- (save-excursion
- (while data
- (when (> (or (cdr (assq (gnus-data-number (car data))
- gnus-newsgroup-scored))
- gnus-summary-default-score 0)
- score)
- (gnus-summary-set-process-mark (caar data)))
- (setq data (cdr data))))
- (gnus-summary-position-point)))
-
-(defun gnus-uu-mark-sparse ()
- "Mark all series that have some articles marked."
- (interactive)
- (let ((marked (nreverse gnus-newsgroup-processable))
- subject articles total headers)
- (unless marked
- (error "No articles marked with the process mark"))
- (setq gnus-newsgroup-processable nil)
- (save-excursion
- (while marked
- (and (vectorp (setq headers
- (gnus-summary-article-header (car marked))))
- (setq subject (mail-header-subject headers)
- articles (gnus-uu-find-articles-matching
- (gnus-uu-reginize-string subject))
- total (nconc total articles)))
- (while articles
- (gnus-summary-set-process-mark (car articles))
- (setcdr marked (delq (car articles) (cdr marked)))
- (setq articles (cdr articles)))
- (setq marked (cdr marked)))
- (setq gnus-newsgroup-processable (nreverse total)))
- (gnus-summary-position-point)))
-
-(defun gnus-uu-mark-all ()
- "Mark all articles in \"series\" order."
- (interactive)
- (setq gnus-newsgroup-processable nil)
- (save-excursion
- (let ((data gnus-newsgroup-data)
- number)
- (while data
- (when (and (not (memq (setq number (gnus-data-number (car data)))
- gnus-newsgroup-processable))
- (vectorp (gnus-data-header (car data))))
- (gnus-summary-goto-subject number)
- (gnus-uu-mark-series))
- (setq data (cdr data)))))
- (gnus-summary-position-point))
-
-;; All PostScript functions written by Erik Selberg <speed@cs.washington.edu>.
-
-(defun gnus-uu-decode-postscript (&optional n)
- "Gets postscript of the current article."
- (interactive "P")
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article n))
-
-(defun gnus-uu-decode-postscript-view (&optional n)
- "Gets and views the current article."
- (interactive "P")
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-postscript n)))
-
-(defun gnus-uu-decode-postscript-and-save (n dir)
- "Extracts postscript and saves the current article."
- (interactive
- (list current-prefix-arg
- (file-name-as-directory
- (read-file-name "Save in dir: "
- gnus-uu-default-dir
- gnus-uu-default-dir t))))
- (gnus-uu-decode-with-method 'gnus-uu-decode-postscript-article
- n dir nil nil t))
-
-(defun gnus-uu-decode-postscript-and-save-view (n dir)
- "Decodes, views and saves the resulting file."
- (interactive
- (list current-prefix-arg
- (read-file-name "Where do you want to save the file(s)? "
- gnus-uu-default-dir
- gnus-uu-default-dir t)))
- (let ((gnus-view-pseudos (or gnus-view-pseudos 'automatic)))
- (gnus-uu-decode-postscript-and-save n dir)))
-
-
-;; Internal functions.
-
-(defun gnus-uu-decode-with-method (method n &optional save not-insert
- scan cdir)
- (gnus-uu-initialize scan)
- (when save
- (setq gnus-uu-default-dir save))
- ;; Create the directory we save to.
- (when (and scan cdir save
- (not (file-exists-p save)))
- (make-directory save t))
- (let ((articles (gnus-uu-get-list-of-articles n))
- files)
- (setq files (gnus-uu-grab-articles articles method t))
- (let ((gnus-current-article (car articles)))
- (when scan
- (setq files (gnus-uu-scan-directory gnus-uu-work-dir))))
- (when save
- (gnus-uu-save-files files save))
- (when (eq gnus-uu-do-not-unpack-archives nil)
- (setq files (gnus-uu-unpack-files files)))
- (setq files (nreverse (gnus-uu-get-actions files)))
- (or not-insert (not gnus-insert-pseudo-articles)
- (gnus-summary-insert-pseudos files save))))
-
-(defun gnus-uu-scan-directory (dir &optional rec)
- "Return a list of all files under DIR."
- (let ((files (directory-files dir t))
- out file)
- (while (setq file (pop files))
- (unless (member (file-name-nondirectory file) '("." ".."))
- (push (list (cons 'name file)
- (cons 'article gnus-current-article))
- out)
- (when (file-directory-p file)
- (setq out (nconc (gnus-uu-scan-directory file t) out)))))
- (if rec
- out
- (nreverse out))))
-
-(defun gnus-uu-save-files (files dir)
- "Save FILES in DIR."
- (let ((len (length files))
- (reg (concat "^" (regexp-quote gnus-uu-work-dir)))
- to-file file fromdir)
- (while (setq file (cdr (assq 'name (pop files))))
- (when (file-exists-p file)
- (string-match reg file)
- (setq fromdir (substring file (match-end 0)))
- (if (file-directory-p file)
- (gnus-make-directory (concat dir fromdir))
- (setq to-file (concat dir fromdir))
- (when (or (not (file-exists-p to-file))
- (eq gnus-uu-be-dangerous t)
- (and gnus-uu-be-dangerous
- (gnus-y-or-n-p (format "%s exists; overwrite? "
- to-file))))
- (copy-file file to-file t t)))))
- (gnus-message 5 "Saved %d file%s" len (if (= len 1) "" "s"))))
-
-;; Functions for saving and possibly digesting articles without
-;; any decoding.
-
-;; Function called by gnus-uu-grab-articles to treat each article.
-(defun gnus-uu-save-article (buffer in-state)
- (cond
- (gnus-uu-save-separate-articles
- (save-excursion
- (set-buffer buffer)
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer
- (concat gnus-uu-saved-article-name gnus-current-article)))
- (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
- ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
- 'begin 'end))
- ((eq in-state 'last) (list 'end))
- (t (list 'middle)))))
- ((not gnus-uu-save-in-digest)
- (save-excursion
- (set-buffer buffer)
- (write-region (point-min) (point-max) gnus-uu-saved-article-name t)
- (cond ((eq in-state 'first) (list gnus-uu-saved-article-name 'begin))
- ((eq in-state 'first-and-last) (list gnus-uu-saved-article-name
- 'begin 'end))
- ((eq in-state 'last) (list 'end))
- (t (list 'middle)))))
- (t
- (let ((header (gnus-summary-article-header)))
- (push (cons (mail-header-from header)
- (mail-header-subject header))
- gnus-uu-digest-from-subject))
- (let ((name (file-name-nondirectory gnus-uu-saved-article-name))
- beg subj headers headline sorthead body end-string state)
- (if (or (eq in-state 'first)
- (eq in-state 'first-and-last))
- (progn
- (setq state (list 'begin))
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*gnus-uu-body*"))
- (erase-buffer))
- (save-excursion
- (set-buffer (gnus-get-buffer-create "*gnus-uu-pre*"))
- (erase-buffer)
- (insert (format
- "Date: %s\nFrom: %s\nSubject: %s Digest\n\n"
- (message-make-date) name name))
- (when (and message-forward-as-mime gnus-uu-digest-buffer)
- (insert
- "<#mml type=message/rfc822>\nSubject: Topics\n\n<#/mml>\n")
- (forward-line -1))
- (insert "Topics:\n")))
- (when (not (eq in-state 'end))
- (setq state (list 'middle))))
- (save-excursion
- (set-buffer "*gnus-uu-body*")
- (goto-char (setq beg (point-max)))
- (save-excursion
- (save-restriction
- (set-buffer buffer)
- (let (buffer-read-only)
- (gnus-set-text-properties (point-min) (point-max) nil)
- ;; These two are necessary for XEmacs 19.12 fascism.
- (put-text-property (point-min) (point-max) 'invisible nil)
- (put-text-property (point-min) (point-max) 'intangible nil))
- (when (and message-forward-as-mime
- message-forward-show-mml
- gnus-uu-digest-buffer)
- (mm-enable-multibyte)
- (mime-to-mml))
- (goto-char (point-min))
- (re-search-forward "\n\n")
- (unless (and message-forward-as-mime gnus-uu-digest-buffer)
- ;; Quote all 30-dash lines.
- (save-excursion
- (while (re-search-forward "^-" nil t)
- (beginning-of-line)
- (delete-char 1)
- (insert "- "))))
- (setq body (buffer-substring (1- (point)) (point-max)))
- (narrow-to-region (point-min) (point))
- (if (not (setq headers gnus-uu-digest-headers))
- (setq sorthead (buffer-string))
- (while headers
- (setq headline (car headers))
- (setq headers (cdr headers))
- (goto-char (point-min))
- (while (re-search-forward headline nil t)
- (setq sorthead
- (concat sorthead
- (buffer-substring
- (match-beginning 0)
- (or (and (re-search-forward "^[^ \t]" nil t)
- (1- (point)))
- (progn (forward-line 1) (point)))))))))
- (widen)))
- (if (and message-forward-as-mime gnus-uu-digest-buffer)
- (if message-forward-show-mml
- (progn
- (insert "\n<#mml type=message/rfc822>\n")
- (insert sorthead) (goto-char (point-max))
- (insert body) (goto-char (point-max))
- (insert "\n<#/mml>\n"))
- (let ((buf (mml-generate-new-buffer " *mml*")))
- (with-current-buffer buf
- (insert sorthead)
- (goto-char (point-min))
- (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (setq subj (buffer-substring (match-beginning 1)
- (match-end 1))))
- (goto-char (point-max))
- (insert body))
- (insert "\n<#part type=message/rfc822"
- " buffer=\"" (buffer-name buf) "\">\n")))
- (insert sorthead) (goto-char (point-max))
- (insert body) (goto-char (point-max))
- (insert (concat "\n" (make-string 30 ?-) "\n\n")))
- (goto-char beg)
- (when (re-search-forward "^Subject: \\(.*\\)$" nil t)
- (setq subj (buffer-substring (match-beginning 1) (match-end 1))))
- (when subj
- (save-excursion
- (set-buffer "*gnus-uu-pre*")
- (insert (format " %s\n" subj)))))
- (when (or (eq in-state 'last)
- (eq in-state 'first-and-last))
- (if (and message-forward-as-mime gnus-uu-digest-buffer)
- (with-current-buffer gnus-uu-digest-buffer
- (erase-buffer)
- (insert-buffer-substring "*gnus-uu-pre*")
- (goto-char (point-max))
- (insert-buffer-substring "*gnus-uu-body*"))
- (save-excursion
- (set-buffer "*gnus-uu-pre*")
- (insert (format "\n\n%s\n\n" (make-string 70 ?-)))
- (if gnus-uu-digest-buffer
- (with-current-buffer gnus-uu-digest-buffer
- (erase-buffer)
- (insert-buffer-substring "*gnus-uu-pre*"))
- (let ((coding-system-for-write mm-text-coding-system))
- (gnus-write-buffer gnus-uu-saved-article-name))))
- (save-excursion
- (set-buffer "*gnus-uu-body*")
- (goto-char (point-max))
- (insert
- (concat (setq end-string (format "End of %s Digest" name))
- "\n"))
- (insert (concat (make-string (length end-string) ?*) "\n"))
- (if gnus-uu-digest-buffer
- (with-current-buffer gnus-uu-digest-buffer
- (goto-char (point-max))
- (insert-buffer-substring "*gnus-uu-body*"))
- (let ((coding-system-for-write mm-text-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (write-region
- (point-min) (point-max) gnus-uu-saved-article-name t)))))
- (gnus-kill-buffer "*gnus-uu-pre*")
- (gnus-kill-buffer "*gnus-uu-body*")
- (push 'end state))
- (if (memq 'begin state)
- (cons gnus-uu-saved-article-name state)
- state)))))
-
-;; Binhex treatment - not very advanced.
-
-(defvar gnus-uu-binhex-body-line
- "^[^:]...............................................................$")
-(defvar gnus-uu-binhex-begin-line
- "^:...............................................................$")
-(defvar gnus-uu-binhex-end-line
- ":$")
-
-(defun gnus-uu-binhex-article (buffer in-state)
- (let (state start-char)
- (save-excursion
- (set-buffer buffer)
- (widen)
- (goto-char (point-min))
- (when (not (re-search-forward gnus-uu-binhex-begin-line nil t))
- (when (not (re-search-forward gnus-uu-binhex-body-line nil t))
- (setq state (list 'wrong-type))))
-
- (if (memq 'wrong-type state)
- ()
- (beginning-of-line)
- (setq start-char (point))
- (if (looking-at gnus-uu-binhex-begin-line)
- (progn
- (setq state (list 'begin))
- (write-region (point-min) (point-min)
- gnus-uu-binhex-article-name))
- (setq state (list 'middle)))
- (goto-char (point-max))
- (re-search-backward (concat gnus-uu-binhex-body-line "\\|"
- gnus-uu-binhex-end-line)
- nil t)
- (when (looking-at gnus-uu-binhex-end-line)
- (setq state (if (memq 'begin state)
- (cons 'end state)
- (list 'end))))
- (beginning-of-line)
- (forward-line 1)
- (when (file-exists-p gnus-uu-binhex-article-name)
- (mm-append-to-file start-char (point) gnus-uu-binhex-article-name))))
- (if (memq 'begin state)
- (cons gnus-uu-binhex-article-name state)
- state)))
-
-;; PostScript
-
-(defun gnus-uu-decode-postscript-article (process-buffer in-state)
- (let ((state (list 'ok))
- start-char end-char file-name)
- (save-excursion
- (set-buffer process-buffer)
- (goto-char (point-min))
- (if (not (re-search-forward gnus-uu-postscript-begin-string nil t))
- (setq state (list 'wrong-type))
- (beginning-of-line)
- (setq start-char (point))
- (if (not (re-search-forward gnus-uu-postscript-end-string nil t))
- (setq state (list 'wrong-type))
- (setq end-char (point))
- (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
- (insert-buffer-substring process-buffer start-char end-char)
- (setq file-name (concat gnus-uu-work-dir
- (cdr gnus-article-current) ".ps"))
- (write-region (point-min) (point-max) file-name)
- (setq state (list file-name 'begin 'end)))))
- state))
-
-
-;; Find actions.
-
-(defun gnus-uu-get-actions (files)
- (let ((ofiles files)
- action name)
- (while files
- (setq name (cdr (assq 'name (car files))))
- (and
- (setq action (gnus-uu-get-action name))
- (setcar files (nconc (list (if (string= action "gnus-uu-archive")
- (cons 'action "file")
- (cons 'action action))
- (cons 'execute (gnus-uu-command
- action name)))
- (car files))))
- (setq files (cdr files)))
- ofiles))
-
-(defun gnus-uu-get-action (file-name)
- (let (action)
- (setq action
- (gnus-uu-choose-action
- file-name
- (append
- gnus-uu-user-view-rules
- (if gnus-uu-ignore-default-view-rules
- nil
- gnus-uu-default-view-rules)
- gnus-uu-user-view-rules-end)))
- (when (and (not (string= (or action "") "gnus-uu-archive"))
- gnus-uu-view-with-metamail)
- (when (setq action
- (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list))
- (setq action (format "metamail -d -b -c \"%s\"" action))))
- action))
-
-
-;; Functions for treating subjects and collecting series.
-
-(defun gnus-uu-reginize-string (string)
- ;; Takes a string and puts a \ in front of every special character;
- ;; replaces the last thing that looks like "2/3" with "[0-9]+/3"
- ;; or, if it can't find something like that, tries "2 of 3", then
- ;; finally just replaces the next to last number with "[0-9]+".
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
- (buffer-disable-undo)
- (erase-buffer)
- (insert (regexp-quote string))
-
- (setq case-fold-search nil)
-
- (end-of-line)
- (if (re-search-backward "\\([^0-9]\\)[0-9]+/\\([0-9]+\\)" nil t)
- (replace-match "\\1[0-9]+/\\2")
-
- (end-of-line)
- (if (re-search-backward "\\([^0-9]\\)[0-9]+[ \t]*of[ \t]*\\([0-9]+\\)"
- nil t)
- (replace-match "\\1[0-9]+ of \\2")
-
- (end-of-line)
- (if (re-search-backward "\\([^0-9]\\)[0-9]+\\([^0-9]+\\)[0-9]+"
- nil t)
- (replace-match "\\1[0-9]+\\2[0-9]+" t nil nil nil))))
-
- (goto-char 1)
- (while (re-search-forward "[ \t]+" nil t)
- (replace-match "[ \t]+" t t))
-
- (buffer-string)))
-
-(defun gnus-uu-get-list-of-articles (n)
- ;; If N is non-nil, the article numbers of the N next articles
- ;; will be returned.
- ;; If any articles have been marked as processable, they will be
- ;; returned.
- ;; Failing that, articles that have subjects that are part of the
- ;; same "series" as the current will be returned.
- (let (articles)
- (cond
- (n
- (setq n (prefix-numeric-value n))
- (let ((backward (< n 0))
- (n (abs n)))
- (save-excursion
- (while (and (> n 0)
- (push (gnus-summary-article-number)
- articles)
- (gnus-summary-search-forward nil nil backward))
- (setq n (1- n))))
- (nreverse articles)))
- (gnus-newsgroup-processable
- (reverse gnus-newsgroup-processable))
- (t
- (gnus-uu-find-articles-matching)))))
-
-(defun gnus-uu-string< (l1 l2)
- (string< (car l1) (car l2)))
-
-(defun gnus-uu-find-articles-matching
- (&optional subject only-unread do-not-translate)
- ;; Finds all articles that matches the regexp SUBJECT. If it is
- ;; nil, the current article name will be used. If ONLY-UNREAD is
- ;; non-nil, only unread articles are chosen. If DO-NOT-TRANSLATE is
- ;; non-nil, article names are not equalized before sorting.
- (let ((subject (or subject
- (gnus-uu-reginize-string (gnus-summary-article-subject))))
- list-of-subjects)
- (save-excursion
- (when subject
- ;; Collect all subjects matching subject.
- (let ((case-fold-search t)
- (data gnus-newsgroup-data)
- subj mark d)
- (while data
- (setq d (pop data))
- (and (not (gnus-data-pseudo-p d))
- (or (not only-unread)
- (= (setq mark (gnus-data-mark d))
- gnus-unread-mark)
- (= mark gnus-ticked-mark)
- (= mark gnus-dormant-mark))
- (setq subj (mail-header-subject (gnus-data-header d)))
- (string-match subject subj)
- (push (cons subj (gnus-data-number d))
- list-of-subjects))))
-
- ;; Expand numbers, sort, and return the list of article
- ;; numbers.
- (mapcar (lambda (sub) (cdr sub))
- (sort (gnus-uu-expand-numbers
- list-of-subjects
- (not do-not-translate))
- 'gnus-uu-string<))))))
-
-(defun gnus-uu-expand-numbers (string-list &optional translate)
- ;; Takes a list of strings and "expands" all numbers in all the
- ;; strings. That is, this function makes all numbers equal length by
- ;; prepending lots of zeroes before each number. This is to ease later
- ;; sorting to find out what sequence the articles are supposed to be
- ;; decoded in. Returns the list of expanded strings.
- (let ((out-list string-list)
- string)
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
- (buffer-disable-undo)
- (while string-list
- (erase-buffer)
- (insert (caar string-list))
- ;; Translate multiple spaces to one space.
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+" nil t)
- (replace-match " "))
- ;; Translate all characters to "a".
- (goto-char (point-min))
- (when translate
- (while (re-search-forward "[A-Za-z]" nil t)
- (replace-match "a" t t)))
- ;; Expand numbers.
- (goto-char (point-min))
- (while (re-search-forward "[0-9]+" nil t)
- (ignore-errors
- (replace-match
- (format "%06d"
- (string-to-number (buffer-substring
- (match-beginning 0) (match-end 0)))))))
- (setq string (buffer-substring 1 (point-max)))
- (setcar (car string-list) string)
- (setq string-list (cdr string-list))))
- out-list))
-
-
-;; `gnus-uu-grab-articles' is the general multi-article treatment
-;; function. It takes a list of articles to be grabbed and a function
-;; to apply to each article.
-;;
-;; The function to be called should take two parameters. The first
-;; parameter is the article buffer. The function should leave the
-;; result, if any, in this buffer. Most treatment functions will just
-;; generate files...
-;;
-;; The second parameter is the state of the list of articles, and can
-;; have four values: `first', `middle', `last' and `first-and-last'.
-;;
-;; The function should return a list. The list may contain the
-;; following symbols:
-;; `error' if an error occurred
-;; `begin' if the beginning of an encoded file has been received
-;; If the list returned contains a `begin', the first element of
-;; the list *must* be a string with the file name of the decoded
-;; file.
-;; `end' if the end of an encoded file has been received
-;; `middle' if the article was a body part of an encoded file
-;; `wrong-type' if the article was not a part of an encoded file
-;; `ok', which can be used everything is ok
-
-(defvar gnus-uu-has-been-grabbed nil)
-
-(defun gnus-uu-unmark-list-of-grabbed (&optional dont-unmark-last-article)
- (let (art)
- (if (not (and gnus-uu-has-been-grabbed
- gnus-uu-unmark-articles-not-decoded))
- ()
- (when dont-unmark-last-article
- (setq art (car gnus-uu-has-been-grabbed))
- (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
- (while gnus-uu-has-been-grabbed
- (gnus-summary-tick-article (car gnus-uu-has-been-grabbed) t)
- (setq gnus-uu-has-been-grabbed (cdr gnus-uu-has-been-grabbed)))
- (when dont-unmark-last-article
- (setq gnus-uu-has-been-grabbed (list art))))))
-
-;; This function takes a list of articles and a function to apply to
-;; each article grabbed.
-;;
-;; This function returns a list of files decoded if the grabbing and
-;; the process-function has been successful and nil otherwise.
-(defun gnus-uu-grab-articles (articles process-function
- &optional sloppy limit no-errors)
- (let ((state 'first)
- (gnus-asynchronous nil)
- (gnus-inhibit-treatment t)
- has-been-begin article result-file result-files process-state
- gnus-summary-display-article-function
- gnus-article-prepare-hook gnus-display-mime-function
- article-series files)
-
- (while (and articles
- (not (memq 'error process-state))
- (or sloppy
- (not (memq 'end process-state))))
-
- (setq article (pop articles))
- (when (vectorp (gnus-summary-article-header article))
- (push article article-series)
-
- (unless articles
- (if (eq state 'first)
- (setq state 'first-and-last)
- (setq state 'last)))
-
- (let ((part (gnus-uu-part-number article)))
- (gnus-message 6 "Getting article %d%s..."
- article (if (string= part "") "" (concat ", " part))))
- (gnus-summary-display-article article)
-
- ;; Push the article to the processing function.
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (let ((buffer-read-only nil))
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (setq process-state
- (funcall process-function
- gnus-original-article-buffer state)))))
-
- (gnus-summary-remove-process-mark article)
-
- ;; If this is the beginning of a decoded file, we push it
- ;; on to a list.
- (when (or (memq 'begin process-state)
- (and (or (eq state 'first)
- (eq state 'first-and-last))
- (memq 'ok process-state)))
- (when has-been-begin
- ;; If there is a `result-file' here, that means that the
- ;; file was unsuccessfully decoded, so we delete it.
- (when (and result-file
- (file-exists-p result-file)
- (not gnus-uu-be-dangerous)
- (or (eq gnus-uu-be-dangerous t)
- (gnus-y-or-n-p
- (format "Delete unsuccessfully decoded file %s? "
- result-file))))
- (delete-file result-file)))
- (when (memq 'begin process-state)
- (setq result-file (car process-state)))
- (setq has-been-begin t))
-
- ;; Check whether we have decoded one complete file.
- (when (memq 'end process-state)
- (setq article-series nil)
- (setq has-been-begin nil)
- (if (stringp result-file)
- (setq files (list result-file))
- (setq files result-file))
- (setq result-file (car files))
- (while files
- (push (list (cons 'name (pop files))
- (cons 'article article))
- result-files))
- ;; Allow user-defined functions to be run on this file.
- (when gnus-uu-grabbed-file-functions
- (let ((funcs gnus-uu-grabbed-file-functions))
- (unless (listp funcs)
- (setq funcs (list funcs)))
- (while funcs
- (funcall (pop funcs) result-file))))
- (setq result-file nil)
- ;; Check whether we have decoded enough articles.
- (and limit (= (length result-files) limit)
- (setq articles nil)))
-
- ;; If this is the last article to be decoded, and
- ;; we still haven't reached the end, then we delete
- ;; the partially decoded file.
- (and (or (eq state 'last) (eq state 'first-and-last))
- (not (memq 'end process-state))
- result-file
- (file-exists-p result-file)
- (not gnus-uu-be-dangerous)
- (or (eq gnus-uu-be-dangerous t)
- (gnus-y-or-n-p
- (format "Delete incomplete file %s? " result-file)))
- (delete-file result-file))
-
- ;; If this was a file of the wrong sort, then
- (when (and (or (memq 'wrong-type process-state)
- (memq 'error process-state))
- gnus-uu-unmark-articles-not-decoded)
- (gnus-summary-tick-article article t))
-
- ;; Set the new series state.
- (if (and (not has-been-begin)
- (not sloppy)
- (or (memq 'end process-state)
- (memq 'middle process-state)))
- (progn
- (setq process-state (list 'error))
- (gnus-message 2 "No begin part at the beginning")
- (sleep-for 2))
- (setq state 'middle))))
-
- ;; When there are no result-files, then something must be wrong.
- (if result-files
- (message "")
- (cond
- ((not has-been-begin)
- (gnus-message 2 "Wrong type file"))
- ((memq 'error process-state)
- (gnus-message 2 "An error occurred during decoding"))
- ((not (or (memq 'ok process-state)
- (memq 'end process-state)))
- (gnus-message 2 "End of articles reached before end of file")))
- ;; Make unsuccessfully decoded articles unread.
- (when gnus-uu-unmark-articles-not-decoded
- (while article-series
- (gnus-summary-tick-article (pop article-series) t))))
-
- ;; The original article buffer is hosed, shoot it down.
- (gnus-kill-buffer gnus-original-article-buffer)
- (setq gnus-current-article nil)
- result-files))
-
-(defun gnus-uu-grab-view (file)
- "View FILE using the gnus-uu methods."
- (let ((action (gnus-uu-get-action file)))
- (gnus-execute-command
- (if (string-match "%" action)
- (format action file)
- (concat action " " file))
- (eq gnus-view-pseudos 'not-confirm))))
-
-(defun gnus-uu-grab-move (file)
- "Move FILE to somewhere."
- (when gnus-uu-default-dir
- (let ((to-file (concat (file-name-as-directory gnus-uu-default-dir)
- (file-name-nondirectory file))))
- (rename-file file to-file)
- (unless (file-exists-p file)
- (make-symbolic-link to-file file)))))
-
-(defun gnus-uu-part-number (article)
- (let* ((header (gnus-summary-article-header article))
- (subject (and header (mail-header-subject header)))
- (part nil))
- (if subject
- (while (string-match "[0-9]+/[0-9]+\\|[0-9]+[ \t]+of[ \t]+[0-9]+"
- subject)
- (setq part (match-string 0 subject))
- (setq subject (substring subject (match-end 0)))))
- (or part
- (while (string-match "\\([0-9]+\\)[^0-9]+\\([0-9]+\\)" subject)
- (setq part (match-string 0 subject))
- (setq subject (substring subject (match-end 0)))))
- (or part "")))
-
-(defun gnus-uu-uudecode-sentinel (process event)
- (delete-process (get-process process)))
-
-(defun gnus-uu-uustrip-article (process-buffer in-state)
- ;; Uudecodes a file asynchronously.
- (save-excursion
- (set-buffer process-buffer)
- (let ((state (list 'wrong-type))
- process-connection-type case-fold-search buffer-read-only
- files start-char)
- (goto-char (point-min))
-
- ;; Deal with ^M at the end of the lines.
- (when gnus-uu-kill-carriage-return
- (save-excursion
- (while (search-forward "\r" nil t)
- (delete-backward-char 1))))
-
- (while (or (re-search-forward gnus-uu-begin-string nil t)
- (re-search-forward gnus-uu-body-line nil t))
- (setq state (list 'ok))
- ;; Ok, we are at the first uucoded line.
- (beginning-of-line)
- (setq start-char (point))
-
- (if (not (looking-at gnus-uu-begin-string))
- (setq state (list 'middle))
- ;; This is the beginning of a uuencoded article.
- ;; We replace certain characters that could make things messy.
- (setq gnus-uu-file-name
- (gnus-map-function
- mm-file-name-rewrite-functions
- (file-name-nondirectory (match-string 1))))
- (replace-match (concat "begin 644 " gnus-uu-file-name) t t)
-
- ;; Remove any non gnus-uu-body-line right after start.
- (forward-line 1)
- (while (and (not (eobp))
- (not (looking-at gnus-uu-body-line)))
- (gnus-delete-line))
-
- ;; If a process is running, we kill it.
- (when (and gnus-uu-uudecode-process
- (memq (process-status gnus-uu-uudecode-process)
- '(run stop)))
- (delete-process gnus-uu-uudecode-process)
- (gnus-uu-unmark-list-of-grabbed t))
-
- ;; Start a new uudecoding process.
- (let ((cdir default-directory))
- (unwind-protect
- (progn
- (cd gnus-uu-work-dir)
- (setq gnus-uu-uudecode-process
- (start-process
- "*uudecode*"
- (gnus-get-buffer-create gnus-uu-output-buffer-name)
- shell-file-name shell-command-switch
- (format "cd %s %s uudecode" gnus-uu-work-dir
- gnus-shell-command-separator))))
- (cd cdir)))
- (set-process-sentinel
- gnus-uu-uudecode-process 'gnus-uu-uudecode-sentinel)
- (setq state (list 'begin))
- (push (concat gnus-uu-work-dir gnus-uu-file-name) files))
-
- ;; We look for the end of the thing to be decoded.
- (if (re-search-forward gnus-uu-end-string nil t)
- (push 'end state)
- (goto-char (point-max))
- (re-search-backward gnus-uu-body-line nil t))
-
- (forward-line 1)
-
- (when gnus-uu-uudecode-process
- (when (memq (process-status gnus-uu-uudecode-process) '(run stop))
- ;; Try to correct mishandled uucode.
- (when gnus-uu-correct-stripped-uucode
- (gnus-uu-check-correct-stripped-uucode start-char (point)))
- (gnus-run-hooks 'gnus-uu-pre-uudecode-hook)
-
- ;; Send the text to the process.
- (condition-case nil
- (process-send-region
- gnus-uu-uudecode-process start-char (point))
- (error
- (progn
- (delete-process gnus-uu-uudecode-process)
- (gnus-message 2 "gnus-uu: Couldn't uudecode")
- (setq state (list 'wrong-type)))))
-
- (if (memq 'end state)
- (progn
- ;; Send an EOF, just in case.
- (ignore-errors
- (process-send-eof gnus-uu-uudecode-process))
- (while (memq (process-status gnus-uu-uudecode-process)
- '(open run))
- (accept-process-output gnus-uu-uudecode-process 1)))
- (when (or (not gnus-uu-uudecode-process)
- (not (memq (process-status gnus-uu-uudecode-process)
- '(run stop))))
- (setq state (list 'wrong-type)))))))
-
- (if (memq 'begin state)
- (cons (if (= (length files) 1) (car files) files) state)
- state))))
-
-(defvar gnus-uu-unshar-warning
- "*** WARNING ***
-
-Shell archives are an archaic method of bundling files for distribution
-across computer networks. During the unpacking process, arbitrary commands
-are executed on your system, and all kinds of nasty things can happen.
-Please examine the archive very carefully before you instruct Emacs to
-unpack it. You can browse the archive buffer using \\[scroll-other-window].
-
-If you are unsure what to do, please answer \"no\"."
- "Text of warning message displayed by `gnus-uu-unshar-article'.
-Make sure that this text consists only of few text lines. Otherwise,
-Gnus might fail to display all of it.")
-
-
-;; This function is used by `gnus-uu-grab-articles' to treat
-;; a shared article.
-(defun gnus-uu-unshar-article (process-buffer in-state)
- (let ((state (list 'ok))
- start-char)
- (save-excursion
- (set-buffer process-buffer)
- (goto-char (point-min))
- (if (not (re-search-forward gnus-uu-shar-begin-string nil t))
- (setq state (list 'wrong-type))
- (save-window-excursion
- (save-excursion
- (switch-to-buffer (current-buffer))
- (delete-other-windows)
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- "*Warning*"))))
- (unless
- (unwind-protect
- (with-current-buffer buffer
- (insert (substitute-command-keys
- gnus-uu-unshar-warning))
- (goto-char (point-min))
- (display-buffer buffer)
- (yes-or-no-p "This is a shell archive, unshar it? "))
- (kill-buffer buffer))
- (setq state (list 'error))))))
- (unless (memq 'error state)
- (beginning-of-line)
- (setq start-char (point))
- (call-process-region
- start-char (point-max) shell-file-name nil
- (gnus-get-buffer-create gnus-uu-output-buffer-name) nil
- shell-command-switch
- (concat "cd " gnus-uu-work-dir " "
- gnus-shell-command-separator " sh")))))
- state))
-
-;; Returns the name of what the shar file is going to unpack.
-(defun gnus-uu-find-name-in-shar ()
- (let ((oldpoint (point))
- res)
- (goto-char (point-min))
- (when (re-search-forward gnus-uu-shar-name-marker nil t)
- (setq res (buffer-substring (match-beginning 1) (match-end 1))))
- (goto-char oldpoint)
- res))
-
-;; `gnus-uu-choose-action' chooses what action to perform given the name
-;; and `gnus-uu-file-action-list'. Returns either nil if no action is
-;; found, or the name of the command to run if such a rule is found.
-(defun gnus-uu-choose-action (file-name file-action-list &optional no-ignore)
- (let ((action-list (copy-sequence file-action-list))
- (case-fold-search t)
- rule action)
- (and
- (unless no-ignore
- (and (not
- (and gnus-uu-ignore-files-by-name
- (string-match gnus-uu-ignore-files-by-name file-name)))
- (not
- (and gnus-uu-ignore-files-by-type
- (string-match gnus-uu-ignore-files-by-type
- (or (gnus-uu-choose-action
- file-name gnus-uu-ext-to-mime-list t)
- ""))))))
- (while (not (or (eq action-list ()) action))
- (setq rule (car action-list))
- (setq action-list (cdr action-list))
- (when (string-match (car rule) file-name)
- (setq action (cadr rule)))))
- action))
-
-(defun gnus-uu-treat-archive (file-path)
- ;; Unpacks an archive. Returns t if unpacking is successful.
- (let ((did-unpack t)
- action command dir)
- (setq action (gnus-uu-choose-action
- file-path (append gnus-uu-user-archive-rules
- (if gnus-uu-ignore-default-archive-rules
- nil
- gnus-uu-default-archive-rules))))
-
- (when (not action)
- (error "No unpackers for the file %s" file-path))
-
- (string-match "/[^/]*$" file-path)
- (setq dir (substring file-path 0 (match-beginning 0)))
-
- (when (member action gnus-uu-destructive-archivers)
- (copy-file file-path (concat file-path "~") t))
-
- (setq command (format "cd %s ; %s" dir (gnus-uu-command action file-path)))
-
- (save-excursion
- (set-buffer (gnus-get-buffer-create gnus-uu-output-buffer-name))
- (erase-buffer))
-
- (gnus-message 5 "Unpacking: %s..." (gnus-uu-command action file-path))
-
- (if (eq 0 (call-process shell-file-name nil
- (gnus-get-buffer-create gnus-uu-output-buffer-name)
- nil shell-command-switch command))
- (message "")
- (gnus-message 2 "Error during unpacking of archive")
- (setq did-unpack nil))
-
- (when (member action gnus-uu-destructive-archivers)
- (rename-file (concat file-path "~") file-path t))
-
- did-unpack))
-
-(defun gnus-uu-dir-files (dir)
- (let ((dirs (directory-files dir t "[^/][^\\.][^\\.]?$"))
- files file)
- (while dirs
- (if (file-directory-p (setq file (car dirs)))
- (setq files (append files (gnus-uu-dir-files file)))
- (push file files))
- (setq dirs (cdr dirs)))
- files))
-
-(defun gnus-uu-unpack-files (files &optional ignore)
- ;; Go through FILES and look for files to unpack.
- (let* ((totfiles (gnus-uu-ls-r gnus-uu-work-dir))
- (ofiles files)
- file did-unpack)
- (while files
- (setq file (cdr (assq 'name (car files))))
- (when (and (not (member file ignore))
- (equal (gnus-uu-get-action (file-name-nondirectory file))
- "gnus-uu-archive"))
- (push file did-unpack)
- (unless (gnus-uu-treat-archive file)
- (gnus-message 2 "Error during unpacking of %s" file))
- (let* ((newfiles (gnus-uu-ls-r gnus-uu-work-dir))
- (nfiles newfiles))
- (while nfiles
- (unless (member (car nfiles) totfiles)
- (push (list (cons 'name (car nfiles))
- (cons 'original file))
- ofiles))
- (setq nfiles (cdr nfiles)))
- (setq totfiles newfiles)))
- (setq files (cdr files)))
- (if did-unpack
- (gnus-uu-unpack-files ofiles (append did-unpack ignore))
- ofiles)))
-
-(defun gnus-uu-ls-r (dir)
- (let* ((files (gnus-uu-directory-files dir t))
- (ofiles files))
- (while files
- (when (file-directory-p (car files))
- (setq ofiles (delete (car files) ofiles))
- (setq ofiles (append ofiles (gnus-uu-ls-r (car files)))))
- (setq files (cdr files)))
- ofiles))
-
-;; Various stuff
-
-(defun gnus-uu-directory-files (dir &optional full)
- (let (files out file)
- (setq files (directory-files dir full))
- (while files
- (setq file (car files))
- (setq files (cdr files))
- (unless (member (file-name-nondirectory file) '("." ".."))
- (push file out)))
- (setq out (nreverse out))
- out))
-
-(defun gnus-uu-check-correct-stripped-uucode (start end)
- (save-excursion
- (let (found beg length)
- (if (not gnus-uu-correct-stripped-uucode)
- ()
- (goto-char start)
-
- (if (re-search-forward " \\|`" end t)
- (progn
- (goto-char start)
- (while (not (eobp))
- (progn
- (when (looking-at "\n")
- (replace-match ""))
- (forward-line 1))))
-
- (while (not (eobp))
- (if (looking-at (concat gnus-uu-begin-string "\\|"
- gnus-uu-end-string))
- ()
- (when (not found)
- (beginning-of-line)
- (setq beg (point))
- (end-of-line)
- (setq length (- (point) beg)))
- (setq found t)
- (beginning-of-line)
- (setq beg (point))
- (end-of-line)
- (when (not (= length (- (point) beg)))
- (insert (make-string (- length (- (point) beg)) ? ))))
- (forward-line 1)))))))
-
-(defvar gnus-uu-tmp-alist nil)
-
-(defun gnus-uu-initialize (&optional scan)
- (let (entry)
- (if (and (not scan)
- (when (setq entry (assoc gnus-newsgroup-name gnus-uu-tmp-alist))
- (if (file-exists-p (cdr entry))
- (setq gnus-uu-work-dir (cdr entry))
- (setq gnus-uu-tmp-alist (delq entry gnus-uu-tmp-alist))
- nil)))
- t
- (setq gnus-uu-tmp-dir (file-name-as-directory
- (expand-file-name gnus-uu-tmp-dir)))
- (if (not (file-directory-p gnus-uu-tmp-dir))
- (error "Temp directory %s doesn't exist" gnus-uu-tmp-dir)
- (when (not (file-writable-p gnus-uu-tmp-dir))
- (error "Temp directory %s can't be written to"
- gnus-uu-tmp-dir)))
-
- (setq gnus-uu-work-dir
- (mm-make-temp-file (concat gnus-uu-tmp-dir "gnus") 'dir))
- (set-file-modes gnus-uu-work-dir 448)
- (setq gnus-uu-work-dir (file-name-as-directory gnus-uu-work-dir))
- (push (cons gnus-newsgroup-name gnus-uu-work-dir)
- gnus-uu-tmp-alist))))
-
-
-;; Kills the temporary uu buffers, kills any processes, etc.
-(defun gnus-uu-clean-up ()
- (let (buf)
- (and gnus-uu-uudecode-process
- (memq (process-status (or gnus-uu-uudecode-process "nevair"))
- '(stop run))
- (delete-process gnus-uu-uudecode-process))
- (when (setq buf (get-buffer gnus-uu-output-buffer-name))
- (kill-buffer buf))))
-
-;; Inputs an action and a filename and returns a full command, making sure
-;; that the filename will be treated as a single argument when the shell
-;; executes the command.
-(defun gnus-uu-command (action file)
- (let ((quoted-file (mm-quote-arg file)))
- (if (string-match "%s" action)
- (format action quoted-file)
- (concat action " " quoted-file))))
-
-(defun gnus-uu-delete-work-dir (&optional dir)
- "Delete recursively all files and directories under `gnus-uu-work-dir'."
- (if dir
- (gnus-message 7 "Deleting directory %s..." dir)
- (setq dir gnus-uu-work-dir))
- (when (and dir
- (file-exists-p dir))
- (let ((files (directory-files dir t nil t))
- file)
- (while (setq file (pop files))
- (unless (member (file-name-nondirectory file) '("." ".."))
- (if (file-directory-p file)
- (gnus-uu-delete-work-dir file)
- (gnus-message 9 "Deleting file %s..." file)
- (condition-case err
- (delete-file file)
- (error (gnus-message 3 "Deleting file %s failed... %s" file err))))))
- (condition-case err
- (delete-directory dir)
- (error (gnus-message 3 "Deleting directory %s failed... %s" file err))))
- (gnus-message 7 "")))
-
-;; Initializing
-
-(add-hook 'gnus-exit-group-hook 'gnus-uu-clean-up)
-(add-hook 'gnus-exit-group-hook 'gnus-uu-delete-work-dir)
-
-\f
-
-;;;
-;;; uuencoded posting
-;;;
-
-;; Any function that is to be used as and encoding method will take two
-;; parameters: PATH-NAME and FILE-NAME. (E.g. "/home/gaga/spiral.jpg"
-;; and "spiral.jpg", respectively.) The function should return nil if
-;; the encoding wasn't successful.
-(defcustom gnus-uu-post-encode-method 'gnus-uu-post-encode-uuencode
- "Function used for encoding binary files.
-There are three functions supplied with gnus-uu for encoding files:
-`gnus-uu-post-encode-uuencode', which does straight uuencoding;
-`gnus-uu-post-encode-mime', which encodes with base64 and adds MIME
-headers; and `gnus-uu-post-encode-mime-uuencode', which encodes with
-uuencode and adds MIME headers."
- :group 'gnus-extract-post
- :type '(radio (function-item gnus-uu-post-encode-uuencode)
- (function-item gnus-uu-post-encode-mime)
- (function-item gnus-uu-post-encode-mime-uuencode)
- (function :tag "Other")))
-
-(defcustom gnus-uu-post-include-before-composing nil
- "Non-nil means that gnus-uu will ask for a file to encode before you compose the article.
-If this variable is t, you can either include an encoded file with
-\\[gnus-uu-post-insert-binary-in-article] or have one included for you when you post the article."
- :group 'gnus-extract-post
- :type 'boolean)
-
-(defcustom gnus-uu-post-length 990
- "Maximum length of an article.
-The encoded file will be split into how many articles it takes to
-post the entire file."
- :group 'gnus-extract-post
- :type 'integer)
-
-(defcustom gnus-uu-post-threaded nil
- "Non-nil means that gnus-uu will post the encoded file in a thread.
-This may not be smart, as no other decoder I have seen are able to
-follow threads when collecting uuencoded articles. (Well, I have seen
-one package that does that - gnus-uu, but somehow, I don't think that
-counts...) The default is nil."
- :group 'gnus-extract-post
- :type 'boolean)
-
-(defcustom gnus-uu-post-separate-description t
- "Non-nil means that the description will be posted in a separate article.
-The first article will typically be numbered (0/x). If this variable
-is nil, the description the user enters will be included at the
-beginning of the first article, which will be numbered (1/x). Default
-is t."
- :group 'gnus-extract-post
- :type 'boolean)
-
-(defvar gnus-uu-post-binary-separator "--binary follows this line--")
-(defvar gnus-uu-post-message-id nil)
-(defvar gnus-uu-post-inserted-file-name nil)
-(defvar gnus-uu-winconf-post-news nil)
-
-(defun gnus-uu-post-news ()
- "Compose an article and post an encoded file."
- (interactive)
- (setq gnus-uu-post-inserted-file-name nil)
- (setq gnus-uu-winconf-post-news (current-window-configuration))
-
- (gnus-summary-post-news)
-
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (current-local-map))
- (use-local-map map))
- ;;(local-set-key "\C-c\C-c" 'gnus-summary-edit-article-done)
- (local-set-key "\C-c\C-c" 'gnus-uu-post-news-inews)
- (local-set-key "\C-c\C-s" 'gnus-uu-post-news-inews)
- (local-set-key "\C-c\C-i" 'gnus-uu-post-insert-binary-in-article)
-
- (when gnus-uu-post-include-before-composing
- (save-excursion (setq gnus-uu-post-inserted-file-name
- (gnus-uu-post-insert-binary)))))
-
-(defun gnus-uu-post-insert-binary-in-article ()
- "Inserts an encoded file in the buffer.
-The user will be asked for a file name."
- (interactive)
- (save-excursion
- (setq gnus-uu-post-inserted-file-name (gnus-uu-post-insert-binary))))
-
-;; Encodes with uuencode and substitutes all spaces with backticks.
-(defun gnus-uu-post-encode-uuencode (path file-name)
- (when (gnus-uu-post-encode-file "uuencode" path file-name)
- (goto-char (point-min))
- (forward-line 1)
- (while (re-search-forward " " nil t)
- (replace-match "`"))
- t))
-
-;; Encodes with uuencode and adds MIME headers.
-(defun gnus-uu-post-encode-mime-uuencode (path file-name)
- (when (gnus-uu-post-encode-uuencode path file-name)
- (gnus-uu-post-make-mime file-name "x-uue")
- t))
-
-;; Encodes with base64 and adds MIME headers
-(defun gnus-uu-post-encode-mime (path file-name)
- (when (eq 0 (call-process shell-file-name nil t nil shell-command-switch
- (format "%s %s -o %s" "mmencode" path file-name)))
- (gnus-uu-post-make-mime file-name "base64")
- t))
-
-;; Adds MIME headers.
-(defun gnus-uu-post-make-mime (file-name encoding)
- (goto-char (point-min))
- (insert (format "Content-Type: %s; name=\"%s\"\n"
- (gnus-uu-choose-action file-name gnus-uu-ext-to-mime-list)
- file-name))
- (insert (format "Content-Transfer-Encoding: %s\n\n" encoding))
- (save-restriction
- (set-buffer gnus-message-buffer)
- (goto-char (point-min))
- (re-search-forward (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line -1)
- (narrow-to-region (point-min) (point))
- (unless (mail-fetch-field "mime-version")
- (widen)
- (insert "MIME-Version: 1.0\n"))
- (widen)))
-
-;; Encodes a file PATH with COMMAND, leaving the result in the
-;; current buffer.
-(defun gnus-uu-post-encode-file (command path file-name)
- (eq 0 (call-process shell-file-name nil t nil shell-command-switch
- (format "%s %s %s" command path file-name))))
-
-(defun gnus-uu-post-news-inews ()
- "Posts the composed news article and encoded file.
-If no file has been included, the user will be asked for a file."
- (interactive)
-
- (let (file-name)
-
- (if gnus-uu-post-inserted-file-name
- (setq file-name gnus-uu-post-inserted-file-name)
- (setq file-name (gnus-uu-post-insert-binary)))
-
- (gnus-uu-post-encoded file-name gnus-uu-post-threaded))
- (setq gnus-uu-post-inserted-file-name nil)
- (when gnus-uu-winconf-post-news
- (set-window-configuration gnus-uu-winconf-post-news)))
-
-;; Asks for a file to encode, encodes it and inserts the result in
-;; the current buffer. Returns the file name the user gave.
-(defun gnus-uu-post-insert-binary ()
- (let ((uuencode-buffer-name "*uuencode buffer*")
- file-path uubuf file-name)
-
- (setq file-path (read-file-name
- "What file do you want to encode? "))
- (when (not (file-exists-p file-path))
- (error "%s: No such file" file-path))
-
- (goto-char (point-max))
- (insert (format "\n%s\n" gnus-uu-post-binary-separator))
-
- ;; #### Unix-specific?
- (when (string-match "^~/" file-path)
- (setq file-path (concat "$HOME" (substring file-path 1))))
- ;; #### Unix-specific?
- (if (string-match "/[^/]*$" file-path)
- (setq file-name (substring file-path (1+ (match-beginning 0))))
- (setq file-name file-path))
-
- (unwind-protect
- (if (save-excursion
- (set-buffer (setq uubuf
- (gnus-get-buffer-create uuencode-buffer-name)))
- (erase-buffer)
- (funcall gnus-uu-post-encode-method file-path file-name))
- (insert-buffer-substring uubuf)
- (error "Encoding unsuccessful"))
- (kill-buffer uubuf))
- file-name))
-
-;; Posts the article and all of the encoded file.
-(defun gnus-uu-post-encoded (file-name &optional threaded)
- (let ((send-buffer-name "*uuencode send buffer*")
- (encoded-buffer-name "*encoded buffer*")
- (top-string "[ cut here %s (%s %d/%d) %s gnus-uu ]")
- (separator (concat mail-header-separator "\n\n"))
- uubuf length parts header i end beg
- beg-line minlen post-buf whole-len beg-binary end-binary)
-
- (setq post-buf (current-buffer))
-
- (goto-char (point-min))
- (when (not (re-search-forward
- (if gnus-uu-post-separate-description
- (concat "^" (regexp-quote gnus-uu-post-binary-separator)
- "$")
- (concat "^" (regexp-quote mail-header-separator) "$"))
- nil t))
- (error "Internal error: No binary/header separator"))
- (beginning-of-line)
- (forward-line 1)
- (setq beg-binary (point))
- (setq end-binary (point-max))
-
- (save-excursion
- (set-buffer (setq uubuf (gnus-get-buffer-create encoded-buffer-name)))
- (erase-buffer)
- (insert-buffer-substring post-buf beg-binary end-binary)
- (goto-char (point-min))
- (setq length (count-lines (point-min) (point-max)))
- (setq parts (/ length gnus-uu-post-length))
- (unless (< (% length gnus-uu-post-length) 4)
- (incf parts)))
-
- (when gnus-uu-post-separate-description
- (forward-line -1))
- (delete-region (point) (point-max))
-
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (beginning-of-line)
- (setq header (buffer-substring (point-min) (point)))
-
- (goto-char (point-min))
- (when gnus-uu-post-separate-description
- (when (re-search-forward "^Subject: " nil t)
- (end-of-line)
- (insert (format " (0/%d)" parts)))
- (save-excursion
- (message-send))
- (setq gnus-uu-post-message-id (message-fetch-field "message-id")))
-
- (save-excursion
- (setq i 1)
- (setq beg 1)
- (while (not (> i parts))
- (set-buffer (gnus-get-buffer-create send-buffer-name))
- (erase-buffer)
- (insert header)
- (when (and threaded gnus-uu-post-message-id)
- (insert "References: " gnus-uu-post-message-id "\n"))
- (insert separator)
- (setq whole-len
- (- 62 (length (format top-string "" file-name i parts ""))))
- (when (> 1 (setq minlen (/ whole-len 2)))
- (setq minlen 1))
- (setq
- beg-line
- (format top-string
- (make-string minlen ?-)
- file-name i parts
- (make-string
- (if (= 0 (% whole-len 2)) (1- minlen) minlen) ?-)))
-
- (goto-char (point-min))
- (when (re-search-forward "^Subject: " nil t)
- (end-of-line)
- (insert (format " (%d/%d)" i parts)))
-
- (goto-char (point-max))
- (save-excursion
- (set-buffer uubuf)
- (goto-char beg)
- (if (= i parts)
- (goto-char (point-max))
- (forward-line gnus-uu-post-length))
- (when (and (= (1+ i) parts) (< (count-lines (point) (point-max)) 4))
- (forward-line -4))
- (setq end (point)))
- (insert-buffer-substring uubuf beg end)
- (insert beg-line "\n")
- (setq beg end)
- (incf i)
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (beginning-of-line)
- (forward-line 2)
- (when (re-search-forward
- (concat "^" (regexp-quote gnus-uu-post-binary-separator) "$")
- nil t)
- (replace-match "")
- (forward-line 1))
- (insert beg-line)
- (insert "\n")
- (let (message-sent-message-via)
- (save-excursion
- (message-send))
- (setq gnus-uu-post-message-id
- (concat (message-fetch-field "references") " "
- (message-fetch-field "message-id"))))))
-
- (gnus-kill-buffer send-buffer-name)
- (gnus-kill-buffer encoded-buffer-name)
-
- (when (not gnus-uu-post-separate-description)
- (set-buffer-modified-p nil)
- (when (fboundp 'bury-buffer)
- (bury-buffer)))))
-
-(provide 'gnus-uu)
-
-;;; arch-tag: 05312384-0a83-4720-9a58-b3160b888853
-;;; gnus-uu.el ends here
+++ /dev/null
-;;; gnus-vm.el --- vm interface for Gnus
-
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Per Persson <pp@gnu.ai.mit.edu>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Major contributors:
-;; Christian Limpach <Christian.Limpach@nice.ch>
-;; Some code stolen from:
-;; Rick Sladkey <jrs@world.std.com>
-
-;;; Code:
-
-(require 'sendmail)
-(require 'message)
-(require 'gnus)
-(require 'gnus-msg)
-
-(eval-when-compile
- (require 'cl)
- (autoload 'vm-mode "vm")
- (autoload 'vm-save-message "vm")
- (autoload 'vm-forward-message "vm")
- (autoload 'vm-reply "vm")
- (autoload 'vm-mail "vm"))
-
-(defvar gnus-vm-inhibit-window-system nil
- "Inhibit loading `win-vm' if using a window-system.
-Has to be set before gnus-vm is loaded.")
-
-(unless gnus-vm-inhibit-window-system
- (ignore-errors
- (when window-system
- (require 'win-vm))))
-
-(when (not (featurep 'vm))
- (load "vm"))
-
-(defun gnus-vm-make-folder (&optional buffer)
- (let ((article (or buffer (current-buffer)))
- (tmp-folder (generate-new-buffer " *tmp-folder*"))
- (start (point-min))
- (end (point-max)))
- (set-buffer tmp-folder)
- (insert-buffer-substring article start end)
- (goto-char (point-min))
- (if (looking-at "^\\(From [^ ]+ \\).*$")
- (replace-match (concat "\\1" (current-time-string)))
- (insert "From " gnus-newsgroup-name " "
- (current-time-string) "\n"))
- (while (re-search-forward "\n\nFrom " nil t)
- (replace-match "\n\n>From "))
- ;; insert a newline, otherwise the last line gets lost
- (goto-char (point-max))
- (insert "\n")
- (vm-mode)
- tmp-folder))
-
-(defun gnus-summary-save-article-vm (&optional arg)
- "Append the current article to a vm folder.
-If N is a positive number, save the N next articles.
-If N is a negative number, save the N previous articles.
-If N is nil and any articles have been marked with the process mark,
-save those articles instead."
- (interactive "P")
- (require 'gnus-art)
- (let ((gnus-default-article-saver 'gnus-summary-save-in-vm))
- (gnus-summary-save-article arg)))
-
-(defun gnus-summary-save-in-vm (&optional folder)
- (interactive)
- (setq folder
- (gnus-read-save-file-name
- "Save %s in VM folder:" folder
- gnus-mail-save-name gnus-newsgroup-name
- gnus-current-headers 'gnus-newsgroup-last-mail))
- (gnus-eval-in-buffer-window gnus-original-article-buffer
- (save-excursion
- (save-restriction
- (widen)
- (let ((vm-folder (gnus-vm-make-folder)))
- (vm-save-message folder)
- (kill-buffer vm-folder))))))
-
-(provide 'gnus-vm)
-
-;;; arch-tag: 42ca7f88-a12f-461d-be3e-cac7efb44866
-;;; gnus-vm.el ends here
+++ /dev/null
-;;; gnus-win.el --- window configuration functions for Gnus
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'gnus-util)
-
-(defgroup gnus-windows nil
- "Window configuration."
- :group 'gnus)
-
-(defcustom gnus-use-full-window t
- "*If non-nil, use the entire Emacs screen."
- :group 'gnus-windows
- :type 'boolean)
-
-(defvar gnus-window-configuration nil
- "Obsolete variable. See `gnus-buffer-configuration'.")
-
-(defcustom gnus-window-min-width 2
- "*Minimum width of Gnus buffers."
- :group 'gnus-windows
- :type 'integer)
-
-(defcustom gnus-window-min-height 1
- "*Minimum height of Gnus buffers."
- :group 'gnus-windows
- :type 'integer)
-
-(defcustom gnus-always-force-window-configuration nil
- "*If non-nil, always force the Gnus window configurations."
- :group 'gnus-windows
- :type 'boolean)
-
-(defcustom gnus-use-frames-on-any-display nil
- "*If non-nil, frames on all displays will be considered useable by Gnus.
-When nil, only frames on the same display as the selected frame will be
-used to display Gnus windows."
- :version "22.1"
- :group 'gnus-windows
- :type 'boolean)
-
-(defvar gnus-buffer-configuration
- '((group
- (vertical 1.0
- (group 1.0 point)
- (if gnus-carpal '(group-carpal 4))))
- (summary
- (vertical 1.0
- (summary 1.0 point)
- (if gnus-carpal '(summary-carpal 4))))
- (article
- (cond
- (gnus-use-trees
- '(vertical 1.0
- (summary 0.25 point)
- (tree 0.25)
- (article 1.0)))
- (t
- '(vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- (article 1.0)))))
- (server
- (vertical 1.0
- (server 1.0 point)
- (if gnus-carpal '(server-carpal 2))))
- (browse
- (vertical 1.0
- (browse 1.0 point)
- (if gnus-carpal '(browse-carpal 2))))
- (message
- (vertical 1.0
- (message 1.0 point)))
- (pick
- (vertical 1.0
- (article 1.0 point)))
- (info
- (vertical 1.0
- (info 1.0 point)))
- (summary-faq
- (vertical 1.0
- (summary 0.25)
- (faq 1.0 point)))
- (edit-article
- (vertical 1.0
- (article 1.0 point)))
- (edit-form
- (vertical 1.0
- (group 0.5)
- (edit-form 1.0 point)))
- (edit-score
- (vertical 1.0
- (summary 0.25)
- (edit-score 1.0 point)))
- (post
- (vertical 1.0
- (post 1.0 point)))
- (reply
- (vertical 1.0
- (article 0.5)
- (message 1.0 point)))
- (forward
- (vertical 1.0
- (message 1.0 point)))
- (reply-yank
- (vertical 1.0
- (message 1.0 point)))
- (mail-bounce
- (vertical 1.0
- (article 0.5)
- (message 1.0 point)))
- (pipe
- (vertical 1.0
- (summary 0.25 point)
- (if gnus-carpal '(summary-carpal 4))
- ("*Shell Command Output*" 1.0)))
- (bug
- (vertical 1.0
- (if gnus-bug-create-help-buffer '("*Gnus Help Bug*" 0.5))
- ("*Gnus Bug*" 1.0 point)))
- (score-trace
- (vertical 1.0
- (summary 0.5 point)
- ("*Score Trace*" 1.0)))
- (score-words
- (vertical 1.0
- (summary 0.5 point)
- ("*Score Words*" 1.0)))
- (split-trace
- (vertical 1.0
- (summary 0.5 point)
- ("*Split Trace*" 1.0)))
- (category
- (vertical 1.0
- (category 1.0)))
- (compose-bounce
- (vertical 1.0
- (article 0.5)
- (message 1.0 point)))
- (display-term
- (vertical 1.0
- ("*display*" 1.0))))
- "Window configuration for all possible Gnus buffers.
-See the Gnus manual for an explanation of the syntax used.")
-
-(defvar gnus-window-to-buffer
- '((group . gnus-group-buffer)
- (summary . gnus-summary-buffer)
- (article . gnus-article-buffer)
- (server . gnus-server-buffer)
- (browse . "*Gnus Browse Server*")
- (edit-group . gnus-group-edit-buffer)
- (edit-form . gnus-edit-form-buffer)
- (edit-server . gnus-server-edit-buffer)
- (group-carpal . gnus-carpal-group-buffer)
- (summary-carpal . gnus-carpal-summary-buffer)
- (server-carpal . gnus-carpal-server-buffer)
- (browse-carpal . gnus-carpal-browse-buffer)
- (edit-score . gnus-score-edit-buffer)
- (message . gnus-message-buffer)
- (mail . gnus-message-buffer)
- (post-news . gnus-message-buffer)
- (faq . gnus-faq-buffer)
- (tree . gnus-tree-buffer)
- (score-trace . "*Score Trace*")
- (split-trace . "*Split Trace*")
- (info . gnus-info-buffer)
- (category . gnus-category-buffer)
- (article-copy . gnus-article-copy)
- (draft . gnus-draft-buffer))
- "Mapping from short symbols to buffer names or buffer variables.")
-
-(defcustom gnus-configure-windows-hook nil
- "*A hook called when configuring windows."
- :version "22.1"
- :group 'gnus-windows
- :type 'hook)
-
-;;; Internal variables.
-
-(defvar gnus-current-window-configuration nil
- "The most recently set window configuration.")
-
-(defvar gnus-created-frames nil)
-(defvar gnus-window-frame-focus nil)
-
-(defun gnus-kill-gnus-frames ()
- "Kill all frames Gnus has created."
- (while gnus-created-frames
- (when (frame-live-p (car gnus-created-frames))
- ;; We slap a condition-case around this `delete-frame' to ensure
- ;; against errors if we try do delete the single frame that's left.
- (ignore-errors
- (delete-frame (car gnus-created-frames))))
- (pop gnus-created-frames)))
-
-(defun gnus-window-configuration-element (list)
- (while (and list
- (not (assq (car list) gnus-window-configuration)))
- (pop list))
- (cadr (assq (car list) gnus-window-configuration)))
-
-(defun gnus-windows-old-to-new (setting)
- ;; First we take care of the really, really old Gnus 3 actions.
- (when (symbolp setting)
- (setq setting
- ;; Take care of ooold GNUS 3.x values.
- (cond ((eq setting 'SelectArticle) 'article)
- ((memq setting '(SelectNewsgroup SelectSubject ExpandSubject))
- 'summary)
- ((memq setting '(ExitNewsgroup)) 'group)
- (t setting))))
- (if (or (listp setting)
- (not (and gnus-window-configuration
- (memq setting '(group summary article)))))
- setting
- (let* ((elem
- (cond
- ((eq setting 'group)
- (gnus-window-configuration-element
- '(group newsgroups ExitNewsgroup)))
- ((eq setting 'summary)
- (gnus-window-configuration-element
- '(summary SelectNewsgroup SelectSubject ExpandSubject)))
- ((eq setting 'article)
- (gnus-window-configuration-element
- '(article SelectArticle)))))
- (total (apply '+ elem))
- (types '(group summary article))
- (pbuf (if (eq setting 'newsgroups) 'group 'summary))
- (i 0)
- perc out)
- (while (< i 3)
- (or (not (numberp (nth i elem)))
- (zerop (nth i elem))
- (progn
- (setq perc (if (= i 2)
- 1.0
- (/ (float (nth i elem)) total)))
- (push (if (eq pbuf (nth i types))
- (list (nth i types) perc 'point)
- (list (nth i types) perc))
- out)))
- (incf i))
- `(vertical 1.0 ,@(nreverse out)))))
-
-;;;###autoload
-(defun gnus-add-configuration (conf)
- "Add the window configuration CONF to `gnus-buffer-configuration'."
- (setq gnus-buffer-configuration
- (cons conf (delq (assq (car conf) gnus-buffer-configuration)
- gnus-buffer-configuration))))
-
-(defvar gnus-frame-list nil)
-
-(defun gnus-window-to-buffer-helper (obj)
- (cond ((not (symbolp obj))
- obj)
- ((boundp obj)
- (symbol-value obj))
- ((fboundp obj)
- (funcall obj))
- (t
- nil)))
-
-(defun gnus-configure-frame (split &optional window)
- "Split WINDOW according to SPLIT."
- (let ((current-window
- (or (get-buffer-window (current-buffer)) (selected-window))))
- (unless window
- (setq window current-window))
- (select-window window)
- ;; This might be an old-style buffer config.
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (symbolp (car split)) (fboundp (car split)))
- (setq split (eval split)))
- (let* ((type (car split))
- (subs (cddr split))
- (len (if (eq type 'horizontal) (window-width) (window-height)))
- (total 0)
- (window-min-width (or gnus-window-min-width window-min-width))
- (window-min-height (or gnus-window-min-height window-min-height))
- s result new-win rest comp-subs size sub)
- (cond
- ;; Nothing to do here.
- ((null split))
- ;; Don't switch buffers.
- ((null type)
- (and (memq 'point split) window))
- ;; This is a buffer to be selected.
- ((not (memq type '(frame horizontal vertical)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer))))))
- (unless buffer
- (error "Invalid buffer type: %s" type))
- (let ((buf (gnus-get-buffer-create
- (gnus-window-to-buffer-helper buffer))))
- (if (eq buf (window-buffer (selected-window))) (set-buffer buf)
- (switch-to-buffer buf)))
- (when (memq 'frame-focus split)
- (setq gnus-window-frame-focus window))
- ;; We return the window if it has the `point' spec.
- (and (memq 'point split) window)))
- ;; This is a frame split.
- ((eq type 'frame)
- (unless gnus-frame-list
- (setq gnus-frame-list (list (window-frame current-window))))
- (let ((i 0)
- params frame fresult)
- (while (< i (length subs))
- ;; Frame parameter is gotten from the sub-split.
- (setq params (cadr (elt subs i)))
- ;; It should be a list.
- (unless (listp params)
- (setq params nil))
- ;; Create a new frame?
- (unless (setq frame (elt gnus-frame-list i))
- (nconc gnus-frame-list (list (setq frame (make-frame params))))
- (push frame gnus-created-frames))
- ;; Is the old frame still alive?
- (unless (frame-live-p frame)
- (setcar (nthcdr i gnus-frame-list)
- (setq frame (make-frame params))))
- ;; Select the frame in question and do more splits there.
- (select-frame frame)
- (setq fresult (or (gnus-configure-frame (elt subs i)) fresult))
- (incf i))
- ;; Select the frame that has the selected buffer.
- (when fresult
- (select-frame (window-frame fresult)))))
- ;; This is a normal split.
- (t
- (when (> (length subs) 0)
- ;; First we have to compute the sizes of all new windows.
- (while subs
- (setq sub (append (pop subs) nil))
- (while (and (not (assq (car sub) gnus-window-to-buffer))
- (symbolp (car sub)) (fboundp (car sub)))
- (setq sub (eval sub)))
- (when sub
- (push sub comp-subs)
- (setq size (cadar comp-subs))
- (cond ((equal size 1.0)
- (setq rest (car comp-subs))
- (setq s 0))
- ((floatp size)
- (setq s (floor (* size len))))
- ((integerp size)
- (setq s size))
- (t
- (error "Invalid size: %s" size)))
- ;; Try to make sure that we are inside the safe limits.
- (cond ((zerop s))
- ((eq type 'horizontal)
- (setq s (max s window-min-width)))
- ((eq type 'vertical)
- (setq s (max s window-min-height))))
- (setcar (cdar comp-subs) s)
- (incf total s)))
- ;; Take care of the "1.0" spec.
- (if rest
- (setcar (cdr rest) (- len total))
- (error "No 1.0 specs in %s" split))
- ;; The we do the actual splitting in a nice recursive
- ;; fashion.
- (setq comp-subs (nreverse comp-subs))
- (while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
- (setq new-win
- (split-window window (cadar comp-subs)
- (eq type 'horizontal))))
- (setq result (or (gnus-configure-frame
- (car comp-subs) window)
- result))
- (select-window new-win)
- (setq window new-win)
- (setq comp-subs (cdr comp-subs))))
- ;; Return the proper window, if any.
- (when result
- (select-window result)))))))
-
-(defvar gnus-frame-split-p nil)
-
-(defun gnus-configure-windows (setting &optional force)
- (if (window-configuration-p setting)
- (set-window-configuration setting)
- (setq gnus-current-window-configuration setting)
- (setq force (or force gnus-always-force-window-configuration))
- (setq setting (gnus-windows-old-to-new setting))
- (let ((split (if (symbolp setting)
- (cadr (assq setting gnus-buffer-configuration))
- setting))
- all-visible)
-
- (setq gnus-frame-split-p nil)
-
- (unless split
- (error "No such setting in `gnus-buffer-configuration': %s" setting))
-
- (if (and (setq all-visible (gnus-all-windows-visible-p split))
- (not force))
- ;; All the windows mentioned are already visible, so we just
- ;; put point in the assigned buffer, and do not touch the
- ;; winconf.
- (select-window all-visible)
-
- ;; Make sure "the other" buffer, nntp-server-buffer, is live.
- (unless (gnus-buffer-live-p nntp-server-buffer)
- (nnheader-init-server-buffer))
-
- ;; Either remove all windows or just remove all Gnus windows.
- (let ((frame (selected-frame)))
- (unwind-protect
- (if gnus-use-full-window
- ;; We want to remove all other windows.
- (if (not gnus-frame-split-p)
- ;; This is not a `frame' split, so we ignore the
- ;; other frames.
- (delete-other-windows)
- ;; This is a `frame' split, so we delete all windows
- ;; on all frames.
- (gnus-delete-windows-in-gnusey-frames))
- ;; Just remove some windows.
- (gnus-remove-some-windows)
- (if (featurep 'xemacs)
- (switch-to-buffer nntp-server-buffer)
- (set-buffer nntp-server-buffer)))
- (select-frame frame)))
-
- (let (gnus-window-frame-focus)
- (if (featurep 'xemacs)
- (switch-to-buffer nntp-server-buffer)
- (set-buffer nntp-server-buffer))
- (gnus-configure-frame split)
- (run-hooks 'gnus-configure-windows-hook)
- (when gnus-window-frame-focus
- (gnus-select-frame-set-input-focus
- (window-frame gnus-window-frame-focus))))))))
-
-(defun gnus-delete-windows-in-gnusey-frames ()
- "Do a `delete-other-windows' in all frames that have Gnus windows."
- (let ((buffers (gnus-buffers)))
- (mapcar
- (lambda (frame)
- (unless (eq (cdr (assq 'minibuffer
- (frame-parameters frame)))
- 'only)
- (select-frame frame)
- (let (do-delete)
- (walk-windows
- (lambda (window)
- (when (memq (window-buffer window) buffers)
- (setq do-delete t))))
- (when do-delete
- (delete-other-windows)))))
- (frame-list))))
-
-(defun gnus-all-windows-visible-p (split)
- "Say whether all buffers in SPLIT are currently visible.
-In particular, the value returned will be the window that
-should have point."
- (let ((stack (list split))
- (all-visible t)
- type buffer win buf)
- (while (and (setq split (pop stack))
- all-visible)
- ;; Be backwards compatible.
- (when (vectorp split)
- (setq split (append split nil)))
- (when (or (consp (car split))
- (vectorp (car split)))
- (push 1.0 split)
- (push 'vertical split))
- ;; The SPLIT might be something that is to be evaled to
- ;; return a new SPLIT.
- (while (and (not (assq (car split) gnus-window-to-buffer))
- (symbolp (car split)) (fboundp (car split)))
- (setq split (eval split)))
-
- (setq type (elt split 0))
- (cond
- ;; Nothing here.
- ((null split) t)
- ;; A buffer.
- ((not (memq type '(horizontal vertical frame)))
- (setq buffer (cond ((stringp type) type)
- (t (cdr (assq type gnus-window-to-buffer)))))
- (unless buffer
- (error "Invalid buffer type: %s" type))
- (if (and (setq buf (get-buffer (gnus-window-to-buffer-helper buffer)))
- (setq win (gnus-get-buffer-window buf t)))
- (if (memq 'point split)
- (setq all-visible win))
- (setq all-visible nil)))
- (t
- (when (eq type 'frame)
- (setq gnus-frame-split-p t))
- (setq stack (append (cddr split) stack)))))
- (unless (eq all-visible t)
- all-visible)))
-
-(defun gnus-window-top-edge (&optional window)
- (nth 1 (window-edges window)))
-
-(defun gnus-remove-some-windows ()
- (let ((buffers (gnus-buffers))
- buf bufs lowest-buf lowest)
- (save-excursion
- ;; Remove windows on all known Gnus buffers.
- (while (setq buf (pop buffers))
- (when (get-buffer-window buf)
- (push buf bufs)
- (pop-to-buffer buf)
- (when (or (not lowest)
- (< (gnus-window-top-edge) lowest))
- (setq lowest (gnus-window-top-edge)
- lowest-buf buf))))
- (when lowest-buf
- (pop-to-buffer lowest-buf)
- (if (featurep 'xemacs)
- (switch-to-buffer nntp-server-buffer)
- (set-buffer nntp-server-buffer)))
- (mapcar (lambda (b) (delete-windows-on b t))
- (delq lowest-buf bufs)))))
-
-(eval-and-compile
- (cond
- ((fboundp 'frames-on-display-list)
- (defalias 'gnus-frames-on-display-list 'frames-on-display-list))
- ((and (featurep 'xemacs) (fboundp 'frame-device))
- (defun gnus-frames-on-display-list ()
- (apply 'filtered-frame-list 'identity (list (frame-device nil)))))
- (t
- (defalias 'gnus-frames-on-display-list 'frame-list))))
-
-(defun gnus-get-buffer-window (buffer &optional frame)
- (cond ((and (null gnus-use-frames-on-any-display)
- (memq frame '(t 0 visible)))
- (car
- (let ((frames (gnus-frames-on-display-list)))
- (gnus-remove-if (lambda (win) (not (memq (window-frame win)
- frames)))
- (get-buffer-window-list buffer nil frame)))))
- (t
- (get-buffer-window buffer frame))))
-
-(provide 'gnus-win)
-
-;; arch-tag: ccd5a394-2ddf-4397-b8f8-6d80d3e46e2b
-;;; gnus-win.el ends here
+++ /dev/null
-;;; gnus-xmas.el --- Gnus functions for XEmacs
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2005, 2006, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (autoload 'gnus-active "gnus" nil nil 'macro)
- (autoload 'gnus-group-entry "gnus" nil nil 'macro)
- (autoload 'gnus-info-level "gnus" nil nil 'macro)
- (autoload 'gnus-info-marks "gnus" nil nil 'macro)
- (autoload 'gnus-info-method "gnus" nil nil 'macro)
- (autoload 'gnus-info-score "gnus" nil nil 'macro))
-
-(require 'text-props)
-(defvar menu-bar-mode (featurep 'menubar))
-(require 'messagexmas)
-(require 'wid-edit)
-
-(defgroup gnus-xmas nil
- "XEmacsoid support for Gnus"
- :group 'gnus)
-
-(defcustom gnus-xmas-glyph-directory nil
- "Directory where Gnus logos and icons are located.
-If this variable is nil, Gnus will try to locate the directory
-automatically."
- :type '(choice (const :tag "autodetect" nil)
- directory)
- :group 'gnus-xmas)
-
-(unless gnus-xmas-glyph-directory
- (unless (setq gnus-xmas-glyph-directory
- (message-xmas-find-glyph-directory "gnus"))
- (error "Can't find glyph directory. \
-Possibly the `etc' directory has not been installed.")))
-
-;;; Internal variables.
-
-;; Don't warn about these undefined variables.
-
-;;defined in gnus.el
-(defvar gnus-active-hashtb)
-(defvar gnus-article-buffer)
-(defvar gnus-auto-center-summary)
-(defvar gnus-current-headers)
-(defvar gnus-level-killed)
-(defvar gnus-level-zombie)
-(defvar gnus-newsgroup-bookmarks)
-(defvar gnus-newsgroup-dependencies)
-(defvar gnus-newsgroup-selected-overlay)
-(defvar gnus-newsrc-hashtb)
-(defvar gnus-read-mark)
-(defvar gnus-refer-article-method)
-(defvar gnus-reffed-article-number)
-(defvar gnus-unread-mark)
-(defvar gnus-version)
-(defvar gnus-view-pseudos)
-(defvar gnus-view-pseudos-separately)
-(defvar gnus-visual)
-(defvar gnus-zombie-list)
-;;defined in gnus-msg.el
-(defvar gnus-article-copy)
-(defvar gnus-check-before-posting)
-;;defined in gnus-vis.el
-(defvar gnus-article-button-face)
-(defvar gnus-article-mouse-face)
-(defvar gnus-summary-selected-face)
-(defvar gnus-group-reading-menu)
-(defvar gnus-group-group-menu)
-(defvar gnus-group-misc-menu)
-(defvar gnus-summary-article-menu)
-(defvar gnus-summary-thread-menu)
-(defvar gnus-summary-misc-menu)
-(defvar gnus-summary-post-menu)
-(defvar gnus-summary-kill-menu)
-(defvar gnus-article-article-menu)
-(defvar gnus-article-treatment-menu)
-(defvar gnus-mouse-2)
-(defvar standard-display-table)
-(defvar gnus-tree-minimize-window)
-
-(defun gnus-xmas-set-text-properties (start end props &optional buffer)
- "You should NEVER use this function. It is ideologically blasphemous.
-It is provided only to ease porting of broken FSF Emacs programs."
- (if (stringp buffer)
- nil
- (map-extents (lambda (extent ignored)
- (remove-text-properties
- start end
- (list (extent-property extent 'text-prop) nil)
- buffer)
- nil)
- buffer start end nil nil 'text-prop)
- (gnus-add-text-properties start end props buffer)))
-
-(defun gnus-xmas-highlight-selected-summary ()
- ;; Highlight selected article in summary buffer
- (when gnus-summary-selected-face
- (when gnus-newsgroup-selected-overlay
- (delete-extent gnus-newsgroup-selected-overlay))
- (setq gnus-newsgroup-selected-overlay
- (make-extent (gnus-point-at-bol) (gnus-point-at-eol)))
- (set-extent-face gnus-newsgroup-selected-overlay
- gnus-summary-selected-face)))
-
-(defcustom gnus-xmas-force-redisplay nil
- "*If non-nil, force a redisplay before recentering the summary buffer.
-This is ugly, but it works around a bug in `window-displayed-height'."
- :type 'boolean
- :group 'gnus-xmas)
-
-(defun gnus-xmas-switch-horizontal-scrollbar-off ()
- (when (featurep 'scrollbar)
- (set-specifier scrollbar-height (cons (current-buffer) 0))))
-
-(defun gnus-xmas-summary-recenter ()
- "\"Center\" point in the summary window.
-If `gnus-auto-center-summary' is nil, or the article buffer isn't
-displayed, no centering will be performed."
- ;; Suggested by earle@mahendo.JPL.NASA.GOV (Greg Earle).
- ;; Recenter only when requested. Suggested by popovich@park.cs.columbia.edu.
- ;; Force redisplay to get properly computed window height.
- (when gnus-xmas-force-redisplay
- (sit-for 0))
- (when gnus-auto-center-summary
- (let* ((height (if (fboundp 'window-displayed-height)
- (window-displayed-height)
- (- (window-height) 2)))
- (top (cond ((< height 4) 0)
- ((< height 7) 1)
- (t (if (numberp gnus-auto-center-summary)
- gnus-auto-center-summary
- 2))))
- (bottom (save-excursion (goto-char (point-max))
- (forward-line (- height))
- (point)))
- (window (get-buffer-window (current-buffer))))
- (when (get-buffer-window gnus-article-buffer)
- ;; Only do recentering when the article buffer is displayed,
- ;; Set the window start to either `bottom', which is the biggest
- ;; possible valid number, or the second line from the top,
- ;; whichever is the least.
- ;; NOFORCE parameter suggested by Daniel Pittman <daniel@danann.net>.
- (set-window-start
- window (min bottom (save-excursion (forward-line (- top)) (point)))
- t))
- ;; Do horizontal recentering while we're at it.
- (when (and (get-buffer-window (current-buffer) t)
- (not (eq gnus-auto-center-summary 'vertical)))
- (let ((selected (selected-window)))
- (select-window (get-buffer-window (current-buffer) t))
- (gnus-summary-position-point)
- (gnus-horizontal-recenter)
- (select-window selected))))))
-
-(defun gnus-xmas-summary-set-display-table ()
- ;; Setup the display table -- like `gnus-summary-setup-display-table',
- ;; but done in an XEmacsish way.
- (let ((table (make-display-table))
- (i 32))
- ;; Nix out all the control chars...
- (while (>= (setq i (1- i)) 0)
- (put-display-table i [??] table))
- ;; ... but not newline and cr, of course. (cr is necessary for the
- ;; selective display).
- (put-display-table ?\n nil table)
- (put-display-table ?\r nil table)
- ;; We keep TAB as well.
- (put-display-table ?\t nil table)
- ;; We nix out any glyphs over 126 below ctl-arrow.
- (let ((i (if (integerp ctl-arrow) ctl-arrow 160)))
- (while (>= (setq i (1- i)) 127)
- (unless (get-display-table i table)
- (put-display-table i [??] table))))
- ;; Can't use `set-specifier' because of a bug in 19.14 and earlier
- (add-spec-to-specifier current-display-table table (current-buffer) nil)))
-
-(defun gnus-xmas-add-text-properties (start end props &optional object)
- (add-text-properties start end props object)
- (put-text-property start end 'start-closed nil object))
-
-(defun gnus-xmas-put-text-property (start end prop value &optional object)
- (put-text-property start end prop value object)
- (put-text-property start end 'start-closed nil object))
-
-(defun gnus-xmas-extent-start-open (point)
- (map-extents (lambda (extent arg)
- (set-extent-property extent 'start-open t))
- nil point (min (1+ (point)) (point-max))))
-
-(defun gnus-xmas-article-push-button (event)
- "Check text under the mouse pointer for a callback function.
-If the text under the mouse pointer has a `gnus-callback' property,
-call it with the value of the `gnus-data' text property."
- (interactive "e")
- (set-buffer (window-buffer (event-window event)))
- (let* ((pos (event-closest-point event))
- (data (get-text-property pos 'gnus-data))
- (fun (get-text-property pos 'gnus-callback)))
- (goto-char pos)
- (when fun
- (funcall fun data))))
-
-(defun gnus-xmas-move-overlay (extent start end &optional buffer)
- (set-extent-endpoints extent start end buffer))
-
-(defun gnus-xmas-kill-all-overlays ()
- "Delete all extents in the current buffer."
- (map-extents (lambda (extent ignore)
- (delete-extent extent)
- nil)))
-
-(defun gnus-xmas-window-top-edge (&optional window)
- (nth 1 (window-pixel-edges window)))
-
-(defun gnus-xmas-tree-minimize ()
- (when (and gnus-tree-minimize-window
- (not (one-window-p)))
- (let* ((window-min-height 2)
- (height (1+ (count-lines (point-min) (point-max))))
- (min (max (1- window-min-height) height))
- (tot (if (numberp gnus-tree-minimize-window)
- (min gnus-tree-minimize-window min)
- min))
- (win (get-buffer-window (current-buffer)))
- (wh (and win (1- (window-height win)))))
- (when (and win
- (not (eq tot wh)))
- (let ((selected (selected-window)))
- (select-window win)
- (enlarge-window (- tot wh))
- (select-window selected))))))
-
-;; Select the lowest window on the frame.
-(defun gnus-xmas-appt-select-lowest-window ()
- (let* ((lowest-window (selected-window))
- (bottom-edge (car (cdr (cdr (cdr (window-pixel-edges))))))
- (last-window (previous-window))
- (window-search t))
- (while window-search
- (let* ((this-window (next-window))
- (next-bottom-edge (car (cdr (cdr (cdr
- (window-pixel-edges
- this-window)))))))
- (when (< bottom-edge next-bottom-edge)
- (setq bottom-edge next-bottom-edge)
- (setq lowest-window this-window))
-
- (select-window this-window)
- (when (eq last-window this-window)
- (select-window lowest-window)
- (setq window-search nil))))))
-
-(defmacro gnus-xmas-menu-add (type &rest menus)
- `(gnus-xmas-menu-add-1 ',type ',menus))
-(put 'gnus-xmas-menu-add 'lisp-indent-function 1)
-
-(defun gnus-xmas-menu-add-1 (type menus)
- (when (and menu-bar-mode
- (gnus-visual-p (intern (format "%s-menu" type)) 'menu))
- (while menus
- (easy-menu-add (symbol-value (pop menus))))))
-
-(defun gnus-xmas-group-menu-add ()
- (gnus-xmas-menu-add group
- gnus-group-reading-menu gnus-group-group-menu gnus-group-misc-menu))
-
-(defun gnus-xmas-summary-menu-add ()
- (gnus-xmas-menu-add summary
- gnus-summary-misc-menu gnus-summary-kill-menu
- gnus-summary-article-menu gnus-summary-thread-menu
- gnus-summary-post-menu ))
-
-(defun gnus-xmas-article-menu-add ()
- (gnus-xmas-menu-add article
- gnus-article-article-menu gnus-article-treatment-menu
- gnus-article-post-menu gnus-article-commands-menu))
-
-(defun gnus-xmas-score-menu-add ()
- (gnus-xmas-menu-add score
- gnus-score-menu))
-
-(defun gnus-xmas-pick-menu-add ()
- (gnus-xmas-menu-add pick
- gnus-pick-menu))
-
-(defun gnus-xmas-topic-menu-add ()
- (gnus-xmas-menu-add topic
- gnus-topic-menu))
-
-(defun gnus-xmas-binary-menu-add ()
- (gnus-xmas-menu-add binary
- gnus-binary-menu))
-
-(defun gnus-xmas-agent-summary-menu-add ()
- (gnus-xmas-menu-add agent-summary
- gnus-agent-summary-menu))
-
-(defun gnus-xmas-agent-group-menu-add ()
- (gnus-xmas-menu-add agent-group
- gnus-agent-group-menu))
-
-(defun gnus-xmas-agent-server-menu-add ()
- (gnus-xmas-menu-add agent-server
- gnus-agent-server-menu))
-
-(defun gnus-xmas-tree-menu-add ()
- (gnus-xmas-menu-add tree
- gnus-tree-menu))
-
-(defun gnus-xmas-draft-menu-add ()
- (gnus-xmas-menu-add draft
- gnus-draft-menu))
-
-(defun gnus-xmas-server-menu-add ()
- (gnus-xmas-menu-add menu
- gnus-server-server-menu gnus-server-connections-menu))
-
-(defun gnus-xmas-browse-menu-add ()
- (gnus-xmas-menu-add browse
- gnus-browse-menu))
-
-(defun gnus-xmas-grouplens-menu-add ()
- (gnus-xmas-menu-add grouplens
- gnus-grouplens-menu))
-
-(defun gnus-xmas-read-event-char (&optional prompt)
- "Get the next event."
- (when prompt
- (message "%s" prompt))
- (let ((event (next-command-event)))
- (sit-for 0)
- ;; We junk all non-key events. Is this naughty?
- (while (not (or (key-press-event-p event)
- (button-press-event-p event)))
- (dispatch-event event)
- (setq event (next-command-event)))
- (cons (and (key-press-event-p event)
- (event-to-character event))
- event)))
-
-(defun gnus-xmas-define ()
- (setq gnus-mouse-2 [button2])
- (setq gnus-mouse-3 [button3])
- (setq gnus-widget-button-keymap widget-button-keymap)
-
- (unless (memq 'underline (face-list))
- (and (fboundp 'make-face)
- (funcall (intern "make-face") 'underline)))
- ;; Must avoid calling set-face-underline-p directly, because it
- ;; is a defsubst in emacs19, and will make the .elc files non
- ;; portable!
- (unless (face-differs-from-default-p 'underline)
- (funcall (intern "set-face-underline-p") 'underline t))
-
- (cond
- ((fboundp 'char-or-char-int-p)
- ;; Handle both types of marks for XEmacs-20.x.
- (defalias 'gnus-characterp 'char-or-char-int-p))
- ;; V19 of XEmacs, probably.
- (t
- (defalias 'gnus-characterp 'characterp)))
-
- (defalias 'gnus-make-overlay 'make-extent)
- (defalias 'gnus-delete-overlay 'delete-extent)
- (defalias 'gnus-overlay-put 'set-extent-property)
- (defalias 'gnus-move-overlay 'gnus-xmas-move-overlay)
- (defalias 'gnus-overlay-buffer 'extent-object)
- (defalias 'gnus-overlay-start 'extent-start-position)
- (defalias 'gnus-overlay-end 'extent-end-position)
- (defalias 'gnus-kill-all-overlays 'gnus-xmas-kill-all-overlays)
- (defalias 'gnus-extent-detached-p 'extent-detached-p)
- (defalias 'gnus-add-text-properties 'gnus-xmas-add-text-properties)
- (defalias 'gnus-put-text-property 'gnus-xmas-put-text-property)
- (defalias 'gnus-deactivate-mark 'ignore)
- (defalias 'gnus-window-edges 'window-pixel-edges)
- (defalias 'gnus-assq-delete-all 'gnus-xmas-assq-delete-all)
-
- (if (and (<= emacs-major-version 19)
- (< emacs-minor-version 14))
- (defalias 'gnus-set-text-properties 'gnus-xmas-set-text-properties))
-
- (unless (boundp 'standard-display-table)
- (setq standard-display-table nil))
-
- (defvar gnus-mouse-face-prop 'highlight)
-
- (defun gnus-byte-code (func)
- "Return a form that can be `eval'ed based on FUNC."
- (let ((fval (indirect-function func)))
- (if (compiled-function-p fval)
- (list 'funcall fval)
- (cons 'progn (cdr (cdr fval))))))
-
- (unless (fboundp 'match-string-no-properties)
- (defalias 'match-string-no-properties 'match-string))
-
- (defalias 'gnus-x-color-values
- (if (fboundp 'x-color-values)
- 'x-color-values
- (lambda (color)
- (color-instance-rgb-components
- (make-color-instance color))))))
-
-(defun gnus-xmas-redefine ()
- "Redefine lots of Gnus functions for XEmacs."
- (defalias 'gnus-summary-set-display-table 'gnus-xmas-summary-set-display-table)
- (defalias 'gnus-visual-turn-off-edit-menu 'identity)
- (defalias 'gnus-summary-recenter 'gnus-xmas-summary-recenter)
- (defalias 'gnus-extent-start-open 'gnus-xmas-extent-start-open)
- (defalias 'gnus-article-push-button 'gnus-xmas-article-push-button)
- (defalias 'gnus-window-top-edge 'gnus-xmas-window-top-edge)
- (defalias 'gnus-read-event-char 'gnus-xmas-read-event-char)
- (defalias 'gnus-group-startup-message 'gnus-xmas-group-startup-message)
- (defalias 'gnus-tree-minimize 'gnus-xmas-tree-minimize)
- (defalias 'gnus-appt-select-lowest-window
- 'gnus-xmas-appt-select-lowest-window)
- (defalias 'gnus-mail-strip-quoted-names 'gnus-xmas-mail-strip-quoted-names)
- (defalias 'gnus-character-to-event 'character-to-event)
- (defalias 'gnus-mode-line-buffer-identification
- 'gnus-xmas-mode-line-buffer-identification)
- (defalias 'gnus-key-press-event-p 'key-press-event-p)
- (defalias 'gnus-region-active-p 'region-active-p)
- (defalias 'gnus-mark-active-p 'region-exists-p)
- (defalias 'gnus-annotation-in-region-p 'gnus-xmas-annotation-in-region-p)
- (defalias 'gnus-mime-button-menu 'gnus-xmas-mime-button-menu)
- (defalias 'gnus-image-type-available-p 'gnus-xmas-image-type-available-p)
- (defalias 'gnus-put-image 'gnus-xmas-put-image)
- (defalias 'gnus-create-image 'gnus-xmas-create-image)
- (defalias 'gnus-remove-image 'gnus-xmas-remove-image)
-
- (when (or (< emacs-major-version 21)
- (and (= emacs-major-version 21)
- (< emacs-minor-version 3)))
- (defalias 'gnus-completing-read 'gnus-xmas-completing-read))
-
- ;; These ones are not defcutom'ed, sometimes not even defvar'ed. They
- ;; probably should. If that is done, the code below should then be moved
- ;; where each variable is defined, in order not to mess with user settings.
- ;; -- didier
- (add-hook 'gnus-score-mode-hook 'gnus-xmas-score-menu-add)
- (add-hook 'gnus-binary-mode-hook 'gnus-xmas-binary-menu-add)
- (add-hook 'gnus-grouplens-mode-hook 'gnus-xmas-grouplens-menu-add)
- (add-hook 'gnus-server-mode-hook 'gnus-xmas-server-menu-add)
- (add-hook 'gnus-browse-mode-hook 'gnus-xmas-browse-menu-add)
- (add-hook 'gnus-draft-mode-hook 'gnus-xmas-draft-menu-add)
- (add-hook 'gnus-mailing-list-mode-hook 'gnus-xmas-mailing-list-menu-add))
-
-
-;;; XEmacs logo and toolbar.
-
-(defun gnus-xmas-group-startup-message (&optional x y)
- "Insert startup message in current buffer."
- ;; Insert the message.
- (erase-buffer)
- (cond
- ((and (console-on-window-system-p)
- (or (featurep 'xpm)
- (featurep 'xbm)))
- (let* ((logo-xpm (expand-file-name "gnus.xpm" gnus-xmas-glyph-directory))
- (logo-xbm (expand-file-name "gnus.xbm" gnus-xmas-glyph-directory))
- (glyph (make-glyph
- (cond ((featurep 'xpm)
- `[xpm
- :file ,logo-xpm
- :color-symbols
- (("thing" . ,(car gnus-logo-colors))
- ("shadow" . ,(cadr gnus-logo-colors))
- ("oort" . "#eeeeee")
- ("background" . ,(face-background 'default)))])
- ((featurep 'xbm)
- `[xbm :file ,logo-xbm])
- (t [nothing])))))
- (insert " ")
- (set-extent-begin-glyph (make-extent (point) (point)) glyph)
- (goto-char (point-min))
- (while (not (eobp))
- (insert (make-string (/ (max (- (window-width) (or x 35)) 0) 2)
- ?\ ))
- (forward-line 1))
- (setq gnus-simple-splash nil))
- (goto-char (point-min))
- (let* ((pheight (+ 20 (count-lines (point-min) (point-max))))
- (wheight (window-height))
- (rest (- wheight pheight)))
- (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n))))
- (t
- (insert
- (format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
-
-"
- ""))
- ;; And then hack it.
- (gnus-indent-rigidly (point-min) (point-max)
- (/ (max (- (window-width) (or x 46)) 0) 2))
- (goto-char (point-min))
- (forward-line 1)
- (let* ((pheight (count-lines (point-min) (point-max)))
- (wheight (window-height))
- (rest (- wheight pheight)))
- (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
- ;; Paint it.
- (put-text-property (point-min) (point-max) 'face 'gnus-splash)))
- (setq modeline-buffer-identification
- (list (concat gnus-version ": *Group*")))
- (set-buffer-modified-p t))
-
-
-;;; The toolbar.
-
-(defun gnus-xmas-update-toolbars ()
- "Update the toolbars' appearance."
- (when (and (not noninteractive)
- (featurep 'gnus-xmas))
- (save-excursion
- (dolist (buffer (buffer-list))
- (set-buffer buffer)
- (cond ((eq major-mode 'gnus-group-mode)
- (gnus-xmas-setup-group-toolbar))
- ((eq major-mode 'gnus-summary-mode)
- (gnus-xmas-setup-summary-toolbar)))))))
-
-(defcustom gnus-use-toolbar (if (featurep 'toolbar) 'default)
- "*Position to display the toolbar. Nil means do not use a toolbar.
-If it is non-nil, it should be one of the symbols `default', `top',
-`bottom', `right', and `left'. `default' means to use the default
-toolbar, the rest mean to display the toolbar on the place which those
-names show."
- :type '(choice (const default)
- (const top) (const bottom) (const left) (const right)
- (const :tag "no toolbar" nil))
- :set (lambda (symbol value)
- (set-default
- symbol
- (if (or (not value)
- (memq value (list 'default 'top 'bottom 'right 'left)))
- value
- 'default))
- (gnus-xmas-update-toolbars))
- :group 'gnus-xmas)
-
-(defcustom gnus-toolbar-thickness
- (if (featurep 'toolbar)
- (cons (specifier-instance default-toolbar-height)
- (specifier-instance default-toolbar-width)))
- "*Cons of the height and the width specifying the thickness of a toolbar.
-The height is used for the toolbar displayed on the top or the bottom,
-the width is used for the toolbar displayed on the right or the left."
- :type '(cons :tag "height & width"
- (integer :tag "height") (integer :tag "width"))
- :set (lambda (symbol value)
- (set-default
- symbol
- (if (and (consp value) (natnump (car value)) (natnump (cdr value)))
- value
- '(37 . 40)))
- (gnus-xmas-update-toolbars))
- :group 'gnus-xmas)
-
-(defvar gnus-group-toolbar
- '([gnus-group-get-new-news gnus-group-get-new-news t "Get new news"]
- [gnus-group-get-new-news-this-group
- gnus-group-get-new-news-this-group t "Get new news in this group"]
- [gnus-group-catchup-current
- gnus-group-catchup-current t "Catchup group"]
- [gnus-group-describe-group
- gnus-group-describe-group t "Describe group"]
- [gnus-group-unsubscribe gnus-group-unsubscribe t "Unsubscribe group"]
- [gnus-group-subscribe gnus-group-subscribe t "Subscribe group"]
- [gnus-group-kill-group gnus-group-kill-group t "Kill group"]
- [gnus-summary-mail-save
- gnus-group-save-newsrc t "Save .newsrc files"] ; borrowed icon.
- [gnus-group-exit gnus-group-exit t "Exit Gnus"])
- "The group buffer toolbar.")
-
-(defvar gnus-summary-toolbar
- '([gnus-summary-prev-unread
- gnus-summary-prev-page-or-article t "Page up"]
- [gnus-summary-next-unread
- gnus-summary-next-page t "Page down"]
- [gnus-summary-post-news
- gnus-summary-post-news t "Post an article"]
- [gnus-summary-followup-with-original
- gnus-summary-followup-with-original t
- "Post a followup and yank the original"]
- [gnus-summary-followup
- gnus-summary-followup t "Post a followup"]
- [gnus-summary-reply-with-original
- gnus-summary-reply-with-original t "Mail a reply and yank the original"]
- [gnus-summary-reply
- gnus-summary-reply t "Mail a reply"]
- [gnus-summary-caesar-message
- gnus-summary-caesar-message t "Rot 13"]
- [gnus-uu-decode-uu
- gnus-uu-decode-uu t "Decode uuencoded articles"]
- [gnus-summary-save-article-file
- gnus-summary-save-article-file t "Save article in file"]
- [gnus-summary-save-article
- gnus-summary-save-article t "Save article"]
- [gnus-uu-post-news
- gnus-uu-post-news t "Post a uuencoded article"]
- [gnus-summary-cancel-article
- gnus-summary-cancel-article t "Cancel article"]
- [gnus-summary-catchup
- gnus-summary-catchup t "Catchup"]
- [gnus-summary-catchup-and-exit
- gnus-summary-catchup-and-exit t "Catchup and exit"]
- [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
- "The summary buffer toolbar.")
-
-(defvar gnus-summary-mail-toolbar
- '(
- [gnus-summary-prev-unread
- gnus-summary-prev-unread-article t "Prev unread article"]
- [gnus-summary-next-unread
- gnus-summary-next-unread-article t "Next unread article"]
- [gnus-summary-mail-reply gnus-summary-reply t "Reply"]
- [gnus-summary-mail-originate gnus-summary-post-news t "Originate"]
- [gnus-summary-mail-save gnus-summary-save-article t "Save"]
- [gnus-summary-mail-copy gnus-summary-copy-article t "Copy message"]
- [gnus-summary-mail-forward gnus-summary-mail-forward t "Forward message"]
- [gnus-summary-caesar-message
- gnus-summary-caesar-message t "Rot 13"]
- [gnus-uu-decode-uu
- gnus-uu-decode-uu t "Decode uuencoded articles"]
- [gnus-summary-save-article-file
- gnus-summary-save-article-file t "Save article in file"]
- [gnus-summary-save-article
- gnus-summary-save-article t "Save article"]
- [gnus-summary-cancel-article ; usenet : cancellation :: mail : deletion.
- gnus-summary-delete-article t "Delete message"]
- [gnus-summary-catchup
- gnus-summary-catchup t "Catchup"]
- [gnus-summary-catchup-and-exit
- gnus-summary-catchup-and-exit t "Catchup and exit"]
- [gnus-summary-exit gnus-summary-exit t "Exit this summary"])
- "The summary buffer mail toolbar.")
-
-(defun gnus-xmas-setup-toolbar (toolbar)
- (when (featurep 'toolbar)
- (if (and gnus-use-toolbar
- (message-xmas-setup-toolbar toolbar nil "gnus"))
- (let ((bar (or (intern-soft (format "%s-toolbar" gnus-use-toolbar))
- 'default-toolbar))
- (height (car gnus-toolbar-thickness))
- (width (cdr gnus-toolbar-thickness))
- (cur (current-buffer))
- bars)
- (set-specifier (symbol-value bar) toolbar cur)
- (set-specifier default-toolbar-height height cur)
- (set-specifier default-toolbar-width width cur)
- (set-specifier top-toolbar-height height cur)
- (set-specifier bottom-toolbar-height height cur)
- (set-specifier right-toolbar-width width cur)
- (set-specifier left-toolbar-width width cur)
- (if (eq bar 'default-toolbar)
- (progn
- (remove-specifier default-toolbar-visible-p cur)
- (remove-specifier top-toolbar cur)
- (remove-specifier top-toolbar-visible-p cur)
- (remove-specifier bottom-toolbar cur)
- (remove-specifier bottom-toolbar-visible-p cur)
- (remove-specifier right-toolbar cur)
- (remove-specifier right-toolbar-visible-p cur)
- (remove-specifier left-toolbar cur)
- (remove-specifier left-toolbar-visible-p cur))
- (set-specifier (symbol-value (intern (format "%s-visible-p" bar)))
- t cur)
- (setq bars (delq bar (list 'default-toolbar
- 'bottom-toolbar 'top-toolbar
- 'right-toolbar 'left-toolbar)))
- (while bars
- (set-specifier (symbol-value (intern (format "%s-visible-p"
- (pop bars))))
- nil cur))))
- (let ((cur (current-buffer)))
- (set-specifier default-toolbar-visible-p nil cur)
- (set-specifier top-toolbar-visible-p nil cur)
- (set-specifier bottom-toolbar-visible-p nil cur)
- (set-specifier right-toolbar-visible-p nil cur)
- (set-specifier left-toolbar-visible-p nil cur)))))
-
-(defun gnus-xmas-setup-group-toolbar ()
- (gnus-xmas-setup-toolbar gnus-group-toolbar))
-
-(defun gnus-xmas-setup-summary-toolbar ()
- (gnus-xmas-setup-toolbar (if (gnus-news-group-p gnus-newsgroup-name)
- gnus-summary-toolbar
- gnus-summary-mail-toolbar)))
-
-(defun gnus-xmas-mail-strip-quoted-names (address)
- "Protect mail-strip-quoted-names from nil input.
-XEmacs compatibility workaround."
- (if (null address)
- nil
- (mail-strip-quoted-names address)))
-
-(defun gnus-xmas-call-region (command &rest args)
- (apply
- 'call-process-region (point-min) (point-max) command t '(t nil) nil
- args))
-
-(defvar gnus-xmas-modeline-left-extent
- (let ((ext (copy-extent modeline-buffer-id-left-extent)))
- ext))
-
-(defvar gnus-xmas-modeline-right-extent
- (let ((ext (copy-extent modeline-buffer-id-right-extent)))
- ext))
-
-(defvar gnus-xmas-modeline-glyph
- (progn
- (let* ((file-xpm (expand-file-name "gnus-pointer.xpm"
- gnus-xmas-glyph-directory))
- (file-xbm (expand-file-name "gnus-pointer.xbm"
- gnus-xmas-glyph-directory))
- (glyph (make-glyph
- ;; Gag gag gag.
- (cond ((featurep 'xpm)
- ;; Let's try a nifty XPM
- `[xpm :file ,file-xpm])
- ((featurep 'xbm)
- ;; Then a not-so-nifty XBM
- `[xbm :file ,file-xbm])
- ;; Then the simple string
- (t [string :data "Gnus:"])))))
- (set-glyph-face glyph 'modeline-buffer-id)
- glyph)))
-
-(defun gnus-xmas-mode-line-buffer-identification (line)
- (let ((line (car line))
- chop)
- (cond
- ;; This is some weird type of id.
- ((not (stringp line))
- (list line))
- ;; This is non-standard, so we just pass it through.
- ((not (string-match "^Gnus:" line))
- (list line))
- ;; We have a standard line, so we colorize and glyphize it a bit.
- (t
- (setq chop (match-end 0))
- (list
- (if gnus-xmas-modeline-glyph
- (cons gnus-xmas-modeline-left-extent gnus-xmas-modeline-glyph)
- (cons gnus-xmas-modeline-left-extent (substring line 0 chop)))
- (cons gnus-xmas-modeline-right-extent (substring line chop)))))))
-
-(defun gnus-xmas-splash ()
- (when (eq (device-type) 'x)
- (gnus-splash)))
-
-(defun gnus-xmas-annotation-in-region-p (b e)
- (or (map-extents (lambda (e u) t) nil b e nil nil 'mm t)
- (if (= b e)
- (eq (cadr (memq 'gnus-undeletable (text-properties-at b))) t)
- (text-property-any b e 'gnus-undeletable t))))
-
-(defun gnus-xmas-mime-button-menu (event prefix)
- "Construct a context-sensitive menu of MIME commands."
- (interactive "e\nP")
- (let ((response (get-popup-menu-response
- `("MIME Part"
- ,@(mapcar (lambda (c) `[,(caddr c) ,(car c) t])
- gnus-mime-button-commands)))))
- (set-buffer (event-buffer event))
- (goto-char (event-point event))
- (funcall (event-function response) (event-object response))))
-
-(defun gnus-group-add-icon ()
- "Add an icon to the current line according to `gnus-group-icon-list'."
- (let* ((p (point))
- (end (gnus-point-at-eol))
- ;; now find out where the line starts and leave point there.
- (beg (progn (beginning-of-line) (point))))
- (save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
- (when (search-forward "==&&==" nil t)
- (let* ((group (gnus-group-group-name))
- (entry (gnus-group-entry group))
- (unread (if (numberp (car entry)) (car entry) 0))
- (active (gnus-active group))
- (total (if active (1+ (- (cdr active) (car active))) 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 (or (gnus-info-level info) gnus-level-killed))
- (score (or (gnus-info-score info) 0))
- (ticked (gnus-range-length (cdr (assq 'tick marked))))
- (group-age (gnus-group-timestamp-delta group))
- (inhibit-read-only t)
- (list gnus-group-icon-list)
- (mystart (match-beginning 0))
- (myend (match-end 0)))
- (goto-char (point-min))
- (while (and list
- (not (eval (caar list))))
- (setq list (cdr list)))
- (if list
- (let* ((file (cdar list))
- (glyph (gnus-group-icon-create-glyph
- (buffer-substring mystart myend)
- file)))
- (if glyph
- (progn
- (mapcar 'delete-annotation (annotations-at myend))
- (let ((ext (make-extent mystart myend))
- (ant (make-annotation glyph myend 'text)))
- ;; set text extent params
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'start-open t)
- (set-extent-property ext 'invisible t)))
- (delete-region mystart myend)))
- (delete-region mystart myend))))
- (widen))
- (goto-char p)))
-
-(defun gnus-group-icon-create-glyph (substring pixmap)
- "Create a glyph for insertion into a group line."
- (or
- (cdr-safe (assoc pixmap gnus-group-icon-cache))
- (let* ((glyph (make-glyph
- (list
- (cons 'x
- (expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'mswindows
- (expand-file-name pixmap gnus-xmas-glyph-directory))
- (cons 'tty substring)))))
- (setq gnus-group-icon-cache
- (cons (cons pixmap glyph) gnus-group-icon-cache))
- (set-glyph-face glyph 'default)
- glyph)))
-
-(defun gnus-xmas-mailing-list-menu-add ()
- (gnus-xmas-menu-add mailing-list
- gnus-mailing-list-menu))
-
-(defun gnus-xmas-image-type-available-p (type)
- (and (if (fboundp 'display-images-p)
- (display-images-p)
- window-system)
- (featurep (if (eq type 'pbm) 'xbm type))))
-
-(defun gnus-xmas-create-image (file &optional type data-p &rest props)
- (let ((type (if type
- (symbol-name type)
- (car (last (split-string file "[.]")))))
- (face (plist-get props :face))
- glyph)
- (when (equal type "pbm")
- (with-temp-buffer
- (if data-p
- (insert file)
- (insert-file-contents-literally file))
- (shell-command-on-region (point-min) (point-max)
- "ppmtoxpm 2>/dev/null" t)
- (setq file (buffer-string)
- type "xpm"
- data-p t)))
- (setq glyph
- (if (equal type "xbm")
- (make-glyph (list (cons 'x file)))
- (with-temp-buffer
- (if data-p
- (insert file)
- (insert-file-contents-literally file))
- (make-glyph
- (vector
- (or (intern type)
- (mm-image-type-from-buffer))
- :data (buffer-string))))))
- (when face
- (set-glyph-face glyph face))
- glyph))
-
-(defun gnus-xmas-put-image (glyph &optional string category)
- "Insert STRING, but display GLYPH.
-Warning: Don't insert text immediately after the image."
- (let ((begin (point))
- extent)
- (if (and (bobp) (not string))
- (setq string " "))
- (if string
- (insert string)
- (setq begin (1- begin)))
- (setq extent (make-extent begin (point)))
- (set-extent-property extent 'gnus-image category)
- (set-extent-property extent 'duplicable t)
- (if string
- (set-extent-property extent 'invisible t))
- (set-extent-property extent 'end-glyph glyph))
- glyph)
-
-(defun gnus-xmas-remove-image (image &optional category)
- (map-extents
- (lambda (ext unused)
- (when (equal (extent-end-glyph ext) image)
- (set-extent-property ext 'invisible nil)
- (set-extent-property ext 'end-glyph nil))
- nil)
- nil nil nil nil nil 'gnus-image category))
-
-(defun gnus-xmas-completing-read (prompt table &optional
- predicate require-match history)
- (when (and history
- (not (boundp history)))
- (set history nil))
- (completing-read
- (if (symbol-value history)
- (concat prompt " (" (car (symbol-value history)) "): ")
- (concat prompt ": "))
- table
- predicate
- require-match
- nil
- history))
-
-;; This macro is because XEmacs versions prior to 21.2 do not have the
-;; PROTOCOL argument to `open-network-stream'.
-(defmacro gnus-xmas-open-network-stream (name buffer host service &optional protocol)
- "Like `open-network-stream' but take into account older XEmacs versions."
- (if (and (featurep 'xemacs)
- (fboundp 'open-network-stream)
- (emacs-version>= 21 2))
- `(open-network-stream ,name ,buffer ,host ,service ,protocol)
- `(open-network-stream ,name ,buffer ,host ,service)))
-
-(defun gnus-xmas-assq-delete-all (key alist)
- (let ((elem nil))
- (while (setq elem (assq key alist))
- (setq alist (delq elem alist)))
- alist))
-
-(provide 'gnus-xmas)
-
-;;; arch-tag: 4e84de3f-ea0a-4ee3-bfeb-e03d46fcacef
-;;; gnus-xmas.el ends here
+++ /dev/null
-;;; gnus.el --- a newsreader for GNU Emacs
-
-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval '(run-hooks 'gnus-load-hook))
-
-(eval-when-compile (require 'cl))
-(require 'wid-edit)
-(require 'mm-util)
-(require 'nnheader)
-
-;; These are defined afterwards with gnus-define-group-parameter
-(defvar gnus-ham-process-destinations)
-(defvar gnus-parameter-ham-marks-alist)
-(defvar gnus-parameter-spam-marks-alist)
-(defvar gnus-spam-autodetect)
-(defvar gnus-spam-autodetect-methods)
-(defvar gnus-spam-newsgroup-contents)
-(defvar gnus-spam-process-destinations)
-(defvar gnus-spam-process-newsgroups)
-
-
-(defgroup gnus nil
- "The coffee-brewing, all singing, all dancing, kitchen sink newsreader."
- :group 'news
- :group 'mail)
-
-(defgroup gnus-start nil
- "Starting your favorite newsreader."
- :group 'gnus)
-
-(defgroup gnus-format nil
- "Dealing with formatting issues."
- :group 'gnus)
-
-(defgroup gnus-charset nil
- "Group character set issues."
- :link '(custom-manual "(gnus)Charsets")
- :version "21.1"
- :group 'gnus)
-
-(defgroup gnus-cache nil
- "Cache interface."
- :link '(custom-manual "(gnus)Article Caching")
- :group 'gnus)
-
-(defgroup gnus-registry nil
- "Article Registry."
- :group 'gnus)
-
-(defgroup gnus-start-server nil
- "Server options at startup."
- :group 'gnus-start)
-
-;; These belong to gnus-group.el.
-(defgroup gnus-group nil
- "Group buffers."
- :link '(custom-manual "(gnus)Group Buffer")
- :group 'gnus)
-
-(defgroup gnus-group-foreign nil
- "Foreign groups."
- :link '(custom-manual "(gnus)Foreign Groups")
- :group 'gnus-group)
-
-(defgroup gnus-group-new nil
- "Automatic subscription of new groups."
- :group 'gnus-group)
-
-(defgroup gnus-group-levels nil
- "Group levels."
- :link '(custom-manual "(gnus)Group Levels")
- :group 'gnus-group)
-
-(defgroup gnus-group-select nil
- "Selecting a Group."
- :link '(custom-manual "(gnus)Selecting a Group")
- :group 'gnus-group)
-
-(defgroup gnus-group-listing nil
- "Showing slices of the group list."
- :link '(custom-manual "(gnus)Listing Groups")
- :group 'gnus-group)
-
-(defgroup gnus-group-visual nil
- "Sorting the group buffer."
- :link '(custom-manual "(gnus)Group Buffer Format")
- :group 'gnus-group
- :group 'gnus-visual)
-
-(defgroup gnus-group-various nil
- "Various group options."
- :link '(custom-manual "(gnus)Scanning New Messages")
- :group 'gnus-group)
-
-;; These belong to gnus-sum.el.
-(defgroup gnus-summary nil
- "Summary buffers."
- :link '(custom-manual "(gnus)Summary Buffer")
- :group 'gnus)
-
-(defgroup gnus-summary-exit nil
- "Leaving summary buffers."
- :link '(custom-manual "(gnus)Exiting the Summary Buffer")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-marks nil
- "Marks used in summary buffers."
- :link '(custom-manual "(gnus)Marking Articles")
- :group 'gnus-summary)
-
-(defgroup gnus-thread nil
- "Ordering articles according to replies."
- :link '(custom-manual "(gnus)Threading")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-format nil
- "Formatting of the summary buffer."
- :link '(custom-manual "(gnus)Summary Buffer Format")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-choose nil
- "Choosing Articles."
- :link '(custom-manual "(gnus)Choosing Articles")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-maneuvering nil
- "Summary movement commands."
- :link '(custom-manual "(gnus)Summary Maneuvering")
- :group 'gnus-summary)
-
-(defgroup gnus-picon nil
- "Show pictures of people, domains, and newsgroups."
- :group 'gnus-visual)
-
-(defgroup gnus-summary-mail nil
- "Mail group commands."
- :link '(custom-manual "(gnus)Mail Group Commands")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-sort nil
- "Sorting the summary buffer."
- :link '(custom-manual "(gnus)Sorting the Summary Buffer")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-visual nil
- "Highlighting and menus in the summary buffer."
- :link '(custom-manual "(gnus)Summary Highlighting")
- :group 'gnus-visual
- :group 'gnus-summary)
-
-(defgroup gnus-summary-various nil
- "Various summary buffer options."
- :link '(custom-manual "(gnus)Various Summary Stuff")
- :group 'gnus-summary)
-
-(defgroup gnus-summary-pick nil
- "Pick mode in the summary buffer."
- :link '(custom-manual "(gnus)Pick and Read")
- :prefix "gnus-pick-"
- :group 'gnus-summary)
-
-(defgroup gnus-summary-tree nil
- "Tree display of threads in the summary buffer."
- :link '(custom-manual "(gnus)Tree Display")
- :prefix "gnus-tree-"
- :group 'gnus-summary)
-
-;; Belongs to gnus-uu.el
-(defgroup gnus-extract-view nil
- "Viewing extracted files."
- :link '(custom-manual "(gnus)Viewing Files")
- :group 'gnus-extract)
-
-;; Belongs to gnus-score.el
-(defgroup gnus-score nil
- "Score and kill file handling."
- :group 'gnus)
-
-(defgroup gnus-score-kill nil
- "Kill files."
- :group 'gnus-score)
-
-(defgroup gnus-score-adapt nil
- "Adaptive score files."
- :group 'gnus-score)
-
-(defgroup gnus-score-default nil
- "Default values for score files."
- :group 'gnus-score)
-
-(defgroup gnus-score-expire nil
- "Expiring score rules."
- :group 'gnus-score)
-
-(defgroup gnus-score-decay nil
- "Decaying score rules."
- :group 'gnus-score)
-
-(defgroup gnus-score-files nil
- "Score and kill file names."
- :group 'gnus-score
- :group 'gnus-files)
-
-(defgroup gnus-score-various nil
- "Various scoring and killing options."
- :group 'gnus-score)
-
-;; Other
-(defgroup gnus-visual nil
- "Options controlling the visual fluff."
- :group 'gnus
- :group 'faces)
-
-(defgroup gnus-agent nil
- "Offline support for Gnus."
- :group 'gnus)
-
-(defgroup gnus-files nil
- "Files used by Gnus."
- :group 'gnus)
-
-(defgroup gnus-dribble-file nil
- "Auto save file."
- :link '(custom-manual "(gnus)Auto Save")
- :group 'gnus-files)
-
-(defgroup gnus-newsrc nil
- "Storing Gnus state."
- :group 'gnus-files)
-
-(defgroup gnus-server nil
- "Options related to newsservers and other servers used by Gnus."
- :group 'gnus)
-
-(defgroup gnus-server-visual nil
- "Highlighting and menus in the server buffer."
- :group 'gnus-visual
- :group 'gnus-server)
-
-(defgroup gnus-message '((message custom-group))
- "Composing replies and followups in Gnus."
- :group 'gnus)
-
-(defgroup gnus-meta nil
- "Meta variables controlling major portions of Gnus.
-In general, modifying these variables does not take affect until Gnus
-is restarted, and sometimes reloaded."
- :group 'gnus)
-
-(defgroup gnus-various nil
- "Other Gnus options."
- :link '(custom-manual "(gnus)Various Various")
- :group 'gnus)
-
-(defgroup gnus-exit nil
- "Exiting Gnus."
- :link '(custom-manual "(gnus)Exiting Gnus")
- :group 'gnus)
-
-(defgroup gnus-fun nil
- "Frivolous Gnus extensions."
- :link '(custom-manual "(gnus)Exiting Gnus")
- :group 'gnus)
-
-(defconst gnus-version-number "5.10.10"
- "Version number for this version of Gnus.")
-
-(defconst gnus-version (format "Gnus v%s" gnus-version-number)
- "Version string for this version of Gnus.")
-
-(defcustom gnus-inhibit-startup-message nil
- "If non-nil, the startup message will not be displayed.
-This variable is used before `.gnus.el' is loaded, so it should
-be set in `.emacs' instead."
- :group 'gnus-start
- :type 'boolean)
-
-(defcustom gnus-play-startup-jingle nil
- "If non-nil, play the Gnus jingle at startup."
- :group 'gnus-start
- :type 'boolean)
-
-(unless (fboundp 'gnus-group-remove-excess-properties)
- (defalias 'gnus-group-remove-excess-properties 'ignore))
-
-(unless (fboundp 'gnus-set-text-properties)
- (defalias 'gnus-set-text-properties 'set-text-properties))
-
-(unless (featurep 'gnus-xmas)
- (defalias 'gnus-make-overlay 'make-overlay)
- (defalias 'gnus-delete-overlay 'delete-overlay)
- (defalias 'gnus-overlay-put 'overlay-put)
- (defalias 'gnus-move-overlay 'move-overlay)
- (defalias 'gnus-overlay-buffer 'overlay-buffer)
- (defalias 'gnus-overlay-start 'overlay-start)
- (defalias 'gnus-overlay-end 'overlay-end)
- (defalias 'gnus-extent-detached-p 'ignore)
- (defalias 'gnus-extent-start-open 'ignore)
- (defalias 'gnus-appt-select-lowest-window 'appt-select-lowest-window)
- (defalias 'gnus-mail-strip-quoted-names 'mail-strip-quoted-names)
- (defalias 'gnus-character-to-event 'identity)
- (defalias 'gnus-assq-delete-all 'assq-delete-all)
- (defalias 'gnus-add-text-properties 'add-text-properties)
- (defalias 'gnus-put-text-property 'put-text-property)
- (defvar gnus-mode-line-image-cache t)
- (if (fboundp 'find-image)
- (defun gnus-mode-line-buffer-identification (line)
- (let ((str (car-safe line))
- (load-path (mm-image-load-path)))
- (if (and (stringp str)
- (string-match "^Gnus:" str))
- (progn (add-text-properties
- 0 5
- (list 'display
- (if (eq t gnus-mode-line-image-cache)
- (setq gnus-mode-line-image-cache
- (find-image
- '((:type xpm :file "gnus-pointer.xpm"
- :ascent center)
- (:type xbm :file "gnus-pointer.xbm"
- :ascent center))))
- gnus-mode-line-image-cache)
- 'help-echo (format
- "This is %s, %s."
- gnus-version (gnus-emacs-version)))
- str)
- (list str))
- line)))
- (defalias 'gnus-mode-line-buffer-identification 'identity))
- (defalias 'gnus-characterp 'numberp)
- (defalias 'gnus-deactivate-mark 'deactivate-mark)
- (defalias 'gnus-window-edges 'window-edges)
- (defalias 'gnus-key-press-event-p 'numberp)
- ;;(defalias 'gnus-decode-rfc1522 'ignore)
- )
-
-;; We define these group faces here to avoid the display
-;; update forced when creating new faces.
-
-(defface gnus-group-news-1
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "ForestGreen" :bold t))
- (t
- ()))
- "Level 1 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-1-face 'face-alias 'gnus-group-news-1)
-
-(defface gnus-group-news-1-empty
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise"))
- (((class color)
- (background light))
- (:foreground "ForestGreen"))
- (t
- ()))
- "Level 1 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-1-empty-face 'face-alias 'gnus-group-news-1-empty)
-
-(defface gnus-group-news-2
- '((((class color)
- (background dark))
- (:foreground "turquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "CadetBlue4" :bold t))
- (t
- ()))
- "Level 2 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-2-face 'face-alias 'gnus-group-news-2)
-
-(defface gnus-group-news-2-empty
- '((((class color)
- (background dark))
- (:foreground "turquoise"))
- (((class color)
- (background light))
- (:foreground "CadetBlue4"))
- (t
- ()))
- "Level 2 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-2-empty-face 'face-alias 'gnus-group-news-2-empty)
-
-(defface gnus-group-news-3
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 3 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-3-face 'face-alias 'gnus-group-news-3)
-
-(defface gnus-group-news-3-empty
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 3 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-3-empty-face 'face-alias 'gnus-group-news-3-empty)
-
-(defface gnus-group-news-4
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 4 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-4-face 'face-alias 'gnus-group-news-4)
-
-(defface gnus-group-news-4-empty
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 4 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-4-empty-face 'face-alias 'gnus-group-news-4-empty)
-
-(defface gnus-group-news-5
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 5 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-5-face 'face-alias 'gnus-group-news-5)
-
-(defface gnus-group-news-5-empty
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 5 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-5-empty-face 'face-alias 'gnus-group-news-5-empty)
-
-(defface gnus-group-news-6
- '((((class color)
- (background dark))
- (:bold t))
- (((class color)
- (background light))
- (:bold t))
- (t
- ()))
- "Level 6 newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-6-face 'face-alias 'gnus-group-news-6)
-
-(defface gnus-group-news-6-empty
- '((((class color)
- (background dark))
- ())
- (((class color)
- (background light))
- ())
- (t
- ()))
- "Level 6 empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-6-empty-face 'face-alias 'gnus-group-news-6-empty)
-
-(defface gnus-group-news-low
- '((((class color)
- (background dark))
- (:foreground "DarkTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen" :bold t))
- (t
- ()))
- "Low level newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-low-face 'face-alias 'gnus-group-news-low)
-
-(defface gnus-group-news-low-empty
- '((((class color)
- (background dark))
- (:foreground "DarkTurquoise"))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- ()))
- "Low level empty newsgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-news-low-empty-face 'face-alias 'gnus-group-news-low-empty)
-
-(defface gnus-group-mail-1
- '((((class color)
- (background dark))
- (:foreground "aquamarine1" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink3" :bold t))
- (t
- (:bold t)))
- "Level 1 mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-1-face 'face-alias 'gnus-group-mail-1)
-
-(defface gnus-group-mail-1-empty
- '((((class color)
- (background dark))
- (:foreground "aquamarine1"))
- (((class color)
- (background light))
- (:foreground "DeepPink3"))
- (t
- (:italic t :bold t)))
- "Level 1 empty mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-1-empty-face 'face-alias 'gnus-group-mail-1-empty)
-
-(defface gnus-group-mail-2
- '((((class color)
- (background dark))
- (:foreground "aquamarine2" :bold t))
- (((class color)
- (background light))
- (:foreground "HotPink3" :bold t))
- (t
- (:bold t)))
- "Level 2 mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-2-face 'face-alias 'gnus-group-mail-2)
-
-(defface gnus-group-mail-2-empty
- '((((class color)
- (background dark))
- (:foreground "aquamarine2"))
- (((class color)
- (background light))
- (:foreground "HotPink3"))
- (t
- (:bold t)))
- "Level 2 empty mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-2-empty-face 'face-alias 'gnus-group-mail-2-empty)
-
-(defface gnus-group-mail-3
- '((((class color)
- (background dark))
- (:foreground "aquamarine3" :bold t))
- (((class color)
- (background light))
- (:foreground "magenta4" :bold t))
- (t
- (:bold t)))
- "Level 3 mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-3-face 'face-alias 'gnus-group-mail-3)
-
-(defface gnus-group-mail-3-empty
- '((((class color)
- (background dark))
- (:foreground "aquamarine3"))
- (((class color)
- (background light))
- (:foreground "magenta4"))
- (t
- ()))
- "Level 3 empty mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-3-empty-face 'face-alias 'gnus-group-mail-3-empty)
-
-(defface gnus-group-mail-low
- '((((class color)
- (background dark))
- (:foreground "aquamarine4" :bold t))
- (((class color)
- (background light))
- (:foreground "DeepPink4" :bold t))
- (t
- (:bold t)))
- "Low level mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-low-face 'face-alias 'gnus-group-mail-low)
-
-(defface gnus-group-mail-low-empty
- '((((class color)
- (background dark))
- (:foreground "aquamarine4"))
- (((class color)
- (background light))
- (:foreground "DeepPink4"))
- (t
- (:bold t)))
- "Low level empty mailgroup face."
- :group 'gnus-group)
-;; backward-compatibility alias
-(put 'gnus-group-mail-low-empty-face 'face-alias 'gnus-group-mail-low-empty)
-
-;; Summary mode faces.
-
-(defface gnus-summary-selected '((t (:underline t)))
- "Face used for selected articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-selected-face 'face-alias 'gnus-summary-selected)
-
-(defface gnus-summary-cancelled
- '((((class color))
- (:foreground "yellow" :background "black")))
- "Face used for cancelled articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-cancelled-face 'face-alias 'gnus-summary-cancelled)
-
-(defface gnus-summary-high-ticked
- '((((class color)
- (background dark))
- (:foreground "pink" :bold t))
- (((class color)
- (background light))
- (:foreground "firebrick" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ticked articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-ticked-face 'face-alias 'gnus-summary-high-ticked)
-
-(defface gnus-summary-low-ticked
- '((((class color)
- (background dark))
- (:foreground "pink" :italic t))
- (((class color)
- (background light))
- (:foreground "firebrick" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ticked articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-ticked-face 'face-alias 'gnus-summary-low-ticked)
-
-(defface gnus-summary-normal-ticked
- '((((class color)
- (background dark))
- (:foreground "pink"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- ()))
- "Face used for normal interest ticked articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-ticked-face 'face-alias 'gnus-summary-normal-ticked)
-
-(defface gnus-summary-high-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
- "Face used for high interest ancient articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-ancient-face 'face-alias 'gnus-summary-high-ancient)
-
-(defface gnus-summary-low-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue" :italic t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :italic t))
- (t
- (:italic t)))
- "Face used for low interest ancient articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-ancient-face 'face-alias 'gnus-summary-low-ancient)
-
-(defface gnus-summary-normal-ancient
- '((((class color)
- (background dark))
- (:foreground "SkyBlue"))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- ()))
- "Face used for normal interest ancient articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-ancient-face 'face-alias 'gnus-summary-normal-ancient)
-
-(defface gnus-summary-high-undownloaded
- '((((class color)
- (background light))
- (:bold t :foreground "cyan4"))
- (((class color) (background dark))
- (:bold t :foreground "LightGray"))
- (t (:inverse-video t :bold t)))
- "Face used for high interest uncached articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-undownloaded-face 'face-alias 'gnus-summary-high-undownloaded)
-
-(defface gnus-summary-low-undownloaded
- '((((class color)
- (background light))
- (:italic t :foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:italic t :foreground "LightGray" :bold nil))
- (t (:inverse-video t :italic t)))
- "Face used for low interest uncached articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-undownloaded-face 'face-alias 'gnus-summary-low-undownloaded)
-
-(defface gnus-summary-normal-undownloaded
- '((((class color)
- (background light))
- (:foreground "cyan4" :bold nil))
- (((class color) (background dark))
- (:foreground "LightGray" :bold nil))
- (t (:inverse-video t)))
- "Face used for normal interest uncached articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-undownloaded-face 'face-alias 'gnus-summary-normal-undownloaded)
-
-(defface gnus-summary-high-unread
- '((t
- (:bold t)))
- "Face used for high interest unread articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-unread-face 'face-alias 'gnus-summary-high-unread)
-
-(defface gnus-summary-low-unread
- '((t
- (:italic t)))
- "Face used for low interest unread articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-unread-face 'face-alias 'gnus-summary-low-unread)
-
-(defface gnus-summary-normal-unread
- '((t
- ()))
- "Face used for normal interest unread articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-unread-face 'face-alias 'gnus-summary-normal-unread)
-
-(defface gnus-summary-high-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :bold t))
- (t
- (:bold t)))
- "Face used for high interest read articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-high-read-face 'face-alias 'gnus-summary-high-read)
-
-(defface gnus-summary-low-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"
- :italic t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"
- :italic t))
- (t
- (:italic t)))
- "Face used for low interest read articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-low-read-face 'face-alias 'gnus-summary-low-read)
-
-(defface gnus-summary-normal-read
- '((((class color)
- (background dark))
- (:foreground "PaleGreen"))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- ()))
- "Face used for normal interest read articles."
- :group 'gnus-summary)
-;; backward-compatibility alias
-(put 'gnus-summary-normal-read-face 'face-alias 'gnus-summary-normal-read)
-
-
-;;;
-;;; Gnus buffers
-;;;
-
-(defvar gnus-buffers nil)
-
-(defun gnus-get-buffer-create (name)
- "Do the same as `get-buffer-create', but store the created buffer."
- (or (get-buffer name)
- (car (push (get-buffer-create name) gnus-buffers))))
-
-(defun gnus-add-buffer ()
- "Add the current buffer to the list of Gnus buffers."
- (push (current-buffer) gnus-buffers))
-
-(defmacro gnus-kill-buffer (buffer)
- "Kill BUFFER and remove from the list of Gnus buffers."
- `(let ((buf ,buffer))
- (when (gnus-buffer-exists-p buf)
- (setq gnus-buffers (delete (get-buffer buf) gnus-buffers))
- (kill-buffer buf))))
-
-(defun gnus-buffers ()
- "Return a list of live Gnus buffers."
- (while (and gnus-buffers
- (not (buffer-name (car gnus-buffers))))
- (pop gnus-buffers))
- (let ((buffers gnus-buffers))
- (while (cdr buffers)
- (if (buffer-name (cadr buffers))
- (pop buffers)
- (setcdr buffers (cddr buffers)))))
- gnus-buffers)
-
-;;; Splash screen.
-
-(defvar gnus-group-buffer "*Group*")
-
-(eval-and-compile
- (autoload 'gnus-play-jingle "gnus-audio"))
-
-(defface gnus-splash
- '((((class color)
- (background dark))
- (:foreground "#888888"))
- (((class color)
- (background light))
- (:foreground "#888888"))
- (t
- ()))
- "Face for the splash screen."
- :group 'gnus-start)
-;; backward-compatibility alias
-(put 'gnus-splash-face 'face-alias 'gnus-splash)
-
-(defun gnus-splash ()
- (save-excursion
- (switch-to-buffer (gnus-get-buffer-create gnus-group-buffer))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (unless gnus-inhibit-startup-message
- (gnus-group-startup-message)
- (sit-for 0)
- (when gnus-play-startup-jingle
- (gnus-play-jingle))))))
-
-(defun gnus-indent-rigidly (start end arg)
- "Indent rigidly using only spaces and no tabs."
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (let ((tab-width 8))
- (indent-rigidly start end arg)
- ;; We translate tabs into spaces -- not everybody uses
- ;; an 8-character tab.
- (goto-char (point-min))
- (while (search-forward "\t" nil t)
- (replace-match " " t t))))))
-
-(defvar gnus-simple-splash nil)
-
-;;(format "%02x%02x%02x" 114 66 20) "724214"
-
-(defvar gnus-logo-color-alist
- '((flame "#cc3300" "#ff2200")
- (pine "#c0cc93" "#f8ffb8")
- (moss "#a1cc93" "#d2ffb8")
- (irish "#04cc90" "#05ff97")
- (sky "#049acc" "#05deff")
- (tin "#6886cc" "#82b6ff")
- (velvet "#7c68cc" "#8c82ff")
- (grape "#b264cc" "#cf7df")
- (labia "#cc64c2" "#fd7dff")
- (berry "#cc6485" "#ff7db5")
- (dino "#724214" "#1e3f03")
- (oort "#cccccc" "#888888")
- (storm "#666699" "#99ccff")
- (pdino "#9999cc" "#99ccff")
- (purp "#9999cc" "#666699")
- (no "#000000" "#ff0000")
- (neutral "#b4b4b4" "#878787")
- (september "#bf9900" "#ffcc00"))
- "Color alist used for the Gnus logo.")
-
-(defcustom gnus-logo-color-style 'oort
- "*Color styles used for the Gnus logo."
- :type `(choice ,@(mapcar (lambda (elem) (list 'const (car elem)))
- gnus-logo-color-alist))
- :group 'gnus-xmas)
-
-(defvar gnus-logo-colors
- (cdr (assq gnus-logo-color-style gnus-logo-color-alist))
- "Colors used for the Gnus logo.")
-
-(defun gnus-group-startup-message (&optional x y)
- "Insert startup message in current buffer."
- ;; Insert the message.
- (erase-buffer)
- (cond
- ((and
- (fboundp 'find-image)
- (display-graphic-p)
- ;; Make sure the library defining `image-load-path' is loaded
- ;; (`find-image' is autoloaded) (and discard the result). Else, we may
- ;; get "defvar ignored because image-load-path is let-bound" when calling
- ;; `find-image' below.
- (or (find-image '(nil (:type xpm :file "gnus.xpm"))) t)
- (let* ((data-directory (nnheader-find-etc-directory "images/gnus"))
- (image-load-path (cond (data-directory
- (list data-directory))
- ((boundp 'image-load-path)
- (symbol-value 'image-load-path))
- (t load-path)))
- (image (find-image
- `((:type xpm :file "gnus.xpm"
- :color-symbols
- (("thing" . ,(car gnus-logo-colors))
- ("shadow" . ,(cadr gnus-logo-colors))
- ("oort" . "#eeeeee")
- ("background" . ,(face-background 'default))))
- (:type pbm :file "gnus.pbm"
- ;; Account for the pbm's blackground.
- :background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))
- (:type xbm :file "gnus.xbm"
- ;; Account for the xbm's blackground.
- :background ,(face-foreground 'gnus-splash)
- :foreground ,(face-background 'default))))))
- (when image
- (let ((size (image-size image)))
- (insert-char ?\n (max 0 (round (- (window-height)
- (or y (cdr size)) 1) 2)))
- (insert-char ?\ (max 0 (round (- (window-width)
- (or x (car size))) 2)))
- (insert-image image))
- (setq gnus-simple-splash nil)
- t))))
- (t
- (insert
- (format " %s
- _ ___ _ _
- _ ___ __ ___ __ _ ___
- __ _ ___ __ ___
- _ ___ _
- _ _ __ _
- ___ __ _
- __ _
- _ _ _
- _ _ _
- _ _ _
- __ ___
- _ _ _ _
- _ _
- _ _
- _ _
- _
- __
-
-"
- ""))
- ;; And then hack it.
- (gnus-indent-rigidly (point-min) (point-max)
- (/ (max (- (window-width) (or x 46)) 0) 2))
- (goto-char (point-min))
- (forward-line 1)
- (let* ((pheight (count-lines (point-min) (point-max)))
- (wheight (window-height))
- (rest (- wheight pheight)))
- (insert (make-string (max 0 (* 2 (/ rest 3))) ?\n)))
- ;; Fontify some.
- (put-text-property (point-min) (point-max) 'face 'gnus-splash)
- (setq gnus-simple-splash t)))
- (goto-char (point-min))
- (setq mode-line-buffer-identification (concat " " gnus-version))
- (set-buffer-modified-p t))
-
-(eval-when (load)
- (let ((command (format "%s" this-command)))
- (when (string-match "gnus" command)
- (if (string-match "gnus-other-frame" command)
- (gnus-get-buffer-create gnus-group-buffer)
- (gnus-splash)))))
-
-;;; Do the rest.
-
-(require 'gnus-util)
-(require 'nnheader)
-
-(defcustom gnus-parameters nil
- "Alist of group parameters.
-
-For example:
- ((\"mail\\\\..*\" (gnus-show-threads nil)
- (gnus-use-scoring nil)
- (gnus-summary-line-format
- \"%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\\n\")
- (gcc-self . t)
- (display . all))
- (\"mail\\\\.me\" (gnus-use-scoring t))
- (\"list\\\\..*\" (total-expire . t)
- (broken-reply-to . t)))"
- :version "22.1"
- :group 'gnus-group-various
- :type '(repeat (cons regexp
- (repeat sexp))))
-
-(defcustom gnus-parameters-case-fold-search 'default
- "If it is t, ignore case of group names specified in `gnus-parameters'.
-If it is nil, don't ignore case. If it is `default', which is for the
-backward compatibility, use the value of `case-fold-search'."
- :version "22.1"
- :group 'gnus-group-various
- :type '(choice :format "%{%t%}:\n %[Value Menu%] %v"
- (const :tag "Use `case-fold-search'" default)
- (const nil)
- (const t)))
-
-(defvar gnus-group-parameters-more nil)
-
-(defmacro gnus-define-group-parameter (param &rest rest)
- "Define a group parameter PARAM.
-REST is a plist of following:
-:type One of `bool', `list' or nil.
-:function The name of the function.
-:function-document The documentation of the function.
-:parameter-type The type for customizing the parameter.
-:parameter-document The documentation for the parameter.
-:variable The name of the variable.
-:variable-document The documentation for the variable.
-:variable-group The group for customizing the variable.
-:variable-type The type for customizing the variable.
-:variable-default The default value of the variable."
- (let* ((type (plist-get rest :type))
- (parameter-type (plist-get rest :parameter-type))
- (parameter-document (plist-get rest :parameter-document))
- (function (or (plist-get rest :function)
- (intern (format "gnus-parameter-%s" param))))
- (function-document (or (plist-get rest :function-document) ""))
- (variable (or (plist-get rest :variable)
- (intern (format "gnus-parameter-%s-alist" param))))
- (variable-document (or (plist-get rest :variable-document) ""))
- (variable-group (plist-get rest :variable-group))
- (variable-type (or (plist-get rest :variable-type)
- `(quote (repeat
- (list (regexp :tag "Group")
- ,(car (cdr parameter-type)))))))
- (variable-default (plist-get rest :variable-default)))
- (list
- 'progn
- `(defcustom ,variable ,variable-default
- ,variable-document
- :group 'gnus-group-parameter
- :group ',variable-group
- :type ,variable-type)
- `(setq gnus-group-parameters-more
- (delq (assq ',param gnus-group-parameters-more)
- gnus-group-parameters-more))
- `(add-to-list 'gnus-group-parameters-more
- (list ',param
- ,parameter-type
- ,parameter-document))
- (if (eq type 'bool)
- `(defun ,function (name)
- ,function-document
- (let ((params (gnus-group-find-parameter name))
- val)
- (cond
- ((memq ',param params)
- t)
- ((setq val (assq ',param params))
- (cdr val))
- ((stringp ,variable)
- (string-match ,variable name))
- (,variable
- (let ((alist ,variable)
- elem value)
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- value (cdr elem))))
- (if (consp value) (car value) value))))))
- `(defun ,function (name)
- ,function-document
- (and name
- (or (gnus-group-find-parameter name ',param ,(and type t))
- (let ((alist ,variable)
- elem value)
- (while (setq elem (pop alist))
- (when (and name
- (string-match (car elem) name))
- (setq alist nil
- value (cdr elem))))
- ,(if type
- 'value
- '(if (consp value) (car value) value))))))))))
-
-(defcustom gnus-home-directory "~/"
- "Directory variable that specifies the \"home\" directory.
-All other Gnus file and directory variables are initialized from this variable."
- :group 'gnus-files
- :type 'directory)
-
-(defcustom gnus-directory (or (getenv "SAVEDIR")
- (nnheader-concat gnus-home-directory "News/"))
- "*Directory variable from which all other Gnus file variables are derived.
-
-Note that Gnus is mostly loaded when the `.gnus.el' file is read.
-This means that other directory variables that are initialized from
-this variable won't be set properly if you set this variable in `.gnus.el'.
-Set this variable in `.emacs' instead."
- :group 'gnus-files
- :type 'directory)
-
-(defcustom gnus-default-directory nil
- "*Default directory for all Gnus buffers."
- :group 'gnus-files
- :type '(choice (const :tag "current" nil)
- directory))
-
-;; Site dependent variables. These variables should be defined in
-;; paths.el.
-
-(defvar gnus-default-nntp-server nil
- "Specify a default NNTP server.
-This variable should be defined in paths.el, and should never be set
-by the user.
-If you want to change servers, you should use `gnus-select-method'.
-See the documentation to that variable.")
-
-;; Don't touch this variable.
-(defvar gnus-nntp-service "nntp"
- "NNTP service name (\"nntp\" or 119).
-This is an obsolete variable, which is scarcely used. If you use an
-nntp server for your newsgroup and want to change the port number
-used to 899, you would say something along these lines:
-
- (setq gnus-select-method '(nntp \"my.nntp.server\" (nntp-port-number 899)))")
-
-(defcustom gnus-nntpserver-file "/etc/nntpserver"
- "A file with only the name of the nntp server in it."
- :group 'gnus-files
- :group 'gnus-server
- :type 'file)
-
-(defun gnus-getenv-nntpserver ()
- "Find default nntp server.
-Check the NNTPSERVER environment variable and the
-`gnus-nntpserver-file' file."
- (or (getenv "NNTPSERVER")
- (and (file-readable-p gnus-nntpserver-file)
- (with-temp-buffer
- (insert-file-contents gnus-nntpserver-file)
- (when (re-search-forward "[^ \t\n\r]+" nil t)
- (match-string 0))))))
-
-;; `M-x customize-variable RET gnus-select-method RET' should work without
-;; starting or even loading Gnus.
-;;;###autoload(when (fboundp 'custom-autoload)
-;;;###autoload (custom-autoload 'gnus-select-method "gnus"))
-
-(defcustom gnus-select-method
- (condition-case nil
- (nconc
- (list 'nntp (or (condition-case nil
- (gnus-getenv-nntpserver)
- (error nil))
- (when (and gnus-default-nntp-server
- (not (string= gnus-default-nntp-server "")))
- gnus-default-nntp-server)
- "news"))
- (if (or (null gnus-nntp-service)
- (equal gnus-nntp-service "nntp"))
- nil
- (list gnus-nntp-service)))
- (error nil))
- "Default method for selecting a newsgroup.
-This variable should be a list, where the first element is how the
-news is to be fetched, the second is the address.
-
-For instance, if you want to get your news via \"flab.flab.edu\" using
-NNTP, you could say:
-
-\(setq gnus-select-method '(nntp \"flab.flab.edu\"))
-
-If you want to use your local spool, say:
-
-\(setq gnus-select-method (list 'nnspool (system-name)))
-
-If you use this variable, you must set `gnus-nntp-server' to nil.
-
-There is a lot more to know about select methods and virtual servers -
-see the manual for details."
- :group 'gnus-server
- :group 'gnus-start
- :initialize 'custom-initialize-default
- :type 'gnus-select-method)
-
-(defcustom gnus-message-archive-method "archive"
- "*Method used for archiving messages you've sent.
-This should be a mail method."
- :group 'gnus-server
- :group 'gnus-message
- :type '(choice (const :tag "Default archive method" "archive")
- gnus-select-method))
-
-(defcustom gnus-message-archive-group nil
- "*Name of the group in which to save the messages you've written.
-This can either be a string; a list of strings; or an alist
-of regexps/functions/forms to be evaluated to return a string (or a list
-of strings). The functions are called with the name of the current
-group (or nil) as a parameter.
-
-If you want to save your mail in one group and the news articles you
-write in another group, you could say something like:
-
- \(setq gnus-message-archive-group
- '((if (message-news-p)
- \"misc-news\"
- \"misc-mail\")))
-
-Normally the group names returned by this variable should be
-unprefixed -- which implicitly means \"store on the archive server\".
-However, you may wish to store the message on some other server. In
-that case, just return a fully prefixed name of the group --
-\"nnml+private:mail.misc\", for instance."
- :group 'gnus-message
- :type '(choice (const :tag "none" nil)
- function
- sexp
- string))
-
-(defcustom gnus-secondary-servers nil
- "List of NNTP servers that the user can choose between interactively.
-To make Gnus query you for a server, you have to give `gnus' a
-non-numeric prefix - `C-u M-x gnus', in short."
- :group 'gnus-server
- :type '(repeat string))
-
-(defcustom gnus-nntp-server nil
- "*The name of the host running the NNTP server.
-This variable is semi-obsolete. Use the `gnus-select-method'
-variable instead."
- :group 'gnus-server
- :type '(choice (const :tag "disable" nil)
- string))
-
-(defcustom gnus-secondary-select-methods nil
- "A list of secondary methods that will be used for reading news.
-This is a list where each element is a complete select method (see
-`gnus-select-method').
-
-If, for instance, you want to read your mail with the nnml back end,
-you could set this variable:
-
-\(setq gnus-secondary-select-methods '((nnml \"\")))"
- :group 'gnus-server
- :type '(repeat gnus-select-method))
-
-(defvar gnus-backup-default-subscribed-newsgroups
- '("news.announce.newusers" "news.groups.questions" "gnu.emacs.gnus")
- "Default default new newsgroups the first time Gnus is run.
-Should be set in paths.el, and shouldn't be touched by the user.")
-
-(defcustom gnus-local-domain nil
- "Local domain name without a host name.
-The DOMAINNAME environment variable is used instead if it is defined.
-If the function `system-name' returns the full Internet name, there is
-no need to set this variable."
- :group 'gnus-message
- :type '(choice (const :tag "default" nil)
- string))
-
-(defvar gnus-local-organization nil
- "String with a description of what organization (if any) the user belongs to.
-Obsolete variable; use `message-user-organization' instead.")
-
-;; Customization variables
-
-(defcustom gnus-refer-article-method nil
- "Preferred method for fetching an article by Message-ID.
-If you are reading news from the local spool (with nnspool), fetching
-articles by Message-ID is painfully slow. By setting this method to an
-nntp method, you might get acceptable results.
-
-The value of this variable must be a valid select method as discussed
-in the documentation of `gnus-select-method'.
-
-It can also be a list of select methods, as well as the special symbol
-`current', which means to use the current select method. If it is a
-list, Gnus will try all the methods in the list until it finds a match."
- :group 'gnus-server
- :type '(choice (const :tag "default" nil)
- (const current)
- (const :tag "Google" (nnweb "refer" (nnweb-type google)))
- gnus-select-method
- (repeat :menu-tag "Try multiple"
- :tag "Multiple"
- :value (current (nnweb "refer" (nnweb-type google)))
- (choice :tag "Method"
- (const current)
- (const :tag "Google"
- (nnweb "refer" (nnweb-type google)))
- gnus-select-method))))
-
-(defcustom gnus-group-faq-directory
- '("/ftp@mirrors.aol.com:/pub/rtfm/usenet/"
- "/ftp@sunsite.doc.ic.ac.uk:/pub/usenet/news-faqs/"
- "/ftp@src.doc.ic.ac.uk:/usenet/news-FAQS/"
- "/ftp@ftp.seas.gwu.edu:/pub/rtfm/"
- "/ftp@ftp.pasteur.fr:/pub/FAQ/"
- "/ftp@rtfm.mit.edu:/pub/usenet/"
- "/ftp@ftp.uni-paderborn.de:/pub/FAQ/"
- "/ftp@ftp.sunet.se:/pub/usenet/"
- "/ftp@nctuccca.nctu.edu.tw:/pub/Documents/rtfm/usenet-by-group/"
- "/ftp@hwarang.postech.ac.kr:/pub/usenet/"
- "/ftp@ftp.hk.super.net:/mirror/faqs/")
- "*Directory where the group FAQs are stored.
-This will most commonly be on a remote machine, and the file will be
-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. 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
-something of value back from them.
-
-If the default site is too slow, try one of these:
-
- North America: mirrors.aol.com /pub/rtfm/usenet
- ftp.seas.gwu.edu /pub/rtfm
- rtfm.mit.edu /pub/usenet
- Europe: ftp.uni-paderborn.de /pub/FAQ
- src.doc.ic.ac.uk /usenet/news-FAQS
- ftp.sunet.se /pub/usenet
- ftp.pasteur.fr /pub/FAQ
- Asia: nctuccca.nctu.edu.tw /pub/Documents/rtfm/usenet-by-group/
- hwarang.postech.ac.kr /pub/usenet
- ftp.hk.super.net /mirror/faqs"
- :group 'gnus-group-various
- :type '(choice directory
- (repeat directory)))
-
-(defcustom gnus-group-charter-alist
- '(("no" . (concat "http://no.news-admin.org/charter/" name ".txt"))
- ("de" . (concat "http://purl.net/charta/" name ".html"))
- ("dk" . (concat "http://www.usenet.dk/grupper.pl?get=" name))
- ("england" . (concat "http://england.news-admin.org/charters/" name))
- ("fr" . (concat "http://www.usenet-fr.net/fur/chartes/" name ".html"))
- ("europa" . (concat "http://www.europa.usenet.eu.org/chartas/charta-en-"
- (gnus-replace-in-string name "europa\\." "") ".html"))
- ("nl" . (concat "http://www.xs4all.nl/~sister/usenet/charters/" name))
- ("aus" . (concat "http://aus.news-admin.org/groupinfo.cgi/" name))
- ("pl" . (concat "http://www.usenet.pl/opisy/" name))
- ("ch" . (concat "http://www.use-net.ch/Usenet/charter.html#" name))
- ("at" . (concat "http://www.usenet.at/chartas/" name "/charta"))
- ("uk" . (concat "http://www.usenet.org.uk/" name ".html"))
- ("dfw" . (concat "http://www.cirr.com/dfw/charters/" name ".html"))
- ("se" . (concat "http://www.usenet-se.net/Reglementen/"
- (gnus-replace-in-string name "\\." "_") ".html"))
- ("milw" . (concat "http://usenet.mil.wi.us/"
- (gnus-replace-in-string name "milw\\." "") "-charter"))
- ("ca" . (concat "http://www.sbay.org/ca/charter-" name ".html"))
- ("netins" . (concat "http://www.netins.net/usenet/charter/"
- (gnus-replace-in-string name "\\." "-") "-charter.html")))
- "*An alist of (HIERARCHY . FORM) pairs used to construct the URL of a charter.
-When FORM is evaluated `name' is bound to the name of the group."
- :version "22.1"
- :group 'gnus-group-various
- :type '(repeat (cons (string :tag "Hierarchy") (sexp :tag "Form"))))
-(put 'gnus-group-charter-alist 'risky-local-variable t)
-
-(defcustom gnus-group-fetch-control-use-browse-url nil
- "*Non-nil means that control messages are displayed using `browse-url'.
-Otherwise they are fetched with ange-ftp and displayed in an ephemeral
-group."
- :version "22.1"
- :group 'gnus-group-various
- :type 'boolean)
-
-(defcustom gnus-use-cross-reference t
- "*Non-nil means that cross referenced articles will be marked as read.
-If nil, ignore cross references. If t, mark articles as read in
-subscribed newsgroups. If neither t nor nil, mark as read in all
-newsgroups."
- :group 'gnus-server
- :type '(choice (const :tag "off" nil)
- (const :tag "subscribed" t)
- (sexp :format "all"
- :value always)))
-
-(defcustom gnus-process-mark ?#
- "*Process mark."
- :group 'gnus-group-visual
- :group 'gnus-summary-marks
- :type 'character)
-
-(defcustom gnus-large-newsgroup 200
- "*The number of articles which indicates a large newsgroup.
-If the number of articles in a newsgroup is greater than this value,
-confirmation is required for selecting the newsgroup.
-If it is nil, no confirmation is required."
- :group 'gnus-group-select
- :type '(choice (const :tag "No limit" nil)
- integer))
-
-(defcustom gnus-use-long-file-name (not (memq system-type '(usg-unix-v xenix)))
- "*Non-nil means that the default name of a file to save articles in is the group name.
-If it's nil, the directory form of the group name is used instead.
-
-If this variable is a list, and the list contains the element
-`not-score', long file names will not be used for score files; if it
-contains the element `not-save', long file names will not be used for
-saving; and if it contains the element `not-kill', long file names
-will not be used for kill files.
-
-Note that the default for this variable varies according to what system
-type you're using. On `usg-unix-v' and `xenix' this variable defaults
-to nil while on all other systems it defaults to t."
- :group 'gnus-start
- :type '(radio (sexp :format "Non-nil\n"
- :match (lambda (widget value)
- (and value (not (listp value))))
- :value t)
- (const nil)
- (checklist (const :format "%v " not-score)
- (const :format "%v " not-save)
- (const not-kill))))
-
-(defcustom gnus-kill-files-directory gnus-directory
- "*Name of the directory where kill files will be stored (default \"~/News\")."
- :group 'gnus-score-files
- :group 'gnus-score-kill
- :type 'directory)
-
-(defcustom gnus-save-score nil
- "*If non-nil, save group scoring info."
- :group 'gnus-score-various
- :group 'gnus-start
- :type 'boolean)
-
-(defcustom gnus-use-undo t
- "*If non-nil, allow undoing in Gnus group mode buffers."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-use-adaptive-scoring nil
- "*If non-nil, use some adaptive scoring scheme.
-If a list, then the values `word' and `line' are meaningful. The
-former will perform adaption on individual words in the subject
-header while `line' will perform adaption on several headers."
- :group 'gnus-meta
- :group 'gnus-score-adapt
- :type '(set (const word) (const line)))
-
-(defcustom gnus-use-cache 'passive
- "*If nil, Gnus will ignore the article cache.
-If `passive', it will allow entering (and reading) articles
-explicitly entered into the cache. If anything else, use the
-cache to the full extent of the law."
- :group 'gnus-meta
- :group 'gnus-cache
- :type '(choice (const :tag "off" nil)
- (const :tag "passive" passive)
- (const :tag "active" t)))
-
-(defcustom gnus-use-trees nil
- "*If non-nil, display a thread tree buffer."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-use-grouplens nil
- "*If non-nil, use GroupLens ratings."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-keep-backlog 20
- "*If non-nil, Gnus will keep read articles for later re-retrieval.
-If it is a number N, then Gnus will only keep the last N articles
-read. If it is neither nil nor a number, Gnus will keep all read
-articles. This is not a good idea."
- :group 'gnus-meta
- :type '(choice (const :tag "off" nil)
- integer
- (sexp :format "all"
- :value t)))
-
-(defcustom gnus-use-nocem nil
- "*If non-nil, Gnus will read NoCeM cancel messages.
-You can also set this variable to a positive number as a group level.
-In that case, Gnus scans NoCeM messages when checking new news if this
-value is not exceeding a group level that you specify as the prefix
-argument to some commands, e.g. `gnus', `gnus-group-get-new-news', etc.
-Otherwise, Gnus does not scan NoCeM messages if you specify a group
-level to those commands."
- :group 'gnus-meta
- :type '(choice
- (const :tag "off" nil)
- (const :tag "on" t)
- (list :convert-widget
- (lambda (widget)
- (list 'integer :tag "group level"
- :value (if (boundp 'gnus-level-default-subscribed)
- gnus-level-default-subscribed
- 3))))))
-
-(defcustom gnus-suppress-duplicates nil
- "*If non-nil, Gnus will mark duplicate copies of the same article as read."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-use-scoring t
- "*If non-nil, enable scoring."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-summary-prepare-exit-hook
- '(gnus-summary-expire-articles)
- "*A hook called when preparing to exit from the summary buffer.
-It calls `gnus-summary-expire-articles' by default."
- :group 'gnus-summary-exit
- :type 'hook)
-
-(defcustom gnus-novice-user t
- "*Non-nil means that you are a Usenet novice.
-If non-nil, verbose messages may be displayed and confirmations may be
-required."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-expert-user nil
- "*Non-nil means that you will never be asked for confirmation about anything.
-That doesn't mean *anything* anything; particularly destructive
-commands will still require prompting."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-interactive-catchup t
- "*If non-nil, require your confirmation when catching up a group."
- :group 'gnus-group-select
- :type 'boolean)
-
-(defcustom gnus-interactive-exit t
- "*If non-nil, require your confirmation when exiting Gnus."
- :group 'gnus-exit
- :type 'boolean)
-
-(defcustom gnus-extract-address-components 'gnus-extract-address-components
- "*Function for extracting address components from a From header.
-Two pre-defined function exist: `gnus-extract-address-components',
-which is the default, quite fast, and too simplistic solution, and
-`mail-extract-address-components', which works much better, but is
-slower."
- :group 'gnus-summary-format
- :type '(radio (function-item gnus-extract-address-components)
- (function-item mail-extract-address-components)
- (function :tag "Other")))
-
-(defcustom gnus-carpal nil
- "*If non-nil, display clickable icons."
- :group 'gnus-meta
- :type 'boolean)
-
-(defcustom gnus-shell-command-separator ";"
- "String used to separate shell commands."
- :group 'gnus-files
- :type 'string)
-
-(defcustom gnus-valid-select-methods
- '(("nntp" post address prompt-address physical-address)
- ("nnspool" post address)
- ("nnvirtual" post-mail virtual prompt-address)
- ("nnmbox" mail respool address)
- ("nnml" post-mail respool address)
- ("nnmh" mail respool address)
- ("nndir" post-mail prompt-address physical-address)
- ("nneething" none address prompt-address physical-address)
- ("nndoc" none address prompt-address)
- ("nnbabyl" mail address respool)
- ("nnkiboze" post virtual)
- ("nnsoup" post-mail address)
- ("nndraft" post-mail)
- ("nnfolder" mail respool address)
- ("nngateway" post-mail address prompt-address physical-address)
- ("nnweb" none)
- ("nngoogle" post)
- ("nnslashdot" post)
- ("nnultimate" none)
- ("nnrss" none)
- ("nnwfm" none)
- ("nnwarchive" none)
- ("nnlistserv" none)
- ("nnagent" post-mail)
- ("nnimap" post-mail address prompt-address physical-address)
- ("nnmaildir" mail respool address)
- ("nnnil" none))
- "*An alist of valid select methods.
-The first element of each list lists should be a string with the name
-of the select method. The other elements may be the category of
-this method (i. e., `post', `mail', `none' or whatever) or other
-properties that this method has (like being respoolable).
-If you implement a new select method, all you should have to change is
-this variable. I think."
- :group 'gnus-server
- :type '(repeat (group (string :tag "Name")
- (radio-button-choice (const :format "%v " post)
- (const :format "%v " mail)
- (const :format "%v " none)
- (const post-mail))
- (checklist :inline t
- (const :format "%v " address)
- (const :format "%v " prompt-address)
- (const :format "%v " physical-address)
- (const :format "%v " virtual)
- (const respool)))))
-
-(defun gnus-redefine-select-method-widget ()
- "Recomputes the select-method widget based on the value of
-`gnus-valid-select-methods'."
- (define-widget 'gnus-select-method 'list
- "Widget for entering a select method."
- :value '(nntp "")
- :tag "Select Method"
- :args `((choice :tag "Method"
- ,@(mapcar (lambda (entry)
- (list 'const :format "%v\n"
- (intern (car entry))))
- gnus-valid-select-methods)
- (symbol :tag "other"))
- (string :tag "Address")
- (repeat :tag "Options"
- :inline t
- (list :format "%v"
- variable
- (sexp :tag "Value"))))))
-
-(gnus-redefine-select-method-widget)
-
-(defcustom gnus-updated-mode-lines '(group article summary tree)
- "List of buffers that should update their mode lines.
-The list may contain the symbols `group', `article', `tree' and
-`summary'. If the corresponding symbol is present, Gnus will keep
-that mode line updated with information that may be pertinent.
-If this variable is nil, screen refresh may be quicker."
- :group 'gnus-various
- :type '(set (const group)
- (const article)
- (const summary)
- (const tree)))
-
-;; Added by Keinonen Kari <kk85613@cs.tut.fi>.
-(defcustom gnus-mode-non-string-length nil
- "*Max length of mode-line non-string contents.
-If this is nil, Gnus will take space as is needed, leaving the rest
-of the mode line intact. Note that the default of nil is unlikely
-to be desirable; see the manual for further details."
- :group 'gnus-various
- :type '(choice (const nil)
- integer))
-
-;; There should be special validation for this.
-(define-widget 'gnus-email-address 'string
- "An email address.")
-
-(gnus-define-group-parameter
- to-address
- :function-document
- "Return GROUP's to-address."
- :variable-document
- "*Alist of group regexps and correspondent to-addresses."
- :variable-group gnus-group-parameter
- :parameter-type '(gnus-email-address :tag "To Address")
- :parameter-document "\
-This will be used when doing followups and posts.
-
-This is primarily useful in mail groups that represent closed
-mailing lists--mailing lists where it's expected that everybody that
-writes to the mailing list is subscribed to it. Since using this
-parameter ensures that the mail only goes to the mailing list itself,
-it means that members won't receive two copies of your followups.
-
-Using `to-address' will actually work whether the group is foreign or
-not. Let's say there's a group on the server that is called
-`fa.4ad-l'. This is a real newsgroup, but the server has gotten the
-articles from a mail-to-news gateway. Posting directly to this group
-is therefore impossible--you have to send mail to the mailing list
-address instead.
-
-The gnus-group-split mail splitting mechanism will behave as if this
-address was listed in gnus-group-split Addresses (see below).")
-
-(gnus-define-group-parameter
- to-list
- :function-document
- "Return GROUP's to-list."
- :variable-document
- "*Alist of group regexps and correspondent to-lists."
- :variable-group gnus-group-parameter
- :parameter-type '(gnus-email-address :tag "To List")
- :parameter-document "\
-This address will be used when doing a `a' in the group.
-
-It is totally ignored when doing a followup--except that if it is
-present in a news group, you'll get mail group semantics when doing
-`f'.
-
-The gnus-group-split mail splitting mechanism will behave as if this
-address was listed in gnus-group-split Addresses (see below).")
-
-(gnus-define-group-parameter
- subscribed
- :type bool
- :function-document
- "Return GROUP's subscription status."
- :variable-document
- "*Groups which are automatically considered subscribed."
- :variable-group gnus-group-parameter
- :parameter-type '(const :tag "Subscribed" t)
- :parameter-document "\
-Gnus assumed that you are subscribed to the To/List address.
-
-When constructing a list of subscribed groups using
-`gnus-find-subscribed-addresses', Gnus includes the To address given
-above, or the list address (if the To address has not been set).")
-
-(gnus-define-group-parameter
- auto-expire
- :type bool
- :function gnus-group-auto-expirable-p
- :function-document
- "Check whether GROUP is auto-expirable or not."
- :variable gnus-auto-expirable-newsgroups
- :variable-default nil
- :variable-document
- "*Groups in which to automatically mark read articles as expirable.
-If non-nil, this should be a regexp that should match all groups in
-which to perform auto-expiry. This only makes sense for mail groups."
- :variable-group nnmail-expire
- :variable-type '(choice (const nil)
- regexp)
- :parameter-type '(const :tag "Automatic Expire" t)
- :parameter-document
- "All articles that are read will be marked as expirable.")
-
-(gnus-define-group-parameter
- total-expire
- :type bool
- :function gnus-group-total-expirable-p
- :function-document
- "Check whether GROUP is total-expirable or not."
- :variable gnus-total-expirable-newsgroups
- :variable-default nil
- :variable-document
- "*Groups in which to perform expiry of all read articles.
-Use with extreme caution. All groups that match this regexp will be
-expiring - which means that all read articles will be deleted after
-\(say) one week. (This only goes for mail groups and the like, of
-course.)"
- :variable-group nnmail-expire
- :variable-type '(choice (const nil)
- regexp)
- :parameter-type '(const :tag "Total Expire" t)
- :parameter-document
- "All read articles will be put through the expiry process
-
-This happens even if they are not marked as expirable.
-Use with caution.")
-
-(gnus-define-group-parameter
- charset
- :function-document
- "Return the default charset of GROUP."
- :variable gnus-group-charset-alist
- :variable-default
- '(("\\(^\\|:\\)hk\\>\\|\\(^\\|:\\)tw\\>\\|\\<big5\\>" cn-big5)
- ("\\(^\\|:\\)cn\\>\\|\\<chinese\\>" cn-gb-2312)
- ("\\(^\\|:\\)fj\\>\\|\\(^\\|:\\)japan\\>" iso-2022-jp-2)
- ("\\(^\\|:\\)tnn\\>\\|\\(^\\|:\\)pin\\>\\|\\(^\\|:\\)sci.lang.japan" iso-2022-7bit)
- ("\\(^\\|:\\)relcom\\>" koi8-r)
- ("\\(^\\|:\\)fido7\\>" koi8-r)
- ("\\(^\\|:\\)\\(cz\\|hun\\|pl\\|sk\\|hr\\)\\>" iso-8859-2)
- ("\\(^\\|:\\)israel\\>" iso-8859-1)
- ("\\(^\\|:\\)han\\>" euc-kr)
- ("\\(^\\|:\\)alt.chinese.text.big5\\>" chinese-big5)
- ("\\(^\\|:\\)soc.culture.vietnamese\\>" vietnamese-viqr)
- ("\\(^\\|:\\)\\(comp\\|rec\\|alt\\|sci\\|soc\\|news\\|gnu\\|bofh\\)\\>" iso-8859-1))
- :variable-document
- "Alist of regexps (to match group names) and default charsets to be used when reading."
- :variable-group gnus-charset
- :variable-type '(repeat (list (regexp :tag "Group")
- (symbol :tag "Charset")))
- :parameter-type '(symbol :tag "Charset")
- :parameter-document "\
-The default charset to use in the group.")
-
-(gnus-define-group-parameter
- post-method
- :type list
- :function-document
- "Return a posting method for GROUP."
- :variable gnus-post-method-alist
- :variable-document
- "Alist of regexps (to match group names) and method to be used when
-posting an article."
- :variable-group gnus-group-foreign
- :parameter-type
- '(choice :tag "Posting Method"
- (const :tag "Use native server" native)
- (const :tag "Use current server" current)
- (list :convert-widget
- (lambda (widget)
- (list 'sexp :tag "Methods"
- :value gnus-select-method))))
- :parameter-document
- "Posting method for this group.")
-
-(gnus-define-group-parameter
- large-newsgroup-initial
- :type integer
- :function-document
- "Return GROUP's initial input of the number of articles."
- :variable-document
- "*Alist of group regexps and its initial input of the number of articles."
- :variable-group gnus-group-parameter
- :parameter-type '(choice :tag "Initial Input for Large Newsgroup"
- (const :tag "All" nil)
- (integer))
- :parameter-document "\
-
-This number will be prompted as the initial value of the number of
-articles to list when the group is a large newsgroup (see
-`gnus-large-newsgroup'). If it is nil, the default value is the
-total number of articles in the group.")
-
-;; The Gnus registry's ignored groups
-(gnus-define-group-parameter
- registry-ignore
- :type list
- :function-document
- "Whether this group should be ignored by the registry."
- :variable gnus-registry-ignored-groups
- :variable-default nil
- :variable-document
- "*Groups in which the registry should be turned off."
- :variable-group gnus-registry
- :variable-type '(repeat
- (list
- (regexp :tag "Group Name Regular Expression")
- (boolean :tag "Ignored")))
-
- :parameter-type '(boolean :tag "Group Ignored by the Registry")
- :parameter-document
- "Whether the Gnus Registry should ignore this group.")
-
-;; group parameters for spam processing added by Ted Zlatanov <tzz@lifelogs.com>
-(defcustom gnus-install-group-spam-parameters t
- "*Disable the group parameters for spam detection.
-Enable if `G c' in XEmacs is giving you trouble, and make sure to submit a bug report."
- :version "22.1"
- :type 'boolean
- :group 'gnus-start)
-
-(when gnus-install-group-spam-parameters
- (defvar gnus-group-spam-classification-spam t
- "Spam group classification (requires spam.el).
-This group contains spam messages. On summary entry, unread messages
-will be marked as spam. On summary exit, the specified spam
-processors will be invoked on spam-marked messages, then those
-messages will be expired, so the spam processor will only see a
-spam-marked message once.")
-
- (defvar gnus-group-spam-classification-ham 'ask
- "The ham value for the spam group parameter (requires spam.el).
-On summary exit, the specified ham processors will be invoked on
-ham-marked messages. Exercise caution, since the ham processor will
-see the same message more than once because there is no ham message
-registry.")
-
- (gnus-define-group-parameter
- spam-contents
- :type list
- :function-document
- "The spam type (spam, ham, or neither) of the group."
- :variable gnus-spam-newsgroup-contents
- :variable-default nil
- :variable-document
- "*Group classification (spam, ham, or neither). Only
-meaningful when spam.el is loaded. If non-nil, this should be a
-list of group name regexps associated with a classification for
-each one. In spam groups, new articles are marked as spam on
-summary entry. There is other behavior associated with ham and
-no classification when spam.el is loaded - see the manual."
- :variable-group spam
- :variable-type '(repeat
- (list :tag "Group contents spam/ham classification"
- (regexp :tag "Group")
- (choice
- (variable-item gnus-group-spam-classification-spam)
- (variable-item gnus-group-spam-classification-ham)
- (const :tag "Unclassified" nil))))
-
- :parameter-type '(list :tag "Group contents spam/ham classification"
- (choice :tag "Group contents classification for spam sorting"
- (variable-item gnus-group-spam-classification-spam)
- (variable-item gnus-group-spam-classification-ham)
- (const :tag "Unclassified" nil)))
- :parameter-document
- "The spam classification (spam, ham, or neither) of this group.
-When a spam group is entered, all unread articles are marked as
-spam. There is other behavior associated with ham and no
-classification when spam.el is loaded - see the manual.")
-
- (defvar gnus-group-spam-exit-processor-ifile "ifile"
- "OBSOLETE: The ifile summary exit spam processor.")
-
- (defvar gnus-group-spam-exit-processor-stat "stat"
- "OBSOLETE: The spam-stat summary exit spam processor.")
-
- (defvar gnus-group-spam-exit-processor-bogofilter "bogofilter"
- "OBSOLETE: The Bogofilter summary exit spam processor.")
-
- (defvar gnus-group-spam-exit-processor-blacklist "blacklist"
- "OBSOLETE: The Blacklist summary exit spam processor.")
-
- (defvar gnus-group-spam-exit-processor-report-gmane "report-gmane"
- "OBSOLETE: The Gmane reporting summary exit spam processor.
-Only applicable to NNTP groups with articles from Gmane. See spam-report.el")
-
- (defvar gnus-group-spam-exit-processor-spamoracle "spamoracle-spam"
- "OBSOLETE: The spamoracle summary exit spam processor.")
-
- (defvar gnus-group-ham-exit-processor-ifile "ifile-ham"
- "OBSOLETE: The ifile summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-bogofilter "bogofilter-ham"
- "OBSOLETE: The Bogofilter summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-stat "stat-ham"
- "OBSOLETE: The spam-stat summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-whitelist "whitelist"
- "OBSOLETE: The whitelist summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-BBDB "bbdb"
- "OBSOLETE: The BBDB summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-copy "copy"
- "OBSOLETE: The ham copy exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (defvar gnus-group-ham-exit-processor-spamoracle "spamoracle-ham"
- "OBSOLETE: The spamoracle summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
- (gnus-define-group-parameter
- spam-process
- :type list
- :parameter-type
- '(choice
- :tag "Spam Summary Exit Processor"
- :value nil
- (list :tag "Spam Summary Exit Processor Choices"
- (set
- (variable-item gnus-group-spam-exit-processor-ifile)
- (variable-item gnus-group-spam-exit-processor-stat)
- (variable-item gnus-group-spam-exit-processor-bogofilter)
- (variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-spamoracle)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
- (variable-item gnus-group-ham-exit-processor-bogofilter)
- (variable-item gnus-group-ham-exit-processor-ifile)
- (variable-item gnus-group-ham-exit-processor-stat)
- (variable-item gnus-group-ham-exit-processor-whitelist)
- (variable-item gnus-group-ham-exit-processor-BBDB)
- (variable-item gnus-group-ham-exit-processor-spamoracle)
- (variable-item gnus-group-ham-exit-processor-copy)
- (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
- (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
- (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
- (const :tag "Spam: ifile" (spam spam-use-ifile))
- (const :tag "Spam: Spam-stat" (spam spam-use-stat))
- (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
- (const :tag "Ham: ifile" (ham spam-use-ifile))
- (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
- (const :tag "Ham: Spam-stat" (ham spam-use-stat))
- (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
- (const :tag "Ham: BBDB" (ham spam-use-BBDB))
- (const :tag "Ham: Copy" (ham spam-use-ham-copy))
- (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
- :function-document
- "Which spam or ham processors will be applied when the summary is exited."
- :variable gnus-spam-process-newsgroups
- :variable-default nil
- :variable-document
- "*Groups in which to automatically process spam or ham articles with
-a backend on summary exit. If non-nil, this should be a list of group
-name regexps that should match all groups in which to do automatic
-spam processing, associated with the appropriate processor."
- :variable-group spam
- :variable-type
- '(repeat :tag "Spam/Ham Processors"
- (list :tag "Spam Summary Exit Processor Choices"
- (regexp :tag "Group Regexp")
- (set
- :tag "Spam/Ham Summary Exit Processor"
- (variable-item gnus-group-spam-exit-processor-ifile)
- (variable-item gnus-group-spam-exit-processor-stat)
- (variable-item gnus-group-spam-exit-processor-bogofilter)
- (variable-item gnus-group-spam-exit-processor-blacklist)
- (variable-item gnus-group-spam-exit-processor-spamoracle)
- (variable-item gnus-group-spam-exit-processor-report-gmane)
- (variable-item gnus-group-ham-exit-processor-bogofilter)
- (variable-item gnus-group-ham-exit-processor-ifile)
- (variable-item gnus-group-ham-exit-processor-stat)
- (variable-item gnus-group-ham-exit-processor-whitelist)
- (variable-item gnus-group-ham-exit-processor-BBDB)
- (variable-item gnus-group-ham-exit-processor-spamoracle)
- (variable-item gnus-group-ham-exit-processor-copy)
- (const :tag "Spam: Gmane Report" (spam spam-use-gmane))
- (const :tag "Spam: Bogofilter" (spam spam-use-bogofilter))
- (const :tag "Spam: Blacklist" (spam spam-use-blacklist))
- (const :tag "Spam: ifile" (spam spam-use-ifile))
- (const :tag "Spam: Spam-stat" (spam spam-use-stat))
- (const :tag "Spam: Spam Oracle" (spam spam-use-spamoracle))
- (const :tag "Ham: ifile" (ham spam-use-ifile))
- (const :tag "Ham: Bogofilter" (ham spam-use-bogofilter))
- (const :tag "Ham: Spam-stat" (ham spam-use-stat))
- (const :tag "Ham: Whitelist" (ham spam-use-whitelist))
- (const :tag "Ham: BBDB" (ham spam-use-BBDB))
- (const :tag "Ham: Copy" (ham spam-use-ham-copy))
- (const :tag "Ham: Spam Oracle" (ham spam-use-spamoracle)))))
-
- :parameter-document
- "Which spam or ham processors will be applied when the summary is exited.")
-
- (gnus-define-group-parameter
- spam-autodetect
- :type list
- :parameter-type
- '(boolean :tag "Spam autodetection")
- :function-document
- "Should spam be autodetected (with spam-split) in this group?"
- :variable gnus-spam-autodetect
- :variable-default nil
- :variable-document
- "*Groups in which spam should be autodetected when they are entered.
- Only unseen articles will be examined, unless
- spam-autodetect-recheck-messages is set."
- :variable-group spam
- :variable-type
- '(repeat
- :tag "Autodetection setting"
- (list
- (regexp :tag "Group Regexp")
- boolean))
- :parameter-document
- "Spam autodetection.
-Only unseen articles will be examined, unless
-spam-autodetect-recheck-messages is set.")
-
- (gnus-define-group-parameter
- spam-autodetect-methods
- :type list
- :parameter-type
- '(choice :tag "Spam autodetection-specific methods"
- (const none)
- (const default)
- (set :tag "Use specific methods"
- (variable-item spam-use-blacklist)
- (variable-item spam-use-regex-headers)
- (variable-item spam-use-regex-body)
- (variable-item spam-use-whitelist)
- (variable-item spam-use-BBDB)
- (variable-item spam-use-ifile)
- (variable-item spam-use-spamoracle)
- (variable-item spam-use-stat)
- (variable-item spam-use-blackholes)
- (variable-item spam-use-hashcash)
- (variable-item spam-use-bogofilter-headers)
- (variable-item spam-use-bogofilter)))
- :function-document
- "Methods to be used for autodetection in each group"
- :variable gnus-spam-autodetect-methods
- :variable-default nil
- :variable-document
- "*Methods for autodetecting spam per group.
-Requires the spam-autodetect parameter. Only unseen articles
-will be examined, unless spam-autodetect-recheck-messages is
-set."
- :variable-group spam
- :variable-type
- '(repeat
- :tag "Autodetection methods"
- (list
- (regexp :tag "Group Regexp")
- (choice
- (const none)
- (const default)
- (set :tag "Use specific methods"
- (variable-item spam-use-blacklist)
- (variable-item spam-use-regex-headers)
- (variable-item spam-use-regex-body)
- (variable-item spam-use-whitelist)
- (variable-item spam-use-BBDB)
- (variable-item spam-use-ifile)
- (variable-item spam-use-spamoracle)
- (variable-item spam-use-stat)
- (variable-item spam-use-blackholes)
- (variable-item spam-use-hashcash)
- (variable-item spam-use-bogofilter-headers)
- (variable-item spam-use-bogofilter)))))
- :parameter-document
- "Spam autodetection methods.
-Requires the spam-autodetect parameter. Only unseen articles
-will be examined, unless spam-autodetect-recheck-messages is
-set.")
-
- (gnus-define-group-parameter
- spam-process-destination
- :type list
- :parameter-type
- '(choice :tag "Destination for spam-processed articles at summary exit"
- (string :tag "Move to a group")
- (repeat :tag "Move to multiple groups"
- (string :tag "Destination group"))
- (const :tag "Expire" nil))
- :function-document
- "Where spam-processed articles will go at summary exit."
- :variable gnus-spam-process-destinations
- :variable-default nil
- :variable-document
- "*Groups in which to explicitly send spam-processed articles to
-another group, or expire them (the default). If non-nil, this should
-be a list of group name regexps that should match all groups in which
-to do spam-processed article moving, associated with the destination
-group or nil for explicit expiration. This only makes sense for
-mail groups."
- :variable-group spam
- :variable-type
- '(repeat
- :tag "Spam-processed articles destination"
- (list
- (regexp :tag "Group Regexp")
- (choice
- :tag "Destination for spam-processed articles at summary exit"
- (string :tag "Move to a group")
- (repeat :tag "Move to multiple groups"
- (string :tag "Destination group"))
- (const :tag "Expire" nil))))
- :parameter-document
- "Where spam-processed articles will go at summary exit.")
-
- (gnus-define-group-parameter
- ham-process-destination
- :type list
- :parameter-type
- '(choice
- :tag "Destination for ham articles at summary exit from a spam group"
- (string :tag "Move to a group")
- (repeat :tag "Move to multiple groups"
- (string :tag "Destination group"))
- (const :tag "Respool" respool)
- (const :tag "Do nothing" nil))
- :function-document
- "Where ham articles will go at summary exit from a spam group."
- :variable gnus-ham-process-destinations
- :variable-default nil
- :variable-document
- "*Groups in which to explicitly send ham articles to
-another group, or do nothing (the default). If non-nil, this should
-be a list of group name regexps that should match all groups in which
-to do ham article moving, associated with the destination
-group or nil for explicit ignoring. This only makes sense for
-mail groups, and only works in spam groups."
- :variable-group spam
- :variable-type
- '(repeat
- :tag "Ham articles destination"
- (list
- (regexp :tag "Group Regexp")
- (choice
- :tag "Destination for ham articles at summary exit from spam group"
- (string :tag "Move to a group")
- (repeat :tag "Move to multiple groups"
- (string :tag "Destination group"))
- (const :tag "Respool" respool)
- (const :tag "Expire" nil))))
- :parameter-document
- "Where ham articles will go at summary exit from a spam group.")
-
- (gnus-define-group-parameter
- ham-marks
- :type 'list
- :parameter-type '(list :tag "Ham mark choices"
- (set
- (variable-item gnus-del-mark)
- (variable-item gnus-read-mark)
- (variable-item gnus-ticked-mark)
- (variable-item gnus-killed-mark)
- (variable-item gnus-kill-file-mark)
- (variable-item gnus-low-score-mark)))
-
- :parameter-document
- "Marks considered ham (positively not spam). Such articles will be
-processed as ham (non-spam) on group exit. When nil, the global
-spam-ham-marks variable takes precedence."
- :variable-default '((".*" ((gnus-del-mark
- gnus-read-mark
- gnus-killed-mark
- gnus-kill-file-mark
- gnus-low-score-mark))))
- :variable-group spam
- :variable-document
- "*Groups in which to explicitly set the ham marks to some value.")
-
- (gnus-define-group-parameter
- spam-marks
- :type 'list
- :parameter-type '(list :tag "Spam mark choices"
- (set
- (variable-item gnus-spam-mark)
- (variable-item gnus-killed-mark)
- (variable-item gnus-kill-file-mark)
- (variable-item gnus-low-score-mark)))
-
- :parameter-document
- "Marks considered spam.
-Such articles will be processed as spam on group exit. When nil, the global
-spam-spam-marks variable takes precedence."
- :variable-default '((".*" ((gnus-spam-mark))))
- :variable-group spam
- :variable-document
- "*Groups in which to explicitly set the spam marks to some value."))
-
-(defcustom gnus-group-uncollapsed-levels 1
- "Number of group name elements to leave alone when making a short group name."
- :group 'gnus-group-visual
- :type 'integer)
-
-(defcustom gnus-group-use-permanent-levels nil
- "*If non-nil, once you set a level, Gnus will use this level."
- :group 'gnus-group-levels
- :type 'boolean)
-
-;; Hooks.
-
-(defcustom gnus-load-hook nil
- "A hook run while Gnus is loaded."
- :group 'gnus-start
- :type 'hook)
-
-(defcustom gnus-apply-kill-hook '(gnus-apply-kill-file)
- "A hook called to apply kill files to a group.
-This hook is intended to apply a kill file to the selected newsgroup.
-The function `gnus-apply-kill-file' is called by default.
-
-Since a general kill file is too heavy to use only for a few
-newsgroups, I recommend you to use a lighter hook function. For
-example, if you'd like to apply a kill file to articles which contains
-a string `rmgroup' in subject in newsgroup `control', you can use the
-following hook:
-
- (setq gnus-apply-kill-hook
- (list
- (lambda ()
- (cond ((string-match \"control\" gnus-newsgroup-name)
- (gnus-kill \"Subject\" \"rmgroup\")
- (gnus-expunge \"X\"))))))"
- :group 'gnus-score-kill
- :options '(gnus-apply-kill-file)
- :type 'hook)
-
-(defcustom gnus-group-change-level-function nil
- "Function run when a group level is changed.
-It is called with three parameters -- GROUP, LEVEL and OLDLEVEL."
- :group 'gnus-group-levels
- :type '(choice (const nil)
- function))
-
-;;; Face thingies.
-
-(defcustom gnus-visual
- '(summary-highlight group-highlight article-highlight
- mouse-face
- summary-menu group-menu article-menu
- tree-highlight menu highlight
- browse-menu server-menu
- page-marker tree-menu binary-menu pick-menu
- grouplens-menu)
- "*Enable visual features.
-If `visual' is disabled, there will be no menus and few faces. Most of
-the visual customization options below will be ignored. Gnus will use
-less space and be faster as a result.
-
-This variable can also be a list of visual elements to switch on. For
-instance, to switch off all visual things except menus, you can say:
-
- (setq gnus-visual '(menu))
-
-Valid elements include `summary-highlight', `group-highlight',
-`article-highlight', `mouse-face', `summary-menu', `group-menu',
-`article-menu', `tree-highlight', `menu', `highlight', `browse-menu',
-`server-menu', `page-marker', `tree-menu', `binary-menu', `pick-menu',
-and `grouplens-menu'."
- :group 'gnus-meta
- :group 'gnus-visual
- :type '(set (const summary-highlight)
- (const group-highlight)
- (const article-highlight)
- (const mouse-face)
- (const summary-menu)
- (const group-menu)
- (const article-menu)
- (const tree-highlight)
- (const menu)
- (const highlight)
- (const browse-menu)
- (const server-menu)
- (const page-marker)
- (const tree-menu)
- (const binary-menu)
- (const pick-menu)
- (const grouplens-menu)))
-
-;; Byte-compiler warning.
-(defvar gnus-visual)
-;; Find out whether the gnus-visual TYPE is wanted.
-(defun gnus-visual-p (&optional type class)
- (and gnus-visual ; Has to be non-nil, at least.
- (if (not type) ; We don't care about type.
- gnus-visual
- (if (listp gnus-visual) ; It's a list, so we check it.
- (or (memq type gnus-visual)
- (memq class gnus-visual))
- t))))
-
-(defcustom gnus-mouse-face
- (condition-case ()
- (if (gnus-visual-p 'mouse-face 'highlight)
- (if (boundp 'gnus-mouse-face)
- (or gnus-mouse-face 'highlight)
- 'highlight)
- 'default)
- (error 'highlight))
- "*Face used for group or summary buffer mouse highlighting.
-The line beneath the mouse pointer will be highlighted with this
-face."
- :group 'gnus-visual
- :type 'face)
-
-(defcustom gnus-article-save-directory gnus-directory
- "*Name of the directory articles will be saved in (default \"~/News\")."
- :group 'gnus-article-saving
- :type 'directory)
-
-(defvar gnus-plugged t
- "Whether Gnus is plugged or not.")
-
-(defcustom gnus-agent-cache t
- "Controls use of the agent cache while plugged.
-When set, Gnus will prefer using the locally stored content rather
-than re-fetching it from the server. You also need to enable
-`gnus-agent' for this to have any affect."
- :version "22.1"
- :group 'gnus-agent
- :type 'boolean)
-
-(defcustom gnus-default-charset 'undecided
- "Default charset assumed to be used when viewing non-ASCII characters.
-This variable is overridden on a group-to-group basis by the
-`gnus-group-charset-alist' variable and is only used on groups not
-covered by that variable."
- :type 'symbol
- :group 'gnus-charset)
-
-;; Fixme: Doc reference to agent.
-(defcustom gnus-agent t
- "Whether we want to use the Gnus agent or not.
-
-You may customize gnus-agent to disable its use. However, some
-back ends have started to use the agent as a client-side cache.
-Disabling the agent may result in noticeable loss of performance."
- :version "22.1"
- :group 'gnus-agent
- :type 'boolean)
-
-(defcustom gnus-other-frame-function 'gnus
- "Function called by the command `gnus-other-frame'."
- :group 'gnus-start
- :type '(choice (function-item gnus)
- (function-item gnus-no-server)
- (function-item gnus-slave)
- (function-item gnus-slave-no-server)))
-
-(defcustom gnus-other-frame-parameters nil
- "Frame parameters used by `gnus-other-frame' to create a Gnus frame.
-This should be an alist for Emacs, or a plist for XEmacs."
- :group 'gnus-start
- :type (if (featurep 'xemacs)
- '(repeat (list :inline t :format "%v"
- (symbol :tag "Property")
- (sexp :tag "Value")))
- '(repeat (cons :format "%v"
- (symbol :tag "Parameter")
- (sexp :tag "Value")))))
-
-(defcustom gnus-user-agent '(emacs gnus type)
- "Which information should be exposed in the User-Agent header.
-
-Can be a list of symbols or a string. Valid symbols are `gnus'
-\(show Gnus version\) and `emacs' \(show Emacs version\). In
-addition to the Emacs version, you can add `codename' \(show
-\(S\)XEmacs codename\) or either `config' \(show system
-configuration\) or `type' \(show system type\). If you set it to
-a string, be sure to use a valid format, see RFC 2616."
-
- :version "22.1"
- :group 'gnus-message
- :type '(choice (list (set :inline t
- (const gnus :tag "Gnus version")
- (const emacs :tag "Emacs version")
- (choice :tag "system"
- (const type :tag "system type")
- (const config :tag "system configuration"))
- (const codename :tag "Emacs codename")))
- (string)))
-
-;; Convert old (No Gnus < 2005-01-10, v5-10 < 2005-09-05) symbol type values:
-(when (symbolp gnus-user-agent)
- (setq gnus-user-agent
- (cond ((eq gnus-user-agent 'emacs-gnus-config)
- '(emacs gnus config))
- ((eq gnus-user-agent 'emacs-gnus-type)
- '(emacs gnus type))
- ((eq gnus-user-agent 'emacs-gnus)
- '(emacs gnus))
- ((eq gnus-user-agent 'gnus)
- '(gnus))
- (t gnus-user-agent)))
- (gnus-message 1 "Converted `gnus-user-agent' to `%s'." gnus-user-agent)
- (sit-for 1)
- (if (get 'gnus-user-agent 'saved-value)
- (customize-save-variable 'gnus-user-agent gnus-user-agent)
- (gnus-message 1 "Edit your init file to make this change permanent.")
- (sit-for 2)))
-
-\f
-;;; Internal variables
-
-(defvar gnus-agent-gcc-header "X-Gnus-Agent-Gcc")
-(defvar gnus-agent-meta-information-header "X-Gnus-Agent-Meta-Information")
-(defvar gnus-agent-method-p-cache nil
- ; Reset each time gnus-agent-covered-methods is changed else
- ; gnus-agent-method-p may mis-report a methods status.
- )
-(defvar gnus-agent-target-move-group-header "X-Gnus-Agent-Move-To")
-(defvar gnus-draft-meta-information-header "X-Draft-From")
-(defvar gnus-group-get-parameter-function 'gnus-group-get-parameter)
-(defvar gnus-original-article-buffer " *Original Article*")
-(defvar gnus-newsgroup-name nil)
-(defvar gnus-ephemeral-servers nil)
-(defvar gnus-server-method-cache nil)
-
-(defvar gnus-agent-fetching nil
- "Whether Gnus agent is in fetching mode.")
-
-(defvar gnus-agent-covered-methods nil
- "A list of servers, NOT methods, showing which servers are covered by the agent.")
-
-(defvar gnus-command-method nil
- "Dynamically bound variable that says what the current back end is.")
-
-(defvar gnus-current-select-method nil
- "The current method for selecting a newsgroup.")
-
-(defvar gnus-tree-buffer "*Tree*"
- "Buffer where Gnus thread trees are displayed.")
-
-;; Dummy variable.
-(defvar gnus-use-generic-from nil)
-
-;; Variable holding the user answers to all method prompts.
-(defvar gnus-method-history nil)
-
-;; Variable holding the user answers to all mail method prompts.
-(defvar gnus-mail-method-history nil)
-
-;; Variable holding the user answers to all group prompts.
-(defvar gnus-group-history nil)
-
-(defvar gnus-server-alist nil
- "List of available servers.")
-
-(defcustom gnus-cache-directory
- (nnheader-concat gnus-directory "cache/")
- "*The directory where cached articles will be stored."
- :group 'gnus-cache
- :type 'directory)
-
-(defvar gnus-predefined-server-alist
- `(("cache"
- nnspool "cache"
- (nnspool-spool-directory ,gnus-cache-directory)
- (nnspool-nov-directory ,gnus-cache-directory)
- (nnspool-active-file
- ,(nnheader-concat gnus-cache-directory "active"))))
- "List of predefined (convenience) servers.")
-
-(defvar gnus-topic-indentation "") ;; Obsolete variable.
-
-(defconst gnus-article-mark-lists
- '((marked . tick) (replied . reply)
- (expirable . expire) (killed . killed)
- (bookmarks . bookmark) (dormant . dormant)
- (scored . score) (saved . save)
- (cached . cache) (downloadable . download)
- (unsendable . unsend) (forwarded . forward)
- (recent . recent) (seen . seen)))
-
-(defconst gnus-article-special-mark-lists
- '((seen range)
- (killed range)
- (bookmark tuple)
- (score tuple)))
-
-;; Propagate flags to server, with the following exceptions:
-;; `seen' is private to each gnus installation
-;; `cache' is a internal gnus flag for each gnus installation
-;; `download' is a agent flag private to each gnus installation
-;; `unsend' are for nndraft groups only
-;; `score' is not a proper mark
-;; `bookmark': don't propagated it, or fix the bug in update-mark.
-(defconst gnus-article-unpropagated-mark-lists
- '(seen cache download unsend score bookmark)
- "Marks that shouldn't be propagated to back ends.
-Typical marks are those that make no sense in a standalone back end,
-such as a mark that says whether an article is stored in the cache
-\(which doesn't make sense in a standalone back end).")
-
-(defvar gnus-headers-retrieved-by nil)
-(defvar gnus-article-reply nil)
-(defvar gnus-override-method nil)
-(defvar gnus-article-check-size nil)
-(defvar gnus-opened-servers nil)
-
-(defvar gnus-current-kill-article nil)
-
-(defvar gnus-have-read-active-file nil)
-
-(defconst gnus-maintainer
- "bugs@gnus.org (The Gnus Bugfixing Girls + Boys)"
- "The mail address of the Gnus maintainers.")
-
-(defvar gnus-info-nodes
- '((gnus-group-mode "(gnus)Group Buffer")
- (gnus-summary-mode "(gnus)Summary Buffer")
- (gnus-article-mode "(gnus)Article Buffer")
- (gnus-server-mode "(gnus)Server Buffer")
- (gnus-browse-mode "(gnus)Browse Foreign Server")
- (gnus-tree-mode "(gnus)Tree Display"))
- "Alist of major modes and related Info nodes.")
-
-(defvar gnus-group-buffer "*Group*")
-(defvar gnus-summary-buffer "*Summary*")
-(defvar gnus-article-buffer "*Article*")
-(defvar gnus-server-buffer "*Server*")
-
-(defvar gnus-slave nil
- "Whether this Gnus is a slave or not.")
-
-(defvar gnus-batch-mode nil
- "Whether this Gnus is running in batch mode or not.")
-
-(defvar gnus-variable-list
- '(gnus-newsrc-options gnus-newsrc-options-n
- gnus-newsrc-last-checked-date
- gnus-newsrc-alist gnus-server-alist
- gnus-killed-list gnus-zombie-list
- gnus-topic-topology gnus-topic-alist
- gnus-format-specs)
- "Gnus variables saved in the quick startup file.")
-
-(defvar gnus-newsrc-alist nil
- "Assoc list of read articles.
-`gnus-newsrc-hashtb' should be kept so that both hold the same information.")
-
-(defvar gnus-registry-alist nil
- "Assoc list of registry data.
-gnus-registry.el will populate this if it's loaded.")
-
-(defvar gnus-newsrc-hashtb nil
- "Hashtable of `gnus-newsrc-alist'.")
-
-(defvar gnus-killed-list nil
- "List of killed newsgroups.")
-
-(defvar gnus-killed-hashtb nil
- "Hash table equivalent of `gnus-killed-list'.")
-
-(defvar gnus-zombie-list nil
- "List of almost dead newsgroups.")
-
-(defvar gnus-description-hashtb nil
- "Descriptions of newsgroups.")
-
-(defvar gnus-list-of-killed-groups nil
- "List of newsgroups that have recently been killed by the user.")
-
-(defvar gnus-active-hashtb nil
- "Hashtable of active articles.")
-
-(defvar gnus-moderated-hashtb nil
- "Hashtable of moderated newsgroups.")
-
-;; Save window configuration.
-(defvar gnus-prev-winconf nil)
-
-(defvar gnus-reffed-article-number nil)
-
-;;; Let the byte-compiler know that we know about this variable.
-(defvar rmail-default-rmail-file)
-
-(defvar gnus-dead-summary nil)
-
-(defvar gnus-invalid-group-regexp "[: `'\"/]\\|^$"
- "Regexp matching invalid groups.")
-
-(defvar gnus-other-frame-object nil
- "A frame object which will be created by `gnus-other-frame'.")
-
-;;; End of variables.
-
-;; Define some autoload functions Gnus might use.
-(eval-and-compile
-
- ;; This little mapcar goes through the list below and marks the
- ;; symbols in question as autoloaded functions.
- (mapcar
- (lambda (package)
- (let ((interactive (nth 1 (memq ':interactive package))))
- (mapcar
- (lambda (function)
- (let (keymap)
- (when (consp function)
- (setq keymap (car (memq 'keymap function)))
- (setq function (car function)))
- (unless (fboundp function)
- (autoload function (car package) nil interactive keymap))))
- (if (eq (nth 1 package) ':interactive)
- (nthcdr 3 package)
- (cdr package)))))
- '(("info" :interactive t Info-goto-node)
- ("pp" pp-to-string)
- ("qp" quoted-printable-decode-region quoted-printable-decode-string)
- ("ps-print" ps-print-preprint)
- ("message" :interactive t
- message-send-and-exit message-yank-original)
- ("babel" babel-as-string)
- ("nnmail" nnmail-split-fancy nnmail-article-group)
- ("nnvirtual" nnvirtual-catchup-group nnvirtual-convert-headers)
- ("rmailout" rmail-output rmail-output-to-rmail-file)
- ("rmail" rmail-insert-rmail-file-header rmail-count-new-messages
- rmail-show-message rmail-summary-exists
- rmail-select-summary rmail-update-summary)
- ("gnus-audio" :interactive t gnus-audio-play)
- ("gnus-xmas" gnus-xmas-splash)
- ("gnus-soup" :interactive t
- gnus-group-brew-soup gnus-brew-soup gnus-soup-add-article
- gnus-soup-send-replies gnus-soup-save-areas gnus-soup-pack-packet)
- ("nnsoup" nnsoup-pack-replies)
- ("score-mode" :interactive t gnus-score-mode)
- ("gnus-mh" gnus-summary-save-article-folder
- gnus-Folder-save-name gnus-folder-save-name)
- ("gnus-mh" :interactive t gnus-summary-save-in-folder)
- ("gnus-demon" gnus-demon-add-nocem gnus-demon-add-scanmail
- gnus-demon-add-rescan gnus-demon-add-scan-timestamps
- gnus-demon-add-disconnection gnus-demon-add-handler
- gnus-demon-remove-handler)
- ("gnus-demon" :interactive t
- gnus-demon-init gnus-demon-cancel)
- ("gnus-fun" gnus-convert-gray-x-face-to-xpm gnus-display-x-face-in-from
- gnus-convert-image-to-gray-x-face gnus-convert-face-to-png
- gnus-face-from-file)
- ("gnus-salt" gnus-highlight-selected-tree gnus-possibly-generate-tree
- gnus-tree-open gnus-tree-close gnus-carpal-setup-buffer)
- ("gnus-nocem" gnus-nocem-scan-groups gnus-nocem-close
- gnus-nocem-unwanted-article-p)
- ("gnus-srvr" gnus-enter-server-buffer gnus-server-set-info
- gnus-server-server-name)
- ("gnus-srvr" gnus-browse-foreign-server)
- ("gnus-cite" :interactive t
- gnus-article-highlight-citation gnus-article-hide-citation-maybe
- gnus-article-hide-citation gnus-article-fill-cited-article
- gnus-article-hide-citation-in-followups)
- ("gnus-kill" gnus-kill gnus-apply-kill-file-internal
- gnus-kill-file-edit-file gnus-kill-file-raise-followups-to-author
- gnus-execute gnus-expunge gnus-batch-kill gnus-batch-score)
- ("gnus-cache" gnus-cache-possibly-enter-article gnus-cache-save-buffers
- gnus-cache-possibly-remove-articles gnus-cache-request-article
- gnus-cache-retrieve-headers gnus-cache-possibly-alter-active
- gnus-cache-enter-remove-article gnus-cached-article-p
- gnus-cache-open gnus-cache-close gnus-cache-update-article
- gnus-cache-articles-in-group)
- ("gnus-cache" :interactive t gnus-jog-cache gnus-cache-enter-article
- gnus-cache-remove-article gnus-summary-insert-cached-articles)
- ("gnus-score" :interactive t
- gnus-summary-increase-score gnus-summary-set-score
- gnus-summary-raise-thread gnus-summary-raise-same-subject
- gnus-summary-raise-score gnus-summary-raise-same-subject-and-select
- gnus-summary-lower-thread gnus-summary-lower-same-subject
- gnus-summary-lower-score gnus-summary-lower-same-subject-and-select
- gnus-summary-current-score gnus-score-delta-default
- gnus-score-flush-cache gnus-score-close
- gnus-possibly-score-headers gnus-score-followup-article
- gnus-score-followup-thread)
- ("gnus-score"
- (gnus-summary-score-map keymap) gnus-score-save gnus-score-headers
- gnus-current-score-file-nondirectory gnus-score-adaptive
- gnus-score-find-trace gnus-score-file-name)
- ("gnus-cus" :interactive t gnus-group-customize gnus-score-customize)
- ("gnus-topic" :interactive t gnus-topic-mode)
- ("gnus-topic" gnus-topic-remove-group gnus-topic-set-parameters
- gnus-subscribe-topics)
- ("gnus-salt" :interactive t gnus-pick-mode gnus-binary-mode)
- ("gnus-uu" (gnus-uu-extract-map keymap) (gnus-uu-mark-map keymap))
- ("gnus-uu" :interactive t
- gnus-uu-digest-mail-forward gnus-uu-digest-post-forward
- gnus-uu-mark-series gnus-uu-mark-region gnus-uu-mark-buffer
- gnus-uu-mark-by-regexp gnus-uu-mark-all
- gnus-uu-mark-sparse gnus-uu-mark-thread gnus-uu-decode-uu
- gnus-uu-decode-uu-and-save gnus-uu-decode-unshar
- gnus-uu-decode-unshar-and-save gnus-uu-decode-save
- gnus-uu-decode-binhex gnus-uu-decode-uu-view
- gnus-uu-decode-uu-and-save-view gnus-uu-decode-unshar-view
- gnus-uu-decode-unshar-and-save-view gnus-uu-decode-save-view
- gnus-uu-decode-binhex-view gnus-uu-unmark-thread
- gnus-uu-mark-over gnus-uu-post-news)
- ("gnus-uu" gnus-uu-delete-work-dir gnus-uu-unmark-thread)
- ("gnus-msg" (gnus-summary-send-map keymap)
- gnus-article-mail gnus-copy-article-buffer gnus-extended-version)
- ("gnus-msg" :interactive t
- gnus-group-post-news gnus-group-mail gnus-group-news
- gnus-summary-post-news gnus-summary-news-other-window
- gnus-summary-followup gnus-summary-followup-with-original
- gnus-summary-cancel-article gnus-summary-supersede-article
- gnus-post-news gnus-summary-reply gnus-summary-reply-with-original
- gnus-summary-mail-forward gnus-summary-mail-other-window
- gnus-summary-resend-message gnus-summary-resend-bounced-mail
- gnus-summary-wide-reply gnus-summary-followup-to-mail
- gnus-summary-followup-to-mail-with-original gnus-bug
- gnus-summary-wide-reply-with-original
- gnus-summary-post-forward gnus-summary-wide-reply-with-original
- gnus-summary-post-forward)
- ("gnus-picon" :interactive t gnus-treat-from-picon)
- ("gnus-gl" bbb-login bbb-logout bbb-grouplens-group-p
- gnus-grouplens-mode)
- ("smiley" :interactive t smiley-region)
- ("gnus-win" gnus-configure-windows gnus-add-configuration)
- ("gnus-sum" gnus-summary-insert-line gnus-summary-read-group
- gnus-list-of-unread-articles gnus-list-of-read-articles
- gnus-offer-save-summaries gnus-make-thread-indent-array
- gnus-summary-exit gnus-update-read-articles gnus-summary-last-subject
- gnus-summary-skip-intangible gnus-summary-article-number
- gnus-data-header gnus-data-find)
- ("gnus-group" gnus-group-insert-group-line gnus-group-quit
- gnus-group-list-groups gnus-group-first-unread-group
- gnus-group-set-mode-line gnus-group-set-info gnus-group-save-newsrc
- gnus-group-setup-buffer gnus-group-get-new-news
- gnus-group-make-help-group gnus-group-update-group
- gnus-group-iterate gnus-group-group-name)
- ("gnus-bcklg" gnus-backlog-request-article gnus-backlog-enter-article
- gnus-backlog-remove-article)
- ("gnus-art" gnus-article-read-summary-keys gnus-article-save
- gnus-article-prepare gnus-article-set-window-start
- gnus-article-next-page gnus-article-prev-page
- gnus-request-article-this-buffer gnus-article-mode
- gnus-article-setup-buffer gnus-narrow-to-page
- gnus-article-delete-invisible-text gnus-treat-article)
- ("gnus-art" :interactive t
- gnus-article-hide-headers gnus-article-hide-boring-headers
- gnus-article-treat-overstrike
- gnus-article-remove-cr gnus-article-remove-trailing-blank-lines
- gnus-article-display-x-face gnus-article-de-quoted-unreadable
- gnus-article-de-base64-unreadable
- gnus-article-decode-HZ
- gnus-article-wash-html
- gnus-article-unsplit-urls
- gnus-article-hide-pem gnus-article-hide-signature
- gnus-article-strip-leading-blank-lines gnus-article-date-local
- gnus-article-date-original gnus-article-date-lapsed
-;; gnus-article-show-all-headers
- gnus-article-edit-mode gnus-article-edit-article
- gnus-article-edit-done gnus-article-decode-encoded-words
- gnus-start-date-timer gnus-stop-date-timer
- gnus-mime-view-all-parts)
- ("gnus-int" gnus-request-type)
- ("gnus-start" gnus-newsrc-parse-options gnus-1 gnus-no-server-1
- gnus-dribble-enter gnus-read-init-file gnus-dribble-touch)
- ("gnus-dup" gnus-dup-suppress-articles gnus-dup-unsuppress-article
- gnus-dup-enter-articles)
- ("gnus-range" gnus-copy-sequence)
- ("gnus-eform" gnus-edit-form)
- ("gnus-move" :interactive t
- gnus-group-move-group-to-server gnus-change-server)
- ("gnus-logic" gnus-score-advanced)
- ("gnus-undo" gnus-undo-mode gnus-undo-register)
- ("gnus-async" gnus-async-request-fetched-article gnus-async-prefetch-next
- gnus-async-prefetch-article gnus-async-prefetch-remove-group
- gnus-async-halt-prefetch)
- ("gnus-agent" gnus-open-agent gnus-agent-get-function
- gnus-agent-save-active gnus-agent-method-p
- gnus-agent-get-undownloaded-list gnus-agent-fetch-session
- gnus-summary-set-agent-mark gnus-agent-save-group-info
- gnus-agent-request-article gnus-agent-retrieve-headers)
- ("gnus-agent" :interactive t
- gnus-unplugged gnus-agentize gnus-agent-batch)
- ("gnus-vm" :interactive t gnus-summary-save-in-vm
- gnus-summary-save-article-vm)
- ("compface" uncompface)
- ("gnus-draft" :interactive t gnus-draft-mode gnus-group-send-queue)
- ("gnus-mlspl" gnus-group-split gnus-group-split-fancy)
- ("gnus-mlspl" :interactive t gnus-group-split-setup
- gnus-group-split-update)
- ("gnus-delay" gnus-delay-initialize))))
-
-;;; gnus-sum.el thingies
-
-
-(defcustom gnus-summary-line-format "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n"
- "*The format specification of the lines in the summary buffer.
-
-It works along the same lines as a normal formatting string,
-with some simple extensions.
-
-%N Article number, left padded with spaces (string)
-%S Subject (string)
-%s Subject if it is at the root of a thread, and \"\" otherwise (string)
-%n Name of the poster (string)
-%a Extracted name of the poster (string)
-%A Extracted address of the poster (string)
-%F Contents of the From: header (string)
-%f Contents of the From: or To: headers (string)
-%x Contents of the Xref: header (string)
-%D Date of the article (string)
-%d Date of the article (string) in DD-MMM format
-%o Date of the article (string) in YYYYMMDD`T'HHMMSS format
-%M Message-id of the article (string)
-%r References of the article (string)
-%c Number of characters in the article (integer)
-%k Pretty-printed version of the above (string)
- For example, \"1.2k\" or \"0.4M\".
-%L Number of lines in the article (integer)
-%I Indentation based on thread level (a string of spaces)
-%B A complex trn-style thread tree (string)
- The variables `gnus-sum-thread-*' can be used for customization.
-%T A string with two possible values: 80 spaces if the article
- is on thread level two or larger and 0 spaces on level one
-%R \"A\" if this article has been replied to, \" \" otherwise (character)
-%U Status of this article (character, \"R\", \"K\", \"-\" or \" \")
-%[ Opening bracket (character, \"[\" or \"<\")
-%] Closing bracket (character, \"]\" or \">\")
-%> Spaces of length thread-level (string)
-%< Spaces of length (- 20 thread-level) (string)
-%i Article score (number)
-%z Article zcore (character)
-%t Number of articles under the current thread (number).
-%e Whether the thread is empty or not (character).
-%l GroupLens score (string).
-%V Total thread score (number).
-%P The line number (number).
-%O Download mark (character).
-%* If present, indicates desired cursor position
- (instead of after first colon).
-%u User defined specifier. The next character in the format string should
- be a letter. Gnus will call the function gnus-user-format-function-X,
- where X is the letter following %u. The function will be passed the
- current header as argument. The function should return a string, which
- will be inserted into the summary just like information from any other
- summary specifier.
-
-The %U (status), %R (replied) and %z (zcore) specs have to be handled
-with care. For reasons of efficiency, Gnus will compute what column
-these characters will end up in, and \"hard-code\" that. This means that
-it is invalid to have these specs after a variable-length spec. Well,
-you might not be arrested, but your summary buffer will look strange,
-which is bad enough.
-
-The smart choice is to have these specs as far to the left as
-possible.
-
-This restriction may disappear in later versions of Gnus.
-
-General format specifiers can also be used.
-See Info node `(gnus)Formatting Variables'."
- :link '(custom-manual "(gnus)Formatting Variables")
- :type 'string
- :group 'gnus-summary-format)
-
-;;;
-;;; Skeleton keymaps
-;;;
-
-(defun gnus-suppress-keymap (keymap)
- (suppress-keymap keymap)
- (let ((keys `([backspace] [delete] "\177" "\M-u"))) ;gnus-mouse-2
- (while keys
- (define-key keymap (pop keys) 'undefined))))
-
-(defvar gnus-article-mode-map
- (let ((keymap (make-sparse-keymap)))
- (gnus-suppress-keymap keymap)
- keymap))
-(defvar gnus-summary-mode-map
- (let ((keymap (make-keymap)))
- (gnus-suppress-keymap keymap)
- keymap))
-(defvar gnus-group-mode-map
- (let ((keymap (make-keymap)))
- (gnus-suppress-keymap keymap)
- keymap))
-
-\f
-
-;; Fix by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-;; If you want the cursor to go somewhere else, set these two
-;; functions in some startup hook to whatever you want.
-(defalias 'gnus-summary-position-point 'gnus-goto-colon)
-(defalias 'gnus-group-position-point 'gnus-goto-colon)
-
-;;; Various macros and substs.
-
-(defun gnus-header-from (header)
- (mail-header-from header))
-
-(defmacro gnus-gethash (string hashtable)
- "Get hash value of STRING in HASHTABLE."
- `(symbol-value (intern-soft ,string ,hashtable)))
-
-(defmacro gnus-gethash-safe (string hashtable)
- "Get hash value of STRING in HASHTABLE.
-Return nil if not defined."
- `(let ((sym (intern-soft ,string ,hashtable)))
- (and (boundp sym) (symbol-value sym))))
-
-(defmacro gnus-sethash (string value hashtable)
- "Set hash value. Arguments are STRING, VALUE, and HASHTABLE."
- `(set (intern ,string ,hashtable) ,value))
-(put 'gnus-sethash 'edebug-form-spec '(form form form))
-
-(defmacro gnus-group-unread (group)
- "Get the currently computed number of unread articles in GROUP."
- `(car (gnus-gethash ,group gnus-newsrc-hashtb)))
-
-(defmacro gnus-group-entry (group)
- "Get the newsrc entry for GROUP."
- `(gnus-gethash ,group gnus-newsrc-hashtb))
-
-(defmacro gnus-active (group)
- "Get active info on GROUP."
- `(gnus-gethash ,group gnus-active-hashtb))
-
-(defmacro gnus-set-active (group active)
- "Set GROUP's active info."
- `(gnus-sethash ,group ,active gnus-active-hashtb))
-
-;; Info access macros.
-
-(defmacro gnus-info-group (info)
- `(nth 0 ,info))
-(defmacro gnus-info-rank (info)
- `(nth 1 ,info))
-(defmacro gnus-info-read (info)
- `(nth 2 ,info))
-(defmacro gnus-info-marks (info)
- `(nth 3 ,info))
-(defmacro gnus-info-method (info)
- `(nth 4 ,info))
-(defmacro gnus-info-params (info)
- `(nth 5 ,info))
-
-(defmacro gnus-info-level (info)
- `(let ((rank (gnus-info-rank ,info)))
- (if (consp rank)
- (car rank)
- rank)))
-(defmacro gnus-info-score (info)
- `(let ((rank (gnus-info-rank ,info)))
- (or (and (consp rank) (cdr rank)) 0)))
-
-(defmacro gnus-info-set-group (info group)
- `(setcar ,info ,group))
-(defmacro gnus-info-set-rank (info rank)
- `(setcar (nthcdr 1 ,info) ,rank))
-(defmacro gnus-info-set-read (info read)
- `(setcar (nthcdr 2 ,info) ,read))
-(defmacro gnus-info-set-marks (info marks &optional extend)
- (if extend
- `(gnus-info-set-entry ,info ,marks 3)
- `(setcar (nthcdr 3 ,info) ,marks)))
-(defmacro gnus-info-set-method (info method &optional extend)
- (if extend
- `(gnus-info-set-entry ,info ,method 4)
- `(setcar (nthcdr 4 ,info) ,method)))
-(defmacro gnus-info-set-params (info params &optional extend)
- (if extend
- `(gnus-info-set-entry ,info ,params 5)
- `(setcar (nthcdr 5 ,info) ,params)))
-
-(defun gnus-info-set-entry (info entry number)
- ;; Extend the info until we have enough elements.
- (while (<= (length info) number)
- (nconc info (list nil)))
- ;; Set the entry.
- (setcar (nthcdr number info) entry))
-
-(defmacro gnus-info-set-level (info level)
- `(let ((rank (cdr ,info)))
- (if (consp (car rank))
- (setcar (car rank) ,level)
- (setcar rank ,level))))
-(defmacro gnus-info-set-score (info score)
- `(let ((rank (cdr ,info)))
- (if (consp (car rank))
- (setcdr (car rank) ,score)
- (setcar rank (cons (car rank) ,score)))))
-
-(defmacro gnus-get-info (group)
- `(nth 2 (gnus-gethash ,group gnus-newsrc-hashtb)))
-
-;;; Load the compatibility functions.
-
-(require 'gnus-ems)
-
-\f
-;;;
-;;; Shutdown
-;;;
-
-(defvar gnus-shutdown-alist nil)
-
-(defun gnus-add-shutdown (function &rest symbols)
- "Run FUNCTION whenever one of SYMBOLS is shut down."
- (push (cons function symbols) gnus-shutdown-alist))
-
-(defun gnus-shutdown (symbol)
- "Shut down everything that waits for SYMBOL."
- (let ((alist gnus-shutdown-alist)
- entry)
- (while (setq entry (pop alist))
- (when (memq symbol (cdr entry))
- (funcall (car entry))))))
-
-\f
-;;;
-;;; Gnus Utility Functions
-;;;
-
-(defun gnus-find-subscribed-addresses ()
- "Return a regexp matching the addresses of all subscribed mail groups.
-It consists of the `to-address' or `to-list' parameter of all groups
-with a `subscribed' parameter."
- (let (group address addresses)
- (dolist (entry (cdr gnus-newsrc-alist))
- (setq group (car entry))
- (when (gnus-parameter-subscribed group)
- (setq address (mail-strip-quoted-names
- (or (gnus-group-fast-parameter group 'to-address)
- (gnus-group-fast-parameter group 'to-list))))
- (when address
- (add-to-list 'addresses address))))
- (when addresses
- (list (mapconcat 'regexp-quote addresses "\\|")))))
-
-(defmacro gnus-string-or (&rest strings)
- "Return the first element of STRINGS that is a non-blank string.
-STRINGS will be evaluated in normal `or' order."
- `(gnus-string-or-1 ',strings))
-
-(defun gnus-string-or-1 (strings)
- (let (string)
- (while strings
- (setq string (eval (pop strings)))
- (if (string-match "^[ \t]*$" string)
- (setq string nil)
- (setq strings nil)))
- string))
-
-(defun gnus-version (&optional arg)
- "Version number of this version of Gnus.
-If ARG, insert string at point."
- (interactive "P")
- (if arg
- (insert (message gnus-version))
- (message gnus-version)))
-
-(defun gnus-continuum-version (&optional version)
- "Return VERSION as a floating point number."
- (interactive)
- (unless version
- (setq version gnus-version))
- (when (or (string-match "^\\([^ ]+\\)? ?Gnus v?\\([0-9.]+\\)$" version)
- (string-match "^\\(.?\\)gnus-\\([0-9.]+\\)$" version))
- (let ((alpha (and (match-beginning 1) (match-string 1 version)))
- (number (match-string 2 version))
- major minor least)
- (unless (string-match
- "\\([0-9]\\)\\.\\([0-9]+\\)\\.?\\([0-9]+\\)?" number)
- (error "Invalid version string: %s" version))
- (setq major (string-to-number (match-string 1 number))
- minor (string-to-number (match-string 2 number))
- least (if (match-beginning 3)
- (string-to-number (match-string 3 number))
- 0))
- (string-to-number
- (if (zerop major)
- (format "%s00%02d%02d"
- (if (member alpha '("(ding)" "d"))
- "4.99"
- (+ 5 (* 0.02
- (abs
- (- (mm-char-int (aref (downcase alpha) 0))
- (mm-char-int ?t))))
- -0.01))
- minor least)
- (format "%d.%02d%02d" major minor least))))))
-
-(defun gnus-info-find-node (&optional nodename)
- "Find Info documentation of Gnus."
- (interactive)
- ;; Enlarge info window if needed.
- (let (gnus-info-buffer)
- (Info-goto-node (or nodename (cadr (assq major-mode gnus-info-nodes))))
- (setq gnus-info-buffer (current-buffer))
- (gnus-configure-windows 'info)))
-
-;;;
-;;; gnus-interactive
-;;;
-
-(defvar gnus-current-prefix-symbol nil
- "Current prefix symbol.")
-
-(defvar gnus-current-prefix-symbols nil
- "List of current prefix symbols.")
-
-(defun gnus-interactive (string &optional params)
- "Return a list that can be fed to `interactive'.
-See `interactive' for full documentation.
-
-Adds the following specs:
-
-y -- The current symbolic prefix.
-Y -- A list of the current symbolic prefix(es).
-A -- Article number.
-H -- Article header.
-g -- Group name."
- (let ((i 0)
- out c prompt)
- (while (< i (length string))
- (string-match ".\\([^\n]*\\)\n?" string i)
- (setq c (aref string i))
- (when (match-end 1)
- (setq prompt (match-string 1 string)))
- (setq i (match-end 0))
- ;; We basically emulate just about everything that
- ;; `interactive' does, but add the specs listed above.
- (push
- (cond
- ((= c ?a)
- (completing-read prompt obarray 'fboundp t))
- ((= c ?b)
- (read-buffer prompt (current-buffer) t))
- ((= c ?B)
- (read-buffer prompt (other-buffer (current-buffer))))
- ((= c ?c)
- (read-char))
- ((= c ?C)
- (completing-read prompt obarray 'commandp t))
- ((= c ?d)
- (point))
- ((= c ?D)
- (read-file-name prompt nil default-directory 'lambda))
- ((= c ?f)
- (read-file-name prompt nil nil 'lambda))
- ((= c ?F)
- (read-file-name prompt))
- ((= c ?k)
- (read-key-sequence prompt))
- ((= c ?K)
- (error "Not implemented spec"))
- ((= c ?e)
- (error "Not implemented spec"))
- ((= c ?m)
- (mark))
- ((= c ?N)
- (error "Not implemented spec"))
- ((= c ?n)
- (string-to-number (read-from-minibuffer prompt)))
- ((= c ?p)
- (prefix-numeric-value current-prefix-arg))
- ((= c ?P)
- current-prefix-arg)
- ((= c ?r)
- 'gnus-prefix-nil)
- ((= c ?s)
- (read-string prompt))
- ((= c ?S)
- (intern (read-string prompt)))
- ((= c ?v)
- (read-variable prompt))
- ((= c ?x)
- (read-minibuffer prompt))
- ((= c ?x)
- (eval-minibuffer prompt))
- ;; And here the new specs come.
- ((= c ?y)
- gnus-current-prefix-symbol)
- ((= c ?Y)
- gnus-current-prefix-symbols)
- ((= c ?g)
- (gnus-group-group-name))
- ((= c ?A)
- (gnus-summary-skip-intangible)
- (or (get-text-property (point) 'gnus-number)
- (gnus-summary-last-subject)))
- ((= c ?H)
- (gnus-data-header (gnus-data-find (gnus-summary-article-number))))
- (t
- (error "Non-implemented spec")))
- out)
- (cond
- ((= c ?r)
- (push (if (< (point) (mark)) (point) (mark)) out)
- (push (if (> (point) (mark)) (point) (mark)) out))))
- (setq out (delq 'gnus-prefix-nil out))
- (nreverse out)))
-
-(defun gnus-symbolic-argument (&optional arg)
- "Read a symbolic argument and a command, and then execute command."
- (interactive "P")
- (let* ((in-command (this-command-keys))
- (command in-command)
- gnus-current-prefix-symbols
- gnus-current-prefix-symbol
- syms)
- (while (equal in-command command)
- (message "%s-" (key-description (this-command-keys)))
- (push (intern (char-to-string (read-char))) syms)
- (setq command (read-key-sequence nil t)))
- (setq gnus-current-prefix-symbols (nreverse syms)
- gnus-current-prefix-symbol (car gnus-current-prefix-symbols))
- (call-interactively (key-binding command t))))
-
-;;; More various functions.
-
-(defsubst gnus-check-backend-function (func group)
- "Check whether GROUP supports function FUNC.
-GROUP can either be a string (a group name) or a select method."
- (ignore-errors
- (let ((method (if (stringp group)
- (car (gnus-find-method-for-group group))
- group)))
- (unless (featurep method)
- (require method))
- (fboundp (intern (format "%s-%s" method func))))))
-
-(defun gnus-group-read-only-p (&optional group)
- "Check whether GROUP supports editing or not.
-If GROUP is nil, `gnus-newsgroup-name' will be checked instead. Note
-that that variable is buffer-local to the summary buffers."
- (let ((group (or group gnus-newsgroup-name)))
- (not (gnus-check-backend-function 'request-replace-article group))))
-
-(defun gnus-virtual-group-p (group)
- "Say whether GROUP is virtual or not."
- (memq 'virtual (assoc (symbol-name (car (gnus-find-method-for-group group)))
- gnus-valid-select-methods)))
-
-(defun gnus-news-group-p (group &optional article)
- "Return non-nil if GROUP (and ARTICLE) come from a news server."
- (cond ((gnus-member-of-valid 'post group) ;Ordinary news group
- t) ;is news of course.
- ((not (gnus-member-of-valid 'post-mail group)) ;Non-combined.
- nil) ;must be mail then.
- ((vectorp article) ;Has header info.
- (eq (gnus-request-type group (mail-header-id article)) 'news))
- ((null article) ;Hasn't header info
- (eq (gnus-request-type group) 'news)) ;(unknown ==> mail)
- ((< article 0) ;Virtual message
- nil) ;we don't know, guess mail.
- (t ;Has positive number
- (eq (gnus-request-type group article) 'news)))) ;use it.
-
-;; Returns a list of writable groups.
-(defun gnus-writable-groups ()
- (let ((alist gnus-newsrc-alist)
- groups group)
- (while (setq group (car (pop alist)))
- (unless (gnus-group-read-only-p group)
- (push group groups)))
- (nreverse groups)))
-
-;; Check whether to use long file names.
-(defun gnus-use-long-file-name (symbol)
- ;; The variable has to be set...
- (and gnus-use-long-file-name
- ;; If it isn't a list, then we return t.
- (or (not (listp gnus-use-long-file-name))
- ;; If it is a list, and the list contains `symbol', we
- ;; return nil.
- (not (memq symbol gnus-use-long-file-name)))))
-
-;; Generate a unique new group name.
-(defun gnus-generate-new-group-name (leaf)
- (let ((name leaf)
- (num 0))
- (while (gnus-gethash name gnus-newsrc-hashtb)
- (setq name (concat leaf "<" (int-to-string (setq num (1+ num))) ">")))
- name))
-
-(defun gnus-ephemeral-group-p (group)
- "Say whether GROUP is ephemeral or not."
- (gnus-group-get-parameter group 'quit-config t))
-
-(defun gnus-group-quit-config (group)
- "Return the quit-config of GROUP."
- (gnus-group-get-parameter group 'quit-config t))
-
-(defun gnus-kill-ephemeral-group (group)
- "Remove ephemeral GROUP from relevant structures."
- (gnus-sethash group nil gnus-newsrc-hashtb))
-
-(defun gnus-simplify-mode-line ()
- "Make mode lines a bit simpler."
- (setq mode-line-modified (cdr gnus-mode-line-modified))
- (when (listp mode-line-format)
- (make-local-variable 'mode-line-format)
- (setq mode-line-format (copy-sequence mode-line-format))
- (when (equal (nth 3 mode-line-format) " ")
- (setcar (nthcdr 3 mode-line-format) " "))))
-
-;;; Servers and groups.
-
-(defsubst gnus-server-add-address (method)
- (let ((method-name (symbol-name (car method))))
- (if (and (memq 'address (assoc method-name gnus-valid-select-methods))
- (not (assq (intern (concat method-name "-address")) method))
- (memq 'physical-address (assq (car method)
- gnus-valid-select-methods)))
- (append method (list (list (intern (concat method-name "-address"))
- (nth 1 method))))
- method)))
-
-(defsubst gnus-method-to-server (method)
- (catch 'server-name
- (setq method (or method gnus-select-method))
-
- ;; Perhaps it is already in the cache.
- (mapc (lambda (name-method)
- (if (equal (cdr name-method) method)
- (throw 'server-name (car name-method))))
- gnus-server-method-cache)
-
- (mapc
- (lambda (server-alist)
- (mapc (lambda (name-method)
- (when (gnus-methods-equal-p (cdr name-method) method)
- (unless (member name-method gnus-server-method-cache)
- (push name-method gnus-server-method-cache))
- (throw 'server-name (car name-method))))
- server-alist))
- (let ((alists (list gnus-server-alist
- gnus-predefined-server-alist)))
- (if gnus-select-method
- (push (list (cons "native" gnus-select-method)) alists))
- alists))
-
- (let* ((name (if (member (cadr method) '(nil ""))
- (format "%s" (car method))
- (format "%s:%s" (car method) (cadr method))))
- (name-method (cons name method)))
- (unless (member name-method gnus-server-method-cache)
- (push name-method gnus-server-method-cache))
- name)))
-
-(defsubst gnus-server-to-method (server)
- "Map virtual server names to select methods."
- (or (and server (listp server) server)
- (cdr (assoc server gnus-server-method-cache))
- (let ((result
- (or
- ;; Perhaps this is the native server?
- (and (equal server "native") gnus-select-method)
- ;; It should be in the server alist.
- (cdr (assoc server gnus-server-alist))
- ;; It could be in the predefined server alist.
- (cdr (assoc server gnus-predefined-server-alist))
- ;; If not, we look through all the opened server
- ;; to see whether we can find it there.
- (let ((opened gnus-opened-servers))
- (while (and opened
- (not (equal server (format "%s:%s" (caaar opened)
- (cadaar opened)))))
- (pop opened))
- (caar opened))
- ;; It could be a named method, search all servers
- (let ((servers gnus-secondary-select-methods))
- (while (and servers
- (not (equal server (format "%s:%s" (caar servers)
- (cadar servers)))))
- (pop servers))
- (car servers))
- ;; This could be some sort of foreign server that I
- ;; simply haven't opened (yet). Do a brute-force scan
- ;; of the entire gnus-newsrc-alist for the server name
- ;; of every method. As a side-effect, loads the
- ;; gnus-server-method-cache so this only happens once,
- ;; if at all.
- (let ((alist (cdr gnus-newsrc-alist))
- method match)
- (while alist
- (setq method (gnus-info-method (pop alist)))
- (when (and (not (stringp method))
- (equal server (gnus-method-to-server method)))
- (setq match method
- alist nil)))
- match))))
- (when result
- (push (cons server result) gnus-server-method-cache))
- result)))
-
-(defsubst gnus-server-get-method (group method)
- ;; Input either a server name, and extended server name, or a
- ;; select method, and return a select method.
- (cond ((stringp method)
- (gnus-server-to-method method))
- ((equal method gnus-select-method)
- gnus-select-method)
- ((and (stringp (car method))
- group)
- (gnus-server-extend-method group method))
- ((and method
- (not group)
- (equal (cadr method) ""))
- method)
- (t
- (gnus-server-add-address method))))
-
-(defmacro gnus-method-equal (ss1 ss2)
- "Say whether two servers are equal."
- `(let ((s1 ,ss1)
- (s2 ,ss2))
- (or (equal s1 s2)
- (and (= (length s1) (length s2))
- (progn
- (while (and s1 (member (car s1) s2))
- (setq s1 (cdr s1)))
- (null s1))))))
-
-(defun gnus-methods-equal-p (m1 m2)
- (let ((m1 (or m1 gnus-select-method))
- (m2 (or m2 gnus-select-method)))
- (or (equal m1 m2)
- (and (eq (car m1) (car m2))
- (or (not (memq 'address (assoc (symbol-name (car m1))
- gnus-valid-select-methods)))
- (equal (nth 1 m1) (nth 1 m2)))))))
-
-(defun gnus-server-equal (m1 m2)
- "Say whether two methods are equal."
- (let ((m1 (cond ((null m1) gnus-select-method)
- ((stringp m1) (gnus-server-to-method m1))
- (t m1)))
- (m2 (cond ((null m2) gnus-select-method)
- ((stringp m2) (gnus-server-to-method m2))
- (t m2))))
- (gnus-method-equal m1 m2)))
-
-(defun gnus-servers-using-backend (backend)
- "Return a list of known servers using BACKEND."
- (let ((opened gnus-opened-servers)
- out)
- (while opened
- (when (eq backend (caaar opened))
- (push (caar opened) out))
- (pop opened))
- out))
-
-(defun gnus-archive-server-wanted-p ()
- "Say whether the user wants to use the archive server."
- (cond
- ((or (not gnus-message-archive-method)
- (not gnus-message-archive-group))
- nil)
- ((and gnus-message-archive-method gnus-message-archive-group)
- t)
- (t
- (let ((active (cadr (assq 'nnfolder-active-file
- gnus-message-archive-method))))
- (and active
- (file-exists-p active))))))
-
-(defsubst gnus-method-to-server-name (method)
- (concat
- (format "%s" (car method))
- (when (and
- (or (assoc (format "%s" (car method))
- (gnus-methods-using 'address))
- (gnus-server-equal method gnus-message-archive-method))
- (nth 1 method)
- (not (string= (nth 1 method) "")))
- (concat "+" (nth 1 method)))))
-
-(defsubst gnus-method-to-full-server-name (method)
- (format "%s+%s" (car method) (nth 1 method)))
-
-(defun gnus-group-prefixed-name (group method &optional full)
- "Return the whole name from GROUP and METHOD.
-Call with full set to get the fully qualified group name (even if the
-server is native)."
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- (if (or (not method)
- (and (not full) (gnus-server-equal method "native"))
- ;;;!!! This might not be right. We'll see...
- ;(string-match ":" group)
- )
- group
- (concat (gnus-method-to-server-name method) ":" group)))
-
-(defun gnus-group-guess-prefixed-name (group)
- "Guess the whole name from GROUP and METHOD."
- (gnus-group-prefixed-name group (gnus-find-method-for-group
- group)))
-
-(defun gnus-group-full-name (group method)
- "Return the full name from GROUP and METHOD, even if the method is native."
- (gnus-group-prefixed-name group method t))
-
-(defun gnus-group-guess-full-name (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group (gnus-find-method-for-group group))))
-
-(defun gnus-group-guess-full-name-from-command-method (group)
- "Guess the full name from GROUP, even if the method is native."
- (if (gnus-group-prefixed-p group)
- group
- (gnus-group-full-name group gnus-command-method)))
-
-(defun gnus-group-real-prefix (group)
- "Return the prefix of the current group name."
- (if (stringp group)
- (if (string-match "^[^:]+:" group)
- (substring group 0 (match-end 0))
- "")
- nil))
-
-(defun gnus-group-short-name (group)
- "Return the short group name."
- (let ((prefix (gnus-group-real-prefix group)))
- (if (< 0 (length prefix))
- (substring group (length prefix) nil)
- group)))
-
-(defun gnus-group-prefixed-p (group)
- "Return the prefix of the current group name."
- (< 0 (length (gnus-group-real-prefix group))))
-
-(defun gnus-summary-buffer-name (group)
- "Return the summary buffer name of GROUP."
- (concat "*Summary " (gnus-group-decoded-name group) "*"))
-
-(defun gnus-group-method (group)
- "Return the server or method used for selecting GROUP.
-You should probably use `gnus-find-method-for-group' instead."
- (let ((prefix (gnus-group-real-prefix group)))
- (if (equal prefix "")
- gnus-select-method
- (let ((servers gnus-opened-servers)
- (server "")
- backend possible found)
- (if (string-match "^[^\\+]+\\+" prefix)
- (setq backend (intern (substring prefix 0 (1- (match-end 0))))
- server (substring prefix (match-end 0) (1- (length prefix))))
- (setq backend (intern (substring prefix 0 (1- (length prefix))))))
- (while servers
- (when (eq (caaar servers) backend)
- (setq possible (caar servers))
- (when (equal (cadaar servers) server)
- (setq found (caar servers))))
- (pop servers))
- (or (car (rassoc found gnus-server-alist))
- found
- (car (rassoc possible gnus-server-alist))
- possible
- (list backend server))))))
-
-(defsubst gnus-native-method-p (method)
- "Return whether METHOD is the native select method."
- (gnus-method-equal method gnus-select-method))
-
-(defsubst gnus-secondary-method-p (method)
- "Return whether METHOD is a secondary select method."
- (let ((methods gnus-secondary-select-methods)
- (gmethod (inline (gnus-server-get-method nil method))))
- (while (and methods
- (not (gnus-method-equal
- (inline (gnus-server-get-method nil (car methods)))
- gmethod)))
- (setq methods (cdr methods)))
- methods))
-
-(defun gnus-method-simplify (method)
- "Return the shortest uniquely identifying string or method for METHOD."
- (cond ((stringp method)
- method)
- ((gnus-native-method-p method)
- nil)
- ((gnus-secondary-method-p method)
- (format "%s:%s" (nth 0 method) (nth 1 method)))
- (t
- method)))
-
-(defun gnus-groups-from-server (server)
- "Return a list of all groups that are fetched from SERVER."
- (let ((alist (cdr gnus-newsrc-alist))
- info groups)
- (while (setq info (pop alist))
- (when (gnus-server-equal (gnus-info-method info) server)
- (push (gnus-info-group info) groups)))
- (sort groups 'string<)))
-
-(defun gnus-group-foreign-p (group)
- "Say whether a group is foreign or not."
- (and (not (gnus-group-native-p group))
- (not (gnus-group-secondary-p group))))
-
-(defun gnus-group-native-p (group)
- "Say whether the group is native or not."
- (not (string-match ":" group)))
-
-(defun gnus-group-secondary-p (group)
- "Say whether the group is secondary or not."
- (gnus-secondary-method-p (gnus-find-method-for-group group)))
-
-(defun gnus-parameters-get-parameter (group)
- "Return the group parameters for GROUP from `gnus-parameters'."
- (let ((case-fold-search (if (eq gnus-parameters-case-fold-search 'default)
- case-fold-search
- gnus-parameters-case-fold-search))
- params-list)
- (dolist (elem gnus-parameters)
- (when (string-match (car elem) group)
- (setq params-list
- (nconc (gnus-expand-group-parameters
- (car elem) (cdr elem) group)
- params-list))))
- params-list))
-
-(defun gnus-expand-group-parameter (match value group)
- "Use MATCH to expand VALUE in GROUP."
- (with-temp-buffer
- (insert group)
- (goto-char (point-min))
- (while (re-search-forward match nil t)
- (replace-match value))
- (buffer-string)))
-
-(defun gnus-expand-group-parameters (match parameters group)
- "Go through PARAMETERS and expand them according to the match data."
- (let (new)
- (dolist (elem parameters)
- (if (and (stringp (cdr elem))
- (string-match "\\\\[0-9&]" (cdr elem)))
- (push (cons (car elem)
- (gnus-expand-group-parameter match (cdr elem) group))
- new)
- (push elem new)))
- new))
-
-(defun gnus-group-fast-parameter (group symbol &optional allow-list)
- "For GROUP, return the value of SYMBOL.
-
-You should call this in the `gnus-group-buffer' buffer.
-The function `gnus-group-find-parameter' will do that for you."
- ;; The speed trick: No cons'ing and quit early.
- (let* ((params (funcall gnus-group-get-parameter-function group))
- ;; Start easy, check the "real" group parameters.
- (simple-results
- (gnus-group-parameter-value params symbol allow-list t)))
- (if simple-results
- ;; Found results; return them.
- (car simple-results)
- ;; We didn't found it there, try `gnus-parameters'.
- (let ((result nil)
- (head nil)
- (tail gnus-parameters))
- ;; A good old-fashioned non-cl loop.
- (while tail
- (setq head (car tail)
- tail (cdr tail))
- ;; The car is regexp matching for matching the group name.
- (when (string-match (car head) group)
- ;; The cdr is the parameters.
- (setq result (gnus-group-parameter-value (cdr head)
- symbol allow-list))
- (when result
- ;; Expand if necessary.
- (if (and (stringp result) (string-match "\\\\[0-9&]" result))
- (setq result (gnus-expand-group-parameter (car head)
- result group)))
- ;; Exit the loop early.
- (setq tail nil))))
- ;; Done.
- result))))
-
-(defun gnus-group-find-parameter (group &optional symbol allow-list)
- "Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters.
-
-If you call this function inside a loop, consider using the faster
-`gnus-group-fast-parameter' instead."
- (save-excursion
- (set-buffer gnus-group-buffer)
- (if symbol
- (gnus-group-fast-parameter group symbol allow-list)
- (nconc
- (copy-sequence
- (funcall gnus-group-get-parameter-function group))
- (gnus-parameters-get-parameter group)))))
-
-(defun gnus-group-get-parameter (group &optional symbol allow-list)
- "Return the group parameters for GROUP.
-If SYMBOL, return the value of that symbol in the group parameters.
-If ALLOW-LIST, also allow list as a result.
-Most functions should use `gnus-group-find-parameter', which
-also examines the topic parameters."
- (let ((params (gnus-info-params (gnus-get-info group))))
- (if symbol
- (gnus-group-parameter-value params symbol allow-list)
- params)))
-
-(defun gnus-group-parameter-value (params symbol &optional
- allow-list present-p)
- "Return the value of SYMBOL in group PARAMS.
-If ALLOW-LIST, also allow list as a result."
- ;; We only wish to return group parameters (dotted lists) and
- ;; not local variables, which may have the same names.
- ;; But first we handle single elements...
- (or (car (memq symbol params))
- ;; Handle alist.
- (let (elem)
- (catch 'found
- (while (setq elem (pop params))
- (when (and (consp elem)
- (eq (car elem) symbol)
- (or allow-list
- (atom (cdr elem))))
- (throw 'found (if present-p (list (cdr elem))
- (cdr elem)))))))))
-
-(defun gnus-group-add-parameter (group param)
- "Add parameter PARAM to GROUP."
- (let ((info (gnus-get-info group)))
- (when info
- (gnus-group-remove-parameter group (if (consp param) (car param) param))
- ;; Cons the new param to the old one and update.
- (gnus-group-set-info (cons param (gnus-info-params info))
- group 'params))))
-
-(defun gnus-group-set-parameter (group name value)
- "Set parameter NAME to VALUE in GROUP."
- (let ((info (gnus-get-info group)))
- (when info
- (gnus-group-remove-parameter group name)
- (let ((old-params (gnus-info-params info))
- (new-params (list (cons name value))))
- (while old-params
- (when (or (not (listp (car old-params)))
- (not (eq (caar old-params) name)))
- (setq new-params (append new-params (list (car old-params)))))
- (setq old-params (cdr old-params)))
- (gnus-group-set-info new-params group 'params)))))
-
-(defun gnus-group-remove-parameter (group name)
- "Remove parameter NAME from GROUP."
- (let ((info (gnus-get-info group)))
- (when info
- (let ((params (gnus-info-params info)))
- (when params
- (setq params (delq name params))
- (while (assq name params)
- (gnus-pull name params))
- (gnus-info-set-params info params))))))
-
-(defun gnus-group-add-score (group &optional score)
- "Add SCORE to the GROUP score.
-If SCORE is nil, add 1 to the score of GROUP."
- (let ((info (gnus-get-info group)))
- (when info
- (gnus-info-set-score info (+ (gnus-info-score info) (or score 1))))))
-
-(defun gnus-short-group-name (group &optional levels)
- "Collapse GROUP name LEVELS.
-Select methods are stripped and any remote host name is stripped down to
-just the host name."
- (let* ((name "")
- (foreign "")
- (depth 0)
- (skip 1)
- (levels (or levels
- gnus-group-uncollapsed-levels
- (progn
- (while (string-match "\\." group skip)
- (setq skip (match-end 0)
- depth (+ depth 1)))
- depth))))
- ;; Separate foreign select method from group name and collapse.
- ;; If method contains a server, collapse to non-domain server name,
- ;; otherwise collapse to select method.
- (let* ((colon (string-match ":" group))
- (server (and colon (substring group 0 colon)))
- (plus (and server (string-match "+" server))))
- (when server
- (if plus
- (setq foreign (substring server (+ 1 plus)
- (string-match "\\." server))
- group (substring group (+ 1 colon)))
- (setq foreign server
- group (substring group (+ 1 colon))))
- (setq foreign (concat foreign ":")))
- ;; Collapse group name leaving LEVELS uncollapsed elements
- (let* ((slist (split-string group "/"))
- (slen (length slist))
- (dlist (split-string group "\\."))
- (dlen (length dlist))
- glist
- glen
- gsep
- res)
- (if (> slen dlen)
- (setq glist slist
- glen slen
- gsep "/")
- (setq glist dlist
- glen dlen
- gsep "."))
- (setq levels (- glen levels))
- (dolist (g glist)
- (push (if (>= (decf levels) 0)
- (if (zerop (length g))
- ""
- (substring g 0 1))
- g)
- res))
- (concat foreign (mapconcat 'identity (nreverse res) gsep))))))
-
-(defun gnus-narrow-to-body ()
- "Narrow to the body of an article."
- (narrow-to-region
- (progn
- (goto-char (point-min))
- (or (search-forward "\n\n" nil t)
- (point-max)))
- (point-max)))
-
-\f
-;;;
-;;; Kill file handling.
-;;;
-
-(defun gnus-apply-kill-file ()
- "Apply a kill file to the current newsgroup.
-Returns the number of articles marked as read."
- (if (or (file-exists-p (gnus-newsgroup-kill-file nil))
- (file-exists-p (gnus-newsgroup-kill-file gnus-newsgroup-name)))
- (gnus-apply-kill-file-internal)
- 0))
-
-(defun gnus-kill-save-kill-buffer ()
- (let ((file (gnus-newsgroup-kill-file gnus-newsgroup-name)))
- (when (get-file-buffer file)
- (save-excursion
- (set-buffer (get-file-buffer file))
- (when (buffer-modified-p)
- (save-buffer))
- (kill-buffer (current-buffer))))))
-
-(defcustom gnus-kill-file-name "KILL"
- "Suffix of the kill files."
- :group 'gnus-score-kill
- :group 'gnus-score-files
- :type 'string)
-
-(defun gnus-newsgroup-kill-file (newsgroup)
- "Return the name of a kill file name for NEWSGROUP.
-If NEWSGROUP is nil, return the global kill file name instead."
- (cond
- ;; The global KILL file is placed at top of the directory.
- ((or (null newsgroup)
- (string-equal newsgroup ""))
- (expand-file-name gnus-kill-file-name
- gnus-kill-files-directory))
- ;; Append ".KILL" to newsgroup name.
- ((gnus-use-long-file-name 'not-kill)
- (expand-file-name (concat (gnus-newsgroup-savable-name newsgroup)
- "." gnus-kill-file-name)
- gnus-kill-files-directory))
- ;; Place "KILL" under the hierarchical directory.
- (t
- (expand-file-name (concat (gnus-newsgroup-directory-form newsgroup)
- "/" gnus-kill-file-name)
- gnus-kill-files-directory))))
-
-;;; Server things.
-
-(defun gnus-member-of-valid (symbol group)
- "Find out if GROUP has SYMBOL as part of its \"valid\" spec."
- (memq symbol (assoc
- (symbol-name (car (gnus-find-method-for-group group)))
- gnus-valid-select-methods)))
-
-(defun gnus-method-option-p (method option)
- "Return non-nil if select METHOD has OPTION as a parameter."
- (when (stringp method)
- (setq method (gnus-server-to-method method)))
- (memq option (assoc (format "%s" (car method))
- gnus-valid-select-methods)))
-
-(defun gnus-similar-server-opened (method)
- (let ((opened gnus-opened-servers))
- (while (and method opened)
- (when (and (equal (cadr method) (cadaar opened))
- (equal (car method) (caaar opened))
- (not (equal method (caar opened))))
- (setq method nil))
- (pop opened))
- (not method)))
-
-(defun gnus-server-extend-method (group method)
- ;; This function "extends" a virtual server. If the server is
- ;; "hello", and the select method is ("hello" (my-var "something"))
- ;; in the group "alt.alt", this will result in a new virtual server
- ;; called "hello+alt.alt".
- (if (or (not (inline (gnus-similar-server-opened method)))
- (not (cddr method)))
- method
- `(,(car method) ,(concat (cadr method) "+" group)
- (,(intern (format "%s-address" (car method))) ,(cadr method))
- ,@(cddr method))))
-
-(defun gnus-server-status (method)
- "Return the status of METHOD."
- (nth 1 (assoc method gnus-opened-servers)))
-
-(defun gnus-group-name-to-method (group)
- "Guess a select method based on GROUP."
- (if (string-match ":" group)
- (let ((server (substring group 0 (match-beginning 0))))
- (if (string-match "\\+" server)
- (list (intern (substring server 0 (match-beginning 0)))
- (substring server (match-end 0)))
- (list (intern server) "")))
- gnus-select-method))
-
-(defun gnus-server-string (server)
- "Return a readable string that describes SERVER."
- (let* ((server (gnus-server-to-method server))
- (address (nth 1 server)))
- (if (and address
- (not (zerop (length address))))
- (format "%s using %s" address (car server))
- (format "%s" (car server)))))
-
-(defun gnus-find-method-for-group (group &optional info)
- "Find the select method that GROUP uses."
- (or gnus-override-method
- (and (not group)
- gnus-select-method)
- (and (not (gnus-group-entry group))
- ;; Killed or otherwise unknown group.
- (or
- ;; If we know a virtual server by that name, return its method.
- (gnus-server-to-method (gnus-group-server group))
- ;; Guess a new method as last resort.
- (gnus-group-name-to-method group)))
- (let ((info (or info (gnus-get-info group)))
- method)
- (if (or (not info)
- (not (setq method (gnus-info-method info)))
- (equal method "native"))
- gnus-select-method
- (setq method
- (cond ((stringp method)
- (inline (gnus-server-to-method method)))
- ((stringp (cadr method))
- (inline (gnus-server-extend-method group method)))
- (t
- method)))
- (cond ((equal (cadr method) "")
- method)
- ((null (cadr method))
- (list (car method) ""))
- (t
- (gnus-server-add-address method)))))))
-
-(defun gnus-methods-using (feature)
- "Find all methods that have FEATURE."
- (let ((valids gnus-valid-select-methods)
- outs)
- (while valids
- (when (memq feature (car valids))
- (push (car valids) outs))
- (setq valids (cdr valids)))
- outs))
-
-(eval-and-compile
- (autoload 'message-y-or-n-p "message" nil nil 'macro))
-
-(defun gnus-read-group (prompt &optional default)
- "Prompt the user for a group name.
-Disallow invalid group names."
- (let ((prefix "")
- group)
- (while (not group)
- (when (string-match
- gnus-invalid-group-regexp
- (setq group (read-string (concat prefix prompt)
- (cons (or default "") 0)
- 'gnus-group-history)))
- (let ((match (match-string 0 group)))
- ;; Might be okay (e.g. for nnimap), so ask the user:
- (unless (and (not (string-match "^$\\|:" match))
- (message-y-or-n-p
- "Proceed and create group anyway? " t
-"The group name \"" group "\" contains a forbidden character: \"" match "\".
-
-Usually, it's dangerous to create a group with this name, because it's not
-supported by all back ends and servers. On IMAP servers it should work,
-though. If you are really sure, you can proceed anyway and create the group.
-
-You may customize the variable `gnus-invalid-group-regexp', which currently is
-set to \"" gnus-invalid-group-regexp
-"\", if you want to get rid of this query permanently."))
- (setq prefix (format "Invalid group name: \"%s\". " group)
- group nil)))))
- group))
-
-(defun gnus-read-method (prompt)
- "Prompt the user for a method.
-Allow completion over sensible values."
- (let* ((open-servers
- (mapcar (lambda (i) (cons (format "%s:%s" (caar i) (cadar i)) i))
- gnus-opened-servers))
- (valid-methods
- (let (methods)
- (dolist (method gnus-valid-select-methods)
- (if (or (memq 'prompt-address method)
- (not (assoc (format "%s:" (car method)) open-servers)))
- (push method methods)))
- methods))
- (servers
- (append valid-methods
- open-servers
- gnus-predefined-server-alist
- gnus-server-alist))
- (method
- (completing-read
- prompt servers
- nil t nil 'gnus-method-history)))
- (cond
- ((equal method "")
- (setq method gnus-select-method))
- ((assoc method gnus-valid-select-methods)
- (let ((address (if (memq 'prompt-address
- (assoc method gnus-valid-select-methods))
- (read-string "Address: ")
- "")))
- (or (cadr (assoc (format "%s:%s" method address) open-servers))
- (list (intern method) address))))
- ((assoc method servers)
- method)
- (t
- (list (intern method) "")))))
-
-;;; Agent functions
-
-(defun gnus-agent-method-p (method)
- "Say whether METHOD is covered by the agent."
- (or (eq (car gnus-agent-method-p-cache) method)
- (setq gnus-agent-method-p-cache
- (cons method
- (member (if (stringp method)
- method
- (gnus-method-to-server method)) gnus-agent-covered-methods))))
- (cdr gnus-agent-method-p-cache))
-
-(defun gnus-online (method)
- (not
- (if gnus-plugged
- (eq (cadr (assoc method gnus-opened-servers)) 'offline)
- (gnus-agent-method-p method))))
-
-;;; User-level commands.
-
-;;;###autoload
-(defun gnus-slave-no-server (&optional arg)
- "Read network news as a slave, without connecting to the local server."
- (interactive "P")
- (gnus-no-server arg t))
-
-;;;###autoload
-(defun gnus-no-server (&optional arg slave)
- "Read network news.
-If ARG is a positive number, Gnus will use that as the startup
-level. If ARG is nil, Gnus will be started at level 2. If ARG is
-non-nil and not a positive number, Gnus will prompt the user for the
-name of an NNTP server to use.
-As opposed to `gnus', this command will not connect to the local
-server."
- (interactive "P")
- (gnus-no-server-1 arg slave))
-
-;;;###autoload
-(defun gnus-slave (&optional arg)
- "Read news as a slave."
- (interactive "P")
- (gnus arg nil 'slave))
-
-;;;###autoload
-(defun gnus-other-frame (&optional arg display)
- "Pop up a frame to read news.
-This will call one of the Gnus commands which is specified by the user
-option `gnus-other-frame-function' (default `gnus') with the argument
-ARG if Gnus is not running, otherwise just pop up a Gnus frame. The
-optional second argument DISPLAY should be a standard display string
-such as \"unix:0\" to specify where to pop up a frame. If DISPLAY is
-omitted or the function `make-frame-on-display' is not available, the
-current display is used."
- (interactive "P")
- (if (fboundp 'make-frame-on-display)
- (unless display
- (setq display (gnus-frame-or-window-display-name (selected-frame))))
- (setq display nil))
- (let ((alive (gnus-alive-p)))
- (unless (and alive
- (catch 'found
- (walk-windows
- (lambda (window)
- (when (and (or (not display)
- (equal display
- (gnus-frame-or-window-display-name
- window)))
- (with-current-buffer (window-buffer window)
- (string-match "\\`gnus-"
- (symbol-name major-mode))))
- (gnus-select-frame-set-input-focus
- (setq gnus-other-frame-object (window-frame window)))
- (select-window window)
- (throw 'found t)))
- 'ignore t)))
- (gnus-select-frame-set-input-focus
- (setq gnus-other-frame-object
- (if display
- (make-frame-on-display display gnus-other-frame-parameters)
- (make-frame gnus-other-frame-parameters))))
- (if alive
- (switch-to-buffer gnus-group-buffer)
- (funcall gnus-other-frame-function arg)
- (add-hook 'gnus-exit-gnus-hook
- '(lambda nil
- (when (and (frame-live-p gnus-other-frame-object)
- (cdr (frame-list)))
- (delete-frame gnus-other-frame-object))
- (setq gnus-other-frame-object nil)))))))
-
-;;;###autoload
-(defun gnus (&optional arg dont-connect slave)
- "Read network news.
-If ARG is non-nil and a positive number, Gnus will use that as the
-startup level. If ARG is non-nil and not a positive number, Gnus will
-prompt the user for the name of an NNTP server to use."
- (interactive "P")
- (unless (byte-code-function-p (symbol-function 'gnus))
- (message "You should byte-compile Gnus")
- (sit-for 2))
- (gnus-1 arg dont-connect slave))
-
-;; Allow redefinition of Gnus functions.
-
-(gnus-ems-redefine)
-
-(provide 'gnus)
-
-;;; arch-tag: acebeeab-f331-4f8f-a7ea-89c58c84f636
-;;; gnus.el ends here
+++ /dev/null
-;;; gpg-ring.el --- Major mode for editing GnuPG key rings.
-
-;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart
-
-;; Author: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
-;; Maintainer: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
-;; Keywords: crypto
-;; Created: 2000-04-28
-
-;; This file is NOT (yet?) 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-
-\f
-;;; Code:
-
-(require 'gpg)
-(eval-when-compile (require 'cl))
-
-;;;; Customization:
-
-;;; Customization: Groups:
-
-(defgroup gpg-ring nil
- "GNU Privacy Guard user interface."
- :tag "GnuPG user interface"
- :group 'gpg)
-
-;;; Customization: Variables:
-
-(defface gpg-ring-key-invalid-face
- '((((class color))
- (:foreground "yellow" :background "red"))
- (t (:bold t :italic t :underline t)))
- "Face for strings indicating key invalidity."
- :group 'gpg-ring)
-
-(defface gpg-ring-uncertain-validity-face
- '((((class color)) (:foreground "red"))
- (t (:bold t)))
- "Face for strings indicating uncertain validity."
- :group 'gpg-ring)
-
-(defface gpg-ring-full-validity-face
- '((((class color)) (:foreground "ForestGreen" :bold t))
- (t (:bold t)))
- "Face for strings indicating key invalidity."
- :group 'gpg-ring)
-
-(defvar gpg-ring-mode-hook nil
- "Normal hook run when entering GnuPG ring mode.")
-
-;;; Constants
-
-(defconst gpg-ring-algo-alist
- '((rsa . "RSA")
- (rsa-encrypt-only . "RSA-E")
- (rsa-sign-only . "RSA-S")
- (elgamal-encrypt-only . "ELG-E")
- (dsa . "DSA")
- (elgamal . "ELG-E"))
- "Alist mapping algorithm IDs to algorithm abbreviations.")
-
-(defconst gpg-ring-trust-alist
- '((not-known "???" gpg-ring-uncertain-validity-face)
- (disabled "DIS" gpg-ring-key-invalid-face)
- (revoked "REV" gpg-ring-key-invalid-face)
- (expired "EXP" gpg-ring-key-invalid-face)
- (trust-undefined "QES" gpg-ring-uncertain-validity-face)
- (trust-none "NON" gpg-ring-uncertain-validity-face)
- (trust-marginal "MAR")
- (trust-full "FUL" gpg-ring-full-validity-face)
- (trust-ultimate "ULT" gpg-ring-full-validity-face))
- "Alist mapping trust IDs to trust abbrevs and faces.")
-
-(defvar gpg-ring-mode-map
- (let ((map (make-keymap)))
- (suppress-keymap map t)
- map)
- "Keymap for `gpg-ring-mode'.")
-
-(define-key gpg-ring-mode-map "0" 'delete-window)
-(define-key gpg-ring-mode-map "1" 'delete-other-windows)
-(define-key gpg-ring-mode-map "M" 'gpg-ring-mark-process-all)
-(define-key gpg-ring-mode-map "U" 'gpg-ring-unmark-all)
-(define-key gpg-ring-mode-map "a" 'gpg-ring-toggle-show-unusable)
-(define-key gpg-ring-mode-map "d" 'gpg-ring-mark-delete)
-(define-key gpg-ring-mode-map "f" 'gpg-ring-update-key)
-(define-key gpg-ring-mode-map "g" 'gpg-ring-update)
-(define-key gpg-ring-mode-map "i" 'gpg-ring-show-key)
-(define-key gpg-ring-mode-map "l" 'gpg-ring-toggle-show-all-ids)
-(define-key gpg-ring-mode-map "m" 'gpg-ring-mark-process)
-(define-key gpg-ring-mode-map "n" 'gpg-ring-next-record)
-(define-key gpg-ring-mode-map "p" 'gpg-ring-previous-record)
-(define-key gpg-ring-mode-map "q" 'gpg-ring-quit)
-(define-key gpg-ring-mode-map "u" 'gpg-ring-unmark)
-(define-key gpg-ring-mode-map "x" 'gpg-ring-extract-keys)
-(define-key gpg-ring-mode-map "X" 'gpg-ring-extract-keys-to-kill)
-
-(define-key gpg-ring-mode-map "\C-c\C-c" 'gpg-ring-action)
-
-;;; Internal functions:
-
-(defvar gpg-ring-key-list
- nil
- "List of keys in the key list buffer.")
-(make-variable-buffer-local 'gpg-ring-key-list)
-
-(defvar gpg-ring-update-funcs
- nil
- "List of functions called to obtain the key list.")
-(make-variable-buffer-local 'gpg-ring-update-funcs)
-
-(defvar gpg-ring-show-unusable
- nil
- "If t, show expired, revoked and disabled keys, too.")
-(make-variable-buffer-local 'gpg-ring-show-unusable)
-
-(defvar gpg-ring-show-all-ids
- nil
- "If t, show all user IDs. If nil, show only the primary user ID.")
-(make-variable-buffer-local 'gpg-ring-show-all-ids)
-
-(defvar gpg-ring-marks-alist
- nil
- "Alist of (UNIQUE-ID MARK KEY).
-UNIQUE-ID is a unique key ID from GnuPG. MARK is either `?D'
-(marked for deletion), or `?*' (marked for processing).")
-(make-variable-buffer-local 'gpg-ring-marks-alist)
-
-(defvar gpg-ring-action
- nil
- "Function to call when `gpg-ring-action' is invoked.
-A list of the keys which are marked for processing is passed as argument.")
-(make-variable-buffer-local 'gpg-ring-action)
-
-(defun gpg-ring-mode ()
- "Mode for editing GnuPG key rings.
-\\{gpg-ring-mode-map}
-Turning on gpg-ring-mode runs `gpg-ring-mode-hook'."
- (interactive)
- (kill-all-local-variables)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (use-local-map gpg-ring-mode-map)
- (setq mode-name "Key Ring")
- (setq major-mode 'gpg-ring-mode)
- (run-hooks 'gpg-ring-mode-hook))
-
-
-(defmacro gpg-ring-record-start (&optional pos)
- "Return buffer position of start of record containing POS."
- `(get-text-property (or ,pos (point)) 'gpg-record-start))
-
-(defun gpg-ring-current-key (&optional pos)
- "Return GnuPG key at POS, or at point if ommitted."
- (or (get-text-property (or pos (point)) 'gpg-key)
- (error "No record on current line")))
-
-(defun gpg-ring-goto-record (pos)
- "Go to record starting at POS.
-Position point after the marks at the beginning of a record."
- (goto-char pos)
- (forward-char 2))
-
-(defun gpg-ring-next-record ()
- "Advances point to the start of the next record."
- (interactive)
- (let ((start (next-single-property-change
- (point) 'gpg-record-start nil (point-max))))
- ;; Don't advance to the last line of the buffer.
- (when (/= start (point-max))
- (gpg-ring-goto-record start))))
-
-(defun gpg-ring-previous-record ()
- "Advances point to the start of the previous record."
- (interactive)
- ;; The last line of the buffer doesn't contain a record.
- (let ((start (gpg-ring-record-start)))
- (if start
- (gpg-ring-goto-record (previous-single-property-change
- start 'gpg-record-start nil (point-min)))
- (gpg-ring-goto-record
- (gpg-ring-record-start (1- (point-max)))))))
-
-(defun gpg-ring-set-mark (&optional pos mark)
- "Set MARK on record at POS, or at point if POS is omitted.
-If MARK is omitted, clear it."
- (save-excursion
- (let* ((start (gpg-ring-record-start pos))
- (key (gpg-ring-current-key start))
- (id (gpg-key-unique-id key))
- (entry (assoc id gpg-ring-marks-alist))
- buffer-read-only)
- (goto-char start)
- ;; Replace the mark character.
- (subst-char-in-region (point) (1+ (point)) (char-after)
- (or mark ? ))
- ;; Store the mark in alist.
- (if entry
- (setcdr entry (if mark (list mark key)))
- (when mark
- (push (list id mark key) gpg-ring-marks-alist))))))
-
-(defun gpg-ring-marked-keys (&optional only-marked mark)
- "Return list of key specs which have MARK.
-If no marks are present and ONLY-MARKED is not nil, return singleton
-list with key of the current record. If MARK is omitted, `?*' is
-used."
- (let ((the-marker (or mark ?*))
- (marks gpg-ring-marks-alist)
- key-list)
- (while marks
- (let ((mark (pop marks)))
- ;; If this entry has got the right mark ...
- (when (equal (nth 1 mark) the-marker)
- ;; ... rember the key spec.
- (push (nth 2 mark) key-list))))
- (or key-list (if (not only-marked) (list (gpg-ring-current-key))))))
-
-(defun gpg-ring-mark-process ()
- "Mark record at point for processing."
- (interactive)
- (gpg-ring-set-mark nil ?*)
- (gpg-ring-next-record))
-
-(defun gpg-ring-mark-delete ()
- "Mark record at point for processing."
- (interactive)
- (gpg-ring-set-mark nil ?D)
- (gpg-ring-next-record))
-
-(defun gpg-ring-unmark ()
- "Mark record at point for processing."
- (interactive)
- (gpg-ring-set-mark)
- (gpg-ring-next-record))
-
-(defun gpg-ring-mark-process-all ()
- "Put process mark on all records."
- (interactive)
- (setq gpg-ring-marks-alist
- (mapcar (lambda (key)
- (list (gpg-key-unique-id key) ?* key))
- gpg-ring-key-list))
- (gpg-ring-regenerate))
-
-(defun gpg-ring-unmark-all ()
- "Remove all record marks."
- (interactive)
- (setq gpg-ring-marks-alist nil)
- (gpg-ring-regenerate))
-
-(defun gpg-ring-toggle-show-unusable ()
- "Toggle value if `gpg-ring-show-unusable'."
- (interactive)
- (setq gpg-ring-show-unusable (not gpg-ring-show-unusable))
- (gpg-ring-regenerate))
-
-(defun gpg-ring-toggle-show-all-ids ()
- "Toggle value of `gpg-ring-show-all-ids'."
- (interactive)
- (setq gpg-ring-show-all-ids (not gpg-ring-show-all-ids))
- (gpg-ring-regenerate))
-
-(defvar gpg-ring-output-buffer-name "*GnuPG Output*"
- "Name buffer to which output from GnuPG is sent.")
-
-(defmacro gpg-ring-with-output-buffer (&rest body)
- "Erase GnuPG output buffer, evaluate BODY in it, and display it."
- `(with-current-buffer (get-buffer-create gpg-ring-output-buffer-name)
- (erase-buffer)
- (setq truncate-lines t)
- ,@body
- (goto-char (point-min))
- (display-buffer gpg-ring-output-buffer-name)))
-
-(defun gpg-ring-quit ()
- "Bury key list buffer and kill GnuPG output buffer."
- (interactive)
- (let ((output (get-buffer gpg-ring-output-buffer-name)))
- (when output
- (kill-buffer output)))
- (when (eq 'gpg-ring-mode major-mode)
- (bury-buffer)))
-
-(defun gpg-ring-show-key ()
- "Show information for current key."
- (interactive)
- (let ((keys (gpg-ring-marked-keys)))
- (gpg-ring-with-output-buffer
- (gpg-key-insert-information (gpg-key-unique-id-list keys)))))
-
-(defun gpg-ring-extract-keys ()
- "Export currently selected public keys in ASCII armor."
- (interactive)
- (let ((keys (gpg-ring-marked-keys)))
- (gpg-ring-with-output-buffer
- (gpg-key-insert-public-key (gpg-key-unique-id-list keys)))))
-
-(defun gpg-ring-extract-keys-to-kill ()
- "Export currently selected public keys in ASCII armor to kill ring."
- (interactive)
- (let ((keys (gpg-ring-marked-keys)))
- (with-temp-buffer
- (gpg-key-insert-public-key (gpg-key-unique-id-list keys))
- (copy-region-as-kill (point-min) (point-max)))))
-
-(defun gpg-ring-update-key ()
- "Fetch key information from key server."
- (interactive)
- (let ((keys (gpg-ring-marked-keys)))
- (gpg-ring-with-output-buffer
- (gpg-key-retrieve (gpg-key-unique-id-list keys)))))
-
-(defun gpg-ring-insert-key-stat (key)
- (let* ((validity (gpg-key-validity key))
- (validity-entry (assq validity gpg-ring-trust-alist))
- (trust (gpg-key-trust key))
- (trust-entry (assq trust gpg-ring-trust-alist)))
- ;; Insert abbrev for key status.
- (let ((start (point)))
- (insert (nth 1 validity-entry))
- ;; Change face if necessary.
- (when (nth 2 validity-entry)
- (add-text-properties start (point)
- (list 'face (nth 2 validity-entry)))))
- ;; Trust, key ID, length, algorithm, creation date.
- (insert (format "/%s %-8s/%4d/%-5s created %s"
- (nth 1 trust-entry)
- (gpg-short-key-id key)
- (gpg-key-length key)
- (cdr (assq (gpg-key-algorithm key) gpg-ring-algo-alist))
- (gpg-key-creation-date key)))
- ;; Expire date.
- (when (gpg-key-expire-date key)
- (insert ", ")
- (let ((start (point))
- (expired (eq 'expired validity))
- (notice (concat )))
- (insert (if expired "EXPIRED" "expires")
- " " (gpg-key-expire-date key))
- (when expired
- (add-text-properties start (point)
- '(face gpg-ring-key-invalid-face)))))))
-
-(defun gpg-ring-insert-key (key &optional mark)
- "Inserts description for KEY into current buffer before point."
- (let ((start (point)))
- (insert (if mark mark " ")
- " " (gpg-key-primary-user-id key) "\n"
- " ")
- (gpg-ring-insert-key-stat key)
- (insert "\n")
- (when gpg-ring-show-all-ids
- (let ((uids (gpg-key-user-ids key)))
- (while uids
- (insert " ID " (pop uids) "\n"))))
- (add-text-properties start (point)
- (list 'gpg-record-start start
- 'gpg-key key))))
-
-(defun gpg-ring-regenerate ()
- "Regenerate the key list buffer from stored data."
- (interactive)
- (let* ((key-list gpg-ring-key-list)
- ;; Record position of point.
- (old-record (if (eobp) ; No record on last line.
- nil
- (gpg-key-unique-id (gpg-ring-current-key))))
- (old-pos (if old-record (- (point) (gpg-ring-record-start))))
- found new-pos new-pos-offset buffer-read-only new-marks)
- ;; Replace buffer contents with new data.
- (erase-buffer)
- (while key-list
- (let* ((key (pop key-list))
- (id (gpg-key-unique-id key))
- (mark (assoc id gpg-ring-marks-alist)))
- (when (or gpg-ring-show-unusable
- (not (memq (gpg-key-validity key)
- '(disabled revoked expired))))
- ;; Check if point was in this record.
- (when (and old-record
- (string-equal old-record id))
- (setq new-pos (point))
- (setq new-pos-offset (+ new-pos old-pos)))
- ;; Check if this record was marked.
- (if (nth 1 mark)
- (progn
- (push mark new-marks)
- (gpg-ring-insert-key key (nth 1 mark)))
- (gpg-ring-insert-key key)))))
- ;; Replace mark alist with the new one (which does not contain
- ;; marks for records which vanished during this update).
- (setq gpg-ring-marks-alist new-marks)
- ;; Restore point.
- (if (not old-record)
- ;; We were at the end of the buffer before.
- (goto-char (point-max))
- (if new-pos
- (if (and (< new-pos-offset (point-max))
- (equal old-record (gpg-key-unique-id
- (gpg-ring-current-key new-pos-offset))))
- ;; Record is there, with offset.
- (goto-char new-pos-offset)
- ;; Record is there, but not offset.
- (goto-char new-pos))
- ;; Record is not there.
- (goto-char (point-min))))))
-
-(defun gpg-ring-update ()
- "Update the key list buffer with new data."
- (interactive)
- (let ((funcs gpg-ring-update-funcs)
- old)
- ;; Merge the sorted lists obtained by calling elements of
- ;; `gpg-ring-update-funcs'.
- (while funcs
- (let ((additional (funcall (pop funcs)))
- new)
- (while (and additional old)
- (if (gpg-key-lessp (car additional) (car old))
- (push (pop additional) new)
- (if (gpg-key-lessp (car old) (car additional))
- (push (pop old) new)
- ;; Keys are perhaps equal. Always Add old key.
- (push (pop old) new)
- ;; If new key is equal, drop it, otherwise add it as well.
- (if (string-equal (gpg-key-unique-id (car old))
- (gpg-key-unique-id (car additional)))
- (pop additional)
- (push (pop additional) new)))))
- ;; Store new list as old one for next round.
- (setq old (nconc (nreverse new) old additional))))
- ;; Store the list in the buffer.
- (setq gpg-ring-key-list old))
- (gpg-ring-regenerate))
-
-(defun gpg-ring-action ()
- "Perform the action associated with this buffer."
- (interactive)
- (if gpg-ring-action
- (funcall gpg-ring-action (gpg-ring-marked-keys))
- (error "No action for this buffer specified")))
-
-;;;###autoload
-(defun gpg-ring-keys (&optional key-list-funcs action)
- (interactive)
- (let ((buffer (get-buffer-create "*GnuPG Key List*")))
- (with-current-buffer buffer
- (gpg-ring-mode)
- (setq gpg-ring-action action)
- (setq gpg-ring-update-funcs key-list-funcs key-list-funcs)
- (gpg-ring-update)
- (goto-char (point-min)))
- (switch-to-buffer buffer)))
-
-;;;###autoload
-(defun gpg-ring-public (key-spec)
- "List public keys matching keys KEY-SPEC."
- (interactive "sList public keys containing: ")
- (gpg-ring-keys `((lambda () (gpg-key-list-keys ,key-spec)))))
-
-(provide 'gpg-ring)
-
-;;; arch-tag: a4c5b2d1-aff0-4ab6-96e9-267727226c2d
-;;; gpg-ring.el ends here
+++ /dev/null
-;;; gpg.el --- Interface to GNU Privacy Guard
-
-;; Copyright (C) 2000 RUS-CERT, University Of Stuttgart
-
-;; Author: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
-;; Maintainer: Florian Weimer <Florian.Weimer@RUS.Uni-Stuttgart.DE>
-;; Keywords: crypto
-;; Created: 2000-04-15
-
-;; This file is NOT (yet?) 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
-;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
-;;
-;; This code is not well-tested. BE CAREFUL!
-;;
-;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
-;; ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA ALPHA
-
-;; Implemented features which can be tested:
-;;
-;; * Customization for all flavors of PGP is possible.
-;; * The main operations (verify, decrypt, sign, encrypt, sign &
-;; encrypt) are implemented.
-;; * Optionally, Gero Treuner's gpg-2comp script is supported,
-;; to generate data which is compatible with PGP 2.6.3.
-
-;; Customizing external programs
-;; =============================
-
-;; The customization are very similar to those of others programs,
-;; only the C-ish "%" constructs have been replaced by more Lisp-like
-;; syntax.
-;;
-;; First, you have to adjust the default executable paths
-;; (`gpg-command-default-alist', customization group `gpg-options',
-;; "Controlling GnuPG invocation."). After that, you should
-;; change the configuration options which control how specific
-;; command line flags are built (`gpg-command-flag-sign-with-key',
-;; (`gpg-command-flag-recipient'). The elements of these lists are
-;; concatenated without spaces, and a new argument is only started
-;; where indicated. The `gpg-command-flag-recipient' list is special:
-;; it consists of two parts, the first one remains at the beginning
-;; of the argument, the second one is repeated for each recipient.
-;; Finally, `gpg-command-passphrase-env' has to be changed if there's
-;; no command line flag to force the external program to read the data
-;; from standard input before the message.
-;;
-;; In customization group `gpg-commands', "Controlling GnuPG
-;; invocation.", you have to supply the actual syntax for external
-;; program calls. Each variable consists of a pair of a program
-;; specification (if a Lisp symbol is given here, it is translated
-;; via `gpg-command-default-alist') and a list of program arguments
-;; with placeholders. Please read the documentation of each variable
-;; before making your adjustments and try to match the given
-;; requirements as closely as possible!
-;;
-;; The `gpg-commands-key' group, "GnuPG Key Management Commands.",
-;; specifies key management commands. The syntax of these variables
-;; is like those in the `gpg-commands' group. Note that the output
-;; format of some of these external programs has to match very close
-;; that of GnuPG. Additional tools (Thomas Roessler's "pgpring.c")
-;; are available if your favorite implementation of OpenPGP cannot
-;; output the this format.
-
-;; Security considerations
-;; =======================
-
-;; On a typical multiuser UNIX system, the memory image of the
-;; Emacs process is not locked, therefore it can be swapped to disk
-;; at any time. As a result, the passphrase might show up in the
-;; swap space (even if you don't use the passphrase cache, i.e. if
-;; `gpg-passphrase-timeout' is 0). If someone is able to run `gdb' or
-;; another debugger on your Emacs process, he might be able to recover
-;; the passphrase as well. Unfortunately, nothing can be done in
-;; order to prevent this at the moment.
-;;
-;; BE CAREFUL: If you use the passphrase cache feature, the passphrase
-;; is stored in the variable `gpg-passphrase' -- and it is NOT
-;; encrypted in any way. (This is a conceptual problem because the
-;; nature of the passphrase cache requires that Emacs is able to
-;; decrypt automatically, so only a very weak protection could be
-;; applied anyway.)
-;;
-;; In addition, if you use an unpatched Emacs 20 (and earlier
-;; versions), passwords show up in the output of the `view-lossage'
-;; function (bound to `C-h l' by default).
-
-\f
-;;; Code:
-
-(if (featurep 'xemacs)
- (require 'timer-funcs)
- (require 'timer))
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (defalias 'gpg-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
-;; itimer/timer compatibility
-(eval-and-compile
- (if (featurep 'xemacs)
- (progn
- (defalias 'gpg-cancel-timer 'delete-itimer)
- (defalias 'gpg-timer-activate 'activate-itimer)
- (defalias 'gpg-timer-create 'make-itimer)
- (defalias 'gpg-timer-set-function 'set-itimer-function)
- (defalias 'gpg-timer-set-time 'set-itimer-value))
- (defalias 'gpg-cancel-timer 'cancel-timer)
- (defalias 'gpg-timer-activate 'timer-activate)
- (defalias 'gpg-timer-create 'timer-create)
- (defalias 'gpg-timer-set-function 'timer-set-function)
- (defalias 'gpg-timer-set-time 'timer-set-time)))
-
-;;;; Customization:
-
-;;; Customization: Groups:
-
-(defgroup gpg nil
- "GNU Privacy Guard interface."
- :tag "GnuPG"
- :group 'processes)
-
-(defgroup gpg-options nil
- "Controlling GnuPG invocation."
- :tag "GnuPG Options"
- :group 'gpg)
-
-(defgroup gpg-commands nil
- "Primary GnuPG Operations."
- :tag "GnuPG Commands"
- :group 'gpg)
-
-(defgroup gpg-commands-key nil
- "Commands for GnuPG key management."
- :tag "GnuPG Key Commands"
- :group 'gpg-commands)
-
-;;; Customization: Widgets:
-
-(if (get 'alist 'widget-type)
- (define-widget 'gpg-command-alist 'alist
- "An association list for GnuPG command names."
- :key-type '(symbol :tag "Abbreviation")
- :value-type '(string :tag "Program name")
- :convert-widget 'widget-alist-convert-widget
- :tag "Alist")
- (define-widget 'gpg-command-alist 'repeat
- "An association list for GnuPG command names."
- :args '((cons :format "%v"
- (symbol :tag "Abbreviation")
- (string :tag "Program name")))
- :tag "Alist"))
-
-(define-widget 'gpg-command-program 'choice
- "Widget for entering the name of a program (mostly the GnuPG binary)."
- :tag "Program"
- :args '((const :tag "Default GnuPG program."
- :value gpg)
- (const :tag "GnuPG compatibility wrapper."
- :value gpg-2comp)
- (const :tag "Disabled"
- :value nil)
- (string :tag "Custom program" :format "%v")))
-
-(define-widget 'gpg-command-sign-options 'cons
- "Widget for entering signing options."
- :args '(gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert armor option here if necessary."
- :value armor)
- (const :tag "Insert text mode option here if necessary."
- :value textmode)
- (const :tag "Insert the sign with key option here if necessary."
- :value sign-with-key)
- (string :format "%v")))))
-
-(define-widget 'gpg-command-key-options 'cons
- "Widget for entering key command options."
- :args '(gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert key ID here."
- :value key-id)
- (string :format "%v")))))
-
-;;; Customization: Variables:
-
-;;; Customization: Variables: Paths and Flags:
-
-(defcustom gpg-passphrase-timeout
- 0
- "Timeout (in seconds) for the passphrase cache.
-The passphrase cache is cleared after is hasn't been used for this
-many seconds. The values 0 means that the passphrase is not cached at
-all."
- :tag "Passphrase Timeout"
- :type 'number
- :group 'gpg-options)
-
-(defcustom gpg-default-key-id
- nil
- "Default key/user ID used for signatures."
- :tag "Default Key ID"
- :type '(choice
- (const :tag "Use GnuPG default." :value nil)
- (string))
- :group 'gpg-options)
-
-(defcustom gpg-temp-directory
- (expand-file-name "~/tmp")
- "Directory for temporary files.
-If you are running Emacs 20, this directory must have mode 0700."
- :tag "Temp directory"
- :type 'string
- :group 'gpg-options)
-
-(defcustom gpg-command-default-alist
- '((gpg . "gpg")
- (gpg-2comp . "gpg"))
- "Default paths for some GnuPG-related programs.
-Modify this variable if you have to change the paths to the
-executables required by the GnuPG interface. You can enter \"gpg-2comp\"
-for `gpg-2comp' if you have obtained this script, in order to gain
-PGP 2.6.x compatibility."
- :tag "GnuPG programs"
- :type 'gpg-command-alist
- :group 'gpg-options)
-
-(defcustom gpg-command-all-arglist
- nil
- "List of arguments to add to all GPG commands."
- :tag "All command args"
- :group 'gpg-options)
-
-(defcustom gpg-command-flag-textmode "--textmode"
- "The flag to indicate canonical text mode to GnuPG."
- :tag "Text mode flag"
- :type 'string
- :group 'gpg-options)
-
-(defcustom gpg-command-flag-armor "--armor"
- "The flag to request ASCII-armoring output from GnuPG."
- :tag "Armor flag"
- :type 'string
- :group 'gpg-options)
-
-(defcustom gpg-command-flag-sign-with-key '("--local-user=" sign-with-key)
- "String to include to specify the signing key ID.
-The elements are concatenated (without spaces) to form a command line
-option."
- :tag "Sign with key flag"
- :type '(repeat :tag "Argument parts"
- (choice :format "%[Type%] %v"
- (const :tag "Start next argument." :value next-argument)
- (const :tag "Insert signing key ID here." :value sign-with-key)
- (string)))
- :group 'gpg-options)
-
-(defcustom gpg-command-flag-recipient
- '(nil . ("-r" next-argument recipient next-argument))
- "Format of a recipient specification.
-The elements are concatenated (without spaces) to form a command line
-option. The second part is repeated for each recipient."
- :tag "Recipients Flag"
- :type '(cons
- (repeat :tag "Common prefix"
- (choice :format "%[Type%] %v"
- (const :tag "Start next argument." :value next-argument)
- (string)))
- (repeat :tag "For each recipient"
- (choice :format "%[Type%] %v"
- (const :tag "Start next argument." :value next-argument)
- (const :tag "Insert recipient key ID here." :value recipient)
- (string))))
- :group 'gpg-options)
-
-(defcustom gpg-command-passphrase-env
- nil
- "Environment variable to set when a passphrase is required, or nil.
-If an operation is invoked which requires a passphrase, this
-environment variable is set before calling the external program to
-indicate that it should read the passphrase from standard input."
- :tag "Passphrase environment"
- :type '(choice
- (const :tag "Disabled" :value nil)
- (cons
- (string :tag "Variable")
- (string :tag "Value")))
- :group 'gpg-options)
-
-;;; Customization: Variables: GnuPG Commands:
-
-(defcustom gpg-command-verify
- '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" signature-file message-file))
- "Command to verify a detached signature.
-The invoked program has to read the signed message and the signature
-from the given files. It should write human-readable information to
-standard output and/or standard error. The program shall not convert
-charsets or line endings; the input data shall be treated as binary."
- :tag "Verify Command"
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert name of file containing the message here."
- :value message-file)
- (const :tag "Insert name of file containing the signature here."
- :value signature-file)
- (string :format "%v"))))
- :group 'gpg-commands)
-
-(defcustom gpg-command-verify-cleartext
- '(gpg . ("--status-fd" "1" "--batch" "--verbose" "--verify" message-file))
- "Command to verify a message.
-The invoked program has to read the signed message from the given
-file. It should write human-readable information to standard output
-and/or standard error. The program shall not convert charsets or line
-endings; the input data shall be treated as binary."
- :tag "Cleartext Verify Command"
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert name of file containing the message here."
- :value message-file)
- (string :format "%v"))))
- :group 'gpg-commands)
-
-(defcustom gpg-command-decrypt
- '(gpg . ("--status-fd" "2" "--decrypt" "--batch" "--passphrase-fd=0"))
- "Command to decrypt a message.
-The invoked program has to read the passphrase from standard
-input, followed by the encrypted message. It writes the decrypted
-message to standard output, and human-readable diagnostic messages to
-standard error."
- :tag "Decrypt Command"
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert name of file containing the message here."
- :value message-file)
- (string :format "%v"))))
- :group 'gpg-commands)
-
-(defcustom gpg-command-sign-cleartext
- '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
- armor textmode "--clearsign"
- sign-with-key))
- "Command to create a \"clearsign\" text file.
-The invoked program has to read the passphrase from standard input,
-followed by the message to sign. It should write the ASCII-amored
-signed text message to standard output, and diagnostic messages to
-standard error."
- :tag "Clearsign Command"
- :type 'gpg-command-sign-options
- :group 'gpg-commands)
-
-(defcustom gpg-command-sign-detached
- '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
- armor textmode "--detach-sign"
- sign-with-key))
- "Command to create a detached signature.
-The invoked program has to read the passphrase from standard input,
-followed by the message to sign. It should write the ASCII-amored
-detached signature to standard output, and diagnostic messages to
-standard error. The program shall not convert charsets or line
-endings; the input data shall be treated as binary."
- :tag "Sign Detached Command"
- :type 'gpg-command-sign-options
- :group 'gpg-commands)
-
-(defcustom gpg-command-sign-encrypt
- '(gpg-2comp . ("--batch" "--passphrase-fd=0" "--output=-"
- armor textmode "--always-trust" sign-with-key recipients
- "--sign" "--encrypt" plaintext-file))
- "Command to sign and encrypt a file.
-The invoked program has to read the passphrase from standard input,
-followed by the message to sign and encrypt if there is no
-`plaintext-file' placeholder. It should write the ASCII-amored
-encrypted message to standard output, and diagnostic messages to
-standard error."
- :tag "Sign And Encrypt Command"
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert the `sign with key' option here if necessary."
- :value sign-with-key)
- (const :tag "Insert list of recipients here."
- :value recipients)
- (const :tag "Insert here name of file with plaintext."
- :value plaintext-file)
- (string :format "%v"))))
- :group 'gpg-commands)
-
-(defcustom gpg-command-encrypt
- '(gpg-2comp . ("--batch" "--output=-" armor textmode "--always-trust"
- "--encrypt" recipients plaintext-file))
- "Command to encrypt a file.
-The invoked program has to read the message to encrypt from standard
-input or from the plaintext file (if the `plaintext-file' placeholder
-is present). It should write the ASCII-amored encrypted message to
-standard output, and diagnostic messages to standard error."
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert list of recipients here."
- :value recipients)
- (const :tag "Insert here name of file with plaintext."
- :value plaintext-file)
- (string :format "%v"))))
- :group 'gpg-commands)
-
-;;; Customization: Variables: Key Management Commands:
-
-(defcustom gpg-command-key-import
- '(gpg . ("--import" "--verbose" message-file))
- "Command to import a public key from a file."
- :tag "Import Command"
- :type '(cons
- gpg-command-program
- (repeat
- :tag "Arguments"
- (choice
- :format "%[Type%] %v"
- (const :tag "Insert name of file containing the key here."
- :value message-file)
- (string :format "%v"))))
- :group 'gpg-commands-key)
-
-(defcustom gpg-command-key-export
- '(gpg . ("--no-verbose" "--armor" "--export" key-id))
- "Command to export a public key from the key ring.
-The key should be written to standard output using ASCII armor."
- :tag "Export Command"
- :type 'gpg-command-key-options
- :group 'gpg-commands-key)
-
-(defcustom gpg-command-key-verify
- '(gpg . ("--no-verbose" "--batch" "--fingerprint" "--check-sigs" key-id))
- "Command to verify a public key."
- :tag "Verification Command"
- :type 'gpg-command-key-options
- :group 'gpg-commands-key)
-
-(defcustom gpg-command-key-public-ring
- '(gpg . ("--no-verbose" "--batch" "--with-colons" "--list-keys" key-id))
- "Command to list the contents of the public key ring."
- :tag "List Public Key Ring Command"
- :type 'gpg-command-key-options
- :group 'gpg-commands-key)
-
-(defcustom gpg-command-key-secret-ring
- '(gpg . ("--no-verbose" "--batch" "--with-colons"
- "--list-secret-keys" key-id))
- "Command to list the contents of the secret key ring."
- :tag "List Secret Key Ring Command"
- :type 'gpg-command-key-options
- :group 'gpg-commands-key)
-
-(defcustom gpg-command-key-retrieve
- '(gpg . ("--batch" "--recv-keys" key-id))
- "Command to retrieve public keys."
- :tag "Retrieve Keys Command"
- :type 'gpg-command-key-options
- :group 'gpg-commands-key)
-
-\f
-;;;; Helper functions for GnuPG invocation:
-
-;;; Build the GnuPG command line:
-
-(defun gpg-build-argument (template substitutions &optional pass-start)
- "Build command line argument(s) by substituting placeholders.
-TEMPLATE is a list of strings and symbols. The placeholder symbols in
-it are replaced by SUBSTITUTIONS, the elements between
-`next-argument' symbols are concatenated without spaces and are
-returned in a list.
-
-SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either
-a string (which is inserted literally), a list of strings (which are
-inserted as well), or nil, which means to insert nothing.
-
-If PASS-START is t, `next-argument' is also inserted into the result,
-and symbols without a proper substitution are retained in the output,
-otherwise, an untranslated symbol results in an error.
-
-This function does not handle empty arguments reliably."
- (let ((current-arg "")
- (arglist nil))
- (while template
- (let* ((templ (pop template))
- (repl (assoc templ substitutions))
- (new (if repl (cdr repl) templ)))
- (cond
- ((eq templ 'next-argument)
- ;; If the current argument is not empty, start a new one.
- (unless (equal current-arg "")
- (setq arglist (nconc arglist
- (if pass-start
- (list current-arg 'next-argument)
- (list current-arg))))
- (setq current-arg "")))
- ((null new) nil) ; Drop it.
- ((and (not (stringp templ)) (null repl))
- ;; Retain an untranslated symbol in the output if
- ;; `pass-start' is true.
- (unless pass-start
- (error "No replacement for `%s'" templ))
- (setq arglist (nconc arglist (list current-arg templ)))
- (setq current-arg ""))
- (t
- (unless (listp new)
- (setq new (list new)))
- (setq current-arg (concat current-arg
- (apply 'concat new)))))))
- (unless (equal current-arg "")
- (setq arglist (nconc arglist (list current-arg))))
- arglist))
-
-(defun gpg-build-arg-list (template substitutions)
- "Build command line by substituting placeholders.
-TEMPLATE is a list of strings and symbols. The placeholder symbols in
-it are replaced by SUBSTITUTIONS.
-
-SUBSTITIONS is a list of (SYMBOL . SEXP) pairs, where SEXP is either a
-string (which is inserted literally), a list of strings (which are
-inserted as well), or nil, which means to insert nothing."
- (let ((arglist (copy-sequence gpg-command-all-arglist)))
- (while template
- (let* ((templ (pop template))
- (repl (assoc templ substitutions))
- (new (if repl (cdr repl) templ)))
- (cond
- ((and (symbolp templ) (null repl))
- (error "No replacement for `%s'" templ))
- ((null new) nil) ; Drop it.
- (t
- (unless (listp new)
- (setq new (list new)))
- (setq arglist (nconc arglist new))))))
- arglist))
-
-(defun gpg-build-flag-recipients-one (recipient)
- "Build argument for one RECIPIENT."
- (gpg-build-argument (cdr gpg-command-flag-recipient)
- `((recipient . ,recipient)) t))
-
-(defun gpg-build-flag-recipients (recipients)
- "Build list of RECIPIENTS using `gpg-command-flag-recipient'."
- (gpg-build-argument
- (apply 'append (car gpg-command-flag-recipient)
- (mapcar 'gpg-build-flag-recipients-one
- recipients))
- nil))
-
-(defun gpg-read-recipients ()
- "Query the user for several recipients."
- (let ((go t)
- recipients r)
- (while go
- (setq r (read-string "Enter recipient ID [RET when no more]: "))
- (if (equal r "")
- (setq go nil)
- (setq recipients (nconc recipients (list r)))))
- recipients))
-
-(defun gpg-build-flag-sign-with-key (key)
- "Build sign with key flag using `gpg-command-flag-sign-with-key'."
- (let ((k (if key key
- (if gpg-default-key-id gpg-default-key-id
- nil))))
- (if k
- (gpg-build-argument gpg-command-flag-sign-with-key
- (list (cons 'sign-with-key k)))
- nil)))
-
-(defmacro gpg-with-passphrase-env (&rest body)
- "Adjust the process environment and evaluate BODY.
-During the evaluation of the body forms, the process environment is
-adjust according to `gpg-command-passphrase-env'."
- (let ((env-value (make-symbol "env-value")))
- `(let ((,env-value))
- (unwind-protect
- (progn
- (when gpg-command-passphrase-env
- (setq ,env-value (getenv (car gpg-command-passphrase-env)))
- (setenv (car gpg-command-passphrase-env)
- (cdr gpg-command-passphrase-env)))
- ,@body)
- (when gpg-command-passphrase-env
- ;; This will clear the variable if it wasn't set before.
- (setenv (car gpg-command-passphrase-env) ,env-value))))))
-(put 'gpg-with-passphrase-env 'lisp-indent-function 0)
-(put 'gpg-with-passphrase-env 'edebug-form-spec '(body))
-
-;;; Temporary files:
-
-(defun gpg-make-temp-file ()
- "Create a temporary file in a safe way"
- (let ((name ;; User may use "~/"
- (expand-file-name "gnupg" gpg-temp-directory)))
- (if (fboundp 'make-temp-file)
- ;; If we've got make-temp-file, we are on the save side.
- (make-temp-file name)
- ;; make-temp-name doesn't create the file, and an ordinary
- ;; write-file operation is prone to nasty symlink attacks if the
- ;; temporary file resides in a world-writable directory.
- (unless (or (memq system-type '(windows-nt cygwin32 win32 w32 mswindows))
- (eq (file-modes gpg-temp-directory) 448)) ; mode 0700
- (error "Directory for temporary files (%s) must have mode 0700" gpg-temp-directory))
- (setq name (make-temp-name name))
- (let ((mode (default-file-modes)))
- (unwind-protect
- (progn
- (set-default-file-modes 384) ; mode 0600
- (with-temp-file name))
- (set-default-file-modes mode)))
- name)))
-
-(defvar gpg-temp-files nil
- "List of temporary files used by the GnuPG interface.
-Do not set this variable. Call `gpg-with-temp-files' if you need
-temporary files.")
-
-(defun gpg-with-temp-files-create (count)
- "Do not call this function. Used internally by `gpg-with-temp-files'."
- (while (> count 0)
- (setq gpg-temp-files (cons (gpg-make-temp-file) gpg-temp-files))
- (setq count (1- count))))
-
-(defun gpg-with-temp-files-delete ()
- "Do not call this function. Used internally by `gpg-with-temp-files'."
- (while gpg-temp-files
- (let ((file (pop gpg-temp-files)))
- (condition-case nil
- (delete-file file)
- (error nil)))))
-
-(defmacro gpg-with-temp-files (count &rest body)
- "Create COUNT temporary files, USE them, and delete them.
-The function USE is called with the names of all temporary files as
-arguments."
- `(let ((gpg-temp-files))
- (unwind-protect
- (progn
- ;; Create the temporary files.
- (gpg-with-temp-files-create ,count)
- ,@body)
- (gpg-with-temp-files-delete))))
-(put 'gpg-with-temp-files 'lisp-indent-function 1)
-(put 'gpg-with-temp-files 'edebug-form-spec '(body))
-
-;;; Making subprocesses:
-
-(defun gpg-exec-path (option)
- "Return the program name for OPTION.
-OPTION is of the form (PROGRAM . ARGLIST). This functions returns
-PROGRAM, but takes default values into account."
- (let* ((prg (car option))
- (path (assq prg gpg-command-default-alist)))
- (cond
- (path (if (null (cdr path))
- (error "Command `%s' is not available" prg)
- (cdr path)))
- ((null prg) (error "Command is disabled"))
- (t prg))))
-
-(defun gpg-call-process (cmd args stdin stdout stderr &optional passphrase)
- "Invoke external program CMD with ARGS on buffer STDIN.
-Standard output is insert before point in STDOUT, standard error in
-STDERR. If PASSPHRASE is given, send it before STDIN. PASSPHRASE
-should not end with a line feed (\"\\n\").
-
-If `stdin-file' is present in ARGS, it is replaced by the name of a
-temporary file. Before invoking CMD, the contents of STDIN is written
-to this file."
- (gpg-with-temp-files 2
- (let* ((coding-system-for-read 'no-conversion)
- (coding-system-for-write 'no-conversion)
- (have-stdin-file (memq 'stdin-file args))
- (stdin-file (nth 0 gpg-temp-files))
- (stderr-file (nth 1 gpg-temp-files))
- (cpr-args `(,cmd
- nil ; don't delete
- (,stdout ,stderr-file)
- nil ; don't display
- ;; Replace `stdin-file'.
- ,@(gpg-build-arg-list
- args (list (cons 'stdin-file stdin-file)))))
- res)
- (when have-stdin-file
- (with-temp-file stdin-file
- (buffer-disable-undo)
- (insert-buffer-substring stdin)))
- (setq res
- (if passphrase
- (with-temp-buffer
- (buffer-disable-undo)
- (insert passphrase "\n")
- (unless have-stdin-file
- (apply 'insert-buffer-substring
- (if (listp stdin) stdin (list stdin))))
- (apply 'call-process-region (point-min) (point-max) cpr-args)
- ;; Wipe out passphrase.
- (goto-char (point-min))
- (translate-region (point) (gpg-point-at-eol)
- (make-string 256 ? )))
- (if (listp stdin)
- (with-current-buffer (car stdin)
- (apply 'call-process-region
- (cadr stdin)
- (if have-stdin-file (cadr stdin) (caddr stdin))
- cpr-args))
- (with-current-buffer stdin
- (apply 'call-process-region
- (point-min)
- (if have-stdin-file (point-min) (point-max))
- cpr-args)))))
- (with-current-buffer stderr
- (insert-file-contents-literally stderr-file))
- (if (or (stringp res) (> res 0))
- ;; Signal or abnormal exit.
- (with-current-buffer stderr
- (goto-char (point-max))
- (insert (format "\nCommand exit status: %s\n" res))
- nil)
- t))))
-
-(defvar gpg-result-buffer nil
- "The result of a GnuPG operation is stored in this buffer.
-Never set this variable directly, use `gpg-show-result' instead.")
-
-(defun gpg-show-result-buffer (always-show result)
- "Called by `gpg-show-results' to actually show the buffer."
- (with-current-buffer gpg-result-buffer
- ;; Only proceed if the buffer is non-empty.
- (when (and (/= (point-min) (point-max))
- (or always-show (not result)))
- (save-window-excursion
- (display-buffer (current-buffer))
- (unless (y-or-n-p "Continue? ")
- (error "GnuPG operation aborted"))))))
-
-(defmacro gpg-show-result (always-show &rest body)
- "Show GnuPG result to user for confirmation.
-This macro binds `gpg-result-buffer' to a temporary buffer and
-evaluates BODY, like `progn'. If BODY evaluates to `nil' (or
-`always-show' is not nil), the user is asked for confirmation."
- `(let ((gpg-result-buffer (get-buffer-create
- (generate-new-buffer-name "*GnuPG Output*"))))
- (unwind-protect
- (gpg-show-result-buffer ,always-show (progn ,@body))
- (kill-buffer gpg-result-buffer))))
-(put 'gpg-show-result 'lisp-indent-function 1)
-(put 'gpg-show-result 'edebug-form-spec '(body))
-
-;;; Passphrase handling:
-
-(defvar gpg-passphrase-timer
- (gpg-timer-create)
- "This timer will clear the passphrase cache periodically.")
-
-(defvar gpg-passphrase
- nil
- "The (unencrypted) passphrase cache.")
-
-(defun gpg-passphrase-clear-string (str)
- "Erases STR by overwriting all characters."
- (let ((pos 0)
- (len (length str)))
- (while (< pos len)
- (aset str pos ? )
- (incf pos))))
-
-;;;###autoload
-(defun gpg-passphrase-forget ()
- "Forget stored passphrase."
- (interactive)
- (when gpg-passphrase
- (gpg-cancel-timer gpg-passphrase-timer)
- (setq gpg-passphrase-timer nil)
- (gpg-passphrase-clear-string gpg-passphrase)
- (setq gpg-passphrase nil)))
-
-(defun gpg-passphrase-store (passphrase)
- "Store PASSPHRASE in cache.
-Updates the timeout for clearing the cache to `gpg-passphrase-timeout'."
- (unless (equal gpg-passphrase-timeout 0)
- (if (null gpg-passphrase-timer)
- (setq gpg-passphrase-timer (gpg-timer-create)))
- (gpg-timer-set-time gpg-passphrase-timer
- (timer-relative-time (current-time)
- gpg-passphrase-timeout))
- (gpg-timer-set-function gpg-passphrase-timer 'gpg-passphrase-forget)
- (unless (and (fboundp 'itimer-live-p)
- (itimer-live-p gpg-passphrase-timer))
- (gpg-timer-activate gpg-passphrase-timer))
- (setq gpg-passphrase passphrase))
- passphrase)
-
-(defun gpg-passphrase-read ()
- "Read a passphrase and remember it for some time."
- (interactive)
- (if gpg-passphrase
- ;; This reinitializes the timer.
- (gpg-passphrase-store gpg-passphrase)
- (let ((pp (read-passwd "Enter passphrase: ")))
- (gpg-passphrase-store pp))))
-
-\f
-;;;; Main operations:
-
-;;;###autoload
-(defun gpg-verify (message signature result)
- "Verify buffer MESSAGE against detached SIGNATURE buffer.
-Returns t if everything worked out well, nil otherwise. Consult
-buffer RESULT for details."
- (interactive "bBuffer containing message: \nbBuffer containing signature: \nbBuffor for result: ")
- (gpg-with-temp-files 2
- (let* ((sig-file (nth 0 gpg-temp-files))
- (msg-file (nth 1 gpg-temp-files))
- (cmd (gpg-exec-path gpg-command-verify))
- (args (gpg-build-arg-list (cdr gpg-command-verify)
- `((signature-file . ,sig-file)
- (message-file . ,msg-file))))
- res)
- (with-temp-file sig-file
- (buffer-disable-undo)
- (apply 'insert-buffer-substring (if (listp signature)
- signature
- (list signature))))
- (with-temp-file msg-file
- (buffer-disable-undo)
- (apply 'insert-buffer-substring (if (listp message)
- message
- (list message))))
- (setq res (apply 'call-process-region
- (point-min) (point-min) ; no data
- cmd
- nil ; don't delete
- result
- nil ; don't display
- args))
- (if (or (stringp res) (> res 0))
- ;; Signal or abnormal exit.
- (with-current-buffer result
- (insert (format "\nCommand exit status: %s\n" res))
- nil)
- t))))
-
-;;;###autoload
-(defun gpg-verify-cleartext (message result)
- "Verify message in buffer MESSAGE.
-Returns t if everything worked out well, nil otherwise. Consult
-buffer RESULT for details.
-
-NOTE: Use of this function is deprecated."
- (interactive "bBuffer containing message: \nbBuffor for result: ")
- (gpg-with-temp-files 1
- (let* ((msg-file (nth 0 gpg-temp-files))
- (cmd (gpg-exec-path gpg-command-verify-cleartext))
- (args (gpg-build-arg-list (cdr gpg-command-verify-cleartext)
- `((message-file . ,msg-file))))
- res)
- (with-temp-file msg-file
- (buffer-disable-undo)
- (apply 'insert-buffer-substring (if (listp message)
- message
- (list message))))
- (setq res (apply 'call-process-region
- (point-min) (point-min) ; no data
- cmd
- nil ; don't delete
- result
- nil ; don't display
- args))
- (if (or (stringp res) (> res 0))
- ;; Signal or abnormal exit.
- (with-current-buffer result
- (insert (format "\nCommand exit status: %s\n" res))
- nil)
- t))))
-
-;;;###autoload
-(defun gpg-decrypt (ciphertext plaintext result &optional passphrase)
- "Decrypt buffer CIPHERTEXT to buffer PLAINTEXT.
-Returns t if everything worked out well, nil otherwise. Consult
-buffer RESULT for details. Reads a missing PASSPHRASE using
-`gpg-passphrase-read'."
- (interactive "bBuffer containing ciphertext: \nbBuffer for plaintext: \nbBuffor for decryption status: ")
- (gpg-call-process (gpg-exec-path gpg-command-decrypt)
- (gpg-build-arg-list (cdr gpg-command-decrypt) nil)
- ciphertext plaintext result
- (if passphrase passphrase (gpg-passphrase-read)))
- (when passphrase
- (gpg-passphrase-clear-string passphrase)))
-
-;;;###autoload
-(defun gpg-sign-cleartext
- (plaintext signed-text result &optional passphrase sign-with-key)
- "Sign buffer PLAINTEXT, and store PLAINTEXT with signature in
-SIGNED-TEXT.
-Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID
-SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if
-everything worked out well, nil otherwise. Consult buffer RESULT for
-details.
-
-NOTE: Use of this function is deprecated."
- (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ")
- (let ((subst (list (cons 'sign-with-key
- (gpg-build-flag-sign-with-key sign-with-key))
- (cons 'armor gpg-command-flag-armor)
- (cons 'textmode gpg-command-flag-textmode))))
- (gpg-call-process (gpg-exec-path gpg-command-sign-cleartext)
- (gpg-build-arg-list (cdr gpg-command-sign-cleartext)
- subst)
- plaintext signed-text result
- (if passphrase passphrase (gpg-passphrase-read))))
- (when passphrase
- (gpg-passphrase-clear-string passphrase)))
-
-;;;###autoload
-(defun gpg-sign-detached
- (plaintext signature result &optional passphrase sign-with-key
- armor textmode)
- "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer.
-Reads a missing PASSPHRASE using `gpg-passphrase-read'. Uses key ID
-SIGN-WITH-KEY if given, otherwise the default key ID. Returns t if
-everything worked out well, nil otherwise. Consult buffer RESULT for
-details. ARMOR the result and activate canonical TEXTMODE if
-requested."
- (interactive "bBuffer containing plaintext: \nbBuffer for text with signature: \nbBuffer for status information: ")
- (let ((subst (list (cons 'sign-with-key
- (gpg-build-flag-sign-with-key sign-with-key))
- (cons 'armor (if armor gpg-command-flag-armor))
- (cons 'textmode (if armor gpg-command-flag-textmode)))))
- (gpg-call-process (gpg-exec-path gpg-command-sign-detached)
- (gpg-build-arg-list (cdr gpg-command-sign-detached)
- subst)
- plaintext signature result
- (if passphrase passphrase (gpg-passphrase-read))))
- (when passphrase
- (gpg-passphrase-clear-string passphrase)))
-
-
-;;;###autoload
-(defun gpg-sign-encrypt
- (plaintext ciphertext result recipients &optional passphrase sign-with-key
- armor textmode)
- "Sign buffer PLAINTEXT, and store SIGNATURE in that buffer.
-RECIPIENTS is a list of key IDs used for encryption. This function
-reads a missing PASSPHRASE using `gpg-passphrase-read', and uses key
-ID SIGN-WITH-KEY for the signature if given, otherwise the default key
-ID. Returns t if everything worked out well, nil otherwise. Consult
-buffer RESULT for details. ARMOR the result and activate canonical
-TEXTMODE if requested."
- (interactive (list
- (read-buffer "Buffer containing plaintext: " nil t)
- (read-buffer "Buffer for ciphertext: " nil t)
- (read-buffer "Buffer for status informationt: " nil t)
- (gpg-read-recipients)))
- (let ((subst `((sign-with-key . ,(gpg-build-flag-sign-with-key
- sign-with-key))
- (plaintext-file . stdin-file)
- (recipients . ,(gpg-build-flag-recipients recipients))
- (armor ,(if armor gpg-command-flag-armor))
- (textmode ,(if armor gpg-command-flag-textmode)))))
- (gpg-call-process (gpg-exec-path gpg-command-sign-encrypt)
- (gpg-build-arg-list (cdr gpg-command-sign-encrypt)
- subst)
- plaintext ciphertext result
- (if passphrase passphrase (gpg-passphrase-read))))
- (when passphrase
- (gpg-passphrase-clear-string passphrase)))
-
-
-;;;###autoload
-(defun gpg-encrypt
- (plaintext ciphertext result recipients &optional passphrase armor textmode)
- "Encrypt buffer PLAINTEXT, and store CIPHERTEXT in that buffer.
-RECIPIENTS is a list of key IDs used for encryption. Returns t if
-everything worked out well, nil otherwise. Consult buffer RESULT for
-details. ARMOR the result and activate canonical
-TEXTMODE if requested."
- (interactive (list
- (read-buffer "Buffer containing plaintext: " nil t)
- (read-buffer "Buffer for ciphertext: " nil t)
- (read-buffer "Buffer for status informationt: " nil t)
- (gpg-read-recipients)))
- (let ((subst `((plaintext-file . stdin-file)
- (recipients . ,(gpg-build-flag-recipients recipients))
- (armor ,(if armor gpg-command-flag-armor))
- (textmode ,(if armor gpg-command-flag-textmode)))))
- (gpg-call-process (gpg-exec-path gpg-command-encrypt)
- (gpg-build-arg-list (cdr gpg-command-encrypt) subst)
- plaintext ciphertext result nil))
- (when passphrase
- (gpg-passphrase-clear-string passphrase)))
-
-\f
-;;;; Key management
-
-;;; ADT: OpenPGP Key
-
-(defun gpg-key-make (user-id key-id unique-id length algorithm
- creation-date expire-date validity trust)
- "Create a new key object (for internal use only)."
- (vector
- ;; 0 1 2 3 4
- user-id key-id unique-id length algorithm
- ;; 5 6 7 8
- creation-date expire-date validity trust))
-
-
-(defun gpg-key-p (key)
- "Return t if KEY is a key specification."
- (and (arrayp key) (equal (length key) 9) key))
-
-(defmacro gpg-key-primary-user-id (key)
- "The primary user ID for KEY (human-readable).
-DO NOT USE this ID for selecting recipients. It is probably not
-unique."
- (list 'car (list 'aref key 0)))
-
-(defmacro gpg-key-user-ids (key)
- "A list of additional user IDs for KEY (human-readable).
-DO NOT USE these IDs for selecting recipients. They are probably not
-unique."
- (list 'cdr (list 'aref key 0)))
-
-(defmacro gpg-key-id (key)
- "The key ID of KEY.
-DO NOT USE this ID for selecting recipients. It is not guaranteed to
-be unique."
- (list 'aref key 1))
-
-(defun gpg-short-key-id (key)
- "The short key ID of KEY."
- (let* ((id (gpg-key-id key))
- (len (length id)))
- (if (> len 8)
- (substring id (- len 8))
- id)))
-
-(defmacro gpg-key-unique-id (key)
- "A non-standard ID of KEY which is only valid locally.
-This ID can be used to specify recipients in a safe manner. Note,
-even this ID might not be unique unless GnuPG is used."
- (list 'aref key 2))
-
-(defmacro gpg-key-unique-id-list (key-list)
- "Like `gpg-key-unique-id', but operate on a list."
- `(mapcar (lambda (key) (gpg-key-unique-id key))
- ,key-list))
-
-(defmacro gpg-key-length (key)
- "Returns the key length."
- (list 'aref key 3))
-
-(defmacro gpg-key-algorithm (key)
- "The encryption algorithm used by KEY.
-One of the symbols `rsa', `rsa-encrypt', `rsa-sign', `elgamal',
-`elgamal-encrypt', `dsa'."
- (list 'aref key 4))
-
-(defmacro gpg-key-creation-date (key)
- "A string with the creation date of KEY in ISO format."
- (list 'aref key 5))
-
-(defmacro gpg-key-expire-date (key)
- "A string with the expiration date of KEY in ISO format."
- (list 'aref key 6))
-
-(defmacro gpg-key-validity (key)
- "The calculated validity of KEY.
-One of the symbols `not-known', `disabled', `revoked', `expired',
-`undefined', `trust-none', `trust-marginal', `trust-full',
-`trust-ultimate' (see the GnuPG documentation for details)."
- (list 'aref key 7))
-
-(defmacro gpg-key-trust (key)
- "The assigned trust for KEY.
-One of the symbols `not-known', `undefined', `trust-none',
-`trust-marginal', `trust-full' (see the GnuPG
-documentation for details)."
- (list 'aref key 8))
-
-(defun gpg-key-lessp (a b)
- "Returns t if primary user ID of A is less than B."
- (string-lessp (gpg-key-primary-user-id a) (gpg-key-primary-user-id b) ))
-
-;;; Accessing the key database:
-
-;; Internal functions:
-
-(defmacro gpg-key-list-keys-skip-field ()
- '(search-forward ":" eol 'move))
-
-(defmacro gpg-key-list-keys-get-field ()
- '(buffer-substring (point) (if (gpg-key-list-keys-skip-field)
- (1- (point))
- eol)))
-(defmacro gpg-key-list-keys-string-field ()
- '(gpg-key-list-keys-get-field))
-
-(defmacro gpg-key-list-keys-read-field ()
- (let ((field (make-symbol "field")))
- `(let ((,field (gpg-key-list-keys-get-field)))
- (if (equal (length ,field) 0)
- nil
- (read ,field)))))
-
-(defun gpg-key-list-keys-parse-line ()
- "Parse the line in the current buffer and return a vector of fields."
- (let* ((eol (gpg-point-at-eol))
- (v (if (eolp)
- nil
- (vector
- (gpg-key-list-keys-read-field) ; type
- (gpg-key-list-keys-get-field) ; trust
- (gpg-key-list-keys-read-field) ; key length
- (gpg-key-list-keys-read-field) ; algorithm
- (gpg-key-list-keys-get-field) ; key ID
- (gpg-key-list-keys-get-field) ; creation data
- (gpg-key-list-keys-get-field) ; expire
- (gpg-key-list-keys-get-field) ; unique (local) ID
- (gpg-key-list-keys-get-field) ; ownertrust
- (gpg-key-list-keys-string-field) ; user ID
- ))))
- (if (eolp)
- (when v
- (forward-char 1))
- (error "Too many fields in GnuPG key database"))
- v))
-
-(defconst gpg-pubkey-algo-alist
- '((1 . rsa)
- (2 . rsa-encrypt-only)
- (3 . rsa-sign-only)
- (16 . elgamal-encrypt-only)
- (17 . dsa)
- (20 . elgamal))
- "Alist mapping OpenPGP public key algorithm numbers to symbols.")
-
-(defconst gpg-trust-alist
- '((?- . not-known)
- (?o . not-known)
- (?d . disabled)
- (?r . revoked)
- (?e . expired)
- (?q . trust-undefined)
- (?n . trust-none)
- (?m . trust-marginal)
- (?f . trust-full)
- (?u . trust-ultimate))
- "Alist mapping GnuPG trust value short forms to long symbols.")
-
-(defconst gpg-unabbrev-trust-alist
- '(("TRUST_UNDEFINED" . trust-undefined)
- ("TRUST_NEVER" . trust-none)
- ("TRUST_MARGINAL" . trust-marginal)
- ("TRUST_FULLY" . trust-full)
- ("TRUST_ULTIMATE" . trust-ultimate))
- "Alist mapping capitalized GnuPG trust values to long symbols.")
-
-(defmacro gpg-key-list-keys-in-buffer-store ()
- '(when primary-user-id
- (sort user-id 'string-lessp)
- (push (gpg-key-make (cons primary-user-id user-id)
- key-id unique-id key-length
- algorithm creation-date
- expire-date validity trust)
- key-list)))
-
-(defun gpg-key-list-keys-in-buffer (&optional buffer)
- "Return a list of keys for BUFFER.
-If BUFFER is omitted, use current buffer."
- (with-current-buffer (if buffer buffer (current-buffer))
- (goto-char (point-min))
- ;; Skip key ring filename written by GnuPG.
- (search-forward "\n---------------------------\n" nil t)
- ;; Loop over all lines in buffer and analyze them.
- (let (primary-user-id user-id key-id unique-id ; current key components
- key-length algorithm creation-date expire-date validity trust
- line ; fields in current line
- key-list) ; keys gather so far
-
- (while (setq line (gpg-key-list-keys-parse-line))
- (cond
- ;; Public or secret key.
- ((memq (aref line 0) '(pub sec))
- ;; Store previous key, if any.
- (gpg-key-list-keys-in-buffer-store)
- ;; Record field values.
- (setq primary-user-id (aref line 9))
- (setq user-id nil)
- (setq key-id (aref line 4))
- ;; We use the key ID if no unique ID is available.
- (setq unique-id (if (> (length (aref line 7)) 0)
- (concat "#" (aref line 7))
- (concat "0x" key-id)))
- (setq key-length (aref line 2))
- (setq algorithm (assq (aref line 3) gpg-pubkey-algo-alist))
- (if algorithm
- (setq algorithm (cdr algorithm))
- (error "Unknown algorithm %s" (aref line 3)))
- (setq creation-date (if (> (length (aref line 5)) 0)
- (aref line 5)))
- (setq expire-date (if (> (length (aref line 6)) 0)
- (aref line 6)))
- (setq validity (assq (aref (aref line 1) 0) gpg-trust-alist))
- (if validity
- (setq validity (cdr validity))
- (error "Unknown validity specification %S" (aref line 1)))
- (setq trust (assq (aref (aref line 8) 0) gpg-trust-alist))
- (if trust
- (setq trust (cdr trust))
- (error "Unknown trust specification %S" (aref line 8))))
-
- ;; Additional user ID
- ((eq 'uid (aref line 0))
- (setq user-id (cons (aref line 9) user-id)))
-
- ;; Subkeys are ignored for now.
- ((memq (aref line 0) '(sub ssb))
- t)
- (t (error "Unknown record type %S" (aref line 0)))))
-
- ;; Store the key retrieved last.
- (gpg-key-list-keys-in-buffer-store)
- ;; Sort the keys according to the primary user ID.
- (sort key-list 'gpg-key-lessp))))
-
-(defun gpg-key-list-keyspec (command &optional keyspec stderr ignore-error)
- "Insert the output of COMMAND before point in current buffer."
- (let* ((cmd (gpg-exec-path command))
- (key (if (equal keyspec "") nil keyspec))
- (args (gpg-build-arg-list (cdr command) `((key-id . ,key))))
- exit-status)
- (setq exit-status
- (apply 'call-process-region
- (point-min) (point-min) ; no data
- cmd
- nil ; don't delete
- (if stderr t '(t nil))
- nil ; don't display
- args))
- (unless (or ignore-error (equal exit-status 0))
- (error "GnuPG command exited unsuccessfully"))))
-
-
-(defun gpg-key-list-keyspec-parse (command &optional keyspec)
- "Return a list of keys matching KEYSPEC.
-COMMAND is used to obtain the key list. The usual substring search
-for keys is performed."
- (with-temp-buffer
- (buffer-disable-undo)
- (gpg-key-list-keyspec command keyspec)
- (gpg-key-list-keys-in-buffer)))
-
-;;;###autoload
-(defun gpg-key-list-keys (&optional keyspec)
- "A list of public keys matching KEYSPEC.
-The usual substring search for keys is performed."
- (gpg-key-list-keyspec-parse gpg-command-key-public-ring keyspec))
-
-;;;###autoload
-(defun gpg-key-list-secret-keys (&optional keyspec)
- "A list of secret keys matching KEYSPEC.
-The usual substring search for keys is performed."
- (gpg-key-list-keyspec-parse gpg-command-key-secret-ring keyspec))
-
-;;;###autoload
-(defun gpg-key-insert-public-key (key)
- "Inserts the public key(s) matching KEYSPEC.
-The ASCII-armored key is inserted before point into current buffer."
- (gpg-key-list-keyspec gpg-command-key-export key))
-
-;;;###autoload
-(defun gpg-key-insert-information (key)
- "Insert human-readable information (including fingerprint) on KEY.
-Insertion takes place in current buffer before point."
- (gpg-key-list-keyspec gpg-command-key-verify key))
-
-;;;###autoload
-(defun gpg-key-retrieve (key)
- "Fetch KEY from default key server.
-KEY is a key ID or a list of key IDs. Status information about this
-operation is inserted into the current buffer before point."
- (gpg-key-list-keyspec gpg-command-key-retrieve key t t))
-
-;;;###autoload
-(defun gpg-key-add-to-ring (key result)
- "Adds key in buffer KEY to the GnuPG key ring.
-Human-readable information on the RESULT is stored in buffer RESULT
-before point.")
-
-(provide 'gpg)
-
-;;; arch-tag: c972455d-9bc5-4de1-9dc7-4f494d63053b
-;;; gpg.el ends here
+++ /dev/null
-;;; hashcash.el --- Add hashcash payments to email
-
-;; Copyright (C) 2002, 2003, 2005 Free Software Foundation
-;; Copyright (C) 1997--2002 Paul E. Foley
-
-;; Maintainer: Paul Foley <mycroft@actrix.gen.nz>
-;; Keywords: mail, hashcash
-
-;; Released under the GNU General Public License
-;; (http://www.gnu.org/licenses/gpl.html)
-
-;;; Commentary:
-
-;; The hashcash binary is at http://www.cypherspace.org/hashcash/
-;;
-;; Call mail-add-payment to add a hashcash payment to a mail message
-;; in the current buffer.
-;;
-;; To automatically add payments to all outgoing mail:
-;; (add-hook 'message-send-hook 'mail-add-payment)
-
-;;; Code:
-
-(eval-and-compile
- (autoload 'executable-find "executable"))
-
-(defgroup hashcash nil
- "Hashcash configuration."
- :group 'mail)
-
-(defcustom hashcash-default-payment 0
- "*The default number of bits to pay to unknown users.
-If this is zero, no payment header will be generated.
-See `hashcash-payment-alist'."
- :type 'integer
- :group 'hashcash)
-
-(defcustom hashcash-payment-alist '()
- "*An association list mapping email addresses to payment amounts.
-Elements may consist of (ADDR AMOUNT) or (ADDR STRING AMOUNT), where
-ADDR is the email address of the intended recipient and AMOUNT is
-the value of hashcash payment to be made to that user. STRING, if
-present, is the string to be hashed; if not present ADDR will be used."
- :group 'hashcash)
-
-(defcustom hashcash-default-accept-payment 10
- "*The default minimum number of bits to accept on incoming payments."
- :type 'integer
- :group 'hashcash)
-
-(defcustom hashcash-accept-resources `((,user-mail-address nil))
- "*An association list mapping hashcash resources to payment amounts.
-Resources named here are to be accepted in incoming payments. If the
-corresponding AMOUNT is NIL, the value of `hashcash-default-accept-payment'
-is used instead."
- :group 'hashcash)
-
-(defcustom hashcash-path (executable-find "hashcash")
- "*The path to the hashcash binary."
- :group 'hashcash)
-
-(defcustom hashcash-double-spend-database "hashcash.db"
- "*The path to the double-spending database."
- :group 'hashcash)
-
-(defcustom hashcash-in-news nil
- "*Specifies whether or not hashcash payments should be made to newsgroups."
- :type 'boolean
- :group 'hashcash)
-
-(require 'mail-utils)
-
-(eval-and-compile
- (if (fboundp 'point-at-bol)
- (defalias 'hashcash-point-at-bol 'point-at-bol)
- (defalias 'hashcash-point-at-bol 'line-beginning-position))
-
- (if (fboundp 'point-at-eol)
- (defalias 'hashcash-point-at-eol 'point-at-eol)
- (defalias 'hashcash-point-at-eol 'line-end-position)))
-
-(defun hashcash-strip-quoted-names (addr)
- (setq addr (mail-strip-quoted-names addr))
- (if (and addr (string-match "\\`\\([^+@]+\\)\\+[^@]*\\(@.+\\)" addr))
- (concat (match-string 1 addr) (match-string 2 addr))
- addr))
-
-(defun hashcash-payment-required (addr)
- "Return the hashcash payment value required for the given address."
- (let ((val (assoc addr hashcash-payment-alist)))
- (or (nth 2 val) (nth 1 val) hashcash-default-payment)))
-
-(defun hashcash-payment-to (addr)
- "Return the string with which hashcash payments should collide."
- (let ((val (assoc addr hashcash-payment-alist)))
- (or (nth 1 val) (nth 0 val) addr)))
-
-(defun hashcash-generate-payment (str val)
- "Generate a hashcash payment by finding a VAL-bit collison on STR."
- (if (> val 0)
- (save-excursion
- (set-buffer (get-buffer-create " *hashcash*"))
- (erase-buffer)
- (call-process hashcash-path nil t nil
- "-m" "-q" "-b" (number-to-string val) str)
- (goto-char (point-min))
- (buffer-substring (hashcash-point-at-bol) (hashcash-point-at-eol)))
- nil))
-
-(defun hashcash-check-payment (token str val)
- "Check the validity of a hashcash payment."
- (zerop (call-process hashcash-path nil nil nil "-c"
- "-d" "-f" hashcash-double-spend-database
- "-b" (number-to-string val)
- "-r" str
- token)))
-
-(defun hashcash-version (token)
- "Find the format version of a hashcash token."
- ;; Version 1.2 looks like n:yymmdd:rrrrr:xxxxxxxxxxxxxxxx
- ;; This carries its own version number embedded in the token,
- ;; so no further format number changes should be necessary
- ;; in the X-Payment header.
- ;;
- ;; Version 1.1 looks like yymmdd:rrrrr:xxxxxxxxxxxxxxxx
- ;; You need to upgrade your hashcash binary.
- ;;
- ;; Version 1.0 looked like nnnnnrrrrrxxxxxxxxxxxxxxxx
- ;; This is no longer supported.
- (cond ((equal (aref token 1) ?:) 1.2)
- ((equal (aref token 6) ?:) 1.1)
- (t (error "Unknown hashcash format version"))))
-
-;;;###autoload
-(defun hashcash-insert-payment (arg)
- "Insert X-Payment and X-Hashcash headers with a payment for ARG"
- (interactive "sPay to: ")
- (let ((pay (hashcash-generate-payment (hashcash-payment-to arg)
- (hashcash-payment-required arg))))
- (when pay
-; (insert-before-markers "X-Payment: hashcash "
-; (number-to-string (hashcash-version pay)) " "
-; pay "\n")
- (insert-before-markers "X-Hashcash: " pay "\n"))))
-
-;;;###autoload
-(defun hashcash-verify-payment (token &optional resource amount)
- "Verify a hashcash payment"
- (let ((key (if (< (hashcash-version token) 1.2)
- (nth 1 (split-string token ":"))
- (nth 2 (split-string token ":")))))
- (cond ((null resource)
- (let ((elt (assoc key hashcash-accept-resources)))
- (and elt (hashcash-check-payment token (car elt)
- (or (cadr elt) hashcash-default-accept-payment)))))
- ((equal token key)
- (hashcash-check-payment token resource
- (or amount hashcash-default-accept-payment)))
- (t nil))))
-
-;;;###autoload
-(defun mail-add-payment (&optional arg)
- "Add X-Payment: and X-Hashcash: headers with a hashcash payment
-for each recipient address. Prefix arg sets default payment temporarily."
- (interactive "P")
- (let ((hashcash-default-payment (if arg (prefix-numeric-value arg)
- hashcash-default-payment))
- (addrlist nil))
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (search-forward mail-header-separator)
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (let ((to (hashcash-strip-quoted-names (mail-fetch-field "To" nil t)))
- (cc (hashcash-strip-quoted-names (mail-fetch-field "Cc" nil t)))
- (ng (hashcash-strip-quoted-names (mail-fetch-field "Newsgroups"
- nil t))))
- (when to
- (setq addrlist (split-string to ",[ \t\n]*")))
- (when cc
- (setq addrlist (nconc addrlist (split-string cc ",[ \t\n]*"))))
- (when (and hashcash-in-news ng)
- (setq addrlist (nconc addrlist (split-string ng ",[ \t\n]*")))))
- (when addrlist
- (mapcar #'hashcash-insert-payment addrlist))))) ; mapc
- t)
-
-;;;###autoload
-(defun mail-check-payment (&optional arg)
- "Look for a valid X-Payment: or X-Hashcash: header.
-Prefix arg sets default accept amount temporarily."
- (interactive "P")
- (let ((hashcash-default-accept-payment (if arg (prefix-numeric-value arg)
- hashcash-default-accept-payment))
- (version (hashcash-version (hashcash-generate-payment "x" 1))))
- (save-excursion
- (goto-char (point-min))
- (search-forward "\n\n")
- (beginning-of-line)
- (let ((end (point))
- (ok nil))
- (goto-char (point-min))
- (while (and (not ok) (search-forward "X-Payment: hashcash " end t))
- (let ((value (split-string
- (buffer-substring (point) (hashcash-point-at-eol))
- " ")))
- (when (equal (car value) (number-to-string version))
- (setq ok (hashcash-verify-payment (cadr value))))))
- (goto-char (point-min))
- (while (and (not ok) (search-forward "X-Hashcash: " end t))
- (setq ok (hashcash-verify-payment
- (buffer-substring (point) (hashcash-point-at-eol)))))
- (when ok
- (message "Payment valid"))
- ok))))
-
-(provide 'hashcash)
-
-;;; arch-tag: 0e7fe983-a124-4392-9788-0dbcbd2c4d62
+++ /dev/null
-;;; html2text.el --- a simple html to plain text converter
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Joakim Hove <hove@phys.ntnu.no>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; These functions provide a simple way to wash/clean html infected
-;; mails. Definitely do not work in all cases, but some improvement
-;; in readability is generally obtained. Formatting is only done in
-;; the buffer, so the next time you enter the article it will be
-;; "re-htmlized".
-;;
-;; The main function is `html2text'.
-
-;;; Code:
-
-;;
-;; <Global variables>
-;;
-
-(eval-when-compile
- (require 'cl))
-
-(defvar html2text-format-single-element-list '(("hr" . html2text-clean-hr)))
-
-(defvar html2text-replace-list
- '((" " . " ") (">" . ">") ("<" . "<") (""" . "\"")
- ("&" . "&") ("'" . "'"))
- "The map of entity to text.
-
-This is an alist were each element is a dotted pair consisting of an
-old string, and a replacement string. This replacement is done by the
-function `html2text-substitute' which basically performs a
-`replace-string' operation for every element in the list. This is
-completely verbatim - without any use of REGEXP.")
-
-(defvar html2text-remove-tag-list
- '("html" "body" "p" "img" "dir" "head" "div" "br" "font" "title" "meta")
- "A list of removable tags.
-
-This is a list of tags which should be removed, without any
-formatting. Note that tags in the list are presented *without*
-any \"<\" or \">\". All occurrences of a tag appearing in this
-list are removed, irrespective of whether it is a closing or
-opening tag, or if the tag has additional attributes. The
-deletion is done by the function `html2text-remove-tags'.
-
-For instance the text:
-
-\"Here comes something <font size\"+3\" face=\"Helvetica\"> big </font>.\"
-
-will be reduced to:
-
-\"Here comes something big.\"
-
-If this list contains the element \"font\".")
-
-(defvar html2text-format-tag-list
- '(("b" . html2text-clean-bold)
- ("strong" . html2text-clean-bold)
- ("u" . html2text-clean-underline)
- ("i" . html2text-clean-italic)
- ("em" . html2text-clean-italic)
- ("blockquote" . html2text-clean-blockquote)
- ("a" . html2text-clean-anchor)
- ("ul" . html2text-clean-ul)
- ("ol" . html2text-clean-ol)
- ("dl" . html2text-clean-dl)
- ("center" . html2text-clean-center))
- "An alist of tags and processing functions.
-
-This is an alist where each dotted pair consists of a tag, and then
-the name of a function to be called when this tag is found. The
-function is called with the arguments p1, p2, p3 and p4. These are
-demontrated below:
-
-\"<b> This is bold text </b>\"
- ^ ^ ^ ^
- | | | |
-p1 p2 p3 p4
-
-Then the called function will typically format the text somewhat and
-remove the tags.")
-
-(defvar html2text-remove-tag-list2 '("li" "dt" "dd" "meta")
- "Another list of removable tags.
-
-This is a list of tags which are removed similarly to the list
-`html2text-remove-tag-list' - but these tags are retained for the
-formatting, and then moved afterward.")
-
-;;
-;; </Global variables>
-;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; <Utility functions>
-;;
-
-
-(defun html2text-replace-string (from-string to-string min max)
- "Replace FROM-STRING with TO-STRING in region from MIN to MAX."
- (goto-char min)
- (let ((delta (- (string-width to-string) (string-width from-string)))
- (change 0))
- (while (search-forward from-string max t)
- (replace-match to-string)
- (setq change (+ change delta)))
- change))
-
-;;
-;; </Utility functions>
-;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; <Functions related to attributes> i.e. <font size=+3>
-;;
-
-(defun html2text-attr-value (list attribute)
- "Get value of ATTRIBUTE from LIST."
- (nth 1 (assoc attribute list)))
-
-(defun html2text-get-attr (p1 p2)
- (goto-char p1)
- (re-search-forward " +[^ ]" p2 t)
- (let* ((attr-string (buffer-substring-no-properties (1- (point)) (1- p2)))
- (tmp-list (split-string attr-string))
- (attr-list)
- (counter 0)
- (prev (car tmp-list))
- (this (nth 1 tmp-list))
- (next (nth 2 tmp-list))
- (index 1))
-
- (cond
- ;; size=3
- ((string-match "[^ ]=[^ ]" prev)
- (let ((attr (nth 0 (split-string prev "=")))
- (value (nth 1 (split-string prev "="))))
- (setq attr-list (cons (list attr value) attr-list))))
- ;; size= 3
- ((string-match "[^ ]=\\'" prev)
- (setq attr-list (cons (list (substring prev 0 -1) this) attr-list))))
-
- (while (< index (length tmp-list))
- (cond
- ;; size=3
- ((string-match "[^ ]=[^ ]" this)
- (let ((attr (nth 0 (split-string this "=")))
- (value (nth 1 (split-string this "="))))
- (setq attr-list (cons (list attr value) attr-list))))
- ;; size =3
- ((string-match "\\`=[^ ]" this)
- (setq attr-list (cons (list prev (substring this 1)) attr-list)))
- ;; size= 3
- ((string-match "[^ ]=\\'" this)
- (setq attr-list (cons (list (substring this 0 -1) next) attr-list)))
- ;; size = 3
- ((string= "=" this)
- (setq attr-list (cons (list prev next) attr-list))))
- (setq index (1+ index))
- (setq prev this)
- (setq this next)
- (setq next (nth (1+ index) tmp-list)))
- ;;
- ;; Tags with no accompanying "=" i.e. value=nil
- ;;
- (setq prev (car tmp-list))
- (setq this (nth 1 tmp-list))
- (setq next (nth 2 tmp-list))
- (setq index 1)
-
- (when (and (not (string-match "=" prev))
- (not (string= (substring this 0 1) "=")))
- (setq attr-list (cons (list prev nil) attr-list)))
- (while (< index (1- (length tmp-list)))
- (when (and (not (string-match "=" this))
- (not (or (string= (substring next 0 1) "=")
- (string= (substring prev -1) "="))))
- (setq attr-list (cons (list this nil) attr-list)))
- (setq index (1+ index))
- (setq prev this)
- (setq this next)
- (setq next (nth (1+ index) tmp-list)))
-
- (when (and this
- (not (string-match "=" this))
- (not (string= (substring prev -1) "=")))
- (setq attr-list (cons (list this nil) attr-list)))
- ;; return - value
- attr-list))
-
-;;
-;; </Functions related to attributes>
-;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; <Functions to be called to format a tag-pair>
-;;
-(defun html2text-clean-list-items (p1 p2 list-type)
- (goto-char p1)
- (let ((item-nr 0)
- (items 0))
- (while (re-search-forward "<li>" p2 t)
- (setq items (1+ items)))
- (goto-char p1)
- (while (< item-nr items)
- (setq item-nr (1+ item-nr))
- (re-search-forward "<li>" (point-max) t)
- (cond
- ((string= list-type "ul") (insert " o "))
- ((string= list-type "ol") (insert (format " %s: " item-nr)))
- (t (insert " x "))))))
-
-(defun html2text-clean-dtdd (p1 p2)
- (goto-char p1)
- (let ((items 0)
- (item-nr 0))
- (while (re-search-forward "<dt>" p2 t)
- (setq items (1+ items)))
- (goto-char p1)
- (while (< item-nr items)
- (setq item-nr (1+ item-nr))
- (re-search-forward "<dt>\\([ ]*\\)" (point-max) t)
- (when (match-string 1)
- (delete-region (point) (- (point) (string-width (match-string 1)))))
- (let ((def-p1 (point))
- (def-p2 0))
- (re-search-forward "\\([ ]*\\)\\(</dt>\\|<dd>\\)" (point-max) t)
- (if (match-string 1)
- (progn
- (let* ((mw1 (string-width (match-string 1)))
- (mw2 (string-width (match-string 2)))
- (mw (+ mw1 mw2)))
- (goto-char (- (point) mw))
- (delete-region (point) (+ (point) mw1))
- (setq def-p2 (point))))
- (setq def-p2 (- (point) (string-width (match-string 2)))))
- (put-text-property def-p1 def-p2 'face 'bold)))))
-
-(defun html2text-delete-tags (p1 p2 p3 p4)
- (delete-region p1 p2)
- (delete-region (- p3 (- p2 p1)) (- p4 (- p2 p1))))
-
-(defun html2text-delete-single-tag (p1 p2)
- (delete-region p1 p2))
-
-(defun html2text-clean-hr (p1 p2)
- (html2text-delete-single-tag p1 p2)
- (goto-char p1)
- (newline 1)
- (insert (make-string fill-column ?-)))
-
-(defun html2text-clean-ul (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4)
- (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ul"))
-
-(defun html2text-clean-ol (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4)
- (html2text-clean-list-items p1 (- p3 (- p1 p2)) "ol"))
-
-(defun html2text-clean-dl (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4)
- (html2text-clean-dtdd p1 (- p3 (- p1 p2))))
-
-(defun html2text-clean-center (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4)
- (center-region p1 (- p3 (- p2 p1))))
-
-(defun html2text-clean-bold (p1 p2 p3 p4)
- (put-text-property p2 p3 'face 'bold)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-title (p1 p2 p3 p4)
- (put-text-property p2 p3 'face 'bold)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-underline (p1 p2 p3 p4)
- (put-text-property p2 p3 'face 'underline)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-italic (p1 p2 p3 p4)
- (put-text-property p2 p3 'face 'italic)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-font (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-blockquote (p1 p2 p3 p4)
- (html2text-delete-tags p1 p2 p3 p4))
-
-(defun html2text-clean-anchor (p1 p2 p3 p4)
- ;; If someone can explain how to make the URL clickable I will surely
- ;; improve upon this.
- ;; Maybe `goto-addr.el' can be used here.
- (let* ((attr-list (html2text-get-attr p1 p2))
- (href (html2text-attr-value attr-list "href")))
- (delete-region p1 p4)
- (when href
- (goto-char p1)
- (insert (substring href 1 -1 ))
- (put-text-property p1 (point) 'face 'bold))))
-
-;;
-;; </Functions to be called to format a tag-pair>
-;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; <Functions to be called to fix up paragraphs>
-;;
-
-(defun html2text-fix-paragraph (p1 p2)
- (goto-char p1)
- (let ((has-br-line)
- (refill-start)
- (refill-stop))
- (when (re-search-forward "<br>$" p2 t)
- (goto-char p1)
- (when (re-search-forward ".+[^<][^b][^r][^>]$" p2 t)
- (beginning-of-line)
- (setq refill-start (point))
- (goto-char p2)
- (re-search-backward ".+[^<][^b][^r][^>]$" refill-start t)
- (forward-line 1)
- (end-of-line)
- ;; refill-stop should ideally be adjusted to
- ;; accomodate the "<br>" strings which are removed
- ;; between refill-start and refill-stop. Can simply
- ;; be returned from my-replace-string
- (setq refill-stop (+ (point)
- (html2text-replace-string
- "<br>" ""
- refill-start (point))))
- ;; (message "Point = %s refill-stop = %s" (point) refill-stop)
- ;; (sleep-for 4)
- (fill-region refill-start refill-stop))))
- (html2text-replace-string "<br>" "" p1 p2))
-
-;;
-;; This one is interactive ...
-;;
-(defun html2text-fix-paragraphs ()
- "This _tries_ to fix up the paragraphs - this is done in quite a ad-hook
-fashion, quite close to pure guess-work. It does work in some cases though."
- (interactive)
- (goto-char (point-min))
- (while (re-search-forward "^<br>$" nil t)
- (delete-region (match-beginning 0) (match-end 0)))
- ;; Removing lonely <br> on a single line, if they are left intact we
- ;; dont have any paragraphs at all.
- (goto-char (point-min))
- (while (not (eobp))
- (let ((p1 (point)))
- (forward-paragraph 1)
- ;;(message "Kaller fix med p1=%s p2=%s " p1 (1- (point))) (sleep-for 5)
- (html2text-fix-paragraph p1 (1- (point)))
- (goto-char p1)
- (when (not (eobp))
- (forward-paragraph 1)))))
-
-;;
-;; </Functions to be called to fix up paragraphs>
-;;
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;
-;; <Interactive functions>
-;;
-
-(defun html2text-remove-tags (tag-list)
- "Removes the tags listed in the list `html2text-remove-tag-list'.
-See the documentation for that variable."
- (interactive)
- (dolist (tag tag-list)
- (goto-char (point-min))
- (while (re-search-forward (format "\\(</?%s[^>]*>\\)" tag) (point-max) t)
- (delete-region (match-beginning 0) (match-end 0)))))
-
-(defun html2text-format-tags ()
- "See the variable `html2text-format-tag-list' for documentation."
- (interactive)
- (dolist (tag-and-function html2text-format-tag-list)
- (let ((tag (car tag-and-function))
- (function (cdr tag-and-function)))
- (goto-char (point-min))
- (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
- (point-max) t)
- (let ((p1)
- (p2 (point))
- (p3) (p4))
- (search-backward "<" (point-min) t)
- (setq p1 (point))
- (unless (search-forward (format "</%s>" tag) (point-max) t)
- (goto-char p2)
- (insert (format "</%s>" tag)))
- (setq p4 (point))
- (search-backward "</" (point-min) t)
- (setq p3 (point))
- (funcall function p1 p2 p3 p4)
- (goto-char p1))))))
-
-(defun html2text-substitute ()
- "See the variable `html2text-replace-list' for documentation."
- (interactive)
- (dolist (e html2text-replace-list)
- (goto-char (point-min))
- (let ((old-string (car e))
- (new-string (cdr e)))
- (html2text-replace-string old-string new-string (point-min) (point-max)))))
-
-(defun html2text-format-single-elements ()
- (interactive)
- (dolist (tag-and-function html2text-format-single-element-list)
- (let ((tag (car tag-and-function))
- (function (cdr tag-and-function)))
- (goto-char (point-min))
- (while (re-search-forward (format "\\(<%s\\( [^>]*\\)?>\\)" tag)
- (point-max) t)
- (let ((p1)
- (p2 (point)))
- (search-backward "<" (point-min) t)
- (setq p1 (point))
- (funcall function p1 p2))))))
-
-;;
-;; Main function
-;;
-
-;;;###autoload
-(defun html2text ()
- "Convert HTML to plain text in the current buffer."
- (interactive)
- (save-excursion
- (let ((case-fold-search t)
- (buffer-read-only))
- (html2text-remove-tags html2text-remove-tag-list)
- (html2text-format-tags)
- (html2text-remove-tags html2text-remove-tag-list2)
- (html2text-substitute)
- (html2text-format-single-elements)
- (html2text-fix-paragraphs))))
-
-;;
-;; </Interactive functions>
-;;
-(provide 'html2text)
-;;; arch-tag: e9e57b79-35d4-4de1-a647-e7e01fe56d1e
-;;; html2text.el ends here
+++ /dev/null
-;;; ietf-drums.el --- Functions for parsing RFC822bis headers
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; DRUMS is an IETF Working Group that works (or worked) on the
-;; successor to RFC822, "Standard For The Format Of Arpa Internet Text
-;; Messages". This library is based on
-;; draft-ietf-drums-msg-fmt-05.txt, released on 1998-08-05.
-
-;; Pending a real regression self test suite, Simon Josefsson added
-;; various self test expressions snipped from bug reports, and their
-;; expected value, below. I you believe it could be useful, please
-;; add your own test cases, or write a real self test suite, or just
-;; remove this.
-
-;; <m3oekvfd50.fsf@whitebox.m5r.de>
-;; (ietf-drums-parse-address "'foo' <foo@example.com>")
-;; => ("foo@example.com" . "'foo'")
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'time-date)
-(require 'mm-util)
-
-(defvar ietf-drums-no-ws-ctl-token "\001-\010\013\014\016-\037\177"
- "US-ASCII control characters excluding CR, LF and white space.")
-(defvar ietf-drums-text-token "\001-\011\013\014\016-\177"
- "US-ASCII characters excluding CR and LF.")
-(defvar ietf-drums-specials-token "()<>[]:;@\\,.\""
- "Special characters.")
-(defvar ietf-drums-quote-token "\\"
- "Quote character.")
-(defvar ietf-drums-wsp-token " \t"
- "White space.")
-(defvar ietf-drums-fws-regexp
- (concat "[" ietf-drums-wsp-token "]*\n[" ietf-drums-wsp-token "]+")
- "Folding white space.")
-(defvar ietf-drums-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~"
- "Textual token.")
-(defvar ietf-drums-dot-atext-token "-^a-zA-Z0-9!#$%&'*+/=?_`{|}~."
- "Textual token including full stop.")
-(defvar ietf-drums-qtext-token
- (concat ietf-drums-no-ws-ctl-token "\041\043-\133\135-\177")
- "Non-white-space control characters, plus the rest of ASCII excluding
-backslash and doublequote.")
-(defvar ietf-drums-tspecials "][()<>@,;:\\\"/?="
- "Tspecials.")
-
-(defvar ietf-drums-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\\ "/" table)
- (modify-syntax-entry ?< "(" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?@ "w" table)
- (modify-syntax-entry ?/ "w" table)
- (modify-syntax-entry ?* "_" table)
- (modify-syntax-entry ?\; "_" table)
- (modify-syntax-entry ?\' "_" table)
- (if (featurep 'xemacs)
- (let ((i 128))
- (while (< i 256)
- (modify-syntax-entry i "w" table)
- (setq i (1+ i)))))
- table))
-
-(defun ietf-drums-token-to-list (token)
- "Translate TOKEN into a list of characters."
- (let ((i 0)
- b e c out range)
- (while (< i (length token))
- (setq c (mm-char-int (aref token i)))
- (incf i)
- (cond
- ((eq c (mm-char-int ?-))
- (if b
- (setq range t)
- (push c out)))
- (range
- (while (<= b c)
- (push (mm-make-char 'ascii b) out)
- (incf b))
- (setq range nil))
- ((= i (length token))
- (push (mm-make-char 'ascii c) out))
- (t
- (when b
- (push (mm-make-char 'ascii b) out))
- (setq b c))))
- (nreverse out)))
-
-(defsubst ietf-drums-init (string)
- (set-syntax-table ietf-drums-syntax-table)
- (insert string)
- (ietf-drums-unfold-fws)
- (goto-char (point-min)))
-
-(defun ietf-drums-remove-comments (string)
- "Remove comments from STRING."
- (with-temp-buffer
- (let (c)
- (ietf-drums-init string)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (delete-region (point) (progn (forward-sexp 1) (point))))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun ietf-drums-remove-whitespace (string)
- "Remove whitespace from STRING."
- (with-temp-buffer
- (ietf-drums-init string)
- (let (c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((memq c '(?\ ?\t ?\n))
- (delete-char 1))
- (t
- (forward-char 1))))
- (buffer-string))))
-
-(defun ietf-drums-get-comment (string)
- "Return the first comment in STRING."
- (with-temp-buffer
- (ietf-drums-init string)
- (let (result c)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (forward-sexp 1))
- ((eq c ?\()
- (setq result
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))
- (t
- (forward-char 1))))
- result)))
-
-(defun ietf-drums-strip (string)
- "Remove comments and whitespace from STRING."
- (ietf-drums-remove-whitespace (ietf-drums-remove-comments string)))
-
-(defun ietf-drums-parse-address (string)
- "Parse STRING and return a MAILBOX / DISPLAY-NAME pair."
- (with-temp-buffer
- (let (display-name mailbox c display-string)
- (ietf-drums-init string)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((or (eq c ? )
- (eq c ?\t))
- (forward-char 1))
- ((eq c ?\()
- (forward-sexp 1))
- ((eq c ?\")
- (push (buffer-substring
- (1+ (point)) (progn (forward-sexp 1) (1- (point))))
- display-name))
- ((looking-at (concat "[" ietf-drums-atext-token "@" "]"))
- (push (buffer-substring (point) (progn (forward-sexp 1) (point)))
- display-name))
- ((eq c ?<)
- (setq mailbox
- (ietf-drums-remove-whitespace
- (ietf-drums-remove-comments
- (buffer-substring
- (1+ (point))
- (progn (forward-sexp 1) (1- (point))))))))
- (t (error "Unknown symbol: %c" c))))
- ;; If we found no display-name, then we look for comments.
- (if display-name
- (setq display-string
- (mapconcat 'identity (reverse display-name) " "))
- (setq display-string (ietf-drums-get-comment string)))
- (if (not mailbox)
- (when (string-match "@" display-string)
- (cons
- (mapconcat 'identity (nreverse display-name) "")
- (ietf-drums-get-comment string)))
- (cons mailbox display-string)))))
-
-(defun ietf-drums-parse-addresses (string)
- "Parse STRING and return a list of MAILBOX / DISPLAY-NAME pairs."
- (if (null string)
- nil
- (with-temp-buffer
- (ietf-drums-init string)
- (let ((beg (point))
- pairs c address)
- (while (not (eobp))
- (setq c (char-after))
- (cond
- ((memq c '(?\" ?< ?\())
- (condition-case nil
- (forward-sexp 1)
- (error
- (skip-chars-forward "^,"))))
- ((eq c ?,)
- (setq address
- (condition-case nil
- (ietf-drums-parse-address
- (buffer-substring beg (point)))
- (error nil)))
- (if address (push address pairs))
- (forward-char 1)
- (setq beg (point)))
- (t
- (forward-char 1))))
- (setq address
- (condition-case nil
- (ietf-drums-parse-address
- (buffer-substring beg (point)))
- (error nil)))
- (if address (push address pairs))
- (nreverse pairs)))))
-
-(defun ietf-drums-unfold-fws ()
- "Unfold folding white space in the current buffer."
- (goto-char (point-min))
- (while (re-search-forward ietf-drums-fws-regexp nil t)
- (replace-match " " t t))
- (goto-char (point-min)))
-
-(defun ietf-drums-parse-date (string)
- "Return an Emacs time spec from STRING."
- (apply 'encode-time (parse-time-string string)))
-
-(defun ietf-drums-narrow-to-header ()
- "Narrow to the header section in the current buffer."
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward "^\r?$" nil 1)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min)))
-
-(defun ietf-drums-quote-string (string)
- "Quote string if it needs quoting to be displayed in a header."
- (if (string-match (concat "[^" ietf-drums-atext-token "]") string)
- (concat "\"" string "\"")
- string))
-
-(provide 'ietf-drums)
-
-;;; arch-tag: 379a0191-dbae-4ca6-a0f5-d4202c209ef9
-;;; ietf-drums.el ends here
+++ /dev/null
-;;; imap.el --- imap library
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <jas@pdc.kth.se>
-;; Keywords: mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; imap.el is a elisp library providing an interface for talking to
-;; IMAP servers.
-;;
-;; imap.el is roughly divided in two parts, one that parses IMAP
-;; responses from the server and storing data into buffer-local
-;; variables, and one for utility functions which send commands to
-;; server, waits for an answer, and return information. The latter
-;; part is layered on top of the previous.
-;;
-;; The imap.el API consist of the following functions, other functions
-;; in this file should not be called directly and the result of doing
-;; so are at best undefined.
-;;
-;; Global commands:
-;;
-;; imap-open, imap-opened, imap-authenticate, imap-close,
-;; imap-capability, imap-namespace, imap-error-text
-;;
-;; Mailbox commands:
-;;
-;; imap-mailbox-get, imap-mailbox-map, imap-current-mailbox,
-;; imap-current-mailbox-p, imap-search, imap-mailbox-select,
-;; imap-mailbox-examine, imap-mailbox-unselect, imap-mailbox-expunge
-;; imap-mailbox-close, imap-mailbox-create, imap-mailbox-delete
-;; imap-mailbox-rename, imap-mailbox-lsub, imap-mailbox-list
-;; imap-mailbox-subscribe, imap-mailbox-unsubscribe, imap-mailbox-status
-;; imap-mailbox-acl-get, imap-mailbox-acl-set, imap-mailbox-acl-delete
-;;
-;; Message commands:
-;;
-;; imap-fetch-asynch, imap-fetch,
-;; imap-current-message, imap-list-to-message-set,
-;; imap-message-get, imap-message-map
-;; imap-message-envelope-date, imap-message-envelope-subject,
-;; imap-message-envelope-from, imap-message-envelope-sender,
-;; imap-message-envelope-reply-to, imap-message-envelope-to,
-;; imap-message-envelope-cc, imap-message-envelope-bcc
-;; imap-message-envelope-in-reply-to, imap-message-envelope-message-id
-;; imap-message-body, imap-message-flag-permanent-p
-;; imap-message-flags-set, imap-message-flags-del
-;; imap-message-flags-add, imap-message-copyuid
-;; imap-message-copy, imap-message-appenduid
-;; imap-message-append, imap-envelope-from
-;; imap-body-lines
-;;
-;; It is my hope that these commands should be pretty self
-;; explanatory for someone that know IMAP. All functions have
-;; additional documentation on how to invoke them.
-;;
-;; imap.el support RFC1730/2060 (IMAP4/IMAP4rev1), implemented IMAP
-;; extensions are RFC2195 (CRAM-MD5), RFC2086 (ACL), RFC2342
-;; (NAMESPACE), RFC2359 (UIDPLUS), the IMAP-part of RFC2595 (STARTTLS,
-;; LOGINDISABLED) (with use of external library starttls.el and
-;; program starttls) and the GSSAPI / kerberos V4 sections of RFC1731
-;; (with use of external program `imtest'). It also takes advantage of
-;; the UNSELECT extension in Cyrus IMAPD.
-;;
-;; Without the work of John McClary Prevost and Jim Radford this library
-;; would not have seen the light of day. Many thanks.
-;;
-;; This is a transcript of short interactive session for demonstration
-;; purposes.
-;;
-;; (imap-open "my.mail.server")
-;; => " *imap* my.mail.server:0"
-;;
-;; The rest are invoked with current buffer as the buffer returned by
-;; `imap-open'. It is possible to do all without this, but it would
-;; look ugly here since `buffer' is always the last argument for all
-;; imap.el API functions.
-;;
-;; (imap-authenticate "myusername" "mypassword")
-;; => auth
-;;
-;; (imap-mailbox-lsub "*")
-;; => ("INBOX.sentmail" "INBOX.private" "INBOX.draft" "INBOX.spam")
-;;
-;; (imap-mailbox-list "INBOX.n%")
-;; => ("INBOX.namedroppers" "INBOX.nnimap" "INBOX.ntbugtraq")
-;;
-;; (imap-mailbox-select "INBOX.nnimap")
-;; => "INBOX.nnimap"
-;;
-;; (imap-mailbox-get 'exists)
-;; => 166
-;;
-;; (imap-mailbox-get 'uidvalidity)
-;; => "908992622"
-;;
-;; (imap-search "FLAGGED SINCE 18-DEC-98")
-;; => (235 236)
-;;
-;; (imap-fetch 235 "RFC822.PEEK" 'RFC822)
-;; => "X-Sieve: cmu-sieve 1.3^M\nX-Username: <jas@pdc.kth.se>^M\r...."
-;;
-;; Todo:
-;;
-;; o Parse UIDs as strings? We need to overcome the 28 bit limit somehow.
-;; o Don't use `read' at all (important places already fixed)
-;; o Accept list of articles instead of message set string in most
-;; imap-message-* functions.
-;; o Send strings as literal if they contain, e.g., ".
-;;
-;; Revision history:
-;;
-;; - 19991218 added starttls/digest-md5 patch,
-;; by Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-;; NB! you need SLIM for starttls.el and digest-md5.el
-;; - 19991023 commited to pgnus
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(eval-and-compile
- (autoload 'base64-decode-string "base64")
- (autoload 'base64-encode-string "base64")
- (autoload 'starttls-open-stream "starttls")
- (autoload 'starttls-negotiate "starttls")
- (autoload 'digest-md5-parse-digest-challenge "digest-md5")
- (autoload 'digest-md5-digest-response "digest-md5")
- (autoload 'digest-md5-digest-uri "digest-md5")
- (autoload 'digest-md5-challenge "digest-md5")
- (autoload 'rfc2104-hash "rfc2104")
- (autoload 'md5 "md5")
- (autoload 'utf7-encode "utf7")
- (autoload 'utf7-decode "utf7")
- (autoload 'format-spec "format-spec")
- (autoload 'format-spec-make "format-spec")
- (autoload 'open-tls-stream "tls")
- ;; Avoid use gnus-point-at-eol so we're independent of Gnus. These
- ;; days we have point-at-eol anyhow.
- (if (fboundp 'point-at-eol)
- (defalias 'imap-point-at-eol 'point-at-eol)
- (defun imap-point-at-eol ()
- (save-excursion
- (end-of-line)
- (point)))))
-
-;; User variables.
-
-(defgroup imap nil
- "Low-level IMAP issues."
- :version "21.1"
- :group 'mail)
-
-(defcustom imap-kerberos4-program '("imtest -m kerberos_v4 -u %l -p %p %s"
- "imtest -kp %s %p")
- "List of strings containing commands for Kerberos 4 authentication.
-%s is replaced with server hostname, %p with port to connect to, and
-%l with the value of `imap-default-user'. The program should accept
-IMAP commands on stdin and return responses to stdout. Each entry in
-the list is tried until a successful connection is made."
- :group 'imap
- :type '(repeat string))
-
-(defcustom imap-gssapi-program (list
- (concat "gsasl %s %p "
- "--mechanism GSSAPI "
- "--authentication-id %l")
- "imtest -m gssapi -u %l -p %p %s")
- "List of strings containing commands for GSSAPI (krb5) authentication.
-%s is replaced with server hostname, %p with port to connect to, and
-%l with the value of `imap-default-user'. The program should accept
-IMAP commands on stdin and return responses to stdout. Each entry in
-the list is tried until a successful connection is made."
- :group 'imap
- :type '(repeat string))
-
-(defcustom imap-ssl-program '("openssl s_client -quiet -ssl3 -connect %s:%p"
- "openssl s_client -quiet -ssl2 -connect %s:%p"
- "s_client -quiet -ssl3 -connect %s:%p"
- "s_client -quiet -ssl2 -connect %s:%p")
- "A string, or list of strings, containing commands for SSL connections.
-Within a string, %s is replaced with the server address and %p with
-port number on server. The program should accept IMAP commands on
-stdin and return responses to stdout. Each entry in the list is tried
-until a successful connection is made."
- :group 'imap
- :type '(choice string
- (repeat string)))
-
-(defcustom imap-shell-program '("ssh %s imapd"
- "rsh %s imapd"
- "ssh %g ssh %s imapd"
- "rsh %g rsh %s imapd")
- "A list of strings, containing commands for IMAP connection.
-Within a string, %s is replaced with the server address, %p with port
-number on server, %g with `imap-shell-host', and %l with
-`imap-default-user'. The program should read IMAP commands from stdin
-and write IMAP response to stdout. Each entry in the list is tried
-until a successful connection is made."
- :group 'imap
- :type '(repeat string))
-
-(defcustom imap-process-connection-type nil
- "*Value for `process-connection-type' to use for Kerberos4, GSSAPI and SSL.
-The `process-connection-type' variable control type of device
-used to communicate with subprocesses. Values are nil to use a
-pipe, or t or `pty' to use a pty. The value has no effect if the
-system has no ptys or if all ptys are busy: then a pipe is used
-in any case. The value takes effect when a IMAP server is
-opened, changing it after that has no effect."
- :version "22.1"
- :group 'imap
- :type 'boolean)
-
-(defcustom imap-use-utf7 t
- "If non-nil, do utf7 encoding/decoding of mailbox names.
-Since the UTF7 decoding currently only decodes into ISO-8859-1
-characters, you may disable this decoding if you need to access UTF7
-encoded mailboxes which doesn't translate into ISO-8859-1."
- :group 'imap
- :type 'boolean)
-
-(defcustom imap-log nil
- "If non-nil, a imap session trace is placed in *imap-log* buffer.
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *imap-log*
-buffer. It is not written to disk, however. Do not enable this
-variable unless you are comfortable with that."
- :group 'imap
- :type 'boolean)
-
-(defcustom imap-debug nil
- "If non-nil, random debug spews are placed in *imap-debug* buffer.
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *imap-debug*
-buffer. It is not written to disk, however. Do not enable this
-variable unless you are comfortable with that."
- :group 'imap
- :type 'boolean)
-
-(defcustom imap-shell-host "gateway"
- "Hostname of rlogin proxy."
- :group 'imap
- :type 'string)
-
-(defcustom imap-default-user (user-login-name)
- "Default username to use."
- :group 'imap
- :type 'string)
-
-(defcustom imap-read-timeout (if (string-match
- "windows-nt\\|os/2\\|emx\\|cygwin"
- (symbol-name system-type))
- 1.0
- 0.1)
- "*How long to wait between checking for the end of output.
-Shorter values mean quicker response, but is more CPU intensive."
- :type 'number
- :group 'imap)
-
-(defcustom imap-store-password nil
- "If non-nil, store session password without promting."
- :group 'imap
- :type 'boolean)
-
-;; Various variables.
-
-(defvar imap-fetch-data-hook nil
- "Hooks called after receiving each FETCH response.")
-
-(defvar imap-streams '(gssapi kerberos4 starttls tls ssl network shell)
- "Priority of streams to consider when opening connection to server.")
-
-(defvar imap-stream-alist
- '((gssapi imap-gssapi-stream-p imap-gssapi-open)
- (kerberos4 imap-kerberos4-stream-p imap-kerberos4-open)
- (tls imap-tls-p imap-tls-open)
- (ssl imap-ssl-p imap-ssl-open)
- (network imap-network-p imap-network-open)
- (shell imap-shell-p imap-shell-open)
- (starttls imap-starttls-p imap-starttls-open))
- "Definition of network streams.
-
-\(NAME CHECK OPEN)
-
-NAME names the stream, CHECK is a function returning non-nil if the
-server support the stream and OPEN is a function for opening the
-stream.")
-
-(defvar imap-authenticators '(gssapi
- kerberos4
- digest-md5
- cram-md5
- login
- anonymous)
- "Priority of authenticators to consider when authenticating to server.")
-
-(defvar imap-authenticator-alist
- '((gssapi imap-gssapi-auth-p imap-gssapi-auth)
- (kerberos4 imap-kerberos4-auth-p imap-kerberos4-auth)
- (cram-md5 imap-cram-md5-p imap-cram-md5-auth)
- (login imap-login-p imap-login-auth)
- (anonymous imap-anonymous-p imap-anonymous-auth)
- (digest-md5 imap-digest-md5-p imap-digest-md5-auth))
- "Definition of authenticators.
-
-\(NAME CHECK AUTHENTICATE)
-
-NAME names the authenticator. CHECK is a function returning non-nil if
-the server support the authenticator and AUTHENTICATE is a function
-for doing the actual authentication.")
-
-(defvar imap-error nil
- "Error codes from the last command.")
-
-;; Internal constants. Change these and die.
-
-(defconst imap-default-port 143)
-(defconst imap-default-ssl-port 993)
-(defconst imap-default-tls-port 993)
-(defconst imap-default-stream 'network)
-(defconst imap-coding-system-for-read 'binary)
-(defconst imap-coding-system-for-write 'binary)
-(defconst imap-local-variables '(imap-server
- imap-port
- imap-client-eol
- imap-server-eol
- imap-auth
- imap-stream
- imap-username
- imap-password
- imap-current-mailbox
- imap-current-target-mailbox
- imap-message-data
- imap-capability
- imap-namespace
- imap-state
- imap-reached-tag
- imap-failed-tags
- imap-tag
- imap-process
- imap-calculate-literal-size-first
- imap-mailbox-data))
-(defconst imap-log-buffer "*imap-log*")
-(defconst imap-debug-buffer "*imap-debug*")
-
-;; Internal variables.
-
-(defvar imap-stream nil)
-(defvar imap-auth nil)
-(defvar imap-server nil)
-(defvar imap-port nil)
-(defvar imap-username nil)
-(defvar imap-password nil)
-(defvar imap-calculate-literal-size-first nil)
-(defvar imap-state 'closed
- "IMAP state.
-Valid states are `closed', `initial', `nonauth', `auth', `selected'
-and `examine'.")
-
-(defvar imap-server-eol "\r\n"
- "The EOL string sent from the server.")
-
-(defvar imap-client-eol "\r\n"
- "The EOL string we send to the server.")
-
-(defvar imap-current-mailbox nil
- "Current mailbox name.")
-
-(defvar imap-current-target-mailbox nil
- "Current target mailbox for COPY and APPEND commands.")
-
-(defvar imap-mailbox-data nil
- "Obarray with mailbox data.")
-
-(defvar imap-mailbox-prime 997
- "Length of imap-mailbox-data.")
-
-(defvar imap-current-message nil
- "Current message number.")
-
-(defvar imap-message-data nil
- "Obarray with message data.")
-
-(defvar imap-message-prime 997
- "Length of imap-message-data.")
-
-(defvar imap-capability nil
- "Capability for server.")
-
-(defvar imap-namespace nil
- "Namespace for current server.")
-
-(defvar imap-reached-tag 0
- "Lower limit on command tags that have been parsed.")
-
-(defvar imap-failed-tags nil
- "Alist of tags that failed.
-Each element is a list with four elements; tag (a integer), response
-state (a symbol, `OK', `NO' or `BAD'), response code (a string), and
-human readable response text (a string).")
-
-(defvar imap-tag 0
- "Command tag number.")
-
-(defvar imap-process nil
- "Process.")
-
-(defvar imap-continuation nil
- "Non-nil indicates that the server emitted a continuation request.
-The actual value is really the text on the continuation line.")
-
-(defvar imap-callbacks nil
- "List of response tags and callbacks, on the form `(number . function)'.
-The function should take two arguments, the first the IMAP tag and the
-second the status (OK, NO, BAD etc) of the command.")
-
-\f
-;; Utility functions:
-
-(defun imap-remassoc (key alist)
- "Delete by side effect any elements of LIST whose car is `equal' to KEY.
-The modified LIST is returned. If the first member
-of LIST has a car that is `equal' to KEY, there is no way to remove it
-by side effect; therefore, write `(setq foo (remassoc key foo))' to be
-sure of changing the value of `foo'."
- (when alist
- (if (equal key (caar alist))
- (cdr alist)
- (setcdr alist (imap-remassoc key (cdr alist)))
- alist)))
-
-(defsubst imap-disable-multibyte ()
- "Enable multibyte in the current buffer."
- (when (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil)))
-
-(defsubst imap-utf7-encode (string)
- (if imap-use-utf7
- (and string
- (condition-case ()
- (utf7-encode string t)
- (error (message
- "imap: Could not UTF7 encode `%s', using it unencoded..."
- string)
- string)))
- string))
-
-(defsubst imap-utf7-decode (string)
- (if imap-use-utf7
- (and string
- (condition-case ()
- (utf7-decode string t)
- (error (message
- "imap: Could not UTF7 decode `%s', using it undecoded..."
- string)
- string)))
- string))
-
-(defsubst imap-ok-p (status)
- (if (eq status 'OK)
- t
- (setq imap-error status)
- nil))
-
-(defun imap-error-text (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (nth 3 (car imap-failed-tags))))
-
-\f
-;; Server functions; stream stuff:
-
-(defun imap-kerberos4-stream-p (buffer)
- (imap-capability 'AUTH=KERBEROS_V4 buffer))
-
-(defun imap-kerberos4-open (name buffer server port)
- (let ((cmds imap-kerberos4-program)
- cmd done)
- (while (and (not done) (setq cmd (pop cmds)))
- (message "Opening Kerberos 4 IMAP connection with `%s'..." cmd)
- (erase-buffer)
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process-connection-type imap-process-connection-type)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
- response)
- (when process
- (with-current-buffer buffer
- (setq imap-client-eol "\n"
- imap-calculate-literal-size-first t)
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- ;; Athena IMTEST can output SSL verify errors
- (or (while (looking-at "^verify error:num=")
- (forward-line))
- t)
- (or (while (looking-at "^TLS connection established")
- (forward-line))
- t)
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
- (forward-line))
- t)
- ;; cyrus 1.6 imtest print "S: " before server greeting
- (or (not (looking-at "S: "))
- (forward-char 3)
- t)
- (not (and (imap-parse-greeting)
- ;; success in imtest < 1.6:
- (or (re-search-forward
- "^__\\(.*\\)__\n" nil t)
- ;; success in imtest 1.6:
- (re-search-forward
- "^\\(Authenticat.*\\)" nil t))
- (setq response (match-string 1)))))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (erase-buffer)
- (message "Opening Kerberos 4 IMAP connection with `%s'...%s" cmd
- (if response (concat "done, " response) "failed"))
- (if (and response (let ((case-fold-search nil))
- (not (string-match "failed" response))))
- (setq done process)
- (if (memq (process-status process) '(open run))
- (imap-send-command "LOGOUT"))
- (delete-process process)
- nil)))))
- done))
-
-(defun imap-gssapi-stream-p (buffer)
- (imap-capability 'AUTH=GSSAPI buffer))
-
-(defun imap-gssapi-open (name buffer server port)
- (let ((cmds imap-gssapi-program)
- cmd done)
- (while (and (not done) (setq cmd (pop cmds)))
- (message "Opening GSSAPI IMAP connection with `%s'..." cmd)
- (erase-buffer)
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process-connection-type imap-process-connection-type)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)
- ?l imap-default-user))))
- response)
- (when process
- (with-current-buffer buffer
- (setq imap-client-eol "\n"
- imap-calculate-literal-size-first t)
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- ;; Athena IMTEST can output SSL verify errors
- (or (while (looking-at "^verify error:num=")
- (forward-line))
- t)
- (or (while (looking-at "^TLS connection established")
- (forward-line))
- t)
- ;; cyrus 1.6.x (13? < x <= 22) queries capabilities
- (or (while (looking-at "^C:")
- (forward-line))
- t)
- ;; cyrus 1.6 imtest print "S: " before server greeting
- (or (not (looking-at "S: "))
- (forward-char 3)
- t)
- ;; GNU SASL may print 'Trying ...' first.
- (or (not (looking-at "Trying "))
- (forward-line)
- t)
- (not (and (imap-parse-greeting)
- ;; success in imtest 1.6:
- (re-search-forward
- (concat "^\\(\\(Authenticat.*\\)\\|\\("
- "Client authentication "
- "finished.*\\)\\)")
- nil t)
- (setq response (match-string 1)))))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (erase-buffer)
- (message "GSSAPI IMAP connection: %s" (or response "failed"))
- (if (and response (let ((case-fold-search nil))
- (not (string-match "failed" response))))
- (setq done process)
- (if (memq (process-status process) '(open run))
- (imap-send-command "LOGOUT"))
- (delete-process process)
- nil)))))
- done))
-
-(defun imap-ssl-p (buffer)
- nil)
-
-(defun imap-ssl-open (name buffer server port)
- "Open a SSL connection to server."
- (let ((cmds (if (listp imap-ssl-program) imap-ssl-program
- (list imap-ssl-program)))
- cmd done)
- (while (and (not done) (setq cmd (pop cmds)))
- (message "imap: Opening SSL connection with `%s'..." cmd)
- (erase-buffer)
- (let* ((port (or port imap-default-ssl-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process-connection-type imap-process-connection-type)
- (set-process-query-on-exit-flag
- (if (fboundp 'set-process-query-on-exit-flag)
- 'set-process-query-on-exit-flag
- 'process-kill-without-query))
- process)
- (when (progn
- (setq process (start-process
- name buffer shell-file-name
- shell-command-switch
- (format-spec cmd
- (format-spec-make
- ?s server
- ?p (number-to-string port)))))
- (funcall set-process-query-on-exit-flag process nil)
- process)
- (with-current-buffer buffer
- (goto-char (point-min))
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-max))
- (forward-line -1)
- (not (imap-parse-greeting)))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (erase-buffer)
- (when (memq (process-status process) '(open run))
- (setq done process))))))
- (if done
- (progn
- (message "imap: Opening SSL connection with `%s'...done" cmd)
- done)
- (message "imap: Opening SSL connection with `%s'...failed" cmd)
- nil)))
-
-(defun imap-tls-p (buffer)
- nil)
-
-(defun imap-tls-open (name buffer server port)
- (let* ((port (or port imap-default-tls-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (open-tls-stream name buffer server port)))
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-max))
- (forward-line -1)
- (not (imap-parse-greeting)))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (when (memq (process-status process) '(open run))
- process))))
-
-(defun imap-network-p (buffer)
- t)
-
-(defun imap-network-open (name buffer server port)
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (open-network-stream name buffer server port)))
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-min))
- (not (imap-parse-greeting)))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (when (memq (process-status process) '(open run))
- process))))
-
-(defun imap-shell-p (buffer)
- nil)
-
-(defun imap-shell-open (name buffer server port)
- (let ((cmds (if (listp imap-shell-program) imap-shell-program
- (list imap-shell-program)))
- cmd done)
- (while (and (not done) (setq cmd (pop cmds)))
- (message "imap: Opening IMAP connection with `%s'..." cmd)
- (setq imap-client-eol "\n")
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (start-process
- name buffer shell-file-name shell-command-switch
- (format-spec
- cmd
- (format-spec-make
- ?s server
- ?g imap-shell-host
- ?p (number-to-string port)
- ?l imap-default-user)))))
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-max))
- (forward-line -1)
- (not (imap-parse-greeting)))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (erase-buffer)
- (when (memq (process-status process) '(open run))
- (setq done process)))))
- (if done
- (progn
- (message "imap: Opening IMAP connection with `%s'...done" cmd)
- done)
- (message "imap: Opening IMAP connection with `%s'...failed" cmd)
- nil)))
-
-(defun imap-starttls-p (buffer)
- (imap-capability 'STARTTLS buffer))
-
-(defun imap-starttls-open (name buffer server port)
- (let* ((port (or port imap-default-port))
- (coding-system-for-read imap-coding-system-for-read)
- (coding-system-for-write imap-coding-system-for-write)
- (process (starttls-open-stream name buffer server port))
- done tls-info)
- (message "imap: Connecting with STARTTLS...")
- (when process
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-max))
- (forward-line -1)
- (not (imap-parse-greeting)))
- (accept-process-output process 1)
- (sit-for 1))
- (imap-send-command "STARTTLS")
- (while (and (memq (process-status process) '(open run))
- (set-buffer buffer) ;; XXX "blue moon" nntp.el bug
- (goto-char (point-max))
- (forward-line -1)
- (not (re-search-forward "[0-9]+ OK.*\r?\n" nil t)))
- (accept-process-output process 1)
- (sit-for 1))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring buffer)))
- (when (and (setq tls-info (starttls-negotiate process))
- (memq (process-status process) '(open run)))
- (setq done process)))
- (if (stringp tls-info)
- (message "imap: STARTTLS info: %s" tls-info))
- (message "imap: Connecting with STARTTLS...%s" (if done "done" "failed"))
- done))
-
-;; Server functions; authenticator stuff:
-
-(defun imap-interactive-login (buffer loginfunc)
- "Login to server in BUFFER.
-LOGINFUNC is passed a username and a password, it should return t if
-it where successful authenticating itself to the server, nil otherwise.
-Returns t if login was successful, nil otherwise."
- (with-current-buffer buffer
- (make-local-variable 'imap-username)
- (make-local-variable 'imap-password)
- (let (user passwd ret)
- ;; (condition-case ()
- (while (or (not user) (not passwd))
- (setq user (or imap-username
- (read-from-minibuffer
- (concat "IMAP username for " imap-server
- " (using stream `" (symbol-name imap-stream)
- "'): ")
- (or user imap-default-user))))
- (setq passwd (or imap-password
- (read-passwd
- (concat "IMAP password for " user "@"
- imap-server " (using authenticator `"
- (symbol-name imap-auth) "'): "))))
- (when (and user passwd)
- (if (funcall loginfunc user passwd)
- (progn
- (setq ret t
- imap-username user)
- (when (and (not imap-password)
- (or imap-store-password
- (y-or-n-p "Store password for this session? ")))
- (setq imap-password passwd)))
- (message "Login failed...")
- (setq passwd nil)
- (setq imap-password nil)
- (sit-for 1))))
- ;; (quit (with-current-buffer buffer
- ;; (setq user nil
- ;; passwd nil)))
- ;; (error (with-current-buffer buffer
- ;; (setq user nil
- ;; passwd nil))))
- ret)))
-
-(defun imap-gssapi-auth-p (buffer)
- (eq imap-stream 'gssapi))
-
-(defun imap-gssapi-auth (buffer)
- (message "imap: Authenticating using GSSAPI...%s"
- (if (eq imap-stream 'gssapi) "done" "failed"))
- (eq imap-stream 'gssapi))
-
-(defun imap-kerberos4-auth-p (buffer)
- (and (imap-capability 'AUTH=KERBEROS_V4 buffer)
- (eq imap-stream 'kerberos4)))
-
-(defun imap-kerberos4-auth (buffer)
- (message "imap: Authenticating using Kerberos 4...%s"
- (if (eq imap-stream 'kerberos4) "done" "failed"))
- (eq imap-stream 'kerberos4))
-
-(defun imap-cram-md5-p (buffer)
- (imap-capability 'AUTH=CRAM-MD5 buffer))
-
-(defun imap-cram-md5-auth (buffer)
- "Login to server using the AUTH CRAM-MD5 method."
- (message "imap: Authenticating using CRAM-MD5...")
- (let ((done (imap-interactive-login
- buffer
- (lambda (user passwd)
- (imap-ok-p
- (imap-send-command-wait
- (list
- "AUTHENTICATE CRAM-MD5"
- (lambda (challenge)
- (let* ((decoded (base64-decode-string challenge))
- (hash (rfc2104-hash 'md5 64 16 passwd decoded))
- (response (concat user " " hash))
- (encoded (base64-encode-string response)))
- encoded)))))))))
- (if done
- (message "imap: Authenticating using CRAM-MD5...done")
- (message "imap: Authenticating using CRAM-MD5...failed"))))
-
-(defun imap-login-p (buffer)
- (and (not (imap-capability 'LOGINDISABLED buffer))
- (not (imap-capability 'X-LOGIN-CMD-DISABLED buffer))))
-
-(defun imap-login-auth (buffer)
- "Login to server using the LOGIN command."
- (message "imap: Plaintext authentication...")
- (imap-interactive-login buffer
- (lambda (user passwd)
- (imap-ok-p (imap-send-command-wait
- (concat "LOGIN \"" user "\" \""
- passwd "\""))))))
-
-(defun imap-anonymous-p (buffer)
- t)
-
-(defun imap-anonymous-auth (buffer)
- (message "imap: Logging in anonymously...")
- (with-current-buffer buffer
- (imap-ok-p (imap-send-command-wait
- (concat "LOGIN anonymous \"" (concat (user-login-name) "@"
- (system-name)) "\"")))))
-
-(defun imap-digest-md5-p (buffer)
- (and (imap-capability 'AUTH=DIGEST-MD5 buffer)
- (condition-case ()
- (require 'digest-md5)
- (error nil))))
-
-(defun imap-digest-md5-auth (buffer)
- "Login to server using the AUTH DIGEST-MD5 method."
- (message "imap: Authenticating using DIGEST-MD5...")
- (imap-interactive-login
- buffer
- (lambda (user passwd)
- (let ((tag
- (imap-send-command
- (list
- "AUTHENTICATE DIGEST-MD5"
- (lambda (challenge)
- (digest-md5-parse-digest-challenge
- (base64-decode-string challenge))
- (let* ((digest-uri
- (digest-md5-digest-uri
- "imap" (digest-md5-challenge 'realm)))
- (response
- (digest-md5-digest-response
- user passwd digest-uri)))
- (base64-encode-string response 'no-line-break))))
- )))
- (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- nil
- (setq imap-continuation nil)
- (imap-send-command-1 "")
- (imap-ok-p (imap-wait-for-tag tag)))))))
-
-;; Server functions:
-
-(defun imap-open-1 (buffer)
- (with-current-buffer buffer
- (erase-buffer)
- (setq imap-current-mailbox nil
- imap-current-message nil
- imap-state 'initial
- imap-process (condition-case ()
- (funcall (nth 2 (assq imap-stream
- imap-stream-alist))
- "imap" buffer imap-server imap-port)
- ((error quit) nil)))
- (when imap-process
- (set-process-filter imap-process 'imap-arrival-filter)
- (set-process-sentinel imap-process 'imap-sentinel)
- (while (and (eq imap-state 'initial)
- (memq (process-status imap-process) '(open run)))
- (message "Waiting for response from %s..." imap-server)
- (accept-process-output imap-process 1))
- (message "Waiting for response from %s...done" imap-server)
- (and (memq (process-status imap-process) '(open run))
- imap-process))))
-
-(defun imap-open (server &optional port stream auth buffer)
- "Open a IMAP connection to host SERVER at PORT returning a buffer.
-If PORT is unspecified, a default value is used (143 except
-for SSL which use 993).
-STREAM indicates the stream to use, see `imap-streams' for available
-streams. If nil, it choices the best stream the server is capable of.
-AUTH indicates authenticator to use, see `imap-authenticators' for
-available authenticators. If nil, it choices the best stream the
-server is capable of.
-BUFFER can be a buffer or a name of a buffer, which is created if
-necessary. If nil, the buffer name is generated."
- (setq buffer (or buffer (format " *imap* %s:%d" server (or port 0))))
- (with-current-buffer (get-buffer-create buffer)
- (if (imap-opened buffer)
- (imap-close buffer))
- (mapcar 'make-local-variable imap-local-variables)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (setq imap-server (or server imap-server))
- (setq imap-port (or port imap-port))
- (setq imap-auth (or auth imap-auth))
- (setq imap-stream (or stream imap-stream))
- (message "imap: Connecting to %s..." imap-server)
- (if (null (let ((imap-stream (or imap-stream imap-default-stream)))
- (imap-open-1 buffer)))
- (progn
- (message "imap: Connecting to %s...failed" imap-server)
- nil)
- (when (null imap-stream)
- ;; Need to choose stream.
- (let ((streams imap-streams))
- (while (setq stream (pop streams))
- ;; OK to use this stream?
- (when (funcall (nth 1 (assq stream imap-stream-alist)) buffer)
- ;; Stream changed?
- (if (not (eq imap-default-stream stream))
- (with-current-buffer (get-buffer-create
- (generate-new-buffer-name " *temp*"))
- (mapcar 'make-local-variable imap-local-variables)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (setq imap-server (or server imap-server))
- (setq imap-port (or port imap-port))
- (setq imap-auth (or auth imap-auth))
- (message "imap: Reconnecting with stream `%s'..." stream)
- (if (null (let ((imap-stream stream))
- (imap-open-1 (current-buffer))))
- (progn
- (kill-buffer (current-buffer))
- (message
- "imap: Reconnecting with stream `%s'...failed"
- stream))
- ;; We're done, kill the first connection
- (imap-close buffer)
- (let ((name (if (stringp buffer)
- buffer
- (buffer-name buffer))))
- (kill-buffer buffer)
- (rename-buffer name))
- (message "imap: Reconnecting with stream `%s'...done"
- stream)
- (setq imap-stream stream)
- (setq imap-capability nil)
- (setq streams nil)))
- ;; We're done
- (message "imap: Connecting to %s...done" imap-server)
- (setq imap-stream stream)
- (setq imap-capability nil)
- (setq streams nil))))))
- (when (imap-opened buffer)
- (setq imap-mailbox-data (make-vector imap-mailbox-prime 0)))
- (when imap-stream
- buffer))))
-
-(defun imap-opened (&optional buffer)
- "Return non-nil if connection to imap server in BUFFER is open.
-If BUFFER is nil then the current buffer is used."
- (and (setq buffer (get-buffer (or buffer (current-buffer))))
- (buffer-live-p buffer)
- (with-current-buffer buffer
- (and imap-process
- (memq (process-status imap-process) '(open run))))))
-
-(defun imap-authenticate (&optional user passwd buffer)
- "Authenticate to server in BUFFER, using current buffer if nil.
-It uses the authenticator specified when opening the server. If the
-authenticator requires username/passwords, they are queried from the
-user and optionally stored in the buffer. If USER and/or PASSWD is
-specified, the user will not be questioned and the username and/or
-password is remembered in the buffer."
- (with-current-buffer (or buffer (current-buffer))
- (if (not (eq imap-state 'nonauth))
- (or (eq imap-state 'auth)
- (eq imap-state 'select)
- (eq imap-state 'examine))
- (make-local-variable 'imap-username)
- (make-local-variable 'imap-password)
- (if user (setq imap-username user))
- (if passwd (setq imap-password passwd))
- (if imap-auth
- (and (funcall (nth 2 (assq imap-auth
- imap-authenticator-alist)) buffer)
- (setq imap-state 'auth))
- ;; Choose authenticator.
- (let ((auths imap-authenticators)
- auth)
- (while (setq auth (pop auths))
- ;; OK to use authenticator?
- (when (funcall (nth 1 (assq auth imap-authenticator-alist)) buffer)
- (message "imap: Authenticating to `%s' using `%s'..."
- imap-server auth)
- (setq imap-auth auth)
- (if (funcall (nth 2 (assq auth imap-authenticator-alist)) buffer)
- (progn
- (message "imap: Authenticating to `%s' using `%s'...done"
- imap-server auth)
- (setq auths nil))
- (message "imap: Authenticating to `%s' using `%s'...failed"
- imap-server auth)))))
- imap-state))))
-
-(defun imap-close (&optional buffer)
- "Close connection to server in BUFFER.
-If BUFFER is nil, the current buffer is used."
- (with-current-buffer (or buffer (current-buffer))
- (when (imap-opened)
- (condition-case nil
- (imap-send-command-wait "LOGOUT")
- (quit nil)))
- (when (and imap-process
- (memq (process-status imap-process) '(open run)))
- (delete-process imap-process))
- (setq imap-current-mailbox nil
- imap-current-message nil
- imap-process nil)
- (erase-buffer)
- t))
-
-(defun imap-capability (&optional identifier buffer)
- "Return a list of identifiers which server in BUFFER support.
-If IDENTIFIER, return non-nil if it's among the servers capabilities.
-If BUFFER is nil, the current buffer is assumed."
- (with-current-buffer (or buffer (current-buffer))
- (unless imap-capability
- (unless (imap-ok-p (imap-send-command-wait "CAPABILITY"))
- (setq imap-capability '(IMAP2))))
- (if identifier
- (memq (intern (upcase (symbol-name identifier))) imap-capability)
- imap-capability)))
-
-(defun imap-namespace (&optional buffer)
- "Return a namespace hierarchy at server in BUFFER.
-If BUFFER is nil, the current buffer is assumed."
- (with-current-buffer (or buffer (current-buffer))
- (unless imap-namespace
- (when (imap-capability 'NAMESPACE)
- (imap-send-command-wait "NAMESPACE")))
- imap-namespace))
-
-(defun imap-send-command-wait (command &optional buffer)
- (imap-wait-for-tag (imap-send-command command buffer) buffer))
-
-\f
-;; Mailbox functions:
-
-(defun imap-mailbox-put (propname value &optional mailbox buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if imap-mailbox-data
- (put (intern (or mailbox imap-current-mailbox) imap-mailbox-data)
- propname value)
- (error "Imap-mailbox-data is nil, prop %s value %s mailbox %s buffer %s"
- propname value mailbox (current-buffer)))
- t))
-
-(defsubst imap-mailbox-get-1 (propname &optional mailbox)
- (get (intern-soft (or mailbox imap-current-mailbox) imap-mailbox-data)
- propname))
-
-(defun imap-mailbox-get (propname &optional mailbox buffer)
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-get-1 propname (or mailbox imap-current-mailbox)))))
-
-(defun imap-mailbox-map-1 (func &optional mailbox-decoder buffer)
- (with-current-buffer (or buffer (current-buffer))
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (if mailbox-decoder
- (funcall mailbox-decoder (symbol-name s))
- (symbol-name s))) result))
- imap-mailbox-data)
- result)))
-
-(defun imap-mailbox-map (func &optional buffer)
- "Map a function across each mailbox in `imap-mailbox-data', returning a list.
-Function should take a mailbox name (a string) as
-the only argument."
- (imap-mailbox-map-1 func 'imap-utf7-decode buffer))
-
-(defun imap-current-mailbox (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-utf7-decode imap-current-mailbox)))
-
-(defun imap-current-mailbox-p-1 (mailbox &optional examine)
- (and (string= mailbox imap-current-mailbox)
- (or (and examine
- (eq imap-state 'examine))
- (and (not examine)
- (eq imap-state 'selected)))))
-
-(defun imap-current-mailbox-p (mailbox &optional examine buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-current-mailbox-p-1 (imap-utf7-encode mailbox) examine)))
-
-(defun imap-mailbox-select-1 (mailbox &optional examine)
- "Select MAILBOX on server in BUFFER.
-If EXAMINE is non-nil, do a read-only select."
- (if (imap-current-mailbox-p-1 mailbox examine)
- imap-current-mailbox
- (setq imap-current-mailbox mailbox)
- (if (imap-ok-p (imap-send-command-wait
- (concat (if examine "EXAMINE" "SELECT") " \""
- mailbox "\"")))
- (progn
- (setq imap-message-data (make-vector imap-message-prime 0)
- imap-state (if examine 'examine 'selected))
- imap-current-mailbox)
- ;; Failed SELECT/EXAMINE unselects current mailbox
- (setq imap-current-mailbox nil))))
-
-(defun imap-mailbox-select (mailbox &optional examine buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-utf7-decode
- (imap-mailbox-select-1 (imap-utf7-encode mailbox) examine))))
-
-(defun imap-mailbox-examine-1 (mailbox &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-select-1 mailbox 'examine)))
-
-(defun imap-mailbox-examine (mailbox &optional buffer)
- "Examine MAILBOX on server in BUFFER."
- (imap-mailbox-select mailbox 'examine buffer))
-
-(defun imap-mailbox-unselect (&optional buffer)
- "Close current folder in BUFFER, without expunging articles."
- (with-current-buffer (or buffer (current-buffer))
- (when (or (eq imap-state 'auth)
- (and (imap-capability 'UNSELECT)
- (imap-ok-p (imap-send-command-wait "UNSELECT")))
- (and (imap-ok-p
- (imap-send-command-wait (concat "EXAMINE \""
- imap-current-mailbox
- "\"")))
- (imap-ok-p (imap-send-command-wait "CLOSE"))))
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth)
- t)))
-
-(defun imap-mailbox-expunge (&optional asynch buffer)
- "Expunge articles in current folder in BUFFER.
-If ASYNCH, do not wait for succesful completion of the command.
-If BUFFER is nil the current buffer is assumed."
- (with-current-buffer (or buffer (current-buffer))
- (when (and imap-current-mailbox (not (eq imap-state 'examine)))
- (if asynch
- (imap-send-command "EXPUNGE")
- (imap-ok-p (imap-send-command-wait "EXPUNGE"))))))
-
-(defun imap-mailbox-close (&optional asynch buffer)
- "Expunge articles and close current folder in BUFFER.
-If ASYNCH, do not wait for succesful completion of the command.
-If BUFFER is nil the current buffer is assumed."
- (with-current-buffer (or buffer (current-buffer))
- (when imap-current-mailbox
- (if asynch
- (imap-add-callback (imap-send-command "CLOSE")
- `(lambda (tag status)
- (message "IMAP mailbox `%s' closed... %s"
- imap-current-mailbox status)
- (when (eq ,imap-current-mailbox
- imap-current-mailbox)
- ;; Don't wipe out data if another mailbox
- ;; was selected...
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth))))
- (when (imap-ok-p (imap-send-command-wait "CLOSE"))
- (setq imap-current-mailbox nil
- imap-message-data nil
- imap-state 'auth)))
- t)))
-
-(defun imap-mailbox-create-1 (mailbox)
- (imap-ok-p (imap-send-command-wait (list "CREATE \"" mailbox "\""))))
-
-(defun imap-mailbox-create (mailbox &optional buffer)
- "Create MAILBOX on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
- (with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-create-1 (imap-utf7-encode mailbox))))
-
-(defun imap-mailbox-delete (mailbox &optional buffer)
- "Delete MAILBOX on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p
- (imap-send-command-wait (list "DELETE \"" mailbox "\""))))))
-
-(defun imap-mailbox-rename (oldname newname &optional buffer)
- "Rename mailbox OLDNAME to NEWNAME on server in BUFFER.
-If BUFFER is nil the current buffer is assumed."
- (let ((oldname (imap-utf7-encode oldname))
- (newname (imap-utf7-encode newname)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p
- (imap-send-command-wait (list "RENAME \"" oldname "\" "
- "\"" newname "\""))))))
-
-(defun imap-mailbox-lsub (&optional root reference add-delimiter buffer)
- "Return a list of subscribed mailboxes on server in BUFFER.
-If ROOT is non-nil, only list matching mailboxes. If ADD-DELIMITER is
-non-nil, a hierarchy delimiter is added to root. REFERENCE is a
-implementation-specific string that has to be passed to lsub command."
- (with-current-buffer (or buffer (current-buffer))
- ;; Make sure we know the hierarchy separator for root's hierarchy
- (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
- (imap-send-command-wait (concat "LIST \"" reference "\" \""
- (imap-utf7-encode root) "\"")))
- ;; clear list data (NB not delimiter and other stuff)
- (imap-mailbox-map-1 (lambda (mailbox)
- (imap-mailbox-put 'lsub nil mailbox)))
- (when (imap-ok-p
- (imap-send-command-wait
- (concat "LSUB \"" reference "\" \"" (imap-utf7-encode root)
- (and add-delimiter (imap-mailbox-get-1 'delimiter root))
- "%\"")))
- (let (out)
- (imap-mailbox-map-1 (lambda (mailbox)
- (when (imap-mailbox-get-1 'lsub mailbox)
- (push (imap-utf7-decode mailbox) out))))
- (nreverse out)))))
-
-(defun imap-mailbox-list (root &optional reference add-delimiter buffer)
- "Return a list of mailboxes matching ROOT on server in BUFFER.
-If ADD-DELIMITER is non-nil, a hierarchy delimiter is added to
-root. REFERENCE is a implementation-specific string that has to be
-passed to list command."
- (with-current-buffer (or buffer (current-buffer))
- ;; Make sure we know the hierarchy separator for root's hierarchy
- (when (and add-delimiter (null (imap-mailbox-get-1 'delimiter root)))
- (imap-send-command-wait (concat "LIST \"" reference "\" \""
- (imap-utf7-encode root) "\"")))
- ;; clear list data (NB not delimiter and other stuff)
- (imap-mailbox-map-1 (lambda (mailbox)
- (imap-mailbox-put 'list nil mailbox)))
- (when (imap-ok-p
- (imap-send-command-wait
- (concat "LIST \"" reference "\" \"" (imap-utf7-encode root)
- (and add-delimiter (imap-mailbox-get-1 'delimiter root))
- "%\"")))
- (let (out)
- (imap-mailbox-map-1 (lambda (mailbox)
- (when (imap-mailbox-get-1 'list mailbox)
- (push (imap-utf7-decode mailbox) out))))
- (nreverse out)))))
-
-(defun imap-mailbox-subscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
-Returns non-nil if successful."
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "SUBSCRIBE \""
- (imap-utf7-encode mailbox)
- "\"")))))
-
-(defun imap-mailbox-unsubscribe (mailbox &optional buffer)
- "Send the SUBSCRIBE command on the mailbox to server in BUFFER.
-Returns non-nil if successful."
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait (concat "UNSUBSCRIBE "
- (imap-utf7-encode mailbox)
- "\"")))))
-
-(defun imap-mailbox-status (mailbox items &optional buffer)
- "Get status items ITEM in MAILBOX from server in BUFFER.
-ITEMS can be a symbol or a list of symbols, valid symbols are one of
-the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
-or 'unseen. If ITEMS is a list of symbols, a list of values is
-returned, if ITEMS is a symbol only its value is returned."
- (with-current-buffer (or buffer (current-buffer))
- (when (imap-ok-p
- (imap-send-command-wait (list "STATUS \""
- (imap-utf7-encode mailbox)
- "\" "
- (upcase
- (format "%s"
- (if (listp items)
- items
- (list items)))))))
- (if (listp items)
- (mapcar (lambda (item)
- (imap-mailbox-get item mailbox))
- items)
- (imap-mailbox-get items mailbox)))))
-
-(defun imap-mailbox-status-asynch (mailbox items &optional buffer)
- "Send status item request ITEM on MAILBOX to server in BUFFER.
-ITEMS can be a symbol or a list of symbols, valid symbols are one of
-the STATUS data items -- ie 'messages, 'recent, 'uidnext, 'uidvalidity
-or 'unseen. The IMAP command tag is returned."
- (with-current-buffer (or buffer (current-buffer))
- (imap-send-command (list "STATUS \""
- (imap-utf7-encode mailbox)
- "\" "
- (format "%s"
- (if (listp items)
- items
- (list items)))))))
-
-(defun imap-mailbox-acl-get (&optional mailbox buffer)
- "Get ACL on mailbox from server in BUFFER."
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (when (imap-ok-p
- (imap-send-command-wait (list "GETACL \""
- (or mailbox imap-current-mailbox)
- "\"")))
- (imap-mailbox-get-1 'acl (or mailbox imap-current-mailbox))))))
-
-(defun imap-mailbox-acl-set (identifier rights &optional mailbox buffer)
- "Change/set ACL for IDENTIFIER to RIGHTS in MAILBOX from server in BUFFER."
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p
- (imap-send-command-wait (list "SETACL \""
- (or mailbox imap-current-mailbox)
- "\" "
- identifier
- " "
- rights))))))
-
-(defun imap-mailbox-acl-delete (identifier &optional mailbox buffer)
- "Removes any <identifier,rights> pair for IDENTIFIER in MAILBOX from server in BUFFER."
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p
- (imap-send-command-wait (list "DELETEACL \""
- (or mailbox imap-current-mailbox)
- "\" "
- identifier))))))
-
-\f
-;; Message functions:
-
-(defun imap-current-message (&optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- imap-current-message))
-
-(defun imap-list-to-message-set (list)
- (mapconcat (lambda (item)
- (number-to-string item))
- (if (listp list)
- list
- (list list))
- ","))
-
-(defun imap-range-to-message-set (range)
- (mapconcat
- (lambda (item)
- (if (consp item)
- (format "%d:%d"
- (car item) (cdr item))
- (format "%d" item)))
- (if (and (listp range) (not (listp (cdr range))))
- (list range) ;; make (1 . 2) into ((1 . 2))
- range)
- ","))
-
-(defun imap-fetch-asynch (uids props &optional nouidfetch buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-send-command (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
- (if (listp uids)
- (imap-list-to-message-set uids)
- uids)
- props))))
-
-(defun imap-fetch (uids props &optional receive nouidfetch buffer)
- "Fetch properties PROPS from message set UIDS from server in BUFFER.
-UIDS can be a string, number or a list of numbers. If RECEIVE
-is non-nil return these properties."
- (with-current-buffer (or buffer (current-buffer))
- (when (imap-ok-p (imap-send-command-wait
- (format "%sFETCH %s %s" (if nouidfetch "" "UID ")
- (if (listp uids)
- (imap-list-to-message-set uids)
- uids)
- props)))
- (if (or (null receive) (stringp uids))
- t
- (if (listp uids)
- (mapcar (lambda (uid)
- (if (listp receive)
- (mapcar (lambda (prop)
- (imap-message-get uid prop))
- receive)
- (imap-message-get uid receive)))
- uids)
- (imap-message-get uids receive))))))
-
-(defun imap-message-put (uid propname value &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if imap-message-data
- (put (intern (number-to-string uid) imap-message-data)
- propname value)
- (error "Imap-message-data is nil, uid %s prop %s value %s buffer %s"
- uid propname value (current-buffer)))
- t))
-
-(defun imap-message-get (uid propname &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (get (intern-soft (number-to-string uid) imap-message-data)
- propname)))
-
-(defun imap-message-map (func propname &optional buffer)
- "Map a function across each mailbox in `imap-message-data', returning a list."
- (with-current-buffer (or buffer (current-buffer))
- (let (result)
- (mapatoms
- (lambda (s)
- (push (funcall func (get s 'UID) (get s propname)) result))
- imap-message-data)
- result)))
-
-(defmacro imap-message-envelope-date (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 0)))
-
-(defmacro imap-message-envelope-subject (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 1)))
-
-(defmacro imap-message-envelope-from (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 2)))
-
-(defmacro imap-message-envelope-sender (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 3)))
-
-(defmacro imap-message-envelope-reply-to (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 4)))
-
-(defmacro imap-message-envelope-to (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 5)))
-
-(defmacro imap-message-envelope-cc (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 6)))
-
-(defmacro imap-message-envelope-bcc (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 7)))
-
-(defmacro imap-message-envelope-in-reply-to (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 8)))
-
-(defmacro imap-message-envelope-message-id (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (elt (imap-message-get ,uid 'ENVELOPE) 9)))
-
-(defmacro imap-message-body (uid &optional buffer)
- `(with-current-buffer (or ,buffer (current-buffer))
- (imap-message-get ,uid 'BODY)))
-
-(defun imap-search (predicate &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-mailbox-put 'search 'dummy)
- (when (imap-ok-p (imap-send-command-wait (concat "UID SEARCH " predicate)))
- (if (eq (imap-mailbox-get-1 'search imap-current-mailbox) 'dummy)
- (progn
- (message "Missing SEARCH response to a SEARCH command (server not RFC compliant)...")
- nil)
- (imap-mailbox-get-1 'search imap-current-mailbox)))))
-
-(defun imap-message-flag-permanent-p (flag &optional mailbox buffer)
- "Return t if FLAG can be permanently (between IMAP sessions) saved on articles, in MAILBOX on server in BUFFER."
- (with-current-buffer (or buffer (current-buffer))
- (or (member "\\*" (imap-mailbox-get 'permanentflags mailbox))
- (member flag (imap-mailbox-get 'permanentflags mailbox)))))
-
-(defun imap-message-flags-set (articles flags &optional silent buffer)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-flags-del (articles flags &optional silent buffer)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " -FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-flags-add (articles flags &optional silent buffer)
- (when (and articles flags)
- (with-current-buffer (or buffer (current-buffer))
- (imap-ok-p (imap-send-command-wait
- (concat "UID STORE " articles
- " +FLAGS" (if silent ".SILENT") " (" flags ")"))))))
-
-(defun imap-message-copyuid-1 (mailbox)
- (if (imap-capability 'UIDPLUS)
- (list (nth 0 (imap-mailbox-get-1 'copyuid mailbox))
- (string-to-number (nth 2 (imap-mailbox-get-1 'copyuid mailbox))))
- (let ((old-mailbox imap-current-mailbox)
- (state imap-state)
- (imap-message-data (make-vector 2 0)))
- (when (imap-mailbox-examine-1 mailbox)
- (prog1
- (and (imap-fetch "*" "UID")
- (list (imap-mailbox-get-1 'uidvalidity mailbox)
- (apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
- (if old-mailbox
- (imap-mailbox-select old-mailbox (eq state 'examine))
- (imap-mailbox-unselect)))))))
-
-(defun imap-message-copyuid (mailbox &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-message-copyuid-1 (imap-utf7-decode mailbox))))
-
-(defun imap-message-copy (articles mailbox
- &optional dont-create no-copyuid buffer)
- "Copy ARTICLES (a string message set) to MAILBOX on server in
-BUFFER, creating mailbox if it doesn't exist. If dont-create is
-non-nil, it will not create a mailbox. On success, return a list with
-the UIDVALIDITY of the mailbox the article(s) was copied to as the
-first element, rest of list contain the saved articles' UIDs."
- (when articles
- (with-current-buffer (or buffer (current-buffer))
- (let ((mailbox (imap-utf7-encode mailbox)))
- (if (let ((cmd (concat "UID COPY " articles " \"" mailbox "\""))
- (imap-current-target-mailbox mailbox))
- (if (imap-ok-p (imap-send-command-wait cmd))
- t
- (when (and (not dont-create)
- ;; removed because of buggy Oracle server
- ;; that doesn't send TRYCREATE tags (which
- ;; is a MUST according to specifications):
- ;;(imap-mailbox-get-1 'trycreate mailbox)
- (imap-mailbox-create-1 mailbox))
- (imap-ok-p (imap-send-command-wait cmd)))))
- (or no-copyuid
- (imap-message-copyuid-1 mailbox)))))))
-
-(defun imap-message-appenduid-1 (mailbox)
- (if (imap-capability 'UIDPLUS)
- (imap-mailbox-get-1 'appenduid mailbox)
- (let ((old-mailbox imap-current-mailbox)
- (state imap-state)
- (imap-message-data (make-vector 2 0)))
- (when (imap-mailbox-examine-1 mailbox)
- (prog1
- (and (imap-fetch "*" "UID")
- (list (imap-mailbox-get-1 'uidvalidity mailbox)
- (apply 'max (imap-message-map
- (lambda (uid prop) uid) 'UID))))
- (if old-mailbox
- (imap-mailbox-select old-mailbox (eq state 'examine))
- (imap-mailbox-unselect)))))))
-
-(defun imap-message-appenduid (mailbox &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (imap-message-appenduid-1 (imap-utf7-encode mailbox))))
-
-(defun imap-message-append (mailbox article &optional flags date-time buffer)
- "Append ARTICLE (a buffer) to MAILBOX on server in BUFFER.
-FLAGS and DATE-TIME is currently not used. Return a cons holding
-uidvalidity of MAILBOX and UID the newly created article got, or nil
-on failure."
- (let ((mailbox (imap-utf7-encode mailbox)))
- (with-current-buffer (or buffer (current-buffer))
- (and (let ((imap-current-target-mailbox mailbox))
- (imap-ok-p
- (imap-send-command-wait
- (list "APPEND \"" mailbox "\" " article))))
- (imap-message-appenduid-1 mailbox)))))
-
-(defun imap-body-lines (body)
- "Return number of lines in article by looking at the mime bodystructure BODY."
- (if (listp body)
- (if (stringp (car body))
- (cond ((and (string= (upcase (car body)) "TEXT")
- (numberp (nth 7 body)))
- (nth 7 body))
- ((and (string= (upcase (car body)) "MESSAGE")
- (numberp (nth 9 body)))
- (nth 9 body))
- (t 0))
- (apply '+ (mapcar 'imap-body-lines body)))
- 0))
-
-(defun imap-envelope-from (from)
- "Return a from string line."
- (and from
- (concat (aref from 0)
- (if (aref from 0) " <")
- (aref from 2)
- "@"
- (aref from 3)
- (if (aref from 0) ">"))))
-
-\f
-;; Internal functions.
-
-(defun imap-add-callback (tag func)
- (setq imap-callbacks (append (list (cons tag func)) imap-callbacks)))
-
-(defun imap-send-command-1 (cmdstr)
- (setq cmdstr (concat cmdstr imap-client-eol))
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert cmdstr)))
- (process-send-string imap-process cmdstr))
-
-(defun imap-send-command (command &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (if (not (listp command)) (setq command (list command)))
- (let ((tag (setq imap-tag (1+ imap-tag)))
- cmd cmdstr)
- (setq cmdstr (concat (number-to-string imap-tag) " "))
- (while (setq cmd (pop command))
- (cond ((stringp cmd)
- (setq cmdstr (concat cmdstr cmd)))
- ((bufferp cmd)
- (let ((eol imap-client-eol)
- (calcfirst imap-calculate-literal-size-first)
- size)
- (with-current-buffer cmd
- (if calcfirst
- (setq size (buffer-size)))
- (when (not (equal eol "\r\n"))
- ;; XXX modifies buffer!
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match eol)))
- (if (not calcfirst)
- (setq size (buffer-size))))
- (setq cmdstr
- (concat cmdstr (format "{%d}" size))))
- (unwind-protect
- (progn
- (imap-send-command-1 cmdstr)
- (setq cmdstr nil)
- (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil) ;; abort command if no cont-req
- (let ((process imap-process)
- (stream imap-stream)
- (eol imap-client-eol))
- (with-current-buffer cmd
- (and imap-log
- (with-current-buffer (get-buffer-create
- imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert-buffer-substring cmd)))
- (process-send-region process (point-min)
- (point-max)))
- (process-send-string process imap-client-eol))))
- (setq imap-continuation nil)))
- ((functionp cmd)
- (imap-send-command-1 cmdstr)
- (setq cmdstr nil)
- (unwind-protect
- (if (not (eq (imap-wait-for-tag tag) 'INCOMPLETE))
- (setq command nil) ;; abort command if no cont-req
- (setq command (cons (funcall cmd imap-continuation)
- command)))
- (setq imap-continuation nil)))
- (t
- (error "Unknown command type"))))
- (if cmdstr
- (imap-send-command-1 cmdstr))
- tag)))
-
-(defun imap-wait-for-tag (tag &optional buffer)
- (with-current-buffer (or buffer (current-buffer))
- (let (imap-have-messaged)
- (while (and (null imap-continuation)
- (memq (process-status imap-process) '(open run))
- (< imap-reached-tag tag))
- (let ((len (/ (point-max) 1024))
- message-log-max)
- (unless (< len 10)
- (setq imap-have-messaged t)
- (message "imap read: %dk" len))
- (accept-process-output imap-process
- (truncate imap-read-timeout)
- (truncate (* (- imap-read-timeout
- (truncate imap-read-timeout))
- 1000)))))
- ;; A process can die _before_ we have processed everything it
- ;; has to say. Moreover, this can happen in between the call to
- ;; accept-process-output and the call to process-status in an
- ;; iteration of the loop above.
- (when (and (null imap-continuation)
- (< imap-reached-tag tag))
- (accept-process-output imap-process 0 0))
- (when imap-have-messaged
- (message ""))
- (and (memq (process-status imap-process) '(open run))
- (or (assq tag imap-failed-tags)
- (if imap-continuation
- 'INCOMPLETE
- 'OK))))))
-
-(defun imap-sentinel (process string)
- (delete-process process))
-
-(defun imap-find-next-line ()
- "Return point at end of current line, taking into account literals.
-Return nil if no complete line has arrived."
- (when (re-search-forward (concat imap-server-eol "\\|{\\([0-9]+\\)}"
- imap-server-eol)
- nil t)
- (if (match-string 1)
- (if (< (point-max) (+ (point) (string-to-number (match-string 1))))
- nil
- (goto-char (+ (point) (string-to-number (match-string 1))))
- (imap-find-next-line))
- (point))))
-
-(defun imap-arrival-filter (proc string)
- "IMAP process filter."
- ;; Sometimes, we are called even though the process has died.
- ;; Better abstain from doing stuff in that case.
- (when (buffer-name (process-buffer proc))
- (with-current-buffer (process-buffer proc)
- (goto-char (point-max))
- (insert string)
- (and imap-log
- (with-current-buffer (get-buffer-create imap-log-buffer)
- (imap-disable-multibyte)
- (buffer-disable-undo)
- (goto-char (point-max))
- (insert string)))
- (let (end)
- (goto-char (point-min))
- (while (setq end (imap-find-next-line))
- (save-restriction
- (narrow-to-region (point-min) end)
- (delete-backward-char (length imap-server-eol))
- (goto-char (point-min))
- (unwind-protect
- (cond ((eq imap-state 'initial)
- (imap-parse-greeting))
- ((or (eq imap-state 'auth)
- (eq imap-state 'nonauth)
- (eq imap-state 'selected)
- (eq imap-state 'examine))
- (imap-parse-response))
- (t
- (message "Unknown state %s in arrival filter"
- imap-state)))
- (delete-region (point-min) (point-max)))))))))
-
-\f
-;; Imap parser.
-
-(defsubst imap-forward ()
- (or (eobp) (forward-char)))
-
-;; number = 1*DIGIT
-;; ; Unsigned 32-bit integer
-;; ; (0 <= n < 4,294,967,296)
-
-(defsubst imap-parse-number ()
- (when (looking-at "[0-9]+")
- (prog1
- (string-to-number (match-string 0))
- (goto-char (match-end 0)))))
-
-;; literal = "{" number "}" CRLF *CHAR8
-;; ; Number represents the number of CHAR8s
-
-(defsubst imap-parse-literal ()
- (when (looking-at "{\\([0-9]+\\)}\r\n")
- (let ((pos (match-end 0))
- (len (string-to-number (match-string 1))))
- (if (< (point-max) (+ pos len))
- nil
- (goto-char (+ pos len))
- (buffer-substring pos (+ pos len))))))
-
-;; string = quoted / literal
-;;
-;; quoted = DQUOTE *QUOTED-CHAR DQUOTE
-;;
-;; QUOTED-CHAR = <any TEXT-CHAR except quoted-specials> /
-;; "\" quoted-specials
-;;
-;; quoted-specials = DQUOTE / "\"
-;;
-;; TEXT-CHAR = <any CHAR except CR and LF>
-
-(defsubst imap-parse-string ()
- (cond ((eq (char-after) ?\")
- (forward-char 1)
- (let ((p (point)) (name ""))
- (skip-chars-forward "^\"\\\\")
- (setq name (buffer-substring p (point)))
- (while (eq (char-after) ?\\)
- (setq p (1+ (point)))
- (forward-char 2)
- (skip-chars-forward "^\"\\\\")
- (setq name (concat name (buffer-substring p (point)))))
- (forward-char 1)
- name))
- ((eq (char-after) ?{)
- (imap-parse-literal))))
-
-;; nil = "NIL"
-
-(defsubst imap-parse-nil ()
- (if (looking-at "NIL")
- (goto-char (match-end 0))))
-
-;; nstring = string / nil
-
-(defsubst imap-parse-nstring ()
- (or (imap-parse-string)
- (and (imap-parse-nil)
- nil)))
-
-;; astring = atom / string
-;;
-;; atom = 1*ATOM-CHAR
-;;
-;; ATOM-CHAR = <any CHAR except atom-specials>
-;;
-;; atom-specials = "(" / ")" / "{" / SP / CTL / list-wildcards /
-;; quoted-specials
-;;
-;; list-wildcards = "%" / "*"
-;;
-;; quoted-specials = DQUOTE / "\"
-
-(defsubst imap-parse-astring ()
- (or (imap-parse-string)
- (buffer-substring (point)
- (if (re-search-forward "[(){ \r\n%*\"\\]" nil t)
- (goto-char (1- (match-end 0)))
- (end-of-line)
- (point)))))
-
-;; address = "(" addr-name SP addr-adl SP addr-mailbox SP
-;; addr-host ")"
-;;
-;; addr-adl = nstring
-;; ; Holds route from [RFC-822] route-addr if
-;; ; non-nil
-;;
-;; addr-host = nstring
-;; ; nil indicates [RFC-822] group syntax.
-;; ; Otherwise, holds [RFC-822] domain name
-;;
-;; addr-mailbox = nstring
-;; ; nil indicates end of [RFC-822] group; if
-;; ; non-nil and addr-host is nil, holds
-;; ; [RFC-822] group name.
-;; ; Otherwise, holds [RFC-822] local-part
-;; ; after removing [RFC-822] quoting
-;;
-;; addr-name = nstring
-;; ; If non-nil, holds phrase from [RFC-822]
-;; ; mailbox after removing [RFC-822] quoting
-;;
-
-(defsubst imap-parse-address ()
- (let (address)
- (when (eq (char-after) ?\()
- (imap-forward)
- (setq address (vector (prog1 (imap-parse-nstring)
- (imap-forward))
- (prog1 (imap-parse-nstring)
- (imap-forward))
- (prog1 (imap-parse-nstring)
- (imap-forward))
- (imap-parse-nstring)))
- (when (eq (char-after) ?\))
- (imap-forward)
- address))))
-
-;; address-list = "(" 1*address ")" / nil
-;;
-;; nil = "NIL"
-
-(defsubst imap-parse-address-list ()
- (if (eq (char-after) ?\()
- (let (address addresses)
- (imap-forward)
- (while (and (not (eq (char-after) ?\)))
- ;; next line for MS Exchange bug
- (progn (and (eq (char-after) ? ) (imap-forward)) t)
- (setq address (imap-parse-address)))
- (setq addresses (cons address addresses)))
- (when (eq (char-after) ?\))
- (imap-forward)
- (nreverse addresses)))
- ;; With assert, the code might not be eval'd.
- ;; (assert (imap-parse-nil) t "In imap-parse-address-list")
- (imap-parse-nil)))
-
-;; mailbox = "INBOX" / astring
-;; ; INBOX is case-insensitive. All case variants of
-;; ; INBOX (e.g. "iNbOx") MUST be interpreted as INBOX
-;; ; not as an astring. An astring which consists of
-;; ; the case-insensitive sequence "I" "N" "B" "O" "X"
-;; ; is considered to be INBOX and not an astring.
-;; ; Refer to section 5.1 for further
-;; ; semantic details of mailbox names.
-
-(defsubst imap-parse-mailbox ()
- (let ((mailbox (imap-parse-astring)))
- (if (string-equal "INBOX" (upcase mailbox))
- "INBOX"
- mailbox)))
-
-;; greeting = "*" SP (resp-cond-auth / resp-cond-bye) CRLF
-;;
-;; resp-cond-auth = ("OK" / "PREAUTH") SP resp-text
-;; ; Authentication condition
-;;
-;; resp-cond-bye = "BYE" SP resp-text
-
-(defun imap-parse-greeting ()
- "Parse a IMAP greeting."
- (cond ((looking-at "\\* OK ")
- (setq imap-state 'nonauth))
- ((looking-at "\\* PREAUTH ")
- (setq imap-state 'auth))
- ((looking-at "\\* BYE ")
- (setq imap-state 'closed))))
-
-;; response = *(continue-req / response-data) response-done
-;;
-;; continue-req = "+" SP (resp-text / base64) CRLF
-;;
-;; response-data = "*" SP (resp-cond-state / resp-cond-bye /
-;; mailbox-data / message-data / capability-data) CRLF
-;;
-;; response-done = response-tagged / response-fatal
-;;
-;; response-fatal = "*" SP resp-cond-bye CRLF
-;; ; Server closes connection immediately
-;;
-;; response-tagged = tag SP resp-cond-state CRLF
-;;
-;; resp-cond-state = ("OK" / "NO" / "BAD") SP resp-text
-;; ; Status condition
-;;
-;; resp-cond-bye = "BYE" SP resp-text
-;;
-;; mailbox-data = "FLAGS" SP flag-list /
-;; "LIST" SP mailbox-list /
-;; "LSUB" SP mailbox-list /
-;; "SEARCH" *(SP nz-number) /
-;; "STATUS" SP mailbox SP "("
-;; [status-att SP number *(SP status-att SP number)] ")" /
-;; number SP "EXISTS" /
-;; number SP "RECENT"
-;;
-;; message-data = nz-number SP ("EXPUNGE" / ("FETCH" SP msg-att))
-;;
-;; capability-data = "CAPABILITY" *(SP capability) SP "IMAP4rev1"
-;; *(SP capability)
-;; ; IMAP4rev1 servers which offer RFC 1730
-;; ; compatibility MUST list "IMAP4" as the first
-;; ; capability.
-
-(defun imap-parse-response ()
- "Parse a IMAP command response."
- (let (token)
- (case (setq token (read (current-buffer)))
- (+ (setq imap-continuation
- (or (buffer-substring (min (point-max) (1+ (point)))
- (point-max))
- t)))
- (* (case (prog1 (setq token (read (current-buffer)))
- (imap-forward))
- (OK (imap-parse-resp-text))
- (NO (imap-parse-resp-text))
- (BAD (imap-parse-resp-text))
- (BYE (imap-parse-resp-text))
- (FLAGS (imap-mailbox-put 'flags (imap-parse-flag-list)))
- (LIST (imap-parse-data-list 'list))
- (LSUB (imap-parse-data-list 'lsub))
- (SEARCH (imap-mailbox-put
- 'search
- (read (concat "(" (buffer-substring (point) (point-max)) ")"))))
- (STATUS (imap-parse-status))
- (CAPABILITY (setq imap-capability
- (read (concat "(" (upcase (buffer-substring
- (point) (point-max)))
- ")"))))
- (ACL (imap-parse-acl))
- (t (case (prog1 (read (current-buffer))
- (imap-forward))
- (EXISTS (imap-mailbox-put 'exists token))
- (RECENT (imap-mailbox-put 'recent token))
- (EXPUNGE t)
- (FETCH (imap-parse-fetch token))
- (t (message "Garbage: %s" (buffer-string)))))))
- (t (let (status)
- (if (not (integerp token))
- (message "Garbage: %s" (buffer-string))
- (case (prog1 (setq status (read (current-buffer)))
- (imap-forward))
- (OK (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (imap-parse-resp-text)))
- (NO (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (save-excursion
- (imap-parse-resp-text))
- (let (code text)
- (when (eq (char-after) ?\[)
- (setq code (buffer-substring (point)
- (search-forward "]")))
- (imap-forward))
- (setq text (buffer-substring (point) (point-max)))
- (push (list token status code text)
- imap-failed-tags))))
- (BAD (progn
- (setq imap-reached-tag (max imap-reached-tag token))
- (save-excursion
- (imap-parse-resp-text))
- (let (code text)
- (when (eq (char-after) ?\[)
- (setq code (buffer-substring (point)
- (search-forward "]")))
- (imap-forward))
- (setq text (buffer-substring (point) (point-max)))
- (push (list token status code text) imap-failed-tags)
- (error "Internal error, tag %s status %s code %s text %s"
- token status code text))))
- (t (message "Garbage: %s" (buffer-string))))
- (when (assq token imap-callbacks)
- (funcall (cdr (assq token imap-callbacks)) token status)
- (setq imap-callbacks
- (imap-remassoc token imap-callbacks)))))))))
-
-;; resp-text = ["[" resp-text-code "]" SP] text
-;;
-;; text = 1*TEXT-CHAR
-;;
-;; TEXT-CHAR = <any CHAR except CR and LF>
-
-(defun imap-parse-resp-text ()
- (imap-parse-resp-text-code))
-
-;; resp-text-code = "ALERT" /
-;; "BADCHARSET [SP "(" astring *(SP astring) ")" ] /
-;; "NEWNAME" SP string SP string /
-;; "PARSE" /
-;; "PERMANENTFLAGS" SP "("
-;; [flag-perm *(SP flag-perm)] ")" /
-;; "READ-ONLY" /
-;; "READ-WRITE" /
-;; "TRYCREATE" /
-;; "UIDNEXT" SP nz-number /
-;; "UIDVALIDITY" SP nz-number /
-;; "UNSEEN" SP nz-number /
-;; resp-text-atom [SP 1*<any TEXT-CHAR except "]">]
-;;
-;; resp_code_apnd = "APPENDUID" SPACE nz_number SPACE uniqueid
-;;
-;; resp_code_copy = "COPYUID" SPACE nz_number SPACE set SPACE set
-;;
-;; set = sequence-num / (sequence-num ":" sequence-num) /
-;; (set "," set)
-;; ; Identifies a set of messages. For message
-;; ; sequence numbers, these are consecutive
-;; ; numbers from 1 to the number of messages in
-;; ; the mailbox
-;; ; Comma delimits individual numbers, colon
-;; ; delimits between two numbers inclusive.
-;; ; Example: 2,4:7,9,12:* is 2,4,5,6,7,9,12,13,
-;; ; 14,15 for a mailbox with 15 messages.
-;;
-;; sequence-num = nz-number / "*"
-;; ; * is the largest number in use. For message
-;; ; sequence numbers, it is the number of messages
-;; ; in the mailbox. For unique identifiers, it is
-;; ; the unique identifier of the last message in
-;; ; the mailbox.
-;;
-;; flag-perm = flag / "\*"
-;;
-;; flag = "\Answered" / "\Flagged" / "\Deleted" /
-;; "\Seen" / "\Draft" / flag-keyword / flag-extension
-;; ; Does not include "\Recent"
-;;
-;; flag-extension = "\" atom
-;; ; Future expansion. Client implementations
-;; ; MUST accept flag-extension flags. Server
-;; ; implementations MUST NOT generate
-;; ; flag-extension flags except as defined by
-;; ; future standard or standards-track
-;; ; revisions of this specification.
-;;
-;; flag-keyword = atom
-;;
-;; resp-text-atom = 1*<any ATOM-CHAR except "]">
-
-(defun imap-parse-resp-text-code ()
- ;; xxx next line for stalker communigate pro 3.3.1 bug
- (when (looking-at " \\[")
- (imap-forward))
- (when (eq (char-after) ?\[)
- (imap-forward)
- (cond ((search-forward "PERMANENTFLAGS " nil t)
- (imap-mailbox-put 'permanentflags (imap-parse-flag-list)))
- ((search-forward "UIDNEXT \\([0-9]+\\)" nil t)
- (imap-mailbox-put 'uidnext (match-string 1)))
- ((search-forward "UNSEEN " nil t)
- (imap-mailbox-put 'first-unseen (read (current-buffer))))
- ((looking-at "UIDVALIDITY \\([0-9]+\\)")
- (imap-mailbox-put 'uidvalidity (match-string 1)))
- ((search-forward "READ-ONLY" nil t)
- (imap-mailbox-put 'read-only t))
- ((search-forward "NEWNAME " nil t)
- (let (oldname newname)
- (setq oldname (imap-parse-string))
- (imap-forward)
- (setq newname (imap-parse-string))
- (imap-mailbox-put 'newname newname oldname)))
- ((search-forward "TRYCREATE" nil t)
- (imap-mailbox-put 'trycreate t imap-current-target-mailbox))
- ((looking-at "APPENDUID \\([0-9]+\\) \\([0-9]+\\)")
- (imap-mailbox-put 'appenduid
- (list (match-string 1)
- (string-to-number (match-string 2)))
- imap-current-target-mailbox))
- ((looking-at "COPYUID \\([0-9]+\\) \\([0-9,:]+\\) \\([0-9,:]+\\)")
- (imap-mailbox-put 'copyuid (list (match-string 1)
- (match-string 2)
- (match-string 3))
- imap-current-target-mailbox))
- ((search-forward "ALERT] " nil t)
- (message "Imap server %s information: %s" imap-server
- (buffer-substring (point) (point-max)))))))
-
-;; mailbox-list = "(" [mbx-list-flags] ")" SP
-;; (DQUOTE QUOTED-CHAR DQUOTE / nil) SP mailbox
-;;
-;; mbx-list-flags = *(mbx-list-oflag SP) mbx-list-sflag
-;; *(SP mbx-list-oflag) /
-;; mbx-list-oflag *(SP mbx-list-oflag)
-;;
-;; mbx-list-oflag = "\Noinferiors" / flag-extension
-;; ; Other flags; multiple possible per LIST response
-;;
-;; mbx-list-sflag = "\Noselect" / "\Marked" / "\Unmarked"
-;; ; Selectability flags; only one per LIST response
-;;
-;; QUOTED-CHAR = <any TEXT-CHAR except quoted-specials> /
-;; "\" quoted-specials
-;;
-;; quoted-specials = DQUOTE / "\"
-
-(defun imap-parse-data-list (type)
- (let (flags delimiter mailbox)
- (setq flags (imap-parse-flag-list))
- (when (looking-at " NIL\\| \"\\\\?\\(.\\)\"")
- (setq delimiter (match-string 1))
- (goto-char (1+ (match-end 0)))
- (when (setq mailbox (imap-parse-mailbox))
- (imap-mailbox-put type t mailbox)
- (imap-mailbox-put 'list-flags flags mailbox)
- (imap-mailbox-put 'delimiter delimiter mailbox)))))
-
-;; msg_att ::= "(" 1#("ENVELOPE" SPACE envelope /
-;; "FLAGS" SPACE "(" #(flag / "\Recent") ")" /
-;; "INTERNALDATE" SPACE date_time /
-;; "RFC822" [".HEADER" / ".TEXT"] SPACE nstring /
-;; "RFC822.SIZE" SPACE number /
-;; "BODY" ["STRUCTURE"] SPACE body /
-;; "BODY" section ["<" number ">"] SPACE nstring /
-;; "UID" SPACE uniqueid) ")"
-;;
-;; date_time ::= <"> date_day_fixed "-" date_month "-" date_year
-;; SPACE time SPACE zone <">
-;;
-;; section ::= "[" [section_text / (nz_number *["." nz_number]
-;; ["." (section_text / "MIME")])] "]"
-;;
-;; section_text ::= "HEADER" / "HEADER.FIELDS" [".NOT"]
-;; SPACE header_list / "TEXT"
-;;
-;; header_fld_name ::= astring
-;;
-;; header_list ::= "(" 1#header_fld_name ")"
-
-(defsubst imap-parse-header-list ()
- (when (eq (char-after) ?\()
- (let (strlist)
- (while (not (eq (char-after) ?\)))
- (imap-forward)
- (push (imap-parse-astring) strlist))
- (imap-forward)
- (nreverse strlist))))
-
-(defsubst imap-parse-fetch-body-section ()
- (let ((section
- (buffer-substring (point) (1- (re-search-forward "[] ]" nil t)))))
- (if (eq (char-before) ? )
- (prog1
- (mapconcat 'identity (cons section (imap-parse-header-list)) " ")
- (search-forward "]" nil t))
- section)))
-
-(defun imap-parse-fetch (response)
- (when (eq (char-after) ?\()
- (let (uid flags envelope internaldate rfc822 rfc822header rfc822text
- rfc822size body bodydetail bodystructure flags-empty)
- (while (not (eq (char-after) ?\)))
- (imap-forward)
- (let ((token (read (current-buffer))))
- (imap-forward)
- (cond ((eq token 'UID)
- (setq uid (condition-case ()
- (read (current-buffer))
- (error))))
- ((eq token 'FLAGS)
- (setq flags (imap-parse-flag-list))
- (if (not flags)
- (setq flags-empty 't)))
- ((eq token 'ENVELOPE)
- (setq envelope (imap-parse-envelope)))
- ((eq token 'INTERNALDATE)
- (setq internaldate (imap-parse-string)))
- ((eq token 'RFC822)
- (setq rfc822 (imap-parse-nstring)))
- ((eq token 'RFC822.HEADER)
- (setq rfc822header (imap-parse-nstring)))
- ((eq token 'RFC822.TEXT)
- (setq rfc822text (imap-parse-nstring)))
- ((eq token 'RFC822.SIZE)
- (setq rfc822size (read (current-buffer))))
- ((eq token 'BODY)
- (if (eq (char-before) ?\[)
- (push (list
- (upcase (imap-parse-fetch-body-section))
- (and (eq (char-after) ?<)
- (buffer-substring (1+ (point))
- (search-forward ">" nil t)))
- (progn (imap-forward)
- (imap-parse-nstring)))
- bodydetail)
- (setq body (imap-parse-body))))
- ((eq token 'BODYSTRUCTURE)
- (setq bodystructure (imap-parse-body))))))
- (when uid
- (setq imap-current-message uid)
- (imap-message-put uid 'UID uid)
- (and (or flags flags-empty) (imap-message-put uid 'FLAGS flags))
- (and envelope (imap-message-put uid 'ENVELOPE envelope))
- (and internaldate (imap-message-put uid 'INTERNALDATE internaldate))
- (and rfc822 (imap-message-put uid 'RFC822 rfc822))
- (and rfc822header (imap-message-put uid 'RFC822.HEADER rfc822header))
- (and rfc822text (imap-message-put uid 'RFC822.TEXT rfc822text))
- (and rfc822size (imap-message-put uid 'RFC822.SIZE rfc822size))
- (and body (imap-message-put uid 'BODY body))
- (and bodydetail (imap-message-put uid 'BODYDETAIL bodydetail))
- (and bodystructure (imap-message-put uid 'BODYSTRUCTURE bodystructure))
- (run-hooks 'imap-fetch-data-hook)))))
-
-;; mailbox-data = ...
-;; "STATUS" SP mailbox SP "("
-;; [status-att SP number
-;; *(SP status-att SP number)] ")"
-;; ...
-;;
-;; status-att = "MESSAGES" / "RECENT" / "UIDNEXT" / "UIDVALIDITY" /
-;; "UNSEEN"
-
-(defun imap-parse-status ()
- (let ((mailbox (imap-parse-mailbox)))
- (if (eq (char-after) ? )
- (forward-char))
- (when (and mailbox (eq (char-after) ?\())
- (while (and (not (eq (char-after) ?\)))
- (or (forward-char) t)
- (looking-at "\\([A-Za-z]+\\) "))
- (let ((token (match-string 1)))
- (goto-char (match-end 0))
- (cond ((string= token "MESSAGES")
- (imap-mailbox-put 'messages (read (current-buffer)) mailbox))
- ((string= token "RECENT")
- (imap-mailbox-put 'recent (read (current-buffer)) mailbox))
- ((string= token "UIDNEXT")
- (and (looking-at "[0-9]+")
- (imap-mailbox-put 'uidnext (match-string 0) mailbox)
- (goto-char (match-end 0))))
- ((string= token "UIDVALIDITY")
- (and (looking-at "[0-9]+")
- (imap-mailbox-put 'uidvalidity (match-string 0) mailbox)
- (goto-char (match-end 0))))
- ((string= token "UNSEEN")
- (imap-mailbox-put 'unseen (read (current-buffer)) mailbox))
- (t
- (message "Unknown status data %s in mailbox %s ignored"
- token mailbox)
- (read (current-buffer)))))))))
-
-;; acl_data ::= "ACL" SPACE mailbox *(SPACE identifier SPACE
-;; rights)
-;;
-;; identifier ::= astring
-;;
-;; rights ::= astring
-
-(defun imap-parse-acl ()
- (let ((mailbox (imap-parse-mailbox))
- identifier rights acl)
- (while (eq (char-after) ?\ )
- (imap-forward)
- (setq identifier (imap-parse-astring))
- (imap-forward)
- (setq rights (imap-parse-astring))
- (setq acl (append acl (list (cons identifier rights)))))
- (imap-mailbox-put 'acl acl mailbox)))
-
-;; flag-list = "(" [flag *(SP flag)] ")"
-;;
-;; flag = "\Answered" / "\Flagged" / "\Deleted" /
-;; "\Seen" / "\Draft" / flag-keyword / flag-extension
-;; ; Does not include "\Recent"
-;;
-;; flag-keyword = atom
-;;
-;; flag-extension = "\" atom
-;; ; Future expansion. Client implementations
-;; ; MUST accept flag-extension flags. Server
-;; ; implementations MUST NOT generate
-;; ; flag-extension flags except as defined by
-;; ; future standard or standards-track
-;; ; revisions of this specification.
-
-(defun imap-parse-flag-list ()
- (let (flag-list start)
- (assert (eq (char-after) ?\() nil "In imap-parse-flag-list")
- (while (and (not (eq (char-after) ?\)))
- (setq start (progn
- (imap-forward)
- ;; next line for Courier IMAP bug.
- (skip-chars-forward " ")
- (point)))
- (> (skip-chars-forward "^ )" (imap-point-at-eol)) 0))
- (push (buffer-substring start (point)) flag-list))
- (assert (eq (char-after) ?\)) nil "In imap-parse-flag-list")
- (imap-forward)
- (nreverse flag-list)))
-
-;; envelope = "(" env-date SP env-subject SP env-from SP env-sender SP
-;; env-reply-to SP env-to SP env-cc SP env-bcc SP
-;; env-in-reply-to SP env-message-id ")"
-;;
-;; env-bcc = "(" 1*address ")" / nil
-;;
-;; env-cc = "(" 1*address ")" / nil
-;;
-;; env-date = nstring
-;;
-;; env-from = "(" 1*address ")" / nil
-;;
-;; env-in-reply-to = nstring
-;;
-;; env-message-id = nstring
-;;
-;; env-reply-to = "(" 1*address ")" / nil
-;;
-;; env-sender = "(" 1*address ")" / nil
-;;
-;; env-subject = nstring
-;;
-;; env-to = "(" 1*address ")" / nil
-
-(defun imap-parse-envelope ()
- (when (eq (char-after) ?\()
- (imap-forward)
- (vector (prog1 (imap-parse-nstring) ;; date
- (imap-forward))
- (prog1 (imap-parse-nstring) ;; subject
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; from
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; sender
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; reply-to
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; to
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; cc
- (imap-forward))
- (prog1 (imap-parse-address-list) ;; bcc
- (imap-forward))
- (prog1 (imap-parse-nstring) ;; in-reply-to
- (imap-forward))
- (prog1 (imap-parse-nstring) ;; message-id
- (imap-forward)))))
-
-;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
-
-(defsubst imap-parse-string-list ()
- (cond ((eq (char-after) ?\() ;; body-fld-param
- (let (strlist str)
- (imap-forward)
- (while (setq str (imap-parse-string))
- (push str strlist)
- ;; buggy stalker communigate pro 3.0 doesn't print SPC
- ;; between body-fld-param's sometimes
- (or (eq (char-after) ?\")
- (imap-forward)))
- (nreverse strlist)))
- ((imap-parse-nil)
- nil)))
-
-;; body-extension = nstring / number /
-;; "(" body-extension *(SP body-extension) ")"
-;; ; Future expansion. Client implementations
-;; ; MUST accept body-extension fields. Server
-;; ; implementations MUST NOT generate
-;; ; body-extension fields except as defined by
-;; ; future standard or standards-track
-;; ; revisions of this specification.
-
-(defun imap-parse-body-extension ()
- (if (eq (char-after) ?\()
- (let (b-e)
- (imap-forward)
- (push (imap-parse-body-extension) b-e)
- (while (eq (char-after) ?\ )
- (imap-forward)
- (push (imap-parse-body-extension) b-e))
- (assert (eq (char-after) ?\)) nil "In imap-parse-body-extension")
- (imap-forward)
- (nreverse b-e))
- (or (imap-parse-number)
- (imap-parse-nstring))))
-
-;; body-ext-1part = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
-;; *(SP body-extension)]]
-;; ; MUST NOT be returned on non-extensible
-;; ; "BODY" fetch
-;;
-;; body-ext-mpart = body-fld-param [SP body-fld-dsp [SP body-fld-lang
-;; *(SP body-extension)]]
-;; ; MUST NOT be returned on non-extensible
-;; ; "BODY" fetch
-
-(defsubst imap-parse-body-ext ()
- (let (ext)
- (when (eq (char-after) ?\ ) ;; body-fld-dsp
- (imap-forward)
- (let (dsp)
- (if (eq (char-after) ?\()
- (progn
- (imap-forward)
- (push (imap-parse-string) dsp)
- (imap-forward)
- (push (imap-parse-string-list) dsp)
- (imap-forward))
- ;; With assert, the code might not be eval'd.
- ;; (assert (imap-parse-nil) t "In imap-parse-body-ext")
- (imap-parse-nil))
- (push (nreverse dsp) ext))
- (when (eq (char-after) ?\ ) ;; body-fld-lang
- (imap-forward)
- (if (eq (char-after) ?\()
- (push (imap-parse-string-list) ext)
- (push (imap-parse-nstring) ext))
- (while (eq (char-after) ?\ ) ;; body-extension
- (imap-forward)
- (setq ext (append (imap-parse-body-extension) ext)))))
- ext))
-
-;; body = "(" body-type-1part / body-type-mpart ")"
-;;
-;; body-ext-1part = body-fld-md5 [SP body-fld-dsp [SP body-fld-lang
-;; *(SP body-extension)]]
-;; ; MUST NOT be returned on non-extensible
-;; ; "BODY" fetch
-;;
-;; body-ext-mpart = body-fld-param [SP body-fld-dsp [SP body-fld-lang
-;; *(SP body-extension)]]
-;; ; MUST NOT be returned on non-extensible
-;; ; "BODY" fetch
-;;
-;; body-fields = body-fld-param SP body-fld-id SP body-fld-desc SP
-;; body-fld-enc SP body-fld-octets
-;;
-;; body-fld-desc = nstring
-;;
-;; body-fld-dsp = "(" string SP body-fld-param ")" / nil
-;;
-;; body-fld-enc = (DQUOTE ("7BIT" / "8BIT" / "BINARY" / "BASE64"/
-;; "QUOTED-PRINTABLE") DQUOTE) / string
-;;
-;; body-fld-id = nstring
-;;
-;; body-fld-lang = nstring / "(" string *(SP string) ")"
-;;
-;; body-fld-lines = number
-;;
-;; body-fld-md5 = nstring
-;;
-;; body-fld-octets = number
-;;
-;; body-fld-param = "(" string SP string *(SP string SP string) ")" / nil
-;;
-;; body-type-1part = (body-type-basic / body-type-msg / body-type-text)
-;; [SP body-ext-1part]
-;;
-;; body-type-basic = media-basic SP body-fields
-;; ; MESSAGE subtype MUST NOT be "RFC822"
-;;
-;; body-type-msg = media-message SP body-fields SP envelope
-;; SP body SP body-fld-lines
-;;
-;; body-type-text = media-text SP body-fields SP body-fld-lines
-;;
-;; body-type-mpart = 1*body SP media-subtype
-;; [SP body-ext-mpart]
-;;
-;; media-basic = ((DQUOTE ("APPLICATION" / "AUDIO" / "IMAGE" /
-;; "MESSAGE" / "VIDEO") DQUOTE) / string) SP media-subtype
-;; ; Defined in [MIME-IMT]
-;;
-;; media-message = DQUOTE "MESSAGE" DQUOTE SP DQUOTE "RFC822" DQUOTE
-;; ; Defined in [MIME-IMT]
-;;
-;; media-subtype = string
-;; ; Defined in [MIME-IMT]
-;;
-;; media-text = DQUOTE "TEXT" DQUOTE SP media-subtype
-;; ; Defined in [MIME-IMT]
-
-(defun imap-parse-body ()
- (let (body)
- (when (eq (char-after) ?\()
- (imap-forward)
- (if (eq (char-after) ?\()
- (let (subbody)
- (while (and (eq (char-after) ?\()
- (setq subbody (imap-parse-body)))
- ;; buggy stalker communigate pro 3.0 insert a SPC between
- ;; parts in multiparts
- (when (and (eq (char-after) ?\ )
- (eq (char-after (1+ (point))) ?\())
- (imap-forward))
- (push subbody body))
- (imap-forward)
- (push (imap-parse-string) body) ;; media-subtype
- (when (eq (char-after) ?\ ) ;; body-ext-mpart:
- (imap-forward)
- (if (eq (char-after) ?\() ;; body-fld-param
- (push (imap-parse-string-list) body)
- (push (and (imap-parse-nil) nil) body))
- (setq body
- (append (imap-parse-body-ext) body))) ;; body-ext-...
- (assert (eq (char-after) ?\)) nil "In imap-parse-body")
- (imap-forward)
- (nreverse body))
-
- (push (imap-parse-string) body) ;; media-type
- (imap-forward)
- (push (imap-parse-string) body) ;; media-subtype
- (imap-forward)
- ;; next line for Sun SIMS bug
- (and (eq (char-after) ? ) (imap-forward))
- (if (eq (char-after) ?\() ;; body-fld-param
- (push (imap-parse-string-list) body)
- (push (and (imap-parse-nil) nil) body))
- (imap-forward)
- (push (imap-parse-nstring) body) ;; body-fld-id
- (imap-forward)
- (push (imap-parse-nstring) body) ;; body-fld-desc
- (imap-forward)
- ;; next `or' for Sun SIMS bug, it regard body-fld-enc as a
- ;; nstring and return nil instead of defaulting back to 7BIT
- ;; as the standard says.
- (push (or (imap-parse-nstring) "7BIT") body) ;; body-fld-enc
- (imap-forward)
- (push (imap-parse-number) body) ;; body-fld-octets
-
- ;; ok, we're done parsing the required parts, what comes now is one
- ;; of three things:
- ;;
- ;; envelope (then we're parsing body-type-msg)
- ;; body-fld-lines (then we're parsing body-type-text)
- ;; body-ext-1part (then we're parsing body-type-basic)
- ;;
- ;; the problem is that the two first are in turn optionally followed
-;; by the third. So we parse the first two here (if there are any)...
-
- (when (eq (char-after) ?\ )
- (imap-forward)
- (let (lines)
- (cond ((eq (char-after) ?\() ;; body-type-msg:
- (push (imap-parse-envelope) body) ;; envelope
- (imap-forward)
- (push (imap-parse-body) body) ;; body
- ;; buggy stalker communigate pro 3.0 doesn't print
- ;; number of lines in message/rfc822 attachment
- (if (eq (char-after) ?\))
- (push 0 body)
- (imap-forward)
- (push (imap-parse-number) body))) ;; body-fld-lines
- ((setq lines (imap-parse-number)) ;; body-type-text:
- (push lines body)) ;; body-fld-lines
- (t
- (backward-char))))) ;; no match...
-
- ;; ...and then parse the third one here...
-
- (when (eq (char-after) ?\ ) ;; body-ext-1part:
- (imap-forward)
- (push (imap-parse-nstring) body) ;; body-fld-md5
- (setq body (append (imap-parse-body-ext) body))) ;; body-ext-1part..
-
- (assert (eq (char-after) ?\)) nil "In imap-parse-body 2")
- (imap-forward)
- (nreverse body)))))
-
-(when imap-debug ; (untrace-all)
- (require 'trace)
- (buffer-disable-undo (get-buffer-create imap-debug-buffer))
- (mapcar (lambda (f) (trace-function-background f imap-debug-buffer))
- '(
- imap-utf7-encode
- imap-utf7-decode
- imap-error-text
- imap-kerberos4s-p
- imap-kerberos4-open
- imap-ssl-p
- imap-ssl-open
- imap-network-p
- imap-network-open
- imap-interactive-login
- imap-kerberos4a-p
- imap-kerberos4-auth
- imap-cram-md5-p
- imap-cram-md5-auth
- imap-login-p
- imap-login-auth
- imap-anonymous-p
- imap-anonymous-auth
- imap-open-1
- imap-open
- imap-opened
- imap-authenticate
- imap-close
- imap-capability
- imap-namespace
- imap-send-command-wait
- imap-mailbox-put
- imap-mailbox-get
- imap-mailbox-map-1
- imap-mailbox-map
- imap-current-mailbox
- imap-current-mailbox-p-1
- imap-current-mailbox-p
- imap-mailbox-select-1
- imap-mailbox-select
- imap-mailbox-examine-1
- imap-mailbox-examine
- imap-mailbox-unselect
- imap-mailbox-expunge
- imap-mailbox-close
- imap-mailbox-create-1
- imap-mailbox-create
- imap-mailbox-delete
- imap-mailbox-rename
- imap-mailbox-lsub
- imap-mailbox-list
- imap-mailbox-subscribe
- imap-mailbox-unsubscribe
- imap-mailbox-status
- imap-mailbox-acl-get
- imap-mailbox-acl-set
- imap-mailbox-acl-delete
- imap-current-message
- imap-list-to-message-set
- imap-fetch-asynch
- imap-fetch
- imap-message-put
- imap-message-get
- imap-message-map
- imap-search
- imap-message-flag-permanent-p
- imap-message-flags-set
- imap-message-flags-del
- imap-message-flags-add
- imap-message-copyuid-1
- imap-message-copyuid
- imap-message-copy
- imap-message-appenduid-1
- imap-message-appenduid
- imap-message-append
- imap-body-lines
- imap-envelope-from
- imap-send-command-1
- imap-send-command
- imap-wait-for-tag
- imap-sentinel
- imap-find-next-line
- imap-arrival-filter
- imap-parse-greeting
- imap-parse-response
- imap-parse-resp-text
- imap-parse-resp-text-code
- imap-parse-data-list
- imap-parse-fetch
- imap-parse-status
- imap-parse-acl
- imap-parse-flag-list
- imap-parse-envelope
- imap-parse-body-extension
- imap-parse-body
- )))
-
-(provide 'imap)
-
-;;; arch-tag: 27369ed6-33e4-482f-96f1-8bb906ba70f7
-;;; imap.el ends here
+++ /dev/null
-;;; gnus-agent.el --- Legacy unplugged support for Gnus
-
-;; Copyright (C) 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Kevin Greiner <kgreiner@xpediantsolutions.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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Conversion functions for the Agent.
-
-;;; Code:
-(require 'gnus-start)
-(require 'gnus-util)
-(require 'gnus-range)
-(require 'gnus-agent)
-
-;; Oort Gnus v0.08 - This release updated agent to no longer use
-;; history file and to support a compressed alist.
-
-(defvar gnus-agent-compressed-agentview-search-only nil)
-
-(defun gnus-agent-convert-to-compressed-agentview (converting-to)
- "Iterates over all agentview files to ensure that they have been
-converted to the compressed format."
-
- (let ((search-in (list gnus-agent-directory))
- here
- members
- member
- converted-something)
- (while (setq here (pop search-in))
- (setq members (directory-files here t))
- (while (setq member (pop members))
- (cond ((string-match "/\\.\\.?$" member)
- nil)
- ((file-directory-p member)
- (push member search-in))
- ((equal (file-name-nondirectory member) ".agentview")
- (setq converted-something
- (or (gnus-agent-convert-agentview member)
- converted-something))))))
-
- (if converted-something
- (gnus-message 4 "Successfully converted Gnus %s offline (agent) files to %s" gnus-newsrc-file-version converting-to))))
-
-(defun gnus-agent-convert-to-compressed-agentview-prompt ()
- (catch 'found-file-to-convert
- (let ((gnus-agent-compressed-agentview-search-only t))
- (gnus-agent-convert-to-compressed-agentview nil))))
-
-(gnus-convert-mark-converter-prompt 'gnus-agent-convert-to-compressed-agentview 'gnus-agent-convert-to-compressed-agentview-prompt)
-
-(defun gnus-agent-convert-agentview (file)
- "Load FILE and do a `read' there."
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let ((inhibit-quit t)
- (alist (read (current-buffer)))
- (version (condition-case nil (read (current-buffer))
- (end-of-file 0)))
- changed-version
- history-file)
-
- (cond
- ((= version 0)
- (let (entry
- (gnus-command-method nil))
- (mm-disable-multibyte) ;; everything is binary
- (erase-buffer)
- (insert "\n")
- (let ((file (concat (file-name-directory file) "/history")))
- (when (file-exists-p file)
- (nnheader-insert-file-contents file)
- (setq history-file file)))
-
- (goto-char (point-min))
- (while (not (eobp))
- (if (and (looking-at
- "[^\t\n]+\t\\([0-9]+\\)\t\\([^ \n]+\\) \\([0-9]+\\)")
- (string= (gnus-agent-article-name ".agentview" (match-string 2))
- file)
- (setq entry (assoc (string-to-number (match-string 3)) alist)))
- (setcdr entry (string-to-number (match-string 1))))
- (forward-line 1))
- (setq changed-version t)))
- ((= version 1)
- (setq changed-version t)))
-
- (when changed-version
- (when gnus-agent-compressed-agentview-search-only
- (throw 'found-file-to-convert t))
-
- (erase-buffer)
- (let ((compressed nil))
- (mapcar (lambda (pair)
- (let* ((article-id (car pair))
- (day-of-download (cdr pair))
- (comp-list (assq day-of-download compressed)))
- (if comp-list
- (setcdr comp-list
- (cons article-id (cdr comp-list)))
- (setq compressed
- (cons (list day-of-download article-id)
- compressed)))
- nil)) alist)
- (mapcar (lambda (comp-list)
- (setcdr comp-list
- (gnus-compress-sequence
- (nreverse (cdr comp-list)))))
- compressed)
- (princ compressed (current-buffer)))
- (insert "\n2\n")
- (write-file file)
- (when history-file
- (delete-file history-file))
- t))))
-
-;; End of Oort Gnus v0.08 updates
-
-;; No Gnus v0.3 - This release provides a mechanism for upgrading gnus
-;; from previous versions. Therefore, the previous
-;; hacks to handle a gnus-agent-expire-days that
-;; specifies a list of values can be removed.
-
-(defun gnus-agent-unlist-expire-days (converting-to)
- (when (listp gnus-agent-expire-days)
- (let (buffer)
- (unwind-protect
- (save-window-excursion
- (setq buffer (gnus-get-buffer-create " *Gnus agent upgrade*"))
- (set-buffer buffer)
- (erase-buffer)
- (insert "The definition of gnus-agent-expire-days has been changed.\nYou currently have it set to the list:\n ")
- (gnus-pp gnus-agent-expire-days)
-
- (insert "\nIn order to use version '" converting-to "' of gnus, you will need to set\n")
- (insert "gnus-agent-expire-days to an integer. If you still wish to set different\n")
- (insert "expiration days to individual groups, you must instead set the\n")
- (insert "'agent-days-until-old group and/or topic parameter.\n")
- (insert "\n")
- (insert "If you would like, gnus can iterate over every group comparing its name to the\n")
- (insert "regular expressions that you currently have in gnus-agent-expire-days. When\n")
- (insert "gnus finds a match, it will update that group's 'agent-days-until-old group\n")
- (insert "parameter to the value associated with the regular expression.\n")
- (insert "\n")
- (insert "Whether gnus assigns group parameters, or not, gnus will terminate with an\n")
- (insert "ERROR as soon as this function completes. The reason is that you must\n")
- (insert "manually edit your configuration to either not set gnus-agent-expire-days or\n")
- (insert "to set it to an integer before gnus can be used.\n")
- (insert "\n")
- (insert "Once you have successfully edited gnus-agent-expire-days, gnus will be able to\n")
- (insert "execute past this function.\n")
- (insert "\n")
- (insert "Should gnus use gnus-agent-expire-days to assign\n")
- (insert "agent-days-until-old parameters to individual groups? (Y/N)")
-
- (switch-to-buffer buffer)
- (beep)
- (beep)
-
- (let ((echo-keystrokes 0)
- c)
- (while (progn (setq c (read-char-exclusive))
- (cond ((or (eq c ?y) (eq c ?Y))
- (save-excursion
- (let ((groups (gnus-group-listed-groups)))
- (while groups
- (let* ((group (pop groups))
- (days gnus-agent-expire-days)
- (day (catch 'found
- (while days
- (when (eq 0 (string-match
- (caar days)
- group))
- (throw 'found (cadar days)))
- (setq days (cdr days)))
- nil)))
- (when day
- (gnus-group-set-parameter group 'agent-days-until-old
- day))))))
- nil
- )
- ((or (eq c ?n) (eq c ?N))
- nil)
- (t
- t))))))
- (kill-buffer buffer))
- (error "Change gnus-agent-expire-days to an integer for gnus to start"))))
-
-;; The gnus-agent-unlist-expire-days has its own conversion prompt.
-;; Therefore, hide the default prompt.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unlist-expire-days t)
-
-(defun gnus-agent-unhook-expire-days (converting-to)
- "Remove every lambda from gnus-group-prepare-hook that mention the
-symbol gnus-agent-do-once in their definition. This should NOT be
-necessary as gnus-agent.el no longer adds them. However, it is
-possible that the hook was persistently saved."
- (let ((h t)) ; iterate from bgn of hook
- (while h
- (let ((func (progn (when (eq h t)
- ;; init h to list of functions
- (setq h (cond ((listp gnus-group-prepare-hook)
- gnus-group-prepare-hook)
- ((boundp 'gnus-group-prepare-hook)
- (list gnus-group-prepare-hook)))))
- (pop h))))
-
- (when (cond ((eq (type-of func) 'compiled-function)
- ;; Search def. of compiled function for gnus-agent-do-once string
- (let* (definition
- print-level
- print-length
- (standard-output
- (lambda (char)
- (setq definition (cons char definition)))))
- (princ func) ; populates definition with reversed list of characters
- (let* ((i (length definition))
- (s (make-string i 0)))
- (while definition
- (aset s (setq i (1- i)) (pop definition)))
-
- (string-match "\\bgnus-agent-do-once\\b" s))))
- ((listp func)
- (eq (cadr (nth 2 func)) 'gnus-agent-do-once) ; handles eval'd lambda
- ))
-
- (remove-hook 'gnus-group-prepare-hook func)
- ;; I don't what remove-hook is going to actually do to the
- ;; hook list so start over from the beginning.
- (setq h t))))))
-
-;; gnus-agent-unhook-expire-days is safe in that it does not modify
-;; the .newsrc.eld file.
-(gnus-convert-mark-converter-prompt 'gnus-agent-unhook-expire-days t)
-
-(provide 'legacy-gnus-agent)
-
-;; arch-tag: 845c7b8a-88f7-4468-b8d7-94e8fc72cf1a
-;;; legacy-gnus-agent.el ends here
+++ /dev/null
-;; Shut up.
-
-(defun maybe-fbind (args)
- (while args
- (or (fboundp (car args))
- (defalias (car args) 'ignore))
- (setq args (cdr args))))
-
-(defun maybe-bind (args)
- (mapcar (lambda (var) (unless (boundp var) (set var nil))) args))
-
-(unless (featurep 'xemacs)
- (defun nnkiboze-score-file (a))
- (maybe-fbind
- '(Info-menu
- cp-supported-codepages delete-annotation glyph-height make-annotation
- make-glyph map-extents set-extent-property set-itimer-function w3-do-setup
- w3-prepare-buffer w3-region w32-focus-frame w3m-detect-meta-charset
- w3m-region window-pixel-height window-pixel-width))
-
- (when (<= emacs-major-version 22)
- (maybe-fbind '(display-time-event-handler frame-device)))
-
- (when (= emacs-major-version 21)
- (defun split-line (&optional arg))
- (maybe-fbind
- '(bbdb-complete-name
- custom-autoload delete-extent device-connection dfw-device
- events-to-keys find-coding-system find-face font-lock-set-defaults
- get-char-table glyph-width mail-aliases-setup make-event
- make-network-process message-xmas-redefine put-char-table temp-directory
- unicode-precedence-list url-generic-parse-url url-http-file-exists-p
- url-insert-file-contents valid-image-instantiator-format-p
- vcard-pretty-print w3-coding-system-for-mime-charset))
- (maybe-bind
- '(filladapt-mode
- help-echo-owns-message itimer-list ps-print-color-p url-version
- w3-meta-charset-content-type-regexp
- w3-meta-content-type-charset-regexp))))
-
-(when (featurep 'xemacs)
- (defun nnkiboze-score-file (a))
- (defun split-line (&optional arg))
- (maybe-fbind
- '(codepage-setup
- create-image detect-coding-string display-time-event-handler
- event-click-count event-end event-start find-coding-systems-for-charsets
- find-coding-systems-region find-coding-systems-string find-image
- image-size image-type-available-p insert-image mail-abbrevs-setup
- make-mode-line-mouse-map make-network-process mouse-minibuffer-check
- mouse-movement-p mouse-scroll-subr posn-point posn-window put-image
- read-event rmail-msg-is-pruned rmail-msg-restore-non-pruned-header
- select-safe-coding-system sort-coding-systems track-mouse
- url-generic-parse-url url-http-file-exists-p url-insert-file-contents
- vcard-pretty-print w3m-detect-meta-charset window-edges))
- (maybe-bind
- '(adaptive-fill-first-line-regexp
- buffer-display-table cursor-in-non-selected-windows
- default-enable-multibyte-characters filladapt-mode
- gnus-agent-expire-current-dirs idna-program installation-directory
- line-spacing mark-active mouse-selection-click-count
- mouse-selection-click-count-buffer
- rmail-insert-mime-forwarded-message-function tool-bar-mode
- transient-mark-mode url-version w3-meta-charset-content-type-regexp
- w3-meta-content-type-charset-regexp))
-
- (when (or (and (= emacs-major-version 21) (= emacs-minor-version 4))
- (featurep 'sxemacs))
- (maybe-fbind
- '(custom-autoload
- display-graphic-p display-images-p display-visual-class
- replace-regexp-in-string select-frame-set-input-focus
- unicode-precedence-list w32-focus-frame x-focus-frame)))
-
- (unless (featurep 'mule)
- (maybe-fbind
- '(ccl-execute-on-string
- charsetp coding-system-get get-charset-property pgg-parse-crc24-string
- unicode-precedence-list))
- (maybe-bind
- '(current-language-environment language-info-alist pgg-parse-crc24)))
-
- (unless (featurep 'file-coding)
- (maybe-fbind
- '(coding-system-base
- coding-system-change-eol-conversion coding-system-list coding-system-p
- find-coding-system))
- (maybe-bind '(buffer-file-coding-system enable-multibyte-characters))))
-
-(provide 'lpath)
-
-;;; arch-tag: d1ad864f-dca6-4d21-aa3f-be3248e66dba
+++ /dev/null
-;;; mail-parse.el --- Interface functions for parsing mail
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file contains wrapper functions for a wide range of mail
-;; parsing functions. The idea is that there are low-level libraries
-;; that impement according to various specs (RFC2231, DRUMS, USEFOR),
-;; but that programmers that want to parse some header (say,
-;; Content-Type) will want to use the latest spec.
-;;
-;; So while each low-level library (rfc2231.el, for instance) decodes
-;; faithfully according to that (proposed) standard, this library is
-;; the interface library. If some later RFC supersedes RFC2231, one
-;; would just have to write a new low-level library, adjust the
-;; aliases in this library, and the users and programmers won't notice
-;; any changes.
-
-;;; Code:
-
-(require 'mail-prsvr)
-(require 'ietf-drums)
-(require 'rfc2231)
-(require 'rfc2047)
-(require 'rfc2045)
-
-(defalias 'mail-header-parse-content-type 'rfc2231-parse-qp-string)
-(defalias 'mail-header-parse-content-disposition 'rfc2231-parse-qp-string)
-(defalias 'mail-content-type-get 'rfc2231-get-value)
-;(defalias 'mail-header-encode-parameter 'rfc2045-encode-string)
-(defalias 'mail-header-encode-parameter 'rfc2231-encode-string)
-
-(defalias 'mail-header-remove-comments 'ietf-drums-remove-comments)
-(defalias 'mail-header-remove-whitespace 'ietf-drums-remove-whitespace)
-(defalias 'mail-header-strip 'ietf-drums-strip)
-(defalias 'mail-header-get-comment 'ietf-drums-get-comment)
-(defalias 'mail-header-parse-address 'ietf-drums-parse-address)
-(defalias 'mail-header-parse-addresses 'ietf-drums-parse-addresses)
-(defalias 'mail-header-parse-date 'ietf-drums-parse-date)
-(defalias 'mail-narrow-to-head 'ietf-drums-narrow-to-header)
-(defalias 'mail-quote-string 'ietf-drums-quote-string)
-
-(defalias 'mail-header-fold-field 'rfc2047-fold-field)
-(defalias 'mail-header-unfold-field 'rfc2047-unfold-field)
-(defalias 'mail-header-narrow-to-field 'rfc2047-narrow-to-field)
-(defalias 'mail-header-field-value 'rfc2047-field-value)
-
-(defalias 'mail-encode-encoded-word-region 'rfc2047-encode-region)
-(defalias 'mail-encode-encoded-word-buffer 'rfc2047-encode-message-header)
-(defalias 'mail-encode-encoded-word-string 'rfc2047-encode-string)
-(defalias 'mail-decode-encoded-word-region 'rfc2047-decode-region)
-(defalias 'mail-decode-encoded-word-string 'rfc2047-decode-string)
-(defalias 'mail-decode-encoded-address-region 'rfc2047-decode-address-region)
-(defalias 'mail-decode-encoded-address-string 'rfc2047-decode-address-string)
-
-(provide 'mail-parse)
-
-;;; arch-tag: 3e63d75c-c962-4784-ab01-7ba07ca9d2d4
-;;; mail-parse.el ends here
+++ /dev/null
-;;; mail-prsvr.el --- Interface variables for parsing mail
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(defvar mail-parse-charset nil
- "Default charset used by low-level libraries.
-This variable should never be set. Instead, it should be bound by
-functions that wish to call mail-parse functions and let them know
-what the desired charset is to be.")
-
-(defvar mail-parse-mule-charset nil
- "Default MULE charset used by low-level libraries.
-This variable should never be set.")
-
-(defvar mail-parse-ignored-charsets nil
- "Ignored charsets used by low-level libraries.
-This variable should never be set. Instead, it should be bound by
-functions that wish to call mail-parse functions and let them know
-what the desired charsets is to be ignored.")
-
-(provide 'mail-prsvr)
-
-;;; arch-tag: 9ba878cc-8b43-4f7a-85b1-69b1a9a5d9f5
-;;; mail-prsvr.el ends here
+++ /dev/null
-;;; mail-source.el --- functions for fetching mail
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'imap)
- (eval-when-compile (defvar display-time-mail-function)))
-(eval-and-compile
- (autoload 'pop3-movemail "pop3")
- (autoload 'pop3-get-message-count "pop3")
- (autoload 'nnheader-cancel-timer "nnheader")
- (autoload 'nnheader-run-at-time "nnheader"))
-(require 'format-spec)
-(require 'mm-util)
-(require 'message) ;; for `message-directory'
-
-(defgroup mail-source nil
- "The mail-fetching library."
- :version "21.1"
- :group 'gnus)
-
-;; Define these at compile time to avoid dragging in imap always.
-(defconst mail-source-imap-authenticators
- (eval-when-compile
- (mapcar (lambda (a)
- (list 'const (car a)))
- imap-authenticator-alist)))
-(defconst mail-source-imap-streams
- (eval-when-compile
- (mapcar (lambda (a)
- (list 'const (car a)))
- imap-stream-alist)))
-
-(defcustom mail-sources nil
- "*Where the mail backends will look for incoming mail.
-This variable is a list of mail source specifiers.
-See Info node `(gnus)Mail Source Specifiers'."
- :group 'mail-source
- :link '(custom-manual "(gnus)Mail Source Specifiers")
- :type `(choice
- (const nil)
- (repeat
- (choice :format "%[Value Menu%] %v"
- :value (file)
- (cons :tag "Spool file"
- (const :format "" file)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :path)
- file)))
- (cons :tag "Several files in a directory"
- (const :format "" directory)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :path)
- (directory :tag "Path"))
- (group :inline t
- (const :format "" :value :suffix)
- (string :tag "Suffix"))
- (group :inline t
- (const :format "" :value :predicate)
- (function :tag "Predicate"))
- (group :inline t
- (const :format "" :value :prescript)
- (choice :tag "Prescript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :postscript)
- (choice :tag "Postscript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
- (cons :tag "POP3 server"
- (const :format "" pop)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :server)
- (string :tag "Server"))
- (group :inline t
- (const :format "" :value :port)
- (choice :tag "Port"
- :value "pop3"
- (number :format "%v")
- (string :format "%v")))
- (group :inline t
- (const :format "" :value :user)
- (string :tag "User"))
- (group :inline t
- (const :format "" :value :password)
- (string :tag "Password"))
- (group :inline t
- (const :format "" :value :program)
- (string :tag "Program"))
- (group :inline t
- (const :format "" :value :prescript)
- (choice :tag "Prescript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :postscript)
- (choice :tag "Postscript"
- :value nil
- (string :format "%v")
- (function :format "%v")))
- (group :inline t
- (const :format "" :value :function)
- (function :tag "Function"))
- (group :inline t
- (const :format ""
- :value :authentication)
- (choice :tag "Authentication"
- :value apop
- (const password)
- (const apop)))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
- (cons :tag "Maildir (qmail, postfix...)"
- (const :format "" maildir)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :path)
- (directory :tag "Path"))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
- (cons :tag "IMAP server"
- (const :format "" imap)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :server)
- (string :tag "Server"))
- (group :inline t
- (const :format "" :value :port)
- (choice :tag "Port"
- :value 143
- number string))
- (group :inline t
- (const :format "" :value :user)
- (string :tag "User"))
- (group :inline t
- (const :format "" :value :password)
- (string :tag "Password"))
- (group :inline t
- (const :format "" :value :stream)
- (choice :tag "Stream"
- :value network
- ,@mail-source-imap-streams))
- (group :inline t
- (const :format "" :value :program)
- (string :tag "Program"))
- (group :inline t
- (const :format ""
- :value :authenticator)
- (choice :tag "Authenticator"
- :value login
- ,@mail-source-imap-authenticators))
- (group :inline t
- (const :format "" :value :mailbox)
- (string :tag "Mailbox"
- :value "INBOX"))
- (group :inline t
- (const :format "" :value :predicate)
- (string :tag "Predicate"
- :value "UNSEEN UNDELETED"))
- (group :inline t
- (const :format "" :value :fetchflag)
- (string :tag "Fetchflag"
- :value "\\Deleted"))
- (group :inline t
- (const :format ""
- :value :dontexpunge)
- (boolean :tag "Dontexpunge"))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))
- (cons :tag "Webmail server"
- (const :format "" webmail)
- (checklist :tag "Options" :greedy t
- (group :inline t
- (const :format "" :value :subtype)
- ;; Should be generated from
- ;; `webmail-type-definition', but we
- ;; can't require webmail without W3.
- (choice :tag "Subtype"
- :value hotmail
- (const hotmail)
- (const yahoo)
- (const netaddress)
- (const netscape)
- (const my-deja)))
- (group :inline t
- (const :format "" :value :user)
- (string :tag "User"))
- (group :inline t
- (const :format "" :value :password)
- (string :tag "Password"))
- (group :inline t
- (const :format ""
- :value :dontexpunge)
- (boolean :tag "Dontexpunge"))
- (group :inline t
- (const :format "" :value :plugged)
- (boolean :tag "Plugged"))))))))
-
-(defcustom mail-source-ignore-errors nil
- "*Ignore errors when querying mail sources.
-If nil, the user will be prompted when an error occurs. If non-nil,
-the error will be ignored."
- :version "22.1"
- :group 'mail-source
- :type 'boolean)
-
-(defcustom mail-source-primary-source nil
- "*Primary source for incoming mail.
-If non-nil, this maildrop will be checked periodically for new mail."
- :group 'mail-source
- :type 'sexp)
-
-(defcustom mail-source-flash t
- "*If non-nil, flash periodically when mail is available."
- :group 'mail-source
- :type 'boolean)
-
-(defcustom mail-source-crash-box "~/.emacs-mail-crash-box"
- "File where mail will be stored while processing it."
- :group 'mail-source
- :type 'file)
-
-(defcustom mail-source-directory message-directory
- "Directory where incoming mail source files (if any) will be stored."
- :group 'mail-source
- :type 'directory)
-
-(defcustom mail-source-default-file-modes 384
- "Set the mode bits of all new mail files to this integer."
- :group 'mail-source
- :type 'integer)
-
-(defcustom mail-source-delete-incoming
- ;; 10 ;; development versions
- 2 ;; released versions
- "If non-nil, delete incoming files after handling.
-If t, delete immediately, if nil, never delete. If a positive number, delete
-files older than number of days.
-
-Removing of old files happens in `mail-source-callback', i.e. no
-old incoming files will be deleted unless you receive new mail.
-You may also set this variable to nil and call
-`mail-source-delete-old-incoming' interactively."
- :group 'mail-source
- :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
- :type '(choice (const :tag "immediately" t)
- (const :tag "never" nil)
- (integer :tag "days")))
-
-(defcustom mail-source-delete-old-incoming-confirm nil
- "If non-nil, ask for confirmation before deleting old incoming files.
-This variable only applies when `mail-source-delete-incoming' is a positive
-number."
- :version "22.2" ;; No Gnus / Gnus 5.10.10 (default changed)
- :group 'mail-source
- :type 'boolean)
-
-(defcustom mail-source-incoming-file-prefix "Incoming"
- "Prefix for file name for storing incoming mail"
- :group 'mail-source
- :type 'string)
-
-(defcustom mail-source-report-new-mail-interval 5
- "Interval in minutes between checks for new mail."
- :group 'mail-source
- :type 'number)
-
-(defcustom mail-source-idle-time-delay 5
- "Number of idle seconds to wait before checking for new mail."
- :group 'mail-source
- :type 'number)
-
-(defcustom mail-source-movemail-program nil
- "If non-nil, name of program for fetching new mail."
- :version "22.1"
- :group 'mail-source
- :type '(choice (const nil) string))
-
-;;; Internal variables.
-
-(defvar mail-source-string ""
- "A dynamically bound string that says what the current mail source is.")
-
-(defvar mail-source-new-mail-available nil
- "Flag indicating when new mail is available.")
-
-(eval-and-compile
- (defvar mail-source-common-keyword-map
- '((:plugged))
- "Mapping from keywords to default values.
-Common keywords should be listed here.")
-
- (defvar mail-source-keyword-map
- '((file
- (:prescript)
- (:prescript-delay)
- (:postscript)
- (:path (or (getenv "MAIL")
- (expand-file-name (user-login-name) rmail-spool-directory))))
- (directory
- (:prescript)
- (:prescript-delay)
- (:postscript)
- (:path)
- (:suffix ".spool")
- (:predicate identity))
- (pop
- (:prescript)
- (:prescript-delay)
- (:postscript)
- (:server (getenv "MAILHOST"))
- (:port 110)
- (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
- (:program)
- (:function)
- (:password)
- (:authentication password))
- (maildir
- (:path (or (getenv "MAILDIR") "~/Maildir/"))
- (:subdirs ("cur" "new"))
- (:function))
- (imap
- (:server (getenv "MAILHOST"))
- (:port)
- (:stream)
- (:program)
- (:authentication)
- (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
- (:password)
- (:mailbox "INBOX")
- (:predicate "UNSEEN UNDELETED")
- (:fetchflag "\\Deleted")
- (:prescript)
- (:prescript-delay)
- (:postscript)
- (:dontexpunge))
- (webmail
- (:subtype hotmail)
- (:user (or (user-login-name) (getenv "LOGNAME") (getenv "USER")))
- (:password)
- (:dontexpunge)
- (:authentication password)))
- "Mapping from keywords to default values.
-All keywords that can be used must be listed here."))
-
-(defvar mail-source-fetcher-alist
- '((file mail-source-fetch-file)
- (directory mail-source-fetch-directory)
- (pop mail-source-fetch-pop)
- (maildir mail-source-fetch-maildir)
- (imap mail-source-fetch-imap)
- (webmail mail-source-fetch-webmail))
- "A mapping from source type to fetcher function.")
-
-(defvar mail-source-password-cache nil)
-
-(defvar mail-source-plugged t)
-
-;;; Functions
-
-(eval-and-compile
- (defun mail-source-strip-keyword (keyword)
- "Strip the leading colon off the KEYWORD."
- (intern (substring (symbol-name keyword) 1))))
-
-(eval-and-compile
- (defun mail-source-bind-1 (type)
- (let* ((defaults (cdr (assq type mail-source-keyword-map)))
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
-
-(defmacro mail-source-bind (type-source &rest body)
- "Return a `let' form that binds all variables in source TYPE.
-TYPE-SOURCE is a list where the first element is the TYPE, and
-the second variable is the SOURCE.
-At run time, the mail source specifier SOURCE will be inspected,
-and the variables will be set according to it. Variables not
-specified will be given default values.
-
-After this is done, BODY will be executed in the scope
-of the `let' form.
-
-The variables bound and their default values are described by
-the `mail-source-keyword-map' variable."
- `(let ,(mail-source-bind-1 (car type-source))
- (mail-source-set-1 ,(cadr type-source))
- ,@body))
-
-(put 'mail-source-bind 'lisp-indent-function 1)
-(put 'mail-source-bind 'edebug-form-spec '(sexp body))
-
-(defun mail-source-set-1 (source)
- (let* ((type (pop source))
- (defaults (cdr (assq type mail-source-keyword-map)))
- default value keyword)
- (while (setq default (pop defaults))
- (set (mail-source-strip-keyword (setq keyword (car default)))
- (if (setq value (plist-get source keyword))
- (mail-source-value value)
- (mail-source-value (cadr default)))))))
-
-(eval-and-compile
- (defun mail-source-bind-common-1 ()
- (let* ((defaults mail-source-common-keyword-map)
- default bind)
- (while (setq default (pop defaults))
- (push (list (mail-source-strip-keyword (car default))
- nil)
- bind))
- bind)))
-
-(defun mail-source-set-common-1 (source)
- (let* ((type (pop source))
- (defaults mail-source-common-keyword-map)
- (defaults-1 (cdr (assq type mail-source-keyword-map)))
- default value keyword)
- (while (setq default (pop defaults))
- (set (mail-source-strip-keyword (setq keyword (car default)))
- (if (setq value (plist-get source keyword))
- (mail-source-value value)
- (if (setq value (assq keyword defaults-1))
- (mail-source-value (cadr value))
- (mail-source-value (cadr default))))))))
-
-(defmacro mail-source-bind-common (source &rest body)
- "Return a `let' form that binds all common variables.
-See `mail-source-bind'."
- `(let ,(mail-source-bind-common-1)
- (mail-source-set-common-1 source)
- ,@body))
-
-(put 'mail-source-bind-common 'lisp-indent-function 1)
-(put 'mail-source-bind-common 'edebug-form-spec '(sexp body))
-
-(defun mail-source-value (value)
- "Return the value of VALUE."
- (cond
- ;; String
- ((stringp value)
- value)
- ;; Function
- ((and (listp value) (symbolp (car value)) (fboundp (car value)))
- (eval value))
- ;; Just return the value.
- (t
- value)))
-
-(defun mail-source-fetch (source callback)
- "Fetch mail from SOURCE and call CALLBACK zero or more times.
-CALLBACK will be called with the name of the file where (some of)
-the mail from SOURCE is put.
-Return the number of files that were found."
- (mail-source-bind-common source
- (if (or mail-source-plugged plugged)
- (save-excursion
- (let ((function (cadr (assq (car source) mail-source-fetcher-alist)))
- (found 0))
- (unless function
- (error "%S is an invalid mail source specification" source))
- ;; If there's anything in the crash box, we do it first.
- (when (file-exists-p mail-source-crash-box)
- (message "Processing mail from %s..." mail-source-crash-box)
- (setq found (mail-source-callback
- callback mail-source-crash-box)))
- (+ found
- (if (or debug-on-quit debug-on-error)
- (funcall function source callback)
- (condition-case err
- (funcall function source callback)
- (error
- (if (and (not mail-source-ignore-errors)
- (not
- (yes-or-no-p
- (format "Mail source %s error (%s). Continue? "
- (if (memq ':password source)
- (let ((s (copy-sequence source)))
- (setcar (cdr (memq ':password s))
- "********")
- s)
- source)
- (cadr err)))))
- (error "Cannot get new mail"))
- 0)))))))))
-
-(defun mail-source-delete-old-incoming (&optional age confirm)
- "Remove incoming files older than AGE days.
-If CONFIRM is non-nil, ask for confirmation before removing a file."
- (interactive "P")
- (let* ((high2days (/ 65536.0 60 60 24));; convert high bits to days
- (low2days (/ 1.0 65536.0)) ;; convert low bits to days
- (diff (if (natnump age) age 30));; fallback, if no valid AGE given
- currday files)
- (setq files (directory-files
- mail-source-directory t
- (concat "\\`"
- (regexp-quote mail-source-incoming-file-prefix)))
- currday (* (car (current-time)) high2days)
- currday (+ currday (* low2days (nth 1 (current-time)))))
- (while files
- (let* ((ffile (car files))
- (bfile (gnus-replace-in-string
- ffile "\\`.*/\\([^/]+\\)\\'" "\\1"))
- (filetime (nth 5 (file-attributes ffile)))
- (fileday (* (car filetime) high2days))
- (fileday (+ fileday (* low2days (nth 1 filetime)))))
- (setq files (cdr files))
- (when (and (> (- currday fileday) diff)
- (if confirm
- (y-or-n-p
- (format "\
-Delete old (> %s day(s)) incoming mail file `%s'? " diff bfile))
- (gnus-message 8 "\
-Deleting old (> %s day(s)) incoming mail file `%s'." diff bfile)
- t))
- (delete-file ffile))))))
-
-(defun mail-source-callback (callback info)
- "Call CALLBACK on the mail file, and then remove the mail file.
-Pass INFO on to CALLBACK."
- (if (or (not (file-exists-p mail-source-crash-box))
- (zerop (nth 7 (file-attributes mail-source-crash-box))))
- (progn
- (when (file-exists-p mail-source-crash-box)
- (delete-file mail-source-crash-box))
- 0)
- (prog1
- (funcall callback mail-source-crash-box info)
- (when (file-exists-p mail-source-crash-box)
- ;; Delete or move the incoming mail out of the way.
- (if (eq mail-source-delete-incoming t)
- (delete-file mail-source-crash-box)
- (let ((incoming
- (mm-make-temp-file
- (expand-file-name
- mail-source-incoming-file-prefix
- mail-source-directory))))
- (unless (file-exists-p (file-name-directory incoming))
- (make-directory (file-name-directory incoming) t))
- (rename-file mail-source-crash-box incoming t)
- ;; remove old incoming files?
- (when (natnump mail-source-delete-incoming)
- (mail-source-delete-old-incoming
- mail-source-delete-incoming
- mail-source-delete-old-incoming-confirm))))))))
-
-(defun mail-source-movemail (from to)
- "Move FROM to TO using movemail."
- (if (not (file-writable-p to))
- (error "Can't write to crash box %s. Not moving mail" to)
- (let ((to (file-truename (expand-file-name to)))
- errors result)
- (setq to (file-truename to)
- from (file-truename from))
- ;; Set TO if have not already done so, and rename or copy
- ;; the file FROM to TO if and as appropriate.
- (cond
- ((file-exists-p to)
- ;; The crash box exists already.
- t)
- ((not (file-exists-p from))
- ;; There is no inbox.
- (setq to nil))
- ((zerop (nth 7 (file-attributes from)))
- ;; Empty file.
- (setq to nil))
- (t
- ;; If getting from mail spool directory, use movemail to move
- ;; rather than just renaming, so as to interlock with the
- ;; mailer.
- (unwind-protect
- (save-excursion
- (setq errors (generate-new-buffer " *mail source loss*"))
- (let ((default-directory "/"))
- (setq result
- (apply
- 'call-process
- (append
- (list
- (or mail-source-movemail-program
- (expand-file-name "movemail" exec-directory))
- nil errors nil from to)))))
- (when (file-exists-p to)
- (set-file-modes to mail-source-default-file-modes))
- (if (and (or (not (buffer-modified-p errors))
- (zerop (buffer-size errors)))
- (and (numberp result)
- (zerop result)))
- ;; No output => movemail won.
- t
- (set-buffer errors)
- ;; There may be a warning about older revisions. We
- ;; ignore that.
- (goto-char (point-min))
- (if (search-forward "older revision" nil t)
- t
- ;; Probably a real error.
- (subst-char-in-region (point-min) (point-max) ?\n ?\ )
- (goto-char (point-max))
- (skip-chars-backward " \t")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (when (looking-at "movemail: ")
- (delete-region (point-min) (match-end 0)))
- ;; Result may be a signal description string.
- (unless (yes-or-no-p
- (format "movemail: %s (%s return). Continue? "
- (buffer-string) result))
- (error "%s" (buffer-string)))
- (setq to nil)))))))
- (when (and errors
- (buffer-name errors))
- (kill-buffer errors))
- ;; Return whether we moved successfully or not.
- to)))
-
-(defun mail-source-movemail-and-remove (from to)
- "Move FROM to TO using movemail, then remove FROM if empty."
- (or (not (mail-source-movemail from to))
- (not (zerop (nth 7 (file-attributes from))))
- (delete-file from)))
-
-(defun mail-source-fetch-with-program (program)
- (eq 0 (call-process shell-file-name nil nil nil
- shell-command-switch program)))
-
-(defun mail-source-run-script (script spec &optional delay)
- (when script
- (if (functionp script)
- (funcall script)
- (mail-source-call-script
- (format-spec script spec))))
- (when delay
- (sleep-for delay)))
-
-(defun mail-source-call-script (script)
- (let ((background nil))
- (when (string-match "& *$" script)
- (setq script (substring script 0 (match-beginning 0))
- background 0))
- (call-process shell-file-name nil background nil
- shell-command-switch script)))
-
-;;;
-;;; Different fetchers
-;;;
-
-(defun mail-source-fetch-file (source callback)
- "Fetcher for single-file sources."
- (mail-source-bind (file source)
- (mail-source-run-script
- prescript (format-spec-make ?t mail-source-crash-box)
- prescript-delay)
- (let ((mail-source-string (format "file:%s" path)))
- (if (mail-source-movemail path mail-source-crash-box)
- (prog1
- (mail-source-callback callback path)
- (mail-source-run-script
- postscript (format-spec-make ?t mail-source-crash-box)))
- 0))))
-
-(defun mail-source-fetch-directory (source callback)
- "Fetcher for directory sources."
- (mail-source-bind (directory source)
- (mail-source-run-script
- prescript (format-spec-make ?t path) prescript-delay)
- (let ((found 0)
- (mail-source-string (format "directory:%s" path)))
- (dolist (file (directory-files
- path t (concat (regexp-quote suffix) "$")))
- (when (and (file-regular-p file)
- (funcall predicate file)
- (mail-source-movemail file mail-source-crash-box))
- (incf found (mail-source-callback callback file))))
- (mail-source-run-script postscript (format-spec-make ?t path))
- found)))
-
-(defun mail-source-fetch-pop (source callback)
- "Fetcher for single-file sources."
- (mail-source-bind (pop source)
- (mail-source-run-script
- prescript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
- prescript-delay)
- (let ((from (format "%s:%s:%s" server user port))
- (mail-source-string (format "pop:%s@%s" user server))
- result)
- (when (eq authentication 'password)
- (setq password
- (or password
- (cdr (assoc from mail-source-password-cache))
- (read-passwd
- (format "Password for %s at %s: " user server)))))
- (when server
- (setenv "MAILHOST" server))
- (setq result
- (cond
- (program
- (mail-source-fetch-with-program
- (format-spec
- program
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))))
- (function
- (funcall function mail-source-crash-box))
- ;; The default is to use pop3.el.
- (t
- (require 'pop3)
- (let ((pop3-password password)
- (pop3-maildrop user)
- (pop3-mailhost server)
- (pop3-port port)
- (pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass)))
- (if (or debug-on-quit debug-on-error)
- (save-excursion (pop3-movemail mail-source-crash-box))
- (condition-case err
- (save-excursion (pop3-movemail mail-source-crash-box))
- (error
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache))
- (signal (car err) (cdr err)))))))))
- (if result
- (progn
- (when (eq authentication 'password)
- (unless (assoc from mail-source-password-cache)
- (push (cons from password) mail-source-password-cache)))
- (prog1
- (mail-source-callback callback server)
- ;; Update display-time's mail flag, if relevant.
- (if (equal source mail-source-primary-source)
- (setq mail-source-new-mail-available nil))
- (mail-source-run-script
- postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))))
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache))
- 0))))
-
-(defun mail-source-check-pop (source)
- "Check whether there is new mail."
- (mail-source-bind (pop source)
- (let ((from (format "%s:%s:%s" server user port))
- (mail-source-string (format "pop:%s@%s" user server))
- result)
- (when (eq authentication 'password)
- (setq password
- (or password
- (cdr (assoc from mail-source-password-cache))
- (read-passwd
- (format "Password for %s at %s: " user server))))
- (unless (assoc from mail-source-password-cache)
- (push (cons from password) mail-source-password-cache)))
- (when server
- (setenv "MAILHOST" server))
- (setq result
- (cond
- ;; No easy way to check whether mail is waiting for these.
- (program)
- (function)
- ;; The default is to use pop3.el.
- (t
- (require 'pop3)
- (let ((pop3-password password)
- (pop3-maildrop user)
- (pop3-mailhost server)
- (pop3-port port)
- (pop3-authentication-scheme
- (if (eq authentication 'apop) 'apop 'pass)))
- (if (or debug-on-quit debug-on-error)
- (save-excursion (pop3-get-message-count))
- (condition-case err
- (save-excursion (pop3-get-message-count))
- (error
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache))
- (signal (car err) (cdr err)))))))))
- (if result
- ;; Inform display-time that we have new mail.
- (setq mail-source-new-mail-available (> result 0))
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache)))
- result)))
-
-(defun mail-source-touch-pop ()
- "Open and close a POP connection shortly.
-POP server should be defined in `mail-source-primary-source' (which is
-preferred) or `mail-sources'. You may use it for the POP-before-SMTP
-authentication. To do that, you need to set the
-`message-send-mail-function' variable as `message-smtpmail-send-it'
-and put the following line in your ~/.gnus.el file:
-
-\(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
-
-See the Gnus manual for details."
- (let ((sources (if mail-source-primary-source
- (list mail-source-primary-source)
- mail-sources)))
- (while sources
- (if (eq 'pop (car (car sources)))
- (mail-source-check-pop (car sources)))
- (setq sources (cdr sources)))))
-
-(defun mail-source-new-mail-p ()
- "Handler for `display-time' to indicate when new mail is available."
- ;; Flash (ie. ring the visible bell) if mail is available.
- (if (and mail-source-flash mail-source-new-mail-available)
- (let ((visible-bell t))
- (ding)))
- ;; Only report flag setting; flag is updated on a different schedule.
- mail-source-new-mail-available)
-
-
-(defvar mail-source-report-new-mail nil)
-(defvar mail-source-report-new-mail-timer nil)
-(defvar mail-source-report-new-mail-idle-timer nil)
-
-(eval-when-compile
- (if (featurep 'xemacs)
- (require 'timer-funcs)
- (require 'timer)))
-
-(defun mail-source-start-idle-timer ()
- ;; Start our idle timer if necessary, so we delay the check until the
- ;; user isn't typing.
- (unless mail-source-report-new-mail-idle-timer
- (setq mail-source-report-new-mail-idle-timer
- (run-with-idle-timer
- mail-source-idle-time-delay
- nil
- (lambda ()
- (unwind-protect
- (mail-source-check-pop mail-source-primary-source)
- (setq mail-source-report-new-mail-idle-timer nil)))))
- ;; Since idle timers created when Emacs is already in the idle
- ;; state don't get activated until Emacs _next_ becomes idle, we
- ;; need to force our timer to be considered active now. We do
- ;; this by being naughty and poking the timer internals directly
- ;; (element 0 of the vector is nil if the timer is active).
- (aset mail-source-report-new-mail-idle-timer 0 nil)))
-
-(defun mail-source-report-new-mail (arg)
- "Toggle whether to report when new mail is available.
-This only works when `display-time' is enabled."
- (interactive "P")
- (if (not mail-source-primary-source)
- (error "Need to set `mail-source-primary-source' to check for new mail"))
- (let ((on (if (null arg)
- (not mail-source-report-new-mail)
- (> (prefix-numeric-value arg) 0))))
- (setq mail-source-report-new-mail on)
- (and mail-source-report-new-mail-timer
- (nnheader-cancel-timer mail-source-report-new-mail-timer))
- (and mail-source-report-new-mail-idle-timer
- (nnheader-cancel-timer mail-source-report-new-mail-idle-timer))
- (setq mail-source-report-new-mail-timer nil)
- (setq mail-source-report-new-mail-idle-timer nil)
- (if on
- (progn
- (require 'time)
- ;; display-time-mail-function is an Emacs 21 feature.
- (setq display-time-mail-function #'mail-source-new-mail-p)
- ;; Set up the main timer.
- (setq mail-source-report-new-mail-timer
- (nnheader-run-at-time
- (* 60 mail-source-report-new-mail-interval)
- (* 60 mail-source-report-new-mail-interval)
- #'mail-source-start-idle-timer))
- ;; When you get new mail, clear "Mail" from the mode line.
- (add-hook 'nnmail-post-get-new-mail-hook
- 'display-time-event-handler)
- (message "Mail check enabled"))
- (setq display-time-mail-function nil)
- (remove-hook 'nnmail-post-get-new-mail-hook
- 'display-time-event-handler)
- (message "Mail check disabled"))))
-
-(defun mail-source-fetch-maildir (source callback)
- "Fetcher for maildir sources."
- (mail-source-bind (maildir source)
- (let ((found 0)
- mail-source-string)
- (unless (string-match "/$" path)
- (setq path (concat path "/")))
- (dolist (subdir subdirs)
- (when (file-directory-p (concat path subdir))
- (setq mail-source-string (format "maildir:%s%s" path subdir))
- (dolist (file (directory-files (concat path subdir) t))
- (when (and (not (file-directory-p file))
- (not (if function
- (funcall function file mail-source-crash-box)
- (let ((coding-system-for-write
- mm-text-coding-system)
- (coding-system-for-read
- mm-text-coding-system))
- (with-temp-file mail-source-crash-box
- (insert-file-contents file)
- (goto-char (point-min))
-;;; ;; Unix mail format
-;;; (unless (looking-at "\n*From ")
-;;; (insert "From maildir "
-;;; (current-time-string) "\n"))
-;;; (while (re-search-forward "^From " nil t)
-;;; (replace-match ">From "))
-;;; (goto-char (point-max))
-;;; (insert "\n\n")
- ;; MMDF mail format
- (insert "\001\001\001\001\n"))
- (delete-file file)))))
- (incf found (mail-source-callback callback file))))))
- found)))
-
-(eval-and-compile
- (autoload 'imap-open "imap")
- (autoload 'imap-authenticate "imap")
- (autoload 'imap-mailbox-select "imap")
- (autoload 'imap-mailbox-unselect "imap")
- (autoload 'imap-mailbox-close "imap")
- (autoload 'imap-search "imap")
- (autoload 'imap-fetch "imap")
- (autoload 'imap-close "imap")
- (autoload 'imap-error-text "imap")
- (autoload 'imap-message-flags-add "imap")
- (autoload 'imap-list-to-message-set "imap")
- (autoload 'imap-range-to-message-set "imap")
- (autoload 'nnheader-ms-strip-cr "nnheader"))
-
-(defvar mail-source-imap-file-coding-system 'binary
- "Coding system for the crashbox made by `mail-source-fetch-imap'.")
-
-(defun mail-source-fetch-imap (source callback)
- "Fetcher for imap sources."
- (mail-source-bind (imap source)
- (mail-source-run-script
- prescript (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user)
- prescript-delay)
- (let ((from (format "%s:%s:%s" server user port))
- (found 0)
- (buf (generate-new-buffer " *imap source*"))
- (mail-source-string (format "imap:%s:%s" server mailbox))
- (imap-shell-program (or (list program) imap-shell-program))
- remove)
- (if (and (imap-open server port stream authentication buf)
- (imap-authenticate
- user (or (cdr (assoc from mail-source-password-cache))
- password) buf)
- (imap-mailbox-select mailbox nil buf))
- (let ((coding-system-for-write mail-source-imap-file-coding-system)
- str)
- (with-temp-file mail-source-crash-box
- ;; Avoid converting 8-bit chars from inserted strings to
- ;; multibyte.
- (mm-disable-multibyte)
- ;; remember password
- (with-current-buffer buf
- (when (and imap-password
- (not (assoc from mail-source-password-cache)))
- (push (cons from imap-password) mail-source-password-cache)))
- ;; if predicate is nil, use all uids
- (dolist (uid (imap-search (or predicate "1:*") buf))
- (when (setq str
- (if (imap-capability 'IMAP4rev1 buf)
- (caddar (imap-fetch uid "BODY.PEEK[]"
- 'BODYDETAIL nil buf))
- (imap-fetch uid "RFC822.PEEK" 'RFC822 nil buf)))
- (push uid remove)
- (insert "From imap " (current-time-string) "\n")
- (save-excursion
- (insert str "\n\n"))
- (while (re-search-forward "^From " nil t)
- (replace-match ">From "))
- (goto-char (point-max))))
- (nnheader-ms-strip-cr))
- (incf found (mail-source-callback callback server))
- (when (and remove fetchflag)
- (setq remove (nreverse remove))
- (imap-message-flags-add
- (imap-range-to-message-set (gnus-compress-sequence remove))
- fetchflag nil buf))
- (if dontexpunge
- (imap-mailbox-unselect buf)
- (imap-mailbox-close nil buf))
- (imap-close buf))
- (imap-close buf)
- ;; We nix out the password in case the error
- ;; was because of a wrong password being given.
- (setq mail-source-password-cache
- (delq (assoc from mail-source-password-cache)
- mail-source-password-cache))
- (error "IMAP error: %s" (imap-error-text buf)))
- (kill-buffer buf)
- (mail-source-run-script
- postscript
- (format-spec-make ?p password ?t mail-source-crash-box
- ?s server ?P port ?u user))
- found)))
-
-(eval-and-compile
- (autoload 'webmail-fetch "webmail"))
-
-(defun mail-source-fetch-webmail (source callback)
- "Fetch for webmail source."
- (mail-source-bind (webmail source)
- (let ((mail-source-string (format "webmail:%s:%s" subtype user))
- (webmail-newmail-only dontexpunge)
- (webmail-move-to-trash-can (not dontexpunge)))
- (when (eq authentication 'password)
- (setq password
- (or password
- (cdr (assoc (format "webmail:%s:%s" subtype user)
- mail-source-password-cache))
- (read-passwd
- (format "Password for %s at %s: " user subtype))))
- (when (and password
- (not (assoc (format "webmail:%s:%s" subtype user)
- mail-source-password-cache)))
- (push (cons (format "webmail:%s:%s" subtype user) password)
- mail-source-password-cache)))
- (webmail-fetch mail-source-crash-box subtype user password)
- (mail-source-callback callback (symbol-name subtype)))))
-
-(provide 'mail-source)
-
-;;; arch-tag: 72948025-1d17-4d6c-bb12-ef1aa2c490fd
-;;; mail-source.el ends here
+++ /dev/null
-;;; mailcap.el --- MIME media types configuration
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: William M. Perry <wmperry@aventail.com>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail, multimedia
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Provides configuration of MIME media types from directly from Lisp
-;; and via the usual mailcap mechanism (RFC 1524). Deals with
-;; mime.types similarly.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mm-util)
-
-(defgroup mailcap nil
- "Definition of viewers for MIME types."
- :version "21.1"
- :group 'mime)
-
-(defvar mailcap-parse-args-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?' "\"" table)
- (modify-syntax-entry ?` "\"" table)
- (modify-syntax-entry ?{ "(" table)
- (modify-syntax-entry ?} ")" table)
- table)
- "A syntax table for parsing SGML attributes.")
-
-(eval-and-compile
- (when (featurep 'xemacs)
- (condition-case nil
- (require 'lpr)
- (error nil))))
-
-(defvar mailcap-print-command
- (mapconcat 'identity
- (cons (if (boundp 'lpr-command)
- lpr-command
- "lpr")
- (when (boundp 'lpr-switches)
- (if (stringp lpr-switches)
- (list lpr-switches)
- lpr-switches)))
- " ")
- "Shell command (including switches) used to print Postscript files.")
-
-;; Postpone using defcustom for this as it's so big and we essentially
-;; have to have two copies of the data around then. Perhaps just
-;; customize the Lisp viewers and rely on the normal configuration
-;; files for the rest? -- fx
-(defvar mailcap-mime-data
- `(("application"
- ("vnd.ms-excel"
- (viewer . "gnumeric %s")
- (test . (getenv "DISPLAY"))
- (type . "application/vnd.ms-excel"))
- ("x-x509-ca-cert"
- (viewer . ssl-view-site-cert)
- (test . (fboundp 'ssl-view-site-cert))
- (type . "application/x-x509-ca-cert"))
- ("x-x509-user-cert"
- (viewer . ssl-view-user-cert)
- (test . (fboundp 'ssl-view-user-cert))
- (type . "application/x-x509-user-cert"))
- ("octet-stream"
- (viewer . mailcap-save-binary-file)
- (non-viewer . t)
- (type . "application/octet-stream"))
- ("dvi"
- (viewer . "xdvi -safer %s")
- (test . (eq window-system 'x))
- ("needsx11")
- (type . "application/dvi")
- ("print" . "dvips -qRP %s"))
- ("dvi"
- (viewer . "dvitty %s")
- (test . (not (getenv "DISPLAY")))
- (type . "application/dvi")
- ("print" . "dvips -qRP %s"))
- ("emacs-lisp"
- (viewer . mailcap-maybe-eval)
- (type . "application/emacs-lisp"))
- ("x-emacs-lisp"
- (viewer . mailcap-maybe-eval)
- (type . "application/x-emacs-lisp"))
- ("x-tar"
- (viewer . mailcap-save-binary-file)
- (non-viewer . t)
- (type . "application/x-tar"))
- ("x-latex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/x-latex"))
- ("x-tex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/x-tex"))
- ("latex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/latex"))
- ("tex"
- (viewer . tex-mode)
- (test . (fboundp 'tex-mode))
- (type . "application/tex"))
- ("texinfo"
- (viewer . texinfo-mode)
- (test . (fboundp 'texinfo-mode))
- (type . "application/tex"))
- ("zip"
- (viewer . mailcap-save-binary-file)
- (non-viewer . t)
- (type . "application/zip")
- ("copiousoutput"))
- ("pdf"
- (viewer . "gv -safer %s")
- (type . "application/pdf")
- (test . window-system)
- ("print" . ,(concat "pdf2ps %s - | " mailcap-print-command)))
- ("pdf"
- (viewer . "gpdf %s")
- (type . "application/pdf")
- ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
- (test . (eq window-system 'x)))
- ("pdf"
- (viewer . "xpdf %s")
- (type . "application/pdf")
- ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
- (test . (eq window-system 'x)))
- ("pdf"
- (viewer . ,(concat "pdftotext %s -"))
- (type . "application/pdf")
- ("print" . ,(concat "pdftops %s - | " mailcap-print-command))
- ("copiousoutput"))
- ("postscript"
- (viewer . "gv -safer %s")
- (type . "application/postscript")
- (test . window-system)
- ("print" . ,(concat mailcap-print-command " %s"))
- ("needsx11"))
- ("postscript"
- (viewer . "ghostview -dSAFER %s")
- (type . "application/postscript")
- (test . (eq window-system 'x))
- ("print" . ,(concat mailcap-print-command " %s"))
- ("needsx11"))
- ("postscript"
- (viewer . "ps2ascii %s")
- (type . "application/postscript")
- (test . (not (getenv "DISPLAY")))
- ("print" . ,(concat mailcap-print-command " %s"))
- ("copiousoutput"))
- ("sieve"
- (viewer . sieve-mode)
- (test . (fboundp 'sieve-mode))
- (type . "application/sieve"))
- ("pgp-keys"
- (viewer . "gpg --import --interactive --verbose")
- (type . "application/pgp-keys")
- ("needsterminal")))
- ("audio"
- ("x-mpeg"
- (viewer . "maplay %s")
- (type . "audio/x-mpeg"))
- (".*"
- (viewer . "showaudio")
- (type . "audio/*")))
- ("message"
- ("rfc-*822"
- (viewer . mm-view-message)
- (test . (and (featurep 'gnus)
- (gnus-alive-p)))
- (type . "message/rfc822"))
- ("rfc-*822"
- (viewer . vm-mode)
- (test . (fboundp 'vm-mode))
- (type . "message/rfc822"))
- ("rfc-*822"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "message/rfc822"))
- ("rfc-*822"
- (viewer . view-mode)
- (type . "message/rfc822")))
- ("image"
- ("x-xwd"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq window-system 'x))
- ("needsx11"))
- ("x11-dump"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq window-system 'x))
- ("needsx11"))
- ("windowdump"
- (viewer . "xwud -in %s")
- (type . "image/x-xwd")
- ("compose" . "xwd -frame > %s")
- (test . (eq window-system 'x))
- ("needsx11"))
- (".*"
- (viewer . "display %s")
- (type . "image/*")
- (test . (eq window-system 'x))
- ("needsx11"))
- (".*"
- (viewer . "ee %s")
- (type . "image/*")
- (test . (eq window-system 'x))
- ("needsx11")))
- ("text"
- ("plain"
- (viewer . w3-mode)
- (test . (fboundp 'w3-mode))
- (type . "text/plain"))
- ("plain"
- (viewer . view-mode)
- (test . (fboundp 'view-mode))
- (type . "text/plain"))
- ("plain"
- (viewer . fundamental-mode)
- (type . "text/plain"))
- ("enriched"
- (viewer . enriched-decode)
- (test . (fboundp 'enriched-decode))
- (type . "text/enriched"))
- ("html"
- (viewer . mm-w3-prepare-buffer)
- (test . (fboundp 'w3-prepare-buffer))
- (type . "text/html")))
- ("video"
- ("mpeg"
- (viewer . "mpeg_play %s")
- (type . "video/mpeg")
- (test . (eq window-system 'x))
- ("needsx11")))
- ("x-world"
- ("x-vrml"
- (viewer . "webspace -remote %s -URL %u")
- (type . "x-world/x-vrml")
- ("description"
- "VRML document")))
- ("archive"
- ("tar"
- (viewer . tar-mode)
- (type . "archive/tar")
- (test . (fboundp 'tar-mode)))))
- "The mailcap structure is an assoc list of assoc lists.
-1st assoc list is keyed on the major content-type
-2nd assoc list is keyed on the minor content-type (which can be a regexp)
-
-Which looks like:
------------------
- ((\"application\"
- (\"postscript\" . <info>))
- (\"text\"
- (\"plain\" . <info>)))
-
-Where <info> is another assoc list of the various information
-related to the mailcap RFC 1524. This is keyed on the lowercase
-attribute name (viewer, test, etc). This looks like:
- ((viewer . VIEWERINFO)
- (test . TESTINFO)
- (xxxx . \"STRING\")
- FLAG)
-
-Where VIEWERINFO specifies how the content-type is viewed. Can be
-a string, in which case it is run through a shell, with
-appropriate parameters, or a symbol, in which case the symbol is
-`funcall'ed, with the buffer as an argument.
-
-TESTINFO is a test for the viewer's applicability, or nil. If nil, it
-means the viewer is always valid. If it is a Lisp function, it is
-called with a list of items from any extra fields from the
-Content-Type header as argument to return a boolean value for the
-validity. Otherwise, if it is a non-function Lisp symbol or list
-whose car is a symbol, it is `eval'led to yield the validity. If it
-is a string or list of strings, it represents a shell command to run
-to return a true or false shell value for the validity.")
-(put 'mailcap-mime-data 'risky-local-variable t)
-
-(defcustom mailcap-download-directory nil
- "*Directory to which `mailcap-save-binary-file' downloads files by default.
-nil means your home directory."
- :type '(choice (const :tag "Home directory" nil)
- directory)
- :group 'mailcap)
-
-(defvar mailcap-poor-system-types
- '(ms-dos ms-windows windows-nt win32 w32 mswindows)
- "Systems that don't have a Unix-like directory hierarchy.")
-
-;;;
-;;; Utility functions
-;;;
-
-(defun mailcap-save-binary-file ()
- (goto-char (point-min))
- (unwind-protect
- (let ((file (read-file-name
- "Filename to save as: "
- (or mailcap-download-directory "~/")))
- (require-final-newline nil))
- (write-region (point-min) (point-max) file))
- (kill-buffer (current-buffer))))
-
-(defvar mailcap-maybe-eval-warning
- "*** WARNING ***
-
-This MIME part contains untrusted and possibly harmful content.
-If you evaluate the Emacs Lisp code contained in it, a lot of nasty
-things can happen. Please examine the code very carefully before you
-instruct Emacs to evaluate it. You can browse the buffer containing
-the code using \\[scroll-other-window].
-
-If you are unsure what to do, please answer \"no\"."
- "Text of warning message displayed by `mailcap-maybe-eval'.
-Make sure that this text consists only of few text lines. Otherwise,
-Gnus might fail to display all of it.")
-
-(defun mailcap-maybe-eval ()
- "Maybe evaluate a buffer of Emacs Lisp code."
- (let ((lisp-buffer (current-buffer)))
- (goto-char (point-min))
- (when
- (save-window-excursion
- (delete-other-windows)
- (let ((buffer (get-buffer-create (generate-new-buffer-name
- "*Warning*"))))
- (unwind-protect
- (with-current-buffer buffer
- (insert (substitute-command-keys
- mailcap-maybe-eval-warning))
- (goto-char (point-min))
- (display-buffer buffer)
- (yes-or-no-p "This is potentially dangerous emacs-lisp code, evaluate it? "))
- (kill-buffer buffer))))
- (eval-buffer (current-buffer)))
- (when (buffer-live-p lisp-buffer)
- (with-current-buffer lisp-buffer
- (emacs-lisp-mode)))))
-
-
-;;;
-;;; The mailcap parser
-;;;
-
-(defun mailcap-replace-regexp (regexp to-string)
- ;; Quiet replace-regexp.
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (replace-match to-string t nil)))
-
-(defvar mailcap-parsed-p nil)
-
-(defun mailcap-parse-mailcaps (&optional path force)
- "Parse out all the mailcaps specified in a path string PATH.
-Components of PATH are separated by the `path-separator' character
-appropriate for this system. If FORCE, re-parse even if already
-parsed. If PATH is omitted, use the value of environment variable
-MAILCAPS if set; otherwise (on Unix) use the path from RFC 1524, plus
-/usr/local/etc/mailcap."
- (interactive (list nil t))
- (when (or (not mailcap-parsed-p)
- force)
- (cond
- (path nil)
- ((getenv "MAILCAPS") (setq path (getenv "MAILCAPS")))
- ((memq system-type mailcap-poor-system-types)
- (setq path '("~/.mailcap" "~/mail.cap" "~/etc/mail.cap")))
- (t (setq path
- ;; This is per RFC 1524, specifically
- ;; with /usr before /usr/local.
- '("~/.mailcap" "/etc/mailcap" "/usr/etc/mailcap"
- "/usr/local/etc/mailcap"))))
- (let ((fnames (reverse
- (if (stringp path)
- (delete "" (split-string path path-separator))
- path)))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-readable-p fname)
- (file-regular-p fname))
- (mailcap-parse-mailcap fname))
- (setq fnames (cdr fnames))))
- (setq mailcap-parsed-p t)))
-
-(defun mailcap-parse-mailcap (fname)
- "Parse out the mailcap file specified by FNAME."
- (let (major ; The major mime type (image/audio/etc)
- minor ; The minor mime type (gif, basic, etc)
- save-pos ; Misc saved positions used in parsing
- viewer ; How to view this mime type
- info ; Misc info about this mime type
- )
- (with-temp-buffer
- (insert-file-contents fname)
- (set-syntax-table mailcap-parse-args-syntax-table)
- (mailcap-replace-regexp "#.*" "") ; Remove all comments
- (mailcap-replace-regexp "\\\\[ \t]*\n" " ") ; And collapse spaces
- (mailcap-replace-regexp "\n+" "\n") ; And blank lines
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (while (not (bobp))
- (skip-chars-backward " \t\n")
- (beginning-of-line)
- (setq save-pos (point)
- info nil)
- (skip-chars-forward "^/; \t\n")
- (downcase-region save-pos (point))
- (setq major (buffer-substring save-pos (point)))
- (skip-chars-forward " \t")
- (setq minor "")
- (when (eq (char-after) ?/)
- (forward-char)
- (skip-chars-forward " \t")
- (setq save-pos (point))
- (skip-chars-forward "^; \t\n")
- (downcase-region save-pos (point))
- (setq minor
- (cond
- ((eq ?* (or (char-after save-pos) 0)) ".*")
- ((= (point) save-pos) ".*")
- (t (regexp-quote (buffer-substring save-pos (point)))))))
- (skip-chars-forward " \t")
- ;;; Got the major/minor chunks, now for the viewers/etc
- ;;; The first item _must_ be a viewer, according to the
- ;;; RFC for mailcap files (#1524)
- (setq viewer "")
- (when (eq (char-after) ?\;)
- (forward-char)
- (skip-chars-forward " \t")
- (setq save-pos (point))
- (skip-chars-forward "^;\n")
- ;; skip \;
- (while (eq (char-before) ?\\)
- (backward-delete-char 1)
- (forward-char)
- (skip-chars-forward "^;\n"))
- (if (eq (or (char-after save-pos) 0) ?')
- (setq viewer (progn
- (narrow-to-region (1+ save-pos) (point))
- (goto-char (point-min))
- (prog1
- (read (current-buffer))
- (goto-char (point-max))
- (widen))))
- (setq viewer (buffer-substring save-pos (point)))))
- (setq save-pos (point))
- (end-of-line)
- (unless (equal viewer "")
- (setq info (nconc (list (cons 'viewer viewer)
- (cons 'type (concat major "/"
- (if (string= minor ".*")
- "*" minor))))
- (mailcap-parse-mailcap-extras save-pos (point))))
- (mailcap-mailcap-entry-passes-test info)
- (mailcap-add-mailcap-entry major minor info))
- (beginning-of-line)))))
-
-(defun mailcap-parse-mailcap-extras (st nd)
- "Grab all the extra stuff from a mailcap entry."
- (let (
- name ; From name=
- value ; its value
- results ; Assoc list of results
- name-pos ; Start of XXXX= position
- val-pos ; Start of value position
- done ; Found end of \'d ;s?
- )
- (save-restriction
- (narrow-to-region st nd)
- (goto-char (point-min))
- (skip-chars-forward " \n\t;")
- (while (not (eobp))
- (setq done nil)
- (setq name-pos (point))
- (skip-chars-forward "^ \n\t=;")
- (downcase-region name-pos (point))
- (setq name (buffer-substring name-pos (point)))
- (skip-chars-forward " \t\n")
- (if (not (eq (char-after (point)) ?=)) ; There is no value
- (setq value t)
- (skip-chars-forward " \t\n=")
- (setq val-pos (point))
- (if (memq (char-after val-pos) '(?\" ?'))
- (progn
- (setq val-pos (1+ val-pos))
- (condition-case nil
- (progn
- (forward-sexp 1)
- (backward-char 1))
- (error (goto-char (point-max)))))
- (while (not done)
- (skip-chars-forward "^;")
- (if (eq (char-after (1- (point))) ?\\ )
- (progn
- (subst-char-in-region (1- (point)) (point) ?\\ ? )
- (skip-chars-forward ";"))
- (setq done t))))
- (setq value (buffer-substring val-pos (point))))
- ;; `test' as symbol, others like "copiousoutput" and "needsx11" as
- ;; strings
- (setq results (cons (cons (if (string-equal name "test")
- 'test
- name)
- value) results))
- (skip-chars-forward " \";\n\t"))
- results)))
-
-(defun mailcap-mailcap-entry-passes-test (info)
- "Return non-nil if mailcap entry INFO passes its test clause.
-Also return non-nil if no test clause is present."
- (let ((test (assq 'test info)) ; The test clause
- status)
- (setq status (and test (split-string (cdr test) " ")))
- (if (and (or (assoc "needsterm" info)
- (assoc "needsterminal" info)
- (assoc "needsx11" info))
- (not (getenv "DISPLAY")))
- (setq status nil)
- (cond
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-n")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") t nil)))
- ((and (equal (nth 0 status) "test")
- (equal (nth 1 status) "-z")
- (or (equal (nth 2 status) "$DISPLAY")
- (equal (nth 2 status) "\"$DISPLAY\"")))
- (setq status (if (getenv "DISPLAY") nil t)))
- (test nil)
- (t nil)))
- (and test (listp test) (setcdr test status))))
-
-;;;
-;;; The action routines.
-;;;
-
-(defun mailcap-possible-viewers (major minor)
- "Return a list of possible viewers from MAJOR for minor type MINOR."
- (let ((exact '())
- (wildcard '()))
- (while major
- (cond
- ((equal (car (car major)) minor)
- (setq exact (cons (cdr (car major)) exact)))
- ((and minor (string-match (concat "^" (car (car major)) "$") minor))
- (setq wildcard (cons (cdr (car major)) wildcard))))
- (setq major (cdr major)))
- (nconc exact wildcard)))
-
-(defun mailcap-unescape-mime-test (test type-info)
- (let (save-pos save-chr subst)
- (cond
- ((symbolp test) test)
- ((and (listp test) (symbolp (car test))) test)
- ((or (stringp test)
- (and (listp test) (stringp (car test))
- (setq test (mapconcat 'identity test " "))))
- (with-temp-buffer
- (insert test)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^%")
- (if (/= (- (point)
- (progn (skip-chars-backward "\\\\")
- (point)))
- 0) ; It is an escaped %
- (progn
- (delete-char 1)
- (skip-chars-forward "%."))
- (setq save-pos (point))
- (skip-chars-forward "%")
- (setq save-chr (char-after (point)))
- ;; Escapes:
- ;; %s: name of a file for the body data
- ;; %t: content-type
- ;; %{<parameter name}: value of parameter in mailcap entry
- ;; %n: number of sub-parts for multipart content-type
- ;; %F: a set of content-type/filename pairs for multiparts
- (cond
- ((null save-chr) nil)
- ((= save-chr ?t)
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert (or (cdr (assq 'type type-info)) "\"\"")))
- ((memq save-chr '(?M ?n ?F))
- (delete-region save-pos (progn (forward-char 1) (point)))
- (insert "\"\""))
- ((= save-chr ?{)
- (forward-char 1)
- (skip-chars-forward "^}")
- (downcase-region (+ 2 save-pos) (point))
- (setq subst (buffer-substring (+ 2 save-pos) (point)))
- (delete-region save-pos (1+ (point)))
- (insert (or (cdr (assoc subst type-info)) "\"\"")))
- (t nil))))
- (buffer-string)))
- (t (error "Bad value to mailcap-unescape-mime-test: %s" test)))))
-
-(defvar mailcap-viewer-test-cache nil)
-
-(defun mailcap-viewer-passes-test (viewer-info type-info)
- "Return non-nil if viewer specified by VIEWER-INFO passes its test clause.
-Also return non-nil if it has no test clause. TYPE-INFO is an argument
-to supply to the test."
- (let* ((test-info (assq 'test viewer-info))
- (test (cdr test-info))
- (otest test)
- (viewer (cdr (assoc 'viewer viewer-info)))
- (default-directory (expand-file-name "~/"))
- status parsed-test cache result)
- (cond ((setq cache (assoc test mailcap-viewer-test-cache))
- (cadr cache))
- ((not test-info) t) ; No test clause
- (t
- (setq
- result
- (cond
- ((not test) nil) ; Already failed test
- ((eq test t) t) ; Already passed test
- ((functionp test) ; Lisp function as test
- (funcall test type-info))
- ((and (symbolp test) ; Lisp variable as test
- (boundp test))
- (symbol-value test))
- ((and (listp test) ; List to be eval'd
- (symbolp (car test)))
- (eval test))
- (t
- (setq test (mailcap-unescape-mime-test test type-info)
- test (list shell-file-name nil nil nil
- shell-command-switch test)
- status (apply 'call-process test))
- (eq 0 status))))
- (push (list otest result) mailcap-viewer-test-cache)
- result))))
-
-(defun mailcap-add-mailcap-entry (major minor info)
- (let ((old-major (assoc major mailcap-mime-data)))
- (if (null old-major) ; New major area
- (setq mailcap-mime-data
- (cons (cons major (list (cons minor info)))
- mailcap-mime-data))
- (let ((cur-minor (assoc minor old-major)))
- (cond
- ((or (null cur-minor) ; New minor area, or
- (assq 'test info)) ; Has a test, insert at beginning
- (setcdr old-major (cons (cons minor info) (cdr old-major))))
- ((and (not (assq 'test info)) ; No test info, replace completely
- (not (assq 'test cur-minor))
- (equal (assq 'viewer info) ; Keep alternative viewer
- (assq 'viewer cur-minor)))
- (setcdr cur-minor info))
- (t
- (setcdr old-major (cons (cons minor info) (cdr old-major))))))
- )))
-
-(defun mailcap-add (type viewer &optional test)
- "Add VIEWER as a handler for TYPE.
-If TEST is not given, it defaults to t."
- (let ((tl (split-string type "/")))
- (when (or (not (car tl))
- (not (cadr tl)))
- (error "%s is not a valid MIME type" type))
- (mailcap-add-mailcap-entry
- (car tl) (cadr tl)
- `((viewer . ,viewer)
- (test . ,(if test test t))
- (type . ,type)))))
-
-;;;
-;;; The main whabbo
-;;;
-
-(defun mailcap-viewer-lessp (x y)
- "Return t if viewer X is more desirable than viewer Y."
- (let ((x-wild (string-match "[*?]" (or (cdr-safe (assq 'type x)) "")))
- (y-wild (string-match "[*?]" (or (cdr-safe (assq 'type y)) "")))
- (x-lisp (not (stringp (or (cdr-safe (assq 'viewer x)) ""))))
- (y-lisp (not (stringp (or (cdr-safe (assq 'viewer y)) "")))))
- (cond
- ((and x-wild (not y-wild))
- nil)
- ((and (not x-wild) y-wild)
- t)
- ((and (not y-lisp) x-lisp)
- t)
- (t nil))))
-
-(defun mailcap-mime-info (string &optional request)
- "Get the MIME viewer command for STRING, return nil if none found.
-Expects a complete content-type header line as its argument.
-
-Second argument REQUEST specifies what information to return. If it is
-nil or the empty string, the viewer (second field of the mailcap
-entry) will be returned. If it is a string, then the mailcap field
-corresponding to that string will be returned (print, description,
-whatever). If a number, then all the information for this specific
-viewer is returned. If `all', then all possible viewers for
-this type is returned."
- (let (
- major ; Major encoding (text, etc)
- minor ; Minor encoding (html, etc)
- info ; Other info
- save-pos ; Misc. position during parse
- major-info ; (assoc major mailcap-mime-data)
- minor-info ; (assoc minor major-info)
- test ; current test proc.
- viewers ; Possible viewers
- passed ; Viewers that passed the test
- viewer ; The one and only viewer
- ctl)
- (save-excursion
- (setq ctl (mail-header-parse-content-type (or string "text/plain")))
- (setq major (split-string (car ctl) "/"))
- (setq minor (cadr major)
- major (car major))
- (when (setq major-info (cdr (assoc major mailcap-mime-data)))
- (when (setq viewers (mailcap-possible-viewers major-info minor))
- (setq info (mapcar (lambda (a) (cons (symbol-name (car a))
- (cdr a)))
- (cdr ctl)))
- (while viewers
- (if (mailcap-viewer-passes-test (car viewers) info)
- (setq passed (cons (car viewers) passed)))
- (setq viewers (cdr viewers)))
- (setq passed (sort passed 'mailcap-viewer-lessp))
- (setq viewer (car passed))))
- (when (and (stringp (cdr (assq 'viewer viewer)))
- passed)
- (setq viewer (car passed)))
- (cond
- ((and (null viewer) (not (equal major "default")) request)
- (mailcap-mime-info "default" request))
- ((or (null request) (equal request ""))
- (mailcap-unescape-mime-test (cdr (assq 'viewer viewer)) info))
- ((stringp request)
- (mailcap-unescape-mime-test
- (cdr-safe (assoc request viewer)) info))
- ((eq request 'all)
- passed)
- (t
- ;; MUST make a copy *sigh*, else we modify mailcap-mime-data
- (setq viewer (copy-sequence viewer))
- (let ((view (assq 'viewer viewer))
- (test (assq 'test viewer)))
- (if view (setcdr view (mailcap-unescape-mime-test (cdr view) info)))
- (if test (setcdr test (mailcap-unescape-mime-test (cdr test) info))))
- viewer)))))
-
-;;;
-;;; Experimental MIME-types parsing
-;;;
-
-(defvar mailcap-mime-extensions
- '(("" . "text/plain")
- (".abs" . "audio/x-mpeg")
- (".aif" . "audio/aiff")
- (".aifc" . "audio/aiff")
- (".aiff" . "audio/aiff")
- (".ano" . "application/x-annotator")
- (".au" . "audio/ulaw")
- (".avi" . "video/x-msvideo")
- (".bcpio" . "application/x-bcpio")
- (".bin" . "application/octet-stream")
- (".cdf" . "application/x-netcdr")
- (".cpio" . "application/x-cpio")
- (".csh" . "application/x-csh")
- (".css" . "text/css")
- (".dvi" . "application/x-dvi")
- (".diff" . "text/x-patch")
- (".el" . "application/emacs-lisp")
- (".eps" . "application/postscript")
- (".etx" . "text/x-setext")
- (".exe" . "application/octet-stream")
- (".fax" . "image/x-fax")
- (".gif" . "image/gif")
- (".hdf" . "application/x-hdf")
- (".hqx" . "application/mac-binhex40")
- (".htm" . "text/html")
- (".html" . "text/html")
- (".icon" . "image/x-icon")
- (".ief" . "image/ief")
- (".jpg" . "image/jpeg")
- (".macp" . "image/x-macpaint")
- (".man" . "application/x-troff-man")
- (".me" . "application/x-troff-me")
- (".mif" . "application/mif")
- (".mov" . "video/quicktime")
- (".movie" . "video/x-sgi-movie")
- (".mp2" . "audio/x-mpeg")
- (".mp3" . "audio/x-mpeg")
- (".mp2a" . "audio/x-mpeg2")
- (".mpa" . "audio/x-mpeg")
- (".mpa2" . "audio/x-mpeg2")
- (".mpe" . "video/mpeg")
- (".mpeg" . "video/mpeg")
- (".mpega" . "audio/x-mpeg")
- (".mpegv" . "video/mpeg")
- (".mpg" . "video/mpeg")
- (".mpv" . "video/mpeg")
- (".ms" . "application/x-troff-ms")
- (".nc" . "application/x-netcdf")
- (".nc" . "application/x-netcdf")
- (".oda" . "application/oda")
- (".patch" . "text/x-patch")
- (".pbm" . "image/x-portable-bitmap")
- (".pdf" . "application/pdf")
- (".pgm" . "image/portable-graymap")
- (".pict" . "image/pict")
- (".png" . "image/png")
- (".pnm" . "image/x-portable-anymap")
- (".ppm" . "image/portable-pixmap")
- (".ps" . "application/postscript")
- (".qt" . "video/quicktime")
- (".ras" . "image/x-raster")
- (".rgb" . "image/x-rgb")
- (".rtf" . "application/rtf")
- (".rtx" . "text/richtext")
- (".sh" . "application/x-sh")
- (".sit" . "application/x-stuffit")
- (".siv" . "application/sieve")
- (".snd" . "audio/basic")
- (".src" . "application/x-wais-source")
- (".tar" . "archive/tar")
- (".tcl" . "application/x-tcl")
- (".tex" . "application/x-tex")
- (".texi" . "application/texinfo")
- (".tga" . "image/x-targa")
- (".tif" . "image/tiff")
- (".tiff" . "image/tiff")
- (".tr" . "application/x-troff")
- (".troff" . "application/x-troff")
- (".tsv" . "text/tab-separated-values")
- (".txt" . "text/plain")
- (".vbs" . "video/mpeg")
- (".vox" . "audio/basic")
- (".vrml" . "x-world/x-vrml")
- (".wav" . "audio/x-wav")
- (".xls" . "application/vnd.ms-excel")
- (".wrl" . "x-world/x-vrml")
- (".xbm" . "image/xbm")
- (".xpm" . "image/xpm")
- (".xwd" . "image/windowdump")
- (".zip" . "application/zip")
- (".ai" . "application/postscript")
- (".jpe" . "image/jpeg")
- (".jpeg" . "image/jpeg"))
- "An alist of file extensions and corresponding MIME content-types.
-This exists for you to customize the information in Lisp. It is
-merged with values from mailcap files by `mailcap-parse-mimetypes'.")
-
-(defvar mailcap-mimetypes-parsed-p nil)
-
-(defun mailcap-parse-mimetypes (&optional path force)
- "Parse out all the mimetypes specified in a Unix-style path string PATH.
-Components of PATH are separated by the `path-separator' character
-appropriate for this system. If PATH is omitted, use the value of
-environment variable MIMETYPES if set; otherwise use a default path.
-If FORCE, re-parse even if already parsed."
- (interactive (list nil t))
- (when (or (not mailcap-mimetypes-parsed-p)
- force)
- (cond
- (path nil)
- ((getenv "MIMETYPES") (setq path (getenv "MIMETYPES")))
- ((memq system-type mailcap-poor-system-types)
- (setq path '("~/mime.typ" "~/etc/mime.typ")))
- (t (setq path
- ;; mime.types seems to be the normal name, definitely so
- ;; on current GNUish systems. The search order follows
- ;; that for mailcap.
- '("~/.mime.types"
- "/etc/mime.types"
- "/usr/etc/mime.types"
- "/usr/local/etc/mime.types"
- "/usr/local/www/conf/mime.types"
- "~/.mime-types"
- "/etc/mime-types"
- "/usr/etc/mime-types"
- "/usr/local/etc/mime-types"
- "/usr/local/www/conf/mime-types"))))
- (let ((fnames (reverse (if (stringp path)
- (delete "" (split-string path path-separator))
- path)))
- fname)
- (while fnames
- (setq fname (car fnames))
- (if (and (file-readable-p fname))
- (mailcap-parse-mimetype-file fname))
- (setq fnames (cdr fnames))))
- (setq mailcap-mimetypes-parsed-p t)))
-
-(defun mailcap-parse-mimetype-file (fname)
- "Parse out a mime-types file FNAME."
- (let (type ; The MIME type for this line
- extns ; The extensions for this line
- save-pos ; Misc. saved buffer positions
- )
- (with-temp-buffer
- (insert-file-contents fname)
- (mailcap-replace-regexp "#.*" "")
- (mailcap-replace-regexp "\n+" "\n")
- (mailcap-replace-regexp "[ \t]+$" "")
- (goto-char (point-max))
- (skip-chars-backward " \t\n")
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward " \t\n")
- (setq save-pos (point))
- (skip-chars-forward "^ \t\n")
- (downcase-region save-pos (point))
- (setq type (buffer-substring save-pos (point)))
- (while (not (eolp))
- (skip-chars-forward " \t")
- (setq save-pos (point))
- (skip-chars-forward "^ \t\n")
- (setq extns (cons (buffer-substring save-pos (point)) extns)))
- (while extns
- (setq mailcap-mime-extensions
- (cons
- (cons (if (= (string-to-char (car extns)) ?.)
- (car extns)
- (concat "." (car extns))) type)
- mailcap-mime-extensions)
- extns (cdr extns)))))))
-
-(defun mailcap-extension-to-mime (extn)
- "Return the MIME content type of the file extensions EXTN."
- (mailcap-parse-mimetypes)
- (if (and (stringp extn)
- (not (eq (string-to-char extn) ?.)))
- (setq extn (concat "." extn)))
- (cdr (assoc (downcase extn) mailcap-mime-extensions)))
-
-;; Unused?
-(defalias 'mailcap-command-p 'executable-find)
-
-(defun mailcap-mime-types ()
- "Return a list of MIME media types."
- (mailcap-parse-mimetypes)
- (mm-delete-duplicates
- (nconc
- (mapcar 'cdr mailcap-mime-extensions)
- (apply
- 'nconc
- (mapcar
- (lambda (l)
- (delq nil
- (mapcar
- (lambda (m)
- (let ((type (cdr (assq 'type (cdr m)))))
- (if (equal (cadr (split-string type "/"))
- "*")
- nil
- type)))
- (cdr l))))
- mailcap-mime-data)))))
-
-(provide 'mailcap)
-
-;;; arch-tag: 1fd4f9c9-c305-4d2e-9747-3a4d45baa0bd
-;;; mailcap.el ends here
+++ /dev/null
-;;; message.el --- composing mail and news messages
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: mail, 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This mode provides mail-sending facilities from within Emacs. It
-;; consists mainly of large chunks of code from the sendmail.el,
-;; gnus-msg.el and rnewspost.el files.
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (defvar gnus-message-group-art)
- (defvar gnus-list-identifiers)) ; gnus-sum is required where necessary
-(require 'canlock)
-(require 'mailheader)
-(require 'gmm-utils)
-(require 'nnheader)
-;; This is apparently necessary even though things are autoloaded.
-;; Because we dynamically bind mail-abbrev-mode-regexp, we'd better
-;; require mailabbrev here.
-(if (featurep 'xemacs)
- (require 'mail-abbrevs)
- (require 'mailabbrev))
-(require 'mail-parse)
-(require 'mml)
-(require 'rfc822)
-(eval-and-compile
- (autoload 'gnus-find-method-for-group "gnus")
- (autoload 'nnvirtual-find-group-art "nnvirtual")
- (autoload 'gnus-group-decoded-name "gnus-group"))
-
-(defgroup message '((user-mail-address custom-variable)
- (user-full-name custom-variable))
- "Mail and news message composing."
- :link '(custom-manual "(message)Top")
- :group 'mail
- :group 'news)
-
-(put 'user-mail-address 'custom-type 'string)
-(put 'user-full-name 'custom-type 'string)
-
-(defgroup message-various nil
- "Various Message Variables."
- :link '(custom-manual "(message)Various Message Variables")
- :group 'message)
-
-(defgroup message-buffers nil
- "Message Buffers."
- :link '(custom-manual "(message)Message Buffers")
- :group 'message)
-
-(defgroup message-sending nil
- "Message Sending."
- :link '(custom-manual "(message)Sending Variables")
- :group 'message)
-
-(defgroup message-interface nil
- "Message Interface."
- :link '(custom-manual "(message)Interface")
- :group 'message)
-
-(defgroup message-forwarding nil
- "Message Forwarding."
- :link '(custom-manual "(message)Forwarding")
- :group 'message-interface)
-
-(defgroup message-insertion nil
- "Message Insertion."
- :link '(custom-manual "(message)Insertion")
- :group 'message)
-
-(defgroup message-headers nil
- "Message Headers."
- :link '(custom-manual "(message)Message Headers")
- :group 'message)
-
-(defgroup message-news nil
- "Composing News Messages."
- :group 'message)
-
-(defgroup message-mail nil
- "Composing Mail Messages."
- :group 'message)
-
-(defgroup message-faces nil
- "Faces used for message composing."
- :group 'message
- :group 'faces)
-
-(defcustom message-directory "~/Mail/"
- "*Directory from which all other mail file variables are derived."
- :group 'message-various
- :type 'directory)
-
-(defcustom message-max-buffers 10
- "*How many buffers to keep before starting to kill them off."
- :group 'message-buffers
- :type 'integer)
-
-(defcustom message-send-rename-function nil
- "Function called to rename the buffer after sending it."
- :group 'message-buffers
- :type '(choice function (const nil)))
-
-(defcustom message-fcc-handler-function 'message-output
- "*A function called to save outgoing articles.
-This function will be called with the name of the file to store the
-article in. The default function is `message-output' which saves in Unix
-mailbox format."
- :type '(radio (function-item message-output)
- (function :tag "Other"))
- :group 'message-sending)
-
-(defcustom message-fcc-externalize-attachments nil
- "If non-nil, attachments are included as external parts in Fcc copies."
- :version "22.1"
- :type 'boolean
- :group 'message-sending)
-
-(defcustom message-courtesy-message
- "The following message is a courtesy copy of an article\nthat has been posted to %s as well.\n\n"
- "*This is inserted at the start of a mailed copy of a posted message.
-If the string contains the format spec \"%s\", the Newsgroups
-the article has been posted to will be inserted there.
-If this variable is nil, no such courtesy message will be added."
- :group 'message-sending
- :type '(radio string (const nil)))
-
-(defcustom message-ignored-bounced-headers
- "^\\(Received\\|Return-Path\\|Delivered-To\\):"
- "*Regexp that matches headers to be removed in resent bounced mail."
- :group 'message-interface
- :type 'regexp)
-
-;;;###autoload
-(defcustom message-from-style 'default
- "*Specifies how \"From\" headers look.
-
-If nil, they contain just the return address like:
- king@grassland.com
-If `parens', they look like:
- king@grassland.com (Elvis Parsley)
-If `angles', they look like:
- Elvis Parsley <king@grassland.com>
-
-Otherwise, most addresses look like `angles', but they look like
-`parens' if `angles' would need quoting and `parens' would not."
- :type '(choice (const :tag "simple" nil)
- (const parens)
- (const angles)
- (const default))
- :group 'message-headers)
-
-(defcustom message-insert-canlock t
- "Whether to insert a Cancel-Lock header in news postings."
- :version "22.1"
- :group 'message-headers
- :type 'boolean)
-
-(defcustom message-syntax-checks
- (if message-insert-canlock '((sender . disabled)) nil)
- ;; Guess this one shouldn't be easy to customize...
- "*Controls what syntax checks should not be performed on outgoing posts.
-To disable checking of long signatures, for instance, add
- `(signature . disabled)' to this list.
-
-Don't touch this variable unless you really know what you're doing.
-
-Checks include `approved', `continuation-headers', `control-chars',
-`empty', `existing-newsgroups', `from', `illegible-text',
-`invisible-text', `long-header-lines', `long-lines', `message-id',
-`multiple-headers', `new-text', `newsgroups', `quoting-style',
-`repeated-newsgroups', `reply-to', `sender', `sendsys', `shoot',
-`shorten-followup-to', `signature', `size', `subject', `subject-cmsg'
-and `valid-newsgroups'."
- :group 'message-news
- :type '(repeat sexp)) ; Fixme: improve this
-
-(defcustom message-required-headers '((optional . References)
- From)
- "*Headers to be generated or prompted for when sending a message.
-Also see `message-required-news-headers' and
-`message-required-mail-headers'."
- :version "22.1"
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat sexp))
-
-(defcustom message-draft-headers '(References From)
- "*Headers to be generated when saving a draft message."
- :version "22.1"
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat sexp))
-
-(defcustom message-required-news-headers
- '(From Newsgroups Subject Date Message-ID
- (optional . Organization)
- (optional . User-Agent))
- "*Headers to be generated or prompted for when posting an article.
-RFC977 and RFC1036 require From, Date, Newsgroups, Subject,
-Message-ID. Organization, Lines, In-Reply-To, Expires, and
-User-Agent are optional. If you don't want message to insert some
-header, remove it from this list."
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat sexp))
-
-(defcustom message-required-mail-headers
- '(From Subject Date (optional . In-Reply-To) Message-ID
- (optional . User-Agent))
- "*Headers to be generated or prompted for when mailing a message.
-It is recommended that From, Date, To, Subject and Message-ID be
-included. Organization and User-Agent are optional."
- :group 'message-mail
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat sexp))
-
-(defcustom message-deletable-headers '(Message-ID Date Lines)
- "Headers to be deleted if they already exist and were generated by message previously."
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type 'sexp)
-
-(defcustom message-ignored-news-headers
- "^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
- "*Regexp of headers to be removed unconditionally before posting."
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp))
-
-(defcustom message-ignored-mail-headers
- "^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:"
- "*Regexp of headers to be removed unconditionally before mailing."
- :group 'message-mail
- :group 'message-headers
- :link '(custom-manual "(message)Mail Headers")
- :type 'regexp)
-
-(defcustom message-ignored-supersedes-headers "^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-ID:\\|^X-Complaints-To:\\|Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|^X-Payment:"
- "*Header lines matching this regexp will be deleted before posting.
-It's best to delete old Path and Date headers before posting to avoid
-any confusion."
- :group 'message-interface
- :link '(custom-manual "(message)Superseding")
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp))
-
-(defcustom message-subject-re-regexp
- "^[ \t]*\\([Rr][Ee]\\(\\[[0-9]*\\]\\)*:[ \t]*\\)*[ \t]*"
- "*Regexp matching \"Re: \" in the subject line."
- :group 'message-various
- :link '(custom-manual "(message)Message Headers")
- :type 'regexp)
-
-;;; Start of variables adopted from `message-utils.el'.
-
-(defcustom message-subject-trailing-was-query 'ask
- "*What to do with trailing \"(was: <old subject>)\" in subject lines.
-If nil, leave the subject unchanged. If it is the symbol `ask', query
-the user what do do. In this case, the subject is matched against
-`message-subject-trailing-was-ask-regexp'. If
-`message-subject-trailing-was-query' is t, always strip the trailing
-old subject. In this case, `message-subject-trailing-was-regexp' is
-used."
- :version "22.1"
- :type '(choice (const :tag "never" nil)
- (const :tag "always strip" t)
- (const ask))
- :link '(custom-manual "(message)Message Headers")
- :group 'message-various)
-
-(defcustom message-subject-trailing-was-ask-regexp
- "[ \t]*\\([[(]+[Ww][Aa][Ss][ \t]*.*[\])]+\\)"
- "*Regexp matching \"(was: <old subject>)\" in the subject line.
-
-The function `message-strip-subject-trailing-was' uses this regexp if
-`message-subject-trailing-was-query' is set to the symbol `ask'. If
-the variable is t instead of `ask', use
-`message-subject-trailing-was-regexp' instead.
-
-It is okay to create some false positives here, as the user is asked."
- :version "22.1"
- :group 'message-various
- :link '(custom-manual "(message)Message Headers")
- :type 'regexp)
-
-(defcustom message-subject-trailing-was-regexp
- "[ \t]*\\((*[Ww][Aa][Ss]:[ \t]*.*)\\)"
- "*Regexp matching \"(was: <old subject>)\" in the subject line.
-
-If `message-subject-trailing-was-query' is set to t, the subject is
-matched against `message-subject-trailing-was-regexp' in
-`message-strip-subject-trailing-was'. You should use a regexp creating very
-few false positives here."
- :version "22.1"
- :group 'message-various
- :link '(custom-manual "(message)Message Headers")
- :type 'regexp)
-
-;;; marking inserted text
-
-(defcustom message-mark-insert-begin
- "--8<---------------cut here---------------start------------->8---\n"
- "How to mark the beginning of some inserted text."
- :version "22.1"
- :type 'string
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-various)
-
-(defcustom message-mark-insert-end
- "--8<---------------cut here---------------end--------------->8---\n"
- "How to mark the end of some inserted text."
- :version "22.1"
- :type 'string
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-various)
-
-(defcustom message-archive-header "X-No-Archive: Yes\n"
- "Header to insert when you don't want your article to be archived.
-Archives \(such as groups.google.com\) respect this header."
- :version "22.1"
- :type 'string
- :link '(custom-manual "(message)Header Commands")
- :group 'message-various)
-
-(defcustom message-archive-note
- "X-No-Archive: Yes - save http://groups.google.com/"
- "Note to insert why you wouldn't want this posting archived.
-If nil, don't insert any text in the body."
- :version "22.1"
- :type '(radio string (const nil))
- :link '(custom-manual "(message)Header Commands")
- :group 'message-various)
-
-;;; Crossposts and Followups
-;; inspired by JoH-followup-to by Jochem Huhman <joh at gmx.de>
-;; new suggestions by R. Weikusat <rw at another.de>
-
-(defvar message-cross-post-old-target nil
- "Old target for cross-posts or follow-ups.")
-(make-variable-buffer-local 'message-cross-post-old-target)
-
-(defcustom message-cross-post-default t
- "When non-nil `message-cross-post-followup-to' will perform a crosspost.
-If nil, `message-cross-post-followup-to' will only do a followup. Note that
-you can explicitly override this setting by calling
-`message-cross-post-followup-to' with a prefix."
- :version "22.1"
- :type 'boolean
- :group 'message-various)
-
-(defcustom message-cross-post-note "Crosspost & Followup-To: "
- "Note to insert before signature to notify of cross-post and follow-up."
- :version "22.1"
- :type 'string
- :group 'message-various)
-
-(defcustom message-followup-to-note "Followup-To: "
- "Note to insert before signature to notify of follow-up only."
- :version "22.1"
- :type 'string
- :group 'message-various)
-
-(defcustom message-cross-post-note-function 'message-cross-post-insert-note
- "Function to use to insert note about Crosspost or Followup-To.
-The function will be called with four arguments. The function should not only
-insert a note, but also ensure old notes are deleted. See the documentation
-for `message-cross-post-insert-note'."
- :version "22.1"
- :type 'function
- :group 'message-various)
-
-;;; End of variables adopted from `message-utils.el'.
-
-;;;###autoload
-(defcustom message-signature-separator "^-- *$"
- "Regexp matching the signature separator."
- :type 'regexp
- :link '(custom-manual "(message)Various Message Variables")
- :group 'message-various)
-
-(defcustom message-elide-ellipsis "\n[...]\n\n"
- "*The string which is inserted for elided text."
- :type 'string
- :link '(custom-manual "(message)Various Commands")
- :group 'message-various)
-
-(defcustom message-interactive t
- "Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors."
- :group 'message-sending
- :group 'message-mail
- :link '(custom-manual "(message)Sending Variables")
- :type 'boolean)
-
-(defcustom message-generate-new-buffers 'unique
- "*Say whether to create a new message buffer to compose a message.
-Valid values include:
-
-nil
- Generate the buffer name in the Message way (e.g., *mail*, *news*,
- *mail to whom*, *news on group*, etc.) and continue editing in the
- existing buffer of that name. If there is no such buffer, it will
- be newly created.
-
-`unique' or t
- Create the new buffer with the name generated in the Message way.
-
-`unsent'
- Similar to `unique' but the buffer name begins with \"*unsent \".
-
-`standard'
- Similar to nil but the buffer name is simpler like *mail message*.
-
-function
- If this is a function, call that function with three parameters:
- The type, the To address and the group name (any of these may be nil).
- The function should return the new buffer name."
- :group 'message-buffers
- :link '(custom-manual "(message)Message Buffers")
- :type '(choice (const nil)
- (sexp :tag "unique" :format "unique\n" :value unique
- :match (lambda (widget value) (memq value '(unique t))))
- (const unsent)
- (const standard)
- (function :format "\n %{%t%}: %v")))
-
-(defcustom message-kill-buffer-on-exit nil
- "*Non-nil means that the message buffer will be killed after sending a message."
- :group 'message-buffers
- :link '(custom-manual "(message)Message Buffers")
- :type 'boolean)
-
-(eval-when-compile
- (defvar gnus-local-organization))
-(defcustom message-user-organization
- (or (and (boundp 'gnus-local-organization)
- (stringp gnus-local-organization)
- gnus-local-organization)
- (getenv "ORGANIZATION")
- t)
- "*String to be used as an Organization header.
-If t, use `message-user-organization-file'."
- :group 'message-headers
- :type '(choice string
- (const :tag "consult file" t)))
-
-;;;###autoload
-(defcustom message-user-organization-file "/usr/lib/news/organization"
- "*Local news organization file."
- :type 'file
- :link '(custom-manual "(message)News Headers")
- :group 'message-headers)
-
-(defcustom message-make-forward-subject-function
- #'message-forward-subject-name-subject
- "*List of functions called to generate subject headers for forwarded messages.
-The subject generated by the previous function is passed into each
-successive function.
-
-The provided functions are:
-
-* `message-forward-subject-author-subject' Source of article (author or
- newsgroup), in brackets followed by the subject
-* `message-forward-subject-name-subject' Source of article (name of author
- or newsgroup), in brackets followed by the subject
-* `message-forward-subject-fwd' Subject of article with 'Fwd:' prepended
- to it."
- :group 'message-forwarding
- :link '(custom-manual "(message)Forwarding")
- :type '(radio (function-item message-forward-subject-author-subject)
- (function-item message-forward-subject-fwd)
- (function-item message-forward-subject-name-subject)
- (repeat :tag "List of functions" function)))
-
-(defcustom message-forward-as-mime t
- "*Non-nil means forward messages as an inline/rfc822 MIME section.
-Otherwise, directly inline the old message in the forwarded message."
- :version "21.1"
- :group 'message-forwarding
- :link '(custom-manual "(message)Forwarding")
- :type 'boolean)
-
-(defcustom message-forward-show-mml 'best
- "*Non-nil means show forwarded messages as MML (decoded from MIME).
-Otherwise, forwarded messages are unchanged.
-Can also be the symbol `best' to indicate that MML should be
-used, except when it is a bad idea to use MML. One example where
-it is a bad idea is when forwarding a signed or encrypted
-message, because converting MIME to MML would invalidate the
-digital signature."
- :version "21.1"
- :group 'message-forwarding
- :type '(choice (const :tag "use MML" t)
- (const :tag "don't use MML " nil)
- (const :tag "use MML when appropriate" best)))
-
-(defcustom message-forward-before-signature t
- "*Non-nil means put forwarded message before signature, else after."
- :group 'message-forwarding
- :type 'boolean)
-
-(defcustom message-wash-forwarded-subjects nil
- "*Non-nil means try to remove as much cruft as possible from the subject.
-Done before generating the new subject of a forward."
- :group 'message-forwarding
- :link '(custom-manual "(message)Forwarding")
- :type 'boolean)
-
-(defcustom message-ignored-resent-headers "^Return-receipt\\|^X-Gnus\\|^Gnus-Warning:\\|^>?From "
- "*All headers that match this regexp will be deleted when resending a message."
- :group 'message-interface
- :link '(custom-manual "(message)Resending")
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp))
-
-(defcustom message-forward-ignored-headers "^Content-Transfer-Encoding:\\|^X-Gnus"
- "*All headers that match this regexp will be deleted when forwarding a message."
- :version "21.1"
- :group 'message-forwarding
- :type '(repeat :value-to-internal (lambda (widget value)
- (custom-split-regexp-maybe value))
- :match (lambda (widget value)
- (or (stringp value)
- (widget-editable-list-match widget value)))
- regexp))
-
-(defcustom message-ignored-cited-headers "."
- "*Delete these headers from the messages you yank."
- :group 'message-insertion
- :link '(custom-manual "(message)Insertion Variables")
- :type 'regexp)
-
-(defcustom message-cite-prefix-regexp
- (if (string-match "[[:digit:]]" "1") ;; support POSIX?
- "\\([ \t]*[-_.[:word:]]+>+\\|[ \t]*[]>|}+]\\)+"
- ;; ?-, ?_ or ?. MUST NOT be in syntax entry w.
- (let ((old-table (syntax-table))
- non-word-constituents)
- (set-syntax-table text-mode-syntax-table)
- (setq non-word-constituents
- (concat
- (if (string-match "\\w" "-") "" "-")
- (if (string-match "\\w" "_") "" "_")
- (if (string-match "\\w" ".") "" ".")))
- (set-syntax-table old-table)
- (if (equal non-word-constituents "")
- "\\([ \t]*\\(\\w\\)+>+\\|[ \t]*[]>|}+]\\)+"
- (concat "\\([ \t]*\\(\\w\\|["
- non-word-constituents
- "]\\)+>+\\|[ \t]*[]>|}+]\\)+"))))
- "*Regexp matching the longest possible citation prefix on a line."
- :version "22.1"
- :group 'message-insertion
- :link '(custom-manual "(message)Insertion Variables")
- :type 'regexp)
-
-(defcustom message-cancel-message "I am canceling my own article.\n"
- "Message to be inserted in the cancel message."
- :group 'message-interface
- :link '(custom-manual "(message)Canceling News")
- :type 'string)
-
-;; Useful to set in site-init.el
-;;;###autoload
-(defcustom message-send-mail-function 'message-send-mail-with-sendmail
- "Function to call to send the current buffer as mail.
-The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'.
-
-Valid values include `message-send-mail-with-sendmail' (the default),
-`message-send-mail-with-mh', `message-send-mail-with-qmail',
-`message-smtpmail-send-it', `smtpmail-send-it' and `feedmail-send-it'.
-
-See also `send-mail-function'."
- :type '(radio (function-item message-send-mail-with-sendmail)
- (function-item message-send-mail-with-mh)
- (function-item message-send-mail-with-qmail)
- (function-item message-smtpmail-send-it)
- (function-item smtpmail-send-it)
- (function-item feedmail-send-it)
- (function :tag "Other"))
- :group 'message-sending
- :link '(custom-manual "(message)Mail Variables")
- :group 'message-mail)
-
-(defcustom message-send-news-function 'message-send-news
- "Function to call to send the current buffer as news.
-The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'."
- :group 'message-sending
- :group 'message-news
- :link '(custom-manual "(message)News Variables")
- :type 'function)
-
-(defcustom message-reply-to-function nil
- "If non-nil, function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers."
- :group 'message-interface
- :link '(custom-manual "(message)Reply")
- :type '(choice function (const nil)))
-
-(defcustom message-wide-reply-to-function nil
- "If non-nil, function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers."
- :group 'message-interface
- :link '(custom-manual "(message)Wide Reply")
- :type '(choice function (const nil)))
-
-(defcustom message-followup-to-function nil
- "If non-nil, function that should return a list of headers.
-This function should pick out addresses from the To, Cc, and From headers
-and respond with new To and Cc headers."
- :group 'message-interface
- :link '(custom-manual "(message)Followup")
- :type '(choice function (const nil)))
-
-(defcustom message-use-followup-to 'ask
- "*Specifies what to do with Followup-To header.
-If nil, always ignore the header. If it is t, use its value, but
-query before using the \"poster\" value. If it is the symbol `ask',
-always query the user whether to use the value. If it is the symbol
-`use', always use the value."
- :group 'message-interface
- :link '(custom-manual "(message)Followup")
- :type '(choice (const :tag "ignore" nil)
- (const :tag "use & query" t)
- (const use)
- (const ask)))
-
-(defcustom message-use-mail-followup-to 'use
- "*Specifies what to do with Mail-Followup-To header.
-If nil, always ignore the header. If it is the symbol `ask', always
-query the user whether to use the value. If it is the symbol `use',
-always use the value."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Mailing Lists")
- :type '(choice (const :tag "ignore" nil)
- (const use)
- (const ask)))
-
-(defcustom message-subscribed-address-functions nil
- "*Specifies functions for determining list subscription.
-If nil, do not attempt to determine list subscription with functions.
-If non-nil, this variable contains a list of functions which return
-regular expressions to match lists. These functions can be used in
-conjunction with `message-subscribed-regexps' and
-`message-subscribed-addresses'."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Mailing Lists")
- :type '(repeat sexp))
-
-(defcustom message-subscribed-address-file nil
- "*A file containing addresses the user is subscribed to.
-If nil, do not look at any files to determine list subscriptions. If
-non-nil, each line of this file should be a mailing list address."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Mailing Lists")
- :type '(radio file (const nil)))
-
-(defcustom message-subscribed-addresses nil
- "*Specifies a list of addresses the user is subscribed to.
-If nil, do not use any predefined list subscriptions. This list of
-addresses can be used in conjunction with
-`message-subscribed-address-functions' and `message-subscribed-regexps'."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Mailing Lists")
- :type '(repeat string))
-
-(defcustom message-subscribed-regexps nil
- "*Specifies a list of addresses the user is subscribed to.
-If nil, do not use any predefined list subscriptions. This list of
-regular expressions can be used in conjunction with
-`message-subscribed-address-functions' and `message-subscribed-addresses'."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Mailing Lists")
- :type '(repeat regexp))
-
-(defcustom message-allow-no-recipients 'ask
- "Specifies what to do when there are no recipients other than Gcc/Fcc.
-If it is the symbol `always', the posting is allowed. If it is the
-symbol `never', the posting is not allowed. If it is the symbol
-`ask', you are prompted."
- :version "22.1"
- :group 'message-interface
- :link '(custom-manual "(message)Message Headers")
- :type '(choice (const always)
- (const never)
- (const ask)))
-
-(defcustom message-sendmail-f-is-evil nil
- "*Non-nil means don't add \"-f username\" to the sendmail command line.
-Doing so would be even more evil than leaving it out."
- :group 'message-sending
- :link '(custom-manual "(message)Mail Variables")
- :type 'boolean)
-
-(defcustom message-sendmail-envelope-from nil
- "*Envelope-from when sending mail with sendmail.
-If this is nil, use `user-mail-address'. If it is the symbol
-`header', use the From: header of the message."
- :version "22.1"
- :type '(choice (string :tag "From name")
- (const :tag "Use From: header from message" header)
- (const :tag "Use `user-mail-address'" nil))
- :link '(custom-manual "(message)Mail Variables")
- :group 'message-sending)
-
-;; qmail-related stuff
-(defcustom message-qmail-inject-program "/var/qmail/bin/qmail-inject"
- "Location of the qmail-inject program."
- :group 'message-sending
- :link '(custom-manual "(message)Mail Variables")
- :type 'file)
-
-(defcustom message-qmail-inject-args nil
- "Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument. It
-may also be a function.
-
-For e.g., if you wish to set the envelope sender address so that bounces
-go to the right place or to deal with listserv's usage of that address, you
-might set this variable to '(\"-f\" \"you@some.where\")."
- :group 'message-sending
- :link '(custom-manual "(message)Mail Variables")
- :type '(choice (function)
- (repeat string)))
-
-(defvar message-cater-to-broken-inn t
- "Non-nil means Gnus should not fold the `References' header.
-Folding `References' makes ancient versions of INN create incorrect
-NOV lines.")
-
-(eval-when-compile
- (defvar gnus-post-method)
- (defvar gnus-select-method))
-(defcustom message-post-method
- (cond ((and (boundp 'gnus-post-method)
- (listp gnus-post-method)
- gnus-post-method)
- gnus-post-method)
- ((boundp 'gnus-select-method)
- gnus-select-method)
- (t '(nnspool "")))
- "*Method used to post news.
-Note that when posting from inside Gnus, for instance, this
-variable isn't used."
- :group 'message-news
- :group 'message-sending
- ;; This should be the `gnus-select-method' widget, but that might
- ;; create a dependence to `gnus.el'.
- :type 'sexp)
-
-;; FIXME: This should be a temporary workaround until someone implements a
-;; proper solution. If a crash happens while replying, the auto-save file
-;; will *not* have a `References:' header if `message-generate-headers-first'
-;; is nil. See: http://article.gmane.org/gmane.emacs.gnus.general/51138
-(defcustom message-generate-headers-first '(references)
- "Which headers should be generated before starting to compose a message.
-If t, generate all required headers. This can also be a list of headers to
-generate. The variables `message-required-news-headers' and
-`message-required-mail-headers' specify which headers to generate.
-
-Note that the variable `message-deletable-headers' specifies headers which
-are to be deleted and then re-generated before sending, so this variable
-will not have a visible effect for those headers."
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(choice (const :tag "None" nil)
- (const :tag "References" '(references))
- (const :tag "All" t)
- (repeat (sexp :tag "Header"))))
-
-(defcustom message-setup-hook nil
- "Normal hook, run each time a new outgoing message is initialized.
-The function `message-setup' runs this hook."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-cancel-hook nil
- "Hook run when cancelling articles."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-signature-setup-hook nil
- "Normal hook, run each time a new outgoing message is initialized.
-It is run after the headers have been inserted and before
-the signature is inserted."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-mode-hook nil
- "Hook run in message mode buffers."
- :group 'message-various
- :type 'hook)
-
-(defcustom message-header-hook nil
- "Hook run in a message mode buffer narrowed to the headers."
- :group 'message-various
- :type 'hook)
-
-(defcustom message-header-setup-hook nil
- "Hook called narrowed to the headers when setting up a message buffer."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-minibuffer-local-map
- (let ((map (make-sparse-keymap 'message-minibuffer-local-map)))
- (set-keymap-parent map minibuffer-local-map)
- map)
- "Keymap for `message-read-from-minibuffer'."
- :version "22.1"
- :group 'message-various)
-
-;;;###autoload
-(defcustom message-citation-line-function 'message-insert-citation-line
- "*Function called to insert the \"Whomever writes:\" line.
-
-Note that Gnus provides a feature where the reader can click on
-`writes:' to hide the cited text. If you change this line too much,
-people who read your message will have to change their Gnus
-configuration. See the variable `gnus-cite-attribution-suffix'."
- :type 'function
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-;;;###autoload
-(defcustom message-yank-prefix "> "
- "*Prefix inserted on the lines of yanked messages.
-Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-cited-prefix'."
- :type 'string
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-(defcustom message-yank-cited-prefix ">"
- "*Prefix inserted on cited or empty lines of yanked messages.
-Fix `message-cite-prefix-regexp' if it is set to an abnormal value.
-See also `message-yank-prefix'."
- :version "22.1"
- :type 'string
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-(defcustom message-indentation-spaces 3
- "*Number of spaces to insert at the beginning of each cited line.
-Used by `message-yank-original' via `message-yank-cite'."
- :group 'message-insertion
- :link '(custom-manual "(message)Insertion Variables")
- :type 'integer)
-
-;;;###autoload
-(defcustom message-cite-function 'message-cite-original
- "*Function for citing an original message.
-Predefined functions include `message-cite-original' and
-`message-cite-original-without-signature'.
-Note that `message-cite-original' uses `mail-citation-hook' if that is non-nil."
- :type '(radio (function-item message-cite-original)
- (function-item message-cite-original-without-signature)
- (function-item sc-cite-original)
- (function :tag "Other"))
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-;;;###autoload
-(defcustom message-indent-citation-function 'message-indent-citation
- "*Function for modifying a citation just inserted in the mail buffer.
-This can also be a list of functions. Each function can find the
-citation between (point) and (mark t). And each function should leave
-point and mark around the citation text as modified."
- :type 'function
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-;;;###autoload
-(defcustom message-signature t
- "*String to be inserted at the end of the message buffer.
-If t, the `message-signature-file' file will be inserted instead.
-If a function, the result from the function will be used instead.
-If a form, the result from the form will be used instead."
- :type 'sexp
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-;;;###autoload
-(defcustom message-signature-file "~/.signature"
- "*Name of file containing the text inserted at end of message buffer.
-Ignored if the named file doesn't exist.
-If nil, don't insert a signature."
- :type '(choice file (const :tags "None" nil))
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-;;;###autoload
-(defcustom message-signature-insert-empty-line t
- "*If non-nil, insert an empty line before the signature separator."
- :version "22.1"
- :type 'boolean
- :link '(custom-manual "(message)Insertion Variables")
- :group 'message-insertion)
-
-(defcustom message-distribution-function nil
- "*Function called to return a Distribution header."
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)News Headers")
- :type '(choice function (const nil)))
-
-(defcustom message-expires 14
- "Number of days before your article expires."
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)News Headers")
- :type 'integer)
-
-(defcustom message-user-path nil
- "If nil, use the NNTP server name in the Path header.
-If stringp, use this; if non-nil, use no host name (user name only)."
- :group 'message-news
- :group 'message-headers
- :link '(custom-manual "(message)News Headers")
- :type '(choice (const :tag "nntp" nil)
- (string :tag "name")
- (sexp :tag "none" :format "%t" t)))
-
-(defvar message-reply-buffer nil)
-(defvar message-reply-headers nil
- "The headers of the current replied article.
-It is a vector of the following headers:
-\[number subject from date id references chars lines xref extra].")
-(defvar message-newsreader nil)
-(defvar message-mailer nil)
-(defvar message-sent-message-via nil)
-(defvar message-checksum nil)
-(defvar message-send-actions nil
- "A list of actions to be performed upon successful sending of a message.")
-(defvar message-exit-actions nil
- "A list of actions to be performed upon exiting after sending a message.")
-(defvar message-kill-actions nil
- "A list of actions to be performed before killing a message buffer.")
-(defvar message-postpone-actions nil
- "A list of actions to be performed after postponing a message.")
-
-(define-widget 'message-header-lines 'text
- "All header lines must be LFD terminated."
- :format "%{%t%}:%n%v"
- :valid-regexp "^\\'"
- :error "All header lines must be newline terminated")
-
-(defcustom message-default-headers ""
- "*A string containing header lines to be inserted in outgoing messages.
-It is inserted before you edit the message, so you can edit or delete
-these lines."
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type 'message-header-lines)
-
-(defcustom message-default-mail-headers ""
- "*A string of header lines to be inserted in outgoing mails."
- :group 'message-headers
- :group 'message-mail
- :link '(custom-manual "(message)Mail Headers")
- :type 'message-header-lines)
-
-(defcustom message-default-news-headers ""
- "*A string of header lines to be inserted in outgoing news articles."
- :group 'message-headers
- :group 'message-news
- :link '(custom-manual "(message)News Headers")
- :type 'message-header-lines)
-
-;; Note: could use /usr/ucb/mail instead of sendmail;
-;; options -t, and -v if not interactive.
-(defcustom message-mailer-swallows-blank-line
- (if (and (string-match "sparc-sun-sunos\\(\\'\\|[^5]\\)"
- system-configuration)
- (file-readable-p "/etc/sendmail.cf")
- (let ((buffer (get-buffer-create " *temp*")))
- (unwind-protect
- (save-excursion
- (set-buffer buffer)
- (insert-file-contents "/etc/sendmail.cf")
- (goto-char (point-min))
- (let ((case-fold-search nil))
- (re-search-forward "^OR\\>" nil t)))
- (kill-buffer buffer))))
- ;; According to RFC822, "The field-name must be composed of printable
- ;; ASCII characters (i. e., characters that have decimal values between
- ;; 33 and 126, except colon)", i. e., any chars except ctl chars,
- ;; space, or colon.
- '(looking-at "[ \t]\\|[][!\"#$%&'()*+,-./0-9;<=>?@A-Z\\\\^_`a-z{|}~]+:"))
- "*Set this non-nil if the system's mailer runs the header and body together.
-\(This problem exists on Sunos 4 when sendmail is run in remote mode.)
-The value should be an expression to test whether the problem will
-actually occur."
- :group 'message-sending
- :link '(custom-manual "(message)Mail Variables")
- :type 'sexp)
-
-;;;###autoload
-(define-mail-user-agent 'message-user-agent
- 'message-mail 'message-send-and-exit
- 'message-kill-buffer 'message-send-hook)
-
-(defvar message-mh-deletable-headers '(Message-ID Date Lines Sender)
- "If non-nil, delete the deletable headers before feeding to mh.")
-
-(defvar message-send-method-alist
- '((news message-news-p message-send-via-news)
- (mail message-mail-p message-send-via-mail))
- "Alist of ways to send outgoing messages.
-Each element has the form
-
- \(TYPE PREDICATE FUNCTION)
-
-where TYPE is a symbol that names the method; PREDICATE is a function
-called without any parameters to determine whether the message is
-a message of type TYPE; and FUNCTION is a function to be called if
-PREDICATE returns non-nil. FUNCTION is called with one parameter --
-the prefix.")
-
-(defcustom message-mail-alias-type 'abbrev
- "*What alias expansion type to use in Message buffers.
-The default is `abbrev', which uses mailabbrev. nil switches
-mail aliases off."
- :group 'message
- :link '(custom-manual "(message)Mail Aliases")
- :type '(choice (const :tag "Use Mailabbrev" abbrev)
- (const :tag "No expansion" nil)))
-
-(defcustom message-auto-save-directory
- (file-name-as-directory (nnheader-concat message-directory "drafts"))
- "*Directory where Message auto-saves buffers if Gnus isn't running.
-If nil, Message won't auto-save."
- :group 'message-buffers
- :link '(custom-manual "(message)Various Message Variables")
- :type '(choice directory (const :tag "Don't auto-save" nil)))
-
-(defcustom message-default-charset
- (and (not (mm-multibyte-p)) 'iso-8859-1)
- "Default charset used in non-MULE Emacsen.
-If nil, you might be asked to input the charset."
- :version "21.1"
- :group 'message
- :link '(custom-manual "(message)Various Message Variables")
- :type 'symbol)
-
-(defcustom message-dont-reply-to-names
- (and (boundp 'rmail-dont-reply-to-names) rmail-dont-reply-to-names)
- "*A regexp specifying addresses to prune when doing wide replies.
-A value of nil means exclude your own user name only."
- :version "21.1"
- :group 'message
- :link '(custom-manual "(message)Wide Reply")
- :type '(choice (const :tag "Yourself" nil)
- regexp))
-
-(defvar message-shoot-gnksa-feet nil
- "*A list of GNKSA feet you are allowed to shoot.
-Gnus gives you all the opportunity you could possibly want for
-shooting yourself in the foot. Also, Gnus allows you to shoot the
-feet of Good Net-Keeping Seal of Approval. The following are foot
-candidates:
-`empty-article' Allow you to post an empty article;
-`quoted-text-only' Allow you to post quoted text only;
-`multiple-copies' Allow you to post multiple copies;
-`cancel-messages' Allow you to cancel or supersede messages from
- your other email addresses.")
-
-(defsubst message-gnksa-enable-p (feature)
- (or (not (listp message-shoot-gnksa-feet))
- (memq feature message-shoot-gnksa-feet)))
-
-(defcustom message-hidden-headers nil
- "Regexp of headers to be hidden when composing new messages.
-This can also be a list of regexps to match headers. Or a list
-starting with `not' and followed by regexps."
- :version "22.1"
- :group 'message
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat regexp))
-
-;;; Internal variables.
-;;; Well, not really internal.
-
-(defvar message-mode-syntax-table
- (let ((table (copy-syntax-table text-mode-syntax-table)))
- (modify-syntax-entry ?% ". " table)
- (modify-syntax-entry ?> ". " table)
- (modify-syntax-entry ?< ". " table)
- table)
- "Syntax table used while in Message mode.")
-
-(defface message-header-to
- '((((class color)
- (background dark))
- (:foreground "green2" :bold t))
- (((class color)
- (background light))
- (:foreground "MidnightBlue" :bold t))
- (t
- (:bold t :italic t)))
- "Face used for displaying From headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-to-face 'face-alias 'message-header-to)
-
-(defface message-header-cc
- '((((class color)
- (background dark))
- (:foreground "green4" :bold t))
- (((class color)
- (background light))
- (:foreground "MidnightBlue"))
- (t
- (:bold t)))
- "Face used for displaying Cc headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-cc-face 'face-alias 'message-header-cc)
-
-(defface message-header-subject
- '((((class color)
- (background dark))
- (:foreground "green3"))
- (((class color)
- (background light))
- (:foreground "navy blue" :bold t))
- (t
- (:bold t)))
- "Face used for displaying subject headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-subject-face 'face-alias 'message-header-subject)
-
-(defface message-header-newsgroups
- '((((class color)
- (background dark))
- (:foreground "yellow" :bold t :italic t))
- (((class color)
- (background light))
- (:foreground "blue4" :bold t :italic t))
- (t
- (:bold t :italic t)))
- "Face used for displaying newsgroups headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-newsgroups-face 'face-alias 'message-header-newsgroups)
-
-(defface message-header-other
- '((((class color)
- (background dark))
- (:foreground "#b00000"))
- (((class color)
- (background light))
- (:foreground "steel blue"))
- (t
- (:bold t :italic t)))
- "Face used for displaying newsgroups headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-other-face 'face-alias 'message-header-other)
-
-(defface message-header-name
- '((((class color)
- (background dark))
- (:foreground "DarkGreen"))
- (((class color)
- (background light))
- (:foreground "cornflower blue"))
- (t
- (:bold t)))
- "Face used for displaying header names."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-name-face 'face-alias 'message-header-name)
-
-(defface message-header-xheader
- '((((class color)
- (background dark))
- (:foreground "blue"))
- (((class color)
- (background light))
- (:foreground "blue"))
- (t
- (:bold t)))
- "Face used for displaying X-Header headers."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-header-xheader-face 'face-alias 'message-header-xheader)
-
-(defface message-separator
- '((((class color)
- (background dark))
- (:foreground "blue3"))
- (((class color)
- (background light))
- (:foreground "brown"))
- (t
- (:bold t)))
- "Face used for displaying the separator."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-separator-face 'face-alias 'message-separator)
-
-(defface message-cited-text
- '((((class color)
- (background dark))
- (:foreground "red"))
- (((class color)
- (background light))
- (:foreground "red"))
- (t
- (:bold t)))
- "Face used for displaying cited text names."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-cited-text-face 'face-alias 'message-cited-text)
-
-(defface message-mml
- '((((class color)
- (background dark))
- (:foreground "ForestGreen"))
- (((class color)
- (background light))
- (:foreground "ForestGreen"))
- (t
- (:bold t)))
- "Face used for displaying MML."
- :group 'message-faces)
-;; backward-compatibility alias
-(put 'message-mml-face 'face-alias 'message-mml)
-
-(defun message-font-lock-make-header-matcher (regexp)
- (let ((form
- `(lambda (limit)
- (let ((start (point)))
- (save-restriction
- (widen)
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (setq limit (min limit (match-beginning 0))))
- (goto-char start))
- (and (< start limit)
- (re-search-forward ,regexp limit t))))))
- (if (featurep 'bytecomp)
- (byte-compile form)
- form)))
-
-(defvar message-font-lock-keywords
- (let ((content "[ \t]*\\(.+\\(\n[ \t].*\\)*\\)\n?"))
- `((,(message-font-lock-make-header-matcher
- (concat "^\\([Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-to nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\(^[GBF]?[Cc][Cc]:\\|^[Rr]eply-[Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-cc nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([Ss]ubject:\\)" content))
- (1 'message-header-name)
- (2 'message-header-subject nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([Nn]ewsgroups:\\|Followup-[Tt]o:\\)" content))
- (1 'message-header-name)
- (2 'message-header-newsgroups nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\([A-Z][^: \n\t]+:\\)" content))
- (1 'message-header-name)
- (2 'message-header-other nil t))
- (,(message-font-lock-make-header-matcher
- (concat "^\\(X-[A-Za-z0-9-]+:\\|In-Reply-To:\\)" content))
- (1 'message-header-name)
- (2 'message-header-name))
- ,@(if (and mail-header-separator
- (not (equal mail-header-separator "")))
- `((,(concat "^\\(" (regexp-quote mail-header-separator) "\\)$")
- 1 'message-separator))
- nil)
- ((lambda (limit)
- (re-search-forward (concat "^\\("
- message-cite-prefix-regexp
- "\\).*")
- limit t))
- (0 'message-cited-text))
- ("<#/?\\(multipart\\|part\\|external\\|mml\\|secure\\)[^>]*>"
- (0 'message-mml))))
- "Additional expressions to highlight in Message mode.")
-
-
-;; XEmacs does it like this. For Emacs, we have to set the
-;; `font-lock-defaults' buffer-local variable.
-(put 'message-mode 'font-lock-defaults '(message-font-lock-keywords t))
-
-(defvar message-face-alist
- '((bold . bold-region)
- (underline . underline-region)
- (default . (lambda (b e)
- (unbold-region b e)
- (ununderline-region b e))))
- "Alist of mail and news faces for facemenu.
-The cdr of each entry is a function for applying the face to a region.")
-
-(defcustom message-send-hook nil
- "Hook run before sending messages.
-This hook is run quite early when sending."
- :group 'message-various
- :options '(ispell-message)
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-send-mail-hook nil
- "Hook run before sending mail messages.
-This hook is run very late -- just before the message is sent as
-mail."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-send-news-hook nil
- "Hook run before sending news messages.
-This hook is run very late -- just before the message is sent as
-news."
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'hook)
-
-(defcustom message-sent-hook nil
- "Hook run after sending messages."
- :group 'message-various
- :type 'hook)
-
-(defvar message-send-coding-system 'binary
- "Coding system to encode outgoing mail.")
-
-(defvar message-draft-coding-system
- mm-auto-save-coding-system
- "*Coding system to compose mail.
-If you'd like to make it possible to share draft files between XEmacs
-and Emacs, you may use `iso-2022-7bit' for this value at your own risk.
-Note that the coding-system `iso-2022-7bit' isn't suitable to all data.")
-
-(defcustom message-send-mail-partially-limit 1000000
- "The limitation of messages sent as message/partial.
-The lower bound of message size in characters, beyond which the message
-should be sent in several parts. If it is nil, the size is unlimited."
- :version "21.1"
- :group 'message-buffers
- :link '(custom-manual "(message)Mail Variables")
- :type '(choice (const :tag "unlimited" nil)
- (integer 1000000)))
-
-(defcustom message-alternative-emails nil
- "*Regexp matching alternative email addresses.
-The first address in the To, Cc or From headers of the original
-article matching this variable is used as the From field of
-outgoing messages.
-
-This variable has precedence over posting styles and anything that runs
-off `message-setup-hook'."
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(choice (const :tag "Always use primary" nil)
- regexp))
-
-(defcustom message-hierarchical-addresses nil
- "A list of hierarchical mail address definitions.
-
-Inside each entry, the first address is the \"top\" address, and
-subsequent addresses are subaddresses; this is used to indicate that
-mail sent to the first address will automatically be delivered to the
-subaddresses. So if the first address appears in the recipient list
-for a message, the subaddresses will be removed (if present) before
-the mail is sent. All addresses in this structure should be
-downcased."
- :version "22.1"
- :group 'message-headers
- :type '(repeat (repeat string)))
-
-(defcustom message-mail-user-agent nil
- "Like `mail-user-agent'.
-Except if it is nil, use Gnus native MUA; if it is t, use
-`mail-user-agent'."
- :version "22.1"
- :type '(radio (const :tag "Gnus native"
- :format "%t\n"
- nil)
- (const :tag "`mail-user-agent'"
- :format "%t\n"
- t)
- (function-item :tag "Default Emacs mail"
- :format "%t\n"
- sendmail-user-agent)
- (function-item :tag "Emacs interface to MH"
- :format "%t\n"
- mh-e-user-agent)
- (function :tag "Other"))
- :version "21.1"
- :group 'message)
-
-(defcustom message-wide-reply-confirm-recipients nil
- "Whether to confirm a wide reply to multiple email recipients.
-If this variable is nil, don't ask whether to reply to all recipients.
-If this variable is non-nil, pose the question \"Reply to all
-recipients?\" before a wide reply to multiple recipients. If the user
-answers yes, reply to all recipients as usual. If the user answers
-no, only reply back to the author."
- :version "22.1"
- :group 'message-headers
- :link '(custom-manual "(message)Wide Reply")
- :type 'boolean)
-
-(defcustom message-user-fqdn nil
- "*Domain part of Message-Ids."
- :version "22.1"
- :group 'message-headers
- :link '(custom-manual "(message)News Headers")
- :type '(radio (const :format "%v " nil)
- (string :format "FQDN: %v")))
-
-;; XEmacs change: Don't calculate a default value
-(defcustom message-use-idna nil
- "Whether to encode non-ASCII in domain names into ASCII according to IDNA.
-GNU Libidn, and in particular the elisp package \"idna.el\" and
-the external program \"idn\", must be installed for this
-functionality to work."
- :version "22.1"
- :group 'message-headers
- :link '(custom-manual "(message)IDNA")
- :type '(choice (const :tag "Ask" ask)
- (const :tag "Never" nil)
- (const :tag "Always" t)))
-
-;;; Internal variables.
-
-(defvar message-sending-message "Sending...")
-(defvar message-buffer-list nil)
-(defvar message-this-is-news nil)
-(defvar message-this-is-mail nil)
-(defvar message-draft-article nil)
-(defvar message-mime-part nil)
-(defvar message-posting-charset nil)
-(defvar message-inserted-headers nil)
-
-;; Byte-compiler warning
-(eval-when-compile
- (defvar gnus-active-hashtb)
- (defvar gnus-read-active-file))
-
-;;; Regexp matching the delimiter of messages in UNIX mail format
-;;; (UNIX From lines), minus the initial ^. It should be a copy
-;;; of rmail.el's rmail-unix-mail-delimiter.
-(defvar message-unix-mail-delimiter
- (let ((time-zone-regexp
- (concat "\\([A-Z]?[A-Z]?[A-Z][A-Z]\\( DST\\)?"
- "\\|[-+]?[0-9][0-9][0-9][0-9]"
- "\\|"
- "\\) *")))
- (concat
- "From "
-
- ;; Many things can happen to an RFC 822 mailbox before it is put into
- ;; a `From' line. The leading phrase can be stripped, e.g.
- ;; `Joe <@w.x:joe@y.z>' -> `<@w.x:joe@y.z>'. The <> can be stripped, e.g.
- ;; `<@x.y:joe@y.z>' -> `@x.y:joe@y.z'. Everything starting with a CRLF
- ;; can be removed, e.g.
- ;; From: joe@y.z (Joe K
- ;; User)
- ;; can yield `From joe@y.z (Joe K Fri Mar 22 08:11:15 1996', and
- ;; From: Joe User
- ;; <joe@y.z>
- ;; can yield `From Joe User Fri Mar 22 08:11:15 1996'.
- ;; The mailbox can be removed or be replaced by white space, e.g.
- ;; From: "Joe User"{space}{tab}
- ;; <joe@y.z>
- ;; can yield `From {space}{tab} Fri Mar 22 08:11:15 1996',
- ;; where {space} and {tab} represent the Ascii space and tab characters.
- ;; We want to match the results of any of these manglings.
- ;; The following regexp rejects names whose first characters are
- ;; obviously bogus, but after that anything goes.
- "\\([^\0-\b\n-\r\^?].*\\)?"
-
- ;; The time the message was sent.
- "\\([^\0-\r \^?]+\\) +" ; day of the week
- "\\([^\0-\r \^?]+\\) +" ; month
- "\\([0-3]?[0-9]\\) +" ; day of month
- "\\([0-2][0-9]:[0-5][0-9]\\(:[0-6][0-9]\\)?\\) *" ; time of day
-
- ;; Perhaps a time zone, specified by an abbreviation, or by a
- ;; numeric offset.
- time-zone-regexp
-
- ;; The year.
- " \\([0-9][0-9]+\\) *"
-
- ;; On some systems the time zone can appear after the year, too.
- time-zone-regexp
-
- ;; Old uucp cruft.
- "\\(remote from .*\\)?"
-
- "\n"))
- "Regexp matching the delimiter of messages in UNIX mail format.")
-
-(defvar message-unsent-separator
- (concat "^ *---+ +Unsent message follows +---+ *$\\|"
- "^ *---+ +Returned message +---+ *$\\|"
- "^Start of returned message$\\|"
- "^ *---+ +Original message +---+ *$\\|"
- "^ *--+ +begin message +--+ *$\\|"
- "^ *---+ +Original message follows +---+ *$\\|"
- "^ *---+ +Undelivered message follows +---+ *$\\|"
- "^|? *---+ +Message text follows: +---+ *|?$")
- "A regexp that matches the separator before the text of a failed message.")
-
-(defvar message-header-format-alist
- `((Newsgroups)
- (To . message-fill-address)
- (Cc . message-fill-address)
- (Subject)
- (In-Reply-To)
- (Fcc)
- (Bcc)
- (Date)
- (Organization)
- (Distribution)
- (Lines)
- (Expires)
- (Message-ID)
- (References . message-shorten-references)
- (User-Agent))
- "Alist used for formatting headers.")
-
-(defvar message-options nil
- "Some saved answers when sending message.")
-
-(defvar message-send-mail-real-function nil
- "Internal send mail function.")
-
-(defvar message-bogus-system-names "^localhost\\.\\|\\.local$"
- "The regexp of bogus system names.")
-
-(defcustom message-valid-fqdn-regexp
- (concat "[a-z0-9][-.a-z0-9]+\\." ;; [hostname.subdomain.]domain.
- ;; valid TLDs:
- "\\([a-z][a-z]\\|" ;; two letter country TDLs
- "aero\\|arpa\\|bitnet\\|biz\\|bofh\\|"
- "cat\\|com\\|coop\\|edu\\|gov\\|"
- "info\\|int\\|jobs\\|"
- "mil\\|mobi\\|museum\\|name\\|net\\|"
- "org\\|pro\\|travel\\|uucp\\)")
- ;; http://en.wikipedia.org/wiki/List_of_Internet_top-level_domains
- ;; http://en.wikipedia.org/wiki/GTLD
- ;; `in the process of being approved': .asia .post .tel .sex
- ;; "dead" nato bitnet uucp
- "Regular expression that matches a valid FQDN."
- ;; see also: gnus-button-valid-fqdn-regexp
- :version "22.1"
- :group 'message-headers
- :type 'regexp)
-
-(eval-and-compile
- (autoload 'idna-to-ascii "idna")
- (autoload 'message-setup-toolbar "messagexmas")
- (autoload 'mh-new-draft-name "mh-comp")
- (autoload 'mh-send-letter "mh-comp")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-point-at-bol "gnus-util")
- (autoload 'gnus-output-to-rmail "gnus-util")
- (autoload 'gnus-output-to-mail "gnus-util")
- (autoload 'nndraft-request-associate-buffer "nndraft")
- (autoload 'nndraft-request-expire-articles "nndraft")
- (autoload 'gnus-open-server "gnus-int")
- (autoload 'gnus-request-post "gnus-int")
- (autoload 'gnus-alive-p "gnus-util")
- (autoload 'gnus-server-string "gnus")
- (autoload 'gnus-group-name-charset "gnus-group")
- (autoload 'gnus-group-name-decode "gnus-group")
- (autoload 'gnus-groups-from-server "gnus")
- (autoload 'rmail-output "rmailout")
- (autoload 'gnus-delay-article "gnus-delay")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'gnus-extract-address-components "gnus-util")
- (autoload 'gnus-select-frame-set-input-focus "gnus-util"))
-
-\f
-
-;;;
-;;; Utility functions.
-;;;
-
-(defmacro message-y-or-n-p (question show &rest text)
- "Ask QUESTION, displaying remaining args in a temporary buffer if SHOW."
- `(message-talkative-question 'y-or-n-p ,question ,show ,@text))
-
-(defmacro message-delete-line (&optional n)
- "Delete the current line (and the next N lines)."
- `(delete-region (progn (beginning-of-line) (point))
- (progn (forward-line ,(or n 1)) (point))))
-
-(defun message-mark-active-p ()
- "Non-nil means the mark and region are currently active in this buffer."
- mark-active)
-
-(defun message-unquote-tokens (elems)
- "Remove double quotes (\") from strings in list ELEMS."
- (mapcar (lambda (item)
- (while (string-match "^\\(.*\\)\"\\(.*\\)$" item)
- (setq item (concat (match-string 1 item)
- (match-string 2 item))))
- item)
- elems))
-
-(defun message-tokenize-header (header &optional separator)
- "Split HEADER into a list of header elements.
-SEPARATOR is a string of characters to be used as separators. \",\"
-is used by default."
- (if (not header)
- nil
- (let ((regexp (format "[%s]+" (or separator ",")))
- (first t)
- beg quoted elems paren)
- (with-temp-buffer
- (mm-enable-multibyte)
- (setq beg (point-min))
- (insert header)
- (goto-char (point-min))
- (while (not (eobp))
- (if first
- (setq first nil)
- (forward-char 1))
- (cond ((and (> (point) beg)
- (or (eobp)
- (and (looking-at regexp)
- (not quoted)
- (not paren))))
- (push (buffer-substring beg (point)) elems)
- (setq beg (match-end 0)))
- ((eq (char-after) ?\")
- (setq quoted (not quoted)))
- ((and (eq (char-after) ?\()
- (not quoted))
- (setq paren t))
- ((and (eq (char-after) ?\))
- (not quoted))
- (setq paren nil))))
- (nreverse elems)))))
-
-(defun message-mail-file-mbox-p (file)
- "Say whether FILE looks like a Unix mbox file."
- (when (and (file-exists-p file)
- (file-readable-p file)
- (file-regular-p file))
- (with-temp-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (looking-at message-unix-mail-delimiter))))
-
-(defun message-fetch-field (header &optional not-all)
- "The same as `mail-fetch-field', only remove all newlines.
-The buffer is expected to be narrowed to just the header of the message;
-see `message-narrow-to-headers-or-head'."
- (let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
- (value (mail-fetch-field header nil (not not-all))))
- (when value
- (while (string-match "\n[\t ]+" value)
- (setq value (replace-match " " t t value)))
- (set-text-properties 0 (length value) nil value)
- value)))
-
-(defun message-field-value (header &optional not-all)
- "The same as `message-fetch-field', only narrow to the headers first."
- (save-excursion
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field header not-all))))
-
-(defun message-narrow-to-field ()
- "Narrow the buffer to the header on the current line."
- (beginning-of-line)
- (narrow-to-region
- (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \n\t]" nil t)
- (progn
- (beginning-of-line)
- (point))
- (point-max))))
- (goto-char (point-min)))
-
-(defun message-add-header (&rest headers)
- "Add the HEADERS to the message header, skipping those already present."
- (while headers
- (let (hclean)
- (unless (string-match "^\\([^:]+\\):[ \t]*[^ \t]" (car headers))
- (error "Invalid header `%s'" (car headers)))
- (setq hclean (match-string 1 (car headers)))
- (save-restriction
- (message-narrow-to-headers)
- (unless (re-search-forward (concat "^" (regexp-quote hclean) ":") nil t)
- (goto-char (point-max))
- (if (string-match "\n$" (car headers))
- (insert (car headers))
- (insert (car headers) ?\n)))))
- (setq headers (cdr headers))))
-
-(defmacro message-with-reply-buffer (&rest forms)
- "Evaluate FORMS in the reply buffer, if it exists."
- `(when (and message-reply-buffer
- (buffer-name message-reply-buffer))
- (save-excursion
- (set-buffer message-reply-buffer)
- ,@forms)))
-
-(put 'message-with-reply-buffer 'lisp-indent-function 0)
-(put 'message-with-reply-buffer 'edebug-form-spec '(body))
-
-(defun message-fetch-reply-field (header)
- "Fetch field HEADER from the message we're replying to."
- (message-with-reply-buffer
- (save-restriction
- (mail-narrow-to-head)
- (message-fetch-field header))))
-
-(defun message-strip-list-identifiers (subject)
- "Remove list identifiers in `gnus-list-identifiers' from string SUBJECT."
- (require 'gnus-sum) ; for gnus-list-identifiers
- (let ((regexp (if (stringp gnus-list-identifiers)
- gnus-list-identifiers
- (mapconcat 'identity gnus-list-identifiers " *\\|"))))
- (if (string-match (concat "\\(\\(\\(Re: +\\)?\\(" regexp
- " *\\)\\)+\\(Re: +\\)?\\)") subject)
- (concat (substring subject 0 (match-beginning 1))
- (or (match-string 3 subject)
- (match-string 5 subject))
- (substring subject
- (match-end 1)))
- subject)))
-
-(defun message-strip-subject-re (subject)
- "Remove \"Re:\" from subject lines in string SUBJECT."
- (if (string-match message-subject-re-regexp subject)
- (substring subject (match-end 0))
- subject))
-
-(defcustom message-replacement-char "."
- "Replacement character used instead of unprintable or not decodable chars."
- :group 'message-various
- :version "22.1" ;; Gnus 5.10.9
- :type '(choice string
- (const ".")
- (const "?")))
-
-;; FIXME: We also should call `message-strip-subject-encoded-words'
-;; when forwarding. Probably in `message-make-forward-subject' and
-;; `message-forward-make-body'.
-
-(defun message-strip-subject-encoded-words (subject)
- "Fix non-decodable words in SUBJECT."
- ;; Cf. `gnus-simplify-subject-fully'.
- (let* ((case-fold-search t)
- (replacement-chars (format "[%s%s%s]"
- message-replacement-char
- message-replacement-char
- message-replacement-char))
- (enc-word-re "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?\\([^?]+\\)\\(\\?=\\)")
- cs-string
- (have-marker
- (with-temp-buffer
- (insert subject)
- (goto-char (point-min))
- (when (re-search-forward enc-word-re nil t)
- (setq cs-string (match-string 1)))))
- cs-coding q-or-b word-beg word-end)
- (if (or (not have-marker) ;; No encoded word found...
- ;; ... or double encoding was correct:
- (and (stringp cs-string)
- (setq cs-string (downcase cs-string))
- (mm-coding-system-p (intern cs-string))
- (not (prog1
- (y-or-n-p
- (format "\
-Decoded Subject \"%s\"
-contains a valid encoded word. Decode again? "
- subject))
- (setq cs-coding (intern cs-string))))))
- subject
- (with-temp-buffer
- (insert subject)
- (goto-char (point-min))
- (while (re-search-forward enc-word-re nil t)
- (setq cs-string (downcase (match-string 1))
- q-or-b (match-string 2)
- word-beg (match-beginning 0)
- word-end (match-end 0))
- (setq cs-coding
- (if (mm-coding-system-p (intern cs-string))
- (setq cs-coding (intern cs-string))
- nil))
- ;; No double encoded subject? => bogus charset.
- (unless cs-coding
- (setq cs-coding
- (mm-read-coding-system
- (format "\
-Decoded Subject \"%s\"
-contains an encoded word. The charset `%s' is unknown or invalid.
-Hit RET to replace non-decodable characters with \"%s\" or enter replacement
-charset: "
- subject cs-string message-replacement-char)))
- (if cs-coding
- (replace-match (concat "=?" (symbol-name cs-coding)
- "?\\2?\\3\\4\\5"))
- (save-excursion
- (goto-char word-beg)
- (re-search-forward "=\\?\\([^?]+\\)\\?\\([QB]\\)\\?" word-end t)
- (replace-match "")
- ;; QP or base64
- (if (string-match "\\`Q\\'" q-or-b)
- ;; QP
- (progn
- (message "Replacing non-decodable characters with \"%s\"."
- message-replacement-char)
- (while (re-search-forward "\\(=[A-F0-9][A-F0-9]\\)+"
- word-end t)
- (replace-match message-replacement-char)))
- ;; base64
- (message "Replacing non-decodable characters with \"%s\"."
- replacement-chars)
- (re-search-forward "[^?]+" word-end t)
- (replace-match replacement-chars))
- (re-search-forward "\\?=")
- (replace-match "")))))
- (rfc2047-decode-region (point-min) (point-max))
- (buffer-string)))))
-
-;;; Start of functions adopted from `message-utils.el'.
-
-(defun message-strip-subject-trailing-was (subject)
- "Remove trailing \"(was: <old subject>)\" from SUBJECT lines.
-Leading \"Re: \" is not stripped by this function. Use the function
-`message-strip-subject-re' for this."
- (let* ((query message-subject-trailing-was-query)
- (new) (found))
- (setq found
- (string-match
- (if (eq query 'ask)
- message-subject-trailing-was-ask-regexp
- message-subject-trailing-was-regexp)
- subject))
- (if found
- (setq new (substring subject 0 (match-beginning 0))))
- (if (or (not found) (eq query nil))
- subject
- (if (eq query 'ask)
- (if (message-y-or-n-p
- "Strip `(was: <old subject>)' in subject? " t
- (concat
- "Strip `(was: <old subject>)' in subject "
- "and use the new one instead?\n\n"
- "Current subject is: \""
- subject "\"\n\n"
- "New subject would be: \""
- new "\"\n\n"
- "See the variable `message-subject-trailing-was-query' "
- "to get rid of this query."
- ))
- new subject)
- new))))
-
-;;; Suggested by Jonas Steverud @ www.dtek.chalmers.se/~d4jonas/
-
-(defun message-change-subject (new-subject)
- "Ask for NEW-SUBJECT header, append (was: <Old Subject>)."
- ;; <URL:http://www.landfield.com/usefor/drafts/draft-ietf-usefor-useage--1.02.unpaged>
- (interactive
- (list
- (read-from-minibuffer "New subject: ")))
- (cond ((and (not (or (null new-subject) ; new subject not empty
- (zerop (string-width new-subject))
- (string-match "^[ \t]*$" new-subject))))
- (save-excursion
- (let ((old-subject
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "Subject"))))
- (cond ((not old-subject)
- (error "No current subject"))
- ((not (string-match
- (concat "^[ \t]*"
- (regexp-quote new-subject)
- " \t]*$")
- old-subject)) ; yes, it really is a new subject
- ;; delete eventual Re: prefix
- (setq old-subject
- (message-strip-subject-re old-subject))
- (message-goto-subject)
- (message-delete-line)
- (insert (concat "Subject: "
- new-subject
- " (was: "
- old-subject ")\n")))))))))
-
-(defun message-mark-inserted-region (beg end)
- "Mark some region in the current article with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "r")
- (save-excursion
- ;; add to the end of the region first, otherwise end would be invalid
- (goto-char end)
- (insert message-mark-insert-end)
- (goto-char beg)
- (insert message-mark-insert-begin)))
-
-(defun message-mark-insert-file (file)
- "Insert FILE at point, marking it with enclosing tags.
-See `message-mark-insert-begin' and `message-mark-insert-end'."
- (interactive "fFile to insert: ")
- ;; reverse insertion to get correct result.
- (let ((p (point)))
- (insert message-mark-insert-end)
- (goto-char p)
- (insert-file-contents file)
- (goto-char p)
- (insert message-mark-insert-begin)))
-
-(defun message-add-archive-header ()
- "Insert \"X-No-Archive: Yes\" in the header and a note in the body.
-The note can be customized using `message-archive-note'. When called with a
-prefix argument, ask for a text to insert. If you don't want the note in the
-body, set `message-archive-note' to nil."
- (interactive)
- (if current-prefix-arg
- (setq message-archive-note
- (read-from-minibuffer "Reason for No-Archive: "
- (cons message-archive-note 0))))
- (save-excursion
- (if (message-goto-signature)
- (re-search-backward message-signature-separator))
- (when message-archive-note
- (insert message-archive-note)
- (newline))
- (message-add-header message-archive-header)
- (message-sort-headers)))
-
-(defun message-cross-post-followup-to-header (target-group)
- "Mangles FollowUp-To and Newsgroups header to point to TARGET-GROUP.
-With prefix-argument just set Follow-Up, don't cross-post."
- (interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
- (message-remove-header "Follow[Uu]p-[Tt]o" t)
- (message-goto-newsgroups)
- (beginning-of-line)
- ;; if we already did a crosspost before, kill old target
- (if (and message-cross-post-old-target
- (re-search-forward
- (regexp-quote (concat "," message-cross-post-old-target))
- nil t))
- (replace-match ""))
- ;; unless (followup is to poster or user explicitly asked not
- ;; to cross-post, or target-group is already in Newsgroups)
- ;; add target-group to Newsgroups line.
- (cond ((and (or
- ;; def: cross-post, req:no
- (and message-cross-post-default (not current-prefix-arg))
- ;; def: no-cross-post, req:yes
- (and (not message-cross-post-default) current-prefix-arg))
- (not (string-match "poster" target-group))
- (not (string-match (regexp-quote target-group)
- (message-fetch-field "Newsgroups"))))
- (end-of-line)
- (insert (concat "," target-group))))
- (end-of-line) ; ensure Followup: comes after Newsgroups:
- ;; unless new followup would be identical to Newsgroups line
- ;; make a new Followup-To line
- (if (not (string-match (concat "^[ \t]*"
- target-group
- "[ \t]*$")
- (message-fetch-field "Newsgroups")))
- (insert (concat "\nFollowup-To: " target-group)))
- (setq message-cross-post-old-target target-group))
-
-(defun message-cross-post-insert-note (target-group cross-post in-old
- old-groups)
- "Insert a in message body note about a set Followup or Crosspost.
-If there have been previous notes, delete them. TARGET-GROUP specifies the
-group to Followup-To. When CROSS-POST is t, insert note about
-crossposting. IN-OLD specifies whether TARGET-GROUP is a member of
-OLD-GROUPS. OLD-GROUPS lists the old-groups the posting would have
-been made to before the user asked for a Crosspost."
- ;; start scanning body for previous uses
- (message-goto-signature)
- (let ((head (re-search-backward
- (concat "^" mail-header-separator)
- nil t))) ; just search in body
- (message-goto-signature)
- (while (re-search-backward
- (concat "^" (regexp-quote message-cross-post-note) ".*")
- head t)
- (message-delete-line))
- (message-goto-signature)
- (while (re-search-backward
- (concat "^" (regexp-quote message-followup-to-note) ".*")
- head t)
- (message-delete-line))
- ;; insert new note
- (if (message-goto-signature)
- (re-search-backward message-signature-separator))
- (if (or in-old
- (not cross-post)
- (string-match "^[ \t]*poster[ \t]*$" target-group))
- (insert (concat message-followup-to-note target-group "\n"))
- (insert (concat message-cross-post-note target-group "\n")))))
-
-(defun message-cross-post-followup-to (target-group)
- "Crossposts message and set Followup-To to TARGET-GROUP.
-With prefix-argument just set Follow-Up, don't cross-post."
- (interactive
- (list ; Completion based on Gnus
- (completing-read "Followup To: "
- (if (boundp 'gnus-newsrc-alist)
- gnus-newsrc-alist)
- nil nil '("poster" . 0)
- (if (boundp 'gnus-group-history)
- 'gnus-group-history))))
- (cond ((not (or (null target-group) ; new subject not empty
- (zerop (string-width target-group))
- (string-match "^[ \t]*$" target-group)))
- (save-excursion
- (let* ((old-groups (message-fetch-field "Newsgroups"))
- (in-old (string-match
- (regexp-quote target-group)
- (or old-groups ""))))
- ;; check whether target exactly matches old Newsgroups
- (cond ((not old-groups)
- (error "No current newsgroup"))
- ((or (not in-old)
- (not (string-match
- (concat "^[ \t]*"
- (regexp-quote target-group)
- "[ \t]*$")
- old-groups)))
- ;; yes, Newsgroups line must change
- (message-cross-post-followup-to-header target-group)
- ;; insert note whether we do cross-post or followup-to
- (funcall message-cross-post-note-function
- target-group
- (if (or (and message-cross-post-default
- (not current-prefix-arg))
- (and (not message-cross-post-default)
- current-prefix-arg)) t)
- in-old old-groups))))))))
-
-;;; Reduce To: to Cc: or Bcc: header
-
-(defun message-reduce-to-to-cc ()
- "Replace contents of To: header with contents of Cc: or Bcc: header."
- (interactive)
- (let ((cc-content
- (save-restriction (message-narrow-to-headers)
- (message-fetch-field "cc")))
- (bcc nil))
- (if (and (not cc-content)
- (setq cc-content
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "bcc"))))
- (setq bcc t))
- (cond (cc-content
- (save-excursion
- (message-goto-to)
- (message-delete-line)
- (insert (concat "To: " cc-content "\n"))
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header (if bcc
- "bcc"
- "cc"))))))))
-
-;;; End of functions adopted from `message-utils.el'.
-
-(defun message-remove-header (header &optional is-regexp first reverse)
- "Remove HEADER in the narrowed buffer.
-If IS-REGEXP, HEADER is a regular expression.
-If FIRST, only remove the first instance of the header.
-Return the number of headers removed."
- (goto-char (point-min))
- (let ((regexp (if is-regexp header (concat "^" (regexp-quote header) ":")))
- (number 0)
- (case-fold-search t)
- last)
- (while (and (not (eobp))
- (not last))
- (if (if reverse
- (not (looking-at regexp))
- (looking-at regexp))
- (progn
- (incf number)
- (when first
- (setq last t))
- (delete-region
- (point)
- ;; There might be a continuation header, so we have to search
- ;; until we find a new non-continuation line.
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \t]" nil t)
- (goto-char (match-beginning 0))
- (point-max)))))
- (forward-line 1)
- (if (re-search-forward "^[^ \t]" nil t)
- (goto-char (match-beginning 0))
- (goto-char (point-max)))))
- number))
-
-(defun message-remove-first-header (header)
- "Remove the first instance of HEADER if there is more than one."
- (let ((count 0)
- (regexp (concat "^" (regexp-quote header) ":")))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (incf count)))
- (while (> count 1)
- (message-remove-header header nil t)
- (decf count))))
-
-(defun message-narrow-to-headers ()
- "Narrow the buffer to the head of the message."
- (widen)
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min)))
-
-(defun message-narrow-to-head-1 ()
- "Like `message-narrow-to-head'. Don't widen."
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil 1)
- (1- (point))
- (point-max)))
- (goto-char (point-min)))
-
-(defun message-narrow-to-head ()
- "Narrow the buffer to the head of the message.
-Point is left at the beginning of the narrowed-to region."
- (widen)
- (message-narrow-to-head-1))
-
-(defun message-narrow-to-headers-or-head ()
- "Narrow the buffer to the head of the message."
- (widen)
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward (concat "\\(\n\\)\n\\|^\\("
- (regexp-quote mail-header-separator)
- "\n\\)")
- nil t)
- (or (match-end 1) (match-beginning 2))
- (point-max)))
- (goto-char (point-min)))
-
-(defun message-news-p ()
- "Say whether the current buffer contains a news message."
- (and (not message-this-is-mail)
- (or message-this-is-news
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (and (message-fetch-field "newsgroups")
- (not (message-fetch-field "posted-to"))))))))
-
-(defun message-mail-p ()
- "Say whether the current buffer contains a mail message."
- (and (not message-this-is-news)
- (or message-this-is-mail
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (or (message-fetch-field "to")
- (message-fetch-field "cc")
- (message-fetch-field "bcc")))))))
-
-(defun message-subscribed-p ()
- "Say whether we need to insert a MFT header."
- (or message-subscribed-regexps
- message-subscribed-addresses
- message-subscribed-address-file
- message-subscribed-address-functions))
-
-(defun message-next-header ()
- "Go to the beginning of the next header."
- (beginning-of-line)
- (or (eobp) (forward-char 1))
- (not (if (re-search-forward "^[^ \t]" nil t)
- (beginning-of-line)
- (goto-char (point-max)))))
-
-(defun message-sort-headers-1 ()
- "Sort the buffer as headers using `message-rank' text props."
- (goto-char (point-min))
- (require 'sort)
- (sort-subr
- nil 'message-next-header
- (lambda ()
- (message-next-header)
- (unless (bobp)
- (forward-char -1)))
- (lambda ()
- (or (get-text-property (point) 'message-rank)
- 10000))))
-
-(defun message-sort-headers ()
- "Sort the headers of the current message according to `message-header-format-alist'."
- (interactive)
- (save-excursion
- (save-restriction
- (let ((max (1+ (length message-header-format-alist)))
- rank)
- (message-narrow-to-headers)
- (while (re-search-forward "^[^ \n]+:" nil t)
- (put-text-property
- (match-beginning 0) (1+ (match-beginning 0))
- 'message-rank
- (if (setq rank (length (memq (assq (intern (buffer-substring
- (match-beginning 0)
- (1- (match-end 0))))
- message-header-format-alist)
- message-header-format-alist)))
- (- max rank)
- (1+ max)))))
- (message-sort-headers-1))))
-
-(defun message-info (&optional arg)
- "Display the Message manual.
-
-Prefixed with one \\[universal-argument], display the Emacs MIME manual.
-Prefixed with two \\[universal-argument]'s, display the PGG manual."
- (interactive "p")
- (cond ((eq arg 16) (Info-goto-node "(pgg)Top"))
- ((eq arg 4) (Info-goto-node "(emacs-mime)Top"))
- (t (Info-goto-node "(message)Top"))))
-
-\f
-
-;;;
-;;; Message mode
-;;;
-
-;;; Set up keymap.
-
-(defvar message-mode-map nil)
-
-(unless message-mode-map
- (setq message-mode-map (make-keymap))
- (set-keymap-parent message-mode-map text-mode-map)
- (define-key message-mode-map "\C-c?" 'describe-mode)
-
- (define-key message-mode-map "\C-c\C-f\C-t" 'message-goto-to)
- (define-key message-mode-map "\C-c\C-f\C-o" 'message-goto-from)
- (define-key message-mode-map "\C-c\C-f\C-b" 'message-goto-bcc)
- (define-key message-mode-map "\C-c\C-f\C-w" 'message-goto-fcc)
- (define-key message-mode-map "\C-c\C-f\C-c" 'message-goto-cc)
- (define-key message-mode-map "\C-c\C-f\C-s" 'message-goto-subject)
- (define-key message-mode-map "\C-c\C-f\C-r" 'message-goto-reply-to)
- (define-key message-mode-map "\C-c\C-f\C-n" 'message-goto-newsgroups)
- (define-key message-mode-map "\C-c\C-f\C-d" 'message-goto-distribution)
- (define-key message-mode-map "\C-c\C-f\C-f" 'message-goto-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-m" 'message-goto-mail-followup-to)
- (define-key message-mode-map "\C-c\C-f\C-k" 'message-goto-keywords)
- (define-key message-mode-map "\C-c\C-f\C-u" 'message-goto-summary)
- (define-key message-mode-map "\C-c\C-f\C-i"
- 'message-insert-or-toggle-importance)
- (define-key message-mode-map "\C-c\C-f\C-a"
- 'message-generate-unsubscribed-mail-followup-to)
-
- ;; modify headers (and insert notes in body)
- (define-key message-mode-map "\C-c\C-fs" 'message-change-subject)
- ;;
- (define-key message-mode-map "\C-c\C-fx" 'message-cross-post-followup-to)
- ;; prefix+message-cross-post-followup-to = same w/o cross-post
- (define-key message-mode-map "\C-c\C-ft" 'message-reduce-to-to-cc)
- (define-key message-mode-map "\C-c\C-fa" 'message-add-archive-header)
- ;; mark inserted text
- (define-key message-mode-map "\C-c\M-m" 'message-mark-inserted-region)
- (define-key message-mode-map "\C-c\M-f" 'message-mark-insert-file)
-
- (define-key message-mode-map "\C-c\C-b" 'message-goto-body)
- (define-key message-mode-map "\C-c\C-i" 'message-goto-signature)
-
- (define-key message-mode-map "\C-c\C-t" 'message-insert-to)
- (define-key message-mode-map "\C-c\C-fw" 'message-insert-wide-reply)
- (define-key message-mode-map "\C-c\C-n" 'message-insert-newsgroups)
- (define-key message-mode-map "\C-c\C-l" 'message-to-list-only)
-
- (define-key message-mode-map "\C-c\C-u" 'message-insert-or-toggle-importance)
- (define-key message-mode-map "\C-c\M-n"
- 'message-insert-disposition-notification-to)
-
- (define-key message-mode-map "\C-c\C-y" 'message-yank-original)
- (define-key message-mode-map "\C-c\M-\C-y" 'message-yank-buffer)
- (define-key message-mode-map "\C-c\C-q" 'message-fill-yanked-message)
- (define-key message-mode-map "\C-c\C-w" 'message-insert-signature)
- (define-key message-mode-map "\C-c\M-h" 'message-insert-headers)
- (define-key message-mode-map "\C-c\C-r" 'message-caesar-buffer-body)
- (define-key message-mode-map "\C-c\C-o" 'message-sort-headers)
- (define-key message-mode-map "\C-c\M-r" 'message-rename-buffer)
-
- (define-key message-mode-map "\C-c\C-c" 'message-send-and-exit)
- (define-key message-mode-map "\C-c\C-s" 'message-send)
- (define-key message-mode-map "\C-c\C-k" 'message-kill-buffer)
- (define-key message-mode-map "\C-c\C-d" 'message-dont-send)
- (define-key message-mode-map "\C-c\n" 'gnus-delay-article)
-
- (define-key message-mode-map "\C-c\C-e" 'message-elide-region)
- (define-key message-mode-map "\C-c\C-v" 'message-delete-not-region)
- (define-key message-mode-map "\C-c\C-z" 'message-kill-to-signature)
- (define-key message-mode-map "\M-\r" 'message-newline-and-reformat)
- ;;(define-key message-mode-map "\M-q" 'message-fill-paragraph)
- (define-key message-mode-map [remap split-line] 'message-split-line)
-
- (define-key message-mode-map "\C-c\C-a" 'mml-attach-file)
-
- (define-key message-mode-map "\C-a" 'message-beginning-of-line)
- (define-key message-mode-map "\t" 'message-tab)
- (define-key message-mode-map "\M-;" 'comment-region))
-
-(easy-menu-define
- message-mode-menu message-mode-map "Message Menu."
- `("Message"
- ["Yank Original" message-yank-original message-reply-buffer]
- ["Fill Yanked Message" message-fill-yanked-message t]
- ["Insert Signature" message-insert-signature t]
- ["Caesar (rot13) Message" message-caesar-buffer-body t]
- ["Caesar (rot13) Region" message-caesar-region (message-mark-active-p)]
- ["Elide Region" message-elide-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Replace text in region with an ellipsis"))]
- ["Delete Outside Region" message-delete-not-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Delete all quoted text outside region"))]
- ["Kill To Signature" message-kill-to-signature t]
- ["Newline and Reformat" message-newline-and-reformat t]
- ["Rename buffer" message-rename-buffer t]
- ["Spellcheck" ispell-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Spellcheck this message"))]
- "----"
- ["Insert Region Marked" message-mark-inserted-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Mark region with enclosing tags"))]
- ["Insert File Marked..." message-mark-insert-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert file at point marked with enclosing tags"))]
- "----"
- ["Send Message" message-send-and-exit
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Send this message"))]
- ["Postpone Message" message-dont-send
- ,@(if (featurep 'xemacs) '(t)
- '(:help "File this draft message and exit"))]
- ["Send at Specific Time..." gnus-delay-article
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Ask, then arrange to send message at that time"))]
- ["Kill Message" message-kill-buffer
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Delete this message without sending"))]
- "----"
- ["Message manual" message-info
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the Message manual"))]))
-
-(easy-menu-define
- message-mode-field-menu message-mode-map ""
- `("Field"
- ["To" message-goto-to t]
- ["From" message-goto-from t]
- ["Subject" message-goto-subject t]
- ["Change subject..." message-change-subject t]
- ["Cc" message-goto-cc t]
- ["Bcc" message-goto-bcc t]
- ["Fcc" message-goto-fcc t]
- ["Reply-To" message-goto-reply-to t]
- ["Flag As Important" message-insert-importance-high
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark this message as important"))]
- ["Flag As Unimportant" message-insert-importance-low
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Mark this message as unimportant"))]
- ["Request Receipt"
- message-insert-disposition-notification-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Request a receipt notification"))]
- "----"
- ;; (typical) news stuff
- ["Summary" message-goto-summary t]
- ["Keywords" message-goto-keywords t]
- ["Newsgroups" message-goto-newsgroups t]
- ["Fetch Newsgroups" message-insert-newsgroups t]
- ["Followup-To" message-goto-followup-to t]
- ;; ["Followup-To (with note in body)" message-cross-post-followup-to t]
- ["Crosspost / Followup-To..." message-cross-post-followup-to t]
- ["Distribution" message-goto-distribution t]
- ["X-No-Archive:" message-add-archive-header t ]
- "----"
- ;; (typical) mailing-lists stuff
- ["Fetch To" message-insert-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a To header that points to the author."))]
- ["Fetch To and Cc" message-insert-wide-reply
- ,@(if (featurep 'xemacs) '(t)
- '(:help
- "Insert To and Cc headers as if you were doing a wide reply."))]
- "----"
- ["Send to list only" message-to-list-only t]
- ["Mail-Followup-To" message-goto-mail-followup-to t]
- ["Unsubscribed list post" message-generate-unsubscribed-mail-followup-to
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Insert a reasonable `Mail-Followup-To:' header."))]
- ["Reduce To: to Cc:" message-reduce-to-to-cc t]
- "----"
- ["Sort Headers" message-sort-headers t]
- ["Encode non-ASCII domain names" message-idna-to-ascii-rhs t]
- ["Goto Body" message-goto-body t]
- ["Goto Signature" message-goto-signature t]))
-
-(defvar message-tool-bar-map nil)
-
-(eval-when-compile
- (defvar facemenu-add-face-function)
- (defvar facemenu-remove-face-function))
-
-;;; Forbidden properties
-;;
-;; We use `after-change-functions' to keep special text properties
-;; that interfer with the normal function of message mode out of the
-;; buffer.
-
-(defcustom message-strip-special-text-properties t
- "Strip special properties from the message buffer.
-
-Emacs has a number of special text properties which can break message
-composing in various ways. If this option is set, message will strip
-these properties from the message composition buffer. However, some
-packages requires these properties to be present in order to work.
-If you use one of these packages, turn this option off, and hope the
-message composition doesn't break too bad."
- :version "22.1"
- :group 'message-various
- :link '(custom-manual "(message)Various Message Variables")
- :type 'boolean)
-
-(defconst message-forbidden-properties
- ;; No reason this should be clutter up customize. We make it a
- ;; property list (rather than a list of property symbols), to be
- ;; directly useful for `remove-text-properties'.
- '(field nil read-only nil invisible nil intangible nil
- mouse-face nil modification-hooks nil insert-in-front-hooks nil
- insert-behind-hooks nil point-entered nil point-left nil)
- ;; Other special properties:
- ;; category, face, display: probably doesn't do any harm.
- ;; fontified: is used by font-lock.
- ;; syntax-table, local-map: I dunno.
- ;; We need to add XEmacs names to the list.
- "Property list of with properties forbidden in message buffers.
-The values of the properties are ignored, only the property names are used.")
-
-(defun message-tamago-not-in-use-p (pos)
- "Return t when tamago version 4 is not in use at the cursor position.
-Tamago version 4 is a popular input method for writing Japanese text.
-It uses the properties `intangible', `invisible', `modification-hooks'
-and `read-only' when translating ascii or kana text to kanji text.
-These properties are essential to work, so we should never strip them."
- (not (and (boundp 'egg-modefull-mode)
- (symbol-value 'egg-modefull-mode)
- (or (memq (get-text-property pos 'intangible)
- '(its-part-1 its-part-2))
- (get-text-property pos 'egg-end)
- (get-text-property pos 'egg-lang)
- (get-text-property pos 'egg-start)))))
-
-(defun message-strip-forbidden-properties (begin end &optional old-length)
- "Strip forbidden properties between BEGIN and END, ignoring the third arg.
-This function is intended to be called from `after-change-functions'.
-See also `message-forbidden-properties'."
- (when (and message-strip-special-text-properties
- (message-tamago-not-in-use-p begin))
- (let ((buffer-read-only nil)
- (inhibit-read-only t))
- (while (not (= begin end))
- (when (not (get-text-property begin 'message-hidden))
- (remove-text-properties begin (1+ begin)
- message-forbidden-properties))
- (incf begin)))))
-
-;;;###autoload
-(define-derived-mode message-mode text-mode "Message"
- "Major mode for editing mail and news to be sent.
-Like Text Mode but with these additional commands:\\<message-mode-map>
-C-c C-s `message-send' (send the message) C-c C-c `message-send-and-exit'
-C-c C-d Postpone sending the message C-c C-k Kill the message
-C-c C-f move to a header field (and create it if there isn't):
- C-c C-f C-t move to To C-c C-f C-s move to Subject
- C-c C-f C-c move to Cc C-c C-f C-b move to Bcc
- C-c C-f C-w move to Fcc C-c C-f C-r move to Reply-To
- C-c C-f C-u move to Summary C-c C-f C-n move to Newsgroups
- C-c C-f C-k move to Keywords C-c C-f C-d move to Distribution
- C-c C-f C-o move to From (\"Originator\")
- C-c C-f C-f move to Followup-To
- C-c C-f C-m move to Mail-Followup-To
- C-c C-f C-i cycle through Importance values
- C-c C-f s change subject and append \"(was: <Old Subject>)\"
- C-c C-f x crossposting with FollowUp-To header and note in body
- C-c C-f t replace To: header with contents of Cc: or Bcc:
- C-c C-f a Insert X-No-Archive: header and a note in the body
-C-c C-t `message-insert-to' (add a To header to a news followup)
-C-c C-l `message-to-list-only' (removes all but list address in to/cc)
-C-c C-n `message-insert-newsgroups' (add a Newsgroup header to a news reply)
-C-c C-b `message-goto-body' (move to beginning of message text).
-C-c C-i `message-goto-signature' (move to the beginning of the signature).
-C-c C-w `message-insert-signature' (insert `message-signature-file' file).
-C-c C-y `message-yank-original' (insert current message, if any).
-C-c C-q `message-fill-yanked-message' (fill what was yanked).
-C-c C-e `message-elide-region' (elide the text between point and mark).
-C-c C-v `message-delete-not-region' (remove the text outside the region).
-C-c C-z `message-kill-to-signature' (kill the text up to the signature).
-C-c C-r `message-caesar-buffer-body' (rot13 the message body).
-C-c C-a `mml-attach-file' (attach a file as MIME).
-C-c C-u `message-insert-or-toggle-importance' (insert or cycle importance).
-C-c M-n `message-insert-disposition-notification-to' (request receipt).
-C-c M-m `message-mark-inserted-region' (mark region with enclosing tags).
-C-c M-f `message-mark-insert-file' (insert file marked with enclosing tags).
-M-RET `message-newline-and-reformat' (break the line and reformat)."
- (setq local-abbrev-table text-mode-abbrev-table)
- (set (make-local-variable 'message-reply-buffer) nil)
- (set (make-local-variable 'message-inserted-headers) nil)
- (set (make-local-variable 'message-send-actions) nil)
- (set (make-local-variable 'message-exit-actions) nil)
- (set (make-local-variable 'message-kill-actions) nil)
- (set (make-local-variable 'message-postpone-actions) nil)
- (set (make-local-variable 'message-draft-article) nil)
- (setq buffer-offer-save t)
- (set (make-local-variable 'facemenu-add-face-function)
- (lambda (face end)
- (let ((face-fun (cdr (assq face message-face-alist))))
- (if face-fun
- (funcall face-fun (point) end)
- (error "Face %s not configured for %s mode" face mode-name)))
- ""))
- (set (make-local-variable 'facemenu-remove-face-function) t)
- (set (make-local-variable 'message-reply-headers) nil)
- (make-local-variable 'message-newsreader)
- (make-local-variable 'message-mailer)
- (make-local-variable 'message-post-method)
- (set (make-local-variable 'message-sent-message-via) nil)
- (set (make-local-variable 'message-checksum) nil)
- (set (make-local-variable 'message-mime-part) 0)
- (message-setup-fill-variables)
- ;; Allow using comment commands to add/remove quoting.
- ;; (set (make-local-variable 'comment-start) message-yank-prefix)
- (when message-yank-prefix
- (set (make-local-variable 'comment-start) message-yank-prefix)
- (set (make-local-variable 'comment-start-skip)
- (concat "^" (regexp-quote message-yank-prefix) "[ \t]*")))
- (if (featurep 'xemacs)
- (message-setup-toolbar)
- (set (make-local-variable 'font-lock-defaults)
- '(message-font-lock-keywords t))
- (if (boundp 'tool-bar-map)
- (set (make-local-variable 'tool-bar-map) (message-make-tool-bar))))
- (easy-menu-add message-mode-menu message-mode-map)
- (easy-menu-add message-mode-field-menu message-mode-map)
- (gnus-make-local-hook 'after-change-functions)
- ;; Mmmm... Forbidden properties...
- (add-hook 'after-change-functions 'message-strip-forbidden-properties
- nil 'local)
- ;; Allow mail alias things.
- (when (eq message-mail-alias-type 'abbrev)
- (if (fboundp 'mail-abbrevs-setup)
- (mail-abbrevs-setup)
- (if (fboundp 'mail-aliases-setup) ; warning avoidance
- (mail-aliases-setup))))
- (unless buffer-file-name
- (message-set-auto-save-file-name))
- (unless (buffer-base-buffer)
- ;; Don't enable multibyte on an indirect buffer. Maybe enabling
- ;; multibyte is not necessary at all. -- zsh
- (mm-enable-multibyte))
- (set (make-local-variable 'indent-tabs-mode) nil) ;No tabs for indentation.
- (mml-mode))
-
-(defun message-setup-fill-variables ()
- "Setup message fill variables."
- (set (make-local-variable 'fill-paragraph-function)
- 'message-fill-paragraph)
- (make-local-variable 'paragraph-separate)
- (make-local-variable 'paragraph-start)
- (make-local-variable 'adaptive-fill-regexp)
- (unless (boundp 'adaptive-fill-first-line-regexp)
- (setq adaptive-fill-first-line-regexp nil))
- (make-local-variable 'adaptive-fill-first-line-regexp)
- (let ((quote-prefix-regexp
- ;; User should change message-cite-prefix-regexp if
- ;; message-yank-prefix is set to an abnormal value.
- (concat "\\(" message-cite-prefix-regexp "\\)[ \t]*")))
- (setq paragraph-start
- (concat
- (regexp-quote mail-header-separator) "$\\|"
- "[ \t]*$\\|" ; blank lines
- "-- $\\|" ; signature delimiter
- "---+$\\|" ; delimiters for forwarded messages
- page-delimiter "$\\|" ; spoiler warnings
- ".*wrote:$\\|" ; attribution lines
- quote-prefix-regexp "$\\|" ; empty lines in quoted text
- ; mml tags
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\|secure\\)"))
- (setq paragraph-separate paragraph-start)
- (setq adaptive-fill-regexp
- (concat quote-prefix-regexp "\\|" adaptive-fill-regexp))
- (setq adaptive-fill-first-line-regexp
- (concat quote-prefix-regexp "\\|"
- adaptive-fill-first-line-regexp)))
- (make-local-variable 'auto-fill-inhibit-regexp)
- ;;(setq auto-fill-inhibit-regexp "^[A-Z][^: \n\t]+:")
- (setq auto-fill-inhibit-regexp nil)
- (make-local-variable 'normal-auto-fill-function)
- (setq normal-auto-fill-function 'message-do-auto-fill)
- ;; KLUDGE: auto fill might already be turned on in `text-mode-hook'.
- ;; In that case, ensure that it uses the right function. The real
- ;; solution would be not to use `define-derived-mode', and run
- ;; `text-mode-hook' ourself at the end of the mode.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-19.
- (when auto-fill-function
- (setq auto-fill-function normal-auto-fill-function)))
-
-\f
-
-;;;
-;;; Message mode commands
-;;;
-
-;;; Movement commands
-
-(defun message-goto-to ()
- "Move point to the To header."
- (interactive)
- (message-position-on-field "To"))
-
-(defun message-goto-from ()
- "Move point to the From header."
- (interactive)
- (message-position-on-field "From"))
-
-(defun message-goto-subject ()
- "Move point to the Subject header."
- (interactive)
- (message-position-on-field "Subject"))
-
-(defun message-goto-cc ()
- "Move point to the Cc header."
- (interactive)
- (message-position-on-field "Cc" "To"))
-
-(defun message-goto-bcc ()
- "Move point to the Bcc header."
- (interactive)
- (message-position-on-field "Bcc" "Cc" "To"))
-
-(defun message-goto-fcc ()
- "Move point to the Fcc header."
- (interactive)
- (message-position-on-field "Fcc" "To" "Newsgroups"))
-
-(defun message-goto-reply-to ()
- "Move point to the Reply-To header."
- (interactive)
- (message-position-on-field "Reply-To" "Subject"))
-
-(defun message-goto-newsgroups ()
- "Move point to the Newsgroups header."
- (interactive)
- (message-position-on-field "Newsgroups"))
-
-(defun message-goto-distribution ()
- "Move point to the Distribution header."
- (interactive)
- (message-position-on-field "Distribution"))
-
-(defun message-goto-followup-to ()
- "Move point to the Followup-To header."
- (interactive)
- (message-position-on-field "Followup-To" "Newsgroups"))
-
-(defun message-goto-mail-followup-to ()
- "Move point to the Mail-Followup-To header."
- (interactive)
- (message-position-on-field "Mail-Followup-To" "To"))
-
-(defun message-goto-keywords ()
- "Move point to the Keywords header."
- (interactive)
- (message-position-on-field "Keywords" "Subject"))
-
-(defun message-goto-summary ()
- "Move point to the Summary header."
- (interactive)
- (message-position-on-field "Summary" "Subject"))
-
-(defun message-goto-body (&optional interactivep)
- "Move point to the beginning of the message body."
- (interactive (list t))
- (when (and interactivep
- (looking-at "[ \t]*\n"))
- (expand-abbrev))
- (goto-char (point-min))
- (or (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (search-forward-regexp "[^:]+:\\([^\n]\\|\n[ \t]\\)+\n\n" nil t)))
-
-(defun message-in-body-p ()
- "Return t if point is in the message body."
- (let ((body (save-excursion (message-goto-body) (point))))
- (>= (point) body)))
-
-(defun message-goto-eoh ()
- "Move point to the end of the headers."
- (interactive)
- (message-goto-body)
- (forward-line -1))
-
-(defun message-goto-signature ()
- "Move point to the beginning of the message signature.
-If there is no signature in the article, go to the end and
-return nil."
- (interactive)
- (goto-char (point-min))
- (if (re-search-forward message-signature-separator nil t)
- (forward-line 1)
- (goto-char (point-max))
- nil))
-
-(defun message-generate-unsubscribed-mail-followup-to (&optional include-cc)
- "Insert a reasonable MFT header in a post to an unsubscribed list.
-When making original posts to a mailing list you are not subscribed to,
-you have to type in a MFT header by hand. The contents, usually, are
-the addresses of the list and your own address. This function inserts
-such a header automatically. It fetches the contents of the To: header
-in the current mail buffer, and appends the current `user-mail-address'.
-
-If the optional argument INCLUDE-CC is non-nil, the addresses in the
-Cc: header are also put into the MFT."
-
- (interactive "P")
- (let* (cc tos)
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "Mail-Followup-To")
- (setq cc (and include-cc (message-fetch-field "Cc")))
- (setq tos (if cc
- (concat (message-fetch-field "To") "," cc)
- (message-fetch-field "To"))))
- (message-goto-mail-followup-to)
- (insert (concat tos ", " user-mail-address))))
-
-\f
-
-(defun message-insert-to (&optional force)
- "Insert a To header that points to the author of the article being replied to.
-If the original author requested not to be sent mail, don't insert unless the
-prefix FORCE is given."
- (interactive "P")
- (let* ((mct (message-fetch-reply-field "mail-copies-to"))
- (dont (and mct (or (equal (downcase mct) "never")
- (equal (downcase mct) "nobody"))))
- (to (or (message-fetch-reply-field "mail-reply-to")
- (message-fetch-reply-field "reply-to")
- (message-fetch-reply-field "from"))))
- (when (and dont to)
- (message
- (if force
- "Ignoring the user request not to have copies sent via mail"
- "Complying with the user request not to have copies sent via mail")))
- (when (and force (not to))
- (error "No mail address in the article"))
- (when (and to (or force (not dont)))
- (message-carefully-insert-headers (list (cons 'To to))))))
-
-(defun message-insert-wide-reply ()
- "Insert To and Cc headers as if you were doing a wide reply."
- (interactive)
- (let ((headers (message-with-reply-buffer
- (message-get-reply-headers t))))
- (message-carefully-insert-headers headers)))
-
-(defcustom message-header-synonyms
- '((To Cc Bcc)
- (Original-To))
- "List of lists of header synonyms.
-E.g., if this list contains a member list with elements `Cc' and `To',
-then `message-carefully-insert-headers' will not insert a `To' header
-when the message is already `Cc'ed to the recipient."
- :version "22.1"
- :group 'message-headers
- :link '(custom-manual "(message)Message Headers")
- :type '(repeat sexp))
-
-(defun message-carefully-insert-headers (headers)
- "Insert the HEADERS, an alist, into the message buffer.
-Does not insert the headers when they are already present there
-or in the synonym headers, defined by `message-header-synonyms'."
- ;; FIXME: Should compare only the address and not the full name. Comparison
- ;; should be done case-folded (and with `string=' rather than
- ;; `string-match').
- ;; (mail-strip-quoted-names "Foo Bar <foo@bar>, bla@fasel (Bla Fasel)")
- (dolist (header headers)
- (let* ((header-name (symbol-name (car header)))
- (new-header (cdr header))
- (synonyms (loop for synonym in message-header-synonyms
- when (memq (car header) synonym) return synonym))
- (old-header
- (loop for synonym in synonyms
- for old-header = (mail-fetch-field (symbol-name synonym))
- when (and old-header (string-match new-header old-header))
- return synonym)))
- (if old-header
- (message "already have `%s' in `%s'" new-header old-header)
- (when (and (message-position-on-field header-name)
- (setq old-header (mail-fetch-field header-name))
- (not (string-match "\\` *\\'" old-header)))
- (insert ", "))
- (insert new-header)))))
-
-(defun message-widen-reply ()
- "Widen the reply to include maximum recipients."
- (interactive)
- (let ((follow-to
- (and message-reply-buffer
- (buffer-name message-reply-buffer)
- (save-excursion
- (set-buffer message-reply-buffer)
- (message-get-reply-headers t)))))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (dolist (elem follow-to)
- (message-remove-header (symbol-name (car elem)))
- (goto-char (point-min))
- (insert (symbol-name (car elem)) ": "
- (cdr elem) "\n"))))))
-
-(defun message-insert-newsgroups ()
- "Insert the Newsgroups header from the article being replied to."
- (interactive)
- (when (and (message-position-on-field "Newsgroups")
- (mail-fetch-field "newsgroups")
- (not (string-match "\\` *\\'" (mail-fetch-field "newsgroups"))))
- (insert ","))
- (insert (or (message-fetch-reply-field "newsgroups") "")))
-
-\f
-
-;;; Various commands
-
-(defun message-delete-not-region (beg end)
- "Delete everything in the body of the current message outside of the region."
- (interactive "r")
- (let (citeprefix)
- (save-excursion
- (goto-char beg)
- ;; snarf citation prefix, if appropriate
- (unless (eq (point) (progn (beginning-of-line) (point)))
- (when (looking-at message-cite-prefix-regexp)
- (setq citeprefix (match-string 0))))
- (goto-char end)
- (delete-region (point) (if (not (message-goto-signature))
- (point)
- (forward-line -2)
- (point)))
- (insert "\n")
- (goto-char beg)
- (delete-region beg (progn (message-goto-body)
- (forward-line 2)
- (point)))
- (when citeprefix
- (insert citeprefix))))
- (when (message-goto-signature)
- (forward-line -2)))
-
-(defun message-kill-to-signature ()
- "Deletes all text up to the signature."
- (interactive)
- (let ((point (point)))
- (message-goto-signature)
- (unless (eobp)
- (end-of-line -1))
- (kill-region point (point))
- (unless (bolp)
- (insert "\n"))))
-
-(defun message-newline-and-reformat (&optional arg not-break)
- "Insert four newlines, and then reformat if inside quoted text.
-Prefix arg means justify as well."
- (interactive (list (if current-prefix-arg 'full)))
- (let (quoted point beg end leading-space bolp)
- (setq point (point))
- (beginning-of-line)
- (setq beg (point))
- (setq bolp (= beg point))
- ;; Find first line of the paragraph.
- (if not-break
- (while (and (not (eobp))
- (not (looking-at message-cite-prefix-regexp))
- (looking-at paragraph-start))
- (forward-line 1)))
- ;; Find the prefix
- (when (looking-at message-cite-prefix-regexp)
- (setq quoted (match-string 0))
- (goto-char (match-end 0))
- (looking-at "[ \t]*")
- (setq leading-space (match-string 0)))
- (if (and quoted
- (not not-break)
- (not bolp)
- (< (- point beg) (length quoted)))
- ;; break inside the cite prefix.
- (setq quoted nil
- end nil))
- (if quoted
- (progn
- (forward-line 1)
- (while (and (not (eobp))
- (not (looking-at paragraph-separate))
- (looking-at message-cite-prefix-regexp)
- (equal quoted (match-string 0)))
- (goto-char (match-end 0))
- (looking-at "[ \t]*")
- (if (> (length leading-space) (length (match-string 0)))
- (setq leading-space (match-string 0)))
- (forward-line 1))
- (setq end (point))
- (goto-char beg)
- (while (and (if (bobp) nil (forward-line -1) t)
- (not (looking-at paragraph-start))
- (looking-at message-cite-prefix-regexp)
- (equal quoted (match-string 0)))
- (setq beg (point))
- (goto-char (match-end 0))
- (looking-at "[ \t]*")
- (if (> (length leading-space) (length (match-string 0)))
- (setq leading-space (match-string 0)))))
- (while (and (not (eobp))
- (not (looking-at paragraph-separate))
- (not (looking-at message-cite-prefix-regexp)))
- (forward-line 1))
- (setq end (point))
- (goto-char beg)
- (while (and (if (bobp) nil (forward-line -1) t)
- (not (looking-at paragraph-start))
- (not (looking-at message-cite-prefix-regexp)))
- (setq beg (point))))
- (goto-char point)
- (save-restriction
- (narrow-to-region beg end)
- (if not-break
- (setq point nil)
- (if bolp
- (newline)
- (newline)
- (newline))
- (setq point (point))
- ;; (newline 2) doesn't mark both newline's as hard, so call
- ;; newline twice. -jas
- (newline)
- (newline)
- (delete-region (point) (re-search-forward "[ \t]*"))
- (when (and quoted (not bolp))
- (insert quoted leading-space)))
- (undo-boundary)
- (if quoted
- (let* ((adaptive-fill-regexp
- (regexp-quote (concat quoted leading-space)))
- (adaptive-fill-first-line-regexp
- adaptive-fill-regexp ))
- (fill-paragraph arg))
- (fill-paragraph arg))
- (if point (goto-char point)))))
-
-(defun message-fill-paragraph (&optional arg)
- "Like `fill-paragraph'."
- (interactive (list (if current-prefix-arg 'full)))
- (if (if (boundp 'filladapt-mode) filladapt-mode)
- nil
- (message-newline-and-reformat arg t)
- t))
-
-;; Is it better to use `mail-header-end'?
-(defun message-point-in-header-p ()
- "Return t if point is in the header."
- (save-excursion
- (let ((p (point)))
- (goto-char (point-min))
- (not (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n")
- p t)))))
-
-(defun message-do-auto-fill ()
- "Like `do-auto-fill', but don't fill in message header."
- (unless (message-point-in-header-p)
- (do-auto-fill)))
-
-(defun message-insert-signature (&optional force)
- "Insert a signature. See documentation for variable `message-signature'."
- (interactive (list 0))
- (let* ((signature
- (cond
- ((and (null message-signature)
- (eq force 0))
- (save-excursion
- (goto-char (point-max))
- (not (re-search-backward message-signature-separator nil t))))
- ((and (null message-signature)
- force)
- t)
- ((functionp message-signature)
- (funcall message-signature))
- ((listp message-signature)
- (eval message-signature))
- (t message-signature)))
- (signature
- (cond ((stringp signature)
- signature)
- ((and (eq t signature)
- message-signature-file
- (file-exists-p message-signature-file))
- signature))))
- (when signature
- (goto-char (point-max))
- ;; Insert the signature.
- (unless (bolp)
- (insert "\n"))
- (when message-signature-insert-empty-line
- (insert "\n"))
- (insert "-- \n")
- (if (eq signature t)
- (insert-file-contents message-signature-file)
- (insert signature))
- (goto-char (point-max))
- (or (bolp) (insert "\n")))))
-
-(defun message-insert-importance-high ()
- "Insert header to mark message as important."
- (interactive)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "Importance"))
- (message-goto-eoh)
- (insert "Importance: high\n")))
-
-(defun message-insert-importance-low ()
- "Insert header to mark message as unimportant."
- (interactive)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "Importance"))
- (message-goto-eoh)
- (insert "Importance: low\n")))
-
-(defun message-insert-or-toggle-importance ()
- "Insert a \"Importance: high\" header, or cycle through the header values.
-The three allowed values according to RFC 1327 are `high', `normal'
-and `low'."
- (interactive)
- (save-excursion
- (let ((valid '("high" "normal" "low"))
- (new "high")
- cur)
- (save-restriction
- (message-narrow-to-headers)
- (when (setq cur (message-fetch-field "Importance"))
- (message-remove-header "Importance")
- (setq new (cond ((string= cur "high")
- "low")
- ((string= cur "low")
- "normal")
- (t
- "high")))))
- (message-goto-eoh)
- (insert (format "Importance: %s\n" new)))))
-
-(defun message-insert-disposition-notification-to ()
- "Request a disposition notification (return receipt) to this message.
-Note that this should not be used in newsgroups."
- (interactive)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-remove-header "Disposition-Notification-To"))
- (message-goto-eoh)
- (insert (format "Disposition-Notification-To: %s\n"
- (or (message-field-value "Reply-to")
- (message-field-value "From")
- (message-make-from))))))
-
-(defun message-elide-region (b e)
- "Elide the text in the region.
-An ellipsis (from `message-elide-ellipsis') will be inserted where the
-text was killed."
- (interactive "r")
- (kill-region b e)
- (insert message-elide-ellipsis))
-
-(defvar message-caesar-translation-table nil)
-
-(defun message-caesar-region (b e &optional n)
- "Caesar rotate region B to E by N, default 13, for decrypting netnews."
- (interactive
- (list
- (min (point) (or (mark t) (point)))
- (max (point) (or (mark t) (point)))
- (when current-prefix-arg
- (prefix-numeric-value current-prefix-arg))))
-
- (setq n (if (numberp n) (mod n 26) 13)) ;canonize N
- (unless (or (zerop n) ; no action needed for a rot of 0
- (= b e)) ; no region to rotate
- ;; We build the table, if necessary.
- (when (or (not message-caesar-translation-table)
- (/= (aref message-caesar-translation-table ?a) (+ ?a n)))
- (setq message-caesar-translation-table
- (message-make-caesar-translation-table n)))
- (translate-region b e message-caesar-translation-table)))
-
-(defun message-make-caesar-translation-table (n)
- "Create a rot table with offset N."
- (let ((i -1)
- (table (make-string 256 0)))
- (while (< (incf i) 256)
- (aset table i i))
- (concat
- (substring table 0 ?A)
- (substring table (+ ?A n) (+ ?A n (- 26 n)))
- (substring table ?A (+ ?A n))
- (substring table (+ ?A 26) ?a)
- (substring table (+ ?a n) (+ ?a n (- 26 n)))
- (substring table ?a (+ ?a n))
- (substring table (+ ?a 26) 255))))
-
-(defun message-caesar-buffer-body (&optional rotnum)
- "Caesar rotate all letters in the current buffer by 13 places.
-Used to encode/decode possibly offensive messages (commonly in rec.humor).
-With prefix arg, specifies the number of places to rotate each letter forward.
-Mail and USENET news headers are not rotated."
- (interactive (if current-prefix-arg
- (list (prefix-numeric-value current-prefix-arg))
- (list nil)))
- (save-excursion
- (save-restriction
- (when (message-goto-body)
- (narrow-to-region (point) (point-max)))
- (message-caesar-region (point-min) (point-max) rotnum))))
-
-(defun message-pipe-buffer-body (program)
- "Pipe the message body in the current buffer through PROGRAM."
- (save-excursion
- (save-restriction
- (when (message-goto-body)
- (narrow-to-region (point) (point-max)))
- (shell-command-on-region
- (point-min) (point-max) program nil t))))
-
-(defun message-rename-buffer (&optional enter-string)
- "Rename the *message* buffer to \"*message* RECIPIENT\".
-If the function is run with a prefix, it will ask for a new buffer
-name, rather than giving an automatic name."
- (interactive "Pbuffer name: ")
- (save-excursion
- (save-restriction
- (goto-char (point-min))
- (narrow-to-region (point)
- (search-forward mail-header-separator nil 'end))
- (let* ((mail-to (or
- (if (message-news-p) (message-fetch-field "Newsgroups")
- (message-fetch-field "To"))
- ""))
- (mail-trimmed-to
- (if (string-match "," mail-to)
- (concat (substring mail-to 0 (match-beginning 0)) ", ...")
- mail-to))
- (name-default (concat "*message* " mail-trimmed-to))
- (name (if enter-string
- (read-string "New buffer name: " name-default)
- name-default)))
- (rename-buffer name t)))))
-
-(defun message-fill-yanked-message (&optional justifyp)
- "Fill the paragraphs of a message yanked into this one.
-Numeric argument means justify as well."
- (interactive "P")
- (save-excursion
- (goto-char (point-min))
- (search-forward (concat "\n" mail-header-separator "\n") nil t)
- (let ((fill-prefix message-yank-prefix))
- (fill-individual-paragraphs (point) (point-max) justifyp))))
-
-(defun message-indent-citation ()
- "Modify text just inserted from a message to be cited.
-The inserted text should be the region.
-When this function returns, the region is again around the modified text.
-
-Normally, indent each nonblank line `message-indentation-spaces' spaces.
-However, if `message-yank-prefix' is non-nil, insert that prefix on each line."
- (let ((start (point)))
- ;; Remove unwanted headers.
- (when message-ignored-cited-headers
- (let (all-removed)
- (save-restriction
- (narrow-to-region
- (goto-char start)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point)))
- (message-remove-header message-ignored-cited-headers t)
- (when (= (point-min) (point-max))
- (setq all-removed t))
- (goto-char (point-max)))
- (if all-removed
- (goto-char start)
- (forward-line 1))))
- ;; Delete blank lines at the start of the buffer.
- (while (and (point-min)
- (eolp)
- (not (eobp)))
- (message-delete-line))
- ;; Delete blank lines at the end of the buffer.
- (goto-char (point-max))
- (unless (eolp)
- (insert "\n"))
- (while (and (zerop (forward-line -1))
- (looking-at "$"))
- (message-delete-line))
- ;; Do the indentation.
- (if (null message-yank-prefix)
- (indent-rigidly start (mark t) message-indentation-spaces)
- (save-excursion
- (goto-char start)
- (while (< (point) (mark t))
- (if (or (looking-at ">") (looking-at "^$"))
- (insert message-yank-cited-prefix)
- (insert message-yank-prefix))
- (forward-line 1))))
- (goto-char start)))
-
-(defun message-yank-original (&optional arg)
- "Insert the message being replied to, if any.
-Puts point before the text and mark after.
-Normally indents each nonblank line ARG spaces (default 3). However,
-if `message-yank-prefix' is non-nil, insert that prefix on each line.
-
-This function uses `message-cite-function' to do the actual citing.
-
-Just \\[universal-argument] as argument means don't indent, insert no
-prefix, and don't delete any headers."
- (interactive "P")
- (let ((modified (buffer-modified-p)))
- (when (and message-reply-buffer
- message-cite-function)
- (delete-windows-on message-reply-buffer t)
- (push-mark (save-excursion
- (insert-buffer-substring message-reply-buffer)
- (unless (bolp)
- (insert ?\n))
- (point)))
- (unless arg
- (funcall message-cite-function)
- (unless (eq (char-before (mark t)) ?\n)
- (let ((pt (point)))
- (goto-char (mark t))
- (insert-before-markers ?\n)
- (goto-char pt))))
- (unless modified
- (setq message-checksum (message-checksum))))))
-
-(defun message-yank-buffer (buffer)
- "Insert BUFFER into the current buffer and quote it."
- (interactive "bYank buffer: ")
- (let ((message-reply-buffer (get-buffer buffer)))
- (save-window-excursion
- (message-yank-original))))
-
-(defun message-buffers ()
- "Return a list of active message buffers."
- (let (buffers)
- (save-excursion
- (dolist (buffer (buffer-list t))
- (set-buffer buffer)
- (when (and (eq major-mode 'message-mode)
- (null message-sent-message-via))
- (push (buffer-name buffer) buffers))))
- (nreverse buffers)))
-
-(defun message-cite-original-without-signature ()
- "Cite function in the standard Message manner.
-This function strips off the signature from the original message."
- (let* ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function))))
- ;; This function may be called by `gnus-summary-yank-message' and
- ;; may insert a different article from the original. So, we will
- ;; modify the value of `message-reply-headers' with that article.
- (message-reply-headers
- (save-restriction
- (narrow-to-region start end)
- (message-narrow-to-head-1)
- (vector 0
- (or (message-fetch-field "subject") "none")
- (or (message-fetch-field "from") "nobody")
- (message-fetch-field "date")
- (message-fetch-field "message-id" t)
- (message-fetch-field "references")
- 0 0 ""))))
- (mml-quote-region start end)
- ;; Allow undoing.
- (undo-boundary)
- (goto-char end)
- (when (re-search-backward message-signature-separator start t)
- ;; Also peel off any blank lines before the signature.
- (forward-line -1)
- (while (looking-at "^[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (delete-region (point) end)
- (unless (search-backward "\n\n" start t)
- ;; Insert a blank line if it is peeled off.
- (insert "\n")))
- (goto-char start)
- (while functions
- (funcall (pop functions)))
- (when message-citation-line-function
- (unless (bolp)
- (insert "\n"))
- (funcall message-citation-line-function))))
-
-(eval-when-compile (defvar mail-citation-hook)) ;Compiler directive
-(defun message-cite-original ()
- "Cite function in the standard Message manner."
- (if (and (boundp 'mail-citation-hook)
- mail-citation-hook)
- (run-hooks 'mail-citation-hook)
- (let* ((start (point))
- (end (mark t))
- (functions
- (when message-indent-citation-function
- (if (listp message-indent-citation-function)
- message-indent-citation-function
- (list message-indent-citation-function))))
- ;; This function may be called by `gnus-summary-yank-message' and
- ;; may insert a different article from the original. So, we will
- ;; modify the value of `message-reply-headers' with that article.
- (message-reply-headers
- (save-restriction
- (narrow-to-region start end)
- (message-narrow-to-head-1)
- (vector 0
- (or (message-fetch-field "subject") "none")
- (or (message-fetch-field "from") "nobody")
- (message-fetch-field "date")
- (message-fetch-field "message-id" t)
- (message-fetch-field "references")
- 0 0 ""))))
- (mml-quote-region start end)
- (goto-char start)
- (while functions
- (funcall (pop functions)))
- (when message-citation-line-function
- (unless (bolp)
- (insert "\n"))
- (funcall message-citation-line-function)))))
-
-(defun message-insert-citation-line ()
- "Insert a simple citation line."
- (when message-reply-headers
- (insert (mail-header-from message-reply-headers) " writes:")
- (newline)
- (newline)))
-
-(defun message-position-on-field (header &rest afters)
- (let ((case-fold-search t))
- (save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (progn
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (match-beginning 0)))
- (goto-char (point-min))
- (if (re-search-forward (concat "^" (regexp-quote header) ":") nil t)
- (progn
- (re-search-forward "^[^ \t]" nil 'move)
- (beginning-of-line)
- (skip-chars-backward "\n")
- t)
- (while (and afters
- (not (re-search-forward
- (concat "^" (regexp-quote (car afters)) ":")
- nil t)))
- (pop afters))
- (when afters
- (re-search-forward "^[^ \t]" nil 'move)
- (beginning-of-line))
- (insert header ": \n")
- (forward-char -1)
- nil))))
-
-(defun message-remove-signature ()
- "Remove the signature from the text between point and mark.
-The text will also be indented the normal way."
- (save-excursion
- (let ((start (point))
- mark)
- (if (not (re-search-forward message-signature-separator (mark t) t))
- ;; No signature here, so we just indent the cited text.
- (message-indent-citation)
- ;; Find the last non-empty line.
- (forward-line -1)
- (while (looking-at "[ \t]*$")
- (forward-line -1))
- (forward-line 1)
- (setq mark (set-marker (make-marker) (point)))
- (goto-char start)
- (message-indent-citation)
- ;; Enable undoing the deletion.
- (undo-boundary)
- (delete-region mark (mark t))
- (set-marker mark nil)))))
-
-\f
-
-;;;
-;;; Sending messages
-;;;
-
-(defun message-send-and-exit (&optional arg)
- "Send message like `message-send', then, if no errors, exit from mail buffer."
- (interactive "P")
- (let ((buf (current-buffer))
- (actions message-exit-actions))
- (when (and (message-send arg)
- (buffer-name buf))
- (if message-kill-buffer-on-exit
- (kill-buffer buf)
- (bury-buffer buf)
- (when (eq buf (current-buffer))
- (message-bury buf)))
- (message-do-actions actions)
- t)))
-
-(defun message-dont-send ()
- "Don't send the message you have been editing.
-Instead, just auto-save the buffer and then bury it."
- (interactive)
- (set-buffer-modified-p t)
- (save-buffer)
- (let ((actions message-postpone-actions))
- (message-bury (current-buffer))
- (message-do-actions actions)))
-
-(defun message-kill-buffer ()
- "Kill the current buffer."
- (interactive)
- (when (or (not (buffer-modified-p))
- (yes-or-no-p "Message modified; kill anyway? "))
- (let ((actions message-kill-actions)
- (draft-article message-draft-article)
- (auto-save-file-name buffer-auto-save-file-name)
- (file-name buffer-file-name)
- (modified (buffer-modified-p)))
- (setq buffer-file-name nil)
- (kill-buffer (current-buffer))
- (when (and (or (and auto-save-file-name
- (file-exists-p auto-save-file-name))
- (and file-name
- (file-exists-p file-name)))
- (progn
- ;; If the message buffer has lived in a dedicated window,
- ;; `kill-buffer' has killed the frame. Thus the
- ;; `yes-or-no-p' may show up in a lowered frame. Make sure
- ;; that the user can see the question by raising the
- ;; current frame:
- (raise-frame)
- (yes-or-no-p (format "Remove the backup file%s? "
- (if modified " too" "")))))
- (ignore-errors
- (delete-file auto-save-file-name))
- (let ((message-draft-article draft-article))
- (message-disassociate-draft)))
- (message-do-actions actions))))
-
-(defun message-bury (buffer)
- "Bury this mail BUFFER."
- (let ((newbuf (other-buffer buffer)))
- (bury-buffer buffer)
- (if (and (window-dedicated-p (selected-window))
- (not (null (delq (selected-frame) (visible-frame-list)))))
- (delete-frame (selected-frame))
- (switch-to-buffer newbuf))))
-
-(defun message-send (&optional arg)
- "Send the message in the current buffer.
-If `message-interactive' is non-nil, wait for success indication or
-error messages, and inform user.
-Otherwise any failure is reported in a message back to the user from
-the mailer.
-The usage of ARG is defined by the instance that called Message.
-It should typically alter the sending method in some way or other."
- (interactive "P")
- ;; Make it possible to undo the coming changes.
- (undo-boundary)
- (let ((inhibit-read-only t))
- (put-text-property (point-min) (point-max) 'read-only nil))
- (message-fix-before-sending)
- (run-hooks 'message-send-hook)
- (message message-sending-message)
- (let ((alist message-send-method-alist)
- (success t)
- elem sent dont-barf-on-no-method
- (message-options message-options))
- (message-options-set-recipient)
- (while (and success
- (setq elem (pop alist)))
- (when (funcall (cadr elem))
- (when (and (or (not (memq (car elem)
- message-sent-message-via))
- (message-fetch-field "supersedes")
- (if (or (message-gnksa-enable-p 'multiple-copies)
- (not (eq (car elem) 'news)))
- (y-or-n-p
- (format
- "Already sent message via %s; resend? "
- (car elem)))
- (error "Denied posting -- multiple copies")))
- (setq success (funcall (caddr elem) arg)))
- (setq sent t))))
- (unless (or sent
- (not success)
- (let ((fcc (message-fetch-field "Fcc"))
- (gcc (message-fetch-field "Gcc")))
- (when (or fcc gcc)
- (or (eq message-allow-no-recipients 'always)
- (and (not (eq message-allow-no-recipients 'never))
- (setq dont-barf-on-no-method
- (gnus-y-or-n-p
- (format "No receiver, perform %s anyway? "
- (cond ((and fcc gcc) "Fcc and Gcc")
- (fcc "Fcc")
- (t "Gcc"))))))))))
- (error "No methods specified to send by"))
- (when (or dont-barf-on-no-method
- (and success sent))
- (message-do-fcc)
- (save-excursion
- (run-hooks 'message-sent-hook))
- (message "Sending...done")
- ;; Mark the buffer as unmodified and delete auto-save.
- (set-buffer-modified-p nil)
- (delete-auto-save-file-if-necessary t)
- (message-disassociate-draft)
- ;; Delete other mail buffers and stuff.
- (message-do-send-housekeeping)
- (message-do-actions message-send-actions)
- ;; Return success.
- t)))
-
-(defun message-send-via-mail (arg)
- "Send the current message via mail."
- (message-send-mail arg))
-
-(defun message-send-via-news (arg)
- "Send the current message via news."
- (funcall message-send-news-function arg))
-
-(defmacro message-check (type &rest forms)
- "Eval FORMS if TYPE is to be checked."
- `(or (message-check-element ,type)
- (save-excursion
- ,@forms)))
-
-(put 'message-check 'lisp-indent-function 1)
-(put 'message-check 'edebug-form-spec '(form body))
-
-(defun message-text-with-property (prop)
- "Return a list of all points where the text has PROP."
- (let ((points nil)
- (point (point-min)))
- (save-excursion
- (while (< point (point-max))
- (when (get-text-property point prop)
- (push point points))
- (incf point)))
- (nreverse points)))
-
-(defun message-fix-before-sending ()
- "Do various things to make the message nice before sending it."
- ;; Make sure there's a newline at the end of the message.
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- ;; Make the hidden headers visible.
- (let ((points (message-text-with-property 'message-hidden)))
- (when points
- (goto-char (car points))
- (dolist (point points)
- (add-text-properties point (1+ point)
- '(invisible nil intangible nil)))))
- ;; Make invisible text visible.
- ;; It doesn't seem as if this is useful, since the invisible property
- ;; is clobbered by an after-change hook anyhow.
- (message-check 'invisible-text
- (let ((points (message-text-with-property 'invisible)))
- (when points
- (goto-char (car points))
- (dolist (point points)
- (put-text-property point (1+ point) 'invisible nil)
- (message-overlay-put (message-make-overlay point (1+ point))
- 'face 'highlight))
- (unless (yes-or-no-p
- "Invisible text found and made visible; continue sending? ")
- (error "Invisible text found and made visible")))))
- (message-check 'illegible-text
- (let (found choice)
- (message-goto-body)
- (skip-chars-forward mm-7bit-chars)
- (while (not (eobp))
- (when (let ((char (char-after)))
- (or (< (mm-char-int char) 128)
- (and (mm-multibyte-p)
- (memq (char-charset char)
- '(eight-bit-control eight-bit-graphic
- control-1))
- (not (get-text-property
- (point) 'untranslated-utf-8)))))
- (message-overlay-put (message-make-overlay (point) (1+ (point)))
- 'face 'highlight)
- (setq found t))
- (forward-char)
- (skip-chars-forward mm-7bit-chars))
- (when found
- (setq choice
- (gnus-multiple-choice
- "Non-printable characters found. Continue sending?"
- `((?d "Remove non-printable characters and send")
- (?r ,(format
- "Replace non-printable characters with \"%s\" and send"
- message-replacement-char))
- (?i "Ignore non-printable characters and send")
- (?e "Continue editing"))))
- (if (eq choice ?e)
- (error "Non-printable characters"))
- (message-goto-body)
- (skip-chars-forward mm-7bit-chars)
- (while (not (eobp))
- (when (let ((char (char-after)))
- (or (< (mm-char-int char) 128)
- (and (mm-multibyte-p)
- ;; FIXME: Wrong for Emacs 23 (unicode) and for
- ;; things like undecable utf-8. Should at least
- ;; use find-coding-systems-region.
- (memq (char-charset char)
- '(eight-bit-control eight-bit-graphic
- control-1))
- (not (get-text-property
- (point) 'untranslated-utf-8)))))
- (if (eq choice ?i)
- (message-kill-all-overlays)
- (delete-char 1)
- (when (eq choice ?r)
- (insert message-replacement-char))))
- (forward-char)
- (skip-chars-forward mm-7bit-chars))))))
-
-(defun message-add-action (action &rest types)
- "Add ACTION to be performed when doing an exit of type TYPES."
- (while types
- (add-to-list (intern (format "message-%s-actions" (pop types)))
- action)))
-
-(defun message-delete-action (action &rest types)
- "Delete ACTION from lists of actions performed when doing an exit of type TYPES."
- (let (var)
- (while types
- (set (setq var (intern (format "message-%s-actions" (pop types))))
- (delq action (symbol-value var))))))
-
-(defun message-do-actions (actions)
- "Perform all actions in ACTIONS."
- ;; Now perform actions on successful sending.
- (while actions
- (ignore-errors
- (cond
- ;; A simple function.
- ((functionp (car actions))
- (funcall (car actions)))
- ;; Something to be evaled.
- (t
- (eval (car actions)))))
- (pop actions)))
-
-(defun message-send-mail-partially ()
- "Send mail as message/partial."
- ;; replace the header delimiter with a blank line
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (run-hooks 'message-send-mail-hook)
- (let ((p (goto-char (point-min)))
- (tembuf (message-generate-new-buffer-clone-locals " message temp"))
- (curbuf (current-buffer))
- (id (message-make-message-id)) (n 1)
- plist total header required-mail-headers)
- (while (not (eobp))
- (if (< (point-max) (+ p message-send-mail-partially-limit))
- (goto-char (point-max))
- (goto-char (+ p message-send-mail-partially-limit))
- (beginning-of-line)
- (if (<= (point) p) (forward-line 1))) ;; In case of bad message.
- (push p plist)
- (setq p (point)))
- (setq total (length plist))
- (push (point-max) plist)
- (setq plist (nreverse plist))
- (unwind-protect
- (save-excursion
- (setq p (pop plist))
- (while plist
- (set-buffer curbuf)
- (copy-to-buffer tembuf p (car plist))
- (set-buffer tembuf)
- (goto-char (point-min))
- (if header
- (progn
- (goto-char (point-min))
- (narrow-to-region (point) (point))
- (insert header))
- (message-goto-eoh)
- (setq header (buffer-substring (point-min) (point)))
- (goto-char (point-min))
- (narrow-to-region (point) (point))
- (insert header)
- (message-remove-header "Mime-Version")
- (message-remove-header "Content-Type")
- (message-remove-header "Content-Transfer-Encoding")
- (message-remove-header "Message-ID")
- (message-remove-header "Lines")
- (goto-char (point-max))
- (insert "Mime-Version: 1.0\n")
- (setq header (buffer-string)))
- (goto-char (point-max))
- (insert (format "Content-Type: message/partial; id=\"%s\"; number=%d; total=%d\n\n"
- id n total))
- (forward-char -1)
- (let ((mail-header-separator ""))
- (when (memq 'Message-ID message-required-mail-headers)
- (insert "Message-ID: " (message-make-message-id) "\n"))
- (when (memq 'Lines message-required-mail-headers)
- (insert "Lines: " (message-make-lines) "\n"))
- (message-goto-subject)
- (end-of-line)
- (insert (format " (%d/%d)" n total))
- (widen)
- (mm-with-unibyte-current-buffer
- (funcall (or message-send-mail-real-function
- message-send-mail-function))))
- (setq n (+ n 1))
- (setq p (pop plist))
- (erase-buffer)))
- (kill-buffer tembuf))))
-
-(defun message-send-mail (&optional arg)
- (require 'mail-utils)
- (let* ((tembuf (message-generate-new-buffer-clone-locals " message temp"))
- (case-fold-search nil)
- (news (message-news-p))
- (mailbuf (current-buffer))
- (message-this-is-mail t)
- (message-posting-charset
- (if (fboundp 'gnus-setup-posting-charset)
- (gnus-setup-posting-charset nil)
- message-posting-charset))
- (headers message-required-mail-headers))
- (save-restriction
- (message-narrow-to-headers)
- ;; Generate the Mail-Followup-To header if the header is not there...
- (if (and (message-subscribed-p)
- (not (mail-fetch-field "mail-followup-to")))
- (setq headers
- (cons
- (cons "Mail-Followup-To" (message-make-mail-followup-to))
- message-required-mail-headers))
- ;; otherwise, delete the MFT header if the field is empty
- (when (equal "" (mail-fetch-field "mail-followup-to"))
- (message-remove-header "^Mail-Followup-To:")))
- ;; Insert some headers.
- (let ((message-deletable-headers
- (if news nil message-deletable-headers)))
- (message-generate-headers headers))
- ;; Check continuation headers.
- (message-check 'continuation-headers
- (goto-char (point-min))
- (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t)
- (goto-char (match-beginning 0))
- (if (y-or-n-p "Fix continuation lines? ")
- (insert " ")
- (forward-line 1)
- (unless (y-or-n-p "Send anyway? ")
- (error "Failed to send the message")))))
- ;; Let the user do all of the above.
- (run-hooks 'message-header-hook))
- (unwind-protect
- (save-excursion
- (set-buffer tembuf)
- (erase-buffer)
- ;; Avoid copying text props (except hard newlines).
- (insert (with-current-buffer mailbuf
- (mml-buffer-substring-no-properties-except-hard-newlines
- (point-min) (point-max))))
- ;; Remove some headers.
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- ;; We (re)generate the Lines header.
- (when (memq 'Lines message-required-mail-headers)
- (message-generate-headers '(Lines)))
- ;; Remove some headers.
- (message-remove-header message-ignored-mail-headers t)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (message-cleanup-headers)
- ;; FIXME: we're inserting the courtesy copy after encoding.
- ;; This is wrong if the courtesy copy string contains
- ;; non-ASCII characters. -- jh
- (when
- (save-restriction
- (message-narrow-to-headers)
- (and news
- (or (message-fetch-field "cc")
- (message-fetch-field "bcc")
- (message-fetch-field "to"))
- (let ((content-type (message-fetch-field
- "content-type")))
- (and
- (or
- (not content-type)
- (string= "text/plain"
- (car
- (mail-header-parse-content-type
- content-type))))
- (not
- (string= "base64"
- (message-fetch-field
- "content-transfer-encoding")))))))
- (message-insert-courtesy-copy))
- (if (or (not message-send-mail-partially-limit)
- (< (buffer-size) message-send-mail-partially-limit)
- (not (message-y-or-n-p
- "The message size is too large, split? "
- t
- "\
-The message size, "
- (/ (buffer-size) 1000) "KB, is too large.
-
-Some mail gateways (MTA's) bounce large messages. To avoid the
-problem, answer `y', and the message will be split into several
-smaller pieces, the size of each is about "
- (/ message-send-mail-partially-limit 1000)
- "KB except the last
-one.
-
-However, some mail readers (MUA's) can't read split messages, i.e.,
-mails in message/partially format. Answer `n', and the message will be
-sent in one piece.
-
-The size limit is controlled by `message-send-mail-partially-limit'.
-If you always want Gnus to send messages in one piece, set
-`message-send-mail-partially-limit' to nil.
-")))
- (mm-with-unibyte-current-buffer
- (message "Sending via mail...")
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
- (message-send-mail-partially)))
- (kill-buffer tembuf))
- (set-buffer mailbuf)
- (push 'mail message-sent-message-via)))
-
-(defun message-send-mail-with-sendmail ()
- "Send off the prepared buffer with sendmail."
- (let ((errbuf (if message-interactive
- (message-generate-new-buffer-clone-locals
- " sendmail errors")
- 0))
- resend-to-addresses delimline)
- (unwind-protect
- (progn
- (let ((case-fold-search t))
- (save-restriction
- (message-narrow-to-headers)
- (setq resend-to-addresses (message-fetch-field "resent-to")))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- (run-hooks 'message-send-mail-hook)
- ;; Insert an extra newline if we need it to work around
- ;; Sun's bug that swallows newlines.
- (goto-char (1+ delimline))
- (when (eval message-mailer-swallows-blank-line)
- (newline))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (erase-buffer))))
- (let* ((default-directory "/")
- (coding-system-for-write message-send-coding-system)
- (cpr (apply
- 'call-process-region
- (append
- (list (point-min) (point-max)
- (cond ((boundp 'sendmail-program)
- sendmail-program)
- ((file-exists-p "/usr/sbin/sendmail")
- "/usr/sbin/sendmail")
- ((file-exists-p "/usr/lib/sendmail")
- "/usr/lib/sendmail")
- ((file-exists-p "/usr/ucblib/sendmail")
- "/usr/ucblib/sendmail")
- (t "fakemail"))
- nil errbuf nil "-oi")
- ;; Always specify who from,
- ;; since some systems have broken sendmails.
- ;; But some systems are more broken with -f, so
- ;; we'll let users override this.
- (if (null message-sendmail-f-is-evil)
- (list "-f" (message-sendmail-envelope-from)))
- ;; These mean "report errors by mail"
- ;; and "deliver in background".
- (if (null message-interactive) '("-oem" "-odb"))
- ;; Get the addresses from the message
- ;; unless this is a resend.
- ;; We must not do that for a resend
- ;; because we would find the original addresses.
- ;; For a resend, include the specific addresses.
- (if resend-to-addresses
- (list resend-to-addresses)
- '("-t"))))))
- (unless (or (null cpr) (and (numberp cpr) (zerop cpr)))
- (error "Sending...failed with exit value %d" cpr)))
- (when message-interactive
- (save-excursion
- (set-buffer errbuf)
- (goto-char (point-min))
- (while (re-search-forward "\n\n* *" nil t)
- (replace-match "; "))
- (if (not (zerop (buffer-size)))
- (error "Sending...failed to %s"
- (buffer-string))))))
- (when (bufferp errbuf)
- (kill-buffer errbuf)))))
-
-(defun message-send-mail-with-qmail ()
- "Pass the prepared message buffer to qmail-inject.
-Refer to the documentation for the variable `message-send-mail-function'
-to find out how to use this."
- ;; replace the header delimiter with a blank line
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (run-hooks 'message-send-mail-hook)
- ;; send the message
- (case
- (let ((coding-system-for-write message-send-coding-system))
- (apply
- 'call-process-region (point-min) (point-max)
- message-qmail-inject-program nil nil nil
- ;; qmail-inject's default behaviour is to look for addresses on the
- ;; command line; if there're none, it scans the headers.
- ;; yes, it does The Right Thing w.r.t. Resent-To and it's kin.
- ;;
- ;; in general, ALL of qmail-inject's defaults are perfect for simply
- ;; reading a formatted (i. e., at least a To: or Resent-To header)
- ;; message from stdin.
- ;;
- ;; qmail also has the advantage of not having been raped by
- ;; various vendors, so we don't have to allow for that, either --
- ;; compare this with message-send-mail-with-sendmail and weep
- ;; for sendmail's lost innocence.
- ;;
- ;; all this is way cool coz it lets us keep the arguments entirely
- ;; free for -inject-arguments -- a big win for the user and for us
- ;; since we don't have to play that double-guessing game and the user
- ;; gets full control (no gestapo'ish -f's, for instance). --sj
- (if (functionp message-qmail-inject-args)
- (funcall message-qmail-inject-args)
- message-qmail-inject-args)))
- ;; qmail-inject doesn't say anything on it's stdout/stderr,
- ;; we have to look at the retval instead
- (0 nil)
- (100 (error "qmail-inject reported permanent failure"))
- (111 (error "qmail-inject reported transient failure"))
- ;; should never happen
- (t (error "qmail-inject reported unknown failure"))))
-
-(defun message-send-mail-with-mh ()
- "Send the prepared message buffer with mh."
- (let ((mh-previous-window-config nil)
- (name (mh-new-draft-name)))
- (setq buffer-file-name name)
- ;; MH wants to generate these headers itself.
- (when message-mh-deletable-headers
- (let ((headers message-mh-deletable-headers))
- (while headers
- (goto-char (point-min))
- (and (re-search-forward
- (concat "^" (symbol-name (car headers)) ": *") nil t)
- (message-delete-line))
- (pop headers))))
- (run-hooks 'message-send-mail-hook)
- ;; Pass it on to mh.
- (mh-send-letter)))
-
-(defun message-smtpmail-send-it ()
- "Send the prepared message buffer with `smtpmail-send-it'.
-This only differs from `smtpmail-send-it' that this command evaluates
-`message-send-mail-hook' just before sending a message. It is useful
-if your ISP requires the POP-before-SMTP authentication. See the Gnus
-manual for details."
- (run-hooks 'message-send-mail-hook)
- (smtpmail-send-it))
-
-(defun message-canlock-generate ()
- "Return a string that is non-trivial to guess.
-Do not use this for anything important, it is cryptographically weak."
- (require 'sha1)
- (let (sha1-maximum-internal-length)
- (sha1 (concat (message-unique-id)
- (format "%x%x%x" (random) (random t) (random))
- (prin1-to-string (recent-keys))
- (prin1-to-string (garbage-collect))))))
-
-(defun message-canlock-password ()
- "The password used by message for cancel locks.
-This is the value of `canlock-password', if that option is non-nil.
-Otherwise, generate and save a value for `canlock-password' first."
- (unless canlock-password
- (customize-save-variable 'canlock-password (message-canlock-generate))
- (setq canlock-password-for-verify canlock-password))
- canlock-password)
-
-(defun message-insert-canlock ()
- (when message-insert-canlock
- (message-canlock-password)
- (canlock-insert-header)))
-
-(defun message-send-news (&optional arg)
- (let* ((tembuf (message-generate-new-buffer-clone-locals " *message temp*"))
- (case-fold-search nil)
- (method (if (functionp message-post-method)
- (funcall message-post-method arg)
- message-post-method))
- (newsgroups-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- (followup-field (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Followup-To")))
- ;; BUG: We really need to get the charset for each name in the
- ;; Newsgroups and Followup-To lines to allow crossposting
- ;; between group namess with incompatible character sets.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> 2001-10-08.
- (group-field-charset
- (gnus-group-name-charset method newsgroups-field))
- (followup-field-charset
- (gnus-group-name-charset method (or followup-field "")))
- (rfc2047-header-encoding-alist
- (append (when group-field-charset
- (list (cons "Newsgroups" group-field-charset)))
- (when followup-field-charset
- (list (cons "Followup-To" followup-field-charset)))
- rfc2047-header-encoding-alist))
- (messbuf (current-buffer))
- (message-syntax-checks
- (if (and arg
- (listp message-syntax-checks))
- (cons '(existing-newsgroups . disabled)
- message-syntax-checks)
- message-syntax-checks))
- (message-this-is-news t)
- (message-posting-charset
- (gnus-setup-posting-charset newsgroups-field))
- result)
- (if (not (message-check-news-body-syntax))
- nil
- (save-restriction
- (message-narrow-to-headers)
- ;; Insert some headers.
- (message-generate-headers message-required-news-headers)
- (message-insert-canlock)
- ;; Let the user do all of the above.
- (run-hooks 'message-header-hook))
- ;; Note: This check will be disabled by the ".*" default value for
- ;; gnus-group-name-charset-group-alist. -- Pa 2001-10-07.
- (when (and group-field-charset
- (listp message-syntax-checks))
- (setq message-syntax-checks
- (cons '(valid-newsgroups . disabled)
- message-syntax-checks)))
- (message-cleanup-headers)
- (if (not (let ((message-post-method method))
- (message-check-news-syntax)))
- nil
- (unwind-protect
- (save-excursion
- (set-buffer tembuf)
- (buffer-disable-undo)
- (erase-buffer)
- ;; Avoid copying text props (except hard newlines).
- (insert
- (with-current-buffer messbuf
- (mml-buffer-substring-no-properties-except-hard-newlines
- (point-min) (point-max))))
- (message-encode-message-body)
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
- ;; We (re)generate the Lines header.
- (when (memq 'Lines message-required-mail-headers)
- (message-generate-headers '(Lines)))
- ;; Remove some headers.
- (message-remove-header message-ignored-news-headers t)
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (let ((case-fold-search t))
- ;; Remove the delimiter.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1))
- (run-hooks 'message-send-news-hook)
- (gnus-open-server method)
- (message "Sending news via %s..." (gnus-server-string method))
- (setq result (let ((mail-header-separator ""))
- (gnus-request-post method))))
- (kill-buffer tembuf))
- (set-buffer messbuf)
- (if result
- (push 'news message-sent-message-via)
- (message "Couldn't send message via news: %s"
- (nnheader-get-report (car method)))
- nil)))))
-
-;;;
-;;; Header generation & syntax checking.
-;;;
-
-(defun message-check-element (type)
- "Return non-nil if this TYPE is not to be checked."
- (if (eq message-syntax-checks 'dont-check-for-anything-just-trust-me)
- t
- (let ((able (assq type message-syntax-checks)))
- (and (consp able)
- (eq (cdr able) 'disabled)))))
-
-(defun message-check-news-syntax ()
- "Check the syntax of the message."
- (save-excursion
- (save-restriction
- (widen)
- ;; We narrow to the headers and check them first.
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-check-news-header-syntax))))))
-
-(defun message-check-news-header-syntax ()
- (and
- ;; Check Newsgroups header.
- (message-check 'newsgroups
- (let ((group (message-fetch-field "newsgroups")))
- (or
- (and group
- (not (string-match "\\`[ \t]*\\'" group)))
- (ignore
- (message
- "The newsgroups field is empty or missing. Posting is denied.")))))
- ;; Check the Subject header.
- (message-check 'subject
- (let* ((case-fold-search t)
- (subject (message-fetch-field "subject")))
- (or
- (and subject
- (not (string-match "\\`[ \t]*\\'" subject)))
- (ignore
- (message
- "The subject field is empty or missing. Posting is denied.")))))
- ;; Check for commands in Subject.
- (message-check 'subject-cmsg
- (if (string-match "^cmsg " (message-fetch-field "subject"))
- (y-or-n-p
- "The control code \"cmsg\" is in the subject. Really post? ")
- t))
- ;; Check long header lines.
- (message-check 'long-header-lines
- (let ((start (point))
- (header nil)
- (length 0)
- found)
- (while (and (not found)
- (re-search-forward "^\\([^ \t:]+\\): " nil t))
- (if (> (- (point) (match-beginning 0)) 998)
- (setq found t
- length (- (point) (match-beginning 0)))
- (setq header (match-string-no-properties 1)))
- (setq start (match-beginning 0))
- (forward-line 1))
- (if found
- (y-or-n-p (format "Your %s header is too long (%d). Really post? "
- header length))
- t)))
- ;; Check for multiple identical headers.
- (message-check 'multiple-headers
- (let (found)
- (while (and (not found)
- (re-search-forward "^[^ \t:]+: " nil t))
- (save-excursion
- (or (re-search-forward
- (concat "^"
- (regexp-quote
- (setq found
- (buffer-substring
- (match-beginning 0) (- (match-end 0) 2))))
- ":")
- nil t)
- (setq found nil))))
- (if found
- (y-or-n-p (format "Multiple %s headers. Really post? " found))
- t)))
- ;; Check for Version and Sendsys.
- (message-check 'sendsys
- (if (re-search-forward "^Sendsys:\\|^Version:" nil t)
- (y-or-n-p
- (format "The article contains a %s command. Really post? "
- (buffer-substring (match-beginning 0)
- (1- (match-end 0)))))
- t))
- ;; See whether we can shorten Followup-To.
- (message-check 'shorten-followup-to
- (let ((newsgroups (message-fetch-field "newsgroups"))
- (followup-to (message-fetch-field "followup-to"))
- to)
- (when (and newsgroups
- (string-match "," newsgroups)
- (not followup-to)
- (not
- (zerop
- (length
- (setq to (completing-read
- "Followups to (default no Followup-To header): "
- (mapcar #'list
- (cons "poster"
- (message-tokenize-header
- newsgroups)))))))))
- (goto-char (point-min))
- (insert "Followup-To: " to "\n"))
- t))
- ;; Check "Shoot me".
- (message-check 'shoot
- (if (re-search-forward
- "Message-ID.*.i-did-not-set--mail-host-address--so-tickle-me" nil t)
- (y-or-n-p "You appear to have a misconfigured system. Really post? ")
- t))
- ;; Check for Approved.
- (message-check 'approved
- (if (re-search-forward "^Approved:" nil t)
- (y-or-n-p "The article contains an Approved header. Really post? ")
- t))
- ;; Check the Message-ID header.
- (message-check 'message-id
- (let* ((case-fold-search t)
- (message-id (message-fetch-field "message-id" t)))
- (or (not message-id)
- ;; Is there an @ in the ID?
- (and (string-match "@" message-id)
- ;; Is there a dot in the ID?
- (string-match "@[^.]*\\." message-id)
- ;; Does the ID end with a dot?
- (not (string-match "\\.>" message-id)))
- (y-or-n-p
- (format "The Message-ID looks strange: \"%s\". Really post? "
- message-id)))))
- ;; Check the Newsgroups & Followup-To headers.
- (message-check 'existing-newsgroups
- (let* ((case-fold-search t)
- (newsgroups (message-fetch-field "newsgroups"))
- (followup-to (message-fetch-field "followup-to"))
- (groups (message-tokenize-header
- (if followup-to
- (concat newsgroups "," followup-to)
- newsgroups)))
- (post-method (if (functionp message-post-method)
- (funcall message-post-method)
- message-post-method))
- ;; KLUDGE to handle nnvirtual groups. Doing this right
- ;; would probably involve a new nnoo function.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk>, 2001-10-17.
- (method (if (and (consp post-method)
- (eq (car post-method) 'nnvirtual)
- gnus-message-group-art)
- (let ((group (car (nnvirtual-find-group-art
- (car gnus-message-group-art)
- (cdr gnus-message-group-art)))))
- (gnus-find-method-for-group group))
- post-method))
- (known-groups
- (mapcar (lambda (n)
- (gnus-group-name-decode
- (gnus-group-real-name n)
- (gnus-group-name-charset method n)))
- (gnus-groups-from-server method)))
- errors)
- (while groups
- (when (and (not (equal (car groups) "poster"))
- (not (member (car groups) known-groups))
- (not (member (car groups) errors)))
- (push (car groups) errors))
- (pop groups))
- (cond
- ;; Gnus is not running.
- ((or (not (and (boundp 'gnus-active-hashtb)
- gnus-active-hashtb))
- (not (boundp 'gnus-read-active-file)))
- t)
- ;; We don't have all the group names.
- ((and (or (not gnus-read-active-file)
- (eq gnus-read-active-file 'some))
- errors)
- (y-or-n-p
- (format
- "Really use %s possibly unknown group%s: %s? "
- (if (= (length errors) 1) "this" "these")
- (if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", "))))
- ;; There were no errors.
- ((not errors)
- t)
- ;; There are unknown groups.
- (t
- (y-or-n-p
- (format
- "Really post to %s unknown group%s: %s? "
- (if (= (length errors) 1) "this" "these")
- (if (= (length errors) 1) "" "s")
- (mapconcat 'identity errors ", ")))))))
- ;; Check continuation headers.
- (message-check 'continuation-headers
- (goto-char (point-min))
- (let ((do-posting t))
- (while (re-search-forward "^[^ \t\n][^ \t\n:]*[ \t\n]" nil t)
- (goto-char (match-beginning 0))
- (if (y-or-n-p "Fix continuation lines? ")
- (insert " ")
- (forward-line 1)
- (unless (y-or-n-p "Send anyway? ")
- (setq do-posting nil))))
- do-posting))
- ;; Check the Newsgroups & Followup-To headers for syntax errors.
- (message-check 'valid-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error)
- (while (and headers (not error))
- (when (setq header (mail-fetch-field (car headers)))
- (if (or
- (not
- (string-match
- "\\`\\([-+_&.a-zA-Z0-9]+\\)?\\(,[-+_&.a-zA-Z0-9]+\\)*\\'"
- header))
- (memq
- nil (mapcar
- (lambda (g)
- (not (string-match "\\.\\'\\|\\.\\." g)))
- (message-tokenize-header header ","))))
- (setq error t)))
- (unless error
- (pop headers)))
- (if (not error)
- t
- (y-or-n-p
- (format "The %s header looks odd: \"%s\". Really post? "
- (car headers) header)))))
- (message-check 'repeated-newsgroups
- (let ((case-fold-search t)
- (headers '("Newsgroups" "Followup-To"))
- header error groups group)
- (while (and headers
- (not error))
- (when (setq header (mail-fetch-field (pop headers)))
- (setq groups (message-tokenize-header header ","))
- (while (setq group (pop groups))
- (when (member group groups)
- (setq error group
- groups nil)))))
- (if (not error)
- t
- (y-or-n-p
- (format "Group %s is repeated in headers. Really post? " error)))))
- ;; Check the From header.
- (message-check 'from
- (let* ((case-fold-search t)
- (from (message-fetch-field "from"))
- ad)
- (cond
- ((not from)
- (message "There is no From line. Posting is denied.")
- nil)
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- from))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
- (string-match "\\.$" ad) ;larsi@ifi.uio.
- (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
- (string-match "(.*).*(.*)" from)) ;(lars) (lars)
- (message
- "Denied posting -- the From looks strange: \"%s\"." from)
- nil)
- ((let ((addresses (rfc822-addresses from)))
- (while (and addresses
- (not (eq (string-to-char (car addresses)) ?\()))
- (setq addresses (cdr addresses)))
- addresses)
- (message
- "Denied posting -- bad From address: \"%s\"." from)
- nil)
- (t t))))
- ;; Check the Reply-To header.
- (message-check 'reply-to
- (let* ((case-fold-search t)
- (reply-to (message-fetch-field "reply-to"))
- ad)
- (cond
- ((not reply-to)
- t)
- ((string-match "," reply-to)
- (y-or-n-p
- (format "Multiple Reply-To addresses: \"%s\". Really post? "
- reply-to)))
- ((or (not (string-match
- "@[^\\.]*\\."
- (setq ad (nth 1 (mail-extract-address-components
- reply-to))))) ;larsi@ifi
- (string-match "\\.\\." ad) ;larsi@ifi..uio
- (string-match "@\\." ad) ;larsi@.ifi.uio
- (string-match "\\.$" ad) ;larsi@ifi.uio.
- (not (string-match "^[^@]+@[^@]+$" ad)) ;larsi.ifi.uio
- (string-match "(.*).*(.*)" reply-to)) ;(lars) (lars)
- (y-or-n-p
- (format
- "The Reply-To looks strange: \"%s\". Really post? "
- reply-to)))
- (t t))))))
-
-(defun message-check-news-body-syntax ()
- (and
- ;; Check for long lines.
- (message-check 'long-lines
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (while (and
- (or (looking-at
- "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)")
- (let ((p (point)))
- (end-of-line)
- (< (- (point) p) 80)))
- (zerop (forward-line 1))))
- (or (bolp)
- (eobp)
- (y-or-n-p
- "You have lines longer than 79 characters. Really post? ")))
- ;; Check whether the article is empty.
- (message-check 'empty
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (forward-line 1)
- (let ((b (point)))
- (goto-char (point-max))
- (re-search-backward message-signature-separator nil t)
- (beginning-of-line)
- (or (re-search-backward "[^ \n\t]" b t)
- (if (message-gnksa-enable-p 'empty-article)
- (y-or-n-p "Empty article. Really post? ")
- (message "Denied posting -- Empty article.")
- nil))))
- ;; Check for control characters.
- (message-check 'control-chars
- (if (re-search-forward
- (mm-string-as-multibyte "[\000-\007\013\015-\032\034-\037\200-\237]")
- nil t)
- (y-or-n-p
- "The article contains control characters. Really post? ")
- t))
- ;; Check excessive size.
- (message-check 'size
- (if (> (buffer-size) 60000)
- (y-or-n-p
- (format "The article is %d octets long. Really post? "
- (buffer-size)))
- t))
- ;; Check whether any new text has been added.
- (message-check 'new-text
- (or
- (not message-checksum)
- (not (eq (message-checksum) message-checksum))
- (if (message-gnksa-enable-p 'quoted-text-only)
- (y-or-n-p
- "It looks like no new text has been added. Really post? ")
- (message "Denied posting -- no new text has been added.")
- nil)))
- ;; Check the length of the signature.
- (message-check 'signature
- (goto-char (point-max))
- (if (> (count-lines (point) (point-max)) 5)
- (y-or-n-p
- (format
- "Your .sig is %d lines; it should be max 4. Really post? "
- (1- (count-lines (point) (point-max)))))
- t))
- ;; Ensure that text follows last quoted portion.
- (message-check 'quoting-style
- (goto-char (point-max))
- (let ((no-problem t))
- (when (search-backward-regexp "^>[^\n]*\n" nil t)
- (setq no-problem (search-forward-regexp "^[ \t]*[^>\n]" nil t)))
- (if no-problem
- t
- (if (message-gnksa-enable-p 'quoted-text-only)
- (y-or-n-p "Your text should follow quoted text. Really post? ")
- ;; Ensure that
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (if (search-forward-regexp "^[ \t]*[^>\n]" nil t)
- (y-or-n-p "Your text should follow quoted text. Really post? ")
- (message "Denied posting -- only quoted text.")
- nil)))))))
-
-(defun message-checksum ()
- "Return a \"checksum\" for the current buffer."
- (let ((sum 0))
- (save-excursion
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$"))
- (while (not (eobp))
- (when (not (looking-at "[ \t\n]"))
- (setq sum (logxor (ash sum 1) (if (natnump sum) 0 1)
- (char-after))))
- (forward-char 1)))
- sum))
-
-(defun message-do-fcc ()
- "Process Fcc headers in the current buffer."
- (let ((case-fold-search t)
- (buf (current-buffer))
- list file
- (mml-externalize-attachments message-fcc-externalize-attachments))
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (setq file (message-fetch-field "fcc" t)))
- (when file
- (set-buffer (get-buffer-create " *message temp*"))
- (erase-buffer)
- (insert-buffer-substring buf)
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers)
- (while (setq file (message-fetch-field "fcc" t))
- (push file list)
- (message-remove-header "fcc" nil t))
- (let ((mail-parse-charset message-default-charset)
- (rfc2047-header-encoding-alist
- (cons '("Newsgroups" . default)
- rfc2047-header-encoding-alist)))
- (mail-encode-encoded-word-buffer)))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$")
- nil t)
- (replace-match "" t t ))
- ;; Process FCC operations.
- (while list
- (setq file (pop list))
- (if (string-match "^[ \t]*|[ \t]*\\(.*\\)[ \t]*$" file)
- ;; Pipe the article to the program in question.
- (call-process-region (point-min) (point-max) shell-file-name
- nil nil nil shell-command-switch
- (match-string 1 file))
- ;; Save the article.
- (setq file (expand-file-name file))
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (if (and message-fcc-handler-function
- (not (eq message-fcc-handler-function 'rmail-output)))
- (funcall message-fcc-handler-function file)
- (if (and (file-readable-p file) (mail-file-babyl-p file))
- (rmail-output file 1 nil t)
- (let ((mail-use-rfc822 t))
- (rmail-output file 1 t t))))))
- (kill-buffer (current-buffer))))))
-
-(defun message-output (filename)
- "Append this article to Unix/babyl mail file FILENAME."
- (if (and (file-readable-p filename)
- (mail-file-babyl-p filename))
- (gnus-output-to-rmail filename t)
- (gnus-output-to-mail filename t)))
-
-(defun message-cleanup-headers ()
- "Do various automatic cleanups of the headers."
- ;; Remove empty lines in the header.
- (save-restriction
- (message-narrow-to-headers)
- ;; Remove blank lines.
- (while (re-search-forward "^[ \t]*\n" nil t)
- (replace-match "" t t))
-
- ;; Correct Newsgroups and Followup-To headers: Change sequence of
- ;; spaces to comma and eliminate spaces around commas. Eliminate
- ;; embedded line breaks.
- (goto-char (point-min))
- (while (re-search-forward "^\\(Newsgroups\\|Followup-To\\): +" nil t)
- (save-restriction
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil t)
- (match-beginning 0)
- (forward-line 1)
- (point)))
- (goto-char (point-min))
- (while (re-search-forward "\n[ \t]+" nil t)
- (replace-match " " t t)) ;No line breaks (too confusing)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n]*,[ \t\n]*\\|[ \t]+" nil t)
- (replace-match "," t t))
- (goto-char (point-min))
- ;; Remove trailing commas.
- (when (re-search-forward ",+$" nil t)
- (replace-match "" t t))))))
-
-(eval-when-compile (require 'parse-time))
-(defun message-make-date (&optional now)
- "Make a valid data header.
-If NOW, use that time instead."
- (require 'parse-time)
- (let* ((now (or now (current-time)))
- (zone (nth 8 (decode-time now)))
- (sign "+"))
- (when (< zone 0)
- (setq sign "-")
- (setq zone (- zone)))
- (concat
- ;; The day name of the %a spec is locale-specific. Pfff.
- (format "%s, " (capitalize (car (rassoc (nth 6 (decode-time now))
- parse-time-weekdays))))
- (format-time-string "%d" now)
- ;; The month name of the %b spec is locale-specific. Pfff.
- (format " %s "
- (capitalize (car (rassoc (nth 4 (decode-time now))
- parse-time-months))))
- (format-time-string "%Y %H:%M:%S " now)
- ;; We do all of this because XEmacs doesn't have the %z spec.
- (format "%s%02d%02d" sign (/ zone 3600) (/ (% zone 3600) 60)))))
-
-(defun message-make-message-id ()
- "Make a unique Message-ID."
- (concat "<" (message-unique-id)
- (let ((psubject (save-excursion (message-fetch-field "subject")))
- (psupersedes
- (save-excursion (message-fetch-field "supersedes"))))
- (if (or
- (and message-reply-headers
- (mail-header-references message-reply-headers)
- (mail-header-subject message-reply-headers)
- psubject
- (not (string=
- (message-strip-subject-re
- (mail-header-subject message-reply-headers))
- (message-strip-subject-re psubject))))
- (and psupersedes
- (string-match "_-_@" psupersedes)))
- "_-_" ""))
- "@" (message-make-fqdn) ">"))
-
-(defvar message-unique-id-char nil)
-
-;; If you ever change this function, make sure the new version
-;; cannot generate IDs that the old version could.
-;; You might for example insert a "." somewhere (not next to another dot
-;; or string boundary), or modify the "fsf" string.
-(defun message-unique-id ()
- ;; Don't use microseconds from (current-time), they may be unsupported.
- ;; Instead we use this randomly inited counter.
- (setq message-unique-id-char
- (% (1+ (or message-unique-id-char (logand (random t) (1- (lsh 1 20)))))
- ;; (current-time) returns 16-bit ints,
- ;; and 2^16*25 just fits into 4 digits i base 36.
- (* 25 25)))
- (let ((tm (current-time)))
- (concat
- (if (or (memq system-type '(ms-dos emx vax-vms))
- ;; message-number-base36 doesn't handle bigints.
- (floatp (user-uid)))
- (let ((user (downcase (user-login-name))))
- (while (string-match "[^a-z0-9_]" user)
- (aset user (match-beginning 0) ?_))
- user)
- (message-number-base36 (user-uid) -1))
- (message-number-base36 (+ (car tm)
- (lsh (% message-unique-id-char 25) 16)) 4)
- (message-number-base36 (+ (nth 1 tm)
- (lsh (/ message-unique-id-char 25) 16)) 4)
- ;; Append a given name, because while the generated ID is unique
- ;; to this newsreader, other newsreaders might otherwise generate
- ;; the same ID via another algorithm.
- ".fsf")))
-
-(defun message-number-base36 (num len)
- (if (if (< len 0)
- (<= num 0)
- (= len 0))
- ""
- (concat (message-number-base36 (/ num 36) (1- len))
- (char-to-string (aref "zyxwvutsrqponmlkjihgfedcba9876543210"
- (% num 36))))))
-
-(defun message-make-organization ()
- "Make an Organization header."
- (let* ((organization
- (when message-user-organization
- (if (functionp message-user-organization)
- (funcall message-user-organization)
- message-user-organization))))
- (with-temp-buffer
- (mm-enable-multibyte)
- (cond ((stringp organization)
- (insert organization))
- ((and (eq t organization)
- message-user-organization-file
- (file-exists-p message-user-organization-file))
- (insert-file-contents message-user-organization-file)))
- (goto-char (point-min))
- (while (re-search-forward "[\t\n]+" nil t)
- (replace-match "" t t))
- (unless (zerop (buffer-size))
- (buffer-string)))))
-
-(defun message-make-lines ()
- "Count the number of lines and return numeric string."
- (save-excursion
- (save-restriction
- (widen)
- (message-goto-body)
- (int-to-string (count-lines (point) (point-max))))))
-
-(defun message-make-references ()
- "Return the References header for this message."
- (when message-reply-headers
- (let ((message-id (mail-header-message-id message-reply-headers))
- (references (mail-header-references message-reply-headers))
- new-references)
- (if (or references message-id)
- (concat (or references "") (and references " ")
- (or message-id ""))
- nil))))
-
-(defun message-make-in-reply-to ()
- "Return the In-Reply-To header for this message."
- (when message-reply-headers
- (let ((from (mail-header-from message-reply-headers))
- (date (mail-header-date message-reply-headers))
- (msg-id (mail-header-message-id message-reply-headers)))
- (when from
- (let ((name (mail-extract-address-components from)))
- (concat
- msg-id (if msg-id " (")
- (if (car name)
- (if (string-match "[^\000-\177]" (car name))
- ;; Quote a string containing non-ASCII characters.
- ;; It will make the RFC2047 encoder cause an error
- ;; if there are special characters.
- (let ((default-enable-multibyte-characters t))
- (with-temp-buffer
- (insert (car name))
- (goto-char (point-min))
- (while (search-forward "\"" nil t)
- (when (prog2
- (backward-char)
- (zerop (% (skip-chars-backward "\\\\") 2))
- (goto-char (match-beginning 0)))
- (insert "\\"))
- (forward-char))
- ;; Those quotes will be removed by the RFC2047 encoder.
- (concat "\"" (buffer-string) "\"")))
- (car name))
- (nth 1 name))
- "'s message of \""
- (if (or (not date) (string= date ""))
- "(unknown date)" date)
- "\"" (if msg-id ")")))))))
-
-(defun message-make-distribution ()
- "Make a Distribution header."
- (let ((orig-distribution (message-fetch-reply-field "distribution")))
- (cond ((functionp message-distribution-function)
- (funcall message-distribution-function))
- (t orig-distribution))))
-
-(defun message-make-expires ()
- "Return an Expires header based on `message-expires'."
- (let ((current (current-time))
- (future (* 1.0 message-expires 60 60 24)))
- ;; Add the future to current.
- (setcar current (+ (car current) (round (/ future (expt 2 16)))))
- (setcar (cdr current) (+ (nth 1 current) (% (round future) (expt 2 16))))
- (message-make-date current)))
-
-(defun message-make-path ()
- "Return uucp path."
- (let ((login-name (user-login-name)))
- (cond ((null message-user-path)
- (concat (system-name) "!" login-name))
- ((stringp message-user-path)
- ;; Support GENERICPATH. Suggested by vixie@decwrl.dec.com.
- (concat message-user-path "!" login-name))
- (t login-name))))
-
-(defun message-make-from ()
- "Make a From header."
- (let* ((style message-from-style)
- (login (message-make-address))
- (fullname
- (or (and (boundp 'user-full-name)
- user-full-name)
- (user-full-name))))
- (when (string= fullname "&")
- (setq fullname (user-login-name)))
- (with-temp-buffer
- (mm-enable-multibyte)
- (cond
- ((or (null style)
- (equal fullname ""))
- (insert login))
- ((or (eq style 'angles)
- (and (not (eq style 'parens))
- ;; Use angles if no quoting is needed, or if parens would
- ;; need quoting too.
- (or (not (string-match "[^- !#-'*+/-9=?A-Z^-~]" fullname))
- (let ((tmp (concat fullname nil)))
- (while (string-match "([^()]*)" tmp)
- (aset tmp (match-beginning 0) ?-)
- (aset tmp (1- (match-end 0)) ?-))
- (string-match "[\\()]" tmp)))))
- (insert fullname)
- (goto-char (point-min))
- ;; Look for a character that cannot appear unquoted
- ;; according to RFC 822.
- (when (re-search-forward "[^- !#-'*+/-9=?A-Z^-~]" nil 1)
- ;; Quote fullname, escaping specials.
- (goto-char (point-min))
- (insert "\"")
- (while (re-search-forward "[\"\\]" nil 1)
- (replace-match "\\\\\\&" t))
- (insert "\""))
- (insert " <" login ">"))
- (t ; 'parens or default
- (insert login " (")
- (let ((fullname-start (point)))
- (insert fullname)
- (goto-char fullname-start)
- ;; RFC 822 says \ and nonmatching parentheses
- ;; must be escaped in comments.
- ;; Escape every instance of ()\ ...
- (while (re-search-forward "[()\\]" nil 1)
- (replace-match "\\\\\\&" t))
- ;; ... then undo escaping of matching parentheses,
- ;; including matching nested parentheses.
- (goto-char fullname-start)
- (while (re-search-forward
- "\\(\\=\\|[^\\]\\(\\\\\\\\\\)*\\)\\\\(\\(\\([^\\]\\|\\\\\\\\\\)*\\)\\\\)"
- nil 1)
- (replace-match "\\1(\\3)" t)
- (goto-char fullname-start)))
- (insert ")")))
- (buffer-string))))
-
-(defun message-make-sender ()
- "Return the \"real\" user address.
-This function tries to ignore all user modifications, and
-give as trustworthy answer as possible."
- (concat (user-login-name) "@" (system-name)))
-
-(defun message-make-address ()
- "Make the address of the user."
- (or (message-user-mail-address)
- (concat (user-login-name) "@" (message-make-domain))))
-
-(defun message-user-mail-address ()
- "Return the pertinent part of `user-mail-address'."
- (when (and user-mail-address
- (string-match "@.*\\." user-mail-address))
- (if (string-match " " user-mail-address)
- (nth 1 (mail-extract-address-components user-mail-address))
- user-mail-address)))
-
-(defun message-sendmail-envelope-from ()
- "Return the envelope from."
- (cond ((eq message-sendmail-envelope-from 'header)
- (nth 1 (mail-extract-address-components
- (message-fetch-field "from"))))
- ((stringp message-sendmail-envelope-from)
- message-sendmail-envelope-from)
- (t
- (message-make-address))))
-
-(defun message-make-fqdn ()
- "Return user's fully qualified domain name."
- (let* ((system-name (system-name))
- (user-mail (message-user-mail-address))
- (user-domain
- (if (and user-mail
- (string-match "@\\(.*\\)\\'" user-mail))
- (match-string 1 user-mail)))
- (case-fold-search t))
- (cond
- ((and message-user-fqdn
- (stringp message-user-fqdn)
- (string-match message-valid-fqdn-regexp message-user-fqdn)
- (not (string-match message-bogus-system-names message-user-fqdn)))
- ;; `message-user-fqdn' seems to be valid
- message-user-fqdn)
- ((and (string-match message-valid-fqdn-regexp system-name)
- (not (string-match message-bogus-system-names system-name)))
- ;; `system-name' returned the right result.
- system-name)
- ;; Try `mail-host-address'.
- ((and (boundp 'mail-host-address)
- (stringp mail-host-address)
- (string-match message-valid-fqdn-regexp mail-host-address)
- (not (string-match message-bogus-system-names mail-host-address)))
- mail-host-address)
- ;; We try `user-mail-address' as a backup.
- ((and user-domain
- (stringp user-domain)
- (string-match message-valid-fqdn-regexp user-domain)
- (not (string-match message-bogus-system-names user-domain)))
- user-domain)
- ;; Default to this bogus thing.
- (t
- (concat system-name
- ".i-did-not-set--mail-host-address--so-tickle-me")))))
-
-(defun message-make-host-name ()
- "Return the name of the host."
- (let ((fqdn (message-make-fqdn)))
- (string-match "^[^.]+\\." fqdn)
- (substring fqdn 0 (1- (match-end 0)))))
-
-(defun message-make-domain ()
- "Return the domain name."
- (or mail-host-address
- (message-make-fqdn)))
-
-(defun message-to-list-only ()
- "Send a message to the list only.
-Remove all addresses but the list address from To and Cc headers."
- (interactive)
- (let ((listaddr (message-make-mail-followup-to t)))
- (when listaddr
- (save-excursion
- (message-remove-header "to")
- (message-remove-header "cc")
- (message-position-on-field "To" "X-Draft-From")
- (insert listaddr)))))
-
-(defun message-make-mail-followup-to (&optional only-show-subscribed)
- "Return the Mail-Followup-To header.
-If passed the optional argument ONLY-SHOW-SUBSCRIBED only return the
-subscribed address (and not the additional To and Cc header contents)."
- (let* ((case-fold-search t)
- (to (message-fetch-field "To"))
- (cc (message-fetch-field "cc"))
- (msg-recipients (concat to (and to cc ", ") cc))
- (recipients
- (mapcar 'mail-strip-quoted-names
- (message-tokenize-header msg-recipients)))
- (file-regexps
- (if message-subscribed-address-file
- (let (begin end item re)
- (save-excursion
- (with-temp-buffer
- (insert-file-contents message-subscribed-address-file)
- (while (not (eobp))
- (setq begin (point))
- (forward-line 1)
- (setq end (point))
- (if (bolp) (setq end (1- end)))
- (setq item (regexp-quote (buffer-substring begin end)))
- (if re (setq re (concat re "\\|" item))
- (setq re (concat "\\`\\(" item))))
- (and re (list (concat re "\\)\\'"))))))))
- (mft-regexps (apply 'append message-subscribed-regexps
- (mapcar 'regexp-quote
- message-subscribed-addresses)
- file-regexps
- (mapcar 'funcall
- message-subscribed-address-functions))))
- (save-match-data
- (let ((subscribed-lists nil)
- (list
- (loop for recipient in recipients
- when (loop for regexp in mft-regexps
- when (string-match regexp recipient) return t)
- return recipient)))
- (when list
- (if only-show-subscribed
- list
- msg-recipients))))))
-
-(defun message-idna-to-ascii-rhs-1 (header)
- "Interactively potentially IDNA encode domain names in HEADER."
- (let ((field (message-fetch-field header))
- rhs ace address)
- (when field
- (dolist (rhs
- (mm-delete-duplicates
- (mapcar (lambda (rhs) (or (cadr (split-string rhs "@")) ""))
- (mapcar 'downcase
- (mapcar
- 'car (mail-header-parse-addresses field))))))
- (setq ace (downcase (idna-to-ascii rhs)))
- (when (and (not (equal rhs ace))
- (or (not (eq message-use-idna 'ask))
- (y-or-n-p (format "Replace %s with %s in %s:? "
- rhs ace header))))
- (goto-char (point-min))
- (while (re-search-forward (concat "^" header ":") nil t)
- (message-narrow-to-field)
- (while (search-forward (concat "@" rhs) nil t)
- (replace-match (concat "@" ace) t t))
- (goto-char (point-max))
- (widen)))))))
-
-(defun message-idna-to-ascii-rhs ()
- "Possibly IDNA encode non-ASCII domain names in From:, To: and Cc: headers.
-See `message-idna-encode'."
- (interactive)
- (when message-use-idna
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (message-idna-to-ascii-rhs-1 "From")
- (message-idna-to-ascii-rhs-1 "To")
- (message-idna-to-ascii-rhs-1 "Reply-To")
- (message-idna-to-ascii-rhs-1 "Mail-Reply-To")
- (message-idna-to-ascii-rhs-1 "Mail-Followup-To")
- (message-idna-to-ascii-rhs-1 "Cc")))))
-
-(defun message-generate-headers (headers)
- "Prepare article HEADERS.
-Headers already prepared in the buffer are not modified."
- (setq headers (append headers message-required-headers))
- (save-restriction
- (message-narrow-to-headers)
- (let* ((Date (message-make-date))
- (Message-ID (message-make-message-id))
- (Organization (message-make-organization))
- (From (message-make-from))
- (Path (message-make-path))
- (Subject nil)
- (Newsgroups nil)
- (In-Reply-To (message-make-in-reply-to))
- (References (message-make-references))
- (To nil)
- (Distribution (message-make-distribution))
- (Lines (message-make-lines))
- (User-Agent message-newsreader)
- (Expires (message-make-expires))
- (case-fold-search t)
- (optionalp nil)
- header value elem header-string)
- ;; First we remove any old generated headers.
- (let ((headers message-deletable-headers))
- (unless (buffer-modified-p)
- (setq headers (delq 'Message-ID (copy-sequence headers))))
- (while headers
- (goto-char (point-min))
- (and (re-search-forward
- (concat "^" (symbol-name (car headers)) ": *") nil t)
- (get-text-property (1+ (match-beginning 0)) 'message-deletable)
- (message-delete-line))
- (pop headers)))
- ;; Go through all the required headers and see if they are in the
- ;; articles already. If they are not, or are empty, they are
- ;; inserted automatically - except for Subject, Newsgroups and
- ;; Distribution.
- (while headers
- (goto-char (point-min))
- (setq elem (pop headers))
- (if (consp elem)
- (if (eq (car elem) 'optional)
- (setq header (cdr elem)
- optionalp t)
- (setq header (car elem)))
- (setq header elem))
- (setq header-string (if (stringp header)
- header
- (symbol-name header)))
- (when (or (not (re-search-forward
- (concat "^"
- (regexp-quote (downcase header-string))
- ":")
- nil t))
- (progn
- ;; The header was found. We insert a space after the
- ;; colon, if there is none.
- (if (/= (char-after) ? ) (insert " ") (forward-char 1))
- ;; Find out whether the header is empty.
- (looking-at "[ \t]*\n[^ \t]")))
- ;; So we find out what value we should insert.
- (setq value
- (cond
- ((and (consp elem)
- (eq (car elem) 'optional)
- (not (member header-string message-inserted-headers)))
- ;; This is an optional header. If the cdr of this
- ;; is something that is nil, then we do not insert
- ;; this header.
- (setq header (cdr elem))
- (or (and (functionp (cdr elem))
- (funcall (cdr elem)))
- (and (boundp (cdr elem))
- (symbol-value (cdr elem)))))
- ((consp elem)
- ;; The element is a cons. Either the cdr is a
- ;; string to be inserted verbatim, or it is a
- ;; function, and we insert the value returned from
- ;; this function.
- (or (and (stringp (cdr elem))
- (cdr elem))
- (and (functionp (cdr elem))
- (funcall (cdr elem)))))
- ((and (boundp header)
- (symbol-value header))
- ;; The element is a symbol. We insert the value
- ;; of this symbol, if any.
- (symbol-value header))
- ((not (message-check-element
- (intern (downcase (symbol-name header)))))
- ;; We couldn't generate a value for this header,
- ;; so we just ask the user.
- (read-from-minibuffer
- (format "Empty header for %s; enter value: " header)))))
- ;; Finally insert the header.
- (when (and value
- (not (equal value "")))
- (save-excursion
- (if (bolp)
- (progn
- ;; This header didn't exist, so we insert it.
- (goto-char (point-max))
- (let ((formatter
- (cdr (assq header message-header-format-alist))))
- (if formatter
- (funcall formatter header value)
- (insert header-string ": " value))
- ;; We check whether the value was ended by a
- ;; newline. If now, we insert one.
- (unless (bolp)
- (insert "\n"))
- (forward-line -1)))
- ;; The value of this header was empty, so we clear
- ;; totally and insert the new value.
- (delete-region (point) (gnus-point-at-eol))
- ;; If the header is optional, and the header was
- ;; empty, we con't insert it anyway.
- (unless optionalp
- (push header-string message-inserted-headers)
- (insert value)))
- ;; Add the deletable property to the headers that require it.
- (and (memq header message-deletable-headers)
- (progn (beginning-of-line) (looking-at "[^:]+: "))
- (add-text-properties
- (point) (match-end 0)
- '(message-deletable t face italic) (current-buffer)))))))
- ;; Insert new Sender if the From is strange.
- (let ((from (message-fetch-field "from"))
- (sender (message-fetch-field "sender"))
- (secure-sender (message-make-sender)))
- (when (and from
- (not (message-check-element 'sender))
- (not (string=
- (downcase
- (cadr (mail-extract-address-components from)))
- (downcase secure-sender)))
- (or (null sender)
- (not
- (string=
- (downcase
- (cadr (mail-extract-address-components sender)))
- (downcase secure-sender)))))
- (goto-char (point-min))
- ;; Rename any old Sender headers to Original-Sender.
- (when (re-search-forward "^\\(Original-\\)*Sender:" nil t)
- (beginning-of-line)
- (insert "Original-")
- (beginning-of-line))
- (when (or (message-news-p)
- (string-match "@.+\\.." secure-sender))
- (insert "Sender: " secure-sender "\n"))))
- ;; Check for IDNA
- (message-idna-to-ascii-rhs))))
-
-(defun message-insert-courtesy-copy ()
- "Insert a courtesy message in mail copies of combined messages."
- (let (newsgroups)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (when (setq newsgroups (message-fetch-field "newsgroups"))
- (goto-char (point-max))
- (insert "Posted-To: " newsgroups "\n")))
- (forward-line 1)
- (when message-courtesy-message
- (cond
- ((string-match "%s" message-courtesy-message)
- (insert (format message-courtesy-message newsgroups)))
- (t
- (insert message-courtesy-message)))))))
-
-;;;
-;;; Setting up a message buffer
-;;;
-
-(defun message-fill-address (header value)
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (narrow-to-region (point-min) (1- (point-max)))
- (let (quoted last)
- (goto-char (point-min))
- (while (not (eobp))
- (skip-chars-forward "^,\"" (point-max))
- (if (or (eq (char-after) ?,)
- (eobp))
- (when (not quoted)
- (if (and (> (current-column) 78)
- last)
- (progn
- (save-excursion
- (goto-char last)
- (insert "\n\t"))
- (setq last (1+ (point))))
- (setq last (1+ (point)))))
- (setq quoted (not quoted)))
- (unless (eobp)
- (forward-char 1))))
- (goto-char (point-max))
- (widen)
- (forward-line 1)))
-
-(defun message-split-line ()
- "Split current line, moving portion beyond point vertically down.
-If the current line has `message-yank-prefix', insert it on the new line."
- (interactive "*")
- (condition-case nil
- (split-line message-yank-prefix) ;; Emacs 22.1+ supports arg.
- (error
- (split-line))))
-
-(defun message-fill-header (header value)
- (let ((begin (point))
- (fill-column 78)
- (fill-prefix "\t"))
- (insert (capitalize (symbol-name header))
- ": "
- (if (consp value) (car value) value)
- "\n")
- (save-restriction
- (narrow-to-region begin (point))
- (fill-region-as-paragraph begin (point))
- ;; Tapdance around looong Message-IDs.
- (forward-line -1)
- (when (looking-at "[ \t]*$")
- (message-delete-line))
- (goto-char begin)
- (re-search-forward ":" nil t)
- (when (looking-at "\n[ \t]+")
- (replace-match " " t t))
- (goto-char (point-max)))))
-
-(defun message-shorten-1 (list cut surplus)
- "Cut SURPLUS elements out of LIST, beginning with CUTth one."
- (setcdr (nthcdr (- cut 2) list)
- (nthcdr (+ (- cut 2) surplus 1) list)))
-
-(defun message-shorten-references (header references)
- "Trim REFERENCES to be 21 Message-ID long or less, and fold them.
-If folding is disallowed, also check that the REFERENCES are less
-than 988 characters long, and if they are not, trim them until they are."
- (let ((maxcount 21)
- (count 0)
- (cut 2)
- refs)
- (with-temp-buffer
- (insert references)
- (goto-char (point-min))
- ;; Cons a list of valid references.
- (while (re-search-forward "<[^>]+>" nil t)
- (push (match-string 0) refs))
- (setq refs (nreverse refs)
- count (length refs)))
-
- ;; If the list has more than MAXCOUNT elements, trim it by
- ;; removing the CUTth element and the required number of
- ;; elements that follow.
- (when (> count maxcount)
- (let ((surplus (- count maxcount)))
- (message-shorten-1 refs cut surplus)
- (decf count surplus)))
-
- ;; If folding is disallowed, make sure the total length (including
- ;; the spaces between) will be less than MAXSIZE characters.
- ;;
- ;; Only disallow folding for News messages. At this point the headers
- ;; have not been generated, thus we use message-this-is-news directly.
- (when (and message-this-is-news message-cater-to-broken-inn)
- (let ((maxsize 988)
- (totalsize (+ (apply #'+ (mapcar #'length refs))
- (1- count)))
- (surplus 0)
- (ptr (nthcdr (1- cut) refs)))
- ;; Decide how many elements to cut off...
- (while (> totalsize maxsize)
- (decf totalsize (1+ (length (car ptr))))
- (incf surplus)
- (setq ptr (cdr ptr)))
- ;; ...and do it.
- (when (> surplus 0)
- (message-shorten-1 refs cut surplus))))
-
- ;; Finally, collect the references back into a string and insert
- ;; it into the buffer.
- (let ((refstring (mapconcat #'identity refs " ")))
- (if (and message-this-is-news message-cater-to-broken-inn)
- (insert (capitalize (symbol-name header)) ": "
- refstring "\n")
- (message-fill-header header refstring)))))
-
-(defun message-position-point ()
- "Move point to where the user probably wants to find it."
- (message-narrow-to-headers)
- (cond
- ((re-search-forward "^[^:]+:[ \t]*$" nil t)
- (search-backward ":" )
- (widen)
- (forward-char 1)
- (if (eq (char-after) ? )
- (forward-char 1)
- (insert " ")))
- (t
- (goto-char (point-max))
- (widen)
- (forward-line 1)
- (unless (looking-at "$")
- (forward-line 2)))
- (sit-for 0)))
-
-(defcustom message-beginning-of-line t
- "Whether \\<message-mode-map>\\[message-beginning-of-line]\
- goes to beginning of header values."
- :version "22.1"
- :group 'message-buffers
- :link '(custom-manual "(message)Movement")
- :type 'boolean)
-
-(defun message-beginning-of-line (&optional n)
- "Move point to beginning of header value or to beginning of line.
-The prefix argument N is passed directly to `beginning-of-line'.
-
-This command is identical to `beginning-of-line' if point is
-outside the message header or if the option `message-beginning-of-line'
-is nil.
-
-If point is in the message header and on a (non-continued) header
-line, move point to the beginning of the header value or the beginning of line,
-whichever is closer. If point is already at beginning of line, move point to
-beginning of header value. Therefore, repeated calls will toggle point
-between beginning of field and beginning of line."
- (interactive "p")
- (let ((zrs 'zmacs-region-stays))
- (when (and (interactive-p) (boundp zrs))
- (set zrs t)))
- (if (and message-beginning-of-line
- (message-point-in-header-p))
- (let* ((here (point))
- (bol (progn (beginning-of-line n) (point)))
- (eol (gnus-point-at-eol))
- (eoh (re-search-forward ": *" eol t)))
- (goto-char
- (if (and eoh (or (< eoh here) (= bol here)))
- eoh bol)))
- (beginning-of-line n)))
-
-(defun message-buffer-name (type &optional to group)
- "Return a new (unique) buffer name based on TYPE and TO."
- (cond
- ;; Generate a new buffer name The Message Way.
- ((memq message-generate-new-buffers '(unique t))
- (generate-new-buffer-name
- (concat "*" type
- (if to
- (concat " to "
- (or (car (mail-extract-address-components to))
- to) "")
- "")
- (if (and group (not (string= group ""))) (concat " on " group) "")
- "*")))
- ;; Check whether `message-generate-new-buffers' is a function,
- ;; and if so, call it.
- ((functionp message-generate-new-buffers)
- (funcall message-generate-new-buffers type to group))
- ((eq message-generate-new-buffers 'unsent)
- (generate-new-buffer-name
- (concat "*unsent " type
- (if to
- (concat " to "
- (or (car (mail-extract-address-components to))
- to) "")
- "")
- (if (and group (not (string= group ""))) (concat " on " group) "")
- "*")))
- ;; Search for the existing message buffer with the specified name.
- (t
- (let* ((new (if (eq message-generate-new-buffers 'standard)
- (generate-new-buffer-name (concat "*" type " message*"))
- (let ((message-generate-new-buffers 'unique))
- (message-buffer-name type to group))))
- (regexp (concat "\\`"
- (regexp-quote
- (if (string-match "<[0-9]+>\\'" new)
- (substring new 0 (match-beginning 0))
- new))
- "\\(?:<\\([0-9]+\\)>\\)?\\'"))
- (case-fold-search nil))
- (or (cdar
- (last
- (sort
- (delq nil
- (mapcar
- (lambda (b)
- (when (and (string-match regexp (setq b (buffer-name b)))
- (eq (with-current-buffer b major-mode)
- 'message-mode))
- (cons (string-to-number (or (match-string 1 b) "1"))
- b)))
- (buffer-list)))
- 'car-less-than-car)))
- new)))))
-
-(defun message-pop-to-buffer (name &optional switch-function)
- "Pop to buffer NAME, and warn if it already exists and is modified."
- (let ((buffer (get-buffer name)))
- (if (and buffer
- (buffer-name buffer))
- (let ((window (get-buffer-window buffer 0)))
- (if window
- ;; Raise the frame already displaying the message buffer.
- (progn
- (gnus-select-frame-set-input-focus (window-frame window))
- (select-window window))
- (funcall (or switch-function 'pop-to-buffer) buffer)
- (set-buffer buffer))
- (when (and (buffer-modified-p)
- (not (prog1
- (y-or-n-p
- "Message already being composed; erase? ")
- (message nil))))
- (error "Message being composed")))
- (funcall (or switch-function 'pop-to-buffer) name)
- (set-buffer name))
- (erase-buffer)
- (message-mode)))
-
-(defun message-do-send-housekeeping ()
- "Kill old message buffers."
- ;; We might have sent this buffer already. Delete it from the
- ;; list of buffers.
- (setq message-buffer-list (delq (current-buffer) message-buffer-list))
- (while (and message-max-buffers
- message-buffer-list
- (>= (length message-buffer-list) message-max-buffers))
- ;; Kill the oldest buffer -- unless it has been changed.
- (let ((buffer (pop message-buffer-list)))
- (when (and (buffer-name buffer)
- (not (buffer-modified-p buffer)))
- (kill-buffer buffer))))
- ;; Rename the buffer.
- (if message-send-rename-function
- (funcall message-send-rename-function)
- ;; Note: mail-abbrevs of XEmacs renames buffer name behind Gnus.
- (when (string-match
- "\\`\\*\\(sent \\|unsent \\)?\\(.+\\)\\*[^\\*]*\\|\\`mail to "
- (buffer-name))
- (let ((name (match-string 2 (buffer-name)))
- to group)
- (if (not (or (null name)
- (string-equal name "mail")
- (string-equal name "posting")))
- (setq name (concat "*sent " name "*"))
- (message-narrow-to-headers)
- (setq to (message-fetch-field "to"))
- (setq group (message-fetch-field "newsgroups"))
- (widen)
- (setq name
- (cond
- (to (concat "*sent mail to "
- (or (car (mail-extract-address-components to))
- to) "*"))
- ((and group (not (string= group "")))
- (concat "*sent posting on " group "*"))
- (t "*sent mail*"))))
- (unless (string-equal name (buffer-name))
- (rename-buffer name t)))))
- ;; Push the current buffer onto the list.
- (when message-max-buffers
- (setq message-buffer-list
- (nconc message-buffer-list (list (current-buffer))))))
-
-(defun message-mail-user-agent ()
- (let ((mua (cond
- ((not message-mail-user-agent) nil)
- ((eq message-mail-user-agent t) mail-user-agent)
- (t message-mail-user-agent))))
- (if (memq mua '(message-user-agent gnus-user-agent))
- nil
- mua)))
-
-(defun message-setup (headers &optional replybuffer actions
- continue switch-function)
- (let ((mua (message-mail-user-agent))
- subject to field yank-action)
- (if (not (and message-this-is-mail mua))
- (message-setup-1 headers replybuffer actions)
- (if replybuffer
- (setq yank-action (list 'insert-buffer replybuffer)))
- (setq headers (copy-sequence headers))
- (setq field (assq 'Subject headers))
- (when field
- (setq subject (cdr field))
- (setq headers (delq field headers)))
- (setq field (assq 'To headers))
- (when field
- (setq to (cdr field))
- (setq headers (delq field headers)))
- (let ((mail-user-agent mua))
- (compose-mail to subject
- (mapcar (lambda (item)
- (cons
- (format "%s" (car item))
- (cdr item)))
- headers)
- continue switch-function yank-action actions)))))
-
-(defun message-headers-to-generate (headers included-headers excluded-headers)
- "Return a list that includes all headers from HEADERS.
-If INCLUDED-HEADERS is a list, just include those headers. If it is
-t, include all headers. In any case, headers from EXCLUDED-HEADERS
-are not included."
- (let ((result nil)
- header-name)
- (dolist (header headers)
- (setq header-name (cond
- ((and (consp header)
- (eq (car header) 'optional))
- ;; On the form (optional . Header)
- (cdr header))
- ((consp header)
- ;; On the form (Header . function)
- (car header))
- (t
- ;; Just a Header.
- header)))
- (when (and (not (memq header-name excluded-headers))
- (or (eq included-headers t)
- (memq header-name included-headers)))
- (push header result)))
- (nreverse result)))
-
-(defun message-setup-1 (headers &optional replybuffer actions)
- (dolist (action actions)
- (condition-case nil
- (add-to-list 'message-send-actions
- `(apply ',(car action) ',(cdr action)))))
- (setq message-reply-buffer replybuffer)
- (goto-char (point-min))
- ;; Insert all the headers.
- (mail-header-format
- (let ((h headers)
- (alist message-header-format-alist))
- (while h
- (unless (assq (caar h) message-header-format-alist)
- (push (list (caar h)) alist))
- (pop h))
- alist)
- headers)
- (delete-region (point) (progn (forward-line -1) (point)))
- (when message-default-headers
- (insert message-default-headers)
- (or (bolp) (insert ?\n)))
- (put-text-property
- (point)
- (progn
- (insert mail-header-separator "\n")
- (1- (point)))
- 'read-only nil)
- (forward-line -1)
- (when (message-news-p)
- (when message-default-news-headers
- (insert message-default-news-headers)
- (or (bolp) (insert ?\n)))
- (when message-generate-headers-first
- (message-generate-headers
- (message-headers-to-generate
- (append message-required-news-headers
- message-required-headers)
- message-generate-headers-first
- '(Lines Subject)))))
- (when (message-mail-p)
- (when message-default-mail-headers
- (insert message-default-mail-headers)
- (or (bolp) (insert ?\n)))
- (when message-generate-headers-first
- (message-generate-headers
- (message-headers-to-generate
- (append message-required-mail-headers
- message-required-headers)
- message-generate-headers-first
- '(Lines Subject)))))
- (run-hooks 'message-signature-setup-hook)
- (message-insert-signature)
- (save-restriction
- (message-narrow-to-headers)
- (run-hooks 'message-header-setup-hook))
- (set-buffer-modified-p nil)
- (setq buffer-undo-list nil)
- (run-hooks 'message-setup-hook)
- ;; Do this last to give it precedence over posting styles, etc.
- (when (message-mail-p)
- (save-restriction
- (message-narrow-to-headers)
- (if message-alternative-emails
- (message-use-alternative-email-as-from))))
- (message-position-point)
- (undo-boundary))
-
-(defun message-set-auto-save-file-name ()
- "Associate the message buffer with a file in the drafts directory."
- (when message-auto-save-directory
- (unless (file-directory-p
- (directory-file-name message-auto-save-directory))
- (make-directory message-auto-save-directory t))
- (if (gnus-alive-p)
- (setq message-draft-article
- (nndraft-request-associate-buffer "drafts"))
- (setq buffer-file-name (expand-file-name
- (if (memq system-type
- '(ms-dos ms-windows windows-nt
- cygwin cygwin32 win32 w32
- mswindows))
- "message"
- "*message*")
- message-auto-save-directory))
- (setq buffer-auto-save-file-name (make-auto-save-file-name)))
- (clear-visited-file-modtime)
- (setq buffer-file-coding-system message-draft-coding-system)))
-
-(defun message-disassociate-draft ()
- "Disassociate the message buffer from the drafts directory."
- (when message-draft-article
- (nndraft-request-expire-articles
- (list message-draft-article) "nndraft:drafts" nil t)))
-
-(defun message-insert-headers ()
- "Generate the headers for the article."
- (interactive)
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (when (message-news-p)
- (message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-news-headers)))))
- (when (message-mail-p)
- (message-generate-headers
- (delq 'Lines
- (delq 'Subject
- (copy-sequence message-required-mail-headers))))))))
-
-\f
-
-;;;
-;;; Commands for interfacing with message
-;;;
-
-;;;###autoload
-(defun message-mail (&optional to subject
- other-headers continue switch-function
- yank-action send-actions)
- "Start editing a mail message to be sent.
-OTHER-HEADERS is an alist of header/value pairs. CONTINUE says whether
-to continue editing a message already being composed. SWITCH-FUNCTION
-is a function used to switch to and display the mail buffer."
- (interactive)
- (let ((message-this-is-mail t) replybuffer)
- (unless (message-mail-user-agent)
- (message-pop-to-buffer
- ;; Search for the existing message buffer if `continue' is non-nil.
- (let ((message-generate-new-buffers
- (when (or (not continue)
- (eq message-generate-new-buffers 'standard)
- (functionp message-generate-new-buffers))
- message-generate-new-buffers)))
- (message-buffer-name "mail" to))
- switch-function))
- ;; FIXME: message-mail should do something if YANK-ACTION is not
- ;; insert-buffer.
- (and (consp yank-action) (eq (car yank-action) 'insert-buffer)
- (setq replybuffer (nth 1 yank-action)))
- (message-setup
- (nconc
- `((To . ,(or to "")) (Subject . ,(or subject "")))
- (when other-headers other-headers))
- replybuffer send-actions continue switch-function)
- ;; FIXME: Should return nil if failure.
- t))
-
-;;;###autoload
-(defun message-news (&optional newsgroups subject)
- "Start editing a news article to be sent."
- (interactive)
- (let ((message-this-is-news t))
- (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
- (Subject . ,(or subject ""))))))
-
-(defun message-get-reply-headers (wide &optional to-address address-headers)
- (let (follow-to mct never-mct to cc author mft recipients)
- ;; Find all relevant headers we need.
- (save-restriction
- (message-narrow-to-headers-or-head)
- ;; Gmane renames "To". Look at "Original-To", too, if it is present in
- ;; message-header-synonyms.
- (setq to (or (message-fetch-field "to")
- (and (loop for synonym in message-header-synonyms
- when (memq 'Original-To synonym)
- return t)
- (message-fetch-field "original-to")))
- cc (message-fetch-field "cc")
- mct (message-fetch-field "mail-copies-to")
- author (or (message-fetch-field "mail-reply-to")
- (message-fetch-field "reply-to")
- (message-fetch-field "from")
- "")
- mft (and message-use-mail-followup-to
- (message-fetch-field "mail-followup-to"))))
-
- ;; Handle special values of Mail-Copies-To.
- (when mct
- (cond ((or (equal (downcase mct) "never")
- (equal (downcase mct) "nobody"))
- (setq never-mct t)
- (setq mct nil))
- ((or (equal (downcase mct) "always")
- (equal (downcase mct) "poster"))
- (setq mct author))))
-
- (save-match-data
- ;; Build (textual) list of new recipient addresses.
- (cond
- ((not wide)
- (setq recipients (concat ", " author)))
- (address-headers
- (dolist (header address-headers)
- (let ((value (message-fetch-field header)))
- (when value
- (setq recipients (concat recipients ", " value))))))
- ((and mft
- (string-match "[^ \t,]" mft)
- (or (not (eq message-use-mail-followup-to 'ask))
- (message-y-or-n-p "Obey Mail-Followup-To? " t "\
-You should normally obey the Mail-Followup-To: header. In this
-article, it has the value of
-
-" mft "
-
-which directs your response to " (if (string-match "," mft)
- "the specified addresses"
- "that address only") ".
-
-Most commonly, Mail-Followup-To is used by a mailing list poster to
-express that responses should be sent to just the list, and not the
-poster as well.
-
-If a message is posted to several mailing lists, Mail-Followup-To may
-also be used to direct the following discussion to one list only,
-because discussions that are spread over several lists tend to be
-fragmented and very difficult to follow.
-
-Also, some source/announcement lists are not intended for discussion;
-responses here are directed to other addresses.
-
-You may customize the variable `message-use-mail-followup-to', if you
-want to get rid of this query permanently.")))
- (setq recipients (concat ", " mft)))
- (to-address
- (setq recipients (concat ", " to-address))
- ;; If the author explicitly asked for a copy, we don't deny it to them.
- (if mct (setq recipients (concat recipients ", " mct))))
- (t
- (setq recipients (if never-mct "" (concat ", " author)))
- (if to (setq recipients (concat recipients ", " to)))
- (if cc (setq recipients (concat recipients ", " cc)))
- (if mct (setq recipients (concat recipients ", " mct)))))
- (if (>= (length recipients) 2)
- ;; Strip the leading ", ".
- (setq recipients (substring recipients 2)))
- ;; Squeeze whitespace.
- (while (string-match "[ \t][ \t]+" recipients)
- (setq recipients (replace-match " " t t recipients)))
- ;; Remove addresses that match `rmail-dont-reply-to-names'.
- (let ((rmail-dont-reply-to-names message-dont-reply-to-names))
- (setq recipients (rmail-dont-reply-to recipients)))
- ;; Perhaps "Mail-Copies-To: never" removed the only address?
- (if (string-equal recipients "")
- (setq recipients author))
- ;; Convert string to a list of (("foo@bar" . "Name <Foo@BAR>") ...).
- (setq recipients
- (mapcar
- (lambda (addr)
- (cons (downcase (mail-strip-quoted-names addr)) addr))
- (message-tokenize-header recipients)))
- ;; Remove first duplicates. (Why not all duplicates? Is this a bug?)
- (let ((s recipients))
- (while s
- (setq recipients (delq (assoc (car (pop s)) s) recipients))))
-
- ;; Remove hierarchical lists that are contained within each other,
- ;; if message-hierarchical-addresses is defined.
- (when message-hierarchical-addresses
- (let ((plain-addrs (mapcar 'car recipients))
- subaddrs recip)
- (while plain-addrs
- (setq subaddrs (assoc (car plain-addrs)
- message-hierarchical-addresses)
- plain-addrs (cdr plain-addrs))
- (when subaddrs
- (setq subaddrs (cdr subaddrs))
- (while subaddrs
- (setq recip (assoc (car subaddrs) recipients)
- subaddrs (cdr subaddrs))
- (if recip
- (setq recipients (delq recip recipients))))))))
-
- ;; Build the header alist. Allow the user to be asked whether
- ;; or not to reply to all recipients in a wide reply.
- (setq follow-to (list (cons 'To (cdr (pop recipients)))))
- (when (and recipients
- (or (not message-wide-reply-confirm-recipients)
- (y-or-n-p "Reply to all recipients? ")))
- (setq recipients (mapconcat
- (lambda (addr) (cdr addr)) recipients ", "))
- (if (string-match "^ +" recipients)
- (setq recipients (substring recipients (match-end 0))))
- (push (cons 'Cc recipients) follow-to)))
- follow-to))
-
-(defcustom message-simplify-subject-functions
- '(message-strip-list-identifiers
- message-strip-subject-re
- message-strip-subject-trailing-was
- message-strip-subject-encoded-words)
- "List of functions taking a string argument that simplify subjects.
-The functions are applied when replying to a message.
-
-Useful functions to put in this list include:
-`message-strip-list-identifiers', `message-strip-subject-re',
-`message-strip-subject-trailing-was', and
-`message-strip-subject-encoded-words'."
- :version "22.1" ;; Gnus 5.10.9
- :group 'message-various
- :type '(repeat function))
-
-(defun message-simplify-subject (subject &optional functions)
- "Return simplified SUBJECT."
- (unless functions
- ;; Simplify fully:
- (setq functions message-simplify-subject-functions))
- (when (and (memq 'message-strip-list-identifiers functions)
- gnus-list-identifiers)
- (setq subject (message-strip-list-identifiers subject)))
- (when (memq 'message-strip-subject-re functions)
- (setq subject (concat "Re: " (message-strip-subject-re subject))))
- (when (and (memq 'message-strip-subject-trailing-was functions)
- message-subject-trailing-was-query)
- (setq subject (message-strip-subject-trailing-was subject)))
- (when (memq 'message-strip-subject-encoded-words functions)
- (setq subject (message-strip-subject-encoded-words subject)))
- subject)
-
-;;;###autoload
-(defun message-reply (&optional to-address wide)
- "Start editing a reply to the article in the current buffer."
- (interactive)
- (require 'gnus-sum) ; for gnus-list-identifiers
- (let ((cur (current-buffer))
- from subject date reply-to to cc
- references message-id follow-to
- (inhibit-point-motion-hooks t)
- (message-this-is-mail t)
- gnus-warning)
- (save-restriction
- (message-narrow-to-head-1)
- ;; Allow customizations to have their say.
- (if (not wide)
- ;; This is a regular reply.
- (when (functionp message-reply-to-function)
- (save-excursion
- (setq follow-to (funcall message-reply-to-function))))
- ;; This is a followup.
- (when (functionp message-wide-reply-to-function)
- (save-excursion
- (setq follow-to
- (funcall message-wide-reply-to-function)))))
- (setq message-id (message-fetch-field "message-id" t)
- references (message-fetch-field "references")
- date (message-fetch-field "date")
- from (or (message-fetch-field "from") "nobody")
- subject (or (message-fetch-field "subject") "none"))
-
- ;; Strip list identifiers, "Re: ", and "was:"
- (setq subject (message-simplify-subject subject))
-
- (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
- (string-match "<[^>]+>" gnus-warning))
- (setq message-id (match-string 0 gnus-warning)))
-
- (unless follow-to
- (setq follow-to (message-get-reply-headers wide to-address))))
-
- (unless (message-mail-user-agent)
- (message-pop-to-buffer
- (message-buffer-name
- (if wide "wide reply" "reply") from
- (if wide to-address nil))))
-
- (setq message-reply-headers
- (vector 0 subject from date message-id references 0 0 ""))
-
- (message-setup
- `((Subject . ,subject)
- ,@follow-to)
- cur)))
-
-;;;###autoload
-(defun message-wide-reply (&optional to-address)
- "Make a \"wide\" reply to the message in the current buffer."
- (interactive)
- (message-reply to-address t))
-
-;;;###autoload
-(defun message-followup (&optional to-newsgroups)
- "Follow up to the message in the current buffer.
-If TO-NEWSGROUPS, use that as the new Newsgroups line."
- (interactive)
- (require 'gnus-sum) ; for gnus-list-identifiers
- (let ((cur (current-buffer))
- from subject date reply-to mrt mct
- references message-id follow-to
- (inhibit-point-motion-hooks t)
- (message-this-is-news t)
- followup-to distribution newsgroups gnus-warning posted-to)
- (save-restriction
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (when (functionp message-followup-to-function)
- (setq follow-to
- (funcall message-followup-to-function)))
- (setq from (message-fetch-field "from")
- date (message-fetch-field "date")
- subject (or (message-fetch-field "subject") "none")
- references (message-fetch-field "references")
- message-id (message-fetch-field "message-id" t)
- followup-to (message-fetch-field "followup-to")
- newsgroups (message-fetch-field "newsgroups")
- posted-to (message-fetch-field "posted-to")
- reply-to (message-fetch-field "reply-to")
- mrt (message-fetch-field "mail-reply-to")
- distribution (message-fetch-field "distribution")
- mct (message-fetch-field "mail-copies-to"))
- (when (and (setq gnus-warning (message-fetch-field "gnus-warning"))
- (string-match "<[^>]+>" gnus-warning))
- (setq message-id (match-string 0 gnus-warning)))
- ;; Remove bogus distribution.
- (when (and (stringp distribution)
- (let ((case-fold-search t))
- (string-match "world" distribution)))
- (setq distribution nil))
- ;; Strip list identifiers, "Re: ", and "was:"
- (setq subject (message-simplify-subject subject))
- (widen))
-
- (message-pop-to-buffer (message-buffer-name "followup" from newsgroups))
-
- (setq message-reply-headers
- (vector 0 subject from date message-id references 0 0 ""))
-
- (message-setup
- `((Subject . ,subject)
- ,@(cond
- (to-newsgroups
- (list (cons 'Newsgroups to-newsgroups)))
- (follow-to follow-to)
- ((and followup-to message-use-followup-to)
- (list
- (cond
- ((equal (downcase followup-to) "poster")
- (if (or (eq message-use-followup-to 'use)
- (message-y-or-n-p "Obey Followup-To: poster? " t "\
-You should normally obey the Followup-To: header.
-
-`Followup-To: poster' sends your response via e-mail instead of news.
-
-A typical situation where `Followup-To: poster' is used is when the poster
-does not read the newsgroup, so he wouldn't see any replies sent to it.
-
-You may customize the variable `message-use-followup-to', if you
-want to get rid of this query permanently."))
- (progn
- (setq message-this-is-news nil)
- (cons 'To (or mrt reply-to from "")))
- (cons 'Newsgroups newsgroups)))
- (t
- (if (or (equal followup-to newsgroups)
- (not (eq message-use-followup-to 'ask))
- (message-y-or-n-p
- (concat "Obey Followup-To: " followup-to "? ") t "\
-You should normally obey the Followup-To: header.
-
- `Followup-To: " followup-to "'
-directs your response to " (if (string-match "," followup-to)
- "the specified newsgroups"
- "that newsgroup only") ".
-
-If a message is posted to several newsgroups, Followup-To is often
-used to direct the following discussion to one newsgroup only,
-because discussions that are spread over several newsgroup tend to
-be fragmented and very difficult to follow.
-
-Also, some source/announcement newsgroups are not intended for discussion;
-responses here are directed to other newsgroups.
-
-You may customize the variable `message-use-followup-to', if you
-want to get rid of this query permanently."))
- (cons 'Newsgroups followup-to)
- (cons 'Newsgroups newsgroups))))))
- (posted-to
- `((Newsgroups . ,posted-to)))
- (t
- `((Newsgroups . ,newsgroups))))
- ,@(and distribution (list (cons 'Distribution distribution)))
- ,@(when (and mct
- (not (or (equal (downcase mct) "never")
- (equal (downcase mct) "nobody"))))
- (list (cons 'Cc (if (or (equal (downcase mct) "always")
- (equal (downcase mct) "poster"))
- (or mrt reply-to from "")
- mct)))))
-
- cur)))
-
-(defun message-is-yours-p ()
- "Non-nil means current article is yours.
-If you have added 'cancel-messages to `message-shoot-gnksa-feet', all articles
-are yours except those that have Cancel-Lock header not belonging to you.
-Instead of shooting GNKSA feet, you should modify `message-alternative-emails'
-regexp to match all of yours addresses."
- ;; Canlock-logic as suggested by Per Abrahamsen
- ;; <abraham@dina.kvl.dk>
- ;;
- ;; IF article has cancel-lock THEN
- ;; IF we can verify it THEN
- ;; issue cancel
- ;; ELSE
- ;; error: cancellock: article is not yours
- ;; ELSE
- ;; Use old rules, comparing sender...
- (save-excursion
- (save-restriction
- (message-narrow-to-head-1)
- (if (message-fetch-field "Cancel-Lock")
- (if (null (canlock-verify))
- t
- (error "Failed to verify Cancel-lock: This article is not yours"))
- (let (sender from)
- (or
- (message-gnksa-enable-p 'cancel-messages)
- (and (setq sender (message-fetch-field "sender"))
- (string-equal (downcase sender)
- (downcase (message-make-sender))))
- ;; Email address in From field equals to our address
- (and (setq from (message-fetch-field "from"))
- (string-equal
- (downcase (cadr (mail-extract-address-components from)))
- (downcase (cadr (mail-extract-address-components
- (message-make-from))))))
- ;; Email address in From field matches
- ;; 'message-alternative-emails' regexp
- (and from
- message-alternative-emails
- (string-match
- message-alternative-emails
- (cadr (mail-extract-address-components from))))))))))
-
-;;;###autoload
-(defun message-cancel-news (&optional arg)
- "Cancel an article you posted.
-If ARG, allow editing of the cancellation message."
- (interactive "P")
- (unless (message-news-p)
- (error "This is not a news article; canceling is impossible"))
- (let (from newsgroups message-id distribution buf)
- (save-excursion
- ;; Get header info from original article.
- (save-restriction
- (message-narrow-to-head-1)
- (setq from (message-fetch-field "from")
- newsgroups (message-fetch-field "newsgroups")
- message-id (message-fetch-field "message-id" t)
- distribution (message-fetch-field "distribution")))
- ;; Make sure that this article was written by the user.
- (unless (message-is-yours-p)
- (error "This article is not yours"))
- (when (yes-or-no-p "Do you really want to cancel this article? ")
- ;; Make control message.
- (if arg
- (message-news)
- (setq buf (set-buffer (get-buffer-create " *message cancel*"))))
- (erase-buffer)
- (insert "Newsgroups: " newsgroups "\n"
- "From: " from "\n"
- "Subject: cmsg cancel " message-id "\n"
- "Control: cancel " message-id "\n"
- (if distribution
- (concat "Distribution: " distribution "\n")
- "")
- mail-header-separator "\n"
- message-cancel-message)
- (run-hooks 'message-cancel-hook)
- (unless arg
- (message "Canceling your article...")
- (if (let ((message-syntax-checks
- 'dont-check-for-anything-just-trust-me))
- (funcall message-send-news-function))
- (message "Canceling your article...done"))
- (kill-buffer buf))))))
-
-;;;###autoload
-(defun message-supersede ()
- "Start composing a message to supersede the current message.
-This is done simply by taking the old article and adding a Supersedes
-header line with the old Message-ID."
- (interactive)
- (let ((cur (current-buffer)))
- ;; Check whether the user owns the article that is to be superseded.
- (unless (message-is-yours-p)
- (error "This article is not yours"))
- ;; Get a normal message buffer.
- (message-pop-to-buffer (message-buffer-name "supersede"))
- (insert-buffer-substring cur)
- (mime-to-mml)
- (message-narrow-to-head-1)
- ;; Remove unwanted headers.
- (when message-ignored-supersedes-headers
- (message-remove-header message-ignored-supersedes-headers t))
- (goto-char (point-min))
- (if (not (re-search-forward "^Message-ID: " nil t))
- (error "No Message-ID in this article")
- (replace-match "Supersedes: " t t))
- (goto-char (point-max))
- (insert mail-header-separator)
- (widen)
- (forward-line 1)))
-
-;;;###autoload
-(defun message-recover ()
- "Reread contents of current buffer from its last auto-save file."
- (interactive)
- (let ((file-name (make-auto-save-file-name)))
- (cond ((save-window-excursion
- (if (not (eq system-type 'vax-vms))
- (with-output-to-temp-buffer "*Directory*"
- (with-current-buffer standard-output
- (fundamental-mode)) ; for Emacs 20.4+
- (buffer-disable-undo standard-output)
- (let ((default-directory "/"))
- (call-process
- "ls" nil standard-output nil "-l" file-name))))
- (yes-or-no-p (format "Recover auto save file %s? " file-name)))
- (let ((buffer-read-only nil))
- (erase-buffer)
- (insert-file-contents file-name nil)))
- (t (error "message-recover cancelled")))))
-
-;;; Washing Subject:
-
-(defun message-wash-subject (subject)
- "Remove junk like \"Re:\", \"(fwd)\", etc. added to subject string SUBJECT.
-Previous forwarders, replyers, etc. may add it."
- (with-temp-buffer
- (insert subject)
- (goto-char (point-min))
- ;; strip Re/Fwd stuff off the beginning
- (while (re-search-forward
- "\\([Rr][Ee]:\\|[Ff][Ww][Dd]\\(\\[[0-9]*\\]\\)?:\\|[Ff][Ww]:\\)" nil t)
- (replace-match ""))
-
- ;; and gnus-style forwards [foo@bar.com] subject
- (goto-char (point-min))
- (while (re-search-forward "\\[[^ \t]*\\(@\\|\\.\\)[^ \t]*\\]" nil t)
- (replace-match ""))
-
- ;; and off the end
- (goto-char (point-max))
- (while (re-search-backward "([Ff][Ww][Dd])" nil t)
- (replace-match ""))
-
- ;; and finally, any whitespace that was left-over
- (goto-char (point-min))
- (while (re-search-forward "^[ \t]+" nil t)
- (replace-match ""))
- (goto-char (point-max))
- (while (re-search-backward "[ \t]+$" nil t)
- (replace-match ""))
-
- (buffer-string)))
-
-;;; Forwarding messages.
-
-(defvar message-forward-decoded-p nil
- "Non-nil means the original message is decoded.")
-
-(defun message-forward-subject-name-subject (subject)
- "Generate a SUBJECT for a forwarded message.
-The form is: [Source] Subject, where if the original message was mail,
-Source is the name of the sender, and if the original message was
-news, Source is the list of newsgroups is was posted to."
- (let* ((group (message-fetch-field "newsgroups"))
- (from (message-fetch-field "from"))
- (prefix
- (if group
- (gnus-group-decoded-name group)
- (or (and from (car (gnus-extract-address-components from)))
- "(nowhere)"))))
- (concat "["
- (if message-forward-decoded-p
- prefix
- (mail-decode-encoded-word-string prefix))
- "] " subject)))
-
-(defun message-forward-subject-author-subject (subject)
- "Generate a SUBJECT for a forwarded message.
-The form is: [Source] Subject, where if the original message was mail,
-Source is the sender, and if the original message was news, Source is
-the list of newsgroups is was posted to."
- (let* ((group (message-fetch-field "newsgroups"))
- (prefix
- (if group
- (gnus-group-decoded-name group)
- (or (message-fetch-field "from")
- "(nowhere)"))))
- (concat "["
- (if message-forward-decoded-p
- prefix
- (mail-decode-encoded-word-string prefix))
- "] " subject)))
-
-(defun message-forward-subject-fwd (subject)
- "Generate a SUBJECT for a forwarded message.
-The form is: Fwd: Subject, where Subject is the original subject of
-the message."
- (if (string-match "^Fwd: " subject)
- subject
- (concat "Fwd: " subject)))
-
-(defun message-make-forward-subject ()
- "Return a Subject header suitable for the message in the current buffer."
- (save-excursion
- (save-restriction
- (message-narrow-to-head-1)
- (let ((funcs message-make-forward-subject-function)
- (subject (message-fetch-field "Subject")))
- (setq subject
- (if subject
- (if message-forward-decoded-p
- subject
- (mail-decode-encoded-word-string subject))
- ""))
- (if message-wash-forwarded-subjects
- (setq subject (message-wash-subject subject)))
- ;; Make sure funcs is a list.
- (and funcs
- (not (listp funcs))
- (setq funcs (list funcs)))
- ;; Apply funcs in order, passing subject generated by previous
- ;; func to the next one.
- (while funcs
- (when (functionp (car funcs))
- (setq subject (funcall (car funcs) subject)))
- (setq funcs (cdr funcs)))
- subject))))
-
-(eval-when-compile
- (defvar gnus-article-decoded-p))
-
-
-;;;###autoload
-(defun message-forward (&optional news digest)
- "Forward the current message via mail.
-Optional NEWS will use news to forward instead of mail.
-Optional DIGEST will use digest to forward."
- (interactive "P")
- (let* ((cur (current-buffer))
- (message-forward-decoded-p
- (if (local-variable-p 'gnus-article-decoded-p (current-buffer))
- gnus-article-decoded-p ;; In an article buffer.
- message-forward-decoded-p))
- (subject (message-make-forward-subject)))
- (if news
- (message-news nil subject)
- (message-mail nil subject))
- (message-forward-make-body cur digest)))
-
-(defun message-forward-make-body-plain (forward-buffer)
- (insert
- "\n-------------------- Start of forwarded message --------------------\n")
- (let ((b (point)) e)
- (insert
- (with-temp-buffer
- (mm-disable-multibyte)
- (insert
- (with-current-buffer forward-buffer
- (mm-with-unibyte-current-buffer (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
- (setq e (point))
- (insert
- "\n-------------------- End of forwarded message --------------------\n")
- (when message-forward-ignored-headers
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
-
-(defun message-forward-make-body-mime (forward-buffer)
- (insert "\n\n<#part type=message/rfc822 disposition=inline raw=t>\n")
- (let ((b (point)) e)
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max)))
- (setq e (point))
- (insert "<#/part>\n")))
-
-(defun message-forward-make-body-mml (forward-buffer)
- (insert "\n\n<#mml type=message/rfc822 disposition=inline>\n")
- (let ((b (point)) e)
- (if (not message-forward-decoded-p)
- (insert
- (with-temp-buffer
- (mm-disable-multibyte)
- (insert
- (with-current-buffer forward-buffer
- (mm-with-unibyte-current-buffer (buffer-string))))
- (mm-enable-multibyte)
- (mime-to-mml)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (buffer-string)))
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-insert-buffer forward-buffer)
- (goto-char (point-min))
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- (goto-char (point-max))))
- (setq e (point))
- (insert "<#/mml>\n")
- (when (and (not message-forward-decoded-p)
- message-forward-ignored-headers)
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (message-remove-header message-forward-ignored-headers t)))))
-
-(defun message-forward-make-body-digest-plain (forward-buffer)
- (insert
- "\n-------------------- Start of forwarded message --------------------\n")
- (let ((b (point)) e)
- (mml-insert-buffer forward-buffer)
- (setq e (point))
- (insert
- "\n-------------------- End of forwarded message --------------------\n")))
-
-(defun message-forward-make-body-digest-mime (forward-buffer)
- (insert "\n<#multipart type=digest>\n")
- (let ((b (point)) e)
- (insert-buffer-substring forward-buffer)
- (setq e (point))
- (insert "<#/multipart>\n")
- (save-restriction
- (narrow-to-region b e)
- (goto-char b)
- (narrow-to-region (point)
- (or (search-forward "\n\n" nil t) (point)))
- (delete-region (point-min) (point-max)))))
-
-(defun message-forward-make-body-digest (forward-buffer)
- (if message-forward-as-mime
- (message-forward-make-body-digest-mime forward-buffer)
- (message-forward-make-body-digest-plain forward-buffer)))
-
-;;;###autoload
-(defun message-forward-make-body (forward-buffer &optional digest)
- ;; Put point where we want it before inserting the forwarded
- ;; message.
- (if message-forward-before-signature
- (message-goto-body)
- (goto-char (point-max)))
- (if digest
- (message-forward-make-body-digest forward-buffer)
- (if message-forward-as-mime
- (if (and message-forward-show-mml
- (not (and (eq message-forward-show-mml 'best)
- (with-current-buffer forward-buffer
- (goto-char (point-min))
- (re-search-forward
- "Content-Type: *multipart/\\(signed\\|encrypted\\)"
- nil t)))))
- (message-forward-make-body-mml forward-buffer)
- (message-forward-make-body-mime forward-buffer))
- (message-forward-make-body-plain forward-buffer)))
- (message-position-point))
-
-;;;###autoload
-(defun message-forward-rmail-make-body (forward-buffer)
- (save-window-excursion
- (set-buffer forward-buffer)
- ;; Rmail doesn't have rmail-msg-restore-non-pruned-header in Emacs
- ;; 20. FIXIT, or we drop support for rmail in Emacs 20.
- (if (rmail-msg-is-pruned)
- (rmail-msg-restore-non-pruned-header)))
- (message-forward-make-body forward-buffer))
-
-(eval-when-compile (defvar rmail-enable-mime-composing))
-
-;; Fixme: Should have defcustom.
-;;;###autoload
-(defun message-insinuate-rmail ()
- "Let RMAIL use message to forward."
- (interactive)
- (setq rmail-enable-mime-composing t)
- (setq rmail-insert-mime-forwarded-message-function
- 'message-forward-rmail-make-body))
-
-;;;###autoload
-(defun message-resend (address)
- "Resend the current article to ADDRESS."
- (interactive
- (list (message-read-from-minibuffer "Resend message to: ")))
- (message "Resending message to %s..." address)
- (save-excursion
- (let ((cur (current-buffer))
- beg)
- ;; We first set up a normal mail buffer.
- (unless (message-mail-user-agent)
- (set-buffer (get-buffer-create " *message resend*"))
- (erase-buffer))
- (let ((message-this-is-mail t)
- message-setup-hook)
- (message-setup `((To . ,address))))
- ;; Insert our usual headers.
- (message-generate-headers '(From Date To Message-ID))
- (message-narrow-to-headers)
- ;; Remove X-Draft-From header etc.
- (message-remove-header message-ignored-mail-headers t)
- ;; Rename them all to "Resent-*".
- (goto-char (point-min))
- (while (re-search-forward "^[A-Za-z]" nil t)
- (forward-char -1)
- (insert "Resent-"))
- (widen)
- (forward-line)
- (delete-region (point) (point-max))
- (setq beg (point))
- ;; Insert the message to be resent.
- (insert-buffer-substring cur)
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-char -1)
- (save-restriction
- (narrow-to-region beg (point))
- (message-remove-header message-ignored-resent-headers t)
- (goto-char (point-max)))
- (insert mail-header-separator)
- ;; Rename all old ("Also-")Resent headers.
- (while (re-search-backward "^\\(Also-\\)*Resent-" beg t)
- (beginning-of-line)
- (insert "Also-"))
- ;; Quote any "From " lines at the beginning.
- (goto-char beg)
- (when (looking-at "From ")
- (replace-match "X-From-Line: "))
- ;; Send it.
- (let ((message-inhibit-body-encoding t)
- message-required-mail-headers
- rfc2047-encode-encoded-words)
- (message-send-mail))
- (kill-buffer (current-buffer)))
- (message "Resending message to %s...done" address)))
-
-;;;###autoload
-(defun message-bounce ()
- "Re-mail the current message.
-This only makes sense if the current message is a bounce message that
-contains some mail you have written which has been bounced back to
-you."
- (interactive)
- (let ((handles (mm-dissect-buffer t))
- boundary)
- (message-pop-to-buffer (message-buffer-name "bounce"))
- (if (stringp (car handles))
- ;; This is a MIME bounce.
- (mm-insert-part (car (last handles)))
- ;; This is a non-MIME bounce, so we try to remove things
- ;; manually.
- (mm-insert-part handles)
- (undo-boundary)
- (goto-char (point-min))
- (re-search-forward "\n\n+" nil t)
- (setq boundary (point))
- ;; We remove everything before the bounced mail.
- (if (or (re-search-forward message-unsent-separator nil t)
- (progn
- (search-forward "\n\n" nil 'move)
- (re-search-backward "^Return-Path:.*\n" boundary t)))
- (progn
- (forward-line 1)
- (delete-region (point-min)
- (if (re-search-forward "^[^ \n\t]+:" nil t)
- (match-beginning 0)
- (point))))
- (goto-char boundary)
- (when (re-search-backward "^.?From .*\n" nil t)
- (delete-region (match-beginning 0) (match-end 0)))))
- (mime-to-mml)
- (save-restriction
- (message-narrow-to-head-1)
- (message-remove-header message-ignored-bounced-headers t)
- (goto-char (point-max))
- (insert mail-header-separator))
- (message-position-point)))
-
-;;;
-;;; Interactive entry points for new message buffers.
-;;;
-
-;;;###autoload
-(defun message-mail-other-window (&optional to subject)
- "Like `message-mail' command, but display mail buffer in another window."
- (interactive)
- (unless (message-mail-user-agent)
- (let ((pop-up-windows t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to))))
- (let ((message-this-is-mail t))
- (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
- nil nil nil 'switch-to-buffer-other-window)))
-
-;;;###autoload
-(defun message-mail-other-frame (&optional to subject)
- "Like `message-mail' command, but display mail buffer in another frame."
- (interactive)
- (unless (message-mail-user-agent)
- (let ((pop-up-frames t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "mail" to))))
- (let ((message-this-is-mail t))
- (message-setup `((To . ,(or to "")) (Subject . ,(or subject "")))
- nil nil nil 'switch-to-buffer-other-frame)))
-
-;;;###autoload
-(defun message-news-other-window (&optional newsgroups subject)
- "Start editing a news article to be sent."
- (interactive)
- (let ((pop-up-windows t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
- (let ((message-this-is-news t))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
- (Subject . ,(or subject ""))))))
-
-;;;###autoload
-(defun message-news-other-frame (&optional newsgroups subject)
- "Start editing a news article to be sent."
- (interactive)
- (let ((pop-up-frames t)
- (special-display-buffer-names nil)
- (special-display-regexps nil)
- (same-window-buffer-names nil)
- (same-window-regexps nil))
- (message-pop-to-buffer (message-buffer-name "posting" nil newsgroups)))
- (let ((message-this-is-news t))
- (message-setup `((Newsgroups . ,(or newsgroups ""))
- (Subject . ,(or subject ""))))))
-
-;;; underline.el
-
-;; This code should be moved to underline.el (from which it is stolen).
-
-;;;###autoload
-(defun bold-region (start end)
- "Bold all nonblank characters in the region.
-Works by overstriking characters.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
- (interactive "r")
- (save-excursion
- (let ((end1 (make-marker)))
- (move-marker end1 (max start end))
- (goto-char (min start end))
- (while (< (point) end1)
- (or (looking-at "[_\^@- ]")
- (insert (char-after) "\b"))
- (forward-char 1)))))
-
-;;;###autoload
-(defun unbold-region (start end)
- "Remove all boldness (overstruck characters) in the region.
-Called from program, takes two arguments START and END
-which specify the range to operate on."
- (interactive "r")
- (save-excursion
- (let ((end1 (make-marker)))
- (move-marker end1 (max start end))
- (goto-char (min start end))
- (while (re-search-forward "\b" end1 t)
- (if (eq (char-after) (char-after (- (point) 2)))
- (delete-char -2))))))
-
-(defun message-exchange-point-and-mark ()
- "Exchange point and mark, but don't activate region if it was inactive."
- (unless (prog1
- (message-mark-active-p)
- (exchange-point-and-mark))
- (setq mark-active nil)))
-
-(defalias 'message-make-overlay 'make-overlay)
-(defalias 'message-delete-overlay 'delete-overlay)
-(defalias 'message-overlay-put 'overlay-put)
-(defun message-kill-all-overlays ()
- (if (featurep 'xemacs)
- (map-extents (lambda (extent ignore) (delete-extent extent)))
- (mapcar #'delete-overlay (overlays-in (point-min) (point-max)))))
-
-;; Support for toolbar
-(eval-when-compile
- (defvar tool-bar-mode))
-
-;; Note: The :set function in the `message-tool-bar*' variables will only
-;; affect _new_ message buffers. We might add a function that walks thru all
-;; message-mode buffers and force the update.
-(defun message-tool-bar-update (&optional symbol value)
- "Update message mode toolbar.
-Setter function for custom variables."
- (setq-default message-tool-bar-map nil)
- (when symbol
- ;; When used as ":set" function:
- (set-default symbol value)))
-
-(defcustom message-tool-bar (if (eq gmm-tool-bar-style 'gnome)
- 'message-tool-bar-gnome
- 'message-tool-bar-retro)
- "Specifies the message mode tool bar.
-
-It can be either a list or a symbol refering to a list. See
-`gmm-tool-bar-from-list' for the format of the list. The
-default key map is `message-mode-map'.
-
-Pre-defined symbols include `message-tool-bar-gnome' and
-`message-tool-bar-retro'."
- :type '(repeat gmm-tool-bar-list-item)
- :type '(choice (const :tag "GNOME style" message-tool-bar-gnome)
- (const :tag "Retro look" message-tool-bar-retro)
- (repeat :tag "User defined list" gmm-tool-bar-item)
- (symbol))
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
- :group 'message)
-
-(defcustom message-tool-bar-gnome
- '((ispell-message "spell" nil
- :visible (or (not (boundp 'flyspell-mode))
- (not flyspell-mode)))
- (flyspell-buffer "spell" t
- :visible (and (boundp 'flyspell-mode)
- flyspell-mode)
- :help "Flyspell whole buffer")
- (gmm-ignore "separator")
- (message-send-and-exit "mail/send")
- (message-dont-send "mail/save-draft")
- (message-kill-buffer "close") ;; stock_cancel
- (mml-attach-file "attach" mml-mode-map)
- (mml-preview "mail/preview" mml-mode-map)
- ;; (mml-secure-message-sign-encrypt "lock" mml-mode-map :visible nil)
- (message-insert-importance-high "important" nil :visible nil)
- (message-insert-importance-low "unimportant" nil :visible nil)
- (message-insert-disposition-notification-to "receipt" nil :visible nil)
- (gmm-customize-mode "preferences" t :help "Edit mode preferences")
- (message-info "help" t :help "Message manual"))
- "List of items for the message tool bar (GNOME style).
-
-See `gmm-tool-bar-from-list' for details on the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
- :group 'message)
-
-(defcustom message-tool-bar-retro
- '(;; Old Emacs 21 icon for consistency.
- (message-send-and-exit "gnus/mail-send")
- (message-kill-buffer "close")
- (message-dont-send "cancel")
- (mml-attach-file "attach" mml-mode-map)
- (ispell-message "spell")
- (mml-preview "preview" mml-mode-map)
- (message-insert-importance-high "gnus/important")
- (message-insert-importance-low "gnus/unimportant")
- (message-insert-disposition-notification-to "gnus/receipt"))
- "List of items for the message tool bar (retro style).
-
-See `gmm-tool-bar-from-list' for details on the format of the list."
- :type '(repeat gmm-tool-bar-item)
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
- :group 'message)
-
-(defcustom message-tool-bar-zap-list
- '(new-file open-file dired kill-buffer write-file
- print-buffer customize help)
- "List of icon items from the global tool bar.
-These items are not displayed on the message mode tool bar.
-
-See `gmm-tool-bar-from-list' for the format of the list."
- :type 'gmm-tool-bar-zap-list
- :version "22.1" ;; Gnus 5.10.9
- :initialize 'custom-initialize-default
- :set 'message-tool-bar-update
- :group 'message)
-
-(defvar image-load-path)
-
-(defun message-make-tool-bar (&optional force)
- "Make a message mode tool bar from `message-tool-bar-list'.
-When FORCE, rebuild the tool bar."
- (when (and (not (featurep 'xemacs))
- (boundp 'tool-bar-mode)
- tool-bar-mode
- (or (not message-tool-bar-map) force))
- (setq message-tool-bar-map
- (let* ((load-path
- (gmm-image-load-path-for-library "message"
- "mail/save-draft.xpm"
- nil t))
- (image-load-path (cons (car load-path)
- (when (boundp 'image-load-path)
- image-load-path))))
- (gmm-tool-bar-from-list message-tool-bar
- message-tool-bar-zap-list
- 'message-mode-map))))
- message-tool-bar-map)
-
-;;; Group name completion.
-
-(defcustom message-newgroups-header-regexp
- "^\\(Newsgroups\\|Followup-To\\|Posted-To\\|Gcc\\):"
- "Regexp that match headers that lists groups."
- :group 'message
- :type 'regexp)
-
-(defcustom message-completion-alist
- (list (cons message-newgroups-header-regexp 'message-expand-group)
- '("^\\(Resent-\\)?\\(To\\|B?Cc\\):" . message-expand-name)
- '("^\\(Reply-To\\|From\\|Mail-Followup-To\\|Mail-Copies-To\\):"
- . message-expand-name)
- '("^\\(Disposition-Notification-To\\|Return-Receipt-To\\):"
- . message-expand-name))
- "Alist of (RE . FUN). Use FUN for completion on header lines matching RE."
- :version "22.1"
- :group 'message
- :type '(alist :key-type regexp :value-type function))
-
-(defcustom message-tab-body-function nil
- "*Function to execute when `message-tab' (TAB) is executed in the body.
-If nil, the function bound in `text-mode-map' or `global-map' is executed."
- :version "22.1"
- :group 'message
- :link '(custom-manual "(message)Various Commands")
- :type '(choice (const nil)
- function))
-
-(defun message-tab ()
- "Complete names according to `message-completion-alist'.
-Execute function specified by `message-tab-body-function' when not in
-those headers."
- (interactive)
- (let ((alist message-completion-alist))
- (while (and alist
- (let ((mail-abbrev-mode-regexp (caar alist)))
- (not (mail-abbrev-in-expansion-header-p))))
- (setq alist (cdr alist)))
- (funcall (or (cdar alist) message-tab-body-function
- (lookup-key text-mode-map "\t")
- (lookup-key global-map "\t")
- 'indent-relative))))
-
-(eval-and-compile
- (condition-case nil
- (with-temp-buffer
- (let ((standard-output (current-buffer)))
- (eval '(display-completion-list nil "")))
- (defalias 'message-display-completion-list 'display-completion-list))
- (error ;; Don't use `wrong-number-of-arguments' here because of XEmacs.
- (defun message-display-completion-list (completions &optional ignore)
- "Display the list of completions, COMPLETIONS, using `standard-output'."
- (display-completion-list completions)))))
-
-(defun message-expand-group ()
- "Expand the group name under point."
- (let* ((b (save-excursion
- (save-restriction
- (narrow-to-region
- (save-excursion
- (beginning-of-line)
- (skip-chars-forward "^:")
- (1+ (point)))
- (point))
- (skip-chars-backward "^, \t\n") (point))))
- (completion-ignore-case t)
- (string (buffer-substring b (progn (skip-chars-forward "^,\t\n ")
- (point))))
- (hashtb (and (boundp 'gnus-active-hashtb) gnus-active-hashtb))
- (completions (all-completions string hashtb))
- comp)
- (delete-region b (point))
- (cond
- ((= (length completions) 1)
- (if (string= (car completions) string)
- (progn
- (insert string)
- (message "Only matching group"))
- (insert (car completions))))
- ((and (setq comp (try-completion string hashtb))
- (not (string= comp string)))
- (insert comp))
- (t
- (insert string)
- (if (not comp)
- (message "No matching groups")
- (save-selected-window
- (pop-to-buffer "*Completions*")
- (buffer-disable-undo)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (let ((standard-output (current-buffer)))
- (message-display-completion-list (sort completions 'string<)
- string))
- (setq buffer-read-only nil)
- (goto-char (point-min))
- (delete-region (point) (progn (forward-line 3) (point))))))))))
-
-(defun message-expand-name ()
- (if (fboundp 'bbdb-complete-name)
- (bbdb-complete-name)
- (expand-abbrev)))
-
-;;; Help stuff.
-
-(defun message-talkative-question (ask question show &rest text)
- "Call FUNCTION with argument QUESTION; optionally display TEXT... args.
-If SHOW is non-nil, the arguments TEXT... are displayed in a temp buffer.
-The following arguments may contain lists of values."
- (if (and show
- (setq text (message-flatten-list text)))
- (save-window-excursion
- (save-excursion
- (with-output-to-temp-buffer " *MESSAGE information message*"
- (set-buffer " *MESSAGE information message*")
- (fundamental-mode) ; for Emacs 20.4+
- (mapcar 'princ text)
- (goto-char (point-min))))
- (funcall ask question))
- (funcall ask question)))
-
-(defun message-flatten-list (list)
- "Return a new, flat list that contains all elements of LIST.
-
-\(message-flatten-list '(1 (2 3 (4 5 (6))) 7))
-=> (1 2 3 4 5 6 7)"
- (cond ((consp list)
- (apply 'append (mapcar 'message-flatten-list list)))
- (list
- (list list))))
-
-(defun message-generate-new-buffer-clone-locals (name &optional varstr)
- "Create and return a buffer with name based on NAME using `generate-new-buffer'.
-Then clone the local variables and values from the old buffer to the
-new one, cloning only the locals having a substring matching the
-regexp VARSTR."
- (let ((oldbuf (current-buffer)))
- (save-excursion
- (set-buffer (generate-new-buffer name))
- (message-clone-locals oldbuf varstr)
- (current-buffer))))
-
-(defun message-clone-locals (buffer &optional varstr)
- "Clone the local variables from BUFFER to the current buffer."
- (let ((locals (save-excursion
- (set-buffer buffer)
- (buffer-local-variables)))
- (regexp "^gnus\\|^nn\\|^message\\|^sendmail\\|^smtp\\|^user-mail-address"))
- (mapcar
- (lambda (local)
- (when (and (consp local)
- (car local)
- (string-match regexp (symbol-name (car local)))
- (or (null varstr)
- (string-match varstr (symbol-name (car local)))))
- (ignore-errors
- (set (make-local-variable (car local))
- (cdr local)))))
- locals)))
-
-;;;
-;;; MIME functions
-;;;
-
-(defvar message-inhibit-body-encoding nil)
-
-(defun message-encode-message-body ()
- (unless message-inhibit-body-encoding
- (let ((mail-parse-charset (or mail-parse-charset
- message-default-charset))
- (case-fold-search t)
- lines content-type-p)
- (message-goto-body)
- (save-restriction
- (narrow-to-region (point) (point-max))
- (let ((new (mml-generate-mime)))
- (when new
- (delete-region (point-min) (point-max))
- (insert new)
- (goto-char (point-min))
- (if (eq (aref new 0) ?\n)
- (delete-char 1)
- (search-forward "\n\n")
- (setq lines (buffer-substring (point-min) (1- (point))))
- (delete-region (point-min) (point))))))
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-remove-header "Mime-Version")
- (goto-char (point-max))
- (insert "MIME-Version: 1.0\n")
- (when lines
- (insert lines))
- (setq content-type-p
- (or mml-boundary
- (re-search-backward "^Content-Type:" nil t))))
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-remove-first-header "Content-Type")
- (message-remove-first-header "Content-Transfer-Encoding"))
- ;; We always make sure that the message has a Content-Type
- ;; header. This is because some broken MTAs and MUAs get
- ;; awfully confused when confronted with a message with a
- ;; MIME-Version header and without a Content-Type header. For
- ;; instance, Solaris' /usr/bin/mail.
- (unless content-type-p
- (goto-char (point-min))
- ;; For unknown reason, MIME-Version doesn't exist.
- (when (re-search-forward "^MIME-Version:" nil t)
- (forward-line 1)
- (insert "Content-Type: text/plain; charset=us-ascii\n"))))))
-
-(defun message-read-from-minibuffer (prompt &optional initial-contents)
- "Read from the minibuffer while providing abbrev expansion."
- (if (fboundp 'mail-abbrevs-setup)
- (let ((mail-abbrev-mode-regexp "")
- (minibuffer-setup-hook 'mail-abbrevs-setup)
- (minibuffer-local-map message-minibuffer-local-map))
- (read-from-minibuffer prompt initial-contents))
- (let ((minibuffer-setup-hook 'mail-abbrev-minibuffer-setup-hook)
- (minibuffer-local-map message-minibuffer-local-map))
- (read-string prompt initial-contents))))
-
-(defun message-use-alternative-email-as-from ()
- "Set From field of the outgoing message to the first matching
-address in `message-alternative-emails', looking at To, Cc and
-From headers in the original article."
- (require 'mail-utils)
- (let* ((fields '("To" "Cc" "From"))
- (emails
- (split-string
- (mail-strip-quoted-names
- (mapconcat 'message-fetch-reply-field fields ","))
- "[ \f\t\n\r\v,]+"))
- email)
- (while emails
- (if (string-match message-alternative-emails (car emails))
- (setq email (car emails)
- emails nil))
- (pop emails))
- (unless (or (not email) (equal email user-mail-address))
- (message-remove-header "From")
- (goto-char (point-max))
- (insert "From: " (let ((user-mail-address email)) (message-make-from))
- "\n"))))
-
-(defun message-options-get (symbol)
- (cdr (assq symbol message-options)))
-
-(defun message-options-set (symbol value)
- (let ((the-cons (assq symbol message-options)))
- (if the-cons
- (if value
- (setcdr the-cons value)
- (setq message-options (delq the-cons message-options)))
- (and value
- (push (cons symbol value) message-options))))
- value)
-
-(defun message-options-set-recipient ()
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-options-set 'message-sender
- (mail-strip-quoted-names
- (message-fetch-field "from")))
- (message-options-set 'message-recipients
- (mail-strip-quoted-names
- (let ((to (message-fetch-field "to"))
- (cc (message-fetch-field "cc"))
- (bcc (message-fetch-field "bcc")))
- (concat
- (or to "")
- (if (and to cc) ", ")
- (or cc "")
- (if (and (or to cc) bcc) ", ")
- (or bcc "")))))))
-
-(defun message-hide-headers ()
- "Hide headers based on the `message-hidden-headers' variable."
- (let ((regexps (if (stringp message-hidden-headers)
- (list message-hidden-headers)
- message-hidden-headers))
- (inhibit-point-motion-hooks t)
- (after-change-functions nil))
- (when regexps
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (goto-char (point-min))
- (while (not (eobp))
- (if (not (message-hide-header-p regexps))
- (message-next-header)
- (let ((begin (point)))
- (message-next-header)
- (add-text-properties
- begin (point)
- '(invisible t message-hidden t))))))))))
-
-(defun message-hide-header-p (regexps)
- (let ((result nil)
- (reverse nil))
- (when (eq (car regexps) 'not)
- (setq reverse t)
- (pop regexps))
- (dolist (regexp regexps)
- (setq result (or result (looking-at regexp))))
- (if reverse
- (not result)
- result)))
-
-(when (featurep 'xemacs)
- (require 'messagexmas)
- (message-xmas-redefine))
-
-(provide 'message)
-
-(run-hooks 'message-load-hook)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: 94b32cac-4504-4b6c-8181-030ebf380ee0
-;;; message.el ends here
+++ /dev/null
-;;; messagexmas.el --- XEmacs extensions to message
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2003,
-;; 2005, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: mail, 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'nnheader)
-
-(defvar message-xmas-dont-activate-region t
- "If t, don't activate region after yanking.")
-
-(defvar message-xmas-glyph-directory nil
- "*Directory where Message logos and icons are located.
-If this variable is nil, Message will try to locate the directory
-automatically.")
-
-(defvar message-use-toolbar (if (featurep 'toolbar) 'default)
- "*Position to display the toolbar. Nil means do not use a toolbar.
-If it is non-nil, it should be one of the symbols `default', `top',
-`bottom', `right', and `left'. `default' means to use the default
-toolbar, the rest mean to display the toolbar on the place which those
-names show.")
-
-(defvar message-toolbar-thickness
- (if (featurep 'toolbar)
- (cons (specifier-instance default-toolbar-height)
- (specifier-instance default-toolbar-width)))
- "*Cons of the height and the width specifying the thickness of a toolbar.
-The height is used for the toolbar displayed on the top or the bottom,
-the width is used for the toolbar displayed on the right or the left.")
-
-(defvar message-toolbar
- '([message-spell ispell-message t "Spell"]
- [message-help (Info-goto-node "(Message)Top") t "Message help"])
- "The message buffer toolbar.")
-
-(defun message-xmas-find-glyph-directory (&optional package)
- (setq package (or package "message"))
- (let ((dir (symbol-value
- (intern-soft (concat package "-xmas-glyph-directory")))))
- (if (and (stringp dir) (file-directory-p dir))
- dir
- (nnheader-find-etc-directory package))))
-
-(defun message-xmas-setup-toolbar (bar &optional force package)
- (let ((dir (or (message-xmas-find-glyph-directory package)
- (message-xmas-find-glyph-directory "gnus")))
- (xpm (if (featurep 'xpm) "xpm" "xbm"))
- icon up down disabled name)
- (unless package
- (setq message-xmas-glyph-directory dir))
- (when dir
- (while bar
- (setq icon (aref (car bar) 0)
- name (symbol-name icon)
- bar (cdr bar))
- (when (or force
- (not (boundp icon)))
- (setq up (concat dir name "-up." xpm))
- (setq down (concat dir name "-down." xpm))
- (setq disabled (concat dir name "-disabled." xpm))
- (if (not (file-exists-p up))
- (setq bar nil
- dir nil)
- (set icon (toolbar-make-button-list
- up (and (file-exists-p down) down)
- (and (file-exists-p disabled) disabled)))))))
- dir))
-
-(defun message-setup-toolbar ()
- (when (featurep 'toolbar)
- (if (and message-use-toolbar
- (message-xmas-setup-toolbar message-toolbar))
- (let ((bar (or (intern-soft (format "%s-toolbar" message-use-toolbar))
- 'default-toolbar))
- (height (car message-toolbar-thickness))
- (width (cdr message-toolbar-thickness))
- (cur (current-buffer))
- bars)
- (set-specifier (symbol-value bar) message-toolbar cur)
- (set-specifier default-toolbar-height height cur)
- (set-specifier default-toolbar-width width cur)
- (set-specifier top-toolbar-height height cur)
- (set-specifier bottom-toolbar-height height cur)
- (set-specifier right-toolbar-width width cur)
- (set-specifier left-toolbar-width width cur)
- (if (eq bar 'default-toolbar)
- (progn
- (remove-specifier default-toolbar-visible-p cur)
- (remove-specifier top-toolbar cur)
- (remove-specifier top-toolbar-visible-p cur)
- (remove-specifier bottom-toolbar cur)
- (remove-specifier bottom-toolbar-visible-p cur)
- (remove-specifier right-toolbar cur)
- (remove-specifier right-toolbar-visible-p cur)
- (remove-specifier left-toolbar cur)
- (remove-specifier left-toolbar-visible-p cur))
- (set-specifier (symbol-value (intern (format "%s-visible-p" bar)))
- t cur)
- (setq bars (delq bar (list 'default-toolbar
- 'bottom-toolbar 'top-toolbar
- 'right-toolbar 'left-toolbar)))
- (while bars
- (set-specifier (symbol-value (intern (format "%s-visible-p"
- (pop bars))))
- nil cur))))
- (let ((cur (current-buffer)))
- (set-specifier default-toolbar-visible-p nil cur)
- (set-specifier top-toolbar-visible-p nil cur)
- (set-specifier bottom-toolbar-visible-p nil cur)
- (set-specifier right-toolbar-visible-p nil cur)
- (set-specifier left-toolbar-visible-p nil cur)))))
-
-(defun message-xmas-exchange-point-and-mark ()
- "Exchange point and mark, but allow for XEmacs' optional argument."
- (exchange-point-and-mark message-xmas-dont-activate-region))
-
-(defun message-xmas-maybe-fontify ()
- (when (featurep 'font-lock)
- (font-lock-set-defaults)))
-
-(defun message-xmas-make-caesar-translation-table (n)
- "Create a rot table with offset N."
- (let ((i -1)
- (table (make-string 256 0))
- (a (mm-char-int ?a))
- (A (mm-char-int ?A)))
- (while (< (incf i) 256)
- (aset table i i))
- (concat
- (substring table 0 A)
- (substring table (+ A n) (+ A n (- 26 n)))
- (substring table A (+ A n))
- (substring table (+ A 26) a)
- (substring table (+ a n) (+ a n (- 26 n)))
- (substring table a (+ a n))
- (substring table (+ a 26) 255))))
-
-(add-hook 'message-mode-hook 'message-xmas-maybe-fontify)
-
-(defun message-xmas-redefine ()
- "Redefine message functions for XEmacs."
- (defalias 'message-exchange-point-and-mark
- 'message-xmas-exchange-point-and-mark)
- (defalias 'message-mark-active-p
- 'region-exists-p)
- (when (>= emacs-major-version 20)
- (defalias 'message-make-caesar-translation-table
- 'message-xmas-make-caesar-translation-table))
- (defalias 'message-make-overlay 'make-extent)
- (defalias 'message-delete-overlay 'delete-extent)
- (defalias 'message-overlay-put 'set-extent-property))
-
-(message-xmas-redefine)
-
-(provide 'messagexmas)
-
-;;; arch-tag: 0ece0484-8757-4641-b2d4-17147dd5c5b5
-;;; messagexmas.el ends here
+++ /dev/null
-;;; messcompat.el --- making message mode compatible with mail mode
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: mail, 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This file tries to provide backward compatibility with sendmail.el
-;; for Message mode. It should be used by simply adding
-;;
-;; (require 'messcompat)
-;;
-;; to the .emacs file. Loading it after Message mode has been
-;; loaded will have no effect.
-
-;;; Code:
-
-(require 'sendmail)
-
-(defvar message-from-style mail-from-style
- "*Specifies how \"From\" headers look.
-
-If nil, they contain just the return address like:
- king@grassland.com
-If `parens', they look like:
- king@grassland.com (Elvis Parsley)
-If `angles', they look like:
- Elvis Parsley <king@grassland.com>
-
-Otherwise, most addresses look like `angles', but they look like
-`parens' if `angles' would need quoting and `parens' would not.")
-
-(defvar message-interactive mail-interactive
- "Non-nil means when sending a message wait for and display errors.
-nil means let mailer mail back a message to report errors.")
-
-(defvar message-setup-hook mail-setup-hook
- "Normal hook, run each time a new outgoing message is initialized.
-The function `message-setup' runs this hook.")
-
-(if (boundp 'mail-mode-hook)
- (defvar message-mode-hook mail-mode-hook
- "Hook run in message mode buffers."))
-
-(defvar message-indentation-spaces mail-indentation-spaces
- "*Number of spaces to insert at the beginning of each cited line.
-Used by `message-yank-original' via `message-yank-cite'.")
-
-(defvar message-signature mail-signature
- "*String to be inserted at the end of the message buffer.
-If t, the `message-signature-file' file will be inserted instead.
-If a function, the result from the function will be used instead.
-If a form, the result from the form will be used instead.")
-
-;; Deleted the autoload cookie because this crashes in loaddefs.el.
-(defvar message-signature-file mail-signature-file
- "*File containing the text inserted at end of the message buffer.")
-
-(defvar message-default-headers mail-default-headers
- "*A string containing header lines to be inserted in outgoing messages.
-It is inserted before you edit the message, so you can edit or delete
-these lines.")
-
-(defvar message-send-hook mail-send-hook
- "Hook run before sending messages.")
-
-(defvar message-send-mail-function send-mail-function
- "Function to call to send the current buffer as mail.
-The headers should be delimited by a line whose contents match the
-variable `mail-header-separator'.")
-
-(provide 'messcompat)
-
-;;; arch-tag: a76673be-905e-4bbd-8966-615370494a7b
-;;; messcompat.el ends here
+++ /dev/null
-;;; mm-bodies.el --- Functions for decoding MIME things
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-and-compile
- (or (fboundp 'base64-decode-region)
- (require 'base64)))
-
-(eval-when-compile
- (defvar mm-uu-decode-function)
- (defvar mm-uu-binhex-decode-function))
-
-(require 'mm-util)
-(require 'rfc2047)
-(require 'mm-encode)
-
-;; 8bit treatment gets any char except: 0x32 - 0x7f, LF, TAB, BEL,
-;; BS, vertical TAB, form feed, and ^_
-;;
-;; Note that CR is *not* included, as that would allow a non-paired CR
-;; in the body contrary to RFC 2822:
-;;
-;; - CR and LF MUST only occur together as CRLF; they MUST NOT
-;; appear independently in the body.
-
-(defvar mm-7bit-chars "\x20-\x7f\n\t\x7\x8\xb\xc\x1f")
-
-(defcustom mm-body-charset-encoding-alist
- '((iso-2022-jp . 7bit)
- (iso-2022-jp-2 . 7bit)
- ;; We MUST encode UTF-16 because it can contain \0's which is
- ;; known to break servers.
- ;; Note: UTF-16 variants are invalid for text parts [RFC 2781],
- ;; so this can't happen :-/.
- ;; PPS: Yes, it can happen if the user specifies UTF-16 in the MML
- ;; markup. - jh.
- (utf-16 . base64)
- (utf-16be . base64)
- (utf-16le . base64))
- "Alist of MIME charsets to encodings.
-Valid encodings are `7bit', `8bit', `quoted-printable' and `base64'."
- :type '(repeat (cons (symbol :tag "charset")
- (choice :tag "encoding"
- (const 7bit)
- (const 8bit)
- (const quoted-printable)
- (const base64))))
- :group 'mime)
-
-(defun mm-encode-body (&optional charset)
- "Encode a body.
-Should be called narrowed to the body that is to be encoded.
-If there is more than one non-ASCII MULE charset in the body, then the
-list of MULE charsets found is returned.
-If CHARSET is non-nil, it is used as the MIME charset to encode the body.
-If successful, the MIME charset is returned.
-If no encoding was done, nil is returned."
- (if (not (mm-multibyte-p))
- ;; In the non-Mule case, we search for non-ASCII chars and
- ;; return the value of `mail-parse-charset' if any are found.
- (or charset
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward "[^\x0-\x7f]" nil t)
- (or mail-parse-charset
- (message-options-get 'mm-encody-body-charset)
- (message-options-set
- 'mm-encody-body-charset
- (mm-read-coding-system "Charset used in the article: ")))
- ;; The logic in `mml-generate-mime-1' confirms that it's OK
- ;; to return nil here.
- nil)))
- (save-excursion
- (if charset
- (progn
- (mm-encode-coding-region (point-min) (point-max)
- (mm-charset-to-coding-system charset))
- charset)
- (goto-char (point-min))
- (let ((charsets (mm-find-mime-charset-region (point-min) (point-max)
- mm-hack-charsets)))
- (cond
- ;; No encoding.
- ((null charsets)
- nil)
- ;; Too many charsets.
- ((> (length charsets) 1)
- charsets)
- ;; We encode.
- (t
- (prog1
- (setq charset (car charsets))
- (mm-encode-coding-region (point-min) (point-max)
- (mm-charset-to-coding-system charset))))
- ))))))
-
-(defun mm-long-lines-p (length)
- "Say whether any of the lines in the buffer is longer than LENGTH."
- (save-excursion
- (goto-char (point-min))
- (end-of-line)
- (while (and (not (eobp))
- (not (> (current-column) length)))
- (forward-line 1)
- (end-of-line))
- (and (> (current-column) length)
- (current-column))))
-
-(defvar message-posting-charset)
-
-(defun mm-body-encoding (charset &optional encoding)
- "Do Content-Transfer-Encoding and return the encoding of the current buffer."
- (when (stringp encoding)
- (setq encoding (intern (downcase encoding))))
- (let ((bits (mm-body-7-or-8))
- (longp (mm-long-lines-p 1000)))
- (require 'message)
- (cond
- ((and (not longp)
- (not (and mm-use-ultra-safe-encoding
- (or (save-excursion (re-search-forward " $" nil t))
- (save-excursion (re-search-forward "^From " nil t)))))
- (eq bits '7bit))
- bits)
- ((and (not mm-use-ultra-safe-encoding)
- (not longp)
- (not (cdr (assq charset mm-body-charset-encoding-alist)))
- (or (eq t (cdr message-posting-charset))
- (memq charset (cdr message-posting-charset))
- (eq charset mail-parse-charset)))
- bits)
- (t
- (let ((encoding (or encoding
- (cdr (assq charset mm-body-charset-encoding-alist))
- (mm-qp-or-base64))))
- (when mm-use-ultra-safe-encoding
- (setq encoding (mm-safer-encoding encoding)))
- (mm-encode-content-transfer-encoding encoding "text/plain")
- encoding)))))
-
-(defun mm-body-7-or-8 ()
- "Say whether the body is 7bit or 8bit."
- (if (save-excursion
- (goto-char (point-min))
- (skip-chars-forward mm-7bit-chars)
- (eobp))
- '7bit
- '8bit))
-
-;;;
-;;; Functions for decoding
-;;;
-
-(eval-when-compile (defvar mm-uu-yenc-decode-function))
-
-(defun mm-decode-content-transfer-encoding (encoding &optional type)
- "Decodes buffer encoded with ENCODING, returning success status.
-If TYPE is `text/plain' CRLF->LF translation may occur."
- (prog1
- (condition-case error
- (cond
- ((eq encoding 'quoted-printable)
- (quoted-printable-decode-region (point-min) (point-max))
- t)
- ((eq encoding 'base64)
- (base64-decode-region
- (point-min)
- ;; Some mailers insert whitespace
- ;; junk at the end which
- ;; base64-decode-region dislikes.
- ;; Also remove possible junk which could
- ;; have been added by mailing list software.
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[\t ]*\r?\n" nil t)
- (delete-region (match-beginning 0) (match-end 0)))
- (goto-char (point-max))
- (when (re-search-backward "^[A-Za-z0-9+/]+=*[\t ]*$" nil t)
- (forward-line))
- (point))))
- ((memq encoding '(7bit 8bit binary))
- ;; Do nothing.
- t)
- ((null encoding)
- ;; Do nothing.
- t)
- ((memq encoding '(x-uuencode x-uue))
- (require 'mm-uu)
- (funcall mm-uu-decode-function (point-min) (point-max))
- t)
- ((eq encoding 'x-binhex)
- (require 'mm-uu)
- (funcall mm-uu-binhex-decode-function (point-min) (point-max))
- t)
- ((eq encoding 'x-yenc)
- (require 'mm-uu)
- (funcall mm-uu-yenc-decode-function (point-min) (point-max))
- )
- ((functionp encoding)
- (funcall encoding (point-min) (point-max))
- t)
- (t
- (message "Unknown encoding %s; defaulting to 8bit" encoding)))
- (error
- (message "Error while decoding: %s" error)
- nil))
- (when (and
- type
- (memq encoding '(base64 x-uuencode x-uue x-binhex x-yenc))
- (string-match "\\`text/" type))
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t)))))
-
-(defun mm-decode-body (charset &optional encoding type)
- "Decode the current article that has been encoded with ENCODING to CHARSET.
-ENCODING is a MIME content transfer encoding.
-CHARSET is the MIME charset with which to decode the data after transfer
-decoding. If it is nil, default to `mail-parse-charset'."
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset))
- (save-excursion
- (when encoding
- (mm-decode-content-transfer-encoding encoding type))
- (when (and (featurep 'mule) ;; Fixme: Wrong test for unibyte session.
- (not (eq charset 'gnus-decoded)))
- (let ((coding-system (mm-charset-to-coding-system
- ;; Allow overwrite using
- ;; `mm-charset-override-alist'.
- charset nil t)))
- (if (and (not coding-system)
- (listp mail-parse-ignored-charsets)
- (memq 'gnus-unknown mail-parse-ignored-charsets))
- (setq coding-system
- (mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset coding-system
- ;; buffer-file-coding-system
- ;;Article buffer is nil coding system
- ;;in XEmacs
- (mm-multibyte-p)
- (or (not (eq coding-system 'ascii))
- (setq coding-system mail-parse-charset)))
- (mm-decode-coding-region (point-min) (point-max)
- coding-system))
- (setq buffer-file-coding-system
- (if (boundp 'last-coding-system-used)
- (symbol-value 'last-coding-system-used)
- coding-system))))))
-
-(defun mm-decode-string (string charset)
- "Decode STRING with CHARSET."
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset))
- (or
- (when (featurep 'mule)
- (let ((coding-system (mm-charset-to-coding-system
- charset
- ;; Allow overwrite using
- ;; `mm-charset-override-alist'.
- nil t)))
- (if (and (not coding-system)
- (listp mail-parse-ignored-charsets)
- (memq 'gnus-unknown mail-parse-ignored-charsets))
- (setq coding-system
- (mm-charset-to-coding-system mail-parse-charset)))
- (when (and charset coding-system
- (mm-multibyte-p)
- (or (not (eq coding-system 'ascii))
- (setq coding-system mail-parse-charset)))
- (mm-decode-coding-string string coding-system))))
- string))
-
-(provide 'mm-bodies)
-
-;;; arch-tag: 41104bb6-4443-4ca9-8d5c-ff87ecf27d8d
-;;; mm-bodies.el ends here
+++ /dev/null
-;;; mm-decode.el --- Functions for decoding MIME things
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'mail-parse)
-(require 'mailcap)
-(require 'mm-bodies)
-(eval-when-compile (require 'cl)
- (require 'term))
-
-(eval-and-compile
- (autoload 'executable-find "executable")
- (autoload 'mm-inline-partial "mm-partial")
- (autoload 'mm-inline-external-body "mm-extern")
- (autoload 'mm-extern-cache-contents "mm-extern")
- (autoload 'mm-insert-inline "mm-view"))
-
-(defvar gnus-current-window-configuration)
-
-(add-hook 'gnus-exit-gnus-hook 'mm-destroy-postponed-undisplay-list)
-
-(defgroup mime-display ()
- "Display of MIME in mail and news articles."
- :link '(custom-manual "(emacs-mime)Display Customization")
- :version "21.1"
- :group 'mail
- :group 'news
- :group 'multimedia)
-
-(defgroup mime-security ()
- "MIME security in mail and news articles."
- :link '(custom-manual "(emacs-mime)Display Customization")
- :group 'mail
- :group 'news
- :group 'multimedia)
-
-;;; Convenience macros.
-
-(defmacro mm-handle-buffer (handle)
- `(nth 0 ,handle))
-(defmacro mm-handle-type (handle)
- `(nth 1 ,handle))
-(defsubst mm-handle-media-type (handle)
- (if (stringp (car handle))
- (car handle)
- (car (mm-handle-type handle))))
-(defsubst mm-handle-media-supertype (handle)
- (car (split-string (mm-handle-media-type handle) "/")))
-(defsubst mm-handle-media-subtype (handle)
- (cadr (split-string (mm-handle-media-type handle) "/")))
-(defmacro mm-handle-encoding (handle)
- `(nth 2 ,handle))
-(defmacro mm-handle-undisplayer (handle)
- `(nth 3 ,handle))
-(defmacro mm-handle-set-undisplayer (handle function)
- `(setcar (nthcdr 3 ,handle) ,function))
-(defmacro mm-handle-disposition (handle)
- `(nth 4 ,handle))
-(defmacro mm-handle-description (handle)
- `(nth 5 ,handle))
-(defmacro mm-handle-cache (handle)
- `(nth 6 ,handle))
-(defmacro mm-handle-set-cache (handle contents)
- `(setcar (nthcdr 6 ,handle) ,contents))
-(defmacro mm-handle-id (handle)
- `(nth 7 ,handle))
-(defmacro mm-handle-multipart-original-buffer (handle)
- `(get-text-property 0 'buffer (car ,handle)))
-(defmacro mm-handle-multipart-from (handle)
- `(get-text-property 0 'from (car ,handle)))
-(defmacro mm-handle-multipart-ctl-parameter (handle parameter)
- `(get-text-property 0 ,parameter (car ,handle)))
-
-(defmacro mm-make-handle (&optional buffer type encoding undisplayer
- disposition description cache
- id)
- `(list ,buffer ,type ,encoding ,undisplayer
- ,disposition ,description ,cache ,id))
-
-(defcustom mm-text-html-renderer
- (cond ((locate-library "w3") 'w3)
- ((executable-find "w3m") (if (locate-library "w3m")
- 'w3m
- 'w3m-standalone))
- ((executable-find "links") 'links)
- ((executable-find "lynx") 'lynx)
- (t 'html2text))
- "Render of HTML contents.
-It is one of defined renderer types, or a rendering function.
-The defined renderer types are:
-`w3' : use Emacs/W3;
-`w3m' : use emacs-w3m;
-`w3m-standalone': use w3m;
-`links': use links;
-`lynx' : use lynx;
-`html2text' : use html2text;
-nil : use external viewer."
- :version "22.1"
- :type '(choice (const w3)
- (const w3m)
- (const w3m-standalone)
- (const links)
- (const lynx)
- (const html2text)
- (const nil)
- (function))
- :group 'mime-display)
-
-(defvar mm-inline-text-html-renderer nil
- "Function used for rendering inline HTML contents.
-It is suggested to customize `mm-text-html-renderer' instead.")
-
-(defcustom mm-inline-text-html-with-images nil
- "If non-nil, Gnus will allow retrieving images in HTML contents with
-the <img> tags. It has no effect on Emacs/w3. See also the
-documentation for the `mm-w3m-safe-url-regexp' variable."
- :version "22.1"
- :type 'boolean
- :group 'mime-display)
-
-(defcustom mm-w3m-safe-url-regexp "\\`cid:"
- "Regexp matching URLs which are considered to be safe.
-Some HTML mails might contain a nasty trick used by spammers, using
-the <img> tag which is far more evil than the [Click Here!] button.
-It is most likely intended to check whether the ominous spam mail has
-reached your eyes or not, in which case the spammer knows for sure
-that your email address is valid. It is done by embedding an
-identifier string into a URL that you might automatically retrieve
-when displaying the image. The default value is \"\\\\`cid:\" which only
-matches parts embedded to the Multipart/Related type MIME contents and
-Gnus will never connect to the spammer's site arbitrarily. You may
-set this variable to nil if you consider all urls to be safe."
- :version "22.1"
- :type '(choice (regexp :tag "Regexp")
- (const :tag "All URLs are safe" nil))
- :group 'mime-display)
-
-(defcustom mm-inline-text-html-with-w3m-keymap t
- "If non-nil, use emacs-w3m command keys in the article buffer."
- :version "22.1"
- :type 'boolean
- :group 'mime-display)
-
-(defcustom mm-enable-external t
- "Indicate whether external MIME handlers should be used.
-
-If t, all defined external MIME handlers are used. If nil, files are saved by
-`mailcap-save-binary-file'. If it is the symbol `ask', you are prompted
-before the external MIME handler is invoked."
- :version "22.1"
- :type '(choice (const :tag "Always" t)
- (const :tag "Never" nil)
- (const :tag "Ask" ask))
- :group 'mime-display)
-
-(defcustom mm-inline-media-tests
- '(("image/p?jpeg"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'jpeg handle)))
- ("image/png"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'png handle)))
- ("image/gif"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'gif handle)))
- ("image/tiff"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'tiff handle)) )
- ("image/xbm"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'xbm handle)))
- ("image/x-xbitmap"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'xbm handle)))
- ("image/xpm"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'xpm handle)))
- ("image/x-xpixmap"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'xpm handle)))
- ("image/bmp"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'bmp handle)))
- ("image/x-portable-bitmap"
- mm-inline-image
- (lambda (handle)
- (mm-valid-and-fit-image-p 'pbm handle)))
- ("text/plain" mm-inline-text identity)
- ("text/enriched" mm-inline-text identity)
- ("text/richtext" mm-inline-text identity)
- ("text/x-patch" mm-display-patch-inline
- (lambda (handle)
- ;; If the diff-mode.el package is installed, the function is
- ;; autoloaded. Checking (locate-library "diff-mode") would be trying
- ;; to cater to broken installations. OTOH checking the function
- ;; makes it possible to install another package which provides an
- ;; alternative implementation of diff-mode. --Stef
- (fboundp 'diff-mode)))
- ("application/emacs-lisp" mm-display-elisp-inline identity)
- ("application/x-emacs-lisp" mm-display-elisp-inline identity)
- ("text/html"
- mm-inline-text-html
- (lambda (handle)
- (or mm-inline-text-html-renderer
- mm-text-html-renderer)))
- ("text/x-vcard"
- mm-inline-text-vcard
- (lambda (handle)
- (or (featurep 'vcard)
- (locate-library "vcard"))))
- ("message/delivery-status" mm-inline-text identity)
- ("message/rfc822" mm-inline-message identity)
- ("message/partial" mm-inline-partial identity)
- ("message/external-body" mm-inline-external-body identity)
- ("text/.*" mm-inline-text identity)
- ("audio/wav" mm-inline-audio
- (lambda (handle)
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
- (device-sound-enabled-p))))
- ("audio/au"
- mm-inline-audio
- (lambda (handle)
- (and (or (featurep 'nas-sound) (featurep 'native-sound))
- (device-sound-enabled-p))))
- ("application/pgp-signature" ignore identity)
- ("application/x-pkcs7-signature" ignore identity)
- ("application/pkcs7-signature" ignore identity)
- ("application/x-pkcs7-mime" ignore identity)
- ("application/pkcs7-mime" ignore identity)
- ("multipart/alternative" ignore identity)
- ("multipart/mixed" ignore identity)
- ("multipart/related" ignore identity)
- ;; Disable audio and image
- ("audio/.*" ignore ignore)
- ("image/.*" ignore ignore)
- ;; Default to displaying as text
- (".*" mm-inline-text mm-readable-p))
- "Alist of media types/tests saying whether types can be displayed inline."
- :type '(repeat (list (regexp :tag "MIME type")
- (function :tag "Display function")
- (function :tag "Display test")))
- :group 'mime-display)
-
-(defcustom mm-inlined-types
- '("image/.*" "text/.*" "message/delivery-status" "message/rfc822"
- "message/partial" "message/external-body" "application/emacs-lisp"
- "application/x-emacs-lisp"
- "application/pgp-signature" "application/x-pkcs7-signature"
- "application/pkcs7-signature" "application/x-pkcs7-mime"
- "application/pkcs7-mime"
- ;; Mutt still uses this even though it has already been withdrawn.
- "application/pgp")
- "List of media types that are to be displayed inline.
-See also `mm-inline-media-tests', which says how to display a media
-type inline."
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-keep-viewer-alive-types
- '("application/postscript" "application/msword" "application/vnd.ms-excel"
- "application/pdf" "application/x-dvi")
- "List of media types for which the external viewer will not be killed
-when selecting a different article."
- :version "22.1"
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-automatic-display
- '("text/plain" "text/enriched" "text/richtext" "text/html"
- "text/x-vcard" "image/.*" "message/delivery-status" "multipart/.*"
- "message/rfc822" "text/x-patch" "application/pgp-signature"
- "application/emacs-lisp" "application/x-emacs-lisp"
- "application/x-pkcs7-signature"
- "application/pkcs7-signature" "application/x-pkcs7-mime"
- "application/pkcs7-mime"
- ;; Mutt still uses this even though it has already been withdrawn.
- "application/pgp\\'")
- "A list of MIME types to be displayed automatically."
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-attachment-override-types '("text/x-vcard"
- "application/pkcs7-mime"
- "application/x-pkcs7-mime"
- "application/pkcs7-signature"
- "application/x-pkcs7-signature")
- "Types to have \"attachment\" ignored if they can be displayed inline."
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-inline-override-types nil
- "Types to be treated as attachments even if they can be displayed inline."
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-automatic-external-display nil
- "List of MIME type regexps that will be displayed externally automatically."
- :type '(repeat regexp)
- :group 'mime-display)
-
-(defcustom mm-discouraged-alternatives nil
- "List of MIME types that are discouraged when viewing multipart/alternative.
-Viewing agents are supposed to view the last possible part of a message,
-as that is supposed to be the richest. However, users may prefer other
-types instead, and this list says what types are most unwanted. If,
-for instance, text/html parts are very unwanted, and text/richtext are
-somewhat unwanted, then the value of this variable should be set
-to:
-
- (\"text/html\" \"text/richtext\")
-
-Adding \"image/.*\" might also be useful. Spammers use it as the
-prefered part of multipart/alternative messages. See also
-`gnus-buttonized-mime-types', to which adding \"multipart/alternative\"
-enables you to choose manually one of two types those mails include."
- :type '(repeat regexp) ;; See `mm-preferred-alternative-precedence'.
- :group 'mime-display)
-
-(defcustom mm-tmp-directory
- (if (fboundp 'temp-directory)
- (temp-directory)
- (if (boundp 'temporary-file-directory)
- temporary-file-directory
- "/tmp/"))
- "Where mm will store its temporary files."
- :type 'directory
- :group 'mime-display)
-
-(defcustom mm-inline-large-images nil
- "If non-nil, then all images fit in the buffer."
- :type 'boolean
- :group 'mime-display)
-
-(defvar mm-file-name-rewrite-functions
- '(mm-file-name-delete-control mm-file-name-delete-gotchas)
- "*List of functions used for rewriting file names of MIME parts.
-Each function takes a file name as input and returns a file name.
-
-Ready-made functions include
-`mm-file-name-delete-control'
-`mm-file-name-delete-gotchas'
-`mm-file-name-delete-whitespace',
-`mm-file-name-trim-whitespace',
-`mm-file-name-collapse-whitespace',
-`mm-file-name-replace-whitespace',
-`capitalize', `downcase', `upcase', and
-`upcase-initials'.")
-
-(defvar mm-path-name-rewrite-functions nil
- "*List of functions for rewriting the full file names of MIME parts.
-This is used when viewing parts externally, and is meant for
-transforming the absolute name so that non-compliant programs can find
-the file where it's saved.
-
-Each function takes a file name as input and returns a file name.")
-
-(defvar mm-file-name-replace-whitespace nil
- "String used for replacing whitespace characters; default is `\"_\"'.")
-
-(defcustom mm-default-directory nil
- "The default directory where mm will save files.
-If not set, `default-directory' will be used."
- :type '(choice directory (const :tag "Default" nil))
- :group 'mime-display)
-
-(defcustom mm-attachment-file-modes 384
- "Set the mode bits of saved attachments to this integer."
- :version "22.1"
- :type 'integer
- :group 'mime-display)
-
-(defcustom mm-external-terminal-program "xterm"
- "The program to start an external terminal."
- :version "22.1"
- :type 'string
- :group 'mime-display)
-
-;;; Internal variables.
-
-(defvar mm-last-shell-command "")
-(defvar mm-content-id-alist nil)
-(defvar mm-postponed-undisplay-list nil)
-
-;; According to RFC2046, in particular, in a digest, the default
-;; Content-Type value for a body part is changed from "text/plain" to
-;; "message/rfc822".
-(defvar mm-dissect-default-type "text/plain")
-
-(autoload 'mml2015-verify "mml2015")
-(autoload 'mml2015-verify-test "mml2015")
-(autoload 'mml-smime-verify "mml-smime")
-(autoload 'mml-smime-verify-test "mml-smime")
-
-(defvar mm-verify-function-alist
- '(("application/pgp-signature" mml2015-verify "PGP" mml2015-verify-test)
- ("application/x-gnus-pgp-signature" mm-uu-pgp-signed-extract-1 "PGP"
- mm-uu-pgp-signed-test)
- ("application/pkcs7-signature" mml-smime-verify "S/MIME"
- mml-smime-verify-test)
- ("application/x-pkcs7-signature" mml-smime-verify "S/MIME"
- mml-smime-verify-test)))
-
-(defcustom mm-verify-option 'never
- "Option of verifying signed parts.
-`never', not verify; `always', always verify;
-`known', only verify known protocols. Otherwise, ask user."
- :version "22.1"
- :type '(choice (item always)
- (item never)
- (item :tag "only known protocols" known)
- (item :tag "ask" nil))
- :group 'mime-security)
-
-(autoload 'mml2015-decrypt "mml2015")
-(autoload 'mml2015-decrypt-test "mml2015")
-
-(defvar mm-decrypt-function-alist
- '(("application/pgp-encrypted" mml2015-decrypt "PGP" mml2015-decrypt-test)
- ("application/x-gnus-pgp-encrypted" mm-uu-pgp-encrypted-extract-1 "PGP"
- mm-uu-pgp-encrypted-test)))
-
-(defcustom mm-decrypt-option nil
- "Option of decrypting encrypted parts.
-`never', not decrypt; `always', always decrypt;
-`known', only decrypt known protocols. Otherwise, ask user."
- :version "22.1"
- :type '(choice (item always)
- (item never)
- (item :tag "only known protocols" known)
- (item :tag "ask" nil))
- :group 'mime-security)
-
-(defvar mm-viewer-completion-map
- (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
- (set-keymap-parent map minibuffer-local-completion-map)
- ;; Should we bind other key to minibuffer-complete-word?
- (define-key map " " 'self-insert-command)
- map)
- "Keymap for input viewer with completion.")
-
-(defvar mm-viewer-completion-map
- (let ((map (make-sparse-keymap 'mm-viewer-completion-map)))
- (set-keymap-parent map minibuffer-local-completion-map)
- ;; Should we bind other key to minibuffer-complete-word?
- (define-key map " " 'self-insert-command)
- map)
- "Keymap for input viewer with completion.")
-
-;;; The functions.
-
-(defun mm-alist-to-plist (alist)
- "Convert association list ALIST into the equivalent property-list form.
-The plist is returned. This converts from
-
-\((a . 1) (b . 2) (c . 3))
-
-into
-
-\(a 1 b 2 c 3)
-
-The original alist is not modified. See also `destructive-alist-to-plist'."
- (let (plist)
- (while alist
- (let ((el (car alist)))
- (setq plist (cons (cdr el) (cons (car el) plist))))
- (setq alist (cdr alist)))
- (nreverse plist)))
-
-(defun mm-keep-viewer-alive-p (handle)
- "Say whether external viewer for HANDLE should stay alive."
- (let ((types mm-keep-viewer-alive-types)
- (type (mm-handle-media-type handle))
- ty)
- (catch 'found
- (while (setq ty (pop types))
- (when (string-match ty type)
- (throw 'found t))))))
-
-(defun mm-handle-set-external-undisplayer (handle function)
- "Set the undisplayer for HANDLE to FUNCTION.
-Postpone undisplaying of viewers for types in
-`mm-keep-viewer-alive-types'."
- (if (mm-keep-viewer-alive-p handle)
- (let ((new-handle (copy-sequence handle)))
- (mm-handle-set-undisplayer new-handle function)
- (mm-handle-set-undisplayer handle nil)
- (push new-handle mm-postponed-undisplay-list))
- (mm-handle-set-undisplayer handle function)))
-
-(defun mm-destroy-postponed-undisplay-list ()
- (when mm-postponed-undisplay-list
- (message "Destroying external MIME viewers")
- (mm-destroy-parts mm-postponed-undisplay-list)))
-
-(defun mm-dissect-buffer (&optional no-strict-mime loose-mime from)
- "Dissect the current buffer and return a list of MIME handles."
- (save-excursion
- (let (ct ctl type subtype cte cd description id result)
- (save-restriction
- (mail-narrow-to-head)
- (when (or no-strict-mime
- loose-mime
- (mail-fetch-field "mime-version"))
- (setq ct (mail-fetch-field "content-type")
- ctl (and ct (mail-header-parse-content-type ct))
- cte (mail-fetch-field "content-transfer-encoding")
- cd (mail-fetch-field "content-disposition")
- description (mail-fetch-field "content-description")
- id (mail-fetch-field "content-id"))
- (unless from
- (setq from (mail-fetch-field "from")))
- ;; FIXME: In some circumstances, this code is running within
- ;; an unibyte macro. mail-extract-address-components
- ;; creates unibyte buffers. This `if', though not a perfect
- ;; solution, avoids most of them.
- (if from
- (setq from (cadr (mail-extract-address-components from))))))
- (when cte
- (setq cte (mail-header-strip cte)))
- (if (or (not ctl)
- (not (string-match "/" (car ctl))))
- (mm-dissect-singlepart
- (list mm-dissect-default-type)
- (and cte (intern (downcase (mail-header-remove-whitespace
- (mail-header-remove-comments
- cte)))))
- no-strict-mime
- (and cd (mail-header-parse-content-disposition cd))
- description)
- (setq type (split-string (car ctl) "/"))
- (setq subtype (cadr type)
- type (car type))
- (setq
- result
- (cond
- ((equal type "multipart")
- (let ((mm-dissect-default-type (if (equal subtype "digest")
- "message/rfc822"
- "text/plain"))
- (start (cdr (assq 'start (cdr ctl)))))
- (add-text-properties 0 (length (car ctl))
- (mm-alist-to-plist (cdr ctl)) (car ctl))
-
- ;; what really needs to be done here is a way to link a
- ;; MIME handle back to it's parent MIME handle (in a multilevel
- ;; MIME article). That would probably require changing
- ;; the mm-handle API so we simply store the multipart buffer
- ;; name as a text property of the "multipart/whatever" string.
- (add-text-properties 0 (length (car ctl))
- (list 'buffer (mm-copy-to-buffer)
- 'from from
- 'start start)
- (car ctl))
- (cons (car ctl) (mm-dissect-multipart ctl from))))
- (t
- (mm-possibly-verify-or-decrypt
- (mm-dissect-singlepart
- ctl
- (and cte (intern (downcase (mail-header-remove-whitespace
- (mail-header-remove-comments
- cte)))))
- no-strict-mime
- (and cd (mail-header-parse-content-disposition cd))
- description id)
- ctl))))
- (when id
- (when (string-match " *<\\(.*\\)> *" id)
- (setq id (match-string 1 id)))
- (push (cons id result) mm-content-id-alist))
- result))))
-
-(defun mm-dissect-singlepart (ctl cte &optional force cdl description id)
- (when (or force
- (if (equal "text/plain" (car ctl))
- (assoc 'format ctl)
- t))
- (mm-make-handle
- (mm-copy-to-buffer) ctl cte nil cdl description nil id)))
-
-(defun mm-dissect-multipart (ctl from)
- (goto-char (point-min))
- (let* ((boundary (concat "\n--" (mail-content-type-get ctl 'boundary)))
- (close-delimiter (concat (regexp-quote boundary) "--[ \t]*$"))
- start parts
- (end (save-excursion
- (goto-char (point-max))
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- (point-max)))))
- (setq boundary (concat (regexp-quote boundary) "[ \t]*$"))
- (while (and (< (point) end) (re-search-forward boundary end t))
- (goto-char (match-beginning 0))
- (when start
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
- (end-of-line 2)
- (or (looking-at boundary)
- (forward-line 1))
- (setq start (point)))
- (when (and start (< start end))
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (setq parts (nconc (list (mm-dissect-buffer t nil from)) parts)))))
- (mm-possibly-verify-or-decrypt (nreverse parts) ctl)))
-
-(defun mm-copy-to-buffer ()
- "Copy the contents of the current buffer to a fresh buffer."
- (let ((obuf (current-buffer))
- beg)
- (goto-char (point-min))
- (search-forward-regexp "^\n" nil t)
- (setq beg (point))
- (with-current-buffer
- ;; Preserve the data's unibyteness (for url-insert-file-contents).
- (let ((default-enable-multibyte-characters (mm-multibyte-p)))
- (generate-new-buffer " *mm*"))
- (insert-buffer-substring obuf beg)
- (current-buffer))))
-
-(defun mm-display-parts (handle &optional no-default)
- (if (stringp (car handle))
- (mapcar 'mm-display-parts (cdr handle))
- (if (bufferp (car handle))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-display-part handle)
- (goto-char (point-max)))
- (mapcar 'mm-display-parts handle))))
-
-(defun mm-display-part (handle &optional no-default)
- "Display the MIME part represented by HANDLE.
-Returns nil if the part is removed; inline if displayed inline;
-external if displayed external."
- (save-excursion
- (mailcap-parse-mailcaps)
- (if (mm-handle-displayed-p handle)
- (mm-remove-part handle)
- (let* ((ehandle (if (equal (mm-handle-media-type handle)
- "message/external-body")
- (progn
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (mm-handle-cache handle))
- handle))
- (type (mm-handle-media-type ehandle))
- (method (mailcap-mime-info type))
- (filename (or (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)
- "<file>"))
- (external mm-enable-external))
- (if (and (mm-inlinable-p ehandle)
- (mm-inlined-p ehandle))
- (progn
- (forward-line 1)
- (mm-display-inline handle)
- 'inline)
- (when (or method
- (not no-default))
- (if (and (not method)
- (equal "text" (car (split-string type "/"))))
- (progn
- (forward-line 1)
- (mm-insert-inline handle (mm-get-part handle))
- 'inline)
- (setq external
- (and method ;; If nil, we always use "save".
- (stringp method) ;; 'mailcap-save-binary-file
- (or (eq mm-enable-external t)
- (and (eq mm-enable-external 'ask)
- (y-or-n-p
- (concat
- "Display part (" type
- ") using external program"
- ;; Can non-string method ever happen?
- (if (stringp method)
- (concat
- " \"" (format method filename) "\"")
- "")
- "? "))))))
- (if external
- (mm-display-external
- handle (or method 'mailcap-save-binary-file))
- (mm-display-external
- handle 'mailcap-save-binary-file)))))))))
-
-(defun mm-display-external (handle method)
- "Display HANDLE using METHOD."
- (let ((outbuf (current-buffer)))
- (mm-with-unibyte-buffer
- (if (functionp method)
- (let ((cur (current-buffer)))
- (if (eq method 'mailcap-save-binary-file)
- (progn
- (set-buffer (generate-new-buffer " *mm*"))
- (setq method nil))
- (mm-insert-part handle)
- (let ((win (get-buffer-window cur t)))
- (when win
- (select-window win)))
- (switch-to-buffer (generate-new-buffer " *mm*")))
- (buffer-disable-undo)
- (mm-set-buffer-file-coding-system mm-binary-coding-system)
- (insert-buffer-substring cur)
- (goto-char (point-min))
- (when method
- (message "Viewing with %s" method))
- (let ((mm (current-buffer))
- (non-viewer (assq 'non-viewer
- (mailcap-mime-info
- (mm-handle-media-type handle) t))))
- (unwind-protect
- (if method
- (funcall method)
- (mm-save-part handle))
- (when (and (not non-viewer)
- method)
- (mm-handle-set-undisplayer handle mm)))))
- ;; The function is a string to be executed.
- (mm-insert-part handle)
- (let* ((dir (mm-make-temp-file
- (expand-file-name "emm." mm-tmp-directory) 'dir))
- (filename (or
- (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)))
- (mime-info (mailcap-mime-info
- (mm-handle-media-type handle) t))
- (needsterm (or (assoc "needsterm" mime-info)
- (assoc "needsterminal" mime-info)))
- (copiousoutput (assoc "copiousoutput" mime-info))
- file buffer)
- ;; We create a private sub-directory where we store our files.
- (set-file-modes dir 448)
- (if filename
- (setq file (expand-file-name
- (gnus-map-function mm-file-name-rewrite-functions
- (file-name-nondirectory filename))
- dir))
- ;; Use nametemplate (defined in RFC1524) if it is specified
- ;; in mailcap.
- (let ((suffix (cdr (assoc "nametemplate" mime-info))))
- (if (and suffix
- (string-match "\\`%s\\(\\..+\\)\\'" suffix))
- (setq suffix (match-string 1 suffix))
- ;; Otherwise, use a suffix according to
- ;; `mailcap-mime-extensions'.
- (setq suffix (car (rassoc (mm-handle-media-type handle)
- mailcap-mime-extensions))))
- (setq file (mm-make-temp-file (expand-file-name "mm." dir)
- nil suffix))))
- (let ((coding-system-for-write mm-binary-coding-system))
- (write-region (point-min) (point-max) file nil 'nomesg))
- (message "Viewing with %s" method)
- (cond
- (needsterm
- (let ((command (mm-mailcap-command
- method file (mm-handle-type handle))))
- (unwind-protect
- (if window-system
- (start-process "*display*" nil
- mm-external-terminal-program
- "-e" shell-file-name
- shell-command-switch command)
- (require 'term)
- (require 'gnus-win)
- (set-buffer
- (setq buffer
- (make-term "display"
- shell-file-name
- nil
- shell-command-switch command)))
- (term-mode)
- (term-char-mode)
- (set-process-sentinel
- (get-buffer-process buffer)
- `(lambda (process state)
- (if (eq 'exit (process-status process))
- (gnus-configure-windows
- ',gnus-current-window-configuration))))
- (gnus-configure-windows 'display-term))
- (mm-handle-set-external-undisplayer handle (cons file buffer)))
- (message "Displaying %s..." command))
- 'external)
- (copiousoutput
- (with-current-buffer outbuf
- (forward-line 1)
- (mm-insert-inline
- handle
- (unwind-protect
- (progn
- (call-process shell-file-name nil
- (setq buffer
- (generate-new-buffer " *mm*"))
- nil
- shell-command-switch
- (mm-mailcap-command
- method file (mm-handle-type handle)))
- (if (buffer-live-p buffer)
- (with-current-buffer buffer
- (buffer-string))))
- (progn
- (ignore-errors (delete-file file))
- (ignore-errors (delete-directory
- (file-name-directory file)))
- (ignore-errors (kill-buffer buffer))))))
- 'inline)
- (t
- ;; Deleting the temp file should be postponed for some wrappers,
- ;; shell scripts, and so on, which might exit right after having
- ;; started a viewer command as a background job.
- (let ((command (mm-mailcap-command
- method file (mm-handle-type handle))))
- (unwind-protect
- (progn
- (start-process "*display*"
- (setq buffer
- (generate-new-buffer " *mm*"))
- shell-file-name
- shell-command-switch command)
- (set-process-sentinel
- (get-buffer-process buffer)
- (lexical-let ;; Don't use `let'.
- ;; Function used to remove temp file and directory.
- ((fn `(lambda nil
- ;; Don't use `ignore-errors'.
- (condition-case nil
- (delete-file ,file)
- (error))
- (condition-case nil
- (delete-directory
- ,(file-name-directory file))
- (error))))
- ;; Form uses to kill the process buffer and
- ;; remove the undisplayer.
- (fm `(progn
- (kill-buffer ,buffer)
- ,(macroexpand
- (list 'mm-handle-set-undisplayer
- (list 'quote handle)
- nil))))
- ;; Message to be issued when the process exits.
- (done (format "Displaying %s...done" command))
- ;; In particular, the timer object (which is
- ;; a vector in Emacs but is a list in XEmacs)
- ;; requires that it is lexically scoped.
- (timer (run-at-time 2.0 nil 'ignore)))
- (if (boundp 'itimer-list)
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer itimer-list)
- (set-itimer-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))
- (lambda (process state)
- (when (eq 'exit (process-status process))
- (if (memq timer timer-list)
- (timer-set-function timer fn)
- (funcall fn))
- (ignore-errors (eval fm))
- (message "%s" done)))))))
- (mm-handle-set-external-undisplayer
- handle (cons file buffer)))
- (message "Displaying %s..." command))
- 'external)))))))
-
-(defun mm-mailcap-command (method file type-list)
- (let ((ctl (cdr type-list))
- (beg 0)
- (uses-stdin t)
- out sub total)
- (while (string-match "%{\\([^}]+\\)}\\|'%s'\\|\"%s\"\\|%s\\|%t\\|%%"
- method beg)
- (push (substring method beg (match-beginning 0)) out)
- (setq beg (match-end 0)
- total (match-string 0 method)
- sub (match-string 1 method))
- (cond
- ((string= total "%%")
- (push "%" out))
- ((or (string= total "%s")
- ;; We do our own quoting.
- (string= total "'%s'")
- (string= total "\"%s\""))
- (setq uses-stdin nil)
- (push (mm-quote-arg
- (gnus-map-function mm-path-name-rewrite-functions file)) out))
- ((string= total "%t")
- (push (mm-quote-arg (car type-list)) out))
- (t
- (push (mm-quote-arg (or (cdr (assq (intern sub) ctl)) "")) out))))
- (push (substring method beg (length method)) out)
- (when uses-stdin
- (push "<" out)
- (push (mm-quote-arg
- (gnus-map-function mm-path-name-rewrite-functions file))
- out))
- (mapconcat 'identity (nreverse out) "")))
-
-(defun mm-remove-parts (handles)
- "Remove the displayed MIME parts represented by HANDLES."
- (if (and (listp handles)
- (bufferp (car handles)))
- (mm-remove-part handles)
- (let (handle)
- (while (setq handle (pop handles))
- (cond
- ((stringp handle)
- (when (buffer-live-p (get-text-property 0 'buffer handle))
- (kill-buffer (get-text-property 0 'buffer handle))))
- ((and (listp handle)
- (stringp (car handle)))
- (mm-remove-parts (cdr handle)))
- (t
- (mm-remove-part handle)))))))
-
-(defun mm-destroy-parts (handles)
- "Remove the displayed MIME parts represented by HANDLES."
- (if (and (listp handles)
- (bufferp (car handles)))
- (mm-destroy-part handles)
- (let (handle)
- (while (setq handle (pop handles))
- (cond
- ((stringp handle)
- (when (buffer-live-p (get-text-property 0 'buffer handle))
- (kill-buffer (get-text-property 0 'buffer handle))))
- ((and (listp handle)
- (stringp (car handle)))
- (mm-destroy-parts handle))
- (t
- (mm-destroy-part handle)))))))
-
-(defun mm-remove-part (handle)
- "Remove the displayed MIME part represented by HANDLE."
- (when (listp handle)
- (let ((object (mm-handle-undisplayer handle)))
- (ignore-errors
- (cond
- ;; Internally displayed part.
- ((mm-annotationp object)
- (delete-annotation object))
- ((or (functionp object)
- (and (listp object)
- (eq (car object) 'lambda)))
- (funcall object))
- ;; Externally displayed part.
- ((consp object)
- (condition-case ()
- (while (get-buffer-process (cdr object))
- (interrupt-process (get-buffer-process (cdr object)))
- (message "Waiting for external displayer to die...")
- (sit-for 1))
- (quit)
- (error))
- (ignore-errors (and (cdr object) (kill-buffer (cdr object))))
- (message "Waiting for external displayer to die...done")
- (ignore-errors (delete-file (car object)))
- (ignore-errors (delete-directory (file-name-directory
- (car object)))))
- ((bufferp object)
- (when (buffer-live-p object)
- (kill-buffer object)))))
- (mm-handle-set-undisplayer handle nil))))
-
-(defun mm-display-inline (handle)
- (let* ((type (mm-handle-media-type handle))
- (function (cadr (mm-assoc-string-match mm-inline-media-tests type))))
- (funcall function handle)
- (goto-char (point-min))))
-
-(defun mm-assoc-string-match (alist type)
- (dolist (elem alist)
- (when (string-match (car elem) type)
- (return elem))))
-
-(defun mm-automatic-display-p (handle)
- "Say whether the user wants HANDLE to be displayed automatically."
- (let ((methods mm-automatic-display)
- (type (mm-handle-media-type handle))
- method result)
- (while (setq method (pop methods))
- (when (and (not (mm-inline-override-p handle))
- (string-match method type))
- (setq result t
- methods nil)))
- result))
-
-(defun mm-inlinable-p (handle &optional type)
- "Say whether HANDLE can be displayed inline.
-TYPE is the mime-type of the object; it defaults to the one given
-in HANDLE."
- (unless type (setq type (mm-handle-media-type handle)))
- (let ((alist mm-inline-media-tests)
- test)
- (while alist
- (when (string-match (caar alist) type)
- (setq test (caddar alist)
- alist nil)
- (setq test (funcall test handle)))
- (pop alist))
- test))
-
-(defun mm-inlined-p (handle)
- "Say whether the user wants HANDLE to be displayed inline."
- (let ((methods mm-inlined-types)
- (type (mm-handle-media-type handle))
- method result)
- (while (setq method (pop methods))
- (when (and (not (mm-inline-override-p handle))
- (string-match method type))
- (setq result t
- methods nil)))
- result))
-
-(defun mm-attachment-override-p (handle)
- "Say whether HANDLE should have attachment behavior overridden."
- (let ((types mm-attachment-override-types)
- (type (mm-handle-media-type handle))
- ty)
- (catch 'found
- (while (setq ty (pop types))
- (when (and (string-match ty type)
- (mm-inlinable-p handle))
- (throw 'found t))))))
-
-(defun mm-inline-override-p (handle)
- "Say whether HANDLE should have inline behavior overridden."
- (let ((types mm-inline-override-types)
- (type (mm-handle-media-type handle))
- ty)
- (catch 'found
- (while (setq ty (pop types))
- (when (string-match ty type)
- (throw 'found t))))))
-
-(defun mm-automatic-external-display-p (type)
- "Return the user-defined method for TYPE."
- (let ((methods mm-automatic-external-display)
- method result)
- (while (setq method (pop methods))
- (when (string-match method type)
- (setq result t
- methods nil)))
- result))
-
-(defun mm-destroy-part (handle)
- "Destroy the data structures connected to HANDLE."
- (when (listp handle)
- (mm-remove-part handle)
- (when (buffer-live-p (mm-handle-buffer handle))
- (kill-buffer (mm-handle-buffer handle)))))
-
-(defun mm-handle-displayed-p (handle)
- "Say whether HANDLE is displayed or not."
- (mm-handle-undisplayer handle))
-
-;;;
-;;; Functions for outputting parts
-;;;
-
-(defmacro mm-with-part (handle &rest forms)
- "Run FORMS in the temp buffer containing the contents of HANDLE."
- `(let* ((handle ,handle)
- ;; The multibyteness of the temp buffer should be turned on
- ;; if inserting a multibyte string. Contrarily, the buffer's
- ;; multibyteness should be off if inserting a unibyte string,
- ;; especially if a string contains 8bit data.
- (default-enable-multibyte-characters
- (with-current-buffer (mm-handle-buffer handle)
- (mm-multibyte-p))))
- (with-temp-buffer
- (insert-buffer-substring (mm-handle-buffer handle))
- (mm-disable-multibyte)
- (mm-decode-content-transfer-encoding
- (mm-handle-encoding handle)
- (mm-handle-media-type handle))
- ,@forms)))
-(put 'mm-with-part 'lisp-indent-function 1)
-(put 'mm-with-part 'edebug-form-spec '(body))
-
-(defun mm-get-part (handle &optional no-cache)
- "Return the contents of HANDLE as a string.
-If NO-CACHE is non-nil, cached contents of a message/external-body part
-are ignored."
- (if (and (not no-cache)
- (equal (mm-handle-media-type handle) "message/external-body"))
- (progn
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (with-current-buffer (mm-handle-buffer (mm-handle-cache handle))
- (buffer-string)))
- (mm-with-part handle
- (buffer-string))))
-
-(defun mm-insert-part (handle &optional no-cache)
- "Insert the contents of HANDLE in the current buffer.
-If NO-CACHE is non-nil, cached contents of a message/external-body part
-are ignored."
- (save-excursion
- (insert
- (cond ((eq (mail-content-type-get (mm-handle-type handle) 'charset)
- 'gnus-decoded)
- (with-current-buffer (mm-handle-buffer handle)
- (buffer-string)))
- ((mm-multibyte-p)
- (mm-string-to-multibyte (mm-get-part handle no-cache)))
- (t
- (mm-get-part handle no-cache))))))
-
-(defun mm-file-name-delete-whitespace (file-name)
- "Remove all whitespace characters from FILE-NAME."
- (while (string-match "\\s-+" file-name)
- (setq file-name (replace-match "" t t file-name)))
- file-name)
-
-(defun mm-file-name-trim-whitespace (file-name)
- "Remove leading and trailing whitespace characters from FILE-NAME."
- (when (string-match "\\`\\s-+" file-name)
- (setq file-name (substring file-name (match-end 0))))
- (when (string-match "\\s-+\\'" file-name)
- (setq file-name (substring file-name 0 (match-beginning 0))))
- file-name)
-
-(defun mm-file-name-collapse-whitespace (file-name)
- "Collapse multiple whitespace characters in FILE-NAME."
- (while (string-match "\\s-\\s-+" file-name)
- (setq file-name (replace-match " " t t file-name)))
- file-name)
-
-(defun mm-file-name-replace-whitespace (file-name)
- "Replace whitespace characters in FILE-NAME with underscores.
-Set the option `mm-file-name-replace-whitespace' to any other
-string if you do not like underscores."
- (let ((s (or mm-file-name-replace-whitespace "_")))
- (while (string-match "\\s-" file-name)
- (setq file-name (replace-match s t t file-name))))
- file-name)
-
-(defun mm-file-name-delete-control (filename)
- "Delete control characters from FILENAME."
- (gnus-replace-in-string filename "[\x00-\x1f\x7f]" ""))
-
-(defun mm-file-name-delete-gotchas (filename)
- "Delete shell gotchas from FILENAME."
- (setq filename (gnus-replace-in-string filename "[<>|]" ""))
- (gnus-replace-in-string filename "^[.-]+" ""))
-
-(defun mm-save-part (handle)
- "Write HANDLE to a file."
- (let ((filename (or (mail-content-type-get
- (mm-handle-disposition handle) 'filename)
- (mail-content-type-get
- (mm-handle-type handle) 'name)))
- file)
- (when filename
- (setq filename (gnus-map-function mm-file-name-rewrite-functions
- (file-name-nondirectory filename))))
- (setq file
- (mm-with-multibyte
- (read-file-name "Save MIME part to: "
- (or mm-default-directory default-directory)
- nil nil (or filename ""))))
- (setq mm-default-directory (file-name-directory file))
- (and (or (not (file-exists-p file))
- (yes-or-no-p (format "File %s already exists; overwrite? "
- file)))
- (progn
- (mm-save-part-to-file handle file)
- file))))
-
-(defun mm-save-part-to-file (handle file)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (let ((coding-system-for-write 'binary)
- (current-file-modes (default-file-modes))
- ;; Don't re-compress .gz & al. Arguably we should make
- ;; `file-name-handler-alist' nil, but that would chop
- ;; ange-ftp, which is reasonable to use here.
- (inhibit-file-name-operation 'write-region)
- (inhibit-file-name-handlers
- (cons 'jka-compr-handler inhibit-file-name-handlers)))
- (set-default-file-modes mm-attachment-file-modes)
- (unwind-protect
- (write-region (point-min) (point-max) file)
- (set-default-file-modes current-file-modes)))))
-
-(defun mm-pipe-part (handle)
- "Pipe HANDLE to a process."
- (let* ((name (mail-content-type-get (mm-handle-type handle) 'name))
- (command
- (read-string "Shell command on MIME part: " mm-last-shell-command)))
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (let ((coding-system-for-write 'binary))
- (shell-command-on-region (point-min) (point-max) command nil)))))
-
-(defun mm-interactively-view-part (handle)
- "Display HANDLE using METHOD."
- (let* ((type (mm-handle-media-type handle))
- (methods
- (mapcar (lambda (i) (list (cdr (assoc 'viewer i))))
- (mailcap-mime-info type 'all)))
- (method (let ((minibuffer-local-completion-map
- mm-viewer-completion-map))
- (completing-read "Viewer: " methods))))
- (when (string= method "")
- (error "No method given"))
- (if (string-match "^[^% \t]+$" method)
- (setq method (concat method " %s")))
- (mm-display-external handle method)))
-
-(defun mm-preferred-alternative (handles &optional preferred)
- "Say which of HANDLES are preferred."
- (let ((prec (if preferred (list preferred)
- (mm-preferred-alternative-precedence handles)))
- p h result type handle)
- (while (setq p (pop prec))
- (setq h handles)
- (while h
- (setq handle (car h))
- (setq type (mm-handle-media-type handle))
- (when (and (equal p type)
- (mm-automatic-display-p handle)
- (or (stringp (car handle))
- (not (mm-handle-disposition handle))
- (equal (car (mm-handle-disposition handle))
- "inline")))
- (setq result handle
- h nil
- prec nil))
- (pop h)))
- result))
-
-(defun mm-preferred-alternative-precedence (handles)
- "Return the precedence based on HANDLES and `mm-discouraged-alternatives'."
- (let ((seq (nreverse (mapcar #'mm-handle-media-type
- handles))))
- (dolist (disc (reverse mm-discouraged-alternatives))
- (dolist (elem (copy-sequence seq))
- (when (string-match disc elem)
- (setq seq (nconc (delete elem seq) (list elem))))))
- seq))
-
-(defun mm-get-content-id (id)
- "Return the handle(s) referred to by ID."
- (cdr (assoc id mm-content-id-alist)))
-
-(defconst mm-image-type-regexps
- '(("/\\*.*XPM.\\*/" . xpm)
- ("P[1-6]" . pbm)
- ("GIF8" . gif)
- ("\377\330" . jpeg)
- ("\211PNG\r\n" . png)
- ("#define" . xbm)
- ("\\(MM\0\\*\\)\\|\\(II\\*\0\\)" . tiff)
- ("%!PS" . postscript))
- "Alist of (REGEXP . IMAGE-TYPE) pairs used to auto-detect image types.
-When the first bytes of an image file match REGEXP, it is assumed to
-be of image type IMAGE-TYPE.")
-
-;; Steal from image.el. image-type-from-data suffers multi-line matching bug.
-(defun mm-image-type-from-buffer ()
- "Determine the image type from data in the current buffer.
-Value is a symbol specifying the image type or nil if type cannot
-be determined."
- (let ((types mm-image-type-regexps)
- type)
- (goto-char (point-min))
- (while (and types (null type))
- (let ((regexp (car (car types)))
- (image-type (cdr (car types))))
- (when (looking-at regexp)
- (setq type image-type))
- (setq types (cdr types))))
- type))
-
-(defun mm-get-image (handle)
- "Return an image instance based on HANDLE."
- (let ((type (mm-handle-media-subtype handle))
- spec)
- ;; Allow some common translations.
- (setq type
- (cond
- ((equal type "x-pixmap")
- "xpm")
- ((equal type "x-xbitmap")
- "xbm")
- ((equal type "x-portable-bitmap")
- "pbm")
- (t type)))
- (or (mm-handle-cache handle)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (prog1
- (setq spec
- (ignore-errors
- ;; Avoid testing `make-glyph' since W3 may define
- ;; a bogus version of it.
- (if (fboundp 'create-image)
- (create-image (buffer-string)
- (or (mm-image-type-from-buffer)
- (intern type))
- 'data-p)
- (mm-create-image-xemacs type))))
- (mm-handle-set-cache handle spec))))))
-
-(defun mm-create-image-xemacs (type)
- (cond
- ((equal type "xbm")
- ;; xbm images require special handling, since
- ;; the only way to create glyphs from these
- ;; (without a ton of work) is to write them
- ;; out to a file, and then create a file
- ;; specifier.
- (let ((file (mm-make-temp-file
- (expand-file-name "emm" mm-tmp-directory)
- nil ".xbm")))
- (unwind-protect
- (progn
- (write-region (point-min) (point-max) file)
- (make-glyph (list (cons 'x file))))
- (ignore-errors
- (delete-file file)))))
- (t
- (make-glyph
- (vector
- (or (mm-image-type-from-buffer)
- (intern type))
- :data (buffer-string))))))
-
-(defun mm-image-fit-p (handle)
- "Say whether the image in HANDLE will fit the current window."
- (let ((image (mm-get-image handle)))
- (or (not image)
- (if (fboundp 'glyph-width)
- ;; XEmacs' glyphs can actually tell us about their width, so
- ;; lets be nice and smart about them.
- (or mm-inline-large-images
- (and (<= (glyph-width image) (window-pixel-width))
- (<= (glyph-height image) (window-pixel-height))))
- (let* ((size (image-size image))
- (w (car size))
- (h (cdr size)))
- (or mm-inline-large-images
- (and (<= h (1- (window-height))) ; Don't include mode line.
- (<= w (window-width)))))))))
-
-(defun mm-valid-image-format-p (format)
- "Say whether FORMAT can be displayed natively by Emacs."
- (cond
- ;; Handle XEmacs
- ((fboundp 'valid-image-instantiator-format-p)
- (valid-image-instantiator-format-p format))
- ;; Handle Emacs 21
- ((fboundp 'image-type-available-p)
- (and (display-graphic-p)
- (image-type-available-p format)))
- ;; Nobody else can do images yet.
- (t
- nil)))
-
-(defun mm-valid-and-fit-image-p (format handle)
- "Say whether FORMAT can be displayed natively and HANDLE fits the window."
- (and (mm-valid-image-format-p format)
- (mm-image-fit-p handle)))
-
-(defun mm-find-part-by-type (handles type &optional notp recursive)
- "Search in HANDLES for part with TYPE.
-If NOTP, returns first non-matching part.
-If RECURSIVE, search recursively."
- (let (handle)
- (while handles
- (if (and recursive (stringp (caar handles)))
- (if (setq handle (mm-find-part-by-type (cdar handles) type
- notp recursive))
- (setq handles nil))
- (if (if notp
- (not (equal (mm-handle-media-type (car handles)) type))
- (equal (mm-handle-media-type (car handles)) type))
- (setq handle (car handles)
- handles nil)))
- (setq handles (cdr handles)))
- handle))
-
-(defun mm-find-raw-part-by-type (ctl type &optional notp)
- (goto-char (point-min))
- (let* ((boundary (concat "--" (mm-handle-multipart-ctl-parameter ctl
- 'boundary)))
- (close-delimiter (concat "^" (regexp-quote boundary) "--[ \t]*$"))
- start
- (end (save-excursion
- (goto-char (point-max))
- (if (re-search-backward close-delimiter nil t)
- (match-beginning 0)
- (point-max))))
- result)
- (setq boundary (concat "^" (regexp-quote boundary) "[ \t]*$"))
- (while (and (not result)
- (re-search-forward boundary end t))
- (goto-char (match-beginning 0))
- (when start
- (save-excursion
- (save-restriction
- (narrow-to-region start (1- (point)))
- (when (let* ((ct (mail-fetch-field "content-type"))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (if notp
- (not (equal (car ctl) type))
- (equal (car ctl) type)))
- (setq result (buffer-string))))))
- (forward-line 1)
- (setq start (point)))
- (when (and (not result) start)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (when (let* ((ct (mail-fetch-field "content-type"))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (if notp
- (not (equal (car ctl) type))
- (equal (car ctl) type)))
- (setq result (buffer-string))))))
- result))
-
-(defvar mm-security-handle nil)
-
-(defsubst mm-set-handle-multipart-parameter (handle parameter value)
- ;; HANDLE could be a CTL.
- (when handle
- (put-text-property 0 (length (car handle)) parameter value
- (car handle))))
-
-(defun mm-possibly-verify-or-decrypt (parts ctl)
- (let ((type (car ctl))
- (subtype (cadr (split-string (car ctl) "/")))
- (mm-security-handle ctl) ;; (car CTL) is the type.
- protocol func functest)
- (cond
- ((or (equal type "application/x-pkcs7-mime")
- (equal type "application/pkcs7-mime"))
- (with-temp-buffer
- (when (and (cond
- ((eq mm-decrypt-option 'never) nil)
- ((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known) t)
- (t (y-or-n-p
- (format "Decrypt (S/MIME) part? "))))
- (mm-view-pkcs7 parts))
- (setq parts (mm-dissect-buffer t)))))
- ((equal subtype "signed")
- (unless (and (setq protocol
- (mm-handle-multipart-ctl-parameter ctl 'protocol))
- (not (equal protocol "multipart/mixed")))
- ;; The message is broken or draft-ietf-openpgp-multsig-01.
- (let ((protocols mm-verify-function-alist))
- (while protocols
- (if (and (or (not (setq functest (nth 3 (car protocols))))
- (funcall functest parts ctl))
- (mm-find-part-by-type parts (caar protocols) nil t))
- (setq protocol (caar protocols)
- protocols nil)
- (setq protocols (cdr protocols))))))
- (setq func (nth 1 (assoc protocol mm-verify-function-alist)))
- (when (cond
- ((eq mm-verify-option 'never) nil)
- ((eq mm-verify-option 'always) t)
- ((eq mm-verify-option 'known)
- (and func
- (or (not (setq functest
- (nth 3 (assoc protocol
- mm-verify-function-alist))))
- (funcall functest parts ctl))))
- (t
- (y-or-n-p
- (format "Verify signed (%s) part? "
- (or (nth 2 (assoc protocol mm-verify-function-alist))
- (format "protocol=%s" protocol))))))
- (save-excursion
- (if func
- (funcall func parts ctl)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (format "Unknown sign protocol (%s)" protocol))))))
- ((equal subtype "encrypted")
- (unless (setq protocol
- (mm-handle-multipart-ctl-parameter ctl 'protocol))
- ;; The message is broken.
- (let ((parts parts))
- (while parts
- (if (assoc (mm-handle-media-type (car parts))
- mm-decrypt-function-alist)
- (setq protocol (mm-handle-media-type (car parts))
- parts nil)
- (setq parts (cdr parts))))))
- (setq func (nth 1 (assoc protocol mm-decrypt-function-alist)))
- (when (cond
- ((eq mm-decrypt-option 'never) nil)
- ((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known)
- (and func
- (or (not (setq functest
- (nth 3 (assoc protocol
- mm-decrypt-function-alist))))
- (funcall functest parts ctl))))
- (t
- (y-or-n-p
- (format "Decrypt (%s) part? "
- (or (nth 2 (assoc protocol mm-decrypt-function-alist))
- (format "protocol=%s" protocol))))))
- (save-excursion
- (if func
- (setq parts (funcall func parts ctl))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (format "Unknown encrypt protocol (%s)" protocol))))))
- (t nil))
- parts))
-
-(defun mm-multiple-handles (handles)
- (and (listp handles)
- (> (length handles) 1)
- (or (listp (car handles))
- (stringp (car handles)))))
-
-(defun mm-complicated-handles (handles)
- (and (listp (car handles))
- (> (length handles) 1)))
-
-(defun mm-merge-handles (handles1 handles2)
- (append
- (if (listp (car handles1))
- handles1
- (list handles1))
- (if (listp (car handles2))
- handles2
- (list handles2))))
-
-(defun mm-readable-p (handle)
- "Say whether the content of HANDLE is readable."
- (and (< (with-current-buffer (mm-handle-buffer handle)
- (buffer-size)) 10000)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (and (eq (mm-body-7-or-8) '7bit)
- (not (mm-long-lines-p 76))))))
-
-(provide 'mm-decode)
-
-;; arch-tag: 4f35d360-56b8-4030-9388-3ed82d359b9b
-;;; mm-decode.el ends here
+++ /dev/null
-;;; mm-encode.el --- Functions for encoding MIME things
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mailcap)
-(eval-and-compile
- (autoload 'mm-body-7-or-8 "mm-bodies")
- (autoload 'mm-long-lines-p "mm-bodies"))
-
-(defcustom mm-content-transfer-encoding-defaults
- '(("text/x-patch" 8bit)
- ("text/.*" qp-or-base64)
- ("message/rfc822" 8bit)
- ("application/emacs-lisp" qp-or-base64)
- ("application/x-emacs-lisp" qp-or-base64)
- ("application/x-patch" qp-or-base64)
- (".*" base64))
- "Alist of regexps that match MIME types and their encodings.
-If the encoding is `qp-or-base64', then either quoted-printable
-or base64 will be used, depending on what is more efficient.
-
-`qp-or-base64' has another effect. It will fold long lines so that
-MIME parts may not be broken by MTA. So do `quoted-printable' and
-`base64'.
-
-Note: It affects body encoding only when a part is a raw forwarded
-message (which will be made by `gnus-summary-mail-forward' with the
-arg 2 for example) or is neither the text/* type nor the message/*
-type. Even though in those cases, you can use the `encoding' MML tag
-to specify encoding of non-ASCII MIME parts."
- :type '(repeat (list (regexp :tag "MIME type")
- (choice :tag "encoding"
- (const 7bit)
- (const 8bit)
- (const qp-or-base64)
- (const quoted-printable)
- (const base64))))
- :group 'mime)
-
-(defvar mm-use-ultra-safe-encoding nil
- "If non-nil, use encodings aimed at Procrustean bed survival.
-
-This means that textual parts are encoded as quoted-printable if they
-contain lines longer than 76 characters or starting with \"From \" in
-the body. Non-7bit encodings (8bit, binary) are generally disallowed.
-This is to reduce the probability that a broken MTA or MDA changes the
-message.
-
-This variable should never be set directly, but bound before a call to
-`mml-generate-mime' or similar functions.")
-
-(defun mm-insert-rfc822-headers (charset encoding)
- "Insert text/plain headers with CHARSET and ENCODING."
- (insert "MIME-Version: 1.0\n")
- (insert "Content-Type: text/plain; charset="
- (mail-quote-string (downcase (symbol-name charset))) "\n")
- (insert "Content-Transfer-Encoding: "
- (downcase (symbol-name encoding)) "\n"))
-
-(defun mm-insert-multipart-headers ()
- "Insert multipart/mixed headers."
- (let ((boundary "=-=-="))
- (insert "MIME-Version: 1.0\n")
- (insert "Content-Type: multipart/mixed; boundary=\"" boundary "\"\n")
- boundary))
-
-(defun mm-default-file-encoding (file)
- "Return a default encoding for FILE."
- (if (not (string-match "\\.[^.]+$" file))
- "application/octet-stream"
- (mailcap-extension-to-mime (match-string 0 file))))
-
-(defun mm-safer-encoding (encoding)
- "Return an encoding similar to ENCODING but safer than it."
- (cond
- ((eq encoding '7bit) '7bit) ;; 7bit is considered safe.
- ((memq encoding '(8bit quoted-printable)) 'quoted-printable)
- ;; The remaining encodings are binary and base64 (and perhaps some
- ;; non-standard ones), which are both turned into base64.
- (t 'base64)))
-
-(defun mm-encode-content-transfer-encoding (encoding &optional type)
- "Encode the current buffer with ENCODING for MIME type TYPE.
-ENCODING can be: nil (do nothing); one of `quoted-printable', `base64';
-`7bit', `8bit' or `binary' (all do nothing); a function to do the encoding."
- (cond
- ((eq encoding 'quoted-printable)
- ;; This used to try to make a multibyte buffer unibyte. That's
- ;; completely wrong, since you'd get QP-encoded emacs-mule. If
- ;; this gets run on multibyte text it's an error that needs
- ;; fixing, and the encoding function will signal an error.
- ;; Likewise base64 below.
- (quoted-printable-encode-region (point-min) (point-max) t))
- ((eq encoding 'base64)
- (when (string-match "\\`text/" type)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (replace-match "\r\n" t t)))
- (base64-encode-region (point-min) (point-max)))
- ((memq encoding '(7bit 8bit binary))
- ;; Do nothing.
- )
- ((null encoding)
- ;; Do nothing.
- )
- ;; Fixme: Ignoring errors here looks bogus.
- ((functionp encoding)
- (ignore-errors (funcall encoding (point-min) (point-max))))
- (t
- (error "Unknown encoding %s" encoding))))
-
-(defun mm-encode-buffer (type)
- "Encode the buffer which contains data of MIME type TYPE.
-TYPE is a string or a list of the components.
-The encoding used is returned."
- (let* ((mime-type (if (stringp type) type (car type)))
- (encoding
- (or (and (listp type)
- (cadr (assq 'encoding type)))
- (mm-content-transfer-encoding mime-type)))
- (bits (mm-body-7-or-8)))
- ;; We force buffers that are 7bit to be unencoded, no matter
- ;; what the preferred encoding is.
- ;; Only if the buffers don't contain lone lines.
- (when (and (eq bits '7bit) (not (mm-long-lines-p 76)))
- (setq encoding bits))
- (mm-encode-content-transfer-encoding encoding mime-type)
- encoding))
-
-(defun mm-insert-headers (type encoding &optional file)
- "Insert headers for TYPE."
- (insert "Content-Type: " type)
- (when file
- (insert ";\n\tname=\"" (file-name-nondirectory file) "\""))
- (insert "\n")
- (insert (format "Content-Transfer-Encoding: %s\n" encoding))
- (insert "Content-Disposition: inline")
- (when file
- (insert ";\n\tfilename=\"" (file-name-nondirectory file) "\""))
- (insert "\n")
- (insert "\n"))
-
-(defun mm-content-transfer-encoding (type)
- "Return a CTE suitable for TYPE to encode the current buffer."
- (let ((rules mm-content-transfer-encoding-defaults))
- (catch 'found
- (while rules
- (when (string-match (caar rules) type)
- (throw 'found
- (let ((encoding
- (if (eq (cadr (car rules)) 'qp-or-base64)
- (mm-qp-or-base64)
- (cadr (car rules)))))
- (if mm-use-ultra-safe-encoding
- (mm-safer-encoding encoding)
- encoding))))
- (pop rules)))))
-
-(defun mm-qp-or-base64 ()
- "Return the type with which to encode the buffer.
-This is either `base64' or `quoted-printable'."
- (if (equal mm-use-ultra-safe-encoding '(sign . "pgp"))
- ;; perhaps not always accurate?
- 'quoted-printable
- (save-excursion
- (let ((limit (min (point-max) (+ 2000 (point-min))))
- (n8bit 0))
- (goto-char (point-min))
- (skip-chars-forward "\x20-\x7f\r\n\t" limit)
- (while (< (point) limit)
- (incf n8bit)
- (forward-char 1)
- (skip-chars-forward "\x20-\x7f\r\n\t" limit))
- (if (or (< (* 6 n8bit) (- limit (point-min)))
- ;; Don't base64, say, a short line with a single
- ;; non-ASCII char when splitting parts by charset.
- (= n8bit 1))
- 'quoted-printable
- 'base64)))))
-
-(provide 'mm-encode)
-
-;;; arch-tag: 7d01bba4-d469-4851-952b-dc863f84ed66
-;;; mm-encode.el ends here
+++ /dev/null
-;;; mm-extern.el --- showing message/external-body
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: message external-body
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'mm-util)
-(require 'mm-decode)
-(require 'mm-url)
-
-(defvar gnus-article-mime-handles)
-
-(defvar mm-extern-function-alist
- '((local-file . mm-extern-local-file)
- (url . mm-extern-url)
- (anon-ftp . mm-extern-anon-ftp)
- (ftp . mm-extern-ftp)
-;;; (tftp . mm-extern-tftp)
- (mail-server . mm-extern-mail-server)
-;;; (afs . mm-extern-afs))
- ))
-
-(defvar mm-extern-anonymous "anonymous")
-
-(defun mm-extern-local-file (handle)
- (erase-buffer)
- (let ((name (cdr (assq 'name (cdr (mm-handle-type handle)))))
- (coding-system-for-read mm-binary-coding-system))
- (unless name
- (error "The filename is not specified"))
- (mm-disable-multibyte)
- (if (file-exists-p name)
- (mm-insert-file-contents name nil nil nil nil t)
- (error "File %s is gone" name))))
-
-(defun mm-extern-url (handle)
- (erase-buffer)
- (let ((url (cdr (assq 'url (cdr (mm-handle-type handle)))))
- (name buffer-file-name)
- (coding-system-for-read mm-binary-coding-system))
- (unless url
- (error "URL is not specified"))
- (mm-with-unibyte-current-buffer
- (mm-url-insert-file-contents url))
- (mm-disable-multibyte)
- (setq buffer-file-name name)))
-
-(defun mm-extern-anon-ftp (handle)
- (erase-buffer)
- (let* ((params (cdr (mm-handle-type handle)))
- (name (cdr (assq 'name params)))
- (site (cdr (assq 'site params)))
- (directory (cdr (assq 'directory params)))
- (mode (cdr (assq 'mode params)))
- (path (concat "/" (or mm-extern-anonymous
- (read-string (format "ID for %s: " site)))
- "@" site ":" directory "/" name))
- (coding-system-for-read mm-binary-coding-system))
- (unless name
- (error "The filename is not specified"))
- (mm-disable-multibyte)
- (mm-insert-file-contents path nil nil nil nil t)))
-
-(defun mm-extern-ftp (handle)
- (let (mm-extern-anonymous)
- (mm-extern-anon-ftp handle)))
-
-(defun mm-extern-mail-server (handle)
- (require 'message)
- (let* ((params (cdr (mm-handle-type handle)))
- (server (cdr (assq 'server params)))
- (subject (or (cdr (assq 'subject params)) "none"))
- (buf (current-buffer))
- info)
- (if (y-or-n-p (format "Send a request message to %s? " server))
- (save-window-excursion
- (message-mail server subject)
- (message-goto-body)
- (delete-region (point) (point-max))
- (insert-buffer-substring buf)
- (message "Requesting external body...")
- (message-send-and-exit)
- (setq info "Request is sent.")
- (message info))
- (setq info "Request is not sent."))
- (goto-char (point-min))
- (insert "[" info "]\n\n")))
-
-;;;###autoload
-(defun mm-extern-cache-contents (handle)
- "Put the external-body part of HANDLE into its cache."
- (let* ((access-type (cdr (assq 'access-type
- (cdr (mm-handle-type handle)))))
- (func (cdr (assq (intern
- (downcase
- (or access-type
- (error "Couldn't find access type"))))
- mm-extern-function-alist)))
- buf handles)
- (unless func
- (error "Access type (%s) is not supported" access-type))
- (mm-with-part handle
- (goto-char (point-max))
- (insert "\n\n")
- ;; It should be just a single MIME handle.
- (setq handles (mm-dissect-buffer t)))
- (unless (bufferp (car handles))
- (mm-destroy-parts handles)
- (error "Multipart external body is not supported"))
- (save-excursion
- (set-buffer (setq buf (mm-handle-buffer handles)))
- (let (good)
- (unwind-protect
- (progn
- (funcall func handle)
- (setq good t))
- (unless good
- (mm-destroy-parts handles))))
- (mm-handle-set-cache handle handles))
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles))))
-
-;;;###autoload
-(defun mm-inline-external-body (handle &optional no-display)
- "Show the external-body part of HANDLE.
-This function replaces the buffer of HANDLE with a buffer contains
-the entire message.
-If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
- (unless (mm-handle-cache handle)
- (mm-extern-cache-contents handle))
- (unless no-display
- (save-excursion
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-display-part (mm-handle-cache handle))))
- ;; Move undisplayer added to the cached handle to the parent.
- (mm-handle-set-undisplayer
- handle (mm-handle-undisplayer (mm-handle-cache handle)))
- (mm-handle-set-undisplayer (mm-handle-cache handle) nil)))
-
-(provide 'mm-extern)
-
-;;; arch-tag: 9653808e-14d9-4172-86e6-adceaa05378e
-;;; mm-extern.el ends here
+++ /dev/null
-;;; mm-partial.el --- showing message/partial
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: message partial
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus-sum)
-(require 'mm-util)
-(require 'mm-decode)
-
-(defun mm-partial-find-parts (id &optional art)
- (let ((headers (save-excursion
- (set-buffer gnus-summary-buffer)
- gnus-newsgroup-headers))
- phandles header)
- (while (setq header (pop headers))
- (unless (eq (aref header 0) art)
- (mm-with-unibyte-buffer
- (gnus-request-article-this-buffer (aref header 0)
- gnus-newsgroup-name)
- (when (search-forward id nil t)
- (let ((nhandles (mm-dissect-buffer
- nil gnus-article-loose-mime)) nid)
- (if (consp (car nhandles))
- (mm-destroy-parts nhandles)
- (setq nid (cdr (assq 'id
- (cdr (mm-handle-type nhandles)))))
- (if (not (equal id nid))
- (mm-destroy-parts nhandles)
- (push nhandles phandles))))))))
- phandles))
-
-;;;###autoload
-(defun mm-inline-partial (handle &optional no-display)
- "Show the partial part of HANDLE.
-This function replaces the buffer of HANDLE with a buffer contains
-the entire message.
-If NO-DISPLAY is nil, display it. Otherwise, do nothing after replacing."
- (let ((id (cdr (assq 'id (cdr (mm-handle-type handle)))))
- phandles
- (b (point)) (n 1) total
- phandle nn ntotal
- gnus-displaying-mime handles buffer)
- (unless (mm-handle-cache handle)
- (unless id
- (error "Can not find message/partial id"))
- (setq phandles
- (sort (cons handle
- (mm-partial-find-parts
- id
- (save-excursion
- (set-buffer gnus-summary-buffer)
- (gnus-summary-article-number))))
- #'(lambda (a b)
- (let ((anumber (string-to-number
- (cdr (assq 'number
- (cdr (mm-handle-type a))))))
- (bnumber (string-to-number
- (cdr (assq 'number
- (cdr (mm-handle-type b)))))))
- (< anumber bnumber)))))
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles phandles))
- (save-excursion
- (set-buffer (generate-new-buffer " *mm*"))
- (while (setq phandle (pop phandles))
- (setq nn (string-to-number
- (cdr (assq 'number
- (cdr (mm-handle-type phandle))))))
- (setq ntotal (string-to-number
- (cdr (assq 'total
- (cdr (mm-handle-type phandle))))))
- (if ntotal
- (if total
- (unless (eq total ntotal)
- (error "The numbers of total are different"))
- (setq total ntotal)))
- (unless (< nn n)
- (unless (eq nn n)
- (error "Missing part %d" n))
- (mm-insert-part phandle)
- (goto-char (point-max))
- (when (not (eq 0 (skip-chars-backward "\r\n")))
- ;; remove tail blank spaces except one
- (if (looking-at "\r?\n")
- (goto-char (match-end 0)))
- (delete-region (point) (point-max)))
- (setq n (+ n 1))))
- (unless total
- (error "Don't known the total number of"))
- (if (<= n total)
- (error "Missing part %d" n))
- (kill-buffer (mm-handle-buffer handle))
- (goto-char (point-min))
- (let ((point (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- (goto-char (point-min))
- (unless (re-search-forward "^mime-version:" point t)
- (insert "MIME-Version: 1.0\n")))
- (setcar handle (current-buffer))
- (mm-handle-set-cache handle t)))
- (unless no-display
- (save-excursion
- (save-restriction
- (narrow-to-region b b)
- (mm-insert-part handle)
- (let (gnus-article-mime-handles)
- (run-hooks 'gnus-article-decode-hook)
- (gnus-article-prepare-display)
- (setq handles gnus-article-mime-handles))
- (when handles
- ;; It is in article buffer.
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles)))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (condition-case nil
- ;; This is only valid on XEmacs.
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
- '(background background-pixmap foreground))
- (error nil))
- (delete-region ,(point-min-marker) ,(point-max-marker))))))))))
-
-(provide 'mm-partial)
-
-;;; arch-tag: 460e7424-05f2-4a1d-a0f2-70ec081eff7d
-;;; mm-partial.el ends here
+++ /dev/null
-;;; mm-url.el --- a wrapper of url functions/commands for Gnus
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Some codes are stolen from w3 and url packages. Some are moved from
-;; nnweb.
-
-;; TODO: Support POST, cookie.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'mm-util)
-(require 'gnus)
-
-(eval-and-compile
- (autoload 'executable-find "executable"))
-
-(eval-when-compile
- (if (featurep 'xemacs)
- (require 'timer-funcs)
- (require 'timer)))
-
-(defvar url-current-object)
-(defvar url-package-name)
-(defvar url-package-version)
-
-(defgroup mm-url nil
- "A wrapper of url package and external url command for Gnus."
- :group 'gnus)
-
-(defcustom mm-url-use-external (not
- (condition-case nil
- (require 'url)
- (error nil)))
- "*If non-nil, use external grab program `mm-url-program'."
- :version "22.1"
- :type 'boolean
- :group 'mm-url)
-
-(defvar mm-url-predefined-programs
- '((wget "wget" "--user-agent=mm-url" "-q" "-O" "-")
- (w3m "w3m" "-dump_source")
- (lynx "lynx" "-source")
- (curl "curl" "--silent" "--user-agent" "mm-url" "--location")))
-
-(defcustom mm-url-program
- (cond
- ((executable-find "wget") 'wget)
- ((executable-find "w3m") 'w3m)
- ((executable-find "lynx") 'lynx)
- ((executable-find "curl") 'curl)
- (t "GET"))
- "The url grab program.
-Likely values are `wget', `w3m', `lynx' and `curl'."
- :version "22.1"
- :type '(choice
- (symbol :tag "wget" wget)
- (symbol :tag "w3m" w3m)
- (symbol :tag "lynx" lynx)
- (symbol :tag "curl" curl)
- (string :tag "other"))
- :group 'mm-url)
-
-(defcustom mm-url-arguments nil
- "The arguments for `mm-url-program'."
- :version "22.1"
- :type '(repeat string)
- :group 'mm-url)
-
-\f
-;;; Internal variables
-
-(defvar mm-url-package-name
- (gnus-replace-in-string
- (gnus-replace-in-string gnus-version " v.*$" "")
- " " "-"))
-
-(defvar mm-url-package-version gnus-version-number)
-
-;; Stolen from w3.
-(defvar mm-url-html-entities
- '(
- ;;(excl . 33)
- (quot . 34)
- ;;(num . 35)
- ;;(dollar . 36)
- ;;(percent . 37)
- (amp . 38)
- (rsquo . 39) ; should be U+8217
- ;;(apos . 39)
- ;;(lpar . 40)
- ;;(rpar . 41)
- ;;(ast . 42)
- ;;(plus . 43)
- ;;(comma . 44)
- ;;(period . 46)
- ;;(colon . 58)
- ;;(semi . 59)
- (lt . 60)
- ;;(equals . 61)
- (gt . 62)
- ;;(quest . 63)
- ;;(commat . 64)
- ;;(lsqb . 91)
- ;;(rsqb . 93)
- (uarr . 94) ; should be U+8593
- ;;(lowbar . 95)
- (lsquo . 96) ; should be U+8216
- (lcub . 123)
- ;;(verbar . 124)
- (rcub . 125)
- (tilde . 126)
- (nbsp . 160)
- (iexcl . 161)
- (cent . 162)
- (pound . 163)
- (curren . 164)
- (yen . 165)
- (brvbar . 166)
- (sect . 167)
- (uml . 168)
- (copy . 169)
- (ordf . 170)
- (laquo . 171)
- (not . 172)
- (shy . 173)
- (reg . 174)
- (macr . 175)
- (deg . 176)
- (plusmn . 177)
- (sup2 . 178)
- (sup3 . 179)
- (acute . 180)
- (micro . 181)
- (para . 182)
- (middot . 183)
- (cedil . 184)
- (sup1 . 185)
- (ordm . 186)
- (raquo . 187)
- (frac14 . 188)
- (frac12 . 189)
- (frac34 . 190)
- (iquest . 191)
- (Agrave . 192)
- (Aacute . 193)
- (Acirc . 194)
- (Atilde . 195)
- (Auml . 196)
- (Aring . 197)
- (AElig . 198)
- (Ccedil . 199)
- (Egrave . 200)
- (Eacute . 201)
- (Ecirc . 202)
- (Euml . 203)
- (Igrave . 204)
- (Iacute . 205)
- (Icirc . 206)
- (Iuml . 207)
- (ETH . 208)
- (Ntilde . 209)
- (Ograve . 210)
- (Oacute . 211)
- (Ocirc . 212)
- (Otilde . 213)
- (Ouml . 214)
- (times . 215)
- (Oslash . 216)
- (Ugrave . 217)
- (Uacute . 218)
- (Ucirc . 219)
- (Uuml . 220)
- (Yacute . 221)
- (THORN . 222)
- (szlig . 223)
- (agrave . 224)
- (aacute . 225)
- (acirc . 226)
- (atilde . 227)
- (auml . 228)
- (aring . 229)
- (aelig . 230)
- (ccedil . 231)
- (egrave . 232)
- (eacute . 233)
- (ecirc . 234)
- (euml . 235)
- (igrave . 236)
- (iacute . 237)
- (icirc . 238)
- (iuml . 239)
- (eth . 240)
- (ntilde . 241)
- (ograve . 242)
- (oacute . 243)
- (ocirc . 244)
- (otilde . 245)
- (ouml . 246)
- (divide . 247)
- (oslash . 248)
- (ugrave . 249)
- (uacute . 250)
- (ucirc . 251)
- (uuml . 252)
- (yacute . 253)
- (thorn . 254)
- (yuml . 255)
-
- ;; Special handling of these
- (frac56 . "5/6")
- (frac16 . "1/6")
- (frac45 . "4/5")
- (frac35 . "3/5")
- (frac25 . "2/5")
- (frac15 . "1/5")
- (frac23 . "2/3")
- (frac13 . "1/3")
- (frac78 . "7/8")
- (frac58 . "5/8")
- (frac38 . "3/8")
- (frac18 . "1/8")
-
- ;; The following 5 entities are not mentioned in the HTML 2.0
- ;; standard, nor in any other HTML proposed standard of which I
- ;; am aware. I am not even sure they are ISO entity names. ***
- ;; Hence, some arrangement should be made to give a bad HTML
- ;; message when they are seen.
- (ndash . 45)
- (mdash . 45)
- (emsp . 32)
- (ensp . 32)
- (sim . 126)
- (le . "<=")
- (agr . "alpha")
- (rdquo . "''")
- (ldquo . "``")
- (trade . "(TM)")
- ;; To be done
- ;; (shy . ????) ; soft hyphen
- )
- "*An assoc list of entity names and how to actually display them.")
-
-(defconst mm-url-unreserved-chars
- '(
- ?a ?b ?c ?d ?e ?f ?g ?h ?i ?j ?k ?l ?m ?n ?o ?p ?q ?r ?s ?t ?u ?v ?w ?x ?y ?z
- ?A ?B ?C ?D ?E ?F ?G ?H ?I ?J ?K ?L ?M ?N ?O ?P ?Q ?R ?S ?T ?U ?V ?W ?X ?Y ?Z
- ?0 ?1 ?2 ?3 ?4 ?5 ?6 ?7 ?8 ?9
- ?- ?_ ?. ?! ?~ ?* ?' ?\( ?\))
- "A list of characters that are _NOT_ reserved in the URL spec.
-This is taken from RFC 2396.")
-
-(defun mm-url-load-url ()
- "Load `url-insert-file-contents'."
- (unless (condition-case ()
- (progn
- (require 'url-handlers)
- (require 'url-parse)
- (require 'url-vars))
- (error nil))
- ;; w3-4.0pre0.46 or earlier version.
- (require 'w3-vars)
- (require 'url)))
-
-;;;###autoload
-(defun mm-url-insert-file-contents (url)
- "Insert file contents of URL.
-If `mm-url-use-external' is non-nil, use `mm-url-program'."
- (if mm-url-use-external
- (progn
- (if (string-match "^file:/+" url)
- (insert-file-contents (substring url (1- (match-end 0))))
- (mm-url-insert-file-contents-external url))
- (goto-char (point-min))
- (if (fboundp 'url-generic-parse-url)
- (setq url-current-object
- (url-generic-parse-url url)))
- (list url (buffer-size)))
- (mm-url-load-url)
- (let ((name buffer-file-name)
- (url-request-extra-headers
- ;; ISTM setting a Connection header was a workaround for
- ;; older versions of url included with w3, but it does more
- ;; harm than good with the one shipped with Emacs. --ansel
- (if (not (and (boundp 'url-version)
- (equal url-version "Emacs")))
- (list (cons "Connection" "Close"))))
- (url-package-name (or mm-url-package-name
- url-package-name))
- (url-package-version (or mm-url-package-version
- url-package-version))
- result)
- (setq result (url-insert-file-contents url))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "\r 1000\r ?" nil t)
- (replace-match "")))
- (setq buffer-file-name name)
- (if (and (fboundp 'url-generic-parse-url)
- (listp result))
- (setq url-current-object (url-generic-parse-url
- (car result))))
- result)))
-
-;;;###autoload
-(defun mm-url-insert-file-contents-external (url)
- "Insert file contents of URL using `mm-url-program'."
- (let (program args)
- (if (symbolp mm-url-program)
- (let ((item (cdr (assq mm-url-program mm-url-predefined-programs))))
- (setq program (car item)
- args (append (cdr item) (list url))))
- (setq program mm-url-program
- args (append mm-url-arguments (list url))))
- (unless (eq 0 (apply 'call-process program nil t nil args))
- (error "Couldn't fetch %s" url))))
-
-(defvar mm-url-timeout 30
- "The number of seconds before timing out an URL fetch.")
-
-(defvar mm-url-retries 10
- "The number of retries after timing out when fetching an URL.")
-
-(defun mm-url-insert (url &optional follow-refresh)
- "Insert the contents from an URL in the current buffer.
-If FOLLOW-REFRESH is non-nil, redirect refresh url in META."
- (let ((times mm-url-retries)
- (done nil)
- (first t)
- result)
- (while (and (not (zerop (decf times)))
- (not done))
- (with-timeout (mm-url-timeout)
- (unless first
- (message "Trying again (%s)..." (- mm-url-retries times)))
- (setq first nil)
- (if follow-refresh
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-url-insert-file-contents url)
- (goto-char (point-min))
- (when (re-search-forward
- "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\"" nil t)
- (let ((url (match-string 1)))
- (delete-region (point-min) (point-max))
- (setq result (mm-url-insert url t)))))
- (setq result (mm-url-insert-file-contents url)))
- (setq done t)))
- result))
-
-(defun mm-url-decode-entities ()
- "Decode all HTML entities."
- (goto-char (point-min))
- (while (re-search-forward "&\\(#[0-9]+\\|[a-z]+[0-9]*\\);" nil t)
- (let ((elem (if (eq (aref (match-string 1) 0) ?\#)
- (let ((c
- (string-to-number (substring
- (match-string 1) 1))))
- (if (mm-char-or-char-int-p c) c 32))
- (or (cdr (assq (intern (match-string 1))
- mm-url-html-entities))
- ?#))))
- (unless (stringp elem)
- (setq elem (char-to-string elem)))
- (replace-match elem t t))))
-
-(defun mm-url-decode-entities-nbsp ()
- "Decode all HTML entities and to a space."
- (let ((mm-url-html-entities (cons '(nbsp . 32) mm-url-html-entities)))
- (mm-url-decode-entities)))
-
-(defun mm-url-decode-entities-string (string)
- (with-temp-buffer
- (insert string)
- (mm-url-decode-entities)
- (buffer-string)))
-
-(defun mm-url-form-encode-xwfu (chunk)
- "Escape characters in a string for application/x-www-form-urlencoded.
-Blasphemous crap because someone didn't think %20 was good enough for encoding
-spaces. Die Die Die."
- ;; This will get rid of the 'attributes' specified by the file type,
- ;; which are useless for an application/x-www-form-urlencoded form.
- (if (consp chunk)
- (setq chunk (cdr chunk)))
-
- (mapconcat
- (lambda (char)
- (cond
- ((= char ? ) "+")
- ((memq char mm-url-unreserved-chars) (char-to-string char))
- (t (upcase (format "%%%02x" char)))))
- ;; Fixme: Should this actually be accepting multibyte? Is there a
- ;; better way in XEmacs?
- (if (featurep 'mule)
- (encode-coding-string chunk
- (if (fboundp 'find-coding-systems-string)
- (car (find-coding-systems-string chunk))
- buffer-file-coding-system))
- chunk)
- ""))
-
-(defun mm-url-encode-www-form-urlencoded (pairs)
- "Return PAIRS encoded for forms."
- (mapconcat
- (lambda (data)
- (concat (mm-url-form-encode-xwfu (car data)) "="
- (mm-url-form-encode-xwfu (cdr data))))
- pairs "&"))
-
-(defun mm-url-fetch-form (url pairs)
- "Fetch a form from URL with PAIRS as the data using the POST method."
- (mm-url-load-url)
- (let ((url-request-data (mm-url-encode-www-form-urlencoded pairs))
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun mm-url-fetch-simple (url content)
- (mm-url-load-url)
- (let ((url-request-data content)
- (url-request-method "POST")
- (url-request-extra-headers
- '(("Content-type" . "application/x-www-form-urlencoded"))))
- (url-insert-file-contents url)
- (setq buffer-file-name nil))
- t)
-
-(defun mm-url-remove-markup ()
- "Remove all HTML markup, leaving just plain text."
- (goto-char (point-min))
- (while (search-forward "<!--" nil t)
- (delete-region (match-beginning 0)
- (or (search-forward "-->" nil t)
- (point-max))))
- (goto-char (point-min))
- (while (re-search-forward "<[^>]+>" nil t)
- (replace-match "" t t)))
-
-(provide 'mm-url)
-
-;;; arch-tag: 0594f9b3-417c-48b0-adc2-5082e1e7917f
-;;; mm-url.el ends here
+++ /dev/null
-;;; mm-util.el --- Utility functions for Mule and low level things
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mail-prsvr)
-
-(eval-and-compile
- (mapcar
- (lambda (elem)
- (let ((nfunc (intern (format "mm-%s" (car elem)))))
- (if (fboundp (car elem))
- (defalias nfunc (car elem))
- (defalias nfunc (cdr elem)))))
- '((coding-system-list . ignore)
- (char-int . identity)
- (coding-system-equal . equal)
- (annotationp . ignore)
- (set-buffer-file-coding-system . ignore)
- (make-char
- . (lambda (charset int)
- (int-to-char int)))
- (read-charset
- . (lambda (prompt)
- "Return a charset."
- (intern
- (completing-read
- prompt
- (mapcar (lambda (e) (list (symbol-name (car e))))
- mm-mime-mule-charset-alist)
- nil t))))
- (subst-char-in-string
- . (lambda (from to string &optional inplace)
- ;; stolen (and renamed) from nnheader.el
- "Replace characters in STRING from FROM to TO.
- Unless optional argument INPLACE is non-nil, return a new string."
- (let ((string (if inplace string (copy-sequence string)))
- (len (length string))
- (idx 0))
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (when (= (aref string idx) from)
- (aset string idx to))
- (setq idx (1+ idx)))
- string)))
- (string-as-unibyte . identity)
- (string-make-unibyte . identity)
- ;; string-as-multibyte often doesn't really do what you think it does.
- ;; Example:
- ;; (aref (string-as-multibyte "\201") 0) -> 129 (aka ?\201)
- ;; (aref (string-as-multibyte "\300") 0) -> 192 (aka ?\300)
- ;; (aref (string-as-multibyte "\300\201") 0) -> 192 (aka ?\300)
- ;; (aref (string-as-multibyte "\300\201") 1) -> 129 (aka ?\201)
- ;; but
- ;; (aref (string-as-multibyte "\201\300") 0) -> 2240
- ;; (aref (string-as-multibyte "\201\300") 1) -> <error>
- ;; Better use string-to-multibyte or encode-coding-string.
- ;; If you really need string-as-multibyte somewhere it's usually
- ;; because you're using the internal emacs-mule representation (maybe
- ;; because you're using string-as-unibyte somewhere), which is
- ;; generally a problem in itself.
- ;; Here is an approximate equivalence table to help think about it:
- ;; (string-as-multibyte s) ~= (decode-coding-string s 'emacs-mule)
- ;; (string-to-multibyte s) ~= (decode-coding-string s 'binary)
- ;; (string-make-multibyte s) ~= (decode-coding-string s locale-coding-system)
- (string-as-multibyte . identity)
- (multibyte-string-p . ignore)
- (insert-byte . insert-char)
- (multibyte-char-to-unibyte . identity))))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (if (featurep 'file-coding)
- ;; Don't modify string if CODING-SYSTEM is nil.
- (progn
- (defun mm-decode-coding-string (str coding-system)
- (if coding-system
- (decode-coding-string str coding-system)
- str))
- (defun mm-encode-coding-string (str coding-system)
- (if coding-system
- (encode-coding-string str coding-system)
- str))
- (defun mm-decode-coding-region (start end coding-system)
- (if coding-system
- (decode-coding-region start end coding-system)))
- (defun mm-encode-coding-region (start end coding-system)
- (if coding-system
- (encode-coding-region start end coding-system))))
- (defun mm-decode-coding-string (str coding-system) str)
- (defun mm-encode-coding-string (str coding-system) str)
- (defalias 'mm-decode-coding-region 'ignore)
- (defalias 'mm-encode-coding-region 'ignore))
- (defalias 'mm-decode-coding-string 'decode-coding-string)
- (defalias 'mm-encode-coding-string 'encode-coding-string)
- (defalias 'mm-decode-coding-region 'decode-coding-region)
- (defalias 'mm-encode-coding-region 'encode-coding-region)))
-
-(eval-and-compile
- (cond
- ((fboundp 'replace-in-string)
- (defalias 'mm-replace-in-string 'replace-in-string))
- ((fboundp 'replace-regexp-in-string)
- (defun mm-replace-in-string (string regexp newtext &optional literal)
- "Replace all matches for REGEXP with NEWTEXT in STRING.
-If LITERAL is non-nil, insert NEWTEXT literally. Return a new
-string containing the replacements.
-
-This is a compatibility function for different Emacsen."
- (replace-regexp-in-string regexp newtext string nil literal)))
- (t
- (defun mm-replace-in-string (string regexp newtext &optional literal)
- "Replace all matches for REGEXP with NEWTEXT in STRING.
-If LITERAL is non-nil, insert NEWTEXT literally. Return a new
-string containing the replacements.
-
-This is a compatibility function for different Emacsen."
- (let ((start 0) tail)
- (while (string-match regexp string start)
- (setq tail (- (length string) (match-end 0)))
- (setq string (replace-match newtext nil literal string))
- (setq start (- (length string) tail))))
- string))))
-
-(defalias 'mm-string-to-multibyte
- (cond
- ((featurep 'xemacs)
- 'identity)
- ((fboundp 'string-to-multibyte)
- 'string-to-multibyte)
- (t
- (lambda (string)
- "Return a multibyte string with the same individual chars as string."
- (mapconcat
- (lambda (ch) (mm-string-as-multibyte (char-to-string ch)))
- string "")))))
-
-(eval-and-compile
- (defalias 'mm-char-or-char-int-p
- (cond
- ((fboundp 'char-or-char-int-p) 'char-or-char-int-p)
- ((fboundp 'char-valid-p) 'char-valid-p)
- (t 'identity))))
-
-;; Fixme: This seems always to be used to read a MIME charset, so it
-;; should be re-named and fixed (in Emacs) to offer completion only on
-;; proper charset names (base coding systems which have a
-;; mime-charset defined). XEmacs doesn't believe in mime-charset;
-;; test with
-;; `(or (coding-system-get 'iso-8859-1 'mime-charset)
-;; (coding-system-get 'iso-8859-1 :mime-charset))'
-;; Actually, there should be an `mm-coding-system-mime-charset'.
-(eval-and-compile
- (defalias 'mm-read-coding-system
- (cond
- ((fboundp 'read-coding-system)
- (if (and (featurep 'xemacs)
- (<= (string-to-number emacs-version) 21.1))
- (lambda (prompt &optional default-coding-system)
- (read-coding-system prompt))
- 'read-coding-system))
- (t (lambda (prompt &optional default-coding-system)
- "Prompt the user for a coding system."
- (completing-read
- prompt (mapcar (lambda (s) (list (symbol-name (car s))))
- mm-mime-mule-charset-alist)))))))
-
-(defvar mm-coding-system-list nil)
-(defun mm-get-coding-system-list ()
- "Get the coding system list."
- (or mm-coding-system-list
- (setq mm-coding-system-list (mm-coding-system-list))))
-
-(defun mm-coding-system-p (cs)
- "Return non-nil if CS is a symbol naming a coding system.
-In XEmacs, also return non-nil if CS is a coding system object.
-If CS is available, return CS itself in Emacs, and return a coding
-system object in XEmacs."
- (if (fboundp 'find-coding-system)
- (and cs (find-coding-system cs))
- (if (fboundp 'coding-system-p)
- (when (coding-system-p cs)
- cs)
- ;; no-MULE XEmacs:
- (car (memq cs (mm-get-coding-system-list))))))
-
-(defun mm-codepage-setup (number &optional alias)
- "Create a coding system cpNUMBER.
-The coding system is created using `codepage-setup'. If ALIAS is
-non-nil, an alias is created and added to
-`mm-charset-synonym-alist'. If ALIAS is a string, it's used as
-the alias. Else windows-NUMBER is used."
- (interactive
- (let ((completion-ignore-case t)
- (candidates (cp-supported-codepages)))
- (list (completing-read "Setup DOS Codepage: (default 437) " candidates
- nil t nil nil "437"))))
- (when alias
- (setq alias (if (stringp alias)
- (intern alias)
- (intern (format "windows-%s" number)))))
- (let* ((cp (intern (format "cp%s" number))))
- (unless (mm-coding-system-p cp)
- (codepage-setup number))
- (when (and alias
- ;; Don't add alias if setup of cp failed.
- (mm-coding-system-p cp))
- (add-to-list 'mm-charset-synonym-alist (cons alias cp)))))
-
-(defvar mm-charset-synonym-alist
- `(
- ;; Not in XEmacs, but it's not a proper MIME charset anyhow.
- ,@(unless (mm-coding-system-p 'x-ctext)
- '((x-ctext . ctext)))
- ;; ISO-8859-15 is very similar to ISO-8859-1. But it's _different_ in 8
- ;; positions!
- ,@(unless (mm-coding-system-p 'iso-8859-15)
- '((iso-8859-15 . iso-8859-1)))
- ;; BIG-5HKSCS is similar to, but different than, BIG-5.
- ,@(unless (mm-coding-system-p 'big5-hkscs)
- '((big5-hkscs . big5)))
- ;; A Microsoft misunderstanding.
- ,@(when (and (not (mm-coding-system-p 'unicode))
- (mm-coding-system-p 'utf-16-le))
- '((unicode . utf-16-le)))
- ;; A Microsoft misunderstanding.
- ,@(unless (mm-coding-system-p 'ks_c_5601-1987)
- (if (mm-coding-system-p 'cp949)
- '((ks_c_5601-1987 . cp949))
- '((ks_c_5601-1987 . euc-kr))))
- ;; Windows-31J is Windows Codepage 932.
- ,@(when (and (not (mm-coding-system-p 'windows-31j))
- (mm-coding-system-p 'cp932))
- '((windows-31j . cp932)))
- ;; Charset name: GBK, Charset aliases: CP936, MS936, windows-936
- ;; http://www.iana.org/assignments/charset-reg/GBK
- ;; Emacs 22.1 has cp936, but not gbk, so we alias it:
- ,@(when (and (not (mm-coding-system-p 'gbk))
- (mm-coding-system-p 'cp936))
- '((gbk . cp936)))
- )
- "A mapping from unknown or invalid charset names to the real charset names.
-
-See `mm-codepage-iso-8859-list' and `mm-codepage-ibm-list'.")
-
-(defcustom mm-codepage-iso-8859-list
- (list 1250 ;; Windows-1250 is a variant of Latin-2 heavily used by Microsoft
- ;; Outlook users in Czech republic. Use this to allow reading of
- ;; their e-mails. cp1250 should be defined by M-x codepage-setup
- ;; (Emacs 21).
- '(1252 . 1) ;; Windows-1252 is a superset of iso-8859-1 (West
- ;; Europe). See also `gnus-article-dumbquotes-map'.
- '(1254 . 9) ;; Windows-1254 is a superset of iso-8859-9 (Turkish).
- '(1255 . 8));; Windows-1255 is a superset of iso-8859-8 (Hebrew).
- "A list of Windows codepage numbers and iso-8859 charset numbers.
-
-If an element is a number corresponding to a supported windows
-codepage, appropriate entries to `mm-charset-synonym-alist' are
-added by `mm-setup-codepage-iso-8859'. An element may also be a
-cons cell where the car is a codepage number and the cdr is the
-corresponding number of an iso-8859 charset."
- :type '(list (set :inline t
- (const 1250 :tag "Central and East European")
- (const (1252 . 1) :tag "West European")
- (const (1254 . 9) :tag "Turkish")
- (const (1255 . 8) :tag "Hebrew"))
- (repeat :inline t
- :tag "Other options"
- (choice
- (integer :tag "Windows codepage number")
- (cons (integer :tag "Windows codepage number")
- (integer :tag "iso-8859 charset number")))))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
-(defcustom mm-codepage-ibm-list
- (list 437 ;; (US etc.)
- 860 ;; (Portugal)
- 861 ;; (Iceland)
- 862 ;; (Israel)
- 863 ;; (Canadian French)
- 865 ;; (Nordic)
- 852 ;;
- 850 ;; (Latin 1)
- 855 ;; (Cyrillic)
- 866 ;; (Cyrillic - Russian)
- 857 ;; (Turkish)
- 864 ;; (Arabic)
- 869 ;; (Greek)
- 874);; (Thai)
- ;; In Emacs 23 (unicode), cp... and ibm... are aliases.
- ;; Cf. http://thread.gmane.org/v9lkng5nwy.fsf@marauder.physik.uni-ulm.de
- "List of IBM codepage numbers.
-
-The codepage mappings slighly differ between IBM and other vendors.
-See \"ftp://ftp.unicode.org/Public/MAPPINGS/VENDORS/IBM/README.TXT\".
-
-If an element is a number corresponding to a supported windows
-codepage, appropriate entries to `mm-charset-synonym-alist' are
-added by `mm-setup-codepage-ibm'."
- :type '(list (set :inline t
- (const 437 :tag "US etc.")
- (const 860 :tag "Portugal")
- (const 861 :tag "Iceland")
- (const 862 :tag "Israel")
- (const 863 :tag "Canadian French")
- (const 865 :tag "Nordic")
- (const 852)
- (const 850 :tag "Latin 1")
- (const 855 :tag "Cyrillic")
- (const 866 :tag "Cyrillic - Russian")
- (const 857 :tag "Turkish")
- (const 864 :tag "Arabic")
- (const 869 :tag "Greek")
- (const 874 :tag "Thai"))
- (repeat :inline t
- :tag "Other options"
- (integer :tag "Codepage number")))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
-(defun mm-setup-codepage-iso-8859 (&optional list)
- "Add appropriate entries to `mm-charset-synonym-alist'.
-Unless LIST is given, `mm-codepage-iso-8859-list' is used."
- (unless list
- (setq list mm-codepage-iso-8859-list))
- (dolist (i list)
- (let (cp windows iso)
- (if (consp i)
- (setq cp (intern (format "cp%d" (car i)))
- windows (intern (format "windows-%d" (car i)))
- iso (intern (format "iso-8859-%d" (cdr i))))
- (setq cp (intern (format "cp%d" i))
- windows (intern (format "windows-%d" i))))
- (unless (mm-coding-system-p windows)
- (if (mm-coding-system-p cp)
- (add-to-list 'mm-charset-synonym-alist (cons windows cp))
- (add-to-list 'mm-charset-synonym-alist (cons windows iso)))))))
-
-(defun mm-setup-codepage-ibm (&optional list)
- "Add appropriate entries to `mm-charset-synonym-alist'.
-Unless LIST is given, `mm-codepage-ibm-list' is used."
- (unless list
- (setq list mm-codepage-ibm-list))
- (dolist (number list)
- (let ((ibm (intern (format "ibm%d" number)))
- (cp (intern (format "cp%d" number))))
- (when (and (not (mm-coding-system-p ibm))
- (mm-coding-system-p cp))
- (add-to-list 'mm-charset-synonym-alist (cons ibm cp))))))
-
-;; Initialize:
-(mm-setup-codepage-iso-8859)
-(mm-setup-codepage-ibm)
-
-(defcustom mm-charset-override-alist
- `((iso-8859-1 . windows-1252))
- "A mapping from undesired charset names to their replacement.
-
-You may add pairs like (iso-8859-1 . windows-1252) here,
-i.e. treat iso-8859-1 as windows-1252. windows-1252 is a
-superset of iso-8859-1."
- :type '(list (set :inline t
- (const (iso-8859-1 . windows-1252))
- (const (undecided . windows-1252)))
- (repeat :inline t
- :tag "Other options"
- (cons (symbol :tag "From charset")
- (symbol :tag "To charset"))))
- :version "22.1" ;; Gnus 5.10.9
- :group 'mime)
-
-(defcustom mm-charset-eval-alist
- (if (featurep 'xemacs)
- nil ;; I don't know what would be useful for XEmacs.
- '(;; Emacs 21 offers 1250 1251 1253 1257. Emacs 22 provides autoloads for
- ;; 1250-1258 (i.e. `mm-codepage-setup' does nothing).
- (windows-1250 . (mm-codepage-setup 1250 t))
- (windows-1251 . (mm-codepage-setup 1251 t))
- (windows-1253 . (mm-codepage-setup 1253 t))
- (windows-1257 . (mm-codepage-setup 1257 t))))
- "An alist of (CHARSET . FORM) pairs.
-If an article is encoded in an unknown CHARSET, FORM is
-evaluated. This allows to load additional libraries providing
-charsets on demand. If supported by your Emacs version, you
-could use `autoload-coding-system' here."
- :version "22.1" ;; Gnus 5.10.9
- :type '(list (set :inline t
- (const (windows-1250 . (mm-codepage-setup 1250 t)))
- (const (windows-1251 . (mm-codepage-setup 1251 t)))
- (const (windows-1253 . (mm-codepage-setup 1253 t)))
- (const (windows-1257 . (mm-codepage-setup 1257 t)))
- (const (cp850 . (mm-codepage-setup 850 nil))))
- (repeat :inline t
- :tag "Other options"
- (cons (symbol :tag "charset")
- (symbol :tag "form"))))
- :group 'mime)
-(put 'mm-charset-eval-alist 'risky-local-variable t)
-
-(defvar mm-binary-coding-system
- (cond
- ((mm-coding-system-p 'binary) 'binary)
- ((mm-coding-system-p 'no-conversion) 'no-conversion)
- (t nil))
- "100% binary coding system.")
-
-(defvar mm-text-coding-system
- (or (if (memq system-type '(windows-nt ms-dos ms-windows))
- (and (mm-coding-system-p 'raw-text-dos) 'raw-text-dos)
- (and (mm-coding-system-p 'raw-text) 'raw-text))
- mm-binary-coding-system)
- "Text-safe coding system (For removing ^M).")
-
-(defvar mm-text-coding-system-for-write nil
- "Text coding system for write.")
-
-(defvar mm-auto-save-coding-system
- (cond
- ((mm-coding-system-p 'utf-8-emacs) ; Mule 7
- (if (memq system-type '(windows-nt ms-dos ms-windows))
- (if (mm-coding-system-p 'utf-8-emacs-dos)
- 'utf-8-emacs-dos mm-binary-coding-system)
- 'utf-8-emacs))
- ((mm-coding-system-p 'emacs-mule)
- (if (memq system-type '(windows-nt ms-dos ms-windows))
- (if (mm-coding-system-p 'emacs-mule-dos)
- 'emacs-mule-dos mm-binary-coding-system)
- 'emacs-mule))
- ((mm-coding-system-p 'escape-quoted) 'escape-quoted)
- (t mm-binary-coding-system))
- "Coding system of auto save file.")
-
-(defvar mm-universal-coding-system mm-auto-save-coding-system
- "The universal coding system.")
-
-;; Fixme: some of the cars here aren't valid MIME charsets. That
-;; should only matter with XEmacs, though.
-(defvar mm-mime-mule-charset-alist
- `((us-ascii ascii)
- (iso-8859-1 latin-iso8859-1)
- (iso-8859-2 latin-iso8859-2)
- (iso-8859-3 latin-iso8859-3)
- (iso-8859-4 latin-iso8859-4)
- (iso-8859-5 cyrillic-iso8859-5)
- ;; Non-mule (X)Emacs uses the last mule-charset for 8bit characters.
- ;; The fake mule-charset, gnus-koi8-r, tells Gnus that the default
- ;; charset is koi8-r, not iso-8859-5.
- (koi8-r cyrillic-iso8859-5 gnus-koi8-r)
- (iso-8859-6 arabic-iso8859-6)
- (iso-8859-7 greek-iso8859-7)
- (iso-8859-8 hebrew-iso8859-8)
- (iso-8859-9 latin-iso8859-9)
- (iso-8859-14 latin-iso8859-14)
- (iso-8859-15 latin-iso8859-15)
- (viscii vietnamese-viscii-lower)
- (iso-2022-jp latin-jisx0201 japanese-jisx0208 japanese-jisx0208-1978)
- (euc-kr korean-ksc5601)
- (gb2312 chinese-gb2312)
- (big5 chinese-big5-1 chinese-big5-2)
- (tibetan tibetan)
- (thai-tis620 thai-tis620)
- (windows-1251 cyrillic-iso8859-5)
- (iso-2022-7bit ethiopic arabic-1-column arabic-2-column)
- (iso-2022-jp-2 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212)
- (iso-2022-int-1 latin-iso8859-1 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2)
- (iso-2022-int-1 latin-iso8859-1 latin-iso8859-2
- cyrillic-iso8859-5 greek-iso8859-7
- latin-jisx0201 japanese-jisx0208-1978
- chinese-gb2312 japanese-jisx0208
- korean-ksc5601 japanese-jisx0212
- chinese-cns11643-1 chinese-cns11643-2
- chinese-cns11643-3 chinese-cns11643-4
- chinese-cns11643-5 chinese-cns11643-6
- chinese-cns11643-7)
- (iso-2022-jp-3 latin-jisx0201 japanese-jisx0208-1978 japanese-jisx0208
- japanese-jisx0213-1 japanese-jisx0213-2)
- (shift_jis latin-jisx0201 katakana-jisx0201 japanese-jisx0208)
- ,(cond ((fboundp 'unicode-precedence-list)
- (cons 'utf-8 (delq 'ascii (mapcar 'charset-name
- (unicode-precedence-list)))))
- ((or (not (fboundp 'charsetp)) ;; non-Mule case
- (charsetp 'unicode-a)
- (not (mm-coding-system-p 'mule-utf-8)))
- '(utf-8 unicode-a unicode-b unicode-c unicode-d unicode-e))
- (t ;; If we have utf-8 we're in Mule 5+.
- (append '(utf-8)
- (delete 'ascii
- (coding-system-get 'mule-utf-8 'safe-charsets))))))
- "Alist of MIME-charset/MULE-charsets.")
-
-(defun mm-enrich-utf-8-by-mule-ucs ()
- "Make the `utf-8' MIME charset usable by the Mule-UCS package.
-This function will run when the `un-define' module is loaded under
-XEmacs, and fill the `utf-8' entry in `mm-mime-mule-charset-alist'
-with Mule charsets. It is completely useless for Emacs."
- (when (boundp 'unicode-basic-translation-charset-order-list)
- (condition-case nil
- (let ((val (delq
- 'ascii
- (copy-sequence
- (symbol-value
- 'unicode-basic-translation-charset-order-list))))
- (elem (assq 'utf-8 mm-mime-mule-charset-alist)))
- (if elem
- (setcdr elem val)
- (setq mm-mime-mule-charset-alist
- (nconc mm-mime-mule-charset-alist
- (list (cons 'utf-8 val))))))
- (error))))
-
-;; Correct by construction, but should be unnecessary for Emacs:
-(if (featurep 'xemacs)
- (eval-after-load "un-define" '(mm-enrich-utf-8-by-mule-ucs))
- (when (and (fboundp 'coding-system-list)
- (fboundp 'sort-coding-systems))
- (let ((css (sort-coding-systems (coding-system-list 'base-only)))
- cs mime mule alist)
- (while css
- (setq cs (pop css)
- mime (or (coding-system-get cs :mime-charset) ; Emacs 23 (unicode)
- (coding-system-get cs 'mime-charset)))
- (when (and mime
- (not (eq t (setq mule
- (coding-system-get cs 'safe-charsets))))
- (not (assq mime alist)))
- (push (cons mime (delq 'ascii mule)) alist)))
- (setq mm-mime-mule-charset-alist (nreverse alist)))))
-
-(defvar mm-hack-charsets '(iso-8859-15 iso-2022-jp-2)
- "A list of special charsets.
-Valid elements include:
-`iso-8859-15' convert ISO-8859-1, -9 to ISO-8859-15 if ISO-8859-15 exists.
-`iso-2022-jp-2' convert ISO-2022-jp to ISO-2022-jp-2 if ISO-2022-jp-2 exists."
-)
-
-(defvar mm-iso-8859-15-compatible
- '((iso-8859-1 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE")
- (iso-8859-9 "\xA4\xA6\xA8\xB4\xB8\xBC\xBD\xBE\xD0\xDD\xDE\xF0\xFD\xFE"))
- "ISO-8859-15 exchangeable coding systems and inconvertible characters.")
-
-(defvar mm-iso-8859-x-to-15-table
- (and (fboundp 'coding-system-p)
- (mm-coding-system-p 'iso-8859-15)
- (mapcar
- (lambda (cs)
- (if (mm-coding-system-p (car cs))
- (let ((c (string-to-char
- (decode-coding-string "\341" (car cs)))))
- (cons (char-charset c)
- (cons
- (- (string-to-char
- (decode-coding-string "\341" 'iso-8859-15)) c)
- (string-to-list (decode-coding-string (car (cdr cs))
- (car cs))))))
- '(gnus-charset 0)))
- mm-iso-8859-15-compatible))
- "A table of the difference character between ISO-8859-X and ISO-8859-15.")
-
-(defcustom mm-coding-system-priorities
- (if (boundp 'current-language-environment)
- (let ((lang (symbol-value 'current-language-environment)))
- (cond ((string= lang "Japanese")
- ;; Japanese users prefer iso-2022-jp to euc-japan or
- ;; shift_jis, however iso-8859-1 should be used when
- ;; there are only ASCII text and Latin-1 characters.
- '(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)))))
- "Preferred coding systems for encoding outgoing messages.
-
-More than one suitable coding system may be found for some text.
-By default, the coding system with the highest priority is used
-to encode outgoing messages (see `sort-coding-systems'). If this
-variable is set, it overrides the default priority."
- :version "21.2"
- :type '(repeat (symbol :tag "Coding system"))
- :group 'mime)
-
-;; ??
-(defvar mm-use-find-coding-systems-region
- (fboundp 'find-coding-systems-region)
- "Use `find-coding-systems-region' to find proper coding systems.
-
-Setting it to nil is useful on Emacsen supporting Unicode if sending
-mail with multiple parts is preferred to sending a Unicode one.")
-
-;;; Internal variables:
-
-;;; Functions:
-
-(defun mm-mule-charset-to-mime-charset (charset)
- "Return the MIME charset corresponding to the given Mule CHARSET."
- (if (and (fboundp 'find-coding-systems-for-charsets)
- (fboundp 'sort-coding-systems))
- (let ((css (sort (sort-coding-systems
- (find-coding-systems-for-charsets (list charset)))
- 'mm-sort-coding-systems-predicate))
- cs mime)
- (while (and (not mime)
- css)
- (when (setq cs (pop css))
- (setq mime (or (coding-system-get cs :mime-charset)
- (coding-system-get cs 'mime-charset)))))
- mime)
- (let ((alist (mapcar (lambda (cs)
- (assq cs mm-mime-mule-charset-alist))
- (sort (mapcar 'car mm-mime-mule-charset-alist)
- 'mm-sort-coding-systems-predicate)))
- out)
- (while alist
- (when (memq charset (cdar alist))
- (setq out (caar alist)
- alist nil))
- (pop alist))
- out)))
-
-(defun mm-charset-to-coding-system (charset &optional lbt
- allow-override)
- "Return coding-system corresponding to CHARSET.
-CHARSET is a symbol naming a MIME charset.
-If optional argument LBT (`unix', `dos' or `mac') is specified, it is
-used as the line break code type of the coding system.
-
-If ALLOW-OVERRIDE is given, use `mm-charset-override-alist' to
-map undesired charset names to their replacement. This should
-only be used for decoding, not for encoding."
- ;; OVERRIDE is used (only) in `mm-decode-body' and `mm-decode-string'.
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when lbt
- (setq charset (intern (format "%s-%s" charset lbt))))
- (cond
- ((null charset)
- charset)
- ;; Running in a non-MULE environment.
- ((or (null (mm-get-coding-system-list))
- (not (fboundp 'coding-system-get)))
- charset)
- ;; Check override list quite early. Should only used for decoding, not for
- ;; encoding!
- ((and allow-override
- (let ((cs (cdr (assq charset mm-charset-override-alist))))
- (and cs (mm-coding-system-p cs) cs))))
- ;; ascii
- ((eq charset 'us-ascii)
- 'ascii)
- ;; Check to see whether we can handle this charset. (This depends
- ;; on there being some coding system matching each `mime-charset'
- ;; property defined, as there should be.)
- ((and (mm-coding-system-p charset)
-;;; Doing this would potentially weed out incorrect charsets.
-;;; charset
-;;; (eq charset (coding-system-get charset 'mime-charset))
- )
- charset)
- ;; Eval expressions from `mm-charset-eval-alist'
- ((let* ((el (assq charset mm-charset-eval-alist))
- (cs (car el))
- (form (cdr el)))
- (and cs
- form
- (prog2
- ;; Avoid errors...
- (condition-case nil (eval form) (error nil))
- ;; (message "Failed to eval `%s'" form))
- (mm-coding-system-p cs)
- (message "Added charset `%s' via `mm-charset-eval-alist'" cs))
- cs)))
- ;; Translate invalid charsets.
- ((let ((cs (cdr (assq charset mm-charset-synonym-alist))))
- (and cs
- (mm-coding-system-p cs)
- ;; (message
- ;; "Using synonym `%s' from `mm-charset-synonym-alist' for `%s'"
- ;; cs charset)
- cs)))
- ;; Last resort: search the coding system list for entries which
- ;; have the right mime-charset in case the canonical name isn't
- ;; defined (though it should be).
- ((let (cs)
- ;; mm-get-coding-system-list returns a list of cs without lbt.
- ;; Do we need -lbt?
- (dolist (c (mm-get-coding-system-list))
- (if (and (null cs)
- (eq charset (or (coding-system-get c :mime-charset)
- (coding-system-get c 'mime-charset))))
- (setq cs c)))
- (unless cs
- ;; Warn the user about unknown charset:
- (if (fboundp 'gnus-message)
- (gnus-message 7 "Unknown charset: %s" charset)
- (message "Unknown charset: %s" charset)))
- cs))))
-
-(defsubst mm-replace-chars-in-string (string from to)
- (mm-subst-char-in-string from to string))
-
-(eval-and-compile
- (defvar mm-emacs-mule (and (not (featurep 'xemacs))
- (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters
- (fboundp 'set-buffer-multibyte))
- "True in Emacs with Mule.")
-
- (if mm-emacs-mule
- (defun mm-enable-multibyte ()
- "Set the multibyte flag of the current buffer.
-Only do this if the default value of `enable-multibyte-characters' is
-non-nil. This is a no-op in XEmacs."
- (set-buffer-multibyte 'to))
- (defalias 'mm-enable-multibyte 'ignore))
-
- (if mm-emacs-mule
- (defun mm-disable-multibyte ()
- "Unset the multibyte flag of in the current buffer.
-This is a no-op in XEmacs."
- (set-buffer-multibyte nil))
- (defalias 'mm-disable-multibyte 'ignore)))
-
-(defun mm-preferred-coding-system (charset)
- ;; A typo in some Emacs versions.
- (or (get-charset-property charset 'preferred-coding-system)
- (get-charset-property charset 'prefered-coding-system)))
-
-;; Mule charsets shouldn't be used.
-(defsubst mm-guess-charset ()
- "Guess Mule charset from the language environment."
- (or
- mail-parse-mule-charset ;; cached mule-charset
- (progn
- (setq mail-parse-mule-charset
- (and (boundp 'current-language-environment)
- (car (last
- (assq 'charset
- (assoc current-language-environment
- language-info-alist))))))
- (if (or (not mail-parse-mule-charset)
- (eq mail-parse-mule-charset 'ascii))
- (setq mail-parse-mule-charset
- (or (car (last (assq mail-parse-charset
- mm-mime-mule-charset-alist)))
- ;; default
- 'latin-iso8859-1)))
- mail-parse-mule-charset)))
-
-(defun mm-charset-after (&optional pos)
- "Return charset of a character in current buffer at position POS.
-If POS is nil, it defauls to the current point.
-If POS is out of range, the value is nil.
-If the charset is `composition', return the actual one."
- (let ((char (char-after pos)) charset)
- (if (< (mm-char-int char) 128)
- (setq charset 'ascii)
- ;; charset-after is fake in some Emacsen.
- (setq charset (and (fboundp 'char-charset) (char-charset char)))
- (if (eq charset 'composition) ; Mule 4
- (let ((p (or pos (point))))
- (cadr (find-charset-region p (1+ p))))
- (if (and charset (not (memq charset '(ascii eight-bit-control
- eight-bit-graphic))))
- charset
- (mm-guess-charset))))))
-
-(defun mm-mime-charset (charset)
- "Return the MIME charset corresponding to the given Mule CHARSET."
- (if (eq charset 'unknown)
- (error "The message contains non-printable characters, please use attachment"))
- (if (and (fboundp 'coding-system-get) (fboundp 'get-charset-property))
- ;; This exists in Emacs 20.
- (or
- (and (mm-preferred-coding-system charset)
- (or (coding-system-get
- (mm-preferred-coding-system charset) :mime-charset)
- (coding-system-get
- (mm-preferred-coding-system charset) 'mime-charset)))
- (and (eq charset 'ascii)
- 'us-ascii)
- (mm-preferred-coding-system charset)
- (mm-mule-charset-to-mime-charset charset))
- ;; This is for XEmacs.
- (mm-mule-charset-to-mime-charset charset)))
-
-(if (fboundp 'delete-dups)
- (defalias 'mm-delete-duplicates 'delete-dups)
- (defun mm-delete-duplicates (list)
- "Destructively remove `equal' duplicates from LIST.
-Store the result in LIST and return it. LIST must be a proper list.
-Of several `equal' occurrences of an element in LIST, the first
-one is kept.
-
-This is a compatibility function for Emacsen without `delete-dups'."
- ;; Code from `subr.el' in Emacs 22:
- (let ((tail list))
- (while tail
- (setcdr tail (delete (car tail) (cdr tail)))
- (setq tail (cdr tail))))
- list))
-
-;; Fixme: This is used in places when it should be testing the
-;; default multibyteness. See mm-default-multibyte-p.
-(eval-and-compile
- (if (and (not (featurep 'xemacs))
- (boundp 'enable-multibyte-characters))
- (defun mm-multibyte-p ()
- "Non-nil if multibyte is enabled in the current buffer."
- enable-multibyte-characters)
- (defun mm-multibyte-p () (featurep 'mule))))
-
-(defun mm-default-multibyte-p ()
- "Return non-nil if the session is multibyte.
-This affects whether coding conversion should be attempted generally."
- (if (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters
- t)))
-
-(defun mm-iso-8859-x-to-15-region (&optional b e)
- (if (fboundp 'char-charset)
- (let (charset item c inconvertible)
- (save-restriction
- (if e (narrow-to-region b e))
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (while (not (eobp))
- (cond
- ((not (setq item (assq (char-charset (setq c (char-after)))
- mm-iso-8859-x-to-15-table)))
- (forward-char))
- ((memq c (cdr (cdr item)))
- (setq inconvertible t)
- (forward-char))
- (t
- (insert-before-markers (prog1 (+ c (car (cdr item)))
- (delete-char 1)))))
- (skip-chars-forward "\0-\177")))
- (not inconvertible))))
-
-(defun mm-sort-coding-systems-predicate (a b)
- (let ((priorities
- (mapcar (lambda (cs)
- ;; Note: invalid entries are dropped silently
- (and (setq cs (mm-coding-system-p cs))
- (coding-system-base cs)))
- mm-coding-system-priorities)))
- (and (setq a (mm-coding-system-p a))
- (if (setq b (mm-coding-system-p b))
- (> (length (memq (coding-system-base a) priorities))
- (length (memq (coding-system-base b) priorities)))
- t))))
-
-(eval-when-compile
- (autoload 'latin-unity-massage-name "latin-unity")
- (autoload 'latin-unity-maybe-remap "latin-unity")
- (autoload 'latin-unity-representations-feasible-region "latin-unity")
- (autoload 'latin-unity-representations-present-region "latin-unity")
- (defvar latin-unity-coding-systems)
- (defvar latin-unity-ucs-list))
-
-(defun mm-xemacs-find-mime-charset-1 (begin end)
- "Determine which MIME charset to use to send region as message.
-This uses the XEmacs-specific latin-unity package to better handle the
-case where identical characters from diverse ISO-8859-? character sets
-can be encoded using a single one of the corresponding coding systems.
-
-It treats `mm-coding-system-priorities' as the list of preferred
-coding systems; a useful example setting for this list in Western
-Europe would be '(iso-8859-1 iso-8859-15 utf-8), which would default
-to the very standard Latin 1 coding system, and only move to coding
-systems that are less supported as is necessary to encode the
-characters that exist in the buffer.
-
-Latin Unity doesn't know about those non-ASCII Roman characters that
-are available in various East Asian character sets. As such, its
-behavior if you have a JIS 0212 LATIN SMALL LETTER A WITH ACUTE in a
-buffer and it can otherwise be encoded as Latin 1, won't be ideal.
-But this is very much a corner case, so don't worry about it."
- (let ((systems mm-coding-system-priorities) csets psets curset)
-
- ;; Load the Latin Unity library, if available.
- (when (and (not (featurep 'latin-unity)) (locate-library "latin-unity"))
- (ignore-errors (require 'latin-unity)))
-
- ;; Now, can we use it?
- (if (featurep 'latin-unity)
- (progn
- (setq csets (latin-unity-representations-feasible-region begin end)
- psets (latin-unity-representations-present-region begin end))
-
- (catch 'done
-
- ;; Pass back the first coding system in the preferred list
- ;; that can encode the whole region.
- (dolist (curset systems)
- (setq curset (latin-unity-massage-name 'buffer-default curset))
-
- ;; If the coding system is a universal coding system, then
- ;; it can certainly encode all the characters in the region.
- (if (memq curset latin-unity-ucs-list)
- (throw 'done (list curset)))
-
- ;; If a coding system isn't universal, and isn't in
- ;; the list that latin unity knows about, we can't
- ;; decide whether to use it here. Leave that until later
- ;; in `mm-find-mime-charset-region' function, whence we
- ;; have been called.
- (unless (memq curset latin-unity-coding-systems)
- (throw 'done nil))
-
- ;; Right, we know about this coding system, and it may
- ;; conceivably be able to encode all the characters in
- ;; the region.
- (if (latin-unity-maybe-remap begin end curset csets psets t)
- (throw 'done (list curset))))
-
- ;; Can't encode using anything from the
- ;; `mm-coding-system-priorities' list.
- ;; Leave `mm-find-mime-charset' to do most of the work.
- nil))
-
- ;; Right, latin unity isn't available; let `mm-find-charset-region'
- ;; take its default action, which equally applies to GNU Emacs.
- nil)))
-
-(defmacro mm-xemacs-find-mime-charset (begin end)
- (when (featurep 'xemacs)
- `(and (featurep 'mule) (mm-xemacs-find-mime-charset-1 ,begin ,end))))
-
-(defun mm-find-mime-charset-region (b e &optional hack-charsets)
- "Return the MIME charsets needed to encode the region between B and E.
-nil means ASCII, a single-element list represents an appropriate MIME
-charset, and a longer list means no appropriate charset."
- (let (charsets)
- ;; The return possibilities of this function are a mess...
- (or (and (mm-multibyte-p)
- mm-use-find-coding-systems-region
- ;; Find the mime-charset of the most preferred coding
- ;; system that has one.
- (let ((systems (find-coding-systems-region b e)))
- (when mm-coding-system-priorities
- (setq systems
- (sort systems 'mm-sort-coding-systems-predicate)))
- (setq systems (delq 'compound-text systems))
- (unless (equal systems '(undecided))
- (while systems
- (let* ((head (pop systems))
- (cs (or (coding-system-get head :mime-charset)
- (coding-system-get head 'mime-charset))))
- ;; The mime-charset (`x-ctext') of
- ;; `compound-text' is not in the IANA list. We
- ;; shouldn't normally use anything here with a
- ;; mime-charset having an `x-' prefix.
- ;; Fixme: Allow this to be overridden, since
- ;; there is existing use of x-ctext.
- ;; Also people apparently need the coding system
- ;; `iso-2022-jp-3' (which Mule-UCS defines with
- ;; mime-charset, though it's not valid).
- (if (and cs
- (not (string-match "^[Xx]-" (symbol-name cs)))
- ;; UTF-16 of any variety is invalid for
- ;; text parts and, unfortunately, has
- ;; mime-charset defined both in Mule-UCS
- ;; and versions of Emacs. (The name
- ;; might be `mule-utf-16...' or
- ;; `utf-16...'.)
- (not (string-match "utf-16" (symbol-name cs))))
- (setq systems nil
- charsets (list cs))))))
- charsets))
- ;; If we're XEmacs, and some coding system is appropriate,
- ;; mm-xemacs-find-mime-charset will return an appropriate list.
- ;; Otherwise, we'll get nil, and the next setq will get invoked.
- (setq charsets (mm-xemacs-find-mime-charset b e))
-
- ;; We're not multibyte, or a single coding system won't cover it.
- (setq charsets
- (mm-delete-duplicates
- (mapcar 'mm-mime-charset
- (delq 'ascii
- (mm-find-charset-region b e))))))
- (if (and (> (length charsets) 1)
- (memq 'iso-8859-15 charsets)
- (memq 'iso-8859-15 hack-charsets)
- (save-excursion (mm-iso-8859-x-to-15-region b e)))
- (mapcar (lambda (x) (setq charsets (delq (car x) charsets)))
- mm-iso-8859-15-compatible))
- (if (and (memq 'iso-2022-jp-2 charsets)
- (memq 'iso-2022-jp-2 hack-charsets))
- (setq charsets (delq 'iso-2022-jp charsets)))
- ;; Attempt to reduce the number of charsets if utf-8 is available.
- (if (and (featurep 'xemacs)
- (> (length charsets) 1)
- (mm-coding-system-p 'utf-8))
- (let ((mm-coding-system-priorities
- (cons 'utf-8 mm-coding-system-priorities)))
- (setq charsets
- (mm-delete-duplicates
- (mapcar 'mm-mime-charset
- (delq 'ascii
- (mm-find-charset-region b e)))))))
- charsets))
-
-(defmacro mm-with-unibyte-buffer (&rest forms)
- "Create a temporary buffer, and evaluate FORMS there like `progn'.
-Use unibyte mode for this."
- `(let (default-enable-multibyte-characters)
- (with-temp-buffer ,@forms)))
-(put 'mm-with-unibyte-buffer 'lisp-indent-function 0)
-(put 'mm-with-unibyte-buffer 'edebug-form-spec '(body))
-
-(defmacro mm-with-multibyte-buffer (&rest forms)
- "Create a temporary buffer, and evaluate FORMS there like `progn'.
-Use multibyte mode for this."
- `(let ((default-enable-multibyte-characters t))
- (with-temp-buffer ,@forms)))
-(put 'mm-with-multibyte-buffer 'lisp-indent-function 0)
-(put 'mm-with-multibyte-buffer 'edebug-form-spec '(body))
-
-(defmacro mm-with-unibyte-current-buffer (&rest forms)
- "Evaluate FORMS with current buffer temporarily made unibyte.
-Also bind `default-enable-multibyte-characters' to nil.
-Equivalent to `progn' in XEmacs
-
-NOTE: Use this macro with caution in multibyte buffers (it is not
-worth using this macro in unibyte buffers of course). Use of
-`(set-buffer-multibyte t)', which is run finally, is generally
-harmful since it is likely to modify existing data in the buffer.
-For instance, it converts \"\\300\\255\" into \"\\255\" in
-Emacs 23 (unicode)."
- (let ((multibyte (make-symbol "multibyte"))
- (buffer (make-symbol "buffer")))
- `(if mm-emacs-mule
- (let ((,multibyte enable-multibyte-characters)
- (,buffer (current-buffer)))
- (unwind-protect
- (let (default-enable-multibyte-characters)
- (set-buffer-multibyte nil)
- ,@forms)
- (set-buffer ,buffer)
- (set-buffer-multibyte ,multibyte)))
- (let (default-enable-multibyte-characters)
- ,@forms))))
-(put 'mm-with-unibyte-current-buffer 'lisp-indent-function 0)
-(put 'mm-with-unibyte-current-buffer 'edebug-form-spec '(body))
-
-(defmacro mm-with-unibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' nil."
- `(let (default-enable-multibyte-characters)
- ,@forms))
-(put 'mm-with-unibyte 'lisp-indent-function 0)
-(put 'mm-with-unibyte 'edebug-form-spec '(body))
-
-(defmacro mm-with-multibyte (&rest forms)
- "Eval the FORMS with the default value of `enable-multibyte-characters' t."
- `(let ((default-enable-multibyte-characters t))
- ,@forms))
-(put 'mm-with-multibyte 'lisp-indent-function 0)
-(put 'mm-with-multibyte 'edebug-form-spec '(body))
-
-(defun mm-find-charset-region (b e)
- "Return a list of Emacs charsets in the region B to E."
- (cond
- ((and (mm-multibyte-p)
- (fboundp 'find-charset-region))
- ;; Remove composition since the base charsets have been included.
- ;; Remove eight-bit-*, treat them as ascii.
- (let ((css (find-charset-region b e)))
- (mapcar (lambda (cs) (setq css (delq cs css)))
- '(composition eight-bit-control eight-bit-graphic
- control-1))
- css))
- (t
- ;; We are in a unibyte buffer or XEmacs non-mule, so we futz around a bit.
- (save-excursion
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (skip-chars-forward "\0-\177")
- (if (eobp)
- '(ascii)
- (let (charset)
- (setq charset
- (and (boundp 'current-language-environment)
- (car (last (assq 'charset
- (assoc current-language-environment
- language-info-alist))))))
- (if (eq charset 'ascii) (setq charset nil))
- (or charset
- (setq charset
- (car (last (assq mail-parse-charset
- mm-mime-mule-charset-alist)))))
- (list 'ascii (or charset 'latin-iso8859-1)))))))))
-
-(if (fboundp 'shell-quote-argument)
- (defalias 'mm-quote-arg 'shell-quote-argument)
- (defun mm-quote-arg (arg)
- "Return a version of ARG that is safe to evaluate in a shell."
- (let ((pos 0) new-pos accum)
- ;; *** bug: we don't handle newline characters properly
- (while (setq new-pos (string-match "[]*[;!'`\"$\\& \t{} |()<>]" arg pos))
- (push (substring arg pos new-pos) accum)
- (push "\\" accum)
- (push (list (aref arg new-pos)) accum)
- (setq pos (1+ new-pos)))
- (if (= pos 0)
- arg
- (apply 'concat (nconc (nreverse accum) (list (substring arg pos))))))))
-
-(defun mm-auto-mode-alist ()
- "Return an `auto-mode-alist' with only the .gz (etc) thingies."
- (let ((alist auto-mode-alist)
- out)
- (while alist
- (when (listp (cdar alist))
- (push (car alist) out))
- (pop alist))
- (nreverse out)))
-
-(defvar mm-inhibit-file-name-handlers
- '(jka-compr-handler image-file-handler)
- "A list of handlers doing (un)compression (etc) thingies.")
-
-(defun mm-insert-file-contents (filename &optional visit beg end replace
- inhibit)
- "Like `insert-file-contents', but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-`find-file-hooks', etc.
-If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'.
- This function ensures that none of these modifications will take place."
- (let* ((format-alist nil)
- (auto-mode-alist (if inhibit nil (mm-auto-mode-alist)))
- (default-major-mode 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (inhibit-file-name-operation (if inhibit
- 'insert-file-contents
- inhibit-file-name-operation))
- (inhibit-file-name-handlers
- (if inhibit
- (append mm-inhibit-file-name-handlers
- inhibit-file-name-handlers)
- inhibit-file-name-handlers))
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
- (set ffh nil)
- (unwind-protect
- (insert-file-contents filename visit beg end replace)
- (set ffh val))))
-
-(defun mm-append-to-file (start end filename &optional codesys inhibit)
- "Append the contents of the region to the end of file FILENAME.
-When called from a function, expects three arguments,
-START, END and FILENAME. START and END are buffer positions
-saying what text to write.
-Optional fourth argument specifies the coding system to use when
-encoding the file.
-If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
- (let ((coding-system-for-write
- (or codesys mm-text-coding-system-for-write
- mm-text-coding-system))
- (inhibit-file-name-operation (if inhibit
- 'append-to-file
- inhibit-file-name-operation))
- (inhibit-file-name-handlers
- (if inhibit
- (append mm-inhibit-file-name-handlers
- inhibit-file-name-handlers)
- inhibit-file-name-handlers)))
- (write-region start end filename t 'no-message)
- (message "Appended to %s" filename)))
-
-(defun mm-write-region (start end filename &optional append visit lockname
- coding-system inhibit)
-
- "Like `write-region'.
-If INHIBIT is non-nil, inhibit `mm-inhibit-file-name-handlers'."
- (let ((coding-system-for-write
- (or coding-system mm-text-coding-system-for-write
- mm-text-coding-system))
- (inhibit-file-name-operation (if inhibit
- 'write-region
- inhibit-file-name-operation))
- (inhibit-file-name-handlers
- (if inhibit
- (append mm-inhibit-file-name-handlers
- inhibit-file-name-handlers)
- inhibit-file-name-handlers)))
- (write-region start end filename append visit lockname)))
-
-;; It is not a MIME function, but some MIME functions use it.
-(if (and (fboundp 'make-temp-file)
- (ignore-errors
- (let ((def (symbol-function 'make-temp-file)))
- (and (byte-code-function-p def)
- (setq def (if (fboundp 'compiled-function-arglist)
- ;; XEmacs
- (eval (list 'compiled-function-arglist def))
- (aref def 0)))
- (>= (length def) 4)
- (eq (nth 3 def) 'suffix)))))
- (defalias 'mm-make-temp-file 'make-temp-file)
- ;; Stolen (and modified for Emacs 20 and XEmacs) from Emacs 22.
- (defun mm-make-temp-file (prefix &optional dir-flag suffix)
- "Create a temporary file.
-The returned file name (created by appending some random characters at the end
-of PREFIX, and expanding against `temporary-file-directory' if necessary),
-is guaranteed to point to a newly created empty file.
-You can then use `write-region' to write new data into the file.
-
-If DIR-FLAG is non-nil, create a new empty directory instead of a file.
-
-If SUFFIX is non-nil, add that at the end of the file name."
- (let ((umask (default-file-modes))
- file)
- (unwind-protect
- (progn
- ;; Create temp files with strict access rights. It's easy to
- ;; loosen them later, whereas it's impossible to close the
- ;; time-window of loose permissions otherwise.
- (set-default-file-modes 448)
- (while (condition-case err
- (progn
- (setq file
- (make-temp-name
- (expand-file-name
- prefix
- (if (fboundp 'temp-directory)
- ;; XEmacs
- (temp-directory)
- temporary-file-directory))))
- (if suffix
- (setq file (concat file suffix)))
- (if dir-flag
- (make-directory file)
- ;; NOTE: This is unsafe if Emacs 20
- ;; users and XEmacs users don't use
- ;; a secure temp directory.
- (gmm-write-region "" nil file nil 'silent
- nil 'excl))
- nil)
- (file-already-exists t)
- ;; The Emacs 20 and XEmacs versions of
- ;; `make-directory' issue `file-error'.
- (file-error (or (and (or (featurep 'xemacs)
- (= emacs-major-version 20))
- (file-exists-p file))
- (signal (car err) (cdr err)))))
- ;; the file was somehow created by someone else between
- ;; `make-temp-name' and `write-region', let's try again.
- nil)
- file)
- ;; Reset the umask.
- (set-default-file-modes umask)))))
-
-(defun mm-image-load-path (&optional package)
- (let (dir result)
- (dolist (path load-path (nreverse result))
- (when (and path
- (file-directory-p
- (setq dir (concat (file-name-directory
- (directory-file-name path))
- "etc/images/" (or package "gnus/")))))
- (push dir result))
- (push path result))))
-
-;; Fixme: This doesn't look useful where it's used.
-(if (fboundp 'detect-coding-region)
- (defun mm-detect-coding-region (start end)
- "Like `detect-coding-region' except returning the best one."
- (let ((coding-systems
- (detect-coding-region start end)))
- (or (car-safe coding-systems)
- coding-systems)))
- (defun mm-detect-coding-region (start end)
- (let ((point (point)))
- (goto-char start)
- (skip-chars-forward "\0-\177" end)
- (prog1
- (if (eq (point) end) 'ascii (mm-guess-charset))
- (goto-char point)))))
-
-(if (fboundp 'coding-system-get)
- (defun mm-detect-mime-charset-region (start end)
- "Detect MIME charset of the text in the region between START and END."
- (let ((cs (mm-detect-coding-region start end)))
- (or (coding-system-get cs :mime-charset)
- (coding-system-get cs 'mime-charset))))
- (defun mm-detect-mime-charset-region (start end)
- "Detect MIME charset of the text in the region between START and END."
- (let ((cs (mm-detect-coding-region start end)))
- cs)))
-
-
-(provide 'mm-util)
-
-;; arch-tag: 94dc5388-825d-4fd1-bfa5-2100aa351238
-;;; mm-util.el ends here
+++ /dev/null
-;;; mm-uu.el --- Return uu stuff as mm handles
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: postscript uudecode binhex shar forward gnatsweb pgp
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'nnheader)
-(require 'mm-decode)
-(require 'mailcap)
-(require 'mml2015)
-
-(autoload 'uudecode-decode-region "uudecode")
-(autoload 'uudecode-decode-region-external "uudecode")
-(autoload 'uudecode-decode-region-internal "uudecode")
-
-(autoload 'binhex-decode-region "binhex")
-(autoload 'binhex-decode-region-external "binhex")
-(autoload 'binhex-decode-region-internal "binhex")
-
-(autoload 'yenc-decode-region "yenc")
-(autoload 'yenc-extract-filename "yenc")
-
-(defcustom mm-uu-decode-function 'uudecode-decode-region
- "*Function to uudecode.
-Internal function is done in Lisp by default, therefore decoding may
-appear to be horribly slow. You can make Gnus use an external
-decoder, such as uudecode."
- :type '(choice
- (function-item :tag "Auto detect" uudecode-decode-region)
- (function-item :tag "Internal" uudecode-decode-region-internal)
- (function-item :tag "External" uudecode-decode-region-external))
- :group 'gnus-article-mime)
-
-(defcustom mm-uu-binhex-decode-function 'binhex-decode-region
- "*Function to binhex decode.
-Internal function is done in elisp by default, therefore decoding may
-appear to be horribly slow . You can make Gnus use the external Unix
-decoder, such as hexbin."
- :type '(choice (function-item :tag "Auto detect" binhex-decode-region)
- (function-item :tag "Internal" binhex-decode-region-internal)
- (function-item :tag "External" binhex-decode-region-external))
- :group 'gnus-article-mime)
-
-(defvar mm-uu-yenc-decode-function 'yenc-decode-region)
-
-(defvar mm-uu-pgp-beginning-signature
- "^-----BEGIN PGP SIGNATURE-----")
-
-(defvar mm-uu-beginning-regexp nil)
-
-(defvar mm-dissect-disposition "inline"
- "The default disposition of uu parts.
-This can be either \"inline\" or \"attachment\".")
-
-(defcustom mm-uu-emacs-sources-regexp "\\.emacs\\.sources"
- "The regexp of Emacs sources groups."
- :version "22.1"
- :type 'regexp
- :group 'gnus-article-mime)
-
-(defcustom mm-uu-diff-groups-regexp
- "\\(gmane\\|gnu\\)\\..*\\(diff\\|commit\\|cvs\\|bug\\|devel\\)"
- "Regexp matching diff groups."
- :version "22.1"
- :type 'regexp
- :group 'gnus-article-mime)
-
-(defvar mm-uu-type-alist
- '((postscript
- "^%!PS-"
- "^%%EOF$"
- mm-uu-postscript-extract
- nil)
- (uu
- "^begin[ \t]+0?[0-7][0-7][0-7][ \t]+"
- "^end[ \t]*$"
- mm-uu-uu-extract
- mm-uu-uu-filename)
- (binhex
- "^:...............................................................$"
- ":$"
- mm-uu-binhex-extract
- nil
- mm-uu-binhex-filename)
- (yenc
- "^=ybegin.*size=[0-9]+.*name=.*$"
- "^=yend.*size=[0-9]+"
- mm-uu-yenc-extract
- mm-uu-yenc-filename)
- (shar
- "^#! */bin/sh"
- "^exit 0$"
- mm-uu-shar-extract)
- (forward
- ;; Thanks to Edward J. Sabol <sabol@alderaan.gsfc.nasa.gov> and
- ;; Peter von der Ah\'e <pahe@daimi.au.dk>
- "^-+ \\(Start of \\)?Forwarded message"
- "^-+ End \\(of \\)?forwarded message"
- mm-uu-forward-extract
- nil
- mm-uu-forward-test)
- (gnatsweb
- "^----gnatsweb-attachment----"
- nil
- mm-uu-gnatsweb-extract)
- (pgp-signed
- "^-----BEGIN PGP SIGNED MESSAGE-----"
- "^-----END PGP SIGNATURE-----"
- mm-uu-pgp-signed-extract
- nil
- nil)
- (pgp-encrypted
- "^-----BEGIN PGP MESSAGE-----"
- "^-----END PGP MESSAGE-----"
- mm-uu-pgp-encrypted-extract
- nil
- nil)
- (pgp-key
- "^-----BEGIN PGP PUBLIC KEY BLOCK-----"
- "^-----END PGP PUBLIC KEY BLOCK-----"
- mm-uu-pgp-key-extract
- mm-uu-gpg-key-skip-to-last
- nil)
- (emacs-sources
- "^;;;?[ \t]*[^ \t]+\\.el[ \t]*--"
- "^;;;?[ \t]*\\([^ \t]+\\.el\\)[ \t]+ends here"
- mm-uu-emacs-sources-extract
- nil
- mm-uu-emacs-sources-test)
- (diff
- "^Index: "
- nil
- mm-uu-diff-extract
- nil
- mm-uu-diff-test))
- "A list of specifications for non-MIME attachments.
-Each element consist of the following entries: label,
-start-regexp, end-regexp, extract-function, test-function.
-
-After modifying this list you must run \\[mm-uu-configure].
-
-You can disable elements from this list by customizing
-`mm-uu-configure-list'.")
-
-(defcustom mm-uu-configure-list '((shar . disabled))
- "A list of mm-uu configuration.
-To disable dissecting shar codes, for instance, add
-`(shar . disabled)' to this list."
- :type 'alist
- :options (mapcar (lambda (entry)
- (list (car entry) '(const disabled)))
- mm-uu-type-alist)
- :group 'gnus-article-mime)
-
-(defvar mm-uu-text-plain-type '("text/plain" (charset . gnus-decoded))
- "MIME type and parameters for text/plain parts.
-`gnus-decoded' is a fake charset, which means no further decoding.")
-
-;; functions
-
-(defsubst mm-uu-type (entry)
- (car entry))
-
-(defsubst mm-uu-beginning-regexp (entry)
- (nth 1 entry))
-
-(defsubst mm-uu-end-regexp (entry)
- (nth 2 entry))
-
-(defsubst mm-uu-function-extract (entry)
- (nth 3 entry))
-
-(defsubst mm-uu-function-1 (entry)
- (nth 4 entry))
-
-(defsubst mm-uu-function-2 (entry)
- (nth 5 entry))
-
-(defun mm-uu-copy-to-buffer (&optional from to)
- "Copy the contents of the current buffer to a fresh buffer.
-Return that buffer."
- (let ((obuf (current-buffer))
- (coding-system
- ;; Might not exist in non-MULE XEmacs
- (when (boundp 'buffer-file-coding-system)
- buffer-file-coding-system)))
- (with-current-buffer (generate-new-buffer " *mm-uu*")
- (setq buffer-file-coding-system coding-system)
- (insert-buffer-substring obuf from to)
- (current-buffer))))
-
-(defun mm-uu-configure-p (key val)
- (member (cons key val) mm-uu-configure-list))
-
-(defun mm-uu-configure (&optional symbol value)
- "Configure detection of non-MIME attachments."
- (interactive)
- (if symbol (set-default symbol value))
- (setq mm-uu-beginning-regexp nil)
- (mapcar (lambda (entry)
- (if (mm-uu-configure-p (mm-uu-type entry) 'disabled)
- nil
- (setq mm-uu-beginning-regexp
- (concat mm-uu-beginning-regexp
- (if mm-uu-beginning-regexp "\\|")
- (mm-uu-beginning-regexp entry)))))
- mm-uu-type-alist))
-
-(mm-uu-configure)
-
-(eval-when-compile
- (defvar file-name)
- (defvar start-point)
- (defvar end-point)
- (defvar entry))
-
-(defun mm-uu-uu-filename ()
- (if (looking-at ".+")
- (setq file-name
- (let ((nnheader-file-name-translation-alist
- '((?/ . ?,) (?\ . ?_) (?* . ?_) (?$ . ?_))))
- (nnheader-translate-file-chars (match-string 0))))))
-
-(defun mm-uu-binhex-filename ()
- (setq file-name
- (ignore-errors
- (binhex-decode-region start-point end-point t))))
-
-(defun mm-uu-yenc-filename ()
- (goto-char start-point)
- (setq file-name
- (ignore-errors
- (yenc-extract-filename))))
-
-(defun mm-uu-forward-test ()
- (save-excursion
- (goto-char start-point)
- (forward-line)
- (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:")))
-
-(defun mm-uu-postscript-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("application/postscript")))
-
-(defun mm-uu-emacs-sources-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("application/emacs-lisp" (charset . gnus-decoded))
- nil nil
- (list mm-dissect-disposition
- (cons 'filename file-name))))
-
-(eval-when-compile
- (defvar gnus-newsgroup-name))
-
-(defun mm-uu-emacs-sources-test ()
- (setq file-name (match-string 1))
- (and gnus-newsgroup-name
- mm-uu-emacs-sources-regexp
- (string-match mm-uu-emacs-sources-regexp gnus-newsgroup-name)))
-
-(defun mm-uu-diff-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("text/x-patch" (charset . gnus-decoded))))
-
-(defun mm-uu-diff-test ()
- (and gnus-newsgroup-name
- mm-uu-diff-groups-regexp
- (string-match mm-uu-diff-groups-regexp gnus-newsgroup-name)))
-
-(defun mm-uu-forward-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer
- (progn (goto-char start-point) (forward-line) (point))
- (progn (goto-char end-point) (forward-line -1) (point)))
- '("message/rfc822" (charset . gnus-decoded))))
-
-(defun mm-uu-uu-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- (list (or (and file-name
- (string-match "\\.[^\\.]+$"
- file-name)
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- "application/octet-stream"))
- 'x-uuencode nil
- (if (and file-name (not (equal file-name "")))
- (list mm-dissect-disposition
- (cons 'filename file-name)))))
-
-(defun mm-uu-binhex-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- (list (or (and file-name
- (string-match "\\.[^\\.]+$" file-name)
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- "application/octet-stream"))
- 'x-binhex nil
- (if (and file-name (not (equal file-name "")))
- (list mm-dissect-disposition
- (cons 'filename file-name)))))
-
-(defun mm-uu-yenc-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- (list (or (and file-name
- (string-match "\\.[^\\.]+$" file-name)
- (mailcap-extension-to-mime
- (match-string 0 file-name)))
- "application/octet-stream"))
- 'x-yenc nil
- (if (and file-name (not (equal file-name "")))
- (list mm-dissect-disposition
- (cons 'filename file-name)))))
-
-
-(defun mm-uu-shar-extract ()
- (mm-make-handle (mm-uu-copy-to-buffer start-point end-point)
- '("application/x-shar")))
-
-(defun mm-uu-gnatsweb-extract ()
- (save-restriction
- (goto-char start-point)
- (forward-line)
- (narrow-to-region (point) end-point)
- (mm-dissect-buffer t)))
-
-(defun mm-uu-pgp-signed-test (&rest rest)
- (and
- mml2015-use
- (mml2015-clear-verify-function)
- (cond
- ((eq mm-verify-option 'never) nil)
- ((eq mm-verify-option 'always) t)
- ((eq mm-verify-option 'known) t)
- (t (prog1
- (y-or-n-p "Verify pgp signed part? ")
- (message ""))))))
-
-(eval-when-compile
- (defvar gnus-newsgroup-charset))
-
-(defun mm-uu-pgp-signed-extract-1 (handles ctl)
- (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max))))
- (with-current-buffer buf
- (if (mm-uu-pgp-signed-test)
- (progn
- (mml2015-clean-buffer)
- (let ((coding-system-for-write (or gnus-newsgroup-charset
- 'iso-8859-1)))
- (funcall (mml2015-clear-verify-function))))
- (when (and mml2015-use (null (mml2015-clear-verify-function)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (format "Clear verification not supported by `%s'.\n" mml2015-use))))
- (goto-char (point-min))
- (forward-line)
- ;; We need to be careful not to strip beyond the armor headers.
- ;; Previously, an attacker could replace the text inside our
- ;; markup with trailing garbage by injecting whitespace into the
- ;; message.
- (while (looking-at "Hash:") ; The only header allowed in cleartext
- (forward-line)) ; signatures according to RFC2440.
- (when (looking-at "[\t ]*$")
- (forward-line))
- (delete-region (point-min) (point))
- (if (re-search-forward mm-uu-pgp-beginning-signature nil t)
- (delete-region (match-beginning 0) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward "^- " nil t)
- (replace-match "" t t)
- (forward-line 1)))
- (list (mm-make-handle buf mm-uu-text-plain-type))))
-
-(defun mm-uu-pgp-signed-extract ()
- (let ((mm-security-handle (list (format "multipart/signed"))))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'protocol "application/x-gnus-pgp-signature")
- (save-restriction
- (narrow-to-region start-point end-point)
- (add-text-properties 0 (length (car mm-security-handle))
- (list 'buffer (mm-uu-copy-to-buffer))
- (car mm-security-handle))
- (setcdr mm-security-handle
- (mm-uu-pgp-signed-extract-1 nil
- mm-security-handle)))
- mm-security-handle))
-
-(defun mm-uu-pgp-encrypted-test (&rest rest)
- (and
- mml2015-use
- (mml2015-clear-decrypt-function)
- (cond
- ((eq mm-decrypt-option 'never) nil)
- ((eq mm-decrypt-option 'always) t)
- ((eq mm-decrypt-option 'known) t)
- (t (prog1
- (y-or-n-p "Decrypt pgp encrypted part? ")
- (message ""))))))
-
-(defun mm-uu-pgp-encrypted-extract-1 (handles ctl)
- (let ((buf (mm-uu-copy-to-buffer (point-min) (point-max)))
- (first t)
- charset)
- ;; Make sure there's a blank line between header and body.
- (with-current-buffer buf
- (goto-char (point-min))
- (while (prog2
- (forward-line 1)
- (if first
- (looking-at "[^\t\n ]+:")
- (looking-at "[^\t\n ]+:\\|[\t ]"))
- (setq first nil)))
- (unless (memq (char-after) '(?\n nil))
- (insert "\n"))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (setq charset (mail-fetch-field "charset")))
- (if (and (mm-uu-pgp-encrypted-test)
- (progn
- (mml2015-clean-buffer)
- (funcall (mml2015-clear-decrypt-function))
- (equal (mm-handle-multipart-ctl-parameter mm-security-handle
- 'gnus-info)
- "OK")))
- (progn
- ;; Decode charset.
- (if (and (or charset
- (setq charset gnus-newsgroup-charset))
- (setq charset (mm-charset-to-coding-system charset))
- (not (eq charset 'ascii)))
- ;; Assume that buffer's multibyteness is turned off.
- ;; See `mml2015-pgg-clear-decrypt'.
- (insert (mm-decode-coding-string (prog1
- (buffer-string)
- (erase-buffer)
- (mm-enable-multibyte))
- charset))
- (mm-enable-multibyte))
- (list (mm-make-handle buf mm-uu-text-plain-type)))
- (list (mm-make-handle buf '("application/pgp-encrypted")))))))
-
-(defun mm-uu-pgp-encrypted-extract ()
- (let ((mm-security-handle (list (format "multipart/encrypted"))))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'protocol "application/x-gnus-pgp-encrypted")
- (save-restriction
- (narrow-to-region start-point end-point)
- (add-text-properties 0 (length (car mm-security-handle))
- (list 'buffer (mm-uu-copy-to-buffer))
- (car mm-security-handle))
- (setcdr mm-security-handle
- (mm-uu-pgp-encrypted-extract-1 nil
- mm-security-handle)))
- mm-security-handle))
-
-(defun mm-uu-gpg-key-skip-to-last ()
- (let ((point (point))
- (end-regexp (mm-uu-end-regexp entry))
- (beginning-regexp (mm-uu-beginning-regexp entry)))
- (when (and end-regexp
- (not (mm-uu-configure-p (mm-uu-type entry) 'disabled)))
- (while (re-search-forward end-regexp nil t)
- (skip-chars-forward " \t\n\r")
- (if (looking-at beginning-regexp)
- (setq point (match-end 0)))))
- (goto-char point)))
-
-(defun mm-uu-pgp-key-extract ()
- (let ((buf (mm-uu-copy-to-buffer start-point end-point)))
- (mm-make-handle buf
- '("application/pgp-keys"))))
-
-;;;###autoload
-(defun mm-uu-dissect (&optional noheader mime-type)
- "Dissect the current buffer and return a list of uu handles.
-The optional NOHEADER means there's no header in the buffer.
-MIME-TYPE specifies a MIME type and parameters, which defaults to the
-value of `mm-uu-text-plain-type'."
- (let ((case-fold-search t)
- (mm-uu-text-plain-type (or mime-type mm-uu-text-plain-type))
- text-start start-point end-point file-name result entry func)
- (save-excursion
- (goto-char (point-min))
- (cond
- (noheader)
- ((looking-at "\n")
- (forward-line))
- ((search-forward "\n\n" nil t)
- t)
- (t (goto-char (point-max))))
- (setq text-start (point))
- (while (re-search-forward mm-uu-beginning-regexp nil t)
- (setq start-point (match-beginning 0)
- entry nil)
- (let ((alist mm-uu-type-alist)
- (beginning-regexp (match-string 0)))
- (while (not entry)
- (if (string-match (mm-uu-beginning-regexp (car alist))
- beginning-regexp)
- (setq entry (car alist))
- (pop alist))))
- (if (setq func (mm-uu-function-1 entry))
- (funcall func))
- (forward-line);; in case of failure
- (when (and (not (mm-uu-configure-p (mm-uu-type entry) 'disabled))
- (let ((end-regexp (mm-uu-end-regexp entry)))
- (if (not end-regexp)
- (or (setq end-point (point-max)) t)
- (prog1
- (re-search-forward end-regexp nil t)
- (forward-line)
- (setq end-point (point)))))
- (or (not (setq func (mm-uu-function-2 entry)))
- (funcall func)))
- (if (and (> start-point text-start)
- (progn
- (goto-char text-start)
- (re-search-forward "." start-point t)))
- (push
- (mm-make-handle (mm-uu-copy-to-buffer text-start start-point)
- mm-uu-text-plain-type)
- result))
- (push
- (funcall (mm-uu-function-extract entry))
- result)
- (goto-char (setq text-start end-point))))
- (when result
- (if (and (> (point-max) (1+ text-start))
- (save-excursion
- (goto-char text-start)
- (re-search-forward "." nil t)))
- (push
- (mm-make-handle (mm-uu-copy-to-buffer text-start (point-max))
- mm-uu-text-plain-type)
- result))
- (setq result (cons "multipart/mixed" (nreverse result))))
- result)))
-
-;;;###autoload
-(defun mm-uu-dissect-text-parts (handle &optional decoded)
- "Dissect text parts and put uu handles into HANDLE.
-Assume text has been decoded if DECODED is non-nil."
- (let ((buffer (mm-handle-buffer handle)))
- (cond ((stringp buffer)
- (dolist (elem (cdr handle))
- (mm-uu-dissect-text-parts elem decoded)))
- ((bufferp buffer)
- (let ((type (mm-handle-media-type handle))
- (case-fold-search t) ;; string-match
- children charset encoding)
- (when (and
- (stringp type)
- ;; Mutt still uses application/pgp even though
- ;; it has already been withdrawn.
- (string-match "\\`text/\\|\\`application/pgp\\'" type)
- (setq
- children
- (with-current-buffer buffer
- (cond
- ((or decoded
- (eq (setq charset (mail-content-type-get
- (mm-handle-type handle)
- 'charset))
- 'gnus-decoded))
- (setq decoded t)
- (mm-uu-dissect
- t (cons type '((charset . gnus-decoded)))))
- (charset
- (setq decoded t)
- (mm-with-multibyte-buffer
- (insert (mm-decode-string (mm-get-part handle)
- charset))
- (mm-uu-dissect
- t (cons type '((charset . gnus-decoded))))))
- ((setq encoding (mm-handle-encoding handle))
- (setq decoded nil)
- ;; Inherit the multibyteness of the `buffer'.
- (with-temp-buffer
- (insert-buffer-substring buffer)
- (mm-decode-content-transfer-encoding
- encoding type)
- (mm-uu-dissect t (list type))))
- (t
- (setq decoded nil)
- (mm-uu-dissect t (list type)))))))
- ;; Ignore it if a given part is dissected into a single
- ;; part of which the type is the same as the given one.
- (if (and (<= (length children) 2)
- (string-equal (mm-handle-media-type (cadr children))
- type))
- (kill-buffer (mm-handle-buffer (cadr children)))
- (kill-buffer buffer)
- (setcdr handle (cdr children))
- (setcar handle (car children)) ;; "multipart/mixed"
- (dolist (elem (cdr children))
- (mm-uu-dissect-text-parts elem decoded))))))
- (t
- (dolist (elem handle)
- (mm-uu-dissect-text-parts elem decoded))))))
-
-(provide 'mm-uu)
-
-;; arch-tag: 7db076bf-53db-4320-aa19-ca76a1d2ab2c
-;;; mm-uu.el ends here
+++ /dev/null
-;;; mm-view.el --- functions for viewing MIME objects
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mail-parse)
-(require 'mailcap)
-(require 'mm-bodies)
-(require 'mm-decode)
-
-(eval-and-compile
- (autoload 'gnus-article-prepare-display "gnus-art")
- (autoload 'vcard-parse-string "vcard")
- (autoload 'vcard-format-string "vcard")
- (autoload 'fill-flowed "flow-fill")
- (autoload 'html2text "html2text" nil t)
- (unless (fboundp 'diff-mode)
- (autoload 'diff-mode "diff-mode" "" t nil)))
-
-(defvar gnus-article-mime-handles)
-(defvar gnus-newsgroup-charset)
-(defvar smime-keys)
-(defvar w3m-cid-retrieve-function-alist)
-(defvar w3m-current-buffer)
-(defvar w3m-display-inline-images)
-(defvar w3m-minor-mode-map)
-
-(defvar mm-text-html-renderer-alist
- '((w3 . mm-inline-text-html-render-with-w3)
- (w3m . mm-inline-text-html-render-with-w3m)
- (w3m-standalone . mm-inline-text-html-render-with-w3m-standalone)
- (links mm-inline-render-with-file
- mm-links-remove-leading-blank
- "links" "-dump" file)
- (lynx mm-inline-render-with-stdin nil
- "lynx" "-dump" "-force_html" "-stdin" "-nolist")
- (html2text mm-inline-render-with-function html2text))
- "The attributes of renderer types for text/html.")
-
-(defvar mm-text-html-washer-alist
- '((w3 . gnus-article-wash-html-with-w3)
- (w3m . gnus-article-wash-html-with-w3m)
- (w3m-standalone . gnus-article-wash-html-with-w3m-standalone)
- (links mm-inline-wash-with-file
- mm-links-remove-leading-blank
- "links" "-dump" file)
- (lynx mm-inline-wash-with-stdin nil
- "lynx" "-dump" "-force_html" "-stdin" "-nolist")
- (html2text html2text))
- "The attributes of washer types for text/html.")
-
-(defcustom mm-fill-flowed t
- "If non-nil an format=flowed article will be displayed flowed."
- :type 'boolean
- :version "22.1"
- :group 'mime-display)
-
-;;; Internal variables.
-
-;;;
-;;; Functions for displaying various formats inline
-;;;
-
-(defun mm-inline-image-emacs (handle)
- (let ((b (point-marker))
- buffer-read-only)
- (put-image (mm-get-image handle) b)
- (insert "\n\n")
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let ((b ,b)
- buffer-read-only)
- (remove-images b b)
- (delete-region b (+ b 2)))))))
-
-(defun mm-inline-image-xemacs (handle)
- (insert "\n\n")
- (forward-char -2)
- (let ((annot (make-annotation (mm-get-image handle) nil 'text))
- buffer-read-only)
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let ((b ,(point-marker))
- buffer-read-only)
- (delete-annotation ,annot)
- (delete-region (- b 2) b))))
- (set-extent-property annot 'mm t)
- (set-extent-property annot 'duplicable t)))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (defalias 'mm-inline-image 'mm-inline-image-xemacs)
- (defalias 'mm-inline-image 'mm-inline-image-emacs)))
-
-(defvar mm-w3-setup nil)
-(defun mm-setup-w3 ()
- (unless mm-w3-setup
- (require 'w3)
- (w3-do-setup)
- (require 'url)
- (require 'w3-vars)
- (require 'url-vars)
- (setq mm-w3-setup t)))
-
-(defun mm-inline-text-html-render-with-w3 (handle)
- (mm-setup-w3)
- (let ((text (mm-get-part handle))
- (b (point))
- (url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil)
- (url-current-object
- (url-generic-parse-url (format "cid:%s" (mm-handle-id handle))))
- (width (window-width))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (save-excursion
- (insert text)
- (save-restriction
- (narrow-to-region b (point))
- (goto-char (point-min))
- (if (or (and (boundp 'w3-meta-content-type-charset-regexp)
- (re-search-forward
- w3-meta-content-type-charset-regexp nil t))
- (and (boundp 'w3-meta-charset-content-type-regexp)
- (re-search-forward
- w3-meta-charset-content-type-regexp nil t)))
- (setq charset
- (or (let ((bsubstr (buffer-substring-no-properties
- (match-beginning 2)
- (match-end 2))))
- (if (fboundp 'w3-coding-system-for-mime-charset)
- (w3-coding-system-for-mime-charset bsubstr)
- (mm-charset-to-coding-system bsubstr)))
- charset)))
- (delete-region (point-min) (point-max))
- (insert (mm-decode-string text charset))
- (save-window-excursion
- (save-restriction
- (let ((w3-strict-width width)
- ;; Don't let w3 set the global version of
- ;; this variable.
- (fill-column fill-column))
- (if (or debug-on-error debug-on-quit)
- (w3-region (point-min) (point-max))
- (condition-case ()
- (w3-region (point-min) (point-max))
- (error
- (delete-region (point-min) (point-max))
- (let ((b (point))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset)))
- (if (or (eq charset 'gnus-decoded)
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle)
- charset))))
- (message
- "Error while rendering html; showing as text/plain")))))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (functionp 'remove-specifier)
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
-
-(defvar mm-w3m-setup nil
- "Whether gnus-article-mode has been setup to use emacs-w3m.")
-
-(defun mm-setup-w3m ()
- "Setup gnus-article-mode to use emacs-w3m."
- (unless mm-w3m-setup
- (require 'w3m)
- (unless (assq 'gnus-article-mode w3m-cid-retrieve-function-alist)
- (push (cons 'gnus-article-mode 'mm-w3m-cid-retrieve)
- w3m-cid-retrieve-function-alist))
- (setq mm-w3m-setup t))
- (setq w3m-display-inline-images mm-inline-text-html-with-images))
-
-(defun mm-w3m-cid-retrieve-1 (url handle)
- (dolist (elem handle)
- (when (consp elem)
- (when (equal url (mm-handle-id elem))
- (mm-insert-part elem)
- (throw 'found-handle (mm-handle-media-type elem)))
- (when (and (stringp (car elem))
- (equal "multipart" (mm-handle-media-supertype elem)))
- (mm-w3m-cid-retrieve-1 url elem)))))
-
-(defun mm-w3m-cid-retrieve (url &rest args)
- "Insert a content pointed by URL if it has the cid: scheme."
- (when (string-match "\\`cid:" url)
- (or (catch 'found-handle
- (mm-w3m-cid-retrieve-1
- (setq url (concat "<" (substring url (match-end 0)) ">"))
- (with-current-buffer w3m-current-buffer
- gnus-article-mime-handles)))
- (prog1
- nil
- (message "Failed to find \"Content-ID: %s\"" url)))))
-
-(defun mm-inline-text-html-render-with-w3m (handle)
- "Render a text/html part using emacs-w3m."
- (mm-setup-w3m)
- (let ((text (mm-get-part handle))
- (b (point))
- (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
- mail-parse-charset)))
- (save-excursion
- (insert (if charset (mm-decode-string text charset) text))
- (save-restriction
- (narrow-to-region b (point))
- (unless charset
- (goto-char (point-min))
- (when (setq charset (w3m-detect-meta-charset))
- (delete-region (point-min) (point-max))
- (insert (mm-decode-string text charset))))
- (let ((w3m-safe-url-regexp mm-w3m-safe-url-regexp)
- w3m-force-redisplay)
- (w3m-region (point-min) (point-max) nil charset))
- (when (and mm-inline-text-html-with-w3m-keymap
- (boundp 'w3m-minor-mode-map)
- w3m-minor-mode-map)
- (add-text-properties
- (point-min) (point-max)
- (list 'keymap w3m-minor-mode-map
- ;; Put the mark meaning this part was rendered by emacs-w3m.
- 'mm-inline-text-html-with-w3m t)))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (functionp 'remove-specifier)
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop)
- (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker)
- ,(point-max-marker)))))))))
-
-(defvar mm-w3m-standalone-supports-m17n-p (if (featurep 'mule) 'undecided)
- "*T means the w3m command supports the m17n feature.")
-
-(defun mm-w3m-standalone-supports-m17n-p ()
- "Say whether the w3m command supports the m17n feature."
- (cond ((eq mm-w3m-standalone-supports-m17n-p t) t)
- ((eq mm-w3m-standalone-supports-m17n-p nil) nil)
- ((not (featurep 'mule)) (setq mm-w3m-standalone-supports-m17n-p nil))
- ((condition-case nil
- (let ((coding-system-for-write 'iso-2022-jp)
- (coding-system-for-read 'iso-2022-jp)
- (str (mm-decode-coding-string "\
-\e$B#D#o#e#s!!#w#3#m!!#s#u#p#p#o#r#t!!#m#1#7#n!)\e(B" 'iso-2022-jp)))
- (mm-with-multibyte-buffer
- (insert str)
- (call-process-region
- (point-min) (point-max) "w3m" t t nil "-dump"
- "-T" "text/html" "-I" "iso-2022-jp" "-O" "iso-2022-jp")
- (goto-char (point-min))
- (search-forward str nil t)))
- (error nil))
- (setq mm-w3m-standalone-supports-m17n-p t))
- (t
- ;;(message "You had better upgrade your w3m command")
- (setq mm-w3m-standalone-supports-m17n-p nil))))
-
-(defun mm-inline-text-html-render-with-w3m-standalone (handle)
- "Render a text/html part using w3m."
- (if (mm-w3m-standalone-supports-m17n-p)
- (let ((source (mm-get-part handle))
- (charset (or (mail-content-type-get (mm-handle-type handle)
- 'charset)
- (symbol-name mail-parse-charset)))
- cs)
- (unless (and charset
- (setq cs (mm-charset-to-coding-system charset))
- (not (eq cs 'ascii)))
- ;; The default.
- (setq charset "iso-8859-1"
- cs 'iso-8859-1))
- (mm-insert-inline
- handle
- (mm-with-unibyte-buffer
- (insert source)
- (mm-enable-multibyte)
- (let ((coding-system-for-write 'binary)
- (coding-system-for-read cs))
- (call-process-region
- (point-min) (point-max)
- "w3m" t t nil "-dump" "-T" "text/html"
- "-I" charset "-O" charset))
- (buffer-string))))
- (mm-inline-render-with-stdin handle nil "w3m" "-dump" "-T" "text/html")))
-
-(defun mm-links-remove-leading-blank ()
- ;; Delete the annoying three spaces preceding each line of links
- ;; output.
- (goto-char (point-min))
- (while (re-search-forward "^ " nil t)
- (delete-region (match-beginning 0) (match-end 0))))
-
-(defun mm-inline-wash-with-file (post-func cmd &rest args)
- (let ((file (mm-make-temp-file
- (expand-file-name "mm" mm-tmp-directory))))
- (let ((coding-system-for-write 'binary))
- (write-region (point-min) (point-max) file nil 'silent))
- (delete-region (point-min) (point-max))
- (unwind-protect
- (apply 'call-process cmd nil t nil (mapcar 'eval args))
- (delete-file file))
- (and post-func (funcall post-func))))
-
-(defun mm-inline-wash-with-stdin (post-func cmd &rest args)
- (let ((coding-system-for-write 'binary))
- (apply 'call-process-region (point-min) (point-max)
- cmd t t nil args))
- (and post-func (funcall post-func)))
-
-(defun mm-inline-render-with-file (handle post-func cmd &rest args)
- (let ((source (mm-get-part handle)))
- (mm-insert-inline
- handle
- (mm-with-unibyte-buffer
- (insert source)
- (apply 'mm-inline-wash-with-file post-func cmd args)
- (buffer-string)))))
-
-(defun mm-inline-render-with-stdin (handle post-func cmd &rest args)
- (let ((source (mm-get-part handle)))
- (mm-insert-inline
- handle
- (mm-with-unibyte-buffer
- (insert source)
- (apply 'mm-inline-wash-with-stdin post-func cmd args)
- (buffer-string)))))
-
-(defun mm-inline-render-with-function (handle func &rest args)
- (let ((source (mm-get-part handle))
- (charset (or (mail-content-type-get (mm-handle-type handle) 'charset)
- mail-parse-charset)))
- (mm-insert-inline
- handle
- (mm-with-multibyte-buffer
- (insert (if charset
- (mm-decode-string source charset)
- source))
- (apply func args)
- (buffer-string)))))
-
-(defun mm-inline-text-html (handle)
- (let* ((func (or mm-inline-text-html-renderer mm-text-html-renderer))
- (entry (assq func mm-text-html-renderer-alist))
- buffer-read-only)
- (if entry
- (setq func (cdr entry)))
- (cond
- ((functionp func)
- (funcall func handle))
- (t
- (apply (car func) handle (cdr func))))))
-
-(defun mm-inline-text-vcard (handle)
- (let (buffer-read-only)
- (mm-insert-inline
- handle
- (concat "\n-- \n"
- (ignore-errors
- (if (fboundp 'vcard-pretty-print)
- (vcard-pretty-print (mm-get-part handle))
- (vcard-format-string
- (vcard-parse-string (mm-get-part handle)
- 'vcard-standard-filter))))))))
-
-(defun mm-inline-text (handle)
- (let ((b (point))
- (type (mm-handle-media-subtype handle))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- buffer-read-only)
- (if (or (eq charset 'gnus-decoded)
- ;; This is probably not entirely correct, but
- ;; makes rfc822 parts with embedded multiparts work.
- (eq mail-parse-charset 'gnus-decoded))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part handle)
- (goto-char (point-max)))
- (insert (mm-decode-string (mm-get-part handle) charset)))
- (when (and mm-fill-flowed
- (equal type "plain")
- (equal (cdr (assoc 'format (mm-handle-type handle)))
- "flowed"))
- (save-restriction
- (narrow-to-region b (point))
- (goto-char b)
- (fill-flowed)
- (goto-char (point-max))))
- (save-restriction
- (narrow-to-region b (point))
- (when (or (equal type "enriched")
- (equal type "richtext"))
- (set-text-properties (point-min) (point-max) nil)
- (ignore-errors
- (enriched-decode (point-min) (point-max))))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(point-min-marker)
- ,(point-max-marker))))))))
-
-(defun mm-insert-inline (handle text)
- "Insert TEXT inline from HANDLE."
- (let ((b (point)))
- (insert text)
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (delete-region ,(set-marker (make-marker) b)
- ,(set-marker (make-marker) (point))))))))
-
-(defun mm-inline-audio (handle)
- (message "Not implemented"))
-
-(defun mm-view-sound-file ()
- (message "Not implemented"))
-
-(defun mm-w3-prepare-buffer ()
- (require 'w3)
- (let ((url-standalone-mode t)
- (url-gateway-unplugged t)
- (w3-honor-stylesheets nil))
- (w3-prepare-buffer)))
-
-(defun mm-view-message ()
- (mm-enable-multibyte)
- (let (handles)
- (let (gnus-article-mime-handles)
- ;; Double decode problem may happen. See mm-inline-message.
- (run-hooks 'gnus-article-decode-hook)
- (gnus-article-prepare-display)
- (setq handles gnus-article-mime-handles))
- (when handles
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles))))
- (fundamental-mode)
- (goto-char (point-min)))
-
-(defun mm-inline-message (handle)
- (let ((b (point))
- (bolp (bolp))
- (charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- gnus-displaying-mime handles)
- (when (and charset
- (stringp charset))
- (setq charset (intern (downcase charset)))
- (when (eq charset 'us-ascii)
- (setq charset nil)))
- (save-excursion
- (save-restriction
- (narrow-to-region b b)
- (mm-insert-part handle)
- (let (gnus-article-mime-handles
- ;; disable prepare hook
- gnus-article-prepare-hook
- (gnus-newsgroup-charset
- (unless (eq charset 'gnus-decoded) ;; mm-uu might set it.
- (or charset gnus-newsgroup-charset))))
- (let ((gnus-original-article-buffer (mm-handle-buffer handle)))
- (run-hooks 'gnus-article-decode-hook))
- (gnus-article-prepare-display)
- (setq handles gnus-article-mime-handles))
- (goto-char (point-min))
- (unless bolp
- (insert "\n"))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (insert "----------\n\n")
- (when handles
- (setq gnus-article-mime-handles
- (mm-merge-handles gnus-article-mime-handles handles)))
- (mm-handle-set-undisplayer
- handle
- `(lambda ()
- (let (buffer-read-only)
- (if (fboundp 'remove-specifier)
- ;; This is only valid on XEmacs.
- (mapcar (lambda (prop)
- (remove-specifier
- (face-property 'default prop) (current-buffer)))
- '(background background-pixmap foreground)))
- (delete-region ,(point-min-marker) ,(point-max-marker)))))))))
-
-(defun mm-display-inline-fontify (handle mode)
- (let (text)
- ;; XEmacs @#$@ version of font-lock refuses to fully turn itself
- ;; on for buffers whose name begins with " ". That's why we use
- ;; save-current-buffer/get-buffer-create rather than
- ;; with-temp-buffer.
- (save-current-buffer
- (set-buffer (generate-new-buffer "*fontification*"))
- (unwind-protect
- (progn
- (buffer-disable-undo)
- (mm-insert-part handle)
- (require 'font-lock)
- (let ((font-lock-maximum-size nil)
- ;; Disable support modes, e.g., jit-lock, lazy-lock, etc.
- (font-lock-mode-hook nil)
- (font-lock-support-mode nil)
- ;; I find font-lock a bit too verbose.
- (font-lock-verbose nil))
- (funcall mode)
- ;; The mode function might have already turned on font-lock.
- (unless (symbol-value 'font-lock-mode)
- (font-lock-fontify-buffer)))
- ;; By default, XEmacs font-lock uses non-duplicable text
- ;; properties. This code forces all the text properties
- ;; to be copied along with the text.
- (when (fboundp 'extent-list)
- (map-extents (lambda (ext ignored)
- (set-extent-property ext 'duplicable t)
- nil)
- nil nil nil nil nil 'text-prop))
- (setq text (buffer-string)))
- (kill-buffer (current-buffer))))
- (mm-insert-inline handle text)))
-
-;; Shouldn't these functions check whether the user even wants to use
-;; font-lock? At least under XEmacs, this fontification is pretty
-;; much unconditional. Also, it would be nice to change for the size
-;; of the fontified region.
-
-(defun mm-display-patch-inline (handle)
- (mm-display-inline-fontify handle 'diff-mode))
-
-(defun mm-display-elisp-inline (handle)
- (mm-display-inline-fontify handle 'emacs-lisp-mode))
-
-;; id-signedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
-;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 2 }
-(defvar mm-pkcs7-signed-magic
- (mm-string-as-unibyte
- (apply 'concat
- (mapcar 'char-to-string
- (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
- ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
- ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
- ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x02)))))
-
-;; id-envelopedData OBJECT IDENTIFIER ::= { iso(1) member-body(2)
-;; us(840) rsadsi(113549) pkcs(1) pkcs7(7) 3 }
-(defvar mm-pkcs7-enveloped-magic
- (mm-string-as-unibyte
- (apply 'concat
- (mapcar 'char-to-string
- (list ?\x30 ?\x5c ?\x28 ?\x80 ?\x5c ?\x7c ?\x81 ?\x2e ?\x5c
- ?\x7c ?\x82 ?\x2e ?\x2e ?\x5c ?\x7c ?\x83 ?\x2e ?\x2e
- ?\x2e ?\x5c ?\x29 ?\x06 ?\x09 ?\x5c ?\x2a ?\x86 ?\x48
- ?\x86 ?\xf7 ?\x0d ?\x01 ?\x07 ?\x03)))))
-
-(defun mm-view-pkcs7-get-type (handle)
- (mm-with-unibyte-buffer
- (mm-insert-part handle)
- (cond ((looking-at mm-pkcs7-enveloped-magic)
- 'enveloped)
- ((looking-at mm-pkcs7-signed-magic)
- 'signed)
- (t
- (error "Could not identify PKCS#7 type")))))
-
-(defun mm-view-pkcs7 (handle)
- (case (mm-view-pkcs7-get-type handle)
- (enveloped (mm-view-pkcs7-decrypt handle))
- (signed (mm-view-pkcs7-verify handle))
- (otherwise (error "Unknown or unimplemented PKCS#7 type"))))
-
-(defun mm-view-pkcs7-verify (handle)
- ;; A bogus implementation of PKCS#7. FIXME::
- (mm-insert-part handle)
- (goto-char (point-min))
- (if (search-forward "Content-Type: " nil t)
- (delete-region (point-min) (match-beginning 0)))
- (goto-char (point-max))
- (if (re-search-backward "--\r?\n?" nil t)
- (delete-region (match-end 0) (point-max)))
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- (message "Verify signed PKCS#7 message is unimplemented.")
- (sit-for 1)
- t)
-
-(autoload 'gnus-completing-read-maybe-default "gnus-util" nil nil 'macro)
-
-(defun mm-view-pkcs7-decrypt (handle)
- (insert-buffer-substring (mm-handle-buffer handle))
- (goto-char (point-min))
- (insert "MIME-Version: 1.0\n")
- (mm-insert-headers "application/pkcs7-mime" "base64" "smime.p7m")
- (smime-decrypt-region
- (point-min) (point-max)
- (if (= (length smime-keys) 1)
- (cadar smime-keys)
- (smime-get-key-by-email
- (gnus-completing-read-maybe-default
- (concat "Decipher using key"
- (if smime-keys
- (concat " (default " (caar smime-keys) "): ")
- ": "))
- smime-keys nil nil nil nil (car-safe (car-safe smime-keys))))))
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- (goto-char (point-min)))
-
-(provide 'mm-view)
-
-;;; arch-tag: b60e749a-d05c-47f2-bccd-bdaa59327cb2
-;;; mm-view.el ends here
+++ /dev/null
-;;; mml-sec.el --- A package with security functions for MML documents
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'mml-smime)
-(eval-when-compile (require 'cl))
-(autoload 'mml2015-sign "mml2015")
-(autoload 'mml2015-encrypt "mml2015")
-(autoload 'mml1991-sign "mml1991")
-(autoload 'mml1991-encrypt "mml1991")
-(autoload 'message-goto-body "message")
-(autoload 'mml-insert-tag "mml")
-
-(defvar mml-sign-alist
- '(("smime" mml-smime-sign-buffer mml-smime-sign-query)
- ("pgp" mml-pgp-sign-buffer list)
- ("pgpauto" mml-pgpauto-sign-buffer list)
- ("pgpmime" mml-pgpmime-sign-buffer list))
- "Alist of MIME signer functions.")
-
-(defcustom mml-default-sign-method "pgpmime"
- "Default sign method.
-The string must have an entry in `mml-sign-alist'."
- :version "22.1"
- :type '(choice (const "smime")
- (const "pgp")
- (const "pgpauto")
- (const "pgpmime")
- string)
- :group 'message)
-
-(defvar mml-encrypt-alist
- '(("smime" mml-smime-encrypt-buffer mml-smime-encrypt-query)
- ("pgp" mml-pgp-encrypt-buffer list)
- ("pgpauto" mml-pgpauto-sign-buffer list)
- ("pgpmime" mml-pgpmime-encrypt-buffer list))
- "Alist of MIME encryption functions.")
-
-(defcustom mml-default-encrypt-method "pgpmime"
- "Default encryption method.
-The string must have an entry in `mml-encrypt-alist'."
- :version "22.1"
- :type '(choice (const "smime")
- (const "pgp")
- (const "pgpauto")
- (const "pgpmime")
- string)
- :group 'message)
-
-(defcustom mml-signencrypt-style-alist
- '(("smime" separate)
- ("pgp" combined)
- ("pgpauto" combined)
- ("pgpmime" combined))
- "Alist specifying if `signencrypt' results in two separate operations or not.
-The first entry indicates the MML security type, valid entries include
-the strings \"smime\", \"pgp\", and \"pgpmime\". The second entry is
-a symbol `separate' or `combined' where `separate' means that MML signs
-and encrypt messages in a two step process, and `combined' means that MML
-signs and encrypt the message in one step.
-
-Note that the output generated by using a `combined' mode is NOT
-understood by all PGP implementations, in particular PGP version
-2 does not support it! See Info node `(message)Security' for
-details."
- :version "22.1"
- :group 'message
- :type '(repeat (list (choice (const :tag "S/MIME" "smime")
- (const :tag "PGP" "pgp")
- (const :tag "PGP/MIME" "pgpmime")
- (string :tag "User defined"))
- (choice (const :tag "Separate" separate)
- (const :tag "Combined" combined)))))
-
-;;; Configuration/helper functions
-
-(defun mml-signencrypt-style (method &optional style)
- "Function for setting/getting the signencrypt-style used. Takes two
-arguments, the method (e.g. \"pgp\") and optionally the mode
-\(e.g. combined). If the mode is omitted, the current value is returned.
-
-For example, if you prefer to use combined sign & encrypt with
-smime, putting the following in your Gnus startup file will
-enable that behavior:
-
-\(mml-set-signencrypt-style \"smime\" combined)
-
-You can also customize or set `mml-signencrypt-style-alist' instead."
- (let ((style-item (assoc method mml-signencrypt-style-alist)))
- (if style-item
- (if (or (eq style 'separate)
- (eq style 'combined))
- ;; valid style setting?
- (setf (second style-item) style)
- ;; otherwise, just return the current value
- (second style-item))
- (message "Warning, attempt to set invalid signencrypt style"))))
-
-;;; Security functions
-
-(defun mml-smime-sign-buffer (cont)
- (or (mml-smime-sign cont)
- (error "Signing failed... inspect message logs for errors")))
-
-(defun mml-smime-encrypt-buffer (cont &optional sign)
- (when sign
- (message "Combined sign and encrypt S/MIME not support yet")
- (sit-for 1))
- (or (mml-smime-encrypt cont)
- (error "Encryption failed... inspect message logs for errors")))
-
-(defun mml-pgp-sign-buffer (cont)
- (or (mml1991-sign cont)
- (error "Signing failed... inspect message logs for errors")))
-
-(defun mml-pgp-encrypt-buffer (cont &optional sign)
- (or (mml1991-encrypt cont sign)
- (error "Encryption failed... inspect message logs for errors")))
-
-(defun mml-pgpmime-sign-buffer (cont)
- (or (mml2015-sign cont)
- (error "Signing failed... inspect message logs for errors")))
-
-(defun mml-pgpmime-encrypt-buffer (cont &optional sign)
- (or (mml2015-encrypt cont sign)
- (error "Encryption failed... inspect message logs for errors")))
-
-(defun mml-pgpauto-sign-buffer (cont)
- (message-goto-body)
- (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
- (mml2015-sign cont)
- (mml1991-sign cont))
- (error "Encryption failed... inspect message logs for errors")))
-
-(defun mml-pgpauto-encrypt-buffer (cont &optional sign)
- (message-goto-body)
- (or (if (re-search-backward "Content-Type: *multipart/.*" nil t) ; there must be a better way...
- (mml2015-encrypt cont sign)
- (mml1991-encrypt cont sign))
- (error "Encryption failed... inspect message logs for errors")))
-
-(defun mml-secure-part (method &optional sign)
- (save-excursion
- (let ((tags (funcall (nth 2 (assoc method (if sign mml-sign-alist
- mml-encrypt-alist))))))
- (cond ((re-search-backward
- "<#\\(multipart\\|part\\|external\\|mml\\)" nil t)
- (goto-char (match-end 0))
- (insert (if sign " sign=" " encrypt=") method)
- (while tags
- (let ((key (pop tags))
- (value (pop tags)))
- (when value
- ;; Quote VALUE if it contains suspicious characters.
- (when (string-match "[\"'\\~/*;() \t\n]" value)
- (setq value (prin1-to-string value)))
- (insert (format " %s=%s" key value))))))
- ((or (re-search-backward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t))
- (goto-char (match-end 0))
- (apply 'mml-insert-tag 'part (cons (if sign 'sign 'encrypt)
- (cons method tags))))
- (t (error "The message is corrupted. No mail header separator"))))))
-
-(defvar mml-secure-method
- (if (equal mml-default-encrypt-method mml-default-sign-method)
- mml-default-sign-method
- "pgpmime")
- "Current security method. Internal variable.")
-
-(defun mml-secure-sign (&optional method)
- "Add MML tags to sign this MML part.
-Use METHOD if given. Else use `mml-secure-method' or
-`mml-default-sign-method'."
- (interactive)
- (mml-secure-part
- (or method mml-secure-method mml-default-sign-method)
- 'sign))
-
-(defun mml-secure-encrypt (&optional method)
- "Add MML tags to encrypt this MML part.
-Use METHOD if given. Else use `mml-secure-method' or
-`mml-default-sign-method'."
- (interactive)
- (mml-secure-part
- (or method mml-secure-method mml-default-sign-method)))
-
-(defun mml-secure-sign-pgp ()
- "Add MML tags to PGP sign this MML part."
- (interactive)
- (mml-secure-part "pgp" 'sign))
-
-(defun mml-secure-sign-pgpauto ()
- "Add MML tags to PGP-auto sign this MML part."
- (interactive)
- (mml-secure-part "pgpauto" 'sign))
-
-(defun mml-secure-sign-pgpmime ()
- "Add MML tags to PGP/MIME sign this MML part."
- (interactive)
- (mml-secure-part "pgpmime" 'sign))
-
-(defun mml-secure-sign-smime ()
- "Add MML tags to S/MIME sign this MML part."
- (interactive)
- (mml-secure-part "smime" 'sign))
-
-(defun mml-secure-encrypt-pgp ()
- "Add MML tags to PGP encrypt this MML part."
- (interactive)
- (mml-secure-part "pgp"))
-
-(defun mml-secure-encrypt-pgpmime ()
- "Add MML tags to PGP/MIME encrypt this MML part."
- (interactive)
- (mml-secure-part "pgpmime"))
-
-(defun mml-secure-encrypt-smime ()
- "Add MML tags to S/MIME encrypt this MML part."
- (interactive)
- (mml-secure-part "smime"))
-
-;; defuns that add the proper <#secure ...> tag to the top of the message body
-(defun mml-secure-message (method &optional modesym)
- (let ((mode (prin1-to-string modesym))
- insert-loc)
- (mml-unsecure-message)
- (save-excursion
- (goto-char (point-min))
- (cond ((re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (goto-char (setq insert-loc (match-end 0)))
- (unless (looking-at "<#secure")
- (mml-insert-tag
- 'secure 'method method 'mode mode)))
- (t (error
- "The message is corrupted. No mail header separator"))))
- (when (eql insert-loc (point))
- (forward-line 1))))
-
-(defun mml-unsecure-message ()
- "Remove security related MML tags from message."
- (interactive)
- (save-excursion
- (goto-char (point-max))
- (when (re-search-backward "^<#secure.*>\n" nil t)
- (delete-region (match-beginning 0) (match-end 0)))))
-
-
-(defun mml-secure-message-sign (&optional method)
- "Add MML tags to sign this MML part.
-Use METHOD if given. Else use `mml-secure-method' or
-`mml-default-sign-method'."
- (interactive)
- (mml-secure-part
- (or method mml-secure-method mml-default-sign-method)
- 'sign))
-
-(defun mml-secure-message-sign-encrypt (&optional method)
- "Add MML tag to sign and encrypt the entire message.
-Use METHOD if given. Else use `mml-secure-method' or
-`mml-default-sign-method'."
- (interactive)
- (mml-secure-message
- (or method mml-secure-method mml-default-sign-method)
- 'signencrypt))
-
-(defun mml-secure-message-encrypt (&optional method)
- "Add MML tag to encrypt the entire message.
-Use METHOD if given. Else use `mml-secure-method' or
-`mml-default-sign-method'."
- (interactive)
- (mml-secure-message
- (or method mml-secure-method mml-default-sign-method)
- 'encrypt))
-
-(defun mml-secure-message-sign-smime ()
- "Add MML tag to encrypt/sign the entire message."
- (interactive)
- (mml-secure-message "smime" 'sign))
-
-(defun mml-secure-message-sign-pgp ()
- "Add MML tag to encrypt/sign the entire message."
- (interactive)
- (mml-secure-message "pgp" 'sign))
-
-(defun mml-secure-message-sign-pgpmime ()
- "Add MML tag to encrypt/sign the entire message."
- (interactive)
- (mml-secure-message "pgpmime" 'sign))
-
-(defun mml-secure-message-sign-pgpauto ()
- "Add MML tag to encrypt/sign the entire message."
- (interactive)
- (mml-secure-message "pgpauto" 'sign))
-
-(defun mml-secure-message-encrypt-smime (&optional dontsign)
- "Add MML tag to encrypt and sign the entire message.
-If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
- (mml-secure-message "smime" (if dontsign 'encrypt 'signencrypt)))
-
-(defun mml-secure-message-encrypt-pgp (&optional dontsign)
- "Add MML tag to encrypt and sign the entire message.
-If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
- (mml-secure-message "pgp" (if dontsign 'encrypt 'signencrypt)))
-
-(defun mml-secure-message-encrypt-pgpmime (&optional dontsign)
- "Add MML tag to encrypt and sign the entire message.
-If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
- (mml-secure-message "pgpmime" (if dontsign 'encrypt 'signencrypt)))
-
-(defun mml-secure-message-encrypt-pgpauto (&optional dontsign)
- "Add MML tag to encrypt and sign the entire message.
-If called with a prefix argument, only encrypt (do NOT sign)."
- (interactive "P")
- (mml-secure-message "pgpauto" (if dontsign 'encrypt 'signencrypt)))
-
-(provide 'mml-sec)
-
-;;; arch-tag: 111c56e7-df5e-4287-87d7-93ed2911ec6c
-;;; mml-sec.el ends here
+++ /dev/null
-;;; mml-smime.el --- S/MIME support for MML
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; Keywords: Gnus, MIME, S/MIME, MML
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'smime)
-(require 'mm-decode)
-(autoload 'message-narrow-to-headers "message")
-(autoload 'message-fetch-field "message")
-
-(defun mml-smime-sign (cont)
- (when (null smime-keys)
- (customize-variable 'smime-keys)
- (error "No S/MIME keys configured, use customize to add your key"))
- (smime-sign-buffer (cdr (assq 'keyfile cont)))
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))
- (goto-char (point-max)))
-
-(defun mml-smime-encrypt (cont)
- (let (certnames certfiles tmp file tmpfiles)
- ;; xxx tmp files are always an security issue
- (while (setq tmp (pop cont))
- (if (and (consp tmp) (eq (car tmp) 'certfile))
- (push (cdr tmp) certnames)))
- (while (setq tmp (pop certnames))
- (if (not (and (not (file-exists-p tmp))
- (get-buffer tmp)))
- (push tmp certfiles)
- (setq file (mm-make-temp-file (expand-file-name "mml."
- mm-tmp-directory)))
- (with-current-buffer tmp
- (write-region (point-min) (point-max) file))
- (push file certfiles)
- (push file tmpfiles)))
- (if (smime-encrypt-buffer certfiles)
- (progn
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- t)
- (while (setq tmp (pop tmpfiles))
- (delete-file tmp))
- nil))
- (goto-char (point-max)))
-
-(defun mml-smime-sign-query ()
- ;; query information (what certificate) from user when MML tag is
- ;; added, for use later by the signing process
- (when (null smime-keys)
- (customize-variable 'smime-keys)
- (error "No S/MIME keys configured, use customize to add your key"))
- (list 'keyfile
- (if (= (length smime-keys) 1)
- (cadar smime-keys)
- (or (let ((from (cadr (funcall (if (boundp
- 'gnus-extract-address-components)
- gnus-extract-address-components
- 'mail-extract-address-components)
- (or (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "from")))
- "")))))
- (and from (smime-get-key-by-email from)))
- (smime-get-key-by-email
- (completing-read "Sign this part with what signature? "
- smime-keys nil nil
- (and (listp (car-safe smime-keys))
- (caar smime-keys))))))))
-
-(defun mml-smime-get-file-cert ()
- (ignore-errors
- (list 'certfile (read-file-name
- "File with recipient's S/MIME certificate: "
- smime-certificate-directory nil t ""))))
-
-(defun mml-smime-get-dns-cert ()
- ;; todo: deal with comma separated multiple recipients
- (let (result who bad cert)
- (condition-case ()
- (while (not result)
- (setq who (read-from-minibuffer
- (format "%sLookup certificate for: " (or bad ""))
- (cadr (funcall (if (boundp
- 'gnus-extract-address-components)
- gnus-extract-address-components
- 'mail-extract-address-components)
- (or (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (message-fetch-field "to")))
- "")))))
- (if (setq cert (smime-cert-by-dns who))
- (setq result (list 'certfile (buffer-name cert)))
- (setq bad (format "`%s' not found. " who))))
- (quit))
- result))
-
-(defun mml-smime-encrypt-query ()
- ;; todo: add ldap support (xemacs ldap api?)
- ;; todo: try dns/ldap automatically first, before prompting user
- (let (certs done)
- (while (not done)
- (ecase (read (gnus-completing-read-with-default
- "dns" "Fetch certificate from"
- '(("dns") ("file")) nil t))
- (dns (setq certs (append certs
- (mml-smime-get-dns-cert))))
- (file (setq certs (append certs
- (mml-smime-get-file-cert)))))
- (setq done (not (y-or-n-p "Add more recipients? "))))
- certs))
-
-(defun mml-smime-verify (handle ctl)
- (with-temp-buffer
- (insert-buffer-substring (mm-handle-multipart-original-buffer ctl))
- (goto-char (point-min))
- (insert (format "Content-Type: %s; " (mm-handle-media-type ctl)))
- (insert (format "protocol=\"%s\"; "
- (mm-handle-multipart-ctl-parameter ctl 'protocol)))
- (insert (format "micalg=\"%s\"; "
- (mm-handle-multipart-ctl-parameter ctl 'micalg)))
- (insert (format "boundary=\"%s\"\n\n"
- (mm-handle-multipart-ctl-parameter ctl 'boundary)))
- (when (get-buffer smime-details-buffer)
- (kill-buffer smime-details-buffer))
- (let ((buf (current-buffer))
- (good-signature (smime-noverify-buffer))
- (good-certificate (and (or smime-CA-file smime-CA-directory)
- (smime-verify-buffer)))
- addresses openssl-output)
- (setq openssl-output (with-current-buffer smime-details-buffer
- (buffer-string)))
- (if (not good-signature)
- (progn
- ;; we couldn't verify message, fail with openssl output as message
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (concat "OpenSSL failed to verify message integrity:\n"
- "-------------------------------------------\n"
- openssl-output)))
- ;; verify mail addresses in mail against those in certificate
- (when (and (smime-pkcs7-region (point-min) (point-max))
- (smime-pkcs7-certificates-region (point-min) (point-max)))
- (with-temp-buffer
- (insert-buffer-substring buf)
- (goto-char (point-min))
- (while (re-search-forward "-----END CERTIFICATE-----" nil t)
- (when (smime-pkcs7-email-region (point-min) (point))
- (setq addresses (append (smime-buffer-as-string-region
- (point-min) (point)) addresses)))
- (delete-region (point-min) (point)))
- (setq addresses (mapcar 'downcase addresses))))
- (if (not (member (downcase (or (mm-handle-multipart-from ctl) "")) addresses))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Sender address forged")
- (if good-certificate
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Ok (sender authenticated)")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Ok (sender not trusted)")))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (concat "Sender claimed to be: " (mm-handle-multipart-from ctl) "\n"
- (if addresses
- (concat "Addresses in certificate: "
- (mapconcat 'identity addresses ", "))
- "No addresses found in certificate. (Requires OpenSSL 0.9.6 or later.)")
- "\n" "\n"
- "OpenSSL output:\n"
- "---------------\n" openssl-output "\n"
- "Certificate(s) inside S/MIME signature:\n"
- "---------------------------------------\n"
- (buffer-string) "\n")))))
- handle)
-
-(defun mml-smime-verify-test (handle ctl)
- smime-openssl-program)
-
-(provide 'mml-smime)
-
-;;; arch-tag: f1bf94d4-f2cd-4c6f-b059-ad69492817e2
-;;; mml-smime.el ends here
+++ /dev/null
-;;; mml.el --- A package for parsing and validating MML documents
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'mm-util)
-(require 'mm-bodies)
-(require 'mm-encode)
-(require 'mm-decode)
-(require 'mml-sec)
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (autoload 'message-make-message-id "message")
- (autoload 'gnus-setup-posting-charset "gnus-msg")
- (autoload 'gnus-add-minor-mode "gnus-ems")
- (autoload 'gnus-make-local-hook "gnus-util")
- (autoload 'message-fetch-field "message")
- (autoload 'message-info "message")
- (autoload 'fill-flowed-encode "flow-fill")
- (autoload 'message-posting-charset "message")
- (autoload 'dnd-get-local-file-name "dnd"))
-
-(defvar gnus-article-mime-handles)
-(defvar gnus-mouse-2)
-(defvar gnus-newsrc-hashtb)
-(defvar message-default-charset)
-(defvar message-deletable-headers)
-(defvar message-options)
-(defvar message-posting-charset)
-(defvar message-required-mail-headers)
-(defvar message-required-news-headers)
-(defvar dnd-protocol-alist)
-
-(defcustom mml-content-type-parameters
- '(name access-type expiration size permission format)
- "*A list of acceptable parameters in MML tag.
-These parameters are generated in Content-Type header if exists."
- :version "22.1"
- :type '(repeat (symbol :tag "Parameter"))
- :group 'message)
-
-(defcustom mml-content-disposition-parameters
- '(filename creation-date modification-date read-date)
- "*A list of acceptable parameters in MML tag.
-These parameters are generated in Content-Disposition header if exists."
- :version "22.1"
- :type '(repeat (symbol :tag "Parameter"))
- :group 'message)
-
-(defcustom mml-insert-mime-headers-always nil
- "If non-nil, always put Content-Type: text/plain at top of empty parts.
-It is necessary to work against a bug in certain clients."
- :version "22.1"
- :type 'boolean
- :group 'message)
-
-(defvar mml-tweak-type-alist nil
- "A list of (TYPE . FUNCTION) for tweaking MML parts.
-TYPE is a string containing a regexp to match the MIME type. FUNCTION
-is a Lisp function which is called with the MML handle to tweak the
-part. This variable is used only when no TWEAK parameter exists in
-the MML handle.")
-
-(defvar mml-tweak-function-alist nil
- "A list of (NAME . FUNCTION) for tweaking MML parts.
-NAME is a string containing the name of the TWEAK parameter in the MML
-handle. FUNCTION is a Lisp function which is called with the MML
-handle to tweak the part.")
-
-(defvar mml-tweak-sexp-alist
- '((mml-externalize-attachments . mml-tweak-externalize-attachments))
- "A list of (SEXP . FUNCTION) for tweaking MML parts.
-SEXP is an s-expression. If the evaluation of SEXP is non-nil, FUNCTION
-is called. FUNCTION is a Lisp function which is called with the MML
-handle to tweak the part.")
-
-(defvar mml-externalize-attachments nil
- "*If non-nil, local-file attachments are generated as external parts.")
-
-(defvar mml-generate-multipart-alist nil
- "*Alist of multipart generation functions.
-Each entry has the form (NAME . FUNCTION), where
-NAME is a string containing the name of the part (without the
-leading \"/multipart/\"),
-FUNCTION is a Lisp function which is called to generate the part.
-
-The Lisp function has to supply the appropriate MIME headers and the
-contents of this part.")
-
-(defvar mml-syntax-table
- (let ((table (copy-syntax-table emacs-lisp-mode-syntax-table)))
- (modify-syntax-entry ?\\ "/" table)
- (modify-syntax-entry ?< "(" table)
- (modify-syntax-entry ?> ")" table)
- (modify-syntax-entry ?@ "w" table)
- (modify-syntax-entry ?/ "w" table)
- (modify-syntax-entry ?= " " table)
- (modify-syntax-entry ?* " " table)
- (modify-syntax-entry ?\; " " table)
- (modify-syntax-entry ?\' " " table)
- table))
-
-(defvar mml-boundary-function 'mml-make-boundary
- "A function called to suggest a boundary.
-The function may be called several times, and should try to make a new
-suggestion each time. The function is called with one parameter,
-which is a number that says how many times the function has been
-called for this message.")
-
-(defvar mml-confirmation-set nil
- "A list of symbols, each of which disables some warning.
-`unknown-encoding': always send messages contain characters with
-unknown encoding; `use-ascii': always use ASCII for those characters
-with unknown encoding; `multipart': always send messages with more than
-one charsets.")
-
-(defvar mml-generate-default-type "text/plain"
- "Content type by which the Content-Type header can be omitted.
-The Content-Type header will not be put in the MIME part if the type
-equals the value and there's no parameter (e.g. charset, format, etc.)
-and `mml-insert-mime-headers-always' is nil. The value will be bound
-to \"message/rfc822\" when encoding an article to be forwarded as a MIME
-part. This is for the internal use, you should never modify the value.")
-
-(defvar mml-buffer-list nil)
-
-(defun mml-generate-new-buffer (name)
- (let ((buf (generate-new-buffer name)))
- (push buf mml-buffer-list)
- buf))
-
-(defun mml-destroy-buffers ()
- (let (kill-buffer-hook)
- (mapcar 'kill-buffer mml-buffer-list)
- (setq mml-buffer-list nil)))
-
-(defun mml-parse ()
- "Parse the current buffer as an MML document."
- (save-excursion
- (goto-char (point-min))
- (let ((table (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table mml-syntax-table)
- (mml-parse-1))
- (set-syntax-table table)))))
-
-(defun mml-parse-1 ()
- "Parse the current buffer as an MML document."
- (let (struct tag point contents charsets warn use-ascii no-markup-p raw)
- (while (and (not (eobp))
- (not (looking-at "<#/multipart")))
- (cond
- ((looking-at "<#secure")
- ;; The secure part is essentially a meta-meta tag, which
- ;; expands to either a part tag if there are no other parts in
- ;; the document or a multipart tag if there are other parts
- ;; included in the message
- (let* (secure-mode
- (taginfo (mml-read-tag))
- (recipients (cdr (assq 'recipients taginfo)))
- (sender (cdr (assq 'sender taginfo)))
- (location (cdr (assq 'tag-location taginfo)))
- (mode (cdr (assq 'mode taginfo)))
- (method (cdr (assq 'method taginfo)))
- tags)
- (save-excursion
- (if
- (re-search-forward
- "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
- (setq secure-mode "multipart")
- (setq secure-mode "part")))
- (save-excursion
- (goto-char location)
- (re-search-forward "<#secure[^\n]*>\n"))
- (delete-region (match-beginning 0) (match-end 0))
- (cond ((string= mode "sign")
- (setq tags (list "sign" method)))
- ((string= mode "encrypt")
- (setq tags (list "encrypt" method)))
- ((string= mode "signencrypt")
- (setq tags (list "sign" method "encrypt" method))))
- (eval `(mml-insert-tag ,secure-mode
- ,@tags
- ,(if recipients "recipients")
- ,recipients
- ,(if sender "sender")
- ,sender))
- ;; restart the parse
- (goto-char location)))
- ((looking-at "<#multipart")
- (push (nconc (mml-read-tag) (mml-parse-1)) struct))
- ((looking-at "<#external")
- (push (nconc (mml-read-tag) (list (cons 'contents (mml-read-part))))
- struct))
- (t
- (if (or (looking-at "<#part") (looking-at "<#mml"))
- (setq tag (mml-read-tag)
- no-markup-p nil
- warn nil)
- (setq tag (list 'part '(type . "text/plain"))
- no-markup-p t
- warn t))
- (setq raw (cdr (assq 'raw tag))
- point (point)
- contents (mml-read-part (eq 'mml (car tag)))
- charsets (cond
- (raw nil)
- ((assq 'charset tag)
- (list
- (intern (downcase (cdr (assq 'charset tag))))))
- (t
- (mm-find-mime-charset-region point (point)
- mm-hack-charsets))))
- (when (and (not raw) (memq nil charsets))
- (if (or (memq 'unknown-encoding mml-confirmation-set)
- (message-options-get 'unknown-encoding)
- (and (y-or-n-p "\
-Message contains characters with unknown encoding. Really send? ")
- (message-options-set 'unknown-encoding t)))
- (if (setq use-ascii
- (or (memq 'use-ascii mml-confirmation-set)
- (message-options-get 'use-ascii)
- (and (y-or-n-p "Use ASCII as charset? ")
- (message-options-set 'use-ascii t))))
- (setq charsets (delq nil charsets))
- (setq warn nil))
- (error "Edit your message to remove those characters")))
- (if (or raw
- (eq 'mml (car tag))
- (< (length charsets) 2))
- (if (or (not no-markup-p)
- (string-match "[^ \t\r\n]" contents))
- ;; Don't create blank parts.
- (push (nconc tag (list (cons 'contents contents)))
- struct))
- (let ((nstruct (mml-parse-singlepart-with-multiple-charsets
- tag point (point) use-ascii)))
- (when (and warn
- (not (memq 'multipart mml-confirmation-set))
- (not (message-options-get 'multipart))
- (not (and (y-or-n-p (format "\
-A message part needs to be split into %d charset parts. Really send? "
- (length nstruct)))
- (message-options-set 'multipart t))))
- (error "Edit your message to use only one charset"))
- (setq struct (nconc nstruct struct)))))))
- (unless (eobp)
- (forward-line 1))
- (nreverse struct)))
-
-(defun mml-parse-singlepart-with-multiple-charsets
- (orig-tag beg end &optional use-ascii)
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char (point-min))
- (let ((current (or (mm-mime-charset (mm-charset-after))
- (and use-ascii 'us-ascii)))
- charset struct space newline paragraph)
- (while (not (eobp))
- (setq charset (mm-mime-charset (mm-charset-after)))
- (cond
- ;; The charset remains the same.
- ((eq charset 'us-ascii))
- ((or (and use-ascii (not charset))
- (eq charset current))
- (setq space nil
- newline nil
- paragraph nil))
- ;; The initial charset was ascii.
- ((eq current 'us-ascii)
- (setq current charset
- space nil
- newline nil
- paragraph nil))
- ;; We have a change in charsets.
- (t
- (push (append
- orig-tag
- (list (cons 'contents
- (buffer-substring-no-properties
- beg (or paragraph newline space (point))))))
- struct)
- (setq beg (or paragraph newline space (point))
- current charset
- space nil
- newline nil
- paragraph nil)))
- ;; Compute places where it might be nice to break the part.
- (cond
- ((memq (following-char) '(? ?\t))
- (setq space (1+ (point))))
- ((and (eq (following-char) ?\n)
- (not (bobp))
- (eq (char-after (1- (point))) ?\n))
- (setq paragraph (point)))
- ((eq (following-char) ?\n)
- (setq newline (1+ (point)))))
- (forward-char 1))
- ;; Do the final part.
- (unless (= beg (point))
- (push (append orig-tag
- (list (cons 'contents
- (buffer-substring-no-properties
- beg (point)))))
- struct))
- struct))))
-
-(defun mml-read-tag ()
- "Read a tag and return the contents."
- (let ((orig-point (point))
- contents name elem val)
- (forward-char 2)
- (setq name (buffer-substring-no-properties
- (point) (progn (forward-sexp 1) (point))))
- (skip-chars-forward " \t\n")
- (while (not (looking-at ">[ \t]*\n?"))
- (setq elem (buffer-substring-no-properties
- (point) (progn (forward-sexp 1) (point))))
- (skip-chars-forward "= \t\n")
- (setq val (buffer-substring-no-properties
- (point) (progn (forward-sexp 1) (point))))
- (when (string-match "^\"\\(.*\\)\"$" val)
- (setq val (match-string 1 val)))
- (push (cons (intern elem) val) contents)
- (skip-chars-forward " \t\n"))
- (goto-char (match-end 0))
- ;; Don't skip the leading space.
- ;;(skip-chars-forward " \t\n")
- ;; Put the tag location into the returned contents
- (setq contents (append (list (cons 'tag-location orig-point)) contents))
- (cons (intern name) (nreverse contents))))
-
-(defun mml-buffer-substring-no-properties-except-hard-newlines (start end)
- (let ((str (buffer-substring-no-properties start end))
- (bufstart start) tmp)
- (while (setq tmp (text-property-any start end 'hard 't))
- (set-text-properties (- tmp bufstart) (- tmp bufstart -1)
- '(hard t) str)
- (setq start (1+ tmp)))
- str))
-
-(defun mml-read-part (&optional mml)
- "Return the buffer up till the next part, multipart or closing part or multipart.
-If MML is non-nil, return the buffer up till the correspondent mml tag."
- (let ((beg (point)) (count 1))
- ;; If the tag ended at the end of the line, we go to the next line.
- (when (looking-at "[ \t]*\n")
- (forward-line 1))
- (if mml
- (progn
- (while (and (> count 0) (not (eobp)))
- (if (re-search-forward "<#\\(/\\)?mml." nil t)
- (setq count (+ count (if (match-beginning 1) -1 1)))
- (goto-char (point-max))))
- (mml-buffer-substring-no-properties-except-hard-newlines
- beg (if (> count 0)
- (point)
- (match-beginning 0))))
- (if (re-search-forward
- "<#\\(/\\)?\\(multipart\\|part\\|external\\|mml\\)." nil t)
- (prog1
- (mml-buffer-substring-no-properties-except-hard-newlines
- beg (match-beginning 0))
- (if (or (not (match-beginning 1))
- (equal (match-string 2) "multipart"))
- (goto-char (match-beginning 0))
- (when (looking-at "[ \t]*\n")
- (forward-line 1))))
- (mml-buffer-substring-no-properties-except-hard-newlines
- beg (goto-char (point-max)))))))
-
-(defvar mml-boundary nil)
-(defvar mml-base-boundary "-=-=")
-(defvar mml-multipart-number 0)
-
-(defun mml-generate-mime ()
- "Generate a MIME message based on the current MML document."
- (let ((cont (mml-parse))
- (mml-multipart-number mml-multipart-number))
- (if (not cont)
- nil
- (mm-with-multibyte-buffer
- (if (and (consp (car cont))
- (= (length cont) 1))
- (mml-generate-mime-1 (car cont))
- (mml-generate-mime-1 (nconc (list 'multipart '(type . "mixed"))
- cont)))
- (buffer-string)))))
-
-(defun mml-generate-mime-1 (cont)
- (let ((mm-use-ultra-safe-encoding
- (or mm-use-ultra-safe-encoding (assq 'sign cont))))
- (save-restriction
- (narrow-to-region (point) (point))
- (mml-tweak-part cont)
- (cond
- ((or (eq (car cont) 'part) (eq (car cont) 'mml))
- (let* ((raw (cdr (assq 'raw cont)))
- (filename (cdr (assq 'filename cont)))
- (type (or (cdr (assq 'type cont))
- (if filename
- (or (mm-default-file-encoding filename)
- "application/octet-stream")
- "text/plain")))
- coded encoding charset flowed)
- (if (and (not raw)
- (member (car (split-string type "/")) '("text" "message")))
- (progn
- (with-temp-buffer
- (setq charset (mm-charset-to-coding-system
- (cdr (assq 'charset cont))))
- (when (eq charset 'ascii)
- (setq charset nil))
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and filename
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (let ((coding-system-for-read charset))
- (mm-insert-file-contents filename)))
- ((eq 'mml (car cont))
- (insert (cdr (assq 'contents cont))))
- (t
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (cdr (assq 'contents cont)))
- ;; Remove quotes from quoted tags.
- (goto-char (point-min))
- (while (re-search-forward
- "<#!+/?\\(part\\|multipart\\|external\\|mml\\)"
- nil t)
- (delete-region (+ (match-beginning 0) 2)
- (+ (match-beginning 0) 3))))))
- (cond
- ((eq (car cont) 'mml)
- (let ((mml-boundary (mml-compute-boundary cont))
- ;; It is necessary for the case where this
- ;; function is called recursively since
- ;; `m-g-d-t' will be bound to "message/rfc822"
- ;; when encoding an article to be forwarded.
- (mml-generate-default-type "text/plain"))
- (mml-to-mime))
- (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
- ;; ignore 0x1b, it is part of iso-2022-jp
- (setq encoding (mm-body-7-or-8))))
- ((string= (car (split-string type "/")) "message")
- (let ((mm-7bit-chars (concat mm-7bit-chars "\x1b")))
- ;; ignore 0x1b, it is part of iso-2022-jp
- (setq encoding (mm-body-7-or-8))))
- (t
- ;; Only perform format=flowed filling on text/plain
- ;; parts where there either isn't a format parameter
- ;; in the mml tag or it says "flowed" and there
- ;; actually are hard newlines in the text.
- (let (use-hard-newlines)
- (when (and (string= type "text/plain")
- (not (string= (cdr (assq 'sign cont)) "pgp"))
- (or (null (assq 'format cont))
- (string= (cdr (assq 'format cont))
- "flowed"))
- (setq use-hard-newlines
- (text-property-any
- (point-min) (point-max) 'hard 't)))
- (fill-flowed-encode)
- ;; Indicate that `mml-insert-mime-headers' should
- ;; insert a "; format=flowed" string unless the
- ;; user has already specified it.
- (setq flowed (null (assq 'format cont)))))
- (setq charset (mm-encode-body charset))
- (setq encoding (mm-body-encoding
- charset (cdr (assq 'encoding cont))))))
- (setq coded (buffer-string)))
- (mml-insert-mime-headers cont type charset encoding flowed)
- (insert "\n")
- (insert coded))
- (mm-with-unibyte-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert (mm-string-as-unibyte
- (with-current-buffer (cdr (assq 'buffer cont))
- (buffer-string)))))
- ((and filename
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (let ((coding-system-for-read mm-binary-coding-system))
- (mm-insert-file-contents filename nil nil nil nil t)))
- (t
- (let ((contents (cdr (assq 'contents cont))))
- (if (if (featurep 'xemacs)
- (string-match "[^\000-\377]" contents)
- (mm-multibyte-string-p contents))
- (progn
- (mm-enable-multibyte)
- (insert contents)
- (unless raw
- (setq charset (mm-encode-body))))
- (insert contents)))))
- (setq encoding (mm-encode-buffer type)
- coded (mm-string-as-multibyte (buffer-string))))
- (mml-insert-mime-headers cont type charset encoding nil)
- (insert "\n" coded))))
- ((eq (car cont) 'external)
- (insert "Content-Type: message/external-body")
- (let ((parameters (mml-parameter-string
- cont '(expiration size permission)))
- (name (cdr (assq 'name cont)))
- (url (cdr (assq 'url cont))))
- (when name
- (setq name (mml-parse-file-name name))
- (if (stringp name)
- (mml-insert-parameter
- (mail-header-encode-parameter "name" name)
- "access-type=local-file")
- (mml-insert-parameter
- (mail-header-encode-parameter
- "name" (file-name-nondirectory (nth 2 name)))
- (mail-header-encode-parameter "site" (nth 1 name))
- (mail-header-encode-parameter
- "directory" (file-name-directory (nth 2 name))))
- (mml-insert-parameter
- (concat "access-type="
- (if (member (nth 0 name) '("ftp@" "anonymous@"))
- "anon-ftp"
- "ftp")))))
- (when url
- (mml-insert-parameter
- (mail-header-encode-parameter "url" url)
- "access-type=url"))
- (when parameters
- (mml-insert-parameter-string
- cont '(expiration size permission)))
- (insert "\n\n")
- (insert "Content-Type: "
- (or (cdr (assq 'type cont))
- (if name
- (or (mm-default-file-encoding name)
- "application/octet-stream")
- "text/plain"))
- "\n")
- (insert "Content-ID: " (message-make-message-id) "\n")
- (insert "Content-Transfer-Encoding: "
- (or (cdr (assq 'encoding cont)) "binary"))
- (insert "\n\n")
- (insert (or (cdr (assq 'contents cont))))
- (insert "\n")))
- ((eq (car cont) 'multipart)
- (let* ((type (or (cdr (assq 'type cont)) "mixed"))
- (mml-generate-default-type (if (equal type "digest")
- "message/rfc822"
- "text/plain"))
- (handler (assoc type mml-generate-multipart-alist)))
- (if handler
- (funcall (cdr handler) cont)
- ;; No specific handler. Use default one.
- (let ((mml-boundary (mml-compute-boundary cont)))
- (insert (format "Content-Type: multipart/%s; boundary=\"%s\""
- type mml-boundary)
- (if (cdr (assq 'start cont))
- (format "; start=\"%s\"\n" (cdr (assq 'start cont)))
- "\n"))
- (let ((cont cont) part)
- (while (setq part (pop cont))
- ;; Skip `multipart' and attributes.
- (when (and (consp part) (consp (cdr part)))
- (insert "\n--" mml-boundary "\n")
- (mml-generate-mime-1 part)
- (goto-char (point-max)))))
- (insert "\n--" mml-boundary "--\n")))))
- (t
- (error "Invalid element: %S" cont)))
- ;; handle sign & encrypt tags in a semi-smart way.
- (let ((sign-item (assoc (cdr (assq 'sign cont)) mml-sign-alist))
- (encrypt-item (assoc (cdr (assq 'encrypt cont))
- mml-encrypt-alist))
- sender recipients)
- (when (or sign-item encrypt-item)
- (when (setq sender (cdr (assq 'sender cont)))
- (message-options-set 'mml-sender sender)
- (message-options-set 'message-sender sender))
- (if (setq recipients (cdr (assq 'recipients cont)))
- (message-options-set 'message-recipients recipients))
- (let ((style (mml-signencrypt-style
- (first (or sign-item encrypt-item)))))
- ;; check if: we're both signing & encrypting, both methods
- ;; are the same (why would they be different?!), and that
- ;; the signencrypt style allows for combined operation.
- (if (and sign-item encrypt-item (equal (first sign-item)
- (first encrypt-item))
- (equal style 'combined))
- (funcall (nth 1 encrypt-item) cont t)
- ;; otherwise, revert to the old behavior.
- (when sign-item
- (funcall (nth 1 sign-item) cont))
- (when encrypt-item
- (funcall (nth 1 encrypt-item) cont)))))))))
-
-(defun mml-compute-boundary (cont)
- "Return a unique boundary that does not exist in CONT."
- (let ((mml-boundary (funcall mml-boundary-function
- (incf mml-multipart-number))))
- ;; This function tries again and again until it has found
- ;; a unique boundary.
- (while (not (catch 'not-unique
- (mml-compute-boundary-1 cont))))
- mml-boundary))
-
-(defun mml-compute-boundary-1 (cont)
- (let (filename)
- (cond
- ((eq (car cont) 'part)
- (with-temp-buffer
- (cond
- ((cdr (assq 'buffer cont))
- (insert-buffer-substring (cdr (assq 'buffer cont))))
- ((and (setq filename (cdr (assq 'filename cont)))
- (not (equal (cdr (assq 'nofile cont)) "yes")))
- (mm-insert-file-contents filename nil nil nil nil t))
- (t
- (insert (cdr (assq 'contents cont)))))
- (goto-char (point-min))
- (when (re-search-forward (concat "^--" (regexp-quote mml-boundary))
- nil t)
- (setq mml-boundary (funcall mml-boundary-function
- (incf mml-multipart-number)))
- (throw 'not-unique nil))))
- ((eq (car cont) 'multipart)
- (mapcar 'mml-compute-boundary-1 (cddr cont))))
- t))
-
-(defun mml-make-boundary (number)
- (concat (make-string (% number 60) ?=)
- (if (> number 17)
- (format "%x" number)
- "")
- mml-base-boundary))
-
-(defun mml-insert-mime-headers (cont type charset encoding flowed)
- (let (parameters id disposition description)
- (setq parameters
- (mml-parameter-string
- cont mml-content-type-parameters))
- (when (or charset
- parameters
- flowed
- (not (equal type mml-generate-default-type))
- mml-insert-mime-headers-always)
- (when (consp charset)
- (error
- "Can't encode a part with several charsets"))
- (insert "Content-Type: " type)
- (when charset
- (mml-insert-parameter
- (mail-header-encode-parameter "charset" (symbol-name charset))))
- (when flowed
- (mml-insert-parameter "format=flowed"))
- (when parameters
- (mml-insert-parameter-string
- cont mml-content-type-parameters))
- (insert "\n"))
- (when (setq id (cdr (assq 'id cont)))
- (insert "Content-ID: " id "\n"))
- (setq parameters
- (mml-parameter-string
- cont mml-content-disposition-parameters))
- (when (or (setq disposition (cdr (assq 'disposition cont)))
- parameters)
- (insert "Content-Disposition: " (or disposition "inline"))
- (when parameters
- (mml-insert-parameter-string
- cont mml-content-disposition-parameters))
- (insert "\n"))
- (unless (eq encoding '7bit)
- (insert (format "Content-Transfer-Encoding: %s\n" encoding)))
- (when (setq description (cdr (assq 'description cont)))
- (insert "Content-Description: ")
- (setq description (prog1
- (point)
- (insert description "\n")))
- (mail-encode-encoded-word-region description (point)))))
-
-(defun mml-parameter-string (cont types)
- (let ((string "")
- value type)
- (while (setq type (pop types))
- (when (setq value (cdr (assq type cont)))
- ;; Strip directory component from the filename parameter.
- (when (eq type 'filename)
- (setq value (file-name-nondirectory value)))
- (setq string (concat string "; "
- (mail-header-encode-parameter
- (symbol-name type) value)))))
- (when (not (zerop (length string)))
- string)))
-
-(defun mml-insert-parameter-string (cont types)
- (let (value type)
- (while (setq type (pop types))
- (when (setq value (cdr (assq type cont)))
- ;; Strip directory component from the filename parameter.
- (when (eq type 'filename)
- (setq value (file-name-nondirectory value)))
- (mml-insert-parameter
- (mail-header-encode-parameter
- (symbol-name type) value))))))
-
-(eval-when-compile
- (defvar ange-ftp-name-format)
- (defvar efs-path-regexp))
-(defun mml-parse-file-name (path)
- (if (if (boundp 'efs-path-regexp)
- (string-match efs-path-regexp path)
- (if (boundp 'ange-ftp-name-format)
- (string-match (car ange-ftp-name-format) path)))
- (list (match-string 1 path) (match-string 2 path)
- (substring path (1+ (match-end 2))))
- path))
-
-(defun mml-insert-buffer (buffer)
- "Insert BUFFER at point and quote any MML markup."
- (save-restriction
- (narrow-to-region (point) (point))
- (insert-buffer-substring buffer)
- (mml-quote-region (point-min) (point-max))
- (goto-char (point-max))))
-
-;;;
-;;; Transforming MIME to MML
-;;;
-
-(defun mime-to-mml (&optional handles)
- "Translate the current buffer (which should be a message) into MML.
-If HANDLES is non-nil, use it instead reparsing the buffer."
- ;; First decode the head.
- (save-restriction
- (message-narrow-to-head)
- (let ((rfc2047-quote-decoded-words-containing-tspecials t))
- (mail-decode-encoded-word-region (point-min) (point-max))))
- (unless handles
- (setq handles (mm-dissect-buffer t)))
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (delete-region (point) (point-max))
- (if (stringp (car handles))
- (mml-insert-mime handles)
- (mml-insert-mime handles t))
- (mm-destroy-parts handles)
- (save-restriction
- (message-narrow-to-head)
- ;; Remove them, they are confusing.
- (message-remove-header "Content-Type")
- (message-remove-header "MIME-Version")
- (message-remove-header "Content-Disposition")
- (message-remove-header "Content-Transfer-Encoding")))
-
-(defun mml-to-mime ()
- "Translate the current buffer from MML to MIME."
- (message-encode-message-body)
- (save-restriction
- (message-narrow-to-headers-or-head)
- ;; Skip past any From_ headers.
- (while (looking-at "From ")
- (forward-line 1))
- (let ((mail-parse-charset message-default-charset))
- (mail-encode-encoded-word-buffer))))
-
-(defun mml-insert-mime (handle &optional no-markup)
- (let (textp buffer mmlp)
- ;; Determine type and stuff.
- (unless (stringp (car handle))
- (unless (setq textp (equal (mm-handle-media-supertype handle) "text"))
- (save-excursion
- (set-buffer (setq buffer (mml-generate-new-buffer " *mml*")))
- (mm-insert-part handle 'no-cache)
- (if (setq mmlp (equal (mm-handle-media-type handle)
- "message/rfc822"))
- (mime-to-mml)))))
- (if mmlp
- (mml-insert-mml-markup handle nil t t)
- (unless (and no-markup
- (equal (mm-handle-media-type handle) "text/plain"))
- (mml-insert-mml-markup handle buffer textp)))
- (cond
- (mmlp
- (insert-buffer-substring buffer)
- (goto-char (point-max))
- (insert "<#/mml>\n"))
- ((stringp (car handle))
- (mapcar 'mml-insert-mime (cdr handle))
- (insert "<#/multipart>\n"))
- (textp
- (let ((charset (mail-content-type-get
- (mm-handle-type handle) 'charset))
- (start (point)))
- (if (eq charset 'gnus-decoded)
- (mm-insert-part handle)
- (insert (mm-decode-string (mm-get-part handle) charset)))
- (mml-quote-region start (point)))
- (goto-char (point-max)))
- (t
- (insert "<#/part>\n")))))
-
-(defun mml-insert-mml-markup (handle &optional buffer nofile mmlp)
- "Take a MIME handle and insert an MML tag."
- (if (stringp (car handle))
- (progn
- (insert "<#multipart type=" (mm-handle-media-subtype handle))
- (let ((start (mm-handle-multipart-ctl-parameter handle 'start)))
- (when start
- (insert " start=\"" start "\"")))
- (insert ">\n"))
- (if mmlp
- (insert "<#mml type=" (mm-handle-media-type handle))
- (insert "<#part type=" (mm-handle-media-type handle)))
- (dolist (elem (append (cdr (mm-handle-type handle))
- (cdr (mm-handle-disposition handle))))
- (unless (symbolp (cdr elem))
- (insert " " (symbol-name (car elem)) "=\"" (cdr elem) "\"")))
- (when (mm-handle-id handle)
- (insert " id=\"" (mm-handle-id handle) "\""))
- (when (mm-handle-disposition handle)
- (insert " disposition=" (car (mm-handle-disposition handle))))
- (when buffer
- (insert " buffer=\"" (buffer-name buffer) "\""))
- (when nofile
- (insert " nofile=yes"))
- (when (mm-handle-description handle)
- (insert " description=\"" (mm-handle-description handle) "\""))
- (insert ">\n")))
-
-(defun mml-insert-parameter (&rest parameters)
- "Insert PARAMETERS in a nice way."
- (let (start end)
- (dolist (param parameters)
- (insert ";")
- (setq start (point))
- (insert " " param)
- (setq end (point))
- (goto-char start)
- (end-of-line)
- (if (> (current-column) 76)
- (progn
- (goto-char start)
- (insert "\n")
- (goto-char (1+ end)))
- (goto-char end)))))
-
-;;;
-;;; Mode for inserting and editing MML forms
-;;;
-
-(defvar mml-mode-map
- (let ((sign (make-sparse-keymap))
- (encrypt (make-sparse-keymap))
- (signpart (make-sparse-keymap))
- (encryptpart (make-sparse-keymap))
- (map (make-sparse-keymap))
- (main (make-sparse-keymap)))
- (define-key map "\C-s" 'mml-secure-message-sign)
- (define-key map "\C-c" 'mml-secure-message-encrypt)
- (define-key map "\C-e" 'mml-secure-message-sign-encrypt)
- (define-key map "\C-p\C-s" 'mml-secure-sign)
- (define-key map "\C-p\C-c" 'mml-secure-encrypt)
- (define-key sign "p" 'mml-secure-message-sign-pgpmime)
- (define-key sign "o" 'mml-secure-message-sign-pgp)
- (define-key sign "s" 'mml-secure-message-sign-smime)
- (define-key signpart "p" 'mml-secure-sign-pgpmime)
- (define-key signpart "o" 'mml-secure-sign-pgp)
- (define-key signpart "s" 'mml-secure-sign-smime)
- (define-key encrypt "p" 'mml-secure-message-encrypt-pgpmime)
- (define-key encrypt "o" 'mml-secure-message-encrypt-pgp)
- (define-key encrypt "s" 'mml-secure-message-encrypt-smime)
- (define-key encryptpart "p" 'mml-secure-encrypt-pgpmime)
- (define-key encryptpart "o" 'mml-secure-encrypt-pgp)
- (define-key encryptpart "s" 'mml-secure-encrypt-smime)
- (define-key map "\C-n" 'mml-unsecure-message)
- (define-key map "f" 'mml-attach-file)
- (define-key map "b" 'mml-attach-buffer)
- (define-key map "e" 'mml-attach-external)
- (define-key map "q" 'mml-quote-region)
- (define-key map "m" 'mml-insert-multipart)
- (define-key map "p" 'mml-insert-part)
- (define-key map "v" 'mml-validate)
- (define-key map "P" 'mml-preview)
- (define-key map "s" sign)
- (define-key map "S" signpart)
- (define-key map "c" encrypt)
- (define-key map "C" encryptpart)
- ;;(define-key map "n" 'mml-narrow-to-part)
- ;; `M-m' conflicts with `back-to-indentation'.
- ;; (define-key main "\M-m" map)
- (define-key main "\C-c\C-m" map)
- main))
-
-(easy-menu-define
- mml-menu mml-mode-map ""
- `("Attachments"
- ["Attach File..." mml-attach-file
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a file at point"))]
- ["Attach Buffer..." mml-attach-buffer
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach a buffer to the outgoing MIME message"))]
- ["Attach External..." mml-attach-external
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Attach reference to file"))]
- ;;
- ("Change Security Method"
- ["PGP/MIME"
- (lambda () (interactive) (setq mml-secure-method "pgpmime"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to PGP/MIME"))
- :style radio
- :selected (equal mml-secure-method "pgpmime") ]
- ["S/MIME"
- (lambda () (interactive) (setq mml-secure-method "smime"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to S/MIME"))
- :style radio
- :selected (equal mml-secure-method "smime") ]
- ["Inline PGP"
- (lambda () (interactive) (setq mml-secure-method "pgp"))
- ,@(if (featurep 'xemacs) nil
- '(:help "Set Security Method to inline PGP"))
- :style radio
- :selected (equal mml-secure-method "pgp") ] )
- ;;
- ["Sign Message" mml-secure-message-sign t]
- ["Encrypt Message" mml-secure-message-encrypt t]
- ["Sign and Encrypt Message" mml-secure-message-sign-encrypt t]
- ["Encrypt/Sign off" mml-unsecure-message
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Don't Encrypt/Sign Message"))]
- ;; Maybe we could remove these, because people who write MML most probably
- ;; don't use the menu:
- ["Insert Part..." mml-insert-part
- :active (message-in-body-p)]
- ["Insert Multipart..." mml-insert-multipart
- :active (message-in-body-p)]
- ;;
- ;; Do we have separate encrypt and encrypt/sign commands for parts?
- ["Sign Part" mml-secure-sign t]
- ["Encrypt Part" mml-secure-encrypt t]
- ;;["Narrow" mml-narrow-to-part t]
- ["Quote MML in region" mml-quote-region
- :active (message-mark-active-p)
- ,@(if (featurep 'xemacs) nil
- '(:help "Quote MML tags in region"))]
- ["Validate MML" mml-validate t]
- ["Preview" mml-preview t]
- "----"
- ["Emacs MIME manual" (lambda () (interactive) (message-info 4))
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the Emacs MIME manual"))]
- ["PGG manual" (lambda () (interactive) (message-info 16))
- ,@(if (featurep 'xemacs) '(t)
- '(:help "Display the PGG manual"))]))
-
-(defvar mml-mode nil
- "Minor mode for editing MML.")
-
-(defun mml-mode (&optional arg)
- "Minor mode for editing MML.
-MML is the MIME Meta Language, a minor mode for composing MIME articles.
-See Info node `(emacs-mime)Composing'.
-
-\\{mml-mode-map}"
- (interactive "P")
- (when (set (make-local-variable 'mml-mode)
- (if (null arg) (not mml-mode)
- (> (prefix-numeric-value arg) 0)))
- (add-minor-mode 'mml-mode " MML" mml-mode-map)
- (easy-menu-add mml-menu mml-mode-map)
- (when (boundp 'dnd-protocol-alist)
- (set (make-local-variable 'dnd-protocol-alist)
- (append mml-dnd-protocol-alist dnd-protocol-alist)))
- (run-hooks 'mml-mode-hook)))
-
-;;;
-;;; Helper functions for reading MIME stuff from the minibuffer and
-;;; inserting stuff to the buffer.
-;;;
-
-(defun mml-minibuffer-read-file (prompt)
- (let* ((completion-ignored-extensions nil)
- (file (read-file-name prompt nil nil t)))
- ;; Prevent some common errors. This is inspired by similar code in
- ;; VM.
- (when (file-directory-p file)
- (error "%s is a directory, cannot attach" file))
- (unless (file-exists-p file)
- (error "No such file: %s" file))
- (unless (file-readable-p file)
- (error "Permission denied: %s" file))
- file))
-
-(defun mml-minibuffer-read-type (name &optional default)
- (mailcap-parse-mimetypes)
- (let* ((default (or default
- (mm-default-file-encoding name)
- ;; Perhaps here we should check what the file
- ;; looks like, and offer text/plain if it looks
- ;; like text/plain.
- "application/octet-stream"))
- (string (completing-read
- (format "Content type (default %s): " default)
- (mapcar 'list (mailcap-mime-types)))))
- (if (not (equal string ""))
- string
- default)))
-
-(defun mml-minibuffer-read-description ()
- (let ((description (read-string "One line description: ")))
- (when (string-match "\\`[ \t]*\\'" description)
- (setq description nil))
- description))
-
-(defun mml-minibuffer-read-disposition (type &optional default)
- (unless default (setq default
- (if (and (string-match "\\`text/" type)
- (not (string-match "\\`text/rtf\\'" type)))
- "inline"
- "attachment")))
- (let ((disposition (completing-read
- (format "Disposition (default %s): " default)
- '(("attachment") ("inline") (""))
- nil t nil nil default)))
- (if (not (equal disposition ""))
- disposition
- default)))
-
-(defun mml-quote-region (beg end)
- "Quote the MML tags in the region."
- (interactive "r")
- (save-excursion
- (save-restriction
- ;; Temporarily narrow the region to defend from changes
- ;; invalidating END.
- (narrow-to-region beg end)
- (goto-char (point-min))
- ;; Quote parts.
- (while (re-search-forward
- "<#!*/?\\(multipart\\|part\\|external\\|mml\\)" nil t)
- ;; Insert ! after the #.
- (goto-char (+ (match-beginning 0) 2))
- (insert "!")))))
-
-(defun mml-insert-tag (name &rest plist)
- "Insert an MML tag described by NAME and PLIST."
- (when (symbolp name)
- (setq name (symbol-name name)))
- (insert "<#" name)
- (while plist
- (let ((key (pop plist))
- (value (pop plist)))
- (when value
- ;; Quote VALUE if it contains suspicious characters.
- (when (string-match "[\"'\\~/*;() \t\n]" value)
- (setq value (with-output-to-string
- (let (print-escape-nonascii)
- (prin1 value)))))
- (insert (format " %s=%s" key value)))))
- (insert ">\n"))
-
-(defun mml-insert-empty-tag (name &rest plist)
- "Insert an empty MML tag described by NAME and PLIST."
- (when (symbolp name)
- (setq name (symbol-name name)))
- (apply #'mml-insert-tag name plist)
- (insert "<#/" name ">\n"))
-
-;;; Attachment functions.
-
-(defcustom mml-dnd-protocol-alist
- '(("^file:///" . mml-dnd-attach-file)
- ("^file://" . dnd-open-file)
- ("^file:" . mml-dnd-attach-file))
- "The functions to call when a drop in `mml-mode' is made.
-See `dnd-protocol-alist' for more information. When nil, behave
-as in other buffers."
- :type '(choice (repeat (cons (regexp) (function)))
- (const :tag "Behave as in other buffers" nil))
- :version "22.1" ;; Gnus 5.10.9
- :group 'message)
-
-(defcustom mml-dnd-attach-options nil
- "Which options should be queried when attaching a file via drag and drop.
-
-If it is a list, valid members are `type', `description' and
-`disposition'. `disposition' implies `type'. If it is nil,
-don't ask for options. If it is t, ask the user whether or not
-to specify options."
- :type '(choice
- (const :tag "Non" nil)
- (const :tag "Query" t)
- (list :value (type description disposition)
- (set :inline t
- (const type)
- (const description)
- (const disposition))))
- :version "22.1" ;; Gnus 5.10.9
- :group 'message)
-
-(defun mml-attach-file (file &optional type description disposition)
- "Attach a file to the outgoing MIME message.
-The file is not inserted or encoded until you send the message with
-`\\[message-send-and-exit]' or `\\[message-send]'.
-
-FILE is the name of the file to attach. TYPE is its
-content-type, a string of the form \"type/subtype\". DESCRIPTION
-is a one-line description of the attachment. The DISPOSITION
-specifies how the attachment is intended to be displayed. It can
-be either \"inline\" (displayed automatically within the message
-body) or \"attachment\" (separate from the body)."
- (interactive
- (let* ((file (mml-minibuffer-read-file "Attach file: "))
- (type (mml-minibuffer-read-type file))
- (description (mml-minibuffer-read-description))
- (disposition (mml-minibuffer-read-disposition type)))
- (list file type description disposition)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
- (mml-insert-empty-tag 'part
- 'type type
- 'filename file
- 'disposition (or disposition "attachment")
- 'description description)))
-
-(defun mml-dnd-attach-file (uri action)
- "Attach a drag and drop file.
-
-Ask for type, description or disposition according to
-`mml-dnd-attach-options'."
- (let ((file (dnd-get-local-file-name uri t)))
- (when (and file (file-regular-p file))
- (let ((mml-dnd-attach-options mml-dnd-attach-options)
- type description disposition)
- (setq mml-dnd-attach-options
- (when (and (eq mml-dnd-attach-options t)
- (not
- (y-or-n-p
- "Use default type, disposition and description? ")))
- '(type description disposition)))
- (when (or (memq 'type mml-dnd-attach-options)
- (memq 'disposition mml-dnd-attach-options))
- (setq type (mml-minibuffer-read-type file)))
- (when (memq 'description mml-dnd-attach-options)
- (setq description (mml-minibuffer-read-description)))
- (when (memq 'disposition mml-dnd-attach-options)
- (setq disposition (mml-minibuffer-read-disposition type)))
- (mml-attach-file file type description disposition)))))
-
-(defun mml-attach-buffer (buffer &optional type description)
- "Attach a buffer to the outgoing MIME message.
-See `mml-attach-file' for details of operation."
- (interactive
- (let* ((buffer (read-buffer "Attach buffer: "))
- (type (mml-minibuffer-read-type buffer "text/plain"))
- (description (mml-minibuffer-read-description)))
- (list buffer type description)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
- (mml-insert-empty-tag 'part 'type type 'buffer buffer
- 'disposition "attachment"
- 'description description)))
-
-(defun mml-attach-external (file &optional type description)
- "Attach an external file into the buffer.
-FILE is an ange-ftp/efs specification of the part location.
-TYPE is the MIME type to use."
- (interactive
- (let* ((file (mml-minibuffer-read-file "Attach external file: "))
- (type (mml-minibuffer-read-type file))
- (description (mml-minibuffer-read-description)))
- (list file type description)))
- (save-excursion
- (unless (message-in-body-p) (goto-char (point-max)))
- (mml-insert-empty-tag 'external 'type type 'name file
- 'disposition "attachment" 'description description)))
-
-(defun mml-insert-multipart (&optional type)
- (interactive (list (completing-read "Multipart type (default mixed): "
- '(("mixed") ("alternative") ("digest") ("parallel")
- ("signed") ("encrypted"))
- nil nil "mixed")))
- (or type
- (setq type "mixed"))
- (mml-insert-empty-tag "multipart" 'type type)
- (forward-line -1))
-
-(defun mml-insert-part (&optional type)
- (interactive
- (list (mml-minibuffer-read-type "")))
- (mml-insert-tag 'part 'type type 'disposition "inline")
- (forward-line -1))
-
-(defun mml-preview-insert-mail-followup-to ()
- "Insert a Mail-Followup-To header before previewing an article.
-Should be adopted if code in `message-send-mail' is changed."
- (when (and (message-mail-p)
- (message-subscribed-p)
- (not (mail-fetch-field "mail-followup-to"))
- (message-make-mail-followup-to))
- (message-position-on-field "Mail-Followup-To" "X-Draft-From")
- (insert (message-make-mail-followup-to))))
-
-(defun mml-preview (&optional raw)
- "Display current buffer with Gnus, in a new buffer.
-If RAW, display a raw encoded MIME message."
- (interactive "P")
- (save-excursion
- (let* ((buf (current-buffer))
- (message-options message-options)
- (message-this-is-mail (message-mail-p))
- (message-this-is-news (message-news-p))
- (message-posting-charset (or (gnus-setup-posting-charset
- (save-restriction
- (message-narrow-to-headers-or-head)
- (message-fetch-field "Newsgroups")))
- message-posting-charset)))
- (message-options-set-recipient)
- (pop-to-buffer (generate-new-buffer
- (concat (if raw "*Raw MIME preview of "
- "*MIME preview of ") (buffer-name))))
- (when (boundp 'gnus-buffers)
- (push (current-buffer) gnus-buffers))
- (erase-buffer)
- (insert-buffer-substring buf)
- (mml-preview-insert-mail-followup-to)
- (let ((message-deletable-headers (if (message-news-p)
- nil
- message-deletable-headers)))
- (message-generate-headers
- (copy-sequence (if (message-news-p)
- message-required-news-headers
- message-required-mail-headers))))
- (if (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n") nil t)
- (replace-match "\n"))
- (let ((mail-header-separator ""));; mail-header-separator is removed.
- (mml-to-mime))
- (if raw
- (when (fboundp 'set-buffer-multibyte)
- (let ((s (buffer-string)))
- ;; Insert the content into unibyte buffer.
- (erase-buffer)
- (mm-disable-multibyte)
- (insert s)))
- (let ((gnus-newsgroup-charset (car message-posting-charset))
- gnus-article-prepare-hook gnus-original-article-buffer)
- (run-hooks 'gnus-article-decode-hook)
- (let ((gnus-newsgroup-name "dummy")
- (gnus-newsrc-hashtb (or gnus-newsrc-hashtb
- (gnus-make-hashtable 5))))
- (gnus-article-prepare-display))))
- ;; Disable article-mode-map.
- (use-local-map nil)
- (gnus-make-local-hook 'kill-buffer-hook)
- (add-hook 'kill-buffer-hook
- (lambda ()
- (mm-destroy-parts gnus-article-mime-handles)) nil t)
- (setq buffer-read-only t)
- (local-set-key "q" (lambda () (interactive) (kill-buffer nil)))
- (local-set-key "=" (lambda () (interactive) (delete-other-windows)))
- (local-set-key "\r"
- (lambda ()
- (interactive)
- (widget-button-press (point))))
- (local-set-key gnus-mouse-2
- (lambda (event)
- (interactive "@e")
- (widget-button-press (widget-event-point event) event)))
- (goto-char (point-min)))))
-
-(defun mml-validate ()
- "Validate the current MML document."
- (interactive)
- (mml-parse))
-
-(defun mml-tweak-part (cont)
- "Tweak a MML part."
- (let ((tweak (cdr (assq 'tweak cont)))
- func)
- (cond
- (tweak
- (setq func
- (or (cdr (assoc tweak mml-tweak-function-alist))
- (intern tweak))))
- (mml-tweak-type-alist
- (let ((alist mml-tweak-type-alist)
- (type (or (cdr (assq 'type cont)) "text/plain")))
- (while alist
- (if (string-match (caar alist) type)
- (setq func (cdar alist)
- alist nil)
- (setq alist (cdr alist)))))))
- (if func
- (funcall func cont)
- cont)
- (let ((alist mml-tweak-sexp-alist))
- (while alist
- (if (eval (caar alist))
- (funcall (cdar alist) cont))
- (setq alist (cdr alist)))))
- cont)
-
-(defun mml-tweak-externalize-attachments (cont)
- "Tweak attached files as external parts."
- (let (filename-cons)
- (when (and (eq (car cont) 'part)
- (not (cdr (assq 'buffer cont)))
- (and (setq filename-cons (assq 'filename cont))
- (not (equal (cdr (assq 'nofile cont)) "yes"))))
- (setcar cont 'external)
- (setcar filename-cons 'name))))
-
-(provide 'mml)
-
-;;; arch-tag: 583c96cf-1ffe-451b-a5e5-4733ae9ddd12
-;;; mml.el ends here
+++ /dev/null
-;;; mml1991.el --- Old PGP message format (RFC 1991) support for MML
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Sascha Lüdecke <sascha@meta-x.de>,
-;; Simon Josefsson <simon@josefsson.org> (Mailcrypt interface, Gnus glue)
-;; Keywords PGP
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'mm-util))
-
-(defvar mc-pgp-always-sign)
-
-(autoload 'quoted-printable-decode-region "qp")
-(autoload 'quoted-printable-encode-region "qp")
-
-(defvar mml1991-use mml2015-use
- "The package used for PGP.")
-
-(defvar mml1991-function-alist
- '((mailcrypt mml1991-mailcrypt-sign
- mml1991-mailcrypt-encrypt)
- (gpg mml1991-gpg-sign
- mml1991-gpg-encrypt)
- (pgg mml1991-pgg-sign
- mml1991-pgg-encrypt))
- "Alist of PGP functions.")
-
-;;; mailcrypt wrapper
-
-(eval-and-compile
- (autoload 'mc-sign-generic "mc-toplev"))
-
-(defvar mml1991-decrypt-function 'mailcrypt-decrypt)
-(defvar mml1991-verify-function 'mailcrypt-verify)
-
-(defun mml1991-mailcrypt-sign (cont)
- (let ((text (current-buffer))
- headers signature
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Save MIME Content[^ ]+: headers from signing
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (setq headers (buffer-string))
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (quoted-printable-decode-region (point-min) (point-max))
- (with-temp-buffer
- (setq signature (current-buffer))
- (insert-buffer-substring text)
- (unless (mc-sign-generic (message-options-get 'message-sender)
- nil nil nil nil)
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Sign error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (quoted-printable-encode-region (point-min) (point-max))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- (if headers (insert headers))
- (insert "\n")
- (insert-buffer-substring signature)
- (goto-char (point-max)))))
-
-(defun mml1991-mailcrypt-encrypt (cont &optional sign)
- (let ((text (current-buffer))
- (mc-pgp-always-sign
- (or mc-pgp-always-sign
- sign
- (eq t (or (message-options-get 'message-sign-encrypt)
- (message-options-set
- 'message-sign-encrypt
- (or (y-or-n-p "Sign the message? ")
- 'not))))
- 'never))
- cipher
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- (setq cipher (current-buffer))
- (insert-buffer-substring text)
- (unless (mc-encrypt-generic
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- nil
- (point-min) (point-max)
- (message-options-get 'message-sender)
- 'sign)
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Encrypt error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- ;;(insert "Content-Type: application/pgp-encrypted\n\n")
- ;;(insert "Version: 1\n\n")
- (insert "\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))))))
-
-;;; gpg wrapper
-
-(eval-and-compile
- (autoload 'gpg-sign-cleartext "gpg"))
-
-(defun mml1991-gpg-sign (cont)
- (let ((text (current-buffer))
- headers signature
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Save MIME Content[^ ]+: headers from signing
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (setq headers (buffer-string))
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (quoted-printable-decode-region (point-min) (point-max))
- (with-temp-buffer
- (unless (gpg-sign-cleartext text (setq signature (current-buffer))
- result-buffer
- nil
- (message-options-get 'message-sender))
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Sign error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (quoted-printable-encode-region (point-min) (point-max))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- (if headers (insert headers))
- (insert "\n")
- (insert-buffer-substring signature)
- (goto-char (point-max)))))
-
-(defun mml1991-gpg-encrypt (cont &optional sign)
- (let ((text (current-buffer))
- cipher
- (result-buffer (get-buffer-create "*GPG Result*")))
- ;; Strip MIME Content[^ ]: headers since it will be ASCII ARMOURED
- (goto-char (point-min))
- (while (looking-at "^Content[^ ]+:") (forward-line))
- (unless (bobp)
- (delete-region (point-min) (point)))
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- (flet ((gpg-encrypt-func
- (sign plaintext ciphertext result recipients &optional
- passphrase sign-with-key armor textmode)
- (if sign
- (gpg-sign-encrypt
- plaintext ciphertext result recipients passphrase
- sign-with-key armor textmode)
- (gpg-encrypt
- plaintext ciphertext result recipients passphrase
- armor textmode))))
- (unless (gpg-encrypt-func
- sign
- text (setq cipher (current-buffer))
- result-buffer
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- nil
- (message-options-get 'message-sender)
- t t) ; armor & textmode
- (unless (> (point-max) (point-min))
- (pop-to-buffer result-buffer)
- (error "Encrypt error"))))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- ;;(insert "Content-Type: application/pgp-encrypted\n\n")
- ;;(insert "Version: 1\n\n")
- (insert "\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))))))
-
-;; pgg wrapper
-
-(eval-when-compile
- (defvar pgg-default-user-id)
- (defvar pgg-errors-buffer)
- (defvar pgg-output-buffer))
-
-(defun mml1991-pgg-sign (cont)
- (let ((pgg-text-mode t)
- (pgg-default-user-id (or (message-options-get 'mml-sender)
- pgg-default-user-id))
- headers cte)
- ;; Don't sign headers.
- (goto-char (point-min))
- (when (re-search-forward "^$" nil t)
- (setq headers (buffer-substring (point-min) (point)))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (setq cte (mail-fetch-field "content-transfer-encoding")))
- (forward-line 1)
- (delete-region (point-min) (point))
- (when cte
- (setq cte (intern (downcase cte)))
- (mm-decode-content-transfer-encoding cte)))
- (unless (pgg-sign-region (point-min) (point-max) t)
- (pop-to-buffer pgg-errors-buffer)
- (error "Encrypt error"))
- (delete-region (point-min) (point-max))
- (mm-with-unibyte-current-buffer
- (insert-buffer-substring pgg-output-buffer)
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (when cte
- (mm-encode-content-transfer-encoding cte))
- (goto-char (point-min))
- (when headers
- (insert headers))
- (insert "\n"))
- t))
-
-(defun mml1991-pgg-encrypt (cont &optional sign)
- (goto-char (point-min))
- (when (re-search-forward "^$" nil t)
- (let ((cte (save-restriction
- (narrow-to-region (point-min) (point))
- (mail-fetch-field "content-transfer-encoding"))))
- ;; Strip MIME headers since it will be ASCII armoured.
- (forward-line 1)
- (delete-region (point-min) (point))
- (when cte
- (mm-decode-content-transfer-encoding (intern (downcase cte))))))
- (unless (let ((pgg-text-mode t))
- (pgg-encrypt-region
- (point-min) (point-max)
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- sign))
- (pop-to-buffer pgg-errors-buffer)
- (error "Encrypt error"))
- (delete-region (point-min) (point-max))
- (insert "\n")
- (insert-buffer-substring pgg-output-buffer)
- t)
-
-;;;###autoload
-(defun mml1991-encrypt (cont &optional sign)
- (let ((func (nth 2 (assq mml1991-use mml1991-function-alist))))
- (if func
- (funcall func cont sign)
- (error "Cannot find encrypt function"))))
-
-;;;###autoload
-(defun mml1991-sign (cont)
- (let ((func (nth 1 (assq mml1991-use mml1991-function-alist))))
- (if func
- (funcall func cont)
- (error "Cannot find sign function"))))
-
-(provide 'mml1991)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: e542be18-ab28-4393-9b33-97fe9cf30706
-;;; mml1991.el ends here
+++ /dev/null
-;;; mml2015.el --- MIME Security with Pretty Good Privacy (PGP)
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: PGP MIME MML
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; RFC 2015 is updated by RFC 3156, this file should be compatible
-;; with both.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mm-decode)
-(require 'mm-util)
-(require 'mml)
-
-(defvar mc-pgp-always-sign)
-
-(defvar mml2015-use (or
- (progn
- (ignore-errors
- (require 'pgg))
- (and (fboundp 'pgg-sign-region)
- 'pgg))
- (progn
- (ignore-errors
- (require 'gpg))
- (and (fboundp 'gpg-sign-detached)
- 'gpg))
- (progn (ignore-errors
- (load "mc-toplev"))
- (and (fboundp 'mc-encrypt-generic)
- (fboundp 'mc-sign-generic)
- (fboundp 'mc-cleanup-recipient-headers)
- 'mailcrypt)))
- "The package used for PGP/MIME.")
-
-;; Something is not RFC2015.
-(defvar mml2015-function-alist
- '((mailcrypt mml2015-mailcrypt-sign
- mml2015-mailcrypt-encrypt
- mml2015-mailcrypt-verify
- mml2015-mailcrypt-decrypt
- mml2015-mailcrypt-clear-verify
- mml2015-mailcrypt-clear-decrypt)
- (gpg mml2015-gpg-sign
- mml2015-gpg-encrypt
- mml2015-gpg-verify
- mml2015-gpg-decrypt
- mml2015-gpg-clear-verify
- mml2015-gpg-clear-decrypt)
- (pgg mml2015-pgg-sign
- mml2015-pgg-encrypt
- mml2015-pgg-verify
- mml2015-pgg-decrypt
- mml2015-pgg-clear-verify
- mml2015-pgg-clear-decrypt))
- "Alist of PGP/MIME functions.")
-
-(defvar mml2015-result-buffer nil)
-
-(defcustom mml2015-unabbrev-trust-alist
- '(("TRUST_UNDEFINED" . nil)
- ("TRUST_NEVER" . nil)
- ("TRUST_MARGINAL" . t)
- ("TRUST_FULLY" . t)
- ("TRUST_ULTIMATE" . t))
- "Map GnuPG trust output values to a boolean saying if you trust the key."
- :version "22.1"
- :group 'mime-security
- :type '(repeat (cons (regexp :tag "GnuPG output regexp")
- (boolean :tag "Trust key"))))
-
-;;; mailcrypt wrapper
-
-(eval-and-compile
- (autoload 'mailcrypt-decrypt "mailcrypt")
- (autoload 'mailcrypt-verify "mailcrypt")
- (autoload 'mc-pgp-always-sign "mailcrypt")
- (autoload 'mc-encrypt-generic "mc-toplev")
- (autoload 'mc-cleanup-recipient-headers "mc-toplev")
- (autoload 'mc-sign-generic "mc-toplev"))
-
-(eval-when-compile
- (defvar mc-default-scheme)
- (defvar mc-schemes))
-
-(defvar mml2015-decrypt-function 'mailcrypt-decrypt)
-(defvar mml2015-verify-function 'mailcrypt-verify)
-
-(defun mml2015-format-error (err)
- (if (stringp (cadr err))
- (cadr err)
- (format "%S" (cdr err))))
-
-(defun mml2015-mailcrypt-decrypt (handle ctl)
- (catch 'error
- (let (child handles result)
- (unless (setq child (mm-find-part-by-type
- (cdr handle)
- "application/octet-stream" nil t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (with-temp-buffer
- (mm-insert-part child)
- (setq result
- (condition-case err
- (funcall mml2015-decrypt-function)
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil)))
- (unless (car result)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")
- (throw 'error handle))
- (setq handles (mm-dissect-buffer t)))
- (mm-destroy-parts handle)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info
- (concat "OK"
- (let ((sig (with-current-buffer mml2015-result-buffer
- (mml2015-gpg-extract-signature-details))))
- (concat ", Signer: " sig))))
- (if (listp (car handles))
- handles
- (list handles)))))
-
-(defun mml2015-mailcrypt-clear-decrypt ()
- (let (result)
- (setq result
- (condition-case err
- (funcall mml2015-decrypt-function)
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil)))
- (if (car result)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))))
-
-(defun mml2015-fix-micalg (alg)
- (and alg
- ;; Mutt/1.2.5i has seen sending micalg=php-sha1
- (upcase (if (string-match "^p[gh]p-" alg)
- (substring alg (match-end 0))
- alg))))
-
-(defun mml2015-mailcrypt-verify (handle ctl)
- (catch 'error
- (let (part)
- (unless (setq part (mm-find-raw-part-by-type
- ctl (or (mm-handle-multipart-ctl-parameter
- ctl 'protocol)
- "application/pgp-signature")
- t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (with-temp-buffer
- (insert "-----BEGIN PGP SIGNED MESSAGE-----\n")
- (insert (format "Hash: %s\n\n"
- (or (mml2015-fix-micalg
- (mm-handle-multipart-ctl-parameter
- ctl 'micalg))
- "SHA1")))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert part "\n")
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "^-")
- (insert "- "))
- (forward-line)))
- (unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" nil t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (save-restriction
- (narrow-to-region (point) (point))
- (mm-insert-part part)
- (goto-char (point-min))
- (if (re-search-forward "^-----BEGIN PGP [^-]+-----\r?$" nil t)
- (replace-match "-----BEGIN PGP SIGNATURE-----" t t))
- (if (re-search-forward "^-----END PGP [^-]+-----\r?$" nil t)
- (replace-match "-----END PGP SIGNATURE-----" t t)))
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
- (unless (condition-case err
- (prog1
- (funcall mml2015-verify-function)
- (if (get-buffer " *mailcrypt stderr temp")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer " *mailcrypt stderr temp"
- (buffer-string))))
- (if (get-buffer " *mailcrypt stdout temp")
- (kill-buffer " *mailcrypt stdout temp"))
- (if (get-buffer " *mailcrypt stderr temp")
- (kill-buffer " *mailcrypt stderr temp"))
- (if (get-buffer " *mailcrypt status temp")
- (kill-buffer " *mailcrypt status temp"))
- (if (get-buffer mc-gpg-debug-buffer)
- (kill-buffer mc-gpg-debug-buffer)))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")
- (throw 'error handle))))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- handle)))
-
-(defun mml2015-mailcrypt-clear-verify ()
- (let ((mc-gpg-debug-buffer (get-buffer-create " *gnus gpg debug*")))
- (if (condition-case err
- (prog1
- (funcall mml2015-verify-function)
- (if (get-buffer " *mailcrypt stderr temp")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer " *mailcrypt stderr temp"
- (buffer-string))))
- (if (get-buffer " *mailcrypt stdout temp")
- (kill-buffer " *mailcrypt stdout temp"))
- (if (get-buffer " *mailcrypt stderr temp")
- (kill-buffer " *mailcrypt stderr temp"))
- (if (get-buffer " *mailcrypt status temp")
- (kill-buffer " *mailcrypt status temp"))
- (if (get-buffer mc-gpg-debug-buffer)
- (kill-buffer mc-gpg-debug-buffer)))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))))
-
-(defun mml2015-mailcrypt-sign (cont)
- (mc-sign-generic (message-options-get 'message-sender)
- nil nil nil nil)
- (let ((boundary (mml-compute-boundary cont))
- hash point)
- (goto-char (point-min))
- (unless (re-search-forward "^-----BEGIN PGP SIGNED MESSAGE-----\r?$" nil t)
- (error "Cannot find signed begin line"))
- (goto-char (match-beginning 0))
- (forward-line 1)
- (unless (looking-at "Hash:[ \t]*\\([a-zA-Z0-9]+\\)")
- (error "Cannot not find PGP hash"))
- (setq hash (match-string 1))
- (unless (re-search-forward "^$" nil t)
- (error "Cannot not find PGP message"))
- (forward-line 1)
- (delete-region (point-min) (point))
- (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
- boundary))
- (insert (format "\tmicalg=pgp-%s; protocol=\"application/pgp-signature\"\n"
- (downcase hash)))
- (insert (format "\n--%s\n" boundary))
- (setq point (point))
- (goto-char (point-max))
- (unless (re-search-backward "^-----END PGP SIGNATURE-----\r?$" nil t)
- (error "Cannot find signature part"))
- (replace-match "-----END PGP MESSAGE-----" t t)
- (goto-char (match-beginning 0))
- (unless (re-search-backward "^-----BEGIN PGP SIGNATURE-----\r?$"
- nil t)
- (error "Cannot find signature part"))
- (replace-match "-----BEGIN PGP MESSAGE-----" t t)
- (goto-char (match-beginning 0))
- (save-restriction
- (narrow-to-region point (point))
- (goto-char point)
- (while (re-search-forward "^- -" nil t)
- (replace-match "-" t t))
- (goto-char (point-max)))
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/pgp-signature\n\n")
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max))))
-
-(defun mml2015-mailcrypt-encrypt (cont &optional sign)
- (let ((mc-pgp-always-sign
- (or mc-pgp-always-sign
- sign
- (eq t (or (message-options-get 'message-sign-encrypt)
- (message-options-set
- 'message-sign-encrypt
- (or (y-or-n-p "Sign the message? ")
- 'not))))
- 'never)))
- (mm-with-unibyte-current-buffer
- (mc-encrypt-generic
- (or (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (mc-cleanup-recipient-headers
- (read-string "Recipients: "))))
- nil nil nil
- (message-options-get 'message-sender))))
- (goto-char (point-min))
- (unless (looking-at "-----BEGIN PGP MESSAGE-----")
- (error "Fail to encrypt the message"))
- (let ((boundary (mml-compute-boundary cont)))
- (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
- boundary))
- (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/pgp-encrypted\n\n")
- (insert "Version: 1\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/octet-stream\n\n")
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max))))
-
-;;; gpg wrapper
-
-(eval-and-compile
- (autoload 'gpg-decrypt "gpg")
- (autoload 'gpg-verify "gpg")
- (autoload 'gpg-verify-cleartext "gpg")
- (autoload 'gpg-sign-detached "gpg")
- (autoload 'gpg-sign-encrypt "gpg")
- (autoload 'gpg-encrypt "gpg")
- (autoload 'gpg-passphrase-read "gpg"))
-
-(defun mml2015-gpg-passphrase ()
- (or (message-options-get 'gpg-passphrase)
- (message-options-set 'gpg-passphrase (gpg-passphrase-read))))
-
-(defun mml2015-gpg-decrypt-1 ()
- (let ((cipher (current-buffer)) plain result)
- (if (with-temp-buffer
- (prog1
- (gpg-decrypt cipher (setq plain (current-buffer))
- mml2015-result-buffer nil)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer mml2015-result-buffer
- (buffer-string)))
- (set-buffer cipher)
- (erase-buffer)
- (insert-buffer-substring plain)
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))))
- '(t)
- ;; Some wrong with the return value, check plain text buffer.
- (if (> (point-max) (point-min))
- '(t)
- nil))))
-
-(defun mml2015-gpg-decrypt (handle ctl)
- (let ((mml2015-decrypt-function 'mml2015-gpg-decrypt-1))
- (mml2015-mailcrypt-decrypt handle ctl)))
-
-(defun mml2015-gpg-clear-decrypt ()
- (let (result)
- (setq result (mml2015-gpg-decrypt-1))
- (if (car result)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))))
-
-(defun mml2015-gpg-pretty-print-fpr (fingerprint)
- (let* ((result "")
- (fpr-length (string-width fingerprint))
- (n-slice 0)
- slice)
- (setq fingerprint (string-to-list fingerprint))
- (while fingerprint
- (setq fpr-length (- fpr-length 4))
- (setq slice (butlast fingerprint fpr-length))
- (setq fingerprint (nthcdr 4 fingerprint))
- (setq n-slice (1+ n-slice))
- (setq result
- (concat
- result
- (case n-slice
- (1 slice)
- (otherwise (concat " " slice))))))
- result))
-
-(defun mml2015-gpg-extract-signature-details ()
- (goto-char (point-min))
- (let* ((expired (re-search-forward
- "^\\[GNUPG:\\] SIGEXPIRED$"
- nil t))
- (signer (and (re-search-forward
- "^\\[GNUPG:\\] GOODSIG \\([0-9A-Za-z]*\\) \\(.*\\)$"
- nil t)
- (cons (match-string 1) (match-string 2))))
- (fprint (and (re-search-forward
- "^\\[GNUPG:\\] VALIDSIG \\([0-9a-zA-Z]*\\) "
- nil t)
- (match-string 1)))
- (trust (and (re-search-forward
- "^\\[GNUPG:\\] \\(TRUST_.*\\)$"
- nil t)
- (match-string 1)))
- (trust-good-enough-p
- (cdr (assoc trust mml2015-unabbrev-trust-alist))))
- (cond ((and signer fprint)
- (concat (cdr signer)
- (unless trust-good-enough-p
- (concat "\nUntrusted, Fingerprint: "
- (mml2015-gpg-pretty-print-fpr fprint)))
- (when expired
- (format "\nWARNING: Signature from expired key (%s)"
- (car signer)))))
- ((re-search-forward
- "^\\(gpg: \\)?Good signature from \"\\(.*\\)\"$" nil t)
- (match-string 2))
- (t
- "From unknown user"))))
-
-(defun mml2015-gpg-verify (handle ctl)
- (catch 'error
- (let (part message signature info-is-set-p)
- (unless (setq part (mm-find-raw-part-by-type
- ctl (or (mm-handle-multipart-ctl-parameter
- ctl 'protocol)
- "application/pgp-signature")
- t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (with-temp-buffer
- (setq message (current-buffer))
- (insert part)
- ;; Convert <LF> to <CR><LF> in verify mode. Sign and
- ;; clearsign use --textmode. The conversion is not necessary.
- ;; In clearverify, the conversion is not necessary either.
- (goto-char (point-min))
- (end-of-line)
- (while (not (eobp))
- (unless (eq (char-before) ?\r)
- (insert "\r"))
- (forward-line)
- (end-of-line))
- (with-temp-buffer
- (setq signature (current-buffer))
- (unless (setq part (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" nil t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (mm-insert-part part)
- (unless (condition-case err
- (prog1
- (gpg-verify message signature mml2015-result-buffer)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer mml2015-result-buffer
- (buffer-string))))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Error.")
- (setq info-is-set-p t)
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Quit.")
- (setq info-is-set-p t)
- nil))
- (unless info-is-set-p
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))
- (throw 'error handle)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info
- (with-current-buffer mml2015-result-buffer
- (mml2015-gpg-extract-signature-details))))
- handle)))
-
-(defun mml2015-gpg-clear-verify ()
- (if (condition-case err
- (prog1
- (gpg-verify-cleartext (current-buffer) mml2015-result-buffer)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer mml2015-result-buffer
- (buffer-string))))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info
- (with-current-buffer mml2015-result-buffer
- (mml2015-gpg-extract-signature-details)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")))
-
-(defun mml2015-gpg-sign (cont)
- (let ((boundary (mml-compute-boundary cont))
- (text (current-buffer)) signature)
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (with-temp-buffer
- (unless (gpg-sign-detached text (setq signature (current-buffer))
- mml2015-result-buffer
- nil
- (message-options-get 'message-sender)
- t t) ; armor & textmode
- (unless (> (point-max) (point-min))
- (pop-to-buffer mml2015-result-buffer)
- (error "Sign error")))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (goto-char (point-min))
- (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
- boundary))
- ;;; FIXME: what is the micalg?
- (insert "\tmicalg=pgp-sha1; protocol=\"application/pgp-signature\"\n")
- (insert (format "\n--%s\n" boundary))
- (goto-char (point-max))
- (insert (format "\n--%s\n" boundary))
- (insert "Content-Type: application/pgp-signature\n\n")
- (insert-buffer-substring signature)
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max)))))
-
-(defun mml2015-gpg-encrypt (cont &optional sign)
- (let ((boundary (mml-compute-boundary cont))
- (text (current-buffer))
- cipher)
- (mm-with-unibyte-current-buffer
- (with-temp-buffer
- ;; set up a function to call the correct gpg encrypt routine
- ;; with the right arguments. (FIXME: this should be done
- ;; differently.)
- (flet ((gpg-encrypt-func
- (sign plaintext ciphertext result recipients &optional
- passphrase sign-with-key armor textmode)
- (if sign
- (gpg-sign-encrypt
- plaintext ciphertext result recipients passphrase
- sign-with-key armor textmode)
- (gpg-encrypt
- plaintext ciphertext result recipients passphrase
- armor textmode))))
- (unless (gpg-encrypt-func
- sign ; passed in when using signencrypt
- text (setq cipher (current-buffer))
- mml2015-result-buffer
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- nil
- (message-options-get 'message-sender)
- t t) ; armor & textmode
- (unless (> (point-max) (point-min))
- (pop-to-buffer mml2015-result-buffer)
- (error "Encrypt error"))))
- (goto-char (point-min))
- (while (re-search-forward "\r+$" nil t)
- (replace-match "" t t))
- (set-buffer text)
- (delete-region (point-min) (point-max))
- (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
- boundary))
- (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/pgp-encrypted\n\n")
- (insert "Version: 1\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/octet-stream\n\n")
- (insert-buffer-substring cipher)
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max))))))
-
-;;; pgg wrapper
-
-(eval-when-compile
- (defvar pgg-default-user-id)
- (defvar pgg-errors-buffer)
- (defvar pgg-output-buffer))
-
-(eval-and-compile
- (autoload 'pgg-decrypt-region "pgg")
- (autoload 'pgg-verify-region "pgg")
- (autoload 'pgg-sign-region "pgg")
- (autoload 'pgg-encrypt-region "pgg")
- (autoload 'pgg-parse-armor "pgg-parse"))
-
-(defun mml2015-pgg-decrypt (handle ctl)
- (catch 'error
- (let ((pgg-errors-buffer mml2015-result-buffer)
- child handles result decrypt-status)
- (unless (setq child (mm-find-part-by-type
- (cdr handle)
- "application/octet-stream" nil t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- (throw 'error handle))
- (with-temp-buffer
- (mm-insert-part child)
- (if (condition-case err
- (prog1
- (pgg-decrypt-region (point-min) (point-max))
- (setq decrypt-status
- (with-current-buffer mml2015-result-buffer
- (buffer-string)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- decrypt-status))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (with-current-buffer pgg-output-buffer
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))
- (setq handles (mm-dissect-buffer t))
- (mm-destroy-parts handle)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK")
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (concat decrypt-status
- (when (stringp (car handles))
- "\n" (mm-handle-multipart-ctl-parameter
- handles 'gnus-details))))
- (if (listp (car handles))
- handles
- (list handles)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")
- (throw 'error handle))))))
-
-(defun mml2015-pgg-clear-decrypt ()
- (let ((pgg-errors-buffer mml2015-result-buffer))
- (if (prog1
- (pgg-decrypt-region (point-min) (point-max))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (with-current-buffer mml2015-result-buffer
- (buffer-string))))
- (progn
- (erase-buffer)
- ;; Treat data which pgg returns as a unibyte string.
- (mm-disable-multibyte)
- (insert-buffer-substring pgg-output-buffer)
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "OK"))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))))
-
-(defun mml2015-pgg-verify (handle ctl)
- (let ((pgg-errors-buffer mml2015-result-buffer)
- signature-file part signature)
- (if (or (null (setq part (mm-find-raw-part-by-type
- ctl (or (mm-handle-multipart-ctl-parameter
- ctl 'protocol)
- "application/pgp-signature")
- t)))
- (null (setq signature (mm-find-part-by-type
- (cdr handle) "application/pgp-signature" nil t))))
- (progn
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Corrupted")
- handle)
- (with-temp-buffer
- (insert part)
- ;; Convert <LF> to <CR><LF> in verify mode. Sign and
- ;; clearsign use --textmode. The conversion is not necessary.
- ;; In clearverify, the conversion is not necessary either.
- (goto-char (point-min))
- (end-of-line)
- (while (not (eobp))
- (unless (eq (char-before) ?\r)
- (insert "\r"))
- (forward-line)
- (end-of-line))
- (with-temp-file (setq signature-file (mm-make-temp-file "pgg"))
- (mm-insert-part signature))
- (if (condition-case err
- (prog1
- (pgg-verify-region (point-min) (point-max)
- signature-file t)
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (concat (with-current-buffer pgg-output-buffer
- (buffer-string))
- (with-current-buffer pgg-errors-buffer
- (buffer-string)))))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (progn
- (delete-file signature-file)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info
- (with-current-buffer pgg-errors-buffer
- (mml2015-gpg-extract-signature-details))))
- (delete-file signature-file)
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed")))))
- handle)
-
-(defun mml2015-pgg-clear-verify ()
- (let ((pgg-errors-buffer mml2015-result-buffer)
- (text (buffer-string))
- (coding-system buffer-file-coding-system))
- (if (condition-case err
- (prog1
- (mm-with-unibyte-buffer
- (insert (mm-encode-coding-string text coding-system))
- (pgg-verify-region (point-min) (point-max) nil t))
- (goto-char (point-min))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n" t t))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details
- (concat (with-current-buffer pgg-output-buffer
- (buffer-string))
- (with-current-buffer pgg-errors-buffer
- (buffer-string)))))
- (error
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details (mml2015-format-error err))
- nil)
- (quit
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-details "Quit.")
- nil))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info
- (with-current-buffer pgg-errors-buffer
- (mml2015-gpg-extract-signature-details)))
- (mm-set-handle-multipart-parameter
- mm-security-handle 'gnus-info "Failed"))))
-
-(defun mml2015-pgg-sign (cont)
- (let ((pgg-errors-buffer mml2015-result-buffer)
- (boundary (mml-compute-boundary cont))
- (pgg-default-user-id (or (message-options-get 'mml-sender)
- pgg-default-user-id))
- (pgg-text-mode t)
- entry)
- (unless (pgg-sign-region (point-min) (point-max))
- (pop-to-buffer mml2015-result-buffer)
- (error "Sign error"))
- (goto-char (point-min))
- (insert (format "Content-Type: multipart/signed; boundary=\"%s\";\n"
- boundary))
- (if (setq entry (assq 2 (pgg-parse-armor
- (with-current-buffer pgg-output-buffer
- (buffer-string)))))
- (setq entry (assq 'hash-algorithm (cdr entry))))
- (insert (format "\tmicalg=%s; "
- (if (cdr entry)
- (downcase (format "pgp-%s" (cdr entry)))
- "pgp-sha1")))
- (insert "protocol=\"application/pgp-signature\"\n")
- (insert (format "\n--%s\n" boundary))
- (goto-char (point-max))
- (insert (format "\n--%s\n" boundary))
- (insert "Content-Type: application/pgp-signature\n\n")
- (insert-buffer-substring pgg-output-buffer)
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max))))
-
-(defun mml2015-pgg-encrypt (cont &optional sign)
- (let ((pgg-errors-buffer mml2015-result-buffer)
- (pgg-text-mode t)
- (boundary (mml-compute-boundary cont)))
- (unless (pgg-encrypt-region (point-min) (point-max)
- (split-string
- (or
- (message-options-get 'message-recipients)
- (message-options-set 'message-recipients
- (read-string "Recipients: ")))
- "[ \f\t\n\r\v,]+")
- sign)
- (pop-to-buffer mml2015-result-buffer)
- (error "Encrypt error"))
- (delete-region (point-min) (point-max))
- (goto-char (point-min))
- (insert (format "Content-Type: multipart/encrypted; boundary=\"%s\";\n"
- boundary))
- (insert "\tprotocol=\"application/pgp-encrypted\"\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/pgp-encrypted\n\n")
- (insert "Version: 1\n\n")
- (insert (format "--%s\n" boundary))
- (insert "Content-Type: application/octet-stream\n\n")
- (insert-buffer-substring pgg-output-buffer)
- (goto-char (point-max))
- (insert (format "--%s--\n" boundary))
- (goto-char (point-max))))
-
-;;; General wrapper
-
-(defun mml2015-clean-buffer ()
- (if (gnus-buffer-live-p mml2015-result-buffer)
- (with-current-buffer mml2015-result-buffer
- (erase-buffer)
- t)
- (setq mml2015-result-buffer
- (gnus-get-buffer-create "*MML2015 Result*"))
- nil))
-
-(defsubst mml2015-clear-decrypt-function ()
- (nth 6 (assq mml2015-use mml2015-function-alist)))
-
-(defsubst mml2015-clear-verify-function ()
- (nth 5 (assq mml2015-use mml2015-function-alist)))
-
-;;;###autoload
-(defun mml2015-decrypt (handle ctl)
- (mml2015-clean-buffer)
- (let ((func (nth 4 (assq mml2015-use mml2015-function-alist))))
- (if func
- (funcall func handle ctl)
- handle)))
-
-;;;###autoload
-(defun mml2015-decrypt-test (handle ctl)
- mml2015-use)
-
-;;;###autoload
-(defun mml2015-verify (handle ctl)
- (mml2015-clean-buffer)
- (let ((func (nth 3 (assq mml2015-use mml2015-function-alist))))
- (if func
- (funcall func handle ctl)
- handle)))
-
-;;;###autoload
-(defun mml2015-verify-test (handle ctl)
- mml2015-use)
-
-;;;###autoload
-(defun mml2015-encrypt (cont &optional sign)
- (mml2015-clean-buffer)
- (let ((func (nth 2 (assq mml2015-use mml2015-function-alist))))
- (if func
- (funcall func cont sign)
- (error "Cannot find encrypt function"))))
-
-;;;###autoload
-(defun mml2015-sign (cont)
- (mml2015-clean-buffer)
- (let ((func (nth 1 (assq mml2015-use mml2015-function-alist))))
- (if func
- (funcall func cont)
- (error "Cannot find sign function"))))
-
-;;;###autoload
-(defun mml2015-self-encrypt ()
- (mml2015-encrypt nil))
-
-(provide 'mml2015)
-
-;;; arch-tag: b04701d5-0b09-44d8-bed8-de901bf435f2
-;;; mml2015.el ends here
+++ /dev/null
-;;; nnagent.el --- offline backend for Gnus
-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-(require 'gnus-agent)
-(require 'nnml)
-
-(nnoo-declare nnagent
- nnml)
-
-\f
-
-(defconst nnagent-version "nnagent 1.0")
-
-(defvoo nnagent-directory nil
- "Internal variable."
- nnml-directory)
-
-(defvoo nnagent-active-file nil
- "Internal variable."
- nnml-active-file)
-
-(defvoo nnagent-newsgroups-file nil
- "Internal variable."
- nnml-newsgroups-file)
-
-(defvoo nnagent-get-new-mail nil
- "Internal variable."
- nnml-get-new-mail)
-
-;;; Interface functions.
-
-(nnoo-define-basics nnagent)
-
-(defun nnagent-server (server)
- (and server (format "%s+%s" (car gnus-command-method) server)))
-
-(deffoo nnagent-open-server (server &optional defs)
- (setq defs
- `((nnagent-directory ,(gnus-agent-directory))
- (nnagent-active-file ,(gnus-agent-lib-file "active"))
- (nnagent-newsgroups-file ,(gnus-agent-lib-file "newsgroups"))
- (nnagent-get-new-mail nil)))
- (nnoo-change-server 'nnagent
- (nnagent-server server)
- defs)
- (let ((dir (gnus-agent-directory))
- err)
- (cond
- ((not (condition-case arg
- (file-exists-p dir)
- (ftp-error (setq err (format "%s" arg)))))
- (nnagent-close-server)
- (nnheader-report
- 'nnagent (or err
- (format "No such file or directory: %s" dir))))
- ((not (file-directory-p (file-truename dir)))
- (nnagent-close-server)
- (nnheader-report 'nnagent "Not a directory: %s" dir))
- (t
- (nnheader-report 'nnagent "Opened server %s using directory %s"
- server dir)
- t))))
-
-(deffoo nnagent-retrieve-groups (groups &optional server)
- (save-excursion
- (cond
- ((file-exists-p (gnus-agent-lib-file "groups"))
- (nnmail-find-file (gnus-agent-lib-file "groups"))
- 'groups)
- ((file-exists-p (gnus-agent-lib-file "active"))
- (nnmail-find-file (gnus-agent-lib-file "active"))
- 'active)
- (t nil))))
-
-(defun nnagent-request-type (group article)
- (unless (stringp article)
- (let ((gnus-agent nil))
- (if (not (gnus-check-backend-function
- 'request-type (car gnus-command-method)))
- 'unknown
- (funcall (gnus-get-function gnus-command-method 'request-type)
- (gnus-group-real-name group) article)))))
-
-(deffoo nnagent-request-newgroups (date server)
- nil)
-
-(deffoo nnagent-request-update-info (group info &optional server)
- nil)
-
-(deffoo nnagent-request-post (&optional server)
- (gnus-agent-insert-meta-information 'news gnus-command-method)
- (gnus-request-accept-article "nndraft:queue" nil t t))
-
-(deffoo nnagent-request-set-mark (group action server)
- (with-temp-buffer
- (insert "(gnus-agent-synchronize-group-flags \""
- group
- "\" '")
- (gnus-pp action)
- (insert " \""
- (gnus-method-to-server gnus-command-method)
- "\"")
- (insert ")\n")
- (append-to-file (point-min) (point-max) (gnus-agent-lib-file "flags")))
- nil)
-
-(deffoo nnagent-retrieve-headers (articles &optional group server fetch-old)
- (let ((file (gnus-agent-article-name ".overview" group))
- arts n first)
- (save-excursion
- (gnus-agent-load-alist group)
- (setq arts (gnus-sorted-difference
- articles (mapcar 'car gnus-agent-article-alist)))
- ;; Assume that articles with smaller numbers than the first one
- ;; Agent knows are gone.
- (setq first (caar gnus-agent-article-alist))
- (when first
- (while (and arts (< (car arts) first))
- (pop arts)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (nnheader-insert-nov-file file (car articles))
- (goto-char (point-min))
- (gnus-parse-without-error
- (while (and arts (not (eobp)))
- (setq n (read (current-buffer)))
- (when (> n (car arts))
- (beginning-of-line))
- (while (and arts (> n (car arts)))
- (insert (format
- "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
- (car arts) (car arts)))
- (pop arts))
- (when (and arts (= n (car arts)))
- (pop arts))
- (forward-line 1)))
- (while arts
- (insert (format
- "%d\t[Undownloaded article %d]\tGnus Agent\t\t\t\n"
- (car arts) (car arts)))
- (pop arts))
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- t)
- 'nov)))
-
-(deffoo nnagent-request-expire-articles (articles group &optional server force)
- articles)
-
-(deffoo nnagent-request-group (group &optional server dont-check)
- (nnoo-parent-function 'nnagent 'nnml-request-group
- (list group (nnagent-server server) dont-check)))
-
-(deffoo nnagent-close-group (group &optional server)
- (nnoo-parent-function 'nnagent 'nnml-close-group
- (list group (nnagent-server server))))
-
-(deffoo nnagent-request-accept-article (group &optional server last)
- (nnoo-parent-function 'nnagent 'nnml-request-accept-article
- (list group (nnagent-server server) last)))
-
-(deffoo nnagent-request-article (id &optional group server buffer)
- (nnoo-parent-function 'nnagent 'nnml-request-article
- (list id group (nnagent-server server) buffer)))
-
-(deffoo nnagent-request-create-group (group &optional server args)
- (nnoo-parent-function 'nnagent 'nnml-request-create-group
- (list group (nnagent-server server) args)))
-
-(deffoo nnagent-request-delete-group (group &optional force server)
- (nnoo-parent-function 'nnagent 'nnml-request-delete-group
- (list group force (nnagent-server server))))
-
-(deffoo nnagent-request-list (&optional server)
- (nnoo-parent-function 'nnagent 'nnml-request-list
- (list (nnagent-server server))))
-
-(deffoo nnagent-request-list-newsgroups (&optional server)
- (nnoo-parent-function 'nnagent 'nnml-request-list-newsgroups
- (list (nnagent-server server))))
-
-(deffoo nnagent-request-move-article
- (article group server accept-form &optional last)
- (nnoo-parent-function 'nnagent 'nnml-request-move-article
- (list article group (nnagent-server server)
- accept-form last)))
-
-(deffoo nnagent-request-rename-group (group new-name &optional server)
- (nnoo-parent-function 'nnagent 'nnml-request-rename-group
- (list group new-name (nnagent-server server))))
-
-(deffoo nnagent-request-scan (&optional group server)
- (nnoo-parent-function 'nnagent 'nnml-request-scan
- (list group (nnagent-server server))))
-
-(deffoo nnagent-set-status (article name value &optional group server)
- (nnoo-parent-function 'nnagent 'nnml-set-status
- (list article name value group (nnagent-server server))))
-
-(deffoo nnagent-server-opened (&optional server)
- (nnoo-parent-function 'nnagent 'nnml-server-opened
- (list (nnagent-server server))))
-
-(deffoo nnagent-status-message (&optional server)
- (nnoo-parent-function 'nnagent 'nnml-status-message
- (list (nnagent-server server))))
-
-(deffoo nnagent-request-regenerate (server)
- (nnoo-parent-function 'nnagent 'nnml-request-regenerate
- (list (nnagent-server server))))
-
-;; Use nnml functions for just about everything.
-(nnoo-import nnagent
- (nnml))
-
-\f
-;;; Internal functions.
-
-(provide 'nnagent)
-
-;;; arch-tag: af710b77-f816-4969-af31-6fd94fb42245
-;;; nnagent.el ends here
+++ /dev/null
-;;; nnbabyl.el --- rmail mbox access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1099, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
-
-;;; Code:
-
-(require 'nnheader)
-(condition-case nil
- (require 'rmail)
- (t (nnheader-message
- 5 "Ignore rmail errors from this file, you don't have rmail")))
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnbabyl)
-
-(defvoo nnbabyl-mbox-file (expand-file-name "~/RMAIL")
- "The name of the rmail box file in the users home directory.")
-
-(defvoo nnbabyl-active-file (expand-file-name "~/.rmail-active")
- "The name of the active file for the rmail box.")
-
-(defvoo nnbabyl-get-new-mail t
- "If non-nil, nnbabyl will check the incoming mail file and split the mail.")
-
-
-(defvoo nnbabyl-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
-
-\f
-
-(defvar nnbabyl-mail-delimiter "\^_")
-
-(defconst nnbabyl-version "nnbabyl 1.0"
- "nnbabyl version.")
-
-(defvoo nnbabyl-mbox-buffer nil)
-(defvoo nnbabyl-current-group nil)
-(defvoo nnbabyl-status-string "")
-(defvoo nnbabyl-group-alist nil)
-(defvoo nnbabyl-active-timestamp nil)
-
-(defvoo nnbabyl-previous-buffer-mode nil)
-
-(eval-and-compile
- (autoload 'gnus-set-text-properties "gnus-ems"))
-
-\f
-
-;;; Interface functions
-
-(nnoo-define-basics nnbabyl)
-
-(deffoo nnbabyl-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((number (length articles))
- (count 0)
- (delim (concat "^" nnbabyl-mail-delimiter))
- article art-string start stop)
- (nnbabyl-possibly-change-newsgroup group server)
- (while (setq article (pop articles))
- (setq art-string (nnbabyl-article-string article))
- (set-buffer nnbabyl-mbox-buffer)
- (end-of-line)
- (when (or (search-forward art-string nil t)
- (search-backward art-string nil t))
- (unless (re-search-backward delim nil t)
- (goto-char (point-min)))
- (while (and (not (looking-at ".+:"))
- (zerop (forward-line 1))))
- (setq start (point))
- (search-forward "\n\n" nil t)
- (setq stop (1- (point)))
- (set-buffer nntp-server-buffer)
- (insert "221 ")
- (princ article (current-buffer))
- (insert " Article retrieved.\n")
- (insert-buffer-substring nnbabyl-mbox-buffer start stop)
- (goto-char (point-max))
- (insert ".\n"))
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (zerop (% (incf count) 20))
- (nnheader-message 5 "nnbabyl: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (nnheader-message 5 "nnbabyl: Receiving headers...done"))
-
- (set-buffer nntp-server-buffer)
- (nnheader-fold-continuation-lines)
- 'headers)))
-
-(deffoo nnbabyl-open-server (server &optional defs)
- (nnoo-change-server 'nnbabyl server defs)
- (nnbabyl-create-mbox)
- (cond
- ((not (file-exists-p nnbabyl-mbox-file))
- (nnbabyl-close-server)
- (nnheader-report 'nnbabyl "No such file: %s" nnbabyl-mbox-file))
- ((file-directory-p nnbabyl-mbox-file)
- (nnbabyl-close-server)
- (nnheader-report 'nnbabyl "Not a regular file: %s" nnbabyl-mbox-file))
- (t
- (nnheader-report 'nnbabyl "Opened server %s using mbox %s" server
- nnbabyl-mbox-file)
- t)))
-
-(deffoo nnbabyl-close-server (&optional server)
- ;; Restore buffer mode.
- (when (and (nnbabyl-server-opened)
- nnbabyl-previous-buffer-mode)
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (narrow-to-region
- (caar nnbabyl-previous-buffer-mode)
- (cdar nnbabyl-previous-buffer-mode))
- (funcall (cdr nnbabyl-previous-buffer-mode))))
- (nnoo-close-server 'nnbabyl server)
- (setq nnbabyl-mbox-buffer nil)
- t)
-
-(deffoo nnbabyl-server-opened (&optional server)
- (and (nnoo-current-server-p 'nnbabyl server)
- nnbabyl-mbox-buffer
- (buffer-name nnbabyl-mbox-buffer)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)))
-
-(deffoo nnbabyl-request-article (article &optional newsgroup server buffer)
- (nnbabyl-possibly-change-newsgroup newsgroup server)
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- (when (search-forward (nnbabyl-article-string article) nil t)
- (let (start stop summary-line)
- (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
- (goto-char (point-min))
- (end-of-line))
- (while (and (not (looking-at ".+:"))
- (zerop (forward-line 1))))
- (setq start (point))
- (or (when (re-search-forward
- (concat "^" nnbabyl-mail-delimiter) nil t)
- (beginning-of-line)
- t)
- (goto-char (point-max)))
- (setq stop (point))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nnbabyl-mbox-buffer start stop)
- (goto-char (point-min))
- ;; If there is an EOOH header, then we have to remove some
- ;; duplicated headers.
- (setq summary-line (looking-at "Summary-line:"))
- (when (search-forward "\n*** EOOH ***" nil t)
- (if summary-line
- ;; The headers to be deleted are located before the
- ;; EOOH line...
- (delete-region (point-min) (progn (forward-line 1)
- (point)))
- ;; ...or after.
- (delete-region (progn (beginning-of-line) (point))
- (or (search-forward "\n\n" nil t)
- (point)))))
- (if (numberp article)
- (cons nnbabyl-current-group article)
- (nnbabyl-article-group-number)))))))
-
-(deffoo nnbabyl-request-group (group &optional server dont-check)
- (let ((active (cadr (assoc group nnbabyl-group-alist))))
- (save-excursion
- (cond
- ((or (null active)
- (null (nnbabyl-possibly-change-newsgroup group server)))
- (nnheader-report 'nnbabyl "No such group: %s" group))
- (dont-check
- (nnheader-report 'nnbabyl "Selected group %s" group)
- (nnheader-insert ""))
- (t
- (nnheader-report 'nnbabyl "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (1+ (- (cdr active) (car active)))
- (car active) (cdr active) group))))))
-
-(deffoo nnbabyl-request-scan (&optional group server)
- (nnbabyl-possibly-change-newsgroup group server)
- (nnbabyl-read-mbox)
- (nnmail-get-new-mail
- 'nnbabyl
- (lambda ()
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (save-buffer)))
- (file-name-directory nnbabyl-mbox-file)
- group
- (lambda ()
- (save-excursion
- (let ((in-buf (current-buffer)))
- (goto-char (point-min))
- (while (search-forward "\n\^_\n" nil t)
- (delete-char -1))
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-max))
- (search-backward "\n\^_" nil t)
- (goto-char (match-end 0))
- (insert-buffer-substring in-buf)))
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))))
-
-(deffoo nnbabyl-close-group (group &optional server)
- t)
-
-(deffoo nnbabyl-request-create-group (group &optional server args)
- (nnmail-activate 'nnbabyl)
- (unless (assoc group nnbabyl-group-alist)
- (push (list group (cons 1 0))
- nnbabyl-group-alist)
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
- t)
-
-(deffoo nnbabyl-request-list (&optional server)
- (save-excursion
- (nnmail-find-file nnbabyl-active-file)
- (setq nnbabyl-group-alist (nnmail-get-active))
- t))
-
-(deffoo nnbabyl-request-newgroups (date &optional server)
- (nnbabyl-request-list server))
-
-(deffoo nnbabyl-request-list-newsgroups (&optional server)
- (nnheader-report 'nnbabyl "nnbabyl: LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnbabyl-request-expire-articles
- (articles newsgroup &optional server force)
- (nnbabyl-possibly-change-newsgroup newsgroup server)
- (let* ((is-old t)
- rest)
- (nnmail-activate 'nnbabyl)
-
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (gnus-set-text-properties (point-min) (point-max) nil)
- (while (and articles is-old)
- (goto-char (point-min))
- (when (search-forward (nnbabyl-article-string (car articles)) nil t)
- (if (setq is-old
- (nnmail-expired-article-p
- newsgroup
- (buffer-substring
- (point) (progn (end-of-line) (point))) force))
- (progn
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnbabyl-request-article (car articles)
- newsgroup server
- (current-buffer))
- (let ((nnml-current-directory nil))
- (nnmail-expiry-target-group
- nnmail-expiry-target newsgroup)))
- (nnbabyl-possibly-change-newsgroup newsgroup server))
- (nnheader-message 5 "Deleting article %d in %s..."
- (car articles) newsgroup)
- (nnbabyl-delete-mail))
- (push (car articles) rest)))
- (setq articles (cdr articles)))
- (save-buffer)
- ;; Find the lowest active article in this group.
- (let ((active (nth 1 (assoc newsgroup nnbabyl-group-alist))))
- (goto-char (point-min))
- (while (and (not (search-forward
- (nnbabyl-article-string (car active)) nil t))
- (<= (car active) (cdr active)))
- (setcar active (1+ (car active)))
- (goto-char (point-min))))
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
- (nconc rest articles))))
-
-(deffoo nnbabyl-request-move-article
- (article group server accept-form &optional last)
- (let ((buf (get-buffer-create " *nnbabyl move*"))
- result)
- (and
- (nnbabyl-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (insert-buffer-substring nntp-server-buffer)
- (goto-char (point-min))
- (while (re-search-forward
- "^X-Gnus-Newsgroup:"
- (save-excursion (search-forward "\n\n" nil t) (point)) t)
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result)
- (save-excursion
- (nnbabyl-possibly-change-newsgroup group server)
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- (if (search-forward (nnbabyl-article-string article) nil t)
- (nnbabyl-delete-mail))
- (and last (save-buffer))))
- result))
-
-(deffoo nnbabyl-request-accept-article (group &optional server last)
- (nnbabyl-possibly-change-newsgroup group server)
- (nnmail-check-syntax)
- (let ((buf (current-buffer))
- result beg)
- (and
- (nnmail-activate 'nnbabyl)
- (save-excursion
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-line -1)
- (save-excursion
- (while (re-search-backward "^X-Gnus-Newsgroup: " beg t)
- (delete-region (point) (progn (forward-line 1) (point)))))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
- (setq result
- (if (stringp group)
- (list (cons group (nnbabyl-active-number group)))
- (nnmail-article-group 'nnbabyl-active-number)))
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nnbabyl-save-mail result))))
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-max))
- (search-backward "\n\^_")
- (goto-char (match-end 0))
- (insert-buffer-substring buf)
- (when last
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
- (save-buffer)
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file))
- result))))
-
-(deffoo nnbabyl-request-replace-article (article group buffer)
- (nnbabyl-possibly-change-newsgroup group)
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- (if (not (search-forward (nnbabyl-article-string article) nil t))
- nil
- (nnbabyl-delete-mail t t)
- (insert-buffer-substring buffer)
- (save-buffer)
- t)))
-
-(deffoo nnbabyl-request-delete-group (group &optional force server)
- (nnbabyl-possibly-change-newsgroup group server)
- ;; Delete all articles in GROUP.
- (if (not force)
- () ; Don't delete the articles.
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- ;; Delete all articles in this group.
- (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
- found)
- (while (search-forward ident nil t)
- (setq found t)
- (nnbabyl-delete-mail))
- (when found
- (save-buffer)))))
- ;; Remove the group from all structures.
- (setq nnbabyl-group-alist
- (delq (assoc group nnbabyl-group-alist) nnbabyl-group-alist)
- nnbabyl-current-group nil)
- ;; Save the active file.
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
- t)
-
-(deffoo nnbabyl-request-rename-group (group new-name &optional server)
- (nnbabyl-possibly-change-newsgroup group server)
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- (let ((ident (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"))
- (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
- found)
- (while (search-forward ident nil t)
- (replace-match new-ident t t)
- (setq found t))
- (when found
- (save-buffer))))
- (let ((entry (assoc group nnbabyl-group-alist)))
- (and entry (setcar entry new-name))
- (setq nnbabyl-current-group nil)
- ;; Save the new group alist.
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
- t))
-
-\f
-;;; Internal functions.
-
-;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
-;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
-;; delimiter line.
-(defun nnbabyl-delete-mail (&optional force leave-delim)
- ;; Delete the current X-Gnus-Newsgroup line.
- (unless force
- (delete-region
- (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
- ;; Beginning of the article.
- (save-excursion
- (save-restriction
- (widen)
- (narrow-to-region
- (save-excursion
- (unless (re-search-backward (concat "^" nnbabyl-mail-delimiter) nil t)
- (goto-char (point-min))
- (end-of-line))
- (if leave-delim (progn (forward-line 1) (point))
- (match-beginning 0)))
- (progn
- (forward-line 1)
- (or (and (re-search-forward (concat "^" nnbabyl-mail-delimiter)
- nil t)
- (match-beginning 0))
- (point-max))))
- (goto-char (point-min))
- ;; Only delete the article if no other groups owns it as well.
- (when (or force (not (re-search-forward "^X-Gnus-Newsgroup: " nil t)))
- (delete-region (point-min) (point-max))))))
-
-(defun nnbabyl-possibly-change-newsgroup (newsgroup &optional server)
- (when (and server
- (not (nnbabyl-server-opened server)))
- (nnbabyl-open-server server))
- (when (or (not nnbabyl-mbox-buffer)
- (not (buffer-name nnbabyl-mbox-buffer)))
- (save-excursion (nnbabyl-read-mbox)))
- (unless nnbabyl-group-alist
- (nnmail-activate 'nnbabyl))
- (if newsgroup
- (if (assoc newsgroup nnbabyl-group-alist)
- (setq nnbabyl-current-group newsgroup)
- (nnheader-report 'nnbabyl "No such group in file"))
- t))
-
-(defun nnbabyl-article-string (article)
- (if (numberp article)
- (concat "\nX-Gnus-Newsgroup: " nnbabyl-current-group ":"
- (int-to-string article) " ")
- (concat "\nMessage-ID: " article)))
-
-(defun nnbabyl-article-group-number ()
- (save-excursion
- (goto-char (point-min))
- (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
- nil t)
- (cons (buffer-substring (match-beginning 1) (match-end 1))
- (string-to-number
- (buffer-substring (match-beginning 2) (match-end 2)))))))
-
-(defun nnbabyl-insert-lines ()
- "Insert how many lines and chars there are in the body of the mail."
- (let (lines chars)
- (save-excursion
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- ;; There may be an EOOH line here...
- (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
- (search-forward "\n\n" nil t))
- (setq chars (- (point-max) (point))
- lines (max (- (count-lines (point) (point-max)) 1) 0))
- ;; Move back to the end of the headers.
- (goto-char (point-min))
- (search-forward "\n\n" nil t)
- (forward-char -1)
- (save-excursion
- (when (re-search-backward "^Lines: " nil t)
- (delete-region (point) (progn (forward-line 1) (point)))))
- (insert (format "Lines: %d\n" lines))
- chars))))
-
-(defun nnbabyl-save-mail (group-art)
- ;; Called narrowed to an article.
- (nnbabyl-insert-lines)
- (nnmail-insert-xref group-art)
- (nnbabyl-insert-newsgroup-line group-art)
- (run-hooks 'nnbabyl-prepare-save-mail-hook)
- group-art)
-
-(defun nnbabyl-insert-newsgroup-line (group-art)
- (save-excursion
- (goto-char (point-min))
- (while (looking-at "From ")
- (replace-match "Mail-from: From " t t)
- (forward-line 1))
- ;; If there is a C-l at the beginning of the narrowed region, this
- ;; isn't really a "save", but rather a "scan".
- (goto-char (point-min))
- (unless (looking-at "\^L")
- (save-excursion
- (insert "\^L\n0, unseen,,\n*** EOOH ***\n")
- (goto-char (point-max))
- (insert "\^_\n")))
- (when (search-forward "\n\n" nil t)
- (forward-char -1)
- (while group-art
- (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
- (caar group-art) (cdar group-art)
- (current-time-string)))
- (setq group-art (cdr group-art))))
- t))
-
-(defun nnbabyl-active-number (group)
- ;; Find the next article number in GROUP.
- (let ((active (cadr (assoc group nnbabyl-group-alist))))
- (if active
- (setcdr active (1+ (cdr active)))
- ;; This group is new, so we create a new entry for it.
- ;; This might be a bit naughty... creating groups on the drop of
- ;; a hat, but I don't know...
- (push (list group (setq active (cons 1 1)))
- nnbabyl-group-alist))
- (cdr active)))
-
-(defun nnbabyl-create-mbox ()
- (unless (file-exists-p nnbabyl-mbox-file)
- ;; Create a new, empty RMAIL mbox file.
- (save-excursion
- (set-buffer (setq nnbabyl-mbox-buffer
- (create-file-buffer nnbabyl-mbox-file)))
- (setq buffer-file-name nnbabyl-mbox-file)
- (insert "BABYL OPTIONS:\n\n\^_")
- (nnmail-write-region
- (point-min) (point-max) nnbabyl-mbox-file t 'nomesg))))
-
-(defun nnbabyl-read-mbox ()
- (nnmail-activate 'nnbabyl)
- (nnbabyl-create-mbox)
-
- (unless (and nnbabyl-mbox-buffer
- (buffer-name nnbabyl-mbox-buffer)
- (save-excursion
- (set-buffer nnbabyl-mbox-buffer)
- (= (buffer-size) (nnheader-file-size nnbabyl-mbox-file))))
- ;; This buffer has changed since we read it last. Possibly.
- (save-excursion
- (let ((delim (concat "^" nnbabyl-mail-delimiter))
- (alist nnbabyl-group-alist)
- start end number)
- (set-buffer (setq nnbabyl-mbox-buffer
- (nnheader-find-file-noselect
- nnbabyl-mbox-file nil t)))
- ;; Save previous buffer mode.
- (setq nnbabyl-previous-buffer-mode
- (cons (cons (point-min) (point-max))
- major-mode))
-
- (buffer-disable-undo)
- (widen)
- (setq buffer-read-only nil)
- (fundamental-mode)
-
- ;; Go through the group alist and compare against
- ;; the rmail file.
- (while alist
- (goto-char (point-max))
- (when (and (re-search-backward
- (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
- (caar alist))
- nil t)
- (> (setq number
- (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1))))
- (cdadar alist)))
- (setcdr (cadar alist) number))
- (setq alist (cdr alist)))
-
- ;; We go through the mbox and make sure that each and
- ;; every mail belongs to some group or other.
- (goto-char (point-min))
- (if (looking-at "\^L")
- (setq start (point))
- (re-search-forward delim nil t)
- (setq start (match-end 0)))
- (while (re-search-forward delim nil t)
- (setq end (match-end 0))
- (unless (search-backward "\nX-Gnus-Newsgroup: " start t)
- (goto-char end)
- (save-excursion
- (save-restriction
- (narrow-to-region (goto-char start) end)
- (nnbabyl-save-mail
- (nnmail-article-group 'nnbabyl-active-number))
- (setq end (point-max)))))
- (goto-char (setq start end)))
- (when (buffer-modified-p (current-buffer))
- (save-buffer))
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)))))
-
-(defun nnbabyl-remove-incoming-delims ()
- (goto-char (point-min))
- (while (search-forward "\^_" nil t)
- (replace-match "?" t t)))
-
-(defun nnbabyl-check-mbox ()
- "Go through the nnbabyl mbox and make sure that no article numbers are reused."
- (interactive)
- (let ((idents (make-vector 1000 0))
- id)
- (save-excursion
- (when (or (not nnbabyl-mbox-buffer)
- (not (buffer-name nnbabyl-mbox-buffer)))
- (nnbabyl-read-mbox))
- (set-buffer nnbabyl-mbox-buffer)
- (goto-char (point-min))
- (while (re-search-forward "^X-Gnus-Newsgroup: \\([^ ]+\\) " nil t)
- (if (intern-soft (setq id (match-string 1)) idents)
- (progn
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
- (nnheader-message 7 "Moving %s..." id)
- (nnbabyl-save-mail
- (nnmail-article-group 'nnbabyl-active-number)))
- (intern id idents)))
- (when (buffer-modified-p (current-buffer))
- (save-buffer))
- (nnmail-save-active nnbabyl-group-alist nnbabyl-active-file)
- (nnheader-message 5 ""))))
-
-(provide 'nnbabyl)
-
-;;; arch-tag: aa7ddedb-8c07-4c0e-beb0-58e795c2b81b
-;;; nnbabyl.el ends here
+++ /dev/null
-;;; nndb.el --- nndb access for Gnus
-
-;; Copyright (C) 1997, 1998, 2000, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Kai Grossjohann <grossjohann@ls6.informatik.uni-dortmund.de>
-;; Joe Hildebrand <joe.hildebrand@ilg.com>
-;; David Blacka <davidb@rwhois.net>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This was based upon Kai Grossjohan's shamessly snarfed code and
-;;; further modified by Joe Hildebrand. It has been updated for Red
-;;; Gnus.
-
-;; TODO:
-;;
-;; * Fix bug where server connection can be lost and impossible to regain
-;; This hasn't happened to me in a while; think it was fixed in Rgnus
-;;
-;; * make it handle different nndb servers seemlessly
-;;
-;; * Optimize expire if FORCE
-;;
-;; * Optimize move (only expire once)
-;;
-;; * Deal with add/deletion of groups
-;;
-;; * make the backend TOUCH an article when marked as expireable (will
-;; make article expire 'expiry' days after that moment).
-
-;;-
-;; Register nndb with known select methods.
-
-(require 'gnus-start)
-(unless (assoc "nndb" gnus-valid-select-methods)
- (gnus-declare-backend "nndb" 'mail 'respool 'address 'prompt-address))
-
-;;; Code:
-
-(require 'nnmail)
-(require 'nnheader)
-(require 'nntp)
-(eval-when-compile (require 'cl))
-
-;; Declare nndb as derived from nntp
-
-(nnoo-declare nndb nntp)
-
-;; Variables specific to nndb
-
-;;- currently not used but just in case...
-(defvoo nndb-deliver-program "nndel"
- "*The program used to put a message in an NNDB group.")
-
-(defvoo nndb-server-side-expiry nil
- "If t, expiry calculation will occur on the server side.")
-
-(defvoo nndb-set-expire-date-on-mark nil
- "If t, the expiry date for a given article will be set to the time
-it was marked as expireable; otherwise the date will be the time the
-article was posted to nndb")
-
-;; Variables copied from nntp
-
-(defvoo nndb-server-opened-hook '(nntp-send-authinfo-from-file)
- "Like nntp-server-opened-hook."
- nntp-server-opened-hook)
-
-(defvoo nndb-address "localhost"
- "*The name of the NNDB server."
- nntp-address)
-
-(defvoo nndb-port-number 9000
- "*Port number to connect to."
- nntp-port-number)
-
-;; change to 'news if you are actually using nndb for news
-(defvoo nndb-article-type 'mail)
-
-(defvoo nndb-status-string nil "" nntp-status-string)
-
-\f
-
-(defconst nndb-version "nndb 0.7"
- "Version numbers of this version of NNDB.")
-
-\f
-;;; Interface functions.
-
-(nnoo-define-basics nndb)
-
-;;------------------------------------------------------------------
-
-;; this function turns the lisp list into a string list. There is
-;; probably a more efficient way to do this.
-(defun nndb-build-article-string (articles)
- (let (art-string art)
- (while articles
- (setq art (pop articles))
- (setq art-string (concat art-string art " ")))
- art-string))
-
-(defun nndb-build-expire-rest-list (total expire)
- (let (art rest)
- (while total
- (setq art (pop total))
- (if (memq art expire)
- ()
- (push art rest)))
- rest))
-
-
-;;
-(deffoo nndb-request-type (group &optional article)
- nndb-article-type)
-
-;; nndb-request-update-info does not exist and is not needed
-
-;; nndb-request-update-mark does not exist; it should be used to TOUCH
-;; articles as they are marked exipirable
-(defun nndb-touch-article (group article)
- (nntp-send-command nil "X-TOUCH" article))
-
-(deffoo nndb-request-update-mark
- (group article mark)
- "Sets the expiry date for ARTICLE in GROUP to now, if the mark is 'E'"
- (if (and nndb-set-expire-date-on-mark (string-equal mark "E"))
- (nndb-touch-article group article))
- mark)
-
-;; nndb-request-create-group -- currently this isn't necessary; nndb
-;; creates groups on demand.
-
-;; todo -- use some other time than the creation time of the article
-;; best is time since article has been marked as expirable
-
-(defun nndb-request-expire-articles-local
- (articles &optional group server force)
- "Let gnus do the date check and issue the delete commands."
- (let (msg art delete-list (num-delete 0) rest)
- (nntp-possibly-change-group group server)
- (while articles
- (setq art (pop articles))
- (nntp-send-command "^\\([23]\\|^423\\).*\n" "X-DATE" art)
- (setq msg (nndb-status-message))
- (if (string-match "^423" msg)
- ()
- (or (string-match "'\\(.+\\)'" msg)
- (error "Not a valid response for X-DATE command: %s"
- msg))
- (if (nnmail-expired-article-p
- group
- (date-to-time (substring msg (match-beginning 1) (match-end 1)))
- force)
- (progn
- (setq delete-list (concat delete-list " " (int-to-string art)))
- (setq num-delete (1+ num-delete)))
- (push art rest))))
- (if (> (length delete-list) 0)
- (progn
- (nnheader-message 5 "Deleting %s article(s) from %s"
- (int-to-string num-delete) group)
- (nntp-send-command "^[23].*\n" "X-DELETE" delete-list))
- )
-
- (nnheader-message 5 "")
- (nconc rest articles)))
-
-(defun nndb-get-remote-expire-response ()
- (let (list)
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (if (looking-at "^[34]")
- ;; x-expire returned error--presume no articles were expirable)
- (setq list nil)
- ;; otherwise, pull all of the following numbers into the list
- (re-search-forward "follows\r?\n?" nil t)
- (while (re-search-forward "^[0-9]+$" nil t)
- (push (string-to-number (match-string 0)) list)))
- list))
-
-(defun nndb-request-expire-articles-remote
- (articles &optional group server force)
- "Let the nndb backend expire articles"
- (let (days art-string delete-list (num-delete 0))
- (nntp-possibly-change-group group server)
-
- ;; first calculate the wait period in days
- (setq days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait))
- ;; now handle the special cases
- (cond (force
- (setq days 0))
- ((eq days 'never)
- ;; This isn't an expirable group.
- (setq days -1))
- ((eq days 'immediate)
- (setq days 0)))
-
-
- ;; build article string
- (setq art-string (concat days " " (nndb-build-article-string articles)))
- (nntp-send-command "^\.\r?\n\\|^[345].*\n" "X-EXPIRE" art-string)
-
- (setq delete-list (nndb-get-remote-expire-response))
- (setq num-delete (length delete-list))
- (if (> num-delete 0)
- (nnheader-message 5 "Deleting %s article(s) from %s"
- (int-to-string num-delete) group))
-
- (nndb-build-expire-rest-list articles delete-list)))
-
-(deffoo nndb-request-expire-articles
- (articles &optional group server force)
- "Expires ARTICLES from GROUP on SERVER.
-If FORCE, delete regardless of exiration date, otherwise use normal
-expiry mechanism."
- (if nndb-server-side-expiry
- (nndb-request-expire-articles-remote articles group server force)
- (nndb-request-expire-articles-local articles group server force)))
-
-(deffoo nndb-request-move-article
- (article group server accept-form &optional last)
- "Move ARTICLE (a number) from GROUP on SERVER.
-Evals ACCEPT-FORM in current buffer, where the article is.
-Optional LAST is ignored."
- ;; we guess that the second arg in accept-form is the new group,
- ;; which it will be for nndb, which is all that matters anyway
- (let ((new-group (nth 1 accept-form)) result)
- (nntp-possibly-change-group group server)
-
- ;; use the move command for nndb-to-nndb moves
- (if (string-match "^nndb" new-group)
- (let ((new-group-name (gnus-group-real-name new-group)))
- (nntp-send-command "^[23].*\n" "X-MOVE" article new-group-name)
- (cons new-group article))
- ;; else move normally
- (let ((artbuf (get-buffer-create " *nndb move*")))
- (and
- (nndb-request-article article group server artbuf)
- (save-excursion
- (set-buffer artbuf)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result)
- (nndb-request-expire-articles (list article)
- group
- server
- t))
- result)
- )))
-
-(deffoo nndb-request-accept-article (group server &optional last)
- "The article in the current buffer is put into GROUP."
- (nntp-possibly-change-group group server)
- (let (art msg)
- (when (nntp-send-command "^[23].*\r?\n" "ACCEPT" group)
- (nnheader-insert "")
- (nntp-send-buffer "^[23].*\n"))
-
- (set-buffer nntp-server-buffer)
- (setq msg (buffer-string))
- (or (string-match "^\\([0-9]+\\)" msg)
- (error "nndb: %s" msg))
- (setq art (substring msg (match-beginning 1) (match-end 1)))
- (nnheader-message 5 "nndb: accepted %s" art)
- (list art)))
-
-(deffoo nndb-request-replace-article (article group buffer)
- "ARTICLE is the number of the article in GROUP to be replaced with the contents of the BUFFER."
- (set-buffer buffer)
- (when (nntp-send-command "^[23].*\r?\n" "X-REPLACE" (int-to-string article))
- (nnheader-insert "")
- (nntp-send-buffer "^[23.*\n")
- (list (int-to-string article))))
-
- ; nndb-request-delete-group does not exist
- ; todo -- maybe later
-
- ; nndb-request-rename-group does not exist
- ; todo -- maybe later
-
-;; -- standard compatability functions
-
-(deffoo nndb-status-message (&optional server)
- "Return server status as a string."
- (set-buffer nntp-server-buffer)
- (buffer-string))
-
-;; Import stuff from nntp
-
-(nnoo-import nndb
- (nntp))
-
-(provide 'nndb)
-
-;;; arch-tag: 83bd6fb4-58d9-4fed-a901-c6c625ad5f8a
-;;; nndb.el ends here
+++ /dev/null
-;;; nndiary.el --- A diary back end for Gnus
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Didier Verna <didier@xemacs.org>
-;; Maintainer: Didier Verna <didier@xemacs.org>
-;; Created: Fri Jul 16 18:55:42 1999
-;; Keywords: calendar mail 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-
-;;; Commentary:
-
-;; Contents management by FCM version 0.1.
-
-;; Description:
-;; ===========
-
-;; nndiary is a mail back end designed to handle mails as diary event
-;; reminders. It is now fully documented in the Gnus manual.
-
-
-;; Bugs / Todo:
-;; ===========
-
-;; * Respooling doesn't work because contrary to the request-scan function,
-;; Gnus won't allow me to override the split methods when calling the
-;; respooling back end functions.
-;; * There's a bug in the time zone mechanism with variable TZ locations.
-;; * We could allow a keyword like `ask' in X-Diary-* headers, that would mean
-;; "ask for value upon reception of the message".
-;; * We could add an optional header X-Diary-Reminders to specify a special
-;; reminders value for this message. Suggested by Jody Klymak.
-;; * We should check messages validity in other circumstances than just
-;; moving an article from somewhere else (request-accept). For instance,
-;; when editing / saving and so on.
-
-
-;; Remarks:
-;; =======
-
-;; * nnoo. NNDiary is very similar to nnml. This makes the idea of using nnoo
-;; (to derive nndiary from nnml) natural. However, my experience with nnoo
-;; is that for reasonably complex back ends like this one, noo is a burden
-;; rather than an help. It's tricky to use, not everything can be inherited,
-;; what can be inherited and when is not very clear, and you've got to be
-;; very careful because a little mistake can fuck up your other back ends,
-;; especially because their variables will be use instead of your real ones.
-;; Finally, I found it easier to just clone the needed parts of nnml, and
-;; tracking nnml updates is not a big deal.
-
-;; IMHO, nnoo is actually badly designed. A much simpler, and yet more
-;; powerful one would be to make *real* functions and variables for a new
-;; back end based on another. Lisp is a reflexive language so that's a very
-;; easy thing to do: inspect the function's form, replace occurences of
-;; <nnfrom> (even in strings) with <nnto>, and you're done.
-
-;; * nndiary-get-new-mail, nndiary-mail-source and nndiary-split-methods:
-;; NNDiary has some experimental parts, in the sense Gnus normally uses only
-;; one mail back ends for mail retreival and splitting. This back end is
-;; also an attempt to make it behave differently. For Gnus developpers: as
-;; you can see if you snarf into the code, that was not a very difficult
-;; thing to do. Something should be done about the respooling breakage
-;; though.
-
-
-;;; Code:
-
-(require 'nnoo)
-(require 'nnheader)
-(require 'nnmail)
-(eval-when-compile (require 'cl))
-
-(require 'gnus-start)
-(require 'gnus-sum)
-
-;; Compatibility Functions =================================================
-
-(eval-and-compile
- (if (fboundp 'signal-error)
- (defun nndiary-error (&rest args)
- (apply #'signal-error 'nndiary args))
- (defun nndiary-error (&rest args)
- (apply #'error args))))
-
-
-;; Back End behavior customization ===========================================
-
-(defgroup nndiary nil
- "The Gnus Diary back end."
- :version "22.1"
- :group 'gnus-diary)
-
-(defcustom nndiary-mail-sources
- `((file :path ,(expand-file-name "~/.nndiary")))
- "*NNDiary specific mail sources.
-This variable is used by nndiary in place of the standard `mail-sources'
-variable when `nndiary-get-new-mail' is set to non-nil. These sources
-must contain diary messages ONLY."
- :group 'nndiary
- :group 'mail-source
- :type 'sexp)
-
-(defcustom nndiary-split-methods '(("diary" ""))
- "*NNDiary specific split methods.
-This variable is used by nndiary in place of the standard
-`nnmail-split-methods' variable when `nndiary-get-new-mail' is set to
-non-nil."
- :group 'nndiary
- :group 'nnmail-split
- :type '(choice (repeat :tag "Alist" (group (string :tag "Name") regexp))
- (function-item nnmail-split-fancy)
- (function :tag "Other")))
-
-
-(defcustom nndiary-reminders '((0 . day))
- "*Different times when you want to be reminded of your appointments.
-Diary articles will appear again, as if they'd been just received.
-
-Entries look like (3 . day) which means something like \"Please
-Hortense, would you be so kind as to remind me of my appointments 3 days
-before the date, thank you very much. Anda, hmmm... by the way, are you
-doing anything special tonight ?\".
-
-The units of measure are 'minute 'hour 'day 'week 'month and 'year (no,
-not 'century, sorry).
-
-NOTE: the units of measure actually express dates, not durations: if you
-use 'week, messages will pop up on Sundays at 00:00 (or Mondays if
-`nndiary-week-starts-on-monday' is non-nil) and *not* 7 days before the
-appointment, if you use 'month, messages will pop up on the first day of
-each months, at 00:00 and so on.
-
-If you really want to specify a duration (like 24 hours exactly), you can
-use the equivalent in minutes (the smallest unit). A fuzz of 60 seconds
-maximum in the reminder is not that painful, I think. Although this
-scheme might appear somewhat weird at a first glance, it is very powerful.
-In order to make this clear, here are some examples:
-
-- '(0 . day): this is the default value of `nndiary-reminders'. It means
- pop up the appointments of the day each morning at 00:00.
-
-- '(1 . day): this means pop up the appointments the day before, at 00:00.
-
-- '(6 . hour): for an appointment at 18:30, this would pop up the
- appointment message at 12:00.
-
-- '(360 . minute): for an appointment at 18:30 and 15 seconds, this would
- pop up the appointment message at 12:30."
- :group 'nndiary
- :type '(repeat (cons :format "%v\n"
- (integer :format "%v")
- (choice :format "%[%v(s)%] before...\n"
- :value day
- (const :format "%v" minute)
- (const :format "%v" hour)
- (const :format "%v" day)
- (const :format "%v" week)
- (const :format "%v" month)
- (const :format "%v" year)))))
-
-(defcustom nndiary-week-starts-on-monday nil
- "*Whether a week starts on monday (otherwise, sunday)."
- :type 'boolean
- :group 'nndiary)
-
-
-(defcustom nndiary-request-create-group-hooks nil
- "*Hooks to run after `nndiary-request-create-group' is executed.
-The hooks will be called with the full group name as argument."
- :group 'nndiary
- :type 'hook)
-
-(defcustom nndiary-request-update-info-hooks nil
- "*Hooks to run after `nndiary-request-update-info-group' is executed.
-The hooks will be called with the full group name as argument."
- :group 'nndiary
- :type 'hook)
-
-(defcustom nndiary-request-accept-article-hooks nil
- "*Hooks to run before accepting an article.
-Executed near the beginning of `nndiary-request-accept-article'.
-The hooks will be called with the article in the current buffer."
- :group 'nndiary
- :type 'hook)
-
-(defcustom nndiary-check-directory-twice t
- "*If t, check directories twice to avoid NFS failures."
- :group 'nndiary
- :type 'boolean)
-
-
-;; Back End declaration ======================================================
-
-;; Well, most of this is nnml clonage.
-
-(nnoo-declare nndiary)
-
-(defvoo nndiary-directory (nnheader-concat gnus-directory "diary/")
- "Spool directory for the nndiary back end.")
-
-(defvoo nndiary-active-file
- (expand-file-name "active" nndiary-directory)
- "Active file for the nndiary back end.")
-
-(defvoo nndiary-newsgroups-file
- (expand-file-name "newsgroups" nndiary-directory)
- "Newsgroups description file for the nndiary back end.")
-
-(defvoo nndiary-get-new-mail nil
- "Whether nndiary gets new mail and split it.
-Contrary to traditional mail back ends, this variable can be set to t
-even if your primary mail back end also retreives mail. In such a case,
-NDiary uses its own mail-sources and split-methods.")
-
-(defvoo nndiary-nov-is-evil nil
- "If non-nil, Gnus will never use nov databases for nndiary groups.
-Using nov databases will speed up header fetching considerably.
-This variable shouldn't be flipped much. If you have, for some reason,
-set this to t, and want to set it to nil again, you should always run
-the `nndiary-generate-nov-databases' command. The function will go
-through all nnml directories and generate nov databases for them
-all. This may very well take some time.")
-
-(defvoo nndiary-prepare-save-mail-hook nil
- "*Hook run narrowed to an article before saving.")
-
-(defvoo nndiary-inhibit-expiry nil
- "If non-nil, inhibit expiry.")
-
-\f
-
-(defconst nndiary-version "0.2-b14"
- "Current Diary back end version.")
-
-(defun nndiary-version ()
- "Current Diary back end version."
- (interactive)
- (message "NNDiary version %s" nndiary-version))
-
-(defvoo nndiary-nov-file-name ".overview")
-
-(defvoo nndiary-current-directory nil)
-(defvoo nndiary-current-group nil)
-(defvoo nndiary-status-string "" )
-(defvoo nndiary-nov-buffer-alist nil)
-(defvoo nndiary-group-alist nil)
-(defvoo nndiary-active-timestamp nil)
-(defvoo nndiary-article-file-alist nil)
-
-(defvoo nndiary-generate-active-function 'nndiary-generate-active-info)
-(defvoo nndiary-nov-buffer-file-name nil)
-(defvoo nndiary-file-coding-system nnmail-file-coding-system)
-
-(defconst nndiary-headers
- '(("Minute" 0 59)
- ("Hour" 0 23)
- ("Dom" 1 31)
- ("Month" 1 12)
- ("Year" 1971)
- ("Dow" 0 6)
- ("Time-Zone" (("Y" -43200)
-
- ("X" -39600)
-
- ("W" -36000)
-
- ("V" -32400)
-
- ("U" -28800)
- ("PST" -28800)
-
- ("T" -25200)
- ("MST" -25200)
- ("PDT" -25200)
-
- ("S" -21600)
- ("CST" -21600)
- ("MDT" -21600)
-
- ("R" -18000)
- ("EST" -18000)
- ("CDT" -18000)
-
- ("Q" -14400)
- ("AST" -14400)
- ("EDT" -14400)
-
- ("P" -10800)
- ("ADT" -10800)
-
- ("O" -7200)
-
- ("N" -3600)
-
- ("Z" 0)
- ("GMT" 0)
- ("UT" 0)
- ("UTC" 0)
- ("WET" 0)
-
- ("A" 3600)
- ("CET" 3600)
- ("MET" 3600)
- ("MEZ" 3600)
- ("BST" 3600)
- ("WEST" 3600)
-
- ("B" 7200)
- ("EET" 7200)
- ("CEST" 7200)
- ("MEST" 7200)
- ("MESZ" 7200)
-
- ("C" 10800)
-
- ("D" 14400)
-
- ("E" 18000)
-
- ("F" 21600)
-
- ("G" 25200)
-
- ("H" 28800)
-
- ("I" 32400)
- ("JST" 32400)
-
- ("K" 36000)
- ("GST" 36000)
-
- ("L" 39600)
-
- ("M" 43200)
- ("NZST" 43200)
-
- ("NZDT" 46800))))
- ;; List of NNDiary headers that specify the time spec. Each header name is
- ;; followed by either two integers (specifying a range of possible values
- ;; for this header) or one list (specifying all the possible values for this
- ;; header). In the latter case, the list does NOT include the unspecifyed
- ;; spec (*).
- ;; For time zone values, we have symbolic time zone names associated with
- ;; the (relative) number of seconds ahead GMT.
- )
-
-(defsubst nndiary-schedule ()
- (let (head)
- (condition-case arg
- (mapcar
- (lambda (elt)
- (setq head (nth 0 elt))
- (nndiary-parse-schedule (nth 0 elt) (nth 1 elt) (nth 2 elt)))
- nndiary-headers)
- (t
- (nnheader-report 'nndiary "X-Diary-%s header parse error: %s."
- head (cdr arg))
- nil))
- ))
-
-;;; Interface functions =====================================================
-
-(nnoo-define-basics nndiary)
-
-(deffoo nndiary-retrieve-headers (sequence &optional group server fetch-old)
- (when (nndiary-possibly-change-directory group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let* ((file nil)
- (number (length sequence))
- (count 0)
- (file-name-coding-system nnmail-pathname-coding-system)
- beg article
- (nndiary-check-directory-twice
- (and nndiary-check-directory-twice
- ;; To speed up, disable it in some case.
- (or (not (numberp nnmail-large-newsgroup))
- (<= number nnmail-large-newsgroup)))))
- (if (stringp (car sequence))
- 'headers
- (if (nndiary-retrieve-headers-with-nov sequence fetch-old)
- 'nov
- (while sequence
- (setq article (car sequence))
- (setq file (nndiary-article-to-file article))
- (when (and file
- (file-exists-p file)
- (not (file-directory-p file)))
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (nnheader-insert-head file)
- (goto-char beg)
- (if (search-forward "\n\n" nil t)
- (forward-char -1)
- (goto-char (point-max))
- (insert "\n\n"))
- (insert ".\n")
- (delete-region (point) (point-max)))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (zerop (% count 20))
- (nnheader-message 6 "nndiary: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (nnheader-message 6 "nndiary: Receiving headers...done"))
-
- (nnheader-fold-continuation-lines)
- 'headers))))))
-
-(deffoo nndiary-open-server (server &optional defs)
- (nnoo-change-server 'nndiary server defs)
- (when (not (file-exists-p nndiary-directory))
- (ignore-errors (make-directory nndiary-directory t)))
- (cond
- ((not (file-exists-p nndiary-directory))
- (nndiary-close-server)
- (nnheader-report 'nndiary "Couldn't create directory: %s"
- nndiary-directory))
- ((not (file-directory-p (file-truename nndiary-directory)))
- (nndiary-close-server)
- (nnheader-report 'nndiary "Not a directory: %s" nndiary-directory))
- (t
- (nnheader-report 'nndiary "Opened server %s using directory %s"
- server nndiary-directory)
- t)))
-
-(deffoo nndiary-request-regenerate (server)
- (nndiary-possibly-change-directory nil server)
- (nndiary-generate-nov-databases server)
- t)
-
-(deffoo nndiary-request-article (id &optional group server buffer)
- (nndiary-possibly-change-directory group server)
- (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
- (file-name-coding-system nnmail-pathname-coding-system)
- path gpath group-num)
- (if (stringp id)
- (when (and (setq group-num (nndiary-find-group-number id))
- (cdr
- (assq (cdr group-num)
- (nnheader-article-to-file-alist
- (setq gpath
- (nnmail-group-pathname
- (car group-num)
- nndiary-directory))))))
- (setq path (concat gpath (int-to-string (cdr group-num)))))
- (setq path (nndiary-article-to-file id)))
- (cond
- ((not path)
- (nnheader-report 'nndiary "No such article: %s" id))
- ((not (file-exists-p path))
- (nnheader-report 'nndiary "No such file: %s" path))
- ((file-directory-p path)
- (nnheader-report 'nndiary "File is a directory: %s" path))
- ((not (save-excursion (let ((nnmail-file-coding-system
- nndiary-file-coding-system))
- (nnmail-find-file path))))
- (nnheader-report 'nndiary "Couldn't read file: %s" path))
- (t
- (nnheader-report 'nndiary "Article %s retrieved" id)
- ;; We return the article number.
- (cons (if group-num (car group-num) group)
- (string-to-number (file-name-nondirectory path)))))))
-
-(deffoo nndiary-request-group (group &optional server dont-check)
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (cond
- ((not (nndiary-possibly-change-directory group server))
- (nnheader-report 'nndiary "Invalid group (no such directory)"))
- ((not (file-exists-p nndiary-current-directory))
- (nnheader-report 'nndiary "Directory %s does not exist"
- nndiary-current-directory))
- ((not (file-directory-p nndiary-current-directory))
- (nnheader-report 'nndiary "%s is not a directory"
- nndiary-current-directory))
- (dont-check
- (nnheader-report 'nndiary "Group %s selected" group)
- t)
- (t
- (nnheader-re-read-dir nndiary-current-directory)
- (nnmail-activate 'nndiary)
- (let ((active (nth 1 (assoc group nndiary-group-alist))))
- (if (not active)
- (nnheader-report 'nndiary "No such group: %s" group)
- (nnheader-report 'nndiary "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (max (1+ (- (cdr active) (car active))) 0)
- (car active) (cdr active) group)))))))
-
-(deffoo nndiary-request-scan (&optional group server)
- ;; Use our own mail sources and split methods while Gnus doesn't let us have
- ;; multiple back ends for retrieving mail.
- (let ((mail-sources nndiary-mail-sources)
- (nnmail-split-methods nndiary-split-methods))
- (setq nndiary-article-file-alist nil)
- (nndiary-possibly-change-directory group server)
- (nnmail-get-new-mail 'nndiary 'nndiary-save-nov nndiary-directory group)))
-
-(deffoo nndiary-close-group (group &optional server)
- (setq nndiary-article-file-alist nil)
- t)
-
-(deffoo nndiary-request-create-group (group &optional server args)
- (nndiary-possibly-change-directory nil server)
- (nnmail-activate 'nndiary)
- (cond
- ((assoc group nndiary-group-alist)
- t)
- ((and (file-exists-p (nnmail-group-pathname group nndiary-directory))
- (not (file-directory-p (nnmail-group-pathname
- group nndiary-directory))))
- (nnheader-report 'nndiary "%s is a file"
- (nnmail-group-pathname group nndiary-directory)))
- (t
- (let (active)
- (push (list group (setq active (cons 1 0)))
- nndiary-group-alist)
- (nndiary-possibly-create-directory group)
- (nndiary-possibly-change-directory group server)
- (let ((articles (nnheader-directory-articles nndiary-current-directory)))
- (when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))
- (nnmail-save-active nndiary-group-alist nndiary-active-file)
- (run-hook-with-args 'nndiary-request-create-group-hooks
- (gnus-group-prefixed-name group
- (list "nndiary" server)))
- t))
- ))
-
-(deffoo nndiary-request-list (&optional server)
- (save-excursion
- (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (nnmail-find-file nndiary-active-file))
- (setq nndiary-group-alist (nnmail-get-active))
- t))
-
-(deffoo nndiary-request-newgroups (date &optional server)
- (nndiary-request-list server))
-
-(deffoo nndiary-request-list-newsgroups (&optional server)
- (save-excursion
- (nnmail-find-file nndiary-newsgroups-file)))
-
-(deffoo nndiary-request-expire-articles (articles group &optional server force)
- (nndiary-possibly-change-directory group server)
- (let ((active-articles
- (nnheader-directory-articles nndiary-current-directory))
- article rest number)
- (nnmail-activate 'nndiary)
- ;; Articles not listed in active-articles are already gone,
- ;; so don't try to expire them.
- (setq articles (gnus-intersection articles active-articles))
- (while articles
- (setq article (nndiary-article-to-file (setq number (pop articles))))
- (if (and (nndiary-deletable-article-p group number)
- ;; Don't use nnmail-expired-article-p. Our notion of expiration
- ;; is a bit peculiar ...
- (or force (nndiary-expired-article-p article)))
- (progn
- ;; Allow a special target group.
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nndiary-request-article number group server (current-buffer))
- (let ((nndiary-current-directory nil))
- (nnmail-expiry-target-group nnmail-expiry-target group)))
- (nndiary-possibly-change-directory group server))
- (nnheader-message 5 "Deleting article %s in %s" number group)
- (condition-case ()
- (funcall nnmail-delete-file-function article)
- (file-error (push number rest)))
- (setq active-articles (delq number active-articles))
- (nndiary-nov-delete-article group number))
- (push number rest)))
- (let ((active (nth 1 (assoc group nndiary-group-alist))))
- (when active
- (setcar active (or (and active-articles
- (apply 'min active-articles))
- (1+ (cdr active)))))
- (nnmail-save-active nndiary-group-alist nndiary-active-file))
- (nndiary-save-nov)
- (nconc rest articles)))
-
-(deffoo nndiary-request-move-article
- (article group server accept-form &optional last)
- (let ((buf (get-buffer-create " *nndiary move*"))
- result)
- (nndiary-possibly-change-directory group server)
- (nndiary-update-file-alist)
- (and
- (nndiary-deletable-article-p group article)
- (nndiary-request-article article group server)
- (let (nndiary-current-directory
- nndiary-current-group
- nndiary-article-file-alist)
- (save-excursion
- (set-buffer buf)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result))
- (progn
- (nndiary-possibly-change-directory group server)
- (condition-case ()
- (funcall nnmail-delete-file-function
- (nndiary-article-to-file article))
- (file-error nil))
- (nndiary-nov-delete-article group article)
- (when last
- (nndiary-save-nov)
- (nnmail-save-active nndiary-group-alist nndiary-active-file))))
- result))
-
-(deffoo nndiary-request-accept-article (group &optional server last)
- (nndiary-possibly-change-directory group server)
- (nnmail-check-syntax)
- (run-hooks 'nndiary-request-accept-article-hooks)
- (when (nndiary-schedule)
- (let (result)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")))
- (if (stringp group)
- (and
- (nnmail-activate 'nndiary)
- (setq result
- (car (nndiary-save-mail
- (list (cons group (nndiary-active-number group))))))
- (progn
- (nnmail-save-active nndiary-group-alist nndiary-active-file)
- (and last (nndiary-save-nov))))
- (and
- (nnmail-activate 'nndiary)
- (if (and (not (setq result
- (nnmail-article-group 'nndiary-active-number)))
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nndiary-save-mail result))))
- (when last
- (nnmail-save-active nndiary-group-alist nndiary-active-file)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close))
- (nndiary-save-nov))))
- result))
- )
-
-(deffoo nndiary-request-post (&optional server)
- (nnmail-do-request-post 'nndiary-request-accept-article server))
-
-(deffoo nndiary-request-replace-article (article group buffer)
- (nndiary-possibly-change-directory group)
- (save-excursion
- (set-buffer buffer)
- (nndiary-possibly-create-directory group)
- (let ((chars (nnmail-insert-lines))
- (art (concat (int-to-string article) "\t"))
- headers)
- (when (ignore-errors
- (nnmail-write-region
- (point-min) (point-max)
- (or (nndiary-article-to-file article)
- (expand-file-name (int-to-string article)
- nndiary-current-directory))
- nil (if (nnheader-be-verbose 5) nil 'nomesg))
- t)
- (setq headers (nndiary-parse-head chars article))
- ;; Replace the NOV line in the NOV file.
- (save-excursion
- (set-buffer (nndiary-open-nov group))
- (goto-char (point-min))
- (if (or (looking-at art)
- (search-forward (concat "\n" art) nil t))
- ;; Delete the old NOV line.
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point)))
- ;; The line isn't here, so we have to find out where
- ;; we should insert it. (This situation should never
- ;; occur, but one likes to make sure...)
- (while (and (looking-at "[0-9]+\t")
- (< (string-to-number
- (buffer-substring
- (match-beginning 0) (match-end 0)))
- article)
- (zerop (forward-line 1)))))
- (beginning-of-line)
- (nnheader-insert-nov headers)
- (nndiary-save-nov)
- t)))))
-
-(deffoo nndiary-request-delete-group (group &optional force server)
- (nndiary-possibly-change-directory group server)
- (when force
- ;; Delete all articles in GROUP.
- (let ((articles
- (directory-files
- nndiary-current-directory t
- (concat nnheader-numerical-short-files
- "\\|" (regexp-quote nndiary-nov-file-name) "$")))
- article)
- (while articles
- (setq article (pop articles))
- (when (file-writable-p article)
- (nnheader-message 5 "Deleting article %s in %s..." article group)
- (funcall nnmail-delete-file-function article))))
- ;; Try to delete the directory itself.
- (ignore-errors (delete-directory nndiary-current-directory)))
- ;; Remove the group from all structures.
- (setq nndiary-group-alist
- (delq (assoc group nndiary-group-alist) nndiary-group-alist)
- nndiary-current-group nil
- nndiary-current-directory nil)
- ;; Save the active file.
- (nnmail-save-active nndiary-group-alist nndiary-active-file)
- t)
-
-(deffoo nndiary-request-rename-group (group new-name &optional server)
- (nndiary-possibly-change-directory group server)
- (let ((new-dir (nnmail-group-pathname new-name nndiary-directory))
- (old-dir (nnmail-group-pathname group nndiary-directory)))
- (when (ignore-errors
- (make-directory new-dir t)
- t)
- ;; We move the articles file by file instead of renaming
- ;; the directory -- there may be subgroups in this group.
- ;; One might be more clever, I guess.
- (let ((files (nnheader-article-to-file-alist old-dir)))
- (while files
- (rename-file
- (concat old-dir (cdar files))
- (concat new-dir (cdar files)))
- (pop files)))
- ;; Move .overview file.
- (let ((overview (concat old-dir nndiary-nov-file-name)))
- (when (file-exists-p overview)
- (rename-file overview (concat new-dir nndiary-nov-file-name))))
- (when (<= (length (directory-files old-dir)) 2)
- (ignore-errors (delete-directory old-dir)))
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nndiary-group-alist)))
- (when entry
- (setcar entry new-name))
- (setq nndiary-current-directory nil
- nndiary-current-group nil)
- ;; Save the new group alist.
- (nnmail-save-active nndiary-group-alist nndiary-active-file)
- t))))
-
-(deffoo nndiary-set-status (article name value &optional group server)
- (nndiary-possibly-change-directory group server)
- (let ((file (nndiary-article-to-file article)))
- (cond
- ((not (file-exists-p file))
- (nnheader-report 'nndiary "File %s does not exist" file))
- (t
- (with-temp-file file
- (nnheader-insert-file-contents file)
- (nnmail-replace-status name value))
- t))))
-
-\f
-;;; Interface optional functions ============================================
-
-(deffoo nndiary-request-update-info (group info &optional server)
- (nndiary-possibly-change-directory group)
- (let ((timestamp (gnus-group-parameter-value (gnus-info-params info)
- 'timestamp t)))
- (if (not timestamp)
- (nnheader-report 'nndiary "Group %s doesn't have a timestamp" group)
- ;; else
- ;; Figure out which articles should be re-new'ed
- (let ((articles (nndiary-flatten (gnus-info-read info) 0))
- article file unread buf)
- (save-excursion
- (setq buf (nnheader-set-temp-buffer " *nndiary update*"))
- (while (setq article (pop articles))
- (setq file (concat nndiary-current-directory
- (int-to-string article)))
- (and (file-exists-p file)
- (nndiary-renew-article-p file timestamp)
- (push article unread)))
- ;;(message "unread: %s" unread)
- (sit-for 1)
- (kill-buffer buf))
- (setq unread (sort unread '<))
- (and unread
- (gnus-info-set-read info (gnus-update-read-articles
- (gnus-info-group info) unread t)))
- ))
- (run-hook-with-args 'nndiary-request-update-info-hooks
- (gnus-info-group info))
- t))
-
-
-\f
-;;; Internal functions ======================================================
-
-(defun nndiary-article-to-file (article)
- (nndiary-update-file-alist)
- (let (file)
- (if (setq file (cdr (assq article nndiary-article-file-alist)))
- (expand-file-name file nndiary-current-directory)
- ;; Just to make sure nothing went wrong when reading over NFS --
- ;; check once more.
- (if nndiary-check-directory-twice
- (when (file-exists-p
- (setq file (expand-file-name (number-to-string article)
- nndiary-current-directory)))
- (nndiary-update-file-alist t)
- file)))))
-
-(defun nndiary-deletable-article-p (group article)
- "Say whether ARTICLE in GROUP can be deleted."
- (let (path)
- (when (setq path (nndiary-article-to-file article))
- (when (file-writable-p path)
- (or (not nnmail-keep-last-article)
- (not (eq (cdr (nth 1 (assoc group nndiary-group-alist)))
- article)))))))
-
-;; Find an article number in the current group given the Message-ID.
-(defun nndiary-find-group-number (id)
- (save-excursion
- (set-buffer (get-buffer-create " *nndiary id*"))
- (let ((alist nndiary-group-alist)
- number)
- ;; We want to look through all .overview files, but we want to
- ;; start with the one in the current directory. It seems most
- ;; likely that the article we are looking for is in that group.
- (if (setq number (nndiary-find-id nndiary-current-group id))
- (cons nndiary-current-group number)
- ;; It wasn't there, so we look through the other groups as well.
- (while (and (not number)
- alist)
- (or (string= (caar alist) nndiary-current-group)
- (setq number (nndiary-find-id (caar alist) id)))
- (or number
- (setq alist (cdr alist))))
- (and number
- (cons (caar alist) number))))))
-
-(defun nndiary-find-id (group id)
- (erase-buffer)
- (let ((nov (expand-file-name nndiary-nov-file-name
- (nnmail-group-pathname group
- nndiary-directory)))
- number found)
- (when (file-exists-p nov)
- (nnheader-insert-file-contents nov)
- (while (and (not found)
- (search-forward id nil t)) ; We find the ID.
- ;; And the id is in the fourth field.
- (if (not (and (search-backward "\t" nil t 4)
- (not (search-backward"\t" (gnus-point-at-bol) t))))
- (forward-line 1)
- (beginning-of-line)
- (setq found t)
- ;; We return the article number.
- (setq number
- (ignore-errors (read (current-buffer))))))
- number)))
-
-(defun nndiary-retrieve-headers-with-nov (articles &optional fetch-old)
- (if (or gnus-nov-is-evil nndiary-nov-is-evil)
- nil
- (let ((nov (expand-file-name nndiary-nov-file-name
- nndiary-current-directory)))
- (when (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (nnheader-insert-file-contents nov)
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- t))))))
-
-(defun nndiary-possibly-change-directory (group &optional server)
- (when (and server
- (not (nndiary-server-opened server)))
- (nndiary-open-server server))
- (if (not group)
- t
- (let ((pathname (nnmail-group-pathname group nndiary-directory))
- (file-name-coding-system nnmail-pathname-coding-system))
- (when (not (equal pathname nndiary-current-directory))
- (setq nndiary-current-directory pathname
- nndiary-current-group group
- nndiary-article-file-alist nil))
- (file-exists-p nndiary-current-directory))))
-
-(defun nndiary-possibly-create-directory (group)
- (let ((dir (nnmail-group-pathname group nndiary-directory)))
- (unless (file-exists-p dir)
- (make-directory (directory-file-name dir) t)
- (nnheader-message 5 "Creating mail directory %s" dir))))
-
-(defun nndiary-save-mail (group-art)
- "Called narrowed to an article."
- (let (chars headers)
- (setq chars (nnmail-insert-lines))
- (nnmail-insert-xref group-art)
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nndiary-prepare-save-mail-hook)
- (goto-char (point-min))
- (while (looking-at "From ")
- (replace-match "X-From-Line: ")
- (forward-line 1))
- ;; We save the article in all the groups it belongs in.
- (let ((ga group-art)
- first)
- (while ga
- (nndiary-possibly-create-directory (caar ga))
- (let ((file (concat (nnmail-group-pathname
- (caar ga) nndiary-directory)
- (int-to-string (cdar ga)))))
- (if first
- ;; It was already saved, so we just make a hard link.
- (funcall nnmail-crosspost-link-function first file t)
- ;; Save the article.
- (nnmail-write-region (point-min) (point-max) file nil
- (if (nnheader-be-verbose 5) nil 'nomesg))
- (setq first file)))
- (setq ga (cdr ga))))
- ;; Generate a nov line for this article. We generate the nov
- ;; line after saving, because nov generation destroys the
- ;; header.
- (setq headers (nndiary-parse-head chars))
- ;; Output the nov line to all nov databases that should have it.
- (let ((ga group-art))
- (while ga
- (nndiary-add-nov (caar ga) (cdar ga) headers)
- (setq ga (cdr ga))))
- group-art))
-
-(defun nndiary-active-number (group)
- "Compute the next article number in GROUP."
- (let ((active (cadr (assoc group nndiary-group-alist))))
- ;; The group wasn't known to nndiary, so we just create an active
- ;; entry for it.
- (unless active
- ;; Perhaps the active file was corrupt? See whether
- ;; there are any articles in this group.
- (nndiary-possibly-create-directory group)
- (nndiary-possibly-change-directory group)
- (unless nndiary-article-file-alist
- (setq nndiary-article-file-alist
- (sort
- (nnheader-article-to-file-alist nndiary-current-directory)
- 'car-less-than-car)))
- (setq active
- (if nndiary-article-file-alist
- (cons (caar nndiary-article-file-alist)
- (caar (last nndiary-article-file-alist)))
- (cons 1 0)))
- (push (list group active) nndiary-group-alist))
- (setcdr active (1+ (cdr active)))
- (while (file-exists-p
- (expand-file-name (int-to-string (cdr active))
- (nnmail-group-pathname group nndiary-directory)))
- (setcdr active (1+ (cdr active))))
- (cdr active)))
-
-(defun nndiary-add-nov (group article headers)
- "Add a nov line for the GROUP base."
- (save-excursion
- (set-buffer (nndiary-open-nov group))
- (goto-char (point-max))
- (mail-header-set-number headers article)
- (nnheader-insert-nov headers)))
-
-(defsubst nndiary-header-value ()
- (buffer-substring (match-end 0) (progn (end-of-line) (point))))
-
-(defun nndiary-parse-head (chars &optional number)
- "Parse the head of the current buffer."
- (save-excursion
- (save-restriction
- (unless (zerop (buffer-size))
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t) (1- (point)) (point-max))))
- (let ((headers (nnheader-parse-naked-head)))
- (mail-header-set-chars headers chars)
- (mail-header-set-number headers number)
- headers))))
-
-(defun nndiary-open-nov (group)
- (or (cdr (assoc group nndiary-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nndiary overview %s*"
- group))))
- (save-excursion
- (set-buffer buffer)
- (set (make-local-variable 'nndiary-nov-buffer-file-name)
- (expand-file-name
- nndiary-nov-file-name
- (nnmail-group-pathname group nndiary-directory)))
- (erase-buffer)
- (when (file-exists-p nndiary-nov-buffer-file-name)
- (nnheader-insert-file-contents nndiary-nov-buffer-file-name)))
- (push (cons group buffer) nndiary-nov-buffer-alist)
- buffer)))
-
-(defun nndiary-save-nov ()
- (save-excursion
- (while nndiary-nov-buffer-alist
- (when (buffer-name (cdar nndiary-nov-buffer-alist))
- (set-buffer (cdar nndiary-nov-buffer-alist))
- (when (buffer-modified-p)
- (nnmail-write-region 1 (point-max) nndiary-nov-buffer-file-name
- nil 'nomesg))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
- (setq nndiary-nov-buffer-alist (cdr nndiary-nov-buffer-alist)))))
-
-;;;###autoload
-(defun nndiary-generate-nov-databases (&optional server)
- "Generate NOV databases in all nndiary directories."
- (interactive (list (or (nnoo-current-server 'nndiary) "")))
- ;; Read the active file to make sure we don't re-use articles
- ;; numbers in empty groups.
- (nnmail-activate 'nndiary)
- (unless (nndiary-server-opened server)
- (nndiary-open-server server))
- (setq nndiary-directory (expand-file-name nndiary-directory))
- ;; Recurse down the directories.
- (nndiary-generate-nov-databases-1 nndiary-directory nil t)
- ;; Save the active file.
- (nnmail-save-active nndiary-group-alist nndiary-active-file))
-
-(defun nndiary-generate-nov-databases-1 (dir &optional seen no-active)
- "Regenerate the NOV database in DIR."
- (interactive "DRegenerate NOV in: ")
- (setq dir (file-name-as-directory dir))
- ;; Only scan this sub-tree if we haven't been here yet.
- (unless (member (file-truename dir) seen)
- (push (file-truename dir) seen)
- ;; We descend recursively
- (let ((dirs (directory-files dir t nil t))
- dir)
- (while (setq dir (pop dirs))
- (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
- (file-directory-p dir))
- (nndiary-generate-nov-databases-1 dir seen))))
- ;; Do this directory.
- (let ((files (sort (nnheader-article-to-file-alist dir)
- 'car-less-than-car)))
- (if (not files)
- (let* ((group (nnheader-file-to-group
- (directory-file-name dir) nndiary-directory))
- (info (cadr (assoc group nndiary-group-alist))))
- (when info
- (setcar info (1+ (cdr info)))))
- (funcall nndiary-generate-active-function dir)
- ;; Generate the nov file.
- (nndiary-generate-nov-file dir files)
- (unless no-active
- (nnmail-save-active nndiary-group-alist nndiary-active-file))))))
-
-(eval-when-compile (defvar files))
-(defun nndiary-generate-active-info (dir)
- ;; Update the active info for this group.
- (let* ((group (nnheader-file-to-group
- (directory-file-name dir) nndiary-directory))
- (entry (assoc group nndiary-group-alist))
- (last (or (caadr entry) 0)))
- (setq nndiary-group-alist (delq entry nndiary-group-alist))
- (push (list group
- (cons (or (caar files) (1+ last))
- (max last
- (or (let ((f files))
- (while (cdr f) (setq f (cdr f)))
- (caar f))
- 0))))
- nndiary-group-alist)))
-
-(defun nndiary-generate-nov-file (dir files)
- (let* ((dir (file-name-as-directory dir))
- (nov (concat dir nndiary-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
- chars file headers)
- (save-excursion
- ;; Init the nov buffer.
- (set-buffer nov-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (set-buffer nntp-server-buffer)
- ;; Delete the old NOV file.
- (when (file-exists-p nov)
- (funcall nnmail-delete-file-function nov))
- (while files
- (unless (file-directory-p (setq file (concat dir (cdar files))))
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (narrow-to-region
- (goto-char (point-min))
- (progn
- (search-forward "\n\n" nil t)
- (setq chars (- (point-max) (point)))
- (max 1 (1- (point)))))
- (unless (zerop (buffer-size))
- (goto-char (point-min))
- (setq headers (nndiary-parse-head chars (caar files)))
- (save-excursion
- (set-buffer nov-buffer)
- (goto-char (point-max))
- (nnheader-insert-nov headers)))
- (widen))
- (setq files (cdr files)))
- (save-excursion
- (set-buffer nov-buffer)
- (nnmail-write-region 1 (point-max) nov nil 'nomesg)
- (kill-buffer (current-buffer))))))
-
-(defun nndiary-nov-delete-article (group article)
- (save-excursion
- (set-buffer (nndiary-open-nov group))
- (when (nnheader-find-nov-line article)
- (delete-region (point) (progn (forward-line 1) (point)))
- (when (bobp)
- (let ((active (cadr (assoc group nndiary-group-alist)))
- num)
- (when active
- (if (eobp)
- (setf (car active) (1+ (cdr active)))
- (when (and (setq num (ignore-errors (read (current-buffer))))
- (numberp num))
- (setf (car active) num)))))))
- t))
-
-(defun nndiary-update-file-alist (&optional force)
- (when (or (not nndiary-article-file-alist)
- force)
- (setq nndiary-article-file-alist
- (nnheader-article-to-file-alist nndiary-current-directory))))
-
-
-(defun nndiary-string-to-number (str min &optional max)
- ;; Like `string-to-number' but barf if STR is not exactly an integer, and not
- ;; within the specified bounds.
- ;; Signals are caught by `nndiary-schedule'.
- (if (not (string-match "^[ \t]*[0-9]+[ \t]*$" str))
- (nndiary-error "not an integer value")
- ;; else
- (let ((val (string-to-number str)))
- (and (or (< val min)
- (and max (> val max)))
- (nndiary-error "value out of range"))
- val)))
-
-(defun nndiary-parse-schedule-value (str min-or-values max)
- ;; Parse the schedule string STR, or signal an error.
- ;; Signals are caught by `nndary-schedule'.
- (if (string-match "[ \t]*\\*[ \t]*" str)
- ;; unspecifyed
- nil
- ;; specifyed
- (if (listp min-or-values)
- ;; min-or-values is values
- ;; #### NOTE: this is actually only a hack for time zones.
- (let ((val (and (string-match "[ \t]*\\([^ \t]+\\)[ \t]*" str)
- (match-string 1 str))))
- (if (and val (setq val (assoc val min-or-values)))
- (list (cadr val))
- (nndiary-error "invalid syntax")))
- ;; min-or-values is min
- (mapcar
- (lambda (val)
- (let ((res (split-string val "-")))
- (cond
- ((= (length res) 1)
- (nndiary-string-to-number (car res) min-or-values max))
- ((= (length res) 2)
- ;; don't know if crontab accepts this, but ensure
- ;; that BEG is <= END
- (let ((beg (nndiary-string-to-number (car res) min-or-values max))
- (end (nndiary-string-to-number (cadr res) min-or-values max)))
- (cond ((< beg end)
- (cons beg end))
- ((= beg end)
- beg)
- (t
- (cons end beg)))))
- (t
- (nndiary-error "invalid syntax")))
- ))
- (split-string str ",")))
- ))
-
-;; ### FIXME: remove this function if it's used only once.
-(defun nndiary-parse-schedule (head min-or-values max)
- ;; Parse the cron-like value of header X-Diary-HEAD in current buffer.
- ;; - Returns nil if `*'
- ;; - Otherwise returns a list of integers and/or ranges (BEG . END)
- ;; The exception is the Timze-Zone value which is always of the form (STR).
- ;; Signals are caught by `nndary-schedule'.
- (let ((header (format "^X-Diary-%s: \\(.*\\)$" head)))
- (goto-char (point-min))
- (if (not (re-search-forward header nil t))
- (nndiary-error "header missing")
- ;; else
- (nndiary-parse-schedule-value (match-string 1) min-or-values max))
- ))
-
-(defun nndiary-max (spec)
- ;; Returns the max of specification SPEC, or nil for permanent schedules.
- (unless (null spec)
- (let ((elts spec)
- (max 0)
- elt)
- (while (setq elt (pop elts))
- (if (integerp elt)
- (and (> elt max) (setq max elt))
- (and (> (cdr elt) max) (setq max (cdr elt)))))
- max)))
-
-(defun nndiary-flatten (spec min &optional max)
- ;; flatten the spec by expanding ranges to all possible values.
- (let (flat n)
- (cond ((null spec)
- ;; this happens when I flatten something else than one of my
- ;; schedules (a list of read articles for instance).
- (unless (null max)
- (setq n min)
- (while (<= n max)
- (push n flat)
- (setq n (1+ n)))))
- (t
- (let ((elts spec)
- elt)
- (while (setq elt (pop elts))
- (if (integerp elt)
- (push elt flat)
- ;; else
- (setq n (car elt))
- (while (<= n (cdr elt))
- (push n flat)
- (setq n (1+ n))))))))
- flat))
-
-(defun nndiary-unflatten (spec)
- ;; opposite of flatten: build ranges if possible
- (setq spec (sort spec '<))
- (let (min max res)
- (while (setq min (pop spec))
- (setq max min)
- (while (and (car spec) (= (car spec) (1+ max)))
- (setq max (1+ max))
- (pop spec))
- (if (= max min)
- (setq res (append res (list min)))
- (setq res (append res (list (cons min max))))))
- res))
-
-(defun nndiary-compute-reminders (date)
- ;; Returns a list of times corresponding to the reminders of date DATE.
- ;; See the comment in `nndiary-reminders' about rounding.
- (let* ((reminders nndiary-reminders)
- (date-elts (decode-time date))
- ;; ### NOTE: out-of-range values are accepted by encode-time. This
- ;; makes our life easier.
- (monday (- (nth 3 date-elts)
- (if nndiary-week-starts-on-monday
- (if (zerop (nth 6 date-elts))
- 6
- (- (nth 6 date-elts) 1))
- (nth 6 date-elts))))
- reminder res)
- ;; remove the DOW and DST entries
- (setcdr (nthcdr 5 date-elts) (nthcdr 8 date-elts))
- (while (setq reminder (pop reminders))
- (push
- (cond ((eq (cdr reminder) 'minute)
- (subtract-time
- (apply 'encode-time 0 (nthcdr 1 date-elts))
- (seconds-to-time (* (car reminder) 60.0))))
- ((eq (cdr reminder) 'hour)
- (subtract-time
- (apply 'encode-time 0 0 (nthcdr 2 date-elts))
- (seconds-to-time (* (car reminder) 3600.0))))
- ((eq (cdr reminder) 'day)
- (subtract-time
- (apply 'encode-time 0 0 0 (nthcdr 3 date-elts))
- (seconds-to-time (* (car reminder) 86400.0))))
- ((eq (cdr reminder) 'week)
- (subtract-time
- (apply 'encode-time 0 0 0 monday (nthcdr 4 date-elts))
- (seconds-to-time (* (car reminder) 604800.0))))
- ((eq (cdr reminder) 'month)
- (subtract-time
- (apply 'encode-time 0 0 0 1 (nthcdr 4 date-elts))
- (seconds-to-time (* (car reminder) 18748800.0))))
- ((eq (cdr reminder) 'year)
- (subtract-time
- (apply 'encode-time 0 0 0 1 1 (nthcdr 5 date-elts))
- (seconds-to-time (* (car reminder) 400861056.0)))))
- res))
- (sort res 'time-less-p)))
-
-(defun nndiary-last-occurence (sched)
- ;; Returns the last occurence of schedule SCHED as an Emacs time struct, or
- ;; nil for permanent schedule or errors.
- (let ((minute (nndiary-max (nth 0 sched)))
- (hour (nndiary-max (nth 1 sched)))
- (year (nndiary-max (nth 4 sched)))
- (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
- (current-time-zone))))
- (when year
- (or minute (setq minute 59))
- (or hour (setq hour 23))
- ;; I'll just compute all possible values and test them by decreasing
- ;; order until one succeeds. This is probably quide rude, but I got
- ;; bored in finding a good algorithm for doing that ;-)
- ;; ### FIXME: remove identical entries.
- (let ((dom-list (nth 2 sched))
- (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '>))
- (year-list (sort (nndiary-flatten (nth 4 sched) 1971) '>))
- (dow-list (nth 5 sched)))
- ;; Special case: an asterisk in one of the days specifications means
- ;; that only the other should be taken into account. If both are
- ;; unspecified, you would get all possible days in both.
- (cond ((null dow-list)
- ;; this gets all days if dom-list is nil
- (setq dom-list (nndiary-flatten dom-list 1 31)))
- ((null dom-list)
- ;; this also gets all days if dow-list is nil
- (setq dow-list (nndiary-flatten dow-list 0 6)))
- (t
- (setq dom-list (nndiary-flatten dom-list 1 31))
- (setq dow-list (nndiary-flatten dow-list 0 6))))
- (or
- (catch 'found
- (while (setq year (pop year-list))
- (let ((months month-list)
- month)
- (while (setq month (pop months))
- ;; Now we must merge the Dows with the Doms. To do that, we
- ;; have to know which day is the 1st one for this month.
- ;; Maybe there's simpler, but decode-time(encode-time) will
- ;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
- (max (cond ((= month 2)
- (if (date-leap-year-p year) 29 28))
- ((<= month 7)
- (if (zerop (% month 2)) 30 31))
- (t
- (if (zerop (% month 2)) 31 30))))
- (doms dom-list)
- (dows dow-list)
- day days)
- ;; first, review the doms to see if they are valid.
- (while (setq day (pop doms))
- (and (<= day max)
- (push day days)))
- ;; second add all possible dows
- (while (setq day (pop dows))
- ;; days start at 1.
- (setq day (1+ (- day first)))
- (and (< day 0) (setq day (+ 7 day)))
- (while (<= day max)
- (push day days)
- (setq day (+ 7 day))))
- ;; Finally, if we have some days, they are valid
- (when days
- (sort days '>)
- (throw 'found
- (encode-time 0 minute hour
- (car days) month year time-zone)))
- )))))
- ;; There's an upper limit, but we didn't find any last occurence.
- ;; This means that the schedule is undecidable. This can happen if
- ;; you happen to say something like "each Feb 31 until 2038".
- (progn
- (nnheader-report 'nndiary "Undecidable schedule")
- nil))
- ))))
-
-(defun nndiary-next-occurence (sched now)
- ;; Returns the next occurence of schedule SCHED, starting from time NOW.
- ;; If there's no next occurence, returns the last one (if any) which is then
- ;; in the past.
- (let* ((today (decode-time now))
- (this-minute (nth 1 today))
- (this-hour (nth 2 today))
- (this-day (nth 3 today))
- (this-month (nth 4 today))
- (this-year (nth 5 today))
- (minute-list (sort (nndiary-flatten (nth 0 sched) 0 59) '<))
- (hour-list (sort (nndiary-flatten (nth 1 sched) 0 23) '<))
- (dom-list (nth 2 sched))
- (month-list (sort (nndiary-flatten (nth 3 sched) 1 12) '<))
- (years (if (nth 4 sched)
- (sort (nndiary-flatten (nth 4 sched) 1971) '<)
- t))
- (dow-list (nth 5 sched))
- (year (1- this-year))
- (time-zone (or (and (nth 6 sched) (car (nth 6 sched)))
- (current-time-zone))))
- ;; Special case: an asterisk in one of the days specifications means that
- ;; only the other should be taken into account. If both are unspecified,
- ;; you would get all possible days in both.
- (cond ((null dow-list)
- ;; this gets all days if dom-list is nil
- (setq dom-list (nndiary-flatten dom-list 1 31)))
- ((null dom-list)
- ;; this also gets all days if dow-list is nil
- (setq dow-list (nndiary-flatten dow-list 0 6)))
- (t
- (setq dom-list (nndiary-flatten dom-list 1 31))
- (setq dow-list (nndiary-flatten dow-list 0 6))))
- ;; Remove past years.
- (unless (eq years t)
- (while (and (car years) (< (car years) this-year))
- (pop years)))
- (if years
- ;; Because we might not be limited in years, we must guard against
- ;; infinite loops. Appart from cases like Feb 31, there are probably
- ;; other ones, (no monday XXX 2nd etc). I don't know any algorithm to
- ;; decide this, so I assume that if we reach 10 years later, the
- ;; schedule is undecidable.
- (or
- (catch 'found
- (while (if (eq years t)
- (and (setq year (1+ year))
- (<= year (+ 10 this-year)))
- (setq year (pop years)))
- (let ((months month-list)
- month)
- ;; Remove past months for this year.
- (and (= year this-year)
- (while (and (car months) (< (car months) this-month))
- (pop months)))
- (while (setq month (pop months))
- ;; Now we must merge the Dows with the Doms. To do that, we
- ;; have to know which day is the 1st one for this month.
- ;; Maybe there's simpler, but decode-time(encode-time) will
- ;; give us the answer.
- (let ((first (nth 6 (decode-time
- (encode-time 0 0 0 1 month year
- time-zone))))
- (max (cond ((= month 2)
- (if (date-leap-year-p year) 29 28))
- ((<= month 7)
- (if (zerop (% month 2)) 30 31))
- (t
- (if (zerop (% month 2)) 31 30))))
- (doms dom-list)
- (dows dow-list)
- day days)
- ;; first, review the doms to see if they are valid.
- (while (setq day (pop doms))
- (and (<= day max)
- (push day days)))
- ;; second add all possible dows
- (while (setq day (pop dows))
- ;; days start at 1.
- (setq day (1+ (- day first)))
- (and (< day 0) (setq day (+ 7 day)))
- (while (<= day max)
- (push day days)
- (setq day (+ 7 day))))
- ;; Aaaaaaall right. Now we have a valid list of DAYS for
- ;; this month and this year.
- (when days
- (setq days (sort days '<))
- ;; Remove past days for this year and this month.
- (and (= year this-year)
- (= month this-month)
- (while (and (car days) (< (car days) this-day))
- (pop days)))
- (while (setq day (pop days))
- (let ((hours hour-list)
- hour)
- ;; Remove past hours for this year, this month and
- ;; this day.
- (and (= year this-year)
- (= month this-month)
- (= day this-day)
- (while (and (car hours)
- (< (car hours) this-hour))
- (pop hours)))
- (while (setq hour (pop hours))
- (let ((minutes minute-list)
- minute)
- ;; Remove past hours for this year, this month,
- ;; this day and this hour.
- (and (= year this-year)
- (= month this-month)
- (= day this-day)
- (= hour this-hour)
- (while (and (car minutes)
- (< (car minutes) this-minute))
- (pop minutes)))
- (while (setq minute (pop minutes))
- ;; Ouch! Here, we've got a complete valid
- ;; schedule. It's a good one if it's in the
- ;; future.
- (let ((time (encode-time 0 minute hour day
- month year
- time-zone)))
- (and (time-less-p now time)
- (throw 'found time)))
- ))))
- ))
- )))
- ))
- (nndiary-last-occurence sched))
- ;; else
- (nndiary-last-occurence sched))
- ))
-
-(defun nndiary-expired-article-p (file)
- (with-temp-buffer
- (if (nnheader-insert-head file)
- (let ((sched (nndiary-schedule)))
- ;; An article has expired if its last schedule (if any) is in the
- ;; past. A permanent schedule never expires.
- (and sched
- (setq sched (nndiary-last-occurence sched))
- (time-less-p sched (current-time))))
- ;; else
- (nnheader-report 'nndiary "Could not read file %s" file)
- nil)
- ))
-
-(defun nndiary-renew-article-p (file timestamp)
- (erase-buffer)
- (if (nnheader-insert-head file)
- (let ((now (current-time))
- (sched (nndiary-schedule)))
- ;; The article should be re-considered as unread if there's a reminder
- ;; between the group timestamp and the current time.
- (when (and sched (setq sched (nndiary-next-occurence sched now)))
- (let ((reminders ;; add the next occurence itself at the end.
- (append (nndiary-compute-reminders sched) (list sched))))
- (while (and reminders (time-less-p (car reminders) timestamp))
- (pop reminders))
- ;; The reminders might be empty if the last date is in the past,
- ;; or we've got at least the next occurence itself left. All past
- ;; dates are renewed.
- (or (not reminders)
- (time-less-p (car reminders) now)))
- ))
- ;; else
- (nnheader-report 'nndiary "Could not read file %s" file)
- nil))
-
-;; The end... ===============================================================
-
-(mapcar
- (lambda (elt)
- (let ((header (intern (format "X-Diary-%s" (car elt)))))
- ;; Required for building NOV databases and some other stuff
- (add-to-list 'gnus-extra-headers header)
- (add-to-list 'nnmail-extra-headers header)))
- nndiary-headers)
-
-(unless (assoc "nndiary" gnus-valid-select-methods)
- (gnus-declare-backend "nndiary" 'post-mail 'respool 'address))
-
-(provide 'nndiary)
-
-
-;;; arch-tag: 9c542b95-92e7-4ace-a038-330ab296e203
-;;; nndiary.el ends here
+++ /dev/null
-;;; nndir.el --- single directory newsgroup access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmh)
-(require 'nnml)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndir
- nnml nnmh)
-
-(defvoo nndir-directory nil
- "Where nndir will look for groups."
- nnml-current-directory nnmh-current-directory)
-
-(defvoo nndir-nov-is-evil nil
- "*Non-nil means that nndir will never retrieve NOV headers."
- nnml-nov-is-evil)
-
-\f
-
-(defvoo nndir-current-group "" nil nnml-current-group nnmh-current-group)
-(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
-(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
-
-(defvoo nndir-status-string "" nil nnmh-status-string)
-(defconst nndir-version "nndir 1.0")
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nndir)
-
-(deffoo nndir-open-server (server &optional defs)
- (setq nndir-directory
- (or (cadr (assq 'nndir-directory defs))
- server))
- (unless (assq 'nndir-directory defs)
- (push `(nndir-directory ,server) defs))
- (push `(nndir-current-group
- ,(file-name-nondirectory (directory-file-name nndir-directory)))
- defs)
- (push `(nndir-top-directory
- ,(file-name-directory (directory-file-name nndir-directory)))
- defs)
- (nnoo-change-server 'nndir server defs)
- (let (err)
- (cond
- ((not (condition-case arg
- (file-exists-p nndir-directory)
- (ftp-error (setq err (format "%s" arg)))))
- (nndir-close-server)
- (nnheader-report
- 'nndir (or err "No such file or directory: %s" nndir-directory)))
- ((not (file-directory-p (file-truename nndir-directory)))
- (nndir-close-server)
- (nnheader-report 'nndir "Not a directory: %s" nndir-directory))
- (t
- (nnheader-report 'nndir "Opened server %s using directory %s"
- server nndir-directory)
- t))))
-
-(nnoo-map-functions nndir
- (nnml-retrieve-headers 0 nndir-current-group 0 0)
- (nnml-request-article 0 nndir-current-group 0 0)
- (nnmh-request-group nndir-current-group 0 0)
- (nnml-close-group nndir-current-group 0)
- (nnml-request-list (nnoo-current-server 'nndir) nndir-directory)
- (nnml-request-newsgroups (nnoo-current-server 'nndir) nndir-directory))
-
-(provide 'nndir)
-
-;;; arch-tag: 56f09f68-0e4e-4816-818a-df80b4a394c8
-;;; nndir.el ends here
+++ /dev/null
-;;; nndoc.el --- single file access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; For Outlook mail boxes format, see http://mbx2mbox.sourceforge.net/
-
-;;; Code:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(require 'gnus-util)
-(require 'mm-util)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndoc)
-
-(defvoo nndoc-article-type 'guess
- "*Type of the file.
-One of `mbox', `babyl', `digest', `news', `rnews', `mmdf', `forward',
-`rfc934', `rfc822-forward', `mime-parts', `standard-digest',
-`slack-digest', `clari-briefs', `nsmail', `outlook', `oe-dbx',
-`mailman', `exim-bounce', or `guess'.")
-
-(defvoo nndoc-post-type 'mail
- "*Whether the nndoc group is `mail' or `post'.")
-
-(defvoo nndoc-open-document-hook 'nnheader-ms-strip-cr
- "Hook run after opening a document.
-The default function removes all trailing carriage returns
-from the document.")
-
-(defvar nndoc-type-alist
- `((mmdf
- (article-begin . "^\^A\^A\^A\^A\n")
- (body-end . "^\^A\^A\^A\^A\n"))
- (mime-digest
- (article-begin . "")
- (head-begin . "^ ?\n")
- (head-end . "^ ?$")
- (body-end . "")
- (file-end . "")
- (subtype digest guess))
- (mime-parts
- (generate-head-function . nndoc-generate-mime-parts-head)
- (article-transform-function . nndoc-transform-mime-parts))
- (nsmail
- (article-begin . "^From - "))
- (news
- (article-begin . "^Path:"))
- (rnews
- (article-begin . "^#! *rnews +\\([0-9]+\\) *\n")
- (body-end-function . nndoc-rnews-body-end))
- (mbox
- (article-begin-function . nndoc-mbox-article-begin)
- (body-end-function . nndoc-mbox-body-end))
- (babyl
- (article-begin . "\^_\^L *\n")
- (body-end . "\^_")
- (body-begin-function . nndoc-babyl-body-begin)
- (head-begin-function . nndoc-babyl-head-begin))
- (exim-bounce
- (article-begin . "^------ This is a copy of the message, including all the headers. ------\n\n")
- (body-end-function . nndoc-exim-bounce-body-end-function))
- (rfc934
- (article-begin . "^--.*\n+")
- (body-end . "^--.*$")
- (prepare-body-function . nndoc-unquote-dashes))
- (mailman
- (article-begin . "^--__--__--\n\nMessage:")
- (body-end . "^--__--__--$")
- (prepare-body-function . nndoc-unquote-dashes))
- (clari-briefs
- (article-begin . "^ \\*")
- (body-end . "^\t------*[ \t]^*\n^ \\*")
- (body-begin . "^\t")
- (head-end . "^\t")
- (generate-head-function . nndoc-generate-clari-briefs-head)
- (article-transform-function . nndoc-transform-clari-briefs))
-
- (standard-digest
- (first-article . ,(concat "^" (make-string 70 ?-) "\n *\n+"))
- (article-begin . ,(concat "^\n" (make-string 30 ?-) "\n *\n+"))
- (prepare-body-function . nndoc-unquote-dashes)
- (body-end-function . nndoc-digest-body-end)
- (head-end . "^ *$")
- (body-begin . "^ *\n")
- (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
- (subtype digest guess))
- (slack-digest
- (article-begin . "^------------------------------*[\n \t]+")
- (head-end . "^ ?$")
- (body-end-function . nndoc-digest-body-end)
- (body-begin . "^ ?$")
- (file-end . "^End of")
- (prepare-body-function . nndoc-unquote-dashes)
- (subtype digest guess))
- (lanl-gov-announce
- (article-begin . "^\\\\\\\\\n")
- (head-begin . "^Paper.*:")
- (head-end . "\\(^\\\\\\\\.*\n\\|-----------------\\)")
- (body-begin . "")
- (body-end . "\\(-------------------------------------------------\\|%-%-%-%-%-%-%-%-%-%-%-%-%-%-\\|%%--%%--%%--%%--%%--%%--%%--%%--\\|%%%---%%%---%%%---%%%---\\)")
- (file-end . "\\(^Title: Recent Seminal\\|%%%---%%%---%%%---%%%---\\)")
- (generate-head-function . nndoc-generate-lanl-gov-head)
- (article-transform-function . nndoc-transform-lanl-gov-announce)
- (subtype preprints guess))
- (rfc822-forward
- (article-begin . "^\n+")
- (body-end-function . nndoc-rfc822-forward-body-end-function)
- (generate-head-function . nndoc-rfc822-forward-generate-head)
- (generate-article-function . nndoc-rfc822-forward-generate-article))
- (outlook
- (article-begin-function . nndoc-outlook-article-begin)
- (body-end . "\0"))
- (oe-dbx ;; Outlook Express DBX format
- (dissection-function . nndoc-oe-dbx-dissection)
- (generate-head-function . nndoc-oe-dbx-generate-head)
- (generate-article-function . nndoc-oe-dbx-generate-article))
- (forward
- (article-begin . "^-+ \\(Start of \\)?forwarded message.*\n+")
- (body-end . "^-+ End \\(of \\)?forwarded message.*$")
- (prepare-body-function . nndoc-unquote-dashes))
- (mail-in-mail ;; Wild guess on mailer daemon's messages or others
- (article-begin-function . nndoc-mail-in-mail-article-begin))
- (guess
- (guess . t)
- (subtype nil))
- (digest
- (guess . t)
- (subtype nil))
- (preprints
- (guess . t)
- (subtype nil))))
-
-(defvar nndoc-binary-file-names ".[Dd][Bb][Xx]$"
- "Regexp for binary nndoc file names.")
-
-\f
-(defvoo nndoc-file-begin nil)
-(defvoo nndoc-first-article nil)
-(defvoo nndoc-article-begin nil)
-(defvoo nndoc-head-begin nil)
-(defvoo nndoc-head-end nil)
-(defvoo nndoc-file-end nil)
-(defvoo nndoc-body-begin nil)
-(defvoo nndoc-body-end-function nil)
-(defvoo nndoc-body-begin-function nil)
-(defvoo nndoc-head-begin-function nil)
-(defvoo nndoc-body-end nil)
-;; nndoc-dissection-alist is a list of sublists. Each sublist holds the
-;; following items. ARTICLE acts as the association key and is an ordinal
-;; starting at 1. HEAD-BEGIN [0], HEAD-END [1], BODY-BEGIN [2] and BODY-END
-;; [3] are positions in the `nndoc' buffer. LINE-COUNT [4] is a count of
-;; lines in the body. For MIME dissections only, ARTICLE-INSERT [5] and
-;; SUMMARY-INSERT [6] give headers to insert for full article or summary line
-;; generation, respectively. Other headers usually follow directly from the
-;; buffer. Value `nil' means no insert.
-(defvoo nndoc-dissection-alist nil)
-(defvoo nndoc-prepare-body-function nil)
-(defvoo nndoc-generate-head-function nil)
-(defvoo nndoc-article-transform-function nil)
-(defvoo nndoc-article-begin-function nil)
-(defvoo nndoc-generate-article-function nil)
-(defvoo nndoc-dissection-function nil)
-
-(defvoo nndoc-status-string "")
-(defvoo nndoc-group-alist nil)
-(defvoo nndoc-current-buffer nil
- "Current nndoc news buffer.")
-(defvoo nndoc-address nil)
-
-(defconst nndoc-version "nndoc 1.0"
- "nndoc version.")
-
-\f
-
-;;; Interface functions
-
-(nnoo-define-basics nndoc)
-
-(deffoo nndoc-retrieve-headers (articles &optional newsgroup server fetch-old)
- (when (nndoc-possibly-change-buffer newsgroup server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let (article entry)
- (if (stringp (car articles))
- 'headers
- (while articles
- (when (setq entry (cdr (assq (setq article (pop articles))
- nndoc-dissection-alist)))
- (insert (format "221 %d Article retrieved.\n" article))
- (if nndoc-generate-head-function
- (funcall nndoc-generate-head-function article)
- (insert-buffer-substring
- nndoc-current-buffer (car entry) (nth 1 entry)))
- (goto-char (point-max))
- (unless (eq (char-after (1- (point))) ?\n)
- (insert "\n"))
- (insert (format "Lines: %d\n" (nth 4 entry)))
- (insert ".\n")))
-
- (nnheader-fold-continuation-lines)
- 'headers)))))
-
-(deffoo nndoc-request-article (article &optional newsgroup server buffer)
- (nndoc-possibly-change-buffer newsgroup server)
- (save-excursion
- (let ((buffer (or buffer nntp-server-buffer))
- (entry (cdr (assq article nndoc-dissection-alist)))
- beg)
- (set-buffer buffer)
- (erase-buffer)
- (when entry
- (cond
- ((stringp article) nil)
- (nndoc-generate-article-function
- (funcall nndoc-generate-article-function article))
- (t
- (insert-buffer-substring
- nndoc-current-buffer (car entry) (nth 1 entry))
- (insert "\n")
- (setq beg (point))
- (insert-buffer-substring
- nndoc-current-buffer (nth 2 entry) (nth 3 entry))
- (goto-char beg)
- (when nndoc-prepare-body-function
- (funcall nndoc-prepare-body-function))
- (when nndoc-article-transform-function
- (funcall nndoc-article-transform-function article))
- t))))))
-
-(deffoo nndoc-request-group (group &optional server dont-check)
- "Select news GROUP."
- (let (number)
- (cond
- ((not (nndoc-possibly-change-buffer group server))
- (nnheader-report 'nndoc "No such file or buffer: %s"
- nndoc-address))
- (dont-check
- (nnheader-report 'nndoc "Selected group %s" group)
- t)
- ((zerop (setq number (length nndoc-dissection-alist)))
- (nndoc-close-group group)
- (nnheader-report 'nndoc "No articles in group %s" group))
- (t
- (nnheader-insert "211 %d %d %d %s\n" number 1 number group)))))
-
-(deffoo nndoc-request-type (group &optional article)
- (cond ((not article) 'unknown)
- (nndoc-post-type nndoc-post-type)
- (t 'unknown)))
-
-(deffoo nndoc-close-group (group &optional server)
- (nndoc-possibly-change-buffer group server)
- (and nndoc-current-buffer
- (buffer-name nndoc-current-buffer)
- (kill-buffer nndoc-current-buffer))
- (setq nndoc-group-alist (delq (assoc group nndoc-group-alist)
- nndoc-group-alist))
- (setq nndoc-current-buffer nil)
- (nnoo-close-server 'nndoc server)
- (setq nndoc-dissection-alist nil)
- t)
-
-(deffoo nndoc-request-list (&optional server)
- nil)
-
-(deffoo nndoc-request-newgroups (date &optional server)
- nil)
-
-(deffoo nndoc-request-list-newsgroups (&optional server)
- nil)
-
-\f
-;;; Internal functions.
-
-(defun nndoc-possibly-change-buffer (group source)
- (let (buf)
- (cond
- ;; The current buffer is this group's buffer.
- ((and nndoc-current-buffer
- (buffer-name nndoc-current-buffer)
- (eq nndoc-current-buffer
- (setq buf (cdr (assoc group nndoc-group-alist))))))
- ;; We change buffers by taking an old from the group alist.
- ;; `source' is either a string (a file name) or a buffer object.
- (buf
- (setq nndoc-current-buffer buf))
- ;; It's a totally new group.
- ((or (and (bufferp nndoc-address)
- (buffer-name nndoc-address))
- (and (stringp nndoc-address)
- (file-exists-p nndoc-address)
- (not (file-directory-p nndoc-address))))
- (push (cons group (setq nndoc-current-buffer
- (get-buffer-create
- (concat " *nndoc " group "*"))))
- nndoc-group-alist)
- (setq nndoc-dissection-alist nil)
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (erase-buffer)
- (if (and (stringp nndoc-address)
- (string-match nndoc-binary-file-names nndoc-address))
- (let ((coding-system-for-read 'binary))
- (mm-insert-file-contents nndoc-address))
- (if (stringp nndoc-address)
- (nnheader-insert-file-contents nndoc-address)
- (insert-buffer-substring nndoc-address))
- (run-hooks 'nndoc-open-document-hook)))))
- ;; Initialize the nndoc structures according to this new document.
- (when (and nndoc-current-buffer
- (not nndoc-dissection-alist))
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (nndoc-set-delims)
- (if (eq nndoc-article-type 'mime-parts)
- (nndoc-dissect-mime-parts)
- (nndoc-dissect-buffer))))
- (unless nndoc-current-buffer
- (nndoc-close-server))
- ;; Return whether we managed to select a file.
- nndoc-current-buffer))
-
-;;;
-;;; Deciding what document type we have
-;;;
-
-(defun nndoc-set-delims ()
- "Set the nndoc delimiter variables according to the type of the document."
- (let ((vars '(nndoc-file-begin
- nndoc-first-article
- nndoc-article-begin-function
- nndoc-head-begin nndoc-head-end
- nndoc-file-end nndoc-article-begin
- nndoc-body-begin nndoc-body-end-function nndoc-body-end
- nndoc-prepare-body-function nndoc-article-transform-function
- nndoc-generate-head-function nndoc-body-begin-function
- nndoc-head-begin-function
- nndoc-generate-article-function
- nndoc-dissection-function)))
- (while vars
- (set (pop vars) nil)))
- (let (defs)
- ;; Guess away until we find the real file type.
- (while (assq 'guess (setq defs (cdr (assq nndoc-article-type
- nndoc-type-alist))))
- (setq nndoc-article-type (nndoc-guess-type nndoc-article-type)))
- ;; Set the nndoc variables.
- (while defs
- (set (intern (format "nndoc-%s" (caar defs)))
- (cdr (pop defs))))))
-
-(defun nndoc-guess-type (subtype)
- (let ((alist nndoc-type-alist)
- results result entry)
- (while (and (not result)
- (setq entry (pop alist)))
- (when (memq subtype (or (cdr (assq 'subtype entry)) '(guess)))
- (goto-char (point-min))
- ;; Remove blank lines.
- (while (eq (following-char) ?\n)
- (delete-char 1))
- (when (numberp (setq result (funcall (intern
- (format "nndoc-%s-type-p"
- (car entry))))))
- (push (cons result entry) results)
- (setq result nil))))
- (unless (or result results)
- (error "Document is not of any recognized type"))
- (if result
- (car entry)
- (cadar (last (sort results 'car-less-than-car))))))
-
-;;;
-;;; Built-in type predicates and functions
-;;;
-
-(defun nndoc-mbox-type-p ()
- (when (looking-at message-unix-mail-delimiter)
- t))
-
-(defun nndoc-mbox-article-begin ()
- (when (re-search-forward (concat "^" message-unix-mail-delimiter) nil t)
- (goto-char (match-beginning 0))))
-
-(defun nndoc-mbox-body-end ()
- (let ((beg (point))
- len end)
- (when
- (save-excursion
- (and (re-search-backward
- (concat "^" message-unix-mail-delimiter) nil t)
- (setq end (point))
- (search-forward "\n\n" beg t)
- (re-search-backward
- "^Content-Length:[ \t]*\\([0-9]+\\) *$" end t)
- (setq len (string-to-number (match-string 1)))
- (search-forward "\n\n" beg t)
- (unless (= (setq len (+ (point) len)) (point-max))
- (and (< len (point-max))
- (goto-char len)
- (looking-at message-unix-mail-delimiter)))))
- (goto-char len))))
-
-(defun nndoc-mmdf-type-p ()
- (when (looking-at "\^A\^A\^A\^A$")
- t))
-
-(defun nndoc-news-type-p ()
- (when (looking-at "^Path:.*\n")
- t))
-
-(defun nndoc-rnews-type-p ()
- (when (looking-at "#! *rnews")
- t))
-
-(defun nndoc-rnews-body-end ()
- (and (re-search-backward nndoc-article-begin nil t)
- (forward-line 1)
- (goto-char (+ (point) (string-to-number (match-string 1))))))
-
-(defun nndoc-babyl-type-p ()
- (when (re-search-forward "\^_\^L *\n" nil t)
- t))
-
-(defun nndoc-babyl-body-begin ()
- (re-search-forward "^\n" nil t)
- (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
- (let ((next (or (save-excursion
- (re-search-forward nndoc-article-begin nil t))
- (point-max))))
- (unless (re-search-forward "^\n" next t)
- (goto-char next)
- (forward-line -1)
- (insert "\n")
- (forward-line -1)))))
-
-(defun nndoc-babyl-head-begin ()
- (when (re-search-forward "^[0-9].*\n" nil t)
- (when (looking-at "\\*\\*\\* EOOH \\*\\*\\*")
- (forward-line 1))
- t))
-
-(defun nndoc-forward-type-p ()
- (when (and (re-search-forward "^-+ \\(Start of \\)?forwarded message.*\n+"
- nil t)
- (looking-at "[\r\n]*[a-zA-Z][a-zA-Z0-9-]*:\\|^>?From "))
- t))
-
-(defun nndoc-rfc934-type-p ()
- (when (and (re-search-forward "^-+ Start of forwarded.*\n+" nil t)
- (not (re-search-forward "^Subject:.*digest" nil t))
- (not (re-search-backward "^From:" nil t 2))
- (not (re-search-forward "^From:" nil t 2)))
- t))
-
-(defun nndoc-mailman-type-p ()
- (when (re-search-forward "^--__--__--\n+" nil t)
- t))
-
-(defun nndoc-rfc822-forward-type-p ()
- (save-restriction
- (message-narrow-to-head)
- (when (re-search-forward "^Content-Type: *message/rfc822" nil t)
- t)))
-
-(defun nndoc-rfc822-forward-body-end-function ()
- (goto-char (point-max)))
-
-(defun nndoc-rfc822-forward-generate-article (article &optional head)
- (let ((entry (cdr (assq article nndoc-dissection-alist)))
- (begin (point))
- encoding)
- (with-current-buffer nndoc-current-buffer
- (save-restriction
- (message-narrow-to-head)
- (setq encoding (message-fetch-field "content-transfer-encoding"))))
- (insert-buffer-substring nndoc-current-buffer (car entry) (nth 3 entry))
- (when encoding
- (save-restriction
- (narrow-to-region begin (point-max))
- (mm-decode-content-transfer-encoding
- (intern (downcase (mail-header-strip encoding))))))
- (when head
- (goto-char begin)
- (when (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))))
- t)
-
-(defun nndoc-rfc822-forward-generate-head (article)
- (nndoc-rfc822-forward-generate-article article 'head))
-
-(defun nndoc-mime-parts-type-p ()
- (let ((case-fold-search t)
- (limit (search-forward "\n\n" nil t)))
- (goto-char (point-min))
- (when (and limit
- (re-search-forward
- (concat "\
-^Content-Type:[ \t]*multipart/[a-z]+ *; *\\(\\(\n[ \t]\\)?.*;\\)*"
- "\\(\n[ \t]\\)?[ \t]*boundary=\"?[^\"\n]*[^\" \t\n]")
- limit t))
- t)))
-
-(defun nndoc-transform-mime-parts (article)
- (let* ((entry (cdr (assq article nndoc-dissection-alist)))
- (headers (nth 5 entry)))
- (when headers
- (goto-char (point-min))
- (insert headers))))
-
-(defun nndoc-generate-mime-parts-head (article)
- (let* ((entry (cdr (assq article nndoc-dissection-alist)))
- (headers (nth 6 entry)))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert-buffer-substring
- nndoc-current-buffer (car entry) (nth 1 entry))
- (goto-char (point-max)))
- (when headers
- (insert headers))))
-
-(defun nndoc-clari-briefs-type-p ()
- (when (let ((case-fold-search nil))
- (re-search-forward "^\t[^a-z]+ ([^a-z]+) --" nil t))
- t))
-
-(defun nndoc-transform-clari-briefs (article)
- (goto-char (point-min))
- (when (looking-at " *\\*\\(.*\\)\n")
- (replace-match "" t t))
- (nndoc-generate-clari-briefs-head article))
-
-(defun nndoc-generate-clari-briefs-head (article)
- (let ((entry (cdr (assq article nndoc-dissection-alist)))
- subject from)
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (save-restriction
- (narrow-to-region (car entry) (nth 3 entry))
- (goto-char (point-min))
- (when (looking-at " *\\*\\(.*\\)$")
- (setq subject (match-string 1))
- (when (string-match "[ \t]+$" subject)
- (setq subject (substring subject 0 (match-beginning 0)))))
- (when
- (let ((case-fold-search nil))
- (re-search-forward
- "^\t\\([^a-z]+\\(,[^(]+\\)? ([^a-z]+)\\) --" nil t))
- (setq from (match-string 1)))))
- (insert "From: " "clari@clari.net (" (or from "unknown") ")"
- "\nSubject: " (or subject "(no subject)") "\n")))
-
-(defun nndoc-exim-bounce-type-p ()
- (and (re-search-forward "^------ This is a copy of the message, including all the headers. ------" nil t)
- t))
-
-(defun nndoc-exim-bounce-body-end-function ()
- (goto-char (point-max)))
-
-
-(defun nndoc-mime-digest-type-p ()
- (let ((case-fold-search t)
- boundary-id b-delimiter entry)
- (when (and
- (re-search-forward
- (concat "^Content-Type: *multipart/digest;[ \t\n]*[ \t]"
- "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)")
- nil t)
- (match-beginning 1))
- (setq boundary-id (match-string 1)
- b-delimiter (concat "\n--" boundary-id "[ \t]*$"))
- (setq entry (assq 'mime-digest nndoc-type-alist))
- (setcdr entry
- (list
- (cons 'head-begin "^ ?\n")
- (cons 'head-end "^ ?$")
- (cons 'body-begin "^ ?\n")
- (cons 'article-begin b-delimiter)
- (cons 'body-end-function 'nndoc-digest-body-end)
- (cons 'file-end (concat "^--" boundary-id "--[ \t]*$"))))
- t)))
-
-(defun nndoc-standard-digest-type-p ()
- (when (and (re-search-forward (concat "^" (make-string 70 ?-) "\n\n") nil t)
- (re-search-forward
- (concat "\n\n" (make-string 30 ?-) "\n\n") nil t))
- t))
-
-(defun nndoc-digest-body-end ()
- (and (re-search-forward nndoc-article-begin nil t)
- (goto-char (match-beginning 0))))
-
-(defun nndoc-slack-digest-type-p ()
- 0)
-
-(defun nndoc-lanl-gov-announce-type-p ()
- (when (let ((case-fold-search nil))
- (re-search-forward "^\\\\\\\\\nPaper\\( (\\*cross-listing\\*)\\)?: [a-zA-Z-\\.]+/[0-9]+" nil t))
- t))
-
-(defun nndoc-transform-lanl-gov-announce (article)
- (goto-char (point-max))
- (when (re-search-backward "^\\\\\\\\ +( *\\([^ ]*\\) , *\\([^ ]*\\))" nil t)
- (replace-match "\n\nGet it at \\1 (\\2)" t nil))
- (goto-char (point-min))
- (while (re-search-forward "^\\\\\\\\$" nil t)
- (replace-match "" t nil))
- (goto-char (point-min))
- (when (re-search-forward "^replaced with revised version +\\(.*[^ ]\\) +" nil t)
- (replace-match "Date: \\1 (revised) " t nil))
- (goto-char (point-min))
- (unless (re-search-forward "^From" nil t)
- (goto-char (point-min))
- (when (re-search-forward "^Authors?: \\(.*\\)" nil t)
- (goto-char (point-min))
- (insert "From: " (match-string 1) "\n"))))
-
-(defun nndoc-generate-lanl-gov-head (article)
- (let ((entry (cdr (assq article nndoc-dissection-alist)))
- (from "<no address given>")
- subject date)
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (save-restriction
- (narrow-to-region (car entry) (nth 1 entry))
- (goto-char (point-min))
- (when (looking-at "^Paper.*: \\([a-zA-Z-\\.]+/[0-9]+\\)")
- (setq subject (concat " (" (match-string 1) ")"))
- (when (re-search-forward "^From: \\(.*\\)" nil t)
- (setq from (concat "<"
- (cadr (funcall gnus-extract-address-components
- (match-string 1))) ">")))
- (if (re-search-forward "^Date: +\\([^(]*\\)" nil t)
- (setq date (match-string 1))
- (when (re-search-forward "^replaced with revised version +\\([^(]*\\)" nil t)
- (setq date (match-string 1))))
- (when (re-search-forward "^Title: \\([^\f]*\\)\nAuthors?: \\(.*\\)"
- nil t)
- (setq subject (concat (match-string 1) subject))
- (setq from (concat (match-string 2) " " from))))))
- (while (and from (string-match "(\[^)\]*)" from))
- (setq from (replace-match "" t t from)))
- (insert "From: " (or from "unknown")
- "\nSubject: " (or subject "(no subject)") "\n")
- (if date (insert "Date: " date))))
-
-(defun nndoc-nsmail-type-p ()
- (when (looking-at "From - ")
- t))
-
-(defun nndoc-outlook-article-begin ()
- (prog1 (re-search-forward "From:\\|Received:" nil t)
- (goto-char (match-beginning 0))))
-
-(defun nndoc-outlook-type-p ()
- ;; FIXME: Is JMF the magic of outlook mailbox? -- ShengHuo.
- (looking-at "JMF"))
-
-(defun nndoc-oe-dbx-type-p ()
- (looking-at (mm-string-as-multibyte "\317\255\022\376")))
-
-(defun nndoc-read-little-endian ()
- (+ (prog1 (char-after) (forward-char 1))
- (lsh (prog1 (char-after) (forward-char 1)) 8)
- (lsh (prog1 (char-after) (forward-char 1)) 16)
- (lsh (prog1 (char-after) (forward-char 1)) 24)))
-
-(defun nndoc-oe-dbx-decode-block ()
- (list
- (nndoc-read-little-endian) ;; this address
- (nndoc-read-little-endian) ;; next address offset
- (nndoc-read-little-endian) ;; blocksize
- (nndoc-read-little-endian))) ;; next address
-
-(defun nndoc-oe-dbx-dissection ()
- (let ((i 0) blk p tp)
- (goto-char 60117) ;; 0x0000EAD4+1
- (setq p (point))
- (unless (eobp)
- (setq blk (nndoc-oe-dbx-decode-block)))
- (while (and blk (> (car blk) 0) (or (zerop (nth 3 blk))
- (> (nth 3 blk) p)))
- (push (list (incf i) p nil nil nil 0) nndoc-dissection-alist)
- (while (and (> (car blk) 0) (> (nth 3 blk) p))
- (goto-char (1+ (nth 3 blk)))
- (setq blk (nndoc-oe-dbx-decode-block)))
- (if (or (<= (car blk) p)
- (<= (nth 1 blk) 0)
- (not (zerop (nth 3 blk))))
- (setq blk nil)
- (setq tp (+ (car blk) (nth 1 blk) 17))
- (if (or (<= tp p) (>= tp (point-max)))
- (setq blk nil)
- (goto-char tp)
- (setq p tp
- blk (nndoc-oe-dbx-decode-block)))))))
-
-(defun nndoc-oe-dbx-generate-article (article &optional head)
- (let ((entry (cdr (assq article nndoc-dissection-alist)))
- (cur (current-buffer))
- (begin (point))
- blk p)
- (with-current-buffer nndoc-current-buffer
- (setq p (car entry))
- (while (> p (point-min))
- (goto-char p)
- (setq blk (nndoc-oe-dbx-decode-block))
- (setq p (point))
- (with-current-buffer cur
- (insert-buffer-substring nndoc-current-buffer p (+ p (nth 2 blk))))
- (setq p (1+ (nth 3 blk)))))
- (goto-char begin)
- (while (re-search-forward "\r$" nil t)
- (delete-backward-char 1))
- (when head
- (goto-char begin)
- (when (search-forward "\n\n" nil t)
- (setcar (cddddr entry) (count-lines (point) (point-max)))
- (delete-region (1- (point)) (point-max))))
- t))
-
-(defun nndoc-oe-dbx-generate-head (article)
- (nndoc-oe-dbx-generate-article article 'head))
-
-(defun nndoc-mail-in-mail-type-p ()
- (let (found)
- (save-excursion
- (catch 'done
- (while (re-search-forward "\n\n[-A-Za-z0-9]+:" nil t)
- (setq found 0)
- (forward-line)
- (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:")
- (if (looking-at "[-A-Za-z0-9]+:")
- (setq found (1+ found)))
- (forward-line))
- (if (and (> found 0) (looking-at "\n"))
- (throw 'done 9999)))
- nil))))
-
-(defun nndoc-mail-in-mail-article-begin ()
- (let (point found)
- (if (catch 'done
- (while (re-search-forward "\n\n\\([-A-Za-z0-9]+:\\)" nil t)
- (setq found 0)
- (setq point (match-beginning 1))
- (forward-line)
- (while (looking-at "[ \t]\\|[-A-Za-z0-9]+:")
- (if (looking-at "[-A-Za-z0-9]+:")
- (setq found (1+ found)))
- (forward-line))
- (if (and (> found 0) (looking-at "\n"))
- (throw 'done t)))
- nil)
- (goto-char point))))
-
-(deffoo nndoc-request-accept-article (group &optional server last)
- nil)
-
-;;;
-;;; Functions for dissecting the documents
-;;;
-
-(defun nndoc-search (regexp)
- (prog1
- (re-search-forward regexp nil t)
- (beginning-of-line)))
-
-(defun nndoc-dissect-buffer ()
- "Go through the document and partition it into heads/bodies/articles."
- (let ((i 0)
- (first t)
- art-begin head-begin head-end body-begin body-end)
- (setq nndoc-dissection-alist nil)
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (goto-char (point-min))
- ;; Remove blank lines.
- (while (eq (following-char) ?\n)
- (delete-char 1))
- (if nndoc-dissection-function
- (funcall nndoc-dissection-function)
- ;; Find the beginning of the file.
- (when nndoc-file-begin
- (nndoc-search nndoc-file-begin))
- ;; Go through the file.
- (while (if (and first nndoc-first-article)
- (nndoc-search nndoc-first-article)
- (if art-begin
- (goto-char art-begin)
- (nndoc-article-begin)))
- (setq first nil
- art-begin nil)
- (cond (nndoc-head-begin-function
- (funcall nndoc-head-begin-function))
- (nndoc-head-begin
- (nndoc-search nndoc-head-begin)))
- (if (or (eobp)
- (and nndoc-file-end
- (looking-at nndoc-file-end)))
- (goto-char (point-max))
- (setq head-begin (point))
- (nndoc-search (or nndoc-head-end "^$"))
- (setq head-end (point))
- (if nndoc-body-begin-function
- (funcall nndoc-body-begin-function)
- (nndoc-search (or nndoc-body-begin "^\n")))
- (setq body-begin (point))
- (or (and nndoc-body-end-function
- (funcall nndoc-body-end-function))
- (and nndoc-body-end
- (nndoc-search nndoc-body-end))
- (and (nndoc-article-begin)
- (setq art-begin (point)))
- (progn
- (goto-char (point-max))
- (when nndoc-file-end
- (and (re-search-backward nndoc-file-end nil t)
- (beginning-of-line)))))
- (setq body-end (point))
- (push (list (incf i) head-begin head-end body-begin body-end
- (count-lines body-begin body-end))
- nndoc-dissection-alist)))))))
-
-(defun nndoc-article-begin ()
- (if nndoc-article-begin-function
- (funcall nndoc-article-begin-function)
- (ignore-errors
- (nndoc-search nndoc-article-begin))))
-
-(defun nndoc-unquote-dashes ()
- "Unquote quoted non-separators in digests."
- (while (re-search-forward "^- -"nil t)
- (replace-match "-" t t)))
-
-;; Against compiler warnings.
-(defvar nndoc-mime-split-ordinal)
-
-(defun nndoc-dissect-mime-parts ()
- "Go through a MIME composite article and partition it into sub-articles.
-When a MIME entity contains sub-entities, dissection produces one article for
-the header of this entity, and one article per sub-entity."
- (setq nndoc-dissection-alist nil
- nndoc-mime-split-ordinal 0)
- (save-excursion
- (set-buffer nndoc-current-buffer)
- (nndoc-dissect-mime-parts-sub (point-min) (point-max) nil nil nil)))
-
-(defun nndoc-dissect-mime-parts-sub (head-begin body-end article-insert
- position parent)
- "Dissect an entity, within a composite MIME message.
-The complete message or MIME entity extends from HEAD-BEGIN to BODY-END.
-ARTICLE-INSERT should be added at beginning for generating a full article.
-The string POSITION holds a dotted decimal representation of the article
-position in the hierarchical structure, it is nil for the outer entity.
-PARENT is the message-ID of the parent summary line, or nil for none."
- (let ((case-fold-search t)
- (message-id (nnmail-message-id))
- head-end body-begin summary-insert message-rfc822 multipart-any
- subject content-type type subtype boundary-regexp)
- ;; Gracefully handle a missing body.
- (goto-char head-begin)
- (if (or (and (eq (char-after) ?\n) (or (forward-char 1) t))
- (search-forward "\n\n" body-end t))
- (setq head-end (1- (point))
- body-begin (point))
- (setq head-end body-end
- body-begin body-end))
- (narrow-to-region head-begin head-end)
- ;; Save MIME attributes.
- (goto-char head-begin)
- (setq content-type (message-fetch-field "Content-Type"))
- (when content-type
- (when (string-match
- "^ *\\([^ \t\n/;]+\\)/\\([^ \t\n/;]+\\)" content-type)
- (setq type (downcase (match-string 1 content-type))
- subtype (downcase (match-string 2 content-type))
- message-rfc822 (and (string= type "message")
- (string= subtype "rfc822"))
- multipart-any (string= type "multipart")))
- (when (string-match ";[ \t\n]*name=\\([^ \t\n;]+\\)" content-type)
- (setq subject (match-string 1 content-type)))
- (when (string-match "boundary=\"?\\([^\"\n]*[^\" \t\n]\\)" content-type)
- (setq boundary-regexp (concat "^--"
- (regexp-quote
- (match-string 1 content-type))
- "\\(--\\)?[ \t]*\n"))))
- (unless subject
- (when (or multipart-any (not article-insert))
- (setq subject (message-fetch-field "Subject"))))
- (unless type
- (setq type "text"
- subtype "plain"))
- ;; Prepare the article and summary inserts.
- (unless article-insert
- (setq article-insert (buffer-string)
- head-end head-begin))
- ;; Fix MIME-Version
- (unless (string-match "MIME-Version:" article-insert)
- (setq article-insert
- (concat article-insert "MIME-Version: 1.0\n")))
- (setq summary-insert article-insert)
- ;; - summary Subject.
- (setq summary-insert
- (let ((line (concat "Subject: <" position
- (and position multipart-any ".")
- (and multipart-any "*")
- (and (or position multipart-any) " ")
- (cond ((string= subtype "plain") type)
- ((string= subtype "basic") type)
- (t subtype))
- ">"
- (and subject " ")
- subject
- "\n")))
- (if (string-match "Subject:.*\n\\([ \t].*\n\\)*" summary-insert)
- (replace-match line t t summary-insert)
- (concat summary-insert line))))
- ;; - summary Message-ID.
- (setq summary-insert
- (let ((line (concat "Message-ID: " message-id "\n")))
- (if (string-match "Message-ID:.*\n\\([ \t].*\n\\)*" summary-insert)
- (replace-match line t t summary-insert)
- (concat summary-insert line))))
- ;; - summary References.
- (when parent
- (setq summary-insert
- (let ((line (concat "References: " parent "\n")))
- (if (string-match "References:.*\n\\([ \t].*\n\\)*"
- summary-insert)
- (replace-match line t t summary-insert)
- (concat summary-insert line)))))
- ;; Generate dissection information for this entity.
- (push (list (incf nndoc-mime-split-ordinal)
- head-begin head-end body-begin body-end
- (count-lines body-begin body-end)
- article-insert summary-insert)
- nndoc-dissection-alist)
- ;; Recurse for all sub-entities, if any.
- (widen)
- (cond
- (message-rfc822
- (save-excursion
- (nndoc-dissect-mime-parts-sub body-begin body-end nil
- position message-id)))
- ((and multipart-any boundary-regexp)
- (let ((part-counter 0)
- part-begin part-end eof-flag)
- (while (string-match "\
-^\\(Lines\\|Content-\\(Type\\|Transfer-Encoding\\|Disposition\\)\\):.*\n\\([ \t].*\n\\)*"
- article-insert)
- (setq article-insert (replace-match "" t t article-insert)))
- (let ((case-fold-search nil))
- (goto-char body-begin)
- (setq eof-flag (not (re-search-forward boundary-regexp body-end t)))
- (while (not eof-flag)
- (setq part-begin (point))
- (cond ((re-search-forward boundary-regexp body-end t)
- (or (not (match-string 1))
- (string= (match-string 1) "")
- (setq eof-flag t))
- (forward-line -1)
- (setq part-end (point))
- (forward-line 1))
- (t (setq part-end body-end
- eof-flag t)))
- (save-excursion
- (nndoc-dissect-mime-parts-sub
- part-begin part-end article-insert
- (concat position
- (and position ".")
- (format "%d" (incf part-counter)))
- message-id)))))))))
-
-;;;###autoload
-(defun nndoc-add-type (definition &optional position)
- "Add document DEFINITION to the list of nndoc document definitions.
-If POSITION is nil or `last', the definition will be added
-as the last checked definition, if t or `first', add as the
-first definition, and if any other symbol, add after that
-symbol in the alist."
- ;; First remove any old instances.
- (gnus-pull (car definition) nndoc-type-alist)
- ;; Then enter the new definition in the proper place.
- (cond
- ((or (null position) (eq position 'last))
- (setq nndoc-type-alist (nconc nndoc-type-alist (list definition))))
- ((or (eq position t) (eq position 'first))
- (push definition nndoc-type-alist))
- (t
- (let ((list (memq (assq position nndoc-type-alist)
- nndoc-type-alist)))
- (unless list
- (error "No such position: %s" position))
- (setcdr list (cons definition (cdr list)))))))
-
-(provide 'nndoc)
-
-;;; arch-tag: f5c2970e-0387-47ac-a0b3-6cc317dffabe
-;;; nndoc.el ends here
+++ /dev/null
-;;; nndraft.el --- draft article access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-start)
-(require 'nnmh)
-(require 'nnoo)
-(require 'mm-util)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndraft
- nnmh)
-
-(defvoo nndraft-directory (nnheader-concat gnus-directory "drafts/")
- "Where nndraft will store its files."
- nnmh-directory)
-
-\f
-
-(defvoo nndraft-current-group "" nil nnmh-current-group)
-(defvoo nndraft-get-new-mail nil nil nnmh-get-new-mail)
-(defvoo nndraft-current-directory nil nil nnmh-current-directory)
-
-(defconst nndraft-version "nndraft 1.0")
-(defvoo nndraft-status-string "" nil nnmh-status-string)
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nndraft)
-
-(deffoo nndraft-open-server (server &optional defs)
- (nnoo-change-server 'nndraft server defs)
- (cond
- ((not (file-exists-p nndraft-directory))
- (nndraft-close-server)
- (nnheader-report 'nndraft "No such file or directory: %s"
- nndraft-directory))
- ((not (file-directory-p (file-truename nndraft-directory)))
- (nndraft-close-server)
- (nnheader-report 'nndraft "Not a directory: %s" nndraft-directory))
- (t
- (nnheader-report 'nndraft "Opened server %s using directory %s"
- server nndraft-directory)
- t)))
-
-(deffoo nndraft-retrieve-headers (articles &optional group server fetch-old)
- (nndraft-possibly-change-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let* (article)
- ;; We don't support fetching by Message-ID.
- (if (stringp (car articles))
- 'headers
- (while articles
- (narrow-to-region (point) (point))
- (when (nndraft-request-article
- (setq article (pop articles)) group server (current-buffer))
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (goto-char (point-max)))
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (insert (format "221 %d Article retrieved.\n" article))
- (widen)
- (goto-char (point-max))
- (insert ".\n")))
-
- (nnheader-fold-continuation-lines)
- 'headers))))
-
-(deffoo nndraft-request-article (id &optional group server buffer)
- (nndraft-possibly-change-group group)
- (when (numberp id)
- ;; We get the newest file of the auto-saved file and the
- ;; "real" file.
- (let* ((file (nndraft-article-filename id))
- (auto (nndraft-auto-save-file-name file))
- (newest (if (file-newer-than-file-p file auto) file auto))
- (nntp-server-buffer (or buffer nntp-server-buffer)))
- (when (and (file-exists-p newest)
- (let ((nnmail-file-coding-system
- (if (file-newer-than-file-p file auto)
- (if (member group '("drafts" "delayed"))
- message-draft-coding-system
- mm-text-coding-system)
- mm-auto-save-coding-system)))
- (nnmail-find-file newest)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- ;; If there's a mail header separator in this file,
- ;; we remove it.
- (when (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "$") nil t)
- (replace-match "" t t)))
- t))))
-
-(deffoo nndraft-request-restore-buffer (article &optional group server)
- "Request a new buffer that is restored to the state of ARTICLE."
- (nndraft-possibly-change-group group)
- (when (nndraft-request-article article group server (current-buffer))
- (message-remove-header "xref")
- (message-remove-header "lines")
- ;; Articles in nndraft:queue are considered as sent messages. The
- ;; Date field should be the time when they are sent.
- ;;(message-remove-header "date")
- t))
-
-(deffoo nndraft-request-update-info (group info &optional server)
- (nndraft-possibly-change-group group)
- (gnus-info-set-read
- info
- (gnus-update-read-articles (gnus-group-prefixed-name group '(nndraft ""))
- (nndraft-articles) t))
- (let ((marks (nth 3 info)))
- (when marks
- ;; Nix out all marks except the `unsend'-able article marks.
- (setcar (nthcdr 3 info)
- (if (assq 'unsend marks)
- (list (assq 'unsend marks))
- nil))))
- t)
-
-(defun nndraft-generate-headers ()
- (save-excursion
- (message-generate-headers
- (message-headers-to-generate
- message-required-headers message-draft-headers nil))))
-
-(deffoo nndraft-request-associate-buffer (group)
- "Associate the current buffer with some article in the draft group."
- (nndraft-open-server "")
- (nndraft-request-group group)
- (nndraft-possibly-change-group group)
- (let ((gnus-verbose-backends nil)
- (buf (current-buffer))
- article file)
- (with-temp-buffer
- (insert-buffer-substring buf)
- (setq article (nndraft-request-accept-article
- group (nnoo-current-server 'nndraft) t 'noinsert)
- file (nndraft-article-filename article)))
- (setq buffer-file-name (expand-file-name file)
- buffer-auto-save-file-name (make-auto-save-file-name))
- (clear-visited-file-modtime)
- (let ((hook (if (boundp 'write-contents-functions)
- 'write-contents-functions
- 'write-contents-hooks)))
- (gnus-make-local-hook hook)
- (add-hook hook 'nndraft-generate-headers nil t))
- article))
-
-(deffoo nndraft-request-group (group &optional server dont-check)
- (nndraft-possibly-change-group group)
- (unless dont-check
- (let* ((pathname (nnmail-group-pathname group nndraft-directory))
- (file-name-coding-system nnmail-pathname-coding-system)
- dir file)
- (nnheader-re-read-dir pathname)
- (setq dir (mapcar (lambda (name) (string-to-number (substring name 1)))
- (ignore-errors (directory-files
- pathname nil "^#[0-9]+#$" t))))
- (dolist (n dir)
- (unless (file-exists-p
- (setq file (expand-file-name (int-to-string n) pathname)))
- (rename-file (nndraft-auto-save-file-name file) file)))))
- (nnoo-parent-function 'nndraft
- 'nnmh-request-group
- (list group server dont-check)))
-
-(deffoo nndraft-request-move-article (article group server
- accept-form &optional last)
- (nndraft-possibly-change-group group)
- (let ((buf (get-buffer-create " *nndraft move*"))
- result)
- (and
- (nndraft-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result)
- (null (nndraft-request-expire-articles (list article) group server 'force))
- result)))
-
-(deffoo nndraft-request-expire-articles (articles group &optional server force)
- (nndraft-possibly-change-group group)
- (let* ((nnmh-allow-delete-final t)
- (res (nnoo-parent-function 'nndraft
- 'nnmh-request-expire-articles
- (list articles group server force)))
- article)
- ;; Delete all the "state" files of articles that have been expired.
- (while articles
- (unless (memq (setq article (pop articles)) res)
- (let ((auto (nndraft-auto-save-file-name
- (nndraft-article-filename article))))
- (when (file-exists-p auto)
- (funcall nnmail-delete-file-function auto)))
- (dolist (backup
- (let ((kept-new-versions 1)
- (kept-old-versions 0))
- (find-backup-file-name
- (nndraft-article-filename article))))
- (when (file-exists-p backup)
- (funcall nnmail-delete-file-function backup)))))
- res))
-
-(deffoo nndraft-request-accept-article (group &optional server last noinsert)
- (nndraft-possibly-change-group group)
- (let ((gnus-verbose-backends nil))
- (nnoo-parent-function 'nndraft 'nnmh-request-accept-article
- (list group server last noinsert))))
-
-(deffoo nndraft-request-replace-article (article group buffer)
- (nndraft-possibly-change-group group)
- (let ((nnmail-file-coding-system
- (if (member group '("drafts" "delayed"))
- message-draft-coding-system
- mm-text-coding-system)))
- (nnoo-parent-function 'nndraft 'nnmh-request-replace-article
- (list article group buffer))))
-
-(deffoo nndraft-request-create-group (group &optional server args)
- (nndraft-possibly-change-group group)
- (if (file-exists-p nndraft-current-directory)
- (if (file-directory-p nndraft-current-directory)
- t
- nil)
- (condition-case ()
- (progn
- (gnus-make-directory nndraft-current-directory)
- t)
- (file-error nil))))
-
-\f
-;;; Low-Level Interface
-
-(defun nndraft-possibly-change-group (group)
- (when (and group
- (not (equal group nndraft-current-group)))
- (nndraft-open-server "")
- (setq nndraft-current-group group)
- (setq nndraft-current-directory
- (nnheader-concat nndraft-directory group))))
-
-(defun nndraft-article-filename (article &rest args)
- (apply 'concat
- (file-name-as-directory nndraft-current-directory)
- (int-to-string article)
- args))
-
-(defun nndraft-auto-save-file-name (file)
- (save-excursion
- (prog1
- (progn
- (set-buffer (get-buffer-create " *draft tmp*"))
- (setq buffer-file-name file)
- (make-auto-save-file-name))
- (kill-buffer (current-buffer)))))
-
-(defun nndraft-articles ()
- "Return the list of messages in the group."
- (gnus-make-directory nndraft-current-directory)
- (sort
- (mapcar 'string-to-number
- (directory-files nndraft-current-directory nil "\\`[0-9]+\\'" t))
- '<))
-
-(nnoo-import nndraft
- (nnmh
- nnmh-retrieve-headers
- nnmh-request-group
- nnmh-close-group
- nnmh-request-list
- nnmh-request-newsgroups))
-
-(provide 'nndraft)
-
-;;; arch-tag: 3ce26ca0-41cb-48b1-8703-4dad35e188aa
-;;; nndraft.el ends here
+++ /dev/null
-;;; nneething.el --- arbitrary file access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'nnoo)
-(require 'gnus-util)
-
-(nnoo-declare nneething)
-
-(defvoo nneething-map-file-directory
- (nnheader-concat gnus-directory ".nneething/")
- "Where nneething stores the map files.")
-
-(defvoo nneething-map-file ".nneething"
- "Name of the map files.")
-
-(defvoo nneething-exclude-files nil
- "Regexp saying what files to exclude from the group.
-If this variable is nil, no files will be excluded.")
-
-(defvoo nneething-include-files nil
- "Regexp saying what files to include in the group.
-If this variable is non-nil, only files matching this regexp will be
-included.")
-
-\f
-
-;;; Internal variables.
-
-(defconst nneething-version "nneething 1.0"
- "nneething version.")
-
-(defvoo nneething-current-directory nil
- "Current news group directory.")
-
-(defvoo nneething-status-string "")
-
-(defvoo nneething-work-buffer " *nneething work*")
-
-(defvoo nneething-group nil)
-(defvoo nneething-map nil)
-(defvoo nneething-read-only nil)
-(defvoo nneething-active nil)
-(defvoo nneething-address nil)
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nneething)
-
-(deffoo nneething-retrieve-headers (articles &optional group server fetch-old)
- (nneething-possibly-change-directory group)
-
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let* ((number (length articles))
- (count 0)
- (large (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)))
- article file)
-
- (if (stringp (car articles))
- 'headers
-
- (while (setq article (pop articles))
- (setq file (nneething-file-name article))
-
- (when (and (file-exists-p file)
- (or (file-directory-p file)
- (not (zerop (nnheader-file-size file)))))
- (insert (format "221 %d Article retrieved.\n" article))
- (nneething-insert-head file)
- (insert ".\n"))
-
- (incf count)
-
- (and large
- (zerop (% count 20))
- (nnheader-message 5 "nneething: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (when large
- (nnheader-message 5 "nneething: Receiving headers...done"))
-
- (nnheader-fold-continuation-lines)
- 'headers))))
-
-(deffoo nneething-request-article (id &optional group server buffer)
- (nneething-possibly-change-directory group)
- (let ((file (unless (stringp id)
- (nneething-file-name id)))
- (nntp-server-buffer (or buffer nntp-server-buffer)))
- (and (stringp file) ; We did not request by Message-ID.
- (file-exists-p file) ; The file exists.
- (not (file-directory-p file)) ; It's not a dir.
- (save-excursion
- (let ((nnmail-file-coding-system 'binary))
- (nnmail-find-file file)) ; Insert the file in the nntp buf.
- (unless (nnheader-article-p) ; Either it's a real article...
- (let ((type
- (unless (file-directory-p file)
- (or (cdr (assoc (concat "." (file-name-extension file))
- mailcap-mime-extensions))
- "text/plain")))
- (charset
- (mm-detect-mime-charset-region (point-min) (point-max)))
- (encoding))
- (unless (string-match "\\`text/" type)
- (base64-encode-region (point-min) (point-max))
- (setq encoding "base64"))
- (goto-char (point-min))
- (nneething-make-head file (current-buffer)
- nil type charset encoding))
- (insert "\n"))
- t))))
-
-(deffoo nneething-request-group (group &optional server dont-check)
- (nneething-possibly-change-directory group server)
- (unless dont-check
- (nneething-create-mapping)
- (if (> (car nneething-active) (cdr nneething-active))
- (nnheader-insert "211 0 1 0 %s\n" group)
- (nnheader-insert
- "211 %d %d %d %s\n"
- (- (1+ (cdr nneething-active)) (car nneething-active))
- (car nneething-active) (cdr nneething-active)
- group)))
- t)
-
-(deffoo nneething-request-list (&optional server dir)
- (nnheader-report 'nneething "LIST is not implemented."))
-
-(deffoo nneething-request-newgroups (date &optional server)
- (nnheader-report 'nneething "NEWSGROUPS is not implemented."))
-
-(deffoo nneething-request-type (group &optional article)
- 'unknown)
-
-(deffoo nneething-close-group (group &optional server)
- (setq nneething-current-directory nil)
- t)
-
-(deffoo nneething-open-server (server &optional defs)
- (nnheader-init-server-buffer)
- (if (nneething-server-opened server)
- t
- (unless (assq 'nneething-address defs)
- (setq defs (append defs (list (list 'nneething-address server)))))
- (nnoo-change-server 'nneething server defs)))
-
-\f
-;;; Internal functions.
-
-(defun nneething-possibly-change-directory (group &optional server)
- (when (and server
- (not (nneething-server-opened server)))
- (nneething-open-server server))
- (when (and group
- (not (equal nneething-group group)))
- (setq nneething-group group)
- (setq nneething-map nil)
- (setq nneething-active (cons 1 0))
- (nneething-create-mapping)))
-
-(defun nneething-map-file ()
- ;; We make sure that the .nneething directory exists.
- (gnus-make-directory nneething-map-file-directory)
- ;; We store it in a special directory under the user's home dir.
- (concat (file-name-as-directory nneething-map-file-directory)
- nneething-group nneething-map-file))
-
-(defun nneething-create-mapping ()
- ;; Read nneething-active and nneething-map.
- (when (file-exists-p nneething-address)
- (let ((map-file (nneething-map-file))
- (files (directory-files nneething-address))
- touched map-files)
- (when (file-exists-p map-file)
- (ignore-errors
- (load map-file nil t t)))
- (unless nneething-active
- (setq nneething-active (cons 1 0)))
- ;; Old nneething had a different map format.
- (when (and (cdar nneething-map)
- (atom (cdar nneething-map)))
- (setq nneething-map
- (mapcar (lambda (n)
- (list (cdr n) (car n)
- (nth 5 (file-attributes
- (nneething-file-name (car n))))))
- nneething-map)))
- ;; Remove files matching the exclusion regexp.
- (when nneething-exclude-files
- (let ((f files)
- prev)
- (while f
- (if (string-match nneething-exclude-files (car f))
- (if prev (setcdr prev (cdr f))
- (setq files (cdr files)))
- (setq prev f))
- (setq f (cdr f)))))
- ;; Remove files not matching the inclusion regexp.
- (when nneething-include-files
- (let ((f files)
- prev)
- (while f
- (if (not (string-match nneething-include-files (car f)))
- (if prev (setcdr prev (cdr f))
- (setq files (cdr files)))
- (setq prev f))
- (setq f (cdr f)))))
- ;; Remove deleted files from the map.
- (let ((map nneething-map)
- prev)
- (while map
- (if (and (member (cadr (car map)) files)
- ;; We also remove files that have changed mod times.
- (equal (nth 5 (file-attributes
- (nneething-file-name (cadr (car map)))))
- (cadr (cdar map))))
- (progn
- (push (cadr (car map)) map-files)
- (setq prev map))
- (setq touched t)
- (if prev
- (setcdr prev (cdr map))
- (setq nneething-map (cdr nneething-map))))
- (setq map (cdr map))))
- ;; Find all new files and enter them into the map.
- (while files
- (unless (member (car files) map-files)
- ;; This file is not in the map, so we enter it.
- (setq touched t)
- (setcdr nneething-active (1+ (cdr nneething-active)))
- (push (list (cdr nneething-active) (car files)
- (nth 5 (file-attributes
- (nneething-file-name (car files)))))
- nneething-map))
- (setq files (cdr files)))
- (when (and touched
- (not nneething-read-only))
- (with-temp-file map-file
- (insert "(setq nneething-map '")
- (gnus-prin1 nneething-map)
- (insert ")\n(setq nneething-active '")
- (gnus-prin1 nneething-active)
- (insert ")\n"))))))
-
-(defun nneething-insert-head (file)
- "Insert the head of FILE."
- (when (nneething-get-head file)
- (insert-buffer-substring nneething-work-buffer)
- (goto-char (point-max))))
-
-(defun nneething-encode-file-name (file &optional coding-system)
- "Encode the name of the FILE in CODING-SYSTEM."
- (let ((pos 0) buf)
- (setq file (mm-encode-coding-string
- file (or coding-system nnmail-pathname-coding-system)))
- (while (string-match "[^-0-9a-zA-Z_:/.]" file pos)
- (setq buf (cons (format "%%%02x" (aref file (match-beginning 0)))
- (cons (substring file pos (match-beginning 0)) buf))
- pos (match-end 0)))
- (apply (function concat)
- (nreverse (cons (substring file pos) buf)))))
-
-(defun nneething-decode-file-name (file &optional coding-system)
- "Decode the name of the FILE is encoded in CODING-SYSTEM."
- (let ((pos 0) buf)
- (while (string-match "%\\([0-9a-fA-F][0-9a-fA-F]\\)" file pos)
- (setq buf (cons (string (string-to-number (match-string 1 file) 16))
- (cons (substring file pos (match-beginning 0)) buf))
- pos (match-end 0)))
- (mm-decode-coding-string
- (apply (function concat)
- (nreverse (cons (substring file pos) buf)))
- (or coding-system nnmail-pathname-coding-system))))
-
-(defun nneething-get-file-name (id)
- "Extract the file name from the message ID string."
- (when (string-match "\\`<nneething-\\([^@]+\\)@.*>\\'" id)
- (nneething-decode-file-name (match-string 1 id))))
-
-(defun nneething-make-head (file &optional buffer extra-msg
- mime-type mime-charset mime-encoding)
- "Create a head by looking at the file attributes of FILE."
- (let ((atts (file-attributes file)))
- (insert
- "Subject: " (file-name-nondirectory file) (or extra-msg "") "\n"
- "Message-ID: <nneething-" (nneething-encode-file-name file)
- "@" (system-name) ">\n"
- (if (equal '(0 0) (nth 5 atts)) ""
- (concat "Date: " (current-time-string (nth 5 atts)) "\n"))
- (or (when buffer
- (save-excursion
- (set-buffer buffer)
- (when (re-search-forward "<[a-zA-Z0-9_]@[-a-zA-Z0-9_]>" 1000 t)
- (concat "From: " (match-string 0) "\n"))))
- (nneething-from-line (nth 2 atts) file))
- (if (> (string-to-number (int-to-string (nth 7 atts))) 0)
- (concat "Chars: " (int-to-string (nth 7 atts)) "\n")
- "")
- (if buffer
- (save-excursion
- (set-buffer buffer)
- (concat "Lines: " (int-to-string
- (count-lines (point-min) (point-max)))
- "\n"))
- "")
- (if mime-type
- (concat "Content-Type: " mime-type
- (if mime-charset
- (concat "; charset="
- (if (stringp mime-charset)
- mime-charset
- (symbol-name mime-charset)))
- "")
- (if mime-encoding
- (concat "\nContent-Transfer-Encoding: " mime-encoding)
- "")
- "\nMIME-Version: 1.0\n")
- ""))))
-
-(defun nneething-from-line (uid &optional file)
- "Return a From header based of UID."
- (let* ((login (condition-case nil
- (user-login-name uid)
- (error
- (cond ((= uid (user-uid)) (user-login-name))
- ((zerop uid) "root")
- (t (int-to-string uid))))))
- (name (condition-case nil
- (user-full-name uid)
- (error
- (cond ((= uid (user-uid)) (user-full-name))
- ((zerop uid) "Ms. Root")))))
- (host (if (string-match "\\`/[^/@]*@\\([^:/]+\\):" file)
- (prog1
- (substring file
- (match-beginning 1)
- (match-end 1))
- (when (string-match
- "/\\(users\\|home\\)/\\([^/]+\\)/" file)
- (setq login (substring file
- (match-beginning 2)
- (match-end 2))
- name nil)))
- (system-name))))
- (concat "From: " login "@" host
- (if name (concat " (" name ")") "") "\n")))
-
-(defun nneething-get-head (file)
- "Either find the head in FILE or make a head for FILE."
- (save-excursion
- (set-buffer (get-buffer-create nneething-work-buffer))
- (setq case-fold-search nil)
- (buffer-disable-undo)
- (erase-buffer)
- (cond
- ((not (file-exists-p file))
- ;; The file do not exist.
- nil)
- ((or (file-directory-p file)
- (file-symlink-p file))
- ;; It's a dir, so we fudge a head.
- (nneething-make-head file) t)
- (t
- ;; We examine the file.
- (condition-case ()
- (progn
- (nnheader-insert-head file)
- (if (nnheader-article-p)
- (delete-region
- (progn
- (goto-char (point-min))
- (or (and (search-forward "\n\n" nil t)
- (1- (point)))
- (point-max)))
- (point-max))
- (goto-char (point-min))
- (nneething-make-head file (current-buffer))
- (delete-region (point) (point-max))))
- (file-error
- (nneething-make-head file (current-buffer) " (unreadable)")))
- t))))
-
-(defun nneething-file-name (article)
- "Return the file name of ARTICLE."
- (let ((dir (file-name-as-directory nneething-address))
- fname)
- (if (numberp article)
- (if (setq fname (cadr (assq article nneething-map)))
- (expand-file-name fname dir)
- (mm-make-temp-file (expand-file-name "nneething" dir)))
- (expand-file-name article dir))))
-
-(provide 'nneething)
-
-;;; arch-tag: 1277f386-88f2-4459-bb24-f3f45962a6c5
-;;; nneething.el ends here
+++ /dev/null
-;;; nnfolder.el --- mail folder access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
-;; ShengHuo Zhu <zsh@cs.rochester.edu> (adding NOV)
-;; Scott Byer <byer@mv.us.adobe.com>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-(require 'gnus)
-(require 'gnus-util)
-(require 'gnus-range)
-
-(eval-and-compile
- (autoload 'gnus-article-unpropagatable-p "gnus-sum")
- (autoload 'gnus-intersection "gnus-range"))
-
-(nnoo-declare nnfolder)
-
-(defvoo nnfolder-directory (expand-file-name message-directory)
- "The name of the nnfolder directory.")
-
-(defvoo nnfolder-nov-directory nil
- "The name of the nnfolder NOV directory.
-If nil, `nnfolder-directory' is used.")
-
-(defvoo nnfolder-marks-directory nil
- "The name of the nnfolder MARKS directory.
-If nil, `nnfolder-directory' is used.")
-
-(defvoo nnfolder-active-file
- (nnheader-concat nnfolder-directory "active")
- "The name of the active file.")
-
-;; I renamed this variable to something more in keeping with the general GNU
-;; style. -SLB
-
-(defvoo nnfolder-ignore-active-file nil
- "If non-nil, the active file is ignored.
-This causes nnfolder to do some extra work in order to determine the
-true active ranges of an mbox file. Note that the active file is
-still saved, but its values are not used. This costs some extra time
-when scanning an mbox when opening it.")
-
-(defvoo nnfolder-distrust-mbox nil
- "If non-nil, the folder will be distrusted.
-This means that nnfolder will not trust the user with respect to
-inserting unaccounted for mail in the middle of an mbox file. This
-can greatly slow down scans, which now must scan the entire file for
-unmarked messages. When nil, scans occur forward from the last marked
-message, a huge time saver for large mailboxes.")
-
-(defvoo nnfolder-newsgroups-file
- (concat (file-name-as-directory nnfolder-directory) "newsgroups")
- "Mail newsgroups description file.")
-
-(defvoo nnfolder-get-new-mail t
- "If non-nil, nnfolder will check the incoming mail file and split the mail.")
-
-(defvoo nnfolder-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
-
-(defvoo nnfolder-save-buffer-hook nil
- "Hook run before saving the nnfolder mbox buffer.")
-
-
-(defvoo nnfolder-inhibit-expiry nil
- "If non-nil, inhibit expiry.")
-
-\f
-
-(defconst nnfolder-version "nnfolder 2.0"
- "nnfolder version.")
-
-(defconst nnfolder-article-marker "X-Gnus-Article-Number: "
- "String used to demarcate what the article number for a message is.")
-
-(defvoo nnfolder-current-group nil)
-(defvoo nnfolder-current-buffer nil)
-(defvoo nnfolder-status-string "")
-(defvoo nnfolder-group-alist nil)
-(defvoo nnfolder-buffer-alist nil)
-(defvoo nnfolder-scantime-alist nil)
-(defvoo nnfolder-active-timestamp nil)
-(defvoo nnfolder-active-file-coding-system mm-text-coding-system)
-(defvoo nnfolder-active-file-coding-system-for-write
- nnmail-active-file-coding-system)
-(defvoo nnfolder-file-coding-system mm-text-coding-system)
-(defvoo nnfolder-file-coding-system-for-write nnheader-file-coding-system
- "Coding system for save nnfolder file.
-if nil, `nnfolder-file-coding-system' is used.") ; FIXME: fill-in the doc-string of this variable
-
-(defvoo nnfolder-nov-is-evil nil
- "If non-nil, Gnus will never generate and use nov databases for mail groups.
-Using nov databases will speed up header fetching considerably.
-This variable shouldn't be flipped much. If you have, for some reason,
-set this to t, and want to set it to nil again, you should always run
-the `nnfolder-generate-active-file' command. The function will go
-through all nnfolder directories and generate nov databases for them
-all. This may very well take some time.")
-
-(defvoo nnfolder-nov-file-suffix ".nov")
-
-(defvoo nnfolder-nov-buffer-alist nil)
-
-(defvar nnfolder-nov-buffer-file-name nil)
-
-(defvoo nnfolder-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail groups.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set
-this to t, and want to set it to nil again, you should always remove
-the corresponding marks file (usually base nnfolder file name
-concatenated with `.mrk', but see `nnfolder-marks-file-suffix') for
-the group. Then the marks file will be regenerated properly by Gnus.")
-
-(defvoo nnfolder-marks nil)
-
-(defvoo nnfolder-marks-file-suffix ".mrk")
-
-(defvar nnfolder-marks-modtime (gnus-make-hashtable))
-
-\f
-
-;;; Interface functions
-
-(nnoo-define-basics nnfolder)
-
-(deffoo nnfolder-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let (article start stop num)
- (nnfolder-possibly-change-group group server)
- (when nnfolder-current-buffer
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (if (stringp (car articles))
- 'headers
- (if (nnfolder-retrieve-headers-with-nov articles fetch-old)
- 'nov
- (setq articles (gnus-sorted-intersection
- ;; Is ARTICLES sorted?
- (sort articles '<)
- (nnfolder-existing-articles)))
- (while (setq article (pop articles))
- (set-buffer nnfolder-current-buffer)
- (cond ((nnfolder-goto-article article)
- (setq start (point))
- (setq stop (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (insert-buffer-substring nnfolder-current-buffer
- start stop)
- (goto-char (point-max))
- (insert ".\n"))
-
- ;; If we couldn't find this article, skip over ranges
- ;; of missing articles so we don't search the whole file
- ;; for each of them.
- ((numberp article)
- (setq start (point))
- (and
- ;; Check that we are either at BOF or after an
- ;; article with a lower number. We do this so we
- ;; won't be confused by out-of-order article numbers,
- ;; as caused by active file bogosity.
- (cond
- ((bobp))
- ((search-backward (concat "\n" nnfolder-article-marker)
- nil t)
- (goto-char (match-end 0))
- (setq num (string-to-number
- (buffer-substring
- (point) (gnus-point-at-eol))))
- (goto-char start)
- (< num article)))
- ;; Check that we are before an article with a
- ;; higher number.
- (search-forward (concat "\n" nnfolder-article-marker)
- nil t)
- (progn
- (setq num (string-to-number
- (buffer-substring
- (point) (gnus-point-at-eol))))
- (> num article))
- ;; Discard any article numbers before the one we're
- ;; now looking at.
- (while (and articles
- (< (car articles) num))
- (setq articles (cdr articles))))
- (goto-char start))))
- (set-buffer nntp-server-buffer)
- (nnheader-fold-continuation-lines)
- 'headers))))))
-
-(deffoo nnfolder-open-server (server &optional defs)
- (nnoo-change-server 'nnfolder server defs)
- (nnmail-activate 'nnfolder t)
- (gnus-make-directory nnfolder-directory)
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (and nnfolder-nov-directory
- (gnus-make-directory nnfolder-nov-directory)))
- (unless nnfolder-marks-is-evil
- (and nnfolder-marks-directory
- (gnus-make-directory nnfolder-marks-directory)))
- (cond
- ((not (file-exists-p nnfolder-directory))
- (nnfolder-close-server)
- (nnheader-report 'nnfolder "Couldn't create directory: %s"
- nnfolder-directory))
- ((not (file-directory-p (file-truename nnfolder-directory)))
- (nnfolder-close-server)
- (nnheader-report 'nnfolder "Not a directory: %s" nnfolder-directory))
- (t
- (nnmail-activate 'nnfolder)
- (nnheader-report 'nnfolder "Opened server %s using directory %s"
- server nnfolder-directory)
- t)))
-
-(deffoo nnfolder-request-close ()
- (let ((alist nnfolder-buffer-alist))
- (while alist
- (nnfolder-close-group (caar alist) nil t)
- (setq alist (cdr alist))))
- (nnoo-close-server 'nnfolder)
- (setq nnfolder-buffer-alist nil
- nnfolder-group-alist nil))
-
-(deffoo nnfolder-request-article (article &optional group server buffer)
- (nnfolder-possibly-change-group group server)
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (when (nnfolder-goto-article article)
- (let (start stop)
- (setq start (point))
- (forward-line 1)
- (unless (and (nnmail-search-unix-mail-delim)
- (forward-line -1))
- (goto-char (point-max)))
- (setq stop (point))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nnfolder-current-buffer start stop)
- (goto-char (point-min))
- (while (looking-at "From ")
- (delete-char 5)
- (insert "X-From-Line: ")
- (forward-line 1))
- (if (numberp article)
- (cons nnfolder-current-group article)
- (goto-char (point-min))
- (cons nnfolder-current-group
- (if (search-forward (concat "\n" nnfolder-article-marker)
- nil t)
- (string-to-number (buffer-substring
- (point) (gnus-point-at-eol)))
- -1))))))))
-
-(deffoo nnfolder-request-group (group &optional server dont-check)
- (nnfolder-possibly-change-group group server t)
- (save-excursion
- (if (not (assoc group nnfolder-group-alist))
- (nnheader-report 'nnfolder "No such group: %s" group)
- (if dont-check
- (progn
- (nnheader-report 'nnfolder "Selected group %s" group)
- t)
- (let* ((active (assoc group nnfolder-group-alist))
- (group (car active))
- (range (cadr active)))
- (cond
- ((null active)
- (nnheader-report 'nnfolder "No such group: %s" group))
- ((null nnfolder-current-group)
- (nnheader-report 'nnfolder "Empty group: %s" group))
- (t
- (nnheader-report 'nnfolder "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (1+ (- (cdr range) (car range)))
- (car range) (cdr range) group))))))))
-
-(deffoo nnfolder-request-scan (&optional group server)
- (nnfolder-possibly-change-group nil server)
- (when nnfolder-get-new-mail
- (nnfolder-possibly-change-group group server)
- (nnmail-get-new-mail
- 'nnfolder
- (lambda ()
- (let ((bufs nnfolder-buffer-alist))
- (save-excursion
- (while bufs
- (if (not (gnus-buffer-live-p (nth 1 (car bufs))))
- (setq nnfolder-buffer-alist
- (delq (car bufs) nnfolder-buffer-alist))
- (set-buffer (nth 1 (car bufs)))
- (nnfolder-save-buffer)
- (kill-buffer (current-buffer)))
- (setq bufs (cdr bufs))))))
- nnfolder-directory
- group)))
-
-;; Don't close the buffer if we're not shutting down the server. This way,
-;; we can keep the buffer in the group buffer cache, and not have to grovel
-;; over the buffer again unless we add new mail to it or modify it in some
-;; way.
-
-(deffoo nnfolder-close-group (group &optional server force)
- ;; Make sure we _had_ the group open.
- (when (or (assoc group nnfolder-buffer-alist)
- (equal group nnfolder-current-group))
- (let ((inf (assoc group nnfolder-buffer-alist)))
- (when inf
- (when (and nnfolder-current-group
- nnfolder-current-buffer)
- (push (list nnfolder-current-group nnfolder-current-buffer)
- nnfolder-buffer-alist))
- (setq nnfolder-buffer-alist
- (delq inf nnfolder-buffer-alist))
- (setq nnfolder-current-buffer (cadr inf)
- nnfolder-current-group (car inf))))
- (when (and nnfolder-current-buffer
- (buffer-name nnfolder-current-buffer))
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- ;; If the buffer was modified, write the file out now.
- (nnfolder-save-buffer)
- ;; If we're shutting the server down, we need to kill the
- ;; buffer and remove it from the open buffer list. Or, of
- ;; course, if we're trying to minimize our space impact.
- (kill-buffer (current-buffer))
- (setq nnfolder-buffer-alist (delq (assoc group nnfolder-buffer-alist)
- nnfolder-buffer-alist)))))
- (setq nnfolder-current-group nil
- nnfolder-current-buffer nil)
- t)
-
-(deffoo nnfolder-request-create-group (group &optional server args)
- (nnfolder-possibly-change-group nil server)
- (nnmail-activate 'nnfolder)
- (when (and group
- (not (assoc group nnfolder-group-alist)))
- (push (list group (cons 1 0)) nnfolder-group-alist)
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (save-current-buffer
- (nnfolder-read-folder group)))
- t)
-
-(deffoo nnfolder-request-list (&optional server)
- (nnfolder-possibly-change-group nil server)
- (save-excursion
- (let ((nnmail-file-coding-system nnfolder-active-file-coding-system))
- (nnmail-find-file nnfolder-active-file)
- (setq nnfolder-group-alist (nnmail-get-active)))
- t))
-
-(deffoo nnfolder-request-newgroups (date &optional server)
- (nnfolder-possibly-change-group nil server)
- (nnfolder-request-list server))
-
-(deffoo nnfolder-request-list-newsgroups (&optional server)
- (nnfolder-possibly-change-group nil server)
- (save-excursion
- (let ((nnmail-file-coding-system nnfolder-file-coding-system))
- (nnmail-find-file nnfolder-newsgroups-file))))
-
-;; Return a list consisting of all article numbers existing in the
-;; current folder.
-
-(defun nnfolder-existing-articles ()
- (save-excursion
- (when nnfolder-current-buffer
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (let ((marker (concat "\n" nnfolder-article-marker))
- (number "[0-9]+")
- numbers)
- (while (and (search-forward marker nil t)
- (re-search-forward number nil t))
- (let ((newnum (string-to-number (match-string 0))))
- (if (nnmail-within-headers-p)
- (push newnum numbers))))
- ;; The article numbers are increasing, so this result is sorted.
- (nreverse numbers)))))
-
-(deffoo nnfolder-request-expire-articles
- (articles newsgroup &optional server force)
- (nnfolder-possibly-change-group newsgroup server)
- (let* ((is-old t)
- ;; The articles we have deleted so far.
- (deleted-articles nil)
- ;; The articles that really exist and will
- ;; be expired if they are old enough.
- (maybe-expirable
- (gnus-sorted-intersection articles (nnfolder-existing-articles))))
- (nnmail-activate 'nnfolder)
-
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- ;; Since messages are sorted in arrival order and expired in the
- ;; same order, we can stop as soon as we find a message that is
- ;; too old.
- (while (and maybe-expirable is-old)
- (goto-char (point-min))
- (when (and (nnfolder-goto-article (car maybe-expirable))
- (search-forward (concat "\n" nnfolder-article-marker)
- nil t))
- (forward-sexp)
- (when (setq is-old
- (nnmail-expired-article-p
- newsgroup
- (buffer-substring
- (point) (progn (end-of-line) (point)))
- force nnfolder-inhibit-expiry))
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnfolder-request-article (car maybe-expirable)
- newsgroup server (current-buffer))
- (let ((nnfolder-current-directory nil))
- (nnmail-expiry-target-group
- nnmail-expiry-target newsgroup)))
- (nnfolder-possibly-change-group newsgroup server))
- (nnheader-message 5 "Deleting article %d in %s..."
- (car maybe-expirable) newsgroup)
- (nnfolder-delete-mail)
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-nov-delete-article newsgroup (car maybe-expirable)))
- ;; Must remember which articles were actually deleted
- (push (car maybe-expirable) deleted-articles)))
- (setq maybe-expirable (cdr maybe-expirable)))
- (unless nnfolder-inhibit-expiry
- (nnheader-message 5 "Deleting articles...done"))
- (nnfolder-save-buffer)
- (nnfolder-adjust-min-active newsgroup)
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (gnus-sorted-difference articles (nreverse deleted-articles)))))
-
-(deffoo nnfolder-request-move-article (article group server
- accept-form &optional last)
- (save-excursion
- (let ((buf (get-buffer-create " *nnfolder move*"))
- result)
- (and
- (nnfolder-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (insert-buffer-substring nntp-server-buffer)
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^" nnfolder-article-marker)
- (save-excursion (and (search-forward "\n\n" nil t) (point)))
- t)
- (gnus-delete-line))
- (setq result (eval accept-form))
- (kill-buffer buf)
- result)
- (save-excursion
- (nnfolder-possibly-change-group group server)
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (when (nnfolder-goto-article article)
- (nnfolder-delete-mail))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-nov-delete-article group article))
- (when last
- (nnfolder-save-buffer)
- (nnfolder-adjust-min-active group)
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))))
- result)))
-
-(deffoo nnfolder-request-accept-article (group &optional server last)
- (save-excursion
- (nnfolder-possibly-change-group group server)
- (nnmail-check-syntax)
- (let ((buf (current-buffer))
- result art-group)
- (goto-char (point-min))
- (when (looking-at "X-From-Line: ")
- (replace-match "From ")
- (while (progn (forward-line) (looking-at "[ \t]"))
- (delete-char -1)))
- (with-temp-buffer
- (let ((nnmail-file-coding-system nnfolder-active-file-coding-system)
- (nntp-server-buffer (current-buffer)))
- (nnmail-find-file nnfolder-active-file)
- (setq nnfolder-group-alist (nnmail-parse-active))))
- (save-excursion
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (goto-char (point-max)))
- (while (re-search-backward (concat "^" nnfolder-article-marker) nil t)
- (delete-region (point) (progn (forward-line 1) (point))))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
- (setq result (if (stringp group)
- (list (cons group (nnfolder-active-number group)))
- (setq art-group
- (nnmail-article-group 'nnfolder-active-number))))
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result
- (car (nnfolder-save-mail result)))))
- (when last
- (save-excursion
- (nnfolder-possibly-change-folder (or (caar art-group) group))
- (nnfolder-save-buffer)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close))))
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- (unless result
- (nnheader-report 'nnfolder "Couldn't store article"))
- result)))
-
-(deffoo nnfolder-request-replace-article (article group buffer)
- (nnfolder-possibly-change-group group)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (if (not (looking-at "X-From-Line: "))
- (insert "From nobody " (current-time-string) "\n")
- (replace-match "From ")
- (forward-line 1)
- (while (looking-at "[ \t]")
- (delete-char -1)
- (forward-line 1)))
- (nnfolder-normalize-buffer)
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (if (not (nnfolder-goto-article article))
- nil
- (nnfolder-delete-mail)
- (insert-buffer-substring buffer)
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (save-excursion
- (set-buffer buffer)
- (let ((headers (nnfolder-parse-head article
- (point-min) (point-max))))
- (with-current-buffer (nnfolder-open-nov group)
- (if (nnheader-find-nov-line article)
- (delete-region (point) (progn (forward-line 1) (point))))
- (nnheader-insert-nov headers)))))
- (nnfolder-save-buffer)
- t)))
-
-(deffoo nnfolder-request-delete-group (group &optional force server)
- (nnfolder-close-group group server t)
- ;; Delete all articles in GROUP.
- (if (not force)
- () ; Don't delete the articles.
- ;; Delete the file that holds the group.
- (let ((data (nnfolder-group-pathname group))
- (nov (nnfolder-group-nov-pathname group))
- (mrk (nnfolder-group-marks-pathname group)))
- (ignore-errors (delete-file data))
- (ignore-errors (delete-file nov))
- (ignore-errors (delete-file mrk))))
- ;; Remove the group from all structures.
- (setq nnfolder-group-alist
- (delq (assoc group nnfolder-group-alist) nnfolder-group-alist)
- nnfolder-current-group nil
- nnfolder-current-buffer nil)
- ;; Save the active file.
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- t)
-
-(deffoo nnfolder-request-rename-group (group new-name &optional server)
- (nnfolder-possibly-change-group group server)
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- (and (file-writable-p buffer-file-name)
- (ignore-errors
- (let ((new-file (nnfolder-group-pathname new-name)))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file buffer-file-name new-file)
- (when (file-exists-p (nnfolder-group-nov-pathname group))
- (setq new-file (nnfolder-group-nov-pathname new-name))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-nov-pathname group) new-file))
- (when (file-exists-p (nnfolder-group-marks-pathname group))
- (setq new-file (nnfolder-group-marks-pathname new-name))
- (gnus-make-directory (file-name-directory new-file))
- (rename-file (nnfolder-group-marks-pathname group) new-file)))
- t)
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnfolder-group-alist)))
- (and entry (setcar entry new-name))
- (setq nnfolder-current-buffer nil
- nnfolder-current-group nil)
- ;; Save the new group alist.
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
- ;; We kill the buffer instead of renaming it and stuff.
- (kill-buffer (current-buffer))
- t))))
-
-(deffoo nnfolder-request-regenerate (server)
- (nnfolder-possibly-change-group nil server)
- (nnfolder-generate-active-file)
- t)
-
-\f
-;;; Internal functions.
-
-(defun nnfolder-adjust-min-active (group)
- ;; Find the lowest active article in this group.
- (let* ((active (cadr (assoc group nnfolder-group-alist)))
- (marker (concat "\n" nnfolder-article-marker))
- (number "[0-9]+")
- (activemin (cdr active)))
- (save-excursion
- (set-buffer nnfolder-current-buffer)
- (goto-char (point-min))
- (while (and (search-forward marker nil t)
- (re-search-forward number nil t))
- (let ((newnum (string-to-number (match-string 0))))
- (if (nnmail-within-headers-p)
- (setq activemin (min activemin newnum)))))
- (setcar active activemin))))
-
-(defun nnfolder-article-string (article)
- (if (numberp article)
- (concat "\n" nnfolder-article-marker (int-to-string article) " ")
- (concat "\nMessage-ID: " article)))
-
-(defun nnfolder-goto-article (article)
- "Place point at the start of the headers of ARTICLE.
-ARTICLE can be an article number or a Message-ID.
-Returns t if successful, nil otherwise."
- (let ((art-string (nnfolder-article-string article))
- start found)
- ;; It is likely that we are at or before the delimiter line.
- ;; We therefore go to the end of the previous line, and start
- ;; searching from there.
- (beginning-of-line)
- (unless (bobp)
- (forward-char -1))
- (setq start (point))
- ;; First search forward.
- (while (and (setq found (search-forward art-string nil t))
- (not (nnmail-within-headers-p))))
- ;; If unsuccessful, search backward from where we started,
- (unless found
- (goto-char start)
- (while (and (setq found (search-backward art-string nil t))
- (not (nnmail-within-headers-p)))))
- (when found
- (nnmail-search-unix-mail-delim-backward))))
-
-(defun nnfolder-delete-mail (&optional leave-delim)
- "Delete the message that point is in.
-If optional argument LEAVE-DELIM is t, then mailbox delimiter is not
-deleted. Point is left where the deleted region was."
- (save-restriction
- (narrow-to-region
- (save-excursion
- ;; In case point is at the beginning of the message already.
- (forward-line 1)
- (nnmail-search-unix-mail-delim-backward)
- (if leave-delim (progn (forward-line 1) (point))
- (point)))
- (progn
- (forward-line 1)
- (if (nnmail-search-unix-mail-delim)
- (point)
- (point-max))))
- (run-hooks 'nnfolder-delete-mail-hook)
- (delete-region (point-min) (point-max))))
-
-(defun nnfolder-possibly-change-group (group &optional server dont-check)
- ;; Change servers.
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (unless (gnus-buffer-live-p nnfolder-current-buffer)
- (setq nnfolder-current-buffer nil
- nnfolder-current-group nil))
- ;; Change group.
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (when (and group
- (not (equal group nnfolder-current-group))
- (progn
- (nnmail-activate 'nnfolder)
- (and (assoc group nnfolder-group-alist)
- (file-exists-p (nnfolder-group-pathname group)))))
- (if dont-check
- (setq nnfolder-current-group group
- nnfolder-current-buffer nil)
- (let (inf file)
- ;; If we have to change groups, see if we don't already have
- ;; the folder in memory. If we do, verify the modtime and
- ;; destroy the folder if needed so we can rescan it.
- (setq nnfolder-current-buffer
- (nth 1 (assoc group nnfolder-buffer-alist)))
-
- ;; If the buffer is not live, make sure it isn't in the
- ;; alist. If it is live, verify that nobody else has
- ;; touched the file since last time.
- (when (and nnfolder-current-buffer
- (not (gnus-buffer-live-p nnfolder-current-buffer)))
- (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)
- nnfolder-current-buffer nil))
-
- (setq nnfolder-current-group group)
-
- (when (or (not nnfolder-current-buffer)
- (not (verify-visited-file-modtime
- nnfolder-current-buffer)))
- (save-excursion
- (setq file (nnfolder-group-pathname group))
- ;; See whether we need to create the new file.
- (unless (file-exists-p file)
- (gnus-make-directory (file-name-directory file))
- (let ((nnmail-file-coding-system
- (or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system-for-write)))
- (nnmail-write-region (point-min) (point-min)
- file t 'nomesg)))
- (when (setq nnfolder-current-buffer (nnfolder-read-folder group))
- (set-buffer nnfolder-current-buffer)
- (push (list group nnfolder-current-buffer)
- nnfolder-buffer-alist)))))))))
-
-(defun nnfolder-save-mail (group-art-list)
- "Called narrowed to an article."
- (let* (save-list group-art)
- (goto-char (point-min))
- ;; The From line may have been quoted by movemail.
- (when (looking-at ">From")
- (delete-char 1))
- ;; This might come from somewhere else.
- (unless (looking-at "From ")
- (insert "From nobody " (current-time-string) "\n")
- (goto-char (point-min)))
- ;; Quote all "From " lines in the article.
- (forward-line 1)
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert "> ")))
- (setq save-list group-art-list)
- (nnmail-insert-lines)
- (nnmail-insert-xref group-art-list)
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnfolder-prepare-save-mail-hook)
-
- ;; Insert the mail into each of the destination groups.
- (while (setq group-art (pop group-art-list))
- ;; Kill any previous newsgroup markers.
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (goto-char (point-max)))
- (while (search-backward (concat "\n" nnfolder-article-marker) nil t)
- (delete-region (1+ (point)) (progn (forward-line 2) (point))))
-
- ;; Insert the new newsgroup marker.
- (nnfolder-insert-newsgroup-line group-art)
-
- (save-excursion
- (let ((beg (point-min))
- (end (point-max))
- (obuf (current-buffer)))
- (nnfolder-possibly-change-folder (car group-art))
- (let ((buffer-read-only nil))
- (nnfolder-normalize-buffer)
- (insert-buffer-substring obuf beg end))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (set-buffer obuf)
- (nnfolder-add-nov (car group-art) (cdr group-art)
- (nnfolder-parse-head nil beg end))))))
-
- ;; Did we save it anywhere?
- save-list))
-
-(defun nnfolder-normalize-buffer ()
- "Make sure there are two newlines at the end of the buffer."
- (goto-char (point-max))
- (skip-chars-backward "\n")
- (delete-region (point) (point-max))
- (unless (bobp)
- (insert "\n\n")))
-
-(defun nnfolder-insert-newsgroup-line (group-art)
- (save-excursion
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max))
- (insert "\n"))
- (forward-char -1)
- (insert (format (concat nnfolder-article-marker "%d %s\n")
- (cdr group-art) (message-make-date)))))
-
-(defun nnfolder-active-number (group)
- ;; Find the next article number in GROUP.
- (let ((active (cadr (assoc group nnfolder-group-alist))))
- (if active
- (setcdr active (1+ (cdr active)))
- ;; This group is new, so we create a new entry for it.
- ;; This might be a bit naughty... creating groups on the drop of
- ;; a hat, but I don't know...
- (push (list group (setq active (cons 1 1)))
- nnfolder-group-alist))
- (cdr active)))
-
-(defun nnfolder-possibly-change-folder (group)
- (let ((inf (assoc group nnfolder-buffer-alist)))
- (if (and inf
- (gnus-buffer-live-p (cadr inf)))
- (set-buffer (cadr inf))
- (when inf
- (setq nnfolder-buffer-alist (delq inf nnfolder-buffer-alist)))
- (when nnfolder-group-alist
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file))
- (push (list group (nnfolder-read-folder group))
- nnfolder-buffer-alist))))
-
-;; This method has a problem if you've accidentally let the active
-;; list get out of sync with the files. This could happen, say, if
-;; you've accidentally gotten new mail with something other than Gnus
-;; (but why would _that_ ever happen? :-). In that case, we will be
-;; in the middle of processing the file, ready to add new X-Gnus
-;; article number markers, and we'll run across a message with no ID
-;; yet - the active list _may_not_ be ready for us yet.
-
-;; To handle this, I'm modifying this routine to maintain the maximum
-;; ID seen so far, and when we hit a message with no ID, we will
-;; _manually_ scan the rest of the message looking for any more,
-;; possibly higher IDs. We'll assume the maximum that we find is the
-;; highest active. Note that this shouldn't cost us much extra time
-;; at all, but will be a lot less vulnerable to glitches between the
-;; mbox and the active file.
-
-(defun nnfolder-read-folder (group)
- (let* ((file (nnfolder-group-pathname group))
- (nov (nnfolder-group-nov-pathname group))
- (buffer (set-buffer
- (let ((nnheader-file-coding-system
- nnfolder-file-coding-system))
- (nnheader-find-file-noselect file t)))))
- (mm-enable-multibyte) ;; Use multibyte buffer for future copying.
- (buffer-disable-undo)
- (if (equal (cadr (assoc group nnfolder-scantime-alist))
- (nth 5 (file-attributes file)))
- ;; This looks up-to-date, so we don't do any scanning.
- (if (file-exists-p file)
- buffer
- (push (list group buffer) nnfolder-buffer-alist)
- (set-buffer-modified-p t)
- (nnfolder-save-buffer))
- ;; Parse the damn thing.
- (save-excursion
- (goto-char (point-min))
- ;; Remove any blank lines at the start.
- (while (eq (following-char) ?\n)
- (delete-char 1))
- (nnmail-activate 'nnfolder)
- ;; Read in the file.
- (let ((delim "^From ")
- (marker (concat "\n" nnfolder-article-marker))
- (number "[0-9]+")
- (active (or (cadr (assoc group nnfolder-group-alist))
- (cons 1 0)))
- (scantime (assoc group nnfolder-scantime-alist))
- (minid (lsh -1 -1))
- maxid start end newscantime
- novbuf articles newnum
- buffer-read-only)
- (setq maxid (cdr active))
-
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil
- (and (file-exists-p nov)
- (file-newer-than-file-p nov file)))
- (unless (file-exists-p nov)
- (gnus-make-directory (file-name-directory nov)))
- (with-current-buffer
- (setq novbuf (nnfolder-open-nov group))
- (goto-char (point-min))
- (while (not (eobp))
- (push (read novbuf) articles)
- (forward-line 1))
- (setq articles (nreverse articles))))
- (goto-char (point-min))
-
- ;; Anytime the active number is 1 or 0, it is suspect. In
- ;; that case, search the file manually to find the active
- ;; number. Or, of course, if we're being paranoid. (This
- ;; would also be the place to build other lists from the
- ;; header markers, such as expunge lists, etc., if we ever
- ;; desired to abandon the active file entirely for mboxes.)
- (when (or nnfolder-ignore-active-file
- novbuf
- (< maxid 2))
- (while (and (search-forward marker nil t)
- (looking-at number))
- (setq newnum (string-to-number (match-string 0)))
- (when (nnmail-within-headers-p)
- (setq maxid (max maxid newnum)
- minid (min minid newnum))
- (when novbuf
- (if (memq newnum articles)
- (setq articles (delq newnum articles))
- (let ((headers (nnfolder-parse-head newnum)))
- (with-current-buffer novbuf
- (nnheader-find-nov-line newnum)
- (nnheader-insert-nov headers)))))))
- (when (and novbuf articles)
- (with-current-buffer novbuf
- (dolist (article articles)
- (when (nnheader-find-nov-line article)
- (delete-region (point)
- (progn (forward-line 1) (point)))))))
- (setcar active (max 1 (min minid maxid)))
- (setcdr active (max maxid (cdr active)))
- (goto-char (point-min)))
-
- ;; As long as we trust that the user will only insert
- ;; unmarked mail at the end, go to the end and search
- ;; backwards for the last marker. Find the start of that
- ;; message, and begin to search for unmarked messages from
- ;; there.
- (when (not (or nnfolder-distrust-mbox
- (< maxid 2)))
- (goto-char (point-max))
- (unless (re-search-backward marker nil t)
- (goto-char (point-min)))
- ;;(when (nnmail-search-unix-mail-delim)
- ;; (goto-char (point-min)))
- )
-
- ;; Keep track of the active number on our own, and insert it
- ;; back into the active list when we're done. Also, prime
- ;; the pump to cut down on the number of searches we do.
- (unless (nnmail-search-unix-mail-delim)
- (goto-char (point-max)))
- (setq end (point-marker))
- (while (not (= end (point-max)))
- (setq start (marker-position end))
- (goto-char end)
- ;; There may be more than one "From " line, so we skip past
- ;; them.
- (while (looking-at delim)
- (forward-line 1))
- (set-marker end (if (nnmail-search-unix-mail-delim)
- (point)
- (point-max)))
- (goto-char start)
- (when (not (search-forward marker end t))
- (narrow-to-region start end)
- (nnmail-insert-lines)
- (nnfolder-insert-newsgroup-line
- (cons nil
- (setq newnum
- (nnfolder-active-number group))))
- (when novbuf
- (let ((headers (nnfolder-parse-head newnum (point-min)
- (point-max))))
- (with-current-buffer novbuf
- (goto-char (point-max))
- (nnheader-insert-nov headers))))
- (widen)))
-
- (set-marker end nil)
- ;; Make absolutely sure that the active list reflects
- ;; reality!
- (nnfolder-save-active nnfolder-group-alist nnfolder-active-file)
-
- ;; Set the scantime for this group.
- (setq newscantime (visited-file-modtime))
- (if scantime
- (setcdr scantime (list newscantime))
- (push (list group newscantime)
- nnfolder-scantime-alist))
- ;; Save nov.
- (when novbuf
- (nnfolder-save-nov))
- (current-buffer))))))
-
-;;;###autoload
-(defun nnfolder-generate-active-file ()
- "Look for mbox folders in the nnfolder directory and make them into groups.
-This command does not work if you use short group names."
- (interactive)
- (nnmail-activate 'nnfolder)
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (dolist (file (directory-files (or nnfolder-nov-directory
- nnfolder-directory)
- t
- (concat
- (regexp-quote nnfolder-nov-file-suffix)
- "$")))
- (when (not (message-mail-file-mbox-p file))
- (ignore-errors
- (delete-file file)))))
- (let ((files (directory-files nnfolder-directory))
- file)
- (while (setq file (pop files))
- (when (and (not (backup-file-name-p file))
- (message-mail-file-mbox-p
- (nnheader-concat nnfolder-directory file)))
- (let ((oldgroup (assoc file nnfolder-group-alist)))
- (if oldgroup
- (nnheader-message 5 "Refreshing group %s..." file)
- (nnheader-message 5 "Adding group %s..." file))
- (if oldgroup
- (setq nnfolder-group-alist
- (delq oldgroup (copy-sequence nnfolder-group-alist))))
- (push (list file (cons 1 0)) nnfolder-group-alist)
- (nnfolder-possibly-change-folder file)
- (nnfolder-possibly-change-group file)
- (nnfolder-close-group file))))
- (nnheader-message 5 "")))
-
-(defun nnfolder-group-pathname (group)
- "Make file name for GROUP."
- (setq group
- (mm-encode-coding-string group nnmail-pathname-coding-system))
- (let ((dir (file-name-as-directory (expand-file-name nnfolder-directory))))
- ;; If this file exists, we use it directly.
- (if (or nnmail-use-long-file-names
- (file-exists-p (concat dir group)))
- (concat dir group)
- ;; If not, we translate dots into slashes.
- (concat dir (nnheader-replace-chars-in-string group ?. ?/)))))
-
-(defun nnfolder-group-nov-pathname (group)
- "Make pathname for GROUP NOV."
- (let ((nnfolder-directory
- (or nnfolder-nov-directory nnfolder-directory)))
- (concat (nnfolder-group-pathname group) nnfolder-nov-file-suffix)))
-
-(defun nnfolder-save-buffer ()
- "Save the buffer."
- (when (buffer-modified-p)
- (run-hooks 'nnfolder-save-buffer-hook)
- (gnus-make-directory (file-name-directory (buffer-file-name)))
- (let ((coding-system-for-write
- (or nnfolder-file-coding-system-for-write
- nnfolder-file-coding-system)))
- (save-buffer)))
- (unless (or gnus-nov-is-evil nnfolder-nov-is-evil)
- (nnfolder-save-nov)))
-
-(defun nnfolder-save-active (group-alist active-file)
- (let ((nnmail-active-file-coding-system
- (or nnfolder-active-file-coding-system-for-write
- nnfolder-active-file-coding-system)))
- (nnmail-save-active group-alist active-file)))
-
-(defun nnfolder-open-nov (group)
- (or (cdr (assoc group nnfolder-nov-buffer-alist))
- (let ((buffer (get-buffer-create (format " *nnfolder overview %s*" group))))
- (save-excursion
- (set-buffer buffer)
- (set (make-local-variable 'nnfolder-nov-buffer-file-name)
- (nnfolder-group-nov-pathname group))
- (erase-buffer)
- (when (file-exists-p nnfolder-nov-buffer-file-name)
- (nnheader-insert-file-contents nnfolder-nov-buffer-file-name)))
- (push (cons group buffer) nnfolder-nov-buffer-alist)
- buffer)))
-
-(defun nnfolder-save-nov ()
- (save-excursion
- (while nnfolder-nov-buffer-alist
- (when (buffer-name (cdar nnfolder-nov-buffer-alist))
- (set-buffer (cdar nnfolder-nov-buffer-alist))
- (when (buffer-modified-p)
- (gnus-make-directory (file-name-directory
- nnfolder-nov-buffer-file-name))
- (nnmail-write-region 1 (point-max) nnfolder-nov-buffer-file-name
- nil 'nomesg))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
- (setq nnfolder-nov-buffer-alist (cdr nnfolder-nov-buffer-alist)))))
-
-(defun nnfolder-nov-delete-article (group article)
- (save-excursion
- (set-buffer (nnfolder-open-nov group))
- (when (nnheader-find-nov-line article)
- (delete-region (point) (progn (forward-line 1) (point))))
- t))
-
-(defun nnfolder-retrieve-headers-with-nov (articles &optional fetch-old)
- (if (or gnus-nov-is-evil nnfolder-nov-is-evil)
- nil
- (let ((nov (nnfolder-group-nov-pathname nnfolder-current-group)))
- (when (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (nnheader-insert-file-contents nov)
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- t))))))
-
-(defun nnfolder-parse-head (&optional number b e)
- "Parse the head of the current buffer."
- (let ((buf (current-buffer))
- chars)
- (save-excursion
- (unless b
- (setq b (if (nnmail-search-unix-mail-delim-backward)
- (point) (point-min)))
- (forward-line 1)
- (setq e (if (nnmail-search-unix-mail-delim)
- (point) (point-max))))
- (setq chars (- e b))
- (unless (zerop chars)
- (goto-char b)
- (if (search-forward "\n\n" e t) (setq e (1- (point)))))
- (with-temp-buffer
- (insert-buffer-substring buf b e)
- (let ((headers (nnheader-parse-naked-head)))
- (mail-header-set-chars headers chars)
- (mail-header-set-number headers number)
- headers)))))
-
-(defun nnfolder-add-nov (group article headers)
- "Add a nov line for the GROUP base."
- (save-excursion
- (set-buffer (nnfolder-open-nov group))
- (goto-char (point-max))
- (mail-header-set-number headers article)
- (nnheader-insert-nov headers)))
-
-(deffoo nnfolder-request-set-mark (group actions &optional server)
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (unless nnfolder-marks-is-evil
- (nnfolder-open-marks group server)
- (dolist (action actions)
- (let ((range (nth 0 action))
- (what (nth 1 action))
- (marks (nth 2 action)))
- (assert (or (eq what 'add) (eq what 'del)) nil
- "Unknown request-set-mark action: %s" what)
- (dolist (mark marks)
- (setq nnfolder-marks (gnus-update-alist-soft
- mark
- (funcall (if (eq what 'add) 'gnus-range-add
- 'gnus-remove-from-range)
- (cdr (assoc mark nnfolder-marks)) range)
- nnfolder-marks)))))
- (nnfolder-save-marks group server))
- nil)
-
-(deffoo nnfolder-request-update-info (group info &optional server)
- ;; Change servers.
- (when (and server
- (not (nnfolder-server-opened server)))
- (nnfolder-open-server server))
- (when (and (not nnfolder-marks-is-evil) (nnfolder-marks-changed-p group))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnfolder-open-marks group server)
- ;; Update info using `nnfolder-marks'.
- (mapcar (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnfolder-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnfolder-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnfolder-group-marks-pathname (group)
- "Make pathname for GROUP NOV."
- (let ((nnfolder-directory (or nnfolder-marks-directory nnfolder-directory)))
- (concat (nnfolder-group-pathname group) nnfolder-marks-file-suffix)))
-
-(defun nnfolder-marks-changed-p (group)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (null (gnus-gethash file nnfolder-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnfolder-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnfolder-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (nnfolder-group-marks-pathname group)))
- (condition-case err
- (progn
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnfolder-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnfolder-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnfolder-open-marks (group server)
- (let ((file (nnfolder-group-marks-pathname group)))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnfolder-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnfolder-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnfolder marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnfolder marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nnfolder:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
- (setq nnfolder-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnfolder-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnfolder-marks (gnus-remassoc el nnfolder-marks)))
- (nnfolder-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
-(provide 'nnfolder)
-
-;;; arch-tag: a040d0f4-4f4e-445f-8972-839575c5f7e6
-;;; nnfolder.el ends here
+++ /dev/null
-;;; nngateway.el --- posting news via mail gateways
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'nnoo)
-(require 'message)
-
-(nnoo-declare nngateway)
-
-(defvoo nngateway-address nil
- "Address of the mail-to-news gateway.")
-
-(defvoo nngateway-header-transformation 'nngateway-simple-header-transformation
- "Function to be called to rewrite the news headers into mail headers.
-It is called narrowed to the headers to be transformed with one
-parameter -- the gateway address.")
-
-;;; Interface functions
-
-(nnoo-define-basics nngateway)
-
-(deffoo nngateway-open-server (server &optional defs)
- (if (nngateway-server-opened server)
- t
- (unless (assq 'nngateway-address defs)
- (setq defs (append defs (list (list 'nngateway-address server)))))
- (nnoo-change-server 'nngateway server defs)))
-
-(deffoo nngateway-request-post (&optional server)
- (when (or (nngateway-server-opened server)
- (nngateway-open-server server))
- ;; Rewrite the header.
- (let ((buf (current-buffer)))
- (with-temp-buffer
- (insert-buffer-substring buf)
- (message-narrow-to-head)
- (funcall nngateway-header-transformation nngateway-address)
- (goto-char (point-max))
- (insert mail-header-separator "\n")
- (widen)
- (let (message-required-mail-headers)
- (funcall (or message-send-mail-real-function
- message-send-mail-function)))
- t))))
-
-;;; Internal functions
-
-(defun nngateway-simple-header-transformation (gateway)
- "Transform the headers to use GATEWAY."
- (let ((newsgroups (mail-fetch-field "newsgroups")))
- (message-remove-header "to")
- (message-remove-header "cc")
- (goto-char (point-min))
- (insert "To: " (nnheader-replace-chars-in-string newsgroups ?. ?-)
- "@" gateway "\n")))
-
-(defun nngateway-mail2news-header-transformation (gateway)
- "Transform the headers for sending to a mail2news gateway."
- (message-remove-header "to")
- (message-remove-header "cc")
- (goto-char (point-min))
- (insert "To: " gateway "\n"))
-
-(nnoo-define-skeleton nngateway)
-
-(provide 'nngateway)
-
-;;; arch-tag: f7ecb92e-b10c-43d5-9a9b-1314233341fc
-;;; nngateway.el ends here
+++ /dev/null
-;;; nnheader.el --- header access macros for Gnus and its backends
-
-;; Copyright (C) 1987, 1988, 1989, 1990, 1993, 1994,
-;; 1995, 1996, 1997, 1998, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defvar nnmail-extra-headers)
-
-;; Requiring `gnus-util' at compile time creates a circular
-;; dependency between nnheader.el and gnus-util.el.
-;;(eval-when-compile (require 'gnus-util))
-
-(require 'mail-utils)
-(require 'mm-util)
-(require 'gnus-util)
-(eval-and-compile
- (autoload 'gnus-sorted-intersection "gnus-range")
- (autoload 'gnus-intersection "gnus-range")
- (autoload 'gnus-sorted-complement "gnus-range")
- (autoload 'gnus-sorted-difference "gnus-range"))
-
-(defcustom gnus-verbose-backends 7
- "Integer that says how verbose the Gnus backends should be.
-The higher the number, the more messages the Gnus backends will flash
-to say what it's doing. At zero, the Gnus backends will be totally
-mute; at five, they will display most important messages; and at ten,
-they will keep on jabbering all the time."
- :group 'gnus-start
- :type 'integer)
-
-(defcustom gnus-nov-is-evil nil
- "If non-nil, Gnus backends will never output headers in the NOV format."
- :group 'gnus-server
- :type 'boolean)
-
-(defvar nnheader-max-head-length 8192
- "*Max length of the head of articles.
-
-Value is an integer, nil, or t. nil means read in chunks of a file
-indefinitely until a complete head is found\; t means always read the
-entire file immediately, disregarding `nnheader-head-chop-length'.
-
-Integer values will in effect be rounded up to the nearest multiple of
-`nnheader-head-chop-length'.")
-
-(defvar nnheader-head-chop-length 2048
- "*Length of each read operation when trying to fetch HEAD headers.")
-
-(defvar nnheader-read-timeout
- (if (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
- (symbol-name system-type))
- ;; http://thread.gmane.org/v9655t3pjo.fsf@marauder.physik.uni-ulm.de
- ;;
- ;; IIRC, values lower than 1.0 didn't/don't work on Windows/DOS.
- ;;
- ;; There should probably be a runtime test to determine the timing
- ;; resolution, or a primitive to report it. I don't know off-hand
- ;; what's possible. Perhaps better, maybe the Windows/DOS primitive
- ;; could round up non-zero timeouts to a minimum of 1.0?
- 1.0
- 0.1)
- "How long nntp should wait between checking for the end of output.
-Shorter values mean quicker response, but are more CPU intensive.")
-
-(defvar nnheader-file-name-translation-alist
- (let ((case-fold-search t))
- (cond
- ((string-match "windows-nt\\|os/2\\|emx\\|cygwin"
- (symbol-name system-type))
- (append (mapcar (lambda (c) (cons c ?_))
- '(?: ?* ?\" ?< ?> ??))
- (if (string-match "windows-nt\\|cygwin"
- (symbol-name system-type))
- nil
- '((?+ . ?-)))))
- (t nil)))
- "*Alist that says how to translate characters in file names.
-For instance, if \":\" is invalid as a file character in file names
-on your system, you could say something like:
-
-\(setq nnheader-file-name-translation-alist '((?: . ?_)))")
-
-(defvar nnheader-directory-separator-character
- (string-to-char (substring (file-name-as-directory ".") -1))
- "*A character used to a directory separator.")
-
-(eval-and-compile
- (autoload 'nnmail-message-id "nnmail")
- (autoload 'mail-position-on-field "sendmail")
- (autoload 'message-remove-header "message")
- (autoload 'gnus-point-at-eol "gnus-util")
- (autoload 'gnus-buffer-live-p "gnus-util"))
-
-;;; Header access macros.
-
-;; These macros may look very much like the ones in GNUS 4.1. They
-;; are, in a way, but you should note that the indices they use have
-;; been changed from the internal GNUS format to the NOV format. The
-;; makes it possible to read headers from XOVER much faster.
-;;
-;; The format of a header is now:
-;; [number subject from date id references chars lines xref extra]
-;;
-;; (That next-to-last entry is defined as "misc" in the NOV format,
-;; but Gnus uses it for xrefs.)
-
-(defmacro mail-header-number (header)
- "Return article number in HEADER."
- `(aref ,header 0))
-
-(defmacro mail-header-set-number (header number)
- "Set article number of HEADER to NUMBER."
- `(aset ,header 0 ,number))
-
-(defmacro mail-header-subject (header)
- "Return subject string in HEADER."
- `(aref ,header 1))
-
-(defmacro mail-header-set-subject (header subject)
- "Set article subject of HEADER to SUBJECT."
- `(aset ,header 1 ,subject))
-
-(defmacro mail-header-from (header)
- "Return author string in HEADER."
- `(aref ,header 2))
-
-(defmacro mail-header-set-from (header from)
- "Set article author of HEADER to FROM."
- `(aset ,header 2 ,from))
-
-(defmacro mail-header-date (header)
- "Return date in HEADER."
- `(aref ,header 3))
-
-(defmacro mail-header-set-date (header date)
- "Set article date of HEADER to DATE."
- `(aset ,header 3 ,date))
-
-(defalias 'mail-header-message-id 'mail-header-id)
-(defmacro mail-header-id (header)
- "Return Id in HEADER."
- `(aref ,header 4))
-
-(defalias 'mail-header-set-message-id 'mail-header-set-id)
-(defmacro mail-header-set-id (header id)
- "Set article Id of HEADER to ID."
- `(aset ,header 4 ,id))
-
-(defmacro mail-header-references (header)
- "Return references in HEADER."
- `(aref ,header 5))
-
-(defmacro mail-header-set-references (header ref)
- "Set article references of HEADER to REF."
- `(aset ,header 5 ,ref))
-
-(defmacro mail-header-chars (header)
- "Return number of chars of article in HEADER."
- `(aref ,header 6))
-
-(defmacro mail-header-set-chars (header chars)
- "Set number of chars in article of HEADER to CHARS."
- `(aset ,header 6 ,chars))
-
-(defmacro mail-header-lines (header)
- "Return lines in HEADER."
- `(aref ,header 7))
-
-(defmacro mail-header-set-lines (header lines)
- "Set article lines of HEADER to LINES."
- `(aset ,header 7 ,lines))
-
-(defmacro mail-header-xref (header)
- "Return xref string in HEADER."
- `(aref ,header 8))
-
-(defmacro mail-header-set-xref (header xref)
- "Set article XREF of HEADER to xref."
- `(aset ,header 8 ,xref))
-
-(defmacro mail-header-extra (header)
- "Return the extra headers in HEADER."
- `(aref ,header 9))
-
-(defmacro mail-header-set-extra (header extra)
- "Set the extra headers in HEADER to EXTRA."
- `(aset ,header 9 ',extra))
-
-(defsubst make-mail-header (&optional init)
- "Create a new mail header structure initialized with INIT."
- (make-vector 10 init))
-
-(defsubst make-full-mail-header (&optional number subject from date id
- references chars lines xref
- extra)
- "Create a new mail header structure initialized with the parameters given."
- (vector number subject from date id references chars lines xref extra))
-
-;; fake message-ids: generation and detection
-
-(defvar nnheader-fake-message-id 1)
-
-(defsubst nnheader-generate-fake-message-id ()
- (concat "fake+none+" (int-to-string (incf nnheader-fake-message-id))))
-
-(defsubst nnheader-fake-message-id-p (id)
- (save-match-data ; regular message-id's are <.*>
- (string-match "\\`fake\\+none\\+[0-9]+\\'" id)))
-
-;; Parsing headers and NOV lines.
-
-(defsubst nnheader-remove-cr-followed-by-lf ()
- (goto-char (point-max))
- (while (search-backward "\r\n" nil t)
- (delete-char 1)))
-
-(defsubst nnheader-header-value ()
- (skip-chars-forward " \t")
- (buffer-substring (point) (gnus-point-at-eol)))
-
-(defun nnheader-parse-naked-head (&optional number)
- ;; This function unfolds continuation lines in this buffer
- ;; destructively. When this side effect is unwanted, use
- ;; `nnheader-parse-head' instead of this function.
- (let ((case-fold-search t)
- (buffer-read-only nil)
- (cur (current-buffer))
- (p (point-min))
- in-reply-to lines ref)
- (nnheader-remove-cr-followed-by-lf)
- (ietf-drums-unfold-fws)
- (subst-char-in-region (point-min) (point-max) ?\t ? )
- (goto-char p)
- (insert "\n")
- (prog1
- ;; This implementation of this function, with nine
- ;; search-forwards instead of the one re-search-forward and a
- ;; case (which basically was the old function) is actually
- ;; about twice as fast, even though it looks messier. You
- ;; can't have everything, I guess. Speed and elegance don't
- ;; always go hand in hand.
- (vector
- ;; Number.
- (or number 0)
- ;; Subject.
- (progn
- (goto-char p)
- (if (search-forward "\nsubject:" nil t)
- (nnheader-header-value) "(none)"))
- ;; From.
- (progn
- (goto-char p)
- (if (search-forward "\nfrom:" nil t)
- (nnheader-header-value) "(nobody)"))
- ;; Date.
- (progn
- (goto-char p)
- (if (search-forward "\ndate:" nil t)
- (nnheader-header-value) ""))
- ;; Message-ID.
- (progn
- (goto-char p)
- (if (search-forward "\nmessage-id:" nil t)
- (buffer-substring
- (1- (or (search-forward "<" (gnus-point-at-eol) t)
- (point)))
- (or (search-forward ">" (gnus-point-at-eol) t) (point)))
- ;; If there was no message-id, we just fake one to make
- ;; subsequent routines simpler.
- (nnheader-generate-fake-message-id)))
- ;; References.
- (progn
- (goto-char p)
- (if (search-forward "\nreferences:" nil t)
- (nnheader-header-value)
- ;; Get the references from the in-reply-to header if
- ;; there were no references and the in-reply-to header
- ;; looks promising.
- (if (and (search-forward "\nin-reply-to:" nil t)
- (setq in-reply-to (nnheader-header-value))
- (string-match "<[^\n>]+>" in-reply-to))
- (let (ref2)
- (setq ref (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (while (string-match "<[^\n>]+>"
- in-reply-to (match-end 0))
- (setq ref2 (substring in-reply-to (match-beginning 0)
- (match-end 0)))
- (when (> (length ref2) (length ref))
- (setq ref ref2)))
- ref)
- nil)))
- ;; Chars.
- 0
- ;; Lines.
- (progn
- (goto-char p)
- (if (search-forward "\nlines: " nil t)
- (if (numberp (setq lines (read cur)))
- lines 0)
- 0))
- ;; Xref.
- (progn
- (goto-char p)
- (and (search-forward "\nxref:" nil t)
- (nnheader-header-value)))
- ;; Extra.
- (when nnmail-extra-headers
- (let ((extra nnmail-extra-headers)
- out)
- (while extra
- (goto-char p)
- (when (search-forward
- (concat "\n" (symbol-name (car extra)) ":") nil t)
- (push (cons (car extra) (nnheader-header-value))
- out))
- (pop extra))
- out)))
- (goto-char p)
- (delete-char 1))))
-
-(defun nnheader-parse-head (&optional naked)
- (let ((cur (current-buffer)) num beg end)
- (when (if naked
- (setq num 0
- beg (point-min)
- end (point-max))
- (goto-char (point-min))
- ;; Search to the beginning of the next header. Error
- ;; messages do not begin with 2 or 3.
- (when (re-search-forward "^[23][0-9]+ " nil t)
- (end-of-line)
- (setq num (read cur)
- beg (point)
- end (if (search-forward "\n.\n" nil t)
- (- (point) 2)
- (point)))))
- (with-temp-buffer
- (insert-buffer-substring cur beg end)
- (nnheader-parse-naked-head num)))))
-
-(defmacro nnheader-nov-skip-field ()
- '(search-forward "\t" eol 'move))
-
-(defmacro nnheader-nov-field ()
- '(buffer-substring (point) (if (nnheader-nov-skip-field) (1- (point)) eol)))
-
-(defmacro nnheader-nov-read-integer ()
- '(prog1
- (if (eq (char-after) ?\t)
- 0
- (let ((num (condition-case nil
- (read (current-buffer))
- (error nil))))
- (if (numberp num) num 0)))
- (or (eobp) (forward-char 1))))
-
-(defmacro nnheader-nov-parse-extra ()
- '(let (out string)
- (while (not (memq (char-after) '(?\n nil)))
- (setq string (nnheader-nov-field))
- (when (string-match "^\\([^ :]+\\): " string)
- (push (cons (intern (match-string 1 string))
- (substring string (match-end 0)))
- out)))
- out))
-
-(defmacro nnheader-nov-read-message-id ()
- '(let ((id (nnheader-nov-field)))
- (if (string-match "^<[^>]+>$" id)
- id
- (nnheader-generate-fake-message-id))))
-
-(defun nnheader-parse-nov ()
- (let ((eol (gnus-point-at-eol)))
- (vector
- (nnheader-nov-read-integer) ; number
- (nnheader-nov-field) ; subject
- (nnheader-nov-field) ; from
- (nnheader-nov-field) ; date
- (nnheader-nov-read-message-id) ; id
- (nnheader-nov-field) ; refs
- (nnheader-nov-read-integer) ; chars
- (nnheader-nov-read-integer) ; lines
- (if (eq (char-after) ?\n)
- nil
- (if (looking-at "Xref: ")
- (goto-char (match-end 0)))
- (nnheader-nov-field)) ; Xref
- (nnheader-nov-parse-extra)))) ; extra
-
-(defun nnheader-insert-nov (header)
- (princ (mail-header-number header) (current-buffer))
- (let ((p (point)))
- (insert
- "\t"
- (or (mail-header-subject header) "(none)") "\t"
- (or (mail-header-from header) "(nobody)") "\t"
- (or (mail-header-date header) "") "\t"
- (or (mail-header-id header)
- (nnmail-message-id))
- "\t"
- (or (mail-header-references header) "") "\t")
- (princ (or (mail-header-chars header) 0) (current-buffer))
- (insert "\t")
- (princ (or (mail-header-lines header) 0) (current-buffer))
- (insert "\t")
- (when (mail-header-xref header)
- (insert "Xref: " (mail-header-xref header)))
- (when (or (mail-header-xref header)
- (mail-header-extra header))
- (insert "\t"))
- (when (mail-header-extra header)
- (let ((extra (mail-header-extra header)))
- (while extra
- (insert (symbol-name (caar extra))
- ": " (cdar extra) "\t")
- (pop extra))))
- (insert "\n")
- (backward-char 1)
- (while (search-backward "\n" p t)
- (delete-char 1))
- (forward-line 1)))
-
-(defun nnheader-parse-overview-file (file)
- "Parse FILE and return a list of headers."
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents file)
- (goto-char (point-min))
- (let (headers)
- (while (not (eobp))
- (push (nnheader-parse-nov) headers)
- (forward-line 1))
- (nreverse headers))))
-
-(defun nnheader-write-overview-file (file headers)
- "Write HEADERS to FILE."
- (with-temp-file file
- (mapcar 'nnheader-insert-nov headers)))
-
-(defun nnheader-insert-header (header)
- (insert
- "Subject: " (or (mail-header-subject header) "(none)") "\n"
- "From: " (or (mail-header-from header) "(nobody)") "\n"
- "Date: " (or (mail-header-date header) "") "\n"
- "Message-ID: " (or (mail-header-id header) (nnmail-message-id)) "\n"
- "References: " (or (mail-header-references header) "") "\n"
- "Lines: ")
- (princ (or (mail-header-lines header) 0) (current-buffer))
- (insert "\n\n"))
-
-(defun nnheader-insert-article-line (article)
- (goto-char (point-min))
- (insert "220 ")
- (princ article (current-buffer))
- (insert " Article retrieved.\n")
- (search-forward "\n\n" nil 'move)
- (delete-region (point) (point-max))
- (forward-char -1)
- (insert "."))
-
-(defun nnheader-nov-delete-outside-range (beg end)
- "Delete all NOV lines that lie outside the BEG to END range."
- ;; First we find the first wanted line.
- (nnheader-find-nov-line beg)
- (delete-region (point-min) (point))
- ;; Then we find the last wanted line.
- (when (nnheader-find-nov-line end)
- (forward-line 1))
- (delete-region (point) (point-max)))
-
-(defun nnheader-find-nov-line (article)
- "Put point at the NOV line that start with ARTICLE.
-If ARTICLE doesn't exist, put point where that line
-would have been. The function will return non-nil if
-the line could be found."
- ;; This function basically does a binary search.
- (let ((max (point-max))
- (min (goto-char (point-min)))
- (cur (current-buffer))
- (prev (point-min))
- num found)
- (while (not found)
- (goto-char (+ min (/ (- max min) 2)))
- (beginning-of-line)
- (if (or (= (point) prev)
- (eobp))
- (setq found t)
- (setq prev (point))
- (while (and (not (numberp (setq num (read cur))))
- (not (eobp)))
- (gnus-delete-line))
- (cond ((> num article)
- (setq max (point)))
- ((< num article)
- (setq min (point)))
- (t
- (setq found 'yes)))))
- ;; We may be at the first line.
- (when (and (not num)
- (not (eobp)))
- (setq num (read cur)))
- ;; Now we may have found the article we're looking for, or we
- ;; may be somewhere near it.
- (when (and (not (eq found 'yes))
- (not (eq num article)))
- (setq found (point))
- (while (and (< (point) max)
- (or (not (numberp num))
- (< num article)))
- (forward-line 1)
- (setq found (point))
- (or (eobp)
- (= (setq num (read cur)) article)))
- (unless (eq num article)
- (goto-char found)))
- (beginning-of-line)
- (eq num article)))
-
-;; Various cruft the backends and Gnus need to communicate.
-
-(defvar nntp-server-buffer nil)
-(defvar nntp-process-response nil)
-(defvar news-reply-yank-from nil)
-(defvar news-reply-yank-message-id nil)
-
-(defvar nnheader-callback-function nil)
-
-(defun nnheader-init-server-buffer ()
- "Initialize the Gnus-backend communication buffer."
- (save-excursion
- (unless (gnus-buffer-live-p nntp-server-buffer)
- (setq nntp-server-buffer (get-buffer-create " *nntpd*")))
- (set-buffer nntp-server-buffer)
- (mm-enable-multibyte)
- (erase-buffer)
- (kill-all-local-variables)
- (setq case-fold-search t) ;Should ignore case.
- (set (make-local-variable 'nntp-process-response) nil)
- t))
-
-;;; Various functions the backends use.
-
-(defun nnheader-file-error (file)
- "Return a string that says what is wrong with FILE."
- (format
- (cond
- ((not (file-exists-p file))
- "%s does not exist")
- ((file-directory-p file)
- "%s is a directory")
- ((not (file-readable-p file))
- "%s is not readable"))
- file))
-
-(defun nnheader-insert-head (file)
- "Insert the head of the article."
- (when (file-exists-p file)
- (if (eq nnheader-max-head-length t)
- ;; Just read the entire file.
- (nnheader-insert-file-contents file)
- ;; Read blocks of the size specified by `nnheader-head-chop-length'
- ;; until we find a separator.
- (let ((beg 0)
- (start (point))
- ;; Use `binary' to prevent the contents from being decoded,
- ;; or it will change the number of characters that
- ;; `insert-file-contents' returns.
- (coding-system-for-read 'binary))
- (while (and (eq nnheader-head-chop-length
- (nth 1 (mm-insert-file-contents
- file nil beg
- (incf beg nnheader-head-chop-length))))
- ;; CRLF or CR might be used for the line-break code.
- (prog1 (not (re-search-forward "\n\r?\n\\|\r\r" nil t))
- (goto-char (point-max)))
- (or (null nnheader-max-head-length)
- (< beg nnheader-max-head-length))))
- ;; Finally decode the contents.
- (when (mm-coding-system-p nnheader-file-coding-system)
- (mm-decode-coding-region start (point-max)
- nnheader-file-coding-system))))
- t))
-
-(defun nnheader-article-p ()
- "Say whether the current buffer looks like an article."
- (goto-char (point-min))
- (if (not (search-forward "\n\n" nil t))
- nil
- (narrow-to-region (point-min) (1- (point)))
- (goto-char (point-min))
- (while (looking-at "[a-zA-Z][^ \t]+:.*\n\\([ \t].*\n\\)*\\|From .*\n")
- (goto-char (match-end 0)))
- (prog1
- (eobp)
- (widen))))
-
-(defun nnheader-insert-references (references message-id)
- "Insert a References header based on REFERENCES and MESSAGE-ID."
- (if (and (not references) (not message-id))
- ;; This is invalid, but not all articles have Message-IDs.
- ()
- (mail-position-on-field "References")
- (let ((begin (gnus-point-at-bol))
- (fill-column 78)
- (fill-prefix "\t"))
- (when references
- (insert references))
- (when (and references message-id)
- (insert " "))
- (when message-id
- (insert message-id))
- ;; Fold long References lines to conform to RFC1036 (sort of).
- ;; The region must end with a newline to fill the region
- ;; without inserting extra newline.
- (fill-region-as-paragraph begin (1+ (point))))))
-
-(defun nnheader-replace-header (header new-value)
- "Remove HEADER and insert the NEW-VALUE."
- (save-excursion
- (save-restriction
- (nnheader-narrow-to-headers)
- (prog1
- (message-remove-header header)
- (goto-char (point-max))
- (insert header ": " new-value "\n")))))
-
-(defun nnheader-narrow-to-headers ()
- "Narrow to the head of an article."
- (widen)
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (goto-char (point-min)))
-
-(defun nnheader-remove-body ()
- "Remove the body from an article in this current buffer."
- (goto-char (point-min))
- (when (re-search-forward "\n\r?\n" nil t)
- (delete-region (point) (point-max))))
-
-(defun nnheader-set-temp-buffer (name &optional noerase)
- "Set-buffer to an empty (possibly new) buffer called NAME with undo disabled."
- (set-buffer (get-buffer-create name))
- (buffer-disable-undo)
- (unless noerase
- (erase-buffer))
- (current-buffer))
-
-(eval-when-compile (defvar jka-compr-compression-info-list))
-(defvar nnheader-numerical-files
- (if (boundp 'jka-compr-compression-info-list)
- (concat "\\([0-9]+\\)\\("
- (mapconcat (lambda (i) (aref i 0))
- jka-compr-compression-info-list "\\|")
- "\\)?")
- "[0-9]+$")
- "Regexp that match numerical files.")
-
-(defvar nnheader-numerical-short-files (concat "^" nnheader-numerical-files)
- "Regexp that matches numerical file names.")
-
-(defvar nnheader-numerical-full-files (concat "/" nnheader-numerical-files)
- "Regexp that matches numerical full file names.")
-
-(defsubst nnheader-file-to-number (file)
- "Take a FILE name and return the article number."
- (if (string= nnheader-numerical-short-files "^[0-9]+$")
- (string-to-number file)
- (string-match nnheader-numerical-short-files file)
- (string-to-number (match-string 0 file))))
-
-(defvar nnheader-directory-files-is-safe
- (or (eq system-type 'windows-nt)
- (and (not (featurep 'xemacs))
- (> emacs-major-version 20)))
- "If non-nil, Gnus believes `directory-files' is safe.
-It has been reported numerous times that `directory-files' fails with
-an alarming frequency on NFS mounted file systems. If it is nil,
-`nnheader-directory-files-safe' is used.")
-
-(defun nnheader-directory-files-safe (&rest args)
- "Execute `directory-files' twice and returns the longer result."
- (let ((first (apply 'directory-files args))
- (second (apply 'directory-files args)))
- (if (> (length first) (length second))
- first
- second)))
-
-(defun nnheader-directory-articles (dir)
- "Return a list of all article files in directory DIR."
- (mapcar 'nnheader-file-to-number
- (if nnheader-directory-files-is-safe
- (directory-files
- dir nil nnheader-numerical-short-files t)
- (nnheader-directory-files-safe
- dir nil nnheader-numerical-short-files t))))
-
-(defun nnheader-article-to-file-alist (dir)
- "Return an alist of article/file pairs in DIR."
- (mapcar (lambda (file) (cons (nnheader-file-to-number file) file))
- (if nnheader-directory-files-is-safe
- (directory-files
- dir nil nnheader-numerical-short-files t)
- (nnheader-directory-files-safe
- dir nil nnheader-numerical-short-files t))))
-
-(defun nnheader-fold-continuation-lines ()
- "Fold continuation lines in the current buffer."
- (nnheader-replace-regexp "\\(\r?\n[ \t]+\\)+" " "))
-
-(defun nnheader-translate-file-chars (file &optional full)
- "Translate FILE into something that can be a file name.
-If FULL, translate everything."
- (if (null nnheader-file-name-translation-alist)
- ;; No translation is necessary.
- file
- (let* ((i 0)
- trans leaf path len)
- (if full
- ;; Do complete translation.
- (setq leaf (copy-sequence file)
- path ""
- i (if (and (< 1 (length leaf)) (eq ?: (aref leaf 1)))
- 2 0))
- ;; We translate -- but only the file name. We leave the directory
- ;; alone.
- (if (and (featurep 'xemacs)
- (memq system-type '(cygwin32 win32 w32 mswindows windows-nt
- cygwin)))
- ;; This is needed on NT and stuff, because
- ;; file-name-nondirectory is not enough to split
- ;; file names, containing ':', e.g.
- ;; "d:\\Work\\News\\nntp+news.fido7.ru:fido7.ru.gnu.SCORE"
- ;;
- ;; we are trying to correctly split such names:
- ;; "d:file.name" -> "a:" "file.name"
- ;; "aaa:bbb.ccc" -> "" "aaa:bbb.ccc"
- ;; "d:aaa\\bbb:ccc" -> "d:aaa\\" "bbb:ccc"
- ;; etc.
- ;; to translate then only the file name part.
- (progn
- (setq leaf file
- path "")
- (if (string-match "\\(^\\w:\\|[/\\]\\)\\([^/\\]+\\)$" file)
- (setq leaf (substring file (match-beginning 2))
- path (substring file 0 (match-beginning 2)))))
- ;; Emacs DTRT, says andrewi.
- (setq leaf (file-name-nondirectory file)
- path (file-name-directory file))))
- (setq len (length leaf))
- (while (< i len)
- (when (setq trans (cdr (assq (aref leaf i)
- nnheader-file-name-translation-alist)))
- (aset leaf i trans))
- (incf i))
- (concat path leaf))))
-
-(defun nnheader-report (backend &rest args)
- "Report an error from the BACKEND.
-The first string in ARGS can be a format string."
- (set (intern (format "%s-status-string" backend))
- (if (< (length args) 2)
- (car args)
- (apply 'format args)))
- nil)
-
-(defun nnheader-get-report (backend)
- "Get the most recent report from BACKEND."
- (condition-case ()
- (nnheader-message 5 "%s" (symbol-value (intern (format "%s-status-string"
- backend))))
- (error (nnheader-message 5 ""))))
-
-(defun nnheader-insert (format &rest args)
- "Clear the communication buffer and insert FORMAT and ARGS into the buffer.
-If FORMAT isn't a format string, it and all ARGS will be inserted
-without formatting."
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (if (string-match "%" format)
- (insert (apply 'format format args))
- (apply 'insert format args))
- t))
-
-(defsubst nnheader-replace-chars-in-string (string from to)
- (mm-subst-char-in-string from to string))
-
-(defun nnheader-replace-duplicate-chars-in-string (string from to)
- "Replace characters in STRING from FROM to TO."
- (let ((string (substring string 0)) ;Copy string.
- (len (length string))
- (idx 0) prev i)
- ;; Replace all occurrences of FROM with TO.
- (while (< idx len)
- (setq i (aref string idx))
- (when (and (eq prev from) (= i from))
- (aset string (1- idx) to)
- (aset string idx to))
- (setq prev i)
- (setq idx (1+ idx)))
- string))
-
-(defun nnheader-file-to-group (file &optional top)
- "Return a group name based on FILE and TOP."
- (nnheader-replace-chars-in-string
- (if (not top)
- file
- (condition-case ()
- (substring (expand-file-name file)
- (length
- (expand-file-name
- (file-name-as-directory top))))
- (error "")))
- nnheader-directory-separator-character ?.))
-
-(defun nnheader-message (level &rest args)
- "Message if the Gnus backends are talkative."
- (if (or (not (numberp gnus-verbose-backends))
- (<= level gnus-verbose-backends))
- (apply 'message args)
- (apply 'format args)))
-
-(defun nnheader-be-verbose (level)
- "Return whether the backends should be verbose on LEVEL."
- (or (not (numberp gnus-verbose-backends))
- (<= level gnus-verbose-backends)))
-
-(defvar nnheader-pathname-coding-system 'iso-8859-1
- "*Coding system for file name.")
-
-(defun nnheader-group-pathname (group dir &optional file)
- "Make file name for GROUP."
- (concat
- (let ((dir (file-name-as-directory (expand-file-name dir))))
- ;; If this directory exists, we use it directly.
- (file-name-as-directory
- (if (file-directory-p (concat dir group))
- (expand-file-name group dir)
- ;; If not, we translate dots into slashes.
- (expand-file-name (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnheader-pathname-coding-system)
- dir))))
- (cond ((null file) "")
- ((numberp file) (int-to-string file))
- (t file))))
-
-(defun nnheader-concat (dir &rest files)
- "Concat DIR as directory to FILES."
- (apply 'concat (file-name-as-directory dir) files))
-
-(defun nnheader-ms-strip-cr ()
- "Strip ^M from the end of all lines."
- (save-excursion
- (nnheader-remove-cr-followed-by-lf)))
-
-(defun nnheader-file-size (file)
- "Return the file size of FILE or 0."
- (or (nth 7 (file-attributes file)) 0))
-
-(defun nnheader-find-etc-directory (package &optional file first)
- "Go through `load-path' and find the \"../etc/PACKAGE\" directory.
-This function will look in the parent directory of each `load-path'
-entry, and look for the \"etc\" directory there.
-If FILE, find the \".../etc/PACKAGE\" file instead.
-If FIRST is non-nil, return the directory or the file found at the
-first. Otherwise, find the newest one, though it may take a time."
- (let ((path load-path)
- dir results)
- ;; We try to find the dir by looking at the load path,
- ;; stripping away the last component and adding "etc/".
- (while path
- (if (and (car path)
- (file-exists-p
- (setq dir (concat
- (file-name-directory
- (directory-file-name (car path)))
- "etc/" package
- (if file "" "/"))))
- (or file (file-directory-p dir)))
- (progn
- (or (member dir results)
- (push dir results))
- (setq path (if first nil (cdr path))))
- (setq path (cdr path))))
- (if (or first (not (cdr results)))
- (car results)
- (car (sort results 'file-newer-than-file-p)))))
-
-(eval-when-compile
- (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 (and (fboundp 'efs-re-read-dir) (boundp 'efs-path-regexp))
- (when (string-match efs-path-regexp path)
- (efs-re-read-dir path))
- (when (and (fboundp 'ange-ftp-re-read-dir) (boundp 'ange-ftp-path-format))
- (when (string-match (car ange-ftp-path-format) path)
- (ange-ftp-re-read-dir path)))))
-
-(defvar nnheader-file-coding-system 'raw-text
- "Coding system used in file backends of Gnus.")
-
-(defun nnheader-insert-file-contents (filename &optional visit beg end replace)
- "Like `insert-file-contents', q.v., but only reads in the file.
-A buffer may be modified in several ways after reading into the buffer due
-to advanced Emacs features, such as file-name-handlers, format decoding,
-find-file-hooks, etc.
- This function ensures that none of these modifications will take place."
- (let ((coding-system-for-read nnheader-file-coding-system))
- (mm-insert-file-contents filename visit beg end replace)))
-
-(defun nnheader-insert-nov-file (file first)
- (let ((size (nth 7 (file-attributes file)))
- (cutoff (* 32 1024)))
- (when size
- (if (< size cutoff)
- ;; If the file is small, we just load it.
- (nnheader-insert-file-contents file)
- ;; We start on the assumption that FIRST is pretty recent. If
- ;; not, we just insert the rest of the file as well.
- (let (current)
- (nnheader-insert-file-contents file nil (- size cutoff) size)
- (goto-char (point-min))
- (delete-region (point) (or (search-forward "\n" nil 'move) (point)))
- (setq current (ignore-errors (read (current-buffer))))
- (if (and (numberp current)
- (< current first))
- t
- (delete-region (point-min) (point-max))
- (nnheader-insert-file-contents file)))))))
-
-(defun nnheader-find-file-noselect (&rest args)
- "Open a file with some variables bound.
-See `find-file-noselect' for the arguments."
- (let* ((format-alist nil)
- (auto-mode-alist (mm-auto-mode-alist))
- (default-major-mode 'fundamental-mode)
- (enable-local-variables nil)
- (after-insert-file-functions nil)
- (enable-local-eval nil)
- (coding-system-for-read nnheader-file-coding-system)
- (ffh (if (boundp 'find-file-hook)
- 'find-file-hook
- 'find-file-hooks))
- (val (symbol-value ffh)))
- (set ffh nil)
- (unwind-protect
- (apply 'find-file-noselect args)
- (set ffh val))))
-
-(defun nnheader-directory-regular-files (dir)
- "Return a list of all regular files in DIR."
- (let ((files (directory-files dir t))
- out)
- (while files
- (when (file-regular-p (car files))
- (push (car files) out))
- (pop files))
- (nreverse out)))
-
-(defun nnheader-directory-files (&rest args)
- "Same as `directory-files', but prune \".\" and \"..\"."
- (let ((files (apply 'directory-files args))
- out)
- (while files
- (unless (member (file-name-nondirectory (car files)) '("." ".."))
- (push (car files) out))
- (pop files))
- (nreverse out)))
-
-(defmacro nnheader-skeleton-replace (from &optional to regexp)
- `(let ((new (generate-new-buffer " *nnheader replace*"))
- (cur (current-buffer))
- (start (point-min)))
- (set-buffer cur)
- (goto-char (point-min))
- (while (,(if regexp 're-search-forward 'search-forward)
- ,from nil t)
- (insert-buffer-substring
- cur start (prog1 (match-beginning 0) (set-buffer new)))
- (goto-char (point-max))
- ,(when to `(insert ,to))
- (set-buffer cur)
- (setq start (point)))
- (insert-buffer-substring
- cur start (prog1 (point-max) (set-buffer new)))
- (copy-to-buffer cur (point-min) (point-max))
- (kill-buffer (current-buffer))
- (set-buffer cur)))
-
-(defun nnheader-replace-string (from to)
- "Do a fast replacement of FROM to TO from point to `point-max'."
- (nnheader-skeleton-replace from to))
-
-(defun nnheader-replace-regexp (from to)
- "Do a fast regexp replacement of FROM to TO from point to `point-max'."
- (nnheader-skeleton-replace from to t))
-
-(defun nnheader-strip-cr ()
- "Strip all \r's from the current buffer."
- (nnheader-skeleton-replace "\r"))
-
-(defalias 'nnheader-run-at-time 'run-at-time)
-(defalias 'nnheader-cancel-timer 'cancel-timer)
-(defalias 'nnheader-cancel-function-timers 'cancel-function-timers)
-(defalias 'nnheader-string-as-multibyte 'string-as-multibyte)
-
-(defun nnheader-accept-process-output (process)
- (accept-process-output
- process
- (truncate nnheader-read-timeout)
- (truncate (* (- nnheader-read-timeout
- (truncate nnheader-read-timeout))
- 1000))))
-
-(when (featurep 'xemacs)
- (require 'nnheaderxm))
-
-(run-hooks 'nnheader-load-hook)
-
-(provide 'nnheader)
-
-;;; arch-tag: a9c4b7d9-52ae-4ec9-b196-dfd93124d202
-;;; nnheader.el ends here
+++ /dev/null
-;;; nnheaderxm.el --- making Gnus backends work under XEmacs
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2003, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(if (condition-case nil
- (progn
- (unless (or itimer-process itimer-timer)
- (itimer-driver-start))
- ;; Check whether there is a bug to which the difference of
- ;; the present time and the time when the itimer driver was
- ;; woken up is subtracted from the initial itimer value.
- (let* ((inhibit-quit t)
- (ctime (current-time))
- (itimer-timer-last-wakeup
- (prog1
- ctime
- (setcar ctime (1- (car ctime)))))
- (itimer-list nil)
- (itimer (start-itimer "nnheader-run-at-time" 'ignore 5)))
- (sleep-for 0.1) ;; Accept the timeout interrupt.
- (prog1
- (> (itimer-value itimer) 0)
- (delete-itimer itimer))))
- (error nil))
- (defun nnheader-xmas-run-at-time (time repeat function &rest args)
- "Emulating function run as `run-at-time'.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (apply #'start-itimer "nnheader-run-at-time"
- function (if time (max time 1e-9) 1e-9)
- repeat nil t args))
- (defun nnheader-xmas-run-at-time (time repeat function &rest args)
- "Emulating function run as `run-at-time' in the right way.
-TIME should be nil meaning now, or a number of seconds from now.
-Return an itimer object which can be used in either `delete-itimer'
-or `cancel-timer'."
- (let ((itimers (list nil)))
- (setcar
- itimers
- (apply #'start-itimer "nnheader-run-at-time"
- (lambda (itimers repeat function &rest args)
- (let ((itimer (car itimers)))
- (if repeat
- (progn
- (set-itimer-function
- itimer
- (lambda (itimer repeat function &rest args)
- (set-itimer-restart itimer repeat)
- (set-itimer-function itimer function)
- (set-itimer-function-arguments itimer args)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer repeat function) args)))
- (set-itimer-function
- itimer
- (lambda (itimer function &rest args)
- (delete-itimer itimer)
- (apply function args)))
- (set-itimer-function-arguments
- itimer
- (append (list itimer function) args)))))
- 1e-9 (if time (max time 1e-9) 1e-9)
- nil t itimers repeat function args)))))
-
-(defalias 'nnheader-run-at-time 'nnheader-xmas-run-at-time)
-(defalias 'nnheader-cancel-timer 'delete-itimer)
-(defalias 'nnheader-cancel-function-timers 'ignore)
-(defalias 'nnheader-string-as-multibyte 'identity)
-
-(provide 'nnheaderxm)
-
-;;; arch-tag: ee2b3387-d3ca-4de6-9b64-304d838706dd
-;;; nnheaderxm.el ends here
+++ /dev/null
-;;; nnimap.el --- imap backend for Gnus
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <jas@pdc.kth.se>
-;; Jim Radford <radford@robby.caltech.edu>
-;; Keywords: mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Todo, major things:
-;;
-;; o Fix Gnus to view correct number of unread/total articles in group buffer
-;; o Fix Gnus to handle leading '.' in group names (fixed?)
-;; o Finish disconnected mode (moving articles between mailboxes unplugged)
-;; o Sieve
-;; o MIME (partial article fetches)
-;; o Split to other backends, different split rules for different
-;; servers/inboxes
-;;
-;; Todo, minor things:
-;;
-;; o Don't require half of Gnus -- backends should be standalone
-;; o Verify that we don't use IMAP4rev1 specific things (RFC2060 App B)
-;; o Dont uid fetch 1,* in nnimap-retrive-groups (slow)
-;; o Split up big fetches (1,* header especially) in smaller chunks
-;; o What do I do with gnus-newsgroup-*?
-;; o Tell Gnus about new groups (how can we tell?)
-;; o Respooling (fix Gnus?) (unnecessary?)
-;; o Add support for the following: (if applicable)
-;; request-list-newsgroups, request-regenerate
-;; list-active-group,
-;; request-associate-buffer, request-restore-buffer,
-;; o Do The Right Thing when UIDVALIDITY changes (what's the right thing?)
-;; o Support RFC2221 (Login referrals)
-;; o IMAP2BIS compatibility? (RFC2061)
-;; o ACAP stuff (perhaps a different project, would be nice to ACAPify
-;; .newsrc.eld)
-;; o What about Gnus's article editing, can we support it? NO!
-;; o Use \Draft to support the draft group??
-;; o Duplicate suppression
-;; o Rewrite UID SEARCH UID X as UID FETCH X (UID) for those with slow servers
-
-;;; Code:
-
-(require 'imap)
-(require 'nnoo)
-(require 'nnmail)
-(require 'nnheader)
-(require 'mm-util)
-(require 'gnus)
-(require 'gnus-range)
-(require 'gnus-start)
-(require 'gnus-int)
-
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnimap)
-
-(defconst nnimap-version "nnimap 1.0")
-
-(defgroup nnimap nil
- "Reading IMAP mail with Gnus."
- :group 'gnus)
-
-(defvoo nnimap-address nil
- "Address of physical IMAP server. If nil, use the virtual server's name.")
-
-(defvoo nnimap-server-port nil
- "Port number on physical IMAP server.
-If nil, defaults to 993 for TLS/SSL connections and 143 otherwise.")
-
-;; Splitting variables
-
-(defcustom nnimap-split-crosspost t
- "If non-nil, do crossposting if several split methods match the mail.
-If nil, the first match found will be used."
- :group 'nnimap
- :type 'boolean)
-
-(defcustom nnimap-split-inbox nil
- "Name of mailbox to split mail from.
-
-Mail is read from this mailbox and split according to rules in
-`nnimap-split-rule'.
-
-This can be a string or a list of strings."
- :group 'nnimap
- :type '(choice (string)
- (repeat string)))
-
-(define-widget 'nnimap-strict-function 'function
- "This widget only matches values that are functionp.
-
-Warning: This means that a value that is the symbol of a not yet
-loaded function will not match. Use with care."
- :match 'nnimap-strict-function-match)
-
-(defun nnimap-strict-function-match (widget value)
- "Ignoring WIDGET, match if VALUE is a function."
- (functionp value))
-
-(defcustom nnimap-split-rule nil
- "Mail will be split according to these rules.
-
-Mail is read from mailbox(es) specified in `nnimap-split-inbox'.
-
-If you'd like, for instance, one mail group for mail from the
-\"gnus-imap\" mailing list, one group for junk mail and leave
-everything else in the incoming mailbox, you could do something like
-this:
-
-\(setq nnimap-split-rule '((\"INBOX.gnus-imap\" \"From:.*gnus-imap\")
- (\"INBOX.junk\" \"Subject:.*buy\")))
-
-As you can see, `nnimap-split-rule' is a list of lists, where the
-first element in each \"rule\" is the name of the IMAP mailbox (or the
-symbol `junk' if you want to remove the mail), and the second is a
-regexp that nnimap will try to match on the header to find a fit.
-
-The second element can also be a function. In that case, it will be
-called narrowed to the headers with the first element of the rule as
-the argument. It should return a non-nil value if it thinks that the
-mail belongs in that group.
-
-This variable can also have a function as its value, the function will
-be called with the headers narrowed and should return a group where it
-thinks the article should be splitted to. See `nnimap-split-fancy'.
-
-To allow for different split rules on different virtual servers, and
-even different split rules in different inboxes on the same server,
-the syntax of this variable have been extended along the lines of:
-
-\(setq nnimap-split-rule
- '((\"my1server\" (\".*\" ((\"ding\" \"ding@gnus.org\")
- (\"junk\" \"From:.*Simon\")))
- (\"my2server\" (\"INBOX\" nnimap-split-fancy))
- (\"my[34]server\" (\".*\" ((\"private\" \"To:.*Simon\")
- (\"junk\" my-junk-func)))))
-
-The virtual server name is in fact a regexp, so that the same rules
-may apply to several servers. In the example, the servers
-\"my3server\" and \"my4server\" both use the same rules. Similarly,
-the inbox string is also a regexp. The actual splitting rules are as
-before, either a function, or a list with group/regexp or
-group/function elements."
- :group 'nnimap
- :type '(choice :tag "Rule type"
- (repeat :menu-tag "Single-server"
- :tag "Single-server list"
- (list (string :tag "Mailbox")
- (choice :tag "Predicate"
- (regexp :tag "A regexp")
- (nnimap-strict-function :tag "A function"))))
- (choice :menu-tag "A function"
- :tag "A function"
- (function-item nnimap-split-fancy)
- (function-item nnmail-split-fancy)
- (nnimap-strict-function :tag "User-defined function"))
- (repeat :menu-tag "Multi-server (extended)"
- :tag "Multi-server list"
- (list (regexp :tag "Server regexp")
- (list (regexp :tag "Incoming Mailbox regexp")
- (repeat :tag "Rules for matching server(s) and mailbox(es)"
- (list (string :tag "Destination mailbox")
- (choice :tag "Predicate"
- (regexp :tag "A Regexp")
- (nnimap-strict-function :tag "A Function")))))))))
-
-(defcustom nnimap-split-predicate "UNSEEN UNDELETED"
- "The predicate used to find articles to split.
-If you use another IMAP client to peek on articles but always would
-like nnimap to split them once it's started, you could change this to
-\"UNDELETED\". Other available predicates are available in
-RFC2060 section 6.4.4."
- :group 'nnimap
- :type 'string)
-
-(defcustom nnimap-split-fancy nil
- "Like the variable `nnmail-split-fancy'."
- :group 'nnimap
- :type 'sexp)
-
-(defvar nnimap-split-download-body-default nil
- "Internal variable with default value for `nnimap-split-download-body'.")
-
-(defcustom nnimap-split-download-body 'default
- "Whether to download entire articles during splitting.
-This is generally not required, and will slow things down considerably.
-You may need it if you want to use an advanced splitting function that
-analyzes the body before splitting the article.
-If this variable is nil, bodies will not be downloaded; if this
-variable is the symbol `default' the default behavior is
-used (which currently is nil, unless you use a statistical
-spam.el test); if this variable is another non-nil value bodies
-will be downloaded."
- :version "22.1"
- :group 'nnimap
- :type '(choice (const :tag "Let system decide" deault)
- boolean))
-
-;; Performance / bug workaround variables
-
-(defcustom nnimap-close-asynchronous t
- "Close mailboxes asynchronously in `nnimap-close-group'.
-This means that errors caught by nnimap when closing the mailbox will
-not prevent Gnus from updating the group status, which may be harmful.
-However, it increases speed."
- :version "22.1"
- :type 'boolean
- :group 'nnimap)
-
-(defcustom nnimap-dont-close t
- "Never close mailboxes.
-This increases the speed of closing mailboxes (quiting group) but may
-decrease the speed of selecting another mailbox later. Re-selecting
-the same mailbox will be faster though."
- :version "22.1"
- :type 'boolean
- :group 'nnimap)
-
-(defcustom nnimap-retrieve-groups-asynchronous t
- "Send asynchronous STATUS commands for each mailbox before checking mail.
-If you have mailboxes that rarely receives mail, this speeds up new
-mail checking. It works by first sending STATUS commands for each
-mailbox, and then only checking groups which has a modified UIDNEXT
-more carefully for new mail.
-
-In summary, the default is O((1-p)*k+p*n) and changing it to nil makes
-it O(n). If p is small, then the default is probably faster."
- :version "22.1"
- :type 'boolean
- :group 'nnimap)
-
-(defvoo nnimap-need-unselect-to-notice-new-mail nil
- "Unselect mailboxes before looking for new mail in them.
-Some servers seem to need this under some circumstances.")
-
-;; Authorization / Privacy variables
-
-(defvoo nnimap-auth-method nil
- "Obsolete.")
-
-(defvoo nnimap-stream nil
- "How nnimap will connect to the server.
-
-The default, nil, will try to use the \"best\" method the server can
-handle.
-
-Change this if
-
-1) you want to connect with TLS/SSL. The TLS/SSL integration
- with IMAP is suboptimal so you'll have to tell it
- specifically.
-
-2) your server is more capable than your environment -- i.e. your
- server accept Kerberos login's but you haven't installed the
- `imtest' program or your machine isn't configured for Kerberos.
-
-Possible choices: gssapi, kerberos4, starttls, tls, ssl, network, shell.
-See also `imap-streams' and `imap-stream-alist'.")
-
-(defvoo nnimap-authenticator nil
- "How nnimap authenticate itself to the server.
-
-The default, nil, will try to use the \"best\" method the server can
-handle.
-
-There is only one reason for fiddling with this variable, and that is
-if your server is more capable than your environment -- i.e. you
-connect to a server that accept Kerberos login's but you haven't
-installed the `imtest' program or your machine isn't configured for
-Kerberos.
-
-Possible choices: gssapi, kerberos4, digest-md5, cram-md5, login, anonymous.
-See also `imap-authenticators' and `imap-authenticator-alist'")
-
-(defvoo nnimap-directory (nnheader-concat gnus-directory "overview/")
- "Directory to keep NOV cache files for nnimap groups.
-See also `nnimap-nov-file-name'.")
-
-(defvoo nnimap-nov-file-name "nnimap."
- "NOV cache base filename.
-The group name and `nnimap-nov-file-name-suffix' will be appended. A
-typical complete file name would be
-~/News/overview/nnimap.pdc.INBOX.ding.nov, or
-~/News/overview/nnimap/pdc/INBOX/ding/nov if
-`nnmail-use-long-file-names' is nil")
-
-(defvoo nnimap-nov-file-name-suffix ".novcache"
- "Suffix for NOV cache base filename.")
-
-(defvoo nnimap-nov-is-evil gnus-agent
- "If non-nil, never generate or use a local nov database for this backend.
-Using nov databases should speed up header fetching considerably.
-However, it will invoke a UID SEARCH UID command on the server, and
-some servers implement this command inefficiently by opening each and
-every message in the group, thus making it quite slow.
-Unlike other backends, you do not need to take special care if you
-flip this variable.")
-
-(defvoo nnimap-search-uids-not-since-is-evil nil
- "If non-nil, avoid \"UID SEARCH UID ... NOT SINCE\" queries when expiring.
-Instead, use \"UID SEARCH SINCE\" to prune the list of expirable
-articles within Gnus. This seems to be faster on Courier in some cases.")
-
-(defvoo nnimap-expunge-on-close 'always ; 'ask, 'never
- "Whether to expunge a group when it is closed.
-When a IMAP group with articles marked for deletion is closed, this
-variable determine if nnimap should actually remove the articles or
-not.
-
-If always, nnimap always perform a expunge when closing the group.
-If never, nnimap never expunges articles marked for deletion.
-If ask, nnimap will ask you if you wish to expunge marked articles.
-
-When setting this variable to `never', you can only expunge articles
-by using `G x' (gnus-group-nnimap-expunge) from the Group buffer.")
-
-(defvoo nnimap-list-pattern "*"
- "A string LIMIT or list of strings with mailbox wildcards used to limit available groups.
-See below for available wildcards.
-
-The LIMIT string can be a cons cell (REFERENCE . LIMIT), where
-REFERENCE will be passed as the first parameter to LIST/LSUB. The
-semantics of this are server specific, on the University of Washington
-server you can specify a directory.
-
-Example:
- '(\"INBOX\" \"mail/*\" (\"~friend/mail/\" . \"list/*\"))
-
-There are two wildcards * and %. * matches everything, % matches
-everything in the current hierarchy.")
-
-(defvoo nnimap-news-groups nil
- "IMAP support a news-like mode, also known as bulletin board mode,
-where replies is sent via IMAP instead of SMTP.
-
-This variable should contain a regexp matching groups where you wish
-replies to be stored to the mailbox directly.
-
-Example:
- '(\"^[^I][^N][^B][^O][^X].*$\")
-
-This will match all groups not beginning with \"INBOX\".
-
-Note that there is nothing technically different between mail-like and
-news-like mailboxes. If you wish to have a group with todo items or
-similar which you wouldn't want to set up a mailing list for, you can
-use this to make replies go directly to the group.")
-
-(defvoo nnimap-expunge-search-string "UID %s NOT SINCE %s"
- "IMAP search command to use for articles that are to be expired.
-The first %s is replaced by a UID set of articles to search on,
-and the second %s is replaced by a date criterium.
-
-One useful (and perhaps the only useful) value to change this to would
-be `UID %s NOT SENTSINCE %s' to make nnimap use the Date: header
-instead of the internal date of messages. See section 6.4.4 of RFC
-2060 for more information on valid strings.
-
-However, if `nnimap-search-uids-not-since-is-evil' is true, this
-variable has no effect since the search logic is reversed.")
-
-(defvoo nnimap-importantize-dormant t
- "If non-nil, mark \"dormant\" articles as \"ticked\" for other IMAP clients.
-Note that within Gnus, dormant articles will still (only) be
-marked as ticked. This is to make \"dormant\" articles stand out,
-just like \"ticked\" articles, in other IMAP clients.")
-
-(defvoo nnimap-server-address nil
- "Obsolete. Use `nnimap-address'.")
-
-(defcustom nnimap-authinfo-file "~/.authinfo"
- "Authorization information for IMAP servers. In .netrc format."
- :type
- '(choice file
- (repeat :tag "Entries"
- :menu-tag "Inline"
- (list :format "%v"
- :value ("" ("login" . "") ("password" . ""))
- (string :tag "Host")
- (checklist :inline t
- (cons :format "%v"
- (const :format "" "login")
- (string :format "Login: %v"))
- (cons :format "%v"
- (const :format "" "password")
- (string :format "Password: %v"))))))
- :group 'nnimap)
-
-(defcustom nnimap-prune-cache t
- "If non-nil, nnimap check whether articles still exist on server before using data stored in NOV cache."
- :type 'boolean
- :group 'nnimap)
-
-(defvar nnimap-request-list-method 'imap-mailbox-list
- "Method to use to request a list of all folders from the server.
-If this is 'imap-mailbox-lsub, then use a server-side subscription list to
-restrict visible folders.")
-
-(defcustom nnimap-debug nil
- "If non-nil, random debug spews are placed in *nnimap-debug* buffer.
-Note that username, passwords and other privacy sensitive
-information (such as e-mail) may be stored in the *nnimap-debug*
-buffer. It is not written to disk, however. Do not enable this
-variable unless you are comfortable with that."
- :group 'nnimap
- :type 'boolean)
-
-;; Internal variables:
-
-(defvar nnimap-debug-buffer "*nnimap-debug*")
-(defvar nnimap-mailbox-info (gnus-make-hashtable 997))
-(defvar nnimap-current-move-server nil)
-(defvar nnimap-current-move-group nil)
-(defvar nnimap-current-move-article nil)
-(defvar nnimap-length)
-(defvar nnimap-progress-chars '(?| ?/ ?- ?\\))
-(defvar nnimap-progress-how-often 20)
-(defvar nnimap-counter)
-(defvar nnimap-server-buffer-alist nil) ;; Map server name to buffers.
-(defvar nnimap-current-server nil) ;; Current server
-(defvar nnimap-server-buffer nil) ;; Current servers' buffer
-
-\f
-
-(nnoo-define-basics nnimap)
-
-;; Utility functions:
-
-(defsubst nnimap-get-server-buffer (server)
- "Return buffer for SERVER, if nil use current server."
- (cadr (assoc (or server nnimap-current-server) nnimap-server-buffer-alist)))
-
-(defun nnimap-possibly-change-server (server)
- "Return buffer for SERVER, changing the current server as a side-effect.
-If SERVER is nil, uses the current server."
- (setq nnimap-current-server (or server nnimap-current-server)
- nnimap-server-buffer (nnimap-get-server-buffer nnimap-current-server)))
-
-(defun nnimap-verify-uidvalidity (group server)
- "Verify stored uidvalidity match current one in GROUP on SERVER."
- (let* ((gnusgroup (gnus-group-prefixed-name
- group (gnus-server-to-method
- (format "nnimap:%s" server))))
- (new-uidvalidity (imap-mailbox-get 'uidvalidity))
- (old-uidvalidity (gnus-group-get-parameter gnusgroup 'uidvalidity))
- (dir (file-name-as-directory (expand-file-name nnimap-directory)))
- (nameuid (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group "." old-uidvalidity
- nnimap-nov-file-name-suffix) t))
- (file (if (or nnmail-use-long-file-names
- (file-exists-p (expand-file-name nameuid dir)))
- (expand-file-name nameuid dir)
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string nameuid ?. ?/)
- nnmail-pathname-coding-system)
- dir))))
- (if old-uidvalidity
- (if (not (equal old-uidvalidity new-uidvalidity))
- ;; uidvalidity clash
- (gnus-delete-file file)
- (gnus-group-set-parameter gnusgroup 'uidvalidity new-uidvalidity)
- t)
- (gnus-group-add-parameter gnusgroup (cons 'uidvalidity new-uidvalidity))
- t)))
-
-(defun nnimap-before-find-minmax-bugworkaround ()
- "Function called before iterating through mailboxes with
-`nnimap-find-minmax-uid'."
- (when nnimap-need-unselect-to-notice-new-mail
- ;; XXX this is for UoW imapd problem, it doesn't notice new mail in
- ;; currently selected mailbox without a re-select/examine.
- (or (null (imap-current-mailbox nnimap-server-buffer))
- (imap-mailbox-unselect nnimap-server-buffer))))
-
-(defun nnimap-find-minmax-uid (group &optional examine)
- "Find lowest and highest active article number in GROUP.
-If EXAMINE is non-nil the group is selected read-only."
- (with-current-buffer nnimap-server-buffer
- (when (or (string= group (imap-current-mailbox))
- (imap-mailbox-select group examine))
- (let (minuid maxuid)
- (when (> (imap-mailbox-get 'exists) 0)
- (imap-fetch "1,*" "UID" nil 'nouidfetch)
- (imap-message-map (lambda (uid Uid)
- (setq minuid (if minuid (min minuid uid) uid)
- maxuid (if maxuid (max maxuid uid) uid)))
- 'UID))
- (list (imap-mailbox-get 'exists) minuid maxuid)))))
-
-(defun nnimap-possibly-change-group (group &optional server)
- "Make GROUP the current group, and SERVER the current server."
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (if (or (null group) (imap-current-mailbox-p group))
- imap-current-mailbox
- (if (imap-mailbox-select group)
- (if (or (nnimap-verify-uidvalidity
- group (or server nnimap-current-server))
- (zerop (imap-mailbox-get 'exists group))
- t ;; for OGnus to see if ignoring uidvalidity
- ;; changes has any bad effects.
- (yes-or-no-p
- (format
- "nnimap: Group %s is not uidvalid. Continue? " group)))
- imap-current-mailbox
- (imap-mailbox-unselect)
- (error "nnimap: Group %s is not uid-valid" group))
- (nnheader-report 'nnimap (imap-error-text)))))))
-
-(defun nnimap-replace-whitespace (string)
- "Return STRING with all whitespace replaced with space."
- (when string
- (while (string-match "[\r\n\t]+" string)
- (setq string (replace-match " " t t string)))
- string))
-
-;; Required backend functions
-
-(defun nnimap-retrieve-headers-progress ()
- "Hook to insert NOV line for current article into `nntp-server-buffer'."
- (and (numberp nnmail-large-newsgroup)
- (zerop (% (incf nnimap-counter) nnimap-progress-how-often))
- (> nnimap-length nnmail-large-newsgroup)
- (nnheader-message 6 "nnimap: Retrieving headers... %c"
- (nth (/ (% nnimap-counter
- (* (length nnimap-progress-chars)
- nnimap-progress-how-often))
- nnimap-progress-how-often)
- nnimap-progress-chars)))
- (with-current-buffer nntp-server-buffer
- (let (headers lines chars uid mbx)
- (with-current-buffer nnimap-server-buffer
- (setq uid imap-current-message
- mbx imap-current-mailbox
- headers (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get uid 'BODYDETAIL)))
- (imap-message-get uid 'RFC822.HEADER)))
- lines (imap-body-lines (imap-message-body imap-current-message))
- chars (imap-message-get imap-current-message 'RFC822.SIZE)))
- (nnheader-insert-nov
- (with-temp-buffer
- (buffer-disable-undo)
- (insert headers)
- (let ((head (nnheader-parse-naked-head)))
- (mail-header-set-number head uid)
- (mail-header-set-chars head chars)
- (mail-header-set-lines head lines)
- (mail-header-set-xref
- head (format "%s %s:%d" (system-name) mbx uid))
- head))))))
-
-(defun nnimap-retrieve-which-headers (articles fetch-old)
- "Get a range of articles to fetch based on ARTICLES and FETCH-OLD."
- (with-current-buffer nnimap-server-buffer
- (if (numberp (car-safe articles))
- (imap-search
- (concat "UID "
- (imap-range-to-message-set
- (gnus-compress-sequence
- (append (gnus-uncompress-sequence
- (and fetch-old
- (cons (if (numberp fetch-old)
- (max 1 (- (car articles) fetch-old))
- 1)
- (1- (car articles)))))
- articles)))))
- (mapcar (lambda (msgid)
- (imap-search
- (format "HEADER Message-Id \"%s\"" msgid)))
- articles))))
-
-(defun nnimap-group-overview-filename (group server)
- "Make file name for GROUP on SERVER."
- (let* ((dir (file-name-as-directory (expand-file-name nnimap-directory)))
- (uidvalidity (gnus-group-get-parameter
- (gnus-group-prefixed-name
- group (gnus-server-to-method
- (format "nnimap:%s" server)))
- 'uidvalidity))
- (name (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group nnimap-nov-file-name-suffix) t))
- (nameuid (nnheader-translate-file-chars
- (concat nnimap-nov-file-name
- (if (equal server "")
- "unnamed"
- server) "." group "." uidvalidity
- nnimap-nov-file-name-suffix) t))
- (oldfile (if (or nnmail-use-long-file-names
- (file-exists-p (expand-file-name name dir)))
- (expand-file-name name dir)
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string name ?. ?/)
- nnmail-pathname-coding-system)
- dir)))
- (newfile (if (or nnmail-use-long-file-names
- (file-exists-p (expand-file-name nameuid dir)))
- (expand-file-name nameuid dir)
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string nameuid ?. ?/)
- nnmail-pathname-coding-system)
- dir))))
- (when (and (file-exists-p oldfile) (not (file-exists-p newfile)))
- (message "nnimap: Upgrading novcache filename...")
- (sit-for 1)
- (gnus-make-directory (file-name-directory newfile))
- (unless (ignore-errors (rename-file oldfile newfile) t)
- (if (ignore-errors (copy-file oldfile newfile) t)
- (delete-file oldfile)
- (error "Can't rename `%s' to `%s'" oldfile newfile))))
- newfile))
-
-(defun nnimap-retrieve-headers-from-file (group server)
- (with-current-buffer nntp-server-buffer
- (let ((nov (nnimap-group-overview-filename group server)))
- (when (file-exists-p nov)
- (mm-insert-file-contents nov)
- (set-buffer-modified-p nil)
- (let ((min (ignore-errors (goto-char (point-min))
- (read (current-buffer))))
- (max (ignore-errors (goto-char (point-max))
- (forward-line -1)
- (read (current-buffer)))))
- (if (and (numberp min) (numberp max))
- (cons min max)
- ;; junk, remove it, it's saved later
- (erase-buffer)
- nil))))))
-
-(defun nnimap-retrieve-headers-from-server (articles group server)
- (with-current-buffer nnimap-server-buffer
- (let ((imap-fetch-data-hook '(nnimap-retrieve-headers-progress))
- (nnimap-length (gnus-range-length articles))
- (nnimap-counter 0))
- (imap-fetch (imap-range-to-message-set articles)
- (concat "(UID RFC822.SIZE BODY "
- (let ((headers
- (append '(Subject From Date Message-Id
- References In-Reply-To Xref)
- (copy-sequence
- nnmail-extra-headers))))
- (if (imap-capability 'IMAP4rev1)
- (format "BODY.PEEK[HEADER.FIELDS %s])" headers)
- (format "RFC822.HEADER.LINES %s)" headers)))))
- (with-current-buffer nntp-server-buffer
- (sort-numeric-fields 1 (point-min) (point-max)))
- (and (numberp nnmail-large-newsgroup)
- (> nnimap-length nnmail-large-newsgroup)
- (nnheader-message 6 "nnimap: Retrieving headers...done")))))
-
-(defun nnimap-dont-use-nov-p (group server)
- (or gnus-nov-is-evil nnimap-nov-is-evil
- (unless (and (gnus-make-directory
- (file-name-directory
- (nnimap-group-overview-filename group server)))
- (file-writable-p
- (nnimap-group-overview-filename group server)))
- (message "nnimap: Nov cache not writable, %s"
- (nnimap-group-overview-filename group server)))))
-
-(deffoo nnimap-retrieve-headers (articles &optional group server fetch-old)
- (when (nnimap-possibly-change-group group server)
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (if (nnimap-dont-use-nov-p group server)
- (nnimap-retrieve-headers-from-server
- (gnus-compress-sequence articles) group server)
- (let (uids cached low high)
- (when (setq uids (nnimap-retrieve-which-headers articles fetch-old)
- low (car uids)
- high (car (last uids)))
- (if (setq cached (nnimap-retrieve-headers-from-file group server))
- (progn
- ;; fetch articles with uids before cache block
- (when (< low (car cached))
- (goto-char (point-min))
- (nnimap-retrieve-headers-from-server
- (cons low (1- (car cached))) group server))
- ;; fetch articles with uids after cache block
- (when (> high (cdr cached))
- (goto-char (point-max))
- (nnimap-retrieve-headers-from-server
- (cons (1+ (cdr cached)) high) group server))
- (when nnimap-prune-cache
- ;; remove nov's for articles which has expired on server
- (goto-char (point-min))
- (dolist (uid (gnus-set-difference articles uids))
- (when (re-search-forward (format "^%d\t" uid) nil t)
- (gnus-delete-line)))))
- ;; nothing cached, fetch whole range from server
- (nnimap-retrieve-headers-from-server
- (cons low high) group server))
- (when (buffer-modified-p)
- (nnmail-write-region
- (point-min) (point-max)
- (nnimap-group-overview-filename group server) nil 'nomesg))
- (nnheader-nov-delete-outside-range low high))))
- 'nov)))
-
-(defun nnimap-open-connection (server)
- (if (not (imap-open nnimap-address nnimap-server-port nnimap-stream
- nnimap-authenticator nnimap-server-buffer))
- (nnheader-report 'nnimap "Can't open connection to server %s" server)
- (unless (or (imap-capability 'IMAP4 nnimap-server-buffer)
- (imap-capability 'IMAP4rev1 nnimap-server-buffer))
- (imap-close nnimap-server-buffer)
- (nnheader-report 'nnimap "Server %s is not IMAP4 compliant" server))
- (let* ((list (progn (gnus-message 7 "Parsing authinfo file `%s'."
- nnimap-authinfo-file)
- (gnus-parse-netrc nnimap-authinfo-file)))
- (port (if nnimap-server-port
- (int-to-string nnimap-server-port)
- "imap"))
- (alist (or (gnus-netrc-machine list server port "imap")
- (gnus-netrc-machine list server port "imaps")
- (gnus-netrc-machine list
- (or nnimap-server-address
- nnimap-address)
- port "imap")
- (gnus-netrc-machine list
- (or nnimap-server-address
- nnimap-address)
- port "imaps")))
- (user (gnus-netrc-get alist "login"))
- (passwd (gnus-netrc-get alist "password")))
- (if (imap-authenticate user passwd nnimap-server-buffer)
- (prog1
- (push (list server nnimap-server-buffer)
- nnimap-server-buffer-alist)
- (nnimap-possibly-change-server server))
- (imap-close nnimap-server-buffer)
- (kill-buffer nnimap-server-buffer)
- (nnheader-report 'nnimap "Could not authenticate to %s" server)))))
-
-(deffoo nnimap-open-server (server &optional defs)
- (nnheader-init-server-buffer)
- (if (nnimap-server-opened server)
- t
- (unless (assq 'nnimap-server-buffer defs)
- (push (list 'nnimap-server-buffer (concat " *nnimap* " server)) defs))
- ;; translate `nnimap-server-address' to `nnimap-address' in defs
- ;; for people that configured nnimap with a very old version
- (unless (assq 'nnimap-address defs)
- (if (assq 'nnimap-server-address defs)
- (push (list 'nnimap-address
- (cadr (assq 'nnimap-server-address defs))) defs)
- (push (list 'nnimap-address server) defs)))
- (nnoo-change-server 'nnimap server defs)
- (or nnimap-server-buffer
- (setq nnimap-server-buffer (cadr (assq 'nnimap-server-buffer defs))))
- (with-current-buffer (get-buffer-create nnimap-server-buffer)
- (nnoo-change-server 'nnimap server defs))
- (or (and nnimap-server-buffer
- (imap-opened nnimap-server-buffer)
- (if (with-current-buffer nnimap-server-buffer
- (memq imap-state '(auth select examine)))
- t
- (imap-close nnimap-server-buffer)
- (nnimap-open-connection server)))
- (nnimap-open-connection server))))
-
-(deffoo nnimap-server-opened (&optional server)
- "Whether SERVER is opened.
-If SERVER is the current virtual server, and the connection to the
-physical server is alive, this function return a non-nil value. If
-SERVER is nil, it is treated as the current server."
- ;; clean up autologouts??
- (and (or server nnimap-current-server)
- (nnoo-server-opened 'nnimap (or server nnimap-current-server))
- (imap-opened (nnimap-get-server-buffer server))))
-
-(deffoo nnimap-close-server (&optional server)
- "Close connection to server and free all resources connected to it.
-Return nil if the server couldn't be closed for some reason."
- (let ((server (or server nnimap-current-server)))
- (when (or (nnimap-server-opened server)
- (imap-opened (nnimap-get-server-buffer server)))
- (imap-close (nnimap-get-server-buffer server))
- (kill-buffer (nnimap-get-server-buffer server))
- (setq nnimap-server-buffer nil
- nnimap-current-server nil
- nnimap-server-buffer-alist
- (delq server nnimap-server-buffer-alist)))
- (nnoo-close-server 'nnimap server)))
-
-(deffoo nnimap-request-close ()
- "Close connection to all servers and free all resources that the backend have reserved.
-All buffers that have been created by that
-backend should be killed. (Not the nntp-server-buffer, though.) This
-function is generally only called when Gnus is shutting down."
- (mapcar (lambda (server) (nnimap-close-server (car server)))
- nnimap-server-buffer-alist)
- (setq nnimap-server-buffer-alist nil))
-
-(deffoo nnimap-status-message (&optional server)
- "This function returns the last error message from server."
- (when (nnimap-possibly-change-server server)
- (nnoo-status-message 'nnimap server)))
-
-(defun nnimap-demule (string)
- ;; BEWARE: we used to use string-as-multibyte here which is braindead
- ;; because it will turn accidental emacs-mule-valid byte sequences
- ;; into multibyte chars. --Stef
- ;; Reverted, braindead got 7.5 out of 10 on imdb, so it can't be
- ;; that bad. --Simon
- (funcall (if (and (fboundp 'string-as-multibyte)
- (subrp (symbol-function 'string-as-multibyte)))
- 'string-as-multibyte
- 'identity)
- (or string "")))
-
-(defun nnimap-make-callback (article gnus-callback buffer)
- "Return a callback function."
- `(lambda ()
- (nnimap-callback ,article ,gnus-callback ,buffer)))
-
-(defun nnimap-callback (article gnus-callback buffer)
- (when (eq article (imap-current-message))
- (remove-hook 'imap-fetch-data-hook
- (nnimap-make-callback article gnus-callback buffer))
- (with-current-buffer buffer
- (insert
- (with-current-buffer nnimap-server-buffer
- (nnimap-demule
- (if (imap-capability 'IMAP4rev1)
- ;; xxx don't just use car? alist doesn't contain
- ;; anything else now, but it might...
- (nth 2 (car (imap-message-get article 'BODYDETAIL)))
- (imap-message-get article 'RFC822)))))
- (nnheader-ms-strip-cr)
- (funcall gnus-callback t))))
-
-(defun nnimap-request-article-part (article part prop &optional
- group server to-buffer detail)
- (when (nnimap-possibly-change-group group server)
- (let ((article (if (stringp article)
- (car-safe (imap-search
- (format "HEADER Message-Id \"%s\"" article)
- nnimap-server-buffer))
- article)))
- (when article
- (gnus-message 10 "nnimap: Fetching (part of) article %d from %s..."
- article (or group imap-current-mailbox
- gnus-newsgroup-name))
- (if (not nnheader-callback-function)
- (with-current-buffer (or to-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((data (imap-fetch article part prop nil
- nnimap-server-buffer)))
- (insert (nnimap-demule (if detail
- (nth 2 (car data))
- data))))
- (nnheader-ms-strip-cr)
- (gnus-message
- 10 "nnimap: Fetching (part of) article %d from %s...done"
- article (or group imap-current-mailbox gnus-newsgroup-name))
- (if (bobp)
- (nnheader-report 'nnimap "No such article %d in %s: %s"
- article (or group imap-current-mailbox
- gnus-newsgroup-name)
- (imap-error-text nnimap-server-buffer))
- (cons group article)))
- (add-hook 'imap-fetch-data-hook
- (nnimap-make-callback article
- nnheader-callback-function
- nntp-server-buffer))
- (imap-fetch-asynch article part nil nnimap-server-buffer)
- (cons group article))))))
-
-(deffoo nnimap-asynchronous-p ()
- t)
-
-(deffoo nnimap-request-article (article &optional group server to-buffer)
- (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
- (nnimap-request-article-part
- article "BODY.PEEK[]" 'BODYDETAIL group server to-buffer 'detail)
- (nnimap-request-article-part
- article "RFC822.PEEK" 'RFC822 group server to-buffer)))
-
-(deffoo nnimap-request-head (article &optional group server to-buffer)
- (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
- (nnimap-request-article-part
- article "BODY.PEEK[HEADER]" 'BODYDETAIL group server to-buffer 'detail)
- (nnimap-request-article-part
- article "RFC822.HEADER" 'RFC822.HEADER group server to-buffer)))
-
-(deffoo nnimap-request-body (article &optional group server to-buffer)
- (if (imap-capability 'IMAP4rev1 nnimap-server-buffer)
- (nnimap-request-article-part
- article "BODY.PEEK[TEXT]" 'BODYDETAIL group server to-buffer 'detail)
- (nnimap-request-article-part
- article "RFC822.TEXT.PEEK" 'RFC822.TEXT group server to-buffer)))
-
-(deffoo nnimap-request-group (group &optional server fast)
- (nnimap-request-update-info-internal
- group
- (gnus-get-info (gnus-group-prefixed-name
- group (gnus-server-to-method (format "nnimap:%s" server))))
- server)
- (when (nnimap-possibly-change-group group server)
- (nnimap-before-find-minmax-bugworkaround)
- (let (info)
- (cond (fast group)
- ((null (setq info (nnimap-find-minmax-uid group t)))
- (nnheader-report 'nnimap "Could not get active info for %s"
- group))
- (t
- (nnheader-insert "211 %d %d %d %s\n" (or (nth 0 info) 0)
- (max 1 (or (nth 1 info) 1))
- (or (nth 2 info) 0) group)
- (nnheader-report 'nnimap "Group %s selected" group)
- t)))))
-
-(defun nnimap-update-unseen (group &optional server)
- "Update the unseen count in `nnimap-mailbox-info'."
- (gnus-sethash
- (gnus-group-prefixed-name group server)
- (let ((old (gnus-gethash-safe (gnus-group-prefixed-name group server)
- nnimap-mailbox-info)))
- (list (nth 0 old) (nth 1 old)
- (imap-mailbox-status group 'unseen nnimap-server-buffer)
- (nth 3 old)))
- nnimap-mailbox-info))
-
-(defun nnimap-close-group (group &optional server)
- (with-current-buffer nnimap-server-buffer
- (when (and (imap-opened)
- (nnimap-possibly-change-group group server))
- (nnimap-update-unseen group server)
- (case nnimap-expunge-on-close
- (always (progn
- (imap-mailbox-expunge nnimap-close-asynchronous)
- (unless nnimap-dont-close
- (imap-mailbox-close nnimap-close-asynchronous))))
- (ask (if (and (imap-search "DELETED")
- (gnus-y-or-n-p (format "Expunge articles in group `%s'? "
- imap-current-mailbox)))
- (progn
- (imap-mailbox-expunge nnimap-close-asynchronous)
- (unless nnimap-dont-close
- (imap-mailbox-close nnimap-close-asynchronous)))
- (imap-mailbox-unselect)))
- (t (imap-mailbox-unselect)))
- (not imap-current-mailbox))))
-
-(defun nnimap-pattern-to-list-arguments (pattern)
- (mapcar (lambda (p)
- (cons (car-safe p) (or (cdr-safe p) p)))
- (if (and (listp pattern)
- (listp (cdr pattern)))
- pattern
- (list pattern))))
-
-(deffoo nnimap-request-list (&optional server)
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nntp-server-buffer
- (erase-buffer))
- (gnus-message 5 "nnimap: Generating active list%s..."
- (if (> (length server) 0) (concat " for " server) ""))
- (nnimap-before-find-minmax-bugworkaround)
- (with-current-buffer nnimap-server-buffer
- (dolist (pattern (nnimap-pattern-to-list-arguments nnimap-list-pattern))
- (dolist (mbx (funcall nnimap-request-list-method
- (cdr pattern) (car pattern)))
- (or (member "\\NoSelect" (imap-mailbox-get 'list-flags mbx))
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
- (when info
- (with-current-buffer nntp-server-buffer
- (insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))))
- (gnus-message 5 "nnimap: Generating active list%s...done"
- (if (> (length server) 0) (concat " for " server) ""))
- t))
-
-(deffoo nnimap-request-post (&optional server)
- (let ((success t))
- (dolist (mbx (message-unquote-tokens
- (message-tokenize-header
- (message-fetch-field "Newsgroups") ", ")) success)
- (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
- (or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
- (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
- to-newsgroup))
- (or (and (gnus-request-create-group
- to-newsgroup gnus-command-method)
- (gnus-activate-group to-newsgroup nil nil
- gnus-command-method))
- (error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
- (unless (nnimap-request-accept-article mbx (nth 1 gnus-command-method))
- (setq success nil))))))
-
-;; Optional backend functions
-
-(defun nnimap-string-lessp-numerical (s1 s2)
- "Return t if first arg string is less than second in numerical order."
- (cond ((string= s1 s2)
- nil)
- ((> (length s1) (length s2))
- nil)
- ((< (length s1) (length s2))
- t)
- ((< (string-to-number (substring s1 0 1))
- (string-to-number (substring s2 0 1)))
- t)
- ((> (string-to-number (substring s1 0 1))
- (string-to-number (substring s2 0 1)))
- nil)
- (t
- (nnimap-string-lessp-numerical (substring s1 1) (substring s2 1)))))
-
-(deffoo nnimap-retrieve-groups (groups &optional server)
- (when (nnimap-possibly-change-server server)
- (gnus-message 5 "nnimap: Checking mailboxes...")
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (nnimap-before-find-minmax-bugworkaround)
- (let (asyncgroups slowgroups)
- (if (null nnimap-retrieve-groups-asynchronous)
- (setq slowgroups groups)
- (dolist (group groups)
- (gnus-message 9 "nnimap: Quickly checking mailbox %s" group)
- (add-to-list (if (gnus-gethash-safe
- (gnus-group-prefixed-name group server)
- nnimap-mailbox-info)
- 'asyncgroups
- 'slowgroups)
- (list group (imap-mailbox-status-asynch
- group '(uidvalidity uidnext unseen)
- nnimap-server-buffer))))
- (dolist (asyncgroup asyncgroups)
- (let ((group (nth 0 asyncgroup))
- (tag (nth 1 asyncgroup))
- new old)
- (when (imap-ok-p (imap-wait-for-tag tag nnimap-server-buffer))
- (if (or (not (string=
- (nth 0 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidvalidity group
- nnimap-server-buffer)))
- (not (string=
- (nth 1 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))
- (imap-mailbox-get 'uidnext group
- nnimap-server-buffer))))
- (push (list group) slowgroups)
- (insert (nth 3 (gnus-gethash (gnus-group-prefixed-name
- group server)
- nnimap-mailbox-info))))))))
- (dolist (group slowgroups)
- (if nnimap-retrieve-groups-asynchronous
- (setq group (car group)))
- (gnus-message 7 "nnimap: Mailbox %s modified" group)
- (imap-mailbox-put 'uidnext nil group nnimap-server-buffer)
- (or (member "\\NoSelect" (imap-mailbox-get 'list-flags group
- nnimap-server-buffer))
- (let* ((info (nnimap-find-minmax-uid group 'examine))
- (str (format "\"%s\" %d %d y\n" group
- (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))
- (when (> (or (imap-mailbox-get 'recent group
- nnimap-server-buffer) 0)
- 0)
- (push (list (cons group 0)) nnmail-split-history))
- (insert str)
- (when nnimap-retrieve-groups-asynchronous
- (gnus-sethash
- (gnus-group-prefixed-name group server)
- (list (or (imap-mailbox-get
- 'uidvalidity group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidvalidity nnimap-server-buffer))
- (or (imap-mailbox-get
- 'uidnext group nnimap-server-buffer)
- (imap-mailbox-status
- group 'uidnext nnimap-server-buffer))
- (or (imap-mailbox-get
- 'unseen group nnimap-server-buffer)
- (imap-mailbox-status
- group 'unseen nnimap-server-buffer))
- str)
- nnimap-mailbox-info)))))))
- (gnus-message 5 "nnimap: Checking mailboxes...done")
- 'active))
-
-(deffoo nnimap-request-update-info-internal (group info &optional server)
- (when (nnimap-possibly-change-group group server)
- (when info ;; xxx what does this mean? should we create a info?
- (with-current-buffer nnimap-server-buffer
- (gnus-message 5 "nnimap: Updating info for %s..."
- (gnus-info-group info))
-
- (when (nnimap-mark-permanent-p 'read)
- (let (seen unseen)
- ;; read info could contain articles marked unread by other
- ;; imap clients! we correct this
- (setq unseen (gnus-compress-sequence
- (imap-search "UNSEEN UNDELETED"))
- seen (gnus-range-difference (gnus-info-read info) unseen)
- seen (gnus-range-add seen
- (gnus-compress-sequence
- (imap-search "SEEN")))
- seen (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen))
- (gnus-info-set-read info seen)))
-
- (mapcar (lambda (pred)
- (when (or (eq (cdr pred) 'recent)
- (and (nnimap-mark-permanent-p (cdr pred))
- (member (nnimap-mark-to-flag (cdr pred))
- (imap-mailbox-get 'flags))))
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (gnus-compress-sequence
- (imap-search (nnimap-mark-to-predicate (cdr pred))))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
-
- (when nnimap-importantize-dormant
- ;; nnimap mark dormant article as ticked too (for other clients)
- ;; so we remove that mark for gnus since we support dormant
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- 'tick
- (gnus-remove-from-range
- (cdr-safe (assoc 'tick (gnus-info-marks info)))
- (cdr-safe (assoc 'dormant (gnus-info-marks info))))
- (gnus-info-marks info))
- t))
-
- (gnus-message 5 "nnimap: Updating info for %s...done"
- (gnus-info-group info))
-
- info))))
-
-(deffoo nnimap-request-type (group &optional article)
- (if (and nnimap-news-groups (string-match nnimap-news-groups group))
- 'news
- 'mail))
-
-(deffoo nnimap-request-set-mark (group actions &optional server)
- (when (nnimap-possibly-change-group group server)
- (with-current-buffer nnimap-server-buffer
- (let (action)
- (gnus-message 7 "nnimap: Setting marks in %s..." group)
- (while (setq action (pop actions))
- (let ((range (nth 0 action))
- (what (nth 1 action))
- (cmdmarks (nth 2 action))
- marks)
- ;; bookmark can't be stored (not list/range
- (setq cmdmarks (delq 'bookmark cmdmarks))
- ;; killed can't be stored (not list/range
- (setq cmdmarks (delq 'killed cmdmarks))
- ;; unsent are for nndraft groups only
- (setq cmdmarks (delq 'unsent cmdmarks))
- ;; cache flags are pointless on the server
- (setq cmdmarks (delq 'cache cmdmarks))
- ;; seen flags are local to each gnus
- (setq cmdmarks (delq 'seen cmdmarks))
- ;; recent marks can't be set
- (setq cmdmarks (delq 'recent cmdmarks))
- (when nnimap-importantize-dormant
- ;; flag dormant articles as ticked
- (if (memq 'dormant cmdmarks)
- (setq cmdmarks (cons 'tick cmdmarks))))
- ;; remove stuff we are forbidden to store
- (mapcar (lambda (mark)
- (if (imap-message-flag-permanent-p
- (nnimap-mark-to-flag mark))
- (setq marks (cons mark marks))))
- cmdmarks)
- (when (and range marks)
- (cond ((eq what 'del)
- (imap-message-flags-del
- (imap-range-to-message-set range)
- (nnimap-mark-to-flag marks nil t)))
- ((eq what 'add)
- (imap-message-flags-add
- (imap-range-to-message-set range)
- (nnimap-mark-to-flag marks nil t)))
- ((eq what 'set)
- (imap-message-flags-set
- (imap-range-to-message-set range)
- (nnimap-mark-to-flag marks nil t)))))))
- (gnus-message 7 "nnimap: Setting marks in %s...done" group))))
- nil)
-
-(defun nnimap-split-fancy ()
- "Like the function `nnmail-split-fancy', but uses `nnimap-split-fancy'."
- (let ((nnmail-split-fancy nnimap-split-fancy))
- (nnmail-split-fancy)))
-
-(defun nnimap-split-to-groups (rules)
- ;; tries to match all rules in nnimap-split-rule against content of
- ;; nntp-server-buffer, returns a list of groups that matched.
- (with-current-buffer nntp-server-buffer
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- (if (functionp rules)
- (funcall rules)
- (let (to-groups regrepp)
- (catch 'split-done
- (dolist (rule rules to-groups)
- (let ((group (car rule))
- (regexp (cadr rule)))
- (goto-char (point-min))
- (when (and (if (stringp regexp)
- (progn
- (if (not (stringp group))
- (setq group (eval group))
- (setq regrepp
- (string-match "\\\\[0-9&]" group)))
- (re-search-forward regexp nil t))
- (funcall regexp group))
- ;; Don't enter the article into the same group twice.
- (not (assoc group to-groups)))
- (push (if regrepp
- (nnmail-expand-newtext group)
- group)
- to-groups)
- (or nnimap-split-crosspost
- (throw 'split-done to-groups))))))))))
-
-(defun nnimap-assoc-match (key alist)
- (let (element)
- (while (and alist (not element))
- (if (string-match (car (car alist)) key)
- (setq element (car alist)))
- (setq alist (cdr alist)))
- element))
-
-(defun nnimap-split-find-rule (server inbox)
- (if (and (listp nnimap-split-rule) (listp (car nnimap-split-rule))
- (list (cdar nnimap-split-rule)) (listp (cadar nnimap-split-rule)))
- ;; extended format
- (cadr (nnimap-assoc-match inbox (cdr (nnimap-assoc-match
- server nnimap-split-rule))))
- nnimap-split-rule))
-
-(defun nnimap-split-find-inbox (server)
- (if (listp nnimap-split-inbox)
- nnimap-split-inbox
- (list nnimap-split-inbox)))
-
-(defun nnimap-split-articles (&optional group server)
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (let (rule inbox removeorig (inboxes (nnimap-split-find-inbox server)))
- ;; iterate over inboxes
- (while (and (setq inbox (pop inboxes))
- (nnimap-possibly-change-group inbox)) ;; SELECT
- ;; find split rule for this server / inbox
- (when (setq rule (nnimap-split-find-rule server inbox))
- ;; iterate over articles
- (dolist (article (imap-search nnimap-split-predicate))
- (when (if (if (eq nnimap-split-download-body 'default)
- nnimap-split-download-body-default
- nnimap-split-download-body)
- (and (nnimap-request-article article)
- (with-current-buffer nntp-server-buffer (mail-narrow-to-head)))
- (nnimap-request-head article))
- ;; copy article to right group(s)
- (setq removeorig nil)
- (dolist (to-group (nnimap-split-to-groups rule))
- (cond ((eq to-group 'junk)
- (message "IMAP split removed %s:%s:%d" server inbox
- article)
- (setq removeorig t))
- ((imap-message-copy (number-to-string article)
- to-group nil 'nocopyuid)
- (message "IMAP split moved %s:%s:%d to %s" server
- inbox article to-group)
- (setq removeorig t)
- (when nnmail-cache-accepted-message-ids
- (with-current-buffer nntp-server-buffer
- (let (msgid)
- (and (setq msgid
- (nnmail-fetch-field "message-id"))
- (nnmail-cache-insert msgid
- to-group
- (nnmail-fetch-field "subject"))))))
- ;; Add the group-art list to the history list.
- (push (list (cons to-group 0)) nnmail-split-history))
- (t
- (message "IMAP split failed to move %s:%s:%d to %s"
- server inbox article to-group))))
- (if (if (eq nnimap-split-download-body 'default)
- nnimap-split-download-body-default
- nnimap-split-download-body)
- (widen))
- ;; remove article if it was successfully copied somewhere
- (and removeorig
- (imap-message-flags-add (format "%d" article)
- "\\Seen \\Deleted")))))
- (when (imap-mailbox-select inbox) ;; just in case
- ;; todo: UID EXPUNGE (if available) to remove splitted articles
- (imap-mailbox-expunge)
- (imap-mailbox-close)))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close))
- t))))
-
-(deffoo nnimap-request-scan (&optional group server)
- (nnimap-split-articles group server))
-
-(deffoo nnimap-request-newgroups (date &optional server)
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nntp-server-buffer
- (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s..."
- (if (> (length server) 0) " on " "") server)
- (erase-buffer)
- (nnimap-before-find-minmax-bugworkaround)
- (dolist (pattern (nnimap-pattern-to-list-arguments
- nnimap-list-pattern))
- (dolist (mbx (imap-mailbox-lsub (cdr pattern) (car pattern) nil
- nnimap-server-buffer))
- (or (catch 'found
- (dolist (mailbox (imap-mailbox-get 'list-flags mbx
- nnimap-server-buffer))
- (if (string= (downcase mailbox) "\\noselect")
- (throw 'found t)))
- nil)
- (let ((info (nnimap-find-minmax-uid mbx 'examine)))
- (when info
- (insert (format "\"%s\" %d %d y\n"
- mbx (or (nth 2 info) 0)
- (max 1 (or (nth 1 info) 1)))))))))
- (gnus-message 5 "nnimap: Listing subscribed mailboxes%s%s...done"
- (if (> (length server) 0) " on " "") server))
- t))
-
-(deffoo nnimap-request-create-group (group &optional server args)
- (when (nnimap-possibly-change-server server)
- (or (imap-mailbox-status group 'uidvalidity nnimap-server-buffer)
- (imap-mailbox-create group nnimap-server-buffer)
- (nnheader-report 'nnimap "%S"
- (imap-error-text nnimap-server-buffer)))))
-
-(defun nnimap-time-substract (time1 time2)
- "Return TIME for TIME1 - TIME2."
- (let* ((ms (- (car time1) (car time2)))
- (ls (- (nth 1 time1) (nth 1 time2))))
- (if (< ls 0)
- (list (- ms 1) (+ (expt 2 16) ls))
- (list ms ls))))
-
-(eval-when-compile (require 'parse-time))
-(defun nnimap-date-days-ago (daysago)
- "Return date, in format \"3-Aug-1998\", for DAYSAGO days ago."
- (require 'parse-time)
- (let* ((time (nnimap-time-substract (current-time) (days-to-time daysago)))
- (date (format-time-string
- (format "%%d-%s-%%Y"
- (capitalize (car (rassoc (nth 4 (decode-time time))
- parse-time-months))))
- time)))
- (if (eq ?0 (string-to-char date))
- (substring date 1)
- date)))
-
-(defun nnimap-request-expire-articles-progress ()
- (gnus-message 5 "nnimap: Marking article %d for deletion..."
- imap-current-message))
-
-(defun nnimap-expiry-target (arts group server)
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (dolist (art arts)
- (nnimap-request-article art group server (current-buffer))
- ;; hints for optimization in `nnimap-request-accept-article'
- (let ((nnimap-current-move-article art)
- (nnimap-current-move-group group)
- (nnimap-current-move-server server))
- (nnmail-expiry-target-group nnmail-expiry-target group))))
- ;; It is not clear if `nnmail-expiry-target' somehow cause the
- ;; current group to be changed or not, so we make sure here.
- (nnimap-possibly-change-group group server)))
-
-;; Notice that we don't actually delete anything, we just mark them deleted.
-(deffoo nnimap-request-expire-articles (articles group &optional server force)
- (let ((artseq (gnus-compress-sequence articles)))
- (when (and artseq (nnimap-possibly-change-group group server))
- (with-current-buffer nnimap-server-buffer
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((or force (eq days 'immediate))
- (let ((oldarts (imap-search
- (concat "UID "
- (imap-range-to-message-set artseq)))))
- (when oldarts
- (nnimap-expiry-target oldarts group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts)) "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts))))))
- ((and nnimap-search-uids-not-since-is-evil (numberp days))
- (let* ((all-new-articles
- (gnus-compress-sequence
- (imap-search (format "SINCE %s"
- (nnimap-date-days-ago days)))))
- (oldartseq
- (gnus-range-difference artseq all-new-articles))
- (oldarts (gnus-uncompress-range oldartseq)))
- (when oldarts
- (nnimap-expiry-target oldarts group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set oldartseq)
- "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts))))))
- ((numberp days)
- (let ((oldarts (imap-search
- (format nnimap-expunge-search-string
- (imap-range-to-message-set artseq)
- (nnimap-date-days-ago days))))
- (imap-fetch-data-hook
- '(nnimap-request-expire-articles-progress)))
- (when oldarts
- (nnimap-expiry-target oldarts group server)
- (when (imap-message-flags-add
- (imap-range-to-message-set
- (gnus-compress-sequence oldarts)) "\\Deleted")
- (setq articles (gnus-set-difference
- articles oldarts)))))))))))
- ;; return articles not deleted
- articles)
-
-(deffoo nnimap-request-move-article (article group server
- accept-form &optional last)
- (when (nnimap-possibly-change-server server)
- (save-excursion
- (let ((buf (get-buffer-create " *nnimap move*"))
- (nnimap-current-move-article article)
- (nnimap-current-move-group group)
- (nnimap-current-move-server nnimap-current-server)
- result)
- (and (nnimap-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (buffer-disable-undo (current-buffer))
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer buf)
- result)
- (nnimap-possibly-change-group group server)
- (imap-message-flags-add
- (imap-range-to-message-set (list article))
- "\\Deleted" 'silent nnimap-server-buffer))
- result))))
-
-(deffoo nnimap-request-accept-article (group &optional server last)
- (when (nnimap-possibly-change-server server)
- (let (uid)
- (if (setq uid
- (if (string= nnimap-current-server nnimap-current-move-server)
- ;; moving article within same server, speed it up...
- (and (nnimap-possibly-change-group
- nnimap-current-move-group)
- (imap-message-copy (number-to-string
- nnimap-current-move-article)
- group 'dontcreate nil
- nnimap-server-buffer))
- (with-current-buffer (current-buffer)
- (goto-char (point-min))
- ;; remove any 'From blabla' lines, some IMAP servers
- ;; reject the entire message otherwise.
- (when (looking-at "^From[^:]")
- (delete-region (point) (progn (forward-line) (point))))
- ;; turn into rfc822 format (\r\n eol's)
- (while (search-forward "\n" nil t)
- (replace-match "\r\n"))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject"))))
- (when (and last nnmail-cache-accepted-message-ids)
- (nnmail-cache-close))
- ;; this 'or' is for Cyrus server bug
- (or (null (imap-current-mailbox nnimap-server-buffer))
- (imap-mailbox-unselect nnimap-server-buffer))
- (imap-message-append group (current-buffer) nil nil
- nnimap-server-buffer)))
- (cons group (nth 1 uid))
- (nnheader-report 'nnimap (imap-error-text nnimap-server-buffer))))))
-
-(deffoo nnimap-request-delete-group (group force &optional server)
- (when (nnimap-possibly-change-server server)
- (with-current-buffer nnimap-server-buffer
- (if force
- (or (null (imap-mailbox-status group 'uidvalidity))
- (imap-mailbox-delete group))
- ;; UNSUBSCRIBE?
- t))))
-
-(deffoo nnimap-request-rename-group (group new-name &optional server)
- (when (nnimap-possibly-change-server server)
- (imap-mailbox-rename group new-name nnimap-server-buffer)))
-
-(defun nnimap-expunge (mailbox server)
- (when (nnimap-possibly-change-group mailbox server)
- (imap-mailbox-expunge nil nnimap-server-buffer)))
-
-(defun nnimap-acl-get (mailbox server)
- (when (nnimap-possibly-change-server server)
- (and (imap-capability 'ACL nnimap-server-buffer)
- (imap-mailbox-acl-get mailbox nnimap-server-buffer))))
-
-(defun nnimap-acl-edit (mailbox method old-acls new-acls)
- (when (nnimap-possibly-change-server (cadr method))
- (unless (imap-capability 'ACL nnimap-server-buffer)
- (error "Your server does not support ACL editing"))
- (with-current-buffer nnimap-server-buffer
- ;; delete all removed identifiers
- (mapcar (lambda (old-acl)
- (unless (assoc (car old-acl) new-acls)
- (or (imap-mailbox-acl-delete (car old-acl) mailbox)
- (error "Can't delete ACL for %s" (car old-acl)))))
- old-acls)
- ;; set all changed acl's
- (mapcar (lambda (new-acl)
- (let ((new-rights (cdr new-acl))
- (old-rights (cdr (assoc (car new-acl) old-acls))))
- (unless (and old-rights new-rights
- (string= old-rights new-rights))
- (or (imap-mailbox-acl-set (car new-acl) new-rights mailbox)
- (error "Can't set ACL for %s to %s" (car new-acl)
- new-rights)))))
- new-acls)
- t)))
-
-\f
-;;; Internal functions
-
-;;
-;; This is confusing.
-;;
-;; mark => read, tick, draft, reply etc
-;; flag => "\\Seen", "\\Flagged", "\\Draft", "gnus-expire" etc
-;; predicate => "SEEN", "FLAGGED", "DRAFT", "KEYWORD gnus-expire" etc
-;;
-;; Mark should not really contain 'read since it's not a "mark" in the Gnus
-;; world, but we cheat. Mark == gnus-article-mark-lists + '(read . read).
-;;
-
-(defconst nnimap-mark-to-predicate-alist
- (mapcar
- (lambda (pair) ; cdr is the mark
- (or (assoc (cdr pair)
- '((read . "SEEN")
- (tick . "FLAGGED")
- (draft . "DRAFT")
- (recent . "RECENT")
- (reply . "ANSWERED")))
- (cons (cdr pair)
- (format "KEYWORD gnus-%s" (symbol-name (cdr pair))))))
- (cons '(read . read) gnus-article-mark-lists)))
-
-(defun nnimap-mark-to-predicate (pred)
- "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP predicate.
-This is a string such as \"SEEN\", \"FLAGGED\", \"KEYWORD gnus-expire\",
-to be used within a IMAP SEARCH query."
- (cdr (assq pred nnimap-mark-to-predicate-alist)))
-
-(defconst nnimap-mark-to-flag-alist
- (mapcar
- (lambda (pair)
- (or (assoc (cdr pair)
- '((read . "\\Seen")
- (tick . "\\Flagged")
- (draft . "\\Draft")
- (recent . "\\Recent")
- (reply . "\\Answered")))
- (cons (cdr pair)
- (format "gnus-%s" (symbol-name (cdr pair))))))
- (cons '(read . read) gnus-article-mark-lists)))
-
-(defun nnimap-mark-to-flag-1 (preds)
- (if (and (not (null preds)) (listp preds))
- (cons (nnimap-mark-to-flag (car preds))
- (nnimap-mark-to-flag (cdr preds)))
- (cdr (assoc preds nnimap-mark-to-flag-alist))))
-
-(defun nnimap-mark-to-flag (preds &optional always-list make-string)
- "Convert a Gnus mark (a symbol such as read, tick, expire) to a IMAP flag.
-This is a string such as \"\\Seen\", \"\\Flagged\", \"gnus-expire\", to
-be used in a STORE FLAGS command."
- (let ((result (nnimap-mark-to-flag-1 preds)))
- (setq result (if (and (or make-string always-list)
- (not (listp result)))
- (list result)
- result))
- (if make-string
- (mapconcat (lambda (flag)
- (if (listp flag)
- (mapconcat 'identity flag " ")
- flag))
- result " ")
- result)))
-
-(defun nnimap-mark-permanent-p (mark &optional group)
- "Return t if MARK can be permanently (between IMAP sessions) saved on articles, in GROUP."
- (imap-message-flag-permanent-p (nnimap-mark-to-flag mark)))
-
-(when nnimap-debug
- (require 'trace)
- (buffer-disable-undo (get-buffer-create nnimap-debug-buffer))
- (mapcar (lambda (f) (trace-function-background f nnimap-debug-buffer))
- '(
- nnimap-possibly-change-server
- nnimap-verify-uidvalidity
- nnimap-find-minmax-uid
- nnimap-before-find-minmax-bugworkaround
- nnimap-possibly-change-group
- ;;nnimap-replace-whitespace
- nnimap-retrieve-headers-progress
- nnimap-retrieve-which-headers
- nnimap-group-overview-filename
- nnimap-retrieve-headers-from-file
- nnimap-retrieve-headers-from-server
- nnimap-retrieve-headers
- nnimap-open-connection
- nnimap-open-server
- nnimap-server-opened
- nnimap-close-server
- nnimap-request-close
- nnimap-status-message
- ;;nnimap-demule
- nnimap-request-article-part
- nnimap-request-article
- nnimap-request-head
- nnimap-request-body
- nnimap-request-group
- nnimap-close-group
- nnimap-pattern-to-list-arguments
- nnimap-request-list
- nnimap-request-post
- nnimap-retrieve-groups
- nnimap-request-update-info-internal
- nnimap-request-type
- nnimap-request-set-mark
- nnimap-split-to-groups
- nnimap-split-find-rule
- nnimap-split-find-inbox
- nnimap-split-articles
- nnimap-request-scan
- nnimap-request-newgroups
- nnimap-request-create-group
- nnimap-time-substract
- nnimap-date-days-ago
- nnimap-request-expire-articles-progress
- nnimap-request-expire-articles
- nnimap-request-move-article
- nnimap-request-accept-article
- nnimap-request-delete-group
- nnimap-request-rename-group
- gnus-group-nnimap-expunge
- gnus-group-nnimap-edit-acl
- gnus-group-nnimap-edit-acl-done
- nnimap-group-mode-hook
- nnimap-mark-to-predicate
- nnimap-mark-to-flag-1
- nnimap-mark-to-flag
- nnimap-mark-permanent-p
- )))
-
-(provide 'nnimap)
-
-;; arch-tag: 2b001f20-3ff9-4094-a0ad-46807c1ba70b
-;;; nnimap.el ends here
+++ /dev/null
-;;; nnir.el --- search mail with various search engines -*- coding: iso-8859-1 -*-
-;; Copyright (C) 1998 Kai Großjohann
-
-;; Author: Kai Großjohann <grossjohann@ls6.cs.uni-dortmund.de>
-;; Keywords: news, mail, searching, ir, glimpse, wais, hyrex
-
-;; This file is not part of GNU Emacs.
-
-;; This 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The most recent version of this can always be fetched from the Gnus
-;; CVS repository. See http://www.gnus.org/ for more information.
-
-;; This code is still in the development stage but I'd like other
-;; people to have a look at it. Please do not hesitate to contact me
-;; with your ideas.
-
-;; What does it do? Well, it allows you to index your mail using some
-;; search engine (freeWAIS-sf, Glimpse and others -- see later),
-;; then type `G G' in the Group buffer and issue a query to the search
-;; engine. You will then get a buffer which shows all articles
-;; matching the query, sorted by Retrieval Status Value (score).
-
-;; When looking at the retrieval result (in the Summary buffer) you
-;; can type `G T' (aka M-x gnus-summary-nnir-goto-thread RET) on an
-;; article. You will be teleported into the group this article came
-;; from, showing the thread this article is part of. (See below for
-;; restrictions.)
-
-;; The Lisp installation is simple: just put this file on your
-;; load-path, byte-compile it, and load it from ~/.gnus or something.
-;; This will install a new command `G G' in your Group buffer for
-;; searching your mail. Note that you also need to configure a number
-;; of variables, as described below.
-
-;; Restrictions:
-;;
-;; * If you don't use HyREX as your search engine, this expects that
-;; you use nnml or another one-file-per-message backend, because the
-;; others doesn't support nnfolder.
-;; * It can only search the mail backend's which are supported by one
-;; search engine, because of different query languages.
-;; * There are restrictions to the Glimpse setup.
-;; * There are restrictions to the Wais setup.
-;; * There are restrictions to the imap setup.
-;; * gnus-summary-nnir-goto-thread: Fetches whole group first, before
-;; limiting to the right articles. This is much too slow, of
-;; course. May issue a query for number of articles to fetch; you
-;; must accept the default of all articles at this point or things
-;; may break.
-
-;; The Lisp setup involves setting a few variables and setting up the
-;; search engine. You can define the variables in the server definition
-;; like this :
-;; (setq gnus-secondary-select-methods '(
-;; (nnimap "" (nnimap-address "localhost")
-;; (nnir-search-engine hyrex)
-;; (nnir-hyrex-additional-switches ("-d" "ddl-nnimap.xml"))
-;; )))
-;; Or you can define the global ones. The variables set in the mailer-
-;; definition will be used first.
-;; The variable to set is `nnir-search-engine'. Choose one of the engines
-;; listed in `nnir-engines'. (Actually `nnir-engines' is an alist,
-;; type `C-h v nnir-engines RET' for more information; this includes
-;; examples for setting `nnir-search-engine', too.)
-;;
-;; The variable nnir-mail-backend isn't used anymore.
-;;
-
-;; You must also set up a search engine. I'll tell you about the two
-;; search engines currently supported:
-
-;; 1. freeWAIS-sf
-;;
-;; As always with freeWAIS-sf, you need a so-called `format file'. I
-;; use the following file:
-;;
-;; ,-----
-;; | # Kai's format file for freeWAIS-sf for indexing mails.
-;; | # Each mail is in a file, much like the MH format.
-;; |
-;; | # Document separator should never match -- each file is a document.
-;; | record-sep: /^@this regex should never match@$/
-;; |
-;; | # Searchable fields specification.
-;; |
-;; | region: /^[sS]ubject:/ /^[sS]ubject: */
-;; | subject "Subject header" stemming TEXT BOTH
-;; | end: /^[^ \t]/
-;; |
-;; | region: /^([tT][oO]|[cC][cC]):/ /^([tT][oO]|[cC][cC]): */
-;; | to "To and Cc headers" SOUNDEX BOTH
-;; | end: /^[^ \t]/
-;; |
-;; | region: /^[fF][rR][oO][mM]:/ /^[fF][rR][oO][mM]: */
-;; | from "From header" SOUNDEX BOTH
-;; | end: /^[^ \t]/
-;; |
-;; | region: /^$/
-;; | stemming TEXT GLOBAL
-;; | end: /^@this regex should never match@$/
-;; `-----
-;;
-;; 1998-07-22: waisindex would dump core on me for large articles with
-;; the above settings. I used /^$/ as the end regex for the global
-;; field. That seemed to work okay.
-
-;; There is a Perl module called `WAIS.pm' which is available from
-;; CPAN as well as ls6-ftp.cs.uni-dortmund.de:/pub/wais/Perl. This
-;; module comes with a nifty tool called `makedb', which I use for
-;; indexing. Here's my `makedb.conf':
-;;
-;; ,-----
-;; | # Config file for makedb
-;; |
-;; | # Global options
-;; | waisindex = /usr/local/bin/waisindex
-;; | wais_opt = -stem -t fields
-;; | # `-stem' option necessary when `stemming' is specified for the
-;; | # global field in the *.fmt file
-;; |
-;; | # Own variables
-;; | homedir = /home/kai
-;; |
-;; | # The mail database.
-;; | database = mail
-;; | files = `find $homedir/Mail -name \*[0-9] -print`
-;; | dbdir = $homedir/.wais
-;; | limit = 100
-;; `-----
-;;
-;; The Lisp setup involves the `nnir-wais-*' variables. The most
-;; difficult to understand variable is probably
-;; `nnir-wais-remove-prefix'. Here's what it does: the output of
-;; `waissearch' basically contains the file name and the (full)
-;; directory name. As Gnus works with group names rather than
-;; directory names, the directory name is transformed into a group
-;; name as follows: first, a prefix is removed from the (full)
-;; directory name, then all `/' are replaced with `.'. The variable
-;; `nnir-wais-remove-prefix' should contain a regex matching exactly
-;; this prefix. It defaults to `$HOME/Mail/' (note the trailing
-;; slash).
-
-;; 2. Glimpse
-;;
-;; The code expects you to have one Glimpse index which contains all
-;; your mail files. The Lisp setup involves setting the
-;; `nnir-glimpse-*' variables. The most difficult to understand
-;; variable is probably `nnir-glimpse-remove-prefix', it corresponds
-;; to `nnir-wais-remove-prefix', see above. The `nnir-glimpse-home'
-;; variable should be set to the value of the `-H' option which allows
-;; one to search this Glimpse index. I have indexed my whole home
-;; directory with Glimpse, so I assume a default of `$HOME'.
-
-;; 3. Namazu
-;;
-;; The Namazu backend requires you to have one directory containing all
-;; index files, this is controlled by the `nnir-namazu-index-directory'
-;; variable. To function the `nnir-namazu-remove-prefix' variable must
-;; also be correct, see the documentation for `nnir-wais-remove-prefix'
-;; above.
-;;
-;; It is particularly important not to pass any any switches to namazu
-;; that will change the output format. Good switches to use include
-;; `--sort', `--ascending', `--early' and `--late'. Refer to the Namazu
-;; documentation for further information on valid switches.
-;;
-;; To index my mail with the `mknmz' program I use the following
-;; configuration file:
-;;
-;; ,----
-;; | package conf; # Don't remove this line!
-;; |
-;; | # Paths which will not be indexed. Don't use `^' or `$' anchors.
-;; | $EXCLUDE_PATH = "spam|sent";
-;; |
-;; | # Header fields which should be searchable. case-insensitive
-;; | $REMAIN_HEADER = "from|date|message-id|subject";
-;; |
-;; | # Searchable fields. case-insensitive
-;; | $SEARCH_FIELD = "from|date|message-id|subject";
-;; |
-;; | # The max length of a word.
-;; | $WORD_LENG_MAX = 128;
-;; |
-;; | # The max length of a field.
-;; | $MAX_FIELD_LENGTH = 256;
-;; `----
-;;
-;; My mail is stored in the directories ~/Mail/mail/, ~/Mail/lists/ and
-;; ~/Mail/archive/, so to index them I go to the directory set in
-;; `nnir-namazu-index-directory' and issue the following command.
-;;
-;; mknmz --mailnews ~/Mail/archive/ ~/Mail/mail/ ~/Mail/lists/
-;;
-;; For maximum searching efficiency I have a cron job set to run this
-;; command every four hours.
-
-;; 4. HyREX
-;;
-;; The HyREX backend requires you to have one directory from where all
-;; your relative paths are to, if you use them. This directory must be
-;; set in the `nnir-hyrex-index-directory' variable, which defaults to
-;; your home directory. You must also pass the base, class and
-;; directory options or simply your dll to the `nnir-hyrex-programm' by
-;; setting the `nnir-hyrex-additional-switches' variable accordently.
-;; To function the `nnir-hyrex-remove-prefix' variable must also be
-;; correct, see the documentation for `nnir-wais-remove-prefix' above.
-
-;; Developer information:
-
-;; I have tried to make the code expandable. Basically, it is divided
-;; into two layers. The upper layer is somewhat like the `nnvirtual'
-;; or `nnkiboze' backends: given a specification of what articles to
-;; show from another backend, it creates a group containing exactly
-;; those articles. The lower layer issues a query to a search engine
-;; and produces such a specification of what articles to show from the
-;; other backend.
-
-;; The interface between the two layers consists of the single
-;; function `nnir-run-query', which just selects the appropriate
-;; function for the search engine one is using. The input to
-;; `nnir-run-query' is a string, representing the query as input by
-;; the user. The output of `nnir-run-query' is supposed to be a
-;; vector, each element of which should in turn be a three-element
-;; vector. The first element should be full group name of the article,
-;; the second element should be the article number, and the third
-;; element should be the Retrieval Status Value (RSV) as returned from
-;; the search engine. An RSV is the score assigned to the document by
-;; the search engine. For Boolean search engines like Glimpse, the
-;; RSV is always 1000 (or 1 or 100, or whatever you like).
-
-;; The sorting order of the articles in the summary buffer created by
-;; nnir is based on the order of the articles in the above mentioned
-;; vector, so that's where you can do the sorting you'd like. Maybe
-;; it would be nice to have a way of displaying the search result
-;; sorted differently?
-
-;; So what do you need to do when you want to add another search
-;; engine? You write a function that executes the query. Temporary
-;; data from the search engine can be put in `nnir-tmp-buffer'. This
-;; function should return the list of articles as a vector, as
-;; described above. Then, you need to register this backend in
-;; `nnir-engines'. Then, users can choose the backend by setting
-;; `nnir-search-engine'.
-
-;; Todo, or future ideas:
-
-;; * Make it so that Glimpse can also be called without `-F'.
-;;
-;; * It should be possible to restrict search to certain groups.
-;;
-;; * There is currently no error checking.
-;;
-;; * The summary buffer display is currently really ugly, with all the
-;; added information in the subjects. How could I make this
-;; prettier?
-;;
-;; * A function which can be called from an nnir summary buffer which
-;; teleports you into the group the current article came from and
-;; shows you the whole thread this article is part of.
-;; Implementation suggestions?
-;; (1998-07-24: There is now a preliminary implementation, but
-;; it is much too slow and quite fragile.)
-;;
-;; * Support other mail backends. In particular, probably quite a few
-;; people use nnfolder. How would one go about searching nnfolders
-;; and producing the right data needed? The group name and the RSV
-;; are simple, but what about the article number?
-;; - The article number is encoded in the `X-Gnus-Article-Number'
-;; header of each mail.
-;; - The HyREX engine supports nnfolder.
-;;
-;; * Support compressed mail files. Probably, just stripping off the
-;; `.gz' or `.Z' file name extension is sufficient.
-;;
-;; * Support a find/grep combination.
-;;
-;; * At least for imap, the query is performed twice.
-;;
-
-;; Have you got other ideas?
-
-;;; Setup Code:
-
-(require 'cl)
-(require 'nnoo)
-(require 'gnus-group)
-(require 'gnus-sum)
-(eval-and-compile
- (require 'gnus-util))
-(eval-when-compile
- (require 'nnimap)
- (autoload 'read-kbd-macro "edmacro" nil t))
-
-(nnoo-declare nnir)
-(nnoo-define-basics nnir)
-
-(gnus-declare-backend "nnir" 'mail)
-
-(defvar nnir-imap-search-field "TEXT"
- "The IMAP search item when doing an nnir search")
-
-(defvar nnir-imap-search-arguments
- '(("Whole message" . "TEXT")
- ("Subject" . "SUBJECT")
- ("To" . "TO")
- ("From" . "FROM")
- (nil . "HEADER \"%s\""))
- "Mapping from user readable strings to IMAP search items for use in nnir")
-
-(defvar nnir-imap-search-argument-history ()
- "The history for querying search options in nnir")
-
-;;; Developer Extension Variable:
-
-(defvar nnir-engines
- `((glimpse nnir-run-glimpse
- ((group . "Group spec: ")))
- (wais nnir-run-waissearch
- ())
- (excite nnir-run-excite-search
- ())
- (imap nnir-run-imap
- ((criteria
- "Search in: " ; Prompt
- ,nnir-imap-search-arguments ; alist for completing
- nil ; no filtering
- nil ; allow any user input
- nil ; initial value
- nnir-imap-search-argument-history ; the history to use
- ,nnir-imap-search-field ; default
- )))
- (swish++ nnir-run-swish++
- ((group . "Group spec: ")))
- (swish-e nnir-run-swish-e
- ((group . "Group spec: ")))
- (namazu nnir-run-namazu
- ())
- (hyrex nnir-run-hyrex
- ((group . "Group spec: "))))
- "Alist of supported search engines.
-Each element in the alist is a three-element list (ENGINE FUNCTION ARGS).
-ENGINE is a symbol designating the searching engine. FUNCTION is also
-a symbol, giving the function that does the search. The third element
-ARGS is a list of cons pairs (PARAM . PROMPT). When issuing a query,
-the FUNCTION will issue a query for each of the PARAMs, using PROMPT.
-
-The value of `nnir-search-engine' must be one of the ENGINE symbols.
-For example, use the following line for searching using freeWAIS-sf:
- (setq nnir-search-engine 'wais)
-Use the following line if you read your mail via IMAP and your IMAP
-server supports searching:
- (setq nnir-search-engine 'imap)
-Note that you have to set additional variables for most backends. For
-example, the `wais' backend needs the variables `nnir-wais-program',
-`nnir-wais-database' and `nnir-wais-remove-prefix'.
-
-Add an entry here when adding a new search engine.")
-
-;;; User Customizable Variables:
-
-(defgroup nnir nil
- "Search nnmh and nnml groups in Gnus with Glimpse, freeWAIS-sf, or EWS."
- :group 'gnus)
-
-;; Mail backend.
-
-;; TODO:
-;; If `nil', use server parameters to find out which server to search. CCC
-;;
-(defcustom nnir-mail-backend '(nnml "")
- "*Specifies which backend should be searched.
-More precisely, this is used to determine from which backend to fetch the
-messages found.
-
-This must be equal to an existing server, so maybe it is best to use
-something like the following:
- (setq nnir-mail-backend (nth 0 gnus-secondary-select-methods))
-The above line works fine if the mail backend you want to search is
-the first element of gnus-secondary-select-methods (`nth' starts counting
-at zero)."
- :type '(sexp)
- :group 'nnir)
-
-;; Search engine to use.
-
-(defcustom nnir-search-engine 'wais
- "*The search engine to use. Must be a symbol.
-See `nnir-engines' for a list of supported engines, and for example
-settings of `nnir-search-engine'."
- :type '(sexp)
- :group 'nnir)
-
-;; Glimpse engine.
-
-(defcustom nnir-glimpse-program "glimpse"
- "*Name of Glimpse executable."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-glimpse-home (getenv "HOME")
- "*Value of `-H' glimpse option.
-`~' and environment variables must be expanded, see the functions
-`expand-file-name' and `substitute-in-file-name'."
- :type '(directory)
- :group 'nnir)
-
-(defcustom nnir-glimpse-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by Glimpse
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
-
-For example, suppose that Glimpse returns file names such as
-\"/home/john/Mail/mail/misc/42\". For this example, use the following
-setting: (setq nnir-glimpse-remove-prefix \"/home/john/Mail/\")
-Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
-`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
-arrive at the correct group name, \"mail.misc\"."
- :type '(regexp)
- :group 'nnir)
-
-(defcustom nnir-glimpse-additional-switches '("-i")
- "*A list of strings, to be given as additional arguments to glimpse.
-The switches `-H', `-W', `-l' and `-y' are always used -- calling
-glimpse without them does not make sense in our situation.
-Suggested elements to put here are `-i' and `-w'.
-
-Note that this should be a list. Ie, do NOT use the following:
- (setq nnir-glimpse-additional-switches \"-i -w\") ; wrong!
-Instead, use this:
- (setq nnir-glimpse-additional-switches '(\"-i\" \"-w\"))"
- :type '(repeat (string))
- :group 'nnir)
-
-;; freeWAIS-sf.
-
-(defcustom nnir-wais-program "waissearch"
- "*Name of waissearch executable."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-wais-database (expand-file-name "~/.wais/mail")
- "*Name of Wais database containing the mail.
-
-Note that this should be a file name without extension. For example,
-if you have a file /home/john/.wais/mail.fmt, use this:
- (setq nnir-wais-database \"/home/john/.wais/mail\")
-The string given here is passed to `waissearch -d' as-is."
- :type '(file)
- :group 'nnir)
-
-(defcustom nnir-wais-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each directory name returned by waissearch
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
-
-This variable is similar to `nnir-glimpse-remove-prefix', only for Wais,
-not Glimpse."
- :type '(regexp)
- :group 'nnir)
-
-;; EWS (Excite for Web Servers) engine.
-
-(defcustom nnir-excite-aquery-program "aquery.pl"
- "*Name of the EWS query program. Should be `aquery.pl' or a path to same."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-excite-collection "Mail"
- "*Name of the EWS collection to search."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-excite-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by EWS
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
-
-This variable is very similar to `nnir-glimpse-remove-prefix', except
-that it is for EWS, not Glimpse."
- :type '(regexp)
- :group 'nnir)
-
-;; Swish++. Next three variables Copyright (C) 2000, 2001 Christoph
-;; Conrad <christoph.conrad@gmx.de>.
-;; Swish++ home page: http://homepage.mac.com/pauljlucas/software/swish/
-
-(defcustom nnir-swish++-configuration-file
- (expand-file-name "~/Mail/swish++.conf")
- "*Configuration file for swish++."
- :type '(file)
- :group 'nnir)
-
-(defcustom nnir-swish++-program "search"
- "*Name of swish++ search executable."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-swish++-additional-switches '()
- "*A list of strings, to be given as additional arguments to swish++.
-
-Note that this should be a list. Ie, do NOT use the following:
- (setq nnir-swish++-additional-switches \"-i -w\") ; wrong
-Instead, use this:
- (setq nnir-swish++-additional-switches '(\"-i\" \"-w\"))"
- :type '(repeat (string))
- :group 'nnir)
-
-(defcustom nnir-swish++-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by swish++
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
-
-This variable is very similar to `nnir-glimpse-remove-prefix', except
-that it is for swish++, not Glimpse."
- :type '(regexp)
- :group 'nnir)
-
-;; Swish-E. Next three variables Copyright (C) 2000 Christoph Conrad
-;; <christoph.conrad@gmx.de>.
-;; URL: http://sunsite.berkeley.edu/SWISH-E/
-;; New version: http://www.boe.es/swish-e
-
-(defcustom nnir-swish-e-index-file
- (expand-file-name "~/Mail/index.swish-e")
- "*Index file for swish-e.
-This could be a server parameter."
- :type '(file)
- :group 'nnir)
-
-(defcustom nnir-swish-e-program "swish-e"
- "*Name of swish-e search executable.
-This cannot be a server parameter."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-swish-e-additional-switches '()
- "*A list of strings, to be given as additional arguments to swish-e.
-
-Note that this should be a list. Ie, do NOT use the following:
- (setq nnir-swish-e-additional-switches \"-i -w\") ; wrong
-Instead, use this:
- (setq nnir-swish-e-additional-switches '(\"-i\" \"-w\"))
-
-This could be a server parameter."
- :type '(repeat (string))
- :group 'nnir)
-
-(defcustom nnir-swish-e-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by swish-e
-in order to get a group name (albeit with / instead of .). This is a
-regular expression.
-
-This variable is very similar to `nnir-glimpse-remove-prefix', except
-that it is for swish-e, not Glimpse.
-
-This could be a server parameter."
- :type '(regexp)
- :group 'nnir)
-
-;; HyREX engine, see <URL:http://ls6-www.cs.uni-dortmund.de/>
-
-(defcustom nnir-hyrex-program "nnir-search"
- "*Name of the nnir-search executable."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-hyrex-additional-switches '()
- "*A list of strings, to be given as additional arguments for nnir-search.
-Note that this should be a list. Ie, do NOT use the following:
- (setq nnir-hyrex-additional-switches \"-ddl ddl.xml -c nnir\") ; wrong !
-Instead, use this:
- (setq nnir-hyrex-additional-switches '(\"-ddl\" \"ddl.xml\" \"-c\" \"nnir\"))"
- :type '(repeat (string))
- :group 'nnir)
-
-(defcustom nnir-hyrex-index-directory (getenv "HOME")
- "*Index directory for HyREX."
- :type '(directory)
- :group 'nnir)
-
-(defcustom nnir-hyrex-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by HyREX
-in order to get a group name (albeit with / instead of .).
-
-For example, suppose that HyREX returns file names such as
-\"/home/john/Mail/mail/misc/42\". For this example, use the following
-setting: (setq nnir-hyrex-remove-prefix \"/home/john/Mail/\")
-Note the trailing slash. Removing this prefix gives \"mail/misc/42\".
-`nnir' knows to remove the \"/42\" and to replace \"/\" with \".\" to
-arrive at the correct group name, \"mail.misc\"."
- :type '(directory)
- :group 'nnir)
-
-;; Namazu engine, see <URL:http://ww.namazu.org/>
-
-(defcustom nnir-namazu-program "namazu"
- "*Name of Namazu search executable."
- :type '(string)
- :group 'nnir)
-
-(defcustom nnir-namazu-index-directory (expand-file-name "~/Mail/namazu/")
- "*Index directory for Namazu."
- :type '(directory)
- :group 'nnir)
-
-(defcustom nnir-namazu-additional-switches '()
- "*A list of strings, to be given as additional arguments to namazu.
-The switches `-q', `-a', and `-s' are always used, very few other switches
-make any sense in this context.
-
-Note that this should be a list. Ie, do NOT use the following:
- (setq nnir-namazu-additional-switches \"-i -w\") ; wrong
-Instead, use this:
- (setq nnir-namazu-additional-switches '(\"-i\" \"-w\"))"
- :type '(repeat (string))
- :group 'nnir)
-
-(defcustom nnir-namazu-remove-prefix (concat (getenv "HOME") "/Mail/")
- "*The prefix to remove from each file name returned by Namazu
-in order to get a group name (albeit with / instead of .).
-
-This variable is very similar to `nnir-glimpse-remove-prefix', except
-that it is for Namazu, not Glimpse."
- :type '(directory)
- :group 'nnir)
-
-;;; Internal Variables:
-
-(defvar nnir-current-query nil
- "Internal: stores current query (= group name).")
-
-(defvar nnir-current-server nil
- "Internal: stores current server (does it ever change?).")
-
-(defvar nnir-current-group-marked nil
- "Internal: stores current list of process-marked groups.")
-
-(defvar nnir-artlist nil
- "Internal: stores search result.")
-
-(defvar nnir-tmp-buffer " *nnir*"
- "Internal: temporary buffer.")
-
-;;; Code:
-
-;; Gnus glue.
-
-(defun gnus-group-make-nnir-group (extra-parms query)
- "Create an nnir group. Asks for query."
- (interactive "P\nsQuery: ")
- (setq nnir-current-query nil
- nnir-current-server nil
- nnir-current-group-marked nil
- nnir-artlist nil)
- (let ((parms nil))
- (if extra-parms
- (setq parms (nnir-read-parms query))
- (setq parms (list (cons 'query query))))
- (gnus-group-read-ephemeral-group
- (concat "nnir:" (prin1-to-string parms)) '(nnir "") t
- (cons (current-buffer)
- gnus-current-window-configuration)
- nil)))
-
-;; Emacs 19 compatibility?
-(or (fboundp 'kbd) (defalias 'kbd 'read-kbd-macro))
-
-(defun nnir-group-mode-hook ()
- (define-key gnus-group-mode-map
- (if (fboundp 'read-kbd-macro)
- (kbd "G G")
- "GG") ; XEmacs 19 compat
- 'gnus-group-make-nnir-group))
-(add-hook 'gnus-group-mode-hook 'nnir-group-mode-hook)
-
-
-
-;; Summary mode commands.
-
-(defun gnus-summary-nnir-goto-thread ()
- "Only applies to nnir groups. Go to group this article came from
-and show thread that contains this article."
- (interactive)
- (unless (eq 'nnir (car (gnus-find-method-for-group gnus-newsgroup-name)))
- (error "Can't execute this command unless in nnir group."))
- (let* ((cur (gnus-summary-article-number))
- (group (nnir-artlist-artitem-group nnir-artlist cur))
- (backend-number (nnir-artlist-artitem-number nnir-artlist cur))
- server backend-group)
- (setq server (nnir-group-server group))
- (setq backend-group (gnus-group-real-name group))
- (gnus-group-read-ephemeral-group
- backend-group
- (gnus-server-to-method server)
- t ; activate
- (cons (current-buffer)
- 'summary) ; window config
- nil
- (list backend-number))
- (gnus-summary-limit (list backend-number))
- (gnus-summary-refer-thread)))
-
-(if (fboundp 'eval-after-load)
- (eval-after-load "gnus-sum"
- '(define-key gnus-summary-goto-map
- "T" 'gnus-summary-nnir-goto-thread))
- (add-hook 'gnus-summary-mode-hook
- (function (lambda ()
- (define-key gnus-summary-goto-map
- "T" 'gnus-summary-nnir-goto-thread)))))
-
-
-
-;; Gnus backend interface functions.
-
-(deffoo nnir-open-server (server &optional definitions)
- ;; Just set the server variables appropriately.
- (nnoo-change-server 'nnir server definitions))
-
-(deffoo nnir-request-group (group &optional server fast)
- "GROUP is the query string."
- (nnir-possibly-change-server server)
- ;; Check for cache and return that if appropriate.
- (if (and (equal group nnir-current-query)
- (equal gnus-group-marked nnir-current-group-marked)
- (or (null server)
- (equal server nnir-current-server)))
- nnir-artlist
- ;; Cache miss.
- (setq nnir-artlist (nnir-run-query group)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (if (zerop (length nnir-artlist))
- (progn
- (setq nnir-current-query nil
- nnir-current-server nil
- nnir-current-group-marked nil
- nnir-artlist nil)
- (nnheader-report 'nnir "Search produced empty results."))
- ;; Remember data for cache.
- (setq nnir-current-query group)
- (when server (setq nnir-current-server server))
- (setq nnir-current-group-marked gnus-group-marked)
- (nnheader-insert "211 %d %d %d %s\n"
- (nnir-artlist-length nnir-artlist) ; total #
- 1 ; first #
- (nnir-artlist-length nnir-artlist) ; last #
- group)))) ; group name
-
-(deffoo nnir-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (let ((artlist (copy-sequence articles))
- (idx 1)
- (art nil)
- (artitem nil)
- (artgroup nil) (artno nil)
- (artrsv nil)
- (artfullgroup nil)
- (novitem nil)
- (novdata nil)
- (foo nil)
- server)
- (while (not (null artlist))
- (setq art (car artlist))
- (or (numberp art)
- (nnheader-report
- 'nnir
- "nnir-retrieve-headers doesn't grok message ids: %s"
- art))
- (setq artitem (nnir-artlist-article nnir-artlist art))
- (setq artrsv (nnir-artitem-rsv artitem))
- (setq artfullgroup (nnir-artitem-group artitem))
- (setq artno (nnir-artitem-number artitem))
- (setq artgroup (gnus-group-real-name artfullgroup))
- (setq server (nnir-group-server artfullgroup))
- ;; retrieve NOV or HEAD data for this article, transform into
- ;; NOV data and prepend to `novdata'
- (set-buffer nntp-server-buffer)
- (nnir-possibly-change-server server)
- (case (setq foo (gnus-retrieve-headers (list artno) artfullgroup nil))
- (nov
- (goto-char (point-min))
- (setq novitem (nnheader-parse-nov))
- (unless novitem
- (pop-to-buffer nntp-server-buffer)
- (error
- "nnheader-parse-nov returned nil for article %s in group %s"
- artno artfullgroup)))
- (headers
- (goto-char (point-min))
- (setq novitem (nnheader-parse-head))
- (unless novitem
- (pop-to-buffer nntp-server-buffer)
- (error
- "nnheader-parse-head returned nil for article %s in group %s"
- artno artfullgroup)))
- (t (nnheader-report 'nnir "Don't support header type %s." foo)))
- ;; replace article number in original group with article number
- ;; in nnir group
- (mail-header-set-number novitem idx)
- (mail-header-set-from novitem
- (mail-header-from novitem))
- (mail-header-set-subject
- novitem
- (format "[%d: %s/%d] %s"
- artrsv artgroup artno
- (mail-header-subject novitem)))
- ;;-(mail-header-set-extra novitem nil)
- (push novitem novdata)
- (setq artlist (cdr artlist))
- (setq idx (1+ idx)))
- (setq novdata (nreverse novdata))
- (set-buffer nntp-server-buffer) (erase-buffer)
- (mapcar 'nnheader-insert-nov novdata)
- 'nov)))
-
-(deffoo nnir-request-article (article
- &optional group server to-buffer)
- (save-excursion
- (let* ((artitem (nnir-artlist-article nnir-artlist
- article))
- (artfullgroup (nnir-artitem-group artitem))
- (artno (nnir-artitem-number artitem))
- ;; Bug?
- ;; Why must we bind nntp-server-buffer here? It won't
- ;; work if `buf' is used, say. (Of course, the set-buffer
- ;; line below must then be updated, too.)
- (nntp-server-buffer (or to-buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (message "Requesting article %d from group %s"
- artno artfullgroup)
- (gnus-request-article artno artfullgroup nntp-server-buffer)
- (cons artfullgroup artno))))
-
-
-(nnoo-define-skeleton nnir)
-
-;;; Search Engine Interfaces:
-
-;; Glimpse interface.
-(defun nnir-run-glimpse (query server &optional group)
- "Run given query against glimpse. Returns a vector of (group name, file name)
-pairs (also vectors, actually)."
- (save-excursion
- (let ((artlist nil)
- (groupspec (cdr (assq 'group query)))
- (qstring (cdr (assq 'query query)))
- (prefix (nnir-read-server-parm 'nnir-glimps-remove-prefix server))
- artno dirnam)
- (when (and group groupspec)
- (error (concat "It does not make sense to use a group spec"
- " with process-marked groups.")))
- (when group
- (setq groupspec (gnus-group-real-name group)))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
- (if groupspec
- (message "Doing glimpse query %s on %s..." query groupspec)
- (message "Doing glimpse query %s..." query))
- (let* ((cp-list
- `( ,nnir-glimpse-program
- nil ; input from /dev/null
- t ; output
- nil ; don't redisplay
- "-H" ,(nnir-read-server-parm 'nnir-glimpse-home server) ; search home dir
- "-W" ; match pattern in file
- "-l" "-y" ; misc options
- ,@(nnir-read-server-parm 'nnir-glimpse-additional-switches server)
- "-F" ,prefix ; restrict output to mail
- ,qstring ; the query, in glimpse format
- ))
- (exitstatus
- (progn
- (message "%s args: %s" nnir-glimpse-program
- (mapconcat 'identity (cddddr cp-list) " "))
- (apply 'call-process cp-list))))
- (unless (or (null exitstatus)
- (zerop exitstatus))
- (nnheader-report 'nnir "Couldn't run glimpse: %s" exitstatus)
- ;; Glimpse failure reason is in this buffer, show it if
- ;; the user wants it.
- (when (> gnus-verbose 6)
- (display-buffer nnir-tmp-buffer))))
- (when groupspec
- (keep-lines groupspec))
- (if groupspec
- (message "Doing glimpse query %s on %s...done" query groupspec)
- (message "Doing glimpse query %s...done" query))
- (sit-for 0)
- ;; remove superfluous stuff from glimpse output
- (goto-char (point-min))
- (delete-non-matching-lines "/[0-9]+$")
- ;;(delete-matching-lines "\\.overview~?$")
- (goto-char (point-min))
- (while (re-search-forward (concat "^" prefix "\\(.+\\)" "/\\([0-9]\\)+$") nil t)
- ;; replace / with . in group names
- (setq dirnam (substitute ?. ?/ (match-string 1))
- artno (match-string 2))
- (push (vector (nnir-group-full-name dirnam server)
- (string-to-int artno)) artlist))
-
- (sort* artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y))))))
- )))
-
-;; freeWAIS-sf interface.
-(defun nnir-run-waissearch (query server &optional group)
- "Run given query agains waissearch. Returns vector of (group name, file name)
-pairs (also vectors, actually)."
- (when group
- (error "The freeWAIS-sf backend cannot search specific groups."))
- (save-excursion
- (let ((qstring (cdr (assq 'query query)))
- (prefix (nnir-read-server-parm 'nnir-wais-remove-prefix server))
- (artlist nil)
- (score nil) (artno nil) (dirnam nil) (group nil))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
- (message "Doing WAIS query %s..." query)
- (call-process nnir-wais-program
- nil ; input from /dev/null
- t ; output to current buffer
- nil ; don't redisplay
- "-d" (nnir-read-server-parm 'nnir-wais-database server) ; database to search
- qstring)
- (message "Massaging waissearch output...")
- ;; remove superfluous lines
- (keep-lines "Score:")
- ;; extract data from result lines
- (goto-char (point-min))
- (while (re-search-forward
- "Score: +\\([0-9]+\\).*'\\([0-9]+\\) +\\([^']+\\)/'" nil t)
- (setq score (match-string 1)
- artno (match-string 2)
- dirnam (match-string 3))
- (unless (string-match prefix dirnam)
- (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
- dirnam prefix))
- (setq group (substitute ?. ?/ (replace-match "" t t dirnam)))
- (push (vector (nnir-group-full-name group server)
- (string-to-int artno)
- (string-to-int score))
- artlist))
- (message "Massaging waissearch output...done")
- (apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
-
-;; EWS (Excite for Web Servers) interface
-(defun nnir-run-excite-search (query server &optional group)
- "Run a given query against EWS. Returns vector of (group name, file name)
-pairs (also vectors, actually)."
- (when group
- (error "Searching specific groups not implemented for EWS."))
- (save-excursion
- (let ((qstring (cdr (assq 'query query)))
- (prefix (nnir-read-server-parm 'nnir-excite-remove-prefix server))
- artlist group article-num article)
- (setq nnir-current-query query)
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
- (message "Doing EWS query %s..." qstring)
- (call-process nnir-excite-aquery-program
- nil ; input from /dev/null
- t ; output to current buffer
- nil ; don't redisplay
- (nnir-read-server-parm 'nnir-excite-collection server)
- (if (string= (substring qstring 0 1) "(")
- qstring
- (format "(concept %s)" qstring)))
- (message "Gathering query output...")
-
- (goto-char (point-min))
- (while (re-search-forward
- "^[0-9]+\\s-[0-9]+\\s-[0-9]+\\s-\\(\\S-*\\)" nil t)
- (setq article (match-string 1))
- (unless (string-match
- (concat "^" (regexp-quote prefix)
- "\\(.*\\)/\\([0-9]+\\)") article)
- (nnheader-report 'nnir "Dir name %s doesn't contain prefix %s"
- article prefix))
- (setq group (substitute ?. ?/ (match-string 1 article)))
- (setq group (nnir-group-full-name group server))
- (setq article-num (match-string 2 article))
- (setq artlist (vconcat artlist (vector (vector group
- (string-to-int article-num)
- 1000)))))
- (message "Gathering query output...done")
- artlist)))
-
-;; IMAP interface. The following function is Copyright (C) 1998 Simon
-;; Josefsson <jas@pdc.kth.se>.
-;; todo:
-;; nnir invokes this two (2) times???!
-;; we should not use nnimap at all but open our own server connection
-;; we should not LIST * but use nnimap-list-pattern from defs
-;; send queries as literals
-;; handle errors
-
-(defun nnir-run-imap (query srv &optional group-option)
- (require 'imap)
- (require 'nnimap)
- (save-excursion
- (let ((qstring (cdr (assq 'query query)))
- (server (cadr (gnus-server-to-method srv)))
- (group (or group-option (gnus-group-group-name)))
- (defs (caddr (gnus-server-to-method srv)))
- (criteria (or (cdr (assq 'criteria query))
- nnir-imap-search-field))
- artlist buf)
- (message "Opening server %s" server)
- (condition-case ()
- (when (nnimap-open-server server defs) ;; xxx
- (setq buf nnimap-server-buffer) ;; xxx
- (message "Searching %s..." group)
- (let ((arts 0)
- (mbx (gnus-group-real-name group)))
- (when (imap-mailbox-select mbx nil buf)
- (mapcar
- (lambda (artnum)
- (push (vector group artnum 1) artlist)
- (setq arts (1+ arts)))
- (imap-search (concat criteria " \"" qstring "\"") buf))
- (message "Searching %s... %d matches" mbx arts)))
- (message "Searching %s...done" group))
- (quit nil))
- (reverse artlist))))
-
-;; Swish++ interface. The following function is Copyright (C) 2000,
-;; 2001 Christoph Conrad <christoph.conrad@gmx.de>.
-;; -cc- Todo
-;; Search by
-;; - group
-;; Sort by
-;; - rank (default)
-;; - article number
-;; - file size
-;; - group
-(defun nnir-run-swish++ (query server &optional group)
- "Run given query against swish++.
-Returns a vector of (group name, file name) pairs (also vectors,
-actually).
-
-Tested with swish++ 4.7 on GNU/Linux and with with swish++ 5.0b2 on
-Windows NT 4.0."
-
- (when group
- (error "The swish++ backend cannot search specific groups."))
-
- (save-excursion
- (let ( (qstring (cdr (assq 'query query)))
- (groupspec (cdr (assq 'group query)))
- (prefix (nnir-read-server-parm 'nnir-swish++-remove-prefix server))
- (artlist nil)
- (score nil) (artno nil) (dirnam nil) (group nil) )
-
- (when (equal "" qstring)
- (error "swish++: You didn't enter anything."))
-
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
-
- (if groupspec
- (message "Doing swish++ query %s on %s..." qstring groupspec)
- (message "Doing swish++ query %s..." qstring))
-
- (let* ((cp-list `( ,nnir-swish++-program
- nil ; input from /dev/null
- t ; output
- nil ; don't redisplay
- "--config-file" ,(nnir-read-server-parm 'nnir-swish++-configuration-file server)
- ,@(nnir-read-server-parm 'nnir-swish++-additional-switches server)
- ,qstring ; the query, in swish++ format
- ))
- (exitstatus
- (progn
- (message "%s args: %s" nnir-swish++-program
- (mapconcat 'identity (cddddr cp-list) " ")) ;; ???
- (apply 'call-process cp-list))))
- (unless (or (null exitstatus)
- (zerop exitstatus))
- (nnheader-report 'nnir "Couldn't run swish++: %s" exitstatus)
- ;; swish++ failure reason is in this buffer, show it if
- ;; the user wants it.
- (when (> gnus-verbose 6)
- (display-buffer nnir-tmp-buffer))))
-
- ;; The results are output in the format of:
- ;; V 4.7 Linux
- ;; rank relative-path-name file-size file-title
- ;; V 5.0b2:
- ;; rank relative-path-name file-size topic??
- ;; where rank is an integer from 1 to 100.
- (goto-char (point-min))
- (while (re-search-forward
- "\\(^[0-9]+\\) \\([^ ]+\\) [0-9]+ \\(.*\\)$" nil t)
- (setq score (match-string 1)
- artno (file-name-nondirectory (match-string 2))
- dirnam (file-name-directory (match-string 2)))
-
- ;; don't match directories
- (when (string-match "^[0-9]+$" artno)
- (when (not (null dirnam))
-
- ;; maybe limit results to matching groups.
- (when (or (not groupspec)
- (string-match groupspec dirnam))
-
- ;; remove nnir-swish++-remove-prefix from beginning of dirname
- (when (string-match (concat "^" prefix)
- dirnam)
- (setq dirnam (replace-match "" t t dirnam)))
-
- (setq dirnam (substring dirnam 0 -1))
- ;; eliminate all ".", "/", "\" from beginning. Always matches.
- (string-match "^[./\\]*\\(.*\\)$" dirnam)
- ;; "/" -> "."
- (setq group (substitute ?. ?/ (match-string 1 dirnam)))
- ;; "\\" -> "."
- (setq group (substitute ?. ?\\ group))
-
- (push (vector (nnir-group-full-name group server)
- (string-to-int artno)
- (string-to-int score))
- artlist)))))
-
- (message "Massaging swish++ output...done")
-
- ;; Sort by score
- (apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
-
-;; Swish-E interface. The following function is Copyright (C) 2000,
-;; 2001 by Christoph Conrad <christoph.conrad@gmx.de>.
-(defun nnir-run-swish-e (query server &optional group)
- "Run given query against swish-e.
-Returns a vector of (group name, file name) pairs (also vectors,
-actually).
-
-Tested with swish-e-2.0.1 on Windows NT 4.0."
-
- ;; swish-e crashes with empty parameter to "-w" on commandline...
- (when group
- (error "The swish-e backend cannot search specific groups."))
-
- (save-excursion
- (let ((qstring (cdr (assq 'query query)))
- (prefix
- (or (nnir-read-server-parm 'nnir-swish-e-remove-prefix server)
- (error "Missing parameter `nnir-swish-e-remove-prefix'")))
- (artlist nil)
- (score nil) (artno nil) (dirnam nil) (group nil) )
-
- (when (equal "" qstring)
- (error "swish-e: You didn't enter anything."))
-
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
-
- (message "Doing swish-e query %s..." query)
- (let* ((index-file
- (or (nnir-read-server-parm
- 'nnir-swish-e-index-file server)
- (error "Missing parameter `nnir-swish-e-index-file'")))
- (additional-switches
- (nnir-read-server-parm
- 'nnir-swish++-additional-switches server))
- (cp-list `(,nnir-swish-e-program
- nil ; input from /dev/null
- t ; output
- nil ; don't redisplay
- "-f" ,index-file
- ,@additional-switches
- "-w"
- ,qstring ; the query, in swish-e format
- ))
- (exitstatus
- (progn
- (message "%s args: %s" nnir-swish-e-program
- (mapconcat 'identity (cddddr cp-list) " "))
- (apply 'call-process cp-list))))
- (unless (or (null exitstatus)
- (zerop exitstatus))
- (nnheader-report 'nnir "Couldn't run swish-e: %s" exitstatus)
- ;; swish-e failure reason is in this buffer, show it if
- ;; the user wants it.
- (when (> gnus-verbose 6)
- (display-buffer nnir-tmp-buffer))))
-
- ;; The results are output in the format of:
- ;; rank path-name file-title file-size
- (goto-char (point-min))
- (while (re-search-forward
- "\\(^[0-9]+\\) \\([^ ]+\\) \"\\([^\"]+\\)\" [0-9]+$" nil t)
- (setq score (match-string 1)
- artno (match-string 3)
- dirnam (file-name-directory (match-string 2)))
-
- ;; don't match directories
- (when (string-match "^[0-9]+$" artno)
- (when (not (null dirnam))
-
- ;; remove nnir-swish-e-remove-prefix from beginning of dirname
- (when (string-match (concat "^" prefix) dirnam)
- (setq dirnam (replace-match "" t t dirnam)))
-
- (setq dirnam (substring dirnam 0 -1))
- ;; eliminate all ".", "/", "\" from beginning. Always matches.
- (string-match "^[./\\]*\\(.*\\)$" dirnam)
- ;; "/" -> "."
- (setq group (substitute ?. ?/ (match-string 1 dirnam)))
- ;; Windows "\\" -> "."
- (setq group (substitute ?. ?\\ group))
-
- (push (vector (nnir-group-full-name group server)
- (string-to-int artno)
- (string-to-int score))
- artlist))))
-
- (message "Massaging swish-e output...done")
-
- ;; Sort by score
- (apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
-
-;; HyREX interface
-(defun nnir-run-hyrex (query server &optional group)
- (save-excursion
- (let ((artlist nil)
- (groupspec (cdr (assq 'group query)))
- (qstring (cdr (assq 'query query)))
- (prefix (nnir-read-server-parm 'nnir-hyrex-remove-prefix server))
- score artno dirnam)
- (when (and group groupspec)
- (error (concat "It does not make sense to use a group spec"
- " with process-marked groups.")))
- (when group
- (setq groupspec (gnus-group-real-name group)))
- (when (and group (not (equal group (nnir-group-full-name groupspec server))))
- (message "%s vs. %s" group (nnir-group-full-name groupspec server))
- (error "Server with groupspec doesn't match group !"))
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
- (if groupspec
- (message "Doing hyrex-search query %s on %s..." query groupspec)
- (message "Doing hyrex-search query %s..." query))
- (let* ((cp-list
- `( ,nnir-hyrex-program
- nil ; input from /dev/null
- t ; output
- nil ; don't redisplay
- "-i",(nnir-read-server-parm 'nnir-hyrex-index-directory server) ; index directory
- ,@(nnir-read-server-parm 'nnir-hyrex-additional-switches server)
- ,qstring ; the query, in hyrex-search format
- ))
- (exitstatus
- (progn
- (message "%s args: %s" nnir-hyrex-program
- (mapconcat 'identity (cddddr cp-list) " "))
- (apply 'call-process cp-list))))
- (unless (or (null exitstatus)
- (zerop exitstatus))
- (nnheader-report 'nnir "Couldn't run hyrex-search: %s" exitstatus)
- ;; nnir-search failure reason is in this buffer, show it if
- ;; the user wants it.
- (when (> gnus-verbose 6)
- (display-buffer nnir-tmp-buffer)))) ;; FIXME: Dont clear buffer !
- (if groupspec
- (message "Doing hyrex-search query \"%s\" on %s...done" qstring groupspec)
- (message "Doing hyrex-search query \"%s\"...done" qstring))
- (sit-for 0)
- ;; nnir-search returns:
- ;; for nnml/nnfolder: "filename mailid weigth"
- ;; for nnimap: "group mailid weigth"
- (goto-char (point-min))
- (delete-non-matching-lines "^\\S + [0-9]+ [0-9]+$")
- ;; HyREX couldn't search directly in groups -- so filter out here.
- (when groupspec
- (keep-lines groupspec))
- ;; extract data from result lines
- (goto-char (point-min))
- (while (re-search-forward
- "\\(\\S +\\) \\([0-9]+\\) \\([0-9]+\\)" nil t)
- (setq dirnam (match-string 1)
- artno (match-string 2)
- score (match-string 3))
- (when (string-match prefix dirnam)
- (setq dirnam (replace-match "" t t dirnam)))
- (push (vector (nnir-group-full-name (substitute ?. ?/ dirnam) server)
- (string-to-int artno)
- (string-to-int score))
- artlist))
- (message "Massaging hyrex-search output...done.")
- (apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (if (string-lessp (nnir-artitem-group x)
- (nnir-artitem-group y))
- t
- (< (nnir-artitem-number x)
- (nnir-artitem-number y)))))))
- )))
-
-;; Namazu interface
-(defun nnir-run-namazu (query server &optional group)
- "Run given query against Namazu. Returns a vector of (group name, file name)
-pairs (also vectors, actually).
-
-Tested with Namazu 2.0.6 on a GNU/Linux system."
- (when group
- (error "The Namazu backend cannot search specific groups"))
- (save-excursion
- (let (
- (artlist nil)
- (qstring (cdr (assq 'query query)))
- (prefix (nnir-read-server-parm 'nnir-namazu-remove-prefix server))
- (score nil)
- (group nil)
- (article nil)
- (process-environment (copy-sequence process-environment))
- )
- (setenv "LC_MESSAGES" "C")
- (set-buffer (get-buffer-create nnir-tmp-buffer))
- (erase-buffer)
- (let* ((cp-list
- `( ,nnir-namazu-program
- nil ; input from /dev/null
- t ; output
- nil ; don't redisplay
- "-q" ; don't be verbose
- "-a" ; show all matches
- "-s" ; use short format
- ,@(nnir-read-server-parm 'nnir-namazu-additional-switches server)
- ,qstring ; the query, in namazu format
- ,(nnir-read-server-parm 'nnir-namazu-index-directory server) ; index directory
- ))
- (exitstatus
- (progn
- (message "%s args: %s" nnir-namazu-program
- (mapconcat 'identity (cddddr cp-list) " "))
- (apply 'call-process cp-list))))
- (unless (or (null exitstatus)
- (zerop exitstatus))
- (nnheader-report 'nnir "Couldn't run namazu: %s" exitstatus)
- ;; Namazu failure reason is in this buffer, show it if
- ;; the user wants it.
- (when (> gnus-verbose 6)
- (display-buffer nnir-tmp-buffer))))
-
- ;; Namazu output looks something like this:
- ;; 2. Re: Gnus agent expire broken (score: 55)
- ;; /home/henrik/Mail/mail/sent/1310 (4,138 bytes)
-
- (goto-char (point-min))
- (while (re-search-forward
- "^\\([0-9]+\\.\\).*\\((score: \\([0-9]+\\)\\))\n\\([^ ]+\\)"
- nil t)
- (setq score (match-string 3)
- group (file-name-directory (match-string 4))
- article (file-name-nondirectory (match-string 4)))
-
- ;; make sure article and group is sane
- (when (and (string-match "^[0-9]+$" article)
- (not (null group)))
- (when (string-match (concat "^" prefix) group)
- (setq group (replace-match "" t t group)))
-
- ;; remove trailing slash from groupname
- (setq group (substring group 0 -1))
-
- ;; stuff results into artlist vector
- (push (vector (nnir-group-full-name (substitute ?. ?/ group) server)
- (string-to-int article)
- (string-to-int score)) artlist)))
-
- ;; sort artlist by score
- (apply 'vector
- (sort* artlist
- (function (lambda (x y)
- (> (nnir-artitem-rsv x)
- (nnir-artitem-rsv y)))))))))
-
-;;; Util Code:
-
-(defun nnir-read-parms (query)
- "Reads additional search parameters according to `nnir-engines'."
- (let ((parmspec (caddr (assoc nnir-search-engine nnir-engines))))
- (cons (cons 'query query)
- (mapcar 'nnir-read-parm parmspec))))
-
-(defun nnir-read-parm (parmspec)
- "Reads a single search parameter.
-`parmspec' is a cons cell, the car is a symbol, the cdr is a prompt."
- (let ((sym (car parmspec))
- (prompt (cdr parmspec)))
- (if (listp prompt)
- (let* ((result (apply 'completing-read prompt))
- (mapping (or (assoc result nnir-imap-search-arguments)
- (assoc nil nnir-imap-search-arguments))))
- (cons sym (format (cdr mapping) result)))
- (cons sym (read-string prompt)))))
-
-(defun nnir-run-query (query)
- "Invoke appropriate search engine function (see `nnir-engines').
-If some groups were process-marked, run the query for each of the groups
-and concat the results."
- (let ((q (car (read-from-string query))))
- (if gnus-group-marked
- (apply 'vconcat
- (mapcar (lambda (x)
- (let ((server (nnir-group-server x))
- search-func)
- (setq search-func (cadr
- (assoc
- (nnir-read-server-parm 'nnir-search-engine server) nnir-engines)))
- (if search-func
- (funcall search-func q server x)
- nil)))
- gnus-group-marked)
- )
- (apply 'vconcat
- (mapcar (lambda (x)
- (if (and (equal (cadr x) 'ok) (not (equal (cadar x) "-ephemeral")))
- (let ((server (format "%s:%s" (caar x) (cadar x)))
- search-func)
- (setq search-func (cadr
- (assoc
- (nnir-read-server-parm 'nnir-search-engine server) nnir-engines)))
- (if search-func
- (funcall search-func q server nil)
- nil))
- nil))
- gnus-opened-servers)
- ))
- ))
-
-(defun nnir-read-server-parm (key server)
- "Returns the parameter value of for the given server, where server is of
-form 'backend:name'."
- (let ((method (gnus-server-to-method server)))
- (cond ((and method (assq key (cddr method)))
- (nth 1 (assq key (cddr method))))
- ((and nnir-mail-backend
- (gnus-method-equal method nnir-mail-backend))
- (symbol-value key))
- ((null nnir-mail-backend)
- (symbol-value key))
- (t nil))))
-;; (if method
-;; (if (assq key (cddr method))
-;; (nth 1 (assq key (cddr method)))
-;; (symbol-value key))
-;; (symbol-value key))
-;; ))
-
-(defmacro nnir-group-server (group)
- "Returns the server for a foreign newsgroup in the format as gnus-server-to-method needs it. Compare to gnus-group-real-prefix and gnus-group-real-name."
- `(let ((gname ,group))
- (if (string-match "^\\([^:]+\\):" gname)
- (setq gname (match-string 1 gname))
- nil)
- (if (string-match "^\\([^+]+\\)\\+\\(.+\\)$" gname)
- (format "%s:%s" (match-string 1 gname) (match-string 2 gname))
- (concat gname ":"))
- ))
-
-(defun nnir-group-full-name (shortname server)
- "For the given group name, return a full Gnus group name.
-The Gnus backend/server information is added."
- (gnus-group-prefixed-name shortname (gnus-server-to-method server)))
-
-(defun nnir-possibly-change-server (server)
- (unless (and server (nnir-server-opened server))
- (nnir-open-server server)))
-
-
-;; Data type article list.
-
-(defun nnir-artlist-length (artlist)
- "Returns number of articles in artlist."
- (length artlist))
-
-(defun nnir-artlist-article (artlist n)
- "Returns from ARTLIST the Nth artitem (counting starting at 1)."
- (elt artlist (1- n)))
-
-(defun nnir-artitem-group (artitem)
- "Returns the group from the ARTITEM."
- (elt artitem 0))
-
-(defun nnir-artlist-artitem-group (artlist n)
- "Returns from ARTLIST the group of the Nth artitem (counting from 1)."
- (nnir-artitem-group (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-number (artitem)
- "Returns the number from the ARTITEM."
- (elt artitem 1))
-
-(defun nnir-artlist-artitem-number (artlist n)
- "Returns from ARTLIST the number of the Nth artitem (counting from 1)."
- (nnir-artitem-number (nnir-artlist-article artlist n)))
-
-(defun nnir-artitem-rsv (artitem)
- "Returns the Retrieval Status Value (RSV, score) from the ARTITEM."
- (elt artitem 2))
-
-(defun nnir-artlist-artitem-rsv (artlist n)
- "Returns from ARTLIST the Retrieval Status Value of the Nth artitem
-(counting from 1)."
- (nnir-artitem-rsv (nnir-artlist-article artlist n)))
-
-;; unused?
-(defun nnir-artlist-groups (artlist)
- "Returns a list of all groups in the given ARTLIST."
- (let ((res nil)
- (with-dups nil))
- ;; from each artitem, extract group component
- (setq with-dups (mapcar 'nnir-artitem-group artlist))
- ;; remove duplicates from above
- (mapcar (function (lambda (x) (add-to-list 'res x)))
- with-dups)
- res))
-
-
-;; The end.
-(provide 'nnir)
-
-;;; arch-tag: 9b3fecf8-4397-4bbb-bf3c-6ac3cbbc6664
+++ /dev/null
-;;; nnkiboze.el --- select virtual news access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can't be used
-;; separately.
-
-;;; Code:
-
-(require 'nntp)
-(require 'nnheader)
-(require 'gnus)
-(require 'gnus-score)
-(require 'nnoo)
-(require 'mm-util)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnkiboze)
-(defvoo nnkiboze-directory (nnheader-concat gnus-directory "kiboze/")
- "nnkiboze will put its files in this directory.")
-
-(defvoo nnkiboze-level 9
- "The maximum level to be searched for articles.")
-
-(defvoo nnkiboze-remove-read-articles t
- "If non-nil, nnkiboze will remove read articles from the kiboze group.")
-
-(defvoo nnkiboze-ephemeral nil
- "If non-nil, don't store any data anywhere.")
-
-(defvoo nnkiboze-scores nil
- "Score rules for generating the nnkiboze group.")
-
-(defvoo nnkiboze-regexp nil
- "Regexp for matching component groups.")
-
-(defvoo nnkiboze-file-coding-system mm-text-coding-system
- "Coding system for nnkiboze files.")
-
-\f
-
-(defconst nnkiboze-version "nnkiboze 1.0")
-
-(defvoo nnkiboze-current-group nil)
-(defvoo nnkiboze-status-string "")
-
-(defvoo nnkiboze-headers nil)
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nnkiboze)
-
-(deffoo nnkiboze-retrieve-headers (articles &optional group server fetch-old)
- (nnkiboze-possibly-change-group group)
- (unless gnus-nov-is-evil
- (if (stringp (car articles))
- 'headers
- (let ((nov (nnkiboze-nov-file-name)))
- (when (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents nov))
- (nnheader-nov-delete-outside-range
- (car articles) (car (last articles)))
- 'nov))))))
-
-(deffoo nnkiboze-request-article (article &optional newsgroup server buffer)
- (nnkiboze-possibly-change-group newsgroup)
- (if (not (numberp article))
- ;; This is a real kludge. It might not work at times, but it
- ;; does no harm I think. The only alternative is to offer no
- ;; article fetching by message-id at all.
- (nntp-request-article article newsgroup gnus-nntp-server buffer)
- (let* ((header (gnus-summary-article-header article))
- (xref (mail-header-xref header))
- num group)
- (unless xref
- (error "nnkiboze: No xref"))
- (unless (string-match " \\([^ ]+\\):\\([0-9]+\\)" xref)
- (error "nnkiboze: Malformed xref"))
- (setq num (string-to-number (match-string 2 xref))
- group (match-string 1 xref))
- (or (with-current-buffer buffer
- (or (and gnus-use-cache (gnus-cache-request-article num group))
- (gnus-agent-request-article num group)))
- (gnus-request-article num group buffer)))))
-
-(deffoo nnkiboze-request-scan (&optional group server)
- (nnkiboze-possibly-change-group group)
- (nnkiboze-generate-group (concat "nnkiboze:" group)))
-
-(deffoo nnkiboze-request-group (group &optional server dont-check)
- "Make GROUP the current newsgroup."
- (nnkiboze-possibly-change-group group)
- (if dont-check
- t
- (let ((nov-file (nnkiboze-nov-file-name))
- beg end total)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (unless (file-exists-p nov-file)
- (nnkiboze-request-scan group))
- (if (not (file-exists-p nov-file))
- (nnheader-report 'nnkiboze "Can't select group %s" group)
- (let ((nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents nov-file))
- (if (zerop (buffer-size))
- (nnheader-insert "211 0 0 0 %s\n" group)
- (goto-char (point-min))
- (when (looking-at "[0-9]+")
- (setq beg (read (current-buffer))))
- (goto-char (point-max))
- (when (re-search-backward "^[0-9]" nil t)
- (setq end (read (current-buffer))))
- (setq total (count-lines (point-min) (point-max)))
- (nnheader-insert "211 %d %d %d %s\n" total beg end group)))))))
-
-(deffoo nnkiboze-close-group (group &optional server)
- (nnkiboze-possibly-change-group group)
- ;; Remove NOV lines of articles that are marked as read.
- (when (and (file-exists-p (nnkiboze-nov-file-name))
- nnkiboze-remove-read-articles)
- (let ((coding-system-for-write nnkiboze-file-coding-system))
- (with-temp-file (nnkiboze-nov-file-name)
- (let ((cur (current-buffer))
- (nnheader-file-coding-system nnkiboze-file-coding-system))
- (nnheader-insert-file-contents (nnkiboze-nov-file-name))
- (goto-char (point-min))
- (while (not (eobp))
- (if (not (gnus-article-read-p (read cur)))
- (forward-line 1)
- (gnus-delete-line))))))
- (setq nnkiboze-current-group nil)))
-
-(deffoo nnkiboze-open-server (server &optional defs)
- (unless (assq 'nnkiboze-regexp defs)
- (push `(nnkiboze-regexp ,server)
- defs))
- (nnoo-change-server 'nnkiboze server defs))
-
-(deffoo nnkiboze-request-delete-group (group &optional force server)
- (nnkiboze-possibly-change-group group)
- (when force
- (let ((files (nconc
- (nnkiboze-score-file group)
- (list (nnkiboze-nov-file-name)
- (nnkiboze-nov-file-name ".newsrc")))))
- (while files
- (and (file-exists-p (car files))
- (file-writable-p (car files))
- (delete-file (car files)))
- (setq files (cdr files)))))
- (setq nnkiboze-current-group nil)
- t)
-
-(nnoo-define-skeleton nnkiboze)
-
-\f
-;;; Internal functions.
-
-(defun nnkiboze-possibly-change-group (group)
- (setq nnkiboze-current-group group))
-
-(defun nnkiboze-prefixed-name (group)
- (gnus-group-prefixed-name group '(nnkiboze "")))
-
-;;;###autoload
-(defun nnkiboze-generate-groups ()
- "\"Usage: emacs -batch -l nnkiboze -f nnkiboze-generate-groups\".
-Finds out what articles are to be part of the nnkiboze groups."
- (interactive)
- (let ((nnmail-spool-file nil)
- (mail-sources nil)
- (gnus-use-dribble-file nil)
- (gnus-read-active-file t)
- (gnus-expert-user t))
- (gnus))
- (let* ((gnus-newsrc-alist (gnus-copy-sequence gnus-newsrc-alist))
- (newsrc (cdr gnus-newsrc-alist))
- gnus-newsrc-hashtb info)
- (gnus-make-hashtable-from-newsrc-alist)
- ;; We have copied all the newsrc alist info over to local copies
- ;; so that we can mess all we want with these lists.
- (while (setq info (pop newsrc))
- (when (string-match "nnkiboze" (gnus-info-group info))
- ;; For each kiboze group, we call this function to generate
- ;; it.
- (nnkiboze-generate-group (gnus-info-group info) t))))
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-list-groups)))
-
-(defun nnkiboze-score-file (group)
- (list (expand-file-name
- (concat (file-name-as-directory gnus-kill-files-directory)
- (nnheader-translate-file-chars
- (concat (nnkiboze-prefixed-name nnkiboze-current-group)
- "." gnus-score-file-suffix))))))
-
-(defun nnkiboze-generate-group (group &optional inhibit-list-groups)
- (let* ((info (nth 2 (gnus-gethash group gnus-newsrc-hashtb)))
- (newsrc-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".newsrc"))))
- (nov-file (concat nnkiboze-directory
- (nnheader-translate-file-chars
- (concat group ".nov"))))
- method nnkiboze-newsrc gname newsrc active
- ginfo lowest glevel orig-info nov-buffer
- ;; Bind various things to nil to make group entry faster.
- (gnus-expert-user t)
- (gnus-large-newsgroup nil)
- (gnus-score-find-score-files-function 'nnkiboze-score-file)
- ;; Use only nnkiboze-score-file!
- (gnus-score-use-all-scores nil)
- (gnus-use-scoring t)
- (gnus-verbose (min gnus-verbose 3))
- gnus-select-group-hook gnus-summary-prepare-hook
- gnus-thread-sort-functions gnus-show-threads
- gnus-visual gnus-suppress-duplicates num-unread)
- (unless info
- (error "No such group: %s" group))
- ;; Load the kiboze newsrc file for this group.
- (mm-with-unibyte
- (when (file-exists-p newsrc-file)
- (load newsrc-file))
- (let ((coding-system-for-write nnkiboze-file-coding-system))
- (gnus-make-directory (file-name-directory nov-file))
- (with-temp-file nov-file
- (when (file-exists-p nov-file)
- (insert-file-contents nov-file))
- (setq nov-buffer (current-buffer))
- ;; Go through the active hashtb and add new all groups that match the
- ;; kiboze regexp.
- (mapatoms
- (lambda (group)
- (and (string-match nnkiboze-regexp
- (setq gname (symbol-name group))) ; Match
- (not (assoc gname nnkiboze-newsrc)) ; It isn't registered
- (numberp (car (symbol-value group))) ; It is active
- (or (> nnkiboze-level 7)
- (and (setq glevel
- (nth 1 (nth 2 (gnus-gethash
- gname gnus-newsrc-hashtb))))
- (>= nnkiboze-level glevel)))
- (not (string-match "^nnkiboze:" gname)) ; Exclude kibozes
- (push (cons gname (1- (car (symbol-value group))))
- nnkiboze-newsrc)))
- gnus-active-hashtb)
- ;; `newsrc' is set to the list of groups that possibly are
- ;; component groups to this kiboze group. This list has elements
- ;; on the form `(GROUP . NUMBER)', where NUMBER is the highest
- ;; number that has been kibozed in GROUP in this kiboze group.
- (setq newsrc nnkiboze-newsrc)
- (while newsrc
- (if (not (setq active (gnus-gethash
- (caar newsrc) gnus-active-hashtb)))
- ;; This group isn't active after all, so we remove it from
- ;; the list of component groups.
- (setq nnkiboze-newsrc (delq (car newsrc) nnkiboze-newsrc))
- (setq lowest (cdar newsrc))
- ;; Ok, we have a valid component group, so we jump to it.
- (switch-to-buffer gnus-group-buffer)
- (gnus-group-jump-to-group (caar newsrc))
- (gnus-message 3 "nnkiboze: Checking %s..." (caar newsrc))
- (setq ginfo (gnus-get-info (gnus-group-group-name))
- orig-info (gnus-copy-sequence ginfo)
- num-unread (car (gnus-gethash (caar newsrc)
- gnus-newsrc-hashtb)))
- (unwind-protect
- (progn
- ;; We set all list of article marks to nil. Since we operate
- ;; on copies of the real lists, we can destroy anything we
- ;; want here.
- (when (nth 3 ginfo)
- (setcar (nthcdr 3 ginfo) nil))
- ;; We set the list of read articles to be what we expect for
- ;; this kiboze group -- either nil or `(1 . LOWEST)'.
- (when ginfo
- (setcar (nthcdr 2 ginfo)
- (and (not (= lowest 1)) (cons 1 lowest))))
- (when (and (or (not ginfo)
- (> (length (gnus-list-of-unread-articles
- (car ginfo)))
- 0))
- (progn
- (ignore-errors
- (gnus-group-select-group nil))
- (eq major-mode 'gnus-summary-mode)))
- ;; We are now in the group where we want to be.
- (setq method (gnus-find-method-for-group
- gnus-newsgroup-name))
- (when (eq method gnus-select-method)
- (setq method nil))
- ;; We go through the list of scored articles.
- (while gnus-newsgroup-scored
- (when (> (caar gnus-newsgroup-scored) lowest)
- ;; If it has a good score, then we enter this article
- ;; into the kiboze group.
- (nnkiboze-enter-nov
- nov-buffer
- (gnus-summary-article-header
- (caar gnus-newsgroup-scored))
- gnus-newsgroup-name))
- (setq gnus-newsgroup-scored (cdr gnus-newsgroup-scored)))
- ;; That's it. We exit this group.
- (when (eq major-mode 'gnus-summary-mode)
- (kill-buffer (current-buffer)))))
- ;; Restore the proper info.
- (when ginfo
- (setcdr ginfo (cdr orig-info)))
- (setcar (gnus-gethash (caar newsrc) gnus-newsrc-hashtb)
- num-unread)))
- (setcdr (car newsrc) (cdr active))
- (gnus-message 3 "nnkiboze: Checking %s...done" (caar newsrc))
- (setq newsrc (cdr newsrc)))))
- ;; We save the kiboze newsrc for this group.
- (gnus-make-directory (file-name-directory newsrc-file))
- (with-temp-file newsrc-file
- (insert "(setq nnkiboze-newsrc '")
- (gnus-prin1 nnkiboze-newsrc)
- (insert ")\n")))
- (unless inhibit-list-groups
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-list-groups)))
- t))
-
-(defun nnkiboze-enter-nov (buffer header group)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (let ((prefix (gnus-group-real-prefix group))
- (oheader (copy-sequence header))
- article)
- (if (zerop (forward-line -1))
- (progn
- (setq article (1+ (read (current-buffer))))
- (forward-line 1))
- (setq article 1))
- (mail-header-set-number oheader article)
- (with-temp-buffer
- (insert (or (mail-header-xref oheader) ""))
- (goto-char (point-min))
- (if (re-search-forward " [^ ]+:[0-9]+" nil t)
- (goto-char (match-beginning 0))
- (or (eobp) (forward-char 1)))
- ;; The first Xref has to be the group this article
- ;; really came for - this is the article nnkiboze
- ;; will request when it is asked for the article.
- (insert " " group ":"
- (int-to-string (mail-header-number header)) " ")
- (while (re-search-forward " [^ ]+:[0-9]+" nil t)
- (goto-char (1+ (match-beginning 0)))
- (insert prefix))
- (mail-header-set-xref oheader (buffer-string)))
- (nnheader-insert-nov oheader))))
-
-(defun nnkiboze-nov-file-name (&optional suffix)
- (concat (file-name-as-directory nnkiboze-directory)
- (nnheader-translate-file-chars
- (concat (nnkiboze-prefixed-name nnkiboze-current-group)
- (or suffix ".nov")))))
-
-(provide 'nnkiboze)
-
-;;; arch-tag: 66068271-bdc9-4801-bcde-779702e73a05
-;;; nnkiboze.el ends here
+++ /dev/null
-;;; nnlistserv.el --- retrieving articles via web mailing list archives
-
-;; Copyright (C) 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'mm-url)
-(require 'nnweb)
-
-(nnoo-declare nnlistserv
- nnweb)
-
-(defvoo nnlistserv-directory (nnheader-concat gnus-directory "nnlistserv/")
- "Where nnlistserv will save its files."
- nnweb-directory)
-
-(defvoo nnlistserv-name 'kk
- "What search engine type is being used."
- nnweb-type)
-
-(defvoo nnlistserv-type-definition
- '((kk
- (article . nnlistserv-kk-wash-article)
- (map . nnlistserv-kk-create-mapping)
- (search . nnlistserv-kk-search)
- (address . "http://www.itk.ntnu.no/ansatte/Andresen_Trond/kk-f/%s/")
- (pages "fra160396" "fra160796" "fra061196" "fra160197"
- "fra090997" "fra040797" "fra130397" "nye")
- (index . "date.html")
- (identifier . nnlistserv-kk-identity)))
- "Type-definition alist."
- nnweb-type-definition)
-
-(defvoo nnlistserv-search nil
- "Search string to feed to DejaNews."
- nnweb-search)
-
-(defvoo nnlistserv-ephemeral-p nil
- "Whether this nnlistserv server is ephemeral."
- nnweb-ephemeral-p)
-
-;;; Internal variables
-
-;;; Interface functions
-
-(nnoo-define-basics nnlistserv)
-
-(nnoo-import nnlistserv
- (nnweb))
-
-;;; Internal functions
-
-;;;
-;;; KK functions.
-;;;
-
-(defun nnlistserv-kk-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (let ((case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- (pages (nnweb-definition 'pages))
- map url page subject from )
- (while (setq page (pop pages))
- (erase-buffer)
- (when (funcall (nnweb-definition 'search) page)
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (mm-url-decode-entities)
- (goto-char (point-min))
- (while (re-search-forward "^<li> *<a href=\"\\([^\"]+\\)\"><b>\\([^\\>]+\\)</b></a> *<[^>]+><i>\\([^>]+\\)<" nil t)
- (setq url (match-string 1)
- subject (match-string 2)
- from (match-string 3))
- (setq url (concat (format (nnweb-definition 'address) page) url))
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) subject from ""
- (concat "<" (nnweb-identifier url) "@kk>")
- nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))
- (nnheader-message 5 "%s %s %s" (cdr active) (point) pages)))))
- ;; Return the articles in the right order.
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car)))))
-
-(defun nnlistserv-kk-wash-article ()
- (let ((case-fold-search t)
- (headers '(sent name email subject id))
- sent name email subject id)
- (mm-url-decode-entities)
- (while headers
- (goto-char (point-min))
- (re-search-forward (format "<!-- %s=\"\\([^\"]+\\)" (car headers)) nil t)
- (set (pop headers) (match-string 1)))
- (goto-char (point-min))
- (search-forward "<!-- body" nil t)
- (delete-region (point-min) (progn (forward-line 1) (point)))
- (goto-char (point-max))
- (search-backward "<!-- body" nil t)
- (delete-region (point-max) (progn (beginning-of-line) (point)))
- (mm-url-remove-markup)
- (goto-char (point-min))
- (insert (format "From: %s <%s>\n" name email)
- (format "Subject: %s\n" subject)
- (format "Message-ID: %s\n" id)
- (format "Date: %s\n\n" sent))))
-
-(defun nnlistserv-kk-search (search)
- (mm-url-insert
- (concat (format (nnweb-definition 'address) search)
- (nnweb-definition 'index)))
- t)
-
-(defun nnlistserv-kk-identity (url)
- "Return an unique identifier based on URL."
- url)
-
-(provide 'nnlistserv)
-
-;;; arch-tag: 7705176f-d332-4a5e-a520-d0d319445617
-;;; nnlistserv.el ends here
+++ /dev/null
-;;; nnmail.el --- mail support functions for the Gnus mail backends
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus) ; for macro gnus-kill-buffer, at least
-(require 'nnheader)
-(require 'message)
-(require 'custom)
-(require 'gnus-util)
-(require 'mail-source)
-(require 'mm-util)
-
-(eval-and-compile
- (autoload 'gnus-add-buffer "gnus")
- (autoload 'gnus-kill-buffer "gnus"))
-
-(defgroup nnmail nil
- "Reading mail with Gnus."
- :group 'gnus)
-
-(defgroup nnmail-retrieve nil
- "Retrieving new mail."
- :group 'nnmail)
-
-(defgroup nnmail-prepare nil
- "Preparing (or mangling) new mail after retrieval."
- :group 'nnmail)
-
-(defgroup nnmail-duplicate nil
- "Handling of duplicate mail messages."
- :group 'nnmail)
-
-(defgroup nnmail-split nil
- "Organizing the incoming mail in folders."
- :group 'nnmail)
-
-(defgroup nnmail-files nil
- "Mail files."
- :group 'gnus-files
- :group 'nnmail)
-
-(defgroup nnmail-expire nil
- "Expiring old mail."
- :group 'nnmail)
-
-(defgroup nnmail-procmail nil
- "Interfacing with procmail and other mail agents."
- :group 'nnmail)
-
-(defgroup nnmail-various nil
- "Various mail options."
- :group 'nnmail)
-
-(defcustom nnmail-split-methods '(("mail.misc" ""))
- "*Incoming mail will be split according to this variable.
-
-If you'd like, for instance, one mail group for mail from the
-\"4ad-l\" mailing list, one group for junk mail and one for everything
-else, you could do something like this:
-
- (setq nnmail-split-methods
- '((\"mail.4ad\" \"From:.*4ad\")
- (\"mail.junk\" \"From:.*Lars\\\\|Subject:.*buy\")
- (\"mail.misc\" \"\")))
-
-As you can see, this variable is a list of lists, where the first
-element in each \"rule\" is the name of the group (which, by the way,
-does not have to be called anything beginning with \"mail\",
-\"yonka.zow\" is a fine, fine name), and the second is a regexp that
-nnmail will try to match on the header to find a fit.
-
-The second element can also be a function. In that case, it will be
-called narrowed to the headers with the first element of the rule as
-the argument. It should return a non-nil value if it thinks that the
-mail belongs in that group.
-
-The last element should always have \"\" as the regexp.
-
-This variable can also have a function as its value."
- :group 'nnmail-split
- :type '(choice (repeat :tag "Alist" (group (string :tag "Name")
- (choice regexp function)))
- (function-item nnmail-split-fancy)
- (function :tag "Other")))
-
-;; Suggested by Erik Selberg <speed@cs.washington.edu>.
-(defcustom nnmail-crosspost t
- "If non-nil, do crossposting if several split methods match the mail.
-If nil, the first match found will be used."
- :group 'nnmail-split
- :type 'boolean)
-
-(defcustom nnmail-split-fancy-with-parent-ignore-groups nil
- "Regexp that matches group names to be ignored when applying `nnmail-split-fancy-with-parent'.
-This can also be a list of regexps."
- :version "22.1"
- :group 'nnmail-split
- :type '(choice (const :tag "none" nil)
- (regexp :value ".*")
- (repeat :value (".*") regexp)))
-
-(defcustom nnmail-cache-ignore-groups nil
- "Regexp that matches group names to be ignored when inserting message ids into the cache (`nnmail-cache-insert').
-This can also be a list of regexps."
- :version "22.1"
- :group 'nnmail-split
- :type '(choice (const :tag "none" nil)
- (regexp :value ".*")
- (repeat :value (".*") regexp)))
-
-;; Added by gord@enci.ucalgary.ca (Gordon Matzigkeit).
-(defcustom nnmail-keep-last-article nil
- "If non-nil, nnmail will never delete/move a group's last article.
-It can be marked expirable, so it will be deleted when it is no longer last.
-
-You may need to set this variable if other programs are putting
-new mail into folder numbers that Gnus has marked as expired."
- :group 'nnmail-procmail
- :group 'nnmail-various
- :type 'boolean)
-
-(defcustom nnmail-use-long-file-names nil
- "If non-nil the mail backends will use long file and directory names.
-If nil, groups like \"mail.misc\" will end up in directories like
-\"mail/misc/\"."
- :group 'nnmail-files
- :type 'boolean)
-
-(defcustom nnmail-default-file-modes 384
- "Set the mode bits of all new mail files to this integer."
- :group 'nnmail-files
- :type 'integer)
-
-(defcustom nnmail-expiry-wait 7
- "*Expirable articles that are older than this will be expired.
-This variable can either be a number (which will be interpreted as a
-number of days) -- this doesn't have to be an integer. This variable
-can also be `immediate' and `never'."
- :group 'nnmail-expire
- :type '(choice (const immediate)
- (number :tag "days")
- (const never)))
-
-(defcustom nnmail-expiry-wait-function nil
- "Variable that holds function to specify how old articles should be before they are expired.
-The function will be called with the name of the group that the expiry
-is to be performed in, and it should return an integer that says how
-many days an article can be stored before it is considered \"old\".
-It can also return the values `never' and `immediate'.
-
-Eg.:
-
-\(setq nnmail-expiry-wait-function
- (lambda (newsgroup)
- (cond ((string-match \"private\" newsgroup) 31)
- ((string-match \"junk\" newsgroup) 1)
- ((string-match \"important\" newsgroup) 'never)
- (t 7))))"
- :group 'nnmail-expire
- :type '(choice (const :tag "nnmail-expiry-wait" nil)
- (function :format "%v" nnmail-)))
-
-(defcustom nnmail-expiry-target 'delete
- "*Variable that says where expired messages should end up.
-The default value is `delete' (which says to delete the messages),
-but it can also be a string or a function. If it is a string, expired
-messages end up in that group. If it is a function, the function is
-called in a buffer narrowed to the message in question. The function
-receives one argument, the name of the group the message comes from.
-The return value should be `delete' or a group name (a string)."
- :version "21.1"
- :group 'nnmail-expire
- :type '(choice (const delete)
- (function :format "%v" nnmail-)
- string))
-
-(defcustom nnmail-fancy-expiry-targets nil
- "Determine expiry target based on articles using fancy techniques.
-
-This is a list of (\"HEADER\" \"REGEXP\" \"TARGET\") entries. If
-`nnmail-expiry-target' is set to the function
-`nnmail-fancy-expiry-target' and HEADER of the article matches REGEXP,
-the message will be expired to a group determined by invoking
-`format-time-string' with TARGET used as the format string and the
-time extracted from the articles' Date header (if missing the current
-time is used).
-
-In the special cases that HEADER is the symbol `to-from', the regexp
-will try to match against both the From and the To header.
-
-Example:
-
-\(setq nnmail-fancy-expiry-targets
- '((to-from \"boss\" \"nnfolder:Work\")
- (\"Subject\" \"IMPORTANT\" \"nnfolder:IMPORTANT.%Y.%b\")
- (\"from\" \".*\" \"nnfolder:Archive-%Y\")))
-
-In this case, articles containing the string \"boss\" in the To or the
-From header will be expired to the group \"nnfolder:Work\";
-articles containing the sting \"IMPORTANT\" in the Subject header will
-be expired to the group \"nnfolder:IMPORTANT.YYYY.MMM\"; and
-everything else will be expired to \"nnfolder:Archive-YYYY\"."
- :version "22.1"
- :group 'nnmail-expire
- :type '(repeat (list (choice :tag "Match against"
- (string :tag "Header")
- (const to-from))
- regexp
- (string :tag "Target group format string"))))
-
-(defcustom nnmail-cache-accepted-message-ids nil
- "If non-nil, put Message-IDs of Gcc'd articles into the duplicate cache.
-If non-nil, also update the cache when copy or move articles."
- :group 'nnmail
- :type 'boolean)
-
-(defcustom nnmail-spool-file '((file))
- "*Where the mail backends will look for incoming mail.
-This variable is a list of mail source specifiers.
-This variable is obsolete; `mail-sources' should be used instead."
- :group 'nnmail-files
- :type 'sexp)
-(make-obsolete-variable 'nnmail-spool-file
- "This option is obsolete in Gnus 5.9. \
-Use `mail-sources' instead.")
-;; revision 5.29 / p0-85 / Gnus 5.9
-
-(defcustom nnmail-resplit-incoming nil
- "*If non-nil, re-split incoming procmail sorted mail."
- :group 'nnmail-procmail
- :type 'boolean)
-
-(defcustom nnmail-scan-directory-mail-source-once nil
- "*If non-nil, scan all incoming procmail sorted mails once.
-It scans low-level sorted spools even when not required."
- :version "21.1"
- :group 'nnmail-procmail
- :type 'boolean)
-
-(defcustom nnmail-delete-file-function 'delete-file
- "Function called to delete files in some mail backends."
- :group 'nnmail-files
- :type 'function)
-
-(defcustom nnmail-crosspost-link-function
- (if (string-match "windows-nt\\|emx" (symbol-name system-type))
- 'copy-file
- 'add-name-to-file)
- "*Function called to create a copy of a file.
-This is `add-name-to-file' by default, which means that crossposts
-will use hard links. If your file system doesn't allow hard
-links, you could set this variable to `copy-file' instead."
- :group 'nnmail-files
- :type '(radio (function-item add-name-to-file)
- (function-item copy-file)
- (function :tag "Other")))
-
-(defcustom nnmail-read-incoming-hook
- (if (eq system-type 'windows-nt)
- '(nnheader-ms-strip-cr)
- nil)
- "*Hook that will be run after the incoming mail has been transferred.
-The incoming mail is moved from the specified spool file (which normally is
-something like \"/usr/spool/mail/$user\") to the user's home
-directory. This hook is called after the incoming mail box has been
-emptied, and can be used to call any mail box programs you have
-running (\"xwatch\", etc.)
-
-Eg.
-
-\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
- (call-process \"/local/bin/mailsend\" nil nil nil
- \"read\" nnmail-spool-file)))
-
-If you have xwatch running, this will alert it that mail has been
-read.
-
-If you use `display-time', you could use something like this:
-
-\(add-hook 'nnmail-read-incoming-hook
- (lambda ()
- ;; Update the displayed time, since that will clear out
- ;; the flag that says you have mail.
- (when (eq (process-status \"display-time\") 'run)
- (display-time-filter display-time-process \"\"))))"
- :group 'nnmail-prepare
- :type 'hook)
-
-(defcustom nnmail-prepare-incoming-hook nil
- "Hook called before treating incoming mail.
-The hook is run in a buffer with all the new, incoming mail."
- :group 'nnmail-prepare
- :type 'hook)
-
-(defcustom nnmail-prepare-incoming-header-hook nil
- "Hook called narrowed to the headers of each message.
-This can be used to remove excessive spaces (and stuff like
-that) from the headers before splitting and saving the messages."
- :group 'nnmail-prepare
- :type 'hook)
-
-(defcustom nnmail-prepare-incoming-message-hook nil
- "Hook called narrowed to each message."
- :group 'nnmail-prepare
- :type 'hook)
-
-(defcustom nnmail-list-identifiers nil
- "Regexp that matches list identifiers to be removed.
-This can also be a list of regexps."
- :group 'nnmail-prepare
- :type '(choice (const :tag "none" nil)
- (regexp :value ".*")
- (repeat :value (".*") regexp)))
-
-(defcustom nnmail-pre-get-new-mail-hook nil
- "Hook called just before starting to handle new incoming mail."
- :group 'nnmail-retrieve
- :type 'hook)
-
-(defcustom nnmail-post-get-new-mail-hook nil
- "Hook called just after finishing handling new incoming mail."
- :group 'nnmail-retrieve
- :type 'hook)
-
-(defcustom nnmail-split-hook nil
- "Hook called before deciding where to split an article.
-The functions in this hook are free to modify the buffer
-contents in any way they choose -- the buffer contents are
-discarded after running the split process."
- :group 'nnmail-split
- :type 'hook)
-
-(defcustom nnmail-spool-hook nil
- "*A hook called when a new article is spooled."
- :version "22.1"
- :group 'nnmail
- :type 'hook)
-
-(defcustom nnmail-large-newsgroup 50
- "*The number of articles which indicates a large newsgroup or nil.
-If the number of articles is greater than the value, verbose
-messages will be shown to indicate the current status."
- :group 'nnmail-various
- :type '(choice (const :tag "infinite" nil)
- (number :tag "count")))
-
-(define-widget 'nnmail-lazy 'default
- "Base widget for recursive datastructures.
-
-This is copy of the `lazy' widget in Emacs 22.1 provided for compatibility."
- :format "%{%t%}: %v"
- :convert-widget 'widget-value-convert-widget
- :value-create (lambda (widget)
- (let ((value (widget-get widget :value))
- (type (widget-get widget :type)))
- (widget-put widget :children
- (list (widget-create-child-value
- widget (widget-convert type) value)))))
- :value-delete 'widget-children-value-delete
- :value-get (lambda (widget)
- (widget-value (car (widget-get widget :children))))
- :value-inline (lambda (widget)
- (widget-apply (car (widget-get widget :children))
- :value-inline))
- :default-get (lambda (widget)
- (widget-default-get
- (widget-convert (widget-get widget :type))))
- :match (lambda (widget value)
- (widget-apply (widget-convert (widget-get widget :type))
- :match value))
- :validate (lambda (widget)
- (widget-apply (car (widget-get widget :children)) :validate)))
-
-(define-widget 'nnmail-split-fancy 'nnmail-lazy
- "Widget for customizing splits in the variable of the same name."
- :tag "Split"
- :type '(menu-choice :value (any ".*value.*" "misc")
- :tag "Type"
- (string :tag "Destination")
- (list :tag "Use first match (|)" :value (|)
- (const :format "" |)
- (editable-list :inline t nnmail-split-fancy))
- (list :tag "Use all matches (&)" :value (&)
- (const :format "" &)
- (editable-list :inline t nnmail-split-fancy))
- (list :tag "Function with fixed arguments (:)"
- :value (: nil)
- (const :format "" :value :)
- function
- (editable-list :inline t (sexp :tag "Arg"))
- )
- (list :tag "Function with split arguments (!)"
- :value (! nil)
- (const :format "" !)
- function
- (editable-list :inline t nnmail-split-fancy))
- (list :tag "Field match"
- (choice :tag "Field"
- regexp symbol)
- (choice :tag "Match"
- regexp
- (symbol :value mail))
- (repeat :inline t
- :tag "Restrictions"
- (group :inline t
- (const :format "" -)
- regexp))
- nnmail-split-fancy)
- (const :tag "Junk (delete mail)" junk)))
-
-(defcustom nnmail-split-fancy "mail.misc"
- "Incoming mail can be split according to this fancy variable.
-To enable this, set `nnmail-split-methods' to `nnmail-split-fancy'.
-
-The format of this variable is SPLIT, where SPLIT can be one of
-the following:
-
-GROUP: Mail will be stored in GROUP (a string).
-
-\(FIELD VALUE [- RESTRICT [- RESTRICT [...]]] SPLIT): If the message
- field FIELD (a regexp) contains VALUE (a regexp), store the messages
- as specified by SPLIT. If RESTRICT (a regexp) matches some string
- after FIELD and before the end of the matched VALUE, return nil,
- otherwise process SPLIT. Multiple RESTRICTs add up, further
- restricting the possibility of processing SPLIT.
-
-\(| SPLIT...): Process each SPLIT expression until one of them matches.
- A SPLIT expression is said to match if it will cause the mail
- message to be stored in one or more groups.
-
-\(& SPLIT...): Process each SPLIT expression.
-
-\(: FUNCTION optional args): Call FUNCTION with the optional args, in
- the buffer containing the message headers. The return value FUNCTION
- should be a split, which is then recursively processed.
-
-\(! FUNCTION SPLIT): Call FUNCTION with the result of SPLIT. The
- return value FUNCTION should be a split, which is then recursively
- processed.
-
-junk: Mail will be deleted. Use with care! Do not submerge in water!
- Example:
- (setq nnmail-split-fancy
- '(| (\"Subject\" \"MAKE MONEY FAST\" junk)
- ...other.rules.omitted...))
-
-FIELD must match a complete field name. VALUE must match a complete
-word according to the `nnmail-split-fancy-syntax-table' syntax table.
-You can use \".*\" in the regexps to match partial field names or words.
-
-FIELD and VALUE can also be lisp symbols, in that case they are expanded
-as specified in `nnmail-split-abbrev-alist'.
-
-GROUP can contain \\& and \\N which will substitute from matching
-\\(\\) patterns in the previous VALUE.
-
-Example:
-
-\(setq nnmail-split-methods 'nnmail-split-fancy
- nnmail-split-fancy
- ;; Messages from the mailer daemon are not crossposted to any of
- ;; the ordinary groups. Warnings are put in a separate group
- ;; from real errors.
- '(| (\"from\" mail (| (\"subject\" \"warn.*\" \"mail.warning\")
- \"mail.misc\"))
- ;; Non-error messages are crossposted to all relevant
- ;; groups, but we don't crosspost between the group for the
- ;; (ding) list and the group for other (ding) related mail.
- (& (| (any \"ding@ifi\\\\.uio\\\\.no\" \"ding.list\")
- (\"subject\" \"ding\" \"ding.misc\"))
- ;; Other mailing lists...
- (any \"procmail@informatik\\\\.rwth-aachen\\\\.de\" \"procmail.list\")
- (any \"SmartList@informatik\\\\.rwth-aachen\\\\.de\" \"SmartList.list\")
- ;; Both lists below have the same suffix, so prevent
- ;; cross-posting to mkpkg.list of messages posted only to
- ;; the bugs- list, but allow cross-posting when the
- ;; message was really cross-posted.
- (any \"bugs-mypackage@somewhere\" \"mypkg.bugs\")
- (any \"mypackage@somewhere\" - \"bugs-mypackage\" \"mypkg.list\")
- ;;
- ;; People...
- (any \"larsi@ifi\\\\.uio\\\\.no\" \"people.Lars Magne Ingebrigtsen\"))
- ;; Unmatched mail goes to the catch all group.
- \"misc.misc\"))"
- :group 'nnmail-split
- :type 'nnmail-split-fancy)
-
-(defcustom nnmail-split-abbrev-alist
- '((any . "from\\|to\\|cc\\|sender\\|apparently-to\\|resent-from\\|resent-to\\|resent-cc")
- (mail . "mailer-daemon\\|postmaster\\|uucp")
- (to . "to\\|cc\\|apparently-to\\|resent-to\\|resent-cc")
- (from . "from\\|sender\\|resent-from")
- (nato . "to\\|cc\\|resent-to\\|resent-cc")
- (naany . "from\\|to\\|cc\\|sender\\|resent-from\\|resent-to\\|resent-cc"))
- "*Alist of abbreviations allowed in `nnmail-split-fancy'."
- :group 'nnmail-split
- :type '(repeat (cons :format "%v" symbol regexp)))
-
-(defcustom nnmail-message-id-cache-length 1000
- "*The approximate number of Message-IDs nnmail will keep in its cache.
-If this variable is nil, no checking on duplicate messages will be
-performed."
- :group 'nnmail-duplicate
- :type '(choice (const :tag "disable" nil)
- (integer :format "%v")))
-
-(defcustom nnmail-message-id-cache-file
- (nnheader-concat gnus-home-directory ".nnmail-cache")
- "The file name of the nnmail Message-ID cache."
- :group 'nnmail-duplicate
- :group 'nnmail-files
- :type 'file)
-
-(defcustom nnmail-treat-duplicates 'warn
- "*If non-nil, nnmail keep a cache of Message-IDs to discover mail duplicates.
-Three values are valid: nil, which means that nnmail is not to keep a
-Message-ID cache; `warn', which means that nnmail should insert extra
-headers to warn the user about the duplication (this is the default);
-and `delete', which means that nnmail will delete duplicated mails.
-
-This variable can also be a function. It will be called from a buffer
-narrowed to the article in question with the Message-ID as a
-parameter. It should return nil, `warn' or `delete'."
- :group 'nnmail-duplicate
- :type '(choice (const :tag "off" nil)
- (const warn)
- (const delete)))
-
-(defcustom nnmail-extra-headers '(To Newsgroups)
- "*Extra headers to parse."
- :version "21.1"
- :group 'nnmail
- :type '(repeat symbol))
-
-(defcustom nnmail-split-header-length-limit 2048
- "Header lines longer than this limit are excluded from the split function."
- :version "21.1"
- :group 'nnmail
- :type 'integer)
-
-(defcustom nnmail-mail-splitting-charset nil
- "Default charset to be used when splitting incoming mail."
- :version "22.1"
- :group 'nnmail
- :type 'symbol)
-
-(defcustom nnmail-mail-splitting-decodes nil
- "Whether the nnmail splitting functionality should MIME decode headers."
- :version "22.1"
- :group 'nnmail
- :type 'boolean)
-
-(defcustom nnmail-split-fancy-match-partial-words nil
- "Whether to match partial words when fancy splitting.
-Normally, regexes given in `nnmail-split-fancy' are implicitly surrounded
-by \"\\=\\<...\\>\". If this variable is true, they are not implicitly\
- surrounded
-by anything."
- :version "22.1"
- :group 'nnmail
- :type 'boolean)
-
-(defcustom nnmail-split-lowercase-expanded t
- "Whether to lowercase expanded entries (i.e. \\N) when splitting mails.
-This avoids the creation of multiple groups when users send to an address
-using different case (i.e. mailing-list@domain vs Mailing-List@Domain)."
- :version "22.1"
- :group 'nnmail
- :type 'boolean)
-
-;;; Internal variables.
-
-(defvar nnmail-article-buffer " *nnmail incoming*"
- "The buffer used for splitting incoming mails.")
-
-(defvar nnmail-split-history nil
- "List of group/article elements that say where the previous split put messages.")
-
-(defvar nnmail-split-fancy-syntax-table
- (let ((table (make-syntax-table)))
- ;; support the %-hack
- (modify-syntax-entry ?\% "." table)
- table)
- "Syntax table used by `nnmail-split-fancy'.")
-
-(defvar nnmail-prepare-save-mail-hook nil
- "Hook called before saving mail.")
-
-(defvar nnmail-split-tracing nil)
-(defvar nnmail-split-trace nil)
-
-\f
-
-(defun nnmail-request-post (&optional server)
- (mail-send-and-exit nil))
-
-(defvar nnmail-file-coding-system 'raw-text
- "Coding system used in nnmail.")
-
-(defvar nnmail-incoming-coding-system
- mm-text-coding-system
- "Coding system used in reading inbox")
-
-(defvar nnmail-pathname-coding-system nil
- "*Coding system for file name.")
-
-(defun nnmail-find-file (file)
- "Insert FILE in server buffer safely."
- (set-buffer nntp-server-buffer)
- (delete-region (point-min) (point-max))
- (let ((format-alist nil)
- (after-insert-file-functions nil))
- (condition-case ()
- (let ((coding-system-for-read nnmail-file-coding-system)
- (auto-mode-alist (mm-auto-mode-alist))
- (file-name-coding-system nnmail-pathname-coding-system))
- (insert-file-contents file)
- t)
- (file-error nil))))
-
-(defun nnmail-group-pathname (group dir &optional file)
- "Make file name for GROUP."
- (concat
- (let ((dir (file-name-as-directory (expand-file-name dir))))
- (setq group (nnheader-replace-duplicate-chars-in-string
- (nnheader-replace-chars-in-string group ?/ ?_)
- ?. ?_))
- (setq group (nnheader-translate-file-chars group))
- ;; If this directory exists, we use it directly.
- (file-name-as-directory
- (if (or nnmail-use-long-file-names
- (file-directory-p (concat dir group)))
- (expand-file-name group dir)
- ;; If not, we translate dots into slashes.
- (expand-file-name
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string group ?. ?/)
- nnmail-pathname-coding-system)
- dir))))
- (or file "")))
-
-(defun nnmail-get-active ()
- "Returns an assoc of group names and active ranges.
-nn*-request-list should have been called before calling this function."
- ;; Go through all groups from the active list.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (nnmail-parse-active)))
-
-(defun nnmail-parse-active ()
- "Parse the active file in the current buffer and return an alist."
- (goto-char (point-min))
- (unless (re-search-forward "[\\\"]" nil t)
- (goto-char (point-max))
- (while (re-search-backward "[][';?()#]" nil t)
- (insert ?\\)))
- (goto-char (point-min))
- (let ((buffer (current-buffer))
- group-assoc group max min)
- (while (not (eobp))
- (condition-case err
- (progn
- (narrow-to-region (point) (gnus-point-at-eol))
- (setq group (read buffer))
- (unless (stringp group)
- (setq group (symbol-name group)))
- (if (and (numberp (setq max (read buffer)))
- (numberp (setq min (read buffer))))
- (push (list group (cons min max))
- group-assoc)))
- (error nil))
- (widen)
- (forward-line 1))
- group-assoc))
-
-(defvar nnmail-active-file-coding-system 'raw-text
- "*Coding system for active file.")
-
-(defun nnmail-save-active (group-assoc file-name)
- "Save GROUP-ASSOC in ACTIVE-FILE."
- (let ((coding-system-for-write nnmail-active-file-coding-system))
- (when file-name
- (with-temp-file file-name
- (nnmail-generate-active group-assoc)))))
-
-(defun nnmail-generate-active (alist)
- "Generate an active file from group-alist ALIST."
- (erase-buffer)
- (let (group)
- (while (setq group (pop alist))
- (insert (format "%S %d %d y\n" (intern (car group)) (cdadr group)
- (caadr group))))
- (goto-char (point-max))
- (while (search-backward "\\." nil t)
- (delete-char 1))))
-
-(defun nnmail-get-split-group (file source)
- "Find out whether this FILE is to be split into GROUP only.
-If SOURCE is a directory spec, try to return the group name component."
- (if (eq (car source) 'directory)
- (let ((file (file-name-nondirectory file)))
- (mail-source-bind (directory source)
- (if (string-match (concat (regexp-quote suffix) "$") file)
- (substring file 0 (match-beginning 0))
- nil)))
- nil))
-
-(defun nnmail-process-babyl-mail-format (func artnum-func)
- (let ((case-fold-search t)
- (count 0)
- start message-id content-length do-search end)
- (while (not (eobp))
- (goto-char (point-min))
- (re-search-forward
- "\f\n0, *unseen,+\n\\(\\*\\*\\* EOOH \\*\\*\\*\n\\)?" nil t)
- (goto-char (match-end 0))
- (delete-region (match-beginning 0) (match-end 0))
- (narrow-to-region
- (setq start (point))
- (progn
- ;; Skip all the headers in case there are more "From "s...
- (or (search-forward "\n\n" nil t)
- (search-forward-regexp "^[^:]*\\( .*\\|\\)$" nil t)
- (search-forward "\1f\f"))
- (point)))
- ;; Unquote the ">From " line, if any.
- (goto-char (point-min))
- (when (looking-at ">From ")
- (replace-match "X-From-Line: ") )
- (run-hooks 'nnmail-prepare-incoming-header-hook)
- (goto-char (point-max))
- ;; Find the Message-ID header.
- (save-excursion
- (if (re-search-backward
- "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]*>\\)" nil t)
- (setq message-id (buffer-substring (match-beginning 1)
- (match-end 1)))
- ;; There is no Message-ID here, so we create one.
- (save-excursion
- (when (re-search-backward "^Message-ID[ \t]*:" nil t)
- (beginning-of-line)
- (insert "Original-")))
- (forward-line -1)
- (insert "Message-ID: " (setq message-id (nnmail-message-id))
- "\n")))
- ;; Look for a Content-Length header.
- (if (not (save-excursion
- (and (re-search-backward
- "^Content-Length:[ \t]*\\([0-9]+\\)" start t)
- (setq content-length (string-to-number
- (buffer-substring
- (match-beginning 1)
- (match-end 1))))
- ;; We destroy the header, since none of
- ;; the backends ever use it, and we do not
- ;; want to confuse other mailers by having
- ;; a (possibly) faulty header.
- (progn (insert "X-") t))))
- (setq do-search t)
- (widen)
- (if (or (= (+ (point) content-length) (point-max))
- (save-excursion
- (goto-char (+ (point) content-length))
- (looking-at "\1f")))
- (progn
- (goto-char (+ (point) content-length))
- (setq do-search nil))
- (setq do-search t)))
- (widen)
- ;; Go to the beginning of the next article - or to the end
- ;; of the buffer.
- (when do-search
- (if (re-search-forward "^\1f" nil t)
- (goto-char (match-beginning 0))
- (goto-char (1- (point-max)))))
- (delete-char 1) ; delete ^_
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (goto-char (point-min))
- (nnmail-check-duplication message-id func artnum-func)
- (incf count)
- (setq end (point-max))))
- (goto-char end))
- count))
-
-(defsubst nnmail-search-unix-mail-delim ()
- "Put point at the beginning of the next Unix mbox message."
- ;; Algorithm used to find the next article in the
- ;; brain-dead Unix mbox format:
- ;;
- ;; 1) Search for "^From ".
- ;; 2) If we find it, then see whether the previous
- ;; line is blank and the next line looks like a header.
- ;; Then it's possible that this is a mail delim, and we use it.
- (let ((case-fold-search nil)
- found)
- (while (not found)
- (if (not (re-search-forward "^From " nil t))
- (setq found 'no)
- (save-excursion
- (beginning-of-line)
- (when (and (or (bobp)
- (save-excursion
- (forward-line -1)
- (eq (char-after) ?\n)))
- (save-excursion
- (forward-line 1)
- (while (looking-at ">From \\|From ")
- (forward-line 1))
- (looking-at "[^ \n\t:]+[ \n\t]*:")))
- (setq found 'yes)))))
- (beginning-of-line)
- (eq found 'yes)))
-
-(defun nnmail-search-unix-mail-delim-backward ()
- "Put point at the beginning of the current Unix mbox message."
- ;; Algorithm used to find the next article in the
- ;; brain-dead Unix mbox format:
- ;;
- ;; 1) Search for "^From ".
- ;; 2) If we find it, then see whether the previous
- ;; line is blank and the next line looks like a header.
- ;; Then it's possible that this is a mail delim, and we use it.
- (let ((case-fold-search nil)
- found)
- (while (not found)
- (if (not (re-search-backward "^From " nil t))
- (setq found 'no)
- (save-excursion
- (beginning-of-line)
- (when (and (or (bobp)
- (save-excursion
- (forward-line -1)
- (eq (char-after) ?\n)))
- (save-excursion
- (forward-line 1)
- (while (looking-at ">From \\|From ")
- (forward-line 1))
- (looking-at "[^ \n\t:]+[ \n\t]*:")))
- (setq found 'yes)))))
- (beginning-of-line)
- (eq found 'yes)))
-
-(defun nnmail-process-unix-mail-format (func artnum-func)
- (let ((case-fold-search t)
- (count 0)
- start message-id content-length end skip head-end)
- (goto-char (point-min))
- (if (not (and (re-search-forward "^From " nil t)
- (goto-char (match-beginning 0))))
- ;; Possibly wrong format?
- (error "Error, unknown mail format! (Possibly corrupted %s `%s'.)"
- (if (buffer-file-name) "file" "buffer")
- (or (buffer-file-name) (buffer-name)))
- ;; Carry on until the bitter end.
- (while (not (eobp))
- (setq start (point)
- end nil)
- ;; Find the end of the head.
- (narrow-to-region
- start
- (if (search-forward "\n\n" nil t)
- (1- (point))
- ;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
- (while (and (looking-at "From \\|[^ \t]+:")
- (not (eobp)))
- (forward-line 1))
- (point)))
- ;; Find the Message-ID header.
- (goto-char (point-min))
- (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
- (setq message-id (match-string 1))
- (save-excursion
- (when (re-search-forward "^Message-ID[ \t]*:" nil t)
- (beginning-of-line)
- (insert "Original-")))
- ;; There is no Message-ID here, so we create one.
- (forward-line 1)
- (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
- ;; Look for a Content-Length header.
- (goto-char (point-min))
- (if (not (re-search-forward
- "^Content-Length:[ \t]*\\([0-9]+\\)" nil t))
- (setq content-length nil)
- (setq content-length (string-to-number (match-string 1)))
- ;; We destroy the header, since none of the backends ever
- ;; use it, and we do not want to confuse other mailers by
- ;; having a (possibly) faulty header.
- (beginning-of-line)
- (insert "X-"))
- (run-hooks 'nnmail-prepare-incoming-header-hook)
- ;; Find the end of this article.
- (goto-char (point-max))
- (widen)
- (setq head-end (point))
- ;; We try the Content-Length value. The idea: skip over the header
- ;; separator, then check what happens content-length bytes into the
- ;; message body. This should be either the end of the buffer, the
- ;; message separator or a blank line followed by the separator.
- ;; The blank line should probably be deleted. If neither of the
- ;; three is met, the content-length header is probably invalid.
- (when content-length
- (forward-line 1)
- (setq skip (+ (point) content-length))
- (goto-char skip)
- (cond ((or (= skip (point-max))
- (= (1+ skip) (point-max)))
- (setq end (point-max)))
- ((looking-at "From ")
- (setq end skip))
- ((looking-at "[ \t]*\n\\(From \\)")
- (setq end (match-beginning 1)))
- (t (setq end nil))))
- (if end
- (goto-char end)
- ;; No Content-Length, so we find the beginning of the next
- ;; article or the end of the buffer.
- (goto-char head-end)
- (or (nnmail-search-unix-mail-delim)
- (goto-char (point-max))))
- ;; Allow the backend to save the article.
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (goto-char (point-min))
- (incf count)
- (nnmail-check-duplication message-id func artnum-func)
- (setq end (point-max))))
- (goto-char end)))
- count))
-
-(defun nnmail-process-mmdf-mail-format (func artnum-func)
- (let ((delim "^\^A\^A\^A\^A$")
- (case-fold-search t)
- (count 0)
- start message-id end)
- (goto-char (point-min))
- (if (not (and (re-search-forward delim nil t)
- (forward-line 1)))
- ;; Possibly wrong format?
- (error "Error, unknown mail format! (Possibly corrupted.)")
- ;; Carry on until the bitter end.
- (while (not (eobp))
- (setq start (point))
- ;; Find the end of the head.
- (narrow-to-region
- start
- (if (search-forward "\n\n" nil t)
- (1- (point))
- ;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
- (while (and (looking-at "From \\|[^ \t]+:")
- (not (eobp)))
- (forward-line 1))
- (point)))
- ;; Find the Message-ID header.
- (goto-char (point-min))
- (if (re-search-forward "^Message-ID[ \t]*:[ \n\t]*\\(<[^>]+>\\)" nil t)
- (setq message-id (match-string 1))
- ;; There is no Message-ID here, so we create one.
- (save-excursion
- (when (re-search-backward "^Message-ID[ \t]*:" nil t)
- (beginning-of-line)
- (insert "Original-")))
- (forward-line 1)
- (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
- (run-hooks 'nnmail-prepare-incoming-header-hook)
- ;; Find the end of this article.
- (goto-char (point-max))
- (widen)
- (if (re-search-forward delim nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- ;; Allow the backend to save the article.
- (save-excursion
- (save-restriction
- (narrow-to-region start (point))
- (goto-char (point-min))
- (incf count)
- (nnmail-check-duplication message-id func artnum-func)
- (setq end (point-max))))
- (goto-char end)
- (forward-line 2)))
- count))
-
-(defun nnmail-process-maildir-mail-format (func artnum-func)
- ;; In a maildir, every file contains exactly one mail.
- (let ((case-fold-search t)
- message-id)
- (goto-char (point-min))
- ;; Find the end of the head.
- (narrow-to-region
- (point-min)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- ;; This will never happen, but just to be on the safe side --
- ;; if there is no head-body delimiter, we search a bit manually.
- (while (and (looking-at "From \\|[^ \t]+:")
- (not (eobp)))
- (forward-line 1))
- (point)))
- ;; Find the Message-ID header.
- (goto-char (point-min))
- (if (re-search-forward "^Message-ID:[ \t]*\\(<[^>]+>\\)" nil t)
- (setq message-id (match-string 1))
- ;; There is no Message-ID here, so we create one.
- (save-excursion
- (when (re-search-backward "^Message-ID[ \t]*:" nil t)
- (beginning-of-line)
- (insert "Original-")))
- (forward-line 1)
- (insert "Message-ID: " (setq message-id (nnmail-message-id)) "\n"))
- (run-hooks 'nnmail-prepare-incoming-header-hook)
- ;; Allow the backend to save the article.
- (widen)
- (save-excursion
- (goto-char (point-min))
- (nnmail-check-duplication message-id func artnum-func))
- 1))
-
-(defun nnmail-split-incoming (incoming func &optional exit-func
- group artnum-func)
- "Go through the entire INCOMING file and pick out each individual mail.
-FUNC will be called with the buffer narrowed to each mail."
- (let ( ;; If this is a group-specific split, we bind the split
- ;; methods to just this group.
- (nnmail-split-methods (if (and group
- (not nnmail-resplit-incoming))
- (list (list group ""))
- nnmail-split-methods)))
- (save-excursion
- ;; Insert the incoming file.
- (set-buffer (get-buffer-create nnmail-article-buffer))
- (erase-buffer)
- (let ((coding-system-for-read nnmail-incoming-coding-system))
- (mm-insert-file-contents incoming))
- (prog1
- (if (zerop (buffer-size))
- 0
- (goto-char (point-min))
- (save-excursion (run-hooks 'nnmail-prepare-incoming-hook))
- ;; Handle both babyl, MMDF and unix mail formats, since
- ;; movemail will use the former when fetching from a
- ;; mailbox, the latter when fetching from a file.
- (cond ((or (looking-at "\^L")
- (looking-at "BABYL OPTIONS:"))
- (nnmail-process-babyl-mail-format func artnum-func))
- ((looking-at "\^A\^A\^A\^A")
- (nnmail-process-mmdf-mail-format func artnum-func))
- ((looking-at "Return-Path:")
- (nnmail-process-maildir-mail-format func artnum-func))
- (t
- (nnmail-process-unix-mail-format func artnum-func))))
- (when exit-func
- (funcall exit-func))
- (kill-buffer (current-buffer))))))
-
-(defun nnmail-article-group (func &optional trace)
- "Look at the headers and return an alist of groups that match.
-FUNC will be called with the group name to determine the article number."
- (let ((methods (or nnmail-split-methods '(("bogus" ""))))
- (obuf (current-buffer))
- group-art method grp)
- (if (and (sequencep methods)
- (= (length methods) 1))
- ;; If there is only just one group to put everything in, we
- ;; just return a list with just this one method in.
- (setq group-art
- (list (cons (caar methods) (funcall func (caar methods)))))
- ;; We do actual comparison.
- (save-excursion
- ;; Copy the article into the work buffer.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring obuf)
- ;; Narrow to headers.
- (narrow-to-region
- (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (point)
- (point-max)))
- (goto-char (point-min))
- ;; Decode MIME headers and charsets.
- (when nnmail-mail-splitting-decodes
- (let ((mail-parse-charset nnmail-mail-splitting-charset))
- (mail-decode-encoded-word-region (point-min) (point-max))))
- ;; Fold continuation lines.
- (goto-char (point-min))
- (while (re-search-forward "\\(\r?\n[ \t]+\\)+" nil t)
- (replace-match " " t t))
- ;; Nuke pathologically long headers. Since Gnus applies
- ;; pathologically complex regexps to the buffer, lines
- ;; that are looong will take longer than the Universe's
- ;; existence to process.
- (goto-char (point-min))
- (while (not (eobp))
- (unless (< (move-to-column nnmail-split-header-length-limit)
- nnmail-split-header-length-limit)
- (delete-region (point) (gnus-point-at-eol)))
- (forward-line 1))
- ;; Allow washing.
- (goto-char (point-min))
- (run-hooks 'nnmail-split-hook)
- (when (setq nnmail-split-tracing trace)
- (setq nnmail-split-trace nil))
- (if (and (symbolp nnmail-split-methods)
- (fboundp nnmail-split-methods))
- (let ((split
- (condition-case error-info
- ;; `nnmail-split-methods' is a function, so we
- ;; just call this function here and use the
- ;; result.
- (or (funcall nnmail-split-methods)
- '("bogus"))
- (error
- (nnheader-message
- 5 "Error in `nnmail-split-methods'; using `bogus' mail group: %S" error-info)
- (sit-for 1)
- '("bogus")))))
- (setq split (mm-delete-duplicates split))
- ;; The article may be "cross-posted" to `junk'. What
- ;; to do? Just remove the `junk' spec. Don't really
- ;; see anything else to do...
- (let (elem)
- (while (setq elem (car (memq 'junk split)))
- (setq split (delq elem split))))
- (when split
- (setq group-art
- (mapcar
- (lambda (group) (cons group (funcall func group)))
- split))))
- ;; Go through the split methods to find a match.
- (while (and methods
- (or nnmail-crosspost
- (not group-art)))
- (goto-char (point-max))
- (setq method (pop methods)
- grp (car method))
- (if (or methods
- (not (equal "" (nth 1 method))))
- (when (and
- (ignore-errors
- (if (stringp (nth 1 method))
- (let ((expand (string-match "\\\\[0-9&]" grp))
- (pos (re-search-backward (cadr method)
- nil t)))
- (and expand
- (setq grp (nnmail-expand-newtext grp)))
- pos)
- ;; Function to say whether this is a match.
- (funcall (nth 1 method) grp)))
- ;; Don't enter the article into the same
- ;; group twice.
- (not (assoc grp group-art)))
- (push (cons grp (funcall func grp))
- group-art))
- ;; This is the final group, which is used as a
- ;; catch-all.
- (unless group-art
- (setq group-art
- (list (cons (car method)
- (funcall func (car method))))))))
- ;; Fall back on "bogus" if all else fails.
- (unless group-art
- (setq group-art (list (cons "bogus" (funcall func "bogus"))))))
- ;; Produce a trace if non-empty.
- (when (and trace nnmail-split-trace)
- (let ((restore (current-buffer)))
- (nnheader-set-temp-buffer "*Split Trace*")
- (gnus-add-buffer)
- (dolist (trace (nreverse nnmail-split-trace))
- (prin1 trace (current-buffer))
- (insert "\n"))
- (goto-char (point-min))
- (gnus-configure-windows 'split-trace)
- (set-buffer restore)))
- (widen)
- ;; See whether the split methods returned `junk'.
- (if (equal group-art '(junk))
- nil
- ;; The article may be "cross-posted" to `junk'. What
- ;; to do? Just remove the `junk' spec. Don't really
- ;; see anything else to do...
- (let (elem)
- (while (setq elem (car (memq 'junk group-art)))
- (setq group-art (delq elem group-art)))
- (nreverse group-art)))))))
-
-(defun nnmail-insert-lines ()
- "Insert how many lines there are in the body of the mail.
-Return the number of characters in the body."
- (let (lines chars)
- (save-excursion
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max))
- (insert "\n"))
- (setq chars (- (point-max) (point)))
- (setq lines (count-lines (point) (point-max)))
- (forward-char -1)
- (save-excursion
- (when (re-search-backward "^Lines: " nil t)
- (delete-region (point) (progn (forward-line 1) (point)))))
- (beginning-of-line)
- (insert (format "Lines: %d\n" (max lines 0)))
- chars)))
-
-(defun nnmail-insert-xref (group-alist)
- "Insert an Xref line based on the (group . article) alist."
- (save-excursion
- (goto-char (point-min))
- (unless (search-forward "\n\n" nil t)
- (goto-char (point-max))
- (insert "\n"))
- (forward-char -1)
- (when (re-search-backward "^Xref: " nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- (insert (format "Xref: %s" (system-name)))
- (while group-alist
- (insert (format " %s:%d"
- (mm-encode-coding-string
- (caar group-alist)
- nnmail-pathname-coding-system)
- (cdar group-alist)))
- (setq group-alist (cdr group-alist)))
- (insert "\n")))
-
-;;; Message washing functions
-
-(defun nnmail-remove-leading-whitespace ()
- "Remove excessive whitespace from all headers."
- (goto-char (point-min))
- (while (re-search-forward "^\\([^ :]+: \\) +" nil t)
- (replace-match "\\1" t)))
-
-(defun nnmail-remove-list-identifiers ()
- "Remove list identifiers from Subject headers."
- (let ((regexp
- (if (consp nnmail-list-identifiers)
- (mapconcat 'identity nnmail-list-identifiers " *\\|")
- nnmail-list-identifiers)))
- (when regexp
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^Subject: +\\(R[Ee]: +\\)*\\(" regexp " *\\)")
- nil t)
- (delete-region (match-beginning 2) (match-end 0))
- (beginning-of-line))
- (when (re-search-forward "^Subject: +\\(\\(R[Ee]: +\\)+\\)R[Ee]: +"
- nil t)
- (delete-region (match-beginning 1) (match-end 1))
- (beginning-of-line)))))
-
-(defun nnmail-remove-tabs ()
- "Translate TAB characters into SPACE characters."
- (subst-char-in-region (point-min) (point-max) ?\t ? t))
-
-(defun nnmail-fix-eudora-headers ()
- "Eudora has a broken References line, but an OK In-Reply-To."
- (goto-char (point-min))
- (when (re-search-forward "^X-Mailer:.*Eudora" nil t)
- (goto-char (point-min))
- (when (re-search-forward "^References:" nil t)
- (beginning-of-line)
- (insert "X-Gnus-Broken-Eudora-"))
- (goto-char (point-min))
- (when (re-search-forward "^\\(In-Reply-To:[^\n]+\\)\n[ \t]+" nil t)
- (replace-match "\\1" t))))
-
-(custom-add-option 'nnmail-prepare-incoming-header-hook
- 'nnmail-fix-eudora-headers)
-
-;;; Utility functions
-
-(defun nnmail-do-request-post (accept-func &optional server)
- "Utility function to directly post a message to an nnmail-derived group.
-Calls ACCEPT-FUNC (which should be `nnchoke-request-accept-article')
-to actually put the message in the right group."
- (let ((success t))
- (dolist (mbx (message-unquote-tokens
- (message-tokenize-header
- (message-fetch-field "Newsgroups") ", ")) success)
- (let ((to-newsgroup (gnus-group-prefixed-name mbx gnus-command-method)))
- (or (gnus-active to-newsgroup)
- (gnus-activate-group to-newsgroup)
- (if (gnus-y-or-n-p (format "No such group: %s. Create it? "
- to-newsgroup))
- (or (and (gnus-request-create-group
- to-newsgroup gnus-command-method)
- (gnus-activate-group to-newsgroup nil nil
- gnus-command-method))
- (error "Couldn't create group %s" to-newsgroup)))
- (error "No such group: %s" to-newsgroup))
- (unless (funcall accept-func mbx (nth 1 gnus-command-method))
- (setq success nil))))))
-
-(defun nnmail-split-fancy ()
- "Fancy splitting method.
-See the documentation for the variable `nnmail-split-fancy' for details."
- (let ((syntab (syntax-table)))
- (unwind-protect
- (progn
- (set-syntax-table nnmail-split-fancy-syntax-table)
- (nnmail-split-it nnmail-split-fancy))
- (set-syntax-table syntab))))
-
-(defvar nnmail-split-cache nil)
-;; Alist of split expressions their equivalent regexps.
-
-(defun nnmail-split-it (split)
- ;; Return a list of groups matching SPLIT.
- (let (cached-pair)
- (cond
- ;; nil split
- ((null split)
- nil)
-
- ;; A group name. Do the \& and \N subs into the string.
- ((stringp split)
- (when nnmail-split-tracing
- (push split nnmail-split-trace))
- (list (nnmail-expand-newtext split)))
-
- ;; Junk the message.
- ((eq split 'junk)
- (when nnmail-split-tracing
- (push "junk" nnmail-split-trace))
- (list 'junk))
-
- ;; Builtin & operation.
- ((eq (car split) '&)
- (apply 'nconc (mapcar 'nnmail-split-it (cdr split))))
-
- ;; Builtin | operation.
- ((eq (car split) '|)
- (let (done)
- (while (and (not done) (cdr split))
- (setq split (cdr split)
- done (nnmail-split-it (car split))))
- done))
-
- ;; Builtin : operation.
- ((eq (car split) ':)
- (when nnmail-split-tracing
- (push split nnmail-split-trace))
- (nnmail-split-it (save-excursion (eval (cdr split)))))
-
- ;; Builtin ! operation.
- ((eq (car split) '!)
- (funcall (cadr split) (nnmail-split-it (caddr split))))
-
- ;; Check the cache for the regexp for this split.
- ((setq cached-pair (assq split nnmail-split-cache))
- (let (split-result
- (end-point (point-max))
- (value (nth 1 split)))
- (if (symbolp value)
- (setq value (cdr (assq value nnmail-split-abbrev-alist))))
- (while (and (goto-char end-point)
- (re-search-backward (cdr cached-pair) nil t))
- (when nnmail-split-tracing
- (push split nnmail-split-trace))
- (let ((split-rest (cddr split))
- (end (match-end 0))
- ;; The searched regexp is \(\(FIELD\).*\)\(VALUE\).
- ;; So, start-of-value is the point just before the
- ;; beginning of the value, whereas after-header-name
- ;; is the point just after the field name.
- (start-of-value (match-end 1))
- (after-header-name (match-end 2)))
- ;; Start the next search just before the beginning of the
- ;; VALUE match.
- (setq end-point (1- start-of-value))
- ;; Handle - RESTRICTs
- (while (eq (car split-rest) '-)
- ;; RESTRICT must start after-header-name and
- ;; end after start-of-value, so that, for
- ;; (any "foo" - "x-foo" "foo.list")
- ;; we do not exclude foo.list just because
- ;; the header is: ``To: x-foo, foo''
- (goto-char end)
- (if (and (re-search-backward (cadr split-rest)
- after-header-name t)
- (> (match-end 0) start-of-value))
- (setq split-rest nil)
- (setq split-rest (cddr split-rest))))
- (when split-rest
- (goto-char end)
- (let ((value (nth 1 split)))
- (if (symbolp value)
- (setq value (cdr (assq value nnmail-split-abbrev-alist))))
- ;; Someone might want to do a \N sub on this match, so get the
- ;; correct match positions.
- (re-search-backward value start-of-value))
- (dolist (sp (nnmail-split-it (car split-rest)))
- (unless (member sp split-result)
- (push sp split-result))))))
- split-result))
-
- ;; Not in cache, compute a regexp for the field/value pair.
- (t
- (let ((field (nth 0 split))
- (value (nth 1 split))
- (split-rest (cddr split))
- partial-front
- partial-rear
- regexp)
- (if (symbolp value)
- (setq value (cdr (assq value nnmail-split-abbrev-alist))))
- (if (and (>= (length value) 2)
- (string= ".*" (substring value 0 2)))
- (setq value (substring value 2)
- partial-front ""))
- ;; Same trick for the rear of the regexp
- (if (and (>= (length value) 2)
- (string= ".*" (substring value -2)))
- (setq value (substring value 0 -2)
- partial-rear ""))
- ;; Invert the match-partial-words behavior if the optional
- ;; last element is specified.
- (while (eq (car split-rest) '-)
- (setq split-rest (cddr split-rest)))
- (when (if (cadr split-rest)
- (not nnmail-split-fancy-match-partial-words)
- nnmail-split-fancy-match-partial-words)
- (setq partial-front ""
- partial-rear ""))
- (setq regexp (concat "^\\(\\("
- (if (symbolp field)
- (cdr (assq field nnmail-split-abbrev-alist))
- field)
- "\\):.*\\)"
- (or partial-front "\\<")
- "\\("
- value
- "\\)"
- (or partial-rear "\\>")))
- (push (cons split regexp) nnmail-split-cache)
- ;; Now that it's in the cache, just call nnmail-split-it again
- ;; on the same split, which will find it immediately in the cache.
- (nnmail-split-it split))))))
-
-(defun nnmail-expand-newtext (newtext)
- (let ((len (length newtext))
- (pos 0)
- c expanded beg N did-expand)
- (while (< pos len)
- (setq beg pos)
- (while (and (< pos len)
- (not (= (aref newtext pos) ?\\)))
- (setq pos (1+ pos)))
- (unless (= beg pos)
- (push (substring newtext beg pos) expanded))
- (when (< pos len)
- ;; We hit a \; expand it.
- (setq did-expand t
- pos (1+ pos)
- c (aref newtext pos))
- (if (not (or (= c ?\&)
- (and (>= c ?1)
- (<= c ?9))))
- ;; \ followed by some character we don't expand.
- (push (char-to-string c) expanded)
- ;; \& or \N
- (if (= c ?\&)
- (setq N 0)
- (setq N (- c ?0)))
- (when (match-beginning N)
- (push (if nnmail-split-lowercase-expanded
- (downcase (buffer-substring (match-beginning N)
- (match-end N)))
- (buffer-substring (match-beginning N) (match-end N)))
- expanded))))
- (setq pos (1+ pos)))
- (if did-expand
- (apply 'concat (nreverse expanded))
- newtext)))
-
-;; Activate a backend only if it isn't already activated.
-;; If FORCE, re-read the active file even if the backend is
-;; already activated.
-(defun nnmail-activate (backend &optional force)
- (nnheader-init-server-buffer)
- (let (file timestamp file-time)
- (if (or (not (symbol-value (intern (format "%s-group-alist" backend))))
- force
- (and (setq file (ignore-errors
- (symbol-value (intern (format "%s-active-file"
- backend)))))
- (setq file-time (nth 5 (file-attributes file)))
- (or (not
- (setq timestamp
- (condition-case ()
- (symbol-value (intern
- (format "%s-active-timestamp"
- backend)))
- (error 'none))))
- (not (consp timestamp))
- (equal timestamp '(0 0))
- (> (nth 0 file-time) (nth 0 timestamp))
- (and (= (nth 0 file-time) (nth 0 timestamp))
- (> (nth 1 file-time) (nth 1 timestamp))))))
- (save-excursion
- (or (eq timestamp 'none)
- (set (intern (format "%s-active-timestamp" backend))
- file-time))
- (funcall (intern (format "%s-request-list" backend)))))
- t))
-
-(defun nnmail-message-id ()
- (concat "<" (message-unique-id) "@totally-fudged-out-message-id>"))
-
-;;;
-;;; nnmail duplicate handling
-;;;
-
-(defvar nnmail-cache-buffer nil)
-
-(defun nnmail-cache-open ()
- (if (or (not nnmail-treat-duplicates)
- (and nnmail-cache-buffer
- (buffer-name nnmail-cache-buffer)))
- () ; The buffer is open.
- (save-excursion
- (set-buffer
- (setq nnmail-cache-buffer
- (get-buffer-create " *nnmail message-id cache*")))
- (gnus-add-buffer)
- (when (file-exists-p nnmail-message-id-cache-file)
- (nnheader-insert-file-contents nnmail-message-id-cache-file))
- (set-buffer-modified-p nil)
- (current-buffer))))
-
-(defun nnmail-cache-close ()
- (when (and nnmail-cache-buffer
- nnmail-treat-duplicates
- (buffer-name nnmail-cache-buffer)
- (buffer-modified-p nnmail-cache-buffer))
- (save-excursion
- (set-buffer nnmail-cache-buffer)
- ;; Weed out the excess number of Message-IDs.
- (goto-char (point-max))
- (when (search-backward "\n" nil t nnmail-message-id-cache-length)
- (progn
- (beginning-of-line)
- (delete-region (point-min) (point))))
- ;; Save the buffer.
- (or (file-exists-p (file-name-directory nnmail-message-id-cache-file))
- (make-directory (file-name-directory nnmail-message-id-cache-file)
- t))
- (nnmail-write-region (point-min) (point-max)
- nnmail-message-id-cache-file nil 'silent)
- (set-buffer-modified-p nil)
- (setq nnmail-cache-buffer nil)
- (gnus-kill-buffer (current-buffer)))))
-
-;; Compiler directives.
-(defvar group)
-(defvar group-art-list)
-(defvar group-art)
-(defun nnmail-cache-insert (id grp &optional subject sender)
- (when (stringp id)
- ;; this will handle cases like `B r' where the group is nil
- (let ((grp (or grp gnus-newsgroup-name "UNKNOWN")))
- (run-hook-with-args 'nnmail-spool-hook
- id grp subject sender))
- (when nnmail-treat-duplicates
- ;; Store some information about the group this message is written
- ;; to. This is passed in as the grp argument -- all locations this
- ;; has been called from have been checked and the group is available.
- ;; The only ambiguous case is nnmail-check-duplication which will only
- ;; pass the first (of possibly >1) group which matches. -Josh
- (unless (gnus-buffer-live-p nnmail-cache-buffer)
- (nnmail-cache-open))
- (save-excursion
- (set-buffer nnmail-cache-buffer)
- (goto-char (point-max))
- (if (and grp (not (string= "" grp))
- (gnus-methods-equal-p gnus-command-method
- (nnmail-cache-primary-mail-backend)))
- (let ((regexp (if (consp nnmail-cache-ignore-groups)
- (mapconcat 'identity nnmail-cache-ignore-groups
- "\\|")
- nnmail-cache-ignore-groups)))
- (unless (and regexp (string-match regexp grp))
- (insert id "\t" grp "\n")))
- (insert id "\n"))))))
-
-(defun nnmail-cache-primary-mail-backend ()
- (let ((be-list (cons gnus-select-method gnus-secondary-select-methods))
- (be nil)
- (res nil)
- (get-new-mail nil))
- (while (and (null res) be-list)
- (setq be (car be-list))
- (setq be-list (cdr be-list))
- (when (and (gnus-method-option-p be 'respool)
- (setq get-new-mail
- (intern (format "%s-get-new-mail" (car be))))
- (boundp get-new-mail)
- (symbol-value get-new-mail))
- (setq res be)))
- res))
-
-;; Fetch the group name corresponding to the message id stored in the
-;; cache.
-(defun nnmail-cache-fetch-group (id)
- (when (and nnmail-treat-duplicates nnmail-cache-buffer)
- (save-excursion
- (set-buffer nnmail-cache-buffer)
- (goto-char (point-max))
- (when (search-backward id nil t)
- (beginning-of-line)
- (skip-chars-forward "^\n\r\t")
- (unless (looking-at "[\r\n]")
- (forward-char 1)
- (buffer-substring (point) (gnus-point-at-eol)))))))
-
-;; Function for nnmail-split-fancy: look up all references in the
-;; cache and if a match is found, return that group.
-(defun nnmail-split-fancy-with-parent ()
- "Split this message into the same group as its parent.
-This function can be used as an entry in `nnmail-split-fancy', for
-example like this: (: nnmail-split-fancy-with-parent)
-For a message to be split, it looks for the parent message in the
-References or In-Reply-To header and then looks in the message id
-cache file (given by the variable `nnmail-message-id-cache-file') to
-see which group that message was put in. This group is returned.
-
-See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (let* ((refstr (or (message-fetch-field "references")
- (message-fetch-field "in-reply-to")))
- (references nil)
- (res nil)
- (regexp (if (consp nnmail-split-fancy-with-parent-ignore-groups)
- (mapconcat
- (lambda (x) (format "\\(%s\\)" x))
- nnmail-split-fancy-with-parent-ignore-groups
- "\\|")
- nnmail-split-fancy-with-parent-ignore-groups)))
- (when refstr
- (setq references (nreverse (gnus-split-references refstr)))
- (unless (gnus-buffer-live-p nnmail-cache-buffer)
- (nnmail-cache-open))
- (mapcar (lambda (x)
- (setq res (or (nnmail-cache-fetch-group x) res))
- (when (or (member res '("delayed" "drafts" "queue"))
- (and regexp res (string-match regexp res)))
- (setq res nil)))
- references)
- res)))
-
-(defun nnmail-cache-id-exists-p (id)
- (when nnmail-treat-duplicates
- (save-excursion
- (set-buffer nnmail-cache-buffer)
- (goto-char (point-max))
- (search-backward id nil t))))
-
-(defun nnmail-fetch-field (header)
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (message-fetch-field header))))
-
-(defun nnmail-check-duplication (message-id func artnum-func)
- (run-hooks 'nnmail-prepare-incoming-message-hook)
- ;; If this is a duplicate message, then we do not save it.
- (let* ((duplication (nnmail-cache-id-exists-p message-id))
- (case-fold-search t)
- (action (when duplication
- (cond
- ((memq nnmail-treat-duplicates '(warn delete))
- nnmail-treat-duplicates)
- ((functionp nnmail-treat-duplicates)
- (funcall nnmail-treat-duplicates message-id))
- (t
- nnmail-treat-duplicates))))
- group-art)
- ;; We insert a line that says what the mail source is.
- (let ((case-fold-search t))
- (goto-char (point-min))
- (re-search-forward "^message-id[ \t]*:" nil t)
- (beginning-of-line)
- (insert (format "X-Gnus-Mail-Source: %s\n" mail-source-string)))
-
- ;; Let the backend save the article (or not).
- (cond
- ((not duplication)
- (funcall func (setq group-art
- (nreverse (nnmail-article-group artnum-func))))
- (nnmail-cache-insert message-id (caar group-art)))
- ((eq action 'delete)
- (setq group-art nil))
- ((eq action 'warn)
- ;; We insert a warning.
- (let ((case-fold-search t))
- (goto-char (point-min))
- (re-search-forward "^message-id[ \t]*:" nil t)
- (beginning-of-line)
- (insert
- "Gnus-Warning: This is a duplicate of message " message-id "\n")
- (funcall func (setq group-art
- (nreverse (nnmail-article-group artnum-func))))))
- (t
- (funcall func (setq group-art
- (nreverse (nnmail-article-group artnum-func))))))
- ;; Add the group-art list to the history list.
- (if group-art
- (push group-art nnmail-split-history)
- (delete-region (point-min) (point-max)))))
-
-;;; Get new mail.
-
-(defvar nnmail-fetched-sources nil)
-
-(defun nnmail-get-value (&rest args)
- (let ((sym (intern (apply 'format args))))
- (when (boundp sym)
- (symbol-value sym))))
-
-(defun nnmail-get-new-mail (method exit-func temp
- &optional group spool-func)
- "Read new incoming mail."
- (let* ((sources (or mail-sources
- (if (listp nnmail-spool-file)
- nnmail-spool-file
- (list nnmail-spool-file))))
- fetching-sources
- (group-in group)
- (i 0)
- (new 0)
- (total 0)
- incoming incomings source)
- (when (and (nnmail-get-value "%s-get-new-mail" method)
- sources)
- (while (setq source (pop sources))
- ;; Be compatible with old values.
- (cond
- ((stringp source)
- (setq source
- (cond
- ((string-match "^po:" source)
- (list 'pop :user (substring source (match-end 0))))
- ((file-directory-p source)
- (list 'directory :path source))
- (t
- (list 'file :path source)))))
- ((eq source 'procmail)
- (message "Invalid value for nnmail-spool-file: `procmail'")
- nil))
- ;; Hack to only fetch the contents of a single group's spool file.
- (when (and (eq (car source) 'directory)
- (null nnmail-scan-directory-mail-source-once)
- group)
- (mail-source-bind (directory source)
- (setq source (append source
- (list
- :predicate
- (gnus-byte-compile
- `(lambda (file)
- (string-equal
- ,(concat group suffix)
- (file-name-nondirectory file)))))))))
- (when nnmail-fetched-sources
- (if (member source nnmail-fetched-sources)
- (setq source nil)
- (push source nnmail-fetched-sources)
- (push source fetching-sources)))))
- (when fetching-sources
- ;; We first activate all the groups.
- (nnmail-activate method)
- ;; Allow the user to hook.
- (run-hooks 'nnmail-pre-get-new-mail-hook)
- ;; Open the message-id cache.
- (nnmail-cache-open)
- ;; The we go through all the existing mail source specification
- ;; and fetch the mail from each.
- (while (setq source (pop fetching-sources))
- (nnheader-message 4 "%s: Reading incoming mail from %s..."
- method (car source))
- (when (setq new
- (mail-source-fetch
- source
- (gnus-byte-compile
- `(lambda (file orig-file)
- (nnmail-split-incoming
- file ',(intern (format "%s-save-mail" method))
- ',spool-func
- (if (equal file orig-file)
- nil
- (nnmail-get-split-group orig-file ',source))
- ',(intern (format "%s-active-number" method)))))))
- (incf total new)
- (incf i)))
- ;; If we did indeed read any incoming spools, we save all info.
- (if (zerop total)
- (nnheader-message 4 "%s: Reading incoming mail (no new mail)...done"
- method (car source))
- (nnmail-save-active
- (nnmail-get-value "%s-group-alist" method)
- (nnmail-get-value "%s-active-file" method))
- (when exit-func
- (funcall exit-func))
- (run-hooks 'nnmail-read-incoming-hook)
- (nnheader-message 4 "%s: Reading incoming mail (%d new)...done" method
- total))
- ;; Close the message-id cache.
- (nnmail-cache-close)
- ;; Allow the user to hook.
- (run-hooks 'nnmail-post-get-new-mail-hook))))
-
-(defun nnmail-expired-article-p (group time force &optional inhibit)
- "Say whether an article that is TIME old in GROUP should be expired."
- (if force
- t
- (let ((days (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function group))
- nnmail-expiry-wait)))
- (cond ((or (eq days 'never)
- (and (not force)
- inhibit))
- ;; This isn't an expirable group.
- nil)
- ((eq days 'immediate)
- ;; We expire all articles on sight.
- t)
- ((equal time '(0 0))
- ;; This is an ange-ftp group, and we don't have any dates.
- nil)
- ((numberp days)
- (setq days (days-to-time days))
- ;; Compare the time with the current time.
- (ignore-errors (time-less-p days (time-since time))))))))
-
-(defun nnmail-expiry-target-group (target group)
- ;; Do not invoke this from nntp-server-buffer! At least nnfolder clears
- ;; that buffer if the nnfolder group isn't selected.
- (let (nnmail-cache-accepted-message-ids)
- ;; Don't enter Message-IDs into cache.
- ;; Let users hack it in TARGET function.
- (when (functionp target)
- (setq target (funcall target group)))
- (unless (eq target 'delete)
- (when (or (gnus-request-group target)
- (gnus-request-create-group target))
- (let ((group-art (gnus-request-accept-article target nil nil t)))
- (when (consp group-art)
- (gnus-group-mark-article-read target (cdr group-art))))))))
-
-(defun nnmail-fancy-expiry-target (group)
- "Returns a target expiry group determined by `nnmail-fancy-expiry-targets'."
- (let* (header
- (case-fold-search nil)
- (from (or (message-fetch-field "from") ""))
- (to (or (message-fetch-field "to") ""))
- (date (message-fetch-field "date"))
- (target 'delete))
- (setq date (if date
- (condition-case err
- (date-to-time date)
- (error
- (message "%s" (error-message-string err))
- (current-time)))
- (current-time)))
- (dolist (regexp-target-pair (reverse nnmail-fancy-expiry-targets) target)
- (setq header (car regexp-target-pair))
- (cond
- ;; If the header is to-from then match against the
- ;; To or From header
- ((and (equal header 'to-from)
- (or (string-match (cadr regexp-target-pair) from)
- (and (string-match (cadr regexp-target-pair) to)
- (let ((rmail-dont-reply-to-names
- message-dont-reply-to-names))
- (equal (rmail-dont-reply-to from) "")))))
- (setq target (format-time-string (caddr regexp-target-pair) date)))
- ((and (not (equal header 'to-from))
- (string-match (cadr regexp-target-pair)
- (or
- (message-fetch-field header)
- "")))
- (setq target
- (format-time-string (caddr regexp-target-pair) date)))))))
-
-(defun nnmail-check-syntax ()
- "Check (and modify) the syntax of the message in the current buffer."
- (save-restriction
- (message-narrow-to-head)
- (let ((case-fold-search t))
- (unless (re-search-forward "^Message-ID[ \t]*:" nil t)
- (insert "Message-ID: " (nnmail-message-id) "\n")))))
-
-(defun nnmail-write-region (start end filename &optional append visit lockname)
- "Do a `write-region', and then set the file modes."
- (let ((coding-system-for-write nnmail-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (write-region start end filename append visit lockname)
- (set-file-modes filename nnmail-default-file-modes)))
-
-;;;
-;;; Status functions
-;;;
-
-(defun nnmail-replace-status (name value)
- "Make status NAME and VALUE part of the current status line."
- (save-restriction
- (message-narrow-to-head)
- (let ((status (nnmail-decode-status)))
- (setq status (delq (member name status) status))
- (when value
- (push (cons name value) status))
- (message-remove-header "status")
- (goto-char (point-max))
- (insert "Status: " (nnmail-encode-status status) "\n"))))
-
-(defun nnmail-decode-status ()
- "Return a status-value alist from STATUS."
- (goto-char (point-min))
- (when (re-search-forward "^Status: " nil t)
- (let (name value status)
- (save-restriction
- ;; Narrow to the status.
- (narrow-to-region
- (point)
- (if (re-search-forward "^[^ \t]" nil t)
- (1- (point))
- (point-max)))
- ;; Go through all elements and add them to the list.
- (goto-char (point-min))
- (while (re-search-forward "[^ \t=]+" nil t)
- (setq name (match-string 0))
- (if (not (eq (char-after) ?=))
- ;; Implied "yes".
- (setq value "yes")
- (forward-char 1)
- (if (not (eq (char-after) ?\"))
- (if (not (looking-at "[^ \t]"))
- ;; Implied "no".
- (setq value "no")
- ;; Unquoted value.
- (setq value (match-string 0))
- (goto-char (match-end 0)))
- ;; Quoted value.
- (setq value (read (current-buffer)))))
- (push (cons name value) status)))
- status)))
-
-(defun nnmail-encode-status (status)
- "Return a status string from STATUS."
- (mapconcat
- (lambda (elem)
- (concat
- (car elem) "="
- (if (string-match "[ \t]" (cdr elem))
- (prin1-to-string (cdr elem))
- (cdr elem))))
- status " "))
-
-(defun nnmail-split-history ()
- "Generate an overview of where the last mail split put articles."
- (interactive)
- (unless nnmail-split-history
- (error "No current split history"))
- (with-output-to-temp-buffer "*nnmail split history*"
- (with-current-buffer standard-output
- (fundamental-mode)) ; for Emacs 20.4+
- (let ((history nnmail-split-history)
- elem)
- (while (setq elem (pop history))
- (princ (mapconcat (lambda (ga)
- (concat (car ga) ":" (int-to-string (cdr ga))))
- elem
- ", "))
- (princ "\n")))))
-
-(defun nnmail-purge-split-history (group)
- "Remove all instances of GROUP from `nnmail-split-history'."
- (let ((history nnmail-split-history))
- (while history
- (setcar history (gnus-remove-if (lambda (e) (string= (car e) group))
- (car history)))
- (pop history))
- (setq nnmail-split-history (delq nil nnmail-split-history))))
-
-(defun nnmail-new-mail-p (group)
- "Say whether GROUP has new mail."
- (let ((his nnmail-split-history)
- found)
- (while his
- (when (assoc group (pop his))
- (setq found t
- his nil)))
- found))
-
-(defun nnmail-within-headers-p ()
- "Check to see if point is within the headers of a unix mail message.
-Doesn't change point."
- (let ((pos (point)))
- (save-excursion
- (and (nnmail-search-unix-mail-delim-backward)
- (not (search-forward "\n\n" pos t))))))
-
-(run-hooks 'nnmail-load-hook)
-
-(provide 'nnmail)
-
-;;; arch-tag: fe8f671a-50db-428a-bb5d-f00462f72ed7
-;;; nnmail.el ends here
+++ /dev/null
-;;; nnmaildir.el --- maildir backend for Gnus
-;; Public domain.
-
-;; Author: Paul Jarc <prj@po.cwru.edu>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Maildir format is documented at <URL:http://cr.yp.to/proto/maildir.html>
-;; and in the maildir(5) man page from qmail (available at
-;; <URL:http://www.qmail.org/man/man5/maildir.html>). nnmaildir also stores
-;; extra information in the .nnmaildir/ directory within a maildir.
-;;
-;; Some goals of nnmaildir:
-;; * Everything Just Works, and correctly. E.g., NOV data is automatically
-;; regenerated when stale; no need for manually running
-;; *-generate-nov-databases.
-;; * Perfect reliability: [C-g] will never corrupt its data in memory, and
-;; SIGKILL will never corrupt its data in the filesystem.
-;; * Allow concurrent operation as much as possible. If files change out
-;; from under us, adapt to the changes or degrade gracefully.
-;; * We use the filesystem as a database, so that, e.g., it's easy to
-;; manipulate marks from outside Gnus.
-;; * All information about a group is stored in the maildir, for easy backup,
-;; copying, restoring, etc.
-;;
-;; Todo:
-;; * Add a hook for when moving messages from new/ to cur/, to support
-;; nnmail's duplicate detection.
-;; * Improve generated Xrefs, so crossposts are detectable.
-;; * Improve code readability.
-
-;;; Code:
-
-;; eval this before editing
-[(progn
- (put 'nnmaildir--with-nntp-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-work-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-nov-buffer 'lisp-indent-function 0)
- (put 'nnmaildir--with-move-buffer 'lisp-indent-function 0)
- )
-]
-
-(eval-and-compile
- (require 'nnheader)
- (require 'gnus)
- (require 'gnus-util)
- (require 'gnus-range)
- (require 'gnus-start)
- (require 'gnus-int)
- (require 'message))
-(eval-when-compile
- (require 'cl)
- (require 'nnmail))
-
-(defconst nnmaildir-version "Gnus")
-
-(defvar nnmaildir-article-file-name nil
- "*The filename of the most recently requested article. This variable is set
-by nnmaildir-request-article.")
-
-;; The filename of the article being moved/copied:
-(defvar nnmaildir--file nil)
-
-;; Variables to generate filenames of messages being delivered:
-(defvar nnmaildir--delivery-time "")
-(defconst nnmaildir--delivery-pid (concat "P" (number-to-string (emacs-pid))))
-(defvar nnmaildir--delivery-count nil)
-
-;; An obarry containing symbols whose names are server names and whose values
-;; are servers:
-(defvar nnmaildir--servers (make-vector 3 0))
-;; The current server:
-(defvar nnmaildir--cur-server nil)
-
-;; A copy of nnmail-extra-headers
-(defvar nnmaildir--extra nil)
-
-;; A NOV structure looks like this (must be prin1-able, so no defstruct):
-["subject\tfrom\tdate"
- "references\tchars\lines"
- "To: you\tIn-Reply-To: <your.mess@ge>"
- (12345 67890) ;; modtime of the corresponding article file
- (to in-reply-to)] ;; contemporary value of nnmail-extra-headers
-(defconst nnmaildir--novlen 5)
-(defmacro nnmaildir--nov-new (beg mid end mtime extra)
- `(vector ,beg ,mid ,end ,mtime ,extra))
-(defmacro nnmaildir--nov-get-beg (nov) `(aref ,nov 0))
-(defmacro nnmaildir--nov-get-mid (nov) `(aref ,nov 1))
-(defmacro nnmaildir--nov-get-end (nov) `(aref ,nov 2))
-(defmacro nnmaildir--nov-get-mtime (nov) `(aref ,nov 3))
-(defmacro nnmaildir--nov-get-extra (nov) `(aref ,nov 4))
-(defmacro nnmaildir--nov-set-beg (nov value) `(aset ,nov 0 ,value))
-(defmacro nnmaildir--nov-set-mid (nov value) `(aset ,nov 1 ,value))
-(defmacro nnmaildir--nov-set-end (nov value) `(aset ,nov 2 ,value))
-(defmacro nnmaildir--nov-set-mtime (nov value) `(aset ,nov 3 ,value))
-(defmacro nnmaildir--nov-set-extra (nov value) `(aset ,nov 4 ,value))
-
-(defstruct nnmaildir--art
- (prefix nil :type string) ;; "time.pid.host"
- (suffix nil :type string) ;; ":2,flags"
- (num nil :type natnum) ;; article number
- (msgid nil :type string) ;; "<mess.age@id>"
- (nov nil :type vector)) ;; cached nov structure, or nil
-
-(defstruct nnmaildir--grp
- (name nil :type string) ;; "group.name"
- (new nil :type list) ;; new/ modtime
- (cur nil :type list) ;; cur/ modtime
- (min 1 :type natnum) ;; minimum article number
- (count 0 :type natnum) ;; count of articles
- (nlist nil :type list) ;; list of articles, ordered descending by number
- (flist nil :type vector) ;; obarray mapping filename prefix->article
- (mlist nil :type vector) ;; obarray mapping message-id->article
- (cache nil :type vector) ;; nov cache
- (index nil :type natnum) ;; index of next cache entry to replace
- (mmth nil :type vector)) ;; obarray mapping mark name->dir modtime
- ; ("Mark Mod Time Hash")
-
-(defstruct nnmaildir--srv
- (address nil :type string) ;; server address string
- (method nil :type list) ;; (nnmaildir "address" ...)
- (prefix nil :type string) ;; "nnmaildir+address:"
- (dir nil :type string) ;; "/expanded/path/to/server/dir/"
- (ls nil :type function) ;; directory-files function
- (groups nil :type vector) ;; obarray mapping group name->group
- (curgrp nil :type nnmaildir--grp) ;; current group, or nil
- (error nil :type string) ;; last error message, or nil
- (mtime nil :type list) ;; modtime of dir
- (gnm nil) ;; flag: split from mail-sources?
- (target-prefix nil :type string)) ;; symlink target prefix
-
-(defun nnmaildir--expired-article (group article)
- (setf (nnmaildir--art-nov article) nil)
- (let ((flist (nnmaildir--grp-flist group))
- (mlist (nnmaildir--grp-mlist group))
- (min (nnmaildir--grp-min group))
- (count (1- (nnmaildir--grp-count group)))
- (prefix (nnmaildir--art-prefix article))
- (msgid (nnmaildir--art-msgid article))
- (new-nlist nil)
- (nlist-pre '(nil . nil))
- nlist-post num)
- (unless (zerop count)
- (setq nlist-post (nnmaildir--grp-nlist group)
- num (nnmaildir--art-num article))
- (if (eq num (caar nlist-post))
- (setq new-nlist (cdr nlist-post))
- (setq new-nlist nlist-post
- nlist-pre nlist-post
- nlist-post (cdr nlist-post))
- (while (/= num (caar nlist-post))
- (setq nlist-pre nlist-post
- nlist-post (cdr nlist-post)))
- (setq nlist-post (cdr nlist-post))
- (if (eq num min)
- (setq min (caar nlist-pre)))))
- (let ((inhibit-quit t))
- (setf (nnmaildir--grp-min group) min)
- (setf (nnmaildir--grp-count group) count)
- (setf (nnmaildir--grp-nlist group) new-nlist)
- (setcdr nlist-pre nlist-post)
- (unintern prefix flist)
- (unintern msgid mlist))))
-
-(defun nnmaildir--nlist-art (group num)
- (let ((entry (assq num (nnmaildir--grp-nlist group))))
- (if entry
- (cdr entry))))
-(defmacro nnmaildir--flist-art (list file)
- `(symbol-value (intern-soft ,file ,list)))
-(defmacro nnmaildir--mlist-art (list msgid)
- `(symbol-value (intern-soft ,msgid ,list)))
-
-(defun nnmaildir--pgname (server gname)
- (let ((prefix (nnmaildir--srv-prefix server)))
- (if prefix (concat prefix gname)
- (setq gname (gnus-group-prefixed-name gname
- (nnmaildir--srv-method server)))
- (setf (nnmaildir--srv-prefix server) (gnus-group-real-prefix gname))
- gname)))
-
-(defun nnmaildir--param (pgname param)
- (setq param (gnus-group-find-parameter pgname param 'allow-list))
- (if (vectorp param) (setq param (aref param 0)))
- (eval param))
-
-(defmacro nnmaildir--with-nntp-buffer (&rest body)
- `(save-excursion
- (set-buffer nntp-server-buffer)
- ,@body))
-(defmacro nnmaildir--with-work-buffer (&rest body)
- `(save-excursion
- (set-buffer (get-buffer-create " *nnmaildir work*"))
- ,@body))
-(defmacro nnmaildir--with-nov-buffer (&rest body)
- `(save-excursion
- (set-buffer (get-buffer-create " *nnmaildir nov*"))
- ,@body))
-(defmacro nnmaildir--with-move-buffer (&rest body)
- `(save-excursion
- (set-buffer (get-buffer-create " *nnmaildir move*"))
- ,@body))
-
-(defmacro nnmaildir--subdir (dir subdir)
- `(file-name-as-directory (concat ,dir ,subdir)))
-(defmacro nnmaildir--srvgrp-dir (srv-dir gname)
- `(nnmaildir--subdir ,srv-dir ,gname))
-(defmacro nnmaildir--tmp (dir) `(nnmaildir--subdir ,dir "tmp"))
-(defmacro nnmaildir--new (dir) `(nnmaildir--subdir ,dir "new"))
-(defmacro nnmaildir--cur (dir) `(nnmaildir--subdir ,dir "cur"))
-(defmacro nnmaildir--nndir (dir) `(nnmaildir--subdir ,dir ".nnmaildir"))
-(defmacro nnmaildir--nov-dir (dir) `(nnmaildir--subdir ,dir "nov"))
-(defmacro nnmaildir--marks-dir (dir) `(nnmaildir--subdir ,dir "marks"))
-(defmacro nnmaildir--num-dir (dir) `(nnmaildir--subdir ,dir "num"))
-(defmacro nnmaildir--num-file (dir) `(concat ,dir ":"))
-
-(defmacro nnmaildir--unlink (file-arg)
- `(let ((file ,file-arg))
- (if (file-attributes file) (delete-file file))))
-(defun nnmaildir--mkdir (dir)
- (or (file-exists-p (file-name-as-directory dir))
- (make-directory-internal (directory-file-name dir))))
-(defun nnmaildir--delete-dir-files (dir ls)
- (when (file-attributes dir)
- (mapcar 'delete-file (funcall ls dir 'full "\\`[^.]" 'nosort))
- (delete-directory dir)))
-
-(defun nnmaildir--group-maxnum (server group)
- (if (zerop (nnmaildir--grp-count group)) 0
- (let ((x (nnmaildir--srvgrp-dir (nnmaildir--srv-dir server)
- (nnmaildir--grp-name group))))
- (setq x (nnmaildir--nndir x)
- x (nnmaildir--num-dir x)
- x (nnmaildir--num-file x)
- x (file-attributes x))
- (if x (1- (nth 1 x)) 0))))
-
-;; Make the given server, if non-nil, be the current server. Then make the
-;; given group, if non-nil, be the current group of the current server. Then
-;; return the group object for the current group.
-(defun nnmaildir--prepare (server group)
- (let (x groups)
- (catch 'return
- (if (null server)
- (unless (setq server nnmaildir--cur-server)
- (throw 'return nil))
- (unless (setq server (intern-soft server nnmaildir--servers))
- (throw 'return nil))
- (setq server (symbol-value server)
- nnmaildir--cur-server server))
- (unless (setq groups (nnmaildir--srv-groups server))
- (throw 'return nil))
- (unless (nnmaildir--srv-method server)
- (setq x (concat "nnmaildir:" (nnmaildir--srv-address server))
- x (gnus-server-to-method x))
- (unless x (throw 'return nil))
- (setf (nnmaildir--srv-method server) x))
- (if (null group)
- (unless (setq group (nnmaildir--srv-curgrp server))
- (throw 'return nil))
- (unless (setq group (intern-soft group groups))
- (throw 'return nil))
- (setq group (symbol-value group)))
- group)))
-
-(defun nnmaildir--tab-to-space (string)
- (let ((pos 0))
- (while (string-match "\t" string pos)
- (aset string (match-beginning 0) ? )
- (setq pos (match-end 0))))
- string)
-
-(defun nnmaildir--update-nov (server group article)
- (let ((nnheader-file-coding-system 'binary)
- (srv-dir (nnmaildir--srv-dir server))
- (storage-version 1) ;; [version article-number msgid [...nov...]]
- dir gname pgname msgdir prefix suffix file attr mtime novdir novfile
- nov msgid nov-beg nov-mid nov-end field val old-extra num numdir
- deactivate-mark)
- (catch 'return
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname server gname)
- dir (nnmaildir--srvgrp-dir srv-dir gname)
- msgdir (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- prefix (nnmaildir--art-prefix article)
- suffix (nnmaildir--art-suffix article)
- file (concat msgdir prefix suffix)
- attr (file-attributes file))
- (unless attr
- (nnmaildir--expired-article group article)
- (throw 'return nil))
- (setq mtime (nth 5 attr)
- attr (nth 7 attr)
- nov (nnmaildir--art-nov article)
- dir (nnmaildir--nndir dir)
- novdir (nnmaildir--nov-dir dir)
- novfile (concat novdir prefix))
- (unless (equal nnmaildir--extra nnmail-extra-headers)
- (setq nnmaildir--extra (copy-sequence nnmail-extra-headers)))
- (nnmaildir--with-nov-buffer
- ;; First we'll check for already-parsed NOV data.
- (cond ((not (file-exists-p novfile))
- ;; The NOV file doesn't exist; we have to parse the message.
- (setq nov nil))
- ((not nov)
- ;; The file exists, but the data isn't in memory; read the file.
- (erase-buffer)
- (nnheader-insert-file-contents novfile)
- (setq nov (read (current-buffer)))
- (if (not (and (vectorp nov)
- (/= 0 (length nov))
- (equal storage-version (aref nov 0))))
- ;; This NOV data seems to be in the wrong format.
- (setq nov nil)
- (unless (nnmaildir--art-num article)
- (setf (nnmaildir--art-num article) (aref nov 1)))
- (unless (nnmaildir--art-msgid article)
- (setf (nnmaildir--art-msgid article) (aref nov 2)))
- (setq nov (aref nov 3)))))
- ;; Now check whether the already-parsed data (if we have any) is
- ;; usable: if the message has been edited or if nnmail-extra-headers
- ;; has been augmented since this data was parsed from the message,
- ;; then we have to reparse. Otherwise it's up-to-date.
- (when (and nov (equal mtime (nnmaildir--nov-get-mtime nov)))
- ;; The timestamp matches. Now check nnmail-extra-headers.
- (setq old-extra (nnmaildir--nov-get-extra nov))
- (when (equal nnmaildir--extra old-extra) ;; common case
- ;; Save memory; use a single copy of the list value.
- (nnmaildir--nov-set-extra nov nnmaildir--extra)
- (throw 'return nov))
- ;; They're not equal, but maybe the new is a subset of the old.
- (if (null nnmaildir--extra)
- ;; The empty set is a subset of every set.
- (throw 'return nov))
- (if (not (memq nil (mapcar (lambda (e) (memq e old-extra))
- nnmaildir--extra)))
- (throw 'return nov)))
- ;; Parse the NOV data out of the message.
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (insert "\n")
- (goto-char (point-min))
- (save-restriction
- (if (search-forward "\n\n" nil 'noerror)
- (progn
- (setq nov-mid (count-lines (point) (point-max)))
- (narrow-to-region (point-min) (1- (point))))
- (setq nov-mid 0))
- (goto-char (point-min))
- (delete-char 1)
- (setq nov (nnheader-parse-naked-head)
- field (or (mail-header-lines nov) 0)))
- (unless (or (zerop field) (nnmaildir--param pgname 'distrust-Lines:))
- (setq nov-mid field))
- (setq nov-mid (number-to-string nov-mid)
- nov-mid (concat (number-to-string attr) "\t" nov-mid))
- (save-match-data
- (setq field (or (mail-header-references nov) ""))
- (nnmaildir--tab-to-space field)
- (setq nov-mid (concat field "\t" nov-mid)
- nov-beg (mapconcat
- (lambda (f) (nnmaildir--tab-to-space (or f "")))
- (list (mail-header-subject nov)
- (mail-header-from nov)
- (mail-header-date nov)) "\t")
- nov-end (mapconcat
- (lambda (extra)
- (setq field (symbol-name (car extra))
- val (cdr extra))
- (nnmaildir--tab-to-space field)
- (nnmaildir--tab-to-space val)
- (concat field ": " val))
- (mail-header-extra nov) "\t")))
- (setq msgid (mail-header-id nov))
- (if (or (null msgid) (nnheader-fake-message-id-p msgid))
- (setq msgid (concat "<" prefix "@nnmaildir>")))
- (nnmaildir--tab-to-space msgid)
- ;; The data is parsed; create an nnmaildir NOV structure.
- (setq nov (nnmaildir--nov-new nov-beg nov-mid nov-end mtime
- nnmaildir--extra)
- num (nnmaildir--art-num article))
- (unless num
- ;; Allocate a new article number.
- (erase-buffer)
- (setq numdir (nnmaildir--num-dir dir)
- file (nnmaildir--num-file numdir)
- num -1)
- (nnmaildir--mkdir numdir)
- (write-region "" nil file nil 'no-message)
- (while file
- ;; Get the number of links to file.
- (setq attr (nth 1 (file-attributes file)))
- (if (= attr num)
- ;; We've already tried this number, in the previous loop
- ;; iteration, and failed.
- (signal 'error `("Corrupt internal nnmaildir data" ,numdir)))
- ;; If attr is 123, try to link file to "123". This atomically
- ;; increases the link count and creates the "123" link, failing
- ;; if that link was already created by another Gnus, just after
- ;; we stat()ed file.
- (condition-case nil
- (progn
- (add-name-to-file file (concat numdir (format "%x" attr)))
- (setq file nil)) ;; Stop looping.
- (file-already-exists nil))
- (setq num attr))
- (setf (nnmaildir--art-num article) num))
- ;; Store this new NOV data in a file
- (erase-buffer)
- (prin1 (vector storage-version num msgid nov) (current-buffer))
- (setq file (concat novfile ":"))
- (nnmaildir--unlink file)
- (gmm-write-region (point-min) (point-max) file nil 'no-message nil
- 'excl))
- (rename-file file novfile 'replace)
- (setf (nnmaildir--art-msgid article) msgid)
- nov)))
-
-(defun nnmaildir--cache-nov (group article nov)
- (let ((cache (nnmaildir--grp-cache group))
- (index (nnmaildir--grp-index group))
- goner)
- (unless (nnmaildir--art-nov article)
- (setq goner (aref cache index))
- (if goner (setf (nnmaildir--art-nov goner) nil))
- (aset cache index article)
- (setf (nnmaildir--grp-index group) (% (1+ index) (length cache))))
- (setf (nnmaildir--art-nov article) nov)))
-
-(defun nnmaildir--grp-add-art (server group article)
- (let ((nov (nnmaildir--update-nov server group article))
- count num min nlist nlist-cdr insert-nlist)
- (when nov
- (setq count (1+ (nnmaildir--grp-count group))
- num (nnmaildir--art-num article)
- min (if (= count 1) num
- (min num (nnmaildir--grp-min group)))
- nlist (nnmaildir--grp-nlist group))
- (if (or (null nlist) (> num (caar nlist)))
- (setq nlist (cons (cons num article) nlist))
- (setq insert-nlist t
- nlist-cdr (cdr nlist))
- (while (and nlist-cdr (< num (caar nlist-cdr)))
- (setq nlist nlist-cdr
- nlist-cdr (cdr nlist))))
- (let ((inhibit-quit t))
- (setf (nnmaildir--grp-count group) count)
- (setf (nnmaildir--grp-min group) min)
- (if insert-nlist
- (setcdr nlist (cons (cons num article) nlist-cdr))
- (setf (nnmaildir--grp-nlist group) nlist))
- (set (intern (nnmaildir--art-prefix article)
- (nnmaildir--grp-flist group))
- article)
- (set (intern (nnmaildir--art-msgid article)
- (nnmaildir--grp-mlist group))
- article)
- (set (intern (nnmaildir--grp-name group)
- (nnmaildir--srv-groups server))
- group))
- (nnmaildir--cache-nov group article nov)
- t)))
-
-(defun nnmaildir--group-ls (server pgname)
- (or (nnmaildir--param pgname 'directory-files)
- (nnmaildir--srv-ls server)))
-
-(defun nnmaildir-article-number-to-file-name
- (number group-name server-address-string)
- (let ((group (nnmaildir--prepare server-address-string group-name))
- article dir pgname)
- (catch 'return
- (unless group
- ;; The given group or server does not exist.
- (throw 'return nil))
- (setq article (nnmaildir--nlist-art group number))
- (unless article
- ;; The given article number does not exist in this group.
- (throw 'return nil))
- (setq pgname (nnmaildir--pgname nnmaildir--cur-server group-name)
- dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir group-name)
- dir (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir)))
- (concat dir (nnmaildir--art-prefix article)
- (nnmaildir--art-suffix article)))))
-
-(defun nnmaildir-article-number-to-base-name
- (number group-name server-address-string)
- (let ((x (nnmaildir--prepare server-address-string group-name)))
- (when x
- (setq x (nnmaildir--nlist-art x number))
- (and x (cons (nnmaildir--art-prefix x)
- (nnmaildir--art-suffix x))))))
-
-(defun nnmaildir-base-name-to-article-number
- (base-name group-name server-address-string)
- (let ((x (nnmaildir--prepare server-address-string group-name)))
- (when x
- (setq x (nnmaildir--grp-flist x)
- x (nnmaildir--flist-art x base-name))
- (and x (nnmaildir--art-num x)))))
-
-(defun nnmaildir--nlist-iterate (nlist ranges func)
- (let (entry high low nlist2)
- (if (eq ranges 'all)
- (setq ranges `((1 . ,(caar nlist)))))
- (while ranges
- (setq entry (car ranges) ranges (cdr ranges))
- (while (and ranges (eq entry (car ranges)))
- (setq ranges (cdr ranges))) ;; skip duplicates
- (if (numberp entry)
- (setq low entry
- high entry)
- (setq low (car entry)
- high (cdr entry)))
- (setq nlist2 nlist) ;; Don't assume any sorting of ranges
- (catch 'iterate-loop
- (while nlist2
- (if (<= (caar nlist2) high) (throw 'iterate-loop nil))
- (setq nlist2 (cdr nlist2))))
- (catch 'iterate-loop
- (while nlist2
- (setq entry (car nlist2) nlist2 (cdr nlist2))
- (if (< (car entry) low) (throw 'iterate-loop nil))
- (funcall func (cdr entry)))))))
-
-(defun nnmaildir--up2-1 (n)
- (if (zerop n) 1 (1- (lsh 1 (1+ (logb n))))))
-
-(defun nnmaildir--system-name ()
- (gnus-replace-in-string
- (gnus-replace-in-string
- (gnus-replace-in-string
- (system-name)
- "\\\\" "\\134" 'literal)
- "/" "\\057" 'literal)
- ":" "\\072" 'literal))
-
-(defun nnmaildir-request-type (group &optional article)
- 'mail)
-
-(defun nnmaildir-status-message (&optional server)
- (nnmaildir--prepare server nil)
- (nnmaildir--srv-error nnmaildir--cur-server))
-
-(defun nnmaildir-server-opened (&optional server)
- (and nnmaildir--cur-server
- (if server
- (string-equal server (nnmaildir--srv-address nnmaildir--cur-server))
- t)
- (nnmaildir--srv-groups nnmaildir--cur-server)
- t))
-
-(defun nnmaildir-open-server (server &optional defs)
- (let ((x server)
- dir size)
- (catch 'return
- (setq server (intern-soft x nnmaildir--servers))
- (if server
- (and (setq server (symbol-value server))
- (nnmaildir--srv-groups server)
- (setq nnmaildir--cur-server server)
- (throw 'return t))
- (setq server (make-nnmaildir--srv :address x))
- (let ((inhibit-quit t))
- (set (intern x nnmaildir--servers) server)))
- (setq dir (assq 'directory defs))
- (unless dir
- (setf (nnmaildir--srv-error server)
- "You must set \"directory\" in the select method")
- (throw 'return nil))
- (setq dir (cadr dir)
- dir (eval dir)
- dir (expand-file-name dir)
- dir (file-name-as-directory dir))
- (unless (file-exists-p dir)
- (setf (nnmaildir--srv-error server) (concat "No such directory: " dir))
- (throw 'return nil))
- (setf (nnmaildir--srv-dir server) dir)
- (setq x (assq 'directory-files defs))
- (if (null x)
- (setq x (if nnheader-directory-files-is-safe 'directory-files
- 'nnheader-directory-files-safe))
- (setq x (cadr x))
- (unless (functionp x)
- (setf (nnmaildir--srv-error server)
- (concat "Not a function: " (prin1-to-string x)))
- (throw 'return nil)))
- (setf (nnmaildir--srv-ls server) x)
- (setq size (length (funcall x dir nil "\\`[^.]" 'nosort))
- size (nnmaildir--up2-1 size))
- (and (setq x (assq 'get-new-mail defs))
- (setq x (cdr x))
- (car x)
- (setf (nnmaildir--srv-gnm server) t)
- (require 'nnmail))
- (setq x (assq 'target-prefix defs))
- (if x
- (progn
- (setq x (cadr x)
- x (eval x))
- (setf (nnmaildir--srv-target-prefix server) x))
- (setq x (assq 'create-directory defs))
- (if x
- (progn
- (setq x (cadr x)
- x (eval x)
- x (file-name-as-directory x))
- (setf (nnmaildir--srv-target-prefix server) x))
- (setf (nnmaildir--srv-target-prefix server) "")))
- (setf (nnmaildir--srv-groups server) (make-vector size 0))
- (setq nnmaildir--cur-server server)
- t)))
-
-(defun nnmaildir--parse-filename (file)
- (let ((prefix (car file))
- timestamp len)
- (if (string-match "\\`\\([0-9]+\\)\\(\\..*\\)\\'" prefix)
- (progn
- (setq timestamp (concat "0000" (match-string 1 prefix))
- len (- (length timestamp) 4))
- (vector (string-to-number (substring timestamp 0 len))
- (string-to-number (substring timestamp len))
- (match-string 2 prefix)
- file))
- file)))
-
-(defun nnmaildir--sort-files (a b)
- (catch 'return
- (if (consp a)
- (throw 'return (and (consp b) (string-lessp (car a) (car b)))))
- (if (consp b) (throw 'return t))
- (if (< (aref a 0) (aref b 0)) (throw 'return t))
- (if (> (aref a 0) (aref b 0)) (throw 'return nil))
- (if (< (aref a 1) (aref b 1)) (throw 'return t))
- (if (> (aref a 1) (aref b 1)) (throw 'return nil))
- (string-lessp (aref a 2) (aref b 2))))
-
-(defun nnmaildir--scan (gname scan-msgs groups method srv-dir srv-ls)
- (catch 'return
- (let ((36h-ago (- (car (current-time)) 2))
- absdir nndir tdir ndir cdir nattr cattr isnew pgname read-only ls
- files num dir flist group x)
- (setq absdir (nnmaildir--srvgrp-dir srv-dir gname)
- nndir (nnmaildir--nndir absdir))
- (unless (file-exists-p absdir)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such directory: " absdir))
- (throw 'return nil))
- (setq tdir (nnmaildir--tmp absdir)
- ndir (nnmaildir--new absdir)
- cdir (nnmaildir--cur absdir)
- nattr (file-attributes ndir)
- cattr (file-attributes cdir))
- (unless (and (file-exists-p tdir) nattr cattr)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Not a maildir: " absdir))
- (throw 'return nil))
- (setq group (nnmaildir--prepare nil gname)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname))
- (if group
- (setq isnew nil)
- (setq isnew t
- group (make-nnmaildir--grp :name gname :index 0))
- (nnmaildir--mkdir nndir)
- (nnmaildir--mkdir (nnmaildir--nov-dir nndir))
- (nnmaildir--mkdir (nnmaildir--marks-dir nndir))
- (write-region "" nil (concat nndir "markfile") nil 'no-message))
- (setq read-only (nnmaildir--param pgname 'read-only)
- ls (or (nnmaildir--param pgname 'directory-files) srv-ls))
- (unless read-only
- (setq x (nth 11 (file-attributes tdir)))
- (unless (and (= x (nth 11 nattr)) (= x (nth 11 cattr)))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Maildir spans filesystems: " absdir))
- (throw 'return nil))
- (mapcar
- (lambda (file)
- (setq x (file-attributes file))
- (if (or (> (cadr x) 1) (< (car (nth 4 x)) 36h-ago))
- (delete-file file)))
- (funcall ls tdir 'full "\\`[^.]" 'nosort)))
- (or scan-msgs
- isnew
- (throw 'return t))
- (setq nattr (nth 5 nattr))
- (if (equal nattr (nnmaildir--grp-new group))
- (setq nattr nil))
- (if read-only (setq dir (and (or isnew nattr) ndir))
- (when (or isnew nattr)
- (mapcar
- (lambda (file)
- (let ((path (concat ndir file)))
- (and (time-less-p (nth 5 (file-attributes path)) (current-time))
- (rename-file path (concat cdir file ":2,")))))
- (funcall ls ndir nil "\\`[^.]" 'nosort))
- (setf (nnmaildir--grp-new group) nattr))
- (setq cattr (nth 5 (file-attributes cdir)))
- (if (equal cattr (nnmaildir--grp-cur group))
- (setq cattr nil))
- (setq dir (and (or isnew cattr) cdir)))
- (unless dir (throw 'return t))
- (setq files (funcall ls dir nil "\\`[^.]" 'nosort)
- files (save-match-data
- (mapcar
- (lambda (f)
- (string-match "\\`\\([^:]*\\)\\(\\(:.*\\)?\\)\\'" f)
- (cons (match-string 1 f) (match-string 2 f)))
- files)))
- (when isnew
- (setq num (nnmaildir--up2-1 (length files)))
- (setf (nnmaildir--grp-flist group) (make-vector num 0))
- (setf (nnmaildir--grp-mlist group) (make-vector num 0))
- (setf (nnmaildir--grp-mmth group) (make-vector 1 0))
- (setq num (nnmaildir--param pgname 'nov-cache-size))
- (if (numberp num) (if (< num 1) (setq num 1))
- (setq num 16
- cdir (nnmaildir--marks-dir nndir)
- ndir (nnmaildir--subdir cdir "tick")
- cdir (nnmaildir--subdir cdir "read"))
- (mapcar
- (lambda (file)
- (setq file (car file))
- (if (or (not (file-exists-p (concat cdir file)))
- (file-exists-p (concat ndir file)))
- (setq num (1+ num))))
- files))
- (setf (nnmaildir--grp-cache group) (make-vector num nil))
- (let ((inhibit-quit t))
- (set (intern gname groups) group))
- (or scan-msgs (throw 'return t)))
- (setq flist (nnmaildir--grp-flist group)
- files (mapcar
- (lambda (file)
- (and (null (nnmaildir--flist-art flist (car file)))
- file))
- files)
- files (delq nil files)
- files (mapcar 'nnmaildir--parse-filename files)
- files (sort files 'nnmaildir--sort-files))
- (mapcar
- (lambda (file)
- (setq file (if (consp file) file (aref file 3))
- x (make-nnmaildir--art :prefix (car file) :suffix (cdr file)))
- (nnmaildir--grp-add-art nnmaildir--cur-server group x))
- files)
- (if read-only (setf (nnmaildir--grp-new group) nattr)
- (setf (nnmaildir--grp-cur group) cattr)))
- t))
-
-(defun nnmaildir-request-scan (&optional scan-group server)
- (let ((coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- (nnmaildir-get-new-mail t)
- (nnmaildir-group-alist nil)
- (nnmaildir-active-file nil)
- x srv-ls srv-dir method groups target-prefix group dirs grp-dir seen
- deactivate-mark)
- (nnmaildir--prepare server nil)
- (setq srv-ls (nnmaildir--srv-ls nnmaildir--cur-server)
- srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
- method (nnmaildir--srv-method nnmaildir--cur-server)
- groups (nnmaildir--srv-groups nnmaildir--cur-server)
- target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
- (nnmaildir--with-work-buffer
- (save-match-data
- (if (stringp scan-group)
- (if (nnmaildir--scan scan-group t groups method srv-dir srv-ls)
- (if (nnmaildir--srv-gnm nnmaildir--cur-server)
- (nnmail-get-new-mail 'nnmaildir nil nil scan-group))
- (unintern scan-group groups))
- (setq x (nth 5 (file-attributes srv-dir))
- scan-group (null scan-group))
- (if (equal x (nnmaildir--srv-mtime nnmaildir--cur-server))
- (if scan-group
- (mapatoms (lambda (sym)
- (nnmaildir--scan (symbol-name sym) t groups
- method srv-dir srv-ls))
- groups))
- (setq dirs (funcall srv-ls srv-dir nil "\\`[^.]" 'nosort)
- dirs (if (zerop (length target-prefix))
- dirs
- (gnus-remove-if
- (lambda (dir)
- (and (>= (length dir) (length target-prefix))
- (string= (substring dir 0
- (length target-prefix))
- target-prefix)))
- dirs))
- seen (nnmaildir--up2-1 (length dirs))
- seen (make-vector seen 0))
- (mapcar
- (lambda (grp-dir)
- (if (nnmaildir--scan grp-dir scan-group groups method srv-dir
- srv-ls)
- (intern grp-dir seen)))
- dirs)
- (setq x nil)
- (mapatoms (lambda (group)
- (setq group (symbol-name group))
- (unless (intern-soft group seen)
- (setq x (cons group x))))
- groups)
- (mapcar (lambda (grp) (unintern grp groups)) x)
- (setf (nnmaildir--srv-mtime nnmaildir--cur-server)
- (nth 5 (file-attributes srv-dir))))
- (and scan-group
- (nnmaildir--srv-gnm nnmaildir--cur-server)
- (nnmail-get-new-mail 'nnmaildir nil nil))))))
- t)
-
-(defun nnmaildir-request-list (&optional server)
- (nnmaildir-request-scan 'find-new-groups server)
- (let (pgname ro deactivate-mark)
- (nnmaildir--prepare server nil)
- (nnmaildir--with-nntp-buffer
- (erase-buffer)
- (mapatoms (lambda (group)
- (setq pgname (symbol-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server pgname)
- group (symbol-value group)
- ro (nnmaildir--param pgname 'read-only))
- (insert (nnmaildir--grp-name group) " ")
- (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
- nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--grp-min group) nntp-server-buffer)
- (insert " " (if ro "n" "y") "\n"))
- (nnmaildir--srv-groups nnmaildir--cur-server))))
- t)
-
-(defun nnmaildir-request-newgroups (date &optional server)
- (nnmaildir-request-list server))
-
-(defun nnmaildir-retrieve-groups (groups &optional server)
- (let (group deactivate-mark)
- (nnmaildir--prepare server nil)
- (nnmaildir--with-nntp-buffer
- (erase-buffer)
- (mapcar
- (lambda (gname)
- (setq group (nnmaildir--prepare nil gname))
- (if (null group) (insert "411 no such news group\n")
- (insert "211 ")
- (princ (nnmaildir--grp-count group) nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--grp-min group) nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
- nntp-server-buffer)
- (insert " " gname "\n")))
- groups)))
- 'group)
-
-(defun nnmaildir-request-update-info (gname info &optional server)
- (let ((group (nnmaildir--prepare server gname))
- pgname flist always-marks never-marks old-marks dotfile num dir
- markdirs marks mark ranges markdir article read end new-marks ls
- old-mmth new-mmth mtime mark-sym existing missing deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- flist (nnmaildir--grp-flist group))
- (when (zerop (nnmaildir--grp-count group))
- (gnus-info-set-read info nil)
- (gnus-info-set-marks info nil 'extend)
- (throw 'return info))
- (setq old-marks (cons 'read (gnus-info-read info))
- old-marks (cons old-marks (gnus-info-marks info))
- always-marks (nnmaildir--param pgname 'always-marks)
- never-marks (nnmaildir--param pgname 'never-marks)
- existing (nnmaildir--grp-nlist group)
- existing (mapcar 'car existing)
- existing (nreverse existing)
- existing (gnus-compress-sequence existing 'always-list)
- missing (list (cons 1 (nnmaildir--group-maxnum
- nnmaildir--cur-server group)))
- missing (gnus-range-difference missing existing)
- dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir gname)
- dir (nnmaildir--nndir dir)
- dir (nnmaildir--marks-dir dir)
- ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- markdirs (funcall ls dir nil "\\`[^.]" 'nosort)
- new-mmth (nnmaildir--up2-1 (length markdirs))
- new-mmth (make-vector new-mmth 0)
- old-mmth (nnmaildir--grp-mmth group))
- (mapcar
- (lambda (mark)
- (setq markdir (nnmaildir--subdir dir mark)
- mark-sym (intern mark)
- ranges nil)
- (catch 'got-ranges
- (if (memq mark-sym never-marks) (throw 'got-ranges nil))
- (when (memq mark-sym always-marks)
- (setq ranges existing)
- (throw 'got-ranges nil))
- (setq mtime (nth 5 (file-attributes markdir)))
- (set (intern mark new-mmth) mtime)
- (when (equal mtime (symbol-value (intern-soft mark old-mmth)))
- (setq ranges (assq mark-sym old-marks))
- (if ranges (setq ranges (cdr ranges)))
- (throw 'got-ranges nil))
- (mapcar
- (lambda (prefix)
- (setq article (nnmaildir--flist-art flist prefix))
- (if article
- (setq ranges
- (gnus-add-to-range ranges
- `(,(nnmaildir--art-num article))))))
- (funcall ls markdir nil "\\`[^.]" 'nosort)))
- (if (eq mark-sym 'read) (setq read ranges)
- (if ranges (setq marks (cons (cons mark-sym ranges) marks)))))
- markdirs)
- (gnus-info-set-read info (gnus-range-add read missing))
- (gnus-info-set-marks info marks 'extend)
- (setf (nnmaildir--grp-mmth group) new-mmth)
- info)))
-
-(defun nnmaildir-request-group (gname &optional server fast)
- (let ((group (nnmaildir--prepare server gname))
- deactivate-mark)
- (catch 'return
- (unless group
- ;; (insert "411 no such news group\n")
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) group)
- (if fast (throw 'return t))
- (nnmaildir--with-nntp-buffer
- (erase-buffer)
- (insert "211 ")
- (princ (nnmaildir--grp-count group) nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--grp-min group) nntp-server-buffer)
- (insert " ")
- (princ (nnmaildir--group-maxnum nnmaildir--cur-server group)
- nntp-server-buffer)
- (insert " " gname "\n")
- t))))
-
-(defun nnmaildir-request-create-group (gname &optional server args)
- (nnmaildir--prepare server nil)
- (catch 'return
- (let ((target-prefix (nnmaildir--srv-target-prefix nnmaildir--cur-server))
- srv-dir dir groups)
- (when (zerop (length gname))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Invalid (empty) group name")
- (throw 'return nil))
- (when (eq (aref "." 0) (aref gname 0))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Group names may not start with \".\"")
- (throw 'return nil))
- (when (save-match-data (string-match "[\0/\t]" gname))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Invalid characters (null, tab, or /) in group name: "
- gname))
- (throw 'return nil))
- (setq groups (nnmaildir--srv-groups nnmaildir--cur-server))
- (when (intern-soft gname groups)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Group already exists: " gname))
- (throw 'return nil))
- (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
- (if (file-name-absolute-p target-prefix)
- (setq dir (expand-file-name target-prefix))
- (setq dir srv-dir
- dir (file-truename dir)
- dir (concat dir target-prefix)))
- (setq dir (nnmaildir--subdir dir gname))
- (nnmaildir--mkdir dir)
- (nnmaildir--mkdir (nnmaildir--tmp dir))
- (nnmaildir--mkdir (nnmaildir--new dir))
- (nnmaildir--mkdir (nnmaildir--cur dir))
- (unless (string= target-prefix "")
- (make-symbolic-link (concat target-prefix gname)
- (concat srv-dir gname)))
- (nnmaildir-request-scan 'find-new-groups))))
-
-(defun nnmaildir-request-rename-group (gname new-name &optional server)
- (let ((group (nnmaildir--prepare server gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- srv-dir x groups)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (when (zerop (length new-name))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Invalid (empty) group name")
- (throw 'return nil))
- (when (eq (aref "." 0) (aref new-name 0))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Group names may not start with \".\"")
- (throw 'return nil))
- (when (save-match-data (string-match "[\0/\t]" new-name))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Invalid characters (null, tab, or /) in group name: "
- new-name))
- (throw 'return nil))
- (if (string-equal gname new-name) (throw 'return t))
- (when (intern-soft new-name
- (nnmaildir--srv-groups nnmaildir--cur-server))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Group already exists: " new-name))
- (throw 'return nil))
- (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server))
- (condition-case err
- (rename-file (concat srv-dir gname)
- (concat srv-dir new-name))
- (error
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Error renaming link: " (prin1-to-string err)))
- (throw 'return nil)))
- (setq x (nnmaildir--srv-groups nnmaildir--cur-server)
- groups (make-vector (length x) 0))
- (mapatoms (lambda (sym)
- (unless (eq (symbol-value sym) group)
- (set (intern (symbol-name sym) groups)
- (symbol-value sym))))
- x)
- (setq group (copy-sequence group))
- (setf (nnmaildir--grp-name group) new-name)
- (set (intern new-name groups) group)
- (setf (nnmaildir--srv-groups nnmaildir--cur-server) groups)
- t)))
-
-(defun nnmaildir-request-delete-group (gname force &optional server)
- (let ((group (nnmaildir--prepare server gname))
- pgname grp-dir target dir ls deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- grp-dir (nnmaildir--srv-dir nnmaildir--cur-server)
- target (car (file-attributes (concat grp-dir gname)))
- grp-dir (nnmaildir--srvgrp-dir grp-dir gname))
- (unless (or force (stringp target))
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Not a symlink: " gname))
- (throw 'return nil))
- (if (eq group (nnmaildir--srv-curgrp nnmaildir--cur-server))
- (setf (nnmaildir--srv-curgrp nnmaildir--cur-server) nil))
- (unintern gname (nnmaildir--srv-groups nnmaildir--cur-server))
- (if (not force)
- (progn
- (setq grp-dir (directory-file-name grp-dir))
- (nnmaildir--unlink grp-dir))
- (setq ls (nnmaildir--group-ls nnmaildir--cur-server pgname))
- (if (nnmaildir--param pgname 'read-only)
- (progn (delete-directory (nnmaildir--tmp grp-dir))
- (nnmaildir--unlink (nnmaildir--new grp-dir))
- (delete-directory (nnmaildir--cur grp-dir)))
- (nnmaildir--delete-dir-files (nnmaildir--tmp grp-dir) ls)
- (nnmaildir--delete-dir-files (nnmaildir--new grp-dir) ls)
- (nnmaildir--delete-dir-files (nnmaildir--cur grp-dir) ls))
- (setq dir (nnmaildir--nndir grp-dir))
- (mapcar (lambda (subdir) (nnmaildir--delete-dir-files subdir ls))
- `(,(nnmaildir--nov-dir dir) ,(nnmaildir--num-dir dir)
- ,@(funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
- 'nosort)))
- (setq dir (nnmaildir--nndir grp-dir))
- (nnmaildir--unlink (concat dir "markfile"))
- (nnmaildir--unlink (concat dir "markfile{new}"))
- (delete-directory (nnmaildir--marks-dir dir))
- (delete-directory dir)
- (if (not (stringp target))
- (delete-directory grp-dir)
- (setq grp-dir (directory-file-name grp-dir)
- dir target)
- (unless (eq (aref "/" 0) (aref dir 0))
- (setq dir (concat (file-truename
- (nnmaildir--srv-dir nnmaildir--cur-server))
- dir)))
- (delete-directory dir)
- (nnmaildir--unlink grp-dir)))
- t)))
-
-(defun nnmaildir-retrieve-headers (articles &optional gname server fetch-old)
- (let ((group (nnmaildir--prepare server gname))
- srv-dir dir nlist mlist article num start stop nov nlist2 insert-nov
- deactivate-mark)
- (setq insert-nov
- (lambda (article)
- (setq nov (nnmaildir--update-nov nnmaildir--cur-server group
- article))
- (when nov
- (nnmaildir--cache-nov group article nov)
- (setq num (nnmaildir--art-num article))
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-beg nov) "\t"
- (nnmaildir--art-msgid article) "\t"
- (nnmaildir--nov-get-mid nov) "\tXref: nnmaildir "
- gname ":")
- (princ num nntp-server-buffer)
- (insert "\t" (nnmaildir--nov-get-end nov) "\n"))))
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (if gname (concat "No such group: " gname) "No current group"))
- (throw 'return nil))
- (nnmaildir--with-nntp-buffer
- (erase-buffer)
- (setq mlist (nnmaildir--grp-mlist group)
- nlist (nnmaildir--grp-nlist group)
- gname (nnmaildir--grp-name group)
- srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir srv-dir gname))
- (cond
- ((null nlist))
- ((and fetch-old (not (numberp fetch-old)))
- (nnmaildir--nlist-iterate nlist 'all insert-nov))
- ((null articles))
- ((stringp (car articles))
- (mapcar
- (lambda (msgid)
- (setq article (nnmaildir--mlist-art mlist msgid))
- (if article (funcall insert-nov article)))
- articles))
- (t
- (if fetch-old
- ;; Assume the article range list is sorted ascending
- (setq stop (car articles)
- start (car (last articles))
- stop (if (numberp stop) stop (car stop))
- start (if (numberp start) start (cdr start))
- stop (- stop fetch-old)
- stop (if (< stop 1) 1 stop)
- articles (list (cons stop start))))
- (nnmaildir--nlist-iterate nlist articles insert-nov)))
- (sort-numeric-fields 1 (point-min) (point-max))
- 'nov))))
-
-(defun nnmaildir-request-article (num-msgid &optional gname server to-buffer)
- (let ((group (nnmaildir--prepare server gname))
- (case-fold-search t)
- list article dir pgname deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (if gname (concat "No such group: " gname) "No current group"))
- (throw 'return nil))
- (if (numberp num-msgid)
- (setq article (nnmaildir--nlist-art group num-msgid))
- (setq list (nnmaildir--grp-mlist group)
- article (nnmaildir--mlist-art list num-msgid))
- (if article (setq num-msgid (nnmaildir--art-num article))
- (catch 'found
- (mapatoms
- (lambda (group-sym)
- (setq group (symbol-value group-sym)
- list (nnmaildir--grp-mlist group)
- article (nnmaildir--mlist-art list num-msgid))
- (when article
- (setq num-msgid (nnmaildir--art-num article))
- (throw 'found nil)))
- (nnmaildir--srv-groups nnmaildir--cur-server))))
- (unless article
- (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
- (throw 'return nil)))
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir gname)
- dir (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- nnmaildir-article-file-name
- (concat dir
- (nnmaildir--art-prefix article)
- (nnmaildir--art-suffix article)))
- (unless (file-exists-p nnmaildir-article-file-name)
- (nnmaildir--expired-article group article)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Article has expired")
- (throw 'return nil))
- (save-excursion
- (set-buffer (or to-buffer nntp-server-buffer))
- (erase-buffer)
- (nnheader-insert-file-contents nnmaildir-article-file-name))
- (cons gname num-msgid))))
-
-(defun nnmaildir-request-post (&optional server)
- (let (message-required-mail-headers)
- (funcall message-send-mail-function)))
-
-(defun nnmaildir-request-replace-article (number gname buffer)
- (let ((group (nnmaildir--prepare nil gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- dir file article suffix tmpfile deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
- 'read-only)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Read-only group: " group))
- (throw 'return nil))
- (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir gname)
- article (nnmaildir--nlist-art group number))
- (unless article
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such article: " (number-to-string number)))
- (throw 'return nil))
- (setq suffix (nnmaildir--art-suffix article)
- file (nnmaildir--art-prefix article)
- tmpfile (concat (nnmaildir--tmp dir) file))
- (when (file-exists-p tmpfile)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "File exists: " tmpfile))
- (throw 'return nil))
- (save-excursion
- (set-buffer buffer)
- (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil
- 'excl))
- (unix-sync) ;; no fsync :(
- (rename-file tmpfile (concat (nnmaildir--cur dir) file suffix) 'replace)
- t)))
-
-(defun nnmaildir-request-move-article (article gname server accept-form
- &optional last)
- (let ((group (nnmaildir--prepare server gname))
- pgname suffix result nnmaildir--file deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- article (nnmaildir--nlist-art group article))
- (unless article
- (setf (nnmaildir--srv-error nnmaildir--cur-server) "No such article")
- (throw 'return nil))
- (setq suffix (nnmaildir--art-suffix article)
- nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
- nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
- nnmaildir--file (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new nnmaildir--file)
- (nnmaildir--cur nnmaildir--file))
- nnmaildir--file (concat nnmaildir--file
- (nnmaildir--art-prefix article)
- suffix))
- (unless (file-exists-p nnmaildir--file)
- (nnmaildir--expired-article group article)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- "Article has expired")
- (throw 'return nil))
- (nnmaildir--with-move-buffer
- (erase-buffer)
- (nnheader-insert-file-contents nnmaildir--file)
- (setq result (eval accept-form)))
- (unless (or (null result) (nnmaildir--param pgname 'read-only))
- (nnmaildir--unlink nnmaildir--file)
- (nnmaildir--expired-article group article))
- result)))
-
-(defun nnmaildir-request-accept-article (gname &optional server last)
- (let ((group (nnmaildir--prepare server gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- srv-dir dir file time tmpfile curfile 24h article)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (throw 'return nil))
- (setq gname (nnmaildir--grp-name group))
- (when (nnmaildir--param (nnmaildir--pgname nnmaildir--cur-server gname)
- 'read-only)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Read-only group: " gname))
- (throw 'return nil))
- (setq srv-dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir srv-dir gname)
- time (current-time)
- file (format-time-string "%s." time))
- (unless (string-equal nnmaildir--delivery-time file)
- (setq nnmaildir--delivery-time file
- nnmaildir--delivery-count 0))
- (when (and (consp (cdr time))
- (consp (cddr time)))
- (setq file (concat file "M" (number-to-string (caddr time)))))
- (setq file (concat file nnmaildir--delivery-pid)
- file (concat file "Q" (number-to-string nnmaildir--delivery-count))
- file (concat file "." (nnmaildir--system-name))
- tmpfile (concat (nnmaildir--tmp dir) file)
- curfile (concat (nnmaildir--cur dir) file ":2,"))
- (when (file-exists-p tmpfile)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "File exists: " tmpfile))
- (throw 'return nil))
- (when (file-exists-p curfile)
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "File exists: " curfile))
- (throw 'return nil))
- (setq nnmaildir--delivery-count (1+ nnmaildir--delivery-count)
- 24h (run-with-timer 86400 nil
- (lambda ()
- (nnmaildir--unlink tmpfile)
- (setf (nnmaildir--srv-error
- nnmaildir--cur-server)
- "24-hour timer expired")
- (throw 'return nil))))
- (condition-case nil
- (add-name-to-file nnmaildir--file tmpfile)
- (error
- (gmm-write-region (point-min) (point-max) tmpfile nil 'no-message nil
- 'excl)
- (unix-sync))) ;; no fsync :(
- (nnheader-cancel-timer 24h)
- (condition-case err
- (add-name-to-file tmpfile curfile)
- (error
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "Error linking: " (prin1-to-string err)))
- (nnmaildir--unlink tmpfile)
- (throw 'return nil)))
- (nnmaildir--unlink tmpfile)
- (setq article (make-nnmaildir--art :prefix file :suffix ":2,"))
- (if (nnmaildir--grp-add-art nnmaildir--cur-server group article)
- (cons gname (nnmaildir--art-num article))))))
-
-(defun nnmaildir-save-mail (group-art)
- (catch 'return
- (unless group-art
- (throw 'return nil))
- (let (ga gname x groups nnmaildir--file deactivate-mark)
- (save-excursion
- (goto-char (point-min))
- (save-match-data
- (while (looking-at "From ")
- (replace-match "X-From-Line: ")
- (forward-line 1))))
- (setq groups (nnmaildir--srv-groups nnmaildir--cur-server)
- ga (car group-art) group-art (cdr group-art)
- gname (car ga))
- (or (intern-soft gname groups)
- (nnmaildir-request-create-group gname)
- (throw 'return nil)) ;; not that nnmail bothers to check :(
- (unless (nnmaildir-request-accept-article gname)
- (throw 'return nil))
- (setq nnmaildir--file (nnmaildir--srv-dir nnmaildir--cur-server)
- nnmaildir--file (nnmaildir--srvgrp-dir nnmaildir--file gname)
- x (nnmaildir--prepare nil gname)
- x (nnmaildir--grp-nlist x)
- x (cdar x)
- nnmaildir--file (concat nnmaildir--file
- (nnmaildir--art-prefix x)
- (nnmaildir--art-suffix x)))
- (delq nil
- (mapcar
- (lambda (ga)
- (setq gname (car ga))
- (and (or (intern-soft gname groups)
- (nnmaildir-request-create-group gname))
- (nnmaildir-request-accept-article gname)
- ga))
- group-art)))))
-
-(defun nnmaildir-active-number (gname)
- 0)
-
-(defun nnmaildir-request-expire-articles (ranges &optional gname server force)
- (let ((no-force (not force))
- (group (nnmaildir--prepare server gname))
- pgname time boundary bound-iter high low target dir nlist nlist2
- stop article didnt nnmaildir--file nnmaildir-article-file-name
- deactivate-mark)
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (if gname (concat "No such group: " gname) "No current group"))
- (throw 'return (gnus-uncompress-range ranges)))
- (setq gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname))
- (if (nnmaildir--param pgname 'read-only)
- (throw 'return (gnus-uncompress-range ranges)))
- (setq time (nnmaildir--param pgname 'expire-age))
- (unless time
- (setq time (or (and nnmail-expiry-wait-function
- (funcall nnmail-expiry-wait-function gname))
- nnmail-expiry-wait))
- (if (eq time 'immediate)
- (setq time 0)
- (if (numberp time)
- (setq time (* time 86400)))))
- (when no-force
- (unless (integerp time) ;; handle 'never
- (throw 'return (gnus-uncompress-range ranges)))
- (setq boundary (current-time)
- high (- (car boundary) (/ time 65536))
- low (- (cadr boundary) (% time 65536)))
- (if (< low 0)
- (setq low (+ low 65536)
- high (1- high)))
- (setcar (cdr boundary) low)
- (setcar boundary high))
- (setq dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir gname)
- dir (nnmaildir--cur dir)
- nlist (nnmaildir--grp-nlist group)
- ranges (reverse ranges))
- (nnmaildir--with-move-buffer
- (nnmaildir--nlist-iterate
- nlist ranges
- (lambda (article)
- (setq nnmaildir--file (nnmaildir--art-prefix article)
- nnmaildir--file (concat dir nnmaildir--file
- (nnmaildir--art-suffix article))
- time (file-attributes nnmaildir--file))
- (cond
- ((null time)
- (nnmaildir--expired-article group article))
- ((and no-force
- (progn
- (setq time (nth 5 time)
- bound-iter boundary)
- (while (and bound-iter time
- (= (car bound-iter) (car time)))
- (setq bound-iter (cdr bound-iter)
- time (cdr time)))
- (and bound-iter time
- (car-less-than-car bound-iter time))))
- (setq didnt (cons (nnmaildir--art-num article) didnt)))
- (t
- (setq nnmaildir-article-file-name nnmaildir--file
- target (if force nil
- (save-excursion
- (save-restriction
- (nnmaildir--param pgname 'expire-group)))))
- (when (and (stringp target)
- (not (string-equal target pgname))) ;; Move it.
- (erase-buffer)
- (nnheader-insert-file-contents nnmaildir--file)
- (gnus-request-accept-article target nil nil 'no-encode))
- (if (equal target pgname)
- ;; Leave it here.
- (setq didnt (cons (nnmaildir--art-num article) didnt))
- (nnmaildir--unlink nnmaildir--file)
- (nnmaildir--expired-article group article))))))
- (erase-buffer))
- didnt)))
-
-(defun nnmaildir-request-set-mark (gname actions &optional server)
- (let ((group (nnmaildir--prepare server gname))
- (coding-system-for-write nnheader-file-coding-system)
- (buffer-file-coding-system nil)
- (file-coding-system-alist nil)
- del-mark del-action add-action set-action marksdir markfile nlist
- ranges begin end article all-marks todo-marks did-marks mdir mfile
- pgname ls permarkfile deactivate-mark)
- (setq del-mark
- (lambda (mark)
- (setq mfile (nnmaildir--subdir marksdir (symbol-name mark))
- mfile (concat mfile (nnmaildir--art-prefix article)))
- (nnmaildir--unlink mfile))
- del-action (lambda (article) (mapcar del-mark todo-marks))
- add-action
- (lambda (article)
- (mapcar
- (lambda (mark)
- (setq mdir (nnmaildir--subdir marksdir (symbol-name mark))
- permarkfile (concat mdir ":")
- mfile (concat mdir (nnmaildir--art-prefix article)))
- (unless (memq mark did-marks)
- (setq did-marks (cons mark did-marks))
- (nnmaildir--mkdir mdir)
- (unless (file-attributes permarkfile)
- (condition-case nil
- (add-name-to-file markfile permarkfile)
- (file-error
- ;; AFS can't make hard links in separate directories
- (write-region "" nil permarkfile nil 'no-message)))))
- (unless (file-exists-p mfile)
- (add-name-to-file permarkfile mfile)))
- todo-marks))
- set-action (lambda (article)
- (funcall add-action)
- (mapcar (lambda (mark)
- (unless (memq mark todo-marks)
- (funcall del-mark mark)))
- all-marks)))
- (catch 'return
- (unless group
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- (mapcar (lambda (action)
- (setq ranges (gnus-range-add ranges (car action))))
- actions)
- (throw 'return ranges))
- (setq nlist (nnmaildir--grp-nlist group)
- marksdir (nnmaildir--srv-dir nnmaildir--cur-server)
- marksdir (nnmaildir--srvgrp-dir marksdir gname)
- marksdir (nnmaildir--nndir marksdir)
- markfile (concat marksdir "markfile")
- marksdir (nnmaildir--marks-dir marksdir)
- gname (nnmaildir--grp-name group)
- pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- all-marks (funcall ls marksdir nil "\\`[^.]" 'nosort)
- all-marks (mapcar 'intern all-marks))
- (mapcar
- (lambda (action)
- (setq ranges (car action)
- todo-marks (caddr action))
- (mapcar (lambda (mark) (add-to-list 'all-marks mark)) todo-marks)
- (if (numberp (cdr ranges)) (setq ranges (list ranges)))
- (nnmaildir--nlist-iterate nlist ranges
- (cond ((eq 'del (cadr action)) del-action)
- ((eq 'add (cadr action)) add-action)
- (t set-action))))
- actions)
- nil)))
-
-(defun nnmaildir-close-group (gname &optional server)
- (let ((group (nnmaildir--prepare server gname))
- pgname ls dir msgdir files flist dirs)
- (if (null group)
- (progn
- (setf (nnmaildir--srv-error nnmaildir--cur-server)
- (concat "No such group: " gname))
- nil)
- (setq pgname (nnmaildir--pgname nnmaildir--cur-server gname)
- ls (nnmaildir--group-ls nnmaildir--cur-server pgname)
- dir (nnmaildir--srv-dir nnmaildir--cur-server)
- dir (nnmaildir--srvgrp-dir dir gname)
- msgdir (if (nnmaildir--param pgname 'read-only)
- (nnmaildir--new dir) (nnmaildir--cur dir))
- dir (nnmaildir--nndir dir)
- dirs (cons (nnmaildir--nov-dir dir)
- (funcall ls (nnmaildir--marks-dir dir) 'full "\\`[^.]"
- 'nosort))
- dirs (mapcar
- (lambda (dir)
- (cons dir (funcall ls dir nil "\\`[^.]" 'nosort)))
- dirs)
- files (funcall ls msgdir nil "\\`[^.]" 'nosort)
- flist (nnmaildir--up2-1 (length files))
- flist (make-vector flist 0))
- (save-match-data
- (mapcar
- (lambda (file)
- (string-match "\\`\\([^:]*\\)\\(:.*\\)?\\'" file)
- (intern (match-string 1 file) flist))
- files))
- (mapcar
- (lambda (dir)
- (setq files (cdr dir)
- dir (file-name-as-directory (car dir)))
- (mapcar
- (lambda (file)
- (unless (or (intern-soft file flist) (string= file ":"))
- (setq file (concat dir file))
- (delete-file file)))
- files))
- dirs)
- t)))
-
-(defun nnmaildir-close-server (&optional server)
- (let (flist ls dirs dir files file x)
- (nnmaildir--prepare server nil)
- (when nnmaildir--cur-server
- (setq server nnmaildir--cur-server
- nnmaildir--cur-server nil)
- (unintern (nnmaildir--srv-address server) nnmaildir--servers)))
- t)
-
-(defun nnmaildir-request-close ()
- (let (servers buffer)
- (mapatoms (lambda (server)
- (setq servers (cons (symbol-name server) servers)))
- nnmaildir--servers)
- (mapcar 'nnmaildir-close-server servers)
- (setq buffer (get-buffer " *nnmaildir work*"))
- (if buffer (kill-buffer buffer))
- (setq buffer (get-buffer " *nnmaildir nov*"))
- (if buffer (kill-buffer buffer))
- (setq buffer (get-buffer " *nnmaildir move*"))
- (if buffer (kill-buffer buffer)))
- t)
-
-(provide 'nnmaildir)
-
-;; Local Variables:
-;; indent-tabs-mode: t
-;; fill-column: 77
-;; End:
-
-;;; arch-tag: 0c4e44cd-dfde-4040-888e-5597ec771849
-;;; nnmaildir.el ends here
+++ /dev/null
-;;; nnmbox.el --- mail mbox access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, or (at your option)
-;; any later version.
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
-
-;;; Code:
-
-(require 'nnheader)
-(require 'message)
-(require 'nnmail)
-(require 'nnoo)
-(require 'gnus-range)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnmbox)
-
-(defvoo nnmbox-mbox-file (expand-file-name "~/mbox")
- "The name of the mail box file in the user's home directory.")
-
-(defvoo nnmbox-active-file (expand-file-name "~/.mbox-active")
- "The name of the active file for the mail box.")
-
-(defvoo nnmbox-get-new-mail t
- "If non-nil, nnmbox will check the incoming mail file and split the mail.")
-
-(defvoo nnmbox-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
-
-\f
-
-(defconst nnmbox-version "nnmbox 1.0"
- "nnmbox version.")
-
-(defvoo nnmbox-current-group nil
- "Current nnmbox news group directory.")
-
-(defvar nnmbox-mbox-buffer nil)
-
-(defvoo nnmbox-status-string "")
-
-(defvoo nnmbox-group-alist nil)
-(defvoo nnmbox-active-timestamp nil)
-
-(defvoo nnmbox-file-coding-system mm-binary-coding-system)
-(defvoo nnmbox-file-coding-system-for-write nil)
-(defvoo nnmbox-active-file-coding-system mm-binary-coding-system)
-(defvoo nnmbox-active-file-coding-system-for-write nil)
-
-(defvar nnmbox-group-building-active-articles nil)
-(defvar nnmbox-group-active-articles nil)
-\f
-
-;;; Interface functions
-
-(nnoo-define-basics nnmbox)
-
-(deffoo nnmbox-retrieve-headers (sequence &optional newsgroup server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((number (length sequence))
- (count 0)
- article start stop)
- (nnmbox-possibly-change-newsgroup newsgroup server)
- (while sequence
- (setq article (car sequence))
- (set-buffer nnmbox-mbox-buffer)
- (when (nnmbox-find-article article)
- (setq start
- (save-excursion
- (re-search-backward
- (concat "^" message-unix-mail-delimiter) nil t)
- (point)))
- (search-forward "\n\n" nil t)
- (setq stop (1- (point)))
- (set-buffer nntp-server-buffer)
- (insert (format "221 %d Article retrieved.\n" article))
- (insert-buffer-substring nnmbox-mbox-buffer start stop)
- (goto-char (point-max))
- (insert ".\n"))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (zerop (% count 20))
- (nnheader-message 5 "nnmbox: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (nnheader-message 5 "nnmbox: Receiving headers...done"))
-
- (set-buffer nntp-server-buffer)
- (nnheader-fold-continuation-lines)
- 'headers)))
-
-(deffoo nnmbox-open-server (server &optional defs)
- (nnoo-change-server 'nnmbox server defs)
- (nnmbox-create-mbox)
- (cond
- ((not (file-exists-p nnmbox-mbox-file))
- (nnmbox-close-server)
- (nnheader-report 'nnmbox "No such file: %s" nnmbox-mbox-file))
- ((file-directory-p nnmbox-mbox-file)
- (nnmbox-close-server)
- (nnheader-report 'nnmbox "Not a regular file: %s" nnmbox-mbox-file))
- (t
- (nnheader-report 'nnmbox "Opened server %s using mbox %s" server
- nnmbox-mbox-file)
- t)))
-
-(deffoo nnmbox-close-server (&optional server)
- (when (and nnmbox-mbox-buffer
- (buffer-name nnmbox-mbox-buffer))
- (kill-buffer nnmbox-mbox-buffer))
- (nnoo-close-server 'nnmbox server)
- t)
-
-(deffoo nnmbox-server-opened (&optional server)
- (and (nnoo-current-server-p 'nnmbox server)
- nnmbox-mbox-buffer
- (buffer-name nnmbox-mbox-buffer)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)))
-
-(deffoo nnmbox-request-article (article &optional newsgroup server buffer)
- (nnmbox-possibly-change-newsgroup newsgroup server)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (when (nnmbox-find-article article)
- (let (start stop)
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (setq start (point))
- (forward-line 1)
- (setq stop (if (re-search-forward (concat "^"
- message-unix-mail-delimiter)
- nil 'move)
- (match-beginning 0)
- (point)))
- (let ((nntp-server-buffer (or buffer nntp-server-buffer)))
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring nnmbox-mbox-buffer start stop)
- (goto-char (point-min))
- (while (looking-at "From ")
- (delete-char 5)
- (insert "X-From-Line: ")
- (forward-line 1))
- (if (numberp article)
- (cons nnmbox-current-group article)
- (nnmbox-article-group-number nil)))))))
-
-(deffoo nnmbox-request-group (group &optional server dont-check)
- (nnmbox-possibly-change-newsgroup nil server)
- (let ((active (cadr (assoc group nnmbox-group-alist))))
- (cond
- ((or (null active)
- (null (nnmbox-possibly-change-newsgroup group server)))
- (nnheader-report 'nnmbox "No such group: %s" group))
- (dont-check
- (nnheader-report 'nnmbox "Selected group %s" group)
- (nnheader-insert ""))
- (t
- (nnheader-report 'nnmbox "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (1+ (- (cdr active) (car active)))
- (car active) (cdr active) group)))))
-
-(defun nnmbox-save-buffer ()
- (let ((coding-system-for-write
- (or nnmbox-file-coding-system-for-write
- nnmbox-file-coding-system)))
- (save-buffer)))
-
-(defun nnmbox-save-active (group-alist active-file)
- (let ((nnmail-active-file-coding-system
- (or nnmbox-active-file-coding-system-for-write
- nnmbox-active-file-coding-system)))
- (nnmail-save-active group-alist active-file)))
-
-(deffoo nnmbox-request-scan (&optional group server)
- (nnmbox-possibly-change-newsgroup group server)
- (nnmbox-read-mbox)
- (nnmail-get-new-mail
- 'nnmbox
- (lambda ()
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (nnmbox-save-buffer)))
- (file-name-directory nnmbox-mbox-file)
- group
- (lambda ()
- (save-excursion
- (let ((in-buf (current-buffer)))
- (set-buffer nnmbox-mbox-buffer)
- (goto-char (point-max))
- (insert-buffer-substring in-buf)))
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file))))
-
-(deffoo nnmbox-close-group (group &optional server)
- t)
-
-(deffoo nnmbox-request-create-group (group &optional server args)
- (nnmail-activate 'nnmbox)
- (unless (assoc group nnmbox-group-alist)
- (push (list group (cons 1 0))
- nnmbox-group-alist)
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file))
- t)
-
-(deffoo nnmbox-request-list (&optional server)
- (save-excursion
- (let ((nnmail-file-coding-system
- nnmbox-active-file-coding-system))
- (nnmail-find-file nnmbox-active-file))
- (setq nnmbox-group-alist (nnmail-get-active))
- t))
-
-(deffoo nnmbox-request-newgroups (date &optional server)
- (nnmbox-request-list server))
-
-(deffoo nnmbox-request-list-newsgroups (&optional server)
- (nnheader-report 'nnmbox "LIST NEWSGROUPS is not implemented."))
-
-(deffoo nnmbox-request-expire-articles
- (articles newsgroup &optional server force)
- (nnmbox-possibly-change-newsgroup newsgroup server)
- (let* ((is-old t)
- rest)
- (nnmail-activate 'nnmbox)
-
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (while (and articles is-old)
- (when (nnmbox-find-article (car articles))
- (if (setq is-old
- (nnmail-expired-article-p
- newsgroup
- (buffer-substring
- (point) (progn (end-of-line) (point))) force))
- (progn
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnmbox-request-article (car articles)
- newsgroup server
- (current-buffer))
- (let ((nnml-current-directory nil))
- (nnmail-expiry-target-group
- nnmail-expiry-target newsgroup)))
- (nnmbox-possibly-change-newsgroup newsgroup server))
- (nnheader-message 5 "Deleting article %d in %s..."
- (car articles) newsgroup)
- (nnmbox-delete-mail))
- (push (car articles) rest)))
- (setq articles (cdr articles)))
- (nnmbox-save-buffer)
- ;; Find the lowest active article in this group.
- (let ((active (nth 1 (assoc newsgroup nnmbox-group-alist))))
- (while (and (not (nnmbox-find-article (car active)))
- (<= (car active) (cdr active)))
- (setcar active (1+ (car active)))))
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
- (nconc rest articles))))
-
-(deffoo nnmbox-request-move-article
- (article group server accept-form &optional last)
- (let ((buf (get-buffer-create " *nnmbox move*"))
- result)
- (and
- (nnmbox-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (insert-buffer-substring nntp-server-buffer)
- (goto-char (point-min))
- (while (re-search-forward
- "^X-Gnus-Newsgroup:"
- (save-excursion (search-forward "\n\n" nil t) (point)) t)
- (gnus-delete-line))
- (setq result (eval accept-form))
- (kill-buffer buf)
- result)
- (save-excursion
- (nnmbox-possibly-change-newsgroup group server)
- (set-buffer nnmbox-mbox-buffer)
- (when (nnmbox-find-article article)
- (nnmbox-delete-mail))
- (and last (nnmbox-save-buffer))))
- result))
-
-(deffoo nnmbox-request-accept-article (group &optional server last)
- (nnmbox-possibly-change-newsgroup group server)
- (nnmail-check-syntax)
- (let ((buf (current-buffer))
- result cont)
- (and
- (nnmail-activate 'nnmbox)
- (with-temp-buffer
- (insert-buffer-substring buf)
- (goto-char (point-min))
- (cond (;; The From line may have been quoted by movemail.
- (looking-at (concat ">" message-unix-mail-delimiter))
- (delete-char 1)
- (forward-line 1))
- ((looking-at "X-From-Line: ")
- (replace-match "From ")
- (forward-line 1))
- (t
- (insert "From nobody " (current-time-string) "\n")))
- (narrow-to-region (point)
- (if (search-forward "\n\n" nil 'move)
- (1- (point))
- (point)))
- (while (re-search-backward "^X-Gnus-Newsgroup: " nil t)
- (delete-region (point) (progn (forward-line 1) (point))))
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (message-fetch-field "message-id")
- group
- (message-fetch-field "subject")
- (message-fetch-field "from")))
- (widen)
- (setq result (if (stringp group)
- (list (cons group (nnmbox-active-number group)))
- (nnmail-article-group 'nnmbox-active-number)))
- (prog1
- (if (and (null result)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nnmbox-save-mail result))))
- (setq cont (buffer-string))))
- (with-current-buffer nnmbox-mbox-buffer
- (goto-char (point-max))
- (insert cont)
- (when last
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close))
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
- (nnmbox-save-buffer))))
- result))
-
-(deffoo nnmbox-request-replace-article (article group buffer)
- (nnmbox-possibly-change-newsgroup group)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (if (not (nnmbox-find-article article))
- nil
- (nnmbox-delete-mail t t)
- (insert
- (with-temp-buffer
- (insert-buffer-substring buffer)
- (goto-char (point-min))
- (when (looking-at "X-From-Line:")
- (delete-region (point) (progn (forward-line 1) (point))))
- (while (re-search-forward (concat "^" message-unix-mail-delimiter)
- nil t)
- (goto-char (match-beginning 0))
- (insert ">"))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (buffer-string)))
- (nnmbox-save-buffer)
- t)))
-
-(deffoo nnmbox-request-delete-group (group &optional force server)
- (nnmbox-possibly-change-newsgroup group server)
- ;; Delete all articles in GROUP.
- (if (not force)
- () ; Don't delete the articles.
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (goto-char (point-min))
- ;; Delete all articles in this group.
- (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
- found)
- (while (search-forward ident nil t)
- (setq found t)
- (nnmbox-delete-mail))
- (when found
- (nnmbox-save-buffer)))))
- ;; Remove the group from all structures.
- (setq nnmbox-group-alist
- (delq (assoc group nnmbox-group-alist) nnmbox-group-alist)
- nnmbox-current-group nil)
- ;; Save the active file.
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
- t)
-
-(deffoo nnmbox-request-rename-group (group new-name &optional server)
- (nnmbox-possibly-change-newsgroup group server)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (goto-char (point-min))
- (let ((ident (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"))
- (new-ident (concat "\nX-Gnus-Newsgroup: " new-name ":"))
- found)
- (while (search-forward ident nil t)
- (replace-match new-ident t t)
- (setq found t))
- (when found
- (nnmbox-save-buffer))))
- (let ((entry (assoc group nnmbox-group-active-articles)))
- (when entry
- (setcar entry new-name)))
- (let ((entry (assoc group nnmbox-group-alist)))
- (when entry
- (setcar entry new-name))
- (setq nnmbox-current-group nil)
- ;; Save the new group alist.
- (nnmbox-save-active nnmbox-group-alist nnmbox-active-file)
- t))
-
-\f
-;;; Internal functions.
-
-;; If FORCE, delete article no matter how many X-Gnus-Newsgroup
-;; headers there are. If LEAVE-DELIM, don't delete the Unix mbox
-;; delimiter line.
-(defun nnmbox-delete-mail (&optional force leave-delim)
- ;; Delete the current X-Gnus-Newsgroup line.
- ;; First delete record of active article, unless the article is being
- ;; replaced, indicated by FORCE being non-nil.
- (if (not force)
- (nnmbox-record-deleted-article (nnmbox-article-group-number t)))
- (or force
- (gnus-delete-line))
- ;; Beginning of the article.
- (save-excursion
- (save-restriction
- (narrow-to-region
- (prog2
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (if leave-delim (progn (forward-line 1) (point))
- (match-beginning 0))
- (forward-line 1))
- (or (and (re-search-forward (concat "^" message-unix-mail-delimiter)
- nil t)
- (match-beginning 0))
- (point-max)))
- (goto-char (point-min))
- ;; Only delete the article if no other group owns it as well.
- (when (or force
- (not (re-search-forward "^X-Gnus-Newsgroup: " nil t))
- (search-backward "\n\n" nil t))
- (delete-region (point-min) (point-max))))))
-
-(defun nnmbox-possibly-change-newsgroup (newsgroup &optional server)
- (when (and server
- (not (nnmbox-server-opened server)))
- (nnmbox-open-server server))
- (when (or (not nnmbox-mbox-buffer)
- (not (buffer-name nnmbox-mbox-buffer)))
- (nnmbox-read-mbox))
- (when (not nnmbox-group-alist)
- (nnmail-activate 'nnmbox))
- (if newsgroup
- (when (assoc newsgroup nnmbox-group-alist)
- (setq nnmbox-current-group newsgroup))
- t))
-
-(defun nnmbox-article-string (article)
- (if (numberp article)
- (concat "\nX-Gnus-Newsgroup: " nnmbox-current-group ":"
- (int-to-string article) " ")
- (concat "\nMessage-ID: " article)))
-
-(defun nnmbox-article-group-number (this-line)
- (save-excursion
- (if this-line
- (beginning-of-line)
- (goto-char (point-min)))
- (when (re-search-forward "^X-Gnus-Newsgroup: +\\([^:]+\\):\\([0-9]+\\) "
- nil t)
- (cons (buffer-substring (match-beginning 1) (match-end 1))
- (string-to-number
- (buffer-substring (match-beginning 2) (match-end 2)))))))
-
-(defun nnmbox-in-header-p (pos)
- "Return non-nil if POS is in the header of an article."
- (save-excursion
- (goto-char pos)
- (re-search-backward (concat "^" message-unix-mail-delimiter) nil t)
- (search-forward "\n\n" nil t)
- (< pos (point))))
-
-(defun nnmbox-find-article (article)
- "Leaves point on the relevant X-Gnus-Newsgroup line if found."
- ;; Check that article is in the active range first, to avoid an
- ;; expensive exhaustive search if it isn't.
- (if (and (numberp article)
- (not (nnmbox-is-article-active-p article)))
- nil
- (let ((art-string (nnmbox-article-string article))
- (found nil))
- ;; There is the possibility that the X-Gnus-Newsgroup line appears
- ;; in the body of an article (for instance, if an article has been
- ;; forwarded from someone using Gnus as their mailer), so check
- ;; that the line is actually part of the article header.
- (or (and (search-forward art-string nil t)
- (nnmbox-in-header-p (point)))
- (progn
- (goto-char (point-min))
- (while (and (not found)
- (search-forward art-string nil t))
- (setq found (nnmbox-in-header-p (point))))
- found)))))
-
-(defun nnmbox-record-active-article (group-art)
- (let* ((group (car group-art))
- (article (cdr group-art))
- (entry
- (or (assoc group nnmbox-group-active-articles)
- (progn
- (push (list group)
- nnmbox-group-active-articles)
- (car nnmbox-group-active-articles)))))
- ;; add article to index, either by building complete list
- ;; in reverse order, or as a list of ranges.
- (if (not nnmbox-group-building-active-articles)
- (setcdr entry (gnus-add-to-range (cdr entry) (list article)))
- (when (memq article (cdr entry))
- (switch-to-buffer nnmbox-mbox-buffer)
- (error "Article %s:%d already exists!" group article))
- (when (and (cadr entry) (< article (cadr entry)))
- (switch-to-buffer nnmbox-mbox-buffer)
- (error "Article %s:%d out of order" group article))
- (setcdr entry (cons article (cdr entry))))))
-
-(defun nnmbox-record-deleted-article (group-art)
- (let* ((group (car group-art))
- (article (cdr group-art))
- (entry
- (or (assoc group nnmbox-group-active-articles)
- (progn
- (push (list group)
- nnmbox-group-active-articles)
- (car nnmbox-group-active-articles)))))
- ;; remove article from index
- (setcdr entry (gnus-remove-from-range (cdr entry) (list article)))))
-
-(defun nnmbox-is-article-active-p (article)
- (gnus-member-of-range
- article
- (cdr (assoc nnmbox-current-group
- nnmbox-group-active-articles))))
-
-(defun nnmbox-save-mail (group-art)
- "Called narrowed to an article."
- (let ((delim (concat "^" message-unix-mail-delimiter)))
- (goto-char (point-min))
- ;; This might come from somewhere else.
- (if (looking-at delim)
- (forward-line 1)
- (insert "From nobody " (current-time-string) "\n"))
- ;; Quote all "From " lines in the article.
- (while (re-search-forward delim nil t)
- (goto-char (match-beginning 0))
- (insert ">")))
- (goto-char (point-max))
- (unless (bolp)
- (insert "\n"))
- (nnmail-insert-lines)
- (nnmail-insert-xref group-art)
- (nnmbox-insert-newsgroup-line group-art)
- (let ((alist group-art))
- (while alist
- (nnmbox-record-active-article (car alist))
- (setq alist (cdr alist))))
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnmbox-prepare-save-mail-hook)
- group-art)
-
-(defun nnmbox-insert-newsgroup-line (group-art)
- (save-excursion
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (forward-char -1)
- (while group-art
- (insert (format "X-Gnus-Newsgroup: %s:%d %s\n"
- (caar group-art) (cdar group-art)
- (current-time-string)))
- (setq group-art (cdr group-art))))
- t))
-
-(defun nnmbox-active-number (group)
- ;; Find the next article number in GROUP.
- (let ((active (cadr (assoc group nnmbox-group-alist))))
- (if active
- (setcdr active (1+ (cdr active)))
- ;; This group is new, so we create a new entry for it.
- ;; This might be a bit naughty... creating groups on the drop of
- ;; a hat, but I don't know...
- (push (list group (setq active (cons 1 1)))
- nnmbox-group-alist))
- (cdr active)))
-
-(defun nnmbox-create-mbox ()
- (when (not (file-exists-p nnmbox-mbox-file))
- (let ((nnmail-file-coding-system
- (or nnmbox-file-coding-system-for-write
- nnmbox-file-coding-system))
- (dir (file-name-directory nnmbox-mbox-file)))
- (and dir (gnus-make-directory dir))
- (nnmail-write-region (point-min) (point-min)
- nnmbox-mbox-file t 'nomesg))))
-
-(defun nnmbox-read-mbox ()
- (nnmail-activate 'nnmbox)
- (nnmbox-create-mbox)
- (if (and nnmbox-mbox-buffer
- (buffer-name nnmbox-mbox-buffer)
- (save-excursion
- (set-buffer nnmbox-mbox-buffer)
- (= (buffer-size) (nnheader-file-size nnmbox-mbox-file))))
- ()
- (save-excursion
- (let ((delim (concat "^" message-unix-mail-delimiter))
- (alist nnmbox-group-alist)
- (nnmbox-group-building-active-articles t)
- start end end-header number)
- (set-buffer (setq nnmbox-mbox-buffer
- (let ((nnheader-file-coding-system
- nnmbox-file-coding-system))
- (nnheader-find-file-noselect
- nnmbox-mbox-file t t))))
- (mm-enable-multibyte)
- (buffer-disable-undo)
-
- ;; Go through the group alist and compare against the mbox file.
- (while alist
- (goto-char (point-max))
- (when (and (re-search-backward
- (format "^X-Gnus-Newsgroup: %s:\\([0-9]+\\) "
- (caar alist)) nil t)
- (> (setq number
- (string-to-number
- (buffer-substring
- (match-beginning 1) (match-end 1))))
- (cdadar alist)))
- (setcdr (cadar alist) number))
- (setq alist (cdr alist)))
-
- ;; Examine all articles for our private X-Gnus-Newsgroup
- ;; headers. This is done primarily as a consistency check, but
- ;; it is convenient for building an index of the articles
- ;; present, to avoid costly searches for missing articles
- ;; (eg. when expiring articles).
- (goto-char (point-min))
- (setq nnmbox-group-active-articles nil)
- (while (re-search-forward delim nil t)
- (setq start (match-beginning 0))
- (save-excursion
- (search-forward "\n\n" nil t)
- (setq end-header (point))
- (setq end (or (and
- (re-search-forward delim nil t)
- (match-beginning 0))
- (point-max))))
- (if (search-forward "\nX-Gnus-Newsgroup: " end-header t)
- ;; Build a list of articles in each group, remembering
- ;; that each article may be in more than one group.
- (progn
- (nnmbox-record-active-article (nnmbox-article-group-number t))
- (while (search-forward "\nX-Gnus-Newsgroup: " end-header t)
- (nnmbox-record-active-article (nnmbox-article-group-number t))))
- ;; The article is either new, or for some other reason
- ;; hasn't got our private headers, so add them now. The
- ;; only situation I've encountered when the X-Gnus-Newsgroup
- ;; header is missing is if the article contains a forwarded
- ;; message which does contain that header line (earlier
- ;; versions of Gnus didn't restrict their search to the
- ;; headers). In this case, there is an Xref line which
- ;; provides the relevant information to construct the
- ;; missing header(s).
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (if (re-search-forward "\nXref: [^ ]+" end-header t)
- ;; generate headers from Xref:
- (let (alist)
- (while (re-search-forward " \\([^:]+\\):\\([0-9]+\\)" end-header t)
- (push (cons (match-string 1)
- (string-to-number (match-string 2))) alist))
- (nnmbox-insert-newsgroup-line alist))
- ;; this is really a new article
- (nnmbox-save-mail
- (nnmail-article-group 'nnmbox-active-number))))))
- (goto-char end))
- ;; put article lists in order
- (setq alist nnmbox-group-active-articles)
- (while alist
- (setcdr (car alist) (gnus-compress-sequence (nreverse (cdar alist))))
- (setq alist (cdr alist)))))))
-
-(provide 'nnmbox)
-
-;;; arch-tag: 611dd95f-be37-413a-b3ae-8b059ba93659
-;;; nnmbox.el ends here
+++ /dev/null
-;;; nnmh.el --- mhspool access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-start)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnmh)
-
-(defvoo nnmh-directory message-directory
- "Mail spool directory.")
-
-(defvoo nnmh-get-new-mail t
- "If non-nil, nnmh will check the incoming mail file and split the mail.")
-
-(defvoo nnmh-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
-
-(defvoo nnmh-be-safe nil
- "If non-nil, nnmh will check all articles to make sure whether they are new or not.
-Go through the .nnmh-articles file and compare with the actual
-articles in this folder. The articles that are \"new\" will be marked
-as unread by Gnus.")
-
-\f
-
-(defconst nnmh-version "nnmh 1.0"
- "nnmh version.")
-
-(defvoo nnmh-current-directory nil
- "Current news group directory.")
-
-(defvoo nnmh-status-string "")
-(defvoo nnmh-group-alist nil)
-;; Don't even think about setting this variable. It does not exist.
-;; Forget about it. Uh-huh. Nope. Nobody here. It's only bound
-;; dynamically by certain functions in nndraft.
-(defvar nnmh-allow-delete-final nil)
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nnmh)
-
-(deffoo nnmh-retrieve-headers (articles &optional newsgroup server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let* ((file nil)
- (number (length articles))
- (large (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)))
- (count 0)
- (file-name-coding-system nnmail-pathname-coding-system)
- beg article)
- (nnmh-possibly-change-directory newsgroup server)
- ;; We don't support fetching by Message-ID.
- (if (stringp (car articles))
- 'headers
- (while articles
- (when (and (file-exists-p
- (setq file (concat (file-name-as-directory
- nnmh-current-directory)
- (int-to-string
- (setq article (pop articles))))))
- (not (file-directory-p file)))
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (nnheader-insert-head file)
- (goto-char beg)
- (if (search-forward "\n\n" nil t)
- (forward-char -1)
- (goto-char (point-max))
- (insert "\n\n"))
- (insert ".\n")
- (delete-region (point) (point-max)))
- (setq count (1+ count))
-
- (and large
- (zerop (% count 20))
- (nnheader-message 5 "nnmh: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (when large
- (nnheader-message 5 "nnmh: Receiving headers...done"))
-
- (nnheader-fold-continuation-lines)
- 'headers))))
-
-(deffoo nnmh-open-server (server &optional defs)
- (nnoo-change-server 'nnmh server defs)
- (when (not (file-exists-p nnmh-directory))
- (condition-case ()
- (make-directory nnmh-directory t)
- (error t)))
- (cond
- ((not (file-exists-p nnmh-directory))
- (nnmh-close-server)
- (nnheader-report 'nnmh "Couldn't create directory: %s" nnmh-directory))
- ((not (file-directory-p (file-truename nnmh-directory)))
- (nnmh-close-server)
- (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory))
- (t
- (nnheader-report 'nnmh "Opened server %s using directory %s"
- server nnmh-directory)
- t)))
-
-(deffoo nnmh-request-article (id &optional newsgroup server buffer)
- (nnmh-possibly-change-directory newsgroup server)
- (let ((file (if (stringp id)
- nil
- (concat nnmh-current-directory (int-to-string id))))
- (file-name-coding-system nnmail-pathname-coding-system)
- (nntp-server-buffer (or buffer nntp-server-buffer)))
- (and (stringp file)
- (file-exists-p file)
- (not (file-directory-p file))
- (save-excursion (nnmail-find-file file))
- (string-to-number (file-name-nondirectory file)))))
-
-(deffoo nnmh-request-group (group &optional server dont-check)
- (nnheader-init-server-buffer)
- (nnmh-possibly-change-directory group server)
- (let ((pathname (nnmail-group-pathname group nnmh-directory))
- (file-name-coding-system nnmail-pathname-coding-system)
- dir)
- (cond
- ((not (file-directory-p pathname))
- (nnheader-report
- 'nnmh "Can't select group (no such directory): %s" group))
- (t
- (setq nnmh-current-directory pathname)
- (and nnmh-get-new-mail
- nnmh-be-safe
- (nnmh-update-gnus-unreads group))
- (cond
- (dont-check
- (nnheader-report 'nnmh "Selected group %s" group)
- t)
- (t
- ;; Re-scan the directory if it's on a foreign system.
- (nnheader-re-read-dir pathname)
- (setq dir
- (sort
- (mapcar (lambda (name) (string-to-number name))
- (directory-files pathname nil "^[0-9]+$" t))
- '<))
- (cond
- (dir
- (setq nnmh-group-alist
- (delq (assoc group nnmh-group-alist) nnmh-group-alist))
- (push (list group (cons (car dir) (car (last dir))))
- nnmh-group-alist)
- (nnheader-report 'nnmh "Selected group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (length dir) (car dir)
- (car (last dir)) group))
- (t
- (nnheader-report 'nnmh "Empty group %s" group)
- (nnheader-insert (format "211 0 1 0 %s\n" group))))))))))
-
-(deffoo nnmh-request-scan (&optional group server)
- (nnmail-get-new-mail 'nnmh nil nnmh-directory group))
-
-(deffoo nnmh-request-list (&optional server dir)
- (nnheader-insert "")
- (nnmh-possibly-change-directory nil server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (nnmh-toplev
- (file-truename (or dir (file-name-as-directory nnmh-directory)))))
- (nnmh-request-list-1 nnmh-toplev))
- (setq nnmh-group-alist (nnmail-get-active))
- t)
-
-(defvar nnmh-toplev)
-(defun nnmh-request-list-1 (dir)
- (setq dir (expand-file-name dir))
- ;; Recurse down all directories.
- (let ((dirs (and (file-readable-p dir)
- (> (nth 1 (file-attributes (file-chase-links dir))) 2)
- (nnheader-directory-files dir t nil t)))
- rdir)
- ;; Recurse down directories.
- (while (setq rdir (pop dirs))
- (when (and (file-directory-p rdir)
- (file-readable-p rdir)
- (not (equal (file-truename rdir)
- (file-truename dir))))
- (nnmh-request-list-1 rdir))))
- ;; For each directory, generate an active file line.
- (unless (string= (expand-file-name nnmh-toplev) dir)
- (let ((files (mapcar
- (lambda (name) (string-to-number name))
- (directory-files dir nil "^[0-9]+$" t))))
- (when files
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-max))
- (insert
- (format
- "%s %.0f %.0f y\n"
- (progn
- (string-match
- (regexp-quote
- (file-truename (file-name-as-directory
- (expand-file-name nnmh-toplev))))
- dir)
- (mm-string-as-multibyte
- (mm-encode-coding-string
- (nnheader-replace-chars-in-string
- (substring dir (match-end 0))
- ?/ ?.)
- nnmail-pathname-coding-system)))
- (apply 'max files)
- (apply 'min files)))))))
- t)
-
-(deffoo nnmh-request-newgroups (date &optional server)
- (nnmh-request-list server))
-
-(deffoo nnmh-request-expire-articles (articles newsgroup
- &optional server force)
- (nnmh-possibly-change-directory newsgroup server)
- (let ((is-old t)
- (nnmail-expiry-target
- (or (gnus-group-find-parameter newsgroup 'expiry-target t)
- nnmail-expiry-target))
- article rest mod-time)
- (nnheader-init-server-buffer)
-
- (while (and articles is-old)
- (setq article (concat nnmh-current-directory
- (int-to-string (car articles))))
- (when (setq mod-time (nth 5 (file-attributes article)))
- (if (and (nnmh-deletable-article-p newsgroup (car articles))
- (setq is-old
- (nnmail-expired-article-p newsgroup mod-time force)))
- (progn
- ;; Allow a special target group. -- jcn
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnmh-request-article (car articles)
- newsgroup server (current-buffer))
- (nnmail-expiry-target-group
- nnmail-expiry-target newsgroup)))
- (nnheader-message 5 "Deleting article %s in %s..."
- article newsgroup)
- (condition-case ()
- (funcall nnmail-delete-file-function article)
- (file-error
- (nnheader-message 1 "Couldn't delete article %s in %s"
- article newsgroup)
- (push (car articles) rest))))
- (push (car articles) rest)))
- (setq articles (cdr articles)))
- (nnheader-message 5 "")
- (nconc rest articles)))
-
-(deffoo nnmh-close-group (group &optional server)
- t)
-
-(deffoo nnmh-request-move-article (article group server
- accept-form &optional last)
- (let ((buf (get-buffer-create " *nnmh move*"))
- result)
- (and
- (nnmh-deletable-article-p group article)
- (nnmh-request-article article group server)
- (save-excursion
- (set-buffer buf)
- (erase-buffer)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result)
- (progn
- (nnmh-possibly-change-directory group server)
- (condition-case ()
- (funcall nnmail-delete-file-function
- (concat nnmh-current-directory (int-to-string article)))
- (file-error nil))))
- result))
-
-(deffoo nnmh-request-accept-article (group &optional server last noinsert)
- (nnmh-possibly-change-directory group server)
- (nnmail-check-syntax)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
- (nnheader-init-server-buffer)
- (prog1
- (if (stringp group)
- (if noinsert
- (nnmh-active-number group)
- (car (nnmh-save-mail
- (list (cons group (nnmh-active-number group)))
- noinsert)))
- (let ((res (nnmail-article-group 'nnmh-active-number)))
- (if (and (null res)
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- 'junk
- (car (nnmh-save-mail res noinsert)))))
- (when (and last nnmail-cache-accepted-message-ids)
- (nnmail-cache-close))))
-
-(deffoo nnmh-request-replace-article (article group buffer)
- (nnmh-possibly-change-directory group)
- (save-excursion
- (set-buffer buffer)
- (nnmh-possibly-create-directory group)
- (ignore-errors
- (nnmail-write-region
- (point-min) (point-max)
- (concat nnmh-current-directory (int-to-string article))
- nil (if (nnheader-be-verbose 5) nil 'nomesg))
- t)))
-
-(deffoo nnmh-request-create-group (group &optional server args)
- (nnheader-init-server-buffer)
- (unless (assoc group nnmh-group-alist)
- (let (active)
- (push (list group (setq active (cons 1 0)))
- nnmh-group-alist)
- (nnmh-possibly-create-directory group)
- (nnmh-possibly-change-directory group server)
- (let ((articles (mapcar
- (lambda (file)
- (string-to-number file))
- (directory-files
- nnmh-current-directory nil "^[0-9]+$"))))
- (when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))))
- t)
-
-(deffoo nnmh-request-delete-group (group &optional force server)
- (nnmh-possibly-change-directory group server)
- ;; Delete all articles in GROUP.
- (if (not force)
- () ; Don't delete the articles.
- (let ((articles (directory-files nnmh-current-directory t "^[0-9]+$")))
- (while articles
- (when (file-writable-p (car articles))
- (nnheader-message 5 "Deleting article %s in %s..."
- (car articles) group)
- (funcall nnmail-delete-file-function (car articles)))
- (setq articles (cdr articles))))
- ;; Try to delete the directory itself.
- (ignore-errors
- (delete-directory nnmh-current-directory)))
- ;; Remove the group from all structures.
- (setq nnmh-group-alist
- (delq (assoc group nnmh-group-alist) nnmh-group-alist)
- nnmh-current-directory nil)
- t)
-
-(deffoo nnmh-request-rename-group (group new-name &optional server)
- (nnmh-possibly-change-directory group server)
- (let ((new-dir (nnmail-group-pathname new-name nnmh-directory))
- (old-dir (nnmail-group-pathname group nnmh-directory)))
- (when (ignore-errors
- (make-directory new-dir t)
- t)
- ;; We move the articles file by file instead of renaming
- ;; the directory -- there may be subgroups in this group.
- ;; One might be more clever, I guess.
- (let ((files (nnheader-article-to-file-alist old-dir)))
- (while files
- (rename-file
- (concat old-dir (cdar files))
- (concat new-dir (cdar files)))
- (pop files)))
- (when (<= (length (directory-files old-dir)) 2)
- (ignore-errors
- (delete-directory old-dir)))
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnmh-group-alist)))
- (when entry
- (setcar entry new-name))
- (setq nnmh-current-directory nil)
- t))))
-
-(nnoo-define-skeleton nnmh)
-
-\f
-;;; Internal functions.
-
-(defun nnmh-possibly-change-directory (newsgroup &optional server)
- (when (and server
- (not (nnmh-server-opened server)))
- (nnmh-open-server server))
- (when newsgroup
- (let ((pathname (nnmail-group-pathname newsgroup nnmh-directory))
- (file-name-coding-system nnmail-pathname-coding-system))
- (if (file-directory-p pathname)
- (setq nnmh-current-directory pathname)
- (nnheader-report 'nnmh "Not a directory: %s" nnmh-directory)))))
-
-(defun nnmh-possibly-create-directory (group)
- (let (dir dirs)
- (setq dir (nnmail-group-pathname group nnmh-directory))
- (while (not (file-directory-p dir))
- (push dir dirs)
- (setq dir (file-name-directory (directory-file-name dir))))
- (while dirs
- (when (make-directory (directory-file-name (car dirs)))
- (error "Could not create directory %s" (car dirs)))
- (nnheader-message 5 "Creating mail directory %s" (car dirs))
- (setq dirs (cdr dirs)))))
-
-(defun nnmh-save-mail (group-art &optional noinsert)
- "Called narrowed to an article."
- (unless noinsert
- (nnmail-insert-lines)
- (nnmail-insert-xref group-art))
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnmh-prepare-save-mail-hook)
- (goto-char (point-min))
- (while (looking-at "From ")
- (replace-match "X-From-Line: ")
- (forward-line 1))
- ;; We save the article in all the newsgroups it belongs in.
- (let ((ga group-art)
- first)
- (while ga
- (nnmh-possibly-create-directory (caar ga))
- (let ((file (concat (nnmail-group-pathname
- (caar ga) nnmh-directory)
- (int-to-string (cdar ga)))))
- (if first
- ;; It was already saved, so we just make a hard link.
- (funcall nnmail-crosspost-link-function first file t)
- ;; Save the article.
- (nnmail-write-region (point-min) (point-max) file nil nil)
- (setq first file)))
- (setq ga (cdr ga))))
- group-art)
-
-(defun nnmh-active-number (group)
- "Compute the next article number in GROUP."
- (let ((active (cadr (assoc group nnmh-group-alist)))
- (dir (nnmail-group-pathname group nnmh-directory))
- (file-name-coding-system nnmail-pathname-coding-system)
- file)
- (unless active
- ;; The group wasn't known to nnmh, so we just create an active
- ;; entry for it.
- (setq active (cons 1 0))
- (push (list group active) nnmh-group-alist)
- (unless (file-exists-p dir)
- (gnus-make-directory dir))
- ;; Find the highest number in the group.
- (let ((files (sort
- (mapcar
- (lambda (f)
- (string-to-number f))
- (directory-files dir nil "^[0-9]+$"))
- '>)))
- (when files
- (setcdr active (car files)))))
- (setcdr active (1+ (cdr active)))
- (while (or
- ;; See whether the file exists...
- (file-exists-p
- (setq file (concat (nnmail-group-pathname group nnmh-directory)
- (int-to-string (cdr active)))))
- ;; ... or there is a buffer that will make that file exist
- ;; in the future.
- (get-file-buffer file))
- ;; Skip past that file.
- (setcdr active (1+ (cdr active))))
- (cdr active)))
-
-(defun nnmh-update-gnus-unreads (group)
- ;; Go through the .nnmh-articles file and compare with the actual
- ;; articles in this folder. The articles that are "new" will be
- ;; marked as unread by Gnus.
- (let* ((dir nnmh-current-directory)
- (files (sort (mapcar (function (lambda (name) (string-to-number name)))
- (directory-files nnmh-current-directory
- nil "^[0-9]+$" t))
- '<))
- (nnmh-file (concat dir ".nnmh-articles"))
- new articles)
- ;; Load the .nnmh-articles file.
- (when (file-exists-p nnmh-file)
- (setq articles
- (let (nnmh-newsgroup-articles)
- (ignore-errors (load nnmh-file nil t t))
- nnmh-newsgroup-articles)))
- ;; Add all new articles to the `new' list.
- (let ((art files))
- (while art
- (unless (assq (car art) articles)
- (push (car art) new))
- (setq art (cdr art))))
- ;; Remove all deleted articles.
- (let ((art articles))
- (while art
- (unless (memq (caar art) files)
- (setq articles (delq (car art) articles)))
- (setq art (cdr art))))
- ;; Check whether the articles really are the ones that Gnus thinks
- ;; they are by looking at the time-stamps.
- (let ((arts articles)
- art)
- (while (setq art (pop arts))
- (when (not (equal
- (nth 5 (file-attributes
- (concat dir (int-to-string (car art)))))
- (cdr art)))
- (setq articles (delq art articles))
- (push (car art) new))))
- ;; Go through all the new articles and add them, and their
- ;; time-stamps, to the list.
- (setq articles
- (nconc articles
- (mapcar
- (lambda (art)
- (cons art
- (nth 5 (file-attributes
- (concat dir (int-to-string art))))))
- new)))
- ;; Make Gnus mark all new articles as unread.
- (when new
- (gnus-make-articles-unread
- (gnus-group-prefixed-name group (list 'nnmh ""))
- (setq new (sort new '<))))
- ;; Sort the article list with highest numbers first.
- (setq articles (sort articles (lambda (art1 art2)
- (> (car art1) (car art2)))))
- ;; Finally write this list back to the .nnmh-articles file.
- (with-temp-file nnmh-file
- (insert ";; Gnus article active file for " group "\n\n")
- (insert "(setq nnmh-newsgroup-articles '")
- (gnus-prin1 articles)
- (insert ")\n"))))
-
-(defun nnmh-deletable-article-p (group article)
- "Say whether ARTICLE in GROUP can be deleted."
- (let ((path (concat nnmh-current-directory (int-to-string article))))
- ;; Writable.
- (and (file-writable-p path)
- (or
- ;; We can never delete the last article in the group.
- (not (eq (cdr (nth 1 (assoc group nnmh-group-alist)))
- article))
- ;; Well, we can.
- nnmh-allow-delete-final))))
-
-(provide 'nnmh)
-
-;;; arch-tag: 36c12a98-3bad-44b3-9953-628078ef0e04
-;;; nnmh.el ends here
+++ /dev/null
-;;; nnml.el --- mail spool access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org> (adding MARKS)
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Based on nnspool.el by Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>.
-;; For an overview of what the interface functions do, please see the
-;; Gnus sources.
-
-;;; Code:
-
-(require 'gnus)
-(require 'nnheader)
-(require 'nnmail)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (autoload 'gnus-article-unpropagatable-p "gnus-sum"))
-
-(nnoo-declare nnml)
-
-(defvoo nnml-directory message-directory
- "Spool directory for the nnml mail backend.")
-
-(defvoo nnml-active-file
- (expand-file-name "active" nnml-directory)
- "Mail active file.")
-
-(defvoo nnml-newsgroups-file
- (expand-file-name "newsgroups" nnml-directory)
- "Mail newsgroups description file.")
-
-(defvoo nnml-get-new-mail t
- "If non-nil, nnml will check the incoming mail file and split the mail.")
-
-(defvoo nnml-nov-is-evil nil
- "If non-nil, Gnus will never generate and use nov databases for mail spools.
-Using nov databases will speed up header fetching considerably.
-This variable shouldn't be flipped much. If you have, for some reason,
-set this to t, and want to set it to nil again, you should always run
-the `nnml-generate-nov-databases' command. The function will go
-through all nnml directories and generate nov databases for them
-all. This may very well take some time.")
-
-(defvoo nnml-marks-is-evil nil
- "If non-nil, Gnus will never generate and use marks file for mail spools.
-Using marks files makes it possible to backup and restore mail groups
-separately from `.newsrc.eld'. If you have, for some reason, set this
-to t, and want to set it to nil again, you should always remove the
-corresponding marks file (usually named `.marks' in the nnml group
-directory, but see `nnml-marks-file-name') for the group. Then the
-marks file will be regenerated properly by Gnus.")
-
-(defvoo nnml-prepare-save-mail-hook nil
- "Hook run narrowed to an article before saving.")
-
-(defvoo nnml-inhibit-expiry nil
- "If non-nil, inhibit expiry.")
-
-(defvoo nnml-use-compressed-files nil
- "If non-nil, allow using compressed message files.")
-
-\f
-
-(defconst nnml-version "nnml 1.0"
- "nnml version.")
-
-(defvoo nnml-nov-file-name ".overview")
-(defvoo nnml-marks-file-name ".marks")
-
-(defvoo nnml-current-directory nil)
-(defvoo nnml-current-group nil)
-(defvoo nnml-status-string "")
-(defvoo nnml-nov-buffer-alist nil)
-(defvoo nnml-group-alist nil)
-(defvoo nnml-active-timestamp nil)
-(defvoo nnml-article-file-alist nil)
-
-(defvoo nnml-generate-active-function 'nnml-generate-active-info)
-
-(defvar nnml-nov-buffer-file-name nil)
-
-(defvoo nnml-file-coding-system nnmail-file-coding-system)
-
-(defvoo nnml-marks nil)
-
-(defvar nnml-marks-modtime (gnus-make-hashtable))
-
-\f
-;;; Interface functions.
-
-(nnoo-define-basics nnml)
-
-(deffoo nnml-retrieve-headers (sequence &optional group server fetch-old)
- (when (nnml-possibly-change-directory group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let* ((file nil)
- (number (length sequence))
- (count 0)
- (file-name-coding-system nnmail-pathname-coding-system)
- beg article)
- (if (stringp (car sequence))
- 'headers
- (if (nnml-retrieve-headers-with-nov sequence fetch-old)
- 'nov
- (while sequence
- (setq article (car sequence))
- (setq file (nnml-article-to-file article))
- (when (and file
- (file-exists-p file)
- (not (file-directory-p file)))
- (insert (format "221 %d Article retrieved.\n" article))
- (setq beg (point))
- (nnheader-insert-head file)
- (goto-char beg)
- (if (re-search-forward "\n\r?\n" nil t)
- (forward-char -1)
- (goto-char (point-max))
- (insert "\n\n"))
- (insert ".\n")
- (delete-region (point) (point-max)))
- (setq sequence (cdr sequence))
- (setq count (1+ count))
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (zerop (% count 20))
- (nnheader-message 6 "nnml: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (and (numberp nnmail-large-newsgroup)
- (> number nnmail-large-newsgroup)
- (nnheader-message 6 "nnml: Receiving headers...done"))
-
- (nnheader-fold-continuation-lines)
- 'headers))))))
-
-(deffoo nnml-open-server (server &optional defs)
- (nnoo-change-server 'nnml server defs)
- (when (not (file-exists-p nnml-directory))
- (ignore-errors (make-directory nnml-directory t)))
- (cond
- ((not (file-exists-p nnml-directory))
- (nnml-close-server)
- (nnheader-report 'nnml "Couldn't create directory: %s" nnml-directory))
- ((not (file-directory-p (file-truename nnml-directory)))
- (nnml-close-server)
- (nnheader-report 'nnml "Not a directory: %s" nnml-directory))
- (t
- (nnheader-report 'nnml "Opened server %s using directory %s"
- server nnml-directory)
- t)))
-
-(deffoo nnml-request-regenerate (server)
- (nnml-possibly-change-directory nil server)
- (nnml-generate-nov-databases server)
- t)
-
-(deffoo nnml-request-article (id &optional group server buffer)
- (nnml-possibly-change-directory group server)
- (let* ((nntp-server-buffer (or buffer nntp-server-buffer))
- (file-name-coding-system nnmail-pathname-coding-system)
- path gpath group-num)
- (if (stringp id)
- (when (and (setq group-num (nnml-find-group-number id))
- (cdr
- (assq (cdr group-num)
- (nnheader-article-to-file-alist
- (setq gpath
- (nnmail-group-pathname
- (car group-num)
- nnml-directory))))))
- (setq path (concat gpath (int-to-string (cdr group-num)))))
- (setq path (nnml-article-to-file id)))
- (cond
- ((not path)
- (nnheader-report 'nnml "No such article: %s" id))
- ((not (file-exists-p path))
- (nnheader-report 'nnml "No such file: %s" path))
- ((file-directory-p path)
- (nnheader-report 'nnml "File is a directory: %s" path))
- ((not (save-excursion (let ((nnmail-file-coding-system
- nnml-file-coding-system))
- (nnmail-find-file path))))
- (nnheader-report 'nnml "Couldn't read file: %s" path))
- (t
- (nnheader-report 'nnml "Article %s retrieved" id)
- ;; We return the article number.
- (cons (if group-num (car group-num) group)
- (string-to-number (file-name-nondirectory path)))))))
-
-(deffoo nnml-request-group (group &optional server dont-check)
- (let ((file-name-coding-system nnmail-pathname-coding-system))
- (cond
- ((not (nnml-possibly-change-directory group server))
- (nnheader-report 'nnml "Invalid group (no such directory)"))
- ((not (file-exists-p nnml-current-directory))
- (nnheader-report 'nnml "Directory %s does not exist"
- nnml-current-directory))
- ((not (file-directory-p nnml-current-directory))
- (nnheader-report 'nnml "%s is not a directory" nnml-current-directory))
- (dont-check
- (nnheader-report 'nnml "Group %s selected" group)
- t)
- (t
- (nnheader-re-read-dir nnml-current-directory)
- (nnmail-activate 'nnml)
- (let ((active (nth 1 (assoc group nnml-group-alist))))
- (if (not active)
- (nnheader-report 'nnml "No such group: %s" group)
- (nnheader-report 'nnml "Selected group %s" group)
- (nnheader-insert "211 %d %d %d %s\n"
- (max (1+ (- (cdr active) (car active))) 0)
- (car active) (cdr active) group)))))))
-
-(deffoo nnml-request-scan (&optional group server)
- (setq nnml-article-file-alist nil)
- (nnml-possibly-change-directory group server)
- (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
-
-(deffoo nnml-close-group (group &optional server)
- (setq nnml-article-file-alist nil)
- t)
-
-(deffoo nnml-request-create-group (group &optional server args)
- (nnml-possibly-change-directory nil server)
- (nnmail-activate 'nnml)
- (cond
- ((assoc group nnml-group-alist)
- t)
- ((and (file-exists-p (nnmail-group-pathname group nnml-directory))
- (not (file-directory-p (nnmail-group-pathname group nnml-directory))))
- (nnheader-report 'nnml "%s is a file"
- (nnmail-group-pathname group nnml-directory)))
- (t
- (let (active)
- (push (list group (setq active (cons 1 0)))
- nnml-group-alist)
- (nnml-possibly-create-directory group)
- (nnml-possibly-change-directory group server)
- (let ((articles (nnml-directory-articles nnml-current-directory)))
- (when articles
- (setcar active (apply 'min articles))
- (setcdr active (apply 'max articles))))
- (nnmail-save-active nnml-group-alist nnml-active-file)
- t))))
-
-(deffoo nnml-request-list (&optional server)
- (save-excursion
- (let ((nnmail-file-coding-system nnmail-active-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (nnmail-find-file nnml-active-file))
- (setq nnml-group-alist (nnmail-get-active))
- t))
-
-(deffoo nnml-request-newgroups (date &optional server)
- (nnml-request-list server))
-
-(deffoo nnml-request-list-newsgroups (&optional server)
- (save-excursion
- (nnmail-find-file nnml-newsgroups-file)))
-
-(deffoo nnml-request-expire-articles (articles group &optional server force)
- (nnml-possibly-change-directory group server)
- (let ((active-articles
- (nnml-directory-articles nnml-current-directory))
- (is-old t)
- article rest mod-time number)
- (nnmail-activate 'nnml)
-
- (setq active-articles (sort active-articles '<))
- ;; Articles not listed in active-articles are already gone,
- ;; so don't try to expire them.
- (setq articles (gnus-sorted-intersection articles active-articles))
-
- (while (and articles is-old)
- (if (and (setq article (nnml-article-to-file
- (setq number (pop articles))))
- (setq mod-time (nth 5 (file-attributes article)))
- (nnml-deletable-article-p group number)
- (setq is-old (nnmail-expired-article-p group mod-time force
- nnml-inhibit-expiry)))
- (progn
- ;; Allow a special target group.
- (unless (eq nnmail-expiry-target 'delete)
- (with-temp-buffer
- (nnml-request-article number group server (current-buffer))
- (let (nnml-current-directory
- nnml-current-group
- nnml-article-file-alist)
- (nnmail-expiry-target-group nnmail-expiry-target group)))
- ;; Maybe directory is changed during nnmail-expiry-target-group.
- (nnml-possibly-change-directory group server))
- (nnheader-message 5 "Deleting article %s in %s"
- number group)
- (condition-case ()
- (funcall nnmail-delete-file-function article)
- (file-error
- (push number rest)))
- (setq active-articles (delq number active-articles))
- (nnml-nov-delete-article group number))
- (push number rest)))
- (let ((active (nth 1 (assoc group nnml-group-alist))))
- (when active
- (setcar active (or (and active-articles
- (apply 'min active-articles))
- (1+ (cdr active)))))
- (nnmail-save-active nnml-group-alist nnml-active-file))
- (nnml-save-nov)
- (nconc rest articles)))
-
-(deffoo nnml-request-move-article
- (article group server accept-form &optional last)
- (let ((buf (get-buffer-create " *nnml move*"))
- result)
- (nnml-possibly-change-directory group server)
- (nnml-update-file-alist)
- (and
- (nnml-deletable-article-p group article)
- (nnml-request-article article group server)
- (let (nnml-current-directory
- nnml-current-group
- nnml-article-file-alist)
- (save-excursion
- (set-buffer buf)
- (insert-buffer-substring nntp-server-buffer)
- (setq result (eval accept-form))
- (kill-buffer (current-buffer))
- result))
- (progn
- (nnml-possibly-change-directory group server)
- (condition-case ()
- (funcall nnmail-delete-file-function
- (nnml-article-to-file article))
- (file-error nil))
- (nnml-nov-delete-article group article)
- (when last
- (nnml-save-nov)
- (nnmail-save-active nnml-group-alist nnml-active-file))))
- result))
-
-(deffoo nnml-request-accept-article (group &optional server last)
- (nnml-possibly-change-directory group server)
- (nnmail-check-syntax)
- (let (result)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-insert (nnmail-fetch-field "message-id")
- group
- (nnmail-fetch-field "subject")
- (nnmail-fetch-field "from")))
- (if (stringp group)
- (and
- (nnmail-activate 'nnml)
- (setq result (car (nnml-save-mail
- (list (cons group (nnml-active-number group))))))
- (progn
- (nnmail-save-active nnml-group-alist nnml-active-file)
- (and last (nnml-save-nov))))
- (and
- (nnmail-activate 'nnml)
- (if (and (not (setq result (nnmail-article-group 'nnml-active-number)))
- (yes-or-no-p "Moved to `junk' group; delete article? "))
- (setq result 'junk)
- (setq result (car (nnml-save-mail result))))
- (when last
- (nnmail-save-active nnml-group-alist nnml-active-file)
- (when nnmail-cache-accepted-message-ids
- (nnmail-cache-close))
- (nnml-save-nov))))
- result))
-
-(deffoo nnml-request-post (&optional server)
- (nnmail-do-request-post 'nnml-request-accept-article server))
-
-(deffoo nnml-request-replace-article (article group buffer)
- (nnml-possibly-change-directory group)
- (save-excursion
- (set-buffer buffer)
- (nnml-possibly-create-directory group)
- (let ((chars (nnmail-insert-lines))
- (art (concat (int-to-string article) "\t"))
- headers)
- (when (ignore-errors
- (nnmail-write-region
- (point-min) (point-max)
- (or (nnml-article-to-file article)
- (expand-file-name (int-to-string article)
- nnml-current-directory))
- nil (if (nnheader-be-verbose 5) nil 'nomesg))
- t)
- (setq headers (nnml-parse-head chars article))
- ;; Replace the NOV line in the NOV file.
- (save-excursion
- (set-buffer (nnml-open-nov group))
- (goto-char (point-min))
- (if (or (looking-at art)
- (search-forward (concat "\n" art) nil t))
- ;; Delete the old NOV line.
- (gnus-delete-line)
- ;; The line isn't here, so we have to find out where
- ;; we should insert it. (This situation should never
- ;; occur, but one likes to make sure...)
- (while (and (looking-at "[0-9]+\t")
- (< (string-to-number
- (buffer-substring
- (match-beginning 0) (match-end 0)))
- article)
- (zerop (forward-line 1)))))
- (beginning-of-line)
- (nnheader-insert-nov headers)
- (nnml-save-nov)
- t)))))
-
-(deffoo nnml-request-delete-group (group &optional force server)
- (nnml-possibly-change-directory group server)
- (when force
- ;; Delete all articles in GROUP.
- (let ((articles
- (directory-files
- nnml-current-directory t
- (concat nnheader-numerical-short-files
- "\\|" (regexp-quote nnml-nov-file-name) "$"
- "\\|" (regexp-quote nnml-marks-file-name) "$")))
- article)
- (while articles
- (setq article (pop articles))
- (when (file-writable-p article)
- (nnheader-message 5 "Deleting article %s in %s..." article group)
- (funcall nnmail-delete-file-function article))))
- ;; Try to delete the directory itself.
- (ignore-errors (delete-directory nnml-current-directory)))
- ;; Remove the group from all structures.
- (setq nnml-group-alist
- (delq (assoc group nnml-group-alist) nnml-group-alist)
- nnml-current-group nil
- nnml-current-directory nil)
- ;; Save the active file.
- (nnmail-save-active nnml-group-alist nnml-active-file)
- t)
-
-(deffoo nnml-request-rename-group (group new-name &optional server)
- (nnml-possibly-change-directory group server)
- (let ((new-dir (nnmail-group-pathname new-name nnml-directory))
- (old-dir (nnmail-group-pathname group nnml-directory)))
- (when (ignore-errors
- (make-directory new-dir t)
- t)
- ;; We move the articles file by file instead of renaming
- ;; the directory -- there may be subgroups in this group.
- ;; One might be more clever, I guess.
- (let ((files (nnheader-article-to-file-alist old-dir)))
- (while files
- (rename-file
- (concat old-dir (cdar files))
- (concat new-dir (cdar files)))
- (pop files)))
- ;; Move .overview file.
- (let ((overview (concat old-dir nnml-nov-file-name)))
- (when (file-exists-p overview)
- (rename-file overview (concat new-dir nnml-nov-file-name))))
- ;; Move .marks file.
- (let ((marks (concat old-dir nnml-marks-file-name)))
- (when (file-exists-p marks)
- (rename-file marks (concat new-dir nnml-marks-file-name))))
- (when (<= (length (directory-files old-dir)) 2)
- (ignore-errors (delete-directory old-dir)))
- ;; That went ok, so we change the internal structures.
- (let ((entry (assoc group nnml-group-alist)))
- (when entry
- (setcar entry new-name))
- (setq nnml-current-directory nil
- nnml-current-group nil)
- ;; Save the new group alist.
- (nnmail-save-active nnml-group-alist nnml-active-file)
- t))))
-
-(deffoo nnml-set-status (article name value &optional group server)
- (nnml-possibly-change-directory group server)
- (let ((file (nnml-article-to-file article)))
- (cond
- ((not (file-exists-p file))
- (nnheader-report 'nnml "File %s does not exist" file))
- (t
- (with-temp-file file
- (nnheader-insert-file-contents file)
- (nnmail-replace-status name value))
- t))))
-
-\f
-;;; Internal functions.
-
-(defun nnml-article-to-file (article)
- (nnml-update-file-alist)
- (let (file)
- (if (setq file
- (if nnml-use-compressed-files
- (cdr (assq article nnml-article-file-alist))
- (number-to-string article)))
- (expand-file-name file nnml-current-directory)
- (when (not nnheader-directory-files-is-safe)
- ;; Just to make sure nothing went wrong when reading over NFS --
- ;; check once more.
- (when (file-exists-p
- (setq file (expand-file-name (number-to-string article)
- nnml-current-directory)))
- (nnml-update-file-alist t)
- file)))))
-
-(defun nnml-deletable-article-p (group article)
- "Say whether ARTICLE in GROUP can be deleted."
- (let (path)
- (when (setq path (nnml-article-to-file article))
- (when (file-writable-p path)
- (or (not nnmail-keep-last-article)
- (not (eq (cdr (nth 1 (assoc group nnml-group-alist)))
- article)))))))
-
-;; Find an article number in the current group given the Message-ID.
-(defun nnml-find-group-number (id)
- (save-excursion
- (set-buffer (get-buffer-create " *nnml id*"))
- (let ((alist nnml-group-alist)
- number)
- ;; We want to look through all .overview files, but we want to
- ;; start with the one in the current directory. It seems most
- ;; likely that the article we are looking for is in that group.
- (if (setq number (nnml-find-id nnml-current-group id))
- (cons nnml-current-group number)
- ;; It wasn't there, so we look through the other groups as well.
- (while (and (not number)
- alist)
- (or (string= (caar alist) nnml-current-group)
- (setq number (nnml-find-id (caar alist) id)))
- (or number
- (setq alist (cdr alist))))
- (and number
- (cons (caar alist) number))))))
-
-(defun nnml-find-id (group id)
- (erase-buffer)
- (let ((nov (expand-file-name nnml-nov-file-name
- (nnmail-group-pathname group nnml-directory)))
- number found)
- (when (file-exists-p nov)
- (nnheader-insert-file-contents nov)
- (while (and (not found)
- (search-forward id nil t)) ; We find the ID.
- ;; And the id is in the fourth field.
- (if (not (and (search-backward "\t" nil t 4)
- (not (search-backward"\t" (gnus-point-at-bol) t))))
- (forward-line 1)
- (beginning-of-line)
- (setq found t)
- ;; We return the article number.
- (setq number
- (ignore-errors (read (current-buffer))))))
- number)))
-
-(defun nnml-retrieve-headers-with-nov (articles &optional fetch-old)
- (if (or gnus-nov-is-evil nnml-nov-is-evil)
- nil
- (let ((nov (expand-file-name nnml-nov-file-name nnml-current-directory)))
- (when (file-exists-p nov)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (nnheader-insert-file-contents nov)
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; Don't remove anything.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- t))))))
-
-(defun nnml-possibly-change-directory (group &optional server)
- (when (and server
- (not (nnml-server-opened server)))
- (nnml-open-server server))
- (if (not group)
- t
- (let ((pathname (nnmail-group-pathname group nnml-directory))
- (file-name-coding-system nnmail-pathname-coding-system))
- (when (not (equal pathname nnml-current-directory))
- (setq nnml-current-directory pathname
- nnml-current-group group
- nnml-article-file-alist nil))
- (file-exists-p nnml-current-directory))))
-
-(defun nnml-possibly-create-directory (group)
- (let ((dir (nnmail-group-pathname group nnml-directory)))
- (unless (file-exists-p dir)
- (make-directory (directory-file-name dir) t)
- (nnheader-message 5 "Creating mail directory %s" dir))))
-
-(defun nnml-save-mail (group-art)
- "Called narrowed to an article."
- (let (chars headers extension)
- (setq chars (nnmail-insert-lines))
- (setq extension
- (and nnml-use-compressed-files
- (> chars 1000)
- ".gz"))
- (nnmail-insert-xref group-art)
- (run-hooks 'nnmail-prepare-save-mail-hook)
- (run-hooks 'nnml-prepare-save-mail-hook)
- (goto-char (point-min))
- (while (looking-at "From ")
- (replace-match "X-From-Line: ")
- (forward-line 1))
- ;; We save the article in all the groups it belongs in.
- (let ((ga group-art)
- first)
- (while ga
- (nnml-possibly-create-directory (caar ga))
- (let ((file (concat (nnmail-group-pathname
- (caar ga) nnml-directory)
- (int-to-string (cdar ga))
- extension)))
- (if first
- ;; It was already saved, so we just make a hard link.
- (funcall nnmail-crosspost-link-function first file t)
- ;; Save the article.
- (nnmail-write-region (point-min) (point-max) file nil
- (if (nnheader-be-verbose 5) nil 'nomesg))
- (setq first file)))
- (setq ga (cdr ga))))
- ;; Generate a nov line for this article. We generate the nov
- ;; line after saving, because nov generation destroys the
- ;; header.
- (setq headers (nnml-parse-head chars))
- ;; Output the nov line to all nov databases that should have it.
- (let ((ga group-art))
- (while ga
- (nnml-add-nov (caar ga) (cdar ga) headers)
- (setq ga (cdr ga))))
- group-art))
-
-(defun nnml-active-number (group)
- "Compute the next article number in GROUP."
- (let ((active (cadr (assoc group nnml-group-alist))))
- ;; The group wasn't known to nnml, so we just create an active
- ;; entry for it.
- (unless active
- ;; Perhaps the active file was corrupt? See whether
- ;; there are any articles in this group.
- (nnml-possibly-create-directory group)
- (nnml-possibly-change-directory group)
- (unless nnml-article-file-alist
- (setq nnml-article-file-alist
- (sort
- (nnml-current-group-article-to-file-alist)
- 'car-less-than-car)))
- (setq active
- (if nnml-article-file-alist
- (cons (caar nnml-article-file-alist)
- (caar (last nnml-article-file-alist)))
- (cons 1 0)))
- (push (list group active) nnml-group-alist))
- (setcdr active (1+ (cdr active)))
- (while (file-exists-p
- (expand-file-name (int-to-string (cdr active))
- (nnmail-group-pathname group nnml-directory)))
- (setcdr active (1+ (cdr active))))
- (cdr active)))
-
-(defun nnml-add-nov (group article headers)
- "Add a nov line for the GROUP base."
- (save-excursion
- (set-buffer (nnml-open-nov group))
- (goto-char (point-max))
- (mail-header-set-number headers article)
- (nnheader-insert-nov headers)))
-
-(defsubst nnml-header-value ()
- (buffer-substring (match-end 0) (gnus-point-at-eol)))
-
-(defun nnml-parse-head (chars &optional number)
- "Parse the head of the current buffer."
- (save-excursion
- (save-restriction
- (unless (zerop (buffer-size))
- (narrow-to-region
- (goto-char (point-min))
- (if (re-search-forward "\n\r?\n" nil t)
- (1- (point))
- (point-max))))
- (let ((headers (nnheader-parse-naked-head)))
- (mail-header-set-chars headers chars)
- (mail-header-set-number headers number)
- headers))))
-
-(defun nnml-get-nov-buffer (group)
- (let ((buffer (get-buffer-create (format " *nnml overview %s*" group))))
- (save-excursion
- (set-buffer buffer)
- (set (make-local-variable 'nnml-nov-buffer-file-name)
- (expand-file-name
- nnml-nov-file-name
- (nnmail-group-pathname group nnml-directory)))
- (erase-buffer)
- (when (file-exists-p nnml-nov-buffer-file-name)
- (nnheader-insert-file-contents nnml-nov-buffer-file-name)))
- buffer))
-
-(defun nnml-open-nov (group)
- (or (cdr (assoc group nnml-nov-buffer-alist))
- (let ((buffer (nnml-get-nov-buffer group)))
- (push (cons group buffer) nnml-nov-buffer-alist)
- buffer)))
-
-(defun nnml-save-nov ()
- (save-excursion
- (while nnml-nov-buffer-alist
- (when (buffer-name (cdar nnml-nov-buffer-alist))
- (set-buffer (cdar nnml-nov-buffer-alist))
- (when (buffer-modified-p)
- (nnmail-write-region (point-min) (point-max)
- nnml-nov-buffer-file-name nil 'nomesg))
- (set-buffer-modified-p nil)
- (kill-buffer (current-buffer)))
- (setq nnml-nov-buffer-alist (cdr nnml-nov-buffer-alist)))))
-
-;;;###autoload
-(defun nnml-generate-nov-databases (&optional server)
- "Generate NOV databases in all nnml directories."
- (interactive (list (or (nnoo-current-server 'nnml) "")))
- ;; Read the active file to make sure we don't re-use articles
- ;; numbers in empty groups.
- (nnmail-activate 'nnml)
- (unless (nnml-server-opened server)
- (nnml-open-server server))
- (setq nnml-directory (expand-file-name nnml-directory))
- ;; Recurse down the directories.
- (nnml-generate-nov-databases-1 nnml-directory nil t)
- ;; Save the active file.
- (nnmail-save-active nnml-group-alist nnml-active-file))
-
-(defun nnml-generate-nov-databases-1 (dir &optional seen no-active)
- "Regenerate the NOV database in DIR."
- (interactive "DRegenerate NOV in: ")
- (setq dir (file-name-as-directory dir))
- ;; Only scan this sub-tree if we haven't been here yet.
- (unless (member (file-truename dir) seen)
- (push (file-truename dir) seen)
- ;; We descend recursively
- (let ((dirs (directory-files dir t nil t))
- dir)
- (while (setq dir (pop dirs))
- (when (and (not (string-match "^\\." (file-name-nondirectory dir)))
- (file-directory-p dir))
- (nnml-generate-nov-databases-1 dir seen))))
- ;; Do this directory.
- (let ((files (sort (nnheader-article-to-file-alist dir)
- 'car-less-than-car)))
- (if (not files)
- (let* ((group (nnheader-file-to-group
- (directory-file-name dir) nnml-directory))
- (info (cadr (assoc group nnml-group-alist))))
- (when info
- (setcar info (1+ (cdr info)))))
- (funcall nnml-generate-active-function dir)
- ;; Generate the nov file.
- (nnml-generate-nov-file dir files)
- (unless no-active
- (nnmail-save-active nnml-group-alist nnml-active-file))))))
-
-(eval-when-compile (defvar files))
-(defun nnml-generate-active-info (dir)
- ;; Update the active info for this group.
- (let* ((group (nnheader-file-to-group
- (directory-file-name dir) nnml-directory))
- (entry (assoc group nnml-group-alist))
- (last (or (caadr entry) 0)))
- (setq nnml-group-alist (delq entry nnml-group-alist))
- (push (list group
- (cons (or (caar files) (1+ last))
- (max last
- (or (let ((f files))
- (while (cdr f) (setq f (cdr f)))
- (caar f))
- 0))))
- nnml-group-alist)))
-
-(defun nnml-generate-nov-file (dir files)
- (let* ((dir (file-name-as-directory dir))
- (nov (concat dir nnml-nov-file-name))
- (nov-buffer (get-buffer-create " *nov*"))
- chars file headers)
- (save-excursion
- ;; Init the nov buffer.
- (set-buffer nov-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (set-buffer nntp-server-buffer)
- ;; Delete the old NOV file.
- (when (file-exists-p nov)
- (funcall nnmail-delete-file-function nov))
- (while files
- (unless (file-directory-p (setq file (concat dir (cdar files))))
- (erase-buffer)
- (nnheader-insert-file-contents file)
- (narrow-to-region
- (goto-char (point-min))
- (progn
- (re-search-forward "\n\r?\n" nil t)
- (setq chars (- (point-max) (point)))
- (max (point-min) (1- (point)))))
- (unless (zerop (buffer-size))
- (goto-char (point-min))
- (setq headers (nnml-parse-head chars (caar files)))
- (save-excursion
- (set-buffer nov-buffer)
- (goto-char (point-max))
- (nnheader-insert-nov headers)))
- (widen))
- (setq files (cdr files)))
- (save-excursion
- (set-buffer nov-buffer)
- (nnmail-write-region (point-min) (point-max) nov nil 'nomesg)
- (kill-buffer (current-buffer))))))
-
-(defun nnml-nov-delete-article (group article)
- (save-excursion
- (set-buffer (nnml-open-nov group))
- (when (nnheader-find-nov-line article)
- (delete-region (point) (progn (forward-line 1) (point)))
- (when (bobp)
- (let ((active (cadr (assoc group nnml-group-alist)))
- num)
- (when active
- (if (eobp)
- (setf (car active) (1+ (cdr active)))
- (when (and (setq num (ignore-errors (read (current-buffer))))
- (numberp num))
- (setf (car active) num)))))))
- t))
-
-(defun nnml-update-file-alist (&optional force)
- (when nnml-use-compressed-files
- (when (or (not nnml-article-file-alist)
- force)
- (setq nnml-article-file-alist
- (nnml-current-group-article-to-file-alist)))))
-
-(defun nnml-directory-articles (dir)
- "Return a list of all article files in a directory.
-Use the nov database for that directory if available."
- (if (or gnus-nov-is-evil nnml-nov-is-evil
- (not (file-exists-p
- (expand-file-name nnml-nov-file-name dir))))
- (nnheader-directory-articles dir)
- ;; build list from .overview if available
- ;; We would use nnml-open-nov, except that nnml-nov-buffer-alist is
- ;; defvoo'd, and we might get called when it hasn't been swapped in.
- (save-excursion
- (let ((list nil)
- art
- (buffer (nnml-get-nov-buffer nnml-current-group)))
- (set-buffer buffer)
- (goto-char (point-min))
- (while (not (eobp))
- (setq art (read (current-buffer)))
- (push art list)
- (forward-line 1))
- list))))
-
-(defun nnml-current-group-article-to-file-alist ()
- "Return an alist of article/file pairs in the current group.
-Use the nov database for the current group if available."
- (if (or nnml-use-compressed-files
- gnus-nov-is-evil
- nnml-nov-is-evil
- (not (file-exists-p
- (expand-file-name nnml-nov-file-name
- nnml-current-directory))))
- (nnheader-article-to-file-alist nnml-current-directory)
- ;; build list from .overview if available
- (save-excursion
- (let ((alist nil)
- (buffer (nnml-get-nov-buffer nnml-current-group))
- art)
- (set-buffer buffer)
- (goto-char (point-min))
- (while (not (eobp))
- (setq art (read (current-buffer)))
- ;; assume file name is unadorned (ie. not compressed etc)
- (push (cons art (int-to-string art)) alist)
- (forward-line 1))
- alist))))
-
-(deffoo nnml-request-set-mark (group actions &optional server)
- (nnml-possibly-change-directory group server)
- (unless nnml-marks-is-evil
- (nnml-open-marks group server)
- (dolist (action actions)
- (let ((range (nth 0 action))
- (what (nth 1 action))
- (marks (nth 2 action)))
- (assert (or (eq what 'add) (eq what 'del)) nil
- "Unknown request-set-mark action: %s" what)
- (dolist (mark marks)
- (setq nnml-marks (gnus-update-alist-soft
- mark
- (funcall (if (eq what 'add) 'gnus-range-add
- 'gnus-remove-from-range)
- (cdr (assoc mark nnml-marks)) range)
- nnml-marks)))))
- (nnml-save-marks group server))
- nil)
-
-(deffoo nnml-request-update-info (group info &optional server)
- (nnml-possibly-change-directory group server)
- (when (and (not nnml-marks-is-evil) (nnml-marks-changed-p group))
- (nnheader-message 8 "Updating marks for %s..." group)
- (nnml-open-marks group server)
- ;; Update info using `nnml-marks'.
- (mapcar (lambda (pred)
- (unless (memq (cdr pred) gnus-article-unpropagated-mark-lists)
- (gnus-info-set-marks
- info
- (gnus-update-alist-soft
- (cdr pred)
- (cdr (assq (cdr pred) nnml-marks))
- (gnus-info-marks info))
- t)))
- gnus-article-mark-lists)
- (let ((seen (cdr (assq 'read nnml-marks))))
- (gnus-info-set-read info
- (if (and (integerp (car seen))
- (null (cdr seen)))
- (list (cons (car seen) (car seen)))
- seen)))
- (nnheader-message 8 "Updating marks for %s...done" group))
- info)
-
-(defun nnml-marks-changed-p (group)
- (let ((file (expand-file-name nnml-marks-file-name
- (nnmail-group-pathname group nnml-directory))))
- (if (null (gnus-gethash file nnml-marks-modtime))
- t ;; never looked at marks file, assume it has changed
- (not (equal (gnus-gethash file nnml-marks-modtime)
- (nth 5 (file-attributes file)))))))
-
-(defun nnml-save-marks (group server)
- (let ((file-name-coding-system nnmail-pathname-coding-system)
- (file (expand-file-name nnml-marks-file-name
- (nnmail-group-pathname group nnml-directory))))
- (condition-case err
- (progn
- (nnml-possibly-create-directory group)
- (with-temp-file file
- (erase-buffer)
- (gnus-prin1 nnml-marks)
- (insert "\n"))
- (gnus-sethash file
- (nth 5 (file-attributes file))
- nnml-marks-modtime))
- (error (or (gnus-yes-or-no-p
- (format "Could not write to %s (%s). Continue? " file err))
- (error "Cannot write to %s (%s)" file err))))))
-
-(defun nnml-open-marks (group server)
- (let ((file (expand-file-name
- nnml-marks-file-name
- (nnmail-group-pathname group nnml-directory))))
- (if (file-exists-p file)
- (condition-case err
- (with-temp-buffer
- (gnus-sethash file (nth 5 (file-attributes file))
- nnml-marks-modtime)
- (nnheader-insert-file-contents file)
- (setq nnml-marks (read (current-buffer)))
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks))))
- (error (or (gnus-yes-or-no-p
- (format "Error reading nnml marks file %s (%s). Continuing will use marks from .newsrc.eld. Continue? " file err))
- (error "Cannot read nnml marks file %s (%s)" file err))))
- ;; User didn't have a .marks file. Probably first time
- ;; user of the .marks stuff. Bootstrap it from .newsrc.eld.
- (let ((info (gnus-get-info
- (gnus-group-prefixed-name
- group
- (gnus-server-to-method (format "nnml:%s" server))))))
- (nnheader-message 7 "Bootstrapping marks for %s..." group)
- (setq nnml-marks (gnus-info-marks info))
- (push (cons 'read (gnus-info-read info)) nnml-marks)
- (dolist (el gnus-article-unpropagated-mark-lists)
- (setq nnml-marks (gnus-remassoc el nnml-marks)))
- (nnml-save-marks group server)
- (nnheader-message 7 "Bootstrapping marks for %s...done" group)))))
-
-(provide 'nnml)
-
-;;; arch-tag: 52c97dc3-9735-45de-b439-9e4d23b52004
-;;; nnml.el ends here
+++ /dev/null
-;;; nnnil.el --- empty backend for Gnus
-;; Public domain.
-
-;; Author: Paul Jarc <prj@po.cwru.edu>
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; nnnil is a Gnus backend that provides no groups or articles. It's useful
-;; as a primary select method when you want all your real select methods to
-;; be secondary or foreign.
-
-;;; Code:
-
-(eval-and-compile
- (require 'nnheader))
-
-(defvar nnnil-status-string "")
-
-(defun nnnil-retrieve-headers (articles &optional group server fetch-old)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- 'nov)
-
-(defun nnnil-open-server (server &optional definitions)
- t)
-
-(defun nnnil-close-server (&optional server)
- t)
-
-(defun nnnil-request-close ()
- t)
-
-(defun nnnil-server-opened (&optional server)
- t)
-
-(defun nnnil-status-message (&optional server)
- nnnil-status-string)
-
-(defun nnnil-request-article (article &optional group server to-buffer)
- (setq nnnil-status-string "No such group")
- nil)
-
-(defun nnnil-request-group (group &optional server fast)
- (let (deactivate-mark)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert "411 no such news group\n")))
- (setq nnnil-status-string "No such group")
- nil)
-
-(defun nnnil-close-group (group &optional server)
- t)
-
-(defun nnnil-request-list (&optional server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- t)
-
-(defun nnnil-request-post (&optional server)
- (setq nnnil-status-string "Read-only server")
- nil)
-
-(provide 'nnnil)
-
-;;; arch-tag: a982a1a3-bc5e-4fb1-a233-d7657a3e3257
+++ /dev/null
-;;; nnoo.el --- OO Gnus Backends
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(eval-when-compile (require 'cl))
-
-(defvar nnoo-definition-alist nil)
-(defvar nnoo-state-alist nil)
-(defvar nnoo-parent-backend nil)
-
-(defmacro defvoo (var init &optional doc &rest map)
- "The same as `defvar', only takes list of variables to MAP to."
- `(prog1
- ,(if doc
- `(defvar ,var ,init ,(concat doc "\n\nThis is a Gnus server variable. See Info node `(gnus)Select Methods'."))
- `(defvar ,var ,init))
- (nnoo-define ',var ',map)))
-(put 'defvoo 'lisp-indent-function 2)
-(put 'defvoo 'edebug-form-spec '(var init &optional doc &rest map))
-
-(defmacro deffoo (func args &rest forms)
- "The same as `defun', only register FUNC."
- `(prog1
- (defun ,func ,args ,@forms)
- (nnoo-register-function ',func)))
-(put 'deffoo 'lisp-indent-function 2)
-(put 'deffoo 'edebug-form-spec '(&define name lambda-list def-body))
-
-(defun nnoo-register-function (func)
- (let ((funcs (nthcdr 3 (assoc (nnoo-backend func)
- nnoo-definition-alist))))
- (unless funcs
- (error "%s belongs to a backend that hasn't been declared" func))
- (setcar funcs (cons func (car funcs)))))
-
-(defmacro nnoo-declare (backend &rest parents)
- `(eval-and-compile
- (if (assq ',backend nnoo-definition-alist)
- (setcar (cdr (assq ',backend nnoo-definition-alist))
- (mapcar 'list ',parents))
- (push (list ',backend
- (mapcar 'list ',parents)
- nil nil)
- nnoo-definition-alist))
- (unless (assq ',backend nnoo-state-alist)
- (push (list ',backend "*internal-non-initialized-backend*")
- nnoo-state-alist))))
-(put 'nnoo-declare 'lisp-indent-function 1)
-
-(defun nnoo-parents (backend)
- (nth 1 (assoc backend nnoo-definition-alist)))
-
-(defun nnoo-variables (backend)
- (nth 2 (assoc backend nnoo-definition-alist)))
-
-(defun nnoo-functions (backend)
- (nth 3 (assoc backend nnoo-definition-alist)))
-
-(defmacro nnoo-import (backend &rest imports)
- `(nnoo-import-1 ',backend ',imports))
-(put 'nnoo-import 'lisp-indent-function 1)
-
-(defun nnoo-import-1 (backend imports)
- (let ((call-function
- (if (symbolp (car imports)) (pop imports) 'nnoo-parent-function))
- imp functions function)
- (while (setq imp (pop imports))
- (setq functions
- (or (cdr imp)
- (nnoo-functions (car imp))))
- (while functions
- (unless (fboundp
- (setq function
- (nnoo-symbol backend
- (nnoo-rest-symbol (car functions)))))
- (eval `(deffoo ,function (&rest args)
- (,call-function ',backend ',(car functions) args))))
- (pop functions)))))
-
-(defun nnoo-parent-function (backend function args)
- (let ((pbackend (nnoo-backend function))
- (nnoo-parent-backend backend))
- (nnoo-change-server pbackend
- (nnoo-current-server backend)
- (cdr (assq pbackend (nnoo-parents backend))))
- (prog1
- (apply function args)
- ;; Copy the changed variables back into the child.
- (let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
- (while vars
- (set (cadar vars) (symbol-value (caar vars)))
- (setq vars (cdr vars)))))))
-
-(defun nnoo-execute (backend function &rest args)
- "Execute FUNCTION on behalf of BACKEND."
- (let ((pbackend (nnoo-backend function))
- (nnoo-parent-backend backend))
- (nnoo-change-server pbackend
- (nnoo-current-server backend)
- (cdr (assq pbackend (nnoo-parents backend))))
- (prog1
- (apply function args)
- ;; Copy the changed variables back into the child.
- (let ((vars (cdr (assq pbackend (nnoo-parents backend)))))
- (while vars
- (set (cadar vars) (symbol-value (caar vars)))
- (setq vars (cdr vars)))))))
-
-(defmacro nnoo-map-functions (backend &rest maps)
- `(nnoo-map-functions-1 ',backend ',maps))
-(put 'nnoo-map-functions 'lisp-indent-function 1)
-
-(defun nnoo-map-functions-1 (backend maps)
- (let (m margs i)
- (while (setq m (pop maps))
- (setq i 0
- margs nil)
- (while (< i (length (cdr m)))
- (if (numberp (nth i (cdr m)))
- (push `(nth ,i args) margs)
- (push (nth i (cdr m)) margs))
- (incf i))
- (eval `(deffoo ,(nnoo-symbol backend (nnoo-rest-symbol (car m)))
- (&rest args)
- (nnoo-parent-function ',backend ',(car m)
- ,(cons 'list (nreverse margs))))))))
-
-(defun nnoo-backend (symbol)
- (string-match "^[^-]+-" (symbol-name symbol))
- (intern (substring (symbol-name symbol) 0 (1- (match-end 0)))))
-
-(defun nnoo-rest-symbol (symbol)
- (string-match "^[^-]+-" (symbol-name symbol))
- (intern (substring (symbol-name symbol) (match-end 0))))
-
-(defun nnoo-symbol (backend symbol)
- (intern (format "%s-%s" backend symbol)))
-
-(defun nnoo-define (var map)
- (let* ((backend (nnoo-backend var))
- (def (assq backend nnoo-definition-alist))
- (parents (nth 1 def)))
- (unless def
- (error "%s belongs to a backend that hasn't been declared" var))
- (setcar (nthcdr 2 def)
- (delq (assq var (nth 2 def)) (nth 2 def)))
- (setcar (nthcdr 2 def)
- (cons (cons var (symbol-value var))
- (nth 2 def)))
- (while map
- (nconc (assq (nnoo-backend (car map)) parents)
- (list (list (pop map) var))))))
-
-(defun nnoo-change-server (backend server defs)
- (let* ((bstate (cdr (assq backend nnoo-state-alist)))
- (current (car bstate))
- (parents (nnoo-parents backend))
- (server (if nnoo-parent-backend
- (format "%s+%s" nnoo-parent-backend server)
- server))
- (bvariables (nnoo-variables backend))
- state def)
- ;; If we don't have a current state, we push an empty state
- ;; onto the alist.
- (unless bstate
- (push (setq bstate (list backend nil))
- nnoo-state-alist)
- (pop bstate))
- (if (equal server current)
- t
- (nnoo-push-server backend current)
- (setq state (or (cdr (assoc server (cddr bstate)))
- (nnoo-variables backend)))
- (while state
- (set (caar state) (cdar state))
- (pop state))
- (setcar bstate server)
- (unless (cdr (assoc server (cddr bstate)))
- (while (setq def (pop defs))
- (unless (assq (car def) bvariables)
- (nconc bvariables
- (list (cons (car def) (and (boundp (car def))
- (symbol-value (car def)))))))
- (if (equal server "*internal-non-initialized-backend*")
- (set (car def) (symbol-value (cadr def)))
- (set (car def) (cadr def)))))
- (while parents
- (nnoo-change-server
- (caar parents) (format "%s+%s" backend server)
- (mapcar (lambda (def) (list (car def) (symbol-value (cadr def))))
- (cdar parents)))
- (pop parents))))
- t)
-
-(defun nnoo-push-server (backend current)
- (let ((bstate (assq backend nnoo-state-alist))
- (defs (nnoo-variables backend)))
- ;; Remove the old definition.
- (setcdr (cdr bstate) (delq (assoc current (cddr bstate)) (cddr bstate)))
- ;; If this is the first time we push the server (i. e., this is
- ;; the nil server), then we update the default values of
- ;; all the variables to reflect the current values.
- (when (equal current "*internal-non-initialized-backend*")
- (let ((defaults (nnoo-variables backend))
- def)
- (while (setq def (pop defaults))
- (setcdr def (symbol-value (car def))))))
- (let (state)
- (while defs
- (push (cons (caar defs) (symbol-value (caar defs)))
- state)
- (pop defs))
- (nconc bstate (list (cons current state))))))
-
-(defsubst nnoo-current-server-p (backend server)
- (equal (nnoo-current-server backend)
- (if nnoo-parent-backend
- (format "%s+%s" nnoo-parent-backend server)
- server)))
-
-(defun nnoo-current-server (backend)
- (nth 1 (assq backend nnoo-state-alist)))
-
-(defun nnoo-close-server (backend &optional server)
- (unless server
- (setq server (nnoo-current-server backend)))
- (when server
- (let* ((bstate (cdr (assq backend nnoo-state-alist)))
- (defs (assoc server (cdr bstate))))
- (when bstate
- (setcar bstate nil)
- (setcdr bstate (delq defs (cdr bstate)))
- (pop defs)
- (while defs
- (set (car (pop defs)) nil)))))
- t)
-
-(defun nnoo-close (backend)
- (setq nnoo-state-alist
- (delq (assq backend nnoo-state-alist)
- nnoo-state-alist))
- t)
-
-(defun nnoo-status-message (backend server)
- (nnheader-get-report backend))
-
-(defun nnoo-server-opened (backend server)
- (and (nnoo-current-server-p backend server)
- nntp-server-buffer
- (buffer-name nntp-server-buffer)))
-
-(defmacro nnoo-define-basics (backend)
- "Define `close-server', `server-opened' and `status-message'."
- `(eval-and-compile
- (nnoo-define-basics-1 ',backend)))
-
-(defun nnoo-define-basics-1 (backend)
- (let ((functions '(close-server server-opened status-message)))
- (while functions
- (eval `(deffoo ,(nnoo-symbol backend (car functions))
- (&optional server)
- (,(nnoo-symbol 'nnoo (pop functions)) ',backend server)))))
- (eval `(deffoo ,(nnoo-symbol backend 'open-server)
- (server &optional defs)
- (nnoo-change-server ',backend server defs))))
-
-(defmacro nnoo-define-skeleton (backend)
- "Define all required backend functions for BACKEND.
-All functions will return nil and report an error."
- `(eval-and-compile
- (nnoo-define-skeleton-1 ',backend)))
-
-(defun nnoo-define-skeleton-1 (backend)
- (let ((functions '(retrieve-headers
- request-close request-article
- request-group close-group
- request-list request-post request-list-newsgroups))
- function fun)
- (while (setq function (pop functions))
- (when (not (fboundp (setq fun (nnoo-symbol backend function))))
- (eval `(deffoo ,fun
- (&rest args)
- (nnheader-report ',backend ,(format "%s-%s not implemented"
- backend function))))))))
-
-(defun nnoo-set (server &rest args)
- (let ((parents (nnoo-parents (car server)))
- (nnoo-parent-backend (car server)))
- (while parents
- (nnoo-change-server (caar parents)
- (cadr server)
- (cdar parents))
- (pop parents)))
- (nnoo-change-server (car server)
- (cadr server) (cddr server))
- (while args
- (set (pop args) (pop args))))
-
-(provide 'nnoo)
-
-;;; arch-tag: 0196b5ed-6f34-4778-a455-73a971f837e7
-;;; nnoo.el ends here
+++ /dev/null
-;;; nnrss.el --- interfacing with RSS
-
-;; Copyright (C) 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: RSS
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus)
-(require 'nnoo)
-(require 'nnmail)
-(require 'message)
-(require 'mm-util)
-(require 'gnus-util)
-(require 'time-date)
-(require 'rfc2231)
-(require 'mm-url)
-(require 'rfc2047)
-(require 'mml)
-(eval-when-compile
- (ignore-errors
- (require 'xml)))
-(eval '(require 'xml))
-
-(nnoo-declare nnrss)
-
-(defvoo nnrss-directory (nnheader-concat gnus-directory "rss/")
- "Where nnrss will save its files.")
-
-;; (group max rss-url)
-(defvoo nnrss-server-data nil)
-
-;; (num timestamp url subject author date extra)
-(defvoo nnrss-group-data nil)
-(defvoo nnrss-group-max 0)
-(defvoo nnrss-group-min 1)
-(defvoo nnrss-group nil)
-(defvoo nnrss-group-hashtb nil)
-(defvoo nnrss-status-string "")
-
-(defconst nnrss-version "nnrss 1.0")
-
-(defvar nnrss-group-alist '()
- "List of RSS addresses.")
-
-(defvar nnrss-use-local nil)
-
-(defvar nnrss-description-field 'X-Gnus-Description
- "Field name used for DESCRIPTION.
-To use the description in headers, put this name into `nnmail-extra-headers'.")
-
-(defvar nnrss-url-field 'X-Gnus-Url
- "Field name used for URL.
-To use the description in headers, put this name into `nnmail-extra-headers'.")
-
-(defvar nnrss-content-function nil
- "A function which is called in `nnrss-request-article'.
-The arguments are (ENTRY GROUP ARTICLE).
-ENTRY is the record of the current headline. GROUP is the group name.
-ARTICLE is the article number of the current headline.")
-
-(defvar nnrss-file-coding-system mm-universal-coding-system
- "Coding system used when reading and writing files.")
-
-(defvar nnrss-compatible-encoding-alist
- (delq nil (mapcar (lambda (elem)
- (if (and (mm-coding-system-p (car elem))
- (mm-coding-system-p (cdr elem)))
- elem))
- mm-charset-override-alist))
- "Alist of encodings and those supersets.
-The cdr of each element is used to decode data if it is available when
-the car is what the data specify as the encoding. Or, the car is used
-for decoding when the cdr that the data specify is not available.")
-
-(defvar nnrss-wash-html-in-text-plain-parts nil
- "*Non-nil means render text in text/plain parts as HTML.
-The function specified by the `mm-text-html-renderer' variable will be
-used to render text. If it is nil, text will simply be folded.")
-
-(nnoo-define-basics nnrss)
-
-;;; Interface functions
-
-(defsubst nnrss-format-string (string)
- (gnus-replace-in-string string " *\n *" " "))
-
-(defun nnrss-decode-group-name (group)
- (if (and group (mm-coding-system-p 'utf-8))
- (setq group (mm-decode-coding-string group 'utf-8))
- group))
-
-(deffoo nnrss-retrieve-headers (articles &optional group server fetch-old)
- (setq group (nnrss-decode-group-name group))
- (nnrss-possibly-change-group group server)
- (let (e)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (article articles)
- (if (setq e (assq article nnrss-group-data))
- (insert (number-to-string (car e)) "\t" ;; number
- ;; subject
- (or (nth 3 e) "")
- "\t"
- ;; from
- (or (nth 4 e) "(nobody)")
- "\t"
- ;; date
- (or (nth 5 e) "")
- "\t"
- ;; id
- (format "<%d@%s.nnrss>" (car e) group)
- "\t"
- ;; refs
- "\t"
- ;; chars
- "-1" "\t"
- ;; lines
- "-1" "\t"
- ;; Xref
- "" "\t"
- (if (and (nth 6 e)
- (memq nnrss-description-field
- nnmail-extra-headers))
- (concat (symbol-name nnrss-description-field)
- ": "
- (nnrss-format-string (nth 6 e))
- "\t")
- "")
- (if (and (nth 2 e)
- (memq nnrss-url-field
- nnmail-extra-headers))
- (concat (symbol-name nnrss-url-field)
- ": "
- (nnrss-format-string (nth 2 e))
- "\t")
- "")
- "\n")))))
- 'nov)
-
-(deffoo nnrss-request-group (group &optional server dont-check)
- (setq group (nnrss-decode-group-name group))
- (nnheader-message 6 "nnrss: Requesting %s..." group)
- (nnrss-possibly-change-group group server)
- (prog1
- (if dont-check
- t
- (nnrss-check-group group server)
- (nnheader-report 'nnrss "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" nnrss-group-max nnrss-group-min nnrss-group-max
- (prin1-to-string group)
- t))
- (nnheader-message 6 "nnrss: Requesting %s...done" group)))
-
-(deffoo nnrss-close-group (group &optional server)
- t)
-
-(eval-when-compile
- (defvar mm-text-html-renderer)
- (defvar mm-text-html-washer-alist))
-
-(deffoo nnrss-request-article (article &optional group server buffer)
- (setq group (nnrss-decode-group-name group))
- (when (stringp article)
- (setq article (if (string-match "\\`<\\([0-9]+\\)@" article)
- (string-to-number (match-string 1 article))
- 0)))
- (nnrss-possibly-change-group group server)
- (let ((e (assq article nnrss-group-data))
- (nntp-server-buffer (or buffer nntp-server-buffer))
- post err)
- (when e
- (with-current-buffer nntp-server-buffer
- (erase-buffer)
- (if group
- (insert "Newsgroups: " group "\n"))
- (if (nth 3 e)
- (insert "Subject: " (nth 3 e) "\n"))
- (if (nth 4 e)
- (insert "From: " (nth 4 e) "\n"))
- (if (nth 5 e)
- (insert "Date: " (nnrss-format-string (nth 5 e)) "\n"))
- (let ((header (buffer-string))
- (text (nth 6 e))
- (link (nth 2 e))
- (enclosure (nth 7 e))
- (comments (nth 8 e))
- ;; Enable encoding of Newsgroups header in XEmacs.
- (default-enable-multibyte-characters t)
- (rfc2047-header-encoding-alist
- (if (mm-coding-system-p 'utf-8)
- (cons '("Newsgroups" . utf-8)
- rfc2047-header-encoding-alist)
- rfc2047-header-encoding-alist))
- rfc2047-encode-encoded-words body fn)
- (when (or text link enclosure comments)
- (insert "\n")
- (insert "<#multipart type=alternative>\n"
- "<#part type=\"text/plain\">\n")
- (setq body (point))
- (when text
- (insert text)
- (goto-char body)
- (if (and nnrss-wash-html-in-text-plain-parts
- (progn
- (require 'mm-view)
- (setq fn (or (cdr (assq mm-text-html-renderer
- mm-text-html-washer-alist))
- mm-text-html-renderer))))
- (progn
- (narrow-to-region body (point-max))
- (if (functionp fn)
- (funcall fn)
- (apply (car fn) (cdr fn)))
- (widen)
- (goto-char body)
- (re-search-forward "[^\t\n ]" nil t)
- (beginning-of-line)
- (delete-region body (point))
- (goto-char (point-max))
- (skip-chars-backward "\t\n ")
- (end-of-line)
- (delete-region (point) (point-max))
- (insert "\n"))
- (while (re-search-forward "\n+" nil t)
- (replace-match " "))
- (goto-char body)
- ;; See `nnrss-check-group', which inserts "<br /><br />".
- (when (search-forward "<br /><br />" nil t)
- (if (eobp)
- (replace-match "\n")
- (replace-match "\n\n")))
- (unless (eobp)
- (let ((fill-column default-fill-column)
- (window (get-buffer-window nntp-server-buffer)))
- (when window
- (setq fill-column
- (max 1 (/ (* (window-width window) 7) 8))))
- (fill-region (point) (point-max))
- (goto-char (point-max))
- ;; XEmacs version of `fill-region' inserts newline.
- (unless (bolp)
- (insert "\n")))))
- (when (or link enclosure)
- (insert "\n")))
- (when link
- (insert link "\n"))
- (when enclosure
- (insert (car enclosure) " "
- (nth 2 enclosure) " "
- (nth 3 enclosure) "\n"))
- (when comments
- (insert comments "\n"))
- (setq body (buffer-substring body (point)))
- (insert "<#/part>\n"
- "<#part type=\"text/html\">\n"
- "<html><head></head><body>\n")
- (when text
- (insert text "\n"))
- (when link
- (insert "<p><a href=\"" link "\">link</a></p>\n"))
- (when enclosure
- (insert "<p><a href=\"" (car enclosure) "\">"
- (cadr enclosure) "</a> " (nth 2 enclosure)
- " " (nth 3 enclosure) "</p>\n"))
- (when comments
- (insert "<p><a href=\"" comments "\">comments</a></p>\n"))
- (insert "</body></html>\n"
- "<#/part>\n"
- "<#/multipart>\n"))
- (condition-case nil
- (mml-to-mime)
- (error
- (erase-buffer)
- (insert header
- "Content-Type: text/plain; charset=gnus-decoded\n"
- "Content-Transfer-Encoding: 8bit\n\n"
- body)
- (nnheader-message
- 3 "Warning - there might be invalid characters"))))
- (goto-char (point-min))
- (search-forward "\n\n")
- (forward-line -1)
- (insert (format "Message-ID: <%d@%s.nnrss>\n"
- (car e)
- (let ((rfc2047-encoding-type 'mime)
- rfc2047-encode-max-chars)
- (rfc2047-encode-string
- (gnus-replace-in-string group "[\t\n ]+" "_")))))
- (when nnrss-content-function
- (funcall nnrss-content-function e group article))))
- (cond
- (err
- (nnheader-report 'nnrss err))
- ((not e)
- (nnheader-report 'nnrss "no such id: %d" article))
- (t
- (nnheader-report 'nnrss "article %s retrieved" (car e))
- ;; we return the article number.
- (cons nnrss-group (car e))))))
-
-(deffoo nnrss-request-list (&optional server)
- (nnrss-possibly-change-group nil server)
- (nnrss-generate-active)
- t)
-
-(deffoo nnrss-open-server (server &optional defs connectionless)
- (nnrss-read-server-data server)
- (nnoo-change-server 'nnrss server defs)
- t)
-
-(deffoo nnrss-request-expire-articles
- (articles group &optional server force)
- (setq group (nnrss-decode-group-name group))
- (nnrss-possibly-change-group group server)
- (let (e days not-expirable changed)
- (dolist (art articles)
- (if (and (setq e (assq art nnrss-group-data))
- (nnmail-expired-article-p
- group
- (if (listp (setq days (nth 1 e))) days
- (days-to-time (- days (time-to-days '(0 0)))))
- force))
- (setq nnrss-group-data (delq e nnrss-group-data)
- changed t)
- (push art not-expirable)))
- (if changed
- (nnrss-save-group-data group server))
- not-expirable))
-
-(deffoo nnrss-request-delete-group (group &optional force server)
- (setq group (nnrss-decode-group-name group))
- (nnrss-possibly-change-group group server)
- (let (elem)
- ;; There may be two or more entries in `nnrss-group-alist' since
- ;; this function didn't delete them formerly.
- (while (setq elem (assoc group nnrss-group-alist))
- (setq nnrss-group-alist (delq elem nnrss-group-alist))))
- (setq nnrss-server-data
- (delq (assoc group nnrss-server-data) nnrss-server-data))
- (nnrss-save-server-data server)
- (ignore-errors
- (delete-file (nnrss-make-filename group server)))
- t)
-
-(deffoo nnrss-request-list-newsgroups (&optional server)
- (nnrss-possibly-change-group nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnrss-group-alist)
- (if (third elem)
- (insert (car elem) "\t" (third elem) "\n"))))
- t)
-
-(nnoo-define-skeleton nnrss)
-
-;;; Internal functions
-(eval-when-compile (defun xml-rpc-method-call (&rest args)))
-
-(defun nnrss-get-encoding ()
- "Return an encoding attribute specified in the current xml contents.
-If `nnrss-compatible-encoding-alist' specifies the compatible encoding,
-it is used instead. If the xml contents doesn't specify the encoding,
-return `utf-8' which is the default encoding for xml if it is available,
-otherwise return nil."
- (goto-char (point-min))
- (if (re-search-forward
- "<\\?[^>]*encoding=\\(\"\\([^\">]+\\)\"\\|'\\([^'>]+\\)'\\)"
- nil t)
- (let ((encoding (intern (downcase (or (match-string 2)
- (match-string 3))))))
- (or
- (mm-coding-system-p (cdr (assq encoding
- nnrss-compatible-encoding-alist)))
- (mm-coding-system-p encoding)
- (mm-coding-system-p (car (rassq encoding
- nnrss-compatible-encoding-alist)))))
- (mm-coding-system-p 'utf-8)))
-
-(defun nnrss-fetch (url &optional local)
- "Fetch URL and put it in a the expected Lisp structure."
- (mm-with-unibyte-buffer
- ;;some CVS versions of url.el need this to close the connection quickly
- (let (cs xmlform htmlform)
- ;; bit o' work necessary for w3 pre-cvs and post-cvs
- (if local
- (let ((coding-system-for-read 'binary))
- (insert-file-contents url))
- ;; FIXME: shouldn't binding `coding-system-for-read' be moved
- ;; to `mm-url-insert'?
- (let ((coding-system-for-read 'binary))
- (condition-case err
- (mm-url-insert url)
- (error (if (or debug-on-quit debug-on-error)
- (signal (car err) (cdr err))
- (message "nnrss: Failed to fetch %s" url))))))
- (nnheader-remove-cr-followed-by-lf)
- ;; Decode text according to the encoding attribute.
- (when (setq cs (nnrss-get-encoding))
- (insert (prog1
- (mm-decode-coding-string (buffer-string) cs)
- (erase-buffer)
- (mm-enable-multibyte))))
- (goto-char (point-min))
-
- ;; Because xml-parse-region can't deal with anything that isn't
- ;; xml and w3-parse-buffer can't deal with some xml, we have to
- ;; parse with xml-parse-region first and, if that fails, parse
- ;; with w3-parse-buffer. Yuck. Eventually, someone should find out
- ;; why w3-parse-buffer fails to parse some well-formed xml and
- ;; fix it.
-
- (condition-case err1
- (setq xmlform (xml-parse-region (point-min) (point-max)))
- (error
- (condition-case err2
- (setq htmlform (caddar (w3-parse-buffer
- (current-buffer))))
- (error
- (message "\
-nnrss: %s: Not valid XML %s and w3-parse doesn't work %s"
- url err1 err2)))))
- (if htmlform
- htmlform
- xmlform))))
-
-(defun nnrss-possibly-change-group (&optional group server)
- (when (and server
- (not (nnrss-server-opened server)))
- (nnrss-open-server server))
- (when (and group (not (equal group nnrss-group)))
- (nnrss-read-group-data group server)
- (setq nnrss-group group)))
-
-(defvar nnrss-extra-categories '(nnrss-snarf-moreover-categories))
-
-(defun nnrss-generate-active ()
- (when (y-or-n-p "Fetch extra categories? ")
- (dolist (func nnrss-extra-categories)
- (funcall func)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnrss-group-alist)
- (insert (prin1-to-string (car elem)) " 0 1 y\n"))
- (dolist (elem nnrss-server-data)
- (unless (assoc (car elem) nnrss-group-alist)
- (insert (prin1-to-string (car elem)) " 0 1 y\n")))))
-
-(eval-and-compile (autoload 'timezone-parse-date "timezone"))
-
-(defun nnrss-normalize-date (date)
- "Return a date string of DATE in the RFC822 style.
-This function handles the ISO 8601 date format described in
-<URL:http://www.w3.org/TR/NOTE-datetime>, and also the RFC822 style
-which RSS 2.0 allows."
- (let (case-fold-search vector year month day time zone cts)
- (cond ((null date))
- ;; RFC822
- ((string-match " [0-9]+ " date)
- (setq vector (timezone-parse-date date)
- year (string-to-number (aref vector 0)))
- (when (>= year 1969)
- (setq month (string-to-number (aref vector 1))
- day (string-to-number (aref vector 2)))
- (unless (>= (length (setq time (aref vector 3))) 3)
- (setq time "00:00:00"))
- (when (and (setq zone (aref vector 4))
- (not (string-match "\\`[A-Z+-]" zone)))
- (setq zone nil))))
- ;; ISO 8601
- ((string-match
- (eval-when-compile
- (concat
- ;; 1. year
- "\\(199[0-9]\\|20[0-9][0-9]\\)"
- "\\(-"
- ;; 3. month
- "\\([01][0-9]\\)"
- "\\(-"
- ;; 5. day
- "\\([0-3][0-9]\\)"
- "\\)?\\)?\\(T"
- ;; 7. hh:mm
- "\\([012][0-9]:[0-5][0-9]\\)"
- "\\("
- ;; 9. :ss
- "\\(:[0-5][0-9]\\)"
- "\\(\\.[0-9]+\\)?\\)?\\)?"
- ;; 13+14,15,16. zone
- "\\(\\(\\([+-][012][0-9]\\):\\([0-5][0-9]\\)\\)"
- "\\|\\([+-][012][0-9][0-5][0-9]\\)"
- "\\|\\(Z\\)\\)?"))
- date)
- (setq year (string-to-number (match-string 1 date))
- month (string-to-number (or (match-string 3 date) "1"))
- day (string-to-number (or (match-string 5 date) "1"))
- time (if (match-beginning 9)
- (substring date (match-beginning 7) (match-end 9))
- (concat (or (match-string 7 date) "00:00") ":00"))
- zone (cond ((match-beginning 13)
- (concat (match-string 13 date)
- (match-string 14 date)))
- ((match-beginning 16) ;; Z
- "+0000")
- (t ;; nil if zone is not provided.
- (match-string 15 date))))))
- (if month
- (progn
- (setq cts (current-time-string (encode-time 0 0 0 day month year)))
- (format "%s, %02d %s %04d %s%s"
- (substring cts 0 3) day (substring cts 4 7) year time
- (if zone
- (concat " " zone)
- "")))
- (message-make-date))))
-
-;;; data functions
-
-(defun nnrss-read-server-data (server)
- (setq nnrss-server-data nil)
- (let ((file (nnrss-make-filename "nnrss" server)))
- (when (file-exists-p file)
- ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
- ;; file names. So, we use `insert-file-contents' instead.
- (mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (insert-file-contents file)
- (eval-region (point-min) (point-max)))))))
-
-(defun nnrss-save-server-data (server)
- (gnus-make-directory nnrss-directory)
- (let ((coding-system-for-write nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (with-temp-file (nnrss-make-filename "nnrss" server)
- (insert (format ";; -*- coding: %s; -*-\n"
- nnrss-file-coding-system))
- (gnus-prin1 `(setq nnrss-group-alist ',nnrss-group-alist))
- (insert "\n")
- (gnus-prin1 `(setq nnrss-server-data ',nnrss-server-data)))))
-
-(defun nnrss-read-group-data (group server)
- (setq nnrss-group-data nil)
- (setq nnrss-group-hashtb (gnus-make-hashtable))
- (let ((pair (assoc group nnrss-server-data)))
- (setq nnrss-group-max (or (cadr pair) 0))
- (setq nnrss-group-min (+ nnrss-group-max 1)))
- (let ((file (nnrss-make-filename group server)))
- (when (file-exists-p file)
- ;; In Emacs 21.3 and earlier, `load' doesn't support non-ASCII
- ;; file names. So, we use `insert-file-contents' instead.
- (mm-with-multibyte-buffer
- (let ((coding-system-for-read nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (insert-file-contents file)
- (eval-region (point-min) (point-max))))
- (dolist (e nnrss-group-data)
- (gnus-sethash (or (nth 2 e) (nth 6 e)) t nnrss-group-hashtb)
- (when (and (car e) (> nnrss-group-min (car e)))
- (setq nnrss-group-min (car e)))
- (when (and (car e) (< nnrss-group-max (car e)))
- (setq nnrss-group-max (car e)))))))
-
-(defun nnrss-save-group-data (group server)
- (gnus-make-directory nnrss-directory)
- (let ((coding-system-for-write nnrss-file-coding-system)
- (file-name-coding-system nnmail-pathname-coding-system))
- (with-temp-file (nnrss-make-filename group server)
- (insert (format ";; -*- coding: %s; -*-\n"
- nnrss-file-coding-system))
- (gnus-prin1 `(setq nnrss-group-data ',nnrss-group-data)))))
-
-(defun nnrss-make-filename (name server)
- (expand-file-name
- (nnrss-translate-file-chars
- (concat name
- (and server
- (not (equal server ""))
- "-")
- server
- ".el"))
- nnrss-directory))
-
-(gnus-add-shutdown 'nnrss-close 'gnus)
-
-(defun nnrss-close ()
- "Clear internal nnrss variables."
- (setq nnrss-group-data nil
- nnrss-server-data nil
- nnrss-group-hashtb nil
- nnrss-group-alist nil))
-
-;;; URL interface
-
-(defun nnrss-no-cache (url)
- "")
-
-(defun nnrss-insert-w3 (url)
- (mm-with-unibyte-current-buffer
- (condition-case err
- (mm-url-insert url)
- (error (if (or debug-on-quit debug-on-error)
- (signal (car err) (cdr err))
- (message "nnrss: Failed to fetch %s" url))))))
-
-(defun nnrss-decode-entities-string (string)
- (if string
- (mm-with-multibyte-buffer
- (insert string)
- (mm-url-decode-entities-nbsp)
- (buffer-string))))
-
-(defalias 'nnrss-insert 'nnrss-insert-w3)
-
-(defun nnrss-mime-encode-string (string)
- (mm-with-multibyte-buffer
- (insert string)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (while (re-search-forward "[\t\n ]+" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (skip-chars-forward " ")
- (delete-region (point-min) (point))
- (goto-char (point-max))
- (skip-chars-forward " ")
- (delete-region (point) (point-max))
- (let ((rfc2047-encoding-type 'mime)
- rfc2047-encode-max-chars)
- (rfc2047-encode-region (point-min) (point-max)))
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (delete-backward-char 1))
- (buffer-string)))
-
-;;; Snarf functions
-
-(defun nnrss-check-group (group server)
- (let (file xml subject url extra changed author date feed-subject
- enclosure comments rss-ns rdf-ns content-ns dc-ns)
- (if (and nnrss-use-local
- (file-exists-p (setq file (expand-file-name
- (nnrss-translate-file-chars
- (concat group ".xml"))
- nnrss-directory))))
- (setq xml (nnrss-fetch file t))
- (setq url (or (nth 2 (assoc group nnrss-server-data))
- (second (assoc group nnrss-group-alist))))
- (unless url
- (setq url
- (cdr
- (assoc 'href
- (nnrss-discover-feed
- (read-string
- (format "URL to search for %s: " group) "http://")))))
- (let ((pair (assoc group nnrss-server-data)))
- (if pair
- (setcdr (cdr pair) (list url))
- (push (list group nnrss-group-max url) nnrss-server-data)))
- (setq changed t))
- (setq xml (nnrss-fetch url)))
- ;; See
- ;; http://feeds.archive.org/validator/docs/howto/declare_namespaces.html
- ;; for more RSS namespaces.
- (setq dc-ns (nnrss-get-namespace-prefix xml "http://purl.org/dc/elements/1.1/")
- rdf-ns (nnrss-get-namespace-prefix xml "http://www.w3.org/1999/02/22-rdf-syntax-ns#")
- rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")
- content-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/modules/content/"))
- (dolist (item (nreverse (nnrss-find-el (intern (concat rss-ns "item")) xml)))
- (when (and (listp item)
- (string= (concat rss-ns "item") (car item))
- (if (setq url (nnrss-decode-entities-string
- (nnrss-node-text rss-ns 'link (cddr item))))
- (not (gnus-gethash url nnrss-group-hashtb))
- (setq extra (or (nnrss-node-text content-ns 'encoded item)
- (nnrss-node-text rss-ns 'description item)))
- (not (gnus-gethash extra nnrss-group-hashtb))))
- (setq subject (nnrss-node-text rss-ns 'title item))
- (setq extra (or extra
- (nnrss-node-text content-ns 'encoded item)
- (nnrss-node-text rss-ns 'description item)))
- (if (setq feed-subject (nnrss-node-text dc-ns 'subject item))
- (setq extra (concat feed-subject "<br /><br />" extra)))
- (setq author (or (nnrss-node-text rss-ns 'author item)
- (nnrss-node-text dc-ns 'creator item)
- (nnrss-node-text dc-ns 'contributor item)))
- (setq date (nnrss-normalize-date
- (or (nnrss-node-text dc-ns 'date item)
- (nnrss-node-text rss-ns 'pubDate item))))
- (setq comments (nnrss-node-text rss-ns 'comments item))
- (when (setq enclosure (cadr (assq (intern (concat rss-ns "enclosure")) item)))
- (let ((url (cdr (assq 'url enclosure)))
- (len (cdr (assq 'length enclosure)))
- (type (cdr (assq 'type enclosure)))
- (name))
- (setq len
- (if (and len (integerp (setq len (string-to-number len))))
- ;; actually already in `ls-lisp-format-file-size' but
- ;; probably not worth to require it for one function
- (do ((size (/ len 1.0) (/ size 1024.0))
- (post-fixes (list "" "k" "M" "G" "T" "P" "E")
- (cdr post-fixes)))
- ((< size 1024)
- (format "%.1f%s" size (car post-fixes))))
- "0"))
- (setq url (or url ""))
- (setq name (if (string-match "/\\([^/]*\\)$" url)
- (match-string 1 url)
- "file"))
- (setq type (or type ""))
- (setq enclosure (list url name len type))))
- (push
- (list
- (incf nnrss-group-max)
- (current-time)
- url
- (and subject (nnrss-mime-encode-string subject))
- (and author (nnrss-mime-encode-string author))
- date
- (and extra (nnrss-decode-entities-string extra))
- enclosure
- comments)
- nnrss-group-data)
- (gnus-sethash (or url extra) t nnrss-group-hashtb)
- (setq changed t))
- (setq extra nil))
- (when changed
- (nnrss-save-group-data group server)
- (let ((pair (assoc group nnrss-server-data)))
- (if pair
- (setcar (cdr pair) nnrss-group-max)
- (push (list group nnrss-group-max) nnrss-server-data)))
- (nnrss-save-server-data server))))
-
-(defun nnrss-opml-import (opml-file)
- "OPML subscriptions import.
-Read the file and attempt to subscribe to each Feed in the file."
- (interactive "fImport file: ")
- (mapc
- (lambda (node)
- (let ((xmlurl (cdr (assq 'xmlUrl (cadr node)))))
- (when (and xmlurl
- (not (string-match "\\`[\t ]*\\'" xmlurl))
- (prog1
- (y-or-n-p (format "Subscribe to %s " xmlurl))
- (message "")))
- (condition-case err
- (progn
- (gnus-group-make-rss-group xmlurl)
- (forward-line 1))
- (error
- (message
- "Failed to subscribe to %s (%s); type any key to continue: "
- xmlurl
- (error-message-string err))
- (let ((echo-keystrokes 0))
- (read-char)))))))
- (nnrss-find-el 'outline
- (mm-with-multibyte-buffer
- (insert-file-contents opml-file)
- (xml-parse-region (point-min) (point-max))))))
-
-(defun nnrss-opml-export ()
- "OPML subscription export.
-Export subscriptions to a buffer in OPML Format."
- (interactive)
- (with-current-buffer (get-buffer-create "*OPML Export*")
- (mm-set-buffer-file-coding-system 'utf-8)
- (insert "<?xml version=\"1.0\" encoding=\"utf-8\"?>\n"
- "<!-- OPML generated by Emacs Gnus' nnrss.el -->\n"
- "<opml version=\"1.1\">\n"
- " <head>\n"
- " <title>mySubscriptions</title>\n"
- " <dateCreated>" (format-time-string "%a, %d %b %Y %T %z")
- "</dateCreated>\n"
- " <ownerEmail>" user-mail-address "</ownerEmail>\n"
- " <ownerName>" (user-full-name) "</ownerName>\n"
- " </head>\n"
- " <body>\n")
- (dolist (sub nnrss-group-alist)
- (insert " <outline text=\"" (car sub)
- "\" xmlUrl=\"" (cadr sub) "\"/>\n"))
- (insert " </body>\n"
- "</opml>\n"))
- (pop-to-buffer "*OPML Export*")
- (when (fboundp 'sgml-mode)
- (sgml-mode)))
-
-(defun nnrss-generate-download-script ()
- "Generate a download script in the current buffer.
-It is useful when `(setq nnrss-use-local t)'."
- (interactive)
- (insert "#!/bin/sh\n")
- (insert "WGET=wget\n")
- (insert "RSSDIR='" (expand-file-name nnrss-directory) "'\n")
- (dolist (elem nnrss-server-data)
- (let ((url (or (nth 2 elem)
- (second (assoc (car elem) nnrss-group-alist)))))
- (insert "$WGET -q -O \"$RSSDIR\"/'"
- (nnrss-translate-file-chars (concat (car elem) ".xml"))
- "' '" url "'\n"))))
-
-(defun nnrss-translate-file-chars (name)
- (let ((nnheader-file-name-translation-alist
- (append nnheader-file-name-translation-alist '((?' . ?_)))))
- (nnheader-translate-file-chars name)))
-
-(defvar nnrss-moreover-url
- "http://w.moreover.com/categories/category_list_rss.html"
- "The url of moreover.com categories.")
-
-(defun nnrss-snarf-moreover-categories ()
- "Snarf RSS links from moreover.com."
- (interactive)
- (let (category name url changed)
- (with-temp-buffer
- (nnrss-insert nnrss-moreover-url)
- (goto-char (point-min))
- (while (re-search-forward
- "<a name=\"\\([^\"]+\\)\">\\|<a href=\"\\(http://[^\"]*moreover\\.com[^\"]+page\\?c=\\([^\"&]+\\)&o=rss\\)" nil t)
- (if (match-string 1)
- (setq category (match-string 1))
- (setq url (match-string 2)
- name (mm-url-decode-entities-string
- (rfc2231-decode-encoded-string
- (match-string 3))))
- (if category
- (setq name (concat category "." name)))
- (unless (assoc name nnrss-server-data)
- (setq changed t)
- (push (list name 0 url) nnrss-server-data)))))
- (if changed
- (nnrss-save-server-data ""))))
-
-(defun nnrss-node-text (namespace local-name element)
- (let* ((node (assq (intern (concat namespace (symbol-name local-name)))
- element))
- (text (if (and node (listp node))
- (nnrss-node-just-text node)
- node))
- (cleaned-text (if text
- (gnus-replace-in-string
- (gnus-replace-in-string
- text "^[\000-\037\177]+\\|^ +\\| +$" "")
- "\r\n" "\n"))))
- (if (string-equal "" cleaned-text)
- nil
- cleaned-text)))
-
-(defun nnrss-node-just-text (node)
- (if (and node (listp node))
- (mapconcat 'nnrss-node-just-text (cddr node) " ")
- node))
-
-(defun nnrss-find-el (tag data &optional found-list)
- "Find the all matching elements in the data.
-Careful with this on large documents!"
- (when (consp data)
- (dolist (bit data)
- (when (car-safe bit)
- (when (equal tag (car bit))
- ;; Old xml.el may return a list of string.
- (when (and (consp (caddr bit))
- (stringp (caaddr bit)))
- (setcar (cddr bit) (caaddr bit)))
- (setq found-list
- (append found-list
- (list bit))))
- (if (and (consp (car-safe (caddr bit)))
- (not (stringp (caddr bit))))
- (setq found-list
- (append found-list
- (nnrss-find-el
- tag (caddr bit))))
- (setq found-list
- (append found-list
- (nnrss-find-el
- tag (cddr bit))))))))
- found-list)
-
-(defun nnrss-rsslink-p (el)
- "Test if the element we are handed is an RSS autodiscovery link."
- (and (eq (car-safe el) 'link)
- (string-equal (cdr (assoc 'rel (cadr el))) "alternate")
- (or (string-equal (cdr (assoc 'type (cadr el)))
- "application/rss+xml")
- (string-equal (cdr (assoc 'type (cadr el))) "text/xml"))))
-
-(defun nnrss-get-rsslinks (data)
- "Extract the <link> elements that are links to RSS from the parsed data."
- (delq nil (mapcar
- (lambda (el)
- (if (nnrss-rsslink-p el) el))
- (nnrss-find-el 'link data))))
-
-(defun nnrss-extract-hrefs (data)
- "Recursively extract hrefs from a page's source.
-DATA should be the output of `xml-parse-region' or
-`w3-parse-buffer'."
- (mapcar (lambda (ahref)
- (cdr (assoc 'href (cadr ahref))))
- (nnrss-find-el 'a data)))
-
-(defmacro nnrss-match-macro (base-uri item onsite-list offsite-list)
- `(cond ((or (string-match (concat "^" ,base-uri) ,item)
- (not (string-match "://" ,item)))
- (setq ,onsite-list (append ,onsite-list (list ,item))))
- (t (setq ,offsite-list (append ,offsite-list (list ,item))))))
-
-(defun nnrss-order-hrefs (base-uri hrefs)
- "Given a list of hrefs, sort them using the following priorities:
- 1. links ending in .rss
- 2. links ending in .rdf
- 3. links ending in .xml
- 4. links containing the above
- 5. offsite links
-
-BASE-URI is used to determine the location of the links and
-whether they are `offsite' or `onsite'."
- (let (rss-onsite-end rdf-onsite-end xml-onsite-end
- rss-onsite-in rdf-onsite-in xml-onsite-in
- rss-offsite-end rdf-offsite-end xml-offsite-end
- rss-offsite-in rdf-offsite-in xml-offsite-in)
- (dolist (href hrefs)
- (cond ((null href))
- ((string-match "\\.rss$" href)
- (nnrss-match-macro
- base-uri href rss-onsite-end rss-offsite-end))
- ((string-match "\\.rdf$" href)
- (nnrss-match-macro
- base-uri href rdf-onsite-end rdf-offsite-end))
- ((string-match "\\.xml$" href)
- (nnrss-match-macro
- base-uri href xml-onsite-end xml-offsite-end))
- ((string-match "rss" href)
- (nnrss-match-macro
- base-uri href rss-onsite-in rss-offsite-in))
- ((string-match "rdf" href)
- (nnrss-match-macro
- base-uri href rdf-onsite-in rdf-offsite-in))
- ((string-match "xml" href)
- (nnrss-match-macro
- base-uri href xml-onsite-in xml-offsite-in))))
- (append
- rss-onsite-end rdf-onsite-end xml-onsite-end
- rss-onsite-in rdf-onsite-in xml-onsite-in
- rss-offsite-end rdf-offsite-end xml-offsite-end
- rss-offsite-in rdf-offsite-in xml-offsite-in)))
-
-(defun nnrss-discover-feed (url)
- "Given a page, find an RSS feed using Mark Pilgrim's
-`ultra-liberal rss locator' (http://diveintomark.org/2002/08/15.html)."
-
- (let ((parsed-page (nnrss-fetch url)))
-
-;; 1. if this url is the rss, use it.
- (if (nnrss-rss-p parsed-page)
- (let ((rss-ns (nnrss-get-namespace-prefix parsed-page "http://purl.org/rss/1.0/")))
- (nnrss-rss-title-description rss-ns parsed-page url))
-
-;; 2. look for the <link rel="alternate"
-;; type="application/rss+xml" and use that if it is there.
- (let ((links (nnrss-get-rsslinks parsed-page)))
- (if links
- (let* ((xml (nnrss-fetch
- (cdr (assoc 'href (cadar links)))))
- (rss-ns (nnrss-get-namespace-prefix xml "http://purl.org/rss/1.0/")))
- (nnrss-rss-title-description rss-ns xml (cdr (assoc 'href (cadar links)))))
-
-;; 3. look for links on the site in the following order:
-;; - onsite links ending in .rss, .rdf, or .xml
-;; - onsite links containing any of the above
-;; - offsite links ending in .rss, .rdf, or .xml
-;; - offsite links containing any of the above
- (let* ((base-uri (progn (string-match ".*://[^/]+/?" url)
- (match-string 0 url)))
- (hrefs (nnrss-order-hrefs
- base-uri (nnrss-extract-hrefs parsed-page)))
- (rss-link nil))
- (while (and (eq rss-link nil) (not (eq hrefs nil)))
- (let ((href-data (nnrss-fetch (car hrefs))))
- (if (nnrss-rss-p href-data)
- (let* ((rss-ns (nnrss-get-namespace-prefix href-data "http://purl.org/rss/1.0/")))
- (setq rss-link (nnrss-rss-title-description
- rss-ns href-data (car hrefs))))
- (setq hrefs (cdr hrefs)))))
- (if rss-link rss-link
-
-;; 4. check syndic8
- (nnrss-find-rss-via-syndic8 url))))))))
-
-(defun nnrss-find-rss-via-syndic8 (url)
- "Query syndic8 for the rss feeds it has for URL."
- (if (not (locate-library "xml-rpc"))
- (progn
- (message "XML-RPC is not available... not checking Syndic8.")
- nil)
- (require 'xml-rpc)
- (let ((feedid (xml-rpc-method-call
- "http://www.syndic8.com/xmlrpc.php"
- 'syndic8.FindSites
- url)))
- (when feedid
- (let* ((feedinfo (xml-rpc-method-call
- "http://www.syndic8.com/xmlrpc.php"
- 'syndic8.GetFeedInfo
- feedid))
- (urllist
- (delq nil
- (mapcar
- (lambda (listinfo)
- (if (string-equal
- (cdr (assoc "status" listinfo))
- "Syndicated")
- (cons
- (cdr (assoc "sitename" listinfo))
- (list
- (cons 'title
- (cdr (assoc
- "sitename" listinfo)))
- (cons 'href
- (cdr (assoc
- "dataurl" listinfo)))))))
- feedinfo))))
- (if (not (> (length urllist) 1))
- (cdar urllist)
- (let ((completion-ignore-case t)
- (selection
- (mapcar (lambda (listinfo)
- (cons (cdr (assoc "sitename" listinfo))
- (string-to-number
- (cdr (assoc "feedid" listinfo)))))
- feedinfo)))
- (cdr (assoc
- (completing-read
- "Multiple feeds found. Select one: "
- selection nil t) urllist)))))))))
-
-(defun nnrss-rss-p (data)
- "Test if DATA is an RSS feed.
-Simply ensures that the first element is rss or rdf."
- (or (eq (caar data) 'rss)
- (eq (caar data) 'rdf:RDF)))
-
-(defun nnrss-rss-title-description (rss-namespace data url)
- "Return the title of an RSS feed."
- (if (nnrss-rss-p data)
- (let ((description (intern (concat rss-namespace "description")))
- (title (intern (concat rss-namespace "title")))
- (channel (nnrss-find-el (intern (concat rss-namespace "channel"))
- data)))
- (list
- (cons 'description (caddr (nth 0 (nnrss-find-el description channel))))
- (cons 'title (caddr (nth 0 (nnrss-find-el title channel))))
- (cons 'href url)))))
-
-(defun nnrss-get-namespace-prefix (el uri)
- "Given EL (containing a parsed element) and URI (containing a string
-that gives the URI for which you want to retrieve the namespace
-prefix), return the prefix."
- (let* ((prefix (car (rassoc uri (cadar el))))
- (nslist (if prefix
- (split-string (symbol-name prefix) ":")))
- (ns (cond ((eq (length nslist) 1) ; no prefix given
- "")
- ((eq (length nslist) 2) ; extract prefix
- (cadr nslist)))))
- (if (and ns (not (string= ns "")))
- (concat ns ":")
- ns)))
-
-(provide 'nnrss)
-
-
-;;; nnrss.el ends here
-
-;;; arch-tag: 12910c07-0cdf-44fb-8d2c-416ded64c267
+++ /dev/null
-;;; nnslashdot.el --- interfacing with Slashdot
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-
-(nnoo-declare nnslashdot)
-
-(defvoo nnslashdot-directory (nnheader-concat gnus-directory "slashdot/")
- "Where nnslashdot will save its files.")
-
-(defvoo nnslashdot-active-url "http://slashdot.org/search.pl?section=&min=%d"
- "Where nnslashdot will fetch the active file from.")
-
-(defvoo nnslashdot-comments-url "http://slashdot.org/comments.pl?sid=%s&threshold=%d&commentsort=%d&mode=flat&startat=%d"
- "Where nnslashdot will fetch comments from.")
-
-(defvoo nnslashdot-article-url
- "http://slashdot.org/article.pl?sid=%s&mode=nocomment"
- "Where nnslashdot will fetch the article from.")
-
-(defvoo nnslashdot-backslash-url "http://slashdot.org/slashdot.xml"
- "Where nnslashdot will fetch the stories from.")
-
-(defvoo nnslashdot-use-front-page nil
- "Use the front page in addition to the backslash page.")
-
-(defvoo nnslashdot-threshold -1
- "The article threshold.")
-
-(defvoo nnslashdot-threaded t
- "Whether the nnslashdot groups should be threaded or not.")
-
-(defvoo nnslashdot-group-number 0
- "The number of non-fresh groups to keep updated.")
-
-(defvoo nnslashdot-login-name ""
- "The login name to use when posting.")
-
-(defvoo nnslashdot-password ""
- "The password to use when posting.")
-
-;;; Internal variables
-
-(defvar nnslashdot-groups nil)
-(defvar nnslashdot-buffer nil)
-(defvar nnslashdot-headers nil)
-
-;;; Interface functions
-
-(nnoo-define-basics nnslashdot)
-
-(deffoo nnslashdot-retrieve-headers (articles &optional group server fetch-old)
- (nnslashdot-possibly-change-server group server)
- (condition-case why
- (unless gnus-nov-is-evil
- (nnslashdot-retrieve-headers-1 articles group))
- (search-failed (nnslashdot-lose why))))
-
-(deffoo nnslashdot-retrieve-headers-1 (articles group)
- (let* ((last (car (last articles)))
- (start (if nnslashdot-threaded 1 (pop articles)))
- (entry (assoc group nnslashdot-groups))
- (sid (nth 2 entry))
- (first-comments t)
- headers article subject score from date lines parent point cid
- s startats changed)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
- (erase-buffer)
- (when (= start 1)
- (mm-url-insert (format nnslashdot-article-url sid) t)
- (goto-char (point-min))
- (if (eobp)
- (error "Couldn't open connection to slashdot"))
- (re-search-forward "Posted by[ \t\r\n]+")
- (when (looking-at "\\(<a[^>]+>\\)?[ \t\r\n]*\\([^<\r\n]+\\)")
- (setq from (mm-url-decode-entities-string (match-string 2))))
- (search-forward "on ")
- (setq date (nnslashdot-date-to-date
- (buffer-substring (point) (1- (search-forward "<")))))
- (setq lines (/ (- (point)
- (progn (forward-line 1) (point)))
- 60))
- (push
- (cons
- 1
- (make-full-mail-header
- 1 group from date
- (concat "<" sid "%1@slashdot>")
- "" 0 lines nil nil))
- headers)
- (setq start (if nnslashdot-threaded 2 (pop articles))))
- (while (and start (<= start last))
- (setq point (goto-char (point-max)))
- (mm-url-insert
- (format nnslashdot-comments-url sid
- nnslashdot-threshold 0 (- start 2))
- t)
- (when (and nnslashdot-threaded first-comments)
- (setq first-comments nil)
- (goto-char (point-max))
- (while (re-search-backward "startat=\\([0-9]+\\)" nil t)
- (setq s (string-to-number (match-string 1)))
- (unless (memq s startats)
- (push s startats)))
- (setq startats (sort startats '<)))
- (setq article (if (and article (< start article)) article start))
- (goto-char point)
- (while (re-search-forward
- "<a name=\"\\([0-9]+\\)\">\\([^<]+\\)\\(?:.*\n\\)\\{2,10\\}.*score:\\([^)]+\\))"
- nil t)
- (setq cid (match-string 1)
- subject (match-string 2)
- score (match-string 3))
- (unless (assq article (nth 4 entry))
- (setcar (nthcdr 4 entry) (cons (cons article cid) (nth 4 entry)))
- (setq changed t))
- (when (string-match "^Re: *" subject)
- (setq subject (concat "Re: " (substring subject (match-end 0)))))
- (setq subject (mm-url-decode-entities-string subject)
- from "")
- (when (re-search-forward "by[ \t\n]+<[^>]+>\\([^<(]+\\)" nil t)
- (setq from
- (concat
- (mm-url-decode-entities-string (match-string 1))
- " <nobody@slashdot.org>")))
- (search-forward "on ")
- (setq date
- (nnslashdot-date-to-date
- (buffer-substring
- (point) (progn (skip-chars-forward "^()<>\n\r") (point)))))
- (setq lines (/ (abs (- (search-forward "<div")
- (search-forward "</div>")))
- 70))
- (if (not
- (re-search-forward ".*cid=\\([0-9]+\\)\">Parent</A>" nil t))
- (setq parent nil)
- (setq parent (match-string 1))
- (when (string= parent "0")
- (setq parent nil)))
- (push
- (cons
- article
- (make-full-mail-header
- article
- (concat subject " (" score ")")
- from date
- (concat "<" sid "%" cid "@slashdot>")
- (if parent
- (concat "<" sid "%" parent "@slashdot>")
- "")
- 0 lines nil nil))
- headers)
- (while (and articles (<= (car articles) article))
- (pop articles))
- (setq article (1+ article)))
- (if nnslashdot-threaded
- (progn
- (setq start (pop startats))
- (if start (setq start (+ start 2))))
- (setq start (pop articles))))))
- (if changed (nnslashdot-write-groups))
- (setq nnslashdot-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (dolist (header nnslashdot-headers)
- (nnheader-insert-nov (cdr header)))))
- 'nov))
-
-(deffoo nnslashdot-request-group (group &optional server dont-check)
- (nnslashdot-possibly-change-server nil server)
- (let ((elem (assoc group nnslashdot-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnslashdot "Group does not exist"))
- (t
- (nnheader-report 'nnslashdot "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnslashdot-close-group (group &optional server)
- (nnslashdot-possibly-change-server group server)
- (when (gnus-buffer-live-p nnslashdot-buffer)
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (kill-buffer nnslashdot-buffer)))
- t)
-
-(deffoo nnslashdot-request-article (article &optional group server buffer)
- (nnslashdot-possibly-change-server group server)
- (let (contents cid)
- (condition-case why
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (let ((case-fold-search t))
- (goto-char (point-min))
- (when (and (stringp article)
- (string-match "%\\([0-9]+\\)@" article))
- (setq cid (match-string 1 article))
- (let ((map (nth 4 (assoc group nnslashdot-groups))))
- (while map
- (if (equal (cdar map) cid)
- (setq article (caar map)
- map nil)
- (setq map (cdr map))))))
- (when (numberp article)
- (if (= article 1)
- (progn
- (search-forward "Posted by")
- (search-forward "<div class=\"intro\">")
- (setq contents
- (buffer-substring
- (point)
- (progn
- (search-forward "commentwrap")
- (match-beginning 0)))))
- (setq cid (cdr (assq article
- (nth 4 (assoc group nnslashdot-groups)))))
- (search-forward (format "<a name=\"%s\">" cid))
- (setq contents
- (buffer-substring
- (search-forward "<div class=\"commentBody\">")
- (progn
- (search-forward "<div class=\"commentSub\"")
- (match-beginning 0))))))))
- (search-failed (nnslashdot-lose why)))
-
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (insert contents)
- (goto-char (point-min))
- (while (re-search-forward "\\(<br>\r?\\)+" nil t)
- (replace-match "<p>" t t))
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (insert "Newsgroups: " (caddr (assoc group nnslashdot-groups))
- "\n")
- (let ((header (cdr (assq article nnslashdot-headers))))
- (nnheader-insert-header header))
- (nnheader-report 'nnslashdot "Fetched article %s" article))
- (cons group article)))))
-
-(deffoo nnslashdot-close-server (&optional server)
- (when (and (nnslashdot-server-opened server)
- (gnus-buffer-live-p nnslashdot-buffer))
- (save-excursion
- (set-buffer nnslashdot-buffer)
- (kill-buffer nnslashdot-buffer)))
- (nnoo-close-server 'nnslashdot server))
-
-(deffoo nnslashdot-request-list (&optional server)
- (nnslashdot-possibly-change-server nil server)
- (let ((number 0)
- (first nnslashdot-use-front-page)
- sid elem description articles gname)
- (condition-case why
- ;; First we do the Ultramode to get info on all the latest groups.
- (progn
- (mm-with-unibyte-buffer
- (mm-url-insert nnslashdot-backslash-url t)
- (goto-char (point-min))
- (if (eobp)
- (error "Couldn't open connection to slashdot"))
- (while (search-forward "<story>" nil t)
- (narrow-to-region (point) (search-forward "</story>"))
- (goto-char (point-min))
- (re-search-forward "<title>\\([^<]+\\)</title>")
- (setq description
- (mm-url-decode-entities-string (match-string 1)))
- (re-search-forward "<url>\\([^<]+\\)</url>")
- (setq sid (match-string 1))
- (string-match "sid=\\([0-9/]+\\)\\(.shtml\\|$\\)" sid)
- (setq sid (match-string 1 sid))
- (re-search-forward "<comments>\\([^<]+\\)</comments>")
- (setq articles (string-to-number (match-string 1)))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid (current-time) nil)
- nnslashdot-groups))
- (goto-char (point-max))
- (widen)))
- ;; Then do the older groups.
- (while (or first
- (> (- nnslashdot-group-number number) 0))
- (setq first nil)
- (mm-with-unibyte-buffer
- (let ((case-fold-search t))
- (mm-url-insert (format nnslashdot-active-url number) t)
- (goto-char (point-min))
- (while (re-search-forward
- "article.pl\\?sid=\\([^&]+\\).*>\\([^<]+\\)</a>"
- nil t)
- (setq sid (match-string 1)
- description
- (mm-url-decode-entities-string (match-string 2)))
- (forward-line 1)
- (when (re-search-forward "with \\([0-9]+\\) comment" nil t)
- (setq articles (1+ (string-to-number (match-string 1)))))
- (setq gname (concat description " (" sid ")"))
- (if (setq elem (assoc gname nnslashdot-groups))
- (setcar (cdr elem) articles)
- (push (list gname articles sid (current-time) nil)
- nnslashdot-groups)))))
- (incf number 30)))
- (search-failed (nnslashdot-lose why)))
- (nnslashdot-write-groups)
- (nnslashdot-generate-active)
- t))
-
-(deffoo nnslashdot-request-newgroups (date &optional server)
- (nnslashdot-possibly-change-server nil server)
- (nnslashdot-generate-active)
- t)
-
-(deffoo nnslashdot-request-post (&optional server)
- (nnslashdot-possibly-change-server nil server)
- (let ((sid (message-fetch-field "newsgroups"))
- (subject (message-fetch-field "subject"))
- (references (car (last (split-string
- (message-fetch-field "references")))))
- body quoted pid)
- (string-match "%\\([0-9]+\\)@slashdot" references)
- (setq pid (match-string 1 references))
- (message-goto-body)
- (narrow-to-region (point) (progn (message-goto-signature) (point)))
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "> ")
- (progn
- (delete-region (point) (+ (point) 2))
- (unless quoted
- (insert "<blockquote>\n"))
- (setq quoted t))
- (when quoted
- (insert "</blockquote>\n")
- (setq quoted nil)))
- (forward-line 1))
- (goto-char (point-min))
- (while (re-search-forward "^ *\n" nil t)
- (replace-match "<p>\n"))
- (widen)
- (when (message-goto-signature)
- (forward-line -1)
- (insert "<p>\n")
- (while (not (eobp))
- (end-of-line)
- (insert "<br>")
- (forward-line 1)))
- (message-goto-body)
- (setq body (buffer-substring (point) (point-max)))
- (erase-buffer)
- (mm-url-fetch-form
- "http://slashdot.org/comments.pl"
- `(("sid" . ,sid)
- ("pid" . ,pid)
- ("rlogin" . "userlogin")
- ("unickname" . ,nnslashdot-login-name)
- ("upasswd" . ,nnslashdot-password)
- ("postersubj" . ,subject)
- ("op" . "Submit")
- ("postercomment" . ,body)
- ("posttype" . "html")))))
-
-(deffoo nnslashdot-request-delete-group (group &optional force server)
- (nnslashdot-possibly-change-server group server)
- (setq nnslashdot-groups (delq (assoc group nnslashdot-groups)
- nnslashdot-groups))
- (nnslashdot-write-groups))
-
-(deffoo nnslashdot-request-close ()
- (setq nnslashdot-headers nil
- nnslashdot-groups nil))
-
-(deffoo nnslashdot-request-expire-articles
- (articles group &optional server force)
- (nnslashdot-possibly-change-server group server)
- (let ((item (assoc group nnslashdot-groups)))
- (when item
- (if (fourth item)
- (when (and (>= (length articles) (cadr item)) ;; All are expirable.
- (nnmail-expired-article-p
- group
- (fourth item)
- force))
- (setq nnslashdot-groups (delq item nnslashdot-groups))
- (nnslashdot-write-groups)
- (setq articles nil)) ;; all expired.
- (setcdr (cddr item) (list (current-time)))
- (nnslashdot-write-groups))))
- articles)
-
-(nnoo-define-skeleton nnslashdot)
-
-;;; Internal functions
-
-(defun nnslashdot-possibly-change-server (&optional group server)
- (nnslashdot-init server)
- (when (and server
- (not (nnslashdot-server-opened server)))
- (nnslashdot-open-server server))
- (unless nnslashdot-groups
- (nnslashdot-read-groups)))
-
-(defun nnslashdot-make-tuple (tuple n)
- (prog1
- tuple
- (while (> n 1)
- (unless (cdr tuple)
- (setcdr tuple (list nil)))
- (setq tuple (cdr tuple)
- n (1- n)))))
-
-(defun nnslashdot-read-groups ()
- (let ((file (expand-file-name "groups" nnslashdot-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnslashdot-groups (read (current-buffer))))
- (if (and nnslashdot-groups (< (length (car nnslashdot-groups)) 5))
- (let ((groups nnslashdot-groups))
- (while groups
- (nnslashdot-make-tuple (car groups) 5)
- (setq groups (cdr groups))))))))
-
-(defun nnslashdot-write-groups ()
- (with-temp-file (expand-file-name "groups" nnslashdot-directory)
- (gnus-prin1 nnslashdot-groups)))
-
-(defun nnslashdot-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnslashdot-directory)
- (gnus-make-directory nnslashdot-directory))
- (unless (gnus-buffer-live-p nnslashdot-buffer)
- (setq nnslashdot-buffer
- (save-excursion
- (nnheader-set-temp-buffer
- (format " *nnslashdot %s*" server))))
- (push nnslashdot-buffer gnus-buffers)))
-
-(defun nnslashdot-date-to-date (sdate)
- (condition-case err
- (let ((elem (delete "" (split-string sdate))))
- (concat (substring (nth 0 elem) 0 3) " "
- (substring (nth 1 elem) 0 3) " "
- (substring (nth 2 elem) 0 2) " "
- (substring (nth 3 elem) 1 6) " "
- (format-time-string "%Y") " "
- (nth 4 elem)))
- (error "")))
-
-(defun nnslashdot-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnslashdot-groups)
- (when (numberp (cadr elem))
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n")))))
-
-(defun nnslashdot-lose (why)
- (error "Slashdot HTML has changed; please get a new version of nnslashdot"))
-
-(provide 'nnslashdot)
-
-;;; arch-tag: aa73df7a-f7e6-4eef-bdea-5ce2f8c691b3
-;;; nnslashdot.el ends here
+++ /dev/null
-;;; nnsoup.el --- SOUP access for Gnus
-
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnmail)
-(require 'gnus-soup)
-(require 'gnus-msg)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnsoup)
-
-(defvoo nnsoup-directory (nnheader-concat gnus-home-directory "SOUP/")
- "*SOUP packet directory.")
-
-(defvoo nnsoup-tmp-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp/"))
- "*Where nnsoup will store temporary files.")
-
-(defvoo nnsoup-replies-directory (expand-file-name "replies/" nnsoup-directory)
- "*Directory where outgoing packets will be composed.")
-
-(defvoo nnsoup-replies-format-type ?u ;; u is USENET news format.
- "*Format of the replies packages.")
-
-(defvoo nnsoup-replies-index-type ?n
- "*Index type of the replies packages.")
-
-(defvoo nnsoup-active-file (expand-file-name "active" nnsoup-directory)
- "Active file.")
-
-(defvoo nnsoup-packer (concat "tar cf - %s | gzip > "
- (expand-file-name gnus-home-directory)
- "Soupin%d.tgz")
- "Format string command for packing a SOUP packet.
-The SOUP files will be inserted where the %s is in the string.
-This string MUST contain both %s and %d. The file number will be
-inserted where %d appears.")
-
-(defvoo nnsoup-unpacker "gunzip -c %s | tar xvf -"
- "*Format string command for unpacking a SOUP packet.
-The SOUP packet file name will be inserted at the %s.")
-
-(defvoo nnsoup-packet-directory gnus-home-directory
- "*Where nnsoup will look for incoming packets.")
-
-(defvoo nnsoup-packet-regexp "Soupout"
- "*Regular expression matching SOUP packets in `nnsoup-packet-directory'.")
-
-(defvoo nnsoup-always-save t
- "If non-nil commit the reply buffer on each message send.
-This is necessary if using message mode outside Gnus with nnsoup as a
-backend for the messages.")
-
-\f
-
-(defconst nnsoup-version "nnsoup 0.0"
- "nnsoup version.")
-
-(defvoo nnsoup-status-string "")
-(defvoo nnsoup-group-alist nil)
-(defvoo nnsoup-current-prefix 0)
-(defvoo nnsoup-replies-list nil)
-(defvoo nnsoup-buffers nil)
-(defvoo nnsoup-current-group nil)
-(defvoo nnsoup-group-alist-touched nil)
-(defvoo nnsoup-article-alist nil)
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nnsoup)
-
-(deffoo nnsoup-retrieve-headers (sequence &optional group server fetch-old)
- (nnsoup-possibly-change-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let ((areas (cddr (assoc nnsoup-current-group nnsoup-group-alist)))
- (articles sequence)
- (use-nov t)
- useful-areas this-area-seq msg-buf)
- (if (stringp (car sequence))
- ;; We don't support fetching by Message-ID.
- 'headers
- ;; We go through all the areas and find which files the
- ;; articles in SEQUENCE come from.
- (while (and areas sequence)
- ;; Peel off areas that are below sequence.
- (while (and areas (< (cdar (car areas)) (car sequence)))
- (setq areas (cdr areas)))
- (when areas
- ;; This is a useful area.
- (push (car areas) useful-areas)
- (setq this-area-seq nil)
- ;; We take note whether this MSG has a corresponding IDX
- ;; for later use.
- (when (or (= (gnus-soup-encoding-index
- (gnus-soup-area-encoding (nth 1 (car areas)))) ?n)
- (not (file-exists-p
- (nnsoup-file
- (gnus-soup-area-prefix (nth 1 (car areas)))))))
- (setq use-nov nil))
- ;; We assign the portion of `sequence' that is relevant to
- ;; this MSG packet to this packet.
- (while (and sequence (<= (car sequence) (cdar (car areas))))
- (push (car sequence) this-area-seq)
- (setq sequence (cdr sequence)))
- (setcar useful-areas (cons (nreverse this-area-seq)
- (car useful-areas)))))
-
- ;; We now have a list of article numbers and corresponding
- ;; areas.
- (setq useful-areas (nreverse useful-areas))
-
- ;; Two different approaches depending on whether all the MSG
- ;; files have corresponding IDX files. If they all do, we
- ;; simply return the relevant IDX files and let Gnus sort out
- ;; what lines are relevant. If some of the IDX files are
- ;; missing, we must return HEADs for all the articles.
- (if use-nov
- ;; We have IDX files for all areas.
- (progn
- (while useful-areas
- (goto-char (point-max))
- (let ((b (point))
- (number (car (nth 1 (car useful-areas))))
- (index-buffer (nnsoup-index-buffer
- (gnus-soup-area-prefix
- (nth 2 (car useful-areas))))))
- (when index-buffer
- (insert-buffer-substring index-buffer)
- (goto-char b)
- ;; We have to remove the index number entries and
- ;; insert article numbers instead.
- (while (looking-at "[0-9]+")
- (replace-match (int-to-string number) t t)
- (incf number)
- (forward-line 1))))
- (setq useful-areas (cdr useful-areas)))
- 'nov)
- ;; We insert HEADs.
- (while useful-areas
- (setq articles (caar useful-areas)
- useful-areas (cdr useful-areas))
- (while articles
- (when (setq msg-buf
- (nnsoup-narrow-to-article
- (car articles) (cdar useful-areas) 'head))
- (goto-char (point-max))
- (insert (format "221 %d Article retrieved.\n" (car articles)))
- (insert-buffer-substring msg-buf)
- (goto-char (point-max))
- (insert ".\n"))
- (setq articles (cdr articles))))
-
- (nnheader-fold-continuation-lines)
- 'headers)))))
-
-(deffoo nnsoup-open-server (server &optional defs)
- (nnoo-change-server 'nnsoup server defs)
- (when (not (file-exists-p nnsoup-directory))
- (condition-case ()
- (make-directory nnsoup-directory t)
- (error t)))
- (cond
- ((not (file-exists-p nnsoup-directory))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Couldn't create directory: %s" nnsoup-directory))
- ((not (file-directory-p (file-truename nnsoup-directory)))
- (nnsoup-close-server)
- (nnheader-report 'nnsoup "Not a directory: %s" nnsoup-directory))
- (t
- (nnsoup-read-active-file)
- (nnheader-report 'nnsoup "Opened server %s using directory %s"
- server nnsoup-directory)
- t)))
-
-(deffoo nnsoup-request-close ()
- (nnsoup-write-active-file)
- (nnsoup-write-replies)
- (gnus-soup-save-areas)
- ;; Kill all nnsoup buffers.
- (let (buffer)
- (while nnsoup-buffers
- (setq buffer (cdr (pop nnsoup-buffers)))
- (and buffer
- (buffer-name buffer)
- (kill-buffer buffer))))
- (setq nnsoup-group-alist nil
- nnsoup-group-alist-touched nil
- nnsoup-current-group nil
- nnsoup-replies-list nil)
- (nnoo-close-server 'nnoo)
- t)
-
-(deffoo nnsoup-request-article (id &optional newsgroup server buffer)
- (nnsoup-possibly-change-group newsgroup)
- (let (buf)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (when (and (not (stringp id))
- (setq buf (nnsoup-narrow-to-article id)))
- (insert-buffer-substring buf)
- t))))
-
-(deffoo nnsoup-request-group (group &optional server dont-check)
- (nnsoup-possibly-change-group group)
- (if dont-check
- t
- (let ((active (cadr (assoc group nnsoup-group-alist))))
- (if (not active)
- (nnheader-report 'nnsoup "No such group: %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n"
- (max (1+ (- (cdr active) (car active))) 0)
- (car active) (cdr active) group)))))
-
-(deffoo nnsoup-request-type (group &optional article)
- (nnsoup-possibly-change-group group)
- ;; Try to guess the type based on the first article in the group.
- (when (not article)
- (setq article
- (cdar (car (cddr (assoc group nnsoup-group-alist))))))
- (if (not article)
- 'unknown
- (let ((kind (gnus-soup-encoding-kind
- (gnus-soup-area-encoding
- (nth 1 (nnsoup-article-to-area
- article nnsoup-current-group))))))
- (cond ((= kind ?m) 'mail)
- ((= kind ?n) 'news)
- (t 'unknown)))))
-
-(deffoo nnsoup-close-group (group &optional server)
- ;; Kill all nnsoup buffers.
- (let ((buffers nnsoup-buffers)
- elem)
- (while buffers
- (when (equal (car (setq elem (pop buffers))) group)
- (setq nnsoup-buffers (delq elem nnsoup-buffers))
- (and (cdr elem) (buffer-name (cdr elem))
- (kill-buffer (cdr elem))))))
- t)
-
-(deffoo nnsoup-request-list (&optional server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (unless nnsoup-group-alist
- (nnsoup-read-active-file))
- (let ((alist nnsoup-group-alist)
- (standard-output (current-buffer))
- entry)
- (while (setq entry (pop alist))
- (insert (car entry) " ")
- (princ (cdadr entry))
- (insert " ")
- (princ (caadr entry))
- (insert " y\n"))
- t)))
-
-(deffoo nnsoup-request-scan (group &optional server)
- (nnsoup-unpack-packets))
-
-(deffoo nnsoup-request-newgroups (date &optional server)
- (nnsoup-request-list))
-
-(deffoo nnsoup-request-list-newsgroups (&optional server)
- nil)
-
-(deffoo nnsoup-request-post (&optional server)
- (nnsoup-store-reply "news")
- t)
-
-(deffoo nnsoup-request-mail (&optional server)
- (nnsoup-store-reply "mail")
- t)
-
-(deffoo nnsoup-request-expire-articles (articles group &optional server force)
- (nnsoup-possibly-change-group group)
- (let* ((total-infolist (assoc group nnsoup-group-alist))
- (active (cadr total-infolist))
- (infolist (cddr total-infolist))
- info range-list mod-time prefix)
- (while infolist
- (setq info (pop infolist)
- range-list (gnus-uncompress-range (car info))
- prefix (gnus-soup-area-prefix (nth 1 info)))
- (when;; All the articles in this file are marked for expiry.
- (and (or (setq mod-time (nth 5 (file-attributes
- (nnsoup-file prefix))))
- (setq mod-time (nth 5 (file-attributes
- (nnsoup-file prefix t)))))
- (gnus-sublist-p articles range-list)
- ;; This file is old enough.
- (nnmail-expired-article-p group mod-time force))
- ;; Ok, we delete this file.
- (when (ignore-errors
- (nnheader-message
- 5 "Deleting %s in group %s..." (nnsoup-file prefix)
- group)
- (when (file-exists-p (nnsoup-file prefix))
- (delete-file (nnsoup-file prefix)))
- (nnheader-message
- 5 "Deleting %s in group %s..." (nnsoup-file prefix t)
- group)
- (when (file-exists-p (nnsoup-file prefix t))
- (delete-file (nnsoup-file prefix t)))
- t)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))
- (setq articles (gnus-sorted-difference articles range-list))))
- (when (not mod-time)
- (setcdr (cdr total-infolist) (delq info (cddr total-infolist)))))
- (if (cddr total-infolist)
- (setcar active (caaadr (cdr total-infolist)))
- (setcar active (1+ (cdr active))))
- (nnsoup-write-active-file t)
- ;; Return the articles that weren't expired.
- articles))
-
-\f
-;;; Internal functions
-
-(defun nnsoup-possibly-change-group (group &optional force)
- (when (and group
- (not (equal nnsoup-current-group group)))
- (setq nnsoup-article-alist nil)
- (setq nnsoup-current-group group))
- t)
-
-(defun nnsoup-read-active-file ()
- (setq nnsoup-group-alist nil)
- (when (file-exists-p nnsoup-active-file)
- (ignore-errors
- (load nnsoup-active-file t t t))
- ;; Be backwards compatible.
- (when (and nnsoup-group-alist
- (not (atom (caadar nnsoup-group-alist))))
- (let ((alist nnsoup-group-alist)
- entry e min max)
- (while (setq e (cdr (setq entry (pop alist))))
- (setq min (caaar e))
- (while (cdr e)
- (setq e (cdr e)))
- (setq max (cdar (car e)))
- (setcdr entry (cons (cons min max) (cdr entry)))))
- (setq nnsoup-group-alist-touched t))
- nnsoup-group-alist))
-
-(defun nnsoup-write-active-file (&optional force)
- (when (and nnsoup-group-alist
- (or force
- nnsoup-group-alist-touched))
- (setq nnsoup-group-alist-touched nil)
- (with-temp-file nnsoup-active-file
- (gnus-prin1 `(setq nnsoup-group-alist ',nnsoup-group-alist))
- (insert "\n")
- (gnus-prin1 `(setq nnsoup-current-prefix ,nnsoup-current-prefix))
- (insert "\n"))))
-
-(defun nnsoup-next-prefix ()
- "Return the next free prefix."
- (let (prefix)
- (while (or (file-exists-p
- (nnsoup-file (setq prefix (int-to-string
- nnsoup-current-prefix))))
- (file-exists-p (nnsoup-file prefix t)))
- (incf nnsoup-current-prefix))
- (incf nnsoup-current-prefix)
- prefix))
-
-(defun nnsoup-file-name (dir file)
- "Return the full name of FILE (in any case) in DIR."
- (let* ((case-fold-search t)
- (files (directory-files dir t))
- (regexp (concat (regexp-quote file) "$")))
- (car (delq nil
- (mapcar
- (lambda (file)
- (if (string-match regexp file)
- file
- nil))
- files)))))
-
-(defun nnsoup-read-areas ()
- (let ((areas-file (nnsoup-file-name nnsoup-tmp-directory "areas")))
- (when areas-file
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let ((areas (gnus-soup-parse-areas areas-file))
- entry number area lnum cur-prefix file)
- ;; Go through all areas in the new AREAS file.
- (while (setq area (pop areas))
- ;; Change the name to the permanent name and move the files.
- (setq cur-prefix (nnsoup-next-prefix))
- (nnheader-message 5 "Incorporating file %s..." cur-prefix)
- (when (file-exists-p
- (setq file
- (expand-file-name
- (concat (gnus-soup-area-prefix area) ".IDX")
- nnsoup-tmp-directory)))
- (rename-file file (nnsoup-file cur-prefix)))
- (when (file-exists-p
- (setq file (expand-file-name
- (concat (gnus-soup-area-prefix area) ".MSG")
- nnsoup-tmp-directory)))
- (rename-file file (nnsoup-file cur-prefix t))
- (gnus-soup-set-area-prefix area cur-prefix)
- ;; Find the number of new articles in this area.
- (setq number (nnsoup-number-of-articles area))
- (if (not (setq entry (assoc (gnus-soup-area-name area)
- nnsoup-group-alist)))
- ;; If this is a new area (group), we just add this info to
- ;; the group alist.
- (push (list (gnus-soup-area-name area)
- (cons 1 number)
- (list (cons 1 number) area))
- nnsoup-group-alist)
- ;; There are already articles in this group, so we add this
- ;; info to the end of the entry.
- (nconc entry (list (list (cons (1+ (setq lnum (cdadr entry)))
- (+ lnum number))
- area)))
- (setcdr (cadr entry) (+ lnum number))))))
- (nnsoup-write-active-file t)
- (delete-file areas-file)))))
-
-(defun nnsoup-number-of-articles (area)
- (save-excursion
- (cond
- ;; If the number is in the area info, we just return it.
- ((gnus-soup-area-number area)
- (gnus-soup-area-number area))
- ;; If there is an index file, we just count the lines.
- ((/= (gnus-soup-encoding-index (gnus-soup-area-encoding area)) ?n)
- (set-buffer (nnsoup-index-buffer (gnus-soup-area-prefix area)))
- (count-lines (point-min) (point-max)))
- ;; We do it the hard way - re-searching through the message
- ;; buffer.
- (t
- (set-buffer (nnsoup-message-buffer (gnus-soup-area-prefix area)))
- (unless (assoc (gnus-soup-area-prefix area) nnsoup-article-alist)
- (nnsoup-dissect-buffer area))
- (length (cdr (assoc (gnus-soup-area-prefix area)
- nnsoup-article-alist)))))))
-
-(defun nnsoup-dissect-buffer (area)
- (let ((mbox-delim (concat "^" message-unix-mail-delimiter))
- (format (gnus-soup-encoding-format (gnus-soup-area-encoding area)))
- (i 0)
- alist len)
- (goto-char (point-min))
- (cond
- ;; rnews batch format
- ((or (= format ?u)
- (= format ?n)) ;; Gnus back compatibility.
- (while (looking-at "^#! *rnews \\(+[0-9]+\\) *$")
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (forward-char (string-to-number (match-string 1)))
- (point)))
- alist)))
- ;; Unix mbox format
- ((= format ?m)
- (while (looking-at mbox-delim)
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (if (re-search-forward mbox-delim nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- (point)))
- alist)))
- ;; MMDF format
- ((= format ?M)
- (while (looking-at "\^A\^A\^A\^A\n")
- (forward-line 1)
- (push (list
- (incf i) (point)
- (progn
- (if (search-forward "\n\^A\^A\^A\^A\n" nil t)
- (beginning-of-line)
- (goto-char (point-max)))
- (point)))
- alist)))
- ;; Binary format
- ((or (= format ?B) (= format ?b))
- (while (not (eobp))
- (setq len (+ (* (char-after (point)) (expt 2.0 24))
- (* (char-after (+ (point) 1)) (expt 2 16))
- (* (char-after (+ (point) 2)) (expt 2 8))
- (char-after (+ (point) 3))))
- (push (list
- (incf i) (+ (point) 4)
- (progn
- (forward-char (floor (+ len 4)))
- (point)))
- alist)))
- (t
- (error "Unknown format: %c" format)))
- (push (cons (gnus-soup-area-prefix area) alist) nnsoup-article-alist)))
-
-(defun nnsoup-index-buffer (prefix &optional message)
- (let* ((file (concat prefix (if message ".MSG" ".IDX")))
- (buffer-name (concat " *nnsoup " file "*")))
- (or (get-buffer buffer-name) ; File already loaded.
- (when (file-exists-p (expand-file-name file nnsoup-directory))
- (save-excursion ; Load the file.
- (set-buffer (get-buffer-create buffer-name))
- (buffer-disable-undo)
- (push (cons nnsoup-current-group (current-buffer)) nnsoup-buffers)
- (nnheader-insert-file-contents
- (expand-file-name file nnsoup-directory))
- (current-buffer))))))
-
-(defun nnsoup-file (prefix &optional message)
- (expand-file-name
- (concat prefix (if message ".MSG" ".IDX"))
- nnsoup-directory))
-
-(defun nnsoup-message-buffer (prefix)
- (nnsoup-index-buffer prefix 'msg))
-
-(defun nnsoup-unpack-packets ()
- "Unpack all packets in `nnsoup-packet-directory'."
- (let ((packets (directory-files
- nnsoup-packet-directory t nnsoup-packet-regexp))
- packet)
- (while (setq packet (pop packets))
- (nnheader-message 5 "nnsoup: unpacking %s..." packet)
- (if (not (gnus-soup-unpack-packet
- nnsoup-tmp-directory nnsoup-unpacker packet))
- (nnheader-message 5 "Couldn't unpack %s" packet)
- (delete-file packet)
- (nnsoup-read-areas)
- (nnheader-message 5 "Unpacking...done")))))
-
-(defun nnsoup-narrow-to-article (article &optional area head)
- (let* ((area (or area (nnsoup-article-to-area article nnsoup-current-group)))
- (prefix (and area (gnus-soup-area-prefix (nth 1 area))))
- (msg-buf (and prefix (nnsoup-index-buffer prefix 'msg)))
- beg end)
- (when area
- (save-excursion
- (cond
- ;; There is no MSG file.
- ((null msg-buf)
- nil)
- ;; We use the index file to find out where the article
- ;; begins and ends.
- ((and (= (gnus-soup-encoding-index
- (gnus-soup-area-encoding (nth 1 area)))
- ?c)
- (file-exists-p (nnsoup-file prefix)))
- (set-buffer (nnsoup-index-buffer prefix))
- (widen)
- (goto-char (point-min))
- (forward-line (- article (caar area)))
- (setq beg (read (current-buffer)))
- (forward-line 1)
- (if (looking-at "[0-9]+")
- (progn
- (setq end (read (current-buffer)))
- (set-buffer msg-buf)
- (widen)
- (let ((format (gnus-soup-encoding-format
- (gnus-soup-area-encoding (nth 1 area)))))
- (goto-char end)
- (when (or (= format ?u) (= format ?n) (= format ?m))
- (setq end (progn (forward-line -1) (point))))))
- (set-buffer msg-buf))
- (widen)
- (narrow-to-region beg (or end (point-max))))
- (t
- (set-buffer msg-buf)
- (widen)
- (unless (assoc (gnus-soup-area-prefix (nth 1 area))
- nnsoup-article-alist)
- (nnsoup-dissect-buffer (nth 1 area)))
- (let ((entry (assq article (cdr (assoc (gnus-soup-area-prefix
- (nth 1 area))
- nnsoup-article-alist)))))
- (when entry
- (narrow-to-region (cadr entry) (caddr entry))))))
- (goto-char (point-min))
- (if (not head)
- ()
- (narrow-to-region
- (point-min)
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max))))
- msg-buf))))
-
-;;;###autoload
-(defun nnsoup-pack-replies ()
- "Make an outbound package of SOUP replies."
- (interactive)
- (unless (file-exists-p nnsoup-replies-directory)
- (nnheader-message 5 "No such directory: %s" nnsoup-replies-directory))
- ;; Write all data buffers.
- (gnus-soup-save-areas)
- ;; Write the active file.
- (nnsoup-write-active-file)
- ;; Write the REPLIES file.
- (nnsoup-write-replies)
- ;; Check whether there is anything here.
- (when (null (directory-files nnsoup-replies-directory nil "\\.MSG$"))
- (error "No files to pack"))
- ;; Pack all these files into a SOUP packet.
- (gnus-soup-pack nnsoup-replies-directory nnsoup-packer))
-
-(defun nnsoup-write-replies ()
- "Write the REPLIES file."
- (when nnsoup-replies-list
- (gnus-soup-write-replies nnsoup-replies-directory nnsoup-replies-list)
- (setq nnsoup-replies-list nil)))
-
-(defun nnsoup-article-to-area (article group)
- "Return the area that ARTICLE in GROUP is located in."
- (let ((areas (cddr (assoc group nnsoup-group-alist))))
- (while (and areas (< (cdar (car areas)) article))
- (setq areas (cdr areas)))
- (and areas (car areas))))
-
-(defvar nnsoup-old-functions
- (list message-send-mail-real-function message-send-news-function))
-
-;;;###autoload
-(defun nnsoup-set-variables ()
- "Use the SOUP methods for posting news and mailing mail."
- (interactive)
- (setq message-send-news-function 'nnsoup-request-post)
- (setq message-send-mail-real-function 'nnsoup-request-mail))
-
-;;;###autoload
-(defun nnsoup-revert-variables ()
- "Revert posting and mailing methods to the standard Emacs methods."
- (interactive)
- (setq message-send-mail-real-function (car nnsoup-old-functions))
- (setq message-send-news-function (cadr nnsoup-old-functions)))
-
-(defun nnsoup-store-reply (kind)
- ;; Mostly stolen from `message.el'.
- (require 'mail-utils)
- (let ((tembuf (generate-new-buffer " message temp"))
- (case-fold-search nil)
- delimline
- (mailbuf (current-buffer)))
- (unwind-protect
- (save-excursion
- (save-restriction
- (message-narrow-to-headers)
- (if (equal kind "mail")
- (message-generate-headers message-required-mail-headers)
- (message-generate-headers message-required-news-headers)))
- (set-buffer tembuf)
- (erase-buffer)
- (insert-buffer-substring mailbuf)
- ;; Remove some headers.
- (save-restriction
- (message-narrow-to-headers)
- ;; Remove some headers.
- (message-remove-header message-ignored-mail-headers t))
- (goto-char (point-max))
- ;; require one newline at the end.
- (or (= (preceding-char) ?\n)
- (insert ?\n))
- (let ((case-fold-search t))
- ;; Change header-delimiter to be what sendmail expects.
- (goto-char (point-min))
- (re-search-forward
- (concat "^" (regexp-quote mail-header-separator) "\n"))
- (replace-match "\n")
- (backward-char 1)
- (setq delimline (point-marker))
- (goto-char (1+ delimline))
- (let ((msg-buf
- (gnus-soup-store
- nnsoup-replies-directory
- (nnsoup-kind-to-prefix kind) nil nnsoup-replies-format-type
- nnsoup-replies-index-type))
- (num 0))
- (when (and msg-buf (bufferp msg-buf))
- (save-excursion
- (set-buffer msg-buf)
- (goto-char (point-min))
- (while (re-search-forward "^#! *rnews" nil t)
- (incf num))
- (when nnsoup-always-save
- (save-buffer)))
- (nnheader-message 5 "Stored %d messages" num)))
- (nnsoup-write-replies)
- (kill-buffer tembuf))))))
-
-(defun nnsoup-kind-to-prefix (kind)
- (unless nnsoup-replies-list
- (setq nnsoup-replies-list
- (gnus-soup-parse-replies
- (expand-file-name "REPLIES" nnsoup-replies-directory))))
- (let ((replies nnsoup-replies-list))
- (while (and replies
- (not (string= kind (gnus-soup-reply-kind (car replies)))))
- (setq replies (cdr replies)))
- (if replies
- (gnus-soup-reply-prefix (car replies))
- (push (vector (gnus-soup-unique-prefix nnsoup-replies-directory)
- kind
- (format "%c%c%c"
- nnsoup-replies-format-type
- nnsoup-replies-index-type
- (if (string= kind "news")
- ?n ?m)))
- nnsoup-replies-list)
- (gnus-soup-reply-prefix (car nnsoup-replies-list)))))
-
-(defun nnsoup-make-active ()
- "(Re-)create the SOUP active file."
- (interactive)
- (let ((files (sort (directory-files nnsoup-directory t "IDX$")
- (lambda (f1 f2)
- (< (progn (string-match "/\\([0-9]+\\)\\." f1)
- (string-to-number (match-string 1 f1)))
- (progn (string-match "/\\([0-9]+\\)\\." f2)
- (string-to-number (match-string 1 f2)))))))
- active group lines ident elem min)
- (set-buffer (get-buffer-create " *nnsoup work*"))
- (while files
- (nnheader-message 5 "Doing %s..." (car files))
- (erase-buffer)
- (nnheader-insert-file-contents (car files))
- (goto-char (point-min))
- (if (not (re-search-forward "^[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t *\\(Xref: \\)? *[^ ]* \\([^ ]+\\):[0-9]" nil t))
- (setq group "unknown")
- (setq group (match-string 2)))
- (setq lines (count-lines (point-min) (point-max)))
- (setq ident (progn (string-match
- "/\\([0-9]+\\)\\." (car files))
- (substring
- (car files) (match-beginning 1)
- (match-end 1))))
- (if (not (setq elem (assoc group active)))
- (push (list group (cons 1 lines)
- (list (cons 1 lines)
- (vector ident group "ucm" "" lines)))
- active)
- (nconc elem
- (list
- (list (cons (1+ (setq min (cdadr elem)))
- (+ min lines))
- (vector ident group "ucm" "" lines))))
- (setcdr (cadr elem) (+ min lines)))
- (setq files (cdr files)))
- (nnheader-message 5 "")
- (setq nnsoup-group-alist active)
- (nnsoup-write-active-file t)))
-
-(defun nnsoup-delete-unreferenced-message-files ()
- "Delete any *.MSG and *.IDX files that aren't known by nnsoup."
- (interactive)
- (let* ((known (apply 'nconc (mapcar
- (lambda (ga)
- (mapcar
- (lambda (area)
- (gnus-soup-area-prefix (cadr area)))
- (cddr ga)))
- nnsoup-group-alist)))
- (regexp "\\.MSG$\\|\\.IDX$")
- (files (directory-files nnsoup-directory nil regexp))
- non-files file)
- ;; Find all files that aren't known by nnsoup.
- (while (setq file (pop files))
- (string-match regexp file)
- (unless (member (substring file 0 (match-beginning 0)) known)
- (push file non-files)))
- ;; Sort and delete the files.
- (setq non-files (sort non-files 'string<))
- (map-y-or-n-p "Delete file %s? "
- (lambda (file) (delete-file
- (expand-file-name file nnsoup-directory)))
- non-files)))
-
-(provide 'nnsoup)
-
-;;; arch-tag: b0451389-5703-4450-9425-f66f6b38c828
-;;; nnsoup.el ends here
+++ /dev/null
-;;; nnspool.el --- spool access for GNU Emacs
-
-;; Copyright (C) 1988, 1989, 1990, 1993, 1994, 1995, 1996, 1997, 1998,
-;; 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nntp)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnspool)
-
-(defvoo nnspool-inews-program news-inews-program
- "Program to post news.
-This is most commonly `inews' or `injnews'.")
-
-(defvoo nnspool-inews-switches '("-h" "-S")
- "Switches for nnspool-request-post to pass to `inews' for posting news.
-If you are using Cnews, you probably should set this variable to nil.")
-
-(defvoo nnspool-spool-directory
- (file-name-as-directory (if (boundp 'news-directory)
- (symbol-value 'news-directory)
- news-path))
- "Local news spool directory.")
-
-(defvoo nnspool-nov-directory (concat nnspool-spool-directory "over.view/")
- "Local news nov directory.")
-
-(defvoo nnspool-lib-dir
- (if (file-exists-p "/usr/lib/news/active")
- "/usr/lib/news/"
- "/var/lib/news/")
- "Where the local news library files are stored.")
-
-(defvoo nnspool-active-file (concat nnspool-lib-dir "active")
- "Local news active file.")
-
-(defvoo nnspool-newsgroups-file (concat nnspool-lib-dir "newsgroups")
- "Local news newsgroups file.")
-
-(defvoo nnspool-distributions-file (concat nnspool-lib-dir "distribs.pat")
- "Local news distributions file.")
-
-(defvoo nnspool-history-file (concat nnspool-lib-dir "history")
- "Local news history file.")
-
-(defvoo nnspool-active-times-file (concat nnspool-lib-dir "active.times")
- "Local news active date file.")
-
-(defvoo nnspool-large-newsgroup 50
- "The number of articles which indicates a large newsgroup.
-If the number of articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvoo nnspool-nov-is-evil nil
- "Non-nil means that nnspool will never return NOV lines instead of headers.")
-
-(defconst nnspool-sift-nov-with-sed nil
- "If non-nil, use sed to get the relevant portion from the overview file.
-If nil, nnspool will load the entire file into a buffer and process it
-there.")
-
-(defvoo nnspool-rejected-article-hook nil
- "*A hook that will be run when an article has been rejected by the server.")
-
-(defvoo nnspool-file-coding-system nnheader-file-coding-system
- "Coding system for nnspool.")
-
-\f
-
-(defconst nnspool-version "nnspool 2.0"
- "Version numbers of this version of NNSPOOL.")
-
-(defvoo nnspool-current-directory nil
- "Current news group directory.")
-
-(defvoo nnspool-current-group nil)
-(defvoo nnspool-status-string "")
-
-\f
-;;; Interface functions.
-
-(nnoo-define-basics nnspool)
-
-(deffoo nnspool-retrieve-headers (articles &optional group server fetch-old)
- "Retrieve the headers of ARTICLES."
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (when (nnspool-possibly-change-directory group)
- (let* ((number (length articles))
- (count 0)
- (default-directory nnspool-current-directory)
- (do-message (and (numberp nnspool-large-newsgroup)
- (> number nnspool-large-newsgroup)))
- (nnheader-file-coding-system nnspool-file-coding-system)
- file beg article ag)
- (if (and (numberp (car articles))
- (nnspool-retrieve-headers-with-nov articles fetch-old))
- ;; We successfully retrieved the NOV headers.
- 'nov
- ;; No NOV headers here, so we do it the hard way.
- (while (setq article (pop articles))
- (if (stringp article)
- ;; This is a Message-ID.
- (setq ag (nnspool-find-id article)
- file (and ag (nnspool-article-pathname
- (car ag) (cdr ag)))
- article (cdr ag))
- ;; This is an article in the current group.
- (setq file (int-to-string article)))
- ;; Insert the head of the article.
- (when (and file
- (file-exists-p file))
- (insert "221 ")
- (princ article (current-buffer))
- (insert " Article retrieved.\n")
- (setq beg (point))
- (inline (nnheader-insert-head file))
- (goto-char beg)
- (if (search-forward "\n\n" nil t)
- (progn
- (forward-char -1)
- (insert ".\n"))
- (goto-char (point-max))
- (if (bolp)
- (insert ".\n")
- (insert "\n.\n")))
- (delete-region (point) (point-max)))
-
- (and do-message
- (zerop (% (incf count) 20))
- (nnheader-message 5 "nnspool: Receiving headers... %d%%"
- (/ (* count 100) number))))
-
- (when do-message
- (nnheader-message 5 "nnspool: Receiving headers...done"))
-
- ;; Fold continuation lines.
- (nnheader-fold-continuation-lines)
- 'headers)))))
-
-(deffoo nnspool-open-server (server &optional defs)
- (nnoo-change-server 'nnspool server defs)
- (cond
- ((not (file-exists-p nnspool-spool-directory))
- (nnspool-close-server)
- (nnheader-report 'nnspool "Spool directory doesn't exist: %s"
- nnspool-spool-directory))
- ((not (file-directory-p
- (directory-file-name
- (file-truename nnspool-spool-directory))))
- (nnspool-close-server)
- (nnheader-report 'nnspool "Not a directory: %s" nnspool-spool-directory))
- ((not (file-exists-p nnspool-active-file))
- (nnheader-report 'nnspool "The active file doesn't exist: %s"
- nnspool-active-file))
- (t
- (nnheader-report 'nnspool "Opened server %s using directory %s"
- server nnspool-spool-directory)
- t)))
-
-(deffoo nnspool-request-article (id &optional group server buffer)
- "Select article by message ID (or number)."
- (nnspool-possibly-change-directory group)
- (let ((nntp-server-buffer (or buffer nntp-server-buffer))
- file ag)
- (if (stringp id)
- ;; This is a Message-ID.
- (when (setq ag (nnspool-find-id id))
- (setq file (nnspool-article-pathname (car ag) (cdr ag))))
- (setq file (nnspool-article-pathname nnspool-current-group id)))
- (and file
- (file-exists-p file)
- (not (file-directory-p file))
- (save-excursion (nnspool-find-file file))
- ;; We return the article number and group name.
- (if (numberp id)
- (cons nnspool-current-group id)
- ag))))
-
-(deffoo nnspool-request-body (id &optional group server)
- "Select article body by message ID (or number)."
- (nnspool-possibly-change-directory group)
- (let ((res (nnspool-request-article id)))
- (when res
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (point-min) (point)))
- res))))
-
-(deffoo nnspool-request-head (id &optional group server)
- "Select article head by message ID (or number)."
- (nnspool-possibly-change-directory group)
- (let ((res (nnspool-request-article id)))
- (when res
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (delete-region (1- (point)) (point-max)))
- (nnheader-fold-continuation-lines)))
- res))
-
-(deffoo nnspool-request-group (group &optional server dont-check)
- "Select news GROUP."
- (let ((pathname (nnspool-article-pathname group))
- dir)
- (if (not (file-directory-p pathname))
- (nnheader-report
- 'nnspool "Invalid group name (no such directory): %s" group)
- (setq nnspool-current-directory pathname)
- (nnheader-report 'nnspool "Selected group %s" group)
- (if dont-check
- (progn
- (nnheader-report 'nnspool "Selected group %s" group)
- t)
- ;; Yes, completely empty spool directories *are* possible.
- ;; Fix by Sudish Joseph <joseph@cis.ohio-state.edu>
- (when (setq dir (directory-files pathname nil "^[0-9]+$" t))
- (setq dir
- (sort (mapcar (lambda (name) (string-to-number name)) dir) '<)))
- (if dir
- (nnheader-insert
- "211 %d %d %d %s\n" (length dir) (car dir)
- (progn (while (cdr dir) (setq dir (cdr dir))) (car dir))
- group)
- (nnheader-report 'nnspool "Empty group %s" group)
- (nnheader-insert "211 0 0 0 %s\n" group))))))
-
-(deffoo nnspool-request-type (group &optional article)
- 'news)
-
-(deffoo nnspool-close-group (group &optional server)
- t)
-
-(deffoo nnspool-request-list (&optional server)
- "List active newsgroups."
- (save-excursion
- (or (nnspool-find-file nnspool-active-file)
- (nnheader-report 'nnspool (nnheader-file-error nnspool-active-file)))))
-
-(deffoo nnspool-request-list-newsgroups (&optional server)
- "List newsgroups (defined in NNTP2)."
- (save-excursion
- (or (nnspool-find-file nnspool-newsgroups-file)
- (nnheader-report 'nnspool (nnheader-file-error
- nnspool-newsgroups-file)))))
-
-(deffoo nnspool-request-list-distributions (&optional server)
- "List distributions (defined in NNTP2)."
- (save-excursion
- (or (nnspool-find-file nnspool-distributions-file)
- (nnheader-report 'nnspool (nnheader-file-error
- nnspool-distributions-file)))))
-
-;; Suggested by Hallvard B Furuseth <h.b.furuseth@usit.uio.no>.
-(deffoo nnspool-request-newgroups (date &optional server)
- "List groups created after DATE."
- (if (nnspool-find-file nnspool-active-times-file)
- (save-excursion
- ;; Find the last valid line.
- (goto-char (point-max))
- (while (and (not (looking-at
- "\\([^ ]+\\) +\\([0-9]+\\)[0-9][0-9][0-9] "))
- (zerop (forward-line -1))))
- (let ((seconds (time-to-seconds (date-to-time date)))
- groups)
- ;; Go through lines and add the latest groups to a list.
- (while (and (looking-at "\\([^ ]+\\) +[0-9]+ ")
- (progn
- ;; We insert a .0 to make the list reader
- ;; interpret the number as a float. It is far
- ;; too big to be stored in a lisp integer.
- (goto-char (1- (match-end 0)))
- (insert ".0")
- (> (progn
- (goto-char (match-end 1))
- (read (current-buffer)))
- seconds))
- (push (buffer-substring
- (match-beginning 1) (match-end 1))
- groups)
- (zerop (forward-line -1))))
- (erase-buffer)
- (while groups
- (insert (car groups) " 0 0 y\n")
- (setq groups (cdr groups))))
- t)
- nil))
-
-(deffoo nnspool-request-post (&optional server)
- "Post a new news in current buffer."
- (save-excursion
- (let* ((process-connection-type nil) ; t bugs out on Solaris
- (inews-buffer (generate-new-buffer " *nnspool post*"))
- (proc
- (condition-case err
- (apply 'start-process "*nnspool inews*" inews-buffer
- nnspool-inews-program nnspool-inews-switches)
- (error
- (nnheader-report 'nnspool "inews error: %S" err)))))
- (if (not proc)
- ;; The inews program failed.
- ()
- (nnheader-report 'nnspool "")
- (set-process-sentinel proc 'nnspool-inews-sentinel)
- (mm-with-unibyte-current-buffer
- (process-send-region proc (point-min) (point-max)))
- ;; We slap a condition-case around this, because the process may
- ;; have exited already...
- (ignore-errors
- (process-send-eof proc))
- t))))
-
-
-\f
-;;; Internal functions.
-
-(defun nnspool-inews-sentinel (proc status)
- (save-excursion
- (set-buffer (process-buffer proc))
- (goto-char (point-min))
- (if (or (zerop (buffer-size))
- (search-forward "spooled" nil t))
- (kill-buffer (current-buffer))
- ;; Make status message by folding lines.
- (while (re-search-forward "[ \t\n]+" nil t)
- (replace-match " " t t))
- (nnheader-report 'nnspool "%s" (buffer-string))
- (nnheader-message 5 "nnspool: %s" nnspool-status-string)
- (ding)
- (run-hooks 'nnspool-rejected-article-hook))))
-
-(defun nnspool-retrieve-headers-with-nov (articles &optional fetch-old)
- (if (or gnus-nov-is-evil nnspool-nov-is-evil)
- nil
- (let ((nov (nnheader-group-pathname
- nnspool-current-group nnspool-nov-directory ".overview"))
- (arts articles)
- (nnheader-file-coding-system nnspool-file-coding-system)
- last)
- (if (not (file-exists-p nov))
- ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (if nnspool-sift-nov-with-sed
- (nnspool-sift-nov-with-sed articles nov)
- (nnheader-insert-file-contents nov)
- (if (and fetch-old
- (not (numberp fetch-old)))
- t ; We want all the headers.
- (ignore-errors
- ;; Delete unwanted NOV lines.
- (nnheader-nov-delete-outside-range
- (if fetch-old (max 1 (- (car articles) fetch-old))
- (car articles))
- (car (last articles)))
- ;; If the buffer is empty, this wasn't very successful.
- (unless (zerop (buffer-size))
- ;; We check what the last article number was.
- ;; The NOV file may be out of sync with the articles
- ;; in the group.
- (forward-line -1)
- (setq last (read (current-buffer)))
- (if (= last (car articles))
- ;; Yup, it's all there.
- t
- ;; Perhaps not. We try to find the missing articles.
- (while (and arts
- (<= last (car arts)))
- (pop arts))
- ;; The articles in `arts' are missing from the buffer.
- (while arts
- (nnspool-insert-nov-head (pop arts)))
- t))))))))))
-
-(defun nnspool-insert-nov-head (article)
- "Read the head of ARTICLE, convert to NOV headers, and insert."
- (save-excursion
- (let ((cur (current-buffer))
- buf)
- (setq buf (nnheader-set-temp-buffer " *nnspool head*"))
- (when (nnheader-insert-head
- (nnspool-article-pathname nnspool-current-group article))
- (nnheader-insert-article-line article)
- (let ((headers (nnheader-parse-head)))
- (set-buffer cur)
- (goto-char (point-max))
- (nnheader-insert-nov headers)))
- (kill-buffer buf))))
-
-(defun nnspool-sift-nov-with-sed (articles file)
- (let ((first (car articles))
- (last (progn (while (cdr articles) (setq articles (cdr articles)))
- (car articles))))
- (call-process "awk" nil t nil
- (format "BEGIN {firstmsg=%d; lastmsg=%d;}\n $1 >= firstmsg && $1 <= lastmsg {print;}"
- (1- first) (1+ last))
- file)))
-
-;; Fixed by fdc@cliwe.ping.de (Frank D. Cringle).
-;; Find out what group an article identified by a Message-ID is in.
-(defun nnspool-find-id (id)
- (save-excursion
- (set-buffer (get-buffer-create " *nnspool work*"))
- (erase-buffer)
- (ignore-errors
- (call-process "grep" nil t nil (regexp-quote id) nnspool-history-file))
- (goto-char (point-min))
- (prog1
- (when (looking-at "<[^>]+>[ \t]+[-0-9~]+[ \t]+\\([^ /\t\n]+\\)/\\([0-9]+\\)[ \t\n]")
- (cons (match-string 1) (string-to-number (match-string 2))))
- (kill-buffer (current-buffer)))))
-
-(defun nnspool-find-file (file)
- "Insert FILE in server buffer safely."
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (condition-case ()
- (let ((coding-system-for-read nnspool-file-coding-system))
- (mm-insert-file-contents file)
- t)
- (file-error nil)))
-
-(defun nnspool-possibly-change-directory (group)
- (if (not group)
- t
- (let ((pathname (nnspool-article-pathname group)))
- (if (file-directory-p pathname)
- (setq nnspool-current-directory pathname
- nnspool-current-group group)
- (nnheader-report 'nnspool "No such newsgroup: %s" group)))))
-
-(defun nnspool-article-pathname (group &optional article)
- "Find the file name for GROUP."
- (nnheader-group-pathname group nnspool-spool-directory article))
-
-(provide 'nnspool)
-
-;;; arch-tag: bdac8d27-2934-4eee-bad0-49e6b90c0d05
-;;; nnspool.el ends here
+++ /dev/null
-;;; nntp.el --- nntp access for Gnus
-
-;; Copyright (C) 1987, 1988, 1989, 1990, 1992, 1993,
-;; 1994, 1995, 1996, 1997, 1998, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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, 51 Franklin Street, Fifth Floor, Boston,
-;; MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'nnheader)
-(require 'nnoo)
-(require 'gnus-util)
-
-(nnoo-declare nntp)
-
-(eval-when-compile (require 'cl))
-
-(defgroup nntp nil
- "NNTP access for Gnus."
- :group 'gnus)
-
-(defvoo nntp-address nil
- "Address of the physical nntp server.")
-
-(defvoo nntp-port-number "nntp"
- "Port number on the physical nntp server.")
-
-(defvoo nntp-server-opened-hook '(nntp-send-mode-reader)
- "*Hook used for sending commands to the server at startup.
-The default value is `nntp-send-mode-reader', which makes an innd
-server spawn an nnrpd server.")
-
-(defvoo nntp-authinfo-function 'nntp-send-authinfo
- "Function used to send AUTHINFO to the server.
-It is called with no parameters.")
-
-(defvoo nntp-server-action-alist
- '(("nntpd 1\\.5\\.11t"
- (remove-hook 'nntp-server-opened-hook 'nntp-send-mode-reader))
- ("NNRP server Netscape"
- (setq nntp-server-list-active-group nil)))
- "Alist of regexps to match on server types and actions to be taken.
-For instance, if you want Gnus to beep every time you connect
-to innd, you could say something like:
-
-\(setq nntp-server-action-alist
- '((\"innd\" (ding))))
-
-You probably don't want to do that, though.")
-
-(defvoo nntp-open-connection-function 'nntp-open-network-stream
- "*Function used for connecting to a remote system.
-It will be called with the buffer to output in as argument.
-
-Currently, five such functions are provided (please refer to their
-respective doc string for more information), three of them establishing
-direct connections to the nntp server, and two of them using an indirect
-host.
-
-Direct connections:
-- `nntp-open-network-stream' (the default),
-- `nntp-open-ssl-stream',
-- `nntp-open-tls-stream',
-- `nntp-open-telnet-stream'.
-
-Indirect connections:
-- `nntp-open-via-rlogin-and-telnet',
-- `nntp-open-via-telnet-and-telnet'.")
-
-(defvoo nntp-never-echoes-commands nil
- "*Non-nil means the nntp server never echoes commands.
-It is reported that some nntps server doesn't echo commands. So, you
-may want to set this to non-nil in the method for such a server setting
-`nntp-open-connection-function' to `nntp-open-ssl-stream' for example.
-Note that the `nntp-open-connection-functions-never-echo-commands'
-variable overrides the nil value of this variable.")
-
-(defvoo nntp-open-connection-functions-never-echo-commands
- '(nntp-open-network-stream)
- "*List of functions that never echo commands.
-Add or set a function which you set to `nntp-open-connection-function'
-to this list if it does not echo commands. Note that a non-nil value
-of the `nntp-never-echoes-commands' variable overrides this variable.")
-
-(defvoo nntp-pre-command nil
- "*Pre-command to use with the various nntp-open-via-* methods.
-This is where you would put \"runsocks\" or stuff like that.")
-
-(defvoo nntp-telnet-command "telnet"
- "*Telnet command used to connect to the nntp server.
-This command is used by the various nntp-open-via-* methods.")
-
-(defvoo nntp-telnet-switches '("-8")
- "*Switches given to the telnet command `nntp-telnet-command'.")
-
-(defvoo nntp-end-of-line "\r\n"
- "*String to use on the end of lines when talking to the NNTP server.
-This is \"\\r\\n\" by default, but should be \"\\n\" when
-using an indirect connection method (nntp-open-via-*).")
-
-(defvoo nntp-via-rlogin-command "rsh"
- "*Rlogin command used to connect to an intermediate host.
-This command is used by the `nntp-open-via-rlogin-and-telnet' method.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
-
-(defvoo nntp-via-rlogin-command-switches nil
- "*Switches given to the rlogin command `nntp-via-rlogin-command'.
-If you use \"ssh\" for `nntp-via-rlogin-command', you may set this to
-\(\"-C\") in order to compress all data connections, otherwise set this
-to \(\"-t\" \"-e\" \"none\") or (\"-C\" \"-t\" \"-e\" \"none\") if the telnet
-command requires a pseudo-tty allocation on an intermediate host.")
-
-(defvoo nntp-via-telnet-command "telnet"
- "*Telnet command used to connect to an intermediate host.
-This command is used by the `nntp-open-via-telnet-and-telnet' method.")
-
-(defvoo nntp-via-telnet-switches '("-8")
- "*Switches given to the telnet command `nntp-via-telnet-command'.")
-
-(defvoo nntp-via-user-name nil
- "*User name to log in on an intermediate host with.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
-
-(defvoo nntp-via-user-password nil
- "*Password to use to log in on an intermediate host with.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
-
-(defvoo nntp-via-address nil
- "*Address of an intermediate host to connect to.
-This variable is used by the `nntp-open-via-rlogin-and-telnet' and
-`nntp-open-via-telnet-and-telnet' methods.")
-
-(defvoo nntp-via-envuser nil
- "*Whether both telnet client and server support the ENVIRON option.
-If non-nil, there will be no prompt for a login name.")
-
-(defvoo nntp-via-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
- "*Regular expression to match the shell prompt on an intermediate host.
-This variable is used by the `nntp-open-via-telnet-and-telnet' method.")
-
-(defvoo nntp-large-newsgroup 50
- "*The number of articles which indicates a large newsgroup.
-If the number of articles is greater than the value, verbose
-messages will be shown to indicate the current status.")
-
-(defvoo nntp-maximum-request 400
- "*The maximum number of the requests sent to the NNTP server at one time.
-If Emacs hangs up while retrieving headers, set the variable to a
-lower value.")
-
-(defvoo nntp-nov-is-evil nil
- "*If non-nil, nntp will never attempt to use XOVER when talking to the server.")
-
-(defvoo nntp-xover-commands '("XOVER" "XOVERVIEW")
- "*List of strings that are used as commands to fetch NOV lines from a server.
-The strings are tried in turn until a positive response is gotten. If
-none of the commands are successful, nntp will just grab headers one
-by one.")
-
-(defvoo nntp-nov-gap 5
- "*Maximum allowed gap between two articles.
-If the gap between two consecutive articles is bigger than this
-variable, split the XOVER request into two requests.")
-
-(defvoo nntp-xref-number-is-evil nil
- "*If non-nil, Gnus never trusts article numbers in the Xref header.
-Some news servers, e.g., ones running Diablo, run multiple engines
-having the same articles but article numbers are not kept synchronized
-between them. If you connect to such a server, set this to a non-nil
-value, and Gnus never uses article numbers (that appear in the Xref
-header and vary by which engine is chosen) to refer to articles.")
-
-(defvoo nntp-prepare-server-hook nil
- "*Hook run before a server is opened.
-If can be used to set up a server remotely, for instance. Say you
-have an account at the machine \"other.machine\". This machine has
-access to an NNTP server that you can't access locally. You could
-then use this hook to rsh to the remote machine and start a proxy NNTP
-server there that you can connect to. See also
-`nntp-open-connection-function'")
-
-(defvoo nntp-coding-system-for-read 'binary
- "*Coding system to read from NNTP.")
-
-(defvoo nntp-coding-system-for-write 'binary
- "*Coding system to write to NNTP.")
-
-(defcustom nntp-authinfo-file "~/.authinfo"
- ".netrc-like file that holds nntp authinfo passwords."
- :group 'nntp
- :type
- '(choice file
- (repeat :tag "Entries"
- :menu-tag "Inline"
- (list :format "%v"
- :value ("" ("login" . "") ("password" . ""))
- (string :tag "Host")
- (checklist :inline t
- (cons :format "%v"
- (const :format "" "login")
- (string :format "Login: %v"))
- (cons :format "%v"
- (const :format "" "password")
- (string :format "Password: %v")))))))
-
-\f
-
-(defvoo nntp-connection-timeout nil
- "*Number of seconds to wait before an nntp connection times out.
-If this variable is nil, which is the default, no timers are set.
-NOTE: This variable is never seen to work in Emacs 20 and XEmacs 21.")
-
-(defvoo nntp-prepare-post-hook nil
- "*Hook run just before posting an article. It is supposed to be used
-to insert Cancel-Lock headers.")
-
-;;; Internal variables.
-
-(defvar nntp-record-commands nil
- "*If non-nil, nntp will record all commands in the \"*nntp-log*\" buffer.")
-
-(defvar nntp-have-messaged nil)
-
-(defvar nntp-process-wait-for nil)
-(defvar nntp-process-to-buffer nil)
-(defvar nntp-process-callback nil)
-(defvar nntp-process-decode nil)
-(defvar nntp-process-start-point nil)
-(defvar nntp-inside-change-function nil)
-(defvoo nntp-last-command-time nil)
-(defvoo nntp-last-command nil)
-(defvoo nntp-authinfo-password nil)
-(defvoo nntp-authinfo-user nil)
-
-(defvar nntp-connection-list nil)
-
-(defvoo nntp-server-type nil)
-(defvoo nntp-connection-alist nil)
-(defvoo nntp-status-string "")
-(defconst nntp-version "nntp 5.0")
-(defvoo nntp-inhibit-erase nil)
-(defvoo nntp-inhibit-output nil)
-
-(defvoo nntp-server-xover 'try)
-(defvoo nntp-server-list-active-group 'try)
-
-(defvar nntp-async-needs-kluge
- (string-match "^GNU Emacs 20\\.3\\." (emacs-version))
- "*When non-nil, nntp will poll asynchronous connections
-once a second. By default, this is turned on only for Emacs
-20.3, which has a bug that breaks nntp's normal method of
-noticing asynchronous data.")
-
-(defvar nntp-async-timer nil)
-(defvar nntp-async-process-list nil)
-
-(defvar nntp-ssl-program
- "openssl s_client -quiet -ssl3 -connect %s:%p"
-"A string containing commands for SSL connections.
-Within a string, %s is replaced with the server address and %p with
-port number on server. The program should accept IMAP commands on
-stdin and return responses to stdout.")
-
-(defvar nntp-authinfo-rejected nil
-"A custom error condition used to report 'Authentication Rejected' errors.
-Condition handlers that match just this condition ensure that the nntp
-backend doesn't catch this error.")
-(put 'nntp-authinfo-rejected 'error-conditions '(error nntp-authinfo-rejected))
-(put 'nntp-authinfo-rejected 'error-message "Authorization Rejected")
-
-\f
-
-;;; Internal functions.
-
-(defsubst nntp-send-string (process string)
- "Send STRING to PROCESS."
- ;; We need to store the time to provide timeouts, and
- ;; to store the command so the we can replay the command
- ;; if the server gives us an AUTHINFO challenge.
- (setq nntp-last-command-time (current-time)
- nntp-last-command string)
- (when nntp-record-commands
- (nntp-record-command string))
- (process-send-string process (concat string nntp-end-of-line))
- (or (memq (process-status process) '(open run))
- (nntp-report "Server closed connection")))
-
-(defun nntp-record-command (string)
- "Record the command STRING."
- (save-excursion
- (set-buffer (get-buffer-create "*nntp-log*"))
- (goto-char (point-max))
- (let ((time (current-time)))
- (insert (format-time-string "%Y%m%dT%H%M%S" time)
- "." (format "%03d" (/ (nth 2 time) 1000))
- " " nntp-address " " string "\n"))))
-
-(defun nntp-report (&rest args)
- "Report an error from the nntp backend. The first string in ARGS
-can be a format string. For some commands, the failed command may be
-retried once before actually displaying the error report."
-
- (when nntp-record-commands
- (nntp-record-command "*** CALLED nntp-report ***"))
-
- (nnheader-report 'nntp args)
-
- (apply 'error args))
-
-(defun nntp-report-1 (&rest args)
- "Throws out to nntp-with-open-group-error so that the connection may
-be restored and the command retried."
-
- (when nntp-record-commands
- (nntp-record-command "*** CONNECTION LOST ***"))
-
- (throw 'nntp-with-open-group-error t))
-
-(defsubst nntp-wait-for (process wait-for buffer &optional decode discard)
- "Wait for WAIT-FOR to arrive from PROCESS."
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-min))
- (while (and (or (not (memq (char-after (point)) '(?2 ?3 ?4 ?5)))
- (looking-at "48[02]"))
- (memq (process-status process) '(open run)))
- (cond ((looking-at "480")
- (nntp-handle-authinfo process))
- ((looking-at "482")
- (nnheader-report 'nntp (get 'nntp-authinfo-rejected 'error-message))
- (signal 'nntp-authinfo-rejected nil))
- ((looking-at "^.*\n")
- (delete-region (point) (progn (forward-line 1) (point)))))
- (nntp-accept-process-output process)
- (goto-char (point-min)))
- (prog1
- (cond
- ((looking-at "[45]")
- (progn
- (nntp-snarf-error-message)
- nil))
- ((not (memq (process-status process) '(open run)))
- (nntp-report "Server closed connection"))
- (t
- (goto-char (point-max))
- (let ((limit (point-min))
- response)
- (while (not (re-search-backward wait-for limit t))
- (nntp-accept-process-output process)
- ;; We assume that whatever we wait for is less than 1000
- ;; characters long.
- (setq limit (max (- (point-max) 1000) (point-min)))
- (goto-char (point-max)))
- (setq response (match-string 0))
- (with-current-buffer nntp-server-buffer
- (setq nntp-process-response response)))
- (nntp-decode-text (not decode))
- (unless discard
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (insert-buffer-substring (process-buffer process))
- ;; Nix out "nntp reading...." message.
- (when nntp-have-messaged
- (setq nntp-have-messaged nil)
- (nnheader-message 5 ""))))
- t))
- (unless discard
- (erase-buffer)))))
-
-(defun nntp-kill-buffer (buffer)
- (when (buffer-name buffer)
- (kill-buffer buffer)
- (nnheader-init-server-buffer)))
-
-(defsubst nntp-find-connection (buffer)
- "Find the connection delivering to BUFFER."
- (let ((alist nntp-connection-alist)
- (buffer (if (stringp buffer) (get-buffer buffer) buffer))
- process entry)
- (while (and alist (setq entry (pop alist)))
- (when (eq buffer (cadr entry))
- (setq process (car entry)
- alist nil)))
- (when process
- (if (memq (process-status process) '(open run))
- process
- (nntp-kill-buffer (process-buffer process))
- (setq nntp-connection-alist (delq entry nntp-connection-alist))
- nil))))
-
-(defsubst nntp-find-connection-entry (buffer)
- "Return the entry for the connection to BUFFER."
- (assq (nntp-find-connection buffer) nntp-connection-alist))
-
-(defun nntp-find-connection-buffer (buffer)
- "Return the process connection buffer tied to BUFFER."
- (let ((process (nntp-find-connection buffer)))
- (when process
- (process-buffer process))))
-
-(defsubst nntp-retrieve-data (command address port buffer
- &optional wait-for callback decode)
- "Use COMMAND to retrieve data into BUFFER from PORT on ADDRESS."
- (let ((process (or (nntp-find-connection buffer)
- (nntp-open-connection buffer))))
- (if process
- (progn
- (unless (or nntp-inhibit-erase nnheader-callback-function)
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)))
- (condition-case err
- (progn
- (when command
- (nntp-send-string process command))
- (cond
- ((eq callback 'ignore)
- t)
- ((and callback wait-for)
- (nntp-async-wait process wait-for buffer decode callback)
- t)
- (wait-for
- (nntp-wait-for process wait-for buffer decode))
- (t t)))
- (nntp-authinfo-rejected
- (signal 'nntp-authinfo-rejected (cdr err)))
- (error
- (nnheader-report 'nntp "Couldn't open connection to %s: %s"
- address err))
- (quit
- (message "Quit retrieving data from nntp")
- (signal 'quit nil)
- nil)))
- (nnheader-report 'nntp "Couldn't open connection to %s" address))))
-
-(defsubst nntp-send-command (wait-for &rest strings)
- "Send STRINGS to server and wait until WAIT-FOR returns."
- (when (and (not nnheader-callback-function)
- (not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
- (let* ((command (mapconcat 'identity strings " "))
- (process (nntp-find-connection nntp-server-buffer))
- (buffer (and process (process-buffer process)))
- (pos (and buffer (with-current-buffer buffer (point)))))
- (if process
- (prog1
- (nntp-retrieve-data command
- nntp-address nntp-port-number
- nntp-server-buffer
- wait-for nnheader-callback-function)
- ;; If nothing to wait for, still remove possibly echo'ed commands.
- ;; We don't have echoes if `nntp-never-echoes-commands' is non-nil
- ;; or the value of `nntp-open-connection-function' is in
- ;; `nntp-open-connection-functions-never-echo-commands', so we
- ;; skip this in that cases.
- (unless (or wait-for
- nntp-never-echoes-commands
- (memq
- nntp-open-connection-function
- nntp-open-connection-functions-never-echo-commands))
- (nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol))))
- )))
- (nnheader-report 'nntp "Couldn't open connection to %s."
- nntp-address))))
-
-(defun nntp-send-command-nodelete (wait-for &rest strings)
- "Send STRINGS to server and wait until WAIT-FOR returns."
- (let* ((command (mapconcat 'identity strings " "))
- (process (nntp-find-connection nntp-server-buffer))
- (buffer (and process (process-buffer process)))
- (pos (and buffer (with-current-buffer buffer (point)))))
- (if process
- (prog1
- (nntp-retrieve-data command
- nntp-address nntp-port-number
- nntp-server-buffer
- wait-for nnheader-callback-function)
- ;; If nothing to wait for, still remove possibly echo'ed commands
- (unless wait-for
- (nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1)
- (gnus-point-at-bol)))))))
- (nnheader-report 'nntp "Couldn't open connection to %s."
- nntp-address))))
-
-(defun nntp-send-command-and-decode (wait-for &rest strings)
- "Send STRINGS to server and wait until WAIT-FOR returns."
- (when (and (not nnheader-callback-function)
- (not nntp-inhibit-output))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)))
- (let* ((command (mapconcat 'identity strings " "))
- (process (nntp-find-connection nntp-server-buffer))
- (buffer (and process (process-buffer process)))
- (pos (and buffer (with-current-buffer buffer (point)))))
- (if process
- (prog1
- (nntp-retrieve-data command
- nntp-address nntp-port-number
- nntp-server-buffer
- wait-for nnheader-callback-function t)
- ;; If nothing to wait for, still remove possibly echo'ed commands
- (unless wait-for
- (nntp-accept-response)
- (save-excursion
- (set-buffer buffer)
- (goto-char pos)
- (if (looking-at (regexp-quote command))
- (delete-region pos (progn (forward-line 1) (gnus-point-at-bol))))
- )))
- (nnheader-report 'nntp "Couldn't open connection to %s."
- nntp-address))))
-
-
-(defun nntp-send-buffer (wait-for)
- "Send the current buffer to server and wait until WAIT-FOR returns."
- (when (and (not nnheader-callback-function)
- (not nntp-inhibit-output))
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)))
- (nntp-encode-text)
- (mm-with-unibyte-current-buffer
- ;; Some encoded unicode text contains character 0x80-0x9f e.g. Euro.
- (process-send-region (nntp-find-connection nntp-server-buffer)
- (point-min) (point-max)))
- (nntp-retrieve-data
- nil nntp-address nntp-port-number nntp-server-buffer
- wait-for nnheader-callback-function))
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nntp)
-
-(defsubst nntp-next-result-arrived-p ()
- (cond
- ;; A result that starts with a 2xx code is terminated by
- ;; a line with only a "." on it.
- ((eq (char-after) ?2)
- (if (re-search-forward "\n\\.\r?\n" nil t)
- t
- nil))
- ;; A result that starts with a 3xx or 4xx code is terminated
- ;; by a newline.
- ((looking-at "[34]")
- (if (search-forward "\n" nil t)
- t
- nil))
- ;; No result here.
- (t
- nil)))
-
-(eval-when-compile
- (defvar nntp-with-open-group-internal nil)
- (defvar nntp-report-n nil))
-
-(defmacro nntp-with-open-group (group server &optional connectionless &rest forms)
- "Protect against servers that don't like clients that keep idle connections opens.
-The problem being that these servers may either close a connection or
-simply ignore any further requests on a connection. Closed
-connections are not detected until accept-process-output has updated
-the process-status. Dropped connections are not detected until the
-connection timeouts (which may be several minutes) or
-nntp-connection-timeout has expired. When these occur
-nntp-with-open-group, opens a new connection then re-issues the NNTP
-command whose response triggered the error."
- (when (and (listp connectionless)
- (not (eq connectionless nil)))
- (setq forms (cons connectionless forms)
- connectionless nil))
- `(letf ((nntp-report-n (symbol-function 'nntp-report))
- ((symbol-function 'nntp-report) (symbol-function 'nntp-report-1))
- (nntp-with-open-group-internal nil))
- (while (catch 'nntp-with-open-group-error
- ;; Open the connection to the server
- ;; NOTE: Existing connections are NOT tested.
- (nntp-possibly-change-group ,group ,server ,connectionless)
-
- (let ((timer
- (and nntp-connection-timeout
- (nnheader-run-at-time
- nntp-connection-timeout nil
- '(lambda ()
- (let ((process (nntp-find-connection
- nntp-server-buffer))
- (buffer (and process
- (process-buffer process))))
- ;; When I an able to identify the
- ;; connection to the server AND I've
- ;; received NO reponse for
- ;; nntp-connection-timeout seconds.
- (when (and buffer (eq 0 (buffer-size buffer)))
- ;; Close the connection. Take no
- ;; other action as the accept input
- ;; code will handle the closed
- ;; connection.
- (nntp-kill-buffer buffer))))))))
- (unwind-protect
- (setq nntp-with-open-group-internal
- (condition-case nil
- (progn ,@forms)
- (quit
- (nntp-close-server)
- (signal 'quit nil))))
- (when timer
- (nnheader-cancel-timer timer)))
- nil))
- (setf (symbol-function 'nntp-report) nntp-report-n))
- nntp-with-open-group-internal))
-
-(deffoo nntp-retrieve-headers (articles &optional group server fetch-old)
- "Retrieve the headers of ARTICLES."
- (nntp-with-open-group
- group server
- (save-excursion
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- (erase-buffer)
- (if (and (not gnus-nov-is-evil)
- (not nntp-nov-is-evil)
- (nntp-retrieve-headers-with-xover articles fetch-old))
- ;; We successfully retrieved the headers via XOVER.
- 'nov
- ;; XOVER didn't work, so we do it the hard, slow and inefficient
- ;; way.
- (let ((number (length articles))
- (articles articles)
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- article)
- ;; Send HEAD commands.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "HEAD" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving headers... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving headers...done"))
-
- ;; Now all of replies are received. Fold continuation lines.
- (nnheader-fold-continuation-lines)
- ;; Remove all "\r"'s.
- (nnheader-strip-cr)
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'headers)))))
-
-(deffoo nntp-retrieve-groups (groups &optional server)
- "Retrieve group info on GROUPS."
- (nntp-with-open-group
- nil server
- (when (nntp-find-connection-buffer nntp-server-buffer)
- (catch 'done
- (save-excursion
- ;; Erase nntp-server-buffer before nntp-inhibit-erase.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (set-buffer (nntp-find-connection-buffer nntp-server-buffer))
- ;; The first time this is run, this variable is `try'. So we
- ;; try.
- (when (eq nntp-server-list-active-group 'try)
- (nntp-try-list-active (car groups)))
- (erase-buffer)
- (let ((count 0)
- (groups groups)
- (received 0)
- (last-point (point-min))
- (nntp-inhibit-erase t)
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (command (if nntp-server-list-active-group
- "LIST ACTIVE" "GROUP")))
- (while groups
- ;; Timeout may have killed the buffer.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- ;; Send the command to the server.
- (nntp-send-command nil command (pop groups))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null groups) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (and (gnus-buffer-live-p buf)
- (progn
- ;; Search `blue moon' in this file for the
- ;; reason why set-buffer here.
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (re-search-forward "^[0-9]" nil t)
- (incf received))
- (setq last-point (point))
- (< received count)))
- (nntp-accept-response))))
-
- ;; Wait for the reply from the final command.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- (set-buffer buf)
- (goto-char (point-max))
- (re-search-backward "^[0-9]" nil t)
- (when (looking-at "^[23]")
- (while (and (gnus-buffer-live-p buf)
- (progn
- (set-buffer buf)
- (goto-char (point-max))
- (if (not nntp-server-list-active-group)
- (not (re-search-backward "\r?\n"
- (- (point) 3) t))
- (not (re-search-backward "^\\.\r?\n"
- (- (point) 4) t)))))
- (nntp-accept-response)))
-
- ;; Now all replies are received. We remove CRs.
- (unless (gnus-buffer-live-p buf)
- (nnheader-report 'nntp "Connection to %s is closed." server)
- (throw 'done nil))
- (set-buffer buf)
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
-
- (if (not nntp-server-list-active-group)
- (progn
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'group)
- ;; We have read active entries, so we just delete the
- ;; superfluous gunk.
- (goto-char (point-min))
- (while (re-search-forward "^[.2-5]" nil t)
- (delete-region (match-beginning 0)
- (progn (forward-line 1) (point))))
- (copy-to-buffer nntp-server-buffer (point-min) (point-max))
- 'active)))))))
-
-(deffoo nntp-retrieve-articles (articles &optional group server)
- (nntp-with-open-group
- group server
- (save-excursion
- (let ((number (length articles))
- (articles articles)
- (count 0)
- (received 0)
- (last-point (point-min))
- (buf (nntp-find-connection-buffer nntp-server-buffer))
- (nntp-inhibit-erase t)
- (map (apply 'vector articles))
- (point 1)
- article)
- (set-buffer buf)
- (erase-buffer)
- ;; Send ARTICLE command.
- (while (setq article (pop articles))
- (nntp-send-command
- nil
- "ARTICLE" (if (numberp article)
- (int-to-string article)
- ;; `articles' is either a list of article numbers
- ;; or a list of article IDs.
- article))
- (incf count)
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (zerop (% count nntp-maximum-request)))
- (nntp-accept-response)
- (while (progn
- (set-buffer buf)
- (goto-char last-point)
- ;; Count replies.
- (while (nntp-next-result-arrived-p)
- (aset map received (cons (aref map received) (point)))
- (setq last-point (point))
- (incf received))
- (< received count))
- ;; If number of headers is greater than 100, give
- ;; informative messages.
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (zerop (% received 20))
- (nnheader-message 6 "NNTP: Receiving articles... %d%%"
- (/ (* received 100) number)))
- (nntp-accept-response))))
- (and (numberp nntp-large-newsgroup)
- (> number nntp-large-newsgroup)
- (nnheader-message 6 "NNTP: Receiving articles...done"))
-
- ;; Now we have all the responses. We go through the results,
- ;; wash it and copy it over to the server buffer.
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq last-point (point-min))
- (mapcar
- (lambda (entry)
- (narrow-to-region
- (setq point (goto-char (point-max)))
- (progn
- (insert-buffer-substring buf last-point (cdr entry))
- (point-max)))
- (setq last-point (cdr entry))
- (nntp-decode-text)
- (widen)
- (cons (car entry) point))
- map)))))
-
-(defun nntp-try-list-active (group)
- (nntp-list-active-group group)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (cond ((or (eobp)
- (looking-at "5[0-9]+"))
- (setq nntp-server-list-active-group nil))
- (t
- (setq nntp-server-list-active-group t)))))
-
-(deffoo nntp-list-active-group (group &optional server)
- "Return the active info on GROUP (which can be a regexp)."
- (nntp-with-open-group
- nil server
- (nntp-send-command "^\\.*\r?\n" "LIST ACTIVE" group)))
-
-(deffoo nntp-request-group-articles (group &optional server)
- "Return the list of existing articles in GROUP."
- (nntp-with-open-group
- nil server
- (nntp-send-command "^\\.*\r?\n" "LISTGROUP" group)))
-
-(deffoo nntp-request-article (article &optional group server buffer command)
- (nntp-with-open-group
- group server
- (when (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "ARTICLE"
- (if (numberp article) (int-to-string article) article))
- (if (and buffer
- (not (equal buffer nntp-server-buffer)))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (copy-to-buffer buffer (point-min) (point-max))
- (nntp-find-group-and-number group))
- (nntp-find-group-and-number group)))))
-
-(deffoo nntp-request-head (article &optional group server)
- (nntp-with-open-group
- group server
- (when (nntp-send-command
- "\r?\n\\.\r?\n" "HEAD"
- (if (numberp article) (int-to-string article) article))
- (prog1
- (nntp-find-group-and-number group)
- (nntp-decode-text)))))
-
-(deffoo nntp-request-body (article &optional group server)
- (nntp-with-open-group
- group server
- (nntp-send-command-and-decode
- "\r?\n\\.\r?\n" "BODY"
- (if (numberp article) (int-to-string article) article))))
-
-(deffoo nntp-request-group (group &optional server dont-check)
- (nntp-with-open-group
- nil server
- (when (nntp-send-command "^[245].*\n" "GROUP" group)
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (setcar (cddr entry) group)))))
-
-(deffoo nntp-close-group (group &optional server)
- t)
-
-(deffoo nntp-server-opened (&optional server)
- "Say whether a connection to SERVER has been opened."
- (and (nnoo-current-server-p 'nntp server)
- nntp-server-buffer
- (gnus-buffer-live-p nntp-server-buffer)
- (nntp-find-connection nntp-server-buffer)))
-
-(deffoo nntp-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nntp-server-opened server)
- t
- (when (or (stringp (car defs))
- (numberp (car defs)))
- (setq defs (cons (list 'nntp-port-number (car defs)) (cdr defs))))
- (unless (assq 'nntp-address defs)
- (setq defs (append defs (list (list 'nntp-address server)))))
- (nnoo-change-server 'nntp server defs)
- (unless connectionless
- (or (nntp-find-connection nntp-server-buffer)
- (nntp-open-connection nntp-server-buffer)))))
-
-(deffoo nntp-close-server (&optional server)
- (nntp-possibly-change-group nil server t)
- (let ((process (nntp-find-connection nntp-server-buffer)))
- (while process
- (when (memq (process-status process) '(open run))
- (ignore-errors
- (nntp-send-string process "QUIT")
- (unless (eq nntp-open-connection-function 'nntp-open-network-stream)
- ;; Ok, this is evil, but when using telnet and stuff
- ;; as the connection method, it's important that the
- ;; QUIT command actually is sent out before we kill
- ;; the process.
- (sleep-for 1))))
- (nntp-kill-buffer (process-buffer process))
- (setq process (car (pop nntp-connection-alist))))
- (nnoo-close-server 'nntp)))
-
-(deffoo nntp-request-close ()
- (let (process)
- (while (setq process (pop nntp-connection-list))
- (when (memq (process-status process) '(open run))
- (ignore-errors
- (nntp-send-string process "QUIT")
- (unless (eq nntp-open-connection-function 'nntp-open-network-stream)
- ;; Ok, this is evil, but when using telnet and stuff
- ;; as the connection method, it's important that the
- ;; QUIT command actually is sent out before we kill
- ;; the process.
- (sleep-for 1))))
- (nntp-kill-buffer (process-buffer process)))))
-
-(deffoo nntp-request-list (&optional server)
- (nntp-with-open-group
- nil server
- (nntp-send-command-and-decode "\r?\n\\.\r?\n" "LIST")))
-
-(deffoo nntp-request-list-newsgroups (&optional server)
- (nntp-with-open-group
- nil server
- (nntp-send-command "\r?\n\\.\r?\n" "LIST NEWSGROUPS")))
-
-(deffoo nntp-request-newgroups (date &optional server)
- (nntp-with-open-group
- nil server
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let* ((time (date-to-time date))
- (ls (- (cadr time) (nth 8 (decode-time time)))))
- (cond ((< ls 0)
- (setcar time (1- (car time)))
- (setcar (cdr time) (+ ls 65536)))
- ((>= ls 65536)
- (setcar time (1+ (car time)))
- (setcar (cdr time) (- ls 65536)))
- (t
- (setcar (cdr time) ls)))
- (prog1
- (nntp-send-command
- "^\\.\r?\n" "NEWGROUPS"
- (format-time-string "%y%m%d %H%M%S" time)
- "GMT")
- (nntp-decode-text))))))
-
-(deffoo nntp-request-post (&optional server)
- (nntp-with-open-group
- nil server
- (when (nntp-send-command "^[23].*\r?\n" "POST")
- (let ((response (with-current-buffer nntp-server-buffer
- nntp-process-response))
- server-id)
- (when (and response
- (string-match "^[23].*\\(<[^\t\n @<>]+@[^\t\n @<>]+>\\)"
- response))
- (setq server-id (match-string 1 response))
- (narrow-to-region (goto-char (point-min))
- (if (search-forward "\n\n" nil t)
- (1- (point))
- (point-max)))
- (unless (mail-fetch-field "Message-ID")
- (goto-char (point-min))
- (insert "Message-ID: " server-id "\n"))
- (widen))
- (run-hooks 'nntp-prepare-post-hook)
- (nntp-send-buffer "^[23].*\n")))))
-
-(deffoo nntp-request-type (group article)
- 'news)
-
-(deffoo nntp-asynchronous-p ()
- t)
-
-;;; Hooky functions.
-
-(defun nntp-send-mode-reader ()
- "Send the MODE READER command to the nntp server.
-This function is supposed to be called from `nntp-server-opened-hook'.
-It will make innd servers spawn an nnrpd process to allow actual article
-reading."
- (nntp-send-command "^.*\n" "MODE READER"))
-
-(defun nntp-send-authinfo (&optional send-if-force)
- "Send the AUTHINFO to the nntp server.
-It will look in the \"~/.authinfo\" file for matching entries. If
-nothing suitable is found there, it will prompt for a user name
-and a password.
-
-If SEND-IF-FORCE, only send authinfo to the server if the
-.authinfo file has the FORCE token."
- (let* ((list (gnus-parse-netrc nntp-authinfo-file))
- (alist (gnus-netrc-machine list nntp-address "nntp"))
- (force (gnus-netrc-get alist "force"))
- (user (or (gnus-netrc-get alist "login") nntp-authinfo-user))
- (passwd (gnus-netrc-get alist "password")))
- (when (or (not send-if-force)
- force)
- (unless user
- (setq user (read-string (format "NNTP (%s) user name: " nntp-address))
- nntp-authinfo-user user))
- (unless (member user '(nil ""))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (or passwd
- nntp-authinfo-password
- (setq nntp-authinfo-password
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address))))))))))
-
-(defun nntp-send-nosy-authinfo ()
- "Send the AUTHINFO to the nntp server."
- (let ((user (read-string (format "NNTP (%s) user name: " nntp-address))))
- (unless (member user '(nil ""))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" user)
- (when t ;???Should check if AUTHINFO succeeded
- (nntp-send-command "^2.*\r?\n" "AUTHINFO PASS"
- (read-passwd (format "NNTP (%s@%s) password: "
- user nntp-address)))))))
-
-(defun nntp-send-authinfo-from-file ()
- "Send the AUTHINFO to the nntp server.
-
-The authinfo login name is taken from the user's login name and the
-password contained in '~/.nntp-authinfo'."
- (when (file-exists-p "~/.nntp-authinfo")
- (with-temp-buffer
- (insert-file-contents "~/.nntp-authinfo")
- (goto-char (point-min))
- (nntp-send-command "^3.*\r?\n" "AUTHINFO USER" (user-login-name))
- (nntp-send-command
- "^2.*\r?\n" "AUTHINFO PASS"
- (buffer-substring (point) (gnus-point-at-eol))))))
-
-;;; Internal functions.
-
-(defun nntp-handle-authinfo (process)
- "Take care of an authinfo response from the server."
- (let ((last nntp-last-command))
- (funcall nntp-authinfo-function)
- ;; We have to re-send the function that was interrupted by
- ;; the authinfo request.
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- (nntp-send-string process last)))
-
-(defun nntp-make-process-buffer (buffer)
- "Create a new, fresh buffer usable for nntp process connections."
- (save-excursion
- (set-buffer
- (generate-new-buffer
- (format " *server %s %s %s*"
- nntp-address nntp-port-number
- (gnus-buffer-exists-p buffer))))
- (mm-enable-multibyte)
- (set (make-local-variable 'after-change-functions) nil)
- (set (make-local-variable 'nntp-process-wait-for) nil)
- (set (make-local-variable 'nntp-process-callback) nil)
- (set (make-local-variable 'nntp-process-to-buffer) nil)
- (set (make-local-variable 'nntp-process-start-point) nil)
- (set (make-local-variable 'nntp-process-decode) nil)
- (current-buffer)))
-
-(defun nntp-open-connection (buffer)
- "Open a connection to PORT on ADDRESS delivering output to BUFFER."
- (run-hooks 'nntp-prepare-server-hook)
- (let* ((pbuffer (nntp-make-process-buffer buffer))
- (timer
- (and nntp-connection-timeout
- (nnheader-run-at-time
- nntp-connection-timeout nil
- `(lambda ()
- (nntp-kill-buffer ,pbuffer)))))
- (process
- (condition-case ()
- (let ((coding-system-for-read nntp-coding-system-for-read)
- (coding-system-for-write nntp-coding-system-for-write))
- (funcall nntp-open-connection-function pbuffer))
- (error nil)
- (quit
- (message "Quit opening connection")
- (nntp-kill-buffer pbuffer)
- (signal 'quit nil)
- nil))))
- (when timer
- (nnheader-cancel-timer timer))
- (unless process
- (nntp-kill-buffer pbuffer))
- (when (and (buffer-name pbuffer)
- process)
- (gnus-set-process-query-on-exit-flag process nil)
- (if (and (nntp-wait-for process "^2.*\n" buffer nil t)
- (memq (process-status process) '(open run)))
- (prog1
- (caar (push (list process buffer nil) nntp-connection-alist))
- (push process nntp-connection-list)
- (save-excursion
- (set-buffer pbuffer)
- (nntp-read-server-type)
- (erase-buffer)
- (set-buffer nntp-server-buffer)
- (let ((nnheader-callback-function nil))
- (run-hooks 'nntp-server-opened-hook)
- (nntp-send-authinfo t))))
- (nntp-kill-buffer (process-buffer process))
- nil))))
-
-(defun nntp-open-network-stream (buffer)
- (open-network-stream "nntpd" buffer nntp-address nntp-port-number))
-
-(eval-and-compile
- (autoload 'format-spec "format-spec")
- (autoload 'format-spec-make "format-spec")
- (autoload 'open-tls-stream "tls"))
-
-(defun nntp-open-ssl-stream (buffer)
- (let* ((process-connection-type nil)
- (proc (start-process "nntpd" buffer
- shell-file-name
- shell-command-switch
- (format-spec nntp-ssl-program
- (format-spec-make
- ?s nntp-address
- ?p nntp-port-number)))))
- (gnus-set-process-query-on-exit-flag proc nil)
- (save-excursion
- (set-buffer buffer)
- (let ((nntp-connection-alist (list proc buffer nil)))
- (nntp-wait-for-string "^\r*20[01]"))
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc)))
-
-(defun nntp-open-tls-stream (buffer)
- (let ((proc (open-tls-stream "nntpd" buffer nntp-address nntp-port-number)))
- (gnus-set-process-query-on-exit-flag proc nil)
- (save-excursion
- (set-buffer buffer)
- (let ((nntp-connection-alist (list proc buffer nil)))
- (nntp-wait-for-string "^\r*20[01]"))
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc)))
-
-(defun nntp-read-server-type ()
- "Find out what the name of the server we have connected to is."
- ;; Wait for the status string to arrive.
- (setq nntp-server-type (buffer-string))
- (let ((alist nntp-server-action-alist)
- (case-fold-search t)
- entry)
- ;; Run server-specific commands.
- (while alist
- (setq entry (pop alist))
- (when (string-match (car entry) nntp-server-type)
- (if (and (listp (cadr entry))
- (not (eq 'lambda (caadr entry))))
- (eval (cadr entry))
- (funcall (cadr entry)))))))
-
-(defun nntp-async-wait (process wait-for buffer decode callback)
- (save-excursion
- (set-buffer (process-buffer process))
- (unless nntp-inside-change-function
- (erase-buffer))
- (setq nntp-process-wait-for wait-for
- nntp-process-to-buffer buffer
- nntp-process-decode decode
- nntp-process-callback callback
- nntp-process-start-point (point-max))
- (setq after-change-functions '(nntp-after-change-function))
- (if nntp-async-needs-kluge
- (nntp-async-kluge process))))
-
-(defun nntp-async-kluge (process)
- ;; emacs 20.3 bug: process output with encoding 'binary
- ;; doesn't trigger after-change-functions.
- (unless nntp-async-timer
- (setq nntp-async-timer
- (nnheader-run-at-time 1 1 'nntp-async-timer-handler)))
- (add-to-list 'nntp-async-process-list process))
-
-(defun nntp-async-timer-handler ()
- (mapcar
- (lambda (proc)
- (if (memq (process-status proc) '(open run))
- (nntp-async-trigger proc)
- (nntp-async-stop proc)))
- nntp-async-process-list))
-
-(defun nntp-async-stop (proc)
- (setq nntp-async-process-list (delq proc nntp-async-process-list))
- (when (and nntp-async-timer (not nntp-async-process-list))
- (nnheader-cancel-timer nntp-async-timer)
- (setq nntp-async-timer nil)))
-
-(defun nntp-after-change-function (beg end len)
- (unwind-protect
- ;; we only care about insertions at eob
- (when (and (eq 0 len) (eq (point-max) end))
- (save-match-data
- (let ((proc (get-buffer-process (current-buffer))))
- (when proc
- (nntp-async-trigger proc)))))
- ;; any throw from after-change-functions will leave it
- ;; set to nil. so we reset it here, if necessary.
- (when quit-flag
- (setq after-change-functions '(nntp-after-change-function)))))
-
-(defun nntp-async-trigger (process)
- (save-excursion
- (set-buffer (process-buffer process))
- (when nntp-process-callback
- ;; do we have an error message?
- (goto-char nntp-process-start-point)
- (if (memq (following-char) '(?4 ?5))
- ;; wants credentials?
- (if (looking-at "480")
- (nntp-handle-authinfo process)
- ;; report error message.
- (nntp-snarf-error-message)
- (nntp-do-callback nil))
-
- ;; got what we expect?
- (goto-char (point-max))
- (when (re-search-backward
- nntp-process-wait-for nntp-process-start-point t)
- (let ((response (match-string 0)))
- (with-current-buffer nntp-server-buffer
- (setq nntp-process-response response)))
- (nntp-async-stop process)
- ;; convert it.
- (when (gnus-buffer-exists-p nntp-process-to-buffer)
- (let ((buf (current-buffer))
- (start nntp-process-start-point)
- (decode nntp-process-decode))
- (save-excursion
- (set-buffer nntp-process-to-buffer)
- (goto-char (point-max))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert-buffer-substring buf start)
- (when decode
- (nntp-decode-text))))))
- ;; report it.
- (goto-char (point-max))
- (nntp-do-callback
- (buffer-name (get-buffer nntp-process-to-buffer))))))))
-
-(defun nntp-do-callback (arg)
- (let ((callback nntp-process-callback)
- (nntp-inside-change-function t))
- (setq nntp-process-callback nil)
- (funcall callback arg)))
-
-(defun nntp-snarf-error-message ()
- "Save the error message in the current buffer."
- (let ((message (buffer-string)))
- (while (string-match "[\r\n]+" message)
- (setq message (replace-match " " t t message)))
- (nnheader-report 'nntp message)
- message))
-
-(defun nntp-accept-process-output (process)
- "Wait for output from PROCESS and message some dots."
- (save-excursion
- (set-buffer (or (nntp-find-connection-buffer nntp-server-buffer)
- nntp-server-buffer))
- (let ((len (/ (buffer-size) 1024))
- message-log-max)
- (unless (< len 10)
- (setq nntp-have-messaged t)
- (nnheader-message 7 "nntp read: %dk" len)))
- (nnheader-accept-process-output process)
- ;; accept-process-output may update status of process to indicate
- ;; that the server has closed the connection. This MUST be
- ;; handled here as the buffer restored by the save-excursion may
- ;; be the process's former output buffer (i.e. now killed)
- (or (and process
- (memq (process-status process) '(open run)))
- (nntp-report "Server closed connection"))))
-
-(defun nntp-accept-response ()
- "Wait for output from the process that outputs to BUFFER."
- (nntp-accept-process-output (nntp-find-connection nntp-server-buffer)))
-
-(defun nntp-possibly-change-group (group server &optional connectionless)
- (let ((nnheader-callback-function nil))
- (when server
- (or (nntp-server-opened server)
- (nntp-open-server server nil connectionless)))
-
- (unless connectionless
- (or (nntp-find-connection nntp-server-buffer)
- (nntp-open-connection nntp-server-buffer))))
-
- (when group
- (let ((entry (nntp-find-connection-entry nntp-server-buffer)))
- (cond ((not entry)
- (nntp-report "Server closed connection"))
- ((not (equal group (caddr entry)))
- (save-excursion
- (set-buffer (process-buffer (car entry)))
- (erase-buffer)
- (nntp-send-command "^[245].*\n" "GROUP" group)
- (setcar (cddr entry) group)
- (erase-buffer)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))))))))
-
-(defun nntp-decode-text (&optional cr-only)
- "Decode the text in the current buffer."
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (delete-char -1))
- (unless cr-only
- ;; Remove trailing ".\n" end-of-transfer marker.
- (goto-char (point-max))
- (forward-line -1)
- (when (looking-at ".\n")
- (delete-char 2))
- ;; Delete status line.
- (goto-char (point-min))
- (while (looking-at "[1-5][0-9][0-9] .*\n")
- ;; For some unknown reason, there is more than one status line.
- (delete-region (point) (progn (forward-line 1) (point))))
- ;; Remove "." -> ".." encoding.
- (while (search-forward "\n.." nil t)
- (delete-char -1))))
-
-(defun nntp-encode-text ()
- "Encode the text in the current buffer."
- (save-excursion
- ;; Replace "." at beginning of line with "..".
- (goto-char (point-min))
- (while (re-search-forward "^\\." nil t)
- (insert "."))
- (goto-char (point-max))
- ;; Insert newline at the end of the buffer.
- (unless (bolp)
- (insert "\n"))
- ;; Insert `.' at end of buffer (end of text mark).
- (goto-char (point-max))
- (insert ".\n")
- (goto-char (point-min))
- (while (not (eobp))
- (end-of-line)
- (delete-char 1)
- (insert nntp-end-of-line))))
-
-(defun nntp-retrieve-headers-with-xover (articles &optional fetch-old)
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (cond
-
- ;; This server does not talk NOV.
- ((not nntp-server-xover)
- nil)
-
- ;; We don't care about gaps.
- ((or (not nntp-nov-gap)
- fetch-old)
- (nntp-send-xover-command
- (if fetch-old
- (if (numberp fetch-old)
- (max 1 (- (car articles) fetch-old))
- 1)
- (car articles))
- (car (last articles)) 'wait)
-
- (goto-char (point-min))
- (when (looking-at "[1-5][0-9][0-9] .*\n")
- (delete-region (point) (progn (forward-line 1) (point))))
- (while (search-forward "\r" nil t)
- (replace-match "" t t))
- (goto-char (point-max))
- (forward-line -1)
- (when (looking-at "\\.")
- (delete-region (point) (progn (forward-line 1) (point)))))
-
- ;; We do it the hard way. For each gap, an XOVER command is sent
- ;; to the server. We do not wait for a reply from the server, we
- ;; just send them off as fast as we can. That means that we have
- ;; to count the number of responses we get back to find out when we
- ;; have gotten all we asked for.
- ((numberp nntp-nov-gap)
- (let ((count 0)
- (received 0)
- last-point
- in-process-buffer-p
- (buf nntp-server-buffer)
- (process-buffer (nntp-find-connection-buffer nntp-server-buffer))
- first last status)
- ;; We have to check `nntp-server-xover'. If it gets set to nil,
- ;; that means that the server does not understand XOVER, but we
- ;; won't know that until we try.
- (while (and nntp-server-xover articles)
- (setq first (car articles))
- ;; Search forward until we find a gap, or until we run out of
- ;; articles.
- (while (and (cdr articles)
- (< (- (nth 1 articles) (car articles)) nntp-nov-gap))
- (setq articles (cdr articles)))
-
- (setq in-process-buffer-p (stringp nntp-server-xover))
- (nntp-send-xover-command first (setq last (car articles)))
- (setq articles (cdr articles))
-
- (when (and nntp-server-xover in-process-buffer-p)
- ;; Don't count tried request.
- (setq count (1+ count))
-
- ;; Every 400 requests we have to read the stream in
- ;; order to avoid deadlocks.
- (when (or (null articles) ;All requests have been sent.
- (= 1 (% count nntp-maximum-request)))
-
- (nntp-accept-response)
- ;; On some Emacs versions the preceding function has a
- ;; tendency to change the buffer. Perhaps. It's quite
- ;; difficult to reproduce, because it only seems to happen
- ;; once in a blue moon.
- (set-buffer process-buffer)
- (while (progn
- (goto-char (or last-point (point-min)))
- ;; Count replies.
- (while (re-search-forward "^\\([0-9][0-9][0-9]\\) .*\n"
- nil t)
- (incf received)
- (setq status (match-string 1))
- (if (string-match "^[45]" status)
- (setq status 'error)
- (setq status 'ok)))
- (setq last-point (point))
- (or (< received count)
- (if (eq status 'error)
- nil
- ;; I haven't started reading the final response
- (progn
- (goto-char (point-max))
- (forward-line -1)
- (not (looking-at "^\\.\r?\n"))))))
- ;; I haven't read the end of the final response
- (nntp-accept-response)
- (set-buffer process-buffer))))
-
- ;; Some nntp servers seem to have an extension to the XOVER
- ;; extension. On these servers, requesting an article range
- ;; preceeding the active range does not return an error as
- ;; specified in the RFC. What we instead get is the NOV entry
- ;; for the first available article. Obviously, a client can
- ;; use that entry to avoid making unnecessary requests. The
- ;; only problem is for a client that assumes that the response
- ;; will always be within the requested ranage. For such a
- ;; client, we can get N copies of the same entry (one for each
- ;; XOVER command sent to the server).
-
- (when (<= count 1)
- (goto-char (point-min))
- (when (re-search-forward "^[0-9][0-9][0-9] .*\n\\([0-9]+\\)" nil t)
- (let ((low-limit (string-to-number
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- (while (and articles (<= (car articles) low-limit))
- (setq articles (cdr articles))))))
- (set-buffer buf))
-
- (when nntp-server-xover
- (when in-process-buffer-p
- (set-buffer buf)
- (goto-char (point-max))
- (insert-buffer-substring process-buffer)
- (set-buffer process-buffer)
- (erase-buffer)
- (set-buffer buf))
-
- ;; We remove any "." lines and status lines.
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (delete-char -1))
- (goto-char (point-min))
- (delete-matching-lines "^\\.$\\|^[1-5][0-9][0-9] ")
- t))))
-
- nntp-server-xover)
-
-(defun nntp-send-xover-command (beg end &optional wait-for-reply)
- "Send the XOVER command to the server."
- (let ((range (format "%d-%d" beg end))
- (nntp-inhibit-erase t))
- (if (stringp nntp-server-xover)
- ;; If `nntp-server-xover' is a string, then we just send this
- ;; command.
- (if wait-for-reply
- (nntp-send-command-nodelete
- "\r?\n\\.\r?\n" nntp-server-xover range)
- ;; We do not wait for the reply.
- (nntp-send-command-nodelete nil nntp-server-xover range))
- (let ((commands nntp-xover-commands))
- ;; `nntp-xover-commands' is a list of possible XOVER commands.
- ;; We try them all until we get at positive response.
- (while (and commands (eq nntp-server-xover 'try))
- (nntp-send-command-nodelete "\r?\n\\.\r?\n" (car commands) range)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (goto-char (point-min))
- (and (looking-at "[23]") ; No error message.
- ;; We also have to look at the lines. Some buggy
- ;; servers give back simple lines with just the
- ;; article number. How... helpful.
- (progn
- (forward-line 1)
- ;; More text after number, or a dot.
- (looking-at "[0-9]+\t...\\|\\.\r?\n"))
- (setq nntp-server-xover (car commands))))
- (setq commands (cdr commands)))
- ;; If none of the commands worked, we disable XOVER.
- (when (eq nntp-server-xover 'try)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (setq nntp-server-xover nil)))
- nntp-server-xover))))
-
-(defun nntp-find-group-and-number (&optional group)
- (save-excursion
- (save-restriction
- (set-buffer nntp-server-buffer)
- (narrow-to-region (goto-char (point-min))
- (or (search-forward "\n\n" nil t) (point-max)))
- (goto-char (point-min))
- ;; We first find the number by looking at the status line.
- (let ((number (and (looking-at "2[0-9][0-9] +\\([0-9]+\\) ")
- (string-to-number
- (buffer-substring (match-beginning 1)
- (match-end 1)))))
- newsgroups xref)
- (and number (zerop number) (setq number nil))
- (if number
- ;; Then we find the group name.
- (setq group
- (cond
- ;; If there is only one group in the Newsgroups
- ;; header, then it seems quite likely that this
- ;; article comes from that group, I'd say.
- ((and (setq newsgroups
- (mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
- newsgroups)
- ;; If there is more than one group in the
- ;; Newsgroups header, then the Xref header should
- ;; be filled out. We hazard a guess that the group
- ;; that has this article number in the Xref header
- ;; is the one we are looking for. This might very
- ;; well be wrong if this article happens to have
- ;; the same number in several groups, but that's
- ;; life.
- ((and (setq xref (mail-fetch-field "xref"))
- number
- (string-match
- (format "\\([^ :]+\\):%d" number) xref))
- (match-string 1 xref))
- (t "")))
- (cond
- ((and (not nntp-xref-number-is-evil)
- (setq xref (mail-fetch-field "xref"))
- (string-match
- (if group
- (concat "\\(" (regexp-quote group) "\\):\\([0-9]+\\)")
- "\\([^ :]+\\):\\([0-9]+\\)")
- xref))
- (setq group (match-string 1 xref)
- number (string-to-number (match-string 2 xref))))
- ((and (setq newsgroups
- (mail-fetch-field "newsgroups"))
- (not (string-match "," newsgroups)))
- (setq group newsgroups))
- (group)
- (t (setq group ""))))
- (when (string-match "\r" group)
- (setq group (substring group 0 (match-beginning 0))))
- (cons group number)))))
-
-(defun nntp-wait-for-string (regexp)
- "Wait until string arrives in the buffer."
- (let ((buf (current-buffer))
- proc)
- (goto-char (point-min))
- (while (and (setq proc (get-buffer-process buf))
- (memq (process-status proc) '(open run))
- (not (re-search-forward regexp nil t)))
- (accept-process-output proc)
- (set-buffer buf)
- (goto-char (point-min)))))
-
-
-;; ==========================================================================
-;; Obsolete nntp-open-* connection methods -- drv
-;; ==========================================================================
-
-(defvoo nntp-open-telnet-envuser nil
- "*If non-nil, telnet session (client and server both) will support the ENVIRON option and not prompt for login name.")
-
-(defvoo nntp-telnet-shell-prompt "bash\\|\$ *\r?$\\|> *\r?"
- "*Regular expression to match the shell prompt on the remote machine.")
-
-(defvoo nntp-rlogin-program "rsh"
- "*Program used to log in on remote machines.
-The default is \"rsh\", but \"ssh\" is a popular alternative.")
-
-(defvoo nntp-rlogin-parameters '("telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-rlogin'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be used as the parameter list given to rsh.")
-
-(defvoo nntp-rlogin-user-name nil
- "*User name on remote system when using the rlogin connect method.")
-
-(defvoo nntp-telnet-parameters
- '("exec" "telnet" "-8" "${NNTPSERVER:=news}" "nntp")
- "*Parameters to `nntp-open-telnet'.
-That function may be used as `nntp-open-connection-function'. In that
-case, this list will be executed as a command after logging in
-via telnet.")
-
-(defvoo nntp-telnet-user-name nil
- "User name to log in via telnet with.")
-
-(defvoo nntp-telnet-passwd nil
- "Password to use to log in via telnet with.")
-
-(defun nntp-open-telnet (buffer)
- (save-excursion
- (set-buffer buffer)
- (erase-buffer)
- (let ((proc (apply
- 'start-process
- "nntpd" buffer nntp-telnet-command nntp-telnet-switches))
- (case-fold-search t))
- (when (memq (process-status proc) '(open run))
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc "set escape \^X\n")
- (cond
- ((and nntp-open-telnet-envuser nntp-telnet-user-name)
- (process-send-string proc (concat "open " "-l" nntp-telnet-user-name
- nntp-address "\n")))
- (t
- (process-send-string proc (concat "open " nntp-address "\n"))))
- (cond
- ((not nntp-open-telnet-envuser)
- (nntp-wait-for-string "^\r*.?login:")
- (process-send-string
- proc (concat
- (or nntp-telnet-user-name
- (setq nntp-telnet-user-name (read-string "login: ")))
- "\n"))))
- (nntp-wait-for-string "^\r*.?password:")
- (process-send-string
- proc (concat
- (or nntp-telnet-passwd
- (setq nntp-telnet-passwd
- (read-passwd "Password: ")))
- "\n"))
- (nntp-wait-for-string nntp-telnet-shell-prompt)
- (process-send-string
- proc (concat (mapconcat 'identity nntp-telnet-parameters " ") "\n"))
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- (process-send-string proc "\^]")
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc "mode character\n")
- (accept-process-output proc 1)
- (sit-for 1)
- (goto-char (point-min))
- (forward-line 1)
- (delete-region (point) (point-max)))
- proc)))
-
-(defun nntp-open-rlogin (buffer)
- "Open a connection to SERVER using rsh."
- (let ((proc (if nntp-rlogin-user-name
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program
- nntp-address "-l" nntp-rlogin-user-name
- nntp-rlogin-parameters)
- (apply 'start-process
- "nntpd" buffer nntp-rlogin-program nntp-address
- nntp-rlogin-parameters))))
- (save-excursion
- (set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc)))
-
-
-;; ==========================================================================
-;; Replacements for the nntp-open-* functions -- drv
-;; ==========================================================================
-
-(defun nntp-open-telnet-stream (buffer)
- "Open a nntp connection by telnet'ing the news server.
-
-Please refer to the following variables to customize the connection:
-- `nntp-pre-command',
-- `nntp-telnet-command',
-- `nntp-telnet-switches',
-- `nntp-address',
-- `nntp-port-number',
-- `nntp-end-of-line'."
- (let ((command `(,nntp-telnet-command
- ,@nntp-telnet-switches
- ,nntp-address
- ,(if (integerp nntp-port-number)
- (number-to-string nntp-port-number)
- nntp-port-number)))
- proc)
- (and nntp-pre-command
- (push nntp-pre-command command))
- (setq proc (apply 'start-process "nntpd" buffer command))
- (save-excursion
- (set-buffer buffer)
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- proc)))
-
-(defun nntp-open-via-rlogin-and-telnet (buffer)
- "Open a connection to an nntp server through an intermediate host.
-First rlogin to the remote host, and then telnet the real news server
-from there.
-
-Please refer to the following variables to customize the connection:
-- `nntp-pre-command',
-- `nntp-via-rlogin-command',
-- `nntp-via-rlogin-command-switches',
-- `nntp-via-user-name',
-- `nntp-via-address',
-- `nntp-telnet-command',
-- `nntp-telnet-switches',
-- `nntp-address',
-- `nntp-port-number',
-- `nntp-end-of-line'."
- (let ((command `(,nntp-via-address
- ,nntp-telnet-command
- ,@nntp-telnet-switches))
- proc)
- (when nntp-via-user-name
- (setq command `("-l" ,nntp-via-user-name ,@command)))
- (when nntp-via-rlogin-command-switches
- (setq command (append nntp-via-rlogin-command-switches command)))
- (push nntp-via-rlogin-command command)
- (and nntp-pre-command
- (push nntp-pre-command command))
- (setq proc (apply 'start-process "nntpd" buffer command))
- (save-excursion
- (set-buffer buffer)
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc (concat "open " nntp-address " "
- (if (integerp nntp-port-number)
- (number-to-string nntp-port-number)
- nntp-port-number)
- "\n"))
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- (process-send-string proc "\^]")
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc "mode character\n")
- (accept-process-output proc 1)
- (sit-for 1)
- (goto-char (point-min))
- (forward-line 1)
- (delete-region (point) (point-max)))
- proc))
-
-(defun nntp-open-via-telnet-and-telnet (buffer)
- "Open a connection to an nntp server through an intermediate host.
-First telnet the remote host, and then telnet the real news server
-from there.
-
-Please refer to the following variables to customize the connection:
-- `nntp-pre-command',
-- `nntp-via-telnet-command',
-- `nntp-via-telnet-switches',
-- `nntp-via-address',
-- `nntp-via-envuser',
-- `nntp-via-user-name',
-- `nntp-via-user-password',
-- `nntp-via-shell-prompt',
-- `nntp-telnet-command',
-- `nntp-telnet-switches',
-- `nntp-address',
-- `nntp-port-number',
-- `nntp-end-of-line'."
- (save-excursion
- (set-buffer buffer)
- (erase-buffer)
- (let ((command `(,nntp-via-telnet-command ,@nntp-via-telnet-switches))
- (case-fold-search t)
- proc)
- (and nntp-pre-command (push nntp-pre-command command))
- (setq proc (apply 'start-process "nntpd" buffer command))
- (when (memq (process-status proc) '(open run))
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc "set escape \^X\n")
- (cond
- ((and nntp-via-envuser nntp-via-user-name)
- (process-send-string proc (concat "open " "-l" nntp-via-user-name
- nntp-via-address "\n")))
- (t
- (process-send-string proc (concat "open " nntp-via-address
- "\n"))))
- (when (not nntp-via-envuser)
- (nntp-wait-for-string "^\r*.?login:")
- (process-send-string proc
- (concat
- (or nntp-via-user-name
- (setq nntp-via-user-name
- (read-string "login: ")))
- "\n")))
- (nntp-wait-for-string "^\r*.?password:")
- (process-send-string proc
- (concat
- (or nntp-via-user-password
- (setq nntp-via-user-password
- (read-passwd "Password: ")))
- "\n"))
- (nntp-wait-for-string nntp-via-shell-prompt)
- (let ((real-telnet-command `("exec"
- ,nntp-telnet-command
- ,@nntp-telnet-switches
- ,nntp-address
- ,(if (integerp nntp-port-number)
- (number-to-string nntp-port-number)
- nntp-port-number))))
- (process-send-string proc
- (concat (mapconcat 'identity
- real-telnet-command " ")
- "\n")))
- (nntp-wait-for-string "^\r*20[01]")
- (beginning-of-line)
- (delete-region (point-min) (point))
- (process-send-string proc "\^]")
- (nntp-wait-for-string "^r?telnet")
- (process-send-string proc "mode character\n")
- (accept-process-output proc 1)
- (sit-for 1)
- (goto-char (point-min))
- (forward-line 1)
- (delete-region (point) (point-max)))
- proc)))
-
-(provide 'nntp)
-
-;;; arch-tag: 8655466a-b1b5-4929-9c45-7b1b2e767271
-;;; nntp.el ends here
+++ /dev/null
-;;; nnultimate.el --- interfacing with the Ultimate Bulletin Board system
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(require 'nnweb)
-(require 'parse-time)
-(autoload 'w3-parse-buffer "w3-parse")
-
-(nnoo-declare nnultimate)
-
-(defvoo nnultimate-directory (nnheader-concat gnus-directory "ultimate/")
- "Where nnultimate will save its files.")
-
-(defvoo nnultimate-address ""
- "The address of the Ultimate bulletin board.")
-
-;;; Internal variables
-
-(defvar nnultimate-groups-alist nil)
-(defvoo nnultimate-groups nil)
-(defvoo nnultimate-headers nil)
-(defvoo nnultimate-articles nil)
-(defvar nnultimate-table-regexp
- "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
-
-;;; Interface functions
-
-(nnoo-define-basics nnultimate)
-
-(deffoo nnultimate-retrieve-headers (articles &optional group server fetch-old)
- (nnultimate-possibly-change-server group server)
- (unless gnus-nov-is-evil
- (let* ((last (car (last articles)))
- (did nil)
- (start 1)
- (entry (assoc group nnultimate-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (furl "forumdisplay.cgi?action=topics&number=%d&DaysPrune=1000")
- (furls (list (concat nnultimate-address (format furl sid))))
- (nnultimate-table-regexp
- "postings.*editpost\\|forumdisplay\\|getbio")
- headers article subject score from date lines parent point
- contents tinfo fetchers map elem a href garticles topic old-max
- inc datel table current-page total-contents pages
- farticles forum-contents parse furl-fetched mmap farticle)
- (setq map mapping)
- (while (and (setq article (car articles))
- map)
- ;; Skip past the articles in the map until we reach the
- ;; article we're looking for.
- (while (and map
- (or (> article (caar map))
- (< (cadar map) (caar map))))
- (pop map))
- (when (setq mmap (car map))
- (setq farticle -1)
- (while (and article
- (<= article (nth 1 mmap)))
- ;; Do we already have a fetcher for this topic?
- (if (setq elem (assq (nth 2 mmap) fetchers))
- ;; Yes, so we just add the spec to the end.
- (nconc elem (list (cons article
- (+ (nth 3 mmap) (incf farticle)))))
- ;; No, so we add a new one.
- (push (list (nth 2 mmap)
- (cons article
- (+ (nth 3 mmap) (incf farticle))))
- fetchers))
- (pop articles)
- (setq article (car articles)))))
- ;; Now we have the mapping from/to Gnus/nnultimate article numbers,
- ;; so we start fetching the topics that we need to satisfy the
- ;; request.
- (if (not fetchers)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- (setq nnultimate-articles nil)
- (mm-with-unibyte-buffer
- (dolist (elem fetchers)
- (setq pages 1
- current-page 1
- total-contents nil)
- (while (<= current-page pages)
- (erase-buffer)
- (setq subject (nth 2 (assq (car elem) topics)))
- (setq href (nth 3 (assq (car elem) topics)))
- (if (= current-page 1)
- (mm-url-insert href)
- (string-match "\\.html$" href)
- (mm-url-insert (concat (substring href 0 (match-beginning 0))
- "-" (number-to-string current-page)
- (match-string 0 href))))
- (goto-char (point-min))
- (setq contents
- (ignore-errors (w3-parse-buffer (current-buffer))))
- (setq table (nnultimate-find-forum-table contents))
- (goto-char (point-min))
- (when (re-search-forward "topic is \\([0-9]+\\) pages" nil t)
- (setq pages (string-to-number (match-string 1))))
- (setq contents (cdr (nth 2 (car (nth 2 table)))))
- (setq total-contents (nconc total-contents contents))
- (incf current-page))
- (when t
- (let ((i 0))
- (dolist (co total-contents)
- (push (list (or (nnultimate-topic-article-to-article
- group (car elem) (incf i))
- 1)
- co subject)
- nnultimate-articles))))
- (when nil
- (dolist (art (cdr elem))
- (when (nth (1- (cdr art)) total-contents)
- (push (list (car art)
- (nth (1- (cdr art)) total-contents)
- subject)
- nnultimate-articles))))))
- (setq nnultimate-articles
- (sort nnultimate-articles 'car-less-than-car))
- ;; Now we have all the articles, conveniently in an alist
- ;; where the key is the Gnus article number.
- (dolist (articlef nnultimate-articles)
- (setq article (nth 0 articlef)
- contents (nth 1 articlef)
- subject (nth 2 articlef))
- (setq from (mapconcat 'identity
- (nnweb-text (car (nth 2 contents)))
- " ")
- datel (nnweb-text (nth 2 (car (cdr (nth 2 contents))))))
- (while datel
- (when (string-match "Posted" (car datel))
- (setq date (substring (car datel) (match-end 0))
- datel nil))
- (pop datel))
- (when date
- (setq date (delete "" (split-string date "[-, \n\t\r ]")))
- (setq date
- (if (or (member "AM" date)
- (member "PM" date))
- (format
- "%s %s %s %s"
- (nth 1 date)
- (if (and (>= (length (nth 0 date)) 3)
- (assoc (downcase
- (substring (nth 0 date) 0 3))
- parse-time-months))
- (substring (nth 0 date) 0 3)
- (car (rassq (string-to-number (nth 0 date))
- parse-time-months)))
- (nth 2 date) (nth 3 date))
- (format "%s %s %s %s"
- (car (rassq (string-to-number (nth 1 date))
- parse-time-months))
- (nth 0 date) (nth 2 date) (nth 3 date)))))
- (push
- (cons
- article
- (make-full-mail-header
- article subject
- from (or date "")
- (concat "<" (number-to-string sid) "%"
- (number-to-string article)
- "@ultimate." server ">")
- "" 0
- (/ (length (mapconcat
- 'identity
- (nnweb-text
- (cdr (nth 2 (nth 1 (nth 2 contents)))))
- ""))
- 70)
- nil nil))
- headers))
- (setq nnultimate-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (mm-with-unibyte-current-buffer
- (erase-buffer)
- (dolist (header nnultimate-headers)
- (nnheader-insert-nov (cdr header))))))
- 'nov)))
-
-(defun nnultimate-topic-article-to-article (group topic article)
- (catch 'found
- (dolist (elem (nth 5 (assoc group nnultimate-groups)))
- (when (and (= topic (nth 2 elem))
- (>= article (nth 3 elem))
- (< article (+ (- (nth 1 elem) (nth 0 elem)) 1
- (nth 3 elem))))
- (throw 'found
- (+ (nth 0 elem) (- article (nth 3 elem))))))))
-
-(deffoo nnultimate-request-group (group &optional server dont-check)
- (nnultimate-possibly-change-server nil server)
- (when (not nnultimate-groups)
- (nnultimate-request-list))
- (unless dont-check
- (nnultimate-create-mapping group))
- (let ((elem (assoc group nnultimate-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnultimate "Group does not exist"))
- (t
- (nnheader-report 'nnultimate "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnultimate-request-close ()
- (setq nnultimate-groups-alist nil
- nnultimate-groups nil))
-
-(deffoo nnultimate-request-article (article &optional group server buffer)
- (nnultimate-possibly-change-server group server)
- (let ((contents (cdr (assq article nnultimate-articles))))
- (setq contents (cddr (nth 2 (nth 1 (nth 2 (car contents))))))
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (nnweb-insert-html (cons 'p (cons nil (list contents))))
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (let ((header (cdr (assq article nnultimate-headers))))
- (mm-with-unibyte-current-buffer
- (nnheader-insert-header header)))
- (nnheader-report 'nnultimate "Fetched article %s" article)
- (cons group article)))))
-
-(deffoo nnultimate-request-list (&optional server)
- (nnultimate-possibly-change-server nil server)
- (mm-with-unibyte-buffer
- (mm-url-insert
- (if (string-match "/$" nnultimate-address)
- (concat nnultimate-address "Ultimate.cgi")
- nnultimate-address))
- (let ((contents (nth 2 (car (nth 2
- (nnultimate-find-forum-table
- (w3-parse-buffer (current-buffer)))))))
- sid elem description articles a href group forum
- a1 a2)
- (dolist (row contents)
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq group (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (setq description (car (last (nnweb-text (nth 1 row)))))
- (setq a1 (car (last (nnweb-text (nth 2 row)))))
- (setq a2 (car (last (nnweb-text (nth 3 row)))))
- (when (string-match "^[0-9]+$" a1)
- (setq articles (string-to-number a1)))
- (when (and a2 (string-match "^[0-9]+$" a2))
- (setq articles (max articles (string-to-number a2))))
- (when href
- (string-match "number=\\([0-9]+\\)" href)
- (setq forum (string-to-number (match-string 1 href)))
- (if (setq elem (assoc group nnultimate-groups))
- (setcar (cdr elem) articles)
- (push (list group articles forum description nil nil nil nil)
- nnultimate-groups))))))
- (nnultimate-write-groups)
- (nnultimate-generate-active)
- t))
-
-(deffoo nnultimate-request-newgroups (date &optional server)
- (nnultimate-possibly-change-server nil server)
- (nnultimate-generate-active)
- t)
-
-(nnoo-define-skeleton nnultimate)
-
-;;; Internal functions
-
-(defun nnultimate-prune-days (group time)
- "Compute the number of days to fetch info for."
- (let ((old-time (nth 7 (assoc group nnultimate-groups))))
- (if (null old-time)
- 1000
- (- (time-to-days time) (time-to-days old-time)))))
-
-(defun nnultimate-create-mapping (group)
- (let* ((entry (assoc group nnultimate-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (current-time (current-time))
- (furl
- (concat "forumdisplay.cgi?action=topics&number=%d&DaysPrune="
- (number-to-string
- (nnultimate-prune-days group current-time))))
- (furls (list (concat nnultimate-address (format furl sid))))
- contents forum-contents furl-fetched a subject href
- garticles topic tinfo old-max inc parse)
- (mm-with-unibyte-buffer
- (while furls
- (erase-buffer)
- (mm-url-insert (pop furls))
- (goto-char (point-min))
- (setq parse (w3-parse-buffer (current-buffer)))
- (setq contents
- (cdr (nth 2 (car (nth 2 (nnultimate-find-forum-table
- parse))))))
- (setq forum-contents (nconc contents forum-contents))
- (unless furl-fetched
- (setq furl-fetched t)
- ;; On the first time through this loop, we find all the
- ;; forum URLs.
- (dolist (a (nnweb-parse-find-all 'a parse))
- (let ((href (cdr (assq 'href (nth 1 a)))))
- (when (and href
- (string-match "forumdisplay.*startpoint" href))
- (push href furls))))
- (setq furls (nreverse furls))))
- ;; The main idea here is to map Gnus article numbers to
- ;; nnultimate article numbers. Say there are three topics in
- ;; this forum, the first with 4 articles, the seconds with 2,
- ;; and the third with 1. Then this will translate into 7 Gnus
- ;; article numbers, where 1-4 comes from the first topic, 5-6
- ;; from the second and 7 from the third. Now, then next time
- ;; the group is entered, there's 2 new articles in topic one
- ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
- ;; in topic one and 10 will be the 2 in topic three.
- (dolist (row (nreverse forum-contents))
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq subject (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (let ((artlist (nreverse (nnweb-text row)))
- art)
- (while (and (not art)
- artlist)
- (when (string-match "^[0-9]+$" (car artlist))
- (setq art (1+ (string-to-number (car artlist)))))
- (pop artlist))
- (setq garticles art))
- (when garticles
- (string-match "/\\([0-9]+\\).html" href)
- (setq topic (string-to-number (match-string 1 href)))
- (if (setq tinfo (assq topic topics))
- (progn
- (setq old-max (cadr tinfo))
- (setcar (cdr tinfo) garticles))
- (setq old-max 0)
- (push (list topic garticles subject href) topics)
- (setcar (nthcdr 4 entry) topics))
- (when (not (= old-max garticles))
- (setq inc (- garticles old-max))
- (setq mapping (nconc mapping
- (list
- (list
- old-total (1- (incf old-total inc))
- topic (1+ old-max)))))
- (incf old-max inc)
- (setcar (nthcdr 5 entry) mapping)
- (setcar (nthcdr 6 entry) old-total))))))
- (setcar (nthcdr 7 entry) current-time)
- (setcar (nthcdr 1 entry) (1- old-total))
- (nnultimate-write-groups)
- mapping))
-
-(defun nnultimate-possibly-change-server (&optional group server)
- (nnultimate-init server)
- (when (and server
- (not (nnultimate-server-opened server)))
- (nnultimate-open-server server))
- (unless nnultimate-groups-alist
- (nnultimate-read-groups)
- (setq nnultimate-groups (cdr (assoc nnultimate-address
- nnultimate-groups-alist)))))
-
-(deffoo nnultimate-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nnultimate-server-opened server)
- t
- (unless (assq 'nnultimate-address defs)
- (setq defs (append defs (list (list 'nnultimate-address server)))))
- (nnoo-change-server 'nnultimate server defs)))
-
-(defun nnultimate-read-groups ()
- (setq nnultimate-groups-alist nil)
- (let ((file (expand-file-name "groups" nnultimate-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnultimate-groups-alist (read (current-buffer)))))))
-
-(defun nnultimate-write-groups ()
- (setq nnultimate-groups-alist
- (delq (assoc nnultimate-address nnultimate-groups-alist)
- nnultimate-groups-alist))
- (push (cons nnultimate-address nnultimate-groups)
- nnultimate-groups-alist)
- (with-temp-file (expand-file-name "groups" nnultimate-directory)
- (prin1 nnultimate-groups-alist (current-buffer))))
-
-(defun nnultimate-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnultimate-directory)
- (gnus-make-directory nnultimate-directory)))
-
-(defun nnultimate-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnultimate-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
-
-(defun nnultimate-find-forum-table (contents)
- (catch 'found
- (nnultimate-find-forum-table-1 contents)))
-
-(defun nnultimate-find-forum-table-1 (contents)
- (dolist (element contents)
- (unless (stringp element)
- (when (and (eq (car element) 'table)
- (nnultimate-forum-table-p element))
- (throw 'found element))
- (when (nth 2 element)
- (nnultimate-find-forum-table-1 (nth 2 element))))))
-
-(defun nnultimate-forum-table-p (parse)
- (when (not (apply 'gnus-or
- (mapcar
- (lambda (p)
- (nnweb-parse-find 'table p))
- (nth 2 parse))))
- (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
- case-fold-search)
- (when (and href (string-match nnultimate-table-regexp href))
- t))))
-
-(provide 'nnultimate)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: ab6bfc45-8fe1-4647-9c78-41050eb152b8
-;;; nnultimate.el ends here
+++ /dev/null
-;;; nnvirtual.el --- virtual newsgroups access for Gnus
-
-;; Copyright (C) 1994, 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002,
-;; 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: David Moore <dmoore@ucsd.edu>
-;; Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu UMEDA <umerin@flab.flab.fujitsu.junet>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The other access methods (nntp, nnspool, etc) are general news
-;; access methods. This module relies on Gnus and can not be used
-;; separately.
-
-;;; Code:
-
-(require 'nntp)
-(require 'nnheader)
-(require 'gnus)
-(require 'nnoo)
-(require 'gnus-util)
-(require 'gnus-start)
-(require 'gnus-sum)
-(require 'gnus-msg)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nnvirtual)
-
-(defvoo nnvirtual-always-rescan t
- "If non-nil, always scan groups for unread articles when entering a group.
-If this variable is nil and you read articles in a component group
-after the virtual group has been activated, the read articles from the
-component group will show up when you enter the virtual group.")
-
-(defvoo nnvirtual-component-regexp nil
- "Regexp to match component groups.")
-
-(defvoo nnvirtual-component-groups nil
- "Component group in this nnvirtual group.")
-
-\f
-
-(defconst nnvirtual-version "nnvirtual 1.1")
-
-(defvoo nnvirtual-current-group nil)
-
-(defvoo nnvirtual-mapping-table nil
- "Table of rules on how to map between component group and article number to virtual article number.")
-
-(defvoo nnvirtual-mapping-offsets nil
- "Table indexed by component group to an offset to be applied to article numbers in that group.")
-
-(defvoo nnvirtual-mapping-len 0
- "Number of articles in this virtual group.")
-
-(defvoo nnvirtual-mapping-reads nil
- "Compressed sequence of read articles on the virtual group as computed from the unread status of individual component groups.")
-
-(defvoo nnvirtual-mapping-marks nil
- "Compressed marks alist for the virtual group as computed from the marks of individual component groups.")
-
-(defvoo nnvirtual-info-installed nil
- "T if we have already installed the group info for this group, and shouldn't blast over it again.")
-
-(defvoo nnvirtual-status-string "")
-
-(eval-and-compile
- (autoload 'gnus-cache-articles-in-group "gnus-cache"))
-
-\f
-
-;;; Interface functions.
-
-(nnoo-define-basics nnvirtual)
-
-
-(deffoo nnvirtual-retrieve-headers (articles &optional newsgroup
- server fetch-old)
- (when (nnvirtual-possibly-change-server server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (if (stringp (car articles))
- 'headers
- (let ((vbuf (nnheader-set-temp-buffer
- (get-buffer-create " *virtual headers*")))
- (carticles (nnvirtual-partition-sequence articles))
- (system-name (system-name))
- cgroup carticle article result prefix)
- (while carticles
- (setq cgroup (caar carticles))
- (setq articles (cdar carticles))
- (pop carticles)
- (when (and articles
- (gnus-check-server
- (gnus-find-method-for-group cgroup) t)
- (gnus-request-group cgroup t)
- (setq prefix (gnus-group-real-prefix cgroup))
- ;; FIX FIX FIX we want to check the cache!
- ;; This is probably evil if people have set
- ;; gnus-use-cache to nil themselves, but I
- ;; have no way of finding the true value of it.
- (let ((gnus-use-cache t))
- (setq result (gnus-retrieve-headers
- articles cgroup nil))))
- (set-buffer nntp-server-buffer)
- ;; If we got HEAD headers, we convert them into NOV
- ;; headers. This is slow, inefficient and, come to think
- ;; of it, downright evil. So sue me. I couldn't be
- ;; bothered to write a header parse routine that could
- ;; parse a mixed HEAD/NOV buffer.
- (when (eq result 'headers)
- (nnvirtual-convert-headers))
- (goto-char (point-min))
- (while (not (eobp))
- (delete-region (point)
- (progn
- (setq carticle (read nntp-server-buffer))
- (point)))
-
- ;; We remove this article from the articles list, if
- ;; anything is left in the articles list after going through
- ;; the entire buffer, then those articles have been
- ;; expired or canceled, so we appropriately update the
- ;; component group below. They should be coming up
- ;; generally in order, so this shouldn't be slow.
- (setq articles (delq carticle articles))
-
- (setq article (nnvirtual-reverse-map-article cgroup carticle))
- (if (null article)
- ;; This line has no reverse mapping, that means it
- ;; was an extra article reference returned by nntp.
- (progn
- (beginning-of-line)
- (delete-region (point) (progn (forward-line 1) (point))))
- ;; Otherwise insert the virtual article number,
- ;; and clean up the xrefs.
- (princ article nntp-server-buffer)
- (nnvirtual-update-xref-header cgroup carticle
- prefix system-name)
- (forward-line 1))
- )
-
- (set-buffer vbuf)
- (goto-char (point-max))
- (insert-buffer-substring nntp-server-buffer))
- ;; Anything left in articles is expired or canceled.
- ;; Could be smart and not tell it about articles already known?
- (when articles
- (gnus-group-make-articles-read cgroup articles))
- )
-
- ;; The headers are ready for reading, so they are inserted into
- ;; the nntp-server-buffer, which is where Gnus expects to find
- ;; them.
- (prog1
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (insert-buffer-substring vbuf)
- ;; FIX FIX FIX, we should be able to sort faster than
- ;; this if needed, since each cgroup is sorted, we just
- ;; need to merge
- (sort-numeric-fields 1 (point-min) (point-max))
- 'nov)
- (kill-buffer vbuf)))))))
-
-
-(defvoo nnvirtual-last-accessed-component-group nil)
-
-(deffoo nnvirtual-request-article (article &optional group server buffer)
- (when (nnvirtual-possibly-change-server server)
- (if (stringp article)
- ;; This is a fetch by Message-ID.
- (cond
- ((not nnvirtual-last-accessed-component-group)
- (nnheader-report
- 'nnvirtual "Don't know what server to request from"))
- (t
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (let* ((gnus-override-method nil)
- (method (gnus-find-method-for-group
- nnvirtual-last-accessed-component-group)))
- (funcall (gnus-get-function method 'request-article)
- article nil (nth 1 method) buffer)))))
- ;; This is a fetch by number.
- (let* ((amap (nnvirtual-map-article article))
- (cgroup (car amap)))
- (cond
- ((not amap)
- (nnheader-report 'nnvirtual "No such article: %s" article))
- ((not (gnus-check-group cgroup))
- (nnheader-report
- 'nnvirtual "Can't open server where %s exists" cgroup))
- ((not (gnus-request-group cgroup t))
- (nnheader-report 'nnvirtual "Can't open component group %s" cgroup))
- (t
- (setq nnvirtual-last-accessed-component-group cgroup)
- (if buffer
- (save-excursion
- (set-buffer buffer)
- ;; We bind this here to avoid double decoding.
- (let ((gnus-article-decode-hook nil))
- (gnus-request-article-this-buffer (cdr amap) cgroup)))
- (gnus-request-article (cdr amap) cgroup))))))))
-
-
-(deffoo nnvirtual-open-server (server &optional defs)
- (unless (assq 'nnvirtual-component-regexp defs)
- (push `(nnvirtual-component-regexp ,server)
- defs))
- (nnoo-change-server 'nnvirtual server defs)
- (if nnvirtual-component-groups
- t
- (setq nnvirtual-mapping-table nil
- nnvirtual-mapping-offsets nil
- nnvirtual-mapping-len 0
- nnvirtual-mapping-reads nil
- nnvirtual-mapping-marks nil
- nnvirtual-info-installed nil)
- (when nnvirtual-component-regexp
- ;; Go through the newsrc alist and find all component groups.
- (let ((newsrc (cdr gnus-newsrc-alist))
- group)
- (while (setq group (car (pop newsrc)))
- (when (string-match nnvirtual-component-regexp group) ; Match
- ;; Add this group to the list of component groups.
- (setq nnvirtual-component-groups
- (cons group (delete group nnvirtual-component-groups)))))))
- (if (not nnvirtual-component-groups)
- (nnheader-report 'nnvirtual "No component groups: %s" server)
- t)))
-
-
-(deffoo nnvirtual-request-group (group &optional server dont-check)
- (nnvirtual-possibly-change-server server)
- (setq nnvirtual-component-groups
- (delete (nnvirtual-current-group) nnvirtual-component-groups))
- (cond
- ((null nnvirtual-component-groups)
- (setq nnvirtual-current-group nil)
- (nnheader-report 'nnvirtual "No component groups in %s" group))
- (t
- (setq nnvirtual-current-group group)
- (when (or (not dont-check)
- nnvirtual-always-rescan)
- (nnvirtual-create-mapping)
- (when nnvirtual-always-rescan
- (nnvirtual-request-update-info
- (nnvirtual-current-group)
- (gnus-get-info (nnvirtual-current-group)))))
- (nnheader-insert "211 %d 1 %d %s\n"
- nnvirtual-mapping-len nnvirtual-mapping-len group))))
-
-
-(deffoo nnvirtual-request-type (group &optional article)
- (if (not article)
- 'unknown
- (if (numberp article)
- (let ((mart (nnvirtual-map-article article)))
- (if mart
- (gnus-request-type (car mart) (cdr mart))))
- (gnus-request-type
- nnvirtual-last-accessed-component-group nil))))
-
-(deffoo nnvirtual-request-update-mark (group article mark)
- (let* ((nart (nnvirtual-map-article article))
- (cgroup (car nart)))
- (when (and nart
- (memq mark gnus-auto-expirable-marks)
- ;; The component group might be a virtual group.
- (= mark (gnus-request-update-mark cgroup (cdr nart) mark))
- (gnus-group-auto-expirable-p cgroup))
- (setq mark gnus-expirable-mark)))
- mark)
-
-
-(deffoo nnvirtual-close-group (group &optional server)
- (when (and (nnvirtual-possibly-change-server server)
- (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
- (nnvirtual-update-read-and-marked t t))
- t)
-
-
-(deffoo nnvirtual-request-list (&optional server)
- (nnheader-report 'nnvirtual "LIST is not implemented."))
-
-
-(deffoo nnvirtual-request-newgroups (date &optional server)
- (nnheader-report 'nnvirtual "NEWGROUPS is not supported."))
-
-
-(deffoo nnvirtual-request-list-newsgroups (&optional server)
- (nnheader-report 'nnvirtual "LIST NEWSGROUPS is not implemented."))
-
-
-(deffoo nnvirtual-request-update-info (group info &optional server)
- (when (and (nnvirtual-possibly-change-server server)
- (not nnvirtual-info-installed))
- ;; Install the precomputed lists atomically, so the virtual group
- ;; is not left in a half-way state in case of C-g.
- (gnus-atomic-progn
- (setcar (cddr info) nnvirtual-mapping-reads)
- (if (nthcdr 3 info)
- (setcar (nthcdr 3 info) nnvirtual-mapping-marks)
- (when nnvirtual-mapping-marks
- (setcdr (nthcdr 2 info) (list nnvirtual-mapping-marks))))
- (setq nnvirtual-info-installed t))
- t))
-
-
-(deffoo nnvirtual-catchup-group (group &optional server all)
- (when (and (nnvirtual-possibly-change-server server)
- (not (gnus-ephemeral-group-p (nnvirtual-current-group))))
- ;; copy over existing marks first, in case they set anything
- (nnvirtual-update-read-and-marked nil nil)
- ;; do a catchup on all component groups
- (let ((gnus-group-marked (copy-sequence nnvirtual-component-groups))
- (gnus-expert-user t))
- ;; Make sure all groups are activated.
- (mapcar
- (lambda (g)
- (when (not (numberp (car (gnus-gethash g gnus-newsrc-hashtb))))
- (gnus-activate-group g)))
- nnvirtual-component-groups)
- (save-excursion
- (set-buffer gnus-group-buffer)
- (gnus-group-catchup-current nil all)))))
-
-
-(deffoo nnvirtual-find-group-art (group article)
- "Return the real group and article for virtual GROUP and ARTICLE."
- (nnvirtual-map-article article))
-
-
-(deffoo nnvirtual-request-post (&optional server)
- (if (not gnus-message-group-art)
- (nnheader-report 'nnvirtual "Can't post to an nnvirtual group")
- (let ((group (car (nnvirtual-find-group-art
- (car gnus-message-group-art)
- (cdr gnus-message-group-art)))))
- (gnus-request-post (gnus-find-method-for-group group)))))
-
-
-(deffoo nnvirtual-request-expire-articles (articles group
- &optional server force)
- (nnvirtual-possibly-change-server server)
- (setq nnvirtual-component-groups
- (delete (nnvirtual-current-group) nnvirtual-component-groups))
- (let (unexpired)
- (dolist (group nnvirtual-component-groups)
- (setq unexpired (nconc unexpired
- (mapcar
- #'(lambda (article)
- (nnvirtual-reverse-map-article
- group article))
- (gnus-uncompress-range
- (gnus-group-expire-articles-1 group))))))
- (sort (delq nil unexpired) '<)))
-
-\f
-;;; Internal functions.
-
-(defun nnvirtual-convert-headers ()
- "Convert HEAD headers into NOV headers."
- (save-excursion
- (set-buffer nntp-server-buffer)
- (let* ((dependencies (make-vector 100 0))
- (headers (gnus-get-newsgroup-headers dependencies))
- header)
- (erase-buffer)
- (while (setq header (pop headers))
- (nnheader-insert-nov header)))))
-
-
-(defun nnvirtual-update-xref-header (group article prefix system-name)
- "Edit current NOV header in current buffer to have an xref to the component group, and also server prefix any existing xref lines."
- ;; Move to beginning of Xref field, creating a slot if needed.
- (beginning-of-line)
- (looking-at
- "[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t[^\t]*\t")
- (goto-char (match-end 0))
- (unless (search-forward "\t" (gnus-point-at-eol) 'move)
- (insert "\t"))
-
- ;; Remove any spaces at the beginning of the Xref field.
- (while (eq (char-after (1- (point))) ? )
- (forward-char -1)
- (delete-char 1))
-
- (insert "Xref: " system-name " " group ":")
- (princ article (current-buffer))
- (insert " ")
-
- ;; If there were existing xref lines, clean them up to have the correct
- ;; component server prefix.
- (save-restriction
- (narrow-to-region (point)
- (or (search-forward "\t" (gnus-point-at-eol) t)
- (gnus-point-at-eol)))
- (goto-char (point-min))
- (when (re-search-forward "Xref: *[^\n:0-9 ]+ *" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (when (re-search-forward
- (concat (regexp-quote (gnus-group-real-name group)) ":[0-9]+")
- nil t)
- (replace-match "" t t))
- (unless (eobp)
- (insert " ")
- (when (not (string= "" prefix))
- (while (re-search-forward "[^ ]+:[0-9]+" nil t)
- (save-excursion
- (goto-char (match-beginning 0))
- (insert prefix))))))
-
- ;; Ensure a trailing \t.
- (end-of-line)
- (or (eq (char-after (1- (point))) ?\t)
- (insert ?\t)))
-
-
-(defun nnvirtual-possibly-change-server (server)
- (or (not server)
- (nnoo-current-server-p 'nnvirtual server)
- (nnvirtual-open-server server)))
-
-
-(defun nnvirtual-update-read-and-marked (read-p update-p)
- "Copy marks from the virtual group to the component groups.
-If READ-P is not nil, update the (un)read status of the components.
-If UPDATE-P is not nil, call gnus-group-update-group on the components."
- (when nnvirtual-current-group
- (let ((unreads (and read-p
- (nnvirtual-partition-sequence
- (gnus-list-of-unread-articles
- (nnvirtual-current-group)))))
- (type-marks
- (delq nil
- (mapcar (lambda (ml)
- (if (eq (car ml) 'score)
- nil
- (cons (car ml)
- (nnvirtual-partition-sequence (cdr ml)))))
- (gnus-info-marks (gnus-get-info
- (nnvirtual-current-group))))))
- mark type groups carticles info entry)
-
- ;; Ok, atomically move all of the (un)read info, clear any old
- ;; marks, and move all of the current marks. This way if someone
- ;; hits C-g, you won't leave the component groups in a half-way state.
- (progn
- ;; move (un)read
- ;; bind for workaround guns-update-read-articles
- (let ((gnus-newsgroup-active nil))
- (while (setq entry (pop unreads))
- (gnus-update-read-articles (car entry) (cdr entry))))
-
- ;; clear all existing marks on the component groups
- (setq groups nnvirtual-component-groups)
- (while groups
- (when (and (setq info (gnus-get-info (pop groups)))
- (gnus-info-marks info))
- (gnus-info-set-marks
- info
- (if (assq 'score (gnus-info-marks info))
- (list (assq 'score (gnus-info-marks info)))
- nil))))
-
- ;; Ok, currently type-marks is an assq list with keys of a mark type,
- ;; with data of an assq list with keys of component group names
- ;; and the articles which correspond to that key/group pair.
- (while (setq mark (pop type-marks))
- (setq type (car mark))
- (setq groups (cdr mark))
- (while (setq carticles (pop groups))
- (gnus-add-marked-articles (car carticles) type (cdr carticles)
- nil t))))
-
- ;; possibly update the display, it is really slow
- (when update-p
- (setq groups nnvirtual-component-groups)
- (while groups
- (gnus-group-update-group (pop groups) t))))))
-
-
-(defun nnvirtual-current-group ()
- "Return the prefixed name of the current nnvirtual group."
- (concat "nnvirtual:" nnvirtual-current-group))
-
-
-
-;;; This is currently O(kn^2) to merge n lists of length k.
-;;; You could do it in O(knlogn), but we have a small n, and the
-;;; overhead of the other approach is probably greater.
-(defun nnvirtual-merge-sorted-lists (&rest lists)
- "Merge many sorted lists of numbers."
- (if (null (cdr lists))
- (car lists)
- (sort (apply 'nconc lists) '<)))
-
-
-;;; We map between virtual articles and real articles in a manner
-;;; which keeps the size of the virtual active list the same as the
-;;; sum of the component active lists.
-
-;;; To achieve fair mixing of the groups, the last article in each of
-;;; N component groups will be in the last N articles in the virtual
-;;; group.
-
-;;; If you have 3 components A, B and C, with articles 1-8, 1-5, and
-;;; 6-7 respectively, then the virtual article numbers look like:
-;;;
-;;; 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
-;;; A1 A2 A3 A4 B1 A5 B2 A6 B3 A7 B4 C6 A8 B5 C7
-
-;;; To compute these mappings we generate a couple tables and then
-;;; do some fast operations on them. Tables for the example above:
-;;;
-;;; Offsets - [(A 0) (B -3) (C -1)]
-;;;
-;;; a b c d e
-;;; Mapping - ([ 3 0 1 3 0 ]
-;;; [ 6 3 2 9 3 ]
-;;; [ 8 6 3 15 9 ])
-;;;
-;;; (note column 'e' is different in real algorithm, which is slightly
-;;; different than described here, but this gives you the methodology.)
-;;;
-;;; The basic idea is this, when going from component->virtual, apply
-;;; the appropriate offset to the article number. Then search the first
-;;; column of the table for a row where 'a' is less than or equal to the
-;;; modified number. You can see that only group A can therefore go to
-;;; the first row, groups A and B to the second, and all to the last.
-;;; The third column of the table is telling us the number of groups
-;;; which might be able to reach that row (it might increase by more than
-;;; 1 if several groups have the same size).
-;;; Then column 'b' provides an additional offset you apply when you have
-;;; found the correct row. You then multiply by 'c' and add on the groups
-;;; _position_ in the offset table. The basic idea here is that on
-;;; any given row we are going to map back and forth using X'=X*c+Y and
-;;; X=(X'/c), Y=(X' mod c). Then once you've done this transformation,
-;;; you apply a final offset from column 'e' to give the virtual article.
-;;;
-;;; Going the other direction, you instead search on column 'd' instead
-;;; of 'a', and apply everything in reverse order.
-
-;;; Convert component -> virtual:
-;;; set num = num - Offset(group)
-;;; find first row in Mapping where num <= 'a'
-;;; num = (num-'b')*c + Position(group) + 'e'
-
-;;; Convert virtual -> component:
-;;; find first row in Mapping where num <= 'd'
-;;; num = num - 'e'
-;;; group_pos = num mod 'c'
-;;; num = (num / 'c') + 'b' + Offset(group_pos)
-
-;;; Easy no? :)
-;;;
-;;; Well actually, you need to keep column e offset smaller by the 'c'
-;;; column for that line, and always add 1 more when going from
-;;; component -> virtual. Otherwise you run into a problem with
-;;; unique reverse mapping.
-
-(defun nnvirtual-map-article (article)
- "Return a cons of the component group and article corresponding to the given virtual ARTICLE."
- (let ((table nnvirtual-mapping-table)
- entry group-pos)
- (while (and table
- (> article (aref (car table) 3)))
- (setq table (cdr table)))
- (when (and table
- (> article 0))
- (setq entry (car table))
- (setq article (- article (aref entry 4) 1))
- (setq group-pos (mod article (aref entry 2)))
- (cons (car (aref nnvirtual-mapping-offsets group-pos))
- (+ (/ article (aref entry 2))
- (aref entry 1)
- (cdr (aref nnvirtual-mapping-offsets group-pos)))
- ))
- ))
-
-
-
-(defun nnvirtual-reverse-map-article (group article)
- "Return the virtual article number corresponding to the given component GROUP and ARTICLE."
- (when (numberp article)
- (let ((table nnvirtual-mapping-table)
- (group-pos 0)
- entry)
- (while (not (string= group (car (aref nnvirtual-mapping-offsets
- group-pos))))
- (setq group-pos (1+ group-pos)))
- (setq article (- article (cdr (aref nnvirtual-mapping-offsets
- group-pos))))
- (while (and table
- (> article (aref (car table) 0)))
- (setq table (cdr table)))
- (setq entry (car table))
- (when (and entry
- (> article 0)
- (< group-pos (aref entry 2))) ; article not out of range below
- (+ (aref entry 4)
- group-pos
- (* (- article (aref entry 1))
- (aref entry 2))
- 1))
- )))
-
-
-(defsubst nnvirtual-reverse-map-sequence (group articles)
- "Return list of virtual article numbers for all ARTICLES in GROUP.
-The ARTICLES should be sorted, and can be a compressed sequence.
-If any of the article numbers has no corresponding virtual article,
-then it is left out of the result."
- (when (numberp (cdr-safe articles))
- (setq articles (list articles)))
- (let (result a i j new-a)
- (while (setq a (pop articles))
- (if (atom a)
- (setq i a
- j a)
- (setq i (car a)
- j (cdr a)))
- (while (<= i j)
- ;; If this is slow, you can optimize by moving article checking
- ;; into here. You don't have to recompute the group-pos,
- ;; nor scan the table every time.
- (when (setq new-a (nnvirtual-reverse-map-article group i))
- (push new-a result))
- (setq i (1+ i))))
- (nreverse result)))
-
-
-(defun nnvirtual-partition-sequence (articles)
- "Return an association list of component article numbers.
-These are indexed by elements of nnvirtual-component-groups, based on
-the sequence ARTICLES of virtual article numbers. ARTICLES should be
-sorted, and can be a compressed sequence. If any of the article
-numbers has no corresponding component article, then it is left out of
-the result."
- (when (numberp (cdr-safe articles))
- (setq articles (list articles)))
- (let ((carticles (mapcar (lambda (g) (list g))
- nnvirtual-component-groups))
- a i j article entry)
- (while (setq a (pop articles))
- (if (atom a)
- (setq i a
- j a)
- (setq i (car a)
- j (cdr a)))
- (while (<= i j)
- (when (setq article (nnvirtual-map-article i))
- (setq entry (assoc (car article) carticles))
- (setcdr entry (cons (cdr article) (cdr entry))))
- (setq i (1+ i))))
- (mapcar (lambda (x) (setcdr x (nreverse (cdr x))))
- carticles)
- carticles))
-
-
-(defun nnvirtual-create-mapping ()
- "Build the tables necessary to map between component (group, article) to virtual article.
-Generate the set of read messages and marks for the virtual group
-based on the marks on the component groups."
- (let ((cnt 0)
- (tot 0)
- (M 0)
- (i 0)
- actives all-unreads all-marks
- active min max size unreads marks
- next-M next-tot
- reads beg)
- ;; Ok, we loop over all component groups and collect a lot of
- ;; information:
- ;; Into actives we place (g size max), where size is max-min+1.
- ;; Into all-unreads we put (g unreads).
- ;; Into all-marks we put (g marks).
- ;; We also increment cnt and tot here, and compute M (max of sizes).
- (mapcar (lambda (g)
- (setq active (gnus-activate-group g)
- min (car active)
- max (cdr active))
- (when (and active (>= max min) (not (zerop max)))
- ;; store active information
- (push (list g (- max min -1) max) actives)
- ;; collect unread/mark info for later
- (setq unreads (gnus-list-of-unread-articles g))
- (setq marks (gnus-info-marks (gnus-get-info g)))
- (when gnus-use-cache
- (push (cons 'cache
- (gnus-cache-articles-in-group g))
- marks))
- (push (cons g unreads) all-unreads)
- (push (cons g marks) all-marks)
- ;; count groups, total #articles, and max size
- (setq size (- max min -1))
- (setq cnt (1+ cnt)
- tot (+ tot size)
- M (max M size))))
- nnvirtual-component-groups)
-
- ;; Number of articles in the virtual group.
- (setq nnvirtual-mapping-len tot)
-
-
- ;; We want the actives list sorted by size, to build the tables.
- (setq actives (sort actives (lambda (g1 g2) (< (nth 1 g1) (nth 1 g2)))))
-
- ;; Build the offset table. Largest sized groups are at the front.
- (setq nnvirtual-mapping-offsets
- (vconcat
- (nreverse
- (mapcar (lambda (entry)
- (cons (nth 0 entry)
- (- (nth 2 entry) M)))
- actives))))
-
- ;; Build the mapping table.
- (setq nnvirtual-mapping-table nil)
- (setq actives (mapcar (lambda (entry) (nth 1 entry)) actives))
- (while actives
- (setq size (car actives))
- (setq next-M (- M size))
- (setq next-tot (- tot (* cnt size)))
- ;; make current row in table
- (push (vector M next-M cnt tot (- next-tot cnt))
- nnvirtual-mapping-table)
- ;; update M and tot
- (setq M next-M)
- (setq tot next-tot)
- ;; subtract the current size from all entries.
- (setq actives (mapcar (lambda (x) (- x size)) actives))
- ;; remove anything that went to 0.
- (while (and actives
- (= (car actives) 0))
- (pop actives)
- (setq cnt (- cnt 1))))
-
-
- ;; Now that the mapping tables are generated, we can convert
- ;; and combine the separate component unreads and marks lists
- ;; into single lists of virtual article numbers.
- (setq unreads (apply 'nnvirtual-merge-sorted-lists
- (mapcar (lambda (x)
- (nnvirtual-reverse-map-sequence
- (car x) (cdr x)))
- all-unreads)))
- (setq marks (mapcar
- (lambda (type)
- (cons (cdr type)
- (gnus-compress-sequence
- (apply
- 'nnvirtual-merge-sorted-lists
- (mapcar (lambda (x)
- (nnvirtual-reverse-map-sequence
- (car x)
- (cdr (assq (cdr type) (cdr x)))))
- all-marks)))))
- gnus-article-mark-lists))
-
- ;; Remove any empty marks lists, and store.
- (setq nnvirtual-mapping-marks nil)
- (while marks
- (if (cdr (car marks))
- (push (car marks) nnvirtual-mapping-marks))
- (setq marks (cdr marks)))
-
- ;; We need to convert the unreads to reads. We compress the
- ;; sequence as we go, otherwise it could be huge.
- (while (and (<= (incf i) nnvirtual-mapping-len)
- unreads)
- (if (= i (car unreads))
- (setq unreads (cdr unreads))
- ;; try to get a range.
- (setq beg i)
- (while (and (<= (incf i) nnvirtual-mapping-len)
- (not (= i (car unreads)))))
- (setq i (- i 1))
- (if (= i beg)
- (push i reads)
- (push (cons beg i) reads))
- ))
- (when (<= i nnvirtual-mapping-len)
- (if (= i nnvirtual-mapping-len)
- (push i reads)
- (push (cons i nnvirtual-mapping-len) reads)))
-
- ;; Store the reads list for later use.
- (setq nnvirtual-mapping-reads (nreverse reads))
-
- ;; Throw flag to show we changed the info.
- (setq nnvirtual-info-installed nil)
- ))
-
-(provide 'nnvirtual)
-
-;;; arch-tag: ca8c8ad9-1bd8-4b0f-9722-90dc645a45f5
-;;; nnvirtual.el ends here
+++ /dev/null
-;;; nnwarchive.el --- interfacing with web archives
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: news egroups mail-archive
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Note: You need to have `url' (w3 0.46) or greater version
-;; installed for some functions of this backend to work.
-
-;; Todo:
-;; 1. To support more web archives.
-;; 2. Generalize webmail to other MHonArc archive.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'gnus-bcklg)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-
-(nnoo-declare nnwarchive)
-
-(defvar nnwarchive-type-definition
- '((egroups
- (address . "www.egroups.com")
- (open-url
- "http://www.egroups.com/login.cgi?&login_email=%s&login_password=%s"
- nnwarchive-login nnwarchive-passwd)
- (list-url
- "http://www.egroups.com/mygroups")
- (list-dissect . nnwarchive-egroups-list)
- (list-groups . nnwarchive-egroups-list-groups)
- (xover-url
- "http://www.egroups.com/messages/%s/%d" group aux)
- (xover-last-url
- "http://www.egroups.com/messages/%s/" group)
- (xover-page-size . 13)
- (xover-dissect . nnwarchive-egroups-xover)
- (article-url
- "http://www.egroups.com/message/%s/%d?source=1" group article)
- (article-dissect . nnwarchive-egroups-article)
- (authentication . t)
- (article-offset . 0)
- (xover-files . nnwarchive-egroups-xover-files))
- (mail-archive
- (address . "www.mail-archive.com")
- (open-url)
- (list-url
- "http://www.mail-archive.com/lists.html")
- (list-dissect . nnwarchive-mail-archive-list)
- (list-groups . nnwarchive-mail-archive-list-groups)
- (xover-url
- "http://www.mail-archive.com/%s/mail%d.html" group aux)
- (xover-last-url
- "http://www.mail-archive.com/%s/maillist.html" group)
- (xover-page-size)
- (xover-dissect . nnwarchive-mail-archive-xover)
- (article-url
- "http://www.mail-archive.com/%s/msg%05d.html" group article1)
- (article-dissect . nnwarchive-mail-archive-article)
- (xover-files . nnwarchive-mail-archive-xover-files)
- (authentication)
- (article-offset . 1))))
-
-(defvar nnwarchive-default-type 'egroups)
-
-(defvoo nnwarchive-directory (nnheader-concat gnus-directory "warchive/")
- "Where nnwarchive will save its files.")
-
-(defvoo nnwarchive-type nil
- "The type of nnwarchive.")
-
-(defvoo nnwarchive-address ""
- "The address of nnwarchive.")
-
-(defvoo nnwarchive-login nil
- "Your login name for the group.")
-
-(defvoo nnwarchive-passwd nil
- "Your password for the group.")
-
-(defvoo nnwarchive-groups nil)
-
-(defvoo nnwarchive-headers-cache nil)
-
-(defvoo nnwarchive-authentication nil)
-
-(defvoo nnwarchive-nov-is-evil nil)
-
-(defconst nnwarchive-version "nnwarchive 1.0")
-
-;;; Internal variables
-
-(defvoo nnwarchive-open-url nil)
-(defvoo nnwarchive-open-dissect nil)
-
-(defvoo nnwarchive-list-url nil)
-(defvoo nnwarchive-list-dissect nil)
-(defvoo nnwarchive-list-groups nil)
-
-(defvoo nnwarchive-xover-files nil)
-(defvoo nnwarchive-xover-url nil)
-(defvoo nnwarchive-xover-last-url nil)
-(defvoo nnwarchive-xover-dissect nil)
-(defvoo nnwarchive-xover-page-size nil)
-
-(defvoo nnwarchive-article-url nil)
-(defvoo nnwarchive-article-dissect nil)
-(defvoo nnwarchive-xover-files nil)
-(defvoo nnwarchive-article-offset 0)
-
-(defvoo nnwarchive-buffer nil)
-
-(defvoo nnwarchive-keep-backlog 300)
-(defvar nnwarchive-backlog-articles nil)
-(defvar nnwarchive-backlog-hashtb nil)
-
-(defvoo nnwarchive-headers nil)
-
-
-;;; Interface functions
-
-(nnoo-define-basics nnwarchive)
-
-(defun nnwarchive-set-default (type)
- (let ((defs (cdr (assq type nnwarchive-type-definition)))
- def)
- (dolist (def defs)
- (set (intern (concat "nnwarchive-" (symbol-name (car def))))
- (cdr def)))))
-
-(defmacro nnwarchive-backlog (&rest form)
- `(let ((gnus-keep-backlog nnwarchive-keep-backlog)
- (gnus-backlog-buffer
- (format " *nnwarchive backlog %s*" nnwarchive-address))
- (gnus-backlog-articles nnwarchive-backlog-articles)
- (gnus-backlog-hashtb nnwarchive-backlog-hashtb))
- (unwind-protect
- (progn ,@form)
- (setq nnwarchive-backlog-articles gnus-backlog-articles
- nnwarchive-backlog-hashtb gnus-backlog-hashtb))))
-(put 'nnwarchive-backlog 'lisp-indent-function 0)
-(put 'nnwarchive-backlog 'edebug-form-spec '(form body))
-
-(defun nnwarchive-backlog-enter-article (group number buffer)
- (nnwarchive-backlog
- (gnus-backlog-enter-article group number buffer)))
-
-(defun nnwarchive-get-article (article &optional group server buffer)
- (if (numberp article)
- (if (nnwarchive-backlog
- (gnus-backlog-request-article group article
- (or buffer nntp-server-buffer)))
- (cons group article)
- (let (contents)
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (goto-char (point-min))
- (let ((article1 (- article nnwarchive-article-offset)))
- (nnwarchive-url nnwarchive-article-url))
- (setq contents (funcall nnwarchive-article-dissect group article)))
- (when contents
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (insert contents)
- (nnwarchive-backlog-enter-article group article (current-buffer))
- (nnheader-report 'nnwarchive "Fetched article %s" article)
- (cons group article)))))
- nil))
-
-(deffoo nnwarchive-retrieve-headers (articles &optional group server fetch-old)
- (nnwarchive-possibly-change-server group server)
- (if (or gnus-nov-is-evil nnwarchive-nov-is-evil)
- (with-temp-buffer
- (with-current-buffer nntp-server-buffer
- (erase-buffer))
- (let ((buf (current-buffer)) b e)
- (dolist (art articles)
- (nnwarchive-get-article art group server buf)
- (setq b (goto-char (point-min)))
- (if (search-forward "\n\n" nil t)
- (forward-char -1)
- (goto-char (point-max)))
- (setq e (point))
- (with-current-buffer nntp-server-buffer
- (insert (format "221 %d Article retrieved.\n" art))
- (insert-buffer-substring buf b e)
- (insert ".\n"))))
- 'headers)
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (funcall nnwarchive-xover-files group articles))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let (header)
- (dolist (art articles)
- (if (setq header (assq art nnwarchive-headers))
- (nnheader-insert-nov (cdr header))))))
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))
- 'nov))
-
-(deffoo nnwarchive-request-group (group &optional server dont-check)
- (nnwarchive-possibly-change-server nil server)
- (when (and (not dont-check) nnwarchive-list-groups)
- (funcall nnwarchive-list-groups (list group))
- (nnwarchive-write-groups))
- (let ((elem (assoc group nnwarchive-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnwarchive "Group does not exist"))
- (t
- (nnheader-report 'nnwarchive "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (or (cadr elem) 0) 1 (or (cadr elem) 0)
- (prin1-to-string group))
- t))))
-
-(deffoo nnwarchive-request-article (article &optional group server buffer)
- (nnwarchive-possibly-change-server group server)
- (nnwarchive-get-article article group server buffer))
-
-(deffoo nnwarchive-close-server (&optional server)
- (when (and (nnwarchive-server-opened server)
- (gnus-buffer-live-p nnwarchive-buffer))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (kill-buffer nnwarchive-buffer)))
- (nnwarchive-backlog
- (gnus-backlog-shutdown))
- (nnoo-close-server 'nnwarchive server))
-
-(deffoo nnwarchive-request-list (&optional server)
- (nnwarchive-possibly-change-server nil server)
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (if nnwarchive-list-url
- (nnwarchive-url nnwarchive-list-url))
- (if nnwarchive-list-dissect
- (funcall nnwarchive-list-dissect))
- (nnwarchive-write-groups)
- (nnwarchive-generate-active))
- t)
-
-(deffoo nnwarchive-open-server (server &optional defs connectionless)
- (nnoo-change-server 'nnwarchive server defs)
- (nnwarchive-init server)
- (when nnwarchive-authentication
- (setq nnwarchive-login
- (or nnwarchive-login
- (read-string
- (format "Login at %s: " server)
- user-mail-address)))
- (setq nnwarchive-passwd
- (or nnwarchive-passwd
- (read-passwd
- (format "Password for %s at %s: "
- nnwarchive-login server)))))
- (unless nnwarchive-groups
- (nnwarchive-read-groups))
- (save-excursion
- (set-buffer nnwarchive-buffer)
- (erase-buffer)
- (if nnwarchive-open-url
- (nnwarchive-url nnwarchive-open-url))
- (if nnwarchive-open-dissect
- (funcall nnwarchive-open-dissect)))
- t)
-
-(nnoo-define-skeleton nnwarchive)
-
-;;; Internal functions
-
-(defun nnwarchive-possibly-change-server (&optional group server)
- (nnwarchive-init server)
- (when (and server
- (not (nnwarchive-server-opened server)))
- (nnwarchive-open-server server)))
-
-(defun nnwarchive-read-groups ()
- (let ((file (expand-file-name (concat "groups-" nnwarchive-address)
- nnwarchive-directory)))
- (when (file-exists-p file)
- (with-temp-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnwarchive-groups (read (current-buffer)))))))
-
-(defun nnwarchive-write-groups ()
- (with-temp-file (expand-file-name (concat "groups-" nnwarchive-address)
- nnwarchive-directory)
- (prin1 nnwarchive-groups (current-buffer))))
-
-(defun nnwarchive-init (server)
- "Initialize buffers and such."
- (let ((type (intern server)) (defs nnwarchive-type-definition) def)
- (cond
- ((equal server "")
- (setq type nnwarchive-default-type))
- ((assq type nnwarchive-type-definition) t)
- (t
- (setq type nil)
- (while (setq def (pop defs))
- (when (equal (cdr (assq 'address (cdr def))) server)
- (setq defs nil)
- (setq type (car def))))
- (unless type
- (error "Undefined server %s" server))))
- (setq nnwarchive-type type))
- (unless (file-exists-p nnwarchive-directory)
- (gnus-make-directory nnwarchive-directory))
- (unless (gnus-buffer-live-p nnwarchive-buffer)
- (setq nnwarchive-buffer
- (save-excursion
- (nnheader-set-temp-buffer
- (format " *nnwarchive %s %s*" nnwarchive-type server)))))
- (nnwarchive-set-default nnwarchive-type))
-
-(defun nnwarchive-eval (expr)
- (cond
- ((consp expr)
- (cons (nnwarchive-eval (car expr)) (nnwarchive-eval (cdr expr))))
- ((symbolp expr)
- (eval expr))
- (t
- expr)))
-
-(defun nnwarchive-url (xurl)
- (mm-with-unibyte-current-buffer
- (let ((url-confirmation-func 'identity) ;; Some hacks.
- (url-cookie-multiple-line nil))
- (cond
- ((eq (car xurl) 'post)
- (pop xurl)
- (mm-url-fetch-form (car xurl) (nnwarchive-eval (cdr xurl))))
- (t
- (mm-url-insert (apply 'format (nnwarchive-eval xurl))))))))
-
-(defun nnwarchive-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnwarchive-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (or (cadr elem) 0)) " 1 y\n"))))
-
-(defun nnwarchive-paged (articles)
- (let (art narts next)
- (while (setq art (pop articles))
- (when (and (>= art (or next 0))
- (not (assq art nnwarchive-headers)))
- (push art narts)
- (setq next (+ art nnwarchive-xover-page-size))))
- narts))
-
-;; egroups
-
-(defun nnwarchive-egroups-list-groups (groups)
- (save-excursion
- (let (articles)
- (set-buffer nnwarchive-buffer)
- (dolist (group groups)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (when (re-search-forward "of \\([0-9]+\\)[ \t\n\r]*</title>" nil t)
- (setq articles (string-to-number (match-string 1))))
- (let ((elem (assoc group nnwarchive-groups)))
- (if elem
- (setcar (cdr elem) articles)
- (push (list group articles "") nnwarchive-groups)))
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (nnwarchive-egroups-xover group)
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers) nnwarchive-headers-cache)))))))
-
-(defun nnwarchive-egroups-list ()
- (let ((case-fold-search t)
- group description elem articles)
- (goto-char (point-min))
- (while
- (re-search-forward "href=\"/group/\\([^/\"\> ]+\\)" nil t)
- (setq group (match-string 1)
- description (match-string 2))
- (if (setq elem (assoc group nnwarchive-groups))
- (setcar (cdr elem) 0)
- (push (list group articles description) nnwarchive-groups))))
- t)
-
-(defun nnwarchive-egroups-xover (group)
- (let (article subject from date)
- (goto-char (point-min))
- (while (re-search-forward
- "<a href=\"/group/\\([^/]+\\)/\\([0-9]+\\)[^>]+>\\([^<]+\\)<"
- nil t)
- (setq group (match-string 1)
- article (string-to-number (match-string 2))
- subject (match-string 3))
- (forward-line 1)
- (unless (assq article nnwarchive-headers)
- (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
- (setq from (match-string 1)))
- (forward-line 1)
- (if (looking-at "<td[^>]+><font[^>]+>\\([^<]+\\)</font>")
- (setq date (identity (match-string 1))))
- (push (cons
- article
- (make-full-mail-header
- article
- (mm-url-decode-entities-string subject)
- (mm-url-decode-entities-string from)
- date
- (concat "<" group "%"
- (number-to-string article)
- "@egroup.com>")
- ""
- 0 0 "")) nnwarchive-headers))))
- nnwarchive-headers)
-
-(defun nnwarchive-egroups-article (group articles)
- (goto-char (point-min))
- (if (search-forward "<pre>" nil t)
- (delete-region (point-min) (point)))
- (goto-char (point-max))
- (if (search-backward "</pre>" nil t)
- (delete-region (point) (point-max)))
- (goto-char (point-min))
- (while (re-search-forward "<a[^>]+>\\([^<]+\\)</a>" nil t)
- (replace-match "\\1"))
- (mm-url-decode-entities)
- (buffer-string))
-
-(defun nnwarchive-egroups-xover-files (group articles)
- (let (aux auxs)
- (setq auxs (nnwarchive-paged (sort articles '<)))
- (while (setq aux (pop auxs))
- (goto-char (point-max))
- (nnwarchive-url nnwarchive-xover-url))
- (if nnwarchive-xover-dissect
- (nnwarchive-egroups-xover group))))
-
-;; mail-archive
-
-(defun nnwarchive-mail-archive-list-groups (groups)
- (save-excursion
- (let (articles)
- (set-buffer nnwarchive-buffer)
- (dolist (group groups)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (when (re-search-forward "msg\\([0-9]+\\)\\.html" nil t)
- (setq articles (1+ (string-to-number (match-string 1)))))
- (let ((elem (assoc group nnwarchive-groups)))
- (if elem
- (setcar (cdr elem) articles)
- (push (list group articles "") nnwarchive-groups)))
- (setq nnwarchive-headers (cdr (assoc group nnwarchive-headers-cache)))
- (nnwarchive-mail-archive-xover group)
- (let ((elem (assoc group nnwarchive-headers-cache)))
- (if elem
- (setcdr elem nnwarchive-headers)
- (push (cons group nnwarchive-headers)
- nnwarchive-headers-cache)))))))
-
-(defun nnwarchive-mail-archive-list ()
- (let ((case-fold-search t)
- group description elem articles)
- (goto-char (point-min))
- (while (re-search-forward "<a href=\"\\([^/]+\\)/\">\\([^>]+\\)<" nil t)
- (setq group (match-string 1)
- description (match-string 2))
- (forward-line 1)
- (setq articles 0)
- (if (setq elem (assoc group nnwarchive-groups))
- (setcar (cdr elem) articles)
- (push (list group articles description) nnwarchive-groups))))
- t)
-
-(defun nnwarchive-mail-archive-xover (group)
- (let (article subject from date)
- (goto-char (point-min))
- (while (re-search-forward
- "<A[^>]*HREF=\"msg\\([0-9]+\\)\\.html[^>]+>\\([^<]+\\)<"
- nil t)
- (setq article (1+ (string-to-number (match-string 1)))
- subject (match-string 2))
- (forward-line 1)
- (unless (assq article nnwarchive-headers)
- (if (looking-at "<UL><LI><EM>From</EM>: *\\([^<]*[^< ]\\) *<\\([^&]+\\)>")
- (progn
- (setq from (match-string 1)
- date (identity (match-string 2))))
- (setq from "" date ""))
- (push (cons
- article
- (make-full-mail-header
- article
- (mm-url-decode-entities-string subject)
- (mm-url-decode-entities-string from)
- date
- (format "<%05d%%%s>\n" (1- article) group)
- ""
- 0 0 "")) nnwarchive-headers))))
- nnwarchive-headers)
-
-(defun nnwarchive-mail-archive-xover-files (group articles)
- (unless nnwarchive-headers
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-last-url)
- (goto-char (point-min))
- (nnwarchive-mail-archive-xover group))
- (let ((minart (apply 'min articles))
- (min (apply 'min (mapcar 'car nnwarchive-headers)))
- (aux 2))
- (while (> min minart)
- (erase-buffer)
- (nnwarchive-url nnwarchive-xover-url)
- (nnwarchive-mail-archive-xover group)
- (setq min (apply 'min (mapcar 'car nnwarchive-headers))))))
-
-(defvar nnwarchive-caesar-translation-table nil
- "Modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/.")
-
-(defun nnwarchive-make-caesar-translation-table ()
- "Create modified rot13 table. tr/@A-Z[a-z/N-Z[@A-Mn-za-m/."
- (let ((i -1)
- (table (make-string 256 0))
- (a (mm-char-int ?a))
- (A (mm-char-int ?A)))
- (while (< (incf i) 256)
- (aset table i i))
- (concat
- (substring table 0 (1- A))
- (substring table (+ A 13) (+ A 27))
- (substring table (1- A) (+ A 13))
- (substring table (+ A 27) a)
- (substring table (+ a 13) (+ a 26))
- (substring table a (+ a 13))
- (substring table (+ a 26) 255))))
-
-(defun nnwarchive-from-r13 (from-r13)
- (when from-r13
- (with-temp-buffer
- (insert from-r13)
- (let ((message-caesar-translation-table
- (or nnwarchive-caesar-translation-table
- (setq nnwarchive-caesar-translation-table
- (nnwarchive-make-caesar-translation-table)))))
- (message-caesar-region (point-min) (point-max))
- (buffer-string)))))
-
-(defun nnwarchive-mail-archive-article (group article)
- (let (p refs url mime e
- from subject date id
- done
- (case-fold-search t))
- (save-restriction
- (goto-char (point-min))
- (when (search-forward "X-Head-End" nil t)
- (beginning-of-line)
- (narrow-to-region (point-min) (point))
- (mm-url-decode-entities)
- (goto-char (point-min))
- (while (search-forward "<!--X-" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward " -->" nil t)
- (replace-match ""))
- (setq from
- (or (mail-fetch-field "from")
- (nnwarchive-from-r13
- (mail-fetch-field "from-r13"))))
- (setq date (mail-fetch-field "date"))
- (setq id (mail-fetch-field "message-id"))
- (setq subject (mail-fetch-field "subject"))
- (goto-char (point-max))
- (widen))
- (when (search-forward "<ul>" nil t)
- (forward-line)
- (delete-region (point-min) (point))
- (search-forward "</ul>" nil t)
- (end-of-line)
- (narrow-to-region (point-min) (point))
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (goto-char (point-min))
- (delete-blank-lines)
- (when from
- (message-remove-header "from")
- (goto-char (point-max))
- (insert "From: " from "\n"))
- (when subject
- (message-remove-header "subject")
- (goto-char (point-max))
- (insert "Subject: " subject "\n"))
- (when id
- (goto-char (point-max))
- (insert "X-Message-ID: <" id ">\n"))
- (when date
- (message-remove-header "date")
- (goto-char (point-max))
- (insert "Date: " date "\n"))
- (goto-char (point-max))
- (widen)
- (insert "\n"))
- (setq p (point))
- (when (search-forward "X-Body-of-Message" nil t)
- (forward-line)
- (delete-region p (point))
- (search-forward "X-Body-of-Message-End" nil t)
- (beginning-of-line)
- (save-restriction
- (narrow-to-region p (point))
- (goto-char (point-min))
- (if (> (skip-chars-forward "\040\n\r\t") 0)
- (delete-region (point-min) (point)))
- (while (not (eobp))
- (cond
- ((looking-at "<PRE>\r?\n?")
- (delete-region (match-beginning 0) (match-end 0))
- (setq p (point))
- (when (search-forward "</PRE>" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (save-restriction
- (narrow-to-region p (point))
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (goto-char (point-max)))))
- ((looking-at "<P><A HREF=\"\\([^\"]+\\)")
- (setq url (match-string 1))
- (delete-region (match-beginning 0)
- (progn (forward-line) (point)))
- ;; I hate to download the url encode it, then immediately
- ;; decode it.
- (insert "<#external"
- " type="
- (or (and url
- (string-match "\\.[^\\.]+$" url)
- (mailcap-extension-to-mime
- (match-string 0 url)))
- "application/octet-stream")
- (format " url=\"http://www.mail-archive.com/%s/%s\""
- group url)
- ">\n"
- "<#/external>")
- (setq mime t))
- (t
- (setq p (point))
- (insert "<#part type=\"text/html\" disposition=inline>")
- (goto-char
- (if (re-search-forward
- "[\040\n\r\t]*<PRE>\\|[\040\n\r\t]*<P><A HREF=\""
- nil t)
- (match-beginning 0)
- (point-max)))
- (insert "<#/part>")
- (setq mime t)))
- (setq p (point))
- (if (> (skip-chars-forward "\040\n\r\t") 0)
- (delete-region p (point))))
- (goto-char (point-max))))
- (setq p (point))
- (when (search-forward "X-References-End" nil t)
- (setq e (point))
- (beginning-of-line)
- (search-backward "X-References" p t)
- (while (re-search-forward "msg\\([0-9]+\\)\\.html" e t)
- (push (concat "<" (match-string 1) "%" group ">") refs)))
- (delete-region p (point-max))
- (goto-char (point-min))
- (insert (format "Message-ID: <%05d%%%s>\n" (1- article) group))
- (when refs
- (insert "References:")
- (while refs
- (insert " " (pop refs)))
- (insert "\n"))
- (when mime
- (unless (looking-at "$")
- (search-forward "\n\n" nil t)
- (forward-line -1))
- (narrow-to-region (point) (point-max))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max))))
- (widen)))
- (buffer-string)))
-
-(provide 'nnwarchive)
-
-;;; arch-tag: 1ab7a15c-777a-40e0-95c0-0c41b3963578
-;;; nnwarchive.el ends here
+++ /dev/null
-;;; nnweb.el --- retrieving articles via web search engines
-
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-;; 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Note: You need to have `w3' installed for some functions to work.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(eval-and-compile
- (ignore-errors
- (require 'url)))
-(autoload 'w3-parse-buffer "w3-parse")
-
-(nnoo-declare nnweb)
-
-(defvoo nnweb-directory (nnheader-concat gnus-directory "nnweb/")
- "Where nnweb will save its files.")
-
-(defvoo nnweb-type 'google
- "What search engine type is being used.
-Valid types include `google', `dejanews', and `gmane'.")
-
-(defvar nnweb-type-definition
- '((google
- (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
- (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
- (article . nnweb-google-wash-article)
- (reference . identity)
- (map . nnweb-google-create-mapping)
- (search . nnweb-google-search)
- (address . "http://groups.google.com/groups")
- (base . "http://groups.google.com")
- (identifier . nnweb-google-identity))
- (dejanews ;; alias of google
- (id . "http://www.google.com/groups?as_umsgid=%s&hl=en&dmode=source")
- (result . "http://groups.google.com/group/%s/msg/%s?dmode=source")
- (article . nnweb-google-wash-article)
- (reference . identity)
- (map . nnweb-google-create-mapping)
- (search . nnweb-google-search)
- (address . "http://groups.google.com/groups")
- (base . "http://groups.google.com")
- (identifier . nnweb-google-identity))
- (gmane
- (article . nnweb-gmane-wash-article)
- (id . "http://gmane.org/view.php?group=%s")
- (reference . identity)
- (map . nnweb-gmane-create-mapping)
- (search . nnweb-gmane-search)
- (address . "http://search.gmane.org/nov.php")
- (identifier . nnweb-gmane-identity)))
- "Type-definition alist.")
-
-(defvoo nnweb-search nil
- "Search string to feed to Google.")
-
-(defvoo nnweb-max-hits 999
- "Maximum number of hits to display.")
-
-(defvoo nnweb-ephemeral-p nil
- "Whether this nnweb server is ephemeral.")
-
-;;; Internal variables
-
-(defvoo nnweb-articles nil)
-(defvoo nnweb-buffer nil)
-(defvoo nnweb-group-alist nil)
-(defvoo nnweb-group nil)
-(defvoo nnweb-hashtb nil)
-
-;;; Interface functions
-
-(nnoo-define-basics nnweb)
-
-(deffoo nnweb-retrieve-headers (articles &optional group server fetch-old)
- (nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (let (article header)
- (mm-with-unibyte-current-buffer
- (while (setq article (pop articles))
- (when (setq header (cadr (assq article nnweb-articles)))
- (nnheader-insert-nov header))))
- 'nov)))
-
-(deffoo nnweb-request-scan (&optional group server)
- (nnweb-possibly-change-server group server)
- (if nnweb-ephemeral-p
- (setq nnweb-hashtb (gnus-make-hashtable 4095))
- (unless nnweb-articles
- (nnweb-read-overview group)))
- (funcall (nnweb-definition 'map))
- (unless nnweb-ephemeral-p
- (nnweb-write-active)
- (nnweb-write-overview group)))
-
-(deffoo nnweb-request-group (group &optional server dont-check)
- (nnweb-possibly-change-server group server)
- (unless (or nnweb-ephemeral-p
- dont-check
- nnweb-articles)
- (nnweb-read-overview group))
- (cond
- ((not nnweb-articles)
- (nnheader-report 'nnweb "No matching articles"))
- (t
- (let ((active (if nnweb-ephemeral-p
- (cons (caar nnweb-articles)
- (caar (last nnweb-articles)))
- (cadr (assoc group nnweb-group-alist)))))
- (nnheader-report 'nnweb "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (length nnweb-articles)
- (car active) (cdr active) group)))))
-
-(deffoo nnweb-close-group (group &optional server)
- (nnweb-possibly-change-server group server)
- (when (gnus-buffer-live-p nnweb-buffer)
- (save-excursion
- (set-buffer nnweb-buffer)
- (set-buffer-modified-p nil)
- (kill-buffer nnweb-buffer)))
- t)
-
-(deffoo nnweb-request-article (article &optional group server buffer)
- (nnweb-possibly-change-server group server)
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (let* ((header (cadr (assq article nnweb-articles)))
- (url (and header (mail-header-xref header))))
- (when (or (and url
- (mm-with-unibyte-current-buffer
- (mm-url-insert url)))
- (and (stringp article)
- (nnweb-definition 'id t)
- (let ((fetch (nnweb-definition 'id))
- art active)
- (when (string-match "^<\\(.*\\)>$" article)
- (setq art (match-string 1 article)))
- (when (and fetch art)
- (setq url (format fetch
- (mm-url-form-encode-xwfu art)))
- (mm-with-unibyte-current-buffer
- (mm-url-insert url))
- (if (nnweb-definition 'reference t)
- (setq article
- (funcall (nnweb-definition
- 'reference) article)))))))
- (unless nnheader-callback-function
- (funcall (nnweb-definition 'article)))
- (nnheader-report 'nnweb "Fetched article %s" article)
- (cons group (and (numberp article) article))))))
-
-(deffoo nnweb-close-server (&optional server)
- (when (and (nnweb-server-opened server)
- (gnus-buffer-live-p nnweb-buffer))
- (save-excursion
- (set-buffer nnweb-buffer)
- (set-buffer-modified-p nil)
- (kill-buffer nnweb-buffer)))
- (nnoo-close-server 'nnweb server))
-
-(deffoo nnweb-request-list (&optional server)
- (nnweb-possibly-change-server nil server)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (nnmail-generate-active (list (assoc server nnweb-group-alist)))
- t))
-
-(deffoo nnweb-request-update-info (group info &optional server)
- (nnweb-possibly-change-server group server))
-
-(deffoo nnweb-asynchronous-p ()
- nil)
-
-(deffoo nnweb-request-create-group (group &optional server args)
- (nnweb-possibly-change-server nil server)
- (nnweb-request-delete-group group)
- (push `(,group ,(cons 1 0)) nnweb-group-alist)
- (nnweb-write-active)
- t)
-
-(deffoo nnweb-request-delete-group (group &optional force server)
- (nnweb-possibly-change-server group server)
- (gnus-pull group nnweb-group-alist t)
- (nnweb-write-active)
- (gnus-delete-file (nnweb-overview-file group))
- t)
-
-(nnoo-define-skeleton nnweb)
-
-;;; Internal functions
-
-(defun nnweb-read-overview (group)
- "Read the overview of GROUP and build the map."
- (when (file-exists-p (nnweb-overview-file group))
- (mm-with-unibyte-buffer
- (nnheader-insert-file-contents (nnweb-overview-file group))
- (goto-char (point-min))
- (let (header)
- (while (not (eobp))
- (setq header (nnheader-parse-nov))
- (forward-line 1)
- (push (list (mail-header-number header)
- header (mail-header-xref header))
- nnweb-articles)
- (nnweb-set-hashtb header (car nnweb-articles)))))))
-
-(defun nnweb-write-overview (group)
- "Write the overview file for GROUP."
- (with-temp-file (nnweb-overview-file group)
- (let ((articles nnweb-articles))
- (while articles
- (nnheader-insert-nov (cadr (pop articles)))))))
-
-(defun nnweb-set-hashtb (header data)
- (gnus-sethash (nnweb-identifier (mail-header-xref header))
- data nnweb-hashtb))
-
-(defun nnweb-get-hashtb (url)
- (gnus-gethash (nnweb-identifier url) nnweb-hashtb))
-
-(defun nnweb-identifier (ident)
- (funcall (nnweb-definition 'identifier) ident))
-
-(defun nnweb-overview-file (group)
- "Return the name of the overview file of GROUP."
- (nnheader-concat nnweb-directory group ".overview"))
-
-(defun nnweb-write-active ()
- "Save the active file."
- (gnus-make-directory nnweb-directory)
- (with-temp-file (nnheader-concat nnweb-directory "active")
- (prin1 `(setq nnweb-group-alist ',nnweb-group-alist) (current-buffer))))
-
-(defun nnweb-read-active ()
- "Read the active file."
- (load (nnheader-concat nnweb-directory "active") t t t))
-
-(defun nnweb-definition (type &optional noerror)
- "Return the definition of TYPE."
- (let ((def (cdr (assq type (assq nnweb-type nnweb-type-definition)))))
- (when (and (not def)
- (not noerror))
- (error "Undefined definition %s" type))
- def))
-
-(defun nnweb-possibly-change-server (&optional group server)
- (when server
- (unless (nnweb-server-opened server)
- (nnweb-open-server server))
- (nnweb-init server))
- (unless nnweb-group-alist
- (nnweb-read-active))
- (unless nnweb-hashtb
- (setq nnweb-hashtb (gnus-make-hashtable 4095)))
- (when group
- (setq nnweb-group group)))
-
-(defun nnweb-init (server)
- "Initialize buffers and such."
- (unless (gnus-buffer-live-p nnweb-buffer)
- (setq nnweb-buffer
- (save-excursion
- (mm-with-unibyte
- (nnheader-set-temp-buffer
- (format " *nnweb %s %s %s*"
- nnweb-type nnweb-search server))
- (current-buffer))))))
-
-;;;
-;;; groups.google.com
-;;;
-
-(defun nnweb-google-wash-article ()
- ;; We have Google's masked e-mail addresses here. :-/
- (let ((case-fold-search t)
- (start-re "<pre>[\r\n ]*")
- (end-re "[\r\n ]*</pre>"))
- (goto-char (point-min))
- (if (save-excursion
- (or (re-search-forward "The requested message.*could not be found."
- nil t)
- (not (and (re-search-forward start-re nil t)
- (re-search-forward end-re nil t)))))
- ;; FIXME: Don't know how to indicate "not found".
- ;; Should this function throw an error? --rsteib
- (progn
- (gnus-message 3 "Requested article not found")
- (erase-buffer))
- (delete-region (point-min)
- (re-search-forward start-re))
- (goto-char (point-min))
- (delete-region (progn
- (re-search-forward end-re)
- (match-beginning 0))
- (point-max))
- (mm-url-decode-entities))))
-
-(defun nnweb-google-parse-1 (&optional Message-ID)
- "Parse search result in current buffer."
- (let ((i 0)
- (case-fold-search t)
- (active (cadr (assoc nnweb-group nnweb-group-alist)))
- Subject Score Date Newsgroups From
- map url mid)
- (unless active
- (push (list nnweb-group (setq active (cons 1 0)))
- nnweb-group-alist))
- ;; Go through all the article hits on this page.
- (goto-char (point-min))
- (while
- (re-search-forward
- "a +href=\"/group/\\([^>\"]+\\)/browse_thread/[^>]+#\\([0-9a-f]+\\)"
- nil t)
- (setq Newsgroups (match-string-no-properties 1)
- ;; Note: Starting with Google Groups 2, `mid' is a Google-internal
- ;; ID, not a proper Message-ID.
- mid (match-string-no-properties 2)
- url (format
- (nnweb-definition 'result) Newsgroups mid))
- (narrow-to-region (search-forward ">" nil t)
- (search-forward "</a>" nil t))
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (setq Subject (buffer-string))
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point)
- (search-forward "</table" nil t))
-
- (mm-url-remove-markup)
- (mm-url-decode-entities)
- (goto-char (point-max))
- (when
- (re-search-backward
- "^\\(?:\\(\\w+\\) \\([0-9]+\\)\\|\\S-+\\)\\(?: \\([0-9]\\{4\\}\\)\\)? by ?\\(.*\\)"
- nil t)
- (setq Date (if (match-string 1)
- (format "%s %s 00:00:00 %s"
- (match-string 1)
- (match-string 2)
- (or (match-string 3)
- (substring (current-time-string) -4)))
- (current-time-string)))
- (setq From (match-string 4)))
- (widen)
- (incf i)
- (unless (nnweb-get-hashtb url)
- (push
- (list
- (incf (cdr active))
- (make-full-mail-header
- (cdr active) (if Newsgroups
- (concat "(" Newsgroups ") " Subject)
- Subject)
- From Date (or Message-ID mid)
- nil 0 0 url))
- map)
- (nnweb-set-hashtb (cadar map) (car map))))
- map))
-
-(defun nnweb-google-reference (id)
- (let ((map (nnweb-google-parse-1 id)) header)
- (setq nnweb-articles
- (nconc nnweb-articles map))
- (when (setq header (cadar map))
- (mm-with-unibyte-current-buffer
- (mm-url-insert (mail-header-xref header)))
- (caar map))))
-
-(defun nnweb-google-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (erase-buffer)
- (nnheader-message 7 "Searching google...")
- (when (funcall (nnweb-definition 'search) nnweb-search)
- (let ((more t)
- (i 0))
- (while more
- (setq nnweb-articles
- (nconc nnweb-articles (nnweb-google-parse-1)))
- ;; Check if there are more articles to fetch
- (goto-char (point-min))
- (incf i 100)
- (if (or (not (re-search-forward
- "<a [^>]+href=\"\n?\\([^>\" \n\t]+\\)[^<]*<img[^>]+src=[^>]+next"
- nil t))
- (>= i nnweb-max-hits))
- (setq more nil)
- ;; Yup, there are more articles
- (setq more (concat (nnweb-definition 'base) (match-string 1)))
- (when more
- (erase-buffer)
- (nnheader-message 7 "Searching google...(%d)" i)
- (mm-url-insert more))))
- ;; Return the articles in the right order.
- (nnheader-message 7 "Searching google...done")
- (setq nnweb-articles
- (sort nnweb-articles 'car-less-than-car))))))
-
-(defun nnweb-google-search (search)
- (mm-url-insert
- (concat
- (nnweb-definition 'address)
- "?"
- (mm-url-encode-www-form-urlencoded
- `(("q" . ,search)
- ("num" . ,(number-to-string
- (min 100 nnweb-max-hits)))
- ("hq" . "")
- ("hl" . "en")
- ("lr" . "")
- ("safe" . "off")
- ("sites" . "groups")
- ("filter" . "0")))))
- t)
-
-(defun nnweb-google-identity (url)
- "Return an unique identifier based on URL."
- (if (string-match "selm=\\([^ &>]+\\)" url)
- (match-string 1 url)
- url))
-
-;;;
-;;; gmane.org
-;;;
-(defun nnweb-gmane-create-mapping ()
- "Perform the search and create a number-to-url alist."
- (save-excursion
- (set-buffer nnweb-buffer)
- (let ((case-fold-search t)
- (active (or (cadr (assoc nnweb-group nnweb-group-alist))
- (cons 1 0)))
- map)
- (erase-buffer)
- (nnheader-message 7 "Searching Gmane..." )
- (when (funcall (nnweb-definition 'search) nnweb-search)
- (goto-char (point-min))
- ;; Skip the status line
- (forward-line 1)
- ;; Thanks to Olly Betts we now have NOV lines in our buffer!
- (while (not (eobp))
- (unless (or (eolp) (looking-at "\x0d"))
- (let ((header (nnheader-parse-nov)))
- (let ((xref (mail-header-xref header))
- (from (mail-header-from header))
- (subject (mail-header-subject header))
- (rfc2047-encoding-type 'mime))
- (when (string-match " \\([^:]+\\)[:/]\\([0-9]+\\)" xref)
- (mail-header-set-xref
- header
- (format "http://article.gmane.org/%s/%s/raw"
- (match-string 1 xref)
- (match-string 2 xref))))
-
- ;; Add host part to gmane-encrypted addresses
- (when (string-match "@$" from)
- (mail-header-set-from header
- (concat from "public.gmane.org")))
-
- (mail-header-set-subject header
- (rfc2047-encode-string subject))
-
- (unless (nnweb-get-hashtb (mail-header-xref header))
- (mail-header-set-number header (incf (cdr active)))
- (push (list (mail-header-number header) header) map)
- (nnweb-set-hashtb (cadar map) (car map))))))
- (forward-line 1)))
- (nnheader-message 7 "Searching Gmane...done")
- (setq nnweb-articles
- (sort (nconc nnweb-articles map) 'car-less-than-car)))))
-
-(defun nnweb-gmane-wash-article ()
- (let ((case-fold-search t))
- (goto-char (point-min))
- (when (search-forward "<!--X-Head-of-Message-->" nil t)
- (delete-region (point-min) (point))
- (goto-char (point-min))
- (while (looking-at "^<li><em>\\([^ ]+\\)</em>.*</li>")
- (replace-match "\\1\\2" t)
- (forward-line 1))
- (mm-url-remove-markup))))
-
-(defun nnweb-gmane-search (search)
- (mm-url-insert
- (concat
- (nnweb-definition 'address)
- "?"
- (mm-url-encode-www-form-urlencoded
- `(("query" . ,search)
- ("HITSPERPAGE" . ,(number-to-string nnweb-max-hits))))))
- (setq buffer-file-name nil)
- (set-buffer-multibyte t)
- (mm-decode-coding-region (point-min) (point-max) 'utf-8)
- t)
-
-(defun nnweb-gmane-identity (url)
- "Return a unique identifier based on URL."
- (if (string-match "group=\\(.+\\)" url)
- (match-string 1 url)
- url))
-
-;;;
-;;; General web/w3 interface utility functions
-;;;
-
-(defun nnweb-insert-html (parse)
- "Insert HTML based on a w3 parse tree."
- (if (stringp parse)
- (insert (nnheader-string-as-multibyte parse))
- (insert "<" (symbol-name (car parse)) " ")
- (insert (mapconcat
- (lambda (param)
- (concat (symbol-name (car param)) "="
- (prin1-to-string
- (if (consp (cdr param))
- (cadr param)
- (cdr param)))))
- (nth 1 parse)
- " "))
- (insert ">\n")
- (mapcar 'nnweb-insert-html (nth 2 parse))
- (insert "</" (symbol-name (car parse)) ">\n")))
-
-(defun nnweb-parse-find (type parse &optional maxdepth)
- "Find the element of TYPE in PARSE."
- (catch 'found
- (nnweb-parse-find-1 type parse maxdepth)))
-
-(defun nnweb-parse-find-1 (type contents maxdepth)
- (when (or (null maxdepth)
- (not (zerop maxdepth)))
- (when (consp contents)
- (when (eq (car contents) type)
- (throw 'found contents))
- (when (listp (cdr contents))
- (dolist (element contents)
- (when (consp element)
- (nnweb-parse-find-1 type element
- (and maxdepth (1- maxdepth)))))))))
-
-(defun nnweb-parse-find-all (type parse)
- "Find all elements of TYPE in PARSE."
- (catch 'found
- (nnweb-parse-find-all-1 type parse)))
-
-(defun nnweb-parse-find-all-1 (type contents)
- (let (result)
- (when (consp contents)
- (if (eq (car contents) type)
- (push contents result)
- (when (listp (cdr contents))
- (dolist (element contents)
- (when (consp element)
- (setq result
- (nconc result (nnweb-parse-find-all-1 type element))))))))
- result))
-
-(defvar nnweb-text)
-(defun nnweb-text (parse)
- "Return a list of text contents in PARSE."
- (let ((nnweb-text nil))
- (nnweb-text-1 parse)
- (nreverse nnweb-text)))
-
-(defun nnweb-text-1 (contents)
- (dolist (element contents)
- (if (stringp element)
- (push element nnweb-text)
- (when (and (consp element)
- (listp (cdr element)))
- (nnweb-text-1 element)))))
-
-(provide 'nnweb)
-
-;;; arch-tag: f59307eb-c90f-479f-b7d2-dbd8bf51b697
-;;; nnweb.el ends here
+++ /dev/null
-;;; nnwfm.el --- interfacing with a web forum
-
-;; Copyright (C) 2000, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Note: You need to have `url' and `w3' installed for this
-;; backend to work.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(require 'nnweb)
-(autoload 'w3-parse-buffer "w3-parse")
-
-(nnoo-declare nnwfm)
-
-(defvoo nnwfm-directory (nnheader-concat gnus-directory "wfm/")
- "Where nnwfm will save its files.")
-
-(defvoo nnwfm-address ""
- "The address of the Ultimate bulletin board.")
-
-;;; Internal variables
-
-(defvar nnwfm-groups-alist nil)
-(defvoo nnwfm-groups nil)
-(defvoo nnwfm-headers nil)
-(defvoo nnwfm-articles nil)
-(defvar nnwfm-table-regexp
- "postings.*editpost\\|forumdisplay\\|Forum[0-9]+/HTML\\|getbio")
-
-;;; Interface functions
-
-(nnoo-define-basics nnwfm)
-
-(deffoo nnwfm-retrieve-headers (articles &optional group server fetch-old)
- (nnwfm-possibly-change-server group server)
- (unless gnus-nov-is-evil
- (let* ((last (car (last articles)))
- (did nil)
- (start 1)
- (entry (assoc group nnwfm-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (nnwfm-table-regexp "Thread.asp")
- headers article subject score from date lines parent point
- contents tinfo fetchers map elem a href garticles topic old-max
- inc datel table string current-page total-contents pages
- farticles forum-contents parse furl-fetched mmap farticle
- thread-id tables hstuff bstuff time)
- (setq map mapping)
- (while (and (setq article (car articles))
- map)
- (while (and map
- (or (> article (caar map))
- (< (cadar map) (caar map))))
- (pop map))
- (when (setq mmap (car map))
- (setq farticle -1)
- (while (and article
- (<= article (nth 1 mmap)))
- ;; Do we already have a fetcher for this topic?
- (if (setq elem (assq (nth 2 mmap) fetchers))
- ;; Yes, so we just add the spec to the end.
- (nconc elem (list (cons article
- (+ (nth 3 mmap) (incf farticle)))))
- ;; No, so we add a new one.
- (push (list (nth 2 mmap)
- (cons article
- (+ (nth 3 mmap) (incf farticle))))
- fetchers))
- (pop articles)
- (setq article (car articles)))))
- ;; Now we have the mapping from/to Gnus/nnwfm article numbers,
- ;; so we start fetching the topics that we need to satisfy the
- ;; request.
- (if (not fetchers)
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer))
- (setq nnwfm-articles nil)
- (mm-with-unibyte-buffer
- (dolist (elem fetchers)
- (erase-buffer)
- (setq subject (nth 2 (assq (car elem) topics))
- thread-id (nth 0 (assq (car elem) topics)))
- (mm-url-insert
- (concat nnwfm-address
- (format "Item.asp?GroupID=%d&ThreadID=%d" sid
- thread-id)))
- (goto-char (point-min))
- (setq tables (caddar
- (caddar
- (cdr (caddar
- (caddar
- (ignore-errors
- (w3-parse-buffer (current-buffer)))))))))
- (setq tables (cdr (caddar (memq (assq 'div tables) tables))))
- (setq contents nil)
- (dolist (table tables)
- (when (eq (car table) 'table)
- (setq table (caddar (caddar (caddr table)))
- hstuff (delete ":link" (nnweb-text (car table)))
- bstuff (car (caddar (cdr table)))
- from (car hstuff))
- (when (nth 2 hstuff)
- (setq time (nnwfm-date-to-time (nth 2 hstuff)))
- (push (list from time bstuff) contents))))
- (setq contents (nreverse contents))
- (dolist (art (cdr elem))
- (push (list (car art)
- (nth (1- (cdr art)) contents)
- subject)
- nnwfm-articles))))
- (setq nnwfm-articles
- (sort nnwfm-articles 'car-less-than-car))
- ;; Now we have all the articles, conveniently in an alist
- ;; where the key is the Gnus article number.
- (dolist (articlef nnwfm-articles)
- (setq article (nth 0 articlef)
- contents (nth 1 articlef)
- subject (nth 2 articlef))
- (setq from (nth 0 contents)
- date (message-make-date (nth 1 contents)))
- (push
- (cons
- article
- (make-full-mail-header
- article subject
- from (or date "")
- (concat "<" (number-to-string sid) "%"
- (number-to-string article)
- "@wfm>")
- "" 0
- (/ (length (mapconcat 'identity (nnweb-text (nth 2 contents)) ""))
- 70)
- nil nil))
- headers))
- (setq nnwfm-headers (sort headers 'car-less-than-car))
- (save-excursion
- (set-buffer nntp-server-buffer)
- (mm-with-unibyte-current-buffer
- (erase-buffer)
- (dolist (header nnwfm-headers)
- (nnheader-insert-nov (cdr header))))))
- 'nov)))
-
-(deffoo nnwfm-request-group (group &optional server dont-check)
- (nnwfm-possibly-change-server nil server)
- (when (not nnwfm-groups)
- (nnwfm-request-list))
- (unless dont-check
- (nnwfm-create-mapping group))
- (let ((elem (assoc group nnwfm-groups)))
- (cond
- ((not elem)
- (nnheader-report 'nnwfm "Group does not exist"))
- (t
- (nnheader-report 'nnwfm "Opened group %s" group)
- (nnheader-insert
- "211 %d %d %d %s\n" (cadr elem) 1 (cadr elem)
- (prin1-to-string group))))))
-
-(deffoo nnwfm-request-close ()
- (setq nnwfm-groups-alist nil
- nnwfm-groups nil))
-
-(deffoo nnwfm-request-article (article &optional group server buffer)
- (nnwfm-possibly-change-server group server)
- (let ((contents (cdr (assq article nnwfm-articles))))
- (when (setq contents (nth 2 (car contents)))
- (save-excursion
- (set-buffer (or buffer nntp-server-buffer))
- (erase-buffer)
- (nnweb-insert-html contents)
- (goto-char (point-min))
- (insert "Content-Type: text/html\nMIME-Version: 1.0\n")
- (let ((header (cdr (assq article nnwfm-headers))))
- (mm-with-unibyte-current-buffer
- (nnheader-insert-header header)))
- (nnheader-report 'nnwfm "Fetched article %s" article)
- (cons group article)))))
-
-(deffoo nnwfm-request-list (&optional server)
- (nnwfm-possibly-change-server nil server)
- (mm-with-unibyte-buffer
- (mm-url-insert
- (if (string-match "/$" nnwfm-address)
- (concat nnwfm-address "Group.asp")
- nnwfm-address))
- (let* ((nnwfm-table-regexp "Thread.asp")
- (contents (w3-parse-buffer (current-buffer)))
- sid elem description articles a href group forum
- a1 a2)
- (dolist (row (cdr (nth 2 (car (nth 2 (nnwfm-find-forum-table
- contents))))))
- (setq row (nth 2 row))
- (when (setq a (nnweb-parse-find 'a row))
- (setq group (car (last (nnweb-text a)))
- href (cdr (assq 'href (nth 1 a))))
- (setq description (car (last (nnweb-text (nth 1 row)))))
- (setq articles
- (string-to-number
- (gnus-replace-in-string
- (car (last (nnweb-text (nth 3 row)))) "," "")))
- (when (and href
- (string-match "GroupId=\\([0-9]+\\)" href))
- (setq forum (string-to-number (match-string 1 href)))
- (if (setq elem (assoc group nnwfm-groups))
- (setcar (cdr elem) articles)
- (push (list group articles forum description nil nil nil nil)
- nnwfm-groups))))))
- (nnwfm-write-groups)
- (nnwfm-generate-active)
- t))
-
-(deffoo nnwfm-request-newgroups (date &optional server)
- (nnwfm-possibly-change-server nil server)
- (nnwfm-generate-active)
- t)
-
-(nnoo-define-skeleton nnwfm)
-
-;;; Internal functions
-
-(defun nnwfm-new-threads-p (group time)
- "See whether we want to fetch the threads for GROUP written before TIME."
- (let ((old-time (nth 7 (assoc group nnwfm-groups))))
- (or (null old-time)
- (time-less-p old-time time))))
-
-(defun nnwfm-create-mapping (group)
- (let* ((entry (assoc group nnwfm-groups))
- (sid (nth 2 entry))
- (topics (nth 4 entry))
- (mapping (nth 5 entry))
- (old-total (or (nth 6 entry) 1))
- (current-time (current-time))
- (nnwfm-table-regexp "Thread.asp")
- (furls (list (concat nnwfm-address
- (format "Thread.asp?GroupId=%d" sid))))
- fetched-urls
- contents forum-contents a subject href
- garticles topic tinfo old-max inc parse elem date
- url time)
- (mm-with-unibyte-buffer
- (while furls
- (erase-buffer)
- (push (car furls) fetched-urls)
- (mm-url-insert (pop furls))
- (goto-char (point-min))
- (while (re-search-forward " wr(" nil t)
- (forward-char -1)
- (setq elem (message-tokenize-header
- (gnus-replace-in-string
- (buffer-substring
- (1+ (point))
- (progn
- (forward-sexp 1)
- (1- (point))))
- "\\\\[\"\\\\]" "")))
- (push (list
- (string-to-number (nth 1 elem))
- (gnus-replace-in-string (nth 2 elem) "\"" "")
- (string-to-number (nth 5 elem)))
- forum-contents))
- (when (re-search-forward "href=\"\\(Thread.*DateLast=\\([^\"]+\\)\\)"
- nil t)
- (setq url (match-string 1)
- time (nnwfm-date-to-time (gnus-url-unhex-string
- (match-string 2))))
- (when (and (nnwfm-new-threads-p group time)
- (not (member
- (setq url (concat
- nnwfm-address
- (mm-url-decode-entities-string url)))
- fetched-urls)))
- (push url furls))))
- ;; The main idea here is to map Gnus article numbers to
- ;; nnwfm article numbers. Say there are three topics in
- ;; this forum, the first with 4 articles, the seconds with 2,
- ;; and the third with 1. Then this will translate into 7 Gnus
- ;; article numbers, where 1-4 comes from the first topic, 5-6
- ;; from the second and 7 from the third. Now, then next time
- ;; the group is entered, there's 2 new articles in topic one
- ;; and 1 in topic three. Then Gnus article number 8-9 be 5-6
- ;; in topic one and 10 will be the 2 in topic three.
- (dolist (elem (nreverse forum-contents))
- (setq subject (nth 1 elem)
- topic (nth 0 elem)
- garticles (nth 2 elem))
- (if (setq tinfo (assq topic topics))
- (progn
- (setq old-max (cadr tinfo))
- (setcar (cdr tinfo) garticles))
- (setq old-max 0)
- (push (list topic garticles subject) topics)
- (setcar (nthcdr 4 entry) topics))
- (when (not (= old-max garticles))
- (setq inc (- garticles old-max))
- (setq mapping (nconc mapping
- (list
- (list
- old-total (1- (incf old-total inc))
- topic (1+ old-max)))))
- (incf old-max inc)
- (setcar (nthcdr 5 entry) mapping)
- (setcar (nthcdr 6 entry) old-total))))
- (setcar (nthcdr 7 entry) current-time)
- (setcar (nthcdr 1 entry) (1- old-total))
- (nnwfm-write-groups)
- mapping))
-
-(defun nnwfm-possibly-change-server (&optional group server)
- (nnwfm-init server)
- (when (and server
- (not (nnwfm-server-opened server)))
- (nnwfm-open-server server))
- (unless nnwfm-groups-alist
- (nnwfm-read-groups)
- (setq nnwfm-groups (cdr (assoc nnwfm-address
- nnwfm-groups-alist)))))
-
-(deffoo nnwfm-open-server (server &optional defs connectionless)
- (nnheader-init-server-buffer)
- (if (nnwfm-server-opened server)
- t
- (unless (assq 'nnwfm-address defs)
- (setq defs (append defs (list (list 'nnwfm-address server)))))
- (nnoo-change-server 'nnwfm server defs)))
-
-(defun nnwfm-read-groups ()
- (setq nnwfm-groups-alist nil)
- (let ((file (expand-file-name "groups" nnwfm-directory)))
- (when (file-exists-p file)
- (mm-with-unibyte-buffer
- (insert-file-contents file)
- (goto-char (point-min))
- (setq nnwfm-groups-alist (read (current-buffer)))))))
-
-(defun nnwfm-write-groups ()
- (setq nnwfm-groups-alist
- (delq (assoc nnwfm-address nnwfm-groups-alist)
- nnwfm-groups-alist))
- (push (cons nnwfm-address nnwfm-groups)
- nnwfm-groups-alist)
- (with-temp-file (expand-file-name "groups" nnwfm-directory)
- (prin1 nnwfm-groups-alist (current-buffer))))
-
-(defun nnwfm-init (server)
- "Initialize buffers and such."
- (unless (file-exists-p nnwfm-directory)
- (gnus-make-directory nnwfm-directory)))
-
-(defun nnwfm-generate-active ()
- (save-excursion
- (set-buffer nntp-server-buffer)
- (erase-buffer)
- (dolist (elem nnwfm-groups)
- (insert (prin1-to-string (car elem))
- " " (number-to-string (cadr elem)) " 1 y\n"))))
-
-(defun nnwfm-find-forum-table (contents)
- (catch 'found
- (nnwfm-find-forum-table-1 contents)))
-
-(defun nnwfm-find-forum-table-1 (contents)
- (dolist (element contents)
- (unless (stringp element)
- (when (and (eq (car element) 'table)
- (nnwfm-forum-table-p element))
- (throw 'found element))
- (when (nth 2 element)
- (nnwfm-find-forum-table-1 (nth 2 element))))))
-
-(defun nnwfm-forum-table-p (parse)
- (when (not (apply 'gnus-or
- (mapcar
- (lambda (p)
- (nnweb-parse-find 'table p))
- (nth 2 parse))))
- (let ((href (cdr (assq 'href (nth 1 (nnweb-parse-find 'a parse 20)))))
- case-fold-search)
- (when (and href (string-match nnwfm-table-regexp href))
- t))))
-
-(defun nnwfm-date-to-time (date)
- (let ((time (mapcar #'string-to-number (split-string date "[\\.\\+ :]"))))
- (encode-time 0 (nth 4 time) (nth 3 time)
- (nth 0 time) (nth 1 time)
- (if (< (nth 2 time) 70)
- (+ 2000 (nth 2 time))
- (+ 1900 (nth 2 time))))))
-
-(provide 'nnwfm)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; arch-tag: d813966a-4211-4557-ad11-d1ac2bc86536
-;;; nnwfm.el ends here
+++ /dev/null
-;;; parse-time.el --- parsing time strings
-
-;; Copyright (C) 1996, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Erik Naggum <erik@naggum.no>
-;; Keywords: util
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; With the introduction of the `encode-time', `decode-time', and
-;; `format-time-string' functions, dealing with time became simpler in
-;; Emacs. However, parsing time strings is still largely a matter of
-;; heuristics and no common interface has been designed.
-
-;; `parse-time-string' parses a time in a string and returns a list of 9
-;; values, just like `decode-time', where unspecified elements in the
-;; string are returned as nil. `encode-time' may be applied on these
-;; values to obtain an internal time value.
-
-;;; Code:
-
-(eval-when-compile (require 'cl)) ;and ah ain't kiddin' 'bout it
-
-(defvar parse-time-syntax (make-vector 256 nil))
-(defvar parse-time-digits (make-vector 256 nil))
-
-;; Byte-compiler warnings
-(defvar parse-time-elt)
-(defvar parse-time-val)
-
-(unless (aref parse-time-digits ?0)
- (loop for i from ?0 to ?9
- do (aset parse-time-digits i (- i ?0))))
-
-(unless (aref parse-time-syntax ?0)
- (loop for i from ?0 to ?9
- do (aset parse-time-syntax i ?0))
- (loop for i from ?A to ?Z
- do (aset parse-time-syntax i ?A))
- (loop for i from ?a to ?z
- do (aset parse-time-syntax i ?a))
- (aset parse-time-syntax ?+ 1)
- (aset parse-time-syntax ?- -1)
- (aset parse-time-syntax ?: ?d)
- )
-
-(unless (fboundp 'digit-char-p)
- (defsubst digit-char-p (char)
- (aref parse-time-digits char)))
-
-(defsubst parse-time-string-chars (char)
- (and (< char (length parse-time-syntax))
- (aref parse-time-syntax char)))
-
-(put 'parse-error 'error-conditions '(parse-error error))
-(put 'parse-error 'error-message "Parsing error")
-
-(defsubst parse-integer (string &optional start end)
- "[CL] Parse and return the integer in STRING, or nil if none."
- (let ((integer 0)
- (digit 0)
- (index (or start 0))
- (end (or end (length string))))
- (when (< index end)
- (let ((sign (aref string index)))
- (if (or (eq sign ?+) (eq sign ?-))
- (setq sign (parse-time-string-chars sign)
- index (1+ index))
- (setq sign 1))
- (while (and (< index end)
- (setq digit (digit-char-p (aref string index))))
- (setq integer (+ (* integer 10) digit)
- index (1+ index)))
- (if (/= index end)
- (signal 'parse-error `("not an integer"
- ,(substring string (or start 0) end)))
- (* sign integer))))))
-
-(defun parse-time-tokenize (string)
- "Tokenize STRING into substrings."
- (let ((start nil)
- (end (length string))
- (all-digits nil)
- (list ())
- (index 0)
- (c nil))
- (while (< index end)
- (while (and (< index end) ;skip invalid characters
- (not (setq c (parse-time-string-chars (aref string index)))))
- (incf index))
- (setq start index all-digits (eq c ?0))
- (while (and (< (incf index) end) ;scan valid characters
- (setq c (parse-time-string-chars (aref string index))))
- (setq all-digits (and all-digits (eq c ?0))))
- (if (<= index end)
- (push (if all-digits (parse-integer string start index)
- (substring string start index))
- list)))
- (nreverse list)))
-
-(defvar parse-time-months '(("jan" . 1) ("feb" . 2) ("mar" . 3)
- ("apr" . 4) ("may" . 5) ("jun" . 6)
- ("jul" . 7) ("aug" . 8) ("sep" . 9)
- ("oct" . 10) ("nov" . 11) ("dec" . 12)))
-(defvar parse-time-weekdays '(("sun" . 0) ("mon" . 1) ("tue" . 2)
- ("wed" . 3) ("thu" . 4) ("fri" . 5) ("sat" . 6)))
-(defvar parse-time-zoneinfo `(("z" 0) ("ut" 0) ("gmt" 0)
- ("pst" ,(* -8 3600)) ("pdt" ,(* -7 3600) t)
- ("mst" ,(* -7 3600)) ("mdt" ,(* -6 3600) t)
- ("cst" ,(* -6 3600)) ("cdt" ,(* -5 3600) t)
- ("est" ,(* -5 3600)) ("edt" ,(* -4 3600) t))
- "(zoneinfo seconds-off daylight-savings-time-p)")
-
-(defvar parse-time-rules
- `(((6) parse-time-weekdays)
- ((3) (1 31))
- ((4) parse-time-months)
- ((5) (100 4038))
- ((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 8)
- (= (aref parse-time-elt 2) ?:)
- (= (aref parse-time-elt 5) ?:)))
- [0 2] [3 5] [6 8])
- ((8 7) parse-time-zoneinfo
- ,#'(lambda () (car parse-time-val))
- ,#'(lambda () (cadr parse-time-val)))
- ((8)
- ,#'(lambda ()
- (and (stringp parse-time-elt)
- (= 5 (length parse-time-elt))
- (or (= (aref parse-time-elt 0) ?+)
- (= (aref parse-time-elt 0) ?-))))
- ,#'(lambda () (* 60 (+ (parse-integer parse-time-elt 3 5)
- (* 60 (parse-integer parse-time-elt 1 3)))
- (if (= (aref parse-time-elt 0) ?-) -1 1))))
- ((5 4 3)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 10)
- (= (aref parse-time-elt 4) ?-)
- (= (aref parse-time-elt 7) ?-)))
- [0 4] [5 7] [8 10])
- ((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 5)
- (= (aref parse-time-elt 2) ?:)))
- [0 2] [3 5] ,#'(lambda () 0))
- ((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 4)
- (= (aref parse-time-elt 1) ?:)))
- [0 1] [2 4] ,#'(lambda () 0))
- ((2 1 0)
- ,#'(lambda () (and (stringp parse-time-elt)
- (= (length parse-time-elt) 7)
- (= (aref parse-time-elt 1) ?:)))
- [0 1] [2 4] [5 7])
- ((5) (50 110) ,#'(lambda () (+ 1900 parse-time-elt)))
- ((5) (0 49) ,#'(lambda () (+ 2000 parse-time-elt))))
- "(slots predicate extractor...)")
-
-;;;###autoload
-(defun parse-time-string (string)
- "Parse the time-string STRING into (SEC MIN HOUR DAY MON YEAR DOW DST TZ).
-The values are identical to those of `decode-time', but any values that are
-unknown are returned as nil."
- (let ((time (list nil nil nil nil nil nil nil nil nil))
- (temp (parse-time-tokenize (downcase string))))
- (while temp
- (let ((parse-time-elt (pop temp))
- (rules parse-time-rules)
- (exit nil))
- (while (and (not (null rules)) (not exit))
- (let* ((rule (pop rules))
- (slots (pop rule))
- (predicate (pop rule))
- (parse-time-val))
- (when (and (not (nth (car slots) time)) ;not already set
- (setq parse-time-val (cond ((and (consp predicate)
- (not (eq (car predicate)
- 'lambda)))
- (and (numberp parse-time-elt)
- (<= (car predicate) parse-time-elt)
- (<= parse-time-elt (cadr predicate))
- parse-time-elt))
- ((symbolp predicate)
- (cdr (assoc parse-time-elt
- (symbol-value predicate))))
- ((funcall predicate)))))
- (setq exit t)
- (while slots
- (let ((new-val (and rule
- (let ((this (pop rule)))
- (if (vectorp this)
- (parse-integer
- parse-time-elt
- (aref this 0) (aref this 1))
- (funcall this))))))
- (rplaca (nthcdr (pop slots) time)
- (or new-val parse-time-val)))))))))
- time))
-
-(provide 'parse-time)
-
-;;; arch-tag: 07066094-45a8-4c68-b307-86195e2c1103
-;;; parse-time.el ends here
+++ /dev/null
-;;; qp.el --- Quoted-Printable functions
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: mail, extensions
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Functions for encoding and decoding quoted-printable text as
-;; defined in RFC 2045.
-
-;;; Code:
-
-(require 'mm-util)
-(eval-when-compile (defvar mm-use-ultra-safe-encoding))
-
-;;;###autoload
-(defun quoted-printable-decode-region (from to &optional coding-system)
- "Decode quoted-printable in the region between FROM and TO, per RFC 2045.
-If CODING-SYSTEM is non-nil, decode bytes into characters with that
-coding-system.
-
-Interactively, you can supply the CODING-SYSTEM argument
-with \\[universal-coding-system-argument].
-
-The CODING-SYSTEM argument is a historical hangover and is deprecated.
-QP encodes raw bytes and should be decoded into raw bytes. Decoding
-them into characters should be done separately."
- (interactive
- ;; Let the user determine the coding system with "C-x RET c".
- (list (region-beginning) (region-end) coding-system-for-read))
- (unless (mm-coding-system-p coding-system) ; e.g. `ascii' from Gnus
- (setq coding-system nil))
- (save-excursion
- (save-restriction
- ;; RFC 2045: ``An "=" followed by two hexadecimal digits, one
- ;; or both of which are lowercase letters in "abcdef", is
- ;; formally illegal. A robust implementation might choose to
- ;; recognize them as the corresponding uppercase letters.''
- (let ((case-fold-search t))
- (narrow-to-region from to)
- ;; Do this in case we're called from Gnus, say, in a buffer
- ;; which already contains non-ASCII characters which would
- ;; then get doubly-decoded below.
- (if coding-system
- (mm-encode-coding-region (point-min) (point-max) coding-system))
- (goto-char (point-min))
- (while (and (skip-chars-forward "^=")
- (not (eobp)))
- (cond ((eq (char-after (1+ (point))) ?\n)
- (delete-char 2))
- ((looking-at "=[0-9A-F][0-9A-F]")
- (let ((byte (string-to-number (buffer-substring (1+ (point))
- (+ 3 (point)))
- 16)))
- (mm-insert-byte byte 1)
- (delete-char 3)))
- (t
- (message "Malformed quoted-printable text")
- (forward-char)))))
- (if coding-system
- (mm-decode-coding-region (point-min) (point-max) coding-system)))))
-
-(defun quoted-printable-decode-string (string &optional coding-system)
- "Decode the quoted-printable encoded STRING and return the result.
-If CODING-SYSTEM is non-nil, decode the string with coding-system.
-Use of CODING-SYSTEM is deprecated; this function should deal with
-raw bytes, and coding conversion should be done separately."
- (mm-with-unibyte-buffer
- (insert string)
- (quoted-printable-decode-region (point-min) (point-max) coding-system)
- (buffer-string)))
-
-(defun quoted-printable-encode-region (from to &optional fold class)
- "Quoted-printable encode the region between FROM and TO per RFC 2045.
-
-If FOLD, fold long lines at 76 characters (as required by the RFC).
-If CLASS is non-nil, translate the characters not matched by that
-regexp class, which is in the form expected by `skip-chars-forward'.
-You should probably avoid non-ASCII characters in this arg.
-
-If `mm-use-ultra-safe-encoding' is set, fold lines unconditionally and
-encode lines starting with \"From\"."
- (interactive "r")
- (unless class
- ;; Avoid using 8bit characters. = is \075.
- ;; Equivalent to "^\000-\007\013\015-\037\200-\377="
- (setq class "\010-\012\014\040-\074\076-\177"))
- (save-excursion
- (goto-char from)
- (if (re-search-forward (mm-string-to-multibyte "[^\x0-\x7f\x80-\xff]")
- to t)
- (error "Multibyte character in QP encoding region"))
- (save-restriction
- (narrow-to-region from to)
- ;; Encode all the non-ascii and control characters.
- (goto-char (point-min))
- (while (and (skip-chars-forward class)
- (not (eobp)))
- (insert
- (prog1
- ;; To unibyte in case of Emacs 23 (unicode) eight-bit.
- (format "=%02X" (mm-multibyte-char-to-unibyte (char-after)))
- (delete-char 1))))
- ;; Encode white space at the end of lines.
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
- (goto-char (match-beginning 0))
- (while (not (eolp))
- (insert
- (prog1
- (format "=%02X" (char-after))
- (delete-char 1)))))
- (let ((mm-use-ultra-safe-encoding
- (and (boundp 'mm-use-ultra-safe-encoding)
- mm-use-ultra-safe-encoding)))
- (when (or fold mm-use-ultra-safe-encoding)
- (let ((tab-width 1)) ; HTAB is one character.
- (goto-char (point-min))
- (while (not (eobp))
- ;; In ultra-safe mode, encode "From " at the beginning
- ;; of a line.
- (when mm-use-ultra-safe-encoding
- (if (looking-at "From ")
- (replace-match "From=20" nil t)
- (if (looking-at "-")
- (replace-match "=2D" nil t))))
- (end-of-line)
- ;; Fold long lines.
- (while (> (current-column) 76) ; tab-width must be 1.
- (beginning-of-line)
- (forward-char 75) ; 75 chars plus an "="
- (search-backward "=" (- (point) 2) t)
- (insert "=\n")
- (end-of-line))
- (forward-line))))))))
-
-(defun quoted-printable-encode-string (string)
- "Encode the STRING as quoted-printable and return the result."
- (let ((default-enable-multibyte-characters (mm-multibyte-string-p string)))
- (with-temp-buffer
- (insert string)
- (quoted-printable-encode-region (point-min) (point-max))
- (buffer-string))))
-
-(provide 'qp)
-
-;;; arch-tag: db89e52a-e4a1-4b69-926f-f434f04216ba
-;;; qp.el ends here
+++ /dev/null
-;;; rfc1843.el --- HZ (rfc1843) decoding
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: news HZ HZ+ mail i18n
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Usage:
-;; (require 'rfc1843)
-;; (rfc1843-gnus-setup)
-;;
-;; Test:
-;; (rfc1843-decode-string "~{<:Ky2;S{#,NpJ)l6HK!#~}")
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mm-util)
-
-(defvar gnus-decode-encoded-word-function)
-(defvar gnus-decode-header-function)
-(defvar gnus-newsgroup-name)
-
-(defvar rfc1843-word-regexp
- "~\\({\\([\041-\167][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
-
-(defvar rfc1843-word-regexp-strictly
- "~\\({\\([\041-\167][\041-\176]\\)+\\)\\(~}\\|$\\)")
-
-(defvar rfc1843-hzp-word-regexp
- "~\\({\\([\041-\167][\041-\176]\\| \\)+\\|\
-\[<>]\\([\041-\175][\041-\176]\\| \\)+\\)\\(~}\\|$\\)")
-
-(defvar rfc1843-hzp-word-regexp-strictly
- "~\\({\\([\041-\167][\041-\176]\\)+\\|\
-\[<>]\\([\041-\175][\041-\176]\\)+\\)\\(~}\\|$\\)")
-
-(defcustom rfc1843-decode-loosely nil
- "Loosely check HZ encoding if non-nil.
-When it is set non-nil, only buffers or strings with strictly
-HZ-encoded are decoded."
- :type 'boolean
- :group 'mime)
-
-(defcustom rfc1843-decode-hzp t
- "HZ+ decoding support if non-nil.
-HZ+ specification (also known as HZP) is to provide a standardized
-7-bit representation of mixed Big5, GB, and ASCII text for convenient
-e-mail transmission, news posting, etc.
-The document of HZ+ 0.78 specification can be found at
-ftp://ftp.math.psu.edu/pub/simpson/chinese/hzp/hzp.doc"
- :type 'boolean
- :group 'mime)
-
-(defcustom rfc1843-newsgroups-regexp "chinese\\|hz"
- "Regexp of newsgroups in which might be HZ encoded."
- :type 'string
- :group 'mime)
-
-(defun rfc1843-decode-region (from to)
- "Decode HZ in the region between FROM and TO."
- (interactive "r")
- (let (str firstc)
- (save-excursion
- (goto-char from)
- (if (or rfc1843-decode-loosely
- (re-search-forward (if rfc1843-decode-hzp
- rfc1843-hzp-word-regexp-strictly
- rfc1843-word-regexp-strictly) to t))
- (save-restriction
- (narrow-to-region from to)
- (goto-char (point-min))
- (while (re-search-forward (if rfc1843-decode-hzp
- rfc1843-hzp-word-regexp
- rfc1843-word-regexp) (point-max) t)
- ;;; Text with extents may cause XEmacs crash
- (setq str (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))
- (setq firstc (aref str 0))
- (insert (mm-decode-coding-string
- (rfc1843-decode
- (prog1
- (substring str 1)
- (delete-region (match-beginning 0) (match-end 0)))
- firstc)
- (if (eq firstc ?{) 'cn-gb-2312 'cn-big5))))
- (goto-char (point-min))
- (while (search-forward "~" (point-max) t)
- (cond ((eq (char-after) ?\n)
- (delete-char -1)
- (delete-char 1))
- ((eq (char-after) ?~)
- (delete-char 1)))))))))
-
-(defun rfc1843-decode-string (string)
- "Decode HZ STRING and return the results."
- (let ((m (mm-multibyte-p)))
- (with-temp-buffer
- (when m
- (mm-enable-multibyte))
- (insert string)
- (inline
- (rfc1843-decode-region (point-min) (point-max)))
- (buffer-string))))
-
-(defun rfc1843-decode (word &optional firstc)
- "Decode HZ WORD and return it."
- (let ((i -1) (s (substring word 0)) v)
- (if (or (not firstc) (eq firstc ?{))
- (while (< (incf i) (length s))
- (if (eq (setq v (aref s i)) ? ) nil
- (aset s i (+ 128 v))))
- (while (< (incf i) (length s))
- (if (eq (setq v (aref s i)) ? ) nil
- (setq v (+ (* 94 v) (aref s (1+ i)) -3135))
- (aset s i (+ (/ v 157) (if (eq firstc ?<) 201 161)))
- (setq v (% v 157))
- (aset s (incf i) (+ v (if (< v 63) 64 98))))))
- s))
-
-(defun rfc1843-decode-article-body ()
- "Decode HZ encoded text in the article body."
- (if (string-match (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
- (or gnus-newsgroup-name ""))
- (save-excursion
- (save-restriction
- (message-narrow-to-head)
- (let* ((inhibit-point-motion-hooks t)
- (case-fold-search t)
- (ct (message-fetch-field "Content-Type" t))
- (ctl (and ct (mail-header-parse-content-type ct))))
- (if (and ctl (not (string-match "/" (car ctl))))
- (setq ctl nil))
- (goto-char (point-max))
- (widen)
- (forward-line 1)
- (narrow-to-region (point) (point-max))
- (when (or (not ctl)
- (equal (car ctl) "text/plain"))
- (rfc1843-decode-region (point) (point-max))))))))
-
-(defvar rfc1843-old-gnus-decode-header-function nil)
-(defvar gnus-decode-header-methods)
-(defvar gnus-decode-encoded-word-methods)
-
-(defun rfc1843-gnus-setup ()
- "Setup HZ decoding for Gnus."
- (require 'gnus-art)
- (require 'gnus-sum)
- (add-hook 'gnus-article-decode-hook 'rfc1843-decode-article-body t)
- (setq gnus-decode-encoded-word-function
- 'gnus-multi-decode-encoded-word-string
- gnus-decode-header-function
- 'gnus-multi-decode-header
- gnus-decode-encoded-word-methods
- (nconc gnus-decode-encoded-word-methods
- (list
- (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
- 'rfc1843-decode-string)))
- gnus-decode-header-methods
- (nconc gnus-decode-header-methods
- (list
- (cons (concat "\\<\\(" rfc1843-newsgroups-regexp "\\)\\>")
- 'rfc1843-decode-region)))))
-
-(provide 'rfc1843)
-
-;;; arch-tag: 5149c301-a6ca-4731-9c9d-ba616e2cb687
-;;; rfc1843.el ends here
+++ /dev/null
-;;; rfc2045.el --- Functions for decoding rfc2045 headers
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;; RFC 2045 is: "Multipurpose Internet Mail Extensions (MIME) Part
-;; One: Format of Internet Message Bodies".
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'ietf-drums)
-
-(defun rfc2045-encode-string (param value)
- "Return and PARAM=VALUE string encoded according to RFC2045."
- (if (or (string-match (concat "[" ietf-drums-no-ws-ctl-token "]") value)
- (string-match (concat "[" ietf-drums-tspecials "]") value)
- (string-match "[ \n\t]" value)
- (not (string-match (concat "[" ietf-drums-text-token "]") value)))
- (concat param "=" (format "%S" value))
- (concat param "=" value)))
-
-(provide 'rfc2045)
-
-;;; arch-tag: 9ca54127-97bc-432c-b6e2-8c59cadba306
-;;; rfc2045.el ends here
+++ /dev/null
-;;; rfc2047.el --- functions for encoding and decoding rfc2047 messages
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; MORIOKA Tomohiko <morioka@jaist.ac.jp>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; RFC 2047 is "MIME (Multipurpose Internet Mail Extensions) Part
-;; Three: Message Header Extensions for Non-ASCII Text".
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (defvar message-posting-charset)
- (unless (fboundp 'with-syntax-table) ; not in Emacs 20
- (defmacro with-syntax-table (table &rest body)
- "Evaluate BODY with syntax table of current buffer set to TABLE.
-The syntax table of the current buffer is saved, BODY is evaluated, and the
-saved table is restored, even in case of an abnormal exit.
-Value is what BODY returns."
- (let ((old-table (make-symbol "table"))
- (old-buffer (make-symbol "buffer")))
- `(let ((,old-table (syntax-table))
- (,old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-syntax-table ,table)
- ,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
- (set-syntax-table ,old-table))))))))
-
-(require 'qp)
-(require 'mm-util)
-(require 'ietf-drums)
-;; Fixme: Avoid this (used for mail-parse-charset) mm dependence on gnus.
-(require 'mail-prsvr)
-(require 'rfc2045) ;; rfc2045-encode-string
-(autoload 'mm-body-7-or-8 "mm-bodies")
-
-(eval-and-compile
- ;; Avoid gnus-util for mm- code.
- (defalias 'rfc2047-point-at-bol
- (if (fboundp 'point-at-bol)
- 'point-at-bol
- 'line-beginning-position))
-
- (defalias 'rfc2047-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
-(defvar rfc2047-header-encoding-alist
- '(("Newsgroups" . nil)
- ("Followup-To" . nil)
- ("Message-ID" . nil)
- ("\\(Resent-\\)?\\(From\\|Cc\\|To\\|Bcc\\|\\(In-\\)?Reply-To\\|Sender\
-\\|Mail-Followup-To\\|Mail-Copies-To\\|Approved\\)" . address-mime)
- (t . mime))
- "*Header/encoding method alist.
-The list is traversed sequentially. The keys can either be
-header regexps or t.
-
-The values can be:
-
-1) nil, in which case no encoding is done;
-2) `mime', in which case the header will be encoded according to RFC2047;
-3) `address-mime', like `mime', but takes account of the rules for address
- fields (where quoted strings and comments must be treated separately);
-4) a charset, in which case it will be encoded as that charset;
-5) `default', in which case the field will be encoded as the rest
- of the article.")
-
-(defvar rfc2047-charset-encoding-alist
- '((us-ascii . nil)
- (iso-8859-1 . Q)
- (iso-8859-2 . Q)
- (iso-8859-3 . Q)
- (iso-8859-4 . Q)
- (iso-8859-5 . B)
- (koi8-r . B)
- (iso-8859-7 . B)
- (iso-8859-8 . B)
- (iso-8859-9 . Q)
- (iso-8859-14 . Q)
- (iso-8859-15 . Q)
- (iso-2022-jp . B)
- (iso-2022-kr . B)
- (gb2312 . B)
- (big5 . B)
- (cn-big5 . B)
- (cn-gb . B)
- (cn-gb-2312 . B)
- (euc-kr . B)
- (iso-2022-jp-2 . B)
- (iso-2022-int-1 . B)
- (viscii . Q))
- "Alist of MIME charsets to RFC2047 encodings.
-Valid encodings are nil, `Q' and `B'. These indicate binary (no) encoding,
-quoted-printable and base64 respectively.")
-
-(defvar rfc2047-encode-function-alist
- '((Q . rfc2047-q-encode-string)
- (B . rfc2047-b-encode-string)
- (nil . identity))
- "Alist of RFC2047 encodings to encoding functions.")
-
-(defvar rfc2047-encode-encoded-words t
- "Whether encoded words should be encoded again.")
-
-;;;
-;;; Functions for encoding RFC2047 messages
-;;;
-
-(defun rfc2047-qp-or-base64 ()
- "Return the type with which to encode the buffer.
-This is either `base64' or `quoted-printable'."
- (save-excursion
- (let ((limit (min (point-max) (+ 2000 (point-min))))
- (n8bit 0))
- (goto-char (point-min))
- (skip-chars-forward "\x20-\x7f\r\n\t" limit)
- (while (< (point) limit)
- (incf n8bit)
- (forward-char 1)
- (skip-chars-forward "\x20-\x7f\r\n\t" limit))
- (if (or (< (* 6 n8bit) (- limit (point-min)))
- ;; Don't base64, say, a short line with a single
- ;; non-ASCII char when splitting parts by charset.
- (= n8bit 1))
- 'quoted-printable
- 'base64))))
-
-(defun rfc2047-narrow-to-field ()
- "Narrow the buffer to the header on the current line."
- (beginning-of-line)
- (narrow-to-region
- (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \n\t]" nil t)
- (rfc2047-point-at-bol)
- (point-max))))
- (goto-char (point-min)))
-
-(defun rfc2047-field-value ()
- "Return the value of the field at point."
- (save-excursion
- (save-restriction
- (rfc2047-narrow-to-field)
- (re-search-forward ":[ \t\n]*" nil t)
- (buffer-substring-no-properties (point) (point-max)))))
-
-(defun rfc2047-quote-special-characters-in-quoted-strings (&optional
- encodable-regexp)
- "Quote special characters with `\\'s in quoted strings.
-Quoting will not be done in a quoted string if it contains characters
-matching ENCODABLE-REGEXP."
- (goto-char (point-min))
- (let ((tspecials (concat "[" ietf-drums-tspecials "]"))
- beg end)
- (with-syntax-table (standard-syntax-table)
- (while (search-forward "\"" nil t)
- (setq beg (match-beginning 0))
- (unless (eq (char-before beg) ?\\)
- (goto-char beg)
- (setq beg (1+ beg))
- (condition-case nil
- (progn
- (forward-sexp)
- (setq end (1- (point)))
- (goto-char beg)
- (if (and encodable-regexp
- (re-search-forward encodable-regexp end t))
- (goto-char (1+ end))
- (save-restriction
- (narrow-to-region beg end)
- (while (re-search-forward tspecials nil 'move)
- (if (eq (char-before) ?\\)
- (if (looking-at tspecials) ;; Already quoted.
- (forward-char)
- (insert "\\"))
- (goto-char (match-beginning 0))
- (insert "\\")
- (forward-char))))
- (forward-char)))
- (error
- (goto-char beg))))))))
-
-(defvar rfc2047-encoding-type 'address-mime
- "The type of encoding done by `rfc2047-encode-region'.
-This should be dynamically bound around calls to
-`rfc2047-encode-region' to either `mime' or `address-mime'. See
-`rfc2047-header-encoding-alist', for definitions.")
-
-(defun rfc2047-encode-message-header ()
- "Encode the message header according to `rfc2047-header-encoding-alist'.
-Should be called narrowed to the head of the message."
- (interactive "*")
- (save-excursion
- (goto-char (point-min))
- (let (alist elem method)
- (while (not (eobp))
- (save-restriction
- (rfc2047-narrow-to-field)
- (setq method nil
- alist rfc2047-header-encoding-alist)
- (while (setq elem (pop alist))
- (when (or (and (stringp (car elem))
- (looking-at (car elem)))
- (eq (car elem) t))
- (setq alist nil
- method (cdr elem))))
- (if (not (rfc2047-encodable-p))
- (prog2
- (when (eq method 'address-mime)
- (rfc2047-quote-special-characters-in-quoted-strings))
- (if (and (eq (mm-body-7-or-8) '8bit)
- (mm-multibyte-p)
- (mm-coding-system-p
- (car message-posting-charset)))
- ;; 8 bit must be decoded.
- (mm-encode-coding-region
- (point-min) (point-max)
- (mm-charset-to-coding-system
- (car message-posting-charset))))
- ;; No encoding necessary, but folding is nice
- (when nil
- (rfc2047-fold-region
- (save-excursion
- (goto-char (point-min))
- (skip-chars-forward "^:")
- (when (looking-at ": ")
- (forward-char 2))
- (point))
- (point-max))))
- ;; We found something that may perhaps be encoded.
- (re-search-forward "^[^:]+: *" nil t)
- (cond
- ((eq method 'address-mime)
- (rfc2047-encode-region (point) (point-max)))
- ((eq method 'mime)
- (let ((rfc2047-encoding-type 'mime))
- (rfc2047-encode-region (point) (point-max))))
- ((eq method 'default)
- (if (and (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters)
- mail-parse-charset)
- (mm-encode-coding-region (point) (point-max)
- mail-parse-charset)))
- ;; We get this when CC'ing messsages to newsgroups with
- ;; 8-bit names. The group name mail copy just got
- ;; unconditionally encoded. Previously, it would ask
- ;; whether to encode, which was quite confusing for the
- ;; user. If the new behaviour is wrong, tell me. I have
- ;; left the old code commented out below.
- ;; -- Per Abrahamsen <abraham@dina.kvl.dk> Date: 2001-10-07.
- ;; Modified by Dave Love, with the commented-out code changed
- ;; in accordance with changes elsewhere.
- ((null method)
- (rfc2047-encode-region (point) (point-max)))
-;;; ((null method)
-;;; (if (or (message-options-get
-;;; 'rfc2047-encode-message-header-encode-any)
-;;; (message-options-set
-;;; 'rfc2047-encode-message-header-encode-any
-;;; (y-or-n-p
-;;; "Some texts are not encoded. Encode anyway?")))
-;;; (rfc2047-encode-region (point-min) (point-max))
-;;; (error "Cannot send unencoded text")))
- ((mm-coding-system-p method)
- (if (and (featurep 'mule)
- (if (boundp 'default-enable-multibyte-characters)
- default-enable-multibyte-characters))
- (mm-encode-coding-region (point) (point-max) method)))
- ;; Hm.
- (t)))
- (goto-char (point-max)))))))
-
-;; Fixme: This, and the require below may not be the Right Thing, but
-;; should be safe just before release. -- fx 2001-02-08
-(eval-when-compile (defvar message-posting-charset))
-
-(defun rfc2047-encodable-p ()
- "Return non-nil if any characters in current buffer need encoding in headers.
-The buffer may be narrowed."
- (require 'message) ; for message-posting-charset
- (let ((charsets
- (mm-find-mime-charset-region (point-min) (point-max))))
- (goto-char (point-min))
- (or (and rfc2047-encode-encoded-words
- (prog1
- (search-forward "=?" nil t)
- (goto-char (point-min))))
- (and charsets
- (not (equal charsets (list (car message-posting-charset))))))))
-
-;; Use this syntax table when parsing into regions that may need
-;; encoding. Double quotes are string delimiters, backslash is
-;; character quoting, and all other RFC 2822 special characters are
-;; treated as punctuation so we can use forward-sexp/forward-word to
-;; skip to the end of regions appropriately. Nb. ietf-drums does
-;; things differently.
-(defconst rfc2047-syntax-table
- ;; (make-char-table 'syntax-table '(2)) only works in Emacs.
- (let ((table (make-syntax-table)))
- ;; The following is done to work for setting all elements of the table
- ;; in Emacs 21 and 22 and XEmacs; it appears to be the cleanest way.
- ;; Play safe and don't assume the form of the word syntax entry --
- ;; copy it from ?a.
- (if (fboundp 'set-char-table-range) ; Emacs
- (funcall (intern "set-char-table-range")
- table t (aref (standard-syntax-table) ?a))
- (if (fboundp 'put-char-table)
- (if (fboundp 'get-char-table) ; warning avoidance
- (put-char-table t (get-char-table ?a (standard-syntax-table))
- table))))
- (modify-syntax-entry ?\\ "\\" table)
- (modify-syntax-entry ?\" "\"" table)
- (modify-syntax-entry ?\( "(" table)
- (modify-syntax-entry ?\) ")" table)
- (modify-syntax-entry ?\< "." table)
- (modify-syntax-entry ?\> "." table)
- (modify-syntax-entry ?\[ "." table)
- (modify-syntax-entry ?\] "." table)
- (modify-syntax-entry ?: "." table)
- (modify-syntax-entry ?\; "." table)
- (modify-syntax-entry ?, "." table)
- (modify-syntax-entry ?@ "." table)
- table))
-
-(defun rfc2047-encode-region (b e)
- "Encode words in region B to E that need encoding.
-By default, the region is treated as containing RFC2822 addresses.
-Dynamically bind `rfc2047-encoding-type' to change that."
- (save-restriction
- (narrow-to-region b e)
- (let ((encodable-regexp (if rfc2047-encode-encoded-words
- "[^\000-\177]+\\|=\\?"
- "[^\000-\177]+"))
- start ; start of current token
- end begin csyntax
- ;; Whether there's an encoded word before the current token,
- ;; either immediately or separated by space.
- last-encoded
- (orig-text (buffer-substring-no-properties b e)))
- (if (eq 'mime rfc2047-encoding-type)
- ;; Simple case. Continuous words in which all those contain
- ;; non-ASCII characters are encoded collectively. Encoding
- ;; ASCII words, including `Re:' used in Subject headers, is
- ;; avoided for interoperability with non-MIME clients and
- ;; for making it easy to find keywords.
- (progn
- (goto-char (point-min))
- (while (progn (skip-chars-forward " \t\n")
- (not (eobp)))
- (setq start (point))
- (while (and (looking-at "[ \t\n]*\\([^ \t\n]+\\)")
- (progn
- (setq end (match-end 0))
- (re-search-forward encodable-regexp end t)))
- (goto-char end))
- (if (> (point) start)
- (rfc2047-encode start (point))
- (goto-char end))))
- ;; `address-mime' case -- take care of quoted words, comments.
- (rfc2047-quote-special-characters-in-quoted-strings encodable-regexp)
- (with-syntax-table rfc2047-syntax-table
- (goto-char (point-min))
- (condition-case err ; in case of unbalanced quotes
- ;; Look for rfc2822-style: sequences of atoms, quoted
- ;; strings, specials, whitespace. (Specials mustn't be
- ;; encoded.)
- (while (not (eobp))
- ;; Skip whitespace.
- (skip-chars-forward " \t\n")
- (setq start (point))
- (cond
- ((not (char-after))) ; eob
- ;; else token start
- ((eq ?\" (setq csyntax (char-syntax (char-after))))
- ;; Quoted word.
- (forward-sexp)
- (setq end (point))
- ;; Does it need encoding?
- (goto-char start)
- (if (re-search-forward encodable-regexp end 'move)
- ;; It needs encoding. Strip the quotes first,
- ;; since encoded words can't occur in quotes.
- (progn
- (goto-char end)
- (delete-backward-char 1)
- (goto-char start)
- (delete-char 1)
- (when last-encoded
- ;; There was a preceding quoted word. We need
- ;; to include any separating whitespace in this
- ;; word to avoid it getting lost.
- (skip-chars-backward " \t")
- ;; A space is needed between the encoded words.
- (insert ? )
- (setq start (point)
- end (1+ end)))
- ;; Adjust the end position for the deleted quotes.
- (rfc2047-encode start (- end 2))
- (setq last-encoded t)) ; record that it was encoded
- (setq last-encoded nil)))
- ((eq ?. csyntax)
- ;; Skip other delimiters, but record that they've
- ;; potentially separated quoted words.
- (forward-char)
- (setq last-encoded nil))
- ((eq ?\) csyntax)
- (error "Unbalanced parentheses"))
- ((eq ?\( csyntax)
- ;; Look for the end of parentheses.
- (forward-list)
- ;; Encode text as an unstructured field.
- (let ((rfc2047-encoding-type 'mime))
- (rfc2047-encode-region (1+ start) (1- (point))))
- (skip-chars-forward ")"))
- (t ; normal token/whitespace sequence
- ;; Find the end.
- ;; Skip one ASCII word, or encode continuous words
- ;; in which all those contain non-ASCII characters.
- (setq end nil)
- (while (not (or end (eobp)))
- (when (looking-at "[\000-\177]+")
- (setq begin (point)
- end (match-end 0))
- (when (progn
- (while (and (or (re-search-forward
- "[ \t\n]\\|\\Sw" end 'move)
- (setq end nil))
- (eq ?\\ (char-syntax (char-before))))
- ;; Skip backslash-quoted characters.
- (forward-char))
- end)
- (setq end (match-beginning 0))
- (if rfc2047-encode-encoded-words
- (progn
- (goto-char begin)
- (when (search-forward "=?" end 'move)
- (goto-char (match-beginning 0))
- (setq end nil)))
- (goto-char end))))
- ;; Where the value nil of `end' means there may be
- ;; text to have to be encoded following the point.
- ;; Otherwise, the point reached to the end of ASCII
- ;; words separated by whitespace or a special char.
- (unless end
- (when (looking-at encodable-regexp)
- (goto-char (setq begin (match-end 0)))
- (while (and (looking-at "[ \t\n]+\\([^ \t\n]+\\)")
- (setq end (match-end 0))
- (progn
- (while (re-search-forward
- encodable-regexp end t))
- (< begin (point)))
- (goto-char begin)
- (or (not (re-search-forward "\\Sw" end t))
- (progn
- (goto-char (match-beginning 0))
- nil)))
- (goto-char end))
- (when (looking-at "[^ \t\n]+")
- (setq end (match-end 0))
- (if (re-search-forward "\\Sw+" end t)
- ;; There are special characters better
- ;; to be encoded so that MTAs may parse
- ;; them safely.
- (cond ((= end (point)))
- ((looking-at (concat "\\sw*\\("
- encodable-regexp
- "\\)"))
- (setq end nil))
- (t
- (goto-char (1- (match-end 0)))
- (unless (= (point) (match-beginning 0))
- ;; Separate encodable text and
- ;; delimiter.
- (insert " "))))
- (goto-char end)
- (skip-chars-forward " \t\n")
- (if (and (looking-at "[^ \t\n]+")
- (string-match encodable-regexp
- (match-string 0)))
- (setq end nil)
- (goto-char end)))))))
- (skip-chars-backward " \t\n")
- (setq end (point))
- (goto-char start)
- (if (re-search-forward encodable-regexp end 'move)
- (progn
- (unless (memq (char-before start) '(nil ?\t ? ))
- (if (progn
- (goto-char start)
- (skip-chars-backward "^ \t\n")
- (and (looking-at "\\Sw+")
- (= (match-end 0) start)))
- ;; Also encode bogus delimiters.
- (setq start (point))
- ;; Separate encodable text and delimiter.
- (goto-char start)
- (insert " ")
- (setq start (1+ start)
- end (1+ end))))
- (rfc2047-encode start end)
- (setq last-encoded t))
- (setq last-encoded nil)))))
- (error
- (if (or debug-on-quit debug-on-error)
- (signal (car err) (cdr err))
- (error "Invalid data for rfc2047 encoding: %s"
- (mm-replace-in-string orig-text "[ \t\n]+" " "))))))))
- (rfc2047-fold-region b (point))
- (goto-char (point-max))))
-
-(defun rfc2047-encode-string (string)
- "Encode words in STRING.
-By default, the string is treated as containing addresses (see
-`rfc2047-encoding-type')."
- (mm-with-multibyte-buffer
- (insert string)
- (rfc2047-encode-region (point-min) (point-max))
- (buffer-string)))
-
-(defvar rfc2047-encode-max-chars 76
- "Maximum characters of each header line that contain encoded-words.
-If it is nil, encoded-words will not be folded. Too small value may
-cause an error. Don't change this for no particular reason.")
-
-(defun rfc2047-encode-1 (column string cs encoder start crest tail
- &optional eword)
- "Subroutine used by `rfc2047-encode'."
- (cond ((string-equal string "")
- (or eword ""))
- ((not rfc2047-encode-max-chars)
- (concat start
- (funcall encoder (if cs
- (mm-encode-coding-string string cs)
- string))
- "?="))
- ((>= column rfc2047-encode-max-chars)
- (when eword
- (cond ((string-match "\n[ \t]+\\'" eword)
- ;; Reomove a superfluous empty line.
- (setq eword (substring eword 0 (match-beginning 0))))
- ((string-match "(+\\'" eword)
- ;; Break the line before the open parenthesis.
- (setq crest (concat crest (match-string 0 eword))
- eword (substring eword 0 (match-beginning 0))))))
- (rfc2047-encode-1 (length crest) string cs encoder start " " tail
- (concat eword "\n" crest)))
- (t
- (let ((index 0)
- (limit (1- (length string)))
- (prev "")
- next len)
- (while (and prev
- (<= index limit))
- (setq next (concat start
- (funcall encoder
- (if cs
- (mm-encode-coding-string
- (substring string 0 (1+ index))
- cs)
- (substring string 0 (1+ index))))
- "?=")
- len (+ column (length next)))
- (if (> len rfc2047-encode-max-chars)
- (setq next prev
- prev nil)
- (if (or (< index limit)
- (<= (+ len (or (string-match "\n" tail)
- (length tail)))
- rfc2047-encode-max-chars))
- (setq prev next
- index (1+ index))
- (if (string-match "\\`)+" tail)
- ;; Break the line after the close parenthesis.
- (setq tail (concat (substring tail 0 (match-end 0))
- "\n "
- (substring tail (match-end 0)))
- prev next
- index (1+ index))
- (setq next prev
- prev nil)))))
- (if (> index limit)
- (concat eword next tail)
- (if (= 0 index)
- (if (and eword
- (string-match "(+\\'" eword))
- (setq crest (concat crest (match-string 0 eword))
- eword (substring eword 0 (match-beginning 0)))
- (setq eword (concat eword next)))
- (setq crest " "
- eword (concat eword next)))
- (when (string-match "\n[ \t]+\\'" eword)
- ;; Reomove a superfluous empty line.
- (setq eword (substring eword 0 (match-beginning 0))))
- (rfc2047-encode-1 (length crest) (substring string index)
- cs encoder start " " tail
- (concat eword "\n" crest)))))))
-
-(defun rfc2047-encode (b e)
- "Encode the word(s) in the region B to E.
-Point moves to the end of the region."
- (let ((mime-charset (or (mm-find-mime-charset-region b e) (list 'us-ascii)))
- cs encoding tail crest eword)
- (cond ((> (length mime-charset) 1)
- (error "Can't rfc2047-encode `%s'"
- (buffer-substring-no-properties b e)))
- ((= (length mime-charset) 1)
- (setq mime-charset (car mime-charset)
- cs (mm-charset-to-coding-system mime-charset))
- (unless (and (mm-multibyte-p)
- (mm-coding-system-p cs))
- (setq cs nil))
- (save-restriction
- (narrow-to-region b e)
- (setq encoding
- (or (cdr (assq mime-charset
- rfc2047-charset-encoding-alist))
- ;; For the charsets that don't have a preferred
- ;; encoding, choose the one that's shorter.
- (if (eq (rfc2047-qp-or-base64) 'base64)
- 'B
- 'Q)))
- (widen)
- (goto-char e)
- (skip-chars-forward "^ \t\n")
- ;; `tail' may contain a close parenthesis.
- (setq tail (buffer-substring-no-properties e (point)))
- (goto-char b)
- (setq b (point-marker)
- e (set-marker (make-marker) e))
- (rfc2047-fold-region (rfc2047-point-at-bol) b)
- (goto-char b)
- (skip-chars-backward "^ \t\n")
- (unless (= 0 (skip-chars-backward " \t"))
- ;; `crest' may contain whitespace and an open parenthesis.
- (setq crest (buffer-substring-no-properties (point) b)))
- (setq eword (rfc2047-encode-1
- (- b (rfc2047-point-at-bol))
- (mm-replace-in-string
- (buffer-substring-no-properties b e)
- "\n\\([ \t]?\\)" "\\1")
- cs
- (or (cdr (assq encoding
- rfc2047-encode-function-alist))
- 'identity)
- (concat "=?" (downcase (symbol-name mime-charset))
- "?" (upcase (symbol-name encoding)) "?")
- (or crest " ")
- tail))
- (delete-region (if (eq (aref eword 0) ?\n)
- (if (bolp)
- ;; The line was folded before encoding.
- (1- (point))
- (point))
- (goto-char b))
- (+ e (length tail)))
- ;; `eword' contains `crest' and `tail'.
- (insert eword)
- (set-marker b nil)
- (set-marker e nil)
- (unless (or (/= 0 (length tail))
- (eobp)
- (looking-at "[ \t\n)]"))
- (insert " "))))
- (t
- (goto-char e)))))
-
-(defun rfc2047-fold-field ()
- "Fold the current header field."
- (save-excursion
- (save-restriction
- (rfc2047-narrow-to-field)
- (rfc2047-fold-region (point-min) (point-max)))))
-
-(defun rfc2047-fold-region (b e)
- "Fold long lines in region B to E."
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (let ((break nil)
- (qword-break nil)
- (first t)
- (bol (save-restriction
- (widen)
- (rfc2047-point-at-bol))))
- (while (not (eobp))
- (when (and (or break qword-break)
- (> (- (point) bol) 76))
- (goto-char (or break qword-break))
- (setq break nil
- qword-break nil)
- (skip-chars-backward " \t")
- (if (looking-at "[ \t]")
- (insert ?\n)
- (insert "\n "))
- (setq bol (1- (point)))
- ;; Don't break before the first non-LWSP characters.
- (skip-chars-forward " \t")
- (unless (eobp)
- (forward-char 1)))
- (cond
- ((eq (char-after) ?\n)
- (forward-char 1)
- (setq bol (point)
- break nil
- qword-break nil)
- (skip-chars-forward " \t")
- (unless (or (eobp) (eq (char-after) ?\n))
- (forward-char 1)))
- ((eq (char-after) ?\r)
- (forward-char 1))
- ((memq (char-after) '(? ?\t))
- (skip-chars-forward " \t")
- (unless first ;; Don't break just after the header name.
- (setq break (point))))
- ((not break)
- (if (not (looking-at "=\\?[^=]"))
- (if (eq (char-after) ?=)
- (forward-char 1)
- (skip-chars-forward "^ \t\n\r="))
- ;; Don't break at the start of the field.
- (unless (= (point) b)
- (setq qword-break (point)))
- (skip-chars-forward "^ \t\n\r")))
- (t
- (skip-chars-forward "^ \t\n\r")))
- (setq first nil))
- (when (and (or break qword-break)
- (> (- (point) bol) 76))
- (goto-char (or break qword-break))
- (setq break nil
- qword-break nil)
- (if (or (> 0 (skip-chars-backward " \t"))
- (looking-at "[ \t]"))
- (insert ?\n)
- (insert "\n "))
- (setq bol (1- (point)))
- ;; Don't break before the first non-LWSP characters.
- (skip-chars-forward " \t")
- (unless (eobp)
- (forward-char 1))))))
-
-(defun rfc2047-unfold-field ()
- "Fold the current line."
- (save-excursion
- (save-restriction
- (rfc2047-narrow-to-field)
- (rfc2047-unfold-region (point-min) (point-max)))))
-
-(defun rfc2047-unfold-region (b e)
- "Unfold lines in region B to E."
- (save-restriction
- (narrow-to-region b e)
- (goto-char (point-min))
- (let ((bol (save-restriction
- (widen)
- (rfc2047-point-at-bol)))
- (eol (rfc2047-point-at-eol)))
- (forward-line 1)
- (while (not (eobp))
- (if (and (looking-at "[ \t]")
- (< (- (rfc2047-point-at-eol) bol) 76))
- (delete-region eol (progn
- (goto-char eol)
- (skip-chars-forward "\r\n")
- (point)))
- (setq bol (rfc2047-point-at-bol)))
- (setq eol (rfc2047-point-at-eol))
- (forward-line 1)))))
-
-(defun rfc2047-b-encode-string (string)
- "Base64-encode the header contained in STRING."
- (base64-encode-string string t))
-
-(defun rfc2047-q-encode-string (string)
- "Quoted-printable-encode the header in STRING."
- (mm-with-unibyte-buffer
- (insert string)
- (quoted-printable-encode-region
- (point-min) (point-max) nil
- ;; = (\075), _ (\137), ? (\077) are used in the encoded word.
- ;; Avoid using 8bit characters.
- ;; This list excludes `especials' (see the RFC2047 syntax),
- ;; meaning that some characters in non-structured fields will
- ;; get encoded when they con't need to be. The following is
- ;; what it used to be.
- ;;; ;; Equivalent to "^\000-\007\011\013\015-\037\200-\377=_?"
- ;;; "\010\012\014\040-\074\076\100-\136\140-\177")
- "-\b\n\f !#-'*+0-9A-Z\\^`-~\d")
- (subst-char-in-region (point-min) (point-max) ? ?_)
- (buffer-string)))
-
-(defun rfc2047-encode-parameter (param value)
- "Return and PARAM=VALUE string encoded in the RFC2047-like style.
-This is a replacement for the `rfc2231-encode-string' function.
-
-When attaching files as MIME parts, we should use the RFC2231 encoding
-to specify the file names containing non-ASCII characters. However,
-many mail softwares don't support it in practice and recipients won't
-be able to extract files with correct names. Instead, the RFC2047-like
-encoding is acceptable generally. This function provides the very
-RFC2047-like encoding, resigning to such a regrettable trend. To use
-it, put the following line in your ~/.gnus.el file:
-
-\(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
-"
- (let ((rfc2047-encoding-type 'mime)
- (rfc2047-encode-max-chars nil))
- (rfc2045-encode-string param (rfc2047-encode-string value))))
-
-;;;
-;;; Functions for decoding RFC2047 messages
-;;;
-
-(eval-and-compile
- (defconst rfc2047-encoded-word-regexp
- "=\\?\\([^][\000-\040()<>@,\;:*\\\"/?.=]+\\)\\(\\*[^?]+\\)?\
-\\?\\(B\\|Q\\)\\?\\([!->@-~ ]*\\)\\?="))
-
-(defvar rfc2047-quote-decoded-words-containing-tspecials nil
- "If non-nil, quote decoded words containing special characters.")
-
-(defvar rfc2047-allow-incomplete-encoded-text t
- "*Non-nil means allow incomplete encoded-text in successive encoded-words.
-Dividing of encoded-text in the place other than character boundaries
-violates RFC2047 section 5, while we have a capability to decode it.
-If it is non-nil, the decoder will decode B- or Q-encoding in each
-encoded-word, concatenate them, and decode it by charset. Otherwise,
-the decoder will fully decode each encoded-word before concatenating
-them.")
-
-(defun rfc2047-strip-backslashes-in-quoted-strings ()
- "Strip backslashes in quoted strings. `\\\"' remains."
- (goto-char (point-min))
- (let (beg)
- (with-syntax-table (standard-syntax-table)
- (while (search-forward "\"" nil t)
- (unless (eq (char-before) ?\\)
- (setq beg (match-end 0))
- (goto-char (match-beginning 0))
- (condition-case nil
- (progn
- (forward-sexp)
- (save-restriction
- (narrow-to-region beg (1- (point)))
- (goto-char beg)
- (while (search-forward "\\" nil 'move)
- (unless (memq (char-after) '(?\"))
- (delete-backward-char 1))
- (forward-char)))
- (forward-char))
- (error
- (goto-char beg))))))))
-
-(defun rfc2047-charset-to-coding-system (charset)
- "Return coding-system corresponding to MIME CHARSET.
-If your Emacs implementation can't decode CHARSET, return nil."
- (when (stringp charset)
- (setq charset (intern (downcase charset))))
- (when (or (not charset)
- (eq 'gnus-all mail-parse-ignored-charsets)
- (memq 'gnus-all mail-parse-ignored-charsets)
- (memq charset mail-parse-ignored-charsets))
- (setq charset mail-parse-charset))
- (let ((cs (mm-charset-to-coding-system charset)))
- (cond ((eq cs 'ascii)
- (setq cs (or (mm-charset-to-coding-system mail-parse-charset)
- 'raw-text)))
- ((mm-coding-system-p cs))
- ((and charset
- (listp mail-parse-ignored-charsets)
- (memq 'gnus-unknown mail-parse-ignored-charsets))
- (setq cs (mm-charset-to-coding-system mail-parse-charset))))
- (if (eq cs 'ascii)
- 'raw-text
- cs)))
-
-(defun rfc2047-decode-encoded-words (words)
- "Decode successive encoded-words in WORDS and return a decoded string.
-Each element of WORDS looks like (CHARSET ENCODING ENCODED-TEXT
-ENCODED-WORD)."
- (let (word charset cs encoding text rest)
- (while words
- (setq word (pop words))
- (if (and (setq cs (rfc2047-charset-to-coding-system
- (setq charset (car word))))
- (condition-case code
- (cond ((char-equal ?B (nth 1 word))
- (setq text (base64-decode-string
- (rfc2047-pad-base64 (nth 2 word)))))
- ((char-equal ?Q (nth 1 word))
- (setq text (quoted-printable-decode-string
- (mm-subst-char-in-string
- ?_ ? (nth 2 word) t)))))
- (error
- (message "%s" (error-message-string code))
- nil)))
- (if (and rfc2047-allow-incomplete-encoded-text
- (eq cs (caar rest)))
- ;; Concatenate text of which the charset is the same.
- (setcdr (car rest) (concat (cdar rest) text))
- (push (cons cs text) rest))
- ;; Don't decode encoded-word.
- (push (cons nil (nth 3 word)) rest)))
- (while rest
- (setq words (concat
- (or (and (setq cs (caar rest))
- (condition-case code
- (mm-decode-coding-string (cdar rest) cs)
- (error
- (message "%s" (error-message-string code))
- nil)))
- (concat (when (cdr rest) " ")
- (cdar rest)
- (when (and words
- (not (eq (string-to-char words) ? )))
- " ")))
- words)
- rest (cdr rest)))
- words))
-
-;; Fixme: This should decode in place, not cons intermediate strings.
-;; Also check whether it needs to worry about delimiting fields like
-;; encoding.
-
-;; In fact it's reported that (invalid) encoding of mailboxes in
-;; addr-specs is in use, so delimiting fields might help. Probably
-;; not decoding a word which isn't properly delimited is good enough
-;; and worthwhile (is it more correct or not?), e.g. something like
-;; `=?iso-8859-1?q?foo?=@'.
-
-(defun rfc2047-decode-region (start end &optional address-mime)
- "Decode MIME-encoded words in region between START and END.
-If ADDRESS-MIME is non-nil, strip backslashes which precede characters
-other than `\"' and `\\' in quoted strings."
- (interactive "r")
- (let ((case-fold-search t)
- (eword-regexp (eval-when-compile
- ;; Ignore whitespace between encoded-words.
- (concat "[\n\t ]*\\(" rfc2047-encoded-word-regexp
- "\\)")))
- b e match words)
- (save-excursion
- (save-restriction
- (narrow-to-region start end)
- (when address-mime
- (rfc2047-strip-backslashes-in-quoted-strings))
- (goto-char (setq b start))
- ;; Look for the encoded-words.
- (while (setq match (re-search-forward eword-regexp nil t))
- (setq e (match-beginning 1)
- end (match-end 0)
- words nil)
- (while match
- (push (list (match-string 2) ;; charset
- (char-after (match-beginning 4)) ;; encoding
- (match-string 5) ;; encoded-text
- (match-string 1)) ;; encoded-word
- words)
- ;; Look for the subsequent encoded-words.
- (when (setq match (looking-at eword-regexp))
- (goto-char (setq end (match-end 0)))))
- ;; Replace the encoded-words with the decoded one.
- (delete-region e end)
- (insert (rfc2047-decode-encoded-words (nreverse words)))
- (save-restriction
- (narrow-to-region e (point))
- (goto-char e)
- ;; Remove newlines between decoded words, though such
- ;; things essentially must not be there.
- (while (re-search-forward "[\n\r]+" nil t)
- (replace-match " "))
- ;; Quote decoded words if there are special characters
- ;; which might violate RFC2822.
- (when (and rfc2047-quote-decoded-words-containing-tspecials
- (let ((regexp (car (rassq
- 'address-mime
- rfc2047-header-encoding-alist))))
- (when regexp
- (save-restriction
- (widen)
- (beginning-of-line)
- (while (and (memq (char-after) '(? ?\t))
- (zerop (forward-line -1))))
- (looking-at regexp)))))
- (let (quoted)
- (goto-char e)
- (skip-chars-forward " \t")
- (setq start (point))
- (setq quoted (eq (char-after) ?\"))
- (goto-char (point-max))
- (skip-chars-backward " \t")
- (if (setq quoted (and quoted
- (> (point) (1+ start))
- (eq (char-before) ?\")))
- (progn
- (backward-char)
- (setq start (1+ start)
- end (point-marker)))
- (setq end (point-marker)))
- (goto-char start)
- (while (search-forward "\"" end t)
- (when (prog2
- (backward-char)
- (zerop (% (skip-chars-backward "\\\\") 2))
- (goto-char (match-beginning 0)))
- (insert "\\"))
- (forward-char))
- (when (and (not quoted)
- (progn
- (goto-char start)
- (re-search-forward
- (concat "[" ietf-drums-tspecials "]")
- end t)))
- (goto-char start)
- (insert "\"")
- (goto-char end)
- (insert "\""))
- (set-marker end nil)))
- (goto-char (point-max)))
- (when (and (mm-multibyte-p)
- mail-parse-charset
- (not (eq mail-parse-charset 'us-ascii))
- (not (eq mail-parse-charset 'gnus-decoded)))
- (mm-decode-coding-region b e mail-parse-charset))
- (setq b (point)))
- (when (and (mm-multibyte-p)
- mail-parse-charset
- (not (eq mail-parse-charset 'us-ascii))
- (not (eq mail-parse-charset 'gnus-decoded)))
- (mm-decode-coding-region b (point-max) mail-parse-charset))))))
-
-(defun rfc2047-decode-address-region (start end)
- "Decode MIME-encoded words in region between START and END.
-Backslashes which precede characters other than `\"' and `\\' in quoted
-strings are stripped."
- (rfc2047-decode-region start end t))
-
-(defun rfc2047-decode-string (string &optional address-mime)
- "Decode MIME-encoded STRING and return the result.
-If ADDRESS-MIME is non-nil, strip backslashes which precede characters
-other than `\"' and `\\' in quoted strings."
- (let ((m (mm-multibyte-p)))
- (if (string-match "=\\?" string)
- (with-temp-buffer
- ;; Fixme: This logic is wrong, but seems to be required by
- ;; Gnus summary buffer generation. The value of `m' depends
- ;; on the current buffer, not global multibyteness or that
- ;; of the string. Also the string returned should always be
- ;; multibyte in a multibyte session, i.e. the buffer should
- ;; be multibyte before `buffer-string' is called.
- (when m
- (mm-enable-multibyte))
- (insert string)
- (inline
- (rfc2047-decode-region (point-min) (point-max) address-mime))
- (buffer-string))
- (when address-mime
- (setq string
- (with-temp-buffer
- (when (mm-multibyte-string-p string)
- (mm-enable-multibyte))
- (insert string)
- (rfc2047-strip-backslashes-in-quoted-strings)
- (buffer-string))))
- ;; Fixme: As above, `m' here is inappropriate.
- (if (and m
- mail-parse-charset
- (not (eq mail-parse-charset 'us-ascii))
- (not (eq mail-parse-charset 'gnus-decoded)))
- ;; `decode-coding-string' in Emacs offers a third optional
- ;; arg NOCOPY to avoid consing a new string if the decoding
- ;; is "trivial". Unfortunately it currently doesn't
- ;; consider anything else than a `nil' coding system
- ;; trivial.
- ;; `rfc2047-decode-string' is called multiple times for each
- ;; article during summary buffer generation, and we really
- ;; want to avoid unnecessary consing. So we bypass
- ;; `decode-coding-string' if the string is purely ASCII.
- (if (and (fboundp 'detect-coding-string)
- ;; string is purely ASCII
- (eq (detect-coding-string string t) 'undecided))
- string
- (mm-decode-coding-string string mail-parse-charset))
- (mm-string-as-multibyte string)))))
-
-(defun rfc2047-decode-address-string (string)
- "Decode MIME-encoded STRING and return the result.
-Backslashes which precede characters other than `\"' and `\\' in quoted
-strings are stripped."
- (rfc2047-decode-string string t))
-
-(defun rfc2047-pad-base64 (string)
- "Pad STRING to quartets."
- ;; Be more liberal to accept buggy base64 strings. If
- ;; base64-decode-string accepts buggy strings, this function could
- ;; be aliased to identity.
- (if (= 0 (mod (length string) 4))
- string
- (when (string-match "=+$" string)
- (setq string (substring string 0 (match-beginning 0))))
- (case (mod (length string) 4)
- (0 string)
- (1 string) ;; Error, don't pad it.
- (2 (concat string "=="))
- (3 (concat string "=")))))
-
-(provide 'rfc2047)
-
-;;; arch-tag: a07fe3d4-22b5-4c4a-bd89-b1f82d5d36f6
-;;; rfc2047.el ends here
+++ /dev/null
-;;; rfc2231.el --- Functions for decoding rfc2231 headers
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-;; 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'ietf-drums)
-(require 'rfc2047)
-(autoload 'mm-encode-body "mm-bodies")
-(autoload 'mail-header-remove-whitespace "mail-parse")
-(autoload 'mail-header-remove-comments "mail-parse")
-
-(defun rfc2231-get-value (ct attribute)
- "Return the value of ATTRIBUTE from CT."
- (cdr (assq attribute (cdr ct))))
-
-(defun rfc2231-parse-qp-string (string)
- "Parse QP-encoded string using `rfc2231-parse-string'.
-N.B. This is in violation with RFC2047, but it seem to be in common use."
- (rfc2231-parse-string (rfc2047-decode-string string)))
-
-(defun rfc2231-parse-string (string &optional signal-error)
- "Parse STRING and return a list.
-The list will be on the form
- `(name (attribute . value) (attribute . value)...)'.
-
-If the optional SIGNAL-ERROR is non-nil, signal an error when this
-function fails in parsing of parameters. Otherwise, this function
-must never cause a Lisp error."
- (with-temp-buffer
- (let ((ttoken (ietf-drums-token-to-list ietf-drums-text-token))
- (stoken (ietf-drums-token-to-list ietf-drums-tspecials))
- (ntoken (ietf-drums-token-to-list "0-9"))
- c type attribute encoded number prev-attribute vals
- prev-encoded parameters value)
- (ietf-drums-init
- (condition-case nil
- (mail-header-remove-whitespace
- (mail-header-remove-comments string))
- ;; The most likely cause of an error is unbalanced parentheses
- ;; or double-quotes. If all parentheses and double-quotes are
- ;; quoted meaninglessly with backslashes, removing them might
- ;; make it parseable. Let's try...
- (error
- (let (mod)
- (when (and (string-match "\\\\\"" string)
- (not (string-match "\\`\"\\|[^\\]\"" string)))
- (setq string (mm-replace-in-string string "\\\\\"" "\"")
- mod t))
- (when (and (string-match "\\\\(" string)
- (string-match "\\\\)" string)
- (not (string-match "\\`(\\|[^\\][()]" string)))
- (setq string (mm-replace-in-string string "\\\\\\([()]\\)" "\\1")
- mod t))
- (or (and mod
- (ignore-errors
- (mail-header-remove-whitespace
- (mail-header-remove-comments string))))
- ;; Finally, attempt to extract only type.
- (if (string-match
- (concat "\\`[\t\n ]*\\([^" ietf-drums-tspecials "\t\n ]+"
- "\\(/[^" ietf-drums-tspecials
- "\t\n ]+\\)?\\)\\([\t\n ;]\\|\\'\\)")
- string)
- (match-string 1 string)
- ""))))))
- (let ((table (copy-syntax-table ietf-drums-syntax-table)))
- (modify-syntax-entry ?\' "w" table)
- (modify-syntax-entry ?* " " table)
- (modify-syntax-entry ?\; " " table)
- (modify-syntax-entry ?= " " table)
- ;; The following isn't valid, but one should be liberal
- ;; in what one receives.
- (modify-syntax-entry ?\: "w" table)
- (set-syntax-table table))
- (setq c (char-after))
- (when (and (memq c ttoken)
- (not (memq c stoken))
- (setq type (ignore-errors
- (downcase
- (buffer-substring (point) (progn
- (forward-sexp 1)
- (point)))))))
- ;; Do the params
- (condition-case err
- (progn
- (while (not (eobp))
- (setq c (char-after))
- (unless (eq c ?\;)
- (error "Invalid header: %s" string))
- (forward-char 1)
- ;; If c in nil, then this is an invalid header, but
- ;; since elm generates invalid headers on this form,
- ;; we allow it.
- (when (setq c (char-after))
- (if (and (memq c ttoken)
- (not (memq c stoken)))
- (setq attribute
- (intern
- (downcase
- (buffer-substring
- (point) (progn (forward-sexp 1) (point))))))
- (error "Invalid header: %s" string))
- (setq c (char-after))
- (if (eq c ?*)
- (progn
- (forward-char 1)
- (setq c (char-after))
- (if (not (memq c ntoken))
- (setq encoded t
- number nil)
- (setq number
- (string-to-number
- (buffer-substring
- (point) (progn (forward-sexp 1) (point)))))
- (setq c (char-after))
- (when (eq c ?*)
- (setq encoded t)
- (forward-char 1)
- (setq c (char-after)))))
- (setq number nil
- encoded nil))
- ;; See if we have any previous continuations.
- (when (and prev-attribute
- (not (eq prev-attribute attribute)))
- (setq vals
- (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
- (push (cons prev-attribute
- (if prev-encoded
- (rfc2231-decode-encoded-string vals)
- vals))
- parameters)
- (setq prev-attribute nil
- vals nil
- prev-encoded nil))
- (unless (eq c ?=)
- (error "Invalid header: %s" string))
- (forward-char 1)
- (setq c (char-after))
- (cond
- ((eq c ?\")
- (setq value (buffer-substring (1+ (point))
- (progn
- (forward-sexp 1)
- (1- (point)))))
- (when encoded
- (setq value (mapconcat (lambda (c) (format "%%%02x" c))
- value ""))))
- ((and (or (memq c ttoken)
- ;; EXTENSION: Support non-ascii chars.
- (> c ?\177))
- (not (memq c stoken)))
- (setq value
- (buffer-substring
- (point)
- (progn
- ;; Jump over asterisk, non-ASCII
- ;; and non-boundary characters.
- (while (and c
- (or (eq c ?*)
- (> c ?\177)
- (not (eq (char-syntax c) ? ))))
- (forward-char 1)
- (setq c (char-after)))
- (point)))))
- (t
- (error "Invalid header: %s" string)))
- (if number
- (progn
- (push (cons number value) vals)
- (setq prev-attribute attribute
- prev-encoded encoded))
- (push (cons attribute
- (if encoded
- (rfc2231-decode-encoded-string value)
- value))
- parameters))))
-
- ;; Take care of any final continuations.
- (when prev-attribute
- (setq vals (mapconcat 'cdr (sort vals 'car-less-than-car) ""))
- (push (cons prev-attribute
- (if prev-encoded
- (rfc2231-decode-encoded-string vals)
- vals))
- parameters)))
- (error
- (setq parameters nil)
- (if signal-error
- (signal (car err) (cdr err))
- ;;(message "%s" (error-message-string err))
- )))
-
- (cons type (nreverse parameters))))))
-
-(defun rfc2231-decode-encoded-string (string)
- "Decode an RFC2231-encoded string.
-These look like:
- \"us-ascii'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"us-ascii''This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"'en-us'This%20is%20%2A%2A%2Afun%2A%2A%2A\",
- \"''This%20is%20%2A%2A%2Afun%2A%2A%2A\", or
- \"This is ***fun***\"."
- (string-match "\\`\\(\\([^']+\\)?'\\([^']+\\)?'\\)?\\(.+\\)" string)
- (let ((coding-system (mm-charset-to-coding-system (match-string 2 string)))
- ;;(language (match-string 3 string))
- (value (match-string 4 string)))
- (mm-with-unibyte-buffer
- (insert value)
- (goto-char (point-min))
- (while (search-forward "%" nil t)
- (insert
- (prog1
- (string-to-number (buffer-substring (point) (+ (point) 2)) 16)
- (delete-region (1- (point)) (+ (point) 2)))))
- ;; Decode using the charset, if any.
- (if (memq coding-system '(nil ascii))
- (buffer-string)
- (mm-decode-coding-string (buffer-string) coding-system)))))
-
-(defun rfc2231-encode-string (param value)
- "Return and PARAM=VALUE string encoded according to RFC2231.
-Use `mml-insert-parameter' or `mml-insert-parameter-string' to insert
-the result of this function."
- (let ((control (ietf-drums-token-to-list ietf-drums-no-ws-ctl-token))
- (tspecial (ietf-drums-token-to-list ietf-drums-tspecials))
- (special (ietf-drums-token-to-list "*'%\n\t"))
- (ascii (ietf-drums-token-to-list ietf-drums-text-token))
- (num -1)
- ;; Don't make lines exceeding 76 column.
- (limit (- 74 (length param)))
- spacep encodep charsetp charset broken)
- (mm-with-multibyte-buffer
- (insert value)
- (goto-char (point-min))
- (while (not (eobp))
- (cond
- ((or (memq (following-char) control)
- (memq (following-char) tspecial)
- (memq (following-char) special))
- (setq encodep t))
- ((eq (following-char) ? )
- (setq spacep t))
- ((not (memq (following-char) ascii))
- (setq charsetp t)))
- (forward-char 1))
- (when charsetp
- (setq charset (mm-encode-body)))
- (mm-disable-multibyte)
- (cond
- ((or encodep charsetp
- (progn
- (end-of-line)
- (> (current-column) (if spacep (- limit 2) limit))))
- (setq limit (- limit 6))
- (goto-char (point-min))
- (insert (symbol-name (or charset 'us-ascii)) "''")
- (while (not (eobp))
- (if (or (not (memq (following-char) ascii))
- (memq (following-char) control)
- (memq (following-char) tspecial)
- (memq (following-char) special)
- (eq (following-char) ? ))
- (progn
- (when (>= (current-column) (1- limit))
- (insert ";\n")
- (setq broken t))
- (insert "%" (format "%02x" (following-char)))
- (delete-char 1))
- (when (> (current-column) limit)
- (insert ";\n")
- (setq broken t))
- (forward-char 1)))
- (goto-char (point-min))
- (if (not broken)
- (insert param "*=")
- (while (not (eobp))
- (insert (if (>= num 0) " " "")
- param "*" (format "%d" (incf num)) "*=")
- (forward-line 1))))
- (spacep
- (goto-char (point-min))
- (insert param "=\"")
- (goto-char (point-max))
- (insert "\""))
- (t
- (goto-char (point-min))
- (insert param "=")))
- (buffer-string))))
-
-(provide 'rfc2231)
-
-;;; arch-tag: c3ab751d-d108-406a-b301-68882ad8cd63
-;;; rfc2231.el ends here
+++ /dev/null
-;;; score-mode.el --- mode for editing Gnus score files
-
-;; Copyright (C) 1996, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: news, mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'mm-util) ; for mm-universal-coding-system
-(require 'gnus-util) ; for gnus-pp, gnus-run-mode-hooks
-
-(defvar gnus-score-mode-hook nil
- "*Hook run in score mode buffers.")
-
-(defvar gnus-score-menu-hook nil
- "*Hook run after creating the score mode menu.")
-
-(defvar gnus-score-edit-exit-function nil
- "Function run on exit from the score buffer.")
-
-(defvar gnus-score-mode-map nil)
-(unless gnus-score-mode-map
- (setq gnus-score-mode-map (make-sparse-keymap))
- (set-keymap-parent gnus-score-mode-map emacs-lisp-mode-map)
- (define-key gnus-score-mode-map "\C-c\C-c" 'gnus-score-edit-exit)
- (define-key gnus-score-mode-map "\C-c\C-d" 'gnus-score-edit-insert-date)
- (define-key gnus-score-mode-map "\C-c\C-p" 'gnus-score-pretty-print))
-
-(defvar score-mode-syntax-table
- (let ((table (copy-syntax-table lisp-mode-syntax-table)))
- (modify-syntax-entry ?| "w" table)
- table)
- "Syntax table used in score-mode buffers.")
-
-;; We need this to cope with non-ASCII scoring.
-(defvar score-mode-coding-system mm-universal-coding-system)
-
-;;;###autoload
-(defun gnus-score-mode ()
- "Mode for editing Gnus score files.
-This mode is an extended emacs-lisp mode.
-
-\\{gnus-score-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map gnus-score-mode-map)
- (gnus-score-make-menu-bar)
- (set-syntax-table score-mode-syntax-table)
- (setq major-mode 'gnus-score-mode)
- (setq mode-name "Score")
- (lisp-mode-variables nil)
- (make-local-variable 'gnus-score-edit-exit-function)
- (gnus-run-mode-hooks 'emacs-lisp-mode-hook 'gnus-score-mode-hook))
-
-(defun gnus-score-make-menu-bar ()
- (unless (boundp 'gnus-score-menu)
- (easy-menu-define
- gnus-score-menu gnus-score-mode-map ""
- '("Score"
- ["Exit" gnus-score-edit-exit t]
- ["Insert date" gnus-score-edit-insert-date t]
- ["Format" gnus-score-pretty-print t]))
- (run-hooks 'gnus-score-menu-hook)))
-
-(defun gnus-score-edit-insert-date ()
- "Insert date in numerical format."
- (interactive)
- (princ (time-to-days (current-time)) (current-buffer)))
-
-(defun gnus-score-pretty-print ()
- "Format the current score file."
- (interactive)
- (goto-char (point-min))
- (let ((form (read (current-buffer))))
- (erase-buffer)
- (let ((emacs-lisp-mode-syntax-table score-mode-syntax-table))
- (gnus-pp form)))
- (goto-char (point-min)))
-
-(defun gnus-score-edit-exit ()
- "Stop editing the score file."
- (interactive)
- (unless (file-exists-p (file-name-directory (buffer-file-name)))
- (make-directory (file-name-directory (buffer-file-name)) t))
- (let ((coding-system-for-write score-mode-coding-system))
- (save-buffer))
- (bury-buffer (current-buffer))
- (let ((buf (current-buffer)))
- (when gnus-score-edit-exit-function
- (funcall gnus-score-edit-exit-function))
- (when (eq buf (current-buffer))
- (switch-to-buffer (other-buffer (current-buffer))))))
-
-(provide 'score-mode)
-
-;;; arch-tag: a74a416b-2505-4ad4-bc4e-a418c96b8845
-;;; score-mode.el ends here
+++ /dev/null
-;;; smiley.el --- displaying smiley faces
-;; Copyright (C) 1996, 1997, 1998, 1999, 2000
-;; Free Software Foundation, Inc.
-
-;; Author: Wes Hardaker <hardaker@ece.ucdavis.edu>
-;; Keywords: fun
-
-;; 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:
-
-;;
-;; comments go here.
-;;
-
-;;; Test smileys: :-] :-o :-) ;-) :-\ :-| :-d :-P 8-| :-(
-
-;; To use:
-;; (require 'smiley)
-;; (setq gnus-treat-display-smileys t)
-
-;; The smilies were drawn by Joe Reiss <jreiss@vt.edu>.
-
-(require 'cl)
-(require 'custom)
-
-(eval-and-compile
- (when (featurep 'xemacs)
- (require 'annotations)
- (require 'messagexmas)))
-
-(defgroup smiley nil
- "Turn :-)'s into real images."
- :group 'gnus-visual)
-
-;; FIXME: Where is the directory when using Emacs?
-(defcustom smiley-data-directory
- (if (featurep 'xemacs)
- (message-xmas-find-glyph-directory "smilies")
- "/usr/local/lib/xemacs/xemacs-packages/etc/smilies")
- "*Location of the smiley faces files."
- :type 'directory
- :group 'smiley)
-
-;; Notice the subtle differences in the regular expressions in the
-;; two alists below.
-
-(defcustom smiley-deformed-regexp-alist
- '(("\\(\\^_?\\^;;;\\)\\W" 1 "WideFaceAse3.xbm")
- ("\\(\\^_?\\^;;\\)\\W" 1 "WideFaceAse2.xbm")
- ("\\(\\^_?\\^;\\)\\W" 1 "WideFaceAse1.xbm")
- ("\\(\\^_?\\^\\)\\W" 1 "WideFaceSmile.xbm")
- ("\\(;_;\\)\\W" 1 "WideFaceWeep.xbm")
- ("\\(T_T\\)\\W" 1 "WideFaceWeep.xbm")
- ("\\(:-*[<«]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-*D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-*[)>}»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(=[)»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-*[/\\\"]\\)[^/]\\W" 1 "FaceIronic.xpm")
- ("[^.0-9]\\([8|]-*[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
- ("\\([:|]-*#+\\)\\W" 1 "FaceNyah.xpm")
- ("\\(:-*[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(:-*[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
- ("\\(:-*|\\)\\W" 1 "FaceStraight.xpm")
- ("\\(:-*p\\)\\W" 1 "FaceTalking.xpm")
- ("\\(:-*d\\)\\W" 1 "FaceTasty.xpm")
- ("\\(;-*[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-*[Vvµ]\\)\\W" 1 "FaceWry.xpm")
- ("\\([:|]-*P\\)\\W" 1 "FaceYukky.xpm")
- ("\\(X-+)+\\)\\W" 1 "dead.xpm"))
- "*Normal and deformed faces for smilies."
- :type '(repeat (list regexp
- (integer :tag "Match")
- (string :tag "Image")))
- :group 'smiley)
-
-(defcustom smiley-nosey-regexp-alist
- '(("\\(:-+[<«]+\\)\\W" 1 "FaceAngry.xpm")
- ("\\(:-+\\]+\\)\\W" 1 "FaceGoofy.xpm")
- ("\\(:-+D\\)\\W" 1 "FaceGrinning.xpm")
- ("\\(:-+[}»]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-*)+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(=[)]+\\)\\W" 1 "FaceHappy.xpm")
- ("\\(:-+[/\\\"]+\\)\\W" 1 "FaceIronic.xpm")
- ("\\([8|]-+[|Oo%]\\)\\W" 1 "FaceKOed.xpm")
- ("\\([:|]-+#+\\)\\W" 1 "FaceNyah.xpm")
- ("\\(:-+[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(=[({]+\\)\\W" 1 "FaceSad.xpm")
- ("\\(:-+[Oo\*]\\)\\W" 1 "FaceStartled.xpm")
- ("\\(:-+|\\)\\W" 1 "FaceStraight.xpm")
- ("\\(:-+p\\)\\W" 1 "FaceTalking.xpm")
- ("\\(:-+d\\)\\W" 1 "FaceTasty.xpm")
- ("\\(;-+[>)}»]+\\)\\W" 1 "FaceWinking.xpm")
- ("\\(:-+[Vvµ]\\)\\W" 1 "FaceWry.xpm")
- ("\\(][:8B]-[)>]\\)\\W" 1 "FaceDevilish.xpm")
- ("\\([:|]-+P\\)\\W" 1 "FaceYukky.xpm")
- ("\\(X-+)+\\)\\W" 1 "dead.xpm"))
- "*Smileys with noses. These get less false matches."
- :type '(repeat (list regexp
- (integer :tag "Match")
- (string :tag "Image")))
- :group 'smiley)
-
-(defcustom smiley-regexp-alist smiley-deformed-regexp-alist
- "*A list of regexps to map smilies to real images.
-Defaults to the contents of `smiley-deformed-regexp-alist'.
-An alternative is `smiley-nosey-regexp-alist' that matches less
-aggressively.
-If this is a symbol, take its value."
- :type '(radio (variable-item smiley-deformed-regexp-alist)
- (variable-item smiley-nosey-regexp-alist)
- symbol
- (repeat (list regexp
- (integer :tag "Match")
- (string :tag "Image"))))
- :group 'smiley)
-
-(defcustom smiley-flesh-color "yellow"
- "*Flesh color."
- :type 'string
- :group 'smiley)
-
-(defcustom smiley-features-color "black"
- "*Features color."
- :type 'string
- :group 'smiley)
-
-(defcustom smiley-tongue-color "red"
- "*Tongue color."
- :type 'string
- :group 'smiley)
-
-(defcustom smiley-circle-color "black"
- "*Circle color."
- :type 'string
- :group 'smiley)
-
-(defcustom smiley-mouse-face 'highlight
- "*Face used for mouse highlighting in the smiley buffer.
-
-Smiley buttons will be displayed in this face when the cursor is
-above them."
- :type 'face
- :group 'smiley)
-
-(defvar smiley-glyph-cache nil)
-
-(defvar smiley-map (make-sparse-keymap "smiley-keys")
- "Keymap to toggle smiley states.")
-
-(define-key smiley-map [(button2)] 'smiley-toggle-extent)
-(define-key smiley-map [(button3)] 'smiley-popup-menu)
-
-(defun smiley-popup-menu (e)
- (interactive "e")
- (popup-menu
- `("Smilies"
- ["Toggle This Smiley" (smiley-toggle-extent ,e) t]
- ["Toggle All Smilies" (smiley-toggle-extents ,e) t])))
-
-(defun smiley-create-glyph (smiley pixmap)
- (or
- (cdr-safe (assoc pixmap smiley-glyph-cache))
- (let* ((xpm-color-symbols
- (and (featurep 'xpm)
- (append `(("flesh" ,smiley-flesh-color)
- ("features" ,smiley-features-color)
- ("tongue" ,smiley-tongue-color))
- xpm-color-symbols)))
- (glyph (make-glyph
- (list
- (cons (if (featurep 'gtk) 'gtk 'x)
- (expand-file-name pixmap smiley-data-directory))
- (cons 'mswindows
- (expand-file-name pixmap smiley-data-directory))
- (cons 'tty smiley)))))
- (setq smiley-glyph-cache (cons (cons pixmap glyph) smiley-glyph-cache))
- (set-glyph-face glyph 'default)
- glyph)))
-
-(defun smiley-create-glyph-ems (smiley pixmap)
- (condition-case e
- (create-image (expand-file-name pixmap smiley-data-directory))
- (error nil)))
-
-
-;;;###autoload
-(defun smiley-region (beg end)
- "Smilify the region between point and mark."
- (interactive "r")
- (smiley-buffer (current-buffer) beg end))
-
-(defun smiley-toggle-extent (event)
- "Toggle smiley at given point."
- (interactive "e")
- (let* ((ant (event-glyph-extent event))
- (pt (event-closest-point event))
- ext)
- (if (annotationp ant)
- (when (extentp (setq ext (extent-property ant 'smiley-extent)))
- (set-extent-property ext 'invisible nil)
- (hide-annotation ant))
- (when pt
- (while (setq ext (extent-at pt (event-buffer event) nil ext 'at))
- (when (annotationp (setq ant
- (extent-property ext 'smiley-annotation)))
- (reveal-annotation ant)
- (set-extent-property ext 'invisible t)))))))
-
-;; FIXME::
-(defun smiley-toggle-extent-ems (event)
- "Toggle smiley at given point.
-Note -- this function hasn't been implemented yet."
- (interactive "e")
- (error "This function hasn't been implemented yet.")
-)
-
-(defun smiley-toggle-extents (e)
- (interactive "e")
- (map-extents
- (lambda (e void)
- (let (ant)
- (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
- (if (eq (extent-property e 'invisible) nil)
- (progn
- (reveal-annotation ant)
- (set-extent-property e 'invisible t)
- )
- (hide-annotation ant)
- (set-extent-property e 'invisible nil)))
- nil))
- (event-buffer e)))
-
-;; FIXME::
-(defun smiley-toggle-extents-ems (e)
- (interactive "e")
- (error "This function hasn't been implemented yet.")
-)
-
-;;;###autoload
-(defun smiley-buffer (&optional buffer st nd)
- (interactive)
- (when (featurep '(or x gtk mswindows))
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (let ((buffer-read-only nil)
- (alist (if (symbolp smiley-regexp-alist)
- (symbol-value smiley-regexp-alist)
- smiley-regexp-alist))
- (case-fold-search nil)
- entry regexp beg group file)
- (map-extents
- (lambda (e void)
- (when (or (extent-property e 'smiley-extent)
- (extent-property e 'smiley-annotation))
- (delete-extent e)))
- buffer st nd)
- (goto-char (or st (point-min)))
- (setq beg (point))
- ;; loop through alist
- (while (setq entry (pop alist))
- (setq regexp (car entry)
- group (cadr entry)
- file (caddr entry))
- (goto-char beg)
- (while (re-search-forward regexp nd t)
- (let* ((start (match-beginning group))
- (end (match-end group))
- (glyph (smiley-create-glyph (buffer-substring start end)
- file)))
- (when glyph
- (mapcar 'delete-annotation (annotations-at end))
- (let ((ext (make-extent start end))
- (ant (make-annotation glyph end 'text)))
- ;; set text extent params
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'start-open t)
- (set-extent-property ext 'invisible t)
- (set-extent-property ext 'keymap smiley-map)
- (set-extent-property ext 'mouse-face smiley-mouse-face)
- (set-extent-property ext 'intangible t)
- ;; set annotation params
- (set-extent-property ant 'mouse-face smiley-mouse-face)
- (set-extent-property ant 'keymap smiley-map)
- ;; remember each other
- (set-extent-property ant 'smiley-extent ext)
- (set-extent-property ext 'smiley-annotation ant)
- ;; Help
- (set-extent-property
- ext 'help-echo
- "button2 toggles smiley, button3 pops up menu")
- (set-extent-property
- ant 'help-echo
- "button2 toggles smiley, button3 pops up menu")
- (set-extent-property ext 'balloon-help
- "Mouse button2 - toggle smiley
-Mouse button3 - menu")
- (set-extent-property ant 'balloon-help
- "Mouse button2 - toggle smiley
-Mouse button3 - menu"))
- (when (smiley-end-paren-p start end)
- (make-annotation ")" end 'text))
- (goto-char end)))))))))
-
-;; FIXME: No popup menu, no customized color
-(defun smiley-buffer-ems (&optional buffer st nd)
- (interactive)
- (when window-system
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (let ((buffer-read-only nil)
- (alist (if (symbolp smiley-regexp-alist)
- (symbol-value smiley-regexp-alist)
- smiley-regexp-alist))
- (case-fold-search nil)
- entry regexp beg group file)
- (dolist (overlay (overlays-in (or st (point-min))
- (or nd (point-max))))
- (when (overlay-get overlay 'smiley)
- (remove-text-properties (overlay-start overlay)
- (overlay-end overlay) '(display))
- (delete-overlay overlay)))
- (goto-char (or st (point-min)))
- (setq beg (point))
- ;; loop through alist
- (while (setq entry (pop alist))
- (setq regexp (car entry)
- group (cadr entry)
- file (caddr entry))
- (goto-char beg)
- (while (re-search-forward regexp nd t)
- (let* ((start (match-beginning group))
- (end (match-end group))
- (glyph (smiley-create-glyph nil file))
- (overlay (make-overlay start end)))
- (when glyph
- (add-text-properties start end
- `(display ,glyph))
- (overlay-put overlay 'smiley glyph)
- (goto-char end)))))))))
-
-(defun smiley-end-paren-p (start end)
- "Try to guess whether the current smiley is an end-paren smiley."
- (save-excursion
- (goto-char start)
- (when (and (re-search-backward "[()]" nil t)
- (eq (char-after) ?\()
- (goto-char end)
- (or (not (re-search-forward "[()]" nil t))
- (eq (char-after (1- (point))) ?\()))
- t)))
-
-(defun smiley-toggle-buffer (&optional arg buffer st nd)
- "Toggle displaying smiley faces.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
- (let (on off)
- (map-extents
- (lambda (e void)
- (let (ant)
- (if (annotationp (setq ant (extent-property e 'smiley-annotation)))
- (if (eq (extent-property e 'invisible) nil)
- (setq off (cons (cons ant e) off))
- (setq on (cons (cons ant e) on)))))
- nil)
- buffer st nd)
- (if (and (not (and (numberp arg) (< arg 0)))
- (or (and (numberp arg) (> arg 0))
- (null on)))
- (if off
- (while off
- (reveal-annotation (caar off))
- (set-extent-property (cdar off) 'invisible t)
- (setq off (cdr off)))
- (smiley-buffer))
- (while on
- (hide-annotation (caar on))
- (set-extent-property (cdar on) 'invisible nil)
- (setq on (cdr on))))))
-
-;; Simply removing all smiley if existing.
-;; FIXME: make it work as the one in XEmacs.
-(defun smiley-toggle-buffer-ems (&optional arg buffer st nd)
- "Toggle displaying smiley faces.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (let (found)
- (dolist (overlay (overlays-in (or st (point-min))
- (or nd (point-max))))
- (when (overlay-get overlay 'smiley)
- (remove-text-properties (overlay-start overlay)
- (overlay-end overlay) '(display))
- (setq found t)))
- (unless found
- (smiley-buffer buffer st nd)))))
-
-(unless (featurep 'xemacs)
- (defalias 'smiley-create-glyph 'smiley-create-glyph-ems)
- (defalias 'smiley-toggle-extent 'smiley-toggle-extent-ems)
- (defalias 'smiley-toggle-extents 'smiley-toggle-extents-ems)
- (defalias 'smiley-buffer 'smiley-buffer-ems)
- (defalias 'smiley-toggle-buffer 'smiley-toggle-buffer-ems))
-
-(defvar gnus-article-buffer)
-;;;###autoload
-(defun gnus-smiley-display (&optional arg)
- "Display \"smileys\" as small graphical icons.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
- (save-excursion
- (article-goto-body)
- (let (buffer-read-only)
- (smiley-toggle-buffer arg (current-buffer) (point) (point-max)))))
-
-(provide 'smiley)
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;;; smiley.el ends here
+++ /dev/null
-;;; smiley.el --- displaying smiley faces
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Dave Love <fx@gnu.org>
-;; Keywords: news mail multimedia
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; A re-written, simplified version of Wes Hardaker's XEmacs smiley.el
-;; which might be merged back to smiley.el if we get an assignment for
-;; that. We don't have assignments for the images smiley.el uses, but
-;; I'm not sure we need that degree of rococoness and defaults like a
-;; yellow background. Also, using PBM means we can display the images
-;; more generally. -- fx
-;; `smiley.el' was replaced by `smiley-ems.el' on 2002-01-26 (after fx'
-;; comment).
-
-;; Test smileys:
-;; smile ^:-) ^:)
-;; blink ;-) ;)
-;; forced :-]
-;; braindamaged 8-)
-;; indifferent :-|
-;; wry :-/ :-\
-;; sad :-(
-;; frown :-{
-;; evil >:-)
-;; cry ;-(
-;; dead X-)
-;; grin :-D
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-(require 'nnheader)
-(require 'gnus-art)
-
-(defgroup smiley nil
- "Turn :-)'s into real images."
- :group 'gnus-visual)
-
-;; Maybe this should go.
-(defcustom smiley-data-directory
- (nnheader-find-etc-directory "images/smilies")
- "Location of the smiley faces files."
- :type 'directory
- :group 'smiley)
-
-;; The XEmacs version has a baroque, if not rococo, set of these.
-(defcustom smiley-regexp-alist
- '(("\\(:-?)\\)\\W" 1 "smile")
- ("\\(;-?)\\)\\W" 1 "blink")
- ("\\(:-]\\)\\W" 1 "forced")
- ("\\(8-)\\)\\W" 1 "braindamaged")
- ("\\(:-|\\)\\W" 1 "indifferent")
- ("\\(:-[/\\]\\)\\W" 1 "wry")
- ("\\(:-(\\)\\W" 1 "sad")
- ("\\(X-)\\)\\W" 1 "dead")
- ("\\(:-{\\)\\W" 1 "frown"))
- "*A list of regexps to map smilies to images.
-The elements are (REGEXP MATCH IMAGE), where MATCH is the submatch in
-regexp to replace with IMAGE. IMAGE is the name of an image file in
-`smiley-data-directory'."
- :type '(repeat (list regexp
- (integer :tag "Regexp match number")
- (string :tag "Image name")))
- :set (lambda (symbol value)
- (set-default symbol value)
- (smiley-update-cache))
- :initialize 'custom-initialize-default
- :group 'smiley)
-
-(defcustom gnus-smiley-file-types
- (let ((types (list "pbm")))
- (when (gnus-image-type-available-p 'xpm)
- (push "xpm" types))
- types)
- "*List of suffixes on smiley file names to try."
- :version "22.1"
- :type '(repeat string)
- :group 'smiley)
-
-(defvar smiley-cached-regexp-alist nil)
-
-(defun smiley-update-cache ()
- (setq smiley-cached-regexp-alist nil)
- (dolist (elt (if (symbolp smiley-regexp-alist)
- (symbol-value smiley-regexp-alist)
- smiley-regexp-alist))
- (let ((types gnus-smiley-file-types)
- file type)
- (while (and (not file)
- (setq type (pop types)))
- (unless (file-exists-p
- (setq file (expand-file-name (concat (nth 2 elt) "." type)
- smiley-data-directory)))
- (setq file nil)))
- (when type
- (let ((image (gnus-create-image file (intern type) nil
- :ascent 'center)))
- (when image
- (push (list (car elt) (cadr elt) image)
- smiley-cached-regexp-alist)))))))
-
-;; Not implemented:
-;; (defvar smiley-mouse-map
-;; (let ((map (make-sparse-keymap)))
-;; (define-key map [down-mouse-2] 'ignore) ; override widget
-;; (define-key map [mouse-2]
-;; 'smiley-mouse-toggle-buffer)
-;; map))
-
-;;;###autoload
-(defun smiley-region (start end)
- "Replace in the region `smiley-regexp-alist' matches with corresponding images.
-A list of images is returned."
- (interactive "r")
- (when (gnus-graphic-display-p)
- (unless smiley-cached-regexp-alist
- (smiley-update-cache))
- (save-excursion
- (let ((beg (or start (point-min)))
- group image images string)
- (dolist (entry smiley-cached-regexp-alist)
- (setq group (nth 1 entry)
- image (nth 2 entry))
- (goto-char beg)
- (while (re-search-forward (car entry) end t)
- (setq string (match-string group))
- (goto-char (match-end group))
- (delete-region (match-beginning group) (match-end group))
- (when image
- (push image images)
- (gnus-add-wash-type 'smiley)
- (gnus-add-image 'smiley image)
- (gnus-put-image image string 'smiley))))
- images))))
-
-;;;###autoload
-(defun smiley-buffer (&optional buffer)
- "Run `smiley-region' at the buffer, specified in the argument or
-interactively. If there's no argument, do it at the current buffer"
- (interactive "bBuffer to run smiley-region: ")
- (save-excursion
- (if buffer
- (set-buffer (get-buffer buffer)))
- (smiley-region (point-min) (point-max))))
-
-(defun smiley-toggle-buffer (&optional arg)
- "Toggle displaying smiley faces in article buffer.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "P")
- (gnus-with-article-buffer
- (if (if (numberp arg)
- (> arg 0)
- (not (memq 'smiley gnus-article-wash-types)))
- (smiley-region (point-min) (point-max))
- (gnus-delete-images 'smiley))))
-
-(defun smiley-mouse-toggle-buffer (event)
- "Toggle displaying smiley faces.
-With arg, turn displaying on if and only if arg is positive."
- (interactive "e")
- (save-excursion
- (save-window-excursion
- (mouse-set-point event)
- (smiley-toggle-buffer))))
-
-(provide 'smiley)
-
-;;; arch-tag: 5beb161b-4321-40af-8ac9-876afb8ee818
-;;; smiley.el ends here
+++ /dev/null
-;;; smime.el --- S/MIME support library
-
-;; Copyright (C) 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Simon Josefsson <simon@josefsson.org>
-;; Keywords: SMIME X.509 PEM OpenSSL
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This library perform S/MIME operations from within Emacs.
-;;
-;; Functions for fetching certificates from public repositories are
-;; provided, currently only from DNS. LDAP support (via EUDC) is planned.
-;;
-;; It uses OpenSSL (tested with version 0.9.5a and 0.9.6) for signing,
-;; encryption and decryption.
-;;
-;; Some general knowledge of S/MIME, X.509, PKCS#12, PEM etc is
-;; probably required to use this library in any useful way.
-;; Especially, don't expect this library to buy security for you. If
-;; you don't understand what you are doing, you're as likely to lose
-;; security than gain any by using this library.
-;;
-;; This library is not intended to provide a "raw" API for S/MIME,
-;; PKCSx or similar, it's intended to perform common operations
-;; done on messages encoded in these formats. The terminology chosen
-;; reflect this.
-;;
-;; The home of this file is in Gnus CVS, but also available from
-;; http://josefsson.org/smime.html.
-
-;;; Quick introduction:
-
-;; Get your S/MIME certificate from VeriSign or someplace. I used
-;; Netscape to generate the key and certificate request and stuff, and
-;; Netscape can export the key into PKCS#12 format.
-;;
-;; Enter OpenSSL. To be able to use this library, it need to have the
-;; SMIME key readable in PEM format. OpenSSL is used to convert the
-;; key:
-;;
-;; $ openssl pkcs12 -in mykey.p12 -clcerts -nodes > mykey.pem
-;; ...
-;;
-;; Now, use M-x customize-variable smime-keys and add mykey.pem as
-;; a key.
-;;
-;; Now you should be able to sign messages! Create a buffer and write
-;; something and run M-x smime-sign-buffer RET RET and you should see
-;; your message MIME armoured and a signature. Encryption, M-x
-;; smime-encrypt-buffer, should also work.
-;;
-;; To be able to verify messages you need to build up trust with
-;; someone. Perhaps you trust the CA that issued your certificate, at
-;; least I did, so I export it's certificates from my PKCS#12
-;; certificate with:
-;;
-;; $ openssl pkcs12 -in mykey.p12 -cacerts -nodes > cacert.pem
-;; ...
-;;
-;; Now, use M-x customize-variable smime-CAs and add cacert.pem as a
-;; CA certificate.
-;;
-;; You should now be able to sign messages, and even verify messages
-;; sent by others that use the same CA as you.
-
-;; Bugs:
-;;
-;; Don't complain that this package doesn't do encrypted PEM files,
-;; submit a patch instead. I store my keys in a safe place, so I
-;; didn't need the encryption. Also, programming was made easier by
-;; that decision. One might think that this even influenced were I
-;; store my keys, and one would probably be right. :-)
-;;
-;; Update: Mathias Herberts sent the patch. However, it uses
-;; environment variables to pass the password to OpenSSL, which is
-;; slightly insecure. Hence a new todo: use a better -passin method.
-;;
-;; Cache password for e.g. 1h
-;;
-;; Suggestions and comments are appreciated, mail me at simon@josefsson.org.
-
-;; begin rant
-;;
-;; I would include pointers to introductory text on concepts used in
-;; this library here, but the material I've read are so horrible I
-;; don't want to recomend them.
-;;
-;; Why can't someone write a simple introduction to all this stuff?
-;; Until then, much of this resemble security by obscurity.
-;;
-;; Also, I'm not going to mention anything about the wonders of
-;; cryptopolitics. Oops, I just did.
-;;
-;; end rant
-
-;;; Revision history:
-
-;; 2000-06-05 initial version, committed to Gnus CVS contrib/
-;; 2000-10-28 retrieve certificates via DNS CERT RRs
-;; 2001-10-14 posted to gnu.emacs.sources
-
-;;; Code:
-
-(require 'dig)
-(eval-when-compile (require 'cl))
-
-(defgroup smime nil
- "S/MIME configuration."
- :group 'mime)
-
-(defcustom smime-keys nil
- "*Map mail addresses to a file containing Certificate (and private key).
-The file is assumed to be in PEM format. You can also associate additional
-certificates to be sent with every message to each address."
- :type '(repeat (list (string :tag "Mail address")
- (file :tag "File name")
- (repeat :tag "Additional certificate files"
- (file :tag "File name"))))
- :group 'smime)
-
-(defcustom smime-CA-directory nil
- "*Directory containing certificates for CAs you trust.
-Directory should contain files (in PEM format) named to the X.509
-hash of the certificate. This can be done using OpenSSL such as:
-
-$ ln -s ca.pem `openssl x509 -noout -hash -in ca.pem`.0
-
-where `ca.pem' is the file containing a PEM encoded X.509 CA
-certificate."
- :type '(choice (const :tag "none" nil)
- directory)
- :group 'smime)
-
-(defcustom smime-CA-file nil
- "*Files containing certificates for CAs you trust.
-File should contain certificates in PEM format."
- :version "22.1"
- :type '(choice (const :tag "none" nil)
- file)
- :group 'smime)
-
-(defcustom smime-certificate-directory "~/Mail/certs/"
- "*Directory containing other people's certificates.
-It should contain files named to the X.509 hash of the certificate,
-and the files themself should be in PEM format."
-;The S/MIME library provide simple functionality for fetching
-;certificates into this directory, so there is no need to populate it
-;manually.
- :type 'directory
- :group 'smime)
-
-(defcustom smime-openssl-program
- (and (condition-case ()
- (eq 0 (call-process "openssl" nil nil nil "version"))
- (error nil))
- "openssl")
- "*Name of OpenSSL binary."
- :type 'string
- :group 'smime)
-
-;; OpenSSL option to select the encryption cipher
-
-(defcustom smime-encrypt-cipher "-des3"
- "*Cipher algorithm used for encryption."
- :version "22.1"
- :type '(choice (const :tag "Triple DES" "-des3")
- (const :tag "DES" "-des")
- (const :tag "RC2 40 bits" "-rc2-40")
- (const :tag "RC2 64 bits" "-rc2-64")
- (const :tag "RC2 128 bits" "-rc2-128"))
- :group 'smime)
-
-(defcustom smime-crl-check nil
- "*Check revocation status of signers certificate using CRLs.
-Enabling this will have OpenSSL check the signers certificate
-against a certificate revocation list (CRL).
-
-For this to work the CRL must be up-to-date and since they are
-normally updated quite often (ie. several times a day) you
-probably need some tool to keep them up-to-date. Unfortunately
-Gnus cannot do this for you.
-
-The CRL should either be appended (in PEM format) to your
-`smime-CA-file' or be located in a file (also in PEM format) in
-your `smime-certificate-directory' named to the X.509 hash of the
-certificate with .r0 as file name extension.
-
-At least OpenSSL version 0.9.7 is required for this to work."
- :type '(choice (const :tag "No check" nil)
- (const :tag "Check certificate" "-crl_check")
- (const :tag "Check certificate chain" "-crl_check_all"))
- :group 'smime)
-
-(defcustom smime-dns-server nil
- "*DNS server to query certificates from.
-If nil, use system defaults."
- :version "22.1"
- :type '(choice (const :tag "System defaults")
- string)
- :group 'smime)
-
-(defvar smime-details-buffer "*OpenSSL output*")
-
-;; Use mm-util?
-(eval-and-compile
- (defalias 'smime-make-temp-file
- (if (fboundp 'make-temp-file)
- 'make-temp-file
- (lambda (prefix &optional dir-flag) ;; Simple implementation
- (expand-file-name
- (make-temp-name prefix)
- (if (fboundp 'temp-directory)
- (temp-directory)
- temporary-file-directory))))))
-
-;; Password dialog function
-
-(defun smime-ask-passphrase ()
- "Asks the passphrase to unlock the secret key."
- (let ((passphrase
- (read-passwd
- "Passphrase for secret key (RET for no passphrase): ")))
- (if (string= passphrase "")
- nil
- passphrase)))
-
-;; OpenSSL wrappers.
-
-(defun smime-call-openssl-region (b e buf &rest args)
- (case (apply 'call-process-region b e smime-openssl-program nil buf nil args)
- (0 t)
- (1 (message "OpenSSL: An error occurred parsing the command options.") nil)
- (2 (message "OpenSSL: One of the input files could not be read.") nil)
- (3 (message "OpenSSL: An error occurred creating the PKCS#7 file or when reading the MIME message.") nil)
- (4 (message "OpenSSL: An error occurred decrypting or verifying the message.") nil)
- (t (error "Unknown OpenSSL exitcode") nil)))
-
-(defun smime-make-certfiles (certfiles)
- (if certfiles
- (append (list "-certfile" (expand-file-name (car certfiles)))
- (smime-make-certfiles (cdr certfiles)))))
-
-;; Sign+encrypt region
-
-(defun smime-sign-region (b e keyfile)
- "Sign region with certified key in KEYFILE.
-If signing fails, the buffer is not modified. Region is assumed to
-have proper MIME tags. KEYFILE is expected to contain a PEM encoded
-private key and certificate as its car, and a list of additional
-certificates to include in its caar. If no additional certificates is
-included, KEYFILE may be the file containing the PEM encoded private
-key and certificate itself."
- (smime-new-details-buffer)
- (let ((keyfile (or (car-safe keyfile) keyfile))
- (certfiles (and (cdr-safe keyfile) (cadr keyfile)))
- (buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
- (passphrase (smime-ask-passphrase))
- (tmpfile (smime-make-temp-file "smime")))
- (if passphrase
- (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
- (prog1
- (when (prog1
- (apply 'smime-call-openssl-region b e (list buffer tmpfile)
- "smime" "-sign" "-signer" (expand-file-name keyfile)
- (append
- (smime-make-certfiles certfiles)
- (if passphrase
- (list "-passin" "env:GNUS_SMIME_PASSPHRASE"))))
- (if passphrase
- (setenv "GNUS_SMIME_PASSPHRASE" "" t))
- (with-current-buffer smime-details-buffer
- (insert-file-contents tmpfile)
- (delete-file tmpfile)))
- (delete-region b e)
- (insert-buffer-substring buffer)
- (goto-char b)
- (when (looking-at "^MIME-Version: 1.0$")
- (delete-region (point) (progn (forward-line 1) (point))))
- t)
- (with-current-buffer smime-details-buffer
- (goto-char (point-max))
- (insert-buffer-substring buffer))
- (kill-buffer buffer))))
-
-(defun smime-encrypt-region (b e certfiles)
- "Encrypt region for recipients specified in CERTFILES.
-If encryption fails, the buffer is not modified. Region is assumed to
-have proper MIME tags. CERTFILES is a list of filenames, each file
-is expected to contain of a PEM encoded certificate."
- (smime-new-details-buffer)
- (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
- (tmpfile (smime-make-temp-file "smime")))
- (prog1
- (when (prog1
- (apply 'smime-call-openssl-region b e (list buffer tmpfile)
- "smime" "-encrypt" smime-encrypt-cipher
- (mapcar 'expand-file-name certfiles))
- (with-current-buffer smime-details-buffer
- (insert-file-contents tmpfile)
- (delete-file tmpfile)))
- (delete-region b e)
- (insert-buffer-substring buffer)
- (goto-char b)
- (when (looking-at "^MIME-Version: 1.0$")
- (delete-region (point) (progn (forward-line 1) (point))))
- t)
- (with-current-buffer smime-details-buffer
- (goto-char (point-max))
- (insert-buffer-substring buffer))
- (kill-buffer buffer))))
-
-;; Sign+encrypt buffer
-
-(defun smime-sign-buffer (&optional keyfile buffer)
- "S/MIME sign BUFFER with key in KEYFILE.
-KEYFILE should contain a PEM encoded key and certificate."
- (interactive)
- (with-current-buffer (or buffer (current-buffer))
- (unless (smime-sign-region
- (point-min) (point-max)
- (if keyfile
- keyfile
- (smime-get-key-with-certs-by-email
- (completing-read
- (concat "Sign using key"
- (if smime-keys
- (concat " (default " (caar smime-keys) "): ")
- ": "))
- smime-keys nil nil (car-safe (car-safe smime-keys))))))
- (error "Signing failed"))))
-
-(defun smime-encrypt-buffer (&optional certfiles buffer)
- "S/MIME encrypt BUFFER for recipients specified in CERTFILES.
-CERTFILES is a list of filenames, each file is expected to consist of
-a PEM encoded key and certificate. Uses current buffer if BUFFER is
-nil."
- (interactive)
- (with-current-buffer (or buffer (current-buffer))
- (unless (smime-encrypt-region
- (point-min) (point-max)
- (or certfiles
- (list (read-file-name "Recipient's S/MIME certificate: "
- smime-certificate-directory nil))))
- (error "Encryption failed"))))
-
-;; Verify+decrypt region
-
-(defun smime-verify-region (b e)
- "Verify S/MIME message in region between B and E.
-Returns non-nil on success.
-Any details (stdout and stderr) are left in the buffer specified by
-`smime-details-buffer'."
- (smime-new-details-buffer)
- (let ((CAs (append (if smime-CA-file
- (list "-CAfile"
- (expand-file-name smime-CA-file)))
- (if smime-CA-directory
- (list "-CApath"
- (expand-file-name smime-CA-directory))))))
- (unless CAs
- (error "No CA configured"))
- (if smime-crl-check
- (add-to-list 'CAs smime-crl-check))
- (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
- "smime" "-verify" "-out" "/dev/null" CAs)
- t
- (insert-buffer-substring smime-details-buffer)
- nil)))
-
-(defun smime-noverify-region (b e)
- "Verify integrity of S/MIME message in region between B and E.
-Returns non-nil on success.
-Any details (stdout and stderr) are left in the buffer specified by
-`smime-details-buffer'."
- (smime-new-details-buffer)
- (if (apply 'smime-call-openssl-region b e (list smime-details-buffer t)
- "smime" "-verify" "-noverify" "-out" '("/dev/null"))
- t
- (insert-buffer-substring smime-details-buffer)
- nil))
-
-(eval-when-compile
- (defvar from))
-
-(defun smime-decrypt-region (b e keyfile)
- "Decrypt S/MIME message in region between B and E with key in KEYFILE.
-On success, replaces region with decrypted data and return non-nil.
-Any details (stderr on success, stdout and stderr on error) are left
-in the buffer specified by `smime-details-buffer'."
- (smime-new-details-buffer)
- (let ((buffer (generate-new-buffer (generate-new-buffer-name " *smime*")))
- CAs (passphrase (smime-ask-passphrase))
- (tmpfile (smime-make-temp-file "smime")))
- (if passphrase
- (setenv "GNUS_SMIME_PASSPHRASE" passphrase))
- (if (prog1
- (apply 'smime-call-openssl-region b e
- (list buffer tmpfile)
- "smime" "-decrypt" "-recip" (expand-file-name keyfile)
- (if passphrase
- (list "-passin" "env:GNUS_SMIME_PASSPHRASE")))
- (if passphrase
- (setenv "GNUS_SMIME_PASSPHRASE" "" t))
- (with-current-buffer smime-details-buffer
- (insert-file-contents tmpfile)
- (delete-file tmpfile)))
- (progn
- (delete-region b e)
- (when (boundp 'from)
- ;; `from' is dynamically bound in mm-dissect.
- (insert "From: " from "\n"))
- (insert-buffer-substring buffer)
- (kill-buffer buffer)
- t)
- (with-current-buffer smime-details-buffer
- (insert-buffer-substring buffer))
- (kill-buffer buffer)
- (delete-region b e)
- (insert-buffer-substring smime-details-buffer)
- nil)))
-
-;; Verify+Decrypt buffer
-
-(defun smime-verify-buffer (&optional buffer)
- "Verify integrity of S/MIME message in BUFFER.
-Uses current buffer if BUFFER is nil. Returns non-nil on success.
-Any details (stdout and stderr) are left in the buffer specified by
-`smime-details-buffer'."
- (interactive)
- (with-current-buffer (or buffer (current-buffer))
- (smime-verify-region (point-min) (point-max))))
-
-(defun smime-noverify-buffer (&optional buffer)
- "Verify integrity of S/MIME message in BUFFER.
-Does NOT verify validity of certificate (only message integrity).
-Uses current buffer if BUFFER is nil. Returns non-nil on success.
-Any details (stdout and stderr) are left in the buffer specified by
-`smime-details-buffer'."
- (interactive)
- (with-current-buffer (or buffer (current-buffer))
- (smime-noverify-region (point-min) (point-max))))
-
-(defun smime-decrypt-buffer (&optional buffer keyfile)
- "Decrypt S/MIME message in BUFFER using KEYFILE.
-Uses current buffer if BUFFER is nil, and query user of KEYFILE if it's nil.
-On success, replaces data in buffer and return non-nil.
-Any details (stderr on success, stdout and stderr on error) are left
-in the buffer specified by `smime-details-buffer'."
- (interactive)
- (with-current-buffer (or buffer (current-buffer))
- (smime-decrypt-region
- (point-min) (point-max)
- (expand-file-name
- (or keyfile
- (smime-get-key-by-email
- (completing-read
- (concat "Decipher using key"
- (if smime-keys (concat " (default " (caar smime-keys) "): ")
- ": "))
- smime-keys nil nil (car-safe (car-safe smime-keys)))))))))
-
-;; Various operations
-
-(defun smime-new-details-buffer ()
- (with-current-buffer (get-buffer-create smime-details-buffer)
- (erase-buffer)))
-
-(defun smime-pkcs7-region (b e)
- "Convert S/MIME message between points B and E into a PKCS7 message."
- (smime-new-details-buffer)
- (when (smime-call-openssl-region b e smime-details-buffer "smime" "-pk7out")
- (delete-region b e)
- (insert-buffer-substring smime-details-buffer)
- t))
-
-(defun smime-pkcs7-certificates-region (b e)
- "Extract any certificates enclosed in PKCS7 message between points B and E."
- (smime-new-details-buffer)
- (when (smime-call-openssl-region
- b e smime-details-buffer "pkcs7" "-print_certs" "-text")
- (delete-region b e)
- (insert-buffer-substring smime-details-buffer)
- t))
-
-(defun smime-pkcs7-email-region (b e)
- "Get email addresses contained in certificate between points B and E.
-A string or a list of strings is returned."
- (smime-new-details-buffer)
- (when (smime-call-openssl-region
- b e smime-details-buffer "x509" "-email" "-noout")
- (delete-region b e)
- (insert-buffer-substring smime-details-buffer)
- t))
-
-;; Utility functions
-
-(defun smime-get-certfiles (keyfile keys)
- (if keys
- (let ((curkey (car keys))
- (otherkeys (cdr keys)))
- (if (string= keyfile (cadr curkey))
- (caddr curkey)
- (smime-get-certfiles keyfile otherkeys)))))
-
-;; Use mm-util?
-(eval-and-compile
- (defalias 'smime-point-at-eol
- (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
-(defun smime-buffer-as-string-region (b e)
- "Return each line in region between B and E as a list of strings."
- (save-excursion
- (goto-char b)
- (let (res)
- (while (< (point) e)
- (let ((str (buffer-substring (point) (smime-point-at-eol))))
- (unless (string= "" str)
- (push str res)))
- (forward-line))
- res)))
-
-;; Find certificates
-
-(defun smime-mail-to-domain (mailaddr)
- (if (string-match "@" mailaddr)
- (replace-match "." 'fixedcase 'literal mailaddr)
- mailaddr))
-
-(defun smime-cert-by-dns (mail)
- (let* ((dig-dns-server smime-dns-server)
- (digbuf (dig-invoke (smime-mail-to-domain mail) "cert" nil nil "+vc"))
- (retbuf (generate-new-buffer (format "*certificate for %s*" mail)))
- (certrr (with-current-buffer digbuf
- (dig-extract-rr (smime-mail-to-domain mail) "cert")))
- (cert (and certrr (dig-rr-get-pkix-cert certrr))))
- (if cert
- (with-current-buffer retbuf
- (insert "-----BEGIN CERTIFICATE-----\n")
- (let ((i 0) (len (length cert)))
- (while (> (- len 64) i)
- (insert (substring cert i (+ i 64)) "\n")
- (setq i (+ i 64)))
- (insert (substring cert i len) "\n"))
- (insert "-----END CERTIFICATE-----\n"))
- (kill-buffer retbuf)
- (setq retbuf nil))
- (kill-buffer digbuf)
- retbuf))
-
-;; User interface.
-
-(defvar smime-buffer "*SMIME*")
-
-(defvar smime-mode-map nil)
-(put 'smime-mode 'mode-class 'special)
-
-(unless smime-mode-map
- (setq smime-mode-map (make-sparse-keymap))
- (suppress-keymap smime-mode-map)
-
- (define-key smime-mode-map "q" 'smime-exit)
- (define-key smime-mode-map "f" 'smime-certificate-info))
-
-(defun smime-mode ()
- "Major mode for browsing, viewing and fetching certificates.
-
-All normal editing commands are switched off.
-\\<smime-mode-map>
-
-The following commands are available:
-
-\\{smime-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (setq major-mode 'smime-mode)
- (setq mode-name "SMIME")
- (setq mode-line-process nil)
- (use-local-map smime-mode-map)
- (buffer-disable-undo)
- (setq truncate-lines t)
- (setq buffer-read-only t)
- (gnus-run-mode-hooks 'smime-mode-hook))
-
-(defun smime-certificate-info (certfile)
- (interactive "fCertificate file: ")
- (let ((buffer (get-buffer-create (format "*certificate %s*" certfile))))
- (switch-to-buffer buffer)
- (erase-buffer)
- (call-process smime-openssl-program nil buffer 'display
- "x509" "-in" (expand-file-name certfile) "-text")
- (fundamental-mode)
- (set-buffer-modified-p nil)
- (toggle-read-only t)
- (goto-char (point-min))))
-
-(defun smime-draw-buffer ()
- (with-current-buffer smime-buffer
- (let (buffer-read-only)
- (erase-buffer)
- (insert "\nYour keys:\n")
- (dolist (key smime-keys)
- (insert
- (format "\t\t%s: %s\n" (car key) (cadr key))))
- (insert "\nTrusted Certificate Authoritys:\n")
- (insert "\nKnown Certificates:\n"))))
-
-(defun smime ()
- "Go to the SMIME buffer."
- (interactive)
- (unless (get-buffer smime-buffer)
- (save-excursion
- (set-buffer (get-buffer-create smime-buffer))
- (smime-mode)))
- (smime-draw-buffer)
- (switch-to-buffer smime-buffer))
-
-(defun smime-exit ()
- "Quit the S/MIME buffer."
- (interactive)
- (kill-buffer (current-buffer)))
-
-;; Other functions
-
-(defun smime-get-key-by-email (email)
- (cadr (assoc email smime-keys)))
-
-(defun smime-get-key-with-certs-by-email (email)
- (cdr (assoc email smime-keys)))
-
-(provide 'smime)
-
-;;; arch-tag: e3f9b938-5085-4510-8a11-6625269c9a9e
-;;; smime.el ends here
+++ /dev/null
-;;; spam-report.el --- Reporting spam
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Teodor Zlatanov <tzz@lifelogs.com>
-;; Keywords: network
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This module addresses a few aspects of spam reporting under Gnus. Page
-;;; breaks are used for grouping declarations and documentation relating to
-;;; each particular aspect.
-
-;;; Code:
-(require 'gnus)
-(require 'gnus-sum)
-
-(eval-and-compile
- (autoload 'mm-url-insert "mm-url"))
-
-(defgroup spam-report nil
- "Spam reporting configuration."
- :group 'mail
- :group 'news)
-
-(defcustom spam-report-gmane-regex nil
- "Regexp matching Gmane newsgroups, e.g. \"^nntp\\+.*:gmane\\.\"
-If you are using spam.el, consider setting gnus-spam-process-newsgroups
-or the gnus-group-spam-exit-processor-report-gmane group/topic parameter
-instead."
- :type '(radio (const nil)
- (regexp :value "^nntp\+.*:gmane\."))
- :group 'spam-report)
-
-(defcustom spam-report-gmane-use-article-number t
- "Whether the article number (faster!) or the header should be used.
-
-You must set this to nil if you don't read Gmane groups directly
-from news.gmane.org, e.g. when using local newsserver such as
-leafnode."
- :type 'boolean
- :group 'spam-report)
-
-(defcustom spam-report-url-ping-function
- 'spam-report-url-ping-plain
- "Function to use for url ping spam reporting.
-The function must accept the arguments `host' and `report'."
- :type '(choice
- (const :tag "Connect directly"
- spam-report-url-ping-plain)
- (const :tag "Use the external program specified in `mm-url-program'"
- spam-report-url-ping-mm-url)
- (const :tag "Store request URLs in `spam-report-requests-file'"
- spam-report-url-to-file)
- (function :tag "User defined function" nil))
- :group 'spam-report)
-
-(defcustom spam-report-requests-file
- (nnheader-concat gnus-directory "spam/" "spam-report-requests.url")
- ;; Is there a convention for the extension of such a file?
- ;; Should we use `spam-directory'?
- "File where spam report request are stored."
- :type 'file
- :group 'spam-report)
-
-(defvar spam-report-url-ping-temp-agent-function nil
- "Internal variable for `spam-report-agentize' and `spam-report-deagentize'.
-This variable will store the value of `spam-report-url-ping-function' from
-before `spam-report-agentize' was run, so that `spam-report-deagentize' can
-undo that change.")
-
-(defun spam-report-gmane (&rest articles)
- "Report an article as spam through Gmane"
- (dolist (article articles)
- (when (and gnus-newsgroup-name
- (or (null spam-report-gmane-regex)
- (string-match spam-report-gmane-regex gnus-newsgroup-name)))
- (gnus-message 6 "Reporting spam article %d to spam.gmane.org..." article)
- (if spam-report-gmane-use-article-number
- (spam-report-url-ping
- "spam.gmane.org"
- (format "/%s:%d"
- (gnus-group-real-name gnus-newsgroup-name)
- article))
- (with-current-buffer nntp-server-buffer
- (gnus-request-head article gnus-newsgroup-name)
- (let ((case-fold-search t)
- field host report url)
- ;; First check for X-Report-Spam because it's more specific to
- ;; spam reporting than Archived-At. OTOH, all new articles on
- ;; Gmane don't have X-Report-Spam anymore (unless Lars changes his
- ;; mind :-)).
- ;;
- ;; There might be more than one Archived-At header so we need to
- ;; find (and transform) the one related to Gmane.
- (setq field (or (gnus-fetch-field "X-Report-Spam")
- (gnus-fetch-field "Archived-At")))
- (setq host (progn
- (string-match
- (concat "http://\\([a-z]+\\.gmane\\.org\\)"
- "\\(/[^:/]+[:/][0-9]+\\)")
- field)
- (match-string 1 field)))
- (setq report (match-string 2 field))
- (when (string-equal "permalink.gmane.org" host)
- (setq host "spam.gmane.org")
- (setq report (gnus-replace-in-string
- report "/\\([0-9]+\\)$" ":\\1")))
- (setq url (format "http://%s%s" host report))
- (if (not (and host report url))
- (gnus-message
- 3 "Could not find a spam report header in article %d..."
- article)
- (gnus-message 7 "Reporting spam through URL %s..." url)
- (spam-report-url-ping host report))))))))
-
-(defun spam-report-url-ping (host report)
- "Ping a host through HTTP, addressing a specific GET resource using
-the function specified by `spam-report-url-ping-function'."
- ;; Example:
- ;; host: "spam.gmane.org"
- ;; report: "/gmane.some.group:123456"
- (funcall spam-report-url-ping-function host report))
-
-(defun spam-report-url-ping-plain (host report)
- "Ping a host through HTTP, addressing a specific GET resource."
- (let ((tcp-connection))
- (with-temp-buffer
- (or (setq tcp-connection
- (open-network-stream
- "URL ping"
- (buffer-name)
- host
- 80))
- (error "Could not open connection to %s" host))
- (set-marker (process-mark tcp-connection) (point-min))
- (process-send-string
- tcp-connection
- (format "GET %s HTTP/1.1\nUser-Agent: %s (spam-report.el)\nHost: %s\n\n"
- report (gnus-extended-version) host)))))
-
-;;;###autoload
-(defun spam-report-process-queue (&optional file keep)
- "Report all queued requests from `spam-report-requests-file'.
-
-If FILE is given, use it instead of `spam-report-requests-file'.
-If KEEP is t, leave old requests in the file. If KEEP is the
-symbol `ask', query before flushing the queue file."
- (interactive
- (list (read-file-name
- "File: "
- (file-name-directory spam-report-requests-file)
- spam-report-requests-file
- nil
- (file-name-nondirectory spam-report-requests-file))
- current-prefix-arg))
- (if (eq spam-report-url-ping-function 'spam-report-url-to-file)
- (error (concat "Cannot process requests when "
- "`spam-report-url-ping-function' is "
- "`spam-report-url-to-file'."))
- (gnus-message 7 "Processing requests using `%s'."
- spam-report-url-ping-function))
- (or file (setq file spam-report-requests-file))
- (save-excursion
- (set-buffer (find-file-noselect file))
- (goto-char (point-min))
- (while (and (not (eobp))
- (re-search-forward
- "http://\\([^/]+\\)\\(/.*\\) *$" (gnus-point-at-eol) t))
- (funcall spam-report-url-ping-function (match-string 1) (match-string 2))
- (forward-line 1))
- (if (or (eq keep nil)
- (and (eq keep 'ask)
- (y-or-n-p
- (format
- "Flush requests from `%s'? " (current-buffer)))))
- (progn
- (gnus-message 7 "Flushing request file `%s'"
- spam-report-requests-file)
- (erase-buffer)
- (save-buffer)
- (kill-buffer (current-buffer)))
- (gnus-message 7 "Keeping requests in `%s'" spam-report-requests-file))))
-
-;;;###autoload
-(defun spam-report-url-ping-mm-url (host report)
- "Ping a host through HTTP, addressing a specific GET resource. Use
-the external program specified in `mm-url-program' to connect to
-server."
- (with-temp-buffer
- (let ((url (format "http://%s%s" host report)))
- (mm-url-insert url t))))
-
-;;;###autoload
-(defun spam-report-url-to-file (host report)
- "Collect spam report requests in `spam-report-requests-file'.
-Customize `spam-report-url-ping-function' to use this function."
- (let ((url (format "http://%s%s" host report))
- (file spam-report-requests-file))
- (gnus-make-directory (file-name-directory file))
- (gnus-message 9 "Writing URL `%s' to file `%s'" url file)
- (with-temp-buffer
- (insert url)
- (newline)
- (append-to-file (point-min) (point-max) file))))
-
-;;;###autoload
-(defun spam-report-agentize ()
- "Add spam-report support to the Agent.
-Spam reports will be queued with \\[spam-report-url-to-file] when
-the Agent is unplugged, and will be submitted in a batch when the
-Agent is plugged."
- (interactive)
- (add-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
- (add-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
-
-;;;###autoload
-(defun spam-report-deagentize ()
- "Remove spam-report support from the Agent.
-Spam reports will be queued with the method used when
-\\[spam-report-agentize] was run."
- (interactive)
- (remove-hook 'gnus-agent-plugged-hook 'spam-report-plug-agent)
- (remove-hook 'gnus-agent-unplugged-hook 'spam-report-unplug-agent))
-
-(defun spam-report-plug-agent ()
- "Adjust spam report settings for plugged state.
-Process queued spam reports."
- ;; Process the queue, unless the user only wanted to report to a file
- ;; anyway.
- (unless (equal spam-report-url-ping-temp-agent-function
- 'spam-report-url-to-file)
- (spam-report-process-queue))
- ;; Set the reporting function, if we have memorized something otherwise,
- ;; stick with plain URL reporting.
- (setq spam-report-url-ping-function
- (or spam-report-url-ping-temp-agent-function
- 'spam-report-url-ping-plain)))
-
-(defun spam-report-unplug-agent ()
- "Restore spam report settings for unplugged state."
- ;; save the old value
- (setq spam-report-url-ping-temp-agent-function
- spam-report-url-ping-function)
- ;; store all reports to file
- (setq spam-report-url-ping-function
- 'spam-report-url-to-file))
-
-(provide 'spam-report)
-
-;;; arch-tag: f6683295-ec89-4ab5-8803-8cc842293022
-;;; spam-report.el ends here.
+++ /dev/null
-;;; spam-stat.el --- detecting spam based on statistics
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Alex Schroeder <alex@gnu.org>
-;; Keywords: network
-;; URL: http://www.emacswiki.org/cgi-bin/wiki.pl?SpamStat
-
-;; This file is part of GNU Emacs.
-
-;; This 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 3, or (at your option)
-;; any later version.
-
-;; This 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This implements spam analysis according to Paul Graham in "A Plan
-;; for Spam". The basis for all this is a statistical distribution of
-;; words for your spam and non-spam mails. We need this information
-;; in a hash-table so that the analysis can use the information when
-;; looking at your mails. Therefore, before you begin, you need tons
-;; of mails (Graham uses 4000 non-spam and 4000 spam mails for his
-;; experiments).
-;;
-;; The main interface to using spam-stat, are the following functions:
-;;
-;; `spam-stat-buffer-is-spam' -- called in a buffer, that buffer is
-;; considered to be a new spam mail; use this for new mail that has
-;; not been processed before
-;;
-;; `spam-stat-buffer-is-non-spam' -- called in a buffer, that buffer
-;; is considered to be a new non-spam mail; use this for new mail that
-;; has not been processed before
-;;
-;; `spam-stat-buffer-change-to-spam' -- called in a buffer, that
-;; buffer is no longer considered to be normal mail but spam; use this
-;; to change the status of a mail that has already been processed as
-;; non-spam
-;;
-;; `spam-stat-buffer-change-to-non-spam' -- called in a buffer, that
-;; buffer is no longer considered to be spam but normal mail; use this
-;; to change the status of a mail that has already been processed as
-;; spam
-;;
-;; `spam-stat-save' -- save the hash table to the file; the filename
-;; used is stored in the variable `spam-stat-file'
-;;
-;; `spam-stat-load' -- load the hash table from a file; the filename
-;; used is stored in the variable `spam-stat-file'
-;;
-;; `spam-stat-score-word' -- return the spam score for a word
-;;
-;; `spam-stat-score-buffer' -- return the spam score for a buffer
-;;
-;; `spam-stat-split-fancy' -- for fancy mail splitting; add
-;; the rule (: spam-stat-split-fancy) to `nnmail-split-fancy'
-;;
-;; This requires the following in your ~/.gnus file:
-;;
-;; (require 'spam-stat)
-;; (spam-stat-load)
-
-;;; Testing:
-
-;; Typical test will involve calls to the following functions:
-;;
-;; Reset: (spam-stat-reset)
-;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
-;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
-;; Save table: (spam-stat-save)
-;; File size: (nth 7 (file-attributes spam-stat-file))
-;; Number of words: (hash-table-count spam-stat)
-;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
-;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
-;; Reduce table size: (spam-stat-reduce-size)
-;; Save table: (spam-stat-save)
-;; File size: (nth 7 (file-attributes spam-stat-file))
-;; Number of words: (hash-table-count spam-stat)
-;; Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
-;; Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
-
-;;; Dictionary Creation:
-
-;; Typically, you will filter away mailing lists etc. using specific
-;; rules in `nnmail-split-fancy'. Somewhere among these rules, you
-;; will filter spam. Here is how you would create your dictionary:
-
-;; Reset: (spam-stat-reset)
-;; Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
-;; Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
-;; Repeat for any other non-spam group you need...
-;; Reduce table size: (spam-stat-reduce-size)
-;; Save table: (spam-stat-save)
-
-;;; Todo:
-
-;; Speed it up. Integrate with Gnus such that it uses spam and expiry
-;; marks to call the appropriate functions when leaving the summary
-;; buffer and saves the hash table when leaving Gnus. More testing:
-;; More mails, disabling SpamAssassin, double checking algorithm, find
-;; improved algorithm.
-
-;;; Thanks:
-
-;; Ted Zlatanov <tzz@lifelogs.com>
-;; Jesper Harder <harder@myrealbox.com>
-;; Dan Schmidt <dfan@dfan.org>
-;; Lasse Rasinen <lrasinen@iki.fi>
-;; Milan Zamazal <pdm@zamazal.org>
-
-\f
-
-;;; Code:
-
-(defvar gnus-original-article-buffer)
-
-(defgroup spam-stat nil
- "Statistical spam detection for Emacs.
-Use the functions to build a dictionary of words and their statistical
-distribution in spam and non-spam mails. Then use a function to determine
-whether a buffer contains spam or not."
- :version "22.1"
- :group 'gnus)
-
-(defcustom spam-stat-file "~/.spam-stat.el"
- "File used to save and load the dictionary.
-See `spam-stat-to-hash-table' for the format of the file."
- :type 'file
- :group 'spam-stat)
-
-(defcustom spam-stat-install-hooks t
- "Whether spam-stat should install its hooks in Gnus.
-This is set to nil if you use spam-stat through spam.el."
- :type 'boolean
- :group 'spam-stat)
-
-(defcustom spam-stat-unknown-word-score 0.2
- "The score to use for unknown words.
-Also used for words that don't appear often enough."
- :type 'number
- :group 'spam-stat)
-
-(defcustom spam-stat-max-word-length 15
- "Only words shorter than this will be considered."
- :type 'integer
- :group 'spam-stat)
-
-(defcustom spam-stat-max-buffer-length 10240
- "Only the beginning of buffers will be analyzed.
-This variable says how many characters this will be."
- :type 'integer
- :group 'spam-stat)
-
-(defcustom spam-stat-split-fancy-spam-group "mail.spam"
- "Name of the group where spam should be stored, if
-`spam-stat-split-fancy' is used in fancy splitting rules. Has no
-effect when spam-stat is invoked through spam.el."
- :type 'string
- :group 'spam-stat)
-
-(defcustom spam-stat-split-fancy-spam-threshhold 0.9
- "Spam score threshhold in spam-stat-split-fancy."
- :type 'number
- :group 'spam-stat)
-
-(defvar spam-stat-syntax-table
- (let ((table (copy-syntax-table text-mode-syntax-table)))
- (modify-syntax-entry ?- "w" table)
- (modify-syntax-entry ?_ "w" table)
- (modify-syntax-entry ?. "w" table)
- (modify-syntax-entry ?! "w" table)
- (modify-syntax-entry ?? "w" table)
- (modify-syntax-entry ?+ "w" table)
- table)
- "Syntax table used when processing mails for statistical analysis.
-The important part is which characters are word constituents.")
-
-(defvar spam-stat-dirty nil
- "Whether the spam-stat database needs saving.")
-
-(defvar spam-stat-buffer nil
- "Buffer to use for scoring while splitting.
-This is set by hooking into Gnus.")
-
-(defvar spam-stat-buffer-name " *spam stat buffer*"
- "Name of the `spam-stat-buffer'.")
-
-;; Functions missing in Emacs 20
-
-(when (memq nil (mapcar 'fboundp
- '(gethash hash-table-count make-hash-table
- mapc puthash)))
- (require 'cl)
- (unless (fboundp 'puthash)
- ;; alias puthash is missing from Emacs 20 cl-extra.el
- (defalias 'puthash 'cl-puthash)))
-
-(eval-when-compile
- (unless (fboundp 'with-syntax-table)
- ;; Imported from Emacs 21.2
- (defmacro with-syntax-table (table &rest body) "\
-Evaluate BODY with syntax table of current buffer set to a copy of TABLE.
-The syntax table of the current buffer is saved, BODY is evaluated, and the
-saved table is restored, even in case of an abnormal exit.
-Value is what BODY returns."
- (let ((old-table (make-symbol "table"))
- (old-buffer (make-symbol "buffer")))
- `(let ((,old-table (syntax-table))
- (,old-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-syntax-table (copy-syntax-table ,table))
- ,@body)
- (save-current-buffer
- (set-buffer ,old-buffer)
- (set-syntax-table ,old-table))))))))
-
-;; Hooking into Gnus
-
-(defun spam-stat-store-current-buffer ()
- "Store a copy of the current buffer in `spam-stat-buffer'."
- (save-excursion
- (let ((str (buffer-string)))
- (set-buffer (get-buffer-create spam-stat-buffer-name))
- (erase-buffer)
- (insert str)
- (setq spam-stat-buffer (current-buffer)))))
-
-(defun spam-stat-store-gnus-article-buffer ()
- "Store a copy of the current article in `spam-stat-buffer'.
-This uses `gnus-article-buffer'."
- (save-excursion
- (set-buffer gnus-original-article-buffer)
- (spam-stat-store-current-buffer)))
-
-;; Data -- not using defstruct in order to save space and time
-
-(defvar spam-stat (make-hash-table :test 'equal)
- "Hash table used to store the statistics.
-Use `spam-stat-load' to load the file.
-Every word is used as a key in this table. The value is a vector.
-Use `spam-stat-ngood', `spam-stat-nbad', `spam-stat-good',
-`spam-stat-bad', and `spam-stat-score' to access this vector.")
-
-(defvar spam-stat-ngood 0
- "The number of good mails in the dictionary.")
-
-(defvar spam-stat-nbad 0
- "The number of bad mails in the dictionary.")
-
-(defsubst spam-stat-good (entry)
- "Return the number of times this word belongs to good mails."
- (aref entry 0))
-
-(defsubst spam-stat-bad (entry)
- "Return the number of times this word belongs to bad mails."
- (aref entry 1))
-
-(defsubst spam-stat-score (entry)
- "Set the score of this word."
- (if entry
- (aref entry 2)
- spam-stat-unknown-word-score))
-
-(defsubst spam-stat-set-good (entry value)
- "Set the number of times this word belongs to good mails."
- (aset entry 0 value))
-
-(defsubst spam-stat-set-bad (entry value)
- "Set the number of times this word belongs to bad mails."
- (aset entry 1 value))
-
-(defsubst spam-stat-set-score (entry value)
- "Set the score of this word."
- (aset entry 2 value))
-
-(defsubst spam-stat-make-entry (good bad)
- "Return a vector with the given properties."
- (let ((entry (vector good bad nil)))
- (spam-stat-set-score entry (spam-stat-compute-score entry))
- entry))
-
-;; Computing
-
-(defun spam-stat-compute-score (entry)
- "Compute the score of this word. 1.0 means spam."
- ;; promote all numbers to floats for the divisions
- (let* ((g (* 2.0 (spam-stat-good entry)))
- (b (float (spam-stat-bad entry))))
- (cond ((< (+ g b) 5)
- .2)
- ((= 0 spam-stat-ngood)
- .99)
- ((= 0 spam-stat-nbad)
- .01)
- (t
- (max .01
- (min .99 (/ (/ b spam-stat-nbad)
- (+ (/ g spam-stat-ngood)
- (/ b spam-stat-nbad)))))))))
-
-;; Parsing
-
-(defmacro with-spam-stat-max-buffer-size (&rest body)
- "Narrows the buffer down to the first 4k characters, then evaluates BODY."
- `(save-restriction
- (when (> (- (point-max)
- (point-min))
- spam-stat-max-buffer-length)
- (narrow-to-region (point-min)
- (+ (point-min) spam-stat-max-buffer-length)))
- ,@body))
-
-(defun spam-stat-buffer-words ()
- "Return a hash table of words and number of occurrences in the buffer."
- (with-spam-stat-max-buffer-size
- (with-syntax-table spam-stat-syntax-table
- (goto-char (point-min))
- (let ((result (make-hash-table :test 'equal))
- word count)
- (while (re-search-forward "\\w+" nil t)
- (setq word (match-string-no-properties 0)
- count (1+ (gethash word result 0)))
- (when (< (length word) spam-stat-max-word-length)
- (puthash word count result)))
- result))))
-
-(defun spam-stat-buffer-is-spam ()
- "Consider current buffer to be a new spam mail."
- (setq spam-stat-nbad (1+ spam-stat-nbad))
- (maphash
- (lambda (word count)
- (let ((entry (gethash word spam-stat)))
- (if entry
- (spam-stat-set-bad entry (+ count (spam-stat-bad entry)))
- (setq entry (spam-stat-make-entry 0 count)))
- (spam-stat-set-score entry (spam-stat-compute-score entry))
- (puthash word entry spam-stat)))
- (spam-stat-buffer-words))
- (setq spam-stat-dirty t))
-
-(defun spam-stat-buffer-is-non-spam ()
- "Consider current buffer to be a new non-spam mail."
- (setq spam-stat-ngood (1+ spam-stat-ngood))
- (maphash
- (lambda (word count)
- (let ((entry (gethash word spam-stat)))
- (if entry
- (spam-stat-set-good entry (+ count (spam-stat-good entry)))
- (setq entry (spam-stat-make-entry count 0)))
- (spam-stat-set-score entry (spam-stat-compute-score entry))
- (puthash word entry spam-stat)))
- (spam-stat-buffer-words))
- (setq spam-stat-dirty t))
-
-(defun spam-stat-buffer-change-to-spam ()
- "Consider current buffer no longer normal mail but spam."
- (setq spam-stat-nbad (1+ spam-stat-nbad)
- spam-stat-ngood (1- spam-stat-ngood))
- (maphash
- (lambda (word count)
- (let ((entry (gethash word spam-stat)))
- (if (not entry)
- (error "This buffer has unknown words in it")
- (spam-stat-set-good entry (- (spam-stat-good entry) count))
- (spam-stat-set-bad entry (+ (spam-stat-bad entry) count))
- (spam-stat-set-score entry (spam-stat-compute-score entry))
- (puthash word entry spam-stat))))
- (spam-stat-buffer-words))
- (setq spam-stat-dirty t))
-
-(defun spam-stat-buffer-change-to-non-spam ()
- "Consider current buffer no longer spam but normal mail."
- (setq spam-stat-nbad (1- spam-stat-nbad)
- spam-stat-ngood (1+ spam-stat-ngood))
- (maphash
- (lambda (word count)
- (let ((entry (gethash word spam-stat)))
- (if (not entry)
- (error "This buffer has unknown words in it")
- (spam-stat-set-good entry (+ (spam-stat-good entry) count))
- (spam-stat-set-bad entry (- (spam-stat-bad entry) count))
- (spam-stat-set-score entry (spam-stat-compute-score entry))
- (puthash word entry spam-stat))))
- (spam-stat-buffer-words))
- (setq spam-stat-dirty t))
-
-;; Saving and Loading
-
-(defun spam-stat-save (&optional force)
- "Save the `spam-stat' hash table as lisp file.
-With a prefix argument save unconditionally."
- (interactive "P")
- (when (or force spam-stat-dirty)
- (with-temp-buffer
- (let ((standard-output (current-buffer))
- (font-lock-maximum-size 0))
- (insert "(setq spam-stat-ngood "
- (number-to-string spam-stat-ngood)
- " spam-stat-nbad "
- (number-to-string spam-stat-nbad)
- " spam-stat (spam-stat-to-hash-table '(")
- (maphash (lambda (word entry)
- (prin1 (list word
- (spam-stat-good entry)
- (spam-stat-bad entry))))
- spam-stat)
- (insert ")))")
- (write-file spam-stat-file)))
- (setq spam-stat-dirty nil)))
-
-(defun spam-stat-load ()
- "Read the `spam-stat' hash table from disk."
- ;; TODO: maybe we should warn the user if spam-stat-dirty is t?
- (load-file spam-stat-file)
- (setq spam-stat-dirty nil))
-
-(defun spam-stat-to-hash-table (entries)
- "Turn list ENTRIES into a hash table and store as `spam-stat'.
-Every element in ENTRIES has the form \(WORD GOOD BAD) where WORD is
-the word string, NGOOD is the number of good mails it has appeared in,
-NBAD is the number of bad mails it has appeared in, GOOD is the number
-of times it appeared in good mails, and BAD is the number of times it
-has appeared in bad mails."
- (let ((table (make-hash-table :test 'equal)))
- (mapc (lambda (l)
- (puthash (car l)
- (spam-stat-make-entry (nth 1 l) (nth 2 l))
- table))
- entries)
- table))
-
-(defun spam-stat-reset ()
- "Reset `spam-stat' to an empty hash-table.
-This deletes all the statistics."
- (interactive)
- (setq spam-stat (make-hash-table :test 'equal)
- spam-stat-ngood 0
- spam-stat-nbad 0)
- (setq spam-stat-dirty t))
-
-;; Scoring buffers
-
-(defvar spam-stat-score-data nil
- "Raw data used in the last run of `spam-stat-score-buffer'.")
-
-(defsubst spam-stat-score-word (word)
- "Return score for WORD.
-The default score for unknown words is stored in
-`spam-stat-unknown-word-score'."
- (spam-stat-score (gethash word spam-stat)))
-
-(defun spam-stat-buffer-words-with-scores ()
- "Process current buffer, return the 15 most conspicuous words.
-These are the words whose spam-stat differs the most from 0.5.
-The list returned contains elements of the form \(WORD SCORE DIFF),
-where DIFF is the difference between SCORE and 0.5."
- (with-spam-stat-max-buffer-size
- (with-syntax-table spam-stat-syntax-table
- (let (result word score)
- (maphash (lambda (word ignore)
- (setq score (spam-stat-score-word word)
- result (cons (list word score (abs (- score 0.5)))
- result)))
- (spam-stat-buffer-words))
- (setq result (sort result (lambda (a b) (< (nth 2 b) (nth 2 a)))))
- (setcdr (nthcdr 14 result) nil)
- result))))
-
-(defun spam-stat-score-buffer ()
- "Return a score describing the spam-probability for this buffer."
- (setq spam-stat-score-data (spam-stat-buffer-words-with-scores))
- (let* ((probs (mapcar (lambda (e) (cadr e)) spam-stat-score-data))
- (prod (apply #'* probs)))
- (/ prod (+ prod (apply #'* (mapcar #'(lambda (x) (- 1 x))
- probs))))))
-
-(defun spam-stat-split-fancy ()
- "Return the name of the spam group if the current mail is spam.
-Use this function on `nnmail-split-fancy'. If you are interested in
-the raw data used for the last run of `spam-stat-score-buffer',
-check the variable `spam-stat-score-data'."
- (condition-case var
- (progn
- (set-buffer spam-stat-buffer)
- (goto-char (point-min))
- (when (> (spam-stat-score-buffer) spam-stat-split-fancy-spam-threshhold)
- (when (boundp 'nnmail-split-trace)
- (mapc (lambda (entry)
- (push entry nnmail-split-trace))
- spam-stat-score-data))
- spam-stat-split-fancy-spam-group))
- (error (message "Error in spam-stat-split-fancy: %S" var)
- nil)))
-
-;; Testing
-
-(defun spam-stat-process-directory (dir func)
- "Process all the regular files in directory DIR using function FUNC."
- (let* ((files (directory-files dir t "^[^.]"))
- (max (/ (length files) 100.0))
- (count 0))
- (with-temp-buffer
- (dolist (f files)
- (when (and (file-readable-p f)
- (file-regular-p f)
- (> (nth 7 (file-attributes f)) 0))
- (setq count (1+ count))
- (message "Reading %s: %.2f%%" dir (/ count max))
- (insert-file-contents f)
- (funcall func)
- (erase-buffer))))))
-
-(defun spam-stat-process-spam-directory (dir)
- "Process all the regular files in directory DIR as spam."
- (interactive "D")
- (spam-stat-process-directory dir 'spam-stat-buffer-is-spam))
-
-(defun spam-stat-process-non-spam-directory (dir)
- "Process all the regular files in directory DIR as non-spam."
- (interactive "D")
- (spam-stat-process-directory dir 'spam-stat-buffer-is-non-spam))
-
-(defun spam-stat-count ()
- "Return size of `spam-stat'."
- (interactive)
- (hash-table-count spam-stat))
-
-(defun spam-stat-test-directory (dir)
- "Test all the regular files in directory DIR for spam.
-If the result is 1.0, then all files are considered spam.
-If the result is 0.0, non of the files is considered spam.
-You can use this to determine error rates."
- (interactive "D")
- (let* ((files (directory-files dir t "^[^.]"))
- (total (length files))
- (score 0.0); float
- (max (/ total 100.0)); float
- (count 0))
- (with-temp-buffer
- (dolist (f files)
- (when (and (file-readable-p f)
- (file-regular-p f)
- (> (nth 7 (file-attributes f)) 0))
- (setq count (1+ count))
- (message "Reading %.2f%%, score %.2f%%"
- (/ count max) (/ score count))
- (insert-file-contents f)
- (when (> (spam-stat-score-buffer) 0.9)
- (setq score (1+ score)))
- (erase-buffer))))
- (message "Final score: %d / %d = %f" score total (/ score total))))
-
-;; Shrinking the dictionary
-
-(defun spam-stat-reduce-size (&optional count)
- "Reduce the size of `spam-stat'.
-This removes all words that occur less than COUNT from the dictionary.
-COUNT defaults to 5"
- (interactive)
- (setq count (or count 5))
- (maphash (lambda (key entry)
- (when (< (+ (spam-stat-good entry)
- (spam-stat-bad entry))
- count)
- (remhash key spam-stat)))
- spam-stat)
- (setq spam-stat-dirty t))
-
-(defun spam-stat-install-hooks-function ()
- "Install the spam-stat function hooks"
- (interactive)
- (add-hook 'nnmail-prepare-incoming-message-hook
- 'spam-stat-store-current-buffer)
- (add-hook 'gnus-select-article-hook
- 'spam-stat-store-gnus-article-buffer))
-
-(when spam-stat-install-hooks
- (spam-stat-install-hooks-function))
-
-(defun spam-stat-unload-hook ()
- "Uninstall the spam-stat function hooks"
- (interactive)
- (remove-hook 'nnmail-prepare-incoming-message-hook
- 'spam-stat-store-current-buffer)
- (remove-hook 'gnus-select-article-hook
- 'spam-stat-store-gnus-article-buffer))
-
-(add-hook 'spam-stat-unload-hook 'spam-stat-unload-hook)
-
-(provide 'spam-stat)
-
-;;; arch-tag: ff1d2200-8ddb-42fb-bb7b-1b5e20448554
-;;; spam-stat.el ends here
+++ /dev/null
-;;; spam.el --- Identifying spam
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Keywords: network
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This module addresses a few aspects of spam control under Gnus. Page
-;;; breaks are used for grouping declarations and documentation relating to
-;;; each particular aspect.
-
-;;; The integration with Gnus is not yet complete. See various `FIXME'
-;;; comments, below, for supplementary explanations or discussions.
-
-;;; Several TODO items are marked as such
-
-;; TODO: spam scores, detection of spam in newsgroups, cross-server splitting,
-;; remote processing, training through files
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'gnus-sum)
-
-(require 'gnus-uu) ; because of key prefix issues
-;;; for the definitions of group content classification and spam processors
-(require 'gnus)
-(require 'message) ;for the message-fetch-field functions
-
-;; for nnimap-split-download-body-default
-(eval-when-compile (require 'nnimap))
-
-;; autoload executable-find
-(eval-and-compile
- ;; executable-find is not autoloaded in Emacs 20
- (autoload 'executable-find "executable"))
-
-;; autoload query-dig
-(eval-and-compile
- (autoload 'query-dig "dig"))
-
-;; autoload spam-report
-(eval-and-compile
- (autoload 'spam-report-gmane "spam-report"))
-
-;; autoload gnus-registry
-(eval-and-compile
- (autoload 'gnus-registry-group-count "gnus-registry")
- (autoload 'gnus-registry-add-group "gnus-registry")
- (autoload 'gnus-registry-store-extra-entry "gnus-registry")
- (autoload 'gnus-registry-fetch-extra "gnus-registry"))
-
-;; autoload query-dns
-(eval-and-compile
- (autoload 'query-dns "dns"))
-
-;;; Main parameters.
-
-(defgroup spam nil
- "Spam configuration."
- :version "22.1"
- :group 'mail
- :group 'news)
-
-(defcustom spam-directory (nnheader-concat gnus-directory "spam/")
- "Directory for spam whitelists and blacklists."
- :type 'directory
- :group 'spam)
-
-(defcustom spam-move-spam-nonspam-groups-only t
- "Whether spam should be moved in non-spam groups only.
-When t, only ham and unclassified groups will have their spam moved
-to the spam-process-destination. When nil, spam will also be moved from
-spam groups."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-process-ham-in-nonham-groups nil
- "Whether ham should be processed in non-ham groups."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-mark-new-messages-in-spam-group-as-spam t
- "Whether new messages in a spam group should get the spam-mark."
- :type 'boolean
- ;; :version "22.1" ;; Gnus 5.10.8 / No Gnus 0.3
- :group 'spam)
-
-(defcustom spam-log-to-registry nil
- "Whether spam/ham processing should be logged in the registry."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-split-symbolic-return nil
- "Whether `spam-split' should work with symbols or group names."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-split-symbolic-return-positive nil
- "Whether `spam-split' should ALWAYS work with symbols or group names.
-Do not set this if you use `spam-split' in a fancy split
- method."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-process-ham-in-spam-groups nil
- "Whether ham should be processed in spam groups."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-mark-only-unseen-as-spam t
- "Whether only unseen articles should be marked as spam in spam groups.
-When nil, all unread articles in a spam group are marked as
-spam. Set this if you want to leave an article unread in a spam group
-without losing it to the automatic spam-marking process."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-mark-ham-unread-before-move-from-spam-group nil
- "Whether ham should be marked unread before it's moved.
-The article is moved out of a spam group according to ham-process-destination.
-This variable is an official entry in the international Longest Variable Name
-Competition."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-disable-spam-split-during-ham-respool nil
- "Whether `spam-split' should be ignored while resplitting ham in a process
-destination. This is useful to prevent ham from ending up in the same spam
-group after the resplit. Don't set this to t if you have spam-split as the
-last rule in your split configuration."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-autodetect-recheck-messages nil
- "Should spam.el recheck all meessages when autodetecting?
-Normally this is nil, so only unseen messages will be checked."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-whitelist (expand-file-name "whitelist" spam-directory)
- "The location of the whitelist.
-The file format is one regular expression per line.
-The regular expression is matched against the address."
- :type 'file
- :group 'spam)
-
-(defcustom spam-blacklist (expand-file-name "blacklist" spam-directory)
- "The location of the blacklist.
-The file format is one regular expression per line.
-The regular expression is matched against the address."
- :type 'file
- :group 'spam)
-
-(defcustom spam-use-dig t
- "Whether `query-dig' should be used instead of `query-dns'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-blacklist nil
- "Whether the blacklist should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-blacklist-ignored-regexes nil
- "Regular expressions that the blacklist should ignore."
- :type '(repeat (regexp :tag "Regular expression to ignore when blacklisting"))
- :group 'spam)
-
-(defcustom spam-use-whitelist nil
- "Whether the whitelist should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-whitelist-exclusive nil
- "Whether whitelist-exclusive should be used by `spam-split'.
-Exclusive whitelisting means that all messages from senders not in the whitelist
-are considered spam."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-blackholes nil
- "Whether blackholes should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-hashcash nil
- "Whether hashcash payments should be detected by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-regex-headers nil
- "Whether a header regular expression match should be used by `spam-split'.
-Also see the variables `spam-regex-headers-spam' and `spam-regex-headers-ham'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-regex-body nil
- "Whether a body regular expression match should be used by `spam-split'.
-Also see the variables `spam-regex-body-spam' and `spam-regex-body-ham'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-bogofilter-headers nil
- "Whether bogofilter headers should be used by `spam-split'.
-Enable this if you pre-process messages with Bogofilter BEFORE Gnus sees them."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-bogofilter nil
- "Whether bogofilter should be invoked by `spam-split'.
-Enable this if you want Gnus to invoke Bogofilter on new messages."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-BBDB nil
- "Whether BBDB should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-BBDB-exclusive nil
- "Whether BBDB-exclusive should be used by `spam-split'.
-Exclusive BBDB means that all messages from senders not in the BBDB are
-considered spam."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-ifile nil
- "Whether ifile should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-stat nil
- "Whether `spam-stat' should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-use-spamoracle nil
- "Whether spamoracle should be used by `spam-split'."
- :type 'boolean
- :group 'spam)
-
-(defcustom spam-install-hooks (or
- spam-use-dig
- spam-use-blacklist
- spam-use-whitelist
- spam-use-whitelist-exclusive
- spam-use-blackholes
- spam-use-hashcash
- spam-use-regex-headers
- spam-use-regex-body
- spam-use-bogofilter-headers
- spam-use-bogofilter
- spam-use-BBDB
- spam-use-BBDB-exclusive
- spam-use-ifile
- spam-use-stat
- spam-use-spamoracle)
- "Whether the spam hooks should be installed.
-Default to t if one of the spam-use-* variables is set."
- :group 'spam
- :type 'boolean)
-
-(defcustom spam-split-group "spam"
- "Group name where incoming spam should be put by `spam-split'."
- :type 'string
- :group 'spam)
-
-;;; TODO: deprecate this variable, it's confusing since it's a list of strings,
-;;; not regular expressions
-(defcustom spam-junk-mailgroups (cons
- spam-split-group
- '("mail.junk" "poste.pourriel"))
- "Mailgroups with spam contents.
-All unmarked article in such group receive the spam mark on group entry."
- :type '(repeat (string :tag "Group"))
- :group 'spam)
-
-(defcustom spam-blackhole-servers '("bl.spamcop.net" "relays.ordb.org"
- "dev.null.dk" "relays.visi.com")
- "List of blackhole servers."
- :type '(repeat (string :tag "Server"))
- :group 'spam)
-
-(defcustom spam-blackhole-good-server-regex nil
- "String matching IP addresses that should not be checked in the blackholes."
- :type '(radio (const nil) regexp)
- :group 'spam)
-
-(defface spam
- '((((class color) (type tty) (background dark))
- (:foreground "gray80" :background "gray50"))
- (((class color) (type tty) (background light))
- (:foreground "gray50" :background "gray80"))
- (((class color) (background dark))
- (:foreground "ivory2"))
- (((class color) (background light))
- (:foreground "ivory4"))
- (t :inverse-video t))
- "Face for spam-marked articles."
- :group 'spam)
-;; backward-compatibility alias
-(put 'spam-face 'face-alias 'spam)
-
-(defcustom spam-face 'spam
- "Face for spam-marked articles."
- :type 'face
- :group 'spam)
-
-(defcustom spam-regex-headers-spam '("^X-Spam-Flag: YES")
- "Regular expression for positive header spam matches."
- :type '(repeat (regexp :tag "Regular expression to match spam header"))
- :group 'spam)
-
-(defcustom spam-regex-headers-ham '("^X-Spam-Flag: NO")
- "Regular expression for positive header ham matches."
- :type '(repeat (regexp :tag "Regular expression to match ham header"))
- :group 'spam)
-
-(defcustom spam-regex-body-spam '()
- "Regular expression for positive body spam matches."
- :type '(repeat (regexp :tag "Regular expression to match spam body"))
- :group 'spam)
-
-(defcustom spam-regex-body-ham '()
- "Regular expression for positive body ham matches."
- :type '(repeat (regexp :tag "Regular expression to match ham body"))
- :group 'spam)
-
-(defgroup spam-ifile nil
- "Spam ifile configuration."
- :group 'spam)
-
-(make-obsolete-variable 'spam-ifile-path 'spam-ifile-program)
-;; "22.1" ;; Gnus 5.10.9
-(defcustom spam-ifile-program (executable-find "ifile")
- "Name of the ifile program."
- :type '(choice (file :tag "Location of ifile")
- (const :tag "ifile is not installed"))
- :group 'spam-ifile)
-
-(make-obsolete-variable 'spam-ifile-database-path 'spam-ifile-database)
-;; "22.1" ;; Gnus 5.10.9
-(defcustom spam-ifile-database nil
- "File name of the ifile database."
- :type '(choice (file :tag "Location of the ifile database")
- (const :tag "Use the default"))
- :group 'spam-ifile)
-
-(defcustom spam-ifile-spam-category "spam"
- "Name of the spam ifile category."
- :type 'string
- :group 'spam-ifile)
-
-(defcustom spam-ifile-ham-category nil
- "Name of the ham ifile category.
-If nil, the current group name will be used."
- :type '(choice (string :tag "Use a fixed category")
- (const :tag "Use the current group name"))
- :group 'spam-ifile)
-
-(defcustom spam-ifile-all-categories nil
- "Whether the ifile check will return all categories, or just spam.
-Set this to t if you want to use the `spam-split' invocation of ifile as
-your main source of newsgroup names."
- :type 'boolean
- :group 'spam-ifile)
-
-(defgroup spam-bogofilter nil
- "Spam bogofilter configuration."
- :group 'spam)
-
-(make-obsolete-variable 'spam-bogofilter-path 'spam-bogofilter-program)
-;; "22.1" ;; Gnus 5.10.9
-(defcustom spam-bogofilter-program (executable-find "bogofilter")
- "Name of the Bogofilter program."
- :type '(choice (file :tag "Location of bogofilter")
- (const :tag "Bogofilter is not installed"))
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-header "X-Bogosity"
- "The header that Bogofilter inserts in messages."
- :type 'string
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-spam-switch "-s"
- "The switch that Bogofilter uses to register spam messages."
- :type 'string
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-ham-switch "-n"
- "The switch that Bogofilter uses to register ham messages."
- :type 'string
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-spam-strong-switch "-S"
- "The switch that Bogofilter uses to unregister ham messages."
- :type 'string
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-ham-strong-switch "-N"
- "The switch that Bogofilter uses to unregister spam messages."
- :type 'string
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-bogosity-positive-spam-header "^\\(Yes\\|Spam\\)"
- "The regex on `spam-bogofilter-header' for positive spam identification."
- :type 'regexp
- :group 'spam-bogofilter)
-
-(defcustom spam-bogofilter-database-directory nil
- "Location of the Bogofilter database.
-When nil, use the default location."
- :type '(choice (directory
- :tag "Location of the Bogofilter database directory")
- (const :tag "Use the default"))
- :group 'spam-bogofilter)
-
-(defgroup spam-spamoracle nil
- "Spam spamoracle configuration."
- :group 'spam)
-
-(defcustom spam-spamoracle-database nil
- "Location of spamoracle database file.
-When nil, use the default spamoracle database."
- :type '(choice (directory :tag "Location of spamoracle database file.")
- (const :tag "Use the default"))
- :group 'spam-spamoracle)
-
-(defcustom spam-spamoracle-binary (executable-find "spamoracle")
- "Location of the spamoracle binary."
- :type '(choice (directory :tag "Location of the spamoracle binary")
- (const :tag "Use the default"))
- :group 'spam-spamoracle)
-
-;;; Key bindings for spam control.
-
-(gnus-define-keys gnus-summary-mode-map
- "St" spam-bogofilter-score
- "Sx" gnus-summary-mark-as-spam
- "Mst" spam-bogofilter-score
- "Msx" gnus-summary-mark-as-spam
- "\M-d" gnus-summary-mark-as-spam)
-
-(defvar spam-old-ham-articles nil
- "List of old ham articles, generated when a group is entered.")
-
-(defvar spam-old-spam-articles nil
- "List of old spam articles, generated when a group is entered.")
-
-(defvar spam-split-disabled nil
- "If non-nil, `spam-split' is disabled, and always returns nil.")
-
-(defvar spam-split-last-successful-check nil
- "`spam-split' will set this to nil or a spam-use-XYZ check if it
- finds ham or spam.")
-
-;; convenience functions
-(defun spam-xor (a b)
- "Logical exclusive `or'."
- (and (or a b) (not (and a b))))
-
-(defun spam-group-ham-mark-p (group mark &optional spam)
- (when (stringp group)
- (let* ((marks (spam-group-ham-marks group spam))
- (marks (if (symbolp mark)
- marks
- (mapcar 'symbol-value marks))))
- (memq mark marks))))
-
-(defun spam-group-spam-mark-p (group mark)
- (spam-group-ham-mark-p group mark t))
-
-(defun spam-group-ham-marks (group &optional spam)
- (when (stringp group)
- (let* ((marks (if spam
- (gnus-parameter-spam-marks group)
- (gnus-parameter-ham-marks group)))
- (marks (car marks))
- (marks (if (listp (car marks)) (car marks) marks)))
- marks)))
-
-(defun spam-group-spam-marks (group)
- (spam-group-ham-marks group t))
-
-(defun spam-group-spam-contents-p (group)
- (if (stringp group)
- (or (member group spam-junk-mailgroups)
- (memq 'gnus-group-spam-classification-spam
- (gnus-parameter-spam-contents group)))
- nil))
-
-(defun spam-group-ham-contents-p (group)
- (if (stringp group)
- (memq 'gnus-group-spam-classification-ham
- (gnus-parameter-spam-contents group))
- nil))
-
-(defvar spam-list-of-processors
- '((gnus-group-spam-exit-processor-report-gmane spam spam-use-gmane)
- (gnus-group-spam-exit-processor-bogofilter spam spam-use-bogofilter)
- (gnus-group-spam-exit-processor-blacklist spam spam-use-blacklist)
- (gnus-group-spam-exit-processor-ifile spam spam-use-ifile)
- (gnus-group-spam-exit-processor-stat spam spam-use-stat)
- (gnus-group-spam-exit-processor-spamoracle spam spam-use-spamoracle)
- (gnus-group-ham-exit-processor-ifile ham spam-use-ifile)
- (gnus-group-ham-exit-processor-bogofilter ham spam-use-bogofilter)
- (gnus-group-ham-exit-processor-stat ham spam-use-stat)
- (gnus-group-ham-exit-processor-whitelist ham spam-use-whitelist)
- (gnus-group-ham-exit-processor-BBDB ham spam-use-BBDB)
- (gnus-group-ham-exit-processor-copy ham spam-use-ham-copy)
- (gnus-group-ham-exit-processor-spamoracle ham spam-use-spamoracle))
- "The spam-list-of-processors list contains pairs associating a
-ham/spam exit processor variable with a classification and a
-spam-use-* variable.")
-
-(defun spam-group-processor-p (group processor)
- (if (and (stringp group)
- (symbolp processor))
- (or (member processor (nth 0 (gnus-parameter-spam-process group)))
- (spam-group-processor-multiple-p
- group
- (cdr-safe (assoc processor spam-list-of-processors))))
- nil))
-
-(defun spam-group-processor-multiple-p (group processor-info)
- (let* ((classification (nth 0 processor-info))
- (check (nth 1 processor-info))
- (parameters (nth 0 (gnus-parameter-spam-process group)))
- found)
- (dolist (parameter parameters)
- (when (and (null found)
- (listp parameter)
- (eq classification (nth 0 parameter))
- (eq check (nth 1 parameter)))
- (setq found t)))
- found))
-
-(defun spam-group-spam-processor-report-gmane-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-report-gmane))
-
-(defun spam-group-spam-processor-bogofilter-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-bogofilter))
-
-(defun spam-group-spam-processor-blacklist-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-blacklist))
-
-(defun spam-group-spam-processor-ifile-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-ifile))
-
-(defun spam-group-ham-processor-ifile-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-ifile))
-
-(defun spam-group-spam-processor-spamoracle-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-spamoracle))
-
-(defun spam-group-ham-processor-bogofilter-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-bogofilter))
-
-(defun spam-group-spam-processor-stat-p (group)
- (spam-group-processor-p group 'gnus-group-spam-exit-processor-stat))
-
-(defun spam-group-ham-processor-stat-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-stat))
-
-(defun spam-group-ham-processor-whitelist-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-whitelist))
-
-(defun spam-group-ham-processor-BBDB-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-BBDB))
-
-(defun spam-group-ham-processor-copy-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-copy))
-
-(defun spam-group-ham-processor-spamoracle-p (group)
- (spam-group-processor-p group 'gnus-group-ham-exit-processor-spamoracle))
-
-;;; Summary entry and exit processing.
-
-(defun spam-summary-prepare ()
- (setq spam-old-ham-articles
- (spam-list-articles gnus-newsgroup-articles 'ham))
- (setq spam-old-spam-articles
- (spam-list-articles gnus-newsgroup-articles 'spam))
- (spam-mark-junk-as-spam-routine))
-
-;; The spam processors are invoked for any group, spam or ham or neither
-(defun spam-summary-prepare-exit ()
- (unless gnus-group-is-exiting-without-update-p
- (gnus-message 6 "Exiting summary buffer and applying spam rules")
-
- ;; first of all, unregister any articles that are no longer ham or spam
- ;; we have to iterate over the processors, or else we'll be too slow
- (dolist (classification '(spam ham))
- (let* ((old-articles (if (eq classification 'spam)
- spam-old-spam-articles
- spam-old-ham-articles))
- (new-articles (spam-list-articles
- gnus-newsgroup-articles
- classification))
- (changed-articles (gnus-set-difference old-articles new-articles)))
- ;; now that we have the changed articles, we go through the processors
- (dolist (processor-param spam-list-of-processors)
- (let ((processor (nth 0 processor-param))
- (processor-classification (nth 1 processor-param))
- (check (nth 2 processor-param))
- unregister-list)
- (dolist (article changed-articles)
- (let ((id (spam-fetch-field-message-id-fast article)))
- (when (spam-log-unregistration-needed-p
- id 'process classification check)
- (push article unregister-list))))
- ;; call spam-register-routine with specific articles to unregister,
- ;; when there are articles to unregister and the check is enabled
- (when (and unregister-list (symbol-value check))
- (spam-register-routine classification check t unregister-list))))))
-
- ;; find all the spam processors applicable to this group
- (dolist (processor-param spam-list-of-processors)
- (let ((processor (nth 0 processor-param))
- (classification (nth 1 processor-param))
- (check (nth 2 processor-param)))
- (when (and (eq 'spam classification)
- (spam-group-processor-p gnus-newsgroup-name processor))
- (spam-register-routine classification check))))
-
- (if spam-move-spam-nonspam-groups-only
- (when (not (spam-group-spam-contents-p gnus-newsgroup-name))
- (spam-mark-spam-as-expired-and-move-routine
- (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
- (gnus-message 5 "Marking spam as expired and moving it to %s"
- gnus-newsgroup-name)
- (spam-mark-spam-as-expired-and-move-routine
- (gnus-parameter-spam-process-destination gnus-newsgroup-name)))
-
- ;; now we redo spam-mark-spam-as-expired-and-move-routine to only
- ;; expire spam, in case the above did not expire them
- (gnus-message 5 "Marking spam as expired without moving it")
- (spam-mark-spam-as-expired-and-move-routine nil)
-
- (when (or (spam-group-ham-contents-p gnus-newsgroup-name)
- (and (spam-group-spam-contents-p gnus-newsgroup-name)
- spam-process-ham-in-spam-groups)
- spam-process-ham-in-nonham-groups)
- ;; find all the ham processors applicable to this group
- (dolist (processor-param spam-list-of-processors)
- (let ((processor (nth 0 processor-param))
- (classification (nth 1 processor-param))
- (check (nth 2 processor-param)))
- (when (and (eq 'ham classification)
- (spam-group-processor-p gnus-newsgroup-name processor))
- (spam-register-routine classification check)))))
-
- (when (spam-group-ham-processor-copy-p gnus-newsgroup-name)
- (gnus-message 5 "Copying ham")
- (spam-ham-copy-routine
- (gnus-parameter-ham-process-destination gnus-newsgroup-name)))
-
- ;; now move all ham articles out of spam groups
- (when (spam-group-spam-contents-p gnus-newsgroup-name)
- (gnus-message 5 "Moving ham messages from spam group")
- (spam-ham-move-routine
- (gnus-parameter-ham-process-destination gnus-newsgroup-name))))
-
- (setq spam-old-ham-articles nil)
- (setq spam-old-spam-articles nil))
-
-(defun spam-mark-junk-as-spam-routine ()
- ;; check the global list of group names spam-junk-mailgroups and the
- ;; group parameters
- (when (spam-group-spam-contents-p gnus-newsgroup-name)
- (gnus-message 6 "Marking %s articles as spam"
- (if spam-mark-only-unseen-as-spam
- "unseen"
- "unread"))
- (let ((articles (if spam-mark-only-unseen-as-spam
- gnus-newsgroup-unseen
- gnus-newsgroup-unreads)))
- (if spam-mark-new-messages-in-spam-group-as-spam
- (dolist (article articles)
- (gnus-summary-mark-article article gnus-spam-mark))
- (gnus-message 9 "Did not mark new messages as spam.")))))
-
-(defun spam-mark-spam-as-expired-and-move-routine (&rest groups)
- (if (and (car-safe groups) (listp (car-safe groups)))
- (apply 'spam-mark-spam-as-expired-and-move-routine (car groups))
- (gnus-summary-kill-process-mark)
- (let ((articles gnus-newsgroup-articles)
- (backend-supports-deletions
- (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name))
- article tomove deletep)
- (dolist (article articles)
- (when (eq (gnus-summary-article-mark article) gnus-spam-mark)
- (gnus-summary-mark-article article gnus-expirable-mark)
- (push article tomove)))
-
- ;; now do the actual copies
- (dolist (group groups)
- (when (and tomove
- (stringp group))
- (dolist (article tomove)
- (gnus-summary-set-process-mark article))
- (when tomove
- (if (or (not backend-supports-deletions)
- (> (length groups) 1))
- (progn
- (gnus-summary-copy-article nil group)
- (setq deletep t))
- (gnus-summary-move-article nil group)))))
-
- ;; now delete the articles, if there was a copy done, and the
- ;; backend allows it
- (when (and deletep backend-supports-deletions)
- (dolist (article tomove)
- (gnus-summary-set-process-mark article))
- (when tomove
- (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
- (gnus-summary-delete-article nil))))
-
- (gnus-summary-yank-process-mark))))
-
-(defun spam-ham-copy-or-move-routine (copy groups)
- (gnus-summary-kill-process-mark)
- (let ((todo (spam-list-articles gnus-newsgroup-articles 'ham))
- (backend-supports-deletions
- (gnus-check-backend-function
- 'request-move-article gnus-newsgroup-name))
- (respool-method (gnus-find-method-for-group gnus-newsgroup-name))
- article mark deletep respool)
-
- (when (member 'respool groups)
- (setq respool t) ; boolean for later
- (setq groups '("fake"))) ; when respooling, groups are dynamic so fake it
-
- ;; now do the actual move
- (dolist (group groups)
- (when (and todo (stringp group))
- (dolist (article todo)
- (when spam-mark-ham-unread-before-move-from-spam-group
- (gnus-summary-mark-article article gnus-unread-mark))
- (gnus-summary-set-process-mark article))
-
- (if respool ; respooling is with a "fake" group
- (let ((spam-split-disabled
- (or spam-split-disabled
- spam-disable-spam-split-during-ham-respool)))
- (gnus-summary-respool-article nil respool-method))
- (if (or (not backend-supports-deletions) ; else, we are not respooling
- (> (length groups) 1))
- (progn ; if copying, copy and set deletep
- (gnus-summary-copy-article nil group)
- (setq deletep t))
- (gnus-summary-move-article nil group))))) ; else move articles
-
- ;; now delete the articles, unless a) copy is t, and there was a copy done
- ;; b) a move was done to a single group
- ;; c) backend-supports-deletions is nil
- (unless copy
- (when (and deletep backend-supports-deletions)
- (dolist (article todo)
- (gnus-summary-set-process-mark article))
- (when todo
- (let ((gnus-novice-user nil)) ; don't ask me if I'm sure
- (gnus-summary-delete-article nil))))))
-
- (gnus-summary-yank-process-mark))
-
-(defun spam-ham-copy-routine (&rest groups)
- (if (and (car-safe groups) (listp (car-safe groups)))
- (apply 'spam-ham-copy-routine (car groups))
- (spam-ham-copy-or-move-routine t groups)))
-
-(defun spam-ham-move-routine (&rest groups)
- (if (and (car-safe groups) (listp (car-safe groups)))
- (apply 'spam-ham-move-routine (car groups))
- (spam-ham-copy-or-move-routine nil groups)))
-
-(eval-and-compile
- (defalias 'spam-point-at-eol (if (fboundp 'point-at-eol)
- 'point-at-eol
- 'line-end-position)))
-
-(defun spam-get-article-as-string (article)
- (let ((article-buffer (spam-get-article-as-buffer article))
- article-string)
- (when article-buffer
- (save-window-excursion
- (set-buffer article-buffer)
- (setq article-string (buffer-string))))
- article-string))
-
-(defun spam-get-article-as-buffer (article)
- (let ((article-buffer))
- (when (numberp article)
- (save-window-excursion
- (gnus-summary-goto-subject article)
- (gnus-summary-show-article t)
- (setq article-buffer (get-buffer gnus-article-buffer))))
- article-buffer))
-
-;; disabled for now
-;; (defun spam-get-article-as-filename (article)
-;; (let ((article-filename))
-;; (when (numberp article)
-;; (nnml-possibly-change-directory
-;; (gnus-group-real-name gnus-newsgroup-name))
-;; (setq article-filename (expand-file-name
-;; (int-to-string article) nnml-current-directory)))
-;; (if (file-exists-p article-filename)
-;; article-filename
-;; nil)))
-
-(defun spam-fetch-field-from-fast (article)
- "Fetch the `from' field quickly, using the internal gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (mail-header-from
- (gnus-data-header (assoc article (gnus-data-list nil))))
- nil))
-
-(defun spam-fetch-field-subject-fast (article)
- "Fetch the `subject' field quickly, using the internal
- gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (mail-header-subject
- (gnus-data-header (assoc article (gnus-data-list nil))))
- nil))
-
-(defun spam-fetch-field-message-id-fast (article)
- "Fetch the `Message-ID' field quickly, using the internal
- gnus-data-list function"
- (if (and (numberp article)
- (assoc article (gnus-data-list nil)))
- (mail-header-message-id
- (gnus-data-header (assoc article (gnus-data-list nil))))
- nil))
-
-\f
-;;;; Spam determination.
-
-(defvar spam-list-of-checks
- '((spam-use-blacklist . spam-check-blacklist)
- (spam-use-regex-headers . spam-check-regex-headers)
- (spam-use-regex-body . spam-check-regex-body)
- (spam-use-whitelist . spam-check-whitelist)
- (spam-use-BBDB . spam-check-BBDB)
- (spam-use-ifile . spam-check-ifile)
- (spam-use-spamoracle . spam-check-spamoracle)
- (spam-use-stat . spam-check-stat)
- (spam-use-blackholes . spam-check-blackholes)
- (spam-use-hashcash . spam-check-hashcash)
- (spam-use-bogofilter-headers . spam-check-bogofilter-headers)
- (spam-use-bogofilter . spam-check-bogofilter))
- "The spam-list-of-checks list contains pairs associating a
-parameter variable with a spam checking function. If the
-parameter variable is true, then the checking function is called,
-and its value decides what happens. Each individual check may
-return nil, t, or a mailgroup name. The value nil means that the
-check does not yield a decision, and so, that further checks are
-needed. The value t means that the message is definitely not
-spam, and that further spam checks should be inhibited.
-Otherwise, a mailgroup name or the symbol 'spam (depending on
-spam-split-symbolic-return) is returned where the mail should go,
-and further checks are also inhibited. The usual mailgroup name
-is the value of `spam-split-group', meaning that the message is
-definitely a spam.")
-
-(defvar spam-list-of-statistical-checks
- '(spam-use-ifile
- spam-use-regex-body
- spam-use-stat
- spam-use-bogofilter
- spam-use-spamoracle)
- "The spam-list-of-statistical-checks list contains all the mail
-splitters that need to have the full message body available.")
-
-;;;TODO: modify to invoke self with each check if invoked without specifics
-(defun spam-split (&rest specific-checks)
- "Split this message into the `spam' group if it is spam.
-This function can be used as an entry in the variable `nnmail-split-fancy',
-for example like this: (: spam-split). It can take checks as
-parameters. A string as a parameter will set the
-spam-split-group to that string.
-
-See the Info node `(gnus)Fancy Mail Splitting' for more details."
- (interactive)
- (setq spam-split-last-successful-check nil)
- (unless spam-split-disabled
- (let ((spam-split-group-choice spam-split-group))
- (dolist (check specific-checks)
- (when (stringp check)
- (setq spam-split-group-choice check)
- (setq specific-checks (delq check specific-checks))))
-
- (let ((spam-split-group spam-split-group-choice))
- (save-excursion
- (save-restriction
- (dolist (check spam-list-of-statistical-checks)
- (when (and (symbolp check) (symbol-value check))
- (widen)
- (gnus-message 8 "spam-split: widening the buffer (%s requires it)"
- (symbol-name check))
- (return)))
- ;; (progn (widen) (debug (buffer-string)))
- (let ((list-of-checks spam-list-of-checks)
- decision)
- (while (and list-of-checks (not decision))
- (let ((pair (pop list-of-checks)))
- (when (and (symbol-value (car pair))
- (or (null specific-checks)
- (memq (car pair) specific-checks)))
- (gnus-message 5 "spam-split: calling the %s function"
- (symbol-name (cdr pair)))
- (setq decision (funcall (cdr pair)))
- ;; if we got a decision at all, save the current check
- (when decision
- (setq spam-split-last-successful-check (car pair)))
-
- (when (eq decision 'spam)
- (if spam-split-symbolic-return
- (setq decision spam-split-group)
- (gnus-error
- 5
- (format "spam-split got %s but %s is nil"
- (symbol-name decision)
- (symbol-name spam-split-symbolic-return))))))))
- (if (eq decision t)
- (if spam-split-symbolic-return-positive 'ham nil)
- decision))))))))
-
-(defun spam-find-spam ()
- "This function will detect spam in the current newsgroup using spam-split."
- (interactive)
-
- (let* ((group gnus-newsgroup-name)
- (autodetect (gnus-parameter-spam-autodetect group))
- (methods (gnus-parameter-spam-autodetect-methods group))
- (first-method (nth 0 methods)))
- (when (and autodetect
- (not (equal first-method 'none)))
- (mapcar
- (lambda (article)
- (let ((id (spam-fetch-field-message-id-fast article))
- (subject (spam-fetch-field-subject-fast article))
- (sender (spam-fetch-field-from-fast article)))
- (unless (and spam-log-to-registry
- (spam-log-registered-p id 'incoming))
- (let* ((spam-split-symbolic-return t)
- (spam-split-symbolic-return-positive t)
- (split-return
- (with-temp-buffer
- (gnus-request-article-this-buffer
- article
- group)
- (if (or (null first-method)
- (equal first-method 'default))
- (spam-split)
- (apply 'spam-split methods)))))
- (if (equal split-return 'spam)
- (gnus-summary-mark-article article gnus-spam-mark))
-
- (when (and split-return spam-log-to-registry)
- (when (zerop (gnus-registry-group-count id))
- (gnus-registry-add-group
- id group subject sender))
-
- (spam-log-processing-to-registry
- id
- 'incoming
- split-return
- spam-split-last-successful-check
- group))))))
- (if spam-autodetect-recheck-messages
- gnus-newsgroup-articles
- gnus-newsgroup-unseen)))))
-
-(defvar spam-registration-functions
- ;; first the ham register, second the spam register function
- ;; third the ham unregister, fourth the spam unregister function
- '((spam-use-blacklist nil
- spam-blacklist-register-routine
- nil
- spam-blacklist-unregister-routine)
- (spam-use-whitelist spam-whitelist-register-routine
- nil
- spam-whitelist-unregister-routine
- nil)
- (spam-use-BBDB spam-BBDB-register-routine
- nil
- spam-BBDB-unregister-routine
- nil)
- (spam-use-ifile spam-ifile-register-ham-routine
- spam-ifile-register-spam-routine
- spam-ifile-unregister-ham-routine
- spam-ifile-unregister-spam-routine)
- (spam-use-spamoracle spam-spamoracle-learn-ham
- spam-spamoracle-learn-spam
- spam-spamoracle-unlearn-ham
- spam-spamoracle-unlearn-spam)
- (spam-use-stat spam-stat-register-ham-routine
- spam-stat-register-spam-routine
- spam-stat-unregister-ham-routine
- spam-stat-unregister-spam-routine)
- ;; note that spam-use-gmane is not a legitimate check
- (spam-use-gmane nil
- spam-report-gmane-register-routine
- ;; does Gmane support unregistration?
- nil
- nil)
- (spam-use-bogofilter spam-bogofilter-register-ham-routine
- spam-bogofilter-register-spam-routine
- spam-bogofilter-unregister-ham-routine
- spam-bogofilter-unregister-spam-routine))
- "The spam-registration-functions list contains pairs
-associating a parameter variable with the ham and spam
-registration functions, and the ham and spam unregistration
-functions")
-
-(defun spam-classification-valid-p (classification)
- (or (eq classification 'spam)
- (eq classification 'ham)))
-
-(defun spam-process-type-valid-p (process-type)
- (or (eq process-type 'incoming)
- (eq process-type 'process)))
-
-(defun spam-registration-check-valid-p (check)
- (assoc check spam-registration-functions))
-
-(defun spam-unregistration-check-valid-p (check)
- (assoc check spam-registration-functions))
-
-(defun spam-registration-function (classification check)
- (let ((flist (cdr-safe (assoc check spam-registration-functions))))
- (if (eq classification 'spam)
- (nth 1 flist)
- (nth 0 flist))))
-
-(defun spam-unregistration-function (classification check)
- (let ((flist (cdr-safe (assoc check spam-registration-functions))))
- (if (eq classification 'spam)
- (nth 3 flist)
- (nth 2 flist))))
-
-(defun spam-list-articles (articles classification)
- (let ((mark-check (if (eq classification 'spam)
- 'spam-group-spam-mark-p
- 'spam-group-ham-mark-p))
- list mark-cache-yes mark-cache-no)
- (dolist (article articles)
- (let ((mark (gnus-summary-article-mark article)))
- (unless (memq mark mark-cache-no)
- (if (memq mark mark-cache-yes)
- (push article list)
- ;; else, we have to actually check the mark
- (if (funcall mark-check
- gnus-newsgroup-name
- mark)
- (progn
- (push article list)
- (push mark mark-cache-yes))
- (push mark mark-cache-no))))))
- list))
-
-(defun spam-register-routine (classification
- check
- &optional unregister
- specific-articles)
- (when (and (spam-classification-valid-p classification)
- (spam-registration-check-valid-p check))
- (let* ((register-function
- (spam-registration-function classification check))
- (unregister-function
- (spam-unregistration-function classification check))
- (run-function (if unregister
- unregister-function
- register-function))
- (log-function (if unregister
- 'spam-log-undo-registration
- 'spam-log-processing-to-registry))
- article articles)
-
- (when run-function
- ;; make list of articles, using specific-articles if given
- (setq articles (or specific-articles
- (spam-list-articles
- gnus-newsgroup-articles
- classification)))
- ;; process them
- (gnus-message 5 "%s %d %s articles with classification %s, check %s"
- (if unregister "Unregistering" "Registering")
- (length articles)
- (if specific-articles "specific" "")
- (symbol-name classification)
- (symbol-name check))
- (funcall run-function articles)
- ;; now log all the registrations (or undo them, depending on unregister)
- (dolist (article articles)
- (funcall log-function
- (spam-fetch-field-message-id-fast article)
- 'process
- classification
- check
- gnus-newsgroup-name))))))
-
-;;; log a ham- or spam-processor invocation to the registry
-(defun spam-log-processing-to-registry (id type classification check group)
- (when spam-log-to-registry
- (if (and (stringp id)
- (stringp group)
- (spam-process-type-valid-p type)
- (spam-classification-valid-p classification)
- (spam-registration-check-valid-p check))
- (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
- (cell (list classification check group)))
- (push cell cell-list)
- (gnus-registry-store-extra-entry
- id
- type
- cell-list))
-
- (gnus-message 5 (format "%s called with bad ID, type, classification, check, or group"
- "spam-log-processing-to-registry")))))
-
-;;; check if a ham- or spam-processor registration has been done
-(defun spam-log-registered-p (id type)
- (when spam-log-to-registry
- (if (and (stringp id)
- (spam-process-type-valid-p type))
- (cdr-safe (gnus-registry-fetch-extra id type))
- (progn
- (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
- "spam-log-registered-p"))
- nil))))
-
-;;; check if a ham- or spam-processor registration needs to be undone
-(defun spam-log-unregistration-needed-p (id type classification check)
- (when spam-log-to-registry
- (if (and (stringp id)
- (spam-process-type-valid-p type)
- (spam-classification-valid-p classification)
- (spam-registration-check-valid-p check))
- (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
- found)
- (dolist (cell cell-list)
- (unless found
- (when (and (eq classification (nth 0 cell))
- (eq check (nth 1 cell)))
- (setq found t))))
- found)
- (progn
- (gnus-message 5 (format "%s called with bad ID, type, classification, or check"
- "spam-log-unregistration-needed-p"))
- nil))))
-
-
-;;; undo a ham- or spam-processor registration (the group is not used)
-(defun spam-log-undo-registration (id type classification check &optional group)
- (when (and spam-log-to-registry
- (spam-log-unregistration-needed-p id type classification check))
- (if (and (stringp id)
- (spam-process-type-valid-p type)
- (spam-classification-valid-p classification)
- (spam-registration-check-valid-p check))
- (let ((cell-list (cdr-safe (gnus-registry-fetch-extra id type)))
- new-cell-list found)
- (dolist (cell cell-list)
- (unless (and (eq classification (nth 0 cell))
- (eq check (nth 1 cell)))
- (push cell new-cell-list)))
- (gnus-registry-store-extra-entry
- id
- type
- new-cell-list))
- (progn
- (gnus-message 5 (format "%s called with bad ID, type, check, or group"
- "spam-log-undo-registration"))
- nil))))
-
-;;; set up IMAP widening if it's necessary
-(defun spam-setup-widening ()
- (dolist (check spam-list-of-statistical-checks)
- (when (symbol-value check)
- (setq nnimap-split-download-body-default t))))
-
-\f
-;;;; Regex body
-
-(defun spam-check-regex-body ()
- (let ((spam-regex-headers-ham spam-regex-body-ham)
- (spam-regex-headers-spam spam-regex-body-spam))
- (spam-check-regex-headers t)))
-
-\f
-;;;; Regex headers
-
-(defun spam-check-regex-headers (&optional body)
- (let ((type (if body "body" "header"))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group))
- ret found)
- (dolist (h-regex spam-regex-headers-ham)
- (unless found
- (goto-char (point-min))
- (when (re-search-forward h-regex nil t)
- (message "Ham regex %s search positive." type)
- (setq found t))))
- (dolist (s-regex spam-regex-headers-spam)
- (unless found
- (goto-char (point-min))
- (when (re-search-forward s-regex nil t)
- (message "Spam regex %s search positive." type)
- (setq found t)
- (setq ret spam-split-group))))
- ret))
-
-\f
-;;;; Blackholes.
-
-(defun spam-reverse-ip-string (ip)
- (when (stringp ip)
- (mapconcat 'identity
- (nreverse (split-string ip "\\."))
- ".")))
-
-(defun spam-check-blackholes ()
- "Check the Received headers for blackholed relays."
- (let ((headers (nnmail-fetch-field "received"))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group))
- ips matches)
- (when headers
- (with-temp-buffer
- (insert headers)
- (goto-char (point-min))
- (gnus-message 5 "Checking headers for relay addresses")
- (while (re-search-forward
- "\\([0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+\\)" nil t)
- (gnus-message 9 "Blackhole search found host IP %s." (match-string 1))
- (push (spam-reverse-ip-string (match-string 1))
- ips)))
- (dolist (server spam-blackhole-servers)
- (dolist (ip ips)
- (unless (and spam-blackhole-good-server-regex
- ;; match the good-server-regex against the reversed (again) IP string
- (string-match
- spam-blackhole-good-server-regex
- (spam-reverse-ip-string ip)))
- (unless matches
- (let ((query-string (concat ip "." server)))
- (if spam-use-dig
- (let ((query-result (query-dig query-string)))
- (when query-result
- (gnus-message 5 "(DIG): positive blackhole check '%s'"
- query-result)
- (push (list ip server query-result)
- matches)))
- ;; else, if not using dig.el
- (when (query-dns query-string)
- (gnus-message 5 "positive blackhole check")
- (push (list ip server (query-dns query-string 'TXT))
- matches)))))))))
- (when matches
- spam-split-group)))
-\f
-;;;; Hashcash.
-
-(eval-when-compile
- (autoload 'mail-check-payment "hashcash"))
-
-(condition-case nil
- (progn
- (require 'hashcash)
-
- (defun spam-check-hashcash ()
- "Check the headers for hashcash payments."
- (mail-check-payment))) ;mail-check-payment returns a boolean
-
- (file-error))
-\f
-;;;; BBDB
-
-;;; original idea for spam-check-BBDB from Alexander Kotelnikov
-;;; <sacha@giotto.sj.ru>
-
-;; all this is done inside a condition-case to trap errors
-
-(eval-when-compile
- (autoload 'bbdb-buffer "bbdb")
- (autoload 'bbdb-create-internal "bbdb")
- (autoload 'bbdb-search-simple "bbdb"))
-
-(eval-and-compile
- (when (condition-case nil
- (progn
- (require 'bbdb)
- (require 'bbdb-com))
- (file-error
- (defalias 'spam-BBDB-register-routine 'ignore)
- (defalias 'spam-enter-ham-BBDB 'ignore)
- nil))
-
- (defun spam-enter-ham-BBDB (addresses &optional remove)
- "Enter an address into the BBDB; implies ham (non-spam) sender"
- (dolist (from addresses)
- (when (stringp from)
- (let* ((parsed-address (gnus-extract-address-components from))
- (name (or (nth 0 parsed-address) "Ham Sender"))
- (remove-function (if remove
- 'bbdb-delete-record-internal
- 'ignore))
- (net-address (nth 1 parsed-address))
- (record (and net-address
- (bbdb-search-simple nil net-address))))
- (when net-address
- (gnus-message 5 "%s address %s %s BBDB"
- (if remove "Deleting" "Adding")
- from
- (if remove "from" "to"))
- (if record
- (funcall remove-function record)
- (bbdb-create-internal name nil net-address nil nil
- "ham sender added by spam.el")))))))
-
- (defun spam-BBDB-register-routine (articles &optional unregister)
- (let (addresses)
- (dolist (article articles)
- (when (stringp (spam-fetch-field-from-fast article))
- (push (spam-fetch-field-from-fast article) addresses)))
- ;; now do the register/unregister action
- (spam-enter-ham-BBDB addresses unregister)))
-
- (defun spam-BBDB-unregister-routine (articles)
- (spam-BBDB-register-routine articles t))
-
- (defun spam-check-BBDB ()
- "Mail from people in the BBDB is classified as ham or non-spam"
- (let ((who (nnmail-fetch-field "from"))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group)))
- (when who
- (setq who (nth 1 (gnus-extract-address-components who)))
- (if (bbdb-search-simple nil who)
- t
- (if spam-use-BBDB-exclusive
- spam-split-group
- nil)))))))
-
-\f
-;;;; ifile
-
-;;; check the ifile backend; return nil if the mail was NOT classified
-;;; as spam
-
-
-(defun spam-get-ifile-database-parameter ()
- "Return the command-line parameter for ifile's database.
-See `spam-ifile-database'."
- (if spam-ifile-database
- (format "--db-file=%s" spam-ifile-database)
- nil))
-
-(defun spam-check-ifile ()
- "Check the ifile backend for the classification of this message."
- (let ((article-buffer-name (buffer-name))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group))
- category return)
- (with-temp-buffer
- (let ((temp-buffer-name (buffer-name))
- (db-param (spam-get-ifile-database-parameter)))
- (save-excursion
- (set-buffer article-buffer-name)
- (apply 'call-process-region
- (point-min) (point-max) spam-ifile-program
- nil temp-buffer-name nil "-c"
- (if db-param `(,db-param "-q") `("-q"))))
- ;; check the return now (we're back in the temp buffer)
- (goto-char (point-min))
- (if (not (eobp))
- (setq category (buffer-substring (point) (spam-point-at-eol))))
- (when (not (zerop (length category))) ; we need a category here
- (if spam-ifile-all-categories
- (setq return category)
- ;; else, if spam-ifile-all-categories is not set...
- (when (string-equal spam-ifile-spam-category category)
- (setq return spam-split-group)))))) ; note return is nil otherwise
- return))
-
-(defun spam-ifile-register-with-ifile (articles category &optional unregister)
- "Register an article, given as a string, with a category.
-Uses `gnus-newsgroup-name' if category is nil (for ham registration)."
- (let ((category (or category gnus-newsgroup-name))
- (add-or-delete-option (if unregister "-d" "-i"))
- (db (spam-get-ifile-database-parameter))
- parameters)
- (with-temp-buffer
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article)))
- (when (stringp article-string)
- (insert article-string))))
- (apply 'call-process-region
- (point-min) (point-max) spam-ifile-program
- nil nil nil
- add-or-delete-option category
- (if db `(,db "-h") `("-h"))))))
-
-(defun spam-ifile-register-spam-routine (articles &optional unregister)
- (spam-ifile-register-with-ifile articles spam-ifile-spam-category unregister))
-
-(defun spam-ifile-unregister-spam-routine (articles)
- (spam-ifile-register-spam-routine articles t))
-
-(defun spam-ifile-register-ham-routine (articles &optional unregister)
- (spam-ifile-register-with-ifile articles spam-ifile-ham-category unregister))
-
-(defun spam-ifile-unregister-ham-routine (articles)
- (spam-ifile-register-ham-routine articles t))
-
-\f
-;;;; spam-stat
-
-(eval-when-compile
- (autoload 'spam-stat-buffer-change-to-non-spam "spam-stat")
- (autoload 'spam-stat-buffer-change-to-spam "spam-stat")
- (autoload 'spam-stat-buffer-is-non-spam "spam-stat")
- (autoload 'spam-stat-buffer-is-spam "spam-stat")
- (autoload 'spam-stat-load "spam-stat")
- (autoload 'spam-stat-save "spam-stat")
- (autoload 'spam-stat-split-fancy "spam-stat"))
-
-(eval-and-compile
- (when (condition-case nil
- (let ((spam-stat-install-hooks nil))
- (require 'spam-stat))
- (file-error
- (defalias 'spam-stat-register-ham-routine 'ignore)
- (defalias 'spam-stat-register-spam-routine 'ignore)
- nil))
-
- (defun spam-check-stat ()
- "Check the spam-stat backend for the classification of this message"
- (let ((spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group))
- (spam-stat-split-fancy-spam-group spam-split-group) ; override
- (spam-stat-buffer (buffer-name)) ; stat the current buffer
- category return)
- (spam-stat-split-fancy)))
-
- (defun spam-stat-register-spam-routine (articles &optional unregister)
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (if unregister
- (spam-stat-buffer-change-to-non-spam)
- (spam-stat-buffer-is-spam))))))
-
- (defun spam-stat-unregister-spam-routine (articles)
- (spam-stat-register-spam-routine articles t))
-
- (defun spam-stat-register-ham-routine (articles &optional unregister)
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article)))
- (with-temp-buffer
- (insert article-string)
- (if unregister
- (spam-stat-buffer-change-to-spam)
- (spam-stat-buffer-is-non-spam))))))
-
- (defun spam-stat-unregister-ham-routine (articles)
- (spam-stat-register-ham-routine articles t))
-
- (defun spam-maybe-spam-stat-load ()
- (when spam-use-stat (spam-stat-load)))
-
- (defun spam-maybe-spam-stat-save ()
- (when spam-use-stat (spam-stat-save)))))
-
-\f
-
-;;;; Blacklists and whitelists.
-
-(defvar spam-whitelist-cache nil)
-(defvar spam-blacklist-cache nil)
-
-(defun spam-kill-whole-line ()
- (beginning-of-line)
- (let ((kill-whole-line t))
- (kill-line)))
-
-;;; address can be a list, too
-(defun spam-enter-whitelist (address &optional remove)
- "Enter ADDRESS (list or single) into the whitelist.
-With a non-nil REMOVE, remove them."
- (interactive "sAddress: ")
- (spam-enter-list address spam-whitelist remove)
- (setq spam-whitelist-cache nil))
-
-;;; address can be a list, too
-(defun spam-enter-blacklist (address &optional remove)
- "Enter ADDRESS (list or single) into the blacklist.
-With a non-nil REMOVE, remove them."
- (interactive "sAddress: ")
- (spam-enter-list address spam-blacklist remove)
- (setq spam-blacklist-cache nil))
-
-(defun spam-enter-list (addresses file &optional remove)
- "Enter ADDRESSES into the given FILE.
-Either the whitelist or the blacklist files can be used. With
-REMOVE not nil, remove the ADDRESSES."
- (if (stringp addresses)
- (spam-enter-list (list addresses) file remove)
- ;; else, we have a list of addresses here
- (unless (file-exists-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (save-excursion
- (set-buffer
- (find-file-noselect file))
- (dolist (a addresses)
- (when (stringp a)
- (goto-char (point-min))
- (if (re-search-forward (regexp-quote a) nil t)
- ;; found the address
- (when remove
- (spam-kill-whole-line))
- ;; else, the address was not found
- (unless remove
- (goto-char (point-max))
- (unless (bobp)
- (insert "\n"))
- (insert a "\n")))))
- (save-buffer))))
-
-;;; returns t if the sender is in the whitelist, nil or
-;;; spam-split-group otherwise
-(defun spam-check-whitelist ()
- ;; FIXME! Should it detect when file timestamps change?
- (let ((spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group)))
- (unless spam-whitelist-cache
- (setq spam-whitelist-cache (spam-parse-list spam-whitelist)))
- (if (spam-from-listed-p spam-whitelist-cache)
- t
- (if spam-use-whitelist-exclusive
- spam-split-group
- nil))))
-
-(defun spam-check-blacklist ()
- ;; FIXME! Should it detect when file timestamps change?
- (let ((spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group)))
- (unless spam-blacklist-cache
- (setq spam-blacklist-cache (spam-parse-list spam-blacklist)))
- (and (spam-from-listed-p spam-blacklist-cache) spam-split-group)))
-
-(defun spam-parse-list (file)
- (when (file-readable-p file)
- (let (contents address)
- (with-temp-buffer
- (insert-file-contents file)
- (while (not (eobp))
- (setq address (buffer-substring (point) (spam-point-at-eol)))
- (forward-line 1)
- ;; insert the e-mail address if detected, otherwise the raw data
- (unless (zerop (length address))
- (let ((pure-address (nth 1 (gnus-extract-address-components address))))
- (push (or pure-address address) contents)))))
- (nreverse contents))))
-
-(defun spam-from-listed-p (cache)
- (let ((from (nnmail-fetch-field "from"))
- found)
- (while cache
- (let ((address (pop cache)))
- (unless (zerop (length address)) ; 0 for a nil address too
- (setq address (regexp-quote address))
- ;; fix regexp-quote's treatment of user-intended regexes
- (while (string-match "\\\\\\*" address)
- (setq address (replace-match ".*" t t address))))
- (when (and address (string-match address from))
- (setq found t
- cache nil))))
- found))
-
-(defun spam-filelist-register-routine (articles blacklist &optional unregister)
- (let ((de-symbol (if blacklist 'spam-use-whitelist 'spam-use-blacklist))
- (declassification (if blacklist 'ham 'spam))
- (enter-function
- (if blacklist 'spam-enter-blacklist 'spam-enter-whitelist))
- (remove-function
- (if blacklist 'spam-enter-whitelist 'spam-enter-blacklist))
- from addresses unregister-list)
- (dolist (article articles)
- (let ((from (spam-fetch-field-from-fast article))
- (id (spam-fetch-field-message-id-fast article))
- sender-ignored)
- (when (stringp from)
- (dolist (ignore-regex spam-blacklist-ignored-regexes)
- (when (and (not sender-ignored)
- (stringp ignore-regex)
- (string-match ignore-regex from))
- (setq sender-ignored t)))
- ;; remember the messages we need to unregister, unless remove is set
- (when (and
- (null unregister)
- (spam-log-unregistration-needed-p
- id 'process declassification de-symbol))
- (push from unregister-list))
- (unless sender-ignored
- (push from addresses)))))
-
- (if unregister
- (funcall enter-function addresses t) ; unregister all these addresses
- ;; else, register normally and unregister what we need to
- (funcall remove-function unregister-list t)
- (dolist (article unregister-list)
- (spam-log-undo-registration
- (spam-fetch-field-message-id-fast article)
- 'process
- declassification
- de-symbol))
- (funcall enter-function addresses nil))))
-
-(defun spam-blacklist-unregister-routine (articles)
- (spam-blacklist-register-routine articles t))
-
-(defun spam-blacklist-register-routine (articles &optional unregister)
- (spam-filelist-register-routine articles t unregister))
-
-(defun spam-whitelist-unregister-routine (articles)
- (spam-whitelist-register-routine articles t))
-
-(defun spam-whitelist-register-routine (articles &optional unregister)
- (spam-filelist-register-routine articles nil unregister))
-
-\f
-;;;; Spam-report glue
-(defun spam-report-gmane-register-routine (articles)
- (when articles
- (apply 'spam-report-gmane articles)))
-
-\f
-;;;; Bogofilter
-(defun spam-check-bogofilter-headers (&optional score)
- (let ((header (nnmail-fetch-field spam-bogofilter-header))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group)))
- (when header ; return nil when no header
- (if score ; scoring mode
- (if (string-match "spamicity=\\([0-9.]+\\)" header)
- (match-string 1 header)
- "0")
- ;; spam detection mode
- (when (string-match spam-bogofilter-bogosity-positive-spam-header
- header)
- spam-split-group)))))
-
-;; return something sensible if the score can't be determined
-(defun spam-bogofilter-score ()
- "Get the Bogofilter spamicity score"
- (interactive)
- (save-window-excursion
- (gnus-summary-show-article t)
- (set-buffer gnus-article-buffer)
- (let ((score (or (spam-check-bogofilter-headers t)
- (spam-check-bogofilter t))))
- (message "Spamicity score %s" score)
- (or score "0"))
- (gnus-summary-show-article)))
-
-(defun spam-check-bogofilter (&optional score)
- "Check the Bogofilter backend for the classification of this message"
- (let ((article-buffer-name (buffer-name))
- (db spam-bogofilter-database-directory)
- return)
- (with-temp-buffer
- (let ((temp-buffer-name (buffer-name)))
- (save-excursion
- (set-buffer article-buffer-name)
- (apply 'call-process-region
- (point-min) (point-max)
- spam-bogofilter-program
- nil temp-buffer-name nil
- (if db `("-d" ,db "-v") `("-v"))))
- (setq return (spam-check-bogofilter-headers score))))
- return))
-
-(defun spam-bogofilter-register-with-bogofilter (articles
- spam
- &optional unregister)
- "Register an article, given as a string, as spam or non-spam."
- (dolist (article articles)
- (let ((article-string (spam-get-article-as-string article))
- (db spam-bogofilter-database-directory)
- (switch (if unregister
- (if spam
- spam-bogofilter-spam-strong-switch
- spam-bogofilter-ham-strong-switch)
- (if spam
- spam-bogofilter-spam-switch
- spam-bogofilter-ham-switch))))
- (when (stringp article-string)
- (with-temp-buffer
- (insert article-string)
-
- (apply 'call-process-region
- (point-min) (point-max)
- spam-bogofilter-program
- nil nil nil switch
- (if db `("-d" ,db "-v") `("-v"))))))))
-
-(defun spam-bogofilter-register-spam-routine (articles &optional unregister)
- (spam-bogofilter-register-with-bogofilter articles t unregister))
-
-(defun spam-bogofilter-unregister-spam-routine (articles)
- (spam-bogofilter-register-spam-routine articles t))
-
-(defun spam-bogofilter-register-ham-routine (articles &optional unregister)
- (spam-bogofilter-register-with-bogofilter articles nil unregister))
-
-(defun spam-bogofilter-unregister-ham-routine (articles)
- (spam-bogofilter-register-ham-routine articles t))
-
-
-\f
-;;;; spamoracle
-(defun spam-check-spamoracle ()
- "Run spamoracle on an article to determine whether it's spam."
- (let ((article-buffer-name (buffer-name))
- (spam-split-group (if spam-split-symbolic-return
- 'spam
- spam-split-group)))
- (with-temp-buffer
- (let ((temp-buffer-name (buffer-name)))
- (save-excursion
- (set-buffer article-buffer-name)
- (let ((status
- (apply 'call-process-region
- (point-min) (point-max)
- spam-spamoracle-binary
- nil temp-buffer-name nil
- (if spam-spamoracle-database
- `("-f" ,spam-spamoracle-database "mark")
- '("mark")))))
- (if (eq 0 status)
- (progn
- (set-buffer temp-buffer-name)
- (goto-char (point-min))
- (when (re-search-forward "^X-Spam: yes;" nil t)
- spam-split-group))
- (error "Error running spamoracle: %s" status))))))))
-
-(defun spam-spamoracle-learn (articles article-is-spam-p &optional unregister)
- "Run spamoracle in training mode."
- (with-temp-buffer
- (let ((temp-buffer-name (buffer-name)))
- (save-excursion
- (goto-char (point-min))
- (dolist (article articles)
- (insert (spam-get-article-as-string article)))
- (let* ((arg (if (spam-xor unregister article-is-spam-p)
- "-spam"
- "-good"))
- (status
- (apply 'call-process-region
- (point-min) (point-max)
- spam-spamoracle-binary
- nil temp-buffer-name nil
- (if spam-spamoracle-database
- `("-f" ,spam-spamoracle-database
- "add" ,arg)
- `("add" ,arg)))))
- (unless (eq 0 status)
- (error "Error running spamoracle: %s" status)))))))
-
-(defun spam-spamoracle-learn-ham (articles &optional unregister)
- (spam-spamoracle-learn articles nil unregister))
-
-(defun spam-spamoracle-unlearn-ham (articles &optional unregister)
- (spam-spamoracle-learn-ham articles t))
-
-(defun spam-spamoracle-learn-spam (articles &optional unregister)
- (spam-spamoracle-learn articles t unregister))
-
-(defun spam-spamoracle-unlearn-spam (articles &optional unregister)
- (spam-spamoracle-learn-spam articles t))
-
-\f
-;;;; Hooks
-
-;;;###autoload
-(defun spam-initialize ()
- "Install the spam.el hooks and do other initialization"
- (interactive)
- (setq spam-install-hooks t)
- ;; TODO: How do we redo this every time the `spam' face is customized?
- (push '((eq mark gnus-spam-mark) . spam)
- gnus-summary-highlight)
- ;; Add hooks for loading and saving the spam stats
- (add-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
- (add-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
- (add-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
- (add-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
- (add-hook 'gnus-get-new-news-hook 'spam-setup-widening)
- (add-hook 'gnus-summary-prepare-hook 'spam-find-spam))
-
-(defun spam-unload-hook ()
- "Uninstall the spam.el hooks"
- (interactive)
- (remove-hook 'gnus-save-newsrc-hook 'spam-maybe-spam-stat-save)
- (remove-hook 'gnus-get-top-new-news-hook 'spam-maybe-spam-stat-load)
- (remove-hook 'gnus-startup-hook 'spam-maybe-spam-stat-load)
- (remove-hook 'gnus-summary-prepare-exit-hook 'spam-summary-prepare-exit)
- (remove-hook 'gnus-summary-prepare-hook 'spam-summary-prepare)
- (remove-hook 'gnus-get-new-news-hook 'spam-setup-widening)
- (remove-hook 'gnus-summary-prepare-hook 'spam-find-spam))
-
-(add-hook 'spam-unload-hook 'spam-unload-hook)
-
-(when spam-install-hooks
- (spam-initialize))
-
-(provide 'spam)
-
-;;; arch-tag: 07e6e0ca-ab0a-4412-b445-1f6c72a4f27f
-;;; spam.el ends here
+++ /dev/null
-;;; time-date.el --- Date and time handling functions
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007, 2008
-;; Free Software Foundation, Inc.
-
-;; Author: Lars Magne Ingebrigtsen <larsi@gnus.org>
-;; Masanobu Umeda <umerin@mse.kyutech.ac.jp>
-;; Keywords: mail news util
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Time values come in three formats. The oldest format is a cons
-;; cell of the form (HIGH . LOW). This format is obsolete, but still
-;; supported. The two other formats are the lists (HIGH LOW) and
-;; (HIGH LOW MICRO). The first two formats specify HIGH * 2^16 + LOW
-;; seconds; the third format specifies HIGH * 2^16 + LOW + MICRO /
-;; 1000000 seconds. We should have 0 <= MICRO < 1000000 and 0 <= LOW
-;; < 2^16. If the time value represents a point in time, then HIGH is
-;; nonnegative. If the time value is a time difference, then HIGH can
-;; be negative as well. The macro `with-decoded-time-value' and the
-;; function `encode-time-value' make it easier to deal with these
-;; three formats. See `time-subtract' for an example of how to use
-;; them.
-
-;;; Code:
-
-(defmacro with-decoded-time-value (varlist &rest body)
- "Decode a time value and bind it according to VARLIST, then eval BODY.
-
-The value of the last form in BODY is returned.
-
-Each element of the list VARLIST is a list of the form
-\(HIGH-SYMBOL LOW-SYMBOL MICRO-SYMBOL [TYPE-SYMBOL] TIME-VALUE).
-The time value TIME-VALUE is decoded and the result it bound to
-the symbols HIGH-SYMBOL, LOW-SYMBOL and MICRO-SYMBOL.
-
-The optional TYPE-SYMBOL is bound to the type of the time value.
-Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH
-LOW), and type 2 is the list (HIGH LOW MICRO)."
- (declare (indent 1)
- (debug ((&rest (symbolp symbolp symbolp &or [symbolp form] form))
- body)))
- (if varlist
- (let* ((elt (pop varlist))
- (high (pop elt))
- (low (pop elt))
- (micro (pop elt))
- (type (unless (eq (length elt) 1)
- (pop elt)))
- (time-value (car elt))
- (gensym (make-symbol "time")))
- `(let* ,(append `((,gensym ,time-value)
- (,high (pop ,gensym))
- ,low ,micro)
- (when type `(,type)))
- (if (consp ,gensym)
- (progn
- (setq ,low (pop ,gensym))
- (if ,gensym
- ,(append `(setq ,micro (car ,gensym))
- (when type `(,type 2)))
- ,(append `(setq ,micro 0)
- (when type `(,type 1)))))
- ,(append `(setq ,low ,gensym ,micro 0)
- (when type `(,type 0))))
- (with-decoded-time-value ,varlist ,@body)))
- `(progn ,@body)))
-
-(defun encode-time-value (high low micro type)
- "Encode HIGH, LOW, and MICRO into a time value of type TYPE.
-Type 0 is the cons cell (HIGH . LOW), type 1 is the list (HIGH LOW),
-and type 2 is the list (HIGH LOW MICRO)."
- (cond
- ((eq type 0) (cons high low))
- ((eq type 1) (list high low))
- ((eq type 2) (list high low micro))))
-
-(autoload 'parse-time-string "parse-time")
-(autoload 'timezone-make-date-arpa-standard "timezone")
-
-;;;###autoload
-(defun date-to-time (date)
- "Parse a string that represents a date-time and return a time value."
- (condition-case ()
- (apply 'encode-time
- (parse-time-string
- ;; `parse-time-string' isn't sufficiently general or
- ;; robust. It fails to grok some of the formats that
- ;; timezone does (e.g. dodgy post-2000 stuff from some
- ;; Elms) and either fails or returns bogus values. Lars
- ;; reverted this change, but that loses non-trivially
- ;; often for me. -- fx
- (timezone-make-date-arpa-standard date)))
- (error (error "Invalid date: %s" date))))
-
-;;;###autoload
-(defun time-to-seconds (time)
- "Convert time value TIME to a floating point number.
-You can use `float-time' instead."
- (with-decoded-time-value ((high low micro time))
- (+ (* 1.0 high 65536)
- low
- (/ micro 1000000.0))))
-
-;;;###autoload
-(defun seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to a time value."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
-
-;;;###autoload
-(defun time-less-p (t1 t2)
- "Say whether time value T1 is less than time value T2."
- (with-decoded-time-value ((high1 low1 micro1 t1)
- (high2 low2 micro2 t2))
- (or (< high1 high2)
- (and (= high1 high2)
- (or (< low1 low2)
- (and (= low1 low2)
- (< micro1 micro2)))))))
-
-;;;###autoload
-(defun days-to-time (days)
- "Convert DAYS into a time value."
- (let* ((seconds (* 1.0 days 60 60 24))
- (high (condition-case nil (floor (/ seconds 65536))
- (range-error most-positive-fixnum))))
- (list high (condition-case nil (floor (- seconds (* 1.0 high 65536)))
- (range-error 65535)))))
-
-;;;###autoload
-(defun time-since (time)
- "Return the time elapsed since TIME.
-TIME should be either a time value or a date-time string."
- (when (stringp time)
- ;; Convert date strings to internal time.
- (setq time (date-to-time time)))
- (time-subtract (current-time) time))
-
-;;;###autoload
-(defalias 'subtract-time 'time-subtract)
-
-;;;###autoload
-(defun time-subtract (t1 t2)
- "Subtract two time values.
-Return the difference in the format of a time value."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
- (setq high (- high high2)
- low (- low low2)
- micro (- micro micro2)
- type (max type type2))
- (when (< micro 0)
- (setq low (1- low)
- micro (+ micro 1000000)))
- (when (< low 0)
- (setq high (1- high)
- low (+ low 65536)))
- (encode-time-value high low micro type)))
-
-;;;###autoload
-(defun time-add (t1 t2)
- "Add two time values. One should represent a time difference."
- (with-decoded-time-value ((high low micro type t1)
- (high2 low2 micro2 type2 t2))
- (setq high (+ high high2)
- low (+ low low2)
- micro (+ micro micro2)
- type (max type type2))
- (when (>= micro 1000000)
- (setq low (1+ low)
- micro (- micro 1000000)))
- (when (>= low 65536)
- (setq high (1+ high)
- low (- low 65536)))
- (encode-time-value high low micro type)))
-
-;;;###autoload
-(defun date-to-day (date)
- "Return the number of days between year 1 and DATE.
-DATE should be a date-time string."
- (time-to-days (date-to-time date)))
-
-;;;###autoload
-(defun days-between (date1 date2)
- "Return the number of days between DATE1 and DATE2.
-DATE1 and DATE2 should be date-time strings."
- (- (date-to-day date1) (date-to-day date2)))
-
-;;;###autoload
-(defun date-leap-year-p (year)
- "Return t if YEAR is a leap year."
- (or (and (zerop (% year 4))
- (not (zerop (% year 100))))
- (zerop (% year 400))))
-
-;;;###autoload
-(defun time-to-day-in-year (time)
- "Return the day number within the year corresponding to TIME."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim))
- (day-of-year (+ day (* 31 (1- month)))))
- (when (> month 2)
- (setq day-of-year (- day-of-year (/ (+ 23 (* 4 month)) 10)))
- (when (date-leap-year-p year)
- (setq day-of-year (1+ day-of-year))))
- day-of-year))
-
-;;;###autoload
-(defun time-to-days (time)
- "The number of days between the Gregorian date 0001-12-31bce and TIME.
-TIME should be a time value.
-The Gregorian date Sunday, December 31, 1bce is imaginary."
- (let* ((tim (decode-time time))
- (month (nth 4 tim))
- (day (nth 3 tim))
- (year (nth 5 tim)))
- (+ (time-to-day-in-year time) ; Days this year
- (* 365 (1- year)) ; + Days in prior years
- (/ (1- year) 4) ; + Julian leap years
- (- (/ (1- year) 100)) ; - century years
- (/ (1- year) 400)))) ; + Gregorian leap years
-
-(defun time-to-number-of-days (time)
- "Return the number of days represented by TIME.
-The number of days will be returned as a floating point number."
- (/ (time-to-seconds time) (* 60 60 24)))
-
-;;;###autoload
-(defun safe-date-to-time (date)
- "Parse a string that represents a date-time and return a time value.
-If DATE is malformed, return a time value of zeros."
- (condition-case ()
- (date-to-time date)
- (error '(0 0))))
-
-(provide 'time-date)
-
-;;; arch-tag: addcf07b-b20a-465b-af72-550b8ac5190f
-;;; time-date.el ends here
+++ /dev/null
-;;; utf7.el --- UTF-7 encoding/decoding for Emacs -*-coding: iso-8859-1;-*-
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Jon K Hellan <hellan@acm.org>
-;; Maintainer: bugs@gnus.org
-;; Keywords: mail
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; UTF-7 - A Mail-Safe Transformation Format of Unicode - RFC 2152
-;; This is a transformation format of Unicode that contains only 7-bit
-;; ASCII octets and is intended to be readable by humans in the limiting
-;; case that the document consists of characters from the US-ASCII
-;; repertoire.
-;; In short, runs of characters outside US-ASCII are encoded as base64
-;; inside delimiters.
-;; A variation of UTF-7 is specified in IMAP 4rev1 (RFC 2060) as the way
-;; to represent characters outside US-ASCII in mailbox names in IMAP.
-;; This library supports both variants, but the IMAP variation was the
-;; reason I wrote it.
-;; The routines convert UTF-7 -> UTF-16 (16 bit encoding of Unicode)
-;; -> current character set, and vice versa.
-;; However, until Emacs supports Unicode, the only Emacs character set
-;; supported here is ISO-8859.1, which can trivially be converted to/from
-;; Unicode.
-;; When decoding results in a character outside the Emacs character set,
-;; an error is thrown. It is up to the application to recover.
-
-;; UTF-7 should be done by providing a coding system. Mule-UCS does
-;; already, but I don't know if it does the IMAP version and it's not
-;; clear whether that should really be a coding system. The UTF-16
-;; part of the conversion can be done with coding systems available
-;; with Mule-UCS or some versions of Emacs. Unfortunately these were
-;; done wrongly (regarding handling of byte-order marks and how the
-;; variants were named), so we don't have a consistent name for the
-;; necessary coding system. The code below doesn't seem to DTRT
-;; generally. E.g.:
-;;
-;; (utf7-encode "a+£")
-;; => "a+ACsAow-"
-;;
-;; $ echo "a+£"|iconv -f iso-8859-1 -t utf-7
-;; a+-+AKM
-;;
-;; -- fx
-
-
-;;; Code:
-
-(require 'base64)
-(eval-when-compile (require 'cl))
-(require 'mm-util)
-
-(defconst utf7-direct-encoding-chars " -%'-*,-[]-}"
- "Character ranges which do not need escaping in UTF-7.")
-
-(defconst utf7-imap-direct-encoding-chars
- (concat utf7-direct-encoding-chars "+\\~")
- "Character ranges which do not need escaping in the IMAP variant of UTF-7.")
-
-(defconst utf7-utf-16-coding-system
- (cond ((mm-coding-system-p 'utf-16-be-no-signature) ; Mule-UCS
- 'utf-16-be-no-signature)
- ((and (mm-coding-system-p 'utf-16-be) ; Emacs 21.3, Emacs 22
- ;; Avoid versions with BOM.
- (= 2 (length (encode-coding-string "a" 'utf-16-be))))
- 'utf-16-be)
- ((mm-coding-system-p 'utf-16-be-nosig) ; ?
- 'utf-16-be-nosig))
- "Coding system which encodes big endian UTF-16 without a BOM signature.")
-
-(defsubst utf7-imap-get-pad-length (len modulus)
- "Return required length of padding for IMAP modified base64 fragment."
- (mod (- len) modulus))
-
-(defun utf7-encode-internal (&optional for-imap)
- "Encode text in (temporary) buffer as UTF-7.
-Use IMAP modification if FOR-IMAP is non-nil."
- (let ((start (point-min))
- (end (point-max)))
- (narrow-to-region start end)
- (goto-char start)
- (let* ((esc-char (if for-imap ?& ?+))
- (direct-encoding-chars
- (if for-imap utf7-imap-direct-encoding-chars
- utf7-direct-encoding-chars))
- (not-direct-encoding-chars (concat "^" direct-encoding-chars)))
- (while (not (eobp))
- (skip-chars-forward direct-encoding-chars)
- (unless (eobp)
- (insert esc-char)
- (let ((p (point))
- (fc (following-char))
- (run-length
- (skip-chars-forward not-direct-encoding-chars)))
- (if (and (= fc esc-char)
- (= run-length 1)) ; Lone esc-char?
- (delete-backward-char 1) ; Now there's one too many
- (utf7-fragment-encode p (point) for-imap))
- (insert "-")))))))
-
-(defun utf7-fragment-encode (start end &optional for-imap)
- "Encode text from START to END in buffer as UTF-7 escape fragment.
-Use IMAP modification if FOR-IMAP is non-nil."
- (save-restriction
- (narrow-to-region start end)
- (funcall (utf7-get-u16char-converter 'to-utf-16))
- (mm-with-unibyte-current-buffer
- (base64-encode-region start (point-max)))
- (goto-char start)
- (let ((pm (point-max)))
- (when for-imap
- (while (search-forward "/" nil t)
- (replace-match ",")))
- (skip-chars-forward "^= \t\n" pm)
- (delete-region (point) pm))))
-
-(defun utf7-decode-internal (&optional for-imap)
- "Decode UTF-7 text in (temporary) buffer.
-Use IMAP modification if FOR-IMAP is non-nil."
- (let ((start (point-min))
- (end (point-max)))
- (goto-char start)
- (let* ((esc-pattern (concat "^" (char-to-string (if for-imap ?& ?+))))
- (base64-chars (concat "A-Za-z0-9+"
- (char-to-string (if for-imap ?, ?/)))))
- (while (not (eobp))
- (skip-chars-forward esc-pattern)
- (unless (eobp)
- (forward-char)
- (let ((p (point))
- (run-length (skip-chars-forward base64-chars)))
- (when (and (not (eobp)) (= (following-char) ?-))
- (delete-char 1))
- (unless (= run-length 0) ; Encoded lone esc-char?
- (save-excursion
- (utf7-fragment-decode p (point) for-imap)
- (goto-char p)
- (delete-backward-char 1)))))))))
-
-(defun utf7-fragment-decode (start end &optional for-imap)
- "Decode base64 encoded fragment from START to END of UTF-7 text in buffer.
-Use IMAP modification if FOR-IMAP is non-nil."
- (save-restriction
- (narrow-to-region start end)
- (when for-imap
- (goto-char start)
- (while (search-forward "," nil 'move-to-end) (replace-match "/")))
- (let ((pl (utf7-imap-get-pad-length (- end start) 4)))
- (insert (make-string pl ?=))
- (base64-decode-region start (+ end pl)))
- (funcall (utf7-get-u16char-converter 'from-utf-16))))
-
-(defun utf7-get-u16char-converter (which-way)
- "Return a function to convert between UTF-16 and current character set."
- (if utf7-utf-16-coding-system
- (if (eq which-way 'to-utf-16)
- (lambda ()
- (encode-coding-region (point-min) (point-max)
- utf7-utf-16-coding-system))
- (lambda ()
- (decode-coding-region (point-min) (point-max)
- utf7-utf-16-coding-system)))
- ;; Add test to check if we are really Latin-1.
- (if (eq which-way 'to-utf-16)
- 'utf7-latin1-u16-char-converter
- 'utf7-u16-latin1-char-converter)))
-
-(defun utf7-latin1-u16-char-converter ()
- "Convert latin 1 (ISO-8859.1) characters to 16 bit Unicode.
-Characters are converted to raw byte pairs in narrowed buffer."
- (mm-encode-coding-region (point-min) (point-max) 'iso-8859-1)
- (mm-disable-multibyte)
- (goto-char (point-min))
- (while (not (eobp))
- (insert 0)
- (forward-char)))
-
-(defun utf7-u16-latin1-char-converter ()
- "Convert 16 bit Unicode characters to latin 1 (ISO-8859.1).
-Characters are in raw byte pairs in narrowed buffer."
- (goto-char (point-min))
- (while (not (eobp))
- (if (= 0 (following-char))
- (delete-char 1)
- (error "Unable to convert from Unicode"))
- (forward-char))
- (mm-decode-coding-region (point-min) (point-max) 'iso-8859-1)
- (mm-enable-multibyte))
-
-(defun utf7-encode (string &optional for-imap)
- "Encode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil."
- (let ((default-enable-multibyte-characters t))
- (with-temp-buffer
- (insert string)
- (utf7-encode-internal for-imap)
- (buffer-string))))
-
-(defun utf7-decode (string &optional for-imap)
- "Decode UTF-7 STRING. Use IMAP modification if FOR-IMAP is non-nil."
- (let ((default-enable-multibyte-characters nil))
- (with-temp-buffer
- (insert string)
- (utf7-decode-internal for-imap)
- (mm-enable-multibyte)
- (buffer-string))))
-
-(provide 'utf7)
-
-;;; arch-tag: 96078b55-85c7-4161-aed2-932c24b282c7
-;;; utf7.el ends here
+++ /dev/null
-;;; uudecode.el -- elisp native uudecode
-
-;; Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: uudecode 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(autoload 'executable-find "executable")
-
-(eval-when-compile (require 'cl))
-
-(eval-and-compile
- (defalias 'uudecode-char-int
- (if (fboundp 'char-int)
- 'char-int
- 'identity)))
-
-(defcustom uudecode-decoder-program "uudecode"
- "*Non-nil value should be a string that names a uu decoder.
-The program should expect to read uu data on its standard
-input and write the converted data to its standard output."
- :type 'string
- :group 'gnus-extract)
-
-(defcustom uudecode-decoder-switches nil
- "*List of command line flags passed to `uudecode-decoder-program'."
- :group 'gnus-extract
- :type '(repeat string))
-
-(defcustom uudecode-use-external
- (executable-find uudecode-decoder-program)
- "*Use external uudecode program."
- :version "22.1"
- :group 'gnus-extract
- :type 'boolean)
-
-(defconst uudecode-alphabet "\040-\140")
-
-(defconst uudecode-begin-line "^begin[ \t]+[0-7][0-7][0-7][ \t]+\\(.*\\)$")
-(defconst uudecode-end-line "^end[ \t]*$")
-
-(defconst uudecode-body-line
- (let ((i 61) (str "^M"))
- (while (> (setq i (1- i)) 0)
- (setq str (concat str "[^a-z]")))
- (concat str ".?$")))
-
-(defvar uudecode-temporary-file-directory
- (cond ((fboundp 'temp-directory) (temp-directory))
- ((boundp 'temporary-file-directory) temporary-file-directory)
- ("/tmp")))
-
-;;;###autoload
-(defun uudecode-decode-region-external (start end &optional file-name)
- "Uudecode region between START and END using external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME. The program
-used is specified by `uudecode-decoder-program'."
- (interactive "r\nP")
- (let ((cbuf (current-buffer)) tempfile firstline status)
- (save-excursion
- (goto-char start)
- (when (re-search-forward uudecode-begin-line nil t)
- (forward-line 1)
- (setq firstline (point))
- (cond ((null file-name))
- ((stringp file-name))
- (t
- (setq file-name (read-file-name "File to Name:"
- nil nil nil
- (match-string 1)))))
- (setq tempfile (if file-name
- (expand-file-name file-name)
- (if (fboundp 'make-temp-file)
- (let ((temporary-file-directory
- uudecode-temporary-file-directory))
- (make-temp-file "uu"))
- (expand-file-name
- (make-temp-name "uu")
- uudecode-temporary-file-directory))))
- (let ((cdir default-directory)
- (default-process-coding-system
- (if (featurep 'xemacs)
- ;; In XEmacs, `nil' is not a valid coding system.
- '(binary . binary)
- nil)))
- (unwind-protect
- (with-temp-buffer
- (insert "begin 600 " (file-name-nondirectory tempfile) "\n")
- (insert-buffer-substring cbuf firstline end)
- (cd (file-name-directory tempfile))
- (apply 'call-process-region
- (point-min)
- (point-max)
- uudecode-decoder-program
- nil
- nil
- nil
- uudecode-decoder-switches))
- (cd cdir) (set-buffer cbuf)))
- (if (file-exists-p tempfile)
- (unless file-name
- (goto-char start)
- (delete-region start end)
- (let (format-alist)
- (insert-file-contents-literally tempfile)))
- (message "Can not uudecode")))
- (ignore-errors (or file-name (delete-file tempfile))))))
-
-(eval-and-compile
- (defalias 'uudecode-string-to-multibyte
- (cond
- ((featurep 'xemacs)
- 'identity)
- ((fboundp 'string-to-multibyte)
- 'string-to-multibyte)
- (t
- (lambda (string)
- "Return a multibyte string with the same individual chars as string."
- (mapconcat
- (lambda (ch) (string-as-multibyte (char-to-string ch)))
- string ""))))))
-
-;;;###autoload
-(defun uudecode-decode-region-internal (start end &optional file-name)
- "Uudecode region between START and END without using an external program.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
- (interactive "r\nP")
- (let ((done nil)
- (counter 0)
- (remain 0)
- (bits 0)
- (lim 0) inputpos result
- (non-data-chars (concat "^" uudecode-alphabet)))
- (save-excursion
- (goto-char start)
- (when (re-search-forward uudecode-begin-line nil t)
- (cond ((null file-name))
- ((stringp file-name))
- (t
- (setq file-name (expand-file-name
- (read-file-name "File to Name:"
- nil nil nil
- (match-string 1))))))
- (forward-line 1)
- (skip-chars-forward non-data-chars end)
- (while (not done)
- (setq inputpos (point))
- (setq remain 0 bits 0 counter 0)
- (cond
- ((> (skip-chars-forward uudecode-alphabet end) 0)
- (setq lim (point))
- (setq remain
- (logand (- (uudecode-char-int (char-after inputpos)) 32)
- 63))
- (setq inputpos (1+ inputpos))
- (if (= remain 0) (setq done t))
- (while (and (< inputpos lim) (> remain 0))
- (setq bits (+ bits
- (logand
- (-
- (uudecode-char-int (char-after inputpos)) 32)
- 63)))
- (if (/= counter 0) (setq remain (1- remain)))
- (setq counter (1+ counter)
- inputpos (1+ inputpos))
- (cond ((= counter 4)
- (setq result (cons
- (concat
- (char-to-string (lsh bits -16))
- (char-to-string (logand (lsh bits -8) 255))
- (char-to-string (logand bits 255)))
- result))
- (setq bits 0 counter 0))
- (t (setq bits (lsh bits 6)))))))
- (cond
- (done)
- ((> 0 remain)
- (error "uucode line ends unexpectly")
- (setq done t))
- ((and (= (point) end) (not done))
- ;;(error "uucode ends unexpectly")
- (setq done t))
- ((= counter 3)
- (setq result (cons
- (concat
- (char-to-string (logand (lsh bits -16) 255))
- (char-to-string (logand (lsh bits -8) 255)))
- result)))
- ((= counter 2)
- (setq result (cons
- (char-to-string (logand (lsh bits -10) 255))
- result))))
- (skip-chars-forward non-data-chars end))
- (if file-name
- (let (default-enable-multibyte-characters)
- (with-temp-file file-name
- (insert (apply 'concat (nreverse result)))))
- (or (markerp end) (setq end (set-marker (make-marker) end)))
- (goto-char start)
- (if enable-multibyte-characters
- (mapc #'(lambda (x) (insert (uudecode-string-to-multibyte x)))
- (nreverse result))
- (insert (apply 'concat (nreverse result))))
- (delete-region (point) end))))))
-
-;;;###autoload
-(defun uudecode-decode-region (start end &optional file-name)
- "Uudecode region between START and END.
-If FILE-NAME is non-nil, save the result to FILE-NAME."
- (if uudecode-use-external
- (uudecode-decode-region-external start end file-name)
- (uudecode-decode-region-internal start end file-name)))
-
-(provide 'uudecode)
-
-;;; arch-tag: e1f09ed5-62b4-4677-9f13-4e81c4fe8ce3
-;;; uudecode.el ends here
+++ /dev/null
-;;; vcard.el --- vcard parsing and display routines
-
-;; Copyright (C) 1997 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@splode.com>
-;; Maintainer: friedman@splode.com
-;; Keywords: extensions
-;; Created: 1997-09-27
-
-;; This program 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 3, or (at your option)
-;; any later version.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; The display routines here are just an example. The primitives in the
-;; first section can be used to construct other vcard formatters.
-
-;;; Code:
-
-(defvar vcard-standard-filters '(vcard-filter-html)
- "*Standard list of filters to apply to parsed vcard data.
-These filters are applied sequentially to vcard data records when
-the function `vcard-standard-filter' is supplied as the second argument to
-`vcard-parse-string'.")
-
-(defun vcard-parse-string (raw &optional filter)
- "Parse RAW vcard data as a string, and return an alist representing data.
-
-If the optional function FILTER is specified, apply that filter to the
-data record of each key before splitting fields. Filters should accept
-two arguments: the key and the data. They are expected to operate on
-\(and return\) a modified data value.
-
-Vcard data is normally in the form
-
- begin: vcard
- key1: field
- key2;subkey1: field
- key2;subkey2: field1;field2;field3
- end: vcard
-
-\(Whitespace after the colon separating the key and field is optional.\)
-If supplied to this function an alist of the form
-
- ((\"key1\" \"field\")
- (\"key2\"
- (\"subkey2\" \"field1\" \"field2\" \"field3\")
- (\"subkey1\" \"field\")))
-
-would be returned."
- (save-match-data
- (let ((raw-pos 0)
- (vcard-data nil)
- key data)
- (string-match "^[ \t]*begin:[ \t]*vcard[ \t]*[\r\n]+" raw raw-pos)
- (setq raw-pos (match-end 0))
- (while (and (< raw-pos (length raw))
- (string-match
- "^[ \t]*\\([^:]+\\):[ \t]*\\(.*\\)[ \t]*[\n\r]+"
- raw raw-pos))
- (setq key (vcard-matching-substring 1 raw))
- (setq data (vcard-matching-substring 2 raw))
- (setq raw-pos (match-end 0))
- (cond
- ((string= key "end")
- (setq raw-pos (length raw)))
- (t
- (and filter
- (setq data (funcall filter key data)))
- (setq vcard-data
- (vcard-set-alist-slot vcard-data
- (vcard-split-string key ";")
- (vcard-split-string data ";"))))))
- (nreverse vcard-data))))
-
-(defun vcard-ref (key vcard-data)
- "Return the vcard data associated with KEY in VCARD-DATA.
-Key may be a list of nested keys or a single string of colon-separated
-keys."
- (cond ((listp key)
- (vcard-alist-assoc key vcard-data))
- ((and (stringp key)
- (save-match-data
- (string-match ";" key)))
- (vcard-alist-assoc (vcard-split-string key ";") vcard-data))
- ((stringp key)
- (cdr (assoc key vcard-data)))))
-
-\f
-;;; Vcard data filters.
-
-;; These receive both the key and data, but are expected to operate on (and
-;; return) just the data.
-;;
-;; There is probably no overwhelming need for this, except that some lusers
-;; put HTML in their vcards under the misguided notion that it's a standard
-;; feature of vcards just because Netscape supports this feature. (Or
-;; perhaps those lusers just don't care that their vcards look like shit in
-;; every other MUA).
-;;
-;; On the other hand, perhaps someone will devise some other use for these
-;; filters, such as noticing common phone number formats and re-formatting
-;; them to fit personal preferences.
-
-(defun vcard-filter-apply-filter-list (filter-list key data)
- (while filter-list
- (setq data (funcall (car filter-list) key data))
- (setq filter-list (cdr filter-list)))
- data)
-
-(defun vcard-standard-filter (key data)
- (vcard-filter-apply-filter-list vcard-standard-filters key data))
-
-(defun vcard-filter-html (key data)
- (save-match-data
- (while (string-match "<[^<>\n]+>" data)
- (setq data (concat (substring data 0 (match-beginning 0))
- (substring data (match-end 0)))))
- data))
-
-\f
-;;; Utility routines.
-
-;; This does most of the dirty work of key lookup for vcard-ref.
-(defun vcard-alist-assoc (keys alist)
- (while (and keys alist)
- (setq alist (cdr (assoc (car keys) alist)))
- (setq keys (cdr keys)))
- alist)
-
-;; In ALIST, set KEY-LIST's value to VALUE, and return new value of ALIST.
-;; KEY-LIST should be a list of nested keys, if ALIST is an alist of alists.
-;; If any key is not present in an alist, the key and value pair will be
-;; inserted into the parent alist.
-(defun vcard-set-alist-slot (alist key-list value)
- (let* ((key (car key-list))
- (elt (assoc key alist)))
- (setq key-list (cdr key-list))
- (cond ((and (cdr elt) key-list)
- (vcard-set-alist-slot (cdr elt) key-list value))
- ((and elt key-list)
- (setcdr elt (vcard-set-alist-slot nil key-list value)))
- (elt (setcdr elt value))
- (t
- (let ((new))
- (setq key-list (nreverse (cons key key-list)))
- (while key-list
- (if new
- (setq new (cons (car key-list) (cons new nil)))
- (setq new (cons (car key-list) value)))
- (setq key-list (cdr key-list)))
-
- (cond ((null alist)
- (setq alist (cons new nil)))
- (t
- (setcdr alist (cons (car alist) (cdr alist)))
- (setcar alist new))))))
- alist))
-
-;; Return substring matched by last search.
-;; N specifies which match data pair to use
-;; Value is nil if there is no Nth match.
-;; If STRING is not specified, the current buffer is used.
-(defun vcard-matching-substring (n &optional string)
- (if (match-beginning n)
- (if string
- (substring string (match-beginning n) (match-end n))
- (buffer-substring (match-beginning n) (match-end n)))))
-
-;; Split STRING at occurences of SEPARATOR. Return a list of substrings.
-;; SEPARATOR can be any regexp, but anything matching the separator will
-;; never appear in any of the returned substrings.
-(defun vcard-split-string (string separator)
- (let* ((list nil)
- (pos 0))
- (save-match-data
- (while (string-match separator string pos)
- (setq list (cons (substring string pos (match-beginning 0)) list))
- (setq pos (match-end 0)))
- (nreverse (cons (substring string pos) list)))))
-
-(defun vcard-flatten (l)
- (if (consp l)
- (apply 'nconc (mapcar 'vcard-flatten l))
- (list l)))
-
-\f
-;;; Sample formatting routines.
-
-(defun vcard-format-box (vcard-data)
- "Like `vcard-format-string', but put an ascii box around text."
- (let* ((lines (vcard-format-lines vcard-data))
- (len (vcard-format-max-length lines))
- (edge (concat "\n+" (make-string (+ len 2) ?-) "+\n"))
- (line-fmt (format "| %%-%ds |" len))
- (formatted-lines
- (mapconcat (function (lambda (s) (format line-fmt s))) lines "\n")))
- (if (string= formatted-lines "")
- formatted-lines
- (concat edge formatted-lines edge))))
-
-(defun vcard-format-string (vcard-data)
- "Format VCARD-DATA into a string suitable for presentation.
-VCARD-DATA should be a parsed vcard alist. The result is a string
-with formatted vcard information which can be inserted into a mime
-presentation buffer."
- (mapconcat 'identity (vcard-format-lines vcard-data) "\n"))
-
-(defun vcard-format-lines (vcard-data)
- (let* ((name (vcard-format-get-name vcard-data))
- (title (vcard-format-ref "title" vcard-data))
- (org (vcard-format-ref "org" vcard-data))
- (addr (vcard-format-get-address vcard-data))
- (tel (vcard-format-get-telephone vcard-data))
- (lines (delete nil (vcard-flatten (list name title org addr))))
- (col-template (format "%%-%ds%%s"
- (vcard-format-offset lines tel)))
- (l lines))
- (while tel
- (setcar l (format col-template (car l) (car tel)))
- ;; If we stripped away too many nil slots from l, add empty strings
- ;; back in so setcar above will work on next iteration.
- (and (cdr tel)
- (null (cdr l))
- (setcdr l (cons "" nil)))
- (setq l (cdr l))
- (setq tel (cdr tel)))
- lines))
-
-
-(defun vcard-format-get-name (vcard-data)
- (let ((name (vcard-format-ref "fn" vcard-data))
- (email (or (vcard-format-ref '("email" "internet") vcard-data)
- (vcard-format-ref "email" vcard-data))))
- (if email
- (format "%s <%s>" name email)
- name)))
-
-(defun vcard-format-get-address (vcard-data)
- (let* ((addr-raw (or (vcard-format-ref '("adr" "dom") vcard-data)
- (vcard-format-ref "adr" vcard-data)))
- (addr (if (consp addr-raw)
- addr-raw
- (list addr-raw)))
- (street (delete "" (list (nth 0 addr) (nth 1 addr) (nth 2 addr))))
- (city-list (delete "" (nthcdr 3 addr)))
- (city (cond ((null (car city-list)) nil)
- ((cdr city-list)
- (format "%s, %s"
- (car city-list)
- (mapconcat 'identity (cdr city-list) " ")))
- (t (car city-list)))))
- (delete nil
- (if city
- (append street (list city))
- street))))
-
-(defun vcard-format-get-telephone (vcard-data)
- (delete nil
- (mapcar (function (lambda (x)
- (let ((result (vcard-format-ref (car x)
- vcard-data)))
- (and result
- (concat (cdr x) result)))))
- '((("tel" "work") . "Work: ")
- (("tel" "home") . "Home: ")
- (("tel" "fax") . "Fax: ")))))
-
-(defun vcard-format-ref (key vcard-data)
- (setq key (vcard-ref key vcard-data))
- (or (cdr key)
- (setq key (car key)))
- (and (stringp key)
- (string= key "")
- (setq key nil))
- key)
-
-(defun vcard-format-offset (row1 row2 &optional maxwidth)
- (or maxwidth (setq maxwidth (frame-width)))
- (let ((max1 (vcard-format-max-length row1))
- (max2 (vcard-format-max-length row2)))
- (+ max1 (min 5 (max 1 (- maxwidth (+ max1 max2)))))))
-
-(defun vcard-format-max-length (strings)
- (let ((maxlen 0)
- (len 0))
- (while strings
- (setq len (length (car strings)))
- (setq strings (cdr strings))
- (and (> len maxlen)
- (setq maxlen len)))
- maxlen))
-
-(provide 'vcard)
-
-;;; arch-tag: 64df032f-e54c-4cfb-9e8c-8bead284f61b
-;;; vcard.el ends here
+++ /dev/null
-;;; webmail.el --- interface of web mail
-
-;; Copyright (C) 1999, 2000, 2001, 2002, 2003, 2004,
-;; 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: hotmail netaddress my-deja netscape
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Note: Now mail.yahoo.com provides POP3 service, the webmail
-;; fetching is not going to be supported.
-
-;; Note: You need to have `url' and `w3' installed for this backend to
-;; work. `w3' must be 4.0pre46+one-line-cookie patch or standalone
-;; `url'.
-
-;; Todo: To support more web mail servers.
-
-;; Known bugs:
-;; 1. Net@ddress may corrupt `X-Face'.
-
-;; Warning:
-;; Webmail is an experimental function, which means NO WARRANTY.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'nnoo)
-(require 'message)
-(require 'gnus-util)
-(require 'gnus)
-(require 'nnmail)
-(require 'mm-util)
-(require 'mm-url)
-(require 'mml)
-(eval-when-compile
- (ignore-errors
- (require 'url)
- (require 'url-cookie)))
-;; Report failure to find w3 at load time if appropriate.
-(eval '(progn
- (require 'url)
- (require 'url-cookie)))
-
-;;;
-
-(defvar webmail-type-definition
- '((hotmail
- ;; Hotmail hate other HTTP user agents and use one line cookie
- (paranoid agent cookie post)
- (address . "www.hotmail.com")
- (open-url "http://www.hotmail.com/")
- (open-snarf . webmail-hotmail-open)
- ;; W3 hate redirect POST
- (login-url
- "http://%s/cgi-bin/dologin?login=%s&passwd=%s&enter=Sign+in&sec=no&curmbox=ACTIVE&_lang=&js=yes&id=2&tw=-10000&beta="
- webmail-aux user password)
- ;;(login-snarf . webmail-hotmail-login)
- ;;(list-url "%s" webmail-aux)
- (list-snarf . webmail-hotmail-list)
- (article-snarf . webmail-hotmail-article)
- (trash-url
- "%s&login=%s&f=33792&curmbox=ACTIVE&_lang=&foo=inbox&js=&page=&%s=on&_HMaction=MoveTo&tobox=trAsH&nullbox="
- webmail-aux user id))
- (yahoo
- (paranoid agent cookie post)
- (address . "mail.yahoo.com")
- (open-url "http://mail.yahoo.com/")
- (open-snarf . webmail-yahoo-open)
- (login-url;; yahoo will not accept GET
- content
- ("%s" webmail-aux)
- ".tries=&.src=ym&.last=&promo=&.intl=&.bypass=&.partner=&.chkP=Y&.done=&login=%s&passwd=%s"
- user password)
- (login-snarf . webmail-yahoo-login)
- (list-url "%s&rb=Inbox&YN=1" webmail-aux)
- (list-snarf . webmail-yahoo-list)
- (article-snarf . webmail-yahoo-article)
- (trash-url
- "%s/ym/ShowFolder?YY=52107&inc=50&order=down&sort=date&pos=0&box=Inbox&DEL=Delete&destBox=&Mid=%s&destBox2="
- webmail-aux id))
- (netaddress
- (paranoid cookie post)
- (address . "www.netaddress.com")
- (open-url "http://www.netaddress.com/")
- (open-snarf . webmail-netaddress-open)
- (login-url
- content
- ("%s" webmail-aux)
- "LoginState=2&SuccessfulLogin=%%2Ftpl&NewServerName=www.netaddress.com&JavaScript=JavaScript1.2&DomainID=4&Domain=usa.net&NA31site=classic.netaddress.com&NA31port=80&UserID=%s&passwd=%s"
- user password)
- (login-snarf . webmail-netaddress-login)
- (list-url
- "http://www.netaddress.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
- webmail-session)
- (list-snarf . webmail-netaddress-list)
- (article-url "http://www.netaddress.com/")
- (article-snarf . webmail-netaddress-article)
- (trash-url
- "http://www.netaddress.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
- webmail-session id))
- (netscape
- (paranoid cookie post agent)
- (address . "webmail.netscape.com")
- (open-url "http://ureg.netscape.com/iiop/UReg2/login/login?U2_LA=en&U2_BACK_FROM_CJ=true&U2_CS=iso-8859-1&U2_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_NEW_ENDURL=http://webmail.netscape.com/tpl/Subscribe/Step1&U2_EXITURL=http://home.netscape.com/&U2_SOURCE=Webmail")
- (open-snarf . webmail-netscape-open)
- (login-url
- content
- ("http://ureg.netscape.com/iiop/UReg2/login/loginform")
- "U2_USERNAME=%s&U2_PASSWORD=%s%s"
- user password webmail-aux)
- (login-snarf . webmail-netaddress-login)
- (list-url
- "http://webmail.netscape.com/tpl/Mail/%s/List?FolderID=-4&SortUseCase=True"
- webmail-session)
- (list-snarf . webmail-netaddress-list)
- (article-url "http://webmail.netscape.com/")
- (article-snarf . webmail-netscape-article)
- (trash-url
- "http://webmail.netscape.com/tpl/Message/%s/Move?FolderID=-4&Q=%s&N=&Sort=Date&F=-1"
- webmail-session id))
- (my-deja
- (paranoid cookie post)
- (address . "www.my-deja.com")
- ;;(open-snarf . webmail-my-deja-open)
- (login-url
- content
- ("http://mydeja.google.com/cgi-bin/deja/maillogin.py")
- "userid=%s&password=%s"
- user password)
- (list-snarf . webmail-my-deja-list)
- (article-snarf . webmail-my-deja-article)
- (trash-url webmail-aux id))))
-
-(defvar webmail-variables
- '(address article-snarf article-url list-snarf list-url
- login-url login-snarf open-url open-snarf site articles
- post-process paranoid trash-url))
-
-(defconst webmail-version "webmail 1.0")
-
-(defvar webmail-newmail-only nil
- "Only fetch new mails.")
-
-(defvar webmail-move-to-trash-can t
- "Move mail to trash can after fetch it.")
-
-;;; Internal variables
-
-(defvar webmail-address nil)
-(defvar webmail-paranoid nil)
-(defvar webmail-aux nil)
-(defvar webmail-session nil)
-(defvar webmail-article-snarf nil)
-(defvar webmail-article-url nil)
-(defvar webmail-list-snarf nil)
-(defvar webmail-list-url nil)
-(defvar webmail-login-url nil)
-(defvar webmail-login-snarf nil)
-(defvar webmail-open-snarf nil)
-(defvar webmail-open-url nil)
-(defvar webmail-trash-url nil)
-(defvar webmail-articles nil)
-(defvar webmail-post-process nil)
-
-(defvar webmail-buffer nil)
-(defvar webmail-buffer-list nil)
-
-(defvar webmail-type nil)
-
-(defvar webmail-error-function nil)
-
-(defvar webmail-debug-file "~/.emacs-webmail-debug")
-
-;;; Interface functions
-
-(defun webmail-debug (str)
- (with-temp-buffer
- (insert "\n---------------- A bug at " str " ------------------\n")
- (mapcar #'(lambda (sym)
- (if (boundp sym)
- (gnus-pp `(setq ,sym ',(eval sym)))))
- '(webmail-type user))
- (insert "---------------- webmail buffer ------------------\n\n")
- (insert-buffer-substring webmail-buffer)
- (insert "\n---------------- end of buffer ------------------\n\n")
- (append-to-file (point-min) (point-max) webmail-debug-file)))
-
-(defun webmail-error (str)
- (if webmail-error-function
- (funcall webmail-error-function str))
- (message "%s HTML has changed or your w3 package is too old.(%s)"
- webmail-type str)
- (error "%s HTML has changed or your w3 package is too old.(%s)"
- webmail-type str))
-
-(defun webmail-setdefault (type)
- (let ((type-def (cdr (assq type webmail-type-definition)))
- (vars webmail-variables)
- pair)
- (setq webmail-type type)
- (dolist (var vars)
- (if (setq pair (assq var type-def))
- (set (intern (concat "webmail-" (symbol-name var))) (cdr pair))
- (set (intern (concat "webmail-" (symbol-name var))) nil)))))
-
-(defun webmail-eval (expr)
- (cond
- ((consp expr)
- (cons (webmail-eval (car expr)) (webmail-eval (cdr expr))))
- ((symbolp expr)
- (eval expr))
- (t
- expr)))
-
-(defun webmail-url (xurl)
- (mm-with-unibyte-current-buffer
- (cond
- ((eq (car xurl) 'content)
- (pop xurl)
- (mm-url-fetch-simple (if (stringp (car xurl))
- (car xurl)
- (apply 'format (webmail-eval (car xurl))))
- (apply 'format (webmail-eval (cdr xurl)))))
- ((eq (car xurl) 'post)
- (pop xurl)
- (mm-url-fetch-form (car xurl) (webmail-eval (cdr xurl))))
- (t
- (mm-url-insert (apply 'format (webmail-eval xurl)))))))
-
-(defun webmail-init ()
- "Initialize buffers and such."
- (if (gnus-buffer-live-p webmail-buffer)
- (set-buffer webmail-buffer)
- (setq webmail-buffer
- (nnheader-set-temp-buffer " *webmail*"))
- (mm-disable-multibyte)))
-
-(defvar url-package-name)
-(defvar url-package-version)
-(defvar url-cookie-multiple-line)
-(defvar url-confirmation-func)
-
-;; Hack W3 POST redirect. See `url-parse-mime-headers'.
-;;
-;; Netscape uses "GET" as redirect method when orignal method is POST
-;; and status is 302, .i.e no security risks by default without
-;; confirmation.
-;;
-;; Some web servers (at least Apache used by yahoo) return status 302
-;; instead of 303, though they mean 303.
-
-(defun webmail-url-confirmation-func (prompt)
- (cond
- ((equal prompt (concat "Honor redirection with non-GET method "
- "(possible security risks)? "))
- nil)
- ((equal prompt "Continue (with method of GET)? ")
- t)
- (t (error prompt))))
-
-(defun webmail-refresh-redirect ()
- "Redirect refresh url in META."
- (goto-char (point-min))
- (while (re-search-forward
- "<meta[ \t\r\n]*http-equiv=\"Refresh\"[^>]*URL=\\([^\"]+\\)\""
- nil t)
- (let ((url (match-string 1)))
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (mm-url-insert url)))
- (goto-char (point-min))))
-
-(defun webmail-fetch (file subtype user password)
- (save-excursion
- (webmail-setdefault subtype)
- (let ((url-package-name (if (memq 'agent webmail-paranoid)
- "Mozilla"
- url-package-name))
- (url-package-version (if (memq 'agent webmail-paranoid)
- "4.0"
- url-package-version))
- (url-cookie-multiple-line (if (memq 'cookie webmail-paranoid)
- nil
- url-cookie-multiple-line))
- (url-confirmation-func (if (memq 'post webmail-paranoid)
- 'webmail-url-confirmation-func
- url-confirmation-func))
- (url-http-silence-on-insecure-redirection t)
- url-cookie-storage url-cookie-secure-storage
- url-cookie-confirmation
- item id (n 0))
- (webmail-init)
- (setq webmail-articles nil)
- (when webmail-open-url
- (erase-buffer)
- (webmail-url webmail-open-url))
- (if webmail-open-snarf (funcall webmail-open-snarf))
- (when webmail-login-url
- (erase-buffer)
- (webmail-url webmail-login-url))
- (if webmail-login-snarf
- (funcall webmail-login-snarf))
- (when webmail-list-url
- (erase-buffer)
- (webmail-url webmail-list-url))
- (if webmail-list-snarf
- (funcall webmail-list-snarf))
- (while (setq item (pop webmail-articles))
- (message "Fetching mail #%d..." (setq n (1+ n)))
- (erase-buffer)
- (mm-with-unibyte-current-buffer
- (mm-url-insert (cdr item)))
- (setq id (car item))
- (if webmail-article-snarf
- (funcall webmail-article-snarf file id))
- (when (and webmail-trash-url webmail-move-to-trash-can)
- (message "Move mail #%d to trash can..." n)
- (condition-case err
- (progn
- (webmail-url webmail-trash-url)
- (let (buf)
- (while (setq buf (pop webmail-buffer-list))
- (kill-buffer buf))))
- (error
- (let (buf)
- (while (setq buf (pop webmail-buffer-list))
- (kill-buffer buf)))
- (error err))))))
- (if webmail-post-process
- (funcall webmail-post-process))))
-
-(defun webmail-encode-8bit ()
- (goto-char (point-min))
- (skip-chars-forward "^\200-\377")
- (while (not (eobp))
- (insert (format "&%d;" (mm-char-int (char-after))))
- (delete-char 1)
- (skip-chars-forward "^\200-\377")))
-
-;;; hotmail
-
-(defun webmail-hotmail-open ()
- (goto-char (point-min))
- (if (re-search-forward
- "action=\"https?://\\([^/]+\\)/cgi-bin/dologin" nil t)
- (setq webmail-aux (match-string 1))
- (webmail-error "open@1")))
-
-(defun webmail-hotmail-login ()
- (let (site)
- (goto-char (point-min))
- (if (re-search-forward
- "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
- (setq site (match-string 1))
- (webmail-error "login@1"))
- (goto-char (point-min))
- (if (re-search-forward
- "\\(/cgi-bin/HoTMaiL\\?[^\"]*a=b[^\"]*\\)" nil t)
- (setq webmail-aux (concat "http://" site (match-string 1)))
- (webmail-error "login@2"))))
-
-(defun webmail-hotmail-list ()
- (goto-char (point-min))
- (skip-chars-forward " \t\n\r")
- (let (site url newp (total "0"))
- (if (eobp)
- (setq total "0")
- (if (re-search-forward "\\([0-9]+\\) *<b>(\\([0-9]+\\) new)" nil t)
- (message "Found %s (%s new)" (setq total (match-string 1))
- (match-string 2))
- (if (re-search-forward "\\([0-9]+\\) new" nil t)
- (message "Found %s new" (setq total (match-string 1)))
- (webmail-error "list@0"))))
- (unless (equal total "0")
- (goto-char (point-min))
- (if (re-search-forward
- "https?://\\([^/]+hotmail\\.msn\\.com\\)/cgi-bin/" nil t)
- (setq site (match-string 1))
- (webmail-error "list@1"))
- (goto-char (point-min))
- (if (re-search-forward "disk=\\([^&]*\\)&" nil t)
- (setq webmail-aux
- (concat "http://" site "/cgi-bin/HoTMaiL?disk="
- (match-string 1)))
- (webmail-error "list@2"))
- (goto-char (point-max))
- (while (re-search-backward
- "newmail\\.gif\\|href=\"\\(/cgi-bin/getmsg\\?[^\"]+\\)\""
- nil t)
- (if (setq url (match-string 1))
- (progn
- (if (or newp (not webmail-newmail-only))
- (let (id)
- (if (string-match "msg=\\([^&]+\\)" url)
- (setq id (match-string 1 url)))
- (push (cons id (concat "http://" site url "&raw=0"))
- webmail-articles)))
- (setq newp nil))
- (setq newp t))))))
-
-;; Thank victor@idaccr.org (Victor S. Miller) for raw=0
-
-(defun webmail-hotmail-article (file id)
- (goto-char (point-min))
- (skip-chars-forward " \t\n\r")
- (unless (eobp)
- (if (not (search-forward "<pre>" nil t))
- (webmail-error "article@3"))
- (skip-chars-forward "\n\r\t ")
- (delete-region (point-min) (point))
- (if (not (search-forward "</pre>" nil t))
- (webmail-error "article@3.1"))
- (delete-region (match-beginning 0) (point-max))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (while (re-search-forward "\r\n?" nil t)
- (replace-match "\n"))
- (goto-char (point-min))
- (insert "\n\n")
- (if (not (looking-at "\n*From "))
- (insert "From nobody " (current-time-string) "\n")
- (forward-line))
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (mm-append-to-file (point-min) (point-max) file)))
-
-(defun webmail-hotmail-article-old (file id)
- (let (p attachment count mime hotmail-direct)
- (save-restriction
- (webmail-encode-8bit)
- (goto-char (point-min))
- (if (not (search-forward "<DIV>" nil t))
- (if (not (search-forward "Reply All" nil t))
- (webmail-error "article@1")
- (setq hotmail-direct t))
- (goto-char (match-beginning 0)))
- (narrow-to-region (point-min) (point))
- (if (not (search-backward "<table" nil t 2))
- (webmail-error "article@1.1"))
- (delete-region (point-min) (match-beginning 0))
- (while (search-forward "<a href=" nil t)
- (setq p (match-beginning 0))
- (search-forward "</a>" nil t)
- (delete-region p (match-end 0)))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-min))
- (when (search-forward "\n\n" nil t)
- (backward-char)
- (delete-region (point) (point-max)))
- (goto-char (point-max))
- (widen)
- (insert "\n")
- (setq p (point))
- (while (re-search-forward
- "<tt>\\|<div>\\|\\(http://[^/]+/cgi-bin/getmsg/\\([^\?]+\\)\?[^\"]*\\)\""
- nil t)
- (if (setq attachment (match-string 1))
- (let ((filename (match-string 2))
- bufname);; Attachment
- (delete-region p (match-end 0))
- (save-excursion
- (set-buffer (generate-new-buffer " *webmail-att*"))
- (mm-url-insert attachment)
- (push (current-buffer) webmail-buffer-list)
- (setq bufname (buffer-name)))
- (setq mime t)
- (insert "<#part type="
- (or (and filename
- (string-match "\\.[^\\.]+$" filename)
- (mailcap-extension-to-mime
- (match-string 0 filename)))
- "application/octet-stream"))
- (insert " buffer=\"" bufname "\"")
- (insert " filename=\"" filename "\"")
- (insert " disposition=\"inline\"")
- (insert "><#/part>\n")
- (setq p (point)))
- (delete-region p (match-end 0))
- (if hotmail-direct
- (if (not (search-forward "</tt>" nil t))
- (webmail-error "article@1.2")
- (delete-region (match-beginning 0) (match-end 0)))
- (setq count 1)
- (while (and (> count 0)
- (re-search-forward "</div>\\|\\(<div>\\)" nil t))
- (if (match-string 1)
- (setq count (1+ count))
- (if (= (setq count (1- count)) 0)
- (delete-region (match-beginning 0)
- (match-end 0))))))
- (narrow-to-region p (point))
- (goto-char (point-min))
- (cond
- ((looking-at "<pre>")
- (goto-char (match-end 0))
- (if (looking-at "$") (forward-char))
- (delete-region (point-min) (point))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- nil)
- (t
- (setq mime t)
- (insert "<#part type=\"text/html\" disposition=inline>")
- (goto-char (point-max))
- (insert "<#/part>")))
- (goto-char (point-max))
- (setq p (point))
- (widen)))
- (delete-region p (point-max))
- (goto-char (point-min))
- ;; Some blank line to seperate mails.
- (insert "\n\nFrom nobody " (current-time-string) "\n")
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (if id
- (insert (format "X-Message-ID: <%s@hotmail.com>\n" id)))
- (unless (looking-at "$")
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (webmail-error "article@2")))
- (narrow-to-region (point) (point-max))
- (if mime
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max)))))
- (goto-char (point-min))
- (widen)
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">"))))
- (mm-append-to-file (point-min) (point-max) file)))
-
-;;; yahoo
-
-(defun webmail-yahoo-open ()
- (goto-char (point-min))
- (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
- (setq webmail-aux (match-string 1))
- (webmail-error "open@1")))
-
-(defun webmail-yahoo-login ()
- (goto-char (point-min))
- (if (re-search-forward "http://[^/]+[0-9]\\.mail\\.yahoo\\.com/" nil t)
- (setq webmail-aux (match-string 0))
- (webmail-error "login@1"))
- (if (re-search-forward "YY=[0-9]+" nil t)
- (setq webmail-aux (concat webmail-aux "ym/ShowFolder?"
- (match-string 0)))
- (webmail-error "login@2")))
-
-(defun webmail-yahoo-list ()
- (let (url (newp t) (tofetch 0))
- (goto-char (point-min))
- (when (re-search-forward
- "showing [0-9]+-\\([0-9]+\\) of \\([0-9]+\\)" nil t)
- ;;(setq listed (match-string 1))
- (message "Found %s mail(s)" (match-string 2)))
- (if (string-match "http://[^/]+" webmail-aux)
- (setq webmail-aux (match-string 0 webmail-aux))
- (webmail-error "list@1"))
- (goto-char (point-min))
- (while (re-search-forward
- "bgcolor=\"#eeeeee\"\\|href=\"\\(/ym/ShowLetter\\?MsgId=\\([^&]+\\)&[^\"]*\\)\""
- nil t)
- (if (setq url (match-string 1))
- (progn
- (when (or newp (not webmail-newmail-only))
- (push (cons (match-string 2) (concat webmail-aux url "&toc=1"))
- webmail-articles)
- (setq tofetch (1+ tofetch)))
- (setq newp t))
- (setq newp nil)))
- (setq webmail-articles (nreverse webmail-articles))
- (message "Fetching %d mail(s)" tofetch)))
-
-(defun webmail-yahoo-article (file id)
- (let (p attachment)
- (save-restriction
- (goto-char (point-min))
- (if (not (search-forward "value=\"Done\"" nil t))
- (webmail-error "article@1"))
- (if (not (search-forward "<table" nil t))
- (webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
- (if (not (search-forward "</table>" nil t))
- (webmail-error "article@3"))
- (narrow-to-region (point-min) (match-end 0))
- (while (search-forward "<a href=" nil t)
- (setq p (match-beginning 0))
- (search-forward "</a>" nil t)
- (delete-region p (match-end 0)))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-max))
- (widen)
- (insert "\n")
- (setq p (point))
- (while (re-search-forward "[^\"]*/ShowLetter/[^\?]+\?[^\"]*" nil t)
- (setq attachment (match-string 0))
- (let (bufname ct ctl cd description)
- (if (not (search-forward "<table" nil t))
- (webmail-error "article@4"))
- (delete-region p (match-beginning 0))
- (if (not (search-forward "</table>" nil t))
- (webmail-error "article@5"))
- (narrow-to-region p (match-end 0))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (delete-blank-lines)
- (setq ct (mail-fetch-field "content-type")
- ctl (and ct (mail-header-parse-content-type ct))
- ;;cte (mail-fetch-field "content-transfer-encoding")
- cd (mail-fetch-field "content-disposition")
- description (mail-fetch-field "content-description")
- id (mail-fetch-field "content-id"))
- (delete-region (point-min) (point-max))
- (widen)
- (save-excursion
- (set-buffer (generate-new-buffer " *webmail-att*"))
- (mm-url-insert (concat webmail-aux attachment))
- (push (current-buffer) webmail-buffer-list)
- (setq bufname (buffer-name)))
- (insert "<#part")
- (if (and ctl (not (equal (car ctl) "text/")))
- (insert " type=\"" (car ctl) "\""))
- (insert " buffer=\"" bufname "\"")
- (if cd
- (insert " disposition=\"" cd "\""))
- (if description
- (insert " description=\"" description "\""))
- (insert "><#/part>\n")
- (setq p (point))))
- (delete-region p (point-max))
- (goto-char (point-min))
- ;; Some blank line to seperate mails.
- (insert "\n\nFrom nobody " (current-time-string) "\n")
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (if id
- (insert (format "X-Message-ID: <%s@yahoo.com>\n" id)))
- (unless (looking-at "$")
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (webmail-error "article@2")))
- (narrow-to-region (point) (point-max))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max))))
- (goto-char (point-min))
- (widen)
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">"))))
- (mm-append-to-file (point-min) (point-max) file)))
-
-;;; netaddress
-
-(defun webmail-netscape-open ()
- (goto-char (point-min))
- (setq webmail-aux "")
- (while (re-search-forward
- "TYPE=hidden *NAME=\\([^ ]+\\) *VALUE=\"\\([^\"]+\\)"
- nil t)
- (setq webmail-aux (concat webmail-aux "&" (match-string 1) "="
- (match-string 2)))))
-
-(defun webmail-netaddress-open ()
- (goto-char (point-min))
- (if (re-search-forward "action=\"\\([^\"]+\\)\"" nil t)
- (setq webmail-aux (concat (car webmail-open-url) (match-string 1)))
- (webmail-error "open@1")))
-
-(defun webmail-netaddress-login ()
- (webmail-refresh-redirect)
- (goto-char (point-min))
- (if (re-search-forward "tpl/[^/]+/\\([^/]+\\)" nil t)
- (setq webmail-session (match-string 1))
- (webmail-error "login@1")))
-
-(defun webmail-netaddress-list ()
- (webmail-refresh-redirect)
- (let (item id)
- (goto-char (point-min))
- (when (re-search-forward
- "(\\([0-9]+\\) unread, \\([0-9]+\\) total)" nil t)
- (message "Found %s mail(s), %s unread"
- (match-string 2) (match-string 1)))
- (goto-char (point-min))
- (while (re-search-forward
- "MR\\[i\\]\\.R='\\([^']*\\)'\\|MR\\[i\\]\\.Q='\\([^']+\\)'" nil t)
- (if (setq id (match-string 2))
- (setq item
- (cons id
- (format "%s/tpl/Message/%s/Read?Q=%s&FolderID=-4&SortUseCase=True&Sort=Date&Headers=True"
- (car webmail-article-url)
- webmail-session id)))
- (if (or (not webmail-newmail-only)
- (equal (match-string 1) "True"))
- (push item webmail-articles))))
- (setq webmail-articles (nreverse webmail-articles))))
-
-(defun webmail-netaddress-single-part ()
- (goto-char (point-min))
- (cond
- ((looking-at "[\t\040\r\n]*<font face=[^>]+>[\t\040\r\n]*")
- ;; text/plain
- (replace-match "")
- (while (re-search-forward "[\t\040\r\n]+" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (while (re-search-forward "<br>" nil t)
- (replace-match "\n"))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- nil)
- (t
- (insert "<#part type=\"text/html\" disposition=inline>")
- (goto-char (point-max))
- (insert "<#/part>")
- t)))
-
-(defun webmail-netaddress-article (file id)
- (webmail-refresh-redirect)
- (let (p p1 attachment count mime type)
- (save-restriction
- (webmail-encode-8bit)
- (goto-char (point-min))
- (if (not (search-forward "Trash" nil t))
- (webmail-error "article@1"))
- (if (not (search-forward "<form>" nil t))
- (webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
- (if (not (search-forward "</form>" nil t))
- (webmail-error "article@3"))
- (narrow-to-region (point-min) (match-end 0))
- (goto-char (point-min))
- (while (re-search-forward "[\040\t\r\n]+" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (while (search-forward "<b>" nil t)
- (replace-match "\n"))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^\040+\\|\040+$" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "\040+" nil t)
- (replace-match " "))
- (goto-char (point-max))
- (widen)
- (insert "\n\n")
- (setq p (point))
- (unless (search-forward "<!-- Data -->" nil t)
- (webmail-error "article@4"))
- (forward-line 14)
- (delete-region p (point))
- (goto-char (point-max))
- (unless (re-search-backward
- "[\040\t]*<br>[\040\t\r\n]*<br>[\040\t\r\n]*<form" p t)
- (webmail-error "article@5"))
- (delete-region (point) (point-max))
- (goto-char p)
- (while (search-forward
- "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
- nil t 2)
- (setq mime t)
- (unless (search-forward "</TABLE>" nil t)
- (webmail-error "article@6"))
- (setq p1 (point))
- (if (search-backward "<IMG " p t)
- (progn
- (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
- (webmail-error "article@7"))
- (setq attachment (match-string 1))
- (setq type (match-string 2))
- (unless (search-forward "</TABLE>" nil t)
- (webmail-error "article@8"))
- (delete-region p (point))
- (let (bufname);; Attachment
- (save-excursion
- (set-buffer (generate-new-buffer " *webmail-att*"))
- (mm-url-insert (concat (car webmail-open-url) attachment))
- (push (current-buffer) webmail-buffer-list)
- (setq bufname (buffer-name)))
- (insert "<#part type=" type)
- (insert " buffer=\"" bufname "\"")
- (insert " disposition=\"inline\"")
- (insert "><#/part>\n")
- (setq p (point))))
- (delete-region p p1)
- (narrow-to-region
- p
- (if (search-forward
- "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
- nil t)
- (match-beginning 0)
- (point-max)))
- (webmail-netaddress-single-part)
- (goto-char (point-max))
- (setq p (point))
- (widen)))
- (unless mime
- (narrow-to-region p (point-max))
- (setq mime (webmail-netaddress-single-part))
- (widen))
- (goto-char (point-min))
- ;; Some blank line to seperate mails.
- (insert "\n\nFrom nobody " (current-time-string) "\n")
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (if id
- (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
- (unless (looking-at "$")
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (webmail-error "article@2")))
- (when mime
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "MIME-Version\\|Content-Type")
- (delete-region (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \t]" nil t)
- (goto-char (match-beginning 0))
- (point-max))))
- (forward-line 1)))
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point) (point-max))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max))))
- (goto-char (point-min))
- (widen))
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">"))))
- (mm-append-to-file (point-min) (point-max) file)))
-
-(defun webmail-netscape-article (file id)
- (let (p p1 attachment count mime type)
- (save-restriction
- (webmail-encode-8bit)
- (goto-char (point-min))
- (if (not (search-forward "Trash" nil t))
- (webmail-error "article@1"))
- (if (not (search-forward "<form>" nil t))
- (webmail-error "article@2"))
- (delete-region (point-min) (match-beginning 0))
- (if (not (search-forward "</form>" nil t))
- (webmail-error "article@3"))
- (narrow-to-region (point-min) (match-end 0))
- (goto-char (point-min))
- (while (re-search-forward "[\040\t\r\n]+" nil t)
- (replace-match " "))
- (goto-char (point-min))
- (while (re-search-forward "<a href=[^>]*>[^<]*</a>" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward "<b>" nil t)
- (replace-match "\n"))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (delete-blank-lines)
- (goto-char (point-min))
- (while (re-search-forward "^\040+\\|\040+$" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "\040+" nil t)
- (replace-match " "))
- (goto-char (point-max))
- (widen)
- (insert "\n\n")
- (setq p (point))
- (unless (search-forward "<!-- Data -->" nil t)
- (webmail-error "article@4"))
- (forward-line 14)
- (delete-region p (point))
- (goto-char (point-max))
- (unless (re-search-backward
- "<form name=\"Transfer2\"" p t)
- (webmail-error "article@5"))
- (delete-region (point) (point-max))
- (goto-char p)
- (while (search-forward
- "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
- nil t 2)
- (setq mime t)
- (unless (search-forward "</TABLE>" nil t)
- (webmail-error "article@6"))
- (setq p1 (point))
- (if (search-backward "<IMG " p t)
- (progn
- (unless (re-search-forward "HREF=\"\\(/tpl/Attachment/[^/]+/\\([^/]+/[^\?]+\\)[^\"]+\\)\"" p1 t)
- (webmail-error "article@7"))
- (setq attachment (match-string 1))
- (setq type (match-string 2))
- (unless (search-forward "</TABLE>" nil t)
- (webmail-error "article@8"))
- (delete-region p (point))
- (let (bufname);; Attachment
- (save-excursion
- (set-buffer (generate-new-buffer " *webmail-att*"))
- (mm-url-insert (concat (car webmail-open-url) attachment))
- (push (current-buffer) webmail-buffer-list)
- (setq bufname (buffer-name)))
- (insert "<#part type=" type)
- (insert " buffer=\"" bufname "\"")
- (insert " disposition=\"inline\"")
- (insert "><#/part>\n")
- (setq p (point))))
- (delete-region p p1)
- (narrow-to-region
- p
- (if (search-forward
- "<TABLE border=\"0\" WIDTH=\"98%\" cellpadding=0 cellspacing=0>"
- nil t)
- (match-beginning 0)
- (point-max)))
- (webmail-netaddress-single-part)
- (goto-char (point-max))
- (setq p (point))
- (widen)))
- (unless mime
- (narrow-to-region p (point-max))
- (setq mime (webmail-netaddress-single-part))
- (widen))
- (goto-char (point-min))
- ;; Some blank line to seperate mails.
- (insert "\n\nFrom nobody " (current-time-string) "\n")
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (if id
- (insert (format "X-Message-ID: <%s@%s>\n" id webmail-address)))
- (unless (looking-at "$")
- (if (search-forward "\n\n" nil t)
- (forward-line -1)
- (webmail-error "article@2")))
- (when mime
- (narrow-to-region (point-min) (point))
- (goto-char (point-min))
- (while (not (eobp))
- (if (looking-at "MIME-Version\\|Content-Type")
- (delete-region (point)
- (progn
- (forward-line 1)
- (if (re-search-forward "^[^ \t]" nil t)
- (goto-char (match-beginning 0))
- (point-max))))
- (forward-line 1)))
- (goto-char (point-max))
- (widen)
- (narrow-to-region (point) (point-max))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max))))
- (goto-char (point-min))
- (widen))
- (let (case-fold-search)
- (while (re-search-forward "^From " nil t)
- (beginning-of-line)
- (insert ">"))))
- (mm-append-to-file (point-min) (point-max) file)))
-
-;;; my-deja
-
-(defun webmail-my-deja-open ()
- (webmail-refresh-redirect)
- (goto-char (point-min))
- (if (re-search-forward "action=\"\\([^\"]+maillogin\\.py[^\"]*\\)\""
- nil t)
- (setq webmail-aux (match-string 1))
- (webmail-error "open@1")))
-
-(defun webmail-my-deja-list ()
- (let (item id newp base)
- (goto-char (point-min))
- (when (re-search-forward "href=\"\\(\\([^\"]*\\)/mailnf\\.[^\"]*\\)\""
- nil t)
- (let ((url (match-string 1)))
- (setq base (match-string 2))
- (erase-buffer)
- (mm-url-insert url)))
- (goto-char (point-min))
- (when (re-search-forward
- "(\\([0-9]+\\) Message.?-[^>]*\\([0-9]+\\) New"
- nil t)
- (message "Found %s mail(s), %s unread"
- (match-string 1) (match-string 2)))
- (goto-char (point-min))
- (while (re-search-forward
- "newmail\\.gif\\|href=\"[^\"]*\\(mailnf\\.[^\"]+act=view[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
- nil t)
- (if (setq id (match-string 2))
- (when (and (or newp (not webmail-newmail-only))
- (not (assoc id webmail-articles)))
- (push (cons id (setq webmail-aux
- (concat base "/" (match-string 1))))
- webmail-articles)
- (setq newp nil))
- (setq newp t)))
- (setq webmail-articles (nreverse webmail-articles))))
-
-(defun webmail-my-deja-article-part (base)
- (let (p)
- (cond
- ((looking-at "[\t\040\r\n]*<!--[^>]*>")
- (replace-match ""))
- ((looking-at "[\t\040\r\n]*</PRE>")
- (replace-match ""))
- ((looking-at "[\t\040\r\n]*<PRE>")
- ;; text/plain
- (replace-match "")
- (save-restriction
- (narrow-to-region (point)
- (if (re-search-forward "</?PRE>" nil t)
- (match-beginning 0)
- (point-max)))
- (goto-char (point-min))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-max))))
- ((looking-at "[\t\040\r\n]*<TABLE")
- (save-restriction
- (narrow-to-region (point)
- (if (search-forward "</TABLE>" nil t 2)
- (point)
- (point-max)))
- (goto-char (point-min))
- (let (name type url bufname)
- (if (and (search-forward "File Name:" nil t)
- (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
- (setq name (match-string 1)))
- (if (and (search-forward "File Type:" nil t)
- (re-search-forward "<FONT[^>]+>\\([^<]+\\)" nil t))
- (setq type (match-string 1)))
- (unless (re-search-forward "action=\"getattach\\.cgi/\\([^\"]+\\)"
- nil t)
- (webmail-error "article@5"))
- (setq url (concat base "/getattach.cgi/" (match-string 1)
- "?sm=Download"))
- (while (re-search-forward
- "type=hidden name=\"\\([^\"]+\\)\" value=\"\\([^\"]+\\)"
- nil t)
- (setq url (concat url "&" (match-string 1) "="
- (match-string 2))))
- (delete-region (point-min) (point-max))
- (save-excursion
- (set-buffer (generate-new-buffer " *webmail-att*"))
- (mm-url-insert url)
- (push (current-buffer) webmail-buffer-list)
- (setq bufname (buffer-name)))
- (insert "<#part type=\"" type "\"")
- (if name (insert " filename=\"" name "\""))
- (insert " buffer=\"" bufname "\"")
- (insert " disposition=inline><#/part>"))))
- (t
- (insert "<#part type=\"text/html\" disposition=inline>")
- (goto-char (point-max))
- (insert "<#/part>")))))
-
-(defun webmail-my-deja-article (file id)
- (let (base)
- (goto-char (point-min))
- (unless (string-match "\\([^\"]+\\)/mail" webmail-aux)
- (webmail-error "article@0"))
- (setq base (match-string 1 webmail-aux))
- (when (re-search-forward
- "href=\"[^\"]*\\(mailnf\\.[^\"]+act=move[^\"]+mid=\\([^\"&]+\\)[^\"]+\\)\""
- nil t)
- (setq webmail-aux (concat base "/" (match-string 1)))
- (string-match "mid=[^\"&]+" webmail-aux)
- (setq webmail-aux (replace-match "mid=%s" nil nil webmail-aux)))
- (unless (search-forward "<HR noshade>" nil t)
- (webmail-error "article@1"))
- (delete-region (point-min) (point))
- (unless (search-forward "<HR noshade>" nil t)
- (webmail-error "article@2"))
- (save-restriction
- (narrow-to-region (point-min) (point))
- (while (search-forward "\r\n" nil t)
- (replace-match "\n"))
- (mm-url-remove-markup)
- (mm-url-decode-entities-nbsp)
- (goto-char (point-min))
- (while (re-search-forward "\n\n+" nil t)
- (replace-match "\n"))
- (goto-char (point-max)))
- (save-restriction
- (narrow-to-region (point) (point-max))
- (goto-char (point-max))
- (unless (search-backward "<HR noshade>" nil t)
- (webmail-error "article@3"))
- (unless (search-backward "</TT>" nil t)
- (webmail-error "article@4"))
- (delete-region (point) (point-max))
- (goto-char (point-min))
- (while (not (eobp))
- (webmail-my-deja-article-part base))
- (insert "MIME-Version: 1.0\n"
- (prog1
- (mml-generate-mime)
- (delete-region (point-min) (point-max)))))
- (goto-char (point-min))
- (insert "\n\nFrom nobody " (current-time-string) "\n")
- (insert "X-Gnus-Webmail: " (symbol-value 'user)
- "@" (symbol-name webmail-type) "\n")
- (if (eq (char-after) ?\n)
- (delete-char 1))
- (mm-append-to-file (point-min) (point-max) file)))
-
-(provide 'webmail)
-
-;;; arch-tag: f75a4558-a8f6-46ec-b1c3-7a6434b3dd71
-;;; webmail.el ends here
+++ /dev/null
-;;; yenc.el --- elisp native yenc decoder
-
-;; Copyright (C) 2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-;; Author: Jesper Harder <harder@ifa.au.dk>
-;; Keywords: yenc 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Functions for decoding yenc encoded messages.
-;;
-;; Limitations:
-;;
-;; * Does not handle multipart messages.
-;; * No support for external decoders.
-;; * Doesn't check the crc32 checksum (if present).
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(defconst yenc-begin-line
- "^=ybegin.*$")
-
-(defconst yenc-decoding-vector
- [214 215 216 217 218 219 220 221 222 223 224 225 226 227 228 229 230
- 231 232 233 234 235 236 237 238 239 240 241 242 243 244 245 246 247
- 248 249 250 251 252 253 254 255 0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15
- 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38
- 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61
- 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84
- 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105
- 106 107 108 109 110 111 112 113 114 115 116 117 118 119 120 121 122
- 123 124 125 126 127 128 129 130 131 132 133 134 135 136 137 138 139
- 140 141 142 143 144 145 146 147 148 149 150 151 152 153 154 155 156
- 157 158 159 160 161 162 163 164 165 166 167 168 169 170 171 172 173
- 174 175 176 177 178 179 180 181 182 183 184 185 186 187 188 189 190
- 191 192 193 194 195 196 197 198 199 200 201 202 203 204 205 206 207
- 208 209 210 211 212 213])
-
-;;;###autoload
-(defun yenc-decode-region (start end)
- "Yenc decode region between START and END using an internal decoder."
- (interactive "r")
- (let (work-buffer)
- (unwind-protect
- (save-excursion
- (goto-char start)
- (when (re-search-forward yenc-begin-line end t)
- (let ((first (match-end 0))
- (header-alist (yenc-parse-line (match-string 0)))
- bytes last footer-alist char)
- (when (re-search-forward "^=ypart.*$" end t)
- (setq first (match-end 0)))
- (when (re-search-forward "^=yend.*$" end t)
- (setq last (match-beginning 0))
- (setq footer-alist (yenc-parse-line (match-string 0)))
- (let (default-enable-multibyte-characters)
- (setq work-buffer (generate-new-buffer " *yenc-work*")))
- (while (< first last)
- (setq char (char-after first))
- (cond ((or (eq char ?\r)
- (eq char ?\n)))
- ((eq char ?=)
- (setq char (char-after (incf first)))
- (with-current-buffer work-buffer
- (insert-char (mod (- char 106) 256) 1)))
- (t
- (with-current-buffer work-buffer
- ;;(insert-char (mod (- char 42) 256) 1)
- (insert-char (aref yenc-decoding-vector char) 1))))
- (incf first))
- (setq bytes (buffer-size work-buffer))
- (unless (and (= (cdr (assq 'size header-alist)) bytes)
- (= (cdr (assq 'size footer-alist)) bytes))
- (message "Warning: Size mismatch while decoding."))
- (goto-char start)
- (delete-region start end)
- (insert-buffer-substring work-buffer))))
- (and work-buffer (kill-buffer work-buffer))))))
-
-;;;###autoload
-(defun yenc-extract-filename ()
- "Extract file name from an yenc header."
- (save-excursion
- (when (re-search-forward yenc-begin-line nil t)
- (cdr (assoc 'name (yenc-parse-line (match-string 0)))))))
-
-(defun yenc-parse-line (str)
- "Extract file name and size from STR."
- (let (result name)
- (when (string-match "^=y.*size=\\([0-9]+\\)" str)
- (push (cons 'size (string-to-number (match-string 1 str))) result))
- (when (string-match "^=y.*name=\\(.*\\)$" str)
- (setq name (match-string 1 str))
- ;; Remove trailing white space
- (when (string-match " +$" name)
- (setq name (substring name 0 (match-beginning 0))))
- (push (cons 'name name) result))
- result))
-
-(provide 'yenc)
-
-;;; arch-tag: 74df17e8-6fa8-4071-9f7d-54d548d79d9a
-;;; yenc.el ends here
+++ /dev/null
-(gnus
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority medium
- category CATEGORY
- dump nil
- description "The Gnus Newsreader and Mailreader."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (binhex canlock compface deuglify earcon flow-fill format-spec gmm-utils gnus-agent gnus-art gnus-async gnus-audio gnus-bcklg gnus-cache gnus-cite gnus-cus gnus-delay gnus-demon gnus-diary gnus-dired gnus-draft gnus-dup gnus-eform gnus-ems gnus-fun gnus-gl gnus-group gnus-int gnus-kill gnus-logic gnus-mh gnus-ml gnus-mlspl gnus-move gnus-msg gnus-nocem gnus-picon gnus-range gnus-registry gnus-salt gnus-score gnus-setup gnus-sieve gnus-soup gnus-spec gnus-srvr gnus-start gnus-sum gnus-topic gnus-undo gnus-util gnus-uu gnus-vm gnus-win gnus-xmas gnus ietf-drums imap legacy-gnus-agent mail-parse mail-prsvr mail-source mailcap message messagexmas messcompat mm-bodies mm-decode mm-encode mm-extern mm-partial mm-url mm-util mm-uu mm-view mml-sec mml-smime mml mml1991 mml2015 nnagent nnbabyl nndb nndiary nndir nndoc nndraft nneething nnfolder nngateway nnheader nnheaderxm nnimap nnkiboze nnlistserv nnmail nnmaildir nnmbox nnmh nnml nnnil nnoo nnrss nnslashdot nnsoup nnspool nntp nnultimate nnvirtual nnwarchive nnweb nnwfm parse-time qp rfc1843 rfc2045 rfc2047 rfc2231 score-mode smiley smime spam-report spam-stat spam time-date utf7 uudecode webmail yenc gnus-idna gpg-ring gpg hashcash vcard)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-2008-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi, gnus-faq.texi, message.texi: Gnus v5.10.10 is released.
-
-2008-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Emacsen): Give recommendations for Emacs 22 and Emacs 23.
-
-2008-04-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Mention customizing of tool bars.
-
-2008-03-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * Makefile.in (datarootdir): Define.
- (install, uninstall): Quote directory name that might contain
- whitespace.
-
- * ps/Makefile.in (datarootdir): Define.
-
-2008-03-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Gnus Development): Clarify difference between ding and
- gnu.emacs.gnus.
- (MIME Commands, Using MIME, RSS): Fix markup.
-
- * gnus-faq.texi ([8.4]): Ditto.
-
-2008-03-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Emacsen): Remove obsolete stuff.
-
-2008-03-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Add version info WRT
- `mail-source-delete-incoming'.
-
-2008-03-16 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Top): Add "Other related manuals" and version info in
- `iftex' output.
- (Formatting Fonts): Add index entries for gnus-mouse-face, gnus-face-0,
- gnus-balloon-face-0 and the corresponding format specifiers.
-
-2008-03-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail Source Customization, Gnus Development, Oort Gnus):
- Update for change of `mail-source-delete-incoming'.
-
-2008-03-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Update copyright years.
-
-2007-12-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Group Parameters): Reorder the text and add a note about
- `gnus-parameters' near the beginning of the node.
-
-2007-12-17 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change)
-
- * gnus.texi (Score File Editing): Fix function name.
-
-2007-12-14 Sven Joachim <svenjoac@gmx.de>
-
- * gnus.texi (Score Variables): Fix typo.
-
-2007-11-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Fancy Mail Splitting): Fix description of splitting based
- on body.
-
-2007-11-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Fetching Mail): Remove obsolete `nnmail-spool-file'.
-
-2007-11-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi, gnus-faq.texi, message.texi: Bump version to 5.10.9.
-
-2007-10-27 Emanuele Giaquinta <e.giaquinta@glauco.it> (tiny change)
-
- * gnus-faq.texi ([5.12]): Remove reference to discontinued service.
-
-2007-10-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Troubleshooting): Adjust Gnus version number.
-
-2007-10-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Relicense "GPLv2 or later" files to "GPLv3 or later".
-
-2007-10-03 Holger Schauer <Holger.Schauer@gmx.de>
-
- * gnus.texi (X-Face): Fix typo.
-
-2007-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Slow/Expensive Connection): Merge explanation for NOV into
- the Terminology section.
- (Terminology): Do.
-
-2007-09-20 Jim Meyering <jim@meyering.net> (tiny change)
-
- * gnus.texi (On Writing Manuals): Fix typos.
-
-2007-09-17 Lowell Gilbert <lgusenet@be-well.ilk.org> (tiny change)
-
- * gnus.texi (Slow/Expensive Connection): Improve descriptions.
-
-2007-09-17 Allan Gottlieb <gottlieb@nyu.edu> (tiny change)
-
- * gnus.texi (Slow/Expensive Connection): Improve descriptions.
-
-2007-09-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Crosspost Handling): Replace gnus-nov-is-evil with
- nntp-nov-is-evil; move vindex to gnus-nov-is-evil to Slow/Expensive
- Connection; add xref to Slow/Expensive Connection.
- (Slow/Expensive Connection): Describe not only NNTP connection; improve
- gnus-nov-is-evil; add an explanation of NOV.
- (Slow Machine): Add xref to Slow/Expensive Connection.
-
-2007-09-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Selecting a Group): Rename gnus-maximum-newsgroup to
- gnus-newsgroup-maximum-articles. Suggested by Leo <sdl.web@gmail.com>.
-
-2007-08-24 IRIE Tetsuya <irie@t.email.ne.jp> (tiny change)
-
- * message.texi (MIME): Replace mml-attach with mml-attach-file.
-
-2007-08-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Selecting a Group): Mention gnus-maximum-newsgroup.
-
-2007-08-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Mention nntp-xref-number-is-evil.
-
-2007-08-08 Glenn Morris <rgm@gnu.org>
-
- * gnus.texi, sieve.texi: Replace `iff'.
-
-2007-07-25 Glenn Morris <rgm@gnu.org>
-
- * Relicense all FSF files to GPLv3 or later.
-
-2007-07-13 Eli Zaretskii <eliz@gnu.org>
-
- * emacs-mime.texi: Add @documentencoding directive.
-
-2007-07-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Splitting Mail): Fix description of
- nnmail-mail-splitting-decodes.
-
-2007-07-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi ([3.2]): Fix locating of environment variables in the
- Control Panel.
-
- * gnus.texi (Misc Article): Add index entry for
- gnus-single-article-buffer.
-
-2007-06-27 Andreas Seltenreich <andreas@gate450.dyndns.org>
-
- * gnus.texi (Starting Up): Fix typo.
-
-2007-06-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Asynchronous Fetching): Fix typo.
-
-2007-06-06 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus.texi (Article Buttons, Mail Source Customization)
- (Sending or Not Sending, Customizing NNDiary):
- * message.texi (Message Headers): Fix typos.
-
-2007-06-06 Andreas Seltenreich <andreas@gate450.dyndns.org>
-
- * gnus.texi (Misc Group Stuff, Summary Buffer)
- (Server Commands, Article Keymap): Fix typo. s/function/command/.
-
-2007-05-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Running NNDiary): Use ~/.gnus.el instead of gnusrc.
-
-2007-05-09 Didier Verna <didier@xemacs.org>
-
- * gnus.texi (Email Based Diary): New. Proper documentation for the
- nndiary back end and the gnus-diary library.
-
-2007-05-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * doclicense.texi: Update to version 1.2 from Emacs CVS.
-
-2007-04-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Highlighting): Clarify gnus-cite-parse-max-size.
-
-2007-04-15 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus.texi, message.texi, pgg.texi, sieve.texi: Include GFDL.
-
-2007-03-31 Eli Zaretskii <eliz@gnu.org>
-
- * emacs-mime.texi (Non-MIME): Postscript -> PostScript.
-
-2007-03-26 Richard Stallman <rms@gnu.org>
-
- * pgg.texi (Caching passphrase): Clean up previous change.
-
-2007-03-25 Thien-Thi Nguyen <ttn@gnu.org>
-
- * gnus.texi (Setting Process Marks): Fix typo.
-
-2007-03-24 Thien-Thi Nguyen <ttn@gnu.org>
-
- * gnus.texi (Splitting Mail): Reword "splitting"-as-adj to be -as-noun.
-
- * gnus.texi (Mail Source Specifiers): Fix typo.
-
-2007-03-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Message Buffers): Update documentation for
- message-generate-new-buffers.
-
-2007-03-15 Daiki Ueno <ueno@unixuser.org>
-
- * pgg.texi (Caching passphrase): Describe pgg-passphrase-coding-system.
-
-2007-03-11 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus.texi (Mail and Post): Update documentation for gnus-user-agent.
- The variable now uses a list of symbols instead of just a symbol.
- Reported by Christoph Conrad <christoph.conrad@gmx.de>.
-
-2007-02-27 Chong Yidong <cyd@stupidchicken.com>
-
- * pgg.texi (Caching passphrase): Document gpg-agent usage, gpg-agent
- problems on the console, and security risk in not using gpg-agent.
-
-2007-02-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Mention nntp-never-echoes-commands and
- nntp-open-connection-functions-never-echo-commands.
-
-2007-01-28 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus.texi (Batching Agents): Fix example. Reported by Tassilo Horn
- <tassilo@member.fsf.org>.
-
-2007-01-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Customizing Articles): Use index entries for gnus-treat-*
- variables only in info to avoid redundant entries in the printed
- manual.
-
-2007-01-02 Daiki Ueno <ueno@unixuser.org>
-
- * message.texi (Using PGP/MIME): Document gpg-agent usage.
-
-2007-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (Security): Split into sub-nodes.
-
-2006-12-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Customizing Articles): Add index entries for all
- gnus-treat-* variables.
-
-2006-12-29 Jouni K. Seppänen <jks@iki.fi>
-
- * gnus.texi (IMAP): Fix incorrect explanation of
- nnimap-search-uids-not-since-is-evil in documentation for
- nnimap-expunge-search-string.
-
-2006-12-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (ifile spam filtering): Rename spam-ifile-database-path to
- spam-ifile-database.
-
-2006-12-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Spam Package Configuration Examples): Don't encourage to
- rebind C-s.
-
-2006-12-26 Jouni K. Seppänen <jks@iki.fi>
-
- * gnus.texi (Group Parameters, Group Maintenance, Topic Commands)
- (Mail Group Commands, Expiring Mail, IMAP): Add index entries for
- "expiring mail".
- (IMAP): Document nnimap-search-uids-not-since-is-evil and
- nnimap-nov-is-evil.
-
-2006-12-24 Chong Yidong <cyd@stupidchicken.com>
-
- * pgg.texi (Caching passphrase): Default for pgg-gpg-use-agent changed
- to t.
- (Prerequisites): Add explanation about gpg-agent.
-
-2006-12-17 Sascha Wilde <wilde@sha-bang.de>
-
- * pgg.texi: Added short note on gpg-agent to the introduction.
-
-2006-12-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Hiding Headers): Document that `long-to' and `many-to'
- also applies to Cc.
-
-2006-12-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (X-Face): Clarify. Say which programs are required
- on Windows.
-
-2006-10-13 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus.texi (Other modes): Fix typo. Add alternative index entry for
- gnus-dired-attach.
- (Selecting a Group): Fix typo.
-
-2006-10-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Image Enhancements): Update for Emacs 22.
-
- * gnus-faq.texi ([1.3]): Update.
-
-2006-10-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Foreign Groups): Say where change of editing commands are
- stored. Add reference to `gnus-parameters'.
-
-2006-09-14 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Add @xref for `mm-fill-flowed'.
-
-2006-09-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail Source Specifiers): Mention problem of duplicate
- mails with pop3-leave-mail-on-server. Fix wording.
- (Limiting): Improve gnus-summary-limit-to-articles.
- (X-Face): Fix typo.
-
-2006-07-24 Richard Stallman <rms@gnu.org>
-
- * pgg.texi: Move periods and commas inside quotes.
-
-2006-07-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Oort Gnus): Mention that the Lisp files are now installed
- in .../site-lisp/gnus/ by default.
- [ From gnus-news.texi in the trunk. ]
-
-2006-07-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (MIME Commands): Additions for yEnc.
-
-2006-07-10 Nick Roberts <nickrob@snap.net.nz>
-
- * gnus.texi, message.texi: Fix typos.
-
-2006-05-29 Stefan Monnier <monnier@iro.umontreal.ca>
-
- * gnus.texi (Example Setup): Use ;; instead of ;;; to better follow
- coding conventions.
-
-2006-06-24 Andreas Seltenreich <uwi7@rz.uni-karlsruhe.de>
-
- * gnus.texi (Summary Buffer Lines): Fix typo.
-
-2006-06-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (News Headers): Update message-syntax-checks section.
-
-2006-05-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Saving Articles): Addition.
-
-2006-05-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Saving Articles): Clarify gnus-summary-save-article-mail.
-
-2006-05-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (Interface): Add tool bar customization.
- (MIME): Index and text additions for mml-attach.
- (MIME): Describe mml-dnd-protocol-alist and
- mml-dnd-attach-options.
-
- * gnus.texi (Oort Gnus): Reorder entries in sections. Fix some
- entries.
- (Starting Up): Add references to "Emacs for Heathens" and to
- "Finding the News". Add user-full-name and user-mail-address.
- (Group Buffer Format): Add tool bar customization and update.
- (Summary Buffer): Add tool bar customization.
- (Posting Styles): Add message-alternative-emails.
-
-2006-04-26 Reiner Steib <Reiner.Steib@gmx.de>
-
- * pgg.texi (Caching passphrase): Fix markup and typos. Simplify.
-
-2006-04-26 Sascha Wilde <wilde@sha-bang.de>
-
- * pgg.texi (Caching passphrase): Added documentation for
- pgg-gpg-use-agent.
-
-2006-04-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Spam Statistics Package): Fix typo in @pxref.
- (Splitting mail using spam-stat): Fix @xref.
-
-2006-04-20 Chong Yidong <cyd@stupidchicken.com>
-
- * gnus.texi (Spam Package): Major revision of the text.
- Previouly this node was "Filtering Spam Using The Spam ELisp Package".
-2006-04-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-refcard.tex: Remove duplicate \def's. Update date.
-
-2006-04-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Emacsen): Don't support Emacs 20.7 and XEmacs 21.1.
-
-2006-04-11 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi, gnus-faq.texi, message.texi: Gnus v5.10.8 is released.
-
-2006-04-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Misc Group Stuff, Summary Buffer, Article Keymap)
- (Server Commands): Key `v' is reserved for users.
-
-2006-04-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Summary Buffer Lines): Add `*'.
-
-2006-04-07 Jochen K\e,A|\e(Bpper <jochen@fhi-berlin.mpg.de>
-
- * gnus.texi (Group Parameters): Mention
- gnus-permanently-visible-groups.
-
-2006-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Face): Fix typo.
-
-2006-04-05 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (X-Face): Clarify.
- (Face): Need Emacs with PNG support.
-
-2006-04-04 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Security): Improve.
-
-2006-03-31 Romain Francoise <romain@orebokech.com>
-
- * gnus.texi (Virtual Groups): `nnvirtual-always-rescan' defaults
- to t, not nil (and has for the past eight years).
-
-2006-03-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Top): Add comment about version line.
-
- * message.texi (Top): Ditto. Change to take named versions into
- account.
-
-2006-03-28 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Posting Styles): Add x-face-file to example.
- (X-Face): Refer to posting styles.
-
- * gnus-faq.texi ([5.8]): Add x-face-file.
- ([8.4]): Add links to gmane.emacs.gnus.user and
- gmane.emacs.gnus.general.
-
-2006-03-27 Karl Berry <karl@gnu.org>
-
- * gnus.texi, message.texi, emacs-mime.texi, sieve.texi, pgg.texi:
- Do not indent copyright year list.
-
-2006-03-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi: Use .invalid.
- ([5.4]): Fix gnus-posting-styles example.
-
-2006-03-20 Romain Francoise <romain@orebokech.com>
-
- * gnus.texi (Mail Folders): Grammar fix.
-
-2006-03-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NoCeM): Mention gnus-use-nocem can also be a number.
-
-2006-03-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Fancy Mail Splitting): Improve sentences so as to be
- easy to understand.
-
-2006-03-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi: Markup fix.
- (Fancy Mail Splitting): Specify new feature.
-
-2006-03-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Fancy Mail Splitting): Improve descriptions about
- partial-words matching.
-
-2006-03-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * emacs-mime.texi (Display Customization): Reword image/.* stuff.
-
- * gnus.texi (Oort Gnus): Add note about `gnus-load'.
- (MIME Commands): Fix mm-discouraged-alternatives.
-
-2006-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * xemacs.mak: Remove outdated file. Use make.bat instead.
-
- * gnus.texi (Oort Gnus): Add `mm-fill-flowed'.
-
-2006-02-27 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (Flowed text): Add mm-fill-flowed. (Sync
- 2004-01-27 from the trunk).
-
-2006-02-09 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Gnus Versions): Add history beyond start of Oort.
-
-2006-01-31 Romain Francoise <romain@orebokech.com>
-
- * message.texi (Message Headers): Explain what
- `message-alternative-emails' does in more detail.
- Update copyright year.
-
-2006-01-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * ps/Makefile.in (distclean): Remove Makefile.
-
- * Makefile.in (almost-clean): Rename from clean.
- (clean): Rename from veryclean.
- (distclean): Use clean.
- (pspackage): Use almost-clean.
-
-2006-01-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi: Update copyright.
-
-2006-01-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Article Washing): Additions.
-
-2006-01-08 Alex Schroeder <alex@gnu.org>
-
- * pgg.texi (Caching passphrase): Rewording.
-
-2006-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (RSS): Document nnrss-wash-html-in-text-plain-parts.
-
-2006-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (RSS): Addition.
-
-2005-12-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Summary Post Commands): Fix function bound to `S O p'.
-
-2005-12-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Display Customization): Add setting example to
- mm-discouraged-alternatives.
-
-2005-12-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (MIME Commands): Mention addition of
- multipart/alternative to gnus-buttonized-mime-types and add xref
- to mm-discouraged-alternatives.
-
- * emacs-mime.texi (Display Customization): Mention addition of
- "image/.*" and add xref to gnus-buttonized-mime-types in the
- mm-discouraged-alternatives section.
-
-2005-12-05 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * pgg.texi (User Commands): Fix description of pgg-verify-region.
- (Selecting an implementation): Fix descriptions.
-
-2005-11-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Various Message Variables): Addition.
-
-2005-11-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi: Fix default values.
-
-2005-11-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Header Commands): Clarify descriptions of
- message-cross-post-followup-to, message-reduce-to-to-cc, and
- message-insert-wide-reply.
- (Various Commands): Fix kindex for message-kill-to-signature;
- clarify description of message-tab.
-
-2005-11-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Mailing Lists): Fix description about MFT.
-
- * gnus.texi (Emacs Lisp): Use ~/.gnus.el instead of ~/.emacs.
-
-2005-11-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Slow Terminal Connection): Replace old description
- with new one.
-
-2005-11-16 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Oort Gnus): Use ~/.gnus.el instead of ~/.emacs;
- replace X-Draft-Headers with X-Draft-From.
-
-2005-11-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Various Various): Fix the default value of
- nnheader-max-head-length.
- (Gnus Versions): Fix typo.
-
-2005-11-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (XVarious): Fix description of gnus-use-toolbar; add
- new variable gnus-toolbar-thickness.
-
-2005-11-08 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (XVarious): Revert description of gnus-use-toolbar.
-
-2005-11-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (X-Face): Fix description.
- (XVarious): Remove gnus-xmas-logo-color-alist and
- gnus-xmas-logo-color-style; fix description of gnus-use-toolbar.
-
-2005-11-04 Ken Manheimer <ken.manheimer@gmail.com>
-
- * pgg.texi (User Commands): Document additional passphrase
- argument for pgg-encrypt-*, pgg-decrypt-*, and pgg-sign-* functions.
- (Backend methods): Likewise for corresponding pgg-scheme-* functions.
-
-2005-11-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Group Parameters): Mention new variable
- gnus-parameters-case-fold-search.
- (Home Score File): Addition.
-
-2005-10-29 Sascha Wilde <wilde@sha-bang.de>
-
- * pgg.texi (How to use): Update the example to add autoload of
- pgg-encrypt-symmetric-region.
- (User Commands): Document pgg-encrypt-symmetric-region.
- (Backend methods): Document pgg-scheme-encrypt-symmetric-region.
-
-2005-10-17 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Document Groups): Remove duplicate item.
-
-2005-10-14 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Document Server Internals): Addition.
-
-2005-10-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (A note on namespaces): Fix RFC reference.
-
-2005-10-12 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (RSS): Fix key description.
-
-2005-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi: Emacs/w3 -> Emacs/W3.
- (Browsing the Web): Fix description.
- (Web Searches): Ditto.
- (Customizing W3): Ditto.
-
-2005-10-07 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Maildir): Clarify expire-age and expire-group.
-
-2005-09-28 Simon Josefsson <jas@extundo.com>
-
- * message.texi (IDNA): Fix.
-
-2005-09-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Remove nntp-buggy-select, nntp-read-timeout,
- nntp-server-hook, and nntp-warn-about-losing-connection; fix
- description of nntp-open-connection-function.
- (Common Variables): Fix descriptions.
-
-2005-09-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Server Buffer Format): Document the %a format spec.
-
-2005-09-22 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Mail): Fix gnus-confirm-mail-reply-to-news entry.
-
-2005-09-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Finding the Parent): Fix description of how Gnus
- finds article.
-
-2005-09-14 Jari Aalto <jari.aalto@cante.net>
-
- * gnus.texi (Advanced Scoring Examples): New exmples to teach how
- to drop off non-answered articles.
-
-2005-09-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail Source Customization): Fix descriptions of
- mail-source-incoming-file-prefix.
-
-2005-09-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Choosing Variables): Fix descriptions.
-
-2005-08-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (time-date): Fix description of safe-date-to-time.
-
-2005-08-18 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Handles): Remove duplicate item.
- (Encoding Customization): Fix the default value for
- mm-coding-system-priorities.
- (Charset Translation): Emacs doesn't use mm-mime-mule-charset-alist.
- (Basic Functions): Fix reference.
-
-2005-08-09 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Charsets): Fj hierarchy uses iso-2022-jp.
-
-2005-07-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Startup Files): Fix name of gnus-site-init-file.
- Mention that gnus-init-file is not read when Emacs is invoked with
- --no-init-file or -q.
-
-2005-06-29 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NoCeM): gnus-nocem-verifyer defaults to pgg-verify.
-
-2005-06-23 Juanma Barranquero <lekktu@gmail.com>
-
- * gnus.texi (MIME Commands, Fancy Mail Splitting, Agent Visuals)
- (Agent Variables):
- * message.texi (Message Headers):
- Texinfo usage fix.
-
-2005-04-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (RSS): Addition.
-
-2005-03-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (gnus-booklet.dvi, gnus-booklet.pdf): Simplify.
- (gnus-faq-texi): Renamed from gnus-faq.texi to avoid unsolicited
- download.
-
-2005-03-29 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (gnus-booklet.dvi, gnus-booklet.pdf)
- (gnus-refcard.dvi, gnus-refcard.pdf): New targets replacing
- refcard.* and booklet.*.
-
- * gnus-refcard.tex: Merged from refcard.tex and gnusref.tex.
- Removed refcard.tex gnusref.tex booklet.tex bk-lt.tex bk-a4.tex.
-
- * gnus-logo.eps: Renamed from gnuslogo-booklet.eps.
- gnuslogo-refcard.eps: Removed.
-
- * Makefile.in (gnus-faq.texi): Depend on xml2texi.*. Fix sed
- command.
-
-2005-03-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Display Customization): Markup fixes.
- (rfc2047): Update.
-
-2005-03-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * Makefile.in (gnus-faq-full-update, gnus-faq-clean)
- (gnus-faq.texi): New targets.
- (distclean): Remove some gnus-faq.* files.
-
- * xml2texi.sh: Mention requirements.
-
- * xml2texi.scm (boilerplate): Add "Do not modify ...".
-
- * gnus-faq.texi: Generated.
-
-2005-03-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi: Generated from gnus-faq.xml using xml2texi.*.
-
- * message.texi, gnus.texi: Update copyright.
-
- * xml2texi.scm (+tag-for-gnus-faq-texi+): New variable.
- (transform): Use it. From Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de> with
- minor modifications.
- (boilerplate): Update copyright for the output file.
-
-2005-03-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * xml2texi.sh: Fix arch tag.
-
-2005-03-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * xml2texi.scm, xml2texi.sh: Added copyright.
- (transform): Avoid redundant entries in @urefs.
- (format-node): Don't insert optional arguments of @node.
-
-2005-03-20 Karl Pfl\e,Ad\e(Bsterer <sigurd@12move.de>
-
- * xml2texi.scm, xml2texi.sh: New files. PLT Scheme program to
- convert FAQ from xml to texi.
-
-2005-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Slow/Expensive Connection): Don't abbreviate "very".
-
-2005-01-28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Some edits based on comments from David Abrahams.
-
-2005-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (RSS): Fix the keystroke.
-
-2005-01-16 Xavier Maillard <zedek@gnu-rox.org> (tiny change)
-
- * gnus-faq.texi ([4.1]): Typo.
-
-2005-01-06 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Reply): `message-reply-to-function' should return
- a list. Suggested by ARISAWA Akihiro <ari@mbf.ocn.co.jp>.
-
-2004-12-08 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi ([5.1]): Added missing bracket.
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): Index
- `spam-initialize'.
-
-2004-11-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (Various Message Variables): Mention that all mail
- file variables are derived from `message-directory'.
-
- * gnus.texi (Splitting Mail): Clarify bogus group.
-
-2004-11-02 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Encoding Customization): Fix
- mm-coding-system-priorities entry.
-
-2004-10-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (New Features): Add 5.11.
-
- * message.texi (Resending): Remove wrong default value.
-
- * gnus.texi (Mail Source Specifiers): Describe possible problems
- of `pop3-leave-mail-on-server'. Add `pop3-movemail' and
- `pop3-leave-mail-on-server' to the index.
-
-2004-10-15 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Canceling News): Add how to set a password.
-
-2004-10-10 Juri Linkov <juri@jurta.org>
-
- * gnus.texi (Top, Marking Articles): Join two menus in one node
- because a node can have only one menu.
-
-2004-10-09 Juri Linkov <juri@jurta.org>
-
- * gnus.texi (Fancy Mail Splitting): Remove backslash in the
- example of nnmail-split-fancy.
-
-2004-10-12 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi ([5.9]): Improve code for reply-in-news.
-
-2004-09-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi ([5.12]): Fix code example for FQDN in Message-Ids
- again.
- Use 5.10 instead of 5.10.0.
-
-2004-09-21 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * texi2latex.el (latexi-translate-file): Support @copying and
- @insertcopying.
- (latexi-copying-text): New variable.
- (latexi-copying): New function.
- (latexi-insertcopying): New function.
- (latexi-translate-file): Support accents; add @documentencoding.
- From Jesper Harder <harder@ifa.au.dk>.
-
- * infohack.el: Support @copying and @insertcopying for Emacs 21.3
- and lesser and XEmacs.
- (infohack): Support @documentencoding in Emacs 21.3. From Jesper
- Harder <harder@ifa.au.dk>.
-
-2004-09-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Mail Commands): S D e.
-
-2004-09-20 Raymond Scholz <ray-2004@zonix.de> (tiny change)
-
- * gnus.texi (Misc Article): Refer to `Summary Buffer Mode Line' in
- the gnus-article-mode-line-format section.
-
-2004-09-20 Helmut Waitzmann <Helmut.Waitzmann@web.de> (tiny change)
-
- * gnus.texi (Various Summary Stuff): Fix the documentation for
- gnus-newsgroup-variables.
-
-2004-09-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (MIME Commands): Added
- gnus-mime-display-multipart-as-mixed,
- gnus-mime-display-multipart-alternative-as-mixed,
- gnus-mime-display-multipart-related-as-mixed.
- (Mail Source Customization): Clarify `mail-source-directory'.
- (Splitting Mail): Mention gnus-group-find-new-groups.
- (SpamOracle): Fixed typo.
-
- * gnus-faq.texi: Untabify.
- ([6.3]): nnir.el is in contrib directory.
-
- * message.texi (News Headers): Clarify how a unique ID is created.
-
- * gnus.texi (Batching Agents): Fixed typo in example. Reported
- by Hiroshi Fujishima <pooh@nature.tsukuba.ac.jp>.
-
-2004-09-20 Andre Srinivasan <andre@e2open.com>
-
- * gnus.texi (Group Parameters): Added more on hooks. (Small
- change.)
-
-2004-09-20 Florian Weimer <fw@deneb.enyo.de>
-
- * gnus.texi (Charsets): Point to relevant section in emacs-mime.
-
-2004-09-10 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Add example. Suggested and partially written
- by Steinar Bang <sb@dod.no>.
-
-2004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (IMAP): Add comments about imaps synonym to imap in
- netrc syntax.
-
-2004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Spam ELisp Package Sequence of Events): Some clarifications.
- (Spam ELisp Package Global Variables): More clarifications.
-
-2004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Spam ELisp Package Filtering of Incoming Mail):
- Mention spam-split does not modify incoming mail.
-
-2004-09-10 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Spam ELisp Package Sequence of Events): Fix typo.
-
-2004-08-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * emacs-mime.texi, gnus-faq.texi, gnus.texi, message.texi,
- * pgg.texi, sieve.texi: Use @copying and @insertcopying.
-
-2004-08-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Encoding Customization): Add a note to the
- mm-content-transfer-encoding-defaults entry.
- (rfc2047): Update.
-
- * gnus.texi (Article Highlighting): Add
- gnus-cite-ignore-quoted-from.
- (POP before SMTP): New node.
- (Posting Styles): Addition.
- (Splitting Mail): Add nnmail-split-lowercase-expanded.
- (Fancy Mail Splitting): Ditto.
- (X-Face): Add gnus-x-face.
-
-2004-08-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail Source Specifiers): Describe
- `pop3-leave-mail-on-server'.
-
-2004-05-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Mention new behavior of `F' and `R' when
- the region is active.
-
-2004-01-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Spam ELisp Package Configuration Examples): Markup fixes.
-
-2004-01-03 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Spam ELisp Package Sequence of Events): explain more
- about the sequence of events and what happens with read-only
- backends
- (Spam ELisp Package Global Variables): explain what happens with
- read-only backends
- (Spam ELisp Package Configuration Examples): added Reiner Steib
- and Ted Zlatanov's setups
-
-2004-01-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * emacs-mime.texi (Display Customization): Add mm-enable-external.
-
-2004-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Category Syntax):
- gnus-agent-cat-enable-undownloaded-faces.
-
-2004-01-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi, gnus.texi, gnus-faq.texi: Update copyright.
-
- * gnus-faq.texi ([5.12]): Fix code example for FQDN in Message-Ids.
-
- * message.texi (Message Headers): Add message-header-synonyms.
-
- * gnus.texi (Other modes): New node.
- (Oort Gnus): Refer to the above in "Dired integration".
-
-2004-01-02 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Top): updated menu with new manual nodes
- (The problem of spam): more ranting
- (Anti-Spam Basics): "spammers are wise to [filtering on From:]"
- (SpamAssassin): mention spam.el
- (Hashcash): do not a sentence end proposition with
- (Filtering Spam Using The Spam ELisp Package): more and better
- explanation, took lots of information out into subsections
- (Spam ELisp Package Sequence of Events)
- (Spam ELisp Package Filtering of Incoming Mail)
- (Spam ELisp Package Global Variables): new or updated content all
- around
- (Spam ELisp Package Configuration Examples): promised new
- section, empty for now
- (Blacklists and Whitelists, BBDB Whitelists)
- (Gmane Spam Reporting, Bogofilter, spam-stat spam filtering)
- (SpamOracle): mention that spam/ham processor variables are being
- obsoleted
- (Extending the Spam ELisp package): add some new documentation
- for adding a new backend to spam.el
-
-2004-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Foreign Groups): Add `gnus-group-read-ephemeral-group'.
- (Oort Gnus): Ditto.
-
-2004-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Key Index): Untabified.
-
- * gnus.texi (RSS): kindex.
-
-2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Summary Score Commands): Add `f' to
- `gnus-score-find-trace'.
- (Score File Editing): Added `V t'.
-
-2003-12-31 Steve Youngs <sryoungs@bigpond.net.au>
-
- * gnus.texi (XEmacs): Update list of Gnus XEmacs package
- requirements.
-
-2003-12-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Canceling and Superseding): Mention `Cancel-Lock'.
-
-2003-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Maildir): Filled.
- (Key Index): Untabified.
-
-2003-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Parameters): Clarification.
-
-2003-12-29 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Agent Variables): Add.
-
-2003-12-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Mention change of `e' in draft groups.
-
-2003-12-15 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Parameters): Clarify.
-
-2003-12-11 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.texi (Agent Parameters): Added references in Topic and
- Group Parameters. Added gnus-agent-cat-disable-undownloaded-faces
- to the list of documented agent parameters.
-
-2003-12-11 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Mailing Lists): Fix typo.
-
-2003-12-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Fancy Mail Splitting): Close paren of a Lisp function.
- (SpamAssassin): Ditto.
-
-2003-12-04 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (SpamAssassin, Fancy Mail Splitting): add
- save-restriction before (widen) in the example. From Kevin Ryde
- <user42@zip.com.au>.
-
-2003-12-03 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (Flowed text): Fix.
-
-2003-12-02 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Agent Variables): Fix.
-
-2003-12-01 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: Add missing mode to some @kindex'es.
-
-2003-11-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (RSS): Add nnrss-use-local.
- (Foreign Groups): Add `G R'.
-
-2003-11-29 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex (subsection*{Notes}): Add `G R'.
-
-2003-11-25 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Hiding Headers): Update.
-
-2003-11-20 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Debugging IMAP): minor corrections
-
-2003-11-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Finding the Parent): nnml does supports fetching by
- MID.
-
-2003-11-20 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Debugging IMAP): Add.
-
-2003-11-19 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Score Decays): Update the gnus-decay-score function.
-
-2003-11-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Troubleshooting): Update.
-
-2003-11-03 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): added
- some clarifications
-
-2003-10-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Fancy Mail Splitting): added mention of
- nnmail-split-fancy-match-partial-words
-
-2003-10-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Slashdot, SpamAssassin, Score File Format): Fix
- overfull hbox.
- (Topic Parameters): @group.
- (Slashdot): Fix.
-
-2003-10-27 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): added
- example of using a string as a parameter to spam-split in order
- to override the default spam-split-group value
-
-2003-10-27 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex (subsection*{Notes}): do.
-
- * gnus.texi (Exiting the Summary Buffer): Add keybinding.
-
-2003-10-23 Reiner Steib <Reiner.Steib@gmx.de>
-
- * emacs-mime.texi: Markup: Use @acronym for MML and MIME.
-
- * message.texi: Ditto.
-
- * gnus.texi: Ditto.
-
-2003-10-23 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (MML Definition): Add format.
-
-2003-10-22 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package):
- changed to use the new spam-initialize function
-
-2003-10-19 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (Mailing Lists): Add Mail-Followup-To to index.
-
- * gnus.texi (Group Parameters): Add Mail-Followup-To to index.
- (Emacsen): Fixed typo.
- (Oort Gnus): Mention message-forward-show-mml change (Sync with
- GNUS-NEWS).
-
-2003-10-12 Adrian Aichner <adrian@xemacs.org>
-
- * gnus.texi (Mail Source Specifiers): uref fixes.
-
-2003-10-18 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Mail Splitting)
- (Filtering Spam Using The Spam ELisp Package): Markup fixes.
-
- * message.texi (Security): @url -> @uref.
-
-2003-10-18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Define gnusasis and gnusurl.
-
-2003-10-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Mail Splitting): Markup fix.
-
-2003-10-03 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Files and Directories): Update.
-
-2003-10-02 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): added
- spam-process-ham-in-spam-groups and
- spam-process-ham-in-nonham-groups variable descriptions
-
-2003-10-01 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Various Message Variables): Typo.
-
- * gnus.texi (Oort Gnus): Typo.
- (Filtering Spam Using The Spam ELisp Package): Just remember,
- kids: There is no 'c' in 'supersede'.
-
-2003-09-27 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Reply): Fix typo.
-
-2003-09-22 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Fancy Mail Splitting, SpamAssassin): corrected fancy
- split example to use current buffer, mentioned
- nnimap-split-download-body
-
-2003-09-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi, gnus-faq.texi, message.texi: gnus -> Gnus.
-
- * message.texi: Fixes.
-
-2003-09-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Fancy Mail Splitting): Make split-on-body work for
- respooling. Suggested by Harald Maier <maierh@myself.com>.
- (Fancy Mail Splitting): Reformat.
-
-2003-09-15 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Posting Styles): Fix typo. @itemize attribute names.
-
-2003-09-14 Jesper Harder <harder@ifa.au.dk>
-
- * pgg.texi (Selecting an implementation, Caching passphrase)
- (Initializing): Markup fix.
-
-2003-09-12 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Buffer Lines): Formatting fix.
-
-2003-09-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Creating a Virtual Server): Use nnml for the example.
- nnspool doesn't work on ms-windows due to file name restrictions.
-
-2003-08-29 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Gmane Spam Reporting): added explanation of
- spam-report-gmane-use-article-number
-
-2003-08-25 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Customizing Articles): xface -> x-face.
-
-2003-08-20 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (GroupLens): Move text around.
-
-2003-08-16 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Searching for Articles): Fix example.
-
-2003-08-08 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Kibozed Groups): Fix.
-
-2003-08-04 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Parameters): Add expiry-target.
- (Archived Messages): Layout fix.
-
-2003-07-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Top): Menu fixes and additions.
-
-2003-07-19 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Encoding Customization): Fix.
- (MML Definition): Typo.
-
-2003-07-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Sorting the Summary Buffer): Index.
-
-2003-07-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi ([3.8]): Fixed example.
-
-2003-07-14 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package):
- mentioned the spam-install-hooks mess
-
-2003-07-11 Matthias Andree <ma@dt.e-technik.uni-dortmund.de> (tiny change)
-
- * gnus.texi (Splitting in IMAP): Typos.
-
-2003-07-11 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Splitting in IMAP): Mention Sieve.
-
-2003-07-10 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Security): Discuss the PGP 2.x compatibility
- problem.
-
-2003-06-24 Jesper Harder <harder@ifa.au.dk>
-
- * sieve.texi (Sieve Mode): Formatting fix.
-
- * gnus.texi (Agent Basics, Group Parameters, Quassia Gnus): do.
-
-2003-06-24 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Mail Commands): Make note of
- Mail-Followup-To.
-
-2003-06-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: Formatting fixes.
-
-2003-06-22 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Security): Mention S/MIME passphrases.
-
-2003-06-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: Add @command.
-
- * texi2latex.el (latexi-translate-file): Add @command and @:.
-
- * gnus.texi (Face): Use @uref.
-
-2003-06-19 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Sieve Commands, Agent Basics, SpamOracle): @xref
- fixes.
-
-2003-06-18 Didier Verna <didier@xemacs.org>
-
- * gnus.texi (Face): New node.
- * gnus.texi (Article Display): Reference it.
- * gnus.texi (Customizing Articles): Ditto.
- * gnus.texi (Image Enhancements): Put the Face node into the menu.
-
-2003-06-17 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus.texi (Splitting Mail): Add "splitting" entry and concept
- index entries. Small patch from Karl Pfl\e,Ad\e(Bsterer
- <sigurd@12move.de>.
-
-2003-06-15 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Daemons): Fixed typo.
-
-2003-06-15 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * message.texi (Message Headers): Extend
- `message-subject-re-regexp' example. From Niklas Morberg
- <niklas.morberg@axis.com>.
-
-2003-06-11 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Bogofilter): revise docs to mention threshold is now
- user-controllable
-
-2003-06-10 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi: Use two spaces consistently to end sentences.
-
- * message.texi: do.
-
- * gnus.texi: do.
-
-2003-06-09 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): new
- SpamOracle node
- (SpamOracle): document new SpamOracle code
-
-2003-06-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Article Buttons, Splitting in IMAP)
- (Category Syntax, Picons): Preemptive strike by
- alt.possesive.its.has.no.apostrophe.
-
-2003-06-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Fancy Mail Splitting): Explain some entries in
- nnmail-split-abbrev-alist.
-
-2003-05-17 Adrian Aichner <adrian@xemacs.org>
-
- * emacs-mime.texi (Charset Translation): Ruthless typo fixing.
- * gnus.texi (Top): Ditto.
- * gnus.texi (Selecting a Group): Ditto.
- * gnus.texi (Delayed Articles): Ditto.
- * gnus.texi (Hiding Headers): Ditto.
- * gnus.texi (Getting Mail): Ditto.
- * gnus.texi (Comparing Mail Back Ends): Ditto.
- * gnus.texi (IMAP): Ditto.
- * gnus.texi (Required Back End Functions): Ditto.
- * gnusref.tex (MIMESummary): Ditto.
- * message.texi (Message Headers): Ditto.
- * message.texi (Mail Variables): Ditto.
- * pgg.texi (Prerequisites): Ditto.
- * pgg.texi (Architecture): Ditto.
- * pgg.texi (Backend methods): Ditto.
- * sieve.texi (Managing Sieve): Ditto.
-
-2003-05-17 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex (subsection*{Notes}): Fix.
-
-2003-05-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Anti-Spam Basics): Removed mention of gnus-junk.
-
-2003-05-13 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Agent Variables, Score File Format)
- (Troubleshooting, Editing IMAP ACLs, Conformity): a -> an.
-
- * message.texi (Insertion Variables): do.
-
-2003-05-13 Niklas Morberg <niklas.morberg@axis.com> (tiny change)
-
- * gnus.texi (IMAP, Agent and IMAP, Oort Gnus): s/a/an/.
-
-2003-05-12 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.texi (Agent Visuals): Add.
-
-2003-05-09 Simon Josefsson <jas@extundo.com>
-
- * pgg.texi (Default user identity): Add.
-
-2003-05-08 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Selecting a Group): Mention nil value
- gnus-large-newsgroup.
-
-2003-05-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (MIME Commands): Fix typo.
-
-2003-05-05 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex: Additions.
-
- * gnus.texi (Oort Gnus): Fix typo.
-
-2003-05-03 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus.texi (Agent Basics): Explain that some servers can be
- agentized, whereas others aren't.
-
-2003-05-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): Add prefix limit feature.
- (Oort Gnus): Fix last commit.
-
-2003-05-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Emacsen): Update.
-
-2003-05-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Document nnimap-need-unselect-to-notice-new-mail.
-
-2003-05-01 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Wide Characters): Proportional -> fixed width.
-
- * texi2latex.el (latexi-translate-file): Add @syncodeindex.
-
- * gnus.texi: Markup and formatting improvements.
- Use @syncodeindex for merging indexes to get the same font for
- @defvar and @vindex entries. Be more consistent about the case
- of index entries.
-
-
-2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Top, Appendices): Fixed Gnus FAQ entry.
-
- * gnus-faq.texi: Wrap long lines in menus. Index.
-
- * gnus.texi (Image Enhancements): Mention missing images support
- of Emacs on MS Windows.
- (Oort Gnus): Mention Gnus FAQ.
-
-2003-04-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): revised
- documentation
- (Gmane Spam Reporting, Anti-spam Hashcash Payments): new sections
-
-2003-04-30 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Oort Gnus): New features in Gnus 5.10 from GNUS-NEWS.
-
-2003-04-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): Index.
- Add gnus-spam-mark.
- (Various Summary Stuff): Add gnus-summary-display-arrow.
-
- * gnus.texi: Fix typos.
-
-2003-04-27 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Group Parameters): Fix markup.
- (Web Archive): Ditto.
-
-2003-04-27 Jesper Harder <harder@ifa.au.dk>
-
- * texi2latex.el (latexi-translate-file): Support @display,
- @group, @smallexample, @subsubheading.
-
- * gnus.texi, gnus-faq.texi: Fix some of the worst overfull and
- underfull hboxes.
-
- * message.texi, gnus.texi: Use the second arg to @uref where it
- makes sense to make HTML and PDF output look nicer.
-
-2003-04-26 Jesper Harder <harder@ifa.au.dk>
-
- * gnus-faq.texi: Make it compile in the LaTeX version. Remove
- redundant entries in @urefs.
- (FAQ - Glossary): Remove the final @bye since it breaks the Gnus
- manual.
- ([1.2]): @subsection -> @subheading.
-
- * texi2latex.el (latexi-translate-file): Support @r, @env,
- @heading, @subheading, @TeX.
-
- * gnus.texi, message.texi, emacs-mime.texi: Markup improvements
- and fixes.
-
-2003-04-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Selecting a Group): Add gnus-large-ephemeral-newsgroup.
- (Filling In Threads): Add gnus-fetch-old-ephemeral-headers.
- (Terminology): Index.
-
-2003-04-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: nil -> @code{nil}. Capitalize "Rmail" and "Babyl"
- consistently.
-
-2003-04-22 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi: Allow inclusion in `gnus.texi' again.
-
-2003-04-21 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus-faq.texi: New, the Gnus FAQ from http://my.gnus.org/FAQ.
- From Frank Schmitt <ich@frank-schmitt.net>.
-
- * gnus.texi (Server Variables): Added server parameters and index.
-
-2003-04-21 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@gmx.net>
-
- * gnus.texi (Group Parameters): Pointer to
- gnus-newsgroup-variables.
-
-2003-04-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Buffer Lines): Add
- gnus-sum-thread-tree-false-root.
-
-2003-04-15 Michael Shields <shields@msrl.com>
-
- * gnus.texi (Group Parameters, Hiding Headers): Document that
- the broken-reply-to group parameter now also affects header
- hiding.
- * gnus.texi (Summary Mail Commands): Suggest setting the
- broken-reply-to parameter if you find yourself using `B r'.
-
-2003-04-16 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (MML Definition): Add sender tag.
-
-2003-04-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Line Specification): Add.
-
-2003-04-13 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Security): Add text about PGP key snarf.
-
-2003-04-13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Misc Article): Addition.
-
-2003-04-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Message Headers): Addition.
-
-2003-04-12 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Encoding Customization): Update default for
- mm-body-charset-encoding-alist.
-
-2003-04-08 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Non-MIME): Add diff.
-
-2003-04-07 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Security): Fix typo.
-
-2003-04-06 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi: Changed ~/.gnus and .gnus.el to ~/.gnus.el
-
-2003-04-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Gnus Versions): Index.
- (Summary Score Commands): Decribe keys in `*Score Trace*' buffer.
-
-2003-04-01 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Button Levels): Added
- `gnus-button-ctan-directory-regexp'
-
-2003-04-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Indirect Functions): Fix examples for
- nntp-via-rlogin-command-switches.
-
-2003-03-31 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Button Levels): New node.
- (Article Buttons): Additions.
-
-2003-03-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Exiting Gnus): Removed gnus-unload.
-
-2003-03-31 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Add.
-
-2003-03-27 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Comparing Mail Back Ends): Note nnmaildir's
- incompatibilities more prominently.
-
-2003-03-27 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Maildir): Note nnmail-expiry-target incompatibility.
-
-2003-03-27 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Adaptive Scoring): Fix.
-
-2003-03-23 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Direct Functions, Common Variables)
- (Mail Source Specifiers, IMAP): Add TLS wherever SSL is mentioned
- now.
-
-2003-03-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Information, Article Washing)
- (Formatting Fonts, Group Parameters): Fix external xrefs.
-
- * message.texi (Mailing Lists): do.
-
-2003-03-22 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Troubleshooting): Fix typo.
- (Drafts): Mention how to restore special property, suggested by
- Florian Weimer <fw@deneb.enyo.de>.
-
-2003-03-19 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Misc Article): Add.
- (Agent Basics): Fix makeinfo warnings.
-
- * message.texi (IDNA): New.
-
-2003-03-18 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.texi (Gnus Unplugged): Refer to new agent Group/Topic
- parameters.
- (Category Syntax): New description.
- (Category Buffer): New command.
- (Category Variables): New variables.
- (Agent as Cache): Expanded description.
- (Agent Expiry): Expanded description.
- (Agent Variables): Fixed and new descriptions.
-
- * infohack.el (batch-makeinfo): Provide local implementation of
- subst-char-in-region as the built-in implementation is unreliable
- on Windows XP (Intermittent failure results in build looping
- forever).
-
-2003-03-18 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Maildir): Replace create-directory with
- target-prefix.
-
-2003-03-18 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Maildir): More info for expire-group; add
- distrust-Lines:.
-
-2003-03-17 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Comparing Mail Back Ends): nnmaildir fixes.
-
-2003-03-17 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Using MIME): Added gnus-mime-delete-part.
-
-2003-03-17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Required Back End Functions): Add.
-
-2003-03-17 Frank Haun <pille3003@fhaun.de> (tiny change)
-
- * pgg.texi: Fix setfilename.
-
-2003-03-09 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Top): Added menu item for Maildir node.
-
-2003-03-11 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Paging the Article): Addition.
-
-2003-03-10 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Customizing Articles): Additions.
-
-2003-03-09 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Maildir): New node.
-
-2003-03-08 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex: Update.
-
-2003-03-03 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail and Post): Updated `gnus-user-agent'.
- (Mail Source Customization): Added `mail-source-delete-incoming'
- and `mail-source-delete-old-incoming-confirm'.
-
-2003-03-01 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Troubleshooting): Fix typo.
- (Group Parameters): Markup fix.
- (Article Hiding, Splitting Mail, Fancy Mail Splitting)
- (Document Server Internals, Score Variables, Adaptive Scoring)
- (X-Face, Hashcash): do.
-
-2003-02-28 Vasily Korytov <deskpot@myrealbox.com>
-
- * gnus.texi: New values, 'to-list and 'cc-list, for
- gnus-boring-article-headers.
-
-2003-02-28 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Extending the spam elisp package): added mention of
- spam-list-of-statistical-checks
-
-2003-02-27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Remove the dependence on ssl.el.
-
-2003-02-26 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Mail Variables): Add
- message-sendmail-envelope-from.
-
-2003-02-24 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Mail and Post): Added `gnus-user-agent', removed
- `gnus-version-expose-system'.
-
-2003-02-24 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: Markup fixes.
-
- * message.texi: do.
-
- * emacs-mime.texi: do.
-
-2003-02-20 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (News Headers): Update description of Message-ID.
-
-2003-02-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Startup Files): Addition.
-
-2003-02-22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-2003-02-22 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Files and Directories): New node.
-
-2003-02-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Mailing List): Fix.
-
- * gnus.texi: Markup fixes.
-
-2003-02-18 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Washing): Mention `g'.
- (Customizing Articles): Added cross reference.
-
-2003-02-12 Michael Shields <shields@msrl.com>
-
- * gnus.texi (Paging the Article): Document
- gnus-article-boring-faces.
- (Choosing Commands): Explain that SPACE in the summary buffer
- is used for both selecting and scrolling.
-
- * gnus.texi (Article Keymap): Say that SPACE and DEL in the
- summary buffer are the same as switching to the article buffer
- and using SPACE and DEL; since now that is the case.
-
-2003-02-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Topic Commands): Addition.
-
-2003-02-07 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (BBDB Whitelists, Blacklists and Whitelists):
- corrected existing docs, added spam-use-whitelist-exclusive and
- spam-use-BBDB-exclusive to list of variables
-
-2003-02-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (The problem of spam): Don't use @email for examples
- -- it creates a mailto-link in HTML and PDF.
-
-2003-02-07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Customization): Addition.
-
-2003-02-04 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi (Mail Variables): Added index entry for
- `message-send-mail-partially-limit'
-
-2003-01-30 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Batching Agents): Index.
- (Agent Commands): do.
- (Delayed Articles): do.
- (Drafts): do.
- (Web Archive): do.
- (Article Washing): do.
- (Slave Gnusae): do.
- (Agent Basics): do.
- (Exiting Gnus): do.
- (Article Date): do.
- (X-Face): do.
- (Exiting the Summary Buffer): do.
- (Charsets): do.
- (Mail Group Commands): do.
-
- * gnus.texi: Mark-up fixes.
-
-2003-01-27 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi: replace `H' mark with `$' mark
- (Blackholes): add spam-blackhole-good-server-regex variable
-
-2003-01-26 Simon Josefsson <jas@extundo.com>
-
- * sieve.texi (Installation): Extension .sv is also used.
-
-2003-01-26 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Article Backlog): Update.
-
-2003-01-23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (NNTP): Addition.
-
-2003-01-23 Teodor Zlatanov <tzz@bwh.harvard.edu>
-
- * gnus.texi (Regular Expressions Header Matching): documentation
- for new spam splitting functionality
-
-2003-01-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Signing and encrypting): Index.
- (Smileys): Update.
- (Toolbar): Move to XVarious because it's XEmacs specific.
-
-2003-01-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Picons): Update.
-
-2003-01-22 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.texi (Agent Expiry, Agent Variables): Don't use @pxref for
- index entries.
-
-2003-01-22 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Add.
- (Expiring in IMAP): Typo fixes.
-
-2003-01-22 Kevin Greiner <kgreiner@xpediantsolutions.com>
-
- * gnus.texi (Agent Regeneration): New node.
- (gnus-select-article-hook): clarified.
- (gnus-downloaded-mark): Added definition.
- (gnus-undownloaded-mark): Updated definition to reference the new
- %O spec.
- (gnus-agent-catchup): Identified articles that are NOT marked as read.
- (gnus-agent-fetch-group): New command.
- (gnus-agent-fetch-series): New command.
- (Agent Expiry): Added comment to document that
- gnus-request-expire-articles may invoke gnus-agent-expire.
- (gnus-agent-mark-unread-after-downloaded): New variable.
- (gnus-agent-consider-all-articles): New variable.
- (gnus-agent-max-fetch-size): New variable.
-
-2003-01-22 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex (subsection*{Notes}): do.
-
- * gnus.texi (Article Hiding): Remove gnus-article-hide-pgp.
- (Customizing Articles): Remove gnus-treat-strip-pgp.
-
-2003-01-21 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Various Summary Stuff): Add
- gnus-summary-display-while-building.
- (Group Parameters): Index gnus-parameters.
- (Startup Files): Index gnus-site-init-file
-
-2003-01-20 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Buffer Lines): Additions to %B.
-
- * gnus.texi: Markup fixes: use @code for nil and t, use @file for
- files.
-
- * message.texi: do.
-
- * emacs-mime.texi: do.
-
-2003-01-19 Jesper Harder <harder@ifa.au.dk>
-
- * dir (File): Add pgg.
-
- * gnus.texi (Selecting a Group): Index gnus-auto-select-subject
-
- * emacs-mime.texi (Display Customization): Add mm-keep-viewer-alive-types
-
-2003-01-16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Agent Commands): Addition.
-
-2003-01-16 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package):
- clarified syntax of gnus-spam-process-destinations and
- gnus-ham-process-destinations variables
- (Extending the spam elisp package): fixed typo in node name
- (Bogofilter): new functionality and variables noted
- (Filtering Spam Using The Spam ELisp Package): added mention of
- nnimap-split-download-body
-
-2003-01-15 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Don't use `path' in some cases.
- From the GNU coding standards:
-
- Please do not use the term ``pathname'' that is used in Unix
- documentation; use ``file name'' (two words) instead. We use
- the term ``path'' only for search paths, which are lists of
- directory names.
-
- * message.texi: Ditto.
-
-2003-01-15 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (X-Face): Revert substantial part of last fix.
- (Splitting in IMAP): Add.
-
-2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Window Layout): Fixed braces in example.
-
-2003-01-13 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Washing): Use new function names in
- `deuglify.el'. Addition.
-
-2003-01-13 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (X-Face): Fix.
-
- * message.texi (Security): Fix.
-
- * gnus.texi (Security): Fix.
- (Signing and encrypting): Fix.
-
-2003-01-12 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using The Spam ELisp Package): removed
- spam.el and spam-stat.el from the node and section names wherever
- possible, since info indexing doesn't like `.' in the name
-
-2003-01-12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Display): Addition.
-
-2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Header Commands): Addition.
-
-2003-01-10 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Washing): Added gnus-outlook-unwrap-lines,
- gnus-outlook-repair-attribution, gnus-outlook-rearrange-citation.
-
-2003-01-11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Change .gnus to .gnus.el.
- (Agent Commands): Remove batch here.
- (MIME Commands): Add.
-
- * message.texi (Canceling News): Document canlock.
-
-2003-01-10 Alex Schroeder <alex@emacswiki.org>
-
- * gnus.texi (Creating a spam-stat dictionary): Explain how using
- the Gnus Agent with nnimap might work to do this.
- (Splitting mail using spam-stat): Use nnimap-split-fancy if you
- use the nnimap back end.
-
-2003-01-10 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Filtering Spam Using spam.el): Trivial fix.
-
-2003-01-10 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Choosing Variables, Agent Caveats): Add.
-
-2003-01-09 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using spam.el, ifile spam filtering)
- (spam-stat spam filtering): added new functionality and explained
- old functionality better, especially where it has changed in
- ham/spam/unclassified group exit processing.
-
-2003-01-09 Alex Schroeder <alex@emacswiki.org>
-
- * gnus.texi (Splitting mail using spam-stat): Fix typo.
- (Creating a spam-stat dictionary, Splitting mail using spam-stat):
- Fix markup in a few places.
-
-2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Positioning Point): %~ => ~*.
-
-2003-01-07 Reiner Steib <Reiner.Steib@gmx.de>
-
- * message.texi: Updated copyright line.
- (Mailing Lists): Updated (renamed) function names.
- (Header Commands): Updated (renamed) function names.
- (Header Commands): Added message-to-list-only,
- message-change-subject, message-cross-post-followup-to,
- message-reduce-to-to-cc and message-add-archive-header. Moved
- message-sort-headers, message-insert-to, message-insert-newsgroups
- and message-insert-disposition-notification-to from other
- sections.
- (Insertion): Added message-mark-inserted-region,
- message-mark-insert-file. Moved
- message-insert-disposition-notification-to to section (Header
- Commands).
- (Various Commands): Moved message-insert-wide-reply,
- message-insert-to, message-insert-newsgroups and
- message-sort-headers to (Header Commands) section.
- (Message Headers): Added message-subject-trailing-was-query.
- (Insertion Variables): Added message-mark-insert-begin and
- message-mark-insert-end.
-
-2003-01-08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Optional Back End Functions): Addition.
- (Positioning Point): Changed to %~.
-
-2003-01-08 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (MIME Commands): Add.
-
-2003-01-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Various Commands): Addition.
-
-2003-01-05 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Filtering Spam Using spam.el)
- (Blacklists and Whitelists, BBDB Whitelists, Blackholes)
- (Bogofilter, Ifile spam filtering, Extending spam.el): updated
- documentation for the new spam.el functionality
-
-2003-01-05 Jesper Harder <harder@ifa.au.dk>
-
- * refcard.tex: Fix pagebreak.
-
- * gnusref.tex: Additions and fixes.
-
- * booklet.tex: Add missing sections.
-
- * gnus.texi (Mail Group Commands): Fix typo.
- (XEmacs): Add sh-script.
- (Article Washing): Fix.
-
-2003-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Setting Process Marks): Addition.
- (Group Line Specification): Addition.
-
-2003-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Line Specification): Addition.
-
-2003-01-03 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi: Fix typos.
-
-2003-01-02 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Troubleshooting): Add.
-
-2003-01-02 Reiner Steib <Reiner.Steib@gmx.de>
-
- * gnus.texi (Article Buttons): Regexps are case insensitive here.
-
-2003-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Generation Commands): Addition.
-
-2003-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Message Headers): Added example.
- (Message Headers): Addition.
-
-2002-12-31 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.texi (Top): Add pointers to related manuals. Suggested by
- Reiner Steib.
-
-2002-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Saving Articles): Addition.
-
-2002-12-30 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Blackholes): added information on query-dig and
- dig.el; users are told that using blackhole checks is OK now
-
-2002-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Loose Threads): add
- gnus-summary-make-false-root-always.
- (Finding the Parent): Change name of nnweb server.
-
-2002-12-22 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi: Fix typos. Index variables. Add
- mm-automatic-external-display, mm-w3m-safe-url-regexp and
- mm-external-terminal-program.
-
-2002-12-20 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi (Message Headers): Add message-allow-no-recipients.
- (Various Commands): Add TAB and message-tab-body-function.
-
-2002-12-19 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Optional Back End Functions):
- nnchoke-request-update-info need not return the info object.
-
-2002-12-15 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex: Additions.
-
-2002-12-14 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Mail): Explain nil value of gnus-uu-digest-headers.
-
-2002-12-10 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.texi (Posting Styles): Clarify the `(header MATCH REGEXP)'
- case.
- (Back End Interface): Mention nnnotbackends. Suggested by Jan
- Rychter.
-
-2002-11-29 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.texi (MIME Commands): Document gnus-inhibit-mime-unbuttonizing.
-
-2002-11-27 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Expiring in IMAP): backend -> back end.
- (Wide Characters): The default value of
- gnus-use-correct-string-widths under Emacs is nil.
- (Filtering Spam Using spam.el): backend -> back end.
- (Extending spam.el): backend -> back end.
- (Filtering Spam Using Statistics (spam-stat.el)): Fix typo.
- (Creating a spam-stat dictionary): Fix typo.
- (Creating a spam-stat dictionary): backend -> back end.
-
-2002-11-22 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi (Extending spam.el): fixed typos and wrong @items
-
-2002-11-21 Teodor Zlatanov <tzz@lifelogs.com>
-
- * gnus.texi:
- added new keyboard commands
-
- * gnus.texi: added extended section on spam
-
-2002-11-18 jas
-
- * gnus.texi: Fix IMAP expiring typos.
-
-2002-11-18 kaig
-
- * gnus.texi: *** empty log message ***
-
-2002-11-18 jas
-
- * gnus.texi: More morse.
-
- * gnus.texi (Article Washing): Add morse.
-
-2002-11-17 jas
-
- * gnus.texi: Fix typo.
-
- * gnus.texi (Expiring in IMAP): Add.
- (Group Parameters): Add reference.
-
-2002-11-16 Kai Gro\e,A_\e(Bjohann <kai.grossjohann@uni-duisburg.de>
-
- * gnus.texi (Expiring Mail): Give summary on difference between
- auto-expire and total-expire and provide information for choosing
- between them.
-
-2002-11-18 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Article Washing): Add morse.
-
-2002-11-17 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Expiring in IMAP): Add.
- (Group Parameters): Add reference.
-
-2002-10-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (RSS): Add gnus-summary-mark-as-read-forward into the
- example code. From Christoph Conrad <christoph.conrad@gmx.de>.
-
-2002-10-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Other Marks): Document gnus-downloadable-mark and
- gnus-undownloaded-mark. Adapted idea from Sriram Karra
- <karra@shakti.homelinux.net>.
- (Formatting Fonts): Say that guillemets are wrong. (How to enter
- guillemets in Texinfo files?)
-
-2002-10-12 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Movement): Add.
-
-2002-10-11 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Formatting Fonts): Fix for balloon help in GNU Emacs.
-
-2002-10-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Delayed Articles): Fix gnus-delay-initialize.
-
-2002-10-10 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Security): Fix.
-
-2002-10-04 Simon Josefsson <jas@extundo.com>
-
- * pgg.texi: Document sign parameter.
-
- * gnus.texi: Add \gnuskey tex command.
-
- * texi2latex.el (latexi-translate-file): Do PGG. (Poor) support
- of @set, @deffn, @defvar, @defun, @key. Improve error.
-
- * Makefile.in: Add PGG.
-
- * pgg.texi: New file.
-
-2002-10-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Group Information): Mention prefix argument for
- gnus-group-fetch-charter and gnus-group-fetch-control.
- From Jesper Harder.
-
-2002-09-26 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Agent Variables): Add.
-
-2002-09-25 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Troubleshooting): Add.
-
-2002-09-23 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Maneuvering): Fix gnus-auto-select-next.
-
-2002-09-19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (X-Face): Add GIF.
-
-2002-09-18 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (A note on namespaces): New.
-
-2002-09-16 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Splitting Mail): "By default, splitting is performed
- on all incoming messages." This sentence had a "not" too many.
- Explicitly say that `nnmail-resplit-incoming' has effect only for
- `directory' mail-sources entries.
-
-2002-09-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Source Specifiers): Say "one-to-one
- correspondence" in the description of `directory'.
-
-2002-09-11 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Top, Summary Buffer): Add info to "Delayed Articles"
- menu line.
-
-2002-09-11 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Article Hiding): Add a document for
- gnus-article-address-banner-alist.
-
-2002-09-11 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Splitting in IMAP): Fix.
-
-2002-09-10 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Other Marks): Fix.
-
-2002-09-09 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Splitting Mail): Typo.
- (Comparing Mail Back Ends): Say "back end" instead of "backend".
- (Terminology): Try to explain "back end" better.
-
-2002-09-09 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Article Buttons): Add.
-
-2002-09-09 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Splitting Mail): Document nnmail-resplit-incoming,
- xref to Mail Source Specifiers.
- (Mail Source Specifiers): Add index entry for
- nnmail-scan-directory-mail-source-once. Add index entry for
- nnmail-resplit-incoming, with xref to Splitting Mail.
-
-2002-09-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Browse Foreign Server): Addition.
- (Limiting): Addition.articles
-
-2002-09-04 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Source Specifiers): Fix.
-
-2002-09-03 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Direct Functions, Common Variables): Named ports like
- "snews" doesn't work with some external tools. Thanks to
- "D. Watson" <djwatson@u.washington.edu> for noting this.
-
-2002-09-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Gnus Unplugged): Fix, agent is now enabled by default.
- (Agent as Cache): New.
-
-2002-08-26 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Information): Add gnus-group-fetch-charter and
- gnus-group-fetch-control.
-
-2002-08-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Posting Server): Document message-smtpmail-send-it.
-
- * message.texi (Mail Variables): Add message-smtpmail-send-it.
-
-2002-08-27 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Source Specifiers): Fix :path default.
-
-2002-08-22 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Mail Commands): Add
- gnus-summary-reply-broken-reply-to and
- gnus-summary-reply-broken-reply-to-with-original.
- (Setting Process Marks): Add gnus-uu-unmark-region
- (Article Header): Fix typo.
- (MIME Commands): Fix typo.
- (MIME Commands): Index gnus-article-decode-mime-words,
- gnus-article-decode-charset and gnus-mime-view-all-parts.
-
-2002-08-20 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Source Specifiers): Mention variable
- nnmail-resplit-incoming under `directory' specifier.
-
-2002-08-18 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Summary Buffer Lines): Document the %k specifier.
-
-2002-08-15 Jesper harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Line Specification): Add %C.
- (Group Parameters): Comments can be displayed in the group line.
-
-2002-08-07 Jesper harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Non-MIME): Add yenc.
- (yenc): New node.
-
-2002-08-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Sorting): Document randomization.
-
-2002-07-28 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Web Searches): Added gmane and removed old
- non-functioning search engines. From Niklas Morberg
- <niklas.morberg@axis.com>.
-
-2002-05-14 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Summary Buffer Lines): Fix typo.
-
-2002-07-27 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Summary Mail Commands): Trivial fix from Reiner Steib
- <4uce.02.r.steib@gmx.net>.
-
-2002-07-18 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus.texi (To From Newsgroups): Additional text regarding how to
- regenerate overviews via server buffer, and note to news admins
- about overview.fmt.
-
-2002-07-14 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Posting Styles): Fix example (it was using the To
- header instead of the From header). From Christopher Splinter
- <cs@splinter.inka.de>.
-
-2002-07-07 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Top): Move hashcash down into spam chapter.
- (Top): New spam menu.
- (Various): Remove hashcash.
- (Thwarting Email Spam): Split into introduction and "Anti-Spam
- Basics" node.
- (SpamAssassin): Add.
- (Hashcash): Add.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Doc fix.
-
-2002-07-02 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Washing Mail): Document the shortcoming of
- nnmail-remove-leading-whitespace.
-
-2002-06-30 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.texi (News Headers): Include example for removing an
- entry from message-required-news-headers.
-
-2002-06-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Add nntp-via-rlogin-command-switches.
-
-2002-06-27 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Back End Variables): Document
- nnmail-cache-ignore-groups. Xref Fancy Mail Splitting.
- (Fancy Mail Splitting): Mention nnmail-cache-ignore-groups and
- why it is useful.
-
-2002-06-25 Kai Gro\e,b_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Fancy Mail Splitting): Include all necessary
- variables in the Lisp example.
-
-2002-06-22 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Pay Hashcash): Add.
-
-2002-06-03 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Splitting Mail): Add.
-
-2002-05-23 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Web Searches): Fix. Trivial change from Niklas
- Morberg <niklas.morberg@axis.com>.
-
-2002-05-22 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail): Add variable.
-
-2002-05-16 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Loose Threads): Add gnus-simplify-all-whitespace.
-
-2002-05-08 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail-To-News Gateways): The default
- nngateway-header-transformation function inserts a "To" header,
- not a "From" header. From Jesper Harder <harder@ifa.au.dk>.
-
-2002-05-08 Josh Huber <huber@alum.wpi.edu>
-
- * message.texi (Security): Added a note about the signencrypt
- style, and how to change it using `mml-signencrypt-style.'
-
-2002-05-04 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (Encoding Customization): Fix.
-
-2002-05-04 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi: Move two chapters "Interface Functions" and
- "Basic Functions" after the Decoding and Encoding chapters. (No
- text modified.)
-
-2002-05-04 Simon Josefsson <jas@extundo.com>
-
- * emacs-mime.texi (Top): Change scope of manual to include users.
- (Customization): Rename to Display Customization.
- (MML Definition): Add cross references.
- (Encoding Customization): New section.
- (Charset Translation): More info and cross references.
-
-2002-05-01 Josh Huber <huber@alum.wpi.edu>
-
- * gnus.texi (Signing and encrypting): Fix doc. Also, add a
- paragraph about replysign/replyencrypt/replysignencryped use.
-
-2002-05-01 Lars Magne Ingebrigtsen <larsi@quimbies.gnus.org>
-
- * message.texi (Message Headers): Remove colon from index
- entries.
-
-2002-05-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Group Mail Splitting): Fix example.
- (Article Buttons): Document that REGEXP can be a variable as well.
-
- * message.texi (Message Headers): Fix example.
-
-2002-04-26 Steve Youngs <youngs@xemacs.org>
-
- * Makefile.in (infodir): Set to '@info_dir@' so we can separate
- defaults for XEmacs and Emacs.
-
-2002-04-27 Jesper Harder <harder@ifa.au.dk>
-
- * emacs-mime.texi (Customization): Update info on HTML renderers.
-
- * gnus.texi (Article Washing): Update information on HTML washing.
- Fix typos.
-
-2002-04-09 Paul Jarc <prj@po.cwru.edu>
-
- * .cvsignore: added message-[0-9]*
-
-2002-04-08 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Group Parameters): Point to the message manual for a
- full explanation of MFT.
- * message.texi (Mailing Lists): Mention
- message-gen-unsubscribed-mft.
- From Karra <karra@cs.utah.edu>.
-
-2002-04-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Saving Articles): Add xref to Mail Group Commands
- because people might be interested in `B c' for saving articles.
- (Archived Messages): Ditto.
-
-2002-04-01 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Sorting Groups): Add gnus-group-sort-selected-groups.
- (Article Washing): Fix typo.
-
- * message.texi (Various Commands): Index message-elide-ellipsis.
- Add message-sort-headers.
- (Mail Variables): Add message-qmail-inject-args,
- message-mailer-swallows-blank-line, message-sendmail-f-is-evil,
- message-qmail-inject-program.
- (Various Message Variables): Add message-auto-save-directory,
- message-strip-special-text-properties, message-cancel-hook.
- (News Headers): Index message-user-organization etc.
- (Forwarding): Add message-forward-before-signature.
- (Mailing Lists): Index message-subscribed-address-file.
- (Wide Reply): Add message-wide-reply-confirm-recipients.
- (Canceling News): Add message-cancel-message.
- (Sending Variables): Add message-interactive.
-
-2002-03-25 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Spool): Add cindex for marks.
- (Mail Folders): Add cindex for marks.
-
-2002-03-24 Raymond Scholz <rscholz@zonix.de>
-
- * gnus.texi (Summary Buffer Lines): Fix doc.
-
-2002-03-24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (booklet.dvi, booklet.pdf): Support booklet.
-
-2002-03-24 Felix Natter <fnatter@gmx.net>
-
- * booklet.tex, bk-at.tex, bk-lt.tex, gnuslog-booklet.eps: New file.
- * gnusref.tex, refcard.tex: Support booklet.
-
-2002-03-24 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex: Addition.
-
- * gnus.texi: Don't use @sc in headings.
- (Article Display): Fix.
- (Signing and encrypting): Add mml-unsecure-message.
- (IMAP): Remove @. to make texi2latex work.
- (Thread Commands): Fix.
- (Unavailable Servers): Add gnus-server-offline-server.
- (Topic Sorting): Add gnus-topic-sort-groups.
- (Limiting): Fix.
- (Article Washing): Fix gnus-article-strip-headers-in-body, add
- gnus-article-outlook-deuglify-article.
- (Article Header): Add gnus-article-remove-leading-whitespace.
- (Customizing Articles): Add gnus-treat-leading-whitespace.
- (Summary Score Commands): Add gnus-score-find-favourite-words.
- (Mailing List): Index gnus-mailing-list-insinuate.
- (Mail Group Commands): Add gnus-article-encrypt-body,
- gnus-summary-create-article. Don't use @var if not
- metasyntactic. Index gnus-summary-edit-article-done.
-
- * message.texi (Security): Add mml-unsecure-message.
- (Mailing Lists): Index message-goto-mail-followup-to.
-
-2002-03-23 Jesper Harder <harder@ifa.au.dk>
-
- * gnusref.tex, refcard.tex: Addition.
-
-2002-03-21 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Sending Variables): Fix typo.
- Trivial change from Raymond Scholz <rscholz@zonix.de>
-
-2002-03-09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Other Marks): Remove duplication.
- Trivial change from David Aspinwall <aspinwall@timesten.com>
-
-2002-03-09 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi: Mention nnmaildir where appropriate; fix some typos.
-
-2002-03-01 Paul Jarc <prj@po.cwru.edu>
-
- * message.texi (Mailing Lists): 'use is the default for
- message-use-mail-followup-to, not nil; 'use is also not t.
- Mention why an unsubscribed list poster might use MFT, and how to
- disable MFT for a single message.
-
-2002-02-25 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Splitting Mail): Addition.
-
-2002-02-23 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnusref.tex (subsection*{Notes}): Addition.
- Suggested by Felix Natter <fnatter@gmx.net>
-
-2002-02-22 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Splitting Mail): Addition.
-
-2002-02-20 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Slave Gnusae): Addition.
- From David S. Goldberg <david.goldberg6@verizon.net>
-
-2002-02-18 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * emacs-mime.texi (mailcap): Addition.
-
- * gnus.texi (Using MIME): Rename functions. Addition.
-
-2002-02-16 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Top): Change description of Posting Server node.
- (Composing Messages): Ditto.
- (Posting Server): Add some mail stuff.
- (IMAP): Terminate @, from Emacs Gnus manual.
- (Thwarting Email Spam): Use @sc.
-
-2002-02-16 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnusref.tex (subsection*{Notes}): Update.
- From: Felix Natter <fnatter@gmx.net>
-
-2002-02-14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Document Groups): Addition.
-
-2002-02-13 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * message.texi (Security): Fix @findex for the key `C-c C-m s p'.
-
-2002-02-13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- Reinstate some changes to make latexpdf work.
-
- * message.texi (Security): Don't use @key.
- (Various Commands): Don't use @point.
-
- * gnus.texi (Mail Source Specifiers): Use @uref.
-
-2002-02-13 Jesper Harder <harder@ifa.au.dk>
-
- * message.texi, gnus.texi, emacs-mime.texi: Use small caps
- consistently. MIME, NOV, NNTP, HTML, IMAP are written with @sc
- most places -- it looks better if it's the same *everywhere*.
- @kbd instead of @code for key sequences. @file instead of @code
- for files.
-
- * message.texi (Various Commands): use the proper @point glyph.
-
- * gnus.texi (Summary Mail Commands): \e,A_\e(B doesn't work. A German
- spelling reform changed the correct spelling to "muss" anyway (I
- think).
-
- * gnus.texi (Mail sources): \e,A'\e(B doesn't work. Use "section" instead.
-
- * gnus.texi (Mail Source Specifiers): use @url.
-
- * message.texi, emacs-mime.texi: update copyright year.
-
-2002-02-12 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Required Back End Functions): specify the lowest and
- highest article numbers for empty groups for nnchoke-request-list
- and nnchoke-request-group.
-
-2002-02-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Sending Variables): Addition.
-
- * gnus.texi (Group Parameters): Add unread, not read.
- (Archived Messages): Addition.
-
-2002-02-09 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Group Parameters): Addition.
- From: Steinar Bang <steinar@bang.priv.no>
-
-2002-02-08 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Washing): Addition.
- From: Michael Cook <michael.cook@cisco.com>
-
-2002-02-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Gnus Unplugged): Use (setq gnus-agent t).
- (Example Setup): Ditto.
- (Category Syntax): Require gnus-agent.
-
-2002-02-06 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Posting Styles): Addition.
-
-2002-02-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Mailing Lists): Addition.
- * gnus.texi (Group Parameters): Addition.
- From Sriram Karra <karra@cs.utah.edu>.
-
-2002-02-03 Karl Kleinpaste <karl@charcoal.com>
-
- * gnus.texi (Summary Score Commands): Added detail on "extra"
- header scoring.
- (Score File Format): ditto
-
-2002-02-01 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Customization): Addition.
-
-2002-01-31 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Posting Styles): Addition. Suggested by
- Michael Cook <michael@waxrat.com>.
-
-2002-01-30 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Customization): Move emacs-w3m stuff backward;
- added documentation for `mm-inline-text-html-with-w3m-keymap'.
-
-2002-01-28 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Agent Expiry): Addition.
-
-2002-01-28 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Customization): Added documentation for
- `mm-inline-text-html-with-images'.
-
- * gnus.texi (Article Washing): Replace w3m to emacs-w3m.
-
-2002-01-26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Spool): Addition.
-
-2002-01-24 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * emacs-mime.texi (Customization): Added documentation for
- `mm-inline-text-html-renderer'.
-
-2002-01-23 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Article Washing): Add URL about w3m.
-
-2002-01-22 Josh Huber <huber@alum.wpi.edu>
-
- * emacs-mime.texi (MML Definition): Added a few words about the
- recipients option.
- * message.texi (Security): Changed documentation to reflect use of
- the new secure tag.
-
-2002-01-21 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Washing): Addition.
-
-2002-01-20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Document Groups): Added info on more doc types.
- (More Threading): Move documentation here.
-
-2002-01-20 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Mailing Lists): Fix. From Love
- <lha@stacken.kth.se>.
-
-2002-01-20 Patric Mueller <bhaak@gmx.net>
-
- * gnus.texi (Group Timestamp): Typo fix.
-
-2002-01-19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Selecting a Group): Addition.
-
-2002-01-19 Lars Magne Ingebrigtsen <karra@cs.utah.edu>
-
- * gnus.texi (Mail Spool): Note that the .marks files can be
- removed.
-
-2002-01-17 Paul Jarc <prj@po.cwru.edu>
-
- * gnus.texi (Choosing a Mail Back End): mention nnmaildir.
- (Comparing Mail Backends): briefly describe nnmaildir.
-
-2002-01-17 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Agent Commands): Use gnus-agent-batch instead of
- gnus-agent-batch-fetch.
-
-2002-01-15 Tue Jari Aalto <jari.aalto@poboxes.com>
-
- * gnus.texi (Really Various Summary Commands): Added commands how
- to create nnvirtual group and and how to modify the nnvirtual
- regexp
-
-2002-01-12 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Agent Caveats): Add agent cache.
- (Agent Variables): Addition.
-
-2002-01-12 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Conformity): Fix typo.
-
- * emacs-mime.texi (Flowed text, Standards): Add.
-
-2002-01-11 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Mailing Lists): Addition.
- * gnus.texi (Group Parameters): Addition.
- From Sriram Karra <karra@cs.utah.edu>.
-
-2002-01-10 Colin Marquardt <c.marquardt@alcatel.de>
-
- * gnus.texi (Changing Servers): Addition.
-
-2002-01-06 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Archived Messages): Rename
- gnus-inews-mark-gcc-as-read to gnus-gcc-mark-as-read.
-
- * Makefile.in (clean): Clean thumb*.
-
-2002-01-05 Harry Putnam <reader@newsguy.com>
-
- * gnus.texi (Score Variables): Clarify.
-
-2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Agent Expiry): Addition.
- (Sorting the Summary Buffer): Addition.
-
-2002-01-05 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Conformity): Add MIME and Disposition Notifications.
-
- * message.texi (Header Commands): Fix. Add m-goto-from.
- (Insertion): Add m-i-disposition-notification-to.
-
-2002-01-05 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (.latexi.pdf-x): Use thumbpdf.
-
- * gnus.texi (Advanced Formatting): Double @'s. Use thumbpdf.
- colorlinks=true.
-
-2002-01-05 Norman Walsh <ndw@nwalsh.com>
-
- * gnus-faq.texi: Fix typo.
-
-2002-01-05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Sorting the Summary Buffer): Addition.
-
-2002-01-04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Virtual Groups): Addition.
-
-2002-01-03 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Keymap): Addition.
- (Summary Mail Commands): Fix.
-
-2002-01-02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Timestamp): Addition. Example from Andras
- BALI.
- (X-Face): Addition.
- (Advanced Formatting): Add example.
-
-2002-01-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Conformity): Add and fix.
-
- * message.texi (Security): Mention gpg-temp-directory.
-
- * gnus.texi (Article Washing): Link to Security section.
- (Security): Fix.
- (Signing and Encrypting): Renamed from Using GPG.
- (IMAP): Fixes.
-
-2002-01-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Customizing Articles): Add crossreference links. Add
- gnus-body-boundary-delimiter.
-
-2002-01-01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Choosing Commands): Addition.
- (Article Display): Update.
- (Article Display): Addition.
- (Article Header): New.
- (Slow Terminal Connection): Addition.
- (Predicate Specifiers): New.
- (To From Newsgroups): Addition.
- (Topic Commands): Addition.
- Update the menus.
- Fix some references b0rked up by the menu fixing.
-
-2001-12-31 Rui Zhu <sprache@iname.com>
-
- * emacs-mime.texi (Customization): Typo fix.
-
-2001-12-31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Display): Addition.
-
- * emacs-mime.texi (Interface Functions): Addition.
-
- * gnus.texi (Using MIME): Addition.
-
-2001-12-30 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (X-Face): Made into own node.
- (Article Display): New.
-
- * emacs-mime.texi (Interface Functions): Addition.
-
- * message.texi (Message Headers): Addition.
-
-2001-12-29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (Customization): Added example.
-
- * gnus.texi (Selecting a Group): Addition.
- (Tree Display): Addition.
-
-2001-12-26 Florian Weimer <fw@deneb.enyo.de>
-
- * gnus.texi (Using GPG): Remove obsolete reference to gpg-2comp.
-
-2001-12-26 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Summary Buffer Lines): Add xrefs. Suggested by
- Arcady Genkin <agenkin-dated-1010249095.131f22@thpoon.com>.
-
-2001-12-26 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Add a note for `nntp-prepare-post-hook'.
-
-2001-12-18 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog, gnus.texi, emacs-mime.texi: (oops) removed
- buffer-file-coding-system
-
-2001-12-18 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * ChangeLog, gnus.texi, emacs-mime.texi: Local Variables `coding'
- MUST be added!
-
-2001-12-17 Josh Huber <huber@alum.wpi.edu>
-
- * ChangeLog: changed coding to buffer-file-coding-system
- * emacs-mime.texi: changed -*- magic cookie -*- to Local Variables
- * gnus.texi: same
- * gnus-ref.tex: same
- * refcard.tex: same
-
-2001-12-16 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Saving Articles): Add muttprint.
- (Article Commands): Mention muttprint.
-
-2001-12-15 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Virtual Groups): Fix. From Raymond Scholz
- <ray-2001@zonix.de>.
-
-2001-12-15 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi, emacs-mime.texi: Fix the header.
-
-2001-12-12 Didier Verna <didier@lrde.epita.fr>
-
- * gnus.texi (Misc Group Stuff): advertise `gnus-group-news'.
- * gnus.texi (Summary Mail Commands): advertise
- `gnus-summary-news-other-window'.
-
-2001-12-10 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Advanced Scoring Examples): Clarify that the
- examples are rules, not complete score files.
-
-2001-12-09 Nevin Kapur <nevin@jhu.edu>
-
- * gnus.texi (Expiring Mail): Add.
-
-2001-12-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Splitting in IMAP): Typo. From Colin Marquardt
- <c.marquardt@alcatel.de>.
-
-2001-12-03 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * infohack.el (infohack): To process write-protected files safely,
- make this buffer be writable after `find-file'.
- From TSUCHIYA Masatoshi <tsuchiya@namazu.org>
-
-2001-12-03 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Dependence.
-
- * emacs-mime.texi: Add coding header.
-
-2001-12-01 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Group Line Specification, Summary Buffer Lines):
- Cross reference Positioning Point.
-
-2001-11-25 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Limiting): Addition.
-
-2001-11-19 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Header Commands, Insertion): Use C-c C-f C-i for
- Importance: instead of C-c C-u. Move to Header Commands from
- Insertion. Suggested by Per Abrahamsen <abraham@dina.kvl.dk>.
-
-2001-11-17 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Insertion): Use C-c C-u for Importance: instead of
- C-c C-p (used by SC).
-
-2001-11-15 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Insertion): Add C-c C-p,
- message-insert-importance-{low,high}.
- (Various Commands): Fix typo.
- (Insertion Variables): New section, all variables moved from
- Commands->Insertion into this node, Variables->Insertion
- Variables.
-
-2001-11-15 14:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Various Summary Stuff): Add gnus-newsgroup-variables.
-
-2001-11-15 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Security): @uref not @url.
-
-2001-11-15 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * sieve.texi (Standards): Changed @samp to @uref.
-
- * message.texi (Security): Changed @code to @uref.
-
- * gnus-faq.texi: Changed a lot of @file to @uref.
-
- * emacs-mime.texi (Standards): Changed @samp to @uref.
-
-2001-11-13 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Article Washing): Add `W s'.
-
-2001-11-12 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Security, Using GPG):
- * message.texi (Security):
- * emacs-mime.texi (MML Definition): Add PGP.
-
-2001-11-09 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.texi (Movement): message-beginning-of-line.
-
-2001-11-07 Simon Josefsson <jas@extundo.com>
-
- * sieve.texi (Examples): Add.
- (Top): Add.
-
- * gnus.texi (Saving Articles): Add gnus-summary-write-to-file.
-
-2001-11-07 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Misc Group Stuff): Add cross reference to Composing
- Messages. Suggested by "Golubev I. N." <gin@mo.msk.ru>.
-
-2001-11-04 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Use C-M- instead of M-C-.
- * message.texi (Insertion): Ditto.
- * sieve.texi (Managing Sieve): Ditto.
- Suggested by Eli Zaretskii <eliz@is.elta.co.il>.
-
-2001-11-02 Simon Josefsson <jas@extundo.com>
-
- * dir (File): Add Sieve.
-
- * gnus.texi (Sieve Commands): Add crossposting.
-
-2001-11-01 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * texi2latex.el (latexi-translate): Typo.
- (latexi-translate-file): Nine in a herd is enough.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * sieve.texi (Installation): Workaround texi2latex bug (replacing
- inside verbatim needs a \end{verbatim} earlier in the file).
-
- * texi2latex.el (latexi-translate): Add sieve.
-
-2001-11-01 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Washing): Add a note.
-
-2001-11-01 Simon Josefsson <jas@extundo.com>
-
- * Makefile.in: Add sieve.
-
- * gnus.texi (Misc Group Stuff):
- (Group Parameters): Add Sieve Commands.
- (top-level): Include Sieve manual after Emacs MIME.
-
-2001-10-31 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Group Parameters): Add integer `display'.
- (IMAP): Fix.
-
-2001-10-31 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (NNTP): Added documentation for
- `nntp-prepare-post-hook'.
-
-2001-10-29 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Customizing Articles): Sort list. Remove
- duplicate. Suggested by Henrik Holm <henrik@tele.ntnu.no>.
-
-2001-10-27 Simon Josefsson <jas@extundo.com>
-
- * message.texi (Insertion): Fix message-yank*-prefix.
-
-2001-10-25 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Source Specifiers): More info on SSL, kerberos etc.
- (IMAP): Ditto. Suggested by Martin Blais <blais@discreet.com>.
-
-2001-10-23 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.texi (Posting Server): Use `native' instead of `nil' for
- posting to native server.
-
-2001-10-22 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * dir (File): Add standard explanation header.
-
-2001-10-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Source Specifiers): Explain more explicitly what
- happens for the `directory' entries. Say that mail from foo.spool
- goes in the group foo.
-
-2001-10-19 Simon Josefsson <jas@extundo.com>
-
- * Makefile.in (clean): rm gnus.out.
- (distclean): rm gnusconfig.tex (moved from "clean").
-
- * gnus.texi (Using MIME): s/mime/MIME/ for PDF version.
-
-2001-10-19 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Finding the News): Disrecommend nnspool for Leafnode
- users.
-
-2001-10-17 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Archived Messages): Add new line after @item.
- From: Jesper Harder <harder@ifa.au.dk>
-
-2001-10-17 21:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Formatting Basics): Extended format specs.
-
-2001-10-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.texi (Summary Buffer Lines): Documment %( and %).
-
-2001-09-04 21:43:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Topic Sorting): Addition.
-
-2001-10-13 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * refcard.tex, gnusref.tex: Merge with the version
- from Felix Natter <f.natter@ndh.net>
-
-2001-10-13 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * refcard.tex: Set version to Oort.
-
- * gnusref.tex: New key bindings in Oort Gnus.
-
-2001-10-12 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (.dvi.ps): Use TEXPICTS.
- (.latexi.dvi-x): Remove gnus.toc as well.
-
- * gnuslogo-refcard.eps: Remove BeginProcSet.
-
-2001-10-12 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Misc Group Stuff): Add UTF-8.
- (Misc Article): Document wash status characters. Suggested by
- david.goldberg6@verizon.net (David S. Goldberg).
-
-2001-10-10 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnusref.tex, refcard.tex: Use epsfig.
-
- * gnuslogo-refcard.eps: Rename from gnuslog.refcard, and set a
- suitable bounding box.
-
- * Makefile.in (.dvi.ps): New rule.
- (refcard.pdf): Use gnuslogo-refcard.eps.
-
-2001-10-09 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Add href and bookmarks for pdf version.
-
-2001-10-06 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (uninstall): Add uninstall.
-
-2001-10-05 Simon Josefsson <jas@extundo.com>
-
- * Makefile.in (clean): Add gnusconfig.tex. Suggested by Henrik
- Enberg <henrik@enberg.org>.
-
-2001-10-04 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Source Customization): Add.
-
-2001-10-04 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (dvi): Don't depend on tmps.
-
-2001-10-03 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * emacs-mime.texi (mailcap): rvplayer -> wavplayer. Thanks to
- Martin Kretzschmar <Martin.Kretzschmar@inf.tu-dresden.de>.
-
-2001-09-29 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Foreign Groups): Fix. Add "mailman".
- (Document Groups): Ditto.
-
-2001-09-28 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in (.texi): Remove $@ first.
-
- * infohack.el (infohack-remove-unsupported): Remove @iflatex lines.
- (infohack): Specify a coding-system to save info files.
- From Katsumi Yamaoka <yamaoka@jpl.org>
-
-2001-09-28 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnusconfig.tex.in: Use cmss if pfu is not found.
-
-2001-09-27 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Illustrated manual.
- * gnus.texi: Put message.texi and emacs-mime.texi in the
- illustrated manual.
- * texi2latex.el: Ditto.
-
-2001-09-27 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Remove the extra white-space.
-
-2001-09-27 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnusconfig.tex.in: New.
- * gnus.texi: Use it.
- * pagestyle.sty: Don't set verbatim font.
- * postamble.tex: Set in ...
- * bembo.sty: Removed.
- * Makefile.in (gnusconfig.tex): Check gnusconfig.tex.in.
- (LATEX): Use configure.
-
-2001-09-26 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Limiting): Addition.
-
-2001-09-25 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Pterodactyl Gnus): Put @item in one line.
-
-2001-09-24 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: eps path fix.
- * postamble.tex: Ditto.
- * texi2latex.el: Ditto.
-
- * Makefile.in: Move some to ps/Makefile.in.
-
-2001-09-24 Simon Josefsson <jas@extundo.com>
-
- * etc/*, herds/*, misc/*, picons/*, screen/*, smilies/*, xface/*:
- New files, from pspackage.tar.gz.
-
- * Makefile.in (distclean): Make veryclean.
-
- * gnus.texi (Summary Mail Commands): Fix.
- (Summary Post Commands): Fix.
- (The Manual): Fix.
-
-2001-09-23 02:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Use "back end".
-
-2001-09-23 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Top): Move IMAP up from "Other Sources" to "Select
- Methods".
- (Charsets): Update default value.
- (Finding the Parent): Add nnimap.
- (Security): Add.
- (Mailing List): Add.
- (Archived Messages): Comment out XEmacs 19 stuff.
- (Using GPG): Add reference to message manual.
- (Direct Functions): Mention OpenSSL as well as SSLeay.
- (Mail Source Specifiers): Add recent IMAP :stream and
- :authentication.
- (Agent Commands): Fix.
- (GroupLens): Add URL and note about this being historical.
- (Wide Characters): Update default value.
- (Picon Requirements): Remove old XEmacs 19 stuff.
-
-2001-09-22 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Other Marks): Add Recent.
-
-2001-09-14 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Folders): Add.
-
-2001-09-11 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Delayed Articles): Fix. Suggested by Paul Jarc
- <prj@po.cwru.edu>.
-
-2001-09-08 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (MIME Commands): Add gnus-buttonized-mime-types.
-
-2001-09-08 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Topic Commands): Make this the first subsection of
- `Group Topics'. Rearrange keys to mention the most important keys
- first and to have subsections. Add some more explanation for
- C-k/C-y.
- (Group Buffer): Add comment from Alex Schroeder as todo item.
-
-2001-09-06 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Fancy Mail Splitting): Mention `delete' near the
- explanation of `junk'.
-
-2001-09-04 Katsumi Yamaoka <yamaoka@jpl.org>
-
- * gnus.texi (Optional Backend Functions): The default function to
- make a date format is `message-make-date', which should produce a
- time zone.
-
-2001-09-04 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Optional Backend Functions): More detail about the
- DATE arg for nnchoke-request-newgroups. Reported by Paul Jarc.
-
-2001-09-01 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Hooking New Backends Into Gnus): Say where to put the
- call for gnus-declare-backend. Add an index entry for
- gnus-declare-backend. Suggested by Paul Jarc.
-
-2001-08-29 Simon Josefsson <jas@extundo.com>
- From Anders Jackson <jackson@hig.se>
-
- * gnus.texi (Group Parameters): Fix.
-
-2001-08-27 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Archiving Mail): Add.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Mail Spool): Add marks.
- (MH Spool): Doesn't use marks file.
- (Mail Folders): Add marks.
-
-2001-08-25 Simon Josefsson <jas@extundo.com>
- From Henrik Enberg <henrik@enberg.org>
-
- * gnus.texi (Group Parameters): Fix.
-
-2001-08-24 16:03:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Parameters): Fix.
-
-2001-08-24 Simon Josefsson <jas@extundo.com>
-
- * Makefile.in (latexps): Make tmps.
-
-2001-08-24 Simon Josefsson <jas@extundo.com>
- From Jesper Harder <harder@ifa.au.dk>
-
- * Makefile.in (latexps): Escape {.
-
- * splitindex: Ditto.
-
-2001-08-23 19:22:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Parameters): Fix.
- (Group Parameters): Addition.
- (Limiting): Addition.
-
-2001-08-21 23:55:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Score Variables): Fix.
-
-2001-08-20 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Delayed Articles): New section. Documents
- gnus-delay.el.
- (Fancy Mail Splitting): Say that nnmail-cache-accepted-message-ids
- must be non-nil for splitting with parents to work.
-
-2001-08-19 17:31:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Other Marks): Addition.
- (Positioning Point): New.
- (Tabulation): New.
-
-2001-08-19 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Getting Started Reading Mail): Use (nnml "") rather
- than (nnml "private") as the example server specification. This
- way, the example group names a few paragraphs further down are
- correct, and I expect that most people are going to use the empty
- string as name, anyway. Please holler if that is wrong.
-
-2001-08-18 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (Optional Backend Functions): Remove `set'
- request-set-mark action.
-
-2001-08-18 00:40:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Wide Characters): New section.
-
-2001-08-17 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi: Replace 20,20 with 23,23 for
- gnus-summary-line-format.
-
-2001-08-17 14:24:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Parameters): Document regexp substitution.
- (Group Parameters): Addition.
-
-2001-08-11 23:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Nevin Kapur <nevin@jhu.edu>
-
- * gnus.texi (September Gnus): Typo.
-
-2001-08-12 Simon Josefsson <jas@extundo.com>
- Suggested by Kai.Grossjohann@CS.Uni-Dortmund.DE
-
- * gnus.texi (Other Marks): Add recent.
- (Optional Backend Functions): Add forward and recent.
-
-2001-08-12 Kai Grossjohann <grossjoh@ls6.informatik.uni-dortmund.de>
-
- * gnus.texi (Window Layout): Renamed from `Windows
- Configuration'. After all, we're not talking about Microsoft.
- Suggested by Barry Fishman.
-
-2001-08-11 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Summary Mail Commands): Remove duplicate explanation
- of `S W'. Reported by Norbert Koch.
-
-2001-08-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Benjamin Rutt <brutt@bloomington.in.us>
-
- * gnus.texi (Troubleshooting): Addition.
-
-2001-08-09 Simon Josefsson <jas@extundo.com>
- From Benjamin Rutt <brutt@bloomington.in.us>
-
- * gnus.texi (Mail Backend Variables): Fix.
-
-2001-08-04 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Summary Buffer Lines): Mention `gnus-goto-colon'.
-
-2001-08-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Backend Interface): Explain about article numbers.
- Suggested by Paul Jarc.
-
-2001-08-02 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * emacs-mime.texi (Non-MIME): Addition.
-
- * gnus.texi (Group Parameters): Addition.
- (Mailing List): Addition.
-
-2001-08-01 Simon Josefsson <jas@extundo.com>
-
- * texi2latex.el (latexi-translate-file): Don't use point-at-bol.
- (latexi-translate-file): Translate some more things, including
- some hardcoded things that cause problems for LaTeX. From Jesper
- Harder <harder@ifa.au.dk>.
-
-2001-07-31 Simon Josefsson <jas@extundo.com>
-
- * bembo.sty: New file.
-
- * texi2latex.el (latexi-translate-file): Support @noindent.
-
- * gnus-faq.texi (Reading News FAQ): Fix (@email -> @samp).
-
-2001-07-28 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Janne Rinta-Manty <rintaman@cs.helsinki.fi>
-
- * gnus.texi (Read Articles): Typo.
-
-2001-07-25 22:22:22 Raymond Scholz <rscholz@zonix.de>
-
- * gnus.texi (Fancy Mail Splitting): New variable
- nnmail-split-fancy-with-parent-ignore-groups
-
-2001-07-24 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Duplicates): Make split method regexp more specific,
- in case other `Gnus-Warning' headers are added in the future.
- Suggested by Karl Kleinpaste.
-
-2001-07-23 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Karl Kleinpaste <karl@charcoal.com>
-
- * gnus.texi (Summary Buffer Lines): Add %B.
-
-2001-07-20 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Jesper Harder <harder@myrealbox.com>
-
- * message.texi (Insertion): Addition.
-
-2001-07-19 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Charsets): Addition.
-
-2001-07-17 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Searching for Articles): Raw articles.
-
-2001-07-16 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.texi (Insertion): Refer to gnus-cite-attribution-suffix.
-
-2001-07-13 12:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (RSS): Add.
- From Christoph Conrad <cc@cli.de>.
-
-2001-07-13 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Incorporating Old Mail): Add index.
-
-2001-07-13 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Group Parameters): Add.
-
-2001-07-04 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Add.
-
-2001-07-04 Didier Verna <didier@lrde.epita.fr>
-
- * gnus.texi (Example Methods): use the new nntp-open-connection
- methods in the examples.
- * gnus.texi (NNTP): update for the new nntp-open-connection methods.
- * gnus.texi (Direct Functions): new node.
- * gnus.texi (Indirect Functions): new node.
- * gnus.texi (Common Variables): new node.
-
-2001-06-27 Simon Josefsson <jas@extundo.com>
- From Ralph Schleicher <rs@nunatak.allgaeu.org>
-
- * gnus.texi (MIME Commands): Add.
-
-2001-06-24 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Summary Score Commands): Say that some commands
- create ADAPT files.
-
-2001-06-23 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Duplicates): Contents of Gnus-Warning header have
- changed. Reported by Peter J Acklam.
-
-2001-06-19 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Fix `imtest' discussion.
-
- * gnus-faq.texi (Frequently Asked Questions): Fix URL.
-
-2001-06-17 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Group Line Specification): Explain why %t is only an
- estimate.
-
-2001-06-16 Simon Josefsson <jas@extundo.com>
-
- * gnus.texi (IMAP): Add.
-
-2001-06-13 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Washing): Add.
-
-2001-06-11 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: behaviour -> behavior. Suggested by Eli Zaretskii
- <eliz@is.elta.co.il>.
-
-2001-06-09 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Apply "overfull hbox" patch from Eli Zaretskii
- <eliz@is.elta.co.il>.
-
-2001-06-07 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (RSS): Add.
-
-2001-05-31 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Setting Marks): Add.
-
-2001-05-27 Simon Josefsson <simon@josefsson.org>
-
- * message.texi (Insertion): Add message-yank-cited-prefix.
-
-2001-05-22 Simon Josefsson <simon@josefsson.org>
- From Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Article Washing): Add.
-
-2001-05-16 Simon Josefsson <simon@josefsson.org>
- From Jesper Harder <harder@ifa.au.dk>
-
- * texi2latex.el (latexi-translate-file): Also exchange ref.
-
- * gnus.texi: Add \gnusref and \gnusuref.
-
-2001-05-16 Simon Josefsson <simon@josefsson.org>
- From Raymond Scholz <ray-2001@zonix.de>
-
- * gnus.texi (Using MIME): Add and fix.
-
-2001-05-05 Florian Weimer <fw@deneb.enyo.de>
-
- * gnus.texi (IMAP): Remove double paragraph (suggest by Norbert
- Koch), fix NNTP reference.
-
-2001-05-04 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- Suggested by Dan Christensen <jdc@uwo.ca>
-
- * gnus.texi (Mail Group Commands): Add pxref.
- (Group Maintenance): Ditto.
- (Topic Commands): Ditto.
- (Expiring Mail): Typo.
-
-2001-05-04 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Raymond Scholz <ray-2001@zonix.de>
-
- * gnus.texi (Summary Buffer Lines): Mention the meaning of a
- colon.
-
-2001-05-03 07:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Sriram Karra <karra@cs.utah.edu>.
-
- * gnus.texi: Add default value.
-
-2001-05-03 06:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Using GPG): Use example environment.
-
-2001-05-02 17:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Expunging mailboxes): Typo.
-
-2001-04-15 19:38:54 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail and Post): Fix.
-
-2001-04-29 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Remove a few The's.
- (RSS): New.
-
-2001-04-26 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Unread Articles): Say that dormants are similar to
- ticked.
-
-2001-04-13 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Sorting Groups): Note `C-k' and `C-y' for manually
- moving groups around.
-
-2001-04-07 Ryan Yeske <rcyeske@vcn.bc.ca>
-
- * gnus.texi (Splitting in IMAP): Fix.
-
-2001-04-07 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (More Threading): Fix.
-
-2001-04-01 00:32:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (S): Renamed.
- (Summary Sorting): Addition.
-
-2001-03-31 00:40:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Other Marks): Additon.
- (The End): Remove "The" from menus.
-
-2001-03-30 23:34:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Adaptive Scoring): Addition.
- (Summary Mail Commands): Addition.
-
-2001-03-17 Matthias Wiehl <mwiehl@gmx.de>
-
- * message.texi (Security): Typos.
-
-2001-03-15 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Hiding Headers): Typos. Reported by Sriram Karra
- <karra@cs.utah.edu>.
-
-2001-03-11 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.texi (Message Headers): Update doc for
- `message-generate-headers-first'.
-
-2001-03-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Nevin Kapur <nevin@jhu.edu>
-
- * gnus.texi (Mail Source Specifiers): Fix.
-
-2001-03-04 09:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From "Yair Friedman (Jerusalem)" <YAIRFR@amdocs.com>
-
- * infohack.el (infohack): Set max-lisp-eval-depth to 600+.
-
-2001-03-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Posting Styles): Posting styles have (NAME VALUE),
- not (NAME . VALUE).
-
-2001-02-25 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
- From Michael Totschnig <michaelt@supernet.ca>.
-
- * gnus.texi (Article Fontisizing): Fix.
-
-2001-02-23 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (Posting Server): Fix, due to change of default value
- of `gnus-post-method' to `current'.
-
-2001-02-23 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Remove double words. From Gerd Moellmann.
-
- * infohack.el (batch-makeinfo): New.
-
- * Makefile.in (EMACSINFO): Use it.
-
-2001-02-17 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Posting Styles): Doc fix.
-
-2001-02-16 Simon Josefsson <sjosefsson@rsasecurity.com>
-
- * gnus.texi (Optional Backend Functions): Fix case.
-
-2001-02-14 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Unread Articles): Say that Gnus itself never expires
- ticked articles. Suggested by M D Greenhow
- mdg@greenhow36.clara.co.uk.
-
-2001-02-13 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Saving Articles): Addition.
-
-2001-02-14 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Group Parameters): Addition.
-
-2001-02-11 13:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Choosing Commands): Move `G j' here.
-
-2001-02-09 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Pterodactyl Gnus): Added.
- (Newest Features): Removed. Suggested by RMS.
-
-2001-02-08 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Group Parameters): Mention `G c' in addition to `G p'.
-
-2001-02-07 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (To From Newsgroups): Make it clear where to put the
- sample code. Suggested by Dan Jacobson.
-
- * gnus.texi (Mail Source Specifiers, IMAP, Agent and IMAP):
- Improve IMAP discussion.
-
-2001-02-07 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * message.texi (Message Headers): `message-generate-headers-first'.
-
-2001-02-06 19:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Using GPG): Key binding.
-
- * message.texi (Security): Ditto.
-
-2001-02-06 18:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Top): Add Using GPG.
-
-2001-02-02 David Masterson <dmasters@Rational.Com>
-
- * gnus.texi (The Server is Down): Add link to Group Levels.
-
-2001-01-24 Simon Josefsson <sj@extundo.com>
-
- * gnus.texi (Mail Source Specifiers): Add IMAP :program, fix POP
- :program typo.
-
-2001-01-15 16:15:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (The Active File): Only old versionf of leafnode
- doesn't do some.
-
-2001-01-23 23:28:08 Satomi Suzuki <pan@mba.nifty.ne.jp>
-
- * message.texi (message-ignored-news-headers): Add "X-Draft-From:".
- (message-ignored-mail-headers): Ditto.
-
-2001-01-21 Raymond Scholz <ray-2001@zonix.de>
-
- * message.texi: Rename X-Mailer and X-Newsreader to User-Agent.
-
-2001-01-19 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * infohack.el: New file.
-
- * Makefile.in: Use it.
-
-2001-01-18 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Hiding Headers): Add.
-
- * emacs-mime.texi: Set dircategory to Emacs.
-
-2001-01-16 Jesper Harder <harder@ifa.au.dk>
-
- * gnus.texi (Group Line Specification): Add.
-
-2001-01-15 16:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Using GPG): Doc fix.
-
-2001-01-15 Simon Josefsson <simon@josefsson.org>
-
- * message.texi (Security): Requires OpenSSL 0.9.6+.
-
-2001-01-13 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail): Move explanation of
- `message-send-mail-partially-limit' to message.texi
-
- * message.texi (Mail Variables): Ditto.
-
-2001-01-10 15:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Washing): makeinfo 1.69 doesn't grok `anchor'.
-
-2001-01-07 18:18:53 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (myself): Quote .
-
-2001-01-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Choosing Commands): Add xref for redisplaying the
- group. Suggestion from Galen Boyer <galenboyer@yahoo.com>.
- (The Summary Buffer): Mention reselecting the current group in the
- menu. Suggestion from Galen Boyer <galenboyer@yahoo.com>.
- (Followups To Yourself): Add Lisp example.
-
-2001-01-05 06:53:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (time-date): Addition.
- (time-date): Addition.
-
-2001-01-04 22:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Newest Features): uref, not url.
-
- * texi2latex.el (latexi-translate-file): Ignore anchor.
-
-2001-01-04 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Article Washing): Refer to `Customizing Articles' for
- permanent changes. Suggested by Russell Marks (russel dot marks
- at ntlworld dot com).
-
-2001-01-03 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Article Washing): Mention `C-u g' as a sort of
- anti-washing.
-
-2001-01-01 11:40:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (extensions): Removed.
-
-2000-12-31 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * texi2latex.el (latexi-translate-file): Understand uref.
-
-2000-12-30 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Selecting a Group): Explain in more detail, what a
- prefix arg means for SPC. Refer people to M-g command from
- summary buffer. Suggested by Paul Repacholi
- <prep@prep.synonet.com> and Dan Jacobson <jidanni@kimo.com.tw>.
-
-2000-12-29 21:43:20 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Spelling): New.
-
-2000-12-29 10:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * texi2latex.el (latexi-translate-file): Support srcdir.
- (latexi-translate-file): Understand ifnottex, dircategory, and
- direntry. Set coding-system-for-write to iso-8859-1.
-
- * Makefile.in: Fix for srcdir.
-
- * gnus.texi (NoCeM): Use file instead of uref.
- (Mail Source Specifiers): Use subsubsection instead of
- subsubheading.
-
-2000-12-29 01:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Top): Set version to Oort Gnus v0.01.
-
- * Makefile.in (install): The info files are in the current
- directory.
-
-2000-12-29 Christopher Splinter <chris@splinter.inka.de>
-
- * gnus.texi (Customizing Articles): Added documentation for
- `gnus-treat-hide-citation-maybe', `gnus-treat-date-iso8601' and
- `gnus-treat-date-user-defined'.
-
-2000-12-29 00:38:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Posting Styles): Addition.
-
-2000-12-28 20:04:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Buffer Entry): New section.
-
-2000-12-22 Christopher Splinter <chris@splinter.inka.de>
-
- * gnus.texi (Group Parameters): Add documentation for the `banner'
- group parameter.
-
-2000-12-22 11:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Adaptive Scoring): Use setq by Thomas Seck
- <tmseck@web.de>.
-
-2000-12-21 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Article Washing): Doc addition by Paul Stevenson
- <p.stevenson@surrey.ac.uk>.
-
-2000-12-10 Jim Meyering <meyering@lucent.com>
-
- * Makefile.in (.texi): Use `-I $(srcdir)' with `makeinfo' so that
- non-srcdir builds work.
-
-2000-11-29 20:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Fancy Mail Splitting): Add.
-
-2000-11-20 08:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Archived Messages): Add.
-
-2000-11-20 Jochen K\e,A|\e(Bpper <jochen@pc1.uni-duesseldorf.de>
-
- * gnus.texi (Security): Fix typo.
-
-2000-11-20 00:00:00 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Add.
-
-2000-11-12 Florian Weimer <fw@deneb.enyo.de>
-
- * message.texi (Security): Fixed typo, change "PGP" to "OpenPGP".
-
-2000-11-12 David Edmondson <dme@dme.org>
-
- * gnus.texi: remove `gnus-cite-prefix-regexp'.
-
- * message.texi (Insertion): move `gnus-cite-prefix-regexp' from
- gnus.texi to here and rename to `message-cite-prefix-regexp'.
-
-2000-11-11 Simon Josefsson <sj@extundo.com>
-
- * message.texi (Security): Add.
-
- * emacs-mime.texi (MML Definition): Add sign, encrypt, keyfile and
- certfile.
-
-2000-11-07 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Group Commands): `gnus-move-split-methods' uses
- group names as target, where `gnus-split-methods' uses file
- names. Suggested by Nevin Kapur.
-
-2000-11-07 Martin Buchholz <martin@xemacs.org>
-
- * gnus.texi: Doc fix.
-
-2000-11-01 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Fancy Mail Splitting): Explain
- `nnmail-split-fancy-with-parent'.
-
-2000-11-01 09:12:24 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Finding the News): @env is not supported in texinfo 3.12.
-
-2000-10-31 Jorge Godoy <godoy@conectiva.com>
-
- * gnus.texi: gnus-gpg document.
-
-2000-10-31 Simon Josefsson <sj@extundo.com>
-
- * gnus.texi (NNTP): Explain `port'.
-
-2000-10-30 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Archived Messages): Explain what happens when group
- names mentioned in `gnus-message-archive-group' contain a select
- method.
-
-2000-10-28 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Group Levels): Explain meaning of subscribed,
- unsubscribed, zombie, killed groups.
-
-2000-10-26 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Gnus Development): nnmail-delete-incoming -->
- mail-source-delete-incoming. Suggested by Karl Kleinpaste
- <karl@charcoal.com>.
-
-2000-10-18 Dave Love <fx@gnu.org>
-
- * gnus.texi (NoCeM): Update.
-
-2000-10-17 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (IMAP): Add.
-
-2000-10-05 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Windows Configuration): add examples; first example
- suggested by Stein A. Str\e,Ax\e(Bmme <stromme@mi.uib.no>. (The actual
- Lisp code is also from him.)
-
-2000-10-07 Dave Love <fx@gnu.org>
-
- * doclicense.texi: New file.
-
-2000-10-07 16:50:14 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Use install-info.
-
-2000-10-06 14:38:27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * message.texi (Message Headers): Add.
-
-2000-10-04 09:23:49 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Hiding): Add.
- (Using MIME): Add.
-
-2000-09-30 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (Agent and IMAP): Add.
- (Splitting in IMAP): Fix.
-
-2000-09-29 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (Converting Kill Files): Fix URL.
- (Posting Styles): Fix regexp.
- (Mail Source Specifiers): Fix.
-
-2000-09-29 12:53:27 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: A workaround for @ifnottex.
-
-2000-09-29 12:36:13 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi: Remove @c lines in the directory due to a bug in
- makeinfo 1.68 (GNU texinfo 3.12).
-
-2000-09-22 Dave Love <fx@gnu.org>
-
- * message.texi, gnus.texi, emacs-mime.texi: Convert to GFDL.
-
-2000-09-20 John H. Palmieri <palmieri@math.washington.edu>
-
- * gnus.texi (Mail Source Customization): Document of
- mail-source-incoming-file-prefix.
-
-2000-09-20 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (IMAP): Add examples.
-
-2000-09-19 Kai Gro\e,A_\e(Bjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (IMAP): Add pointer to description of ~/.authinfo file
- format.
-
-2000-09-17 Felix Natter <f.natter@ndh.net>
-
- * gnusref.tex: New version.
-
- * refcard.tex: New version.
-
-2000-09-17 18:03:52 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Hiding): Doc fix as suggested by Felix Natter
- <fnatter@gmx.net>.
-
-2000-06-22 Michael Totschnig <michaelt@supernet.ca>
-
- * gnus.texi (Agent Basics): Doc fix.
-
-2000-09-14 Jason R. Mastaler <jason@mastaler.com>
-
- * gnus.texi (Mail Source Specifiers): Use $HOME.
-
-2000-08-14 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Source Specifiers): Replace `@paragraph' with
- `@subsubheading'.
-
-2000-08-14 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Mail Source Specifiers): Try to document the
- interface to the functions called via (among others) the
- `:function' keyword.
-
-2000-08-13 20:00:35 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Topic Commands): Fix typo.
-
-2000-08-13 20:20:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Topic Commands): Addition.
-
-2000-08-11 Kai Grossjohann <Kai.Grossjohann@CS.Uni-Dortmund.DE>
-
- * gnus.texi (Expiring Mail): Extend documentation of variable
- `nnmail-expiry-target' and of group parameter `expiry-target'.
- Explain interaction between these. Add Lisp example for setting
- `nnmail-expiry-target'.
-
-2000-08-04 Andreas Oeldenberger <andreas.oeldenberger@gmx.net>
-
- * message.texi (Forwarding): Fix.
-
-2000-07-15 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (nnimap-authinfo-file):
- (gnus-invalid-group-regexp): Add.
- (Mail Source Specifiers): Fix.
- (IMAP): Fix.
- (Agent Basics): Fix.
-
-2000-07-12 19:37:19 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Article Washing): Add keystroke `t'.
-
-2000-07-12 15:49:34 ShengHuo ZHU <zsh@cs.rochester.edu>
-
- * Makefile.in: Add EMACS. Test -x "$(MAKEINFO)" does not work.
- Use sed instead of perl (suggested by Nick V. Pakoulin).
-
-2000-07-03 00:24:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Splitting Mail): Mention gnus-summary-respool-trace.
- (Searching for Articles): Fix.
- (Newest Features): Fix.
-
-2000-06-28 Simon Josefsson <simon@josefsson.org>
-
- * gnus.texi (Splitting in IMAP): Update.
-
-2000-05-19 15:18:32 Dmitry Yaitskov <dimas@home.com>
-
- * message.texi (Reply): Doc fix.
-
-2000-05-17 00:50:29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Listing Groups): Addition.
-
-2000-05-16 21:46:40 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Misc Group Stuff): Addition.
- (Article Washing): Ditto.
-
-2000-05-15 10:16:29 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Update maildir.
-
-2000-05-07 Pavel Janik <Pavel.Janik@inet.cz>
-
- * gnus.texi: direntry added.
-
- * message.texi: direntry added.
-
- * emacs-mime.texi: direntry added.
-
-2000-05-02 Pavel Janik <Pavel.Janik@inet.cz>
-
- * gnus.texi (MIME comands): Spelling fix.
-
-2000-05-03 21:12:05 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Summary Mail Commands): Addition.
- (Summary Post Commands): Ditto.
-
-2000-04-27 Dave Love <fx@gnu.org>
-
- * gnus.texi (Article Washing): Update x-face bit.
-
-2000-04-26 Florian Weimer <fw@deneb.cygnus.argh.org>
-
- * message.texi (Various Message Variables): Document
- message-default-charset.
-
- * emacs-mime.texi (Charset Translation): New section.
-
-2000-04-26 02:30:06 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Posting Styles): Addition.
-
-2000-04-24 17:09:17 Felix Natter <f.natter@ndh.net>
-
- * gnusref.tex: New version.
-
- * refcard.tex: New version.
-
-2000-04-23 00:32:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Thread Commands): Add keystrokes.
- (Various Summary Stuff): Addition.
-
-2000-04-22 21:12:25 Alan Shutko <ats@acm.org>
-
- * Makefile.in: Add pdf support.
-
-2000-04-21 12:07:20 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Listing Groups): Addition.
-
-2000-04-21 13:45:52 Pavel Janik <Pavel.Janik@inet.cz>
-
- * gnus.texi (Mail Source Specifiers): Example for :plugged.
-
-2000-04-20 20:37:48 Pavel Janik <Pavel.Janik@inet.cz>
-
- * gnus.texi (Limiting): Fix.
-
-2000-04-20 20:32:40 Dmitry Yaitskov <dimas@home.com>
-
- * gnus.texi (Charsets): Typo fix.
-
-2000-03-19 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (IMAP): Addition.
-
-2000-03-13 17:44:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Process/Prefix): Addition.
-
-2000-02-04 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (IMAP): Fix.
-
-2000-01-27 18:06:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Remember): Addition.
-
-2000-01-21 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Splitting in IMAP): Addition.
- (Mail Source Specifiers): Add fetchflag setting in example.
-
-2000-01-08 08:10:04 Martin Bialasinski <agr30+news@uni-koeln.de>
-
- * gnus.texi (Mail and Post): Example.
-
-2000-01-08 07:46:13 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Customizing w3): New.
-
-2000-01-08 07:46:06 Hamish Macdonald <hamishm@lucent.com>
-
- * gnus.texi (Customizing w3): Example.
-
-2000-01-06 17:55:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Charsets): Addition.
-
-2000-01-05 15:58:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Group Commands): Addition.
- (Top): Added detailmenu.
-
-2000-01-03 01:31:02 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (MIME Commands): Fix.
-
-2000-01-03 Karl Kleinpaste <karl@justresearch.com>
-
- * gnus.texi (Splitting in IMAP): Add '.' after @xref.
-
-2000-01-02 08:39:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Closing paren.
- Doc fix.
-
-1999-12-28 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Article Hiding): Addition.
- (Splitting in IMAP): Addition.
-
-1999-12-17 12:12:41 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-1999-12-13 23:47:50 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-1999-12-07 00:19:31 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Web Archive): Addition.
-
-1999-12-06 05:17:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Slashdot): Addition.
-
-1999-12-05 00:54:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Removed backslashes.
-
-1999-12-04 07:35:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Setting Process Marks): Addition.
-
-1999-12-04 05:09:46 Manoj Srivastava <srivasta@golden-gryphon.com>
-
- * gnus.texi: Use defface instead of face-spec-set.
-
-1999-12-04 02:31:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (extension): Posting server fix.
- Url update.
-
-1999-12-04 01:16:52 Yoshiki Hayashi <t90553@m.ecc.u-tokyo.ac.jp>
-
- * gnus.texi (group-buffer): Fix "theese".
-
-1999-12-04 01:13:51 Thomas Gellekum <tg@ihf.rwth-aachen.de>
-
- * gnus.texi (Height): Typo fix.
-
-1999-11-13 Adrian Aichner <aichner@ecf.teradyne.com>
-
- * xemacs.mak: New NMAKE file to support build and install of info
- documentation on Windows NT, requiring the `texinfo' XEmacs
- package.
-
-1999-12-03 00:02:11 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Other Gnus Versions): New.
- (Gnus Versions): Made into own node.
-
-1999-12-02 00:00:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Paging the Article): Addition.
- (History): Addition.
-
-1999-11-24 Carsten Leonhardt <leo@arioch.oche.de>
-
- * gnus.texi (Mail Source Specifiers): Mention maildir in the
- overview and the possibility to use remote maildirs.
-
-1999-12-01 14:21:19 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Topic Parameters): Addition.
- (Summary Message Commands): New.
- (Canceling and Superseding): Made into subsection.
- (Charsets): Addition.
-
-1999-11-30 10:54:31 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Add a note.
-
-1999-11-27 17:15:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Typo fixes and @sc.
-
-1999-11-26 16:59:29 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (On Writing Manuals): New.
-
-1999-11-23 17:23:37 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Update.
-
-1999-11-23 05:07:59 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Web Archive): Add nnwarchive.
-
-1999-11-23 03:05:32 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Mail Source Specifiers): Add webmail.
-
-1999-11-19 12:15:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Slashdot): Addition.
-
-1999-11-17 Per Abrahamsen <abraham@dina.kvl.dk>
-
- * gnus.texi (Finding the Parent): Fix example.
-
-1999-11-16 10:09:44 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi: Addition.
- (present): Addition.
-
-1999-11-13 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Mail Source Specifiers): Fix. Added documentation for
- IMAP mail-source keywords `fetchflag' and `dontexpunge'.
-
-1999-11-12 18:00:56 Eli Zaretskii <eliz@is.elta.co.il>
-
- * gnus.texi (Fancy Mail Splitting): Fix @vars.
-
-1999-11-12 17:08:35 Gunnar Evermann <ge204@eng.cam.ac.uk>
-
- * gnus.texi (Splitting in IMAP): @@ fix.
-
-1999-11-12 08:17:49 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-1999-11-12 08:17:44 Ulf Betlehem <flu@iki.fi>
-
- * gnus.texi (Mail Source Specifiers): Example.
-
-1999-11-12 05:26:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Slashdot): Addition.
-
-1999-11-11 04:32:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (News Headers): Fix.
-
- * gnus.texi (Browsing the Web): New.
- (Slashdot): New.
- (Ultimate): New.
-
-1999-11-10 11:32:00 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Archived Messages): Fix.
-
-1999-11-07 01:28:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (MIME Commands): Addition.
-
-1999-11-06 23:09:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Customizing Articles): Fix.
-
-1999-11-05 22:34:23 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Posting Styles): Addition.
-
-1999-10-23 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Mail Source Specifiers): Add imap mail-source.
- (IMAP): New subsection.
- (SOUP): Typo.
-
-1999-09-27 16:07:31 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (New Viewers): Fix.
-
-1999-10-29 David S. Goldberg <dsg@mitre.org>
-
- * emacs-mime.texi (Customization): Document mm-inline-override-types
-
-1999-09-25 10:58:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Forwarding): Updated.
-
- * emacs-mime.texi (New Viewers): New.
-
-1999-09-24 18:52:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Line Specification): Doc fix.
-
-1999-09-24 18:06:33 Bill White <billw@wolfram.com>
-
- * gnus.texi (Article Washing): Fix.
-
-1999-08-27 20:47:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Posting Styles): Doc fix.
-
-1999-08-27 18:51:42 Robin S. Socha <robin@socha.net>
-
- * gnus.texi: Typo fix.
-
-1999-08-27 15:09:01 Jim Meyering <meyering@ascend.com>
-
- * gnus.texi (The Active File): Typo fix.
-
-1999-08-27 15:00:23 Yoshiki Hayashi <t90553@m.ecc.u-tokyo.ac.jp>
-
- * gnus.texi (Generic Marking Commands): Typo fixes.
-
-1999-08-27 14:46:21 Lee Willis <lee@gbdirect.co.uk>
-
- * gnus.texi (Customizing Articles): More explanation.
-
-1999-07-10 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (More Threading): Document new variable
- `gnus-sort-gathered-threads-function'.
-
-1999-07-30 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi: Added `gnus-list-identifiers' stuff.
-
-1999-07-09 19:41:34 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Using MIME): Addition.
- (Topic Commands): Addition.
-
-1999-07-06 05:37:46 Alexandre Oliva <oliva@dcc.unicamp.br>
-
- * gnus.texi (Fancy Mail Splitting): Document RESTRICT.
-
-1999-07-07 10:26:59 Robin S. Socha <robin@socha.net>
-
- * gnus.texi (Scoring Tips): Typo.
-
-1999-07-06 11:41:59 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Fix.
- (Mail Source Customization): Deleted obsolete vars.
-
-1999-07-05 05:16:55 Laura Conrad <lconrad@world.std.com>
-
- * gnus.texi (Mail in a Newsreader): Rewrite.
-
-1999-07-04 04:33:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Posting Styles): Fix.
- (Mail in a Newsreader): New.
-
-1999-06-13 02:29:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (MIME Commands): Addition.
- (Article Miscellania): New.
- (Customizing Articles): Addition.
-
-1999-06-12 00:13:25 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Comparing Mail Backends): Slight edits.
-
-1999-06-12 00:13:20 Karl Kleinpaste <karl@justresearch.com>
-
- * gnus.texi (Comparing Mail Backends): New.
-
-1999-06-11 21:47:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Score): Doc fix.
- (The Active File): Addition.
- (Document Groups): Addition.
-
-1999-04-18 Didier Verna <verna@inf.enst.fr>
-
- * gnus.texi (Article treatment): document the new variable
- `gnus-article-date-lapsed-new-header'.
-
-1999-04-26 Robert Bihlmeyer <robbe@orcus.priv.at>
-
- * gnus.texi (Posting Styles): Typo.
-
-1999-04-18 12:46:33 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Score Commands): Typo.
- (Choosing a Mail Backend): Addition.
-
-1999-04-18 09:24:51 Yoshiki Hayashi <g740685@komaba.ecc.u-tokyo.ac.jp>
-
- * gnus.texi (Startup Variables): Fix.
-
-1999-04-18 09:12:28 Starback <starback@ling.uu.se>
-
- * gnus.texi (Subscription Methods): Typo.
-
-1999-04-18 08:22:27 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Little Disk Space): Addition.
-
-1999-03-25 Erik Toubro Nielsen <erik@ifad.dk>
-
- * gnus.texi (gnus-thread-sort-functions). 'reverse' => 'not'
-
-1999-04-17 10:21:01 Jack Twilley <jmt+usenet@nycap.rr.com>
-
- * gnus.texi (Fancy Mail Splitting): Addition.
-
-1999-04-07 06:13:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Gnus Development): New.
-
-1999-03-06 20:12:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Generic Marking Commands): New.
-
-1999-03-01 16:41:42 Rob Browning <rlb@cs.utexas.edu>
-
- * gnus.texi (Score Variables): Clarify.
-
-1999-02-26 Andreas Jaeger <aj@arthur.rhein-neckar.de>
-
- * gnus.texi: Add ',' after @xrefs.
-
-1999-02-26 20:54:34 Jason R. Mastaler <jason@4b.org>
-
- * gnus.texi (Article Date): Added joke by Colin Rafferty
- (colin@xemacs.org).
-
-1999-02-26 08:26:10 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Fix.
-
-Thu Feb 25 00:28:49 1999 Shenghuo ZHU <zsh@cs.rochester.edu>
-
- * gnus.texi (Category Syntax): Typo fix.
-
-1999-02-21 11:42:54 Vladimir Volovich <vvv@vvv.vsu.ru>
-
- * Makefile.in (.texi): Fix check for MAKEINFO.
-
-1999-02-20 17:33:55 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-1999-02-11 19:19:02 Carsten Leonhardt <leo@arioch.oche.de>
-
- * gnus.texi (Mail Source Specifiers): Document maildir.
-
-1999-02-09 16:21:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Charsets): New.
-
-1999-02-04 03:45:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (Conversion): New.
-
-1999-02-03 03:04:18 Miguel de Icaza <miguel@nuclecu.unam.mx>
-
- * gnus.texi (Fetching Mail): Typo fix.
-
-1999-02-02 22:28:42 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Source Specifiers): Addition.
-
-1999-02-01 21:05:18 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Hiding): Addition.
-
-1999-01-28 08:08:28 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Washing Mail): Addition.
-
-1999-01-27 14:30:39 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Washing): Addition.
-
-1999-01-25 04:24:01 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (MIME): New.
-
- * gnus.texi (Mail Sources): New.
- (Mail Source Specifiers): New.
- (Mail Source Customization): New.
- (Fetching Mail): New.
-
-1999-01-23 09:47:16 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Washing): Removed.
- (Customizing Articles): Addition.
-
-1999-01-16 20:36:48 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Customizing Articles): Rewrite.
- Remove mention of gnus-article-display-hook.
-
-1999-01-12 07:14:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (To From Newsgroups): Addition.
-
-1999-01-03 13:54:51 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Agent Commands): Addition.
-
-1998-12-19 23:29:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Splitting Mail): Addition.
-
-1998-12-13 08:54:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * message.texi (Insertion): Add.
-
-1998-12-03 13:34:48 James Troup <james@nocrew.org>
-
- * gnus.texi (MIME Commands): Typo fix.
-
-1998-12-03 Didier Verna <verna@inf.enst.fr>
-
- * gnus.texi (Group Parameters): update for the posting-style group
- parameter.
-
-1998-12-02 01:04:22 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Emacsen): Addition.
- (Picon Useless Configuration): Addition.
-
-1998-12-01 00:27:04 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (rfc2045): New.
-
-1998-11-29 00:03:43 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi (Composing): New chapter.
-
-1998-11-25 Karl Eichwalder <ke@gnu.franken.de>
-
- * Makefile.in (install): Remove emacs-info, add emacs-mime.
-
-1998-11-25 10:56:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (To From Newsgroups): Addition.
- (Anything Groups): Addition.
- (Article Washing): Addition.
- (MIME Commands): Addition.
-
-1998-11-19 04:05:15 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Really Various Summary Commands): Addition.
-
-1998-11-18 00:52:46 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (MIME Commands): Addition.
- (Expiring Mail): Addition.
-
-1998-11-07 17:18:07 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Gnus Reference Guide): Renamed.
-
-1998-10-26 22:03:08 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Washing): Fix.
- (MIME Commands): Change.
-
-1998-10-25 01:51:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Headers): Addition.
-
-1998-10-24 08:37:12 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Summary Buffer Lines): Addition.
- (To): New.
- (To): Addition.
-
-1998-10-15 18:15:34 Simon Josefsson <jas@pdc.kth.se>
-
- * gnus.texi (Group Info): Must be list of ranges.
-
-1998-10-19 01:27:26 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Article Washing): Addition.
-
-1998-10-18 00:20:58 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Changing Servers): Addition.
-
-1998-10-17 21:34:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Windows Configuration): Addition.
-
-1998-10-01 07:55:35 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Splitting Mail): Fix.
- (Washing Mail): Fix.
-
-1998-09-30 05:54:45 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Selecting a Group): Addition.
-
-1998-09-13 08:58:56 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * dir (File): Updated.
-
-1998-09-12 08:53:05 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * emacs-mime.texi: New file.
-
- * gnus.texi (Misc Article): Addition.
-
-1998-09-11 08:52:50 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Group Score Commands): Fix.
- (Saving Articles): Fix.
- (Agent Expiry): Fix.
- (Using MIME): Change.
-
-1998-09-10 03:19:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Windows Configuration): Addition.
-
-1998-09-06 Mike McEwan <mike@lotusland.demon.co.uk>
-
- * gnus.texi (Category Syntax): Added doc about agent categories
- and download scoring.
-
-1998-09-05 17:36:14 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Sorting Groups): Change.
- (Various Summary Stuff): Addition.
-
-1998-09-04 00:40:07 David S. Goldberg <dsg@mitre.org>
-
- * gnus.texi (Article Hiding): Verify.
-
-1998-08-31 11:46:57 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Folders): Addition.
- (Group Parameters): Addition.
- (MIME Commands): New.
-
-1998-08-27 07:29:17 Lars Magne Ingebrigtsen <larsi@gnus.org>
-
- * gnus.texi (Mail Folders): Addition.
-
- Copyright (C) 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005, 2006,
- 2007 2008 Free Software Foundation, Inc.
-
- 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 3, 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., 51 Franklin Street, Fifth Floor,
- Boston, MA 02110-1301, USA.
-
-;; Local Variables:
-;; coding: iso-2022-7bit
-;; fill-column: 79
-;; add-log-time-zone-rule: t
-;; End:
-
-;;; arch-tag: b5708f36-be16-423b-bcca-f70f5fb4781a
+++ /dev/null
-@c -*-texinfo-*-
-@center Version 1.2, November 2002
-
-@display
-Copyright (C) 2000,2001,2002 Free Software Foundation, Inc.
-51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-@sp 1
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-functional and useful document ``free'' in the sense of freedom: to
-assure everyone the effective freedom to copy and redistribute it,
-with or without modifying it, either commercially or noncommercially.
-Secondarily, this License preserves for the author and publisher a way
-to get credit for their work, while not being considered responsible
-for modifications made by others.
-
-This License is a kind of ``copyleft,'' which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-@sp 1
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work, in any medium, that
-contains a notice placed by the copyright holder saying it can be
-distributed under the terms of this License. Such a notice grants a
-world-wide, royalty-free license, unlimited in duration, to use that
-work under the conditions stated herein. The ``Document,'' below,
-refers to any such manual or work. Any member of the public is a
-licensee, and is addressed as ``you.'' You accept the license if you
-copy, modify or distribute the work in a way requiring permission
-under copyright law.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section of
-the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall subject
-(or to related matters) and contains nothing that could fall directly
-within that overall subject. (Thus, if the Document is in part a
-textbook of mathematics, a Secondary Section may not explain any
-mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License. If a
-section does not fit the above definition of Secondary then it is not
-allowed to be designated as Invariant. The Document may contain zero
-Invariant Sections. If the Document does not identify any Invariant
-Sections then there are none.
-
-The ``Cover Texts'' are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License. A Front-Cover Text may
-be at most 5 words, and a Back-Cover Text may be at most 25 words.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, that is suitable for revising the document
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup, or absence of markup, has been arranged to thwart
-or discourage subsequent modification by readers is not Transparent.
-An image format is not Transparent if used for any substantial amount
-of text. A copy that is not ``Transparent'' is called ``Opaque.''
-
-
-Examples of suitable formats for Transparent copies include plain
-ASCII without markup, Texinfo input format, LaTeX input format, SGML
-or XML using a publicly available DTD, and standard-conforming simple
-HTML, PostScript or PDF designed for human modification. Examples of
-transparent image formats include PNG, XCF and JPG. Opaque formats
-include proprietary formats that can be read and edited only by
-proprietary word processors, SGML or XML for which the DTD and/or
-processing tools are not generally available, and the
-machine-generated HTML, PostScript or PDF produced by some word
-processors for output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, ``Title Page'' means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-A section ``Entitled XYZ'' means a named subunit of the Document whose
-title either is precisely XYZ or contains XYZ in parentheses following
-text that translates XYZ in another language. (Here XYZ stands for a
-specific section name mentioned below, such as ``Acknowledgements,''
-``Dedications,'' ``Endorsements,'' or ``History.'') To ``Preserve the Title''
-of such a section when you modify the Document means that it remains a
-section ``Entitled XYZ'' according to this definition.
-
-The Document may include Warranty Disclaimers next to the notice which
-states that this License applies to the Document. These Warranty
-Disclaimers are considered to be included by reference in this
-License, but only as regards disclaiming warranties: any other
-implication that these Warranty Disclaimers may have is void and has
-no effect on the meaning of this License.
-@sp 1
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no other
-conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-@sp 1
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies (or copies in media that commonly have
-printed covers) of the Document, numbering more than 100, and the
-Document's license notice requires Cover Texts, you must enclose the
-copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a computer-network location from which the general network-using
-public has access to download using public-standard network protocols
-a complete Transparent copy of the Document, free of added material.
-If you use the latter option, you must take reasonably prudent steps,
-when you begin distribution of Opaque copies in quantity, to ensure
-that this Transparent copy will remain thus accessible at the stated
-location until at least one year after the last time you distribute an
-Opaque copy (directly or through your agents or retailers) of that
-edition to the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to give
-them a chance to provide you with an updated version of the Document.
-@sp 1
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-A. Use in the Title Page (and on the covers, if any) a title distinct
- from that of the Document, and from those of previous versions
- (which should, if there were any, be listed in the History section
- of the Document). You may use the same title as a previous version
- if the original publisher of that version gives permission.@*
-B. List on the Title Page, as authors, one or more persons or entities
- responsible for authorship of the modifications in the Modified
- Version, together with at least five of the principal authors of the
- Document (all of its principal authors, if it has fewer than five),
- unless they release you from this requirement.@*
-C. State on the Title page the name of the publisher of the
- Modified Version, as the publisher.@*
-D. Preserve all the copyright notices of the Document.@*
-E. Add an appropriate copyright notice for your modifications
- adjacent to the other copyright notices.@*
-F. Include, immediately after the copyright notices, a license notice
- giving the public permission to use the Modified Version under the
- terms of this License, in the form shown in the Addendum below.@*
-G. Preserve in that license notice the full lists of Invariant Sections
- and required Cover Texts given in the Document's license notice.@*
-H. Include an unaltered copy of this License.@*
-I. Preserve the section Entitled ``History,'' Preserve its Title, and add
- to it an item stating at least the title, year, new authors, and
- publisher of the Modified Version as given on the Title Page. If
- there is no section Entitled ``History'' in the Document, create one
- stating the title, year, authors, and publisher of the Document as
- given on its Title Page, then add an item describing the Modified
- Version as stated in the previous sentence.@*
-J. Preserve the network location, if any, given in the Document for
- public access to a Transparent copy of the Document, and likewise
- the network locations given in the Document for previous versions
- it was based on. These may be placed in the ``History'' section.
- You may omit a network location for a work that was published at
- least four years before the Document itself, or if the original
- publisher of the version it refers to gives permission.@*
-K. For any section Entitled ``Acknowledgements'' or ``Dedications,''
- Preserve the Title of the section, and preserve in the section all
- the substance and tone of each of the contributor acknowledgements
- and/or dedications given therein.@*
-L. Preserve all the Invariant Sections of the Document,
- unaltered in their text and in their titles. Section numbers
- or the equivalent are not considered part of the section titles.@*
-M. Delete any section Entitled ``Endorsements.'' Such a section
- may not be included in the Modified Version.@*
-N. Do not retitle any existing section to be Entitled ``Endorsements''
- or to conflict in title with any Invariant Section.@*
-O. Preserve any Warranty Disclaimers.@*
-@sp 1
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section Entitled ``Endorsements,'' provided it contains
-nothing but endorsements of your Modified Version by various
-parties--for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-@sp 1
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice, and that you preserve all their Warranty Disclaimers.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections Entitled ``History''
-in the various original documents, forming one section Entitled
-``History''; likewise combine any sections Entitled ``Acknowledgements,''
-and any sections Entitled ``Dedications.'' You must delete all sections
-Entitled ``Endorsements.''
-@sp 1
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other documents
-released under this License, and replace the individual copies of this
-License in the various documents with a single copy that is included in
-the collection, provided that you follow the rules of this License for
-verbatim copying of each of the documents in all other respects.
-
-You may extract a single document from such a collection, and distribute
-it individually under this License, provided you insert a copy of this
-License into the extracted document, and follow this License in all
-other respects regarding verbatim copying of that document.
-@sp 1
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, is called an ``aggregate'' if the copyright
-resulting from the compilation is not used to limit the legal rights
-of the compilation's users beyond what the individual works permit.
-When the Document is included in an aggregate, this License does not
-apply to the other works in the aggregate which are not themselves
-derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one half of
-the entire aggregate, the Document's Cover Texts may be placed on
-covers that bracket the Document within the aggregate, or the
-electronic equivalent of covers if the Document is in electronic form.
-Otherwise they must appear on printed covers that bracket the whole
-aggregate.
-@sp 1
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License, and all the license notices in the
-Document, and any Warranty Disclaimers, provided that you also include
-the original English version of this License and the original versions
-of those notices and disclaimers. In case of a disagreement between
-the translation and the original version of this License or a notice
-or disclaimer, the original version will prevail.
-
-If a section in the Document is Entitled ``Acknowledgements,''
-``Dedications,'' or ``History,'' the requirement (section 4) to Preserve
-its Title (section 1) will typically require changing the actual
-title.
-@sp 1
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document except
-as expressly provided for under this License. Any other attempt to
-copy, modify, sublicense or distribute the Document is void, and will
-automatically terminate your rights under this License. However,
-parties who have received copies, or rights, from you under this
-License will not have their licenses terminated so long as such
-parties remain in full compliance.
-@sp 1
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-The Free Software Foundation may publish new, revised versions
-of the GNU Free Documentation License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns. See
-http://www.gnu.org/copyleft/.
-
-Each version of the License is given a distinguishing version number.
-If the Document specifies that a particular numbered version of this
-License ``or any later version'' applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation.
-
-@end enumerate
-
-@unnumberedsec ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@smallexample
-@group
-Copyright (C) @var{year} @var{your name}.
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2
-or any later version published by the Free Software Foundation;
-with no Invariant Sections, no Front-Cover Texts, and no Back-Cover Texts.
-A copy of the license is included in the section entitled ``GNU
-Free Documentation License.''
-@end group
-@end smallexample
-
-If you have Invariant Sections, Front-Cover Texts and Back-Cover Texts,
-replace the ``with...Texts.'' line with this:
-
-@smallexample
-@group
-with the Invariant Sections being @var{list their titles}, with the
-Front-Cover Texts being @var{list}, and with the Back-Cover Texts being
-@var{list}.
-@end group
-@end smallexample
-
-If you have Invariant Sections without Cover Texts, or some other
-combination of the three, merge those two alternatives to suit the
-situation.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-
-@ignore
- arch-tag: c1679162-1d8a-4f02-bc52-2e71765f0165
-@end ignore
+++ /dev/null
-\input texinfo
-
-@setfilename emacs-mime
-@settitle Emacs MIME Manual
-@synindex fn cp
-@synindex vr cp
-@synindex pg cp
-
-@copying
-This file documents the Emacs MIME interface functionality.
-
-Copyright @copyright{} 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005,
-2006, 2007, 2008 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software. Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License. If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@c Node ``Interface Functions'' uses Latin-1 characters
-@documentencoding ISO-8859-1
-
-@dircategory Emacs
-@direntry
-* Emacs MIME: (emacs-mime). Emacs MIME de/composition library.
-@end direntry
-@iftex
-@finalout
-@end iftex
-@setchapternewpage odd
-
-@titlepage
-@title Emacs MIME Manual
-
-@author by Lars Magne Ingebrigtsen
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-@node Top
-@top Emacs MIME
-
-This manual documents the libraries used to compose and display
-@acronym{MIME} messages.
-
-This manual is directed at users who want to modify the behavior of
-the @acronym{MIME} encoding/decoding process or want a more detailed
-picture of how the Emacs @acronym{MIME} library works, and people who want
-to write functions and commands that manipulate @acronym{MIME} elements.
-
-@acronym{MIME} is short for @dfn{Multipurpose Internet Mail Extensions}.
-This standard is documented in a number of RFCs; mainly RFC2045 (Format
-of Internet Message Bodies), RFC2046 (Media Types), RFC2047 (Message
-Header Extensions for Non-@acronym{ASCII} Text), RFC2048 (Registration
-Procedures), RFC2049 (Conformance Criteria and Examples). It is highly
-recommended that anyone who intends writing @acronym{MIME}-compliant software
-read at least RFC2045 and RFC2047.
-
-@menu
-* Decoding and Viewing:: A framework for decoding and viewing.
-* Composing:: @acronym{MML}; a language for describing @acronym{MIME} parts.
-* Interface Functions:: An abstraction over the basic functions.
-* Basic Functions:: Utility and basic parsing functions.
-* Standards:: A summary of RFCs and working documents used.
-* GNU Free Documentation License:: The license for this documentation.
-* Index:: Function and variable index.
-@end menu
-
-
-@node Decoding and Viewing
-@chapter Decoding and Viewing
-
-This chapter deals with decoding and viewing @acronym{MIME} messages on a
-higher level.
-
-The main idea is to first analyze a @acronym{MIME} article, and then allow
-other programs to do things based on the list of @dfn{handles} that are
-returned as a result of this analysis.
-
-@menu
-* Dissection:: Analyzing a @acronym{MIME} message.
-* Non-MIME:: Analyzing a non-@acronym{MIME} message.
-* Handles:: Handle manipulations.
-* Display:: Displaying handles.
-* Display Customization:: Variables that affect display.
-* Files and Directories:: Saving and naming attachments.
-* New Viewers:: How to write your own viewers.
-@end menu
-
-
-@node Dissection
-@section Dissection
-
-The @code{mm-dissect-buffer} is the function responsible for dissecting
-a @acronym{MIME} article. If given a multipart message, it will recursively
-descend the message, following the structure, and return a tree of
-@acronym{MIME} handles that describes the structure of the message.
-
-@node Non-MIME
-@section Non-MIME
-@vindex mm-uu-configure-list
-
-Gnus also understands some non-@acronym{MIME} attachments, such as
-postscript, uuencode, binhex, yenc, shar, forward, gnatsweb, pgp,
-diff. Each of these features can be disabled by add an item into
-@code{mm-uu-configure-list}. For example,
-
-@lisp
-(require 'mm-uu)
-(add-to-list 'mm-uu-configure-list '(pgp-signed . disabled))
-@end lisp
-
-@table @code
-@item postscript
-@findex postscript
-PostScript file.
-
-@item uu
-@findex uu
-Uuencoded file.
-
-@item binhex
-@findex binhex
-Binhex encoded file.
-
-@item yenc
-@findex yenc
-Yenc encoded file.
-
-@item shar
-@findex shar
-Shar archive file.
-
-@item forward
-@findex forward
-Non-@acronym{MIME} forwarded message.
-
-@item gnatsweb
-@findex gnatsweb
-Gnatsweb attachment.
-
-@item pgp-signed
-@findex pgp-signed
-@acronym{PGP} signed clear text.
-
-@item pgp-encrypted
-@findex pgp-encrypted
-@acronym{PGP} encrypted clear text.
-
-@item pgp-key
-@findex pgp-key
-@acronym{PGP} public keys.
-
-@item emacs-sources
-@findex emacs-sources
-@vindex mm-uu-emacs-sources-regexp
-Emacs source code. This item works only in the groups matching
-@code{mm-uu-emacs-sources-regexp}.
-
-@item diff
-@vindex diff
-@vindex mm-uu-diff-groups-regexp
-Patches. This is intended for groups where diffs of committed files
-are automatically sent to. It only works in groups matching
-@code{mm-uu-diff-groups-regexp}.
-
-@end table
-
-@node Handles
-@section Handles
-
-A @acronym{MIME} handle is a list that fully describes a @acronym{MIME}
-component.
-
-The following macros can be used to access elements in a handle:
-
-@table @code
-@item mm-handle-buffer
-@findex mm-handle-buffer
-Return the buffer that holds the contents of the undecoded @acronym{MIME}
-part.
-
-@item mm-handle-type
-@findex mm-handle-type
-Return the parsed @code{Content-Type} of the part.
-
-@item mm-handle-encoding
-@findex mm-handle-encoding
-Return the @code{Content-Transfer-Encoding} of the part.
-
-@item mm-handle-undisplayer
-@findex mm-handle-undisplayer
-Return the object that can be used to remove the displayed part (if it
-has been displayed).
-
-@item mm-handle-set-undisplayer
-@findex mm-handle-set-undisplayer
-Set the undisplayer object.
-
-@item mm-handle-disposition
-@findex mm-handle-disposition
-Return the parsed @code{Content-Disposition} of the part.
-
-@item mm-get-content-id
-Returns the handle(s) referred to by @code{Content-ID}.
-
-@end table
-
-
-@node Display
-@section Display
-
-Functions for displaying, removing and saving.
-
-@table @code
-@item mm-display-part
-@findex mm-display-part
-Display the part.
-
-@item mm-remove-part
-@findex mm-remove-part
-Remove the part (if it has been displayed).
-
-@item mm-inlinable-p
-@findex mm-inlinable-p
-Say whether a @acronym{MIME} type can be displayed inline.
-
-@item mm-automatic-display-p
-@findex mm-automatic-display-p
-Say whether a @acronym{MIME} type should be displayed automatically.
-
-@item mm-destroy-part
-@findex mm-destroy-part
-Free all resources occupied by a part.
-
-@item mm-save-part
-@findex mm-save-part
-Offer to save the part in a file.
-
-@item mm-pipe-part
-@findex mm-pipe-part
-Offer to pipe the part to some process.
-
-@item mm-interactively-view-part
-@findex mm-interactively-view-part
-Prompt for a mailcap method to use to view the part.
-
-@end table
-
-
-@node Display Customization
-@section Display Customization
-
-@table @code
-
-@item mm-inline-media-tests
-@vindex mm-inline-media-tests
-This is an alist where the key is a @acronym{MIME} type, the second element
-is a function to display the part @dfn{inline} (i.e., inside Emacs), and
-the third element is a form to be @code{eval}ed to say whether the part
-can be displayed inline.
-
-This variable specifies whether a part @emph{can} be displayed inline,
-and, if so, how to do it. It does not say whether parts are
-@emph{actually} displayed inline.
-
-@item mm-inlined-types
-@vindex mm-inlined-types
-This, on the other hand, says what types are to be displayed inline, if
-they satisfy the conditions set by the variable above. It's a list of
-@acronym{MIME} media types.
-
-@item mm-automatic-display
-@vindex mm-automatic-display
-This is a list of types that are to be displayed ``automatically'', but
-only if the above variable allows it. That is, only inlinable parts can
-be displayed automatically.
-
-@item mm-automatic-external-display
-@vindex mm-automatic-external-display
-This is a list of types that will be displayed automatically in an
-external viewer.
-
-@item mm-keep-viewer-alive-types
-@vindex mm-keep-viewer-alive-types
-This is a list of media types for which the external viewer will not
-be killed when selecting a different article.
-
-@item mm-attachment-override-types
-@vindex mm-attachment-override-types
-Some @acronym{MIME} agents create parts that have a content-disposition of
-@samp{attachment}. This variable allows overriding that disposition and
-displaying the part inline. (Note that the disposition is only
-overridden if we are able to, and want to, display the part inline.)
-
-@item mm-discouraged-alternatives
-@vindex mm-discouraged-alternatives
-List of @acronym{MIME} types that are discouraged when viewing
-@samp{multipart/alternative}. Viewing agents are supposed to view the
-last possible part of a message, as that is supposed to be the richest.
-However, users may prefer other types instead, and this list says what
-types are most unwanted. If, for instance, @samp{text/html} parts are
-very unwanted, and @samp{text/richtext} parts are somewhat unwanted,
-you could say something like:
-
-@lisp
-(setq mm-discouraged-alternatives
- '("text/html" "text/richtext")
- mm-automatic-display
- (remove "text/html" mm-automatic-display))
-@end lisp
-
-Adding @code{"image/.*"} might also be useful. Spammers use images as
-the preferred part of @samp{multipart/alternative} messages, so you might
-not notice there are other parts. See also
-@code{gnus-buttonized-mime-types}, @ref{MIME Commands, ,MIME Commands,
-gnus, Gnus Manual}. After adding @code{"multipart/alternative"} to
-@code{gnus-buttonized-mime-types} you can choose manually which
-alternative you'd like to view. For example, you can set those
-variables like:
-
-@lisp
-(setq gnus-buttonized-mime-types
- '("multipart/alternative" "multipart/signed")
- mm-discouraged-alternatives
- '("text/html" "image/.*"))
-@end lisp
-
-In this case, Gnus will display radio buttons for such a kind of spam
-message as follows:
-
-@example
-1. (*) multipart/alternative ( ) image/gif
-
-2. (*) text/plain ( ) text/html
-@end example
-
-@item mm-inline-large-images
-@vindex mm-inline-large-images
-When displaying inline images that are larger than the window, Emacs
-does not enable scrolling, which means that you cannot see the whole
-image. To prevent this, the library tries to determine the image size
-before displaying it inline, and if it doesn't fit the window, the
-library will display it externally (e.g. with @samp{ImageMagick} or
-@samp{xv}). Setting this variable to @code{t} disables this check and
-makes the library display all inline images as inline, regardless of
-their size.
-
-@item mm-inline-override-types
-@vindex mm-inline-override-types
-@code{mm-inlined-types} may include regular expressions, for example to
-specify that all @samp{text/.*} parts be displayed inline. If a user
-prefers to have a type that matches such a regular expression be treated
-as an attachment, that can be accomplished by setting this variable to a
-list containing that type. For example assuming @code{mm-inlined-types}
-includes @samp{text/.*}, then including @samp{text/html} in this
-variable will cause @samp{text/html} parts to be treated as attachments.
-
-@item mm-text-html-renderer
-@vindex mm-text-html-renderer
-This selects the function used to render @acronym{HTML}. The predefined
-renderers are selected by the symbols @code{w3},
-@code{w3m}@footnote{See @uref{http://emacs-w3m.namazu.org/} for more
-information about emacs-w3m}, @code{links}, @code{lynx},
-@code{w3m-standalone} or @code{html2text}. If @code{nil} use an
-external viewer. You can also specify a function, which will be
-called with a @acronym{MIME} handle as the argument.
-
-@item mm-inline-text-html-with-images
-@vindex mm-inline-text-html-with-images
-Some @acronym{HTML} mails might have the trick of spammers using
-@samp{<img>} tags. It is likely to be intended to verify whether you
-have read the mail. You can prevent your personal informations from
-leaking by setting this option to @code{nil} (which is the default).
-It is currently ignored by Emacs/w3. For emacs-w3m, you may use the
-command @kbd{t} on the image anchor to show an image even if it is
-@code{nil}.@footnote{The command @kbd{T} will load all images. If you
-have set the option @code{w3m-key-binding} to @code{info}, use @kbd{i}
-or @kbd{I} instead.}
-
-@item mm-w3m-safe-url-regexp
-@vindex mm-w3m-safe-url-regexp
-A regular expression that matches safe URL names, i.e. URLs that are
-unlikely to leak personal information when rendering @acronym{HTML}
-email (the default value is @samp{\\`cid:}). If @code{nil} consider
-all URLs safe.
-
-@item mm-inline-text-html-with-w3m-keymap
-@vindex mm-inline-text-html-with-w3m-keymap
-You can use emacs-w3m command keys in the inlined text/html part by
-setting this option to non-@code{nil}. The default value is @code{t}.
-
-@item mm-external-terminal-program
-@vindex mm-external-terminal-program
-The program used to start an external terminal.
-
-@item mm-enable-external
-@vindex mm-enable-external
-Indicate whether external @acronym{MIME} handlers should be used.
-
-If @code{t}, all defined external @acronym{MIME} handlers are used. If
-@code{nil}, files are saved to disk (@code{mailcap-save-binary-file}).
-If it is the symbol @code{ask}, you are prompted before the external
-@acronym{MIME} handler is invoked.
-
-When you launch an attachment through mailcap (@pxref{mailcap}) an
-attempt is made to use a safe viewer with the safest options---this isn't
-the case if you save it to disk and launch it in a different way
-(command line or double-clicking). Anyhow, if you want to be sure not
-to launch any external programs, set this variable to @code{nil} or
-@code{ask}.
-
-@end table
-
-@node Files and Directories
-@section Files and Directories
-
-@table @code
-
-@item mm-default-directory
-@vindex mm-default-directory
-The default directory for saving attachments. If @code{nil} use
-@code{default-directory}.
-
-@item mm-tmp-directory
-@vindex mm-tmp-directory
-Directory for storing temporary files.
-
-@item mm-file-name-rewrite-functions
-@vindex mm-file-name-rewrite-functions
-A list of functions used for rewriting file names of @acronym{MIME}
-parts. Each function is applied successively to the file name.
-Ready-made functions include
-
-@table @code
-@item mm-file-name-delete-control
-@findex mm-file-name-delete-control
-Delete all control characters.
-
-@item mm-file-name-delete-gotchas
-@findex mm-file-name-delete-gotchas
-Delete characters that could have unintended consequences when used
-with flawed shell scripts, i.e. @samp{|}, @samp{>} and @samp{<}; and
-@samp{-}, @samp{.} as the first character.
-
-@item mm-file-name-delete-whitespace
-@findex mm-file-name-delete-whitespace
-Remove all whitespace.
-
-@item mm-file-name-trim-whitespace
-@findex mm-file-name-trim-whitespace
-Remove leading and trailing whitespace.
-
-@item mm-file-name-collapse-whitespace
-@findex mm-file-name-collapse-whitespace
-Collapse multiple whitespace characters.
-
-@item mm-file-name-replace-whitespace
-@findex mm-file-name-replace-whitespace
-@vindex mm-file-name-replace-whitespace
-Replace whitespace with underscores. Set the variable
-@code{mm-file-name-replace-whitespace} to any other string if you do
-not like underscores.
-@end table
-
-The standard Emacs functions @code{capitalize}, @code{downcase},
-@code{upcase} and @code{upcase-initials} might also prove useful.
-
-@item mm-path-name-rewrite-functions
-@vindex mm-path-name-rewrite-functions
-List of functions used for rewriting the full file names of @acronym{MIME}
-parts. This is used when viewing parts externally, and is meant for
-transforming the absolute name so that non-compliant programs can find
-the file where it's saved.
-
-@end table
-
-@node New Viewers
-@section New Viewers
-
-Here's an example viewer for displaying @code{text/enriched} inline:
-
-@lisp
-(defun mm-display-enriched-inline (handle)
- (let (text)
- (with-temp-buffer
- (mm-insert-part handle)
- (save-window-excursion
- (enriched-decode (point-min) (point-max))
- (setq text (buffer-string))))
- (mm-insert-inline handle text)))
-@end lisp
-
-We see that the function takes a @acronym{MIME} handle as its parameter. It
-then goes to a temporary buffer, inserts the text of the part, does some
-work on the text, stores the result, goes back to the buffer it was
-called from and inserts the result.
-
-The two important helper functions here are @code{mm-insert-part} and
-@code{mm-insert-inline}. The first function inserts the text of the
-handle in the current buffer. It handles charset and/or content
-transfer decoding. The second function just inserts whatever text you
-tell it to insert, but it also sets things up so that the text can be
-``undisplayed'' in a convenient manner.
-
-
-@node Composing
-@chapter Composing
-@cindex Composing
-@cindex MIME Composing
-@cindex MML
-@cindex MIME Meta Language
-
-Creating a @acronym{MIME} message is boring and non-trivial. Therefore,
-a library called @code{mml} has been defined that parses a language
-called @acronym{MML} (@acronym{MIME} Meta Language) and generates
-@acronym{MIME} messages.
-
-@findex mml-generate-mime
-The main interface function is @code{mml-generate-mime}. It will
-examine the contents of the current (narrowed-to) buffer and return a
-string containing the @acronym{MIME} message.
-
-@menu
-* Simple MML Example:: An example @acronym{MML} document.
-* MML Definition:: All valid @acronym{MML} elements.
-* Advanced MML Example:: Another example @acronym{MML} document.
-* Encoding Customization:: Variables that affect encoding.
-* Charset Translation:: How charsets are mapped from @sc{mule} to @acronym{MIME}.
-* Conversion:: Going from @acronym{MIME} to @acronym{MML} and vice versa.
-* Flowed text:: Soft and hard newlines.
-@end menu
-
-
-@node Simple MML Example
-@section Simple MML Example
-
-Here's a simple @samp{multipart/alternative}:
-
-@example
-<#multipart type=alternative>
-This is a plain text part.
-<#part type=text/enriched>
-<center>This is a centered enriched part</center>
-<#/multipart>
-@end example
-
-After running this through @code{mml-generate-mime}, we get this:
-
-@example
-Content-Type: multipart/alternative; boundary="=-=-="
-
-
---=-=-=
-
-
-This is a plain text part.
-
---=-=-=
-Content-Type: text/enriched
-
-
-<center>This is a centered enriched part</center>
-
---=-=-=--
-@end example
-
-
-@node MML Definition
-@section MML Definition
-
-The @acronym{MML} language is very simple. It looks a bit like an SGML
-application, but it's not.
-
-The main concept of @acronym{MML} is the @dfn{part}. Each part can be of a
-different type or use a different charset. The way to delineate a part
-is with a @samp{<#part ...>} tag. Multipart parts can be introduced
-with the @samp{<#multipart ...>} tag. Parts are ended by the
-@samp{<#/part>} or @samp{<#/multipart>} tags. Parts started with the
-@samp{<#part ...>} tags are also closed by the next open tag.
-
-There's also the @samp{<#external ...>} tag. These introduce
-@samp{external/message-body} parts.
-
-Each tag can contain zero or more parameters on the form
-@samp{parameter=value}. The values may be enclosed in quotation marks,
-but that's not necessary unless the value contains white space. So
-@samp{filename=/home/user/#hello$^yes} is perfectly valid.
-
-The following parameters have meaning in @acronym{MML}; parameters that have no
-meaning are ignored. The @acronym{MML} parameter names are the same as the
-@acronym{MIME} parameter names; the things in the parentheses say which
-header it will be used in.
-
-@table @samp
-@item type
-The @acronym{MIME} type of the part (@code{Content-Type}).
-
-@item filename
-Use the contents of the file in the body of the part
-(@code{Content-Disposition}).
-
-@item charset
-The contents of the body of the part are to be encoded in the character
-set specified (@code{Content-Type}). @xref{Charset Translation}.
-
-@item name
-Might be used to suggest a file name if the part is to be saved
-to a file (@code{Content-Type}).
-
-@item disposition
-Valid values are @samp{inline} and @samp{attachment}
-(@code{Content-Disposition}).
-
-@item encoding
-Valid values are @samp{7bit}, @samp{8bit}, @samp{quoted-printable} and
-@samp{base64} (@code{Content-Transfer-Encoding}). @xref{Charset
-Translation}.
-
-@item description
-A description of the part (@code{Content-Description}).
-
-@item creation-date
-RFC822 date when the part was created (@code{Content-Disposition}).
-
-@item modification-date
-RFC822 date when the part was modified (@code{Content-Disposition}).
-
-@item read-date
-RFC822 date when the part was read (@code{Content-Disposition}).
-
-@item recipients
-Who to encrypt/sign the part to. This field is used to override any
-auto-detection based on the To/CC headers.
-
-@item sender
-Identity used to sign the part. This field is used to override the
-default key used.
-
-@item size
-The size (in octets) of the part (@code{Content-Disposition}).
-
-@item sign
-What technology to sign this @acronym{MML} part with (@code{smime}, @code{pgp}
-or @code{pgpmime})
-
-@item encrypt
-What technology to encrypt this @acronym{MML} part with (@code{smime},
-@code{pgp} or @code{pgpmime})
-
-@end table
-
-Parameters for @samp{text/plain}:
-
-@table @samp
-@item format
-Formatting parameter for the text, valid values include @samp{fixed}
-(the default) and @samp{flowed}. Normally you do not specify this
-manually, since it requires the textual body to be formatted in a
-special way described in RFC 2646. @xref{Flowed text}.
-@end table
-
-Parameters for @samp{application/octet-stream}:
-
-@table @samp
-@item type
-Type of the part; informal---meant for human readers
-(@code{Content-Type}).
-@end table
-
-Parameters for @samp{message/external-body}:
-
-@table @samp
-@item access-type
-A word indicating the supported access mechanism by which the file may
-be obtained. Values include @samp{ftp}, @samp{anon-ftp}, @samp{tftp},
-@samp{localfile}, and @samp{mailserver}. (@code{Content-Type}.)
-
-@item expiration
-The RFC822 date after which the file may no longer be fetched.
-(@code{Content-Type}.)
-
-@item size
-The size (in octets) of the file. (@code{Content-Type}.)
-
-@item permission
-Valid values are @samp{read} and @samp{read-write}
-(@code{Content-Type}).
-
-@end table
-
-Parameters for @samp{sign=smime}:
-
-@table @samp
-
-@item keyfile
-File containing key and certificate for signer.
-
-@end table
-
-Parameters for @samp{encrypt=smime}:
-
-@table @samp
-
-@item certfile
-File containing certificate for recipient.
-
-@end table
-
-
-@node Advanced MML Example
-@section Advanced MML Example
-
-Here's a complex multipart message. It's a @samp{multipart/mixed} that
-contains many parts, one of which is a @samp{multipart/alternative}.
-
-@example
-<#multipart type=mixed>
-<#part type=image/jpeg filename=~/rms.jpg disposition=inline>
-<#multipart type=alternative>
-This is a plain text part.
-<#part type=text/enriched name=enriched.txt>
-<center>This is a centered enriched part</center>
-<#/multipart>
-This is a new plain text part.
-<#part disposition=attachment>
-This plain text part is an attachment.
-<#/multipart>
-@end example
-
-And this is the resulting @acronym{MIME} message:
-
-@example
-Content-Type: multipart/mixed; boundary="=-=-="
-
-
---=-=-=
-
-
-
---=-=-=
-Content-Type: image/jpeg;
- filename="~/rms.jpg"
-Content-Disposition: inline;
- filename="~/rms.jpg"
-Content-Transfer-Encoding: base64
-
-/9j/4AAQSkZJRgABAQAAAQABAAD/2wBDAAgGBgcGBQgHBwcJCQgKDBQNDAsLDBkSEw8UHRof
-Hh0aHBwgJC4nICIsIxwcKDcpLDAxNDQ0Hyc5PTgyPC4zNDL/wAALCAAwADABAREA/8QAHwAA
-AQUBAQEBAQEAAAAAAAAAAAECAwQFBgcICQoL/8QAtRAAAgEDAwIEAwUFBAQAAAF9AQIDAAQR
-BRIhMUEGE1FhByJxFDKBkaEII0KxwRVS0fAkM2JyggkKFhcYGRolJicoKSo0NTY3ODk6Q0RF
-RkdISUpTVFVWV1hZWmNkZWZnaGlqc3R1dnd4eXqDhIWGh4iJipKTlJWWl5iZmqKjpKWmp6ip
-qrKztLW2t7i5usLDxMXGx8jJytLT1NXW19jZ2uHi4+Tl5ufo6erx8vP09fb3+Pn6/9oACAEB
-AAA/AO/rifFHjldNuGsrDa0qcSSHkA+gHrXKw+LtWLrMb+RgTyhbr+HSug07xNqV9fQtZrNI
-AyiaE/NuBPOOOP0rvRNE880KOC8TbXXGCv1FPqjrF4LDR7u5L7SkTFT/ALWOP1xXgTuXfc7E
-sx6nua6rwp4IvvEM8chCxWxOdzn7wz6V9AaB4S07w9p5itow0rDLSY5Pt9K43xO66P4xs71m
-2QXiGCbA4yOVJ9+1aYORkdK434lyNH4ahCnG66VT9Nj15JFbPdX0MS43M4VQf5/yr2vSpLnw
-5ZW8dlCZ8KFXjOPX0/mK6rSPEGt3Angu44fNEReHYNvIH3TzXDeKNO8RX+kSX2ouZkicTIOc
-L+g7E810ulFjpVtv3bwgB3HJyK5L4quY/C9sVxk3ij/xx6850u7t1mtp/wDlpEw3An3Jr3Dw
-34gsbWza4nBlhC5LDsaW6+IFgupQyCF3iHH7gA7c9R9ay7zx6t7aX9jHC4smhfBkGCvHGfrm
-tLQ7hbnRrV1GPkAP1x1/Hr+Ncr8Vzjwrbf8AX6v/AKA9eQRyYlQk8Yx9K6XTNbkgia2ciSIn
-7p5Ga9Atte0LTLKO6it4i7dVRFJDcZ4PvXN+JvEMF9bILVGXJLSZ4zkjivRPDaeX4b08HOTC
-pOffmua+KkbS+GLVUGT9tT/0B68eeIpIFYjB70+OOVXyoOM9+M1eaWeCLzHPyHGO/NVWvJJm
-jQ8KGH1NfQWhXSXmh2c8eArRLwO3HSv/2Q==
-
---=-=-=
-Content-Type: multipart/alternative; boundary="==-=-="
-
-
---==-=-=
-
-
-This is a plain text part.
-
---==-=-=
-Content-Type: text/enriched;
- name="enriched.txt"
-
-
-<center>This is a centered enriched part</center>
-
---==-=-=--
-
---=-=-=
-
-This is a new plain text part.
-
---=-=-=
-Content-Disposition: attachment
-
-
-This plain text part is an attachment.
-
---=-=-=--
-@end example
-
-@node Encoding Customization
-@section Encoding Customization
-
-@table @code
-
-@item mm-body-charset-encoding-alist
-@vindex mm-body-charset-encoding-alist
-Mapping from @acronym{MIME} charset to encoding to use. This variable is
-usually used except, e.g., when other requirements force a specific
-encoding (digitally signed messages require 7bit encodings). The
-default is
-
-@lisp
-((iso-2022-jp . 7bit)
- (iso-2022-jp-2 . 7bit)
- (utf-16 . base64)
- (utf-16be . base64)
- (utf-16le . base64))
-@end lisp
-
-As an example, if you do not want to have ISO-8859-1 characters
-quoted-printable encoded, you may add @code{(iso-8859-1 . 8bit)} to
-this variable. You can override this setting on a per-message basis
-by using the @code{encoding} @acronym{MML} tag (@pxref{MML Definition}).
-
-@item mm-coding-system-priorities
-@vindex mm-coding-system-priorities
-Prioritize coding systems to use for outgoing messages. The default
-is @code{nil}, which means to use the defaults in Emacs, but is
-@code{(iso-8859-1 iso-2022-jp iso-2022-jp-2 shift_jis utf-8)} when
-running Emacs in the Japanese language environment. It is a list of
-coding system symbols (aliases of coding systems are also allowed, use
-@kbd{M-x describe-coding-system} to make sure you are specifying correct
-coding system names). For example, if you have configured Emacs
-to prefer UTF-8, but wish that outgoing messages should be sent in
-ISO-8859-1 if possible, you can set this variable to
-@code{(iso-8859-1)}. You can override this setting on a per-message
-basis by using the @code{charset} @acronym{MML} tag (@pxref{MML Definition}).
-
-@item mm-content-transfer-encoding-defaults
-@vindex mm-content-transfer-encoding-defaults
-Mapping from @acronym{MIME} types to encoding to use. This variable is usually
-used except, e.g., when other requirements force a safer encoding
-(digitally signed messages require 7bit encoding). Besides the normal
-@acronym{MIME} encodings, @code{qp-or-base64} may be used to indicate that for
-each case the most efficient of quoted-printable and base64 should be
-used.
-
-@code{qp-or-base64} has another effect. It will fold long lines so that
-MIME parts may not be broken by MTA. So do @code{quoted-printable} and
-@code{base64}.
-
-Note that it affects body encoding only when a part is a raw forwarded
-message (which will be made by @code{gnus-summary-mail-forward} with the
-arg 2 for example) or is neither the @samp{text/*} type nor the
-@samp{message/*} type. Even though in those cases, you can override
-this setting on a per-message basis by using the @code{encoding}
-@acronym{MML} tag (@pxref{MML Definition}).
-
-@item mm-use-ultra-safe-encoding
-@vindex mm-use-ultra-safe-encoding
-When this is non-@code{nil}, it means that textual parts are encoded as
-quoted-printable if they contain lines longer than 76 characters or
-starting with "From " in the body. Non-7bit encodings (8bit, binary)
-are generally disallowed. This reduce the probability that a non-8bit
-clean MTA or MDA changes the message. This should never be set
-directly, but bound by other functions when necessary (e.g., when
-encoding messages that are to be digitally signed).
-
-@end table
-
-@node Charset Translation
-@section Charset Translation
-@cindex charsets
-
-During translation from @acronym{MML} to @acronym{MIME}, for each
-@acronym{MIME} part which has been composed inside Emacs, an appropriate
-charset has to be chosen.
-
-@vindex mail-parse-charset
-If you are running a non-@sc{mule} Emacs, this process is simple: If the
-part contains any non-@acronym{ASCII} (8-bit) characters, the @acronym{MIME} charset
-given by @code{mail-parse-charset} (a symbol) is used. (Never set this
-variable directly, though. If you want to change the default charset,
-please consult the documentation of the package which you use to process
-@acronym{MIME} messages.
-@xref{Various Message Variables, , Various Message Variables, message,
- Message Manual}, for example.)
-If there are only @acronym{ASCII} characters, the @acronym{MIME} charset US-ASCII is
-used, of course.
-
-@cindex MULE
-@cindex UTF-8
-@cindex Unicode
-@vindex mm-mime-mule-charset-alist
-Things are slightly more complicated when running Emacs with @sc{mule}
-support. In this case, a list of the @sc{mule} charsets used in the
-part is obtained, and the @sc{mule} charsets are translated to
-@acronym{MIME} charsets by consulting the table provided by Emacs itself
-or the variable @code{mm-mime-mule-charset-alist} for XEmacs.
-If this results in a single @acronym{MIME} charset, this is used to encode
-the part. But if the resulting list of @acronym{MIME} charsets contains more
-than one element, two things can happen: If it is possible to encode the
-part via UTF-8, this charset is used. (For this, Emacs must support
-the @code{utf-8} coding system, and the part must consist entirely of
-characters which have Unicode counterparts.) If UTF-8 is not available
-for some reason, the part is split into several ones, so that each one
-can be encoded with a single @acronym{MIME} charset. The part can only be
-split at line boundaries, though---if more than one @acronym{MIME} charset is
-required to encode a single line, it is not possible to encode the part.
-
-When running Emacs with @sc{mule} support, the preferences for which
-coding system to use is inherited from Emacs itself. This means that
-if Emacs is set up to prefer UTF-8, it will be used when encoding
-messages. You can modify this by altering the
-@code{mm-coding-system-priorities} variable though (@pxref{Encoding
-Customization}).
-
-The charset to be used can be overridden by setting the @code{charset}
-@acronym{MML} tag (@pxref{MML Definition}) when composing the message.
-
-The encoding of characters (quoted-printable, 8bit etc) is orthogonal
-to the discussion here, and is controlled by the variables
-@code{mm-body-charset-encoding-alist} and
-@code{mm-content-transfer-encoding-defaults} (@pxref{Encoding
-Customization}).
-
-@node Conversion
-@section Conversion
-
-@findex mime-to-mml
-A (multipart) @acronym{MIME} message can be converted to @acronym{MML}
-with the @code{mime-to-mml} function. It works on the message in the
-current buffer, and substitutes @acronym{MML} markup for @acronym{MIME}
-boundaries. Non-textual parts do not have their contents in the buffer,
-but instead have the contents in separate buffers that are referred to
-from the @acronym{MML} tags.
-
-@findex mml-to-mime
-An @acronym{MML} message can be converted back to @acronym{MIME} by the
-@code{mml-to-mime} function.
-
-These functions are in certain senses ``lossy''---you will not get back
-an identical message if you run @code{mime-to-mml} and then
-@code{mml-to-mime}. Not only will trivial things like the order of the
-headers differ, but the contents of the headers may also be different.
-For instance, the original message may use base64 encoding on text,
-while @code{mml-to-mime} may decide to use quoted-printable encoding, and
-so on.
-
-In essence, however, these two functions should be the inverse of each
-other. The resulting contents of the message should remain equivalent,
-if not identical.
-
-
-@node Flowed text
-@section Flowed text
-@cindex format=flowed
-
-The Emacs @acronym{MIME} library will respect the @code{use-hard-newlines}
-variable (@pxref{Hard and Soft Newlines, ,Hard and Soft Newlines,
-emacs, Emacs Manual}) when encoding a message, and the
-``format=flowed'' Content-Type parameter when decoding a message.
-
-On encoding text, regardless of @code{use-hard-newlines}, lines
-terminated by soft newline characters are filled together and wrapped
-after the column decided by @code{fill-flowed-encode-column}.
-Quotation marks (matching @samp{^>* ?}) are respected. The variable
-controls how the text will look in a client that does not support
-flowed text, the default is to wrap after 66 characters. If hard
-newline characters are not present in the buffer, no flow encoding
-occurs.
-
-On decoding flowed text, lines with soft newline characters are filled
-together and wrapped after the column decided by
-@code{fill-flowed-display-column}. The default is to wrap after
-@code{fill-column}.
-
-@table @code
-@item mm-fill-flowed
-@vindex mm-fill-flowed
-If non-@code{nil} a format=flowed article will be displayed flowed.
-@end table
-
-
-@node Interface Functions
-@chapter Interface Functions
-@cindex interface functions
-@cindex mail-parse
-
-The @code{mail-parse} library is an abstraction over the actual
-low-level libraries that are described in the next chapter.
-
-Standards change, and so programs have to change to fit in the new
-mold. For instance, RFC2045 describes a syntax for the
-@code{Content-Type} header that only allows @acronym{ASCII} characters in the
-parameter list. RFC2231 expands on RFC2045 syntax to provide a scheme
-for continuation headers and non-@acronym{ASCII} characters.
-
-The traditional way to deal with this is just to update the library
-functions to parse the new syntax. However, this is sometimes the wrong
-thing to do. In some instances it may be vital to be able to understand
-both the old syntax as well as the new syntax, and if there is only one
-library, one must choose between the old version of the library and the
-new version of the library.
-
-The Emacs @acronym{MIME} library takes a different tack. It defines a
-series of low-level libraries (@file{rfc2047.el}, @file{rfc2231.el}
-and so on) that parses strictly according to the corresponding
-standard. However, normal programs would not use the functions
-provided by these libraries directly, but instead use the functions
-provided by the @code{mail-parse} library. The functions in this
-library are just aliases to the corresponding functions in the latest
-low-level libraries. Using this scheme, programs get a consistent
-interface they can use, and library developers are free to create
-write code that handles new standards.
-
-The following functions are defined by this library:
-
-@table @code
-@item mail-header-parse-content-type
-@findex mail-header-parse-content-type
-Parse a @code{Content-Type} header and return a list on the following
-format:
-
-@lisp
-("type/subtype"
- (attribute1 . value1)
- (attribute2 . value2)
- ...)
-@end lisp
-
-Here's an example:
-
-@example
-(mail-header-parse-content-type
- "image/gif; name=\"b980912.gif\"")
-@result{} ("image/gif" (name . "b980912.gif"))
-@end example
-
-@item mail-header-parse-content-disposition
-@findex mail-header-parse-content-disposition
-Parse a @code{Content-Disposition} header and return a list on the same
-format as the function above.
-
-@item mail-content-type-get
-@findex mail-content-type-get
-Takes two parameters---a list on the format above, and an attribute.
-Returns the value of the attribute.
-
-@example
-(mail-content-type-get
- '("image/gif" (name . "b980912.gif")) 'name)
-@result{} "b980912.gif"
-@end example
-
-@item mail-header-encode-parameter
-@findex mail-header-encode-parameter
-Takes a parameter string and returns an encoded version of the string.
-This is used for parameters in headers like @code{Content-Type} and
-@code{Content-Disposition}.
-
-@item mail-header-remove-comments
-@findex mail-header-remove-comments
-Return a comment-free version of a header.
-
-@example
-(mail-header-remove-comments
- "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
-@result{} "Gnus/5.070027 "
-@end example
-
-@item mail-header-remove-whitespace
-@findex mail-header-remove-whitespace
-Remove linear white space from a header. Space inside quoted strings
-and comments is preserved.
-
-@example
-(mail-header-remove-whitespace
- "image/gif; name=\"Name with spaces\"")
-@result{} "image/gif;name=\"Name with spaces\""
-@end example
-
-@item mail-header-get-comment
-@findex mail-header-get-comment
-Return the last comment in a header.
-
-@example
-(mail-header-get-comment
- "Gnus/5.070027 (Pterodactyl Gnus v0.27) (Finnish Landrace)")
-@result{} "Finnish Landrace"
-@end example
-
-@item mail-header-parse-address
-@findex mail-header-parse-address
-Parse an address and return a list containing the mailbox and the
-plaintext name.
-
-@example
-(mail-header-parse-address
- "Hrvoje Niksic <hniksic@@srce.hr>")
-@result{} ("hniksic@@srce.hr" . "Hrvoje Niksic")
-@end example
-
-@item mail-header-parse-addresses
-@findex mail-header-parse-addresses
-Parse a string with list of addresses and return a list of elements like
-the one described above.
-
-@example
-(mail-header-parse-addresses
- "Hrvoje Niksic <hniksic@@srce.hr>, Steinar Bang <sb@@metis.no>")
-@result{} (("hniksic@@srce.hr" . "Hrvoje Niksic")
- ("sb@@metis.no" . "Steinar Bang"))
-@end example
-
-@item mail-header-parse-date
-@findex mail-header-parse-date
-Parse a date string and return an Emacs time structure.
-
-@item mail-narrow-to-head
-@findex mail-narrow-to-head
-Narrow the buffer to the header section of the buffer. Point is placed
-at the beginning of the narrowed buffer.
-
-@item mail-header-narrow-to-field
-@findex mail-header-narrow-to-field
-Narrow the buffer to the header under point. Understands continuation
-headers.
-
-@item mail-header-fold-field
-@findex mail-header-fold-field
-Fold the header under point.
-
-@item mail-header-unfold-field
-@findex mail-header-unfold-field
-Unfold the header under point.
-
-@item mail-header-field-value
-@findex mail-header-field-value
-Return the value of the field under point.
-
-@item mail-encode-encoded-word-region
-@findex mail-encode-encoded-word-region
-Encode the non-@acronym{ASCII} words in the region. For instance,
-@samp{Naïve} is encoded as @samp{=?iso-8859-1?q?Na=EFve?=}.
-
-@item mail-encode-encoded-word-buffer
-@findex mail-encode-encoded-word-buffer
-Encode the non-@acronym{ASCII} words in the current buffer. This function is
-meant to be called narrowed to the headers of a message.
-
-@item mail-encode-encoded-word-string
-@findex mail-encode-encoded-word-string
-Encode the words that need encoding in a string, and return the result.
-
-@example
-(mail-encode-encoded-word-string
- "This is naïve, baby")
-@result{} "This is =?iso-8859-1?q?na=EFve,?= baby"
-@end example
-
-@item mail-decode-encoded-word-region
-@findex mail-decode-encoded-word-region
-Decode the encoded words in the region.
-
-@item mail-decode-encoded-word-string
-@findex mail-decode-encoded-word-string
-Decode the encoded words in the string and return the result.
-
-@example
-(mail-decode-encoded-word-string
- "This is =?iso-8859-1?q?na=EFve,?= baby")
-@result{} "This is naïve, baby"
-@end example
-
-@end table
-
-Currently, @code{mail-parse} is an abstraction over @code{ietf-drums},
-@code{rfc2047}, @code{rfc2045} and @code{rfc2231}. These are documented
-in the subsequent sections.
-
-
-
-@node Basic Functions
-@chapter Basic Functions
-
-This chapter describes the basic, ground-level functions for parsing and
-handling. Covered here is parsing @code{From} lines, removing comments
-from header lines, decoding encoded words, parsing date headers and so
-on. High-level functionality is dealt with in the first chapter
-(@pxref{Decoding and Viewing}).
-
-@menu
-* rfc2045:: Encoding @code{Content-Type} headers.
-* rfc2231:: Parsing @code{Content-Type} headers.
-* ietf-drums:: Handling mail headers defined by RFC822bis.
-* rfc2047:: En/decoding encoded words in headers.
-* time-date:: Functions for parsing dates and manipulating time.
-* qp:: Quoted-Printable en/decoding.
-* base64:: Base64 en/decoding.
-* binhex:: Binhex decoding.
-* uudecode:: Uuencode decoding.
-* yenc:: Yenc decoding.
-* rfc1843:: Decoding HZ-encoded text.
-* mailcap:: How parts are displayed is specified by the @file{.mailcap} file
-@end menu
-
-
-@node rfc2045
-@section rfc2045
-
-RFC2045 is the ``main'' @acronym{MIME} document, and as such, one would
-imagine that there would be a lot to implement. But there isn't, since
-most of the implementation details are delegated to the subsequent
-RFCs.
-
-So @file{rfc2045.el} has only a single function:
-
-@table @code
-@item rfc2045-encode-string
-@findex rfc2045-encode-string
-Takes a parameter and a value and returns a @samp{PARAM=VALUE} string.
-@var{value} will be quoted if there are non-safe characters in it.
-@end table
-
-
-@node rfc2231
-@section rfc2231
-
-RFC2231 defines a syntax for the @code{Content-Type} and
-@code{Content-Disposition} headers. Its snappy name is @dfn{MIME
-Parameter Value and Encoded Word Extensions: Character Sets, Languages,
-and Continuations}.
-
-In short, these headers look something like this:
-
-@example
-Content-Type: application/x-stuff;
- title*0*=us-ascii'en'This%20is%20even%20more%20;
- title*1*=%2A%2A%2Afun%2A%2A%2A%20;
- title*2="isn't it!"
-@end example
-
-They usually aren't this bad, though.
-
-The following functions are defined by this library:
-
-@table @code
-@item rfc2231-parse-string
-@findex rfc2231-parse-string
-Parse a @code{Content-Type} header and return a list describing its
-elements.
-
-@example
-(rfc2231-parse-string
- "application/x-stuff;
- title*0*=us-ascii'en'This%20is%20even%20more%20;
- title*1*=%2A%2A%2Afun%2A%2A%2A%20;
- title*2=\"isn't it!\"")
-@result{} ("application/x-stuff"
- (title . "This is even more ***fun*** isn't it!"))
-@end example
-
-@item rfc2231-get-value
-@findex rfc2231-get-value
-Takes one of the lists on the format above and returns
-the value of the specified attribute.
-
-@item rfc2231-encode-string
-@findex rfc2231-encode-string
-Encode a parameter in headers likes @code{Content-Type} and
-@code{Content-Disposition}.
-
-@end table
-
-
-@node ietf-drums
-@section ietf-drums
-
-@dfn{drums} is an IETF working group that is working on the replacement
-for RFC822.
-
-The functions provided by this library include:
-
-@table @code
-@item ietf-drums-remove-comments
-@findex ietf-drums-remove-comments
-Remove the comments from the argument and return the results.
-
-@item ietf-drums-remove-whitespace
-@findex ietf-drums-remove-whitespace
-Remove linear white space from the string and return the results.
-Spaces inside quoted strings and comments are left untouched.
-
-@item ietf-drums-get-comment
-@findex ietf-drums-get-comment
-Return the last most comment from the string.
-
-@item ietf-drums-parse-address
-@findex ietf-drums-parse-address
-Parse an address string and return a list that contains the mailbox and
-the plain text name.
-
-@item ietf-drums-parse-addresses
-@findex ietf-drums-parse-addresses
-Parse a string that contains any number of comma-separated addresses and
-return a list that contains mailbox/plain text pairs.
-
-@item ietf-drums-parse-date
-@findex ietf-drums-parse-date
-Parse a date string and return an Emacs time structure.
-
-@item ietf-drums-narrow-to-header
-@findex ietf-drums-narrow-to-header
-Narrow the buffer to the header section of the current buffer.
-
-@end table
-
-
-@node rfc2047
-@section rfc2047
-
-RFC2047 (Message Header Extensions for Non-@acronym{ASCII} Text) specifies how
-non-@acronym{ASCII} text in headers are to be encoded. This is actually rather
-complicated, so a number of variables are necessary to tweak what this
-library does.
-
-The following variables are tweakable:
-
-@table @code
-@item rfc2047-header-encoding-alist
-@vindex rfc2047-header-encoding-alist
-This is an alist of header / encoding-type pairs. Its main purpose is
-to prevent encoding of certain headers.
-
-The keys can either be header regexps, or @code{t}.
-
-The values can be @code{nil}, in which case the header(s) in question
-won't be encoded, @code{mime}, which means that they will be encoded, or
-@code{address-mime}, which means the header(s) will be encoded carefully
-assuming they contain addresses.
-
-@item rfc2047-charset-encoding-alist
-@vindex rfc2047-charset-encoding-alist
-RFC2047 specifies two forms of encoding---@code{Q} (a
-Quoted-Printable-like encoding) and @code{B} (base64). This alist
-specifies which charset should use which encoding.
-
-@item rfc2047-encode-function-alist
-@vindex rfc2047-encode-function-alist
-This is an alist of encoding / function pairs. The encodings are
-@code{Q}, @code{B} and @code{nil}.
-
-@item rfc2047-encoded-word-regexp
-@vindex rfc2047-encoded-word-regexp
-When decoding words, this library looks for matches to this regexp.
-
-@item rfc2047-encode-encoded-words
-@vindex rfc2047-encode-encoded-words
-The boolean variable specifies whether encoded words
-(e.g. @samp{=?hello?=}) should be encoded again.
-
-@end table
-
-Those were the variables, and these are this functions:
-
-@table @code
-@item rfc2047-narrow-to-field
-@findex rfc2047-narrow-to-field
-Narrow the buffer to the header on the current line.
-
-@item rfc2047-encode-message-header
-@findex rfc2047-encode-message-header
-Should be called narrowed to the header of a message. Encodes according
-to @code{rfc2047-header-encoding-alist}.
-
-@item rfc2047-encode-region
-@findex rfc2047-encode-region
-Encodes all encodable words in the region specified.
-
-@item rfc2047-encode-string
-@findex rfc2047-encode-string
-Encode a string and return the results.
-
-@item rfc2047-decode-region
-@findex rfc2047-decode-region
-Decode the encoded words in the region.
-
-@item rfc2047-decode-string
-@findex rfc2047-decode-string
-Decode a string and return the results.
-
-@item rfc2047-encode-parameter
-@findex rfc2047-encode-parameter
-Encode a parameter in the RFC2047-like style. This is a replacement for
-the @code{rfc2231-encode-string} function. @xref{rfc2231}.
-
-When attaching files as @acronym{MIME} parts, we should use the RFC2231
-encoding to specify the file names containing non-@acronym{ASCII}
-characters. However, many mail softwares don't support it in practice
-and recipients won't be able to extract files with correct names.
-Instead, the RFC2047-like encoding is acceptable generally. This
-function provides the very RFC2047-like encoding, resigning to such a
-regrettable trend. To use it, put the following line in your
-@file{~/.gnus.el} file:
-
-@lisp
-(defalias 'mail-header-encode-parameter 'rfc2047-encode-parameter)
-@end lisp
-
-@end table
-
-
-@node time-date
-@section time-date
-
-While not really a part of the @acronym{MIME} library, it is convenient to
-document this library here. It deals with parsing @code{Date} headers
-and manipulating time. (Not by using tesseracts, though, I'm sorry to
-say.)
-
-These functions convert between five formats: A date string, an Emacs
-time structure, a decoded time list, a second number, and a day number.
-
-Here's a bunch of time/date/second/day examples:
-
-@example
-(parse-time-string "Sat Sep 12 12:21:54 1998 +0200")
-@result{} (54 21 12 12 9 1998 6 nil 7200)
-
-(date-to-time "Sat Sep 12 12:21:54 1998 +0200")
-@result{} (13818 19266)
-
-(time-to-seconds '(13818 19266))
-@result{} 905595714.0
-
-(seconds-to-time 905595714.0)
-@result{} (13818 19266 0)
-
-(time-to-days '(13818 19266))
-@result{} 729644
-
-(days-to-time 729644)
-@result{} (961933 65536)
-
-(time-since '(13818 19266))
-@result{} (0 430)
-
-(time-less-p '(13818 19266) '(13818 19145))
-@result{} nil
-
-(subtract-time '(13818 19266) '(13818 19145))
-@result{} (0 121)
-
-(days-between "Sat Sep 12 12:21:54 1998 +0200"
- "Sat Sep 07 12:21:54 1998 +0200")
-@result{} 5
-
-(date-leap-year-p 2000)
-@result{} t
-
-(time-to-day-in-year '(13818 19266))
-@result{} 255
-
-(time-to-number-of-days
- (time-since
- (date-to-time "Mon, 01 Jan 2001 02:22:26 GMT")))
-@result{} 4.146122685185185
-@end example
-
-And finally, we have @code{safe-date-to-time}, which does the same as
-@code{date-to-time}, but returns a zero time if the date is
-syntactically malformed.
-
-The five data representations used are the following:
-
-@table @var
-@item date
-An RFC822 (or similar) date string. For instance: @code{"Sat Sep 12
-12:21:54 1998 +0200"}.
-
-@item time
-An internal Emacs time. For instance: @code{(13818 26466)}.
-
-@item seconds
-A floating point representation of the internal Emacs time. For
-instance: @code{905595714.0}.
-
-@item days
-An integer number representing the number of days since 00000101. For
-instance: @code{729644}.
-
-@item decoded time
-A list of decoded time. For instance: @code{(54 21 12 12 9 1998 6 t
-7200)}.
-@end table
-
-All the examples above represent the same moment.
-
-These are the functions available:
-
-@table @code
-@item date-to-time
-Take a date and return a time.
-
-@item time-to-seconds
-Take a time and return seconds.
-
-@item seconds-to-time
-Take seconds and return a time.
-
-@item time-to-days
-Take a time and return days.
-
-@item days-to-time
-Take days and return a time.
-
-@item date-to-day
-Take a date and return days.
-
-@item time-to-number-of-days
-Take a time and return the number of days that represents.
-
-@item safe-date-to-time
-Take a date and return a time. If the date is not syntactically valid,
-return a ``zero'' time.
-
-@item time-less-p
-Take two times and say whether the first time is less (i. e., earlier)
-than the second time.
-
-@item time-since
-Take a time and return a time saying how long it was since that time.
-
-@item subtract-time
-Take two times and subtract the second from the first. I. e., return
-the time between the two times.
-
-@item days-between
-Take two days and return the number of days between those two days.
-
-@item date-leap-year-p
-Take a year number and say whether it's a leap year.
-
-@item time-to-day-in-year
-Take a time and return the day number within the year that the time is
-in.
-
-@end table
-
-
-@node qp
-@section qp
-
-This library deals with decoding and encoding Quoted-Printable text.
-
-Very briefly explained, qp encoding means translating all 8-bit
-characters (and lots of control characters) into things that look like
-@samp{=EF}; that is, an equal sign followed by the byte encoded as a hex
-string.
-
-The following functions are defined by the library:
-
-@table @code
-@item quoted-printable-decode-region
-@findex quoted-printable-decode-region
-QP-decode all the encoded text in the specified region.
-
-@item quoted-printable-decode-string
-@findex quoted-printable-decode-string
-Decode the QP-encoded text in a string and return the results.
-
-@item quoted-printable-encode-region
-@findex quoted-printable-encode-region
-QP-encode all the encodable characters in the specified region. The third
-optional parameter @var{fold} specifies whether to fold long lines.
-(Long here means 72.)
-
-@item quoted-printable-encode-string
-@findex quoted-printable-encode-string
-QP-encode all the encodable characters in a string and return the
-results.
-
-@end table
-
-
-@node base64
-@section base64
-@cindex base64
-
-Base64 is an encoding that encodes three bytes into four characters,
-thereby increasing the size by about 33%. The alphabet used for
-encoding is very resistant to mangling during transit.
-
-The following functions are defined by this library:
-
-@table @code
-@item base64-encode-region
-@findex base64-encode-region
-base64 encode the selected region. Return the length of the encoded
-text. Optional third argument @var{no-line-break} means do not break
-long lines into shorter lines.
-
-@item base64-encode-string
-@findex base64-encode-string
-base64 encode a string and return the result.
-
-@item base64-decode-region
-@findex base64-decode-region
-base64 decode the selected region. Return the length of the decoded
-text. If the region can't be decoded, return @code{nil} and don't
-modify the buffer.
-
-@item base64-decode-string
-@findex base64-decode-string
-base64 decode a string and return the result. If the string can't be
-decoded, @code{nil} is returned.
-
-@end table
-
-
-@node binhex
-@section binhex
-@cindex binhex
-@cindex Apple
-@cindex Macintosh
-
-@code{binhex} is an encoding that originated in Macintosh environments.
-The following function is supplied to deal with these:
-
-@table @code
-@item binhex-decode-region
-@findex binhex-decode-region
-Decode the encoded text in the region. If given a third parameter, only
-decode the @code{binhex} header and return the filename.
-
-@end table
-
-@node uudecode
-@section uudecode
-@cindex uuencode
-@cindex uudecode
-
-@code{uuencode} is probably still the most popular encoding of binaries
-used on Usenet, although @code{base64} rules the mail world.
-
-The following function is supplied by this package:
-
-@table @code
-@item uudecode-decode-region
-@findex uudecode-decode-region
-Decode the text in the region.
-@end table
-
-
-@node yenc
-@section yenc
-@cindex yenc
-
-@code{yenc} is used for encoding binaries on Usenet. The following
-function is supplied by this package:
-
-@table @code
-@item yenc-decode-region
-@findex yenc-decode-region
-Decode the encoded text in the region.
-
-@end table
-
-
-@node rfc1843
-@section rfc1843
-@cindex rfc1843
-@cindex HZ
-@cindex Chinese
-
-RFC1843 deals with mixing Chinese and @acronym{ASCII} characters in messages. In
-essence, RFC1843 switches between @acronym{ASCII} and Chinese by doing this:
-
-@example
-This sentence is in @acronym{ASCII}.
-The next sentence is in GB.~@{<:Ky2;S@{#,NpJ)l6HK!#~@}Bye.
-@end example
-
-Simple enough, and widely used in China.
-
-The following functions are available to handle this encoding:
-
-@table @code
-@item rfc1843-decode-region
-Decode HZ-encoded text in the region.
-
-@item rfc1843-decode-string
-Decode a HZ-encoded string and return the result.
-
-@end table
-
-
-@node mailcap
-@section mailcap
-
-The @file{~/.mailcap} file is parsed by most @acronym{MIME}-aware message
-handlers and describes how elements are supposed to be displayed.
-Here's an example file:
-
-@example
-image/*; gimp -8 %s
-audio/wav; wavplayer %s
-application/msword; catdoc %s ; copiousoutput ; nametemplate=%s.doc
-@end example
-
-This says that all image files should be displayed with @code{gimp},
-that WAVE audio files should be played by @code{wavplayer}, and that
-MS-WORD files should be inlined by @code{catdoc}.
-
-The @code{mailcap} library parses this file, and provides functions for
-matching types.
-
-@table @code
-@item mailcap-mime-data
-@vindex mailcap-mime-data
-This variable is an alist of alists containing backup viewing rules.
-
-@end table
-
-Interface functions:
-
-@table @code
-@item mailcap-parse-mailcaps
-@findex mailcap-parse-mailcaps
-Parse the @file{~/.mailcap} file.
-
-@item mailcap-mime-info
-Takes a @acronym{MIME} type as its argument and returns the matching viewer.
-
-@end table
-
-
-
-
-@node Standards
-@chapter Standards
-
-The Emacs @acronym{MIME} library implements handling of various elements
-according to a (somewhat) large number of RFCs, drafts and standards
-documents. This chapter lists the relevant ones. They can all be
-fetched from @uref{http://quimby.gnus.org/notes/}.
-
-@table @dfn
-@item RFC822
-@itemx STD11
-Standard for the Format of ARPA Internet Text Messages.
-
-@item RFC1036
-Standard for Interchange of USENET Messages
-
-@item RFC2045
-Format of Internet Message Bodies
-
-@item RFC2046
-Media Types
-
-@item RFC2047
-Message Header Extensions for Non-@acronym{ASCII} Text
-
-@item RFC2048
-Registration Procedures
-
-@item RFC2049
-Conformance Criteria and Examples
-
-@item RFC2231
-@acronym{MIME} Parameter Value and Encoded Word Extensions: Character Sets,
-Languages, and Continuations
-
-@item RFC1843
-HZ - A Data Format for Exchanging Files of Arbitrarily Mixed Chinese and
-@acronym{ASCII} characters
-
-@item draft-ietf-drums-msg-fmt-05.txt
-Draft for the successor of RFC822
-
-@item RFC2112
-The @acronym{MIME} Multipart/Related Content-type
-
-@item RFC1892
-The Multipart/Report Content Type for the Reporting of Mail System
-Administrative Messages
-
-@item RFC2183
-Communicating Presentation Information in Internet Messages: The
-Content-Disposition Header Field
-
-@item RFC2646
-Documentation of the text/plain format parameter for flowed text.
-
-@end table
-
-@node GNU Free Documentation License
-@chapter GNU Free Documentation License
-@include doclicense.texi
-
-@node Index
-@chapter Index
-@printindex cp
-
-@summarycontents
-@contents
-@bye
-
-\f
-@c Local Variables:
-@c mode: texinfo
-@c coding: iso-8859-1
-@c End:
-
-@ignore
- arch-tag: c7ef2fd0-a91c-4e10-aa52-c1a2b11b1a8d
-@end ignore
+++ /dev/null
-/* XPM */
-static char * picon-bar_xpm[] = {
-"6 48 2 1",
-" c white s background",
-". c black",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. ",
-" .. "};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" .... ",
-" .XXXX. .... ",
-" .XXXX. .XXXX.",
-" .XXX. .XXXX.",
-" .........XX. .XXX.",
-".ooooooooo.. .........XX. ",
-".o....ooooo...... .ooooooooo.. ",
-"X. .ooooooooo.X..o....ooooo. ",
-"X. .oooo........X. .ooooo. ",
-". .oooo. .X. .ooooo. ",
-" .oooo. .. .oooo.o. ",
-" .oooo. .oooo.o. ",
-" ...... .ooooo.oo..",
-" .ooooo. ...... ..X.",
-" .ooooo. .ooooo. ..",
-" .o..ooo. ..oooo. ",
-".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX",
-"ooo.XX.oo.XXX......ooo..ooo.XXXX",
-"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX",
-"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX",
-"XXXXXXX.oo.XX.......XXX .oo.XXXX",
-"XXXXXXX.....X..XXXXXXXXXX.oo.XXX",
-"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX",
-"XXXXXXXXXXXXXXXXXXXXXXXXX......X",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" .... ",
-" .XXXX. .... ",
-" .XXXX. .XXXX.",
-" .XXX. .XXXX.",
-" .........XX. .XXX.",
-".ooooooooo.. .........XX. ",
-".o....ooooo...... .ooooooooo.. ",
-"X. .ooooooooo.X..o....ooooo. ",
-"X. .oooo........X. .ooooo. ",
-". .oooo. .X. .ooooo. ",
-" .oooo. .. .oooo.o. ",
-" .oooo. .oooo.o. ",
-" ...... .ooooo.oo..",
-" .ooooo. ...... ..X.",
-" .ooooo. .ooooo. ..",
-" .o..ooo. ..oooo. ",
-".ooo..ooo.XXXXXXXXX.o..ooo.XXXXX",
-"ooo.XX.oo.XXX......ooo..ooo.XXXX",
-"oo.XXX.oo.XXX..oooooo.XX.oo.XXXX",
-"..XXXX.oo.XXX..ooooo.XXX.oo.XXXX",
-"XXXXXXX.oo.XX.......XXX .oo.XXXX",
-"XXXXXXX.....X..XXXXXXXXXX.oo.XXX",
-"XXXXXXXXXXXXX.XXXXXXXXXXX.....XX",
-"XXXXXXXXXXXXXXXXXXXXXXXXX......X",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX",
-"XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX"};
+++ /dev/null
-/* XPM */
-static char * icon-describe-group_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #999999999999 s backgroundToolBarColor",
-"X c #FFFFFFFFFFFF",
-"o c #BFBFBFBFBFBF",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-".......................XXXXX....",
-" ... ... ... ... ... XXX XXXXX..",
-"....................XXXXXXXXXXX.",
-"...................XXXXXXXXXXXXX",
-"..................XXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-"................XXXXXXXXXXXXXXXX",
-" ... ... ... ... XXX XXX XXX XXX",
-".................XXXXXXXXXXXXXXX",
-".................XXXXXXXXXXXXXXX",
-"....... .......XXXXXXXXXXXXXX",
-" ... . oooo ... ..X XXX XXX XXX",
-"..... o...oo .......XXXXXXXXXXX.",
-".... .o....o. .......XXXXXXXXX..",
-".... o . ... .........XXXXX....",
-" ... o .. . .. ... ... ... ...",
-"... o . . ..................",
-".. X . . . ...................",
-". o . . ....................",
-" o . ... ... ... ... ...",
-" o .........................",
-"o . ...o......................",
-" ..........................."};
+++ /dev/null
-/* XPM */
-static char * icon-exit-gnus_xpm[] = {
-"32 32 4 1",
-" c #FFFFFFFFFFFF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #BFBFBFBFBFBF",
-" . ",
-" .. .. ",
-" . .. ... ",
-" ... .. . . ",
-" . . ... . . .... ..... ",
-" . .. .... ..... .. . . .. ",
-" . . .. . ... .. . . ",
-" . ...... ",
-" .... ... ... ",
-" .... ......... ... ",
-" .. . . .X.. .. .... ",
-" . .X. .. . . ... ",
-" .X. . . .. . . ",
-" .X. .. .. . ",
-".. . . ..X.. .. .... . .. .. . ",
-"ooooooo.X.ooo..ooo..oo ooooooooo",
-"oooo oo.X.ooo.ooooo..oooooooo oo",
-"o oooo.X.ooooooo ooo.ooooooooooo",
-"oooooo.X.ooooooooooooooo ooooooo",
-"ooo oo.X.ooo ooooooooooooooooooo",
-"oooooo.X.oooooooooo oooooo ooo",
-"ooooo.X.ooooooooooooooo ooooooo",
-"o ooo.X.oooooo ooooooooooooooooo",
-"ooooo.X.oooo o ooooooooo ooooo",
-"ooooo.X.ooooooooooo oooo o ooo",
-"oo....X...ooooooo o oooooooooo",
-"o..XX...XX..ooo.o.oo.oo oooooooo",
-".XX.XX..X.XX...ooo.oo o oooooo",
-"X.XX.XXXXXXXXXX..oooo.o.oooooo o",
-".................o.o oo.oooo o ",
-"oooooo ooo.oo oo.o . ooooooooo",
-"oooo o oo o oooooooooooooooo"};
+++ /dev/null
-/* XPM */
-static char * icon-get-new-news-this-group_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" .......... ",
-" .XXXXXXXX. ",
-" .XXXXXXXX. ",
-" .XXXXXXXX. .... ",
-" .XXXXXXXX. .oooo. ",
-" .XXXXXXX.... .oooooo. ",
-" .XXXXXXX.. . .oooooo. ",
-" .XXXXXXXX...o. .oooooo. ",
-" .XXXXXXXX..ooo. .oooo. ",
-" .XXXXXXXX. .ooo. .oo. ",
-" .XXXXXXXX. .ooo.....o.... ",
-" .XXXXXXXX. .oooooooooooo. ",
-" .......... .oooooooooooo. ",
-" .oooooooooooo. ",
-" .oooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" .ooooooo.oo. ",
-" ............ ",
-" .oooooo. . ",
-" .ooooooo.. . ",
-" .ooooooo. . ",
-" .oooo.oo... ",
-" .oooo.oooo. ",
-" .ooo. .ooo. ",
-" ..... ..... ",
-" .o. .o. ",
-" .o. .o. "};
+++ /dev/null
-/* XPM */
-static char * icon-get-new-news_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-".......... ",
-".XXXXXXXX. ",
-".XXXXXXXX. ",
-".XXXXXXXX. .... ",
-".XXXXXXXX. .oooo. ",
-".XXXXXXX.... .oooooo. ",
-".XXXXXXX.. . .oooooo. ",
-".XXXXXXXX...o. .oooooo. ",
-".XXXXXXXX..ooo. .oooo. ",
-".XXXXXXXX. .ooo. .oo. ",
-".XXXXXXXX. .ooo.....o.... ",
-".XXXXXXXX. .oooooooooooo. ",
-".......... .oooooooooooo. ",
-" .oooooooooooo. ",
-" .ooooooooooo. ",
-" .o.......oo.....",
-" .o.XXXXX.oo.XXX.",
-" .o.XXXX.ooo.XXX.",
-" .o.XXXX.oo.XXXX.",
-" .o.XXX.ooo.XXXX.",
-" .o.XXX.oo.XXXXX.",
-" ...XX...o.XXXXX.",
-" .oo.X. .XXXXXX.",
-" .oo.XX.. .XXXXXX.",
-" .oo.... ........",
-" .oooo.o..o. ",
-" .oooo.oooo. ",
-" .ooo. .ooo. ",
-" ..... ..... ",
-" .o. .o. ",
-" .o. .o. "};
+++ /dev/null
-/* XPM */
-static char * icon-killfile_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXXX.. ",
-" .XXXXXXXXXXXXXX.X. ",
-" .XXXXXXX...XXXX.XX. ",
-" .XXXXXX.....XXX..... ",
-" .XXXXX..X.X..XXXXXX. ",
-" .XXXXX.......XXXXXX. ",
-" .XXXXX...X...XXXXXX. ",
-" .XXXXXX.....XXXXXXX. ",
-" .XXXXXXX.X.XXXXXXXX. ",
-" .XXXXXXX.X.XXXXXXXX. ",
-" .XXXX.XX...X.XXXXXX. ",
-" .XXX..XXXXXX..XXXXX. ",
-" .XXXXX..XX..XXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX. ",
-" .XXXXX..XX..XXXXXXX. ",
-" .XXX..XXXXXX..XXXXX. ",
-" .XXXX.XXXXXX.XXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-unsubscribe_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXX.XXXXX.. ",
-" .XX.X.XXX.XXXXX.X. ",
-" .XXX.XXXX.XXXXX.XX. ",
-" .XX.X.XXX.XXXXX..... ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-subscribe_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXX.XXXXX.. ",
-" .XXXXXX.X.XXXXX.X. ",
-" .XXXXX.XX.XXXXX.XX. ",
-" .XX.X.XXX.XXXXX..... ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.X.XXXXXXXXX. ",
-" .XXXXX.XX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.X.XXXXXXXXX. ",
-" .XXXXX.XX.XXXXXXXXX. ",
-" .XX.X.XXX.XXXXXXXXX. ",
-" .XXX.XXXX.XXXXXXXXX. ",
-" ..........XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .XXXXXXXX.XXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-rot13_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXXX.. ",
-" .XX..XX...XXX...X. ",
-" .X.XX.X.XX.X.XX.XX. ",
-" .X.XX.X.X.XX.XX..... ",
-" .X....X.XX.X.XXXXXX. ",
-" .X.XX.X...XXX...XXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XX.XXXXX.XXXX.XXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .X..X.XX..XX...XXXX. ",
-" .X..X.X.XX.X.XX.XXX. ",
-" .X.X..X.XX.X...XXXX. ",
-" .X.X..X.XX.X.XXXXXX. ",
-" .X.XX.XX..XX.XXXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .XXXX..XXXXXXXXXXXX. ",
-" .XXX....XXXXXXXXXXX. ",
-" .XX..XX.........XXX. ",
-" .XX..XX.........XXX. ",
-" .XXX....XXX.X.X.XXX. ",
-" .XXXX..XXXX.X.X.XXX. ",
-" .XXXXXXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXXXXX. ",
-" .................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-cancel-post_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ... ... ... ... ....... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... .... ... ...",
-"............... XX ............",
-"............. XXXX ...........",
-"........... XXXX X ...........",
-" ... .... XXXXX X ... ... ...",
-"........ XXXXXXX XXX ..........",
-"........ XXXXXX oXXXX ..........",
-"........o XXXXXXXoXXXX .........",
-" ... ...oo XXXXXXXX . ... ...",
-".........oo XXXXX oooo.........",
-"..........oo o..............",
-"..........ooooooo...............",
-" ... ... ... oo. ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................"};
+++ /dev/null
-/* XPM */
-static char * icon-catchup_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ...... ",
-" .. .XXXX. ",
-" .X. .XXXX. ",
-" ..XX...XXXXX.... ",
-" ..XXXXX..XXXXX.XX... ",
-" ..XXXXX..XXXX.XXXX.. ",
-" .XXXX........XXXX. ",
-" ..XXX.XXXXX....... ",
-" ..XXX.XXXXX..XXX. ",
-" .X.XX.XXXXX.XXXX. ",
-" ...XX.XXXXX.XXXX. ",
-" ...X.XXXXX.X... ",
-" .X.........XX. ",
-" . .XX.XX.XX. ",
-"ooooooooo....XX.XX....oooooooooo",
-"oooooooooo. ....... .oooooooooo",
-"oooooooooo.X.XX.X .X.ooooooooooo",
-"oooooooooo. .X . . .ooooooooooo",
-"oooooooooo...........ooooooooooo",
-"oooooooooo...X..XX...ooooooooooo",
-"oooooooooo...X ..X...ooooooooooo",
-"oooooooooo..........oooooooooooo",
-"oooooooooooo.......ooooooooooooo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-/* XPM */
-static char * icon-catchup2_xpm[] = {
-"32 32 2 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................. .............",
-" ... ... ... ... . ... ... ...",
-"................ ..............",
-"............... ................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"............. .......... .....",
-" ... ... ... . ... ... . ...",
-"............ .......... ......",
-"........... ........... ........",
-"............ .......... .......",
-" ... ... ... . . ... ... ... ...",
-"............... ..... ",
-"................ ... ......",
-"........ ..... ... ...... .....",
-" ... .. .. . . . . .. . .",
-"....... .... .... ... .. . ... ",
-"...... ...... ... ..... ... ...",
-"...... .. .... ...... .. ..",
-" ... ... . ... .. .. ..",
-"........... .... . .... .",
-".......... ..... ..... .. .",
-".......... ..... ....... ... "};
+++ /dev/null
-/* XPM */
-static char * icon-exit-summary_xpm[] = {
-"32 32 2 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................",
-" ... ...... ... ...",
-"........ ....... .......",
-"........ ........... .......",
-"........ .......... .......",
-" ... ... ... ....... ... ...",
-"................ ... .......",
-".................... .......",
-"........ .......... .......",
-" ... ... ... ....... ... ...",
-"........ ....... . .......",
-"........ ....... . .......",
-"........ ....... . .......",
-" ... ... ... ....... ... ...",
-"........ .......... .......",
-"........ ........... .......",
-"................ ... .......",
-" ... ....... ....... ... ...",
-"........ .......... .......",
-"........ ........ . . .......",
-"........ .... . . . . ........",
-" ... .. .. . . . . ... ...",
-"................................",
-"................................",
-"................................",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................................",
-"................................"};
+++ /dev/null
-/* XPM */
-static char * icon-followup_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXXX. ",
-" .X..XX.XXXXXXXX. ",
-" ..XXXX..XXXXXXX. ",
-" . ..XXXX..X.XXXXXXXX. . ",
-" ..XXXXX...X.XXXXXXXX. ",
-" ..XXXXXXX..XXX.XXXXXXXX. ",
-" .XXXXXXXX.XXXXX.XXXXXXXX. ",
-" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX.XXXXXXX.. ",
-" .XXXXXXXXXXXXXXX.XXXX.. ",
-" .XXXXXXXXXXXXXXX.XX.. ",
-" . .XXXXXXXXXXXXXXX.. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-/* XPM */
-static char * icon-followup-w-orig_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ",
-" . . . . . . . . ",
-" ",
-" .. ",
-" ... ",
-" . . . . .. . . . ",
-" . ",
-" ",
-" ",
-" . . . . . . . . ",
-" .. ",
-" ..XX. ",
-" ..XXXX. ",
-" . ..XXX...X. . . . ",
-" ..XXX..XX..X. ",
-" ..XXX..XXX...X. ",
-" .XX..XXXXX...XX. ",
-" . ...XXXXXX.XX.XX. . . . ",
-" .XXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXX.XX. ",
-" . .XXXXXXXXXXXXX.XX. . . ",
-" .XXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXX.XX. ",
-" . .XXXXXXXXXXXXX.XX. . . ",
-" .XXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XX. "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-copy_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" .......................... ",
-" ...XXXXXXXXXXXXXXXXXXX..X. ",
-" .XX..XXXXXXXXXXXXXXX..XXX. ",
-" .XXXX..XXXXXXXXXXX..XXXXX. ",
-" .XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXXX.X...XX.XXXXXXXX. ",
-" .XXXXXX..XXXXXXXX..XXXXXX. ",
-" .XXXXX.XXXXXXXXXXXX.XXXXX. ",
-" .XX.......................... ",
-" .XX.X.XXXXXXXXXXXXXXXXXXX..X. ",
-" .X..XX..XXXXXXXXXXXXXXX..XXX. ",
-" ..X.XXXX..XXXXXXXXXXX..XXXXX. ",
-" ....XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXXX.X...X.XXXXXXXXX. ",
-" .XXXXXXX.XXXXXXX..XXXXXXX. ",
-" .XXXXX..XXXXXXXXXX.XXXXXX. ",
-" .XXXX.XXXXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXXXX.XX. ",
-" ..XXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-delete_xpm[] = {
-"32 32 4 1",
-" c #BEBEBEBEBEBE s backgroundToolBarColor",
-"X c #000000000000",
-"o c #E7E7E7E7E7E7",
-"O c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" XXXXX ",
-" XX XX ",
-" XX XX XXX ",
-" X X XXooXX X ",
-" XX XXX XXooXX XX ",
-" XX XXXXX XXXXX XOXXX ",
-" XXXXX XXXXXX XOOXOOXX",
-" XOX XOOOXOOOX",
-" XXXXX XXXXXX XOOOXOOOO",
-" XX XXXXX XXXXXX XOOXOOOO",
-" XX XXX XXXXXXXOOOXOOOO",
-" X X XOOOOOOXOOOOO",
-" XX XX XOOOOOOOXOOOOO",
-" XX XX XOOOOOOOXXOOOOO",
-" XXXXX XOOOOOXXXOOOOOOO",
-" XOOOXXXOOOOOOOOOO",
-" XOXXXOOOOOOOOOOOOX",
-" XXXOOOOOOOOOOOOOOX ",
-" XXOOOOOOOOOOOOOX ",
-" XXOOOOOOOOOOOX ",
-" XOOOOOOOOOX ",
-" XXOOOOOOX ",
-" XXOOOX ",
-" XXOX ",
-" X ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-forward_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ... ",
-" . . ",
-" . . . ",
-" . ... ",
-" ... ...XX. ",
-" . . . .XX.XXX. ",
-" . . . .XX.XXXX.. ",
-" . . . .XXX.XXXXX.. ",
-" . . . .XXX.XXXXXXX. ",
-" .. . ..XXXX.XXXXXXXX. ",
-" . . .XXXXXX.XXXXXXXXX. ",
-" . .XXXXXX.XXXXXXXXXX. ",
-" .XXXXXXX............. ",
-" .XXXXXXX.XXXXXXXXXXX. ",
-" .XXXXXXX..XXXXXXXXX.. ",
-" ..XXXXX....XXXXXXXXX. ",
-" .XXX.....XXXXXXXXXXX. ",
-" ....XXXX.XXXXXXXXXX. ",
-" ..XXXXXXX.XXXXXXXXX. ",
-" .XXXXXXX.XXXXXXXXX. ",
-" .XXXXXX.XXXXXXX.. ",
-" ..XXXXX.XXXXXX. ",
-" ..XXXX.XXXXX. ",
-" .XXXX.XXXX. ",
-" .XXX.XXX. ",
-" .X.XX.. ",
-" ..X. ",
-" ... ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-get_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ... ... ",
-" . . . . ",
-" . . . . ",
-" . . . . .. ",
-" . .. .. .. ",
-" .XXXXXXX. .XXXXXXX. ",
-" .XXXXX. .XXXXX. ",
-" ..XXX.. ..XXX.. ",
-" ... ... ",
-" ",
-" .......................... ",
-" ...XXXXXXXXXXXXXXXXXXX..X. ",
-" .XX..XXXXXXXXXXXXXXX..XXX. ",
-" .XXXX..XXXXXXXXXXX..XXXXX. ",
-" .XXXXXX..XXXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXX.XX...X.XXXXXXXXX. ",
-" .XXXXX..XXXXXXXX..XXXXXXX. ",
-" .XXXX.XXXXXXXXXXXX.XXXXXX. ",
-" .XXX.XXXXXXXXXXXXXX.XXXXX. ",
-" .X..XXXXXXXXXXXXXXXX..XXX. ",
-" ..XXXXXXXXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-originate_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ",
-" ............. ",
-" .XXXXXXXXXX.X. ",
-" .XXXXXXXXXX.XX. ",
-" .XXXXXXXXXX.... ",
-" ..................XXXXXXXX. ",
-" .X. X X X X X X .X..XXXXXX. ",
-" ..................XXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXX. ",
-" .XX.......XXXX. ",
-" ..............XXXXXXXXXXXXX. ",
-" ...XXXXXXXXXX.XX..X..X.XXXX. ",
-" .XX..XXXXXXXX.XXXXXXXXXXXXX. ",
-" .XXXX..XXXXXX.XXXXXXXXXXXXX. ",
-" .XXXXXX..XXXX.XXXXXXXXXXXXX. ",
-" .XXXXXXXX..XX.XXXXXXXXXXXXX. ",
-" .XXXXXXX.XX...XXXXXXXXXXXXX. ",
-" .XXXXX..XXXXX.XXXXXXX..X.XX. ",
-" .XXXX.XXXXXXX.XXXXXXXXXXXXX. ",
-" .XXX.XXXXXXXX.XXXXXXXXXXXXX. ",
-" .X..XXXXXXXXX.XXXXXXXXXXXXX. ",
-" ..XXXXXXXXXXX............... ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-mail-reply_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" ... ",
-" .XXX.. ",
-" .XXXXXX.. ",
-" ... .XXXXXXXX. ",
-" ..XXX.XX.XXXXXX. ",
-" ..XXXX.XXX.XXXXX. ",
-" ..XXXXXX.XX.XXXXX. ",
-" ..XXXXXXX.XX.XXXXXX. ",
-" .XXXXXXXX.XXX.XXXXX... ",
-" ..XX..XX.XX.XXXXXXXX.XXX.. ",
-" ...XXXXXXX.XX.XXXXX.XX..X. ",
-" .XX..XXXX.XXX.XXXXX...XXX. ",
-" .XXXX..XX.XX.XXXXX..XXXXX. ",
-" .XXXXXX...XXXXXX..XXXXXXX. ",
-" .XXXXXXXX..XXX..XXXXXXXXX. ",
-" .XXXXXXX.XX...X.XXXXXXXXX. ",
-" .XXXXX..XXXXXXXX..XXXXXXX. ",
-" .XXXX.XXXXXXXXXXXX.XXXXXX. ",
-" .XXX.XXXXXXXXXXXXXX.XXXXX. ",
-" .X..XXXXXXXXXXXXXXXX..XXX. ",
-" ..XXXXXXXXXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXXXXXXXXXXX... ",
-" .......................... ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-save-mail_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ........................ ",
-" ...XXXXXXXXXXXXXXXXXX... ",
-" .XX..XXXXXXXXXXXXXX..XX. ",
-" .XXXX..XXXXXXXXXX..XXXX. ",
-" .XXXXXX..XXXXXX..XXXXXX. ",
-" .XXXXXXX...XX..XXXXXXXX. ",
-" .XXXXX..XXX..XX..XXXXXX. ",
-" .XXXX.XXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXX..X. ",
-" ..................XXXXXXXXX.. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo............ ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo............oo. ",
-" .oooooooooooooooo. ",
-" .oooooooooooooooo. ",
-" .oo............oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-next-unread_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXXX. ",
-" .X..XX.XXXXXXXX. ",
-" ..XXXX..XXXXXXX. ",
-" . ..XXXX..X.XXXXXXXX. . ",
-" ..XXXXX...X.XXXXXXXX. ",
-" ..XXXXXXX..XXX.XXXXXXXX. ",
-" .XXXXXXXX.XXXXX.XXXXXXXX. ",
-" ..XXXXXXXXXXXXXX.XXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX.XXXXXXX.. ",
-" .XX.....XXXXXXX.....X.. ",
-" .X.ooooo.XXXXX.oooo.. ",
-" . .oXooooo.XXX.oXooooo.. . ",
-" .ooooooo.X.X.ooooooo. ",
-" .ooooooo..X..ooooooo. ",
-" ..oooooo.XXX.ooooooo. ",
-" . ..oooo.XXXXX.oooo.. . . ",
-" .....XXXXXXX..... ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-/* XPM */
-static char * icon-post_xpm[] = {
-"32 32 3 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXXX. . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . . .XXXXXXXXXXXXXXX. . ",
-" .XXXXXXXXXXXXXX.. ",
-" .XXXXXXXXXX... ",
-" .XXXXXXXXX. ",
-" . . . .XXXXXX.. . . ",
-" .XXX... ",
-" .... ",
-" ",
-" . . . . . . . . ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-prev-unread_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" . . . . . . . . ",
-" ",
-" ",
-" ... ",
-" . . . . ..XX. . . . ",
-" ..XXXX.. ",
-" ..XXXX..X. ",
-" ..XXXXX...X. ",
-" . . ..XXXXXXX..XXX. . . ",
-" ..XXXXXXXX.XXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . . .XXXXXXXXXXXXXX. . . ",
-" .XXXX...XXXXXX..... ",
-" ...o..XX.XXXXX.oooo.. ",
-" .oo..XXXX..XXX.oXooooo. ",
-" . .o..XXXX..X.X.X.ooooooo.. ",
-" ..XXXXX...X..X..ooooooo. ",
-" ..XXXXXXX..XX.XXX.ooooooo. ",
-" .XXXXXXXX.XXXXX.XXX.oooo.. ",
-" ..XXXXXXXXXXXXXX.XXXX..... . ",
-" .XXXXXXXXXXXXXXX.XXXX. ",
-" .XXXXXXXXXXXXXX.XX.. ",
-" .XXXXXXXXXXXXXXX.. ",
-" . .XXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. ",
-" . .XXXXXXXXXXXXXXXX. . . ",
-" .XXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXX. "};
+++ /dev/null
-/* XPM */
-static char * icon-follow-up_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ",
-" . ",
-" .X.. ",
-" ... .XXXX. ",
-" ..XXX.XXXXXX.. ",
-" ..XXXX.XXXXXXXXX. ",
-" ..XXXXX.XXXXXXXXX.. ",
-" ..XXXXXXX.XXXXXXXX.... ",
-" ..XXXXXXXX.XXXXXXXXX.oXX.. ",
-" .X..X.X.X..XXXXXXXXX..o...o. ",
-" ..XXXXXXX.XXXXXXXXX..ooXXX.. ",
-" .X...XXXX.XXXXXXXX..ooX...X. ",
-" .XXXX.XX.XXXXXXXX..oX..XXXX. ",
-" .XXXXX..XXXXXXXX..oX.XXXXXX. ",
-" .XXXXXXX..XXXXX..X..XXXXXXX. ",
-"oo.XXXXXXXXX.XXX....XXXXXXXXX.oo",
-"oo.XXXXXXXXX...X...XXXXXXXXXX.oo",
-"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo",
-"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo",
-"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo",
-"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo",
-"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo",
-"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo",
-"oo...XXXXXXXXXXXXXXXXXXXXX....oo",
-"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo",
-"oo............................oo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-/* XPM */
-static char * icon-follow-up-incl_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-" ",
-" ",
-" ",
-" ",
-" ... ",
-" .X.X. ",
-" .XX.XX.. ",
-" .XXX.XXXX. ",
-" ..XXX.XXXXXX.. ",
-" ..X.XXX.XXXXXXX.. ",
-" ..XX.XXXX.XXXXX.... ",
-" ..XXX.XXXXX.X....XX... ",
-" ..XXX..XXXX....XXXXX.oXX.. ",
-" .XXXX.XXXXXX.XXXXXXX..oXXXo. ",
-" ..XX.XXX.....XXXXXX..ooXXX.. ",
-" .X......XXX.XXXXXX..ooX...X. ",
-" .XXXX.XXXXX.XXXXX..oX..XXXX. ",
-" .XXXXX..XX.XXXXX..oX.XXXXXX. ",
-" .XXXXXXX...XXXX..X..XXXXXXX. ",
-"oo.XXXXXXXXX..XX....XXXXXXXXX.oo",
-"oo.XXXXXXXXX...X...XXXXXXXXXX.oo",
-"oo.XXXXXXXX.XX...XX.XXXXXXXXX.oo",
-"oo.XXXXXXX.XXXXXXXXX.XXXXXXXX.oo",
-"oo.XXXXXX.XXXXXXXXXXX.XXXXXXX.oo",
-"oo.XXXX..XXXXXXXXXXXXX..XXXXX.oo",
-"oo.XXX.XXXXXXXXXXXXXXXXX.XXXX.oo",
-"oo.XX.XXXXXXXXXXXXXXXXXXX.XXX.oo",
-"oo...XXXXXXXXXXXXXXXXXXXXX....oo",
-"oo..XXXXXXXXXXXXXXXXXXXXXXXX..oo",
-"oo............................oo",
-"oooooooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooooooo"};
+++ /dev/null
-/* XPM */
-static char * icon-save-text_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ................ ",
-" .XXXXXXXXXXXXX.X. ",
-" .XXXXXXXXXXXXX.XX. ",
-" .XXXXXXXXXXXXX.XXX. ",
-" .XXXXXXXXXXXXX..... ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" ..................XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXX. ",
-" .oo............oo.XXXXXXXX. ",
-" .oooooooooooooooo.XXXXXXXX. ",
-" .oooooooooooooooo.XXXXXXXX. ",
-" .oo............oo.......... ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-save-mail_xpm[] = {
-"32 32 6 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #FFFFFFFFFFFF",
-"o c #999999999999",
-"O c #E5E5E5E5E5E5",
-"+ c #666666666666",
-" ",
-" ",
-" ",
-" ........................ ",
-" ...XXXXXXXXXXXXXXXXXX... ",
-" .XX..XXXXXXXXXXXXXX..XX. ",
-" .XXXX..XXXXXXXXXX..XXXX. ",
-" .XXXXXX..XXXXXX..XXXXXX. ",
-" .XXXXXXX...XX..XXXXXXXX. ",
-" .XXXXX..XXX..XX..XXXXXX. ",
-" .XXXX.XXXXXXXXXXX.XXXXX. ",
-" .XXX.XXXXXXXXXXXXX..XXX. ",
-" .X..XXXXXXXXXXXXXXXX..X. ",
-" ..................XXXXXXXXX.. ",
-" .oo.OOOOOOOOOO.oo.XXXXXXXXXX. ",
-" .oo.OOOOOOOOOO.oo............ ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo.OOOOOOOOOO.oo. ",
-" .oo............oo. ",
-" .oooooooooooooooo. ",
-" .oooooooooooooooo. ",
-" .oo............oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .oo.+++++++.OO.oo. ",
-" .o.+++++++.OO.oo. ",
-" ................ ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-decode-view_xpm[] = {
-"32 32 4 1",
-" c #BFBFBFBFBFBF s backgroundToolBarColor",
-". c #000000000000",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ................... ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XX.............XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.oooo.oooooo.XX. ",
-" .XX.oo..o..o.oo.XX. ",
-" .XX.o.oo.oo.ooo.XX. ",
-" .XX.ooo.ooooooo.XX. ",
-" .XX.oo.oo.ooooo.XX. ",
-" .XX.oo....ooooo.XX. ",
-" .XX.oooooo.oooo.XX. ",
-" .XX.ooooooo.ooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.ooooooooooo.XX. ",
-" .XX.............XX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" .XXXXXXXXXXXXXXXXX. ",
-" ................... ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * icon-post-pic_xpm[] = {
-"32 32 4 1",
-" c #000000000000",
-". c #BFBFBFBFBFBF s backgroundToolBarColor",
-"X c #999999999999",
-"o c #FFFFFFFFFFFF",
-" ... ... ... ... ... ... ... ...",
-"................................",
-"................ ...............",
-".............. . .............",
-" ... ... ... .. .. ... ... ...",
-".......... ......... .........",
-"........ ............. .......",
-"....... ......",
-" ... .. XXXXXXXXXXXXXXXXX .. ...",
-"....... XXXXXXXXXXXXXXXXX ......",
-"....... XX XX ......",
-"....... XX ooooooooooo XX ......",
-" ... .. XX ooooooooooo XX .. ...",
-"....... XX ooooooooooo XX ......",
-"....... XX oooo oooooo XX ......",
-"....... XX oo o o oo XX ......",
-" ... .. XX o oo oo ooo XX .. ...",
-"....... XX ooo ooooooo XX ......",
-"....... XX oo oo ooooo XX ......",
-"....... XX oo ooooo XX ......",
-" ... .. XX oooooo oooo XX .. ...",
-"....... XX ooooooo ooo XX ......",
-"....... XX ooooooooooo XX ......",
-"....... XX ooooooooooo XX ......",
-" ... .. XX ooooooooooo XX .. ...",
-"....... XX ooooooooooo XX ......",
-"....... XX XX ......",
-"....... XXXXXXXXXXXXXXXXX ......",
-" ... .. XXXXXXXXXXXXXXXXX .. ...",
-"....... ......",
-"................................",
-"................................"};
+++ /dev/null
-/* XPM */
-static char *gnus[] = {
-/* width height num_colors chars_per_pixel */
-" 271 273 3 1",
-/* colors */
-". s thing c #bf9900",
-"# s shadow c #ffcc00",
-"a c None",
-/* pixels */
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............#######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........................#######aaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................######aaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................######aaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................#######aaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................aaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................#######aaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................aaaaaaaaaaaaaaaa....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................########aaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......................aaaaaaaaaaaaaa........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#######aaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................aaaaaaaaaaa............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................########aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................aaaaaaaaa..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................aaaaaaa................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............................aaaaa..................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......######.......................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................aaaa...................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#######aa....................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................aa.....................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaa.................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................a......................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaa................#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaa...............#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaa...............#######aaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaa..............#######aaaaa",
-"aaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaa..............#######aaaaa",
-"aaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa.............#######aaaaa",
-"aaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............####....................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa............########aaaaa",
-"aaaaaaa.........aaaaaaaaaaaaaaaaaaaaaaaaaaa.............########...................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaa...........aaaaaaaaaaaaaaaaaaaaaaa.............############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaaa..........aaaaaaaaaaaaaaaaaaaaaa.............##############..................................................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa...........########aaaaa",
-"aaaaaaaa...........aaaaaaaaaaaaaaaaaaaa............##################.......................##########................................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa..........########aaaaa",
-"aaaaaaaa............aaaaaaaaaaaaaaaaaa............####################....................###############..............................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaa............aaaaaaaaaaaaaaaa..............#####################.................#####################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa###aaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaa.............aaaaaaaaaaaaaa..............#######################...............#######################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa..aaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaaa.............aaaaaaaaaaa...............##########aa#############.............#########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaa..........#######aaaaaa",
-"aaaaaaaaa.............aaaaaaaaa................#########aaaaaaa###########............##########################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa................aaaa..................#######aaaaaaaaaa###########..........############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa.....................................######aaaaaaaaaaaaa###########.........#############################..........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaa....................................######aaaaaaaaaaaaaaaa#########........###############################.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........########aaaaaa",
-"aaaaaaaaaa.................................#######aaaaaaaaaaaaaaaaaa#########.......#######aaaaaaaaaaa##############..........................aaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaaa................................#######aaaaaaaaaaaaaaaaaaaa########......#####aaaaaaaaaaaaaaaaa############..........................aaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaaa...............................########aaaaaaaaaaaaaaaaaaaaa########....#####aaaaaaaaaaaaaaaaaaaaa##########..........................aaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaa#..............................########aaaaaaaaaaaaaaaaaaaaaaaa#.####...#####aaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#######aaaaaaa",
-"aaaaaaaaa#.............................########aaaaaaaaaaaaaaaaaaaaaaaaa...###..######aaaaaaaaaaaaaaaaaaaaaaaa##########...........................aaaaaaaaaaaaaaaaaaa......a#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###...........................#########aaaaaaaaaaaaaaaaaaaaaaaa....##########aaaaaaaaaaaaaaaaaaaaaaaaaa##########............................aaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###..........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....#########aaaaaaaaaaaaaaaaaaaaaaaaaaaa##########...............................aaaaaaaa...........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........########aaaaaaa",
-"aaaaaaaa###.........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....a#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa##########................................................##aaaaaa...aaaaaaaaaaaaaaaaaaaaa......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaaa####........................#########aaaaaaaaaaaaaaaaaaaaaaaaa....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................................##aaaaaa....aaaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaaa####.......................########aaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..............................................##aaaaa.....aaaaaaaaaaaaaaaaaa.......a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa######....................#########aaaaaaaaaaaaaaaaaaaaaaaaaa.....a#aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########............................................##aaaaaa......aaaaaaaaaaaaaaa.........a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa######...................#########aaaaaaaaaaaaaaaaaaaaaaaaaa......##aaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................................##aaaaa.......aaaaaaaaaaaaa..........aa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaa",
-"aaaaaa#######.................#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a###aaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................................###aaaaa.........aaaaaaa..............a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaa",
-"aaaaaaa#######...............#########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########........................................##aaaaa...............................a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaa########............##########aaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.......................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaaa##########.......###########aaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.....................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#######aaaaaaaaa",
-"aaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########....................................##aaaaa...............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........########aaaaaaaaa",
-"aaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########..................................###aaaaa..............................#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaa#######################aaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...............................####aaaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.............................#####aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaa",
-"aaaaaaaaaaa###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########...........................######aaaa..............................######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......########aaaaaaaaaa",
-"aaaaaaaaaaaa#################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########.........................######aaaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
-"aaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaa#########.......................#######aaaa.............................#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aaaaaaaaaaaaaaaa#########....................#########aaaa............................########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaaaaaaaaaaaa#########..................#########aaaaa..........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........aaaaaaaaaaaaaaa###########.............###########aaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............aaaaaaaaaaaaaaa##############....###############aaaaaaa.......................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............aaaaaaaaaaaaaaa##############################aaaaaaaaa.....................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaaaaaaaaaaaa############################aaaaaaaaaaa...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaa................aaaaaaaaaaaaaaaa##########################aaaaaaaaaaaa#................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaa.................aaaaaaaaaaaaaaaa########################aaaaaaaaaaaaa##..............#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa...................aaaaaaaaaaaaaaaa######################aaaaaaaaaaaaa#####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaa....................aaaaaaaaaaaaaaaaa###################aaaaaaaaaaaaaaa########..##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaaaaa....................aaaaaaaaaaaaaaaaaaa################aaaaaaaaaaaaaaaa###########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa......................aaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaa##########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa.......aaaaaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a###a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaaaa........a####a.........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#####aaaaaaaaaaaaaaaaaaaaaaaaaaa........a#####aaa.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....a####aaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaa#.....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaa##....................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaa..........######aaaaa#####..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........#####aaaaaa#######..................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa#########.................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaaa...........######aaaaa###########................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaa##########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaa#########...............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....####aaaaaaaaaaaaaaaaaaaaaa............#######aaaaaaaaaaaa########..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaaaa............#########aaaaaaaaaaaaa#######..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......###aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaa#######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaaa.............#########aaaaaaaaaaaaaaaaa######.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaa..............#########aaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaa#####.............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........aaaaaaaaaaaaa...............#########aaaaaaaaaaaaaaaaaaaaaa#####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...............aaaaa..................########aaaaaaaaaaaaaaaaaaaaaaaaa####............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................................########aaaaaaaaaaaaaaaaaaaaaaaaaa####...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....................................########aaaaaaaaaaaaaaaaaaaaaaaaaaaa###...........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaa####..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa................................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa............................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...........................#########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........................##########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......................###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...................############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#........#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##................#############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.......##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###............##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####.........###############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#......###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######..###################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa########################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#.....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##################aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#....###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##############aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###########aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....a#aaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaa#######aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#aaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaa#######aa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#aaaaaaaaaaaaaaaaaaaaa#####aaaaaaaaa########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#aaaaaaaaaaaaaaaaaaaa#######aaaaaaa#########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......##aaaaaaaaaaaaaaaaaaa########a..aa##########a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........##aaaaaaaaaaaaaaaaaa#########....##########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#aaaaaaaaaaaaaaaaaa#########......#########........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#aaaaaaaaaaaaaaaaaa#########......########a........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa#########.......#######.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........##aaaaaaaaaaaaaaaaa########.........#####.........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaa########........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........###aaaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........###aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........####aaaaaaaaaaaaaaa#########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa#########......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......a######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######........................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa########.......................aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......a#######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######.........a..............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaa#######a........aaa............aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....aa######aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######........aaaaa..........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaa#######a.......aaaaaaa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....aaa#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa######a........aaaaaaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######........aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaa#######a......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaa#######.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaa#######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaa######aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaa######a.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaa#####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaa####aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaa####aa.......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaa###aaa......aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaa####aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaa###aaa.....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaa####aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaa###aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaa###aaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaa....aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa........#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa......#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa....#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa...#####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa..a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.a####aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa.aa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa###aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa##aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa#aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaaa"
-};
+++ /dev/null
-@c \input texinfo @c -*-texinfo-*-
-@c Uncomment 1st line before texing this file alone.
-@c %**start of header
-@c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005, 2006, 2007,
-@c 2008 Free Software Foundation, Inc.
-@c
-@c Do not modify this file, it was generated from gnus-faq.xml, available from
-@c <URL:http://my.gnus.org/FAQ/>.
-@c
-@setfilename gnus-faq.info
-@settitle Frequently Asked Questions
-@c %**end of header
-@c
-
-@node Frequently Asked Questions
-@section Frequently Asked Questions
-
-@menu
-* FAQ - Changes::
-* FAQ - Introduction:: About Gnus and this FAQ.
-* FAQ 1 - Installation FAQ:: Installation of Gnus.
-* FAQ 2 - Startup / Group buffer:: Start up questions and the
- first buffer Gnus shows you.
-* FAQ 3 - Getting Messages:: Making Gnus read your mail
- and news.
-* FAQ 4 - Reading messages:: How to efficiently read
- messages.
-* FAQ 5 - Composing messages:: Composing mails or Usenet
- postings.
-* FAQ 6 - Old messages:: Importing, archiving,
- searching and deleting messages.
-* FAQ 7 - Gnus in a dial-up environment:: Reading mail and news while
- offline.
-* FAQ 8 - Getting help:: When this FAQ isn't enough.
-* FAQ 9 - Tuning Gnus:: How to make Gnus faster.
-* FAQ - Glossary:: Terms used in the FAQ
- explained.
-@end menu
-
-@subheading Abstract
-
-This is the new Gnus Frequently Asked Questions list.
-If you have a Web browser, the official hypertext version is at
-@uref{http://my.gnus.org/FAQ/},
-the Docbook source is available from
-@uref{http://sourceforge.net/projects/gnus/, http://sourceforge.net}.
-
-Please submit features and suggestions to the
-@email{faq-discuss@@my.gnus.org, FAQ discussion list}.
-The list is protected against junk mail with
-@uref{http://smarden.org/qconfirm/index.html, qconfirm}. As
-a subscriber, your submissions will automatically pass. You can
-also subscribe to the list by sending a blank email to
-@email{faq-discuss-subscribe@@my.gnus.org, faq-discuss-subscribe@@my.gnus.org}
-and @uref{http://mail1.kens.com/cgi-bin/ezmlm-browse?command=monthbythread%26list=faq-discuss, browse
-the archive (BROKEN)}.
-
-@node FAQ - Changes
-@subheading Changes
-
-
-
-@itemize @bullet
-
-@item
-Updated FAQ to reflect release of Gnus 5.10 and start of
-No Gnus development.
-@end itemize
-
-@node FAQ - Introduction
-@subheading Introduction
-
-This is the Gnus Frequently Asked Questions list.
-
-Gnus is a Usenet Newsreader and Electronic Mail User Agent implemented
-as a part of Emacs. It's been around in some form for almost a decade
-now, and has been distributed as a standard part of Emacs for much of
-that time. Gnus 5 is the latest (and greatest) incarnation. The
-original version was called GNUS, and was written by Masanobu UMEDA.
-When autumn crept up in '94, Lars Magne Ingebrigtsen grew bored and
-decided to rewrite Gnus.
-
-Its biggest strength is the fact that it is extremely
-customizable. It is somewhat intimidating at first glance, but
-most of the complexity can be ignored until you're ready to take
-advantage of it. If you receive a reasonable volume of e-mail
-(you're on various mailing lists), or you would like to read
-high-volume mailing lists but cannot keep up with them, or read
-high volume newsgroups or are just bored, then Gnus is what you
-want.
-
-This FAQ was maintained by Justin Sheehy until March 2002. He
-would like to thank Steve Baur and Per Abrahamsen for doing a wonderful
-job with this FAQ before him. We would like to do the same - thanks,
-Justin!
-
-If you have a Web browser, the official hypertext version is at:
-@uref{http://my.gnus.org/FAQ/}.
-This version is much nicer than the unofficial hypertext
-versions that are archived at Utrecht, Oxford, Smart Pages, Ohio
-State, and other FAQ archives. See the resources question below
-if you want information on obtaining it in another format.
-
-The information contained here was compiled with the assistance
-of the Gnus development mailing list, and any errors or
-misprints are the my.gnus.org team's fault, sorry.
-
-@node FAQ 1 - Installation FAQ
-@subsection Installation FAQ
-
-@menu
-* [1.1]:: What is the latest version of Gnus?
-* [1.2]:: What's new in 5.10?
-* [1.3]:: Where and how to get Gnus?
-* [1.4]:: What to do with the tarball now?
-* [1.5]:: I sometimes read references to No Gnus and Oort Gnus, what
- are those?
-* [1.6]:: Which version of Emacs do I need?
-* [1.7]:: How do I run Gnus on both Emacs and XEmacs?
-@end menu
-
-@node [1.1]
-@subsubheading Question 1.1
-
-What is the latest version of Gnus?
-
-@subsubheading Answer
-
-Jingle please: Gnus 5.10 is released, get it while it's
-hot! As well as the step in version number is rather
-small, Gnus 5.10 has tons of new features which you
-shouldn't miss. The current release (5.10.10) should be at
-least as stable as the latest release of the 5.8 series.
-
-@node [1.2]
-@subsubheading Question 1.2
-
-What's new in 5.10?
-
-@subsubheading Answer
-
-First of all, you should have a look into the file
-GNUS-NEWS in the toplevel directory of the Gnus tarball,
-there the most important changes are listed. Here's a
-short list of the changes I find especially
-important/interesting:
-
-@itemize @bullet
-
-@item
-Major rewrite of the Gnus agent, Gnus agent is now
-active by default.
-
-@item
-Many new article washing functions for dealing with
-ugly formatted articles.
-
-@item
-Anti Spam features.
-
-@item
-Message-utils now included in Gnus.
-
-@item
-New format specifiers for summary lines, e.g. %B for
-a complex trn-style thread tree.
-@end itemize
-
-@node [1.3]
-@subsubheading Question 1.3
-
-Where and how to get Gnus?
-
-@subsubheading Answer
-
-Gnus is released independent from releases of Emacs and XEmacs.
-Therefore, the version bundled with Emacs or the version in XEmacs'
-package system might not be up to date (e.g. Gnus 5.9 bundled with Emacs
-20 is outdated).
-@c
-You can get the latest released version of Gnus from
-@uref{http://www.gnus.org/dist/gnus.tar.gz} or via anonymous FTP from
-@uref{ftp://ftp.gnus.org/pub/gnus/gnus.tar.gz}.
-
-@node [1.4]
-@subsubheading Question 1.4
-
-What to do with the tarball now?
-
-@subsubheading Answer
-
-Untar it via @samp{tar xvzf gnus.tar.gz} and do the common
-@samp{./configure; make; make install} circle.
-(under MS-Windows either get the Cygwin environment from
-@uref{http://www.cygwin.com}
-which allows you to do what's described above or unpack the
-tarball with some packer (e.g. Winace from
-@uref{http://www.winace.com})
-and use the batch-file make.bat included in the tarball to install
-Gnus.) If you don't want to (or aren't allowed to) install Gnus
-system-wide, you can install it in your home directory and add the
-following lines to your ~/.xemacs/init.el or ~/.emacs:
-
-@example
-(add-to-list 'load-path "/path/to/gnus/lisp")
-(if (featurep 'xemacs)
- (add-to-list 'Info-directory-list "/path/to/gnus/texi/")
- (add-to-list 'Info-default-directory-list "/path/to/gnus/texi/"))
-@end example
-@noindent
-
-Make sure that you don't have any Gnus related stuff
-before this line, on MS Windows use something like
-"C:/path/to/lisp" (yes, "/").
-
-@node [1.5]
-@subsubheading Question 1.5
-
-I sometimes read references to No Gnus and Oort Gnus,
-what are those?
-
-@subsubheading Answer
-
-Oort Gnus was the name of the development version of
-Gnus, which became Gnus 5.10 in autumn 2003. No Gnus is
-the name of the current development version which will
-once become Gnus 5.12 or Gnus 6. (If you're wondering why
-not 5.11, the odd version numbers are normally used for
-the Gnus versions bundled with Emacs)
-
-@node [1.6]
-@subsubheading Question 1.6
-
-Which version of Emacs do I need?
-
-@subsubheading Answer
-
-Gnus 5.10 requires an Emacs version that is greater than or equal
-to Emacs 20.7 or XEmacs 21.1.
-The development versions of Gnus (aka No Gnus) requires Emacs 21
-or XEmacs 21.4.
-
-@node [1.7]
-@subsubheading Question 1.7
-
-How do I run Gnus on both Emacs and XEmacs?
-
-@subsubheading Answer
-
-You can't use the same copy of Gnus in both as the Lisp
-files are byte-compiled to a format which is different
-depending on which Emacs did the compilation. Get one copy
-of Gnus for Emacs and one for XEmacs.
-
-@node FAQ 2 - Startup / Group buffer
-@subsection Startup / Group buffer
-
-@menu
-* [2.1]:: Every time I start Gnus I get a message "Gnus auto-save
- file exists. Do you want to read it?", what does this mean and
- how to prevent it?
-* [2.2]:: Gnus doesn't remember which groups I'm subscribed to,
- what's this?
-* [2.3]:: How to change the format of the lines in Group buffer?
-* [2.4]:: My group buffer becomes a bit crowded, is there a way to
- sort my groups into categories so I can easier browse through
- them?
-* [2.5]:: How to manually sort the groups in Group buffer? How to
- sort the groups in a topic?
-@end menu
-
-@node [2.1]
-@subsubheading Question 2.1
-
-Every time I start Gnus I get a message "Gnus auto-save
-file exists. Do you want to read it?", what does this mean
-and how to prevent it?
-
-@subsubheading Answer
-
-This message means that the last time you used Gnus, it
-wasn't properly exited and therefor couldn't write its
-informations to disk (e.g. which messages you read), you
-are now asked if you want to restore those informations
-from the auto-save file.
-
-To prevent this message make sure you exit Gnus
-via @samp{q} in group buffer instead of
-just killing Emacs.
-
-@node [2.2]
-@subsubheading Question 2.2
-
-Gnus doesn't remember which groups I'm subscribed to,
-what's this?
-
-@subsubheading Answer
-
-You get the message described in the q/a pair above while
-starting Gnus, right? It's an other symptom for the same
-problem, so read the answer above.
-
-@node [2.3]
-@subsubheading Question 2.3
-
-How to change the format of the lines in Group buffer?
-
-@subsubheading Answer
-
-You've got to tweak the value of the variable
-gnus-group-line-format. See the manual node "Group Line
-Specification" for information on how to do this. An
-example for this (guess from whose .gnus :-)):
-
-@example
-(setq gnus-group-line-format "%P%M%S[%5t]%5y : %(%g%)\n")
-@end example
-@noindent
-
-@node [2.4]
-@subsubheading Question 2.4
-
-My group buffer becomes a bit crowded, is there a way to
-sort my groups into categories so I can easier browse
-through them?
-
-@subsubheading Answer
-
-Gnus offers the topic mode, it allows you to sort your
-groups in, well, topics, e.g. all groups dealing with
-Linux under the topic linux, all dealing with music under
-the topic music and all dealing with scottish music under
-the topic scottish which is a subtopic of music.
-
-To enter topic mode, just hit t while in Group buffer. Now
-you can use @samp{T n} to create a topic
-at point and @samp{T m} to move a group to
-a specific topic. For more commands see the manual or the
-menu. You might want to include the %P specifier at the
-beginning of your gnus-group-line-format variable to have
-the groups nicely indented.
-
-@node [2.5]
-@subsubheading Question 2.5
-
-How to manually sort the groups in Group buffer? How to
-sort the groups in a topic?
-
-@subsubheading Answer
-
-Move point over the group you want to move and
-hit @samp{C-k}, now move point to the
-place where you want the group to be and
-hit @samp{C-y}.
-
-@node FAQ 3 - Getting Messages
-@subsection Getting Messages
-
-@menu
-* [3.1]:: I just installed Gnus, started it via @samp{M-x gnus}
- but it only says "nntp (news) open error", what to do?
-* [3.2]:: I'm working under Windows and have no idea what ~/.gnus.el
- means.
-* [3.3]:: My news server requires authentication, how to store user
- name and password on disk?
-* [3.4]:: Gnus seems to start up OK, but I can't find out how to
- subscribe to a group.
-* [3.5]:: Gnus doesn't show all groups / Gnus says I'm not allowed
- to post on this server as well as I am, what's that?
-* [3.6]:: I want Gnus to fetch news from several servers, is this
- possible?
-* [3.7]:: And how about local spool files?
-* [3.8]:: OK, reading news works now, but I want to be able to read
- my mail with Gnus, too. How to do it?
-* [3.9]:: And what about IMAP?
-* [3.10]:: At the office we use one of those MS Exchange servers, can
- I use Gnus to read my mail from it?
-* [3.11]:: Can I tell Gnus not to delete the mails on the server it
- retrieves via POP3?
-@end menu
-
-@node [3.1]
-@subsubheading Question 3.1
-
-I just installed Gnus, started it via
-@samp{M-x gnus}
-but it only says "nntp (news) open error", what to do?
-
-@subsubheading Answer
-
-You've got to tell Gnus where to fetch the news from. Read
-the documentation for information on how to do this. As a
-first start, put those lines in ~/.gnus.el:
-
-@example
-(setq gnus-select-method '(nntp "news.yourprovider.net"))
-(setq user-mail-address "you@@yourprovider.net")
-(setq user-full-name "Your Name")
-@end example
-@noindent
-
-@node [3.2]
-@subsubheading Question 3.2
-
-I'm working under Windows and have no idea what ~/.gnus.el means.
-
-@subsubheading Answer
-
-The ~/ means the home directory where Gnus and Emacs look
-for the configuration files. However, you don't really
-need to know what this means, it suffices that Emacs knows
-what it means :-) You can type
-@samp{C-x C-f ~/.gnus.el RET }
-(yes, with the forward slash, even on Windows), and
-Emacs will open the right file for you. (It will most
-likely be new, and thus empty.)
-However, I'd discourage you from doing so, since the
-directory Emacs chooses will most certainly not be what
-you want, so let's do it the correct way.
-The first thing you've got to do is to
-create a suitable directory (no blanks in directory name
-please) e.g. c:\myhome. Then you must set the environment
-variable HOME to this directory. To do this under Win9x
-or Me include the line
-
-@example
-SET HOME=C:\myhome
-@end example
-@noindent
-
-in your autoexec.bat and reboot. Under NT, 2000 and XP, hit
-Winkey+Pause/Break to enter system options (if it doesn't work, go to
-Control Panel -> System -> Advanced). There you'll find the possibility
-to set environment variables. Create a new one with name HOME and value
-C:\myhome. Rebooting is not necessary.
-
-Now to create ~/.gnus.el, say
-@samp{C-x C-f ~/.gnus.el RET C-x C-s}.
-in Emacs.
-
-@node [3.3]
-@subsubheading Question 3.3
-
-My news server requires authentication, how to store
-user name and password on disk?
-
-@subsubheading Answer
-
-Create a file ~/.authinfo which includes for each server a line like this
-
-@example
-machine news.yourprovider.net login YourUserName password YourPassword
-@end example
-@noindent
-.
-Make sure that the file isn't readable to others if you
-work on a OS which is capable of doing so. (Under Unix
-say
-@example
-chmod 600 ~/.authinfo
-@end example
-@noindent
-
-in a shell.)
-
-@node [3.4]
-@subsubheading Question 3.4
-
-Gnus seems to start up OK, but I can't find out how to
-subscribe to a group.
-
-@subsubheading Answer
-
-If you know the name of the group say @samp{U
-name.of.group RET} in group buffer (use the
-tab-completion Luke). Otherwise hit ^ in group buffer,
-this brings you to the server buffer. Now place point (the
-cursor) over the server which carries the group you want,
-hit @samp{RET}, move point to the group
-you want to subscribe to and say @samp{u}
-to subscribe to it.
-
-@node [3.5]
-@subsubheading Question 3.5
-
-Gnus doesn't show all groups / Gnus says I'm not allowed to
-post on this server as well as I am, what's that?
-
-@subsubheading Answer
-
-Some providers allow restricted anonymous access and full
-access only after authorization. To make Gnus send authinfo
-to those servers append
-
-@example
-force yes
-@end example
-@noindent
-
-to the line for those servers in ~/.authinfo.
-
-@node [3.6]
-@subsubheading Question 3.6
-
-I want Gnus to fetch news from several servers, is this possible?
-
-@subsubheading Answer
-
-Of course. You can specify more sources for articles in the
-variable gnus-secondary-select-methods. Add something like
-this in ~/.gnus.el:
-
-@example
-(add-to-list 'gnus-secondary-select-methods
- '(nntp "news.yourSecondProvider.net"))
-(add-to-list 'gnus-secondary-select-methods
- '(nntp "news.yourThirdProvider.net"))
-@end example
-@noindent
-
-@node [3.7]
-@subsubheading Question 3.7
-
-And how about local spool files?
-
-@subsubheading Answer
-
-No problem, this is just one more select method called
-nnspool, so you want this:
-
-@example
-(add-to-list 'gnus-secondary-select-methods '(nnspool ""))
-@end example
-@noindent
-
-Or this if you don't want an NNTP Server as primary news source:
-
-@example
-(setq gnus-select-method '(nnspool ""))
-@end example
-@noindent
-
-Gnus will look for the spool file in /usr/spool/news, if you
-want something different, change the line above to something like this:
-
-@example
-(add-to-list 'gnus-secondary-select-methods
- '(nnspool ""
- (nnspool-directory "/usr/local/myspoolddir")))
-@end example
-@noindent
-
-This sets the spool directory for this server only.
-You might have to specify more stuff like the program used
-to post articles, see the Gnus manual on how to do this.
-
-@node [3.8]
-@subsubheading Question 3.8
-
-OK, reading news works now, but I want to be able to read my mail
-with Gnus, too. How to do it?
-
-@subsubheading Answer
-
-That's a bit harder since there are many possible sources
-for mail, many possible ways for storing mail and many
-different ways for sending mail. The most common cases are
-these: 1: You want to read your mail from a pop3 server and
-send them directly to a SMTP Server 2: Some program like
-fetchmail retrieves your mail and stores it on disk from
-where Gnus shall read it. Outgoing mail is sent by
-Sendmail, Postfix or some other MTA. Sometimes, you even
-need a combination of the above cases.
-
-However, the first thing to do is to tell Gnus in which way
-it should store the mail, in Gnus terminology which back end
-to use. Gnus supports many different back ends, the most
-commonly used one is nnml. It stores every mail in one file
-and is therefor quite fast. However you might prefer a one
-file per group approach if your file system has problems with
-many small files, the nnfolder back end is then probably the
-choice for you. To use nnml add the following to ~/.gnus.el:
-
-@example
-(add-to-list 'gnus-secondary-select-methods '(nnml ""))
-@end example
-@noindent
-
-As you might have guessed, if you want nnfolder, it's
-
-@example
-(add-to-list 'gnus-secondary-select-methods '(nnfolder ""))
-@end example
-@noindent
-
-Now we need to tell Gnus, where to get it's mail from. If
-it's a POP3 server, then you need something like this:
-
-@example
-(eval-after-load "mail-source"
- '(add-to-list 'mail-sources '(pop :server "pop.YourProvider.net"
- :user "yourUserName"
- :password "yourPassword")))
-@end example
-@noindent
-
-Make sure ~/.gnus.el isn't readable to others if you store
-your password there. If you want to read your mail from a
-traditional spool file on your local machine, it's
-
-@example
-(eval-after-load "mail-source"
- '(add-to-list 'mail-sources '(file :path "/path/to/spool/file"))
-@end example
-@noindent
-
-If it's a Maildir, with one file per message as used by
-postfix, Qmail and (optionally) fetchmail it's
-
-@example
-(eval-after-load "mail-source"
- '(add-to-list 'mail-sources '(maildir :path "/path/to/Maildir/"
- :subdirs ("cur" "new")))
-@end example
-@noindent
-
-And finally if you want to read your mail from several files
-in one directory, for example because procmail already split your
-mail, it's
-
-@example
-(eval-after-load "mail-source"
- '(add-to-list 'mail-sources
- '(directory :path "/path/to/procmail-dir/"
- :suffix ".prcml")))
-@end example
-@noindent
-
-Where :suffix ".prcml" tells Gnus only to use files with the
-suffix .prcml.
-
-OK, now you only need to tell Gnus how to send mail. If you
-want to send mail via sendmail (or whichever MTA is playing
-the role of sendmail on your system), you don't need to do
-anything. However, if you want to send your mail to an
-SMTP Server you need the following in your ~/.gnus.el
-
-@example
-(setq send-mail-function 'smtpmail-send-it)
-(setq message-send-mail-function 'smtpmail-send-it)
-(setq smtpmail-default-smtp-server "smtp.yourProvider.net")
-@end example
-@noindent
-
-@node [3.9]
-@subsubheading Question 3.9
-
-And what about IMAP?
-
-@subsubheading Answer
-
-There are two ways of using IMAP with Gnus. The first one is
-to use IMAP like POP3, that means Gnus fetches the mail from
-the IMAP server and stores it on disk. If you want to do
-this (you don't really want to do this) add the following to
-~/.gnus.el
-
-@example
-(add-to-list 'mail-sources '(imap :server "mail.mycorp.com"
- :user "username"
- :pass "password"
- :stream network
- :authentication login
- :mailbox "INBOX"
- :fetchflag "\\Seen"))
-@end example
-@noindent
-
-You might have to tweak the values for stream and/or
-authentication, see the Gnus manual node "Mail Source
-Specifiers" for possible values.
-
-If you want to use IMAP the way it's intended, you've got to
-follow a different approach. You've got to add the nnimap
-back end to your select method and give the information
-about the server there.
-
-@example
-(add-to-list 'gnus-secondary-select-methods
- '(nnimap "Give the baby a name"
- (nnimap-address "imap.yourProvider.net")
- (nnimap-port 143)
- (nnimap-list-pattern "archive.*")))
-@end example
-@noindent
-
-Again, you might have to specify how to authenticate to the
-server if Gnus can't guess the correct way, see the Manual
-Node "IMAP" for detailed information.
-
-@node [3.10]
-@subsubheading Question 3.10
-
-At the office we use one of those MS Exchange servers, can I use
-Gnus to read my mail from it?
-
-@subsubheading Answer
-
-Offer your administrator a pair of new running shoes for
-activating IMAP on the server and follow the instructions
-above.
-
-@node [3.11]
-@subsubheading Question 3.11
-
-Can I tell Gnus not to delete the mails on the server it
-retrieves via POP3?
-
-@subsubheading Answer
-
-First of all, that's not the way POP3 is intended to work,
-if you have the possibility, you should use the IMAP
-Protocol if you want your messages to stay on the
-server. Nevertheless there might be situations where you
-need the feature, but sadly Gnus itself has no predefined
-functionality to do so.
-
-However this is Gnus county so there are possibilities to
-achieve what you want. The easiest way is to get an external
-program which retrieves copies of the mail and stores them
-on disk, so Gnus can read it from there. On Unix systems you
-could use e.g. fetchmail for this, on MS Windows you can use
-Hamster, an excellent local news and mail server.
-
-The other solution would be, to replace the method Gnus
-uses to get mail from POP3 servers by one which is capable
-of leaving the mail on the server. If you use XEmacs, get
-the package mail-lib, it includes an enhanced pop3.el,
-look in the file, there's documentation on how to tell
-Gnus to use it and not to delete the retrieved mail. For
-GNU Emacs look for the file epop3.el which can do the same
-(If you know the home of this file, please send me an
-e-mail). You can also tell Gnus to use an external program
-(e.g. fetchmail) to fetch your mail, see the info node
-"Mail Source Specifiers" in the Gnus manual on how to do
-it.
-
-@node FAQ 4 - Reading messages
-@subsection Reading messages
-
-@menu
-* [4.1]:: When I enter a group, all read messages are gone. How to
- view them again?
-* [4.2]:: How to tell Gnus to show an important message every time I
- enter a group, even when it's read?
-* [4.3]:: How to view the headers of a message?
-* [4.4]:: How to view the raw unformatted message?
-* [4.5]:: How can I change the headers Gnus displays by default at
- the top of the article buffer?
-* [4.6]:: I'd like Gnus NOT to render HTML-mails but show me the
- text part if it's available. How to do it?
-* [4.7]:: Can I use some other browser than w3 to render my
- HTML-mails?
-* [4.8]:: Is there anything I can do to make poorly formatted mails
- more readable?
-* [4.9]:: Is there a way to automatically ignore posts by specific
- authors or with specific words in the subject? And can I highlight
- more interesting ones in some way?
-* [4.10]:: How can I disable threading in some (e.g. mail-) groups,
- or set other variables specific for some groups?
-* [4.11]:: Can I highlight messages written by me and follow-ups to
- those?
-* [4.12]:: The number of total messages in a group which Gnus
- displays in group buffer is by far to high, especially in mail
- groups. Is this a bug?
-* [4.13]:: I don't like the layout of summary and article buffer, how
- to change it? Perhaps even a three pane display?
-* [4.14]:: I don't like the way the Summary buffer looks, how to
- tweak it?
-* [4.15]:: How to split incoming mails in several groups?
-@end menu
-
-@node [4.1]
-@subsubheading Question 4.1
-
-When I enter a group, all read messages are gone. How to view them again?
-
-@subsubheading Answer
-
-If you enter the group by saying
-@samp{RET}
-in group buffer with point over the group, only unread and ticked messages are loaded. Say
-@samp{C-u RET}
-instead to load all available messages. If you want only the e.g. 300 newest say
-@samp{C-u 300 RET}
-
-Loading only unread messages can be annoying if you have threaded view enabled, say
-
-@example
-(setq gnus-fetch-old-headers 'some)
-@end example
-@noindent
-
-in ~/.gnus.el to load enough old articles to prevent teared threads, replace 'some with t to load
-all articles (Warning: Both settings enlarge the amount of data which is
-fetched when you enter a group and slow down the process of entering a group).
-
-If you already use Gnus 5.10, you can say
-@samp{/o N}
-In summary buffer to load the last N messages, this feature is not available in 5.8.8
-
-If you don't want all old messages, but the parent of the message you're just reading,
-you can say @samp{^}, if you want to retrieve the whole thread
-the message you're just reading belongs to, @samp{A T} is your friend.
-
-@node [4.2]
-@subsubheading Question 4.2
-
-How to tell Gnus to show an important message every time I
-enter a group, even when it's read?
-
-@subsubheading Answer
-
-You can tick important messages. To do this hit
-@samp{u} while point is in summary buffer
-over the message. When you want to remove the mark, hit
-either @samp{d} (this deletes the tick
-mark and set's unread mark) or @samp{M c}
-(which deletes all marks for the message).
-
-@node [4.3]
-@subsubheading Question 4.3
-
-How to view the headers of a message?
-
-@subsubheading Answer
-
-Say @samp{t}
-to show all headers, one more
-@samp{t}
-hides them again.
-
-@node [4.4]
-@subsubheading Question 4.4
-
-How to view the raw unformatted message?
-
-@subsubheading Answer
-
-Say
-@samp{C-u g}
-to show the raw message
-@samp{g}
-returns to normal view.
-
-@node [4.5]
-@subsubheading Question 4.5
-
-How can I change the headers Gnus displays by default at
-the top of the article buffer?
-
-@subsubheading Answer
-
-The variable gnus-visible-headers controls which headers
-are shown, its value is a regular expression, header lines
-which match it are shown. So if you want author, subject,
-date, and if the header exists, Followup-To and MUA / NUA
-say this in ~/.gnus.el:
-
-@example
-(setq gnus-visible-headers
- '("^From" "^Subject" "^Date" "^Newsgroups" "^Followup-To"
- "^User-Agent" "^X-Newsreader" "^X-Mailer"))
-@end example
-@noindent
-
-@node [4.6]
-@subsubheading Question 4.6
-
-I'd like Gnus NOT to render HTML-mails but show me the
-text part if it's available. How to do it?
-
-@subsubheading Answer
-
-Say
-
-@example
-(eval-after-load "mm-decode"
- '(progn
- (add-to-list 'mm-discouraged-alternatives "text/html")
- (add-to-list 'mm-discouraged-alternatives "text/richtext")))
-@end example
-@noindent
-
-in ~/.gnus.el. If you don't want HTML rendered, even if there's no text alternative add
-
-@example
-(setq mm-automatic-display (remove "text/html" mm-automatic-display))
-@end example
-@noindent
-
-too.
-
-@node [4.7]
-@subsubheading Question 4.7
-
-Can I use some other browser than w3 to render my HTML-mails?
-
-@subsubheading Answer
-
-Only if you use Gnus 5.10 or younger. In this case you've got the
-choice between w3, w3m, links, lynx and html2text, which
-one is used can be specified in the variable
-mm-text-html-renderer, so if you want links to render your
-mail say
-
-@example
-(setq mm-text-html-renderer 'links)
-@end example
-@noindent
-
-@node [4.8]
-@subsubheading Question 4.8
-
-Is there anything I can do to make poorly formatted mails
-more readable?
-
-@subsubheading Answer
-
-Gnus offers you several functions to "wash" incoming mail, you can
-find them if you browse through the menu, item
-Article->Washing. The most interesting ones are probably "Wrap
-long lines" (@samp{W w}), "Decode ROT13"
-(@samp{W r}) and "Outlook Deuglify" which repairs
-the dumb quoting used by many users of Microsoft products
-(@samp{W Y f} gives you full deuglify.
-See @samp{W Y C-h} or have a look at the menus for
-other deuglifications). Outlook deuglify is only available since
-Gnus 5.10.
-
-@node [4.9]
-@subsubheading Question 4.9
-
-Is there a way to automatically ignore posts by specific
-authors or with specific words in the subject? And can I
-highlight more interesting ones in some way?
-
-@subsubheading Answer
-
-You want Scoring. Scoring means, that you define rules
-which assign each message an integer value. Depending on
-the value the message is highlighted in summary buffer (if
-it's high, say +2000) or automatically marked read (if the
-value is low, say -800) or some other action happens.
-
-There are basically three ways of setting up rules which assign
-the scoring-value to messages. The first and easiest way is to set
-up rules based on the article you are just reading. Say you're
-reading a message by a guy who always writes nonsense and you want
-to ignore his messages in the future. Hit
-@samp{L}, to set up a rule which lowers the score.
-Now Gnus asks you which the criteria for lowering the Score shall
-be. Hit @samp{?} twice to see all possibilities,
-we want @samp{a} which means the author (the from
-header). Now Gnus wants to know which kind of matching we want.
-Hit either @samp{e} for an exact match or
-@samp{s} for substring-match and delete afterwards
-everything but the name to score down all authors with the given
-name no matter which email address is used. Now you need to tell
-Gnus when to apply the rule and how long it should last, hit e.g.
-@samp{p} to apply the rule now and let it last
-forever. If you want to raise the score instead of lowering it say
-@samp{I} instead of @samp{L}.
-
-You can also set up rules by hand. To do this say @samp{V
-f} in summary buffer. Then you are asked for the name
-of the score file, it's name.of.group.SCORE for rules valid in
-only one group or all.Score for rules valid in all groups. See the
-Gnus manual for the exact syntax, basically it's one big list
-whose elements are lists again. the first element of those lists
-is the header to score on, then one more list with what to match,
-which score to assign, when to expire the rule and how to do the
-matching. If you find me very interesting, you could e.g. add the
-following to your all.Score:
-
-@example
-(("references" ("hschmi22.userfqdn.rz-online.de" 500 nil s))
- ("message-id" ("hschmi22.userfqdn.rz-online.de" 999 nil s)))
-@end example
-@noindent
-
-This would add 999 to the score of messages written by me
-and 500 to the score of messages which are a (possibly
-indirect) answer to a message written by me. Of course
-nobody with a sane mind would do this :-)
-
-The third alternative is adaptive scoring. This means Gnus
-watches you and tries to find out what you find
-interesting and what annoying and sets up rules
-which reflect this. Adaptive scoring can be a huge help
-when reading high traffic groups. If you want to activate
-adaptive scoring say
-
-@example
-(setq gnus-use-adaptive-scoring t)
-@end example
-@noindent
-
-in ~/.gnus.el.
-
-@node [4.10]
-@subsubheading Question 4.10
-
-How can I disable threading in some (e.g. mail-) groups, or
-set other variables specific for some groups?
-
-@subsubheading Answer
-
-While in group buffer move point over the group and hit
-@samp{G c}, this opens a buffer where you
-can set options for the group. At the bottom of the buffer
-you'll find an item that allows you to set variables
-locally for the group. To disable threading enter
-gnus-show-threads as name of variable and nil as
-value. Hit button done at the top of the buffer when
-you're ready.
-
-@node [4.11]
-@subsubheading Question 4.11
-
-Can I highlight messages written by me and follow-ups to
-those?
-
-@subsubheading Answer
-
-Stop those "Can I ..." questions, the answer is always yes
-in Gnus Country :-). It's a three step process: First we
-make faces (specifications of how summary-line shall look
-like) for those postings, then we'll give them some
-special score and finally we'll tell Gnus to use the new
-faces. You can find detailed instructions on how to do it on
-@uref{http://my.gnus.org/node/view/224, my.gnus.org}
-
-@node [4.12]
-@subsubheading Question 4.12
-
-The number of total messages in a group which Gnus
-displays in group buffer is by far to high, especially in
-mail groups. Is this a bug?
-
-@subsubheading Answer
-
-No, that's a matter of design of Gnus, fixing this would
-mean reimplementation of major parts of Gnus'
-back ends. Gnus thinks "highest-article-number -
-lowest-article-number = total-number-of-articles". This
-works OK for Usenet groups, but if you delete and move
-many messages in mail groups, this fails. To cure the
-symptom, enter the group via @samp{C-u RET}
-(this makes Gnus get all messages), then
-hit @samp{M P b} to mark all messages and
-then say @samp{B m name.of.group} to move
-all messages to the group they have been in before, they
-get new message numbers in this process and the count is
-right again (until you delete and move your mail to other
-groups again).
-
-@node [4.13]
-@subsubheading Question 4.13
-
-I don't like the layout of summary and article buffer, how
-to change it? Perhaps even a three pane display?
-
-@subsubheading Answer
-
-You can control the windows configuration by calling the
-function gnus-add-configuration. The syntax is a bit
-complicated but explained very well in the manual node
-"Window Layout". Some popular examples:
-
-Instead 25% summary 75% article buffer 35% summary and 65%
-article (the 1.0 for article means "take the remaining
-space"):
-
-@example
-(gnus-add-configuration
- '(article (vertical 1.0 (summary .35 point) (article 1.0))))
-@end example
-@noindent
-
-A three pane layout, Group buffer on the left, summary
-buffer top-right, article buffer bottom-right:
-
-@example
-(gnus-add-configuration
- '(article
- (horizontal 1.0
- (vertical 25
- (group 1.0))
- (vertical 1.0
- (summary 0.25 point)
- (article 1.0)))))
-(gnus-add-configuration
- '(summary
- (horizontal 1.0
- (vertical 25
- (group 1.0))
- (vertical 1.0
- (summary 1.0 point)))))
-@end example
-@noindent
-
-@node [4.14]
-@subsubheading Question 4.14
-
-I don't like the way the Summary buffer looks, how to tweak it?
-
-@subsubheading Answer
-
-You've got to play around with the variable
-gnus-summary-line-format. It's value is a string of
-symbols which stand for things like author, date, subject
-etc. A list of the available specifiers can be found in the
-manual node "Summary Buffer Lines" and the often forgotten
-node "Formatting Variables" and it's sub-nodes. There
-you'll find useful things like positioning the cursor and
-tabulators which allow you a summary in table form, but
-sadly hard tabulators are broken in 5.8.8.
-
-Since 5.10, Gnus offers you some very nice new specifiers,
-e.g. %B which draws a thread-tree and %&user-date which
-gives you a date where the details are dependent of the
-articles age. Here's an example which uses both:
-
-@example
-(setq gnus-summary-line-format ":%U%R %B %s %-60=|%4L |%-20,20f |%&user-date; \n")
-@end example
-@noindent
-
-resulting in:
-
-@example
-:O Re: [Richard Stallman] rfc2047.el | 13 |Lars Magne Ingebrigt |Sat 23:06
-:O Re: Revival of the ding-patches list | 13 |Lars Magne Ingebrigt |Sat 23:12
-:R > Re: Find correct list of articles for a gro| 25 |Lars Magne Ingebrigt |Sat 23:16
-:O \-> ... | 21 |Kai Grossjohann | 0:01
-:R > Re: Cry for help: deuglify.el - moving stuf| 28 |Lars Magne Ingebrigt |Sat 23:34
-:O \-> ... | 115 |Raymond Scholz | 1:24
-:O \-> ... | 19 |Lars Magne Ingebrigt |15:33
-:O Slow mailing list | 13 |Lars Magne Ingebrigt |Sat 23:49
-:O Re: `@@' mark not documented | 13 |Lars Magne Ingebrigt |Sat 23:50
-:R > Re: Gnus still doesn't count messages prope| 23 |Lars Magne Ingebrigt |Sat 23:57
-:O \-> ... | 18 |Kai Grossjohann | 0:35
-:O \-> ... | 13 |Lars Magne Ingebrigt | 0:56
-@end example
-@noindent
-
-@node [4.15]
-@subsubheading Question 4.15
-
-How to split incoming mails in several groups?
-
-@subsubheading Answer
-
-Gnus offers two possibilities for splitting mail, the easy
-nnmail-split-methods and the more powerful Fancy Mail
-Splitting. I'll only talk about the first one, refer to
-the manual, node "Fancy Mail Splitting" for the latter.
-
-The value of nnmail-split-methods is a list, each element
-is a list which stands for a splitting rule. Each rule has
-the form "group where matching articles should go to",
-"regular expression which has to be matched", the first
-rule which matches wins. The last rule must always be a
-general rule (regular expression .*) which denotes where
-articles should go which don't match any other rule. If
-the folder doesn't exist yet, it will be created as soon
-as an article lands there. By default the mail will be
-send to all groups whose rules match. If you
-don't want that (you probably don't want), say
-
-@example
-(setq nnmail-crosspost nil)
-@end example
-@noindent
-
-in ~/.gnus.el.
-
-An example might be better than thousand words, so here's
-my nnmail-split-methods. Note that I send duplicates in a
-special group and that the default group is spam, since I
-filter all mails out which are from some list I'm
-subscribed to or which are addressed directly to me
-before. Those rules kill about 80% of the Spam which
-reaches me (Email addresses are changed to prevent spammers
-from using them):
-
-@example
-(setq nnmail-split-methods
- '(("duplicates" "^Gnus-Warning:.*duplicate")
- ("XEmacs-NT" "^\\(To:\\|CC:\\).*localpart@@xemacs.invalid.*")
- ("Gnus-Tut" "^\\(To:\\|CC:\\).*localpart@@socha.invalid.*")
- ("tcsh" "^\\(To:\\|CC:\\).*localpart@@mx.gw.invalid.*")
- ("BAfH" "^\\(To:\\|CC:\\).*localpart@@.*uni-muenchen.invalid.*")
- ("Hamster-src" "^\\(CC:\\|To:\\).*hamster-sourcen@@yahoogroups.\\(de\\|com\\).*")
- ("Tagesschau" "^From: tagesschau <localpart@@www.tagesschau.invalid>$")
- ("Replies" "^\\(CC:\\|To:\\).*localpart@@Frank-Schmitt.invalid.*")
- ("EK" "^From:.*\\(localpart@@privateprovider.invalid\\|localpart@@workplace.invalid\\).*")
- ("Spam" "^Content-Type:.*\\(ks_c_5601-1987\\|EUC-KR\\|big5\\|iso-2022-jp\\).*")
- ("Spam" "^Subject:.*\\(This really work\\|XINGA\\|ADV:\\|XXX\\|adult\\|sex\\).*")
- ("Spam" "^Subject:.*\\(\=\?ks_c_5601-1987\?\\|\=\?euc-kr\?\\|\=\?big5\?\\).*")
- ("Spam" "^X-Mailer:\\(.*BulkMailer.*\\|.*MIME::Lite.*\\|\\)")
- ("Spam" "^X-Mailer:\\(.*CyberCreek Avalanche\\|.*http\:\/\/GetResponse\.com\\)")
- ("Spam" "^From:.*\\(verizon\.net\\|prontomail\.com\\|money\\|ConsumerDirect\\).*")
- ("Spam" "^Delivered-To: GMX delivery to spamtrap@@gmx.invalid$")
- ("Spam" "^Received: from link2buy.com")
- ("Spam" "^CC: .*azzrael@@t-online.invalid")
- ("Spam" "^X-Mailer-Version: 1.50 BETA")
- ("Uni" "^\\(CC:\\|To:\\).*localpart@@uni-koblenz.invalid.*")
- ("Inbox" "^\\(CC:\\|To:\\).*\\(my\ name\\|address@@one.invalid\\|adress@@two.invalid\\)")
- ("Spam" "")))
-@end example
-@noindent
-
-@node FAQ 5 - Composing messages
-@subsection Composing messages
-
-@menu
-* [5.1]:: What are the basic commands I need to know for sending
- mail and postings?
-* [5.2]:: How to enable automatic word-wrap when composing messages?
-* [5.3]:: How to set stuff like From, Organization, Reply-To,
- signature...?
-* [5.4]:: Can I set things like From, Signature etc group based on
- the group I post too?
-* [5.5]:: Is there a spell-checker? Perhaps even on-the-fly
- spell-checking?
-* [5.6]:: Can I set the dictionary based on the group I'm posting
- to?
-* [5.7]:: Is there some kind of address-book, so I needn't remember
- all those email addresses?
-* [5.8]:: Sometimes I see little images at the top of article
- buffer. What's that and how can I send one with my postings, too?
-* [5.9]:: Sometimes I accidentally hit r instead of f in newsgroups.
- Can Gnus warn me, when I'm replying by mail in newsgroups?
-* [5.10]:: How to tell Gnus not to generate a sender header?
-* [5.11]:: I want Gnus to locally store copies of my send mail and
- news, how to do it?
-* [5.12]:: People tell me my Message-IDs are not correct, why aren't
- they and how to fix it?
-@end menu
-
-@node [5.1]
-@subsubheading Question 5.1
-
-What are the basic commands I need to know for sending mail and postings?
-
-@subsubheading Answer
-
-To start composing a new mail hit @samp{m}
-either in Group or Summary buffer, for a posting, it's
-either @samp{a} in Group buffer and
-filling the Newsgroups header manually
-or @samp{a} in the Summary buffer of the
-group where the posting shall be send to. Replying by mail
-is
-@samp{r} if you don't want to cite the
-author, or import the cited text manually and
-@samp{R} to cite the text of the original
-message. For a follow up to a newsgroup, it's
-@samp{f} and @samp{F}
-(analogously to @samp{r} and
-@samp{R}).
-
-Enter new headers above the line saying "--text follows
-this line--", enter the text below the line. When ready
-hit @samp{C-c C-c}, to send the message,
-if you want to finish it later hit @samp{C-c
-C-d} to save it in the drafts group, where you
-can start editing it again by saying @samp{D
-e}.
-
-@node [5.2]
-@subsubheading Question 5.2
-
-How to enable automatic word-wrap when composing messages?
-
-@subsubheading Answer
-
-Say
-
-@example
-(add-hook 'message-mode-hook
- (lambda ()
- (setq fill-column 72)
- (turn-on-auto-fill)))
-@end example
-@noindent
-
-in ~/.gnus.el. You can reformat a paragraph by hitting
-@samp{M-q} (as usual)
-
-@node [5.3]
-@subsubheading Question 5.3
-
-How to set stuff like From, Organization, Reply-To, signature...?
-
-@subsubheading Answer
-
-There are other ways, but you should use posting styles
-for this. (See below why).
-This example should make the syntax clear:
-
-@example
-(setq gnus-posting-styles
- '((".*"
- (name "Frank Schmitt")
- (address "me@@there.invalid")
- (organization "Hamme net, kren mer och nimmi")
- (signature-file "~/.signature")
- ("X-SampleHeader" "foobar")
- (eval (setq some-variable "Foo bar")))))
-@end example
-@noindent
-
-The ".*" means that this settings are the default ones
-(see below), valid values for the first element of the
-following lists are signature, signature-file,
-organization, address, name or body. The attribute name
-can also be a string. In that case, this will be used as
-a header name, and the value will be inserted in the
-headers of the article; if the value is `nil', the header
-name will be removed. You can also say (eval (foo bar)),
-then the function foo will be evaluated with argument bar
-and the result will be thrown away.
-
-@node [5.4]
-@subsubheading Question 5.4
-
-Can I set things like From, Signature etc group based on the group I post too?
-
-@subsubheading Answer
-
-That's the strength of posting styles. Before, we used ".*"
-to set the default for all groups. You can use a regexp
-like "^gmane" and the following settings are only applied
-to postings you send to the gmane hierarchy, use
-".*binaries" instead and they will be applied to postings
-send to groups containing the string binaries in their
-name etc.
-
-You can instead of specifying a regexp specify a function
-which is evaluated, only if it returns true, the
-corresponding settings take effect. Two interesting
-candidates for this are message-news-p which returns t if
-the current Group is a newsgroup and the corresponding
-message-mail-p.
-
-Note that all forms that match are applied, that means in
-the example below, when I post to
-gmane.mail.spam.spamassassin.general, the settings under
-".*" are applied and the settings under message-news-p and
-those under "^gmane" and those under
-"^gmane\\.mail\\.spam\\.spamassassin\\.general$". Because
-of this put general settings at the top and specific ones
-at the bottom.
-
-@example
-(setq gnus-posting-styles
- '((".*" ;;default
- (name "Frank Schmitt")
- (organization "Hamme net, kren mer och nimmi")
- (signature-file "~/.signature"))
- ((message-news-p) ;;Usenet news?
- (address "mySpamTrap@@Frank-Schmitt.invalid")
- (reply-to "hereRealRepliesOnlyPlease@@Frank-Schmitt.invalid"))
- ((message-mail-p) ;;mail?
- (address "usedForMails@@Frank-Schmitt.invalid"))
- ("^gmane" ;;this is mail, too in fact
- (address "usedForMails@@Frank-Schmitt.invalid")
- (reply-to nil))
- ("^gmane\\.mail\\.spam\\.spamassassin\\.general$"
- (eval (set (make-local-variable 'message-sendmail-envelope-from)
- "Azzrael@@rz-online.de")))))
-@end example
-@noindent
-
-@node [5.5]
-@subsubheading Question 5.5
-
-Is there a spell-checker? Perhaps even on-the-fly spell-checking?
-
-@subsubheading Answer
-
-You can use ispell.el to spell-check stuff in Emacs. So the
-first thing to do is to make sure that you've got either
-@uref{http://fmg-www.cs.ucla.edu/fmg-members/geoff/ispell.html, ispell}
-or @uref{http://aspell.sourceforge.net/, aspell}
-installed and in your Path. Then you need
-@uref{http://www.kdstevens.com/~stevens/ispell-page.html, ispell.el}
-and for on-the-fly spell-checking
-@uref{http://www-sop.inria.fr/mimosa/personnel/Manuel.Serrano/flyspell/flyspell.html, flyspell.el}.
-Ispell.el is shipped with Emacs and available through the XEmacs package system,
-flyspell.el is shipped with Emacs and part of XEmacs text-modes package which is
-available through the package system, so there should be no need to install them
-manually.
-
-Ispell.el assumes you use ispell, if you choose aspell say
-
-@example
-(setq ispell-program-name "aspell")
-@end example
-@noindent
-
-in your Emacs configuration file.
-
-If you want your outgoing messages to be spell-checked, say
-
-@example
-(add-hook 'message-send-hook 'ispell-message)
-@end example
-@noindent
-
-In your ~/.gnus.el, if you prefer on-the-fly spell-checking say
-
-@example
-(add-hook 'message-mode-hook (lambda () (flyspell-mode 1)))
-@end example
-@noindent
-
-@node [5.6]
-@subsubheading Question 5.6
-
-Can I set the dictionary based on the group I'm posting to?
-
-@subsubheading Answer
-
-Yes, say something like
-
-@example
-(add-hook 'gnus-select-group-hook
- (lambda ()
- (cond
- ((string-match
- "^de\\." (gnus-group-real-name gnus-newsgroup-name))
- (ispell-change-dictionary "deutsch8"))
- (t
- (ispell-change-dictionary "english")))))
-@end example
-@noindent
-
-in ~/.gnus.el. Change "^de\\." and "deutsch8" to something
-that suits your needs.
-
-@node [5.7]
-@subsubheading Question 5.7
-
-Is there some kind of address-book, so I needn't remember
-all those email addresses?
-
-@subsubheading Answer
-
-There's an very basic solution for this, mail aliases.
-You can store your mail addresses in a ~/.mailrc file using a simple
-alias syntax:
-
-@example
-alias al "Al <al@@english-heritage.invalid>"
-@end example
-@noindent
-
-Then typing your alias (followed by a space or punctuation
-character) on a To: or Cc: line in the message buffer will
-cause Gnus to insert the full address for you. See the
-node "Mail Aliases" in Message (not Gnus) manual for
-details.
-
-However, what you really want is the Insidious Big Brother
-Database bbdb. Get it through the XEmacs package system or from
-@uref{http://bbdb.sourceforge.net/, bbdb's homepage}.
-Now place the following in ~/.gnus.el, to activate bbdb for Gnus:
-
-@example
-(require 'bbdb)
-(bbdb-initialize 'gnus 'message)
-@end example
-@noindent
-
-Now you probably want some general bbdb configuration,
-place them in ~/.emacs:
-
-@example
-(require 'bbdb)
-;;If you don't live in Northern America, you should disable the
-;;syntax check for telephone numbers by saying
-(setq bbdb-north-american-phone-numbers-p nil)
-;;Tell bbdb about your email address:
-(setq bbdb-user-mail-names
- (regexp-opt '("Your.Email@@here.invalid"
- "Your.other@@mail.there.invalid")))
-;;cycling while completing email addresses
-(setq bbdb-complete-name-allow-cycling t)
-;;No popup-buffers
-(setq bbdb-use-pop-up nil)
-@end example
-@noindent
-
-Now you should be ready to go. Say @samp{M-x bbdb RET
-RET} to open a bbdb buffer showing all
-entries. Say @samp{c} to create a new
-entry, @samp{b} to search your BBDB and
-@samp{C-o} to add a new field to an
-entry. If you want to add a sender to the BBDB you can
-also just hit `:' on the posting in the summary buffer and
-you are done. When you now compose a new mail,
-hit @samp{TAB} to cycle through know
-recipients.
-
-@node [5.8]
-@subsubheading Question 5.8
-
-Sometimes I see little images at the top of article
-buffer. What's that and how can I send one with my
-postings, too?
-
-@subsubheading Answer
-
-Those images are called X-Faces. They are 48*48 pixel b/w
-pictures, encoded in a header line. If you want to include
-one in your posts, you've got to convert some image to a
-X-Face. So fire up some image manipulation program (say
-Gimp), open the image you want to include, cut out the
-relevant part, reduce color depth to 1 bit, resize to
-48*48 and save as bitmap. Now you should get the compface
-package from
-@uref{ftp://ftp.cs.indiana.edu:/pub/faces/, this site}.
-and create the actual X-face by saying
-
-@example
-cat file.xbm | xbm2ikon | compface > file.face
-cat file.face | sed 's/\\/\\\\/g;s/\"/\\\"/g;' > file.face.quoted
-@end example
-@noindent
-
-If you can't use compface, there's an online X-face converter at
-@uref{http://www.dairiki.org/xface/}.
-If you use MS Windows, you could also use the WinFace program from
-@uref{http://www.xs4all.nl/~walterln/winface/}.
-Now you only have to tell Gnus to include the X-face in your postings by saying
-
-@example
-(setq message-default-headers
- (with-temp-buffer
- (insert "X-Face: ")
- (insert-file-contents "~/.xface")
- (buffer-string)))
-@end example
-@noindent
-
-in ~/.gnus.el. If you use Gnus 5.10, you can simply add an entry
-
-@example
-(x-face-file "~/.xface")
-@end example
-@noindent
-
-to gnus-posting-styles.
-
-@node [5.9]
-@subsubheading Question 5.9
-
-Sometimes I accidentally hit r instead of f in
-newsgroups. Can Gnus warn me, when I'm replying by mail in
-newsgroups?
-
-@subsubheading Answer
-
-Put this in ~/.gnus.el:
-
-@example
-(setq gnus-confirm-mail-reply-to-news t)
-@end example
-@noindent
-
-if you already use Gnus 5.10, if you still use 5.8.8 or
-5.9 try this instead:
-
-@example
-(eval-after-load "gnus-msg"
- '(unless (boundp 'gnus-confirm-mail-reply-to-news)
- (defadvice gnus-summary-reply (around reply-in-news activate)
- "Request confirmation when replying to news."
- (interactive)
- (when (or (not (gnus-news-group-p gnus-newsgroup-name))
- (y-or-n-p "Really reply by mail to article author? "))
- ad-do-it))))
-@end example
-@noindent
-
-@node [5.10]
-@subsubheading Question 5.10
-
-How to tell Gnus not to generate a sender header?
-
-@subsubheading Answer
-
-Since 5.10 Gnus doesn't generate a sender header by
-default. For older Gnus' try this in ~/.gnus.el:
-
-@example
-(eval-after-load "message"
- '(add-to-list 'message-syntax-checks '(sender . disabled)))
-@end example
-@noindent
-
-@node [5.11]
-@subsubheading Question 5.11
-
-I want Gnus to locally store copies of my send mail and
-news, how to do it?
-
-@subsubheading Answer
-
-You must set the variable gnus-message-archive-group to do
-this. You can set it to a string giving the name of the
-group where the copies shall go or like in the example
-below use a function which is evaluated and which returns
-the group to use.
-
-@example
-(setq gnus-message-archive-group
- '((if (message-news-p)
- "nnml:Send-News"
- "nnml:Send-Mail")))
-@end example
-@noindent
-
-@node [5.12]
-@subsubheading Question 5.12
-
-People tell me my Message-IDs are not correct, why
-aren't they and how to fix it?
-
-@subsubheading Answer
-
-The message-ID is an unique identifier for messages you
-send. To make it unique, Gnus need to know which machine
-name to put after the "@@". If the name of the machine
-where Gnus is running isn't suitable (it probably isn't
-at most private machines) you can tell Gnus what to use
-by saying:
-
-@example
-(setq message-user-fqdn "yourmachine.yourdomain.tld")
-@end example
-@noindent
-
-in ~/.gnus.el. If you use Gnus 5.9 or earlier, you can use this
-instead (works for newer versions a well):
-
-@example
-(eval-after-load "message"
- '(let ((fqdn "yourmachine.yourdomain.tld"));; <-- Edit this!
- (if (boundp 'message-user-fqdn)
- (setq message-user-fqdn fqdn)
- (gnus-message 1 "Redefining `message-make-fqdn'.")
- (defun message-make-fqdn ()
- "Return user's fully qualified domain name."
- fqdn))))
-@end example
-@noindent
-
-If you have no idea what to insert for
-"yourmachine.yourdomain.tld", you've got several
-choices. You can either ask your provider if he allows
-you to use something like
-yourUserName.userfqdn.provider.net, or you can use
-somethingUnique.yourdomain.tld if you own the domain
-yourdomain.tld, or you can register at a service which
-gives private users a FQDN for free.
-
-Finally you can tell Gnus not to generate a Message-ID
-for News at all (and letting the server do the job) by saying
-
-@example
-(setq message-required-news-headers
- (remove' Message-ID message-required-news-headers))
-@end example
-@noindent
-
-you can also tell Gnus not to generate Message-IDs for mail by saying
-
-@example
-(setq message-required-mail-headers
- (remove' Message-ID message-required-mail-headers))
-@end example
-@noindent
-
-, however some mail servers don't generate proper
-Message-IDs, too, so test if your Mail Server behaves
-correctly by sending yourself a Mail and looking at the Message-ID.
-
-@node FAQ 6 - Old messages
-@subsection Old messages
-
-@menu
-* [6.1]:: How to import my old mail into Gnus?
-* [6.2]:: How to archive interesting messages?
-* [6.3]:: How to search for a specific message?
-* [6.4]:: How to get rid of old unwanted mail?
-* [6.5]:: I want that all read messages are expired (at least in some
- groups). How to do it?
-* [6.6]:: I don't want expiration to delete my mails but to move them
- to another group.
-@end menu
-
-@node [6.1]
-@subsubheading Question 6.1
-
-How to import my old mail into Gnus?
-
-@subsubheading Answer
-
-The easiest way is to tell your old mail program to
-export the messages in mbox format. Most Unix mailers
-are able to do this, if you come from the MS Windows
-world, you may find tools at
-@uref{http://mbx2mbox.sourceforge.net/}.
-
-Now you've got to import this mbox file into Gnus. To do
-this, create a nndoc group based on the mbox file by
-saying @samp{G f /path/file.mbox RET} in
-Group buffer. You now have read-only access to your
-mail. If you want to import the messages to your normal
-Gnus mail groups hierarchy, enter the nndoc group you've
-just created by saying @samp{C-u RET}
-(thus making sure all messages are retrieved), mark all
-messages by saying @samp{M P b} and
-either copy them to the desired group by saying
-@samp{B c name.of.group RET} or send them
-through nnmail-split-methods (respool them) by saying
-@samp{B r}.
-
-@node [6.2]
-@subsubheading Question 6.2
-
-How to archive interesting messages?
-
-@subsubheading Answer
-
-If you stumble across an interesting message, say in
-gnu.emacs.gnus and want to archive it there are several
-solutions. The first and easiest is to save it to a file
-by saying @samp{O f}. However, wouldn't
-it be much more convenient to have more direct access to
-the archived message from Gnus? If you say yes, put this
-snippet by Frank Haun <pille3003@@fhaun.de> in
-~/.gnus.el:
-
-@example
-(defun my-archive-article (&optional n)
- "Copies one or more article(s) to a corresponding `nnml:' group, e.g.
-`gnus.ding' goes to `nnml:1.gnus.ding'. And `nnml:List-gnus.ding' goes
-to `nnml:1.List-gnus-ding'.
-
-Use process marks or mark a region in the summary buffer to archive
-more then one article."
- (interactive "P")
- (let ((archive-name
- (format
- "nnml:1.%s"
- (if (featurep 'xemacs)
- (replace-in-string gnus-newsgroup-name "^.*:" "")
- (replace-regexp-in-string "^.*:" "" gnus-newsgroup-name)))))
- (gnus-summary-copy-article n archive-name)))
-@end example
-@noindent
-
-You can now say @samp{M-x
-my-archive-article} in summary buffer to
-archive the article under the cursor in a nnml
-group. (Change nnml to your preferred back end)
-
-Of course you can also make sure the cache is enabled by saying
-
-@example
-(setq gnus-use-cache t)
-@end example
-@noindent
-
-then you only have to set either the tick or the dormant
-mark for articles you want to keep, setting the read
-mark will remove them from cache.
-
-@node [6.3]
-@subsubheading Question 6.3
-
-How to search for a specific message?
-
-@subsubheading Answer
-
-There are several ways for this, too. For a posting from
-a Usenet group the easiest solution is probably to ask
-@uref{http://groups.google.com, groups.google.com},
-if you found the posting there, tell Google to display
-the raw message, look for the message-id, and say
-@samp{M-^ the@@message.id RET} in a
-summary buffer.
-Since Gnus 5.10 there's also a Gnus interface for
-groups.google.com which you can call with
-@samp{G W}) in group buffer.
-
-Another idea which works for both mail and news groups
-is to enter the group where the message you are
-searching is and use the standard Emacs search
-@samp{C-s}, it's smart enough to look at
-articles in collapsed threads, too. If you want to
-search bodies, too try @samp{M-s}
-instead. Further on there are the
-gnus-summary-limit-to-foo functions, which can help you,
-too.
-
-Of course you can also use grep to search through your
-local mail, but this is both slow for big archives and
-inconvenient since you are not displaying the found mail
-in Gnus. Here comes nnir into action. Nnir is a front end
-to search engines like swish-e or swish++ and
-others. You index your mail with one of those search
-engines and with the help of nnir you can search trough
-the indexed mail and generate a temporary group with all
-messages which met your search criteria. If this sound
-cool to you get nnir.el from
-@uref{ftp://ls6-ftp.cs.uni-dortmund.de/pub/src/emacs/}
-or @uref{ftp://ftp.is.informatik.uni-duisburg.de/pub/src/emacs/}.
-Instructions on how to use it are at the top of the file.
-
-@node [6.4]
-@subsubheading Question 6.4
-
-How to get rid of old unwanted mail?
-
-@subsubheading Answer
-
-You can of course just mark the mail you don't need
-anymore by saying @samp{#} with point
-over the mail and then say @samp{B DEL}
-to get rid of them forever. You could also instead of
-actually deleting them, send them to a junk-group by
-saying @samp{B m nnml:trash-bin} which
-you clear from time to time, but both are not the intended
-way in Gnus.
-
-In Gnus, we let mail expire like news expires on a news
-server. That means you tell Gnus the message is
-expirable (you tell Gnus "I don't need this mail
-anymore") by saying @samp{E} with point
-over the mail in summary buffer. Now when you leave the
-group, Gnus looks at all messages which you marked as
-expirable before and if they are old enough (default is
-older than a week) they are deleted.
-
-@node [6.5]
-@subsubheading Question 6.5
-
-I want that all read messages are expired (at least in
-some groups). How to do it?
-
-@subsubheading Answer
-
-If you want all read messages to be expired (e.g. in
-mailing lists where there's an online archive), you've
-got two choices: auto-expire and
-total-expire. Auto-expire means, that every article
-which has no marks set and is selected for reading is
-marked as expirable, Gnus hits @samp{E}
-for you every time you read a message. Total-expire
-follows a slightly different approach, here all article
-where the read mark is set are expirable.
-
-To activate auto-expire, include auto-expire in the
-Group parameters for the group. (Hit @samp{G
-c} in summary buffer with point over the
-group to change group parameters). For total-expire add
-total-expire to the group-parameters.
-
-Which method you choose is merely a matter of taste:
-Auto-expire is faster, but it doesn't play together with
-Adaptive Scoring, so if you want to use this feature,
-you should use total-expire.
-
-If you want a message to be excluded from expiration in
-a group where total or auto expire is active, set either
-tick (hit @samp{u}) or dormant mark (hit
-@samp{u}), when you use auto-expire, you
-can also set the read mark (hit
-@samp{d}).
-
-@node [6.6]
-@subsubheading Question 6.6
-
-I don't want expiration to delete my mails but to move them
-to another group.
-
-@subsubheading Answer
-
-Say something like this in ~/.gnus.el:
-
-@example
-(setq nnmail-expiry-target "nnml:expired")
-@end example
-@noindent
-
-(If you want to change the value of nnmail-expiry-target
-on a per group basis see the question "How can I disable
-threading in some (e.g. mail-) groups, or set other
-variables specific for some groups?")
-
-@node FAQ 7 - Gnus in a dial-up environment
-@subsection Gnus in a dial-up environment
-
-@menu
-* [7.1]:: I don't have a permanent connection to the net, how can I
- minimize the time I've got to be connected?
-* [7.2]:: So what was this thing about the Agent?
-* [7.3]:: I want to store article bodies on disk, too. How to do it?
-* [7.4]:: How to tell Gnus not to try to send mails / postings while
- I'm offline?
-@end menu
-
-@node [7.1]
-@subsubheading Question 7.1
-
-I don't have a permanent connection to the net, how can
-I minimize the time I've got to be connected?
-
-@subsubheading Answer
-
-You've got basically two options: Either you use the
-Gnus Agent (see below) for this, or you can install
-programs which fetch your news and mail to your local
-disk and Gnus reads the stuff from your local
-machine.
-
-If you want to follow the second approach, you need a
-program which fetches news and offers them to Gnus, a
-program which does the same for mail and a program which
-receives the mail you write from Gnus and sends them
-when you're online.
-
-Let's talk about Unix systems first: For the news part,
-the easiest solution is a small nntp server like
-@uref{http://www.leafnode.org/, Leafnode} or
-@uref{http://infa.abo.fi/~patrik/sn/, sn},
-of course you can also install a full featured news
-server like
-@uref{http://www.isc.org/products/INN/, inn}.
-Then you want to fetch your Mail, popular choices
-are @uref{http://www.catb.org/~esr/fetchmail/, fetchmail}
-and @uref{http://www.qcc.ca/~charlesc/software/getmail-3.0/, getmail}.
-You should tell those to write the mail to your disk and
-Gnus to read it from there. Last but not least the mail
-sending part: This can be done with every MTA like
-@uref{http://www.sendmail.org/, sendmail},
-@uref{http://www.qmail.org/, postfix},
-@uref{http://www.exim.org/, exim} or
-@uref{http://www.qmail.org/, qmail}.
-
-On windows boxes I'd vote for
-@uref{http://www.tglsoft.de/, Hamster},
-it's a small freeware, open-source program which fetches
-your mail and news from remote servers and offers them
-to Gnus (or any other mail and/or news reader) via nntp
-respectively POP3 or IMAP. It also includes a smtp
-server for receiving mails from Gnus.
-
-@node [7.2]
-@subsubheading Question 7.2
-
-So what was this thing about the Agent?
-
-@subsubheading Answer
-
-The Gnus agent is part of Gnus, it allows you to fetch
-mail and news and store them on disk for reading them
-later when you're offline. It kind of mimics offline
-newsreaders like e.g. Forte Agent. If you want to use
-the Agent place the following in ~/.gnus.el if you are
-still using 5.8.8 or 5.9 (it's the default since 5.10):
-
-@example
-(setq gnus-agent t)
-@end example
-@noindent
-
-Now you've got to select the servers whose groups can be
-stored locally. To do this, open the server buffer
-(that is press @samp{^} while in the
-group buffer). Now select a server by moving point to
-the line naming that server. Finally, agentize the
-server by typing @samp{J a}. If you
-make a mistake, or change your mind, you can undo this
-action by typing @samp{J r}. When
-you're done, type 'q' to return to the group buffer.
-Now the next time you enter a group on a agentized
-server, the headers will be stored on disk and read from
-there the next time you enter the group.
-
-@node [7.3]
-@subsubheading Question 7.3
-
-I want to store article bodies on disk, too. How to do it?
-
-@subsubheading Answer
-
-You can tell the agent to automatically fetch the bodies
-of articles which fulfill certain predicates, this is
-done in a special buffer which can be reached by
-saying @samp{J c} in group
-buffer. Please refer to the documentation for
-information which predicates are possible and how
-exactly to do it.
-
-Further on you can tell the agent manually which
-articles to store on disk. There are two ways to do
-this: Number one: In the summary buffer, process mark a
-set of articles that shall be stored in the agent by
-saying @samp{#} with point over the
-article and then type @samp{J s}. The
-other possibility is to set, again in the summary
-buffer, downloadable (%) marks for the articles you
-want by typing @samp{@@} with point over
-the article and then typing @samp{J u}.
-What's the difference? Well, process marks are erased as
-soon as you exit the summary buffer while downloadable
-marks are permanent. You can actually set downloadable
-marks in several groups then use fetch session ('J s' in
-the GROUP buffer) to fetch all of those articles. The
-only downside is that fetch session also fetches all of
-the headers for every selected group on an agentized
-server. Depending on the volume of headers, the initial
-fetch session could take hours.
-
-@node [7.4]
-@subsubheading Question 7.4
-
-How to tell Gnus not to try to send mails / postings
-while I'm offline?
-
-@subsubheading Answer
-
-All you've got to do is to tell Gnus when you are online
-(plugged) and when you are offline (unplugged), the rest
-works automatically. You can toggle plugged/unplugged
-state by saying @samp{J j} in group
-buffer. To start Gnus unplugged say @samp{M-x
-gnus-unplugged} instead of
-@samp{M-x gnus}. Note that for this to
-work, the agent must be active.
-
-@node FAQ 8 - Getting help
-@subsection Getting help
-
-@menu
-* [8.1]:: How to find information and help inside Emacs?
-* [8.2]:: I can't find anything in the Gnus manual about X (e.g.
- attachments, PGP, MIME...), is it not documented?
-* [8.3]:: Which websites should I know?
-* [8.4]:: Which mailing lists and newsgroups are there?
-* [8.5]:: Where to report bugs?
-* [8.6]:: I need real-time help, where to find it?
-@end menu
-
-@node [8.1]
-@subsubheading Question 8.1
-
-How to find information and help inside Emacs?
-
-@subsubheading Answer
-
-The first stop should be the Gnus manual (Say
-@samp{C-h i d m Gnus RET} to start the
-Gnus manual, then walk through the menus or do a
-full-text search with @samp{s}). Then
-there are the general Emacs help commands starting with
-C-h, type @samp{C-h ? ?} to get a list
-of all available help commands and their meaning. Finally
-@samp{M-x apropos-command} lets you
-search through all available functions and @samp{M-x
-apropos} searches the bound variables.
-
-@node [8.2]
-@subsubheading Question 8.2
-
-I can't find anything in the Gnus manual about X
-(e.g. attachments, PGP, MIME...), is it not documented?
-
-@subsubheading Answer
-
-There's not only the Gnus manual but also the manuals
-for message, emacs-mime, sieve and pgg. Those packages
-are distributed with Gnus and used by Gnus but aren't
-really part of core Gnus, so they are documented in
-different info files, you should have a look in those
-manuals, too.
-
-@node [8.3]
-@subsubheading Question 8.3
-
-Which websites should I know?
-
-@subsubheading Answer
-
-The two most important ones are the
-@uref{http://www.gnus.org, official Gnus website}.
-and it's sister site
-@uref{http://my.gnus.org, my.gnus.org (MGO)},
-hosting an archive of lisp snippets, howtos, a (not
-really finished) tutorial and this FAQ.
-
-Tell me about other sites which are interesting.
-
-@node [8.4]
-@subsubheading Question 8.4
-
-Which mailing lists and newsgroups are there?
-
-@subsubheading Answer
-
-There's the newsgroup gnu.emacs.gnus (also available as
-@uref{http://dir.gmane.org/gmane.emacs.gnus.user,
-gmane.emacs.gnus.user}) which deals with general Gnus questions. If you
-have questions about development versions of Gnus, you should better ask
-on the ding mailing list, see below.
-
-If you want to stay in the big8,
-news.software.newssreaders is also read by some Gnus
-users (but chances for qualified help are much better in
-the above groups). If you speak German, there's
-de.comm.software.gnus.
-
-The ding mailing list (ding@@gnus.org) deals with development of
-Gnus. You can read the ding list via NNTP, too under the name
-@uref{http://dir.gmane.org/gmane.emacs.gnus.general,
-gmane.emacs.gnus.general} from news.gmane.org.
-
-@node [8.5]
-@subsubheading Question 8.5
-
-Where to report bugs?
-
-@subsubheading Answer
-
-Say @samp{M-x gnus-bug}, this will start
-a message to the
-@email{bugs@@gnus.org, gnus bug mailing list}
-including information about your environment which make
-it easier to help you.
-
-@node [8.6]
-@subsubheading Question 8.6
-
-I need real-time help, where to find it?
-
-@subsubheading Answer
-
-Point your IRC client to irc.freenode.net, channel #gnus.
-
-@node FAQ 9 - Tuning Gnus
-@subsection Tuning Gnus
-
-@menu
-* [9.1]:: Starting Gnus is really slow, how to speed it up?
-* [9.2]:: How to speed up the process of entering a group?
-* [9.3]:: Sending mail becomes slower and slower, what's up?
-@end menu
-
-@node [9.1]
-@subsubheading Question 9.1
-
-Starting Gnus is really slow, how to speed it up?
-
-@subsubheading Answer
-
-The reason for this could be the way Gnus reads it's
-active file, see the node "The Active File" in the Gnus
-manual for things you might try to speed the process up.
-An other idea would be to byte compile your ~/.gnus.el (say
-@samp{M-x byte-compile-file RET ~/.gnus.el
-RET} to do it). Finally, if you have require
-statements in your .gnus, you could replace them with
-eval-after-load, which loads the stuff not at startup
-time, but when it's needed. Say you've got this in your
-~/.gnus.el:
-
-@example
-(require 'message)
-(add-to-list 'message-syntax-checks '(sender . disabled))
-@end example
-@noindent
-
-then as soon as you start Gnus, message.el is loaded. If
-you replace it with
-
-@example
-(eval-after-load "message"
- '(add-to-list 'message-syntax-checks '(sender . disabled)))
-@end example
-@noindent
-
-it's loaded when it's needed.
-
-@node [9.2]
-@subsubheading Question 9.2
-
-How to speed up the process of entering a group?
-
-@subsubheading Answer
-
-A speed killer is setting the variable
-gnus-fetch-old-headers to anything different from nil,
-so don't do this if speed is an issue. To speed up
-building of summary say
-
-@example
-(gnus-compile)
-@end example
-@noindent
-
-at the bottom of your ~/.gnus.el, this will make gnus
-byte-compile things like
-gnus-summary-line-format.
-then you could increase the value of gc-cons-threshold
-by saying something like
-
-@example
-(setq gc-cons-threshold 3500000)
-@end example
-@noindent
-
-in ~/.emacs. If you don't care about width of CJK
-characters or use Gnus 5.10 or younger together with a
-recent GNU Emacs, you should say
-
-@example
-(setq gnus-use-correct-string-widths nil)
-@end example
-@noindent
-
-in ~/.gnus.el (thanks to Jesper harder for the last
-two suggestions). Finally if you are still using 5.8.8
-or 5.9 and experience speed problems with summary
-buffer generation, you definitely should update to
-5.10 since there quite some work on improving it has
-been done.
-
-@node [9.3]
-@subsubheading Question 9.3
-
-Sending mail becomes slower and slower, what's up?
-
-@subsubheading Answer
-
-The reason could be that you told Gnus to archive the
-messages you wrote by setting
-gnus-message-archive-group. Try to use a nnml group
-instead of an archive group, this should bring you back
-to normal speed.
-
-@node FAQ - Glossary
-@subsection Glossary
-
-@table @dfn
-
-@item ~/.gnus.el
-When the term ~/.gnus.el is used it just means your Gnus
-configuration file. You might as well call it ~/.gnus or
-specify another name.
-
-@item Back End
-In Gnus terminology a back end is a virtual server, a layer
-between core Gnus and the real NNTP-, POP3-, IMAP- or
-whatever-server which offers Gnus a standardized interface
-to functions like "get message", "get Headers" etc.
-
-@item Emacs
-When the term Emacs is used in this FAQ, it means either GNU
-Emacs or XEmacs.
-
-@item Message
-In this FAQ message means a either a mail or a posting to a
-Usenet Newsgroup or to some other fancy back end, no matter
-of which kind it is.
-
-@item MUA
-MUA is an acronym for Mail User Agent, it's the program you
-use to read and write e-mails.
-
-@item NUA
-NUA is an acronym for News User Agent, it's the program you
-use to read and write Usenet news.
-
-@end table
-
-@ignore
-arch-tag: 64dc5692-edb4-4848-a965-7aa0181acbb8
-@end ignore
+++ /dev/null
-%!PS-Adobe-2.0 EPSF-2.0
-% Copyright (C) 2000, 2001, 2002, 2003, 2004, 2005, 2006, 2007
-% Free Software Foundation, Inc.
-%
-% Author: Luis Fernandes <elf@ee.ryerson.ca>
-%
-% 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 3, 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., 51 Franklin Street, Fifth Floor,
-% Boston, MA 02110-1301, USA.
-%
-%%Title: gnuslogo1.ps
-%%Creator: XV Version 3.00 Rev: 3/30/93 - by John Bradley
-%%BoundingBox: 0 0 493 505
-%%Pages: 1
-%%DocumentFonts:
-%%EndComments
-%%EndProlog
-
-%%Page: 1 1
-
-% remember original state
-/origstate save def
-
-% build a temporary dictionary
-20 dict begin
-
-% define string to hold a scanline's worth of data
-/pix 62 string def
-
-% lower left corner
-0 0 translate
-
-% size of image (on paper, in 1/72inch coords)
-493.0 505.0 scale
-
-% dimensions of data
-493 505 1
-
-% mapping matrix
-[493 0 0 -505 0 505]
-
-{currentfile pix readhexstring pop}
-image
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff01fffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff8003ffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff0000ffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff8000007ffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff0000003ffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffe0000000ffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff000000003fff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff000000000fff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffc0000000007ff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffff80000000003ff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffff00000000001ff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffe00000000000ff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffc00000000000ff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffff8000000000007f8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffff0000000000003f8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffff0000000000003f8
-fffffffffffffffffffffffffff800ffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffe0000000000001f8
-fffffffffffffffffffffffffff0001fffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffc0000000000000f8
-ffffffffffffffffffffffffffc00007ffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffc0000000000000f8
-ffffffffffffffffffffffffff000001ffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffff8000000000000078
-fffffffffffffffffffffffffe0000003ffffffffffff0001fffffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffff0000000000000038
-fffffffffffffffffffffffffc0000001fffffffffffe00007ffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffe0000000000000038
-fffffffffffffffffffffffff800000007ffffffffff800001ffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffe0000000000000038
-fffffffffffffffffffffffff000000003fffffffffe0000003fffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffc0000000000000018
-ffffffffffffffffffffffffe000000001fffffffff80000000fffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffc0000000000000018
-ffffffffffffffffffffffffc000000000ffffffffe000000003ffffffffffffffffffff
-fffffffffffffffffffffffffffffffffff80000000000000018
-ffffffffffffffffffffffff80000000007fffffff8000000000ffffffffffffffffffff
-fffffffffffffffffffffffffffffffffff80000000000000008
-ffffffffffffffffffffffff00000000003fffffff00000000007fffffffffffffffffff
-fffffffffffffffffffffffffffffffffff00000000000000008
-fffffffffffffffffffffffe00000000001ffffffe00000000001fffffffffffffffffff
-fffffffffffffffffffffffffffffffffff00000000000000008
-fffffffffffffffffffffffc00000000000ffffff8000000000007ffffffffffffffffff
-ffffffffffffffffffffffffffffffffffe00000000000000008
-fffffffffffffffffffffff8000000000007fffff0000000000007ffffffffffffffffff
-ffffffffffffffffffffffffffffffffffe00000000000000008
-fffffffffffffffffffffff0000000000001ffffe0000000000000ffffffffffffffffff
-ffffffffffffffffffffffffffffffffffc00000000000000000
-ffffffffffffffffffffffe0000000000000ffffc00000000000007fffffffffffffffff
-ffffffffffffffffffffffffffffffffffc00000000000000000
-ffffffffffffffffffffffc00000000000007fff800000000000001fffffffffffffffff
-ffffffffffffffffffffffffffffffffff800000000000000000
-ffffffffffffffffffffff800000000000003fff000000000000000fffffffffffffffff
-ffffffffffffffffffffffffffffffffff800000000000000000
-ffffffffffffffffffffff000000000000003fff0000000000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffff000040000000000000
-fffffffffffffffffffffe000000000000000ffe0000000000000001ffffffffffffffff
-ffffffffffffffffffffffffffffffffff0007ffc00000000000
-fffffffffffffffffffffc000000000000000ffc0000000000000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffe001ffffc0000000000
-fffffffffffffffffffffc0000000000000007fc00000000000000007fffffffffffffff
-fffffffffffffffffffffffffffffffffc003ffffe0000000000
-fffffffffffffffffffff80000000000000007f800000000000000003fffffffffffffff
-fffffffffffffffffffffffffffffffffc007fffffc000000000
-fffffffffffffffffffff00000000000000001f000000000000000001fffffffffffffff
-fffffffffffffffffffffffffffffffff800fffffff000000000
-ffffffffffffffffffffe00000000000000001f000000000000000000fffffffffffffff
-fffffffffffffffffffffffffffffffff801fffffff800000000
-ffffffffffffffffffffc00000000000000000e0000000000000000007ffffffffffffff
-fffffffffffffffffffffffffffffffff003ffffffff00000000
-ffffffffffffffffffff800000000000000000c0000000000000000003ffffffffffffff
-fffffffffffffffffffffffffffffffff007ffffffff00000000
-ffffffffffffffffffff00000000000000000000000000000000000000ffffffffffffff
-ffffffffffffffffffffffffffffffffe00fffffffff80000000
-fffffffffffffffffffe00000000000000000000000000000000000000ffffffffffffff
-ffffffffffffffffffffffffffffffffe01fffffffffc0000008
-fffffffffffffffffffc000000000000000000000000000000000000007fffffffffffff
-ffffffffffffffffffffffffffffffffc03fffffffffc0000008
-fffffffffffffffffff8000000000000000000000000000000000000001fffffffffffff
-ffffffffffffffffffffffffffffffffc07ffffffffff0000000
-fff9fffffffffffffff800000fe00000000000000000000000000000001fffffffffffff
-ffffffffffffffffffffffffffffffff807ffffffffff0000000
-fff9fffffffffffffff000001ff80000000000000000000000000000000fffffffffffff
-ffffffffffffffffffffffffffffffff80fffffffffff0000008
-fff0ffffffffffffffc000007ffc00000000000000000000000000000007ffffffffffff
-ffffffffffffffffffffffffffffffff81fffffffffff8000008
-fff0ffffffffffffffc00000fffc00000000000000000000000000000003ffffffffffff
-ffffffffffffffffffffffffffffffff01fffffffffff8000008
-ffe07fffffffffffff800001ffff00000000000000000000000000000001ffffffffffff
-ffffffffffffffffffffffffffffffff03fffffffffffc000008
-ffe07fffffffffffff00000fffffc0000000000000000000000000000000ffffffffffff
-fffffffffffffffffffffffffffffffe03fffffffffffc000008
-ffe03ffffffffffffc00001fffffe00000000000000000000000000000007fffffffffff
-fffffffffffffffffffffffffffffffe07fffffffffffe000008
-ffe03ffffffffffff800003ffffff00000000000000000000000000000003fffffffffff
-fffffffffffffffffffffffffffffffe07fffffffffffe000008
-ffc03ffffffffffff000007ffffff80000000000000f80000000000000003fffffffffff
-fffffffffffffffffffffffffffffffe0ffffffffffffe000008
-ffc01fffffffffffe00001fffffffe000000000000fffe000000000000001fffffffffff
-fffffffffffffffffffffffffffffffc0ffffffffffffe000008
-ffc00fffffffffffc00003ffffffff000000000001ffff800000000000000fffffffffff
-fffffffffffffffffffffffffffffffc1fffffffffffff000008
-ff800fffffffffff800003ffffffff800000000007ffffc000000000000007ffffffffff
-fffffffffffffffffffffffffffffffc3fffffffffffff000008
-ff8007fffffffffe00000fffffffffc0000000001ffffffc00000000000003ffffffffff
-fffffffffffffffffffffffffffffff87fffffffffffff000008
-ff8007fffffffffc00000fffffffffe0000000005ffffffe00000000000001ffffffffff
-fffffffffffffffffffffffffffffff87fffffffffffff000008
-ff8003fffffffff800001ffffffffff000000000ffffffffc0000000000000ffffffffff
-fffffffffffffffffffffffffffffff87fffffffffffff000008
-ff0001fffffffff000003ffffffffffc00000007fffffffff80000000000007fffffffff
-fffffffffffffffffffffffffffffff8ffffffffffffff000008
-ff0000ffffffffe000003ffffffffffc0000000ffffffffffc0000000000007fffffffff
-fffffffffffffffffffffffffffffffcffffffffffffff000008
-fe00007fffffff800000ffffffffffff0000001ffffffffffe0000000000001fffffffff
-ffffffffffffffffffffffffffffe7fdffffffffffffff000008
-fe00007fffffff000001ffffffffffff8000003fffffffffff0000000000001fffffffff
-ffffffffffffffffffffffffffffe7fdffffffffffffff000008
-fc00001ffffffc000003ffffffffffffc000007fffffffffffe0000000000007ffffffff
-ffffffffffffffffffffffffffffc7ffffffffffffffff000008
-fc00001ffffff0000003ffffffffffffe00000fffffffffffff0000000000007ffffffff
-fffffffffeffffffffffffffffff87ffffffffffffffff000008
-f800000fffffe0000007fffffffffffff00000fffffffffffff8000000000003ffffffff
-fffffffffcffffffffffffffffff87ffffffffffffffff000008
-f8000003ffff0000000ffffffffffffff80001fffffffffffffc000000000001ffffffff
-fffffffff8ffffffffffffffffff07ffffffffffffffff000008
-f8000001fffe0000001ffffffffffffff80001ffffffffffffff000000000000ffffffff
-fffffffff8fffffffffffffffffe0fffffffffffffffff000008
-f0000000fff00000003ffffffffffffffc0001ffffffffffffff8000000000007fffffff
-fffffffff0fffffffffffffffffe0fffffffffffffffff000018
-e00000001a000000007ffffffffffffffe0003ffffffffffffffc000000000003fffffff
-fffffffff0fffffffffffffffffc0fffffffffffffffff000018
-e000000000000000007fffffffffffffff0003ffffffffffffffc000000000003fffffff
-ffffffffe0fffffffffffffffffc1fffffffffffffffff000018
-c00000000000000000ffffffffffffffff0007ffffffffffffffe000000000001fffffff
-ffffffffe0fffffffffffffffff81fffffffffffffffff000018
-c00000000000000001ffffffffffffffff0007fffffffffffffff0000000000007ffffff
-ffffffffc0fffffffffffffffff83fffffffffffffffff000018
-800000000000000007ffffffffffffffff800ffffffffffffffffc000000000003ffffff
-ffffffff01fffffffffffffffff03fffffffffffffffff000038
-800000000000000007ffffffffffffffff800ffffffffffffffffe000000000001ffffff
-ffffffff01fffffffffffffffff03fffffffffffffffff800038
-00000000000000000fffffffffffffffffc00fffffffffffffffff000000000000ffffff
-fffffffe03ffffffffffffffffe07fffffffffffffffff800038
-00000000000000001fffffffffffffffffc01fffffffffffffffff8000000000007fffff
-fffffffc03ffffffffffffffffe07fffffffffffffffff800038
-00000000000000003fffffffffffffffffe03fffffffffffffffffc000000000003fffff
-fffffff803ffffffffffffffffc07fffffffffffffffff800038
-00000000000000007ffffffffffffffffff03fffffffffffffffffe000000000000fffff
-fffffff007ffffffffffffffffc0ffffffffffffffffff800038
-0000000000000000fffffffffffffffffff07ffffffffffffffffff000000000000fffff
-fffffff007ffffffffffffffff80ffffffffffffffffff800078
-0000000000000003ffffffffffffffff8ff87ffffffffffffffffff8000000000001ffff
-ffffffc00fffffffffffffffff81ffffffffffffffffff800078
-8000000000000007ffffffffffffffff0ff8fffffffffffffffffffc000000000000ffff
-ffffffc00fffffffffffffffff01ffffffffffffffffff8000f8
-8000000000000007fffffffffffffffe0ffffffffffffffffffffffe0000000000007fff
-ffffff801fffffffffffffffff03ffffffffffffffffff8000f8
-c00000000000001ffffffffffffffffc0fffffffffffffffffffffff0000000000001fff
-fffffe001ffffffffffffffffe07ffffffffffffffffff8000f8
-e00000000000007ffffffffffffffff83fffffffffffffffffffffffc0000000000007ff
-fffff8003ffffffffffffffffc07ffffffffffffffffff8000f8
-f00000000000007ffffffffffffffff03fffffffffffffffffffffffc0000000000001ff
-fffff0003ffffffffffffffff80fffffffffffffffffff8000f8
-f0000000000000fffffffffffffffff07fffffffffffffffffffffffe0000000000000ff
-ffffe0003ffffffffffffffff00fffffffffffffffffff8001f8
-f8000000000003ffffffffffffffffe07ffffffffffffffffffffffff00000000000000f
-ffff00007fffffffffffffffe01fffffffffffffffffff0001f8
-fc000000000007ffffffffffffffffc07ffffffffffffffffffffffff800000000000007
-fffc00007fffffffffffffffc01fffffffffffffffffff0001f8
-fc000000000007ffffffffffffffffc0fffffffffffffffffffffffff800000000000000
-ffe000007ffffbffffffffff801fffffffffffffffffff0001f8
-fe00000000001fffffffffffffffff03fffffffffffffffffffffffffe00000000000000
-00000000fffff3ffffffffff003fffffffffffffffffff0001f8
-fe00000000003fffffffffffffffff03ffffffffffffffffffffffffff00000000000000
-00000001fffff1fffffffffe003fffffffffffffffffff0003f8
-ff00000000007ffffffffffffffffe03ffffffffffffffffffffffffff00000000000000
-00000001ffffe1fffffffffc007fffffffffffffffffff0003f8
-ff8000000001fffffffffffffffffc07ffffffffffffffffffffffffff80000000000000
-00000003ffffe0fffffffff0007fffffffffffffffffff0003f8
-ffc000000003fffffffffffffffffc0fffffffffffffffffffffffffffc0000000000000
-00000003ffffc0ffffffffe0007fffffffffffffffffff0003f8
-ffe00000000ffffffffffffffffff81fffffffffffffffffffffffffffe0000000000000
-00000007ffffc07fffffff8000ffffffffffffffffffff0003f8
-fff00000003ffffffffffffffffff01ffffffffffffffffffffffffffff0000000000000
-00000007ffff803fffffff0000fffffffffffffffffffe0007f8
-fff8000000ffffffffffffffffffe03ffffffffffffffffffffffffffff8000000000000
-00000007ffff801ffffffc0001fffffffffffffffffffe0007f8
-fffc000001ffffffffffffffffffe07ffffffffffffffffffffffffffffc000000000000
-0000000fffff000ffffff80003fffffffffffffffffffe0007f8
-fffe00000fffffffffffffffffffc07ffffffffffffffffffffffffffffc000000000000
-0000000fffff0007ffffe00003fffffffffffffffffffe0007f8
-ffff80007fffffffffffffffffff80fffffffffffffffffffffffffffffe000000000000
-0000001ffffe0001ffff800007fffffffffffffffffffe000ff8
-ffffe007ffffffffffffffffffff80ffffffffffffffffffffffffffffff000000000000
-0000001ffffe0000fffc000007fffffffffffffffffffe000ff8
-ffffffffffffffffffffffffffff01ffffffffffffffffffffffffffffff800000000000
-0000003ffffe0000000000000ffffffffffffffffffffe000ff8
-fffffffffffffffffffffffffffe03ffffffffffffffffffffffffffffffc00000000000
-0000003ffffc0000000000000ffffffffffffffffffffe000ff8
-fffffffffffffffffffffffffffe03ffffffffffffffffffffffffffffffe00000000000
-0000007ffff80000000000001ffffffffffffffffffffe001ff8
-fffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffff00000000000
-0000007ffff80000000000001ffffffffffffffffffffe001ff8
-fffffffffffffffffffffffffff807fffffffffffffffffffffffffffffff80000000000
-000000fffff80000000000003ffffffffffffffffffffc001ff8
-fffffffffffffffffffffffffff80ffffffffffffffffffffffffffffffffc0000000000
-000003fffff00000000000007ffffffffffffffffffffc001ff8
-fffffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffe0000000000
-000007ffffe00000000000007ffffffffffffffffffffe003ff8
-fffffffffffffffffffffffffff01fffffffffffffffffffffffffffffffff0000000000
-000007ffffe0000000000000fffffffffffffffffffffc003ff8
-ffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffffff8000000000
-00001fffffc0000000000001fffffffffffffffffffffc003ff8
-ffffffffffffffffffffffffffc07fffffffffffffffffffffffffffffffffe000000000
-00001fffffc0000000000003fffffffffffffffffffffc003ff8
-ffffffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffff000000000
-00003fffff80000000000003fffffffffffffffffffffc007ff8
-ffffffffffffffffffffffffff01fffffffffffffffffffffffffffffffffff800000000
-00007fffff80000000000007fffffffffffffffffffffc007ff8
-ffffffffffffffffffffffffff03fffffffffffffffffffffffffffffffffffc00000000
-0000ffffff0000000000000ffffffffffffffffffffffc007ff8
-fffffffffffffffffffffffffe03fffffffffffffffffffffffffffffffffffc00000000
-0001ffffff0000000000001ffffffffffffffffffffffc007ff8
-fffffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffffff00000000
-0003fffffe0000000000001ffffffffffffffffffffff800fff8
-fffffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffff80000000
-0007fffffe0000000000003ffffffffffffffffffffff800fff8
-fffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffff0000000
-001ffffffc0000000000007ffffffffffffffffffffff800fff8
-fffffffffffffffffffffffff03ffffffffffffffffffffffffffffffffffffff8000000
-003ffffffc000000000000fffffffffffffffffffffff800fff8
-ffffffffffffffffffffffffe07ffffffffffffffffffffffffffffffffffffffe000000
-00fffffff8000000000003fffffffffffffffffffffff001fff8
-ffffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffff800000
-03fffffff8000000000003fffffffffffffffffffffff001fff8
-ffffffffffffffffffffffffc0ffffffffffffffffffffffffffffffffffffffffc00000
-07fffffff0000000000007fffffffffffffffffffffff001fff8
-ffffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffffffffc0000
-3ffffffff000000000000ffffffffffffffffffffffff003fff8
-ffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffffffffe03f
-fffffffff000000000003ffffffffffffffffffffffff003fff8
-ffffffffffffffffffffffff01ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffff800000000007ffffffffffffffffffffffff003fff8
-fffffffffffffffffffffffe03ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffff80000000000ffffffffffffffffffffffffe003fff8
-fffffffffffffffffffffffc07ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffc0000000003ffffffffffffffffffffffffe007fff8
-fffffffffffffffffffffffc0fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffe0000000007ffffffffffffffffffffffffe007fff8
-fffffffffffffffffffffff81fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffe000000000fffffffffffffffffffffffffe00ffff8
-fffffffffffffffffffffff01fffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffff000000001fffffffffffffffffffffffffe00ffff8
-ffffffffffffffffffffffe03ffffffffffffffffffffffffbffffffffffffffffffffff
-ffffffffff800000007fffffffffffffffffffffffffc00ffff8
-ffffffffffffffffffffffe07ffffffffffffffffffdfffff1ffffffffffffffffffffff
-ffffffffffc0000000ffffffffffffffffffffffffffc00ffff8
-ffffffffffffffffffffffe07ffffffffffffffffff9fffff07fffffffffffffffffffff
-ffffffffffe0000001ffffffffffffffffffffffffffc00ffff8
-ffffffffffffffffffffffc0ffffffffffffffffffe3ffffe03fffffffffffffffffffff
-fffffffffff800001fffffffffffffffffffffffffffc01ffff8
-ffffffffffffffffffffff81ffffffffffffffffffc7ffffc00fffffffffffffffffffff
-fffffffffffe00007fffffffffffffffffffffffffffc01ffff8
-ffffffffffffffffffffff81ffffffffffffffffff87ffffc007ffffffffffffffffffff
-ffffffffffff8003ffffffffffffffffffffffffffff801ffff8
-ffffffffffffffffffffff03ffffffffffffffffff0fffff8007ffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff803ffff8
-fffffffffffffffffffffe07fffffffffffffffffe0fffff8001ffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff803ffff8
-fffffffffffffffffffffe07fffffffffffffffffc1fffff0000ffffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff803ffff8
-fffffffffffffffffffffc0ffffffffffffffffff83ffffe00007fffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff007ffff8
-fffffffffffffffffffff81fffffffffffffffffe03ffffe00007fffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff007ffff8
-fffffffffffffffffffff83fffffffffffffffffc07ffffc00003fffffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffff007ffff8
-fffffffffffffffffffff03fffffffffffffffff80fffff800001fffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffe00fffff8
-ffffffffffffffffffffe07fffffffffffffffff00fffff800000fffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffe00fffff8
-ffffffffffffffffffffe0fffffffffffffffffe01fffff0000007ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffe00fffff8
-ffffffffffffffffffffc0fffffffffffffffffc01ffffe0000003ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffe00fffff8
-ffffffffffffffffffff81fffffffffffffffff803ffffe0000003ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffe01fffff8
-ffffffffffffffffffff81ffffffffffffffffe007ffffc0000003ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffc01fffff8
-ffffffffffffffffffff83ffffffffffffffffe007ffffc0000001ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffc01fffff8
-ffffffffffffffffffff07ffffffffffffffff800fffff80000000ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffc01fffff8
-fffffffffffffffffffe07ffffffffffffffff800fffff00000000ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffc03fffff8
-fffffffffffffffffffc0ffffffffffffffffe001fffff00000000ffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffff803fffff8
-fffffffffffffffffffc0ffffffffffffffffc003ffffe000000007fffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffff803fffff8
-fffffffffffffffffff81ffffffffffffffff0003ffffc000000007fffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffff007fffff8
-fffffffffffffffffff01fffffffffffffffe0007ffffc000000003fffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffff007fffff8
-fffffffffffffffffff03fffffffffffffffe000fffff8000000001fffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffff007fffff8
-ffffffffffffffffffe07fffffffffffffff8000fffff0000000001fffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffe00ffffff8
-ffffffffffffffffffc07fffffffffffffff0001fffff0000000001fffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffe00ffffff8
-ffffffffffffffffffc0fffffffffffffffe0001ffffe0000000000fffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffe00ffffff8
-ffffffffffffffffff80fffffffffffffff80003ffffe0000000000fffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffe01ffffff8
-ffffffffffffffffff81fffffffffffffff00007ffffc0000000000fffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffc01ffffff8
-ffffffffffffffffff81ffffffffffffffe00007ffffc00000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffc01ffffff8
-ffffffffffffffffff03ffffffffffffffc0000fffffc00000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffffc03ffffff8
-fffffffffffffffffe03ffffffffffffff00000fffffe00000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff803ffffff8
-fffffffffffffffffc07fffffffffffffe00001ffffff00000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff803ffffff8
-fffffffffffffffffc07fffffffffffffc00007ffffffc0000000007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff807ffffff8
-fffffffffffffffff807fffffffffffff00001fffffffe0000000003ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff807ffffff8
-fffffffffffffffff807ffffffffffffe00003ffffffff0000000003ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff007ffffff8
-fffffffffffffffff00fffffffffffff800007ffffffff8000000003ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff00fffffff8
-fffffffffffffffff00fffffffffffff00000fffffffffc000000001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffff00fffffff8
-ffffffffffffffffe00ffffffffffffc00003fffffffffe000000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffe01fffffff8
-ffffffffffffffffe00ffffffffffff800007ffffffffff000000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffe01fffffff8
-ffffffffffffffffc00ffffffffffff00000fffffffffff800000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffe01fffffff8
-ffffffffffffffff800fffffffffffc00001fffffffffffc00000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffe03fffffff8
-ffffffffffffffff800fffffffffff000007fffffffffffe00000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffe03fffffff8
-ffffffffffffffff001ffffffffffe00000fffffffffffff00000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffc07fffffff8
-ffffffffffffffff001ffffffffffc00001fffffffffffff80000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffc07fffffff8
-fffffffffffffffe000fffffffffe000003fffffffffffff80000001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff807fffffff8
-fffffffffffffffe000fffffffffc000007fffffffffffffc0000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff807fffffff8
-fffffffffffffffc000fffffffff800000ffffffffffffffe0000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff80ffffffff8
-fffffffffffffffc0007fffffffe000001fffffffffffffff0000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff80ffffffff8
-fffffffffffffffc0003fffffffc000003fffffffffffffff0000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff01ffffffff8
-fffffffffffffff80001fffffff8000007fffffffffffffff8000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff01ffffffff8
-fffffffffffffff80000ffffffc000001ffffffffffffffff8000000ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffff01ffffffff8
-fffffffffffffff800003fffff0000003ffffffffffffffffc000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffe01ffffffff8
-fffffffffffffff000000000000000007ffffffffffffffffc000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffe03ffffffff8
-ffffffffffffffe00000000000000000fffffffffffffffffe000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffe03ffffffff8
-ffffffffffffffe00000000000000001fffffffffffffffffe000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffc07ffffffff8
-ffffffffffffffc00000000000000003fffffffffffffffffe000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffc07ffffffff8
-ffffffffffffffc00000000000000007ffffffffffffffffff000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffc07ffffffff8
-ffffffffffffffc0000000000000000fffffffffffffffffff000000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffc0fffffffff8
-ffffffffffffff80000000000000003fffffffffffffffffff800000ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffffc0fffffffff8
-ffffffffffffff80000000000000007fffffffffffffffffff800001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff80fffffffff8
-ffffffffffffff8000000000000001ffffffffffffffffffff800001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff81fffffffff8
-ffffffffffffff8000000000000001ffffffffffffffffffffc00001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff81fffffffff8
-ffffffffffffff8000000000000003ffffffffffffffffffffe00001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff01fffffffff8
-ffffffffffffff000000000000000fffffffffffffffffffffe00001ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffff03fffffffff8
-ffffffffffffff000000000000001ffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffe03fffffffff8
-fffffffffffffe000000000000003ffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffe03fffffffff8
-fffffffffffffe000000000000007ffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffe03fffffffff8
-fffffffffffffc00000000000001fffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffe07fffffffff8
-fffffffffffffc00000000000007fffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffc07fffffffff8
-fffffffffffffc00000000000007fffffffffffffffffffffff00001ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffc07fffffffff8
-fffffffffffffc0000000000003ffffffffffffffffffffffff80003ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffc0ffffffffff8
-fffffffffffffc0000000000007ffffffffffffffffffffffff80003ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffc0ffffffffff8
-fffffffffffffc000000000000fffffffffffffffffffffffff80003ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff80ffffffffff8
-fffffffffffffc000000000003fffffffffffffffffffffffff80003ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff80ffffffffff8
-fffffffffffffc000000000007fffffffffffffffffffffffff80003ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff00ffffffffff8
-fffffffffffffc00000000001ffffffffffffffffffffffffff80007ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff01ffffffffff8
-fffffffffffffe00000000001ffffffffffffffffffffffffff80007ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffff01ffffffffff8
-fffffffffffffe0000000000fffffffffffffffffffffffffff80007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffe01ffffffffff8
-ffffffffffffff0000000001fffffffffffffffffffffffffff80007ffffffffffffffff
-ffffffffffffffffffffffffffffffffffffffe03ffffffffff8
-ffffffffffffff000000000ffffffffffffffffffffffffffff80007ffffffffffffffff
-fffffffffffffffffffdffffffffffffffffffe03ffffffffff8
-ffffffffffffff800000003ffffffffffffffffffffffffffff80007ffffffffffffffff
-fffffffffffffffffff9ffffffffffffffffffc03ffffffffff8
-ffffffffffffffe0000001fffffffffffffffffffffffffffff80007ffffffffffffffff
-fffffffffffffffffff1ffffffffffffffffff807ffffffffff8
-fffffffffffffff0000001fffffffffffffffffffffffffffff8000fffffffffffffffff
-fffffffffffffffffff1ffffffffffffffffff807ffffffffff8
-fffffffffffffff800000ffffffffffffffffffffffffffffffc000fffffffffffffffff
-fffffffffffffffffff1ffffffffffffffffff807ffffffffff8
-fffffffffffffffe0003fffffffffffffffffffffffffffffffc000fffffffffffffffff
-ffffffffffffffffffe1ffffffffffffffffff807ffffffffff8
-ffffffffffffffff4007fffffffffffffffffffffffffffffffc001fffffffffffffffff
-ffffffffffffffffffc1ffffffffffffffffff00fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff
-ffffffffffffffffff83ffffffffffffffffff00fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff
-ffffffffffffffffff83ffffffffffffffffff00fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff
-ffffffffffffffffff03ffffffffffffffffff00fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc001fffffffffffffffff
-ffffffffffffffffff03ffffffffffffffffff01fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff
-ffffffffffffffffff07ffffffffffffffffff01fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff
-fffffffffffffffffe07fffffffffffffffffe01fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc003fffffffffffffffff
-fffffffffffffffffc07fffffffffffffffffe03fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffffff
-fffffffffffffffffc07fffffffffffffffffc03fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffffff
-fffffffffffffffff80ffffffffffffffffffc03fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe007fffffffffffffffff
-fffffffffffffffff80ffffffffffffffffffc03fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe007fffffffffffffffff
-fffffffffffffffff80ffffffffffffffffffc03fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe00ffffffffffffffffff
-fffffffffffffffff03ffffffffffffffffff807fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe00ffffffffffffffffff
-ffffffffffffffffe01ffffffffffffffffff807fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe01ffffffffffffffffff
-ffffffffffffffffe03ffffffffffffffffff807fffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe01ffffffffffffffffff
-ffffffffffffffffc07ffffffffffffffffff00ffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe03ffffffffffffffffff
-ffffffffffffffffc07ffffffffffffffffff00ffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe03ffffffffffffffffff
-ffffffffffffffff80fffffffffffffffffff00ffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe07ffffffffffffffffff
-ffffffffffffffff80fffffffffffffffffff00ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff07ffffffffffffffffff
-ffffffffffffffff00ffffffffffffffffffe01ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff07ffffffffffffffffff
-fffffffffffffffe00ffffffffffffffffffe01ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff0fffffffffffffffffff
-fffffffffffffffe00ffffffffffffffffffe01ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff0fffffffffffffffffff
-fffffffffffffffc01ffffffffffffffffffc01ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffffffffff
-fffffffffffffffc03ffffffffffffffffffc01ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff3fffffffffffffffffff
-fffffffffffffffc03ffffffffffffffffffc03ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff7fffffffffffffffffff
-fffffffffffffff807ffffffffffffffffffc03ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffff807ffffffffffffffffff803ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffff00fffffffffffffffffff803ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffff00fffffffffffffffffff807ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffe01fffffffffffffffffff807ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffe03fffffffffffffffffff807ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffffc03fffffffffffffffffff807ffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffff807fffffffffffffffffff00fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffff807fffffffffffffffffff00fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffff00ffffffffffffffffffff00fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffff00fffffffffffffffffffe00fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffe01fffffffffffffffffffe01fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffe03fffffffffffffffffffe01fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffc03fffffffffffffffffffc01fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffc07fffffffffffffffffffc01fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffff807fffffffffffffffffffc03fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffff00ffffffffffffffffffffc03fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffff00ffffffffffffffffffff803fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffe01ffffffffffffffffffff803fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffe01ffffffffffffffffffff803fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffc03ffffffffffffffffffff807fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffffc03ffffffffffffffffffff007fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffff807ffffffffffffffffffff007fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffff807ffffffffffffffffffff007fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-ffffffffffff00fffffffffffffffffffff007fffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffe00ffffffffffffffffffffe00ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffe01ffffffffffffffffffffe00ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff9fffffffffffff
-fffffffffffc01ffffffffffffffffffffe00ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffff
-fffffffffffc03ffffffffffffffffffffe00ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffff1fffffffffffff
-fffffffffff803ffffffffffffffffffffc00ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffffe1fffffffffffff
-fffffffffff807ffffffffffffffffffffc00ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffffc1fffffffffffff
-fffffffffff00fffffffffffffffffffffc01ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffffc3fffffffffffff
-fffffffffff00fffffffffffffffffffffc01ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffff83fffffffffffff
-ffffffffffc01fffffffffffffffffffffc01ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff
-ffffffffffc01fffffffffffffffffffffc01ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff
-ffffffffff801fffffffffffffffffffff801ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffff07fffffffffffff
-ffffffffff803fffffffffffffffffffff801ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffe0ffffffffffffff
-ffffffffff003fffffffffffffffffffff803ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffc0ffffffffffffff
-fffffffffe007fffffffffffffffffffff803ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffffc1ffffffffffffff
-fffffffffc007fffffffffffffffffffff003ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffff81ffffffffffffff
-fffffffffc00ffffffffffffffffffffff003ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffff01ffffffffffffff
-fffffffff800ffffffffffffffffffffff003ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffff01ffffffffffffff
-fffffffff801ffffffffffffffffffffff003ffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffff03ffffffffffffff
-fffffffff803ffffffffffffffffffffff007ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffe07ffffffffffffff
-fffffffff003fffffffffffffffffffffe007ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffffc07ffffffffffffff
-ffffffffe007fffffffffffffffffffffe007ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffff807ffffffffffffff
-ffffffffc007fffffffffffffffffffffe007ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffff007ffffffffffffff
-ffffffffc007fffffffffffffffffffffe007ffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffff00fffffffffffffff
-ffffffff800ffffffffffffffffffffffe00fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffff00fffffffffffffff
-ffffffff000ffffffffffffffffffffffe00fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffe00fffffffffffffff
-fffffffe001ffffffffffffffffffffffe00fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffc01fffffffffffffff
-fffffffc003ffffffffffffffffffffffe00fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffffc01fffffffffffffff
-9ffffffc003ffffffffffffffffffffffe00fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffff803fffffffffffffff
-0ffffff8003ffffffffffffffffffffffc01fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffff003ffffffffffffffe
-07fffff0007ffffffffffffffffffffffc01fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffff003ffffffffffffffe
-07ffffe000fffffffffffffffffffffffc01fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffe007ffffffffffffff8
-03ffffc000fffffffffffffffffffffffc01fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffe007ffffffffffffff0
-03ffff8001fffffffffffffffffffffff801fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffffc007ffffffffffffff0
-01ffff0003fffffffffffffffffffffff803fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffe0
-00fffe0003fffffffffffffffffffffff803fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffe0
-00fffe0003fffffffffffffffffffffff803fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffff001ffffffffffffffc0
-003ffc0007fffffffffffffffffffffff003fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffe003ffffffffffffff80
-001fe0001ffffffffffffffffffffffff003fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffe003ffffffffffffff00
-000fc0001ffffffffffffffffffffffff007fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffe00
-000000001ffffffffffffffffffffffff007fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff8007fffffffffffffe00
-000000003ffffffffffffffffffffffff007fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff800ffffffffffffffc00
-000000003ffffffffffffffffffffffff007fffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffff000ffffffffffffff800
-000000007fffffffffffffffffffffffe007fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe001ffffffffffffff800
-000000007fffffffffffffffffffffffe007fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffe001ffffffffffffff000
-00000001ffffffffffffffffffffffffe007fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc003ffffffffffffff000
-00000001ffffffffffffffffffffffffe007fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffffc007fffffffffffffe000
-00000001ffffffffffffffffffffffffe007fffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffff0007fffffffffffffc000
-00000003ffffffffffffffffffffffffc00ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffff000ffffffffffffffc000
-00000003ffffffffffffffffffffffffc00ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffff8000
-00000007ffffffffffffffffffffffffc00ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffc001ffffffffffffff0000
-0000000fffffffffffffffffffffffffc01ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffffc003ffffffffffffff0000
-0000001fffffffffffffffffffffffffc01ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffff8003fffffffffffffe0000
-0000001fffffffffffffffffffffffffc01ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffff0007fffffffffffffe0000
-0000003fffffffffffffffffffffffffc01ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffffc0000
-0000007fffffffffffffffffffffffff801ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffff80000
-0000007fffffffffffffffffffffffff801ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffffc001ffffffffffffff80000
-000000ffffffffffffffffffffffffff801ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffff8001ffffffffffffff00000
-000001ffffffffffffffffffffffffff801ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff00000
-000001ffffffffffffffffffffffffff801ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff00000
-000003ffffffffffffffffffffffffff801ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffe0007fffffffffffffe00000
-000003ffffffffffffffffffffffffff801ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffe000ffffffffffffffe00000
-000007ffffffffffffffffffffffffff803ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffc00000
-00000fffffffffffffffffffffffffff003ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffff8001ffffffffffffff800000
-00000fffffffffffffffffffffffffff803ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffff0003ffffffffffffff800000
-00001fffffffffffffffffffffffffff803ffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffff0007ffffffffffffff000200
-00003fffffffffffffffffffffffffff007ffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffe0007fffffffffffffe000700
-00007fffffffffffffffffffffffffff00fffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffe001f80
-0000ffffffffffffffffffffffffffff00fffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe001f80
-0001ffffffffffffffffffffffffffff00fffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffc003fc0
-0001ffffffffffffffffffffffffffff00fffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffff0001ffffffffffffff8007fe0
-0003ffffffffffffffffffffffffffff01fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffff0007fe0
-0007ffffffffffffffffffffffffffff01fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffe0007ffffffffffffff000fff0
-0007ffffffffffffffffffffffffffff01fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffffc000ffffffffffffffe003fff8
-001fffffffffffffffffffffffffffff07fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe003fffc
-007fffffffffffffffffffffffffffff07fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffff8000ffffffffffffffe003fffe
-00ffffffffffffffffffffffffffffff07fffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffff0001ffffffffffffffc007ffff
-dfffffffffffffffffffffffffffffff0ffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffff800fffff
-fffffffffffffffffffffffffffffffe1ffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffff800fffff
-fffffffffffffffffffffffffffffffe1ffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffff001fffff
-fffffffffffffffffffffffffffffffe1ffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff003fffff
-fffffffffffffffffffffffffffffffe3ffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffe003fffff
-ffffffffffffffffffffffffffffffff3ffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffe0001ffffffffffffffc007fffff
-ffffffffffffffffffffffffffffffff3ffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffe0003ffffffffffffffc007fffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffffc0007ffffffffffffffc00ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff800ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffff8000fffffffffffffff801ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffe0000fffffffffffffff001ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffff003ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffffc0003ffffffffffffffe007ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffff80007ffffffffffffffe007ffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffff0000fffffffffffffffc00fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffff0000fffffffffffffffc00fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffe0001fffffffffffffffc00fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffff801fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffffc0003fffffffffffffff801fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffff80003fffffffffffffff003fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffff007fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffff007fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffffc007fffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffffc0001fffffffffffffffc00ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffff80003fffffffffffffffc01ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffff801ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffe0001ffffffffffffffff801ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffff803ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffffc0003ffffffffffffffff803ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffff80003fffffffffffffffe007ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffff80007fffffffffffffffe007ffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffffe00fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffff0000ffffffffffffffffc00fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffff801fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffff80003ffffffffffffffff803fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffff80003ffffffffffffffff003fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff003fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffffe007fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffe0000ffffffffffffffffc007fffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffffc0001ffffffffffffffffc00ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffff80007ffffffffffffffffc00ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff801ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffff00007ffffffffffffffff801ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffe0000fffffffffffffffff003ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffffc0001fffffffffffffffff003ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffff80003ffffffffffffffffe007ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffff80003ffffffffffffffffe007ffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffe00007ffffffffffffffffc00fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffe0000fffffffffffffffffc00fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffffe0000fffffffffffffffffc00fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffff80001fffffffffffffffff801fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffff00003fffffffffffffffff801fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffff00007fffffffffffffffff003fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffe00007fffffffffffffffff007fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffc0000ffffffffffffffffff007fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffffc0001fffffffffffffffffc007fffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffff80003fffffffffffffffffc00ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffff80007fffffffffffffffffc01ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffff00007fffffffffffffffff801ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffff0000ffffffffffffffffff801ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffffc0001ffffffffffffffffff803ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffff80003ffffffffffffffffff803ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffff00007ffffffffffffffffff007ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffff00007ffffffffffffffffff007ffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffe0000ffffffffffffffffffe00fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffc0000ffffffffffffffffffe00fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffffc0001ffffffffffffffffffe01fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffff80003ffffffffffffffffffc03fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffff00007ffffffffffffffffffc03fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffe00007ffffffffffffffffffc03fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffe00007ffffffffffffffffffc07fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffffc0001fffffffffffffffffff807fffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffff80003fffffffffffffffffff80ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffff80003fffffffffffffffffff80ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffff00007fffffffffffffffffff81ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffe0000ffffffffffffffffffff01ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffe0001ffffffffffffffffffff03ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffffc0003ffffffffffffffffffff03ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffff80003fffffffffffffffffffe07ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffff00007fffffffffffffffffffe07ffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffe00007fffffffffffffffffffe0fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffe0000ffffffffffffffffffffc0fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffe0000ffffffffffffffffffffc1fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffffc0001ffffffffffffffffffffc1fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffff80007ffffffffffffffffffff83fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffff00007ffffffffffffffffffff83fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffe00007ffffffffffffffffffff83fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffe0000fffffffffffffffffffff87fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffc0001fffffffffffffffffffff87fffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffffc0001fffffffffffffffffffff0ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffff80003fffffffffffffffffffff0ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffff00007fffffffffffffffffffff0ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffff0000ffffffffffffffffffffff1ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffe0000fffffffffffffffffffffe1ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffffc0001fffffffffffffffffffffe3ffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffff80003fffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffff00007fffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffff0000ffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffe0001ffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffe0001ffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffc0003ffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffffc0007ffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffff0000fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffff0000fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffe0001fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffc0003fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffc0003fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffffc0007fffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffff8000ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffff8001ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffff0001ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffff0003ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffff0003ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffe0007ffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffffc000fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff8001fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff8001fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff8003fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff8007fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff8007fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffff0007fffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffe000ffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffe001ffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffc001ffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffc007ffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffc00fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffffc01fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffff801fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffff003fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffff003fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffff007fffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffff00ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffe00ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffe01ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffc03ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffffc03ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffff807ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffff807ffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffff80fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffff00fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-fffffffffffffffffffffff01fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffe03fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffe07fffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffe0ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffc1ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffc1ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffffc3ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff83ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff87ffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff8fffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff8fffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff1fffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff1fffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-ffffffffffffffffffffff3fffffffffffffffffffffffffffffffffffffffffffffffff
-fffffffffffffffffffffffffffffffffffffffffffffffffff8
-
-
-showpage
-
-% stop using temporary dictionary
-end
-
-% restore original state
-origstate restore
-
-%%Trailer
+++ /dev/null
-\documentclass{article}
-
-% Previously we had five input LaTeX files (booklet.tex bk-lt.tex bk-a4.tex
-% refcard.tex gnusref.tex) and two logo files (gnuslogo-refcard.eps and
-% gnuslogo-booklet.eps).
-%
-% From this LaTeX file (gnus-refcard.tex) plus a single logo (gnus-logo.eps),
-% we can generate the refcard and the booklet version. This simplifies to
-% distribute the refcard with Emacs. Appropriate Makefile rules were added in
-% gnus/texi/Makefile.
-
-% For Emacs, we may use the following commands (w/o) using Gnus' Makefile:
-%
-% latex gnus-refcard.tex &&
-% dvips -t letter -f gnus-refcard.dvi > gnus-refcard.ps
-%
-% latex '\def\booklettrue{}\def\letterpapertrue{}\input{gnus-refcard}' &&
-% mv gnus-refcard.dvi gnus-booklet.dvi &&
-% dvips -t letter -f gnus-booklet.dvi > gnus-booklet.ps
-
-\usepackage{ifthen}
-\ifthenelse{\isundefined{\booklettrue}}{
- \typeout{Creating reference card...}
-}{
- \typeout{Creating reference booklet...}}
-
-\usepackage{supertabular}
-
-\newlength{\logowidth} \setlength{\logowidth} {6.861in}
-\newlength{\logoheight} \setlength{\logoheight}{7.013in}
-
-\usepackage{graphicx}
-
-\usepackage{geometry}
-
-\ifthenelse{\isundefined{\booklettrue}}{% ifcard %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- % Reference Card
-
- \def\Guide{Card}\def\guide{card}
- \def\logoscale{0.25}
-
- % Page setup for the refcard:
-
- % \setlength{\textwidth}{7.26in} \setlength{\textheight}{10in}
- % \setlength{\topmargin}{-1.0in}
- % % the same settings work for A4, although there is a bit of space at the
- % % top and bottom of the page.
- % \setlength{\oddsidemargin}{-0.5in} \setlength{\evensidemargin}{-0.5in}
-
- \ifthenelse{\isundefined{\letterpapertrue}}{
- \geometry{a4paper,hmargin=10mm,tmargin=10mm,bmargin=35mm}
- }{
- \geometry{hmargin=20mm,tmargin=10mm,bmargin=12mm}
- }
-
-}{ %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- % Reference Booklet
-
- \def\Guide{Booklet}\def\guide{booklet}
- \def\logoscale{0.5}% FIXME: too large for 2up printing? --rsteib
-
- \ifthenelse{\isundefined{\letterpapertrue}}{
- \geometry{a5paper,hmargin=10mm,tmargin=10mm,bmargin=4mm}
- }{
- \geometry{a5paper,hmargin=20mm,tmargin=10mm,bmargin=4mm}
- }
-
- \def\sec{\section}
- \def\subsec{\subsection}
- \def\subsubsec{\subsubsection}
- \def\blankpage{\vspace*{\fill}\par
- %\centerline{(This page intentionally left blank.)}
- \par\vspace*{\fill}\pagebreak}
-}%ifbooklet% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-% \input{gnusref} % % % % % % % % % % % % % % % % % % % % % % % % % %
-%% include file for the Gnus refcard and booklet
-
-\def\progver{5.10} % program version
-% \def\refver{5.10-2} % refcard version (not used)
-\def\date{April, 2006}
-\def\author{Gnus Bugfixing Girls + Boys $<$bugs@gnus.org$>$}
-
-%%
-\newlength{\keycolwidth}
-\newenvironment{keys}[1]% #1 is the widest key
-{\nopagebreak%\noindent%
- \settowidth{\keycolwidth}{#1}%
- \addtolength{\keycolwidth}{\tabcolsep}%
- \addtolength{\keycolwidth}{-\columnwidth}%
- \begin{supertabular}{@{}l@{\hspace{\tabcolsep}}p{-\keycolwidth}@{}}}%
- {\end{supertabular}\\}
-
-%% uncomment the first definition if you do not want pagebreaks in maps
-%%\newcommand{\esamepage}{\samepage}
-\newcommand{\esamepage}{}
-
-\newcommand*{\B}[1]{{\bf#1})} % bold l)etter
-
-\newcommand{\Title}{%
- \begin{center}
- {\bf\LARGE Gnus \progver\ Reference \Guide\\}
- %{\normalsize \Guide\ version \refver}
- \end{center}
- }
-
-% \newcommand*{\LogoOLD}[1]{\centerline{%
-% \makebox[\logoscale\logowidth][l]{\vbox to \logoscale\logoheight
-% {\vfill\epsfig{figure=gnuslogo-#1}}\vspace{-\baselineskip}}}}
-
-\newcommand*{\Logo}[1]{\centerline{%
- \includegraphics[width=\logoscale\logowidth]{gnus-logo}}}
-
-%% Contributions by:
-%% 1995 Vladimir Alexiev <vladimir@cs.ualberta.ca>
-%% 2000 Felix Natter <fnatter@gmx.net>
-%% 2001, 2002, 2003, 2005 \author.
-%% Original Gnus manual 1994 Lars Magne Ingebrigtsen
-%% Some material from Emacs Help Bindings feature (C-h b).
-%% Gnus logo by Luis Fernandes.
-\newcommand{\Copyright}{%
- \begin{center}
- Copyright \copyright\ 1995, 2000, 2002, 2003, 2004,
- 2005, 2006, 2007 Free Software Foundation, Inc.
- \end{center}
-
- Permission is granted to make and distribute copies of this reference
- \guide{} provided the copyright notice and this permission are preserved on
- all copies. Please send corrections, additions and suggestions to the
- current maintainer's email address. \Guide{} last edited on \date.
- }
-
-\newcommand{\Notes}{%
- \subsection*{Notes}
- {\esamepage
- Gnus is complex. Currently it has some 876 interactive (user-callable)
- functions. Of these 618 are in the two major modes (Group and
- Summary/Article). Many of these functions have more than one binding, some
- have 3 or even 4 bindings. The total number of keybindings is 677. So in
- order to save 40\% space, every function is listed only once on this
- \guide, under the ``more logical'' binding. Alternative bindings are given
- in parentheses in the beginning of the description.
-
- Many Gnus commands are affected by the numeric prefix. Normally you enter a
- prefix by holding the Meta key and typing a number, but in most Gnus modes
- you don't need to use Meta since the digits are not self-inserting. The
- prefixed behavior of commands is given in [brackets]. Often the prefix is
- used to specify:
-
- \quad [distance] How many objects to move the point over.
-
- \quad [scope] How many objects to operate on (including the current one).
-
- \quad [p/p] The ``Process/Prefix Convention'': If a prefix is given then it
- determines how many objects to operate on. Else if there are some objects
- marked with the process mark \#, these are operated on. Else only the
- current object is affected.
-
- \quad [level] A group subscribedness level. Only groups with a lower or
- equal level will be affected by the operation. If no prefix is given,
- `gnus-group-default-list-level' is used. If
- `gnus-group-use-permanent-levels', then a prefix to the `g' and `l'
- commands will also set the default level.
-
- \quad [score] An article score. If no prefix is given,
- `gnus-summary-default-score' is used. \\*[\baselineskip]
- % some keys
- Gnus startup-commands:\\*
- \begin{keys}{M-x gnus-unplugged}
- M-x gnus & start Gnus. \\
- M-x gnus-no-server & start Gnus without connecting to server
- (i.e. to read mail). \\
- \end{keys}
- Additionally, there are the two commands \texttt{gnus-plugged} and
- \texttt{gnus-unplugged}, which are only used if you want to download
- news and/or read previously downloaded news offline (see C-c C-i g Gnus
- Unplugged RET). Note: \texttt{gnus-no-server} ignores the stuff in
- \texttt{gnus-agent-directory}, and thus does not allow you to use Gnus
- Unplugged.
- %
- \begin{keys}{C-c C-i}
- C-c C-i & Go to the Gnus online {\bf info}.\\
- C-c C-b & Send a Gnus {\bf bug} report.\\
- \end{keys}
- }}
-
-\newcommand{\GroupLevels}{%
- The table below assumes that you use the default Gnus levels.
- Fill your user-specific levels in the blank cells.\\[1\baselineskip]
- \begin{tabular}{|c|l|l|}
- \hline
- Level & Groups & Status \\
- \hline
- 1 & draft/mail groups & \\
- 2 & mail groups & \\
- 3 & & subscribed \\
- 4 & & \\
- 5 & default list level & \\
- \hline
- 6 & & unsubscribed \\
- 7 & & \\
- \hline
- 8 & & zombies \\
- \hline
- 9 & & killed \\
- \hline
- \end{tabular}}
-
-\newcommand{\MarkCharacters}{%
- {\esamepage If a command directly sets a mark, it is shown in parentheses.\\*
- \newlength{\markcolwidth}
- \settowidth{\markcolwidth}{` '}% widest character
- \addtolength{\markcolwidth}{4\tabcolsep}
- \addtolength{\markcolwidth}{-\columnwidth}
- \newlength{\markdblcolwidth}
- \setlength{\markdblcolwidth}{\columnwidth}
- \addtolength{\markdblcolwidth}{-2\tabcolsep}
- \begin{tabular}{|c|p{-\markcolwidth}|}
- \hline
- \multicolumn{2}{|p{\markdblcolwidth}|}{{\bf ``Read'' Marks.}
- All these marks appear in the first column of the summary line, and so
- are mutually exclusive.}\\
- \hline
- ` ' & (M-u, M SPC, M c) Not read.\\
- ! & (!, M !, M t) Ticked (interesting).\\
- ? & (?, M ?) Dormant (only followups are interesting).\\
- E & (E, M e, M x) {\bf Expirable}. Only has effect in mail groups.\\
- G & (C, B DEL) Canceled article (or deleted in mailgroups).\\
- \$ & (M-d, M s x, S x). Marked as spam.\\
- \hline\hline
- \multicolumn{2}{|p{\markdblcolwidth}|}
- {The marks below mean that the article
- is read (killed, uninteresting), and have more or less the same effect.
- Some commands however explicitly differentiate between them (e.g.\ M
- M-C-r, adaptive scoring).}\\
- \hline
- r & (d, M d, M r) Deleted (marked as {\bf read}).\\
- C & (M C; M C-c; M H; c, Z c; Z n; Z C) Killed by {\bf catch-up}.\\
- F & SOUPed article. See the manual.\\
- O & {\bf Old} (read in a previous session).\\
- K & (k, M k; C-k, M K) {\bf Killed}.\\
- M & Article marked as read by duplicate suppression.\\
- Q & Article is part of a sparse thread (see ``Threading''
- in the manual).\\
- R & {\bf Read} (viewed in actuality).\\
- X & Killed by a kill file.\\
- Y & Killed due to low score.\\
- \hline\multicolumn{2}{c}{\vspace{1ex}}\\\hline
- \multicolumn{2}{|p{\markdblcolwidth}|}
- {{\bf Marks not affecting visibility}}\\
- \hline
- \# & (\#, M \#, M P p) Processable (will be affected by the next operation).
- [2]\\
- A & {\bf Answered} (followed-up or replied). [2]\\
- F & Forwarded. [2]\\
- $\ast$ & Cached. [2]\\
- S & Saved. [2]\\
- N & Recently arrived. [2]\\
- . & Unseen. [2]\\
- + & Over default score. [3]\\
- $-$ & Under default score. [3]\\
- $=$ & Has children (thread underneath it). Add `\%e' to
- `gnus-summary-line-format'. [3]\\
- \hline
- \end{tabular}
- }}
-
-\newcommand{\GroupModeGeneral}{%
- \begin{keys}{C-c M-C-x}
- RET & (=) Enter this group. [Prefix: how many (read) articles to fetch.
- Positive: newest articles, negative: oldest ones; non-numerical:
- view all articles, not just unread]\\
- M-RET & Enter group quickly.\\
- M-SPC & Same as RET but does not expunge and hide dormants.\\
- M-C-RET & Enter group without any processing, changes will not be permanent.\\
- SPC & Select this group and display the first (unread) article. [Same
- prefix as above.]\\
- ? & Give a very short help message.\\
- $<$ & Go to the beginning of the Group buffer.\\
- $>$ & Go to the end of the Group buffer.\\
- , & Jump to the lowest-level group with unread articles.\\
- . & Jump to the first group with unread articles.\\
- \^{} & Enter the Server buffer mode.\\
- a & Post an {\bf article} to a group
- [Prefix: use group under point to find posting-style].\\
- b & Find {\bf bogus} groups and delete them.\\
- c & Mark all unticked articles in this group as read ({\bf catch-up}).
- [p/p]\\
- g & Check the server for new articles ({\bf get}). [level]\\
- M-g & Check the server for new articles in this group ({\bf get}). [p/p]\\
- j & {\bf Jump} to a group.\\
- m & {\bf Mail} a message to someone
- [Prefix: use group under point to find posting-style].\\
- n & Go to the {\bf next} group with unread articles. [distance]\\
- M-n & Go to the {\bf next} group on the same or lower level.
- [distance]\\
- p & (DEL) Go to the {\bf previous} group with unread articles.
- [distance]\\
- M-p & Go to the {\bf previous} group on the same or lower level. [distance]\\
- q & {\bf Quit} Gnus.\\
- r & Re-read the init file ({\bf reset}).\\
- s & {\bf Save} the `.newsrc.eld' file (and `.newsrc' if
- `gnus-save-newsrc-file').\\
- z & Suspend (kill all buffers of) Gnus.\\
- B & {\bf Browse} a foreign server.\\
- C & Mark all articles in this group as read ({\bf Catch-up}). [p/p]\\
- F & {\bf Find} new groups and process them.\\
- N & Go to the {\bf next} group. [distance]\\
- P & Go to the {\bf previous} group. [distance]\\
- Q & {\bf Quit} Gnus without saving any startup (.newsrc) files.\\
- R & {\bf Restart} Gnus.\\
- Z & Clear the dribble buffer.\\
- M-c & Clear data from group (marks and list of read articles). \\
- C-c C-s & {\bf Sort} the groups by name, number of unread articles, or level
- (depending on `gnus-group-sort-function').\\
- C-c C-x & Run all expirable articles in this group through the {\bf expiry}
- process.\\
- C-c M-C-x & Run all articles in all groups through the {\bf expiry} process.\\
- C-c M-g & Activate all {\bf groups}.\\
- C-c C-i & Gnus online-manual ({\bf info}).\\
- C-x C-t & {\bf Transpose} two groups.\\
- H f & Fetch this group's {\bf FAQ} (using ange-ftp).\\
- H c & Display this group's {\bf charter}. [Prefix: query for group]\\
- H C & Display this group's {\bf control message} (using
- ange-ftp). [Prefix: query for group]\\
- H v & (V) Display the Gnus {\bf version} number.\\
- H d & (C-c C-d) Show the {\bf description} of this group
- [Prefix: re-read from server].\\
- M-d & {\bf Describe} all groups. [Prefix: re-read from server]\\
- D g & Regenerate a Sieve script from group parameters.\\
- D u & Regenerate Sieve script and {\bf upload} to server.\\
- \end{keys}
- }
-
-\newcommand{\ListGroups}{%
- {\esamepage
- \begin{keys}{A M}
- A d & (C-c C-M-a) List all groups whose names or {\bf descriptions} match a regexp.\\
- A k & (C-c C-l) List all {\bf killed} groups.
- [Prefix: look at active-file from server]\\
- A l & List all groups on a specific level.
- [Prefix: also list groups with no unread articles]\\
- A a & (C-c C-a) List all groups whose names match a regexp
- ({\bf apropos}).\\
- A A & List the server's active-file.\\
- A M & List groups that {\bf match} a regexp.\\
- A m & List groups that {\bf match} a regexp and have unread articles.
- [level]\\
- A s & (l) List all {\bf subscribed} groups with unread articles.
- [level; 5 and lower is the default]\\
- A u & (L) List all groups (including read and {\bf unsubscribed}).
- [level; 7 and lower is the default]\\
- A z & List all {\bf zombie} groups.\\
- A c & List all groups with cached articles. [level]\\
- A ? & List all groups with dormant articles. [level]\\
- \end{keys}
- }
-
- \newcommand{\CreateEditGroups}{%
- {\esamepage
- The select methods are indicated in parentheses.\\*
- \begin{keys}{G DEL}
- G a & Make the Gnus list {\bf archive} group. (nndir over ange-ftp)\\
- G c & {\bf Customize} this group's parameters.\\
- G d & Make a {\bf directory} group (every file must be a posting and files
- must have numeric names). (nndir)\\
- G D & Enter a {\bf directory} as a (temporary) group.
- (nneething without recording articles read)\\
- G e & (M-e) {\bf Edit} this group's select method.\\
- G E & {\bf Edit} this group's info (select method, articles read, etc).\\
- G f & Make a group based on a {\bf file}. (nndoc)\\
- G h & Make the Gnus {\bf help} (documentation) group. (nndoc)\\
- G k & Make a {\bf kiboze} group. (nnkiboze)\\
- G m & {\bf Make} a new group.\\
- G p & Edit this group's {\bf parameters}.\\
- G r & Rename this group (does not work with read-only groups!).\\
- G u & Create one of the groups mentioned in gnus-{\bf useful}-groups.\\
- G v & Add this group to a {\bf virtual} group. [p/p]\\
- G V & Make a new empty {\bf virtual} group. (nnvirtual)\\
- G w & Create ephemeral group based on web-search. [Prefix: make solid group
- instead]\\
- G R & Make an {\bf RSS} group.\\
- G DEL & {\bf Delete} group [Prefix: delete all articles as well].\\
- G x & Expunge all deleted articles in an nnimap mailbox.\\
- G l & Edit ACL (Access Control {\bf List}) for an nnimap mailbox.\\
- \end{keys}
- You can also create mail-groups and read your mail with Gnus (very useful
- if you are subscribed to mailing lists), using one of the methods
- nnmbox, nnbabyl, nnml, nnmh, or nnfolder. Read about it in the online info
- (C-c C-i g Reading Mail RET).
- }}
-
- % TODO:
- \newcommand{\SoupCommands}{%
- \begin{keys}{G s w}
- G s b & gnus-group-brew-soup: not documented.\\
- G s p & gnus-soup-pack-packet: not documented.\\
- G s r & nnsoup-pack-replies: not documented.\\
- G s s & gnus-soup-send-replies: not documented.\\
- G s w & gnus-soup-save-areas: not documented.\\
- \end{keys}}
-
- \newcommand{\MarkGroups}{%
- \begin{keys}{M m}
- M m & (\#) Set the process {\bf mark} on this group. [scope]\\
- M r & Mark all groups matching regular expression.\\
- M u & (M-\#) Remove the process mark from this group ({\bf unmark}).
- [scope]\\
- M U & Remove the process mark from all groups (\textbf{umark all}).\\
- M w & Mark all groups in the current region. [prefix: unmark]\\
- M b & Mark all groups in the {\bf buffer}. [prefix: unmark]\\
- \end{keys}}
-
- \newcommand{\GroupTopicsGeneral}{%
- {\esamepage
- Topics are ``categories'' for groups. Press t in the group-buffer to
- toggle gnus-topic-mode (C-c C-i g Group Topics RET).\\*
- \begin{keys}{C-c C-x}
- T n & Prompt for topic {\bf name} and create it.\\
- T m & {\bf Move} the current group to some other topic [p/p].\\
- T j & {\bf Jump} to a topic.\\
- T c & {\bf Copy} the current group to some other topic [p/p].\\
- T D & Remove (not delete) the current group [p/p].\\
- T M & {\bf Move} all groups matching a regexp to a topic.\\
- T C & {\bf Copy} all groups matching a regexp to a topic.\\
- T H & Toggle {\bf hiding} of empty topics.\\
- T r & {\bf Rename} a topic.\\
- T DEL & Delete an empty topic.\\
- T \# & Mark all groups in the current topic with the process-mark.\\
- T M-\# & Remove the process-mark from all groups in the current topic.\\
- T TAB & (TAB) Indent current topic [Prefix: unindent].\\
- M-TAB & Unindent the current topic.\\
- RET & (SPC) Either unfold topic or enter group [level].\\
- T s & {\bf Show} the current topic. [Prefix: show permanently]\\
- T h & {\bf Hide} the current topic. [Prefix: hide permanently]\\
- C-c C-x & Expire all articles in current group or topic.\\
- C-k & {\bf Kill} a group or topic.\\
- C-y & {\bf Yank} a group or topic.\\
- A T & List active-file using {\bf topics}.\\
- G p & Edit topic-{\bf parameters}.\\
- T M-n & Go to {\bf next} topic. [distance]\\
- T M-p & Go to {\bf previous} topic. [distance]\\
- \end{keys}
- }
- }
-
- \newcommand{\TopicSorting}{%
- {\esamepage
- \begin{keys}{T S m}
- T S a & Sort {\bf alphabetically}.\\
- T S u & Sort by number of {\bf unread} articles.\\
- T S l & Sort by group {\bf level}.\\
- T S v & Sort by group score ({\bf value}).\\
- T S r & Sort by group {\bf rank}.\\
- T S m & Sort by {\bf method}.\\
- T S e & Sort by {\bf server} name.\\
- T S s & Sort according to `gnus-group-sort-function'.\\
- \end{keys}
- With a prefix these commands will sort in reverse order.
- }
- }
-
- \newcommand{\SubscribeKillYankGroups}{%
- {\esamepage
- \begin{keys}{S C-k}
- S k & (C-k) {\bf Kill} this group.\\
- S l & Set the {\bf level} of this group. [p/p]\\
- S s & (U) Prompt for a group and toggle its {\bf subscription}.\\
- S t & (u) {\bf Toggle} subscription to this group. [p/p]\\
- S w & (C-w) Kill all groups in the region.\\
- S y & (C-y) {\bf Yank} the last killed group.\\
- S z & Kill all {\bf zombie} groups.\\
- S C-k & Kill all groups on a certain level.\\
- \end{keys}
- }
- }
-
- \newcommand{\SummaryModeGeneral}{%
- {\esamepage
- \begin{keys}{M-RET}
- SPC & (A SPC, A n) Select an article, scroll it one page, move to the
- next one.\\
- DEL & (A DEL, A p, b) Scroll this article one page back. [distance]\\
- RET & (A RET) Scroll this article one line forward. [distance]\\
- M-RET & (A M-RET) Scroll this article one line backward. [distance]\\
- = & Expand the Summary window (fullsize).
- [Prefix: shrink to display article window]\\
- %
- \& & Execute a command on all articles whose header matches a regexp.
- [Prefix: move backwards]\\
- M-\& & Execute a command on all articles having the process mark.\\
- %
- M-n & (G M-n) Go to the {\bf next} summary line of an unread article.
- [distance]\\
- M-p & (G M-p) Go to the {\bf previous} summary line of an unread article.
- [distance]\\
- M-s & {\bf Search} through all subsequent articles for a regexp.\\
- M-r & Search through all previous articles for a regexp.\\
- %
- A P & {\bf Postscript}-print current buffer.\\
- %
- M-k & Edit this group's {\bf kill} file.\\
- M-K & Edit the general {\bf kill} file.\\
- %
- C-t & Toggle {\bf truncation} of summary lines.\\
- Y g & Regenerate the summary-buffer.\\
- Y c & Insert all cached articles into the summary-buffer.\\
- %
- M-C-e & {\bf Edit} the group-parameters.\\
- M-C-a & Customize the group-parameters.\\
- %
- % article handling
- %
- A $<$ & ($<$, A b) Scroll to the beginning of this article.\\
- A $>$ & ($>$, A e) Scroll to the end of this article.\\
- A s & (s) Perform an i{\bf search} in the article buffer.\\
- %
- A D & (C-d) Un{\bf digestify} this article into a separate group.
- [Prefix: force digest]\\
- M-C-d & Like C-d, but open several documents in nndoc-groups, wrapped
- in an nnvirtual group [p/p]\\
- %
- A g & (g) (Re)fetch this article ({\bf get}). [Prefix: get raw version]\\
- A r & (\^{}, A \^{}) Fetch the parent(s) of this article.
- [Prefix: if positive fetch \textit{n} ancestors;
- negative: fetch only the \textit{n}th ancestor]\\
- A t & {\bf Translate} this article.\\
- A R & Fetch all articles mentioned in the {\bf References}-header.\\
- A T & Fetch full \textbf{thread} in which the current article appears.\\
- M-\^{} & Fetch the article with a given Message-ID.\\
- S y & {\bf Yank} the current article into an existing message-buffer.
- [p/p]\\
- A M & Setup group parameters for {\bf mailing} lists from
- headers. [Prefix: replace old settings]\\
- \end{keys}
- }
- }
-
- \newcommand{\MIMESummary}{%
- {\esamepage
- For the commands operating on one MIME part (a subset of gnus-article-*), a
- prefix selects which part to operate on. If the point is placed over a
- MIME button in the article buffer, use the corresponding bindings for the
- article buffer instead.
-
- \begin{keys}{W M w}
- K v & (b, W M b) {\bf View} the MIME-part.\\
- K o & {\bf Save} the MIME part.\\
- K c & {\bf Copy} the MIME part.\\
- K e & View the MIME part {\bf externally}.\\
- K i & View the MIME part {\bf internally}.\\
- K $\mid$ & Pipe the MIME part to an external command.\\
- K b & Make all the MIME parts have buttons in front of them.\\
- K m & Try to repair {\bf multipart-headers}.\\
- K C & View the MIME part using a different {\bf charset}.\\
- X m & Save all parts matching a MIME type to a directory. [p/p]\\
- M-t & Toggle the buttonized display of the article buffer.\\
- W M w & Decode RFC2047-encoded words in the article headers.\\
- W M c & Decode encoded article bodies. [Prefix: prompt for charset]\\
- W M v & View all MIME parts in the current article.\\
- \end{keys}
- }
- }
-
- \newcommand{\SortSummary}{%
- {\esamepage
- \begin{keys}{C-c C-s C-a}
- C-c C-s C-a & Sort the summary-buffer by {\bf author}.\\
- % C-c C-s C-t & Sort the summary-buffer by {\bf recipient}.\\ % No Gnus
- C-c C-s C-d & Sort the summary-buffer by {\bf date}.\\
- C-c C-s C-i & Sort the summary-buffer by article score.\\
- C-c C-s C-l & Sort the summary-buffer by amount of {\bf lines}.\\
- C-c C-s C-c & Sort the summary-buffer by length.\\
- C-c C-s C-n & Sort the summary-buffer by article {\bf number}.\\
- C-c C-s C-s & Sort the summary-buffer by {\bf subject}.\\
- C-c C-s C-r & Sort the summary-buffer {\bf randomly}.\\
- C-c C-s C-o & Sort the summary-buffer using the default method.\\
- \end{keys}
- With a prefix these functions sort in reverse order.
- }
- }
-
- \newcommand{\MailGroups}{% formerly \Bsubmap
- {\esamepage
- These commands (except `B c') are only valid in a mail group.\\*
- \begin{keys}{B M-C-e}
- B DEL & (B backspace, B delete) {\bf Delete} the mail article from disk (!).
- [p/p]\\
- B B & Crosspost this article to another group.\\
- B c & {\bf Copy} this article from any group to a mail group. [p/p]\\
- B e & {\bf Expire} all expirable articles in this group. [p/p]\\
- B i & {\bf Import} a random file into this group.\\
- B I & Create an empty article in this group.\\
- B m & {\bf Move} the article from one mail group to another. [p/p]\\
- B p & Query whether the article was {\bf posted} as well.\\
- B q & {\bf Query} where the article will end up after fancy splitting\\
- B r & {\bf Respool} this mail article. [p/p]\\
- B t & {\bf Trace} the fancy splitting patterns applied to this article.\\
- B w & (e) Edit this article.\\
- B M-C-e & {\bf Expunge} (delete from disk) all expirable articles in this group
- (!). [p/p]\\
- K E & {\bf Encrypt} article body. [p/p]\\
- \end{keys}
- }
- }
-
- \newcommand{\DraftGroup}{% formerly \Dsubmap
- {\esamepage
- The ``drafts''-group contains messages that have been saved but not sent
- and rejected articles. \\*
- \begin{keys}{B DEL}
- D e & \textbf{edit} message.\\
- D s & \textbf{Send} message. [p/p]\\
- D S & \textbf{Send} all messages.\\
- D t & \textbf{Toggle} sending (mark as unsendable).\\
- B DEL & \textbf{Delete} message (like in mailgroup).\\
- \end{keys}
- }
- }
-
- \newcommand{\SelectArticles}{% formerly \Gsubmap
- {\esamepage
- These commands select the target article. They do not understand the prefix.\\*
- \begin{keys}{G C-n}
- h & Enter article-buffer.\\
- G b & (,) Go to the {\bf best} article (the one with highest score).\\
- G f & (.) Go to the {\bf first} unread article.\\
- G n & (n) Go to the {\bf next} unread article.\\
- G p & (p) Go to the {\bf previous} unread article.\\
- %
- G N & (N) Go to {\bf the} next article.\\
- G P & (P) Go to the {\bf previous} article.\\
- %
- G C-n & (M-C-n) Go to the {\bf next} article with the same subject.\\
- G C-p & (M-C-p) Go to the {\bf previous} article with the same subject.\\
- %
- G l & (l) Go to the previously read article ({\bf last-read-article}).\\
- G o & Pop an article off the summary history and go to it.\\
- %
- G g & Search an article via subject.\\
- G j & (j) Search an article via Message-Id or subject.\\
- \end{keys}
- }
- }
-
- \newcommand{\ArticleModeGeneral}{%
- {\esamepage
- The normal navigation keys work in Article mode. Some additional keys are:\\
- \begin{keys}{C-c RET}
- C-c \^{} & Get the article with the Message-ID near point.\\
- C-c RET & Send reply to address near point.\\
- h & Go to the \textbf{header}-line of the article in the
- summary-buffer.\\
- s & Go to \textbf{summary}-buffer.\\
- RET & (middle mouse button) Activate the button at point to follow
- an URL or Message-ID.\\
- TAB & Move the point to the next button.\\
- M-TAB & Move point to previous button.\\
- \end{keys}
- }
- }
-
- \newcommand{\WashArticle}{% formerly \Wsubmap
- {\esamepage
- \begin{keys}{W W H}
- W 6 & Translate a base64 article.\\
- W a & Strip certain {\bf headers} from body.\\
- W b & Make Message-IDs and URLs in the article mouse-clickable
- {\bf buttons}.\\
- W c & Translate CRLF-pairs to LF and then the remaining CR's to LF's.\\
- W d & Treat {\bf dumbquotes}.\\
- W e & Treat {\bf emphasized} text.\\
- W h & Treat {\bf HTML}.\\
- W l & (w) Remove page breaks ({\bf\^{}L}) from the article.\\
- W m & {\bf Morse} decode article.\\
- W o & Treat {\bf overstrike} or underline (\^{}H\_) in the article.\\
- W p & Verify X-{\bf PGP}-Sig header.\\
- W q & Treat {\bf quoted}-printable in the article.\\
- W r & (C-c C-r) Do a Caesar {\bf rotate} (rot13) on the article.\\
- W s & Verify (and decrypt) a {\bf signed} message.\\
- W t & (t) {\bf Toggle} display of all headers.\\
- W u & {\bf Unsplit} broken URLs.\\
- W v & (v) Toggle permanent {\bf verbose} displaying of all headers.\\
- W w & Do word {\bf wrap} in the article.\\
- W B & Add clickable {\bf buttons} to the article headers.\\
- W C & {\bf Capitalize} first word in each sentence.\\
- W Q & Fill long lines.\\
- W Z & Translate a HZ-encoded article.\\
- %
- W G u & {\bf Unfold} folded header lines.\\
- W G f & {\bf Fold} all header lines.\\
- W G n & Unfold {\bf Newsgroups:} and Follow-Up-To:.\\
- %
- W Y c & Repair broken {\bf citations}.\\
- W Y a & Repair broken {\bf attribution} lines.\\
- W Y u & {\bf Unwrap} broken citation lines.\\
- W Y f & Do a {\bf full} deuglification (W Y c, W Y a, W Y u).\\
- \end{keys}
- }
- }
-
- \newcommand{\BlankAndWhitespace}{%
- {\esamepage
- \begin{keys}{W E w}
- W E l & Strip blank {\bf lines} from the beginning of the article.\\
- W E m & Replace blank lines with empty lines and remove {\bf multiple}
- blank lines.\\
- W E t & Remove {\bf trailing} blank lines.\\
- W E a & Strip blank lines at the beginning and the end
- (W E l, W E m and W E t).\\
- W E A & Strip {\bf all} blank lines.\\
- W E s & Strip leading blank lines from the article body.\\
- W E e & Strip trailing blank lines from the article body.\\
- W E w & Remove leading {\bf whitespace} from all headers.\\
- \end{keys}
- }
- }
-
- \newcommand{\Picons}{%
- {\esamepage
- \begin{keys}{W D D}
- W D s & (W g) Display {\bf smilies}.\\
- W D x & (W f) Look for and display any X-{\bf Face} headers.\\
- W D d & Display any Face headers.\\
- W D n & Toggle picons in {\bf Newsgroups} and Followup-To.\\
- W D m & Toggle picons in {\bf mail} headers (To and Cc).\\
- W D f & Toggle picons in {\bf From}.\\
- W D D & Remove all images from the article buffer.\\
- \end{keys}
- }
- }
-
- \newcommand{\TimeAndDate}{%
- {\esamepage
- \begin{keys}{W T u}
- W T u & (W T z) Display the article timestamp in GMT ({\bf UT, ZULU}).\\
- W T i & Display the article timestamp in {\bf ISO} 8601.\\
- W T l & Display the article timestamp in the {\bf local} timezone.\\
- W T s & Display according to `gnus-article-time-format'.\\
- W T e & Display the time {\bf elapsed} since it was sent.\\
- W T o & Display the {\bf original} timestamp.\\
- W T p & Display the date in format that's {\bf
- pronounceable} in English.\\
- \end{keys}
- }
- }
-
- \newcommand{\HideHighlightArticle}{%
- {\esamepage
- \begin{keys}{W W C-c}
- W W a & Hide {\bf all} unwanted parts. Calls W W h, W W s, W W C-c.\\
- W W h & Hide article {\bf headers}.\\
- W W b & Hide {\bf boring} headers.\\
- W W s & Hide {\bf signature}.\\
- W W l & Hide {\bf list} identifiers in subject-header.\\
- W W P & Hide {\bf PEM} (privacy enhanced messages).\\
- W W B & Hide banner specified by group parameter.\\
- W W c & Hide {\bf citation}.\\
- W W C-c & Hide {\bf citation} using a more intelligent algorithm.\\
- W W C & Hide cited text in articles that aren't roots.\\
- W H a & Highlight {\bf all} parts. Calls W b, W H c, W H h, W H s.\\
- W H c & Highlight article {\bf citations}.\\
- W H h & Highlight article {\bf headers}.\\
- W H s & Highlight article {\bf signature}.\\
- \end{keys}
- For all hiding-commands: A positive prefix always hides, and a negative
- prefix will show what was previously hidden.
- }}
-
- \newcommand{\MIMEArticleMode}{%
- {\esamepage
- \begin{keys}{RET}
- RET & (BUTTON-2) Toggle display of the MIME object.\\
- v & Prompt for a method and then view object using this method.\\
- o & Prompt for a filename and save the MIME object.\\
- C-o & Prompt for a filename to save the MIME object to and remove it.\\
- d & {\bf Delete} the MIME object.\\
- c & {\bf Copy} the MIME object to a new buffer and display this buffer.\\
- i & Display the MIME object in this buffer.\\
- C & Copy the MIME object to a new buffer and display this buffer using {\bf Charset} \\
- E & View internally. \\
- e & View {\bf externally}. \\
- t & View the MIME object as a different {\bf type}.\\
- p & {\bf Print} the MIME object.\\
- $\mid$ & Pipe the MIME object to a process.\\
- . & Take action on the MIME object.\\
- \end{keys}
- }
- }
-
- %% end of article mode for reading ..........................................
-
- \newcommand{\MarkArticlesGeneral}{% formerly \Msubmap
- {\esamepage
- \begin{keys}{M M-C-r}
- d & (M d, M r) Mark this article as read and move to the next one.
- [scope]\\
- D & Mark this article as read and move to the previous one. [scope]\\
- ! & (u, M !, M t) Tick this article (mark it as interesting) and move
- to the next one. [scope]\\
- U & Tick this article and move to the previous one. [scope]\\
- M ? & (?) Mark this article as dormant (only followups are
- interesting). [scope]\\
- M D & Show all {\bf dormant} articles (normally they are hidden unless they
- have any followups).\\
- M M-D & Hide all {\bf dormant} articles.\\
- C-w & Mark all articles between point and mark as read.\\
- M-u & (M SPC, M c) Clear all marks from this article and move to the next
- one. [scope]\\
- M-U & Clear all marks from this article and move to the previous one.
- [scope]\\
- %
- M e & (E, M x) Mark this article as {\bf expirable}. [scope]\\
- %
- M k & (k) {\bf Kill} all articles with the same subject then select the
- next unread one.\\
- M K & (C-k) {\bf Kill} all articles with the same subject as this one.\\
- %
- M C & {\bf Catch-up} the articles that are not ticked and not dormant.\\
- M C-c & {\bf Catch-up} all articles in this group.\\
- M H & {\bf Catch-up} (mark read) this group to point (to-{\bf here}).\\
- %
- M b & Set a {\bf bookmark} in this article.\\
- M B & Remove the {\bf bookmark} from this article.\\
- %
- M M-r & (x) Expunge all {\bf read} articles from this group.\\
- M M-C-r & Expunge all articles having a given mark.\\
- M S & (C-c M-C-s) {\bf Show} all expunged articles.\\
- M M C-h & Displays some more keys doing ticking slightly differently.\\
- \end{keys}
- The variable `gnus-summary-goto-unread' controls what happens after a mark
- has been set (C-x C-i g Setting Marks RET)
- }}
-
- \newcommand{\MarkByScore}{%
- \begin{keys}{M V m}
- M V c & {\bf Clear} all marks from all high-scored articles. [score]\\
- M V k & {\bf Kill} all low-scored articles. [score]\\
- M V m & Mark all high-scored articles with a given {\bf mark}. [score]\\
- M V u & Mark all high-scored articles as interesting (tick them). [score]\\
- \end{keys}
- }
- }
-
-\newcommand{\ProcessMark}{%
- {\esamepage
- These commands set and remove the process mark (\#). You only need to use
- it if the set of articles you want to operate on is non-contiguous. Else
- use a numeric prefix.\\*
- \begin{keys}{M P R}
- M P p & (\#, M \#) Mark this article.\\
- M P u & (M-\#, M M-\#) \textbf{unmark} this article.\\
- M P b & Mark all articles in {\bf buffer}.\\
- M P r & Mark all articles in the {\bf region}.\\
- M P g & Unmark all articles in the region.\\
- M P R & Mark all articles matching a {\bf regexp}.\\
- M P G & Unmark all articles matching a regexp.\\
- M P t & Mark all articles in this (sub){\bf thread}.\\
- M P T & Unmark all articles in this (sub){\bf thread}.\\
- M P s & Mark all articles in the current {\bf series}.\\
- M P S & Mark all {\bf series} that already contain a marked article.\\
- M P a & Mark {\bf all} articles (in series order).\\
- M P U & \textbf{unmark} all articles.\\
- M P i & {\bf Invert} the list of process-marked articles.\\
- M P k & Push the current process-mark set onto stack and unmark
- all articles.\\
- M P y & Pop process-mark set from stack and restore it.\\
- M P w & Push process-mark set on the stack.\\
- M P v & Mark all articles with score over the default score. [Prefix: score]\\
- \end{keys}
- }
- }
-
-\newcommand{\Limiting}{%
- {\esamepage
- \begin{keys}{/M}
- // & (/s) Limit the summary-buffer to articles matching {\bf subject}.\\
- /a & Limit the summary-buffer to articles matching {\bf author}.\\
- /x & Limit depending on ``extra'' headers.\\
- /u & (x) Limit to {\bf unread} articles.
- [Prefix: also exclude ticked and dormant articles]\\
- /. & Limit to unseen articles.\\
- /m & Limit to articles marked with specified {\bf mark}.\\
- /t & Ask for a number and exclude articles younger than that many days.
- [Prefix: exclude older articles]\\
- /n & Limit to current article. [p/p]\\
- /w & Pop the previous limit off the stack and restore it.
- [Prefix: pop all limits]\\
- /v & Limit to score. [score]\\
- /E & (M S) Include all expunged articles in the limit.\\
- /D & Include all dormant articles in the limit.\\
- /* & Limit to cached articles.\\
- Y C & Include all cached articles in the limit.\\
- /d & Exclude all dormant articles from the limit.\\
- /M & Exclude all marked articles.\\
- /T & Include all articles from the current thread in the limit.\\
- /c & Exclude all dormant articles that have no children from the limit.\\
- /C & Mark all excluded unread articles as read.
- [Prefix: also mark ticked and dormant articles]\\
- /o & Insert all {\bf old} articles. [Prefix: how many]\\
- /N & Insert all {\bf new} articles.\\
- /p & Limit to articles {\bf predicated} in the `display' group parameter.\\
- % /r & Limit to {\bf replied} articles. [Prefix: unreplied]\\ % No Gnus
- \end{keys}
- }
- }
-
-\newcommand{\OutputArticles}{% formerly \Osubmap
- {\esamepage
- \begin{keys}{O m}
- O o & (o, C-o) Save this article using the default article saver. [p/p]\\
- O b & Save this article's {\bf body} in plain file format [p/p]\\
- O f & Save this article in plain {\bf file} format. [p/p]\\
- O F & like O f, but overwrite file's contents. [p/p]\\
- O h & Save this article in {\bf mh} folder format. [p/p]\\
- O m & Save this article in {\bf mail} format. [p/p]\\
- O r & Save this article in {\bf rmail} format. [p/p]\\
- O v & Save this article in {\bf vm} format. [p/p]\\
- O p & ($\mid$) {\bf Pipe} this article to a shell command. [p/p]\\
- O P & \textbf{Print} this article using Muttprint. [p/p]\\
- \end{keys}
- }
- }
-
-\newcommand{\PostReplyetc}{% formerly \Ssubmap
- {\esamepage
- These commands put you in a separate news or mail buffer. See the section
- about composing messages for more information.\\*
- %After
- %editing the article, send it by pressing C-c C-c. If you are in a
- %foreign group and want to post the article using the foreign server, give
- %a prefix to C-c C-c.\\*
- \begin{keys}{S O m}
- S p & (a) {\bf Post} an article to this group.\\
- S f & (f) Post a {\bf followup} to this article.\\
- S F & (F) Post a {\bf followup} and include the original. [p/p]\\
- S o p & Forward this article as a {\bf post} to a newsgroup.\\
- S M-c & Send a complaint about excessive crossposting to the author of this
- article. [p/p]\\
- %
- S m & (m) Send a {\bf mail} to some other person.\\
- S r & (r) Mail a {\bf reply} to the author of this article.\\
- S R & (R) Mail a {\bf reply} and include the original. [p/p]\\
- S B r & Like S r but ignore the Reply-To: header.\\
- S B R & Like S R but ignore the Reply-To: header.\\
- S w & Mail a {\bf wide} reply to this article.\\
- S W & Mail a {\bf wide} reply to this article and include
- the original.\\
- S v & Mail a {\bf very} wide reply to this article.\\
- S V & Mail a {\bf very} wide reply to this article and include the original.\\
- S o m & (C-c C-f) Forward this article by {\bf mail} to a person.\\
- S D b & Resend {\bf bounced} mail.\\
- S D r & {\bf Resend} mail to a different person.\\
- S D e & {\bf Edit} and resend.\\
- %
- S n & Post a followup via {\bf news} even if you got the message
- through mail.\\
- S N & Post a followup via {\bf news} and include the original mail.
- [p/p]\\
- %
- S c & (C) {\bf Cancel} this article (only works if it is
- your own). [p/p]\\
- S s & {\bf Supersede} this article with a new one (only for own
- articles).\\
- %
- S O m & Digest these series and forward by {\bf mail}. [p/p]\\
- S O p & Digest these series and forward as a {\bf post} to a newsgroup.
- [p/p]\\
- %
- S u & {\bf Uuencode} a file and post it as a series.\\
- \end{keys}
- If you want to cancel or supersede an article you just posted (before it
- has appeared on the server), go to the *post-news* buffer, change
- `Message-ID' to `Cancel' or `Supersedes' and send it again with C-c C-c.
- }}
-
-\newcommand{\Threading}{% formerly \Tsubmap
- {\esamepage
- \begin{keys}{T M-\#}
- T \# & Mark this thread with the process mark.\\
- T M-\# & Remove process-marks from this thread.\\
- %
- T t & Re-{\bf thread} the current article's thread.\\
- T \^{} & Make the current article child of the marked (or previous) article.\\
- % movement
- T n & (M-C-f, M-down) Go to the {\bf next} thread. [distance]\\
- T p & (M-C-b, M-up) Go to the {\bf previous} thread. [distance]\\
- T d & {\bf Descend} this thread. [distance]\\
- T u & Ascend this thread ({\bf up}-thread). [distance]\\
- T o & Go to the top of this thread.\\
- %
- T s & {\bf Show} the thread hidden under this article.\\
- T h & {\bf Hide} this (sub)thread.\\
- %
- T i & {\bf Increase} the score of this thread.\\
- T l & (M-C-l) {\bf Lower} the score of this thread.\\
- %
- T k & (M-C-k) {\bf Kill} the current (sub)thread. [Negative prefix:
- tick it, positive prefix: unmark it.]\\
- %
- T H & {\bf Hide} all threads.\\
- T S & {\bf Show} all hidden threads.\\
- T T & (M-C-t) {\bf Toggle} threading.\\
- \end{keys}
- }
- }
-
-\newcommand{\Scoring}{% formerly \Vsubmap
- {\esamepage
- Read about Adaptive Scoring in the online info.\\*
- \begin{keys}{\bf A p m l}
- V a & {\bf Add} a new score entry, specifying all elements.\\
- V c & Specify a new score file as {\bf current}.\\
- V e & {\bf Edit} the current score alist.\\
- V f & Edit a score {\bf file} and make it the current one.\\
- V m & {\bf Mark} all articles below a given score as read.\\
- V s & Set the {\bf score} of this article.\\
- V t & Display all score rules applied to this article ({\bf track}).\\
- W w & List {\bf words} used in scoring.\\
- V x & {\bf Expunge} all low-scored articles. [score]\\
- V C & {\bf Customize} the current score file through a user-friendly
- interface.\\
- V F & {\bf Flush} the cache of score files.\\
- V R & {\bf Re-score} the summary buffer.\\
- V S & Display the {\bf score} of this article.\\
- \bf A p m l& Make a scoring entry based on this article.\\
- \end{keys}
- The four letters stand for:\\*
- \quad \B{A}ction: I)ncrease, L)ower;\\*
- \quad \B{p}art: a)uthor (from), s)ubject, x)refs (cross-posting), d)ate, l)ines,
- message-i)d, t)references (parent), f)ollowup, b)ody, h)ead (all headers);\\*
- \quad \B{m}atch type:\\*
- \qquad string: s)ubstring, e)xact, r)egexp, f)uzzy,\\*
- \qquad date: b)efore, a)t, n)this,\\*
- \qquad number: $<$, =, $>$;\\*
- \quad \B{l}ifetime: t)emporary, p)ermanent, i)mmediate.
-
- If you type the second letter in uppercase, the remaining two are assumed
- to be s)ubstring and t)emporary.
- If you type the third letter in uppercase, the last one is assumed to be
- t)emporary.
-
- \quad Extra keys for manual editing of a score file:\\*
- \begin{keys}{C-c C-c}
- C-c C-c & Finish editing the score file.\\
- C-c C-d & Insert the current {\bf date} as number of days.\\
- \end{keys}
- }
- }
-
-\newcommand{\ExtractSeries}{% formerly \Xsubmap
- {\esamepage
- Gnus recognizes if the current article is part of a series (multipart
- posting whose parts are identified by numbers in their subjects, e.g.{}
- 1/10\dots10/10) and processes the series accordingly. You can mark and
- process more than one series at a time. If the posting contains any
- archives, they are expanded and gathered in a new group.\\*
- \begin{keys}{X p}
- X b & Un-{\bf binhex} these series. [p/p]\\
- X o & Simply {\bf output} these series (no decoding). [p/p]\\
- X p & Unpack these {\bf postscript} series. [p/p]\\
- X s & Un-{\bf shar} these series. [p/p]\\
- X u & {\bf Uudecode} these series. [p/p]\\
- \end{keys}
-
- Each one of these commands has four variants:\\*
- \begin{keys}{X v \bf Z}
- X \bf z & Decode these series. [p/p]\\
- X \bf Z & Decode and save these series. [p/p]\\
- X v \bf z & Decode and view these series. [p/p]\\
- X v \bf Z & Decode, save and view these series. [p/p]\\
- \end{keys}
- where {\bf z} or {\bf Z} identifies the decoding method (b, o, p, s, u).
-
- An alternative binding for the most-often used of these commands is\\*
- \begin{keys}{C-c C-v C-v}
- C-c C-v C-v & (X v u) Uudecode and view these series. [p/p]\\
- \end{keys}
- }}
-
-\newcommand{\ExitSummary}{% formerly \Zsubmap
- {\esamepage
- \begin{keys}{Z G}
- Z Z & (q, Z Q) Exit this group.\\
- Z E & (Q) {\bf Exit} without updating the group information.\\
- %
- Z c & (c) Mark all unticked articles as read ({\bf catch-up}) and exit.\\
- Z C & Mark all articles as read ({\bf catch-up}) and exit.\\
- %
- Z n & Mark all articles as read and go to the {\bf next} group.\\
- Z N & Exit and go to {\bf the} next group.\\
- Z P & Exit and go to the {\bf previous} group.\\
- %
- Z G & (M-g) Check for new articles in this group ({\bf get}).\\
- Z R & (C-x C-s) Exit this group, and then enter it again ({\bf reenter}).
- [Prefix: select all articles, read and unread.]\\
- Z s & Update and save the dribble buffer. [Prefix: save .newsrc* as well]\\
- \end{keys}
- }
- }
-
-\newcommand{\MsgCompositionGeneral}{%
- Press C-c ? in the composition-buffer to get this information.\\*
- {\esamepage
- \begin{keys}{C-c C-m}
- % sending
- C-c C-c & Send message and exit. [Prefix: send via foreign server]\\
- C-c C-s & Send message. [Prefix: send via foreign server]\\
- C-c C-d & Don't send message (save as \textbf{draft}).\\
- C-c C-k & \textbf{Kill} message-buffer.\\
- C-c C-m & {\bf Mail} reply to the address near point.
- [Prefix: include the original]\\
- % modify headers/body
- C-c C-o & Sort headers.\\
- C-c C-e & \textbf{Elide} region.\\
- C-c C-v & Kill everything outside region.\\
- C-c C-r & Do a \textbf{Rot-13} on the body.\\
- C-c C-w & Insert signature (from `message-signature-file').\\
- C-c C-z & Kill everything up to signature.\\
- C-c C-y & \textbf{Yank} original message.\\
- C-c C-q & Fill the yanked message.\\
- C-c M-C-y & \textbf{Yank} a buffer and quote it.\\
- M-RET & Insert four newlines and format quoted text. [Prefix:
- justify as well]\\
- C-c M-r & \textbf{Rename} message buffer. [Prefix: ask for new name]\\
- \end{keys}
- }
- }
-
-\newcommand{\MsgCompositionMovementArticle}{%
- The following functions create the header-field if necessary.\\*
- {\esamepage
- \begin{keys}{C-c C-f C-u}
- C-c TAB & Move to \textbf{signature}.\\
- C-c C-b & Move to \textbf{body}.\\
- C-c C-f C-t & (C-c C-t) Move to \textbf{To:}.\\
- C-c C-f C-c & Move to \textbf{Cc:}.\\
- C-c C-f C-b & Move to \textbf{Bcc:}.\\
- C-c C-f C-w & Move to \textbf{Fcc:}.\\
- C-c C-f C-s & Move to \textbf{Subject:}.\\
- C-c C-f C-r & Move to \textbf{Reply-To:}.\\
- C-c C-f C-f & Move to \textbf{Followup-To:}.\\
- C-c C-f C-n & (C-c C-n) Move to \textbf{Newsgroups:}.\\
- C-c C-f C-u & Move to \textbf{Summary:}.\\
- C-c C-f C-k & Move to \textbf{Keywords:}.\\
- C-c C-f C-d & Move to \textbf{Distribution:}.\\
- C-c C-f C-m & Move to \textbf{Mail-Followup-To:}.\\
- C-c C-f C-o & Move to \textbf{From:}.\\
- C-c C-f C-a & Insert a reasonable \textbf{Mail-Followup-To:} for
- an unsubscribed list. [Prefix: include addresses in \textbf{Cc:}]\\
- C-c C-f TAB & (C-c C-u) Move to \textbf{Importance:}.\\
- C-c M-n & Insert \textbf{Disposition-Notification-To:}
- (request receipt).\\
- \end{keys}
- }
- }
-
-\newcommand{\MsgCompositionMML}{%
- {\esamepage
- \begin{keys}{C-c C-m P}
- C-c C-m f & (C-c C-a) Attach \textbf{file}.\\
- C-c C-m b & Attach contents of \textbf{buffer}.\\
- C-c C-m e & Attach \textbf{external} file (ftp..).\\
- C-c C-m P & Create MIME-\textbf{preview} (new
- buffer). [Prefix: show raw MIME preview]\\
- C-c C-m v & \textbf{Validate} article.\\
- C-c C-m p & Insert \textbf{part}.\\
- C-c C-m m & Insert \textbf{multi}-part.\\
- C-c C-m q & \textbf{Quote} region.\\
- C-c C-m c s & Encrypt message using \textbf{S/MIME}.\\
- C-c C-m c o & Encrypt message using PGP.\\
- C-c C-m c p & Encrypt message using \textbf{PGP/MIME}.\\
- C-c C-m s s & Sign message using \textbf{S/MIME}.\\
- C-c C-m s o & Sign message using PGP.\\
- C-c C-m s p & Sign message using \textbf{PGP/MIME}.\\
- C-c C-m C-n & Remove security related MML tags from message.\\
- % TODO: narrow headers (C-c C-m n) ?
- \end{keys}
- }
- }
-
-%% TODO:
-\newcommand{\ServerMode}{%
- {\esamepage
- To enter this mode, press \^{} while in Group mode.\\*
- \begin{keys}{SPC}
- SPC & (RET) Browse this server.\\
- a & {\bf Add} a new server.\\
- c & {\bf Copy} this server.\\
- e & {\bf Edit} a server.\\
- k & {\bf Kill} this server. [scope]\\
- l & {\bf List} all servers.\\
- q & Return to the group buffer ({\bf quit}).\\
- s & Request that the server scan its sources for new articles.\\
- g & Request that the server regenerate its data.\\
- y & {\bf Yank} the previously killed server.\\
- O & Try to {\bf open} a connection to this server.\\
- C & {\bf Close} connection to this server.\\
- D & Mark this server as unreachable ({\bf deny}).\\
- M-o & {\bf Open} the connection to all servers.\\
- M-c & {\bf Close} the connection to all servers.\\
- R & Make all denied servers into closed servers.\\
- L & Set server status to offline.\\
- \end{keys}
- }
- }
-
-\newcommand{\BrowseServer}{%
- {\esamepage
- To enter this mode, press `B' while in Group mode.\\*
- \begin{keys}{RET}
- RET & Enter the current group.\\
- SPC & Enter the current group and display the first article.\\
- ? & Give a very short help message.\\
- n & Go to the {\bf next} group. [distance]\\
- p & Go to the {\bf previous} group. [distance]\\
- q & (l) {\bf Quit} browse mode.\\
- u & Subscribe to the current group. [scope]\\
- \end{keys}
- }
- }
-
-\newcommand{\GroupUnplugged}{%
- {\esamepage
- \begin{keys}{J S}
- J j & Toggle plugged-state.\\
- J s & Fetch articles from all groups for offline-reading.\\
- J u & Fetch all eligible articles from this group.\\
- J S & \textbf{Send} all sendable messages in the drafts group.\\
- %
- J c & Enter \textbf{category} buffer.\\
- J a & \textbf{Add} this group to an Agent category [p/p].\\
- J r & \textbf{Remove} this group from its Agent category [p/p].\\
- J Y & Synchronize flags changed while unplugged with remote server.\\
- \end{keys}
- }
- }
-
-\newcommand{\SummaryUnplugged}{%
- {\esamepage
- \begin{keys}{J M-\#}
- J \# & \textbf{Mark} the article for downloading.\\
- J M-\# & \textbf{Unmark} the article for downloading.\\
- @ & \textbf{Toggle} whether to download the article.\\
- J c & Mark all undownloaded articles as read (\textbf{catch-up}).\\
- J u & Download all downloadable articles from group.\\
- \end{keys}
- }
- }
-
-\newcommand{\ServerUnplugged}{%
- {\esamepage
- \begin{keys}{J a}
- J a & \textbf{Add} the current server to the list of servers covered
- by the agent.\\
- J r & \textbf{Remove} the current server from the list of servers covered
- by the agent.\\
- \end{keys}
- }
- }
-
-% end {gnusref} % % % % % % % % % % % % % % % % % % % % % % % % % %
-
-
-% o some things might not be updated: scoring and server modes, maybe more
-% o Gnus Unplugged category-buffer commands need to be written
-
-\begin{document}
-
-\ifthenelse{\isundefined{\booklettrue}}{ % %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- \raggedbottom\raggedright
- \twocolumn
- % use \tiny to shrink it to 4 pages (needs a high-resolution printer though)
- % \tiny
- \scriptsize
- \pagestyle{plain}
- \Title
- \par
- \Logo{refcard}
-}{
- \setcounter{page}{0}
- \thispagestyle{empty}
- \vspace*{\fill}
- \Title
- \vspace{0.4in}
- \Logo{booklet}
- \vspace*{\fill}
- \pagebreak
-}%ifbooklet% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-% TODO: how does this work ?
-%\tableofcontents
-
-\Notes
-%
-
-\section*{Group-Mode}
-\GroupModeGeneral
- \subsection*{Group Subscribedness-Levels}
- \GroupLevels
- \subsection*{List Groups}
- \ListGroups
- \subsection*{Create/Edit Foreign Groups}
- \CreateEditGroups
- \subsection*{Unsubscribe, Kill and Yank Groups}
- \SubscribeKillYankGroups
- \subsection*{Mark Groups}
- \MarkGroups
- \subsection*{Group-Unplugged}
- \GroupUnplugged
-% topics in group-mode
- \subsection*{Group Topics}
- \GroupTopicsGeneral
- \subsubsection*{Topic Sorting}
- \TopicSorting
-
-% \ifthenelse{\isundefined{\booklettrue}}{}{\pagebreak}
-
-% summary-mode
-\section*{Summary Mode}
-\SummaryModeGeneral
- \subsection*{Select Articles}
- \SelectArticles
-%
- \subsection*{Threading}
- \Threading
-%
- \subsection*{Limiting}
- \Limiting
- \subsection*{Sort the Summary-Buffer}
- \SortSummary
- \subsection*{Score (Value) Commands}
- \Scoring
-
-\ifthenelse{\isundefined{\booklettrue}}{% ifcard %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- \subsection*{Output Articles}
- \OutputArticles
- \subsection*{Extract Series (Uudecode etc)}
- \ExtractSeries
-}{}%ifcard% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
- \subsection*{MIME operations from the Summary-Buffer}
- \MIMESummary
-
-\ifthenelse{\isundefined{\booklettrue}}{}{% ifbooklet %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
- \subsection*{Extract Series (Uudecode etc)}
- \ExtractSeries
- \subsection*{Output Articles}
- \OutputArticles
-}%ifbooklet% %%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%
-
-%
- \subsection*{Post, Followup, Reply, Forward, Cancel}
- \PostReplyetc
-
-\ifthenelse{\isundefined{\booklettrue}}{\newpage}{}% newpage ifcard
-
- \subsection*{Message Composition}
-
- \MsgCompositionGeneral
- \subsubsection*{Jumping in message-buffer}
- \MsgCompositionMovementArticle
- \subsubsection*{Attachments/MML}
- \MsgCompositionMML
-% marking articles
- \subsection*{Mark Articles}
- \MarkArticlesGeneral
- \subsubsection*{Mark Based on Score}
- \MarkByScore
- \subsubsection*{The Process Mark}
- \ProcessMark
- \subsubsection*{Mark Indication-Characters}
- \MarkCharacters
-%
-\ifthenelse{\isundefined{\booklettrue}}{\newpage}{}%
-
- \subsection*{Summary-Unplugged}
- \SummaryUnplugged
- \subsection*{Mail-Group Commands}
- \MailGroups
- \subsection*{Draft-Group Commands}
- \DraftGroup
-% exiting
- \subsection*{Exit the Summary-Buffer}
- \ExitSummary
-%
-%
-\section*{Article Mode (reading)}
-\ArticleModeGeneral
- \subsection*{Wash the Article-Buffer}
- \WashArticle
- \subsubsection*{Blank Lines and Whitespace}
- \BlankAndWhitespace
- \subsubsection*{Picons, X-faces, Smileys}
- \Picons
- \subsubsection*{Time and Date}
- \TimeAndDate
- \subsection*{Hide/Highlight Parts of the Article}
- \HideHighlightArticle
- \subsection*{MIME operations from the Article-Buffer (reading)}
- \MIMEArticleMode
-%
-%
-\section*{Server Mode}
-\ServerMode
- \subsection*{Unplugged-Server}
- \ServerUnplugged
-%
-%
-\section*{Browse Server Mode}
-\BrowseServer
-
-%\pagebreak
-\vspace*{\fill}
-\Copyright
-
-\end{document}
-
-%%% Local Variables:
-%%% mode: latex
-%%% TeX-master: t
-%%% End:
-
-% arch-tag: be438b0e-6832-4afb-8c56-5f84743e5cd1
+++ /dev/null
-\input texinfo
-
-@setfilename gnus
-@settitle Gnus Manual
-@syncodeindex fn cp
-@syncodeindex vr cp
-@syncodeindex pg cp
-
-@copying
-Copyright @copyright{} 1995, 1996, 1997, 1998, 1999, 2000, 2001,
-2002, 2003, 2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software. Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License. If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@iftex
-@iflatex
-\documentclass[twoside,a4paper,openright,11pt]{book}
-\usepackage[latin1]{inputenc}
-\usepackage{pagestyle}
-\usepackage{epsfig}
-\usepackage{pixidx}
-\input{gnusconfig.tex}
-
-\ifx\pdfoutput\undefined
-\else
-\usepackage[pdftex,bookmarks,colorlinks=true]{hyperref}
-\usepackage{thumbpdf}
-\pdfcompresslevel=9
-\fi
-
-\makeindex
-\begin{document}
-
-% Adjust ../Makefile.in if you change the following line:
-\newcommand{\gnusversionname}{Gnus v5.10.10}
-\newcommand{\gnuschaptername}{}
-\newcommand{\gnussectionname}{}
-
-\newcommand{\gnusbackslash}{/}
-
-\newcommand{\gnusref}[1]{``#1'' on page \pageref{#1}}
-\ifx\pdfoutput\undefined
-\newcommand{\gnusuref}[1]{\gnustt{#1}}
-\else
-\newcommand{\gnusuref}[1]{\href{#1}{\gnustt{#1}}}
-\fi
-\newcommand{\gnusxref}[1]{See ``#1'' on page \pageref{#1}}
-\newcommand{\gnuspxref}[1]{see ``#1'' on page \pageref{#1}}
-
-\newcommand{\gnuskindex}[1]{\index{#1}}
-\newcommand{\gnusindex}[1]{\index{#1}}
-
-\newcommand{\gnustt}[1]{{\gnusselectttfont{}#1}}
-\newcommand{\gnuscode}[1]{\gnustt{#1}}
-\newcommand{\gnusasis}[1]{\gnustt{#1}}
-\newcommand{\gnusurl}[1]{\gnustt{#1}}
-\newcommand{\gnuscommand}[1]{\gnustt{#1}}
-\newcommand{\gnusenv}[1]{\gnustt{#1}}
-\newcommand{\gnussamp}[1]{``{\fontencoding{OT1}\gnusselectttfont{}#1}''}
-\newcommand{\gnuslisp}[1]{\gnustt{#1}}
-\newcommand{\gnuskbd}[1]{`\gnustt{#1}'}
-\newcommand{\gnuskey}[1]{`\gnustt{#1}'}
-\newcommand{\gnusfile}[1]{`\gnustt{#1}'}
-\newcommand{\gnusdfn}[1]{\textit{#1}}
-\newcommand{\gnusi}[1]{\textit{#1}}
-\newcommand{\gnusr}[1]{\textrm{#1}}
-\newcommand{\gnusstrong}[1]{\textbf{#1}}
-\newcommand{\gnusemph}[1]{\textit{#1}}
-\newcommand{\gnusvar}[1]{{\fontsize{10pt}{10}\selectfont\textsl{\textsf{#1}}}}
-\newcommand{\gnussc}[1]{\textsc{#1}}
-\newcommand{\gnustitle}[1]{{\huge\textbf{#1}}}
-\newcommand{\gnusversion}[1]{{\small\textit{#1}}}
-\newcommand{\gnusauthor}[1]{{\large\textbf{#1}}}
-\newcommand{\gnusresult}[1]{\gnustt{=> #1}}
-\newcommand{\gnusacronym}[1]{\textsc{#1}}
-\newcommand{\gnusemail}[1]{\textit{#1}}
-
-\newcommand{\gnusbullet}{{${\bullet}$}}
-\newcommand{\gnusdollar}{\$}
-\newcommand{\gnusampersand}{\&}
-\newcommand{\gnuspercent}{\%}
-\newcommand{\gnushash}{\#}
-\newcommand{\gnushat}{\symbol{"5E}}
-\newcommand{\gnusunderline}{\symbol{"5F}}
-\newcommand{\gnusnot}{$\neg$}
-\newcommand{\gnustilde}{\symbol{"7E}}
-\newcommand{\gnusless}{{$<$}}
-\newcommand{\gnusgreater}{{$>$}}
-\newcommand{\gnusbraceleft}{{$>$}}
-\newcommand{\gnusbraceright}{{$>$}}
-
-\newcommand{\gnushead}{\raisebox{-1cm}{\epsfig{figure=ps/gnus-head,height=1cm}}}
-\newcommand{\gnusinteresting}{
-\marginpar[\mbox{}\hfill\gnushead]{\gnushead}
-}
-
-\newcommand{\gnuscleardoublepage}{\ifodd\count0\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage\else\clearpage\fi}
-
-\newcommand{\gnuspagechapter}[1]{
-{\mbox{}}
-}
-
-\newdimen{\gnusdimen}
-\gnusdimen 0pt
-
-\newcommand{\gnuschapter}[2]{
-\gnuscleardoublepage
-\ifdim \gnusdimen = 0pt\setcounter{page}{1}\pagestyle{gnus}\pagenumbering{arabic} \gnusdimen 1pt\fi
-\chapter{#2}
-\renewcommand{\gnussectionname}{}
-\renewcommand{\gnuschaptername}{#2}
-\thispagestyle{empty}
-\hspace*{-2cm}
-\begin{picture}(500,500)(0,0)
-\put(480,350){\makebox(0,0)[tr]{#1}}
-\put(40,300){\makebox(500,50)[bl]{{\Huge\bf{#2}}}}
-\end{picture}
-\clearpage
-}
-
-\newcommand{\gnusfigure}[3]{
-\begin{figure}
-\mbox{}\ifodd\count0\hspace*{-0.8cm}\else\hspace*{-3cm}\fi\begin{picture}(440,#2)
-#3
-\end{picture}
-\caption{#1}
-\end{figure}
-}
-
-\newcommand{\gnusicon}[1]{
-\marginpar[\mbox{}\hfill\raisebox{-1.5cm}{\epsfig{figure=ps/#1-up,height=1.5cm}}]{\raisebox{-1cm}{\epsfig{figure=ps/#1-up,height=1cm}}}
-}
-
-\newcommand{\gnuspicon}[1]{
-\margindex{\epsfig{figure=#1,width=2cm}}
-}
-
-\newcommand{\gnusxface}[2]{
-\margindex{\epsfig{figure=#1,width=1cm}\epsfig{figure=#2,width=1cm}}
-}
-
-\newcommand{\gnussmiley}[2]{
-\margindex{\makebox[2cm]{\hfill\epsfig{figure=#1,width=0.5cm}\hfill\epsfig{figure=#2,width=0.5cm}\hfill}}
-}
-
-\newcommand{\gnusitemx}[1]{\mbox{}\vspace*{-\itemsep}\vspace*{-\parsep}\item#1}
-
-\newcommand{\gnussection}[1]{
-\renewcommand{\gnussectionname}{#1}
-\section{#1}
-}
-
-\newenvironment{codelist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{asislist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{kbdlist}%
-{\begin{list}{}{
-\labelwidth=0cm
-}
-}{\end{list}}
-
-\newenvironment{dfnlist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{stronglist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{samplist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{varlist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newenvironment{emphlist}%
-{\begin{list}{}{
-}
-}{\end{list}}
-
-\newlength\gnusheadtextwidth
-\setlength{\gnusheadtextwidth}{\headtextwidth}
-\addtolength{\gnusheadtextwidth}{1cm}
-
-\newpagestyle{gnuspreamble}%
-{
-{
-\ifodd\count0
-{
-\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\mbox{}}\textbf{\hfill\roman{page}}}
-}
-\else
-{
-\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\roman{page}\hfill\mbox{}}}
-}
-}
-\fi
-}
-}
-{
-\ifodd\count0
-\mbox{} \hfill
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\else
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\hfill \mbox{}
-\fi
-}
-
-\newpagestyle{gnusindex}%
-{
-{
-\ifodd\count0
-{
-\hspace*{-0.23cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\gnuschaptername\hfill\arabic{page}}}}
-}
-\else
-{
-\hspace*{-3.25cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}
-}
-\fi
-}
-}
-{
-\ifodd\count0
-\mbox{} \hfill
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\else
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\hfill \mbox{}
-\fi
-}
-
-\newpagestyle{gnus}%
-{
-{
-\ifodd\count0
-{
-\makebox[12cm]{\hspace*{3.1cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{chapter}.\arabic{section}} \textbf{\gnussectionname\hfill\arabic{page}}}}}
-}
-\else
-{
-\makebox[12cm]{\hspace*{-2.95cm}\underline{\makebox[\gnusheadtextwidth]{\textbf{\arabic{page}\hfill\gnuschaptername}}}}
-}
-\fi
-}
-}
-{
-\ifodd\count0
-\mbox{} \hfill
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\else
-\raisebox{-0.5cm}{\epsfig{figure=ps/gnus-big-logo,height=1cm}}
-\hfill \mbox{}
-\fi
-}
-
-\pagenumbering{roman}
-\pagestyle{gnuspreamble}
-
-@end iflatex
-@end iftex
-
-@iftex
-@iflatex
-
-\begin{titlepage}
-{
-
-%\addtolength{\oddsidemargin}{-5cm}
-%\addtolength{\evensidemargin}{-5cm}
-\parindent=0cm
-\addtolength{\textheight}{2cm}
-
-\gnustitle{\gnustitlename}\hfill\gnusversion{\gnusversionname}\\
-\rule{15cm}{1mm}\\
-\vfill
-\hspace*{0cm}\epsfig{figure=ps/gnus-big-logo,height=15cm}
-\vfill
-\rule{15cm}{1mm}\\
-\gnusauthor{by Lars Magne Ingebrigtsen}
-\newpage
-}
-
-\mbox{}
-\vfill
-
-\thispagestyle{empty}
-
-@c @insertcopying
-\newpage
-\end{titlepage}
-@end iflatex
-@end iftex
-
-@ifnottex
-@insertcopying
-@end ifnottex
-
-@dircategory Emacs
-@direntry
-* Gnus: (gnus). The newsreader Gnus.
-@end direntry
-@iftex
-@finalout
-@end iftex
-@setchapternewpage odd
-
-
-
-@titlepage
-@title Gnus Manual
-
-@author by Lars Magne Ingebrigtsen
-@page
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-
-
-@node Top
-@top The Gnus Newsreader
-
-@ifinfo
-
-You can read news (and mail) from within Emacs by using Gnus. The news
-can be gotten by any nefarious means you can think of---@acronym{NNTP}, local
-spool or your mbox file. All at the same time, if you want to push your
-luck.
-
-@c Adjust ../Makefile.in if you change the following line:
-This manual corresponds to Gnus v5.10.10.
-@c See also below in the iftex branch...
-
-@end ifinfo
-
-@iftex
-
-@iflatex
-\tableofcontents
-\gnuscleardoublepage
-@end iflatex
-
-Gnus is the advanced, self-documenting, customizable, extensible
-unreal-time newsreader for GNU Emacs.
-
-Oops. That sounds oddly familiar, so let's start over again to avoid
-being accused of plagiarism:
-
-Gnus is a message-reading laboratory. It will let you look at just
-about anything as if it were a newsgroup. You can read mail with it,
-you can browse directories with it, you can @code{ftp} with it---you
-can even read news with it!
-
-Gnus tries to empower people who read news the same way Emacs empowers
-people who edit text. Gnus sets no limits to what the user should be
-allowed to do. Users are encouraged to extend Gnus to make it behave
-like they want it to behave. A program should not control people;
-people should be empowered to do what they want by using (or abusing)
-the program.
-
-@c Adjust ../Makefile.in if you change the following line:
-This manual corresponds to Gnus v5.10.10.
-
-@heading Other related manuals
-@itemize
-@item Message manual: Composing messages
-@item Emacs-MIME: Composing messages; @acronym{MIME}-specific parts.
-@item Sieve: Managing Sieve scripts in Emacs.
-@item PGG: @acronym{PGP/MIME} with Gnus.
-@end itemize
-
-@end iftex
-
-@menu
-* Starting Up:: Finding news can be a pain.
-* Group Buffer:: Selecting, subscribing and killing groups.
-* Summary Buffer:: Reading, saving and posting articles.
-* Article Buffer:: Displaying and handling articles.
-* Composing Messages:: Information on sending mail and news.
-* Select Methods:: Gnus reads all messages from various select methods.
-* Scoring:: Assigning values to articles.
-* Various:: General purpose settings.
-* The End:: Farewell and goodbye.
-* Appendices:: Terminology, Emacs intro, @acronym{FAQ}, History, Internals.
-* GNU Free Documentation License:: The license for this documentation.
-* Index:: Variable, function and concept index.
-* Key Index:: Key Index.
-
-Other related manuals
-
-* Message:(message). Composing messages.
-* Emacs-MIME:(emacs-mime). Composing messages; @acronym{MIME}-specific parts.
-* Sieve:(sieve). Managing Sieve scripts in Emacs.
-* PGG:(pgg). @acronym{PGP/MIME} with Gnus.
-
-@detailmenu
- --- The Detailed Node Listing ---
-
-Starting Gnus
-
-* Finding the News:: Choosing a method for getting news.
-* The First Time:: What does Gnus do the first time you start it?
-* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a time.
-* Fetching a Group:: Starting Gnus just to read a group.
-* New Groups:: What is Gnus supposed to do with new groups?
-* Changing Servers:: You may want to move from one server to another.
-* Startup Files:: Those pesky startup files---@file{.newsrc}.
-* Auto Save:: Recovering from a crash.
-* The Active File:: Reading the active file over a slow line Takes Time.
-* Startup Variables:: Other variables you might change.
-
-New Groups
-
-* Checking New Groups:: Determining what groups are new.
-* Subscription Methods:: What Gnus should do with new groups.
-* Filtering New Groups:: Making Gnus ignore certain new groups.
-
-Group Buffer
-
-* Group Buffer Format:: Information listed and how you can change it.
-* Group Maneuvering:: Commands for moving in the group buffer.
-* Selecting a Group:: Actually reading news.
-* Subscription Commands:: Unsubscribing, killing, subscribing.
-* Group Data:: Changing the info for a group.
-* Group Levels:: Levels? What are those, then?
-* Group Score:: A mechanism for finding out what groups you like.
-* Marking Groups:: You can mark groups for later processing.
-* Foreign Groups:: Creating and editing groups.
-* Group Parameters:: Each group may have different parameters set.
-* Listing Groups:: Gnus can list various subsets of the groups.
-* Sorting Groups:: Re-arrange the group order.
-* Group Maintenance:: Maintaining a tidy @file{.newsrc} file.
-* Browse Foreign Server:: You can browse a server. See what it has to offer.
-* Exiting Gnus:: Stop reading news and get some work done.
-* Group Topics:: A folding group mode divided into topics.
-* Misc Group Stuff:: Other stuff that you can to do.
-
-Group Buffer Format
-
-* Group Line Specification:: Deciding how the group buffer is to look.
-* Group Mode Line Specification:: The group buffer mode line.
-* Group Highlighting:: Having nice colors in the group buffer.
-
-Group Topics
-
-* Topic Commands:: Interactive E-Z commands.
-* Topic Variables:: How to customize the topics the Lisp Way.
-* Topic Sorting:: Sorting each topic individually.
-* Topic Topology:: A map of the world.
-* Topic Parameters:: Parameters that apply to all groups in a topic.
-
-Misc Group Stuff
-
-* Scanning New Messages:: Asking Gnus to see whether new messages have arrived.
-* Group Information:: Information and help on groups and Gnus.
-* Group Timestamp:: Making Gnus keep track of when you last read a group.
-* File Commands:: Reading and writing the Gnus files.
-* Sieve Commands:: Managing Sieve scripts.
-
-Summary Buffer
-
-* Summary Buffer Format:: Deciding how the summary buffer is to look.
-* Summary Maneuvering:: Moving around the summary buffer.
-* Choosing Articles:: Reading articles.
-* Paging the Article:: Scrolling the current article.
-* Reply Followup and Post:: Posting articles.
-* Delayed Articles:: Send articles at a later time.
-* Marking Articles:: Marking articles as read, expirable, etc.
-* Limiting:: You can limit the summary buffer.
-* Threading:: How threads are made.
-* Sorting the Summary Buffer:: How articles and threads are sorted.
-* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
-* Article Caching:: You may store articles in a cache.
-* Persistent Articles:: Making articles expiry-resistant.
-* Article Backlog:: Having already read articles hang around.
-* Saving Articles:: Ways of customizing article saving.
-* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
-* Article Treatment:: The article buffer can be mangled at will.
-* MIME Commands:: Doing MIMEy things with the articles.
-* Charsets:: Character set issues.
-* Article Commands:: Doing various things with the article buffer.
-* Summary Sorting:: Sorting the summary buffer in various ways.
-* Finding the Parent:: No child support? Get the parent.
-* Alternative Approaches:: Reading using non-default summaries.
-* Tree Display:: A more visual display of threads.
-* Mail Group Commands:: Some commands can only be used in mail groups.
-* Various Summary Stuff:: What didn't fit anywhere else.
-* Exiting the Summary Buffer:: Returning to the Group buffer,
- or reselecting the current group.
-* Crosspost Handling:: How crossposted articles are dealt with.
-* Duplicate Suppression:: An alternative when crosspost handling fails.
-* Security:: Decrypt and Verify.
-* Mailing List:: Mailing list minor mode.
-
-Summary Buffer Format
-
-* Summary Buffer Lines:: You can specify how summary lines should look.
-* To From Newsgroups:: How to not display your own name.
-* Summary Buffer Mode Line:: You can say how the mode line should look.
-* Summary Highlighting:: Making the summary buffer all pretty and nice.
-
-Choosing Articles
-
-* Choosing Commands:: Commands for choosing articles.
-* Choosing Variables:: Variables that influence these commands.
-
-Reply, Followup and Post
-
-* Summary Mail Commands:: Sending mail.
-* Summary Post Commands:: Sending news.
-* Summary Message Commands:: Other Message-related commands.
-* Canceling and Superseding::
-
-Marking Articles
-
-* Unread Articles:: Marks for unread articles.
-* Read Articles:: Marks for read articles.
-* Other Marks:: Marks that do not affect readedness.
-* Setting Marks:: How to set and remove marks.
-* Generic Marking Commands:: How to customize the marking.
-* Setting Process Marks:: How to mark articles for later processing.
-
-Threading
-
-* Customizing Threading:: Variables you can change to affect the threading.
-* Thread Commands:: Thread based commands in the summary buffer.
-
-Customizing Threading
-
-* Loose Threads:: How Gnus gathers loose threads into bigger threads.
-* Filling In Threads:: Making the threads displayed look fuller.
-* More Threading:: Even more variables for fiddling with threads.
-* Low-Level Threading:: You thought it was over@dots{} but you were wrong!
-
-Decoding Articles
-
-* Uuencoded Articles:: Uudecode articles.
-* Shell Archives:: Unshar articles.
-* PostScript Files:: Split PostScript.
-* Other Files:: Plain save and binhex.
-* Decoding Variables:: Variables for a happy decoding.
-* Viewing Files:: You want to look at the result of the decoding?
-
-Decoding Variables
-
-* Rule Variables:: Variables that say how a file is to be viewed.
-* Other Decode Variables:: Other decode variables.
-* Uuencoding and Posting:: Variables for customizing uuencoding.
-
-Article Treatment
-
-* Article Highlighting:: You want to make the article look like fruit salad.
-* Article Fontisizing:: Making emphasized text look nice.
-* Article Hiding:: You also want to make certain info go away.
-* Article Washing:: Lots of way-neat functions to make life better.
-* Article Header:: Doing various header transformations.
-* Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
-* Article Button Levels:: Controlling appearance of buttons.
-* Article Date:: Grumble, UT!
-* Article Display:: Display various stuff---X-Face, Picons, Smileys
-* Article Signature:: What is a signature?
-* Article Miscellanea:: Various other stuff.
-
-Alternative Approaches
-
-* Pick and Read:: First mark articles and then read them.
-* Binary Groups:: Auto-decode all articles.
-
-Various Summary Stuff
-
-* Summary Group Information:: Information oriented commands.
-* Searching for Articles:: Multiple article commands.
-* Summary Generation Commands::
-* Really Various Summary Commands:: Those pesky non-conformant commands.
-
-Article Buffer
-
-* Hiding Headers:: Deciding what headers should be displayed.
-* Using MIME:: Pushing articles through @acronym{MIME} before reading them.
-* Customizing Articles:: Tailoring the look of the articles.
-* Article Keymap:: Keystrokes available in the article buffer.
-* Misc Article:: Other stuff.
-
-Composing Messages
-
-* Mail:: Mailing and replying.
-* Posting Server:: What server should you post and mail via?
-* POP before SMTP:: You cannot send a mail unless you read a mail.
-* Mail and Post:: Mailing and posting at the same time.
-* Archived Messages:: Where Gnus stores the messages you've sent.
-* Posting Styles:: An easier way to specify who you are.
-* Drafts:: Postponing messages and rejected messages.
-* Rejected Articles:: What happens if the server doesn't like your article?
-* Signing and encrypting:: How to compose secure messages.
-
-Select Methods
-
-* Server Buffer:: Making and editing virtual servers.
-* Getting News:: Reading USENET news with Gnus.
-* Getting Mail:: Reading your personal mail with Gnus.
-* Browsing the Web:: Getting messages from a plethora of Web sources.
-* IMAP:: Using Gnus as a @acronym{IMAP} client.
-* Other Sources:: Reading directories, files, SOUP packets.
-* Combined Groups:: Combining groups into one group.
-* Email Based Diary:: Using mails to manage diary events in Gnus.
-* Gnus Unplugged:: Reading news and mail offline.
-
-Server Buffer
-
-* Server Buffer Format:: You can customize the look of this buffer.
-* Server Commands:: Commands to manipulate servers.
-* Example Methods:: Examples server specifications.
-* Creating a Virtual Server:: An example session.
-* Server Variables:: Which variables to set.
-* Servers and Methods:: You can use server names as select methods.
-* Unavailable Servers:: Some servers you try to contact may be down.
-
-Getting News
-
-* NNTP:: Reading news from an @acronym{NNTP} server.
-* News Spool:: Reading news from the local spool.
-
-@acronym{NNTP}
-
-* Direct Functions:: Connecting directly to the server.
-* Indirect Functions:: Connecting indirectly to the server.
-* Common Variables:: Understood by several connection functions.
-
-Getting Mail
-
-* Mail in a Newsreader:: Important introductory notes.
-* Getting Started Reading Mail:: A simple cookbook example.
-* Splitting Mail:: How to create mail groups.
-* Mail Sources:: How to tell Gnus where to get mail from.
-* Mail Back End Variables:: Variables for customizing mail handling.
-* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail.
-* Group Mail Splitting:: Use group customize to drive mail splitting.
-* Incorporating Old Mail:: What about the old mail you have?
-* Expiring Mail:: Getting rid of unwanted mail.
-* Washing Mail:: Removing cruft from the mail you get.
-* Duplicates:: Dealing with duplicated mail.
-* Not Reading Mail:: Using mail back ends for reading other files.
-* Choosing a Mail Back End:: Gnus can read a variety of mail formats.
-
-Mail Sources
-
-* Mail Source Specifiers:: How to specify what a mail source is.
-* Mail Source Customization:: Some variables that influence things.
-* Fetching Mail:: Using the mail source specifiers.
-
-Choosing a Mail Back End
-
-* Unix Mail Box:: Using the (quite) standard Un*x mbox.
-* Rmail Babyl:: Emacs programs use the Rmail Babyl format.
-* Mail Spool:: Store your mail in a private spool?
-* MH Spool:: An mhspool-like back end.
-* Maildir:: Another one-file-per-message format.
-* Mail Folders:: Having one file for each group.
-* Comparing Mail Back Ends:: An in-depth looks at pros and cons.
-
-Browsing the Web
-
-* Archiving Mail::
-* Web Searches:: Creating groups from articles that match a string.
-* Slashdot:: Reading the Slashdot comments.
-* Ultimate:: The Ultimate Bulletin Board systems.
-* Web Archive:: Reading mailing list archived on web.
-* RSS:: Reading RDF site summary.
-* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
-
-@acronym{IMAP}
-
-* Splitting in IMAP:: Splitting mail with nnimap.
-* Expiring in IMAP:: Expiring mail with nnimap.
-* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox.
-* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button.
-* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus.
-* Debugging IMAP:: What to do when things don't work.
-
-Other Sources
-
-* Directory Groups:: You can read a directory as if it was a newsgroup.
-* Anything Groups:: Dired? Who needs dired?
-* Document Groups:: Single files can be the basis of a group.
-* SOUP:: Reading @sc{soup} packets ``offline''.
-* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
-
-Document Groups
-
-* Document Server Internals:: How to add your own document types.
-
-SOUP
-
-* SOUP Commands:: Commands for creating and sending @sc{soup} packets
-* SOUP Groups:: A back end for reading @sc{soup} packets.
-* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
-
-Combined Groups
-
-* Virtual Groups:: Combining articles from many groups.
-* Kibozed Groups:: Looking through parts of the newsfeed for articles.
-
-Email Based Diary
-
-* The NNDiary Back End:: Basic setup and usage.
-* The Gnus Diary Library:: Utility toolkit on top of nndiary.
-* Sending or Not Sending:: A final note on sending diary messages.
-
-The NNDiary Back End
-
-* Diary Messages:: What makes a message valid for nndiary.
-* Running NNDiary:: NNDiary has two modes of operation.
-* Customizing NNDiary:: Bells and whistles.
-
-The Gnus Diary Library
-
-* Diary Summary Line Format:: A nicer summary buffer line format.
-* Diary Articles Sorting:: A nicer way to sort messages.
-* Diary Headers Generation:: Not doing it manually.
-* Diary Group Parameters:: Not handling them manually.
-
-Gnus Unplugged
-
-* Agent Basics:: How it all is supposed to work.
-* Agent Categories:: How to tell the Gnus Agent what to download.
-* Agent Commands:: New commands for all the buffers.
-* Agent Visuals:: Ways that the agent may effect your summary buffer.
-* Agent as Cache:: The Agent is a big cache too.
-* Agent Expiry:: How to make old articles go away.
-* Agent Regeneration:: How to recover from lost connections and other accidents.
-* Agent and IMAP:: How to use the Agent with @acronym{IMAP}.
-* Outgoing Messages:: What happens when you post/mail something?
-* Agent Variables:: Customizing is fun.
-* Example Setup:: An example @file{~/.gnus.el} file for offline people.
-* Batching Agents:: How to fetch news from a @code{cron} job.
-* Agent Caveats:: What you think it'll do and what it does.
-
-Agent Categories
-
-* Category Syntax:: What a category looks like.
-* Category Buffer:: A buffer for maintaining categories.
-* Category Variables:: Customize'r'Us.
-
-Agent Commands
-
-* Group Agent Commands:: Configure groups and fetch their contents.
-* Summary Agent Commands:: Manually select then fetch specific articles.
-* Server Agent Commands:: Select the servers that are supported by the agent.
-
-Scoring
-
-* Summary Score Commands:: Adding score entries for the current group.
-* Group Score Commands:: General score commands.
-* Score Variables:: Customize your scoring. (My, what terminology).
-* Score File Format:: What a score file may contain.
-* Score File Editing:: You can edit score files by hand as well.
-* Adaptive Scoring:: Big Sister Gnus knows what you read.
-* Home Score File:: How to say where new score entries are to go.
-* Followups To Yourself:: Having Gnus notice when people answer you.
-* Scoring On Other Headers:: Scoring on non-standard headers.
-* Scoring Tips:: How to score effectively.
-* Reverse Scoring:: That problem child of old is not problem.
-* Global Score Files:: Earth-spanning, ear-splitting score files.
-* Kill Files:: They are still here, but they can be ignored.
-* Converting Kill Files:: Translating kill files to score files.
-* GroupLens:: Getting predictions on what you like to read.
-* Advanced Scoring:: Using logical expressions to build score rules.
-* Score Decays:: It can be useful to let scores wither away.
-
-GroupLens
-
-* Using GroupLens:: How to make Gnus use GroupLens.
-* Rating Articles:: Letting GroupLens know how you rate articles.
-* Displaying Predictions:: Displaying predictions given by GroupLens.
-* GroupLens Variables:: Customizing GroupLens.
-
-Advanced Scoring
-
-* Advanced Scoring Syntax:: A definition.
-* Advanced Scoring Examples:: What they look like.
-* Advanced Scoring Tips:: Getting the most out of it.
-
-Various
-
-* Process/Prefix:: A convention used by many treatment commands.
-* Interactive:: Making Gnus ask you many questions.
-* Symbolic Prefixes:: How to supply some Gnus functions with options.
-* Formatting Variables:: You can specify what buffers should look like.
-* Window Layout:: Configuring the Gnus buffer windows.
-* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
-* Mode Lines:: Displaying information in the mode lines.
-* Highlighting and Menus:: Making buffers look all nice and cozy.
-* Buttons:: Get tendinitis in ten easy steps!
-* Daemons:: Gnus can do things behind your back.
-* NoCeM:: How to avoid spam and other fatty foods.
-* Undo:: Some actions can be undone.
-* Predicate Specifiers:: Specifying predicates.
-* Moderation:: What to do if you're a moderator.
-* Image Enhancements:: Modern versions of Emacs/XEmacs can display images.
-* Fuzzy Matching:: What's the big fuzz?
-* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email.
-* Spam Package:: A package for filtering and processing spam.
-* Other modes:: Interaction with other modes.
-* Various Various:: Things that are really various.
-
-Formatting Variables
-
-* Formatting Basics:: A formatting variable is basically a format string.
-* Mode Line Formatting:: Some rules about mode line formatting variables.
-* Advanced Formatting:: Modifying output in various ways.
-* User-Defined Specs:: Having Gnus call your own functions.
-* Formatting Fonts:: Making the formatting look colorful and nice.
-* Positioning Point:: Moving point to a position after an operation.
-* Tabulation:: Tabulating your output.
-* Wide Characters:: Dealing with wide characters.
-
-Image Enhancements
-
-* X-Face:: Display a funky, teensy black-and-white image.
-* Face:: Display a funkier, teensier colored image.
-* Smileys:: Show all those happy faces the way they were
- meant to be shown.
-* Picons:: How to display pictures of what you're reading.
-* XVarious:: Other XEmacsy Gnusey variables.
-
-Thwarting Email Spam
-
-* The problem of spam:: Some background, and some solutions
-* Anti-Spam Basics:: Simple steps to reduce the amount of spam.
-* SpamAssassin:: How to use external anti-spam tools.
-* Hashcash:: Reduce spam by burning CPU time.
-
-Spam Package
-
-* Spam Package Introduction::
-* Filtering Incoming Mail::
-* Detecting Spam in Groups::
-* Spam and Ham Processors::
-* Spam Package Configuration Examples::
-* Spam Back Ends::
-* Extending the Spam package::
-* Spam Statistics Package::
-
-Spam Statistics Package
-
-* Creating a spam-stat dictionary::
-* Splitting mail using spam-stat::
-* Low-level interface to the spam-stat dictionary::
-
-Appendices
-
-* XEmacs:: Requirements for installing under XEmacs.
-* History:: How Gnus got where it is today.
-* On Writing Manuals:: Why this is not a beginner's guide.
-* Terminology:: We use really difficult, like, words here.
-* Customization:: Tailoring Gnus to your needs.
-* Troubleshooting:: What you might try if things do not work.
-* Gnus Reference Guide:: Rilly, rilly technical stuff.
-* Emacs for Heathens:: A short introduction to Emacsian terms.
-* Frequently Asked Questions:: The Gnus FAQ
-
-History
-
-* Gnus Versions:: What Gnus versions have been released.
-* Other Gnus Versions:: Other Gnus versions that also have been released.
-* Why?:: What's the point of Gnus?
-* Compatibility:: Just how compatible is Gnus with @sc{gnus}?
-* Conformity:: Gnus tries to conform to all standards.
-* Emacsen:: Gnus can be run on a few modern Emacsen.
-* Gnus Development:: How Gnus is developed.
-* Contributors:: Oodles of people.
-* New Features:: Pointers to some of the new stuff in Gnus.
-
-New Features
-
-* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus.
-* September Gnus:: The Thing Formally Known As Gnus 5.2/5.3.
-* Red Gnus:: Third time best---Gnus 5.4/5.5.
-* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
-* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
-* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-
-Customization
-
-* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere.
-* Slow Terminal Connection:: You run a remote Emacs.
-* Little Disk Space:: You feel that having large setup files is icky.
-* Slow Machine:: You feel like buying a faster machine.
-
-Gnus Reference Guide
-
-* Gnus Utility Functions:: Common functions and variable to use.
-* Back End Interface:: How Gnus communicates with the servers.
-* Score File Syntax:: A BNF definition of the score file standard.
-* Headers:: How Gnus stores headers internally.
-* Ranges:: A handy format for storing mucho numbers.
-* Group Info:: The group info format.
-* Extended Interactive:: Symbolic prefixes and stuff.
-* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen.
-* Various File Formats:: Formats of files that Gnus use.
-
-Back End Interface
-
-* Required Back End Functions:: Functions that must be implemented.
-* Optional Back End Functions:: Functions that need not be implemented.
-* Error Messaging:: How to get messages and report errors.
-* Writing New Back Ends:: Extending old back ends.
-* Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end.
-* Mail-like Back Ends:: Some tips on mail back ends.
-
-Various File Formats
-
-* Active File Format:: Information on articles and groups available.
-* Newsgroups File Format:: Group descriptions.
-
-Emacs for Heathens
-
-* Keystrokes:: Entering text and executing commands.
-* Emacs Lisp:: The built-in Emacs programming language.
-
-@end detailmenu
-@end menu
-
-@node Starting Up
-@chapter Starting Gnus
-@cindex starting up
-
-If you haven't used Emacs much before using Gnus, read @ref{Emacs for
-Heathens} first.
-
-@kindex M-x gnus
-@findex gnus
-If your system administrator has set things up properly, starting Gnus
-and reading news is extremely easy---you just type @kbd{M-x gnus} in
-your Emacs. If not, you should customize the variable
-@code{gnus-select-method} as described in @ref{Finding the News}. For a
-minimal setup for posting should also customize the variables
-@code{user-full-name} and @code{user-mail-address}.
-
-@findex gnus-other-frame
-@kindex M-x gnus-other-frame
-If you want to start Gnus in a different frame, you can use the command
-@kbd{M-x gnus-other-frame} instead.
-
-If things do not go smoothly at startup, you have to twiddle some
-variables in your @file{~/.gnus.el} file. This file is similar to
-@file{~/.emacs}, but is read when Gnus starts.
-
-If you puzzle at any terms used in this manual, please refer to the
-terminology section (@pxref{Terminology}).
-
-@menu
-* Finding the News:: Choosing a method for getting news.
-* The First Time:: What does Gnus do the first time you start it?
-* The Server is Down:: How can I read my mail then?
-* Slave Gnusae:: You can have more than one Gnus active at a time.
-* New Groups:: What is Gnus supposed to do with new groups?
-* Changing Servers:: You may want to move from one server to another.
-* Startup Files:: Those pesky startup files---@file{.newsrc}.
-* Auto Save:: Recovering from a crash.
-* The Active File:: Reading the active file over a slow line Takes Time.
-* Startup Variables:: Other variables you might change.
-@end menu
-
-
-@node Finding the News
-@section Finding the News
-@cindex finding news
-
-@vindex gnus-select-method
-@c @head
-The @code{gnus-select-method} variable says where Gnus should look for
-news. This variable should be a list where the first element says
-@dfn{how} and the second element says @dfn{where}. This method is your
-native method. All groups not fetched with this method are
-foreign groups.
-
-For instance, if the @samp{news.somewhere.edu} @acronym{NNTP} server is where
-you want to get your daily dosage of news from, you'd say:
-
-@lisp
-(setq gnus-select-method '(nntp "news.somewhere.edu"))
-@end lisp
-
-If you want to read directly from the local spool, say:
-
-@lisp
-(setq gnus-select-method '(nnspool ""))
-@end lisp
-
-If you can use a local spool, you probably should, as it will almost
-certainly be much faster. But do not use the local spool if your
-server is running Leafnode (which is a simple, standalone private news
-server); in this case, use @code{(nntp "localhost")}.
-
-@vindex gnus-nntpserver-file
-@cindex NNTPSERVER
-@cindex @acronym{NNTP} server
-If this variable is not set, Gnus will take a look at the
-@env{NNTPSERVER} environment variable. If that variable isn't set,
-Gnus will see whether @code{gnus-nntpserver-file}
-(@file{/etc/nntpserver} by default) has any opinions on the matter.
-If that fails as well, Gnus will try to use the machine running Emacs
-as an @acronym{NNTP} server. That's a long shot, though.
-
-@vindex gnus-nntp-server
-If @code{gnus-nntp-server} is set, this variable will override
-@code{gnus-select-method}. You should therefore set
-@code{gnus-nntp-server} to @code{nil}, which is what it is by default.
-
-@vindex gnus-secondary-servers
-@vindex gnus-nntp-server
-You can also make Gnus prompt you interactively for the name of an
-@acronym{NNTP} server. If you give a non-numerical prefix to @code{gnus}
-(i.e., @kbd{C-u M-x gnus}), Gnus will let you choose between the servers
-in the @code{gnus-secondary-servers} list (if any). You can also just
-type in the name of any server you feel like visiting. (Note that this
-will set @code{gnus-nntp-server}, which means that if you then @kbd{M-x
-gnus} later in the same Emacs session, Gnus will contact the same
-server.)
-
-@findex gnus-group-browse-foreign-server
-@kindex B (Group)
-However, if you use one @acronym{NNTP} server regularly and are just
-interested in a couple of groups from a different server, you would be
-better served by using the @kbd{B} command in the group buffer. It will
-let you have a look at what groups are available, and you can subscribe
-to any of the groups you want to. This also makes @file{.newsrc}
-maintenance much tidier. @xref{Foreign Groups}.
-
-@vindex gnus-secondary-select-methods
-@c @head
-A slightly different approach to foreign groups is to set the
-@code{gnus-secondary-select-methods} variable. The select methods
-listed in this variable are in many ways just as native as the
-@code{gnus-select-method} server. They will also be queried for active
-files during startup (if that's required), and new newsgroups that
-appear on these servers will be subscribed (or not) just as native
-groups are.
-
-For instance, if you use the @code{nnmbox} back end to read your mail,
-you would typically set this variable to
-
-@lisp
-(setq gnus-secondary-select-methods '((nnmbox "")))
-@end lisp
-
-
-@node The First Time
-@section The First Time
-@cindex first time usage
-
-If no startup files exist (@pxref{Startup Files}), Gnus will try to
-determine what groups should be subscribed by default.
-
-@vindex gnus-default-subscribed-newsgroups
-If the variable @code{gnus-default-subscribed-newsgroups} is set, Gnus
-will subscribe you to just those groups in that list, leaving the rest
-killed. Your system administrator should have set this variable to
-something useful.
-
-Since she hasn't, Gnus will just subscribe you to a few arbitrarily
-picked groups (i.e., @samp{*.newusers}). (@dfn{Arbitrary} is defined
-here as @dfn{whatever Lars thinks you should read}.)
-
-You'll also be subscribed to the Gnus documentation group, which should
-help you with most common problems.
-
-If @code{gnus-default-subscribed-newsgroups} is @code{t}, Gnus will just
-use the normal functions for handling new groups, and not do anything
-special.
-
-
-@node The Server is Down
-@section The Server is Down
-@cindex server errors
-
-If the default server is down, Gnus will understandably have some
-problems starting. However, if you have some mail groups in addition to
-the news groups, you may want to start Gnus anyway.
-
-Gnus, being the trusting sort of program, will ask whether to proceed
-without a native select method if that server can't be contacted. This
-will happen whether the server doesn't actually exist (i.e., you have
-given the wrong address) or the server has just momentarily taken ill
-for some reason or other. If you decide to continue and have no foreign
-groups, you'll find it difficult to actually do anything in the group
-buffer. But, hey, that's your problem. Blllrph!
-
-@findex gnus-no-server
-@kindex M-x gnus-no-server
-@c @head
-If you know that the server is definitely down, or you just want to read
-your mail without bothering with the server at all, you can use the
-@code{gnus-no-server} command to start Gnus. That might come in handy
-if you're in a hurry as well. This command will not attempt to contact
-your primary server---instead, it will just activate all groups on level
-1 and 2. (You should preferably keep no native groups on those two
-levels.) Also @pxref{Group Levels}.
-
-
-@node Slave Gnusae
-@section Slave Gnusae
-@cindex slave
-
-You might want to run more than one Emacs with more than one Gnus at the
-same time. If you are using different @file{.newsrc} files (e.g., if you
-are using the two different Gnusae to read from two different servers),
-that is no problem whatsoever. You just do it.
-
-The problem appears when you want to run two Gnusae that use the same
-@file{.newsrc} file.
-
-To work around that problem some, we here at the Think-Tank at the Gnus
-Towers have come up with a new concept: @dfn{Masters} and
-@dfn{slaves}. (We have applied for a patent on this concept, and have
-taken out a copyright on those words. If you wish to use those words in
-conjunction with each other, you have to send $1 per usage instance to
-me. Usage of the patent (@dfn{Master/Slave Relationships In Computer
-Applications}) will be much more expensive, of course.)
-
-@findex gnus-slave
-Anyway, you start one Gnus up the normal way with @kbd{M-x gnus} (or
-however you do it). Each subsequent slave Gnusae should be started with
-@kbd{M-x gnus-slave}. These slaves won't save normal @file{.newsrc}
-files, but instead save @dfn{slave files} that contain information only
-on what groups have been read in the slave session. When a master Gnus
-starts, it will read (and delete) these slave files, incorporating all
-information from them. (The slave files will be read in the sequence
-they were created, so the latest changes will have precedence.)
-
-Information from the slave files has, of course, precedence over the
-information in the normal (i.e., master) @file{.newsrc} file.
-
-If the @file{.newsrc*} files have not been saved in the master when the
-slave starts, you may be prompted as to whether to read an auto-save
-file. If you answer ``yes'', the unsaved changes to the master will be
-incorporated into the slave. If you answer ``no'', the slave may see some
-messages as unread that have been read in the master.
-
-
-
-@node New Groups
-@section New Groups
-@cindex new groups
-@cindex subscription
-
-@vindex gnus-check-new-newsgroups
-If you are satisfied that you really never want to see any new groups,
-you can set @code{gnus-check-new-newsgroups} to @code{nil}. This will
-also save you some time at startup. Even if this variable is
-@code{nil}, you can always subscribe to the new groups just by pressing
-@kbd{U} in the group buffer (@pxref{Group Maintenance}). This variable
-is @code{ask-server} by default. If you set this variable to
-@code{always}, then Gnus will query the back ends for new groups even
-when you do the @kbd{g} command (@pxref{Scanning New Messages}).
-
-@menu
-* Checking New Groups:: Determining what groups are new.
-* Subscription Methods:: What Gnus should do with new groups.
-* Filtering New Groups:: Making Gnus ignore certain new groups.
-@end menu
-
-
-@node Checking New Groups
-@subsection Checking New Groups
-
-Gnus normally determines whether a group is new or not by comparing the
-list of groups from the active file(s) with the lists of subscribed and
-dead groups. This isn't a particularly fast method. If
-@code{gnus-check-new-newsgroups} is @code{ask-server}, Gnus will ask the
-server for new groups since the last time. This is both faster and
-cheaper. This also means that you can get rid of the list of killed
-groups altogether, so you may set @code{gnus-save-killed-list} to
-@code{nil}, which will save time both at startup, at exit, and all over.
-Saves disk space, too. Why isn't this the default, then?
-Unfortunately, not all servers support this command.
-
-I bet I know what you're thinking now: How do I find out whether my
-server supports @code{ask-server}? No? Good, because I don't have a
-fail-safe answer. I would suggest just setting this variable to
-@code{ask-server} and see whether any new groups appear within the next
-few days. If any do, then it works. If none do, then it doesn't
-work. I could write a function to make Gnus guess whether the server
-supports @code{ask-server}, but it would just be a guess. So I won't.
-You could @code{telnet} to the server and say @code{HELP} and see
-whether it lists @samp{NEWGROUPS} among the commands it understands. If
-it does, then it might work. (But there are servers that lists
-@samp{NEWGROUPS} without supporting the function properly.)
-
-This variable can also be a list of select methods. If so, Gnus will
-issue an @code{ask-server} command to each of the select methods, and
-subscribe them (or not) using the normal methods. This might be handy
-if you are monitoring a few servers for new groups. A side effect is
-that startup will take much longer, so you can meditate while waiting.
-Use the mantra ``dingnusdingnusdingnus'' to achieve permanent bliss.
-
-
-@node Subscription Methods
-@subsection Subscription Methods
-
-@vindex gnus-subscribe-newsgroup-method
-What Gnus does when it encounters a new group is determined by the
-@code{gnus-subscribe-newsgroup-method} variable.
-
-This variable should contain a function. This function will be called
-with the name of the new group as the only parameter.
-
-Some handy pre-fab functions are:
-
-@table @code
-
-@item gnus-subscribe-zombies
-@vindex gnus-subscribe-zombies
-Make all new groups zombies. This is the default. You can browse the
-zombies later (with @kbd{A z}) and either kill them all off properly
-(with @kbd{S z}), or subscribe to them (with @kbd{u}).
-
-@item gnus-subscribe-randomly
-@vindex gnus-subscribe-randomly
-Subscribe all new groups in arbitrary order. This really means that all
-new groups will be added at ``the top'' of the group buffer.
-
-@item gnus-subscribe-alphabetically
-@vindex gnus-subscribe-alphabetically
-Subscribe all new groups in alphabetical order.
-
-@item gnus-subscribe-hierarchically
-@vindex gnus-subscribe-hierarchically
-Subscribe all new groups hierarchically. The difference between this
-function and @code{gnus-subscribe-alphabetically} is slight.
-@code{gnus-subscribe-alphabetically} will subscribe new groups in a strictly
-alphabetical fashion, while this function will enter groups into its
-hierarchy. So if you want to have the @samp{rec} hierarchy before the
-@samp{comp} hierarchy, this function will not mess that configuration
-up. Or something like that.
-
-@item gnus-subscribe-interactively
-@vindex gnus-subscribe-interactively
-Subscribe new groups interactively. This means that Gnus will ask
-you about @strong{all} new groups. The groups you choose to subscribe
-to will be subscribed hierarchically.
-
-@item gnus-subscribe-killed
-@vindex gnus-subscribe-killed
-Kill all new groups.
-
-@item gnus-subscribe-topics
-@vindex gnus-subscribe-topics
-Put the groups into the topic that has a matching @code{subscribe} topic
-parameter (@pxref{Topic Parameters}). For instance, a @code{subscribe}
-topic parameter that looks like
-
-@example
-"nnslashdot"
-@end example
-
-will mean that all groups that match that regex will be subscribed under
-that topic.
-
-If no topics match the groups, the groups will be subscribed in the
-top-level topic.
-
-@end table
-
-@vindex gnus-subscribe-hierarchical-interactive
-A closely related variable is
-@code{gnus-subscribe-hierarchical-interactive}. (That's quite a
-mouthful.) If this variable is non-@code{nil}, Gnus will ask you in a
-hierarchical fashion whether to subscribe to new groups or not. Gnus
-will ask you for each sub-hierarchy whether you want to descend the
-hierarchy or not.
-
-One common mistake is to set the variable a few paragraphs above
-(@code{gnus-subscribe-newsgroup-method}) to
-@code{gnus-subscribe-hierarchical-interactive}. This is an error. This
-will not work. This is ga-ga. So don't do it.
-
-
-@node Filtering New Groups
-@subsection Filtering New Groups
-
-A nice and portable way to control which new newsgroups should be
-subscribed (or ignored) is to put an @dfn{options} line at the start of
-the @file{.newsrc} file. Here's an example:
-
-@example
-options -n !alt.all !rec.all sci.all
-@end example
-
-@vindex gnus-subscribe-options-newsgroup-method
-This line obviously belongs to a serious-minded intellectual scientific
-person (or she may just be plain old boring), because it says that all
-groups that have names beginning with @samp{alt} and @samp{rec} should
-be ignored, and all groups with names beginning with @samp{sci} should
-be subscribed. Gnus will not use the normal subscription method for
-subscribing these groups.
-@code{gnus-subscribe-options-newsgroup-method} is used instead. This
-variable defaults to @code{gnus-subscribe-alphabetically}.
-
-@vindex gnus-options-not-subscribe
-@vindex gnus-options-subscribe
-If you don't want to mess with your @file{.newsrc} file, you can just
-set the two variables @code{gnus-options-subscribe} and
-@code{gnus-options-not-subscribe}. These two variables do exactly the
-same as the @file{.newsrc} @samp{options -n} trick. Both are regexps,
-and if the new group matches the former, it will be unconditionally
-subscribed, and if it matches the latter, it will be ignored.
-
-@vindex gnus-auto-subscribed-groups
-Yet another variable that meddles here is
-@code{gnus-auto-subscribed-groups}. It works exactly like
-@code{gnus-options-subscribe}, and is therefore really superfluous,
-but I thought it would be nice to have two of these. This variable is
-more meant for setting some ground rules, while the other variable is
-used more for user fiddling. By default this variable makes all new
-groups that come from mail back ends (@code{nnml}, @code{nnbabyl},
-@code{nnfolder}, @code{nnmbox}, @code{nnmh}, and @code{nnmaildir})
-subscribed. If you don't like that, just set this variable to
-@code{nil}.
-
-New groups that match this regexp are subscribed using
-@code{gnus-subscribe-options-newsgroup-method}.
-
-
-@node Changing Servers
-@section Changing Servers
-@cindex changing servers
-
-Sometimes it is necessary to move from one @acronym{NNTP} server to another.
-This happens very rarely, but perhaps you change jobs, or one server is
-very flaky and you want to use another.
-
-Changing the server is pretty easy, right? You just change
-@code{gnus-select-method} to point to the new server?
-
-@emph{Wrong!}
-
-Article numbers are not (in any way) kept synchronized between different
-@acronym{NNTP} servers, and the only way Gnus keeps track of what articles
-you have read is by keeping track of article numbers. So when you
-change @code{gnus-select-method}, your @file{.newsrc} file becomes
-worthless.
-
-Gnus provides a few functions to attempt to translate a @file{.newsrc}
-file from one server to another. They all have one thing in
-common---they take a looong time to run. You don't want to use these
-functions more than absolutely necessary.
-
-@kindex M-x gnus-change-server
-@findex gnus-change-server
-If you have access to both servers, Gnus can request the headers for all
-the articles you have read and compare @code{Message-ID}s and map the
-article numbers of the read articles and article marks. The @kbd{M-x
-gnus-change-server} command will do this for all your native groups. It
-will prompt for the method you want to move to.
-
-@kindex M-x gnus-group-move-group-to-server
-@findex gnus-group-move-group-to-server
-You can also move individual groups with the @kbd{M-x
-gnus-group-move-group-to-server} command. This is useful if you want to
-move a (foreign) group from one server to another.
-
-@kindex M-x gnus-group-clear-data-on-native-groups
-@findex gnus-group-clear-data-on-native-groups
-If you don't have access to both the old and new server, all your marks
-and read ranges have become worthless. You can use the @kbd{M-x
-gnus-group-clear-data-on-native-groups} command to clear out all data
-that you have on your native groups. Use with caution.
-
-@kindex M-x gnus-group-clear-data
-@findex gnus-group-clear-data
-Clear the data from the current group only---nix out marks and the
-list of read articles (@code{gnus-group-clear-data}).
-
-After changing servers, you @strong{must} move the cache hierarchy away,
-since the cached articles will have wrong article numbers, which will
-affect which articles Gnus thinks are read.
-@code{gnus-group-clear-data-on-native-groups} will ask you if you want
-to have it done automatically; for @code{gnus-group-clear-data}, you
-can use @kbd{M-x gnus-cache-move-cache} (but beware, it will move the
-cache for all groups).
-
-
-@node Startup Files
-@section Startup Files
-@cindex startup files
-@cindex .newsrc
-@cindex .newsrc.el
-@cindex .newsrc.eld
-
-Most common Unix news readers use a shared startup file called
-@file{.newsrc}. This file contains all the information about what
-groups are subscribed, and which articles in these groups have been
-read.
-
-Things got a bit more complicated with @sc{gnus}. In addition to
-keeping the @file{.newsrc} file updated, it also used a file called
-@file{.newsrc.el} for storing all the information that didn't fit into
-the @file{.newsrc} file. (Actually, it also duplicated everything in
-the @file{.newsrc} file.) @sc{gnus} would read whichever one of these
-files was the most recently saved, which enabled people to swap between
-@sc{gnus} and other newsreaders.
-
-That was kinda silly, so Gnus went one better: In addition to the
-@file{.newsrc} and @file{.newsrc.el} files, Gnus also has a file called
-@file{.newsrc.eld}. It will read whichever of these files that are most
-recent, but it will never write a @file{.newsrc.el} file. You should
-never delete the @file{.newsrc.eld} file---it contains much information
-not stored in the @file{.newsrc} file.
-
-@vindex gnus-save-newsrc-file
-@vindex gnus-read-newsrc-file
-You can turn off writing the @file{.newsrc} file by setting
-@code{gnus-save-newsrc-file} to @code{nil}, which means you can delete
-the file and save some space, as well as exiting from Gnus faster.
-However, this will make it impossible to use other newsreaders than
-Gnus. But hey, who would want to, right? Similarly, setting
-@code{gnus-read-newsrc-file} to @code{nil} makes Gnus ignore the
-@file{.newsrc} file and any @file{.newsrc-SERVER} files, which can be
-convenient if you use a different news reader occasionally, and you
-want to read a different subset of the available groups with that
-news reader.
-
-@vindex gnus-save-killed-list
-If @code{gnus-save-killed-list} (default @code{t}) is @code{nil}, Gnus
-will not save the list of killed groups to the startup file. This will
-save both time (when starting and quitting) and space (on disk). It
-will also mean that Gnus has no record of what groups are new or old,
-so the automatic new groups subscription methods become meaningless.
-You should always set @code{gnus-check-new-newsgroups} to @code{nil} or
-@code{ask-server} if you set this variable to @code{nil} (@pxref{New
-Groups}). This variable can also be a regular expression. If that's
-the case, remove all groups that do not match this regexp before
-saving. This can be useful in certain obscure situations that involve
-several servers where not all servers support @code{ask-server}.
-
-@vindex gnus-startup-file
-@vindex gnus-backup-startup-file
-@vindex version-control
-The @code{gnus-startup-file} variable says where the startup files are.
-The default value is @file{~/.newsrc}, with the Gnus (El Dingo) startup
-file being whatever that one is, with a @samp{.eld} appended.
-If you want version control for this file, set
-@code{gnus-backup-startup-file}. It respects the same values as the
-@code{version-control} variable.
-
-@vindex gnus-save-newsrc-hook
-@vindex gnus-save-quick-newsrc-hook
-@vindex gnus-save-standard-newsrc-hook
-@code{gnus-save-newsrc-hook} is called before saving any of the newsrc
-files, while @code{gnus-save-quick-newsrc-hook} is called just before
-saving the @file{.newsrc.eld} file, and
-@code{gnus-save-standard-newsrc-hook} is called just before saving the
-@file{.newsrc} file. The latter two are commonly used to turn version
-control on or off. Version control is on by default when saving the
-startup files. If you want to turn backup creation off, say something like:
-
-@lisp
-(defun turn-off-backup ()
- (set (make-local-variable 'backup-inhibited) t))
-
-(add-hook 'gnus-save-quick-newsrc-hook 'turn-off-backup)
-(add-hook 'gnus-save-standard-newsrc-hook 'turn-off-backup)
-@end lisp
-
-@vindex gnus-init-file
-@vindex gnus-site-init-file
-When Gnus starts, it will read the @code{gnus-site-init-file}
-(@file{.../site-lisp/gnus-init} by default) and @code{gnus-init-file}
-(@file{~/.gnus} by default) files. These are normal Emacs Lisp files
-and can be used to avoid cluttering your @file{~/.emacs} and
-@file{site-init} files with Gnus stuff. Gnus will also check for files
-with the same names as these, but with @file{.elc} and @file{.el}
-suffixes. In other words, if you have set @code{gnus-init-file} to
-@file{~/.gnus}, it will look for @file{~/.gnus.elc}, @file{~/.gnus.el},
-and finally @file{~/.gnus} (in this order). If Emacs was invoked with
-the @option{-q} or @option{--no-init-file} options (@pxref{Initial
-Options, ,Initial Options, emacs, The Emacs Manual}), Gnus doesn't read
-@code{gnus-init-file}.
-
-
-@node Auto Save
-@section Auto Save
-@cindex dribble file
-@cindex auto-save
-
-Whenever you do something that changes the Gnus data (reading articles,
-catching up, killing/subscribing groups), the change is added to a
-special @dfn{dribble buffer}. This buffer is auto-saved the normal
-Emacs way. If your Emacs should crash before you have saved the
-@file{.newsrc} files, all changes you have made can be recovered from
-this file.
-
-If Gnus detects this file at startup, it will ask the user whether to
-read it. The auto save file is deleted whenever the real startup file is
-saved.
-
-@vindex gnus-use-dribble-file
-If @code{gnus-use-dribble-file} is @code{nil}, Gnus won't create and
-maintain a dribble buffer. The default is @code{t}.
-
-@vindex gnus-dribble-directory
-Gnus will put the dribble file(s) in @code{gnus-dribble-directory}. If
-this variable is @code{nil}, which it is by default, Gnus will dribble
-into the directory where the @file{.newsrc} file is located. (This is
-normally the user's home directory.) The dribble file will get the same
-file permissions as the @file{.newsrc} file.
-
-@vindex gnus-always-read-dribble-file
-If @code{gnus-always-read-dribble-file} is non-@code{nil}, Gnus will
-read the dribble file on startup without querying the user.
-
-
-@node The Active File
-@section The Active File
-@cindex active file
-@cindex ignored groups
-
-When Gnus starts, or indeed whenever it tries to determine whether new
-articles have arrived, it reads the active file. This is a very large
-file that lists all the active groups and articles on the server.
-
-@vindex gnus-ignored-newsgroups
-Before examining the active file, Gnus deletes all lines that match the
-regexp @code{gnus-ignored-newsgroups}. This is done primarily to reject
-any groups with bogus names, but you can use this variable to make Gnus
-ignore hierarchies you aren't ever interested in. However, this is not
-recommended. In fact, it's highly discouraged. Instead, @pxref{New
-Groups} for an overview of other variables that can be used instead.
-
-@c This variable is
-@c @code{nil} by default, and will slow down active file handling somewhat
-@c if you set it to anything else.
-
-@vindex gnus-read-active-file
-@c @head
-The active file can be rather Huge, so if you have a slow network, you
-can set @code{gnus-read-active-file} to @code{nil} to prevent Gnus from
-reading the active file. This variable is @code{some} by default.
-
-Gnus will try to make do by getting information just on the groups that
-you actually subscribe to.
-
-Note that if you subscribe to lots and lots of groups, setting this
-variable to @code{nil} will probably make Gnus slower, not faster. At
-present, having this variable @code{nil} will slow Gnus down
-considerably, unless you read news over a 2400 baud modem.
-
-This variable can also have the value @code{some}. Gnus will then
-attempt to read active info only on the subscribed groups. On some
-servers this is quite fast (on sparkling, brand new INN servers that
-support the @code{LIST ACTIVE group} command), on others this isn't fast
-at all. In any case, @code{some} should be faster than @code{nil}, and
-is certainly faster than @code{t} over slow lines.
-
-Some news servers (old versions of Leafnode and old versions of INN, for
-instance) do not support the @code{LIST ACTIVE group}. For these
-servers, @code{nil} is probably the most efficient value for this
-variable.
-
-If this variable is @code{nil}, Gnus will ask for group info in total
-lock-step, which isn't very fast. If it is @code{some} and you use an
-@acronym{NNTP} server, Gnus will pump out commands as fast as it can, and
-read all the replies in one swoop. This will normally result in better
-performance, but if the server does not support the aforementioned
-@code{LIST ACTIVE group} command, this isn't very nice to the server.
-
-If you think that starting up Gnus takes too long, try all the three
-different values for this variable and see what works best for you.
-
-In any case, if you use @code{some} or @code{nil}, you should definitely
-kill all groups that you aren't interested in to speed things up.
-
-Note that this variable also affects active file retrieval from
-secondary select methods.
-
-
-@node Startup Variables
-@section Startup Variables
-
-@table @code
-
-@item gnus-load-hook
-@vindex gnus-load-hook
-A hook run while Gnus is being loaded. Note that this hook will
-normally be run just once in each Emacs session, no matter how many
-times you start Gnus.
-
-@item gnus-before-startup-hook
-@vindex gnus-before-startup-hook
-A hook run after starting up Gnus successfully.
-
-@item gnus-startup-hook
-@vindex gnus-startup-hook
-A hook run as the very last thing after starting up Gnus
-
-@item gnus-started-hook
-@vindex gnus-started-hook
-A hook that is run as the very last thing after starting up Gnus
-successfully.
-
-@item gnus-setup-news-hook
-@vindex gnus-setup-news-hook
-A hook that is run after reading the @file{.newsrc} file(s), but before
-generating the group buffer.
-
-@item gnus-check-bogus-newsgroups
-@vindex gnus-check-bogus-newsgroups
-If non-@code{nil}, Gnus will check for and delete all bogus groups at
-startup. A @dfn{bogus group} is a group that you have in your
-@file{.newsrc} file, but doesn't exist on the news server. Checking for
-bogus groups can take quite a while, so to save time and resources it's
-best to leave this option off, and do the checking for bogus groups once
-in a while from the group buffer instead (@pxref{Group Maintenance}).
-
-@item gnus-inhibit-startup-message
-@vindex gnus-inhibit-startup-message
-If non-@code{nil}, the startup message won't be displayed. That way,
-your boss might not notice as easily that you are reading news instead
-of doing your job. Note that this variable is used before
-@file{~/.gnus.el} is loaded, so it should be set in @file{.emacs} instead.
-
-@item gnus-no-groups-message
-@vindex gnus-no-groups-message
-Message displayed by Gnus when no groups are available.
-
-@item gnus-play-startup-jingle
-@vindex gnus-play-startup-jingle
-If non-@code{nil}, play the Gnus jingle at startup.
-
-@item gnus-startup-jingle
-@vindex gnus-startup-jingle
-Jingle to be played if the above variable is non-@code{nil}. The
-default is @samp{Tuxedomoon.Jingle4.au}.
-
-@end table
-
-
-@node Group Buffer
-@chapter Group Buffer
-@cindex group buffer
-
-@c Alex Schroeder suggests to rearrange this as follows:
-@c
-@c <kensanata> ok, just save it for reference. I'll go to bed in a minute.
-@c 1. Selecting a Group, 2. (new) Finding a Group, 3. Group Levels,
-@c 4. Subscription Commands, 5. Group Maneuvering, 6. Group Data,
-@c 7. Group Score, 8. Group Buffer Format
-@c <kensanata> Group Levels should have more information on levels 5 to 9. I
-@c suggest to split the 4th paragraph ("Gnus considers groups...") as follows:
-@c <kensanata> First, "Gnus considers groups... (default 9)."
-@c <kensanata> New, a table summarizing what levels 1 to 9 mean.
-@c <kensanata> Third, "Gnus treats subscribed ... reasons of efficiency"
-@c <kensanata> Then expand the next paragraph or add some more to it.
-@c This short one sentence explains levels 1 and 2, therefore I understand
-@c that I should keep important news at 3 and boring news at 4.
-@c Say so! Then go on to explain why I should bother with levels 6 to 9.
-@c Maybe keep those that you don't want to read temporarily at 6,
-@c those that you never want to read at 8, those that offend your
-@c human rights at 9...
-
-
-The @dfn{group buffer} lists all (or parts) of the available groups. It
-is the first buffer shown when Gnus starts, and will never be killed as
-long as Gnus is active.
-
-@iftex
-@iflatex
-\gnusfigure{The Group Buffer}{320}{
-\put(75,50){\epsfig{figure=ps/group,height=9cm}}
-\put(120,37){\makebox(0,0)[t]{Buffer name}}
-\put(120,38){\vector(1,2){10}}
-\put(40,60){\makebox(0,0)[r]{Mode line}}
-\put(40,58){\vector(1,0){30}}
-\put(200,28){\makebox(0,0)[t]{Native select method}}
-\put(200,26){\vector(-1,2){15}}
-}
-@end iflatex
-@end iftex
-
-@menu
-* Group Buffer Format:: Information listed and how you can change it.
-* Group Maneuvering:: Commands for moving in the group buffer.
-* Selecting a Group:: Actually reading news.
-* Subscription Commands:: Unsubscribing, killing, subscribing.
-* Group Data:: Changing the info for a group.
-* Group Levels:: Levels? What are those, then?
-* Group Score:: A mechanism for finding out what groups you like.
-* Marking Groups:: You can mark groups for later processing.
-* Foreign Groups:: Creating and editing groups.
-* Group Parameters:: Each group may have different parameters set.
-* Listing Groups:: Gnus can list various subsets of the groups.
-* Sorting Groups:: Re-arrange the group order.
-* Group Maintenance:: Maintaining a tidy @file{.newsrc} file.
-* Browse Foreign Server:: You can browse a server. See what it has to offer.
-* Exiting Gnus:: Stop reading news and get some work done.
-* Group Topics:: A folding group mode divided into topics.
-* Misc Group Stuff:: Other stuff that you can to do.
-@end menu
-
-
-@node Group Buffer Format
-@section Group Buffer Format
-
-@menu
-* Group Line Specification:: Deciding how the group buffer is to look.
-* Group Mode Line Specification:: The group buffer mode line.
-* Group Highlighting:: Having nice colors in the group buffer.
-@end menu
-
-You can customize the Group Mode tool bar, see @kbd{M-x
-customize-apropos RET gnus-group-tool-bar}. This feature is only
-available in Emacs.
-
-The tool bar icons are now (de)activated correctly depending on the
-cursor position. Therefore, moving around in the Group Buffer is
-slower. You can disable this via the variable
-@code{gnus-group-update-tool-bar}. Its default value depends on your
-Emacs version.
-
-@node Group Line Specification
-@subsection Group Line Specification
-@cindex group buffer format
-
-The default format of the group buffer is nice and dull, but you can
-make it as exciting and ugly as you feel like.
-
-Here's a couple of example group lines:
-
-@example
- 25: news.announce.newusers
- * 0: alt.fan.andrea-dworkin
-@end example
-
-Quite simple, huh?
-
-You can see that there are 25 unread articles in
-@samp{news.announce.newusers}. There are no unread articles, but some
-ticked articles, in @samp{alt.fan.andrea-dworkin} (see that little
-asterisk at the beginning of the line?).
-
-@vindex gnus-group-line-format
-You can change that format to whatever you want by fiddling with the
-@code{gnus-group-line-format} variable. This variable works along the
-lines of a @code{format} specification, which is pretty much the same as
-a @code{printf} specifications, for those of you who use (feh!) C.
-@xref{Formatting Variables}.
-
-@samp{%M%S%5y:%B%(%g%)\n} is the value that produced those lines above.
-
-There should always be a colon on the line; the cursor always moves to
-the colon after performing an operation. @xref{Positioning
-Point}. Nothing else is required---not even the group name. All
-displayed text is just window dressing, and is never examined by Gnus.
-Gnus stores all real information it needs using text properties.
-
-(Note that if you make a really strange, wonderful, spreadsheet-like
-layout, everybody will believe you are hard at work with the accounting
-instead of wasting time reading news.)
-
-Here's a list of all available format characters:
-
-@table @samp
-
-@item M
-An asterisk if the group only has marked articles.
-
-@item S
-Whether the group is subscribed.
-
-@item L
-Level of subscribedness.
-
-@item N
-Number of unread articles.
-
-@item I
-Number of dormant articles.
-
-@item T
-Number of ticked articles.
-
-@item R
-Number of read articles.
-
-@item U
-Number of unseen articles.
-
-@item t
-Estimated total number of articles. (This is really @var{max-number}
-minus @var{min-number} plus 1.)
-
-Gnus uses this estimation because the @acronym{NNTP} protocol provides
-efficient access to @var{max-number} and @var{min-number} but getting
-the true unread message count is not possible efficiently. For
-hysterical raisins, even the mail back ends, where the true number of
-unread messages might be available efficiently, use the same limited
-interface. To remove this restriction from Gnus means that the back
-end interface has to be changed, which is not an easy job. If you
-want to work on this, please contact the Gnus mailing list.
-
-@item y
-Number of unread, unticked, non-dormant articles.
-
-@item i
-Number of ticked and dormant articles.
-
-@item g
-Full group name.
-
-@item G
-Group name.
-
-@item C
-Group comment (@pxref{Group Parameters}) or group name if there is no
-comment element in the group parameters.
-
-@item D
-Newsgroup description. You need to read the group descriptions
-before these will appear, and to do that, you either have to set
-@code{gnus-read-active-file} or use the group buffer @kbd{M-d}
-command.
-
-@item o
-@samp{m} if moderated.
-
-@item O
-@samp{(m)} if moderated.
-
-@item s
-Select method.
-
-@item B
-If the summary buffer for the group is open or not.
-
-@item n
-Select from where.
-
-@item z
-A string that looks like @samp{<%s:%n>} if a foreign select method is
-used.
-
-@item P
-Indentation based on the level of the topic (@pxref{Group Topics}).
-
-@item c
-@vindex gnus-group-uncollapsed-levels
-Short (collapsed) group name. The @code{gnus-group-uncollapsed-levels}
-variable says how many levels to leave at the end of the group name.
-The default is 1---this will mean that group names like
-@samp{gnu.emacs.gnus} will be shortened to @samp{g.e.gnus}.
-
-@item m
-@vindex gnus-new-mail-mark
-@cindex %
-@samp{%} (@code{gnus-new-mail-mark}) if there has arrived new mail to
-the group lately.
-
-@item p
-@samp{#} (@code{gnus-process-mark}) if the group is process marked.
-
-@item d
-A string that says when you last read the group (@pxref{Group
-Timestamp}).
-
-@item u
-User defined specifier. The next character in the format string should
-be a letter. Gnus will call the function
-@code{gnus-user-format-function-}@samp{X}, where @samp{X} is the letter
-following @samp{%u}. The function will be passed a single dummy
-parameter as argument. The function should return a string, which will
-be inserted into the buffer just like information from any other
-specifier.
-@end table
-
-@cindex *
-All the ``number-of'' specs will be filled with an asterisk (@samp{*})
-if no info is available---for instance, if it is a non-activated foreign
-group, or a bogus native group.
-
-
-@node Group Mode Line Specification
-@subsection Group Mode Line Specification
-@cindex group mode line
-
-@vindex gnus-group-mode-line-format
-The mode line can be changed by setting
-@code{gnus-group-mode-line-format} (@pxref{Mode Line Formatting}). It
-doesn't understand that many format specifiers:
-
-@table @samp
-@item S
-The native news server.
-@item M
-The native select method.
-@end table
-
-
-@node Group Highlighting
-@subsection Group Highlighting
-@cindex highlighting
-@cindex group highlighting
-
-@vindex gnus-group-highlight
-Highlighting in the group buffer is controlled by the
-@code{gnus-group-highlight} variable. This is an alist with elements
-that look like @code{(@var{form} . @var{face})}. If @var{form} evaluates to
-something non-@code{nil}, the @var{face} will be used on the line.
-
-Here's an example value for this variable that might look nice if the
-background is dark:
-
-@lisp
-(cond (window-system
- (setq custom-background-mode 'light)
- (defface my-group-face-1
- '((t (:foreground "Red" :bold t))) "First group face")
- (defface my-group-face-2
- '((t (:foreground "DarkSeaGreen4" :bold t)))
- "Second group face")
- (defface my-group-face-3
- '((t (:foreground "Green4" :bold t))) "Third group face")
- (defface my-group-face-4
- '((t (:foreground "SteelBlue" :bold t))) "Fourth group face")
- (defface my-group-face-5
- '((t (:foreground "Blue" :bold t))) "Fifth group face")))
-
-(setq gnus-group-highlight
- '(((> unread 200) . my-group-face-1)
- ((and (< level 3) (zerop unread)) . my-group-face-2)
- ((< level 3) . my-group-face-3)
- ((zerop unread) . my-group-face-4)
- (t . my-group-face-5)))
-@end lisp
-
-Also @pxref{Faces and Fonts}.
-
-Variables that are dynamically bound when the forms are evaluated
-include:
-
-@table @code
-@item group
-The group name.
-@item unread
-The number of unread articles in the group.
-@item method
-The select method.
-@item mailp
-Whether the group is a mail group.
-@item level
-The level of the group.
-@item score
-The score of the group.
-@item ticked
-The number of ticked articles in the group.
-@item total
-The total number of articles in the group. Or rather,
-@var{max-number} minus @var{min-number} plus one.
-@item topic
-When using the topic minor mode, this variable is bound to the current
-topic being inserted.
-@end table
-
-When the forms are @code{eval}ed, point is at the beginning of the line
-of the group in question, so you can use many of the normal Gnus
-functions for snarfing info on the group.
-
-@vindex gnus-group-update-hook
-@findex gnus-group-highlight-line
-@code{gnus-group-update-hook} is called when a group line is changed.
-It will not be called when @code{gnus-visual} is @code{nil}. This hook
-calls @code{gnus-group-highlight-line} by default.
-
-
-@node Group Maneuvering
-@section Group Maneuvering
-@cindex group movement
-
-All movement commands understand the numeric prefix and will behave as
-expected, hopefully.
-
-@table @kbd
-
-@item n
-@kindex n (Group)
-@findex gnus-group-next-unread-group
-Go to the next group that has unread articles
-(@code{gnus-group-next-unread-group}).
-
-@item p
-@itemx DEL
-@kindex DEL (Group)
-@kindex p (Group)
-@findex gnus-group-prev-unread-group
-Go to the previous group that has unread articles
-(@code{gnus-group-prev-unread-group}).
-
-@item N
-@kindex N (Group)
-@findex gnus-group-next-group
-Go to the next group (@code{gnus-group-next-group}).
-
-@item P
-@kindex P (Group)
-@findex gnus-group-prev-group
-Go to the previous group (@code{gnus-group-prev-group}).
-
-@item M-n
-@kindex M-n (Group)
-@findex gnus-group-next-unread-group-same-level
-Go to the next unread group on the same (or lower) level
-(@code{gnus-group-next-unread-group-same-level}).
-
-@item M-p
-@kindex M-p (Group)
-@findex gnus-group-prev-unread-group-same-level
-Go to the previous unread group on the same (or lower) level
-(@code{gnus-group-prev-unread-group-same-level}).
-@end table
-
-Three commands for jumping to groups:
-
-@table @kbd
-
-@item j
-@kindex j (Group)
-@findex gnus-group-jump-to-group
-Jump to a group (and make it visible if it isn't already)
-(@code{gnus-group-jump-to-group}). Killed groups can be jumped to, just
-like living groups.
-
-@item ,
-@kindex , (Group)
-@findex gnus-group-best-unread-group
-Jump to the unread group with the lowest level
-(@code{gnus-group-best-unread-group}).
-
-@item .
-@kindex . (Group)
-@findex gnus-group-first-unread-group
-Jump to the first group with unread articles
-(@code{gnus-group-first-unread-group}).
-@end table
-
-@vindex gnus-group-goto-unread
-If @code{gnus-group-goto-unread} is @code{nil}, all the movement
-commands will move to the next group, not the next unread group. Even
-the commands that say they move to the next unread group. The default
-is @code{t}.
-
-
-@node Selecting a Group
-@section Selecting a Group
-@cindex group selection
-
-@table @kbd
-
-@item SPACE
-@kindex SPACE (Group)
-@findex gnus-group-read-group
-Select the current group, switch to the summary buffer and display the
-first unread article (@code{gnus-group-read-group}). If there are no
-unread articles in the group, or if you give a non-numerical prefix to
-this command, Gnus will offer to fetch all the old articles in this
-group from the server. If you give a numerical prefix @var{n}, @var{n}
-determines the number of articles Gnus will fetch. If @var{n} is
-positive, Gnus fetches the @var{n} newest articles, if @var{n} is
-negative, Gnus fetches the @code{abs(@var{n})} oldest articles.
-
-Thus, @kbd{SPC} enters the group normally, @kbd{C-u SPC} offers old
-articles, @kbd{C-u 4 2 SPC} fetches the 42 newest articles, and @kbd{C-u
-- 4 2 SPC} fetches the 42 oldest ones.
-
-When you are in the group (in the Summary buffer), you can type
-@kbd{M-g} to fetch new articles, or @kbd{C-u M-g} to also show the old
-ones.
-
-@item RET
-@kindex RET (Group)
-@findex gnus-group-select-group
-Select the current group and switch to the summary buffer
-(@code{gnus-group-select-group}). Takes the same arguments as
-@code{gnus-group-read-group}---the only difference is that this command
-does not display the first unread article automatically upon group
-entry.
-
-@item M-RET
-@kindex M-RET (Group)
-@findex gnus-group-quick-select-group
-This does the same as the command above, but tries to do it with the
-minimum amount of fuzz (@code{gnus-group-quick-select-group}). No
-scoring/killing will be performed, there will be no highlights and no
-expunging. This might be useful if you're in a real hurry and have to
-enter some humongous group. If you give a 0 prefix to this command
-(i.e., @kbd{0 M-RET}), Gnus won't even generate the summary buffer,
-which is useful if you want to toggle threading before generating the
-summary buffer (@pxref{Summary Generation Commands}).
-
-@item M-SPACE
-@kindex M-SPACE (Group)
-@findex gnus-group-visible-select-group
-This is yet one more command that does the same as the @kbd{RET}
-command, but this one does it without expunging and hiding dormants
-(@code{gnus-group-visible-select-group}).
-
-@item C-M-RET
-@kindex C-M-RET (Group)
-@findex gnus-group-select-group-ephemerally
-Finally, this command selects the current group ephemerally without
-doing any processing of its contents
-(@code{gnus-group-select-group-ephemerally}). Even threading has been
-turned off. Everything you do in the group after selecting it in this
-manner will have no permanent effects.
-
-@end table
-
-@vindex gnus-large-newsgroup
-The @code{gnus-large-newsgroup} variable says what Gnus should
-consider to be a big group. If it is @code{nil}, no groups are
-considered big. The default value is 200. If the group has more
-(unread and/or ticked) articles than this, Gnus will query the user
-before entering the group. The user can then specify how many
-articles should be fetched from the server. If the user specifies a
-negative number (@var{-n}), the @var{n} oldest articles will be
-fetched. If it is positive, the @var{n} articles that have arrived
-most recently will be fetched.
-
-@vindex gnus-large-ephemeral-newsgroup
-@code{gnus-large-ephemeral-newsgroup} is the same as
-@code{gnus-large-newsgroup}, but is only used for ephemeral
-newsgroups.
-
-@vindex gnus-newsgroup-maximum-articles
-In groups in some news servers, there might be a big gap between a few
-very old articles that will never be expired and the recent ones. In
-such a case, the server will return the data like @code{(1 . 30000000)}
-for the @code{LIST ACTIVE group} command, for example. Even if there
-are actually only the articles 1-10 and 29999900-30000000, Gnus doesn't
-know it at first and prepares for getting 30000000 articles. However,
-it will consume hundreds megabytes of memories and might make Emacs get
-stuck as the case may be. If you use such news servers, set the
-variable @code{gnus-newsgroup-maximum-articles} to a positive number.
-The value means that Gnus ignores articles other than this number of the
-latest ones in every group. For instance, the value 10000 makes Gnus
-get only the articles 29990001-30000000 (if the latest article number is
-30000000 in a group). Note that setting this variable to a number might
-prevent you from reading very old articles. The default value of the
-variable @code{gnus-newsgroup-maximum-articles} is @code{nil}, which
-means Gnus never ignores old articles.
-
-@vindex gnus-select-group-hook
-@vindex gnus-auto-select-first
-@vindex gnus-auto-select-subject
-If @code{gnus-auto-select-first} is non-@code{nil}, select an article
-automatically when entering a group with the @kbd{SPACE} command.
-Which article this is is controlled by the
-@code{gnus-auto-select-subject} variable. Valid values for this
-variable are:
-
-@table @code
-
-@item unread
-Place point on the subject line of the first unread article.
-
-@item first
-Place point on the subject line of the first article.
-
-@item unseen
-Place point on the subject line of the first unseen article.
-
-@item unseen-or-unread
-Place point on the subject line of the first unseen article, and if
-there is no such article, place point on the subject line of the first
-unread article.
-
-@item best
-Place point on the subject line of the highest-scored unread article.
-
-@end table
-
-This variable can also be a function. In that case, that function
-will be called to place point on a subject line.
-
-If you want to prevent automatic selection in some group (say, in a
-binary group with Huge articles) you can set the
-@code{gnus-auto-select-first} variable to @code{nil} in
-@code{gnus-select-group-hook}, which is called when a group is
-selected.
-
-
-@node Subscription Commands
-@section Subscription Commands
-@cindex subscription
-
-@table @kbd
-
-@item S t
-@itemx u
-@kindex S t (Group)
-@kindex u (Group)
-@findex gnus-group-unsubscribe-current-group
-@c @icon{gnus-group-unsubscribe}
-Toggle subscription to the current group
-(@code{gnus-group-unsubscribe-current-group}).
-
-@item S s
-@itemx U
-@kindex S s (Group)
-@kindex U (Group)
-@findex gnus-group-unsubscribe-group
-Prompt for a group to subscribe, and then subscribe it. If it was
-subscribed already, unsubscribe it instead
-(@code{gnus-group-unsubscribe-group}).
-
-@item S k
-@itemx C-k
-@kindex S k (Group)
-@kindex C-k (Group)
-@findex gnus-group-kill-group
-@c @icon{gnus-group-kill-group}
-Kill the current group (@code{gnus-group-kill-group}).
-
-@item S y
-@itemx C-y
-@kindex S y (Group)
-@kindex C-y (Group)
-@findex gnus-group-yank-group
-Yank the last killed group (@code{gnus-group-yank-group}).
-
-@item C-x C-t
-@kindex C-x C-t (Group)
-@findex gnus-group-transpose-groups
-Transpose two groups (@code{gnus-group-transpose-groups}). This isn't
-really a subscription command, but you can use it instead of a
-kill-and-yank sequence sometimes.
-
-@item S w
-@itemx C-w
-@kindex S w (Group)
-@kindex C-w (Group)
-@findex gnus-group-kill-region
-Kill all groups in the region (@code{gnus-group-kill-region}).
-
-@item S z
-@kindex S z (Group)
-@findex gnus-group-kill-all-zombies
-Kill all zombie groups (@code{gnus-group-kill-all-zombies}).
-
-@item S C-k
-@kindex S C-k (Group)
-@findex gnus-group-kill-level
-Kill all groups on a certain level (@code{gnus-group-kill-level}).
-These groups can't be yanked back after killing, so this command should
-be used with some caution. The only time where this command comes in
-really handy is when you have a @file{.newsrc} with lots of unsubscribed
-groups that you want to get rid off. @kbd{S C-k} on level 7 will
-kill off all unsubscribed groups that do not have message numbers in the
-@file{.newsrc} file.
-
-@end table
-
-Also @pxref{Group Levels}.
-
-
-@node Group Data
-@section Group Data
-
-@table @kbd
-
-@item c
-@kindex c (Group)
-@findex gnus-group-catchup-current
-@vindex gnus-group-catchup-group-hook
-@c @icon{gnus-group-catchup-current}
-Mark all unticked articles in this group as read
-(@code{gnus-group-catchup-current}).
-@code{gnus-group-catchup-group-hook} is called when catching up a group from
-the group buffer.
-
-@item C
-@kindex C (Group)
-@findex gnus-group-catchup-current-all
-Mark all articles in this group, even the ticked ones, as read
-(@code{gnus-group-catchup-current-all}).
-
-@item M-c
-@kindex M-c (Group)
-@findex gnus-group-clear-data
-Clear the data from the current group---nix out marks and the list of
-read articles (@code{gnus-group-clear-data}).
-
-@item M-x gnus-group-clear-data-on-native-groups
-@kindex M-x gnus-group-clear-data-on-native-groups
-@findex gnus-group-clear-data-on-native-groups
-If you have switched from one @acronym{NNTP} server to another, all your marks
-and read ranges have become worthless. You can use this command to
-clear out all data that you have on your native groups. Use with
-caution.
-
-@end table
-
-
-@node Group Levels
-@section Group Levels
-@cindex group level
-@cindex level
-
-All groups have a level of @dfn{subscribedness}. For instance, if a
-group is on level 2, it is more subscribed than a group on level 5. You
-can ask Gnus to just list groups on a given level or lower
-(@pxref{Listing Groups}), or to just check for new articles in groups on
-a given level or lower (@pxref{Scanning New Messages}).
-
-Remember: The higher the level of the group, the less important it is.
-
-@table @kbd
-
-@item S l
-@kindex S l (Group)
-@findex gnus-group-set-current-level
-Set the level of the current group. If a numeric prefix is given, the
-next @var{n} groups will have their levels set. The user will be
-prompted for a level.
-@end table
-
-@vindex gnus-level-killed
-@vindex gnus-level-zombie
-@vindex gnus-level-unsubscribed
-@vindex gnus-level-subscribed
-Gnus considers groups from levels 1 to
-@code{gnus-level-subscribed} (inclusive) (default 5) to be subscribed,
-@code{gnus-level-subscribed} (exclusive) and
-@code{gnus-level-unsubscribed} (inclusive) (default 7) to be
-unsubscribed, @code{gnus-level-zombie} to be zombies (walking dead)
-(default 8) and @code{gnus-level-killed} to be killed (completely dead)
-(default 9). Gnus treats subscribed and unsubscribed groups exactly the
-same, but zombie and killed groups have no information on what articles
-you have read, etc, stored. This distinction between dead and living
-groups isn't done because it is nice or clever, it is done purely for
-reasons of efficiency.
-
-It is recommended that you keep all your mail groups (if any) on quite
-low levels (e.g. 1 or 2).
-
-Maybe the following description of the default behavior of Gnus helps to
-understand what these levels are all about. By default, Gnus shows you
-subscribed nonempty groups, but by hitting @kbd{L} you can have it show
-empty subscribed groups and unsubscribed groups, too. Type @kbd{l} to
-go back to showing nonempty subscribed groups again. Thus, unsubscribed
-groups are hidden, in a way.
-
-Zombie and killed groups are similar to unsubscribed groups in that they
-are hidden by default. But they are different from subscribed and
-unsubscribed groups in that Gnus doesn't ask the news server for
-information (number of messages, number of unread messages) on zombie
-and killed groups. Normally, you use @kbd{C-k} to kill the groups you
-aren't interested in. If most groups are killed, Gnus is faster.
-
-Why does Gnus distinguish between zombie and killed groups? Well, when
-a new group arrives on the server, Gnus by default makes it a zombie
-group. This means that you are normally not bothered with new groups,
-but you can type @kbd{A z} to get a list of all new groups. Subscribe
-the ones you like and kill the ones you don't want. (@kbd{A k} shows a
-list of killed groups.)
-
-If you want to play with the level variables, you should show some care.
-Set them once, and don't touch them ever again. Better yet, don't touch
-them at all unless you know exactly what you're doing.
-
-@vindex gnus-level-default-unsubscribed
-@vindex gnus-level-default-subscribed
-Two closely related variables are @code{gnus-level-default-subscribed}
-(default 3) and @code{gnus-level-default-unsubscribed} (default 6),
-which are the levels that new groups will be put on if they are
-(un)subscribed. These two variables should, of course, be inside the
-relevant valid ranges.
-
-@vindex gnus-keep-same-level
-If @code{gnus-keep-same-level} is non-@code{nil}, some movement commands
-will only move to groups of the same level (or lower). In
-particular, going from the last article in one group to the next group
-will go to the next group of the same level (or lower). This might be
-handy if you want to read the most important groups before you read the
-rest.
-
-If this variable is @code{best}, Gnus will make the next newsgroup the
-one with the best level.
-
-@vindex gnus-group-default-list-level
-All groups with a level less than or equal to
-@code{gnus-group-default-list-level} will be listed in the group buffer
-by default.
-
-@vindex gnus-group-list-inactive-groups
-If @code{gnus-group-list-inactive-groups} is non-@code{nil}, non-active
-groups will be listed along with the unread groups. This variable is
-@code{t} by default. If it is @code{nil}, inactive groups won't be
-listed.
-
-@vindex gnus-group-use-permanent-levels
-If @code{gnus-group-use-permanent-levels} is non-@code{nil}, once you
-give a level prefix to @kbd{g} or @kbd{l}, all subsequent commands will
-use this level as the ``work'' level.
-
-@vindex gnus-activate-level
-Gnus will normally just activate (i. e., query the server about) groups
-on level @code{gnus-activate-level} or less. If you don't want to
-activate unsubscribed groups, for instance, you might set this variable
-to 5. The default is 6.
-
-
-@node Group Score
-@section Group Score
-@cindex group score
-@cindex group rank
-@cindex rank
-
-You would normally keep important groups on high levels, but that scheme
-is somewhat restrictive. Don't you wish you could have Gnus sort the
-group buffer according to how often you read groups, perhaps? Within
-reason?
-
-This is what @dfn{group score} is for. You can have Gnus assign a score
-to each group through the mechanism described below. You can then sort
-the group buffer based on this score. Alternatively, you can sort on
-score and then level. (Taken together, the level and the score is
-called the @dfn{rank} of the group. A group that is on level 4 and has
-a score of 1 has a higher rank than a group on level 5 that has a score
-of 300. (The level is the most significant part and the score is the
-least significant part.))
-
-@findex gnus-summary-bubble-group
-If you want groups you read often to get higher scores than groups you
-read seldom you can add the @code{gnus-summary-bubble-group} function to
-the @code{gnus-summary-exit-hook} hook. This will result (after
-sorting) in a bubbling sort of action. If you want to see that in
-action after each summary exit, you can add
-@code{gnus-group-sort-groups-by-rank} or
-@code{gnus-group-sort-groups-by-score} to the same hook, but that will
-slow things down somewhat.
-
-
-@node Marking Groups
-@section Marking Groups
-@cindex marking groups
-
-If you want to perform some command on several groups, and they appear
-subsequently in the group buffer, you would normally just give a
-numerical prefix to the command. Most group commands will then do your
-bidding on those groups.
-
-However, if the groups are not in sequential order, you can still
-perform a command on several groups. You simply mark the groups first
-with the process mark and then execute the command.
-
-@table @kbd
-
-@item #
-@kindex # (Group)
-@itemx M m
-@kindex M m (Group)
-@findex gnus-group-mark-group
-Set the mark on the current group (@code{gnus-group-mark-group}).
-
-@item M-#
-@kindex M-# (Group)
-@itemx M u
-@kindex M u (Group)
-@findex gnus-group-unmark-group
-Remove the mark from the current group
-(@code{gnus-group-unmark-group}).
-
-@item M U
-@kindex M U (Group)
-@findex gnus-group-unmark-all-groups
-Remove the mark from all groups (@code{gnus-group-unmark-all-groups}).
-
-@item M w
-@kindex M w (Group)
-@findex gnus-group-mark-region
-Mark all groups between point and mark (@code{gnus-group-mark-region}).
-
-@item M b
-@kindex M b (Group)
-@findex gnus-group-mark-buffer
-Mark all groups in the buffer (@code{gnus-group-mark-buffer}).
-
-@item M r
-@kindex M r (Group)
-@findex gnus-group-mark-regexp
-Mark all groups that match some regular expression
-(@code{gnus-group-mark-regexp}).
-@end table
-
-Also @pxref{Process/Prefix}.
-
-@findex gnus-group-universal-argument
-If you want to execute some command on all groups that have been marked
-with the process mark, you can use the @kbd{M-&}
-(@code{gnus-group-universal-argument}) command. It will prompt you for
-the command to be executed.
-
-
-@node Foreign Groups
-@section Foreign Groups
-@cindex foreign groups
-
-Below are some group mode commands for making and editing general foreign
-groups, as well as commands to ease the creation of a few
-special-purpose groups. All these commands insert the newly created
-groups under point---@code{gnus-subscribe-newsgroup-method} is not
-consulted.
-
-Changes from the group editing commands are stored in
-@file{~/.newsrc.eld} (@code{gnus-startup-file}). An alternative is the
-variable @code{gnus-parameters}, @xref{Group Parameters}.
-
-@table @kbd
-
-@item G m
-@kindex G m (Group)
-@findex gnus-group-make-group
-@cindex making groups
-Make a new group (@code{gnus-group-make-group}). Gnus will prompt you
-for a name, a method and possibly an @dfn{address}. For an easier way
-to subscribe to @acronym{NNTP} groups (@pxref{Browse Foreign Server}).
-
-@item G M
-@kindex G M (Group)
-@findex gnus-group-read-ephemeral-group
-Make an ephemeral group (@code{gnus-group-read-ephemeral-group}). Gnus
-will prompt you for a name, a method and an @dfn{address}.
-
-@item G r
-@kindex G r (Group)
-@findex gnus-group-rename-group
-@cindex renaming groups
-Rename the current group to something else
-(@code{gnus-group-rename-group}). This is valid only on some
-groups---mail groups mostly. This command might very well be quite slow
-on some back ends.
-
-@item G c
-@kindex G c (Group)
-@cindex customizing
-@findex gnus-group-customize
-Customize the group parameters (@code{gnus-group-customize}).
-
-@item G e
-@kindex G e (Group)
-@findex gnus-group-edit-group-method
-@cindex renaming groups
-Enter a buffer where you can edit the select method of the current
-group (@code{gnus-group-edit-group-method}).
-
-@item G p
-@kindex G p (Group)
-@findex gnus-group-edit-group-parameters
-Enter a buffer where you can edit the group parameters
-(@code{gnus-group-edit-group-parameters}).
-
-@item G E
-@kindex G E (Group)
-@findex gnus-group-edit-group
-Enter a buffer where you can edit the group info
-(@code{gnus-group-edit-group}).
-
-@item G d
-@kindex G d (Group)
-@findex gnus-group-make-directory-group
-@cindex nndir
-Make a directory group (@pxref{Directory Groups}). You will be prompted
-for a directory name (@code{gnus-group-make-directory-group}).
-
-@item G h
-@kindex G h (Group)
-@cindex help group
-@findex gnus-group-make-help-group
-Make the Gnus help group (@code{gnus-group-make-help-group}).
-
-@item G a
-@kindex G a (Group)
-@cindex (ding) archive
-@cindex archive group
-@findex gnus-group-make-archive-group
-@vindex gnus-group-archive-directory
-@vindex gnus-group-recent-archive-directory
-Make a Gnus archive group (@code{gnus-group-make-archive-group}). By
-default a group pointing to the most recent articles will be created
-(@code{gnus-group-recent-archive-directory}), but given a prefix, a full
-group will be created from @code{gnus-group-archive-directory}.
-
-@item G k
-@kindex G k (Group)
-@findex gnus-group-make-kiboze-group
-@cindex nnkiboze
-Make a kiboze group. You will be prompted for a name, for a regexp to
-match groups to be ``included'' in the kiboze group, and a series of
-strings to match on headers (@code{gnus-group-make-kiboze-group}).
-@xref{Kibozed Groups}.
-
-@item G D
-@kindex G D (Group)
-@findex gnus-group-enter-directory
-@cindex nneething
-Read an arbitrary directory as if it were a newsgroup with the
-@code{nneething} back end (@code{gnus-group-enter-directory}).
-@xref{Anything Groups}.
-
-@item G f
-@kindex G f (Group)
-@findex gnus-group-make-doc-group
-@cindex ClariNet Briefs
-@cindex nndoc
-Make a group based on some file or other
-(@code{gnus-group-make-doc-group}). If you give a prefix to this
-command, you will be prompted for a file name and a file type.
-Currently supported types are @code{mbox}, @code{babyl},
-@code{digest}, @code{news}, @code{rnews}, @code{mmdf}, @code{forward},
-@code{rfc934}, @code{rfc822-forward}, @code{mime-parts},
-@code{standard-digest}, @code{slack-digest}, @code{clari-briefs},
-@code{nsmail}, @code{outlook}, @code{oe-dbx}, and @code{mailman}. If
-you run this command without a prefix, Gnus will guess at the file
-type. @xref{Document Groups}.
-
-@item G u
-@kindex G u (Group)
-@vindex gnus-useful-groups
-@findex gnus-group-make-useful-group
-Create one of the groups mentioned in @code{gnus-useful-groups}
-(@code{gnus-group-make-useful-group}).
-
-@item G w
-@kindex G w (Group)
-@findex gnus-group-make-web-group
-@cindex Google
-@cindex nnweb
-@cindex gmane
-Make an ephemeral group based on a web search
-(@code{gnus-group-make-web-group}). If you give a prefix to this
-command, make a solid group instead. You will be prompted for the
-search engine type and the search string. Valid search engine types
-include @code{google}, @code{dejanews}, and @code{gmane}.
-@xref{Web Searches}.
-
-If you use the @code{google} search engine, you can limit the search
-to a particular group by using a match string like
-@samp{shaving group:alt.sysadmin.recovery}.
-
-@item G R
-@kindex G R (Group)
-@findex gnus-group-make-rss-group
-Make a group based on an @acronym{RSS} feed
-(@code{gnus-group-make-rss-group}). You will be prompted for an URL.
-@xref{RSS}.
-
-@item G DEL
-@kindex G DEL (Group)
-@findex gnus-group-delete-group
-This function will delete the current group
-(@code{gnus-group-delete-group}). If given a prefix, this function will
-actually delete all the articles in the group, and forcibly remove the
-group itself from the face of the Earth. Use a prefix only if you are
-absolutely sure of what you are doing. This command can't be used on
-read-only groups (like @code{nntp} groups), though.
-
-@item G V
-@kindex G V (Group)
-@findex gnus-group-make-empty-virtual
-Make a new, fresh, empty @code{nnvirtual} group
-(@code{gnus-group-make-empty-virtual}). @xref{Virtual Groups}.
-
-@item G v
-@kindex G v (Group)
-@findex gnus-group-add-to-virtual
-Add the current group to an @code{nnvirtual} group
-(@code{gnus-group-add-to-virtual}). Uses the process/prefix convention.
-@end table
-
-@xref{Select Methods}, for more information on the various select
-methods.
-
-@vindex gnus-activate-foreign-newsgroups
-If @code{gnus-activate-foreign-newsgroups} is a positive number,
-Gnus will check all foreign groups with this level or lower at startup.
-This might take quite a while, especially if you subscribe to lots of
-groups from different @acronym{NNTP} servers. Also @pxref{Group Levels};
-@code{gnus-activate-level} also affects activation of foreign
-newsgroups.
-
-
-@node Group Parameters
-@section Group Parameters
-@cindex group parameters
-
-The group parameters store information local to a particular group.
-
-Use the @kbd{G p} or the @kbd{G c} command to edit group parameters of a
-group. (@kbd{G p} presents you with a Lisp-based interface, @kbd{G c}
-presents you with a Customize-like interface. The latter helps avoid
-silly Lisp errors.) You might also be interested in reading about topic
-parameters (@pxref{Topic Parameters}).
-Additionally, you can set group parameters via the
-@code{gnus-parameters} variable, see below.
-
-Here's an example group parameter list:
-
-@example
-((to-address . "ding@@gnus.org")
- (auto-expire . t))
-@end example
-
-We see that each element consists of a ``dotted pair''---the thing before
-the dot is the key, while the thing after the dot is the value. All the
-parameters have this form @emph{except} local variable specs, which are
-not dotted pairs, but proper lists.
-
-Some parameters have correspondent customizable variables, each of which
-is an alist of regexps and values.
-
-The following group parameters can be used:
-
-@table @code
-@item to-address
-@cindex to-address
-Address used by when doing followups and new posts.
-
-@example
-(to-address . "some@@where.com")
-@end example
-
-This is primarily useful in mail groups that represent closed mailing
-lists---mailing lists where it's expected that everybody that writes to
-the mailing list is subscribed to it. Since using this parameter
-ensures that the mail only goes to the mailing list itself, it means
-that members won't receive two copies of your followups.
-
-Using @code{to-address} will actually work whether the group is foreign
-or not. Let's say there's a group on the server that is called
-@samp{fa.4ad-l}. This is a real newsgroup, but the server has gotten
-the articles from a mail-to-news gateway. Posting directly to this
-group is therefore impossible---you have to send mail to the mailing
-list address instead.
-
-See also @code{gnus-parameter-to-address-alist}.
-
-@item to-list
-@cindex to-list
-Address used when doing @kbd{a} in that group.
-
-@example
-(to-list . "some@@where.com")
-@end example
-
-It is totally ignored
-when doing a followup---except that if it is present in a news group,
-you'll get mail group semantics when doing @kbd{f}.
-
-If you do an @kbd{a} command in a mail group and you have neither a
-@code{to-list} group parameter nor a @code{to-address} group parameter,
-then a @code{to-list} group parameter will be added automatically upon
-sending the message if @code{gnus-add-to-list} is set to @code{t}.
-@vindex gnus-add-to-list
-
-@findex gnus-mailing-list-mode
-@cindex mail list groups
-If this variable is set, @code{gnus-mailing-list-mode} is turned on when
-entering summary buffer.
-
-See also @code{gnus-parameter-to-list-alist}.
-
-@anchor{subscribed}
-@item subscribed
-@cindex subscribed
-@cindex Mail-Followup-To
-@findex gnus-find-subscribed-addresses
-If this parameter is set to @code{t}, Gnus will consider the
-to-address and to-list parameters for this group as addresses of
-mailing lists you are subscribed to. Giving Gnus this information is
-(only) a first step in getting it to generate correct Mail-Followup-To
-headers for your posts to these lists. The second step is to put the
-following in your @file{.gnus.el}
-
-@lisp
-(setq message-subscribed-address-functions
- '(gnus-find-subscribed-addresses))
-@end lisp
-
-@xref{Mailing Lists, ,Mailing Lists, message, The Message Manual}, for
-a complete treatment of available MFT support.
-
-@item visible
-@cindex visible
-If the group parameter list has the element @code{(visible . t)},
-that group will always be visible in the Group buffer, regardless
-of whether it has any unread articles.
-
-This parameter cannot be set via @code{gnus-parameters}. See
-@code{gnus-permanently-visible-groups} as an alternative.
-
-@item broken-reply-to
-@cindex broken-reply-to
-Elements like @code{(broken-reply-to . t)} signals that @code{Reply-To}
-headers in this group are to be ignored, and for the header to be hidden
-if @code{reply-to} is part of @code{gnus-boring-article-headers}. This
-can be useful if you're reading a mailing list group where the listserv
-has inserted @code{Reply-To} headers that point back to the listserv
-itself. That is broken behavior. So there!
-
-@item to-group
-@cindex to-group
-Elements like @code{(to-group . "some.group.name")} means that all
-posts in that group will be sent to @code{some.group.name}.
-
-@item newsgroup
-@cindex newsgroup
-If you have @code{(newsgroup . t)} in the group parameter list, Gnus
-will treat all responses as if they were responses to news articles.
-This can be useful if you have a mail group that's really a mirror of a
-news group.
-
-@item gcc-self
-@cindex gcc-self
-If @code{(gcc-self . t)} is present in the group parameter list, newly
-composed messages will be @code{Gcc}'d to the current group. If
-@code{(gcc-self . none)} is present, no @code{Gcc:} header will be
-generated, if @code{(gcc-self . "string")} is present, this string will
-be inserted literally as a @code{gcc} header. This parameter takes
-precedence over any default @code{Gcc} rules as described later
-(@pxref{Archived Messages}).
-
-@strong{Caveat}: Adding @code{(gcc-self . t)} to the parameter list of
-@code{nntp} groups (or the like) isn't valid. An @code{nntp} server
-doesn't accept articles.
-
-@item auto-expire
-@cindex auto-expire
-@cindex expiring mail
-If the group parameter has an element that looks like @code{(auto-expire
-. t)}, all articles read will be marked as expirable. For an
-alternative approach, @pxref{Expiring Mail}.
-
-See also @code{gnus-auto-expirable-newsgroups}.
-
-@item total-expire
-@cindex total-expire
-@cindex expiring mail
-If the group parameter has an element that looks like
-@code{(total-expire . t)}, all read articles will be put through the
-expiry process, even if they are not marked as expirable. Use with
-caution. Unread, ticked and dormant articles are not eligible for
-expiry.
-
-See also @code{gnus-total-expirable-newsgroups}.
-
-@item expiry-wait
-@cindex expiry-wait
-@vindex nnmail-expiry-wait-function
-If the group parameter has an element that looks like
-@code{(expiry-wait . 10)}, this value will override any
-@code{nnmail-expiry-wait} and @code{nnmail-expiry-wait-function}
-(@pxref{Expiring Mail}) when expiring expirable messages. The value
-can either be a number of days (not necessarily an integer) or the
-symbols @code{never} or @code{immediate}.
-
-@item expiry-target
-@cindex expiry-target
-Where expired messages end up. This parameter overrides
-@code{nnmail-expiry-target}.
-
-@item score-file
-@cindex score file group parameter
-Elements that look like @code{(score-file . "file")} will make
-@file{file} into the current score file for the group in question. All
-interactive score entries will be put into this file.
-
-@item adapt-file
-@cindex adapt file group parameter
-Elements that look like @code{(adapt-file . "file")} will make
-@file{file} into the current adaptive file for the group in question.
-All adaptive score entries will be put into this file.
-
-@item admin-address
-@cindex admin-address
-When unsubscribing from a mailing list you should never send the
-unsubscription notice to the mailing list itself. Instead, you'd send
-messages to the administrative address. This parameter allows you to
-put the admin address somewhere convenient.
-
-@item display
-@cindex display
-Elements that look like @code{(display . MODE)} say which articles to
-display on entering the group. Valid values are:
-
-@table @code
-@item all
-Display all articles, both read and unread.
-
-@item an integer
-Display the last @var{integer} articles in the group. This is the same as
-entering the group with @kbd{C-u @var{integer}}.
-
-@item default
-Display the default visible articles, which normally includes unread and
-ticked articles.
-
-@item an array
-Display articles that satisfy a predicate.
-
-Here are some examples:
-
-@table @code
-@item [unread]
-Display only unread articles.
-
-@item [not expire]
-Display everything except expirable articles.
-
-@item [and (not reply) (not expire)]
-Display everything except expirable and articles you've already
-responded to.
-@end table
-
-The available operators are @code{not}, @code{and} and @code{or}.
-Predicates include @code{tick}, @code{unsend}, @code{undownload},
-@code{unread}, @code{dormant}, @code{expire}, @code{reply},
-@code{killed}, @code{bookmark}, @code{score}, @code{save},
-@code{cache}, @code{forward}, @code{unseen} and @code{recent}.
-
-@end table
-
-The @code{display} parameter works by limiting the summary buffer to
-the subset specified. You can pop the limit by using the @kbd{/ w}
-command (@pxref{Limiting}).
-
-@item comment
-@cindex comment
-Elements that look like @code{(comment . "This is a comment")} are
-arbitrary comments on the group. You can display comments in the
-group line (@pxref{Group Line Specification}).
-
-@item charset
-@cindex charset
-Elements that look like @code{(charset . iso-8859-1)} will make
-@code{iso-8859-1} the default charset; that is, the charset that will be
-used for all articles that do not specify a charset.
-
-See also @code{gnus-group-charset-alist}.
-
-@item ignored-charsets
-@cindex ignored-charset
-Elements that look like @code{(ignored-charsets x-unknown iso-8859-1)}
-will make @code{iso-8859-1} and @code{x-unknown} ignored; that is, the
-default charset will be used for decoding articles.
-
-See also @code{gnus-group-ignored-charsets-alist}.
-
-@item posting-style
-@cindex posting-style
-You can store additional posting style information for this group
-here (@pxref{Posting Styles}). The format is that of an entry in the
-@code{gnus-posting-styles} alist, except that there's no regexp matching
-the group name (of course). Style elements in this group parameter will
-take precedence over the ones found in @code{gnus-posting-styles}.
-
-For instance, if you want a funky name and signature in this group only,
-instead of hacking @code{gnus-posting-styles}, you could put something
-like this in the group parameters:
-
-@example
-(posting-style
- (name "Funky Name")
- ("X-My-Header" "Funky Value")
- (signature "Funky Signature"))
-@end example
-
-@item post-method
-@cindex post-method
-If it is set, the value is used as the method for posting message
-instead of @code{gnus-post-method}.
-
-@item banner
-@cindex banner
-An item like @code{(banner . @var{regexp})} causes any part of an article
-that matches the regular expression @var{regexp} to be stripped. Instead of
-@var{regexp}, you can also use the symbol @code{signature} which strips the
-last signature or any of the elements of the alist
-@code{gnus-article-banner-alist}.
-
-@item sieve
-@cindex sieve
-This parameter contains a Sieve test that should match incoming mail
-that should be placed in this group. From this group parameter, a
-Sieve @samp{IF} control structure is generated, having the test as the
-condition and @samp{fileinto "group.name";} as the body.
-
-For example, if the @samp{INBOX.list.sieve} group has the @code{(sieve
-address "sender" "sieve-admin@@extundo.com")} group parameter, when
-translating the group parameter into a Sieve script (@pxref{Sieve
-Commands}) the following Sieve code is generated:
-
-@example
-if address \"sender\" \"sieve-admin@@extundo.com\" @{
- fileinto \"INBOX.list.sieve\";
-@}
-@end example
-
-The Sieve language is described in RFC 3028. @xref{Top, Emacs Sieve,
-Top, sieve, Emacs Sieve}.
-
-@item (agent parameters)
-If the agent has been enabled, you can set any of the its parameters
-to control the behavior of the agent in individual groups. See Agent
-Parameters in @ref{Category Syntax}. Most users will choose to set
-agent parameters in either an agent category or group topic to
-minimize the configuration effort.
-
-@item (@var{variable} @var{form})
-You can use the group parameters to set variables local to the group you
-are entering. If you want to turn threading off in @samp{news.answers},
-you could put @code{(gnus-show-threads nil)} in the group parameters of
-that group. @code{gnus-show-threads} will be made into a local variable
-in the summary buffer you enter, and the form @code{nil} will be
-@code{eval}ed there.
-
-Note that this feature sets the variable locally to the summary buffer.
-But some variables are evaluated in the article buffer, or in the
-message buffer (of a reply or followup or otherwise newly created
-message). As a workaround, it might help to add the variable in
-question to @code{gnus-newsgroup-variables}. @xref{Various Summary
-Stuff}. So if you want to set @code{message-from-style} via the group
-parameters, then you may need the following statement elsewhere in your
-@file{~/.gnus} file:
-
-@lisp
-(add-to-list 'gnus-newsgroup-variables 'message-from-style)
-@end lisp
-
-@vindex gnus-list-identifiers
-A use for this feature is to remove a mailing list identifier tag in
-the subject fields of articles. E.g. if the news group
-
-@example
-nntp+news.gnus.org:gmane.text.docbook.apps
-@end example
-
-has the tag @samp{DOC-BOOK-APPS:} in the subject of all articles, this
-tag can be removed from the article subjects in the summary buffer for
-the group by putting @code{(gnus-list-identifiers "DOCBOOK-APPS:")}
-into the group parameters for the group.
-
-This can also be used as a group-specific hook function. If you want to
-hear a beep when you enter a group, you could put something like
-@code{(dummy-variable (ding))} in the parameters of that group.
-@code{dummy-variable} will be set to the (meaningless) result of the
-@code{(ding)} form.
-
-Alternatively, since the VARIABLE becomes local to the group, this
-pattern can be used to temporarily change a hook. For example, if the
-following is added to a group parameter
-
-@lisp
-(gnus-summary-prepared-hook
- '(lambda nil (local-set-key "d" (local-key-binding "n"))))
-@end lisp
-
-when the group is entered, the 'd' key will not mark the article as
-expired.
-
-@end table
-
-@vindex gnus-parameters
-Group parameters can be set via the @code{gnus-parameters} variable too.
-But some variables, such as @code{visible}, have no effect (For this
-case see @code{gnus-permanently-visible-groups} as an alternative.).
-For example:
-
-@lisp
-(setq gnus-parameters
- '(("mail\\..*"
- (gnus-show-threads nil)
- (gnus-use-scoring nil)
- (gnus-summary-line-format
- "%U%R%z%I%(%[%d:%ub%-23,23f%]%) %s\n")
- (gcc-self . t)
- (display . all))
-
- ("^nnimap:\\(foo.bar\\)$"
- (to-group . "\\1"))
-
- ("mail\\.me"
- (gnus-use-scoring t))
-
- ("list\\..*"
- (total-expire . t)
- (broken-reply-to . t))))
-@end lisp
-
-String value of parameters will be subjected to regexp substitution, as
-the @code{to-group} example shows.
-
-@vindex gnus-parameters-case-fold-search
-By default, whether comparing the group name and one of those regexps
-specified in @code{gnus-parameters} is done in a case-sensitive manner
-or a case-insensitive manner depends on the value of
-@code{case-fold-search} at the time when the comparison is done. The
-value of @code{case-fold-search} is typically @code{t}; it means, for
-example, the element @code{("INBOX\\.FOO" (total-expire . t))} might be
-applied to both the @samp{INBOX.FOO} group and the @samp{INBOX.foo}
-group. If you want to make those regexps always case-sensitive, set the
-value of the @code{gnus-parameters-case-fold-search} variable to
-@code{nil}. Otherwise, set it to @code{t} if you want to compare them
-always in a case-insensitive manner.
-
-
-@node Listing Groups
-@section Listing Groups
-@cindex group listing
-
-These commands all list various slices of the groups available.
-
-@table @kbd
-
-@item l
-@itemx A s
-@kindex A s (Group)
-@kindex l (Group)
-@findex gnus-group-list-groups
-List all groups that have unread articles
-(@code{gnus-group-list-groups}). If the numeric prefix is used, this
-command will list only groups of level ARG and lower. By default, it
-only lists groups of level five (i.e.,
-@code{gnus-group-default-list-level}) or lower (i.e., just subscribed
-groups).
-
-@item L
-@itemx A u
-@kindex A u (Group)
-@kindex L (Group)
-@findex gnus-group-list-all-groups
-List all groups, whether they have unread articles or not
-(@code{gnus-group-list-all-groups}). If the numeric prefix is used,
-this command will list only groups of level ARG and lower. By default,
-it lists groups of level seven or lower (i.e., just subscribed and
-unsubscribed groups).
-
-@item A l
-@kindex A l (Group)
-@findex gnus-group-list-level
-List all unread groups on a specific level
-(@code{gnus-group-list-level}). If given a prefix, also list the groups
-with no unread articles.
-
-@item A k
-@kindex A k (Group)
-@findex gnus-group-list-killed
-List all killed groups (@code{gnus-group-list-killed}). If given a
-prefix argument, really list all groups that are available, but aren't
-currently (un)subscribed. This could entail reading the active file
-from the server.
-
-@item A z
-@kindex A z (Group)
-@findex gnus-group-list-zombies
-List all zombie groups (@code{gnus-group-list-zombies}).
-
-@item A m
-@kindex A m (Group)
-@findex gnus-group-list-matching
-List all unread, subscribed groups with names that match a regexp
-(@code{gnus-group-list-matching}).
-
-@item A M
-@kindex A M (Group)
-@findex gnus-group-list-all-matching
-List groups that match a regexp (@code{gnus-group-list-all-matching}).
-
-@item A A
-@kindex A A (Group)
-@findex gnus-group-list-active
-List absolutely all groups in the active file(s) of the
-server(s) you are connected to (@code{gnus-group-list-active}). This
-might very well take quite a while. It might actually be a better idea
-to do a @kbd{A M} to list all matching, and just give @samp{.} as the
-thing to match on. Also note that this command may list groups that
-don't exist (yet)---these will be listed as if they were killed groups.
-Take the output with some grains of salt.
-
-@item A a
-@kindex A a (Group)
-@findex gnus-group-apropos
-List all groups that have names that match a regexp
-(@code{gnus-group-apropos}).
-
-@item A d
-@kindex A d (Group)
-@findex gnus-group-description-apropos
-List all groups that have names or descriptions that match a regexp
-(@code{gnus-group-description-apropos}).
-
-@item A c
-@kindex A c (Group)
-@findex gnus-group-list-cached
-List all groups with cached articles (@code{gnus-group-list-cached}).
-
-@item A ?
-@kindex A ? (Group)
-@findex gnus-group-list-dormant
-List all groups with dormant articles (@code{gnus-group-list-dormant}).
-
-@item A /
-@kindex A / (Group)
-@findex gnus-group-list-limit
-List groups limited within the current selection
-(@code{gnus-group-list-limit}).
-
-@item A f
-@kindex A f (Group)
-@findex gnus-group-list-flush
-Flush groups from the current selection (@code{gnus-group-list-flush}).
-
-@item A p
-@kindex A p (Group)
-@findex gnus-group-list-plus
-List groups plus the current selection (@code{gnus-group-list-plus}).
-
-@end table
-
-@vindex gnus-permanently-visible-groups
-@cindex visible group parameter
-Groups that match the @code{gnus-permanently-visible-groups} regexp will
-always be shown, whether they have unread articles or not. You can also
-add the @code{visible} element to the group parameters in question to
-get the same effect.
-
-@vindex gnus-list-groups-with-ticked-articles
-Groups that have just ticked articles in it are normally listed in the
-group buffer. If @code{gnus-list-groups-with-ticked-articles} is
-@code{nil}, these groups will be treated just like totally empty
-groups. It is @code{t} by default.
-
-
-@node Sorting Groups
-@section Sorting Groups
-@cindex sorting groups
-
-@kindex C-c C-s (Group)
-@findex gnus-group-sort-groups
-@vindex gnus-group-sort-function
-The @kbd{C-c C-s} (@code{gnus-group-sort-groups}) command sorts the
-group buffer according to the function(s) given by the
-@code{gnus-group-sort-function} variable. Available sorting functions
-include:
-
-@table @code
-
-@item gnus-group-sort-by-alphabet
-@findex gnus-group-sort-by-alphabet
-Sort the group names alphabetically. This is the default.
-
-@item gnus-group-sort-by-real-name
-@findex gnus-group-sort-by-real-name
-Sort the group alphabetically on the real (unprefixed) group names.
-
-@item gnus-group-sort-by-level
-@findex gnus-group-sort-by-level
-Sort by group level.
-
-@item gnus-group-sort-by-score
-@findex gnus-group-sort-by-score
-Sort by group score. @xref{Group Score}.
-
-@item gnus-group-sort-by-rank
-@findex gnus-group-sort-by-rank
-Sort by group score and then the group level. The level and the score
-are, when taken together, the group's @dfn{rank}. @xref{Group Score}.
-
-@item gnus-group-sort-by-unread
-@findex gnus-group-sort-by-unread
-Sort by number of unread articles.
-
-@item gnus-group-sort-by-method
-@findex gnus-group-sort-by-method
-Sort alphabetically on the select method.
-
-@item gnus-group-sort-by-server
-@findex gnus-group-sort-by-server
-Sort alphabetically on the Gnus server name.
-
-
-@end table
-
-@code{gnus-group-sort-function} can also be a list of sorting
-functions. In that case, the most significant sort key function must be
-the last one.
-
-
-There are also a number of commands for sorting directly according to
-some sorting criteria:
-
-@table @kbd
-@item G S a
-@kindex G S a (Group)
-@findex gnus-group-sort-groups-by-alphabet
-Sort the group buffer alphabetically by group name
-(@code{gnus-group-sort-groups-by-alphabet}).
-
-@item G S u
-@kindex G S u (Group)
-@findex gnus-group-sort-groups-by-unread
-Sort the group buffer by the number of unread articles
-(@code{gnus-group-sort-groups-by-unread}).
-
-@item G S l
-@kindex G S l (Group)
-@findex gnus-group-sort-groups-by-level
-Sort the group buffer by group level
-(@code{gnus-group-sort-groups-by-level}).
-
-@item G S v
-@kindex G S v (Group)
-@findex gnus-group-sort-groups-by-score
-Sort the group buffer by group score
-(@code{gnus-group-sort-groups-by-score}). @xref{Group Score}.
-
-@item G S r
-@kindex G S r (Group)
-@findex gnus-group-sort-groups-by-rank
-Sort the group buffer by group rank
-(@code{gnus-group-sort-groups-by-rank}). @xref{Group Score}.
-
-@item G S m
-@kindex G S m (Group)
-@findex gnus-group-sort-groups-by-method
-Sort the group buffer alphabetically by back end name@*
-(@code{gnus-group-sort-groups-by-method}).
-
-@item G S n
-@kindex G S n (Group)
-@findex gnus-group-sort-groups-by-real-name
-Sort the group buffer alphabetically by real (unprefixed) group name
-(@code{gnus-group-sort-groups-by-real-name}).
-
-@end table
-
-All the commands below obey the process/prefix convention
-(@pxref{Process/Prefix}).
-
-When given a symbolic prefix (@pxref{Symbolic Prefixes}), all these
-commands will sort in reverse order.
-
-You can also sort a subset of the groups:
-
-@table @kbd
-@item G P a
-@kindex G P a (Group)
-@findex gnus-group-sort-selected-groups-by-alphabet
-Sort the groups alphabetically by group name
-(@code{gnus-group-sort-selected-groups-by-alphabet}).
-
-@item G P u
-@kindex G P u (Group)
-@findex gnus-group-sort-selected-groups-by-unread
-Sort the groups by the number of unread articles
-(@code{gnus-group-sort-selected-groups-by-unread}).
-
-@item G P l
-@kindex G P l (Group)
-@findex gnus-group-sort-selected-groups-by-level
-Sort the groups by group level
-(@code{gnus-group-sort-selected-groups-by-level}).
-
-@item G P v
-@kindex G P v (Group)
-@findex gnus-group-sort-selected-groups-by-score
-Sort the groups by group score
-(@code{gnus-group-sort-selected-groups-by-score}). @xref{Group Score}.
-
-@item G P r
-@kindex G P r (Group)
-@findex gnus-group-sort-selected-groups-by-rank
-Sort the groups by group rank
-(@code{gnus-group-sort-selected-groups-by-rank}). @xref{Group Score}.
-
-@item G P m
-@kindex G P m (Group)
-@findex gnus-group-sort-selected-groups-by-method
-Sort the groups alphabetically by back end name@*
-(@code{gnus-group-sort-selected-groups-by-method}).
-
-@item G P n
-@kindex G P n (Group)
-@findex gnus-group-sort-selected-groups-by-real-name
-Sort the groups alphabetically by real (unprefixed) group name
-(@code{gnus-group-sort-selected-groups-by-real-name}).
-
-@item G P s
-@kindex G P s (Group)
-@findex gnus-group-sort-selected-groups
-Sort the groups according to @code{gnus-group-sort-function}.
-
-@end table
-
-And finally, note that you can use @kbd{C-k} and @kbd{C-y} to manually
-move groups around.
-
-
-@node Group Maintenance
-@section Group Maintenance
-@cindex bogus groups
-
-@table @kbd
-@item b
-@kindex b (Group)
-@findex gnus-group-check-bogus-groups
-Find bogus groups and delete them
-(@code{gnus-group-check-bogus-groups}).
-
-@item F
-@kindex F (Group)
-@findex gnus-group-find-new-groups
-Find new groups and process them (@code{gnus-group-find-new-groups}).
-With 1 @kbd{C-u}, use the @code{ask-server} method to query the server
-for new groups. With 2 @kbd{C-u}'s, use most complete method possible
-to query the server for new groups, and subscribe the new groups as
-zombies.
-
-@item C-c C-x
-@kindex C-c C-x (Group)
-@findex gnus-group-expire-articles
-@cindex expiring mail
-Run all expirable articles in the current group through the expiry
-process (if any) (@code{gnus-group-expire-articles}). That is, delete
-all expirable articles in the group that have been around for a while.
-(@pxref{Expiring Mail}).
-
-@item C-c C-M-x
-@kindex C-c C-M-x (Group)
-@findex gnus-group-expire-all-groups
-@cindex expiring mail
-Run all expirable articles in all groups through the expiry process
-(@code{gnus-group-expire-all-groups}).
-
-@end table
-
-
-@node Browse Foreign Server
-@section Browse Foreign Server
-@cindex foreign servers
-@cindex browsing servers
-
-@table @kbd
-@item B
-@kindex B (Group)
-@findex gnus-group-browse-foreign-server
-You will be queried for a select method and a server name. Gnus will
-then attempt to contact this server and let you browse the groups there
-(@code{gnus-group-browse-foreign-server}).
-@end table
-
-@findex gnus-browse-mode
-A new buffer with a list of available groups will appear. This buffer
-will use the @code{gnus-browse-mode}. This buffer looks a bit (well,
-a lot) like a normal group buffer.
-
-Here's a list of keystrokes available in the browse mode:
-
-@table @kbd
-@item n
-@kindex n (Browse)
-@findex gnus-group-next-group
-Go to the next group (@code{gnus-group-next-group}).
-
-@item p
-@kindex p (Browse)
-@findex gnus-group-prev-group
-Go to the previous group (@code{gnus-group-prev-group}).
-
-@item SPACE
-@kindex SPACE (Browse)
-@findex gnus-browse-read-group
-Enter the current group and display the first article
-(@code{gnus-browse-read-group}).
-
-@item RET
-@kindex RET (Browse)
-@findex gnus-browse-select-group
-Enter the current group (@code{gnus-browse-select-group}).
-
-@item u
-@kindex u (Browse)
-@findex gnus-browse-unsubscribe-current-group
-Unsubscribe to the current group, or, as will be the case here,
-subscribe to it (@code{gnus-browse-unsubscribe-current-group}).
-
-@item l
-@itemx q
-@kindex q (Browse)
-@kindex l (Browse)
-@findex gnus-browse-exit
-Exit browse mode (@code{gnus-browse-exit}).
-
-@item d
-@kindex d (Browse)
-@findex gnus-browse-describe-group
-Describe the current group (@code{gnus-browse-describe-group}).
-
-@item ?
-@kindex ? (Browse)
-@findex gnus-browse-describe-briefly
-Describe browse mode briefly (well, there's not much to describe, is
-there) (@code{gnus-browse-describe-briefly}).
-@end table
-
-
-@node Exiting Gnus
-@section Exiting Gnus
-@cindex exiting Gnus
-
-Yes, Gnus is ex(c)iting.
-
-@table @kbd
-@item z
-@kindex z (Group)
-@findex gnus-group-suspend
-Suspend Gnus (@code{gnus-group-suspend}). This doesn't really exit Gnus,
-but it kills all buffers except the Group buffer. I'm not sure why this
-is a gain, but then who am I to judge?
-
-@item q
-@kindex q (Group)
-@findex gnus-group-exit
-@c @icon{gnus-group-exit}
-Quit Gnus (@code{gnus-group-exit}).
-
-@item Q
-@kindex Q (Group)
-@findex gnus-group-quit
-Quit Gnus without saving the @file{.newsrc} files (@code{gnus-group-quit}).
-The dribble file will be saved, though (@pxref{Auto Save}).
-@end table
-
-@vindex gnus-exit-gnus-hook
-@vindex gnus-suspend-gnus-hook
-@vindex gnus-after-exiting-gnus-hook
-@code{gnus-suspend-gnus-hook} is called when you suspend Gnus and
-@code{gnus-exit-gnus-hook} is called when you quit Gnus, while
-@code{gnus-after-exiting-gnus-hook} is called as the final item when
-exiting Gnus.
-
-Note:
-
-@quotation
-Miss Lisa Cannifax, while sitting in English class, felt her feet go
-numbly heavy and herself fall into a hazy trance as the boy sitting
-behind her drew repeated lines with his pencil across the back of her
-plastic chair.
-@end quotation
-
-
-@node Group Topics
-@section Group Topics
-@cindex topics
-
-If you read lots and lots of groups, it might be convenient to group
-them hierarchically according to topics. You put your Emacs groups over
-here, your sex groups over there, and the rest (what, two groups or so?)
-you put in some misc section that you never bother with anyway. You can
-even group the Emacs sex groups as a sub-topic to either the Emacs
-groups or the sex groups---or both! Go wild!
-
-@iftex
-@iflatex
-\gnusfigure{Group Topics}{400}{
-\put(75,50){\epsfig{figure=ps/group-topic,height=9cm}}
-}
-@end iflatex
-@end iftex
-
-Here's an example:
-
-@example
-Gnus
- Emacs -- I wuw it!
- 3: comp.emacs
- 2: alt.religion.emacs
- Naughty Emacs
- 452: alt.sex.emacs
- 0: comp.talk.emacs.recovery
- Misc
- 8: comp.binaries.fractals
- 13: comp.sources.unix
-@end example
-
-@findex gnus-topic-mode
-@kindex t (Group)
-To get this @emph{fab} functionality you simply turn on (ooh!) the
-@code{gnus-topic} minor mode---type @kbd{t} in the group buffer. (This
-is a toggling command.)
-
-Go ahead, just try it. I'll still be here when you get back. La de
-dum@dots{} Nice tune, that@dots{} la la la@dots{} What, you're back?
-Yes, and now press @kbd{l}. There. All your groups are now listed
-under @samp{misc}. Doesn't that make you feel all warm and fuzzy?
-Hot and bothered?
-
-If you want this permanently enabled, you should add that minor mode to
-the hook for the group mode. Put the following line in your
-@file{~/.gnus.el} file:
-
-@lisp
-(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
-@end lisp
-
-@menu
-* Topic Commands:: Interactive E-Z commands.
-* Topic Variables:: How to customize the topics the Lisp Way.
-* Topic Sorting:: Sorting each topic individually.
-* Topic Topology:: A map of the world.
-* Topic Parameters:: Parameters that apply to all groups in a topic.
-@end menu
-
-
-@node Topic Commands
-@subsection Topic Commands
-@cindex topic commands
-
-When the topic minor mode is turned on, a new @kbd{T} submap will be
-available. In addition, a few of the standard keys change their
-definitions slightly.
-
-In general, the following kinds of operations are possible on topics.
-First of all, you want to create topics. Secondly, you want to put
-groups in topics and to move them around until you have an order you
-like. The third kind of operation is to show/hide parts of the whole
-shebang. You might want to hide a topic including its subtopics and
-groups, to get a better overview of the other groups.
-
-Here is a list of the basic keys that you might need to set up topics
-the way you like.
-
-@table @kbd
-
-@item T n
-@kindex T n (Topic)
-@findex gnus-topic-create-topic
-Prompt for a new topic name and create it
-(@code{gnus-topic-create-topic}).
-
-@item T TAB
-@itemx TAB
-@kindex T TAB (Topic)
-@kindex TAB (Topic)
-@findex gnus-topic-indent
-``Indent'' the current topic so that it becomes a sub-topic of the
-previous topic (@code{gnus-topic-indent}). If given a prefix,
-``un-indent'' the topic instead.
-
-@item M-TAB
-@kindex M-TAB (Topic)
-@findex gnus-topic-unindent
-``Un-indent'' the current topic so that it becomes a sub-topic of the
-parent of its current parent (@code{gnus-topic-unindent}).
-
-@end table
-
-The following two keys can be used to move groups and topics around.
-They work like the well-known cut and paste. @kbd{C-k} is like cut and
-@kbd{C-y} is like paste. Of course, this being Emacs, we use the terms
-kill and yank rather than cut and paste.
-
-@table @kbd
-
-@item C-k
-@kindex C-k (Topic)
-@findex gnus-topic-kill-group
-Kill a group or topic (@code{gnus-topic-kill-group}). All groups in the
-topic will be removed along with the topic.
-
-@item C-y
-@kindex C-y (Topic)
-@findex gnus-topic-yank-group
-Yank the previously killed group or topic
-(@code{gnus-topic-yank-group}). Note that all topics will be yanked
-before all groups.
-
-So, to move a topic to the beginning of the list of topics, just hit
-@kbd{C-k} on it. This is like the ``cut'' part of cut and paste. Then,
-move the cursor to the beginning of the buffer (just below the ``Gnus''
-topic) and hit @kbd{C-y}. This is like the ``paste'' part of cut and
-paste. Like I said -- E-Z.
-
-You can use @kbd{C-k} and @kbd{C-y} on groups as well as on topics. So
-you can move topics around as well as groups.
-
-@end table
-
-After setting up the topics the way you like them, you might wish to
-hide a topic, or to show it again. That's why we have the following
-key.
-
-@table @kbd
-
-@item RET
-@kindex RET (Topic)
-@findex gnus-topic-select-group
-@itemx SPACE
-Either select a group or fold a topic (@code{gnus-topic-select-group}).
-When you perform this command on a group, you'll enter the group, as
-usual. When done on a topic line, the topic will be folded (if it was
-visible) or unfolded (if it was folded already). So it's basically a
-toggling command on topics. In addition, if you give a numerical
-prefix, group on that level (and lower) will be displayed.
-
-@end table
-
-Now for a list of other commands, in no particular order.
-
-@table @kbd
-
-@item T m
-@kindex T m (Topic)
-@findex gnus-topic-move-group
-Move the current group to some other topic
-(@code{gnus-topic-move-group}). This command uses the process/prefix
-convention (@pxref{Process/Prefix}).
-
-@item T j
-@kindex T j (Topic)
-@findex gnus-topic-jump-to-topic
-Go to a topic (@code{gnus-topic-jump-to-topic}).
-
-@item T c
-@kindex T c (Topic)
-@findex gnus-topic-copy-group
-Copy the current group to some other topic
-(@code{gnus-topic-copy-group}). This command uses the process/prefix
-convention (@pxref{Process/Prefix}).
-
-@item T h
-@kindex T h (Topic)
-@findex gnus-topic-hide-topic
-Hide the current topic (@code{gnus-topic-hide-topic}). If given
-a prefix, hide the topic permanently.
-
-@item T s
-@kindex T s (Topic)
-@findex gnus-topic-show-topic
-Show the current topic (@code{gnus-topic-show-topic}). If given
-a prefix, show the topic permanently.
-
-@item T D
-@kindex T D (Topic)
-@findex gnus-topic-remove-group
-Remove a group from the current topic (@code{gnus-topic-remove-group}).
-This command is mainly useful if you have the same group in several
-topics and wish to remove it from one of the topics. You may also
-remove a group from all topics, but in that case, Gnus will add it to
-the root topic the next time you start Gnus. In fact, all new groups
-(which, naturally, don't belong to any topic) will show up in the root
-topic.
-
-This command uses the process/prefix convention
-(@pxref{Process/Prefix}).
-
-@item T M
-@kindex T M (Topic)
-@findex gnus-topic-move-matching
-Move all groups that match some regular expression to a topic
-(@code{gnus-topic-move-matching}).
-
-@item T C
-@kindex T C (Topic)
-@findex gnus-topic-copy-matching
-Copy all groups that match some regular expression to a topic
-(@code{gnus-topic-copy-matching}).
-
-@item T H
-@kindex T H (Topic)
-@findex gnus-topic-toggle-display-empty-topics
-Toggle hiding empty topics
-(@code{gnus-topic-toggle-display-empty-topics}).
-
-@item T #
-@kindex T # (Topic)
-@findex gnus-topic-mark-topic
-Mark all groups in the current topic with the process mark
-(@code{gnus-topic-mark-topic}). This command works recursively on
-sub-topics unless given a prefix.
-
-@item T M-#
-@kindex T M-# (Topic)
-@findex gnus-topic-unmark-topic
-Remove the process mark from all groups in the current topic
-(@code{gnus-topic-unmark-topic}). This command works recursively on
-sub-topics unless given a prefix.
-
-@item C-c C-x
-@kindex C-c C-x (Topic)
-@findex gnus-topic-expire-articles
-@cindex expiring mail
-Run all expirable articles in the current group or topic through the
-expiry process (if any)
-(@code{gnus-topic-expire-articles}). (@pxref{Expiring Mail}).
-
-@item T r
-@kindex T r (Topic)
-@findex gnus-topic-rename
-Rename a topic (@code{gnus-topic-rename}).
-
-@item T DEL
-@kindex T DEL (Topic)
-@findex gnus-topic-delete
-Delete an empty topic (@code{gnus-topic-delete}).
-
-@item A T
-@kindex A T (Topic)
-@findex gnus-topic-list-active
-List all groups that Gnus knows about in a topics-ified way
-(@code{gnus-topic-list-active}).
-
-@item T M-n
-@kindex T M-n (Topic)
-@findex gnus-topic-goto-next-topic
-Go to the next topic (@code{gnus-topic-goto-next-topic}).
-
-@item T M-p
-@kindex T M-p (Topic)
-@findex gnus-topic-goto-previous-topic
-Go to the next topic (@code{gnus-topic-goto-previous-topic}).
-
-@item G p
-@kindex G p (Topic)
-@findex gnus-topic-edit-parameters
-@cindex group parameters
-@cindex topic parameters
-@cindex parameters
-Edit the topic parameters (@code{gnus-topic-edit-parameters}).
-@xref{Topic Parameters}.
-
-@end table
-
-
-@node Topic Variables
-@subsection Topic Variables
-@cindex topic variables
-
-The previous section told you how to tell Gnus which topics to display.
-This section explains how to tell Gnus what to display about each topic.
-
-@vindex gnus-topic-line-format
-The topic lines themselves are created according to the
-@code{gnus-topic-line-format} variable (@pxref{Formatting Variables}).
-Valid elements are:
-
-@table @samp
-@item i
-Indentation.
-@item n
-Topic name.
-@item v
-Visibility.
-@item l
-Level.
-@item g
-Number of groups in the topic.
-@item a
-Number of unread articles in the topic.
-@item A
-Number of unread articles in the topic and all its subtopics.
-@end table
-
-@vindex gnus-topic-indent-level
-Each sub-topic (and the groups in the sub-topics) will be indented with
-@code{gnus-topic-indent-level} times the topic level number of spaces.
-The default is 2.
-
-@vindex gnus-topic-mode-hook
-@code{gnus-topic-mode-hook} is called in topic minor mode buffers.
-
-@vindex gnus-topic-display-empty-topics
-The @code{gnus-topic-display-empty-topics} says whether to display even
-topics that have no unread articles in them. The default is @code{t}.
-
-
-@node Topic Sorting
-@subsection Topic Sorting
-@cindex topic sorting
-
-You can sort the groups in each topic individually with the following
-commands:
-
-
-@table @kbd
-@item T S a
-@kindex T S a (Topic)
-@findex gnus-topic-sort-groups-by-alphabet
-Sort the current topic alphabetically by group name
-(@code{gnus-topic-sort-groups-by-alphabet}).
-
-@item T S u
-@kindex T S u (Topic)
-@findex gnus-topic-sort-groups-by-unread
-Sort the current topic by the number of unread articles
-(@code{gnus-topic-sort-groups-by-unread}).
-
-@item T S l
-@kindex T S l (Topic)
-@findex gnus-topic-sort-groups-by-level
-Sort the current topic by group level
-(@code{gnus-topic-sort-groups-by-level}).
-
-@item T S v
-@kindex T S v (Topic)
-@findex gnus-topic-sort-groups-by-score
-Sort the current topic by group score
-(@code{gnus-topic-sort-groups-by-score}). @xref{Group Score}.
-
-@item T S r
-@kindex T S r (Topic)
-@findex gnus-topic-sort-groups-by-rank
-Sort the current topic by group rank
-(@code{gnus-topic-sort-groups-by-rank}). @xref{Group Score}.
-
-@item T S m
-@kindex T S m (Topic)
-@findex gnus-topic-sort-groups-by-method
-Sort the current topic alphabetically by back end name
-(@code{gnus-topic-sort-groups-by-method}).
-
-@item T S e
-@kindex T S e (Topic)
-@findex gnus-topic-sort-groups-by-server
-Sort the current topic alphabetically by server name
-(@code{gnus-topic-sort-groups-by-server}).
-
-@item T S s
-@kindex T S s (Topic)
-@findex gnus-topic-sort-groups
-Sort the current topic according to the function(s) given by the
-@code{gnus-group-sort-function} variable
-(@code{gnus-topic-sort-groups}).
-
-@end table
-
-When given a prefix argument, all these commands will sort in reverse
-order. @xref{Sorting Groups}, for more information about group
-sorting.
-
-
-@node Topic Topology
-@subsection Topic Topology
-@cindex topic topology
-@cindex topology
-
-So, let's have a look at an example group buffer:
-
-@example
-@group
-Gnus
- Emacs -- I wuw it!
- 3: comp.emacs
- 2: alt.religion.emacs
- Naughty Emacs
- 452: alt.sex.emacs
- 0: comp.talk.emacs.recovery
- Misc
- 8: comp.binaries.fractals
- 13: comp.sources.unix
-@end group
-@end example
-
-So, here we have one top-level topic (@samp{Gnus}), two topics under
-that, and one sub-topic under one of the sub-topics. (There is always
-just one (1) top-level topic). This topology can be expressed as
-follows:
-
-@lisp
-(("Gnus" visible)
- (("Emacs -- I wuw it!" visible)
- (("Naughty Emacs" visible)))
- (("Misc" visible)))
-@end lisp
-
-@vindex gnus-topic-topology
-This is in fact how the variable @code{gnus-topic-topology} would look
-for the display above. That variable is saved in the @file{.newsrc.eld}
-file, and shouldn't be messed with manually---unless you really want
-to. Since this variable is read from the @file{.newsrc.eld} file,
-setting it in any other startup files will have no effect.
-
-This topology shows what topics are sub-topics of what topics (right),
-and which topics are visible. Two settings are currently
-allowed---@code{visible} and @code{invisible}.
-
-
-@node Topic Parameters
-@subsection Topic Parameters
-@cindex topic parameters
-
-All groups in a topic will inherit group parameters from the parent
-(and ancestor) topic parameters. All valid group parameters are valid
-topic parameters (@pxref{Group Parameters}). When the agent is
-enabled, all agent parameters (See Agent Parameters in @ref{Category
-Syntax}) are also valid topic parameters.
-
-In addition, the following parameters are only valid as topic
-parameters:
-
-@table @code
-@item subscribe
-When subscribing new groups by topic (@pxref{Subscription Methods}), the
-@code{subscribe} topic parameter says what groups go in what topic. Its
-value should be a regexp to match the groups that should go in that
-topic.
-
-@item subscribe-level
-When subscribing new groups by topic (see the @code{subscribe} parameter),
-the group will be subscribed with the level specified in the
-@code{subscribe-level} instead of @code{gnus-level-default-subscribed}.
-
-@end table
-
-Group parameters (of course) override topic parameters, and topic
-parameters in sub-topics override topic parameters in super-topics. You
-know. Normal inheritance rules. (@dfn{Rules} is here a noun, not a
-verb, although you may feel free to disagree with me here.)
-
-@example
-@group
-Gnus
- Emacs
- 3: comp.emacs
- 2: alt.religion.emacs
- 452: alt.sex.emacs
- Relief
- 452: alt.sex.emacs
- 0: comp.talk.emacs.recovery
- Misc
- 8: comp.binaries.fractals
- 13: comp.sources.unix
- 452: alt.sex.emacs
-@end group
-@end example
-
-The @samp{Emacs} topic has the topic parameter @code{(score-file
-. "emacs.SCORE")}; the @samp{Relief} topic has the topic parameter
-@code{(score-file . "relief.SCORE")}; and the @samp{Misc} topic has the
-topic parameter @code{(score-file . "emacs.SCORE")}. In addition,
-@* @samp{alt.religion.emacs} has the group parameter @code{(score-file
-. "religion.SCORE")}.
-
-Now, when you enter @samp{alt.sex.emacs} in the @samp{Relief} topic, you
-will get the @file{relief.SCORE} home score file. If you enter the same
-group in the @samp{Emacs} topic, you'll get the @file{emacs.SCORE} home
-score file. If you enter the group @samp{alt.religion.emacs}, you'll
-get the @file{religion.SCORE} home score file.
-
-This seems rather simple and self-evident, doesn't it? Well, yes. But
-there are some problems, especially with the @code{total-expiry}
-parameter. Say you have a mail group in two topics; one with
-@code{total-expiry} and one without. What happens when you do @kbd{M-x
-gnus-expire-all-expirable-groups}? Gnus has no way of telling which one
-of these topics you mean to expire articles from, so anything may
-happen. In fact, I hereby declare that it is @dfn{undefined} what
-happens. You just have to be careful if you do stuff like that.
-
-
-@node Misc Group Stuff
-@section Misc Group Stuff
-
-@menu
-* Scanning New Messages:: Asking Gnus to see whether new messages have arrived.
-* Group Information:: Information and help on groups and Gnus.
-* Group Timestamp:: Making Gnus keep track of when you last read a group.
-* File Commands:: Reading and writing the Gnus files.
-* Sieve Commands:: Managing Sieve scripts.
-@end menu
-
-@table @kbd
-
-@item v
-@kindex v (Group)
-@cindex keys, reserved for users (Group)
-The key @kbd{v} is reserved for users. You can bind it to some
-command or better use it as a prefix key. For example:
-
-@lisp
-(define-key gnus-group-mode-map (kbd "v j d")
- (lambda ()
- (interactive)
- (gnus-group-jump-to-group "nndraft:drafts")))
-@end lisp
-
-On keys reserved for users in Emacs and on keybindings in general
-@xref{Keymaps, Keymaps, , emacs, The Emacs Editor}.
-
-@item ^
-@kindex ^ (Group)
-@findex gnus-group-enter-server-mode
-Enter the server buffer (@code{gnus-group-enter-server-mode}).
-@xref{Server Buffer}.
-
-@item a
-@kindex a (Group)
-@findex gnus-group-post-news
-Start composing a message (a news by default)
-(@code{gnus-group-post-news}). If given a prefix, post to the group
-under the point. If the prefix is 1, prompt for a group to post to.
-Contrary to what the name of this function suggests, the prepared
-article might be a mail instead of a news, if a mail group is specified
-with the prefix argument. @xref{Composing Messages}.
-
-@item m
-@kindex m (Group)
-@findex gnus-group-mail
-Mail a message somewhere (@code{gnus-group-mail}). If given a prefix,
-use the posting style of the group under the point. If the prefix is 1,
-prompt for a group name to find the posting style.
-@xref{Composing Messages}.
-
-@item i
-@kindex i (Group)
-@findex gnus-group-news
-Start composing a news (@code{gnus-group-news}). If given a prefix,
-post to the group under the point. If the prefix is 1, prompt
-for group to post to. @xref{Composing Messages}.
-
-This function actually prepares a news even when using mail groups.
-This is useful for ``posting'' messages to mail groups without actually
-sending them over the network: they're just saved directly to the group
-in question. The corresponding back end must have a request-post method
-for this to work though.
-
-@end table
-
-Variables for the group buffer:
-
-@table @code
-
-@item gnus-group-mode-hook
-@vindex gnus-group-mode-hook
-is called after the group buffer has been
-created.
-
-@item gnus-group-prepare-hook
-@vindex gnus-group-prepare-hook
-is called after the group buffer is
-generated. It may be used to modify the buffer in some strange,
-unnatural way.
-
-@item gnus-group-prepared-hook
-@vindex gnus-group-prepare-hook
-is called as the very last thing after the group buffer has been
-generated. It may be used to move point around, for instance.
-
-@item gnus-permanently-visible-groups
-@vindex gnus-permanently-visible-groups
-Groups matching this regexp will always be listed in the group buffer,
-whether they are empty or not.
-
-@item gnus-group-name-charset-method-alist
-@vindex gnus-group-name-charset-method-alist
-An alist of method and the charset for group names. It is used to show
-non-@acronym{ASCII} group names.
-
-For example:
-@lisp
-(setq gnus-group-name-charset-method-alist
- '(((nntp "news.com.cn") . cn-gb-2312)))
-@end lisp
-
-@item gnus-group-name-charset-group-alist
-@cindex UTF-8 group names
-@vindex gnus-group-name-charset-group-alist
-An alist of regexp of group name and the charset for group names. It
-is used to show non-@acronym{ASCII} group names. @code{((".*"
-utf-8))} is the default value if UTF-8 is supported, otherwise the
-default is @code{nil}.
-
-For example:
-@lisp
-(setq gnus-group-name-charset-group-alist
- '(("\\.com\\.cn:" . cn-gb-2312)))
-@end lisp
-
-@end table
-
-@node Scanning New Messages
-@subsection Scanning New Messages
-@cindex new messages
-@cindex scanning new news
-
-@table @kbd
-
-@item g
-@kindex g (Group)
-@findex gnus-group-get-new-news
-@c @icon{gnus-group-get-new-news}
-Check the server(s) for new articles. If the numerical prefix is used,
-this command will check only groups of level @var{arg} and lower
-(@code{gnus-group-get-new-news}). If given a non-numerical prefix, this
-command will force a total re-reading of the active file(s) from the
-back end(s).
-
-@item M-g
-@kindex M-g (Group)
-@findex gnus-group-get-new-news-this-group
-@vindex gnus-goto-next-group-when-activating
-@c @icon{gnus-group-get-new-news-this-group}
-Check whether new articles have arrived in the current group
-(@code{gnus-group-get-new-news-this-group}).
-@code{gnus-goto-next-group-when-activating} says whether this command is
-to move point to the next group or not. It is @code{t} by default.
-
-@findex gnus-activate-all-groups
-@cindex activating groups
-@item C-c M-g
-@kindex C-c M-g (Group)
-Activate absolutely all groups (@code{gnus-activate-all-groups}).
-
-@item R
-@kindex R (Group)
-@cindex restarting
-@findex gnus-group-restart
-Restart Gnus (@code{gnus-group-restart}). This saves the @file{.newsrc}
-file(s), closes the connection to all servers, clears up all run-time
-Gnus variables, and then starts Gnus all over again.
-
-@end table
-
-@vindex gnus-get-new-news-hook
-@code{gnus-get-new-news-hook} is run just before checking for new news.
-
-@vindex gnus-after-getting-new-news-hook
-@code{gnus-after-getting-new-news-hook} is run after checking for new
-news.
-
-
-@node Group Information
-@subsection Group Information
-@cindex group information
-@cindex information on groups
-
-@table @kbd
-
-
-@item H f
-@kindex H f (Group)
-@findex gnus-group-fetch-faq
-@vindex gnus-group-faq-directory
-@cindex FAQ
-@cindex ange-ftp
-Try to fetch the @acronym{FAQ} for the current group
-(@code{gnus-group-fetch-faq}). Gnus will try to get the @acronym{FAQ}
-from @code{gnus-group-faq-directory}, which is usually a directory on
-a remote machine. This variable can also be a list of directories.
-In that case, giving a prefix to this command will allow you to choose
-between the various sites. @code{ange-ftp} (or @code{efs}) will be
-used for fetching the file.
-
-If fetching from the first site is unsuccessful, Gnus will attempt to go
-through @code{gnus-group-faq-directory} and try to open them one by one.
-
-@item H c
-@kindex H c (Group)
-@findex gnus-group-fetch-charter
-@vindex gnus-group-charter-alist
-@cindex charter
-Try to open the charter for the current group in a web browser
-(@code{gnus-group-fetch-charter}). Query for a group if given a
-prefix argument.
-
-Gnus will use @code{gnus-group-charter-alist} to find the location of
-the charter. If no location is known, Gnus will fetch the control
-messages for the group, which in some cases includes the charter.
-
-@item H C
-@kindex H C (Group)
-@findex gnus-group-fetch-control
-@vindex gnus-group-fetch-control-use-browse-url
-@cindex control message
-Fetch the control messages for the group from the archive at
-@code{ftp.isc.org} (@code{gnus-group-fetch-control}). Query for a
-group if given a prefix argument.
-
-If @code{gnus-group-fetch-control-use-browse-url} is non-@code{nil},
-Gnus will open the control messages in a browser using
-@code{browse-url}. Otherwise they are fetched using @code{ange-ftp}
-and displayed in an ephemeral group.
-
-Note that the control messages are compressed. To use this command
-you need to turn on @code{auto-compression-mode} (@pxref{Compressed
-Files, ,Compressed Files, emacs, The Emacs Manual}).
-
-@item H d
-@itemx C-c C-d
-@c @icon{gnus-group-describe-group}
-@kindex H d (Group)
-@kindex C-c C-d (Group)
-@cindex describing groups
-@cindex group description
-@findex gnus-group-describe-group
-Describe the current group (@code{gnus-group-describe-group}). If given
-a prefix, force Gnus to re-read the description from the server.
-
-@item M-d
-@kindex M-d (Group)
-@findex gnus-group-describe-all-groups
-Describe all groups (@code{gnus-group-describe-all-groups}). If given a
-prefix, force Gnus to re-read the description file from the server.
-
-@item H v
-@itemx V
-@kindex V (Group)
-@kindex H v (Group)
-@cindex version
-@findex gnus-version
-Display current Gnus version numbers (@code{gnus-version}).
-
-@item ?
-@kindex ? (Group)
-@findex gnus-group-describe-briefly
-Give a very short help message (@code{gnus-group-describe-briefly}).
-
-@item C-c C-i
-@kindex C-c C-i (Group)
-@cindex info
-@cindex manual
-@findex gnus-info-find-node
-Go to the Gnus info node (@code{gnus-info-find-node}).
-@end table
-
-
-@node Group Timestamp
-@subsection Group Timestamp
-@cindex timestamps
-@cindex group timestamps
-
-It can be convenient to let Gnus keep track of when you last read a
-group. To set the ball rolling, you should add
-@code{gnus-group-set-timestamp} to @code{gnus-select-group-hook}:
-
-@lisp
-(add-hook 'gnus-select-group-hook 'gnus-group-set-timestamp)
-@end lisp
-
-After doing this, each time you enter a group, it'll be recorded.
-
-This information can be displayed in various ways---the easiest is to
-use the @samp{%d} spec in the group line format:
-
-@lisp
-(setq gnus-group-line-format
- "%M\%S\%p\%P\%5y: %(%-40,40g%) %d\n")
-@end lisp
-
-This will result in lines looking like:
-
-@example
-* 0: mail.ding 19961002T012943
- 0: custom 19961002T012713
-@end example
-
-As you can see, the date is displayed in compact ISO 8601 format. This
-may be a bit too much, so to just display the date, you could say
-something like:
-
-@lisp
-(setq gnus-group-line-format
- "%M\%S\%p\%P\%5y: %(%-40,40g%) %6,6~(cut 2)d\n")
-@end lisp
-
-If you would like greater control of the time format, you can use a
-user-defined format spec. Something like the following should do the
-trick:
-
-@lisp
-(setq gnus-group-line-format
- "%M\%S\%p\%P\%5y: %(%-40,40g%) %ud\n")
-(defun gnus-user-format-function-d (headers)
- (let ((time (gnus-group-timestamp gnus-tmp-group)))
- (if time
- (format-time-string "%b %d %H:%M" time)
- "")))
-@end lisp
-
-
-@node File Commands
-@subsection File Commands
-@cindex file commands
-
-@table @kbd
-
-@item r
-@kindex r (Group)
-@findex gnus-group-read-init-file
-@vindex gnus-init-file
-@cindex reading init file
-Re-read the init file (@code{gnus-init-file}, which defaults to
-@file{~/.gnus.el}) (@code{gnus-group-read-init-file}).
-
-@item s
-@kindex s (Group)
-@findex gnus-group-save-newsrc
-@cindex saving .newsrc
-Save the @file{.newsrc.eld} file (and @file{.newsrc} if wanted)
-(@code{gnus-group-save-newsrc}). If given a prefix, force saving the
-file(s) whether Gnus thinks it is necessary or not.
-
-@c @item Z
-@c @kindex Z (Group)
-@c @findex gnus-group-clear-dribble
-@c Clear the dribble buffer (@code{gnus-group-clear-dribble}).
-
-@end table
-
-
-@node Sieve Commands
-@subsection Sieve Commands
-@cindex group sieve commands
-
-Sieve is a server-side mail filtering language. In Gnus you can use
-the @code{sieve} group parameter (@pxref{Group Parameters}) to specify
-sieve rules that should apply to each group. Gnus provides two
-commands to translate all these group parameters into a proper Sieve
-script that can be transfered to the server somehow.
-
-@vindex gnus-sieve-file
-@vindex gnus-sieve-region-start
-@vindex gnus-sieve-region-end
-The generated Sieve script is placed in @code{gnus-sieve-file} (by
-default @file{~/.sieve}). The Sieve code that Gnus generate is placed
-between two delimiters, @code{gnus-sieve-region-start} and
-@code{gnus-sieve-region-end}, so you may write additional Sieve code
-outside these delimiters that will not be removed the next time you
-regenerate the Sieve script.
-
-@vindex gnus-sieve-crosspost
-The variable @code{gnus-sieve-crosspost} controls how the Sieve script
-is generated. If it is non-@code{nil} (the default) articles is
-placed in all groups that have matching rules, otherwise the article
-is only placed in the group with the first matching rule. For
-example, the group parameter @samp{(sieve address "sender"
-"owner-ding@@hpc.uh.edu")} will generate the following piece of Sieve
-code if @code{gnus-sieve-crosspost} is @code{nil}. (When
-@code{gnus-sieve-crosspost} is non-@code{nil}, it looks the same
-except that the line containing the call to @code{stop} is removed.)
-
-@example
-if address "sender" "owner-ding@@hpc.uh.edu" @{
- fileinto "INBOX.ding";
- stop;
-@}
-@end example
-
-@xref{Top, Emacs Sieve, Top, sieve, Emacs Sieve}.
-
-@table @kbd
-
-@item D g
-@kindex D g (Group)
-@findex gnus-sieve-generate
-@vindex gnus-sieve-file
-@cindex generating sieve script
-Regenerate a Sieve script from the @code{sieve} group parameters and
-put you into the @code{gnus-sieve-file} without saving it.
-
-@item D u
-@kindex D u (Group)
-@findex gnus-sieve-update
-@vindex gnus-sieve-file
-@cindex updating sieve script
-Regenerates the Gnus managed part of @code{gnus-sieve-file} using the
-@code{sieve} group parameters, save the file and upload it to the
-server using the @code{sieveshell} program.
-
-@end table
-
-
-@node Summary Buffer
-@chapter Summary Buffer
-@cindex summary buffer
-
-A line for each article is displayed in the summary buffer. You can
-move around, read articles, post articles and reply to articles.
-
-The most common way to a summary buffer is to select a group from the
-group buffer (@pxref{Selecting a Group}).
-
-You can have as many summary buffers open as you wish.
-
-You can customize the Summary Mode tool bar, see @kbd{M-x
-customize-apropos RET gnus-summary-tool-bar}. This feature is only
-available in Emacs.
-
-@kindex v (Summary)
-@cindex keys, reserved for users (Summary)
-The key @kbd{v} is reserved for users. You can bind it to some
-command or better use it as a prefix key. For example:
-@lisp
-(define-key gnus-summary-mode-map (kbd "v -") "LrS") ;; lower subthread
-@end lisp
-
-@menu
-* Summary Buffer Format:: Deciding how the summary buffer is to look.
-* Summary Maneuvering:: Moving around the summary buffer.
-* Choosing Articles:: Reading articles.
-* Paging the Article:: Scrolling the current article.
-* Reply Followup and Post:: Posting articles.
-* Delayed Articles:: Send articles at a later time.
-* Marking Articles:: Marking articles as read, expirable, etc.
-* Limiting:: You can limit the summary buffer.
-* Threading:: How threads are made.
-* Sorting the Summary Buffer:: How articles and threads are sorted.
-* Asynchronous Fetching:: Gnus might be able to pre-fetch articles.
-* Article Caching:: You may store articles in a cache.
-* Persistent Articles:: Making articles expiry-resistant.
-* Article Backlog:: Having already read articles hang around.
-* Saving Articles:: Ways of customizing article saving.
-* Decoding Articles:: Gnus can treat series of (uu)encoded articles.
-* Article Treatment:: The article buffer can be mangled at will.
-* MIME Commands:: Doing MIMEy things with the articles.
-* Charsets:: Character set issues.
-* Article Commands:: Doing various things with the article buffer.
-* Summary Sorting:: Sorting the summary buffer in various ways.
-* Finding the Parent:: No child support? Get the parent.
-* Alternative Approaches:: Reading using non-default summaries.
-* Tree Display:: A more visual display of threads.
-* Mail Group Commands:: Some commands can only be used in mail groups.
-* Various Summary Stuff:: What didn't fit anywhere else.
-* Exiting the Summary Buffer:: Returning to the Group buffer,
- or reselecting the current group.
-* Crosspost Handling:: How crossposted articles are dealt with.
-* Duplicate Suppression:: An alternative when crosspost handling fails.
-* Security:: Decrypt and Verify.
-* Mailing List:: Mailing list minor mode.
-@end menu
-
-
-@node Summary Buffer Format
-@section Summary Buffer Format
-@cindex summary buffer format
-
-@iftex
-@iflatex
-\gnusfigure{The Summary Buffer}{180}{
-\put(0,0){\epsfig{figure=ps/summary,width=7.5cm}}
-\put(445,0){\makebox(0,0)[br]{\epsfig{figure=ps/summary-article,width=7.5cm}}}
-}
-@end iflatex
-@end iftex
-
-@menu
-* Summary Buffer Lines:: You can specify how summary lines should look.
-* To From Newsgroups:: How to not display your own name.
-* Summary Buffer Mode Line:: You can say how the mode line should look.
-* Summary Highlighting:: Making the summary buffer all pretty and nice.
-@end menu
-
-@findex mail-extract-address-components
-@findex gnus-extract-address-components
-@vindex gnus-extract-address-components
-Gnus will use the value of the @code{gnus-extract-address-components}
-variable as a function for getting the name and address parts of a
-@code{From} header. Two pre-defined functions exist:
-@code{gnus-extract-address-components}, which is the default, quite
-fast, and too simplistic solution; and
-@code{mail-extract-address-components}, which works very nicely, but is
-slower. The default function will return the wrong answer in 5% of the
-cases. If this is unacceptable to you, use the other function instead:
-
-@lisp
-(setq gnus-extract-address-components
- 'mail-extract-address-components)
-@end lisp
-
-@vindex gnus-summary-same-subject
-@code{gnus-summary-same-subject} is a string indicating that the current
-article has the same subject as the previous. This string will be used
-with those specs that require it. The default is @code{""}.
-
-
-@node Summary Buffer Lines
-@subsection Summary Buffer Lines
-
-@vindex gnus-summary-line-format
-You can change the format of the lines in the summary buffer by changing
-the @code{gnus-summary-line-format} variable. It works along the same
-lines as a normal @code{format} string, with some extensions
-(@pxref{Formatting Variables}).
-
-There should always be a colon or a point position marker on the line;
-the cursor always moves to the point position marker or the colon after
-performing an operation. (Of course, Gnus wouldn't be Gnus if it wasn't
-possible to change this. Just write a new function
-@code{gnus-goto-colon} which does whatever you like with the cursor.)
-@xref{Positioning Point}.
-
-The default string is @samp{%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n}.
-
-The following format specification characters and extended format
-specification(s) are understood:
-
-@table @samp
-@item N
-Article number.
-@item S
-Subject string. List identifiers stripped,
-@code{gnus-list-identifiers}. @xref{Article Hiding}.
-@item s
-Subject if the article is the root of the thread or the previous article
-had a different subject, @code{gnus-summary-same-subject} otherwise.
-(@code{gnus-summary-same-subject} defaults to @code{""}.)
-@item F
-Full @code{From} header.
-@item n
-The name (from the @code{From} header).
-@item f
-The name, @code{To} header or the @code{Newsgroups} header (@pxref{To
-From Newsgroups}).
-@item a
-The name (from the @code{From} header). This differs from the @code{n}
-spec in that it uses the function designated by the
-@code{gnus-extract-address-components} variable, which is slower, but
-may be more thorough.
-@item A
-The address (from the @code{From} header). This works the same way as
-the @code{a} spec.
-@item L
-Number of lines in the article.
-@item c
-Number of characters in the article. This specifier is not supported
-in some methods (like nnfolder).
-@item k
-Pretty-printed version of the number of characters in the article;
-for example, @samp{1.2k} or @samp{0.4M}.
-@item I
-Indentation based on thread level (@pxref{Customizing Threading}).
-@item B
-A complex trn-style thread tree, showing response-connecting trace
-lines. A thread could be drawn like this:
-
-@example
->
-+->
-| +->
-| | \->
-| | \->
-| \->
-+->
-\->
-@end example
-
-You can customize the appearance with the following options. Note
-that it is possible to make the thread display look really neat by
-replacing the default @acronym{ASCII} characters with graphic
-line-drawing glyphs.
-@table @code
-@item gnus-sum-thread-tree-root
-@vindex gnus-sum-thread-tree-root
-Used for the root of a thread. If @code{nil}, use subject
-instead. The default is @samp{> }.
-
-@item gnus-sum-thread-tree-false-root
-@vindex gnus-sum-thread-tree-false-root
-Used for the false root of a thread (@pxref{Loose Threads}). If
-@code{nil}, use subject instead. The default is @samp{> }.
-
-@item gnus-sum-thread-tree-single-indent
-@vindex gnus-sum-thread-tree-single-indent
-Used for a thread with just one message. If @code{nil}, use subject
-instead. The default is @samp{}.
-
-@item gnus-sum-thread-tree-vertical
-@vindex gnus-sum-thread-tree-vertical
-Used for drawing a vertical line. The default is @samp{| }.
-
-@item gnus-sum-thread-tree-indent
-@vindex gnus-sum-thread-tree-indent
-Used for indenting. The default is @samp{ }.
-
-@item gnus-sum-thread-tree-leaf-with-other
-@vindex gnus-sum-thread-tree-leaf-with-other
-Used for a leaf with brothers. The default is @samp{+-> }.
-
-@item gnus-sum-thread-tree-single-leaf
-@vindex gnus-sum-thread-tree-single-leaf
-Used for a leaf without brothers. The default is @samp{\-> }
-
-@end table
-
-@item T
-Nothing if the article is a root and lots of spaces if it isn't (it
-pushes everything after it off the screen).
-@item [
-Opening bracket, which is normally @samp{[}, but can also be @samp{<}
-for adopted articles (@pxref{Customizing Threading}).
-@item ]
-Closing bracket, which is normally @samp{]}, but can also be @samp{>}
-for adopted articles.
-@item >
-One space for each thread level.
-@item <
-Twenty minus thread level spaces.
-@item U
-Unread. @xref{Read Articles}.
-
-@item R
-This misleadingly named specifier is the @dfn{secondary mark}. This
-mark will say whether the article has been replied to, has been cached,
-or has been saved. @xref{Other Marks}.
-
-@item i
-Score as a number (@pxref{Scoring}).
-@item z
-@vindex gnus-summary-zcore-fuzz
-Zcore, @samp{+} if above the default level and @samp{-} if below the
-default level. If the difference between
-@code{gnus-summary-default-score} and the score is less than
-@code{gnus-summary-zcore-fuzz}, this spec will not be used.
-@item V
-Total thread score.
-@item x
-@code{Xref}.
-@item D
-@code{Date}.
-@item d
-The @code{Date} in @code{DD-MMM} format.
-@item o
-The @code{Date} in @var{YYYYMMDD}@code{T}@var{HHMMSS} format.
-@item M
-@code{Message-ID}.
-@item r
-@code{References}.
-@item t
-Number of articles in the current sub-thread. Using this spec will slow
-down summary buffer generation somewhat.
-@item e
-An @samp{=} (@code{gnus-not-empty-thread-mark}) will be displayed if the
-article has any children.
-@item P
-The line number.
-@item O
-Download mark.
-@item *
-Desired cursor position (instead of after first colon).
-@item &user-date;
-Age sensitive date format. Various date format is defined in
-@code{gnus-user-date-format-alist}.
-@item u
-User defined specifier. The next character in the format string should
-be a letter. Gnus will call the function
-@code{gnus-user-format-function-@var{x}}, where @var{x} is the letter
-following @samp{%u}. The function will be passed the current header as
-argument. The function should return a string, which will be inserted
-into the summary just like information from any other summary specifier.
-@end table
-
-Text between @samp{%(} and @samp{%)} will be highlighted with
-@code{gnus-mouse-face} when the mouse point is placed inside the area.
-There can only be one such area.
-
-The @samp{%U} (status), @samp{%R} (replied) and @samp{%z} (zcore) specs
-have to be handled with care. For reasons of efficiency, Gnus will
-compute what column these characters will end up in, and ``hard-code''
-that. This means that it is invalid to have these specs after a
-variable-length spec. Well, you might not be arrested, but your summary
-buffer will look strange, which is bad enough.
-
-The smart choice is to have these specs as far to the left as possible.
-(Isn't that the case with everything, though? But I digress.)
-
-This restriction may disappear in later versions of Gnus.
-
-
-@node To From Newsgroups
-@subsection To From Newsgroups
-@cindex To
-@cindex Newsgroups
-
-In some groups (particularly in archive groups), the @code{From} header
-isn't very interesting, since all the articles there are written by
-you. To display the information in the @code{To} or @code{Newsgroups}
-headers instead, you need to decide three things: What information to
-gather; where to display it; and when to display it.
-
-@enumerate
-@item
-@vindex gnus-extra-headers
-The reading of extra header information is controlled by the
-@code{gnus-extra-headers}. This is a list of header symbols. For
-instance:
-
-@lisp
-(setq gnus-extra-headers
- '(To Newsgroups X-Newsreader))
-@end lisp
-
-This will result in Gnus trying to obtain these three headers, and
-storing it in header structures for later easy retrieval.
-
-@item
-@findex gnus-extra-header
-The value of these extra headers can be accessed via the
-@code{gnus-extra-header} function. Here's a format line spec that will
-access the @code{X-Newsreader} header:
-
-@example
-"%~(form (gnus-extra-header 'X-Newsreader))@@"
-@end example
-
-@item
-@vindex gnus-ignored-from-addresses
-The @code{gnus-ignored-from-addresses} variable says when the @samp{%f}
-summary line spec returns the @code{To}, @code{Newsreader} or
-@code{From} header. If this regexp matches the contents of the
-@code{From} header, the value of the @code{To} or @code{Newsreader}
-headers are used instead.
-
-@end enumerate
-
-@vindex nnmail-extra-headers
-A related variable is @code{nnmail-extra-headers}, which controls when
-to include extra headers when generating overview (@acronym{NOV}) files.
-If you have old overview files, you should regenerate them after
-changing this variable, by entering the server buffer using @kbd{^},
-and then @kbd{g} on the appropriate mail server (e.g. nnml) to cause
-regeneration.
-
-@vindex gnus-summary-line-format
-You also have to instruct Gnus to display the data by changing the
-@code{%n} spec to the @code{%f} spec in the
-@code{gnus-summary-line-format} variable.
-
-In summary, you'd typically put something like the following in
-@file{~/.gnus.el}:
-
-@lisp
-(setq gnus-extra-headers
- '(To Newsgroups))
-(setq nnmail-extra-headers gnus-extra-headers)
-(setq gnus-summary-line-format
- "%U%R%z%I%(%[%4L: %-23,23f%]%) %s\n")
-(setq gnus-ignored-from-addresses
- "Your Name Here")
-@end lisp
-
-(The values listed above are the default values in Gnus. Alter them
-to fit your needs.)
-
-A note for news server administrators, or for users who wish to try to
-convince their news server administrator to provide some additional
-support:
-
-The above is mostly useful for mail groups, where you have control over
-the @acronym{NOV} files that are created. However, if you can persuade your
-nntp admin to add (in the usual implementation, notably INN):
-
-@example
-Newsgroups:full
-@end example
-
-to the end of her @file{overview.fmt} file, then you can use that just
-as you would the extra headers from the mail groups.
-
-
-@node Summary Buffer Mode Line
-@subsection Summary Buffer Mode Line
-
-@vindex gnus-summary-mode-line-format
-You can also change the format of the summary mode bar (@pxref{Mode Line
-Formatting}). Set @code{gnus-summary-mode-line-format} to whatever you
-like. The default is @samp{Gnus: %%b [%A] %Z}.
-
-Here are the elements you can play with:
-
-@table @samp
-@item G
-Group name.
-@item p
-Unprefixed group name.
-@item A
-Current article number.
-@item z
-Current article score.
-@item V
-Gnus version.
-@item U
-Number of unread articles in this group.
-@item e
-Number of unread articles in this group that aren't displayed in the
-summary buffer.
-@item Z
-A string with the number of unread and unselected articles represented
-either as @samp{<%U(+%e) more>} if there are both unread and unselected
-articles, and just as @samp{<%U more>} if there are just unread articles
-and no unselected ones.
-@item g
-Shortish group name. For instance, @samp{rec.arts.anime} will be
-shortened to @samp{r.a.anime}.
-@item S
-Subject of the current article.
-@item u
-User-defined spec (@pxref{User-Defined Specs}).
-@item s
-Name of the current score file (@pxref{Scoring}).
-@item d
-Number of dormant articles (@pxref{Unread Articles}).
-@item t
-Number of ticked articles (@pxref{Unread Articles}).
-@item r
-Number of articles that have been marked as read in this session.
-@item E
-Number of articles expunged by the score files.
-@end table
-
-
-@node Summary Highlighting
-@subsection Summary Highlighting
-
-@table @code
-
-@item gnus-visual-mark-article-hook
-@vindex gnus-visual-mark-article-hook
-This hook is run after selecting an article. It is meant to be used for
-highlighting the article in some way. It is not run if
-@code{gnus-visual} is @code{nil}.
-
-@item gnus-summary-update-hook
-@vindex gnus-summary-update-hook
-This hook is called when a summary line is changed. It is not run if
-@code{gnus-visual} is @code{nil}.
-
-@item gnus-summary-selected-face
-@vindex gnus-summary-selected-face
-This is the face (or @dfn{font} as some people call it) used to
-highlight the current article in the summary buffer.
-
-@item gnus-summary-highlight
-@vindex gnus-summary-highlight
-Summary lines are highlighted according to this variable, which is a
-list where the elements are of the format @code{(@var{form}
-. @var{face})}. If you would, for instance, like ticked articles to be
-italic and high-scored articles to be bold, you could set this variable
-to something like
-@lisp
-(((eq mark gnus-ticked-mark) . italic)
- ((> score default) . bold))
-@end lisp
-As you may have guessed, if @var{form} returns a non-@code{nil} value,
-@var{face} will be applied to the line.
-@end table
-
-
-@node Summary Maneuvering
-@section Summary Maneuvering
-@cindex summary movement
-
-All the straight movement commands understand the numeric prefix and
-behave pretty much as you'd expect.
-
-None of these commands select articles.
-
-@table @kbd
-@item G M-n
-@itemx M-n
-@kindex M-n (Summary)
-@kindex G M-n (Summary)
-@findex gnus-summary-next-unread-subject
-Go to the next summary line of an unread article
-(@code{gnus-summary-next-unread-subject}).
-
-@item G M-p
-@itemx M-p
-@kindex M-p (Summary)
-@kindex G M-p (Summary)
-@findex gnus-summary-prev-unread-subject
-Go to the previous summary line of an unread article
-(@code{gnus-summary-prev-unread-subject}).
-
-@item G g
-@kindex G g (Summary)
-@findex gnus-summary-goto-subject
-Ask for an article number and then go to the summary line of that article
-without displaying the article (@code{gnus-summary-goto-subject}).
-@end table
-
-If Gnus asks you to press a key to confirm going to the next group, you
-can use the @kbd{C-n} and @kbd{C-p} keys to move around the group
-buffer, searching for the next group to read without actually returning
-to the group buffer.
-
-Variables related to summary movement:
-
-@table @code
-
-@vindex gnus-auto-select-next
-@item gnus-auto-select-next
-If you issue one of the movement commands (like @kbd{n}) and there are
-no more unread articles after the current one, Gnus will offer to go to
-the next group. If this variable is @code{t} and the next group is
-empty, Gnus will exit summary mode and return to the group buffer. If
-this variable is neither @code{t} nor @code{nil}, Gnus will select the
-next group with unread articles. As a special case, if this variable
-is @code{quietly}, Gnus will select the next group without asking for
-confirmation. If this variable is @code{almost-quietly}, the same
-will happen only if you are located on the last article in the group.
-Finally, if this variable is @code{slightly-quietly}, the @kbd{Z n}
-command will go to the next group without confirmation. Also
-@pxref{Group Levels}.
-
-@item gnus-auto-select-same
-@vindex gnus-auto-select-same
-If non-@code{nil}, all the movement commands will try to go to the next
-article with the same subject as the current. (@dfn{Same} here might
-mean @dfn{roughly equal}. See @code{gnus-summary-gather-subject-limit}
-for details (@pxref{Customizing Threading}).) If there are no more
-articles with the same subject, go to the first unread article.
-
-This variable is not particularly useful if you use a threaded display.
-
-@item gnus-summary-check-current
-@vindex gnus-summary-check-current
-If non-@code{nil}, all the ``unread'' movement commands will not proceed
-to the next (or previous) article if the current article is unread.
-Instead, they will choose the current article.
-
-@item gnus-auto-center-summary
-@vindex gnus-auto-center-summary
-If non-@code{nil}, Gnus will keep the point in the summary buffer
-centered at all times. This makes things quite tidy, but if you have a
-slow network connection, or simply do not like this un-Emacsism, you can
-set this variable to @code{nil} to get the normal Emacs scrolling
-action. This will also inhibit horizontal re-centering of the summary
-buffer, which might make it more inconvenient to read extremely long
-threads.
-
-This variable can also be a number. In that case, center the window at
-the given number of lines from the top.
-
-@end table
-
-
-@node Choosing Articles
-@section Choosing Articles
-@cindex selecting articles
-
-@menu
-* Choosing Commands:: Commands for choosing articles.
-* Choosing Variables:: Variables that influence these commands.
-@end menu
-
-
-@node Choosing Commands
-@subsection Choosing Commands
-
-None of the following movement commands understand the numeric prefix,
-and they all select and display an article.
-
-If you want to fetch new articles or redisplay the group, see
-@ref{Exiting the Summary Buffer}.
-
-@table @kbd
-@item SPACE
-@kindex SPACE (Summary)
-@findex gnus-summary-next-page
-Select the current article, or, if that one's read already, the next
-unread article (@code{gnus-summary-next-page}).
-
-If you have an article window open already and you press @kbd{SPACE}
-again, the article will be scrolled. This lets you conveniently
-@kbd{SPACE} through an entire newsgroup. @xref{Paging the Article}.
-
-@item G n
-@itemx n
-@kindex n (Summary)
-@kindex G n (Summary)
-@findex gnus-summary-next-unread-article
-@c @icon{gnus-summary-next-unread}
-Go to next unread article (@code{gnus-summary-next-unread-article}).
-
-@item G p
-@itemx p
-@kindex p (Summary)
-@findex gnus-summary-prev-unread-article
-@c @icon{gnus-summary-prev-unread}
-Go to previous unread article (@code{gnus-summary-prev-unread-article}).
-
-@item G N
-@itemx N
-@kindex N (Summary)
-@kindex G N (Summary)
-@findex gnus-summary-next-article
-Go to the next article (@code{gnus-summary-next-article}).
-
-@item G P
-@itemx P
-@kindex P (Summary)
-@kindex G P (Summary)
-@findex gnus-summary-prev-article
-Go to the previous article (@code{gnus-summary-prev-article}).
-
-@item G C-n
-@kindex G C-n (Summary)
-@findex gnus-summary-next-same-subject
-Go to the next article with the same subject
-(@code{gnus-summary-next-same-subject}).
-
-@item G C-p
-@kindex G C-p (Summary)
-@findex gnus-summary-prev-same-subject
-Go to the previous article with the same subject
-(@code{gnus-summary-prev-same-subject}).
-
-@item G f
-@itemx .
-@kindex G f (Summary)
-@kindex . (Summary)
-@findex gnus-summary-first-unread-article
-Go to the first unread article
-(@code{gnus-summary-first-unread-article}).
-
-@item G b
-@itemx ,
-@kindex G b (Summary)
-@kindex , (Summary)
-@findex gnus-summary-best-unread-article
-Go to the unread article with the highest score
-(@code{gnus-summary-best-unread-article}). If given a prefix argument,
-go to the first unread article that has a score over the default score.
-
-@item G l
-@itemx l
-@kindex l (Summary)
-@kindex G l (Summary)
-@findex gnus-summary-goto-last-article
-Go to the previous article read (@code{gnus-summary-goto-last-article}).
-
-@item G o
-@kindex G o (Summary)
-@findex gnus-summary-pop-article
-@cindex history
-@cindex article history
-Pop an article off the summary history and go to this article
-(@code{gnus-summary-pop-article}). This command differs from the
-command above in that you can pop as many previous articles off the
-history as you like, while @kbd{l} toggles the two last read articles.
-For a somewhat related issue (if you use these commands a lot),
-@pxref{Article Backlog}.
-
-@item G j
-@itemx j
-@kindex j (Summary)
-@kindex G j (Summary)
-@findex gnus-summary-goto-article
-Ask for an article number or @code{Message-ID}, and then go to that
-article (@code{gnus-summary-goto-article}).
-
-@end table
-
-
-@node Choosing Variables
-@subsection Choosing Variables
-
-Some variables relevant for moving and selecting articles:
-
-@table @code
-@item gnus-auto-extend-newsgroup
-@vindex gnus-auto-extend-newsgroup
-All the movement commands will try to go to the previous (or next)
-article, even if that article isn't displayed in the Summary buffer if
-this variable is non-@code{nil}. Gnus will then fetch the article from
-the server and display it in the article buffer.
-
-@item gnus-select-article-hook
-@vindex gnus-select-article-hook
-This hook is called whenever an article is selected. The default is
-@code{nil}. If you would like each article to be saved in the Agent as
-you read it, putting @code{gnus-agent-fetch-selected-article} on this
-hook will do so.
-
-@item gnus-mark-article-hook
-@vindex gnus-mark-article-hook
-@findex gnus-summary-mark-unread-as-read
-@findex gnus-summary-mark-read-and-unread-as-read
-@findex gnus-unread-mark
-This hook is called whenever an article is selected. It is intended to
-be used for marking articles as read. The default value is
-@code{gnus-summary-mark-read-and-unread-as-read}, and will change the
-mark of almost any article you read to @code{gnus-read-mark}. The only
-articles not affected by this function are ticked, dormant, and
-expirable articles. If you'd instead like to just have unread articles
-marked as read, you can use @code{gnus-summary-mark-unread-as-read}
-instead. It will leave marks like @code{gnus-low-score-mark},
-@code{gnus-del-mark} (and so on) alone.
-
-@end table
-
-
-@node Paging the Article
-@section Scrolling the Article
-@cindex article scrolling
-
-@table @kbd
-
-@item SPACE
-@kindex SPACE (Summary)
-@findex gnus-summary-next-page
-Pressing @kbd{SPACE} will scroll the current article forward one page,
-or, if you have come to the end of the current article, will choose the
-next article (@code{gnus-summary-next-page}).
-
-@vindex gnus-article-boring-faces
-@vindex gnus-article-skip-boring
-If @code{gnus-article-skip-boring} is non-@code{nil} and the rest of
-the article consists only of citations and signature, then it will be
-skipped; the next article will be shown instead. You can customize
-what is considered uninteresting with
-@code{gnus-article-boring-faces}. You can manually view the article's
-pages, no matter how boring, using @kbd{C-M-v}.
-
-@item DEL
-@kindex DEL (Summary)
-@findex gnus-summary-prev-page
-Scroll the current article back one page (@code{gnus-summary-prev-page}).
-
-@item RET
-@kindex RET (Summary)
-@findex gnus-summary-scroll-up
-Scroll the current article one line forward
-(@code{gnus-summary-scroll-up}).
-
-@item M-RET
-@kindex M-RET (Summary)
-@findex gnus-summary-scroll-down
-Scroll the current article one line backward
-(@code{gnus-summary-scroll-down}).
-
-@item A g
-@itemx g
-@kindex A g (Summary)
-@kindex g (Summary)
-@findex gnus-summary-show-article
-@vindex gnus-summary-show-article-charset-alist
-(Re)fetch the current article (@code{gnus-summary-show-article}). If
-given a prefix, fetch the current article, but don't run any of the
-article treatment functions. This will give you a ``raw'' article, just
-the way it came from the server.
-
-If given a numerical prefix, you can do semi-manual charset stuff.
-@kbd{C-u 0 g cn-gb-2312 RET} will decode the message as if it were
-encoded in the @code{cn-gb-2312} charset. If you have
-
-@lisp
-(setq gnus-summary-show-article-charset-alist
- '((1 . cn-gb-2312)
- (2 . big5)))
-@end lisp
-
-then you can say @kbd{C-u 1 g} to get the same effect.
-
-@item A <
-@itemx <
-@kindex < (Summary)
-@kindex A < (Summary)
-@findex gnus-summary-beginning-of-article
-Scroll to the beginning of the article
-(@code{gnus-summary-beginning-of-article}).
-
-@item A >
-@itemx >
-@kindex > (Summary)
-@kindex A > (Summary)
-@findex gnus-summary-end-of-article
-Scroll to the end of the article (@code{gnus-summary-end-of-article}).
-
-@item A s
-@itemx s
-@kindex A s (Summary)
-@kindex s (Summary)
-@findex gnus-summary-isearch-article
-Perform an isearch in the article buffer
-(@code{gnus-summary-isearch-article}).
-
-@item h
-@kindex h (Summary)
-@findex gnus-summary-select-article-buffer
-Select the article buffer (@code{gnus-summary-select-article-buffer}).
-
-@end table
-
-
-@node Reply Followup and Post
-@section Reply, Followup and Post
-
-@menu
-* Summary Mail Commands:: Sending mail.
-* Summary Post Commands:: Sending news.
-* Summary Message Commands:: Other Message-related commands.
-* Canceling and Superseding::
-@end menu
-
-
-@node Summary Mail Commands
-@subsection Summary Mail Commands
-@cindex mail
-@cindex composing mail
-
-Commands for composing a mail message:
-
-@table @kbd
-
-@item S r
-@itemx r
-@kindex S r (Summary)
-@kindex r (Summary)
-@findex gnus-summary-reply
-@c @icon{gnus-summary-mail-reply}
-@c @icon{gnus-summary-reply}
-Mail a reply to the author of the current article
-(@code{gnus-summary-reply}).
-
-@item S R
-@itemx R
-@kindex R (Summary)
-@kindex S R (Summary)
-@findex gnus-summary-reply-with-original
-@c @icon{gnus-summary-reply-with-original}
-Mail a reply to the author of the current article and include the
-original message (@code{gnus-summary-reply-with-original}). This
-command uses the process/prefix convention.
-
-@item S w
-@kindex S w (Summary)
-@findex gnus-summary-wide-reply
-Mail a wide reply to the author of the current article
-(@code{gnus-summary-wide-reply}). A @dfn{wide reply} is a reply that
-goes out to all people listed in the @code{To}, @code{From} (or
-@code{Reply-to}) and @code{Cc} headers. If @code{Mail-Followup-To} is
-present, that's used instead.
-
-@item S W
-@kindex S W (Summary)
-@findex gnus-summary-wide-reply-with-original
-Mail a wide reply to the current article and include the original
-message (@code{gnus-summary-wide-reply-with-original}). This command uses
-the process/prefix convention.
-
-@item S v
-@kindex S v (Summary)
-@findex gnus-summary-very-wide-reply
-Mail a very wide reply to the author of the current article
-(@code{gnus-summary-wide-reply}). A @dfn{very wide reply} is a reply
-that goes out to all people listed in the @code{To}, @code{From} (or
-@code{Reply-to}) and @code{Cc} headers in all the process/prefixed
-articles. This command uses the process/prefix convention.
-
-@item S V
-@kindex S V (Summary)
-@findex gnus-summary-very-wide-reply-with-original
-Mail a very wide reply to the author of the current article and include the
-original message (@code{gnus-summary-very-wide-reply-with-original}). This
-command uses the process/prefix convention.
-
-@item S B r
-@kindex S B r (Summary)
-@findex gnus-summary-reply-broken-reply-to
-Mail a reply to the author of the current article but ignore the
-@code{Reply-To} field (@code{gnus-summary-reply-broken-reply-to}).
-If you need this because a mailing list incorrectly sets a
-@code{Reply-To} header pointing to the list, you probably want to set
-the @code{broken-reply-to} group parameter instead, so things will work
-correctly. @xref{Group Parameters}.
-
-@item S B R
-@kindex S B R (Summary)
-@findex gnus-summary-reply-broken-reply-to-with-original
-Mail a reply to the author of the current article and include the
-original message but ignore the @code{Reply-To} field
-(@code{gnus-summary-reply-broken-reply-to-with-original}).
-
-@item S o m
-@itemx C-c C-f
-@kindex S o m (Summary)
-@kindex C-c C-f (Summary)
-@findex gnus-summary-mail-forward
-@c @icon{gnus-summary-mail-forward}
-Forward the current article to some other person
-(@code{gnus-summary-mail-forward}). If no prefix is given, the message
-is forwarded according to the value of (@code{message-forward-as-mime})
-and (@code{message-forward-show-mml}); if the prefix is 1, decode the
-message and forward directly inline; if the prefix is 2, forward message
-as an rfc822 @acronym{MIME} section; if the prefix is 3, decode message and
-forward as an rfc822 @acronym{MIME} section; if the prefix is 4, forward message
-directly inline; otherwise, the message is forwarded as no prefix given
-but use the flipped value of (@code{message-forward-as-mime}). By
-default, the message is decoded and forwarded as an rfc822 @acronym{MIME}
-section.
-
-@item S m
-@itemx m
-@kindex m (Summary)
-@kindex S m (Summary)
-@findex gnus-summary-mail-other-window
-@c @icon{gnus-summary-mail-originate}
-Prepare a mail (@code{gnus-summary-mail-other-window}). By default, use
-the posting style of the current group. If given a prefix, disable that.
-If the prefix is 1, prompt for a group name to find the posting style.
-
-@item S i
-@itemx i
-@kindex i (Summary)
-@kindex S i (Summary)
-@findex gnus-summary-news-other-window
-Prepare a news (@code{gnus-summary-news-other-window}). By default,
-post to the current group. If given a prefix, disable that. If the
-prefix is 1, prompt for a group to post to.
-
-This function actually prepares a news even when using mail groups.
-This is useful for ``posting'' messages to mail groups without actually
-sending them over the network: they're just saved directly to the group
-in question. The corresponding back end must have a request-post method
-for this to work though.
-
-@item S D b
-@kindex S D b (Summary)
-@findex gnus-summary-resend-bounced-mail
-@cindex bouncing mail
-If you have sent a mail, but the mail was bounced back to you for some
-reason (wrong address, transient failure), you can use this command to
-resend that bounced mail (@code{gnus-summary-resend-bounced-mail}). You
-will be popped into a mail buffer where you can edit the headers before
-sending the mail off again. If you give a prefix to this command, and
-the bounced mail is a reply to some other mail, Gnus will try to fetch
-that mail and display it for easy perusal of its headers. This might
-very well fail, though.
-
-@item S D r
-@kindex S D r (Summary)
-@findex gnus-summary-resend-message
-Not to be confused with the previous command,
-@code{gnus-summary-resend-message} will prompt you for an address to
-send the current message off to, and then send it to that place. The
-headers of the message won't be altered---but lots of headers that say
-@code{Resent-To}, @code{Resent-From} and so on will be added. This
-means that you actually send a mail to someone that has a @code{To}
-header that (probably) points to yourself. This will confuse people.
-So, natcherly you'll only do that if you're really eVIl.
-
-This command is mainly used if you have several accounts and want to
-ship a mail to a different account of yours. (If you're both
-@code{root} and @code{postmaster} and get a mail for @code{postmaster}
-to the @code{root} account, you may want to resend it to
-@code{postmaster}. Ordnung muss sein!
-
-This command understands the process/prefix convention
-(@pxref{Process/Prefix}).
-
-@item S D e
-@kindex S D e (Summary)
-@findex gnus-summary-resend-message-edit
-
-Like the previous command, but will allow you to edit the message as
-if it were a new message before resending.
-
-@item S O m
-@kindex S O m (Summary)
-@findex gnus-uu-digest-mail-forward
-Digest the current series (@pxref{Decoding Articles}) and forward the
-result using mail (@code{gnus-uu-digest-mail-forward}). This command
-uses the process/prefix convention (@pxref{Process/Prefix}).
-
-@item S M-c
-@kindex S M-c (Summary)
-@findex gnus-summary-mail-crosspost-complaint
-@cindex crossposting
-@cindex excessive crossposting
-Send a complaint about excessive crossposting to the author of the
-current article (@code{gnus-summary-mail-crosspost-complaint}).
-
-@findex gnus-crosspost-complaint
-This command is provided as a way to fight back against the current
-crossposting pandemic that's sweeping Usenet. It will compose a reply
-using the @code{gnus-crosspost-complaint} variable as a preamble. This
-command understands the process/prefix convention
-(@pxref{Process/Prefix}) and will prompt you before sending each mail.
-
-@end table
-
-Also @xref{Header Commands, ,Header Commands, message, The Message
-Manual}, for more information.
-
-
-@node Summary Post Commands
-@subsection Summary Post Commands
-@cindex post
-@cindex composing news
-
-Commands for posting a news article:
-
-@table @kbd
-@item S p
-@itemx a
-@kindex a (Summary)
-@kindex S p (Summary)
-@findex gnus-summary-post-news
-@c @icon{gnus-summary-post-news}
-Prepare for posting an article (@code{gnus-summary-post-news}). By
-default, post to the current group. If given a prefix, disable that.
-If the prefix is 1, prompt for another group instead.
-
-@item S f
-@itemx f
-@kindex f (Summary)
-@kindex S f (Summary)
-@findex gnus-summary-followup
-@c @icon{gnus-summary-followup}
-Post a followup to the current article (@code{gnus-summary-followup}).
-
-@item S F
-@itemx F
-@kindex S F (Summary)
-@kindex F (Summary)
-@c @icon{gnus-summary-followup-with-original}
-@findex gnus-summary-followup-with-original
-Post a followup to the current article and include the original message
-(@code{gnus-summary-followup-with-original}). This command uses the
-process/prefix convention.
-
-@item S n
-@kindex S n (Summary)
-@findex gnus-summary-followup-to-mail
-Post a followup to the current article via news, even if you got the
-message through mail (@code{gnus-summary-followup-to-mail}).
-
-@item S N
-@kindex S N (Summary)
-@findex gnus-summary-followup-to-mail-with-original
-Post a followup to the current article via news, even if you got the
-message through mail and include the original message
-(@code{gnus-summary-followup-to-mail-with-original}). This command uses
-the process/prefix convention.
-
-@item S o p
-@kindex S o p (Summary)
-@findex gnus-summary-post-forward
-Forward the current article to a newsgroup
-(@code{gnus-summary-post-forward}).
- If no prefix is given, the message is forwarded according to the value
-of (@code{message-forward-as-mime}) and
-(@code{message-forward-show-mml}); if the prefix is 1, decode the
-message and forward directly inline; if the prefix is 2, forward message
-as an rfc822 @acronym{MIME} section; if the prefix is 3, decode message and
-forward as an rfc822 @acronym{MIME} section; if the prefix is 4, forward message
-directly inline; otherwise, the message is forwarded as no prefix given
-but use the flipped value of (@code{message-forward-as-mime}). By
-default, the message is decoded and forwarded as an rfc822 @acronym{MIME} section.
-
-@item S O p
-@kindex S O p (Summary)
-@findex gnus-uu-digest-post-forward
-@cindex digests
-@cindex making digests
-Digest the current series and forward the result to a newsgroup
-(@code{gnus-uu-digest-post-forward}). This command uses the
-process/prefix convention.
-
-@item S u
-@kindex S u (Summary)
-@findex gnus-uu-post-news
-@c @icon{gnus-uu-post-news}
-Uuencode a file, split it into parts, and post it as a series
-(@code{gnus-uu-post-news}). (@pxref{Uuencoding and Posting}).
-@end table
-
-Also @xref{Header Commands, ,Header Commands, message, The Message
-Manual}, for more information.
-
-
-@node Summary Message Commands
-@subsection Summary Message Commands
-
-@table @kbd
-@item S y
-@kindex S y (Summary)
-@findex gnus-summary-yank-message
-Yank the current article into an already existing Message composition
-buffer (@code{gnus-summary-yank-message}). This command prompts for
-what message buffer you want to yank into, and understands the
-process/prefix convention (@pxref{Process/Prefix}).
-
-@end table
-
-
-@node Canceling and Superseding
-@subsection Canceling Articles
-@cindex canceling articles
-@cindex superseding articles
-
-Have you ever written something, and then decided that you really,
-really, really wish you hadn't posted that?
-
-Well, you can't cancel mail, but you can cancel posts.
-
-@findex gnus-summary-cancel-article
-@kindex C (Summary)
-@c @icon{gnus-summary-cancel-article}
-Find the article you wish to cancel (you can only cancel your own
-articles, so don't try any funny stuff). Then press @kbd{C} or @kbd{S
-c} (@code{gnus-summary-cancel-article}). Your article will be
-canceled---machines all over the world will be deleting your article.
-This command uses the process/prefix convention (@pxref{Process/Prefix}).
-
-Be aware, however, that not all sites honor cancels, so your article may
-live on here and there, while most sites will delete the article in
-question.
-
-Gnus will use the ``current'' select method when canceling. If you
-want to use the standard posting method, use the @samp{a} symbolic
-prefix (@pxref{Symbolic Prefixes}).
-
-Gnus ensures that only you can cancel your own messages using a
-@code{Cancel-Lock} header (@pxref{Canceling News, Canceling News, ,
-message, Message Manual}).
-
-If you discover that you have made some mistakes and want to do some
-corrections, you can post a @dfn{superseding} article that will replace
-your original article.
-
-@findex gnus-summary-supersede-article
-@kindex S (Summary)
-Go to the original article and press @kbd{S s}
-(@code{gnus-summary-supersede-article}). You will be put in a buffer
-where you can edit the article all you want before sending it off the
-usual way.
-
-The same goes for superseding as for canceling, only more so: Some
-sites do not honor superseding. On those sites, it will appear that you
-have posted almost the same article twice.
-
-If you have just posted the article, and change your mind right away,
-there is a trick you can use to cancel/supersede the article without
-waiting for the article to appear on your site first. You simply return
-to the post buffer (which is called @code{*sent ...*}). There you will
-find the article you just posted, with all the headers intact. Change
-the @code{Message-ID} header to a @code{Cancel} or @code{Supersedes}
-header by substituting one of those words for the word
-@code{Message-ID}. Then just press @kbd{C-c C-c} to send the article as
-you would do normally. The previous article will be
-canceled/superseded.
-
-Just remember, kids: There is no 'c' in 'supersede'.
-
-@node Delayed Articles
-@section Delayed Articles
-@cindex delayed sending
-@cindex send delayed
-
-Sometimes, you might wish to delay the sending of a message. For
-example, you might wish to arrange for a message to turn up just in time
-to remind your about the birthday of your Significant Other. For this,
-there is the @code{gnus-delay} package. Setup is simple:
-
-@lisp
-(gnus-delay-initialize)
-@end lisp
-
-@findex gnus-delay-article
-Normally, to send a message you use the @kbd{C-c C-c} command from
-Message mode. To delay a message, use @kbd{C-c C-j}
-(@code{gnus-delay-article}) instead. This will ask you for how long the
-message should be delayed. Possible answers are:
-
-@itemize @bullet
-@item
-A time span. Consists of an integer and a letter. For example,
-@code{42d} means to delay for 42 days. Available letters are @code{m}
-(minutes), @code{h} (hours), @code{d} (days), @code{w} (weeks), @code{M}
-(months) and @code{Y} (years).
-
-@item
-A specific date. Looks like @code{YYYY-MM-DD}. The message will be
-delayed until that day, at a specific time (eight o'clock by default).
-See also @code{gnus-delay-default-hour}.
-
-@item
-A specific time of day. Given in @code{hh:mm} format, 24h, no am/pm
-stuff. The deadline will be at that time today, except if that time has
-already passed, then it's at the given time tomorrow. So if it's ten
-o'clock in the morning and you specify @code{11:15}, then the deadline
-is one hour and fifteen minutes hence. But if you specify @code{9:20},
-that means a time tomorrow.
-@end itemize
-
-The action of the @code{gnus-delay-article} command is influenced by a
-couple of variables:
-
-@table @code
-@item gnus-delay-default-hour
-@vindex gnus-delay-default-hour
-When you specify a specific date, the message will be due on that hour
-on the given date. Possible values are integers 0 through 23.
-
-@item gnus-delay-default-delay
-@vindex gnus-delay-default-delay
-This is a string and gives the default delay. It can be of any of the
-formats described above.
-
-@item gnus-delay-group
-@vindex gnus-delay-group
-Delayed articles will be kept in this group on the drafts server until
-they are due. You probably don't need to change this. The default
-value is @code{"delayed"}.
-
-@item gnus-delay-header
-@vindex gnus-delay-header
-The deadline for each article will be stored in a header. This variable
-is a string and gives the header name. You probably don't need to
-change this. The default value is @code{"X-Gnus-Delayed"}.
-@end table
-
-The way delaying works is like this: when you use the
-@code{gnus-delay-article} command, you give a certain delay. Gnus
-calculates the deadline of the message and stores it in the
-@code{X-Gnus-Delayed} header and puts the message in the
-@code{nndraft:delayed} group.
-
-@findex gnus-delay-send-queue
-And whenever you get new news, Gnus looks through the group for articles
-which are due and sends them. It uses the @code{gnus-delay-send-queue}
-function for this. By default, this function is added to the hook
-@code{gnus-get-new-news-hook}. But of course, you can change this.
-Maybe you want to use the demon to send drafts? Just tell the demon to
-execute the @code{gnus-delay-send-queue} function.
-
-@table @code
-@item gnus-delay-initialize
-@findex gnus-delay-initialize
-By default, this function installs @code{gnus-delay-send-queue} in
-@code{gnus-get-new-news-hook}. But it accepts the optional second
-argument @code{no-check}. If it is non-@code{nil},
-@code{gnus-get-new-news-hook} is not changed. The optional first
-argument is ignored.
-
-For example, @code{(gnus-delay-initialize nil t)} means to do nothing.
-Presumably, you want to use the demon for sending due delayed articles.
-Just don't forget to set that up :-)
-@end table
-
-
-@node Marking Articles
-@section Marking Articles
-@cindex article marking
-@cindex article ticking
-@cindex marks
-
-There are several marks you can set on an article.
-
-You have marks that decide the @dfn{readedness} (whoo, neato-keano
-neologism ohoy!) of the article. Alphabetic marks generally mean
-@dfn{read}, while non-alphabetic characters generally mean @dfn{unread}.
-
-In addition, you also have marks that do not affect readedness.
-
-@ifinfo
-There's a plethora of commands for manipulating these marks.
-@end ifinfo
-
-@menu
-* Unread Articles:: Marks for unread articles.
-* Read Articles:: Marks for read articles.
-* Other Marks:: Marks that do not affect readedness.
-* Setting Marks:: How to set and remove marks.
-* Generic Marking Commands:: How to customize the marking.
-* Setting Process Marks:: How to mark articles for later processing.
-@end menu
-
-
-@node Unread Articles
-@subsection Unread Articles
-
-The following marks mark articles as (kinda) unread, in one form or
-other.
-
-@table @samp
-@item !
-@vindex gnus-ticked-mark
-Marked as ticked (@code{gnus-ticked-mark}).
-
-@dfn{Ticked articles} are articles that will remain visible always. If
-you see an article that you find interesting, or you want to put off
-reading it, or replying to it, until sometime later, you'd typically
-tick it. However, articles can be expired (from news servers by the
-news server software, Gnus itself never expires ticked messages), so if
-you want to keep an article forever, you'll have to make it persistent
-(@pxref{Persistent Articles}).
-
-@item ?
-@vindex gnus-dormant-mark
-Marked as dormant (@code{gnus-dormant-mark}).
-
-@dfn{Dormant articles} will only appear in the summary buffer if there
-are followups to it. If you want to see them even if they don't have
-followups, you can use the @kbd{/ D} command (@pxref{Limiting}).
-Otherwise (except for the visibility issue), they are just like ticked
-messages.
-
-@item SPACE
-@vindex gnus-unread-mark
-Marked as unread (@code{gnus-unread-mark}).
-
-@dfn{Unread articles} are articles that haven't been read at all yet.
-@end table
-
-
-@node Read Articles
-@subsection Read Articles
-@cindex expirable mark
-
-All the following marks mark articles as read.
-
-@table @samp
-
-@item r
-@vindex gnus-del-mark
-These are articles that the user has marked as read with the @kbd{d}
-command manually, more or less (@code{gnus-del-mark}).
-
-@item R
-@vindex gnus-read-mark
-Articles that have actually been read (@code{gnus-read-mark}).
-
-@item O
-@vindex gnus-ancient-mark
-Articles that were marked as read in previous sessions and are now
-@dfn{old} (@code{gnus-ancient-mark}).
-
-@item K
-@vindex gnus-killed-mark
-Marked as killed (@code{gnus-killed-mark}).
-
-@item X
-@vindex gnus-kill-file-mark
-Marked as killed by kill files (@code{gnus-kill-file-mark}).
-
-@item Y
-@vindex gnus-low-score-mark
-Marked as read by having too low a score (@code{gnus-low-score-mark}).
-
-@item C
-@vindex gnus-catchup-mark
-Marked as read by a catchup (@code{gnus-catchup-mark}).
-
-@item G
-@vindex gnus-canceled-mark
-Canceled article (@code{gnus-canceled-mark})
-
-@item F
-@vindex gnus-souped-mark
-@sc{soup}ed article (@code{gnus-souped-mark}). @xref{SOUP}.
-
-@item Q
-@vindex gnus-sparse-mark
-Sparsely reffed article (@code{gnus-sparse-mark}). @xref{Customizing
-Threading}.
-
-@item M
-@vindex gnus-duplicate-mark
-Article marked as read by duplicate suppression
-(@code{gnus-duplicate-mark}). @xref{Duplicate Suppression}.
-
-@end table
-
-All these marks just mean that the article is marked as read, really.
-They are interpreted differently when doing adaptive scoring, though.
-
-One more special mark, though:
-
-@table @samp
-@item E
-@vindex gnus-expirable-mark
-Marked as expirable (@code{gnus-expirable-mark}).
-
-Marking articles as @dfn{expirable} (or have them marked as such
-automatically) doesn't make much sense in normal groups---a user doesn't
-control expiring of news articles, but in mail groups, for instance,
-articles marked as @dfn{expirable} can be deleted by Gnus at
-any time.
-@end table
-
-
-@node Other Marks
-@subsection Other Marks
-@cindex process mark
-@cindex bookmarks
-
-There are some marks that have nothing to do with whether the article is
-read or not.
-
-@itemize @bullet
-
-@item
-You can set a bookmark in the current article. Say you are reading a
-long thesis on cats' urinary tracts, and have to go home for dinner
-before you've finished reading the thesis. You can then set a bookmark
-in the article, and Gnus will jump to this bookmark the next time it
-encounters the article. @xref{Setting Marks}.
-
-@item
-@vindex gnus-replied-mark
-All articles that you have replied to or made a followup to (i.e., have
-answered) will be marked with an @samp{A} in the second column
-(@code{gnus-replied-mark}).
-
-@item
-@vindex gnus-forwarded-mark
-All articles that you have forwarded will be marked with an @samp{F} in
-the second column (@code{gnus-forwarded-mark}).
-
-@item
-@vindex gnus-cached-mark
-Articles stored in the article cache will be marked with an @samp{*} in
-the second column (@code{gnus-cached-mark}). @xref{Article Caching}.
-
-@item
-@vindex gnus-saved-mark
-Articles ``saved'' (in some manner or other; not necessarily
-religiously) are marked with an @samp{S} in the second column
-(@code{gnus-saved-mark}).
-
-@item
-@vindex gnus-recent-mark
-Articles that according to the server haven't been shown to the user
-before are marked with a @samp{N} in the second column
-(@code{gnus-recent-mark}). Note that not all servers support this
-mark, in which case it simply never appears. Compare with
-@code{gnus-unseen-mark}.
-
-@item
-@vindex gnus-unseen-mark
-Articles that haven't been seen before in Gnus by the user are marked
-with a @samp{.} in the second column (@code{gnus-unseen-mark}).
-Compare with @code{gnus-recent-mark}.
-
-@item
-@vindex gnus-downloaded-mark
-When using the Gnus agent (@pxref{Agent Basics}), articles may be
-downloaded for unplugged (offline) viewing. If you are using the
-@samp{%O} spec, these articles get the @samp{+} mark in that spec.
-(The variable @code{gnus-downloaded-mark} controls which character to
-use.)
-
-@item
-@vindex gnus-undownloaded-mark
-When using the Gnus agent (@pxref{Agent Basics}), some articles might
-not have been downloaded. Such articles cannot be viewed while you
-are unplugged (offline). If you are using the @samp{%O} spec, these
-articles get the @samp{-} mark in that spec. (The variable
-@code{gnus-undownloaded-mark} controls which character to use.)
-
-@item
-@vindex gnus-downloadable-mark
-The Gnus agent (@pxref{Agent Basics}) downloads some articles
-automatically, but it is also possible to explicitly mark articles for
-download, even if they would not be downloaded automatically. Such
-explicitly-marked articles get the @samp{%} mark in the first column.
-(The variable @code{gnus-downloadable-mark} controls which character to
-use.)
-
-@item
-@vindex gnus-not-empty-thread-mark
-@vindex gnus-empty-thread-mark
-If the @samp{%e} spec is used, the presence of threads or not will be
-marked with @code{gnus-not-empty-thread-mark} and
-@code{gnus-empty-thread-mark} in the third column, respectively.
-
-@item
-@vindex gnus-process-mark
-Finally we have the @dfn{process mark} (@code{gnus-process-mark}). A
-variety of commands react to the presence of the process mark. For
-instance, @kbd{X u} (@code{gnus-uu-decode-uu}) will uudecode and view
-all articles that have been marked with the process mark. Articles
-marked with the process mark have a @samp{#} in the second column.
-
-@end itemize
-
-You might have noticed that most of these ``non-readedness'' marks
-appear in the second column by default. So if you have a cached, saved,
-replied article that you have process-marked, what will that look like?
-
-Nothing much. The precedence rules go as follows: process -> cache ->
-replied -> saved. So if the article is in the cache and is replied,
-you'll only see the cache mark and not the replied mark.
-
-
-@node Setting Marks
-@subsection Setting Marks
-@cindex setting marks
-
-All the marking commands understand the numeric prefix.
-
-@table @kbd
-@item M c
-@itemx M-u
-@kindex M c (Summary)
-@kindex M-u (Summary)
-@findex gnus-summary-clear-mark-forward
-@cindex mark as unread
-Clear all readedness-marks from the current article
-(@code{gnus-summary-clear-mark-forward}). In other words, mark the
-article as unread.
-
-@item M t
-@itemx !
-@kindex ! (Summary)
-@kindex M t (Summary)
-@findex gnus-summary-tick-article-forward
-Tick the current article (@code{gnus-summary-tick-article-forward}).
-@xref{Article Caching}.
-
-@item M ?
-@itemx ?
-@kindex ? (Summary)
-@kindex M ? (Summary)
-@findex gnus-summary-mark-as-dormant
-Mark the current article as dormant
-(@code{gnus-summary-mark-as-dormant}). @xref{Article Caching}.
-
-@item M d
-@itemx d
-@kindex M d (Summary)
-@kindex d (Summary)
-@findex gnus-summary-mark-as-read-forward
-Mark the current article as read
-(@code{gnus-summary-mark-as-read-forward}).
-
-@item D
-@kindex D (Summary)
-@findex gnus-summary-mark-as-read-backward
-Mark the current article as read and move point to the previous line
-(@code{gnus-summary-mark-as-read-backward}).
-
-@item M k
-@itemx k
-@kindex k (Summary)
-@kindex M k (Summary)
-@findex gnus-summary-kill-same-subject-and-select
-Mark all articles that have the same subject as the current one as read,
-and then select the next unread article
-(@code{gnus-summary-kill-same-subject-and-select}).
-
-@item M K
-@itemx C-k
-@kindex M K (Summary)
-@kindex C-k (Summary)
-@findex gnus-summary-kill-same-subject
-Mark all articles that have the same subject as the current one as read
-(@code{gnus-summary-kill-same-subject}).
-
-@item M C
-@kindex M C (Summary)
-@findex gnus-summary-catchup
-@c @icon{gnus-summary-catchup}
-Mark all unread articles as read (@code{gnus-summary-catchup}).
-
-@item M C-c
-@kindex M C-c (Summary)
-@findex gnus-summary-catchup-all
-Mark all articles in the group as read---even the ticked and dormant
-articles (@code{gnus-summary-catchup-all}).
-
-@item M H
-@kindex M H (Summary)
-@findex gnus-summary-catchup-to-here
-Catchup the current group to point (before the point)
-(@code{gnus-summary-catchup-to-here}).
-
-@item M h
-@kindex M h (Summary)
-@findex gnus-summary-catchup-from-here
-Catchup the current group from point (after the point)
-(@code{gnus-summary-catchup-from-here}).
-
-@item C-w
-@kindex C-w (Summary)
-@findex gnus-summary-mark-region-as-read
-Mark all articles between point and mark as read
-(@code{gnus-summary-mark-region-as-read}).
-
-@item M V k
-@kindex M V k (Summary)
-@findex gnus-summary-kill-below
-Kill all articles with scores below the default score (or below the
-numeric prefix) (@code{gnus-summary-kill-below}).
-
-@item M e
-@itemx E
-@kindex M e (Summary)
-@kindex E (Summary)
-@findex gnus-summary-mark-as-expirable
-Mark the current article as expirable
-(@code{gnus-summary-mark-as-expirable}).
-
-@item M b
-@kindex M b (Summary)
-@findex gnus-summary-set-bookmark
-Set a bookmark in the current article
-(@code{gnus-summary-set-bookmark}).
-
-@item M B
-@kindex M B (Summary)
-@findex gnus-summary-remove-bookmark
-Remove the bookmark from the current article
-(@code{gnus-summary-remove-bookmark}).
-
-@item M V c
-@kindex M V c (Summary)
-@findex gnus-summary-clear-above
-Clear all marks from articles with scores over the default score (or
-over the numeric prefix) (@code{gnus-summary-clear-above}).
-
-@item M V u
-@kindex M V u (Summary)
-@findex gnus-summary-tick-above
-Tick all articles with scores over the default score (or over the
-numeric prefix) (@code{gnus-summary-tick-above}).
-
-@item M V m
-@kindex M V m (Summary)
-@findex gnus-summary-mark-above
-Prompt for a mark, and mark all articles with scores over the default
-score (or over the numeric prefix) with this mark
-(@code{gnus-summary-clear-above}).
-@end table
-
-@vindex gnus-summary-goto-unread
-The @code{gnus-summary-goto-unread} variable controls what action should
-be taken after setting a mark. If non-@code{nil}, point will move to
-the next/previous unread article. If @code{nil}, point will just move
-one line up or down. As a special case, if this variable is
-@code{never}, all the marking commands as well as other commands (like
-@kbd{SPACE}) will move to the next article, whether it is unread or not.
-The default is @code{t}.
-
-
-@node Generic Marking Commands
-@subsection Generic Marking Commands
-
-Some people would like the command that ticks an article (@kbd{!}) go to
-the next article. Others would like it to go to the next unread
-article. Yet others would like it to stay on the current article. And
-even though I haven't heard of anybody wanting it to go to the
-previous (unread) article, I'm sure there are people that want that as
-well.
-
-Multiply these five behaviors with five different marking commands, and
-you get a potentially complex set of variable to control what each
-command should do.
-
-To sidestep that mess, Gnus provides commands that do all these
-different things. They can be found on the @kbd{M M} map in the summary
-buffer. Type @kbd{M M C-h} to see them all---there are too many of them
-to list in this manual.
-
-While you can use these commands directly, most users would prefer
-altering the summary mode keymap. For instance, if you would like the
-@kbd{!} command to go to the next article instead of the next unread
-article, you could say something like:
-
-@lisp
-@group
-(add-hook 'gnus-summary-mode-hook 'my-alter-summary-map)
-(defun my-alter-summary-map ()
- (local-set-key "!" 'gnus-summary-put-mark-as-ticked-next))
-@end group
-@end lisp
-
-@noindent
-or
-
-@lisp
-(defun my-alter-summary-map ()
- (local-set-key "!" "MM!n"))
-@end lisp
-
-
-@node Setting Process Marks
-@subsection Setting Process Marks
-@cindex setting process marks
-
-Process marks are displayed as @code{#} in the summary buffer, and are
-used for marking articles in such a way that other commands will
-process these articles. For instance, if you process mark four
-articles and then use the @kbd{*} command, Gnus will enter these four
-articles into the cache. For more information,
-@pxref{Process/Prefix}.
-
-@table @kbd
-
-@item M P p
-@itemx #
-@kindex # (Summary)
-@kindex M P p (Summary)
-@findex gnus-summary-mark-as-processable
-Mark the current article with the process mark
-(@code{gnus-summary-mark-as-processable}).
-@findex gnus-summary-unmark-as-processable
-
-@item M P u
-@itemx M-#
-@kindex M P u (Summary)
-@kindex M-# (Summary)
-Remove the process mark, if any, from the current article
-(@code{gnus-summary-unmark-as-processable}).
-
-@item M P U
-@kindex M P U (Summary)
-@findex gnus-summary-unmark-all-processable
-Remove the process mark from all articles
-(@code{gnus-summary-unmark-all-processable}).
-
-@item M P i
-@kindex M P i (Summary)
-@findex gnus-uu-invert-processable
-Invert the list of process marked articles
-(@code{gnus-uu-invert-processable}).
-
-@item M P R
-@kindex M P R (Summary)
-@findex gnus-uu-mark-by-regexp
-Mark articles that have a @code{Subject} header that matches a regular
-expression (@code{gnus-uu-mark-by-regexp}).
-
-@item M P G
-@kindex M P G (Summary)
-@findex gnus-uu-unmark-by-regexp
-Unmark articles that have a @code{Subject} header that matches a regular
-expression (@code{gnus-uu-unmark-by-regexp}).
-
-@item M P r
-@kindex M P r (Summary)
-@findex gnus-uu-mark-region
-Mark articles in region (@code{gnus-uu-mark-region}).
-
-@item M P g
-@kindex M P g (Summary)
-@findex gnus-uu-unmark-region
-Unmark articles in region (@code{gnus-uu-unmark-region}).
-
-@item M P t
-@kindex M P t (Summary)
-@findex gnus-uu-mark-thread
-Mark all articles in the current (sub)thread
-(@code{gnus-uu-mark-thread}).
-
-@item M P T
-@kindex M P T (Summary)
-@findex gnus-uu-unmark-thread
-Unmark all articles in the current (sub)thread
-(@code{gnus-uu-unmark-thread}).
-
-@item M P v
-@kindex M P v (Summary)
-@findex gnus-uu-mark-over
-Mark all articles that have a score above the prefix argument
-(@code{gnus-uu-mark-over}).
-
-@item M P s
-@kindex M P s (Summary)
-@findex gnus-uu-mark-series
-Mark all articles in the current series (@code{gnus-uu-mark-series}).
-
-@item M P S
-@kindex M P S (Summary)
-@findex gnus-uu-mark-sparse
-Mark all series that have already had some articles marked
-(@code{gnus-uu-mark-sparse}).
-
-@item M P a
-@kindex M P a (Summary)
-@findex gnus-uu-mark-all
-Mark all articles in series order (@code{gnus-uu-mark-all}).
-
-@item M P b
-@kindex M P b (Summary)
-@findex gnus-uu-mark-buffer
-Mark all articles in the buffer in the order they appear
-(@code{gnus-uu-mark-buffer}).
-
-@item M P k
-@kindex M P k (Summary)
-@findex gnus-summary-kill-process-mark
-Push the current process mark set onto the stack and unmark all articles
-(@code{gnus-summary-kill-process-mark}).
-
-@item M P y
-@kindex M P y (Summary)
-@findex gnus-summary-yank-process-mark
-Pop the previous process mark set from the stack and restore it
-(@code{gnus-summary-yank-process-mark}).
-
-@item M P w
-@kindex M P w (Summary)
-@findex gnus-summary-save-process-mark
-Push the current process mark set onto the stack
-(@code{gnus-summary-save-process-mark}).
-
-@end table
-
-Also see the @kbd{&} command in @ref{Searching for Articles}, for how to
-set process marks based on article body contents.
-
-
-@node Limiting
-@section Limiting
-@cindex limiting
-
-It can be convenient to limit the summary buffer to just show some
-subset of the articles currently in the group. The effect most limit
-commands have is to remove a few (or many) articles from the summary
-buffer.
-
-All limiting commands work on subsets of the articles already fetched
-from the servers. None of these commands query the server for
-additional articles.
-
-@table @kbd
-
-@item / /
-@itemx / s
-@kindex / / (Summary)
-@findex gnus-summary-limit-to-subject
-Limit the summary buffer to articles that match some subject
-(@code{gnus-summary-limit-to-subject}). If given a prefix, exclude
-matching articles.
-
-@item / a
-@kindex / a (Summary)
-@findex gnus-summary-limit-to-author
-Limit the summary buffer to articles that match some author
-(@code{gnus-summary-limit-to-author}). If given a prefix, exclude
-matching articles.
-
-@item / x
-@kindex / x (Summary)
-@findex gnus-summary-limit-to-extra
-Limit the summary buffer to articles that match one of the ``extra''
-headers (@pxref{To From Newsgroups})
-(@code{gnus-summary-limit-to-extra}). If given a prefix, exclude
-matching articles.
-
-@item / u
-@itemx x
-@kindex / u (Summary)
-@kindex x (Summary)
-@findex gnus-summary-limit-to-unread
-Limit the summary buffer to articles not marked as read
-(@code{gnus-summary-limit-to-unread}). If given a prefix, limit the
-buffer to articles strictly unread. This means that ticked and
-dormant articles will also be excluded.
-
-@item / m
-@kindex / m (Summary)
-@findex gnus-summary-limit-to-marks
-Ask for a mark and then limit to all articles that have been marked
-with that mark (@code{gnus-summary-limit-to-marks}).
-
-@item / t
-@kindex / t (Summary)
-@findex gnus-summary-limit-to-age
-Ask for a number and then limit the summary buffer to articles older than (or equal to) that number of days
-(@code{gnus-summary-limit-to-age}). If given a prefix, limit to
-articles younger than that number of days.
-
-@item / n
-@kindex / n (Summary)
-@findex gnus-summary-limit-to-articles
-With prefix @samp{n}, limit the summary buffer to the next @samp{n}
-articles. If not given a prefix, use the process marked articles
-instead. (@code{gnus-summary-limit-to-articles}).
-
-@item / w
-@kindex / w (Summary)
-@findex gnus-summary-pop-limit
-Pop the previous limit off the stack and restore it
-(@code{gnus-summary-pop-limit}). If given a prefix, pop all limits off
-the stack.
-
-@item / .
-@kindex / . (Summary)
-@findex gnus-summary-limit-to-unseen
-Limit the summary buffer to the unseen articles
-(@code{gnus-summary-limit-to-unseen}).
-
-@item / v
-@kindex / v (Summary)
-@findex gnus-summary-limit-to-score
-Limit the summary buffer to articles that have a score at or above some
-score (@code{gnus-summary-limit-to-score}).
-
-@item / p
-@kindex / p (Summary)
-@findex gnus-summary-limit-to-display-predicate
-Limit the summary buffer to articles that satisfy the @code{display}
-group parameter predicate
-(@code{gnus-summary-limit-to-display-predicate}). @xref{Group
-Parameters}, for more on this predicate.
-
-@item / E
-@itemx M S
-@kindex M S (Summary)
-@kindex / E (Summary)
-@findex gnus-summary-limit-include-expunged
-Include all expunged articles in the limit
-(@code{gnus-summary-limit-include-expunged}).
-
-@item / D
-@kindex / D (Summary)
-@findex gnus-summary-limit-include-dormant
-Include all dormant articles in the limit
-(@code{gnus-summary-limit-include-dormant}).
-
-@item / *
-@kindex / * (Summary)
-@findex gnus-summary-limit-include-cached
-Include all cached articles in the limit
-(@code{gnus-summary-limit-include-cached}).
-
-@item / d
-@kindex / d (Summary)
-@findex gnus-summary-limit-exclude-dormant
-Exclude all dormant articles from the limit
-(@code{gnus-summary-limit-exclude-dormant}).
-
-@item / M
-@kindex / M (Summary)
-@findex gnus-summary-limit-exclude-marks
-Exclude all marked articles (@code{gnus-summary-limit-exclude-marks}).
-
-@item / T
-@kindex / T (Summary)
-@findex gnus-summary-limit-include-thread
-Include all the articles in the current thread in the limit.
-
-@item / c
-@kindex / c (Summary)
-@findex gnus-summary-limit-exclude-childless-dormant
-Exclude all dormant articles that have no children from the limit@*
-(@code{gnus-summary-limit-exclude-childless-dormant}).
-
-@item / C
-@kindex / C (Summary)
-@findex gnus-summary-limit-mark-excluded-as-read
-Mark all excluded unread articles as read
-(@code{gnus-summary-limit-mark-excluded-as-read}). If given a prefix,
-also mark excluded ticked and dormant articles as read.
-
-@item / N
-@kindex / N (Summary)
-@findex gnus-summary-insert-new-articles
-Insert all new articles in the summary buffer. It scans for new emails
-if @var{back-end}@code{-get-new-mail} is non-@code{nil}.
-
-@item / o
-@kindex / o (Summary)
-@findex gnus-summary-insert-old-articles
-Insert all old articles in the summary buffer. If given a numbered
-prefix, fetch this number of articles.
-
-@end table
-
-
-@node Threading
-@section Threading
-@cindex threading
-@cindex article threading
-
-Gnus threads articles by default. @dfn{To thread} is to put responses
-to articles directly after the articles they respond to---in a
-hierarchical fashion.
-
-Threading is done by looking at the @code{References} headers of the
-articles. In a perfect world, this would be enough to build pretty
-trees, but unfortunately, the @code{References} header is often broken
-or simply missing. Weird news propagation exacerbates the problem,
-so one has to employ other heuristics to get pleasing results. A
-plethora of approaches exists, as detailed in horrible detail in
-@ref{Customizing Threading}.
-
-First, a quick overview of the concepts:
-
-@table @dfn
-@item root
-The top-most article in a thread; the first article in the thread.
-
-@item thread
-A tree-like article structure.
-
-@item sub-thread
-A small(er) section of this tree-like structure.
-
-@item loose threads
-Threads often lose their roots due to article expiry, or due to the root
-already having been read in a previous session, and not displayed in the
-summary buffer. We then typically have many sub-threads that really
-belong to one thread, but are without connecting roots. These are
-called loose threads.
-
-@item thread gathering
-An attempt to gather loose threads into bigger threads.
-
-@item sparse threads
-A thread where the missing articles have been ``guessed'' at, and are
-displayed as empty lines in the summary buffer.
-
-@end table
-
-
-@menu
-* Customizing Threading:: Variables you can change to affect the threading.
-* Thread Commands:: Thread based commands in the summary buffer.
-@end menu
-
-
-@node Customizing Threading
-@subsection Customizing Threading
-@cindex customizing threading
-
-@menu
-* Loose Threads:: How Gnus gathers loose threads into bigger threads.
-* Filling In Threads:: Making the threads displayed look fuller.
-* More Threading:: Even more variables for fiddling with threads.
-* Low-Level Threading:: You thought it was over@dots{} but you were wrong!
-@end menu
-
-
-@node Loose Threads
-@subsubsection Loose Threads
-@cindex <
-@cindex >
-@cindex loose threads
-
-@table @code
-@item gnus-summary-make-false-root
-@vindex gnus-summary-make-false-root
-If non-@code{nil}, Gnus will gather all loose subtrees into one big tree
-and create a dummy root at the top. (Wait a minute. Root at the top?
-Yup.) Loose subtrees occur when the real root has expired, or you've
-read or killed the root in a previous session.
-
-When there is no real root of a thread, Gnus will have to fudge
-something. This variable says what fudging method Gnus should use.
-There are four possible values:
-
-@iftex
-@iflatex
-\gnusfigure{The Summary Buffer}{390}{
-\put(0,0){\epsfig{figure=ps/summary-adopt,width=7.5cm}}
-\put(445,0){\makebox(0,0)[br]{\epsfig{figure=ps/summary-empty,width=7.5cm}}}
-\put(0,400){\makebox(0,0)[tl]{\epsfig{figure=ps/summary-none,width=7.5cm}}}
-\put(445,400){\makebox(0,0)[tr]{\epsfig{figure=ps/summary-dummy,width=7.5cm}}}
-}
-@end iflatex
-@end iftex
-
-@cindex adopting articles
-
-@table @code
-
-@item adopt
-Gnus will make the first of the orphaned articles the parent. This
-parent will adopt all the other articles. The adopted articles will be
-marked as such by pointy brackets (@samp{<>}) instead of the standard
-square brackets (@samp{[]}). This is the default method.
-
-@item dummy
-@vindex gnus-summary-dummy-line-format
-@vindex gnus-summary-make-false-root-always
-Gnus will create a dummy summary line that will pretend to be the
-parent. This dummy line does not correspond to any real article, so
-selecting it will just select the first real article after the dummy
-article. @code{gnus-summary-dummy-line-format} is used to specify the
-format of the dummy roots. It accepts only one format spec: @samp{S},
-which is the subject of the article. @xref{Formatting Variables}.
-If you want all threads to have a dummy root, even the non-gathered
-ones, set @code{gnus-summary-make-false-root-always} to @code{t}.
-
-@item empty
-Gnus won't actually make any article the parent, but simply leave the
-subject field of all orphans except the first empty. (Actually, it will
-use @code{gnus-summary-same-subject} as the subject (@pxref{Summary
-Buffer Format}).)
-
-@item none
-Don't make any article parent at all. Just gather the threads and
-display them after one another.
-
-@item nil
-Don't gather loose threads.
-@end table
-
-@item gnus-summary-gather-subject-limit
-@vindex gnus-summary-gather-subject-limit
-Loose threads are gathered by comparing subjects of articles. If this
-variable is @code{nil}, Gnus requires an exact match between the
-subjects of the loose threads before gathering them into one big
-super-thread. This might be too strict a requirement, what with the
-presence of stupid newsreaders that chop off long subject lines. If
-you think so, set this variable to, say, 20 to require that only the
-first 20 characters of the subjects have to match. If you set this
-variable to a really low number, you'll find that Gnus will gather
-everything in sight into one thread, which isn't very helpful.
-
-@cindex fuzzy article gathering
-If you set this variable to the special value @code{fuzzy}, Gnus will
-use a fuzzy string comparison algorithm on the subjects (@pxref{Fuzzy
-Matching}).
-
-@item gnus-simplify-subject-fuzzy-regexp
-@vindex gnus-simplify-subject-fuzzy-regexp
-This can either be a regular expression or list of regular expressions
-that match strings that will be removed from subjects if fuzzy subject
-simplification is used.
-
-@item gnus-simplify-ignored-prefixes
-@vindex gnus-simplify-ignored-prefixes
-If you set @code{gnus-summary-gather-subject-limit} to something as low
-as 10, you might consider setting this variable to something sensible:
-
-@c Written by Michael Ernst <mernst@cs.rice.edu>
-@lisp
-(setq gnus-simplify-ignored-prefixes
- (concat
- "\\`\\[?\\("
- (mapconcat
- 'identity
- '("looking"
- "wanted" "followup" "summary\\( of\\)?"
- "help" "query" "problem" "question"
- "answer" "reference" "announce"
- "How can I" "How to" "Comparison of"
- ;; ...
- )
- "\\|")
- "\\)\\s *\\("
- (mapconcat 'identity
- '("for" "for reference" "with" "about")
- "\\|")
- "\\)?\\]?:?[ \t]*"))
-@end lisp
-
-All words that match this regexp will be removed before comparing two
-subjects.
-
-@item gnus-simplify-subject-functions
-@vindex gnus-simplify-subject-functions
-If non-@code{nil}, this variable overrides
-@code{gnus-summary-gather-subject-limit}. This variable should be a
-list of functions to apply to the @code{Subject} string iteratively to
-arrive at the simplified version of the string.
-
-Useful functions to put in this list include:
-
-@table @code
-@item gnus-simplify-subject-re
-@findex gnus-simplify-subject-re
-Strip the leading @samp{Re:}.
-
-@item gnus-simplify-subject-fuzzy
-@findex gnus-simplify-subject-fuzzy
-Simplify fuzzily.
-
-@item gnus-simplify-whitespace
-@findex gnus-simplify-whitespace
-Remove excessive whitespace.
-
-@item gnus-simplify-all-whitespace
-@findex gnus-simplify-all-whitespace
-Remove all whitespace.
-@end table
-
-You may also write your own functions, of course.
-
-
-@item gnus-summary-gather-exclude-subject
-@vindex gnus-summary-gather-exclude-subject
-Since loose thread gathering is done on subjects only, that might lead
-to many false hits, especially with certain common subjects like
-@samp{} and @samp{(none)}. To make the situation slightly better,
-you can use the regexp @code{gnus-summary-gather-exclude-subject} to say
-what subjects should be excluded from the gathering process.@*
-The default is @samp{^ *$\\|^(none)$}.
-
-@item gnus-summary-thread-gathering-function
-@vindex gnus-summary-thread-gathering-function
-Gnus gathers threads by looking at @code{Subject} headers. This means
-that totally unrelated articles may end up in the same ``thread'', which
-is confusing. An alternate approach is to look at all the
-@code{Message-ID}s in all the @code{References} headers to find matches.
-This will ensure that no gathered threads ever include unrelated
-articles, but it also means that people who have posted with broken
-newsreaders won't be gathered properly. The choice is yours---plague or
-cholera:
-
-@table @code
-@item gnus-gather-threads-by-subject
-@findex gnus-gather-threads-by-subject
-This function is the default gathering function and looks at
-@code{Subject}s exclusively.
-
-@item gnus-gather-threads-by-references
-@findex gnus-gather-threads-by-references
-This function looks at @code{References} headers exclusively.
-@end table
-
-If you want to test gathering by @code{References}, you could say
-something like:
-
-@lisp
-(setq gnus-summary-thread-gathering-function
- 'gnus-gather-threads-by-references)
-@end lisp
-
-@end table
-
-
-@node Filling In Threads
-@subsubsection Filling In Threads
-
-@table @code
-@item gnus-fetch-old-headers
-@vindex gnus-fetch-old-headers
-If non-@code{nil}, Gnus will attempt to build old threads by fetching
-more old headers---headers to articles marked as read. If you would
-like to display as few summary lines as possible, but still connect as
-many loose threads as possible, you should set this variable to
-@code{some} or a number. If you set it to a number, no more than that
-number of extra old headers will be fetched. In either case, fetching
-old headers only works if the back end you are using carries overview
-files---this would normally be @code{nntp}, @code{nnspool},
-@code{nnml}, and @code{nnmaildir}. Also remember that if the root of
-the thread has been expired by the server, there's not much Gnus can
-do about that.
-
-This variable can also be set to @code{invisible}. This won't have any
-visible effects, but is useful if you use the @kbd{A T} command a lot
-(@pxref{Finding the Parent}).
-
-@item gnus-fetch-old-ephemeral-headers
-@vindex gnus-fetch-old-ephemeral-headers
-Same as @code{gnus-fetch-old-headers}, but only used for ephemeral
-newsgroups.
-
-@item gnus-build-sparse-threads
-@vindex gnus-build-sparse-threads
-Fetching old headers can be slow. A low-rent similar effect can be
-gotten by setting this variable to @code{some}. Gnus will then look at
-the complete @code{References} headers of all articles and try to string
-together articles that belong in the same thread. This will leave
-@dfn{gaps} in the threading display where Gnus guesses that an article
-is missing from the thread. (These gaps appear like normal summary
-lines. If you select a gap, Gnus will try to fetch the article in
-question.) If this variable is @code{t}, Gnus will display all these
-``gaps'' without regard for whether they are useful for completing the
-thread or not. Finally, if this variable is @code{more}, Gnus won't cut
-off sparse leaf nodes that don't lead anywhere. This variable is
-@code{nil} by default.
-
-@item gnus-read-all-available-headers
-@vindex gnus-read-all-available-headers
-This is a rather obscure variable that few will find useful. It's
-intended for those non-news newsgroups where the back end has to fetch
-quite a lot to present the summary buffer, and where it's impossible to
-go back to parents of articles. This is mostly the case in the
-web-based groups, like the @code{nnultimate} groups.
-
-If you don't use those, then it's safe to leave this as the default
-@code{nil}. If you want to use this variable, it should be a regexp
-that matches the group name, or @code{t} for all groups.
-
-@end table
-
-
-@node More Threading
-@subsubsection More Threading
-
-@table @code
-@item gnus-show-threads
-@vindex gnus-show-threads
-If this variable is @code{nil}, no threading will be done, and all of
-the rest of the variables here will have no effect. Turning threading
-off will speed group selection up a bit, but it is sure to make reading
-slower and more awkward.
-
-@item gnus-thread-hide-subtree
-@vindex gnus-thread-hide-subtree
-If non-@code{nil}, all threads will be hidden when the summary buffer is
-generated.
-
-This can also be a predicate specifier (@pxref{Predicate Specifiers}).
-Available predicates are @code{gnus-article-unread-p} and
-@code{gnus-article-unseen-p}.
-
-Here's an example:
-
-@lisp
-(setq gnus-thread-hide-subtree
- '(or gnus-article-unread-p
- gnus-article-unseen-p))
-@end lisp
-
-(It's a pretty nonsensical example, since all unseen articles are also
-unread, but you get my drift.)
-
-
-@item gnus-thread-expunge-below
-@vindex gnus-thread-expunge-below
-All threads that have a total score (as defined by
-@code{gnus-thread-score-function}) less than this number will be
-expunged. This variable is @code{nil} by default, which means that no
-threads are expunged.
-
-@item gnus-thread-hide-killed
-@vindex gnus-thread-hide-killed
-if you kill a thread and this variable is non-@code{nil}, the subtree
-will be hidden.
-
-@item gnus-thread-ignore-subject
-@vindex gnus-thread-ignore-subject
-Sometimes somebody changes the subject in the middle of a thread. If
-this variable is non-@code{nil}, which is the default, the subject
-change is ignored. If it is @code{nil}, a change in the subject will
-result in a new thread.
-
-@item gnus-thread-indent-level
-@vindex gnus-thread-indent-level
-This is a number that says how much each sub-thread should be indented.
-The default is 4.
-
-@item gnus-sort-gathered-threads-function
-@vindex gnus-sort-gathered-threads-function
-Sometimes, particularly with mailing lists, the order in which mails
-arrive locally is not necessarily the same as the order in which they
-arrived on the mailing list. Consequently, when sorting sub-threads
-using the default @code{gnus-thread-sort-by-number}, responses can end
-up appearing before the article to which they are responding to.
-Setting this variable to an alternate value
-(e.g. @code{gnus-thread-sort-by-date}), in a group's parameters or in an
-appropriate hook (e.g. @code{gnus-summary-generate-hook}) can produce a
-more logical sub-thread ordering in such instances.
-
-@end table
-
-
-@node Low-Level Threading
-@subsubsection Low-Level Threading
-
-@table @code
-
-@item gnus-parse-headers-hook
-@vindex gnus-parse-headers-hook
-Hook run before parsing any headers.
-
-@item gnus-alter-header-function
-@vindex gnus-alter-header-function
-If non-@code{nil}, this function will be called to allow alteration of
-article header structures. The function is called with one parameter,
-the article header vector, which it may alter in any way. For instance,
-if you have a mail-to-news gateway which alters the @code{Message-ID}s
-in systematic ways (by adding prefixes and such), you can use this
-variable to un-scramble the @code{Message-ID}s so that they are more
-meaningful. Here's one example:
-
-@lisp
-(setq gnus-alter-header-function 'my-alter-message-id)
-
-(defun my-alter-message-id (header)
- (let ((id (mail-header-id header)))
- (when (string-match
- "\\(<[^<>@@]*\\)\\.?cygnus\\..*@@\\([^<>@@]*>\\)" id)
- (mail-header-set-id
- (concat (match-string 1 id) "@@" (match-string 2 id))
- header))))
-@end lisp
-
-@end table
-
-
-@node Thread Commands
-@subsection Thread Commands
-@cindex thread commands
-
-@table @kbd
-
-@item T k
-@itemx C-M-k
-@kindex T k (Summary)
-@kindex C-M-k (Summary)
-@findex gnus-summary-kill-thread
-Mark all articles in the current (sub-)thread as read
-(@code{gnus-summary-kill-thread}). If the prefix argument is positive,
-remove all marks instead. If the prefix argument is negative, tick
-articles instead.
-
-@item T l
-@itemx C-M-l
-@kindex T l (Summary)
-@kindex C-M-l (Summary)
-@findex gnus-summary-lower-thread
-Lower the score of the current (sub-)thread
-(@code{gnus-summary-lower-thread}).
-
-@item T i
-@kindex T i (Summary)
-@findex gnus-summary-raise-thread
-Increase the score of the current (sub-)thread
-(@code{gnus-summary-raise-thread}).
-
-@item T #
-@kindex T # (Summary)
-@findex gnus-uu-mark-thread
-Set the process mark on the current (sub-)thread
-(@code{gnus-uu-mark-thread}).
-
-@item T M-#
-@kindex T M-# (Summary)
-@findex gnus-uu-unmark-thread
-Remove the process mark from the current (sub-)thread
-(@code{gnus-uu-unmark-thread}).
-
-@item T T
-@kindex T T (Summary)
-@findex gnus-summary-toggle-threads
-Toggle threading (@code{gnus-summary-toggle-threads}).
-
-@item T s
-@kindex T s (Summary)
-@findex gnus-summary-show-thread
-Expose the (sub-)thread hidden under the current article, if any@*
-(@code{gnus-summary-show-thread}).
-
-@item T h
-@kindex T h (Summary)
-@findex gnus-summary-hide-thread
-Hide the current (sub-)thread (@code{gnus-summary-hide-thread}).
-
-@item T S
-@kindex T S (Summary)
-@findex gnus-summary-show-all-threads
-Expose all hidden threads (@code{gnus-summary-show-all-threads}).
-
-@item T H
-@kindex T H (Summary)
-@findex gnus-summary-hide-all-threads
-Hide all threads (@code{gnus-summary-hide-all-threads}).
-
-@item T t
-@kindex T t (Summary)
-@findex gnus-summary-rethread-current
-Re-thread the current article's thread
-(@code{gnus-summary-rethread-current}). This works even when the
-summary buffer is otherwise unthreaded.
-
-@item T ^
-@kindex T ^ (Summary)
-@findex gnus-summary-reparent-thread
-Make the current article the child of the marked (or previous) article
-(@code{gnus-summary-reparent-thread}).
-
-@end table
-
-The following commands are thread movement commands. They all
-understand the numeric prefix.
-
-@table @kbd
-
-@item T n
-@kindex T n (Summary)
-@itemx C-M-f
-@kindex C-M-n (Summary)
-@itemx M-down
-@kindex M-down (Summary)
-@findex gnus-summary-next-thread
-Go to the next thread (@code{gnus-summary-next-thread}).
-
-@item T p
-@kindex T p (Summary)
-@itemx C-M-b
-@kindex C-M-p (Summary)
-@itemx M-up
-@kindex M-up (Summary)
-@findex gnus-summary-prev-thread
-Go to the previous thread (@code{gnus-summary-prev-thread}).
-
-@item T d
-@kindex T d (Summary)
-@findex gnus-summary-down-thread
-Descend the thread (@code{gnus-summary-down-thread}).
-
-@item T u
-@kindex T u (Summary)
-@findex gnus-summary-up-thread
-Ascend the thread (@code{gnus-summary-up-thread}).
-
-@item T o
-@kindex T o (Summary)
-@findex gnus-summary-top-thread
-Go to the top of the thread (@code{gnus-summary-top-thread}).
-@end table
-
-@vindex gnus-thread-operation-ignore-subject
-If you ignore subject while threading, you'll naturally end up with
-threads that have several different subjects in them. If you then issue
-a command like @kbd{T k} (@code{gnus-summary-kill-thread}) you might not
-wish to kill the entire thread, but just those parts of the thread that
-have the same subject as the current article. If you like this idea,
-you can fiddle with @code{gnus-thread-operation-ignore-subject}. If it
-is non-@code{nil} (which it is by default), subjects will be ignored
-when doing thread commands. If this variable is @code{nil}, articles in
-the same thread with different subjects will not be included in the
-operation in question. If this variable is @code{fuzzy}, only articles
-that have subjects fuzzily equal will be included (@pxref{Fuzzy
-Matching}).
-
-
-@node Sorting the Summary Buffer
-@section Sorting the Summary Buffer
-
-@findex gnus-thread-sort-by-total-score
-@findex gnus-thread-sort-by-date
-@findex gnus-thread-sort-by-score
-@findex gnus-thread-sort-by-subject
-@findex gnus-thread-sort-by-author
-@findex gnus-thread-sort-by-number
-@findex gnus-thread-sort-by-random
-@vindex gnus-thread-sort-functions
-@findex gnus-thread-sort-by-most-recent-number
-@findex gnus-thread-sort-by-most-recent-date
-If you are using a threaded summary display, you can sort the threads by
-setting @code{gnus-thread-sort-functions}, which can be either a single
-function, a list of functions, or a list containing functions and
-@code{(not some-function)} elements.
-
-By default, sorting is done on article numbers. Ready-made sorting
-predicate functions include @code{gnus-thread-sort-by-number},
-@code{gnus-thread-sort-by-author}, @code{gnus-thread-sort-by-subject},
-@code{gnus-thread-sort-by-date}, @code{gnus-thread-sort-by-score},
-@code{gnus-thread-sort-by-most-recent-number},
-@code{gnus-thread-sort-by-most-recent-date},
-@code{gnus-thread-sort-by-random} and
-@code{gnus-thread-sort-by-total-score}.
-
-Each function takes two threads and returns non-@code{nil} if the first
-thread should be sorted before the other. Note that sorting really is
-normally done by looking only at the roots of each thread.
-
-If you use more than one function, the primary sort key should be the
-last function in the list. You should probably always include
-@code{gnus-thread-sort-by-number} in the list of sorting
-functions---preferably first. This will ensure that threads that are
-equal with respect to the other sort criteria will be displayed in
-ascending article order.
-
-If you would like to sort by reverse score, then by subject, and finally
-by number, you could do something like:
-
-@lisp
-(setq gnus-thread-sort-functions
- '(gnus-thread-sort-by-number
- gnus-thread-sort-by-subject
- (not gnus-thread-sort-by-total-score)))
-@end lisp
-
-The threads that have highest score will be displayed first in the
-summary buffer. When threads have the same score, they will be sorted
-alphabetically. The threads that have the same score and the same
-subject will be sorted by number, which is (normally) the sequence in
-which the articles arrived.
-
-If you want to sort by score and then reverse arrival order, you could
-say something like:
-
-@lisp
-(setq gnus-thread-sort-functions
- '((lambda (t1 t2)
- (not (gnus-thread-sort-by-number t1 t2)))
- gnus-thread-sort-by-score))
-@end lisp
-
-@vindex gnus-thread-score-function
-The function in the @code{gnus-thread-score-function} variable (default
-@code{+}) is used for calculating the total score of a thread. Useful
-functions might be @code{max}, @code{min}, or squared means, or whatever
-tickles your fancy.
-
-@findex gnus-article-sort-functions
-@findex gnus-article-sort-by-date
-@findex gnus-article-sort-by-score
-@findex gnus-article-sort-by-subject
-@findex gnus-article-sort-by-author
-@findex gnus-article-sort-by-random
-@findex gnus-article-sort-by-number
-If you are using an unthreaded display for some strange reason or
-other, you have to fiddle with the @code{gnus-article-sort-functions}
-variable. It is very similar to the
-@code{gnus-thread-sort-functions}, except that it uses slightly
-different functions for article comparison. Available sorting
-predicate functions are @code{gnus-article-sort-by-number},
-@code{gnus-article-sort-by-author},
-@code{gnus-article-sort-by-subject}, @code{gnus-article-sort-by-date},
-@code{gnus-article-sort-by-random}, and
-@code{gnus-article-sort-by-score}.
-
-If you want to sort an unthreaded summary display by subject, you could
-say something like:
-
-@lisp
-(setq gnus-article-sort-functions
- '(gnus-article-sort-by-number
- gnus-article-sort-by-subject))
-@end lisp
-
-
-
-@node Asynchronous Fetching
-@section Asynchronous Article Fetching
-@cindex asynchronous article fetching
-@cindex article pre-fetch
-@cindex pre-fetch
-
-If you read your news from an @acronym{NNTP} server that's far away, the
-network latencies may make reading articles a chore. You have to wait
-for a while after pressing @kbd{n} to go to the next article before the
-article appears. Why can't Gnus just go ahead and fetch the article
-while you are reading the previous one? Why not, indeed.
-
-First, some caveats. There are some pitfalls to using asynchronous
-article fetching, especially the way Gnus does it.
-
-Let's say you are reading article 1, which is short, and article 2 is
-quite long, and you are not interested in reading that. Gnus does not
-know this, so it goes ahead and fetches article 2. You decide to read
-article 3, but since Gnus is in the process of fetching article 2, the
-connection is blocked.
-
-To avoid these situations, Gnus will open two (count 'em two)
-connections to the server. Some people may think this isn't a very nice
-thing to do, but I don't see any real alternatives. Setting up that
-extra connection takes some time, so Gnus startup will be slower.
-
-Gnus will fetch more articles than you will read. This will mean that
-the link between your machine and the @acronym{NNTP} server will become more
-loaded than if you didn't use article pre-fetch. The server itself will
-also become more loaded---both with the extra article requests, and the
-extra connection.
-
-Ok, so now you know that you shouldn't really use this thing@dots{} unless
-you really want to.
-
-@vindex gnus-asynchronous
-Here's how: Set @code{gnus-asynchronous} to @code{t}. The rest should
-happen automatically.
-
-@vindex gnus-use-article-prefetch
-You can control how many articles are to be pre-fetched by setting
-@code{gnus-use-article-prefetch}. This is 30 by default, which means
-that when you read an article in the group, the back end will pre-fetch
-the next 30 articles. If this variable is @code{t}, the back end will
-pre-fetch all the articles it can without bound. If it is
-@code{nil}, no pre-fetching will be done.
-
-@vindex gnus-async-prefetch-article-p
-@findex gnus-async-unread-p
-There are probably some articles that you don't want to pre-fetch---read
-articles, for instance. The @code{gnus-async-prefetch-article-p}
-variable controls whether an article is to be pre-fetched. This
-function should return non-@code{nil} when the article in question is
-to be pre-fetched. The default is @code{gnus-async-unread-p}, which
-returns @code{nil} on read articles. The function is called with an
-article data structure as the only parameter.
-
-If, for instance, you wish to pre-fetch only unread articles shorter
-than 100 lines, you could say something like:
-
-@lisp
-(defun my-async-short-unread-p (data)
- "Return non-nil for short, unread articles."
- (and (gnus-data-unread-p data)
- (< (mail-header-lines (gnus-data-header data))
- 100)))
-
-(setq gnus-async-prefetch-article-p 'my-async-short-unread-p)
-@end lisp
-
-These functions will be called many, many times, so they should
-preferably be short and sweet to avoid slowing down Gnus too much.
-It's probably a good idea to byte-compile things like this.
-
-@vindex gnus-prefetched-article-deletion-strategy
-Articles have to be removed from the asynch buffer sooner or later. The
-@code{gnus-prefetched-article-deletion-strategy} says when to remove
-articles. This is a list that may contain the following elements:
-
-@table @code
-@item read
-Remove articles when they are read.
-
-@item exit
-Remove articles when exiting the group.
-@end table
-
-The default value is @code{(read exit)}.
-
-@c @vindex gnus-use-header-prefetch
-@c If @code{gnus-use-header-prefetch} is non-@code{nil}, prefetch articles
-@c from the next group.
-
-
-@node Article Caching
-@section Article Caching
-@cindex article caching
-@cindex caching
-
-If you have an @emph{extremely} slow @acronym{NNTP} connection, you may
-consider turning article caching on. Each article will then be stored
-locally under your home directory. As you may surmise, this could
-potentially use @emph{huge} amounts of disk space, as well as eat up all
-your inodes so fast it will make your head swim. In vodka.
-
-Used carefully, though, it could be just an easier way to save articles.
-
-@vindex gnus-use-long-file-name
-@vindex gnus-cache-directory
-@vindex gnus-use-cache
-To turn caching on, set @code{gnus-use-cache} to @code{t}. By default,
-all articles ticked or marked as dormant will then be copied
-over to your local cache (@code{gnus-cache-directory}). Whether this
-cache is flat or hierarchical is controlled by the
-@code{gnus-use-long-file-name} variable, as usual.
-
-When re-selecting a ticked or dormant article, it will be fetched from the
-cache instead of from the server. As articles in your cache will never
-expire, this might serve as a method of saving articles while still
-keeping them where they belong. Just mark all articles you want to save
-as dormant, and don't worry.
-
-When an article is marked as read, is it removed from the cache.
-
-@vindex gnus-cache-remove-articles
-@vindex gnus-cache-enter-articles
-The entering/removal of articles from the cache is controlled by the
-@code{gnus-cache-enter-articles} and @code{gnus-cache-remove-articles}
-variables. Both are lists of symbols. The first is @code{(ticked
-dormant)} by default, meaning that ticked and dormant articles will be
-put in the cache. The latter is @code{(read)} by default, meaning that
-articles marked as read are removed from the cache. Possibly
-symbols in these two lists are @code{ticked}, @code{dormant},
-@code{unread} and @code{read}.
-
-@findex gnus-jog-cache
-So where does the massive article-fetching and storing come into the
-picture? The @code{gnus-jog-cache} command will go through all
-subscribed newsgroups, request all unread articles, score them, and
-store them in the cache. You should only ever, ever ever ever, use this
-command if 1) your connection to the @acronym{NNTP} server is really, really,
-really slow and 2) you have a really, really, really huge disk.
-Seriously. One way to cut down on the number of articles downloaded is
-to score unwanted articles down and have them marked as read. They will
-not then be downloaded by this command.
-
-@vindex gnus-uncacheable-groups
-@vindex gnus-cacheable-groups
-It is likely that you do not want caching on all groups. For instance,
-if your @code{nnml} mail is located under your home directory, it makes no
-sense to cache it somewhere else under your home directory. Unless you
-feel that it's neat to use twice as much space.
-
-To limit the caching, you could set @code{gnus-cacheable-groups} to a
-regexp of groups to cache, @samp{^nntp} for instance, or set the
-@code{gnus-uncacheable-groups} regexp to @samp{^nnml}, for instance.
-Both variables are @code{nil} by default. If a group matches both
-variables, the group is not cached.
-
-@findex gnus-cache-generate-nov-databases
-@findex gnus-cache-generate-active
-@vindex gnus-cache-active-file
-The cache stores information on what articles it contains in its active
-file (@code{gnus-cache-active-file}). If this file (or any other parts
-of the cache) becomes all messed up for some reason or other, Gnus
-offers two functions that will try to set things right. @kbd{M-x
-gnus-cache-generate-nov-databases} will (re)build all the @acronym{NOV}
-files, and @kbd{gnus-cache-generate-active} will (re)generate the active
-file.
-
-@findex gnus-cache-move-cache
-@code{gnus-cache-move-cache} will move your whole
-@code{gnus-cache-directory} to some other location. You get asked to
-where, isn't that cool?
-
-@node Persistent Articles
-@section Persistent Articles
-@cindex persistent articles
-
-Closely related to article caching, we have @dfn{persistent articles}.
-In fact, it's just a different way of looking at caching, and much more
-useful in my opinion.
-
-Say you're reading a newsgroup, and you happen on to some valuable gem
-that you want to keep and treasure forever. You'd normally just save it
-(using one of the many saving commands) in some file. The problem with
-that is that it's just, well, yucky. Ideally you'd prefer just having
-the article remain in the group where you found it forever; untouched by
-the expiry going on at the news server.
-
-This is what a @dfn{persistent article} is---an article that just won't
-be deleted. It's implemented using the normal cache functions, but
-you use two explicit commands for managing persistent articles:
-
-@table @kbd
-
-@item *
-@kindex * (Summary)
-@findex gnus-cache-enter-article
-Make the current article persistent (@code{gnus-cache-enter-article}).
-
-@item M-*
-@kindex M-* (Summary)
-@findex gnus-cache-remove-article
-Remove the current article from the persistent articles
-(@code{gnus-cache-remove-article}). This will normally delete the
-article.
-@end table
-
-Both these commands understand the process/prefix convention.
-
-To avoid having all ticked articles (and stuff) entered into the cache,
-you should set @code{gnus-use-cache} to @code{passive} if you're just
-interested in persistent articles:
-
-@lisp
-(setq gnus-use-cache 'passive)
-@end lisp
-
-
-@node Article Backlog
-@section Article Backlog
-@cindex backlog
-@cindex article backlog
-
-If you have a slow connection, but the idea of using caching seems
-unappealing to you (and it is, really), you can help the situation some
-by switching on the @dfn{backlog}. This is where Gnus will buffer
-already read articles so that it doesn't have to re-fetch articles
-you've already read. This only helps if you are in the habit of
-re-selecting articles you've recently read, of course. If you never do
-that, turning the backlog on will slow Gnus down a little bit, and
-increase memory usage some.
-
-@vindex gnus-keep-backlog
-If you set @code{gnus-keep-backlog} to a number @var{n}, Gnus will store
-at most @var{n} old articles in a buffer for later re-fetching. If this
-variable is non-@code{nil} and is not a number, Gnus will store
-@emph{all} read articles, which means that your Emacs will grow without
-bound before exploding and taking your machine down with you. I put
-that in there just to keep y'all on your toes.
-
-The default value is 20.
-
-
-@node Saving Articles
-@section Saving Articles
-@cindex saving articles
-
-Gnus can save articles in a number of ways. Below is the documentation
-for saving articles in a fairly straight-forward fashion (i.e., little
-processing of the article is done before it is saved). For a different
-approach (uudecoding, unsharing) you should use @code{gnus-uu}
-(@pxref{Decoding Articles}).
-
-For the commands listed here, the target is a file. If you want to
-save to a group, see the @kbd{B c} (@code{gnus-summary-copy-article})
-command (@pxref{Mail Group Commands}).
-
-@vindex gnus-save-all-headers
-If @code{gnus-save-all-headers} is non-@code{nil}, Gnus will not delete
-unwanted headers before saving the article.
-
-@vindex gnus-saved-headers
-If the preceding variable is @code{nil}, all headers that match the
-@code{gnus-saved-headers} regexp will be kept, while the rest will be
-deleted before saving.
-
-@table @kbd
-
-@item O o
-@itemx o
-@kindex O o (Summary)
-@kindex o (Summary)
-@findex gnus-summary-save-article
-@c @icon{gnus-summary-save-article}
-Save the current article using the default article saver
-(@code{gnus-summary-save-article}).
-
-@item O m
-@kindex O m (Summary)
-@findex gnus-summary-save-article-mail
-Save the current article in a Unix mail box (mbox) file
-(@code{gnus-summary-save-article-mail}).
-
-@item O r
-@kindex O r (Summary)
-@findex gnus-summary-save-article-rmail
-Save the current article in Rmail format
-(@code{gnus-summary-save-article-rmail}).
-
-@item O f
-@kindex O f (Summary)
-@findex gnus-summary-save-article-file
-@c @icon{gnus-summary-save-article-file}
-Save the current article in plain file format
-(@code{gnus-summary-save-article-file}).
-
-@item O F
-@kindex O F (Summary)
-@findex gnus-summary-write-article-file
-Write the current article in plain file format, overwriting any previous
-file contents (@code{gnus-summary-write-article-file}).
-
-@item O b
-@kindex O b (Summary)
-@findex gnus-summary-save-article-body-file
-Save the current article body in plain file format
-(@code{gnus-summary-save-article-body-file}).
-
-@item O h
-@kindex O h (Summary)
-@findex gnus-summary-save-article-folder
-Save the current article in mh folder format
-(@code{gnus-summary-save-article-folder}).
-
-@item O v
-@kindex O v (Summary)
-@findex gnus-summary-save-article-vm
-Save the current article in a VM folder
-(@code{gnus-summary-save-article-vm}).
-
-@item O p
-@itemx |
-@kindex O p (Summary)
-@kindex | (Summary)
-@findex gnus-summary-pipe-output
-Save the current article in a pipe. Uhm, like, what I mean is---Pipe
-the current article to a process (@code{gnus-summary-pipe-output}).
-If given a symbolic prefix (@pxref{Symbolic Prefixes}), include the
-complete headers in the piped output.
-
-@item O P
-@kindex O P (Summary)
-@findex gnus-summary-muttprint
-@vindex gnus-summary-muttprint-program
-Save the current article into muttprint. That is, print it using the
-external program @uref{http://muttprint.sourceforge.net/,
-Muttprint}. The program name and options to use is controlled by the
-variable @code{gnus-summary-muttprint-program}.
-(@code{gnus-summary-muttprint}).
-
-@end table
-
-@vindex gnus-prompt-before-saving
-All these commands use the process/prefix convention
-(@pxref{Process/Prefix}). If you save bunches of articles using these
-functions, you might get tired of being prompted for files to save each
-and every article in. The prompting action is controlled by
-the @code{gnus-prompt-before-saving} variable, which is @code{always} by
-default, giving you that excessive prompting action you know and
-loathe. If you set this variable to @code{t} instead, you'll be prompted
-just once for each series of articles you save. If you like to really
-have Gnus do all your thinking for you, you can even set this variable
-to @code{nil}, which means that you will never be prompted for files to
-save articles in. Gnus will simply save all the articles in the default
-files.
-
-
-@vindex gnus-default-article-saver
-You can customize the @code{gnus-default-article-saver} variable to make
-Gnus do what you want it to. You can use any of the eight ready-made
-functions below, or you can create your own.
-
-@table @code
-
-@item gnus-summary-save-in-rmail
-@findex gnus-summary-save-in-rmail
-@vindex gnus-rmail-save-name
-@findex gnus-plain-save-name
-This is the default format, @dfn{Babyl}. Uses the function in the
-@code{gnus-rmail-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-plain-save-name}.
-
-@item gnus-summary-save-in-mail
-@findex gnus-summary-save-in-mail
-@vindex gnus-mail-save-name
-Save in a Unix mail (mbox) file. Uses the function in the
-@code{gnus-mail-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-plain-save-name}.
-
-@item gnus-summary-save-in-file
-@findex gnus-summary-save-in-file
-@vindex gnus-file-save-name
-@findex gnus-numeric-save-name
-Append the article straight to an ordinary file. Uses the function in
-the @code{gnus-file-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-numeric-save-name}.
-
-@item gnus-summary-write-to-file
-@findex gnus-summary-write-to-file
-Write the article straight to an ordinary file. The file is
-overwritten if it exists. Uses the function in the
-@code{gnus-file-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-numeric-save-name}.
-
-@item gnus-summary-save-body-in-file
-@findex gnus-summary-save-body-in-file
-Append the article body to an ordinary file. Uses the function in the
-@code{gnus-file-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-numeric-save-name}.
-
-@item gnus-summary-write-body-to-file
-@findex gnus-summary-write-body-to-file
-Write the article body straight to an ordinary file. The file is
-overwritten if it exists. Uses the function in the
-@code{gnus-file-save-name} variable to get a file name to save the
-article in. The default is @code{gnus-numeric-save-name}.
-
-@item gnus-summary-save-in-folder
-@findex gnus-summary-save-in-folder
-@findex gnus-folder-save-name
-@findex gnus-Folder-save-name
-@vindex gnus-folder-save-name
-@cindex rcvstore
-@cindex MH folders
-Save the article to an MH folder using @code{rcvstore} from the MH
-library. Uses the function in the @code{gnus-folder-save-name} variable
-to get a file name to save the article in. The default is
-@code{gnus-folder-save-name}, but you can also use
-@code{gnus-Folder-save-name}, which creates capitalized names.
-
-@item gnus-summary-save-in-vm
-@findex gnus-summary-save-in-vm
-Save the article in a VM folder. You have to have the VM mail
-reader to use this setting.
-@end table
-
-The symbol of each function may have the following properties:
-
-@table @code
-@item :decode
-The value non-@code{nil} means save decoded articles. This is
-meaningful only with @code{gnus-summary-save-in-file},
-@code{gnus-summary-save-body-in-file},
-@code{gnus-summary-write-to-file}, and
-@code{gnus-summary-write-body-to-file}.
-
-@item :function
-The value specifies an alternative function which appends, not
-overwrites, articles to a file. This implies that when saving many
-articles at a time, @code{gnus-prompt-before-saving} is bound to
-@code{t} and all articles are saved in a single file. This is
-meaningful only with @code{gnus-summary-write-to-file} and
-@code{gnus-summary-write-body-to-file}.
-
-@item :headers
-The value specifies the symbol of a variable of which the value
-specifies headers to be saved. If it is omitted,
-@code{gnus-save-all-headers} and @code{gnus-saved-headers} control what
-headers should be saved.
-@end table
-
-@vindex gnus-article-save-directory
-All of these functions, except for the last one, will save the article
-in the @code{gnus-article-save-directory}, which is initialized from the
-@env{SAVEDIR} environment variable. This is @file{~/News/} by
-default.
-
-As you can see above, the functions use different functions to find a
-suitable name of a file to save the article in. Below is a list of
-available functions that generate names:
-
-@table @code
-
-@item gnus-Numeric-save-name
-@findex gnus-Numeric-save-name
-File names like @file{~/News/Alt.andrea-dworkin/45}.
-
-@item gnus-numeric-save-name
-@findex gnus-numeric-save-name
-File names like @file{~/News/alt.andrea-dworkin/45}.
-
-@item gnus-Plain-save-name
-@findex gnus-Plain-save-name
-File names like @file{~/News/Alt.andrea-dworkin}.
-
-@item gnus-plain-save-name
-@findex gnus-plain-save-name
-File names like @file{~/News/alt.andrea-dworkin}.
-
-@item gnus-sender-save-name
-@findex gnus-sender-save-name
-File names like @file{~/News/larsi}.
-@end table
-
-@vindex gnus-split-methods
-You can have Gnus suggest where to save articles by plonking a regexp into
-the @code{gnus-split-methods} alist. For instance, if you would like to
-save articles related to Gnus in the file @file{gnus-stuff}, and articles
-related to VM in @file{vm-stuff}, you could set this variable to something
-like:
-
-@lisp
-(("^Subject:.*gnus\\|^Newsgroups:.*gnus" "gnus-stuff")
- ("^Subject:.*vm\\|^Xref:.*vm" "vm-stuff")
- (my-choosing-function "../other-dir/my-stuff")
- ((equal gnus-newsgroup-name "mail.misc") "mail-stuff"))
-@end lisp
-
-We see that this is a list where each element is a list that has two
-elements---the @dfn{match} and the @dfn{file}. The match can either be
-a string (in which case it is used as a regexp to match on the article
-head); it can be a symbol (which will be called as a function with the
-group name as a parameter); or it can be a list (which will be
-@code{eval}ed). If any of these actions have a non-@code{nil} result,
-the @dfn{file} will be used as a default prompt. In addition, the
-result of the operation itself will be used if the function or form
-called returns a string or a list of strings.
-
-You basically end up with a list of file names that might be used when
-saving the current article. (All ``matches'' will be used.) You will
-then be prompted for what you really want to use as a name, with file
-name completion over the results from applying this variable.
-
-This variable is @code{((gnus-article-archive-name))} by default, which
-means that Gnus will look at the articles it saves for an
-@code{Archive-name} line and use that as a suggestion for the file
-name.
-
-Here's an example function to clean up file names somewhat. If you have
-lots of mail groups called things like
-@samp{nnml:mail.whatever}, you may want to chop off the beginning of
-these group names before creating the file name to save to. The
-following will do just that:
-
-@lisp
-(defun my-save-name (group)
- (when (string-match "^nnml:mail." group)
- (substring group (match-end 0))))
-
-(setq gnus-split-methods
- '((gnus-article-archive-name)
- (my-save-name)))
-@end lisp
-
-
-@vindex gnus-use-long-file-name
-Finally, you have the @code{gnus-use-long-file-name} variable. If it is
-@code{nil}, all the preceding functions will replace all periods
-(@samp{.}) in the group names with slashes (@samp{/})---which means that
-the functions will generate hierarchies of directories instead of having
-all the files in the top level directory
-(@file{~/News/alt/andrea-dworkin} instead of
-@file{~/News/alt.andrea-dworkin}.) This variable is @code{t} by default
-on most systems. However, for historical reasons, this is @code{nil} on
-Xenix and usg-unix-v machines by default.
-
-This function also affects kill and score file names. If this variable
-is a list, and the list contains the element @code{not-score}, long file
-names will not be used for score files, if it contains the element
-@code{not-save}, long file names will not be used for saving, and if it
-contains the element @code{not-kill}, long file names will not be used
-for kill files.
-
-If you'd like to save articles in a hierarchy that looks something like
-a spool, you could
-
-@lisp
-(setq gnus-use-long-file-name '(not-save)) ; @r{to get a hierarchy}
-(setq gnus-default-article-saver
- 'gnus-summary-save-in-file) ; @r{no encoding}
-@end lisp
-
-Then just save with @kbd{o}. You'd then read this hierarchy with
-ephemeral @code{nneething} groups---@kbd{G D} in the group buffer, and
-the top level directory as the argument (@file{~/News/}). Then just walk
-around to the groups/directories with @code{nneething}.
-
-
-@node Decoding Articles
-@section Decoding Articles
-@cindex decoding articles
-
-Sometime users post articles (or series of articles) that have been
-encoded in some way or other. Gnus can decode them for you.
-
-@menu
-* Uuencoded Articles:: Uudecode articles.
-* Shell Archives:: Unshar articles.
-* PostScript Files:: Split PostScript.
-* Other Files:: Plain save and binhex.
-* Decoding Variables:: Variables for a happy decoding.
-* Viewing Files:: You want to look at the result of the decoding?
-@end menu
-
-@cindex series
-@cindex article series
-All these functions use the process/prefix convention
-(@pxref{Process/Prefix}) for finding out what articles to work on, with
-the extension that a ``single article'' means ``a single series''. Gnus
-can find out by itself what articles belong to a series, decode all the
-articles and unpack/view/save the resulting file(s).
-
-Gnus guesses what articles are in the series according to the following
-simplish rule: The subjects must be (nearly) identical, except for the
-last two numbers of the line. (Spaces are largely ignored, however.)
-
-For example: If you choose a subject called @samp{cat.gif (2/3)}, Gnus
-will find all the articles that match the regexp @samp{^cat.gif
-([0-9]+/[0-9]+).*$}.
-
-Subjects that are non-standard, like @samp{cat.gif (2/3) Part 6 of a
-series}, will not be properly recognized by any of the automatic viewing
-commands, and you have to mark the articles manually with @kbd{#}.
-
-
-@node Uuencoded Articles
-@subsection Uuencoded Articles
-@cindex uudecode
-@cindex uuencoded articles
-
-@table @kbd
-
-@item X u
-@kindex X u (Summary)
-@findex gnus-uu-decode-uu
-@c @icon{gnus-uu-decode-uu}
-Uudecodes the current series (@code{gnus-uu-decode-uu}).
-
-@item X U
-@kindex X U (Summary)
-@findex gnus-uu-decode-uu-and-save
-Uudecodes and saves the current series
-(@code{gnus-uu-decode-uu-and-save}).
-
-@item X v u
-@kindex X v u (Summary)
-@findex gnus-uu-decode-uu-view
-Uudecodes and views the current series (@code{gnus-uu-decode-uu-view}).
-
-@item X v U
-@kindex X v U (Summary)
-@findex gnus-uu-decode-uu-and-save-view
-Uudecodes, views and saves the current series
-(@code{gnus-uu-decode-uu-and-save-view}).
-
-@end table
-
-Remember that these all react to the presence of articles marked with
-the process mark. If, for instance, you'd like to decode and save an
-entire newsgroup, you'd typically do @kbd{M P a}
-(@code{gnus-uu-mark-all}) and then @kbd{X U}
-(@code{gnus-uu-decode-uu-and-save}).
-
-All this is very much different from how @code{gnus-uu} worked with
-@sc{gnus 4.1}, where you had explicit keystrokes for everything under
-the sun. This version of @code{gnus-uu} generally assumes that you mark
-articles in some way (@pxref{Setting Process Marks}) and then press
-@kbd{X u}.
-
-@vindex gnus-uu-notify-files
-Note: When trying to decode articles that have names matching
-@code{gnus-uu-notify-files}, which is hard-coded to
-@samp{[Cc][Ii][Nn][Dd][Yy][0-9]+.\\(gif\\|jpg\\)}, @code{gnus-uu} will
-automatically post an article on @samp{comp.unix.wizards} saying that
-you have just viewed the file in question. This feature can't be turned
-off.
-
-
-@node Shell Archives
-@subsection Shell Archives
-@cindex unshar
-@cindex shell archives
-@cindex shared articles
-
-Shell archives (``shar files'') used to be a popular way to distribute
-sources, but it isn't used all that much today. In any case, we have
-some commands to deal with these:
-
-@table @kbd
-
-@item X s
-@kindex X s (Summary)
-@findex gnus-uu-decode-unshar
-Unshars the current series (@code{gnus-uu-decode-unshar}).
-
-@item X S
-@kindex X S (Summary)
-@findex gnus-uu-decode-unshar-and-save
-Unshars and saves the current series (@code{gnus-uu-decode-unshar-and-save}).
-
-@item X v s
-@kindex X v s (Summary)
-@findex gnus-uu-decode-unshar-view
-Unshars and views the current series (@code{gnus-uu-decode-unshar-view}).
-
-@item X v S
-@kindex X v S (Summary)
-@findex gnus-uu-decode-unshar-and-save-view
-Unshars, views and saves the current series
-(@code{gnus-uu-decode-unshar-and-save-view}).
-@end table
-
-
-@node PostScript Files
-@subsection PostScript Files
-@cindex PostScript
-
-@table @kbd
-
-@item X p
-@kindex X p (Summary)
-@findex gnus-uu-decode-postscript
-Unpack the current PostScript series (@code{gnus-uu-decode-postscript}).
-
-@item X P
-@kindex X P (Summary)
-@findex gnus-uu-decode-postscript-and-save
-Unpack and save the current PostScript series
-(@code{gnus-uu-decode-postscript-and-save}).
-
-@item X v p
-@kindex X v p (Summary)
-@findex gnus-uu-decode-postscript-view
-View the current PostScript series
-(@code{gnus-uu-decode-postscript-view}).
-
-@item X v P
-@kindex X v P (Summary)
-@findex gnus-uu-decode-postscript-and-save-view
-View and save the current PostScript series
-(@code{gnus-uu-decode-postscript-and-save-view}).
-@end table
-
-
-@node Other Files
-@subsection Other Files
-
-@table @kbd
-@item X o
-@kindex X o (Summary)
-@findex gnus-uu-decode-save
-Save the current series
-(@code{gnus-uu-decode-save}).
-
-@item X b
-@kindex X b (Summary)
-@findex gnus-uu-decode-binhex
-Unbinhex the current series (@code{gnus-uu-decode-binhex}). This
-doesn't really work yet.
-@end table
-
-
-@node Decoding Variables
-@subsection Decoding Variables
-
-Adjective, not verb.
-
-@menu
-* Rule Variables:: Variables that say how a file is to be viewed.
-* Other Decode Variables:: Other decode variables.
-* Uuencoding and Posting:: Variables for customizing uuencoding.
-@end menu
-
-
-@node Rule Variables
-@subsubsection Rule Variables
-@cindex rule variables
-
-Gnus uses @dfn{rule variables} to decide how to view a file. All these
-variables are of the form
-
-@lisp
- (list '(regexp1 command2)
- '(regexp2 command2)
- ...)
-@end lisp
-
-@table @code
-
-@item gnus-uu-user-view-rules
-@vindex gnus-uu-user-view-rules
-@cindex sox
-This variable is consulted first when viewing files. If you wish to use,
-for instance, @code{sox} to convert an @file{.au} sound file, you could
-say something like:
-@lisp
-(setq gnus-uu-user-view-rules
- (list '("\\\\.au$" "sox %s -t .aiff > /dev/audio")))
-@end lisp
-
-@item gnus-uu-user-view-rules-end
-@vindex gnus-uu-user-view-rules-end
-This variable is consulted if Gnus couldn't make any matches from the
-user and default view rules.
-
-@item gnus-uu-user-archive-rules
-@vindex gnus-uu-user-archive-rules
-This variable can be used to say what commands should be used to unpack
-archives.
-@end table
-
-
-@node Other Decode Variables
-@subsubsection Other Decode Variables
-
-@table @code
-@vindex gnus-uu-grabbed-file-functions
-
-@item gnus-uu-grabbed-file-functions
-All functions in this list will be called right after each file has been
-successfully decoded---so that you can move or view files right away,
-and don't have to wait for all files to be decoded before you can do
-anything. Ready-made functions you can put in this list are:
-
-@table @code
-
-@item gnus-uu-grab-view
-@findex gnus-uu-grab-view
-View the file.
-
-@item gnus-uu-grab-move
-@findex gnus-uu-grab-move
-Move the file (if you're using a saving function.)
-@end table
-
-@item gnus-uu-be-dangerous
-@vindex gnus-uu-be-dangerous
-Specifies what to do if unusual situations arise during decoding. If
-@code{nil}, be as conservative as possible. If @code{t}, ignore things
-that didn't work, and overwrite existing files. Otherwise, ask each
-time.
-
-@item gnus-uu-ignore-files-by-name
-@vindex gnus-uu-ignore-files-by-name
-Files with name matching this regular expression won't be viewed.
-
-@item gnus-uu-ignore-files-by-type
-@vindex gnus-uu-ignore-files-by-type
-Files with a @acronym{MIME} type matching this variable won't be viewed.
-Note that Gnus tries to guess what type the file is based on the name.
-@code{gnus-uu} is not a @acronym{MIME} package (yet), so this is slightly
-kludgey.
-
-@item gnus-uu-tmp-dir
-@vindex gnus-uu-tmp-dir
-Where @code{gnus-uu} does its work.
-
-@item gnus-uu-do-not-unpack-archives
-@vindex gnus-uu-do-not-unpack-archives
-Non-@code{nil} means that @code{gnus-uu} won't peek inside archives
-looking for files to display.
-
-@item gnus-uu-view-and-save
-@vindex gnus-uu-view-and-save
-Non-@code{nil} means that the user will always be asked to save a file
-after viewing it.
-
-@item gnus-uu-ignore-default-view-rules
-@vindex gnus-uu-ignore-default-view-rules
-Non-@code{nil} means that @code{gnus-uu} will ignore the default viewing
-rules.
-
-@item gnus-uu-ignore-default-archive-rules
-@vindex gnus-uu-ignore-default-archive-rules
-Non-@code{nil} means that @code{gnus-uu} will ignore the default archive
-unpacking commands.
-
-@item gnus-uu-kill-carriage-return
-@vindex gnus-uu-kill-carriage-return
-Non-@code{nil} means that @code{gnus-uu} will strip all carriage returns
-from articles.
-
-@item gnus-uu-unmark-articles-not-decoded
-@vindex gnus-uu-unmark-articles-not-decoded
-Non-@code{nil} means that @code{gnus-uu} will mark unsuccessfully
-decoded articles as unread.
-
-@item gnus-uu-correct-stripped-uucode
-@vindex gnus-uu-correct-stripped-uucode
-Non-@code{nil} means that @code{gnus-uu} will @emph{try} to fix
-uuencoded files that have had trailing spaces deleted.
-
-@item gnus-uu-pre-uudecode-hook
-@vindex gnus-uu-pre-uudecode-hook
-Hook run before sending a message to @code{uudecode}.
-
-@item gnus-uu-view-with-metamail
-@vindex gnus-uu-view-with-metamail
-@cindex metamail
-Non-@code{nil} means that @code{gnus-uu} will ignore the viewing
-commands defined by the rule variables and just fudge a @acronym{MIME}
-content type based on the file name. The result will be fed to
-@code{metamail} for viewing.
-
-@item gnus-uu-save-in-digest
-@vindex gnus-uu-save-in-digest
-Non-@code{nil} means that @code{gnus-uu}, when asked to save without
-decoding, will save in digests. If this variable is @code{nil},
-@code{gnus-uu} will just save everything in a file without any
-embellishments. The digesting almost conforms to RFC 1153---no easy way
-to specify any meaningful volume and issue numbers were found, so I
-simply dropped them.
-
-@end table
-
-
-@node Uuencoding and Posting
-@subsubsection Uuencoding and Posting
-
-@table @code
-
-@item gnus-uu-post-include-before-composing
-@vindex gnus-uu-post-include-before-composing
-Non-@code{nil} means that @code{gnus-uu} will ask for a file to encode
-before you compose the article. If this variable is @code{t}, you can
-either include an encoded file with @kbd{C-c C-i} or have one included
-for you when you post the article.
-
-@item gnus-uu-post-length
-@vindex gnus-uu-post-length
-Maximum length of an article. The encoded file will be split into how
-many articles it takes to post the entire file.
-
-@item gnus-uu-post-threaded
-@vindex gnus-uu-post-threaded
-Non-@code{nil} means that @code{gnus-uu} will post the encoded file in a
-thread. This may not be smart, as no other decoder I have seen is able
-to follow threads when collecting uuencoded articles. (Well, I have
-seen one package that does that---@code{gnus-uu}, but somehow, I don't
-think that counts@dots{}) Default is @code{nil}.
-
-@item gnus-uu-post-separate-description
-@vindex gnus-uu-post-separate-description
-Non-@code{nil} means that the description will be posted in a separate
-article. The first article will typically be numbered (0/x). If this
-variable is @code{nil}, the description the user enters will be included
-at the beginning of the first article, which will be numbered (1/x).
-Default is @code{t}.
-
-@end table
-
-
-@node Viewing Files
-@subsection Viewing Files
-@cindex viewing files
-@cindex pseudo-articles
-
-After decoding, if the file is some sort of archive, Gnus will attempt
-to unpack the archive and see if any of the files in the archive can be
-viewed. For instance, if you have a gzipped tar file @file{pics.tar.gz}
-containing the files @file{pic1.jpg} and @file{pic2.gif}, Gnus will
-uncompress and de-tar the main file, and then view the two pictures.
-This unpacking process is recursive, so if the archive contains archives
-of archives, it'll all be unpacked.
-
-Finally, Gnus will normally insert a @dfn{pseudo-article} for each
-extracted file into the summary buffer. If you go to these
-``articles'', you will be prompted for a command to run (usually Gnus
-will make a suggestion), and then the command will be run.
-
-@vindex gnus-view-pseudo-asynchronously
-If @code{gnus-view-pseudo-asynchronously} is @code{nil}, Emacs will wait
-until the viewing is done before proceeding.
-
-@vindex gnus-view-pseudos
-If @code{gnus-view-pseudos} is @code{automatic}, Gnus will not insert
-the pseudo-articles into the summary buffer, but view them
-immediately. If this variable is @code{not-confirm}, the user won't even
-be asked for a confirmation before viewing is done.
-
-@vindex gnus-view-pseudos-separately
-If @code{gnus-view-pseudos-separately} is non-@code{nil}, one
-pseudo-article will be created for each file to be viewed. If
-@code{nil}, all files that use the same viewing command will be given as
-a list of parameters to that command.
-
-@vindex gnus-insert-pseudo-articles
-If @code{gnus-insert-pseudo-articles} is non-@code{nil}, insert
-pseudo-articles when decoding. It is @code{t} by default.
-
-So; there you are, reading your @emph{pseudo-articles} in your
-@emph{virtual newsgroup} from the @emph{virtual server}; and you think:
-Why isn't anything real anymore? How did we get here?
-
-
-@node Article Treatment
-@section Article Treatment
-
-Reading through this huge manual, you may have quite forgotten that the
-object of newsreaders is to actually, like, read what people have
-written. Reading articles. Unfortunately, people are quite bad at
-writing, so there are tons of functions and variables to make reading
-these articles easier.
-
-@menu
-* Article Highlighting:: You want to make the article look like fruit salad.
-* Article Fontisizing:: Making emphasized text look nice.
-* Article Hiding:: You also want to make certain info go away.
-* Article Washing:: Lots of way-neat functions to make life better.
-* Article Header:: Doing various header transformations.
-* Article Buttons:: Click on URLs, Message-IDs, addresses and the like.
-* Article Button Levels:: Controlling appearance of buttons.
-* Article Date:: Grumble, UT!
-* Article Display:: Display various stuff---X-Face, Picons, Smileys
-* Article Signature:: What is a signature?
-* Article Miscellanea:: Various other stuff.
-@end menu
-
-
-@node Article Highlighting
-@subsection Article Highlighting
-@cindex highlighting
-
-Not only do you want your article buffer to look like fruit salad, but
-you want it to look like technicolor fruit salad.
-
-@table @kbd
-
-@item W H a
-@kindex W H a (Summary)
-@findex gnus-article-highlight
-@findex gnus-article-maybe-highlight
-Do much highlighting of the current article
-(@code{gnus-article-highlight}). This function highlights header, cited
-text, the signature, and adds buttons to the body and the head.
-
-@item W H h
-@kindex W H h (Summary)
-@findex gnus-article-highlight-headers
-@vindex gnus-header-face-alist
-Highlight the headers (@code{gnus-article-highlight-headers}). The
-highlighting will be done according to the @code{gnus-header-face-alist}
-variable, which is a list where each element has the form
-@code{(@var{regexp} @var{name} @var{content})}.
-@var{regexp} is a regular expression for matching the
-header, @var{name} is the face used for highlighting the header name
-(@pxref{Faces and Fonts}) and @var{content} is the face for highlighting
-the header value. The first match made will be used. Note that
-@var{regexp} shouldn't have @samp{^} prepended---Gnus will add one.
-
-@item W H c
-@kindex W H c (Summary)
-@findex gnus-article-highlight-citation
-Highlight cited text (@code{gnus-article-highlight-citation}).
-
-Some variables to customize the citation highlights:
-
-@table @code
-@vindex gnus-cite-parse-max-size
-
-@item gnus-cite-parse-max-size
-If the article size in bytes is bigger than this variable (which is
-25000 by default), no citation highlighting will be performed.
-
-@item gnus-cite-max-prefix
-@vindex gnus-cite-max-prefix
-Maximum possible length for a citation prefix (default 20).
-
-@item gnus-cite-face-list
-@vindex gnus-cite-face-list
-List of faces used for highlighting citations (@pxref{Faces and Fonts}).
-When there are citations from multiple articles in the same message,
-Gnus will try to give each citation from each article its own face.
-This should make it easier to see who wrote what.
-
-@item gnus-supercite-regexp
-@vindex gnus-supercite-regexp
-Regexp matching normal Supercite attribution lines.
-
-@item gnus-supercite-secondary-regexp
-@vindex gnus-supercite-secondary-regexp
-Regexp matching mangled Supercite attribution lines.
-
-@item gnus-cite-minimum-match-count
-@vindex gnus-cite-minimum-match-count
-Minimum number of identical prefixes we have to see before we believe
-that it's a citation.
-
-@item gnus-cite-attribution-prefix
-@vindex gnus-cite-attribution-prefix
-Regexp matching the beginning of an attribution line.
-
-@item gnus-cite-attribution-suffix
-@vindex gnus-cite-attribution-suffix
-Regexp matching the end of an attribution line.
-
-@item gnus-cite-attribution-face
-@vindex gnus-cite-attribution-face
-Face used for attribution lines. It is merged with the face for the
-cited text belonging to the attribution.
-
-@item gnus-cite-ignore-quoted-from
-@vindex gnus-cite-ignore-quoted-from
-If non-@code{nil}, no citation highlighting will be performed on lines
-beginning with @samp{>From }. Those lines may have been quoted by MTAs
-in order not to mix up with the envelope From line. The default value
-is @code{t}.
-
-@end table
-
-
-@item W H s
-@kindex W H s (Summary)
-@vindex gnus-signature-separator
-@vindex gnus-signature-face
-@findex gnus-article-highlight-signature
-Highlight the signature (@code{gnus-article-highlight-signature}).
-Everything after @code{gnus-signature-separator} (@pxref{Article
-Signature}) in an article will be considered a signature and will be
-highlighted with @code{gnus-signature-face}, which is @code{italic} by
-default.
-
-@end table
-
-@xref{Customizing Articles}, for how to highlight articles automatically.
-
-
-@node Article Fontisizing
-@subsection Article Fontisizing
-@cindex emphasis
-@cindex article emphasis
-
-@findex gnus-article-emphasize
-@kindex W e (Summary)
-People commonly add emphasis to words in news articles by writing things
-like @samp{_this_} or @samp{*this*} or @samp{/this/}. Gnus can make
-this look nicer by running the article through the @kbd{W e}
-(@code{gnus-article-emphasize}) command.
-
-@vindex gnus-emphasis-alist
-How the emphasis is computed is controlled by the
-@code{gnus-emphasis-alist} variable. This is an alist where the first
-element is a regular expression to be matched. The second is a number
-that says what regular expression grouping is used to find the entire
-emphasized word. The third is a number that says what regexp grouping
-should be displayed and highlighted. (The text between these two
-groupings will be hidden.) The fourth is the face used for
-highlighting.
-
-@lisp
-(setq gnus-emphasis-alist
- '(("_\\(\\w+\\)_" 0 1 gnus-emphasis-underline)
- ("\\*\\(\\w+\\)\\*" 0 1 gnus-emphasis-bold)))
-@end lisp
-
-@cindex slash
-@cindex asterisk
-@cindex underline
-@cindex /
-@cindex *
-
-@vindex gnus-emphasis-underline
-@vindex gnus-emphasis-bold
-@vindex gnus-emphasis-italic
-@vindex gnus-emphasis-underline-bold
-@vindex gnus-emphasis-underline-italic
-@vindex gnus-emphasis-bold-italic
-@vindex gnus-emphasis-underline-bold-italic
-By default, there are seven rules, and they use the following faces:
-@code{gnus-emphasis-bold}, @code{gnus-emphasis-italic},
-@code{gnus-emphasis-underline}, @code{gnus-emphasis-bold-italic},
-@code{gnus-emphasis-underline-italic},
-@code{gnus-emphasis-underline-bold}, and
-@code{gnus-emphasis-underline-bold-italic}.
-
-If you want to change these faces, you can either use @kbd{M-x
-customize}, or you can use @code{copy-face}. For instance, if you want
-to make @code{gnus-emphasis-italic} use a red face instead, you could
-say something like:
-
-@lisp
-(copy-face 'red 'gnus-emphasis-italic)
-@end lisp
-
-@vindex gnus-group-highlight-words-alist
-
-If you want to highlight arbitrary words, you can use the
-@code{gnus-group-highlight-words-alist} variable, which uses the same
-syntax as @code{gnus-emphasis-alist}. The @code{highlight-words} group
-parameter (@pxref{Group Parameters}) can also be used.
-
-@xref{Customizing Articles}, for how to fontize articles automatically.
-
-
-@node Article Hiding
-@subsection Article Hiding
-@cindex article hiding
-
-Or rather, hiding certain things in each article. There usually is much
-too much cruft in most articles.
-
-@table @kbd
-
-@item W W a
-@kindex W W a (Summary)
-@findex gnus-article-hide
-Do quite a lot of hiding on the article buffer
-(@kbd{gnus-article-hide}). In particular, this function will hide
-headers, @acronym{PGP}, cited text and the signature.
-
-@item W W h
-@kindex W W h (Summary)
-@findex gnus-article-hide-headers
-Hide headers (@code{gnus-article-hide-headers}). @xref{Hiding
-Headers}.
-
-@item W W b
-@kindex W W b (Summary)
-@findex gnus-article-hide-boring-headers
-Hide headers that aren't particularly interesting
-(@code{gnus-article-hide-boring-headers}). @xref{Hiding Headers}.
-
-@item W W s
-@kindex W W s (Summary)
-@findex gnus-article-hide-signature
-Hide signature (@code{gnus-article-hide-signature}). @xref{Article
-Signature}.
-
-@item W W l
-@kindex W W l (Summary)
-@findex gnus-article-hide-list-identifiers
-@vindex gnus-list-identifiers
-Strip list identifiers specified in @code{gnus-list-identifiers}. These
-are strings some mailing list servers add to the beginning of all
-@code{Subject} headers---for example, @samp{[zebra 4711]}. Any leading
-@samp{Re: } is skipped before stripping. @code{gnus-list-identifiers}
-may not contain @code{\\(..\\)}.
-
-@table @code
-
-@item gnus-list-identifiers
-@vindex gnus-list-identifiers
-A regular expression that matches list identifiers to be removed from
-subject. This can also be a list of regular expressions.
-
-@end table
-
-@item W W P
-@kindex W W P (Summary)
-@findex gnus-article-hide-pem
-Hide @acronym{PEM} (privacy enhanced messages) cruft
-(@code{gnus-article-hide-pem}).
-
-@item W W B
-@kindex W W B (Summary)
-@findex gnus-article-strip-banner
-@vindex gnus-article-banner-alist
-@vindex gnus-article-address-banner-alist
-@cindex banner
-@cindex OneList
-@cindex stripping advertisements
-@cindex advertisements
-Strip the banner specified by the @code{banner} group parameter
-(@code{gnus-article-strip-banner}). This is mainly used to hide those
-annoying banners and/or signatures that some mailing lists and moderated
-groups adds to all the messages. The way to use this function is to add
-the @code{banner} group parameter (@pxref{Group Parameters}) to the
-group you want banners stripped from. The parameter either be a string,
-which will be interpreted as a regular expression matching text to be
-removed, or the symbol @code{signature}, meaning that the (last)
-signature should be removed, or other symbol, meaning that the
-corresponding regular expression in @code{gnus-article-banner-alist} is
-used.
-
-Regardless of a group, you can hide things like advertisements only when
-the sender of an article has a certain mail address specified in
-@code{gnus-article-address-banner-alist}.
-
-@table @code
-
-@item gnus-article-address-banner-alist
-@vindex gnus-article-address-banner-alist
-Alist of mail addresses and banners. Each element has the form
-@code{(@var{address} . @var{banner})}, where @var{address} is a regexp
-matching a mail address in the From header, @var{banner} is one of a
-symbol @code{signature}, an item in @code{gnus-article-banner-alist},
-a regexp and @code{nil}. If @var{address} matches author's mail
-address, it will remove things like advertisements. For example, if a
-sender has the mail address @samp{hail@@yoo-hoo.co.jp} and there is a
-banner something like @samp{Do You Yoo-hoo!?} in all articles he
-sends, you can use the following element to remove them:
-
-@lisp
-("@@yoo-hoo\\.co\\.jp\\'" .
- "\n_+\nDo You Yoo-hoo!\\?\n.*\n.*\n")
-@end lisp
-
-@end table
-
-@item W W c
-@kindex W W c (Summary)
-@findex gnus-article-hide-citation
-Hide citation (@code{gnus-article-hide-citation}). Some variables for
-customizing the hiding:
-
-@table @code
-
-@item gnus-cited-opened-text-button-line-format
-@itemx gnus-cited-closed-text-button-line-format
-@vindex gnus-cited-closed-text-button-line-format
-@vindex gnus-cited-opened-text-button-line-format
-Gnus adds buttons to show where the cited text has been hidden, and to
-allow toggle hiding the text. The format of the variable is specified
-by these format-like variable (@pxref{Formatting Variables}). These
-specs are valid:
-
-@table @samp
-@item b
-Starting point of the hidden text.
-@item e
-Ending point of the hidden text.
-@item l
-Number of characters in the hidden region.
-@item n
-Number of lines of hidden text.
-@end table
-
-@item gnus-cited-lines-visible
-@vindex gnus-cited-lines-visible
-The number of lines at the beginning of the cited text to leave
-shown. This can also be a cons cell with the number of lines at the top
-and bottom of the text, respectively, to remain visible.
-
-@end table
-
-@item W W C-c
-@kindex W W C-c (Summary)
-@findex gnus-article-hide-citation-maybe
-
-Hide citation (@code{gnus-article-hide-citation-maybe}) depending on the
-following two variables:
-
-@table @code
-@item gnus-cite-hide-percentage
-@vindex gnus-cite-hide-percentage
-If the cited text is of a bigger percentage than this variable (default
-50), hide the cited text.
-
-@item gnus-cite-hide-absolute
-@vindex gnus-cite-hide-absolute
-The cited text must have at least this length (default 10) before it
-is hidden.
-@end table
-
-@item W W C
-@kindex W W C (Summary)
-@findex gnus-article-hide-citation-in-followups
-Hide cited text in articles that aren't roots
-(@code{gnus-article-hide-citation-in-followups}). This isn't very
-useful as an interactive command, but might be a handy function to stick
-have happen automatically (@pxref{Customizing Articles}).
-
-@end table
-
-All these ``hiding'' commands are toggles, but if you give a negative
-prefix to these commands, they will show what they have previously
-hidden. If you give a positive prefix, they will always hide.
-
-Also @pxref{Article Highlighting} for further variables for
-citation customization.
-
-@xref{Customizing Articles}, for how to hide article elements
-automatically.
-
-
-@node Article Washing
-@subsection Article Washing
-@cindex washing
-@cindex article washing
-
-We call this ``article washing'' for a really good reason. Namely, the
-@kbd{A} key was taken, so we had to use the @kbd{W} key instead.
-
-@dfn{Washing} is defined by us as ``changing something from something to
-something else'', but normally results in something looking better.
-Cleaner, perhaps.
-
-@xref{Customizing Articles}, if you want to change how Gnus displays
-articles by default.
-
-@table @kbd
-
-@item C-u g
-This is not really washing, it's sort of the opposite of washing. If
-you type this, you see the article exactly as it exists on disk or on
-the server.
-
-@item g
-Force redisplaying of the current article
-(@code{gnus-summary-show-article}). This is also not really washing.
-If you type this, you see the article without any previously applied
-interactive Washing functions but with all default treatments
-(@pxref{Customizing Articles}).
-
-@item W l
-@kindex W l (Summary)
-@findex gnus-summary-stop-page-breaking
-Remove page breaks from the current article
-(@code{gnus-summary-stop-page-breaking}). @xref{Misc Article}, for page
-delimiters.
-
-@item W r
-@kindex W r (Summary)
-@findex gnus-summary-caesar-message
-@c @icon{gnus-summary-caesar-message}
-Do a Caesar rotate (rot13) on the article buffer
-(@code{gnus-summary-caesar-message}).
-Unreadable articles that tell you to read them with Caesar rotate or rot13.
-(Typically offensive jokes and such.)
-
-It's commonly called ``rot13'' because each letter is rotated 13
-positions in the alphabet, e. g. @samp{B} (letter #2) -> @samp{O} (letter
-#15). It is sometimes referred to as ``Caesar rotate'' because Caesar
-is rumored to have employed this form of, uh, somewhat weak encryption.
-
-@item W m
-@kindex W m (Summary)
-@findex gnus-summary-morse-message
-Morse decode the article buffer (@code{gnus-summary-morse-message}).
-
-@item W t
-@item t
-@kindex W t (Summary)
-@kindex t (Summary)
-@findex gnus-summary-toggle-header
-Toggle whether to display all headers in the article buffer
-(@code{gnus-summary-toggle-header}).
-
-@item W v
-@kindex W v (Summary)
-@findex gnus-summary-verbose-headers
-Toggle whether to display all headers in the article buffer permanently
-(@code{gnus-summary-verbose-headers}).
-
-@item W o
-@kindex W o (Summary)
-@findex gnus-article-treat-overstrike
-Treat overstrike (@code{gnus-article-treat-overstrike}).
-
-@item W d
-@kindex W d (Summary)
-@findex gnus-article-treat-dumbquotes
-@vindex gnus-article-dumbquotes-map
-@cindex Smartquotes
-@cindex M****s*** sm*rtq**t*s
-@cindex Latin 1
-Treat M****s*** sm*rtq**t*s according to
-@code{gnus-article-dumbquotes-map}
-(@code{gnus-article-treat-dumbquotes}). Note that this function guesses
-whether a character is a sm*rtq**t* or not, so it should only be used
-interactively.
-
-Sm*rtq**t*s are M****s***'s unilateral extension to the character map in
-an attempt to provide more quoting characters. If you see something
-like @code{\222} or @code{\264} where you're expecting some kind of
-apostrophe or quotation mark, then try this wash.
-
-@item W Y f
-@kindex W Y f (Summary)
-@findex gnus-article-outlook-deuglify-article
-@cindex Outlook Express
-Full deuglify of broken Outlook (Express) articles: Treat dumbquotes,
-unwrap lines, repair attribution and rearrange citation.
-(@code{gnus-article-outlook-deuglify-article}).
-
-@item W Y u
-@kindex W Y u (Summary)
-@findex gnus-article-outlook-unwrap-lines
-@vindex gnus-outlook-deuglify-unwrap-min
-@vindex gnus-outlook-deuglify-unwrap-max
-Unwrap lines that appear to be wrapped citation lines. You can control
-what lines will be unwrapped by frobbing
-@code{gnus-outlook-deuglify-unwrap-min} and
-@code{gnus-outlook-deuglify-unwrap-max}, indicating the minimum and
-maximum length of an unwrapped citation line.
-(@code{gnus-article-outlook-unwrap-lines}).
-
-@item W Y a
-@kindex W Y a (Summary)
-@findex gnus-article-outlook-repair-attribution
-Repair a broken attribution line.@*
-(@code{gnus-article-outlook-repair-attribution}).
-
-@item W Y c
-@kindex W Y c (Summary)
-@findex gnus-article-outlook-rearrange-citation
-Repair broken citations by rearranging the text.
-(@code{gnus-article-outlook-rearrange-citation}).
-
-@item W w
-@kindex W w (Summary)
-@findex gnus-article-fill-cited-article
-Do word wrap (@code{gnus-article-fill-cited-article}).
-
-You can give the command a numerical prefix to specify the width to use
-when filling.
-
-@item W Q
-@kindex W Q (Summary)
-@findex gnus-article-fill-long-lines
-Fill long lines (@code{gnus-article-fill-long-lines}).
-
-@item W C
-@kindex W C (Summary)
-@findex gnus-article-capitalize-sentences
-Capitalize the first word in each sentence
-(@code{gnus-article-capitalize-sentences}).
-
-@item W c
-@kindex W c (Summary)
-@findex gnus-article-remove-cr
-Translate CRLF pairs (i. e., @samp{^M}s on the end of the lines) into LF
-(this takes care of DOS line endings), and then translate any remaining
-CRs into LF (this takes care of Mac line endings)
-(@code{gnus-article-remove-cr}).
-
-@item W q
-@kindex W q (Summary)
-@findex gnus-article-de-quoted-unreadable
-Treat quoted-printable (@code{gnus-article-de-quoted-unreadable}).
-Quoted-Printable is one common @acronym{MIME} encoding employed when
-sending non-@acronym{ASCII} (i.e., 8-bit) articles. It typically
-makes strings like @samp{déjà vu} look like @samp{d=E9j=E0 vu}, which
-doesn't look very readable to me. Note that this is usually done
-automatically by Gnus if the message in question has a
-@code{Content-Transfer-Encoding} header that says that this encoding
-has been done. If a prefix is given, a charset will be asked for.
-
-@item W 6
-@kindex W 6 (Summary)
-@findex gnus-article-de-base64-unreadable
-Treat base64 (@code{gnus-article-de-base64-unreadable}). Base64 is
-one common @acronym{MIME} encoding employed when sending
-non-@acronym{ASCII} (i.e., 8-bit) articles. Note that this is
-usually done automatically by Gnus if the message in question has a
-@code{Content-Transfer-Encoding} header that says that this encoding
-has been done. If a prefix is given, a charset will be asked for.
-
-@item W Z
-@kindex W Z (Summary)
-@findex gnus-article-decode-HZ
-Treat HZ or HZP (@code{gnus-article-decode-HZ}). HZ (or HZP) is one
-common encoding employed when sending Chinese articles. It typically
-makes strings look like @samp{~@{<:Ky2;S@{#,NpJ)l6HK!#~@}}.
-
-@item W u
-@kindex W u (Summary)
-@findex gnus-article-unsplit-urls
-Remove newlines from within URLs. Some mailers insert newlines into
-outgoing email messages to keep lines short. This reformatting can
-split long URLs onto multiple lines. Repair those URLs by removing
-the newlines (@code{gnus-article-unsplit-urls}).
-
-@item W h
-@kindex W h (Summary)
-@findex gnus-article-wash-html
-Treat @acronym{HTML} (@code{gnus-article-wash-html}). Note that this is
-usually done automatically by Gnus if the message in question has a
-@code{Content-Type} header that says that the message is @acronym{HTML}.
-
-If a prefix is given, a charset will be asked for. If it is a number,
-the charset defined in @code{gnus-summary-show-article-charset-alist}
-(@pxref{Paging the Article}) will be used.
-
-@vindex gnus-article-wash-function
-The default is to use the function specified by
-@code{mm-text-html-renderer} (@pxref{Display Customization, ,Display
-Customization, emacs-mime, The Emacs MIME Manual}) to convert the
-@acronym{HTML}, but this is controlled by the
-@code{gnus-article-wash-function} variable. Pre-defined functions you
-can use include:
-
-@table @code
-@item w3
-Use Emacs/W3.
-
-@item w3m
-Use @uref{http://emacs-w3m.namazu.org/, emacs-w3m}.
-
-@item w3m-standalone
-Use @uref{http://w3m.sourceforge.net/, w3m}.
-
-@item links
-Use @uref{http://links.sf.net/, Links}.
-
-@item lynx
-Use @uref{http://lynx.isc.org/, Lynx}.
-
-@item html2text
-Use html2text---a simple @acronym{HTML} converter included with Gnus.
-
-@end table
-
-@item W b
-@kindex W b (Summary)
-@findex gnus-article-add-buttons
-Add clickable buttons to the article (@code{gnus-article-add-buttons}).
-@xref{Article Buttons}.
-
-@item W B
-@kindex W B (Summary)
-@findex gnus-article-add-buttons-to-head
-Add clickable buttons to the article headers
-(@code{gnus-article-add-buttons-to-head}).
-
-@item W p
-@kindex W p (Summary)
-@findex gnus-article-verify-x-pgp-sig
-Verify a signed control message
-(@code{gnus-article-verify-x-pgp-sig}). Control messages such as
-@code{newgroup} and @code{checkgroups} are usually signed by the
-hierarchy maintainer. You need to add the @acronym{PGP} public key of
-the maintainer to your keyring to verify the
-message.@footnote{@acronym{PGP} keys for many hierarchies are
-available at @uref{ftp://ftp.isc.org/pub/pgpcontrol/README.html}}
-
-@item W s
-@kindex W s (Summary)
-@findex gnus-summary-force-verify-and-decrypt
-Verify a signed (@acronym{PGP}, @acronym{PGP/MIME} or
-@acronym{S/MIME}) message
-(@code{gnus-summary-force-verify-and-decrypt}). @xref{Security}.
-
-@item W a
-@kindex W a (Summary)
-@findex gnus-article-strip-headers-in-body
-Strip headers like the @code{X-No-Archive} header from the beginning of
-article bodies (@code{gnus-article-strip-headers-in-body}).
-
-@item W E l
-@kindex W E l (Summary)
-@findex gnus-article-strip-leading-blank-lines
-Remove all blank lines from the beginning of the article
-(@code{gnus-article-strip-leading-blank-lines}).
-
-@item W E m
-@kindex W E m (Summary)
-@findex gnus-article-strip-multiple-blank-lines
-Replace all blank lines with empty lines and then all multiple empty
-lines with a single empty line.
-(@code{gnus-article-strip-multiple-blank-lines}).
-
-@item W E t
-@kindex W E t (Summary)
-@findex gnus-article-remove-trailing-blank-lines
-Remove all blank lines at the end of the article
-(@code{gnus-article-remove-trailing-blank-lines}).
-
-@item W E a
-@kindex W E a (Summary)
-@findex gnus-article-strip-blank-lines
-Do all the three commands above
-(@code{gnus-article-strip-blank-lines}).
-
-@item W E A
-@kindex W E A (Summary)
-@findex gnus-article-strip-all-blank-lines
-Remove all blank lines
-(@code{gnus-article-strip-all-blank-lines}).
-
-@item W E s
-@kindex W E s (Summary)
-@findex gnus-article-strip-leading-space
-Remove all white space from the beginning of all lines of the article
-body (@code{gnus-article-strip-leading-space}).
-
-@item W E e
-@kindex W E e (Summary)
-@findex gnus-article-strip-trailing-space
-Remove all white space from the end of all lines of the article
-body (@code{gnus-article-strip-trailing-space}).
-
-@end table
-
-@xref{Customizing Articles}, for how to wash articles automatically.
-
-
-@node Article Header
-@subsection Article Header
-
-These commands perform various transformations of article header.
-
-@table @kbd
-
-@item W G u
-@kindex W G u (Summary)
-@findex gnus-article-treat-unfold-headers
-Unfold folded header lines (@code{gnus-article-treat-unfold-headers}).
-
-@item W G n
-@kindex W G n (Summary)
-@findex gnus-article-treat-fold-newsgroups
-Fold the @code{Newsgroups} and @code{Followup-To} headers
-(@code{gnus-article-treat-fold-newsgroups}).
-
-@item W G f
-@kindex W G f (Summary)
-@findex gnus-article-treat-fold-headers
-Fold all the message headers
-(@code{gnus-article-treat-fold-headers}).
-
-@item W E w
-@kindex W E w (Summary)
-@findex gnus-article-remove-leading-whitespace
-Remove excessive whitespace from all headers
-(@code{gnus-article-remove-leading-whitespace}).
-
-@end table
-
-
-@node Article Buttons
-@subsection Article Buttons
-@cindex buttons
-
-People often include references to other stuff in articles, and it would
-be nice if Gnus could just fetch whatever it is that people talk about
-with the minimum of fuzz when you hit @kbd{RET} or use the middle mouse
-button on these references.
-
-@vindex gnus-button-man-handler
-Gnus adds @dfn{buttons} to certain standard references by default:
-Well-formed URLs, mail addresses, Message-IDs, Info links, man pages and
-Emacs or Gnus related references. This is controlled by two variables,
-one that handles article bodies and one that handles article heads:
-
-@table @code
-
-@item gnus-button-alist
-@vindex gnus-button-alist
-This is an alist where each entry has this form:
-
-@lisp
-(@var{regexp} @var{button-par} @var{use-p} @var{function} @var{data-par})
-@end lisp
-
-@table @var
-
-@item regexp
-All text that match this regular expression (case insensitive) will be
-considered an external reference. Here's a typical regexp that matches
-embedded URLs: @samp{<URL:\\([^\n\r>]*\\)>}. This can also be a
-variable containing a regexp, useful variables to use include
-@code{gnus-button-url-regexp} and @code{gnus-button-mid-or-mail-regexp}.
-
-@item button-par
-Gnus has to know which parts of the matches is to be highlighted. This
-is a number that says what sub-expression of the regexp is to be
-highlighted. If you want it all highlighted, you use 0 here.
-
-@item use-p
-This form will be @code{eval}ed, and if the result is non-@code{nil},
-this is considered a match. This is useful if you want extra sifting to
-avoid false matches. Often variables named
-@code{gnus-button-@var{*}-level} are used here, @xref{Article Button
-Levels}, but any other form may be used too.
-
-@c @code{use-p} is @code{eval}ed only if @code{regexp} matches.
-
-@item function
-This function will be called when you click on this button.
-
-@item data-par
-As with @var{button-par}, this is a sub-expression number, but this one
-says which part of the match is to be sent as data to @var{function}.
-
-@end table
-
-So the full entry for buttonizing URLs is then
-
-@lisp
-("<URL:\\([^\n\r>]*\\)>" 0 t gnus-button-url 1)
-@end lisp
-
-@item gnus-header-button-alist
-@vindex gnus-header-button-alist
-This is just like the other alist, except that it is applied to the
-article head only, and that each entry has an additional element that is
-used to say what headers to apply the buttonize coding to:
-
-@lisp
-(@var{header} @var{regexp} @var{button-par} @var{use-p} @var{function} @var{data-par})
-@end lisp
-
-@var{header} is a regular expression.
-@end table
-
-@subsubsection Related variables and functions
-
-@table @code
-@item gnus-button-@var{*}-level
-@xref{Article Button Levels}.
-
-@c Stuff related to gnus-button-browse-level
-
-@item gnus-button-url-regexp
-@vindex gnus-button-url-regexp
-A regular expression that matches embedded URLs. It is used in the
-default values of the variables above.
-
-@c Stuff related to gnus-button-man-level
-
-@item gnus-button-man-handler
-@vindex gnus-button-man-handler
-The function to use for displaying man pages. It must take at least one
-argument with a string naming the man page.
-
-@c Stuff related to gnus-button-message-level
-
-@item gnus-button-mid-or-mail-regexp
-@vindex gnus-button-mid-or-mail-regexp
-Regular expression that matches a message ID or a mail address.
-
-@item gnus-button-prefer-mid-or-mail
-@vindex gnus-button-prefer-mid-or-mail
-This variable determines what to do when the button on a string as
-@samp{foo123@@bar.invalid} is pushed. Strings like this can be either a
-message ID or a mail address. If it is one of the symbols @code{mid} or
-@code{mail}, Gnus will always assume that the string is a message ID or
-a mail address, respectively. If this variable is set to the symbol
-@code{ask}, always query the user what to do. If it is a function, this
-function will be called with the string as its only argument. The
-function must return @code{mid}, @code{mail}, @code{invalid} or
-@code{ask}. The default value is the function
-@code{gnus-button-mid-or-mail-heuristic}.
-
-@item gnus-button-mid-or-mail-heuristic
-@findex gnus-button-mid-or-mail-heuristic
-Function that guesses whether its argument is a message ID or a mail
-address. Returns @code{mid} if it's a message IDs, @code{mail} if
-it's a mail address, @code{ask} if unsure and @code{invalid} if the
-string is invalid.
-
-@item gnus-button-mid-or-mail-heuristic-alist
-@vindex gnus-button-mid-or-mail-heuristic-alist
-An alist of @code{(RATE . REGEXP)} pairs used by the function
-@code{gnus-button-mid-or-mail-heuristic}.
-
-@c Stuff related to gnus-button-tex-level
-
-@item gnus-button-ctan-handler
-@findex gnus-button-ctan-handler
-The function to use for displaying CTAN links. It must take one
-argument, the string naming the URL.
-
-@item gnus-ctan-url
-@vindex gnus-ctan-url
-Top directory of a CTAN (Comprehensive TeX Archive Network) archive used
-by @code{gnus-button-ctan-handler}.
-
-@c Misc stuff
-
-@item gnus-article-button-face
-@vindex gnus-article-button-face
-Face used on buttons.
-
-@item gnus-article-mouse-face
-@vindex gnus-article-mouse-face
-Face used when the mouse cursor is over a button.
-
-@end table
-
-@xref{Customizing Articles}, for how to buttonize articles automatically.
-
-
-@node Article Button Levels
-@subsection Article button levels
-@cindex button levels
-The higher the value of the variables @code{gnus-button-@var{*}-level},
-the more buttons will appear. If the level is zero, no corresponding
-buttons are displayed. With the default value (which is 5) you should
-already see quite a lot of buttons. With higher levels, you will see
-more buttons, but you may also get more false positives. To avoid them,
-you can set the variables @code{gnus-button-@var{*}-level} local to
-specific groups (@pxref{Group Parameters}). Here's an example for the
-variable @code{gnus-parameters}:
-
-@lisp
-;; @r{increase @code{gnus-button-*-level} in some groups:}
-(setq gnus-parameters
- '(("\\<\\(emacs\\|gnus\\)\\>" (gnus-button-emacs-level 10))
- ("\\<unix\\>" (gnus-button-man-level 10))
- ("\\<tex\\>" (gnus-button-tex-level 10))))
-@end lisp
-
-@table @code
-
-@item gnus-button-browse-level
-@vindex gnus-button-browse-level
-Controls the display of references to message IDs, mail addresses and
-news URLs. Related variables and functions include
-@code{gnus-button-url-regexp}, @code{browse-url}, and
-@code{browse-url-browser-function}.
-
-@item gnus-button-emacs-level
-@vindex gnus-button-emacs-level
-Controls the display of Emacs or Gnus references. Related functions are
-@code{gnus-button-handle-custom},
-@code{gnus-button-handle-describe-function},
-@code{gnus-button-handle-describe-variable},
-@code{gnus-button-handle-symbol},
-@code{gnus-button-handle-describe-key},
-@code{gnus-button-handle-apropos},
-@code{gnus-button-handle-apropos-command},
-@code{gnus-button-handle-apropos-variable},
-@code{gnus-button-handle-apropos-documentation}, and
-@code{gnus-button-handle-library}.
-
-@item gnus-button-man-level
-@vindex gnus-button-man-level
-Controls the display of references to (Unix) man pages.
-See @code{gnus-button-man-handler}.
-
-@item gnus-button-message-level
-@vindex gnus-button-message-level
-Controls the display of message IDs, mail addresses and news URLs.
-Related variables and functions include
-@code{gnus-button-mid-or-mail-regexp},
-@code{gnus-button-prefer-mid-or-mail},
-@code{gnus-button-mid-or-mail-heuristic}, and
-@code{gnus-button-mid-or-mail-heuristic-alist}.
-
-@item gnus-button-tex-level
-@vindex gnus-button-tex-level
-Controls the display of references to @TeX{} or LaTeX stuff, e.g. for CTAN
-URLs. See the variables @code{gnus-ctan-url},
-@code{gnus-button-ctan-handler},
-@code{gnus-button-ctan-directory-regexp}, and
-@code{gnus-button-handle-ctan-bogus-regexp}.
-
-@end table
-
-
-@node Article Date
-@subsection Article Date
-
-The date is most likely generated in some obscure timezone you've never
-heard of, so it's quite nice to be able to find out what the time was
-when the article was sent.
-
-@table @kbd
-
-@item W T u
-@kindex W T u (Summary)
-@findex gnus-article-date-ut
-Display the date in UT (aka. GMT, aka ZULU)
-(@code{gnus-article-date-ut}).
-
-@item W T i
-@kindex W T i (Summary)
-@findex gnus-article-date-iso8601
-@cindex ISO 8601
-Display the date in international format, aka. ISO 8601
-(@code{gnus-article-date-iso8601}).
-
-@item W T l
-@kindex W T l (Summary)
-@findex gnus-article-date-local
-Display the date in the local timezone (@code{gnus-article-date-local}).
-
-@item W T p
-@kindex W T p (Summary)
-@findex gnus-article-date-english
-Display the date in a format that's easily pronounceable in English
-(@code{gnus-article-date-english}).
-
-@item W T s
-@kindex W T s (Summary)
-@vindex gnus-article-time-format
-@findex gnus-article-date-user
-@findex format-time-string
-Display the date using a user-defined format
-(@code{gnus-article-date-user}). The format is specified by the
-@code{gnus-article-time-format} variable, and is a string that's passed
-to @code{format-time-string}. See the documentation of that variable
-for a list of possible format specs.
-
-@item W T e
-@kindex W T e (Summary)
-@findex gnus-article-date-lapsed
-@findex gnus-start-date-timer
-@findex gnus-stop-date-timer
-Say how much time has elapsed between the article was posted and now
-(@code{gnus-article-date-lapsed}). It looks something like:
-
-@example
-X-Sent: 6 weeks, 4 days, 1 hour, 3 minutes, 8 seconds ago
-@end example
-
-@vindex gnus-article-date-lapsed-new-header
-The value of @code{gnus-article-date-lapsed-new-header} determines
-whether this header will just be added below the old Date one, or will
-replace it.
-
-An advantage of using Gnus to read mail is that it converts simple bugs
-into wonderful absurdities.
-
-If you want to have this line updated continually, you can put
-
-@lisp
-(gnus-start-date-timer)
-@end lisp
-
-in your @file{~/.gnus.el} file, or you can run it off of some hook. If
-you want to stop the timer, you can use the @code{gnus-stop-date-timer}
-command.
-
-@item W T o
-@kindex W T o (Summary)
-@findex gnus-article-date-original
-Display the original date (@code{gnus-article-date-original}). This can
-be useful if you normally use some other conversion function and are
-worried that it might be doing something totally wrong. Say, claiming
-that the article was posted in 1854. Although something like that is
-@emph{totally} impossible. Don't you trust me? *titter*
-
-@end table
-
-@xref{Customizing Articles}, for how to display the date in your
-preferred format automatically.
-
-
-@node Article Display
-@subsection Article Display
-@cindex picons
-@cindex x-face
-@cindex smileys
-
-These commands add various frivolous display gimmicks to the article
-buffer in Emacs versions that support them.
-
-@code{X-Face} headers are small black-and-white images supplied by the
-message headers (@pxref{X-Face}).
-
-@code{Face} headers are small colored images supplied by the message
-headers (@pxref{Face}).
-
-Smileys are those little @samp{:-)} symbols that people like to litter
-their messages with (@pxref{Smileys}).
-
-Picons, on the other hand, reside on your own system, and Gnus will
-try to match the headers to what you have (@pxref{Picons}).
-
-All these functions are toggles---if the elements already exist,
-they'll be removed.
-
-@table @kbd
-@item W D x
-@kindex W D x (Summary)
-@findex gnus-article-display-x-face
-Display an @code{X-Face} in the @code{From} header.
-(@code{gnus-article-display-x-face}).
-
-@item W D d
-@kindex W D d (Summary)
-@findex gnus-article-display-face
-Display a @code{Face} in the @code{From} header.
-(@code{gnus-article-display-face}).
-
-@item W D s
-@kindex W D s (Summary)
-@findex gnus-treat-smiley
-Display smileys (@code{gnus-treat-smiley}).
-
-@item W D f
-@kindex W D f (Summary)
-@findex gnus-treat-from-picon
-Piconify the @code{From} header (@code{gnus-treat-from-picon}).
-
-@item W D m
-@kindex W D m (Summary)
-@findex gnus-treat-mail-picon
-Piconify all mail headers (i. e., @code{Cc}, @code{To})
-(@code{gnus-treat-mail-picon}).
-
-@item W D n
-@kindex W D n (Summary)
-@findex gnus-treat-newsgroups-picon
-Piconify all news headers (i. e., @code{Newsgroups} and
-@code{Followup-To}) (@code{gnus-treat-newsgroups-picon}).
-
-@item W D D
-@kindex W D D (Summary)
-@findex gnus-article-remove-images
-Remove all images from the article buffer
-(@code{gnus-article-remove-images}).
-
-@end table
-
-
-
-@node Article Signature
-@subsection Article Signature
-@cindex signatures
-@cindex article signature
-
-@vindex gnus-signature-separator
-Each article is divided into two parts---the head and the body. The
-body can be divided into a signature part and a text part. The variable
-that says what is to be considered a signature is
-@code{gnus-signature-separator}. This is normally the standard
-@samp{^-- $} as mandated by son-of-RFC 1036. However, many people use
-non-standard signature separators, so this variable can also be a list
-of regular expressions to be tested, one by one. (Searches are done
-from the end of the body towards the beginning.) One likely value is:
-
-@lisp
-(setq gnus-signature-separator
- '("^-- $" ; @r{The standard}
- "^-- *$" ; @r{A common mangling}
- "^-------*$" ; @r{Many people just use a looong}
- ; @r{line of dashes. Shame!}
- "^ *--------*$" ; @r{Double-shame!}
- "^________*$" ; @r{Underscores are also popular}
- "^========*$")) ; @r{Pervert!}
-@end lisp
-
-The more permissive you are, the more likely it is that you'll get false
-positives.
-
-@vindex gnus-signature-limit
-@code{gnus-signature-limit} provides a limit to what is considered a
-signature when displaying articles.
-
-@enumerate
-@item
-If it is an integer, no signature may be longer (in characters) than
-that integer.
-@item
-If it is a floating point number, no signature may be longer (in lines)
-than that number.
-@item
-If it is a function, the function will be called without any parameters,
-and if it returns @code{nil}, there is no signature in the buffer.
-@item
-If it is a string, it will be used as a regexp. If it matches, the text
-in question is not a signature.
-@end enumerate
-
-This variable can also be a list where the elements may be of the types
-listed above. Here's an example:
-
-@lisp
-(setq gnus-signature-limit
- '(200.0 "^---*Forwarded article"))
-@end lisp
-
-This means that if there are more than 200 lines after the signature
-separator, or the text after the signature separator is matched by
-the regular expression @samp{^---*Forwarded article}, then it isn't a
-signature after all.
-
-
-@node Article Miscellanea
-@subsection Article Miscellanea
-
-@table @kbd
-@item A t
-@kindex A t (Summary)
-@findex gnus-article-babel
-Translate the article from one language to another
-(@code{gnus-article-babel}).
-
-@end table
-
-
-@node MIME Commands
-@section MIME Commands
-@cindex MIME decoding
-@cindex attachments
-@cindex viewing attachments
-
-The following commands all understand the numerical prefix. For
-instance, @kbd{3 b} means ``view the third @acronym{MIME} part''.
-
-@table @kbd
-@item b
-@itemx K v
-@kindex b (Summary)
-@kindex K v (Summary)
-View the @acronym{MIME} part.
-
-@item K o
-@kindex K o (Summary)
-Save the @acronym{MIME} part.
-
-@item K c
-@kindex K c (Summary)
-Copy the @acronym{MIME} part.
-
-@item K e
-@kindex K e (Summary)
-View the @acronym{MIME} part externally.
-
-@item K i
-@kindex K i (Summary)
-View the @acronym{MIME} part internally.
-
-@item K |
-@kindex K | (Summary)
-Pipe the @acronym{MIME} part to an external command.
-@end table
-
-The rest of these @acronym{MIME} commands do not use the numerical prefix in
-the same manner:
-
-@table @kbd
-@item K b
-@kindex K b (Summary)
-Make all the @acronym{MIME} parts have buttons in front of them. This is
-mostly useful if you wish to save (or perform other actions) on inlined
-parts.
-
-@item K m
-@kindex K m (Summary)
-@findex gnus-summary-repair-multipart
-Some multipart messages are transmitted with missing or faulty headers.
-This command will attempt to ``repair'' these messages so that they can
-be viewed in a more pleasant manner
-(@code{gnus-summary-repair-multipart}).
-
-@item X m
-@kindex X m (Summary)
-@findex gnus-summary-save-parts
-Save all parts matching a @acronym{MIME} type to a directory
-(@code{gnus-summary-save-parts}). Understands the process/prefix
-convention (@pxref{Process/Prefix}).
-
-@item M-t
-@kindex M-t (Summary)
-@findex gnus-summary-toggle-display-buttonized
-Toggle the buttonized display of the article buffer
-(@code{gnus-summary-toggle-display-buttonized}).
-
-@item W M w
-@kindex W M w (Summary)
-@findex gnus-article-decode-mime-words
-Decode RFC 2047-encoded words in the article headers
-(@code{gnus-article-decode-mime-words}).
-
-@item W M c
-@kindex W M c (Summary)
-@findex gnus-article-decode-charset
-Decode encoded article bodies as well as charsets
-(@code{gnus-article-decode-charset}).
-
-This command looks in the @code{Content-Type} header to determine the
-charset. If there is no such header in the article, you can give it a
-prefix, which will prompt for the charset to decode as. In regional
-groups where people post using some common encoding (but do not
-include @acronym{MIME} headers), you can set the @code{charset} group/topic
-parameter to the required charset (@pxref{Group Parameters}).
-
-@item W M v
-@kindex W M v (Summary)
-@findex gnus-mime-view-all-parts
-View all the @acronym{MIME} parts in the current article
-(@code{gnus-mime-view-all-parts}).
-
-@end table
-
-Relevant variables:
-
-@table @code
-@item gnus-ignored-mime-types
-@vindex gnus-ignored-mime-types
-This is a list of regexps. @acronym{MIME} types that match a regexp from
-this list will be completely ignored by Gnus. The default value is
-@code{nil}.
-
-To have all Vcards be ignored, you'd say something like this:
-
-@lisp
-(setq gnus-ignored-mime-types
- '("text/x-vcard"))
-@end lisp
-
-@item gnus-article-loose-mime
-@vindex gnus-article-loose-mime
-If non-@code{nil}, Gnus won't require the @samp{MIME-Version} header
-before interpreting the message as a @acronym{MIME} message. This helps
-when reading messages from certain broken mail user agents. The
-default is @code{nil}.
-
-@item gnus-article-emulate-mime
-@vindex gnus-article-emulate-mime
-@cindex uuencode
-@cindex yEnc
-There are other, non-@acronym{MIME} encoding methods used. The most common
-is @samp{uuencode}, but yEncode is also getting to be popular. If
-this variable is non-@code{nil}, Gnus will look in message bodies to
-see if it finds these encodings, and if so, it'll run them through the
-Gnus @acronym{MIME} machinery. The default is @code{t}. Only
-single-part yEnc encoded attachments can be decoded. There's no support
-for encoding in Gnus.
-
-@item gnus-unbuttonized-mime-types
-@vindex gnus-unbuttonized-mime-types
-This is a list of regexps. @acronym{MIME} types that match a regexp from
-this list won't have @acronym{MIME} buttons inserted unless they aren't
-displayed or this variable is overridden by
-@code{gnus-buttonized-mime-types}. The default value is
-@code{(".*/.*")}. This variable is only used when
-@code{gnus-inhibit-mime-unbuttonizing} is @code{nil}.
-
-@item gnus-buttonized-mime-types
-@vindex gnus-buttonized-mime-types
-This is a list of regexps. @acronym{MIME} types that match a regexp from
-this list will have @acronym{MIME} buttons inserted unless they aren't
-displayed. This variable overrides
-@code{gnus-unbuttonized-mime-types}. The default value is @code{nil}.
-This variable is only used when @code{gnus-inhibit-mime-unbuttonizing}
-is @code{nil}.
-
-To see e.g. security buttons but no other buttons, you could set this
-variable to @code{("multipart/signed")} and leave
-@code{gnus-unbuttonized-mime-types} at the default value.
-
-You could also add @code{"multipart/alternative"} to this list to
-display radio buttons that allow you to choose one of two media types
-those mails include. See also @code{mm-discouraged-alternatives}
-(@pxref{Display Customization, ,Display Customization, emacs-mime, The
-Emacs MIME Manual}).
-
-@item gnus-inhibit-mime-unbuttonizing
-@vindex gnus-inhibit-mime-unbuttonizing
-If this is non-@code{nil}, then all @acronym{MIME} parts get buttons. The
-default value is @code{nil}.
-
-@item gnus-article-mime-part-function
-@vindex gnus-article-mime-part-function
-For each @acronym{MIME} part, this function will be called with the @acronym{MIME}
-handle as the parameter. The function is meant to be used to allow
-users to gather information from the article (e. g., add Vcard info to
-the bbdb database) or to do actions based on parts (e. g., automatically
-save all jpegs into some directory).
-
-Here's an example function the does the latter:
-
-@lisp
-(defun my-save-all-jpeg-parts (handle)
- (when (equal (car (mm-handle-type handle)) "image/jpeg")
- (with-temp-buffer
- (insert (mm-get-part handle))
- (write-region (point-min) (point-max)
- (read-file-name "Save jpeg to: ")))))
-(setq gnus-article-mime-part-function
- 'my-save-all-jpeg-parts)
-@end lisp
-
-@vindex gnus-mime-multipart-functions
-@item gnus-mime-multipart-functions
-Alist of @acronym{MIME} multipart types and functions to handle them.
-
-@vindex gnus-mime-display-multipart-alternative-as-mixed
-@item gnus-mime-display-multipart-alternative-as-mixed
-Display "multipart/alternative" parts as "multipart/mixed".
-
-@vindex gnus-mime-display-multipart-related-as-mixed
-@item gnus-mime-display-multipart-related-as-mixed
-Display "multipart/related" parts as "multipart/mixed".
-
-If displaying @samp{text/html} is discouraged, see
-@code{mm-discouraged-alternatives}, images or other material inside a
-"multipart/related" part might be overlooked when this variable is
-@code{nil}. @ref{Display Customization, Display Customization, ,
-emacs-mime, Emacs-Mime Manual}.
-
-@vindex gnus-mime-display-multipart-as-mixed
-@item gnus-mime-display-multipart-as-mixed
-Display "multipart" parts as "multipart/mixed". If @code{t}, it
-overrides @code{nil} values of
-@code{gnus-mime-display-multipart-alternative-as-mixed} and
-@code{gnus-mime-display-multipart-related-as-mixed}.
-
-@vindex mm-file-name-rewrite-functions
-@item mm-file-name-rewrite-functions
-List of functions used for rewriting file names of @acronym{MIME} parts.
-Each function takes a file name as input and returns a file name.
-
-Ready-made functions include@*
-@code{mm-file-name-delete-whitespace},
-@code{mm-file-name-trim-whitespace},
-@code{mm-file-name-collapse-whitespace}, and
-@code{mm-file-name-replace-whitespace}. The later uses the value of
-the variable @code{mm-file-name-replace-whitespace} to replace each
-whitespace character in a file name with that string; default value
-is @code{"_"} (a single underscore).
-@findex mm-file-name-delete-whitespace
-@findex mm-file-name-trim-whitespace
-@findex mm-file-name-collapse-whitespace
-@findex mm-file-name-replace-whitespace
-@vindex mm-file-name-replace-whitespace
-
-The standard functions @code{capitalize}, @code{downcase},
-@code{upcase}, and @code{upcase-initials} may be useful, too.
-
-Everybody knows that whitespace characters in file names are evil,
-except those who don't know. If you receive lots of attachments from
-such unenlightened users, you can make live easier by adding
-
-@lisp
-(setq mm-file-name-rewrite-functions
- '(mm-file-name-trim-whitespace
- mm-file-name-collapse-whitespace
- mm-file-name-replace-whitespace))
-@end lisp
-
-@noindent
-to your @file{~/.gnus.el} file.
-
-@end table
-
-
-@node Charsets
-@section Charsets
-@cindex charsets
-
-People use different charsets, and we have @acronym{MIME} to let us know what
-charsets they use. Or rather, we wish we had. Many people use
-newsreaders and mailers that do not understand or use @acronym{MIME}, and
-just send out messages without saying what character sets they use. To
-help a bit with this, some local news hierarchies have policies that say
-what character set is the default. For instance, the @samp{fj}
-hierarchy uses @code{iso-2022-jp}.
-
-@vindex gnus-group-charset-alist
-This knowledge is encoded in the @code{gnus-group-charset-alist}
-variable, which is an alist of regexps (use the first item to match full
-group names) and default charsets to be used when reading these groups.
-
-@vindex gnus-newsgroup-ignored-charsets
-In addition, some people do use soi-disant @acronym{MIME}-aware agents that
-aren't. These blithely mark messages as being in @code{iso-8859-1}
-even if they really are in @code{koi-8}. To help here, the
-@code{gnus-newsgroup-ignored-charsets} variable can be used. The
-charsets that are listed here will be ignored. The variable can be
-set on a group-by-group basis using the group parameters (@pxref{Group
-Parameters}). The default value is @code{(unknown-8bit x-unknown)},
-which includes values some agents insist on having in there.
-
-@vindex gnus-group-posting-charset-alist
-When posting, @code{gnus-group-posting-charset-alist} is used to
-determine which charsets should not be encoded using the @acronym{MIME}
-encodings. For instance, some hierarchies discourage using
-quoted-printable header encoding.
-
-This variable is an alist of regexps and permitted unencoded charsets
-for posting. Each element of the alist has the form @code{(}@var{test
-header body-list}@code{)}, where:
-
-@table @var
-@item test
-is either a regular expression matching the newsgroup header or a
-variable to query,
-@item header
-is the charset which may be left unencoded in the header (@code{nil}
-means encode all charsets),
-@item body-list
-is a list of charsets which may be encoded using 8bit content-transfer
-encoding in the body, or one of the special values @code{nil} (always
-encode using quoted-printable) or @code{t} (always use 8bit).
-@end table
-
-@cindex Russian
-@cindex koi8-r
-@cindex koi8-u
-@cindex iso-8859-5
-@cindex coding system aliases
-@cindex preferred charset
-
-@xref{Encoding Customization, , Encoding Customization, emacs-mime,
-The Emacs MIME Manual}, for additional variables that control which
-MIME charsets are used when sending messages.
-
-Other charset tricks that may be useful, although not Gnus-specific:
-
-If there are several @acronym{MIME} charsets that encode the same Emacs
-charset, you can choose what charset to use by saying the following:
-
-@lisp
-(put-charset-property 'cyrillic-iso8859-5
- 'preferred-coding-system 'koi8-r)
-@end lisp
-
-This means that Russian will be encoded using @code{koi8-r} instead of
-the default @code{iso-8859-5} @acronym{MIME} charset.
-
-If you want to read messages in @code{koi8-u}, you can cheat and say
-
-@lisp
-(define-coding-system-alias 'koi8-u 'koi8-r)
-@end lisp
-
-This will almost do the right thing.
-
-And finally, to read charsets like @code{windows-1251}, you can say
-something like
-
-@lisp
-(codepage-setup 1251)
-(define-coding-system-alias 'windows-1251 'cp1251)
-@end lisp
-
-
-@node Article Commands
-@section Article Commands
-
-@table @kbd
-
-@item A P
-@cindex PostScript
-@cindex printing
-@kindex A P (Summary)
-@vindex gnus-ps-print-hook
-@findex gnus-summary-print-article
-Generate and print a PostScript image of the article buffer
-(@code{gnus-summary-print-article}). @code{gnus-ps-print-hook} will
-be run just before printing the buffer. An alternative way to print
-article is to use Muttprint (@pxref{Saving Articles}).
-
-@end table
-
-
-@node Summary Sorting
-@section Summary Sorting
-@cindex summary sorting
-
-You can have the summary buffer sorted in various ways, even though I
-can't really see why you'd want that.
-
-@table @kbd
-
-@item C-c C-s C-n
-@kindex C-c C-s C-n (Summary)
-@findex gnus-summary-sort-by-number
-Sort by article number (@code{gnus-summary-sort-by-number}).
-
-@item C-c C-s C-a
-@kindex C-c C-s C-a (Summary)
-@findex gnus-summary-sort-by-author
-Sort by author (@code{gnus-summary-sort-by-author}).
-
-@item C-c C-s C-s
-@kindex C-c C-s C-s (Summary)
-@findex gnus-summary-sort-by-subject
-Sort by subject (@code{gnus-summary-sort-by-subject}).
-
-@item C-c C-s C-d
-@kindex C-c C-s C-d (Summary)
-@findex gnus-summary-sort-by-date
-Sort by date (@code{gnus-summary-sort-by-date}).
-
-@item C-c C-s C-l
-@kindex C-c C-s C-l (Summary)
-@findex gnus-summary-sort-by-lines
-Sort by lines (@code{gnus-summary-sort-by-lines}).
-
-@item C-c C-s C-c
-@kindex C-c C-s C-c (Summary)
-@findex gnus-summary-sort-by-chars
-Sort by article length (@code{gnus-summary-sort-by-chars}).
-
-@item C-c C-s C-i
-@kindex C-c C-s C-i (Summary)
-@findex gnus-summary-sort-by-score
-Sort by score (@code{gnus-summary-sort-by-score}).
-
-@item C-c C-s C-r
-@kindex C-c C-s C-r (Summary)
-@findex gnus-summary-sort-by-random
-Randomize (@code{gnus-summary-sort-by-random}).
-
-@item C-c C-s C-o
-@kindex C-c C-s C-o (Summary)
-@findex gnus-summary-sort-by-original
-Sort using the default sorting method
-(@code{gnus-summary-sort-by-original}).
-@end table
-
-These functions will work both when you use threading and when you don't
-use threading. In the latter case, all summary lines will be sorted,
-line by line. In the former case, sorting will be done on a
-root-by-root basis, which might not be what you were looking for. To
-toggle whether to use threading, type @kbd{T T} (@pxref{Thread
-Commands}).
-
-
-@node Finding the Parent
-@section Finding the Parent
-@cindex parent articles
-@cindex referring articles
-
-@table @kbd
-@item ^
-@kindex ^ (Summary)
-@findex gnus-summary-refer-parent-article
-If you'd like to read the parent of the current article, and it is not
-displayed in the summary buffer, you might still be able to. That is,
-if the current group is fetched by @acronym{NNTP}, the parent hasn't expired
-and the @code{References} in the current article are not mangled, you
-can just press @kbd{^} or @kbd{A r}
-(@code{gnus-summary-refer-parent-article}). If everything goes well,
-you'll get the parent. If the parent is already displayed in the
-summary buffer, point will just move to this article.
-
-If given a positive numerical prefix, fetch that many articles back into
-the ancestry. If given a negative numerical prefix, fetch just that
-ancestor. So if you say @kbd{3 ^}, Gnus will fetch the parent, the
-grandparent and the grandgrandparent of the current article. If you say
-@kbd{-3 ^}, Gnus will only fetch the grandgrandparent of the current
-article.
-
-@item A R (Summary)
-@findex gnus-summary-refer-references
-@kindex A R (Summary)
-Fetch all articles mentioned in the @code{References} header of the
-article (@code{gnus-summary-refer-references}).
-
-@item A T (Summary)
-@findex gnus-summary-refer-thread
-@kindex A T (Summary)
-Display the full thread where the current article appears
-(@code{gnus-summary-refer-thread}). This command has to fetch all the
-headers in the current group to work, so it usually takes a while. If
-you do it often, you may consider setting @code{gnus-fetch-old-headers}
-to @code{invisible} (@pxref{Filling In Threads}). This won't have any
-visible effects normally, but it'll make this command work a whole lot
-faster. Of course, it'll make group entry somewhat slow.
-
-@vindex gnus-refer-thread-limit
-The @code{gnus-refer-thread-limit} variable says how many old (i. e.,
-articles before the first displayed in the current group) headers to
-fetch when doing this command. The default is 200. If @code{t}, all
-the available headers will be fetched. This variable can be overridden
-by giving the @kbd{A T} command a numerical prefix.
-
-@item M-^ (Summary)
-@findex gnus-summary-refer-article
-@kindex M-^ (Summary)
-@cindex Message-ID
-@cindex fetching by Message-ID
-You can also ask Gnus for an arbitrary article, no matter what group it
-belongs to. @kbd{M-^} (@code{gnus-summary-refer-article}) will ask you
-for a @code{Message-ID}, which is one of those long, hard-to-read
-thingies that look something like @samp{<38o6up$6f2@@hymir.ifi.uio.no>}.
-You have to get it all exactly right. No fuzzy searches, I'm afraid.
-
-Gnus looks for the @code{Message-ID} in the headers that have already
-been fetched, but also tries all the select methods specified by
-@code{gnus-refer-article-method} if it is not found.
-@end table
-
-@vindex gnus-refer-article-method
-If the group you are reading is located on a back end that does not
-support fetching by @code{Message-ID} very well (like @code{nnspool}),
-you can set @code{gnus-refer-article-method} to an @acronym{NNTP} method. It
-would, perhaps, be best if the @acronym{NNTP} server you consult is the one
-updating the spool you are reading from, but that's not really
-necessary.
-
-It can also be a list of select methods, as well as the special symbol
-@code{current}, which means to use the current select method. If it
-is a list, Gnus will try all the methods in the list until it finds a
-match.
-
-Here's an example setting that will first try the current method, and
-then ask Google if that fails:
-
-@lisp
-(setq gnus-refer-article-method
- '(current
- (nnweb "google" (nnweb-type google))))
-@end lisp
-
-Most of the mail back ends support fetching by @code{Message-ID}, but
-do not do a particularly excellent job at it. That is, @code{nnmbox},
-@code{nnbabyl}, @code{nnmaildir}, @code{nnml}, are able to locate
-articles from any groups, while @code{nnfolder}, and @code{nnimap} are
-only able to locate articles that have been posted to the current
-group. (Anything else would be too time consuming.) @code{nnmh} does
-not support this at all.
-
-
-@node Alternative Approaches
-@section Alternative Approaches
-
-Different people like to read news using different methods. This being
-Gnus, we offer a small selection of minor modes for the summary buffers.
-
-@menu
-* Pick and Read:: First mark articles and then read them.
-* Binary Groups:: Auto-decode all articles.
-@end menu
-
-
-@node Pick and Read
-@subsection Pick and Read
-@cindex pick and read
-
-Some newsreaders (like @code{nn} and, uhm, @code{Netnews} on VM/CMS) use
-a two-phased reading interface. The user first marks in a summary
-buffer the articles she wants to read. Then she starts reading the
-articles with just an article buffer displayed.
-
-@findex gnus-pick-mode
-@kindex M-x gnus-pick-mode
-Gnus provides a summary buffer minor mode that allows
-this---@code{gnus-pick-mode}. This basically means that a few process
-mark commands become one-keystroke commands to allow easy marking, and
-it provides one additional command for switching to the summary buffer.
-
-Here are the available keystrokes when using pick mode:
-
-@table @kbd
-@item .
-@kindex . (Pick)
-@findex gnus-pick-article-or-thread
-Pick the article or thread on the current line
-(@code{gnus-pick-article-or-thread}). If the variable
-@code{gnus-thread-hide-subtree} is true, then this key selects the
-entire thread when used at the first article of the thread. Otherwise,
-it selects just the article. If given a numerical prefix, go to that
-thread or article and pick it. (The line number is normally displayed
-at the beginning of the summary pick lines.)
-
-@item SPACE
-@kindex SPACE (Pick)
-@findex gnus-pick-next-page
-Scroll the summary buffer up one page (@code{gnus-pick-next-page}). If
-at the end of the buffer, start reading the picked articles.
-
-@item u
-@kindex u (Pick)
-@findex gnus-pick-unmark-article-or-thread.
-Unpick the thread or article
-(@code{gnus-pick-unmark-article-or-thread}). If the variable
-@code{gnus-thread-hide-subtree} is true, then this key unpicks the
-thread if used at the first article of the thread. Otherwise it unpicks
-just the article. You can give this key a numerical prefix to unpick
-the thread or article at that line.
-
-@item RET
-@kindex RET (Pick)
-@findex gnus-pick-start-reading
-@vindex gnus-pick-display-summary
-Start reading the picked articles (@code{gnus-pick-start-reading}). If
-given a prefix, mark all unpicked articles as read first. If
-@code{gnus-pick-display-summary} is non-@code{nil}, the summary buffer
-will still be visible when you are reading.
-
-@end table
-
-All the normal summary mode commands are still available in the
-pick-mode, with the exception of @kbd{u}. However @kbd{!} is available
-which is mapped to the same function
-@code{gnus-summary-tick-article-forward}.
-
-If this sounds like a good idea to you, you could say:
-
-@lisp
-(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode)
-@end lisp
-
-@vindex gnus-pick-mode-hook
-@code{gnus-pick-mode-hook} is run in pick minor mode buffers.
-
-@vindex gnus-mark-unpicked-articles-as-read
-If @code{gnus-mark-unpicked-articles-as-read} is non-@code{nil}, mark
-all unpicked articles as read. The default is @code{nil}.
-
-@vindex gnus-summary-pick-line-format
-The summary line format in pick mode is slightly different from the
-standard format. At the beginning of each line the line number is
-displayed. The pick mode line format is controlled by the
-@code{gnus-summary-pick-line-format} variable (@pxref{Formatting
-Variables}). It accepts the same format specs that
-@code{gnus-summary-line-format} does (@pxref{Summary Buffer Lines}).
-
-
-@node Binary Groups
-@subsection Binary Groups
-@cindex binary groups
-
-@findex gnus-binary-mode
-@kindex M-x gnus-binary-mode
-If you spend much time in binary groups, you may grow tired of hitting
-@kbd{X u}, @kbd{n}, @kbd{RET} all the time. @kbd{M-x gnus-binary-mode}
-is a minor mode for summary buffers that makes all ordinary Gnus article
-selection functions uudecode series of articles and display the result
-instead of just displaying the articles the normal way.
-
-@kindex g (Binary)
-@findex gnus-binary-show-article
-The only way, in fact, to see the actual articles is the @kbd{g}
-command, when you have turned on this mode
-(@code{gnus-binary-show-article}).
-
-@vindex gnus-binary-mode-hook
-@code{gnus-binary-mode-hook} is called in binary minor mode buffers.
-
-
-@node Tree Display
-@section Tree Display
-@cindex trees
-
-@vindex gnus-use-trees
-If you don't like the normal Gnus summary display, you might try setting
-@code{gnus-use-trees} to @code{t}. This will create (by default) an
-additional @dfn{tree buffer}. You can execute all summary mode commands
-in the tree buffer.
-
-There are a few variables to customize the tree display, of course:
-
-@table @code
-@item gnus-tree-mode-hook
-@vindex gnus-tree-mode-hook
-A hook called in all tree mode buffers.
-
-@item gnus-tree-mode-line-format
-@vindex gnus-tree-mode-line-format
-A format string for the mode bar in the tree mode buffers (@pxref{Mode
-Line Formatting}). The default is @samp{Gnus: %%b %S %Z}. For a list
-of valid specs, @pxref{Summary Buffer Mode Line}.
-
-@item gnus-selected-tree-face
-@vindex gnus-selected-tree-face
-Face used for highlighting the selected article in the tree buffer. The
-default is @code{modeline}.
-
-@item gnus-tree-line-format
-@vindex gnus-tree-line-format
-A format string for the tree nodes. The name is a bit of a misnomer,
-though---it doesn't define a line, but just the node. The default value
-is @samp{%(%[%3,3n%]%)}, which displays the first three characters of
-the name of the poster. It is vital that all nodes are of the same
-length, so you @emph{must} use @samp{%4,4n}-like specifiers.
-
-Valid specs are:
-
-@table @samp
-@item n
-The name of the poster.
-@item f
-The @code{From} header.
-@item N
-The number of the article.
-@item [
-The opening bracket.
-@item ]
-The closing bracket.
-@item s
-The subject.
-@end table
-
-@xref{Formatting Variables}.
-
-Variables related to the display are:
-
-@table @code
-@item gnus-tree-brackets
-@vindex gnus-tree-brackets
-This is used for differentiating between ``real'' articles and
-``sparse'' articles. The format is
-@example
-((@var{real-open} . @var{real-close})
- (@var{sparse-open} . @var{sparse-close})
- (@var{dummy-open} . @var{dummy-close}))
-@end example
-and the default is @code{((?[ . ?]) (?( . ?)) (?@{ . ?@}) (?< . ?>))}.
-
-@item gnus-tree-parent-child-edges
-@vindex gnus-tree-parent-child-edges
-This is a list that contains the characters used for connecting parent
-nodes to their children. The default is @code{(?- ?\\ ?|)}.
-
-@end table
-
-@item gnus-tree-minimize-window
-@vindex gnus-tree-minimize-window
-If this variable is non-@code{nil}, Gnus will try to keep the tree
-buffer as small as possible to allow more room for the other Gnus
-windows. If this variable is a number, the tree buffer will never be
-higher than that number. The default is @code{t}. Note that if you
-have several windows displayed side-by-side in a frame and the tree
-buffer is one of these, minimizing the tree window will also resize all
-other windows displayed next to it.
-
-You may also wish to add the following hook to keep the window minimized
-at all times:
-
-@lisp
-(add-hook 'gnus-configure-windows-hook
- 'gnus-tree-perhaps-minimize)
-@end lisp
-
-@item gnus-generate-tree-function
-@vindex gnus-generate-tree-function
-@findex gnus-generate-horizontal-tree
-@findex gnus-generate-vertical-tree
-The function that actually generates the thread tree. Two predefined
-functions are available: @code{gnus-generate-horizontal-tree} and
-@code{gnus-generate-vertical-tree} (which is the default).
-
-@end table
-
-Here's an example from a horizontal tree buffer:
-
-@example
-@{***@}-(***)-[odd]-[Gun]
- | \[Jan]
- | \[odd]-[Eri]
- | \(***)-[Eri]
- | \[odd]-[Paa]
- \[Bjo]
- \[Gun]
- \[Gun]-[Jor]
-@end example
-
-Here's the same thread displayed in a vertical tree buffer:
-
-@example
-@group
-@{***@}
- |--------------------------\-----\-----\
-(***) [Bjo] [Gun] [Gun]
- |--\-----\-----\ |
-[odd] [Jan] [odd] (***) [Jor]
- | | |--\
-[Gun] [Eri] [Eri] [odd]
- |
- [Paa]
-@end group
-@end example
-
-If you're using horizontal trees, it might be nice to display the trees
-side-by-side with the summary buffer. You could add something like the
-following to your @file{~/.gnus.el} file:
-
-@lisp
-(setq gnus-use-trees t
- gnus-generate-tree-function 'gnus-generate-horizontal-tree
- gnus-tree-minimize-window nil)
-(gnus-add-configuration
- '(article
- (vertical 1.0
- (horizontal 0.25
- (summary 0.75 point)
- (tree 1.0))
- (article 1.0))))
-@end lisp
-
-@xref{Window Layout}.
-
-
-@node Mail Group Commands
-@section Mail Group Commands
-@cindex mail group commands
-
-Some commands only make sense in mail groups. If these commands are
-invalid in the current group, they will raise a hell and let you know.
-
-All these commands (except the expiry and edit commands) use the
-process/prefix convention (@pxref{Process/Prefix}).
-
-@table @kbd
-
-@item B e
-@kindex B e (Summary)
-@findex gnus-summary-expire-articles
-@cindex expiring mail
-Run all expirable articles in the current group through the expiry
-process (@code{gnus-summary-expire-articles}). That is, delete all
-expirable articles in the group that have been around for a while.
-(@pxref{Expiring Mail}).
-
-@item B C-M-e
-@kindex B C-M-e (Summary)
-@findex gnus-summary-expire-articles-now
-@cindex expiring mail
-Delete all the expirable articles in the group
-(@code{gnus-summary-expire-articles-now}). This means that @strong{all}
-articles eligible for expiry in the current group will
-disappear forever into that big @file{/dev/null} in the sky.
-
-@item B DEL
-@kindex B DEL (Summary)
-@findex gnus-summary-delete-article
-@c @icon{gnus-summary-mail-delete}
-Delete the mail article. This is ``delete'' as in ``delete it from your
-disk forever and ever, never to return again.'' Use with caution.
-(@code{gnus-summary-delete-article}).
-
-@item B m
-@kindex B m (Summary)
-@cindex move mail
-@findex gnus-summary-move-article
-@vindex gnus-preserve-marks
-Move the article from one mail group to another
-(@code{gnus-summary-move-article}). Marks will be preserved if
-@code{gnus-preserve-marks} is non-@code{nil} (which is the default).
-
-@item B c
-@kindex B c (Summary)
-@cindex copy mail
-@findex gnus-summary-copy-article
-@c @icon{gnus-summary-mail-copy}
-Copy the article from one group (mail group or not) to a mail group
-(@code{gnus-summary-copy-article}). Marks will be preserved if
-@code{gnus-preserve-marks} is non-@code{nil} (which is the default).
-
-@item B B
-@kindex B B (Summary)
-@cindex crosspost mail
-@findex gnus-summary-crosspost-article
-Crosspost the current article to some other group
-(@code{gnus-summary-crosspost-article}). This will create a new copy of
-the article in the other group, and the Xref headers of the article will
-be properly updated.
-
-@item B i
-@kindex B i (Summary)
-@findex gnus-summary-import-article
-Import an arbitrary file into the current mail newsgroup
-(@code{gnus-summary-import-article}). You will be prompted for a file
-name, a @code{From} header and a @code{Subject} header.
-
-@item B I
-@kindex B I (Summary)
-@findex gnus-summary-create-article
-Create an empty article in the current mail newsgroups
-(@code{gnus-summary-create-article}). You will be prompted for a
-@code{From} header and a @code{Subject} header.
-
-@item B r
-@kindex B r (Summary)
-@findex gnus-summary-respool-article
-@vindex gnus-summary-respool-default-method
-Respool the mail article (@code{gnus-summary-respool-article}).
-@code{gnus-summary-respool-default-method} will be used as the default
-select method when respooling. This variable is @code{nil} by default,
-which means that the current group select method will be used instead.
-Marks will be preserved if @code{gnus-preserve-marks} is non-@code{nil}
-(which is the default).
-
-@item B w
-@itemx e
-@kindex B w (Summary)
-@kindex e (Summary)
-@findex gnus-summary-edit-article
-@kindex C-c C-c (Article)
-@findex gnus-summary-edit-article-done
-Edit the current article (@code{gnus-summary-edit-article}). To finish
-editing and make the changes permanent, type @kbd{C-c C-c}
-(@code{gnus-summary-edit-article-done}). If you give a prefix to the
-@kbd{C-c C-c} command, Gnus won't re-highlight the article.
-
-@item B q
-@kindex B q (Summary)
-@findex gnus-summary-respool-query
-If you want to re-spool an article, you might be curious as to what group
-the article will end up in before you do the re-spooling. This command
-will tell you (@code{gnus-summary-respool-query}).
-
-@item B t
-@kindex B t (Summary)
-@findex gnus-summary-respool-trace
-Similarly, this command will display all fancy splitting patterns used
-when respooling, if any (@code{gnus-summary-respool-trace}).
-
-@item B p
-@kindex B p (Summary)
-@findex gnus-summary-article-posted-p
-Some people have a tendency to send you ``courtesy'' copies when they
-follow up to articles you have posted. These usually have a
-@code{Newsgroups} header in them, but not always. This command
-(@code{gnus-summary-article-posted-p}) will try to fetch the current
-article from your news server (or rather, from
-@code{gnus-refer-article-method} or @code{gnus-select-method}) and will
-report back whether it found the article or not. Even if it says that
-it didn't find the article, it may have been posted anyway---mail
-propagation is much faster than news propagation, and the news copy may
-just not have arrived yet.
-
-@item K E
-@kindex K E (Summary)
-@findex gnus-article-encrypt-body
-@vindex gnus-article-encrypt-protocol
-Encrypt the body of an article (@code{gnus-article-encrypt-body}).
-The body is encrypted with the encryption protocol specified by the
-variable @code{gnus-article-encrypt-protocol}.
-
-@end table
-
-@vindex gnus-move-split-methods
-@cindex moving articles
-If you move (or copy) articles regularly, you might wish to have Gnus
-suggest where to put the articles. @code{gnus-move-split-methods} is a
-variable that uses the same syntax as @code{gnus-split-methods}
-(@pxref{Saving Articles}). You may customize that variable to create
-suggestions you find reasonable. (Note that
-@code{gnus-move-split-methods} uses group names where
-@code{gnus-split-methods} uses file names.)
-
-@lisp
-(setq gnus-move-split-methods
- '(("^From:.*Lars Magne" "nnml:junk")
- ("^Subject:.*gnus" "nnfolder:important")
- (".*" "nnml:misc")))
-@end lisp
-
-
-@node Various Summary Stuff
-@section Various Summary Stuff
-
-@menu
-* Summary Group Information:: Information oriented commands.
-* Searching for Articles:: Multiple article commands.
-* Summary Generation Commands::
-* Really Various Summary Commands:: Those pesky non-conformant commands.
-@end menu
-
-@table @code
-@vindex gnus-summary-display-while-building
-@item gnus-summary-display-while-building
-If non-@code{nil}, show and update the summary buffer as it's being
-built. If @code{t}, update the buffer after every line is inserted.
-If the value is an integer, @var{n}, update the display every @var{n}
-lines. The default is @code{nil}.
-
-@vindex gnus-summary-display-arrow
-@item gnus-summary-display-arrow
-If non-@code{nil}, display an arrow in the fringe to indicate the
-current article.
-
-@vindex gnus-summary-mode-hook
-@item gnus-summary-mode-hook
-This hook is called when creating a summary mode buffer.
-
-@vindex gnus-summary-generate-hook
-@item gnus-summary-generate-hook
-This is called as the last thing before doing the threading and the
-generation of the summary buffer. It's quite convenient for customizing
-the threading variables based on what data the newsgroup has. This hook
-is called from the summary buffer after most summary buffer variables
-have been set.
-
-@vindex gnus-summary-prepare-hook
-@item gnus-summary-prepare-hook
-It is called after the summary buffer has been generated. You might use
-it to, for instance, highlight lines or modify the look of the buffer in
-some other ungodly manner. I don't care.
-
-@vindex gnus-summary-prepared-hook
-@item gnus-summary-prepared-hook
-A hook called as the very last thing after the summary buffer has been
-generated.
-
-@vindex gnus-summary-ignore-duplicates
-@item gnus-summary-ignore-duplicates
-When Gnus discovers two articles that have the same @code{Message-ID},
-it has to do something drastic. No articles are allowed to have the
-same @code{Message-ID}, but this may happen when reading mail from some
-sources. Gnus allows you to customize what happens with this variable.
-If it is @code{nil} (which is the default), Gnus will rename the
-@code{Message-ID} (for display purposes only) and display the article as
-any other article. If this variable is @code{t}, it won't display the
-article---it'll be as if it never existed.
-
-@vindex gnus-alter-articles-to-read-function
-@item gnus-alter-articles-to-read-function
-This function, which takes two parameters (the group name and the list
-of articles to be selected), is called to allow the user to alter the
-list of articles to be selected.
-
-For instance, the following function adds the list of cached articles to
-the list in one particular group:
-
-@lisp
-(defun my-add-cached-articles (group articles)
- (if (string= group "some.group")
- (append gnus-newsgroup-cached articles)
- articles))
-@end lisp
-
-@vindex gnus-newsgroup-variables
-@item gnus-newsgroup-variables
-A list of newsgroup (summary buffer) local variables, or cons of
-variables and their default expressions to be evalled (when the default
-values are not @code{nil}), that should be made global while the summary
-buffer is active.
-
-Note: The default expressions will be evaluated (using function
-@code{eval}) before assignment to the local variable rather than just
-assigned to it. If the default expression is the symbol @code{global},
-that symbol will not be evaluated but the global value of the local
-variable will be used instead.
-
-These variables can be used to set variables in the group parameters
-while still allowing them to affect operations done in other
-buffers. For example:
-
-@lisp
-(setq gnus-newsgroup-variables
- '(message-use-followup-to
- (gnus-visible-headers .
- "^From:\\|^Newsgroups:\\|^Subject:\\|^Date:\\|^To:")))
-@end lisp
-
-Also @pxref{Group Parameters}.
-@end table
-
-
-@node Summary Group Information
-@subsection Summary Group Information
-
-@table @kbd
-
-@item H f
-@kindex H f (Summary)
-@findex gnus-summary-fetch-faq
-@vindex gnus-group-faq-directory
-Try to fetch the @acronym{FAQ} (list of frequently asked questions)
-for the current group (@code{gnus-summary-fetch-faq}). Gnus will try
-to get the @acronym{FAQ} from @code{gnus-group-faq-directory}, which
-is usually a directory on a remote machine. This variable can also be
-a list of directories. In that case, giving a prefix to this command
-will allow you to choose between the various sites. @code{ange-ftp}
-or @code{efs} will probably be used for fetching the file.
-
-@item H d
-@kindex H d (Summary)
-@findex gnus-summary-describe-group
-Give a brief description of the current group
-(@code{gnus-summary-describe-group}). If given a prefix, force
-rereading the description from the server.
-
-@item H h
-@kindex H h (Summary)
-@findex gnus-summary-describe-briefly
-Give an extremely brief description of the most important summary
-keystrokes (@code{gnus-summary-describe-briefly}).
-
-@item H i
-@kindex H i (Summary)
-@findex gnus-info-find-node
-Go to the Gnus info node (@code{gnus-info-find-node}).
-@end table
-
-
-@node Searching for Articles
-@subsection Searching for Articles
-
-@table @kbd
-
-@item M-s
-@kindex M-s (Summary)
-@findex gnus-summary-search-article-forward
-Search through all subsequent (raw) articles for a regexp
-(@code{gnus-summary-search-article-forward}).
-
-@item M-r
-@kindex M-r (Summary)
-@findex gnus-summary-search-article-backward
-Search through all previous (raw) articles for a regexp
-(@code{gnus-summary-search-article-backward}).
-
-@item &
-@kindex & (Summary)
-@findex gnus-summary-execute-command
-This command will prompt you for a header, a regular expression to match
-on this field, and a command to be executed if the match is made
-(@code{gnus-summary-execute-command}). If the header is an empty
-string, the match is done on the entire article. If given a prefix,
-search backward instead.
-
-For instance, @kbd{& RET some.*string RET #} will put the process mark on
-all articles that have heads or bodies that match @samp{some.*string}.
-
-@item M-&
-@kindex M-& (Summary)
-@findex gnus-summary-universal-argument
-Perform any operation on all articles that have been marked with
-the process mark (@code{gnus-summary-universal-argument}).
-@end table
-
-@node Summary Generation Commands
-@subsection Summary Generation Commands
-
-@table @kbd
-
-@item Y g
-@kindex Y g (Summary)
-@findex gnus-summary-prepare
-Regenerate the current summary buffer (@code{gnus-summary-prepare}).
-
-@item Y c
-@kindex Y c (Summary)
-@findex gnus-summary-insert-cached-articles
-Pull all cached articles (for the current group) into the summary buffer
-(@code{gnus-summary-insert-cached-articles}).
-
-@item Y d
-@kindex Y d (Summary)
-@findex gnus-summary-insert-dormant-articles
-Pull all dormant articles (for the current group) into the summary buffer
-(@code{gnus-summary-insert-dormant-articles}).
-
-@end table
-
-
-@node Really Various Summary Commands
-@subsection Really Various Summary Commands
-
-@table @kbd
-
-@item A D
-@itemx C-d
-@kindex C-d (Summary)
-@kindex A D (Summary)
-@findex gnus-summary-enter-digest-group
-If the current article is a collection of other articles (for instance,
-a digest), you might use this command to enter a group based on the that
-article (@code{gnus-summary-enter-digest-group}). Gnus will try to
-guess what article type is currently displayed unless you give a prefix
-to this command, which forces a ``digest'' interpretation. Basically,
-whenever you see a message that is a collection of other messages of
-some format, you @kbd{C-d} and read these messages in a more convenient
-fashion.
-
-@item C-M-d
-@kindex C-M-d (Summary)
-@findex gnus-summary-read-document
-This command is very similar to the one above, but lets you gather
-several documents into one biiig group
-(@code{gnus-summary-read-document}). It does this by opening several
-@code{nndoc} groups for each document, and then opening an
-@code{nnvirtual} group on top of these @code{nndoc} groups. This
-command understands the process/prefix convention
-(@pxref{Process/Prefix}).
-
-@item C-t
-@kindex C-t (Summary)
-@findex gnus-summary-toggle-truncation
-Toggle truncation of summary lines
-(@code{gnus-summary-toggle-truncation}). This will probably confuse the
-line centering function in the summary buffer, so it's not a good idea
-to have truncation switched off while reading articles.
-
-@item =
-@kindex = (Summary)
-@findex gnus-summary-expand-window
-Expand the summary buffer window (@code{gnus-summary-expand-window}).
-If given a prefix, force an @code{article} window configuration.
-
-@item C-M-e
-@kindex C-M-e (Summary)
-@findex gnus-summary-edit-parameters
-Edit the group parameters (@pxref{Group Parameters}) of the current
-group (@code{gnus-summary-edit-parameters}).
-
-@item C-M-a
-@kindex C-M-a (Summary)
-@findex gnus-summary-customize-parameters
-Customize the group parameters (@pxref{Group Parameters}) of the current
-group (@code{gnus-summary-customize-parameters}).
-
-@end table
-
-
-@node Exiting the Summary Buffer
-@section Exiting the Summary Buffer
-@cindex summary exit
-@cindex exiting groups
-
-Exiting from the summary buffer will normally update all info on the
-group and return you to the group buffer.
-
-@table @kbd
-
-@item Z Z
-@itemx Z Q
-@itemx q
-@kindex Z Z (Summary)
-@kindex Z Q (Summary)
-@kindex q (Summary)
-@findex gnus-summary-exit
-@vindex gnus-summary-exit-hook
-@vindex gnus-summary-prepare-exit-hook
-@vindex gnus-group-no-more-groups-hook
-@c @icon{gnus-summary-exit}
-Exit the current group and update all information on the group
-(@code{gnus-summary-exit}). @code{gnus-summary-prepare-exit-hook} is
-called before doing much of the exiting, which calls
-@code{gnus-summary-expire-articles} by default.
-@code{gnus-summary-exit-hook} is called after finishing the exit
-process. @code{gnus-group-no-more-groups-hook} is run when returning to
-group mode having no more (unread) groups.
-
-@item Z E
-@itemx Q
-@kindex Z E (Summary)
-@kindex Q (Summary)
-@findex gnus-summary-exit-no-update
-Exit the current group without updating any information on the group
-(@code{gnus-summary-exit-no-update}).
-
-@item Z c
-@itemx c
-@kindex Z c (Summary)
-@kindex c (Summary)
-@findex gnus-summary-catchup-and-exit
-@c @icon{gnus-summary-catchup-and-exit}
-Mark all unticked articles in the group as read and then exit
-(@code{gnus-summary-catchup-and-exit}).
-
-@item Z C
-@kindex Z C (Summary)
-@findex gnus-summary-catchup-all-and-exit
-Mark all articles, even the ticked ones, as read and then exit
-(@code{gnus-summary-catchup-all-and-exit}).
-
-@item Z n
-@kindex Z n (Summary)
-@findex gnus-summary-catchup-and-goto-next-group
-Mark all articles as read and go to the next group
-(@code{gnus-summary-catchup-and-goto-next-group}).
-
-@item Z R
-@itemx C-x C-s
-@kindex Z R (Summary)
-@kindex C-x C-s (Summary)
-@findex gnus-summary-reselect-current-group
-Exit this group, and then enter it again
-(@code{gnus-summary-reselect-current-group}). If given a prefix, select
-all articles, both read and unread.
-
-@item Z G
-@itemx M-g
-@kindex Z G (Summary)
-@kindex M-g (Summary)
-@findex gnus-summary-rescan-group
-@c @icon{gnus-summary-mail-get}
-Exit the group, check for new articles in the group, and select the
-group (@code{gnus-summary-rescan-group}). If given a prefix, select all
-articles, both read and unread.
-
-@item Z N
-@kindex Z N (Summary)
-@findex gnus-summary-next-group
-Exit the group and go to the next group
-(@code{gnus-summary-next-group}).
-
-@item Z P
-@kindex Z P (Summary)
-@findex gnus-summary-prev-group
-Exit the group and go to the previous group
-(@code{gnus-summary-prev-group}).
-
-@item Z s
-@kindex Z s (Summary)
-@findex gnus-summary-save-newsrc
-Save the current number of read/marked articles in the dribble buffer
-and then save the dribble buffer (@code{gnus-summary-save-newsrc}). If
-given a prefix, also save the @file{.newsrc} file(s). Using this
-command will make exit without updating (the @kbd{Q} command) worthless.
-@end table
-
-@vindex gnus-exit-group-hook
-@code{gnus-exit-group-hook} is called when you exit the current group
-with an ``updating'' exit. For instance @kbd{Q}
-(@code{gnus-summary-exit-no-update}) does not call this hook.
-
-@findex gnus-summary-wake-up-the-dead
-@findex gnus-dead-summary-mode
-@vindex gnus-kill-summary-on-exit
-If you're in the habit of exiting groups, and then changing your mind
-about it, you might set @code{gnus-kill-summary-on-exit} to @code{nil}.
-If you do that, Gnus won't kill the summary buffer when you exit it.
-(Quelle surprise!) Instead it will change the name of the buffer to
-something like @samp{*Dead Summary ... *} and install a minor mode
-called @code{gnus-dead-summary-mode}. Now, if you switch back to this
-buffer, you'll find that all keys are mapped to a function called
-@code{gnus-summary-wake-up-the-dead}. So tapping any keys in a dead
-summary buffer will result in a live, normal summary buffer.
-
-There will never be more than one dead summary buffer at any one time.
-
-@vindex gnus-use-cross-reference
-The data on the current group will be updated (which articles you have
-read, which articles you have replied to, etc.) when you exit the
-summary buffer. If the @code{gnus-use-cross-reference} variable is
-@code{t} (which is the default), articles that are cross-referenced to
-this group and are marked as read, will also be marked as read in the
-other subscribed groups they were cross-posted to. If this variable is
-neither @code{nil} nor @code{t}, the article will be marked as read in
-both subscribed and unsubscribed groups (@pxref{Crosspost Handling}).
-
-
-@node Crosspost Handling
-@section Crosspost Handling
-
-@cindex velveeta
-@cindex spamming
-Marking cross-posted articles as read ensures that you'll never have to
-read the same article more than once. Unless, of course, somebody has
-posted it to several groups separately. Posting the same article to
-several groups (not cross-posting) is called @dfn{spamming}, and you are
-by law required to send nasty-grams to anyone who perpetrates such a
-heinous crime. You may want to try NoCeM handling to filter out spam
-(@pxref{NoCeM}).
-
-Remember: Cross-posting is kinda ok, but posting the same article
-separately to several groups is not. Massive cross-posting (aka.
-@dfn{velveeta}) is to be avoided at all costs, and you can even use the
-@code{gnus-summary-mail-crosspost-complaint} command to complain about
-excessive crossposting (@pxref{Summary Mail Commands}).
-
-@cindex cross-posting
-@cindex Xref
-@cindex @acronym{NOV}
-One thing that may cause Gnus to not do the cross-posting thing
-correctly is if you use an @acronym{NNTP} server that supports @sc{xover}
-(which is very nice, because it speeds things up considerably) which
-does not include the @code{Xref} header in its @acronym{NOV} lines. This is
-Evil, but all too common, alas, alack. Gnus tries to Do The Right Thing
-even with @sc{xover} by registering the @code{Xref} lines of all
-articles you actually read, but if you kill the articles, or just mark
-them as read without reading them, Gnus will not get a chance to snoop
-the @code{Xref} lines out of these articles, and will be unable to use
-the cross reference mechanism.
-
-@cindex LIST overview.fmt
-@cindex overview.fmt
-To check whether your @acronym{NNTP} server includes the @code{Xref} header
-in its overview files, try @samp{telnet your.nntp.server nntp},
-@samp{MODE READER} on @code{inn} servers, and then say @samp{LIST
-overview.fmt}. This may not work, but if it does, and the last line you
-get does not read @samp{Xref:full}, then you should shout and whine at
-your news admin until she includes the @code{Xref} header in the
-overview files.
-
-If you want Gnus to get the @code{Xref}s right all the time, you have to
-set @code{nntp-nov-is-evil} to @code{t}, which slows things down
-considerably. Also @pxref{Slow/Expensive Connection}.
-
-C'est la vie.
-
-For an alternative approach, @pxref{Duplicate Suppression}.
-
-
-@node Duplicate Suppression
-@section Duplicate Suppression
-
-By default, Gnus tries to make sure that you don't have to read the same
-article more than once by utilizing the crossposting mechanism
-(@pxref{Crosspost Handling}). However, that simple and efficient
-approach may not work satisfactory for some users for various
-reasons.
-
-@enumerate
-@item
-The @acronym{NNTP} server may fail to generate the @code{Xref} header. This
-is evil and not very common.
-
-@item
-The @acronym{NNTP} server may fail to include the @code{Xref} header in the
-@file{.overview} data bases. This is evil and all too common, alas.
-
-@item
-You may be reading the same group (or several related groups) from
-different @acronym{NNTP} servers.
-
-@item
-You may be getting mail that duplicates articles posted to groups.
-@end enumerate
-
-I'm sure there are other situations where @code{Xref} handling fails as
-well, but these four are the most common situations.
-
-If, and only if, @code{Xref} handling fails for you, then you may
-consider switching on @dfn{duplicate suppression}. If you do so, Gnus
-will remember the @code{Message-ID}s of all articles you have read or
-otherwise marked as read, and then, as if by magic, mark them as read
-all subsequent times you see them---in @emph{all} groups. Using this
-mechanism is quite likely to be somewhat inefficient, but not overly
-so. It's certainly preferable to reading the same articles more than
-once.
-
-Duplicate suppression is not a very subtle instrument. It's more like a
-sledge hammer than anything else. It works in a very simple
-fashion---if you have marked an article as read, it adds this Message-ID
-to a cache. The next time it sees this Message-ID, it will mark the
-article as read with the @samp{M} mark. It doesn't care what group it
-saw the article in.
-
-@table @code
-@item gnus-suppress-duplicates
-@vindex gnus-suppress-duplicates
-If non-@code{nil}, suppress duplicates.
-
-@item gnus-save-duplicate-list
-@vindex gnus-save-duplicate-list
-If non-@code{nil}, save the list of duplicates to a file. This will
-make startup and shutdown take longer, so the default is @code{nil}.
-However, this means that only duplicate articles read in a single Gnus
-session are suppressed.
-
-@item gnus-duplicate-list-length
-@vindex gnus-duplicate-list-length
-This variable says how many @code{Message-ID}s to keep in the duplicate
-suppression list. The default is 10000.
-
-@item gnus-duplicate-file
-@vindex gnus-duplicate-file
-The name of the file to store the duplicate suppression list in. The
-default is @file{~/News/suppression}.
-@end table
-
-If you have a tendency to stop and start Gnus often, setting
-@code{gnus-save-duplicate-list} to @code{t} is probably a good idea. If
-you leave Gnus running for weeks on end, you may have it @code{nil}. On
-the other hand, saving the list makes startup and shutdown much slower,
-so that means that if you stop and start Gnus often, you should set
-@code{gnus-save-duplicate-list} to @code{nil}. Uhm. I'll leave this up
-to you to figure out, I think.
-
-@node Security
-@section Security
-
-Gnus is able to verify signed messages or decrypt encrypted messages.
-The formats that are supported are @acronym{PGP}, @acronym{PGP/MIME}
-and @acronym{S/MIME}, however you need some external programs to get
-things to work:
-
-@enumerate
-@item
-To handle @acronym{PGP} and @acronym{PGP/MIME} messages, you have to
-install an OpenPGP implementation such as GnuPG. The Lisp interface
-to GnuPG included with Gnus is called PGG (@pxref{Top, ,PGG, pgg, PGG
-Manual}), but Mailcrypt and gpg.el are also supported.
-
-@item
-To handle @acronym{S/MIME} message, you need to install OpenSSL. OpenSSL 0.9.6
-or newer is recommended.
-
-@end enumerate
-
-The variables that control security functionality on reading messages
-include:
-
-@table @code
-@item mm-verify-option
-@vindex mm-verify-option
-Option of verifying signed parts. @code{never}, not verify;
-@code{always}, always verify; @code{known}, only verify known
-protocols. Otherwise, ask user.
-
-@item mm-decrypt-option
-@vindex mm-decrypt-option
-Option of decrypting encrypted parts. @code{never}, no decryption;
-@code{always}, always decrypt; @code{known}, only decrypt known
-protocols. Otherwise, ask user.
-
-@item mml1991-use
-@vindex mml1991-use
-Symbol indicating elisp interface to OpenPGP implementation for
-@acronym{PGP} messages. The default is @code{pgg}, but
-@code{mailcrypt} and @code{gpg} are also supported although
-deprecated.
-
-@item mml2015-use
-@vindex mml2015-use
-Symbol indicating elisp interface to OpenPGP implementation for
-@acronym{PGP/MIME} messages. The default is @code{pgg}, but
-@code{mailcrypt} and @code{gpg} are also supported although
-deprecated.
-
-@end table
-
-By default the buttons that display security information are not
-shown, because they clutter reading the actual e-mail. You can type
-@kbd{K b} manually to display the information. Use the
-@code{gnus-buttonized-mime-types} and
-@code{gnus-unbuttonized-mime-types} variables to control this
-permanently. @ref{MIME Commands} for further details, and hints on
-how to customize these variables to always display security
-information.
-
-@cindex snarfing keys
-@cindex importing PGP keys
-@cindex PGP key ring import
-Snarfing OpenPGP keys (i.e., importing keys from articles into your
-key ring) is not supported explicitly through a menu item or command,
-rather Gnus do detect and label keys as @samp{application/pgp-keys},
-allowing you to specify whatever action you think is appropriate
-through the usual @acronym{MIME} infrastructure. You can use a
-@file{~/.mailcap} entry (@pxref{mailcap, , mailcap, emacs-mime, The
-Emacs MIME Manual}) such as the following to import keys using GNU
-Privacy Guard when you click on the @acronym{MIME} button
-(@pxref{Using MIME}).
-
-@example
-application/pgp-keys; gpg --import --interactive --verbose; needsterminal
-@end example
-@noindent
-This happens to also be the default action defined in
-@code{mailcap-mime-data}.
-
-More information on how to set things for sending outgoing signed and
-encrypted messages up can be found in the message manual
-(@pxref{Security, ,Security, message, Message Manual}).
-
-@node Mailing List
-@section Mailing List
-@cindex mailing list
-@cindex RFC 2396
-
-@kindex A M (summary)
-@findex gnus-mailing-list-insinuate
-Gnus understands some mailing list fields of RFC 2369. To enable it,
-add a @code{to-list} group parameter (@pxref{Group Parameters}),
-possibly using @kbd{A M} (@code{gnus-mailing-list-insinuate}) in the
-summary buffer.
-
-That enables the following commands to the summary buffer:
-
-@table @kbd
-
-@item C-c C-n h
-@kindex C-c C-n h (Summary)
-@findex gnus-mailing-list-help
-Send a message to fetch mailing list help, if List-Help field exists.
-
-@item C-c C-n s
-@kindex C-c C-n s (Summary)
-@findex gnus-mailing-list-subscribe
-Send a message to subscribe the mailing list, if List-Subscribe field exists.
-
-@item C-c C-n u
-@kindex C-c C-n u (Summary)
-@findex gnus-mailing-list-unsubscribe
-Send a message to unsubscribe the mailing list, if List-Unsubscribe
-field exists.
-
-@item C-c C-n p
-@kindex C-c C-n p (Summary)
-@findex gnus-mailing-list-post
-Post to the mailing list, if List-Post field exists.
-
-@item C-c C-n o
-@kindex C-c C-n o (Summary)
-@findex gnus-mailing-list-owner
-Send a message to the mailing list owner, if List-Owner field exists.
-
-@item C-c C-n a
-@kindex C-c C-n a (Summary)
-@findex gnus-mailing-list-owner
-Browse the mailing list archive, if List-Archive field exists.
-
-@end table
-
-
-@node Article Buffer
-@chapter Article Buffer
-@cindex article buffer
-
-The articles are displayed in the article buffer, of which there is only
-one. All the summary buffers share the same article buffer unless you
-tell Gnus otherwise.
-
-@menu
-* Hiding Headers:: Deciding what headers should be displayed.
-* Using MIME:: Pushing articles through @acronym{MIME} before reading them.
-* Customizing Articles:: Tailoring the look of the articles.
-* Article Keymap:: Keystrokes available in the article buffer.
-* Misc Article:: Other stuff.
-@end menu
-
-
-@node Hiding Headers
-@section Hiding Headers
-@cindex hiding headers
-@cindex deleting headers
-
-The top section of each article is the @dfn{head}. (The rest is the
-@dfn{body}, but you may have guessed that already.)
-
-@vindex gnus-show-all-headers
-There is a lot of useful information in the head: the name of the person
-who wrote the article, the date it was written and the subject of the
-article. That's well and nice, but there's also lots of information
-most people do not want to see---what systems the article has passed
-through before reaching you, the @code{Message-ID}, the
-@code{References}, etc. ad nauseam---and you'll probably want to get rid
-of some of those lines. If you want to keep all those lines in the
-article buffer, you can set @code{gnus-show-all-headers} to @code{t}.
-
-Gnus provides you with two variables for sifting headers:
-
-@table @code
-
-@item gnus-visible-headers
-@vindex gnus-visible-headers
-If this variable is non-@code{nil}, it should be a regular expression
-that says what headers you wish to keep in the article buffer. All
-headers that do not match this variable will be hidden.
-
-For instance, if you only want to see the name of the person who wrote
-the article and the subject, you'd say:
-
-@lisp
-(setq gnus-visible-headers "^From:\\|^Subject:")
-@end lisp
-
-This variable can also be a list of regexps to match headers to
-remain visible.
-
-@item gnus-ignored-headers
-@vindex gnus-ignored-headers
-This variable is the reverse of @code{gnus-visible-headers}. If this
-variable is set (and @code{gnus-visible-headers} is @code{nil}), it
-should be a regular expression that matches all lines that you want to
-hide. All lines that do not match this variable will remain visible.
-
-For instance, if you just want to get rid of the @code{References} line
-and the @code{Xref} line, you might say:
-
-@lisp
-(setq gnus-ignored-headers "^References:\\|^Xref:")
-@end lisp
-
-This variable can also be a list of regexps to match headers to
-be removed.
-
-Note that if @code{gnus-visible-headers} is non-@code{nil}, this
-variable will have no effect.
-
-@end table
-
-@vindex gnus-sorted-header-list
-Gnus can also sort the headers for you. (It does this by default.) You
-can control the sorting by setting the @code{gnus-sorted-header-list}
-variable. It is a list of regular expressions that says in what order
-the headers are to be displayed.
-
-For instance, if you want the name of the author of the article first,
-and then the subject, you might say something like:
-
-@lisp
-(setq gnus-sorted-header-list '("^From:" "^Subject:"))
-@end lisp
-
-Any headers that are to remain visible, but are not listed in this
-variable, will be displayed in random order after all the headers listed in this variable.
-
-@findex gnus-article-hide-boring-headers
-@vindex gnus-boring-article-headers
-You can hide further boring headers by setting
-@code{gnus-treat-hide-boring-headers} to @code{head}. What this function
-does depends on the @code{gnus-boring-article-headers} variable. It's a
-list, but this list doesn't actually contain header names. Instead it
-lists various @dfn{boring conditions} that Gnus can check and remove
-from sight.
-
-These conditions are:
-@table @code
-@item empty
-Remove all empty headers.
-@item followup-to
-Remove the @code{Followup-To} header if it is identical to the
-@code{Newsgroups} header.
-@item reply-to
-Remove the @code{Reply-To} header if it lists the same addresses as
-the @code{From} header, or if the @code{broken-reply-to} group
-parameter is set.
-@item newsgroups
-Remove the @code{Newsgroups} header if it only contains the current group
-name.
-@item to-address
-Remove the @code{To} header if it only contains the address identical to
-the current group's @code{to-address} parameter.
-@item to-list
-Remove the @code{To} header if it only contains the address identical to
-the current group's @code{to-list} parameter.
-@item cc-list
-Remove the @code{Cc} header if it only contains the address identical to
-the current group's @code{to-list} parameter.
-@item date
-Remove the @code{Date} header if the article is less than three days
-old.
-@item long-to
-Remove the @code{To} and/or @code{Cc} header if it is very long.
-@item many-to
-Remove all @code{To} and/or @code{Cc} headers if there are more than one.
-@end table
-
-To include these three elements, you could say something like:
-
-@lisp
-(setq gnus-boring-article-headers
- '(empty followup-to reply-to))
-@end lisp
-
-This is also the default value for this variable.
-
-
-@node Using MIME
-@section Using MIME
-@cindex @acronym{MIME}
-
-Mime is a standard for waving your hands through the air, aimlessly,
-while people stand around yawning.
-
-@acronym{MIME}, however, is a standard for encoding your articles, aimlessly,
-while all newsreaders die of fear.
-
-@acronym{MIME} may specify what character set the article uses, the encoding
-of the characters, and it also makes it possible to embed pictures and
-other naughty stuff in innocent-looking articles.
-
-@vindex gnus-display-mime-function
-@findex gnus-display-mime
-Gnus pushes @acronym{MIME} articles through @code{gnus-display-mime-function}
-to display the @acronym{MIME} parts. This is @code{gnus-display-mime} by
-default, which creates a bundle of clickable buttons that can be used to
-display, save and manipulate the @acronym{MIME} objects.
-
-The following commands are available when you have placed point over a
-@acronym{MIME} button:
-
-@table @kbd
-@findex gnus-article-press-button
-@item RET (Article)
-@kindex RET (Article)
-@itemx BUTTON-2 (Article)
-Toggle displaying of the @acronym{MIME} object
-(@code{gnus-article-press-button}). If built-in viewers can not display
-the object, Gnus resorts to external viewers in the @file{mailcap}
-files. If a viewer has the @samp{copiousoutput} specification, the
-object is displayed inline.
-
-@findex gnus-mime-view-part
-@item M-RET (Article)
-@kindex M-RET (Article)
-@itemx v (Article)
-Prompt for a method, and then view the @acronym{MIME} object using this
-method (@code{gnus-mime-view-part}).
-
-@findex gnus-mime-view-part-as-type
-@item t (Article)
-@kindex t (Article)
-View the @acronym{MIME} object as if it were a different @acronym{MIME} media type
-(@code{gnus-mime-view-part-as-type}).
-
-@findex gnus-mime-view-part-as-charset
-@item C (Article)
-@kindex C (Article)
-Prompt for a charset, and then view the @acronym{MIME} object using this
-charset (@code{gnus-mime-view-part-as-charset}).
-
-@findex gnus-mime-save-part
-@item o (Article)
-@kindex o (Article)
-Prompt for a file name, and then save the @acronym{MIME} object
-(@code{gnus-mime-save-part}).
-
-@findex gnus-mime-save-part-and-strip
-@item C-o (Article)
-@kindex C-o (Article)
-Prompt for a file name, then save the @acronym{MIME} object and strip it from
-the article. Then proceed to article editing, where a reasonable
-suggestion is being made on how the altered article should look
-like. The stripped @acronym{MIME} object will be referred via the
-message/external-body @acronym{MIME} type.
-(@code{gnus-mime-save-part-and-strip}).
-
-@findex gnus-mime-delete-part
-@item d (Article)
-@kindex d (Article)
-Delete the @acronym{MIME} object from the article and replace it with some
-information about the removed @acronym{MIME} object
-(@code{gnus-mime-delete-part}).
-
-@findex gnus-mime-copy-part
-@item c (Article)
-@kindex c (Article)
-Copy the @acronym{MIME} object to a fresh buffer and display this buffer
-(@code{gnus-mime-copy-part}). Compressed files like @file{.gz} and
-@file{.bz2} are automatically decompressed if
-@code{auto-compression-mode} is enabled (@pxref{Compressed Files,,
-Accessing Compressed Files, emacs, The Emacs Editor}).
-
-@findex gnus-mime-print-part
-@item p (Article)
-@kindex p (Article)
-Print the @acronym{MIME} object (@code{gnus-mime-print-part}). This
-command respects the @samp{print=} specifications in the
-@file{.mailcap} file.
-
-@findex gnus-mime-inline-part
-@item i (Article)
-@kindex i (Article)
-Insert the contents of the @acronym{MIME} object into the buffer
-(@code{gnus-mime-inline-part}) as @samp{text/plain}. If given a prefix, insert
-the raw contents without decoding. If given a numerical prefix, you can
-do semi-manual charset stuff (see
-@code{gnus-summary-show-article-charset-alist} in @ref{Paging the
-Article}).
-
-@findex gnus-mime-view-part-internally
-@item E (Article)
-@kindex E (Article)
-View the @acronym{MIME} object with an internal viewer. If no internal
-viewer is available, use an external viewer
-(@code{gnus-mime-view-part-internally}).
-
-@findex gnus-mime-view-part-externally
-@item e (Article)
-@kindex e (Article)
-View the @acronym{MIME} object with an external viewer.
-(@code{gnus-mime-view-part-externally}).
-
-@findex gnus-mime-pipe-part
-@item | (Article)
-@kindex | (Article)
-Output the @acronym{MIME} object to a process (@code{gnus-mime-pipe-part}).
-
-@findex gnus-mime-action-on-part
-@item . (Article)
-@kindex . (Article)
-Interactively run an action on the @acronym{MIME} object
-(@code{gnus-mime-action-on-part}).
-
-@end table
-
-Gnus will display some @acronym{MIME} objects automatically. The way Gnus
-determines which parts to do this with is described in the Emacs
-@acronym{MIME} manual.
-
-It might be best to just use the toggling functions from the article
-buffer to avoid getting nasty surprises. (For instance, you enter the
-group @samp{alt.sing-a-long} and, before you know it, @acronym{MIME} has
-decoded the sound file in the article and some horrible sing-a-long song
-comes screaming out your speakers, and you can't find the volume button,
-because there isn't one, and people are starting to look at you, and you
-try to stop the program, but you can't, and you can't find the program
-to control the volume, and everybody else in the room suddenly decides
-to look at you disdainfully, and you'll feel rather stupid.)
-
-Any similarity to real events and people is purely coincidental. Ahem.
-
-Also @pxref{MIME Commands}.
-
-
-@node Customizing Articles
-@section Customizing Articles
-@cindex article customization
-
-A slew of functions for customizing how the articles are to look like
-exist. You can call these functions interactively
-(@pxref{Article Washing}), or you can have them
-called automatically when you select the articles.
-
-To have them called automatically, you should set the corresponding
-``treatment'' variable. For instance, to have headers hidden, you'd set
-@code{gnus-treat-hide-headers}. Below is a list of variables that can
-be set, but first we discuss the values these variables can have.
-
-Note: Some values, while valid, make little sense. Check the list below
-for sensible values.
-
-@enumerate
-@item
-@code{nil}: Don't do this treatment.
-
-@item
-@code{t}: Do this treatment on all body parts.
-
-@item
-@code{head}: Do the treatment on the headers.
-
-@item
-@code{last}: Do this treatment on the last part.
-
-@item
-An integer: Do this treatment on all body parts that have a length less
-than this number.
-
-@item
-A list of strings: Do this treatment on all body parts that are in
-articles that are read in groups that have names that match one of the
-regexps in the list.
-
-@item
-A list where the first element is not a string:
-
-The list is evaluated recursively. The first element of the list is a
-predicate. The following predicates are recognized: @code{or},
-@code{and}, @code{not} and @code{typep}. Here's an example:
-
-@lisp
-(or last
- (typep "text/x-vcard"))
-@end lisp
-
-@end enumerate
-
-You may have noticed that the word @dfn{part} is used here. This refers
-to the fact that some messages are @acronym{MIME} multipart articles that may
-be divided into several parts. Articles that are not multiparts are
-considered to contain just a single part.
-
-@vindex gnus-article-treat-types
-Are the treatments applied to all sorts of multipart parts? Yes, if you
-want to, but by default, only @samp{text/plain} parts are given the
-treatment. This is controlled by the @code{gnus-article-treat-types}
-variable, which is a list of regular expressions that are matched to the
-type of the part. This variable is ignored if the value of the
-controlling variable is a predicate list, as described above.
-
-@ifinfo
-@c Avoid sort of redundant entries in the same section for the printed
-@c manual, but add them in info to allow `i gnus-treat-foo-bar RET' or
-@c `i foo-bar'.
-@vindex gnus-treat-buttonize
-@vindex gnus-treat-buttonize-head
-@vindex gnus-treat-capitalize-sentences
-@vindex gnus-treat-overstrike
-@vindex gnus-treat-strip-cr
-@vindex gnus-treat-strip-headers-in-body
-@vindex gnus-treat-strip-leading-blank-lines
-@vindex gnus-treat-strip-multiple-blank-lines
-@vindex gnus-treat-strip-pem
-@vindex gnus-treat-strip-trailing-blank-lines
-@vindex gnus-treat-unsplit-urls
-@vindex gnus-treat-wash-html
-@vindex gnus-treat-date-english
-@vindex gnus-treat-date-iso8601
-@vindex gnus-treat-date-lapsed
-@vindex gnus-treat-date-local
-@vindex gnus-treat-date-original
-@vindex gnus-treat-date-user-defined
-@vindex gnus-treat-date-ut
-@vindex gnus-treat-from-picon
-@vindex gnus-treat-mail-picon
-@vindex gnus-treat-newsgroups-picon
-@vindex gnus-treat-display-smileys
-@vindex gnus-treat-body-boundary
-@vindex gnus-treat-display-x-face
-@vindex gnus-treat-display-face
-@vindex gnus-treat-emphasize
-@vindex gnus-treat-fill-article
-@vindex gnus-treat-fill-long-lines
-@vindex gnus-treat-hide-boring-headers
-@vindex gnus-treat-hide-citation
-@vindex gnus-treat-hide-citation-maybe
-@vindex gnus-treat-hide-headers
-@vindex gnus-treat-hide-signature
-@vindex gnus-treat-strip-banner
-@vindex gnus-treat-strip-list-identifiers
-@vindex gnus-treat-highlight-citation
-@vindex gnus-treat-highlight-headers
-@vindex gnus-treat-highlight-signature
-@vindex gnus-treat-play-sounds
-@vindex gnus-treat-translate
-@vindex gnus-treat-x-pgp-sig
-@vindex gnus-treat-unfold-headers
-@vindex gnus-treat-fold-headers
-@vindex gnus-treat-fold-newsgroups
-@vindex gnus-treat-leading-whitespace
-@end ifinfo
-
-The following treatment options are available. The easiest way to
-customize this is to examine the @code{gnus-article-treat} customization
-group. Values in parenthesis are suggested sensible values. Others are
-possible but those listed are probably sufficient for most people.
-
-@table @code
-@item gnus-treat-buttonize (t, integer)
-@item gnus-treat-buttonize-head (head)
-
-@xref{Article Buttons}.
-
-@item gnus-treat-capitalize-sentences (t, integer)
-@item gnus-treat-overstrike (t, integer)
-@item gnus-treat-strip-cr (t, integer)
-@item gnus-treat-strip-headers-in-body (t, integer)
-@item gnus-treat-strip-leading-blank-lines (t, integer)
-@item gnus-treat-strip-multiple-blank-lines (t, integer)
-@item gnus-treat-strip-pem (t, last, integer)
-@item gnus-treat-strip-trailing-blank-lines (t, last, integer)
-@item gnus-treat-unsplit-urls (t, integer)
-@item gnus-treat-wash-html (t, integer)
-
-@xref{Article Washing}.
-
-@item gnus-treat-date-english (head)
-@item gnus-treat-date-iso8601 (head)
-@item gnus-treat-date-lapsed (head)
-@item gnus-treat-date-local (head)
-@item gnus-treat-date-original (head)
-@item gnus-treat-date-user-defined (head)
-@item gnus-treat-date-ut (head)
-
-@xref{Article Date}.
-
-@item gnus-treat-from-picon (head)
-@item gnus-treat-mail-picon (head)
-@item gnus-treat-newsgroups-picon (head)
-
-@xref{Picons}.
-
-@item gnus-treat-display-smileys (t, integer)
-
-@item gnus-treat-body-boundary (head)
-
-@vindex gnus-body-boundary-delimiter
-Adds a delimiter between header and body, the string used as delimiter
-is controlled by @code{gnus-body-boundary-delimiter}.
-
-@xref{Smileys}.
-
-@vindex gnus-treat-display-x-face
-@item gnus-treat-display-x-face (head)
-
-@xref{X-Face}.
-
-@vindex gnus-treat-display-face
-@item gnus-treat-display-face (head)
-
-@xref{Face}.
-
-@vindex gnus-treat-emphasize
-@item gnus-treat-emphasize (t, head, integer)
-@vindex gnus-treat-fill-article
-@item gnus-treat-fill-article (t, integer)
-@vindex gnus-treat-fill-long-lines
-@item gnus-treat-fill-long-lines (t, integer)
-@vindex gnus-treat-hide-boring-headers
-@item gnus-treat-hide-boring-headers (head)
-@vindex gnus-treat-hide-citation
-@item gnus-treat-hide-citation (t, integer)
-@vindex gnus-treat-hide-citation-maybe
-@item gnus-treat-hide-citation-maybe (t, integer)
-@vindex gnus-treat-hide-headers
-@item gnus-treat-hide-headers (head)
-@vindex gnus-treat-hide-signature
-@item gnus-treat-hide-signature (t, last)
-@vindex gnus-treat-strip-banner
-@item gnus-treat-strip-banner (t, last)
-@vindex gnus-treat-strip-list-identifiers
-@item gnus-treat-strip-list-identifiers (head)
-
-@xref{Article Hiding}.
-
-@vindex gnus-treat-highlight-citation
-@item gnus-treat-highlight-citation (t, integer)
-@vindex gnus-treat-highlight-headers
-@item gnus-treat-highlight-headers (head)
-@vindex gnus-treat-highlight-signature
-@item gnus-treat-highlight-signature (t, last, integer)
-
-@xref{Article Highlighting}.
-
-@vindex gnus-treat-play-sounds
-@item gnus-treat-play-sounds
-@vindex gnus-treat-translate
-@item gnus-treat-translate
-@vindex gnus-treat-x-pgp-sig
-@item gnus-treat-x-pgp-sig (head)
-
-@vindex gnus-treat-unfold-headers
-@item gnus-treat-unfold-headers (head)
-@vindex gnus-treat-fold-headers
-@item gnus-treat-fold-headers (head)
-@vindex gnus-treat-fold-newsgroups
-@item gnus-treat-fold-newsgroups (head)
-@vindex gnus-treat-leading-whitespace
-@item gnus-treat-leading-whitespace (head)
-
-@xref{Article Header}.
-
-
-@end table
-
-@vindex gnus-part-display-hook
-You can, of course, write your own functions to be called from
-@code{gnus-part-display-hook}. The functions are called narrowed to the
-part, and you can do anything you like, pretty much. There is no
-information that you have to keep in the buffer---you can change
-everything.
-
-
-@node Article Keymap
-@section Article Keymap
-
-Most of the keystrokes in the summary buffer can also be used in the
-article buffer. They should behave as if you typed them in the summary
-buffer, which means that you don't actually have to have a summary
-buffer displayed while reading. You can do it all from the article
-buffer.
-
-@kindex v (Article)
-@cindex keys, reserved for users (Article)
-The key @kbd{v} is reserved for users. You can bind it to some
-command or better use it as a prefix key.
-
-A few additional keystrokes are available:
-
-@table @kbd
-
-@item SPACE
-@kindex SPACE (Article)
-@findex gnus-article-next-page
-Scroll forwards one page (@code{gnus-article-next-page}).
-This is exactly the same as @kbd{h SPACE h}.
-
-@item DEL
-@kindex DEL (Article)
-@findex gnus-article-prev-page
-Scroll backwards one page (@code{gnus-article-prev-page}).
-This is exactly the same as @kbd{h DEL h}.
-
-@item C-c ^
-@kindex C-c ^ (Article)
-@findex gnus-article-refer-article
-If point is in the neighborhood of a @code{Message-ID} and you press
-@kbd{C-c ^}, Gnus will try to get that article from the server
-(@code{gnus-article-refer-article}).
-
-@item C-c C-m
-@kindex C-c C-m (Article)
-@findex gnus-article-mail
-Send a reply to the address near point (@code{gnus-article-mail}). If
-given a prefix, include the mail.
-
-@item s
-@kindex s (Article)
-@findex gnus-article-show-summary
-Reconfigure the buffers so that the summary buffer becomes visible
-(@code{gnus-article-show-summary}).
-
-@item ?
-@kindex ? (Article)
-@findex gnus-article-describe-briefly
-Give a very brief description of the available keystrokes
-(@code{gnus-article-describe-briefly}).
-
-@item TAB
-@kindex TAB (Article)
-@findex gnus-article-next-button
-Go to the next button, if any (@code{gnus-article-next-button}). This
-only makes sense if you have buttonizing turned on.
-
-@item M-TAB
-@kindex M-TAB (Article)
-@findex gnus-article-prev-button
-Go to the previous button, if any (@code{gnus-article-prev-button}).
-
-@item R
-@kindex R (Article)
-@findex gnus-article-reply-with-original
-Send a reply to the current article and yank the current article
-(@code{gnus-article-reply-with-original}). If given a prefix, make a
-wide reply. If the region is active, only yank the text in the
-region.
-
-@item F
-@kindex F (Article)
-@findex gnus-article-followup-with-original
-Send a followup to the current article and yank the current article
-(@code{gnus-article-followup-with-original}). If given a prefix, make
-a wide reply. If the region is active, only yank the text in the
-region.
-
-
-@end table
-
-
-@node Misc Article
-@section Misc Article
-
-@table @code
-
-@item gnus-single-article-buffer
-@vindex gnus-single-article-buffer
-@cindex article buffers, several
-If non-@code{nil}, use the same article buffer for all the groups.
-(This is the default.) If @code{nil}, each group will have its own
-article buffer.
-
-@vindex gnus-article-decode-hook
-@item gnus-article-decode-hook
-@cindex @acronym{MIME}
-Hook used to decode @acronym{MIME} articles. The default value is
-@code{(article-decode-charset article-decode-encoded-words)}
-
-@vindex gnus-article-prepare-hook
-@item gnus-article-prepare-hook
-This hook is called right after the article has been inserted into the
-article buffer. It is mainly intended for functions that do something
-depending on the contents; it should probably not be used for changing
-the contents of the article buffer.
-
-@item gnus-article-mode-hook
-@vindex gnus-article-mode-hook
-Hook called in article mode buffers.
-
-@item gnus-article-mode-syntax-table
-@vindex gnus-article-mode-syntax-table
-Syntax table used in article buffers. It is initialized from
-@code{text-mode-syntax-table}.
-
-@vindex gnus-article-over-scroll
-@item gnus-article-over-scroll
-If non-@code{nil}, allow scrolling the article buffer even when there
-no more new text to scroll in. The default is @code{nil}.
-
-@vindex gnus-article-mode-line-format
-@item gnus-article-mode-line-format
-This variable is a format string along the same lines as
-@code{gnus-summary-mode-line-format} (@pxref{Summary Buffer Mode
-Line}). It accepts the same format specifications as that variable,
-with two extensions:
-
-@table @samp
-
-@item w
-The @dfn{wash status} of the article. This is a short string with one
-character for each possible article wash operation that may have been
-performed. The characters and their meaning:
-
-@table @samp
-
-@item c
-Displayed when cited text may be hidden in the article buffer.
-
-@item h
-Displayed when headers are hidden in the article buffer.
-
-@item p
-Displayed when article is digitally signed or encrypted, and Gnus has
-hidden the security headers. (N.B. does not tell anything about
-security status, i.e. good or bad signature.)
-
-@item s
-Displayed when the signature has been hidden in the Article buffer.
-
-@item o
-Displayed when Gnus has treated overstrike characters in the article buffer.
-
-@item e
-Displayed when Gnus has treated emphasised strings in the article buffer.
-
-@end table
-
-@item m
-The number of @acronym{MIME} parts in the article.
-
-@end table
-
-@vindex gnus-break-pages
-
-@item gnus-break-pages
-Controls whether @dfn{page breaking} is to take place. If this variable
-is non-@code{nil}, the articles will be divided into pages whenever a
-page delimiter appears in the article. If this variable is @code{nil},
-paging will not be done.
-
-@item gnus-page-delimiter
-@vindex gnus-page-delimiter
-This is the delimiter mentioned above. By default, it is @samp{^L}
-(formfeed).
-
-@cindex IDNA
-@cindex internationalized domain names
-@vindex gnus-use-idna
-@item gnus-use-idna
-This variable controls whether Gnus performs IDNA decoding of
-internationalized domain names inside @samp{From}, @samp{To} and
-@samp{Cc} headers. This requires
-@uref{http://www.gnu.org/software/libidn/, GNU Libidn}, and this
-variable is only enabled if you have installed it.
-
-@end table
-
-
-@node Composing Messages
-@chapter Composing Messages
-@cindex composing messages
-@cindex messages
-@cindex mail
-@cindex sending mail
-@cindex reply
-@cindex followup
-@cindex post
-@cindex using gpg
-@cindex using s/mime
-@cindex using smime
-
-@kindex C-c C-c (Post)
-All commands for posting and mailing will put you in a message buffer
-where you can edit the article all you like, before you send the
-article by pressing @kbd{C-c C-c}. @xref{Top, , Overview, message,
-Message Manual}. Where the message will be posted/mailed to depends
-on your setup (@pxref{Posting Server}).
-
-@menu
-* Mail:: Mailing and replying.
-* Posting Server:: What server should you post and mail via?
-* POP before SMTP:: You cannot send a mail unless you read a mail.
-* Mail and Post:: Mailing and posting at the same time.
-* Archived Messages:: Where Gnus stores the messages you've sent.
-* Posting Styles:: An easier way to specify who you are.
-* Drafts:: Postponing messages and rejected messages.
-* Rejected Articles:: What happens if the server doesn't like your article?
-* Signing and encrypting:: How to compose secure messages.
-@end menu
-
-Also @pxref{Canceling and Superseding} for information on how to
-remove articles you shouldn't have posted.
-
-
-@node Mail
-@section Mail
-
-Variables for customizing outgoing mail:
-
-@table @code
-@item gnus-uu-digest-headers
-@vindex gnus-uu-digest-headers
-List of regexps to match headers included in digested messages. The
-headers will be included in the sequence they are matched. If
-@code{nil} include all headers.
-
-@item gnus-add-to-list
-@vindex gnus-add-to-list
-If non-@code{nil}, add a @code{to-list} group parameter to mail groups
-that have none when you do a @kbd{a}.
-
-@item gnus-confirm-mail-reply-to-news
-@vindex gnus-confirm-mail-reply-to-news
-If non-@code{nil}, Gnus will ask you for a confirmation when you are
-about to reply to news articles by mail. If it is @code{nil}, nothing
-interferes in what you want to do. This can also be a function
-receiving the group name as the only parameter which should return
-non-@code{nil} if a confirmation is needed, or a regular expression
-matching group names, where confirmation should be asked for.
-
-If you find yourself never wanting to reply to mail, but occasionally
-press @kbd{R} anyway, this variable might be for you.
-
-@item gnus-confirm-treat-mail-like-news
-@vindex gnus-confirm-treat-mail-like-news
-If non-@code{nil}, Gnus also requests confirmation according to
-@code{gnus-confirm-mail-reply-to-news} when replying to mail. This is
-useful for treating mailing lists like newsgroups.
-
-@end table
-
-
-@node Posting Server
-@section Posting Server
-
-When you press those magical @kbd{C-c C-c} keys to ship off your latest
-(extremely intelligent, of course) article, where does it go?
-
-Thank you for asking. I hate you.
-
-It can be quite complicated.
-
-@vindex gnus-post-method
-When posting news, Message usually invokes @code{message-send-news}
-(@pxref{News Variables, , News Variables, message, Message Manual}).
-Normally, Gnus will post using the same select method as you're
-reading from (which might be convenient if you're reading lots of
-groups from different private servers). However. If the server
-you're reading from doesn't allow posting, just reading, you probably
-want to use some other server to post your (extremely intelligent and
-fabulously interesting) articles. You can then set the
-@code{gnus-post-method} to some other method:
-
-@lisp
-(setq gnus-post-method '(nnspool ""))
-@end lisp
-
-Now, if you've done this, and then this server rejects your article, or
-this server is down, what do you do then? To override this variable you
-can use a non-zero prefix to the @kbd{C-c C-c} command to force using
-the ``current'' server, to get back the default behavior, for posting.
-
-If you give a zero prefix (i.e., @kbd{C-u 0 C-c C-c}) to that command,
-Gnus will prompt you for what method to use for posting.
-
-You can also set @code{gnus-post-method} to a list of select methods.
-If that's the case, Gnus will always prompt you for what method to use
-for posting.
-
-Finally, if you want to always post using the native select method,
-you can set this variable to @code{native}.
-
-When sending mail, Message invokes @code{message-send-mail-function}.
-The default function, @code{message-send-mail-with-sendmail}, pipes
-your article to the @code{sendmail} binary for further queuing and
-sending. When your local system is not configured for sending mail
-using @code{sendmail}, and you have access to a remote @acronym{SMTP}
-server, you can set @code{message-send-mail-function} to
-@code{smtpmail-send-it} and make sure to setup the @code{smtpmail}
-package correctly. An example:
-
-@lisp
-(setq message-send-mail-function 'smtpmail-send-it
- smtpmail-default-smtp-server "YOUR SMTP HOST")
-@end lisp
-
-To the thing similar to this, there is
-@code{message-smtpmail-send-it}. It is useful if your @acronym{ISP}
-requires the @acronym{POP}-before-@acronym{SMTP} authentication.
-@xref{POP before SMTP}.
-
-Other possible choices for @code{message-send-mail-function} includes
-@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail},
-and @code{feedmail-send-it}.
-
-@node POP before SMTP
-@section POP before SMTP
-@cindex pop before smtp
-@findex message-smtpmail-send-it
-@findex mail-source-touch-pop
-
-Does your @acronym{ISP} require the @acronym{POP}-before-@acronym{SMTP}
-authentication? It is whether you need to connect to the @acronym{POP}
-mail server within a certain time before sending mails. If so, there is
-a convenient way. To do that, put the following lines in your
-@file{~/.gnus.el} file:
-
-@lisp
-(setq message-send-mail-function 'message-smtpmail-send-it)
-(add-hook 'message-send-mail-hook 'mail-source-touch-pop)
-@end lisp
-
-@noindent
-It means to let Gnus connect to the @acronym{POP} mail server in advance
-whenever you send a mail. The @code{mail-source-touch-pop} function
-does only a @acronym{POP} authentication according to the value of
-@code{mail-sources} without fetching mails, just before sending a mail.
-Note that you have to use @code{message-smtpmail-send-it} which runs
-@code{message-send-mail-hook} rather than @code{smtpmail-send-it} and
-set the value of @code{mail-sources} for a @acronym{POP} connection
-correctly. @xref{Mail Sources}.
-
-If you have two or more @acronym{POP} mail servers set in
-@code{mail-sources}, you may want to specify one of them to
-@code{mail-source-primary-source} as the @acronym{POP} mail server to be
-used for the @acronym{POP}-before-@acronym{SMTP} authentication. If it
-is your primary @acronym{POP} mail server (i.e., you are fetching mails
-mainly from that server), you can set it permanently as follows:
-
-@lisp
-(setq mail-source-primary-source
- '(pop :server "pop3.mail.server"
- :password "secret"))
-@end lisp
-
-@noindent
-Otherwise, bind it dynamically only when performing the
-@acronym{POP}-before-@acronym{SMTP} authentication as follows:
-
-@lisp
-(add-hook 'message-send-mail-hook
- (lambda ()
- (let ((mail-source-primary-source
- '(pop :server "pop3.mail.server"
- :password "secret")))
- (mail-source-touch-pop))))
-@end lisp
-
-@node Mail and Post
-@section Mail and Post
-
-Here's a list of variables relevant to both mailing and
-posting:
-
-@table @code
-@item gnus-mailing-list-groups
-@findex gnus-mailing-list-groups
-@cindex mailing lists
-
-If your news server offers groups that are really mailing lists
-gatewayed to the @acronym{NNTP} server, you can read those groups without
-problems, but you can't post/followup to them without some difficulty.
-One solution is to add a @code{to-address} to the group parameters
-(@pxref{Group Parameters}). An easier thing to do is set the
-@code{gnus-mailing-list-groups} to a regexp that matches the groups that
-really are mailing lists. Then, at least, followups to the mailing
-lists will work most of the time. Posting to these groups (@kbd{a}) is
-still a pain, though.
-
-@item gnus-user-agent
-@vindex gnus-user-agent
-@cindex User-Agent
-
-This variable controls which information should be exposed in the
-User-Agent header. It can be a list of symbols or a string. Valid
-symbols are @code{gnus} (show Gnus version) and @code{emacs} (show Emacs
-version). In addition to the Emacs version, you can add @code{codename}
-(show (S)XEmacs codename) or either @code{config} (show system
-configuration) or @code{type} (show system type). If you set it to a
-string, be sure to use a valid format, see RFC 2616.
-
-@end table
-
-You may want to do spell-checking on messages that you send out. Or, if
-you don't want to spell-check by hand, you could add automatic
-spell-checking via the @code{ispell} package:
-
-@cindex ispell
-@findex ispell-message
-@lisp
-(add-hook 'message-send-hook 'ispell-message)
-@end lisp
-
-If you want to change the @code{ispell} dictionary based on what group
-you're in, you could say something like the following:
-
-@lisp
-(add-hook 'gnus-select-group-hook
- (lambda ()
- (cond
- ((string-match
- "^de\\." (gnus-group-real-name gnus-newsgroup-name))
- (ispell-change-dictionary "deutsch"))
- (t
- (ispell-change-dictionary "english")))))
-@end lisp
-
-Modify to suit your needs.
-
-
-@node Archived Messages
-@section Archived Messages
-@cindex archived messages
-@cindex sent messages
-
-Gnus provides a few different methods for storing the mail and news you
-send. The default method is to use the @dfn{archive virtual server} to
-store the messages. If you want to disable this completely, the
-@code{gnus-message-archive-group} variable should be @code{nil}, which
-is the default.
-
-For archiving interesting messages in a group you read, see the
-@kbd{B c} (@code{gnus-summary-copy-article}) command (@pxref{Mail
-Group Commands}).
-
-@vindex gnus-message-archive-method
-@code{gnus-message-archive-method} says what virtual server Gnus is to
-use to store sent messages. The default is:
-
-@lisp
-(nnfolder "archive"
- (nnfolder-directory "~/Mail/archive")
- (nnfolder-active-file "~/Mail/archive/active")
- (nnfolder-get-new-mail nil)
- (nnfolder-inhibit-expiry t))
-@end lisp
-
-You can, however, use any mail select method (@code{nnml},
-@code{nnmbox}, etc.). @code{nnfolder} is a quite likable select method
-for doing this sort of thing, though. If you don't like the default
-directory chosen, you could say something like:
-
-@lisp
-(setq gnus-message-archive-method
- '(nnfolder "archive"
- (nnfolder-inhibit-expiry t)
- (nnfolder-active-file "~/News/sent-mail/active")
- (nnfolder-directory "~/News/sent-mail/")))
-@end lisp
-
-@vindex gnus-message-archive-group
-@cindex Gcc
-Gnus will insert @code{Gcc} headers in all outgoing messages that point
-to one or more group(s) on that server. Which group to use is
-determined by the @code{gnus-message-archive-group} variable.
-
-This variable can be used to do the following:
-
-@table @asis
-@item a string
-Messages will be saved in that group.
-
-Note that you can include a select method in the group name, then the
-message will not be stored in the select method given by
-@code{gnus-message-archive-method}, but in the select method specified
-by the group name, instead. Suppose @code{gnus-message-archive-method}
-has the default value shown above. Then setting
-@code{gnus-message-archive-group} to @code{"foo"} means that outgoing
-messages are stored in @samp{nnfolder+archive:foo}, but if you use the
-value @code{"nnml:foo"}, then outgoing messages will be stored in
-@samp{nnml:foo}.
-
-@item a list of strings
-Messages will be saved in all those groups.
-
-@item an alist of regexps, functions and forms
-When a key ``matches'', the result is used.
-
-@item @code{nil}
-No message archiving will take place. This is the default.
-@end table
-
-Let's illustrate:
-
-Just saving to a single group called @samp{MisK}:
-@lisp
-(setq gnus-message-archive-group "MisK")
-@end lisp
-
-Saving to two groups, @samp{MisK} and @samp{safe}:
-@lisp
-(setq gnus-message-archive-group '("MisK" "safe"))
-@end lisp
-
-Save to different groups based on what group you are in:
-@lisp
-(setq gnus-message-archive-group
- '(("^alt" "sent-to-alt")
- ("mail" "sent-to-mail")
- (".*" "sent-to-misc")))
-@end lisp
-
-More complex stuff:
-@lisp
-(setq gnus-message-archive-group
- '((if (message-news-p)
- "misc-news"
- "misc-mail")))
-@end lisp
-
-How about storing all news messages in one file, but storing all mail
-messages in one file per month:
-
-@lisp
-(setq gnus-message-archive-group
- '((if (message-news-p)
- "misc-news"
- (concat "mail." (format-time-string "%Y-%m")))))
-@end lisp
-
-@c (XEmacs 19.13 doesn't have @code{format-time-string}, so you'll have to
-@c use a different value for @code{gnus-message-archive-group} there.)
-
-Now, when you send a message off, it will be stored in the appropriate
-group. (If you want to disable storing for just one particular message,
-you can just remove the @code{Gcc} header that has been inserted.) The
-archive group will appear in the group buffer the next time you start
-Gnus, or the next time you press @kbd{F} in the group buffer. You can
-enter it and read the articles in it just like you'd read any other
-group. If the group gets really big and annoying, you can simply rename
-if (using @kbd{G r} in the group buffer) to something
-nice---@samp{misc-mail-september-1995}, or whatever. New messages will
-continue to be stored in the old (now empty) group.
-
-That's the default method of archiving sent messages. Gnus offers a
-different way for the people who don't like the default method. In that
-case you should set @code{gnus-message-archive-group} to @code{nil};
-this will disable archiving.
-
-@table @code
-@item gnus-outgoing-message-group
-@vindex gnus-outgoing-message-group
-All outgoing messages will be put in this group. If you want to store
-all your outgoing mail and articles in the group @samp{nnml:archive},
-you set this variable to that value. This variable can also be a list of
-group names.
-
-If you want to have greater control over what group to put each
-message in, you can set this variable to a function that checks the
-current newsgroup name and then returns a suitable group name (or list
-of names).
-
-This variable can be used instead of @code{gnus-message-archive-group},
-but the latter is the preferred method.
-
-@item gnus-gcc-mark-as-read
-@vindex gnus-gcc-mark-as-read
-If non-@code{nil}, automatically mark @code{Gcc} articles as read.
-
-@item gnus-gcc-externalize-attachments
-@vindex gnus-gcc-externalize-attachments
-If @code{nil}, attach files as normal parts in Gcc copies; if a regexp
-and matches the Gcc group name, attach files as external parts; if it is
-@code{all}, attach local files as external parts; if it is other
-non-@code{nil}, the behavior is the same as @code{all}, but it may be
-changed in the future.
-
-@end table
-
-
-@node Posting Styles
-@section Posting Styles
-@cindex posting styles
-@cindex styles
-
-All them variables, they make my head swim.
-
-So what if you want a different @code{Organization} and signature based
-on what groups you post to? And you post both from your home machine
-and your work machine, and you want different @code{From} lines, and so
-on?
-
-@vindex gnus-posting-styles
-One way to do stuff like that is to write clever hooks that change the
-variables you need to have changed. That's a bit boring, so somebody
-came up with the bright idea of letting the user specify these things in
-a handy alist. Here's an example of a @code{gnus-posting-styles}
-variable:
-
-@lisp
-((".*"
- (signature "Peace and happiness")
- (organization "What me?"))
- ("^comp"
- (signature "Death to everybody"))
- ("comp.emacs.i-love-it"
- (organization "Emacs is it")))
-@end lisp
-
-As you might surmise from this example, this alist consists of several
-@dfn{styles}. Each style will be applicable if the first element
-``matches'', in some form or other. The entire alist will be iterated
-over, from the beginning towards the end, and each match will be
-applied, which means that attributes in later styles that match override
-the same attributes in earlier matching styles. So
-@samp{comp.programming.literate} will have the @samp{Death to everybody}
-signature and the @samp{What me?} @code{Organization} header.
-
-The first element in each style is called the @code{match}. If it's a
-string, then Gnus will try to regexp match it against the group name.
-If it is the form @code{(header @var{match} @var{regexp})}, then Gnus
-will look in the original article for a header whose name is
-@var{match} and compare that @var{regexp}. @var{match} and
-@var{regexp} are strings. (The original article is the one you are
-replying or following up to. If you are not composing a reply or a
-followup, then there is nothing to match against.) If the
-@code{match} is a function symbol, that function will be called with
-no arguments. If it's a variable symbol, then the variable will be
-referenced. If it's a list, then that list will be @code{eval}ed. In
-any case, if this returns a non-@code{nil} value, then the style is
-said to @dfn{match}.
-
-Each style may contain an arbitrary amount of @dfn{attributes}. Each
-attribute consists of a @code{(@var{name} @var{value})} pair. In
-addition, you can also use the @code{(@var{name} :file @var{value})}
-form or the @code{(@var{name} :value @var{value})} form. Where
-@code{:file} signifies @var{value} represents a file name and its
-contents should be used as the attribute value, @code{:value} signifies
-@var{value} does not represent a file name explicitly. The attribute
-name can be one of:
-
-@itemize @bullet
-@item @code{signature}
-@item @code{signature-file}
-@item @code{x-face-file}
-@item @code{address}, overriding @code{user-mail-address}
-@item @code{name}, overriding @code{(user-full-name)}
-@item @code{body}
-@end itemize
-
-The attribute name can also be a string or a symbol. In that case,
-this will be used as a header name, and the value will be inserted in
-the headers of the article; if the value is @code{nil}, the header
-name will be removed. If the attribute name is @code{eval}, the form
-is evaluated, and the result is thrown away.
-
-The attribute value can be a string (used verbatim), a function with
-zero arguments (the return value will be used), a variable (its value
-will be used) or a list (it will be @code{eval}ed and the return value
-will be used). The functions and sexps are called/@code{eval}ed in the
-message buffer that is being set up. The headers of the current article
-are available through the @code{message-reply-headers} variable, which
-is a vector of the following headers: number subject from date id
-references chars lines xref extra.
-
-@vindex message-reply-headers
-
-If you wish to check whether the message you are about to compose is
-meant to be a news article or a mail message, you can check the values
-of the @code{message-news-p} and @code{message-mail-p} functions.
-
-@findex message-mail-p
-@findex message-news-p
-
-So here's a new example:
-
-@lisp
-(setq gnus-posting-styles
- '((".*"
- (signature-file "~/.signature")
- (name "User Name")
- (x-face-file "~/.xface")
- (x-url (getenv "WWW_HOME"))
- (organization "People's Front Against MWM"))
- ("^rec.humor"
- (signature my-funny-signature-randomizer))
- ((equal (system-name) "gnarly") ;; @r{A form}
- (signature my-quote-randomizer))
- (message-news-p ;; @r{A function symbol}
- (signature my-news-signature))
- (window-system ;; @r{A value symbol}
- ("X-Window-System" (format "%s" window-system)))
- ;; @r{If I'm replying to Larsi, set the Organization header.}
- ((header "from" "larsi.*org")
- (Organization "Somewhere, Inc."))
- ((posting-from-work-p) ;; @r{A user defined function}
- (signature-file "~/.work-signature")
- (address "user@@bar.foo")
- (body "You are fired.\n\nSincerely, your boss.")
- (organization "Important Work, Inc"))
- ("nnml:.*"
- (From (save-excursion
- (set-buffer gnus-article-buffer)
- (message-fetch-field "to"))))
- ("^nn.+:"
- (signature-file "~/.mail-signature"))))
-@end lisp
-
-The @samp{nnml:.*} rule means that you use the @code{To} address as the
-@code{From} address in all your outgoing replies, which might be handy
-if you fill many roles.
-You may also use @code{message-alternative-emails} instead.
-@xref{Message Headers, ,Message Headers, message, Message Manual}.
-
-@node Drafts
-@section Drafts
-@cindex drafts
-
-If you are writing a message (mail or news) and suddenly remember that
-you have a steak in the oven (or some pesto in the food processor, you
-craaazy vegetarians), you'll probably wish there was a method to save
-the message you are writing so that you can continue editing it some
-other day, and send it when you feel its finished.
-
-Well, don't worry about it. Whenever you start composing a message of
-some sort using the Gnus mail and post commands, the buffer you get will
-automatically associate to an article in a special @dfn{draft} group.
-If you save the buffer the normal way (@kbd{C-x C-s}, for instance), the
-article will be saved there. (Auto-save files also go to the draft
-group.)
-
-@cindex nndraft
-@vindex nndraft-directory
-The draft group is a special group (which is implemented as an
-@code{nndraft} group, if you absolutely have to know) called
-@samp{nndraft:drafts}. The variable @code{nndraft-directory} says where
-@code{nndraft} is to store its files. What makes this group special is
-that you can't tick any articles in it or mark any articles as
-read---all articles in the group are permanently unread.
-
-If the group doesn't exist, it will be created and you'll be subscribed
-to it. The only way to make it disappear from the Group buffer is to
-unsubscribe it. The special properties of the draft group comes from
-a group property (@pxref{Group Parameters}), and if lost the group
-behaves like any other group. This means the commands below will not
-be available. To restore the special properties of the group, the
-simplest way is to kill the group, using @kbd{C-k}, and restart
-Gnus. The group is automatically created again with the
-correct parameters. The content of the group is not lost.
-
-@c @findex gnus-dissociate-buffer-from-draft
-@c @kindex C-c M-d (Mail)
-@c @kindex C-c M-d (Post)
-@c @findex gnus-associate-buffer-with-draft
-@c @kindex C-c C-d (Mail)
-@c @kindex C-c C-d (Post)
-@c If you're writing some super-secret message that you later want to
-@c encode with PGP before sending, you may wish to turn the auto-saving
-@c (and association with the draft group) off. You never know who might be
-@c interested in reading all your extremely valuable and terribly horrible
-@c and interesting secrets. The @kbd{C-c M-d}
-@c (@code{gnus-dissociate-buffer-from-draft}) command does that for you.
-@c If you change your mind and want to turn the auto-saving back on again,
-@c @kbd{C-c C-d} (@code{gnus-associate-buffer-with-draft} does that.
-@c
-@c @vindex gnus-use-draft
-@c To leave association with the draft group off by default, set
-@c @code{gnus-use-draft} to @code{nil}. It is @code{t} by default.
-
-@findex gnus-draft-edit-message
-@kindex D e (Draft)
-When you want to continue editing the article, you simply enter the
-draft group and push @kbd{D e} (@code{gnus-draft-edit-message}) to do
-that. You will be placed in a buffer where you left off.
-
-Rejected articles will also be put in this draft group (@pxref{Rejected
-Articles}).
-
-@findex gnus-draft-send-all-messages
-@kindex D s (Draft)
-@findex gnus-draft-send-message
-@kindex D S (Draft)
-If you have lots of rejected messages you want to post (or mail) without
-doing further editing, you can use the @kbd{D s} command
-(@code{gnus-draft-send-message}). This command understands the
-process/prefix convention (@pxref{Process/Prefix}). The @kbd{D S}
-command (@code{gnus-draft-send-all-messages}) will ship off all messages
-in the buffer.
-
-@findex gnus-draft-toggle-sending
-@kindex D t (Draft)
-If you have some messages that you wish not to send, you can use the
-@kbd{D t} (@code{gnus-draft-toggle-sending}) command to mark the message
-as unsendable. This is a toggling command.
-
-
-@node Rejected Articles
-@section Rejected Articles
-@cindex rejected articles
-
-Sometimes a news server will reject an article. Perhaps the server
-doesn't like your face. Perhaps it just feels miserable. Perhaps
-@emph{there be demons}. Perhaps you have included too much cited text.
-Perhaps the disk is full. Perhaps the server is down.
-
-These situations are, of course, totally beyond the control of Gnus.
-(Gnus, of course, loves the way you look, always feels great, has angels
-fluttering around inside of it, doesn't care about how much cited text
-you include, never runs full and never goes down.) So Gnus saves these
-articles until some later time when the server feels better.
-
-The rejected articles will automatically be put in a special draft group
-(@pxref{Drafts}). When the server comes back up again, you'd then
-typically enter that group and send all the articles off.
-
-@node Signing and encrypting
-@section Signing and encrypting
-@cindex using gpg
-@cindex using s/mime
-@cindex using smime
-
-Gnus can digitally sign and encrypt your messages, using vanilla
-@acronym{PGP} format or @acronym{PGP/MIME} or @acronym{S/MIME}. For
-decoding such messages, see the @code{mm-verify-option} and
-@code{mm-decrypt-option} options (@pxref{Security}).
-
-@vindex gnus-message-replysign
-@vindex gnus-message-replyencrypt
-@vindex gnus-message-replysignencrypted
-Often, you would like to sign replies to people who send you signed
-messages. Even more often, you might want to encrypt messages which
-are in reply to encrypted messages. Gnus offers
-@code{gnus-message-replysign} to enable the former, and
-@code{gnus-message-replyencrypt} for the latter. In addition, setting
-@code{gnus-message-replysignencrypted} (on by default) will sign
-automatically encrypted messages.
-
-Instructing @acronym{MML} to perform security operations on a
-@acronym{MIME} part is done using the @kbd{C-c C-m s} key map for
-signing and the @kbd{C-c C-m c} key map for encryption, as follows.
-
-@table @kbd
-
-@item C-c C-m s s
-@kindex C-c C-m s s (Message)
-@findex mml-secure-message-sign-smime
-
-Digitally sign current message using @acronym{S/MIME}.
-
-@item C-c C-m s o
-@kindex C-c C-m s o (Message)
-@findex mml-secure-message-sign-pgp
-
-Digitally sign current message using @acronym{PGP}.
-
-@item C-c C-m s p
-@kindex C-c C-m s p (Message)
-@findex mml-secure-message-sign-pgp
-
-Digitally sign current message using @acronym{PGP/MIME}.
-
-@item C-c C-m c s
-@kindex C-c C-m c s (Message)
-@findex mml-secure-message-encrypt-smime
-
-Digitally encrypt current message using @acronym{S/MIME}.
-
-@item C-c C-m c o
-@kindex C-c C-m c o (Message)
-@findex mml-secure-message-encrypt-pgp
-
-Digitally encrypt current message using @acronym{PGP}.
-
-@item C-c C-m c p
-@kindex C-c C-m c p (Message)
-@findex mml-secure-message-encrypt-pgpmime
-
-Digitally encrypt current message using @acronym{PGP/MIME}.
-
-@item C-c C-m C-n
-@kindex C-c C-m C-n (Message)
-@findex mml-unsecure-message
-Remove security related @acronym{MML} tags from message.
-
-@end table
-
-@xref{Security, ,Security, message, Message Manual}, for more information.
-
-@node Select Methods
-@chapter Select Methods
-@cindex foreign groups
-@cindex select methods
-
-A @dfn{foreign group} is a group not read by the usual (or
-default) means. It could be, for instance, a group from a different
-@acronym{NNTP} server, it could be a virtual group, or it could be your own
-personal mail group.
-
-A foreign group (or any group, really) is specified by a @dfn{name} and
-a @dfn{select method}. To take the latter first, a select method is a
-list where the first element says what back end to use (e.g. @code{nntp},
-@code{nnspool}, @code{nnml}) and the second element is the @dfn{server
-name}. There may be additional elements in the select method, where the
-value may have special meaning for the back end in question.
-
-One could say that a select method defines a @dfn{virtual server}---so
-we do just that (@pxref{Server Buffer}).
-
-The @dfn{name} of the group is the name the back end will recognize the
-group as.
-
-For instance, the group @samp{soc.motss} on the @acronym{NNTP} server
-@samp{some.where.edu} will have the name @samp{soc.motss} and select
-method @code{(nntp "some.where.edu")}. Gnus will call this group
-@samp{nntp+some.where.edu:soc.motss}, even though the @code{nntp}
-back end just knows this group as @samp{soc.motss}.
-
-The different methods all have their peculiarities, of course.
-
-@menu
-* Server Buffer:: Making and editing virtual servers.
-* Getting News:: Reading USENET news with Gnus.
-* Getting Mail:: Reading your personal mail with Gnus.
-* Browsing the Web:: Getting messages from a plethora of Web sources.
-* IMAP:: Using Gnus as a @acronym{IMAP} client.
-* Other Sources:: Reading directories, files, SOUP packets.
-* Combined Groups:: Combining groups into one group.
-* Email Based Diary:: Using mails to manage diary events in Gnus.
-* Gnus Unplugged:: Reading news and mail offline.
-@end menu
-
-
-@node Server Buffer
-@section Server Buffer
-
-Traditionally, a @dfn{server} is a machine or a piece of software that
-one connects to, and then requests information from. Gnus does not
-connect directly to any real servers, but does all transactions through
-one back end or other. But that's just putting one layer more between
-the actual media and Gnus, so we might just as well say that each
-back end represents a virtual server.
-
-For instance, the @code{nntp} back end may be used to connect to several
-different actual @acronym{NNTP} servers, or, perhaps, to many different ports
-on the same actual @acronym{NNTP} server. You tell Gnus which back end to
-use, and what parameters to set by specifying a @dfn{select method}.
-
-These select method specifications can sometimes become quite
-complicated---say, for instance, that you want to read from the
-@acronym{NNTP} server @samp{news.funet.fi} on port number 13, which
-hangs if queried for @acronym{NOV} headers and has a buggy select. Ahem.
-Anyway, if you had to specify that for each group that used this
-server, that would be too much work, so Gnus offers a way of naming
-select methods, which is what you do in the server buffer.
-
-To enter the server buffer, use the @kbd{^}
-(@code{gnus-group-enter-server-mode}) command in the group buffer.
-
-@menu
-* Server Buffer Format:: You can customize the look of this buffer.
-* Server Commands:: Commands to manipulate servers.
-* Example Methods:: Examples server specifications.
-* Creating a Virtual Server:: An example session.
-* Server Variables:: Which variables to set.
-* Servers and Methods:: You can use server names as select methods.
-* Unavailable Servers:: Some servers you try to contact may be down.
-@end menu
-
-@vindex gnus-server-mode-hook
-@code{gnus-server-mode-hook} is run when creating the server buffer.
-
-
-@node Server Buffer Format
-@subsection Server Buffer Format
-@cindex server buffer format
-
-@vindex gnus-server-line-format
-You can change the look of the server buffer lines by changing the
-@code{gnus-server-line-format} variable. This is a @code{format}-like
-variable, with some simple extensions:
-
-@table @samp
-
-@item h
-How the news is fetched---the back end name.
-
-@item n
-The name of this server.
-
-@item w
-Where the news is to be fetched from---the address.
-
-@item s
-The opened/closed/denied status of the server.
-
-@item a
-Whether this server is agentized.
-@end table
-
-@vindex gnus-server-mode-line-format
-The mode line can also be customized by using the
-@code{gnus-server-mode-line-format} variable (@pxref{Mode Line
-Formatting}). The following specs are understood:
-
-@table @samp
-@item S
-Server name.
-
-@item M
-Server method.
-@end table
-
-Also @pxref{Formatting Variables}.
-
-
-@node Server Commands
-@subsection Server Commands
-@cindex server commands
-
-@table @kbd
-
-@item v
-@kindex v (Server)
-@cindex keys, reserved for users (Server)
-The key @kbd{v} is reserved for users. You can bind it to some
-command or better use it as a prefix key.
-
-@item a
-@kindex a (Server)
-@findex gnus-server-add-server
-Add a new server (@code{gnus-server-add-server}).
-
-@item e
-@kindex e (Server)
-@findex gnus-server-edit-server
-Edit a server (@code{gnus-server-edit-server}).
-
-@item SPACE
-@kindex SPACE (Server)
-@findex gnus-server-read-server
-Browse the current server (@code{gnus-server-read-server}).
-
-@item q
-@kindex q (Server)
-@findex gnus-server-exit
-Return to the group buffer (@code{gnus-server-exit}).
-
-@item k
-@kindex k (Server)
-@findex gnus-server-kill-server
-Kill the current server (@code{gnus-server-kill-server}).
-
-@item y
-@kindex y (Server)
-@findex gnus-server-yank-server
-Yank the previously killed server (@code{gnus-server-yank-server}).
-
-@item c
-@kindex c (Server)
-@findex gnus-server-copy-server
-Copy the current server (@code{gnus-server-copy-server}).
-
-@item l
-@kindex l (Server)
-@findex gnus-server-list-servers
-List all servers (@code{gnus-server-list-servers}).
-
-@item s
-@kindex s (Server)
-@findex gnus-server-scan-server
-Request that the server scan its sources for new articles
-(@code{gnus-server-scan-server}). This is mainly sensible with mail
-servers.
-
-@item g
-@kindex g (Server)
-@findex gnus-server-regenerate-server
-Request that the server regenerate all its data structures
-(@code{gnus-server-regenerate-server}). This can be useful if you have
-a mail back end that has gotten out of sync.
-
-@end table
-
-
-@node Example Methods
-@subsection Example Methods
-
-Most select methods are pretty simple and self-explanatory:
-
-@lisp
-(nntp "news.funet.fi")
-@end lisp
-
-Reading directly from the spool is even simpler:
-
-@lisp
-(nnspool "")
-@end lisp
-
-As you can see, the first element in a select method is the name of the
-back end, and the second is the @dfn{address}, or @dfn{name}, if you
-will.
-
-After these two elements, there may be an arbitrary number of
-@code{(@var{variable} @var{form})} pairs.
-
-To go back to the first example---imagine that you want to read from
-port 15 on that machine. This is what the select method should
-look like then:
-
-@lisp
-(nntp "news.funet.fi" (nntp-port-number 15))
-@end lisp
-
-You should read the documentation to each back end to find out what
-variables are relevant, but here's an @code{nnmh} example:
-
-@code{nnmh} is a mail back end that reads a spool-like structure. Say
-you have two structures that you wish to access: One is your private
-mail spool, and the other is a public one. Here's the possible spec for
-your private mail:
-
-@lisp
-(nnmh "private" (nnmh-directory "~/private/mail/"))
-@end lisp
-
-(This server is then called @samp{private}, but you may have guessed
-that.)
-
-Here's the method for a public spool:
-
-@lisp
-(nnmh "public"
- (nnmh-directory "/usr/information/spool/")
- (nnmh-get-new-mail nil))
-@end lisp
-
-@cindex proxy
-@cindex firewall
-
-If you are behind a firewall and only have access to the @acronym{NNTP}
-server from the firewall machine, you can instruct Gnus to @code{rlogin}
-on the firewall machine and telnet from there to the @acronym{NNTP} server.
-Doing this can be rather fiddly, but your virtual server definition
-should probably look something like this:
-
-@lisp
-(nntp "firewall"
- (nntp-open-connection-function nntp-open-via-rlogin-and-telnet)
- (nntp-via-address "the.firewall.machine")
- (nntp-address "the.real.nntp.host")
- (nntp-end-of-line "\n"))
-@end lisp
-
-If you want to use the wonderful @code{ssh} program to provide a
-compressed connection over the modem line, you could add the following
-configuration to the example above:
-
-@lisp
- (nntp-via-rlogin-command "ssh")
-@end lisp
-
-See also @code{nntp-via-rlogin-command-switches}.
-
-If you're behind a firewall, but have direct access to the outside world
-through a wrapper command like "runsocks", you could open a socksified
-telnet connection to the news server as follows:
-
-@lisp
-(nntp "outside"
- (nntp-pre-command "runsocks")
- (nntp-open-connection-function nntp-open-via-telnet)
- (nntp-address "the.news.server")
- (nntp-end-of-line "\n"))
-@end lisp
-
-This means that you have to have set up @code{ssh-agent} correctly to
-provide automatic authorization, of course. And to get a compressed
-connection, you have to have the @samp{Compression} option in the
-@code{ssh} @file{config} file.
-
-
-@node Creating a Virtual Server
-@subsection Creating a Virtual Server
-
-If you're saving lots of articles in the cache by using persistent
-articles, you may want to create a virtual server to read the cache.
-
-First you need to add a new server. The @kbd{a} command does that. It
-would probably be best to use @code{nnml} to read the cache. You
-could also use @code{nnspool} or @code{nnmh}, though.
-
-Type @kbd{a nnml RET cache RET}.
-
-You should now have a brand new @code{nnml} virtual server called
-@samp{cache}. You now need to edit it to have the right definitions.
-Type @kbd{e} to edit the server. You'll be entered into a buffer that
-will contain the following:
-
-@lisp
-(nnml "cache")
-@end lisp
-
-Change that to:
-
-@lisp
-(nnml "cache"
- (nnml-directory "~/News/cache/")
- (nnml-active-file "~/News/cache/active"))
-@end lisp
-
-Type @kbd{C-c C-c} to return to the server buffer. If you now press
-@kbd{RET} over this virtual server, you should be entered into a browse
-buffer, and you should be able to enter any of the groups displayed.
-
-
-@node Server Variables
-@subsection Server Variables
-@cindex server variables
-@cindex server parameters
-
-One sticky point when defining variables (both on back ends and in Emacs
-in general) is that some variables are typically initialized from other
-variables when the definition of the variables is being loaded. If you
-change the ``base'' variable after the variables have been loaded, you
-won't change the ``derived'' variables.
-
-This typically affects directory and file variables. For instance,
-@code{nnml-directory} is @file{~/Mail/} by default, and all @code{nnml}
-directory variables are initialized from that variable, so
-@code{nnml-active-file} will be @file{~/Mail/active}. If you define a
-new virtual @code{nnml} server, it will @emph{not} suffice to set just
-@code{nnml-directory}---you have to explicitly set all the file
-variables to be what you want them to be. For a complete list of
-variables for each back end, see each back end's section later in this
-manual, but here's an example @code{nnml} definition:
-
-@lisp
-(nnml "public"
- (nnml-directory "~/my-mail/")
- (nnml-active-file "~/my-mail/active")
- (nnml-newsgroups-file "~/my-mail/newsgroups"))
-@end lisp
-
-Server variables are often called @dfn{server parameters}.
-
-@node Servers and Methods
-@subsection Servers and Methods
-
-Wherever you would normally use a select method
-(e.g. @code{gnus-secondary-select-method}, in the group select method,
-when browsing a foreign server) you can use a virtual server name
-instead. This could potentially save lots of typing. And it's nice all
-over.
-
-
-@node Unavailable Servers
-@subsection Unavailable Servers
-
-If a server seems to be unreachable, Gnus will mark that server as
-@code{denied}. That means that any subsequent attempt to make contact
-with that server will just be ignored. ``It can't be opened,'' Gnus
-will tell you, without making the least effort to see whether that is
-actually the case or not.
-
-That might seem quite naughty, but it does make sense most of the time.
-Let's say you have 10 groups subscribed to on server
-@samp{nephelococcygia.com}. This server is located somewhere quite far
-away from you and the machine is quite slow, so it takes 1 minute just
-to find out that it refuses connection to you today. If Gnus were to
-attempt to do that 10 times, you'd be quite annoyed, so Gnus won't
-attempt to do that. Once it has gotten a single ``connection refused'',
-it will regard that server as ``down''.
-
-So, what happens if the machine was only feeling unwell temporarily?
-How do you test to see whether the machine has come up again?
-
-You jump to the server buffer (@pxref{Server Buffer}) and poke it
-with the following commands:
-
-@table @kbd
-
-@item O
-@kindex O (Server)
-@findex gnus-server-open-server
-Try to establish connection to the server on the current line
-(@code{gnus-server-open-server}).
-
-@item C
-@kindex C (Server)
-@findex gnus-server-close-server
-Close the connection (if any) to the server
-(@code{gnus-server-close-server}).
-
-@item D
-@kindex D (Server)
-@findex gnus-server-deny-server
-Mark the current server as unreachable
-(@code{gnus-server-deny-server}).
-
-@item M-o
-@kindex M-o (Server)
-@findex gnus-server-open-all-servers
-Open the connections to all servers in the buffer
-(@code{gnus-server-open-all-servers}).
-
-@item M-c
-@kindex M-c (Server)
-@findex gnus-server-close-all-servers
-Close the connections to all servers in the buffer
-(@code{gnus-server-close-all-servers}).
-
-@item R
-@kindex R (Server)
-@findex gnus-server-remove-denials
-Remove all marks to whether Gnus was denied connection from any servers
-(@code{gnus-server-remove-denials}).
-
-@item L
-@kindex L (Server)
-@findex gnus-server-offline-server
-Set server status to offline (@code{gnus-server-offline-server}).
-
-@end table
-
-
-@node Getting News
-@section Getting News
-@cindex reading news
-@cindex news back ends
-
-A newsreader is normally used for reading news. Gnus currently provides
-only two methods of getting news---it can read from an @acronym{NNTP} server,
-or it can read from a local spool.
-
-@menu
-* NNTP:: Reading news from an @acronym{NNTP} server.
-* News Spool:: Reading news from the local spool.
-@end menu
-
-
-@node NNTP
-@subsection NNTP
-@cindex nntp
-
-Subscribing to a foreign group from an @acronym{NNTP} server is rather easy.
-You just specify @code{nntp} as method and the address of the @acronym{NNTP}
-server as the, uhm, address.
-
-If the @acronym{NNTP} server is located at a non-standard port, setting the
-third element of the select method to this port number should allow you
-to connect to the right port. You'll have to edit the group info for
-that (@pxref{Foreign Groups}).
-
-The name of the foreign group can be the same as a native group. In
-fact, you can subscribe to the same group from as many different servers
-you feel like. There will be no name collisions.
-
-The following variables can be used to create a virtual @code{nntp}
-server:
-
-@table @code
-
-@item nntp-server-opened-hook
-@vindex nntp-server-opened-hook
-@cindex @sc{mode reader}
-@cindex authinfo
-@cindex authentication
-@cindex nntp authentication
-@findex nntp-send-authinfo
-@findex nntp-send-mode-reader
-is run after a connection has been made. It can be used to send
-commands to the @acronym{NNTP} server after it has been contacted. By
-default it sends the command @code{MODE READER} to the server with the
-@code{nntp-send-mode-reader} function. This function should always be
-present in this hook.
-
-@item nntp-authinfo-function
-@vindex nntp-authinfo-function
-@findex nntp-send-authinfo
-@vindex nntp-authinfo-file
-This function will be used to send @samp{AUTHINFO} to the @acronym{NNTP}
-server. The default function is @code{nntp-send-authinfo}, which looks
-through your @file{~/.authinfo} (or whatever you've set the
-@code{nntp-authinfo-file} variable to) for applicable entries. If none
-are found, it will prompt you for a login name and a password. The
-format of the @file{~/.authinfo} file is (almost) the same as the
-@code{ftp} @file{~/.netrc} file, which is defined in the @code{ftp}
-manual page, but here are the salient facts:
-
-@enumerate
-@item
-The file contains one or more line, each of which define one server.
-
-@item
-Each line may contain an arbitrary number of token/value pairs.
-
-The valid tokens include @samp{machine}, @samp{login}, @samp{password},
-@samp{default}. In addition Gnus introduces two new tokens, not present
-in the original @file{.netrc}/@code{ftp} syntax, namely @samp{port} and
-@samp{force}. (This is the only way the @file{.authinfo} file format
-deviates from the @file{.netrc} file format.) @samp{port} is used to
-indicate what port on the server the credentials apply to and
-@samp{force} is explained below.
-
-@end enumerate
-
-Here's an example file:
-
-@example
-machine news.uio.no login larsi password geheimnis
-machine nntp.ifi.uio.no login larsi force yes
-@end example
-
-The token/value pairs may appear in any order; @samp{machine} doesn't
-have to be first, for instance.
-
-In this example, both login name and password have been supplied for the
-former server, while the latter has only the login name listed, and the
-user will be prompted for the password. The latter also has the
-@samp{force} tag, which means that the authinfo will be sent to the
-@var{nntp} server upon connection; the default (i.e., when there is not
-@samp{force} tag) is to not send authinfo to the @var{nntp} server
-until the @var{nntp} server asks for it.
-
-You can also add @samp{default} lines that will apply to all servers
-that don't have matching @samp{machine} lines.
-
-@example
-default force yes
-@end example
-
-This will force sending @samp{AUTHINFO} commands to all servers not
-previously mentioned.
-
-Remember to not leave the @file{~/.authinfo} file world-readable.
-
-@item nntp-server-action-alist
-@vindex nntp-server-action-alist
-This is a list of regexps to match on server types and actions to be
-taken when matches are made. For instance, if you want Gnus to beep
-every time you connect to innd, you could say something like:
-
-@lisp
-(setq nntp-server-action-alist
- '(("innd" (ding))))
-@end lisp
-
-You probably don't want to do that, though.
-
-The default value is
-
-@lisp
-'(("nntpd 1\\.5\\.11t"
- (remove-hook 'nntp-server-opened-hook
- 'nntp-send-mode-reader)))
-@end lisp
-
-This ensures that Gnus doesn't send the @code{MODE READER} command to
-nntpd 1.5.11t, since that command chokes that server, I've been told.
-
-@item nntp-maximum-request
-@vindex nntp-maximum-request
-If the @acronym{NNTP} server doesn't support @acronym{NOV} headers, this back end
-will collect headers by sending a series of @code{head} commands. To
-speed things up, the back end sends lots of these commands without
-waiting for reply, and then reads all the replies. This is controlled
-by the @code{nntp-maximum-request} variable, and is 400 by default. If
-your network is buggy, you should set this to 1.
-
-@item nntp-connection-timeout
-@vindex nntp-connection-timeout
-If you have lots of foreign @code{nntp} groups that you connect to
-regularly, you're sure to have problems with @acronym{NNTP} servers not
-responding properly, or being too loaded to reply within reasonable
-time. This is can lead to awkward problems, which can be helped
-somewhat by setting @code{nntp-connection-timeout}. This is an integer
-that says how many seconds the @code{nntp} back end should wait for a
-connection before giving up. If it is @code{nil}, which is the default,
-no timeouts are done.
-
-@item nntp-nov-is-evil
-@vindex nntp-nov-is-evil
-If the @acronym{NNTP} server does not support @acronym{NOV}, you could set this
-variable to @code{t}, but @code{nntp} usually checks automatically whether @acronym{NOV}
-can be used.
-
-@item nntp-xover-commands
-@vindex nntp-xover-commands
-@cindex @acronym{NOV}
-@cindex XOVER
-List of strings used as commands to fetch @acronym{NOV} lines from a
-server. The default value of this variable is @code{("XOVER"
-"XOVERVIEW")}.
-
-@item nntp-nov-gap
-@vindex nntp-nov-gap
-@code{nntp} normally sends just one big request for @acronym{NOV} lines to
-the server. The server responds with one huge list of lines. However,
-if you have read articles 2-5000 in the group, and only want to read
-article 1 and 5001, that means that @code{nntp} will fetch 4999 @acronym{NOV}
-lines that you will not need. This variable says how
-big a gap between two consecutive articles is allowed to be before the
-@code{XOVER} request is split into several request. Note that if your
-network is fast, setting this variable to a really small number means
-that fetching will probably be slower. If this variable is @code{nil},
-@code{nntp} will never split requests. The default is 5.
-
-@item nntp-xref-number-is-evil
-@vindex nntp-xref-number-is-evil
-When Gnus refers to an article having the @code{Message-ID} that a user
-specifies or having the @code{Message-ID} of the parent article of the
-current one (@pxref{Finding the Parent}), Gnus sends a @code{HEAD}
-command to the @acronym{NNTP} server to know where it is, and the server
-returns the data containing the pairs of a group and an article number
-in the @code{Xref} header. Gnus normally uses the article number to
-refer to the article if the data shows that that article is in the
-current group, while it uses the @code{Message-ID} otherwise. However,
-some news servers, e.g., ones running Diablo, run multiple engines
-having the same articles but article numbers are not kept synchronized
-between them. In that case, the article number that appears in the
-@code{Xref} header varies by which engine is chosen, so you cannot refer
-to the parent article that is in the current group, for instance. If
-you connect to such a server, set this variable to a non-@code{nil}
-value, and Gnus never uses article numbers. For example:
-
-@lisp
-(setq gnus-select-method
- '(nntp "newszilla"
- (nntp-address "newszilla.example.com")
- (nntp-xref-number-is-evil t)
- @dots{}))
-@end lisp
-
-The default value of this server variable is @code{nil}.
-
-@item nntp-prepare-server-hook
-@vindex nntp-prepare-server-hook
-A hook run before attempting to connect to an @acronym{NNTP} server.
-
-@item nntp-record-commands
-@vindex nntp-record-commands
-If non-@code{nil}, @code{nntp} will log all commands it sends to the
-@acronym{NNTP} server (along with a timestamp) in the @samp{*nntp-log*}
-buffer. This is useful if you are debugging a Gnus/@acronym{NNTP} connection
-that doesn't seem to work.
-
-@item nntp-open-connection-function
-@vindex nntp-open-connection-function
-It is possible to customize how the connection to the nntp server will
-be opened. If you specify an @code{nntp-open-connection-function}
-parameter, Gnus will use that function to establish the connection.
-Six pre-made functions are supplied. These functions can be grouped in
-two categories: direct connection functions (four pre-made), and
-indirect ones (two pre-made).
-
-@item nntp-never-echoes-commands
-@vindex nntp-never-echoes-commands
-Non-@code{nil} means the nntp server never echoes commands. It is
-reported that some nntps server doesn't echo commands. So, you may want
-to set this to non-@code{nil} in the method for such a server setting
-@code{nntp-open-connection-function} to @code{nntp-open-ssl-stream} for
-example. The default value is @code{nil}. Note that the
-@code{nntp-open-connection-functions-never-echo-commands} variable
-overrides the @code{nil} value of this variable.
-
-@item nntp-open-connection-functions-never-echo-commands
-@vindex nntp-open-connection-functions-never-echo-commands
-List of functions that never echo commands. Add or set a function which
-you set to @code{nntp-open-connection-function} to this list if it does
-not echo commands. Note that a non-@code{nil} value of the
-@code{nntp-never-echoes-commands} variable overrides this variable. The
-default value is @code{(nntp-open-network-stream)}.
-
-@item nntp-prepare-post-hook
-@vindex nntp-prepare-post-hook
-A hook run just before posting an article. If there is no
-@code{Message-ID} header in the article and the news server provides the
-recommended ID, it will be added to the article before running this
-hook. It is useful to make @code{Cancel-Lock} headers even if you
-inhibit Gnus to add a @code{Message-ID} header, you could say:
-
-@lisp
-(add-hook 'nntp-prepare-post-hook 'canlock-insert-header)
-@end lisp
-
-Note that not all servers support the recommended ID. This works for
-INN versions 2.3.0 and later, for instance.
-
-@end table
-
-@menu
-* Direct Functions:: Connecting directly to the server.
-* Indirect Functions:: Connecting indirectly to the server.
-* Common Variables:: Understood by several connection functions.
-@end menu
-
-
-@node Direct Functions
-@subsubsection Direct Functions
-@cindex direct connection functions
-
-These functions are called direct because they open a direct connection
-between your machine and the @acronym{NNTP} server. The behavior of these
-functions is also affected by commonly understood variables
-(@pxref{Common Variables}).
-
-@table @code
-@findex nntp-open-network-stream
-@item nntp-open-network-stream
-This is the default, and simply connects to some port or other on the
-remote system.
-
-@findex nntp-open-tls-stream
-@item nntp-open-tls-stream
-Opens a connection to a server over a @dfn{secure} channel. To use
-this you must have @uref{http://www.gnu.org/software/gnutls/, GNUTLS}
-installed. You then define a server as follows:
-
-@lisp
-;; @r{"nntps" is port 563 and is predefined in our @file{/etc/services}}
-;; @r{however, @samp{gnutls-cli -p} doesn't like named ports.}
-;;
-(nntp "snews.bar.com"
- (nntp-open-connection-function nntp-open-tls-stream)
- (nntp-port-number )
- (nntp-address "snews.bar.com"))
-@end lisp
-
-@findex nntp-open-ssl-stream
-@item nntp-open-ssl-stream
-Opens a connection to a server over a @dfn{secure} channel. To use
-this you must have @uref{http://www.openssl.org, OpenSSL} or
-@uref{ftp://ftp.psy.uq.oz.au/pub/Crypto/SSL, SSLeay} installed. You
-then define a server as follows:
-
-@lisp
-;; @r{"snews" is port 563 and is predefined in our @file{/etc/services}}
-;; @r{however, @samp{openssl s_client -port} doesn't like named ports.}
-;;
-(nntp "snews.bar.com"
- (nntp-open-connection-function nntp-open-ssl-stream)
- (nntp-port-number 563)
- (nntp-address "snews.bar.com"))
-@end lisp
-
-@findex nntp-open-telnet-stream
-@item nntp-open-telnet-stream
-Opens a connection to an @acronym{NNTP} server by simply @samp{telnet}'ing
-it. You might wonder why this function exists, since we have the
-default @code{nntp-open-network-stream} which would do the job. (One
-of) the reason(s) is that if you are behind a firewall but have direct
-connections to the outside world thanks to a command wrapper like
-@code{runsocks}, you can use it like this:
-
-@lisp
-(nntp "socksified"
- (nntp-pre-command "runsocks")
- (nntp-open-connection-function nntp-open-telnet-stream)
- (nntp-address "the.news.server"))
-@end lisp
-
-With the default method, you would need to wrap your whole Emacs
-session, which is not a good idea.
-@end table
-
-
-@node Indirect Functions
-@subsubsection Indirect Functions
-@cindex indirect connection functions
-
-These functions are called indirect because they connect to an
-intermediate host before actually connecting to the @acronym{NNTP} server.
-All of these functions and related variables are also said to belong to
-the ``via'' family of connection: they're all prefixed with ``via'' to make
-things cleaner. The behavior of these functions is also affected by
-commonly understood variables (@pxref{Common Variables}).
-
-@table @code
-@item nntp-open-via-rlogin-and-telnet
-@findex nntp-open-via-rlogin-and-telnet
-Does an @samp{rlogin} on a remote system, and then does a @samp{telnet}
-to the real @acronym{NNTP} server from there. This is useful for instance if
-you need to connect to a firewall machine first.
-
-@code{nntp-open-via-rlogin-and-telnet}-specific variables:
-
-@table @code
-@item nntp-via-rlogin-command
-@vindex nntp-via-rlogin-command
-Command used to log in on the intermediate host. The default is
-@samp{rsh}, but @samp{ssh} is a popular alternative.
-
-@item nntp-via-rlogin-command-switches
-@vindex nntp-via-rlogin-command-switches
-List of strings to be used as the switches to
-@code{nntp-via-rlogin-command}. The default is @code{nil}. If you use
-@samp{ssh} for @code{nntp-via-rlogin-command}, you may set this to
-@samp{("-C")} in order to compress all data connections, otherwise set
-this to @samp{("-t" "-e" "none")} or @samp{("-C" "-t" "-e" "none")} if
-the telnet command requires a pseudo-tty allocation on an intermediate
-host.
-@end table
-
-@item nntp-open-via-telnet-and-telnet
-@findex nntp-open-via-telnet-and-telnet
-Does essentially the same, but uses @samp{telnet} instead of
-@samp{rlogin} to connect to the intermediate host.
-
-@code{nntp-open-via-telnet-and-telnet}-specific variables:
-
-@table @code
-@item nntp-via-telnet-command
-@vindex nntp-via-telnet-command
-Command used to @code{telnet} the intermediate host. The default is
-@samp{telnet}.
-
-@item nntp-via-telnet-switches
-@vindex nntp-via-telnet-switches
-List of strings to be used as the switches to the
-@code{nntp-via-telnet-command} command. The default is @samp{("-8")}.
-
-@item nntp-via-user-password
-@vindex nntp-via-user-password
-Password to use when logging in on the intermediate host.
-
-@item nntp-via-envuser
-@vindex nntp-via-envuser
-If non-@code{nil}, the intermediate @code{telnet} session (client and
-server both) will support the @code{ENVIRON} option and not prompt for
-login name. This works for Solaris @code{telnet}, for instance.
-
-@item nntp-via-shell-prompt
-@vindex nntp-via-shell-prompt
-Regexp matching the shell prompt on the intermediate host. The default
-is @samp{bash\\|\$ *\r?$\\|> *\r?}.
-
-@end table
-
-@end table
-
-
-Here are some additional variables that are understood by all the above
-functions:
-
-@table @code
-
-@item nntp-via-user-name
-@vindex nntp-via-user-name
-User name to use when connecting to the intermediate host.
-
-@item nntp-via-address
-@vindex nntp-via-address
-Address of the intermediate host to connect to.
-
-@end table
-
-
-@node Common Variables
-@subsubsection Common Variables
-
-The following variables affect the behavior of all, or several of the
-pre-made connection functions. When not specified, all functions are
-affected (the values of the following variables will be used as the
-default if each virtual @code{nntp} server doesn't specify those server
-variables individually).
-
-@table @code
-
-@item nntp-pre-command
-@vindex nntp-pre-command
-A command wrapper to use when connecting through a non native
-connection function (all except @code{nntp-open-network-stream},
-@code{nntp-open-tls-stream}, and @code{nntp-open-ssl-stream}). This is
-where you would put a @samp{SOCKS} wrapper for instance.
-
-@item nntp-address
-@vindex nntp-address
-The address of the @acronym{NNTP} server.
-
-@item nntp-port-number
-@vindex nntp-port-number
-Port number to connect to the @acronym{NNTP} server. The default is
-@samp{nntp}. If you use @acronym{NNTP} over
-@acronym{TLS}/@acronym{SSL}, you may want to use integer ports rather
-than named ports (i.e, use @samp{563} instead of @samp{snews} or
-@samp{nntps}), because external @acronym{TLS}/@acronym{SSL} tools may
-not work with named ports.
-
-@item nntp-end-of-line
-@vindex nntp-end-of-line
-String to use as end-of-line marker when talking to the @acronym{NNTP}
-server. This is @samp{\r\n} by default, but should be @samp{\n} when
-using a non native connection function.
-
-@item nntp-telnet-command
-@vindex nntp-telnet-command
-Command to use when connecting to the @acronym{NNTP} server through
-@samp{telnet}. This is @emph{not} for an intermediate host. This is
-just for the real @acronym{NNTP} server. The default is
-@samp{telnet}.
-
-@item nntp-telnet-switches
-@vindex nntp-telnet-switches
-A list of switches to pass to @code{nntp-telnet-command}. The default
-is @samp{("-8")}.
-
-@end table
-
-
-@node News Spool
-@subsection News Spool
-@cindex nnspool
-@cindex news spool
-
-Subscribing to a foreign group from the local spool is extremely easy,
-and might be useful, for instance, to speed up reading groups that
-contain very big articles---@samp{alt.binaries.pictures.furniture}, for
-instance.
-
-Anyway, you just specify @code{nnspool} as the method and @code{""} (or
-anything else) as the address.
-
-If you have access to a local spool, you should probably use that as the
-native select method (@pxref{Finding the News}). It is normally faster
-than using an @code{nntp} select method, but might not be. It depends.
-You just have to try to find out what's best at your site.
-
-@table @code
-
-@item nnspool-inews-program
-@vindex nnspool-inews-program
-Program used to post an article.
-
-@item nnspool-inews-switches
-@vindex nnspool-inews-switches
-Parameters given to the inews program when posting an article.
-
-@item nnspool-spool-directory
-@vindex nnspool-spool-directory
-Where @code{nnspool} looks for the articles. This is normally
-@file{/usr/spool/news/}.
-
-@item nnspool-nov-directory
-@vindex nnspool-nov-directory
-Where @code{nnspool} will look for @acronym{NOV} files. This is normally@*
-@file{/usr/spool/news/over.view/}.
-
-@item nnspool-lib-dir
-@vindex nnspool-lib-dir
-Where the news lib dir is (@file{/usr/lib/news/} by default).
-
-@item nnspool-active-file
-@vindex nnspool-active-file
-The name of the active file.
-
-@item nnspool-newsgroups-file
-@vindex nnspool-newsgroups-file
-The name of the group descriptions file.
-
-@item nnspool-history-file
-@vindex nnspool-history-file
-The name of the news history file.
-
-@item nnspool-active-times-file
-@vindex nnspool-active-times-file
-The name of the active date file.
-
-@item nnspool-nov-is-evil
-@vindex nnspool-nov-is-evil
-If non-@code{nil}, @code{nnspool} won't try to use any @acronym{NOV} files
-that it finds.
-
-@item nnspool-sift-nov-with-sed
-@vindex nnspool-sift-nov-with-sed
-@cindex sed
-If non-@code{nil}, which is the default, use @code{sed} to get the
-relevant portion from the overview file. If @code{nil},
-@code{nnspool} will load the entire file into a buffer and process it
-there.
-
-@end table
-
-
-@node Getting Mail
-@section Getting Mail
-@cindex reading mail
-@cindex mail
-
-Reading mail with a newsreader---isn't that just plain WeIrD? But of
-course.
-
-@menu
-* Mail in a Newsreader:: Important introductory notes.
-* Getting Started Reading Mail:: A simple cookbook example.
-* Splitting Mail:: How to create mail groups.
-* Mail Sources:: How to tell Gnus where to get mail from.
-* Mail Back End Variables:: Variables for customizing mail handling.
-* Fancy Mail Splitting:: Gnus can do hairy splitting of incoming mail.
-* Group Mail Splitting:: Use group customize to drive mail splitting.
-* Incorporating Old Mail:: What about the old mail you have?
-* Expiring Mail:: Getting rid of unwanted mail.
-* Washing Mail:: Removing cruft from the mail you get.
-* Duplicates:: Dealing with duplicated mail.
-* Not Reading Mail:: Using mail back ends for reading other files.
-* Choosing a Mail Back End:: Gnus can read a variety of mail formats.
-@end menu
-
-
-@node Mail in a Newsreader
-@subsection Mail in a Newsreader
-
-If you are used to traditional mail readers, but have decided to switch
-to reading mail with Gnus, you may find yourself experiencing something
-of a culture shock.
-
-Gnus does not behave like traditional mail readers. If you want to make
-it behave that way, you can, but it's an uphill battle.
-
-Gnus, by default, handles all its groups using the same approach. This
-approach is very newsreaderly---you enter a group, see the new/unread
-messages, and when you read the messages, they get marked as read, and
-you don't see them any more. (Unless you explicitly ask for them.)
-
-In particular, you do not do anything explicitly to delete messages.
-
-Does this mean that all the messages that have been marked as read are
-deleted? How awful!
-
-But, no, it means that old messages are @dfn{expired} according to some
-scheme or other. For news messages, the expire process is controlled by
-the news administrator; for mail, the expire process is controlled by
-you. The expire process for mail is covered in depth in @ref{Expiring
-Mail}.
-
-What many Gnus users find, after using it a while for both news and
-mail, is that the transport mechanism has very little to do with how
-they want to treat a message.
-
-Many people subscribe to several mailing lists. These are transported
-via @acronym{SMTP}, and are therefore mail. But we might go for weeks without
-answering, or even reading these messages very carefully. We may not
-need to save them because if we should need to read one again, they are
-archived somewhere else.
-
-Some people have local news groups which have only a handful of readers.
-These are transported via @acronym{NNTP}, and are therefore news. But we may need
-to read and answer a large fraction of the messages very carefully in
-order to do our work. And there may not be an archive, so we may need
-to save the interesting messages the same way we would personal mail.
-
-The important distinction turns out to be not the transport mechanism,
-but other factors such as how interested we are in the subject matter,
-or how easy it is to retrieve the message if we need to read it again.
-
-Gnus provides many options for sorting mail into ``groups'' which behave
-like newsgroups, and for treating each group (whether mail or news)
-differently.
-
-Some users never get comfortable using the Gnus (ahem) paradigm and wish
-that Gnus should grow up and be a male, er, mail reader. It is possible
-to whip Gnus into a more mailreaderly being, but, as said before, it's
-not easy. People who prefer proper mail readers should try @sc{vm}
-instead, which is an excellent, and proper, mail reader.
-
-I don't mean to scare anybody off, but I want to make it clear that you
-may be required to learn a new way of thinking about messages. After
-you've been subjected to The Gnus Way, you will come to love it. I can
-guarantee it. (At least the guy who sold me the Emacs Subliminal
-Brain-Washing Functions that I've put into Gnus did guarantee it. You
-Will Be Assimilated. You Love Gnus. You Love The Gnus Mail Way.
-You Do.)
-
-
-@node Getting Started Reading Mail
-@subsection Getting Started Reading Mail
-
-It's quite easy to use Gnus to read your new mail. You just plonk the
-mail back end of your choice into @code{gnus-secondary-select-methods},
-and things will happen automatically.
-
-For instance, if you want to use @code{nnml} (which is a ``one file per
-mail'' back end), you could put the following in your @file{~/.gnus.el} file:
-
-@lisp
-(setq gnus-secondary-select-methods '((nnml "")))
-@end lisp
-
-Now, the next time you start Gnus, this back end will be queried for new
-articles, and it will move all the messages in your spool file to its
-directory, which is @file{~/Mail/} by default. The new group that will
-be created (@samp{mail.misc}) will be subscribed, and you can read it
-like any other group.
-
-You will probably want to split the mail into several groups, though:
-
-@lisp
-(setq nnmail-split-methods
- '(("junk" "^From:.*Lars Ingebrigtsen")
- ("crazy" "^Subject:.*die\\|^Organization:.*flabby")
- ("other" "")))
-@end lisp
-
-This will result in three new @code{nnml} mail groups being created:
-@samp{nnml:junk}, @samp{nnml:crazy}, and @samp{nnml:other}. All the
-mail that doesn't fit into the first two groups will be placed in the
-last group.
-
-This should be sufficient for reading mail with Gnus. You might want to
-give the other sections in this part of the manual a perusal, though.
-Especially @pxref{Choosing a Mail Back End} and @pxref{Expiring Mail}.
-
-
-@node Splitting Mail
-@subsection Splitting Mail
-@cindex splitting mail
-@cindex mail splitting
-@cindex mail filtering (splitting)
-
-@vindex nnmail-split-methods
-The @code{nnmail-split-methods} variable says how the incoming mail is
-to be split into groups.
-
-@lisp
-(setq nnmail-split-methods
- '(("mail.junk" "^From:.*Lars Ingebrigtsen")
- ("mail.crazy" "^Subject:.*die\\|^Organization:.*flabby")
- ("mail.other" "")))
-@end lisp
-
-This variable is a list of lists, where the first element of each of
-these lists is the name of the mail group (they do not have to be called
-something beginning with @samp{mail}, by the way), and the second
-element is a regular expression used on the header of each mail to
-determine if it belongs in this mail group. The first string may
-contain @samp{\\1} forms, like the ones used by @code{replace-match} to
-insert sub-expressions from the matched text. For instance:
-
-@lisp
-("list.\\1" "From:.* \\(.*\\)-list@@majordomo.com")
-@end lisp
-
-@noindent
-In that case, @code{nnmail-split-lowercase-expanded} controls whether
-the inserted text should be made lowercase. @xref{Fancy Mail Splitting}.
-
-The second element can also be a function. In that case, it will be
-called narrowed to the headers with the first element of the rule as the
-argument. It should return a non-@code{nil} value if it thinks that the
-mail belongs in that group.
-
-@cindex @samp{bogus} group
-The last of these groups should always be a general one, and the regular
-expression should @emph{always} be @samp{""} so that it matches any mails
-that haven't been matched by any of the other regexps. (These rules are
-processed from the beginning of the alist toward the end. The first rule
-to make a match will ``win'', unless you have crossposting enabled. In
-that case, all matching rules will ``win''.) If no rule matched, the mail
-will end up in the @samp{bogus} group. When new groups are created by
-splitting mail, you may want to run @code{gnus-group-find-new-groups} to
-see the new groups. This also applies to the @samp{bogus} group.
-
-If you like to tinker with this yourself, you can set this variable to a
-function of your choice. This function will be called without any
-arguments in a buffer narrowed to the headers of an incoming mail
-message. The function should return a list of group names that it
-thinks should carry this mail message.
-
-Note that the mail back ends are free to maul the poor, innocent,
-incoming headers all they want to. They all add @code{Lines} headers;
-some add @code{X-Gnus-Group} headers; most rename the Unix mbox
-@code{From<SPACE>} line to something else.
-
-@vindex nnmail-crosspost
-The mail back ends all support cross-posting. If several regexps match,
-the mail will be ``cross-posted'' to all those groups.
-@code{nnmail-crosspost} says whether to use this mechanism or not. Note
-that no articles are crossposted to the general (@samp{""}) group.
-
-@vindex nnmail-crosspost-link-function
-@cindex crosspost
-@cindex links
-@code{nnmh} and @code{nnml} makes crossposts by creating hard links to
-the crossposted articles. However, not all file systems support hard
-links. If that's the case for you, set
-@code{nnmail-crosspost-link-function} to @code{copy-file}. (This
-variable is @code{add-name-to-file} by default.)
-
-@kindex M-x nnmail-split-history
-@findex nnmail-split-history
-If you wish to see where the previous mail split put the messages, you
-can use the @kbd{M-x nnmail-split-history} command. If you wish to see
-where re-spooling messages would put the messages, you can use
-@code{gnus-summary-respool-trace} and related commands (@pxref{Mail
-Group Commands}).
-
-@vindex nnmail-split-header-length-limit
-Header lines longer than the value of
-@code{nnmail-split-header-length-limit} are excluded from the split
-function.
-
-@vindex nnmail-mail-splitting-decodes
-@vindex nnmail-mail-splitting-charset
-By default, splitting does not decode headers, so you can not match on
-non-@acronym{ASCII} strings. But it is useful if you want to match
-articles based on the raw header data. To enable it, set the
-@code{nnmail-mail-splitting-decodes} variable to a non-@code{nil} value.
-In addition, the value of the @code{nnmail-mail-splitting-charset}
-variable is used for decoding non-@acronym{MIME} encoded string when
-@code{nnmail-mail-splitting-decodes} is non-@code{nil}. The default
-value is @code{nil} which means not to decode non-@acronym{MIME} encoded
-string. A suitable value for you will be @code{undecided} or be the
-charset used normally in mails you are interested in.
-
-@vindex nnmail-resplit-incoming
-By default, splitting is performed on all incoming messages. If you
-specify a @code{directory} entry for the variable @code{mail-sources}
-(@pxref{Mail Source Specifiers}), however, then splitting does
-@emph{not} happen by default. You can set the variable
-@code{nnmail-resplit-incoming} to a non-@code{nil} value to make
-splitting happen even in this case. (This variable has no effect on
-other kinds of entries.)
-
-Gnus gives you all the opportunity you could possibly want for shooting
-yourself in the foot. Let's say you create a group that will contain
-all the mail you get from your boss. And then you accidentally
-unsubscribe from the group. Gnus will still put all the mail from your
-boss in the unsubscribed group, and so, when your boss mails you ``Have
-that report ready by Monday or you're fired!'', you'll never see it and,
-come Tuesday, you'll still believe that you're gainfully employed while
-you really should be out collecting empty bottles to save up for next
-month's rent money.
-
-
-@node Mail Sources
-@subsection Mail Sources
-
-Mail can be gotten from many different sources---the mail spool, from
-a @acronym{POP} mail server, from a procmail directory, or from a
-maildir, for instance.
-
-@menu
-* Mail Source Specifiers:: How to specify what a mail source is.
-* Mail Source Customization:: Some variables that influence things.
-* Fetching Mail:: Using the mail source specifiers.
-@end menu
-
-
-@node Mail Source Specifiers
-@subsubsection Mail Source Specifiers
-@cindex POP
-@cindex mail server
-@cindex procmail
-@cindex mail spool
-@cindex mail source
-
-You tell Gnus how to fetch mail by setting @code{mail-sources}
-(@pxref{Fetching Mail}) to a @dfn{mail source specifier}.
-
-Here's an example:
-
-@lisp
-(pop :server "pop3.mailserver.com" :user "myname")
-@end lisp
-
-As can be observed, a mail source specifier is a list where the first
-element is a @dfn{mail source type}, followed by an arbitrary number of
-@dfn{keywords}. Keywords that are not explicitly specified are given
-default values.
-
-The following mail source types are available:
-
-@table @code
-@item file
-Get mail from a single file; typically from the mail spool.
-
-Keywords:
-
-@table @code
-@item :path
-The file name. Defaults to the value of the @env{MAIL}
-environment variable or the value of @code{rmail-spool-directory}
-(usually something like @file{/usr/mail/spool/user-name}).
-
-@item :prescript
-@itemx :postscript
-Script run before/after fetching mail.
-@end table
-
-An example file mail source:
-
-@lisp
-(file :path "/usr/spool/mail/user-name")
-@end lisp
-
-Or using the default file name:
-
-@lisp
-(file)
-@end lisp
-
-If the mail spool file is not located on the local machine, it's best
-to use @acronym{POP} or @acronym{IMAP} or the like to fetch the mail.
-You can not use ange-ftp file names here---it has no way to lock the
-mail spool while moving the mail.
-
-If it's impossible to set up a proper server, you can use ssh instead.
-
-@lisp
-(setq mail-sources
- '((file :prescript "ssh host bin/getmail >%t")))
-@end lisp
-
-The @samp{getmail} script would look something like the following:
-
-@example
-#!/bin/sh
-# getmail - move mail from spool to stdout
-# flu@@iki.fi
-
-MOVEMAIL=/usr/lib/emacs/20.3/i386-redhat-linux/movemail
-TMP=$HOME/Mail/tmp
-rm -f $TMP; $MOVEMAIL $MAIL $TMP >/dev/null && cat $TMP
-@end example
-
-Alter this script to fit the @samp{movemail} and temporary
-file you want to use.
-
-
-@item directory
-@vindex nnmail-scan-directory-mail-source-once
-Get mail from several files in a directory. This is typically used
-when you have procmail split the incoming mail into several files.
-That is, there is a one-to-one correspondence between files in that
-directory and groups, so that mail from the file @file{foo.bar.spool}
-will be put in the group @code{foo.bar}. (You can change the suffix
-to be used instead of @code{.spool}.) Setting
-@code{nnmail-scan-directory-mail-source-once} to non-@code{nil} forces
-Gnus to scan the mail source only once. This is particularly useful
-if you want to scan mail groups at a specified level.
-
-@vindex nnmail-resplit-incoming
-There is also the variable @code{nnmail-resplit-incoming}, if you set
-that to a non-@code{nil} value, then the normal splitting process is
-applied to all the files from the directory, @ref{Splitting Mail}.
-
-Keywords:
-
-@table @code
-@item :path
-The name of the directory where the files are. There is no default
-value.
-
-@item :suffix
-Only files ending with this suffix are used. The default is
-@samp{.spool}.
-
-@item :predicate
-Only files that have this predicate return non-@code{nil} are returned.
-The default is @code{identity}. This is used as an additional
-filter---only files that have the right suffix @emph{and} satisfy this
-predicate are considered.
-
-@item :prescript
-@itemx :postscript
-Script run before/after fetching mail.
-
-@end table
-
-An example directory mail source:
-
-@lisp
-(directory :path "/home/user-name/procmail-dir/"
- :suffix ".prcml")
-@end lisp
-
-@item pop
-Get mail from a @acronym{POP} server.
-
-Keywords:
-
-@table @code
-@item :server
-The name of the @acronym{POP} server. The default is taken from the
-@env{MAILHOST} environment variable.
-
-@item :port
-The port number of the @acronym{POP} server. This can be a number (eg,
-@samp{:port 1234}) or a string (eg, @samp{:port "pop3"}). If it is a
-string, it should be a service name as listed in @file{/etc/services} on
-Unix systems. The default is @samp{"pop3"}. On some systems you might
-need to specify it as @samp{"pop-3"} instead.
-
-@item :user
-The user name to give to the @acronym{POP} server. The default is the login
-name.
-
-@item :password
-The password to give to the @acronym{POP} server. If not specified,
-the user is prompted.
-
-@item :program
-The program to use to fetch mail from the @acronym{POP} server. This
-should be a @code{format}-like string. Here's an example:
-
-@example
-fetchmail %u@@%s -P %p %t
-@end example
-
-The valid format specifier characters are:
-
-@table @samp
-@item t
-The name of the file the mail is to be moved to. This must always be
-included in this string.
-
-@item s
-The name of the server.
-
-@item P
-The port number of the server.
-
-@item u
-The user name to use.
-
-@item p
-The password to use.
-@end table
-
-The values used for these specs are taken from the values you give the
-corresponding keywords.
-
-@item :prescript
-A script to be run before fetching the mail. The syntax is the same as
-the @code{:program} keyword. This can also be a function to be run.
-
-@item :postscript
-A script to be run after fetching the mail. The syntax is the same as
-the @code{:program} keyword. This can also be a function to be run.
-
-@item :function
-The function to use to fetch mail from the @acronym{POP} server. The
-function is called with one parameter---the name of the file where the
-mail should be moved to.
-
-@item :authentication
-This can be either the symbol @code{password} or the symbol @code{apop}
-and says what authentication scheme to use. The default is
-@code{password}.
-
-@end table
-
-@vindex pop3-movemail
-@vindex pop3-leave-mail-on-server
-If the @code{:program} and @code{:function} keywords aren't specified,
-@code{pop3-movemail} will be used. If @code{pop3-leave-mail-on-server}
-is non-@code{nil} the mail is to be left on the @acronym{POP} server
-after fetching when using @code{pop3-movemail}. Note that POP servers
-maintain no state information between sessions, so what the client
-believes is there and what is actually there may not match up. If they
-do not, then you may get duplicate mails or the whole thing can fall
-apart and leave you with a corrupt mailbox.
-
-Here are some examples for getting mail from a @acronym{POP} server.
-Fetch from the default @acronym{POP} server, using the default user
-name, and default fetcher:
-
-@lisp
-(pop)
-@end lisp
-
-Fetch from a named server with a named user and password:
-
-@lisp
-(pop :server "my.pop.server"
- :user "user-name" :password "secret")
-@end lisp
-
-Use @samp{movemail} to move the mail:
-
-@lisp
-(pop :program "movemail po:%u %t %p")
-@end lisp
-
-@item maildir
-Get mail from a maildir. This is a type of mailbox that is supported by
-at least qmail and postfix, where each file in a special directory
-contains exactly one mail.
-
-Keywords:
-
-@table @code
-@item :path
-The name of the directory where the mails are stored. The default is
-taken from the @env{MAILDIR} environment variable or
-@file{~/Maildir/}.
-@item :subdirs
-The subdirectories of the Maildir. The default is
-@samp{("new" "cur")}.
-
-@c If you sometimes look at your mail through a pop3 daemon before fetching
-@c them with Gnus, you may also have to fetch your mails from the
-@c @code{cur} directory inside the maildir, like in the first example
-@c below.
-
-You can also get mails from remote hosts (because maildirs don't suffer
-from locking problems).
-
-@end table
-
-Two example maildir mail sources:
-
-@lisp
-(maildir :path "/home/user-name/Maildir/"
- :subdirs ("cur" "new"))
-@end lisp
-
-@lisp
-(maildir :path "/user@@remotehost.org:~/Maildir/"
- :subdirs ("new"))
-@end lisp
-
-@item imap
-Get mail from a @acronym{IMAP} server. If you don't want to use
-@acronym{IMAP} as intended, as a network mail reading protocol (ie
-with nnimap), for some reason or other, Gnus let you treat it similar
-to a @acronym{POP} server and fetches articles from a given
-@acronym{IMAP} mailbox. @xref{IMAP}, for more information.
-
-Note that for the Kerberos, GSSAPI, @acronym{TLS}/@acronym{SSL} and STARTTLS support you
-may need external programs and libraries, @xref{IMAP}.
-
-Keywords:
-
-@table @code
-@item :server
-The name of the @acronym{IMAP} server. The default is taken from the
-@env{MAILHOST} environment variable.
-
-@item :port
-The port number of the @acronym{IMAP} server. The default is @samp{143}, or
-@samp{993} for @acronym{TLS}/@acronym{SSL} connections.
-
-@item :user
-The user name to give to the @acronym{IMAP} server. The default is the login
-name.
-
-@item :password
-The password to give to the @acronym{IMAP} server. If not specified, the user is
-prompted.
-
-@item :stream
-What stream to use for connecting to the server, this is one of the
-symbols in @code{imap-stream-alist}. Right now, this means
-@samp{gssapi}, @samp{kerberos4}, @samp{starttls}, @samp{tls},
-@samp{ssl}, @samp{shell} or the default @samp{network}.
-
-@item :authentication
-Which authenticator to use for authenticating to the server, this is
-one of the symbols in @code{imap-authenticator-alist}. Right now,
-this means @samp{gssapi}, @samp{kerberos4}, @samp{digest-md5},
-@samp{cram-md5}, @samp{anonymous} or the default @samp{login}.
-
-@item :program
-When using the `shell' :stream, the contents of this variable is
-mapped into the @code{imap-shell-program} variable. This should be a
-@code{format}-like string (or list of strings). Here's an example:
-
-@example
-ssh %s imapd
-@end example
-
-The valid format specifier characters are:
-
-@table @samp
-@item s
-The name of the server.
-
-@item l
-User name from @code{imap-default-user}.
-
-@item p
-The port number of the server.
-@end table
-
-The values used for these specs are taken from the values you give the
-corresponding keywords.
-
-@item :mailbox
-The name of the mailbox to get mail from. The default is @samp{INBOX}
-which normally is the mailbox which receive incoming mail.
-
-@item :predicate
-The predicate used to find articles to fetch. The default, @samp{UNSEEN
-UNDELETED}, is probably the best choice for most people, but if you
-sometimes peek in your mailbox with a @acronym{IMAP} client and mark some
-articles as read (or; SEEN) you might want to set this to @samp{1:*}.
-Then all articles in the mailbox is fetched, no matter what. For a
-complete list of predicates, see RFC 2060 section 6.4.4.
-
-@item :fetchflag
-How to flag fetched articles on the server, the default @samp{\Deleted}
-will mark them as deleted, an alternative would be @samp{\Seen} which
-would simply mark them as read. These are the two most likely choices,
-but more flags are defined in RFC 2060 section 2.3.2.
-
-@item :dontexpunge
-If non-@code{nil}, don't remove all articles marked as deleted in the
-mailbox after finishing the fetch.
-
-@end table
-
-An example @acronym{IMAP} mail source:
-
-@lisp
-(imap :server "mail.mycorp.com"
- :stream kerberos4
- :fetchflag "\\Seen")
-@end lisp
-
-@item webmail
-Get mail from a webmail server, such as @uref{http://www.hotmail.com/},
-@uref{http://webmail.netscape.com/}, @uref{http://www.netaddress.com/},
-@uref{http://mail.yahoo.com/}.
-
-NOTE: Webmail largely depends on cookies. A "one-line-cookie" patch is
-required for url "4.0pre.46".
-
-WARNING: Mails may be lost. NO WARRANTY.
-
-Keywords:
-
-@table @code
-@item :subtype
-The type of the webmail server. The default is @code{hotmail}. The
-alternatives are @code{netscape}, @code{netaddress}, @code{my-deja}.
-
-@item :user
-The user name to give to the webmail server. The default is the login
-name.
-
-@item :password
-The password to give to the webmail server. If not specified, the user is
-prompted.
-
-@item :dontexpunge
-If non-@code{nil}, only fetch unread articles and don't move them to
-trash folder after finishing the fetch.
-
-@end table
-
-An example webmail source:
-
-@lisp
-(webmail :subtype 'hotmail
- :user "user-name"
- :password "secret")
-@end lisp
-@end table
-
-@table @dfn
-@item Common Keywords
-Common keywords can be used in any type of mail source.
-
-Keywords:
-
-@table @code
-@item :plugged
-If non-@code{nil}, fetch the mail even when Gnus is unplugged. If you
-use directory source to get mail, you can specify it as in this
-example:
-
-@lisp
-(setq mail-sources
- '((directory :path "/home/pavel/.Spool/"
- :suffix ""
- :plugged t)))
-@end lisp
-
-Gnus will then fetch your mail even when you are unplugged. This is
-useful when you use local mail and news.
-
-@end table
-@end table
-
-@subsubsection Function Interface
-
-Some of the above keywords specify a Lisp function to be executed.
-For each keyword @code{:foo}, the Lisp variable @code{foo} is bound to
-the value of the keyword while the function is executing. For example,
-consider the following mail-source setting:
-
-@lisp
-(setq mail-sources '((pop :user "jrl"
- :server "pophost" :function fetchfunc)))
-@end lisp
-
-While the function @code{fetchfunc} is executing, the symbol @code{user}
-is bound to @code{"jrl"}, and the symbol @code{server} is bound to
-@code{"pophost"}. The symbols @code{port}, @code{password},
-@code{program}, @code{prescript}, @code{postscript}, @code{function},
-and @code{authentication} are also bound (to their default values).
-
-See above for a list of keywords for each type of mail source.
-
-
-@node Mail Source Customization
-@subsubsection Mail Source Customization
-
-The following is a list of variables that influence how the mail is
-fetched. You would normally not need to set or change any of these
-variables.
-
-@table @code
-@item mail-source-crash-box
-@vindex mail-source-crash-box
-File where mail will be stored while processing it. The default is@*
-@file{~/.emacs-mail-crash-box}.
-
-@cindex Incoming*
-@item mail-source-delete-incoming
-@vindex mail-source-delete-incoming
-If non-@code{nil}, delete incoming files after handling them. If
-@code{t}, delete the files immediately, if @code{nil}, never delete any
-files. If a positive number, delete files older than number of days
-(the deletion will only happen when receiving new mail). You may also
-set @code{mail-source-delete-incoming} to @code{nil} and call
-@code{mail-source-delete-old-incoming} from a hook or interactively.
-@code{mail-source-delete-incoming} defaults to @code{2} in alpha Gnusae
-and @code{10} in released Gnusae. @xref{Gnus Development}.
-
-@item mail-source-delete-old-incoming-confirm
-@vindex mail-source-delete-old-incoming-confirm
-If non-@code{nil}, ask for confirmation before deleting old incoming
-files. This variable only applies when
-@code{mail-source-delete-incoming} is a positive number.
-
-@item mail-source-ignore-errors
-@vindex mail-source-ignore-errors
-If non-@code{nil}, ignore errors when reading mail from a mail source.
-
-@item mail-source-directory
-@vindex mail-source-directory
-Directory where incoming mail source files (if any) will be stored. The
-default is @file{~/Mail/}. At present, the only thing this is used for
-is to say where the incoming files will be stored if the variable
-@code{mail-source-delete-incoming} is @code{nil} or a number.
-
-@item mail-source-incoming-file-prefix
-@vindex mail-source-incoming-file-prefix
-Prefix for file name for storing incoming mail. The default is
-@file{Incoming}, in which case files will end up with names like
-@file{Incoming30630D_} or @file{Incoming298602ZD}. This is really only
-relevant if @code{mail-source-delete-incoming} is @code{nil} or a
-number.
-
-@item mail-source-default-file-modes
-@vindex mail-source-default-file-modes
-All new mail files will get this file mode. The default is 384.
-
-@item mail-source-movemail-program
-@vindex mail-source-movemail-program
-If non-@code{nil}, name of program for fetching new mail. If
-@code{nil}, @code{movemail} in @var{exec-directory}.
-
-@end table
-
-
-@node Fetching Mail
-@subsubsection Fetching Mail
-
-@vindex mail-sources
-The way to actually tell Gnus where to get new mail from is to set
-@code{mail-sources} to a list of mail source specifiers
-(@pxref{Mail Source Specifiers}).
-
-If this variable is @code{nil}, the mail back ends will never attempt to
-fetch mail by themselves.
-
-If you want to fetch mail both from your local spool as well as a
-@acronym{POP} mail server, you'd say something like:
-
-@lisp
-(setq mail-sources
- '((file)
- (pop :server "pop3.mail.server"
- :password "secret")))
-@end lisp
-
-Or, if you don't want to use any of the keyword defaults:
-
-@lisp
-(setq mail-sources
- '((file :path "/var/spool/mail/user-name")
- (pop :server "pop3.mail.server"
- :user "user-name"
- :port "pop3"
- :password "secret")))
-@end lisp
-
-
-When you use a mail back end, Gnus will slurp all your mail from your
-inbox and plonk it down in your home directory. Gnus doesn't move any
-mail if you're not using a mail back end---you have to do a lot of magic
-invocations first. At the time when you have finished drawing the
-pentagram, lightened the candles, and sacrificed the goat, you really
-shouldn't be too surprised when Gnus moves your mail.
-
-
-
-@node Mail Back End Variables
-@subsection Mail Back End Variables
-
-These variables are (for the most part) pertinent to all the various
-mail back ends.
-
-@table @code
-@vindex nnmail-read-incoming-hook
-@item nnmail-read-incoming-hook
-The mail back ends all call this hook after reading new mail. You can
-use this hook to notify any mail watch programs, if you want to.
-
-@vindex nnmail-split-hook
-@item nnmail-split-hook
-@findex gnus-article-decode-encoded-words
-@cindex RFC 1522 decoding
-@cindex RFC 2047 decoding
-Hook run in the buffer where the mail headers of each message is kept
-just before the splitting based on these headers is done. The hook is
-free to modify the buffer contents in any way it sees fit---the buffer
-is discarded after the splitting has been done, and no changes performed
-in the buffer will show up in any files.
-@code{gnus-article-decode-encoded-words} is one likely function to add
-to this hook.
-
-@vindex nnmail-pre-get-new-mail-hook
-@vindex nnmail-post-get-new-mail-hook
-@item nnmail-pre-get-new-mail-hook
-@itemx nnmail-post-get-new-mail-hook
-These are two useful hooks executed when treating new incoming
-mail---@code{nnmail-pre-get-new-mail-hook} (is called just before
-starting to handle the new mail) and
-@code{nnmail-post-get-new-mail-hook} (is called when the mail handling
-is done). Here's and example of using these two hooks to change the
-default file modes the new mail files get:
-
-@lisp
-(add-hook 'nnmail-pre-get-new-mail-hook
- (lambda () (set-default-file-modes 511)))
-
-(add-hook 'nnmail-post-get-new-mail-hook
- (lambda () (set-default-file-modes 551)))
-@end lisp
-
-@item nnmail-use-long-file-names
-@vindex nnmail-use-long-file-names
-If non-@code{nil}, the mail back ends will use long file and directory
-names. Groups like @samp{mail.misc} will end up in directories
-(assuming use of @code{nnml} back end) or files (assuming use of
-@code{nnfolder} back end) like @file{mail.misc}. If it is @code{nil},
-the same group will end up in @file{mail/misc}.
-
-@item nnmail-delete-file-function
-@vindex nnmail-delete-file-function
-@findex delete-file
-Function called to delete files. It is @code{delete-file} by default.
-
-@item nnmail-cache-accepted-message-ids
-@vindex nnmail-cache-accepted-message-ids
-If non-@code{nil}, put the @code{Message-ID}s of articles imported into
-the back end (via @code{Gcc}, for instance) into the mail duplication
-discovery cache. The default is @code{nil}.
-
-@item nnmail-cache-ignore-groups
-@vindex nnmail-cache-ignore-groups
-This can be a regular expression or a list of regular expressions.
-Group names that match any of the regular expressions will never be
-recorded in the @code{Message-ID} cache.
-
-This can be useful, for example, when using Fancy Splitting
-(@pxref{Fancy Mail Splitting}) together with the function
-@code{nnmail-split-fancy-with-parent}.
-
-@end table
-
-
-@node Fancy Mail Splitting
-@subsection Fancy Mail Splitting
-@cindex mail splitting
-@cindex fancy mail splitting
-
-@vindex nnmail-split-fancy
-@findex nnmail-split-fancy
-If the rather simple, standard method for specifying how to split mail
-doesn't allow you to do what you want, you can set
-@code{nnmail-split-methods} to @code{nnmail-split-fancy}. Then you can
-play with the @code{nnmail-split-fancy} variable.
-
-Let's look at an example value of this variable first:
-
-@lisp
-;; @r{Messages from the mailer daemon are not crossposted to any of}
-;; @r{the ordinary groups. Warnings are put in a separate group}
-;; @r{from real errors.}
-(| ("from" mail (| ("subject" "warn.*" "mail.warning")
- "mail.misc"))
- ;; @r{Non-error messages are crossposted to all relevant}
- ;; @r{groups, but we don't crosspost between the group for the}
- ;; @r{(ding) list and the group for other (ding) related mail.}
- (& (| (any "ding@@ifi\\.uio\\.no" "ding.list")
- ("subject" "ding" "ding.misc"))
- ;; @r{Other mailing lists@dots{}}
- (any "procmail@@informatik\\.rwth-aachen\\.de" "procmail.list")
- (any "SmartList@@informatik\\.rwth-aachen\\.de" "SmartList.list")
- ;; @r{Both lists below have the same suffix, so prevent}
- ;; @r{cross-posting to mkpkg.list of messages posted only to}
- ;; @r{the bugs- list, but allow cross-posting when the}
- ;; @r{message was really cross-posted.}
- (any "bugs-mypackage@@somewhere" "mypkg.bugs")
- (any "mypackage@@somewhere" - "bugs-mypackage" "mypkg.list")
- ;; @r{People@dots{}}
- (any "larsi@@ifi\\.uio\\.no" "people.Lars_Magne_Ingebrigtsen"))
- ;; @r{Unmatched mail goes to the catch all group.}
- "misc.misc")
-@end lisp
-
-This variable has the format of a @dfn{split}. A split is a
-(possibly) recursive structure where each split may contain other
-splits. Here are the possible split syntaxes:
-
-@table @code
-
-@item group
-If the split is a string, that will be taken as a group name. Normal
-regexp match expansion will be done. See below for examples.
-
-@c Don't fold this line.
-@item (@var{field} @var{value} [- @var{restrict} [@dots{}] ] @var{split} [@var{invert-partial}])
-The split can be a list containing at least three elements. If the
-first element @var{field} (a regexp matching a header) contains
-@var{value} (also a regexp) then store the message as specified by
-@var{split}.
-
-If @var{restrict} (yet another regexp) matches some string after
-@var{field} and before the end of the matched @var{value}, the
-@var{split} is ignored. If none of the @var{restrict} clauses match,
-@var{split} is processed.
-
-The last element @var{invert-partial} is optional. If it is
-non-@code{nil}, the match-partial-words behavior controlled by the
-variable @code{nnmail-split-fancy-match-partial-words} (see below) is
-be inverted. (New in Gnus 5.10.7)
-
-@item (| @var{split} @dots{})
-If the split is a list, and the first element is @code{|} (vertical
-bar), then process each @var{split} until one of them matches. A
-@var{split} is said to match if it will cause the mail message to be
-stored in one or more groups.
-
-@item (& @var{split} @dots{})
-If the split is a list, and the first element is @code{&}, then
-process all @var{split}s in the list.
-
-@item junk
-If the split is the symbol @code{junk}, then don't save (i.e., delete)
-this message. Use with extreme caution.
-
-@item (: @var{function} @var{arg1} @var{arg2} @dots{})
-If the split is a list, and the first element is @samp{:}, then the
-second element will be called as a function with @var{args} given as
-arguments. The function should return a @var{split}.
-
-@cindex body split
-For instance, the following function could be used to split based on the
-body of the messages:
-
-@lisp
-(defun split-on-body ()
- (save-excursion
- (save-restriction
- (widen)
- (goto-char (point-min))
- (when (re-search-forward "Some.*string" nil t)
- "string.group"))))
-@end lisp
-
-The buffer is narrowed to the header of the message in question when
-@var{function} is run. That's why @code{(widen)} needs to be called
-after @code{save-excursion} and @code{save-restriction} in the example
-above. Also note that with the nnimap backend, message bodies will
-not be downloaded by default. You need to set
-@code{nnimap-split-download-body} to @code{t} to do that
-(@pxref{Splitting in IMAP}).
-
-@item (! @var{func} @var{split})
-If the split is a list, and the first element is @code{!}, then
-@var{split} will be processed, and @var{func} will be called as a
-function with the result of @var{split} as argument. @var{func}
-should return a split.
-
-@item nil
-If the split is @code{nil}, it is ignored.
-
-@end table
-
-In these splits, @var{field} must match a complete field name.
-
-Normally, @var{value} in these splits must match a complete @emph{word}
-according to the fundamental mode syntax table. In other words, all
-@var{value}'s will be implicitly surrounded by @code{\<...\>} markers,
-which are word delimiters. Therefore, if you use the following split,
-for example,
-
-@example
-(any "joe" "joemail")
-@end example
-
-@noindent
-messages sent from @samp{joedavis@@foo.org} will normally not be filed
-in @samp{joemail}. If you want to alter this behavior, you can use any
-of the following three ways:
-
-@enumerate
-@item
-@vindex nnmail-split-fancy-match-partial-words
-You can set the @code{nnmail-split-fancy-match-partial-words} variable
-to non-@code{nil} in order to ignore word boundaries and instead the
-match becomes more like a grep. This variable controls whether partial
-words are matched during fancy splitting. The default value is
-@code{nil}.
-
-Note that it influences all @var{value}'s in your split rules.
-
-@item
-@var{value} beginning with @code{.*} ignores word boundaries in front of
-a word. Similarly, if @var{value} ends with @code{.*}, word boundaries
-in the rear of a word will be ignored. For example, the @var{value}
-@code{"@@example\\.com"} does not match @samp{foo@@example.com} but
-@code{".*@@example\\.com"} does.
-
-@item
-You can set the @var{invert-partial} flag in your split rules of the
-@samp{(@var{field} @var{value} @dots{})} types, aforementioned in this
-section. If the flag is set, word boundaries on both sides of a word
-are ignored even if @code{nnmail-split-fancy-match-partial-words} is
-@code{nil}. Contrarily, if the flag is set, word boundaries are not
-ignored even if @code{nnmail-split-fancy-match-partial-words} is
-non-@code{nil}. (New in Gnus 5.10.7)
-@end enumerate
-
-@vindex nnmail-split-abbrev-alist
-@var{field} and @var{value} can also be Lisp symbols, in that case
-they are expanded as specified by the variable
-@code{nnmail-split-abbrev-alist}. This is an alist of cons cells,
-where the @sc{car} of a cell contains the key, and the @sc{cdr}
-contains the associated value. Predefined entries in
-@code{nnmail-split-abbrev-alist} include:
-
-@table @code
-@item from
-Matches the @samp{From}, @samp{Sender} and @samp{Resent-From} fields.
-@item to
-Matches the @samp{To}, @samp{Cc}, @samp{Apparently-To},
-@samp{Resent-To} and @samp{Resent-Cc} fields.
-@item any
-Is the union of the @code{from} and @code{to} entries.
-@end table
-
-@vindex nnmail-split-fancy-syntax-table
-@code{nnmail-split-fancy-syntax-table} is the syntax table in effect
-when all this splitting is performed.
-
-If you want to have Gnus create groups dynamically based on some
-information in the headers (i.e., do @code{replace-match}-like
-substitutions in the group names), you can say things like:
-
-@example
-(any "debian-\\b\\(\\w+\\)@@lists.debian.org" "mail.debian.\\1")
-@end example
-
-In this example, messages sent to @samp{debian-foo@@lists.debian.org}
-will be filed in @samp{mail.debian.foo}.
-
-If the string contains the element @samp{\&}, then the previously
-matched string will be substituted. Similarly, the elements @samp{\\1}
-up to @samp{\\9} will be substituted with the text matched by the
-groupings 1 through 9.
-
-@vindex nnmail-split-lowercase-expanded
-Where @code{nnmail-split-lowercase-expanded} controls whether the
-lowercase of the matched string should be used for the substitution.
-Setting it as non-@code{nil} is useful to avoid the creation of multiple
-groups when users send to an address using different case
-(i.e. mailing-list@@domain vs Mailing-List@@Domain). The default value
-is @code{t}.
-
-@findex nnmail-split-fancy-with-parent
-@code{nnmail-split-fancy-with-parent} is a function which allows you to
-split followups into the same groups their parents are in. Sometimes
-you can't make splitting rules for all your mail. For example, your
-boss might send you personal mail regarding different projects you are
-working on, and as you can't tell your boss to put a distinguishing
-string into the subject line, you have to resort to manually moving the
-messages into the right group. With this function, you only have to do
-it once per thread.
-
-To use this feature, you have to set @code{nnmail-treat-duplicates}
-and @code{nnmail-cache-accepted-message-ids} to a non-@code{nil}
-value. And then you can include @code{nnmail-split-fancy-with-parent}
-using the colon feature, like so:
-@lisp
-(setq nnmail-treat-duplicates 'warn ; @r{or @code{delete}}
- nnmail-cache-accepted-message-ids t
- nnmail-split-fancy
- '(| (: nnmail-split-fancy-with-parent)
- ;; @r{other splits go here}
- ))
-@end lisp
-
-This feature works as follows: when @code{nnmail-treat-duplicates} is
-non-@code{nil}, Gnus records the message id of every message it sees
-in the file specified by the variable
-@code{nnmail-message-id-cache-file}, together with the group it is in
-(the group is omitted for non-mail messages). When mail splitting is
-invoked, the function @code{nnmail-split-fancy-with-parent} then looks
-at the References (and In-Reply-To) header of each message to split
-and searches the file specified by @code{nnmail-message-id-cache-file}
-for the message ids. When it has found a parent, it returns the
-corresponding group name unless the group name matches the regexp
-@code{nnmail-split-fancy-with-parent-ignore-groups}. It is
-recommended that you set @code{nnmail-message-id-cache-length} to a
-somewhat higher number than the default so that the message ids are
-still in the cache. (A value of 5000 appears to create a file some
-300 kBytes in size.)
-@vindex nnmail-cache-accepted-message-ids
-When @code{nnmail-cache-accepted-message-ids} is non-@code{nil}, Gnus
-also records the message ids of moved articles, so that the followup
-messages goes into the new group.
-
-Also see the variable @code{nnmail-cache-ignore-groups} if you don't
-want certain groups to be recorded in the cache. For example, if all
-outgoing messages are written to an ``outgoing'' group, you could set
-@code{nnmail-cache-ignore-groups} to match that group name.
-Otherwise, answers to all your messages would end up in the
-``outgoing'' group.
-
-
-@node Group Mail Splitting
-@subsection Group Mail Splitting
-@cindex mail splitting
-@cindex group mail splitting
-
-@findex gnus-group-split
-If you subscribe to dozens of mailing lists but you don't want to
-maintain mail splitting rules manually, group mail splitting is for you.
-You just have to set @code{to-list} and/or @code{to-address} in group
-parameters or group customization and set @code{nnmail-split-methods} to
-@code{gnus-group-split}. This splitting function will scan all groups
-for those parameters and split mail accordingly, i.e., messages posted
-from or to the addresses specified in the parameters @code{to-list} or
-@code{to-address} of a mail group will be stored in that group.
-
-Sometimes, mailing lists have multiple addresses, and you may want mail
-splitting to recognize them all: just set the @code{extra-aliases} group
-parameter to the list of additional addresses and it's done. If you'd
-rather use a regular expression, set @code{split-regexp}.
-
-All these parameters in a group will be used to create an
-@code{nnmail-split-fancy} split, in which the @var{field} is @samp{any},
-the @var{value} is a single regular expression that matches
-@code{to-list}, @code{to-address}, all of @code{extra-aliases} and all
-matches of @code{split-regexp}, and the @var{split} is the name of the
-group. @var{restrict}s are also supported: just set the
-@code{split-exclude} parameter to a list of regular expressions.
-
-If you can't get the right split to be generated using all these
-parameters, or you just need something fancier, you can set the
-parameter @code{split-spec} to an @code{nnmail-split-fancy} split. In
-this case, all other aforementioned parameters will be ignored by
-@code{gnus-group-split}. In particular, @code{split-spec} may be set to
-@code{nil}, in which case the group will be ignored by
-@code{gnus-group-split}.
-
-@vindex gnus-group-split-default-catch-all-group
-@code{gnus-group-split} will do cross-posting on all groups that match,
-by defining a single @code{&} fancy split containing one split for each
-group. If a message doesn't match any split, it will be stored in the
-group named in @code{gnus-group-split-default-catch-all-group}, unless
-some group has @code{split-spec} set to @code{catch-all}, in which case
-that group is used as the catch-all group. Even though this variable is
-often used just to name a group, it may also be set to an arbitrarily
-complex fancy split (after all, a group name is a fancy split), and this
-may be useful to split mail that doesn't go to any mailing list to
-personal mail folders. Note that this fancy split is added as the last
-element of a @code{|} split list that also contains a @code{&} split
-with the rules extracted from group parameters.
-
-It's time for an example. Assume the following group parameters have
-been defined:
-
-@example
-nnml:mail.bar:
-((to-address . "bar@@femail.com")
- (split-regexp . ".*@@femail\\.com"))
-nnml:mail.foo:
-((to-list . "foo@@nowhere.gov")
- (extra-aliases "foo@@localhost" "foo-redist@@home")
- (split-exclude "bugs-foo" "rambling-foo")
- (admin-address . "foo-request@@nowhere.gov"))
-nnml:mail.others:
-((split-spec . catch-all))
-@end example
-
-Setting @code{nnmail-split-methods} to @code{gnus-group-split} will
-behave as if @code{nnmail-split-fancy} had been selected and variable
-@code{nnmail-split-fancy} had been set as follows:
-
-@lisp
-(| (& (any "\\(bar@@femail\\.com\\|.*@@femail\\.com\\)" "mail.bar")
- (any "\\(foo@@nowhere\\.gov\\|foo@@localhost\\|foo-redist@@home\\)"
- - "bugs-foo" - "rambling-foo" "mail.foo"))
- "mail.others")
-@end lisp
-
-@findex gnus-group-split-fancy
-If you'd rather not use group splitting for all your mail groups, you
-may use it for only some of them, by using @code{nnmail-split-fancy}
-splits like this:
-
-@lisp
-(: gnus-group-split-fancy @var{groups} @var{no-crosspost} @var{catch-all})
-@end lisp
-
-@var{groups} may be a regular expression or a list of group names whose
-parameters will be scanned to generate the output split.
-@var{no-crosspost} can be used to disable cross-posting; in this case, a
-single @code{|} split will be output. @var{catch-all} is the fall back
-fancy split, used like @code{gnus-group-split-default-catch-all-group}.
-If @var{catch-all} is @code{nil}, or if @code{split-regexp} matches the
-empty string in any selected group, no catch-all split will be issued.
-Otherwise, if some group has @code{split-spec} set to @code{catch-all},
-this group will override the value of the @var{catch-all} argument.
-
-@findex gnus-group-split-setup
-Unfortunately, scanning all groups and their parameters can be quite
-slow, especially considering that it has to be done for every message.
-But don't despair! The function @code{gnus-group-split-setup} can be
-used to enable @code{gnus-group-split} in a much more efficient way. It
-sets @code{nnmail-split-methods} to @code{nnmail-split-fancy} and sets
-@code{nnmail-split-fancy} to the split produced by
-@code{gnus-group-split-fancy}. Thus, the group parameters are only
-scanned once, no matter how many messages are split.
-
-@findex gnus-group-split-update
-However, if you change group parameters, you'd have to update
-@code{nnmail-split-fancy} manually. You can do it by running
-@code{gnus-group-split-update}. If you'd rather have it updated
-automatically, just tell @code{gnus-group-split-setup} to do it for
-you. For example, add to your @file{~/.gnus.el}:
-
-@lisp
-(gnus-group-split-setup @var{auto-update} @var{catch-all})
-@end lisp
-
-If @var{auto-update} is non-@code{nil}, @code{gnus-group-split-update}
-will be added to @code{nnmail-pre-get-new-mail-hook}, so you won't ever
-have to worry about updating @code{nnmail-split-fancy} again. If you
-don't omit @var{catch-all} (it's optional, equivalent to @code{nil}),
-@code{gnus-group-split-default-catch-all-group} will be set to its
-value.
-
-@vindex gnus-group-split-updated-hook
-Because you may want to change @code{nnmail-split-fancy} after it is set
-by @code{gnus-group-split-update}, this function will run
-@code{gnus-group-split-updated-hook} just before finishing.
-
-@node Incorporating Old Mail
-@subsection Incorporating Old Mail
-@cindex incorporating old mail
-@cindex import old mail
-
-Most people have lots of old mail stored in various file formats. If
-you have set up Gnus to read mail using one of the spiffy Gnus mail
-back ends, you'll probably wish to have that old mail incorporated into
-your mail groups.
-
-Doing so can be quite easy.
-
-To take an example: You're reading mail using @code{nnml}
-(@pxref{Mail Spool}), and have set @code{nnmail-split-methods} to a
-satisfactory value (@pxref{Splitting Mail}). You have an old Unix mbox
-file filled with important, but old, mail. You want to move it into
-your @code{nnml} groups.
-
-Here's how:
-
-@enumerate
-@item
-Go to the group buffer.
-
-@item
-Type @kbd{G f} and give the file name to the mbox file when prompted to create an
-@code{nndoc} group from the mbox file (@pxref{Foreign Groups}).
-
-@item
-Type @kbd{SPACE} to enter the newly created group.
-
-@item
-Type @kbd{M P b} to process-mark all articles in this group's buffer
-(@pxref{Setting Process Marks}).
-
-@item
-Type @kbd{B r} to respool all the process-marked articles, and answer
-@samp{nnml} when prompted (@pxref{Mail Group Commands}).
-@end enumerate
-
-All the mail messages in the mbox file will now also be spread out over
-all your @code{nnml} groups. Try entering them and check whether things
-have gone without a glitch. If things look ok, you may consider
-deleting the mbox file, but I wouldn't do that unless I was absolutely
-sure that all the mail has ended up where it should be.
-
-Respooling is also a handy thing to do if you're switching from one mail
-back end to another. Just respool all the mail in the old mail groups
-using the new mail back end.
-
-
-@node Expiring Mail
-@subsection Expiring Mail
-@cindex article expiry
-@cindex expiring mail
-
-Traditional mail readers have a tendency to remove mail articles when
-you mark them as read, in some way. Gnus takes a fundamentally
-different approach to mail reading.
-
-Gnus basically considers mail just to be news that has been received in
-a rather peculiar manner. It does not think that it has the power to
-actually change the mail, or delete any mail messages. If you enter a
-mail group, and mark articles as ``read'', or kill them in some other
-fashion, the mail articles will still exist on the system. I repeat:
-Gnus will not delete your old, read mail. Unless you ask it to, of
-course.
-
-To make Gnus get rid of your unwanted mail, you have to mark the
-articles as @dfn{expirable}. (With the default key bindings, this means
-that you have to type @kbd{E}.) This does not mean that the articles
-will disappear right away, however. In general, a mail article will be
-deleted from your system if, 1) it is marked as expirable, AND 2) it is
-more than one week old. If you do not mark an article as expirable, it
-will remain on your system until hell freezes over. This bears
-repeating one more time, with some spurious capitalizations: IF you do
-NOT mark articles as EXPIRABLE, Gnus will NEVER delete those ARTICLES.
-
-You do not have to mark articles as expirable by hand. Gnus provides
-two features, called ``auto-expire'' and ``total-expire'', that can help you
-with this. In a nutshell, ``auto-expire'' means that Gnus hits @kbd{E}
-for you when you select an article. And ``total-expire'' means that Gnus
-considers all articles as expirable that are read. So, in addition to
-the articles marked @samp{E}, also the articles marked @samp{r},
-@samp{R}, @samp{O}, @samp{K}, @samp{Y} and so on are considered
-expirable.
-
-When should either auto-expire or total-expire be used? Most people
-who are subscribed to mailing lists split each list into its own group
-and then turn on auto-expire or total-expire for those groups.
-(@xref{Splitting Mail}, for more information on splitting each list
-into its own group.)
-
-Which one is better, auto-expire or total-expire? It's not easy to
-answer. Generally speaking, auto-expire is probably faster. Another
-advantage of auto-expire is that you get more marks to work with: for
-the articles that are supposed to stick around, you can still choose
-between tick and dormant and read marks. But with total-expire, you
-only have dormant and ticked to choose from. The advantage of
-total-expire is that it works well with adaptive scoring (@pxref{Adaptive
-Scoring}). Auto-expire works with normal scoring but not with adaptive
-scoring.
-
-@vindex gnus-auto-expirable-newsgroups
-Groups that match the regular expression
-@code{gnus-auto-expirable-newsgroups} will have all articles that you
-read marked as expirable automatically. All articles marked as
-expirable have an @samp{E} in the first column in the summary buffer.
-
-By default, if you have auto expiry switched on, Gnus will mark all the
-articles you read as expirable, no matter if they were read or unread
-before. To avoid having articles marked as read marked as expirable
-automatically, you can put something like the following in your
-@file{~/.gnus.el} file:
-
-@vindex gnus-mark-article-hook
-@lisp
-(remove-hook 'gnus-mark-article-hook
- 'gnus-summary-mark-read-and-unread-as-read)
-(add-hook 'gnus-mark-article-hook 'gnus-summary-mark-unread-as-read)
-@end lisp
-
-Note that making a group auto-expirable doesn't mean that all read
-articles are expired---only the articles marked as expirable
-will be expired. Also note that using the @kbd{d} command won't make
-articles expirable---only semi-automatic marking of articles as read will
-mark the articles as expirable in auto-expirable groups.
-
-Let's say you subscribe to a couple of mailing lists, and you want the
-articles you have read to disappear after a while:
-
-@lisp
-(setq gnus-auto-expirable-newsgroups
- "mail.nonsense-list\\|mail.nice-list")
-@end lisp
-
-Another way to have auto-expiry happen is to have the element
-@code{auto-expire} in the group parameters of the group.
-
-If you use adaptive scoring (@pxref{Adaptive Scoring}) and
-auto-expiring, you'll have problems. Auto-expiring and adaptive scoring
-don't really mix very well.
-
-@vindex nnmail-expiry-wait
-The @code{nnmail-expiry-wait} variable supplies the default time an
-expirable article has to live. Gnus starts counting days from when the
-message @emph{arrived}, not from when it was sent. The default is seven
-days.
-
-Gnus also supplies a function that lets you fine-tune how long articles
-are to live, based on what group they are in. Let's say you want to
-have one month expiry period in the @samp{mail.private} group, a one day
-expiry period in the @samp{mail.junk} group, and a six day expiry period
-everywhere else:
-
-@vindex nnmail-expiry-wait-function
-@lisp
-(setq nnmail-expiry-wait-function
- (lambda (group)
- (cond ((string= group "mail.private")
- 31)
- ((string= group "mail.junk")
- 1)
- ((string= group "important")
- 'never)
- (t
- 6))))
-@end lisp
-
-The group names this function is fed are ``unadorned'' group
-names---no @samp{nnml:} prefixes and the like.
-
-The @code{nnmail-expiry-wait} variable and
-@code{nnmail-expiry-wait-function} function can either be a number (not
-necessarily an integer) or one of the symbols @code{immediate} or
-@code{never}.
-
-You can also use the @code{expiry-wait} group parameter to selectively
-change the expiry period (@pxref{Group Parameters}).
-
-@vindex nnmail-expiry-target
-The normal action taken when expiring articles is to delete them.
-However, in some circumstances it might make more sense to move them
-to other groups instead of deleting them. The variable
-@code{nnmail-expiry-target} (and the @code{expiry-target} group
-parameter) controls this. The variable supplies a default value for
-all groups, which can be overridden for specific groups by the group
-parameter. default value is @code{delete}, but this can also be a
-string (which should be the name of the group the message should be
-moved to), or a function (which will be called in a buffer narrowed to
-the message in question, and with the name of the group being moved
-from as its parameter) which should return a target---either a group
-name or @code{delete}.
-
-Here's an example for specifying a group name:
-@lisp
-(setq nnmail-expiry-target "nnml:expired")
-@end lisp
-
-@findex nnmail-fancy-expiry-target
-@vindex nnmail-fancy-expiry-targets
-Gnus provides a function @code{nnmail-fancy-expiry-target} which will
-expire mail to groups according to the variable
-@code{nnmail-fancy-expiry-targets}. Here's an example:
-
-@lisp
- (setq nnmail-expiry-target 'nnmail-fancy-expiry-target
- nnmail-fancy-expiry-targets
- '((to-from "boss" "nnfolder:Work")
- ("subject" "IMPORTANT" "nnfolder:IMPORTANT.%Y.%b")
- ("from" ".*" "nnfolder:Archive-%Y")))
-@end lisp
-
-With this setup, any mail that has @code{IMPORTANT} in its Subject
-header and was sent in the year @code{YYYY} and month @code{MMM}, will
-get expired to the group @code{nnfolder:IMPORTANT.YYYY.MMM}. If its
-From or To header contains the string @code{boss}, it will get expired
-to @code{nnfolder:Work}. All other mail will get expired to
-@code{nnfolder:Archive-YYYY}.
-
-@vindex nnmail-keep-last-article
-If @code{nnmail-keep-last-article} is non-@code{nil}, Gnus will never
-expire the final article in a mail newsgroup. This is to make life
-easier for procmail users.
-
-@vindex gnus-total-expirable-newsgroups
-By the way: That line up there, about Gnus never expiring non-expirable
-articles, is a lie. If you put @code{total-expire} in the group
-parameters, articles will not be marked as expirable, but all read
-articles will be put through the expiry process. Use with extreme
-caution. Even more dangerous is the
-@code{gnus-total-expirable-newsgroups} variable. All groups that match
-this regexp will have all read articles put through the expiry process,
-which means that @emph{all} old mail articles in the groups in question
-will be deleted after a while. Use with extreme caution, and don't come
-crying to me when you discover that the regexp you used matched the
-wrong group and all your important mail has disappeared. Be a
-@emph{man}! Or a @emph{woman}! Whatever you feel more comfortable
-with! So there!
-
-Most people make most of their mail groups total-expirable, though.
-
-@vindex gnus-inhibit-user-auto-expire
-If @code{gnus-inhibit-user-auto-expire} is non-@code{nil}, user marking
-commands will not mark an article as expirable, even if the group has
-auto-expire turned on.
-
-
-@node Washing Mail
-@subsection Washing Mail
-@cindex mail washing
-@cindex list server brain damage
-@cindex incoming mail treatment
-
-Mailers and list servers are notorious for doing all sorts of really,
-really stupid things with mail. ``Hey, RFC 822 doesn't explicitly
-prohibit us from adding the string @code{wE aRe ElItE!!!!!1!!} to the
-end of all lines passing through our server, so let's do that!!!!1!''
-Yes, but RFC 822 wasn't designed to be read by morons. Things that were
-considered to be self-evident were not discussed. So. Here we are.
-
-Case in point: The German version of Microsoft Exchange adds @samp{AW:
-} to the subjects of replies instead of @samp{Re: }. I could pretend to
-be shocked and dismayed by this, but I haven't got the energy. It is to
-laugh.
-
-Gnus provides a plethora of functions for washing articles while
-displaying them, but it might be nicer to do the filtering before
-storing the mail to disk. For that purpose, we have three hooks and
-various functions that can be put in these hooks.
-
-@table @code
-@item nnmail-prepare-incoming-hook
-@vindex nnmail-prepare-incoming-hook
-This hook is called before doing anything with the mail and is meant for
-grand, sweeping gestures. It is called in a buffer that contains all
-the new, incoming mail. Functions to be used include:
-
-@table @code
-@item nnheader-ms-strip-cr
-@findex nnheader-ms-strip-cr
-Remove trailing carriage returns from each line. This is default on
-Emacs running on MS machines.
-
-@end table
-
-@item nnmail-prepare-incoming-header-hook
-@vindex nnmail-prepare-incoming-header-hook
-This hook is called narrowed to each header. It can be used when
-cleaning up the headers. Functions that can be used include:
-
-@table @code
-@item nnmail-remove-leading-whitespace
-@findex nnmail-remove-leading-whitespace
-Clear leading white space that ``helpful'' listservs have added to the
-headers to make them look nice. Aaah.
-
-(Note that this function works on both the header on the body of all
-messages, so it is a potentially dangerous function to use (if a body
-of a message contains something that looks like a header line). So
-rather than fix the bug, it is of course the right solution to make it
-into a feature by documenting it.)
-
-@item nnmail-remove-list-identifiers
-@findex nnmail-remove-list-identifiers
-Some list servers add an identifier---for example, @samp{(idm)}---to the
-beginning of all @code{Subject} headers. I'm sure that's nice for
-people who use stone age mail readers. This function will remove
-strings that match the @code{nnmail-list-identifiers} regexp, which can
-also be a list of regexp. @code{nnmail-list-identifiers} may not contain
-@code{\\(..\\)}.
-
-For instance, if you want to remove the @samp{(idm)} and the
-@samp{nagnagnag} identifiers:
-
-@lisp
-(setq nnmail-list-identifiers
- '("(idm)" "nagnagnag"))
-@end lisp
-
-This can also be done non-destructively with
-@code{gnus-list-identifiers}, @xref{Article Hiding}.
-
-@item nnmail-remove-tabs
-@findex nnmail-remove-tabs
-Translate all @samp{TAB} characters into @samp{SPACE} characters.
-
-@item nnmail-fix-eudora-headers
-@findex nnmail-fix-eudora-headers
-@cindex Eudora
-Eudora produces broken @code{References} headers, but OK
-@code{In-Reply-To} headers. This function will get rid of the
-@code{References} headers.
-
-@end table
-
-@item nnmail-prepare-incoming-message-hook
-@vindex nnmail-prepare-incoming-message-hook
-This hook is called narrowed to each message. Functions to be used
-include:
-
-@table @code
-@item article-de-quoted-unreadable
-@findex article-de-quoted-unreadable
-Decode Quoted Readable encoding.
-
-@end table
-@end table
-
-
-@node Duplicates
-@subsection Duplicates
-
-@vindex nnmail-treat-duplicates
-@vindex nnmail-message-id-cache-length
-@vindex nnmail-message-id-cache-file
-@cindex duplicate mails
-If you are a member of a couple of mailing lists, you will sometimes
-receive two copies of the same mail. This can be quite annoying, so
-@code{nnmail} checks for and treats any duplicates it might find. To do
-this, it keeps a cache of old @code{Message-ID}s---
-@code{nnmail-message-id-cache-file}, which is @file{~/.nnmail-cache} by
-default. The approximate maximum number of @code{Message-ID}s stored
-there is controlled by the @code{nnmail-message-id-cache-length}
-variable, which is 1000 by default. (So 1000 @code{Message-ID}s will be
-stored.) If all this sounds scary to you, you can set
-@code{nnmail-treat-duplicates} to @code{warn} (which is what it is by
-default), and @code{nnmail} won't delete duplicate mails. Instead it
-will insert a warning into the head of the mail saying that it thinks
-that this is a duplicate of a different message.
-
-This variable can also be a function. If that's the case, the function
-will be called from a buffer narrowed to the message in question with
-the @code{Message-ID} as a parameter. The function must return either
-@code{nil}, @code{warn}, or @code{delete}.
-
-You can turn this feature off completely by setting the variable to
-@code{nil}.
-
-If you want all the duplicate mails to be put into a special
-@dfn{duplicates} group, you could do that using the normal mail split
-methods:
-
-@lisp
-(setq nnmail-split-fancy
- '(| ;; @r{Messages duplicates go to a separate group.}
- ("gnus-warning" "duplicat\\(e\\|ion\\) of message" "duplicate")
- ;; @r{Message from daemons, postmaster, and the like to another.}
- (any mail "mail.misc")
- ;; @r{Other rules.}
- [...] ))
-@end lisp
-@noindent
-Or something like:
-@lisp
-(setq nnmail-split-methods
- '(("duplicates" "^Gnus-Warning:.*duplicate")
- ;; @r{Other rules.}
- [...]))
-@end lisp
-
-Here's a neat feature: If you know that the recipient reads her mail
-with Gnus, and that she has @code{nnmail-treat-duplicates} set to
-@code{delete}, you can send her as many insults as you like, just by
-using a @code{Message-ID} of a mail that you know that she's already
-received. Think of all the fun! She'll never see any of it! Whee!
-
-
-@node Not Reading Mail
-@subsection Not Reading Mail
-
-If you start using any of the mail back ends, they have the annoying
-habit of assuming that you want to read mail with them. This might not
-be unreasonable, but it might not be what you want.
-
-If you set @code{mail-sources} and @code{nnmail-spool-file} to
-@code{nil}, none of the back ends will ever attempt to read incoming
-mail, which should help.
-
-@vindex nnbabyl-get-new-mail
-@vindex nnmbox-get-new-mail
-@vindex nnml-get-new-mail
-@vindex nnmh-get-new-mail
-@vindex nnfolder-get-new-mail
-This might be too much, if, for instance, you are reading mail quite
-happily with @code{nnml} and just want to peek at some old Rmail
-file you have stashed away with @code{nnbabyl}. All back ends have
-variables called back-end-@code{get-new-mail}. If you want to disable
-the @code{nnbabyl} mail reading, you edit the virtual server for the
-group to have a setting where @code{nnbabyl-get-new-mail} to @code{nil}.
-
-All the mail back ends will call @code{nn}*@code{-prepare-save-mail-hook}
-narrowed to the article to be saved before saving it when reading
-incoming mail.
-
-
-@node Choosing a Mail Back End
-@subsection Choosing a Mail Back End
-
-Gnus will read the mail spool when you activate a mail group. The mail
-file is first copied to your home directory. What happens after that
-depends on what format you want to store your mail in.
-
-There are six different mail back ends in the standard Gnus, and more
-back ends are available separately. The mail back end most people use
-(because it is possibly the fastest) is @code{nnml} (@pxref{Mail
-Spool}).
-
-@menu
-* Unix Mail Box:: Using the (quite) standard Un*x mbox.
-* Rmail Babyl:: Emacs programs use the Rmail Babyl format.
-* Mail Spool:: Store your mail in a private spool?
-* MH Spool:: An mhspool-like back end.
-* Maildir:: Another one-file-per-message format.
-* Mail Folders:: Having one file for each group.
-* Comparing Mail Back Ends:: An in-depth looks at pros and cons.
-@end menu
-
-
-@node Unix Mail Box
-@subsubsection Unix Mail Box
-@cindex nnmbox
-@cindex unix mail box
-
-@vindex nnmbox-active-file
-@vindex nnmbox-mbox-file
-The @dfn{nnmbox} back end will use the standard Un*x mbox file to store
-mail. @code{nnmbox} will add extra headers to each mail article to say
-which group it belongs in.
-
-Virtual server settings:
-
-@table @code
-@item nnmbox-mbox-file
-@vindex nnmbox-mbox-file
-The name of the mail box in the user's home directory. Default is
-@file{~/mbox}.
-
-@item nnmbox-active-file
-@vindex nnmbox-active-file
-The name of the active file for the mail box. Default is
-@file{~/.mbox-active}.
-
-@item nnmbox-get-new-mail
-@vindex nnmbox-get-new-mail
-If non-@code{nil}, @code{nnmbox} will read incoming mail and split it
-into groups. Default is @code{t}.
-@end table
-
-
-@node Rmail Babyl
-@subsubsection Rmail Babyl
-@cindex nnbabyl
-@cindex Rmail mbox
-
-@vindex nnbabyl-active-file
-@vindex nnbabyl-mbox-file
-The @dfn{nnbabyl} back end will use a Babyl mail box (aka. @dfn{Rmail
-mbox}) to store mail. @code{nnbabyl} will add extra headers to each
-mail article to say which group it belongs in.
-
-Virtual server settings:
-
-@table @code
-@item nnbabyl-mbox-file
-@vindex nnbabyl-mbox-file
-The name of the Rmail mbox file. The default is @file{~/RMAIL}
-
-@item nnbabyl-active-file
-@vindex nnbabyl-active-file
-The name of the active file for the rmail box. The default is
-@file{~/.rmail-active}
-
-@item nnbabyl-get-new-mail
-@vindex nnbabyl-get-new-mail
-If non-@code{nil}, @code{nnbabyl} will read incoming mail. Default is
-@code{t}
-@end table
-
-
-@node Mail Spool
-@subsubsection Mail Spool
-@cindex nnml
-@cindex mail @acronym{NOV} spool
-
-The @dfn{nnml} spool mail format isn't compatible with any other known
-format. It should be used with some caution.
-
-@vindex nnml-directory
-If you use this back end, Gnus will split all incoming mail into files,
-one file for each mail, and put the articles into the corresponding
-directories under the directory specified by the @code{nnml-directory}
-variable. The default value is @file{~/Mail/}.
-
-You do not have to create any directories beforehand; Gnus will take
-care of all that.
-
-If you have a strict limit as to how many files you are allowed to store
-in your account, you should not use this back end. As each mail gets its
-own file, you might very well occupy thousands of inodes within a few
-weeks. If this is no problem for you, and it isn't a problem for you
-having your friendly systems administrator walking around, madly,
-shouting ``Who is eating all my inodes?! Who? Who!?!'', then you should
-know that this is probably the fastest format to use. You do not have
-to trudge through a big mbox file just to read your new mail.
-
-@code{nnml} is probably the slowest back end when it comes to article
-splitting. It has to create lots of files, and it also generates
-@acronym{NOV} databases for the incoming mails. This makes it possibly the
-fastest back end when it comes to reading mail.
-
-@cindex self contained nnml servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnml}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnml} server) and have all your marks be preserved. Marks
-for a group is usually stored in the @code{.marks} file (but see
-@code{nnml-marks-file-name}) within each @code{nnml} group's directory.
-Individual @code{nnml} groups are also possible to backup, use @kbd{G m}
-to restore the group (after restoring the backup into the nnml
-directory).
-
-If for some reason you believe your @file{.marks} files are screwed
-up, you can just delete them all. Gnus will then correctly regenerate
-them next time it starts.
-
-Virtual server settings:
-
-@table @code
-@item nnml-directory
-@vindex nnml-directory
-All @code{nnml} directories will be placed under this directory. The
-default is the value of @code{message-directory} (whose default value
-is @file{~/Mail}).
-
-@item nnml-active-file
-@vindex nnml-active-file
-The active file for the @code{nnml} server. The default is
-@file{~/Mail/active}.
-
-@item nnml-newsgroups-file
-@vindex nnml-newsgroups-file
-The @code{nnml} group descriptions file. @xref{Newsgroups File
-Format}. The default is @file{~/Mail/newsgroups}.
-
-@item nnml-get-new-mail
-@vindex nnml-get-new-mail
-If non-@code{nil}, @code{nnml} will read incoming mail. The default is
-@code{t}.
-
-@item nnml-nov-is-evil
-@vindex nnml-nov-is-evil
-If non-@code{nil}, this back end will ignore any @acronym{NOV} files. The
-default is @code{nil}.
-
-@item nnml-nov-file-name
-@vindex nnml-nov-file-name
-The name of the @acronym{NOV} files. The default is @file{.overview}.
-
-@item nnml-prepare-save-mail-hook
-@vindex nnml-prepare-save-mail-hook
-Hook run narrowed to an article before saving.
-
-@item nnml-marks-is-evil
-@vindex nnml-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnml-marks-file-name
-@vindex nnml-marks-file-name
-The name of the @dfn{marks} files. The default is @file{.marks}.
-
-@item nnml-use-compressed-files
-@vindex nnml-use-compressed-files
-If non-@code{nil}, @code{nnml} will allow using compressed message
-files.
-
-@end table
-
-@findex nnml-generate-nov-databases
-If your @code{nnml} groups and @acronym{NOV} files get totally out of
-whack, you can do a complete update by typing @kbd{M-x
-nnml-generate-nov-databases}. This command will trawl through the
-entire @code{nnml} hierarchy, looking at each and every article, so it
-might take a while to complete. A better interface to this
-functionality can be found in the server buffer (@pxref{Server
-Commands}).
-
-
-@node MH Spool
-@subsubsection MH Spool
-@cindex nnmh
-@cindex mh-e mail spool
-
-@code{nnmh} is just like @code{nnml}, except that is doesn't generate
-@acronym{NOV} databases and it doesn't keep an active file or marks
-file. This makes @code{nnmh} a @emph{much} slower back end than
-@code{nnml}, but it also makes it easier to write procmail scripts
-for.
-
-Virtual server settings:
-
-@table @code
-@item nnmh-directory
-@vindex nnmh-directory
-All @code{nnmh} directories will be located under this directory. The
-default is the value of @code{message-directory} (whose default is
-@file{~/Mail})
-
-@item nnmh-get-new-mail
-@vindex nnmh-get-new-mail
-If non-@code{nil}, @code{nnmh} will read incoming mail. The default is
-@code{t}.
-
-@item nnmh-be-safe
-@vindex nnmh-be-safe
-If non-@code{nil}, @code{nnmh} will go to ridiculous lengths to make
-sure that the articles in the folder are actually what Gnus thinks
-they are. It will check date stamps and stat everything in sight, so
-setting this to @code{t} will mean a serious slow-down. If you never
-use anything but Gnus to read the @code{nnmh} articles, you do not
-have to set this variable to @code{t}. The default is @code{nil}.
-@end table
-
-
-@node Maildir
-@subsubsection Maildir
-@cindex nnmaildir
-@cindex maildir
-
-@code{nnmaildir} stores mail in the maildir format, with each maildir
-corresponding to a group in Gnus. This format is documented here:
-@uref{http://cr.yp.to/proto/maildir.html} and here:
-@uref{http://www.qmail.org/man/man5/maildir.html}. @code{nnmaildir}
-also stores extra information in the @file{.nnmaildir/} directory
-within a maildir.
-
-Maildir format was designed to allow concurrent deliveries and
-reading, without needing locks. With other back ends, you would have
-your mail delivered to a spool of some kind, and then you would
-configure Gnus to split mail from that spool into your groups. You
-can still do that with @code{nnmaildir}, but the more common
-configuration is to have your mail delivered directly to the maildirs
-that appear as group in Gnus.
-
-@code{nnmaildir} is designed to be perfectly reliable: @kbd{C-g} will
-never corrupt its data in memory, and @code{SIGKILL} will never
-corrupt its data in the filesystem.
-
-@code{nnmaildir} stores article marks and @acronym{NOV} data in each
-maildir. So you can copy a whole maildir from one Gnus setup to
-another, and you will keep your marks.
-
-Virtual server settings:
-
-@table @code
-@item directory
-For each of your @code{nnmaildir} servers (it's very unlikely that
-you'd need more than one), you need to create a directory and populate
-it with maildirs or symlinks to maildirs (and nothing else; do not
-choose a directory already used for other purposes). Each maildir
-will be represented in Gnus as a newsgroup on that server; the
-filename of the symlink will be the name of the group. Any filenames
-in the directory starting with @samp{.} are ignored. The directory is
-scanned when you first start Gnus, and each time you type @kbd{g} in
-the group buffer; if any maildirs have been removed or added,
-@code{nnmaildir} notices at these times.
-
-The value of the @code{directory} parameter should be a Lisp form
-which is processed by @code{eval} and @code{expand-file-name} to get
-the path of the directory for this server. The form is @code{eval}ed
-only when the server is opened; the resulting string is used until the
-server is closed. (If you don't know about forms and @code{eval},
-don't worry---a simple string will work.) This parameter is not
-optional; you must specify it. I don't recommend using
-@code{"~/Mail"} or a subdirectory of it; several other parts of Gnus
-use that directory by default for various things, and may get confused
-if @code{nnmaildir} uses it too. @code{"~/.nnmaildir"} is a typical
-value.
-
-@item target-prefix
-This should be a Lisp form which is processed by @code{eval} and
-@code{expand-file-name}. The form is @code{eval}ed only when the
-server is opened; the resulting string is used until the server is
-closed.
-
-When you create a group on an @code{nnmaildir} server, the maildir is
-created with @code{target-prefix} prepended to its name, and a symlink
-pointing to that maildir is created, named with the plain group name.
-So if @code{directory} is @code{"~/.nnmaildir"} and
-@code{target-prefix} is @code{"../maildirs/"}, then when you create
-the group @code{foo}, @code{nnmaildir} will create
-@file{~/.nnmaildir/../maildirs/foo} as a maildir, and will create
-@file{~/.nnmaildir/foo} as a symlink pointing to
-@file{../maildirs/foo}.
-
-You can set @code{target-prefix} to a string without any slashes to
-create both maildirs and symlinks in the same @code{directory}; in
-this case, any maildirs found in @code{directory} whose names start
-with @code{target-prefix} will not be listed as groups (but the
-symlinks pointing to them will be).
-
-As a special case, if @code{target-prefix} is @code{""} (the default),
-then when you create a group, the maildir will be created in
-@code{directory} without a corresponding symlink. Beware that you
-cannot use @code{gnus-group-delete-group} on such groups without the
-@code{force} argument.
-
-@item directory-files
-This should be a function with the same interface as
-@code{directory-files} (such as @code{directory-files} itself). It is
-used to scan the server's @code{directory} for maildirs. This
-parameter is optional; the default is
-@code{nnheader-directory-files-safe} if
-@code{nnheader-directory-files-is-safe} is @code{nil}, and
-@code{directory-files} otherwise.
-(@code{nnheader-directory-files-is-safe} is checked only once when the
-server is opened; if you want to check it each time the directory is
-scanned, you'll have to provide your own function that does that.)
-
-@item get-new-mail
-If non-@code{nil}, then after scanning for new mail in the group
-maildirs themselves as usual, this server will also incorporate mail
-the conventional Gnus way, from @code{mail-sources} according to
-@code{nnmail-split-methods} or @code{nnmail-split-fancy}. The default
-value is @code{nil}.
-
-Do @emph{not} use the same maildir both in @code{mail-sources} and as
-an @code{nnmaildir} group. The results might happen to be useful, but
-that would be by chance, not by design, and the results might be
-different in the future. If your split rules create new groups,
-remember to supply a @code{create-directory} server parameter.
-@end table
-
-@subsubsection Group parameters
-
-@code{nnmaildir} uses several group parameters. It's safe to ignore
-all this; the default behavior for @code{nnmaildir} is the same as the
-default behavior for other mail back ends: articles are deleted after
-one week, etc. Except for the expiry parameters, all this
-functionality is unique to @code{nnmaildir}, so you can ignore it if
-you're just trying to duplicate the behavior you already have with
-another back end.
-
-If the value of any of these parameters is a vector, the first element
-is evaluated as a Lisp form and the result is used, rather than the
-original value. If the value is not a vector, the value itself is
-evaluated as a Lisp form. (This is why these parameters use names
-different from those of other, similar parameters supported by other
-back ends: they have different, though similar, meanings.) (For
-numbers, strings, @code{nil}, and @code{t}, you can ignore the
-@code{eval} business again; for other values, remember to use an extra
-quote and wrap the value in a vector when appropriate.)
-
-@table @code
-@item expire-age
-An integer specifying the minimum age, in seconds, of an article
-before it will be expired, or the symbol @code{never} to specify that
-articles should never be expired. If this parameter is not set,
-@code{nnmaildir} falls back to the usual
-@code{nnmail-expiry-wait}(@code{-function}) variables (the
-@code{expiry-wait} group parameter overrides @code{nnmail-expiry-wait}
-and makes @code{nnmail-expiry-wait-function} ineffective). If you
-wanted a value of 3 days, you could use something like @code{[(* 3 24
-60 60)]}; @code{nnmaildir} will evaluate the form and use the result.
-An article's age is measured starting from the article file's
-modification time. Normally, this is the same as the article's
-delivery time, but editing an article makes it younger. Moving an
-article (other than via expiry) may also make an article younger.
-
-@item expire-group
-If this is set to a string such as a full Gnus group name, like
-@example
-"backend+server.address.string:group.name"
-@end example
-and if it is not the name of the same group that the parameter belongs
-to, then articles will be moved to the specified group during expiry
-before being deleted. @emph{If this is set to an @code{nnmaildir}
-group, the article will be just as old in the destination group as it
-was in the source group.} So be careful with @code{expire-age} in the
-destination group. If this is set to the name of the same group that
-the parameter belongs to, then the article is not expired at all. If
-you use the vector form, the first element is evaluated once for each
-article. So that form can refer to
-@code{nnmaildir-article-file-name}, etc., to decide where to put the
-article. @emph{Even if this parameter is not set, @code{nnmaildir}
-does not fall back to the @code{expiry-target} group parameter or the
-@code{nnmail-expiry-target} variable.}
-
-@item read-only
-If this is set to @code{t}, @code{nnmaildir} will treat the articles
-in this maildir as read-only. This means: articles are not renamed
-from @file{new/} into @file{cur/}; articles are only found in
-@file{new/}, not @file{cur/}; articles are never deleted; articles
-cannot be edited. @file{new/} is expected to be a symlink to the
-@file{new/} directory of another maildir---e.g., a system-wide mailbox
-containing a mailing list of common interest. Everything in the
-maildir outside @file{new/} is @emph{not} treated as read-only, so for
-a shared mailbox, you do still need to set up your own maildir (or
-have write permission to the shared mailbox); your maildir just won't
-contain extra copies of the articles.
-
-@item directory-files
-A function with the same interface as @code{directory-files}. It is
-used to scan the directories in the maildir corresponding to this
-group to find articles. The default is the function specified by the
-server's @code{directory-files} parameter.
-
-@item distrust-Lines:
-If non-@code{nil}, @code{nnmaildir} will always count the lines of an
-article, rather than use the @code{Lines:} header field. If
-@code{nil}, the header field will be used if present.
-
-@item always-marks
-A list of mark symbols, such as @code{['(read expire)]}. Whenever
-Gnus asks @code{nnmaildir} for article marks, @code{nnmaildir} will
-say that all articles have these marks, regardless of whether the
-marks stored in the filesystem say so. This is a proof-of-concept
-feature that will probably be removed eventually; it ought to be done
-in Gnus proper, or abandoned if it's not worthwhile.
-
-@item never-marks
-A list of mark symbols, such as @code{['(tick expire)]}. Whenever
-Gnus asks @code{nnmaildir} for article marks, @code{nnmaildir} will
-say that no articles have these marks, regardless of whether the marks
-stored in the filesystem say so. @code{never-marks} overrides
-@code{always-marks}. This is a proof-of-concept feature that will
-probably be removed eventually; it ought to be done in Gnus proper, or
-abandoned if it's not worthwhile.
-
-@item nov-cache-size
-An integer specifying the size of the @acronym{NOV} memory cache. To
-speed things up, @code{nnmaildir} keeps @acronym{NOV} data in memory
-for a limited number of articles in each group. (This is probably not
-worthwhile, and will probably be removed in the future.) This
-parameter's value is noticed only the first time a group is seen after
-the server is opened---i.e., when you first start Gnus, typically.
-The @acronym{NOV} cache is never resized until the server is closed
-and reopened. The default is an estimate of the number of articles
-that would be displayed in the summary buffer: a count of articles
-that are either marked with @code{tick} or not marked with
-@code{read}, plus a little extra.
-@end table
-
-@subsubsection Article identification
-Articles are stored in the @file{cur/} subdirectory of each maildir.
-Each article file is named like @code{uniq:info}, where @code{uniq}
-contains no colons. @code{nnmaildir} ignores, but preserves, the
-@code{:info} part. (Other maildir readers typically use this part of
-the filename to store marks.) The @code{uniq} part uniquely
-identifies the article, and is used in various places in the
-@file{.nnmaildir/} subdirectory of the maildir to store information
-about the corresponding article. The full pathname of an article is
-available in the variable @code{nnmaildir-article-file-name} after you
-request the article in the summary buffer.
-
-@subsubsection NOV data
-An article identified by @code{uniq} has its @acronym{NOV} data (used
-to generate lines in the summary buffer) stored in
-@code{.nnmaildir/nov/uniq}. There is no
-@code{nnmaildir-generate-nov-databases} function. (There isn't much
-need for it---an article's @acronym{NOV} data is updated automatically
-when the article or @code{nnmail-extra-headers} has changed.) You can
-force @code{nnmaildir} to regenerate the @acronym{NOV} data for a
-single article simply by deleting the corresponding @acronym{NOV}
-file, but @emph{beware}: this will also cause @code{nnmaildir} to
-assign a new article number for this article, which may cause trouble
-with @code{seen} marks, the Agent, and the cache.
-
-@subsubsection Article marks
-An article identified by @code{uniq} is considered to have the mark
-@code{flag} when the file @file{.nnmaildir/marks/flag/uniq} exists.
-When Gnus asks @code{nnmaildir} for a group's marks, @code{nnmaildir}
-looks for such files and reports the set of marks it finds. When Gnus
-asks @code{nnmaildir} to store a new set of marks, @code{nnmaildir}
-creates and deletes the corresponding files as needed. (Actually,
-rather than create a new file for each mark, it just creates hard
-links to @file{.nnmaildir/markfile}, to save inodes.)
-
-You can invent new marks by creating a new directory in
-@file{.nnmaildir/marks/}. You can tar up a maildir and remove it from
-your server, untar it later, and keep your marks. You can add and
-remove marks yourself by creating and deleting mark files. If you do
-this while Gnus is running and your @code{nnmaildir} server is open,
-it's best to exit all summary buffers for @code{nnmaildir} groups and
-type @kbd{s} in the group buffer first, and to type @kbd{g} or
-@kbd{M-g} in the group buffer afterwards. Otherwise, Gnus might not
-pick up the changes, and might undo them.
-
-
-@node Mail Folders
-@subsubsection Mail Folders
-@cindex nnfolder
-@cindex mbox folders
-@cindex mail folders
-
-@code{nnfolder} is a back end for storing each mail group in a
-separate file. Each file is in the standard Un*x mbox format.
-@code{nnfolder} will add extra headers to keep track of article
-numbers and arrival dates.
-
-@cindex self contained nnfolder servers
-@cindex marks
-When the marks file is used (which it is by default), @code{nnfolder}
-servers have the property that you may backup them using @code{tar} or
-similar, and later be able to restore them into Gnus (by adding the
-proper @code{nnfolder} server) and have all your marks be preserved.
-Marks for a group are usually stored in a file named as the mbox file
-with @code{.mrk} concatenated to it (but see
-@code{nnfolder-marks-file-suffix}) within the @code{nnfolder}
-directory. Individual @code{nnfolder} groups are also possible to
-backup, use @kbd{G m} to restore the group (after restoring the backup
-into the @code{nnfolder} directory).
-
-Virtual server settings:
-
-@table @code
-@item nnfolder-directory
-@vindex nnfolder-directory
-All the @code{nnfolder} mail boxes will be stored under this
-directory. The default is the value of @code{message-directory}
-(whose default is @file{~/Mail})
-
-@item nnfolder-active-file
-@vindex nnfolder-active-file
-The name of the active file. The default is @file{~/Mail/active}.
-
-@item nnfolder-newsgroups-file
-@vindex nnfolder-newsgroups-file
-The name of the group descriptions file. @xref{Newsgroups File
-Format}. The default is @file{~/Mail/newsgroups}
-
-@item nnfolder-get-new-mail
-@vindex nnfolder-get-new-mail
-If non-@code{nil}, @code{nnfolder} will read incoming mail. The
-default is @code{t}
-
-@item nnfolder-save-buffer-hook
-@vindex nnfolder-save-buffer-hook
-@cindex backup files
-Hook run before saving the folders. Note that Emacs does the normal
-backup renaming of files even with the @code{nnfolder} buffers. If
-you wish to switch this off, you could say something like the
-following in your @file{.emacs} file:
-
-@lisp
-(defun turn-off-backup ()
- (set (make-local-variable 'backup-inhibited) t))
-
-(add-hook 'nnfolder-save-buffer-hook 'turn-off-backup)
-@end lisp
-
-@item nnfolder-delete-mail-hook
-@vindex nnfolder-delete-mail-hook
-Hook run in a buffer narrowed to the message that is to be deleted.
-This function can be used to copy the message to somewhere else, or to
-extract some information from it before removing it.
-
-@item nnfolder-nov-is-evil
-@vindex nnfolder-nov-is-evil
-If non-@code{nil}, this back end will ignore any @acronym{NOV} files. The
-default is @code{nil}.
-
-@item nnfolder-nov-file-suffix
-@vindex nnfolder-nov-file-suffix
-The extension for @acronym{NOV} files. The default is @file{.nov}.
-
-@item nnfolder-nov-directory
-@vindex nnfolder-nov-directory
-The directory where the @acronym{NOV} files should be stored. If
-@code{nil}, @code{nnfolder-directory} is used.
-
-@item nnfolder-marks-is-evil
-@vindex nnfolder-marks-is-evil
-If non-@code{nil}, this back end will ignore any @sc{marks} files. The
-default is @code{nil}.
-
-@item nnfolder-marks-file-suffix
-@vindex nnfolder-marks-file-suffix
-The extension for @sc{marks} files. The default is @file{.mrk}.
-
-@item nnfolder-marks-directory
-@vindex nnfolder-marks-directory
-The directory where the @sc{marks} files should be stored. If
-@code{nil}, @code{nnfolder-directory} is used.
-
-@end table
-
-
-@findex nnfolder-generate-active-file
-@kindex M-x nnfolder-generate-active-file
-If you have lots of @code{nnfolder}-like files you'd like to read with
-@code{nnfolder}, you can use the @kbd{M-x nnfolder-generate-active-file}
-command to make @code{nnfolder} aware of all likely files in
-@code{nnfolder-directory}. This only works if you use long file names,
-though.
-
-@node Comparing Mail Back Ends
-@subsubsection Comparing Mail Back Ends
-
-First, just for terminology, the @dfn{back end} is the common word for a
-low-level access method---a transport, if you will, by which something
-is acquired. The sense is that one's mail has to come from somewhere,
-and so selection of a suitable back end is required in order to get that
-mail within spitting distance of Gnus.
-
-The same concept exists for Usenet itself: Though access to articles is
-typically done by @acronym{NNTP} these days, once upon a midnight dreary, everyone
-in the world got at Usenet by running a reader on the machine where the
-articles lay (the machine which today we call an @acronym{NNTP} server), and
-access was by the reader stepping into the articles' directory spool
-area directly. One can still select between either the @code{nntp} or
-@code{nnspool} back ends, to select between these methods, if one happens
-actually to live on the server (or can see its spool directly, anyway,
-via NFS).
-
-The goal in selecting a mail back end is to pick one which
-simultaneously represents a suitable way of dealing with the original
-format plus leaving mail in a form that is convenient to use in the
-future. Here are some high and low points on each:
-
-@table @code
-@item nnmbox
-
-UNIX systems have historically had a single, very common, and well-
-defined format. All messages arrive in a single @dfn{spool file}, and
-they are delineated by a line whose regular expression matches
-@samp{^From_}. (My notational use of @samp{_} is to indicate a space,
-to make it clear in this instance that this is not the RFC-specified
-@samp{From:} header.) Because Emacs and therefore Gnus emanate
-historically from the Unix environment, it is simplest if one does not
-mess a great deal with the original mailbox format, so if one chooses
-this back end, Gnus' primary activity in getting mail from the real spool
-area to Gnus' preferred directory is simply to copy it, with no
-(appreciable) format change in the process. It is the ``dumbest'' way
-to move mail into availability in the Gnus environment. This makes it
-fast to move into place, but slow to parse, when Gnus has to look at
-what's where.
-
-@item nnbabyl
-
-Once upon a time, there was the DEC-10 and DEC-20, running operating
-systems called TOPS and related things, and the usual (only?) mail
-reading environment was a thing called Babyl. I don't know what format
-was used for mail landing on the system, but Babyl had its own internal
-format to which mail was converted, primarily involving creating a
-spool-file-like entity with a scheme for inserting Babyl-specific
-headers and status bits above the top of each message in the file.
-Rmail was Emacs' first mail reader, it was written by Richard Stallman,
-and Stallman came out of that TOPS/Babyl environment, so he wrote Rmail
-to understand the mail files folks already had in existence. Gnus (and
-VM, for that matter) continue to support this format because it's
-perceived as having some good qualities in those mailer-specific
-headers/status bits stuff. Rmail itself still exists as well, of
-course, and is still maintained by Stallman.
-
-Both of the above forms leave your mail in a single file on your
-file system, and they must parse that entire file each time you take a
-look at your mail.
-
-@item nnml
-
-@code{nnml} is the back end which smells the most as though you were
-actually operating with an @code{nnspool}-accessed Usenet system. (In
-fact, I believe @code{nnml} actually derived from @code{nnspool} code,
-lo these years ago.) One's mail is taken from the original spool file,
-and is then cut up into individual message files, 1:1. It maintains a
-Usenet-style active file (analogous to what one finds in an INN- or
-CNews-based news system in (for instance) @file{/var/lib/news/active},
-or what is returned via the @samp{NNTP LIST} verb) and also creates
-@dfn{overview} files for efficient group entry, as has been defined for
-@acronym{NNTP} servers for some years now. It is slower in mail-splitting,
-due to the creation of lots of files, updates to the @code{nnml} active
-file, and additions to overview files on a per-message basis, but it is
-extremely fast on access because of what amounts to the indexing support
-provided by the active file and overviews.
-
-@code{nnml} costs @dfn{inodes} in a big way; that is, it soaks up the
-resource which defines available places in the file system to put new
-files. Sysadmins take a dim view of heavy inode occupation within
-tight, shared file systems. But if you live on a personal machine where
-the file system is your own and space is not at a premium, @code{nnml}
-wins big.
-
-It is also problematic using this back end if you are living in a
-FAT16-based Windows world, since much space will be wasted on all these
-tiny files.
-
-@item nnmh
-
-The Rand MH mail-reading system has been around UNIX systems for a very
-long time; it operates by splitting one's spool file of messages into
-individual files, but with little or no indexing support---@code{nnmh}
-is considered to be semantically equivalent to ``@code{nnml} without
-active file or overviews''. This is arguably the worst choice, because
-one gets the slowness of individual file creation married to the
-slowness of access parsing when learning what's new in one's groups.
-
-@item nnfolder
-
-Basically the effect of @code{nnfolder} is @code{nnmbox} (the first
-method described above) on a per-group basis. That is, @code{nnmbox}
-itself puts @emph{all} one's mail in one file; @code{nnfolder} provides a
-little bit of optimization to this so that each of one's mail groups has
-a Unix mail box file. It's faster than @code{nnmbox} because each group
-can be parsed separately, and still provides the simple Unix mail box
-format requiring minimal effort in moving the mail around. In addition,
-it maintains an ``active'' file making it much faster for Gnus to figure
-out how many messages there are in each separate group.
-
-If you have groups that are expected to have a massive amount of
-messages, @code{nnfolder} is not the best choice, but if you receive
-only a moderate amount of mail, @code{nnfolder} is probably the most
-friendly mail back end all over.
-
-@item nnmaildir
-
-For configuring expiry and other things, @code{nnmaildir} uses
-incompatible group parameters, slightly different from those of other
-mail back ends.
-
-@code{nnmaildir} is largely similar to @code{nnml}, with some notable
-differences. Each message is stored in a separate file, but the
-filename is unrelated to the article number in Gnus. @code{nnmaildir}
-also stores the equivalent of @code{nnml}'s overview files in one file
-per article, so it uses about twice as many inodes as @code{nnml}. (Use
-@code{df -i} to see how plentiful your inode supply is.) If this slows
-you down or takes up very much space, consider switching to
-@uref{http://www.namesys.com/, ReiserFS} or another non-block-structured
-file system.
-
-Since maildirs don't require locking for delivery, the maildirs you use
-as groups can also be the maildirs your mail is directly delivered to.
-This means you can skip Gnus' mail splitting if your mail is already
-organized into different mailboxes during delivery. A @code{directory}
-entry in @code{mail-sources} would have a similar effect, but would
-require one set of mailboxes for spooling deliveries (in mbox format,
-thus damaging message bodies), and another set to be used as groups (in
-whatever format you like). A maildir has a built-in spool, in the
-@code{new/} subdirectory. Beware that currently, mail moved from
-@code{new/} to @code{cur/} instead of via mail splitting will not
-undergo treatment such as duplicate checking.
-
-@code{nnmaildir} stores article marks for a given group in the
-corresponding maildir, in a way designed so that it's easy to manipulate
-them from outside Gnus. You can tar up a maildir, unpack it somewhere
-else, and still have your marks. @code{nnml} also stores marks, but
-it's not as easy to work with them from outside Gnus as with
-@code{nnmaildir}.
-
-@code{nnmaildir} uses a significant amount of memory to speed things up.
-(It keeps in memory some of the things that @code{nnml} stores in files
-and that @code{nnmh} repeatedly parses out of message files.) If this
-is a problem for you, you can set the @code{nov-cache-size} group
-parameter to something small (0 would probably not work, but 1 probably
-would) to make it use less memory. This caching will probably be
-removed in the future.
-
-Startup is likely to be slower with @code{nnmaildir} than with other
-back ends. Everything else is likely to be faster, depending in part
-on your file system.
-
-@code{nnmaildir} does not use @code{nnoo}, so you cannot use @code{nnoo}
-to write an @code{nnmaildir}-derived back end.
-
-@end table
-
-
-@node Browsing the Web
-@section Browsing the Web
-@cindex web
-@cindex browsing the web
-@cindex www
-@cindex http
-
-Web-based discussion forums are getting more and more popular. On many
-subjects, the web-based forums have become the most important forums,
-eclipsing the importance of mailing lists and news groups. The reason
-is easy to understand---they are friendly to new users; you just point
-and click, and there's the discussion. With mailing lists, you have to
-go through a cumbersome subscription procedure, and most people don't
-even know what a news group is.
-
-The problem with this scenario is that web browsers are not very good at
-being newsreaders. They do not keep track of what articles you've read;
-they do not allow you to score on subjects you're interested in; they do
-not allow off-line browsing; they require you to click around and drive
-you mad in the end.
-
-So---if web browsers suck at reading discussion forums, why not use Gnus
-to do it instead?
-
-Gnus has been getting a bit of a collection of back ends for providing
-interfaces to these sources.
-
-@menu
-* Archiving Mail::
-* Web Searches:: Creating groups from articles that match a string.
-* Slashdot:: Reading the Slashdot comments.
-* Ultimate:: The Ultimate Bulletin Board systems.
-* Web Archive:: Reading mailing list archived on web.
-* RSS:: Reading RDF site summary.
-* Customizing W3:: Doing stuff to Emacs/W3 from Gnus.
-@end menu
-
-All the web sources require Emacs/W3 and the url library or those
-alternatives to work.
-
-The main caveat with all these web sources is that they probably won't
-work for a very long time. Gleaning information from the @acronym{HTML} data
-is guesswork at best, and when the layout is altered, the Gnus back end
-will fail. If you have reasonably new versions of these back ends,
-though, you should be ok.
-
-One thing all these Web methods have in common is that the Web sources
-are often down, unavailable or just plain too slow to be fun. In those
-cases, it makes a lot of sense to let the Gnus Agent (@pxref{Gnus
-Unplugged}) handle downloading articles, and then you can read them at
-leisure from your local disk. No more World Wide Wait for you.
-
-@node Archiving Mail
-@subsection Archiving Mail
-@cindex archiving mail
-@cindex backup of mail
-
-Some of the back ends, notably @code{nnml}, @code{nnfolder}, and
-@code{nnmaildir}, now actually store the article marks with each group.
-For these servers, archiving and restoring a group while preserving
-marks is fairly simple.
-
-(Preserving the group level and group parameters as well still
-requires ritual dancing and sacrifices to the @file{.newsrc.eld} deity
-though.)
-
-To archive an entire @code{nnml}, @code{nnfolder}, or @code{nnmaildir}
-server, take a recursive copy of the server directory. There is no need
-to shut down Gnus, so archiving may be invoked by @code{cron} or
-similar. You restore the data by restoring the directory tree, and
-adding a server definition pointing to that directory in Gnus. The
-@ref{Article Backlog}, @ref{Asynchronous Fetching} and other things
-might interfere with overwriting data, so you may want to shut down Gnus
-before you restore the data.
-
-It is also possible to archive individual @code{nnml},
-@code{nnfolder}, or @code{nnmaildir} groups, while preserving marks.
-For @code{nnml} or @code{nnmaildir}, you copy all files in the group's
-directory. For @code{nnfolder} you need to copy both the base folder
-file itself (@file{FOO}, say), and the marks file (@file{FOO.mrk} in
-this example). Restoring the group is done with @kbd{G m} from the Group
-buffer. The last step makes Gnus notice the new directory.
-@code{nnmaildir} notices the new directory automatically, so @kbd{G m}
-is unnecessary in that case.
-
-@node Web Searches
-@subsection Web Searches
-@cindex nnweb
-@cindex Google
-@cindex dejanews
-@cindex gmane
-@cindex Usenet searches
-@cindex searching the Usenet
-
-It's, like, too neat to search the Usenet for articles that match a
-string, but it, like, totally @emph{sucks}, like, totally, to use one of
-those, like, Web browsers, and you, like, have to, rilly, like, look at
-the commercials, so, like, with Gnus you can do @emph{rad}, rilly,
-searches without having to use a browser.
-
-The @code{nnweb} back end allows an easy interface to the mighty search
-engine. You create an @code{nnweb} group, enter a search pattern, and
-then enter the group and read the articles like you would any normal
-group. The @kbd{G w} command in the group buffer (@pxref{Foreign
-Groups}) will do this in an easy-to-use fashion.
-
-@code{nnweb} groups don't really lend themselves to being solid
-groups---they have a very fleeting idea of article numbers. In fact,
-each time you enter an @code{nnweb} group (not even changing the search
-pattern), you are likely to get the articles ordered in a different
-manner. Not even using duplicate suppression (@pxref{Duplicate
-Suppression}) will help, since @code{nnweb} doesn't even know the
-@code{Message-ID} of the articles before reading them using some search
-engines (Google, for instance). The only possible way to keep track
-of which articles you've read is by scoring on the @code{Date}
-header---mark all articles posted before the last date you read the
-group as read.
-
-If the search engine changes its output substantially, @code{nnweb}
-won't be able to parse it and will fail. One could hardly fault the Web
-providers if they were to do this---their @emph{raison d'être} is to
-make money off of advertisements, not to provide services to the
-community. Since @code{nnweb} washes the ads off all the articles, one
-might think that the providers might be somewhat miffed. We'll see.
-
-You must have the @code{url} and @code{W3} package or those alternatives
-(try @code{customize-group} on the @samp{mm-url} variable group)
-installed to be able to use @code{nnweb}.
-
-Virtual server variables:
-
-@table @code
-@item nnweb-type
-@vindex nnweb-type
-What search engine type is being used. The currently supported types
-are @code{google}, @code{dejanews}, and @code{gmane}. Note that
-@code{dejanews} is an alias to @code{google}.
-
-@item nnweb-search
-@vindex nnweb-search
-The search string to feed to the search engine.
-
-@item nnweb-max-hits
-@vindex nnweb-max-hits
-Advisory maximum number of hits per search to display. The default is
-999.
-
-@item nnweb-type-definition
-@vindex nnweb-type-definition
-Type-to-definition alist. This alist says what @code{nnweb} should do
-with the various search engine types. The following elements must be
-present:
-
-@table @code
-@item article
-Function to decode the article and provide something that Gnus
-understands.
-
-@item map
-Function to create an article number to message header and URL alist.
-
-@item search
-Function to send the search string to the search engine.
-
-@item address
-The address the aforementioned function should send the search string
-to.
-
-@item id
-Format string URL to fetch an article by @code{Message-ID}.
-@end table
-
-@end table
-
-
-@node Slashdot
-@subsection Slashdot
-@cindex Slashdot
-@cindex nnslashdot
-
-@uref{http://slashdot.org/, Slashdot} is a popular news site, with
-lively discussion following the news articles. @code{nnslashdot} will
-let you read this forum in a convenient manner.
-
-The easiest way to read this source is to put something like the
-following in your @file{~/.gnus.el} file:
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnslashdot "")))
-@end lisp
-
-This will make Gnus query the @code{nnslashdot} back end for new comments
-and groups. The @kbd{F} command will subscribe each new news article as
-a new Gnus group, and you can read the comments by entering these
-groups. (Note that the default subscription method is to subscribe new
-groups as zombies. Other methods are available (@pxref{Subscription
-Methods}).
-
-If you want to remove an old @code{nnslashdot} group, the @kbd{G DEL}
-command is the most handy tool (@pxref{Foreign Groups}).
-
-When following up to @code{nnslashdot} comments (or posting new
-comments), some light @acronym{HTML}izations will be performed. In
-particular, text quoted with @samp{> } will be quoted with
-@samp{blockquote} instead, and signatures will have @samp{br} added to
-the end of each line. Other than that, you can just write @acronym{HTML}
-directly into the message buffer. Note that Slashdot filters out some
-@acronym{HTML} forms.
-
-The following variables can be altered to change its behavior:
-
-@table @code
-@item nnslashdot-threaded
-Whether @code{nnslashdot} should display threaded groups or not. The
-default is @code{t}. To be able to display threads, @code{nnslashdot}
-has to retrieve absolutely all comments in a group upon entry. If a
-threaded display is not required, @code{nnslashdot} will only retrieve
-the comments that are actually wanted by the user. Threading is nicer,
-but much, much slower than unthreaded.
-
-@item nnslashdot-login-name
-@vindex nnslashdot-login-name
-The login name to use when posting.
-
-@item nnslashdot-password
-@vindex nnslashdot-password
-The password to use when posting.
-
-@item nnslashdot-directory
-@vindex nnslashdot-directory
-Where @code{nnslashdot} will store its files. The default is
-@file{~/News/slashdot/}.
-
-@item nnslashdot-active-url
-@vindex nnslashdot-active-url
-The @acronym{URL} format string that will be used to fetch the
-information on news articles and comments. The default is@*
-@samp{http://slashdot.org/search.pl?section=&min=%d}.
-
-@item nnslashdot-comments-url
-@vindex nnslashdot-comments-url
-The @acronym{URL} format string that will be used to fetch comments.
-
-@item nnslashdot-article-url
-@vindex nnslashdot-article-url
-The @acronym{URL} format string that will be used to fetch the news
-article. The default is
-@samp{http://slashdot.org/article.pl?sid=%s&mode=nocomment}.
-
-@item nnslashdot-threshold
-@vindex nnslashdot-threshold
-The score threshold. The default is -1.
-
-@item nnslashdot-group-number
-@vindex nnslashdot-group-number
-The number of old groups, in addition to the ten latest, to keep
-updated. The default is 0.
-
-@end table
-
-
-
-@node Ultimate
-@subsection Ultimate
-@cindex nnultimate
-@cindex Ultimate Bulletin Board
-
-@uref{http://www.ultimatebb.com/, The Ultimate Bulletin Board} is
-probably the most popular Web bulletin board system used. It has a
-quite regular and nice interface, and it's possible to get the
-information Gnus needs to keep groups updated.
-
-The easiest way to get started with @code{nnultimate} is to say
-something like the following in the group buffer: @kbd{B nnultimate RET
-http://www.tcj.com/messboard/ubbcgi/ RET}. (Substitute the @acronym{URL}
-(not including @samp{Ultimate.cgi} or the like at the end) for a forum
-you're interested in; there's quite a list of them on the Ultimate web
-site.) Then subscribe to the groups you're interested in from the
-server buffer, and read them from the group buffer.
-
-The following @code{nnultimate} variables can be altered:
-
-@table @code
-@item nnultimate-directory
-@vindex nnultimate-directory
-The directory where @code{nnultimate} stores its files. The default is@*
-@file{~/News/ultimate/}.
-@end table
-
-
-@node Web Archive
-@subsection Web Archive
-@cindex nnwarchive
-@cindex Web Archive
-
-Some mailing lists only have archives on Web servers, such as
-@uref{http://www.egroups.com/} and
-@uref{http://www.mail-archive.com/}. It has a quite regular and nice
-interface, and it's possible to get the information Gnus needs to keep
-groups updated.
-
-@findex gnus-group-make-warchive-group
-The easiest way to get started with @code{nnwarchive} is to say
-something like the following in the group buffer: @kbd{M-x
-gnus-group-make-warchive-group RET @var{an_egroup} RET egroups RET
-www.egroups.com RET @var{your@@email.address} RET}. (Substitute the
-@var{an_egroup} with the mailing list you subscribed, the
-@var{your@@email.address} with your email address.), or to browse the
-back end by @kbd{B nnwarchive RET mail-archive RET}.
-
-The following @code{nnwarchive} variables can be altered:
-
-@table @code
-@item nnwarchive-directory
-@vindex nnwarchive-directory
-The directory where @code{nnwarchive} stores its files. The default is@*
-@file{~/News/warchive/}.
-
-@item nnwarchive-login
-@vindex nnwarchive-login
-The account name on the web server.
-
-@item nnwarchive-passwd
-@vindex nnwarchive-passwd
-The password for your account on the web server.
-@end table
-
-@node RSS
-@subsection RSS
-@cindex nnrss
-@cindex RSS
-
-Some web sites have an RDF Site Summary (@acronym{RSS}).
-@acronym{RSS} is a format for summarizing headlines from news related
-sites (such as BBC or CNN). But basically anything list-like can be
-presented as an @acronym{RSS} feed: weblogs, changelogs or recent
-changes to a wiki (e.g. @url{http://cliki.net/recent-changes.rdf}).
-
-@acronym{RSS} has a quite regular and nice interface, and it's
-possible to get the information Gnus needs to keep groups updated.
-
-Note: you had better use Emacs which supports the @code{utf-8} coding
-system because @acronym{RSS} uses UTF-8 for encoding non-@acronym{ASCII}
-text by default. It is also used by default for non-@acronym{ASCII}
-group names.
-
-@kindex G R (Group)
-Use @kbd{G R} from the group buffer to subscribe to a feed---you will be
-prompted for the location, the title and the description of the feed.
-The title, which allows any characters, will be used for the group name
-and the name of the group data file. The description can be omitted.
-
-An easy way to get started with @code{nnrss} is to say something like
-the following in the group buffer: @kbd{B nnrss RET RET y}, then
-subscribe to groups.
-
-The @code{nnrss} back end saves the group data file in
-@code{nnrss-directory} (see below) for each @code{nnrss} group. File
-names containing non-@acronym{ASCII} characters will be encoded by the
-coding system specified with the @code{nnmail-pathname-coding-system}
-variable. If it is @code{nil}, in Emacs the coding system defaults to
-the value of @code{default-file-name-coding-system}. If you are using
-XEmacs and want to use non-@acronym{ASCII} group names, you should set
-the value for the @code{nnmail-pathname-coding-system} variable properly.
-
-The @code{nnrss} back end generates @samp{multipart/alternative}
-@acronym{MIME} articles in which each contains a @samp{text/plain} part
-and a @samp{text/html} part.
-
-@cindex OPML
-You can also use the following commands to import and export your
-subscriptions from a file in @acronym{OPML} format (Outline Processor
-Markup Language).
-
-@defun nnrss-opml-import file
-Prompt for an @acronym{OPML} file, and subscribe to each feed in the
-file.
-@end defun
-
-@defun nnrss-opml-export
-Write your current @acronym{RSS} subscriptions to a buffer in
-@acronym{OPML} format.
-@end defun
-
-The following @code{nnrss} variables can be altered:
-
-@table @code
-@item nnrss-directory
-@vindex nnrss-directory
-The directory where @code{nnrss} stores its files. The default is
-@file{~/News/rss/}.
-
-@item nnrss-file-coding-system
-@vindex nnrss-file-coding-system
-The coding system used when reading and writing the @code{nnrss} groups
-data files. The default is the value of
-@code{mm-universal-coding-system} (which defaults to @code{emacs-mule}
-in Emacs or @code{escape-quoted} in XEmacs).
-
-@item nnrss-use-local
-@vindex nnrss-use-local
-@findex nnrss-generate-download-script
-If you set @code{nnrss-use-local} to @code{t}, @code{nnrss} will read
-the feeds from local files in @code{nnrss-directory}. You can use
-the command @code{nnrss-generate-download-script} to generate a
-download script using @command{wget}.
-
-@item nnrss-wash-html-in-text-plain-parts
-Non-@code{nil} means that @code{nnrss} renders text in @samp{text/plain}
-parts as @acronym{HTML}. The function specified by the
-@code{mm-text-html-renderer} variable (@pxref{Display Customization,
-,Display Customization, emacs-mime, The Emacs MIME Manual}) will be used
-to render text. If it is @code{nil}, which is the default, text will
-simply be folded. Leave it @code{nil} if you prefer to see
-@samp{text/html} parts.
-@end table
-
-The following code may be helpful, if you want to show the description in
-the summary buffer.
-
-@lisp
-(add-to-list 'nnmail-extra-headers nnrss-description-field)
-(setq gnus-summary-line-format "%U%R%z%I%(%[%4L: %-15,15f%]%) %s%uX\n")
-
-(defun gnus-user-format-function-X (header)
- (let ((descr
- (assq nnrss-description-field (mail-header-extra header))))
- (if descr (concat "\n\t" (cdr descr)) "")))
-@end lisp
-
-The following code may be useful to open an nnrss url directly from the
-summary buffer.
-
-@lisp
-(require 'browse-url)
-
-(defun browse-nnrss-url( arg )
- (interactive "p")
- (let ((url (assq nnrss-url-field
- (mail-header-extra
- (gnus-data-header
- (assq (gnus-summary-article-number)
- gnus-newsgroup-data))))))
- (if url
- (progn
- (browse-url (cdr url))
- (gnus-summary-mark-as-read-forward 1))
- (gnus-summary-scroll-up arg))))
-
-(eval-after-load "gnus"
- #'(define-key gnus-summary-mode-map
- (kbd "<RET>") 'browse-nnrss-url))
-(add-to-list 'nnmail-extra-headers nnrss-url-field)
-@end lisp
-
-Even if you have added @samp{text/html} to the
-@code{mm-discouraged-alternatives} variable (@pxref{Display
-Customization, ,Display Customization, emacs-mime, The Emacs MIME
-Manual}) since you don't want to see @acronym{HTML} parts, it might be
-more useful especially in @code{nnrss} groups to display
-@samp{text/html} parts. Here's an example of setting
-@code{mm-discouraged-alternatives} as a group parameter (@pxref{Group
-Parameters}) in order to display @samp{text/html} parts only in
-@code{nnrss} groups:
-
-@lisp
-;; @r{Set the default value of @code{mm-discouraged-alternatives}.}
-(eval-after-load "gnus-sum"
- '(add-to-list
- 'gnus-newsgroup-variables
- '(mm-discouraged-alternatives
- . '("text/html" "image/.*"))))
-
-;; @r{Display @samp{text/html} parts in @code{nnrss} groups.}
-(add-to-list
- 'gnus-parameters
- '("\\`nnrss:" (mm-discouraged-alternatives nil)))
-@end lisp
-
-
-@node Customizing W3
-@subsection Customizing W3
-@cindex W3
-@cindex html
-@cindex url
-@cindex Netscape
-
-Gnus uses the url library to fetch web pages and Emacs/W3 (or those
-alternatives) to display web pages. Emacs/W3 is documented in its own
-manual, but there are some things that may be more relevant for Gnus
-users.
-
-For instance, a common question is how to make Emacs/W3 follow links
-using the @code{browse-url} functions (which will call some external web
-browser like Netscape). Here's one way:
-
-@lisp
-(eval-after-load "w3"
- '(progn
- (fset 'w3-fetch-orig (symbol-function 'w3-fetch))
- (defun w3-fetch (&optional url target)
- (interactive (list (w3-read-url-with-default)))
- (if (eq major-mode 'gnus-article-mode)
- (browse-url url)
- (w3-fetch-orig url target)))))
-@end lisp
-
-Put that in your @file{.emacs} file, and hitting links in W3-rendered
-@acronym{HTML} in the Gnus article buffers will use @code{browse-url} to
-follow the link.
-
-
-@node IMAP
-@section IMAP
-@cindex nnimap
-@cindex @acronym{IMAP}
-
-@acronym{IMAP} is a network protocol for reading mail (or news, or @dots{}),
-think of it as a modernized @acronym{NNTP}. Connecting to a @acronym{IMAP}
-server is much similar to connecting to a news server, you just
-specify the network address of the server.
-
-@acronym{IMAP} has two properties. First, @acronym{IMAP} can do
-everything that @acronym{POP} can, it can hence be viewed as a
-@acronym{POP++}. Secondly, @acronym{IMAP} is a mail storage protocol,
-similar to @acronym{NNTP} being a news storage protocol---however,
-@acronym{IMAP} offers more features than @acronym{NNTP} because news
-is more or less read-only whereas mail is read-write.
-
-If you want to use @acronym{IMAP} as a @acronym{POP++}, use an imap
-entry in @code{mail-sources}. With this, Gnus will fetch mails from
-the @acronym{IMAP} server and store them on the local disk. This is
-not the usage described in this section---@xref{Mail Sources}.
-
-If you want to use @acronym{IMAP} as a mail storage protocol, use an nnimap
-entry in @code{gnus-secondary-select-methods}. With this, Gnus will
-manipulate mails stored on the @acronym{IMAP} server. This is the kind of
-usage explained in this section.
-
-A server configuration in @file{~/.gnus.el} with a few @acronym{IMAP}
-servers might look something like the following. (Note that for
-@acronym{TLS}/@acronym{SSL}, you need external programs and libraries,
-see below.)
-
-@lisp
-(setq gnus-secondary-select-methods
- '((nnimap "simpleserver") ; @r{no special configuration}
- ; @r{perhaps a ssh port forwarded server:}
- (nnimap "dolk"
- (nnimap-address "localhost")
- (nnimap-server-port 1430))
- ; @r{a UW server running on localhost}
- (nnimap "barbar"
- (nnimap-server-port 143)
- (nnimap-address "localhost")
- (nnimap-list-pattern ("INBOX" "mail/*")))
- ; @r{anonymous public cyrus server:}
- (nnimap "cyrus.andrew.cmu.edu"
- (nnimap-authenticator anonymous)
- (nnimap-list-pattern "archive.*")
- (nnimap-stream network))
- ; @r{a ssl server on a non-standard port:}
- (nnimap "vic20"
- (nnimap-address "vic20.somewhere.com")
- (nnimap-server-port 9930)
- (nnimap-stream ssl))))
-@end lisp
-
-After defining the new server, you can subscribe to groups on the
-server using normal Gnus commands such as @kbd{U} in the Group Buffer
-(@pxref{Subscription Commands}) or via the Server Buffer
-(@pxref{Server Buffer}).
-
-The following variables can be used to create a virtual @code{nnimap}
-server:
-
-@table @code
-
-@item nnimap-address
-@vindex nnimap-address
-
-The address of the remote @acronym{IMAP} server. Defaults to the virtual
-server name if not specified.
-
-@item nnimap-server-port
-@vindex nnimap-server-port
-Port on server to contact. Defaults to port 143, or 993 for @acronym{TLS}/@acronym{SSL}.
-
-Note that this should be an integer, example server specification:
-
-@lisp
-(nnimap "mail.server.com"
- (nnimap-server-port 4711))
-@end lisp
-
-@item nnimap-list-pattern
-@vindex nnimap-list-pattern
-String or list of strings of mailboxes to limit available groups to.
-This is used when the server has very many mailboxes and you're only
-interested in a few---some servers export your home directory via
-@acronym{IMAP}, you'll probably want to limit the mailboxes to those in
-@file{~/Mail/*} then.
-
-The string can also be a cons of REFERENCE and the string as above, what
-REFERENCE is used for is server specific, but on the University of
-Washington server it's a directory that will be concatenated with the
-mailbox.
-
-Example server specification:
-
-@lisp
-(nnimap "mail.server.com"
- (nnimap-list-pattern ("INBOX" "Mail/*" "alt.sex.*"
- ("~friend/Mail/" . "list/*"))))
-@end lisp
-
-@item nnimap-stream
-@vindex nnimap-stream
-The type of stream used to connect to your server. By default, nnimap
-will detect and automatically use all of the below, with the exception
-of @acronym{TLS}/@acronym{SSL}. (@acronym{IMAP} over
-@acronym{TLS}/@acronym{SSL} is being replaced by STARTTLS, which can
-be automatically detected, but it's not widely deployed yet.)
-
-Example server specification:
-
-@lisp
-(nnimap "mail.server.com"
- (nnimap-stream ssl))
-@end lisp
-
-Please note that the value of @code{nnimap-stream} is a symbol!
-
-@itemize @bullet
-@item
-@dfn{gssapi:} Connect with GSSAPI (usually Kerberos 5). Requires the
-@samp{gsasl} or @samp{imtest} program.
-@item
-@dfn{kerberos4:} Connect with Kerberos 4. Requires the @samp{imtest} program.
-@item
-@dfn{starttls:} Connect via the STARTTLS extension (similar to
-@acronym{TLS}/@acronym{SSL}). Requires the external library @samp{starttls.el} and program
-@samp{starttls}.
-@item
-@dfn{tls:} Connect through @acronym{TLS}. Requires GNUTLS (the program
-@samp{gnutls-cli}).
-@item
-@dfn{ssl:} Connect through @acronym{SSL}. Requires OpenSSL (the program
-@samp{openssl}) or SSLeay (@samp{s_client}).
-@item
-@dfn{shell:} Use a shell command to start @acronym{IMAP} connection.
-@item
-@dfn{network:} Plain, TCP/IP network connection.
-@end itemize
-
-@vindex imap-kerberos4-program
-The @samp{imtest} program is shipped with Cyrus IMAPD. If you're
-using @samp{imtest} from Cyrus IMAPD < 2.0.14 (which includes version
-1.5.x and 1.6.x) you need to frob @code{imap-process-connection-type}
-to make @code{imap.el} use a pty instead of a pipe when communicating
-with @samp{imtest}. You will then suffer from a line length
-restrictions on @acronym{IMAP} commands, which might make Gnus seem to hang
-indefinitely if you have many articles in a mailbox. The variable
-@code{imap-kerberos4-program} contain parameters to pass to the imtest
-program.
-
-For @acronym{TLS} connection, the @code{gnutls-cli} program from GNUTLS is
-needed. It is available from
-@uref{http://www.gnu.org/software/gnutls/}.
-
-@vindex imap-gssapi-program
-This parameter specifies a list of command lines that invoke a GSSAPI
-authenticated @acronym{IMAP} stream in a subshell. They are tried
-sequentially until a connection is made, or the list has been
-exhausted. By default, @samp{gsasl} from GNU SASL, available from
-@uref{http://www.gnu.org/software/gsasl/}, and the @samp{imtest}
-program from Cyrus IMAPD (see @code{imap-kerberos4-program}), are
-tried.
-
-@vindex imap-ssl-program
-For @acronym{SSL} connections, the OpenSSL program is available from
-@uref{http://www.openssl.org/}. OpenSSL was formerly known as SSLeay,
-and nnimap support it too---although the most recent versions of
-SSLeay, 0.9.x, are known to have serious bugs making it
-useless. Earlier versions, especially 0.8.x, of SSLeay are known to
-work. The variable @code{imap-ssl-program} contain parameters to pass
-to OpenSSL/SSLeay.
-
-@vindex imap-shell-program
-@vindex imap-shell-host
-For @acronym{IMAP} connections using the @code{shell} stream, the variable
-@code{imap-shell-program} specify what program to call.
-
-@item nnimap-authenticator
-@vindex nnimap-authenticator
-
-The authenticator used to connect to the server. By default, nnimap
-will use the most secure authenticator your server is capable of.
-
-Example server specification:
-
-@lisp
-(nnimap "mail.server.com"
- (nnimap-authenticator anonymous))
-@end lisp
-
-Please note that the value of @code{nnimap-authenticator} is a symbol!
-
-@itemize @bullet
-@item
-@dfn{gssapi:} GSSAPI (usually kerberos 5) authentication. Requires
-external program @code{gsasl} or @code{imtest}.
-@item
-@dfn{kerberos4:} Kerberos 4 authentication. Requires external program
-@code{imtest}.
-@item
-@dfn{digest-md5:} Encrypted username/password via DIGEST-MD5. Requires
-external library @code{digest-md5.el}.
-@item
-@dfn{cram-md5:} Encrypted username/password via CRAM-MD5.
-@item
-@dfn{login:} Plain-text username/password via LOGIN.
-@item
-@dfn{anonymous:} Login as ``anonymous'', supplying your email address as password.
-@end itemize
-
-@item nnimap-expunge-on-close
-@cindex expunging
-@vindex nnimap-expunge-on-close
-Unlike Parmenides the @acronym{IMAP} designers have decided things that
-don't exist actually do exist. More specifically, @acronym{IMAP} has
-this concept of marking articles @code{Deleted} which doesn't actually
-delete them, and this (marking them @code{Deleted}, that is) is what
-nnimap does when you delete an article in Gnus (with @kbd{B DEL} or
-similar).
-
-Since the articles aren't really removed when we mark them with the
-@code{Deleted} flag we'll need a way to actually delete them. Feel like
-running in circles yet?
-
-Traditionally, nnimap has removed all articles marked as @code{Deleted}
-when closing a mailbox but this is now configurable by this server
-variable.
-
-The possible options are:
-
-@table @code
-
-@item always
-The default behavior, delete all articles marked as ``Deleted'' when
-closing a mailbox.
-@item never
-Never actually delete articles. Currently there is no way of showing
-the articles marked for deletion in nnimap, but other @acronym{IMAP} clients
-may allow you to do this. If you ever want to run the EXPUNGE command
-manually, @xref{Expunging mailboxes}.
-@item ask
-When closing mailboxes, nnimap will ask if you wish to expunge deleted
-articles or not.
-
-@end table
-
-@item nnimap-importantize-dormant
-@vindex nnimap-importantize-dormant
-
-If non-@code{nil} (the default), marks dormant articles as ticked (as
-well), for other @acronym{IMAP} clients. Within Gnus, dormant articles will
-naturally still (only) be marked as dormant. This is to make dormant
-articles stand out, just like ticked articles, in other @acronym{IMAP}
-clients. (In other words, Gnus has two ``Tick'' marks and @acronym{IMAP}
-has only one.)
-
-Probably the only reason for frobbing this would be if you're trying
-enable per-user persistent dormant flags, using something like:
-
-@lisp
-(setcdr (assq 'dormant nnimap-mark-to-flag-alist)
- (format "gnus-dormant-%s" (user-login-name)))
-(setcdr (assq 'dormant nnimap-mark-to-predicate-alist)
- (format "KEYWORD gnus-dormant-%s" (user-login-name)))
-@end lisp
-
-In this case, you would not want the per-user dormant flag showing up
-as ticked for other users.
-
-@item nnimap-expunge-search-string
-@cindex expunging
-@vindex nnimap-expunge-search-string
-@cindex expiring @acronym{IMAP} mail
-
-This variable contain the @acronym{IMAP} search command sent to server when
-searching for articles eligible for expiring. The default is
-@code{"UID %s NOT SINCE %s"}, where the first @code{%s} is replaced by
-UID set and the second @code{%s} is replaced by a date.
-
-Probably the only useful value to change this to is
-@code{"UID %s NOT SENTSINCE %s"}, which makes nnimap use the Date: in
-messages instead of the internal article date. See section 6.4.4 of
-RFC 2060 for more information on valid strings.
-
-However, if @code{nnimap-search-uids-not-since-is-evil}
-is true, this variable has no effect since the search logic
-is reversed, as described below.
-
-@item nnimap-authinfo-file
-@vindex nnimap-authinfo-file
-
-A file containing credentials used to log in on servers. The format is
-(almost) the same as the @code{ftp} @file{~/.netrc} file. See the
-variable @code{nntp-authinfo-file} for exact syntax; also see
-@ref{NNTP}. An example of an .authinfo line for an IMAP server, is:
-
-@example
-machine students.uio.no login larsi password geheimnis port imap
-@end example
-
-Note that it should be @code{port imap}, or @code{port 143}, if you
-use a @code{nnimap-stream} of @code{tls} or @code{ssl}, even if the
-actual port number used is port 993 for secured IMAP. For
-convenience, Gnus will accept @code{port imaps} as a synonym of
-@code{port imap}.
-
-@item nnimap-need-unselect-to-notice-new-mail
-@vindex nnimap-need-unselect-to-notice-new-mail
-
-Unselect mailboxes before looking for new mail in them. Some servers
-seem to need this under some circumstances; it was reported that
-Courier 1.7.1 did.
-
-@item nnimap-nov-is-evil
-@vindex nnimap-nov-is-evil
-@cindex Courier @acronym{IMAP} server
-@cindex @acronym{NOV}
-
-Never generate or use a local @acronym{NOV} database. Defaults to the
-value of @code{gnus-agent}.
-
-Using a @acronym{NOV} database usually makes header fetching much
-faster, but it uses the @code{UID SEARCH UID} command, which is very
-slow on some servers (notably some versions of Courier). Since the Gnus
-Agent caches the information in the @acronym{NOV} database without using
-the slow command, this variable defaults to true if the Agent is in use,
-and false otherwise.
-
-@item nnimap-search-uids-not-since-is-evil
-@vindex nnimap-search-uids-not-since-is-evil
-@cindex Courier @acronym{IMAP} server
-@cindex expiring @acronym{IMAP} mail
-
-Avoid the @code{UID SEARCH UID @var{message numbers} NOT SINCE
-@var{date}} command, which is slow on some @acronym{IMAP} servers
-(notably, some versions of Courier). Instead, use @code{UID SEARCH SINCE
-@var{date}} and prune the list of expirable articles within Gnus.
-
-When Gnus expires your mail (@pxref{Expiring Mail}), it starts with a
-list of expirable articles and asks the IMAP server questions like ``Of
-these articles, which ones are older than a week?'' While this seems
-like a perfectly reasonable question, some IMAP servers take a long time
-to answer it, since they seemingly go looking into every old article to
-see if it is one of the expirable ones. Curiously, the question ``Of
-@emph{all} articles, which ones are newer than a week?'' seems to be
-much faster to answer, so setting this variable causes Gnus to ask this
-question and figure out the answer to the real question itself.
-
-This problem can really sneak up on you: when you first configure Gnus,
-everything works fine, but once you accumulate a couple thousand
-messages, you start cursing Gnus for being so slow. On the other hand,
-if you get a lot of email within a week, setting this variable will
-cause a lot of network traffic between Gnus and the IMAP server.
-
-@end table
-
-@menu
-* Splitting in IMAP:: Splitting mail with nnimap.
-* Expiring in IMAP:: Expiring mail with nnimap.
-* Editing IMAP ACLs:: Limiting/enabling other users access to a mailbox.
-* Expunging mailboxes:: Equivalent of a ``compress mailbox'' button.
-* A note on namespaces:: How to (not) use @acronym{IMAP} namespace in Gnus.
-* Debugging IMAP:: What to do when things don't work.
-@end menu
-
-
-
-@node Splitting in IMAP
-@subsection Splitting in IMAP
-@cindex splitting imap mail
-
-Splitting is something Gnus users have loved and used for years, and now
-the rest of the world is catching up. Yeah, dream on, not many
-@acronym{IMAP} servers have server side splitting and those that have
-splitting seem to use some non-standard protocol. This means that
-@acronym{IMAP} support for Gnus has to do its own splitting.
-
-And it does.
-
-(Incidentally, people seem to have been dreaming on, and Sieve has
-gaining a market share and is supported by several IMAP servers.
-Fortunately, Gnus support it too, @xref{Sieve Commands}.)
-
-Here are the variables of interest:
-
-@table @code
-
-@item nnimap-split-crosspost
-@cindex splitting, crosspost
-@cindex crosspost
-@vindex nnimap-split-crosspost
-
-If non-@code{nil}, do crossposting if several split methods match the
-mail. If @code{nil}, the first match in @code{nnimap-split-rule}
-found will be used.
-
-Nnmail equivalent: @code{nnmail-crosspost}.
-
-@item nnimap-split-inbox
-@cindex splitting, inbox
-@cindex inbox
-@vindex nnimap-split-inbox
-
-A string or a list of strings that gives the name(s) of @acronym{IMAP}
-mailboxes to split from. Defaults to @code{nil}, which means that
-splitting is disabled!
-
-@lisp
-(setq nnimap-split-inbox
- '("INBOX" ("~/friend/Mail" . "lists/*") "lists.imap"))
-@end lisp
-
-No nnmail equivalent.
-
-@item nnimap-split-rule
-@cindex splitting, rules
-@vindex nnimap-split-rule
-
-New mail found in @code{nnimap-split-inbox} will be split according to
-this variable.
-
-This variable contains a list of lists, where the first element in the
-sublist gives the name of the @acronym{IMAP} mailbox to move articles
-matching the regexp in the second element in the sublist. Got that?
-Neither did I, we need examples.
-
-@lisp
-(setq nnimap-split-rule
- '(("INBOX.nnimap"
- "^Sender: owner-nnimap@@vic20.globalcom.se")
- ("INBOX.junk" "^Subject:.*MAKE MONEY")
- ("INBOX.private" "")))
-@end lisp
-
-This will put all articles from the nnimap mailing list into mailbox
-INBOX.nnimap, all articles containing MAKE MONEY in the Subject: line
-into INBOX.junk and everything else in INBOX.private.
-
-The first string may contain @samp{\\1} forms, like the ones used by
-replace-match to insert sub-expressions from the matched text. For
-instance:
-
-@lisp
-("INBOX.lists.\\1" "^Sender: owner-\\([a-z-]+\\)@@")
-@end lisp
-
-The first element can also be the symbol @code{junk} to indicate that
-matching messages should simply be deleted. Use with care.
-
-The second element can also be a function. In that case, it will be
-called with the first element of the rule as the argument, in a buffer
-containing the headers of the article. It should return a
-non-@code{nil} value if it thinks that the mail belongs in that group.
-
-Nnmail users might recollect that the last regexp had to be empty to
-match all articles (like in the example above). This is not required in
-nnimap. Articles not matching any of the regexps will not be moved out
-of your inbox. (This might affect performance if you keep lots of
-unread articles in your inbox, since the splitting code would go over
-them every time you fetch new mail.)
-
-These rules are processed from the beginning of the alist toward the
-end. The first rule to make a match will ``win'', unless you have
-crossposting enabled. In that case, all matching rules will ``win''.
-
-This variable can also have a function as its value, the function will
-be called with the headers narrowed and should return a group where it
-thinks the article should be split to. See @code{nnimap-split-fancy}.
-
-The splitting code tries to create mailboxes if it needs to.
-
-To allow for different split rules on different virtual servers, and
-even different split rules in different inboxes on the same server,
-the syntax of this variable have been extended along the lines of:
-
-@lisp
-(setq nnimap-split-rule
- '(("my1server" (".*" (("ding" "ding@@gnus.org")
- ("junk" "From:.*Simon"))))
- ("my2server" ("INBOX" nnimap-split-fancy))
- ("my[34]server" (".*" (("private" "To:.*Simon")
- ("junk" my-junk-func))))))
-@end lisp
-
-The virtual server name is in fact a regexp, so that the same rules
-may apply to several servers. In the example, the servers
-@code{my3server} and @code{my4server} both use the same rules.
-Similarly, the inbox string is also a regexp. The actual splitting
-rules are as before, either a function, or a list with group/regexp or
-group/function elements.
-
-Nnmail equivalent: @code{nnmail-split-methods}.
-
-@item nnimap-split-predicate
-@cindex splitting
-@vindex nnimap-split-predicate
-
-Mail matching this predicate in @code{nnimap-split-inbox} will be
-split, it is a string and the default is @samp{UNSEEN UNDELETED}.
-
-This might be useful if you use another @acronym{IMAP} client to read mail in
-your inbox but would like Gnus to split all articles in the inbox
-regardless of readedness. Then you might change this to
-@samp{UNDELETED}.
-
-@item nnimap-split-fancy
-@cindex splitting, fancy
-@findex nnimap-split-fancy
-@vindex nnimap-split-fancy
-
-It's possible to set @code{nnimap-split-rule} to
-@code{nnmail-split-fancy} if you want to use fancy
-splitting. @xref{Fancy Mail Splitting}.
-
-However, to be able to have different fancy split rules for nnmail and
-nnimap back ends you can set @code{nnimap-split-rule} to
-@code{nnimap-split-fancy} and define the nnimap specific fancy split
-rule in @code{nnimap-split-fancy}.
-
-Example:
-
-@lisp
-(setq nnimap-split-rule 'nnimap-split-fancy
- nnimap-split-fancy ...)
-@end lisp
-
-Nnmail equivalent: @code{nnmail-split-fancy}.
-
-@item nnimap-split-download-body
-@findex nnimap-split-download-body
-@vindex nnimap-split-download-body
-
-Set to non-@code{nil} to download entire articles during splitting.
-This is generally not required, and will slow things down
-considerably. You may need it if you want to use an advanced
-splitting function that analyzes the body to split the article.
-
-@end table
-
-@node Expiring in IMAP
-@subsection Expiring in IMAP
-@cindex expiring @acronym{IMAP} mail
-
-Even though @code{nnimap} is not a proper @code{nnmail} derived back
-end, it supports most features in regular expiring (@pxref{Expiring
-Mail}). Unlike splitting in @acronym{IMAP} (@pxref{Splitting in
-IMAP}) it does not clone the @code{nnmail} variables (i.e., creating
-@var{nnimap-expiry-wait}) but reuse the @code{nnmail} variables. What
-follows below are the variables used by the @code{nnimap} expiry
-process.
-
-A note on how the expire mark is stored on the @acronym{IMAP} server is
-appropriate here as well. The expire mark is translated into a
-@code{imap} client specific mark, @code{gnus-expire}, and stored on the
-message. This means that likely only Gnus will understand and treat
-the @code{gnus-expire} mark properly, although other clients may allow
-you to view client specific flags on the message. It also means that
-your server must support permanent storage of client specific flags on
-messages. Most do, fortunately.
-
-If expiring @acronym{IMAP} mail seems very slow, try setting the server
-variable @code{nnimap-search-uids-not-since-is-evil}.
-
-@table @code
-
-@item nnmail-expiry-wait
-@item nnmail-expiry-wait-function
-
-These variables are fully supported. The expire value can be a
-number, the symbol @code{immediate} or @code{never}.
-
-@item nnmail-expiry-target
-
-This variable is supported, and internally implemented by calling the
-@code{nnmail} functions that handle this. It contains an optimization
-that if the destination is a @acronym{IMAP} group on the same server, the
-article is copied instead of appended (that is, uploaded again).
-
-@end table
-
-@node Editing IMAP ACLs
-@subsection Editing IMAP ACLs
-@cindex editing imap acls
-@cindex Access Control Lists
-@cindex Editing @acronym{IMAP} ACLs
-@kindex G l (Group)
-@findex gnus-group-nnimap-edit-acl
-
-ACL stands for Access Control List. ACLs are used in @acronym{IMAP} for
-limiting (or enabling) other users access to your mail boxes. Not all
-@acronym{IMAP} servers support this, this function will give an error if it
-doesn't.
-
-To edit an ACL for a mailbox, type @kbd{G l}
-(@code{gnus-group-edit-nnimap-acl}) and you'll be presented with an ACL
-editing window with detailed instructions.
-
-Some possible uses:
-
-@itemize @bullet
-@item
-Giving ``anyone'' the ``lrs'' rights (lookup, read, keep seen/unseen flags)
-on your mailing list mailboxes enables other users on the same server to
-follow the list without subscribing to it.
-@item
-At least with the Cyrus server, you are required to give the user
-``anyone'' posting ("p") capabilities to have ``plussing'' work (that is,
-mail sent to user+mailbox@@domain ending up in the @acronym{IMAP} mailbox
-INBOX.mailbox).
-@end itemize
-
-@node Expunging mailboxes
-@subsection Expunging mailboxes
-@cindex expunging
-
-@cindex expunge
-@cindex manual expunging
-@kindex G x (Group)
-@findex gnus-group-nnimap-expunge
-
-If you're using the @code{never} setting of @code{nnimap-expunge-on-close},
-you may want the option of expunging all deleted articles in a mailbox
-manually. This is exactly what @kbd{G x} does.
-
-Currently there is no way of showing deleted articles, you can just
-delete them.
-
-@node A note on namespaces
-@subsection A note on namespaces
-@cindex IMAP namespace
-@cindex namespaces
-
-The @acronym{IMAP} protocol has a concept called namespaces, described
-by the following text in the RFC2060:
-
-@display
-5.1.2. Mailbox Namespace Naming Convention
-
- By convention, the first hierarchical element of any mailbox name
- which begins with "#" identifies the "namespace" of the remainder of
- the name. This makes it possible to disambiguate between different
- types of mailbox stores, each of which have their own namespaces.
-
- For example, implementations which offer access to USENET
- newsgroups MAY use the "#news" namespace to partition the USENET
- newsgroup namespace from that of other mailboxes. Thus, the
- comp.mail.misc newsgroup would have an mailbox name of
- "#news.comp.mail.misc", and the name "comp.mail.misc" could refer
- to a different object (e.g. a user's private mailbox).
-@end display
-
-While there is nothing in this text that warrants concern for the
-@acronym{IMAP} implementation in Gnus, some servers use namespace
-prefixes in a way that does not work with how Gnus uses mailbox names.
-
-Specifically, University of Washington's @acronym{IMAP} server uses
-mailbox names like @code{#driver.mbx/read-mail} which are valid only
-in the @sc{create} and @sc{append} commands. After the mailbox is
-created (or a messages is appended to a mailbox), it must be accessed
-without the namespace prefix, i.e. @code{read-mail}. Since Gnus do
-not make it possible for the user to guarantee that user entered
-mailbox names will only be used with the CREATE and APPEND commands,
-you should simply not use the namespace prefixed mailbox names in
-Gnus.
-
-See the UoW IMAPD documentation for the @code{#driver.*/} prefix
-for more information on how to use the prefixes. They are a power
-tool and should be used only if you are sure what the effects are.
-
-@node Debugging IMAP
-@subsection Debugging IMAP
-@cindex IMAP debugging
-@cindex protocol dump (IMAP)
-
-@acronym{IMAP} is a complex protocol, more so than @acronym{NNTP} or
-@acronym{POP3}. Implementation bugs are not unlikely, and we do our
-best to fix them right away. If you encounter odd behavior, chances
-are that either the server or Gnus is buggy.
-
-If you are familiar with network protocols in general, you will
-probably be able to extract some clues from the protocol dump of the
-exchanges between Gnus and the server. Even if you are not familiar
-with network protocols, when you include the protocol dump in
-@acronym{IMAP}-related bug reports you are helping us with data
-critical to solving the problem. Therefore, we strongly encourage you
-to include the protocol dump when reporting IMAP bugs in Gnus.
-
-
-@vindex imap-log
-Because the protocol dump, when enabled, generates lots of data, it is
-disabled by default. You can enable it by setting @code{imap-log} as
-follows:
-
-@lisp
-(setq imap-log t)
-@end lisp
-
-This instructs the @code{imap.el} package to log any exchanges with
-the server. The log is stored in the buffer @samp{*imap-log*}. Look
-for error messages, which sometimes are tagged with the keyword
-@code{BAD}---but when submitting a bug, make sure to include all the
-data.
-
-@node Other Sources
-@section Other Sources
-
-Gnus can do more than just read news or mail. The methods described
-below allow Gnus to view directories and files as if they were
-newsgroups.
-
-@menu
-* Directory Groups:: You can read a directory as if it was a newsgroup.
-* Anything Groups:: Dired? Who needs dired?
-* Document Groups:: Single files can be the basis of a group.
-* SOUP:: Reading @sc{soup} packets ``offline''.
-* Mail-To-News Gateways:: Posting articles via mail-to-news gateways.
-@end menu
-
-
-@node Directory Groups
-@subsection Directory Groups
-@cindex nndir
-@cindex directory groups
-
-If you have a directory that has lots of articles in separate files in
-it, you might treat it as a newsgroup. The files have to have numerical
-names, of course.
-
-This might be an opportune moment to mention @code{ange-ftp} (and its
-successor @code{efs}), that most wonderful of all wonderful Emacs
-packages. When I wrote @code{nndir}, I didn't think much about it---a
-back end to read directories. Big deal.
-
-@code{ange-ftp} changes that picture dramatically. For instance, if you
-enter the @code{ange-ftp} file name
-@file{/ftp.hpc.uh.edu:/pub/emacs/ding-list/} as the directory name,
-@code{ange-ftp} or @code{efs} will actually allow you to read this
-directory over at @samp{sina} as a newsgroup. Distributed news ahoy!
-
-@code{nndir} will use @acronym{NOV} files if they are present.
-
-@code{nndir} is a ``read-only'' back end---you can't delete or expire
-articles with this method. You can use @code{nnmh} or @code{nnml} for
-whatever you use @code{nndir} for, so you could switch to any of those
-methods if you feel the need to have a non-read-only @code{nndir}.
-
-
-@node Anything Groups
-@subsection Anything Groups
-@cindex nneething
-
-From the @code{nndir} back end (which reads a single spool-like
-directory), it's just a hop and a skip to @code{nneething}, which
-pretends that any arbitrary directory is a newsgroup. Strange, but
-true.
-
-When @code{nneething} is presented with a directory, it will scan this
-directory and assign article numbers to each file. When you enter such
-a group, @code{nneething} must create ``headers'' that Gnus can use.
-After all, Gnus is a newsreader, in case you're forgetting.
-@code{nneething} does this in a two-step process. First, it snoops each
-file in question. If the file looks like an article (i.e., the first
-few lines look like headers), it will use this as the head. If this is
-just some arbitrary file without a head (e.g. a C source file),
-@code{nneething} will cobble up a header out of thin air. It will use
-file ownership, name and date and do whatever it can with these
-elements.
-
-All this should happen automatically for you, and you will be presented
-with something that looks very much like a newsgroup. Totally like a
-newsgroup, to be precise. If you select an article, it will be displayed
-in the article buffer, just as usual.
-
-If you select a line that represents a directory, Gnus will pop you into
-a new summary buffer for this @code{nneething} group. And so on. You can
-traverse the entire disk this way, if you feel like, but remember that
-Gnus is not dired, really, and does not intend to be, either.
-
-There are two overall modes to this action---ephemeral or solid. When
-doing the ephemeral thing (i.e., @kbd{G D} from the group buffer), Gnus
-will not store information on what files you have read, and what files
-are new, and so on. If you create a solid @code{nneething} group the
-normal way with @kbd{G m}, Gnus will store a mapping table between
-article numbers and file names, and you can treat this group like any
-other groups. When you activate a solid @code{nneething} group, you will
-be told how many unread articles it contains, etc., etc.
-
-Some variables:
-
-@table @code
-@item nneething-map-file-directory
-@vindex nneething-map-file-directory
-All the mapping files for solid @code{nneething} groups will be stored
-in this directory, which defaults to @file{~/.nneething/}.
-
-@item nneething-exclude-files
-@vindex nneething-exclude-files
-All files that match this regexp will be ignored. Nice to use to exclude
-auto-save files and the like, which is what it does by default.
-
-@item nneething-include-files
-@vindex nneething-include-files
-Regexp saying what files to include in the group. If this variable is
-non-@code{nil}, only files matching this regexp will be included.
-
-@item nneething-map-file
-@vindex nneething-map-file
-Name of the map files.
-@end table
-
-
-@node Document Groups
-@subsection Document Groups
-@cindex nndoc
-@cindex documentation group
-@cindex help group
-
-@code{nndoc} is a cute little thing that will let you read a single file
-as a newsgroup. Several files types are supported:
-
-@table @code
-@cindex Babyl
-@cindex Rmail mbox
-@item babyl
-The Babyl (Rmail) mail box.
-
-@cindex mbox
-@cindex Unix mbox
-@item mbox
-The standard Unix mbox file.
-
-@cindex MMDF mail box
-@item mmdf
-The MMDF mail box format.
-
-@item news
-Several news articles appended into a file.
-
-@cindex rnews batch files
-@item rnews
-The rnews batch transport format.
-
-@item nsmail
-Netscape mail boxes.
-
-@item mime-parts
-@acronym{MIME} multipart messages.
-
-@item standard-digest
-The standard (RFC 1153) digest format.
-
-@item mime-digest
-A @acronym{MIME} digest of messages.
-
-@item lanl-gov-announce
-Announcement messages from LANL Gov Announce.
-
-@cindex forwarded messages
-@item rfc822-forward
-A message forwarded according to RFC822.
-
-@item outlook
-The Outlook mail box.
-
-@item oe-dbx
-The Outlook Express dbx mail box.
-
-@item exim-bounce
-A bounce message from the Exim MTA.
-
-@item forward
-A message forwarded according to informal rules.
-
-@item rfc934
-An RFC934-forwarded message.
-
-@item mailman
-A mailman digest.
-
-@item clari-briefs
-A digest of Clarinet brief news items.
-
-@item slack-digest
-Non-standard digest format---matches most things, but does it badly.
-
-@item mail-in-mail
-The last resort.
-@end table
-
-You can also use the special ``file type'' @code{guess}, which means
-that @code{nndoc} will try to guess what file type it is looking at.
-@code{digest} means that @code{nndoc} should guess what digest type the
-file is.
-
-@code{nndoc} will not try to change the file or insert any extra headers into
-it---it will simply, like, let you use the file as the basis for a
-group. And that's it.
-
-If you have some old archived articles that you want to insert into your
-new & spiffy Gnus mail back end, @code{nndoc} can probably help you with
-that. Say you have an old @file{RMAIL} file with mail that you now want
-to split into your new @code{nnml} groups. You look at that file using
-@code{nndoc} (using the @kbd{G f} command in the group buffer
-(@pxref{Foreign Groups})), set the process mark on all the articles in
-the buffer (@kbd{M P b}, for instance), and then re-spool (@kbd{B r})
-using @code{nnml}. If all goes well, all the mail in the @file{RMAIL}
-file is now also stored in lots of @code{nnml} directories, and you can
-delete that pesky @file{RMAIL} file. If you have the guts!
-
-Virtual server variables:
-
-@table @code
-@item nndoc-article-type
-@vindex nndoc-article-type
-This should be one of @code{mbox}, @code{babyl}, @code{digest},
-@code{news}, @code{rnews}, @code{mmdf}, @code{forward}, @code{rfc934},
-@code{rfc822-forward}, @code{mime-parts}, @code{standard-digest},
-@code{slack-digest}, @code{clari-briefs}, @code{nsmail}, @code{outlook},
-@code{oe-dbx}, @code{mailman}, and @code{mail-in-mail} or @code{guess}.
-
-@item nndoc-post-type
-@vindex nndoc-post-type
-This variable says whether Gnus is to consider the group a news group or
-a mail group. There are two valid values: @code{mail} (the default)
-and @code{news}.
-@end table
-
-@menu
-* Document Server Internals:: How to add your own document types.
-@end menu
-
-
-@node Document Server Internals
-@subsubsection Document Server Internals
-
-Adding new document types to be recognized by @code{nndoc} isn't
-difficult. You just have to whip up a definition of what the document
-looks like, write a predicate function to recognize that document type,
-and then hook into @code{nndoc}.
-
-First, here's an example document type definition:
-
-@example
-(mmdf
- (article-begin . "^\^A\^A\^A\^A\n")
- (body-end . "^\^A\^A\^A\^A\n"))
-@end example
-
-The definition is simply a unique @dfn{name} followed by a series of
-regexp pseudo-variable settings. Below are the possible
-variables---don't be daunted by the number of variables; most document
-types can be defined with very few settings:
-
-@table @code
-@item first-article
-If present, @code{nndoc} will skip past all text until it finds
-something that match this regexp. All text before this will be
-totally ignored.
-
-@item article-begin
-This setting has to be present in all document type definitions. It
-says what the beginning of each article looks like. To do more
-complicated things that cannot be dealt with a simple regexp, you can
-use @code{article-begin-function} instead of this.
-
-@item article-begin-function
-If present, this should be a function that moves point to the beginning
-of each article. This setting overrides @code{article-begin}.
-
-@item head-begin
-If present, this should be a regexp that matches the head of the
-article. To do more complicated things that cannot be dealt with a
-simple regexp, you can use @code{head-begin-function} instead of this.
-
-@item head-begin-function
-If present, this should be a function that moves point to the head of
-the article. This setting overrides @code{head-begin}.
-
-@item head-end
-This should match the end of the head of the article. It defaults to
-@samp{^$}---the empty line.
-
-@item body-begin
-This should match the beginning of the body of the article. It defaults
-to @samp{^\n}. To do more complicated things that cannot be dealt with
-a simple regexp, you can use @code{body-begin-function} instead of this.
-
-@item body-begin-function
-If present, this function should move point to the beginning of the body
-of the article. This setting overrides @code{body-begin}.
-
-@item body-end
-If present, this should match the end of the body of the article. To do
-more complicated things that cannot be dealt with a simple regexp, you
-can use @code{body-end-function} instead of this.
-
-@item body-end-function
-If present, this function should move point to the end of the body of
-the article. This setting overrides @code{body-end}.
-
-@item file-begin
-If present, this should match the beginning of the file. All text
-before this regexp will be totally ignored.
-
-@item file-end
-If present, this should match the end of the file. All text after this
-regexp will be totally ignored.
-
-@end table
-
-So, using these variables @code{nndoc} is able to dissect a document
-file into a series of articles, each with a head and a body. However, a
-few more variables are needed since not all document types are all that
-news-like---variables needed to transform the head or the body into
-something that's palatable for Gnus:
-
-@table @code
-@item prepare-body-function
-If present, this function will be called when requesting an article. It
-will be called with point at the start of the body, and is useful if the
-document has encoded some parts of its contents.
-
-@item article-transform-function
-If present, this function is called when requesting an article. It's
-meant to be used for more wide-ranging transformation of both head and
-body of the article.
-
-@item generate-head-function
-If present, this function is called to generate a head that Gnus can
-understand. It is called with the article number as a parameter, and is
-expected to generate a nice head for the article in question. It is
-called when requesting the headers of all articles.
-
-@item generate-article-function
-If present, this function is called to generate an entire article that
-Gnus can understand. It is called with the article number as a
-parameter when requesting all articles.
-
-@item dissection-function
-If present, this function is called to dissect a document by itself,
-overriding @code{first-article}, @code{article-begin},
-@code{article-begin-function}, @code{head-begin},
-@code{head-begin-function}, @code{head-end}, @code{body-begin},
-@code{body-begin-function}, @code{body-end}, @code{body-end-function},
-@code{file-begin}, and @code{file-end}.
-
-@end table
-
-Let's look at the most complicated example I can come up with---standard
-digests:
-
-@example
-(standard-digest
- (first-article . ,(concat "^" (make-string 70 ?-) "\n\n+"))
- (article-begin . ,(concat "\n\n" (make-string 30 ?-) "\n\n+"))
- (prepare-body-function . nndoc-unquote-dashes)
- (body-end-function . nndoc-digest-body-end)
- (head-end . "^ ?$")
- (body-begin . "^ ?\n")
- (file-end . "^End of .*digest.*[0-9].*\n\\*\\*\\|^End of.*Digest *$")
- (subtype digest guess))
-@end example
-
-We see that all text before a 70-width line of dashes is ignored; all
-text after a line that starts with that @samp{^End of} is also ignored;
-each article begins with a 30-width line of dashes; the line separating
-the head from the body may contain a single space; and that the body is
-run through @code{nndoc-unquote-dashes} before being delivered.
-
-To hook your own document definition into @code{nndoc}, use the
-@code{nndoc-add-type} function. It takes two parameters---the first
-is the definition itself and the second (optional) parameter says
-where in the document type definition alist to put this definition.
-The alist is traversed sequentially, and
-@code{nndoc-@var{type}-type-p} is called for a given type @var{type}.
-So @code{nndoc-mmdf-type-p} is called to see whether a document is of
-@code{mmdf} type, and so on. These type predicates should return
-@code{nil} if the document is not of the correct type; @code{t} if it
-is of the correct type; and a number if the document might be of the
-correct type. A high number means high probability; a low number
-means low probability with @samp{0} being the lowest valid number.
-
-
-@node SOUP
-@subsection SOUP
-@cindex SOUP
-@cindex offline
-
-In the PC world people often talk about ``offline'' newsreaders. These
-are thingies that are combined reader/news transport monstrosities.
-With built-in modem programs. Yecchh!
-
-Of course, us Unix Weenie types of human beans use things like
-@code{uucp} and, like, @code{nntpd} and set up proper news and mail
-transport things like Ghod intended. And then we just use normal
-newsreaders.
-
-However, it can sometimes be convenient to do something that's a bit
-easier on the brain if you have a very slow modem, and you're not really
-that interested in doing things properly.
-
-A file format called @sc{soup} has been developed for transporting news
-and mail from servers to home machines and back again. It can be a bit
-fiddly.
-
-First some terminology:
-
-@table @dfn
-
-@item server
-This is the machine that is connected to the outside world and where you
-get news and/or mail from.
-
-@item home machine
-This is the machine that you want to do the actual reading and responding
-on. It is typically not connected to the rest of the world in any way.
-
-@item packet
-Something that contains messages and/or commands. There are two kinds
-of packets:
-
-@table @dfn
-@item message packets
-These are packets made at the server, and typically contain lots of
-messages for you to read. These are called @file{SoupoutX.tgz} by
-default, where @var{x} is a number.
-
-@item response packets
-These are packets made at the home machine, and typically contains
-replies that you've written. These are called @file{SoupinX.tgz} by
-default, where @var{x} is a number.
-
-@end table
-
-@end table
-
-
-@enumerate
-
-@item
-You log in on the server and create a @sc{soup} packet. You can either
-use a dedicated @sc{soup} thingie (like the @code{awk} program), or you
-can use Gnus to create the packet with its @sc{soup} commands (@kbd{O
-s} and/or @kbd{G s b}; and then @kbd{G s p}) (@pxref{SOUP Commands}).
-
-@item
-You transfer the packet home. Rail, boat, car or modem will do fine.
-
-@item
-You put the packet in your home directory.
-
-@item
-You fire up Gnus on your home machine using the @code{nnsoup} back end as
-the native or secondary server.
-
-@item
-You read articles and mail and answer and followup to the things you
-want (@pxref{SOUP Replies}).
-
-@item
-You do the @kbd{G s r} command to pack these replies into a @sc{soup}
-packet.
-
-@item
-You transfer this packet to the server.
-
-@item
-You use Gnus to mail this packet out with the @kbd{G s s} command.
-
-@item
-You then repeat until you die.
-
-@end enumerate
-
-So you basically have a bipartite system---you use @code{nnsoup} for
-reading and Gnus for packing/sending these @sc{soup} packets.
-
-@menu
-* SOUP Commands:: Commands for creating and sending @sc{soup} packets
-* SOUP Groups:: A back end for reading @sc{soup} packets.
-* SOUP Replies:: How to enable @code{nnsoup} to take over mail and news.
-@end menu
-
-
-@node SOUP Commands
-@subsubsection SOUP Commands
-
-These are commands for creating and manipulating @sc{soup} packets.
-
-@table @kbd
-@item G s b
-@kindex G s b (Group)
-@findex gnus-group-brew-soup
-Pack all unread articles in the current group
-(@code{gnus-group-brew-soup}). This command understands the
-process/prefix convention.
-
-@item G s w
-@kindex G s w (Group)
-@findex gnus-soup-save-areas
-Save all @sc{soup} data files (@code{gnus-soup-save-areas}).
-
-@item G s s
-@kindex G s s (Group)
-@findex gnus-soup-send-replies
-Send all replies from the replies packet
-(@code{gnus-soup-send-replies}).
-
-@item G s p
-@kindex G s p (Group)
-@findex gnus-soup-pack-packet
-Pack all files into a @sc{soup} packet (@code{gnus-soup-pack-packet}).
-
-@item G s r
-@kindex G s r (Group)
-@findex nnsoup-pack-replies
-Pack all replies into a replies packet (@code{nnsoup-pack-replies}).
-
-@item O s
-@kindex O s (Summary)
-@findex gnus-soup-add-article
-This summary-mode command adds the current article to a @sc{soup} packet
-(@code{gnus-soup-add-article}). It understands the process/prefix
-convention (@pxref{Process/Prefix}).
-
-@end table
-
-
-There are a few variables to customize where Gnus will put all these
-thingies:
-
-@table @code
-
-@item gnus-soup-directory
-@vindex gnus-soup-directory
-Directory where Gnus will save intermediate files while composing
-@sc{soup} packets. The default is @file{~/SoupBrew/}.
-
-@item gnus-soup-replies-directory
-@vindex gnus-soup-replies-directory
-This is what Gnus will use as a temporary directory while sending our
-reply packets. @file{~/SoupBrew/SoupReplies/} is the default.
-
-@item gnus-soup-prefix-file
-@vindex gnus-soup-prefix-file
-Name of the file where Gnus stores the last used prefix. The default is
-@samp{gnus-prefix}.
-
-@item gnus-soup-packer
-@vindex gnus-soup-packer
-A format string command for packing a @sc{soup} packet. The default is
-@samp{tar cf - %s | gzip > $HOME/Soupout%d.tgz}.
-
-@item gnus-soup-unpacker
-@vindex gnus-soup-unpacker
-Format string command for unpacking a @sc{soup} packet. The default is
-@samp{gunzip -c %s | tar xvf -}.
-
-@item gnus-soup-packet-directory
-@vindex gnus-soup-packet-directory
-Where Gnus will look for reply packets. The default is @file{~/}.
-
-@item gnus-soup-packet-regexp
-@vindex gnus-soup-packet-regexp
-Regular expression matching @sc{soup} reply packets in
-@code{gnus-soup-packet-directory}.
-
-@end table
-
-
-@node SOUP Groups
-@subsubsection SOUP Groups
-@cindex nnsoup
-
-@code{nnsoup} is the back end for reading @sc{soup} packets. It will
-read incoming packets, unpack them, and put them in a directory where
-you can read them at leisure.
-
-These are the variables you can use to customize its behavior:
-
-@table @code
-
-@item nnsoup-tmp-directory
-@vindex nnsoup-tmp-directory
-When @code{nnsoup} unpacks a @sc{soup} packet, it does it in this
-directory. (@file{/tmp/} by default.)
-
-@item nnsoup-directory
-@vindex nnsoup-directory
-@code{nnsoup} then moves each message and index file to this directory.
-The default is @file{~/SOUP/}.
-
-@item nnsoup-replies-directory
-@vindex nnsoup-replies-directory
-All replies will be stored in this directory before being packed into a
-reply packet. The default is @file{~/SOUP/replies/}.
-
-@item nnsoup-replies-format-type
-@vindex nnsoup-replies-format-type
-The @sc{soup} format of the replies packets. The default is @samp{?n}
-(rnews), and I don't think you should touch that variable. I probably
-shouldn't even have documented it. Drats! Too late!
-
-@item nnsoup-replies-index-type
-@vindex nnsoup-replies-index-type
-The index type of the replies packet. The default is @samp{?n}, which
-means ``none''. Don't fiddle with this one either!
-
-@item nnsoup-active-file
-@vindex nnsoup-active-file
-Where @code{nnsoup} stores lots of information. This is not an ``active
-file'' in the @code{nntp} sense; it's an Emacs Lisp file. If you lose
-this file or mess it up in any way, you're dead. The default is
-@file{~/SOUP/active}.
-
-@item nnsoup-packer
-@vindex nnsoup-packer
-Format string command for packing a reply @sc{soup} packet. The default
-is @samp{tar cf - %s | gzip > $HOME/Soupin%d.tgz}.
-
-@item nnsoup-unpacker
-@vindex nnsoup-unpacker
-Format string command for unpacking incoming @sc{soup} packets. The
-default is @samp{gunzip -c %s | tar xvf -}.
-
-@item nnsoup-packet-directory
-@vindex nnsoup-packet-directory
-Where @code{nnsoup} will look for incoming packets. The default is
-@file{~/}.
-
-@item nnsoup-packet-regexp
-@vindex nnsoup-packet-regexp
-Regular expression matching incoming @sc{soup} packets. The default is
-@samp{Soupout}.
-
-@item nnsoup-always-save
-@vindex nnsoup-always-save
-If non-@code{nil}, save the replies buffer after each posted message.
-
-@end table
-
-
-@node SOUP Replies
-@subsubsection SOUP Replies
-
-Just using @code{nnsoup} won't mean that your postings and mailings end
-up in @sc{soup} reply packets automagically. You have to work a bit
-more for that to happen.
-
-@findex nnsoup-set-variables
-The @code{nnsoup-set-variables} command will set the appropriate
-variables to ensure that all your followups and replies end up in the
-@sc{soup} system.
-
-In specific, this is what it does:
-
-@lisp
-(setq message-send-news-function 'nnsoup-request-post)
-(setq message-send-mail-function 'nnsoup-request-mail)
-@end lisp
-
-And that's it, really. If you only want news to go into the @sc{soup}
-system you just use the first line. If you only want mail to be
-@sc{soup}ed you use the second.
-
-
-@node Mail-To-News Gateways
-@subsection Mail-To-News Gateways
-@cindex mail-to-news gateways
-@cindex gateways
-
-If your local @code{nntp} server doesn't allow posting, for some reason
-or other, you can post using one of the numerous mail-to-news gateways.
-The @code{nngateway} back end provides the interface.
-
-Note that you can't read anything from this back end---it can only be
-used to post with.
-
-Server variables:
-
-@table @code
-@item nngateway-address
-@vindex nngateway-address
-This is the address of the mail-to-news gateway.
-
-@item nngateway-header-transformation
-@vindex nngateway-header-transformation
-News headers often have to be transformed in some odd way or other
-for the mail-to-news gateway to accept it. This variable says what
-transformation should be called, and defaults to
-@code{nngateway-simple-header-transformation}. The function is called
-narrowed to the headers to be transformed and with one parameter---the
-gateway address.
-
-This default function just inserts a new @code{To} header based on the
-@code{Newsgroups} header and the gateway address.
-For instance, an article with this @code{Newsgroups} header:
-
-@example
-Newsgroups: alt.religion.emacs
-@end example
-
-will get this @code{To} header inserted:
-
-@example
-To: alt-religion-emacs@@GATEWAY
-@end example
-
-The following pre-defined functions exist:
-
-@findex nngateway-simple-header-transformation
-@table @code
-
-@item nngateway-simple-header-transformation
-Creates a @code{To} header that looks like
-@var{newsgroup}@@@code{nngateway-address}.
-
-@findex nngateway-mail2news-header-transformation
-
-@item nngateway-mail2news-header-transformation
-Creates a @code{To} header that looks like
-@code{nngateway-address}.
-@end table
-
-@end table
-
-Here's an example:
-
-@lisp
-(setq gnus-post-method
- '(nngateway
- "mail2news@@replay.com"
- (nngateway-header-transformation
- nngateway-mail2news-header-transformation)))
-@end lisp
-
-So, to use this, simply say something like:
-
-@lisp
-(setq gnus-post-method '(nngateway "GATEWAY.ADDRESS"))
-@end lisp
-
-
-
-@node Combined Groups
-@section Combined Groups
-
-Gnus allows combining a mixture of all the other group types into bigger
-groups.
-
-@menu
-* Virtual Groups:: Combining articles from many groups.
-* Kibozed Groups:: Looking through parts of the newsfeed for articles.
-@end menu
-
-
-@node Virtual Groups
-@subsection Virtual Groups
-@cindex nnvirtual
-@cindex virtual groups
-@cindex merging groups
-
-An @dfn{nnvirtual group} is really nothing more than a collection of
-other groups.
-
-For instance, if you are tired of reading many small groups, you can
-put them all in one big group, and then grow tired of reading one
-big, unwieldy group. The joys of computing!
-
-You specify @code{nnvirtual} as the method. The address should be a
-regexp to match component groups.
-
-All marks in the virtual group will stick to the articles in the
-component groups. So if you tick an article in a virtual group, the
-article will also be ticked in the component group from whence it
-came. (And vice versa---marks from the component groups will also be
-shown in the virtual group.). To create an empty virtual group, run
-@kbd{G V} (@code{gnus-group-make-empty-virtual}) in the group buffer
-and edit the method regexp with @kbd{M-e}
-(@code{gnus-group-edit-group-method})
-
-Here's an example @code{nnvirtual} method that collects all Andrea Dworkin
-newsgroups into one, big, happy newsgroup:
-
-@lisp
-(nnvirtual "^alt\\.fan\\.andrea-dworkin$\\|^rec\\.dworkin.*")
-@end lisp
-
-The component groups can be native or foreign; everything should work
-smoothly, but if your computer explodes, it was probably my fault.
-
-Collecting the same group from several servers might actually be a good
-idea if users have set the Distribution header to limit distribution.
-If you would like to read @samp{soc.motss} both from a server in Japan
-and a server in Norway, you could use the following as the group regexp:
-
-@example
-"^nntp\\+server\\.jp:soc\\.motss$\\|^nntp\\+server\\.no:soc\\.motss$"
-@end example
-
-(Remember, though, that if you're creating the group with @kbd{G m}, you
-shouldn't double the backslashes, and you should leave off the quote
-characters at the beginning and the end of the string.)
-
-This should work kinda smoothly---all articles from both groups should
-end up in this one, and there should be no duplicates. Threading (and
-the rest) will still work as usual, but there might be problems with the
-sequence of articles. Sorting on date might be an option here
-(@pxref{Selecting a Group}).
-
-One limitation, however---all groups included in a virtual
-group have to be alive (i.e., subscribed or unsubscribed). Killed or
-zombie groups can't be component groups for @code{nnvirtual} groups.
-
-@vindex nnvirtual-always-rescan
-If the @code{nnvirtual-always-rescan} variable is non-@code{nil} (which
-is the default), @code{nnvirtual} will always scan groups for unread
-articles when entering a virtual group. If this variable is @code{nil}
-and you read articles in a component group after the virtual group has
-been activated, the read articles from the component group will show up
-when you enter the virtual group. You'll also see this effect if you
-have two virtual groups that have a component group in common. If
-that's the case, you should set this variable to @code{t}. Or you can
-just tap @code{M-g} on the virtual group every time before you enter
-it---it'll have much the same effect.
-
-@code{nnvirtual} can have both mail and news groups as component groups.
-When responding to articles in @code{nnvirtual} groups, @code{nnvirtual}
-has to ask the back end of the component group the article comes from
-whether it is a news or mail back end. However, when you do a @kbd{^},
-there is typically no sure way for the component back end to know this,
-and in that case @code{nnvirtual} tells Gnus that the article came from a
-not-news back end. (Just to be on the safe side.)
-
-@kbd{C-c C-n} in the message buffer will insert the @code{Newsgroups}
-line from the article you respond to in these cases.
-
-@code{nnvirtual} groups do not inherit anything but articles and marks
-from component groups---group parameters, for instance, are not
-inherited.
-
-
-@node Kibozed Groups
-@subsection Kibozed Groups
-@cindex nnkiboze
-@cindex kibozing
-
-@dfn{Kibozing} is defined by the @acronym{OED} as ``grepping through
-(parts of) the news feed''. @code{nnkiboze} is a back end that will
-do this for you. Oh joy! Now you can grind any @acronym{NNTP} server
-down to a halt with useless requests! Oh happiness!
-
-@kindex G k (Group)
-To create a kibozed group, use the @kbd{G k} command in the group
-buffer.
-
-The address field of the @code{nnkiboze} method is, as with
-@code{nnvirtual}, a regexp to match groups to be ``included'' in the
-@code{nnkiboze} group. That's where most similarities between
-@code{nnkiboze} and @code{nnvirtual} end.
-
-In addition to this regexp detailing component groups, an
-@code{nnkiboze} group must have a score file to say what articles are
-to be included in the group (@pxref{Scoring}).
-
-@kindex M-x nnkiboze-generate-groups
-@findex nnkiboze-generate-groups
-You must run @kbd{M-x nnkiboze-generate-groups} after creating the
-@code{nnkiboze} groups you want to have. This command will take time.
-Lots of time. Oodles and oodles of time. Gnus has to fetch the
-headers from all the articles in all the component groups and run them
-through the scoring process to determine if there are any articles in
-the groups that are to be part of the @code{nnkiboze} groups.
-
-Please limit the number of component groups by using restrictive
-regexps. Otherwise your sysadmin may become annoyed with you, and the
-@acronym{NNTP} site may throw you off and never let you back in again.
-Stranger things have happened.
-
-@code{nnkiboze} component groups do not have to be alive---they can be dead,
-and they can be foreign. No restrictions.
-
-@vindex nnkiboze-directory
-The generation of an @code{nnkiboze} group means writing two files in
-@code{nnkiboze-directory}, which is @file{~/News/kiboze/} by default.
-One contains the @acronym{NOV} header lines for all the articles in
-the group, and the other is an additional @file{.newsrc} file to store
-information on what groups have been searched through to find
-component articles.
-
-Articles marked as read in the @code{nnkiboze} group will have
-their @acronym{NOV} lines removed from the @acronym{NOV} file.
-
-
-@node Email Based Diary
-@section Email Based Diary
-@cindex diary
-@cindex email based diary
-@cindex calendar
-
-This section describes a special mail back end called @code{nndiary},
-and its companion library @code{gnus-diary}. It is ``special'' in the
-sense that it is not meant to be one of the standard alternatives for
-reading mail with Gnus. See @ref{Choosing a Mail Back End} for that.
-Instead, it is used to treat @emph{some} of your mails in a special way,
-namely, as event reminders.
-
-Here is a typical scenario:
-
-@itemize @bullet
-@item
-You've got a date with Andy Mc Dowell or Bruce Willis (select according
-to your sexual preference) in one month. You don't want to forget it.
-@item
-So you send a ``reminder'' message (actually, a diary one) to yourself.
-@item
-You forget all about it and keep on getting and reading new mail, as usual.
-@item
-From time to time, as you type `g' in the group buffer and as the date
-is getting closer, the message will pop up again to remind you of your
-appointment, just as if it were new and unread.
-@item
-Read your ``new'' messages, this one included, and start dreaming again
-of the night you're gonna have.
-@item
-Once the date is over (you actually fell asleep just after dinner), the
-message will be automatically deleted if it is marked as expirable.
-@end itemize
-
-The Gnus Diary back end has the ability to handle regular appointments
-(that wouldn't ever be deleted) as well as punctual ones, operates as a
-real mail back end and is configurable in many ways. All of this is
-explained in the sections below.
-
-@menu
-* The NNDiary Back End:: Basic setup and usage.
-* The Gnus Diary Library:: Utility toolkit on top of nndiary.
-* Sending or Not Sending:: A final note on sending diary messages.
-@end menu
-
-
-@node The NNDiary Back End
-@subsection The NNDiary Back End
-@cindex nndiary
-@cindex the nndiary back end
-
-@code{nndiary} is a back end very similar to @code{nnml} (@pxref{Mail
-Spool}). Actually, it could appear as a mix of @code{nnml} and
-@code{nndraft}. If you know @code{nnml}, you're already familiar with
-the message storing scheme of @code{nndiary}: one file per message, one
-directory per group.
-
- Before anything, there is one requirement to be able to run
-@code{nndiary} properly: you @emph{must} use the group timestamp feature
-of Gnus. This adds a timestamp to each group's parameters. @ref{Group
-Timestamp} to see how it's done.
-
-@menu
-* Diary Messages:: What makes a message valid for nndiary.
-* Running NNDiary:: NNDiary has two modes of operation.
-* Customizing NNDiary:: Bells and whistles.
-@end menu
-
-@node Diary Messages
-@subsubsection Diary Messages
-@cindex nndiary messages
-@cindex nndiary mails
-
-@code{nndiary} messages are just normal ones, except for the mandatory
-presence of 7 special headers. These headers are of the form
-@code{X-Diary-<something>}, @code{<something>} being one of
-@code{Minute}, @code{Hour}, @code{Dom}, @code{Month}, @code{Year},
-@code{Time-Zone} and @code{Dow}. @code{Dom} means ``Day of Month'', and
-@code{dow} means ``Day of Week''. These headers actually behave like
-crontab specifications and define the event date(s):
-
-@itemize @bullet
-@item
-For all headers except the @code{Time-Zone} one, a header value is
-either a star (meaning all possible values), or a list of fields
-(separated by a comma).
-@item
-A field is either an integer, or a range.
-@item
-A range is two integers separated by a dash.
-@item
-Possible integer values are 0--59 for @code{Minute}, 0--23 for
-@code{Hour}, 1--31 for @code{Dom}, 1--12 for @code{Month}, above 1971
-for @code{Year} and 0--6 for @code{Dow} (0 meaning Sunday).
-@item
-As a special case, a star in either @code{Dom} or @code{Dow} doesn't
-mean ``all possible values'', but ``use only the other field''. Note
-that if both are star'ed, the use of either one gives the same result.
-@item
-The @code{Time-Zone} header is special in that it can only have one
-value (@code{GMT}, for instance). A star doesn't mean ``all possible
-values'' (because it makes no sense), but ``the current local time
-zone''. Most of the time, you'll be using a star here. However, for a
-list of available time zone values, see the variable
-@code{nndiary-headers}.
-@end itemize
-
-As a concrete example, here are the diary headers to add to your message
-for specifying ``Each Monday and each 1st of month, at 12:00, 20:00,
-21:00, 22:00, 23:00 and 24:00, from 1999 to 2010'' (I'll let you find
-what to do then):
-
-@example
-X-Diary-Minute: 0
-X-Diary-Hour: 12, 20-24
-X-Diary-Dom: 1
-X-Diary-Month: *
-X-Diary-Year: 1999-2010
-X-Diary-Dow: 1
-X-Diary-Time-Zone: *
-@end example
-
-@node Running NNDiary
-@subsubsection Running NNDiary
-@cindex running nndiary
-@cindex nndiary operation modes
-
-@code{nndiary} has two modes of operation: ``traditional'' (the default)
-and ``autonomous''. In traditional mode, @code{nndiary} does not get new
-mail by itself. You have to move (@kbd{B m}) or copy (@kbd{B c}) mails
-from your primary mail back end to nndiary groups in order to handle them
-as diary messages. In autonomous mode, @code{nndiary} retrieves its own
-mail and handles it independently from your primary mail back end.
-
-One should note that Gnus is not inherently designed to allow several
-``master'' mail back ends at the same time. However, this does make
-sense with @code{nndiary}: you really want to send and receive diary
-messages to your diary groups directly. So, @code{nndiary} supports
-being sort of a ``second primary mail back end'' (to my knowledge, it is
-the only back end offering this feature). However, there is a limitation
-(which I hope to fix some day): respooling doesn't work in autonomous
-mode.
-
-In order to use @code{nndiary} in autonomous mode, you have several
-things to do:
-
-@itemize @bullet
-@item
-Allow @code{nndiary} to retrieve new mail by itself. Put the following
-line in your @file{~/.gnus.el} file:
-
-@lisp
-(setq nndiary-get-new-mail t)
-@end lisp
-@item
-You must arrange for diary messages (those containing @code{X-Diary-*}
-headers) to be split in a private folder @emph{before} Gnus treat them.
-Again, this is needed because Gnus cannot (yet ?) properly handle
-multiple primary mail back ends. Getting those messages from a separate
-source will compensate this misfeature to some extent.
-
-As an example, here's my procmailrc entry to store diary files in
-@file{~/.nndiary} (the default @code{nndiary} mail source file):
-
-@example
-:0 HD :
-* ^X-Diary
-.nndiary
-@end example
-@end itemize
-
-Once this is done, you might want to customize the following two options
-that affect the diary mail retrieval and splitting processes:
-
-@defvar nndiary-mail-sources
-This is the diary-specific replacement for the standard
-@code{mail-sources} variable. It obeys the same syntax, and defaults to
-@code{(file :path "~/.nndiary")}.
-@end defvar
-
-@defvar nndiary-split-methods
-This is the diary-specific replacement for the standard
-@code{nnmail-split-methods} variable. It obeys the same syntax.
-@end defvar
-
- Finally, you may add a permanent @code{nndiary} virtual server
-(something like @code{(nndiary "diary")} should do) to your
-@code{gnus-secondary-select-methods}.
-
- Hopefully, almost everything (see the TODO section in
-@file{nndiary.el}) will work as expected when you restart Gnus: in
-autonomous mode, typing @kbd{g} and @kbd{M-g} in the group buffer, will
-also get your new diary mails and split them according to your
-diary-specific rules, @kbd{F} will find your new diary groups etc.
-
-@node Customizing NNDiary
-@subsubsection Customizing NNDiary
-@cindex customizing nndiary
-@cindex nndiary customization
-
-Now that @code{nndiary} is up and running, it's time to customize it.
-The custom group is called @code{nndiary} (no, really ?!). You should
-browse it to figure out which options you'd like to tweak. The following
-two variables are probably the only ones you will want to change:
-
-@defvar nndiary-reminders
-This is the list of times when you want to be reminded of your
-appointments (e.g. 3 weeks before, then 2 days before, then 1 hour
-before and that's it). Remember that ``being reminded'' means that the
-diary message will pop up as brand new and unread again when you get new
-mail.
-@end defvar
-
-@defvar nndiary-week-starts-on-monday
-Rather self-explanatory. Otherwise, Sunday is assumed (this is the
-default).
-@end defvar
-
-
-@node The Gnus Diary Library
-@subsection The Gnus Diary Library
-@cindex gnus-diary
-@cindex the gnus diary library
-
-Using @code{nndiary} manually (I mean, writing the headers by hand and
-so on) would be rather boring. Fortunately, there is a library called
-@code{gnus-diary} written on top of @code{nndiary}, that does many
-useful things for you.
-
- In order to use it, add the following line to your @file{~/.gnus.el} file:
-
-@lisp
-(require 'gnus-diary)
-@end lisp
-
- Also, you shouldn't use any @code{gnus-user-format-function-[d|D]}
-(@pxref{Summary Buffer Lines}). @code{gnus-diary} provides both of these
-(sorry if you used them before).
-
-
-@menu
-* Diary Summary Line Format:: A nicer summary buffer line format.
-* Diary Articles Sorting:: A nicer way to sort messages.
-* Diary Headers Generation:: Not doing it manually.
-* Diary Group Parameters:: Not handling them manually.
-@end menu
-
-@node Diary Summary Line Format
-@subsubsection Diary Summary Line Format
-@cindex diary summary buffer line
-@cindex diary summary line format
-
-Displaying diary messages in standard summary line format (usually
-something like @samp{From Joe: Subject}) is pretty useless. Most of
-the time, you're the one who wrote the message, and you mostly want to
-see the event's date.
-
- @code{gnus-diary} provides two supplemental user formats to be used in
-summary line formats. @code{D} corresponds to a formatted time string
-for the next occurrence of the event (e.g. ``Sat, Sep 22 01, 12:00''),
-while @code{d} corresponds to an approximative remaining time until the
-next occurrence of the event (e.g. ``in 6 months, 1 week'').
-
- For example, here's how Joe's birthday is displayed in my
-@code{nndiary+diary:birthdays} summary buffer (note that the message is
-expirable, but will never be deleted, as it specifies a periodic event):
-
-@example
- E Sat, Sep 22 01, 12:00: Joe's birthday (in 6 months, 1 week)
-@end example
-
-In order to get something like the above, you would normally add the
-following line to your diary groups'parameters:
-
-@lisp
-(gnus-summary-line-format "%U%R%z %uD: %(%s%) (%ud)\n")
-@end lisp
-
-However, @code{gnus-diary} does it automatically (@pxref{Diary Group
-Parameters}). You can however customize the provided summary line format
-with the following user options:
-
-@defvar gnus-diary-summary-line-format
-Defines the summary line format used for diary groups (@pxref{Summary
-Buffer Lines}). @code{gnus-diary} uses it to automatically update the
-diary groups'parameters.
-@end defvar
-
-@defvar gnus-diary-time-format
-Defines the format to display dates in diary summary buffers. This is
-used by the @code{D} user format. See the docstring for details.
-@end defvar
-
-@defvar gnus-diary-delay-format-function
-Defines the format function to use for displaying delays (remaining
-times) in diary summary buffers. This is used by the @code{d} user
-format. There are currently built-in functions for English and French;
-you can also define your own. See the docstring for details.
-@end defvar
-
-@node Diary Articles Sorting
-@subsubsection Diary Articles Sorting
-@cindex diary articles sorting
-@cindex diary summary lines sorting
-@findex gnus-summary-sort-by-schedule
-@findex gnus-thread-sort-by-schedule
-@findex gnus-article-sort-by-schedule
-
-@code{gnus-diary} provides new sorting functions (@pxref{Sorting the
-Summary Buffer} ) called @code{gnus-summary-sort-by-schedule},
-@code{gnus-thread-sort-by-schedule} and
-@code{gnus-article-sort-by-schedule}. These functions let you organize
-your diary summary buffers from the closest event to the farthest one.
-
-@code{gnus-diary} automatically installs
-@code{gnus-summary-sort-by-schedule} as a menu item in the summary
-buffer's ``sort'' menu, and the two others as the primary (hence
-default) sorting functions in the group parameters (@pxref{Diary Group
-Parameters}).
-
-@node Diary Headers Generation
-@subsubsection Diary Headers Generation
-@cindex diary headers generation
-@findex gnus-diary-check-message
-
-@code{gnus-diary} provides a function called
-@code{gnus-diary-check-message} to help you handle the @code{X-Diary-*}
-headers. This function ensures that the current message contains all the
-required diary headers, and prompts you for values or corrections if
-needed.
-
- This function is hooked into the @code{nndiary} back end, so that
-moving or copying an article to a diary group will trigger it
-automatically. It is also bound to @kbd{C-c D c} in @code{message-mode}
-and @code{article-edit-mode} in order to ease the process of converting
-a usual mail to a diary one.
-
- This function takes a prefix argument which will force prompting of
-all diary headers, regardless of their presence or validity. That way,
-you can very easily reschedule an already valid diary message, for
-instance.
-
-@node Diary Group Parameters
-@subsubsection Diary Group Parameters
-@cindex diary group parameters
-
-When you create a new diary group, or visit one, @code{gnus-diary}
-automatically checks your group parameters and if needed, sets the
-summary line format to the diary-specific value, installs the
-diary-specific sorting functions, and also adds the different
-@code{X-Diary-*} headers to the group's posting-style. It is then easier
-to send a diary message, because if you use @kbd{C-u a} or @kbd{C-u m}
-on a diary group to prepare a message, these headers will be inserted
-automatically (although not filled with proper values yet).
-
-@node Sending or Not Sending
-@subsection Sending or Not Sending
-
-Well, assuming you've read all of the above, here are two final notes on
-mail sending with @code{nndiary}:
-
-@itemize @bullet
-@item
-@code{nndiary} is a @emph{real} mail back end. You really send real diary
-messsages for real. This means for instance that you can give
-appointments to anybody (provided they use Gnus and @code{nndiary}) by
-sending the diary message to them as well.
-@item
-However, since @code{nndiary} also has a @code{request-post} method, you
-can also use @kbd{C-u a} instead of @kbd{C-u m} on a diary group and the
-message won't actually be sent; just stored locally in the group. This
-comes in very handy for private appointments.
-@end itemize
-
-@node Gnus Unplugged
-@section Gnus Unplugged
-@cindex offline
-@cindex unplugged
-@cindex agent
-@cindex Gnus agent
-@cindex Gnus unplugged
-
-In olden times (ca. February '88), people used to run their newsreaders
-on big machines with permanent connections to the net. News transport
-was dealt with by news servers, and all the newsreaders had to do was to
-read news. Believe it or not.
-
-Nowadays most people read news and mail at home, and use some sort of
-modem to connect to the net. To avoid running up huge phone bills, it
-would be nice to have a way to slurp down all the news and mail, hang up
-the phone, read for several hours, and then upload any responses you
-have to make. And then you repeat the procedure.
-
-Of course, you can use news servers for doing this as well. I've used
-@code{inn} together with @code{slurp}, @code{pop} and @code{sendmail}
-for some years, but doing that's a bore. Moving the news server
-functionality up to the newsreader makes sense if you're the only person
-reading news on a machine.
-
-Setting up Gnus as an ``offline'' newsreader is quite simple. In
-fact, you don't even have to configure anything.
-
-Of course, to use it as such, you have to learn a few new commands.
-
-@menu
-* Agent Basics:: How it all is supposed to work.
-* Agent Categories:: How to tell the Gnus Agent what to download.
-* Agent Commands:: New commands for all the buffers.
-* Agent Visuals:: Ways that the agent may effect your summary buffer.
-* Agent as Cache:: The Agent is a big cache too.
-* Agent Expiry:: How to make old articles go away.
-* Agent Regeneration:: How to recover from lost connections and other accidents.
-* Agent and IMAP:: How to use the Agent with @acronym{IMAP}.
-* Outgoing Messages:: What happens when you post/mail something?
-* Agent Variables:: Customizing is fun.
-* Example Setup:: An example @file{~/.gnus.el} file for offline people.
-* Batching Agents:: How to fetch news from a @code{cron} job.
-* Agent Caveats:: What you think it'll do and what it does.
-@end menu
-
-
-@node Agent Basics
-@subsection Agent Basics
-
-First, let's get some terminology out of the way.
-
-The Gnus Agent is said to be @dfn{unplugged} when you have severed the
-connection to the net (and notified the Agent that this is the case).
-When the connection to the net is up again (and Gnus knows this), the
-Agent is @dfn{plugged}.
-
-The @dfn{local} machine is the one you're running on, and which isn't
-connected to the net continuously.
-
-@dfn{Downloading} means fetching things from the net to your local
-machine. @dfn{Uploading} is doing the opposite.
-
-You know that Gnus gives you all the opportunity you'd ever want for
-shooting yourself in the foot. Some people call it flexibility. Gnus
-is also customizable to a great extent, which means that the user has a
-say on how Gnus behaves. Other newsreaders might unconditionally shoot
-you in your foot, but with Gnus, you have a choice!
-
-Gnus is never really in plugged or unplugged state. Rather, it applies
-that state to each server individually. This means that some servers
-can be plugged while others can be unplugged. Additionally, some
-servers can be ignored by the Agent altogether (which means that
-they're kinda like plugged always).
-
-So when you unplug the Agent and then wonder why is Gnus opening a
-connection to the Net, the next step to do is to look whether all
-servers are agentized. If there is an unagentized server, you found
-the culprit.
-
-Another thing is the @dfn{offline} state. Sometimes, servers aren't
-reachable. When Gnus notices this, it asks you whether you want the
-server to be switched to offline state. If you say yes, then the
-server will behave somewhat as if it was unplugged, except that Gnus
-will ask you whether you want to switch it back online again.
-
-Let's take a typical Gnus session using the Agent.
-
-@itemize @bullet
-
-@item
-@findex gnus-unplugged
-You start Gnus with @code{gnus-unplugged}. This brings up the Gnus
-Agent in a disconnected state. You can read all the news that you have
-already fetched while in this mode.
-
-@item
-You then decide to see whether any new news has arrived. You connect
-your machine to the net (using PPP or whatever), and then hit @kbd{J j}
-to make Gnus become @dfn{plugged} and use @kbd{g} to check for new mail
-as usual. To check for new mail in unplugged mode (@pxref{Mail
-Source Specifiers}).
-
-@item
-You can then read the new news immediately, or you can download the
-news onto your local machine. If you want to do the latter, you press
-@kbd{g} to check if there are any new news and then @kbd{J s} to fetch
-all the eligible articles in all the groups. (To let Gnus know which
-articles you want to download, @pxref{Agent Categories}).
-
-@item
-After fetching the articles, you press @kbd{J j} to make Gnus become
-unplugged again, and you shut down the PPP thing (or whatever). And
-then you read the news offline.
-
-@item
-And then you go to step 2.
-@end itemize
-
-Here are some things you should do the first time (or so) that you use
-the Agent.
-
-@itemize @bullet
-
-@item
-Decide which servers should be covered by the Agent. If you have a mail
-back end, it would probably be nonsensical to have it covered by the
-Agent. Go to the server buffer (@kbd{^} in the group buffer) and press
-@kbd{J a} on the server (or servers) that you wish to have covered by the
-Agent (@pxref{Server Agent Commands}), or @kbd{J r} on automatically
-added servers you do not wish to have covered by the Agent. By default,
-all @code{nntp} and @code{nnimap} servers in @code{gnus-select-method} and
-@code{gnus-secondary-select-methods} are agentized.
-
-@item
-Decide on download policy. It's fairly simple once you decide whether
-you are going to use agent categories, topic parameters, and/or group
-parameters to implement your policy. If you're new to gnus, it
-is probably best to start with a category, @xref{Agent Categories}.
-
-Both topic parameters (@pxref{Topic Parameters}) and agent categories
-(@pxref{Agent Categories}) provide for setting a policy that applies
-to multiple groups. Which you use is entirely up to you. Topic
-parameters do override categories so, if you mix the two, you'll have
-to take that into account. If you have a few groups that deviate from
-your policy, you can use group parameters (@pxref{Group Parameters}) to
-configure them.
-
-@item
-Uhm@dots{} that's it.
-@end itemize
-
-
-@node Agent Categories
-@subsection Agent Categories
-
-One of the main reasons to integrate the news transport layer into the
-newsreader is to allow greater control over what articles to download.
-There's not much point in downloading huge amounts of articles, just to
-find out that you're not interested in reading any of them. It's better
-to be somewhat more conservative in choosing what to download, and then
-mark the articles for downloading manually if it should turn out that
-you're interested in the articles anyway.
-
-One of the more effective methods for controlling what is to be
-downloaded is to create a @dfn{category} and then assign some (or all)
-groups to this category. Groups that do not belong in any other
-category belong to the @code{default} category. Gnus has its own
-buffer for creating and managing categories.
-
-If you prefer, you can also use group parameters (@pxref{Group
-Parameters}) and topic parameters (@pxref{Topic Parameters}) for an
-alternative approach to controlling the agent. The only real
-difference is that categories are specific to the agent (so there is
-less to learn) while group and topic parameters include the kitchen
-sink.
-
-Since you can set agent parameters in several different places we have
-a rule to decide which source to believe. This rule specifies that
-the parameter sources are checked in the following order: group
-parameters, topic parameters, agent category, and finally customizable
-variables. So you can mix all of these sources to produce a wide range
-of behavior, just don't blame me if you don't remember where you put
-your settings.
-
-@menu
-* Category Syntax:: What a category looks like.
-* Category Buffer:: A buffer for maintaining categories.
-* Category Variables:: Customize'r'Us.
-@end menu
-
-
-@node Category Syntax
-@subsubsection Category Syntax
-
-A category consists of a name, the list of groups belonging to the
-category, and a number of optional parameters that override the
-customizable variables. The complete list of agent parameters are
-listed below.
-
-@cindex Agent Parameters
-@table @code
-@item gnus-agent-cat-name
-The name of the category.
-
-@item gnus-agent-cat-groups
-The list of groups that are in this category.
-
-@item gnus-agent-cat-predicate
-A predicate which (generally) gives a rough outline of which articles
-are eligible for downloading; and
-
-@item gnus-agent-cat-score-file
-a score rule which (generally) gives you a finer granularity when
-deciding what articles to download. (Note that this @dfn{download
-score} is not necessarily related to normal scores.)
-
-@item gnus-agent-cat-enable-expiration
-a boolean indicating whether the agent should expire old articles in
-this group. Most groups should be expired to conserve disk space. In
-fact, its probably safe to say that the gnus.* hierarchy contains the
-only groups that should not be expired.
-
-@item gnus-agent-cat-days-until-old
-an integer indicating the number of days that the agent should wait
-before deciding that a read article is safe to expire.
-
-@item gnus-agent-cat-low-score
-an integer that overrides the value of @code{gnus-agent-low-score}.
-
-@item gnus-agent-cat-high-score
-an integer that overrides the value of @code{gnus-agent-high-score}.
-
-@item gnus-agent-cat-length-when-short
-an integer that overrides the value of
-@code{gnus-agent-short-article}.
-
-@item gnus-agent-cat-length-when-long
-an integer that overrides the value of @code{gnus-agent-long-article}.
-
-@c @item gnus-agent-cat-disable-undownloaded-faces
-@c a symbol indicating whether the summary buffer should @emph{not} display
-@c undownloaded articles using the gnus-summary-*-undownloaded-face
-@c faces. The symbol nil will enable the use of undownloaded faces while
-@c all other symbols disable them.
-
-@item gnus-agent-cat-enable-undownloaded-faces
-a symbol indicating whether the summary buffer should display
-undownloaded articles using the gnus-summary-*-undownloaded-face
-faces. The symbol nil will disable the use of undownloaded faces while
-all other symbols enable them.
-@end table
-
-The name of a category can not be changed once the category has been
-created.
-
-Each category maintains a list of groups that are exclusive members of
-that category. The exclusivity rule is automatically enforced, add a
-group to a new category and it is automatically removed from its old
-category.
-
-A predicate in its simplest form can be a single predicate such as
-@code{true} or @code{false}. These two will download every available
-article or nothing respectively. In the case of these two special
-predicates an additional score rule is superfluous.
-
-Predicates of @code{high} or @code{low} download articles in respect of
-their scores in relationship to @code{gnus-agent-high-score} and
-@code{gnus-agent-low-score} as described below.
-
-To gain even finer control of what is to be regarded eligible for
-download a predicate can consist of a number of predicates with logical
-operators sprinkled in between.
-
-Perhaps some examples are in order.
-
-Here's a simple predicate. (It's the default predicate, in fact, used
-for all groups that don't belong to any other category.)
-
-@lisp
-short
-@end lisp
-
-Quite simple, eh? This predicate is true if and only if the article is
-short (for some value of ``short'').
-
-Here's a more complex predicate:
-
-@lisp
-(or high
- (and
- (not low)
- (not long)))
-@end lisp
-
-This means that an article should be downloaded if it has a high score,
-or if the score is not low and the article is not long. You get the
-drift.
-
-The available logical operators are @code{or}, @code{and} and
-@code{not}. (If you prefer, you can use the more ``C''-ish operators
-@samp{|}, @code{&} and @code{!} instead.)
-
-The following predicates are pre-defined, but if none of these fit what
-you want to do, you can write your own.
-
-When evaluating each of these predicates, the named constant will be
-bound to the value determined by calling
-@code{gnus-agent-find-parameter} on the appropriate parameter. For
-example, gnus-agent-short-article will be bound to
-@code{(gnus-agent-find-parameter group 'agent-short-article)}. This
-means that you can specify a predicate in your category then tune that
-predicate to individual groups.
-
-@table @code
-@item short
-True if the article is shorter than @code{gnus-agent-short-article}
-lines; default 100.
-
-@item long
-True if the article is longer than @code{gnus-agent-long-article}
-lines; default 200.
-
-@item low
-True if the article has a download score less than
-@code{gnus-agent-low-score}; default 0.
-
-@item high
-True if the article has a download score greater than
-@code{gnus-agent-high-score}; default 0.
-
-@item spam
-True if the Gnus Agent guesses that the article is spam. The
-heuristics may change over time, but at present it just computes a
-checksum and sees whether articles match.
-
-@item true
-Always true.
-
-@item false
-Always false.
-@end table
-
-If you want to create your own predicate function, here's what you have
-to know: The functions are called with no parameters, but the
-@code{gnus-headers} and @code{gnus-score} dynamic variables are bound to
-useful values.
-
-For example, you could decide that you don't want to download articles
-that were posted more than a certain number of days ago (e.g. posted
-more than @code{gnus-agent-expire-days} ago) you might write a function
-something along the lines of the following:
-
-@lisp
-(defun my-article-old-p ()
- "Say whether an article is old."
- (< (time-to-days (date-to-time (mail-header-date gnus-headers)))
- (- (time-to-days (current-time)) gnus-agent-expire-days)))
-@end lisp
-
-with the predicate then defined as:
-
-@lisp
-(not my-article-old-p)
-@end lisp
-
-or you could append your predicate to the predefined
-@code{gnus-category-predicate-alist} in your @file{~/.gnus.el} or
-wherever.
-
-@lisp
-(require 'gnus-agent)
-(setq gnus-category-predicate-alist
- (append gnus-category-predicate-alist
- '((old . my-article-old-p))))
-@end lisp
-
-and simply specify your predicate as:
-
-@lisp
-(not old)
-@end lisp
-
-If/when using something like the above, be aware that there are many
-misconfigured systems/mailers out there and so an article's date is not
-always a reliable indication of when it was posted. Hell, some people
-just don't give a damn.
-
-The above predicates apply to @emph{all} the groups which belong to the
-category. However, if you wish to have a specific predicate for an
-individual group within a category, or you're just too lazy to set up a
-new category, you can enter a group's individual predicate in its group
-parameters like so:
-
-@lisp
-(agent-predicate . short)
-@end lisp
-
-This is the group/topic parameter equivalent of the agent category default.
-Note that when specifying a single word predicate like this, the
-@code{agent-predicate} specification must be in dotted pair notation.
-
-The equivalent of the longer example from above would be:
-
-@lisp
-(agent-predicate or high (and (not low) (not long)))
-@end lisp
-
-The outer parenthesis required in the category specification are not
-entered here as, not being in dotted pair notation, the value of the
-predicate is assumed to be a list.
-
-
-Now, the syntax of the download score is the same as the syntax of
-normal score files, except that all elements that require actually
-seeing the article itself are verboten. This means that only the
-following headers can be scored on: @code{Subject}, @code{From},
-@code{Date}, @code{Message-ID}, @code{References}, @code{Chars},
-@code{Lines}, and @code{Xref}.
-
-As with predicates, the specification of the @code{download score rule}
-to use in respect of a group can be in either the category definition if
-it's to be applicable to all groups in therein, or a group's parameters
-if it's to be specific to that group.
-
-In both of these places the @code{download score rule} can take one of
-three forms:
-
-@enumerate
-@item
-Score rule
-
-This has the same syntax as a normal Gnus score file except only a
-subset of scoring keywords are available as mentioned above.
-
-example:
-
-@itemize @bullet
-@item
-Category specification
-
-@lisp
-(("from"
- ("Lars Ingebrigtsen" 1000000 nil s))
-("lines"
- (500 -100 nil <)))
-@end lisp
-
-@item
-Group/Topic Parameter specification
-
-@lisp
-(agent-score ("from"
- ("Lars Ingebrigtsen" 1000000 nil s))
- ("lines"
- (500 -100 nil <)))
-@end lisp
-
-Again, note the omission of the outermost parenthesis here.
-@end itemize
-
-@item
-Agent score file
-
-These score files must @emph{only} contain the permitted scoring
-keywords stated above.
-
-example:
-
-@itemize @bullet
-@item
-Category specification
-
-@lisp
-("~/News/agent.SCORE")
-@end lisp
-
-or perhaps
-
-@lisp
-("~/News/agent.SCORE" "~/News/agent.group.SCORE")
-@end lisp
-
-@item
-Group Parameter specification
-
-@lisp
-(agent-score "~/News/agent.SCORE")
-@end lisp
-
-Additional score files can be specified as above. Need I say anything
-about parenthesis?
-@end itemize
-
-@item
-Use @code{normal} score files
-
-If you don't want to maintain two sets of scoring rules for a group, and
-your desired @code{downloading} criteria for a group are the same as your
-@code{reading} criteria then you can tell the agent to refer to your
-@code{normal} score files when deciding what to download.
-
-These directives in either the category definition or a group's
-parameters will cause the agent to read in all the applicable score
-files for a group, @emph{filtering out} those sections that do not
-relate to one of the permitted subset of scoring keywords.
-
-@itemize @bullet
-@item
-Category Specification
-
-@lisp
-file
-@end lisp
-
-@item
-Group Parameter specification
-
-@lisp
-(agent-score . file)
-@end lisp
-@end itemize
-@end enumerate
-
-@node Category Buffer
-@subsubsection Category Buffer
-
-You'd normally do all category maintenance from the category buffer.
-When you enter it for the first time (with the @kbd{J c} command from
-the group buffer), you'll only see the @code{default} category.
-
-The following commands are available in this buffer:
-
-@table @kbd
-@item q
-@kindex q (Category)
-@findex gnus-category-exit
-Return to the group buffer (@code{gnus-category-exit}).
-
-@item e
-@kindex e (Category)
-@findex gnus-category-customize-category
-Use a customization buffer to set all of the selected category's
-parameters at one time (@code{gnus-category-customize-category}).
-
-@item k
-@kindex k (Category)
-@findex gnus-category-kill
-Kill the current category (@code{gnus-category-kill}).
-
-@item c
-@kindex c (Category)
-@findex gnus-category-copy
-Copy the current category (@code{gnus-category-copy}).
-
-@item a
-@kindex a (Category)
-@findex gnus-category-add
-Add a new category (@code{gnus-category-add}).
-
-@item p
-@kindex p (Category)
-@findex gnus-category-edit-predicate
-Edit the predicate of the current category
-(@code{gnus-category-edit-predicate}).
-
-@item g
-@kindex g (Category)
-@findex gnus-category-edit-groups
-Edit the list of groups belonging to the current category
-(@code{gnus-category-edit-groups}).
-
-@item s
-@kindex s (Category)
-@findex gnus-category-edit-score
-Edit the download score rule of the current category
-(@code{gnus-category-edit-score}).
-
-@item l
-@kindex l (Category)
-@findex gnus-category-list
-List all the categories (@code{gnus-category-list}).
-@end table
-
-
-@node Category Variables
-@subsubsection Category Variables
-
-@table @code
-@item gnus-category-mode-hook
-@vindex gnus-category-mode-hook
-Hook run in category buffers.
-
-@item gnus-category-line-format
-@vindex gnus-category-line-format
-Format of the lines in the category buffer (@pxref{Formatting
-Variables}). Valid elements are:
-
-@table @samp
-@item c
-The name of the category.
-
-@item g
-The number of groups in the category.
-@end table
-
-@item gnus-category-mode-line-format
-@vindex gnus-category-mode-line-format
-Format of the category mode line (@pxref{Mode Line Formatting}).
-
-@item gnus-agent-short-article
-@vindex gnus-agent-short-article
-Articles that have fewer lines than this are short. Default 100.
-
-@item gnus-agent-long-article
-@vindex gnus-agent-long-article
-Articles that have more lines than this are long. Default 200.
-
-@item gnus-agent-low-score
-@vindex gnus-agent-low-score
-Articles that have a score lower than this have a low score. Default
-0.
-
-@item gnus-agent-high-score
-@vindex gnus-agent-high-score
-Articles that have a score higher than this have a high score. Default
-0.
-
-@item gnus-agent-expire-days
-@vindex gnus-agent-expire-days
-The number of days that a @samp{read} article must stay in the agent's
-local disk before becoming eligible for expiration (While the name is
-the same, this doesn't mean expiring the article on the server. It
-just means deleting the local copy of the article). What is also
-important to understand is that the counter starts with the time the
-article was written to the local disk and not the time the article was
-read.
-Default 7.
-
-@item gnus-agent-enable-expiration
-@vindex gnus-agent-enable-expiration
-Determines whether articles in a group are, by default, expired or
-retained indefinitely. The default is @code{ENABLE} which means that
-you'll have to disable expiration when desired. On the other hand,
-you could set this to @code{DISABLE}. In that case, you would then
-have to enable expiration in selected groups.
-
-@end table
-
-
-@node Agent Commands
-@subsection Agent Commands
-@findex gnus-agent-toggle-plugged
-@kindex J j (Agent)
-
-All the Gnus Agent commands are on the @kbd{J} submap. The @kbd{J j}
-(@code{gnus-agent-toggle-plugged}) command works in all modes, and
-toggles the plugged/unplugged state of the Gnus Agent.
-
-
-@menu
-* Group Agent Commands:: Configure groups and fetch their contents.
-* Summary Agent Commands:: Manually select then fetch specific articles.
-* Server Agent Commands:: Select the servers that are supported by the agent.
-@end menu
-
-
-
-
-@node Group Agent Commands
-@subsubsection Group Agent Commands
-
-@table @kbd
-@item J u
-@kindex J u (Agent Group)
-@findex gnus-agent-fetch-groups
-Fetch all eligible articles in the current group
-(@code{gnus-agent-fetch-groups}).
-
-@item J c
-@kindex J c (Agent Group)
-@findex gnus-enter-category-buffer
-Enter the Agent category buffer (@code{gnus-enter-category-buffer}).
-
-@item J s
-@kindex J s (Agent Group)
-@findex gnus-agent-fetch-session
-Fetch all eligible articles in all groups
-(@code{gnus-agent-fetch-session}).
-
-@item J S
-@kindex J S (Agent Group)
-@findex gnus-group-send-queue
-Send all sendable messages in the queue group
-(@code{gnus-group-send-queue}). @xref{Drafts}.
-
-@item J a
-@kindex J a (Agent Group)
-@findex gnus-agent-add-group
-Add the current group to an Agent category
-(@code{gnus-agent-add-group}). This command understands the
-process/prefix convention (@pxref{Process/Prefix}).
-
-@item J r
-@kindex J r (Agent Group)
-@findex gnus-agent-remove-group
-Remove the current group from its category, if any
-(@code{gnus-agent-remove-group}). This command understands the
-process/prefix convention (@pxref{Process/Prefix}).
-
-@item J Y
-@kindex J Y (Agent Group)
-@findex gnus-agent-synchronize-flags
-Synchronize flags changed while unplugged with remote server, if any.
-
-
-@end table
-
-
-@node Summary Agent Commands
-@subsubsection Summary Agent Commands
-
-@table @kbd
-@item J #
-@kindex J # (Agent Summary)
-@findex gnus-agent-mark-article
-Mark the article for downloading (@code{gnus-agent-mark-article}).
-
-@item J M-#
-@kindex J M-# (Agent Summary)
-@findex gnus-agent-unmark-article
-Remove the downloading mark from the article
-(@code{gnus-agent-unmark-article}).
-
-@cindex %
-@item @@
-@kindex @@ (Agent Summary)
-@findex gnus-agent-toggle-mark
-Toggle whether to download the article
-(@code{gnus-agent-toggle-mark}). The download mark is @samp{%} by
-default.
-
-@item J c
-@kindex J c (Agent Summary)
-@findex gnus-agent-catchup
-Mark all articles as read (@code{gnus-agent-catchup}) that are neither cached, downloaded, nor downloadable.
-
-@item J S
-@kindex J S (Agent Summary)
-@findex gnus-agent-fetch-group
-Download all eligible (@pxref{Agent Categories}) articles in this group.
-(@code{gnus-agent-fetch-group}).
-
-@item J s
-@kindex J s (Agent Summary)
-@findex gnus-agent-fetch-series
-Download all processable articles in this group.
-(@code{gnus-agent-fetch-series}).
-
-@item J u
-@kindex J u (Agent Summary)
-@findex gnus-agent-summary-fetch-group
-Download all downloadable articles in the current group
-(@code{gnus-agent-summary-fetch-group}).
-
-@end table
-
-
-@node Server Agent Commands
-@subsubsection Server Agent Commands
-
-@table @kbd
-@item J a
-@kindex J a (Agent Server)
-@findex gnus-agent-add-server
-Add the current server to the list of servers covered by the Gnus Agent
-(@code{gnus-agent-add-server}).
-
-@item J r
-@kindex J r (Agent Server)
-@findex gnus-agent-remove-server
-Remove the current server from the list of servers covered by the Gnus
-Agent (@code{gnus-agent-remove-server}).
-
-@end table
-
-
-@node Agent Visuals
-@subsection Agent Visuals
-
-If you open a summary while unplugged and, Gnus knows from the group's
-active range that there are more articles than the headers currently
-stored in the Agent, you may see some articles whose subject looks
-something like @samp{[Undownloaded article #####]}. These are
-placeholders for the missing headers. Aside from setting a mark,
-there is not much that can be done with one of these placeholders.
-When Gnus finally gets a chance to fetch the group's headers, the
-placeholders will automatically be replaced by the actual headers.
-You can configure the summary buffer's maneuvering to skip over the
-placeholders if you care (See @code{gnus-auto-goto-ignores}).
-
-While it may be obvious to all, the only headers and articles
-available while unplugged are those headers and articles that were
-fetched into the Agent while previously plugged. To put it another
-way, ``If you forget to fetch something while plugged, you might have a
-less than satisfying unplugged session''. For this reason, the Agent
-adds two visual effects to your summary buffer. These effects display
-the download status of each article so that you always know which
-articles will be available when unplugged.
-
-The first visual effect is the @samp{%O} spec. If you customize
-@code{gnus-summary-line-format} to include this specifier, you will add
-a single character field that indicates an article's download status.
-Articles that have been fetched into either the Agent or the Cache,
-will display @code{gnus-downloaded-mark} (defaults to @samp{+}). All
-other articles will display @code{gnus-undownloaded-mark} (defaults to
-@samp{-}). If you open a group that has not been agentized, a space
-(@samp{ }) will be displayed.
-
-The second visual effect are the undownloaded faces. The faces, there
-are three indicating the article's score (low, normal, high), seem to
-result in a love/hate response from many Gnus users. The problem is
-that the face selection is controlled by a list of condition tests and
-face names (See @code{gnus-summary-highlight}). Each condition is
-tested in the order in which it appears in the list so early
-conditions have precedence over later conditions. All of this means
-that, if you tick an undownloaded article, the article will continue
-to be displayed in the undownloaded face rather than the ticked face.
-
-If you use the Agent as a cache (to avoid downloading the same article
-each time you visit it or to minimize your connection time), the
-undownloaded face will probably seem like a good idea. The reason
-being that you do all of our work (marking, reading, deleting) with
-downloaded articles so the normal faces always appear.
-
-For occasional Agent users, the undownloaded faces may appear to be an
-absolutely horrible idea. The issue being that, since most of their
-articles have not been fetched into the Agent, most of the normal
-faces will be obscured by the undownloaded faces. If this is your
-situation, you have two choices available. First, you can completely
-disable the undownload faces by customizing
-@code{gnus-summary-highlight} to delete the three cons-cells that
-refer to the @code{gnus-summary-*-undownloaded-face} faces. Second,
-if you prefer to take a more fine-grained approach, you may set the
-@code{agent-disable-undownloaded-faces} group parameter to @code{t}.
-This parameter, like all other agent parameters, may be set on an
-Agent Category (@pxref{Agent Categories}), a Group Topic (@pxref{Topic
-Parameters}), or an individual group (@pxref{Group Parameters}).
-
-@node Agent as Cache
-@subsection Agent as Cache
-
-When Gnus is plugged, it is not efficient to download headers or
-articles from the server again, if they are already stored in the
-Agent. So, Gnus normally only downloads headers once, and stores them
-in the Agent. These headers are later used when generating the summary
-buffer, regardless of whether you are plugged or unplugged. Articles
-are not cached in the Agent by default though (that would potentially
-consume lots of disk space), but if you have already downloaded an
-article into the Agent, Gnus will not download the article from the
-server again but use the locally stored copy instead.
-
-If you so desire, you can configure the agent (see @code{gnus-agent-cache}
-@pxref{Agent Variables}) to always download headers and articles while
-plugged. Gnus will almost certainly be slower, but it will be kept
-synchronized with the server. That last point probably won't make any
-sense if you are using a nntp or nnimap back end.
-
-@node Agent Expiry
-@subsection Agent Expiry
-
-@vindex gnus-agent-expire-days
-@findex gnus-agent-expire
-@kindex M-x gnus-agent-expire
-@kindex M-x gnus-agent-expire-group
-@findex gnus-agent-expire-group
-@cindex agent expiry
-@cindex Gnus agent expiry
-@cindex expiry, in Gnus agent
-
-The Agent back end, @code{nnagent}, doesn't handle expiry. Well, at
-least it doesn't handle it like other back ends. Instead, there are
-special @code{gnus-agent-expire} and @code{gnus-agent-expire-group}
-commands that will expire all read articles that are older than
-@code{gnus-agent-expire-days} days. They can be run whenever you feel
-that you're running out of space. Neither are particularly fast or
-efficient, and it's not a particularly good idea to interrupt them (with
-@kbd{C-g} or anything else) once you've started one of them.
-
-Note that other functions, e.g. @code{gnus-request-expire-articles},
-might run @code{gnus-agent-expire} for you to keep the agent
-synchronized with the group.
-
-The agent parameter @code{agent-enable-expiration} may be used to
-prevent expiration in selected groups.
-
-@vindex gnus-agent-expire-all
-If @code{gnus-agent-expire-all} is non-@code{nil}, the agent
-expiration commands will expire all articles---unread, read, ticked
-and dormant. If @code{nil} (which is the default), only read articles
-are eligible for expiry, and unread, ticked and dormant articles will
-be kept indefinitely.
-
-If you find that some articles eligible for expiry are never expired,
-perhaps some Gnus Agent files are corrupted. There's are special
-commands, @code{gnus-agent-regenerate} and
-@code{gnus-agent-regenerate-group}, to fix possible problems.
-
-@node Agent Regeneration
-@subsection Agent Regeneration
-
-@cindex agent regeneration
-@cindex Gnus agent regeneration
-@cindex regeneration
-
-The local data structures used by @code{nnagent} may become corrupted
-due to certain exceptional conditions. When this happens,
-@code{nnagent} functionality may degrade or even fail. The solution
-to this problem is to repair the local data structures by removing all
-internal inconsistencies.
-
-For example, if your connection to your server is lost while
-downloaded articles into the agent, the local data structures will not
-know about articles successfully downloaded prior to the connection
-failure. Running @code{gnus-agent-regenerate} or
-@code{gnus-agent-regenerate-group} will update the data structures
-such that you don't need to download these articles a second time.
-
-@findex gnus-agent-regenerate
-@kindex M-x gnus-agent-regenerate
-The command @code{gnus-agent-regenerate} will perform
-@code{gnus-agent-regenerate-group} on every agentized group. While
-you can run @code{gnus-agent-regenerate} in any buffer, it is strongly
-recommended that you first close all summary buffers.
-
-@findex gnus-agent-regenerate-group
-@kindex M-x gnus-agent-regenerate-group
-The command @code{gnus-agent-regenerate-group} uses the local copies
-of individual articles to repair the local @acronym{NOV}(header) database. It
-then updates the internal data structures that document which articles
-are stored locally. An optional argument will mark articles in the
-agent as unread.
-
-@node Agent and IMAP
-@subsection Agent and IMAP
-
-The Agent works with any Gnus back end, including nnimap. However,
-since there are some conceptual differences between @acronym{NNTP} and
-@acronym{IMAP}, this section (should) provide you with some information to
-make Gnus Agent work smoother as a @acronym{IMAP} Disconnected Mode client.
-
-The first thing to keep in mind is that all flags (read, ticked, etc)
-are kept on the @acronym{IMAP} server, rather than in @file{.newsrc} as is the
-case for nntp. Thus Gnus need to remember flag changes when
-disconnected, and synchronize these flags when you plug back in.
-
-Gnus keeps track of flag changes when reading nnimap groups under the
-Agent. When you plug back in, Gnus will check if you have any changed
-any flags and ask if you wish to synchronize these with the server.
-The behavior is customizable by @code{gnus-agent-synchronize-flags}.
-
-@vindex gnus-agent-synchronize-flags
-If @code{gnus-agent-synchronize-flags} is @code{nil}, the Agent will
-never automatically synchronize flags. If it is @code{ask}, which is
-the default, the Agent will check if you made any changes and if so
-ask if you wish to synchronize these when you re-connect. If it has
-any other value, all flags will be synchronized automatically.
-
-If you do not wish to synchronize flags automatically when you
-re-connect, you can do it manually with the
-@code{gnus-agent-synchronize-flags} command that is bound to @kbd{J Y}
-in the group buffer.
-
-Some things are currently not implemented in the Agent that you'd might
-expect from a disconnected @acronym{IMAP} client, including:
-
-@itemize @bullet
-
-@item
-Copying/moving articles into nnimap groups when unplugged.
-
-@item
-Creating/deleting nnimap groups when unplugged.
-
-@end itemize
-
-Technical note: the synchronization algorithm does not work by ``pushing''
-all local flags to the server, but rather incrementally update the
-server view of flags by changing only those flags that were changed by
-the user. Thus, if you set one flag on an article, quit the group and
-re-select the group and remove the flag; the flag will be set and
-removed from the server when you ``synchronize''. The queued flag
-operations can be found in the per-server @code{flags} file in the Agent
-directory. It's emptied when you synchronize flags.
-
-
-@node Outgoing Messages
-@subsection Outgoing Messages
-
-When Gnus is unplugged, all outgoing messages (both mail and news) are
-stored in the draft group ``queue'' (@pxref{Drafts}). You can view
-them there after posting, and edit them at will.
-
-When Gnus is plugged again, you can send the messages either from the
-draft group with the special commands available there, or you can use
-the @kbd{J S} command in the group buffer to send all the sendable
-messages in the draft group.
-
-
-
-@node Agent Variables
-@subsection Agent Variables
-
-@table @code
-@item gnus-agent-directory
-@vindex gnus-agent-directory
-Where the Gnus Agent will store its files. The default is
-@file{~/News/agent/}.
-
-@item gnus-agent-handle-level
-@vindex gnus-agent-handle-level
-Groups on levels (@pxref{Group Levels}) higher than this variable will
-be ignored by the Agent. The default is @code{gnus-level-subscribed},
-which means that only subscribed group will be considered by the Agent
-by default.
-
-@item gnus-agent-plugged-hook
-@vindex gnus-agent-plugged-hook
-Hook run when connecting to the network.
-
-@item gnus-agent-unplugged-hook
-@vindex gnus-agent-unplugged-hook
-Hook run when disconnecting from the network.
-
-@item gnus-agent-fetched-hook
-@vindex gnus-agent-fetched-hook
-Hook run when finished fetching articles.
-
-@item gnus-agent-cache
-@vindex gnus-agent-cache
-Variable to control whether use the locally stored @acronym{NOV} and
-articles when plugged, e.g. essentially using the Agent as a cache.
-The default is non-@code{nil}, which means to use the Agent as a cache.
-
-@item gnus-agent-go-online
-@vindex gnus-agent-go-online
-If @code{gnus-agent-go-online} is @code{nil}, the Agent will never
-automatically switch offline servers into online status. If it is
-@code{ask}, the default, the Agent will ask if you wish to switch
-offline servers into online status when you re-connect. If it has any
-other value, all offline servers will be automatically switched into
-online status.
-
-@item gnus-agent-mark-unread-after-downloaded
-@vindex gnus-agent-mark-unread-after-downloaded
-If @code{gnus-agent-mark-unread-after-downloaded} is non-@code{nil},
-mark articles as unread after downloading. This is usually a safe
-thing to do as the newly downloaded article has obviously not been
-read. The default is @code{t}.
-
-@item gnus-agent-consider-all-articles
-@vindex gnus-agent-consider-all-articles
-If @code{gnus-agent-consider-all-articles} is non-@code{nil}, the
-agent will let the agent predicate decide whether articles need to be
-downloaded or not, for all articles. When @code{nil}, the default,
-the agent will only let the predicate decide whether unread articles
-are downloaded or not. If you enable this, you may also want to look
-into the agent expiry settings (@pxref{Category Variables}), so that
-the agent doesn't download articles which the agent will later expire,
-over and over again.
-
-@item gnus-agent-max-fetch-size
-@vindex gnus-agent-max-fetch-size
-The agent fetches articles into a temporary buffer prior to parsing
-them into individual files. To avoid exceeding the max. buffer size,
-the agent alternates between fetching and parsing until all articles
-have been fetched. @code{gnus-agent-max-fetch-size} provides a size
-limit to control how often the cycling occurs. A large value improves
-performance. A small value minimizes the time lost should the
-connection be lost while fetching (You may need to run
-@code{gnus-agent-regenerate-group} to update the group's state.
-However, all articles parsed prior to loosing the connection will be
-available while unplugged). The default is 10M so it is unusual to
-see any cycling.
-
-@item gnus-server-unopen-status
-@vindex gnus-server-unopen-status
-Perhaps not an Agent variable, but closely related to the Agent, this
-variable says what will happen if Gnus cannot open a server. If the
-Agent is enabled, the default, @code{nil}, makes Gnus ask the user
-whether to deny the server or whether to unplug the agent. If the
-Agent is disabled, Gnus always simply deny the server. Other choices
-for this variable include @code{denied} and @code{offline} the latter
-is only valid if the Agent is used.
-
-@item gnus-auto-goto-ignores
-@vindex gnus-auto-goto-ignores
-Another variable that isn't an Agent variable, yet so closely related
-that most will look for it here, this variable tells the summary
-buffer how to maneuver around undownloaded (only headers stored in the
-agent) and unfetched (neither article nor headers stored) articles.
-
-The valid values are @code{nil} (maneuver to any article),
-@code{undownloaded} (maneuvering while unplugged ignores articles that
-have not been fetched), @code{always-undownloaded} (maneuvering always
-ignores articles that have not been fetched), @code{unfetched}
-(maneuvering ignores articles whose headers have not been fetched).
-
-@item gnus-agent-auto-agentize-methods
-@vindex gnus-agent-auto-agentize-methods
-If you have never used the Agent before (or more technically, if
-@file{~/News/agent/lib/servers} does not exist), Gnus will
-automatically agentize a few servers for you. This variable control
-which backends should be auto-agentized. It is typically only useful
-to agentize remote backends. The auto-agentizing has the same effect
-as running @kbd{J a} on the servers (@pxref{Server Agent Commands}).
-If the file exist, you must manage the servers manually by adding or
-removing them, this variable is only applicable the first time you
-start Gnus. The default is @samp{(nntp nnimap)}.
-
-@end table
-
-
-@node Example Setup
-@subsection Example Setup
-
-If you don't want to read this manual, and you have a fairly standard
-setup, you may be able to use something like the following as your
-@file{~/.gnus.el} file to get started.
-
-@lisp
-;; @r{Define how Gnus is to fetch news. We do this over @acronym{NNTP}}
-;; @r{from your ISP's server.}
-(setq gnus-select-method '(nntp "news.your-isp.com"))
-
-;; @r{Define how Gnus is to read your mail. We read mail from}
-;; @r{your ISP's @acronym{POP} server.}
-(setq mail-sources '((pop :server "pop.your-isp.com")))
-
-;; @r{Say how Gnus is to store the mail. We use nnml groups.}
-(setq gnus-secondary-select-methods '((nnml "")))
-
-;; @r{Make Gnus into an offline newsreader.}
-;; (gnus-agentize) ; @r{The obsolete setting.}
-;; (setq gnus-agent t) ; @r{Now the default.}
-@end lisp
-
-That should be it, basically. Put that in your @file{~/.gnus.el} file,
-edit to suit your needs, start up PPP (or whatever), and type @kbd{M-x
-gnus}.
-
-If this is the first time you've run Gnus, you will be subscribed
-automatically to a few default newsgroups. You'll probably want to
-subscribe to more groups, and to do that, you have to query the
-@acronym{NNTP} server for a complete list of groups with the @kbd{A A}
-command. This usually takes quite a while, but you only have to do it
-once.
-
-After reading and parsing a while, you'll be presented with a list of
-groups. Subscribe to the ones you want to read with the @kbd{u}
-command. @kbd{l} to make all the killed groups disappear after you've
-subscribe to all the groups you want to read. (@kbd{A k} will bring
-back all the killed groups.)
-
-You can now read the groups at once, or you can download the articles
-with the @kbd{J s} command. And then read the rest of this manual to
-find out which of the other gazillion things you want to customize.
-
-
-@node Batching Agents
-@subsection Batching Agents
-@findex gnus-agent-batch
-
-Having the Gnus Agent fetch articles (and post whatever messages you've
-written) is quite easy once you've gotten things set up properly. The
-following shell script will do everything that is necessary:
-
-You can run a complete batch command from the command line with the
-following incantation:
-
-@example
-#!/bin/sh
-emacs -batch -l ~/.emacs -l ~/.gnus.el -f gnus-agent-batch >/dev/null 2>&1
-@end example
-
-
-@node Agent Caveats
-@subsection Agent Caveats
-
-The Gnus Agent doesn't seem to work like most other offline
-newsreaders. Here are some common questions that some imaginary people
-may ask:
-
-@table @dfn
-@item If I read an article while plugged, do they get entered into the Agent?
-
-@strong{No}. If you want this behavior, add
-@code{gnus-agent-fetch-selected-article} to
-@code{gnus-select-article-hook}.
-
-@item If I read an article while plugged, and the article already exists in
-the Agent, will it get downloaded once more?
-
-@strong{No}, unless @code{gnus-agent-cache} is @code{nil}.
-
-@end table
-
-In short, when Gnus is unplugged, it only looks into the locally stored
-articles; when it's plugged, it talks to your ISP and may also use the
-locally stored articles.
-
-
-@node Scoring
-@chapter Scoring
-@cindex scoring
-
-Other people use @dfn{kill files}, but we here at Gnus Towers like
-scoring better than killing, so we'd rather switch than fight. They do
-something completely different as well, so sit up straight and pay
-attention!
-
-@vindex gnus-summary-mark-below
-All articles have a default score (@code{gnus-summary-default-score}),
-which is 0 by default. This score may be raised or lowered either
-interactively or by score files. Articles that have a score lower than
-@code{gnus-summary-mark-below} are marked as read.
-
-Gnus will read any @dfn{score files} that apply to the current group
-before generating the summary buffer.
-
-There are several commands in the summary buffer that insert score
-entries based on the current article. You can, for instance, ask Gnus to
-lower or increase the score of all articles with a certain subject.
-
-There are two sorts of scoring entries: Permanent and temporary.
-Temporary score entries are self-expiring entries. Any entries that are
-temporary and have not been used for, say, a week, will be removed
-silently to help keep the sizes of the score files down.
-
-@menu
-* Summary Score Commands:: Adding score entries for the current group.
-* Group Score Commands:: General score commands.
-* Score Variables:: Customize your scoring. (My, what terminology).
-* Score File Format:: What a score file may contain.
-* Score File Editing:: You can edit score files by hand as well.
-* Adaptive Scoring:: Big Sister Gnus knows what you read.
-* Home Score File:: How to say where new score entries are to go.
-* Followups To Yourself:: Having Gnus notice when people answer you.
-* Scoring On Other Headers:: Scoring on non-standard headers.
-* Scoring Tips:: How to score effectively.
-* Reverse Scoring:: That problem child of old is not problem.
-* Global Score Files:: Earth-spanning, ear-splitting score files.
-* Kill Files:: They are still here, but they can be ignored.
-* Converting Kill Files:: Translating kill files to score files.
-* GroupLens:: Getting predictions on what you like to read.
-* Advanced Scoring:: Using logical expressions to build score rules.
-* Score Decays:: It can be useful to let scores wither away.
-@end menu
-
-
-@node Summary Score Commands
-@section Summary Score Commands
-@cindex score commands
-
-The score commands that alter score entries do not actually modify real
-score files. That would be too inefficient. Gnus maintains a cache of
-previously loaded score files, one of which is considered the
-@dfn{current score file alist}. The score commands simply insert
-entries into this list, and upon group exit, this list is saved.
-
-The current score file is by default the group's local score file, even
-if no such score file actually exists. To insert score commands into
-some other score file (e.g. @file{all.SCORE}), you must first make this
-score file the current one.
-
-General score commands that don't actually change the score file:
-
-@table @kbd
-
-@item V s
-@kindex V s (Summary)
-@findex gnus-summary-set-score
-Set the score of the current article (@code{gnus-summary-set-score}).
-
-@item V S
-@kindex V S (Summary)
-@findex gnus-summary-current-score
-Display the score of the current article
-(@code{gnus-summary-current-score}).
-
-@item V t
-@kindex V t (Summary)
-@findex gnus-score-find-trace
-Display all score rules that have been used on the current article
-(@code{gnus-score-find-trace}). In the @code{*Score Trace*} buffer, you
-may type @kbd{e} to edit score file corresponding to the score rule on
-current line and @kbd{f} to format (@code{gnus-score-pretty-print}) the
-score file and edit it.
-
-@item V w
-@kindex V w (Summary)
-@findex gnus-score-find-favourite-words
-List words used in scoring (@code{gnus-score-find-favourite-words}).
-
-@item V R
-@kindex V R (Summary)
-@findex gnus-summary-rescore
-Run the current summary through the scoring process
-(@code{gnus-summary-rescore}). This might be useful if you're playing
-around with your score files behind Gnus' back and want to see the
-effect you're having.
-
-@item V c
-@kindex V c (Summary)
-@findex gnus-score-change-score-file
-Make a different score file the current
-(@code{gnus-score-change-score-file}).
-
-@item V e
-@kindex V e (Summary)
-@findex gnus-score-edit-current-scores
-Edit the current score file (@code{gnus-score-edit-current-scores}).
-You will be popped into a @code{gnus-score-mode} buffer (@pxref{Score
-File Editing}).
-
-@item V f
-@kindex V f (Summary)
-@findex gnus-score-edit-file
-Edit a score file and make this score file the current one
-(@code{gnus-score-edit-file}).
-
-@item V F
-@kindex V F (Summary)
-@findex gnus-score-flush-cache
-Flush the score cache (@code{gnus-score-flush-cache}). This is useful
-after editing score files.
-
-@item V C
-@kindex V C (Summary)
-@findex gnus-score-customize
-Customize a score file in a visually pleasing manner
-(@code{gnus-score-customize}).
-
-@end table
-
-The rest of these commands modify the local score file.
-
-@table @kbd
-
-@item V m
-@kindex V m (Summary)
-@findex gnus-score-set-mark-below
-Prompt for a score, and mark all articles with a score below this as
-read (@code{gnus-score-set-mark-below}).
-
-@item V x
-@kindex V x (Summary)
-@findex gnus-score-set-expunge-below
-Prompt for a score, and add a score rule to the current score file to
-expunge all articles below this score
-(@code{gnus-score-set-expunge-below}).
-@end table
-
-The keystrokes for actually making score entries follow a very regular
-pattern, so there's no need to list all the commands. (Hundreds of
-them.)
-
-@findex gnus-summary-increase-score
-@findex gnus-summary-lower-score
-
-@enumerate
-@item
-The first key is either @kbd{I} (upper case i) for increasing the score
-or @kbd{L} for lowering the score.
-@item
-The second key says what header you want to score on. The following
-keys are available:
-@table @kbd
-
-@item a
-Score on the author name.
-
-@item s
-Score on the subject line.
-
-@item x
-Score on the @code{Xref} line---i.e., the cross-posting line.
-
-@item r
-Score on the @code{References} line.
-
-@item d
-Score on the date.
-
-@item l
-Score on the number of lines.
-
-@item i
-Score on the @code{Message-ID} header.
-
-@item e
-Score on an ``extra'' header, that is, one of those in gnus-extra-headers,
-if your @acronym{NNTP} server tracks additional header data in overviews.
-
-@item f
-Score on followups---this matches the author name, and adds scores to
-the followups to this author. (Using this key leads to the creation of
-@file{ADAPT} files.)
-
-@item b
-Score on the body.
-
-@item h
-Score on the head.
-
-@item t
-Score on thread. (Using this key leads to the creation of @file{ADAPT}
-files.)
-
-@end table
-
-@item
-The third key is the match type. Which match types are valid depends on
-what headers you are scoring on.
-
-@table @code
-
-@item strings
-
-@table @kbd
-
-@item e
-Exact matching.
-
-@item s
-Substring matching.
-
-@item f
-Fuzzy matching (@pxref{Fuzzy Matching}).
-
-@item r
-Regexp matching
-@end table
-
-@item date
-@table @kbd
-
-@item b
-Before date.
-
-@item a
-After date.
-
-@item n
-This date.
-@end table
-
-@item number
-@table @kbd
-
-@item <
-Less than number.
-
-@item =
-Equal to number.
-
-@item >
-Greater than number.
-@end table
-@end table
-
-@item
-The fourth and usually final key says whether this is a temporary (i.e.,
-expiring) score entry, or a permanent (i.e., non-expiring) score entry,
-or whether it is to be done immediately, without adding to the score
-file.
-@table @kbd
-
-@item t
-Temporary score entry.
-
-@item p
-Permanent score entry.
-
-@item i
-Immediately scoring.
-@end table
-
-@item
-If you are scoring on `e' (extra) headers, you will then be prompted for
-the header name on which you wish to score. This must be a header named
-in gnus-extra-headers, and @samp{TAB} completion is available.
-
-@end enumerate
-
-So, let's say you want to increase the score on the current author with
-exact matching permanently: @kbd{I a e p}. If you want to lower the
-score based on the subject line, using substring matching, and make a
-temporary score entry: @kbd{L s s t}. Pretty easy.
-
-To make things a bit more complicated, there are shortcuts. If you use
-a capital letter on either the second or third keys, Gnus will use
-defaults for the remaining one or two keystrokes. The defaults are
-``substring'' and ``temporary''. So @kbd{I A} is the same as @kbd{I a s
-t}, and @kbd{I a R} is the same as @kbd{I a r t}.
-
-These functions take both the numerical prefix and the symbolic prefix
-(@pxref{Symbolic Prefixes}). A numerical prefix says how much to lower
-(or increase) the score of the article. A symbolic prefix of @code{a}
-says to use the @file{all.SCORE} file for the command instead of the
-current score file.
-
-@vindex gnus-score-mimic-keymap
-The @code{gnus-score-mimic-keymap} says whether these commands will
-pretend they are keymaps or not.
-
-
-@node Group Score Commands
-@section Group Score Commands
-@cindex group score commands
-
-There aren't many of these as yet, I'm afraid.
-
-@table @kbd
-
-@item W f
-@kindex W f (Group)
-@findex gnus-score-flush-cache
-Gnus maintains a cache of score alists to avoid having to reload them
-all the time. This command will flush the cache
-(@code{gnus-score-flush-cache}).
-
-@end table
-
-You can do scoring from the command line by saying something like:
-
-@findex gnus-batch-score
-@cindex batch scoring
-@example
-$ emacs -batch -l ~/.emacs -l ~/.gnus.el -f gnus-batch-score
-@end example
-
-
-@node Score Variables
-@section Score Variables
-@cindex score variables
-
-@table @code
-
-@item gnus-use-scoring
-@vindex gnus-use-scoring
-If @code{nil}, Gnus will not check for score files, and will not, in
-general, do any score-related work. This is @code{t} by default.
-
-@item gnus-kill-killed
-@vindex gnus-kill-killed
-If this variable is @code{nil}, Gnus will never apply score files to
-articles that have already been through the kill process. While this
-may save you lots of time, it also means that if you apply a kill file
-to a group, and then change the kill file and want to run it over you
-group again to kill more articles, it won't work. You have to set this
-variable to @code{t} to do that. (It is @code{t} by default.)
-
-@item gnus-kill-files-directory
-@vindex gnus-kill-files-directory
-All kill and score files will be stored in this directory, which is
-initialized from the @env{SAVEDIR} environment variable by default.
-This is @file{~/News/} by default.
-
-@item gnus-score-file-suffix
-@vindex gnus-score-file-suffix
-Suffix to add to the group name to arrive at the score file name
-(@file{SCORE} by default.)
-
-@item gnus-score-uncacheable-files
-@vindex gnus-score-uncacheable-files
-@cindex score cache
-All score files are normally cached to avoid excessive re-loading of
-score files. However, this might make your Emacs grow big and
-bloated, so this regexp can be used to weed out score files unlikely
-to be needed again. It would be a bad idea to deny caching of
-@file{all.SCORE}, while it might be a good idea to not cache
-@file{comp.infosystems.www.authoring.misc.ADAPT}. In fact, this
-variable is @samp{ADAPT$} by default, so no adaptive score files will
-be cached.
-
-@item gnus-save-score
-@vindex gnus-save-score
-If you have really complicated score files, and do lots of batch
-scoring, then you might set this variable to @code{t}. This will make
-Gnus save the scores into the @file{.newsrc.eld} file.
-
-If you do not set this to @code{t}, then manual scores (like those set
-with @kbd{V s} (@code{gnus-summary-set-score})) will not be preserved
-across group visits.
-
-@item gnus-score-interactive-default-score
-@vindex gnus-score-interactive-default-score
-Score used by all the interactive raise/lower commands to raise/lower
-score with. Default is 1000, which may seem excessive, but this is to
-ensure that the adaptive scoring scheme gets enough room to play with.
-We don't want the small changes from the adaptive scoring to overwrite
-manually entered data.
-
-@item gnus-summary-default-score
-@vindex gnus-summary-default-score
-Default score of an article, which is 0 by default.
-
-@item gnus-summary-expunge-below
-@vindex gnus-summary-expunge-below
-Don't display the summary lines of articles that have scores lower than
-this variable. This is @code{nil} by default, which means that no
-articles will be hidden. This variable is local to the summary buffers,
-and has to be set from @code{gnus-summary-mode-hook}.
-
-@item gnus-score-over-mark
-@vindex gnus-score-over-mark
-Mark (in the third column) used for articles with a score over the
-default. Default is @samp{+}.
-
-@item gnus-score-below-mark
-@vindex gnus-score-below-mark
-Mark (in the third column) used for articles with a score below the
-default. Default is @samp{-}.
-
-@item gnus-score-find-score-files-function
-@vindex gnus-score-find-score-files-function
-Function used to find score files for the current group. This function
-is called with the name of the group as the argument.
-
-Predefined functions available are:
-@table @code
-
-@item gnus-score-find-single
-@findex gnus-score-find-single
-Only apply the group's own score file.
-
-@item gnus-score-find-bnews
-@findex gnus-score-find-bnews
-Apply all score files that match, using bnews syntax. This is the
-default. If the current group is @samp{gnu.emacs.gnus}, for instance,
-@file{all.emacs.all.SCORE}, @file{not.alt.all.SCORE} and
-@file{gnu.all.SCORE} would all apply. In short, the instances of
-@samp{all} in the score file names are translated into @samp{.*}, and
-then a regexp match is done.
-
-This means that if you have some score entries that you want to apply to
-all groups, then you put those entries in the @file{all.SCORE} file.
-
-The score files are applied in a semi-random order, although Gnus will
-try to apply the more general score files before the more specific score
-files. It does this by looking at the number of elements in the score
-file names---discarding the @samp{all} elements.
-
-@item gnus-score-find-hierarchical
-@findex gnus-score-find-hierarchical
-Apply all score files from all the parent groups. This means that you
-can't have score files like @file{all.SCORE}, but you can have
-@file{SCORE}, @file{comp.SCORE} and @file{comp.emacs.SCORE} for each
-server.
-
-@end table
-This variable can also be a list of functions. In that case, all
-these functions will be called with the group name as argument, and
-all the returned lists of score files will be applied. These
-functions can also return lists of lists of score alists directly. In
-that case, the functions that return these non-file score alists
-should probably be placed before the ``real'' score file functions, to
-ensure that the last score file returned is the local score file.
-Phu.
-
-For example, to do hierarchical scoring but use a non-server-specific
-overall score file, you could use the value
-@example
-(list (lambda (group) ("all.SCORE"))
- 'gnus-score-find-hierarchical)
-@end example
-
-@item gnus-score-expiry-days
-@vindex gnus-score-expiry-days
-This variable says how many days should pass before an unused score file
-entry is expired. If this variable is @code{nil}, no score file entries
-are expired. It's 7 by default.
-
-@item gnus-update-score-entry-dates
-@vindex gnus-update-score-entry-dates
-If this variable is non-@code{nil}, temporary score entries that have
-been triggered (matched) will have their dates updated. (This is how Gnus
-controls expiry---all non-matched-entries will become too old while
-matched entries will stay fresh and young.) However, if you set this
-variable to @code{nil}, even matched entries will grow old and will
-have to face that oh-so grim reaper.
-
-@item gnus-score-after-write-file-function
-@vindex gnus-score-after-write-file-function
-Function called with the name of the score file just written.
-
-@item gnus-score-thread-simplify
-@vindex gnus-score-thread-simplify
-If this variable is non-@code{nil}, article subjects will be
-simplified for subject scoring purposes in the same manner as with
-threading---according to the current value of
-@code{gnus-simplify-subject-functions}. If the scoring entry uses
-@code{substring} or @code{exact} matching, the match will also be
-simplified in this manner.
-
-@end table
-
-
-@node Score File Format
-@section Score File Format
-@cindex score file format
-
-A score file is an @code{emacs-lisp} file that normally contains just a
-single form. Casual users are not expected to edit these files;
-everything can be changed from the summary buffer.
-
-Anyway, if you'd like to dig into it yourself, here's an example:
-
-@lisp
-(("from"
- ("Lars Ingebrigtsen" -10000)
- ("Per Abrahamsen")
- ("larsi\\|lmi" -50000 nil R))
- ("subject"
- ("Ding is Badd" nil 728373))
- ("xref"
- ("alt.politics" -1000 728372 s))
- ("lines"
- (2 -100 nil <))
- (mark 0)
- (expunge -1000)
- (mark-and-expunge -10)
- (read-only nil)
- (orphan -10)
- (adapt t)
- (files "/hom/larsi/News/gnu.SCORE")
- (exclude-files "all.SCORE")
- (local (gnus-newsgroup-auto-expire t)
- (gnus-summary-make-false-root empty))
- (eval (ding)))
-@end lisp
-
-This example demonstrates most score file elements. @xref{Advanced
-Scoring}, for a different approach.
-
-Even though this looks much like Lisp code, nothing here is actually
-@code{eval}ed. The Lisp reader is used to read this form, though, so it
-has to be valid syntactically, if not semantically.
-
-Six keys are supported by this alist:
-
-@table @code
-
-@item STRING
-If the key is a string, it is the name of the header to perform the
-match on. Scoring can only be performed on these eight headers:
-@code{From}, @code{Subject}, @code{References}, @code{Message-ID},
-@code{Xref}, @code{Lines}, @code{Chars} and @code{Date}. In addition to
-these headers, there are three strings to tell Gnus to fetch the entire
-article and do the match on larger parts of the article: @code{Body}
-will perform the match on the body of the article, @code{Head} will
-perform the match on the head of the article, and @code{All} will
-perform the match on the entire article. Note that using any of these
-last three keys will slow down group entry @emph{considerably}. The
-final ``header'' you can score on is @code{Followup}. These score
-entries will result in new score entries being added for all follow-ups
-to articles that matches these score entries.
-
-Following this key is an arbitrary number of score entries, where each
-score entry has one to four elements.
-@enumerate
-
-@item
-The first element is the @dfn{match element}. On most headers this will
-be a string, but on the Lines and Chars headers, this must be an
-integer.
-
-@item
-If the second element is present, it should be a number---the @dfn{score
-element}. This number should be an integer in the neginf to posinf
-interval. This number is added to the score of the article if the match
-is successful. If this element is not present, the
-@code{gnus-score-interactive-default-score} number will be used
-instead. This is 1000 by default.
-
-@item
-If the third element is present, it should be a number---the @dfn{date
-element}. This date says when the last time this score entry matched,
-which provides a mechanism for expiring the score entries. It this
-element is not present, the score entry is permanent. The date is
-represented by the number of days since December 31, 1 BCE.
-
-@item
-If the fourth element is present, it should be a symbol---the @dfn{type
-element}. This element specifies what function should be used to see
-whether this score entry matches the article. What match types that can
-be used depends on what header you wish to perform the match on.
-@table @dfn
-
-@item From, Subject, References, Xref, Message-ID
-For most header types, there are the @code{r} and @code{R} (regexp), as
-well as @code{s} and @code{S} (substring) types, and @code{e} and
-@code{E} (exact match), and @code{w} (word match) types. If this
-element is not present, Gnus will assume that substring matching should
-be used. @code{R}, @code{S}, and @code{E} differ from the others in
-that the matches will be done in a case-sensitive manner. All these
-one-letter types are really just abbreviations for the @code{regexp},
-@code{string}, @code{exact}, and @code{word} types, which you can use
-instead, if you feel like.
-
-@item Extra
-Just as for the standard string overview headers, if you are using
-gnus-extra-headers, you can score on these headers' values. In this
-case, there is a 5th element in the score entry, being the name of the
-header to be scored. The following entry is useful in your
-@file{all.SCORE} file in case of spam attacks from a single origin
-host, if your @acronym{NNTP} server tracks @samp{NNTP-Posting-Host} in
-overviews:
-
-@lisp
-("111.222.333.444" -1000 nil s
- "NNTP-Posting-Host")
-@end lisp
-
-@item Lines, Chars
-These two headers use different match types: @code{<}, @code{>},
-@code{=}, @code{>=} and @code{<=}.
-
-These predicates are true if
-
-@example
-(PREDICATE HEADER MATCH)
-@end example
-
-evaluates to non-@code{nil}. For instance, the advanced match
-@code{("lines" 4 <)} (@pxref{Advanced Scoring}) will result in the
-following form:
-
-@lisp
-(< header-value 4)
-@end lisp
-
-Or to put it another way: When using @code{<} on @code{Lines} with 4 as
-the match, we get the score added if the article has less than 4 lines.
-(It's easy to get confused and think it's the other way around. But
-it's not. I think.)
-
-When matching on @code{Lines}, be careful because some back ends (like
-@code{nndir}) do not generate @code{Lines} header, so every article ends
-up being marked as having 0 lines. This can lead to strange results if
-you happen to lower score of the articles with few lines.
-
-@item Date
-For the Date header we have three kinda silly match types:
-@code{before}, @code{at} and @code{after}. I can't really imagine this
-ever being useful, but, like, it would feel kinda silly not to provide
-this function. Just in case. You never know. Better safe than sorry.
-Once burnt, twice shy. Don't judge a book by its cover. Never not have
-sex on a first date. (I have been told that at least one person, and I
-quote, ``found this function indispensable'', however.)
-
-@cindex ISO8601
-@cindex date
-A more useful match type is @code{regexp}. With it, you can match the
-date string using a regular expression. The date is normalized to
-ISO8601 compact format first---@var{YYYYMMDD}@code{T}@var{HHMMSS}. If
-you want to match all articles that have been posted on April 1st in
-every year, you could use @samp{....0401.........} as a match string,
-for instance. (Note that the date is kept in its original time zone, so
-this will match articles that were posted when it was April 1st where
-the article was posted from. Time zones are such wholesome fun for the
-whole family, eh?)
-
-@item Head, Body, All
-These three match keys use the same match types as the @code{From} (etc)
-header uses.
-
-@item Followup
-This match key is somewhat special, in that it will match the
-@code{From} header, and affect the score of not only the matching
-articles, but also all followups to the matching articles. This allows
-you e.g. increase the score of followups to your own articles, or
-decrease the score of followups to the articles of some known
-trouble-maker. Uses the same match types as the @code{From} header
-uses. (Using this match key will lead to creation of @file{ADAPT}
-files.)
-
-@item Thread
-This match key works along the same lines as the @code{Followup} match
-key. If you say that you want to score on a (sub-)thread started by an
-article with a @code{Message-ID} @var{x}, then you add a @samp{thread}
-match. This will add a new @samp{thread} match for each article that
-has @var{x} in its @code{References} header. (These new @samp{thread}
-matches will use the @code{Message-ID}s of these matching articles.)
-This will ensure that you can raise/lower the score of an entire thread,
-even though some articles in the thread may not have complete
-@code{References} headers. Note that using this may lead to
-undeterministic scores of the articles in the thread. (Using this match
-key will lead to creation of @file{ADAPT} files.)
-@end table
-@end enumerate
-
-@cindex score file atoms
-@item mark
-The value of this entry should be a number. Any articles with a score
-lower than this number will be marked as read.
-
-@item expunge
-The value of this entry should be a number. Any articles with a score
-lower than this number will be removed from the summary buffer.
-
-@item mark-and-expunge
-The value of this entry should be a number. Any articles with a score
-lower than this number will be marked as read and removed from the
-summary buffer.
-
-@item thread-mark-and-expunge
-The value of this entry should be a number. All articles that belong to
-a thread that has a total score below this number will be marked as read
-and removed from the summary buffer. @code{gnus-thread-score-function}
-says how to compute the total score for a thread.
-
-@item files
-The value of this entry should be any number of file names. These files
-are assumed to be score files as well, and will be loaded the same way
-this one was.
-
-@item exclude-files
-The clue of this entry should be any number of files. These files will
-not be loaded, even though they would normally be so, for some reason or
-other.
-
-@item eval
-The value of this entry will be @code{eval}el. This element will be
-ignored when handling global score files.
-
-@item read-only
-Read-only score files will not be updated or saved. Global score files
-should feature this atom (@pxref{Global Score Files}). (Note:
-@dfn{Global} here really means @dfn{global}; not your personal
-apply-to-all-groups score files.)
-
-@item orphan
-The value of this entry should be a number. Articles that do not have
-parents will get this number added to their scores. Imagine you follow
-some high-volume newsgroup, like @samp{comp.lang.c}. Most likely you
-will only follow a few of the threads, also want to see any new threads.
-
-You can do this with the following two score file entries:
-
-@example
- (orphan -500)
- (mark-and-expunge -100)
-@end example
-
-When you enter the group the first time, you will only see the new
-threads. You then raise the score of the threads that you find
-interesting (with @kbd{I T} or @kbd{I S}), and ignore (@kbd{C y}) the
-rest. Next time you enter the group, you will see new articles in the
-interesting threads, plus any new threads.
-
-I.e.---the orphan score atom is for high-volume groups where a few
-interesting threads which can't be found automatically by ordinary
-scoring rules exist.
-
-@item adapt
-This entry controls the adaptive scoring. If it is @code{t}, the
-default adaptive scoring rules will be used. If it is @code{ignore}, no
-adaptive scoring will be performed on this group. If it is a list, this
-list will be used as the adaptive scoring rules. If it isn't present,
-or is something other than @code{t} or @code{ignore}, the default
-adaptive scoring rules will be used. If you want to use adaptive
-scoring on most groups, you'd set @code{gnus-use-adaptive-scoring} to
-@code{t}, and insert an @code{(adapt ignore)} in the groups where you do
-not want adaptive scoring. If you only want adaptive scoring in a few
-groups, you'd set @code{gnus-use-adaptive-scoring} to @code{nil}, and
-insert @code{(adapt t)} in the score files of the groups where you want
-it.
-
-@item adapt-file
-All adaptive score entries will go to the file named by this entry. It
-will also be applied when entering the group. This atom might be handy
-if you want to adapt on several groups at once, using the same adaptive
-file for a number of groups.
-
-@item local
-@cindex local variables
-The value of this entry should be a list of @code{(@var{var}
-@var{value})} pairs. Each @var{var} will be made buffer-local to the
-current summary buffer, and set to the value specified. This is a
-convenient, if somewhat strange, way of setting variables in some
-groups if you don't like hooks much. Note that the @var{value} won't
-be evaluated.
-@end table
-
-
-@node Score File Editing
-@section Score File Editing
-
-You normally enter all scoring commands from the summary buffer, but you
-might feel the urge to edit them by hand as well, so we've supplied you
-with a mode for that.
-
-It's simply a slightly customized @code{emacs-lisp} mode, with these
-additional commands:
-
-@table @kbd
-
-@item C-c C-c
-@kindex C-c C-c (Score)
-@findex gnus-score-edit-exit
-Save the changes you have made and return to the summary buffer
-(@code{gnus-score-edit-exit}).
-
-@item C-c C-d
-@kindex C-c C-d (Score)
-@findex gnus-score-edit-insert-date
-Insert the current date in numerical format
-(@code{gnus-score-edit-insert-date}). This is really the day number, if
-you were wondering.
-
-@item C-c C-p
-@kindex C-c C-p (Score)
-@findex gnus-score-pretty-print
-The adaptive score files are saved in an unformatted fashion. If you
-intend to read one of these files, you want to @dfn{pretty print} it
-first. This command (@code{gnus-score-pretty-print}) does that for
-you.
-
-@end table
-
-Type @kbd{M-x gnus-score-mode} to use this mode.
-
-@vindex gnus-score-mode-hook
-@code{gnus-score-menu-hook} is run in score mode buffers.
-
-In the summary buffer you can use commands like @kbd{V f}, @kbd{V e} and
-@kbd{V t} to begin editing score files.
-
-
-@node Adaptive Scoring
-@section Adaptive Scoring
-@cindex adaptive scoring
-
-If all this scoring is getting you down, Gnus has a way of making it all
-happen automatically---as if by magic. Or rather, as if by artificial
-stupidity, to be precise.
-
-@vindex gnus-use-adaptive-scoring
-When you read an article, or mark an article as read, or kill an
-article, you leave marks behind. On exit from the group, Gnus can sniff
-these marks and add score elements depending on what marks it finds.
-You turn on this ability by setting @code{gnus-use-adaptive-scoring} to
-@code{t} or @code{(line)}. If you want score adaptively on separate
-words appearing in the subjects, you should set this variable to
-@code{(word)}. If you want to use both adaptive methods, set this
-variable to @code{(word line)}.
-
-@vindex gnus-default-adaptive-score-alist
-To give you complete control over the scoring process, you can customize
-the @code{gnus-default-adaptive-score-alist} variable. For instance, it
-might look something like this:
-
-@lisp
-(setq gnus-default-adaptive-score-alist
- '((gnus-unread-mark)
- (gnus-ticked-mark (from 4))
- (gnus-dormant-mark (from 5))
- (gnus-del-mark (from -4) (subject -1))
- (gnus-read-mark (from 4) (subject 2))
- (gnus-expirable-mark (from -1) (subject -1))
- (gnus-killed-mark (from -1) (subject -3))
- (gnus-kill-file-mark)
- (gnus-ancient-mark)
- (gnus-low-score-mark)
- (gnus-catchup-mark (from -1) (subject -1))))
-@end lisp
-
-As you see, each element in this alist has a mark as a key (either a
-variable name or a ``real'' mark---a character). Following this key is
-a arbitrary number of header/score pairs. If there are no header/score
-pairs following the key, no adaptive scoring will be done on articles
-that have that key as the article mark. For instance, articles with
-@code{gnus-unread-mark} in the example above will not get adaptive score
-entries.
-
-Each article can have only one mark, so just a single of these rules
-will be applied to each article.
-
-To take @code{gnus-del-mark} as an example---this alist says that all
-articles that have that mark (i.e., are marked with @samp{e}) will have a
-score entry added to lower based on the @code{From} header by -4, and
-lowered by @code{Subject} by -1. Change this to fit your prejudices.
-
-If you have marked 10 articles with the same subject with
-@code{gnus-del-mark}, the rule for that mark will be applied ten times.
-That means that that subject will get a score of ten times -1, which
-should be, unless I'm much mistaken, -10.
-
-If you have auto-expirable (mail) groups (@pxref{Expiring Mail}), all
-the read articles will be marked with the @samp{E} mark. This'll
-probably make adaptive scoring slightly impossible, so auto-expiring and
-adaptive scoring doesn't really mix very well.
-
-The headers you can score on are @code{from}, @code{subject},
-@code{message-id}, @code{references}, @code{xref}, @code{lines},
-@code{chars} and @code{date}. In addition, you can score on
-@code{followup}, which will create an adaptive score entry that matches
-on the @code{References} header using the @code{Message-ID} of the
-current article, thereby matching the following thread.
-
-If you use this scheme, you should set the score file atom @code{mark}
-to something small---like -300, perhaps, to avoid having small random
-changes result in articles getting marked as read.
-
-After using adaptive scoring for a week or so, Gnus should start to
-become properly trained and enhance the authors you like best, and kill
-the authors you like least, without you having to say so explicitly.
-
-You can control what groups the adaptive scoring is to be performed on
-by using the score files (@pxref{Score File Format}). This will also
-let you use different rules in different groups.
-
-@vindex gnus-adaptive-file-suffix
-The adaptive score entries will be put into a file where the name is the
-group name with @code{gnus-adaptive-file-suffix} appended. The default
-is @file{ADAPT}.
-
-@vindex gnus-score-exact-adapt-limit
-When doing adaptive scoring, substring or fuzzy matching would probably
-give you the best results in most cases. However, if the header one
-matches is short, the possibility for false positives is great, so if
-the length of the match is less than
-@code{gnus-score-exact-adapt-limit}, exact matching will be used. If
-this variable is @code{nil}, exact matching will always be used to avoid
-this problem.
-
-@vindex gnus-default-adaptive-word-score-alist
-As mentioned above, you can adapt either on individual words or entire
-headers. If you adapt on words, the
-@code{gnus-default-adaptive-word-score-alist} variable says what score
-each instance of a word should add given a mark.
-
-@lisp
-(setq gnus-default-adaptive-word-score-alist
- `((,gnus-read-mark . 30)
- (,gnus-catchup-mark . -10)
- (,gnus-killed-mark . -20)
- (,gnus-del-mark . -15)))
-@end lisp
-
-This is the default value. If you have adaption on words enabled, every
-word that appears in subjects of articles marked with
-@code{gnus-read-mark} will result in a score rule that increase the
-score with 30 points.
-
-@vindex gnus-default-ignored-adaptive-words
-@vindex gnus-ignored-adaptive-words
-Words that appear in the @code{gnus-default-ignored-adaptive-words} list
-will be ignored. If you wish to add more words to be ignored, use the
-@code{gnus-ignored-adaptive-words} list instead.
-
-@vindex gnus-adaptive-word-length-limit
-Some may feel that short words shouldn't count when doing adaptive
-scoring. If so, you may set @code{gnus-adaptive-word-length-limit} to
-an integer. Words shorter than this number will be ignored. This
-variable defaults to @code{nil}.
-
-@vindex gnus-adaptive-word-syntax-table
-When the scoring is done, @code{gnus-adaptive-word-syntax-table} is the
-syntax table in effect. It is similar to the standard syntax table, but
-it considers numbers to be non-word-constituent characters.
-
-@vindex gnus-adaptive-word-minimum
-If @code{gnus-adaptive-word-minimum} is set to a number, the adaptive
-word scoring process will never bring down the score of an article to
-below this number. The default is @code{nil}.
-
-@vindex gnus-adaptive-word-no-group-words
-If @code{gnus-adaptive-word-no-group-words} is set to @code{t}, gnus
-won't adaptively word score any of the words in the group name. Useful
-for groups like @samp{comp.editors.emacs}, where most of the subject
-lines contain the word @samp{emacs}.
-
-After using this scheme for a while, it might be nice to write a
-@code{gnus-psychoanalyze-user} command to go through the rules and see
-what words you like and what words you don't like. Or perhaps not.
-
-Note that the adaptive word scoring thing is highly experimental and is
-likely to change in the future. Initial impressions seem to indicate
-that it's totally useless as it stands. Some more work (involving more
-rigorous statistical methods) will have to be done to make this useful.
-
-
-@node Home Score File
-@section Home Score File
-
-The score file where new score file entries will go is called the
-@dfn{home score file}. This is normally (and by default) the score file
-for the group itself. For instance, the home score file for
-@samp{gnu.emacs.gnus} is @file{gnu.emacs.gnus.SCORE}.
-
-However, this may not be what you want. It is often convenient to share
-a common home score file among many groups---all @samp{emacs} groups
-could perhaps use the same home score file.
-
-@vindex gnus-home-score-file
-The variable that controls this is @code{gnus-home-score-file}. It can
-be:
-
-@enumerate
-@item
-A string. Then this file will be used as the home score file for all
-groups.
-
-@item
-A function. The result of this function will be used as the home score
-file. The function will be called with the name of the group as the
-parameter.
-
-@item
-A list. The elements in this list can be:
-
-@enumerate
-@item
-@code{(@var{regexp} @var{file-name})}. If the @var{regexp} matches the
-group name, the @var{file-name} will be used as the home score file.
-
-@item
-A function. If the function returns non-@code{nil}, the result will
-be used as the home score file. The function will be called with the
-name of the group as the parameter.
-
-@item
-A string. Use the string as the home score file.
-@end enumerate
-
-The list will be traversed from the beginning towards the end looking
-for matches.
-
-@end enumerate
-
-So, if you want to use just a single score file, you could say:
-
-@lisp
-(setq gnus-home-score-file
- "my-total-score-file.SCORE")
-@end lisp
-
-If you want to use @file{gnu.SCORE} for all @samp{gnu} groups and
-@file{rec.SCORE} for all @samp{rec} groups (and so on), you can say:
-
-@findex gnus-hierarchial-home-score-file
-@lisp
-(setq gnus-home-score-file
- 'gnus-hierarchial-home-score-file)
-@end lisp
-
-This is a ready-made function provided for your convenience.
-Other functions include
-
-@table @code
-@item gnus-current-home-score-file
-@findex gnus-current-home-score-file
-Return the ``current'' regular score file. This will make scoring
-commands add entry to the ``innermost'' matching score file.
-
-@end table
-
-If you want to have one score file for the @samp{emacs} groups and
-another for the @samp{comp} groups, while letting all other groups use
-their own home score files:
-
-@lisp
-(setq gnus-home-score-file
- ;; @r{All groups that match the regexp @code{"\\.emacs"}}
- '(("\\.emacs" "emacs.SCORE")
- ;; @r{All the comp groups in one score file}
- ("^comp" "comp.SCORE")))
-@end lisp
-
-@vindex gnus-home-adapt-file
-@code{gnus-home-adapt-file} works exactly the same way as
-@code{gnus-home-score-file}, but says what the home adaptive score file
-is instead. All new adaptive file entries will go into the file
-specified by this variable, and the same syntax is allowed.
-
-In addition to using @code{gnus-home-score-file} and
-@code{gnus-home-adapt-file}, you can also use group parameters
-(@pxref{Group Parameters}) and topic parameters (@pxref{Topic
-Parameters}) to achieve much the same. Group and topic parameters take
-precedence over this variable.
-
-
-@node Followups To Yourself
-@section Followups To Yourself
-
-Gnus offers two commands for picking out the @code{Message-ID} header in
-the current buffer. Gnus will then add a score rule that scores using
-this @code{Message-ID} on the @code{References} header of other
-articles. This will, in effect, increase the score of all articles that
-respond to the article in the current buffer. Quite useful if you want
-to easily note when people answer what you've said.
-
-@table @code
-
-@item gnus-score-followup-article
-@findex gnus-score-followup-article
-This will add a score to articles that directly follow up your own
-article.
-
-@item gnus-score-followup-thread
-@findex gnus-score-followup-thread
-This will add a score to all articles that appear in a thread ``below''
-your own article.
-@end table
-
-@vindex message-sent-hook
-These two functions are both primarily meant to be used in hooks like
-@code{message-sent-hook}, like this:
-@lisp
-(add-hook 'message-sent-hook 'gnus-score-followup-thread)
-@end lisp
-
-
-If you look closely at your own @code{Message-ID}, you'll notice that
-the first two or three characters are always the same. Here's two of
-mine:
-
-@example
-<x6u3u47icf.fsf@@eyesore.no>
-<x6sp9o7ibw.fsf@@eyesore.no>
-@end example
-
-So ``my'' ident on this machine is @samp{x6}. This can be
-exploited---the following rule will raise the score on all followups to
-myself:
-
-@lisp
-("references"
- ("<x6[0-9a-z]+\\.fsf\\(_-_\\)?@@.*eyesore\\.no>"
- 1000 nil r))
-@end lisp
-
-Whether it's the first two or first three characters that are ``yours''
-is system-dependent.
-
-
-@node Scoring On Other Headers
-@section Scoring On Other Headers
-@cindex scoring on other headers
-
-Gnus is quite fast when scoring the ``traditional''
-headers---@samp{From}, @samp{Subject} and so on. However, scoring
-other headers requires writing a @code{head} scoring rule, which means
-that Gnus has to request every single article from the back end to find
-matches. This takes a long time in big groups.
-
-Now, there's not much you can do about this for news groups, but for
-mail groups, you have greater control. In @ref{To From Newsgroups},
-it's explained in greater detail what this mechanism does, but here's
-a cookbook example for @code{nnml} on how to allow scoring on the
-@samp{To} and @samp{Cc} headers.
-
-Put the following in your @file{~/.gnus.el} file.
-
-@lisp
-(setq gnus-extra-headers '(To Cc Newsgroups Keywords)
- nnmail-extra-headers gnus-extra-headers)
-@end lisp
-
-Restart Gnus and rebuild your @code{nnml} overview files with the
-@kbd{M-x nnml-generate-nov-databases} command. This will take a long
-time if you have much mail.
-
-Now you can score on @samp{To} and @samp{Cc} as ``extra headers'' like
-so: @kbd{I e s p To RET <your name> RET}.
-
-See? Simple.
-
-
-@node Scoring Tips
-@section Scoring Tips
-@cindex scoring tips
-
-@table @dfn
-
-@item Crossposts
-@cindex crossposts
-@cindex scoring crossposts
-If you want to lower the score of crossposts, the line to match on is
-the @code{Xref} header.
-@lisp
-("xref" (" talk.politics.misc:" -1000))
-@end lisp
-
-@item Multiple crossposts
-If you want to lower the score of articles that have been crossposted to
-more than, say, 3 groups:
-@lisp
-("xref"
- ("[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+ +[^:\n]+:[0-9]+"
- -1000 nil r))
-@end lisp
-
-@item Matching on the body
-This is generally not a very good idea---it takes a very long time.
-Gnus actually has to fetch each individual article from the server. But
-you might want to anyway, I guess. Even though there are three match
-keys (@code{Head}, @code{Body} and @code{All}), you should choose one
-and stick with it in each score file. If you use any two, each article
-will be fetched @emph{twice}. If you want to match a bit on the
-@code{Head} and a bit on the @code{Body}, just use @code{All} for all
-the matches.
-
-@item Marking as read
-You will probably want to mark articles that have scores below a certain
-number as read. This is most easily achieved by putting the following
-in your @file{all.SCORE} file:
-@lisp
-((mark -100))
-@end lisp
-You may also consider doing something similar with @code{expunge}.
-
-@item Negated character classes
-If you say stuff like @code{[^abcd]*}, you may get unexpected results.
-That will match newlines, which might lead to, well, The Unknown. Say
-@code{[^abcd\n]*} instead.
-@end table
-
-
-@node Reverse Scoring
-@section Reverse Scoring
-@cindex reverse scoring
-
-If you want to keep just articles that have @samp{Sex with Emacs} in the
-subject header, and expunge all other articles, you could put something
-like this in your score file:
-
-@lisp
-(("subject"
- ("Sex with Emacs" 2))
- (mark 1)
- (expunge 1))
-@end lisp
-
-So, you raise all articles that match @samp{Sex with Emacs} and mark the
-rest as read, and expunge them to boot.
-
-
-@node Global Score Files
-@section Global Score Files
-@cindex global score files
-
-Sure, other newsreaders have ``global kill files''. These are usually
-nothing more than a single kill file that applies to all groups, stored
-in the user's home directory. Bah! Puny, weak newsreaders!
-
-What I'm talking about here are Global Score Files. Score files from
-all over the world, from users everywhere, uniting all nations in one
-big, happy score file union! Ange-score! New and untested!
-
-@vindex gnus-global-score-files
-All you have to do to use other people's score files is to set the
-@code{gnus-global-score-files} variable. One entry for each score file,
-or each score file directory. Gnus will decide by itself what score
-files are applicable to which group.
-
-To use the score file
-@file{/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE} and
-all score files in the @file{/ftp@@ftp.some-where:/pub/score} directory,
-say this:
-
-@lisp
-(setq gnus-global-score-files
- '("/ftp@@ftp.gnus.org:/pub/larsi/ding/score/soc.motss.SCORE"
- "/ftp@@ftp.some-where:/pub/score/"))
-@end lisp
-
-@findex gnus-score-search-global-directories
-@noindent
-Simple, eh? Directory names must end with a @samp{/}. These
-directories are typically scanned only once during each Gnus session.
-If you feel the need to manually re-scan the remote directories, you can
-use the @code{gnus-score-search-global-directories} command.
-
-Note that, at present, using this option will slow down group entry
-somewhat. (That is---a lot.)
-
-If you want to start maintaining score files for other people to use,
-just put your score file up for anonymous ftp and announce it to the
-world. Become a retro-moderator! Participate in the retro-moderator
-wars sure to ensue, where retro-moderators battle it out for the
-sympathy of the people, luring them to use their score files on false
-premises! Yay! The net is saved!
-
-Here are some tips for the would-be retro-moderator, off the top of my
-head:
-
-@itemize @bullet
-
-@item
-Articles heavily crossposted are probably junk.
-@item
-To lower a single inappropriate article, lower by @code{Message-ID}.
-@item
-Particularly brilliant authors can be raised on a permanent basis.
-@item
-Authors that repeatedly post off-charter for the group can safely be
-lowered out of existence.
-@item
-Set the @code{mark} and @code{expunge} atoms to obliterate the nastiest
-articles completely.
-
-@item
-Use expiring score entries to keep the size of the file down. You
-should probably have a long expiry period, though, as some sites keep
-old articles for a long time.
-@end itemize
-
-@dots{} I wonder whether other newsreaders will support global score files
-in the future. @emph{Snicker}. Yup, any day now, newsreaders like Blue
-Wave, xrn and 1stReader are bound to implement scoring. Should we start
-holding our breath yet?
-
-
-@node Kill Files
-@section Kill Files
-@cindex kill files
-
-Gnus still supports those pesky old kill files. In fact, the kill file
-entries can now be expiring, which is something I wrote before Daniel
-Quinlan thought of doing score files, so I've left the code in there.
-
-In short, kill processing is a lot slower (and I do mean @emph{a lot})
-than score processing, so it might be a good idea to rewrite your kill
-files into score files.
-
-Anyway, a kill file is a normal @code{emacs-lisp} file. You can put any
-forms into this file, which means that you can use kill files as some
-sort of primitive hook function to be run on group entry, even though
-that isn't a very good idea.
-
-Normal kill files look like this:
-
-@lisp
-(gnus-kill "From" "Lars Ingebrigtsen")
-(gnus-kill "Subject" "ding")
-(gnus-expunge "X")
-@end lisp
-
-This will mark every article written by me as read, and remove the
-marked articles from the summary buffer. Very useful, you'll agree.
-
-Other programs use a totally different kill file syntax. If Gnus
-encounters what looks like a @code{rn} kill file, it will take a stab at
-interpreting it.
-
-Two summary functions for editing a @sc{gnus} kill file:
-
-@table @kbd
-
-@item M-k
-@kindex M-k (Summary)
-@findex gnus-summary-edit-local-kill
-Edit this group's kill file (@code{gnus-summary-edit-local-kill}).
-
-@item M-K
-@kindex M-K (Summary)
-@findex gnus-summary-edit-global-kill
-Edit the general kill file (@code{gnus-summary-edit-global-kill}).
-@end table
-
-Two group mode functions for editing the kill files:
-
-@table @kbd
-
-@item M-k
-@kindex M-k (Group)
-@findex gnus-group-edit-local-kill
-Edit this group's kill file (@code{gnus-group-edit-local-kill}).
-
-@item M-K
-@kindex M-K (Group)
-@findex gnus-group-edit-global-kill
-Edit the general kill file (@code{gnus-group-edit-global-kill}).
-@end table
-
-Kill file variables:
-
-@table @code
-@item gnus-kill-file-name
-@vindex gnus-kill-file-name
-A kill file for the group @samp{soc.motss} is normally called
-@file{soc.motss.KILL}. The suffix appended to the group name to get
-this file name is detailed by the @code{gnus-kill-file-name} variable.
-The ``global'' kill file (not in the score file sense of ``global'', of
-course) is just called @file{KILL}.
-
-@vindex gnus-kill-save-kill-file
-@item gnus-kill-save-kill-file
-If this variable is non-@code{nil}, Gnus will save the
-kill file after processing, which is necessary if you use expiring
-kills.
-
-@item gnus-apply-kill-hook
-@vindex gnus-apply-kill-hook
-@findex gnus-apply-kill-file-unless-scored
-@findex gnus-apply-kill-file
-A hook called to apply kill files to a group. It is
-@code{(gnus-apply-kill-file)} by default. If you want to ignore the
-kill file if you have a score file for the same group, you can set this
-hook to @code{(gnus-apply-kill-file-unless-scored)}. If you don't want
-kill files to be processed, you should set this variable to @code{nil}.
-
-@item gnus-kill-file-mode-hook
-@vindex gnus-kill-file-mode-hook
-A hook called in kill-file mode buffers.
-
-@end table
-
-
-@node Converting Kill Files
-@section Converting Kill Files
-@cindex kill files
-@cindex converting kill files
-
-If you have loads of old kill files, you may want to convert them into
-score files. If they are ``regular'', you can use
-the @file{gnus-kill-to-score.el} package; if not, you'll have to do it
-by hand.
-
-The kill to score conversion package isn't included in Gnus by default.
-You can fetch it from
-@uref{http://www.stud.ifi.uio.no/~larsi/ding-various/gnus-kill-to-score.el}.
-
-If your old kill files are very complex---if they contain more
-non-@code{gnus-kill} forms than not, you'll have to convert them by
-hand. Or just let them be as they are. Gnus will still use them as
-before.
-
-
-@node GroupLens
-@section GroupLens
-@cindex GroupLens
-
-@sc{Note:} Unfortunately the GroupLens system seems to have shut down,
-so this section is mostly of historical interest.
-
-@uref{http://www.cs.umn.edu/Research/GroupLens/, GroupLens} is a
-collaborative filtering system that helps you work together with other
-people to find the quality news articles out of the huge volume of
-news articles generated every day.
-
-To accomplish this the GroupLens system combines your opinions about
-articles you have already read with the opinions of others who have done
-likewise and gives you a personalized prediction for each unread news
-article. Think of GroupLens as a matchmaker. GroupLens watches how you
-rate articles, and finds other people that rate articles the same way.
-Once it has found some people you agree with it tells you, in the form
-of a prediction, what they thought of the article. You can use this
-prediction to help you decide whether or not you want to read the
-article.
-
-@menu
-* Using GroupLens:: How to make Gnus use GroupLens.
-* Rating Articles:: Letting GroupLens know how you rate articles.
-* Displaying Predictions:: Displaying predictions given by GroupLens.
-* GroupLens Variables:: Customizing GroupLens.
-@end menu
-
-
-@node Using GroupLens
-@subsection Using GroupLens
-
-To use GroupLens you must register a pseudonym with your local
-@uref{http://www.cs.umn.edu/Research/GroupLens/bbb.html, Better Bit
-Bureau (BBB)} is the only better bit in town at the moment.
-
-Once you have registered you'll need to set a couple of variables.
-
-@table @code
-
-@item gnus-use-grouplens
-@vindex gnus-use-grouplens
-Setting this variable to a non-@code{nil} value will make Gnus hook into
-all the relevant GroupLens functions.
-
-@item grouplens-pseudonym
-@vindex grouplens-pseudonym
-This variable should be set to the pseudonym you got when registering
-with the Better Bit Bureau.
-
-@item grouplens-newsgroups
-@vindex grouplens-newsgroups
-A list of groups that you want to get GroupLens predictions for.
-
-@end table
-
-That's the minimum of what you need to get up and running with GroupLens.
-Once you've registered, GroupLens will start giving you scores for
-articles based on the average of what other people think. But, to get
-the real benefit of GroupLens you need to start rating articles
-yourself. Then the scores GroupLens gives you will be personalized for
-you, based on how the people you usually agree with have already rated.
-
-
-@node Rating Articles
-@subsection Rating Articles
-
-In GroupLens, an article is rated on a scale from 1 to 5, inclusive.
-Where 1 means something like this article is a waste of bandwidth and 5
-means that the article was really good. The basic question to ask
-yourself is, ``on a scale from 1 to 5 would I like to see more articles
-like this one?''
-
-There are four ways to enter a rating for an article in GroupLens.
-
-@table @kbd
-
-@item r
-@kindex r (GroupLens)
-@findex bbb-summary-rate-article
-This function will prompt you for a rating on a scale of one to five.
-
-@item k
-@kindex k (GroupLens)
-@findex grouplens-score-thread
-This function will prompt you for a rating, and rate all the articles in
-the thread. This is really useful for some of those long running giant
-threads in rec.humor.
-
-@end table
-
-The next two commands, @kbd{n} and @kbd{,} take a numerical prefix to be
-the score of the article you're reading.
-
-@table @kbd
-
-@item 1-5 n
-@kindex n (GroupLens)
-@findex grouplens-next-unread-article
-Rate the article and go to the next unread article.
-
-@item 1-5 ,
-@kindex , (GroupLens)
-@findex grouplens-best-unread-article
-Rate the article and go to the next unread article with the highest score.
-
-@end table
-
-If you want to give the current article a score of 4 and then go to the
-next article, just type @kbd{4 n}.
-
-
-@node Displaying Predictions
-@subsection Displaying Predictions
-
-GroupLens makes a prediction for you about how much you will like a
-news article. The predictions from GroupLens are on a scale from 1 to
-5, where 1 is the worst and 5 is the best. You can use the predictions
-from GroupLens in one of three ways controlled by the variable
-@code{gnus-grouplens-override-scoring}.
-
-@vindex gnus-grouplens-override-scoring
-There are three ways to display predictions in grouplens. You may
-choose to have the GroupLens scores contribute to, or override the
-regular Gnus scoring mechanism. override is the default; however, some
-people prefer to see the Gnus scores plus the grouplens scores. To get
-the separate scoring behavior you need to set
-@code{gnus-grouplens-override-scoring} to @code{'separate}. To have the
-GroupLens predictions combined with the grouplens scores set it to
-@code{'override} and to combine the scores set
-@code{gnus-grouplens-override-scoring} to @code{'combine}. When you use
-the combine option you will also want to set the values for
-@code{grouplens-prediction-offset} and
-@code{grouplens-score-scale-factor}.
-
-@vindex grouplens-prediction-display
-In either case, GroupLens gives you a few choices for how you would like
-to see your predictions displayed. The display of predictions is
-controlled by the @code{grouplens-prediction-display} variable.
-
-The following are valid values for that variable.
-
-@table @code
-@item prediction-spot
-The higher the prediction, the further to the right an @samp{*} is
-displayed.
-
-@item confidence-interval
-A numeric confidence interval.
-
-@item prediction-bar
-The higher the prediction, the longer the bar.
-
-@item confidence-bar
-Numerical confidence.
-
-@item confidence-spot
-The spot gets bigger with more confidence.
-
-@item prediction-num
-Plain-old numeric value.
-
-@item confidence-plus-minus
-Prediction +/- confidence.
-
-@end table
-
-
-@node GroupLens Variables
-@subsection GroupLens Variables
-
-@table @code
-
-@item gnus-summary-grouplens-line-format
-The summary line format used in GroupLens-enhanced summary buffers. It
-accepts the same specs as the normal summary line format (@pxref{Summary
-Buffer Lines}). The default is @samp{%U%R%z%l%I%(%[%4L: %-23,23n%]%)
-%s\n}.
-
-@item grouplens-bbb-host
-Host running the bbbd server. @samp{grouplens.cs.umn.edu} is the
-default.
-
-@item grouplens-bbb-port
-Port of the host running the bbbd server. The default is 9000.
-
-@item grouplens-score-offset
-Offset the prediction by this value. In other words, subtract the
-prediction value by this number to arrive at the effective score. The
-default is 0.
-
-@item grouplens-score-scale-factor
-This variable allows the user to magnify the effect of GroupLens scores.
-The scale factor is applied after the offset. The default is 1.
-
-@end table
-
-
-@node Advanced Scoring
-@section Advanced Scoring
-
-Scoring on Subjects and From headers is nice enough, but what if you're
-really interested in what a person has to say only when she's talking
-about a particular subject? Or what if you really don't want to
-read what person A has to say when she's following up to person B, but
-want to read what she says when she's following up to person C?
-
-By using advanced scoring rules you may create arbitrarily complex
-scoring patterns.
-
-@menu
-* Advanced Scoring Syntax:: A definition.
-* Advanced Scoring Examples:: What they look like.
-* Advanced Scoring Tips:: Getting the most out of it.
-@end menu
-
-
-@node Advanced Scoring Syntax
-@subsection Advanced Scoring Syntax
-
-Ordinary scoring rules have a string as the first element in the rule.
-Advanced scoring rules have a list as the first element. The second
-element is the score to be applied if the first element evaluated to a
-non-@code{nil} value.
-
-These lists may consist of three logical operators, one redirection
-operator, and various match operators.
-
-Logical operators:
-
-@table @code
-@item &
-@itemx and
-This logical operator will evaluate each of its arguments until it finds
-one that evaluates to @code{false}, and then it'll stop. If all arguments
-evaluate to @code{true} values, then this operator will return
-@code{true}.
-
-@item |
-@itemx or
-This logical operator will evaluate each of its arguments until it finds
-one that evaluates to @code{true}. If no arguments are @code{true},
-then this operator will return @code{false}.
-
-@item !
-@itemx not
-@itemx ¬
-This logical operator only takes a single argument. It returns the
-logical negation of the value of its argument.
-
-@end table
-
-There is an @dfn{indirection operator} that will make its arguments
-apply to the ancestors of the current article being scored. For
-instance, @code{1-} will make score rules apply to the parent of the
-current article. @code{2-} will make score rules apply to the
-grandparent of the current article. Alternatively, you can write
-@code{^^}, where the number of @code{^}s (carets) says how far back into
-the ancestry you want to go.
-
-Finally, we have the match operators. These are the ones that do the
-real work. Match operators are header name strings followed by a match
-and a match type. A typical match operator looks like @samp{("from"
-"Lars Ingebrigtsen" s)}. The header names are the same as when using
-simple scoring, and the match types are also the same.
-
-
-@node Advanced Scoring Examples
-@subsection Advanced Scoring Examples
-
-Please note that the following examples are score file rules. To
-make a complete score file from them, surround them with another pair
-of parentheses.
-
-Let's say you want to increase the score of articles written by Lars
-when he's talking about Gnus:
-
-@example
-@group
-((&
- ("from" "Lars Ingebrigtsen")
- ("subject" "Gnus"))
- 1000)
-@end group
-@end example
-
-Quite simple, huh?
-
-When he writes long articles, he sometimes has something nice to say:
-
-@example
-((&
- ("from" "Lars Ingebrigtsen")
- (|
- ("subject" "Gnus")
- ("lines" 100 >)))
- 1000)
-@end example
-
-However, when he responds to things written by Reig Eigil Logge, you
-really don't want to read what he's written:
-
-@example
-((&
- ("from" "Lars Ingebrigtsen")
- (1- ("from" "Reig Eigil Logge")))
- -100000)
-@end example
-
-Everybody that follows up Redmondo when he writes about disappearing
-socks should have their scores raised, but only when they talk about
-white socks. However, when Lars talks about socks, it's usually not
-very interesting:
-
-@example
-((&
- (1-
- (&
- ("from" "redmondo@@.*no" r)
- ("body" "disappearing.*socks" t)))
- (! ("from" "Lars Ingebrigtsen"))
- ("body" "white.*socks"))
- 1000)
-@end example
-
-Suppose you're reading a high volume group and you're only interested
-in replies. The plan is to score down all articles that don't have
-subject that begin with "Re:", "Fw:" or "Fwd:" and then score up all
-parents of articles that have subjects that begin with reply marks.
-
-@example
-((! ("subject" "re:\\|fwd?:" r))
- -200)
-((1- ("subject" "re:\\|fwd?:" r))
- 200)
-@end example
-
-The possibilities are endless.
-
-@node Advanced Scoring Tips
-@subsection Advanced Scoring Tips
-
-The @code{&} and @code{|} logical operators do short-circuit logic.
-That is, they stop processing their arguments when it's clear what the
-result of the operation will be. For instance, if one of the arguments
-of an @code{&} evaluates to @code{false}, there's no point in evaluating
-the rest of the arguments. This means that you should put slow matches
-(@samp{body}, @samp{header}) last and quick matches (@samp{from},
-@samp{subject}) first.
-
-The indirection arguments (@code{1-} and so on) will make their
-arguments work on previous generations of the thread. If you say
-something like:
-
-@example
-...
-(1-
- (1-
- ("from" "lars")))
-...
-@end example
-
-Then that means ``score on the from header of the grandparent of the
-current article''. An indirection is quite fast, but it's better to say:
-
-@example
-(1-
- (&
- ("from" "Lars")
- ("subject" "Gnus")))
-@end example
-
-than it is to say:
-
-@example
-(&
- (1- ("from" "Lars"))
- (1- ("subject" "Gnus")))
-@end example
-
-
-@node Score Decays
-@section Score Decays
-@cindex score decays
-@cindex decays
-
-You may find that your scores have a tendency to grow without
-bounds, especially if you're using adaptive scoring. If scores get too
-big, they lose all meaning---they simply max out and it's difficult to
-use them in any sensible way.
-
-@vindex gnus-decay-scores
-@findex gnus-decay-score
-@vindex gnus-decay-score-function
-Gnus provides a mechanism for decaying scores to help with this problem.
-When score files are loaded and @code{gnus-decay-scores} is
-non-@code{nil}, Gnus will run the score files through the decaying
-mechanism thereby lowering the scores of all non-permanent score rules.
-The decay itself if performed by the @code{gnus-decay-score-function}
-function, which is @code{gnus-decay-score} by default. Here's the
-definition of that function:
-
-@lisp
-(defun gnus-decay-score (score)
- "Decay SCORE according to `gnus-score-decay-constant'
-and `gnus-score-decay-scale'."
- (let ((n (- score
- (* (if (< score 0) -1 1)
- (min (abs score)
- (max gnus-score-decay-constant
- (* (abs score)
- gnus-score-decay-scale)))))))
- (if (and (featurep 'xemacs)
- ;; XEmacs' floor can handle only the floating point
- ;; number below the half of the maximum integer.
- (> (abs n) (lsh -1 -2)))
- (string-to-number
- (car (split-string (number-to-string n) "\\.")))
- (floor n))))
-@end lisp
-
-@vindex gnus-score-decay-scale
-@vindex gnus-score-decay-constant
-@code{gnus-score-decay-constant} is 3 by default and
-@code{gnus-score-decay-scale} is 0.05. This should cause the following:
-
-@enumerate
-@item
-Scores between -3 and 3 will be set to 0 when this function is called.
-
-@item
-Scores with magnitudes between 3 and 60 will be shrunk by 3.
-
-@item
-Scores with magnitudes greater than 60 will be shrunk by 5% of the
-score.
-@end enumerate
-
-If you don't like this decay function, write your own. It is called
-with the score to be decayed as its only parameter, and it should return
-the new score, which should be an integer.
-
-Gnus will try to decay scores once a day. If you haven't run Gnus for
-four days, Gnus will decay the scores four times, for instance.
-
-@iftex
-@iflatex
-@chapter Message
-@include message.texi
-@chapter Emacs MIME
-@include emacs-mime.texi
-@chapter Sieve
-@include sieve.texi
-@chapter PGG
-@include pgg.texi
-@end iflatex
-@end iftex
-
-@node Various
-@chapter Various
-
-@menu
-* Process/Prefix:: A convention used by many treatment commands.
-* Interactive:: Making Gnus ask you many questions.
-* Symbolic Prefixes:: How to supply some Gnus functions with options.
-* Formatting Variables:: You can specify what buffers should look like.
-* Window Layout:: Configuring the Gnus buffer windows.
-* Faces and Fonts:: How to change how faces look.
-* Compilation:: How to speed Gnus up.
-* Mode Lines:: Displaying information in the mode lines.
-* Highlighting and Menus:: Making buffers look all nice and cozy.
-* Buttons:: Get tendinitis in ten easy steps!
-* Daemons:: Gnus can do things behind your back.
-* NoCeM:: How to avoid spam and other fatty foods.
-* Undo:: Some actions can be undone.
-* Predicate Specifiers:: Specifying predicates.
-* Moderation:: What to do if you're a moderator.
-* Fetching a Group:: Starting Gnus just to read a group.
-* Image Enhancements:: Modern versions of Emacs/XEmacs can display images.
-* Fuzzy Matching:: What's the big fuzz?
-* Thwarting Email Spam:: Simple ways to avoid unsolicited commercial email.
-* Spam Package:: A package for filtering and processing spam.
-* Other modes:: Interaction with other modes.
-* Various Various:: Things that are really various.
-@end menu
-
-
-@node Process/Prefix
-@section Process/Prefix
-@cindex process/prefix convention
-
-Many functions, among them functions for moving, decoding and saving
-articles, use what is known as the @dfn{Process/Prefix convention}.
-
-This is a method for figuring out what articles the user wants the
-command to be performed on.
-
-It goes like this:
-
-If the numeric prefix is N, perform the operation on the next N
-articles, starting with the current one. If the numeric prefix is
-negative, perform the operation on the previous N articles, starting
-with the current one.
-
-@vindex transient-mark-mode
-If @code{transient-mark-mode} in non-@code{nil} and the region is
-active, all articles in the region will be worked upon.
-
-If there is no numeric prefix, but some articles are marked with the
-process mark, perform the operation on the articles marked with
-the process mark.
-
-If there is neither a numeric prefix nor any articles marked with the
-process mark, just perform the operation on the current article.
-
-Quite simple, really, but it needs to be made clear so that surprises
-are avoided.
-
-Commands that react to the process mark will push the current list of
-process marked articles onto a stack and will then clear all process
-marked articles. You can restore the previous configuration with the
-@kbd{M P y} command (@pxref{Setting Process Marks}).
-
-@vindex gnus-summary-goto-unread
-One thing that seems to shock & horrify lots of people is that, for
-instance, @kbd{3 d} does exactly the same as @kbd{d} @kbd{d} @kbd{d}.
-Since each @kbd{d} (which marks the current article as read) by default
-goes to the next unread article after marking, this means that @kbd{3 d}
-will mark the next three unread articles as read, no matter what the
-summary buffer looks like. Set @code{gnus-summary-goto-unread} to
-@code{nil} for a more straightforward action.
-
-Many commands do not use the process/prefix convention. All commands
-that do explicitly say so in this manual. To apply the process/prefix
-convention to commands that do not use it, you can use the @kbd{M-&}
-command. For instance, to mark all the articles in the group as
-expirable, you could say @kbd{M P b M-& E}.
-
-
-@node Interactive
-@section Interactive
-@cindex interaction
-
-@table @code
-
-@item gnus-novice-user
-@vindex gnus-novice-user
-If this variable is non-@code{nil}, you are either a newcomer to the
-World of Usenet, or you are very cautious, which is a nice thing to be,
-really. You will be given questions of the type ``Are you sure you want
-to do this?'' before doing anything dangerous. This is @code{t} by
-default.
-
-@item gnus-expert-user
-@vindex gnus-expert-user
-If this variable is non-@code{nil}, you will seldom be asked any
-questions by Gnus. It will simply assume you know what you're doing, no
-matter how strange.
-
-@item gnus-interactive-catchup
-@vindex gnus-interactive-catchup
-Require confirmation before catching up a group if non-@code{nil}. It
-is @code{t} by default.
-
-@item gnus-interactive-exit
-@vindex gnus-interactive-exit
-Require confirmation before exiting Gnus. This variable is @code{t} by
-default.
-@end table
-
-
-@node Symbolic Prefixes
-@section Symbolic Prefixes
-@cindex symbolic prefixes
-
-Quite a lot of Emacs commands react to the (numeric) prefix. For
-instance, @kbd{C-u 4 C-f} moves point four characters forward, and
-@kbd{C-u 9 0 0 I s s p} adds a permanent @code{Subject} substring score
-rule of 900 to the current article.
-
-This is all nice and well, but what if you want to give a command some
-additional information? Well, what most commands do is interpret the
-``raw'' prefix in some special way. @kbd{C-u 0 C-x C-s} means that one
-doesn't want a backup file to be created when saving the current buffer,
-for instance. But what if you want to save without making a backup
-file, and you want Emacs to flash lights and play a nice tune at the
-same time? You can't, and you're probably perfectly happy that way.
-
-@kindex M-i (Summary)
-@findex gnus-symbolic-argument
-I'm not, so I've added a second prefix---the @dfn{symbolic prefix}. The
-prefix key is @kbd{M-i} (@code{gnus-symbolic-argument}), and the next
-character typed in is the value. You can stack as many @kbd{M-i}
-prefixes as you want. @kbd{M-i a C-M-u} means ``feed the @kbd{C-M-u}
-command the symbolic prefix @code{a}''. @kbd{M-i a M-i b C-M-u} means
-``feed the @kbd{C-M-u} command the symbolic prefixes @code{a} and
-@code{b}''. You get the drift.
-
-Typing in symbolic prefixes to commands that don't accept them doesn't
-hurt, but it doesn't do any good either. Currently not many Gnus
-functions make use of the symbolic prefix.
-
-If you're interested in how Gnus implements this, @pxref{Extended
-Interactive}.
-
-
-@node Formatting Variables
-@section Formatting Variables
-@cindex formatting variables
-
-Throughout this manual you've probably noticed lots of variables called
-things like @code{gnus-group-line-format} and
-@code{gnus-summary-mode-line-format}. These control how Gnus is to
-output lines in the various buffers. There's quite a lot of them.
-Fortunately, they all use the same syntax, so there's not that much to
-be annoyed by.
-
-Here's an example format spec (from the group buffer): @samp{%M%S%5y:
-%(%g%)\n}. We see that it is indeed extremely ugly, and that there are
-lots of percentages everywhere.
-
-@menu
-* Formatting Basics:: A formatting variable is basically a format string.
-* Mode Line Formatting:: Some rules about mode line formatting variables.
-* Advanced Formatting:: Modifying output in various ways.
-* User-Defined Specs:: Having Gnus call your own functions.
-* Formatting Fonts:: Making the formatting look colorful and nice.
-* Positioning Point:: Moving point to a position after an operation.
-* Tabulation:: Tabulating your output.
-* Wide Characters:: Dealing with wide characters.
-@end menu
-
-Currently Gnus uses the following formatting variables:
-@code{gnus-group-line-format}, @code{gnus-summary-line-format},
-@code{gnus-server-line-format}, @code{gnus-topic-line-format},
-@code{gnus-group-mode-line-format},
-@code{gnus-summary-mode-line-format},
-@code{gnus-article-mode-line-format},
-@code{gnus-server-mode-line-format}, and
-@code{gnus-summary-pick-line-format}.
-
-All these format variables can also be arbitrary elisp forms. In that
-case, they will be @code{eval}ed to insert the required lines.
-
-@kindex M-x gnus-update-format
-@findex gnus-update-format
-Gnus includes a command to help you while creating your own format
-specs. @kbd{M-x gnus-update-format} will @code{eval} the current form,
-update the spec in question and pop you to a buffer where you can
-examine the resulting Lisp code to be run to generate the line.
-
-
-
-@node Formatting Basics
-@subsection Formatting Basics
-
-Each @samp{%} element will be replaced by some string or other when the
-buffer in question is generated. @samp{%5y} means ``insert the @samp{y}
-spec, and pad with spaces to get a 5-character field''.
-
-As with normal C and Emacs Lisp formatting strings, the numerical
-modifier between the @samp{%} and the formatting type character will
-@dfn{pad} the output so that it is always at least that long.
-@samp{%5y} will make the field always (at least) five characters wide by
-padding with spaces to the left. If you say @samp{%-5y}, it will pad to
-the right instead.
-
-You may also wish to limit the length of the field to protect against
-particularly wide values. For that you can say @samp{%4,6y}, which
-means that the field will never be more than 6 characters wide and never
-less than 4 characters wide.
-
-Also Gnus supports some extended format specifications, such as
-@samp{%&user-date;}.
-
-
-@node Mode Line Formatting
-@subsection Mode Line Formatting
-
-Mode line formatting variables (e.g.,
-@code{gnus-summary-mode-line-format}) follow the same rules as other,
-buffer line oriented formatting variables (@pxref{Formatting Basics})
-with the following two differences:
-
-@enumerate
-
-@item
-There must be no newline (@samp{\n}) at the end.
-
-@item
-The special @samp{%%b} spec can be used to display the buffer name.
-Well, it's no spec at all, really---@samp{%%} is just a way to quote
-@samp{%} to allow it to pass through the formatting machinery unmangled,
-so that Emacs receives @samp{%b}, which is something the Emacs mode line
-display interprets to mean ``show the buffer name''. For a full list of
-mode line specs Emacs understands, see the documentation of the
-@code{mode-line-format} variable.
-
-@end enumerate
-
-
-@node Advanced Formatting
-@subsection Advanced Formatting
-
-It is frequently useful to post-process the fields in some way.
-Padding, limiting, cutting off parts and suppressing certain values can
-be achieved by using @dfn{tilde modifiers}. A typical tilde spec might
-look like @samp{%~(cut 3)~(ignore "0")y}.
-
-These are the valid modifiers:
-
-@table @code
-@item pad
-@itemx pad-left
-Pad the field to the left with spaces until it reaches the required
-length.
-
-@item pad-right
-Pad the field to the right with spaces until it reaches the required
-length.
-
-@item max
-@itemx max-left
-Cut off characters from the left until it reaches the specified length.
-
-@item max-right
-Cut off characters from the right until it reaches the specified
-length.
-
-@item cut
-@itemx cut-left
-Cut off the specified number of characters from the left.
-
-@item cut-right
-Cut off the specified number of characters from the right.
-
-@item ignore
-Return an empty string if the field is equal to the specified value.
-
-@item form
-Use the specified form as the field value when the @samp{@@} spec is
-used.
-
-Here's an example:
-
-@lisp
-"~(form (current-time-string))@@"
-@end lisp
-
-@end table
-
-Let's take an example. The @samp{%o} spec in the summary mode lines
-will return a date in compact ISO8601 format---@samp{19960809T230410}.
-This is quite a mouthful, so we want to shave off the century number and
-the time, leaving us with a six-character date. That would be
-@samp{%~(cut-left 2)~(max-right 6)~(pad 6)o}. (Cutting is done before
-maxing, and we need the padding to ensure that the date is never less
-than 6 characters to make it look nice in columns.)
-
-Ignoring is done first; then cutting; then maxing; and then as the very
-last operation, padding.
-
-If you use lots of these advanced thingies, you'll find that Gnus gets
-quite slow. This can be helped enormously by running @kbd{M-x
-gnus-compile} when you are satisfied with the look of your lines.
-@xref{Compilation}.
-
-
-@node User-Defined Specs
-@subsection User-Defined Specs
-
-All the specs allow for inserting user defined specifiers---@samp{u}.
-The next character in the format string should be a letter. Gnus
-will call the function @code{gnus-user-format-function-}@samp{X}, where
-@samp{X} is the letter following @samp{%u}. The function will be passed
-a single parameter---what the parameter means depends on what buffer
-it's being called from. The function should return a string, which will
-be inserted into the buffer just like information from any other
-specifier. This function may also be called with dummy values, so it
-should protect against that.
-
-Also Gnus supports extended user-defined specs, such as @samp{%u&foo;}.
-Gnus will call the function @code{gnus-user-format-function-}@samp{foo}.
-
-You can also use tilde modifiers (@pxref{Advanced Formatting} to achieve
-much the same without defining new functions. Here's an example:
-@samp{%~(form (count-lines (point-min) (point)))@@}. The form
-given here will be evaluated to yield the current line number, and then
-inserted.
-
-
-@node Formatting Fonts
-@subsection Formatting Fonts
-
-@cindex %(, %)
-@vindex gnus-mouse-face
-There are specs for highlighting, and these are shared by all the format
-variables. Text inside the @samp{%(} and @samp{%)} specifiers will get
-the special @code{mouse-face} property set, which means that it will be
-highlighted (with @code{gnus-mouse-face}) when you put the mouse pointer
-over it.
-
-@cindex %@{, %@}
-@vindex gnus-face-0
-Text inside the @samp{%@{} and @samp{%@}} specifiers will have their
-normal faces set using @code{gnus-face-0}, which is @code{bold} by
-default. If you say @samp{%1@{}, you'll get @code{gnus-face-1} instead,
-and so on. Create as many faces as you wish. The same goes for the
-@code{mouse-face} specs---you can say @samp{%3(hello%)} to have
-@samp{hello} mouse-highlighted with @code{gnus-mouse-face-3}.
-
-@cindex %<<, %>>, guillemets
-@c @cindex %<<, %>>, %«, %», guillemets
-@vindex gnus-balloon-face-0
-Text inside the @samp{%<<} and @samp{%>>} specifiers will get the
-special @code{balloon-help} property set to
-@code{gnus-balloon-face-0}. If you say @samp{%1<<}, you'll get
-@code{gnus-balloon-face-1} and so on. The @code{gnus-balloon-face-*}
-variables should be either strings or symbols naming functions that
-return a string. When the mouse passes over text with this property
-set, a balloon window will appear and display the string. Please
-refer to @ref{Tooltips, ,Tooltips, emacs, The Emacs Manual},
-(in GNU Emacs) or the doc string of @code{balloon-help-mode} (in
-XEmacs) for more information on this. (For technical reasons, the
-guillemets have been approximated as @samp{<<} and @samp{>>} in this
-paragraph.)
-
-Here's an alternative recipe for the group buffer:
-
-@lisp
-;; @r{Create three face types.}
-(setq gnus-face-1 'bold)
-(setq gnus-face-3 'italic)
-
-;; @r{We want the article count to be in}
-;; @r{a bold and green face. So we create}
-;; @r{a new face called @code{my-green-bold}.}
-(copy-face 'bold 'my-green-bold)
-;; @r{Set the color.}
-(set-face-foreground 'my-green-bold "ForestGreen")
-(setq gnus-face-2 'my-green-bold)
-
-;; @r{Set the new & fancy format.}
-(setq gnus-group-line-format
- "%M%S%3@{%5y%@}%2[:%] %(%1@{%g%@}%)\n")
-@end lisp
-
-I'm sure you'll be able to use this scheme to create totally unreadable
-and extremely vulgar displays. Have fun!
-
-Note that the @samp{%(} specs (and friends) do not make any sense on the
-mode-line variables.
-
-@node Positioning Point
-@subsection Positioning Point
-
-Gnus usually moves point to a pre-defined place on each line in most
-buffers. By default, point move to the first colon character on the
-line. You can customize this behavior in three different ways.
-
-You can move the colon character to somewhere else on the line.
-
-@findex gnus-goto-colon
-You can redefine the function that moves the point to the colon. The
-function is called @code{gnus-goto-colon}.
-
-But perhaps the most convenient way to deal with this, if you don't want
-to have a colon in your line, is to use the @samp{%*} specifier. If you
-put a @samp{%*} somewhere in your format line definition, Gnus will
-place point there.
-
-
-@node Tabulation
-@subsection Tabulation
-
-You can usually line up your displays by padding and cutting your
-strings. However, when combining various strings of different size, it
-can often be more convenient to just output the strings, and then worry
-about lining up the following text afterwards.
-
-To do that, Gnus supplies tabulator specs---@samp{%=}. There are two
-different types---@dfn{hard tabulators} and @dfn{soft tabulators}.
-
-@samp{%50=} will insert space characters to pad the line up to column
-50. If the text is already past column 50, nothing will be inserted.
-This is the soft tabulator.
-
-@samp{%-50=} will insert space characters to pad the line up to column
-50. If the text is already past column 50, the excess text past column
-50 will be removed. This is the hard tabulator.
-
-
-@node Wide Characters
-@subsection Wide Characters
-
-Fixed width fonts in most countries have characters of the same width.
-Some countries, however, use Latin characters mixed with wider
-characters---most notable East Asian countries.
-
-The problem is that when formatting, Gnus assumes that if a string is 10
-characters wide, it'll be 10 Latin characters wide on the screen. In
-these countries, that's not true.
-
-@vindex gnus-use-correct-string-widths
-To help fix this, you can set @code{gnus-use-correct-string-widths} to
-@code{t}. This makes buffer generation slower, but the results will be
-prettier. The default value under XEmacs is @code{t} but @code{nil}
-for Emacs.
-
-
-@node Window Layout
-@section Window Layout
-@cindex window layout
-
-No, there's nothing here about X, so be quiet.
-
-@vindex gnus-use-full-window
-If @code{gnus-use-full-window} non-@code{nil}, Gnus will delete all
-other windows and occupy the entire Emacs screen by itself. It is
-@code{t} by default.
-
-Setting this variable to @code{nil} kinda works, but there are
-glitches. Use at your own peril.
-
-@vindex gnus-buffer-configuration
-@code{gnus-buffer-configuration} describes how much space each Gnus
-buffer should be given. Here's an excerpt of this variable:
-
-@lisp
-((group (vertical 1.0 (group 1.0 point)
- (if gnus-carpal (group-carpal 4))))
- (article (vertical 1.0 (summary 0.25 point)
- (article 1.0))))
-@end lisp
-
-This is an alist. The @dfn{key} is a symbol that names some action or
-other. For instance, when displaying the group buffer, the window
-configuration function will use @code{group} as the key. A full list of
-possible names is listed below.
-
-The @dfn{value} (i.e., the @dfn{split}) says how much space each buffer
-should occupy. To take the @code{article} split as an example -
-
-@lisp
-(article (vertical 1.0 (summary 0.25 point)
- (article 1.0)))
-@end lisp
-
-This @dfn{split} says that the summary buffer should occupy 25% of upper
-half of the screen, and that it is placed over the article buffer. As
-you may have noticed, 100% + 25% is actually 125% (yup, I saw y'all
-reaching for that calculator there). However, the special number
-@code{1.0} is used to signal that this buffer should soak up all the
-rest of the space available after the rest of the buffers have taken
-whatever they need. There should be only one buffer with the @code{1.0}
-size spec per split.
-
-Point will be put in the buffer that has the optional third element
-@code{point}. In a @code{frame} split, the last subsplit having a leaf
-split where the tag @code{frame-focus} is a member (i.e. is the third or
-fourth element in the list, depending on whether the @code{point} tag is
-present) gets focus.
-
-Here's a more complicated example:
-
-@lisp
-(article (vertical 1.0 (group 4)
- (summary 0.25 point)
- (if gnus-carpal (summary-carpal 4))
- (article 1.0)))
-@end lisp
-
-If the size spec is an integer instead of a floating point number,
-then that number will be used to say how many lines a buffer should
-occupy, not a percentage.
-
-If the @dfn{split} looks like something that can be @code{eval}ed (to be
-precise---if the @code{car} of the split is a function or a subr), this
-split will be @code{eval}ed. If the result is non-@code{nil}, it will
-be used as a split. This means that there will be three buffers if
-@code{gnus-carpal} is @code{nil}, and four buffers if @code{gnus-carpal}
-is non-@code{nil}.
-
-Not complicated enough for you? Well, try this on for size:
-
-@lisp
-(article (horizontal 1.0
- (vertical 0.5
- (group 1.0)
- (gnus-carpal 4))
- (vertical 1.0
- (summary 0.25 point)
- (summary-carpal 4)
- (article 1.0))))
-@end lisp
-
-Whoops. Two buffers with the mystery 100% tag. And what's that
-@code{horizontal} thingie?
-
-If the first element in one of the split is @code{horizontal}, Gnus will
-split the window horizontally, giving you two windows side-by-side.
-Inside each of these strips you may carry on all you like in the normal
-fashion. The number following @code{horizontal} says what percentage of
-the screen is to be given to this strip.
-
-For each split, there @emph{must} be one element that has the 100% tag.
-The splitting is never accurate, and this buffer will eat any leftover
-lines from the splits.
-
-To be slightly more formal, here's a definition of what a valid split
-may look like:
-
-@example
-@group
-split = frame | horizontal | vertical | buffer | form
-frame = "(frame " size *split ")"
-horizontal = "(horizontal " size *split ")"
-vertical = "(vertical " size *split ")"
-buffer = "(" buf-name " " size *[ "point" ] *[ "frame-focus"] ")"
-size = number | frame-params
-buf-name = group | article | summary ...
-@end group
-@end example
-
-The limitations are that the @code{frame} split can only appear as the
-top-level split. @var{form} should be an Emacs Lisp form that should
-return a valid split. We see that each split is fully recursive, and
-may contain any number of @code{vertical} and @code{horizontal} splits.
-
-@vindex gnus-window-min-width
-@vindex gnus-window-min-height
-@cindex window height
-@cindex window width
-Finding the right sizes can be a bit complicated. No window may be less
-than @code{gnus-window-min-height} (default 1) characters high, and all
-windows must be at least @code{gnus-window-min-width} (default 1)
-characters wide. Gnus will try to enforce this before applying the
-splits. If you want to use the normal Emacs window width/height limit,
-you can just set these two variables to @code{nil}.
-
-If you're not familiar with Emacs terminology, @code{horizontal} and
-@code{vertical} splits may work the opposite way of what you'd expect.
-Windows inside a @code{horizontal} split are shown side-by-side, and
-windows within a @code{vertical} split are shown above each other.
-
-@findex gnus-configure-frame
-If you want to experiment with window placement, a good tip is to call
-@code{gnus-configure-frame} directly with a split. This is the function
-that does all the real work when splitting buffers. Below is a pretty
-nonsensical configuration with 5 windows; two for the group buffer and
-three for the article buffer. (I said it was nonsensical.) If you
-@code{eval} the statement below, you can get an idea of how that would
-look straight away, without going through the normal Gnus channels.
-Play with it until you're satisfied, and then use
-@code{gnus-add-configuration} to add your new creation to the buffer
-configuration list.
-
-@lisp
-(gnus-configure-frame
- '(horizontal 1.0
- (vertical 10
- (group 1.0)
- (article 0.3 point))
- (vertical 1.0
- (article 1.0)
- (horizontal 4
- (group 1.0)
- (article 10)))))
-@end lisp
-
-You might want to have several frames as well. No prob---just use the
-@code{frame} split:
-
-@lisp
-(gnus-configure-frame
- '(frame 1.0
- (vertical 1.0
- (summary 0.25 point frame-focus)
- (article 1.0))
- (vertical ((height . 5) (width . 15)
- (user-position . t)
- (left . -1) (top . 1))
- (picon 1.0))))
-
-@end lisp
-
-This split will result in the familiar summary/article window
-configuration in the first (or ``main'') frame, while a small additional
-frame will be created where picons will be shown. As you can see,
-instead of the normal @code{1.0} top-level spec, each additional split
-should have a frame parameter alist as the size spec.
-@xref{Frame Parameters, , Frame Parameters, elisp, The GNU Emacs Lisp
-Reference Manual}. Under XEmacs, a frame property list will be
-accepted, too---for instance, @code{(height 5 width 15 left -1 top 1)}
-is such a plist.
-The list of all possible keys for @code{gnus-buffer-configuration} can
-be found in its default value.
-
-Note that the @code{message} key is used for both
-@code{gnus-group-mail} and @code{gnus-summary-mail-other-window}. If
-it is desirable to distinguish between the two, something like this
-might be used:
-
-@lisp
-(message (horizontal 1.0
- (vertical 1.0 (message 1.0 point))
- (vertical 0.24
- (if (buffer-live-p gnus-summary-buffer)
- '(summary 0.5))
- (group 1.0))))
-@end lisp
-
-One common desire for a multiple frame split is to have a separate frame
-for composing mail and news while leaving the original frame intact. To
-accomplish that, something like the following can be done:
-
-@lisp
-(message
- (frame 1.0
- (if (not (buffer-live-p gnus-summary-buffer))
- (car (cdr (assoc 'group gnus-buffer-configuration)))
- (car (cdr (assoc 'summary gnus-buffer-configuration))))
- (vertical ((user-position . t) (top . 1) (left . 1)
- (name . "Message"))
- (message 1.0 point))))
-@end lisp
-
-@findex gnus-add-configuration
-Since the @code{gnus-buffer-configuration} variable is so long and
-complicated, there's a function you can use to ease changing the config
-of a single setting: @code{gnus-add-configuration}. If, for instance,
-you want to change the @code{article} setting, you could say:
-
-@lisp
-(gnus-add-configuration
- '(article (vertical 1.0
- (group 4)
- (summary .25 point)
- (article 1.0))))
-@end lisp
-
-You'd typically stick these @code{gnus-add-configuration} calls in your
-@file{~/.gnus.el} file or in some startup hook---they should be run after
-Gnus has been loaded.
-
-@vindex gnus-always-force-window-configuration
-If all windows mentioned in the configuration are already visible, Gnus
-won't change the window configuration. If you always want to force the
-``right'' window configuration, you can set
-@code{gnus-always-force-window-configuration} to non-@code{nil}.
-
-If you're using tree displays (@pxref{Tree Display}), and the tree
-window is displayed vertically next to another window, you may also want
-to fiddle with @code{gnus-tree-minimize-window} to avoid having the
-windows resized.
-
-@subsection Example Window Configurations
-
-@itemize @bullet
-@item
-Narrow left hand side occupied by group buffer. Right hand side split
-between summary buffer (top one-sixth) and article buffer (bottom).
-
-@ifinfo
-@example
-+---+---------+
-| G | Summary |
-| r +---------+
-| o | |
-| u | Article |
-| p | |
-+---+---------+
-@end example
-@end ifinfo
-
-@lisp
-(gnus-add-configuration
- '(article
- (horizontal 1.0
- (vertical 25 (group 1.0))
- (vertical 1.0
- (summary 0.16 point)
- (article 1.0)))))
-
-(gnus-add-configuration
- '(summary
- (horizontal 1.0
- (vertical 25 (group 1.0))
- (vertical 1.0 (summary 1.0 point)))))
-@end lisp
-
-@end itemize
-
-
-@node Faces and Fonts
-@section Faces and Fonts
-@cindex faces
-@cindex fonts
-@cindex colors
-
-Fiddling with fonts and faces used to be very difficult, but these days
-it is very simple. You simply say @kbd{M-x customize-face}, pick out
-the face you want to alter, and alter it via the standard Customize
-interface.
-
-
-@node Compilation
-@section Compilation
-@cindex compilation
-@cindex byte-compilation
-
-@findex gnus-compile
-
-Remember all those line format specification variables?
-@code{gnus-summary-line-format}, @code{gnus-group-line-format}, and so
-on. Now, Gnus will of course heed whatever these variables are, but,
-unfortunately, changing them will mean a quite significant slow-down.
-(The default values of these variables have byte-compiled functions
-associated with them, while the user-generated versions do not, of
-course.)
-
-To help with this, you can run @kbd{M-x gnus-compile} after you've
-fiddled around with the variables and feel that you're (kind of)
-satisfied. This will result in the new specs being byte-compiled, and
-you'll get top speed again. Gnus will save these compiled specs in the
-@file{.newsrc.eld} file. (User-defined functions aren't compiled by
-this function, though---you should compile them yourself by sticking
-them into the @file{~/.gnus.el} file and byte-compiling that file.)
-
-
-@node Mode Lines
-@section Mode Lines
-@cindex mode lines
-
-@vindex gnus-updated-mode-lines
-@code{gnus-updated-mode-lines} says what buffers should keep their mode
-lines updated. It is a list of symbols. Supported symbols include
-@code{group}, @code{article}, @code{summary}, @code{server},
-@code{browse}, and @code{tree}. If the corresponding symbol is present,
-Gnus will keep that mode line updated with information that may be
-pertinent. If this variable is @code{nil}, screen refresh may be
-quicker.
-
-@cindex display-time
-
-@vindex gnus-mode-non-string-length
-By default, Gnus displays information on the current article in the mode
-lines of the summary and article buffers. The information Gnus wishes
-to display (e.g. the subject of the article) is often longer than the
-mode lines, and therefore have to be cut off at some point. The
-@code{gnus-mode-non-string-length} variable says how long the other
-elements on the line is (i.e., the non-info part). If you put
-additional elements on the mode line (e.g. a clock), you should modify
-this variable:
-
-@c Hook written by Francesco Potorti` <pot@cnuce.cnr.it>
-@lisp
-(add-hook 'display-time-hook
- (lambda () (setq gnus-mode-non-string-length
- (+ 21
- (if line-number-mode 5 0)
- (if column-number-mode 4 0)
- (length display-time-string)))))
-@end lisp
-
-If this variable is @code{nil} (which is the default), the mode line
-strings won't be chopped off, and they won't be padded either. Note
-that the default is unlikely to be desirable, as even the percentage
-complete in the buffer may be crowded off the mode line; the user should
-configure this variable appropriately for her configuration.
-
-
-@node Highlighting and Menus
-@section Highlighting and Menus
-@cindex visual
-@cindex highlighting
-@cindex menus
-
-@vindex gnus-visual
-The @code{gnus-visual} variable controls most of the Gnus-prettifying
-aspects. If @code{nil}, Gnus won't attempt to create menus or use fancy
-colors or fonts. This will also inhibit loading the @file{gnus-vis.el}
-file.
-
-This variable can be a list of visual properties that are enabled. The
-following elements are valid, and are all included by default:
-
-@table @code
-@item group-highlight
-Do highlights in the group buffer.
-@item summary-highlight
-Do highlights in the summary buffer.
-@item article-highlight
-Do highlights in the article buffer.
-@item highlight
-Turn on highlighting in all buffers.
-@item group-menu
-Create menus in the group buffer.
-@item summary-menu
-Create menus in the summary buffers.
-@item article-menu
-Create menus in the article buffer.
-@item browse-menu
-Create menus in the browse buffer.
-@item server-menu
-Create menus in the server buffer.
-@item score-menu
-Create menus in the score buffers.
-@item menu
-Create menus in all buffers.
-@end table
-
-So if you only want highlighting in the article buffer and menus in all
-buffers, you could say something like:
-
-@lisp
-(setq gnus-visual '(article-highlight menu))
-@end lisp
-
-If you want highlighting only and no menus whatsoever, you'd say:
-
-@lisp
-(setq gnus-visual '(highlight))
-@end lisp
-
-If @code{gnus-visual} is @code{t}, highlighting and menus will be used
-in all Gnus buffers.
-
-Other general variables that influence the look of all buffers include:
-
-@table @code
-@item gnus-mouse-face
-@vindex gnus-mouse-face
-This is the face (i.e., font) used for mouse highlighting in Gnus. No
-mouse highlights will be done if @code{gnus-visual} is @code{nil}.
-
-@end table
-
-There are hooks associated with the creation of all the different menus:
-
-@table @code
-
-@item gnus-article-menu-hook
-@vindex gnus-article-menu-hook
-Hook called after creating the article mode menu.
-
-@item gnus-group-menu-hook
-@vindex gnus-group-menu-hook
-Hook called after creating the group mode menu.
-
-@item gnus-summary-menu-hook
-@vindex gnus-summary-menu-hook
-Hook called after creating the summary mode menu.
-
-@item gnus-server-menu-hook
-@vindex gnus-server-menu-hook
-Hook called after creating the server mode menu.
-
-@item gnus-browse-menu-hook
-@vindex gnus-browse-menu-hook
-Hook called after creating the browse mode menu.
-
-@item gnus-score-menu-hook
-@vindex gnus-score-menu-hook
-Hook called after creating the score mode menu.
-
-@end table
-
-
-@node Buttons
-@section Buttons
-@cindex buttons
-@cindex mouse
-@cindex click
-
-Those new-fangled @dfn{mouse} contraptions is very popular with the
-young, hep kids who don't want to learn the proper way to do things
-these days. Why, I remember way back in the summer of '89, when I was
-using Emacs on a Tops 20 system. Three hundred users on one single
-machine, and every user was running Simula compilers. Bah!
-
-Right.
-
-@vindex gnus-carpal
-Well, you can make Gnus display bufferfuls of buttons you can click to
-do anything by setting @code{gnus-carpal} to @code{t}. Pretty simple,
-really. Tell the chiropractor I sent you.
-
-
-@table @code
-
-@item gnus-carpal-mode-hook
-@vindex gnus-carpal-mode-hook
-Hook run in all carpal mode buffers.
-
-@item gnus-carpal-button-face
-@vindex gnus-carpal-button-face
-Face used on buttons.
-
-@item gnus-carpal-header-face
-@vindex gnus-carpal-header-face
-Face used on carpal buffer headers.
-
-@item gnus-carpal-group-buffer-buttons
-@vindex gnus-carpal-group-buffer-buttons
-Buttons in the group buffer.
-
-@item gnus-carpal-summary-buffer-buttons
-@vindex gnus-carpal-summary-buffer-buttons
-Buttons in the summary buffer.
-
-@item gnus-carpal-server-buffer-buttons
-@vindex gnus-carpal-server-buffer-buttons
-Buttons in the server buffer.
-
-@item gnus-carpal-browse-buffer-buttons
-@vindex gnus-carpal-browse-buffer-buttons
-Buttons in the browse buffer.
-@end table
-
-All the @code{buttons} variables are lists. The elements in these list
-are either cons cells where the @code{car} contains a text to be displayed and
-the @code{cdr} contains a function symbol, or a simple string.
-
-
-@node Daemons
-@section Daemons
-@cindex demons
-@cindex daemons
-
-Gnus, being larger than any program ever written (allegedly), does lots
-of strange stuff that you may wish to have done while you're not
-present. For instance, you may want it to check for new mail once in a
-while. Or you may want it to close down all connections to all servers
-when you leave Emacs idle. And stuff like that.
-
-Gnus will let you do stuff like that by defining various
-@dfn{handlers}. Each handler consists of three elements: A
-@var{function}, a @var{time}, and an @var{idle} parameter.
-
-Here's an example of a handler that closes connections when Emacs has
-been idle for thirty minutes:
-
-@lisp
-(gnus-demon-close-connections nil 30)
-@end lisp
-
-Here's a handler that scans for @acronym{PGP} headers every hour when
-Emacs is idle:
-
-@lisp
-(gnus-demon-scan-pgp 60 t)
-@end lisp
-
-This @var{time} parameter and that @var{idle} parameter work together
-in a strange, but wonderful fashion. Basically, if @var{idle} is
-@code{nil}, then the function will be called every @var{time} minutes.
-
-If @var{idle} is @code{t}, then the function will be called after
-@var{time} minutes only if Emacs is idle. So if Emacs is never idle,
-the function will never be called. But once Emacs goes idle, the
-function will be called every @var{time} minutes.
-
-If @var{idle} is a number and @var{time} is a number, the function will
-be called every @var{time} minutes only when Emacs has been idle for
-@var{idle} minutes.
-
-If @var{idle} is a number and @var{time} is @code{nil}, the function
-will be called once every time Emacs has been idle for @var{idle}
-minutes.
-
-And if @var{time} is a string, it should look like @samp{07:31}, and
-the function will then be called once every day somewhere near that
-time. Modified by the @var{idle} parameter, of course.
-
-@vindex gnus-demon-timestep
-(When I say ``minute'' here, I really mean @code{gnus-demon-timestep}
-seconds. This is 60 by default. If you change that variable,
-all the timings in the handlers will be affected.)
-
-So, if you want to add a handler, you could put something like this in
-your @file{~/.gnus.el} file:
-
-@findex gnus-demon-add-handler
-@lisp
-(gnus-demon-add-handler 'gnus-demon-close-connections 30 t)
-@end lisp
-
-@findex gnus-demon-add-nocem
-@findex gnus-demon-add-scanmail
-@findex gnus-demon-add-rescan
-@findex gnus-demon-add-scan-timestamps
-@findex gnus-demon-add-disconnection
-Some ready-made functions to do this have been created:
-@code{gnus-demon-add-nocem}, @code{gnus-demon-add-disconnection},
-@code{gnus-demon-add-nntp-close-connection},
-@code{gnus-demon-add-scan-timestamps}, @code{gnus-demon-add-rescan}, and
-@code{gnus-demon-add-scanmail}. Just put those functions in your
-@file{~/.gnus.el} if you want those abilities.
-
-@findex gnus-demon-init
-@findex gnus-demon-cancel
-@vindex gnus-demon-handlers
-If you add handlers to @code{gnus-demon-handlers} directly, you should
-run @code{gnus-demon-init} to make the changes take hold. To cancel all
-daemons, you can use the @code{gnus-demon-cancel} function.
-
-Note that adding daemons can be pretty naughty if you over do it. Adding
-functions that scan all news and mail from all servers every two seconds
-is a sure-fire way of getting booted off any respectable system. So
-behave.
-
-
-@node NoCeM
-@section NoCeM
-@cindex nocem
-@cindex spam
-
-@dfn{Spamming} is posting the same article lots and lots of times.
-Spamming is bad. Spamming is evil.
-
-Spamming is usually canceled within a day or so by various anti-spamming
-agencies. These agencies usually also send out @dfn{NoCeM} messages.
-NoCeM is pronounced ``no see-'em'', and means what the name
-implies---these are messages that make the offending articles, like, go
-away.
-
-What use are these NoCeM messages if the articles are canceled anyway?
-Some sites do not honor cancel messages and some sites just honor cancels
-from a select few people. Then you may wish to make use of the NoCeM
-messages, which are distributed in the @samp{alt.nocem.misc} newsgroup.
-
-Gnus can read and parse the messages in this group automatically, and
-this will make spam disappear.
-
-There are some variables to customize, of course:
-
-@table @code
-@item gnus-use-nocem
-@vindex gnus-use-nocem
-Set this variable to @code{t} to set the ball rolling. It is @code{nil}
-by default.
-
-You can also set this variable to a positive number as a group level.
-In that case, Gnus scans NoCeM messages when checking new news if this
-value is not exceeding a group level that you specify as the prefix
-argument to some commands, e.g. @code{gnus},
-@code{gnus-group-get-new-news}, etc. Otherwise, Gnus does not scan
-NoCeM messages if you specify a group level to those commands. For
-example, if you use 1 or 2 on the mail groups and the levels on the news
-groups remain the default, 3 is the best choice.
-
-@item gnus-nocem-groups
-@vindex gnus-nocem-groups
-Gnus will look for NoCeM messages in the groups in this list. The
-default is
-@lisp
-("news.lists.filters" "news.admin.net-abuse.bulletins"
- "alt.nocem.misc" "news.admin.net-abuse.announce")
-@end lisp
-
-@item gnus-nocem-issuers
-@vindex gnus-nocem-issuers
-There are many people issuing NoCeM messages. This list says what
-people you want to listen to. The default is
-@lisp
-("Automoose-1" "clewis@@ferret.ocunix.on.ca"
- "cosmo.roadkill" "SpamHippo" "hweede@@snafu.de")
-@end lisp
-fine, upstanding citizens all of them.
-
-Known despammers that you can put in this list are listed at@*
-@uref{http://www.xs4all.nl/~rosalind/nocemreg/nocemreg.html}.
-
-You do not have to heed NoCeM messages from all these people---just the
-ones you want to listen to. You also don't have to accept all NoCeM
-messages from the people you like. Each NoCeM message has a @dfn{type}
-header that gives the message a (more or less, usually less) rigorous
-definition. Common types are @samp{spam}, @samp{spew}, @samp{mmf},
-@samp{binary}, and @samp{troll}. To specify this, you have to use
-@code{(@var{issuer} @var{conditions} @dots{})} elements in the list.
-Each condition is either a string (which is a regexp that matches types
-you want to use) or a list on the form @code{(not @var{string})}, where
-@var{string} is a regexp that matches types you don't want to use.
-
-For instance, if you want all NoCeM messages from Chris Lewis except his
-@samp{troll} messages, you'd say:
-
-@lisp
-("clewis@@ferret.ocunix.on.ca" ".*" (not "troll"))
-@end lisp
-
-On the other hand, if you just want nothing but his @samp{spam} and
-@samp{spew} messages, you'd say:
-
-@lisp
-("clewis@@ferret.ocunix.on.ca" (not ".*") "spew" "spam")
-@end lisp
-
-The specs are applied left-to-right.
-
-
-@item gnus-nocem-verifyer
-@vindex gnus-nocem-verifyer
-@findex pgg-verify
-This should be a function for verifying that the NoCeM issuer is who she
-says she is. The default is @code{pgg-verify}, which returns
-non-@code{nil} if the verification is successful, otherwise (including
-the case the NoCeM message was not signed) returns @code{nil}. If this
-is too slow and you don't care for verification (which may be dangerous),
-you can set this variable to @code{nil}.
-
-Formerly the default was @code{mc-verify}, which is a Mailcrypt
-function. While you can still use it, you can change it into
-@code{pgg-verify} running with GnuPG if you are willing to add the
-@acronym{PGP} public keys to GnuPG's keyring.
-
-@item gnus-nocem-directory
-@vindex gnus-nocem-directory
-This is where Gnus will store its NoCeM cache files. The default is@*
-@file{~/News/NoCeM/}.
-
-@item gnus-nocem-expiry-wait
-@vindex gnus-nocem-expiry-wait
-The number of days before removing old NoCeM entries from the cache.
-The default is 15. If you make it shorter Gnus will be faster, but you
-might then see old spam.
-
-@item gnus-nocem-check-from
-@vindex gnus-nocem-check-from
-Non-@code{nil} means check for valid issuers in message bodies.
-Otherwise don't bother fetching articles unless their author matches a
-valid issuer; that is much faster if you are selective about the
-issuers.
-
-@item gnus-nocem-check-article-limit
-@vindex gnus-nocem-check-article-limit
-If non-@code{nil}, the maximum number of articles to check in any NoCeM
-group. NoCeM groups can be huge and very slow to process.
-
-@end table
-
-Using NoCeM could potentially be a memory hog. If you have many living
-(i. e., subscribed or unsubscribed groups), your Emacs process will grow
-big. If this is a problem, you should kill off all (or most) of your
-unsubscribed groups (@pxref{Subscription Commands}).
-
-
-@node Undo
-@section Undo
-@cindex undo
-
-It is very useful to be able to undo actions one has done. In normal
-Emacs buffers, it's easy enough---you just push the @code{undo} button.
-In Gnus buffers, however, it isn't that simple.
-
-The things Gnus displays in its buffer is of no value whatsoever to
-Gnus---it's all just data designed to look nice to the user.
-Killing a group in the group buffer with @kbd{C-k} makes the line
-disappear, but that's just a side-effect of the real action---the
-removal of the group in question from the internal Gnus structures.
-Undoing something like that can't be done by the normal Emacs
-@code{undo} function.
-
-Gnus tries to remedy this somewhat by keeping track of what the user
-does and coming up with actions that would reverse the actions the user
-takes. When the user then presses the @code{undo} key, Gnus will run
-the code to reverse the previous action, or the previous actions.
-However, not all actions are easily reversible, so Gnus currently offers
-a few key functions to be undoable. These include killing groups,
-yanking groups, and changing the list of read articles of groups.
-That's it, really. More functions may be added in the future, but each
-added function means an increase in data to be stored, so Gnus will
-never be totally undoable.
-
-@findex gnus-undo-mode
-@vindex gnus-use-undo
-@findex gnus-undo
-The undoability is provided by the @code{gnus-undo-mode} minor mode. It
-is used if @code{gnus-use-undo} is non-@code{nil}, which is the
-default. The @kbd{C-M-_} key performs the @code{gnus-undo}
-command, which should feel kinda like the normal Emacs @code{undo}
-command.
-
-
-@node Predicate Specifiers
-@section Predicate Specifiers
-@cindex predicate specifiers
-
-Some Gnus variables are @dfn{predicate specifiers}. This is a special
-form that allows flexible specification of predicates without having
-to type all that much.
-
-These specifiers are lists consisting of functions, symbols and lists.
-
-Here's an example:
-
-@lisp
-(or gnus-article-unseen-p
- gnus-article-unread-p)
-@end lisp
-
-The available symbols are @code{or}, @code{and} and @code{not}. The
-functions all take one parameter.
-
-@findex gnus-make-predicate
-Internally, Gnus calls @code{gnus-make-predicate} on these specifiers
-to create a function that can be called. This input parameter to this
-function will be passed along to all the functions in the predicate
-specifier.
-
-
-@node Moderation
-@section Moderation
-@cindex moderation
-
-If you are a moderator, you can use the @file{gnus-mdrtn.el} package.
-It is not included in the standard Gnus package. Write a mail to
-@samp{larsi@@gnus.org} and state what group you moderate, and you'll
-get a copy.
-
-The moderation package is implemented as a minor mode for summary
-buffers. Put
-
-@lisp
-(add-hook 'gnus-summary-mode-hook 'gnus-moderate)
-@end lisp
-
-in your @file{~/.gnus.el} file.
-
-If you are the moderator of @samp{rec.zoofle}, this is how it's
-supposed to work:
-
-@enumerate
-@item
-You split your incoming mail by matching on
-@samp{Newsgroups:.*rec.zoofle}, which will put all the to-be-posted
-articles in some mail group---for instance, @samp{nnml:rec.zoofle}.
-
-@item
-You enter that group once in a while and post articles using the @kbd{e}
-(edit-and-post) or @kbd{s} (just send unedited) commands.
-
-@item
-If, while reading the @samp{rec.zoofle} newsgroup, you happen upon some
-articles that weren't approved by you, you can cancel them with the
-@kbd{c} command.
-@end enumerate
-
-To use moderation mode in these two groups, say:
-
-@lisp
-(setq gnus-moderated-list
- "^nnml:rec.zoofle$\\|^rec.zoofle$")
-@end lisp
-
-
-@node Fetching a Group
-@section Fetching a Group
-@cindex fetching a group
-
-@findex gnus-fetch-group
-It is sometimes convenient to be able to just say ``I want to read this
-group and I don't care whether Gnus has been started or not''. This is
-perhaps more useful for people who write code than for users, but the
-command @code{gnus-fetch-group} provides this functionality in any case.
-It takes the group name as a parameter.
-
-
-@node Image Enhancements
-@section Image Enhancements
-
-XEmacs, as well as Emacs 21@footnote{Emacs 21 on MS Windows doesn't
-support images, Emacs 22 does.} and up, are able to display pictures and
-stuff, so Gnus has taken advantage of that.
-
-@menu
-* X-Face:: Display a funky, teensy black-and-white image.
-* Face:: Display a funkier, teensier colored image.
-* Smileys:: Show all those happy faces the way they were meant to be shown.
-* Picons:: How to display pictures of what you're reading.
-* XVarious:: Other XEmacsy Gnusey variables.
-@end menu
-
-
-@node X-Face
-@subsection X-Face
-@cindex x-face
-
-@code{X-Face} headers describe a 48x48 pixel black-and-white (1 bit
-depth) image that's supposed to represent the author of the message.
-It seems to be supported by an ever-growing number of mail and news
-readers.
-
-@cindex x-face
-@findex gnus-article-display-x-face
-@vindex gnus-article-x-face-command
-@vindex gnus-article-x-face-too-ugly
-@iftex
-@iflatex
-\include{xface}
-@end iflatex
-@end iftex
-@c @anchor{X-Face}
-
-Viewing an @code{X-Face} header either requires an Emacs that has
-@samp{compface} support (which most XEmacs versions have), or that you
-have suitable conversion or display programs installed. If your Emacs
-has image support the default action is to display the face before the
-@code{From} header. If there's no native @code{X-Face} support, Gnus
-will try to convert the @code{X-Face} header using external programs
-from the @code{pbmplus} package and friends, see below. For XEmacs it's
-faster if XEmacs has been compiled with @code{X-Face} support. The
-default action under Emacs without image support is to fork off the
-@code{display} program.
-
-On a GNU/Linux system, the @code{display} program is included in the
-ImageMagick package. For external conversion programs look for packages
-with names like @code{netpbm}, @code{libgr-progs} and @code{compface}.
-On Windows, you may use the packages @code{netpbm} and @code{compface}
-from @url{http://gnuwin32.sourceforge.net}. You need to add the
-@code{bin} directory to your @code{PATH} environment variable.
-@c In fact only the following DLLs and binaries seem to be required:
-@c compface1.dll uncompface.exe libnetpbm10.dll icontopbm.exe
-
-The variable @code{gnus-article-x-face-command} controls which programs
-are used to display the @code{X-Face} header. If this variable is a
-string, this string will be executed in a sub-shell. If it is a
-function, this function will be called with the face as the argument.
-If @code{gnus-article-x-face-too-ugly} (which is a regexp) matches the
-@code{From} header, the face will not be shown.
-
-(Note: @code{x-face} is used in the variable/function names, not
-@code{xface}).
-
-@noindent
-Face and variable:
-
-@table @code
-@item gnus-x-face
-@vindex gnus-x-face
-Face to show X-Face. The colors from this face are used as the
-foreground and background colors of the displayed X-Faces. The
-default colors are black and white.
-@end table
-
-If you use posting styles, you can use an @code{x-face-file} entry in
-@code{gnus-posting-styles}, @xref{Posting Styles}. If you don't, Gnus
-provides a few convenience functions and variables to allow easier
-insertion of X-Face headers in outgoing messages. You also need the
-above mentioned ImageMagick, netpbm or other image conversion packages
-(depending the values of the variables below) for these functions.
-
-@findex gnus-random-x-face
-@vindex gnus-convert-pbm-to-x-face-command
-@vindex gnus-x-face-directory
-@code{gnus-random-x-face} goes through all the @samp{pbm} files in
-@code{gnus-x-face-directory} and picks one at random, and then
-converts it to the X-Face format by using the
-@code{gnus-convert-pbm-to-x-face-command} shell command. The
-@samp{pbm} files should be 48x48 pixels big. It returns the X-Face
-header data as a string.
-
-@findex gnus-insert-random-x-face-header
-@code{gnus-insert-random-x-face-header} calls
-@code{gnus-random-x-face} and inserts a @samp{X-Face} header with the
-randomly generated data.
-
-@findex gnus-x-face-from-file
-@vindex gnus-convert-image-to-x-face-command
-@code{gnus-x-face-from-file} takes a GIF file as the parameter, and then
-converts the file to X-Face format by using the
-@code{gnus-convert-image-to-x-face-command} shell command.
-
-Here's how you would typically use the first function. Put something
-like the following in your @file{~/.gnus.el} file:
-
-@lisp
-(setq message-required-news-headers
- (nconc message-required-news-headers
- (list '(X-Face . gnus-random-x-face))))
-@end lisp
-
-Using the last function would be something like this:
-
-@lisp
-(setq message-required-news-headers
- (nconc message-required-news-headers
- (list '(X-Face . (lambda ()
- (gnus-x-face-from-file
- "~/My-face.gif"))))))
-@end lisp
-
-
-@node Face
-@subsection Face
-@cindex face
-
-@c #### FIXME: faces and x-faces' implementations should really be harmonized.
-
-@code{Face} headers are essentially a funkier version of @code{X-Face}
-ones. They describe a 48x48 pixel colored image that's supposed to
-represent the author of the message.
-
-@cindex face
-@findex gnus-article-display-face
-The contents of a @code{Face} header must be a base64 encoded PNG image.
-See @uref{http://quimby.gnus.org/circus/face/} for the precise
-specifications.
-
-Viewing an @code{Face} header requires an Emacs that is able to display
-PNG images.
-@c Maybe add this:
-@c (if (featurep 'xemacs)
-@c (featurep 'png)
-@c (image-type-available-p 'png))
-
-Gnus provides a few convenience functions and variables to allow
-easier insertion of Face headers in outgoing messages.
-
-@findex gnus-convert-png-to-face
-@code{gnus-convert-png-to-face} takes a 48x48 PNG image, no longer than
-726 bytes long, and converts it to a face.
-
-@findex gnus-face-from-file
-@vindex gnus-convert-image-to-face-command
-@code{gnus-face-from-file} takes a JPEG file as the parameter, and then
-converts the file to Face format by using the
-@code{gnus-convert-image-to-face-command} shell command.
-
-Here's how you would typically use this function. Put something like the
-following in your @file{~/.gnus.el} file:
-
-@lisp
-(setq message-required-news-headers
- (nconc message-required-news-headers
- (list '(Face . (lambda ()
- (gnus-face-from-file "~/face.jpg"))))))
-@end lisp
-
-
-@node Smileys
-@subsection Smileys
-@cindex smileys
-
-@iftex
-@iflatex
-\gnusfig{-3cm}{0.5cm}{\epsfig{figure=ps/BigFace,height=20cm}}
-\input{smiley}
-@end iflatex
-@end iftex
-
-@dfn{Smiley} is a package separate from Gnus, but since Gnus is
-currently the only package that uses Smiley, it is documented here.
-
-In short---to use Smiley in Gnus, put the following in your
-@file{~/.gnus.el} file:
-
-@lisp
-(setq gnus-treat-display-smileys t)
-@end lisp
-
-Smiley maps text smiley faces---@samp{:-)}, @samp{8-)}, @samp{:-(} and
-the like---to pictures and displays those instead of the text smiley
-faces. The conversion is controlled by a list of regexps that matches
-text and maps that to file names.
-
-@vindex smiley-regexp-alist
-The alist used is specified by the @code{smiley-regexp-alist}
-variable. The first item in each element is the regexp to be matched;
-the second element is the regexp match group that is to be replaced by
-the picture; and the third element is the name of the file to be
-displayed.
-
-The following variables customize where Smiley will look for these
-files:
-
-@table @code
-
-@item smiley-data-directory
-@vindex smiley-data-directory
-Where Smiley will look for smiley faces files.
-
-@item gnus-smiley-file-types
-@vindex gnus-smiley-file-types
-List of suffixes on smiley file names to try.
-
-@end table
-
-
-@node Picons
-@subsection Picons
-
-@iftex
-@iflatex
-\include{picons}
-@end iflatex
-@end iftex
-
-So@dots{} You want to slow down your news reader even more! This is a
-good way to do so. It's also a great way to impress people staring
-over your shoulder as you read news.
-
-What are Picons? To quote directly from the Picons Web site:
-
-@iftex
-@iflatex
-\margindex{}
-@end iflatex
-@end iftex
-
-@quotation
-@dfn{Picons} is short for ``personal icons''. They're small,
-constrained images used to represent users and domains on the net,
-organized into databases so that the appropriate image for a given
-e-mail address can be found. Besides users and domains, there are picon
-databases for Usenet newsgroups and weather forecasts. The picons are
-in either monochrome @code{XBM} format or color @code{XPM} and
-@code{GIF} formats.
-@end quotation
-
-@vindex gnus-picon-databases
-For instructions on obtaining and installing the picons databases,
-point your Web browser at
-@uref{http://www.cs.indiana.edu/picons/ftp/index.html}.
-
-If you are using Debian GNU/Linux, saying @samp{apt-get install
-picons.*} will install the picons where Gnus can find them.
-
-To enable displaying picons, simply make sure that
-@code{gnus-picon-databases} points to the directory containing the
-Picons databases.
-
-The following variables offer control over where things are located.
-
-@table @code
-
-@item gnus-picon-databases
-@vindex gnus-picon-databases
-The location of the picons database. This is a list of directories
-containing the @file{news}, @file{domains}, @file{users} (and so on)
-subdirectories. Defaults to @code{("/usr/lib/picon"
-"/usr/local/faces")}.
-
-@item gnus-picon-news-directories
-@vindex gnus-picon-news-directories
-List of subdirectories to search in @code{gnus-picon-databases} for
-newsgroups faces. @code{("news")} is the default.
-
-@item gnus-picon-user-directories
-@vindex gnus-picon-user-directories
-List of subdirectories to search in @code{gnus-picon-databases} for user
-faces. @code{("users" "usenix" "local" "misc")} is the default.
-
-@item gnus-picon-domain-directories
-@vindex gnus-picon-domain-directories
-List of subdirectories to search in @code{gnus-picon-databases} for
-domain name faces. Defaults to @code{("domains")}. Some people may
-want to add @samp{"unknown"} to this list.
-
-@item gnus-picon-file-types
-@vindex gnus-picon-file-types
-Ordered list of suffixes on picon file names to try. Defaults to
-@code{("xpm" "gif" "xbm")} minus those not built-in your Emacs.
-
-@end table
-
-
-@node XVarious
-@subsection Various XEmacs Variables
-
-@table @code
-@item gnus-xmas-glyph-directory
-@vindex gnus-xmas-glyph-directory
-This is where Gnus will look for pictures. Gnus will normally
-auto-detect this directory, but you may set it manually if you have an
-unusual directory structure.
-
-@item gnus-xmas-modeline-glyph
-@vindex gnus-xmas-modeline-glyph
-A glyph displayed in all Gnus mode lines. It is a tiny gnu head by
-default.
-
-@end table
-
-@subsubsection Toolbar
-
-@table @code
-
-@item gnus-use-toolbar
-@vindex gnus-use-toolbar
-This variable specifies the position to display the toolbar. If
-@code{nil}, don't display toolbars. If it is non-@code{nil}, it should
-be one of the symbols @code{default}, @code{top}, @code{bottom},
-@code{right}, and @code{left}. @code{default} means to use the default
-toolbar, the rest mean to display the toolbar on the place which those
-names show. The default is @code{default}.
-
-@item gnus-toolbar-thickness
-@vindex gnus-toolbar-thickness
-Cons of the height and the width specifying the thickness of a toolbar.
-The height is used for the toolbar displayed on the top or the bottom,
-the width is used for the toolbar displayed on the right or the left.
-The default is that of the default toolbar.
-
-@item gnus-group-toolbar
-@vindex gnus-group-toolbar
-The toolbar in the group buffer.
-
-@item gnus-summary-toolbar
-@vindex gnus-summary-toolbar
-The toolbar in the summary buffer.
-
-@item gnus-summary-mail-toolbar
-@vindex gnus-summary-mail-toolbar
-The toolbar in the summary buffer of mail groups.
-
-@end table
-
-@iftex
-@iflatex
-\margindex{}
-@end iflatex
-@end iftex
-
-
-@node Fuzzy Matching
-@section Fuzzy Matching
-@cindex fuzzy matching
-
-Gnus provides @dfn{fuzzy matching} of @code{Subject} lines when doing
-things like scoring, thread gathering and thread comparison.
-
-As opposed to regular expression matching, fuzzy matching is very fuzzy.
-It's so fuzzy that there's not even a definition of what @dfn{fuzziness}
-means, and the implementation has changed over time.
-
-Basically, it tries to remove all noise from lines before comparing.
-@samp{Re: }, parenthetical remarks, white space, and so on, are filtered
-out of the strings before comparing the results. This often leads to
-adequate results---even when faced with strings generated by text
-manglers masquerading as newsreaders.
-
-
-@node Thwarting Email Spam
-@section Thwarting Email Spam
-@cindex email spam
-@cindex spam
-@cindex UCE
-@cindex unsolicited commercial email
-
-In these last days of the Usenet, commercial vultures are hanging about
-and grepping through news like crazy to find email addresses they can
-foist off their scams and products to. As a reaction to this, many
-people have started putting nonsense addresses into their @code{From}
-lines. I think this is counterproductive---it makes it difficult for
-people to send you legitimate mail in response to things you write, as
-well as making it difficult to see who wrote what. This rewriting may
-perhaps be a bigger menace than the unsolicited commercial email itself
-in the end.
-
-The biggest problem I have with email spam is that it comes in under
-false pretenses. I press @kbd{g} and Gnus merrily informs me that I
-have 10 new emails. I say ``Golly gee! Happy is me!'' and select the
-mail group, only to find two pyramid schemes, seven advertisements
-(``New! Miracle tonic for growing full, lustrous hair on your toes!'')
-and one mail asking me to repent and find some god.
-
-This is annoying. Here's what you can do about it.
-
-@menu
-* The problem of spam:: Some background, and some solutions
-* Anti-Spam Basics:: Simple steps to reduce the amount of spam.
-* SpamAssassin:: How to use external anti-spam tools.
-* Hashcash:: Reduce spam by burning CPU time.
-@end menu
-
-@node The problem of spam
-@subsection The problem of spam
-@cindex email spam
-@cindex spam filtering approaches
-@cindex filtering approaches, spam
-@cindex UCE
-@cindex unsolicited commercial email
-
-First, some background on spam.
-
-If you have access to e-mail, you are familiar with spam (technically
-termed @acronym{UCE}, Unsolicited Commercial E-mail). Simply put, it
-exists because e-mail delivery is very cheap compared to paper mail,
-so only a very small percentage of people need to respond to an UCE to
-make it worthwhile to the advertiser. Ironically, one of the most
-common spams is the one offering a database of e-mail addresses for
-further spamming. Senders of spam are usually called @emph{spammers},
-but terms like @emph{vermin}, @emph{scum}, @emph{sociopaths}, and
-@emph{morons} are in common use as well.
-
-Spam comes from a wide variety of sources. It is simply impossible to
-dispose of all spam without discarding useful messages. A good
-example is the TMDA system, which requires senders
-unknown to you to confirm themselves as legitimate senders before
-their e-mail can reach you. Without getting into the technical side
-of TMDA, a downside is clearly that e-mail from legitimate sources may
-be discarded if those sources can't or won't confirm themselves
-through the TMDA system. Another problem with TMDA is that it
-requires its users to have a basic understanding of e-mail delivery
-and processing.
-
-The simplest approach to filtering spam is filtering, at the mail
-server or when you sort through incoming mail. If you get 200 spam
-messages per day from @samp{random-address@@vmadmin.com}, you block
-@samp{vmadmin.com}. If you get 200 messages about @samp{VIAGRA}, you
-discard all messages with @samp{VIAGRA} in the message. If you get
-lots of spam from Bulgaria, for example, you try to filter all mail
-from Bulgarian IPs.
-
-This, unfortunately, is a great way to discard legitimate e-mail. The
-risks of blocking a whole country (Bulgaria, Norway, Nigeria, China,
-etc.) or even a continent (Asia, Africa, Europe, etc.) from contacting
-you should be obvious, so don't do it if you have the choice.
-
-In another instance, the very informative and useful RISKS digest has
-been blocked by overzealous mail filters because it @strong{contained}
-words that were common in spam messages. Nevertheless, in isolated
-cases, with great care, direct filtering of mail can be useful.
-
-Another approach to filtering e-mail is the distributed spam
-processing, for instance DCC implements such a system. In essence,
-@var{N} systems around the world agree that a machine @var{X} in
-Ghana, Estonia, or California is sending out spam e-mail, and these
-@var{N} systems enter @var{X} or the spam e-mail from @var{X} into a
-database. The criteria for spam detection vary---it may be the number
-of messages sent, the content of the messages, and so on. When a user
-of the distributed processing system wants to find out if a message is
-spam, he consults one of those @var{N} systems.
-
-Distributed spam processing works very well against spammers that send
-a large number of messages at once, but it requires the user to set up
-fairly complicated checks. There are commercial and free distributed
-spam processing systems. Distributed spam processing has its risks as
-well. For instance legitimate e-mail senders have been accused of
-sending spam, and their web sites and mailing lists have been shut
-down for some time because of the incident.
-
-The statistical approach to spam filtering is also popular. It is
-based on a statistical analysis of previous spam messages. Usually
-the analysis is a simple word frequency count, with perhaps pairs of
-words or 3-word combinations thrown into the mix. Statistical
-analysis of spam works very well in most of the cases, but it can
-classify legitimate e-mail as spam in some cases. It takes time to
-run the analysis, the full message must be analyzed, and the user has
-to store the database of spam analysis. Statistical analysis on the
-server is gaining popularity. This has the advantage of letting the
-user Just Read Mail, but has the disadvantage that it's harder to tell
-the server that it has misclassified mail.
-
-Fighting spam is not easy, no matter what anyone says. There is no
-magic switch that will distinguish Viagra ads from Mom's e-mails.
-Even people are having a hard time telling spam apart from non-spam,
-because spammers are actively looking to fool us into thinking they
-are Mom, essentially. Spamming is irritating, irresponsible, and
-idiotic behavior from a bunch of people who think the world owes them
-a favor. We hope the following sections will help you in fighting the
-spam plague.
-
-@node Anti-Spam Basics
-@subsection Anti-Spam Basics
-@cindex email spam
-@cindex spam
-@cindex UCE
-@cindex unsolicited commercial email
-
-One way of dealing with spam is having Gnus split out all spam into a
-@samp{spam} mail group (@pxref{Splitting Mail}).
-
-First, pick one (1) valid mail address that you can be reached at, and
-put it in your @code{From} header of all your news articles. (I've
-chosen @samp{larsi@@trym.ifi.uio.no}, but for many addresses on the form
-@samp{larsi+usenet@@ifi.uio.no} will be a better choice. Ask your
-sysadmin whether your sendmail installation accepts keywords in the local
-part of the mail address.)
-
-@lisp
-(setq message-default-news-headers
- "From: Lars Magne Ingebrigtsen <larsi@@trym.ifi.uio.no>\n")
-@end lisp
-
-Then put the following split rule in @code{nnmail-split-fancy}
-(@pxref{Fancy Mail Splitting}):
-
-@lisp
-(...
- (to "larsi@@trym.ifi.uio.no"
- (| ("subject" "re:.*" "misc")
- ("references" ".*@@.*" "misc")
- "spam"))
- ...)
-@end lisp
-
-This says that all mail to this address is suspect, but if it has a
-@code{Subject} that starts with a @samp{Re:} or has a @code{References}
-header, it's probably ok. All the rest goes to the @samp{spam} group.
-(This idea probably comes from Tim Pierce.)
-
-In addition, many mail spammers talk directly to your @acronym{SMTP} server
-and do not include your email address explicitly in the @code{To}
-header. Why they do this is unknown---perhaps it's to thwart this
-thwarting scheme? In any case, this is trivial to deal with---you just
-put anything not addressed to you in the @samp{spam} group by ending
-your fancy split rule in this way:
-
-@lisp
-(
- ...
- (to "larsi" "misc")
- "spam")
-@end lisp
-
-In my experience, this will sort virtually everything into the right
-group. You still have to check the @samp{spam} group from time to time to
-check for legitimate mail, though. If you feel like being a good net
-citizen, you can even send off complaints to the proper authorities on
-each unsolicited commercial email---at your leisure.
-
-This works for me. It allows people an easy way to contact me (they can
-just press @kbd{r} in the usual way), and I'm not bothered at all with
-spam. It's a win-win situation. Forging @code{From} headers to point
-to non-existent domains is yucky, in my opinion.
-
-Be careful with this approach. Spammers are wise to it.
-
-
-@node SpamAssassin
-@subsection SpamAssassin, Vipul's Razor, DCC, etc
-@cindex SpamAssassin
-@cindex Vipul's Razor
-@cindex DCC
-
-The days where the hints in the previous section were sufficient in
-avoiding spam are coming to an end. There are many tools out there
-that claim to reduce the amount of spam you get. This section could
-easily become outdated fast, as new products replace old, but
-fortunately most of these tools seem to have similar interfaces. Even
-though this section will use SpamAssassin as an example, it should be
-easy to adapt it to most other tools.
-
-Note that this section does not involve the @code{spam.el} package,
-which is discussed in the next section. If you don't care for all
-the features of @code{spam.el}, you can make do with these simple
-recipes.
-
-If the tool you are using is not installed on the mail server, you
-need to invoke it yourself. Ideas on how to use the
-@code{:postscript} mail source parameter (@pxref{Mail Source
-Specifiers}) follow.
-
-@lisp
-(setq mail-sources
- '((file :prescript "formail -bs spamassassin < /var/mail/%u")
- (pop :user "jrl"
- :server "pophost"
- :postscript
- "mv %t /tmp/foo; formail -bs spamc < /tmp/foo > %t")))
-@end lisp
-
-Once you manage to process your incoming spool somehow, thus making
-the mail contain e.g.@: a header indicating it is spam, you are ready to
-filter it out. Using normal split methods (@pxref{Splitting Mail}):
-
-@lisp
-(setq nnmail-split-methods '(("spam" "^X-Spam-Flag: YES")
- ...))
-@end lisp
-
-Or using fancy split methods (@pxref{Fancy Mail Splitting}):
-
-@lisp
-(setq nnmail-split-methods 'nnmail-split-fancy
- nnmail-split-fancy '(| ("X-Spam-Flag" "YES" "spam")
- ...))
-@end lisp
-
-Some people might not like the idea of piping the mail through various
-programs using a @code{:prescript} (if some program is buggy, you
-might lose all mail). If you are one of them, another solution is to
-call the external tools during splitting. Example fancy split method:
-
-@lisp
-(setq nnmail-split-fancy '(| (: kevin-spamassassin)
- ...))
-(defun kevin-spamassassin ()
- (save-excursion
- (save-restriction
- (widen)
- (if (eq 1 (call-process-region (point-min) (point-max)
- "spamc" nil nil nil "-c"))
- "spam"))))
-@end lisp
-
-Note that with the nnimap backend, message bodies will not be
-downloaded by default. You need to set
-@code{nnimap-split-download-body} to @code{t} to do that
-(@pxref{Splitting in IMAP}).
-
-That is about it. As some spam is likely to get through anyway, you
-might want to have a nifty function to call when you happen to read
-spam. And here is the nifty function:
-
-@lisp
- (defun my-gnus-raze-spam ()
- "Submit SPAM to Vipul's Razor, then mark it as expirable."
- (interactive)
- (gnus-summary-show-raw-article)
- (gnus-summary-save-in-pipe "razor-report -f -d")
- (gnus-summary-mark-as-expirable 1))
-@end lisp
-
-@node Hashcash
-@subsection Hashcash
-@cindex hashcash
-
-A novel technique to fight spam is to require senders to do something
-costly for each message they send. This has the obvious drawback that
-you cannot rely on everyone in the world using this technique,
-since it is not part of the Internet standards, but it may be useful
-in smaller communities.
-
-While the tools in the previous section work well in practice, they
-work only because the tools are constantly maintained and updated as
-new form of spam appears. This means that a small percentage of spam
-will always get through. It also means that somewhere, someone needs
-to read lots of spam to update these tools. Hashcash avoids that, but
-instead prefers that everyone you contact through e-mail supports the
-scheme. You can view the two approaches as pragmatic vs dogmatic.
-The approaches have their own advantages and disadvantages, but as
-often in the real world, a combination of them is stronger than either
-one of them separately.
-
-@cindex X-Hashcash
-The ``something costly'' is to burn CPU time, more specifically to
-compute a hash collision up to a certain number of bits. The
-resulting hashcash cookie is inserted in a @samp{X-Hashcash:}
-header. For more details, and for the external application
-@code{hashcash} you need to install to use this feature, see
-@uref{http://www.cypherspace.org/~adam/hashcash/}. Even more
-information can be found at @uref{http://www.camram.org/}.
-
-If you wish to call hashcash for each message you send, say something
-like:
-
-@lisp
-(require 'hashcash)
-(add-hook 'message-send-hook 'mail-add-payment)
-@end lisp
-
-The @file{hashcash.el} library can be found in the Gnus development
-contrib directory or at
-@uref{http://users.actrix.gen.nz/mycroft/hashcash.el}.
-
-You will need to set up some additional variables as well:
-
-@table @code
-
-@item hashcash-default-payment
-@vindex hashcash-default-payment
-This variable indicates the default number of bits the hash collision
-should consist of. By default this is 0, meaning nothing will be
-done. Suggested useful values include 17 to 29.
-
-@item hashcash-payment-alist
-@vindex hashcash-payment-alist
-Some receivers may require you to spend burn more CPU time than the
-default. This variable contains a list of @samp{(@var{addr}
-@var{amount})} cells, where @var{addr} is the receiver (email address
-or newsgroup) and @var{amount} is the number of bits in the collision
-that is needed. It can also contain @samp{(@var{addr} @var{string}
-@var{amount})} cells, where the @var{string} is the string to use
-(normally the email address or newsgroup name is used).
-
-@item hashcash
-@vindex hashcash
-Where the @code{hashcash} binary is installed.
-
-@end table
-
-Currently there is no built in functionality in Gnus to verify
-hashcash cookies, it is expected that this is performed by your hand
-customized mail filtering scripts. Improvements in this area would be
-a useful contribution, however.
-
-@node Spam Package
-@section Spam Package
-@cindex spam filtering
-@cindex spam
-
-The Spam package provides Gnus with a centralized mechanism for
-detecting and filtering spam. It filters new mail, and processes
-messages according to whether they are spam or ham. (@dfn{Ham} is the
-name used throughout this manual to indicate non-spam messages.)
-
-@menu
-* Spam Package Introduction::
-* Filtering Incoming Mail::
-* Detecting Spam in Groups::
-* Spam and Ham Processors::
-* Spam Package Configuration Examples::
-* Spam Back Ends::
-* Extending the Spam package::
-* Spam Statistics Package::
-@end menu
-
-@node Spam Package Introduction
-@subsection Spam Package Introduction
-@cindex spam filtering
-@cindex spam filtering sequence of events
-@cindex spam
-
-You must read this section to understand how the Spam package works.
-Do not skip, speed-read, or glance through this section.
-
-@cindex spam-initialize
-@vindex spam-use-stat
-To use the Spam package, you @strong{must} first run the function
-@code{spam-initialize}:
-
-@example
-(spam-initialize)
-@end example
-
-This autoloads @code{spam.el} and installs the various hooks necessary
-to let the Spam package do its job. In order to make use of the Spam
-package, you have to set up certain group parameters and variables,
-which we will describe below. All of the variables controlling the
-Spam package can be found in the @samp{spam} customization group.
-
-There are two ``contact points'' between the Spam package and the rest
-of Gnus: checking new mail for spam, and leaving a group.
-
-Checking new mail for spam is done in one of two ways: while splitting
-incoming mail, or when you enter a group.
-
-The first way, checking for spam while splitting incoming mail, is
-suited to mail back ends such as @code{nnml} or @code{nnimap}, where
-new mail appears in a single spool file. The Spam package processes
-incoming mail, and sends mail considered to be spam to a designated
-``spam'' group. @xref{Filtering Incoming Mail}.
-
-The second way is suited to back ends such as @code{nntp}, which have
-no incoming mail spool, or back ends where the server is in charge of
-splitting incoming mail. In this case, when you enter a Gnus group,
-the unseen or unread messages in that group are checked for spam.
-Detected spam messages are marked as spam. @xref{Detecting Spam in
-Groups}.
-
-@cindex spam back ends
-In either case, you have to tell the Spam package what method to use
-to detect spam messages. There are several methods, or @dfn{spam back
-ends} (not to be confused with Gnus back ends!) to choose from: spam
-``blacklists'' and ``whitelists'', dictionary-based filters, and so
-forth. @xref{Spam Back Ends}.
-
-In the Gnus summary buffer, messages that have been identified as spam
-always appear with a @samp{$} symbol.
-
-The Spam package divides Gnus groups into three categories: ham
-groups, spam groups, and unclassified groups. You should mark each of
-the groups you subscribe to as either a ham group or a spam group,
-using the @code{spam-contents} group parameter (@pxref{Group
-Parameters}). Spam groups have a special property: when you enter a
-spam group, all unseen articles are marked as spam. Thus, mail split
-into a spam group is automatically marked as spam.
-
-Identifying spam messages is only half of the Spam package's job. The
-second half comes into play whenever you exit a group buffer. At this
-point, the Spam package does several things:
-
-First, it calls @dfn{spam and ham processors} to process the articles
-according to whether they are spam or ham. There is a pair of spam
-and ham processors associated with each spam back end, and what the
-processors do depends on the back end. At present, the main role of
-spam and ham processors is for dictionary-based spam filters: they add
-the contents of the messages in the group to the filter's dictionary,
-to improve its ability to detect future spam. The @code{spam-process}
-group parameter specifies what spam processors to use. @xref{Spam and
-Ham Processors}.
-
-If the spam filter failed to mark a spam message, you can mark it
-yourself, so that the message is processed as spam when you exit the
-group:
-
-@table @kbd
-@item M-d
-@itemx M s x
-@itemx S x
-@kindex M-d
-@kindex S x
-@kindex M s x
-@findex gnus-summary-mark-as-spam
-@findex gnus-summary-mark-as-spam
-Mark current article as spam, showing it with the @samp{$} mark
-(@code{gnus-summary-mark-as-spam}).
-@end table
-
-@noindent
-Similarly, you can unmark an article if it has been erroneously marked
-as spam. @xref{Setting Marks}.
-
-Normally, a ham message found in a non-ham group is not processed as
-ham---the rationale is that it should be moved into a ham group for
-further processing (see below). However, you can force these articles
-to be processed as ham by setting
-@code{spam-process-ham-in-spam-groups} and
-@code{spam-process-ham-in-nonham-groups}.
-
-@vindex gnus-ham-process-destinations
-@vindex gnus-spam-process-destinations
-The second thing that the Spam package does when you exit a group is
-to move ham articles out of spam groups, and spam articles out of ham
-groups. Ham in a spam group is moved to the group specified by the
-variable @code{gnus-ham-process-destinations}, or the group parameter
-@code{ham-process-destination}. Spam in a ham group is moved to the
-group specified by the variable @code{gnus-spam-process-destinations},
-or the group parameter @code{spam-process-destination}. If these
-variables are not set, the articles are left in their current group.
-If an article cannot be moved (e.g., with a read-only backend such
-as @acronym{NNTP}), it is copied.
-
-If an article is moved to another group, it is processed again when
-you visit the new group. Normally, this is not a problem, but if you
-want each article to be processed only once, load the
-@code{gnus-registry.el} package and set the variable
-@code{spam-log-to-registry} to @code{t}. @xref{Spam Package
-Configuration Examples}.
-
-Normally, spam groups ignore @code{gnus-spam-process-destinations}.
-However, if you set @code{spam-move-spam-nonspam-groups-only} to
-@code{nil}, spam will also be moved out of spam groups, depending on
-the @code{spam-process-destination} parameter.
-
-The final thing the Spam package does is to mark spam articles as
-expired, which is usually the right thing to do.
-
-If all this seems confusing, don't worry. Soon it will be as natural
-as typing Lisp one-liners on a neural interface@dots{} err, sorry, that's
-50 years in the future yet. Just trust us, it's not so bad.
-
-@node Filtering Incoming Mail
-@subsection Filtering Incoming Mail
-@cindex spam filtering
-@cindex spam filtering incoming mail
-@cindex spam
-
-To use the Spam package to filter incoming mail, you must first set up
-fancy mail splitting. @xref{Fancy Mail Splitting}. The Spam package
-defines a special splitting function that you can add to your fancy
-split variable (either @code{nnmail-split-fancy} or
-@code{nnimap-split-fancy}, depending on your mail back end):
-
-@example
-(: spam-split)
-@end example
-
-@vindex spam-split-group
-@noindent
-The @code{spam-split} function scans incoming mail according to your
-chosen spam back end(s), and sends messages identified as spam to a
-spam group. By default, the spam group is a group named @samp{spam},
-but you can change this by customizing @code{spam-split-group}. Make
-sure the contents of @code{spam-split-group} are an unqualified group
-name. For instance, in an @code{nnimap} server @samp{your-server},
-the value @samp{spam} means @samp{nnimap+your-server:spam}. The value
-@samp{nnimap+server:spam} is therefore wrong---it gives the group
-@samp{nnimap+your-server:nnimap+server:spam}.
-
-@code{spam-split} does not modify the contents of messages in any way.
-
-@vindex nnimap-split-download-body
-Note for IMAP users: if you use the @code{spam-check-bogofilter},
-@code{spam-check-ifile}, and @code{spam-check-stat} spam back ends,
-you should also set set the variable @code{nnimap-split-download-body}
-to @code{t}. These spam back ends are most useful when they can
-``scan'' the full message body. By default, the nnimap back end only
-retrieves the message headers; @code{nnimap-split-download-body} tells
-it to retrieve the message bodies as well. We don't set this by
-default because it will slow @acronym{IMAP} down, and that is not an
-appropriate decision to make on behalf of the user. @xref{Splitting
-in IMAP}.
-
-You have to specify one or more spam back ends for @code{spam-split}
-to use, by setting the @code{spam-use-*} variables. @xref{Spam Back
-Ends}. Normally, @code{spam-split} simply uses all the spam back ends
-you enabled in this way. However, you can tell @code{spam-split} to
-use only some of them. Why this is useful? Suppose you are using the
-@code{spam-use-regex-headers} and @code{spam-use-blackholes} spam back
-ends, and the following split rule:
-
-@example
- nnimap-split-fancy '(|
- (any "ding" "ding")
- (: spam-split)
- ;; @r{default mailbox}
- "mail")
-@end example
-
-@noindent
-The problem is that you want all ding messages to make it to the ding
-folder. But that will let obvious spam (for example, spam detected by
-SpamAssassin, and @code{spam-use-regex-headers}) through, when it's
-sent to the ding list. On the other hand, some messages to the ding
-list are from a mail server in the blackhole list, so the invocation
-of @code{spam-split} can't be before the ding rule.
-
-The solution is to let SpamAssassin headers supersede ding rules, and
-perform the other @code{spam-split} rules (including a second
-invocation of the regex-headers check) after the ding rule. This is
-done by passing a parameter to @code{spam-split}:
-
-@example
-nnimap-split-fancy
- '(|
- ;; @r{spam detected by @code{spam-use-regex-headers} goes to @samp{regex-spam}}
- (: spam-split "regex-spam" 'spam-use-regex-headers)
- (any "ding" "ding")
- ;; @r{all other spam detected by spam-split goes to @code{spam-split-group}}
- (: spam-split)
- ;; @r{default mailbox}
- "mail")
-@end example
-
-@noindent
-This lets you invoke specific @code{spam-split} checks depending on
-your particular needs, and target the results of those checks to a
-particular spam group. You don't have to throw all mail into all the
-spam tests. Another reason why this is nice is that messages to
-mailing lists you have rules for don't have to have resource-intensive
-blackhole checks performed on them. You could also specify different
-spam checks for your nnmail split vs. your nnimap split. Go crazy.
-
-You should set the @code{spam-use-*} variables for whatever spam back
-ends you intend to use. The reason is that when loading
-@file{spam.el}, some conditional loading is done depending on what
-@code{spam-use-xyz} variables you have set. @xref{Spam Back Ends}.
-
-@c @emph{TODO: spam.el needs to provide a uniform way of training all the
-@c statistical databases. Some have that functionality built-in, others
-@c don't.}
-
-@node Detecting Spam in Groups
-@subsection Detecting Spam in Groups
-
-To detect spam when visiting a group, set the group's
-@code{spam-autodetect} and @code{spam-autodetect-methods} group
-parameters. These are accessible with @kbd{G c} or @kbd{G p}, as
-usual (@pxref{Group Parameters}).
-
-You should set the @code{spam-use-*} variables for whatever spam back
-ends you intend to use. The reason is that when loading
-@file{spam.el}, some conditional loading is done depending on what
-@code{spam-use-xyz} variables you have set.
-
-By default, only unseen articles are processed for spam. You can
-force Gnus to recheck all messages in the group by setting the
-variable @code{spam-autodetect-recheck-messages} to @code{t}.
-
-If you use the @code{spam-autodetect} method of checking for spam, you
-can specify different spam detection methods for different groups.
-For instance, the @samp{ding} group may have @code{spam-use-BBDB} as
-the autodetection method, while the @samp{suspect} group may have the
-@code{spam-use-blacklist} and @code{spam-use-bogofilter} methods
-enabled. Unlike with @code{spam-split}, you don't have any control
-over the @emph{sequence} of checks, but this is probably unimportant.
-
-@node Spam and Ham Processors
-@subsection Spam and Ham Processors
-@cindex spam filtering
-@cindex spam filtering variables
-@cindex spam variables
-@cindex spam
-
-@vindex gnus-spam-process-newsgroups
-Spam and ham processors specify special actions to take when you exit
-a group buffer. Spam processors act on spam messages, and ham
-processors on ham messages. At present, the main role of these
-processors is to update the dictionaries of dictionary-based spam back
-ends such as Bogofilter (@pxref{Bogofilter}) and the Spam Statistics
-package (@pxref{Spam Statistics Filtering}).
-
-The spam and ham processors that apply to each group are determined by
-the group's@code{spam-process} group parameter. If this group
-parameter is not defined, they are determined by the variable
-@code{gnus-spam-process-newsgroups}.
-
-@vindex gnus-spam-newsgroup-contents
-Gnus learns from the spam you get. You have to collect your spam in
-one or more spam groups, and set or customize the variable
-@code{spam-junk-mailgroups} as appropriate. You can also declare
-groups to contain spam by setting their group parameter
-@code{spam-contents} to @code{gnus-group-spam-classification-spam}, or
-by customizing the corresponding variable
-@code{gnus-spam-newsgroup-contents}. The @code{spam-contents} group
-parameter and the @code{gnus-spam-newsgroup-contents} variable can
-also be used to declare groups as @emph{ham} groups if you set their
-classification to @code{gnus-group-spam-classification-ham}. If
-groups are not classified by means of @code{spam-junk-mailgroups},
-@code{spam-contents}, or @code{gnus-spam-newsgroup-contents}, they are
-considered @emph{unclassified}. All groups are unclassified by
-default.
-
-@vindex gnus-spam-mark
-@cindex $
-In spam groups, all messages are considered to be spam by default:
-they get the @samp{$} mark (@code{gnus-spam-mark}) when you enter the
-group. If you have seen a message, had it marked as spam, then
-unmarked it, it won't be marked as spam when you enter the group
-thereafter. You can disable that behavior, so all unread messages
-will get the @samp{$} mark, if you set the
-@code{spam-mark-only-unseen-as-spam} parameter to @code{nil}. You
-should remove the @samp{$} mark when you are in the group summary
-buffer for every message that is not spam after all. To remove the
-@samp{$} mark, you can use @kbd{M-u} to ``unread'' the article, or
-@kbd{d} for declaring it read the non-spam way. When you leave a
-group, all spam-marked (@samp{$}) articles are sent to a spam
-processor which will study them as spam samples.
-
-Messages may also be deleted in various other ways, and unless
-@code{ham-marks} group parameter gets overridden below, marks @samp{R}
-and @samp{r} for default read or explicit delete, marks @samp{X} and
-@samp{K} for automatic or explicit kills, as well as mark @samp{Y} for
-low scores, are all considered to be associated with articles which
-are not spam. This assumption might be false, in particular if you
-use kill files or score files as means for detecting genuine spam, you
-should then adjust the @code{ham-marks} group parameter.
-
-@defvar ham-marks
-You can customize this group or topic parameter to be the list of
-marks you want to consider ham. By default, the list contains the
-deleted, read, killed, kill-filed, and low-score marks (the idea is
-that these articles have been read, but are not spam). It can be
-useful to also include the tick mark in the ham marks. It is not
-recommended to make the unread mark a ham mark, because it normally
-indicates a lack of classification. But you can do it, and we'll be
-happy for you.
-@end defvar
-
-@defvar spam-marks
-You can customize this group or topic parameter to be the list of
-marks you want to consider spam. By default, the list contains only
-the spam mark. It is not recommended to change that, but you can if
-you really want to.
-@end defvar
-
-When you leave @emph{any} group, regardless of its
-@code{spam-contents} classification, all spam-marked articles are sent
-to a spam processor, which will study these as spam samples. If you
-explicit kill a lot, you might sometimes end up with articles marked
-@samp{K} which you never saw, and which might accidentally contain
-spam. Best is to make sure that real spam is marked with @samp{$},
-and nothing else.
-
-@vindex gnus-ham-process-destinations
-When you leave a @emph{spam} group, all spam-marked articles are
-marked as expired after processing with the spam processor. This is
-not done for @emph{unclassified} or @emph{ham} groups. Also, any
-@strong{ham} articles in a spam group will be moved to a location
-determined by either the @code{ham-process-destination} group
-parameter or a match in the @code{gnus-ham-process-destinations}
-variable, which is a list of regular expressions matched with group
-names (it's easiest to customize this variable with @kbd{M-x
-customize-variable @key{RET} gnus-ham-process-destinations}). Each
-group name list is a standard Lisp list, if you prefer to customize
-the variable manually. If the @code{ham-process-destination}
-parameter is not set, ham articles are left in place. If the
-@code{spam-mark-ham-unread-before-move-from-spam-group} parameter is
-set, the ham articles are marked as unread before being moved.
-
-If ham can not be moved---because of a read-only backend such as
-@acronym{NNTP}, for example, it will be copied.
-
-Note that you can use multiples destinations per group or regular
-expression! This enables you to send your ham to a regular mail
-group and to a @emph{ham training} group.
-
-When you leave a @emph{ham} group, all ham-marked articles are sent to
-a ham processor, which will study these as non-spam samples.
-
-@vindex spam-process-ham-in-spam-groups
-By default the variable @code{spam-process-ham-in-spam-groups} is
-@code{nil}. Set it to @code{t} if you want ham found in spam groups
-to be processed. Normally this is not done, you are expected instead
-to send your ham to a ham group and process it there.
-
-@vindex spam-process-ham-in-nonham-groups
-By default the variable @code{spam-process-ham-in-nonham-groups} is
-@code{nil}. Set it to @code{t} if you want ham found in non-ham (spam
-or unclassified) groups to be processed. Normally this is not done,
-you are expected instead to send your ham to a ham group and process
-it there.
-
-@vindex gnus-spam-process-destinations
-When you leave a @emph{ham} or @emph{unclassified} group, all
-@strong{spam} articles are moved to a location determined by either
-the @code{spam-process-destination} group parameter or a match in the
-@code{gnus-spam-process-destinations} variable, which is a list of
-regular expressions matched with group names (it's easiest to
-customize this variable with @kbd{M-x customize-variable @key{RET}
-gnus-spam-process-destinations}). Each group name list is a standard
-Lisp list, if you prefer to customize the variable manually. If the
-@code{spam-process-destination} parameter is not set, the spam
-articles are only expired. The group name is fully qualified, meaning
-that if you see @samp{nntp:servername} before the group name in the
-group buffer then you need it here as well.
-
-If spam can not be moved---because of a read-only backend such as
-@acronym{NNTP}, for example, it will be copied.
-
-Note that you can use multiples destinations per group or regular
-expression! This enables you to send your spam to multiple @emph{spam
-training} groups.
-
-@vindex spam-log-to-registry
-The problem with processing ham and spam is that Gnus doesn't track
-this processing by default. Enable the @code{spam-log-to-registry}
-variable so @code{spam.el} will use @code{gnus-registry.el} to track
-what articles have been processed, and avoid processing articles
-multiple times. Keep in mind that if you limit the number of registry
-entries, this won't work as well as it does without a limit.
-
-@vindex spam-mark-only-unseen-as-spam
-Set this variable if you want only unseen articles in spam groups to
-be marked as spam. By default, it is set. If you set it to
-@code{nil}, unread articles will also be marked as spam.
-
-@vindex spam-mark-ham-unread-before-move-from-spam-group
-Set this variable if you want ham to be unmarked before it is moved
-out of the spam group. This is very useful when you use something
-like the tick mark @samp{!} to mark ham---the article will be placed
-in your @code{ham-process-destination}, unmarked as if it came fresh
-from the mail server.
-
-@vindex spam-autodetect-recheck-messages
-When autodetecting spam, this variable tells @code{spam.el} whether
-only unseen articles or all unread articles should be checked for
-spam. It is recommended that you leave it off.
-
-@node Spam Package Configuration Examples
-@subsection Spam Package Configuration Examples
-@cindex spam filtering
-@cindex spam filtering configuration examples
-@cindex spam configuration examples
-@cindex spam
-
-@subsubheading Ted's setup
-
-From Ted Zlatanov <tzz@@lifelogs.com>.
-@example
-;; @r{for @code{gnus-registry-split-fancy-with-parent} and spam autodetection}
-;; @r{see @file{gnus-registry.el} for more information}
-(gnus-registry-initialize)
-(spam-initialize)
-
-(setq
- spam-log-to-registry t ; @r{for spam autodetection}
- spam-use-BBDB t
- spam-use-regex-headers t ; @r{catch X-Spam-Flag (SpamAssassin)}
- ;; @r{all groups with @samp{spam} in the name contain spam}
- gnus-spam-newsgroup-contents
- '(("spam" gnus-group-spam-classification-spam))
- ;; @r{see documentation for these}
- spam-move-spam-nonspam-groups-only nil
- spam-mark-only-unseen-as-spam t
- spam-mark-ham-unread-before-move-from-spam-group t
- nnimap-split-rule 'nnimap-split-fancy
- ;; @r{understand what this does before you copy it to your own setup!}
- nnimap-split-fancy '(|
- ;; @r{trace references to parents and put in their group}
- (: gnus-registry-split-fancy-with-parent)
- ;; @r{this will catch server-side SpamAssassin tags}
- (: spam-split 'spam-use-regex-headers)
- (any "ding" "ding")
- ;; @r{note that spam by default will go to @samp{spam}}
- (: spam-split)
- ;; @r{default mailbox}
- "mail"))
-
-;; @r{my parameters, set with @kbd{G p}}
-
-;; @r{all nnml groups, and all nnimap groups except}
-;; @r{@samp{nnimap+mail.lifelogs.com:train} and}
-;; @r{@samp{nnimap+mail.lifelogs.com:spam}: any spam goes to nnimap training,}
-;; @r{because it must have been detected manually}
-
-((spam-process-destination . "nnimap+mail.lifelogs.com:train"))
-
-;; @r{all @acronym{NNTP} groups}
-;; @r{autodetect spam with the blacklist and ham with the BBDB}
-((spam-autodetect-methods spam-use-blacklist spam-use-BBDB)
-;; @r{send all spam to the training group}
- (spam-process-destination . "nnimap+mail.lifelogs.com:train"))
-
-;; @r{only some @acronym{NNTP} groups, where I want to autodetect spam}
-((spam-autodetect . t))
-
-;; @r{my nnimap @samp{nnimap+mail.lifelogs.com:spam} group}
-
-;; @r{this is a spam group}
-((spam-contents gnus-group-spam-classification-spam)
-
- ;; @r{any spam (which happens when I enter for all unseen messages,}
- ;; @r{because of the @code{gnus-spam-newsgroup-contents} setting above), goes to}
- ;; @r{@samp{nnimap+mail.lifelogs.com:train} unless I mark it as ham}
-
- (spam-process-destination "nnimap+mail.lifelogs.com:train")
-
- ;; @r{any ham goes to my @samp{nnimap+mail.lifelogs.com:mail} folder, but}
- ;; @r{also to my @samp{nnimap+mail.lifelogs.com:trainham} folder for training}
-
- (ham-process-destination "nnimap+mail.lifelogs.com:mail"
- "nnimap+mail.lifelogs.com:trainham")
- ;; @r{in this group, only @samp{!} marks are ham}
- (ham-marks
- (gnus-ticked-mark))
- ;; @r{remembers senders in the blacklist on the way out---this is}
- ;; @r{definitely not needed, it just makes me feel better}
- (spam-process (gnus-group-spam-exit-processor-blacklist)))
-
-;; @r{Later, on the @acronym{IMAP} server I use the @samp{train} group for training}
-;; @r{SpamAssassin to recognize spam, and the @samp{trainham} group fora}
-;; @r{recognizing ham---but Gnus has nothing to do with it.}
-
-@end example
-
-@subsubheading Using @file{spam.el} on an IMAP server with a statistical filter on the server
-From Reiner Steib <reiner.steib@@gmx.de>.
-
-My provider has set up bogofilter (in combination with @acronym{DCC}) on
-the mail server (@acronym{IMAP}). Recognized spam goes to
-@samp{spam.detected}, the rest goes through the normal filter rules,
-i.e. to @samp{some.folder} or to @samp{INBOX}. Training on false
-positives or negatives is done by copying or moving the article to
-@samp{training.ham} or @samp{training.spam} respectively. A cron job on
-the server feeds those to bogofilter with the suitable ham or spam
-options and deletes them from the @samp{training.ham} and
-@samp{training.spam} folders.
-
-With the following entries in @code{gnus-parameters}, @code{spam.el}
-does most of the job for me:
-
-@lisp
- ("nnimap:spam\\.detected"
- (gnus-article-sort-functions '(gnus-article-sort-by-chars))
- (ham-process-destination "nnimap:INBOX" "nnimap:training.ham")
- (spam-contents gnus-group-spam-classification-spam))
- ("nnimap:\\(INBOX\\|other-folders\\)"
- (spam-process-destination . "nnimap:training.spam")
- (spam-contents gnus-group-spam-classification-ham))
-@end lisp
-
-@itemize
-
-@item @b{The Spam folder:}
-
-In the folder @samp{spam.detected}, I have to check for false positives
-(i.e. legitimate mails, that were wrongly judged as spam by
-bogofilter or DCC).
-
-Because of the @code{gnus-group-spam-classification-spam} entry, all
-messages are marked as spam (with @code{$}). When I find a false
-positive, I mark the message with some other ham mark
-(@code{ham-marks}, @ref{Spam and Ham Processors}). On group exit,
-those messages are copied to both groups, @samp{INBOX} (where I want
-to have the article) and @samp{training.ham} (for training bogofilter)
-and deleted from the @samp{spam.detected} folder.
-
-The @code{gnus-article-sort-by-chars} entry simplifies detection of
-false positives for me. I receive lots of worms (sweN, @dots{}), that all
-have a similar size. Grouping them by size (i.e. chars) makes finding
-other false positives easier. (Of course worms aren't @i{spam}
-(@acronym{UCE}, @acronym{UBE}) strictly speaking. Anyhow, bogofilter is
-an excellent tool for filtering those unwanted mails for me.)
-
-@item @b{Ham folders:}
-
-In my ham folders, I just hit @kbd{S x}
-(@code{gnus-summary-mark-as-spam}) whenever I see an unrecognized spam
-mail (false negative). On group exit, those messages are moved to
-@samp{training.ham}.
-@end itemize
-
-@subsubheading Reporting spam articles in Gmane groups with @code{spam-report.el}
-
-From Reiner Steib <reiner.steib@@gmx.de>.
-
-With following entry in @code{gnus-parameters}, @kbd{S x}
-(@code{gnus-summary-mark-as-spam}) marks articles in @code{gmane.*}
-groups as spam and reports the to Gmane at group exit:
-
-@lisp
- ("^gmane\\."
- (spam-process (gnus-group-spam-exit-processor-report-gmane)))
-@end lisp
-
-Additionally, I use @code{(setq spam-report-gmane-use-article-number nil)}
-because I don't read the groups directly from news.gmane.org, but
-through my local news server (leafnode). I.e. the article numbers are
-not the same as on news.gmane.org, thus @code{spam-report.el} has to check
-the @code{X-Report-Spam} header to find the correct number.
-
-@node Spam Back Ends
-@subsection Spam Back Ends
-@cindex spam back ends
-
-The spam package offers a variety of back ends for detecting spam.
-Each back end defines a set of methods for detecting spam
-(@pxref{Filtering Incoming Mail}, @pxref{Detecting Spam in Groups}),
-and a pair of spam and ham processors (@pxref{Spam and Ham
-Processors}).
-
-@menu
-* Blacklists and Whitelists::
-* BBDB Whitelists::
-* Gmane Spam Reporting::
-* Anti-spam Hashcash Payments::
-* Blackholes::
-* Regular Expressions Header Matching::
-* Bogofilter::
-* ifile spam filtering::
-* Spam Statistics Filtering::
-* SpamOracle::
-@end menu
-
-@node Blacklists and Whitelists
-@subsubsection Blacklists and Whitelists
-@cindex spam filtering
-@cindex whitelists, spam filtering
-@cindex blacklists, spam filtering
-@cindex spam
-
-@defvar spam-use-blacklist
-
-Set this variable to @code{t} if you want to use blacklists when
-splitting incoming mail. Messages whose senders are in the blacklist
-will be sent to the @code{spam-split-group}. This is an explicit
-filter, meaning that it acts only on mail senders @emph{declared} to
-be spammers.
-
-@end defvar
-
-@defvar spam-use-whitelist
-
-Set this variable to @code{t} if you want to use whitelists when
-splitting incoming mail. Messages whose senders are not in the
-whitelist will be sent to the next spam-split rule. This is an
-explicit filter, meaning that unless someone is in the whitelist, their
-messages are not assumed to be spam or ham.
-
-@end defvar
-
-@defvar spam-use-whitelist-exclusive
-
-Set this variable to @code{t} if you want to use whitelists as an
-implicit filter, meaning that every message will be considered spam
-unless the sender is in the whitelist. Use with care.
-
-@end defvar
-
-@defvar gnus-group-spam-exit-processor-blacklist
-
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the senders of
-spam-marked articles will be added to the blacklist.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-spam-exit-processor-blacklist}, it is recommended
-that you use @code{'(spam spam-use-blacklist)}. Everything will work
-the same way, we promise.
-
-@end defvar
-
-@defvar gnus-group-ham-exit-processor-whitelist
-
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the senders of
-ham-marked articles in @emph{ham} groups will be added to the
-whitelist. Note that this ham processor has no effect in @emph{spam}
-or @emph{unclassified} groups.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-ham-exit-processor-whitelist}, it is recommended
-that you use @code{'(ham spam-use-whitelist)}. Everything will work
-the same way, we promise.
-
-@end defvar
-
-Blacklists are lists of regular expressions matching addresses you
-consider to be spam senders. For instance, to block mail from any
-sender at @samp{vmadmin.com}, you can put @samp{vmadmin.com} in your
-blacklist. You start out with an empty blacklist. Blacklist entries
-use the Emacs regular expression syntax.
-
-Conversely, whitelists tell Gnus what addresses are considered
-legitimate. All messages from whitelisted addresses are considered
-non-spam. Also see @ref{BBDB Whitelists}. Whitelist entries use the
-Emacs regular expression syntax.
-
-The blacklist and whitelist file locations can be customized with the
-@code{spam-directory} variable (@file{~/News/spam} by default), or
-the @code{spam-whitelist} and @code{spam-blacklist} variables
-directly. The whitelist and blacklist files will by default be in the
-@code{spam-directory} directory, named @file{whitelist} and
-@file{blacklist} respectively.
-
-@node BBDB Whitelists
-@subsubsection BBDB Whitelists
-@cindex spam filtering
-@cindex BBDB whitelists, spam filtering
-@cindex BBDB, spam filtering
-@cindex spam
-
-@defvar spam-use-BBDB
-
-Analogous to @code{spam-use-whitelist} (@pxref{Blacklists and
-Whitelists}), but uses the BBDB as the source of whitelisted
-addresses, without regular expressions. You must have the BBDB loaded
-for @code{spam-use-BBDB} to work properly. Messages whose senders are
-not in the BBDB will be sent to the next spam-split rule. This is an
-explicit filter, meaning that unless someone is in the BBDB, their
-messages are not assumed to be spam or ham.
-
-@end defvar
-
-@defvar spam-use-BBDB-exclusive
-
-Set this variable to @code{t} if you want to use the BBDB as an
-implicit filter, meaning that every message will be considered spam
-unless the sender is in the BBDB. Use with care. Only sender
-addresses in the BBDB will be allowed through; all others will be
-classified as spammers.
-
-@end defvar
-
-@defvar gnus-group-ham-exit-processor-BBDB
-
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the senders of
-ham-marked articles in @emph{ham} groups will be added to the
-BBDB. Note that this ham processor has no effect in @emph{spam}
-or @emph{unclassified} groups.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-ham-exit-processor-BBDB}, it is recommended
-that you use @code{'(ham spam-use-BBDB)}. Everything will work
-the same way, we promise.
-
-@end defvar
-
-@node Gmane Spam Reporting
-@subsubsection Gmane Spam Reporting
-@cindex spam reporting
-@cindex Gmane, spam reporting
-@cindex Gmane, spam reporting
-@cindex spam
-
-@defvar gnus-group-spam-exit-processor-report-gmane
-
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the spam-marked
-articles groups will be reported to the Gmane administrators via a
-HTTP request.
-
-Gmane can be found at @uref{http://gmane.org}.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-spam-exit-processor-report-gmane}, it is recommended
-that you use @code{'(spam spam-use-gmane)}. Everything will work the
-same way, we promise.
-
-@end defvar
-
-@defvar spam-report-gmane-use-article-number
-
-This variable is @code{t} by default. Set it to @code{nil} if you are
-running your own news server, for instance, and the local article
-numbers don't correspond to the Gmane article numbers. When
-@code{spam-report-gmane-use-article-number} is @code{nil},
-@code{spam-report.el} will use the @code{X-Report-Spam} header that
-Gmane provides.
-
-@end defvar
-
-@node Anti-spam Hashcash Payments
-@subsubsection Anti-spam Hashcash Payments
-@cindex spam filtering
-@cindex hashcash, spam filtering
-@cindex spam
-
-@defvar spam-use-hashcash
-
-Similar to @code{spam-use-whitelist} (@pxref{Blacklists and
-Whitelists}), but uses hashcash tokens for whitelisting messages
-instead of the sender address. You must have the @code{hashcash.el}
-package loaded for @code{spam-use-hashcash} to work properly.
-Messages without a hashcash payment token will be sent to the next
-spam-split rule. This is an explicit filter, meaning that unless a
-hashcash token is found, the messages are not assumed to be spam or
-ham.
-
-@end defvar
-
-@node Blackholes
-@subsubsection Blackholes
-@cindex spam filtering
-@cindex blackholes, spam filtering
-@cindex spam
-
-@defvar spam-use-blackholes
-
-This option is disabled by default. You can let Gnus consult the
-blackhole-type distributed spam processing systems (DCC, for instance)
-when you set this option. The variable @code{spam-blackhole-servers}
-holds the list of blackhole servers Gnus will consult. The current
-list is fairly comprehensive, but make sure to let us know if it
-contains outdated servers.
-
-The blackhole check uses the @code{dig.el} package, but you can tell
-@file{spam.el} to use @code{dns.el} instead for better performance if
-you set @code{spam-use-dig} to @code{nil}. It is not recommended at
-this time to set @code{spam-use-dig} to @code{nil} despite the
-possible performance improvements, because some users may be unable to
-use it, but you can try it and see if it works for you.
-
-@end defvar
-
-@defvar spam-blackhole-servers
-
-The list of servers to consult for blackhole checks.
-
-@end defvar
-
-@defvar spam-blackhole-good-server-regex
-
-A regular expression for IPs that should not be checked against the
-blackhole server list. When set to @code{nil}, it has no effect.
-
-@end defvar
-
-@defvar spam-use-dig
-
-Use the @code{dig.el} package instead of the @code{dns.el} package.
-The default setting of @code{t} is recommended.
-
-@end defvar
-
-Blackhole checks are done only on incoming mail. There is no spam or
-ham processor for blackholes.
-
-@node Regular Expressions Header Matching
-@subsubsection Regular Expressions Header Matching
-@cindex spam filtering
-@cindex regular expressions header matching, spam filtering
-@cindex spam
-
-@defvar spam-use-regex-headers
-
-This option is disabled by default. You can let Gnus check the
-message headers against lists of regular expressions when you set this
-option. The variables @code{spam-regex-headers-spam} and
-@code{spam-regex-headers-ham} hold the list of regular expressions.
-Gnus will check against the message headers to determine if the
-message is spam or ham, respectively.
-
-@end defvar
-
-@defvar spam-regex-headers-spam
-
-The list of regular expressions that, when matched in the headers of
-the message, positively identify it as spam.
-
-@end defvar
-
-@defvar spam-regex-headers-ham
-
-The list of regular expressions that, when matched in the headers of
-the message, positively identify it as ham.
-
-@end defvar
-
-Regular expression header checks are done only on incoming mail.
-There is no specific spam or ham processor for regular expressions.
-
-@node Bogofilter
-@subsubsection Bogofilter
-@cindex spam filtering
-@cindex bogofilter, spam filtering
-@cindex spam
-
-@defvar spam-use-bogofilter
-
-Set this variable if you want @code{spam-split} to use Eric Raymond's
-speedy Bogofilter.
-
-With a minimum of care for associating the @samp{$} mark for spam
-articles only, Bogofilter training all gets fairly automatic. You
-should do this until you get a few hundreds of articles in each
-category, spam or not. The command @kbd{S t} in summary mode, either
-for debugging or for curiosity, shows the @emph{spamicity} score of
-the current article (between 0.0 and 1.0).
-
-Bogofilter determines if a message is spam based on a specific
-threshold. That threshold can be customized, consult the Bogofilter
-documentation.
-
-If the @code{bogofilter} executable is not in your path, Bogofilter
-processing will be turned off.
-
-You should not enable this if you use @code{spam-use-bogofilter-headers}.
-
-@end defvar
-
-@table @kbd
-@item M s t
-@itemx S t
-@kindex M s t
-@kindex S t
-@findex spam-bogofilter-score
-Get the Bogofilter spamicity score (@code{spam-bogofilter-score}).
-@end table
-
-@defvar spam-use-bogofilter-headers
-
-Set this variable if you want @code{spam-split} to use Eric Raymond's
-speedy Bogofilter, looking only at the message headers. It works
-similarly to @code{spam-use-bogofilter}, but the @code{X-Bogosity} header
-must be in the message already. Normally you would do this with a
-procmail recipe or something similar; consult the Bogofilter
-installation documents for details.
-
-You should not enable this if you use @code{spam-use-bogofilter}.
-
-@end defvar
-
-@defvar gnus-group-spam-exit-processor-bogofilter
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, spam-marked articles
-will be added to the Bogofilter spam database.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-spam-exit-processor-bogofilter}, it is recommended
-that you use @code{'(spam spam-use-bogofilter)}. Everything will work
-the same way, we promise.
-@end defvar
-
-@defvar gnus-group-ham-exit-processor-bogofilter
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the ham-marked
-articles in @emph{ham} groups will be added to the Bogofilter database
-of non-spam messages. Note that this ham processor has no effect in
-@emph{spam} or @emph{unclassified} groups.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-ham-exit-processor-bogofilter}, it is recommended
-that you use @code{'(ham spam-use-bogofilter)}. Everything will work
-the same way, we promise.
-@end defvar
-
-@defvar spam-bogofilter-database-directory
-
-This is the directory where Bogofilter will store its databases. It
-is not specified by default, so Bogofilter will use its own default
-database directory.
-
-@end defvar
-
-The Bogofilter mail classifier is similar to @command{ifile} in intent and
-purpose. A ham and a spam processor are provided, plus the
-@code{spam-use-bogofilter} and @code{spam-use-bogofilter-headers}
-variables to indicate to spam-split that Bogofilter should either be
-used, or has already been used on the article. The 0.9.2.1 version of
-Bogofilter was used to test this functionality.
-
-@node ifile spam filtering
-@subsubsection ifile spam filtering
-@cindex spam filtering
-@cindex ifile, spam filtering
-@cindex spam
-
-@defvar spam-use-ifile
-
-Enable this variable if you want @code{spam-split} to use @command{ifile}, a
-statistical analyzer similar to Bogofilter.
-
-@end defvar
-
-@defvar spam-ifile-all-categories
-
-Enable this variable if you want @code{spam-use-ifile} to give you all
-the ifile categories, not just spam/non-spam. If you use this, make
-sure you train ifile as described in its documentation.
-
-@end defvar
-
-@defvar spam-ifile-spam-category
-
-This is the category of spam messages as far as ifile is concerned.
-The actual string used is irrelevant, but you probably want to leave
-the default value of @samp{spam}.
-@end defvar
-
-@defvar spam-ifile-database
-
-This is the filename for the ifile database. It is not specified by
-default, so ifile will use its own default database name.
-
-@end defvar
-
-The ifile mail classifier is similar to Bogofilter in intent and
-purpose. A ham and a spam processor are provided, plus the
-@code{spam-use-ifile} variable to indicate to spam-split that ifile
-should be used. The 1.2.1 version of ifile was used to test this
-functionality.
-
-@node Spam Statistics Filtering
-@subsubsection Spam Statistics Filtering
-@cindex spam filtering
-@cindex spam-stat, spam filtering
-@cindex spam-stat
-@cindex spam
-
-This back end uses the Spam Statistics Emacs Lisp package to perform
-statistics-based filtering (@pxref{Spam Statistics Package}). Before
-using this, you may want to perform some additional steps to
-initialize your Spam Statistics dictionary. @xref{Creating a
-spam-stat dictionary}.
-
-@defvar spam-use-stat
-
-@end defvar
-
-@defvar gnus-group-spam-exit-processor-stat
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the spam-marked
-articles will be added to the spam-stat database of spam messages.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-spam-exit-processor-stat}, it is recommended
-that you use @code{'(spam spam-use-stat)}. Everything will work
-the same way, we promise.
-@end defvar
-
-@defvar gnus-group-ham-exit-processor-stat
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameters or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is
-added to a group's @code{spam-process} parameter, the ham-marked
-articles in @emph{ham} groups will be added to the spam-stat database
-of non-spam messages. Note that this ham processor has no effect in
-@emph{spam} or @emph{unclassified} groups.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-ham-exit-processor-stat}, it is recommended
-that you use @code{'(ham spam-use-stat)}. Everything will work
-the same way, we promise.
-@end defvar
-
-This enables @file{spam.el} to cooperate with @file{spam-stat.el}.
-@file{spam-stat.el} provides an internal (Lisp-only) spam database,
-which unlike ifile or Bogofilter does not require external programs.
-A spam and a ham processor, and the @code{spam-use-stat} variable for
-@code{spam-split} are provided.
-
-@node SpamOracle
-@subsubsection Using SpamOracle with Gnus
-@cindex spam filtering
-@cindex SpamOracle
-@cindex spam
-
-An easy way to filter out spam is to use SpamOracle. SpamOracle is an
-statistical mail filtering tool written by Xavier Leroy and needs to be
-installed separately.
-
-There are several ways to use SpamOracle with Gnus. In all cases, your
-mail is piped through SpamOracle in its @emph{mark} mode. SpamOracle will
-then enter an @samp{X-Spam} header indicating whether it regards the
-mail as a spam mail or not.
-
-One possibility is to run SpamOracle as a @code{:prescript} from the
-@xref{Mail Source Specifiers}, (@pxref{SpamAssassin}). This method has
-the advantage that the user can see the @emph{X-Spam} headers.
-
-The easiest method is to make @file{spam.el} (@pxref{Spam Package})
-call SpamOracle.
-
-@vindex spam-use-spamoracle
-To enable SpamOracle usage by @file{spam.el}, set the variable
-@code{spam-use-spamoracle} to @code{t} and configure the
-@code{nnmail-split-fancy} or @code{nnimap-split-fancy}. @xref{Spam
-Package}. In this example the @samp{INBOX} of an nnimap server is
-filtered using SpamOracle. Mails recognized as spam mails will be
-moved to @code{spam-split-group}, @samp{Junk} in this case. Ham
-messages stay in @samp{INBOX}:
-
-@example
-(setq spam-use-spamoracle t
- spam-split-group "Junk"
- nnimap-split-inbox '("INBOX")
- nnimap-split-rule 'nnimap-split-fancy
- nnimap-split-fancy '(| (: spam-split) "INBOX"))
-@end example
-
-@defvar spam-use-spamoracle
-Set to @code{t} if you want Gnus to enable spam filtering using
-SpamOracle.
-@end defvar
-
-@defvar spam-spamoracle-binary
-Gnus uses the SpamOracle binary called @file{spamoracle} found in the
-user's PATH. Using the variable @code{spam-spamoracle-binary}, this
-can be customized.
-@end defvar
-
-@defvar spam-spamoracle-database
-By default, SpamOracle uses the file @file{~/.spamoracle.db} as a database to
-store its analysis. This is controlled by the variable
-@code{spam-spamoracle-database} which defaults to @code{nil}. That means
-the default SpamOracle database will be used. In case you want your
-database to live somewhere special, set
-@code{spam-spamoracle-database} to this path.
-@end defvar
-
-SpamOracle employs a statistical algorithm to determine whether a
-message is spam or ham. In order to get good results, meaning few
-false hits or misses, SpamOracle needs training. SpamOracle learns
-the characteristics of your spam mails. Using the @emph{add} mode
-(training mode) one has to feed good (ham) and spam mails to
-SpamOracle. This can be done by pressing @kbd{|} in the Summary
-buffer and pipe the mail to a SpamOracle process or using
-@file{spam.el}'s spam- and ham-processors, which is much more
-convenient. For a detailed description of spam- and ham-processors,
-@xref{Spam Package}.
-
-@defvar gnus-group-spam-exit-processor-spamoracle
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameter or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is added
-to a group's @code{spam-process} parameter, spam-marked articles will be
-sent to SpamOracle as spam samples.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-spam-exit-processor-spamoracle}, it is recommended
-that you use @code{'(spam spam-use-spamoracle)}. Everything will work
-the same way, we promise.
-@end defvar
-
-@defvar gnus-group-ham-exit-processor-spamoracle
-Add this symbol to a group's @code{spam-process} parameter by
-customizing the group parameter or the
-@code{gnus-spam-process-newsgroups} variable. When this symbol is added
-to a group's @code{spam-process} parameter, the ham-marked articles in
-@emph{ham} groups will be sent to the SpamOracle as samples of ham
-messages. Note that this ham processor has no effect in @emph{spam} or
-@emph{unclassified} groups.
-
-@emph{WARNING}
-
-Instead of the obsolete
-@code{gnus-group-ham-exit-processor-spamoracle}, it is recommended
-that you use @code{'(ham spam-use-spamoracle)}. Everything will work
-the same way, we promise.
-@end defvar
-
-@emph{Example:} These are the Group Parameters of a group that has been
-classified as a ham group, meaning that it should only contain ham
-messages.
-@example
- ((spam-contents gnus-group-spam-classification-ham)
- (spam-process ((ham spam-use-spamoracle)
- (spam spam-use-spamoracle))))
-@end example
-For this group the @code{spam-use-spamoracle} is installed for both
-ham and spam processing. If the group contains spam message
-(e.g. because SpamOracle has not had enough sample messages yet) and
-the user marks some messages as spam messages, these messages will be
-processed by SpamOracle. The processor sends the messages to
-SpamOracle as new samples for spam.
-
-@node Extending the Spam package
-@subsection Extending the Spam package
-@cindex spam filtering
-@cindex spam elisp package, extending
-@cindex extending the spam elisp package
-
-Say you want to add a new back end called blackbox. For filtering
-incoming mail, provide the following:
-
-@enumerate
-
-@item
-Code
-
-@lisp
-(defvar spam-use-blackbox nil
- "True if blackbox should be used.")
-@end lisp
-
-Add
-@lisp
-(spam-use-blackbox . spam-check-blackbox)
-@end lisp
-to @code{spam-list-of-checks}.
-
-Add
-@lisp
-(gnus-group-ham-exit-processor-blackbox ham spam-use-blackbox)
-(gnus-group-spam-exit-processor-blackbox spam spam-use-blackbox)
-@end lisp
-
-to @code{spam-list-of-processors}.
-
-Add
-@lisp
-(spam-use-blackbox spam-blackbox-register-routine
- nil
- spam-blackbox-unregister-routine
- nil)
-@end lisp
-
-to @code{spam-registration-functions}. Write the register/unregister
-routines using the bogofilter register/unregister routines as a
-start, or other register/unregister routines more appropriate to
-Blackbox.
-
-@item
-Functionality
-
-Write the @code{spam-check-blackbox} function. It should return
-@samp{nil} or @code{spam-split-group}, observing the other
-conventions. See the existing @code{spam-check-*} functions for
-examples of what you can do, and stick to the template unless you
-fully understand the reasons why you aren't.
-
-Make sure to add @code{spam-use-blackbox} to
-@code{spam-list-of-statistical-checks} if Blackbox is a statistical
-mail analyzer that needs the full message body to operate.
-
-@end enumerate
-
-For processing spam and ham messages, provide the following:
-
-@enumerate
-
-@item
-Code
-
-Note you don't have to provide a spam or a ham processor. Only
-provide them if Blackbox supports spam or ham processing.
-
-Also, ham and spam processors are being phased out as single
-variables. Instead the form @code{'(spam spam-use-blackbox)} or
-@code{'(ham spam-use-blackbox)} is favored. For now, spam/ham
-processor variables are still around but they won't be for long.
-
-@lisp
-(defvar gnus-group-spam-exit-processor-blackbox "blackbox-spam"
- "The Blackbox summary exit spam processor.
-Only applicable to spam groups.")
-
-(defvar gnus-group-ham-exit-processor-blackbox "blackbox-ham"
- "The whitelist summary exit ham processor.
-Only applicable to non-spam (unclassified and ham) groups.")
-
-@end lisp
-
-@item
-Gnus parameters
-
-Add
-@lisp
-(const :tag "Spam: Blackbox" (spam spam-use-blackbox))
-(const :tag "Ham: Blackbox" (ham spam-use-blackbox))
-@end lisp
-to the @code{spam-process} group parameter in @code{gnus.el}. Make
-sure you do it twice, once for the parameter and once for the
-variable customization.
-
-Add
-@lisp
-(variable-item spam-use-blackbox)
-@end lisp
-to the @code{spam-autodetect-methods} group parameter in
-@code{gnus.el}.
-
-@end enumerate
-
-@node Spam Statistics Package
-@subsection Spam Statistics Package
-@cindex Paul Graham
-@cindex Graham, Paul
-@cindex naive Bayesian spam filtering
-@cindex Bayesian spam filtering, naive
-@cindex spam filtering, naive Bayesian
-
-Paul Graham has written an excellent essay about spam filtering using
-statistics: @uref{http://www.paulgraham.com/spam.html,A Plan for
-Spam}. In it he describes the inherent deficiency of rule-based
-filtering as used by SpamAssassin, for example: Somebody has to write
-the rules, and everybody else has to install these rules. You are
-always late. It would be much better, he argues, to filter mail based
-on whether it somehow resembles spam or non-spam. One way to measure
-this is word distribution. He then goes on to describe a solution
-that checks whether a new mail resembles any of your other spam mails
-or not.
-
-The basic idea is this: Create a two collections of your mail, one
-with spam, one with non-spam. Count how often each word appears in
-either collection, weight this by the total number of mails in the
-collections, and store this information in a dictionary. For every
-word in a new mail, determine its probability to belong to a spam or a
-non-spam mail. Use the 15 most conspicuous words, compute the total
-probability of the mail being spam. If this probability is higher
-than a certain threshold, the mail is considered to be spam.
-
-The Spam Statistics package adds support to Gnus for this kind of
-filtering. It can be used as one of the back ends of the Spam package
-(@pxref{Spam Package}), or by itself.
-
-Before using the Spam Statistics package, you need to set it up.
-First, you need two collections of your mail, one with spam, one with
-non-spam. Then you need to create a dictionary using these two
-collections, and save it. And last but not least, you need to use
-this dictionary in your fancy mail splitting rules.
-
-@menu
-* Creating a spam-stat dictionary::
-* Splitting mail using spam-stat::
-* Low-level interface to the spam-stat dictionary::
-@end menu
-
-@node Creating a spam-stat dictionary
-@subsubsection Creating a spam-stat dictionary
-
-Before you can begin to filter spam based on statistics, you must
-create these statistics based on two mail collections, one with spam,
-one with non-spam. These statistics are then stored in a dictionary
-for later use. In order for these statistics to be meaningful, you
-need several hundred emails in both collections.
-
-Gnus currently supports only the nnml back end for automated dictionary
-creation. The nnml back end stores all mails in a directory, one file
-per mail. Use the following:
-
-@defun spam-stat-process-spam-directory
-Create spam statistics for every file in this directory. Every file
-is treated as one spam mail.
-@end defun
-
-@defun spam-stat-process-non-spam-directory
-Create non-spam statistics for every file in this directory. Every
-file is treated as one non-spam mail.
-@end defun
-
-Usually you would call @code{spam-stat-process-spam-directory} on a
-directory such as @file{~/Mail/mail/spam} (this usually corresponds to
-the group @samp{nnml:mail.spam}), and you would call
-@code{spam-stat-process-non-spam-directory} on a directory such as
-@file{~/Mail/mail/misc} (this usually corresponds to the group
-@samp{nnml:mail.misc}).
-
-When you are using @acronym{IMAP}, you won't have the mails available
-locally, so that will not work. One solution is to use the Gnus Agent
-to cache the articles. Then you can use directories such as
-@file{"~/News/agent/nnimap/mail.yourisp.com/personal_spam"} for
-@code{spam-stat-process-spam-directory}. @xref{Agent as Cache}.
-
-@defvar spam-stat
-This variable holds the hash-table with all the statistics---the
-dictionary we have been talking about. For every word in either
-collection, this hash-table stores a vector describing how often the
-word appeared in spam and often it appeared in non-spam mails.
-@end defvar
-
-If you want to regenerate the statistics from scratch, you need to
-reset the dictionary.
-
-@defun spam-stat-reset
-Reset the @code{spam-stat} hash-table, deleting all the statistics.
-@end defun
-
-When you are done, you must save the dictionary. The dictionary may
-be rather large. If you will not update the dictionary incrementally
-(instead, you will recreate it once a month, for example), then you
-can reduce the size of the dictionary by deleting all words that did
-not appear often enough or that do not clearly belong to only spam or
-only non-spam mails.
-
-@defun spam-stat-reduce-size
-Reduce the size of the dictionary. Use this only if you do not want
-to update the dictionary incrementally.
-@end defun
-
-@defun spam-stat-save
-Save the dictionary.
-@end defun
-
-@defvar spam-stat-file
-The filename used to store the dictionary. This defaults to
-@file{~/.spam-stat.el}.
-@end defvar
-
-@node Splitting mail using spam-stat
-@subsubsection Splitting mail using spam-stat
-
-This section describes how to use the Spam statistics
-@emph{independently} of the @xref{Spam Package}.
-
-First, add the following to your @file{~/.gnus.el} file:
-
-@lisp
-(require 'spam-stat)
-(spam-stat-load)
-@end lisp
-
-This will load the necessary Gnus code, and the dictionary you
-created.
-
-Next, you need to adapt your fancy splitting rules: You need to
-determine how to use @code{spam-stat}. The following examples are for
-the nnml back end. Using the nnimap back end works just as well. Just
-use @code{nnimap-split-fancy} instead of @code{nnmail-split-fancy}.
-
-In the simplest case, you only have two groups, @samp{mail.misc} and
-@samp{mail.spam}. The following expression says that mail is either
-spam or it should go into @samp{mail.misc}. If it is spam, then
-@code{spam-stat-split-fancy} will return @samp{mail.spam}.
-
-@lisp
-(setq nnmail-split-fancy
- `(| (: spam-stat-split-fancy)
- "mail.misc"))
-@end lisp
-
-@defvar spam-stat-split-fancy-spam-group
-The group to use for spam. Default is @samp{mail.spam}.
-@end defvar
-
-If you also filter mail with specific subjects into other groups, use
-the following expression. Only mails not matching the regular
-expression are considered potential spam.
-
-@lisp
-(setq nnmail-split-fancy
- `(| ("Subject" "\\bspam-stat\\b" "mail.emacs")
- (: spam-stat-split-fancy)
- "mail.misc"))
-@end lisp
-
-If you want to filter for spam first, then you must be careful when
-creating the dictionary. Note that @code{spam-stat-split-fancy} must
-consider both mails in @samp{mail.emacs} and in @samp{mail.misc} as
-non-spam, therefore both should be in your collection of non-spam
-mails, when creating the dictionary!
-
-@lisp
-(setq nnmail-split-fancy
- `(| (: spam-stat-split-fancy)
- ("Subject" "\\bspam-stat\\b" "mail.emacs")
- "mail.misc"))
-@end lisp
-
-You can combine this with traditional filtering. Here, we move all
-HTML-only mails into the @samp{mail.spam.filtered} group. Note that since
-@code{spam-stat-split-fancy} will never see them, the mails in
-@samp{mail.spam.filtered} should be neither in your collection of spam mails,
-nor in your collection of non-spam mails, when creating the
-dictionary!
-
-@lisp
-(setq nnmail-split-fancy
- `(| ("Content-Type" "text/html" "mail.spam.filtered")
- (: spam-stat-split-fancy)
- ("Subject" "\\bspam-stat\\b" "mail.emacs")
- "mail.misc"))
-@end lisp
-
-
-@node Low-level interface to the spam-stat dictionary
-@subsubsection Low-level interface to the spam-stat dictionary
-
-The main interface to using @code{spam-stat}, are the following functions:
-
-@defun spam-stat-buffer-is-spam
-Called in a buffer, that buffer is considered to be a new spam mail.
-Use this for new mail that has not been processed before.
-@end defun
-
-@defun spam-stat-buffer-is-no-spam
-Called in a buffer, that buffer is considered to be a new non-spam
-mail. Use this for new mail that has not been processed before.
-@end defun
-
-@defun spam-stat-buffer-change-to-spam
-Called in a buffer, that buffer is no longer considered to be normal
-mail but spam. Use this to change the status of a mail that has
-already been processed as non-spam.
-@end defun
-
-@defun spam-stat-buffer-change-to-non-spam
-Called in a buffer, that buffer is no longer considered to be spam but
-normal mail. Use this to change the status of a mail that has already
-been processed as spam.
-@end defun
-
-@defun spam-stat-save
-Save the hash table to the file. The filename used is stored in the
-variable @code{spam-stat-file}.
-@end defun
-
-@defun spam-stat-load
-Load the hash table from a file. The filename used is stored in the
-variable @code{spam-stat-file}.
-@end defun
-
-@defun spam-stat-score-word
-Return the spam score for a word.
-@end defun
-
-@defun spam-stat-score-buffer
-Return the spam score for a buffer.
-@end defun
-
-@defun spam-stat-split-fancy
-Use this function for fancy mail splitting. Add the rule @samp{(:
-spam-stat-split-fancy)} to @code{nnmail-split-fancy}
-@end defun
-
-Make sure you load the dictionary before using it. This requires the
-following in your @file{~/.gnus.el} file:
-
-@lisp
-(require 'spam-stat)
-(spam-stat-load)
-@end lisp
-
-Typical test will involve calls to the following functions:
-
-@smallexample
-Reset: (setq spam-stat (make-hash-table :test 'equal))
-Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
-Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
-Save table: (spam-stat-save)
-File size: (nth 7 (file-attributes spam-stat-file))
-Number of words: (hash-table-count spam-stat)
-Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
-Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
-Reduce table size: (spam-stat-reduce-size)
-Save table: (spam-stat-save)
-File size: (nth 7 (file-attributes spam-stat-file))
-Number of words: (hash-table-count spam-stat)
-Test spam: (spam-stat-test-directory "~/Mail/mail/spam")
-Test non-spam: (spam-stat-test-directory "~/Mail/mail/misc")
-@end smallexample
-
-Here is how you would create your dictionary:
-
-@smallexample
-Reset: (setq spam-stat (make-hash-table :test 'equal))
-Learn spam: (spam-stat-process-spam-directory "~/Mail/mail/spam")
-Learn non-spam: (spam-stat-process-non-spam-directory "~/Mail/mail/misc")
-Repeat for any other non-spam group you need...
-Reduce table size: (spam-stat-reduce-size)
-Save table: (spam-stat-save)
-@end smallexample
-
-@node Other modes
-@section Interaction with other modes
-
-@subsection Dired
-@cindex dired
-
-@code{gnus-dired-minor-mode} provides some useful functions for dired
-buffers. It is enabled with
-@lisp
-(add-hook 'dired-mode-hook 'turn-on-gnus-dired-mode)
-@end lisp
-
-@table @kbd
-@item C-c C-m C-a
-@findex gnus-dired-attach
-@cindex attachments, selection via dired
-Send dired's marked files as an attachment (@code{gnus-dired-attach}).
-You will be prompted for a message buffer.
-
-@item C-c C-m C-l
-@findex gnus-dired-find-file-mailcap
-Visit a file according to the appropriate mailcap entry
-(@code{gnus-dired-find-file-mailcap}). With prefix, open file in a new
-buffer.
-
-@item C-c C-m C-p
-@findex gnus-dired-print
-Print file according to the mailcap entry (@code{gnus-dired-print}). If
-there is no print command, print in a PostScript image.
-@end table
-
-@node Various Various
-@section Various Various
-@cindex mode lines
-@cindex highlights
-
-@table @code
-
-@item gnus-home-directory
-@vindex gnus-home-directory
-All Gnus file and directory variables will be initialized from this
-variable, which defaults to @file{~/}.
-
-@item gnus-directory
-@vindex gnus-directory
-Most Gnus storage file and directory variables will be initialized from
-this variable, which defaults to the @env{SAVEDIR} environment
-variable, or @file{~/News/} if that variable isn't set.
-
-Note that Gnus is mostly loaded when the @file{~/.gnus.el} file is read.
-This means that other directory variables that are initialized from this
-variable won't be set properly if you set this variable in
-@file{~/.gnus.el}. Set this variable in @file{.emacs} instead.
-
-@item gnus-default-directory
-@vindex gnus-default-directory
-Not related to the above variable at all---this variable says what the
-default directory of all Gnus buffers should be. If you issue commands
-like @kbd{C-x C-f}, the prompt you'll get starts in the current buffer's
-default directory. If this variable is @code{nil} (which is the
-default), the default directory will be the default directory of the
-buffer you were in when you started Gnus.
-
-@item gnus-verbose
-@vindex gnus-verbose
-This variable is an integer between zero and ten. The higher the value,
-the more messages will be displayed. If this variable is zero, Gnus
-will never flash any messages, if it is seven (which is the default),
-most important messages will be shown, and if it is ten, Gnus won't ever
-shut up, but will flash so many messages it will make your head swim.
-
-@item gnus-verbose-backends
-@vindex gnus-verbose-backends
-This variable works the same way as @code{gnus-verbose}, but it applies
-to the Gnus back ends instead of Gnus proper.
-
-@item nnheader-max-head-length
-@vindex nnheader-max-head-length
-When the back ends read straight heads of articles, they all try to read
-as little as possible. This variable (default 8192) specifies
-the absolute max length the back ends will try to read before giving up
-on finding a separator line between the head and the body. If this
-variable is @code{nil}, there is no upper read bound. If it is
-@code{t}, the back ends won't try to read the articles piece by piece,
-but read the entire articles. This makes sense with some versions of
-@code{ange-ftp} or @code{efs}.
-
-@item nnheader-head-chop-length
-@vindex nnheader-head-chop-length
-This variable (default 2048) says how big a piece of each article to
-read when doing the operation described above.
-
-@item nnheader-file-name-translation-alist
-@vindex nnheader-file-name-translation-alist
-@cindex file names
-@cindex invalid characters in file names
-@cindex characters in file names
-This is an alist that says how to translate characters in file names.
-For instance, if @samp{:} is invalid as a file character in file names
-on your system (you OS/2 user you), you could say something like:
-
-@lisp
-@group
-(setq nnheader-file-name-translation-alist
- '((?: . ?_)))
-@end group
-@end lisp
-
-In fact, this is the default value for this variable on OS/2 and MS
-Windows (phooey) systems.
-
-@item gnus-hidden-properties
-@vindex gnus-hidden-properties
-This is a list of properties to use to hide ``invisible'' text. It is
-@code{(invisible t intangible t)} by default on most systems, which
-makes invisible text invisible and intangible.
-
-@item gnus-parse-headers-hook
-@vindex gnus-parse-headers-hook
-A hook called before parsing headers. It can be used, for instance, to
-gather statistics on the headers fetched, or perhaps you'd like to prune
-some headers. I don't see why you'd want that, though.
-
-@item gnus-shell-command-separator
-@vindex gnus-shell-command-separator
-String used to separate two shell commands. The default is @samp{;}.
-
-@item gnus-invalid-group-regexp
-@vindex gnus-invalid-group-regexp
-
-Regexp to match ``invalid'' group names when querying user for a group
-name. The default value catches some @strong{really} invalid group
-names who could possibly mess up Gnus internally (like allowing
-@samp{:} in a group name, which is normally used to delimit method and
-group).
-
-@acronym{IMAP} users might want to allow @samp{/} in group names though.
-
-
-@end table
-
-@node The End
-@chapter The End
-
-Well, that's the manual---you can get on with your life now. Keep in
-touch. Say hello to your cats from me.
-
-My @strong{ghod}---I just can't stand goodbyes. Sniffle.
-
-Ol' Charles Reznikoff said it pretty well, so I leave the floor to him:
-
-@quotation
-@strong{Te Deum}
-
-@sp 1
-Not because of victories @*
-I sing,@*
-having none,@*
-but for the common sunshine,@*
-the breeze,@*
-the largess of the spring.
-
-@sp 1
-Not for victory@*
-but for the day's work done@*
-as well as I was able;@*
-not for a seat upon the dais@*
-but at the common table.@*
-@end quotation
-
-
-@node Appendices
-@chapter Appendices
-
-@menu
-* XEmacs:: Requirements for installing under XEmacs.
-* History:: How Gnus got where it is today.
-* On Writing Manuals:: Why this is not a beginner's guide.
-* Terminology:: We use really difficult, like, words here.
-* Customization:: Tailoring Gnus to your needs.
-* Troubleshooting:: What you might try if things do not work.
-* Gnus Reference Guide:: Rilly, rilly technical stuff.
-* Emacs for Heathens:: A short introduction to Emacsian terms.
-* Frequently Asked Questions:: The Gnus FAQ
-@end menu
-
-
-@node XEmacs
-@section XEmacs
-@cindex XEmacs
-@cindex installing under XEmacs
-
-XEmacs is distributed as a collection of packages. You should install
-whatever packages the Gnus XEmacs package requires. The current
-requirements are @samp{gnus}, @samp{mail-lib}, @samp{xemacs-base},
-@samp{eterm}, @samp{sh-script}, @samp{net-utils}, @samp{os-utils},
-@samp{dired}, @samp{mh-e}, @samp{sieve}, @samp{ps-print}, @samp{W3},
-@samp{pgg}, @samp{mailcrypt}, @samp{ecrypto}, and @samp{sasl}.
-
-
-@node History
-@section History
-
-@cindex history
-@sc{gnus} was written by Masanobu @sc{Umeda}. When autumn crept up in
-'94, Lars Magne Ingebrigtsen grew bored and decided to rewrite Gnus.
-
-If you want to investigate the person responsible for this outrage,
-you can point your (feh!) web browser to
-@uref{http://quimby.gnus.org/}. This is also the primary
-distribution point for the new and spiffy versions of Gnus, and is
-known as The Site That Destroys Newsrcs And Drives People Mad.
-
-During the first extended alpha period of development, the new Gnus was
-called ``(ding) Gnus''. @dfn{(ding)} is, of course, short for
-@dfn{ding is not Gnus}, which is a total and utter lie, but who cares?
-(Besides, the ``Gnus'' in this abbreviation should probably be
-pronounced ``news'' as @sc{Umeda} intended, which makes it a more
-appropriate name, don't you think?)
-
-In any case, after spending all that energy on coming up with a new and
-spunky name, we decided that the name was @emph{too} spunky, so we
-renamed it back again to ``Gnus''. But in mixed case. ``Gnus'' vs.
-``@sc{gnus}''. New vs. old.
-
-@menu
-* Gnus Versions:: What Gnus versions have been released.
-* Other Gnus Versions:: Other Gnus versions that also have been released.
-* Why?:: What's the point of Gnus?
-* Compatibility:: Just how compatible is Gnus with @sc{gnus}?
-* Conformity:: Gnus tries to conform to all standards.
-* Emacsen:: Gnus can be run on a few modern Emacsen.
-* Gnus Development:: How Gnus is developed.
-* Contributors:: Oodles of people.
-* New Features:: Pointers to some of the new stuff in Gnus.
-@end menu
-
-
-@node Gnus Versions
-@subsection Gnus Versions
-@cindex ding Gnus
-@cindex September Gnus
-@cindex Red Gnus
-@cindex Quassia Gnus
-@cindex Pterodactyl Gnus
-@cindex Oort Gnus
-@cindex No Gnus
-@cindex Gnus versions
-
-The first ``proper'' release of Gnus 5 was done in November 1995 when it
-was included in the Emacs 19.30 distribution (132 (ding) Gnus releases
-plus 15 Gnus 5.0 releases).
-
-In May 1996 the next Gnus generation (aka. ``September Gnus'' (after 99
-releases)) was released under the name ``Gnus 5.2'' (40 releases).
-
-On July 28th 1996 work on Red Gnus was begun, and it was released on
-January 25th 1997 (after 84 releases) as ``Gnus 5.4'' (67 releases).
-
-On September 13th 1997, Quassia Gnus was started and lasted 37 releases.
-It was released as ``Gnus 5.6'' on March 8th 1998 (46 releases).
-
-Gnus 5.6 begat Pterodactyl Gnus on August 29th 1998 and was released as
-``Gnus 5.8'' (after 99 releases and a CVS repository) on December 3rd
-1999.
-
-On the 26th of October 2000, Oort Gnus was begun and was released as
-Gnus 5.10 on May 1st 2003 (24 releases).
-
-On the January 4th 2004, No Gnus was begun.
-
-If you happen upon a version of Gnus that has a prefixed name --
-``(ding) Gnus'', ``September Gnus'', ``Red Gnus'', ``Quassia Gnus'',
-``Pterodactyl Gnus'', ``Oort Gnus'', ``No Gnus'' -- don't panic.
-Don't let it know that you're frightened. Back away. Slowly. Whatever
-you do, don't run. Walk away, calmly, until you're out of its reach.
-Find a proper released version of Gnus and snuggle up to that instead.
-
-
-@node Other Gnus Versions
-@subsection Other Gnus Versions
-@cindex Semi-gnus
-
-In addition to the versions of Gnus which have had their releases
-coordinated by Lars, one major development has been Semi-gnus from
-Japan. It's based on a library called @acronym{SEMI}, which provides
-@acronym{MIME} capabilities.
-
-These Gnusae are based mainly on Gnus 5.6 and Pterodactyl Gnus.
-Collectively, they are called ``Semi-gnus'', and different strains are
-called T-gnus, ET-gnus, Nana-gnus and Chaos. These provide powerful
-@acronym{MIME} and multilingualization things, especially important for
-Japanese users.
-
-
-@node Why?
-@subsection Why?
-
-What's the point of Gnus?
-
-I want to provide a ``rad'', ``happening'', ``way cool'' and ``hep''
-newsreader, that lets you do anything you can think of. That was my
-original motivation, but while working on Gnus, it has become clear to
-me that this generation of newsreaders really belong in the stone age.
-Newsreaders haven't developed much since the infancy of the net. If the
-volume continues to rise with the current rate of increase, all current
-newsreaders will be pretty much useless. How do you deal with
-newsgroups that have thousands of new articles each day? How do you
-keep track of millions of people who post?
-
-Gnus offers no real solutions to these questions, but I would very much
-like to see Gnus being used as a testing ground for new methods of
-reading and fetching news. Expanding on @sc{Umeda}-san's wise decision
-to separate the newsreader from the back ends, Gnus now offers a simple
-interface for anybody who wants to write new back ends for fetching mail
-and news from different sources. I have added hooks for customizations
-everywhere I could imagine it being useful. By doing so, I'm inviting
-every one of you to explore and invent.
-
-May Gnus never be complete. @kbd{C-u 100 M-x all-hail-emacs} and
-@kbd{C-u 100 M-x all-hail-xemacs}.
-
-
-@node Compatibility
-@subsection Compatibility
-
-@cindex compatibility
-Gnus was designed to be fully compatible with @sc{gnus}. Almost all key
-bindings have been kept. More key bindings have been added, of course,
-but only in one or two obscure cases have old bindings been changed.
-
-Our motto is:
-@quotation
-@cartouche
-@center In a cloud bones of steel.
-@end cartouche
-@end quotation
-
-All commands have kept their names. Some internal functions have changed
-their names.
-
-The @code{gnus-uu} package has changed drastically. @xref{Decoding
-Articles}.
-
-One major compatibility question is the presence of several summary
-buffers. All variables relevant while reading a group are
-buffer-local to the summary buffer they belong in. Although many
-important variables have their values copied into their global
-counterparts whenever a command is executed in the summary buffer, this
-change might lead to incorrect values being used unless you are careful.
-
-All code that relies on knowledge of @sc{gnus} internals will probably
-fail. To take two examples: Sorting @code{gnus-newsrc-alist} (or
-changing it in any way, as a matter of fact) is strictly verboten. Gnus
-maintains a hash table that points to the entries in this alist (which
-speeds up many functions), and changing the alist directly will lead to
-peculiar results.
-
-@cindex hilit19
-@cindex highlighting
-Old hilit19 code does not work at all. In fact, you should probably
-remove all hilit code from all Gnus hooks
-(@code{gnus-group-prepare-hook} and @code{gnus-summary-prepare-hook}).
-Gnus provides various integrated functions for highlighting. These are
-faster and more accurate. To make life easier for everybody, Gnus will
-by default remove all hilit calls from all hilit hooks. Uncleanliness!
-Away!
-
-Packages like @code{expire-kill} will no longer work. As a matter of
-fact, you should probably remove all old @sc{gnus} packages (and other
-code) when you start using Gnus. More likely than not, Gnus already
-does what you have written code to make @sc{gnus} do. (Snicker.)
-
-Even though old methods of doing things are still supported, only the
-new methods are documented in this manual. If you detect a new method of
-doing something while reading this manual, that does not mean you have
-to stop doing it the old way.
-
-Gnus understands all @sc{gnus} startup files.
-
-@kindex M-x gnus-bug
-@findex gnus-bug
-@cindex reporting bugs
-@cindex bugs
-Overall, a casual user who hasn't written much code that depends on
-@sc{gnus} internals should suffer no problems. If problems occur,
-please let me know by issuing that magic command @kbd{M-x gnus-bug}.
-
-@vindex gnus-bug-create-help-buffer
-If you are in the habit of sending bug reports @emph{very} often, you
-may find the helpful help buffer annoying after a while. If so, set
-@code{gnus-bug-create-help-buffer} to @code{nil} to avoid having it pop
-up at you.
-
-
-@node Conformity
-@subsection Conformity
-
-No rebels without a clue here, ma'am. We conform to all standards known
-to (wo)man. Except for those standards and/or conventions we disagree
-with, of course.
-
-@table @strong
-
-@item RFC (2)822
-@cindex RFC 822
-@cindex RFC 2822
-There are no known breaches of this standard.
-
-@item RFC 1036
-@cindex RFC 1036
-There are no known breaches of this standard, either.
-
-@item Son-of-RFC 1036
-@cindex Son-of-RFC 1036
-We do have some breaches to this one.
-
-@table @emph
-
-@item X-Newsreader
-@itemx User-Agent
-These are considered to be ``vanity headers'', while I consider them
-to be consumer information. After seeing so many badly formatted
-articles coming from @code{tin} and @code{Netscape} I know not to use
-either of those for posting articles. I would not have known that if
-it wasn't for the @code{X-Newsreader} header.
-@end table
-
-@item USEFOR
-@cindex USEFOR
-USEFOR is an IETF working group writing a successor to RFC 1036, based
-on Son-of-RFC 1036. They have produced a number of drafts proposing
-various changes to the format of news articles. The Gnus towers will
-look into implementing the changes when the draft is accepted as an RFC.
-
-@item MIME - RFC 2045-2049 etc
-@cindex @acronym{MIME}
-All the various @acronym{MIME} RFCs are supported.
-
-@item Disposition Notifications - RFC 2298
-Message Mode is able to request notifications from the receiver.
-
-@item PGP - RFC 1991 and RFC 2440
-@cindex RFC 1991
-@cindex RFC 2440
-RFC 1991 is the original @acronym{PGP} message specification,
-published as an informational RFC. RFC 2440 was the follow-up, now
-called Open PGP, and put on the Standards Track. Both document a
-non-@acronym{MIME} aware @acronym{PGP} format. Gnus supports both
-encoding (signing and encryption) and decoding (verification and
-decryption).
-
-@item PGP/MIME - RFC 2015/3156
-RFC 2015 (superseded by 3156 which references RFC 2440 instead of RFC
-1991) describes the @acronym{MIME}-wrapping around the RFC 1991/2440 format.
-Gnus supports both encoding and decoding.
-
-@item S/MIME - RFC 2633
-RFC 2633 describes the @acronym{S/MIME} format.
-
-@item IMAP - RFC 1730/2060, RFC 2195, RFC 2086, RFC 2359, RFC 2595, RFC 1731
-RFC 1730 is @acronym{IMAP} version 4, updated somewhat by RFC 2060
-(@acronym{IMAP} 4 revision 1). RFC 2195 describes CRAM-MD5
-authentication for @acronym{IMAP}. RFC 2086 describes access control
-lists (ACLs) for @acronym{IMAP}. RFC 2359 describes a @acronym{IMAP}
-protocol enhancement. RFC 2595 describes the proper @acronym{TLS}
-integration (STARTTLS) with @acronym{IMAP}. RFC 1731 describes the
-GSSAPI/Kerberos4 mechanisms for @acronym{IMAP}.
-
-@end table
-
-If you ever notice Gnus acting non-compliant with regards to the texts
-mentioned above, don't hesitate to drop a note to Gnus Towers and let us
-know.
-
-
-@node Emacsen
-@subsection Emacsen
-@cindex Emacsen
-@cindex XEmacs
-@cindex Mule
-@cindex Emacs
-
-This Gnus version should work on:
-
-@itemize @bullet
-
-@item
-Emacs 21.1 and up.
-
-@item
-XEmacs 21.4 and up.
-
-@end itemize
-
-This Gnus version will absolutely not work on any Emacsen older than
-that. Not reliably, at least. Older versions of Gnus may work on older
-Emacs versions. Particularly, Gnus 5.10.8 should also work on Emacs
-20.7 and XEmacs 21.1.
-
-While this version of Gnus works on Emacs 22, it is more reasonable to
-use the most recent Emacs 22 version and the Gnus version bundled
-therein. Users of the Emacs development version (to be Emacs 23) are
-strongly encouraged to also use the version bundled with Emacs, which
-corresponds to the development version of Gnus.
-
-@node Gnus Development
-@subsection Gnus Development
-
-Gnus is developed in a two-phased cycle. The first phase involves much
-discussion on the development mailing list @samp{ding@@gnus.org}, where people
-propose changes and new features, post patches and new back ends. This
-phase is called the @dfn{alpha} phase, since the Gnusae released in this
-phase are @dfn{alpha releases}, or (perhaps more commonly in other
-circles) @dfn{snapshots}. During this phase, Gnus is assumed to be
-unstable and should not be used by casual users. Gnus alpha releases
-have names like ``Oort Gnus'' and ``No Gnus''. @xref{Gnus Versions}.
-
-After futzing around for 10-100 alpha releases, Gnus is declared
-@dfn{frozen}, and only bug fixes are applied. Gnus loses the prefix,
-and is called things like ``Gnus 5.10.1'' instead. Normal people are
-supposed to be able to use these, and these are mostly discussed on the
-@samp{gnu.emacs.gnus} newsgroup. This newgroup is mirrored to the
-mailing list @samp{info-gnus-english@@gnu.org} which is carried on Gmane
-as @samp{gmane.emacs.gnus.user}. These releases are finally integrated
-in Emacs.
-
-The division of discussion between the ding mailing list and the Gnus
-newsgroup is not purely based on publicity concerns. It's true that
-having people write about the horrible things that an alpha Gnus release
-can do (sometimes) in a public forum may scare people off, but more
-importantly, talking about new experimental features that have been
-introduced may confuse casual users. New features are frequently
-introduced, fiddled with, and judged to be found wanting, and then
-either discarded or totally rewritten. People reading the mailing list
-usually keep up with these rapid changes, while people on the newsgroup
-can't be assumed to do so.
-
-So if you have problems with or questions about the alpha versions,
-direct those to the ding mailing list @samp{ding@@gnus.org}. This list
-is also available on Gmane as @samp{gmane.emacs.gnus.general}.
-
-@cindex Incoming*
-@vindex mail-source-delete-incoming
-Some variable defaults differ between alpha Gnusae and released Gnusae,
-in particular, @code{mail-source-delete-incoming}. This is to prevent
-lossage of mail if an alpha release hiccups while handling the mail.
-@xref{Mail Source Customization}.
-
-@node Contributors
-@subsection Contributors
-@cindex contributors
-
-The new Gnus version couldn't have been done without the help of all the
-people on the (ding) mailing list. Every day for over a year I have
-gotten billions of nice bug reports from them, filling me with joy,
-every single one of them. Smooches. The people on the list have been
-tried beyond endurance, what with my ``oh, that's a neat idea <type
-type>, yup, I'll release it right away <ship off> no wait, that doesn't
-work at all <type type>, yup, I'll ship that one off right away <ship
-off> no, wait, that absolutely does not work'' policy for releases.
-Micro$oft---bah. Amateurs. I'm @emph{much} worse. (Or is that
-``worser''? ``much worser''? ``worsest''?)
-
-I would like to take this opportunity to thank the Academy for@dots{} oops,
-wrong show.
-
-@itemize @bullet
-
-@item
-Masanobu @sc{Umeda}---the writer of the original @sc{gnus}.
-
-@item
-Shenghuo Zhu---uudecode.el, mm-uu.el, rfc1843.el, webmail.el,
-nnwarchive and many, many other things connected with @acronym{MIME} and
-other types of en/decoding, as well as general bug fixing, new
-functionality and stuff.
-
-@item
-Per Abrahamsen---custom, scoring, highlighting and @sc{soup} code (as
-well as numerous other things).
-
-@item
-Luis Fernandes---design and graphics.
-
-@item
-Joe Reiss---creator of the smiley faces.
-
-@item
-Justin Sheehy---the @acronym{FAQ} maintainer.
-
-@item
-Erik Naggum---help, ideas, support, code and stuff.
-
-@item
-Wes Hardaker---@file{gnus-picon.el} and the manual section on
-@dfn{picons} (@pxref{Picons}).
-
-@item
-Kim-Minh Kaplan---further work on the picon code.
-
-@item
-Brad Miller---@file{gnus-gl.el} and the GroupLens manual section
-(@pxref{GroupLens}).
-
-@item
-Sudish Joseph---innumerable bug fixes.
-
-@item
-Ilja Weis---@file{gnus-topic.el}.
-
-@item
-Steven L. Baur---lots and lots and lots of bugs detections and fixes.
-
-@item
-Vladimir Alexiev---the refcard and reference booklets.
-
-@item
-Felix Lee & Jamie Zawinski---I stole some pieces from the XGnus
-distribution by Felix Lee and JWZ.
-
-@item
-Scott Byer---@file{nnfolder.el} enhancements & rewrite.
-
-@item
-Peter Mutsaers---orphan article scoring code.
-
-@item
-Ken Raeburn---POP mail support.
-
-@item
-Hallvard B Furuseth---various bits and pieces, especially dealing with
-.newsrc files.
-
-@item
-Brian Edmonds---@file{gnus-bbdb.el}.
-
-@item
-David Moore---rewrite of @file{nnvirtual.el} and many other things.
-
-@item
-Kevin Davidson---came up with the name @dfn{ding}, so blame him.
-
-@item
-François Pinard---many, many interesting and thorough bug reports, as
-well as autoconf support.
-
-@end itemize
-
-This manual was proof-read by Adrian Aichner, with Ricardo Nassif, Mark
-Borges, and Jost Krieger proof-reading parts of the manual.
-
-The following people have contributed many patches and suggestions:
-
-Christopher Davis,
-Andrew Eskilsson,
-Kai Grossjohann,
-Kevin Greiner,
-Jesper Harder,
-Paul Jarc,
-Simon Josefsson,
-David Kågedal,
-Richard Pieri,
-Fabrice Popineau,
-Daniel Quinlan,
-Michael Shields,
-Reiner Steib,
-Jason L. Tibbitts, III,
-Jack Vinson,
-Katsumi Yamaoka, @c Yamaoka
-and
-Teodor Zlatanov.
-
-Also thanks to the following for patches and stuff:
-
-Jari Aalto,
-Adrian Aichner,
-Vladimir Alexiev,
-Russ Allbery,
-Peter Arius,
-Matt Armstrong,
-Marc Auslander,
-Miles Bader,
-Alexei V. Barantsev,
-Frank Bennett,
-Robert Bihlmeyer,
-Chris Bone,
-Mark Borges,
-Mark Boyns,
-Lance A. Brown,
-Rob Browning,
-Kees de Bruin,
-Martin Buchholz,
-Joe Buehler,
-Kevin Buhr,
-Alastair Burt,
-Joao Cachopo,
-Zlatko Calusic,
-Massimo Campostrini,
-Castor,
-David Charlap,
-Dan Christensen,
-Kevin Christian,
-Jae-you Chung, @c ?
-James H. Cloos, Jr.,
-Laura Conrad,
-Michael R. Cook,
-Glenn Coombs,
-Andrew J. Cosgriff,
-Neil Crellin,
-Frank D. Cringle,
-Geoffrey T. Dairiki,
-Andre Deparade,
-Ulrik Dickow,
-Dave Disser,
-Rui-Tao Dong, @c ?
-Joev Dubach,
-Michael Welsh Duggan,
-Dave Edmondson,
-Paul Eggert,
-Mark W. Eichin,
-Karl Eichwalder,
-Enami Tsugutomo, @c Enami
-Michael Ernst,
-Luc Van Eycken,
-Sam Falkner,
-Nelson Jose dos Santos Ferreira,
-Sigbjorn Finne,
-Sven Fischer,
-Paul Fisher,
-Decklin Foster,
-Gary D. Foster,
-Paul Franklin,
-Guy Geens,
-Arne Georg Gleditsch,
-David S. Goldberg,
-Michelangelo Grigni,
-Dale Hagglund,
-D. Hall,
-Magnus Hammerin,
-Kenichi Handa, @c Handa
-Raja R. Harinath,
-Yoshiki Hayashi, @c Hayashi
-P. E. Jareth Hein,
-Hisashige Kenji, @c Hisashige
-Scott Hofmann,
-Marc Horowitz,
-Gunnar Horrigmo,
-Richard Hoskins,
-Brad Howes,
-Miguel de Icaza,
-François Felix Ingrand,
-Tatsuya Ichikawa, @c Ichikawa
-Ishikawa Ichiro, @c Ishikawa
-Lee Iverson,
-Iwamuro Motonori, @c Iwamuro
-Rajappa Iyer,
-Andreas Jaeger,
-Adam P. Jenkins,
-Randell Jesup,
-Fred Johansen,
-Gareth Jones,
-Greg Klanderman,
-Karl Kleinpaste,
-Michael Klingbeil,
-Peter Skov Knudsen,
-Shuhei Kobayashi, @c Kobayashi
-Petr Konecny,
-Koseki Yoshinori, @c Koseki
-Thor Kristoffersen,
-Jens Lautenbacher,
-Martin Larose,
-Seokchan Lee, @c Lee
-Joerg Lenneis,
-Carsten Leonhardt,
-James LewisMoss,
-Christian Limpach,
-Markus Linnala,
-Dave Love,
-Mike McEwan,
-Tonny Madsen,
-Shlomo Mahlab,
-Nat Makarevitch,
-Istvan Marko,
-David Martin,
-Jason R. Mastaler,
-Gordon Matzigkeit,
-Timo Metzemakers,
-Richard Mlynarik,
-Lantz Moore,
-Morioka Tomohiko, @c Morioka
-Erik Toubro Nielsen,
-Hrvoje Niksic,
-Andy Norman,
-Fred Oberhauser,
-C. R. Oldham,
-Alexandre Oliva,
-Ken Olstad,
-Masaharu Onishi, @c Onishi
-Hideki Ono, @c Ono
-Ettore Perazzoli,
-William Perry,
-Stephen Peters,
-Jens-Ulrik Holger Petersen,
-Ulrich Pfeifer,
-Matt Pharr,
-Andy Piper,
-John McClary Prevost,
-Bill Pringlemeir,
-Mike Pullen,
-Jim Radford,
-Colin Rafferty,
-Lasse Rasinen,
-Lars Balker Rasmussen,
-Joe Reiss,
-Renaud Rioboo,
-Roland B. Roberts,
-Bart Robinson,
-Christian von Roques,
-Markus Rost,
-Jason Rumney,
-Wolfgang Rupprecht,
-Jay Sachs,
-Dewey M. Sasser,
-Conrad Sauerwald,
-Loren Schall,
-Dan Schmidt,
-Ralph Schleicher,
-Philippe Schnoebelen,
-Andreas Schwab,
-Randal L. Schwartz,
-Danny Siu,
-Matt Simmons,
-Paul D. Smith,
-Jeff Sparkes,
-Toby Speight,
-Michael Sperber,
-Darren Stalder,
-Richard Stallman,
-Greg Stark,
-Sam Steingold,
-Paul Stevenson,
-Jonas Steverud,
-Paul Stodghill,
-Kiyokazu Suto, @c Suto
-Kurt Swanson,
-Samuel Tardieu,
-Teddy,
-Chuck Thompson,
-Tozawa Akihiko, @c Tozawa
-Philippe Troin,
-James Troup,
-Trung Tran-Duc,
-Jack Twilley,
-Aaron M. Ucko,
-Aki Vehtari,
-Didier Verna,
-Vladimir Volovich,
-Jan Vroonhof,
-Stefan Waldherr,
-Pete Ware,
-Barry A. Warsaw,
-Christoph Wedler,
-Joe Wells,
-Lee Willis,
-and
-Lloyd Zusman.
-
-
-For a full overview of what each person has done, the ChangeLogs
-included in the Gnus alpha distributions should give ample reading
-(550kB and counting).
-
-Apologies to everybody that I've forgotten, of which there are many, I'm
-sure.
-
-Gee, that's quite a list of people. I guess that must mean that there
-actually are people who are using Gnus. Who'd'a thunk it!
-
-
-@node New Features
-@subsection New Features
-@cindex new features
-
-@menu
-* ding Gnus:: New things in Gnus 5.0/5.1, the first new Gnus.
-* September Gnus:: The Thing Formally Known As Gnus 5.2/5.3.
-* Red Gnus:: Third time best---Gnus 5.4/5.5.
-* Quassia Gnus:: Two times two is four, or Gnus 5.6/5.7.
-* Pterodactyl Gnus:: Pentad also starts with P, AKA Gnus 5.8/5.9.
-* Oort Gnus:: It's big. It's far out. Gnus 5.10/5.11.
-@end menu
-
-These lists are, of course, just @emph{short} overviews of the
-@emph{most} important new features. No, really. There are tons more.
-Yes, we have feeping creaturism in full effect.
-
-@node ding Gnus
-@subsubsection (ding) Gnus
-
-New features in Gnus 5.0/5.1:
-
-@itemize @bullet
-
-@item
-The look of all buffers can be changed by setting format-like variables
-(@pxref{Group Buffer Format} and @pxref{Summary Buffer Format}).
-
-@item
-Local spool and several @acronym{NNTP} servers can be used at once
-(@pxref{Select Methods}).
-
-@item
-You can combine groups into virtual groups (@pxref{Virtual Groups}).
-
-@item
-You can read a number of different mail formats (@pxref{Getting Mail}).
-All the mail back ends implement a convenient mail expiry scheme
-(@pxref{Expiring Mail}).
-
-@item
-Gnus can use various strategies for gathering threads that have lost
-their roots (thereby gathering loose sub-threads into one thread) or it
-can go back and retrieve enough headers to build a complete thread
-(@pxref{Customizing Threading}).
-
-@item
-Killed groups can be displayed in the group buffer, and you can read
-them as well (@pxref{Listing Groups}).
-
-@item
-Gnus can do partial group updates---you do not have to retrieve the
-entire active file just to check for new articles in a few groups
-(@pxref{The Active File}).
-
-@item
-Gnus implements a sliding scale of subscribedness to groups
-(@pxref{Group Levels}).
-
-@item
-You can score articles according to any number of criteria
-(@pxref{Scoring}). You can even get Gnus to find out how to score
-articles for you (@pxref{Adaptive Scoring}).
-
-@item
-Gnus maintains a dribble buffer that is auto-saved the normal Emacs
-manner, so it should be difficult to lose much data on what you have
-read if your machine should go down (@pxref{Auto Save}).
-
-@item
-Gnus now has its own startup file (@file{~/.gnus.el}) to avoid
-cluttering up the @file{.emacs} file.
-
-@item
-You can set the process mark on both groups and articles and perform
-operations on all the marked items (@pxref{Process/Prefix}).
-
-@item
-You can grep through a subset of groups and create a group from the
-results (@pxref{Kibozed Groups}).
-
-@item
-You can list subsets of groups according to, well, anything
-(@pxref{Listing Groups}).
-
-@item
-You can browse foreign servers and subscribe to groups from those
-servers (@pxref{Browse Foreign Server}).
-
-@item
-Gnus can fetch articles, asynchronously, on a second connection to the
-server (@pxref{Asynchronous Fetching}).
-
-@item
-You can cache articles locally (@pxref{Article Caching}).
-
-@item
-The uudecode functions have been expanded and generalized
-(@pxref{Decoding Articles}).
-
-@item
-You can still post uuencoded articles, which was a little-known feature
-of @sc{gnus}' past (@pxref{Uuencoding and Posting}).
-
-@item
-Fetching parents (and other articles) now actually works without
-glitches (@pxref{Finding the Parent}).
-
-@item
-Gnus can fetch @acronym{FAQ}s and group descriptions (@pxref{Group Information}).
-
-@item
-Digests (and other files) can be used as the basis for groups
-(@pxref{Document Groups}).
-
-@item
-Articles can be highlighted and customized (@pxref{Customizing
-Articles}).
-
-@item
-URLs and other external references can be buttonized (@pxref{Article
-Buttons}).
-
-@item
-You can do lots of strange stuff with the Gnus window & frame
-configuration (@pxref{Window Layout}).
-
-@item
-You can click on buttons instead of using the keyboard
-(@pxref{Buttons}).
-
-@end itemize
-
-
-@node September Gnus
-@subsubsection September Gnus
-
-@iftex
-@iflatex
-\gnusfig{-28cm}{0cm}{\epsfig{figure=ps/september,height=20cm}}
-@end iflatex
-@end iftex
-
-New features in Gnus 5.2/5.3:
-
-@itemize @bullet
-
-@item
-A new message composition mode is used. All old customization variables
-for @code{mail-mode}, @code{rnews-reply-mode} and @code{gnus-msg} are
-now obsolete.
-
-@item
-Gnus is now able to generate @dfn{sparse} threads---threads where
-missing articles are represented by empty nodes (@pxref{Customizing
-Threading}).
-
-@lisp
-(setq gnus-build-sparse-threads 'some)
-@end lisp
-
-@item
-Outgoing articles are stored on a special archive server
-(@pxref{Archived Messages}).
-
-@item
-Partial thread regeneration now happens when articles are
-referred.
-
-@item
-Gnus can make use of GroupLens predictions (@pxref{GroupLens}).
-
-@item
-Picons (personal icons) can be displayed under XEmacs (@pxref{Picons}).
-
-@item
-A @code{trn}-like tree buffer can be displayed (@pxref{Tree Display}).
-
-@lisp
-(setq gnus-use-trees t)
-@end lisp
-
-@item
-An @code{nn}-like pick-and-read minor mode is available for the summary
-buffers (@pxref{Pick and Read}).
-
-@lisp
-(add-hook 'gnus-summary-mode-hook 'gnus-pick-mode)
-@end lisp
-
-@item
-In binary groups you can use a special binary minor mode (@pxref{Binary
-Groups}).
-
-@item
-Groups can be grouped in a folding topic hierarchy (@pxref{Group
-Topics}).
-
-@lisp
-(add-hook 'gnus-group-mode-hook 'gnus-topic-mode)
-@end lisp
-
-@item
-Gnus can re-send and bounce mail (@pxref{Summary Mail Commands}).
-
-@item
-Groups can now have a score, and bubbling based on entry frequency
-is possible (@pxref{Group Score}).
-
-@lisp
-(add-hook 'gnus-summary-exit-hook 'gnus-summary-bubble-group)
-@end lisp
-
-@item
-Groups can be process-marked, and commands can be performed on
-groups of groups (@pxref{Marking Groups}).
-
-@item
-Caching is possible in virtual groups.
-
-@item
-@code{nndoc} now understands all kinds of digests, mail boxes, rnews
-news batches, ClariNet briefs collections, and just about everything
-else (@pxref{Document Groups}).
-
-@item
-Gnus has a new back end (@code{nnsoup}) to create/read SOUP packets
-(@pxref{SOUP}).
-
-@item
-The Gnus cache is much faster.
-
-@item
-Groups can be sorted according to many criteria (@pxref{Sorting
-Groups}).
-
-@item
-New group parameters have been introduced to set list-addresses and
-expiry times (@pxref{Group Parameters}).
-
-@item
-All formatting specs allow specifying faces to be used
-(@pxref{Formatting Fonts}).
-
-@item
-There are several more commands for setting/removing/acting on process
-marked articles on the @kbd{M P} submap (@pxref{Setting Process Marks}).
-
-@item
-The summary buffer can be limited to show parts of the available
-articles based on a wide range of criteria. These commands have been
-bound to keys on the @kbd{/} submap (@pxref{Limiting}).
-
-@item
-Articles can be made persistent with the @kbd{*} command
-(@pxref{Persistent Articles}).
-
-@item
-All functions for hiding article elements are now toggles.
-
-@item
-Article headers can be buttonized (@pxref{Article Washing}).
-
-@item
-All mail back ends support fetching articles by @code{Message-ID}.
-
-@item
-Duplicate mail can now be treated properly (@pxref{Duplicates}).
-
-@item
-All summary mode commands are available directly from the article
-buffer (@pxref{Article Keymap}).
-
-@item
-Frames can be part of @code{gnus-buffer-configuration} (@pxref{Window
-Layout}).
-
-@item
-Mail can be re-scanned by a daemonic process (@pxref{Daemons}).
-@iftex
-@iflatex
-\marginpar[\mbox{}\hfill\epsfig{figure=ps/fseptember,height=5cm}]{\epsfig{figure=ps/fseptember,height=5cm}}
-@end iflatex
-@end iftex
-
-@item
-Gnus can make use of NoCeM files to weed out spam (@pxref{NoCeM}).
-
-@lisp
-(setq gnus-use-nocem t)
-@end lisp
-
-@item
-Groups can be made permanently visible (@pxref{Listing Groups}).
-
-@lisp
-(setq gnus-permanently-visible-groups "^nnml:")
-@end lisp
-
-@item
-Many new hooks have been introduced to make customizing easier.
-
-@item
-Gnus respects the @code{Mail-Copies-To} header.
-
-@item
-Threads can be gathered by looking at the @code{References} header
-(@pxref{Customizing Threading}).
-
-@lisp
-(setq gnus-summary-thread-gathering-function
- 'gnus-gather-threads-by-references)
-@end lisp
-
-@item
-Read articles can be stored in a special backlog buffer to avoid
-refetching (@pxref{Article Backlog}).
-
-@lisp
-(setq gnus-keep-backlog 50)
-@end lisp
-
-@item
-A clean copy of the current article is always stored in a separate
-buffer to allow easier treatment.
-
-@item
-Gnus can suggest where to save articles (@pxref{Saving Articles}).
-
-@item
-Gnus doesn't have to do as much prompting when saving (@pxref{Saving
-Articles}).
-
-@lisp
-(setq gnus-prompt-before-saving t)
-@end lisp
-
-@item
-@code{gnus-uu} can view decoded files asynchronously while fetching
-articles (@pxref{Other Decode Variables}).
-
-@lisp
-(setq gnus-uu-grabbed-file-functions 'gnus-uu-grab-view)
-@end lisp
-
-@item
-Filling in the article buffer now works properly on cited text
-(@pxref{Article Washing}).
-
-@item
-Hiding cited text adds buttons to toggle hiding, and how much
-cited text to hide is now customizable (@pxref{Article Hiding}).
-
-@lisp
-(setq gnus-cited-lines-visible 2)
-@end lisp
-
-@item
-Boring headers can be hidden (@pxref{Article Hiding}).
-
-@item
-Default scoring values can now be set from the menu bar.
-
-@item
-Further syntax checking of outgoing articles have been added.
-
-@end itemize
-
-
-@node Red Gnus
-@subsubsection Red Gnus
-
-New features in Gnus 5.4/5.5:
-
-@iftex
-@iflatex
-\gnusfig{-5.5cm}{-4cm}{\epsfig{figure=ps/red,height=20cm}}
-@end iflatex
-@end iftex
-
-@itemize @bullet
-
-@item
-@file{nntp.el} has been totally rewritten in an asynchronous fashion.
-
-@item
-Article prefetching functionality has been moved up into
-Gnus (@pxref{Asynchronous Fetching}).
-
-@item
-Scoring can now be performed with logical operators like @code{and},
-@code{or}, @code{not}, and parent redirection (@pxref{Advanced
-Scoring}).
-
-@item
-Article washing status can be displayed in the
-article mode line (@pxref{Misc Article}).
-
-@item
-@file{gnus.el} has been split into many smaller files.
-
-@item
-Suppression of duplicate articles based on Message-ID can be done
-(@pxref{Duplicate Suppression}).
-
-@lisp
-(setq gnus-suppress-duplicates t)
-@end lisp
-
-@item
-New variables for specifying what score and adapt files are to be
-considered home score and adapt files (@pxref{Home Score File}) have
-been added.
-
-@item
-@code{nndoc} was rewritten to be easily extendable (@pxref{Document
-Server Internals}).
-
-@item
-Groups can inherit group parameters from parent topics (@pxref{Topic
-Parameters}).
-
-@item
-Article editing has been revamped and is now actually usable.
-
-@item
-Signatures can be recognized in more intelligent fashions
-(@pxref{Article Signature}).
-
-@item
-Summary pick mode has been made to look more @code{nn}-like. Line
-numbers are displayed and the @kbd{.} command can be used to pick
-articles (@code{Pick and Read}).
-
-@item
-Commands for moving the @file{.newsrc.eld} from one server to
-another have been added (@pxref{Changing Servers}).
-
-@item
-There's a way now to specify that ``uninteresting'' fields be suppressed
-when generating lines in buffers (@pxref{Advanced Formatting}).
-
-@item
-Several commands in the group buffer can be undone with @kbd{C-M-_}
-(@pxref{Undo}).
-
-@item
-Scoring can be done on words using the new score type @code{w}
-(@pxref{Score File Format}).
-
-@item
-Adaptive scoring can be done on a Subject word-by-word basis
-(@pxref{Adaptive Scoring}).
-
-@lisp
-(setq gnus-use-adaptive-scoring '(word))
-@end lisp
-
-@item
-Scores can be decayed (@pxref{Score Decays}).
-
-@lisp
-(setq gnus-decay-scores t)
-@end lisp
-
-@item
-Scoring can be performed using a regexp on the Date header. The Date is
-normalized to compact ISO 8601 format first (@pxref{Score File Format}).
-
-@item
-A new command has been added to remove all data on articles from
-the native server (@pxref{Changing Servers}).
-
-@item
-A new command for reading collections of documents
-(@code{nndoc} with @code{nnvirtual} on top) has been added---@kbd{C-M-d}
-(@pxref{Really Various Summary Commands}).
-
-@item
-Process mark sets can be pushed and popped (@pxref{Setting Process
-Marks}).
-
-@item
-A new mail-to-news back end makes it possible to post even when the @acronym{NNTP}
-server doesn't allow posting (@pxref{Mail-To-News Gateways}).
-
-@item
-A new back end for reading searches from Web search engines
-(@dfn{DejaNews}, @dfn{Alta Vista}, @dfn{InReference}) has been added
-(@pxref{Web Searches}).
-
-@item
-Groups inside topics can now be sorted using the standard sorting
-functions, and each topic can be sorted independently (@pxref{Topic
-Sorting}).
-
-@item
-Subsets of the groups can be sorted independently (@code{Sorting
-Groups}).
-
-@item
-Cached articles can be pulled into the groups (@pxref{Summary Generation
-Commands}).
-@iftex
-@iflatex
-\marginpar[\mbox{}\hfill\epsfig{figure=ps/fred,width=3cm}]{\epsfig{figure=ps/fred,width=3cm}}
-@end iflatex
-@end iftex
-
-@item
-Score files are now applied in a more reliable order (@pxref{Score
-Variables}).
-
-@item
-Reports on where mail messages end up can be generated (@pxref{Splitting
-Mail}).
-
-@item
-More hooks and functions have been added to remove junk from incoming
-mail before saving the mail (@pxref{Washing Mail}).
-
-@item
-Emphasized text can be properly fontisized:
-
-@end itemize
-
-
-@node Quassia Gnus
-@subsubsection Quassia Gnus
-
-New features in Gnus 5.6:
-
-@itemize @bullet
-
-@item
-New functionality for using Gnus as an offline newsreader has been
-added. A plethora of new commands and modes have been added.
-@xref{Gnus Unplugged}, for the full story.
-
-@item
-The @code{nndraft} back end has returned, but works differently than
-before. All Message buffers are now also articles in the @code{nndraft}
-group, which is created automatically.
-
-@item
-@code{gnus-alter-header-function} can now be used to alter header
-values.
-
-@item
-@code{gnus-summary-goto-article} now accept Message-ID's.
-
-@item
-A new Message command for deleting text in the body of a message
-outside the region: @kbd{C-c C-v}.
-
-@item
-You can now post to component group in @code{nnvirtual} groups with
-@kbd{C-u C-c C-c}.
-
-@item
- @code{nntp-rlogin-program}---new variable to ease customization.
-
-@item
-@code{C-u C-c C-c} in @code{gnus-article-edit-mode} will now inhibit
-re-highlighting of the article buffer.
-
-@item
-New element in @code{gnus-boring-article-headers}---@code{long-to}.
-
-@item
-@kbd{M-i} symbolic prefix command. @xref{Symbolic Prefixes}, for
-details.
-
-@item
-@kbd{L} and @kbd{I} in the summary buffer now take the symbolic prefix
-@kbd{a} to add the score rule to the @file{all.SCORE} file.
-
-@item
-@code{gnus-simplify-subject-functions} variable to allow greater
-control over simplification.
-
-@item
-@kbd{A T}---new command for fetching the current thread.
-
-@item
-@kbd{/ T}---new command for including the current thread in the
-limit.
-
-@item
-@kbd{M-RET} is a new Message command for breaking cited text.
-
-@item
-@samp{\\1}-expressions are now valid in @code{nnmail-split-methods}.
-
-@item
-The @code{custom-face-lookup} function has been removed.
-If you used this function in your initialization files, you must
-rewrite them to use @code{face-spec-set} instead.
-
-@item
-Canceling now uses the current select method. Symbolic prefix
-@kbd{a} forces normal posting method.
-
-@item
-New command to translate M******** sm*rtq**t*s into proper
-text---@kbd{W d}.
-
-@item
-For easier debugging of @code{nntp}, you can set
-@code{nntp-record-commands} to a non-@code{nil} value.
-
-@item
-@code{nntp} now uses @file{~/.authinfo}, a @file{.netrc}-like file, for
-controlling where and how to send @sc{authinfo} to @acronym{NNTP} servers.
-
-@item
-A command for editing group parameters from the summary buffer
-has been added.
-
-@item
-A history of where mails have been split is available.
-
-@item
-A new article date command has been added---@code{article-date-iso8601}.
-
-@item
-Subjects can be simplified when threading by setting
-@code{gnus-score-thread-simplify}.
-
-@item
-A new function for citing in Message has been
-added---@code{message-cite-original-without-signature}.
-
-@item
-@code{article-strip-all-blank-lines}---new article command.
-
-@item
-A new Message command to kill to the end of the article has
-been added.
-
-@item
-A minimum adaptive score can be specified by using the
-@code{gnus-adaptive-word-minimum} variable.
-
-@item
-The ``lapsed date'' article header can be kept continually
-updated by the @code{gnus-start-date-timer} command.
-
-@item
-Web listserv archives can be read with the @code{nnlistserv} back end.
-
-@item
-Old dejanews archives can now be read by @code{nnweb}.
-
-@end itemize
-
-@node Pterodactyl Gnus
-@subsubsection Pterodactyl Gnus
-
-New features in Gnus 5.8:
-
-@itemize @bullet
-
-@item
-The mail-fetching functions have changed. See the manual for the
-many details. In particular, all procmail fetching variables are gone.
-
-If you used procmail like in
-
-@lisp
-(setq nnmail-use-procmail t)
-(setq nnmail-spool-file 'procmail)
-(setq nnmail-procmail-directory "~/mail/incoming/")
-(setq nnmail-procmail-suffix "\\.in")
-@end lisp
-
-this now has changed to
-
-@lisp
-(setq mail-sources
- '((directory :path "~/mail/incoming/"
- :suffix ".in")))
-@end lisp
-
-@xref{Mail Source Specifiers}.
-
-@item
-Gnus is now a @acronym{MIME}-capable reader. This affects many parts of
-Gnus, and adds a slew of new commands. See the manual for details.
-
-@item
-Gnus has also been multilingualized. This also affects too
-many parts of Gnus to summarize here, and adds many new variables.
-
-@item
-@code{gnus-auto-select-first} can now be a function to be
-called to position point.
-
-@item
-The user can now decide which extra headers should be included in
-summary buffers and @acronym{NOV} files.
-
-@item
-@code{gnus-article-display-hook} has been removed. Instead, a number
-of variables starting with @code{gnus-treat-} have been added.
-
-@item
-The Gnus posting styles have been redone again and now works in a
-subtly different manner.
-
-@item
-New web-based back ends have been added: @code{nnslashdot},
-@code{nnwarchive} and @code{nnultimate}. nnweb has been revamped,
-again, to keep up with ever-changing layouts.
-
-@item
-Gnus can now read @acronym{IMAP} mail via @code{nnimap}.
-
-@end itemize
-
-@node Oort Gnus
-@subsubsection Oort Gnus
-@cindex Oort Gnus
-
-New features in Gnus 5.10:
-
-@itemize @bullet
-
-@item Installation changes
-@c ***********************
-
-@itemize @bullet
-@item
-Upgrading from previous (stable) version if you have used Oort.
-
-If you have tried Oort (the unstable Gnus branch leading to this
-release) but went back to a stable version, be careful when upgrading to
-this version. In particular, you will probably want to remove all
-@file{.marks} (nnml) and @file{.mrk} (nnfolder) files, so that flags are
-read from your @file{.newsrc.eld} instead of from the
-@file{.marks}/@file{.mrk} file where this release store flags. See a
-later entry for more information about marks. Note that downgrading
-isn't save in general.
-
-@item
-Lisp files are now installed in @file{.../site-lisp/gnus/} by default.
-It defaulted to @file{.../site-lisp/} formerly. In addition to this,
-the new installer issues a warning if other Gnus installations which
-will shadow the latest one are detected. You can then remove those
-shadows manually or remove them using @code{make
-remove-installed-shadows}.
-
-@item
-New @file{make.bat} for compiling and installing Gnus under MS Windows
-
-Use @file{make.bat} if you want to install Gnus under MS Windows, the
-first argument to the batch-program should be the directory where
-@file{xemacs.exe} respectively @file{emacs.exe} is located, if you want
-to install Gnus after compiling it, give @file{make.bat} @code{/copy} as
-the second parameter.
-
-@file{make.bat} has been rewritten from scratch, it now features
-automatic recognition of XEmacs and GNU Emacs, generates
-@file{gnus-load.el}, checks if errors occur while compilation and
-generation of info files and reports them at the end of the build
-process. It now uses @code{makeinfo} if it is available and falls
-back to @file{infohack.el} otherwise. @file{make.bat} should now
-install all files which are necessary to run Gnus and be generally a
-complete replacement for the @code{configure; make; make install}
-cycle used under Unix systems.
-
-The new @file{make.bat} makes @file{make-x.bat} and @file{xemacs.mak}
-superfluous, so they have been removed.
-
-@item
-@file{~/News/overview/} not used.
-
-As a result of the following change, the @file{~/News/overview/}
-directory is not used any more. You can safely delete the entire
-hierarchy.
-
-@c FIXME: `gnus-load' is mentioned in README, which is not included in
-@c CVS. We should find a better place for this item.
-@item
-@code{(require 'gnus-load)}
-
-If you use a stand-alone Gnus distribution, you'd better add
-@code{(require 'gnus-load)} into your @file{~/.emacs} after adding the Gnus
-lisp directory into load-path.
-
-File @file{gnus-load.el} contains autoload commands, functions and variables,
-some of which may not be included in distributions of Emacsen.
-
-@end itemize
-
-@item New packages and libraries within Gnus
-@c *****************************************
-
-@itemize @bullet
-
-@item
-The revised Gnus @acronym{FAQ} is included in the manual,
-@xref{Frequently Asked Questions}.
-
-@item
-@acronym{TLS} wrapper shipped with Gnus
-
-@acronym{TLS}/@acronym{SSL} is now supported in @acronym{IMAP} and
-@acronym{NNTP} via @file{tls.el} and GNUTLS. The old
-@acronym{TLS}/@acronym{SSL} support via (external third party)
-@file{ssl.el} and OpenSSL still works.
-
-@item
-Improved anti-spam features.
-
-Gnus is now able to take out spam from your mail and news streams
-using a wide variety of programs and filter rules. Among the supported
-methods are RBL blocklists, bogofilter and white/blacklists. Hooks
-for easy use of external packages such as SpamAssassin and Hashcash
-are also new. @xref{Thwarting Email Spam}.
-@c FIXME: @xref{Spam Package}?. Should this be under Misc?
-
-@item
-Gnus supports server-side mail filtering using Sieve.
-
-Sieve rules can be added as Group Parameters for groups, and the
-complete Sieve script is generated using @kbd{D g} from the Group
-buffer, and then uploaded to the server using @kbd{C-c C-l} in the
-generated Sieve buffer. @xref{Sieve Commands}, and the new Sieve
-manual @ref{Top, , Top, sieve, Emacs Sieve}.
-
-@end itemize
-
-@item Changes in group mode
-@c ************************
-
-@itemize @bullet
-
-@item
-@code{gnus-group-read-ephemeral-group} can be called interactively,
-using @kbd{G M}.
-
-@item
-Retrieval of charters and control messages
-
-There are new commands for fetching newsgroup charters (@kbd{H c}) and
-control messages (@kbd{H C}).
-
-@item
-The new variable @code{gnus-parameters} can be used to set group parameters.
-
-Earlier this was done only via @kbd{G p} (or @kbd{G c}), which stored
-the parameters in @file{~/.newsrc.eld}, but via this variable you can
-enjoy the powers of customize, and simplified backups since you set the
-variable in @file{~/.gnus.el} instead of @file{~/.newsrc.eld}. The
-variable maps regular expressions matching group names to group
-parameters, a'la:
-@lisp
-(setq gnus-parameters
- '(("mail\\..*"
- (gnus-show-threads nil)
- (gnus-use-scoring nil))
- ("^nnimap:\\(foo.bar\\)$"
- (to-group . "\\1"))))
-@end lisp
-
-@item
-Unread count correct in nnimap groups.
-
-The estimated number of unread articles in the group buffer should now
-be correct for nnimap groups. This is achieved by calling
-@code{nnimap-fixup-unread-after-getting-new-news} from the
-@code{gnus-setup-news-hook} (called on startup) and
-@code{gnus-after-getting-new-news-hook}. (called after getting new
-mail). If you have modified those variables from the default, you may
-want to add @code{nnimap-fixup-unread-after-getting-new-news} again. If
-you were happy with the estimate and want to save some (minimal) time
-when getting new mail, remove the function.
-
-@item
-Group names are treated as UTF-8 by default.
-
-This is supposedly what USEFOR wanted to migrate to. See
-@code{gnus-group-name-charset-group-alist} and
-@code{gnus-group-name-charset-method-alist} for customization.
-
-@item
-@code{gnus-group-charset-alist} and
-@code{gnus-group-ignored-charsets-alist}.
-
-The regexps in these variables are compared with full group names
-instead of real group names in 5.8. Users who customize these
-variables should change those regexps accordingly. For example:
-@lisp
-("^han\\>" euc-kr) -> ("\\(^\\|:\\)han\\>" euc-kr)
-@end lisp
-
-@item
-Old intermediate incoming mail files (@file{Incoming*}) are deleted
-after a couple of days, not immediately. @xref{Mail Source
-Customization}. (New in Gnus 5.10.10 / Emacs 22.2)
-
-@end itemize
-
-@item Changes in summary and article mode
-@c **************************************
-
-@itemize @bullet
-
-@item
-@kbd{F} (@code{gnus-article-followup-with-original}) and @kbd{R}
-(@code{gnus-article-reply-with-original}) only yank the text in the
-region if the region is active.
-
-@item
-In draft groups, @kbd{e} is now bound to @code{gnus-draft-edit-message}.
-Use @kbd{B w} for @code{gnus-summary-edit-article} instead.
-
-@item
-Article Buttons
-
-More buttons for URLs, mail addresses, Message-IDs, Info links, man
-pages and Emacs or Gnus related references. @xref{Article Buttons}. The
-variables @code{gnus-button-@var{*}-level} can be used to control the
-appearance of all article buttons. @xref{Article Button Levels}.
-
-@item
-Single-part yenc encoded attachments can be decoded.
-
-@item
-Picons
-
-The picons code has been reimplemented to work in GNU Emacs---some of
-the previous options have been removed or renamed.
-
-Picons are small ``personal icons'' representing users, domain and
-newsgroups, which can be displayed in the Article buffer.
-@xref{Picons}.
-
-@item
-If the new option @code{gnus-treat-body-boundary} is non-@code{nil}, a
-boundary line is drawn at the end of the headers.
-
-@item
-Signed article headers (X-PGP-Sig) can be verified with @kbd{W p}.
-
-@item
-The Summary Buffer uses an arrow in the fringe to indicate the current
-article. Use @code{(setq gnus-summary-display-arrow nil)} to disable it.
-
-@item
-Warn about email replies to news
-
-Do you often find yourself replying to news by email by mistake? Then
-the new option @code{gnus-confirm-mail-reply-to-news} is just the thing for
-you.
-
-@item
-If the new option @code{gnus-summary-display-while-building} is
-non-@code{nil}, the summary buffer is shown and updated as it's being
-built.
-
-@item
-The new @code{recent} mark @samp{.} indicates newly arrived messages (as
-opposed to old but unread messages).
-
-@item
-Gnus supports RFC 2369 mailing list headers, and adds a number of
-related commands in mailing list groups. @xref{Mailing List}.
-
-@item
-The Date header can be displayed in a format that can be read aloud
-in English. @xref{Article Date}.
-
-@item
-diffs are automatically highlighted in groups matching
-@code{mm-uu-diff-groups-regexp}
-
-@item
-Better handling of Microsoft citation styles
-
-Gnus now tries to recognize the mangled header block that some Microsoft
-mailers use to indicate that the rest of the message is a citation, even
-though it is not quoted in any way. The variable
-@code{gnus-cite-unsightly-citation-regexp} matches the start of these
-citations.
-
-The new command @kbd{W Y f}
-(@code{gnus-article-outlook-deuglify-article}) allows deuglifying broken
-Outlook (Express) articles.
-
-@item
-@code{gnus-article-skip-boring}
-
-If you set @code{gnus-article-skip-boring} to @code{t}, then Gnus will
-not scroll down to show you a page that contains only boring text,
-which by default means cited text and signature. You can customize
-what is skippable using @code{gnus-article-boring-faces}.
-
-This feature is especially useful if you read many articles that
-consist of a little new content at the top with a long, untrimmed
-message cited below.
-
-@item
-Smileys (@samp{:-)}, @samp{;-)} etc) are now displayed graphically in
-Emacs too.
-
-Put @code{(setq gnus-treat-display-smileys nil)} in @file{~/.gnus.el} to
-disable it.
-
-@item
-Face headers handling. @xref{Face}.
-
-@item
-In the summary buffer, the new command @kbd{/ N} inserts new messages
-and @kbd{/ o} inserts old messages.
-
-@item
-Gnus decodes morse encoded messages if you press @kbd{W m}.
-
-@item
-@code{gnus-summary-line-format}
-
-The default value changed to @samp{%U%R%z%I%(%[%4L: %-23,23f%]%)
-%s\n}. Moreover @code{gnus-extra-headers},
-@code{nnmail-extra-headers} and @code{gnus-ignored-from-addresses}
-changed their default so that the users name will be replaced by the
-recipient's name or the group name posting to for @acronym{NNTP}
-groups.
-
-@item
-Deleting of attachments.
-
-The command @code{gnus-mime-save-part-and-strip} (bound to @kbd{C-o}
-on @acronym{MIME} buttons) saves a part and replaces the part with an
-external one. @code{gnus-mime-delete-part} (bound to @kbd{d} on
-@acronym{MIME} buttons) removes a part. It works only on back ends
-that support editing.
-
-@item
-@code{gnus-default-charset}
-
-The default value is determined from the
-@code{current-language-environment} variable, instead of
-@code{iso-8859-1}. Also the @samp{.*} item in
-@code{gnus-group-charset-alist} is removed.
-
-@item
-Printing capabilities are enhanced.
-
-Gnus supports Muttprint natively with @kbd{O P} from the Summary and
-Article buffers. Also, each individual @acronym{MIME} part can be
-printed using @kbd{p} on the @acronym{MIME} button.
-
-@item
-Extended format specs.
-
-Format spec @samp{%&user-date;} is added into
-@code{gnus-summary-line-format-alist}. Also, user defined extended
-format specs are supported. The extended format specs look like
-@samp{%u&foo;}, which invokes function
-@code{gnus-user-format-function-@var{foo}}. Because @samp{&} is used as the
-escape character, old user defined format @samp{%u&} is no longer supported.
-
-@item
-@kbd{/ *} (@code{gnus-summary-limit-include-cached}) is rewritten.
-@c FIXME: Was this a user-visible change?
-
-It was aliased to @kbd{Y c}
-(@code{gnus-summary-insert-cached-articles}). The new function filters
-out other articles.
-
-@item
-Some limiting commands accept a @kbd{C-u} prefix to negate the match.
-
-If @kbd{C-u} is used on subject, author or extra headers, i.e., @kbd{/
-s}, @kbd{/ a}, and @kbd{/ x}
-(@code{gnus-summary-limit-to-@{subject,author,extra@}}) respectively, the
-result will be to display all articles that do not match the expression.
-
-@item
-Gnus inlines external parts (message/external).
-
-@end itemize
-
-@item Changes in Message mode and related Gnus features
-@c ****************************************************
-
-@itemize @bullet
-
-@item
-Delayed articles
-
-You can delay the sending of a message with @kbd{C-c C-j} in the Message
-buffer. The messages are delivered at specified time. This is useful
-for sending yourself reminders. @xref{Delayed Articles}.
-
-@item
-If the new option @code{nnml-use-compressed-files} is non-@code{nil},
-the nnml back end allows compressed message files.
-
-@item
-The new option @code{gnus-gcc-mark-as-read} automatically marks
-Gcc articles as read.
-
-@item
-Externalizing of attachments
-
-If @code{gnus-gcc-externalize-attachments} or
-@code{message-fcc-externalize-attachments} is non-@code{nil}, attach
-local files as external parts.
-
-@item
-The envelope sender address can be customized when using Sendmail.
-@xref{Mail Variables, Mail Variables,, message, Message Manual}.
-
-@item
-Gnus no longer generate the Sender: header automatically.
-
-Earlier it was generated when the user configurable email address was
-different from the Gnus guessed default user address. As the guessing
-algorithm is rarely correct these days, and (more controversially) the
-only use of the Sender: header was to check if you are entitled to
-cancel/supersede news (which is now solved by Cancel Locks instead,
-see another entry), generation of the header has been disabled by
-default. See the variables @code{message-required-headers},
-@code{message-required-news-headers}, and
-@code{message-required-mail-headers}.
-
-@item
-Features from third party @file{message-utils.el} added to @file{message.el}.
-
-Message now asks if you wish to remove @samp{(was: <old subject>)} from
-subject lines (see @code{message-subject-trailing-was-query}). @kbd{C-c
-M-m} and @kbd{C-c M-f} inserts markers indicating included text.
-@kbd{C-c C-f a} adds a X-No-Archive: header. @kbd{C-c C-f x} inserts
-appropriate headers and a note in the body for cross-postings and
-followups (see the variables @code{message-cross-post-@var{*}}).
-
-@item
-References and X-Draft-From headers are no longer generated when you
-start composing messages and @code{message-generate-headers-first} is
-@code{nil}.
-
-@item
-Easy inclusion of X-Faces headers. @xref{X-Face}.
-
-@item
-Group Carbon Copy (GCC) quoting
-
-To support groups that contains SPC and other weird characters, groups
-are quoted before they are placed in the Gcc: header. This means
-variables such as @code{gnus-message-archive-group} should no longer
-contain quote characters to make groups containing SPC work. Also, if
-you are using the string @samp{nnml:foo, nnml:bar} (indicating Gcc
-into two groups) you must change it to return the list
-@code{("nnml:foo" "nnml:bar")}, otherwise the Gcc: line will be quoted
-incorrectly. Note that returning the string @samp{nnml:foo, nnml:bar}
-was incorrect earlier, it just didn't generate any problems since it
-was inserted directly.
-
-@item
-@code{message-insinuate-rmail}
-
-Adding @code{(message-insinuate-rmail)} and @code{(setq
-mail-user-agent 'gnus-user-agent)} in @file{.emacs} convinces Rmail to
-compose, reply and forward messages in message-mode, where you can
-enjoy the power of @acronym{MML}.
-
-@item
-@code{message-minibuffer-local-map}
-
-The line below enables BBDB in resending a message:
-@lisp
-(define-key message-minibuffer-local-map [(tab)]
- 'bbdb-complete-name)
-@end lisp
-
-@item
-@code{gnus-posting-styles}
-
-Add a new format of match like
-@lisp
-((header "to" "larsi.*org")
- (Organization "Somewhere, Inc."))
-@end lisp
-The old format like the lines below is obsolete, but still accepted.
-@lisp
-(header "to" "larsi.*org"
- (Organization "Somewhere, Inc."))
-@end lisp
-
-@item
-@code{message-ignored-news-headers} and @code{message-ignored-mail-headers}
-
-@samp{X-Draft-From} and @samp{X-Gnus-Agent-Meta-Information} have been
-added into these two variables. If you customized those, perhaps you
-need add those two headers too.
-
-@item
-Gnus supports the ``format=flowed'' (RFC 2646) parameter. On
-composing messages, it is enabled by @code{use-hard-newlines}.
-Decoding format=flowed was present but not documented in earlier
-versions.
-
-@item
-The option @code{mm-fill-flowed} can be used to disable treatment of
-``format=flowed'' messages. Also, flowed text is disabled when sending
-inline PGP signed messages. @xref{Flowed text, , Flowed text,
-emacs-mime, The Emacs MIME Manual}. (New in Gnus 5.10.7)
-@c This entry is also present in the node "No Gnus".
-
-@item
-Gnus supports the generation of RFC 2298 Disposition Notification requests.
-
-This is invoked with the @kbd{C-c M-n} key binding from message mode.
-
-@item
-Message supports the Importance: (RFC 2156) header.
-
-In the message buffer, @kbd{C-c C-f C-i} or @kbd{C-c C-u} cycles through
-the valid values.
-
-@item
-Gnus supports Cancel Locks in News.
-
-This means a header @samp{Cancel-Lock} is inserted in news posting. It is
-used to determine if you wrote an article or not (for canceling and
-superseding). Gnus generates a random password string the first time
-you post a message, and saves it in your @file{~/.emacs} using the Custom
-system. While the variable is called @code{canlock-password}, it is not
-security sensitive data. Publishing your canlock string on the web
-will not allow anyone to be able to anything she could not already do.
-The behavior can be changed by customizing @code{message-insert-canlock}.
-
-@item
-Gnus supports @acronym{PGP} (RFC 1991/2440), @acronym{PGP/MIME} (RFC
-2015/3156) and @acronym{S/MIME} (RFC 2630-2633).
-
-It needs an external @acronym{S/MIME} and OpenPGP implementation, but no
-additional Lisp libraries. This add several menu items to the
-Attachments menu, and @kbd{C-c RET} key bindings, when composing
-messages. This also obsoletes @code{gnus-article-hide-pgp-hook}.
-
-@item
-@acronym{MML} (Mime compose) prefix changed from @kbd{M-m} to @kbd{C-c
-C-m}.
-
-This change was made to avoid conflict with the standard binding of
-@code{back-to-indentation}, which is also useful in message mode.
-
-@item
-The default for @code{message-forward-show-mml} changed to the symbol
-@code{best}.
-
-The behavior for the @code{best} value is to show @acronym{MML} (i.e.,
-convert to @acronym{MIME}) when appropriate. @acronym{MML} will not be
-used when forwarding signed or encrypted messages, as the conversion
-invalidate the digital signature.
-
-@item
-If @code{auto-compression-mode} is enabled, attachments are automatically
-decompressed when activated.
-@c FIXME: Does this affect article or message mode?
-
-@item
-Support for non-@acronym{ASCII} domain names
-
-Message supports non-@acronym{ASCII} domain names in From:, To: and
-Cc: and will query you whether to perform encoding when you try to
-send a message. The variable @code{message-use-idna} controls this.
-Gnus will also decode non-@acronym{ASCII} domain names in From:, To:
-and Cc: when you view a message. The variable @code{gnus-use-idna}
-controls this.
-
-@item You can now drag and drop attachments to the Message buffer.
-See @code{mml-dnd-protocol-alist} and @code{mml-dnd-attach-options}.
-@xref{MIME, ,MIME, message, Message Manual}.
-@c New in 5.10.9 / 5.11
-
-@end itemize
-
-@item Changes in back ends
-@c ***********************
-
-@itemize @bullet
-@item
-Gnus can display RSS newsfeeds as a newsgroup. @xref{RSS}.
-
-@item
-The nndoc back end now supports mailman digests and exim bounces.
-
-@item
-Gnus supports Maildir groups.
-
-Gnus includes a new back end @file{nnmaildir.el}. @xref{Maildir}.
-
-@item
-The nnml and nnfolder back ends store marks for each groups.
-
-This makes it possible to take backup of nnml/nnfolder servers/groups
-separately of @file{~/.newsrc.eld}, while preserving marks. It also
-makes it possible to share articles and marks between users (without
-sharing the @file{~/.newsrc.eld} file) within e.g. a department. It
-works by storing the marks stored in @file{~/.newsrc.eld} in a per-group
-file @file{.marks} (for nnml) and @file{@var{groupname}.mrk} (for
-nnfolder, named @var{groupname}). If the nnml/nnfolder is moved to
-another machine, Gnus will automatically use the @file{.marks} or
-@file{.mrk} file instead of the information in @file{~/.newsrc.eld}.
-The new server variables @code{nnml-marks-is-evil} and
-@code{nnfolder-marks-is-evil} can be used to disable this feature.
-
-@end itemize
-
-@item Appearance
-@c *************
-
-@itemize @bullet
-
-@item
-The menu bar item (in Group and Summary buffer) named ``Misc'' has
-been renamed to ``Gnus''.
-
-@item
-The menu bar item (in Message mode) named ``@acronym{MML}'' has been
-renamed to ``Attachments''. Note that this menu also contains security
-related stuff, like signing and encryption (@pxref{Security, Security,,
-message, Message Manual}).
-
-@item
-The tool bars have been updated to use GNOME icons in Group, Summary and
-Message mode. You can also customize the tool bars: @kbd{M-x
-customize-apropos RET -tool-bar$} should get you started. This is a new
-feature in Gnus 5.10.10. (Only for Emacs, not in XEmacs.)
-
-@item The tool bar icons are now (de)activated correctly
-in the group buffer, see the variable @code{gnus-group-update-tool-bar}.
-Its default value depends on your Emacs version. This is a new feature
-in Gnus 5.10.9.
-@end itemize
-
-
-@item Miscellaneous changes
-@c ************************
-
-@itemize @bullet
-
-@item
-@code{gnus-agent}
-
-The Gnus Agent has seen a major updated and is now enabled by default,
-and all nntp and nnimap servers from @code{gnus-select-method} and
-@code{gnus-secondary-select-method} are agentized by default. Earlier
-only the server in @code{gnus-select-method} was agentized by the
-default, and the agent was disabled by default. When the agent is
-enabled, headers are now also retrieved from the Agent cache instead
-of the back ends when possible. Earlier this only happened in the
-unplugged state. You can enroll or remove servers with @kbd{J a} and
-@kbd{J r} in the server buffer. Gnus will not download articles into
-the Agent cache, unless you instruct it to do so, though, by using
-@kbd{J u} or @kbd{J s} from the Group buffer. You revert to the old
-behavior of having the Agent disabled with @code{(setq gnus-agent
-nil)}. Note that putting @code{(gnus-agentize)} in @file{~/.gnus.el}
-is not needed any more.
-
-@item
-Gnus reads the @acronym{NOV} and articles in the Agent if plugged.
-
-If one reads an article while plugged, and the article already exists
-in the Agent, it won't get downloaded once more. @code{(setq
-gnus-agent-cache nil)} reverts to the old behavior.
-
-@item
-Dired integration
-
-@code{gnus-dired-minor-mode} (see @ref{Other modes}) installs key
-bindings in dired buffers to send a file as an attachment, open a file
-using the appropriate mailcap entry, and print a file using the mailcap
-entry.
-
-@item
-The format spec @code{%C} for positioning point has changed to @code{%*}.
-
-@item
-@code{gnus-slave-unplugged}
-
-A new command which starts Gnus offline in slave mode.
-
-@end itemize
-
-@end itemize
-
-@iftex
-
-@page
-@node The Manual
-@section The Manual
-@cindex colophon
-@cindex manual
-
-This manual was generated from a TeXinfo file and then run through
-either @code{texi2dvi}
-@iflatex
-or my own home-brewed TeXinfo to \LaTeX\ transformer,
-and then run through @code{latex} and @code{dvips}
-@end iflatex
-to get what you hold in your hands now.
-
-The following conventions have been used:
-
-@enumerate
-
-@item
-This is a @samp{string}
-
-@item
-This is a @kbd{keystroke}
-
-@item
-This is a @file{file}
-
-@item
-This is a @code{symbol}
-
-@end enumerate
-
-So if I were to say ``set @code{flargnoze} to @samp{yes}'', that would
-mean:
-
-@lisp
-(setq flargnoze "yes")
-@end lisp
-
-If I say ``set @code{flumphel} to @code{yes}'', that would mean:
-
-@lisp
-(setq flumphel 'yes)
-@end lisp
-
-@samp{yes} and @code{yes} are two @emph{very} different things---don't
-ever get them confused.
-
-@iflatex
-@c @head
-Of course, everything in this manual is of vital interest, so you should
-read it all. Several times. However, if you feel like skimming the
-manual, look for that gnu head you should see in the margin over
-there---it means that what's being discussed is of more importance than
-the rest of the stuff. (On the other hand, if everything is infinitely
-important, how can anything be more important than that? Just one more
-of the mysteries of this world, I guess.)
-@end iflatex
-
-@end iftex
-
-
-@node On Writing Manuals
-@section On Writing Manuals
-
-I guess most manuals are written after-the-fact; documenting a program
-that's already there. This is not how this manual is written. When
-implementing something, I write the manual entry for that something
-straight away. I then see that it's difficult to explain the
-functionality, so I write how it's supposed to be, and then I change the
-implementation. Writing the documentation and writing the code go hand
-in hand.
-
-This, of course, means that this manual has no, or little, flow. It
-documents absolutely everything in Gnus, but often not where you're
-looking for it. It is a reference manual, and not a guide to how to get
-started with Gnus.
-
-That would be a totally different book, that should be written using the
-reference manual as source material. It would look quite different.
-
-
-@page
-@node Terminology
-@section Terminology
-
-@cindex terminology
-@table @dfn
-
-@item news
-@cindex news
-This is what you are supposed to use this thing for---reading news.
-News is generally fetched from a nearby @acronym{NNTP} server, and is
-generally publicly available to everybody. If you post news, the entire
-world is likely to read just what you have written, and they'll all
-snigger mischievously. Behind your back.
-
-@item mail
-@cindex mail
-Everything that's delivered to you personally is mail. Some news/mail
-readers (like Gnus) blur the distinction between mail and news, but
-there is a difference. Mail is private. News is public. Mailing is
-not posting, and replying is not following up.
-
-@item reply
-@cindex reply
-Send a mail to the person who has written what you are reading.
-
-@item follow up
-@cindex follow up
-Post an article to the current newsgroup responding to the article you
-are reading.
-
-@item back end
-@cindex back end
-Gnus considers mail and news to be mostly the same, really. The only
-difference is how to access the actual articles. News articles are
-commonly fetched via the protocol @acronym{NNTP}, whereas mail
-messages could be read from a file on the local disk. The internal
-architecture of Gnus thus comprises a ``front end'' and a number of
-``back ends''. Internally, when you enter a group (by hitting
-@key{RET}, say), you thereby invoke a function in the front end in
-Gnus. The front end then ``talks'' to a back end and says things like
-``Give me the list of articles in the foo group'' or ``Show me article
-number 4711''.
-
-So a back end mainly defines either a protocol (the @code{nntp} back
-end accesses news via @acronym{NNTP}, the @code{nnimap} back end
-accesses mail via @acronym{IMAP}) or a file format and directory
-layout (the @code{nnspool} back end accesses news via the common
-``spool directory'' format, the @code{nnml} back end access mail via a
-file format and directory layout that's quite similar).
-
-Gnus does not handle the underlying media, so to speak---this is all
-done by the back ends. A back end is a collection of functions to
-access the articles.
-
-However, sometimes the term ``back end'' is also used where ``server''
-would have been more appropriate. And then there is the term ``select
-method'' which can mean either. The Gnus terminology can be quite
-confusing.
-
-@item native
-@cindex native
-Gnus will always use one method (and back end) as the @dfn{native}, or
-default, way of getting news.
-
-@item foreign
-@cindex foreign
-You can also have any number of foreign groups active at the same time.
-These are groups that use non-native non-secondary back ends for getting
-news.
-
-@item secondary
-@cindex secondary
-Secondary back ends are somewhere half-way between being native and being
-foreign, but they mostly act like they are native.
-
-@item article
-@cindex article
-A message that has been posted as news.
-
-@item mail message
-@cindex mail message
-A message that has been mailed.
-
-@item message
-@cindex message
-A mail message or news article
-
-@item head
-@cindex head
-The top part of a message, where administrative information (etc.) is
-put.
-
-@item body
-@cindex body
-The rest of an article. Everything not in the head is in the
-body.
-
-@item header
-@cindex header
-A line from the head of an article.
-
-@item headers
-@cindex headers
-A collection of such lines, or a collection of heads. Or even a
-collection of @acronym{NOV} lines.
-
-@item @acronym{NOV}
-@cindex @acronym{NOV}
-@acronym{NOV} stands for News OverView, which is a type of news server
-header which provide datas containing the condensed header information
-of articles. They are produced by the server itself; in the @code{nntp}
-back end Gnus uses the ones that the @acronym{NNTP} server makes, but
-Gnus makes them by itself for some backends (in particular, @code{nnml}).
-
-When Gnus enters a group, it asks the back end for the headers of all
-unread articles in the group. Most servers support the News OverView
-format, which is more compact and much faster to read and parse than the
-normal @sc{head} format.
-
-The @acronym{NOV} data consist of one or more text lines (@pxref{Text
-Lines, ,Motion by Text Lines, elisp, The Emacs Lisp Reference Manual})
-where each line has the header information of one article. The header
-information is a tab-separated series of the header's contents including
-an article number, a subject, an author, a date, a message-id,
-references, etc.
-
-Those data enable Gnus to generate summary lines quickly. However, if
-the server does not support @acronym{NOV} or you disable it purposely or
-for some reason, Gnus will try to generate the header information by
-parsing each article's headers one by one. It will take time.
-Therefore, it is not usually a good idea to set nn*-nov-is-evil
-(@pxref{Slow/Expensive Connection}) to a non-@code{nil} value unless you
-know that the server makes wrong @acronym{NOV} data.
-
-@item level
-@cindex levels
-Each group is subscribed at some @dfn{level} or other (1-9). The ones
-that have a lower level are ``more'' subscribed than the groups with a
-higher level. In fact, groups on levels 1-5 are considered
-@dfn{subscribed}; 6-7 are @dfn{unsubscribed}; 8 are @dfn{zombies}; and 9
-are @dfn{killed}. Commands for listing groups and scanning for new
-articles will all use the numeric prefix as @dfn{working level}.
-
-@item killed groups
-@cindex killed groups
-No information on killed groups is stored or updated, which makes killed
-groups much easier to handle than subscribed groups.
-
-@item zombie groups
-@cindex zombie groups
-Just like killed groups, only slightly less dead.
-
-@item active file
-@cindex active file
-The news server has to keep track of what articles it carries, and what
-groups exist. All this information in stored in the active file, which
-is rather large, as you might surmise.
-
-@item bogus groups
-@cindex bogus groups
-A group that exists in the @file{.newsrc} file, but isn't known to the
-server (i.e., it isn't in the active file), is a @emph{bogus group}.
-This means that the group probably doesn't exist (any more).
-
-@item activating
-@cindex activating groups
-The act of asking the server for info on a group and computing the
-number of unread articles is called @dfn{activating the group}.
-Un-activated groups are listed with @samp{*} in the group buffer.
-
-@item spool
-@cindex spool
-News servers store their articles locally in one fashion or other.
-One old-fashioned storage method is to have just one file per
-article. That's called a ``traditional spool''.
-
-@item server
-@cindex server
-A machine one can connect to and get news (or mail) from.
-
-@item select method
-@cindex select method
-A structure that specifies the back end, the server and the virtual
-server settings.
-
-@item virtual server
-@cindex virtual server
-A named select method. Since a select method defines all there is to
-know about connecting to a (physical) server, taking the thing as a
-whole is a virtual server.
-
-@item washing
-@cindex washing
-Taking a buffer and running it through a filter of some sort. The
-result will (more often than not) be cleaner and more pleasing than the
-original.
-
-@item ephemeral groups
-@cindex ephemeral groups
-@cindex temporary groups
-Most groups store data on what articles you have read. @dfn{Ephemeral}
-groups are groups that will have no data stored---when you exit the
-group, it'll disappear into the aether.
-
-@item solid groups
-@cindex solid groups
-This is the opposite of ephemeral groups. All groups listed in the
-group buffer are solid groups.
-
-@item sparse articles
-@cindex sparse articles
-These are article placeholders shown in the summary buffer when
-@code{gnus-build-sparse-threads} has been switched on.
-
-@item threading
-@cindex threading
-To put responses to articles directly after the articles they respond
-to---in a hierarchical fashion.
-
-@item root
-@cindex root
-@cindex thread root
-The first article in a thread is the root. It is the ancestor of all
-articles in the thread.
-
-@item parent
-@cindex parent
-An article that has responses.
-
-@item child
-@cindex child
-An article that responds to a different article---its parent.
-
-@item digest
-@cindex digest
-A collection of messages in one file. The most common digest format is
-specified by RFC 1153.
-
-@item splitting
-@cindex splitting, terminology
-@cindex mail sorting
-@cindex mail filtering (splitting)
-The action of sorting your emails according to certain rules. Sometimes
-incorrectly called mail filtering.
-
-@end table
-
-
-@page
-@node Customization
-@section Customization
-@cindex general customization
-
-All variables are properly documented elsewhere in this manual. This
-section is designed to give general pointers on how to customize Gnus
-for some quite common situations.
-
-@menu
-* Slow/Expensive Connection:: You run a local Emacs and get the news elsewhere.
-* Slow Terminal Connection:: You run a remote Emacs.
-* Little Disk Space:: You feel that having large setup files is icky.
-* Slow Machine:: You feel like buying a faster machine.
-@end menu
-
-
-@node Slow/Expensive Connection
-@subsection Slow/Expensive Connection
-
-If you run Emacs on a machine locally, and get your news from a machine
-over some very thin strings, you want to cut down on the amount of data
-Gnus has to get from the server.
-
-@table @code
-
-@item gnus-read-active-file
-Set this to @code{nil}, which will inhibit Gnus from requesting the
-entire active file from the server. This file is often very large. You
-also have to set @code{gnus-check-new-newsgroups} and
-@code{gnus-check-bogus-newsgroups} to @code{nil} to make sure that Gnus
-doesn't suddenly decide to fetch the active file anyway.
-
-@item gnus-nov-is-evil
-@vindex gnus-nov-is-evil
-Usually this one must @emph{always} be @code{nil} (which is the
-default). If, for example, you wish to not use @acronym{NOV}
-(@pxref{Terminology}) with the @code{nntp} back end (@pxref{Crosspost
-Handling}), set @code{nntp-nov-is-evil} to a non-@code{nil} value
-instead of setting this. But you normally do not need to set
-@code{nntp-nov-is-evil} since Gnus by itself will detect whether the
-@acronym{NNTP} server supports @acronym{NOV}. Anyway, grabbing article
-headers from the @acronym{NNTP} server will not be very fast if you tell
-Gnus not to use @acronym{NOV}.
-
-As the variables for the other back ends, there are
-@code{nndiary-nov-is-evil}, @code{nndir-nov-is-evil},
-@code{nnfolder-nov-is-evil}, @code{nnimap-nov-is-evil},
-@code{nnml-nov-is-evil}, @code{nnspool-nov-is-evil}, and
-@code{nnwarchive-nov-is-evil}. Note that a non-@code{nil} value for
-@code{gnus-nov-is-evil} overrides all those variables.@footnote{Although
-the back ends @code{nnkiboze}, @code{nnslashdot}, @code{nnultimate}, and
-@code{nnwfm} don't have their own nn*-nov-is-evil.}
-@end table
-
-
-@node Slow Terminal Connection
-@subsection Slow Terminal Connection
-
-Let's say you use your home computer for dialing up the system that runs
-Emacs and Gnus. If your modem is slow, you want to reduce (as much as
-possible) the amount of data sent over the wires.
-
-@table @code
-
-@item gnus-auto-center-summary
-Set this to @code{nil} to inhibit Gnus from re-centering the summary
-buffer all the time. If it is @code{vertical}, do only vertical
-re-centering. If it is neither @code{nil} nor @code{vertical}, do both
-horizontal and vertical recentering.
-
-@item gnus-visible-headers
-Cut down on the headers included in the articles to the
-minimum. You can, in fact, make do without them altogether---most of the
-useful data is in the summary buffer, anyway. Set this variable to
-@samp{^NEVVVVER} or @samp{From:}, or whatever you feel you need.
-
-Use the following to enable all the available hiding features:
-@lisp
-(setq gnus-treat-hide-headers 'head
- gnus-treat-hide-signature t
- gnus-treat-hide-citation t)
-@end lisp
-
-@item gnus-use-full-window
-By setting this to @code{nil}, you can make all the windows smaller.
-While this doesn't really cut down much generally, it means that you
-have to see smaller portions of articles before deciding that you didn't
-want to read them anyway.
-
-@item gnus-thread-hide-subtree
-If this is non-@code{nil}, all threads in the summary buffer will be
-hidden initially.
-
-
-@item gnus-updated-mode-lines
-If this is @code{nil}, Gnus will not put information in the buffer mode
-lines, which might save some time.
-@end table
-
-
-@node Little Disk Space
-@subsection Little Disk Space
-@cindex disk space
-
-The startup files can get rather large, so you may want to cut their
-sizes a bit if you are running out of space.
-
-@table @code
-
-@item gnus-save-newsrc-file
-If this is @code{nil}, Gnus will never save @file{.newsrc}---it will
-only save @file{.newsrc.eld}. This means that you will not be able to
-use any other newsreaders than Gnus. This variable is @code{t} by
-default.
-
-@item gnus-read-newsrc-file
-If this is @code{nil}, Gnus will never read @file{.newsrc}---it will
-only read @file{.newsrc.eld}. This means that you will not be able to
-use any other newsreaders than Gnus. This variable is @code{t} by
-default.
-
-@item gnus-save-killed-list
-If this is @code{nil}, Gnus will not save the list of dead groups. You
-should also set @code{gnus-check-new-newsgroups} to @code{ask-server}
-and @code{gnus-check-bogus-newsgroups} to @code{nil} if you set this
-variable to @code{nil}. This variable is @code{t} by default.
-
-@end table
-
-
-@node Slow Machine
-@subsection Slow Machine
-@cindex slow machine
-
-If you have a slow machine, or are just really impatient, there are a
-few things you can do to make Gnus run faster.
-
-Set @code{gnus-check-new-newsgroups} and
-@code{gnus-check-bogus-newsgroups} to @code{nil} to make startup faster.
-
-Set @code{gnus-show-threads}, @code{gnus-use-cross-reference} and
-@code{gnus-nov-is-evil} to @code{nil} to make entering and exiting the
-summary buffer faster. Also @pxref{Slow/Expensive Connection}.
-
-
-@page
-@node Troubleshooting
-@section Troubleshooting
-@cindex troubleshooting
-
-Gnus works @emph{so} well straight out of the box---I can't imagine any
-problems, really.
-
-Ahem.
-
-@enumerate
-
-@item
-Make sure your computer is switched on.
-
-@item
-Make sure that you really load the current Gnus version. If you have
-been running @sc{gnus}, you need to exit Emacs and start it up again before
-Gnus will work.
-
-@item
-Try doing an @kbd{M-x gnus-version}. If you get something that looks
-like @c
-@samp{Gnus v5.10.8} @c Adjust ../Makefile.in if you change this line!
-@c
-you have the right files loaded. Otherwise you have some old @file{.el}
-files lying around. Delete these.
-
-@item
-Read the help group (@kbd{G h} in the group buffer) for a
-@acronym{FAQ} and a how-to.
-
-@item
-@vindex max-lisp-eval-depth
-Gnus works on many recursive structures, and in some extreme (and very
-rare) cases Gnus may recurse down ``too deeply'' and Emacs will beep at
-you. If this happens to you, set @code{max-lisp-eval-depth} to 500 or
-something like that.
-@end enumerate
-
-If all else fails, report the problem as a bug.
-
-@cindex bugs
-@cindex reporting bugs
-
-@kindex M-x gnus-bug
-@findex gnus-bug
-If you find a bug in Gnus, you can report it with the @kbd{M-x gnus-bug}
-command. @kbd{M-x set-variable RET debug-on-error RET t RET}, and send
-me the backtrace. I will fix bugs, but I can only fix them if you send
-me a precise description as to how to reproduce the bug.
-
-You really can never be too detailed in a bug report. Always use the
-@kbd{M-x gnus-bug} command when you make bug reports, even if it creates
-a 10Kb mail each time you use it, and even if you have sent me your
-environment 500 times before. I don't care. I want the full info each
-time.
-
-It is also important to remember that I have no memory whatsoever. If
-you send a bug report, and I send you a reply, and then you just send
-back ``No, it's not! Moron!'', I will have no idea what you are
-insulting me about. Always over-explain everything. It's much easier
-for all of us---if I don't have all the information I need, I will just
-mail you and ask for more info, and everything takes more time.
-
-If the problem you're seeing is very visual, and you can't quite explain
-it, copy the Emacs window to a file (with @code{xwd}, for instance), put
-it somewhere it can be reached, and include the URL of the picture in
-the bug report.
-
-@cindex patches
-If you would like to contribute a patch to fix bugs or make
-improvements, please produce the patch using @samp{diff -u}.
-
-@cindex edebug
-If you want to debug your problem further before reporting, possibly
-in order to solve the problem yourself and send a patch, you can use
-edebug. Debugging Lisp code is documented in the Elisp manual
-(@pxref{Debugging, , Debugging Lisp Programs, elisp, The GNU Emacs
-Lisp Reference Manual}). To get you started with edebug, consider if
-you discover some weird behavior when pressing @kbd{c}, the first
-step is to do @kbd{C-h k c} and click on the hyperlink (Emacs only) in
-the documentation buffer that leads you to the function definition,
-then press @kbd{M-x edebug-defun RET} with point inside that function,
-return to Gnus and press @kbd{c} to invoke the code. You will be
-placed in the lisp buffer and can single step using @kbd{SPC} and
-evaluate expressions using @kbd{M-:} or inspect variables using
-@kbd{C-h v}, abort execution with @kbd{q}, and resume execution with
-@kbd{c} or @kbd{g}.
-
-@cindex elp
-@cindex profile
-@cindex slow
-Sometimes, a problem do not directly generate an elisp error but
-manifests itself by causing Gnus to be very slow. In these cases, you
-can use @kbd{M-x toggle-debug-on-quit} and press @kbd{C-g} when things are
-slow, and then try to analyze the backtrace (repeating the procedure
-helps isolating the real problem areas).
-
-A fancier approach is to use the elisp profiler, ELP. The profiler is
-(or should be) fully documented elsewhere, but to get you started
-there are a few steps that need to be followed. First, instrument the
-part of Gnus you are interested in for profiling, e.g. @kbd{M-x
-elp-instrument-package RET gnus} or @kbd{M-x elp-instrument-package
-RET message}. Then perform the operation that is slow and press
-@kbd{M-x elp-results}. You will then see which operations that takes
-time, and can debug them further. If the entire operation takes much
-longer than the time spent in the slowest function in the profiler
-output, you probably profiled the wrong part of Gnus. To reset
-profiling statistics, use @kbd{M-x elp-reset-all}. @kbd{M-x
-elp-restore-all} is supposed to remove profiling, but given the
-complexities and dynamic code generation in Gnus, it might not always
-work perfectly.
-
-@cindex gnu.emacs.gnus
-@cindex ding mailing list
-If you just need help, you are better off asking on
-@samp{gnu.emacs.gnus}. I'm not very helpful. You can also ask on
-@email{ding@@gnus.org, the ding mailing list}. Write to
-@email{ding-request@@gnus.org} to subscribe.
-
-
-@page
-@node Gnus Reference Guide
-@section Gnus Reference Guide
-
-It is my hope that other people will figure out smart stuff that Gnus
-can do, and that other people will write those smart things as well. To
-facilitate that I thought it would be a good idea to describe the inner
-workings of Gnus. And some of the not-so-inner workings, while I'm at
-it.
-
-You can never expect the internals of a program not to change, but I
-will be defining (in some details) the interface between Gnus and its
-back ends (this is written in stone), the format of the score files
-(ditto), data structures (some are less likely to change than others)
-and general methods of operation.
-
-@menu
-* Gnus Utility Functions:: Common functions and variable to use.
-* Back End Interface:: How Gnus communicates with the servers.
-* Score File Syntax:: A BNF definition of the score file standard.
-* Headers:: How Gnus stores headers internally.
-* Ranges:: A handy format for storing mucho numbers.
-* Group Info:: The group info format.
-* Extended Interactive:: Symbolic prefixes and stuff.
-* Emacs/XEmacs Code:: Gnus can be run under all modern Emacsen.
-* Various File Formats:: Formats of files that Gnus use.
-@end menu
-
-
-@node Gnus Utility Functions
-@subsection Gnus Utility Functions
-@cindex Gnus utility functions
-@cindex utility functions
-@cindex functions
-@cindex internal variables
-
-When writing small functions to be run from hooks (and stuff), it's
-vital to have access to the Gnus internal functions and variables.
-Below is a list of the most common ones.
-
-@table @code
-
-@item gnus-newsgroup-name
-@vindex gnus-newsgroup-name
-This variable holds the name of the current newsgroup.
-
-@item gnus-find-method-for-group
-@findex gnus-find-method-for-group
-A function that returns the select method for @var{group}.
-
-@item gnus-group-real-name
-@findex gnus-group-real-name
-Takes a full (prefixed) Gnus group name, and returns the unprefixed
-name.
-
-@item gnus-group-prefixed-name
-@findex gnus-group-prefixed-name
-Takes an unprefixed group name and a select method, and returns the full
-(prefixed) Gnus group name.
-
-@item gnus-get-info
-@findex gnus-get-info
-Returns the group info list for @var{group}.
-
-@item gnus-group-unread
-@findex gnus-group-unread
-The number of unread articles in @var{group}, or @code{t} if that is
-unknown.
-
-@item gnus-active
-@findex gnus-active
-The active entry for @var{group}.
-
-@item gnus-set-active
-@findex gnus-set-active
-Set the active entry for @var{group}.
-
-@item gnus-add-current-to-buffer-list
-@findex gnus-add-current-to-buffer-list
-Adds the current buffer to the list of buffers to be killed on Gnus
-exit.
-
-@item gnus-continuum-version
-@findex gnus-continuum-version
-Takes a Gnus version string as a parameter and returns a floating point
-number. Earlier versions will always get a lower number than later
-versions.
-
-@item gnus-group-read-only-p
-@findex gnus-group-read-only-p
-Says whether @var{group} is read-only or not.
-
-@item gnus-news-group-p
-@findex gnus-news-group-p
-Says whether @var{group} came from a news back end.
-
-@item gnus-ephemeral-group-p
-@findex gnus-ephemeral-group-p
-Says whether @var{group} is ephemeral or not.
-
-@item gnus-server-to-method
-@findex gnus-server-to-method
-Returns the select method corresponding to @var{server}.
-
-@item gnus-server-equal
-@findex gnus-server-equal
-Says whether two virtual servers are equal.
-
-@item gnus-group-native-p
-@findex gnus-group-native-p
-Says whether @var{group} is native or not.
-
-@item gnus-group-secondary-p
-@findex gnus-group-secondary-p
-Says whether @var{group} is secondary or not.
-
-@item gnus-group-foreign-p
-@findex gnus-group-foreign-p
-Says whether @var{group} is foreign or not.
-
-@item gnus-group-find-parameter
-@findex gnus-group-find-parameter
-Returns the parameter list of @var{group}. If given a second parameter,
-returns the value of that parameter for @var{group}.
-
-@item gnus-group-set-parameter
-@findex gnus-group-set-parameter
-Takes three parameters; @var{group}, @var{parameter} and @var{value}.
-
-@item gnus-narrow-to-body
-@findex gnus-narrow-to-body
-Narrows the current buffer to the body of the article.
-
-@item gnus-check-backend-function
-@findex gnus-check-backend-function
-Takes two parameters, @var{function} and @var{group}. If the back end
-@var{group} comes from supports @var{function}, return non-@code{nil}.
-
-@lisp
-(gnus-check-backend-function "request-scan" "nnml:misc")
-@result{} t
-@end lisp
-
-@item gnus-read-method
-@findex gnus-read-method
-Prompts the user for a select method.
-
-@end table
-
-
-@node Back End Interface
-@subsection Back End Interface
-
-Gnus doesn't know anything about @acronym{NNTP}, spools, mail or virtual
-groups. It only knows how to talk to @dfn{virtual servers}. A virtual
-server is a @dfn{back end} and some @dfn{back end variables}. As examples
-of the first, we have @code{nntp}, @code{nnspool} and @code{nnmbox}. As
-examples of the latter we have @code{nntp-port-number} and
-@code{nnmbox-directory}.
-
-When Gnus asks for information from a back end---say @code{nntp}---on
-something, it will normally include a virtual server name in the
-function parameters. (If not, the back end should use the ``current''
-virtual server.) For instance, @code{nntp-request-list} takes a virtual
-server as its only (optional) parameter. If this virtual server hasn't
-been opened, the function should fail.
-
-Note that a virtual server name has no relation to some physical server
-name. Take this example:
-
-@lisp
-(nntp "odd-one"
- (nntp-address "ifi.uio.no")
- (nntp-port-number 4324))
-@end lisp
-
-Here the virtual server name is @samp{odd-one} while the name of
-the physical server is @samp{ifi.uio.no}.
-
-The back ends should be able to switch between several virtual servers.
-The standard back ends implement this by keeping an alist of virtual
-server environments that they pull down/push up when needed.
-
-There are two groups of interface functions: @dfn{required functions},
-which must be present, and @dfn{optional functions}, which Gnus will
-always check for presence before attempting to call 'em.
-
-All these functions are expected to return data in the buffer
-@code{nntp-server-buffer} (@samp{ *nntpd*}), which is somewhat
-unfortunately named, but we'll have to live with it. When I talk about
-@dfn{resulting data}, I always refer to the data in that buffer. When I
-talk about @dfn{return value}, I talk about the function value returned by
-the function call. Functions that fail should return @code{nil} as the
-return value.
-
-Some back ends could be said to be @dfn{server-forming} back ends, and
-some might be said not to be. The latter are back ends that generally
-only operate on one group at a time, and have no concept of ``server''
----they have a group, and they deliver info on that group and nothing
-more.
-
-Gnus identifies each message by way of group name and article number. A
-few remarks about these article numbers might be useful. First of all,
-the numbers are positive integers. Secondly, it is normally not
-possible for later articles to ``re-use'' older article numbers without
-confusing Gnus. That is, if a group has ever contained a message
-numbered 42, then no other message may get that number, or Gnus will get
-mightily confused.@footnote{See the function
-@code{nnchoke-request-update-info}, @ref{Optional Back End Functions}.}
-Third, article numbers must be assigned in order of arrival in the
-group; this is not necessarily the same as the date of the message.
-
-The previous paragraph already mentions all the ``hard'' restrictions that
-article numbers must fulfill. But it seems that it might be useful to
-assign @emph{consecutive} article numbers, for Gnus gets quite confused
-if there are holes in the article numbering sequence. However, due to
-the ``no-reuse'' restriction, holes cannot be avoided altogether. It's
-also useful for the article numbers to start at 1 to avoid running out
-of numbers as long as possible.
-
-Note that by convention, back ends are named @code{nnsomething}, but
-Gnus also comes with some @code{nnnotbackends}, such as
-@file{nnheader.el}, @file{nnmail.el} and @file{nnoo.el}.
-
-In the examples and definitions I will refer to the imaginary back end
-@code{nnchoke}.
-
-@cindex @code{nnchoke}
-
-@menu
-* Required Back End Functions:: Functions that must be implemented.
-* Optional Back End Functions:: Functions that need not be implemented.
-* Error Messaging:: How to get messages and report errors.
-* Writing New Back Ends:: Extending old back ends.
-* Hooking New Back Ends Into Gnus:: What has to be done on the Gnus end.
-* Mail-like Back Ends:: Some tips on mail back ends.
-@end menu
-
-
-@node Required Back End Functions
-@subsubsection Required Back End Functions
-
-@table @code
-
-@item (nnchoke-retrieve-headers ARTICLES &optional GROUP SERVER FETCH-OLD)
-
-@var{articles} is either a range of article numbers or a list of
-@code{Message-ID}s. Current back ends do not fully support either---only
-sequences (lists) of article numbers, and most back ends do not support
-retrieval of @code{Message-ID}s. But they should try for both.
-
-The result data should either be HEADs or @acronym{NOV} lines, and the result
-value should either be @code{headers} or @code{nov} to reflect this.
-This might later be expanded to @code{various}, which will be a mixture
-of HEADs and @acronym{NOV} lines, but this is currently not supported by Gnus.
-
-If @var{fetch-old} is non-@code{nil} it says to try fetching ``extra
-headers'', in some meaning of the word. This is generally done by
-fetching (at most) @var{fetch-old} extra headers less than the smallest
-article number in @code{articles}, and filling the gaps as well. The
-presence of this parameter can be ignored if the back end finds it
-cumbersome to follow the request. If this is non-@code{nil} and not a
-number, do maximum fetches.
-
-Here's an example HEAD:
-
-@example
-221 1056 Article retrieved.
-Path: ifi.uio.no!sturles
-From: sturles@@ifi.uio.no (Sturle Sunde)
-Newsgroups: ifi.discussion
-Subject: Re: Something very droll
-Date: 27 Oct 1994 14:02:57 +0100
-Organization: Dept. of Informatics, University of Oslo, Norway
-Lines: 26
-Message-ID: <38o8e1$a0o@@holmenkollen.ifi.uio.no>
-References: <38jdmq$4qu@@visbur.ifi.uio.no>
-NNTP-Posting-Host: holmenkollen.ifi.uio.no
-.
-@end example
-
-So a @code{headers} return value would imply that there's a number of
-these in the data buffer.
-
-Here's a BNF definition of such a buffer:
-
-@example
-headers = *head
-head = error / valid-head
-error-message = [ "4" / "5" ] 2number " " <error message> eol
-valid-head = valid-message *header "." eol
-valid-message = "221 " <number> " Article retrieved." eol
-header = <text> eol
-@end example
-
-@cindex BNF
-(The version of BNF used here is the one used in RFC822.)
-
-If the return value is @code{nov}, the data buffer should contain
-@dfn{network overview database} lines. These are basically fields
-separated by tabs.
-
-@example
-nov-buffer = *nov-line
-nov-line = field 7*8[ <TAB> field ] eol
-field = <text except TAB>
-@end example
-
-For a closer look at what should be in those fields,
-@pxref{Headers}.
-
-
-@item (nnchoke-open-server SERVER &optional DEFINITIONS)
-
-@var{server} is here the virtual server name. @var{definitions} is a
-list of @code{(VARIABLE VALUE)} pairs that define this virtual server.
-
-If the server can't be opened, no error should be signaled. The back end
-may then choose to refuse further attempts at connecting to this
-server. In fact, it should do so.
-
-If the server is opened already, this function should return a
-non-@code{nil} value. There should be no data returned.
-
-
-@item (nnchoke-close-server &optional SERVER)
-
-Close connection to @var{server} and free all resources connected
-to it. Return @code{nil} if the server couldn't be closed for some
-reason.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-close)
-
-Close connection to all servers and free all resources that the back end
-have reserved. All buffers that have been created by that back end
-should be killed. (Not the @code{nntp-server-buffer}, though.) This
-function is generally only called when Gnus is shutting down.
-
-There should be no data returned.
-
-
-@item (nnchoke-server-opened &optional SERVER)
-
-If @var{server} is the current virtual server, and the connection to the
-physical server is alive, then this function should return a
-non-@code{nil} value. This function should under no circumstances
-attempt to reconnect to a server we have lost connection to.
-
-There should be no data returned.
-
-
-@item (nnchoke-status-message &optional SERVER)
-
-This function should return the last error message from @var{server}.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-article ARTICLE &optional GROUP SERVER TO-BUFFER)
-
-The result data from this function should be the article specified by
-@var{article}. This might either be a @code{Message-ID} or a number.
-It is optional whether to implement retrieval by @code{Message-ID}, but
-it would be nice if that were possible.
-
-If @var{to-buffer} is non-@code{nil}, the result data should be returned
-in this buffer instead of the normal data buffer. This is to make it
-possible to avoid copying large amounts of data from one buffer to
-another, while Gnus mainly requests articles to be inserted directly
-into its article buffer.
-
-If it is at all possible, this function should return a cons cell where
-the @code{car} is the group name the article was fetched from, and the @code{cdr} is
-the article number. This will enable Gnus to find out what the real
-group and article numbers are when fetching articles by
-@code{Message-ID}. If this isn't possible, @code{t} should be returned
-on successful article retrieval.
-
-
-@item (nnchoke-request-group GROUP &optional SERVER FAST)
-
-Get data on @var{group}. This function also has the side effect of
-making @var{group} the current group.
-
-If @var{fast}, don't bother to return useful data, just make @var{group}
-the current group.
-
-Here's an example of some result data and a definition of the same:
-
-@example
-211 56 1000 1059 ifi.discussion
-@end example
-
-The first number is the status, which should be 211. Next is the
-total number of articles in the group, the lowest article number, the
-highest article number, and finally the group name. Note that the total
-number of articles may be less than one might think while just
-considering the highest and lowest article numbers, but some articles
-may have been canceled. Gnus just discards the total-number, so
-whether one should take the bother to generate it properly (if that is a
-problem) is left as an exercise to the reader. If the group contains no
-articles, the lowest article number should be reported as 1 and the
-highest as 0.
-
-@example
-group-status = [ error / info ] eol
-error = [ "4" / "5" ] 2<number> " " <Error message>
-info = "211 " 3* [ <number> " " ] <string>
-@end example
-
-
-@item (nnchoke-close-group GROUP &optional SERVER)
-
-Close @var{group} and free any resources connected to it. This will be
-a no-op on most back ends.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-list &optional SERVER)
-
-Return a list of all groups available on @var{server}. And that means
-@emph{all}.
-
-Here's an example from a server that only carries two groups:
-
-@example
-ifi.test 0000002200 0000002000 y
-ifi.discussion 3324 3300 n
-@end example
-
-On each line we have a group name, then the highest article number in
-that group, the lowest article number, and finally a flag. If the group
-contains no articles, the lowest article number should be reported as 1
-and the highest as 0.
-
-@example
-active-file = *active-line
-active-line = name " " <number> " " <number> " " flags eol
-name = <string>
-flags = "n" / "y" / "m" / "x" / "j" / "=" name
-@end example
-
-The flag says whether the group is read-only (@samp{n}), is moderated
-(@samp{m}), is dead (@samp{x}), is aliased to some other group
-(@samp{=other-group}) or none of the above (@samp{y}).
-
-
-@item (nnchoke-request-post &optional SERVER)
-
-This function should post the current buffer. It might return whether
-the posting was successful or not, but that's not required. If, for
-instance, the posting is done asynchronously, it has generally not been
-completed by the time this function concludes. In that case, this
-function should set up some kind of sentinel to beep the user loud and
-clear if the posting could not be completed.
-
-There should be no result data from this function.
-
-@end table
-
-
-@node Optional Back End Functions
-@subsubsection Optional Back End Functions
-
-@table @code
-
-@item (nnchoke-retrieve-groups GROUPS &optional SERVER)
-
-@var{groups} is a list of groups, and this function should request data
-on all those groups. How it does it is of no concern to Gnus, but it
-should attempt to do this in a speedy fashion.
-
-The return value of this function can be either @code{active} or
-@code{group}, which says what the format of the result data is. The
-former is in the same format as the data from
-@code{nnchoke-request-list}, while the latter is a buffer full of lines
-in the same format as @code{nnchoke-request-group} gives.
-
-@example
-group-buffer = *active-line / *group-status
-@end example
-
-
-@item (nnchoke-request-update-info GROUP INFO &optional SERVER)
-
-A Gnus group info (@pxref{Group Info}) is handed to the back end for
-alterations. This comes in handy if the back end really carries all
-the information (as is the case with virtual and imap groups). This
-function should destructively alter the info to suit its needs, and
-should return a non-@code{nil} value.
-
-There should be no result data from this function.
-
-
-@item (nnchoke-request-type GROUP &optional ARTICLE)
-
-When the user issues commands for ``sending news'' (@kbd{F} in the
-summary buffer, for instance), Gnus has to know whether the article the
-user is following up on is news or mail. This function should return
-@code{news} if @var{article} in @var{group} is news, @code{mail} if it
-is mail and @code{unknown} if the type can't be decided. (The
-@var{article} parameter is necessary in @code{nnvirtual} groups which
-might very well combine mail groups and news groups.) Both @var{group}
-and @var{article} may be @code{nil}.
-
-There should be no result data from this function.
-
-
-@item (nnchoke-request-set-mark GROUP ACTION &optional SERVER)
-
-Set/remove/add marks on articles. Normally Gnus handles the article
-marks (such as read, ticked, expired etc) internally, and store them in
-@file{~/.newsrc.eld}. Some back ends (such as @acronym{IMAP}) however carry
-all information about the articles on the server, so Gnus need to
-propagate the mark information to the server.
-
-@var{action} is a list of mark setting requests, having this format:
-
-@example
-(RANGE ACTION MARK)
-@end example
-
-@var{range} is a range of articles you wish to update marks on.
-@var{action} is @code{add} or @code{del}, used to add marks or remove
-marks (preserving all marks not mentioned). @var{mark} is a list of
-marks; where each mark is a symbol. Currently used marks are
-@code{read}, @code{tick}, @code{reply}, @code{expire}, @code{killed},
-@code{dormant}, @code{save}, @code{download}, @code{unsend},
-@code{forward} and @code{recent}, but your back end should, if
-possible, not limit itself to these.
-
-Given contradictory actions, the last action in the list should be the
-effective one. That is, if your action contains a request to add the
-@code{tick} mark on article 1 and, later in the list, a request to
-remove the mark on the same article, the mark should in fact be removed.
-
-An example action list:
-
-@example
-(((5 12 30) 'del '(tick))
- ((10 . 90) 'add '(read expire))
- ((92 94) 'del '(read)))
-@end example
-
-The function should return a range of articles it wasn't able to set the
-mark on (currently not used for anything).
-
-There should be no result data from this function.
-
-@item (nnchoke-request-update-mark GROUP ARTICLE MARK)
-
-If the user tries to set a mark that the back end doesn't like, this
-function may change the mark. Gnus will use whatever this function
-returns as the mark for @var{article} instead of the original
-@var{mark}. If the back end doesn't care, it must return the original
-@var{mark}, and not @code{nil} or any other type of garbage.
-
-The only use for this I can see is what @code{nnvirtual} does with
-it---if a component group is auto-expirable, marking an article as read
-in the virtual group should result in the article being marked as
-expirable.
-
-There should be no result data from this function.
-
-
-@item (nnchoke-request-scan &optional GROUP SERVER)
-
-This function may be called at any time (by Gnus or anything else) to
-request that the back end check for incoming articles, in one way or
-another. A mail back end will typically read the spool file or query
-the @acronym{POP} server when this function is invoked. The
-@var{group} doesn't have to be heeded---if the back end decides that
-it is too much work just scanning for a single group, it may do a
-total scan of all groups. It would be nice, however, to keep things
-local if that's practical.
-
-There should be no result data from this function.
-
-
-@item (nnchoke-request-group-description GROUP &optional SERVER)
-
-The result data from this function should be a description of
-@var{group}.
-
-@example
-description-line = name <TAB> description eol
-name = <string>
-description = <text>
-@end example
-
-@item (nnchoke-request-list-newsgroups &optional SERVER)
-
-The result data from this function should be the description of all
-groups available on the server.
-
-@example
-description-buffer = *description-line
-@end example
-
-
-@item (nnchoke-request-newgroups DATE &optional SERVER)
-
-The result data from this function should be all groups that were
-created after @samp{date}, which is in normal human-readable date format
-(i.e., the date format used in mail and news headers, and returned by
-the function @code{message-make-date} by default). The data should be
-in the active buffer format.
-
-It is okay for this function to return ``too many'' groups; some back ends
-might find it cheaper to return the full list of groups, rather than
-just the new groups. But don't do this for back ends with many groups.
-Normally, if the user creates the groups herself, there won't be too
-many groups, so @code{nnml} and the like are probably safe. But for
-back ends like @code{nntp}, where the groups have been created by the
-server, it is quite likely that there can be many groups.
-
-
-@item (nnchoke-request-create-group GROUP &optional SERVER)
-
-This function should create an empty group with name @var{group}.
-
-There should be no return data.
-
-
-@item (nnchoke-request-expire-articles ARTICLES &optional GROUP SERVER FORCE)
-
-This function should run the expiry process on all articles in the
-@var{articles} range (which is currently a simple list of article
-numbers.) It is left up to the back end to decide how old articles
-should be before they are removed by this function. If @var{force} is
-non-@code{nil}, all @var{articles} should be deleted, no matter how new
-they are.
-
-This function should return a list of articles that it did not/was not
-able to delete.
-
-There should be no result data returned.
-
-
-@item (nnchoke-request-move-article ARTICLE GROUP SERVER ACCEPT-FORM &optional LAST)
-
-This function should move @var{article} (which is a number) from
-@var{group} by calling @var{accept-form}.
-
-This function should ready the article in question for moving by
-removing any header lines it has added to the article, and generally
-should ``tidy up'' the article. Then it should @code{eval}
-@var{accept-form} in the buffer where the ``tidy'' article is. This
-will do the actual copying. If this @code{eval} returns a
-non-@code{nil} value, the article should be removed.
-
-If @var{last} is @code{nil}, that means that there is a high likelihood
-that there will be more requests issued shortly, so that allows some
-optimizations.
-
-The function should return a cons where the @code{car} is the group name and
-the @code{cdr} is the article number that the article was entered as.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-accept-article GROUP &optional SERVER LAST)
-
-This function takes the current buffer and inserts it into @var{group}.
-If @var{last} in @code{nil}, that means that there will be more calls to
-this function in short order.
-
-The function should return a cons where the @code{car} is the group name and
-the @code{cdr} is the article number that the article was entered as.
-
-The group should exist before the back end is asked to accept the
-article for that group.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-replace-article ARTICLE GROUP BUFFER)
-
-This function should remove @var{article} (which is a number) from
-@var{group} and insert @var{buffer} there instead.
-
-There should be no data returned.
-
-
-@item (nnchoke-request-delete-group GROUP FORCE &optional SERVER)
-
-This function should delete @var{group}. If @var{force}, it should
-really delete all the articles in the group, and then delete the group
-itself. (If there is such a thing as ``the group itself''.)
-
-There should be no data returned.
-
-
-@item (nnchoke-request-rename-group GROUP NEW-NAME &optional SERVER)
-
-This function should rename @var{group} into @var{new-name}. All
-articles in @var{group} should move to @var{new-name}.
-
-There should be no data returned.
-
-@end table
-
-
-@node Error Messaging
-@subsubsection Error Messaging
-
-@findex nnheader-report
-@findex nnheader-get-report
-The back ends should use the function @code{nnheader-report} to report
-error conditions---they should not raise errors when they aren't able to
-perform a request. The first argument to this function is the back end
-symbol, and the rest are interpreted as arguments to @code{format} if
-there are multiple of them, or just a string if there is one of them.
-This function must always returns @code{nil}.
-
-@lisp
-(nnheader-report 'nnchoke "You did something totally bogus")
-
-(nnheader-report 'nnchoke "Could not request group %s" group)
-@end lisp
-
-Gnus, in turn, will call @code{nnheader-get-report} when it gets a
-@code{nil} back from a server, and this function returns the most
-recently reported message for the back end in question. This function
-takes one argument---the server symbol.
-
-Internally, these functions access @var{back-end}@code{-status-string},
-so the @code{nnchoke} back end will have its error message stored in
-@code{nnchoke-status-string}.
-
-
-@node Writing New Back Ends
-@subsubsection Writing New Back Ends
-
-Many back ends are quite similar. @code{nnml} is just like
-@code{nnspool}, but it allows you to edit the articles on the server.
-@code{nnmh} is just like @code{nnml}, but it doesn't use an active file,
-and it doesn't maintain overview databases. @code{nndir} is just like
-@code{nnml}, but it has no concept of ``groups'', and it doesn't allow
-editing articles.
-
-It would make sense if it were possible to ``inherit'' functions from
-back ends when writing new back ends. And, indeed, you can do that if you
-want to. (You don't have to if you don't want to, of course.)
-
-All the back ends declare their public variables and functions by using a
-package called @code{nnoo}.
-
-To inherit functions from other back ends (and allow other back ends to
-inherit functions from the current back end), you should use the
-following macros:
-
-@table @code
-
-@item nnoo-declare
-This macro declares the first parameter to be a child of the subsequent
-parameters. For instance:
-
-@lisp
-(nnoo-declare nndir
- nnml nnmh)
-@end lisp
-
-@code{nndir} has declared here that it intends to inherit functions from
-both @code{nnml} and @code{nnmh}.
-
-@item defvoo
-This macro is equivalent to @code{defvar}, but registers the variable as
-a public server variable. Most state-oriented variables should be
-declared with @code{defvoo} instead of @code{defvar}.
-
-In addition to the normal @code{defvar} parameters, it takes a list of
-variables in the parent back ends to map the variable to when executing
-a function in those back ends.
-
-@lisp
-(defvoo nndir-directory nil
- "Where nndir will look for groups."
- nnml-current-directory nnmh-current-directory)
-@end lisp
-
-This means that @code{nnml-current-directory} will be set to
-@code{nndir-directory} when an @code{nnml} function is called on behalf
-of @code{nndir}. (The same with @code{nnmh}.)
-
-@item nnoo-define-basics
-This macro defines some common functions that almost all back ends should
-have.
-
-@lisp
-(nnoo-define-basics nndir)
-@end lisp
-
-@item deffoo
-This macro is just like @code{defun} and takes the same parameters. In
-addition to doing the normal @code{defun} things, it registers the
-function as being public so that other back ends can inherit it.
-
-@item nnoo-map-functions
-This macro allows mapping of functions from the current back end to
-functions from the parent back ends.
-
-@lisp
-(nnoo-map-functions nndir
- (nnml-retrieve-headers 0 nndir-current-group 0 0)
- (nnmh-request-article 0 nndir-current-group 0 0))
-@end lisp
-
-This means that when @code{nndir-retrieve-headers} is called, the first,
-third, and fourth parameters will be passed on to
-@code{nnml-retrieve-headers}, while the second parameter is set to the
-value of @code{nndir-current-group}.
-
-@item nnoo-import
-This macro allows importing functions from back ends. It should be the
-last thing in the source file, since it will only define functions that
-haven't already been defined.
-
-@lisp
-(nnoo-import nndir
- (nnmh
- nnmh-request-list
- nnmh-request-newgroups)
- (nnml))
-@end lisp
-
-This means that calls to @code{nndir-request-list} should just be passed
-on to @code{nnmh-request-list}, while all public functions from
-@code{nnml} that haven't been defined in @code{nndir} yet should be
-defined now.
-
-@end table
-
-Below is a slightly shortened version of the @code{nndir} back end.
-
-@lisp
-;;; @r{nndir.el --- single directory newsgroup access for Gnus}
-;; @r{Copyright (C) 1995,96 Free Software Foundation, Inc.}
-
-;;; @r{Code:}
-
-(require 'nnheader)
-(require 'nnmh)
-(require 'nnml)
-(require 'nnoo)
-(eval-when-compile (require 'cl))
-
-(nnoo-declare nndir
- nnml nnmh)
-
-(defvoo nndir-directory nil
- "Where nndir will look for groups."
- nnml-current-directory nnmh-current-directory)
-
-(defvoo nndir-nov-is-evil nil
- "*Non-nil means that nndir will never retrieve NOV headers."
- nnml-nov-is-evil)
-
-(defvoo nndir-current-group ""
- nil
- nnml-current-group nnmh-current-group)
-(defvoo nndir-top-directory nil nil nnml-directory nnmh-directory)
-(defvoo nndir-get-new-mail nil nil nnml-get-new-mail nnmh-get-new-mail)
-
-(defvoo nndir-status-string "" nil nnmh-status-string)
-(defconst nndir-version "nndir 1.0")
-
-;;; @r{Interface functions.}
-
-(nnoo-define-basics nndir)
-
-(deffoo nndir-open-server (server &optional defs)
- (setq nndir-directory
- (or (cadr (assq 'nndir-directory defs))
- server))
- (unless (assq 'nndir-directory defs)
- (push `(nndir-directory ,server) defs))
- (push `(nndir-current-group
- ,(file-name-nondirectory
- (directory-file-name nndir-directory)))
- defs)
- (push `(nndir-top-directory
- ,(file-name-directory (directory-file-name nndir-directory)))
- defs)
- (nnoo-change-server 'nndir server defs))
-
-(nnoo-map-functions nndir
- (nnml-retrieve-headers 0 nndir-current-group 0 0)
- (nnmh-request-article 0 nndir-current-group 0 0)
- (nnmh-request-group nndir-current-group 0 0)
- (nnmh-close-group nndir-current-group 0))
-
-(nnoo-import nndir
- (nnmh
- nnmh-status-message
- nnmh-request-list
- nnmh-request-newgroups))
-
-(provide 'nndir)
-@end lisp
-
-
-@node Hooking New Back Ends Into Gnus
-@subsubsection Hooking New Back Ends Into Gnus
-
-@vindex gnus-valid-select-methods
-@findex gnus-declare-backend
-Having Gnus start using your new back end is rather easy---you just
-declare it with the @code{gnus-declare-backend} functions. This will
-enter the back end into the @code{gnus-valid-select-methods} variable.
-
-@code{gnus-declare-backend} takes two parameters---the back end name and
-an arbitrary number of @dfn{abilities}.
-
-Here's an example:
-
-@lisp
-(gnus-declare-backend "nnchoke" 'mail 'respool 'address)
-@end lisp
-
-The above line would then go in the @file{nnchoke.el} file.
-
-The abilities can be:
-
-@table @code
-@item mail
-This is a mailish back end---followups should (probably) go via mail.
-@item post
-This is a newsish back end---followups should (probably) go via news.
-@item post-mail
-This back end supports both mail and news.
-@item none
-This is neither a post nor mail back end---it's something completely
-different.
-@item respool
-It supports respooling---or rather, it is able to modify its source
-articles and groups.
-@item address
-The name of the server should be in the virtual server name. This is
-true for almost all back ends.
-@item prompt-address
-The user should be prompted for an address when doing commands like
-@kbd{B} in the group buffer. This is true for back ends like
-@code{nntp}, but not @code{nnmbox}, for instance.
-@end table
-
-
-@node Mail-like Back Ends
-@subsubsection Mail-like Back Ends
-
-One of the things that separate the mail back ends from the rest of the
-back ends is the heavy dependence by most of the mail back ends on
-common functions in @file{nnmail.el}. For instance, here's the
-definition of @code{nnml-request-scan}:
-
-@lisp
-(deffoo nnml-request-scan (&optional group server)
- (setq nnml-article-file-alist nil)
- (nnmail-get-new-mail 'nnml 'nnml-save-nov nnml-directory group))
-@end lisp
-
-It simply calls @code{nnmail-get-new-mail} with a few parameters,
-and @code{nnmail} takes care of all the moving and splitting of the
-mail.
-
-This function takes four parameters.
-
-@table @var
-@item method
-This should be a symbol to designate which back end is responsible for
-the call.
-
-@item exit-function
-This function should be called after the splitting has been performed.
-
-@item temp-directory
-Where the temporary files should be stored.
-
-@item group
-This optional argument should be a group name if the splitting is to be
-performed for one group only.
-@end table
-
-@code{nnmail-get-new-mail} will call @var{back-end}@code{-save-mail} to
-save each article. @var{back-end}@code{-active-number} will be called to
-find the article number assigned to this article.
-
-The function also uses the following variables:
-@var{back-end}@code{-get-new-mail} (to see whether to get new mail for
-this back end); and @var{back-end}@code{-group-alist} and
-@var{back-end}@code{-active-file} to generate the new active file.
-@var{back-end}@code{-group-alist} should be a group-active alist, like
-this:
-
-@example
-(("a-group" (1 . 10))
- ("some-group" (34 . 39)))
-@end example
-
-
-@node Score File Syntax
-@subsection Score File Syntax
-
-Score files are meant to be easily parseable, but yet extremely
-mallable. It was decided that something that had the same read syntax
-as an Emacs Lisp list would fit that spec.
-
-Here's a typical score file:
-
-@lisp
-(("summary"
- ("win95" -10000 nil s)
- ("Gnus"))
- ("from"
- ("Lars" -1000))
- (mark -100))
-@end lisp
-
-BNF definition of a score file:
-
-@example
-score-file = "" / "(" *element ")"
-element = rule / atom
-rule = string-rule / number-rule / date-rule
-string-rule = "(" quote string-header quote space *string-match ")"
-number-rule = "(" quote number-header quote space *number-match ")"
-date-rule = "(" quote date-header quote space *date-match ")"
-quote = <ascii 34>
-string-header = "subject" / "from" / "references" / "message-id" /
- "xref" / "body" / "head" / "all" / "followup"
-number-header = "lines" / "chars"
-date-header = "date"
-string-match = "(" quote <string> quote [ "" / [ space score [ "" /
- space date [ "" / [ space string-match-t ] ] ] ] ] ")"
-score = "nil" / <integer>
-date = "nil" / <natural number>
-string-match-t = "nil" / "s" / "substring" / "S" / "Substring" /
- "r" / "regex" / "R" / "Regex" /
- "e" / "exact" / "E" / "Exact" /
- "f" / "fuzzy" / "F" / "Fuzzy"
-number-match = "(" <integer> [ "" / [ space score [ "" /
- space date [ "" / [ space number-match-t ] ] ] ] ] ")"
-number-match-t = "nil" / "=" / "<" / ">" / ">=" / "<="
-date-match = "(" quote <string> quote [ "" / [ space score [ "" /
- space date [ "" / [ space date-match-t ] ] ] ] ")"
-date-match-t = "nil" / "at" / "before" / "after"
-atom = "(" [ required-atom / optional-atom ] ")"
-required-atom = mark / expunge / mark-and-expunge / files /
- exclude-files / read-only / touched
-optional-atom = adapt / local / eval
-mark = "mark" space nil-or-number
-nil-or-number = "nil" / <integer>
-expunge = "expunge" space nil-or-number
-mark-and-expunge = "mark-and-expunge" space nil-or-number
-files = "files" *[ space <string> ]
-exclude-files = "exclude-files" *[ space <string> ]
-read-only = "read-only" [ space "nil" / space "t" ]
-adapt = "adapt" [ space "ignore" / space "t" / space adapt-rule ]
-adapt-rule = "(" *[ <string> *[ "(" <string> <integer> ")" ] ")"
-local = "local" *[ space "(" <string> space <form> ")" ]
-eval = "eval" space <form>
-space = *[ " " / <TAB> / <NEWLINE> ]
-@end example
-
-Any unrecognized elements in a score file should be ignored, but not
-discarded.
-
-As you can see, white space is needed, but the type and amount of white
-space is irrelevant. This means that formatting of the score file is
-left up to the programmer---if it's simpler to just spew it all out on
-one looong line, then that's ok.
-
-The meaning of the various atoms are explained elsewhere in this
-manual (@pxref{Score File Format}).
-
-
-@node Headers
-@subsection Headers
-
-Internally Gnus uses a format for storing article headers that
-corresponds to the @acronym{NOV} format in a mysterious fashion. One could
-almost suspect that the author looked at the @acronym{NOV} specification and
-just shamelessly @emph{stole} the entire thing, and one would be right.
-
-@dfn{Header} is a severely overloaded term. ``Header'' is used in
-RFC 1036 to talk about lines in the head of an article (e.g.,
-@code{From}). It is used by many people as a synonym for
-``head''---``the header and the body''. (That should be avoided, in my
-opinion.) And Gnus uses a format internally that it calls ``header'',
-which is what I'm talking about here. This is a 9-element vector,
-basically, with each header (ouch) having one slot.
-
-These slots are, in order: @code{number}, @code{subject}, @code{from},
-@code{date}, @code{id}, @code{references}, @code{chars}, @code{lines},
-@code{xref}, and @code{extra}. There are macros for accessing and
-setting these slots---they all have predictable names beginning with
-@code{mail-header-} and @code{mail-header-set-}, respectively.
-
-All these slots contain strings, except the @code{extra} slot, which
-contains an alist of header/value pairs (@pxref{To From Newsgroups}).
-
-
-@node Ranges
-@subsection Ranges
-
-@sc{gnus} introduced a concept that I found so useful that I've started
-using it a lot and have elaborated on it greatly.
-
-The question is simple: If you have a large amount of objects that are
-identified by numbers (say, articles, to take a @emph{wild} example)
-that you want to qualify as being ``included'', a normal sequence isn't
-very useful. (A 200,000 length sequence is a bit long-winded.)
-
-The solution is as simple as the question: You just collapse the
-sequence.
-
-@example
-(1 2 3 4 5 6 10 11 12)
-@end example
-
-is transformed into
-
-@example
-((1 . 6) (10 . 12))
-@end example
-
-To avoid having those nasty @samp{(13 . 13)} elements to denote a
-lonesome object, a @samp{13} is a valid element:
-
-@example
-((1 . 6) 7 (10 . 12))
-@end example
-
-This means that comparing two ranges to find out whether they are equal
-is slightly tricky:
-
-@example
-((1 . 5) 7 8 (10 . 12))
-@end example
-
-and
-
-@example
-((1 . 5) (7 . 8) (10 . 12))
-@end example
-
-are equal. In fact, any non-descending list is a range:
-
-@example
-(1 2 3 4 5)
-@end example
-
-is a perfectly valid range, although a pretty long-winded one. This is
-also valid:
-
-@example
-(1 . 5)
-@end example
-
-and is equal to the previous range.
-
-Here's a BNF definition of ranges. Of course, one must remember the
-semantic requirement that the numbers are non-descending. (Any number
-of repetition of the same number is allowed, but apt to disappear in
-range handling.)
-
-@example
-range = simple-range / normal-range
-simple-range = "(" number " . " number ")"
-normal-range = "(" start-contents ")"
-contents = "" / simple-range *[ " " contents ] /
- number *[ " " contents ]
-@end example
-
-Gnus currently uses ranges to keep track of read articles and article
-marks. I plan on implementing a number of range operators in C if The
-Powers That Be are willing to let me. (I haven't asked yet, because I
-need to do some more thinking on what operators I need to make life
-totally range-based without ever having to convert back to normal
-sequences.)
-
-
-@node Group Info
-@subsection Group Info
-
-Gnus stores all permanent info on groups in a @dfn{group info} list.
-This list is from three to six elements (or more) long and exhaustively
-describes the group.
-
-Here are two example group infos; one is a very simple group while the
-second is a more complex one:
-
-@example
-("no.group" 5 ((1 . 54324)))
-
-("nnml:my.mail" 3 ((1 . 5) 9 (20 . 55))
- ((tick (15 . 19)) (replied 3 6 (19 . 3)))
- (nnml "")
- ((auto-expire . t) (to-address . "ding@@gnus.org")))
-@end example
-
-The first element is the @dfn{group name}---as Gnus knows the group,
-anyway. The second element is the @dfn{subscription level}, which
-normally is a small integer. (It can also be the @dfn{rank}, which is a
-cons cell where the @code{car} is the level and the @code{cdr} is the
-score.) The third element is a list of ranges of read articles. The
-fourth element is a list of lists of article marks of various kinds.
-The fifth element is the select method (or virtual server, if you like).
-The sixth element is a list of @dfn{group parameters}, which is what
-this section is about.
-
-Any of the last three elements may be missing if they are not required.
-In fact, the vast majority of groups will normally only have the first
-three elements, which saves quite a lot of cons cells.
-
-Here's a BNF definition of the group info format:
-
-@example
-info = "(" group space ralevel space read
- [ "" / [ space marks-list [ "" / [ space method [ "" /
- space parameters ] ] ] ] ] ")"
-group = quote <string> quote
-ralevel = rank / level
-level = <integer in the range of 1 to inf>
-rank = "(" level "." score ")"
-score = <integer in the range of 1 to inf>
-read = range
-marks-lists = nil / "(" *marks ")"
-marks = "(" <string> range ")"
-method = "(" <string> *elisp-forms ")"
-parameters = "(" *elisp-forms ")"
-@end example
-
-Actually that @samp{marks} rule is a fib. A @samp{marks} is a
-@samp{<string>} consed on to a @samp{range}, but that's a bitch to say
-in pseudo-BNF.
-
-If you have a Gnus info and want to access the elements, Gnus offers a
-series of macros for getting/setting these elements.
-
-@table @code
-@item gnus-info-group
-@itemx gnus-info-set-group
-@findex gnus-info-group
-@findex gnus-info-set-group
-Get/set the group name.
-
-@item gnus-info-rank
-@itemx gnus-info-set-rank
-@findex gnus-info-rank
-@findex gnus-info-set-rank
-Get/set the group rank (@pxref{Group Score}).
-
-@item gnus-info-level
-@itemx gnus-info-set-level
-@findex gnus-info-level
-@findex gnus-info-set-level
-Get/set the group level.
-
-@item gnus-info-score
-@itemx gnus-info-set-score
-@findex gnus-info-score
-@findex gnus-info-set-score
-Get/set the group score (@pxref{Group Score}).
-
-@item gnus-info-read
-@itemx gnus-info-set-read
-@findex gnus-info-read
-@findex gnus-info-set-read
-Get/set the ranges of read articles.
-
-@item gnus-info-marks
-@itemx gnus-info-set-marks
-@findex gnus-info-marks
-@findex gnus-info-set-marks
-Get/set the lists of ranges of marked articles.
-
-@item gnus-info-method
-@itemx gnus-info-set-method
-@findex gnus-info-method
-@findex gnus-info-set-method
-Get/set the group select method.
-
-@item gnus-info-params
-@itemx gnus-info-set-params
-@findex gnus-info-params
-@findex gnus-info-set-params
-Get/set the group parameters.
-@end table
-
-All the getter functions take one parameter---the info list. The setter
-functions take two parameters---the info list and the new value.
-
-The last three elements in the group info aren't mandatory, so it may be
-necessary to extend the group info before setting the element. If this
-is necessary, you can just pass on a non-@code{nil} third parameter to
-the three final setter functions to have this happen automatically.
-
-
-@node Extended Interactive
-@subsection Extended Interactive
-@cindex interactive
-@findex gnus-interactive
-
-Gnus extends the standard Emacs @code{interactive} specification
-slightly to allow easy use of the symbolic prefix (@pxref{Symbolic
-Prefixes}). Here's an example of how this is used:
-
-@lisp
-(defun gnus-summary-increase-score (&optional score symp)
- (interactive (gnus-interactive "P\ny"))
- ...
- )
-@end lisp
-
-The best thing to do would have been to implement
-@code{gnus-interactive} as a macro which would have returned an
-@code{interactive} form, but this isn't possible since Emacs checks
-whether a function is interactive or not by simply doing an @code{assq}
-on the lambda form. So, instead we have @code{gnus-interactive}
-function that takes a string and returns values that are usable to
-@code{interactive}.
-
-This function accepts (almost) all normal @code{interactive} specs, but
-adds a few more.
-
-@table @samp
-@item y
-@vindex gnus-current-prefix-symbol
-The current symbolic prefix---the @code{gnus-current-prefix-symbol}
-variable.
-
-@item Y
-@vindex gnus-current-prefix-symbols
-A list of the current symbolic prefixes---the
-@code{gnus-current-prefix-symbol} variable.
-
-@item A
-The current article number---the @code{gnus-summary-article-number}
-function.
-
-@item H
-The current article header---the @code{gnus-summary-article-header}
-function.
-
-@item g
-The current group name---the @code{gnus-group-group-name}
-function.
-
-@end table
-
-
-@node Emacs/XEmacs Code
-@subsection Emacs/XEmacs Code
-@cindex XEmacs
-@cindex Emacsen
-
-While Gnus runs under Emacs, XEmacs and Mule, I decided that one of the
-platforms must be the primary one. I chose Emacs. Not because I don't
-like XEmacs or Mule, but because it comes first alphabetically.
-
-This means that Gnus will byte-compile under Emacs with nary a warning,
-while XEmacs will pump out gigabytes of warnings while byte-compiling.
-As I use byte-compilation warnings to help me root out trivial errors in
-Gnus, that's very useful.
-
-I've also consistently used Emacs function interfaces, but have used
-Gnusey aliases for the functions. To take an example: Emacs defines a
-@code{run-at-time} function while XEmacs defines a @code{start-itimer}
-function. I then define a function called @code{gnus-run-at-time} that
-takes the same parameters as the Emacs @code{run-at-time}. When running
-Gnus under Emacs, the former function is just an alias for the latter.
-However, when running under XEmacs, the former is an alias for the
-following function:
-
-@lisp
-(defun gnus-xmas-run-at-time (time repeat function &rest args)
- (start-itimer
- "gnus-run-at-time"
- `(lambda ()
- (,function ,@@args))
- time repeat))
-@end lisp
-
-This sort of thing has been done for bunches of functions. Gnus does
-not redefine any native Emacs functions while running under XEmacs---it
-does this @code{defalias} thing with Gnus equivalents instead. Cleaner
-all over.
-
-In the cases where the XEmacs function interface was obviously cleaner,
-I used it instead. For example @code{gnus-region-active-p} is an alias
-for @code{region-active-p} in XEmacs, whereas in Emacs it is a function.
-
-Of course, I could have chosen XEmacs as my native platform and done
-mapping functions the other way around. But I didn't. The performance
-hit these indirections impose on Gnus under XEmacs should be slight.
-
-
-@node Various File Formats
-@subsection Various File Formats
-
-@menu
-* Active File Format:: Information on articles and groups available.
-* Newsgroups File Format:: Group descriptions.
-@end menu
-
-
-@node Active File Format
-@subsubsection Active File Format
-
-The active file lists all groups available on the server in
-question. It also lists the highest and lowest current article numbers
-in each group.
-
-Here's an excerpt from a typical active file:
-
-@example
-soc.motss 296030 293865 y
-alt.binaries.pictures.fractals 3922 3913 n
-comp.sources.unix 1605 1593 m
-comp.binaries.ibm.pc 5097 5089 y
-no.general 1000 900 y
-@end example
-
-Here's a pseudo-BNF definition of this file:
-
-@example
-active = *group-line
-group-line = group spc high-number spc low-number spc flag <NEWLINE>
-group = <non-white-space string>
-spc = " "
-high-number = <non-negative integer>
-low-number = <positive integer>
-flag = "y" / "n" / "m" / "j" / "x" / "=" group
-@end example
-
-For a full description of this file, see the manual pages for
-@samp{innd}, in particular @samp{active(5)}.
-
-
-@node Newsgroups File Format
-@subsubsection Newsgroups File Format
-
-The newsgroups file lists groups along with their descriptions. Not all
-groups on the server have to be listed, and not all groups in the file
-have to exist on the server. The file is meant purely as information to
-the user.
-
-The format is quite simple; a group name, a tab, and the description.
-Here's the definition:
-
-@example
-newsgroups = *line
-line = group tab description <NEWLINE>
-group = <non-white-space string>
-tab = <TAB>
-description = <string>
-@end example
-
-
-@page
-@node Emacs for Heathens
-@section Emacs for Heathens
-
-Believe it or not, but some people who use Gnus haven't really used
-Emacs much before they embarked on their journey on the Gnus Love Boat.
-If you are one of those unfortunates whom ``@kbd{C-M-a}'', ``kill the
-region'', and ``set @code{gnus-flargblossen} to an alist where the key
-is a regexp that is used for matching on the group name'' are magical
-phrases with little or no meaning, then this appendix is for you. If
-you are already familiar with Emacs, just ignore this and go fondle your
-cat instead.
-
-@menu
-* Keystrokes:: Entering text and executing commands.
-* Emacs Lisp:: The built-in Emacs programming language.
-@end menu
-
-
-@node Keystrokes
-@subsection Keystrokes
-
-@itemize @bullet
-@item
-Q: What is an experienced Emacs user?
-
-@item
-A: A person who wishes that the terminal had pedals.
-@end itemize
-
-Yes, when you use Emacs, you are apt to use the control key, the shift
-key and the meta key a lot. This is very annoying to some people
-(notably @code{vi}le users), and the rest of us just love the hell out
-of it. Just give up and submit. Emacs really does stand for
-``Escape-Meta-Alt-Control-Shift'', and not ``Editing Macros'', as you
-may have heard from other disreputable sources (like the Emacs author).
-
-The shift keys are normally located near your pinky fingers, and are
-normally used to get capital letters and stuff. You probably use it all
-the time. The control key is normally marked ``CTRL'' or something like
-that. The meta key is, funnily enough, never marked as such on any
-keyboard. The one I'm currently at has a key that's marked ``Alt'',
-which is the meta key on this keyboard. It's usually located somewhere
-to the left hand side of the keyboard, usually on the bottom row.
-
-Now, us Emacs people don't say ``press the meta-control-m key'',
-because that's just too inconvenient. We say ``press the @kbd{C-M-m}
-key''. @kbd{M-} is the prefix that means ``meta'' and ``C-'' is the
-prefix that means ``control''. So ``press @kbd{C-k}'' means ``press
-down the control key, and hold it down while you press @kbd{k}''.
-``Press @kbd{C-M-k}'' means ``press down and hold down the meta key and
-the control key and then press @kbd{k}''. Simple, ay?
-
-This is somewhat complicated by the fact that not all keyboards have a
-meta key. In that case you can use the ``escape'' key. Then @kbd{M-k}
-means ``press escape, release escape, press @kbd{k}''. That's much more
-work than if you have a meta key, so if that's the case, I respectfully
-suggest you get a real keyboard with a meta key. You can't live without
-it.
-
-
-
-@node Emacs Lisp
-@subsection Emacs Lisp
-
-Emacs is the King of Editors because it's really a Lisp interpreter.
-Each and every key you tap runs some Emacs Lisp code snippet, and since
-Emacs Lisp is an interpreted language, that means that you can configure
-any key to run any arbitrary code. You just, like, do it.
-
-Gnus is written in Emacs Lisp, and is run as a bunch of interpreted
-functions. (These are byte-compiled for speed, but it's still
-interpreted.) If you decide that you don't like the way Gnus does
-certain things, it's trivial to have it do something a different way.
-(Well, at least if you know how to write Lisp code.) However, that's
-beyond the scope of this manual, so we are simply going to talk about
-some common constructs that you normally use in your @file{~/.gnus.el}
-file to customize Gnus. (You can also use the @file{~/.emacs} file, but
-in order to set things of Gnus up, it is much better to use the
-@file{~/.gnus.el} file, @xref{Startup Files}.)
-
-If you want to set the variable @code{gnus-florgbnize} to four (4), you
-write the following:
-
-@lisp
-(setq gnus-florgbnize 4)
-@end lisp
-
-This function (really ``special form'') @code{setq} is the one that can
-set a variable to some value. This is really all you need to know. Now
-you can go and fill your @file{~/.gnus.el} file with lots of these to
-change how Gnus works.
-
-If you have put that thing in your @file{~/.gnus.el} file, it will be
-read and @code{eval}ed (which is Lisp-ese for ``run'') the next time you
-start Gnus. If you want to change the variable right away, simply say
-@kbd{C-x C-e} after the closing parenthesis. That will @code{eval} the
-previous ``form'', which is a simple @code{setq} statement here.
-
-Go ahead---just try it, if you're located at your Emacs. After you
-@kbd{C-x C-e}, you will see @samp{4} appear in the echo area, which
-is the return value of the form you @code{eval}ed.
-
-Some pitfalls:
-
-If the manual says ``set @code{gnus-read-active-file} to @code{some}'',
-that means:
-
-@lisp
-(setq gnus-read-active-file 'some)
-@end lisp
-
-On the other hand, if the manual says ``set @code{gnus-nntp-server} to
-@samp{nntp.ifi.uio.no}'', that means:
-
-@lisp
-(setq gnus-nntp-server "nntp.ifi.uio.no")
-@end lisp
-
-So be careful not to mix up strings (the latter) with symbols (the
-former). The manual is unambiguous, but it can be confusing.
-
-@page
-@include gnus-faq.texi
-
-@node GNU Free Documentation License
-@chapter GNU Free Documentation License
-@include doclicense.texi
-
-@node Index
-@chapter Index
-@printindex cp
-
-@node Key Index
-@chapter Key Index
-@printindex ky
-
-@summarycontents
-@contents
-@bye
-
-@iftex
-@iflatex
-\end{document}
-@end iflatex
-@end iftex
-
-@c Local Variables:
-@c mode: texinfo
-@c coding: iso-8859-1
-@c End:
-
-@ignore
- arch-tag: c9fa47e7-78ca-4681-bda9-9fef45d1c819
-@end ignore
+++ /dev/null
-@WITH_FONTS_bembo@\usepackage{bembo}
-@WITH_FONTS_pfu@\newcommand{\gnusselectttfont}{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont}
-@WITH_FONTS_bcr@\def\verbatim@font{\fontfamily{bcr}\fontsize{10pt}{10}\selectfont}
-@WITHOUT_FONTS_pfu@\newcommand{\gnusselectttfont}{\fontfamily{cmss}\fontsize{10pt}{10}\selectfont\hyphenchar\font45}
-
-\newcommand{\gnususefonts}{@USE_FONTS@}
-
-%%% Local Variables:
-%%% mode: latex
-%%% TeX-master: t
-%%% End:
+++ /dev/null
-P2
-11 11
-242
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
-122 122 122 122 122 122 122 122 122 122 122
+++ /dev/null
-P2
-5 5
-50
-26 26 26 26 26
-26 26 26 26 26
-26 26 26 26 26
-26 26 26 26 26
-26 26 26 26 26
+++ /dev/null
-;;; infohack.el --- a hack to format info file.
-;; Copyright (C) 2001, 2003, 2004, 2008 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: info
-
-;; 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'texinfmt)
-
-(if (fboundp 'texinfo-copying)
- nil
- ;; Support @copying and @insertcopying for Emacs 21.3 and lesser and
- ;; XEmacs.
- (defvar texinfo-copying-text ""
- "Text of the copyright notice and copying permissions.")
-
- (defun texinfo-copying ()
- "Copy the copyright notice and copying permissions from the Texinfo file,
-as indicated by the @copying ... @end copying command;
-insert the text with the @insertcopying command."
- (let ((beg (progn (beginning-of-line) (point)))
- (end (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
- (setq texinfo-copying-text
- (buffer-substring-no-properties
- (save-excursion (goto-char beg) (forward-line 1) (point))
- (save-excursion (goto-char end) (forward-line -1) (point))))
- (delete-region beg end)))
-
- (defun texinfo-insertcopying ()
- "Insert the copyright notice and copying permissions from the Texinfo file,
-which are indicated by the @copying ... @end copying command."
- (insert (concat "\n" texinfo-copying-text)))
-
- (defadvice texinfo-format-scan (before expand-@copying-section activate)
- "Extract @copying and replace @insertcopying with it."
- (goto-char (point-min))
- (when (search-forward "@copying" nil t)
- (texinfo-copying))
- (while (search-forward "@insertcopying" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (texinfo-insertcopying))))
-
-(defun infohack-remove-unsupported ()
- (goto-char (point-min))
- (while (re-search-forward "@\\(end \\)?ifnottex" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward "\n@iflatex\n" nil t)
- (delete-region (1+ (match-beginning 0))
- (search-forward "\n@end iflatex\n"))))
-
-(defun infohack (file)
- (let ((dest-directory default-directory)
- (max-lisp-eval-depth (max max-lisp-eval-depth 600))
- coding-system)
- ;; Emacs 21.3 doesn't support @documentencoding
- (unless (get 'documentencoding 'texinfo-format)
- (put 'documentencoding 'texinfo-format
- 'texinfo-discard-line-with-args))
- (find-file file)
- (setq buffer-read-only nil)
- (setq coding-system buffer-file-coding-system)
- (infohack-remove-unsupported)
- (texinfo-every-node-update)
- (texinfo-format-buffer t) ;; Don't save any file.
- (setq default-directory dest-directory)
- (setq buffer-file-name
- (expand-file-name (file-name-nondirectory buffer-file-name)
- default-directory))
- (setq buffer-file-coding-system coding-system)
- (if (> (buffer-size) 100000)
- (Info-split))
- (save-buffer)))
-
-(eval-and-compile
- (when (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
- (symbol-name system-type))
- (defun subst-char-in-region (START END FROMCHAR TOCHAR &optional NOUNDO)
- "From START to END, replace FROMCHAR with TOCHAR each time it occurs.
-If optional arg NOUNDO is non-nil, don't record this change for undo
-and don't mark the buffer as really changed.
-Both characters must have the same length of multi-byte form."
- (let ((original-buffer-undo-list buffer-undo-list)
- (modified (buffer-modified-p)))
- (if NOUNDO
- (setq buffer-undo-list t))
- (goto-char START)
- (let ((from (char-to-string FROMCHAR))
- (to (char-to-string TOCHAR)))
- (while (search-forward from END t)
- (replace-match to t t)))
- (if NOUNDO
- (progn (setq buffer-undo-list original-buffer-undo-list)
- (set-buffer-modidifed-p modified)))))))
-
-(defun batch-makeinfo ()
- "Emacs makeinfo in batch mode."
- (infohack (car command-line-args-left))
- (setq command-line-args-left nil))
-
-;;; arch-tag: 9ca2f71f-b280-48b3-9826-8dc052dfbbfe
-;;; infohack.el ends here
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-
-@setfilename message
-@settitle Message Manual
-@synindex fn cp
-@synindex vr cp
-@synindex pg cp
-@copying
-This file documents Message, the Emacs message composition mode.
-
-Copyright @copyright{} 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003,
-2004, 2005, 2006, 2007, 2008 Free Software Foundation, Inc.
-
-@quotation
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.2 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with the Front-Cover texts being ``A GNU
-Manual'', and with the Back-Cover Texts as in (a) below. A copy of the
-license is included in the section entitled ``GNU Free Documentation
-License'' in the Emacs manual.
-
-(a) The FSF's Back-Cover Text is: ``You have freedom to copy and modify
-this GNU Manual, like GNU software. Copies published by the Free
-Software Foundation raise funds for GNU development.''
-
-This document is part of a collection distributed under the GNU Free
-Documentation License. If you want to distribute this document
-separately from the collection, you can do so by adding a copy of the
-license to the document, as described in section 6 of the license.
-@end quotation
-@end copying
-
-@dircategory Emacs
-@direntry
-* Message: (message). Mail and news composition mode that goes with Gnus.
-@end direntry
-@iftex
-@finalout
-@end iftex
-@setchapternewpage odd
-
-@titlepage
-@title Message Manual
-
-@author by Lars Magne Ingebrigtsen
-@page
-
-@vskip 0pt plus 1filll
-@insertcopying
-@end titlepage
-@page
-
-@node Top
-@top Message
-
-All message composition from Gnus (both mail and news) takes place in
-Message mode buffers.
-
-@menu
-* Interface:: Setting up message buffers.
-* Commands:: Commands you can execute in message mode buffers.
-* Variables:: Customizing the message buffers.
-* Compatibility:: Making Message backwards compatible.
-* Appendices:: More technical things.
-* GNU Free Documentation License:: The license for this documentation.
-* Index:: Variable, function and concept index.
-* Key Index:: List of Message mode keys.
-@end menu
-
-@c Adjust ../Makefile.in if you change the following lines:
-Message is distributed with Gnus. The Gnus distribution
-@c
-corresponding to this manual is Gnus v5.10.10.
-
-
-@node Interface
-@chapter Interface
-
-When a program (or a person) wants to respond to a message -- reply,
-follow up, forward, cancel -- the program (or person) should just put
-point in the buffer where the message is and call the required command.
-@code{Message} will then pop up a new @code{message} mode buffer with
-appropriate headers filled out, and the user can edit the message before
-sending it.
-
-@menu
-* New Mail Message:: Editing a brand new mail message.
-* New News Message:: Editing a brand new news message.
-* Reply:: Replying via mail.
-* Wide Reply:: Responding to all people via mail.
-* Followup:: Following up via news.
-* Canceling News:: Canceling a news article.
-* Superseding:: Superseding a message.
-* Forwarding:: Forwarding a message via news or mail.
-* Resending:: Resending a mail message.
-* Bouncing:: Bouncing a mail message.
-* Mailing Lists:: Send mail to mailing lists.
-@end menu
-
-You can customize the Message Mode tool bar, see @kbd{M-x
-customize-apropos RET message-tool-bar}. This feature is only available
-in Emacs.
-
-@node New Mail Message
-@section New Mail Message
-
-@findex message-mail
-The @code{message-mail} command pops up a new message buffer.
-
-Two optional parameters are accepted: The first will be used as the
-@code{To} header and the second as the @code{Subject} header. If these
-are @code{nil}, those two headers will be empty.
-
-
-@node New News Message
-@section New News Message
-
-@findex message-news
-The @code{message-news} command pops up a new message buffer.
-
-This function accepts two optional parameters. The first will be used
-as the @code{Newsgroups} header and the second as the @code{Subject}
-header. If these are @code{nil}, those two headers will be empty.
-
-
-@node Reply
-@section Reply
-
-@findex message-reply
-The @code{message-reply} function pops up a message buffer that's a
-reply to the message in the current buffer.
-
-@vindex message-reply-to-function
-Message uses the normal methods to determine where replies are to go
-(@pxref{Responses}), but you can change the behavior to suit your needs
-by fiddling with the @code{message-reply-to-function} variable.
-
-If you want the replies to go to the @code{Sender} instead of the
-@code{From}, you could do something like this:
-
-@lisp
-(setq message-reply-to-function
- (lambda ()
- (cond ((equal (mail-fetch-field "from") "somebody")
- (list (cons 'To (mail-fetch-field "sender"))))
- (t
- nil))))
-@end lisp
-
-This function will be called narrowed to the head of the article that is
-being replied to.
-
-As you can see, this function should return a list. In this case, it
-returns @code{((To . "Whom"))} if it has an opinion as to what the To
-header should be. If it does not, it should just return @code{nil}, and
-the normal methods for determining the To header will be used.
-
-Each list element should be a cons, where the @sc{car} should be the
-name of a header (e.g. @code{Cc}) and the @sc{cdr} should be the header
-value (e.g. @samp{larsi@@ifi.uio.no}). All these headers will be
-inserted into the head of the outgoing mail.
-
-
-@node Wide Reply
-@section Wide Reply
-
-@findex message-wide-reply
-The @code{message-wide-reply} pops up a message buffer that's a wide
-reply to the message in the current buffer. A @dfn{wide reply} is a
-reply that goes out to all people listed in the @code{To}, @code{From}
-(or @code{Reply-to}) and @code{Cc} headers.
-
-@vindex message-wide-reply-to-function
-Message uses the normal methods to determine where wide replies are to go,
-but you can change the behavior to suit your needs by fiddling with the
-@code{message-wide-reply-to-function}. It is used in the same way as
-@code{message-reply-to-function} (@pxref{Reply}).
-
-@vindex message-dont-reply-to-names
-Addresses that match the @code{message-dont-reply-to-names} regular
-expression will be removed from the @code{Cc} header.
-
-@vindex message-wide-reply-confirm-recipients
-If @code{message-wide-reply-confirm-recipients} is non-@code{nil} you
-will be asked to confirm that you want to reply to multiple
-recipients. The default is @code{nil}.
-
-@node Followup
-@section Followup
-
-@findex message-followup
-The @code{message-followup} command pops up a message buffer that's a
-followup to the message in the current buffer.
-
-@vindex message-followup-to-function
-Message uses the normal methods to determine where followups are to go,
-but you can change the behavior to suit your needs by fiddling with the
-@code{message-followup-to-function}. It is used in the same way as
-@code{message-reply-to-function} (@pxref{Reply}).
-
-@vindex message-use-followup-to
-The @code{message-use-followup-to} variable says what to do about
-@code{Followup-To} headers. If it is @code{use}, always use the value.
-If it is @code{ask} (which is the default), ask whether to use the
-value. If it is @code{t}, use the value unless it is @samp{poster}. If
-it is @code{nil}, don't use the value.
-
-
-@node Canceling News
-@section Canceling News
-
-@findex message-cancel-news
-The @code{message-cancel-news} command cancels the article in the
-current buffer.
-
-@vindex message-cancel-message
-The value of @code{message-cancel-message} is inserted in the body of
-the cancel message. The default is @samp{I am canceling my own
-article.}.
-
-@cindex Cancel Locks
-@vindex message-insert-canlock
-@cindex canlock
-When Message posts news messages, it inserts @code{Cancel-Lock}
-headers by default. This is a cryptographic header that ensures that
-only you can cancel your own messages, which is nice. The downside
-is that if you lose your @file{.emacs} file (which is where Gnus
-stores the secret cancel lock password (which is generated
-automatically the first time you use this feature)), you won't be
-able to cancel your message. If you want to manage a password yourself,
-you can put something like the following in your @file{~/.gnus.el} file:
-
-@lisp
-(setq canlock-password "geheimnis"
- canlock-password-for-verify canlock-password)
-@end lisp
-
-Whether to insert the header or not is controlled by the
-@code{message-insert-canlock} variable.
-
-Not many news servers respect the @code{Cancel-Lock} header yet, but
-this is expected to change in the future.
-
-
-@node Superseding
-@section Superseding
-
-@findex message-supersede
-The @code{message-supersede} command pops up a message buffer that will
-supersede the message in the current buffer.
-
-@vindex message-ignored-supersedes-headers
-Headers matching the @code{message-ignored-supersedes-headers} are
-removed before popping up the new message buffer. The default is@*
-@samp{^Path:\\|^Date\\|^NNTP-Posting-Host:\\|^Xref:\\|^Lines:\\|@*
-^Received:\\|^X-From-Line:\\|^X-Trace:\\|^X-Complaints-To:\\|@*
-Return-Path:\\|^Supersedes:\\|^NNTP-Posting-Date:\\|^X-Trace:\\|@*
-^X-Complaints-To:\\|^Cancel-Lock:\\|^Cancel-Key:\\|^X-Hashcash:\\|@*
-^X-Payment:}.
-
-
-
-@node Forwarding
-@section Forwarding
-
-@findex message-forward
-The @code{message-forward} command pops up a message buffer to forward
-the message in the current buffer. If given a prefix, forward using
-news.
-
-@table @code
-@item message-forward-ignored-headers
-@vindex message-forward-ignored-headers
-All headers that match this regexp will be deleted when forwarding a message.
-
-@item message-make-forward-subject-function
-@vindex message-make-forward-subject-function
-A list of functions that are called to generate a subject header for
-forwarded messages. The subject generated by the previous function is
-passed into each successive function.
-
-The provided functions are:
-
-@table @code
-@item message-forward-subject-author-subject
-@findex message-forward-subject-author-subject
-Source of article (author or newsgroup), in brackets followed by the
-subject.
-
-@item message-forward-subject-fwd
-Subject of article with @samp{Fwd:} prepended to it.
-@end table
-
-@item message-wash-forwarded-subjects
-@vindex message-wash-forwarded-subjects
-If this variable is @code{t}, the subjects of forwarded messages have
-the evidence of previous forwards (such as @samp{Fwd:}, @samp{Re:},
-@samp{(fwd)}) removed before the new subject is
-constructed. The default value is @code{nil}.
-
-@item message-forward-as-mime
-@vindex message-forward-as-mime
-If this variable is @code{t} (the default), forwarded messages are
-included as inline @acronym{MIME} RFC822 parts. If it's @code{nil}, forwarded
-messages will just be copied inline to the new message, like previous,
-non @acronym{MIME}-savvy versions of Gnus would do.
-
-@item message-forward-before-signature
-@vindex message-forward-before-signature
-If non-@code{nil}, put forwarded message before signature, else after.
-
-@end table
-
-
-@node Resending
-@section Resending
-
-@findex message-resend
-The @code{message-resend} command will prompt the user for an address
-and resend the message in the current buffer to that address.
-
-@vindex message-ignored-resent-headers
-Headers that match the @code{message-ignored-resent-headers} regexp will
-be removed before sending the message.
-
-
-@node Bouncing
-@section Bouncing
-
-@findex message-bounce
-The @code{message-bounce} command will, if the current buffer contains a
-bounced mail message, pop up a message buffer stripped of the bounce
-information. A @dfn{bounced message} is typically a mail you've sent
-out that has been returned by some @code{mailer-daemon} as
-undeliverable.
-
-@vindex message-ignored-bounced-headers
-Headers that match the @code{message-ignored-bounced-headers} regexp
-will be removed before popping up the buffer. The default is
-@samp{^\\(Received\\|Return-Path\\|Delivered-To\\):}.
-
-
-@node Mailing Lists
-@section Mailing Lists
-
-@cindex Mail-Followup-To
-Sometimes while posting to mailing lists, the poster needs to direct
-followups to the post to specific places. The Mail-Followup-To (MFT)
-was created to enable just this. Three example scenarios where this is
-useful:
-
-@itemize @bullet
-@item
-A mailing list poster can use MFT to express that responses should be
-sent to just the list, and not the poster as well. This will happen
-if the poster is already subscribed to the list.
-
-@item
-A mailing list poster can use MFT to express that responses should be
-sent to the list and the poster as well. This will happen if the poster
-is not subscribed to the list.
-
-@item
-If a message is posted to several mailing lists, MFT may also be used
-to direct the following discussion to one list only, because
-discussions that are spread over several lists tend to be fragmented
-and very difficult to follow.
-
-@end itemize
-
-Gnus honors the MFT header in other's messages (i.e. while following
-up to someone else's post) and also provides support for generating
-sensible MFT headers for outgoing messages as well.
-
-@c @menu
-@c * Honoring an MFT post:: What to do when one already exists
-@c * Composing with a MFT header:: Creating one from scratch.
-@c @end menu
-
-@c @node Composing with a MFT header
-@subsection Composing a correct MFT header automagically
-
-The first step in getting Gnus to automagically generate a MFT header
-in posts you make is to give Gnus a list of the mailing lists
-addresses you are subscribed to. You can do this in more than one
-way. The following variables would come in handy.
-
-@table @code
-
-@vindex message-subscribed-addresses
-@item message-subscribed-addresses
-This should be a list of addresses the user is subscribed to. Its
-default value is @code{nil}. Example:
-@lisp
-(setq message-subscribed-addresses
- '("ding@@gnus.org" "bing@@noose.org"))
-@end lisp
-
-@vindex message-subscribed-regexps
-@item message-subscribed-regexps
-This should be a list of regexps denoting the addresses of mailing
-lists subscribed to. Default value is @code{nil}. Example: If you
-want to achieve the same result as above:
-@lisp
-(setq message-subscribed-regexps
- '("\\(ding@@gnus\\)\\|\\(bing@@noose\\)\\.org")
-@end lisp
-
-@vindex message-subscribed-address-functions
-@item message-subscribed-address-functions
-This can be a list of functions to be called (one at a time!!) to
-determine the value of MFT headers. It is advisable that these
-functions not take any arguments. Default value is @code{nil}.
-
-There is a pre-defined function in Gnus that is a good candidate for
-this variable. @code{gnus-find-subscribed-addresses} is a function
-that returns a list of addresses corresponding to the groups that have
-the @code{subscribed} (@pxref{Group Parameters, ,Group Parameters,
-gnus, The Gnus Manual}) group parameter set to a non-@code{nil} value.
-This is how you would do it.
-
-@lisp
-(setq message-subscribed-address-functions
- '(gnus-find-subscribed-addresses))
-@end lisp
-
-@vindex message-subscribed-address-file
-@item message-subscribed-address-file
-You might be one organized human freak and have a list of addresses of
-all subscribed mailing lists in a separate file! Then you can just
-set this variable to the name of the file and life would be good.
-
-@end table
-
-You can use one or more of the above variables. All their values are
-``added'' in some way that works :-)
-
-Now you are all set. Just start composing a message as you normally do.
-And just send it; as always. Just before the message is sent out, Gnus'
-MFT generation thingy kicks in and checks if the message already has a
-MFT field. If there is one, it is left alone. (Except if it's empty -
-in that case, the field is removed and is not replaced with an
-automatically generated one. This lets you disable MFT generation on a
-per-message basis.) If there is none, then the list of recipient
-addresses (in the To: and Cc: headers) is checked to see if one of them
-is a list address you are subscribed to. If none of them is a list
-address, then no MFT is generated; otherwise, a MFT is added to the
-other headers and set to the value of all addresses in To: and Cc:
-
-@kindex C-c C-f C-a
-@findex message-generate-unsubscribed-mail-followup-to
-@kindex C-c C-f C-m
-@findex message-goto-mail-followup-to
-Hm. ``So'', you ask, ``what if I send an email to a list I am not
-subscribed to? I want my MFT to say that I want an extra copy.'' (This
-is supposed to be interpreted by others the same way as if there were no
-MFT, but you can use an explicit MFT to override someone else's
-to-address group parameter.) The function
-@code{message-generate-unsubscribed-mail-followup-to} might come in
-handy. It is bound to @kbd{C-c C-f C-a} by default. In any case, you
-can insert a MFT of your own choice; @kbd{C-c C-f C-m}
-(@code{message-goto-mail-followup-to}) will help you get started.
-
-@c @node Honoring an MFT post
-@subsection Honoring an MFT post
-
-@vindex message-use-mail-followup-to
-When you followup to a post on a mailing list, and the post has a MFT
-header, Gnus' action will depend on the value of the variable
-@code{message-use-mail-followup-to}. This variable can be one of:
-
-@table @code
-@item use
- Always honor MFTs. The To: and Cc: headers in your followup will be
- derived from the MFT header of the original post. This is the default.
-
-@item nil
- Always dishonor MFTs (just ignore the darned thing)
-
-@item ask
-Gnus will prompt you for an action.
-
-@end table
-
-It is considered good netiquette to honor MFT, as it is assumed the
-fellow who posted a message knows where the followups need to go
-better than you do.
-
-@node Commands
-@chapter Commands
-
-@menu
-* Buffer Entry:: Commands after entering a Message buffer.
-* Header Commands:: Commands for moving headers or changing headers.
-* Movement:: Moving around in message buffers.
-* Insertion:: Inserting things into message buffers.
-* MIME:: @acronym{MIME} considerations.
-* IDNA:: Non-@acronym{ASCII} domain name considerations.
-* Security:: Signing and encrypting messages.
-* Various Commands:: Various things.
-* Sending:: Actually sending the message.
-* Mail Aliases:: How to use mail aliases.
-* Spelling:: Having Emacs check your spelling.
-@end menu
-
-
-@node Buffer Entry
-@section Buffer Entry
-@cindex undo
-@kindex C-_
-
-You most often end up in a Message buffer when responding to some other
-message of some sort. Message does lots of handling of quoted text, and
-may remove signatures, reformat the text, or the like---depending on
-which used settings you're using. Message usually gets things right,
-but sometimes it stumbles. To help the user unwind these stumblings,
-Message sets the undo boundary before each major automatic action it
-takes. If you press the undo key (usually located at @kbd{C-_}) a few
-times, you will get back the un-edited message you're responding to.
-
-
-@node Header Commands
-@section Header Commands
-
-@subsection Commands for moving to headers
-
-These following commands move to the header in question. If it doesn't
-exist, it will be inserted.
-
-@table @kbd
-
-@item C-c ?
-@kindex C-c ?
-@findex describe-mode
-Describe the message mode.
-
-@item C-c C-f C-t
-@kindex C-c C-f C-t
-@findex message-goto-to
-Go to the @code{To} header (@code{message-goto-to}).
-
-@item C-c C-f C-o
-@kindex C-c C-f C-o
-@findex message-goto-from
-Go to the @code{From} header (@code{message-goto-from}). (The ``o''
-in the key binding is for Originator.)
-
-@item C-c C-f C-b
-@kindex C-c C-f C-b
-@findex message-goto-bcc
-Go to the @code{Bcc} header (@code{message-goto-bcc}).
-
-@item C-c C-f C-f
-@kindex C-c C-f C-f
-@findex message-goto-fcc
-Go to the @code{Fcc} header (@code{message-goto-fcc}).
-
-@item C-c C-f C-c
-@kindex C-c C-f C-c
-@findex message-goto-cc
-Go to the @code{Cc} header (@code{message-goto-cc}).
-
-@item C-c C-f C-s
-@kindex C-c C-f C-s
-@findex message-goto-subject
-Go to the @code{Subject} header (@code{message-goto-subject}).
-
-@item C-c C-f C-r
-@kindex C-c C-f C-r
-@findex message-goto-reply-to
-Go to the @code{Reply-To} header (@code{message-goto-reply-to}).
-
-@item C-c C-f C-n
-@kindex C-c C-f C-n
-@findex message-goto-newsgroups
-Go to the @code{Newsgroups} header (@code{message-goto-newsgroups}).
-
-@item C-c C-f C-d
-@kindex C-c C-f C-d
-@findex message-goto-distribution
-Go to the @code{Distribution} header (@code{message-goto-distribution}).
-
-@item C-c C-f C-o
-@kindex C-c C-f C-o
-@findex message-goto-followup-to
-Go to the @code{Followup-To} header (@code{message-goto-followup-to}).
-
-@item C-c C-f C-k
-@kindex C-c C-f C-k
-@findex message-goto-keywords
-Go to the @code{Keywords} header (@code{message-goto-keywords}).
-
-@item C-c C-f C-u
-@kindex C-c C-f C-u
-@findex message-goto-summary
-Go to the @code{Summary} header (@code{message-goto-summary}).
-
-@item C-c C-f C-i
-@kindex C-c C-f C-i
-@findex message-insert-or-toggle-importance
-This inserts the @samp{Importance:} header with a value of
-@samp{high}. This header is used to signal the importance of the
-message to the receiver. If the header is already present in the
-buffer, it cycles between the three valid values according to RFC
-1376: @samp{low}, @samp{normal} and @samp{high}.
-
-@item C-c C-f C-a
-@kindex C-c C-f C-a
-@findex message-generate-unsubscribed-mail-followup-to
-Insert a reasonable @samp{Mail-Followup-To:} header
-(@pxref{Mailing Lists}) in a post to an
-unsubscribed list. When making original posts to a mailing list you are
-not subscribed to, you have to type in a @samp{Mail-Followup-To:} header
-by hand. The contents, usually, are the addresses of the list and your
-own address. This function inserts such a header automatically. It
-fetches the contents of the @samp{To:} header in the current mail
-buffer, and appends the current @code{user-mail-address}.
-
-If the optional argument @code{include-cc} is non-@code{nil}, the
-addresses in the @samp{Cc:} header are also put into the
-@samp{Mail-Followup-To:} header.
-
-@end table
-
-@subsection Commands to change headers
-
-@table @kbd
-
-@item C-c C-o
-@kindex C-c C-o
-@findex message-sort-headers
-@vindex message-header-format-alist
-Sort headers according to @code{message-header-format-alist}
-(@code{message-sort-headers}).
-
-@item C-c C-t
-@kindex C-c C-t
-@findex message-insert-to
-Insert a @code{To} header that contains the @code{Reply-To} or
-@code{From} header of the message you're following up
-(@code{message-insert-to}).
-
-@item C-c C-n
-@kindex C-c C-n
-@findex message-insert-newsgroups
-Insert a @code{Newsgroups} header that reflects the @code{Followup-To}
-or @code{Newsgroups} header of the article you're replying to
-(@code{message-insert-newsgroups}).
-
-@item C-c C-l
-@kindex C-c C-l
-@findex message-to-list-only
-Send a message to the list only. Remove all addresses but the list
-address from @code{To:} and @code{Cc:} headers.
-
-@item C-c M-n
-@kindex C-c M-n
-@findex message-insert-disposition-notification-to
-Insert a request for a disposition
-notification. (@code{message-insert-disposition-notification-to}).
-This means that if the recipient support RFC 2298 she might send you a
-notification that she received the message.
-
-@item M-x message-insert-importance-high
-@kindex M-x message-insert-importance-high
-@findex message-insert-importance-high
-@cindex Importance
-Insert an @samp{Importance} header with a value of @samp{high},
-deleting headers if necessary.
-
-@item M-x message-insert-importance-low
-@kindex M-x message-insert-importance-low
-@findex message-insert-importance-low
-@cindex Importance
-Insert an @samp{Importance} header with a value of @samp{low}, deleting
-headers if necessary.
-
-@item C-c C-f s
-@kindex C-c C-f s
-@findex message-change-subject
-@cindex Subject
-Change the current @samp{Subject} header. Ask for new @samp{Subject}
-header and append @samp{(was: <Old Subject>)}. The old subject can be
-stripped on replying, see @code{message-subject-trailing-was-query}
-(@pxref{Message Headers}).
-
-@item C-c C-f x
-@kindex C-c C-f x
-@findex message-cross-post-followup-to
-@vindex message-cross-post-default
-@vindex message-cross-post-note-function
-@cindex X-Post
-@cindex cross-post
-Set up the @samp{FollowUp-To} header with a target newsgroup for a
-cross-post, add that target newsgroup to the @samp{Newsgroups} header if
-it is not a member of @samp{Newsgroups}, and insert a note in the body.
-If @code{message-cross-post-default} is @code{nil} or if this command is
-called with a prefix-argument, only the @samp{FollowUp-To} header will
-be set but the target newsgroup will not be added to the
-@samp{Newsgroups} header. The function to insert a note is controlled
-by the @code{message-cross-post-note-function} variable.
-
-@item C-c C-f t
-@kindex C-c C-f t
-@findex message-reduce-to-to-cc
-Replace contents of @samp{To} header with contents of @samp{Cc} or
-@samp{Bcc} header. (Iff @samp{Cc} header is not present, @samp{Bcc}
-header will be used instead.)
-
-@item C-c C-f w
-@kindex C-c C-f w
-@findex message-insert-wide-reply
-Insert @samp{To} and @samp{Cc} headers as if you were doing a wide
-reply even if the message was not made for a wide reply first.
-
-@item C-c C-f a
-@kindex C-c C-f a
-@findex message-add-archive-header
-@vindex message-archive-header
-@vindex message-archive-note
-@cindex X-No-Archive
-Insert @samp{X-No-Archive: Yes} in the header and a note in the body.
-The header and the note can be customized using
-@code{message-archive-header} and @code{message-archive-note}. When
-called with a prefix argument, ask for a text to insert. If you don't
-want the note in the body, set @code{message-archive-note} to
-@code{nil}.
-
-@end table
-
-
-@node Movement
-@section Movement
-
-@table @kbd
-@item C-c C-b
-@kindex C-c C-b
-@findex message-goto-body
-Move to the beginning of the body of the message
-(@code{message-goto-body}).
-
-@item C-c C-i
-@kindex C-c C-i
-@findex message-goto-signature
-Move to the signature of the message (@code{message-goto-signature}).
-
-@item C-a
-@kindex C-a
-@findex message-beginning-of-line
-@vindex message-beginning-of-line
-If at beginning of header value, go to beginning of line, else go to
-beginning of header value. (The header value comes after the header
-name and the colon.) This behavior can be disabled by toggling
-the variable @code{message-beginning-of-line}.
-
-@end table
-
-
-@node Insertion
-@section Insertion
-
-@table @kbd
-
-@item C-c C-y
-@kindex C-c C-y
-@findex message-yank-original
-Yank the message that's being replied to into the message buffer
-(@code{message-yank-original}).
-
-@item C-c C-M-y
-@kindex C-c C-M-y
-@findex message-yank-buffer
-Prompt for a buffer name and yank the contents of that buffer into the
-message buffer (@code{message-yank-buffer}).
-
-@item C-c C-q
-@kindex C-c C-q
-@findex message-fill-yanked-message
-Fill the yanked message (@code{message-fill-yanked-message}). Warning:
-Can severely mess up the yanked text if its quoting conventions are
-strange. You'll quickly get a feel for when it's safe, though. Anyway,
-just remember that @kbd{C-x u} (@code{undo}) is available and you'll be
-all right.
-
-@item C-c C-w
-@kindex C-c C-w
-@findex message-insert-signature
-Insert a signature at the end of the buffer
-(@code{message-insert-signature}).
-
-@item C-c M-h
-@kindex C-c M-h
-@findex message-insert-headers
-Insert the message headers (@code{message-insert-headers}).
-
-@item C-c M-m
-@kindex C-c M-m
-@findex message-mark-inserted-region
-Mark some region in the current article with enclosing tags.
-See @code{message-mark-insert-begin} and @code{message-mark-insert-end}.
-
-@item C-c M-f
-@kindex C-c M-f
-@findex message-mark-insert-file
-Insert a file in the current article with enclosing tags.
-See @code{message-mark-insert-begin} and @code{message-mark-insert-end}.
-
-@end table
-
-
-@node MIME
-@section MIME
-@cindex MML
-@cindex MIME
-@cindex multipart
-@cindex attachment
-
-Message is a @acronym{MIME}-compliant posting agent. The user generally
-doesn't have to do anything to make the @acronym{MIME} happen---Message will
-automatically add the @code{Content-Type} and
-@code{Content-Transfer-Encoding} headers.
-
-@findex mml-attach-file
-@kindex C-c C-a
-The most typical thing users want to use the multipart things in
-@acronym{MIME} for is to add ``attachments'' to mail they send out.
-This can be done with the @kbd{C-c C-a} command (@kbd{M-x mml-attach-file}),
-which will prompt for a file name and a @acronym{MIME} type.
-
-@vindex mml-dnd-protocol-alist
-@vindex mml-dnd-attach-options
-If your Emacs supports drag and drop, you can also drop the file in the
-Message buffer. The variable @code{mml-dnd-protocol-alist} specifies
-what kind of action is done when you drop a file into the Message
-buffer. The variable @code{mml-dnd-attach-options} controls which
-@acronym{MIME} options you want to specify when dropping a file. If it
-is a list, valid members are @code{type}, @code{description} and
-@code{disposition}. @code{disposition} implies @code{type}. If it is
-@code{nil}, don't ask for options. If it is @code{t}, ask the user
-whether or not to specify options.
-
-You can also create arbitrarily complex multiparts using the @acronym{MML}
-language (@pxref{Composing, , Composing, emacs-mime, The Emacs MIME
-Manual}).
-
-@node IDNA
-@section IDNA
-@cindex IDNA
-@cindex internationalized domain names
-@cindex non-ascii domain names
-
-Message is a @acronym{IDNA}-compliant posting agent. The user
-generally doesn't have to do anything to make the @acronym{IDNA}
-happen---Message will encode non-@acronym{ASCII} domain names in @code{From},
-@code{To}, and @code{Cc} headers automatically.
-
-Until @acronym{IDNA} becomes more well known, Message queries you
-whether @acronym{IDNA} encoding of the domain name really should
-occur. Some users might not be aware that domain names can contain
-non-@acronym{ASCII} now, so this gives them a safety net if they accidently
-typed a non-@acronym{ASCII} domain name.
-
-@vindex message-use-idna
-The @code{message-use-idna} variable control whether @acronym{IDNA} is
-used. If the variable is @code{nil} no @acronym{IDNA} encoding will
-ever happen, if it is set to the symbol @code{ask} the user will be
-queried, and if set to @code{t} (which is the default if @acronym{IDNA}
-is fully available) @acronym{IDNA} encoding happens automatically.
-
-@findex message-idna-to-ascii-rhs
-If you want to experiment with the @acronym{IDNA} encoding, you can
-invoke @kbd{M-x message-idna-to-ascii-rhs RET} in the message buffer
-to have the non-@acronym{ASCII} domain names encoded while you edit
-the message.
-
-Note that you must have @uref{http://www.gnu.org/software/libidn/, GNU
-Libidn} installed in order to use this functionality.
-
-@node Security
-@section Security
-@cindex Security
-@cindex S/MIME
-@cindex PGP
-@cindex PGP/MIME
-@cindex sign
-@cindex encrypt
-@cindex secure
-
-Using the @acronym{MML} language, Message is able to create digitally
-signed and digitally encrypted messages. Message (or rather
-@acronym{MML}) currently support @acronym{PGP} (RFC 1991),
-@acronym{PGP/MIME} (RFC 2015/3156) and @acronym{S/MIME}.
-
-@menu
-* Signing and encryption:: Signing and encrypting commands.
-* Using S/MIME:: Using S/MIME
-* Using PGP/MIME:: Using PGP/MIME
-* PGP Compatibility:: Compatibility with older implementations
-@end menu
-
-@node Signing and encryption
-@subsection Signing and encrypting commands
-
-Instructing @acronym{MML} to perform security operations on a
-@acronym{MIME} part is done using the @kbd{C-c C-m s} key map for
-signing and the @kbd{C-c C-m c} key map for encryption, as follows.
-@table @kbd
-
-@item C-c C-m s s
-@kindex C-c C-m s s
-@findex mml-secure-message-sign-smime
-
-Digitally sign current message using @acronym{S/MIME}.
-
-@item C-c C-m s o
-@kindex C-c C-m s o
-@findex mml-secure-message-sign-pgp
-
-Digitally sign current message using @acronym{PGP}.
-
-@item C-c C-m s p
-@kindex C-c C-m s p
-@findex mml-secure-message-sign-pgpmime
-
-Digitally sign current message using @acronym{PGP/MIME}.
-
-@item C-c C-m c s
-@kindex C-c C-m c s
-@findex mml-secure-message-encrypt-smime
-
-Digitally encrypt current message using @acronym{S/MIME}.
-
-@item C-c C-m c o
-@kindex C-c C-m c o
-@findex mml-secure-message-encrypt-pgp
-
-Digitally encrypt current message using @acronym{PGP}.
-
-@item C-c C-m c p
-@kindex C-c C-m c p
-@findex mml-secure-message-encrypt-pgpmime
-
-Digitally encrypt current message using @acronym{PGP/MIME}.
-
-@item C-c C-m C-n
-@kindex C-c C-m C-n
-@findex mml-unsecure-message
-Remove security related @acronym{MML} tags from message.
-
-@end table
-
-These commands do not immediately sign or encrypt the message, they
-merely insert the proper @acronym{MML} secure tag to instruct the
-@acronym{MML} engine to perform that operation when the message is
-actually sent. They may perform other operations too, such as locating
-and retrieving a @acronym{S/MIME} certificate of the person you wish to
-send encrypted mail to. When the mml parsing engine converts your
-@acronym{MML} into a properly encoded @acronym{MIME} message, the secure
-tag will be replaced with either a part or a multipart tag. If your
-message contains other mml parts, a multipart tag will be used; if no
-other parts are present in your message a single part tag will be used.
-This way, message mode will do the Right Thing (TM) with
-signed/encrypted multipart messages.
-
-Since signing and especially encryption often is used when sensitive
-information is sent, you may want to have some way to ensure that your
-mail is actually signed or encrypted. After invoking the above
-sign/encrypt commands, it is possible to preview the raw article by
-using @kbd{C-u C-c RET P} (@code{mml-preview}). Then you can
-verify that your long rant about what your ex-significant other or
-whomever actually did with that funny looking person at that strange
-party the other night, actually will be sent encrypted.
-
-@emph{Note!} Neither @acronym{PGP/MIME} nor @acronym{S/MIME} encrypt/signs
-RFC822 headers. They only operate on the @acronym{MIME} object. Keep this
-in mind before sending mail with a sensitive Subject line.
-
-By default, when encrypting a message, Gnus will use the
-``signencrypt'' mode, which means the message is both signed and
-encrypted. If you would like to disable this for a particular
-message, give the @code{mml-secure-message-encrypt-*} command a prefix
-argument, e.g., @kbd{C-u C-c C-m c p}.
-
-Actually using the security commands above is not very difficult. At
-least not compared with making sure all involved programs talk with each
-other properly. Thus, we now describe what external libraries or
-programs are required to make things work, and some small general hints.
-
-@node Using S/MIME
-@subsection Using S/MIME
-
-@emph{Note!} This section assume you have a basic familiarity with
-modern cryptography, @acronym{S/MIME}, various PKCS standards, OpenSSL and
-so on.
-
-The @acronym{S/MIME} support in Message (and @acronym{MML}) require
-OpenSSL. OpenSSL performs the actual @acronym{S/MIME} sign/encrypt
-operations. OpenSSL can be found at @uref{http://www.openssl.org/}.
-OpenSSL 0.9.6 and later should work. Version 0.9.5a cannot extract mail
-addresses from certificates, and it insert a spurious CR character into
-@acronym{MIME} separators so you may wish to avoid it if you would like
-to avoid being regarded as someone who send strange mail. (Although by
-sending @acronym{S/MIME} messages you've probably already lost that
-contest.)
-
-To be able to send encrypted mail, a personal certificate is not
-required. Message (@acronym{MML}) need a certificate for the person to whom you
-wish to communicate with though. You're asked for this when you type
-@kbd{C-c C-m c s}. Currently there are two ways to retrieve this
-certificate, from a local file or from DNS. If you chose a local
-file, it need to contain a X.509 certificate in @acronym{PEM} format.
-If you chose DNS, you're asked for the domain name where the
-certificate is stored, the default is a good guess. To my belief,
-Message (@acronym{MML}) is the first mail agent in the world to support
-retrieving @acronym{S/MIME} certificates from DNS, so you're not
-likely to find very many certificates out there. At least there
-should be one, stored at the domain @code{simon.josefsson.org}. LDAP
-is a more popular method of distributing certificates, support for it
-is planned. (Meanwhile, you can use @code{ldapsearch} from the
-command line to retrieve a certificate into a file and use it.)
-
-As for signing messages, OpenSSL can't perform signing operations
-without some kind of configuration. Especially, you need to tell it
-where your private key and your certificate is stored. @acronym{MML}
-uses an Emacs interface to OpenSSL, aptly named @code{smime.el}, and it
-contain a @code{custom} group used for this configuration. So, try
-@kbd{M-x customize-group RET smime RET} and look around.
-
-Currently there is no support for talking to a CA (or RA) to create
-your own certificate. None is planned either. You need to do this
-manually with OpenSSL or using some other program. I used Netscape
-and got a free @acronym{S/MIME} certificate from one of the big CA's on the
-net. Netscape is able to export your private key and certificate in
-PKCS #12 format. Use OpenSSL to convert this into a plain X.509
-certificate in PEM format as follows.
-
-@example
-$ openssl pkcs12 -in ns.p12 -clcerts -nodes > key+cert.pem
-@end example
-
-The @file{key+cert.pem} file should be pointed to from the
-@code{smime-keys} variable. You should now be able to send signed mail.
-
-@emph{Note!} Your private key is now stored unencrypted in the file,
-so take care in handling it. Storing encrypted keys on the disk are
-supported, and Gnus will ask you for a passphrase before invoking
-OpenSSL. Read the OpenSSL documentation for how to achieve this. If
-you use unencrypted keys (e.g., if they are on a secure storage, or if
-you are on a secure single user machine) simply press @code{RET} at
-the passphrase prompt.
-
-@node Using PGP/MIME
-@subsection Using PGP/MIME
-
-@acronym{PGP/MIME} requires an external OpenPGP implementation, such
-as @uref{http://www.gnupg.org/, GNU Privacy Guard}. Pre-OpenPGP
-implementations such as PGP 2.x and PGP 5.x are also supported. One
-Emacs interface to the PGP implementations, PGG (@pxref{Top, ,PGG,
-pgg, PGG Manual}), is included, but Mailcrypt and Florian Weimer's
-@code{gpg.el} are also supported. @xref{PGP Compatibility}.
-
-@cindex gpg-agent
-Message internally calls GnuPG (the @command{gpg} command) to perform
-data encryption, and in certain cases (decrypting or signing for
-example), @command{gpg} requires user's passphrase. Currently the
-recommended way to supply your passphrase to @command{gpg} is to use the
-@command{gpg-agent} program.
-
-To use @command{gpg-agent} in Emacs, you need to run the following
-command from the shell before starting Emacs.
-
-@example
-eval `gpg-agent --daemon`
-@end example
-
-This will invoke @command{gpg-agent} and set the environment variable
-@code{GPG_AGENT_INFO} to allow @command{gpg} to communicate with it.
-It might be good idea to put this command in your @file{.xsession} or
-@file{.bash_profile}. @xref{Invoking GPG-AGENT, , , gnupg, Using the
-GNU Privacy Guard}.
-
-Once your @command{gpg-agent} is set up, it will ask you for a
-passphrase as needed for @command{gpg}. Under the X Window System,
-you will see a new passphrase input dialog appear. The dialog is
-provided by PIN Entry (the @command{pinentry} command), and as of
-version 0.7.2, @command{pinentry} cannot cooperate with Emacs on a
-single tty. So, if you are using a text console, you may need to put
-a passphrase into gpg-agent's cache beforehand. The following command
-does the trick.
-
-@example
-gpg --use-agent --sign < /dev/null > /dev/null
-@end example
-
-The Lisp variable @code{pgg-gpg-use-agent} controls whether to use
-@command{gpg-agent}. See also @xref{Caching passphrase, , , pgg, The
-PGG Manual}.
-
-
-@node PGP Compatibility
-@subsection Compatibility with older implementations
-
-@vindex gpg-temp-directory
-Note, if you are using the @code{gpg.el} you must make sure that the
-directory specified by @code{gpg-temp-directory} have permissions
-0700.
-
-Creating your own key is described in detail in the documentation of
-your PGP implementation, so we refer to it.
-
-If you have imported your old PGP 2.x key into GnuPG, and want to send
-signed and encrypted messages to your fellow PGP 2.x users, you'll
-discover that the receiver cannot understand what you send. One
-solution is to use PGP 2.x instead (i.e., if you use @code{pgg}, set
-@code{pgg-default-scheme} to @code{pgp}). If you do want to use
-GnuPG, you can use a compatibility script called @code{gpg-2comp}
-available from
-@uref{http://muppet.faveve.uni-stuttgart.de/~gero/gpg-2comp/}. You
-could also convince your fellow PGP 2.x users to convert to GnuPG.
-@vindex mml-signencrypt-style-alist
-As a final workaround, you can make the sign and encryption work in
-two steps; separately sign, then encrypt a message. If you would like
-to change this behavior you can customize the
-@code{mml-signencrypt-style-alist} variable. For example:
-
-@lisp
-(setq mml-signencrypt-style-alist '(("smime" separate)
- ("pgp" separate)
- ("pgpauto" separate)
- ("pgpmime" separate)))
-@end lisp
-
-This causes to sign and encrypt in two passes, thus generating a
-message that can be understood by PGP version 2.
-
-(Refer to @uref{http://www.gnupg.org/gph/en/pgp2x.html} for more
-information about the problem.)
-
-@node Various Commands
-@section Various Commands
-
-@table @kbd
-
-@item C-c C-r
-@kindex C-c C-r
-@findex message-caesar-buffer-body
-Caesar rotate (aka. rot13) the current message
-(@code{message-caesar-buffer-body}). If narrowing is in effect, just
-rotate the visible portion of the buffer. A numerical prefix says how
-many places to rotate the text. The default is 13.
-
-@item C-c C-e
-@kindex C-c C-e
-@findex message-elide-region
-@vindex message-elide-ellipsis
-Elide the text between point and mark (@code{message-elide-region}).
-The text is killed and replaced with the contents of the variable
-@code{message-elide-ellipsis}. The default value is to use an ellipsis
-(@samp{[...]}).
-
-@item C-c C-z
-@kindex C-c C-z
-@findex message-kill-to-signature
-Kill all the text up to the signature, or if that's missing, up to the
-end of the message (@code{message-kill-to-signature}).
-
-@item C-c C-v
-@kindex C-c C-v
-@findex message-delete-not-region
-Delete all text in the body of the message that is outside the region
-(@code{message-delete-not-region}).
-
-@item M-RET
-@kindex M-RET
-@findex message-newline-and-reformat
-Insert four newlines, and then reformat if inside quoted text.
-
-Here's an example:
-
-@example
-> This is some quoted text. And here's more quoted text.
-@end example
-
-If point is before @samp{And} and you press @kbd{M-RET}, you'll get:
-
-@example
-> This is some quoted text.
-
-*
-
-> And here's more quoted text.
-@end example
-
-@samp{*} says where point will be placed.
-
-@item C-c M-r
-@kindex C-c M-r
-@findex message-rename-buffer
-Rename the buffer (@code{message-rename-buffer}). If given a prefix,
-prompt for a new buffer name.
-
-@item TAB
-@kindex TAB
-@findex message-tab
-@vindex message-tab-body-function
-If @code{message-tab-body-function} is non-@code{nil}, execute the
-function it specifies. Otherwise use the function bound to @kbd{TAB} in
-@code{text-mode-map} or @code{global-map}.
-
-@end table
-
-
-@node Sending
-@section Sending
-
-@table @kbd
-@item C-c C-c
-@kindex C-c C-c
-@findex message-send-and-exit
-Send the message and bury the current buffer
-(@code{message-send-and-exit}).
-
-@item C-c C-s
-@kindex C-c C-s
-@findex message-send
-Send the message (@code{message-send}).
-
-@item C-c C-d
-@kindex C-c C-d
-@findex message-dont-send
-Bury the message buffer and exit (@code{message-dont-send}).
-
-@item C-c C-k
-@kindex C-c C-k
-@findex message-kill-buffer
-Kill the message buffer and exit (@code{message-kill-buffer}).
-
-@end table
-
-
-
-@node Mail Aliases
-@section Mail Aliases
-@cindex mail aliases
-@cindex aliases
-
-@vindex message-mail-alias-type
-The @code{message-mail-alias-type} variable controls what type of mail
-alias expansion to use. Currently only one form is supported---Message
-uses @code{mailabbrev} to handle mail aliases. If this variable is
-@code{nil}, no mail alias expansion will be performed.
-
-@code{mailabbrev} works by parsing the @file{/etc/mailrc} and
-@file{~/.mailrc} files. These files look like:
-
-@example
-alias lmi "Lars Magne Ingebrigtsen <larsi@@ifi.uio.no>"
-alias ding "ding@@ifi.uio.no (ding mailing list)"
-@end example
-
-After adding lines like this to your @file{~/.mailrc} file, you should
-be able to just write @samp{lmi} in the @code{To} or @code{Cc} (and so
-on) headers and press @kbd{SPC} to expand the alias.
-
-No expansion will be performed upon sending of the message---all
-expansions have to be done explicitly.
-
-
-@node Spelling
-@section Spelling
-@cindex spelling
-@findex ispell-message
-
-There are two popular ways to have Emacs spell-check your messages:
-@code{ispell} and @code{flyspell}. @code{ispell} is the older and
-probably more popular package. You typically first write the message,
-and then run the entire thing through @code{ispell} and fix all the
-typos. To have this happen automatically when you send a message, put
-something like the following in your @file{.emacs} file:
-
-@lisp
-(add-hook 'message-send-hook 'ispell-message)
-@end lisp
-
-@vindex ispell-message-dictionary-alist
-If you're in the habit of writing in different languages, this can be
-controlled by the @code{ispell-message-dictionary-alist} variable:
-
-@lisp
-(setq ispell-message-dictionary-alist
- '(("^Newsgroups:.*\\bde\\." . "deutsch8")
- (".*" . "default")))
-@end lisp
-
-@code{ispell} depends on having the external @samp{ispell} command
-installed.
-
-The other popular method is using @code{flyspell}. This package checks
-your spelling while you're writing, and marks any mis-spelled words in
-various ways.
-
-To use @code{flyspell}, put something like the following in your
-@file{.emacs} file:
-
-@lisp
-(defun my-message-setup-routine ()
- (flyspell-mode 1))
-(add-hook 'message-setup-hook 'my-message-setup-routine)
-@end lisp
-
-@code{flyspell} depends on having the external @samp{ispell} command
-installed.
-
-
-@node Variables
-@chapter Variables
-
-@menu
-* Message Headers:: General message header stuff.
-* Mail Headers:: Customizing mail headers.
-* Mail Variables:: Other mail variables.
-* News Headers:: Customizing news headers.
-* News Variables:: Other news variables.
-* Insertion Variables:: Customizing how things are inserted.
-* Various Message Variables:: Other message variables.
-* Sending Variables:: Variables for sending.
-* Message Buffers:: How Message names its buffers.
-* Message Actions:: Actions to be performed when exiting.
-@end menu
-
-
-@node Message Headers
-@section Message Headers
-
-Message is quite aggressive on the message generation front. It has to
-be -- it's a combined news and mail agent. To be able to send combined
-messages, it has to generate all headers itself (instead of letting the
-mail/news system do it) to ensure that mail and news copies of messages
-look sufficiently similar.
-
-@table @code
-
-@item message-generate-headers-first
-@vindex message-generate-headers-first
-If @code{t}, generate all required headers before starting to
-compose the message. This can also be a list of headers to generate:
-
-@lisp
-(setq message-generate-headers-first
- '(References))
-@end lisp
-
-@vindex message-required-headers
-The variables @code{message-required-headers},
-@code{message-required-mail-headers} and
-@code{message-required-news-headers} specify which headers are
-required.
-
-Note that some headers will be removed and re-generated before posting,
-because of the variable @code{message-deletable-headers} (see below).
-
-@item message-draft-headers
-@vindex message-draft-headers
-When running Message from Gnus, the message buffers are associated
-with a draft group. @code{message-draft-headers} says which headers
-should be generated when a draft is written to the draft group.
-
-@item message-from-style
-@vindex message-from-style
-Specifies how @code{From} headers should look. There are four valid
-values:
-
-@table @code
-@item nil
-Just the address -- @samp{king@@grassland.com}.
-
-@item parens
-@samp{king@@grassland.com (Elvis Parsley)}.
-
-@item angles
-@samp{Elvis Parsley <king@@grassland.com>}.
-
-@item default
-Look like @code{angles} if that doesn't require quoting, and
-@code{parens} if it does. If even @code{parens} requires quoting, use
-@code{angles} anyway.
-
-@end table
-
-@item message-deletable-headers
-@vindex message-deletable-headers
-Headers in this list that were previously generated by Message will be
-deleted before posting. Let's say you post an article. Then you decide
-to post it again to some other group, you naughty boy, so you jump back
-to the @code{*post-buf*} buffer, edit the @code{Newsgroups} line, and
-ship it off again. By default, this variable makes sure that the old
-generated @code{Message-ID} is deleted, and a new one generated. If
-this isn't done, the entire empire would probably crumble, anarchy would
-prevail, and cats would start walking on two legs and rule the world.
-Allegedly.
-
-@item message-default-headers
-@vindex message-default-headers
-This string is inserted at the end of the headers in all message
-buffers.
-
-@item message-subject-re-regexp
-@vindex message-subject-re-regexp
-@cindex Aw
-@cindex Sv
-@cindex Re
-Responses to messages have subjects that start with @samp{Re: }. This
-is @emph{not} an abbreviation of the English word ``response'', but is
-Latin, and means ``in response to''. Some illiterate nincompoops have
-failed to grasp this fact, and have ``internationalized'' their software
-to use abominations like @samp{Aw: } (``antwort'') or @samp{Sv: }
-(``svar'') instead, which is meaningless and evil. However, you may
-have to deal with users that use these evil tools, in which case you may
-set this variable to a regexp that matches these prefixes. Myself, I
-just throw away non-compliant mail.
-
-Here's an example of a value to deal with these headers when
-responding to a message:
-
-@lisp
-(setq message-subject-re-regexp
- (concat
- "^[ \t]*"
- "\\("
- "\\("
- "[Aa][Nn][Tt][Ww]\\.?\\|" ; antw
- "[Aa][Ww]\\|" ; aw
- "[Ff][Ww][Dd]?\\|" ; fwd
- "[Oo][Dd][Pp]\\|" ; odp
- "[Rr][Ee]\\|" ; re
- "[Rr][\311\351][Ff]\\.?\\|" ; ref
- "[Ss][Vv]" ; sv
- "\\)"
- "\\(\\[[0-9]*\\]\\)"
- "*:[ \t]*"
- "\\)"
- "*[ \t]*"
- ))
-@end lisp
-
-@item message-subject-trailing-was-query
-@vindex message-subject-trailing-was-query
-@vindex message-subject-trailing-was-ask-regexp
-@vindex message-subject-trailing-was-regexp
-Controls what to do with trailing @samp{(was: <old subject>)} in subject
-lines. If @code{nil}, leave the subject unchanged. If it is the symbol
-@code{ask}, query the user what to do. In this case, the subject is
-matched against @code{message-subject-trailing-was-ask-regexp}. If
-@code{message-subject-trailing-was-query} is @code{t}, always strip the
-trailing old subject. In this case,
-@code{message-subject-trailing-was-regexp} is used.
-
-@item message-alternative-emails
-@vindex message-alternative-emails
-Regexp matching alternative email addresses. The first address in the
-To, Cc or From headers of the original article matching this variable is
-used as the From field of outgoing messages, replacing the default From
-value.
-
-For example, if you have two secondary email addresses john@@home.net
-and john.doe@@work.com and want to use them in the From field when
-composing a reply to a message addressed to one of them, you could set
-this variable like this:
-
-@lisp
-(setq message-alternative-emails
- (regexp-opt '("john@@home.net" "john.doe@@work.com")))
-@end lisp
-
-This variable has precedence over posting styles and anything that runs
-off @code{message-setup-hook}.
-
-@item message-allow-no-recipients
-@vindex message-allow-no-recipients
-Specifies what to do when there are no recipients other than
-@code{Gcc} or @code{Fcc}. If it is @code{always}, the posting is
-allowed. If it is @code{never}, the posting is not allowed. If it is
-@code{ask} (the default), you are prompted.
-
-@item message-hidden-headers
-@vindex message-hidden-headers
-A regexp, a list of regexps, or a list where the first element is
-@code{not} and the rest are regexps. It says which headers to keep
-hidden when composing a message.
-
-@lisp
-(setq message-hidden-headers
- '(not "From" "Subject" "To" "Cc" "Newsgroups"))
-@end lisp
-
-@item message-header-synonyms
-@vindex message-header-synonyms
-A list of lists of header synonyms. E.g., if this list contains a
-member list with elements @code{Cc} and @code{To}, then
-@code{message-carefully-insert-headers} will not insert a @code{To}
-header when the message is already @code{Cc}ed to the recipient.
-
-@end table
-
-
-@node Mail Headers
-@section Mail Headers
-
-@table @code
-@item message-required-mail-headers
-@vindex message-required-mail-headers
-@xref{News Headers}, for the syntax of this variable. It is
-@code{(From Subject Date (optional . In-Reply-To) Message-ID
-(optional . User-Agent))} by default.
-
-@item message-ignored-mail-headers
-@vindex message-ignored-mail-headers
-Regexp of headers to be removed before mailing. The default is@*
-@samp{^[GF]cc:\\|^Resent-Fcc:\\|^Xref:\\|^X-Draft-From:\\|@*
-^X-Gnus-Agent-Meta-Information:}.
-
-@item message-default-mail-headers
-@vindex message-default-mail-headers
-This string is inserted at the end of the headers in all message
-buffers that are initialized as mail.
-
-@end table
-
-
-@node Mail Variables
-@section Mail Variables
-
-@table @code
-@item message-send-mail-function
-@vindex message-send-mail-function
-@findex message-send-mail-with-sendmail
-@findex message-send-mail-with-mh
-@findex message-send-mail-with-qmail
-@findex message-smtpmail-send-it
-@findex smtpmail-send-it
-@findex feedmail-send-it
-Function used to send the current buffer as mail. The default is
-@code{message-send-mail-with-sendmail}. Other valid values include
-@code{message-send-mail-with-mh}, @code{message-send-mail-with-qmail},
-@code{message-smtpmail-send-it}, @code{smtpmail-send-it} and
-@code{feedmail-send-it}.
-
-@item message-mh-deletable-headers
-@vindex message-mh-deletable-headers
-Most versions of MH doesn't like being fed messages that contain the
-headers in this variable. If this variable is non-@code{nil} (which is
-the default), these headers will be removed before mailing when sending
-messages via MH. Set it to @code{nil} if your MH can handle these
-headers.
-
-@item message-qmail-inject-program
-@vindex message-qmail-inject-program
-@cindex qmail
-Location of the qmail-inject program.
-
-@item message-qmail-inject-args
-@vindex message-qmail-inject-args
-Arguments passed to qmail-inject programs.
-This should be a list of strings, one string for each argument. It
-may also be a function.
-
-For e.g., if you wish to set the envelope sender address so that bounces
-go to the right place or to deal with listserv's usage of that address, you
-might set this variable to @code{'("-f" "you@@some.where")}.
-
-@item message-sendmail-f-is-evil
-@vindex message-sendmail-f-is-evil
-@cindex sendmail
-Non-@code{nil} means don't add @samp{-f username} to the sendmail
-command line. Doing so would be even more evil than leaving it out.
-
-@item message-sendmail-envelope-from
-@vindex message-sendmail-envelope-from
-When @code{message-sendmail-f-is-evil} is @code{nil}, this specifies
-the address to use in the @acronym{SMTP} envelope. If it is
-@code{nil}, use @code{user-mail-address}. If it is the symbol
-@code{header}, use the @samp{From} header of the message.
-
-@item message-mailer-swallows-blank-line
-@vindex message-mailer-swallows-blank-line
-Set this to non-@code{nil} if the system's mailer runs the header and
-body together. (This problem exists on SunOS 4 when sendmail is run
-in remote mode.) The value should be an expression to test whether
-the problem will actually occur.
-
-@item message-send-mail-partially-limit
-@vindex message-send-mail-partially-limit
-@cindex split large message
-The limitation of messages sent as message/partial. The lower bound
-of message size in characters, beyond which the message should be sent
-in several parts. If it is @code{nil}, the size is unlimited.
-
-@end table
-
-
-@node News Headers
-@section News Headers
-
-@vindex message-required-news-headers
-@code{message-required-news-headers} a list of header symbols. These
-headers will either be automatically generated, or, if that's
-impossible, they will be prompted for. The following symbols are valid:
-
-@table @code
-
-@item From
-@cindex From
-@findex user-full-name
-@findex user-mail-address
-This required header will be filled out with the result of the
-@code{message-make-from} function, which depends on the
-@code{message-from-style}, @code{user-full-name},
-@code{user-mail-address} variables.
-
-@item Subject
-@cindex Subject
-This required header will be prompted for if not present already.
-
-@item Newsgroups
-@cindex Newsgroups
-This required header says which newsgroups the article is to be posted
-to. If it isn't present already, it will be prompted for.
-
-@item Organization
-@cindex organization
-@vindex message-user-organization
-@vindex message-user-organization-file
-This optional header will be filled out depending on the
-@code{message-user-organization} variable.
-@code{message-user-organization-file} will be used if this variable is
-@code{t}. This variable can also be a string (in which case this string
-will be used), or it can be a function (which will be called with no
-parameters and should return a string to be used).
-
-@item Lines
-@cindex Lines
-This optional header will be computed by Message.
-
-@item Message-ID
-@cindex Message-ID
-@vindex message-user-fqdn
-@vindex mail-host-address
-@vindex user-mail-address
-@findex system-name
-@cindex Sun
-@cindex i-did-not-set--mail-host-address--so-tickle-me
-This required header will be generated by Message. A unique ID will be
-created based on the date, time, user name (for the local part) and the
-domain part. For the domain part, message will look (in this order) at
-@code{message-user-fqdn}, @code{system-name}, @code{mail-host-address}
-and @code{message-user-mail-address} (i.e. @code{user-mail-address})
-until a probably valid fully qualified domain name (FQDN) was found.
-
-@item User-Agent
-@cindex User-Agent
-This optional header will be filled out according to the
-@code{message-newsreader} local variable.
-
-@item In-Reply-To
-This optional header is filled out using the @code{Date} and @code{From}
-header of the article being replied to.
-
-@item Expires
-@cindex Expires
-@vindex message-expires
-This extremely optional header will be inserted according to the
-@code{message-expires} variable. It is highly deprecated and shouldn't
-be used unless you know what you're doing.
-
-@item Distribution
-@cindex Distribution
-@vindex message-distribution-function
-This optional header is filled out according to the
-@code{message-distribution-function} variable. It is a deprecated and
-much misunderstood header.
-
-@item Path
-@cindex path
-@vindex message-user-path
-This extremely optional header should probably never be used.
-However, some @emph{very} old servers require that this header is
-present. @code{message-user-path} further controls how this
-@code{Path} header is to look. If it is @code{nil}, use the server name
-as the leaf node. If it is a string, use the string. If it is neither
-a string nor @code{nil}, use the user name only. However, it is highly
-unlikely that you should need to fiddle with this variable at all.
-@end table
-
-@findex yow
-@cindex Mime-Version
-In addition, you can enter conses into this list. The @sc{car} of this cons
-should be a symbol. This symbol's name is the name of the header, and
-the @sc{cdr} can either be a string to be entered verbatim as the value of
-this header, or it can be a function to be called. This function should
-return a string to be inserted. For instance, if you want to insert
-@code{Mime-Version: 1.0}, you should enter @code{(Mime-Version . "1.0")}
-into the list. If you want to insert a funny quote, you could enter
-something like @code{(X-Yow . yow)} into the list. The function
-@code{yow} will then be called without any arguments.
-
-If the list contains a cons where the @sc{car} of the cons is
-@code{optional}, the @sc{cdr} of this cons will only be inserted if it is
-non-@code{nil}.
-
-If you want to delete an entry from this list, the following Lisp
-snippet might be useful. Adjust accordingly if you want to remove
-another element.
-
-@lisp
-(setq message-required-news-headers
- (delq 'Message-ID message-required-news-headers))
-@end lisp
-
-Other variables for customizing outgoing news articles:
-
-@table @code
-
-@item message-syntax-checks
-@vindex message-syntax-checks
-Controls what syntax checks should not be performed on outgoing posts.
-To disable checking of long signatures, for instance, add
-
-@lisp
-(signature . disabled)
-@end lisp
-
-to this list.
-
-Valid checks are:
-
-@table @code
-@item approved
-@cindex approved
-Check whether the article has an @code{Approved} header, which is
-something only moderators should include.
-@item continuation-headers
-Check whether there are continuation header lines that don't begin with
-whitespace.
-@item control-chars
-Check for invalid characters.
-@item empty
-Check whether the article is empty.
-@item existing-newsgroups
-Check whether the newsgroups mentioned in the @code{Newsgroups} and
-@code{Followup-To} headers exist.
-@item from
-Check whether the @code{From} header seems nice.
-@item illegible-text
-Check whether there is any non-printable character in the body.
-@item invisible-text
-Check whether there is any invisible text in the buffer.
-@item long-header-lines
-Check for too long header lines.
-@item long-lines
-@cindex long lines
-Check for too long lines in the body.
-@item message-id
-Check whether the @code{Message-ID} looks syntactically ok.
-@item multiple-headers
-Check for the existence of multiple equal headers.
-@item new-text
-Check whether there is any new text in the messages.
-@item newsgroups
-Check whether the @code{Newsgroups} header exists and is not empty.
-@item quoting-style
-Check whether text follows last quoted portion.
-@item repeated-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-to} headers
-contains repeated group names.
-@item reply-to
-Check whether the @code{Reply-To} header looks ok.
-@item sender
-@cindex Sender
-Insert a new @code{Sender} header if the @code{From} header looks odd.
-@item sendsys
-@cindex sendsys
-Check for the existence of version and sendsys commands.
-@item shoot
-Check whether the domain part of the @code{Message-ID} header looks ok.
-@item shorten-followup-to
-Check whether to add a @code{Followup-to} header to shorten the number
-of groups to post to.
-@item signature
-Check the length of the signature.
-@item size
-Check for excessive size.
-@item subject
-Check whether the @code{Subject} header exists and is not empty.
-@item subject-cmsg
-Check the subject for commands.
-@item valid-newsgroups
-Check whether the @code{Newsgroups} and @code{Followup-to} headers
-are valid syntactically.
-@end table
-
-All these conditions are checked by default, except for @code{sender}
-for which the check is disabled by default if
-@code{message-insert-canlock} is non-@code{nil} (@pxref{Canceling News}).
-
-@item message-ignored-news-headers
-@vindex message-ignored-news-headers
-Regexp of headers to be removed before posting. The default is@*
-@samp{^NNTP-Posting-Host:\\|^Xref:\\|^[BGF]cc:\\|^Resent-Fcc:\\|@*
-^X-Draft-From:\\|^X-Gnus-Agent-Meta-Information:}.
-
-@item message-default-news-headers
-@vindex message-default-news-headers
-This string is inserted at the end of the headers in all message
-buffers that are initialized as news.
-
-@end table
-
-
-@node News Variables
-@section News Variables
-
-@table @code
-@item message-send-news-function
-@vindex message-send-news-function
-Function used to send the current buffer as news. The default is
-@code{message-send-news}.
-
-@item message-post-method
-@vindex message-post-method
-Gnusish @dfn{select method} (see the Gnus manual for details) used for
-posting a prepared news message.
-
-@end table
-
-
-@node Insertion Variables
-@section Insertion Variables
-
-@table @code
-@item message-ignored-cited-headers
-@vindex message-ignored-cited-headers
-All headers that match this regexp will be removed from yanked
-messages. The default is @samp{.}, which means that all headers will be
-removed.
-
-@item message-cite-prefix-regexp
-@vindex message-cite-prefix-regexp
-Regexp matching the longest possible citation prefix on a line.
-
-@item message-citation-line-function
-@vindex message-citation-line-function
-@cindex attribution line
-Function called to insert the citation line. The default is
-@code{message-insert-citation-line}, which will lead to citation lines
-that look like:
-
-@example
-Hallvard B Furuseth <h.b.furuseth@@usit.uio.no> writes:
-@end example
-
-Point will be at the beginning of the body of the message when this
-function is called.
-
-Note that Gnus provides a feature where clicking on `writes:' hides the
-cited text. If you change the citation line too much, readers of your
-messages will have to adjust their Gnus, too. See the variable
-@code{gnus-cite-attribution-suffix}. @xref{Article Highlighting, ,
-Article Highlighting, gnus, The Gnus Manual}, for details.
-
-@item message-yank-prefix
-@vindex message-yank-prefix
-@cindex yanking
-@cindex quoting
-When you are replying to or following up an article, you normally want
-to quote the person you are answering. Inserting quoted text is done
-by @dfn{yanking}, and each line you yank will have
-@code{message-yank-prefix} prepended to it (except for quoted and
-empty lines which uses @code{message-yank-cited-prefix}). The default
-is @samp{> }.
-
-@item message-yank-cited-prefix
-@vindex message-yank-cited-prefix
-@cindex yanking
-@cindex cited
-@cindex quoting
-When yanking text from an article which contains no text or already
-cited text, each line will be prefixed with the contents of this
-variable. The default is @samp{>}. See also
-@code{message-yank-prefix}.
-
-@item message-indentation-spaces
-@vindex message-indentation-spaces
-Number of spaces to indent yanked messages.
-
-@item message-cite-function
-@vindex message-cite-function
-@findex message-cite-original
-@findex sc-cite-original
-@findex message-cite-original-without-signature
-@cindex Supercite
-Function for citing an original message. The default is
-@code{message-cite-original}, which simply inserts the original message
-and prepends @samp{> } to each line.
-@code{message-cite-original-without-signature} does the same, but elides
-the signature. You can also set it to @code{sc-cite-original} to use
-Supercite.
-
-@item message-indent-citation-function
-@vindex message-indent-citation-function
-Function for modifying a citation just inserted in the mail buffer.
-This can also be a list of functions. Each function can find the
-citation between @code{(point)} and @code{(mark t)}. And each function
-should leave point and mark around the citation text as modified.
-
-@item message-mark-insert-begin
-@vindex message-mark-insert-begin
-String to mark the beginning of some inserted text.
-
-@item message-mark-insert-end
-@vindex message-mark-insert-end
-String to mark the end of some inserted text.
-
-@item message-signature
-@vindex message-signature
-String to be inserted at the end of the message buffer. If @code{t}
-(which is the default), the @code{message-signature-file} file will be
-inserted instead. If a function, the result from the function will be
-used instead. If a form, the result from the form will be used instead.
-If this variable is @code{nil}, no signature will be inserted at all.
-
-@item message-signature-file
-@vindex message-signature-file
-File containing the signature to be inserted at the end of the buffer.
-The default is @file{~/.signature}.
-
-@item message-signature-insert-empty-line
-@vindex message-signature-insert-empty-line
-If @code{t} (the default value) an empty line is inserted before the
-signature separator.
-
-@end table
-
-Note that RFC1036bis says that a signature should be preceded by the three
-characters @samp{-- } on a line by themselves. This is to make it
-easier for the recipient to automatically recognize and process the
-signature. So don't remove those characters, even though you might feel
-that they ruin your beautiful design, like, totally.
-
-Also note that no signature should be more than four lines long.
-Including @acronym{ASCII} graphics is an efficient way to get
-everybody to believe that you are silly and have nothing important to
-say.
-
-
-@node Various Message Variables
-@section Various Message Variables
-
-@table @code
-@item message-default-charset
-@vindex message-default-charset
-@cindex charset
-Symbol naming a @acronym{MIME} charset. Non-@acronym{ASCII} characters
-in messages are assumed to be encoded using this charset. The default
-is @code{iso-8859-1} on non-@sc{mule} Emacsen; otherwise @code{nil},
-which means ask the user. (This variable is used only on non-@sc{mule}
-Emacsen.) @xref{Charset Translation, , Charset Translation, emacs-mime,
-Emacs MIME Manual}, for details on the @sc{mule}-to-@acronym{MIME}
-translation process.
-
-@item message-signature-separator
-@vindex message-signature-separator
-Regexp matching the signature separator. It is @samp{^-- *$} by
-default.
-
-@item mail-header-separator
-@vindex mail-header-separator
-String used to separate the headers from the body. It is @samp{--text
-follows this line--} by default.
-
-@item message-directory
-@vindex message-directory
-Directory used by many mailey things. The default is @file{~/Mail/}.
-All other mail file variables are derived from @code{message-directory}.
-
-@item message-auto-save-directory
-@vindex message-auto-save-directory
-Directory where Message auto-saves buffers if Gnus isn't running. If
-@code{nil}, Message won't auto-save. The default is @file{~/Mail/drafts/}.
-
-@item message-signature-setup-hook
-@vindex message-signature-setup-hook
-Hook run when initializing the message buffer. It is run after the
-headers have been inserted but before the signature has been inserted.
-
-@item message-setup-hook
-@vindex message-setup-hook
-Hook run as the last thing when the message buffer has been initialized,
-but before yanked text is inserted.
-
-@item message-header-setup-hook
-@vindex message-header-setup-hook
-Hook called narrowed to the headers after initializing the headers.
-
-For instance, if you're running Gnus and wish to insert a
-@samp{Mail-Copies-To} header in all your news articles and all messages
-you send to mailing lists, you could do something like the following:
-
-@lisp
-(defun my-message-header-setup-hook ()
- (let ((group (or gnus-newsgroup-name "")))
- (when (or (message-fetch-field "newsgroups")
- (gnus-group-find-parameter group 'to-address)
- (gnus-group-find-parameter group 'to-list))
- (insert "Mail-Copies-To: never\n"))))
-
-(add-hook 'message-header-setup-hook
- 'my-message-header-setup-hook)
-@end lisp
-
-@item message-send-hook
-@vindex message-send-hook
-Hook run before sending messages.
-
-If you want to add certain headers before sending, you can use the
-@code{message-add-header} function in this hook. For instance:
-@findex message-add-header
-
-@lisp
-(add-hook 'message-send-hook 'my-message-add-content)
-(defun my-message-add-content ()
- (message-add-header "X-In-No-Sense: Nonsense")
- (message-add-header "X-Whatever: no"))
-@end lisp
-
-This function won't add the header if the header is already present.
-
-@item message-send-mail-hook
-@vindex message-send-mail-hook
-Hook run before sending mail messages. This hook is run very late --
-just before the message is actually sent as mail.
-
-@item message-send-news-hook
-@vindex message-send-news-hook
-Hook run before sending news messages. This hook is run very late --
-just before the message is actually sent as news.
-
-@item message-sent-hook
-@vindex message-sent-hook
-Hook run after sending messages.
-
-@item message-cancel-hook
-@vindex message-cancel-hook
-Hook run when canceling news articles.
-
-@item message-mode-syntax-table
-@vindex message-mode-syntax-table
-Syntax table used in message mode buffers.
-
-@item message-strip-special-text-properties
-@vindex message-strip-special-text-properties
-Emacs has a number of special text properties which can break message
-composing in various ways. If this option is set, message will strip
-these properties from the message composition buffer. However, some
-packages requires these properties to be present in order to work. If
-you use one of these packages, turn this option off, and hope the
-message composition doesn't break too bad.
-
-@item message-send-method-alist
-@vindex message-send-method-alist
-@findex message-mail-p
-@findex message-news-p
-@findex message-send-via-mail
-@findex message-send-via-news
-Alist of ways to send outgoing messages. Each element has the form:
-
-@lisp
-(@var{type} @var{predicate} @var{function})
-@end lisp
-
-@table @var
-@item type
-A symbol that names the method.
-
-@item predicate
-A function called without any parameters to determine whether the
-message is a message of type @var{type}. The function will be called in
-the buffer where the message is.
-
-@item function
-A function to be called if @var{predicate} returns non-@code{nil}.
-@var{function} is called with one parameter -- the prefix.
-@end table
-
-The default is:
-
-@lisp
-((news message-news-p message-send-via-news)
- (mail message-mail-p message-send-via-mail))
-@end lisp
-
-The @code{message-news-p} function returns non-@code{nil} if the message
-looks like news, and the @code{message-send-via-news} function sends the
-message according to the @code{message-send-news-function} variable
-(@pxref{News Variables}). The @code{message-mail-p} function returns
-non-@code{nil} if the message looks like mail, and the
-@code{message-send-via-mail} function sends the message according to the
-@code{message-send-mail-function} variable (@pxref{Mail Variables}).
-
-All the elements in this alist will be tried in order, so a message
-containing both a valid @samp{Newsgroups} header and a valid @samp{To}
-header, for example, will be sent as news, and then as mail.
-@end table
-
-
-
-@node Sending Variables
-@section Sending Variables
-
-@table @code
-
-@item message-fcc-handler-function
-@vindex message-fcc-handler-function
-A function called to save outgoing articles. This function will be
-called with the name of the file to store the article in. The default
-function is @code{message-output} which saves in Unix mailbox format.
-
-@item message-courtesy-message
-@vindex message-courtesy-message
-When sending combined messages, this string is inserted at the start of
-the mailed copy. If the string contains the format spec @samp{%s}, the
-newsgroups the article has been posted to will be inserted there. If
-this variable is @code{nil}, no such courtesy message will be added.
-The default value is @samp{"The following message is a courtesy copy of
-an article\\nthat has been posted to %s as well.\\n\\n"}.
-
-@item message-fcc-externalize-attachments
-@vindex message-fcc-externalize-attachments
-If @code{nil}, attach files as normal parts in Fcc copies; if it is
-non-@code{nil}, attach local files as external parts.
-
-@item message-interactive
-@vindex message-interactive
-If non-@code{nil} wait for and display errors when sending a message;
-if @code{nil} let the mailer mail back a message to report errors.
-
-@end table
-
-
-@node Message Buffers
-@section Message Buffers
-
-Message will generate new buffers with unique buffer names when you
-request a message buffer. When you send the message, the buffer isn't
-normally killed off. Its name is changed and a certain number of old
-message buffers are kept alive.
-
-@table @code
-@item message-generate-new-buffers
-@vindex message-generate-new-buffers
-Controls whether to create a new message buffer to compose a message.
-Valid values include:
-
-@table @code
-@item nil
-Generate the buffer name in the Message way (e.g., *mail*, *news*, *mail
-to whom*, *news on group*, etc.) and continue editing in the existing
-buffer of that name. If there is no such buffer, it will be newly
-created.
-
-@item unique
-@item t
-Create the new buffer with the name generated in the Message way. This
-is the default.
-
-@item unsent
-Similar to @code{unique} but the buffer name begins with "*unsent ".
-
-@item standard
-Similar to @code{nil} but the buffer name is simpler like *mail
-message*.
-@end table
-@table @var
-@item function
-If this is a function, call that function with three parameters: The
-type, the To address and the group name (any of these may be
-@code{nil}). The function should return the new buffer name.
-@end table
-
-The default value is @code{unique}.
-
-@item message-max-buffers
-@vindex message-max-buffers
-This variable says how many old message buffers to keep. If there are
-more message buffers than this, the oldest buffer will be killed. The
-default is 10. If this variable is @code{nil}, no old message buffers
-will ever be killed.
-
-@item message-send-rename-function
-@vindex message-send-rename-function
-After sending a message, the buffer is renamed from, for instance,
-@samp{*reply to Lars*} to @samp{*sent reply to Lars*}. If you don't
-like this, set this variable to a function that renames the buffer in a
-manner you like. If you don't want to rename the buffer at all, you can
-say:
-
-@lisp
-(setq message-send-rename-function 'ignore)
-@end lisp
-
-@item message-kill-buffer-on-exit
-@findex message-kill-buffer-on-exit
-If non-@code{nil}, kill the buffer immediately on exit.
-
-@end table
-
-
-@node Message Actions
-@section Message Actions
-
-When Message is being used from a news/mail reader, the reader is likely
-to want to perform some task after the message has been sent. Perhaps
-return to the previous window configuration or mark an article as
-replied.
-
-@vindex message-kill-actions
-@vindex message-postpone-actions
-@vindex message-exit-actions
-@vindex message-send-actions
-The user may exit from the message buffer in various ways. The most
-common is @kbd{C-c C-c}, which sends the message and exits. Other
-possibilities are @kbd{C-c C-s} which just sends the message, @kbd{C-c
-C-d} which postpones the message editing and buries the message buffer,
-and @kbd{C-c C-k} which kills the message buffer. Each of these actions
-have lists associated with them that contains actions to be executed:
-@code{message-send-actions}, @code{message-exit-actions},
-@code{message-postpone-actions}, and @code{message-kill-actions}.
-
-Message provides a function to interface with these lists:
-@code{message-add-action}. The first parameter is the action to be
-added, and the rest of the arguments are which lists to add this action
-to. Here's an example from Gnus:
-
-@lisp
- (message-add-action
- `(set-window-configuration ,(current-window-configuration))
- 'exit 'postpone 'kill)
-@end lisp
-
-This restores the Gnus window configuration when the message buffer is
-killed, postponed or exited.
-
-An @dfn{action} can be either: a normal function, or a list where the
-@sc{car} is a function and the @sc{cdr} is the list of arguments, or
-a form to be @code{eval}ed.
-
-
-@node Compatibility
-@chapter Compatibility
-@cindex compatibility
-
-Message uses virtually only its own variables---older @code{mail-}
-variables aren't consulted. To force Message to take those variables
-into account, you can put the following in your @file{.emacs} file:
-
-@lisp
-(require 'messcompat)
-@end lisp
-
-This will initialize many Message variables from the values in the
-corresponding mail variables.
-
-
-@node Appendices
-@chapter Appendices
-
-@menu
-* Responses:: Standard rules for determining where responses go.
-@end menu
-
-
-@node Responses
-@section Responses
-
-To determine where a message is to go, the following algorithm is used
-by default.
-
-@table @dfn
-@item reply
-A @dfn{reply} is when you want to respond @emph{just} to the person who
-sent the message via mail. There will only be one recipient. To
-determine who the recipient will be, the following headers are
-consulted, in turn:
-
-@table @code
-@item Reply-To
-
-@item From
-@end table
-
-
-@item wide reply
-A @dfn{wide reply} is a mail response that includes @emph{all} entities
-mentioned in the message you are responded to. All mailboxes from the
-following headers will be concatenated to form the outgoing
-@code{To}/@code{Cc} headers:
-
-@table @code
-@item From
-(unless there's a @code{Reply-To}, in which case that is used instead).
-
-@item Cc
-
-@item To
-@end table
-
-If a @code{Mail-Copies-To} header is present, it will also be included
-in the list of mailboxes. If this header is @samp{never}, that means
-that the @code{From} (or @code{Reply-To}) mailbox will be suppressed.
-
-
-@item followup
-A @dfn{followup} is a response sent via news. The following headers
-(listed in order of precedence) determine where the response is to be
-sent:
-
-@table @code
-
-@item Followup-To
-
-@item Newsgroups
-
-@end table
-
-If a @code{Mail-Copies-To} header is present, it will be used as the
-basis of the new @code{Cc} header, except if this header is
-@samp{never}.
-
-@end table
-
-
-@node GNU Free Documentation License
-@chapter GNU Free Documentation License
-@include doclicense.texi
-
-@node Index
-@chapter Index
-@printindex cp
-
-@node Key Index
-@chapter Key Index
-@printindex ky
-
-@summarycontents
-@contents
-@bye
-
-@c End:
-
-@ignore
- arch-tag: 16ab76af-a281-4e34-aed6-5624569f7601
-@end ignore
+++ /dev/null
-
-\catcode `\÷ = \active
-\def ÷{\penalty10000\hskip0.001pt-\penalty\hyphenpenalty\hskip0.001pt\relax}
-
-\def \newpagestyle#1#2#3{\@namedef{ps@#1}{\def\@oddhead{#2}\def\@oddfoot{#3}%
- \let\@evenhead\@oddhead \let\@evenfoot\@oddfoot}}
-\def \newdoublepagestyle#1#2#3#4#5{\@namedef{ps@#1}{\def\@evenhead{#2}%
- \def\@oddhead{#3}%
- \def\@evenfoot{#4}%
- \def\@oddfoot{#5}}}
-
-\newlength{\headtextwidth}
-\setlength{\headtextwidth}{\textwidth}
-\addtolength{\headtextwidth}{2cm}
-\newlength{\headetextwidth}
-\setlength{\headetextwidth}{\headtextwidth}
-\addtolength{\headetextwidth}{-0.5cm}
-\newlength{\headotextwidth}
-\setlength{\headotextwidth}{\headtextwidth}
-\addtolength{\headotextwidth}{-0.35cm}
-
-\def\outputpage{%
- \let \protect \noexpand
- \shipout \vbox{%
- \set@typeset@protect
- \aftergroup\set@typeset@protect
- \@shipoutsetup
- \@begindvi
- \vskip \topmargin
- \moveright\@themargin \vbox {%
- \setbox\@tempboxa \vbox to\headheight{%
- \vfil
- \color@hbox
- \normalcolor
- \hb@xt@ \headtextwidth {%
- \let \label \@gobble
- \let \index \@gobble
- \let \glossary \@gobble %% 21 Jun 91
- \@thehead
- }%
- \color@endbox
- }% %% 22 Feb 87
- \ifodd\c@page
- \dp\@tempboxa \z@
- \box\@tempboxa \mbox{} \\
- \ifx \@oddhead\@empty\else
- % \rule{\headotextwidth}{0.5pt}
- \fi
- \else
- \hskip -2.2cm
- \dp\@tempboxa \z@
- \box\@tempboxa \mbox{}
- \\\mbox{}
- \vskip 2pt
- \hskip -2.0cm
- \ifx \@oddhead\@empty\else
- % \rule{\headetextwidth}{0.5pt}
- \fi
- \fi
- \vskip \headsep
- \box\@outputbox
- \baselineskip \footskip
- \color@hbox
- \normalcolor
- \hb@xt@\textwidth{%
- \let \label \@gobble
- \let \index \@gobble %% 22 Feb 87
- \let \glossary \@gobble %% 21 Jun 91
- \@thefoot
- }%
- \color@endbox
- }%
- }%
- \global \@colht \textheight
- \stepcounter{page}%
- \let\firstmark\botmark
-}
-
-\def\@makechapterhead#1{\gnuspagechapter{#1}}
-
-\setcounter{tocdepth}{3}
-\setcounter{secnumdepth}{3}
-
-% arch-tag: 49bd5922-1cc7-4614-87b7-53f34f669c5c
+++ /dev/null
-#define cygnus_width 48
-#define cygnus_height 48
-static char cygnus_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x03, 0x00, 0x00, 0x00, 0x00,
- 0x60, 0x34, 0xf7, 0x34, 0x36, 0x0e, 0x30, 0x30, 0xdb, 0x6c, 0x36, 0x03,
- 0x30, 0x60, 0xd9, 0x6c, 0x36, 0x07, 0x30, 0x60, 0xd9, 0x6c, 0x36, 0x0e,
- 0x60, 0xc4, 0xd8, 0x6c, 0x36, 0x0c, 0xc0, 0xc3, 0xf0, 0x6c, 0x2c, 0x07,
- 0x00, 0x60, 0xc4, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x78, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x60, 0x01, 0x00, 0x00, 0x00, 0x00, 0xf8, 0xdf, 0x0e, 0x00,
- 0x00, 0x00, 0xf8, 0xff, 0xff, 0x00, 0x00, 0x00, 0xf0, 0x6e, 0x15, 0x00,
- 0x00, 0x00, 0x00, 0x20, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define gnu_width 48
-#define gnu_height 48
-static char gnu_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x04, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x18, 0x00, 0x00, 0x00, 0x00, 0x00, 0x78, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0xe0, 0x00, 0x00, 0x02, 0x00, 0x00, 0x80, 0x03,
- 0x00, 0x03, 0x00, 0x1c, 0x80, 0x07, 0x80, 0x01, 0x70, 0x77, 0x00, 0x0d,
- 0xc0, 0x01, 0xcf, 0xc1, 0x00, 0x0d, 0xe0, 0xc0, 0x87, 0x81, 0x01, 0x09,
- 0xe0, 0xc0, 0x03, 0x01, 0x83, 0x09, 0x70, 0xe0, 0x01, 0x00, 0xc2, 0x0c,
- 0x58, 0xf0, 0x38, 0xe0, 0x6e, 0x0c, 0x4c, 0xf8, 0x8c, 0xff, 0x3f, 0x06,
- 0x44, 0x7c, 0xcc, 0xf1, 0xf8, 0x07, 0x44, 0x3c, 0x76, 0x40, 0x01, 0x0f,
- 0xc4, 0x20, 0x1b, 0x80, 0x06, 0x10, 0x84, 0x99, 0x0d, 0x55, 0xf5, 0x3f,
- 0x0c, 0xcf, 0xf6, 0xaa, 0x8e, 0x0a, 0x18, 0x60, 0x3a, 0x55, 0x0d, 0x00,
- 0x38, 0x38, 0x5b, 0xae, 0x1a, 0x00, 0xe0, 0x8d, 0xad, 0x59, 0x1d, 0x00,
- 0xc0, 0x83, 0x2d, 0xad, 0x1a, 0x00, 0x80, 0xc1, 0xec, 0x5d, 0x1d, 0x00,
- 0x40, 0x78, 0xc6, 0xa9, 0x1a, 0x00, 0xf0, 0x7f, 0x06, 0x52, 0x3d, 0x00,
- 0x50, 0x5d, 0xc5, 0xab, 0x3a, 0x00, 0x00, 0x5c, 0x8d, 0x59, 0x35, 0x00,
- 0x00, 0x96, 0x1a, 0xa0, 0x3a, 0x00, 0x00, 0xb7, 0x2a, 0x60, 0x75, 0x00,
- 0x00, 0xe7, 0xc9, 0xc0, 0x7a, 0x00, 0x00, 0x6f, 0x19, 0x01, 0x75, 0x00,
- 0x00, 0x4f, 0x55, 0xfb, 0xda, 0x00, 0x80, 0x4f, 0xb3, 0x8a, 0x8f, 0x00,
- 0x80, 0x5f, 0xae, 0x0a, 0xee, 0x00, 0x00, 0xdf, 0x64, 0x4f, 0xe4, 0x00,
- 0x00, 0x9f, 0xdd, 0x9d, 0x65, 0x00, 0x00, 0x7e, 0x9b, 0x3d, 0x71, 0x00,
- 0x00, 0x7e, 0xb7, 0xff, 0x70, 0x00, 0x00, 0x7c, 0x6c, 0x3f, 0x7f, 0x00,
- 0x00, 0xf4, 0xcb, 0x79, 0x30, 0x00, 0x00, 0xf0, 0x93, 0x79, 0x18, 0x00,
- 0x00, 0xe0, 0xbf, 0xfd, 0x1f, 0x00, 0x00, 0xa0, 0x3f, 0x87, 0x0f, 0x00,
- 0x00, 0x80, 0xfe, 0x07, 0x00, 0x00, 0x00, 0x00, 0xfe, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0xa8, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define gov_width 48
-#define gov_height 48
-static char gov_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x0e, 0xe0, 0x00, 0x00,
- 0x00, 0xc0, 0xc1, 0x07, 0x07, 0x00, 0x00, 0x20, 0x30, 0x18, 0x08, 0x00,
- 0x00, 0x18, 0xc8, 0x26, 0x30, 0x00, 0x00, 0x04, 0xe8, 0x2f, 0x40, 0x00,
- 0x00, 0x02, 0x54, 0x55, 0x80, 0x00, 0x00, 0x11, 0xf4, 0x5f, 0x20, 0x01,
- 0x80, 0x30, 0xb4, 0x5a, 0x30, 0x02, 0x80, 0x60, 0xf4, 0x5f, 0x18, 0x02,
- 0x40, 0xe0, 0x54, 0x55, 0x1c, 0x04, 0x20, 0xc0, 0xe8, 0x2f, 0x0c, 0x08,
- 0x20, 0x81, 0xc9, 0x26, 0x06, 0x0a, 0xa0, 0x0f, 0x37, 0x98, 0xc3, 0x0f,
- 0x10, 0x3f, 0xce, 0xc7, 0xf1, 0x13, 0x10, 0xff, 0x1c, 0xe0, 0xfc, 0x13,
- 0x10, 0xfe, 0x11, 0x20, 0xfe, 0x11, 0x08, 0xfc, 0x8b, 0x23, 0xff, 0x20,
- 0x08, 0xfc, 0x4b, 0x65, 0xff, 0x20, 0x08, 0xf8, 0xb3, 0x34, 0x7f, 0x20,
- 0x08, 0xf8, 0x83, 0x0c, 0x7f, 0x20, 0x08, 0xf8, 0x43, 0x04, 0x7f, 0x20,
- 0x08, 0xf0, 0xc7, 0x87, 0x3f, 0x20, 0x08, 0xf0, 0x57, 0xd5, 0x3f, 0x20,
- 0x88, 0xf0, 0xaf, 0xea, 0x3f, 0x20, 0x88, 0xe0, 0x57, 0xd5, 0x1f, 0x20,
- 0x90, 0xc3, 0xaf, 0xea, 0x0f, 0x10, 0xd0, 0x81, 0xaf, 0xea, 0x07, 0x10,
- 0x90, 0x0f, 0xa8, 0x2a, 0x00, 0x13, 0xa0, 0x17, 0xac, 0x6a, 0xc0, 0x0b,
- 0x20, 0x3f, 0xac, 0x6a, 0xe0, 0x09, 0x20, 0x1e, 0xae, 0xea, 0xe0, 0x09,
- 0x40, 0x3e, 0xaf, 0xea, 0x73, 0x04, 0x80, 0xf4, 0xb7, 0xda, 0x3f, 0x02,
- 0x80, 0x10, 0xf0, 0x1f, 0x0c, 0x02, 0x00, 0x21, 0xd0, 0x17, 0x0e, 0x01,
- 0x00, 0x22, 0xa8, 0x2a, 0x86, 0x00, 0x00, 0x04, 0xa8, 0x2a, 0x40, 0x00,
- 0x00, 0x18, 0xf0, 0x1e, 0x30, 0x00, 0x00, 0x20, 0x00, 0x01, 0x08, 0x00,
- 0x00, 0xc0, 0x01, 0x00, 0x07, 0x00, 0x00, 0x00, 0x0e, 0xe0, 0x00, 0x00,
- 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define qmw_width 48
-#define qmw_height 48
-static char qmw_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0xc1, 0xff, 0xe0, 0x7f,
- 0xff, 0xff, 0x81, 0x7f, 0xe0, 0x7f, 0x3f, 0xf8, 0x80, 0x7f, 0xc0, 0x7f,
- 0x0f, 0xe0, 0x00, 0x3f, 0xc0, 0x7f, 0x07, 0x40, 0x00, 0x3f, 0x80, 0x7f,
- 0x03, 0x00, 0x18, 0x1e, 0x86, 0x7f, 0xc1, 0x07, 0x18, 0x1e, 0x0e, 0x7f,
- 0xf1, 0x1f, 0x3c, 0x0c, 0x0f, 0x7f, 0xf8, 0x3f, 0x3c, 0x0c, 0x1f, 0x7e,
- 0xf8, 0x3f, 0x7e, 0x80, 0x1f, 0x7e, 0xfc, 0x7f, 0x7e, 0x80, 0x3f, 0x7c,
- 0xfc, 0x7f, 0xff, 0xc0, 0x3f, 0x7c, 0xfe, 0x7f, 0xff, 0xc0, 0x7f, 0x78,
- 0xfe, 0xff, 0xff, 0xe1, 0x7f, 0x78, 0xfe, 0xff, 0xff, 0xff, 0xff, 0x7f,
- 0xfe, 0x7f, 0xf8, 0x1f, 0xfc, 0x07, 0xfe, 0x7f, 0xf0, 0x1f, 0xfc, 0x07,
- 0xfc, 0x79, 0xf0, 0x0f, 0xf8, 0x07, 0x7c, 0x70, 0xe0, 0x0f, 0xf8, 0x03,
- 0xf8, 0x30, 0xe0, 0x07, 0xf0, 0x03, 0xf0, 0x00, 0xc2, 0x87, 0xf0, 0x43,
- 0xe1, 0x01, 0xc3, 0xc3, 0xe1, 0x61, 0x83, 0x81, 0x87, 0xc3, 0xe1, 0x61,
- 0x07, 0xc0, 0x87, 0xe1, 0xc3, 0x70, 0x0f, 0xc0, 0x0f, 0xe1, 0xc3, 0x70,
- 0x3f, 0x80, 0x0f, 0xf0, 0x03, 0x78, 0xff, 0x87, 0x1f, 0xf0, 0x07, 0x78,
- 0xff, 0x0f, 0x1f, 0xf8, 0x07, 0x7c, 0xff, 0x0f, 0x3f, 0xf8, 0x0f, 0x7c,
- 0xff, 0x1f, 0x3e, 0xfc, 0x0f, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x95, 0xaa, 0x7b, 0xd7, 0x15, 0x73,
- 0xb5, 0xaa, 0x48, 0x91, 0x9c, 0x14, 0xd5, 0xaa, 0x3b, 0x97, 0x88, 0x74,
- 0x95, 0xaa, 0x28, 0x94, 0x88, 0x14, 0x97, 0xb2, 0x4b, 0x97, 0x08, 0x13,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0xc3, 0xc7, 0x98, 0x0f, 0x1f, 0x63,
- 0xe3, 0xcf, 0x99, 0x9f, 0x3f, 0x67, 0x63, 0xcc, 0x9b, 0x99, 0x31, 0x6f,
- 0x63, 0xcc, 0x9f, 0x99, 0x31, 0x7f, 0x63, 0xcc, 0x9e, 0x99, 0x31, 0x7b,
- 0xef, 0xcf, 0x9c, 0x9f, 0x3f, 0x73, 0xcf, 0xc7, 0x98, 0x0f, 0x1f, 0x63,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define ruu_width 48
-#define ruu_height 48
-static char ruu_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0x00, 0x00, 0x00, 0x00, 0xc0, 0xc0, 0x83, 0x03, 0x00,
- 0x00, 0x20, 0x80, 0x81, 0x04, 0x00, 0x00, 0xe0, 0xc3, 0x02, 0x03, 0x00,
- 0x00, 0x1e, 0x02, 0x40, 0x7a, 0x00, 0x00, 0xd2, 0x11, 0x88, 0xcb, 0x00,
- 0x00, 0x23, 0x30, 0x0d, 0xc8, 0x00, 0x40, 0x12, 0xa2, 0x21, 0x7a, 0x02,
- 0xc0, 0x9e, 0xa4, 0x35, 0x01, 0x07, 0x00, 0x83, 0xac, 0x35, 0x81, 0x01,
- 0xf0, 0x13, 0xb1, 0xa6, 0xcc, 0x00, 0x20, 0x60, 0x6a, 0x6e, 0x86, 0x00,
- 0xc0, 0xc4, 0x4a, 0xe6, 0x23, 0x01, 0x00, 0x48, 0x4e, 0x60, 0x1a, 0x00,
- 0x00, 0xb0, 0x08, 0x00, 0x0d, 0x20, 0x00, 0xc0, 0x01, 0x00, 0x73, 0x38,
- 0x60, 0xfe, 0x01, 0x80, 0x1f, 0x0e, 0x3c, 0x18, 0xf8, 0x3f, 0x18, 0x00,
- 0x28, 0x61, 0x08, 0x20, 0xec, 0x61, 0x70, 0xfc, 0x18, 0x20, 0x0e, 0x7c,
- 0x40, 0x60, 0x38, 0x20, 0x3c, 0x0c, 0x40, 0x0e, 0x78, 0x20, 0xe0, 0x78,
- 0x60, 0x38, 0xf8, 0x20, 0x0e, 0x00, 0x3c, 0xe0, 0xf8, 0x21, 0x1e, 0x34,
- 0x54, 0x7e, 0xf8, 0x23, 0xc4, 0x75, 0x7c, 0x10, 0xf8, 0x37, 0x18, 0x5c,
- 0x00, 0xf8, 0xe3, 0x8f, 0x7f, 0x2c, 0x80, 0x9c, 0x01, 0x01, 0x07, 0x00,
- 0xe8, 0xe0, 0x08, 0x20, 0x0a, 0x27, 0x38, 0x90, 0x0c, 0xe4, 0x32, 0x3f,
- 0x10, 0x49, 0x4f, 0x66, 0x07, 0x10, 0x90, 0x42, 0xe2, 0xae, 0x8c, 0x10,
- 0x80, 0x24, 0xd2, 0x2e, 0x81, 0x03, 0xa0, 0x05, 0x49, 0x62, 0x01, 0x06,
- 0xc0, 0x91, 0x28, 0x49, 0x32, 0x04, 0x80, 0x9c, 0x28, 0x49, 0x60, 0x02,
- 0x00, 0x52, 0x24, 0x09, 0xc4, 0x01, 0x00, 0x99, 0x21, 0x09, 0x8d, 0x00,
- 0x00, 0x88, 0x1d, 0x70, 0x59, 0x00, 0x00, 0xc8, 0xd0, 0xe8, 0x31, 0x00,
- 0x00, 0x40, 0xd8, 0xe0, 0x00, 0x00, 0x00, 0x40, 0xc8, 0xb0, 0x00, 0x00,
- 0x00, 0x00, 0x48, 0xc0, 0x00, 0x00, 0x00, 0x00, 0xc0, 0x20, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define uu_width 48
-#define uu_height 48
-static char uu_bits[] = {
- 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0x00, 0x7e, 0x7e, 0x00, 0x00,
- 0x00, 0xc0, 0x81, 0x81, 0x03, 0x00, 0x00, 0x30, 0x7e, 0x7e, 0x0c, 0x00,
- 0x00, 0x88, 0x01, 0x80, 0x11, 0x00, 0x00, 0x66, 0x60, 0x06, 0x66, 0x00,
- 0x00, 0x79, 0xb0, 0x0d, 0x9f, 0x00, 0x80, 0x14, 0x4e, 0x72, 0x21, 0x01,
- 0x40, 0x66, 0x54, 0x2a, 0x46, 0x02, 0x20, 0x89, 0x24, 0xa4, 0xf1, 0x04,
- 0xa0, 0x71, 0x93, 0xc9, 0x4c, 0x05, 0x50, 0xe5, 0x7c, 0x3e, 0x33, 0x0a,
- 0x48, 0x2a, 0x8a, 0x4b, 0x94, 0x13, 0xa8, 0x98, 0x15, 0x89, 0x49, 0x16,
- 0x24, 0x49, 0x2c, 0xe5, 0x52, 0x26, 0xd4, 0xab, 0xa5, 0xd5, 0xd4, 0x28,
- 0x94, 0x64, 0xf3, 0x8f, 0x26, 0x28, 0x0a, 0x95, 0xfd, 0x7f, 0xaf, 0x50,
- 0x2a, 0xaa, 0x7f, 0xfe, 0x56, 0x5f, 0x5a, 0xeb, 0x7a, 0x5e, 0x51, 0x55,
- 0xba, 0x0a, 0xff, 0xff, 0x50, 0x53, 0xca, 0x0a, 0xf5, 0xaf, 0xd0, 0x50,
- 0x0a, 0xfa, 0xff, 0xff, 0x5f, 0x50, 0x05, 0x47, 0xb7, 0x2e, 0xe3, 0xaf,
- 0xf5, 0x47, 0xb3, 0x74, 0xe1, 0xa9, 0x0a, 0x8a, 0xd6, 0xd4, 0x51, 0x56,
- 0x8a, 0xfa, 0xff, 0xff, 0x5f, 0x50, 0x8a, 0x4a, 0xe9, 0x97, 0xd2, 0x51,
- 0xfa, 0x6a, 0x57, 0x6a, 0xd3, 0x5e, 0x0a, 0xda, 0x4a, 0xd6, 0xd5, 0x5a,
- 0x0a, 0x55, 0xac, 0x35, 0x2a, 0x58, 0x94, 0xa4, 0xf3, 0xce, 0xe5, 0x28,
- 0x54, 0x29, 0x9b, 0xc9, 0x14, 0x29, 0xe4, 0x4b, 0x32, 0x54, 0xb2, 0x27,
- 0x28, 0x9c, 0x89, 0xbd, 0xc9, 0x14, 0x48, 0x32, 0x8a, 0x49, 0x94, 0x12,
- 0xd0, 0xc4, 0x7c, 0x3e, 0x2b, 0x0a, 0xa0, 0x33, 0xd3, 0xcb, 0x4d, 0x05,
- 0x20, 0x59, 0x1c, 0xf8, 0x8a, 0x04, 0x40, 0x2a, 0x23, 0xa4, 0x4c, 0x02,
- 0x80, 0x94, 0x45, 0x42, 0x29, 0x01, 0x00, 0x99, 0x26, 0x04, 0x99, 0x00,
- 0x00, 0xe6, 0x92, 0xc9, 0x66, 0x00, 0x00, 0x88, 0xe9, 0x97, 0x11, 0x00,
- 0x00, 0x30, 0x7e, 0x7e, 0x0c, 0x00, 0x00, 0xc0, 0x81, 0x81, 0x03, 0x00,
- 0x00, 0x00, 0x7e, 0x7e, 0x00, 0x00, 0x00, 0x00, 0x80, 0x01, 0x00, 0x00};
+++ /dev/null
-#define ubc_width 48
-#define ubc_height 48
-static char ubc_bits[] = {
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x80, 0xc3, 0x10, 0xf8, 0x80, 0x03,
- 0x80, 0xe7, 0x39, 0x73, 0x8c, 0x03, 0x80, 0xe7, 0x39, 0x67, 0xbe, 0x03,
- 0x80, 0xe7, 0x39, 0x27, 0xff, 0x03, 0x80, 0xe7, 0x39, 0x33, 0xff, 0x03,
- 0x80, 0xe7, 0x39, 0x38, 0xff, 0x03, 0x80, 0xe7, 0x39, 0x33, 0xff, 0x03,
- 0x80, 0xe7, 0x39, 0x27, 0xff, 0x03, 0x80, 0xe7, 0x39, 0x67, 0xbe, 0x03,
- 0x80, 0xcf, 0x3c, 0x73, 0x8c, 0x03, 0x80, 0x1f, 0x1e, 0xf8, 0xc0, 0x03,
- 0x80, 0xff, 0xff, 0xff, 0xff, 0x03, 0x80, 0xff, 0xff, 0xff, 0xff, 0x03,
- 0x80, 0xff, 0x7f, 0xfc, 0xff, 0x03, 0x80, 0x07, 0x8e, 0xe3, 0xc0, 0x03,
- 0x80, 0xfb, 0xf1, 0x1f, 0xbf, 0x03, 0x80, 0xff, 0x7f, 0xfc, 0xff, 0x03,
- 0x80, 0x07, 0x8e, 0xe3, 0xc0, 0x03, 0x80, 0xfb, 0xf1, 0x1f, 0xbf, 0x03,
- 0x80, 0xff, 0x7f, 0xfc, 0xff, 0x03, 0x80, 0x07, 0x8e, 0xe3, 0xc0, 0x03,
- 0x80, 0xfb, 0xf1, 0x1f, 0xbf, 0x03, 0x00, 0xff, 0xff, 0xff, 0xff, 0x01,
- 0x00, 0xff, 0xff, 0xfe, 0xff, 0x01, 0x00, 0xfe, 0xff, 0xfe, 0xff, 0x00,
- 0x00, 0xfe, 0xef, 0xee, 0xff, 0x00, 0x00, 0xfc, 0xce, 0xe6, 0x7e, 0x00,
- 0x00, 0xec, 0xcd, 0x66, 0x6f, 0x00, 0x00, 0xd8, 0xd9, 0x36, 0x37, 0x00,
- 0x00, 0x98, 0x99, 0x32, 0x33, 0x00, 0x00, 0x30, 0x13, 0x90, 0x19, 0x00,
- 0x00, 0x60, 0x02, 0x80, 0x0c, 0x00, 0x00, 0xc0, 0x00, 0x00, 0x06, 0x00,
- 0x00, 0x80, 0x01, 0x00, 0x03, 0x00, 0x00, 0x00, 0x03, 0x80, 0x01, 0x00,
- 0x00, 0x00, 0x06, 0xc0, 0x00, 0x00, 0x00, 0x00, 0x0c, 0x60, 0x00, 0x00,
- 0x00, 0x00, 0x18, 0x30, 0x00, 0x00, 0x00, 0x00, 0x30, 0x18, 0x00, 0x00,
- 0x00, 0x00, 0xe0, 0x0e, 0x00, 0x00, 0x00, 0x00, 0x80, 0x03, 0x00, 0x00,
- 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define upenn_width 48
-#define upenn_height 48
-static char upenn_bits[] = {
- 0x00, 0xff, 0xff, 0xff, 0xff, 0x00, 0x00, 0x01, 0x00, 0x00, 0x80, 0x00,
- 0x00, 0xfd, 0xff, 0xff, 0xbf, 0x00, 0x00, 0xfd, 0xff, 0xff, 0xbf, 0x00,
- 0x00, 0xad, 0xfa, 0x5f, 0xb5, 0x00, 0x00, 0xf5, 0xff, 0xff, 0xaf, 0x00,
- 0x00, 0x5d, 0x1a, 0x5a, 0xba, 0x00, 0x00, 0x95, 0xde, 0x76, 0xa9, 0x00,
- 0x00, 0x5d, 0x2a, 0x55, 0xba, 0x00, 0x00, 0x95, 0xee, 0x79, 0xa9, 0x00,
- 0x00, 0x5d, 0xfa, 0x5f, 0xba, 0x00, 0x00, 0xf5, 0xff, 0xff, 0xaf, 0x00,
- 0x00, 0xad, 0xfa, 0x5f, 0xb5, 0x00, 0x00, 0xfd, 0xff, 0xff, 0xbf, 0x00,
- 0x00, 0xfd, 0xff, 0xff, 0xbf, 0x00, 0x00, 0x05, 0x80, 0x01, 0xa0, 0x00,
- 0x00, 0x05, 0xc0, 0x03, 0xa0, 0x00, 0x00, 0x05, 0xe0, 0x07, 0xa0, 0x00,
- 0x00, 0x05, 0xf0, 0x0f, 0xa0, 0x00, 0x00, 0x05, 0x78, 0x1e, 0xa0, 0x00,
- 0x00, 0x05, 0x3c, 0x3c, 0xa0, 0x00, 0x00, 0x05, 0x1e, 0x78, 0xa0, 0x00,
- 0x00, 0x09, 0x1f, 0xf8, 0x90, 0x00, 0x00, 0x8a, 0x3f, 0xfc, 0x51, 0x00,
- 0x00, 0xca, 0x79, 0x9e, 0x53, 0x00, 0x00, 0xea, 0xf0, 0x0f, 0x57, 0x00,
- 0x00, 0x72, 0xe0, 0x07, 0x4e, 0x00, 0x00, 0x74, 0xe0, 0x07, 0x2e, 0x00,
- 0x00, 0xe4, 0x70, 0x0e, 0x27, 0x00, 0x00, 0xe8, 0x39, 0x9c, 0x17, 0x00,
- 0x00, 0xc8, 0x1f, 0xf8, 0x13, 0x00, 0x00, 0xd0, 0x0f, 0xf0, 0x0b, 0x00,
- 0x00, 0x90, 0x07, 0xe0, 0x09, 0x00, 0x00, 0xa0, 0x03, 0xc0, 0x05, 0x00,
- 0x00, 0x20, 0x01, 0x80, 0x04, 0x00, 0x1b, 0x47, 0x02, 0x40, 0xe2, 0xd8,
- 0xf5, 0x88, 0x04, 0x20, 0x11, 0xaf, 0x1d, 0x09, 0x19, 0x98, 0x90, 0xb8,
- 0xc5, 0x05, 0x62, 0x46, 0xa0, 0xa3, 0xe7, 0x0b, 0x8c, 0x31, 0xd0, 0xe7,
- 0x58, 0x39, 0x30, 0x0c, 0x9c, 0x1a, 0x70, 0xed, 0xc3, 0xc3, 0xb7, 0x0e,
- 0x00, 0x11, 0x3c, 0x3c, 0x88, 0x00, 0x00, 0xf2, 0xc1, 0x83, 0x4f, 0x00,
- 0x00, 0x4c, 0x15, 0xa8, 0x32, 0x00, 0x00, 0xf0, 0x72, 0x4d, 0x0f, 0x00,
- 0x00, 0x80, 0x07, 0xe0, 0x01, 0x00, 0x00, 0x00, 0xf8, 0x1f, 0x00, 0x00};
+++ /dev/null
-#define wesleyan_width 48
-#define wesleyan_height 48
-static char wesleyan_bits[] = {
- 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0xff, 0xff, 0x01, 0x00,
- 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00,
- 0x00, 0xf8, 0x0f, 0xe0, 0x3f, 0x00, 0x00, 0xfe, 0xff, 0x0f, 0xff, 0x00,
- 0x00, 0xff, 0x01, 0x10, 0xfc, 0x01, 0x80, 0x9f, 0x00, 0x30, 0xf0, 0x03,
- 0xc0, 0x8f, 0x00, 0x48, 0xe0, 0x07, 0xc0, 0x47, 0x00, 0x84, 0xc0, 0x07,
- 0xe0, 0x43, 0x00, 0x84, 0x80, 0x0f, 0xf0, 0x21, 0x00, 0x02, 0x01, 0x1f,
- 0xf0, 0x20, 0x00, 0x02, 0x01, 0x1e, 0xf8, 0x20, 0x00, 0x42, 0x01, 0x3e,
- 0x78, 0x10, 0x00, 0x81, 0x00, 0x3c, 0x7c, 0x10, 0x00, 0xa1, 0x00, 0x7c,
- 0x3c, 0x10, 0x00, 0x21, 0x01, 0x78, 0x3c, 0x08, 0x80, 0x00, 0x02, 0x78,
- 0x3c, 0x08, 0x80, 0x00, 0x04, 0x78, 0x1e, 0x08, 0x80, 0x00, 0x08, 0xf0,
- 0x1e, 0x04, 0x40, 0x00, 0x08, 0xf0, 0x1e, 0x04, 0x40, 0xc0, 0x07, 0xf0,
- 0x1e, 0x04, 0x40, 0x80, 0x00, 0xf0, 0x1e, 0x02, 0x20, 0xc0, 0x00, 0xf0,
- 0x1e, 0x02, 0x10, 0x80, 0x00, 0xf0, 0x1e, 0x02, 0x10, 0x40, 0x00, 0xf0,
- 0x1e, 0x01, 0x10, 0x20, 0x00, 0xf0, 0x9e, 0x02, 0x10, 0x40, 0x00, 0xf0,
- 0xbc, 0x18, 0x10, 0x40, 0x00, 0x78, 0xbc, 0x40, 0x10, 0x40, 0x00, 0x78,
- 0xbc, 0x01, 0x12, 0x3e, 0x00, 0x78, 0x7c, 0x0e, 0xf8, 0x03, 0x00, 0x7c,
- 0x78, 0x70, 0x24, 0x06, 0x00, 0x3c, 0xf8, 0x80, 0xe2, 0x0e, 0x00, 0x3e,
- 0xf0, 0x3e, 0x21, 0x16, 0x00, 0x1e, 0xf0, 0xc1, 0xf0, 0x23, 0x00, 0x1f,
- 0xe0, 0x1b, 0x13, 0x49, 0x80, 0x0f, 0xc0, 0x67, 0x74, 0x51, 0xc0, 0x07,
- 0xc0, 0x8f, 0x13, 0x55, 0xe0, 0x07, 0x80, 0x1f, 0x14, 0xa5, 0xf0, 0x03,
- 0x00, 0x7f, 0xe4, 0x8a, 0xfc, 0x01, 0x00, 0xfe, 0x21, 0x92, 0xff, 0x00,
- 0x00, 0xf8, 0xaf, 0xe3, 0x3f, 0x00, 0x00, 0xf0, 0xff, 0xff, 0x1f, 0x00,
- 0x00, 0xc0, 0xff, 0xff, 0x07, 0x00, 0x00, 0x00, 0xff, 0xff, 0x01, 0x00,
- 0x00, 0x00, 0xf0, 0x1f, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00, 0x00};
+++ /dev/null
-#define yale_width 48
-#define yale_height 48
-static char yale_bits[] = {
- 0xff, 0xff, 0xff, 0xff, 0xff, 0xff, 0x57, 0x55, 0x55, 0x55, 0x55, 0xd5,
- 0xab, 0xaa, 0xaa, 0xaa, 0xaa, 0xea, 0x57, 0x55, 0x55, 0x55, 0x55, 0xd5,
- 0xab, 0xaa, 0xaa, 0xaa, 0xaa, 0xea, 0x17, 0x00, 0x55, 0x55, 0x01, 0xd4,
- 0xab, 0x3f, 0xa8, 0xaa, 0xf8, 0xea, 0x07, 0xc1, 0x01, 0x00, 0x8e, 0xc0,
- 0x33, 0x01, 0xfe, 0xfe, 0x81, 0xcc, 0x2b, 0x01, 0x00, 0x01, 0x80, 0xd4,
- 0xab, 0x01, 0x00, 0x01, 0x80, 0xd5, 0x4b, 0x35, 0x6e, 0xbd, 0xa5, 0xd2,
- 0x2b, 0x6d, 0x6e, 0xbd, 0xad, 0xd4, 0x93, 0x49, 0x4a, 0x21, 0x99, 0xc9,
- 0xe3, 0x49, 0x4a, 0x21, 0x99, 0xc6, 0x07, 0x49, 0x4a, 0x21, 0xb5, 0xe0,
- 0x0b, 0x75, 0x4b, 0x21, 0xa5, 0xd0, 0x07, 0x01, 0x00, 0x01, 0x80, 0xe0,
- 0x33, 0x41, 0x00, 0x11, 0x80, 0xcc, 0x2b, 0x81, 0x33, 0xe1, 0x8c, 0xd4,
- 0xab, 0x81, 0x27, 0xe1, 0x89, 0xd5, 0x4b, 0x81, 0x04, 0x21, 0x81, 0xd2,
- 0x2b, 0x81, 0x04, 0x21, 0x81, 0xd4, 0x93, 0x81, 0x07, 0xe1, 0x81, 0xc9,
- 0x63, 0x01, 0x00, 0x01, 0x80, 0xc6, 0x07, 0xff, 0x7f, 0xfd, 0xff, 0xe0,
- 0x2e, 0xfe, 0xff, 0xff, 0x7f, 0x6a, 0x56, 0x00, 0x80, 0x01, 0x00, 0x75,
- 0xac, 0xaa, 0x2a, 0xa8, 0xaa, 0x3a, 0x5c, 0x55, 0x55, 0x55, 0x55, 0x1d,
- 0xb8, 0xaa, 0xaa, 0xaa, 0xaa, 0x0e, 0x70, 0x55, 0x55, 0x55, 0x55, 0x07,
- 0xe0, 0xaa, 0xaa, 0xaa, 0xaa, 0x03, 0x80, 0x57, 0x55, 0x55, 0xd5, 0x01,
- 0x00, 0xae, 0xaa, 0xaa, 0x7a, 0x00, 0x00, 0x78, 0x55, 0x55, 0x1d, 0x00,
- 0x00, 0xe0, 0xaa, 0xaa, 0x07, 0x00, 0x00, 0x80, 0x57, 0xf5, 0x01, 0x00,
- 0x00, 0x00, 0xbc, 0x3a, 0x00, 0x00, 0x00, 0x00, 0xf0, 0x0f, 0x00, 0x00,
- 0x00, 0x00, 0x80, 0x01, 0x00, 0x00, 0x00, 0xcc, 0x30, 0x0c, 0x7e, 0x00,
- 0x00, 0xcc, 0x30, 0x0c, 0x06, 0x00, 0x00, 0x78, 0x78, 0x0c, 0x06, 0x00,
- 0x00, 0x30, 0x58, 0x0c, 0x3e, 0x00, 0x00, 0x30, 0xfc, 0x0c, 0x06, 0x00,
- 0x00, 0x30, 0x8c, 0x0c, 0x06, 0x00, 0x00, 0x30, 0x8e, 0xfd, 0x7e, 0x00};
+++ /dev/null
-% SHOWIDX DOCUMENT-STYLE OPTION - released 16 June 1991
-% for LaTeX version 2.09
-% Copyright (C) 1985, 1988, 1989, 1991 by Leslie Lamport
-% Modified by Lars Ingebrigtsen 1993
-%
-% Prints \index entries in outer margin. For use with book or report
-% style. Note: makes \flushbottom the default.
-
-\typeout{Document style option `showidx' - released 16 June 1991}
-\typeout{Modified for use in eyesore.}
-
-\newbox\eye@boxa
-\newbox\eye@boxb
-\newbox\eye@boxc
-\newbox\eye@boxd
-\newbox\eye@boxe
-\newbox\eye@boxf
-\newbox\eye@boxg
-\newbox\eye@box
-\newbox\new@box
-
- \global \setbox \eye@boxa \hbox{}
- \global \setbox \eye@boxb \hbox{}
- \global \setbox \eye@boxc \hbox{}
- \global \setbox \eye@boxd \hbox{}
- \global \setbox \eye@boxe \hbox{}
- \global \setbox \eye@boxf \hbox{}
- \global \setbox \eye@boxg \hbox{}
-
-\newdimen\eye@boxadim \global\eye@boxadim\z@
-\newdimen\eye@boxbdim \global\eye@boxbdim\z@
-\newdimen\eye@boxcdim \global\eye@boxcdim\z@
-\newdimen\eye@boxddim \global\eye@boxddim\z@
-\newdimen\eye@boxedim \global\eye@boxedim\z@
-\newdimen\eye@boxfdim \global\eye@boxfdim\z@
-\newdimen\eye@boxgdim \global\eye@boxgdim\z@
-
-\newdimen\gnus@horiz \global\gnus@horiz\z@
-\newdimen\gnus@vert \global\gnus@vert\z@
-
-
-\newdimen\eye@height
-\global\eye@height\textheight
-% \global\advance\eye@height 8cm
-
-\newdimen\eyeins@height
-\global\eyeins@height\z@
-
-\newdimen\eye@adjust
-\global\eye@adjust 0cm
-
-\newinsert\indexbox
-\dimen\indexbox=\maxdimen
-
-\newinsert\gnusbox
-\dimen\gnusbox=\maxdimen
-
-\newdimen\eye@dim
-\newdimen\new@dim
-\newdimen\doinsert
-
-\newdimen\eye@strutd
-\def\eye@strut#1{%
- \eye@strutd#1
- \advance\eye@strutd\eye@adjust
- \advance\eye@strutd -1mm
- \raisebox{-\eye@strutd}[0pt][0pt]{\rule{1mm}{\eye@strutd}}
-}
-
-\newdimen\eye@tmpd
-\newbox\eye@tmpba
-\newbox\eye@tmpbb
-\def\eye@insbox#1#2#3{%
- \eye@dim#2
- \advance\eye@dim\ht#3
- \advance\eye@dim\eye@adjust
- \ifdim \eye@dim < \eye@height
- \global#2\eye@dim
- \global\setbox#1
- \hbox{\unhbox#1
-% \eye@strut{\ht#3}
- \unhbox#3
- \vrule \@height 1cm \@width\z@}
- \setbox #3 \hbox{}
- \fi}
-
-\def\@showidx#1{
- \setbox\new@box\hbox{#1}
- % \typeout{Vi er i showidx.}
- \new@dim\z@
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxa\eye@boxadim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxb\eye@boxbdim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxc\eye@boxcdim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxd\eye@boxddim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxe\eye@boxedim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxf\eye@boxfdim\new@box
- \ifdim \ht\new@box > \z@
- \eye@insbox\eye@boxg\eye@boxgdim\new@box
- \ifdim \ht\new@box > \z@
- \else
- \typeout{Discarding index.}
- \fi\fi\fi\fi\fi\fi\fi
- \fi
-
- \doinsert \z@
- \ifdim \eyeins@height > \z@
- \eye@dim\eyeins@height
- \advance\eye@dim\eye@boxadim
- \ifdim \eye@dim < \eye@height
- \global\eyeins@height\eye@dim
- \doinsert 1pt
- \fi
- \else
- \doinsert 1pt
- \global\eyeins@height\eye@boxadim
- \fi
-
- \ifdim \ht\eye@boxa > \z@
-
- \ifdim \doinsert > \z@
-% \typeout{Vi inserter i indexbox.}
- \insert\indexbox{
- \small
- \hsize\marginparwidth
- \hangindent\marginparsep
- \parindent\z@
- \parfillskip\@flushglue
- \everypar{}\let\par\@@par
- \lineskip\normallineskip
- \baselineskip .8\normalbaselineskip
- \ifodd\c@page\raggedleft\else\raggedright\fi
- \leavevmode
- \relax
- \unhbox\eye@boxa
- \relax
- }
- \global \setbox \eye@boxa \copy\eye@boxb
- \global \setbox \eye@boxb \copy\eye@boxc
- \global \setbox \eye@boxc \copy\eye@boxd
- \global \setbox \eye@boxd \copy\eye@boxe
- \global \setbox \eye@boxe \copy\eye@boxf
- \global \setbox \eye@boxf \copy\eye@boxg
- \global \setbox \eye@boxg \hbox{}
- \global \eye@boxadim\eye@boxbdim
- \global \eye@boxbdim\eye@boxcdim
- \global \eye@boxcdim\eye@boxddim
- \global \eye@boxddim\eye@boxedim
- \global \eye@boxedim\eye@boxfdim
- \global \eye@boxfdim\eye@boxgdim
- \global \eye@boxgdim\z@
- \fi
- \fi
-
-}
-
-\def\@rightidx{\hskip\columnwidth \hskip\marginparsep}
-\def\@leftidx{\hskip-\marginparsep \hskip-\marginparwidth}
-
-\def\@mkidx{
-
-% \typeout{Vi er i mkidx 1.}
-
- \vbox to \z@{
- \vskip \gnus@vert
- \hbox{
- \hskip \gnus@horiz
- \box\gnusbox
- }\vss
- }
- \vbox to \z@{
- \ifdim \eyeins@height < \textheight
- \eye@dim \textheight
- \advance \eye@dim -\eyeins@height
-% \vskip \eye@dim
- \else
- \eye@dim \eye@height
- \advance \eye@dim -3cm
- \ifdim \eyeins@height > \eye@dim
- % \vskip -3cm
- \fi\fi
- \hbox{
- \ifodd\c@page \@rightidx \else \@leftidx \fi
- \box\indexbox
- }\vss
- }
-
- \global\eyeins@height\z@
-
-}
-
-\def\raggedbottom{\def\@textbottom{\vskip
- \z@ plus.0001fil}\let\@texttop\@mkidx}
-\def\flushbottom{\let\@textbottom\relax \let\@texttop\@mkidx}
-
-\def\margindex#1{\@bsphack
-\begingroup\@sanitize\catcode32=10\relax\@showidx{#1}
- \endgroup\@esphack}
-
-\def\@gnusfig#1{
- \insert\gnusbox{
- \small
- \hsize\textwidth
- \hangindent\marginparsep
- \parindent\z@
- \parfillskip\@flushglue
- \everypar{}\let\par\@@par
- \lineskip\normallineskip
- \baselineskip .8\normalbaselineskip
- \ifodd\c@page\raggedleft\else\raggedright\fi
- \leavevmode
- \relax
- #1
- \relax
- }
-}
-
-\def\gnusfig#1#2#3{\@bsphack
-\begingroup\@sanitize\catcode32=10\relax\@gnusfig{#3}\global\gnus@horiz#1 \global\gnus@vert#2
- \endgroup\@esphack}
-
-\flushbottom
-
-\endinput
-
-% arch-tag: 286974d6-3578-4aa9-b298-f6a03b13f0bd
+++ /dev/null
-\gnuscleardoublepage
-
-\pagestyle{gnusindex}
-
-\renewcommand\indexname{Key Index}
-\renewcommand{\gnuschaptername}{Key Index}
-\input{gnus.kind}
-\gnuscleardoublepage
-
-\renewcommand\indexname{Function and Variable Index}
-\renewcommand{\gnuschaptername}{Function and Variable Index}
-\input{gnus.gind}
-\gnuscleardoublepage
-\thispagestyle{empty}
-
-\renewcommand\indexname{Concept Index}
-\renewcommand{\gnuschaptername}{Concept Index}
-\input{gnus.cind}
-
-\mbox{}
-%\thispagestyle{empty}\mbox{}\clearpage\thispagestyle{empty}\mbox{}\clearpage
-\ifodd\count0\else\thispagestyle{empty}\clearpage\fi
-\mbox{}
-\thispagestyle{empty}
-\vfill
-
-This manual was written by Lars Magne Ingebrigtsen (1968 --- ) who
-resides in Oslo, Norway and poses as a student, but doesn't get much
-studying done, for some strange reason or other. When not worshipping
-at the altar of Emacs, he can often be found slouching on his couch
-reading while bopping his head gently to some obscure music. He does
-not have a cat.
-
-\marginpar[\vspace*{-2.5cm}\epsfig{figure=ps/larsi,height=2cm}]{\vspace*{-2.2cm}\epsfig{figure=ps/larsi,height=2.5cm}}
-
-Graphics by Luis Fernandes. \gnususefonts{}
-
-\clearpage
-\mbox{}
-\thispagestyle{empty}
-\begin{picture}(500,500)(0,0)
-\put(-35,325){\makebox(480,350)[tr]{\epsfig{figure=ps/new-herd-section}}}
-\end{picture}
-
-\end{document}
-
-%%% Local Variables:
-%%% mode: latex
-%%% TeX-master: t
-%%% End:
-
-% arch-tag: 5e771934-0d03-4dbc-898f-10eb429ad992
+++ /dev/null
-%!PS-Adobe-2.0 EPSF-1.2
-%%Creator: Adobe Illustrator 88(TM) format generated by CorelTRACE Version 2.0C
-%%Title: /home/menja/c/larsi/rgnus/texi/ps/eegnu.eps
-%%BoundingBox: 0 0 890.3 909.7
-%%CreationDate: Fri Oct 11 14:59:05 1996
-%%DocumentFonts:
-%%ColorUsage: B & W
-%%TileBox: 0 0 890.3 909.7
-%%EndComments
-% Copyright 1992 Corel Corporation.
-
-% All rights reserved.
-/wPSMDict 150 dict def
-wPSMDict begin
-/bd {bind def} bind def
-/ld {load def} bd
-/xd {exch def} bd
-/_ null def
-/$c 0 def
-/$m 0 def
-/$y 0 def
-/$k 0 def
-/$t 1 def
-/$n _ def
-/$o 0 def
-/$C 0 def
-/$M 0 def
-/$Y 0 def
-/$K 0 def
-/$T 1 def
-/$N _ def
-/$O 0 def
-/$h false def
-/$al 0 def
-/$tr 0 def
-/$le 0 def
-/$lx 0 def
-/$ly 0 def
-/$ctm matrix currentmatrix def
-/@cp /closepath ld
-/@gs /gsave ld
-/@gr /grestore ld
-/@MN {2 copy le{pop}{exch pop}ifelse}bd
-/setcmykcolor where {pop}{/setcmykcolor{4 1 roll
-3 {3 index add 1 @MN 1 exch sub 3 1 roll} repeat
-setrgbcolor
-pop}bd}ifelse
-/@tc{dup 1 ge{pop}{4 {dup
-6 -1 roll
-mul
-exch}repeat
-pop}ifelse}bd
-/@scc{$c $m $y $k $t @tc setcmykcolor true}bd
-/@SCC{$C $M $Y $K $T @tc setcmykcolor true}bd
-/@sm{/$ctm $ctm currentmatrix def}bd
-/x {/$t xd /$n xd
-/$k xd /$y xd /$m xd /$c xd}bd
-/X {/$T xd /$N xd
-/$K xd /$Y xd /$M xd /$C xd}bd
-/g {1 exch sub 0 0 0
-4 -1 roll
-_ 1 x}bd
-/G {1 exch sub 0 0 0
-4 -1 roll
-_ 1 X}bd
-/k {_ 1 x}bd
-/K {_ 1 X}bd
-/d /setdash ld
-/i {dup 0 ne {setflat} {pop} ifelse}bd
-/j /setlinejoin ld
-/J /setlinecap ld
-/M /setmiterlimit ld
-/w /setlinewidth ld
-/O {/$o xd}bd
-/R {/$O xd}bd
-/c /curveto ld
-/C /c ld
-/l /lineto ld
-/L /l ld
-/m /moveto ld
-/n /newpath ld
-/N /newpath ld
-/F {@scc{eofill}if n} bd
-/f {@cp F}bd
-/S {@SCC{stroke}if n} bd
-/s {@cp
-S}bd
-/B {@gs F @gr
-S}bd
-/b {@cp B }bd
-/u {}bd
-/U {}bd
-%%EndProlog
-%%BeginSetup
-%%EndSetup
-1 i
-2 J
-0 j
-4 M
-[]0 d
-
-%%Note: traced as Normal_Outline
-0 g
-163.4 2.9 m
-197.1 51.5 223.7 94.3 251.6 130.7 C
-283.4 176.1 312.0 216.3 342.8 256.8 C
-373.2 303.2 401.1 342.1 420.0 396.9 C
-421.2 403.1 425.1 408.9 424.5 413.5 C
-395.6 371.6 368.4 326.2 337.2 285.0 C
-306.1 247.4 276.3 199.4 244.5 161.5 C
-212.1 116.7 182.9 79.1 168.6 20.4 C
-166.3 13.9 164.7 8.1 162.4 2.2 C
-162.4 2.2 163.4 2.9 163.4 2.9 C
-f
-0 g
-428.1 170.2 m
-428.1 170.2 429.7 170.2 430.0 170.5 C
-454.7 211.4 474.8 275.6 504.0 301.9 C
-512.1 300.6 515.0 280.8 527.3 283.1 C
-534.8 284.4 536.4 284.1 542.9 288.9 C
-571.4 331.1 600.3 374.5 623.6 423.2 C
-640.2 454.7 661.6 492.9 663.5 517.6 C
-660.3 515.6 L
-633.7 468.6 613.2 419.6 582.4 378.4 C
-572.1 367.1 566.5 352.8 550.7 348.3 C
-543.2 348.3 536.1 354.4 530.5 363.8 C
-528.9 367.1 528.9 368.1 525.4 369.7 C
-495.5 333.7 466.7 282.8 446.5 233.5 C
-436.2 206.2 433.2 190.0 427.4 170.5 C
-427.4 170.5 428.1 170.2 428.1 170.2 C
-f
-0 g
-754.7 271.7 m
-783.8 345.7 780.3 386.2 794.2 447.5 C
-806.2 497.1 819.2 543.8 843.5 614.9 C
-869.5 690.4 875.0 731.0 888.0 787.1 C
-892.5 826.7 892.8 865.9 869.5 898.7 C
-853.9 908.7 841.9 912.3 822.1 909.4 C
-785.5 890.2 764.1 846.4 749.8 799.7 C
-750.4 793.6 750.8 791.3 755.0 788.1 C
-755.6 788.1 756.9 788.1 757.9 788.1 C
-772.8 803.3 773.8 842.9 796.8 849.0 C
-817.6 849.0 826.3 847.7 840.3 834.8 C
-855.8 799.7 856.2 789.4 858.1 755.0 C
-855.2 687.5 836.7 643.7 819.8 576.9 C
-801.7 513.7 781.9 454.3 772.8 406.7 C
-766.3 361.6 755.0 332.4 754.0 271.7 C
-754.0 271.7 754.7 271.7 754.7 271.7 C
-f
-0 g
-383.0 484.8 m
-421.2 539.0 420.6 593.1 405.4 650.9 C
-395.0 674.5 382.7 683.6 367.7 695.0 C
-354.8 681.0 339.2 664.2 330.1 640.2 C
-330.1 640.2 330.1 638.5 330.4 638.2 C
-351.5 628.8 372.3 592.2 378.1 567.2 C
-381.0 544.5 378.8 505.2 382.3 484.8 C
-382.3 484.8 383.0 484.8 383.0 484.8 C
-f
-0 g
-120.6 509.8 m
-171.2 511.7 215.0 550.7 255.8 589.6 C
-283.4 609.7 302.2 627.8 315.8 663.5 C
-280.8 636.9 238.3 595.7 192.6 571.7 C
-179.6 566.2 162.4 565.6 147.8 570.4 C
-139.4 578.2 136.2 580.5 136.5 588.6 C
-144.6 635.3 192.3 684.3 217.6 724.8 C
-223.4 738.1 235.7 745.9 238.3 758.9 C
-204.3 726.8 174.1 677.1 147.5 634.3 C
-127.1 600.3 95.3 560.1 102.1 520.5 C
-107.0 510.8 111.8 513.7 120.6 509.8 C
-f
-0 g
-621.7 657.7 m
-669.0 661.2 703.4 716.1 724.8 769.6 C
-730.7 779.0 728.7 785.5 731.3 792.9 C
-711.8 758.5 695.0 728.4 656.7 720.9 C
-638.2 720.3 635.0 721.9 624.9 732.6 C
-621.7 736.5 620.4 739.4 618.1 744.3 C
-588.6 683.0 L
-593.1 671.6 598.3 665.5 608.1 661.9 C
-612.0 661.6 617.8 659.0 621.7 657.7 C
-f
-0 g
-502.0 681.0 m
-526.7 680.4 547.7 694.7 565.2 716.1 C
-576.0 734.9 583.1 755.0 592.2 775.4 C
-592.2 779.6 591.5 783.2 592.8 786.8 C
-582.4 775.7 571.4 752.7 549.7 746.5 C
-520.8 736.2 500.7 751.4 481.6 766.7 C
-440.4 802.3 416.7 847.7 366.8 868.5 C
-346.3 878.2 335.0 875.6 319.1 869.5 C
-300.3 862.7 292.8 850.7 279.2 833.8 C
-285.0 838.3 271.7 828.6 277.2 833.5 C
-268.5 845.8 244.2 875.3 220.8 881.1 C
-168.6 888.3 147.5 809.8 96.3 789.4 C
-83.3 784.8 72.0 776.7 61.2 781.6 C
-41.5 794.2 38.2 804.6 27.5 824.1 C
-2.2 764.7 L
-9.0 751.1 16.8 730.3 32.1 725.1 C
-45.0 720.3 55.1 721.6 68.1 727.1 C
-91.1 745.2 116.4 758.9 132.0 779.3 C
-140.1 789.4 146.5 797.5 157.6 808.5 C
-166.3 816.6 176.1 823.1 187.7 827.0 C
-219.2 813.0 240.6 789.7 259.1 759.5 C
-275.3 782.5 284.7 815.0 321.4 810.1 C
-373.9 801.4 405.0 751.7 443.6 715.1 C
-462.8 694.7 478.3 687.2 502.0 681.0 C
-f
-%%Trailer
-end
-showpage
+++ /dev/null
-%!PS-Adobe-2.0 EPSF-1.2
-%%Creator: Adobe Illustrator 88(TM) format generated by CorelTRACE Version 2.0C
-%%Title: /home/menja/c/larsi/gnus-head.eps
-%%BoundingBox: 0 0 430.6 312.5
-%%CreationDate: Sat Feb 3 13:06:12 1996
-%%DocumentFonts:
-%%ColorUsage: B & W
-%%TileBox: 0 0 430.6 312.5
-%%EndComments
-% Copyright 1992 Corel Corporation.
-
-% All rights reserved.
-/wPSMDict 150 dict def
-wPSMDict begin
-/bd {bind def} bind def
-/ld {load def} bd
-/xd {exch def} bd
-/_ null def
-/$c 0 def
-/$m 0 def
-/$y 0 def
-/$k 0 def
-/$t 1 def
-/$n _ def
-/$o 0 def
-/$C 0 def
-/$M 0 def
-/$Y 0 def
-/$K 0 def
-/$T 1 def
-/$N _ def
-/$O 0 def
-/$h false def
-/$al 0 def
-/$tr 0 def
-/$le 0 def
-/$lx 0 def
-/$ly 0 def
-/$ctm matrix currentmatrix def
-/@cp /closepath ld
-/@gs /gsave ld
-/@gr /grestore ld
-/@MN {2 copy le{pop}{exch pop}ifelse}bd
-/setcmykcolor where {pop}{/setcmykcolor{4 1 roll
-3 {3 index add 1 @MN 1 exch sub 3 1 roll} repeat
-setrgbcolor
-pop}bd}ifelse
-/@tc{dup 1 ge{pop}{4 {dup
-6 -1 roll
-mul
-exch}repeat
-pop}ifelse}bd
-/@scc{$c $m $y $k $t @tc setcmykcolor true}bd
-/@SCC{$C $M $Y $K $T @tc setcmykcolor true}bd
-/@sm{/$ctm $ctm currentmatrix def}bd
-/x {/$t xd /$n xd
-/$k xd /$y xd /$m xd /$c xd}bd
-/X {/$T xd /$N xd
-/$K xd /$Y xd /$M xd /$C xd}bd
-/g {1 exch sub 0 0 0
-4 -1 roll
-_ 1 x}bd
-/G {1 exch sub 0 0 0
-4 -1 roll
-_ 1 X}bd
-/k {_ 1 x}bd
-/K {_ 1 X}bd
-/d /setdash ld
-/i {dup 0 ne {setflat} {pop} ifelse}bd
-/j /setlinejoin ld
-/J /setlinecap ld
-/M /setmiterlimit ld
-/w /setlinewidth ld
-/O {/$o xd}bd
-/R {/$O xd}bd
-/c /curveto ld
-/C /c ld
-/l /lineto ld
-/L /l ld
-/m /moveto ld
-/n /newpath ld
-/N /newpath ld
-/F {@scc{eofill}if n} bd
-/f {@cp F}bd
-/S {@SCC{stroke}if n} bd
-/s {@cp
-S}bd
-/B {@gs F @gr
-S}bd
-/b {@cp B }bd
-/u {}bd
-/U {}bd
-%%EndProlog
-%%BeginSetup
-%%EndSetup
-1 i
-2 J
-0 j
-4 M
-[]0 d
-
-%%Note: traced as Normal_Outline
-0 g
-267.8 10.0 m
-291.8 50.8 294.2 95.0 278.8 136.8 C
-270.2 147.3 264.9 154.5 252.4 156.9 C
-227.0 119.5 L
-256.3 98.8 267.3 63.3 264.0 12.4 C
-264.4 10.5 265.9 9.1 265.9 9.1 C
-265.9 9.1 267.8 10.0 267.8 10.0 C
-f
-0 g
-79.2 40.3 m
-116.6 43.6 150.2 75.3 180.9 103.6 C
-197.2 121.4 204.0 133.4 217.9 150.7 C
-216.4 151.2 215.0 152.1 213.1 152.1 C
-178.0 128.6 147.3 81.1 102.2 86.8 C
-98.4 88.8 95.0 89.2 92.6 92.1 C
-87.3 120.4 126.2 159.8 141.1 182.8 C
-148.8 193.4 159.3 203.0 159.8 217.4 C
-131.0 190.0 98.8 140.6 71.5 90.7 C
-65.2 76.3 58.0 67.6 63.3 53.7 C
-68.6 45.1 70.5 43.2 79.2 40.3 C
-f
-0 g
-355.6 161.2 m
-376.3 159.3 388.3 171.8 404.6 184.3 C
-412.3 201.1 422.4 223.2 423.3 237.6 C
-416.6 234.2 410.8 229.4 405.1 217.4 C
-399.8 211.6 386.8 206.8 378.7 207.8 C
-334.0 206.4 308.1 288.4 252.4 297.1 C
-236.1 299.5 229.9 291.8 214.5 285.6 C
-203.0 270.2 L
-193.4 281.7 175.2 306.7 147.8 303.3 C
-115.2 279.8 101.2 238.5 57.6 230.8 C
-42.7 235.2 26.8 240.9 21.1 253.4 C
-19.6 257.7 19.6 260.1 16.8 262.5 C
-14.4 259.2 12.9 257.7 11.5 253.4 C
-20.1 231.8 12.4 207.8 31.6 190.5 C
-45.6 184.8 60.4 188.1 74.8 201.6 C
-103.6 220.3 113.2 256.3 142.5 259.2 C
-164.1 248.1 178.5 237.1 189.1 214.0 C
-208.8 241.9 L
-225.6 253.4 243.8 250.0 262.0 241.4 C
-294.2 215.0 325.9 167.5 355.6 161.2 C
-f
-%%Trailer
-end
-showpage
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X....X.E ",
-"E...X..X...E",
-"E...X..X...E",
-"E..........E",
-"E...XXXX...E",
-" E.X....X.E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-"..E EEEE E..",
-"E..E....E..E",
-" E........E ",
-" E.. .....E ",
-"E..XX..XX..E",
-"E..........E",
-"E.X......X.E",
-"E..X....X..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E.X......X.E",
-"E.XXXXXXXX.E",
-" E........E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..XXXXXX..E",
-"E..X....X..E",
-" E..X..X..E ",
-" E...XX...E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c #FFFFFF",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E.X......X.E",
-"E..XXXXXX..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E........X.E",
-"E...XXXXX..E",
-" E.X......E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X.XX.X.E ",
-"E...X..X...E",
-"E..X.XX.X..E",
-"E..........E",
-"E..........E",
-" E.XXXXXX.E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E........E ",
-"E..XX..XX..E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E..oooX..E ",
-" E...oo...E ",
-" EE.Xo.EE ",
-" EEEE .Xo.",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E.X....X.E ",
-" EX......XE ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E...XXXX...E",
-"E..X....X..E",
-" E.X....X.E ",
-" E..XXXX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXX...E",
-" E........E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E...XXXXX..E",
-" E....XXX.E ",
-" E....XX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E...o......E",
-"E..ooo.....E",
-" E.XXXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X.....E ",
-"E...X.XXX..E",
-"E..........E",
-"E.X......X.E",
-"E..XXXXXX..E",
-" E..XXXX..E ",
-" E........E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E..X..X..E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E.....XXX..E",
-" E..XX....E ",
-" E....XX..E ",
-" EE....EE ",
-" EEEE ....",
+++ /dev/null
-/* XPM */
-static char * image_name[] = {
-"12 12 5 1",
-" c none",
-". c #FFFF00 s flesh",
-"X c #000000000000 s features",
-"E c #000000000000 s circle",
-"o c #555555555555 s tongue",
-" EEEE ",
-" EE....EE ",
-" E........E ",
-" E.X....X.E ",
-"E...X..X...E",
-"E..........E",
-"E..........E",
-"E..XXXXX...E",
-" E..oooX..E ",
-" E...oo...E ",
-" EE.Xo.EE ",
-" EEEE .Xo.",
+++ /dev/null
-#define Face_ase_width 24
-#define Face_ase_height 16
-static char Face_ase_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0xf0,0xc0,0x03,
- 0x68,0xa1,0x05,
- 0x68,0xa1,0x05,
- 0x68,0xa1,0x05,
- 0xf0,0xc0,0x23,
- 0x00,0x00,0x20,
- 0x00,0x00,0x50,
- 0x50,0x40,0x52,
- 0x00,0x00,0x50,
- 0x20,0x91,0x20,
- 0x00,0x0e,0x00,
- 0x00,0x00,0x00};
+++ /dev/null
-#define Face_ase2_width 32
-#define Face_ase2_height 16
-static char Face_ase2_bits[] = {
- 0x00,0x00,0x00,0x00,
- 0xf0,0x83,0x1f,0x00,
- 0x08,0x44,0x20,0x00,
- 0x00,0x00,0x00,0x00,
- 0xe0,0x81,0x07,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xd0,0x42,0x0b,0x00,
- 0xe0,0x81,0x87,0x10,
- 0x00,0x00,0x80,0x10,
- 0x00,0x00,0x40,0x29,
- 0xa0,0x80,0x44,0x29,
- 0x00,0x00,0x40,0x29,
- 0x40,0x22,0x81,0x10,
- 0x00,0x1c,0x00,0x00,
- 0x00,0x00,0x00,0x00};
+++ /dev/null
-#define Face_ase3_width 24
-#define Face_ase3_height 16
-static char Face_ase3_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0x18,0x00,0x07,
- 0xe0,0xe0,0x00,
- 0xfc,0xf3,0x0f,
- 0xc0,0xe1,0x00,
- 0x38,0x00,0x27,
- 0x00,0x00,0x20,
- 0x00,0x00,0x50,
- 0x50,0x40,0x52,
- 0x00,0x00,0x50,
- 0x20,0x91,0x20,
- 0x00,0x0e,0x00,
- 0x00,0x00,0x00
-};
+++ /dev/null
-#define Face_smile_width 24
-#define Face_smile_height 16
-static char Face_smile_bits[] = {
- 0x00,0x00,0x00,
- 0xf8,0xc1,0x0f,
- 0x04,0x22,0x10,
- 0x00,0x00,0x00,
- 0xf0,0xc0,0x07,
- 0x68,0xa1,0x09,
- 0x68,0xa1,0x09,
- 0x68,0xa1,0x09,
- 0xf0,0xc0,0x07,
- 0x00,0x00,0x00,
- 0x00,0x00,0x00,
- 0x50,0x80,0x04,
- 0x00,0x00,0x00,
- 0x20,0x22,0x01,
- 0x00,0x1c,0x00,
- 0x00,0x00,0x00};
+++ /dev/null
-#define Face_weep_width 24
-#define Face_weep_height 16
-static char Face_weep_bits[] = {
- 0x1c,0x00,0x3c,
- 0xe2,0x80,0x43,
- 0x00,0x63,0x00,
- 0x18,0x00,0x18,
- 0x60,0x00,0x07,
- 0x80,0xe3,0x00,
- 0xfc,0xf7,0x3f,
- 0x80,0xe3,0x00,
- 0x60,0x00,0x07,
- 0x58,0x00,0x1a,
- 0x40,0x00,0x02,
- 0xa0,0x00,0x05,
- 0xa0,0x00,0x05,
- 0xa0,0x1c,0x05,
- 0x40,0x22,0x02,
- 0x00,0x00,0x00
-};
+++ /dev/null
-#!/bin/sh
-match='M-x |(Group)|(Summary)|(Article)|(Server)|(Browse)|(Post)|(Mail)|(Score)|(Binary)|(Topic)|(Pick)'
-fun='\{gnus-|\{nn.*-|\{grouplens-'
-egrep "$match" gnus.idx > gnus.kidx
-egrep "$fun" gnus.idx > gnus.gidx
-egrep -v "$match|$fun" gnus.idx > gnus.cidx
-
-# arch-tag: 2e32a8e5-4eae-46dd-a3d0-90f514ba27d7
+++ /dev/null
-;;; texi2latex.el --- convert a texi file into a LaTeX file.
-;; Copyright (C) 1996, 2004, 2008 Lars Magne Ingebrigtsen
-
-(require 'cl)
-
-(defun latexi-discard-until (string)
- (let ((beg (match-beginning 0)))
- (unless (re-search-forward (concat "^@end +" string "[ \t]*\n") nil t)
- (error "No end: %s" string))
- (delete-region beg (match-end 0))))
-
-(defun latexi-strip-line ()
- (delete-region (progn (beginning-of-line) (point))
- (progn (forward-line 1) (point))))
-
-(defun latexi-switch-line (command arg)
- (latexi-strip-line)
- (insert (format "\\%s{%s}\n" command arg)))
-
-(defun latexi-index-command (command arg)
- (latexi-strip-line)
- (insert (format "\\gnus%sindex{%s}\n"
- (if (equal command "kindex") "k" "")
- arg)))
-
-(defun latexi-begin-command (command)
- (latexi-strip-line)
- (insert (format "\\begin{%s}\n" command)))
-
-(defun latexi-exchange-command (command arg)
- (delete-region (match-beginning 0) (match-end 0))
- (insert (format "\\%s{%s}" command arg)))
-
-(defun latexi-translate ()
- "Translate."
- (interactive)
- (latexi-translate-file "gnus")
- (latexi-translate-file "gnus-faq")
- (latexi-translate-file "message" t)
- (latexi-translate-file "emacs-mime" t)
- (latexi-translate-file "sieve" t)
- (latexi-translate-file "pgg" t))
-
-(defun latexi-translate-file (file &optional as-a-chapter)
- "Translate file a LaTeX file."
- (let ((item-string "")
- (item-stack nil)
- (list-stack nil)
- (latexi-buffer (get-buffer-create "*LaTeXi*"))
- verbatim
- (regexp
- (concat
- "@\\([^{} \t\n]+\\)"
- "\\(\\( +\\(.*$\\)\\|[ \t]*$\\)\\|{\\([^}]*\\)}\\)"))
- (cur (find-file-noselect (concat (or (getenv "srcdir") ".")
- "/" file ".texi")))
- (times 3)
- (chapter 0)
- command arg)
- (pop-to-buffer latexi-buffer)
- (buffer-disable-undo)
- (erase-buffer)
- (insert-buffer-substring cur)
- (goto-char (point-min))
- (when (search-forward "@copying" nil t)
- (latexi-copying))
- (while (search-forward "@insertcopying" nil t)
- (delete-region (match-beginning 0) (match-end 0))
- (latexi-insertcopying))
- (goto-char (point-min))
- (latexi-strip-line)
- (latexi-translate-string "@'e" "\\'{e}")
- (latexi-translate-string "@`a" "\\`{a}")
- (latexi-translate-string "@,{c}" "\\c{c}")
- (latexi-translate-string "@aa{}" "{\\aa}")
- (latexi-translate-string "@\"{@dotless{i}}" "ï")
- (latexi-translate-string "%@{" "\\gnuspercent{}\\gnusbraceleft{}")
- (latexi-translate-string "%@}" "\\gnuspercent{}\\gnusbraceright{}")
- (latexi-translate-string "%1@{" "\\gnuspercent{}1\\gnusbraceright{}")
- (latexi-translate-string "@*" "\\newline{}")
- (latexi-translate-string "S@{" "S\\gnusbraceleft{}")
- (latexi-translate-string "@code{\\222}" "@code{\\gnusbackslash{}222}")
- (latexi-translate-string "@code{\\264}" "@code{\\gnusbackslash{}264}")
- (latexi-translate-string "@samp{\\Deleted}" "@samp{\\gnusbackslash{}Deleted}")
- (latexi-translate-string "@samp{\\Seen}" "@samp{\\gnusbackslash{}Seen}")
- (latexi-translate-string "@file{c:\\myhome}" "@file{c:\\gnusbackslash{}myhome}")
-; (while (re-search-forward "{\"[^\"]*\\(\\\\\\)[^\"]*\"}\\\\" nil t)
-; (replace-match "\\verb+\\\\+ " t t))
- (while (not (zerop (decf times)))
- (goto-char (point-min))
- (while (re-search-forward regexp nil t)
- (setq command (match-string 1))
- (if (match-beginning 3)
- (progn
- (setq arg (or (match-string 4) ""))
- (save-match-data
- (when (string-match "[ \t]+$" arg)
- (setq arg (substring arg 0 (match-beginning 0)))))
- (cond
- ((member command '("c" "comment"))
- (if (string-match "@icon" (or arg ""))
- (progn
- (beginning-of-line)
- (delete-region (point) (+ (point) 4))
- (insert "\\gnus"))
- (delete-region (match-beginning 0)
- (progn (end-of-line) (point))))
- (if (equal arg "@head")
- (insert "\\gnusinteresting")))
- ((member command '("setfilename" "set"
- "synindex" "setchapternewpage"
- "summarycontents" "bye"
- "top" "iftex" "cartouche"
- "iflatex" "finalout" "vskip"
- "dircategory" "group" "syncodeindex"
- "documentencoding"))
- (latexi-strip-line))
- ((member command '("menu" "tex" "ifinfo" "ignore"
- "ifnottex" "direntry"))
- (latexi-discard-until command))
- ((member command '("subsection" "subsubsection"))
- (if as-a-chapter
- (latexi-switch-line (format "sub%s" command) arg)
- (latexi-switch-line command arg)))
- ((member command '("heading"))
- (if as-a-chapter
- (latexi-switch-line "subsection*" arg)
- (latexi-switch-line "section*" arg)))
- ((member command '("subheading"))
- (if as-a-chapter
- (latexi-switch-line "subsubsection*" arg)
- (latexi-switch-line "subsection*" arg)))
- ((member command '("subsubheading"))
- (if as-a-chapter
- (latexi-switch-line "subsubsubsection*" arg)
- (latexi-switch-line "subsubsection*" arg)))
- ((member command '("chapter"))
- (if (string-match "Index" arg)
- (latexi-strip-line)
- (if as-a-chapter
- (latexi-switch-line "gnussection" arg)
- (latexi-switch-line
- (format
- "gnus%s{%s}" command
- (format "\\epsfig{figure=ps/new-herd-%d,scale=.5}"
- (if (> (incf chapter) 9) 9 chapter)))
- arg))))
- ((member command '("section"))
- (if as-a-chapter
- (latexi-switch-line "subsection" arg)
- (latexi-switch-line (format "gnus%s" command) arg)))
- ((member command '("cindex" "findex" "kindex" "vindex"))
- (latexi-index-command command arg))
- ((member command '("*"))
- (delete-char -2)
- (insert "\\\\"))
- ((equal command "sp")
- (replace-match "" t t))
- ((equal command ":")
- (replace-match "" t t))
- ((member command '("deffn" "defvar" "defun"))
- (replace-match "" t t))
- ((equal command "node")
- (latexi-strip-line)
- (unless (string-match "Index" arg)
- (insert (format "\\label{%s}\n" arg))))
- ((equal command "contents")
- (latexi-strip-line)
- ;;(insert (format "\\tableofcontents\n" arg))
- )
- ((member command '("titlepage"))
- (latexi-begin-command command))
- ((member command '("lisp" "example" "smallexample" "display"))
- (latexi-strip-line)
- (insert (format "\\begin{verbatim}\n"))
- (setq verbatim (point)))
- ((member command '("center"))
- (latexi-strip-line)
- (insert (format "\\begin{%s}%s\\end{%s}\n"
- command arg command)))
- ((member command '("end"))
- (cond
- ((member arg '("titlepage"))
- (latexi-strip-line)
- (insert (format "\\end{%s}\n" arg)))
- ((equal arg "quotation")
- (latexi-strip-line)
- (insert (format "\\end{verse}\n")))
- ((member arg '("lisp" "example" "smallexample" "display"))
- (latexi-strip-line)
- (save-excursion
- (save-restriction
- (narrow-to-region verbatim (point))
- (goto-char (point-min))
- (while (search-forward "@{" nil t)
- (replace-match "{" t t))
- (goto-char (point-min))
- (while (search-forward "@}" nil t)
- (replace-match "}" t t))))
- (setq verbatim nil)
- (insert "\\end{verbatim}\n"))
- ((member arg '("table"))
- (setq item-string (pop item-stack))
- (latexi-strip-line)
- (insert (format "\\end{%slist}\n" (pop list-stack))))
- ((member arg '("itemize" "enumerate"))
- (setq item-string (pop item-stack))
- (latexi-strip-line)
- (insert (format "\\end{%s}\n" arg)))
- ((member arg '("iflatex" "iftex" "cartouche" "group"))
- (latexi-strip-line))
- ((member arg '("deffn" "defvar" "defun"))
- (latexi-strip-line))
- (t
- (error "Unknown end arg: %s" arg))))
- ((member command '("table"))
- (push item-string item-stack)
- (push (substring arg 1) list-stack)
- (setq item-string
- (format "[@%s{%%s}]" (car list-stack)))
- (latexi-strip-line)
- (insert (format "\\begin{%slist}\n" (car list-stack))))
- ((member command '("itemize" "enumerate"))
- (push item-string item-stack)
- (cond
- ((member arg '("@bullet"))
- (setq item-string "[\\gnusbullet]"))
- (t
- (setq item-string "")))
- (latexi-strip-line)
- (insert (format "\\begin{%s}\n" command)))
- ((member command '("item"))
- (latexi-strip-line)
- (insert (format "\\%s%s\n" command (format item-string arg))))
- ((equal command "itemx")
- (latexi-strip-line)
- (insert (format "\\gnusitemx{%s}\n" (format item-string arg))))
- ((eq (aref command 0) ?@)
- (goto-char (match-beginning 0))
- (delete-char 2)
- (insert "duppat{}"))
- ((equal command "settitle")
- (latexi-strip-line)
- (if (not as-a-chapter)
- (insert
- (format "\\newcommand{\\gnustitlename}{%s}\n" arg))))
- ((equal command "title")
- (latexi-strip-line)
- (insert (format "\\gnustitlename{%s}\n" arg)))
- ((equal command "author")
- (latexi-strip-line)
- (insert (format "\\gnusauthor{%s}\n" arg)))
- ((equal command "quotation")
- (latexi-begin-command "verse"))
- ((equal command "page")
- (latexi-strip-line)
- (insert "\\newpage\n"))
- ((equal command "'s")
- (goto-char (match-beginning 0))
- (delete-char 1))
- ((equal command "include")
- (latexi-strip-line)
- (string-match "\\.texi" arg)
- (insert (format "\\input{%s.latexi}\n"
- (substring arg 0 (match-beginning 0)))))
- ((equal command "noindent")
- (latexi-strip-line)
- (insert "\\noindent\n"))
- ((equal command "printindex")
- (latexi-strip-line)
- ;;(insert
- ;; (format
- ;; "\\begin{theindex}\\input{gnus.%s}\\end{theindex}\n" arg))
- )
- (t
- (error "Unknown command (file %s line %d): %s"
- file
- (save-excursion
- (widen)
- (1+ (count-lines (point-min) (progn
- (beginning-of-line)
- (point)))))
- command))))
- ;; These are commands with {}.
- (setq arg (match-string 5))
- (cond
- ((member command '("anchor"))
- (latexi-strip-line))
- ((member command '("ref" "xref" "pxref"))
- (latexi-exchange-command (concat "gnus" command) arg))
- ((member command '("sc" "file" "dfn" "emph" "kbd" "key" "uref"
- "code" "samp" "var" "strong" "i"
- "result" "email" "env" "r" "command" "asis"
- "url"))
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert "\\gnus"))
- ((member command '("acronym"))
- (latexi-exchange-command (concat "gnus" command) (downcase arg)))
- ((member command '("copyright" "footnote" "TeX"))
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert "\\"))
- ((member command '("dots"))
- (goto-char (match-beginning 0))
- (delete-region (match-beginning 0) (match-end 0))
- (insert "..."))
- ((eq (aref command 0) ?@)
- (goto-char (match-beginning 0))
- (delete-char 2)
- (insert "duppat{}"))
- (t
- (error "Unknown command (file %s line %d): %s"
- file
- (save-excursion
- (widen)
- (1+ (count-lines (point-min) (progn
- (beginning-of-line)
- (point)))))
- command))))))
- (latexi-translate-string "$" "\\gnusdollar{}")
- (latexi-translate-string "&" "\\gnusampersand{}")
- (latexi-translate-string "%" "\\gnuspercent{}")
- (latexi-translate-string "#" "\\gnushash{}")
- (latexi-translate-string "^" "\\gnushat{}")
- (latexi-translate-string "~" "\\gnustilde{}")
- (latexi-translate-string "_" "\\gnusunderline{}")
- (latexi-translate-string "¬" "\\gnusnot{}")
- (goto-char (point-min))
- (while (search-forward "duppat{}" nil t)
- (replace-match "@" t t))
- (latexi-translate-string "@@" "@")
- (latexi-translate-string "<" "\\gnusless{}")
- (latexi-translate-string ">" "\\gnusgreater{}")
- (goto-char (point-min))
- (search-forward "label{Top}" nil t)
- (while (re-search-forward "\\\\[ntr]\\b" nil t)
- (when (save-match-data
- (or (not (save-excursion
- (search-backward "begin{verbatim}" nil t)))
- (> (save-excursion
- (search-backward "end{verbatim"))
- (save-excursion
- (search-backward "begin{verbatim}")))))
- (goto-char (match-beginning 0))
- (delete-char 1)
- (insert "\\gnusbackslash{}")))
- (latexi-translate-string "\\\\" "\\gnusbackslash{}")
- (goto-char (point-min))
- (while (re-search-forward "\\\\[][{}]" nil t)
- (goto-char (match-beginning 0))
- (delete-char 1))
- (latexi-contributors)
- (let ((coding-system-for-write 'iso-8859-1))
- (write-region (point-min) (point-max) (concat file ".latexi")))))
-
-(defun latexi-translate-string (in out)
- (let (yes)
- (goto-char (point-min))
- (search-forward "label{Top}" nil t)
- (while (search-forward in nil t)
- (when (save-match-data
- (or (not (save-excursion
- (search-backward "begin{verbatim}" nil t)))
- (> (save-excursion
- (re-search-backward "end{verbatim}\\|end{verse}"))
- (save-excursion
- (re-search-backward
- "begin{verbatim}\\|begin{verse}")))))
- (replace-match out t t)))))
-
-(defun latexi-contributors ()
- (goto-char (point-min))
- (when (re-search-forward "^Also thanks to the following" nil t)
- (forward-line 2)
- (narrow-to-region
- (point)
- (1- (search-forward "\n\n")))
- (when (re-search-backward "^and" nil t)
- (latexi-strip-line))
- (goto-char (point-min))
- (while (re-search-forward "[.,] *$" nil t)
- (replace-match "" t t))
- (goto-char (point-min))
- (let (names)
- (while (not (eobp))
- (push (buffer-substring (point) (progn (end-of-line) (point)))
- names)
- (forward-line 1))
- (delete-region (point-min) (point-max))
- (insert "\\begin{tabular}{lll}\n")
- (setq names (nreverse (delete "" names)))
- (while names
- (insert (pop names) " & " (or (pop names) "\\mbox{}")
- " & " (or (pop names) "\\mbox{}")
- "\\\\\n"))
- (insert "\\end{tabular}\n")
- (widen))))
-
-(defvar latexi-copying-text ""
- "Text of the copyright notice and copying permissions.")
-
-(defun latexi-copying ()
- "Copy the copyright notice and copying permissions from the Texinfo file,
-as indicated by the @copying ... @end copying command;
-insert the text with the @insertcopying command."
- (let ((beg (progn (beginning-of-line) (point)))
- (end (progn (re-search-forward "^@end copying[ \t]*\n") (point))))
- (setq latexi-copying-text
- (buffer-substring-no-properties
- (save-excursion (goto-char beg) (forward-line 1) (point))
- (save-excursion (goto-char end) (forward-line -1) (point))))
- (delete-region beg end)))
-
-(defun latexi-insertcopying ()
- "Insert the copyright notice and copying permissions from the Texinfo file,
-which are indicated by the @copying ... @end copying command."
- (insert (concat "\n" latexi-copying-text)))
-
-;;; arch-tag: 31e30f7f-4876-4dd1-ba3a-6f9f7ea0d256
+++ /dev/null
-;;; xml2texi.scm --- Convert gnus-faq.xml to gnus-faq.texi
-;; Copyright (C) 2005 Free Software Foundation, Inc.
-
-;; Author: Karl Pflästerer <sigurd@12move.de>
-;; Keywords: tools
-
-;; This file is not 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-;;
-
-;;; Code:
-
-(require (lib "ssax.ss" "ssax")
- (lib "sxpath.ss" "ssax")
- (lib "sxml-tree-trans.ss" "ssax")
- (lib "pregexp.ss")
- (lib "list.ss")
- (lib "etc.ss")
- (rename (lib "1.ss" "srfi") list-index list-index)
- (rename (lib "13.ss" "srfi") string-join string-join))
-
-
-;;; Constants
-;; In and out; for convenience if we work from the REPL
-(define +infile+ "gnus-faq.xml")
-(define +outfile+ "gnus-faq.texi")
-
-;; These are the names of the sections. These variables hold the names
-;; of the sections where numbering starts in the main menu.
-;; Where we start numbering in menu
-(define +first-numbered-section+ "Installation FAQ")
-;; Where we end numbering in menu
-(define +last-numbered-section+ "Tuning Gnus")
-
-;; Which sections not to include; i.e. not to name a node.
-(define +ignored-sections+ '("Frequently Asked Questions with Answers"))
-
-;; Names of menu entries and the corresponding descriptions (used in the
-;; main menu).
-(define +section-comments-alist+
- '(("Introduction" . "About Gnus and this FAQ.")
- ("Installation FAQ" . "Installation of Gnus.")
- ("Startup / Group buffer" . "Start up questions and the first buffer Gnus shows you.")
- ("Getting Messages" . "Making Gnus read your mail and news.")
- ("Reading messages" . "How to efficiently read messages.")
- ("Composing messages" . "Composing mails or Usenet postings.")
- ("Old messages" . "Importing, archiving, searching and deleting messages.")
- ("Gnus in a dial-up environment" . "Reading mail and news while offline.")
- ("Getting help" . "When this FAQ isn't enough.")
- ("Tuning Gnus" . "How to make Gnus faster.")
- ("Glossary" . "Terms used in the FAQ explained.")))
-
-;; Where to break descriptions in menus
-(define +width+ 72)
-
-;; The boilerplate text we include before the document
-(define boilerplate
- (lambda (titel)
- (format
- "\
-@c \\input texinfo @c -*-texinfo-*-~%\
-@c Uncomment 1st line before texing this file alone.~%\
-@c %**start of header~%\
-@c Copyright (C) 1995, 2001, 2002, 2003, 2004, 2005 Free Software Foundation, Inc.~%\
-@c~%\
-@c Do not modify this file, it was generated from gnus-faq.xml, available from~%\
-@c <URL:http://my.gnus.org/FAQ/>.~%\
-@c~%\
-@setfilename gnus-faq.info~%\
-@settitle ~A~%\
-@c %**end of header~%\
-@c~%\
-" titel)))
-
-;; Inserted right before the end of the file
-(define +tag-for-gnus-faq-texi+
- (format "\
-~%\
-@ignore~%\
-arch-\
-tag: 64dc5692-edb4-4848-a965-7aa0181acbb8~%\
-@end ignore~%\
-"))
-
-;;; Little Helpers
-;; (a b c) -> (1 2 3)
-(define (number-list start inc lst)
- (let loop ((lst lst) (lvl start) (acc '()))
- (if (null? lst)
- (reverse acc)
- (loop (cdr lst) (+ inc lvl) (cons lvl acc)))))
-
-;; Given an alist made of regexps and their replacements (key and value
-;; are in a proper list) returns a function which given a string
-;; replaces all occurences of the regexps (from left to right).
-;; ((re1 repl1) (re2 repl2)) -> str -> str
-(define make-reg-replacer
- (lambda (defalist)
- (let ((allreg (string-join (map car defalist) "|")))
- (lambda (str)
- (if (and (string? str) (pregexp-match allreg str))
- (let loop ((lst defalist) (str str))
- (if (null? lst)
- str
- (loop (cdr lst) (pregexp-replace* (caar lst) str (cadar lst)))))
- str)))))
-
-(define escape-texi
- (make-reg-replacer '(("@" "@@") ("{" "@{") ("}" "@}"))))
-
-(define normalize
- (compose escape-texi (make-reg-replacer `((,(format "~%\\s+") ,(format "~%"))))))
-
-(define normalize-example
- (compose escape-texi (make-reg-replacer '(("^\\s+|\\s+$" "")))))
-
-(define trim-ws (make-reg-replacer '(("^\\s+|\\s+$" ""))))
-
-(define filter-sect
- (lambda (lst)
- (filter (lambda (e) (not (member e +ignored-sections+))) lst)))
-
-;;;; Para
-(define format-para
- (lambda (list-of-entries)
- (format "~%~A~%" (trim-ws (apply string-append list-of-entries)))))
-
-;;;; Questions
-(define format-q-level
- (lambda (level)
- (apply format "[~A.~A]" (reverse level))))
-
-(define format-q-description
- (compose trim-ws (make-reg-replacer `((,(format "~%") " ")))))
-
-;;;; Building nodes
-;; curr-node up-node (list of nodes) (list of node names) ->
-;; ((curr-node curr-name) (next next-name) (prev prev-name) up)
-(define (find-prev-next-up curr up search-list name-list)
- (do ((lst search-list (cdr lst))
- (rlst name-list (cdr rlst))
- (prev up (car lst))
- (prevn up (car rlst)))
- ((or (null? lst) (equal? (car lst) curr))
- (values (cons curr (if (pair? rlst) (car rlst) curr))
- (if (and (pair? lst) (pair? (cdr lst))) ;next
- (cons (cadr lst) (cadr rlst))
- (cons "" ""))
- (cons prev prevn)
- up))))
-
-
-(define (format-node section title up lst-of-nodes lst-of-names)
- (if (member title +ignored-sections+)
- ()
- (call-with-values
- (lambda () (find-prev-next-up title up lst-of-nodes lst-of-names))
- (lambda (currn prevn nextn up)
- (format "~%@node ~A~%~A ~A~%"
- (cdr currn) ;; (cdr prevn) (cdr nextn) up
- section ;; @subsection etc.
- (if (pair? title)
- (apply format "~A.~A" (reverse title))
- title))))))
-
-;;;; Building menus
-
-(define format-menu
- (lambda (alist-of-entries)
- (let ((len (apply max (map (lambda (s) (string-length (car s))) alist-of-entries))))
- (format "~%@menu~%~A@end menu~%"
- (apply string-append
- (map (lambda (e)
- (format "* ~A::~A~A~%"
- (car e) ;the entry
- (make-string (- len (string-length (car e)) -3) #\ )
- (format-menu-description (cdr e) +width+ (+ len 7))))
- alist-of-entries))))))
-
-
-(define format-menu-description
- (lambda (entry width offset)
- (let loop ((lst (pregexp-split "\\s" entry)) (len 0) (acc '()))
- (if (null? lst)
- (apply string-append (reverse! acc))
- (let ((slen (+ 1 (string-length (car lst))))) ; +1 because of whitespace added later
- (if (> (+ slen len) (- width offset))
- (loop (cdr lst) 0 (cons
- (format "~%~A ~A" ; start a new line
- (make-string offset #\ ) ; the whitespace
- (car lst))
- acc))
- (loop (cdr lst) (+ slen len) (cons (format " ~A"(car lst)) acc))))))))
-
-
-(define format-sub-titles
- (lambda (list-of-entries first-number-entry last-number-entry)
- (let ((offset (or (list-index (lambda (e) (equal? e first-number-entry)) list-of-entries) 0))
- (end (or (list-index (lambda (e) (equal? e last-number-entry)) list-of-entries)
- (length list-of-entries))))
- (map (lambda (entry ind)
- (format "FAQ ~A ~A"
- (if (<= offset ind end)
- (format "~A -" (- ind offset -1)) ;numbered entry
- "-")
- entry))
- list-of-entries (number-list 0 1 list-of-entries)))))
-
-;;;; We number some sections first
-
-;; ntags is an alist => ((tag startcounter increment)
-(define (number-nodes tree level ntags)
- (if (null? ntags)
- tree
- (let* ((vals (car ntags))
- (ntag (car vals))
- (start (second vals))
- (inc (third vals))
- (ntags (cdr ntags)))
-
- (map
- (lambda (node sublevel)
- (pre-post-order
- node
- `((,ntag *preorder*
- . ,(lambda (tag . entry)
- `(,tag ,(cons sublevel level)
- ,@(number-nodes entry (cons sublevel level) ntags))))
- (*default* . ,(lambda x x))
- (*text* . ,(lambda (tag s) s)))))
- tree (number-list start inc tree)))))
-
-
-;;(transform->numbered faqsxml '(section article qandaset ((qandadiv 1 1) (qandaentry 0 1))))
-(define transform->numbered
- (lambda (sxml rules)
- (let* ((rules (reverse rules))
- (rule (car rules))
- (ntag (cadr rules))
- (styles (map (lambda (tag) (cons tag (lambda x x))) (list-tail rules 2))))
- (pre-post-order
- sxml
- `((*default* *preorder* . ,(lambda x x))
- (*TOP* . ,(lambda x x))
- ,@styles
- (,ntag *preorder*
- . ,(lambda (tag . nodes)
- (cons tag (number-nodes nodes '() rule)))))))))
-
-
-;;;; The main transform function
-
-(define (transform sxml)
- (let* ((sxml (transform->numbered
- sxml '(section article qandaset ((qandadiv 1 1) (qandaentry 0 1)))))
- (qandadivtitles (filter-sect (map second ((sxpath '(// qandadiv title)) sxml))))
- (fqandadivtitles (format-sub-titles qandadivtitles "" ""))
- (subtitles (filter-sect (append (map second ((sxpath '(// section title)) sxml))
- qandadivtitles
- (map second ((sxpath '(// glossary title)) sxml)))))
- (fsubtitles (format-sub-titles subtitles +first-numbered-section+
- +last-numbered-section+))
- (questlevel (map second ((sxpath '(article section qandaset qandadiv qandaentry)) sxml)))
- (up1 (cadar ((sxpath '(article articleinfo title)) sxml)))
-
-;;; ************************************************************
-;;; The Style Sheet
-;;; ************************************************************
- (style-sheet
- `(
-;;; ************************************************************
-;;; First the SXML special markers
-;;; ************************************************************
- ;; *TOP* *PI* @ are markers from SXML
- (*TOP* . ,(lambda (tag . x) x))
- (*PI* . ,(lambda _ '()))
- (@ . ,(lambda _ ""))
-
- ;; Look for the example rule where we overwrite the *text* rule
- ;; so code doesn't get mangled.
- (*text*
- . ,(lambda (tag string)
- (normalize string)))
- ;; If nothing else matches
- (*default* . ,(lambda x x))
-;;; ************************************************************
-;;; Now to the tags of our FAQ
-;;; ************************************************************
- (article . ,(lambda (tag . sects)
- (list (boilerplate up1) sects
- +tag-for-gnus-faq-texi+)))
-
- (articleinfo
- ((*default* . ,(lambda _ '()))
- (title
- . ,(lambda (tag titel)
- (let ((menucom (map (lambda (entry)
- (let ((e (assoc entry +section-comments-alist+)))
- (if e (cdr e) "")))
- subtitles)))
- (list (format-node '@section titel "" '() '())
- (format-menu (map cons fsubtitles menucom)))))))
- . ,(lambda (tag . info) info))
-
- ;; Sections
- (abstract
- . ,(lambda (tag . text)
- (cons (format "~%@subheading Abstract~%") text)))
- (section
- ((title
- . ,(lambda (tag titel)
- (format-node '@subheading titel up1 subtitles fsubtitles))))
- . ,(lambda (tag . entry) entry))
-
- ;; Q&A well it's called FAQ isn't it?
- (qandaset . ,(lambda (tag . x) x))
- (qandadiv
- ((title
- . ,(lambda (tag titel) titel)))
- . ,(lambda (tag level titel . entries)
- (let ((questions (map cadr entries))
- (nlevel (filter (lambda (lvl) (eq? (car level) (cadr lvl))) questlevel)))
- (list*
- (format-node '@subsection titel up1 subtitles fsubtitles)
- (format-menu (map (lambda (lvl quest)
- (cons (format-q-level lvl)
- (format-q-description quest)))
- nlevel questions))
- entries))))
- (qandaentry
- . ,(lambda (tag level question answer)
- (let ((nodes
- (filter (lambda (lvl) (eq? (cadr lvl) (cadr level))) questlevel))
- (up (list-ref fqandadivtitles (- (cadr level) 1))))
- (list*
- (format-node "@subsubheading Question" level up nodes (map format-q-level nodes))
- question answer))))
- (question . ,(lambda (tag quest) quest))
- (answer
- . ,(lambda (tag . answ) (list* (format "~%@subsubheading Answer~%") answ)))
-
- ;; Para
- (para . ,(lambda (tag . x) (format-para x)))
- (simpara . ,(lambda (tag . x) (cons (format "~%") x)))
-
- ;; Itemized lists.
- ;; We rewrite para here because it plays here the role of an
- ;; item marker
- (itemizedlist
- . ,(lambda (tag lstitem)
- (format "~%@itemize @bullet~%~A@end itemize~%" lstitem)))
- (listitem
- ((para
- . ,(lambda (tag item)
- (format "~%@item~%~A~%" (trim-ws item)))))
- . ,(lambda (tag . x) (string-join x "")))
-
- ;; The glossary.
- (glossary
- ((title . ,(lambda _'())))
- . ,(lambda (tag . terms)
- (let ((titel (cadar ((sxpath '(article glossary title)) sxml))))
- (cons (format-node '@subsection titel up1 subtitles fsubtitles)
- (list (format "~%@table @dfn~%")
- terms
- (format "~%@end table~%"))))))
- (glossentry . ,(lambda (tag . entry) entry))
- (glossterm
- . ,(lambda (tag term)
- (format "~%@item ~A" term)))
- (glossdef
- . ,(lambda (tag def) def))
-
- ;; Lisp examples
- ;; We rewrite the *text* rule so code stays the way it's writen.
- (programlisting
- ((*text*
- . ,(lambda (tag exampl)
- (normalize-example exampl))))
- . ,(lambda (tag . exampl)
- (format "~%@example~%~A~%@end example~%@noindent~%" (string-join exampl ""))))
-
- ;; The link handling
- ;; Here we are interested in the attributes, so we rewrite the @
- ;; rule. If we find a value we look if it's an email or http
- ;; uri.
- (ulink
- ((@
- . ,(lambda (at val) val)))
- . ,(lambda (tag uri name)
- (if (pregexp-match "^http:|^ftp:" uri)
- (if (equal? uri name)
- (format "@uref{~A}" uri)
- (format "@uref{~A, ~A}" uri name))
- (format "@email{~A, ~A}" (substring uri 7) name))))
- (url
- . ,(lambda (tag val) val))
-
- ;; userinput
- (userinput
- . ,(lambda (tag val)
- (format "@samp{~A}" val)))
- )))
- (pre-post-order sxml style-sheet)))
-
-;;;; We call main with infile and outfile as arguments
-(define main
- (lambda (in out)
- (with-output-to-file out
- (lambda ()
- (call-with-input-file in
- (lambda (port)
- (SRV:send-reply (transform (ssax:xml->sxml port '()))))))
- 'replace)))
-
-;; Local Variables:
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: cdd948f7-def9-4ea1-b5ae-b57c308097d7
-;;; xml2texi.scm ends here
+++ /dev/null
-#! /bin/sh
-#|
-exec mzscheme -mr $0 ${1+"$@"}
-|#
-;; Copyright (C) 2005 Free Software Foundation, Inc.
-;;
-;; Author: Karl Pflästerer <sigurd@12move.de>
-;; Keywords: tools
-;;
-;; This file is not 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 3, 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-;;
-;; Requirements:
-;;
-;; To run this scheme program you need MzScheme and DrScheme.
-;;
-;; Some URLs:
-;; http://www.plt-scheme.org/software/mzscheme/
-;; http://www.drscheme.org/
-;; http://www.plt-scheme.org/software/
-;;
-;; ,----[ http://www.plt-scheme.org/license/ ]
-;; | PLT software is distributed under the
-;; | GNU Lesser General Public License (LGPL).
-;; `----
-
-;;; Code:
-
-(require (lib "cmdline.ss"))
-(define +scmfile+ "xml2texi.scm")
-(define +in+ "gnus-faq.xml")
-(define +out+ "gnus-faq.texi")
-
-(command-line
- "xml2texi"
- (current-command-line-arguments)
- (once-each
- (("-i" "--input") in "Name of XML data file (default gnus-faq.xml)"
- (set! +in+ in))
- (("-o" "--output") out "Name of output file (default gnus-faq.texi)"
- (set! +out+ out))
- (("-l" "--library") lib "Name of Scheme library to load (default xml2texi.scm)"
- (set! +scmfile+ lib)))
- (help-labels "The first (or only) remaining argument is used as the name of the Input file"
- "The second argument is used as the name of the Output file")
- (args infile+outfile
- (cond ((= (length infile+outfile) 2)
- (set! +in+ (car infile+outfile))
- (set! +out+ (cadr infile+outfile)))
- ((= (length infile+outfile) 1)
- (set! +in+ (car infile+outfile)))
- (else #f))))
-
-(load +scmfile+)
-(main +in+ +out+)
-
-;; Local Variables:
-;; mode: scheme
-;; coding: iso-8859-1
-;; End:
-
-;; arch-tag: 582279c5-b7bf-44b0-ba09-d243a7d7f6e0
+++ /dev/null
--*- mode: text; left-margin: 2; fill-column: 70; -*-
-
- Liece is mainly written by Daiki Ueno <ueno@unixuser.org>.
-
- This package based on Irchat (version 3.01) which has been
- distributed under GPL1 or later.
-
- Original author of Irchat is Tor Lillqvist <tml@hemuli.atk.vtt.fi>
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 59 Temple Place - Suite 330, Boston, MA
- 02111-1307, USA.
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-\f
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-\f
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-\f
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-\f
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-\f
- Appendix: How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) 19yy <name of author>
-
- This program 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 of the License, or
- (at your option) any later version.
-
- This program 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 this program; if not, write to the Free Software
- Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) 19yy name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * dcc/.cvsignore: Remove.
- * doc/.cvsignore: Remove.
- * etc/.cvsignore: Remove.
- * etc/po/.cvsignore: Remove.
- * lisp/.cvsignore: Remove.
- * .hgignore: New file.
-
-2007-09-04 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2005-10-12 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2005-05-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2004-01-17 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.13 released.
-
-2003-04-22 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.12 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Only list liece-setup.el.
-
-2003-03-27 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.11 released.
-
-2003-03-26 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (PRELOADS): Don't load liece-channel because it needs
- liece-setup and at this point liece-setup doesn't exist.
- (lisp/liece-setup.el): Use $BOOT_XEMACS instead of $XEMACS so we
- don't pick up installed libraries.
-
-2003-03-25 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Add auto-autoloads.el and
- custom-load.el.
-
-2003-03-21 Ben Wing <ben@xemacs.org>
-
- * doc\.cvsignore: Add entries for liece*.html.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile (NO_BUILD_ELC_DEPENDENCIES): New.
- * Makefile (package):
- Delete explicit compile:: and binkit: rules.
- Don't add custom-load.elc to the list of generated elc's.
- Use EXPLICIT_DOCS instead of explicitly giving the targets
- and dependencies.
- Add liece-setup to EARLY_GENERATED_LISP, not GENERATED.
- Update AUTHOR_VERSION to 1.4.9.
- Delete recursive html target.
- Add definition of EMACS when recursively building `package'.
- Use EXTRA_DEPENDENCIES for liece.mo.
- Include Local.rules.inc at the beginning for access to
- MSGFMT and use it instead of hard-coded `msgfmt'.
- Don't build liece.mo if no MSGFMT available.
- Bring up rule for liece-setup.el from lisp/Makefile.lisp.
- Don't use special compilation script anymore (and delete the
- packages: rule that did this); do it the standard
- way. Add PRELOADS to make this possible.
- #### Bogus bogus bogus that liece still has its own
- autoload script. Just s/;;;###liece-autoloads/;;;###autoloads/
- and do it like everyone else!
- * doc/Makefile: Deleted.
- * lisp/Makefile.lisp: Deleted.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
- * Makefile (FLAGS): Use new $(BATCH).
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2002-10-14 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (MANUAL): Removed (unused).
-
-2002-10-15 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.10 released.
-
-2002-10-14 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.09 released.
-
-2002-10-12 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (EXTRA_OBJS): New, add etc/po/liece.mo (for make clean).
- * etc/po/.cvsignore: New, add *.mo.
-
-2002-09-25 Rendhalver [Peter Brown] <rendhalver@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.08 released.
-
-2002-09-19 Adrian Aichner <adrian@xemacs.org>
-
- * doc/Makefile: New file to generate html documentation.
-
-2002-09-19 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (html): New.
-
-2002-07-14 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.07 released.
-
-2002-06-27 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.06 released.
-
-2002-06-08 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.05 released.
-
-2002-05-14 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.04 released.
-
-2002-04-24 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.03 released.
-
-2002-04-08 Daiki Ueno <daiki@xemacs.org>
-
- * Makefile: Add an empty rule to hint `lisp/liece-setup.elc' is
- dependent on `lisp/liece-setup.el'.
-
-2002-03-27 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.02 released.
-
-2002-03-27 Daiki Ueno <daiki@xemacs.org>
-
- * Makefile (GENERATED): Add `lisp/liece-setup.elc'.
-
-2002-03-25 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): 1.01 released.
-
-2002-03-25 Daiki Ueno <daiki@xemacs.org>
-
- * Makefile (REQUIRES): Add fsf-compat and xemacs-base.
- * Makefile (MULE_ELCS): Removed.
- * Makefile (FLAGS): New.
- * Makefile: Export both $(XEMACS) and $(FLAGS).
-
-2002-03-24 Daiki Ueno <daiki@xemacs.org>
-
- * INSTALL: Don't require FLIM.
-
-2002-03-22 Daiki Ueno <daiki@xemacs.org>
-
- * Makefile: Created.
- * package-info.in: Created.
-
+++ /dev/null
--*- mode: text; left-margin: 2; fill-column: 70; -*-
-
- This program is in very early developing stage. Please use at your
- own risk.
-
-* Requirements
-
- Liece works under following environment at least.
-
- - Emacs 20.7
- - XEmacs 21.1 or later
-
- This package uses following libraries.
-
- - APEL 10.2 or later (stands for - "A Portable Emacs Library")
- ftp://ftp.m17n.org/pub/mule/apel/
-
-* Quick installation
-
- (Install APEL, then)
- % ./configure
- % make
- % su
- Password:
- # make install
-
- If you are not able to become super-user, you may specify local
- directory to install.
-
- % ./configure --prefix=~/ --with-lispdir=~/elisp
-
-* Configuration and running
-
-** Setting up your ~/.emacs
-
- If you are using Emacs 20.7, prepare `subdirs.el' with following
- contents, Emacs will find and append each substantial directory to
- `load-path' automagically.
-
- ex:
- (normal-top-level-add-subdirs-to-load-path)
-
- If you have never been using liece and/or its variants,
- add an autoload setting into your `~/.emacs'.
-
- ex:
- (autoload 'liece "liece" nil t)
-
- If you are using Emacs 20.7 and have never run Liece, run
- `etc/gnu-emacs-user-config' to prepare initial settings.
-
-* Optional packages
-
- Following packages are optional. If install script of this package
- found them, it would use various functionality provided by them.
-
- custom
- http://www.dina.kvl.dk/~abraham/custom/
-
- X-Face utility
- ftp://ftp.jpl.org/pub/elisp/
-
- bitmap-mule
- ftp://ftp.jpl.org/pub/elisp/bitmap/ (for GNU Emacs only)
+++ /dev/null
-# Makefile for Liece lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# This XEmacs package contains independent single file lisp packages
-
-VERSION = 1.18
-AUTHOR_VERSION = 1.4.9
-MAINTAINER = Daiki Ueno <ueno@unixuser.org>
-PACKAGE = liece
-PKG_TYPE = regular
-REQUIRES = apel mail-lib fsf-compat xemacs-base
-CATEGORY = standard
-
-include ../../Local.rules.inc
-
-ELCS = lisp/liece-xemacs.elc lisp/gettext.elc lisp/liece-clfns.elc \
- lisp/liece-handler.elc lisp/liece-compat.elc lisp/liece-version.elc \
- lisp/liece-vars.elc lisp/liece-globals.elc lisp/liece-inlines.elc \
- lisp/liece-filter.elc lisp/liece-coding.elc lisp/liece-dcc.elc \
- lisp/liece-menu.elc lisp/liece-000.elc lisp/liece-200.elc \
- lisp/liece-300.elc lisp/liece-400.elc lisp/liece-500.elc \
- lisp/liece-nick.elc lisp/liece-channel.elc lisp/liece-commands.elc \
- lisp/liece-ctcp.elc lisp/liece-q-el.elc lisp/liece-message.elc \
- lisp/liece-handle.elc lisp/liece-hilit.elc lisp/liece-intl.elc \
- lisp/liece-mail.elc lisp/liece-minibuf.elc lisp/liece-misc.elc \
- lisp/liece-tcp.elc lisp/liece-url.elc lisp/liece-x-face.elc \
- lisp/liece-window.elc lisp/liece.elc
-
-# MULE_ELCS = lisp/liece-q-ccl.elc
-
-DATA_1_FILES = $(wildcard etc/icons/*.xpm)
-DATA_1_DEST = $(PACKAGE)/icons
-
-DATA_2_FILES = etc/styles/top etc/styles/middle etc/styles/bottom
-DATA_2_DEST = $(PACKAGE)/styles
-
-ifneq ($(MSGFMT),)
-DATA_3_FILES = etc/po/liece.mo
-DATA_3_DEST = $(PACKAGE)/locale/ja/LC_MESSAGES
-
-EXTRA_DEPENDENCIES = etc/po/liece.mo
-endif
-
-AUTOLOAD_PATH = lisp
-
-EXPLICIT_DOCS = doc/liece.texi
-
-EARLY_GENERATED_LISP += $(AUTOLOAD_PATH)/liece-setup.el
-
-
-PRELOADS = -eval \("push \"./lisp\" load-path"\) \
- -l liece-globals -l liece-vars
-
-include ../../XEmacs.rules
-
-lisp/liece-setup.el: $(ELCS:.elc=.el)
- cd lisp && $(BOOT_XEMACS) -l liece-make -f autoload-liece \
- liece-setup- .
-
-etc/po/liece.mo: etc/po/ja.po
- (cd etc/po; $(MSGFMT) -o liece.mo ja.po)
+++ /dev/null
-SUBDIRS = lisp doc dcc etc
-
-install-package package:
- list='$(SUBDIRS)'; for subdir in $$list; do \
- (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $@) \
- done
+++ /dev/null
--*- mode: text; left-margin: 2; fill-column: 70; -*-
-
-* Directory tree
-
- This package contains following directories:
-
- lisp/ - Emacs Lisp files.
-
- dcc/ - DCC external program source.
-
- doc/ - Documentation, info files, sample configuration, etc.
-
- etc/ - Miscellaneous files which decorate this program.
-
- Please read documentation under `doc' directory.
-
-* Bug reports
-
- If you write bug reports and/or suggestions for improvement,
- please send them to the Liece Mailing List.
- This mailing list is also for other general discussions (about
- future enhancements, customization, etc). To join the Liece ML,
- send an e-mail to:
-
- liece-ctl@unixuser.org
-
- with the message body,
-
- subscribe Your Name
-
-* CVS
-
- Development of Liece uses CVS, Concurrent Versions System.
- Latest developing version is available at CVS.
-
-(0) logging in to anonymous CVS server.
-
- % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login
-
- CVS password: [CR] # NULL string
-
-(1) checkout modules
-
- % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root checkout liece
-
- Specify revision tag in front of the module name.
-
-(2) bootstrapping
-
- % cd liece
- % ./bootstrap
+++ /dev/null
-AC_DEFUN(AC_DEFINE_GNUS_PRODUCT_NAME,
- [echo $ac_n "defining gnus product name... $ac_c"
- AC_CACHE_VAL(EMACS_cv_GNUS_PRODUCT_NAME,[EMACS_cv_GNUS_PRODUCT_NAME=$1])
- GNUS_PRODUCT_NAME=${EMACS_cv_GNUS_PRODUCT_NAME}
- AC_MSG_RESULT(${GNUS_PRODUCT_NAME})
- AC_SUBST(GNUS_PRODUCT_NAME)])
-
-AC_DEFUN(AC_CHECK_EMACS,
- [dnl Check for Emacsen.
-
- dnl Apparently, if you run a shell window in Emacs, it sets the EMACS
- dnl environment variable to 't'. Lets undo the damage.
- test "$EMACS" = t && EMACS=
-
- dnl Ignore cache.
- unset ac_cv_prog_EMACS; unset ac_cv_prog_XEMACS;
-
- AC_ARG_WITH(emacs,
- [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...]],
- [if test "$withval" = yes -o -z "$withval"; then
- AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs)
- else
- AC_CHECK_PROG(EMACS, $withval, $withval, emacs)
- fi])
- AC_ARG_WITH(xemacs,
- [ --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]],
- [if test "$withval" = yes -o -z "$withval"; then
- AC_CHECK_PROG(XEMACS, xemacs, xemacs, xemacs)
- else
- AC_CHECK_PROG(XEMACS, $withval, $withval, xemacs)
- fi
- EMACS=$XEMACS],
- [XEMACS=xemacs
- test -z "$EMACS" && AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs)])
- AC_SUBST(EMACS)
- AC_SUBST(XEMACS)])
-
-AC_DEFUN(AC_EMACS_LISP, [
-elisp="$2"
-if test -z "$3"; then
- AC_MSG_CHECKING(for $1)
-fi
-AC_CACHE_VAL(EMACS_cv_SYS_$1,[
- OUTPUT=./conftest-$$
- echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1
- eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1
- retval=`cat ${OUTPUT}`
- echo "=> ${retval}" >& AC_FD_CC 2>&1
- rm -f ${OUTPUT}
- EMACS_cv_SYS_$1=$retval
-])
-$1=${EMACS_cv_SYS_$1}
-if test -z "$3"; then
- AC_MSG_RESULT($$1)
-fi
-])
-
-AC_DEFUN(AC_CHECK_EMACS_FLAVOR,
- [AC_MSG_CHECKING([what a flavor does $EMACS have])
-
- dnl Ignore cache.
- unset EMACS_cv_SYS_flavor;
-
- AC_EMACS_LISP(flavor,
- (cond ((featurep (quote xemacs)) \"XEmacs\")\
- ((boundp (quote MULE)) \"MULE\")\
- (t \"FSF Emacs\")),
- "noecho")
- case $EMACS_cv_SYS_flavor in
- XEmacs)
- EMACS_FLAVOR=xemacs;;
- MULE)
- EMACS_FLAVOR=mule;;
- *)
- EMACS_FLAVOR=emacs;;
- esac
- AC_MSG_RESULT($EMACS_cv_SYS_flavor)])
-
-AC_DEFUN(AC_PATH_LISPDIR, [
- AC_CHECK_EMACS_FLAVOR
- if test "$prefix" = NONE; then
- AC_MSG_CHECKING([prefix for your Emacs])
- AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),"noecho")
- prefix=${EMACS_cv_SYS_prefix}
- AC_MSG_RESULT($prefix)
- fi
- AC_ARG_WITH(lispdir,
- [ --with-lispdir=DIR Where to install lisp files
- (for XEmacs package, use --with-packagedir instead)],
- lispdir=${withval})
- AC_MSG_CHECKING([where lisp files should go])
- if test -z "$lispdir"; then
- dnl Set default value
- theprefix=$prefix
- if test "$theprefix" = NONE; then
- theprefix=$ac_default_prefix
- fi
- lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}"
- for thedir in share lib; do
- potential=
- if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then
- lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}"
- break
- fi
- done
- fi
- if test ${EMACS_FLAVOR} = xemacs; then
- AC_MSG_RESULT([$lispdir
- (it will be ignored when \"make install-package[[-ja]]\" is done)])
- else
- AC_MSG_RESULT([$lispdir])
- fi
- AC_SUBST(lispdir)
-])
-
-AC_DEFUN(AC_PATH_ETCDIR, [
- AC_ARG_WITH(etcdir,[ --with-etcdir=DIR Where to install etc files], etcdir=${withval})
- AC_MSG_CHECKING([where etc files should go])
- if test -z "$etcdir"; then
- dnl Set default value
- etcdir="\$(lispdir)/../etc"
- fi
- AC_MSG_RESULT($etcdir)
- AC_SUBST(etcdir)
-])
-
-dnl
-dnl Check whether a function exists in a library
-dnl All '_' characters in the first argument are converted to '-'
-dnl
-AC_DEFUN(AC_EMACS_CHECK_LIB, [
-if test -z "$3"; then
- AC_MSG_CHECKING(for $2 in $1)
-fi
-library=`echo $1 | tr _ -`
-AC_EMACS_LISP($1,(progn (fmakunbound (quote $2)) (condition-case nil (progn (require (quote $library)) (fboundp (quote $2))) (error (prog1 nil (message \"$library not found\"))))),"noecho")
-if test "${EMACS_cv_SYS_$1}" = nil; then
- EMACS_cv_SYS_$1=no
-fi
-if test "${EMACS_cv_SYS_$1}" = t; then
- EMACS_cv_SYS_$1=yes
-fi
-HAVE_$1=${EMACS_cv_SYS_$1}
-AC_SUBST(HAVE_$1)
-if test -z "$3"; then
- AC_MSG_RESULT($HAVE_$1)
-fi
-])
-
-dnl
-dnl Perform sanity checking and try to locate the W3 package
-dnl
-AC_DEFUN(AC_CHECK_W3, [
-AC_MSG_CHECKING(for acceptable W3 version)
-
-dnl Ignore cache.
-unset EMACS_cv_ACCEPTABLE_W3;
-unset EMACS_cv_SYS_w3_dir;
-unset EMACS_cv_SYS_w3_forms;
-
-AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_W3,[
-AC_EMACS_CHECK_LIB(w3_forms, w3-form-encode-xwfu,"noecho")
-if test "${HAVE_w3_forms}" = yes; then
- EMACS_cv_ACCEPTABLE_W3=yes
-else
- EMACS_cv_ACCEPTABLE_W3=
-fi
-
-if test "${EMACS_cv_ACCEPTABLE_W3}" = yes; then
- AC_EMACS_LISP(w3_dir,(file-name-directory (locate-library \"w3-forms\")),"noecho")
- EMACS_cv_ACCEPTABLE_W3=$EMACS_cv_SYS_w3_dir
-fi
-])
- AC_ARG_WITH(w3,[ --with-w3=DIR Specify where to find the w3 package], [ EMACS_cv_ACCEPTABLE_W3=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ])
- W3=${EMACS_cv_ACCEPTABLE_W3}
- AC_SUBST(W3)
- if test -z "${EMACS_cv_ACCEPTABLE_W3}"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT(${W3})
- fi
-])
-
-dnl
-dnl Perform sanity checking and try to locate the W3 package
-dnl
-AC_DEFUN(AC_CHECK_URL, [
-AC_MSG_CHECKING(for acceptable URL version)
-
-dnl Ignore cache.
-unset EMACS_cv_ACCEPTABLE_URL;
-unset EMACS_cv_SYS_url_dir;
-unset EMACS_cv_SYS_url;
-
-AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_URL,[
-AC_EMACS_CHECK_LIB(url, url-retrieve, "noecho")
-if test "${HAVE_url}" = yes; then
- EMACS_cv_ACCEPTABLE_URL=yes
-else
- EMACS_cv_ACCEPTABLE_URL=
-fi
-
-if test "${EMACS_cv_ACCEPTABLE_URL}" = yes; then
- AC_EMACS_LISP(url_dir,(file-name-directory (locate-library \"url\")),"noecho")
- EMACS_cv_ACCEPTABLE_URL=$EMACS_cv_SYS_url_dir
-fi
-])
- AC_ARG_WITH(url,[ --with-url=DIR Specify where to find the url package], [ EMACS_cv_ACCEPTABLE_URL=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ])
- URL=${EMACS_cv_ACCEPTABLE_URL}
- AC_SUBST(URL)
- if test -z "${EMACS_cv_ACCEPTABLE_URL}"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT("${URL}")
- fi
-])
-
-dnl
-dnl Perform checking available fonts: Adobe Bembo, Adobe Futura and
-dnl Bitstream Courier.
-dnl
-
-AC_DEFUN(GNUS_CHECK_FONTS, [
-test "$LATEX" = t && LATEX=
-test "$LATEX" || AC_PATH_PROGS(LATEX, latex, no)
-AC_MSG_CHECKING(for available fonts)
-AC_ARG_WITH(fonts,[ --with-fonts Assume all fonts required are available],[USE_FONTS="$withval"])
-WITH_FONTS_bembo='%'
-WITHOUT_FONTS_bembo=
-WITH_FONTS_pfu='%'
-WITHOUT_FONTS_pfu=
-WITH_FONTS_bcr='%'
-WITHOUT_FONTS_bcr=
-if test -z "${USE_FONTS}"; then
- if test "${LATEX}" = no; then
- :
- else
- OUTPUT=./conftest-$$
- echo '\nonstopmode\documentclass{article}\usepackage{bembo}\begin{document}\end{document}' > ${OUTPUT}
- if ${LATEX} ${OUTPUT} </dev/null >& AC_FD_CC 2>&1 ; then
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Adobe Bembo"
- else
- USE_FONTS="${USE_FONTS}, Adobe Bembo"
- fi
- WITH_FONTS_bembo=
- WITHOUT_FONTS_bembo='%'
- fi
- echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT}
- if retval=`${LATEX} ${OUTPUT} </dev/null 2>& AC_FD_CC`; then
- if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then
- :
- else
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Adobe Futura"
- else
- USE_FONTS="${USE_FONTS}, Adobe Futura"
- fi
- WITH_FONTS_pfu=
- WITHOUT_FONTS_pfu='%'
- fi
- fi
- echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{bcr}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT}
- if retval=`${LATEX} ${OUTPUT} </dev/null 2>& AC_FD_CC`; then
- if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then
- :
- else
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Bitstream Courier"
- else
- USE_FONTS="${USE_FONTS}, Bitstream Courier"
- fi
- WITH_FONTS_bcr=
- WITHOUT_FONTS_bcr='%'
- fi
- fi
- rm -f ${OUTPUT} ${OUTPUT}.aux ${OUTPUT}.log ${OUTPUT}.dvi
- fi
-elif test "${USE_FONTS}" = yes ; then
- WITH_FONTS_bembo=
- WITHOUT_FONTS_bembo='%'
- WITH_FONTS_pfu=
- WITHOUT_FONTS_pfu='%'
- WITH_FONTS_bcr=
- WITHOUT_FONTS_bcr='%'
-fi
-AC_SUBST(WITH_FONTS_bembo)
-AC_SUBST(WITHOUT_FONTS_bembo)
-AC_SUBST(WITH_FONTS_pfu)
-AC_SUBST(WITHOUT_FONTS_pfu)
-AC_SUBST(WITH_FONTS_bcr)
-AC_SUBST(WITHOUT_FONTS_bcr)
-if test -z "${USE_FONTS}" ; then
- USE_FONTS=no
-fi
-USE_FONTS=`echo "${USE_FONTS}" | sed 's/,\([[^,]]*\)$/ and\1/'`
-AC_MSG_RESULT("${USE_FONTS}")
-if test "${USE_FONTS}" = yes ; then
- USE_FONTS='Set in Adobe Bembo, Adobe Futura and Bitstream Courier.'
-elif test "${USE_FONTS}" = no ; then
- USE_FONTS=''
-else
- USE_FONTS="Set in ${USE_FONTS}."
-fi
-AC_SUBST(USE_FONTS)
-])
-
-AC_DEFUN(AC_EXAMINE_PACKAGEDIR,
- [dnl Examine PACKAGEDIR.
- AC_EMACS_LISP(PACKAGEDIR,
- (let (package-dir)\
- (if (boundp (quote early-packages))\
- (let ((dirs (delq nil (append (if early-package-load-path\
- early-packages)\
- (if late-package-load-path\
- late-packages)\
- (if last-package-load-path\
- last-packages)))))\
- (while (and dirs (not package-dir))\
- (if (file-directory-p (car dirs))\
- (setq package-dir (car dirs)\
- dirs (cdr dirs))))))\
- (or package-dir \"\")),
- "noecho")])
-
-AC_DEFUN(AC_PATH_PACKAGEDIR,
- [dnl Check for PACKAGEDIR.
- if test ${EMACS_FLAVOR} = xemacs; then
- AC_MSG_CHECKING([where the XEmacs package is])
- AC_ARG_WITH(packagedir,
- [ --with-packagedir=DIR package DIR for XEmacs],
- [if test "$withval" != yes -a -n "$withval"; then
- PACKAGEDIR=$withval
- else
- AC_EXAMINE_PACKAGEDIR
- fi],
- AC_EXAMINE_PACKAGEDIR)
- if test -z "$PACKAGEDIR"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT($PACKAGEDIR)
- fi
- else
- PACKAGEDIR=
- fi
- AC_SUBST(PACKAGEDIR)])
-
-AC_DEFUN(AC_ADD_LOAD_PATH,
- [dnl Check for additional load path.
- AC_ARG_WITH(addpath,
- [ --with-addpath=PATH search Emacs-Lisp libraries with PATH
- use colons to separate directory names],
- [if test "$withval" != yes -a -n "$withval"; then
- AC_MSG_CHECKING([where to find the additional elisp libraries])
- ADDITIONAL_LOAD_PATH=$withval
- AC_MSG_RESULT($ADDITIONAL_LOAD_PATH)
- fi],
- ADDITIONAL_LOAD_PATH=)
- AC_SUBST(ADDITIONAL_LOAD_PATH)])
+++ /dev/null
-#! /bin/sh
-
-aclocal
-automake --gnu --add-missing
-autoconf
-
-exit 0
+++ /dev/null
-AC_INIT(configure.in)
-AC_PREREQ(2.13)
-AM_INIT_AUTOMAKE(liece, 1.4.9)
-
-AC_PROG_CC
-AC_ISC_POSIX
-AC_PROG_INSTALL
-AC_PROG_MAKE_SET
-AC_PROG_RANLIB
-
-AC_CHECK_HEADERS(sys/select.h libgen.h)
-
-AC_CHECK_LIB(nsl, gethostbyname)
-AC_CHECK_LIB(socket, socket)
-
-AC_CHECK_FUNCS(strtoul memmove getaddrinfo)
-AC_CHECK_FUNC(getopt_long,,LIBOBJS="$LIBOBJS getopt.o getopt1.o")
-AC_REPLACE_FUNCS(basename)
-AC_CHECK_EMACS
-AC_PATH_LISPDIR
-AC_PATH_ETCDIR
-AC_PATH_PACKAGEDIR
-
-AC_OUTPUT(Makefile \
-lisp/Makefile \
-dcc/Makefile \
-doc/Makefile \
-etc/Makefile \
-etc/icons/Makefile \
-etc/po/Makefile \
-etc/styles/Makefile)
+++ /dev/null
-DEFS = -I$(srcdir) -I$(top_srcdir) $(CFLAGS) @DEFS@
-LIBOBJS = @LIBOBJS@
-EXTRA_DIST = basename.c getopt.c getopt.h getopt1.c
-CLEANFILES = ldcc ltcp
-
-bin_PROGRAMS = ldcc ltcp
-
-ltcp_SOURCES = tcp.c
-ltcp_LDADD = $(LIBOBJS)
-ldcc_SOURCES = dcc.c
-ldcc_LDADD = $(LIBOBJS)
-
-package: all
-install-package: package install
+++ /dev/null
-/* Return the name-within-directory of a file name.
- Copyright (C) 1996, 1997, 1998 Free Software Foundation, Inc.
- This file is part of the GNU C Library.
-
- The GNU C Library is free software; you can redistribute it and/or
- modify it under the terms of the GNU Library General Public License as
- published by the Free Software Foundation; either version 2 of the
- License, or (at your option) any later version.
-
- The GNU C Library 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
- Library General Public License for more details.
-
- You should have received a copy of the GNU Library General Public
- License along with the GNU C Library; see the file COPYING.LIB. If not,
- write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
- Boston, MA 02111-1307, USA. */
-
-#ifdef HAVE_CONFIG_H
-# include <config.h>
-#endif
-
-#include <string.h>
-
-#define _LIBC
-#ifndef _LIBC
-/* We cannot generally use the name `basename' since XPG defines an unusable
- variant of the function but we cannot use it. */
-# define basename gnu_basename
-#endif
-
-
-char *
-basename (filename)
- const char *filename;
-{
- char *p = strrchr (filename, '/');
- return p ? p + 1 : (char *) filename;
-}
+++ /dev/null
-/* dcc.c
- * Copyright (C) 1998-2002 Daiki Ueno
- *
- * This file is part of Liece.
- *
- * This program 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
- * of the License, or (at your option) any later version.
- *
- * This program 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 this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */
-
-#include <sys/types.h>
-#include <sys/time.h>
-#include <sys/socket.h>
-#include <sys/file.h>
-#include <sys/ioctl.h>
-#include <sys/stat.h>
-#include <sys/time.h>
-#include <netdb.h>
-#include <stdio.h>
-#include <stdlib.h>
-#include <signal.h>
-#include <fcntl.h>
-#include <netinet/in.h>
-#define _GNU_SOURCE
-#include <getopt.h>
-
-#ifndef MAXHOSTNAMELEN
-# define MAXHOSTNAMELEN 31
-#endif
-
-#ifdef HAVE_SYS_SELECT_H
-# include <sys/select.h>
-#endif
-
-#ifdef HAVE_MEMMOVE
-# ifdef HAVE_LIBGEN_H
-# include <libgen.h>
-# ifdef basename
-# undef basename
-# endif
-# endif
-# include <string.h>
-#else
-# define memmove(x,y,z) bcopy((y), (x), (z))
-#endif
-
-#ifndef HAVE_BASENAME
-# define basename(path) (rindex((path), '/') + 1)
-#endif
-
-static void usage();
-static int prepare_listen_port();
-static int prepare_connect_port();
-
-static int receive_file();
-static int send_file();
-static int select_loop();
-static int chat_listen();
-static int chat_connect();
-
-static u_long primary_address_of();
-static u_long extract_addr_of_string();
-static u_long get_address_externally();
-
-static char *progname;
-
-void version () {
- printf("%s (Liece) 1.4.0\n"
- "Copyright (C) 1998, 1999 Daiki Ueno\n"
- "This is free software; see the source for copying conditions. There is NO\n"
- "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n",
- progname);
-}
-
-void usage() {
- printf("Usage: %s [global-options] command [command-options-and-arguments]\n"
- "where global-options are -v, -h, etc.\n"
- "where command is one of send, receive, chat, resolve.\n"
- "where command-options-and-arguments depend on the specific command.\n\n"
- "send <host> <port> <filename>\n"
- "receive <host> <port> <size> <filename>\n"
- "chat listen <port>\n"
- "chat connect <host> <port>\n"
- "resolve [hosts ...]\n",
- progname);
-}
-
-int prepare_listen_port (int ip_port) {
- int sock, tries;
- int opt = 1;
- static struct sockaddr_in server;
-
-
- if ((sock = socket(AF_INET, SOCK_STREAM, 0)) < 0) {
- perror("opening stream socket");
- exit(1);
- }
-
-#ifdef SO_REUSEADDR
- if (setsockopt(sock, SOL_SOCKET, SO_REUSEADDR,
- (char *)&opt, sizeof (opt)) < 0) {
- perror ("setsockopt SO_REUSEADDR");
- }
-#endif
-
- /* Bind a port to listen for new connections */
-
- server.sin_family = AF_INET;
- server.sin_addr.s_addr = INADDR_ANY;
- server.sin_port = htons (ip_port);
- for (tries = 0; tries < 10; tries++) {
- if (bind (sock, (struct sockaddr *) &server, sizeof (server))) {
- if (tries >= 9) {
- perror ("binding stream socket");
- exit (1);
- }
- perror ("binding stream socket. retry in 20 seconds");
- sleep (20); /* wait 20 seconds and try again */
- } else
- break;
- }
- listen (sock, 64);
- return (sock);
-}
-
-u_long get_address_externally(char *ircserver) {
- int i, len, dummy;
- u_long addr;
- struct hostent *hp;
- struct sockaddr_in server, client;
-
- addr = 0xc6290004; /* dummy addr --- rootA */
- if (ircserver && (hp = gethostbyname(ircserver)) != NULL) {
- addr = ntohl(((struct in_addr *)hp->h_addr_list[0])->s_addr);
- }
- if ((dummy = socket(AF_INET, SOCK_DGRAM, 0)) < 0) {
- perror("opening stream socket");
- return -1;
- }
- server.sin_family = AF_INET;
- server.sin_addr.s_addr = htonl(addr);
- server.sin_port = htons(7); /* dummy port --- echo */
- for (i = 0; i < 8; i++) {
- server.sin_zero[i] = 0;
- }
- if (connect(dummy, (struct sockaddr *)&server, sizeof(server)) < 0) {
- perror ("connecting remote socket");
- return -1;
- }
- len = sizeof(client);
- if (getsockname(dummy, (struct sockaddr *)&client, &len) < 0)
- return -1;
- close(dummy);
- return ntohl(client.sin_addr.s_addr);
-}
-
-\f
-/*
- * send_file(int port, char *ifile)
- * listens to connections to port, and when connection established
- * sends ifile to that socket
- */
-int send_file (int port, char *ifile) {
- int sock, ifd, ofd, len;
- u_long addr, bytessent = 0;
- char buf[ BUFSIZ * 8 ];
- fd_set readfds, writefds, fdset;
- struct stat statbuf;
- char namebuf[ MAXHOSTNAMELEN ];
- struct hostent *hp;
- struct sockaddr_in sin;
-
- if ((ifd = open (ifile, O_RDONLY)) < 0) {
- /* error in opening file to send */
- close(ofd);
- return 1;
- }
-
- gethostname(namebuf, sizeof (namebuf));
- fstat (ifd, &statbuf);
-
- sock = prepare_listen_port(port);
- len = sizeof (struct sockaddr_in);
- if (getsockname(sock, (struct sockaddr *)&sin, &len) == 0)
- port = ntohs(sin.sin_port);
-
- if ((addr = get_address_externally (NULL)) < 0) {
- gethostname(namebuf, sizeof (namebuf));
- if (hp = gethostbyname(namebuf))
- addr = ((struct in_addr *) (hp->h_addr_list)[0])->s_addr;
- else
- return 2;
- }
-
- printf ("DCC send %s %d %u %d\n", ifile, port, addr, statbuf.st_size);
-
- ofd = accept(sock, (struct sockaddr *) 0, (int *) 0);
-
- while ((len = read (ifd, buf, sizeof (buf))) > 0) {
- write (ofd, buf, len);
- bytessent += len;
- while ((len = read (ofd, buf, sizeof (u_long))) &&
- ntohl (*(u_long *) buf) != bytessent);
- }
- close (ofd);
- close (ifd);
- printf ("*** DCC file %s sent\n", ifile);
-
- return 0;
-}
-
-/*
- * receive_file(u_long host, int port, char *ifile)
- * connects to (host,port) and reads everything send from there
- * for every packet received gives back how much actually got
- * puts everything in ifile
- */
-int receive_file (u_long host, int port, int size, char *ifile) {
- int sock, ifd, ofd, len, bytesreceived = 0, toread, prev = 0;
- char buf[ BUFSIZ * 8 ];
- fd_set readfds, writefds, fdset;
- u_long netsize;
-
- if ((ofd = open(ifile, O_WRONLY|O_CREAT|O_TRUNC, 0600)) < 0) {
- fprintf(stderr, "open: opening file: %s\n", ifile);
- return 1;
- }
- ifd = prepare_connect_port (host, port);
- if ((toread = sizeof (buf)) > size)
- toread = size;
- while (bytesreceived < size && (len = read (ifd, buf, toread)) > 0) {
- write (ofd, buf, len);
- bytesreceived += len;
- netsize = htonl (bytesreceived);
- lseek (ifd, 0, 2);
- write (ifd, &netsize, 4);
- lseek (ifd, 0, 2);
- if (toread > size - bytesreceived)
- toread = size - bytesreceived;
- if (bytesreceived - prev > size / 5) {
- printf ("DCC %s %d%% (%d/%d bytes) received\n", ifile,
- 100 * bytesreceived / size, bytesreceived, size);
- prev = bytesreceived;
- }
- }
- printf ("*** DCC file %s received\n", ifile);
- close (ifd);
- close (ofd);
-
- return 0;
-}
-
-/*
- * select_loop(int sfd)
- * listens fd given, reads stdin and sends it to socket
- * anything read from socket is send to stdout
- */
-int select_loop (int sfd) {
- int ofd, len, bytesreceived = 0;
- char buf[ BUFSIZ * 8 ];
- fd_set readfds, writefds, fdset;
-
- for (;;) {
- FD_ZERO (&readfds);
- FD_SET (sfd, &readfds);
- FD_SET (0, &readfds);
- if (select (32, &readfds, 0, 0, 0) < 0) {
- perror ("select");
- close (sfd);
- return 1;
- }
-
- if (FD_ISSET (sfd, &readfds)) {
- if ((len = read(sfd, buf, sizeof (buf))) == 0) {
- close (sfd);
- return 0;
- }
- write (1, buf, len);
- FD_CLR (sfd, &readfds);
- }
- if (FD_ISSET (0, &readfds)) {
- if ((len = read (0, buf, sizeof (buf))) == 0) {
- close (sfd);
- return 0;
- }
- write(sfd, buf, len);
- FD_CLR (ofd, &readfds);
- }
- }
-}
-
-int prepare_connect_port (u_long host, int port) {
- int sock;
- static struct hostent *hp;
- static struct sockaddr_in server;
-
- sock = socket (AF_INET, SOCK_STREAM, 0);
- if (sock < 0) {
- perror ("opening stream socket");
- exit (1);
- }
- server.sin_family = AF_INET;
-
- server.sin_addr.s_addr = ntohl (host);
- server.sin_port = htons (port);
-
- if (connect(sock, (struct sockaddr *) &server, sizeof (server)) < 0) {
- perror ("connecting remote socket");
- return 0;
- }
-
- return sock;
-}
-
-u_long extract_addr_of_string (char *str) {
- u_long result = 0;
-
-#ifndef HAVE_STRTOUL
- while (*str++)
- result = result * 10 + *str - '0';
-#else /* !HAVE_STRTOUL */
- result = strtoul(str, NULL, 10);
-#endif /* HAVE_STRTOUL */
- return result;
-}
-
-u_long primary_address_of (char *host) {
- struct hostent *hp;
- u_long addr;
-
- if ((hp = gethostbyname(host)) == NULL)
- addr = inet_addr(host);
- else
- memmove(&addr, hp->h_addr_list[ 0 ], 4);
-
- return ntohl(addr);
-}
-
-int chat_listen(int port) {
- struct sockaddr_in sin;
- struct hostent *hp;
- u_long addr;
- int sock, len;
- char namebuf[ MAXHOSTNAMELEN ];
-
- sock = prepare_listen_port (port);
-
- len = sizeof (struct sockaddr_in);
- if (getsockname(sock, (struct sockaddr *)&sin, &len) == 0)
- port = ntohs(sin.sin_port);
-
- if ((addr = get_address_externally (NULL)) < 0) {
- gethostname(namebuf, sizeof (namebuf));
- if (hp = gethostbyname(namebuf))
- addr = ((struct in_addr *) (hp->h_addr_list)[0])->s_addr;
- else
- return 2;
- }
-
- printf("DCC chat %u %d\n", addr, port);
-
- if ((sock = accept(sock, (struct sockaddr *) 0, (int *) 0)) > -1) {
- printf("DCC chat established\n");
- return select_loop(sock);
- }
-
- return 1;
-}
-
-int chat_connect(u_long host, int port) {
- int sock;
-
- if ((sock = prepare_connect_port(host, port)) > -1) {
- printf("DCC chat established\n");
- return select_loop(sock);
- }
-
- return 1;
-}
-
-\f
-int main (int argc, char **argv) {
- char *host = "localhost";
- char *action;
- int c, status = 0;
-
- progname = (char *)basename(argv[ 0 ]);
-
- while (1) {
- int this_option_optind = optind ? optind : 1;
- int option_index = 0;
- static struct option long_options[] = {
- {"version", 0, 0, 'v'},
- {"help", 0, 0, 'h'},
- {0, 0, 0, 0}
- };
-
- c = getopt_long (argc, argv, "vh", long_options, &option_index);
- if (c == -1)
- break;
-
- switch (c) {
- case 'v':
- version();
- exit(1);
- break;
- case 'h':
- usage();
- exit(1);
- break;
- default:
- break;
- }
- }
-
- if (argc > 1) {
- action = argv[ 1 ];
- } else {
- usage();
- exit(1);
- }
-
- if (!strcmp(action, "resolve")) {
- if (argc < 3) {
- usage();
- exit(1);
- } else {
- u_long i, addr;
- for (i = 2; i < argc; i++) {
- addr = primary_address_of(argv[i]);
- if (addr != -1)
- printf("%u\n", addr);
- else
- printf("0\n");
- }
- status = 0;
- }
- }
-
- if (!strcmp(action, "send")) {
- if (argc != 4) {
- usage();
- exit(1);
- }
- status = send_file (atoi(argv[ 2 ]), argv[ 3 ]);
- } else if (!strcmp(action, "receive")) {
- if (argc != 6) {
- usage();
- exit(1);
- }
- status =
- receive_file (extract_addr_of_string(argv[ 2 ]),
- atoi(argv[ 3 ]), atoi(argv[ 4 ]), argv[ 5 ]);
- } else if (!strcmp(action, "chat")) {
- if (argc > 3) {
- if (!strcmp(argv[ 2 ], "listen")) {
- if (argc != 4) {
- usage();
- exit(1);
- }
- status = chat_listen(atoi(argv[ 3 ]));
- } else if (!strcmp(argv[ 2 ], "connect")) {
- if (argc != 5) {
- usage();
- exit(1);
- }
- status = chat_connect(extract_addr_of_string(argv[ 3 ]),
- atoi(argv[ 4 ]));
- } else {
- usage();
- exit(1);
- }
- }
- } else {
- usage();
- exit(1);
- }
-
- return status;
-}
-
-/*
- * Local variables:
- * compile-command: "gcc -DHAVE_STRTOUL -Wall -O6 -o dcc dcc.c"
- * c-indent-level: 2
- * c-basic-offset: 2
- * tab-width: 2
- * End:
- */
+++ /dev/null
-/* Getopt for GNU.
- NOTE: getopt is now part of the C library, so if you don't know what
- "Keep this file name-space clean" means, talk to roland@gnu.ai.mit.edu
- before changing it!
-
- Copyright (C) 1987, 88, 89, 90, 91, 92, 93, 94
- Free Software Foundation, Inc.
-
- This program 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.
-
- This program 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. */
-\f
-/* This tells Alpha OSF/1 not to define a getopt prototype in <stdio.h>.
- Ditto for AIX 3.2 and <stdlib.h>. */
-#ifndef _NO_PROTO
-#define _NO_PROTO
-#endif
-
-#ifdef HAVE_CONFIG_H
-#if defined (emacs) || defined (CONFIG_BROKETS)
-/* We use <config.h> instead of "config.h" so that a compilation
- using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h
- (which it would do because it found this file in $srcdir). */
-#include <config.h>
-#else
-#include "config.h"
-#endif
-#endif
-
-#ifndef __STDC__
-/* This is a separate conditional since some stdc systems
- reject `defined (const)'. */
-#ifndef const
-#define const
-#endif
-#endif
-
-#include <stdio.h>
-
-#ifdef HAVE_STRING_H
-#include <string.h>
-#endif
-
-/* Comment out all this code if we are using the GNU C Library, and are not
- actually compiling the library itself. This code is part of the GNU C
- Library, but also included in many other GNU distributions. Compiling
- and linking in this code is a waste when using the GNU C library
- (especially if it is a shared library). Rather than having every GNU
- program understand `configure --with-gnu-libc' and omit the object files,
- it is simpler to just do this in the source for each such file. */
-
-#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
-
-
-/* This needs to come after some library #include
- to get __GNU_LIBRARY__ defined. */
-#ifdef __GNU_LIBRARY__
-/* Don't include stdlib.h for non-GNU C libraries because some of them
- contain conflicting prototypes for getopt. */
-#include <stdlib.h>
-#endif /* GNU C library. */
-
-/* This version of `getopt' appears to the caller like standard Unix `getopt'
- but it behaves differently for the user, since it allows the user
- to intersperse the options with the other arguments.
-
- As `getopt' works, it permutes the elements of ARGV so that,
- when it is done, all the options precede everything else. Thus
- all application programs are extended to handle flexible argument order.
-
- Setting the environment variable POSIXLY_CORRECT disables permutation.
- Then the behavior is completely standard.
-
- GNU application programs can use a third alternative mode in which
- they can distinguish the relative order of options and other arguments. */
-
-#include "getopt.h"
-
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
- the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
- each non-option ARGV-element is returned here. */
-
-char *optarg = NULL;
-
-/* Index in ARGV of the next element to be scanned.
- This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
-
- On entry to `getopt', zero means this is the first call; initialize.
-
- When `getopt' returns EOF, this is the index of the first of the
- non-option elements that the caller should itself scan.
-
- Otherwise, `optind' communicates from one call to the next
- how much of ARGV has been scanned so far. */
-
-/* XXX 1003.2 says this must be 1 before any call. */
-int optind = 0;
-
-/* The next char to be scanned in the option-element
- in which the last option character we returned was found.
- This allows us to pick up the scan where we left off.
-
- If this is zero, or a null string, it means resume the scan
- by advancing to the next ARGV-element. */
-
-static char *nextchar;
-
-/* Callers store zero here to inhibit the error message
- for unrecognized options. */
-
-int opterr = 1;
-
-/* Set to an option character which was unrecognized.
- This must be initialized on some systems to avoid linking in the
- system's own getopt implementation. */
-
-int optopt = '?';
-
-/* Describe how to deal with options that follow non-option ARGV-elements.
-
- If the caller did not specify anything,
- the default is REQUIRE_ORDER if the environment variable
- POSIXLY_CORRECT is defined, PERMUTE otherwise.
-
- REQUIRE_ORDER means don't recognize them as options;
- stop option processing when the first non-option is seen.
- This is what Unix does.
- This mode of operation is selected by either setting the environment
- variable POSIXLY_CORRECT, or using `+' as the first character
- of the list of option characters.
-
- PERMUTE is the default. We permute the contents of ARGV as we scan,
- so that eventually all the non-options are at the end. This allows options
- to be given in any order, even with programs that were not written to
- expect this.
-
- RETURN_IN_ORDER is an option available to programs that were written
- to expect options and other ARGV-elements in any order and that care about
- the ordering of the two. We describe each non-option ARGV-element
- as if it were the argument of an option with character code 1.
- Using `-' as the first character of the list of option characters
- selects this mode of operation.
-
- The special argument `--' forces an end of option-scanning regardless
- of the value of `ordering'. In the case of RETURN_IN_ORDER, only
- `--' can cause `getopt' to return EOF with `optind' != ARGC. */
-
-static enum
-{
- REQUIRE_ORDER, PERMUTE, RETURN_IN_ORDER
-} ordering;
-
-/* Value of POSIXLY_CORRECT environment variable. */
-static char *posixly_correct;
-\f
-#ifdef __GNU_LIBRARY__
-/* We want to avoid inclusion of string.h with non-GNU libraries
- because there are many ways it can cause trouble.
- On some systems, it contains special magic macros that don't work
- in GCC. */
-#include <string.h>
-#define my_index strchr
-#else
-
-/* Avoid depending on library functions or files
- whose names are inconsistent. */
-
-char *getenv ();
-
-static char *
-my_index (str, chr)
- const char *str;
- int chr;
-{
- while (*str)
- {
- if (*str == chr)
- return (char *) str;
- str++;
- }
- return 0;
-}
-
-/* If using GCC, we can safely declare strlen this way.
- If not using GCC, it is ok not to declare it. */
-#ifdef __GNUC__
-/* Note that Motorola Delta 68k R3V7 comes with GCC but not stddef.h.
- That was relevant to code that was here before. */
-#ifndef __STDC__
-/* gcc with -traditional declares the built-in strlen to return int,
- and has done so at least since version 2.4.5. -- rms. */
-extern int strlen (const char *);
-#endif /* not __STDC__ */
-#endif /* __GNUC__ */
-
-#endif /* not __GNU_LIBRARY__ */
-\f
-/* Handle permutation of arguments. */
-
-/* Describe the part of ARGV that contains non-options that have
- been skipped. `first_nonopt' is the index in ARGV of the first of them;
- `last_nonopt' is the index after the last of them. */
-
-static int first_nonopt;
-static int last_nonopt;
-
-/* Exchange two adjacent subsequences of ARGV.
- One subsequence is elements [first_nonopt,last_nonopt)
- which contains all the non-options that have been skipped so far.
- The other is elements [last_nonopt,optind), which contains all
- the options processed since those non-options were skipped.
-
- `first_nonopt' and `last_nonopt' are relocated so that they describe
- the new indices of the non-options in ARGV after they are moved. */
-
-static void
-exchange (argv)
- char **argv;
-{
- int bottom = first_nonopt;
- int middle = last_nonopt;
- int top = optind;
- char *tem;
-
- /* Exchange the shorter segment with the far end of the longer segment.
- That puts the shorter segment into the right place.
- It leaves the longer segment in the right place overall,
- but it consists of two parts that need to be swapped next. */
-
- while (top > middle && middle > bottom)
- {
- if (top - middle > middle - bottom)
- {
- /* Bottom segment is the short one. */
- int len = middle - bottom;
- register int i;
-
- /* Swap it with the top part of the top segment. */
- for (i = 0; i < len; i++)
- {
- tem = argv[bottom + i];
- argv[bottom + i] = argv[top - (middle - bottom) + i];
- argv[top - (middle - bottom) + i] = tem;
- }
- /* Exclude the moved bottom segment from further swapping. */
- top -= len;
- }
- else
- {
- /* Top segment is the short one. */
- int len = top - middle;
- register int i;
-
- /* Swap it with the bottom part of the bottom segment. */
- for (i = 0; i < len; i++)
- {
- tem = argv[bottom + i];
- argv[bottom + i] = argv[middle + i];
- argv[middle + i] = tem;
- }
- /* Exclude the moved top segment from further swapping. */
- bottom += len;
- }
- }
-
- /* Update records for the slots the non-options now occupy. */
-
- first_nonopt += (optind - last_nonopt);
- last_nonopt = optind;
-}
-
-/* Initialize the internal data when the first call is made. */
-
-static const char *
-_getopt_initialize (optstring)
- const char *optstring;
-{
- /* Start processing options with ARGV-element 1 (since ARGV-element 0
- is the program name); the sequence of previously skipped
- non-option ARGV-elements is empty. */
-
- first_nonopt = last_nonopt = optind = 1;
-
- nextchar = NULL;
-
- posixly_correct = getenv ("POSIXLY_CORRECT");
-
- /* Determine how to handle the ordering of options and nonoptions. */
-
- if (optstring[0] == '-')
- {
- ordering = RETURN_IN_ORDER;
- ++optstring;
- }
- else if (optstring[0] == '+')
- {
- ordering = REQUIRE_ORDER;
- ++optstring;
- }
- else if (posixly_correct != NULL)
- ordering = REQUIRE_ORDER;
- else
- ordering = PERMUTE;
-
- return optstring;
-}
-\f
-/* Scan elements of ARGV (whose length is ARGC) for option characters
- given in OPTSTRING.
-
- If an element of ARGV starts with '-', and is not exactly "-" or "--",
- then it is an option element. The characters of this element
- (aside from the initial '-') are option characters. If `getopt'
- is called repeatedly, it returns successively each of the option characters
- from each of the option elements.
-
- If `getopt' finds another option character, it returns that character,
- updating `optind' and `nextchar' so that the next call to `getopt' can
- resume the scan with the following option character or ARGV-element.
-
- If there are no more option characters, `getopt' returns `EOF'.
- Then `optind' is the index in ARGV of the first ARGV-element
- that is not an option. (The ARGV-elements have been permuted
- so that those that are not options now come last.)
-
- OPTSTRING is a string containing the legitimate option characters.
- If an option character is seen that is not listed in OPTSTRING,
- return '?' after printing an error message. If you set `opterr' to
- zero, the error message is suppressed but we still return '?'.
-
- If a char in OPTSTRING is followed by a colon, that means it wants an arg,
- so the following text in the same ARGV-element, or the text of the following
- ARGV-element, is returned in `optarg'. Two colons mean an option that
- wants an optional arg; if there is text in the current ARGV-element,
- it is returned in `optarg', otherwise `optarg' is set to zero.
-
- If OPTSTRING starts with `-' or `+', it requests different methods of
- handling the non-option ARGV-elements.
- See the comments about RETURN_IN_ORDER and REQUIRE_ORDER, above.
-
- Long-named options begin with `--' instead of `-'.
- Their names may be abbreviated as long as the abbreviation is unique
- or is an exact match for some defined option. If they have an
- argument, it follows the option name in the same ARGV-element, separated
- from the option name by a `=', or else the in next ARGV-element.
- When `getopt' finds a long-named option, it returns 0 if that option's
- `flag' field is nonzero, the value of the option's `val' field
- if the `flag' field is zero.
-
- The elements of ARGV aren't really const, because we permute them.
- But we pretend they're const in the prototype to be compatible
- with other systems.
-
- LONGOPTS is a vector of `struct option' terminated by an
- element containing a name which is zero.
-
- LONGIND returns the index in LONGOPT of the long-named option found.
- It is only valid when a long-named option has been found by the most
- recent call.
-
- If LONG_ONLY is nonzero, '-' as well as '--' can introduce
- long-named options. */
-
-int
-_getopt_internal (argc, argv, optstring, longopts, longind, long_only)
- int argc;
- char *const *argv;
- const char *optstring;
- const struct option *longopts;
- int *longind;
- int long_only;
-{
- optarg = NULL;
-
- if (optind == 0)
- optstring = _getopt_initialize (optstring);
-
- if (nextchar == NULL || *nextchar == '\0')
- {
- /* Advance to the next ARGV-element. */
-
- if (ordering == PERMUTE)
- {
- /* If we have just processed some options following some non-options,
- exchange them so that the options come first. */
-
- if (first_nonopt != last_nonopt && last_nonopt != optind)
- exchange ((char **) argv);
- else if (last_nonopt != optind)
- first_nonopt = optind;
-
- /* Skip any additional non-options
- and extend the range of non-options previously skipped. */
-
- while (optind < argc
- && (argv[optind][0] != '-' || argv[optind][1] == '\0'))
- optind++;
- last_nonopt = optind;
- }
-
- /* The special ARGV-element `--' means premature end of options.
- Skip it like a null option,
- then exchange with previous non-options as if it were an option,
- then skip everything else like a non-option. */
-
- if (optind != argc && !strcmp (argv[optind], "--"))
- {
- optind++;
-
- if (first_nonopt != last_nonopt && last_nonopt != optind)
- exchange ((char **) argv);
- else if (first_nonopt == last_nonopt)
- first_nonopt = optind;
- last_nonopt = argc;
-
- optind = argc;
- }
-
- /* If we have done all the ARGV-elements, stop the scan
- and back over any non-options that we skipped and permuted. */
-
- if (optind == argc)
- {
- /* Set the next-arg-index to point at the non-options
- that we previously skipped, so the caller will digest them. */
- if (first_nonopt != last_nonopt)
- optind = first_nonopt;
- return EOF;
- }
-
- /* If we have come to a non-option and did not permute it,
- either stop the scan or describe it to the caller and pass it by. */
-
- if ((argv[optind][0] != '-' || argv[optind][1] == '\0'))
- {
- if (ordering == REQUIRE_ORDER)
- return EOF;
- optarg = argv[optind++];
- return 1;
- }
-
- /* We have found another option-ARGV-element.
- Skip the initial punctuation. */
-
- nextchar = (argv[optind] + 1
- + (longopts != NULL && argv[optind][1] == '-'));
- }
-
- /* Decode the current option-ARGV-element. */
-
- /* Check whether the ARGV-element is a long option.
-
- If long_only and the ARGV-element has the form "-f", where f is
- a valid short option, don't consider it an abbreviated form of
- a long option that starts with f. Otherwise there would be no
- way to give the -f short option.
-
- On the other hand, if there's a long option "fubar" and
- the ARGV-element is "-fu", do consider that an abbreviation of
- the long option, just like "--fu", and not "-f" with arg "u".
-
- This distinction seems to be the most useful approach. */
-
- if (longopts != NULL
- && (argv[optind][1] == '-'
- || (long_only && (argv[optind][2] || !my_index (optstring, argv[optind][1])))))
- {
- char *nameend;
- const struct option *p;
- const struct option *pfound = NULL;
- int exact = 0;
- int ambig = 0;
- int indfound;
- int option_index;
-
- for (nameend = nextchar; *nameend && *nameend != '='; nameend++)
- /* Do nothing. */ ;
-
- /* Test all long options for either exact match
- or abbreviated matches. */
- for (p = longopts, option_index = 0; p->name; p++, option_index++)
- if (!strncmp (p->name, nextchar, nameend - nextchar))
- {
- if (nameend - nextchar == (int) strlen (p->name))
- {
- /* Exact match found. */
- pfound = p;
- indfound = option_index;
- exact = 1;
- break;
- }
- else if (pfound == NULL)
- {
- /* First nonexact match found. */
- pfound = p;
- indfound = option_index;
- }
- else
- /* Second or later nonexact match found. */
- ambig = 1;
- }
-
- if (ambig && !exact)
- {
- if (opterr)
- fprintf (stderr, "%s: option `%s' is ambiguous\n",
- argv[0], argv[optind]);
- nextchar += strlen (nextchar);
- optind++;
- return '?';
- }
-
- if (pfound != NULL)
- {
- option_index = indfound;
- optind++;
- if (*nameend)
- {
- /* Don't test has_arg with >, because some C compilers don't
- allow it to be used on enums. */
- if (pfound->has_arg)
- optarg = nameend + 1;
- else
- {
- if (opterr)
- {
- if (argv[optind - 1][1] == '-')
- /* --option */
- fprintf (stderr,
- "%s: option `--%s' doesn't allow an argument\n",
- argv[0], pfound->name);
- else
- /* +option or -option */
- fprintf (stderr,
- "%s: option `%c%s' doesn't allow an argument\n",
- argv[0], argv[optind - 1][0], pfound->name);
- }
- nextchar += strlen (nextchar);
- return '?';
- }
- }
- else if (pfound->has_arg == 1)
- {
- if (optind < argc)
- optarg = argv[optind++];
- else
- {
- if (opterr)
- fprintf (stderr, "%s: option `%s' requires an argument\n",
- argv[0], argv[optind - 1]);
- nextchar += strlen (nextchar);
- return optstring[0] == ':' ? ':' : '?';
- }
- }
- nextchar += strlen (nextchar);
- if (longind != NULL)
- *longind = option_index;
- if (pfound->flag)
- {
- *(pfound->flag) = pfound->val;
- return 0;
- }
- return pfound->val;
- }
-
- /* Can't find it as a long option. If this is not getopt_long_only,
- or the option starts with '--' or is not a valid short
- option, then it's an error.
- Otherwise interpret it as a short option. */
- if (!long_only || argv[optind][1] == '-'
- || my_index (optstring, *nextchar) == NULL)
- {
- if (opterr)
- {
- if (argv[optind][1] == '-')
- /* --option */
- fprintf (stderr, "%s: unrecognized option `--%s'\n",
- argv[0], nextchar);
- else
- /* +option or -option */
- fprintf (stderr, "%s: unrecognized option `%c%s'\n",
- argv[0], argv[optind][0], nextchar);
- }
- nextchar = (char *) "";
- optind++;
- return '?';
- }
- }
-
- /* Look at and handle the next short option-character. */
-
- {
- char c = *nextchar++;
- char *temp = my_index (optstring, c);
-
- /* Increment `optind' when we start to process its last character. */
- if (*nextchar == '\0')
- ++optind;
-
- if (temp == NULL || c == ':')
- {
- if (opterr)
- {
- if (posixly_correct)
- /* 1003.2 specifies the format of this message. */
- fprintf (stderr, "%s: illegal option -- %c\n", argv[0], c);
- else
- fprintf (stderr, "%s: invalid option -- %c\n", argv[0], c);
- }
- optopt = c;
- return '?';
- }
- if (temp[1] == ':')
- {
- if (temp[2] == ':')
- {
- /* This is an option that accepts an argument optionally. */
- if (*nextchar != '\0')
- {
- optarg = nextchar;
- optind++;
- }
- else
- optarg = NULL;
- nextchar = NULL;
- }
- else
- {
- /* This is an option that requires an argument. */
- if (*nextchar != '\0')
- {
- optarg = nextchar;
- /* If we end this ARGV-element by taking the rest as an arg,
- we must advance to the next element now. */
- optind++;
- }
- else if (optind == argc)
- {
- if (opterr)
- {
- /* 1003.2 specifies the format of this message. */
- fprintf (stderr, "%s: option requires an argument -- %c\n",
- argv[0], c);
- }
- optopt = c;
- if (optstring[0] == ':')
- c = ':';
- else
- c = '?';
- }
- else
- /* We already incremented `optind' once;
- increment it again when taking next ARGV-elt as argument. */
- optarg = argv[optind++];
- nextchar = NULL;
- }
- }
- return c;
- }
-}
-
-int
-getopt (argc, argv, optstring)
- int argc;
- char *const *argv;
- const char *optstring;
-{
- return _getopt_internal (argc, argv, optstring,
- (const struct option *) 0,
- (int *) 0,
- 0);
-}
-
-#endif /* _LIBC or not __GNU_LIBRARY__. */
-\f
-#ifdef TEST
-
-/* Compile with -DTEST to make an executable for use in testing
- the above definition of `getopt'. */
-
-int
-main (argc, argv)
- int argc;
- char **argv;
-{
- int c;
- int digit_optind = 0;
-
- while (1)
- {
- int this_option_optind = optind ? optind : 1;
-
- c = getopt (argc, argv, "abc:d:0123456789");
- if (c == EOF)
- break;
-
- switch (c)
- {
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- if (digit_optind != 0 && digit_optind != this_option_optind)
- printf ("digits occur in two different argv-elements.\n");
- digit_optind = this_option_optind;
- printf ("option %c\n", c);
- break;
-
- case 'a':
- printf ("option a\n");
- break;
-
- case 'b':
- printf ("option b\n");
- break;
-
- case 'c':
- printf ("option c with value `%s'\n", optarg);
- break;
-
- case '?':
- break;
-
- default:
- printf ("?? getopt returned character code 0%o ??\n", c);
- }
- }
-
- if (optind < argc)
- {
- printf ("non-option ARGV-elements: ");
- while (optind < argc)
- printf ("%s ", argv[optind++]);
- printf ("\n");
- }
-
- exit (0);
-}
-
-#endif /* TEST */
+++ /dev/null
-/* Declarations for getopt.
- Copyright (C) 1989, 1990, 1991, 1992, 1993 Free Software Foundation, Inc.
-
- This program 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.
-
- This program 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. */
-
-#ifndef _GETOPT_H
-#define _GETOPT_H 1
-
-#ifdef __cplusplus
-extern "C" {
-#endif
-
-/* For communication from `getopt' to the caller.
- When `getopt' finds an option that takes an argument,
- the argument value is returned here.
- Also, when `ordering' is RETURN_IN_ORDER,
- each non-option ARGV-element is returned here. */
-
-extern char *optarg;
-
-/* Index in ARGV of the next element to be scanned.
- This is used for communication to and from the caller
- and for communication between successive calls to `getopt'.
-
- On entry to `getopt', zero means this is the first call; initialize.
-
- When `getopt' returns EOF, this is the index of the first of the
- non-option elements that the caller should itself scan.
-
- Otherwise, `optind' communicates from one call to the next
- how much of ARGV has been scanned so far. */
-
-extern int optind;
-
-/* Callers store zero here to inhibit the error message `getopt' prints
- for unrecognized options. */
-
-extern int opterr;
-
-/* Set to an option character which was unrecognized. */
-
-extern int optopt;
-
-/* Describe the long-named options requested by the application.
- The LONG_OPTIONS argument to getopt_long or getopt_long_only is a vector
- of `struct option' terminated by an element containing a name which is
- zero.
-
- The field `has_arg' is:
- no_argument (or 0) if the option does not take an argument,
- required_argument (or 1) if the option requires an argument,
- optional_argument (or 2) if the option takes an optional argument.
-
- If the field `flag' is not NULL, it points to a variable that is set
- to the value given in the field `val' when the option is found, but
- left unchanged if the option is not found.
-
- To have a long-named option do something other than set an `int' to
- a compiled-in constant, such as set a value from `optarg', set the
- option's `flag' field to zero and its `val' field to a nonzero
- value (the equivalent single-letter option character, if there is
- one). For long options that have a zero `flag' field, `getopt'
- returns the contents of the `val' field. */
-
-struct option
-{
-#if __STDC__
- const char *name;
-#else
- char *name;
-#endif
- /* has_arg can't be an enum because some compilers complain about
- type mismatches in all the code that assumes it is an int. */
- int has_arg;
- int *flag;
- int val;
-};
-
-/* Names for the values of the `has_arg' field of `struct option'. */
-
-#define no_argument 0
-#define required_argument 1
-#define optional_argument 2
-
-#if __STDC__
-#if defined(__GNU_LIBRARY__)
-/* Many other libraries have conflicting prototypes for getopt, with
- differences in the consts, in stdlib.h. To avoid compilation
- errors, only prototype getopt for the GNU C library. */
-extern int getopt (int argc, char *const *argv, const char *shortopts);
-#else /* not __GNU_LIBRARY__ */
-extern int getopt ();
-#endif /* not __GNU_LIBRARY__ */
-extern int getopt_long (int argc, char *const *argv, const char *shortopts,
- const struct option *longopts, int *longind);
-extern int getopt_long_only (int argc, char *const *argv,
- const char *shortopts,
- const struct option *longopts, int *longind);
-
-/* Internal only. Users should not call this directly. */
-extern int _getopt_internal (int argc, char *const *argv,
- const char *shortopts,
- const struct option *longopts, int *longind,
- int long_only);
-#else /* not __STDC__ */
-extern int getopt ();
-extern int getopt_long ();
-extern int getopt_long_only ();
-
-extern int _getopt_internal ();
-#endif /* not __STDC__ */
-
-#ifdef __cplusplus
-}
-#endif
-
-#endif /* _GETOPT_H */
+++ /dev/null
-/* getopt_long and getopt_long_only entry points for GNU getopt.
- Copyright (C) 1987, 88, 89, 90, 91, 92, 1993
- Free Software Foundation, Inc.
-
- This program 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.
-
- This program 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. */
-\f
-#ifdef HAVE_CONFIG_H
-#if defined (emacs) || defined (CONFIG_BROKETS)
-/* We use <config.h> instead of "config.h" so that a compilation
- using -I. -I$srcdir will use ./config.h rather than $srcdir/config.h
- (which it would do because it found this file in $srcdir). */
-#include <config.h>
-#else
-#include "config.h"
-#endif
-#endif
-
-#include "getopt.h"
-
-#ifndef __STDC__
-/* This is a separate conditional since some stdc systems
- reject `defined (const)'. */
-#ifndef const
-#define const
-#endif
-#endif
-
-#include <stdio.h>
-
-/* Comment out all this code if we are using the GNU C Library, and are not
- actually compiling the library itself. This code is part of the GNU C
- Library, but also included in many other GNU distributions. Compiling
- and linking in this code is a waste when using the GNU C library
- (especially if it is a shared library). Rather than having every GNU
- program understand `configure --with-gnu-libc' and omit the object files,
- it is simpler to just do this in the source for each such file. */
-
-#if defined (_LIBC) || !defined (__GNU_LIBRARY__)
-
-
-/* This needs to come after some library #include
- to get __GNU_LIBRARY__ defined. */
-#ifdef __GNU_LIBRARY__
-#include <stdlib.h>
-#else
-char *getenv ();
-#endif
-
-#ifndef NULL
-#define NULL 0
-#endif
-
-int
-getopt_long (argc, argv, options, long_options, opt_index)
- int argc;
- char *const *argv;
- const char *options;
- const struct option *long_options;
- int *opt_index;
-{
- return _getopt_internal (argc, argv, options, long_options, opt_index, 0);
-}
-
-/* Like getopt_long, but '-' as well as '--' can indicate a long option.
- If an option that starts with '-' (not '--') doesn't match a long option,
- but does match a short option, it is parsed as a short option
- instead. */
-
-int
-getopt_long_only (argc, argv, options, long_options, opt_index)
- int argc;
- char *const *argv;
- const char *options;
- const struct option *long_options;
- int *opt_index;
-{
- return _getopt_internal (argc, argv, options, long_options, opt_index, 1);
-}
-
-
-#endif /* _LIBC or not __GNU_LIBRARY__. */
-\f
-#ifdef TEST
-
-#include <stdio.h>
-
-int
-main (argc, argv)
- int argc;
- char **argv;
-{
- int c;
- int digit_optind = 0;
-
- while (1)
- {
- int this_option_optind = optind ? optind : 1;
- int option_index = 0;
- static struct option long_options[] =
- {
- {"add", 1, 0, 0},
- {"append", 0, 0, 0},
- {"delete", 1, 0, 0},
- {"verbose", 0, 0, 0},
- {"create", 0, 0, 0},
- {"file", 1, 0, 0},
- {0, 0, 0, 0}
- };
-
- c = getopt_long (argc, argv, "abc:d:0123456789",
- long_options, &option_index);
- if (c == EOF)
- break;
-
- switch (c)
- {
- case 0:
- printf ("option %s", long_options[option_index].name);
- if (optarg)
- printf (" with arg %s", optarg);
- printf ("\n");
- break;
-
- case '0':
- case '1':
- case '2':
- case '3':
- case '4':
- case '5':
- case '6':
- case '7':
- case '8':
- case '9':
- if (digit_optind != 0 && digit_optind != this_option_optind)
- printf ("digits occur in two different argv-elements.\n");
- digit_optind = this_option_optind;
- printf ("option %c\n", c);
- break;
-
- case 'a':
- printf ("option a\n");
- break;
-
- case 'b':
- printf ("option b\n");
- break;
-
- case 'c':
- printf ("option c with value `%s'\n", optarg);
- break;
-
- case 'd':
- printf ("option d with value `%s'\n", optarg);
- break;
-
- case '?':
- break;
-
- default:
- printf ("?? getopt returned character code 0%o ??\n", c);
- }
- }
-
- if (optind < argc)
- {
- printf ("non-option ARGV-elements: ");
- while (optind < argc)
- printf ("%s ", argv[optind++]);
- printf ("\n");
- }
-
- exit (0);
-}
-
-#endif /* TEST */
+++ /dev/null
-/* tcp.c - TCP/IP stream emulation for GNU Emacs.
- * Copyright (C) 1988, 1989, 1992, 1993 Free Software Foundation, Inc.
- * Copyright (C) 1998-2002 Daiki Ueno
- *
- * This file is part of Liece.
- *
- * This program 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
- * of the License, or (at your option) any later version.
- *
- * This program 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 this program; if not, write to the Free Software
- * Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
- */
-/* This program is based on `tcp' comming from old GNUS distribution
- written by Masanobu Umeda <umerin@mse.kyutech.ac.jp>. */
-
-#include <sys/types.h>
-#include <sys/time.h>
-#include <sys/socket.h>
-#include <sys/file.h>
-#include <sys/ioctl.h>
-#include <sys/stat.h>
-#include <sys/time.h>
-#include <netdb.h>
-#include <stdio.h>
-#include <signal.h>
-#include <fcntl.h>
-#include <netinet/in.h>
-#define _GNU_SOURCE
-#include <getopt.h>
-
-#ifdef HAVE_BASENAME
-# ifdef HAVE_LIBGEN_H
-# include <libgen.h>
-# ifdef basename
-# undef basename
-# endif
-# endif
-# include <string.h>
-#else
-# define basename(path) (rindex((path), '/') + 1)
-#endif
-
-#ifndef NI_MAXHOST
-# define NI_MAXHOST 1025
-#endif
-
-static char *progname;
-
-void version () {
- printf("%s (Liece) 1.4.0\n"
- "Copyright (C) 1998, 1999 Daiki Ueno\n"
- "This is free software; see the source for copying conditions. There is NO\n"
- "warranty; not even for MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.\n",
- progname);
-}
-
-void usage() {
- printf("Usage: %s [options] host [service]\n", progname);
-}
-
-\f
-main (argc, argv)
- int argc;
- char *argv[];
-{
- struct protoent *proto;
- int family, socktype;
- struct sockaddr *addr;
- size_t addrlen;
-#ifdef HAVE_GETADDRINFO
- struct addrinfo *in, hints;
-#else
- struct hostent *host;
- struct servent *serv;
- struct sockaddr_in sin;
-#endif
- char *hostname = NULL, *service = "ircd";
- int port;
- fd_set *readfds, *writefds;
- int server, emacsIn = fileno (stdin), emacsOut = fileno (stdout);
- char buffer[1024], *retry;
- int nbuffer, wret, false = 0;
- int c;
-
- progname = (char *) basename (argv[0]);
-
- while (1)
- {
- int this_option_optind = optind ? optind : 1;
- int option_index = 0;
- static struct option long_options[] =
- {
- {"version", 0, 0, 'v'},
- {"help", 0, 0, 'h'},
- {0, 0, 0, 0}
- };
-
- c = getopt_long (argc, argv, "vh", long_options, &option_index);
- if (c == -1)
- break;
-
- switch (c)
- {
- case 'v':
- version ();
- exit (1);
- break;
- case 'h':
- usage ();
- exit (1);
- break;
- default:
- break;
- }
- }
-
- if (argc < 2)
- {
- usage();
- exit (1);
- }
- if (argc >= 2)
- hostname = argv[1];
- if (argc >= 3)
- service = argv[2];
-
- proto = getprotobyname ("tcp");
- if (!proto)
- {
- perror ("getprotobyname");
- exit (1);
- }
-
-#ifdef HAVE_GETADDRINFO
- memset (&hints, 0, sizeof (hints));
- hints.ai_family = AF_UNSPEC;
- hints.ai_socktype = SOCK_STREAM;
- hints.ai_protocol = proto->p_proto;
- if (getaddrinfo (hostname, service, &hints, &in) < 0)
- {
- perror ("getaddrinfo");
- exit (1);
- }
- family = in->ai_family;
- socktype = in->ai_socktype;
- addr = in->ai_addr;
- addrlen = in->ai_addrlen;
- freeaddrinfo (in);
-#else
- memset (&sin, 0, sizeof (sin));
- host = gethostbyname (hostname);
- if (!host)
- return -1;
- memcpy (&sin.sin_addr, host->h_addr, host->h_length);
- serv = getservbyname (service, proto->p_name);
- if (serv)
- sin.sin_port = htons (serv->s_port);
- else if (isdigit (service[0]))
- sin.sin_port = htons (atoi (service));
- family = sin.sin_family = AF_INET;
- socktype = SOCK_STREAM;
- addr = (struct sockaddr *)&sin;
- addrlen = sizeof (sin);
-#endif
-
- server = socket (family, socktype, 0);
- if (server == -1)
- {
- perror ("socket");
- exit (1);
- }
-
- setsockopt (server, SOL_SOCKET, SO_REUSEADDR,
- (const char *) &false, sizeof (false));
-
- if (connect (server, addr, addrlen) < 0)
- {
- perror ("connect");
- close (server);
- exit (1);
- }
-
-#ifdef O_NDELAY
- fcntl (server, F_SETFL, O_NDELAY);
-#endif /* O_NDELAY */
-
- /* Connection established. */
-
- readfds = (fd_set *) calloc(server + 1, sizeof (fd_mask));
- writefds = (fd_set *) calloc(server + 1, sizeof (fd_mask));
-
- while (1)
- {
- FD_SET (server, readfds);
- FD_SET (emacsIn, readfds);
- if (select (server+1, readfds, NULL, NULL, NULL) == -1)
- {
- perror ("select");
- exit (1);
- }
- if (FD_ISSET (emacsIn, readfds))
- {
- /* From Emacs */
- nbuffer = read (emacsIn, buffer, sizeof buffer -1);
-
- if (nbuffer == 0)
- goto finish;
- for (retry = buffer; nbuffer > 0; nbuffer -= wret, retry += wret)
- {
- FD_SET (server, writefds);
- if (select (server+1, NULL, writefds, NULL, NULL) == -1)
- {
- perror ("select");
- exit (1);
- }
- wret = write (server, retry, nbuffer);
- if (wret < 0) goto finish;
- }
- }
- if (FD_ISSET (server, readfds))
- {
- /* From NNTP server */
- nbuffer = read (server, buffer, sizeof buffer -1);
- if (nbuffer == 0)
- goto finish;
- for (retry = buffer; nbuffer > 0; nbuffer -= wret, retry += wret)
- {
- FD_SET (emacsOut, writefds);
- if (select (emacsOut+1, NULL, writefds, NULL, NULL) == -1)
- {
- perror ("select");
- exit (1);
- }
- wret = write (emacsOut, retry, nbuffer);
- if (wret < 0) goto finish;
- }
- }
- }
-
- /* End of communication. */
- finish:
- close (server);
- close (emacsIn);
- close (emacsOut);
- exit (0);
-}
+++ /dev/null
-info_TEXINFOS = liece.texi
-liece_TEXINFOS = fdl.texi
-
-package: all
-install-package: package
- $(MAKE) infodir=$(PACKAGEDIR)/info install
+++ /dev/null
-
-@node GNU Free Documentation License
-@appendixsec GNU Free Documentation License
-
-@cindex FDL, GNU Free Documentation License
-@center Version 1.1, March 2000
-
-@display
-Copyright @copyright{} 2000 Free Software Foundation, Inc.
-59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-written document @dfn{free} in the sense of freedom: to assure everyone
-the effective freedom to copy and redistribute it, with or without
-modifying it, either commercially or noncommercially. Secondarily,
-this License preserves for the author and publisher a way to get
-credit for their work, while not being considered responsible for
-modifications made by others.
-
-This License is a kind of ``copyleft'', which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work that contains a
-notice placed by the copyright holder saying it can be distributed
-under the terms of this License. The ``Document'', below, refers to any
-such manual or work. Any member of the public is a licensee, and is
-addressed as ``you''.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section of
-the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall subject
-(or to related matters) and contains nothing that could fall directly
-within that overall subject. (For example, if the Document is in part a
-textbook of mathematics, a Secondary Section may not explain any
-mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License.
-
-The ``Cover Texts'' are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, whose contents can be viewed and edited directly and
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup has been designed to thwart or discourage
-subsequent modification by readers is not Transparent. A copy that is
-not ``Transparent'' is called ``Opaque''.
-
-Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input format,
-@acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML} designed
-for human modification. Opaque formats include PostScript,
-@acronym{PDF}, proprietary formats that can be read and edited only by
-proprietary word processors, @acronym{SGML} or @acronym{XML} for which
-the @acronym{DTD} and/or processing tools are not generally available,
-and the machine-generated @acronym{HTML} produced by some word
-processors for output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, ``Title Page'' means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no other
-conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies of the Document numbering more than 100,
-and the Document's license notice requires Cover Texts, you must enclose
-the copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a publicly-accessible computer-network location containing a complete
-Transparent copy of the Document, free of added material, which the
-general network-using public has access to download anonymously at no
-charge using public-standard network protocols. If you use the latter
-option, you must take reasonably prudent steps, when you begin
-distribution of Opaque copies in quantity, to ensure that this
-Transparent copy will remain thus accessible at the stated location
-until at least one year after the last time you distribute an Opaque
-copy (directly or through your agents or retailers) of that edition to
-the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to give
-them a chance to provide you with an updated version of the Document.
-
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-@enumerate A
-@item
-Use in the Title Page (and on the covers, if any) a title distinct
-from that of the Document, and from those of previous versions
-(which should, if there were any, be listed in the History section
-of the Document). You may use the same title as a previous version
-if the original publisher of that version gives permission.
-
-@item
-List on the Title Page, as authors, one or more persons or entities
-responsible for authorship of the modifications in the Modified
-Version, together with at least five of the principal authors of the
-Document (all of its principal authors, if it has less than five).
-
-@item
-State on the Title page the name of the publisher of the
-Modified Version, as the publisher.
-
-@item
-Preserve all the copyright notices of the Document.
-
-@item
-Add an appropriate copyright notice for your modifications
-adjacent to the other copyright notices.
-
-@item
-Include, immediately after the copyright notices, a license notice
-giving the public permission to use the Modified Version under the
-terms of this License, in the form shown in the Addendum below.
-
-@item
-Preserve in that license notice the full lists of Invariant Sections
-and required Cover Texts given in the Document's license notice.
-
-@item
-Include an unaltered copy of this License.
-
-@item
-Preserve the section entitled ``History'', and its title, and add to
-it an item stating at least the title, year, new authors, and
-publisher of the Modified Version as given on the Title Page. If
-there is no section entitled ``History'' in the Document, create one
-stating the title, year, authors, and publisher of the Document as
-given on its Title Page, then add an item describing the Modified
-Version as stated in the previous sentence.
-
-@item
-Preserve the network location, if any, given in the Document for
-public access to a Transparent copy of the Document, and likewise
-the network locations given in the Document for previous versions
-it was based on. These may be placed in the ``History'' section.
-You may omit a network location for a work that was published at
-least four years before the Document itself, or if the original
-publisher of the version it refers to gives permission.
-
-@item
-In any section entitled ``Acknowledgments'' or ``Dedications'',
-preserve the section's title, and preserve in the section all the
-substance and tone of each of the contributor acknowledgments
-and/or dedications given therein.
-
-@item
-Preserve all the Invariant Sections of the Document,
-unaltered in their text and in their titles. Section numbers
-or the equivalent are not considered part of the section titles.
-
-@item
-Delete any section entitled ``Endorsements''. Such a section
-may not be included in the Modified Version.
-
-@item
-Do not retitle any existing section as ``Endorsements''
-or to conflict in title with any Invariant Section.
-@end enumerate
-
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section entitled ``Endorsements'', provided it contains
-nothing but endorsements of your Modified Version by various
-parties---for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections entitled ``History''
-in the various original documents, forming one section entitled
-``History''; likewise combine any sections entitled ``Acknowledgments'',
-and any sections entitled ``Dedications''. You must delete all sections
-entitled ``Endorsements.''
-
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other documents
-released under this License, and replace the individual copies of this
-License in the various documents with a single copy that is included in
-the collection, provided that you follow the rules of this License for
-verbatim copying of each of the documents in all other respects.
-
-You may extract a single document from such a collection, and distribute
-it individually under this License, provided you insert a copy of this
-License into the extracted document, and follow this License in all
-other respects regarding verbatim copying of that document.
-
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, does not as a whole count as a Modified Version
-of the Document, provided no compilation copyright is claimed for the
-compilation. Such a compilation is called an ``aggregate'', and this
-License does not apply to the other self-contained works thus compiled
-with the Document, on account of their being thus compiled, if they
-are not themselves derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one quarter
-of the entire aggregate, the Document's Cover Texts may be placed on
-covers that surround only the Document within the aggregate.
-Otherwise they must appear on covers around the whole aggregate.
-
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License provided that you also include the
-original English version of this License. In case of a disagreement
-between the translation and the original English version of this
-License, the original English version will prevail.
-
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document except
-as expressly provided for under this License. Any other attempt to
-copy, modify, sublicense or distribute the Document is void, and will
-automatically terminate your rights under this License. However,
-parties who have received copies, or rights, from you under this
-License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-The Free Software Foundation may publish new, revised versions
-of the GNU Free Documentation License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
-
-Each version of the License is given a distinguishing version number.
-If the Document specifies that a particular numbered version of this
-License ``or any later version'' applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation.
-@end enumerate
-
-@page
-@appendixsubsec ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@smallexample
-@group
- Copyright (C) @var{year} @var{your name}.
- Permission is granted to copy, distribute and/or modify this document
- under the terms of the GNU Free Documentation License, Version 1.1
- or any later version published by the Free Software Foundation;
- with the Invariant Sections being @var{list their titles}, with the
- Front-Cover Texts being @var{list}, and with the Back-Cover Texts being @var{list}.
- A copy of the license is included in the section entitled ``GNU
- Free Documentation License''.
-@end group
-@end smallexample
-
-If you have no Invariant Sections, write ``with no Invariant Sections''
-instead of saying which ones are invariant. If you have no
-Front-Cover Texts, write ``no Front-Cover Texts'' instead of
-``Front-Cover Texts being @var{list}''; likewise for Back-Cover Texts.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-
-@c Local Variables:
-@c ispell-local-pdict: "ispell-dict"
-@c End:
-
+++ /dev/null
-\input texinfo @c -*-texinfo-*-
-
-@setfilename liece.info
-
-@set VERSION 1.4.5
-
-@direntry
-* Liece: (liece). The Emacs IRC Client.
-@end direntry
-
-@settitle Liece @value{VERSION}
-
-@ifinfo
-This file describes version @value{VERSION} of the Liece IRC client.
-
-Copyright (C) 2000 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end ifinfo
-
-@tex
-
-@titlepage
-@title Liece
-
-@author by Daiki Ueno
-@page
-
-@vskip 0pt plus 1filll
-Copyright @copyright{} 1998-2002 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end titlepage
-@page
-
-@end tex
-
-@node Top, Prerequisites, (dir), (dir)
-@top Liece
-This file describes version @value{VERSION} of the Liece IRC client.
-
-The IRC (Internet Relay Chat) protocol is for use with text based
-conferencing. The standard is documented separately in RFC 1459, RFC
-2810, RFC 2811, RFC 2812, RFC 2813.
-
-@menu
-* Prerequisites::
-* How to use::
-* Index::
-* Function Index::
-* Variable Index::
-@end menu
-
-@node Prerequisites, How to use, Top, Top
-@chapter Prerequisites
-
-This document assumes that you have already experienced at exploring IRC
-world and that you are familiar with its basic operations.
-
-If you are new to IRC, I recommend that you should look over the FAQ at
-Internet Relay Chat (IRC) Help: @uref{http://www.irchelp.org}.
-
-For Japanese users, IRC users in Japan Home Page
-@uref{http://irc.kyoto-u.ac.jp} also provides useful information in
-cares of living.
-
-@node How to use, Index, Prerequisites, Top
-@chapter How to use
-
-@section Environment
-
-Liece is supposed to run on following Emacsen:
-
-@itemize @bullet
-@item Emacs 20.7 or later
-@item XEmacs 21.4 or later
-@end itemize
-
-This document assumes that you have already obtained and installed them.
-
-@section Settings
-
-To get a try at IRC, you need to add the following line to the end of
-your @file{.emacs} file:
-
-@lisp
-(autoload 'liece "liece" "Begin idling your time away." t)
-@end lisp
-
-If you are using GNU Emacs instead of XEmacs, you also need to add the
-contents of @file{etc/sample.dot.emacs} into @file{~/.liece/init.el}.
-
-By hitting @kbd{M-x liece}, you will be asked which IRC server you attempt to
-connect to and your nickname one after another.
-
-@node Index, Function Index, How to use, Top
-@chapter Index
-@printindex cp
-
-@node Function Index, Variable Index, Index, Top
-@chapter Function Index
-@printindex fn
-
-@node Variable Index, , Function Index, Top
-@chapter Variable Index
-@printindex vr
-
-@summarycontents
-@contents
-@bye
-
-@c End:
+++ /dev/null
-! -*- mode: xrdb; coding: euc-jp -*-
-!
-! XEmacs ¤Ç¤ÏÆüËܸì¥á¥Ë¥å¡¼¤òɽ¼¨²Äǽ¤Ç¤¹¤¬¡¢Emacs Lisp ¤Î¥³¡¼¥É¤ÇÆüËܸìʸ»úÎó¤ò
-! »ØÄꤷ¤Æ¤âÀµ¤·¤¯É½¼¨¤Ç¤¤Þ¤»¤ó¡£¤·¤«¤· X ¤Î¥ê¥½¡¼¥¹¤Ë°Ê²¼¤Î¤è¤¦¤Êµ½Ò¤òÄɲä¹
-! ¤ë¤³¤È¤Ç¡¢Liece ¤Î¥á¥Ë¥å¡¼¤òÆüËܸ첽¤¹¤ë¤³¤È¤¬¤Ç¤¤Þ¤¹¡£
-! ¶ñÂÎŪ¤Ë¤Ï¡¢°Ê²¼¤ÎÆâÍƤò locale ¥Ñ¥Ã¥±¡¼¥¸¤ËÉÕ°¤Î¥ê¥½¡¼¥¹¥Õ¥¡¥¤¥ë¤Ë½ñ¤²Ã¤¨¤Þ
-! ¤¹¡£XEmacs ¤òɸ½àŪ¤Ë¥¤¥ó¥¹¥È¡¼¥ë¤·¤Æ¤¤¤ì¤Ð¡¢¤³¤Î¥Õ¥¡¥¤¥ë¤Ï
-!
-! /usr/local/lib/xemacs/mule-packages/etc/app-defaults/ja/Emacs
-!
-! ¤Ë¤¢¤ë¤³¤È¤¬Í½ÁÛ¤µ¤ì¤Þ¤¹¡£¤Þ¤¿¡¢°Ê²¼¤Î³Æ¹Ô¤Ë "XEmacs" ¤È¤¤¤¦ prefix ¤òÉÕ¤±¤Æ¡¢
-! ~/.Xresources ¤Ë½ñ¤¤³¤à¡¢¤È¤¤¤¦¼ê¤â¤¢¤ë¤Ç¤·¤ç¤¦¡£
-
-*XlwMenu.sendFile.labelString: ¥Õ¥¡¥¤¥ë¤òÁ÷¿®
-*XlwMenu.receiveFile.labelString: ¥Õ¥¡¥¤¥ë¤ò¼õ¿®
-*XlwMenu.sendChatRequest.labelString: DCC CHATÍ×µá
-*XlwMenu.acceptChatRequest.labelString: DCC CHAT³«»Ï
-*XlwMenu.listDCCRequest.labelString: DCCÍ×µá°ìÍ÷
-*XlwMenu.dispatchStackedDCCRequests.labelString: DCCÍ×µá¤ò¾å¤«¤é½ç¤Ë½èÍý
-*XlwMenu.crypt.labelString: °Å¹æ²½
-*XlwMenu.toggleCryptMode.labelString: °Å¹æ²½ÀÚÂØ
-*XlwMenu.setDefaultKeyOfThisChannel.labelString: ÈëÌ©¸°¤ÎÀßÄê
-*XlwMenu.setDefaultKeyForThisChannel.labelString: ÈëÌ©¸°¤ÎÀßÄê
-*XlwMenu.addNewKeyToKeyring.labelString: ÈëÌ©¸°¤ÎÄɲÃ
-*XlwMenu.removeKeyFromKeyring.labelString: ÈëÌ©¸°¤Îºï½ü
-*XlwMenu.private.labelString: ¸Ä¿ÍŪ
-*XlwMenu.togglePrivateConversation.labelString: 1ÂÐ1²ñÏÃ
-*XlwMenu.registerFriends.labelString: ͧ¿ÍÅÐÏ¿¤ÎÄɲÃ
-*XlwMenu.unregisterFriends.labelString: ͧ¿ÍÅÐÏ¿¤Îºï½ü
-*XlwMenu.displayUserhost.labelString: ¥æ¡¼¥¶¥Û¥¹¥È̾¤Îɽ¼¨
-*XlwMenu.ignoreNicksRegexp.labelString: ¥Ë¥Ã¥¯/Àµµ¬É½¸½¤ò̵»ë
-*XlwMenu.composeMail.labelString: ¥á¡¼¥ë¤ò½ñ¤¯
-*XlwMenu.channel.labelString: ¥Á¥ã¥ó¥Í¥ë
-*XlwMenu.joinChannel.labelString: ¥Á¥ã¥ó¥Í¥ë¤Ë»²²Ã
-*XlwMenu.partChannel.labelString: ¥Á¥ã¥ó¥Í¥ë¤òΥæ
-*XlwMenu.goToNextChannel.labelString: ¼¡¤Î¥Á¥ã¥ó¥Í¥ë
-*XlwMenu.goToPreviousChannel.labelString: Á°¤Î¥Á¥ã¥ó¥Í¥ë
-*XlwMenu.goToUnreadChannel.labelString: ̤ÆÉ¥Á¥ã¥ó¥Í¥ë
-*XlwMenu.rotateLeftChannels.labelString: ¥Á¥ã¥ó¥Í¥ë°ìÍ÷¤òº¸²ó¤ê¤Ë²óž
-*XlwMenu.rotateRightChannels.labelString: ¥Á¥ã¥ó¥Í¥ë°ìÍ÷¤ò±¦²ó¤ê¤Ë²óž
-*XlwMenu.inviteToThisChannel.labelString: ¤³¤Î¥Á¥ã¥ó¥Í¥ë¤Ë¾·ÂÔ
-*XlwMenu.kickOutFromThisChannel.labelString: ¤³¤Î¥Á¥ã¥ó¥Í¥ë¤«¤é½³¤ê½Ð¤¹
-*XlwMenu.setModeOfThisChannel.labelString: ¥Á¥ã¥ó¥Í¥ë¥â¡¼¥É¤ÎÀßÄê
-*XlwMenu.setTopicOfThisChannel.labelString: ¥Á¥ã¥ó¥Í¥ë¥È¥Ô¥Ã¥¯¤ÎÀßÄê
-*XlwMenu.toggleFreezeOfThisChannel.labelString: ¤³¤Î¥Á¥ã¥ó¥Í¥ë¤Î¸ÇÄê
-*XlwMenu.toggleOwnFreezeOfThisChannel.labelString: ¤³¤Î¥Á¥ã¥ó¥Í¥ë¤Î°ì»þ¸ÇÄê
-*XlwMenu.toggleBeepNoticeOfThisChannel.labelString: ¤³¤Î¥Á¥ã¥ó¥Í¥ë¤Î¥Ó¡¼¥×ÄÌÃÎ
-*XlwMenu.listChannel.labelString: ¥Á¥ã¥ó¥Í¥ë°ìÍ÷¤òɽ¼¨
-*XlwMenu.displayNamesOfChannel.labelString: ¥á¥ó¥Ð¤Îɽ¼¨(¥Ë¥Ã¥¯¥Í¡¼¥à¤Î¤ß)
-*XlwMenu.displayWhoAreOnTheChannel.labelString: ¥á¥ó¥Ð¤Îɽ¼¨
-*XlwMenu.loadVariablesFile.labelString: ÀßÄê¤ÎÆɹþ
-*XlwMenu.saveVariablesFile.labelString: ÀßÄê¤ÎÊݸ
-*XlwMenu.changeWindowStyle.labelString: ¥¦¥£¥ó¥É¥¦¥¹¥¿¥¤¥ë¤ÎÊѹ¹
-*XlwMenu.reloadStyleFile.labelString: ¥¦¥£¥ó¥É¥¦¥¹¥¿¥¤¥ë¤ÎºÆÆɹþ
-*XlwMenu.reconfigureWindows.labelString: ¥¦¥£¥ó¥É¥¦ºÆÇÛÃÖ
-*XlwMenu.toggleChannelBufferDisplayState.labelString: ¥Á¥ã¥ó¥Í¥ë¥Ð¥Ã¥Õ¥¡¤Îɽ¼¨ÀÚÂØ
-*XlwMenu.toggleNickBufferDisplayState.labelString: ¥Ë¥Ã¥¯¥Ð¥Ã¥Õ¥¡¤Îɽ¼¨ÀÚÂØ
-*XlwMenu.enterDebugMode.labelString: ¥Ç¥Ð¥Ã¥°¥â¡¼¥É
-*XlwMenu.quitIRC.labelString: IRC¤ò¤ä¤á¤ë
-
+++ /dev/null
-SUBDIRS = icons po styles
-
-EXTRA_DIST = gnu-emacs-user-config.in
-DISTCLEANFILES = gnu-emacs-user-config
-noinst_DATA = gnu-emacs-user-config
-gnu-emacs-user-config: gnu-emacs-user-config.in
- sed 's!@pkgdatadir@!$(pkgdatadir)!g' $< > $@
- chmod +x $@
-
-package:
-install-package: package
- $(MAKE) pkgdatadir=$(PACKAGEDIR)/etc/$(PACKAGE) install
+++ /dev/null
-#!/bin/sh
-
-# Copyright (C) 2002 Daiki Ueno
-#
-# This file is part of Liece.
-
-# This program 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.
-
-# This program 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.
-
-# Prepare user settings for GNU Emacs.
-# If you are using XEmacs, you don't need to run this script.
-
-EMACS=${EMACS-emacs}
-
-custom=`cat <<'EOF'
-(custom-set-variables
- '(liece-intl-catalogue-directory "@pkgdatadir@/locale" nil (liece)
- "Default location of Liece message catalogs.")
- '(liece-window-style-directory "@pkgdatadir@/styles" nil (liece)
- "Default location of Liece style files.")
- '(liece-icon-directory "@pkgdatadir@/icons" nil (liece)
- "Default location of Liece icon files."))
-EOF`
-
-$EMACS -eval "$custom" -l cus-edit -f Custom-save -f kill-emacs
+++ /dev/null
-icondir = $(pkgdatadir)/icons
-icon_DATA = $(wildcard *.xpm)
-EXTRA_DIST = $(icon_DATA)
\ No newline at end of file
+++ /dev/null
-/* XPM */
-static char *back[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooelooooooooooooo",
-"ooooooooooooeudooooooooooooo",
-"oooooooooooeuocloooooooooooo",
-"ooooooooooeuoecboooooooooooo",
-"oooooooooeuoeocblooooooooooo",
-"ooooooooeuoeoecfdooooooooooo",
-"oooooooeuoeoeocffloooooooooo",
-"ooooooeuoeoeoeoeoboooooooooo",
-"oooooeuoeoeoeoeoedbooooooooo",
-"oooohuoeoeoeoeoeoffooooooooo",
-"oooohueoeoeoeoeoeffooooooooo",
-"ooooocdddddddddddfbooooooooo",
-"oooooochcdcdcccccfbooooooooo",
-"ooooooochchccccccbdooooooooo",
-"oooooooochchcccccblooooooooo",
-"ooooooooochcccffffoooooooooo",
-"ooooooolllchccbbbdlllloooooo",
-"oooooooolllbhcbblllllllooooo",
-"oooooooooollbhbblllllloooooo",
-"ooooooooooollbbllllooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char * ball_blank_xpm[] = {
-"12 12 1 1",
-" c None",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * ball_gray_xpm[] = {
-"12 12 10 1",
-" c None",
-". c #000000",
-"+ c #999999",
-"@ c #666666",
-"# c #FFFFFF",
-"$ c #CCCCCC",
-"% c #888888",
-"& c #555555",
-"* c #BBBBBB",
-"= c #333333",
-" .... ",
-" .+++@. ",
-" .+#$%@&. ",
-" .+*#*%@&=. ",
-" .++++@&==. ",
-" .+++@@&=.. ",
-" .@@@@&==.. ",
-" .@@&&==... ",
-" .====.=. ",
-" .=.... ",
-" .... ",
-" "};
+++ /dev/null
-/* XPM */
-static char * ball_red_xpm[] = {
-"12 12 6 1",
-" c None",
-". c #000000",
-"+ c #FF9999",
-"@ c #FF3333",
-"# c #FFFFFF",
-"$ c #660000",
-" ",
-" .... ",
-" .+++@. ",
-" .+#+@@$. ",
-" .++#++@@$. ",
-" .@+@+@$$$. ",
-" .+@+@@@$.. ",
-" .@@@@$$$.. ",
-" .@@$@$$... ",
-" .$$$$.$. ",
-" .$.... ",
-" .... "};
+++ /dev/null
-/* XPM */
-static char * balloon_xpm[] = {
-"12 12 4 1",
-" c None",
-". c #000000",
-"+ c #FFFFFF",
-"@ c #808080",
-" ...... ",
-" ..++++.. ",
-" .++++++++. ",
-".++@@@@@@++.",
-".++++++++++.",
-".++@@@@@@++.",
-".++++++++++.",
-".++@@@@@@++.",
-" .++++++++. ",
-" .++++++. ",
-" .+++... ",
-" ..... "};
+++ /dev/null
-/* XPM */
-static char *crypt[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooijiiinooooooo",
-"ooooooooooooooiouokkiioooooo",
-"oooooooooooooikkjiiksioooooo",
-"oooooooooooooik.oooik.oooooo",
-"oooooooooooooikjooornjoooooo",
-"oooooooooooooik#ooon..oooooo",
-"oooooiiniiiiijkijooooooooooo",
-"ooooi#n.kkkkin.ji#oooooooooo",
-"ooooiaooouuookki#.oooooooooo",
-"ooooikokkkkkkkii#.oooooooooo",
-"ooooimommmmmmmmi#.oooooooooo",
-"ooooikokkkkkkkki#.oooooooooo",
-"ooooimommmmmmmji#.lllllooooo",
-"ooooikokkkkkkkki#.iiillooooo",
-"ooooimommmmmmjjj#.lilooooooo",
-"ooooikkkkkkkkkki#.lloooooooo",
-"oooooiijjjjj.....ooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *encrypt[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 19 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #003438",
-"b c #008000",
-"c c #008080",
-"d c #00fc00",
-"e c #202020",
-"f c #303060",
-"g c #4098a0",
-"h c #6064c8",
-"i c #808000",
-"j c #808080",
-"k c #9898f8",
-"l c #c0c0c0 s backgroundToolBarColor",
-"m c #e8e8e8",
-"n c #f86430",
-"s c #f864c8",
-"p c #f8fc00",
-"q c #f8fcf8",
-/* pixels */
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllppppppllllllllllll",
-"llllllllpphhhhhpplllllllllll",
-"lllllllpphqqllkhfpllllllllll",
-"lllllllphql###lkhfplllllllll",
-"lllllllphqepll#lheplllllllll",
-"lllllllphlepll#kheplllllllll",
-"llllllpphleppp#kheppllllllll",
-"lllllppehkhjhffkhefpllllllll",
-"lllllphkhffkkkkefhh.plllllll",
-"lllllphklqqqllllkhf.plllllll",
-"lllllphkqhhhhhhhhef.plllllll",
-"lllllphkqlllllllkhf.plllllll",
-"lllllphkqhhhhhhhhff.plllllll",
-"lllllphkqlllllllkhf.plllllll",
-"lllllphkqhhhhhhhhef.jjjjjlll",
-"lllllphkqlllllllkhf.phhjllll",
-"lllllphkhhhhhhhhhf#.jpllllll",
-"lllllpph#fffffefe..pppllllll",
-"llllllppppppppppppplllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll",
-"llllllllllllllllllllllllllll"
-};
+++ /dev/null
-/* XPM */
-static char *forward[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooedhooooooooooooooooo",
-"ooooooooeechoooooooooooooooo",
-"oooooooohuochooooooooooooooo",
-"oooooooohoeochoooooooooooooo",
-"oooooooohuoeochooooooooooooo",
-"oooooooohoeoeochoooooooooooo",
-"ooooeeeeeuoeoeoccooooooooooo",
-"oooohououoeoeoeodcoooooooooo",
-"oooohueeoeoeoeoeodcooooooooo",
-"oooohoeoeoeoeoeoeodcoooooooo",
-"oooohueeoeoeoeoeoecdoooooooo",
-"oooohodddddddddddbbdoooooooo",
-"oooohuchchccccccbbdooooooooo",
-"ooooeohchccccccbbdoooooooooo",
-"ooooeechchccccbbdooooooooooo",
-"oooocbbbbhcccbbdlllllllooooo",
-"oooooooochccbgdllllllloooooo",
-"ooooolllchcbgdlllllooooooooo",
-"oooooollccbgdllloooooooooooo",
-"ooooooollbgdoooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *home[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooooooooooungioooooooo",
-"ooooooooooonnnnnungioooooooo",
-"oooooooooooiiiiiongioooooooo",
-"ooooooooooiuiiiiongioooooooo",
-"oooooooooifguiiiongioooooooo",
-"ooooooooifinguiiinggoooooooo",
-"oooooooifinoniuiiigigooooooo",
-"ooooooifinononioiiigiioooooo",
-"oooooiginonononioiiiigiooooo",
-"ooooiginonononongoiiiiiioooo",
-"oooigfnononononongnffgggoooo",
-"oooooiononiigsononibbgiooooo",
-"oooooononoiiilnonoifggoooooo",
-"ooooooononiiilononiggioooooo",
-"oooooononoiiisnonoigiioooooo",
-"ooooooononiigsononiinioooooo",
-"oooooononoigglnonoiniioooooo",
-"oooohhononggglononinlhoooooo",
-"oollchnhnonkkrkkilhllhlooooo",
-"oollchclllkkrkllhhhchhhhhooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *icons[] = {
-/* width height num_colors chars_per_pixel */
-" 454 29 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #c0c0c0",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"poooooooooooooooooooooooooelooooooooooooooooooooooooooooooooooooooooooedhooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooiiiiiiiiiiilooooooooooooooooooo",
-"pooooooooooooooooooooooooeudooogggggooooooooooooooooooooooooooooooooooeechoooooogggggooooooooooooooooooooooooooooooooooiiiiiiiigoooooooooooooooooooooooooooooooooooooooooooooooooooungiooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooniiigoooooogggggooooooooooooooooooooooooooooooooooooouuuuuuuuuloooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooonllnlnlnlnligooooooooooooooooooo",
-"poooooooooooooooooooooooeuoclooogggooooooooooooooooooooooooooooooooooohuochoooooogggooooooooooooooooooooooooooooooooooiuininiif#ggoooooooooooooooooooooooooooooooooooooooooooonnnnnungiooooooooooooooooooooooooooooooooooooooooooouououoooooooooooooooooooooooooooooooooooooonuoigooooooogggoooooooooooooooooooooooooooooooooooooouuuouououloooooooooooooooooooooooooooooooooooooooooooooooijiiinooooooooooooooooooooooooooooooooooogninnlg.glolol...goooooooooooooooo",
-"pooooooooooooooooooooooeuoecboooogoooooooooooooooooooooooooooooooooooohoeochoooooogooooooooooooooooooooooooooooooooooiunnnnnifff#ggoooooooooooooooooooooooooooooooooooooooooooiiiiiongioooooooooooooooooooooooooooooooooooooooooouououououooooooooooooooooooooooooooooooooooonogigoooooooogooooooooooooooooooooooooooooooooooooooouuuuououulooooooooooooooooooooooooooooooooooooooooooooooiouokkiioooooooooooooooooooooooooooooooooogoioljjjj.lnogli.goooooooooooooooo",
-"poooooooooooooooooooooeuoeocbloooooooooooooooooooooooooooooooooooooooohuoeochooooooooooooooooooooooooooooooooooooiuoooononononnniffgoooooooooooooooooooooooooooooooooooooooooiuiiiiongiooooooooooooooooooooooooooooooooooooooooououuuuuuuouooooooooooooooooooooooooooooooooonoggi.oooooooooooooooooooooooooooooooooooooooooooooooouuuuuuuuuloooooooooooooooooooooooooooooooooooooooooooooikkjiiksiooooooooooooooooooooooooooooooooooogiojjqjjg.loli.j.oooooooooooooooo",
-"pooooooooooooooooooooeuoeoecfdoooooooooooooooooooooooooooooooooooooooohoeoeochooooooooooooooooooooooooooooooooooooiuoonononononfffggooooooooooooooooooooooooooooooooooooooooifguiiiongioooooooooooooooooooooooooooooooooooooooououuuuuuuottoooooooooooooooooooooooooooooooonogggi.oooooooooooooooooooooooooooooooooooooooooooooooouuuuuuuuulggingooooooooooooooooooooooooooooooooooooooooik.oooik.ooooooooooooooooooooooooooooooooooogiooqqqjg.noiojjooooooooooooooooo",
-"poooooooooooooooooooeuoeoeocffloooooooooooooooooooooooooooooooooooeeeeeuoeoeoccooooooooooooooooooooooooooooooooooooiuoononononfg##ggoooooooooooooooooooooooooooooooooooooooifinguiiinggooooooooooooooooooooooooooooooooooooooooouuuutuuuttouoooooooooooooooooooooooooooooonogiggi.oooooooooooooooooooooooooooooooooooooooooooooooouoooooooolgingoooooooooooooooooooooooooooooooooooooooooikjooornjooooooooooooooooooooooooooooooooooooioooqqjg.lolgjjooooooooooooooooo",
-"pooooooooooooooooooeuoeoeoeoeobooooooooooooooooooooooooooooooooooohououoeoeoeodcooooooooooooooooooooooooooooooooooooiuooooooifg###ggooooooooooooooooooooooooooooooooooooooifinoniuiiigigooooooooooooooooooooooooooooooooooooooouooootttutouoooooooooooooooooooooooooooooonoiigggi.ooooooooooooooooooooooooooooooooooooooooooooooooououououlgingooooooooooooooooooooooooooooooooooooooooooik#ooon..ooooooooooooooooooooooooooooooooooooionoqjf.fnoigojooooooooooooooooo",
-"poooooooooooooooooeuoeoeoeoeoedboooooooooooooooooooooooooooooooooohueeoeoeoeoeodcooooooooooooooooooooooooooooooooooooiuooooifg####ggoooooooooooooooooooooooooooooooooooooifinononioiiigiiooooooooooooooooooooooooooooooooooooooniiiintttuuouoooooooooooooooooooooooooooonunigig.igggiiiiiiiooooooooooooooooooooooooooooooooooooonououououoliggoooooooooooooooooooooooooooooooooooiiniiiiijkijoooooooooooooooooooooooooooooooooooooooglionnffffilogggggoooooooooooooooo",
-"poooooooooooooooohuoeoeoeoeoeoffoooooooooooooooooooooooooooooooooohoeoeoeoeoeoeodcooooooooooooooooooooooooooooooooooooiuooifgi####ggooooooooooooooooooooooooooooooooooooiginonononioiiiigioooooooooooooooooooooooooooooooooooooinoiifntuuuuooooooooooooooooooooooooooooonuniigg.noooooooooogooooooooooooooooooooooooooooooooooiinnniiiiiiiiiiggiooooooooooooooooooooooooooooooooi#n.kkkkin.ji#oooooooooooooooooooooooooooooooooooooognion....ignoili.goooooooooooooooo",
-"poooooooooooooooohueoeoeoeoeoeffoooooooooooooooooooooooooooooooooohueeoeoeoeoeoecdoooooooooooooooooooooooooooooooooooooiuifgoi####ggoooooooooooooooooooooooooooooooooooiginonononongoiiiiiioooooooooooooooooooooooooooooooooooinoniigfotutouoooooooooooooooooooooooooooonunigi.iinnnnnnnnnnogooooooooooooooooooooooooooooooooiuuoouonniiinniggiiooooooooooooooooooooooooooooooooiaooouuookki#.ooooooooooooooooooooooooooooooooooooooogiolggiiggloli.ggoooooooooooooooo",
-"pooooooooooooooooocdddddddddddfboooooooooooooooooooooooooooooooooohodddddddddddbbdoooooooooooooooooooooooooooooooooooooogggooi###fggooooooooooooooooooooooooooooooooooigfnononononongnffgggooooooooooooooooooooooooooooooooggofiiiggigoutuuooooooooooooooooooooooooooooonuiii.niinnnnnnnnnnngooooooooooooooooooooooooooooooooiooooouuuuoniiggigiooooooooooooooooooooooooooooooooikokkkkkkkii#.ooooooooooooooooooooooooooooooooooooooooio.llggggnoioggooooooooooooooooo",
-"poooooooooooooooooochcdcdcccccfboooooooooooooooooooooooooooooooooohuchchccccccbbdooooooooooooooooooooooooooooooooooooooooooooi###fggolooooooooooooooooooooooooooooooooooiononiigsononibbgioooooooooooooooooooooooooooooooofoiiooggggigottouoooooooooooooooooooooooooooooigg..ioiinnnnnnnnnnngooooooooooooooooooooooooooooooooionooooooooooogggiiglooooooooooooooooooooooooooooooimommmmmmmmi#.ooooooooooooooooooooooooooooooooooooooooio.llggfllolgggooooooooooooooooo",
-"pooooooooooooooooooochchccccccbdooooooooooooooooooooooooooooooooooeohchccccccbbdooooooooooooooooooooooooooooooooooooooooooooonn#ffggolloooooooooooooooooooooooooooooooooononoiiilnonoifggoooooooooooooooooooooooooooooooooiinoongfgfgiouououoooooooooooooooooooooooooooooooooioiinnnnnnnnnngoooooooooooooooooooooooooooooooooionnnnnnnnnnnngggigfggoooooooooooooooooooooooooooooikokkkkkkkki#.oooooooooooooooooooooooooooooooooooooognionlggggnlolggg.oooooooooooooooo",
-"poooooooooooooooooooochchcccccblooooooooooooooooooooooooooooooooooeechchccccbbdoooooooooooooooooooooooooooooooooooooonnnnnnnnnif#fgglllooooooooooooooooooooooooooooooooooononiiilononiggiooooooooooooooooooooooooooooooooinooniigffgiluououooooooooooooooooooooooooooooooooooioigggggggggggooooooooooooooooooooooooooooooooooionnononononnnggiggfgloooooooooooooooooooooooooooooimommmmmmmji#.lllllooooooooooooooooooooooooooooooooogniol....flnogli.goooooooooooooooo",
-"pooooooooooooooooooooochcccffffooooooooooooooooooooooooooooooooooocbbbbhcccbbdllllllloooooooooooooooooooooooooooooooonnnnnnnnnifffggiiooooooooooooooooooooooooooooooooooononoiiisnonoigiiooooooooooooooooooooooooooooooiiooniiigfillloonlnlnoooooooooooooooooooooooooooooooooioig.oooooooooooooooooooooooooooooooooooooooooooiinononononecnggggfglooooooooooooooooooooooooooooooikokkkkkkkki#.iiillooooooooooooooooooooooooooooooooolgio.ffff.gloii.ggoooooooooooooooo",
-"pooooooooooooooooooolllchccbbbdllllooooooooooooooooooooooooooooooooooochccbgdlllllllooooooooooooooooooooooooooooooooonininininiifgigiloooooooooooooooooooooooooooooooooooononiigsononiinioooooooooooooooooooooooooooooinoniiigfiooooonillllloooooooooooooooooooooooooooooooooioiggligigiiiillooooooooooooooooooooooooooooooooolliiiiiiiiinngggfgloooooooooooooooooooooooooooooooimommmmmmjjj#.liloooooooooooooooooooooooooooooooooooogio.gggfg.noilggooooooooooooooooo",
-"poooooooooooooooooooolllbhcbblllllllooooooooooooooooooooooooooooooolllchcbgdlllllooooooooooooooooooooooooooooooooooooniiiiiiiiiiiigillooooooooooooooooooooooooooooooooooononoigglnonoiniioooooooooooooooooooooooooooooggiiigfiooooniiiiiillnoooooooooooooooooooooooooooooooooioiggigigigilllooooooooooooooooooooooooooooooooooooooolliigggggffglooooooooooooooooooooooooooooooooikkkkkkkkkki#.llooooooooooooooooooooooooooooooooooooooiooggfgf.loigggllloooooooooooooo",
-"poooooooooooooooooooooollbhbbllllllooooooooooooooooooooooooooooooooollccbgdlllooooooooooooooooooooooooooooooooooooooooniiggggg#gggilloooooooooooooooooooooooooooooooooohhononggglononinlhoooooooooooooooooooooooooooooiggigillonliiillnooooooooooooooooooooooooooooooooooooooioiggliloooooooooooooooooooooooooooooooooooooooooooooooooooolgfgooooooooooooooooooooooooooooooooooooiijjjjj.....oooooooooooooooooooooooooooooooooooooooooinnnfffglnlifllllooooooooooooooo",
-"pooooooooooooooooooooooollbbllllooooooooooooooooooooooooooooooooooooollbgdooooooooooooooooooooooooooooooooooooooooooooooolllllllllllooooooooooooooooooooooooooooooooollchnhnonkkrkkilhllhloooooooooooooooooooooooooooonfgflllllllnoooooooooooooooooooooooooooooooooooooooooooioigllooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooogggiiiiigi.llloooooooooooooooo",
-"poooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooollchclllkkrkllhhhchhhhhoooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *icons[] = {
-/* width height num_colors chars_per_pixel */
-" 454 29 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #c0c0c0",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"pppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppppp",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"poooooooooooooooooooooooooelooooooooooooooooooooooooooooooooooooooooooedhooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooiiiiiiiiiiilooooooooooooooooooo",
-"pooooooooooooooooooooooooeudooogggggooooooooooooooooooooooooooooooooooeechoooooogggggooooooooooooooooooooooooooooooooooiiiiiiiigoooooooooooooooooooooooooooooooooooooooooooooooooooungiooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooniiigoooooogggggooooooooooooooooooooooooooooooooooooouuuuuuuuuloooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooonllnlnlnlnligooooooooooooooooooo",
-"poooooooooooooooooooooooeuoclooogggooooooooooooooooooooooooooooooooooohuochoooooogggooooooooooooooooooooooooooooooooooiuininiif#ggoooooooooooooooooooooooooooooooooooooooooooonnnnnungiooooooooooooooooooooooooooooooooooooooooooouououoooooooooooooooooooooooooooooooooooooonuoigooooooogggoooooooooooooooooooooooooooooooooooooouuuouououloooooooooooooooooooooooooooooooooooooooooooooooijiiinooooooooooooooooooooooooooooooooooogninnlg.glolol...goooooooooooooooo",
-"pooooooooooooooooooooooeuoecboooogoooooooooooooooooooooooooooooooooooohoeochoooooogooooooooooooooooooooooooooooooooooiunnnnnifff#ggoooooooooooooooooooooooooooooooooooooooooooiiiiiongioooooooooooooooooooooooooooooooooooooooooouououououooooooooooooooooooooooooooooooooooonogigoooooooogooooooooooooooooooooooooooooooooooooooouuuuououulooooooooooooooooooooooooooooooooooooooooooooooiouokkiioooooooooooooooooooooooooooooooooogoioljjjj.lnogli.goooooooooooooooo",
-"poooooooooooooooooooooeuoeocbloooooooooooooooooooooooooooooooooooooooohuoeochooooooooooooooooooooooooooooooooooooiuoooononononnniffgoooooooooooooooooooooooooooooooooooooooooiuiiiiongiooooooooooooooooooooooooooooooooooooooooououuuuuuuouooooooooooooooooooooooooooooooooonoggi.oooooooooooooooooooooooooooooooooooooooooooooooouuuuuuuuuloooooooooooooooooooooooooooooooooooooooooooooikkjiiksiooooooooooooooooooooooooooooooooooogiojjqjjg.loli.j.oooooooooooooooo",
-"pooooooooooooooooooooeuoeoecfdoooooooooooooooooooooooooooooooooooooooohoeoeochooooooooooooooooooooooooooooooooooooiuoonononononfffggooooooooooooooooooooooooooooooooooooooooifguiiiongioooooooooooooooooooooooooooooooooooooooououuuuuuuottoooooooooooooooooooooooooooooooonogggi.oooooooooooooooooooooooooooooooooooooooooooooooouuuuuuuuulggingooooooooooooooooooooooooooooooooooooooooik.oooik.ooooooooooooooooooooooooooooooooooogiooqqqjg.noiojjooooooooooooooooo",
-"poooooooooooooooooooeuoeoeocffloooooooooooooooooooooooooooooooooooeeeeeuoeoeoccooooooooooooooooooooooooooooooooooooiuoononononfg##ggoooooooooooooooooooooooooooooooooooooooifinguiiinggooooooooooooooooooooooooooooooooooooooooouuuutuuuttouoooooooooooooooooooooooooooooonogiggi.oooooooooooooooooooooooooooooooooooooooooooooooouoooooooolgingoooooooooooooooooooooooooooooooooooooooooikjooornjooooooooooooooooooooooooooooooooooooioooqqjg.lolgjjooooooooooooooooo",
-"pooooooooooooooooooeuoeoeoeoeobooooooooooooooooooooooooooooooooooohououoeoeoeodcooooooooooooooooooooooooooooooooooooiuooooooifg###ggooooooooooooooooooooooooooooooooooooooifinoniuiiigigooooooooooooooooooooooooooooooooooooooouooootttutouoooooooooooooooooooooooooooooonoiigggi.ooooooooooooooooooooooooooooooooooooooooooooooooououououlgingooooooooooooooooooooooooooooooooooooooooooik#ooon..ooooooooooooooooooooooooooooooooooooionoqjf.fnoigojooooooooooooooooo",
-"poooooooooooooooooeuoeoeoeoeoedboooooooooooooooooooooooooooooooooohueeoeoeoeoeodcooooooooooooooooooooooooooooooooooooiuooooifg####ggoooooooooooooooooooooooooooooooooooooifinononioiiigiiooooooooooooooooooooooooooooooooooooooniiiintttuuouoooooooooooooooooooooooooooonunigig.igggiiiiiiiooooooooooooooooooooooooooooooooooooonououououoliggoooooooooooooooooooooooooooooooooooiiniiiiijkijoooooooooooooooooooooooooooooooooooooooglionnffffilogggggoooooooooooooooo",
-"poooooooooooooooohuoeoeoeoeoeoffoooooooooooooooooooooooooooooooooohoeoeoeoeoeoeodcooooooooooooooooooooooooooooooooooooiuooifgi####ggooooooooooooooooooooooooooooooooooooiginonononioiiiigioooooooooooooooooooooooooooooooooooooinoiifntuuuuooooooooooooooooooooooooooooonuniigg.noooooooooogooooooooooooooooooooooooooooooooooiinnniiiiiiiiiiggiooooooooooooooooooooooooooooooooi#n.kkkkin.ji#oooooooooooooooooooooooooooooooooooooognion....ignoili.goooooooooooooooo",
-"poooooooooooooooohueoeoeoeoeoeffoooooooooooooooooooooooooooooooooohueeoeoeoeoeoecdoooooooooooooooooooooooooooooooooooooiuifgoi####ggoooooooooooooooooooooooooooooooooooiginonononongoiiiiiioooooooooooooooooooooooooooooooooooinoniigfotutouoooooooooooooooooooooooooooonunigi.iinnnnnnnnnnogooooooooooooooooooooooooooooooooiuuoouonniiinniggiiooooooooooooooooooooooooooooooooiaooouuookki#.ooooooooooooooooooooooooooooooooooooooogiolggiiggloli.ggoooooooooooooooo",
-"pooooooooooooooooocdddddddddddfboooooooooooooooooooooooooooooooooohodddddddddddbbdoooooooooooooooooooooooooooooooooooooogggooi###fggooooooooooooooooooooooooooooooooooigfnononononongnffgggooooooooooooooooooooooooooooooooggofiiiggigoutuuooooooooooooooooooooooooooooonuiii.niinnnnnnnnnnngooooooooooooooooooooooooooooooooiooooouuuuoniiggigiooooooooooooooooooooooooooooooooikokkkkkkkii#.ooooooooooooooooooooooooooooooooooooooooio.llggggnoioggooooooooooooooooo",
-"poooooooooooooooooochcdcdcccccfboooooooooooooooooooooooooooooooooohuchchccccccbbdooooooooooooooooooooooooooooooooooooooooooooi###fggolooooooooooooooooooooooooooooooooooiononiigsononibbgioooooooooooooooooooooooooooooooofoiiooggggigottouoooooooooooooooooooooooooooooigg..ioiinnnnnnnnnnngooooooooooooooooooooooooooooooooionooooooooooogggiiglooooooooooooooooooooooooooooooimommmmmmmmi#.ooooooooooooooooooooooooooooooooooooooooio.llggfllolgggooooooooooooooooo",
-"pooooooooooooooooooochchccccccbdooooooooooooooooooooooooooooooooooeohchccccccbbdooooooooooooooooooooooooooooooooooooooooooooonn#ffggolloooooooooooooooooooooooooooooooooononoiiilnonoifggoooooooooooooooooooooooooooooooooiinoongfgfgiouououoooooooooooooooooooooooooooooooooioiinnnnnnnnnngoooooooooooooooooooooooooooooooooionnnnnnnnnnnngggigfggoooooooooooooooooooooooooooooikokkkkkkkki#.oooooooooooooooooooooooooooooooooooooognionlggggnlolggg.oooooooooooooooo",
-"poooooooooooooooooooochchcccccblooooooooooooooooooooooooooooooooooeechchccccbbdoooooooooooooooooooooooooooooooooooooonnnnnnnnnif#fgglllooooooooooooooooooooooooooooooooooononiiilononiggiooooooooooooooooooooooooooooooooinooniigffgiluououooooooooooooooooooooooooooooooooooioigggggggggggooooooooooooooooooooooooooooooooooionnononononnnggiggfgloooooooooooooooooooooooooooooimommmmmmmji#.lllllooooooooooooooooooooooooooooooooogniol....flnogli.goooooooooooooooo",
-"pooooooooooooooooooooochcccffffooooooooooooooooooooooooooooooooooocbbbbhcccbbdllllllloooooooooooooooooooooooooooooooonnnnnnnnnifffggiiooooooooooooooooooooooooooooooooooononoiiisnonoigiiooooooooooooooooooooooooooooooiiooniiigfillloonlnlnoooooooooooooooooooooooooooooooooioig.oooooooooooooooooooooooooooooooooooooooooooiinononononecnggggfglooooooooooooooooooooooooooooooikokkkkkkkki#.iiillooooooooooooooooooooooooooooooooolgio.ffff.gloii.ggoooooooooooooooo",
-"pooooooooooooooooooolllchccbbbdllllooooooooooooooooooooooooooooooooooochccbgdlllllllooooooooooooooooooooooooooooooooonininininiifgigiloooooooooooooooooooooooooooooooooooononiigsononiinioooooooooooooooooooooooooooooinoniiigfiooooonillllloooooooooooooooooooooooooooooooooioiggligigiiiillooooooooooooooooooooooooooooooooolliiiiiiiiinngggfgloooooooooooooooooooooooooooooooimommmmmmjjj#.liloooooooooooooooooooooooooooooooooooogio.gggfg.noilggooooooooooooooooo",
-"poooooooooooooooooooolllbhcbblllllllooooooooooooooooooooooooooooooolllchcbgdlllllooooooooooooooooooooooooooooooooooooniiiiiiiiiiiigillooooooooooooooooooooooooooooooooooononoigglnonoiniioooooooooooooooooooooooooooooggiiigfiooooniiiiiillnoooooooooooooooooooooooooooooooooioiggigigigilllooooooooooooooooooooooooooooooooooooooolliigggggffglooooooooooooooooooooooooooooooooikkkkkkkkkki#.llooooooooooooooooooooooooooooooooooooooiooggfgf.loigggllloooooooooooooo",
-"poooooooooooooooooooooollbhbbllllllooooooooooooooooooooooooooooooooollccbgdlllooooooooooooooooooooooooooooooooooooooooniiggggg#gggilloooooooooooooooooooooooooooooooooohhononggglononinlhoooooooooooooooooooooooooooooiggigillonliiillnooooooooooooooooooooooooooooooooooooooioiggliloooooooooooooooooooooooooooooooooooooooooooooooooooolgfgooooooooooooooooooooooooooooooooooooiijjjjj.....oooooooooooooooooooooooooooooooooooooooooinnnfffglnlifllllooooooooooooooo",
-"pooooooooooooooooooooooollbbllllooooooooooooooooooooooooooooooooooooollbgdooooooooooooooooooooooooooooooooooooooooooooooolllllllllllooooooooooooooooooooooooooooooooollchnhnonkkrkkilhllhloooooooooooooooooooooooooooonfgflllllllnoooooooooooooooooooooooooooooooooooooooooooioigllooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooogggiiiiigi.llloooooooooooooooo",
-"poooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooollchclllkkrkllhhhchhhhhoooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo",
-"pooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char * mini_lock_xpm[] = {
-"22 22 4 1",
-" c None s backgroundToolBarColor",
-". c #82077DF77DF7",
-"X c #000000000000",
-"o c #FFFFFFFFFFFF",
-" ",
-" ",
-" ",
-" ",
-" .XXX. ",
-" .ooo.X ",
-" ..oXXXo.. ",
-" XoX...XoX ",
-" XoX. XoX. ",
-" XoX. XoX. ",
-" XXXXXXXXXXX ",
-" X X. ",
-" X ....... X. ",
-" X ooooooo X. ",
-" X ....... X. ",
-" X X. ",
-" XXXXXXXXXXX. ",
-" ........... ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-#define irchat-pointer_width 18
-#define irchat-pointer_height 13
-static unsigned char irchat-pointer_bits[] = {
- 0x00, 0x00, 0xfc, 0x00, 0x70, 0xfc, 0x00, 0x70, 0xfc, 0x00, 0xbc, 0xfc,
- 0x00, 0x3f, 0xfc, 0x00, 0x06, 0xfc, 0x40, 0x03, 0xfc, 0x88, 0x00, 0xfc,
- 0xfc, 0x00, 0xfd, 0xf2, 0x83, 0xfd, 0x94, 0xff, 0xfc, 0x00, 0x3e, 0xfc,
- 0x00, 0x00, 0xfc};
+++ /dev/null
-/* XPM */
-static char * irchat_pointer_xpm[] = {
-"18 13 58 1",
-" c None",
-". c #943D51",
-"+ c #8F243B",
-"@ c #943E51",
-"# c #84132C",
-"$ c #6A031A",
-"% c #99364C",
-"& c #9B3D52",
-"* c #8E1731",
-"= c #72031C",
-"- c #670319",
-"; c #993E52",
-"> c #AC324D",
-", c #981632",
-"' c #81041F",
-") c #77031D",
-"! c #82162E",
-"~ c #9A3D51",
-"{ c #951834",
-"] c #9E3C52",
-"^ c #A73750",
-"/ c #973D51",
-"( c #A73E55",
-"_ c #AB2B47",
-": c #9A1130",
-"< c #8B0422",
-"[ c #8F0F2A",
-"} c #9F2B44",
-"| c #89384A",
-"1 c #943F51",
-"2 c #A74056",
-"3 c #A2364E",
-"4 c #88112A",
-"5 c #76031D",
-"6 c #750820",
-"7 c #993248",
-"8 c #923D50",
-"9 c #933F52",
-"0 c #954154",
-"a c #9F4156",
-"b c #A04156",
-"c c #9F4256",
-"d c #9D3C51",
-"e c #7E172E",
-"f c #5F0317",
-"g c #590316",
-"h c #70192C",
-"i c #8C3146",
-"j c #92394D",
-"k c #8F394C",
-"l c #7F3041",
-"m c #923E51",
-"n c #983E51",
-"o c #8E3045",
-"p c #701D30",
-"q c #66192A",
-"r c #772839",
-"s c #8F3A4D",
-" ",
-" .+@ ",
-" #$% ",
-" &*=-; ",
-" >,')!~ ",
-" {] ",
-" ^/ ",
-" ( ",
-" _:<[}| 1 ",
-" 2 345678 90 ",
-" abc defghijklm ",
-" nopqrs ",
-" "};
+++ /dev/null
-/* XPM */
-static char *location[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooniiigoooooooooooooooo",
-"ooooooonuoigoooooooooooooooo",
-"ooooooonogigoooooooooooooooo",
-"oooooonoggi.oooooooooooooooo",
-"ooooonogggi.oooooooooooooooo",
-"oooonogiggi.oooooooooooooooo",
-"ooonoiigggi.oooooooooooooooo",
-"oonunigig.igggiiiiiiiooooooo",
-"oonuniigg.noooooooooogoooooo",
-"oonunigi.iinnnnnnnnnnogooooo",
-"oonuiii.niinnnnnnnnnnngooooo",
-"ooigg..ioiinnnnnnnnnnngooooo",
-"oooooooioiinnnnnnnnnngoooooo",
-"oooooooioigggggggggggooooooo",
-"oooooooioig.oooooooooooooooo",
-"oooooooioiggligigiiiillooooo",
-"oooooooioiggigigigillloooooo",
-"oooooooioigglilooooooooooooo",
-"oooooooioigllooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *naruto_blank_xpm[] = {
-/* width height num_colors chars_per_pixel */
-" 16 16 2 1",
-/* colors */
-". c #000000",
-"# c None",
-/* pixels */
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################",
-"################"
-};
+++ /dev/null
-/* XPM */
-static char *naruto_gray_xpm[] = {
-/* width height num_colors chars_per_pixel */
-" 16 16 4 1",
-/* colors */
-". c None",
-"# c #fffab5",
-"a c #8e8e8e",
-"b c #000000",
-/* pixels */
-".......#####....",
-".......#####....",
-"......#aaaab##..",
-"......#aaaab##..",
-"...####aaaab###.",
-"...####aaaab###.",
-"###aaaaaaaaaaaa#",
-"###aaaaaaaaaaaa#",
-"...####aaaab###.",
-"...####aaaab###.",
-"......#aaaab##..",
-"......#aaaab##..",
-"......#aaaab##..",
-"......#aaaab##..",
-"......#aaaab##..",
-"......#aaaab##.."
-};
+++ /dev/null
-/* XPM */
-static char * naruto_red_xpm[] = {
-"16 16 97 2",
-" c None",
-". c #0F0F0F",
-"+ c #363636",
-"@ c #434343",
-"# c #232323",
-"$ c #000000",
-"% c #333333",
-"& c #EAEAEA",
-"* c #4A4A4A",
-"= c #555555",
-"- c #212121",
-"; c #393939",
-"> c #F6F6F6",
-", c #FFFFFF",
-"' c #E7E7E7",
-") c #F3F3F3",
-"! c #FFFAFA",
-"~ c #F0EAEA",
-"{ c #D1D1D1",
-"] c #444444",
-"^ c #7A7A7A",
-"/ c #FFFCFC",
-"( c #FFC2C2",
-"_ c #FFA3A3",
-": c #FFAAAA",
-"< c #FFC6C6",
-"[ c #E4E4E4",
-"} c #030303",
-"| c #565656",
-"1 c #E4E2E2",
-"2 c #FFD4D4",
-"3 c #B9B9B9",
-"4 c #0D0D0D",
-"5 c #AEAEAE",
-"6 c #FFC8C8",
-"7 c #FFCDCD",
-"8 c #5E5E5E",
-"9 c #929292",
-"0 c #FDF9F9",
-"a c #FFA1A1",
-"b c #FFFEFE",
-"c c #FFD7D7",
-"d c #FFCCCC",
-"e c #FFF8F8",
-"f c #B5B5B5",
-"g c #141414",
-"h c #7E6161",
-"i c #FFD1D1",
-"j c #FFB9B9",
-"k c #FFD3D3",
-"l c #FFA2A2",
-"m c #DFDFDF",
-"n c #818181",
-"o c #101010",
-"p c #E2C7C7",
-"q c #FFBFBF",
-"r c #FFEAEA",
-"s c #FFF9F9",
-"t c #FFCECE",
-"u c #525252",
-"v c #ACACAC",
-"w c #FFFDFD",
-"x c #FFA0A0",
-"y c #9E9E9E",
-"z c #606060",
-"A c #FFE0E0",
-"B c #FFA7A7",
-"C c #FFF3F3",
-"D c #FFDADA",
-"E c #FEFEFE",
-"F c #323232",
-"G c #020202",
-"H c #282828",
-"I c #656565",
-"J c #FFE9E9",
-"K c #FFC3C3",
-"L c #FFF7F7",
-"M c #ABABAB",
-"N c #1F1F1F",
-"O c #898989",
-"P c #383838",
-"Q c #999999",
-"R c #B3B3B3",
-"S c #040404",
-"T c #2B2B2B",
-"U c #FBFBFB",
-"V c #7B7B7B",
-"W c #070707",
-"X c #CDCDCD",
-"Y c #DDDDDD",
-"Z c #0C0C0C",
-"` c #191919",
-" . c #C7C7C7",
-".. c #2D2D2D",
-"+. c #1B1B1B",
-"@. c #DEDEDE",
-"#. c #131313",
-" . ",
-" + @ # $ % & * # = - ",
-" ; > , ' ) ! ~ { , , ] ",
-" ^ / ( _ : : < , [ } ",
-" | 1 : 2 , , , , , 3 } ",
-"4 5 , 6 7 , , , , , , , ' 8 ",
-" 9 0 a b , b c d e , , , , f g ",
-" h ( , , i j k l ! , , m n . ",
-" o p q , , r s , t i , u ",
-" v w x ! , , , , t i , y ",
-"z , , A B C , w D _ ! , E F ",
-"G H I , J B _ _ K L , , , M ",
-" N , , , > , , , O P Q R S ",
-" T , U V W X , Y Z ",
-" ` ... +.@.; ",
-" S #. "};
+++ /dev/null
-/* XPM */
-static char *pindown[] = {
-/* width height num_colors chars_per_pixel */
-" 16 16 4 1",
-/* colors */
-". c #000000",
-"# c #c0c0c0",
-"a c #ffffff s backgroundToolBarColor",
-"b c #808080",
-/* pixels */
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaa....aaaa",
-"aaaaaa..#a#a.aaa",
-"aaaa...#a#a#b.aa",
-"aaaa.a.a#a#ab.aa",
-"aaa.a#.#a#ab..aa",
-"aaa.#a.b#abb..aa",
-"aaa.b#b......aaa",
-"aaa.bbbbb....aaa",
-"aaaa.bbb....baaa",
-"aaaa.......baaaa",
-"aaa.bb...bbaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa",
-"aaaaaaaaaaaaaaaa"
-};
+++ /dev/null
-/* XPM */
-static char *print[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooouuuuuuuuulooooooooo",
-"ooooooooouuuouououlooooooooo",
-"ooooooooouuuuououulooooooooo",
-"ooooooooouuuuuuuuulooooooooo",
-"ooooooooouuuuuuuuulggingoooo",
-"ooooooooouoooooooolgingooooo",
-"oooooooooououououlgingoooooo",
-"ooooooonououououoliggooooooo",
-"oooooiinnniiiiiiiiiiggiooooo",
-"ooooiuuoouonniiinniggiiooooo",
-"ooooiooooouuuuoniiggigiooooo",
-"ooooionooooooooooogggiiglooo",
-"ooooionnnnnnnnnnnngggigfggoo",
-"ooooionnononononnnggiggfgloo",
-"ooooiinononononecnggggfglooo",
-"ooooolliiiiiiiiinngggfgloooo",
-"oooooooooolliigggggffglooooo",
-"oooooooooooooooolgfgoooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *reload[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooiiiiiiiigooooooooooo",
-"oooooooiuininiif#ggooooooooo",
-"ooooooiunnnnnifff#ggoooooooo",
-"ooiuoooononononnniffgooooooo",
-"oooiuoonononononfffggooooooo",
-"ooooiuoononononfg##ggooooooo",
-"oooooiuooooooifg###ggooooooo",
-"ooooooiuooooifg####ggooooooo",
-"oooooooiuooifgi####ggooooooo",
-"ooooooooiuifgoi####ggooooooo",
-"ooooooooogggooi###fggooooooo",
-"ooooooooooooooi###fggolooooo",
-"oooooooooooooonn#ffggolloooo",
-"oooooonnnnnnnnnif#fggllloooo",
-"oooooonnnnnnnnnifffggiiooooo",
-"oooooonininininiifgigilooooo",
-"ooooooniiiiiiiiiiiigillooooo",
-"oooooooniiggggg#gggilloooooo",
-"oooooooooolllllllllllooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *search[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooooooooouououoooooooo",
-"oooooooooooooouououououooooo",
-"ooooooooooooououuuuuuuouoooo",
-"oooooooooooououuuuuuuottoooo",
-"ooooooooooooouuuutuuuttouooo",
-"oooooooooooouooootttutouoooo",
-"ooooooooooooniiiintttuuouooo",
-"ooooooooooooinoiifntuuuuoooo",
-"oooooooooooinoniigfotutouooo",
-"ooooooooggofiiiggigoutuuoooo",
-"ooooooofoiiooggggigottouoooo",
-"oooooooiinoongfgfgiouououooo",
-"ooooooinooniigffgiluououoooo",
-"ooooiiooniiigfillloonlnlnooo",
-"oooinoniiigfiooooonilllllooo",
-"oooggiiigfiooooniiiiiillnooo",
-"oooiggigillonliiillnoooooooo",
-"ooonfgflllllllnooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-/* XPM */
-static char *stop[] = {
-/* width height num_colors chars_per_pixel */
-" 28 28 23 1",
-/* colors */
-". c #000000",
-"# c #000080",
-"a c #0000f8",
-"b c #003438",
-"c c #008000",
-"d c #008080",
-"e c #00fc00",
-"f c #202020",
-"g c #303060",
-"h c #4098a0",
-"i c #6064c8",
-"j c #800000",
-"k c #808000",
-"l c #808080",
-"m c #980060",
-"n c #9898f8",
-"o c #b2b2b2 s backgroundToolBarColor",
-"p c #e8e8e8",
-"q c #f80000",
-"r c #f86430",
-"s c #f864c8",
-"t c #f8fc00",
-"u c #f8fcf8",
-/* pixels */
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"ooooooooiiiiiiiiiiiloooooooo",
-"ooooooonllnlnlnlnligoooooooo",
-"ooooogninnlg.glolol...gooooo",
-"ooooogoioljjjj.lnogli.gooooo",
-"oooooogiojjqjjg.loli.j.ooooo",
-"oooooogiooqqqjg.noiojjoooooo",
-"oooooooioooqqjg.lolgjjoooooo",
-"oooooooionoqjf.fnoigojoooooo",
-"oooooglionnffffilogggggooooo",
-"ooooognion....ignoili.gooooo",
-"oooooogiolggiiggloli.ggooooo",
-"oooooooio.llggggnoioggoooooo",
-"oooooooio.llggfllolgggoooooo",
-"ooooognionlggggnlolggg.ooooo",
-"ooooogniol....flnogli.gooooo",
-"ooooolgio.ffff.gloii.ggooooo",
-"oooooogio.gggfg.noilggoooooo",
-"oooooooiooggfgf.loiggglllooo",
-"oooooooinnnfffglnliflllloooo",
-"ooooooooogggiiiiigi.lllooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo",
-"oooooooooooooooooooooooooooo"
-};
+++ /dev/null
-localedir = $(pkgdatadir)/locale
-
-pofiles = $(wildcard *.po)
-mofiles = $(pofiles:%.po=%.mo)
-
-EXTRA_DIST = $(pofiles)
-
-all: $(mofiles)
-%.mo: %.po
- msgfmt -o $@ $<
-
-install-data-local: $(mofiles)
- @$(NORMAL_INSTALL)
- $(mkinstalldirs) $(DESTDIR)$(localedir)
- @list='$(mofiles)'; for p in $$list; do \
- lang=`basename $$p | sed s/\.mo//`; \
- $(mkinstalldirs) $(DESTDIR)$(localedir)/$$lang; \
- $(mkinstalldirs) $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES; \
- if test -f $(srcdir)/$$p; then \
- echo " $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/liece.mo"; \
- $(INSTALL_DATA) $(srcdir)/$$p $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/liece.mo; \
- else if test -f $$p; then \
- echo " $(INSTALL_DATA) $$p $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/liece.mo"; \
- $(INSTALL_DATA) $$p $(DESTDIR)$(localedir)/$$lang/LC_MESSAGES/liece.mo; \
- fi; fi; \
- done
+++ /dev/null
-# Copyright (C) 1998-2002 Daiki Ueno
-# Daiki Ueno <ueno@unixuser.org>
-#
-msgid ""
-msgstr ""
-"Project-Id-Version: Liece 1.4.7\n"
-"PO-Revision-Date: 1998-12-30 18:09 +0900\n"
-"Last-Translator: Daiki Ueno <ueno@unixuser.org>\n"
-"Language-Team: Daiki Ueno <ueno@unixuser.org>\n"
-"MIME-Version: 1.0\n"
-"Content-Type: text/plain; charset=euc-japan\n"
-"Content-Transfer-Encoding: 8bit\n"
-
-msgid " (%d min)"
-msgstr " (%d ʬ)"
-
-msgid " \\(has\\|have\\) joined channel %s"
-msgstr " ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤Ë»²²Ã¤·¤Þ¤·¤¿"
-
-msgid " \\(has\\|have\\) left IRC%s"
-msgstr " ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤òÈ´¤±¤Þ¤·¤¿"
-
-msgid " \\(has\\|have\\) left channel %s%s"
-msgstr " ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤òÈ´¤±¤Þ¤·¤¿%s"
-
-msgid " expired"
-msgstr "´ü¸Â¤¬ÀÚ¤ì¤Þ¤·¤¿"
-
-msgid "%d sec"
-msgstr "%d ÉÃ"
-
-msgid "%s (%s) has joined channel %s\n"
-msgstr "%s (%s) ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤Ë»²²Ã¤·¤Þ¤·¤¿\n"
-
-msgid "%s Handshaking with %s (class: %s)\n"
-msgstr "%s %s (¥¯¥é¥¹ %s) ¤È¥Ï¥ó¥É¥·¥§¥¤¥¯¤ò¹Ô¤Ã¤Æ¤¤¤Þ¤¹\n"
-
-msgid "%s Trying to connect to %s (class %s)\n"
-msgstr "%s %s (¥¯¥é¥¹ %s) ¤ËÀܳ¤ò»î¤ß¤Æ¤¤¤Þ¤¹\n"
-
-msgid "%s error (%s %s %s) is %s\n"
-msgstr "%s ¥¨¥é¡¼ (%s %s %s) ¤Ï %s\n"
-
-msgid "%s has come back as (%s)\n"
-msgstr "%s ¤¬ (%s) ¤È¤·¤ÆÌá¤ê¤Þ¤·¤¿\n"
-
-msgid "%s has come back\n"
-msgstr "%s ¤¬Ìá¤ê¤Þ¤·¤¿\n"
-
-msgid "%s has left IRC%s\n"
-msgstr " ¤Ï IRC ¤ò¤ä¤á¤Þ¤·¤¿%s\n"
-
-msgid "%s has left channel %s%s\n"
-msgstr "%s ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤òÈ´¤±¤Þ¤·¤¿%s\n"
-
-msgid "%s is now known as %s\n"
-msgstr "%s ¤Ï %s ¤Ë¥Ë¥Ã¥¯¥Í¡¼¥à¤òÊѤ¨¤Þ¤·¤¿\n"
-
-msgid "%s%s (%s) has joined channel %s\n"
-msgstr "%s%s (%s) ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤Ë»²²Ã¤·¤Þ¤·¤¿\n"
-
-msgid "%s%s has left IRC%s\n"
-msgstr "%s%s ¤Ï IRC ¤ò¤ä¤á¤Þ¤·¤¿%s\n"
-
-msgid "%s%s has left channel %s%s\n"
-msgstr "%s%s ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤òÈ´¤±¤Þ¤·¤¿%s\n"
-
-msgid "%sNew mode for %s set by %s: %s\n"
-msgstr "%s%s ¤Ë %s ¤Ë¤è¤Ã¤Æ¿·¤·¤¤¥â¡¼¥É¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿: %s\n"
-
-msgid "(%d) %s request %s: %s (%s bytes)"
-msgstr "(%d) %s ¥ê¥¯¥¨¥¹¥È %s: %s (%s ¥Ð¥¤¥È)"
-
-msgid "(%d) %s request from %s"
-msgstr "(%1$d) %3$s ¤«¤é %2$s ¥ê¥¯¥¨¥¹¥È"
-
-msgid ", %s (%s) have joined channel %s"
-msgstr ", %s (%s) ¤¬¥Á¥ã¥ó¥Í¥ë %s ¤Ë»²²Ã¤·¤Þ¤·¤¿"
-
-msgid ", %s have left IRC%s"
-msgstr ", %s ¤Ï IRC ¤ò¤ä¤á¤Þ¤·¤¿%s"
-
-msgid ", %s have left channel %s%s"
-msgstr ", %s ¤Ï¥Á¥ã¥ó¥Í¥ë %s ¤òÈ´¤±¤Þ¤·¤¿%s"
-
-msgid "A private message has arrived from %s"
-msgstr "%s ¤«¤é¥×¥é¥¤¥Ù¡¼¥È¥á¥Ã¥»¡¼¥¸¤¬ÆϤ¤¤Æ¤¤¤Þ¤¹"
-
-msgid "Allow to speak: "
-msgstr "ï¤Ëȯ¸À¤òµö¤·¤Þ¤¹¤«: "
-
-msgid "Assign operational privilege to: "
-msgstr "ï¤Ë¥ª¥Ú¥ì¡¼¥¿¸¢¸Â¤òÍ¿¤¨¤Þ¤¹¤«: "
-
-msgid "Ban pattern: "
-msgstr "ban ¥Ñ¥¿¡¼¥ó: "
-
-msgid "Cannot connect to IRC server."
-msgstr "IRC ¥µ¡¼¥Ð¤ËÀܳ¤Ç¤¤Þ¤»¤ó"
-
-msgid "Channel"
-msgstr "¥Á¥ã¥ó¥Í¥ë"
-
-msgid "Channel/User: "
-msgstr "¥Á¥ã¥ó¥Í¥ë¤Þ¤¿¤Ï¥æ¡¼¥¶: "
-
-msgid "Channels: %s\n"
-msgstr "¥Á¥ã¥ó¥Í¥ë: %s\n"
-
-msgid "Chat connection established with: %s"
-msgstr "%s ¤È¤Î¥Á¥ã¥Ã¥ÈÀܳ¤¬³ÎΩ¤·¤Þ¤·¤¿"
-
-msgid "Chat connection with %s finished"
-msgstr "%s ¤È¤Î¥Á¥ã¥Ã¥ÈÀܳ¤ò½ªÎ»¤·¤Þ¤·¤¿"
-
-msgid "Chatting with %s"
-msgstr "%s ¤È¥Á¥ã¥Ã¥ÈÃæ"
-
-msgid "Connecting to IRC server on %s..."
-msgstr "%s ¤Î IRC ¥µ¡¼¥Ð¤ËÀܳÃæ..."
-
-msgid "Connecting to: %s"
-msgstr "%s ¤ËÀܳÃæ"
-
-msgid "Connection closed. (%s)"
-msgstr "Àܳ¤¬ÀÚ¤ì¤Þ¤·¤¿¡£(%s)"
-
-msgid "Connection to %s timed out"
-msgstr "%s ¤Ø¤ÎÀܳ¤¬¥¿¥¤¥à¥¢¥¦¥È¤·¤Þ¤·¤¿"
-
-msgid "Couldn't figure out what was said."
-msgstr "²¿¤ò¸À¤Ã¤Æ¤¤¤ë¤Î¤«¤ï¤«¤ê¤Þ¤»¤ó"
-
-msgid "Currently ignoring:"
-msgstr "¸½ºß¤¢¤Ê¤¿¤¬Ìµ»ë¤·¤Æ¤¤¤ë¤Î¤Ï:"
-
-msgid "DCC No chat request has been arrived."
-msgstr "DCC ¤Î¥Á¥ã¥Ã¥È¥ê¥¯¥¨¥¹¥È¤ÏÆϤ¤¤Æ¤¤¤Þ¤»¤ó"
-
-msgid "DCC No request has been arrived."
-msgstr "DCC ¥ê¥¯¥¨¥¹¥È¤ÏÆϤ¤¤Æ¤¤¤Þ¤»¤ó"
-
-msgid "DCC No send request has been arrived."
-msgstr "DCC ¤Î¥Õ¥¡¥¤¥ëÁ÷¿®¥ê¥¯¥¨¥¹¥È¤ÏÆϤ¤¤Æ¤¤¤Þ¤»¤ó"
-
-msgid "DCC chat has not been started."
-msgstr "DCC ¥Á¥ã¥Ã¥È¤Ï»Ï¤Þ¤Ã¤Æ¤¤¤Þ¤»¤ó"
-
-msgid "DCC directory does not exist. Create it? "
-msgstr "DCC ¥Ç¥£¥ì¥¯¥È¥ê¤¬¤¢¤ê¤Þ¤»¤ó¡£ºî¤ê¤Þ¤¹¤«? "
-
-msgid "Divest operational privilege from: "
-msgstr "狼¤é¥ª¥Ú¥ì¡¼¥¿¸¢¸Â¤òÃ¥¤¤¤Þ¤¹¤«: "
-
-msgid "Do you really query LIST without argument?"
-msgstr "ËÜÅö¤Ë°ú¿ô¤ò»ØÄꤻ¤º¤Ë LIST ¤òÌ䤤¹ç¤ï¤»¤Þ¤¹¤«?"
-
-msgid "Do you really query NAMES without argument?"
-msgstr "ËÜÅö¤Ë°ú¿ô¤ò»ØÄꤻ¤º¤Ë NAMES ¤òÌ䤤¹ç¤ï¤»¤Þ¤¹¤«?"
-
-msgid "Do you really query WHO without argument?"
-msgstr "ËÜÅö¤Ë°ú¿ô¤ò»ØÄꤻ¤º¤Ë WHO ¤òÌ䤤¹ç¤ï¤»¤Þ¤¹¤«?"
-
-msgid "Empty CLIENT version notice from \"%s\"."
-msgstr "\"%s\" ¤«¤é¶õ¤Î¥¯¥é¥¤¥¢¥ó¥È¥Ð¡¼¥¸¥ç¥ó¤¬ÄÌÃΤµ¤ì¤Þ¤·¤¿"
-
-msgid "End private conversation with: "
-msgstr "ï¤È¤Î²ñÏäò½ªÎ»¤·¤Þ¤¹¤«: "
-
-msgid "Enter your nickname: "
-msgstr "¥Ë¥Ã¥¯¥Í¡¼¥à¤òÆþÎϤ·¤Æ¤¯¤À¤µ¤¤: "
-
-msgid "Erroneous nickname %s. Choose a new one with %s."
-msgstr "%s ¤ÏÉÔÀµ¤Ê¥Ë¥Ã¥¯¥Í¡¼¥à¤Ç¤¹¡£%s ¤Ç¿·¤·¤¤¥Ë¥Ã¥¯¥Í¡¼¥à¤òÁª¤ó¤Ç²¼¤µ¤¤"
-
-msgid "File to send: "
-msgstr "Á÷¿®¤¹¤ë¥Õ¥¡¥¤¥ë: "
-
-msgid "Finger whom: "
-msgstr "ï¤òÄ´¤Ù¤Þ¤¹¤«: "
-
-msgid "Following people are now off: %s\n"
-msgstr "%s ¤Ï¸½ºß¥ª¥Õ¥é¥¤¥ó¾õÂ֤Ǥ¹\n"
-
-msgid "Following people are now on: %s\n"
-msgstr "%s ¤Ï¸½ºß¥ª¥ó¥é¥¤¥ó¾õÂ֤Ǥ¹\n"
-
-msgid "Following people are on: %s\n"
-msgstr "%s ¤Ï¥ª¥ó¥é¥¤¥ó¾õÂ֤Ǥ¹\n"
-
-msgid "Forbid to speak: "
-msgstr "ï¤Îȯ¸À¤ò¶Ø»ß¤·¤Þ¤¹¤«: "
-
-msgid "Friend"
-msgstr "ͧ¿Í"
-
-msgid "Getting file from %s: %s (%s bytes)"
-msgstr "%s ¤«¤é¥Õ¥¡¥¤¥ë %s ¤ò¼èÆÀ¤·¤Æ¤¤¤Þ¤¹¡£(%s ¥Ð¥¤¥È)"
-
-msgid "IRC server: "
-msgstr "IRC ¥µ¡¼¥Ð: "
-
-msgid "Ignore nickname or regexp: "
-msgstr "̵»ë¤¹¤ë¥Ë¥Ã¥¯¥Í¡¼¥à¤Þ¤¿¤ÏÀµµ¬É½¸½: "
-
-msgid "Ignore timeout for %s expired.\n"
-msgstr "»þ´ÖÀÚ¤ì¤Î¤¿¤á %s ¤ò̵»ë¤¹¤ë¤Î¤Ï¤ä¤á¤Þ¤·¤¿\n"
-
-msgid "Ignoring %s"
-msgstr "%s ¤ò̵»ë¤·¤Þ¤¹"
-
-msgid "Invite channel: "
-msgstr "¤É¤Î¥Á¥ã¥ó¥Í¥ë¤Ë¸Æ¤Ó¤Þ¤¹¤«: "
-
-msgid "Invite whom: "
-msgstr "ï¤ò¸Æ¤Ó¤Þ¤¹¤«: "
-
-msgid "Inviting user %s to channel %s\n"
-msgstr "¥æ¡¼¥¶ %s ¤ò¥Á¥ã¥ó¥Í¥ë %s ¤Ë¸Æ¤ó¤Ç¤¤¤Þ¤¹\n"
-
-msgid "Inviting user %s\n"
-msgstr "¥æ¡¼¥¶ %s ¤ò¸Æ¤ó¤Ç¤¤¤Þ¤¹\n"
-
-msgid "Join channel: "
-msgstr "»²²Ã¤¹¤ë¥Á¥ã¥ó¥Í¥ë: "
-
-msgid "Key for channel %s: "
-msgstr "¥Á¥ã¥ó¥Í¥ë %s ¤Î¹ç¸ÀÍÕ: "
-
-msgid "Kick Message: "
-msgstr "¥¥Ã¥¯¥á¥Ã¥»¡¼¥¸: "
-
-msgid "Kick out nickname: "
-msgstr "¥¥Ã¥¯¤¹¤ë¥Ë¥Ã¥¯¥Í¡¼¥à: "
-
-msgid "LIST channel: "
-msgstr "LIST ¤òÌ䤤¹ç¤ï¤»¤ë¥Á¥ã¥ó¥Í¥ë: "
-
-msgid "Machine %s is running IRC version %s (%s)\n"
-msgstr "¥Þ¥·¥ó %s ¤Ç¤Ï¥Ð¡¼¥¸¥ç¥ó %s (%s) ¤Î IRC ¥µ¡¼¥Ð¤¬Æ°¤¤¤Æ¤¤¤Þ¤¹\n"
-
-msgid "Malformed ignore-list, no msg+str function."
-msgstr "̯¤Ê ignore-list ¤Ç¤¹¡£¥á¥Ã¥»¡¼¥¸¤Èʸ»úÎó¤ò°ú¿ô¤Ë¤È¤ë´Ø¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó"
-
-msgid "Malformed ignore-list, no user function."
-msgstr "̯¤Ê ignore-list ¤Ç¤¹¡£¥æ¡¼¥¶ÄêµÁ¤Î´Ø¿ô¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó"
-
-msgid "Mode for %s is %s%s\n"
-msgstr "%s ¤Î¥â¡¼¥É¤Ï %s%s\n"
-
-msgid "Mode for channel %s [%s]: "
-msgstr "¥Á¥ã¥ó¥Í¥ë %s ¤Î¥â¡¼¥É [%s]: "
-
-msgid "Mode for user %s [%s]: "
-msgstr "¥æ¡¼¥¶ %s ¤Î¥â¡¼¥É [%s]: "
-
-msgid "Mode for you is %s\n"
-msgstr "¤¢¤Ê¤¿¤Î¥â¡¼¥É¤Ï %s ¤Ç¤¹\n"
-
-msgid "Names on channel: "
-msgstr "NAMES ¤òÌ䤤¹ç¤ï¤»¤ë¥Á¥ã¥ó¥Í¥ë: "
-
-msgid "New mode for %s set by %s: %s\n"
-msgstr "%s ¤Ë % ¤Ë¤è¤Ã¤Æ¿·¤·¤¤¥â¡¼¥É¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿: %s\n"
-
-msgid "New topic on channel %s set by %s: %s\n"
-msgstr "¥Á¥ã¥ó¥Í¥ë %s ¤Ë %s ¤Ë¤è¤Ã¤Æ¿·¤·¤¤¥È¥Ô¥Ã¥¯¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿: %s\n"
-
-msgid "Nickname %s already in use. Choose a new one with %s."
-msgstr "¥Ë¥Ã¥¯¥Í¡¼¥à %s ¤Ï´û¤Ë»ÈÍѤµ¤ì¤Æ¤¤¤Þ¤¹¡£%s ¤Ç¿·¤·¤¤¥Ë¥Ã¥¯¥Í¡¼¥à¤òÁª¤ó¤Ç²¼¤µ¤¤"
-
-msgid "No DCC request here"
-msgstr "DCC ¥ê¥¯¥¨¥¹¥È¤Ï¤¢¤ê¤Þ¤»¤ó"
-
-msgid "No channel"
-msgstr "¥Á¥ã¥ó¥Í¥ë¤Ê¤·"
-
-msgid "No longer ignoring: %s.\n"
-msgstr "%s ¤ò̵»ë¤¹¤ë¤Î¤ò¤ä¤á¤Þ¤·¤¿\n"
-
-msgid "No one you requested is on now.\n"
-msgstr "¤ß¤ó¤Ê¥ª¥Õ¥é¥¤¥ó¾õÂ֤Ǥ¹\n"
-
-msgid "No partner"
-msgstr "¥Á¥ã¥Ã¥ÈÁê¼ê¤¬¤¤¤Þ¤»¤ó"
-
-msgid "No such user %s"
-msgstr "¤½¤Î¤è¤¦¤Ê¥æ¡¼¥¶ %s ¤Ï¤¤¤Þ¤»¤ó"
-
-msgid "No text to send"
-msgstr "Á÷¤ëʸ¾Ï¤¬¤¢¤ê¤Þ¤»¤ó"
-
-msgid "No topic is set\n"
-msgstr "¥È¥Ô¥Ã¥¯¤ÏÀßÄꤵ¤ì¤Æ¤¤¤Þ¤»¤ó\n"
-
-msgid "No unread channel or chat partner."
-msgstr "̤ÆɤΥÁ¥ã¥ó¥Í¥ë¤Þ¤¿¤Ï¥Á¥ã¥Ã¥ÈÁê¼ê¤Ï¤¤¤Þ¤»¤ó"
-
-msgid "Open URL:"
-msgstr "³«¤¯ URL: "
-
-msgid "Part Message: "
-msgstr "Υæ¥á¥Ã¥»¡¼¥¸: "
-
-msgid "Part channel: "
-msgstr "È´¤±¤ë¥Á¥ã¥ó¥Í¥ë: "
-
-msgid "Password incorrect from %s. Try again with password."
-msgstr "%s ¤Î¥Ñ¥¹¥ï¡¼¥É¤¬ÉÔÀµ¤Ç¤¹¡£ºÆÅ٥ѥ¹¥ï¡¼¥É¤òÆþÎϤ·¤Æ²¼¤µ¤¤"
-
-msgid "Please use a newer \"%s\"."
-msgstr "¤è¤ê¿·¤·¤¤ \"%s\" ¤ò¤ª»È¤¤¤¯¤À¤µ¤¤"
-
-msgid "Private message to %s: "
-msgstr "%s ¤Ø¤Î¥×¥é¥¤¥Ù¡¼¥È¥á¥Ã¥»¡¼¥¸: "
-
-msgid "Private message to: "
-msgstr "ï¤Ø¤Î¥×¥é¥¤¥Ù¡¼¥È¥á¥Ã¥»¡¼¥¸: "
-
-msgid "Quit IRC? "
-msgstr "IRC ¤ò¤ä¤á¤Þ¤¹¤«? "
-
-msgid "Reading..."
-msgstr "Æɤó¤Ç¤¤¤Þ¤¹"
-
-msgid "Really SEND from Yank Buffer?"
-msgstr "ËÜÅö¤Ë kill-ring ¤«¤éÁ÷¿®¤·¤Þ¤¹¤«?"
-
-msgid "Received file from %s: %s (%s bytes)"
-msgstr "%s ¤«¤é ¥Õ¥¡¥¤¥ë %s ¤ò¼õ¿®¤·¤Þ¤·¤¿ (%s ¥Ð¥¤¥È)"
-
-msgid "Return to channel: "
-msgstr "Ìá¤ë¥Á¥ã¥ó¥Í¥ë: "
-
-msgid "Ringing user %s"
-msgstr "¥æ¡¼¥¶ %s ¤ò¸Æ¤ó¤Ç¤¤¤Þ¤¹"
-
-msgid "SEND applied autoreceive: %s (%s bytes)\n"
-msgstr "SEND ¥ê¥¯¥¨¥¹¥È¤ËÂФ·¤Æ¼«Æ°¼õ¿®¤ò»Ï¤á¤Þ¤·¤¿: %s (%s ¥Ð¥¤¥È)\n"
-
-msgid "SEND request from %s: %s (%s bytes)\n"
-msgstr "%s ¤«¤é¤Î SEND ¥ê¥¯¥¨¥¹¥È: %s (%s ¥Ð¥¤¥È)\n"
-
-msgid "Sending file to %s: %s (%s bytes)"
-msgstr "%s ¤Ë¥Õ¥¡¥¤¥ë %s ¤òÁ÷¿®¤·¤Æ¤¤¤Þ¤¹ (%s ¥Ð¥¤¥È)"
-
-msgid "Sent file to %s: %s (%s bytes)"
-msgstr "%s ¤Ë¥Õ¥¡¥¤¥ë %s ¤òÁ÷¿®¤·¤Þ¤·¤¿ (%s ¥Ð¥¤¥È)"
-
-msgid "Server Password: "
-msgstr "¥µ¡¼¥Ð¤Î¥Ñ¥¹¥ï¡¼¥É: "
-
-msgid "Server connection closed."
-msgstr "¥µ¡¼¥Ð¤Ø¤ÎÀܳ¤¬ÀÚ¤ì¤Þ¤·¤¿"
-
-msgid "Server time is %s\n"
-msgstr "¥µ¡¼¥Ð¤Î»þ´Ö¤Ï %s ¤Ç¤¹\n"
-
-msgid "Signoff message: "
-msgstr "½ªÎ»¥á¥Ã¥»¡¼¥¸"
-
-msgid "Start private conversation with: "
-msgstr "ï¤È²ñÏäò»Ï¤á¤Þ¤¹¤«: "
-
-msgid "Timeout [RET for none]: "
-msgstr "¥¿¥¤¥à¥¢¥¦¥È [»ØÄꤷ¤Ê¤¤¾ì¹ç¤Ï¥ê¥¿¡¼¥ó]: "
-
-msgid "To whom: "
-msgstr "ï¤Ë: "
-
-msgid "Topic for %s set by %s at %s\n"
-msgstr "%s ¤Î¥È¥Ô¥Ã¥¯¤Ï%s ¤Ë¤è¤Ã¤Æ %s ¤Ë¥È¥Ô¥Ã¥¯¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿\n"
-
-msgid "Topic for %s: %s\n"
-msgstr "%s ¤Î¥È¥Ô¥Ã¥¯¤Ï: %s\n"
-
-msgid "Topic set by %s at %s\n"
-msgstr "%s ¤Ë¤è¤Ã¤Æ %s ¤Ë¥È¥Ô¥Ã¥¯¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿\n"
-
-msgid "Topic: %s\n"
-msgstr "¥È¥Ô¥Ã¥¯ %s\n"
-
-msgid "Unknown FILE message \":%s %s %s %s\""
-msgstr "̤ÃΤΠFILE ¥á¥Ã¥»¡¼¥¸ \":%s %s %s\""
-
-msgid "Unknown ctcp notice \":%s %s %s\""
-msgstr "̤ÃΤΠCTCP ÄÌÃÎ \":%s %s %s\""
-
-msgid "WHO expression: "
-msgstr "WHO ¤Î¸¡º÷¼°: "
-
-msgid "Welcome to the Internet Relay Chat world. Your nick is %s.\n"
-msgstr "¤è¤¦¤³¤½ Internet Relay Chat ¤ÎÀ¤³¦¤Ø¡£¤¢¤Ê¤¿¤Î¥Ë¥Ã¥¯¥Í¡¼¥à¤Ï %s ¤Ç¤¹\n"
-
-msgid "Which query: "
-msgstr "²¿¤òÌ䤤¹ç¤ï¤»¤Þ¤¹¤«: "
-
-msgid "Whose client: "
-msgstr "ï¤Î¥¯¥é¥¤¥¢¥ó¥È¤Ë: "
-
-msgid "With whom: "
-msgstr "ï¤È: "
-
-msgid "You are not a channel operator"
-msgstr "¤¢¤Ê¤¿¤Ï¥Á¥ã¥ó¥Í¥ë¥ª¥Ú¥ì¡¼¥¿¤Ç¤Ï¤¢¤ê¤Þ¤»¤ó"
-
-msgid "You just killed %s. %s\n"
-msgstr "¤¢¤Ê¤¿¤Ï %s ¤ò KILL ¤·¤Þ¤·¤¿¡£%s\n"
-
-msgid "You were kicked off channel %s by %s (%s).\n"
-msgstr "¤¢¤Ê¤¿¤Ï¥Á¥ã¥ó¥Í¥ë %s ¤Ç %s ¤Ë¥¥Ã¥¯¤µ¤ì¤Þ¤·¤¿¡£(%s)\n"
-
-msgid "You're already on channel %s"
-msgstr "¤¢¤Ê¤¿¤Ï¤â¤¦¥Á¥ã¥ó¥Í¥ë %s ¤Ë¤¤¤Þ¤¹"
-
-msgid "You're not on channel %s"
-msgstr "¤¢¤Ê¤¿¤Ï¥Á¥ã¥ó¥Í¥ë %s ¤Ë¤¤¤Þ¤»¤ó"
-
-msgid "Your client version is %s.\n"
-msgstr "¤¢¤Ê¤¿¤Î¥¯¥é¥¤¥¢¥ó¥È¤Î¥Ð¡¼¥¸¥ç¥ó¤Ï %s ¤Ç¤¹\n"
-
-msgid "Your server is %s (version %s).\n"
-msgstr "¤¢¤Ê¤¿¤Î¥µ¡¼¥Ð¤Ï %s (¥Ð¡¼¥¸¥ç¥ó %s) ¤Ç¤¹\n"
-
-msgid "Your server was created %s\n"
-msgstr "¤¢¤Ê¤¿¤Î¥µ¡¼¥Ð¤Ï %s ¤Ëµ¯Æ°¤·¤Þ¤·¤¿\n"
-
-msgid "[Modes are: %s]"
-msgstr "[¥â¡¼¥É: %s]"
-
-msgid "[No match]"
-msgstr "[°ìÃפ¹¤ë¤â¤Î¤¬¤¢¤ê¤Þ¤»¤ó]"
-
-msgid "^%s%sNew mode for %s set by %s: "
-msgstr "^%s%s%s ¤Ë %s ¤Ë¤è¤Ã¤Æ¿·¤·¤¤¥â¡¼¥É¤¬ÀßÄꤵ¤ì¤Þ¤·¤¿: "
-
-msgid "connect error to %s: %s"
-msgstr "%s ¤Ø¤ÎÀܳ¥¨¥é¡¼: %s"
-
-msgid "illegal nickname \"%s\"; not changed"
-msgstr "\"%s\" ¤ÏÉÔÀµ¤Ê¥Ë¥Ã¥¯¥Í¡¼¥à¤Ç¤¹¡£Êѹ¹¤Ç¤¤Þ¤»¤ó"
-
-msgid "listen error to %s: %s"
-msgstr "%s ¤Ø¤Î listen ¥¨¥é¡¼: %s"
-
-msgid "send error to %s: %s"
-msgstr "%s ¤Ø¤ÎÁ÷¿®¥¨¥é¡¼: %s"
+++ /dev/null
-styledir = $(pkgdatadir)/styles
-style_DATA = bottom top middle
-EXTRA_DIST = $(style_DATA)
\ No newline at end of file
+++ /dev/null
-;; -*- emacs-lisp -*-
-;;; bottom --- Window configuration style spec for `bottom'.
-;; Copyright (C) 1998 Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; See file liece-copyright.el for original change log and copyright info.
-
-;; Author: Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; Created: 1999-01-08
-;; Revised: 1999-01-08
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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.
-
-;;; Code:
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . t)
- (channel-list-buffer-mode . t)
- (configuration
- (vertical
- 1.0
- (horizontal
- 1.0
- (others 1.0)
- (channel-list
- liece-channel-list-window-width-percent))
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0)
- (nick liece-nick-window-width-percent))
- (command 4 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . t)
- (configuration
- (vertical
- 1.0
- (horizontal
- 1.0
- (others 1.0)
- (channel-list
- liece-channel-list-window-width-percent))
- (channel liece-channel-window-height-percent)
- (command 4 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . t)
- (channel-list-buffer-mode . nil)
- (configuration
- (vertical
- 1.0
- (others 1.0)
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0)
- (nick liece-nick-window-width-percent))
- (command 4 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . nil)
- (configuration
- (vertical
- 1.0
- (others 1.0)
- (channel liece-channel-window-height-percent)
- (command 4 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . nil)
- (nick-buffer-mode . any)
- (channel-list-buffer-mode . any)
- (configuration
- (vertical
- 1.0
- (dialogue 1.0)
- (command 4 point))))
+++ /dev/null
-;; -*- emacs-lisp -*-
-;;; middle --- Window configuration style spec for `middle'.
-;; Copyright (C) 1998 Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; See file liece-copyright.el for original change log and copyright info.
-
-;; Author: Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; Created: 1999-01-08
-;; Revised: 1999-01-08
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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.
-
-;;; Code:
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . t)
- (channel-list-buffer-mode . t)
- (configuration
- (horizontal
- 1.0
- (vertical
- 1.0
- (channel liece-channel-window-height-percent)
- (command 3 point)
- (others 1.0))
- (vertical
- liece-nick-window-width-percent
- (nick 0.5)
- (channel-list 1.0)))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . t)
- (configuration
- (vertical
- 1.0
- (horizontal
- 1.0
- (others 1.0)
- (channel-list
- liece-channel-list-window-width-percent))
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0))
- (command 3 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . nil)
- (configuration
- (vertical
- 1.0
- (others 1.0)
- (channel liece-channel-window-height-percent)
- (command 3 point))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . nil)
- (nick-buffer-mode . any)
- (channel-list-buffer-mode . any)
- (configuration
- (vertical
- 1.0
- (dialogue 1.0)
- (command 3 point))))
+++ /dev/null
-;;; top --- Window configuration style spec for `top'. -*- emacs-lisp -*-
-;; Copyright (C) 1998 Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; See file liece-copyright.el for original change log and copyright info.
-
-;; Author: Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-;; Created: 1999-01-08
-;; Revised: 1999-01-08
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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.
-
-;;; Code:
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . t)
- (channel-list-buffer-mode . t)
- (configuration
- (vertical
- 1.0
- (command 4 point)
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0)
- (nick liece-nick-window-width-percent))
- (horizontal
- 1.0
- (others 1.0)
- (channel-list
- liece-channel-list-window-width-percent)))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . t)
- (configuration
- (vertical
- 1.0
- (command 4 point)
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0))
- (horizontal
- 1.0
- (others 1.0)
- (channel-list
- liece-channel-list-window-width-percent)))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . t)
- (channel-list-buffer-mode . nil)
- (configuration
- (vertical
- 1.0
- (command 4 point)
- (horizontal
- liece-channel-window-height-percent
- (channel 1.0)
- (nick liece-nick-window-width-percent))
- (others 1.0))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . t)
- (nick-buffer-mode . nil)
- (channel-list-buffer-mode . nil)
- (configuration
- (vertical
- 1.0
- (command 4 point)
- (channel liece-channel-window-height-percent)
- (others 1.0))))
-
-(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . nil)
- (nick-buffer-mode . any)
- (channel-list-buffer-mode . any)
- (configuration
- (vertical
- 1.0
- (command 4 point)
- (dialogue 1.0))))
-
+++ /dev/null
-2007-09-04 Didier Verna <didier@xemacs.org>
-
- * liece-vars.el (liece-timers): Fix misuse of the list widget type
- (forgot this on in the patch below).
-
-2007-09-04 Didier Verna <didier@xemacs.org>
-
- * liece-hilit.el (liece-quoted-colors-ircle): Fix misuse of the
- list widget type.
- * liece-hilit.el (liece-quoted-colors-mirc): Ditto.
- * liece-tcp.el (liece-tcp-rlogin-parameters): Ditto.
-
-2003-11-29 Jerry James <james@xemacs.org>
-
- * liece-minibuf.el: Require 'liece-channel and 'liece-inlines when
- compiling.
-
-2003-04-17 Daiki Ueno <daiki@xemacs.org>
-
- * liece-channel.el: Require 'liece-misc when compiling.
- (liece-channel-equal): Define as function.
- (liece-channel-buffer-create): Define as function.
- (liece-channel-switch-to-last): Define before it is used.
- * liece-ctcp.el: Require 'liece-misc when compiling.
- * liece-message.el: Require 'liece-misc when compiling.
- * liece-misc.el: Move some macros to the beginning of the file.
- * liece-nick.el: Require 'liece-inlines when compiling.
- (liece-nick-equal): Define as function.
- (liece-nick-buffer-create): Define as function.
-
-2003-03-26 Steve Youngs <youngs@xemacs.org>
-
- * liece-channel.el (liece-channel-p): Don't wrap the string-match
- in a 'eval-when-compile' to avoid a void variable error.
- (liece-channel-modeless-p): Ditto.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile.lisp:
- * Makefile.lisp (autoload): New.
- Separate autoload building from elc building.
-
- * liece-make.el (install-update-package-files):
- Use new `batch-update-directory-autoloads' if available.
-
-2002-12-08 Ville Skyttä <scop@xemacs.org>
-
- * Makefile.lisp (all): Not a double-colon any more.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
-
-2002-09-26 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el (liece-minibuf-completing-read): Don't use the
- 7th argument of completing-read.
-
-2002-09-24 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): Check chnlp before
- passing mode argument to liece-channel-set-*.
- [cf. <Bug#161779>]
-
-2002-09-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-quit-message): Don't use
- liece-nick-mark-as-apart.
- (liece-handle-join-message): Ditto.
- [cf. <Liece:00080>]
-
-2002-09-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): The arglist of
- liece-nick-set-mode was changed.
-
-2002-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-join-channel): User
- liece-nick-get-joined-channels.
-
- * liece-channel.el (liece-channel-set-topic): Define as function.
- (liece-channel-add-mode): Ditto.
- (liece-channel-remove-mode): Ditto.
- (liece-channel-set-mode): Ditto.
- (liece-channel-add-ban): Ditto.
- (liece-channel-remove-ban): Ditto.
- (liece-channel-set-ban): Ditto.
- (liece-channel-add-exception): Ditto.
- (liece-channel-remove-exception): Ditto.
- (liece-channel-set-exception): Ditto.
- (liece-channel-add-invite): Ditto.
- (liece-channel-remove-invite): Ditto.
- (liece-channel-set-invite): Ditto.
- * liece-nick.el (liece-nick-mark-as-part): Replace
- liece-nick-{mark,unmark}-as-apart.
- (liece-nick-get-modes): Define as function.
- (liece-nick-add-mode): Ditto.
- (liece-nick-remove-mode): Ditto.
- (liece-nick-set-mode): Ditto.
- * liece-handle.el (liece-handle-mode-message): Follow the changes
- of arglists of liece-channel-set-mode and liece-nick-set-mode.
-
- * liece.el: Fix typo.
- * liece-misc.el (liece-current-nickname): Define as function.
- (liece-current-channel): Ditto.
- (liece-current-channels): Ditto.
- (liece-current-chat-partner): Ditto.
- (liece-current-chat-partners): Ditto.
-
-2002-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): Care
- liece-channel-set-* are defined as macros.
- * liece-inlines.el (string-equal-ignore-case): Don't use
- compare-strings.
- (string-list-member-ignore-case): Don't use member-ignore-case.
- Suggested by "Akinori MUSHA" <knu@iDaemons.org>.
- [cf. <Liece:00075>]
-
-2002-07-13 Daiki Ueno <daiki@xemacs.org>
-
- * liece-menu.el (liece-menu-add-url): Always switch to *Commands*
- buffer.
- * liece-xemacs.el (liece-fix-menu-path-switch-buffer): Removed old
- defadvice to easy-menu-add-item.
-
-2002-06-08 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile.lisp: Include XEmacs.rules.
- * liece-commands.el (liece-command-nickname): Use
- truncate-string-to-width instead of non-existent truncate-string.
- * liece.el (liece-open-server): Ditto.
-
-2002-06-05 Steve Youngs <youngs@xemacs.org>
-
- * liece-inlines.el (string-equal-ignore-case): Don't try to use
- 'compare-strings'.
-
-2002-05-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-modeline-glyph): Check 'xbm.
-
-2002-05-04 Stephen J. Turnbull <stephen@xemacs.org>
-
- * liece-make.el (config-liece-package-directory):
- * liece-config.el (PACKAGEDIR):
- Handle case when dirs is nil.
-
- * Makefile.lisp (package): Preload advice.
-
-2002-05-12 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-default-locale): New variable.
- (bind-text-domain): Use it.
-
-2002-05-07 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-mapcar*): Eliminate recursion.
-
-2002-04-08 Daiki Ueno <daiki@xemacs.org>
-
- * liece-misc.el: Don't require pccl and broken.
-
-2002-04-07 Daiki Ueno <daiki@xemacs.org>
-
- * liece-modules.el: Don't compile liece-q-ccl.el.
- * liece-ctcp.el: Don't require liece-q-ccl.el.
-
-2002-03-25 Daiki Ueno <daiki@xemacs.org>
-
- * Makefile.lisp (FLAGS): Don't set this if it is imported.
-
- * liece-ctcp.el: Don't throw an error when liece-q-ccl is not found.
-
-2002-03-24 Daiki Ueno <daiki@xemacs.org>
-
- * liece-coding.el (liece-mime-charset-for-write): Use
- `mime-charset-to-coding-system' instead of `mime-charset-p'.
- (liece-mime-charset-for-read): Ditto.
-
-2002-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (bind-text-domain): Respect LC_ALL and LC_MESSAGES;
- reverse lang-paths.
-
-2002-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-parse-Content-Type): Bind `case-fold-search'
- to t to extract Content-Type: field properly.
-
-2002-03-19 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el: Autoload `mime-content-type-parameter' and
- `mime-read-Content-Type' only when compiling.
- (gettext-parse-Content-Type): Add bogus detection logic.
-
-2002-03-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (liece-string-to-list): New definition.
- * liece-000.el (liece-handle-004-message): Use it.
- * liece-nick.el (liece-nick-remove-mode): Use it.
- * liece-channel.el (liece-channel-read-mode): Use it.
- * liece-handle.el (liece-handle-mode-message): Use it.
-
- * gettext.el: Require `poem' and `static'.
- (gettext-string-to-list): New definition.
-
-2002-02-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-modules.el (liece-modules-to-compile): Add `liece-coding'.
-
- * liece-coding.el (liece-mime-charset-for-write): Use
- default-mime-charset-for-write as its default.
- (liece-mime-charset-for-read): Use default-mime-charset as its
- default.
-
-2002-01-28 Daiki Ueno <ueno@unixuser.org>
-
- * liece-dcc.el (liece-dcc-start-process): New function.
- (liece-command-dcc-send): Use it.
- (liece-command-dcc-receive): Use it.
- (liece-command-dcc-chat-listen): Use it.
- (liece-command-dcc-chat-connect): Use it.
-
-2001-11-09 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
-
- * liece-vars.el (liece-truncate-partial-width-windows): Change
- default value to fix the inconsistency with docstring.
-
- * liece-window.el (liece-configure-windows): Ditto.
-
-2001-10-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-misc.el (liece-subtract-time): New function.
- (liece-time-difference): Use it.
-
-2001-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-misc.el (liece-time-difference): Fix the arglist.
- [cf. <Liece:45>]
-
-2001-10-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (replace-in-string): Follow a change in XEmacs.
-
-2001-10-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-buffer-min-size): Rename from
- `liece-buffer-default-size'.
-
- * liece-commands.el (liece-command-kill): Use `liece-time-elapsed'
- instead of `liece-time-add'.
-
- * liece.el (liece-check-buffers-if-interval-expired): Swap the
- arguments supplied to `liece-time-difference'.
- (liece-check-buffers): Use `liece-buffer-min-size' instead of
- `liece-buffer-default-size'.
-
- * liece-misc.el (liece-time-difference): Define as function.
- (liece-time-elapsed): Rename from `liece-time-add'.
- (liece-generate-hex-timestamp): Define as function.
-
-2001-10-02 Katsuhiro Hermit Endo <hermit@koka-in.org>
-
- * liece-misc.el (liece-time-difference): Use `abs' for
- `liece-check-buffers-if-interval-expired'.
-
-2001-09-16 Katsuhiro Hermit Endo <hermit@koka-in.org>
-
- * liece-vars.el (liece-server-alist): Update default value.
-
-2001-02-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (liece-read-passwd): Revive.
-
- * liece-clfns.el (liece-clfns-subr-fboundp): Check existence of
- the function `symbol-file'.
-
- * liece-q-ccl.el: Require `poem' for char-int.
- (liece-quote-ccl-256-table): Simplified.
-
-2001-01-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-modules.el: Simplified.
-
-2000-12-09 Tanaka Akira <akr@m17n.org>
-
- * liece.el (liece-refresh-buffer-window): Simplified.
-
-2000-11-30 Tanaka Akira <akr@m17n.org>
-
- * liece.el (liece-refresh-buffer-window): Force to display a last
- non-empty line in last line in a window on Emacs 21.
-
-2000-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-ctcp.el: Remove autoload cookies of
- `liece-command-ctcp-generic',
- `liece-command-ctcp-userinfo-from-minibuffer',
- `liece-command-ctcp-x-face-from-xbm-file' and
- `liece-command-send-file'.
-
- * liece-commands.el: Add autoload setting for
- `liece-command-ctcp-action',
- `liece-command-ctcp-userinfo-from-minibuffer' and
- `liece-command-ctcp-x-face-from-xbm-file'.
-
-2000-10-16 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-quit): Use `liece-close-server'.
-
- * liece.el (liece): Simplify.
- (liece-close-server): Accept optional argument `quit-string'.
-
-2000-10-12 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-menu.el (liece-menu-ctcp-menu): Follow the CTCP command
- changed from `liece-command-client-*' to `liece-command-ctcp-*'.
-
-2000-10-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-qualify-nicks): Refer 1st argument.
-
-2000-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el (liece-minibuffer-complete-channel-modes):
- Don't use old style backquotes.
- (liece-minibuffer-completing-read-multiple-1): Remove a partially
- matched word construct if it exists.
-
-2000-10-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-set-operators): Reset `run'.
- (liece-command-set-voices): Ditto.
-
-2000-09-30 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-modeline-glyph): Add 'xpm check.
- (liece-xemacs-create-nick-glyph): Ditto.
- (liece-xemacs-unread-mark): Ditto.
-
-2000-09-22 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-kill-message): Call
- `liece-close-server' instead of `liece-clear-system'.
-
- * liece-commands.el: Don't autoload `liece-window-configuration-pop'.
- (liece-command-quit): Just send quit.
-
- * liece.el (liece-close-server): Run `liece-exit-hook'; abolish
- argument `quit-string'.
-
- * liece-filter.el (liece-sentinel): Call `liece-close-server'.
-
-2000-09-20 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el: Require `wid-edit'.
-
- * liece-inlines.el (liece-locate-icon-file): Don't check existence
- of the file.
-
- * liece-emacs.el: Don't require `static' and `wid-edit'.
- (liece-splash-image): Set default to nil.
- (liece-emacs-splash-function): New variable.
- (liece-emacs-splash-with-image): New function splitted from
- `liece-emacs-splash'; use `image-size'; hide cursor.
- (liece-emacs-splash-with-stipple): New function.
-
- * liece-minibuf.el (liece-minibuffer-parse-modes): Don't complete
- mode flags when completing an argument.
-
-2000-09-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-menu.el (liece-menu-callback-set-operators): Rename from
- `liece-menu-callback-mode+o'.
- (liece-menu-callback-set-voices): Rename from
- `liece-menu-callback-mode+v'.
- (liece-menu-callback-unset-operators): Rename from
- `liece-menu-callback-mode-o'.
- (liece-menu-callback-unset-voices): Rename from
- `liece-menu-callback-mode-v'.
-
- * liece-nick.el (liece-nick-region-opers): Abolish.
- (liece-nick-region-voices): Abolish.
- (liece-nick-update-region): Don't set them.
-
- * liece.el (liece-dialogue-mode-map): Don't bind `liece-command-exec',
- `liece-command-lusers' and `liece-command-userhost'.
-
- * liece-commands.el (liece-command-exec): Abolish.
- (liece-command-inline): Abolish.
- (liece-command-set-operators): Rename from `liece-command-mode+o'.
- (liece-command-set-voices): Rename from `liece-command-mode+v'.
- (liece-command-qualify-nicks): New function.
- (liece-command-mode-o): Abolish.
- (liece-command-mode-v): Abolish.
- (liece-command-userhost): Abolish.
- (liece-command-lusers): Abolish.
-
-2000-09-18 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-channel-buffer-mode): Set default to t.
- (liece-nick-buffer-mode): Ditto.
- (liece-channel-list-buffer-mode): Ditto.
-
- * liece.el (liece-open-server-internal): Simplify.
- (liece-open-server): Strip bracketed server name here.
- (liece-start-server): Fix last change.
-
-2000-09-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-highlight-mode): Set default to t.
-
- * liece.el (liece-open-server): Simplify.
- (liece-start-server): Canonicalize `liece-server' here.
-
-2000-09-17 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-menu.el (liece-menu-channel-menu): Move `liece-command-freeze'
- from `liece-menu-IRC-menu'.
- (liece-menu-channel-menu): Move `liece-command-own-freeze'
- from 'liece-menu-IRC-menu'.
- (liece-menu-channel-menu): New menu item `liece-dialogue-beep'.
- (liece-menu-channel-menu): New menu item
- `liece-command-unread-channel'.
-
-2000-09-17 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-read-functions): Rename from
- `liece-channel-read-hook'.
-
- * liece-handle.el (liece-channel-unread-functions): Rename from
- `liece-channel-unread-hook'.
-
- * liece-emacs.el (toplevel): Use them.
-
- * liece-xemacs.el (toplevel): Ditto.
-
-2000-09-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-make.el (make-liece-sample-files): Abolish.
- (make-liece-info-files): Abolish.
-
- * liece-url.el (liece-add-url-functions): Rename from `liece-url-add-hook'.
-
- * liece.el (liece-after-insert-functions): Rename from `liece-insert-hook'.
- (liece-before-insert-functions): Rename from `liece-before-insert-hook'.
-
- * liece-handle.el (liece-notice-cleartext-hook): Abolish.
- (liece-privmsg-cleartext-hook): Abolish.
-
- * liece-filter.el (liece-handle-message): Simplify.
-
- * liece-ctcp.el (liece-ctcp-message): Don't ignore errors in hooks.
- (liece-ctcp-notice): Ditto.
- (liece-ctcp-file-notice): Ditto.
-
- * liece-channel.el (liece-channel-add-mode): Don't use pushnew.
- (liece-channel-add-exception): Ditto.
- (liece-channel-add-invite): Ditto.
-
-2000-09-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-inhibit-startup-message): New user option.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-splash-at-point): Don't check `console-type'.
- (liece-x-face-insert-with-xemacs): Ditto.
-
-2000-09-11 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-emacs.el (liece-emacs-unread-character): Abolish.
-
- * liece-vars.el (liece-channel-unread-character): New variable.
-
- * liece-xemacs.el (liece-xemacs-unread-mark): Simplify; Don't use
- `featurep' and `console-type'.
- (toplevel): Ditto.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el: Autoload `completing-read-multiple'; declare
- `crm-separator'.
- (liece-minibuffer-completing-read): Rename from
- `liece-minibuffer-completing-default-read'; accept optional arguments
- `history' and `default'.
- (liece-minibuffer-completion-separator): New variable.
- (liece-minibuffer-completion-table): New variable.
- (liece-minibuffer-completing-read-multiple-1): New completion function.
- (liece-minibuffer-completing-read-multiple): Rename from
- `liece-minibuffer-completing-sequential-read'; accept optional
- arguments `history' and `default'; use `completing-read-multiple'
- when optional 8th argument `multiple-candidate' is specified.
-
- * liece-xemacs.el (liece-xemacs-redisplay-unread-mark): Don't bind `chnl'.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-quit): Don't send QUIT.
-
- * liece-emacs.el (liece-emacs-splash): Use `generate-new-buffer'
- instead of `liece-get-buffer-create'
-
- * liece-xemacs.el (liece-xemacs-splash): Synch with liece-emacs.el
-
- * liece.el (liece-clear-system): Call
- `liece-buffer-dispose-function' instead of burying buffer.
- (liece-open-server-internal): Simplify; Don't use
- `liece-get-buffer-create' to prepare process-buffer.
- (liece-close-server): Accept optional argument `quit-string'.
-
- * liece-vars.el (liece-buffer-dispose-function): New variable.
-
-2000-09-10 Daiki Ueno <ueno@unixuser.org>
-
- * liece-inlines.el (string-list-remove-ignore-case): Remove car of the element.
- (string-list-delete-ignore-case): Ditto.
- (string-list-remove): Ditto.
- (string-list-delete): Ditto.
-
-2000-09-06 Daiki Ueno <ueno@unixuser.org>
-
- * liece-clfns.el (remq): New compiler macro.
-
-2000-09-05 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-redisplay-buffer): New hook
- `liece-channel-read-hook'.
- (liece-channel-change): Run `liece-redisplay-unread-mark'.
-
- * liece-handle.el (liece-handle-privmsg-message): New hook
- `liece-channel-unread-hook'.
-
- * liece-vars.el (liece-display-unread-mark): New variable.
-
- * liece-xemacs.el (liece-xemacs-unread-icon): Rename from
- `liece-xemacs-channel-balloon-icon'.
- (liece-xemacs-unread-mark): Rename and simplified from
- `liece-xemacs-channel-balloon'.
- (liece-xemacs-read-mark): Rename and simplified from
- `liece-xemacs-channel-balloon-kill'.
- (liece-xemacs-redisplay-unread-mark): New function.
- (toplevel): Add them to hook.
-
- * liece-emacs.el (liece-emacs-unread-character): New variable.
- (liece-emacs-unread-mark): New function.
- (liece-emacs-read-mark): Ditto.
- (liece-emacs-redisplay-unread-mark): Ditto.
- (toplevel): Add them to hook.
-
-2000-09-04 Daiki Ueno <ueno@unixuser.org>
-
- * liece-inlines.el (string-equal-ignore-case): Check return value
- of `compare-strings'.
-
-2000-09-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-clfns.el: Require `pym'.
- (liece-clfns-subr-fboundp): New macro.
- (last,member-if,member-if-not,delete-if,remove-if,remove-if-not,
- assoc-if,rassoc-if): Use it.
-
- * liece-inlines.el (string-list-member-ignore-case): Use
- `member-ignore-case'.
- (string-list-remove-ignore-case): Use remq.
- (string-list-member): Abolish.
- (string-list-delete-ignore-case): Use delq.
- (string-equal-ignore-case): Use `compare-strings' if available.
-
-2000-09-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-channel.el (liece-channel-change): Handle
- `liece-current-chat-partner'.
-
- * Makefile.am (SOURCES): Remove `liece-crypt'.
-
- * liece-crypt.el: Remove.
-
- * liece-400.el (liece-handle-433-message): Use `liece-beep'
- (liece-handle-432-message): Ditto.
-
- * liece-misc.el (liece-beep): New macro.
- (liece-set-beep): Rename from `liece-beep'.
-
- * liece-xemacs.el (liece-xemacs-channel-balloon): Abolish local
- variable `chnl'.
-
- * liece.el: Don't require `liece-crypt'.
- (liece-crypt-map): Abolish.
- (liece-buffer-mode-alist): Remove `liece-CRYPT-buffer'.
- (liece-command-mode-map): Don't bind
- `liece-command-enter-message-opposite-crypt-mode'.
- (liece): Don't initialize crypt indicator.
- (liece-command-mode): Ditto.
- (liece-dialogue-mode): Ditto.
- (liece-channel-mode): Ditto.
-
- * liece-xemacs.el: Don't require `liece-crypt'.
- (liece-toolbar-crypt-active-icon): Abolish.
- (liece-toolbar-crypt-inactive-icon): Abolish.
- (liece-toolbar-crypt-icon): Abolish.
- (liece-toolbar-crypt-glyph): Abolish.
- (liece-toolbar-crypt-active-glyph): Abolish.
- (liece-toolbar-crypt-inactive-glyph): Abolish.
- (liece-toolbar-spec-list): Don't set `liece-toolbar-crypt-glyph'.
- (liece-xemacs-setup-toolbar-hook): Remove `liece-toolbar-setup-crypt-glyph'.
- (liece-toolbar-setup-crypt-glyph): Abolish.
- (liece-toolbar-toggle-crypt): Abolish.
-
- * liece-vars.el (liece-defected-message-prefix): Abolish.
- (liece-suspicious-message-prefix): Abolish.
- (liece-beep-function): New variable.
-
- * liece-message.el (liece-message-brackets-function): Don't handle
- `liece-message-encrypted-p'.
- (liece-message-encrypted-p): Abolish.
- (liece-message-suspicious-p): Abolish.
- (liece-message-garbled-p): Abolish.
- (liece-message-fingerprint): Abolish.
- (liece-message-timestamp): Abolish.
-
- * liece-menu.el (liece-menu-crypt-menu): Abolish.
- (liece-menu-channel-menu): Remove `liece-menu-crypt-menu'.
- (liece-menu-alist): Ditto.
- (liece-menu-crypt-menu-map): Abolish.
-
- * liece-handle.el (liece-handle-notice-message): Don't use
- `with-liece-decryption'.
- (liece-handle-privmsg-message): Ditto.
- Use `liece-beep' instead of `beep'.
-
- * liece-modules.el (liece-modules-to-compile): Remove `liece-crypt'.
-
- * liece-globals.el (liece-crypt-indicator): Abolish.
- (liece-CRYPT-buffer): Abolish.
- (liece-C-buffer): Abolish.
-
- * liece-commands.el: Don't require `liece-crypt'.
- (liece-command-send-message): Abolish optional argument ARG and KEY.
- (liece-command-enter-message): Ditto.
- (liece-command-message): Ditto.
- (liece-enter-message): Abolish.
- (liece-command-part): Don't set crypt indicator.
- (liece-switch-to-channel): Ditto.
- (liece-switch-to-channel-no): Ditto.
- (liece-command-private-conversation): Ditto.
- (liece-command-toggle-crypt): Abolish.
-
-2000-08-31 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-handle.el (liece-handle-privmsg-message): Fixed.
-
-2000-08-30 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-commands.el (liece-command-unread-channel): New function.
-
- * liece.el (liece-command-map): Bind "\C-u" to it.
- (liece-channel-list-mode-map): Bind "u" to it.
-
-2000-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * liece-channel.el (liece-channel-change): Run
- `liece-redisplay-buffer-functions' only when
- `liece-current-channel' is non-nil.
-
- * liece-commands.el (liece-command-who): Check
- `liece-current-channel'.
- (liece-command-names): Ditto.
- Suggested by: Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>.
-
-2000-08-30 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-vars.el (liece-channel-unread-list): New variable.
-
- * liece-channel.el (liece-channel-unread-p): New function.
- (liece-channel-redisplay-buffer): Use it.
-
- * liece-handle.el (liece-handle-privmsg-message): Ditto.
-
-2000-08-29 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-change): Run
- `liece-redisplay-buffer-functions'.
-
-2000-08-23 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-privmsg-message): Use
- `liece-pick-buffer-1' to construct channel buffer name.
-
-2000-08-23 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-xemacs.el (liece-xemacs-channel-balloon): New function.
- Show balloon icon to `liece-cahnnel-list-buffer' as XEmacs glyphs
- when non-current channel message is received.
- (liece-xemacs-channel-balloon-kill): New function.
- Kill the balloon icon.
-
-2000-08-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-server-keyword-map): Bind connection type.
-
-2000-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-open-server-internal): Use
- `liece-open-network-stream'; bind liece-tcp-connection-type.
-
- * liece-tcp.el (liece-tcp-open-program-stream-as-binary): Abolish.
- (liece-tcp-open-ssl-stream-as-binary): Abolish.
- (liece-tcp-open-rlogin-stream-as-binary): Abolish.
- (liece-tcp-wait-for-string): Abolish.
- (liece-tcp-stream-alist): New variable.
- (liece-open-network-stream): Abolish 5th argument `type'.
-
-2000-08-01 Yoshiki Hayashi <yoshiki@xemacs.org>
-
- * liece-xemacs.el (liece-toolbar-position): Use
- function defaul-toolbar-position instead of variable.
-
-2000-07-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-emacs.el (create-image): Don't advise.
- (liece-widget-keymap): Remove checking about 'button3.
- (liece-emacs-widget-button-click): Save point in window explicitly.
-
- * liece-ctcp.el (liece-command-ctcp-generic): Fix format string.
-
-2000-07-16 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-commands.el (liece-command-beep): New function.
- Toggle the automatic beep notice when the channel message is received.
-
- * liece.el (liece-dialogue-mode-map): Bind "B" to liece-dialogue-beep.
-
- * liece-vars.el (liece-default-beep): New variable.
- (liece-beep-when-invited): Ditto.
- (liece-beep-when-privmsg): Ditto.
- (liece-beep-words-list): Ditto.
-
-2000-05-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-tcp.el
- (liece-tcp-rlogin-parameters): Use `socket' instead of `telnet'.
- (liece-tcp-open-rlogin-stream): Don't wait for a connection.
- (liece-tcp-open-rlogin-stream-as-binary): Simply wrap
- `liece-tcp-open-rlogin-stream'.
-
-2000-04-21 Daiki Ueno <ueno@unixuser.org>
-
- * liece-ctcp.el
- (liece-ctcp-make-menu-command-wrapper): Quote CTCP subcommands.
-
- * liece-mail.el (liece-maintainer-address): New ML address.
-
-2000-04-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-url.el: Don't require browse-url when compiling.
- (liece-url-browser-name): Abolish.
- (liece-url-prepare-browser-function): Abolish.
- (liece-url-mail-regexp): Abolish.
- (liece-url-browser-function): Abolish.
- (liece-url-link-action): Use browse-url directly.
- (liece-command-browse-url): Ditto.
- (liece-url-add-buttons): Remove local variable `url-start',
- `url-end' and `url'.
- Suggested by: Kenichi OKADA <okada@opaopa.org>
-
- * liece-xemacs.el
- (liece-toolbar-position): Check feature 'toolbar was provided.
-
-2000-04-08 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-setup-toolbar): Run
- `liece-xemacs-setup-toolbar-hook' only once.
- (liece-setup-toolbar): Don't check return value
- of `liece-xemacs-setup-toolbar'.
- Reported by: Yosuke MITSUMASU <werdna@ntn.org>
-
-2000-04-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el: Add autoload for liece-command-ctcp-version,
- liece-command-ctcp-userinfo,liece-command-ctcp-clientinfo,
- liece-command-ctcp-ping,liece-command-ctcp-time,
- liece-command-ctcp-x-face,liece-command-ctcp-comment,
- liece-command-ctcp-help.
- Suggested by: HARUYAMA Seigo <haruyama@unixuser.org>.
-
- * liece-ctcp.el
- (liece-ctcp-make-menu-command-wrapper): Don't use `#'.
- (liece-ctcp-make-command-wrapper): Ditto.
-
-2000-04-04 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-client-query-keys): Rename all commands.
-
- * liece-vars.el
- (liece-ctcp-userinfo): Rename from `liece-client-userinfo'.
- (liece-ctcp-x-face): Ditto.
-
- * liece-ctcp.el (liece-ctcp-message): Abolish macro.
- (liece-ctcp-file-message): Ditto.
-
-2000-03-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el: Require `derived'.
-
-2000-03-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-inlines.el (liece-locate-path): Use
- `liece-locate-data-directory' instead of `locate-data-directory'.
-
-2000-03-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-q-ccl.el (ccl-set-register-right): Abolish.
- (liece-quote-ccl-decode): Simplified.
-
- * liece-compat.el (liece-suppress-mode-line-format): Copy original
- `mode-line-format' before modification.
- (locate-data-directory): Abolish.
- (liece-locate-data-directory): New function.
-
- * liece-xemacs.el (liece-xemacs-suppress-modeline-format): Ditto.
- (liece-locate-data-directory): Override with `locate-data-directory'.
-
- * liece.el
- (liece-command-mode): Define `mode-line-format' as buffer local.
- (liece-dialogue-mode): Exchange `mode-line-modified' position.
- (liece-clear-system): Check buffer status.
-
- * liece-ctcp.el (liece-ctcp-xyzzy-message): Abolish.
- (liece-command-send-file): Don't narrowing buffer.
- (liece-ctcp-file-save-directory): Default to `liece-directory'.
- (liece-register-file-handler): New macro.
- (liece-ctcp-notice): Rewrite.
- (liece-ctcp-message): Rewrite.
- (liece-query-client-insert-to-generic): Abolish.
- (liece-query-client-version): Abolish.
- (liece-query-client-userinfo): Abolish.
- (liece-query-client-help): Abolish.
- (liece-query-client-clientinfo): Abolish.
- (liece-query-client-ping): Abolish.
- (liece-query-client-time): Abolish.
- (liece-query-client-x-face): Abolish.
- (liece-query-client-last-command): Rename from
- `liece-query-client-lastcommand'.
- (liece-query-client-alist): Abolish.
- (liece-ctcp-last-nick): Rename from `liece-query-client-nick'.
- (liece-command-ctcp-x-face-from-minibuffer): Abolish.
- (liece-command-ctcp-x-face-from-commandbuffer): Abolish.
- (liece-command-ctcp-userinfo-from-commandbuffer): Abolish.
-
-2000-03-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-xemacs.el (liece-xemacs-icon-path): Abolish.
- (liece-toolbar-position): Default to `default-toolbar-position'.
- (liece-xemacs-setup-toolbar): Remove directory checking.
- (liece-xemacs-modeline-glyph): Suppress glyph specs.
- (liece-xemacs-create-nick-glyph): Ditto.
-
- * liece-emacs.el (liece-emacs-icon-path): Abolish.
-
- * liece-intl.el (liece-intl-load-catalogue): Rewrite with
- `liece-locate-path'; remove local binding.
-
- * liece-window.el (liece-window-load-style-file): Rewrite with
- `liece-locate-path'; remove local binding.
-
- * liece-compat.el (locate-data-directory): New function.
-
- * liece-inlines.el (liece-find-data-directory): Abolish.
- (liece-locate-path): Rename from `liece-find-path'; use
- `locate-data-directory'; reorder arguments.
- (liece-locate-icon-file): New function.
-
-2000-03-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-globals.el
- (liece-command-buffer,liece-dialogue-buffer,liece-private-buffer,
- liece-others-buffer,liece-channel-buffer,
- liece-channel-buffer-format,liece-channel-list-buffer,
- liece-nick-buffer,liece-nick-buffer-format,
- liece-KILLS-buffer,liece-IGNORED-buffer,liece-WALLOPS-buffer,
- liece-CRYPT-buffer,liece-server-buffer): Remove preceding `*IRC*'.
-
- * liece-xemacs.el
- (liece-xemacs-splash-at-point): Bind
- `liece-insert-environment-version' to nil.
- (liece-xemacs-splash): Ditto.
- (liece-xemacs-suppress-modeline-format): New function.
- (liece-suppress-mode-line-format): Override with
- `liece-xemacs-suppress-modeline-format'.
- (liece-xemacs-mode-line-buffer-identification): Decorate 1st
- element and modify whole identification by side effect.
-
- * liece-compat.el (current-language-environment): Abolish.
- (frame-title-format): Abolish.
- (enable-multibyte-characters): Abolish.
- (liece-suppress-mode-line-format): New function.
-
- * liece-version.el: Use product.el.
- (liece-version): New function.
- (liece-user-interface-product): Abolish.
- (liece-product-name): Abolish.
- (liece-product-version): Abolish.
- (liece-product-code-name): Abolish.
- (liece-user-agent-value): Abolish.
- (liece-command-version): Abolish.
- (liece-environment-version): Rename from
- `liece-emacs-user-agent-value'.
-
- * bitmap-stipple.el
- (bitmap-stipple-insert-pixmap): Don't set point to `point-min'.
-
- * liece-xbm.el: Update.
-
- * liece-emacs.el (liece-emacs-splash): Display version number;
- bind `liece-insert-environment-version' to nil.
- (liece-emacs-mode-line-buffer-identification): Decorate 1st
- element and modify whole identification by side effect.
-
- * liece-vars.el (liece-nick-max-length): New variable.
- (liece-insert-environment-version): New variable.
-
- * liece.el (liece-truncate-nickname): Abolish.
- (liece-client-query-keys,liece-dialogue-keys,
- liece-select-keys,liece-crypt-keys): Define as a plist.
- (liece-local-set-keys): New function borrowed from gnus-util.el.
- (liece-define-keys): Ditto.
- (liece-define-keys-safe): Ditto.
- (liece-define-keys-1): Ditto.
- (liece-command-map): Bind "\C-m" to liece-command-modec.
- (liece-command-mode): Don't set `mode-line-format' directly;
- exchange `mode-line-modified' position;
- (liece-dialogue-mode): Ditto.
- (liece-others-mode): Ditto.
- (liece-channel-mode): Ditto.
- (liece-nick-mode): Ditto.
- (liece-channel-list-mode): Ditto.
-
-2000-03-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (bind-text-domain): Don't refer "PATHNAME/DOMAIN.mo"
- directly.
-
- * bitmap-stipple.el,gettext.el,liece-000.el,liece-200.el,
- liece-300.el,liece-400.el,liece-500.el,liece-commands.el,
- liece-config.el,liece-crypt.el,liece-ctcp.el,liece-dcc.el,
- liece-filter.el,liece-globals.el,liece-handle.el,liece-hilit.el,
- liece-inlines.el,liece-intl.el,liece-mail.el,liece-make.el,
- liece-menu.el,liece-message.el,liece-minibuf.el,liece-misc.el,
- liece-nick.el,liece-q-ccl.el,liece-q-el.el,liece-tcp.el,
- liece-version.el,liece-window.el,liece-x-face.el: Checkdoc.
-
- * liece-menu.el (liece-nick-popup-menu): Use copy-sequence instead
- of copy-tree.
-
- * liece-modules.el (liece-modules-to-compile): Modify for
- `liece-clfns' and `liece-handler'.
-
- * liece-handler.el: Rename from llunf.el.
-
- * liece-clfns.el: New file.
-
- * liece-channel.el (liece-channel-add-buttons): Fix regexp.
- (liece-channel-add-ban): Use add-to-list instead of pushnew.
-
- * liece-coding.el
- (liece-default-coding-system): Abolish.
- (liece-mime-charset-for-write): Rename from
- `liece-default-mime-charset'.
- (liece-mime-charset-for-read): Rename from
- `liece-default-mime-charset-for-read'.
-
- * liece.el (liece-client-query-map,liece-dcc-map,
- liece-crypt-map,liece-friends-map,liece-channel-list-mode-map,
- liece-nick-mode-map,): Use make-sparse-keymap when initialising.
- (liece-command-mode): Don't set liece-display-frame-title to nil.
- (liece-dialogue-mode-map): Bind `L' to liece-command-load-vars
- instead of `C-l'; bind `S' to liece-command-save-vars instead of
- `s'; bind `M' to liece-command-modec instead of `C-m'; bind `O' to
- liece-dialogue-own-freeze instead of `M'.
- (liece-buffer-last-check-time): Rename from
- `liece-last-checkbuffer-time'.
- (liece-check-buffers): Define as function.
- (liece-check-buffers-if-interval-expired): Simplified.
-
- * liece-vars.el
- (liece-buffer-max-size): Rename from `liece-buffer-maxsize'.
- (liece-buffer-default-size): Rename from `liece-buffer-defsize'.
- (liece-buffer-check-interval): Rename from
- `liece-checkbuffer-interval'.
-
- * liece-emacs.el (liece-emacs-widget-button-click): Don't use
- `event-buffer'.
-
- * liece-xemacs.el
- (liece-xemacs-get-buffer-window-list): Abolish.
- (liece-xemacs-run-at-time): Abolish.
- (liece-xemacs-put-text-property): Abolish.
- (liece-xemacs-add-text-property): Abolish.
-
- * liece-minibuf.el (liece-minibuffer-map): Use `set-keymap-parent'
- instead of `liece-set-keymap-parents'.
-
- * liece-compat.el: Don't require emu, broken, alist.
- (remassoc): Abolish.
- (remassq): Abolish.
- (liece-run-at-time): Abolish.
- (liece-cancel-timer): Abolish.
- (with-timeout): Abolish.
- (with-timeout-handler): Abolish.
- (liece-get-buffer-window-list): Abolish.
- (liece-set-keymap-parents): Abolish.
- (event-buffer): Abolish.
- (event-point): Abolish.
- (truncate-string-to-width): Abolish.
- (plist-get): Abolish.
- (read-passwd): Abolish.
- (colon-keyword-usable): Abolish.
- (turn-on-font-lock): Abolish.
- (liece-make-overlay): Abolish.
- (liece-delete-overlay): Abolish.
- (liece-overlay-put): Abolish.
- (liece-move-overlay): Abolish.
- (liece-overlay-end): Abolish.
- (liece-overlay-get): Abolish.
- (liece-overlays-at): Abolish.
- (liece-put-text-property): Abolish.
- (liece-add-text-property): Abolish.
- (buffer-disable-undo): Abolish.
- (valid-plist-p): Abolish.
-
- * liece-url.el (liece-url-browser-netscape): Abolish.
-
-2000-03-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-compat.el (liece-get-buffer-window): Search all frames.
-
-2000-02-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-command-mode): Set frame-title-format when
- running on window-system environment.
-
-2000-02-18 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Use `frame-char-width' and
- `frame-char-height' when calculating logo centering.
-
-2000-02-17 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-400.el (liece-handle-443-message): Check channel name.
-
-2000-02-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-coding.el
- (liece-coding-encode-charset-region): Define as function.
- (liece-coding-encode-charset-string): Define as function.
-
- * liece-dcc.el
- (liece-dcc-chat-send): Switch to liece-command-buffer.
- (liece-dcc-enqueue-request): Rename.
- (liece-dcc-dequeue-request): Ditto.
-
- * liece-misc.el (liece-send-as-binary): Abolish.
- (liece-repair-crlf): Abolish.
- (liece-send): Switch to liece-command-buffer.
-
- * liece-emacs.el (liece-emacs-splash): Use `font-info' if 'font
- parameter of the selected frame is not a fontset name.
-
- * liece.el (liece-open-server-internal): Set process-buffer of
- open-network-stream as unibyte.
-
-2000-02-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-xemacs.el (liece-toolbar-icon-convert-1): New function.
- (liece-toolbar-icon-states): New variable.
-
- * liece-emacs.el (liece-emacs-widget-button-click): Don't preserve
- previously selected window.
-
-2000-01-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el: Require `image' when compiling.
- (create-image): Add optional argument `data-p'.
-
-2000-01-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-message.el (liece-message-empty-predicate): New variable.
-
- * liece-commands.el
- (liece-command-message): Use `liece-message-empty-predicate'.
-
-2000-01-16 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-modules.el (liece-modules): Don't install `queue-m'.
-
- * liece-dcc.el: Don't require `queue-m' at runtime.
-
- * liece-hilit.el:
- Add autoload setting for `liece-channel-add-buttons' and
- `liece-nick-add-buttons'.
- (liece-highlight-maybe-turn-on-font-lock): Activate
- `liece-channel-add-buttons' and `liece-nick-add-buttons' when
- inserting every line.
-
- * liece-compat.el (liece-map-overlays): New function.
- (liece-kill-all-overlays): Use it.
-
- * liece-xemacs.el (liece-xemacs-map-extents): New function.
- (liece-xemacs-kill-all-overlays): Use it.
- (liece-map-overlays): New alias to `liece-xemacs-map-extents'.
-
- * liece-nick.el (liece-nick-redisplay-buffer): New function.
- (liece-nick-add-buttons): New function.
-
- * liece-channel.el
- (liece-channel-redisplay-buffer): New function.
- (liece-channel-list-redisplay-buffer): New function.
- (liece-channel-buffer-invisible-p): Remove redundant cond.
- (liece-channel-part-internal): Remove redundant `function'.
- (liece-channel-list-add-button): Rename from
- `liece-channel-add-button'.
- (liece-channel-push-button-action): Use `liece-command-join'
- instead of `liece-switch-to-channel'.
-
- * liece-commands.el (liece-switch-to-channel-1): Abolish.
- (liece-redisplay-buffer-functions): New variable.
-
-2000-01-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el
- (liece-command-next-channel): Traverse channel list circularly.
- (liece-command-previous-channel): Likewise.
-
-1999-12-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el
- (liece-command-previous-channel): Remove nil from channel list.
- (liece-command-next-channel): Ditto.
-
-1999-12-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Check whether logo height
- is larger than frame height.
-
- * liece-crypt.el (liece-crypt-maybe-encrypt-message): Simplified.
-
- * liece-commands.el
- (liece-command-enter-message-encrypted): Abolish.
- (liece-command-enter-message-cleartext): Abolish.
- (liece-command-enter-message-opposite-crypt-mode): Abolish.
- (liece-command-enter-message-with-key): Abolish.
-
-1999-12-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-user-agent-value): Add APEL version.
-
- * liece-inlines.el (liece-next-line): New macro.
-
- * liece-ctcp.el
- (liece-command-client-action): Use `liece-next-line'.
- (liece-command-client-userinfo-from-commandbuffer): Ditto.
-
- * liece-channel.el (liece-channel-member): Use `member-if' instead
- of `find-if'.
-
- * liece.el (liece): Don't use `liece-command-describe-briefly'.
- (liece-command-mode): Don't bind `next-line-add-newlines'.
- (liece-dialogue-keys): Don't bind `C-u'.
-
- * liece-commands.el (liece-command-topic): If called with prefix
- argument insert the current topic as default.
- (liece-command-finger): Add documentation about optional 2nd
- argument.
- (liece-command-describe-briefly): Abolish.
- (liece-enter-message): Abolish local variable `message'.
- (liece-command-join-channel): Fix paren style.
- (liece-command-join-partner): Ditto.
- (liece-command-join): Ditto.
- (liece-command-part): Ditto.
- (liece-switch-to-channel-no): Ditto.
- (liece-command-complete): Ditto.
- (liece-command-next-channel): Rewrite with using
- `liece-channel-member'.
- (liece-command-previous-channel):
- (liece-command-push): Abolish local variable `rest-sym' and
- `item'; don't use `liece-channel-remove'.
- (liece-command-pop): Abolish local variable `rest-sym'.
- (liece-command-tag-region): Don't create temp buffer.
-
-1999-12-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-set-channel-indicator): Switch to
- `liece-command-buffer' when updating modeline.
-
-1999-12-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-minibuf.el (liece-minibuffer-map): Don't use
- `set-keymap-parents'.
-
- * liece-compat.el (liece-set-keymap-parents): Rename from
- `set-keymap-parents'.
- (turn-on-font-lock,event-buffer,event-point,region-active-p,
- remassoc,remassq,valid-plist-p,plist-get): Add document.
-
-1999-12-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-insert-internal): Don't bind `tab-stop-list'.
- (liece-dialogue-mode): Declare `tab-stop-list' as buffer local.
-
-1999-12-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-message.el (liece-message-parent-buffer): Add condtion.
-
-1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-read-variables-files): Make the `~/.liece/'
- directory if there is no initialization file.
-
-1999-11-10 Kenichi OKADA <okada@opaopa.org>
-
- * liece-xemacs.el (liece-xemacs-splash-at-point): Calculate
- horizontal position of the splash logo.
-
-1999-11-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Check the number of
- the arguments of `insert-image'.
-
-1999-11-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-coding.el (detect-coding-string): Remove.
- (liece-detect-coding-string): Don't define if
- `detect-coding-string' does not exist.
-
-1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-url.el (liece-url-add-buttons): Accept optional arguments
- `start' and `end'.
-
- * liece.el (liece-save-point): New macro; borrowed from SKK.
- (liece-before-insert-hook): New variable.
- (liece-insert-internal): Refine.
-
-1999-11-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-get-buffer-create): Use memq instead of
- member to search over buffers list.
-
-1999-10-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-handle.el (liece-handle-ping-message): Return the
- argument correctly.
-
- * liece.el (liece-insert-internal): Remove `inline'.
-
-1999-10-27 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-nick-scroll-down): Fix
- argument list.
- (liece-command-nick-scroll-up): Ditto.
-
- * liece-hilit.el (liece-highlight-turn-on-font-lock): Set
- `liece-highlight-maybe-play-jingle' as local hook.
- (liece-highlight-font-lock-keywords): Undo last change.
-
-1999-10-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-refresh-windows): Remove.
- (liece-refresh-buffer-window): New function `liece-refresh-windows'.
- (liece-insert-internal): Preserve old point unconditionally when
- the buffer is frozen.
-
-1999-10-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-freeze): Rename from `liece-freeze-toggle'.
- (liece-own-freeze): Rename from `liece-own-freeze-toggle'.
-
- * liece.el: Add autoload for `liece-command-submit-bug-report'.
- (liece-overriding-command-keys): Rename.
- (liece-dialogue-keys): Bind `liece-command-submit-bug-report'.
-
- * liece-commands.el (liece-command-scroll-down): Use
- `scroll-other-window'; accept prefix value.
- (liece-command-scroll-up): Ditto.
- (liece-command-nick-scroll-down): Ditto.
- (liece-command-nick-scroll-up): Ditto.
- (liece-command-freeze): Accept prefix argument.
- (liece-command-own-freeze): Ditto.
- (liece-command-quit): Refine.
-
-1999-10-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-display-friends): Remove
- `save-excursion'.
-
- * liece.el (liece-read-variables-files): Prepare startup
- directory if it does not exist.
-
- * liece-vars.el (liece-directory): New variable.
- (liece-variables-file): Relocate under `liece-directory'.
-
- * liece-ctcp.el (liece-ctcp-version-message): Refer
- `liece-user-agent-value'.
-
- * liece-menu.el: Check features about menubars.
-
- * liece-xemacs.el (liece-xemacs-hide-scrollbars): Set
- `scrollbar-height' to 0 if `horizontal-scrollbar-visible-p' is not
- available.
-
- * liece-mail.el (liece-command-submit-bug-report): New function.
- (liece-maintainer-address): New variable.
-
- * gettext.el (gettext-load-message-catalogue): Enclose with
- `as-binary-input-file' instead of using `set-buffer-multibyte' twice.
- (gettext-load-portable-message-catalogue): Likewise.
- (dgettext): Check the cdr of catalogue entry.
- (gettext-gmo-read-32bit-word): Mask each byte with 255.
-
- * liece-compat.el (truncate-string-to-width): New alias.
-
- * liece.el (liece-server-keyword-bind): Quote colon keywords.
-
- * liece-make.el (make-liece-info-files): Check if
- `set-language-environment' exists.
-
- * liece-misc.el (liece-server-host): Quote colon keyword.
-
-1999-10-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-hilit.el (liece-highlight-font-lock-keywords): Undo last
- change; accept partial matcher as the value of
- `liece-highlight-pattern'.
- (liece-highlight-maybe-play-jingle): New function.
- (liece-highlight-maybe-turn-on-font-lock): Add
- `liece-highlight-maybe-play-jingle' to `after-change-functions'.
-
-1999-10-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (gettext-load-message-catalogue): Use hashtable.
- (gettext-load-portable-message-catalogue): Likewise.
-
-1999-10-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (next-visible-point): Don't advise.
- (liece-remove-properties-region): Enclose by `save-restriction'.
-
-1999-10-12 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-send-action): Remove.
-
- * liece-ctcp.el (liece-command-client-action): Move from
- `liece-commands.el'; mark `liece-command-send-action' as obsolete.
- (liece-client-x-face-notice): Remove whitespaces.
-
- * liece-handle.el (liece-handle-kick-message): Fix message.
-
-1999-10-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (gettext-default-mime-charset): New variable.
- (gettext-parse-Content-Type): Use it.
-
-1999-10-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-message): Fix message prefix.
-
- * liece-compat.el (liece-find-data-directory): Move to
- `liece-inlines'.
-
- * liece-xemacs.el (liece-xemacs-icon-path): Use `liece-find-path'.
-
- * liece-emacs.el (liece-emacs-icon-path): Use `liece-find-path'.
-
- * liece-inlines.el (liece-find-path): New function.
-
-1999-10-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-user-interface-product): Renamed from
- `liece-client-product'.
- (liece-client-version-major): Abolish.
- (liece-client-version-minor): Abolish.
- (liece-client-version-beta): Abolish.
- (liece-client-version-alpha): Abolish.
- (liece-client-version-codename): Abolish.
- (liece-product-name): New macro.
- (liece-product-version): New macro.
- (liece-product-code-name): New macro.
-
-1999-10-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-hilit.el (liece-highlight-jingle-function): New variable.
- (liece-highlight-font-lock-keywords): If liece-highlight-pattern
- matches, play jingle.
-
-1999-10-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-message.el (liece-message-parent-buffer): Check the
- message direction in private conversation.
-
-1999-09-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-emacs-user-agent-value): Include
- `emacs-patch-level'. It exists in XEmacs 21.1.1 or later.
-
-1999-09-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-channel-mode): Make `truncate-lines' local.
- (liece-others-mode): Ditto.
- (liece-channel-list-mode): Ditto.
- (liece-nick-mode): Ditto.
-
-1999-09-18 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-open-server): Set `liece-status-message-string'
- when timeout is expired.
-
-1999-09-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-menu.el (liece-use-localized-menu): New variable.
- (liece-command-define-menus): Use it.
- (liece-command-define-menus-1): New function; to raverse menu
- items recursively.
-
- * liece.el (liece): Call `liece-intl-load-catalogue' before switch
- to the command buffer.
-
- * liece-dcc.el: Refine.
-
- * liece-ctcp.el (liece-client-x-face-notice): Do not decode empty
- `X-Face'.
-
-1999-09-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-vars.el (liece-dcc-program): Rename to `ldcc'.
-
- * liece-tcp.el (liece-tcp-program): Rename to `ltcp'.
-
- * gettext.el (gettext-parse-Content-Type): Require `path-util'.
-
- * liece-x-face.el: Require `path-util'.
-
-1999-09-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Makefile.am (SOURCES): Add `gettext.el'.
-
- * liece-modules.el (liece-modules-to-compile): Add `gettext.el'.
-
- * liece-intl.el: Use `gettext.el'.
- (liece-intl-domains-alist): Abolish.
- (liece-intl-domain-to-mime-charset-alist): Abolish.
- (liece-intl-prepare-prefix): Abolish.
- (liece-intl-parse-Content-Type): Abolish.
- (liece-intl-convert-string): Abolish.
- (liece-intl-catalogue-path): Abolish.
-
- * gettext.el: New file.
-
- * liece-ctcp.el: Add autoload setting for `liece-ctcp-dcc-message'.
-
- * liece.el (liece): Save window splitting only when called
- interactively.
- (liece-clear-system): Do not restore window splitting.
- (liece-command-mode): Set syntax table explicitly; make
- `frame-title-format' buffer local.
-
- * liece-window.el (liece-window-configuration-push): Do not save
- `frame-title-format'.
- (liece-window-configuration-pop): Likewise.
-
- * liece-commands.el (liece-command-quit): Restore window splitting
- only when called interactively.
-
-1999-09-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-server-keyword-map): New variable.
- (liece-server-keyword-bind): New macro modified version of
- `mail-source-bind' from `mail-source.el'.
- (liece-server-parse-string): New function.
- (liece-open-server): Use them.
-
-1999-09-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-300.el (liece-handle-353-message): Reverse reply list.
-
- * All files are renamed from `irchat-*' to `liece-*'.
- All symbols are renamed too.
-
- * irchat-vars.el (irchat-connection-timeout): Default to 60.
-
- * irchat-nick.el (irchat-nick-insert): Handle reverse order
- sorting.
-
-1999-09-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat): Call `irchat-command-mode' just once.
- (irchat-initialize-buffers): Likewise.
-
- * irchat-channel.el (irchat-channel-buffer-create): Call
- `irchat-channel-mode' just once.
-
- * irchat-nick.el (irchat-nick-buffer-create): Call
- `irchat-nick-mode' just once.
-
- * irchat-message.el (irchat-message-parent-buffer): Fix condition.
-
-1999-09-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-sort-nicks): New variable.
-
- * irchat-intl.el (irchat-intl-load-catalogue): Ignore all errors
- when reading catalogue file.
-
- * irchat-menu.el: Do not require `irchat-ctcp'; add autoload
- settings for `irchat-menu-callback-ctcp-version',
- `irchat-menu-callback-ctcp-userinfo',
- `irchat-menu-callback-ctcp-help',
- `irchat-menu-callback-ctcp-clientinfo' and
- `irchat-menu-callback-ctcp-ping'; add `irchat-menu-add-url' to
- `irchat-url-add-hook'.
-
- * irchat-url.el (irchat-url-add-buttons): Enclose with
- `save-excursion'; run `irchat-url-add-hook'.
-
-1999-09-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.7.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Abolish.
-
- * irchat-intl.el (irchat-intl-get-msgstr-if): Abolish.
-
- * irchat-vars.el: Remove defconst for colon keyword.
-
-1999-09-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-menu.el: All the menu specs are expanded immediately.
- (irchat-menu-prepare-menus): Abolish.
- (irchat-menu-define): New function.
- (irchat-menu-alist): New variable.
-
- * irchat-handle.el (irchat-handle-topic-message): Check empty
- topic line.
-
- * irchat.el (irchat): When `irchat-startup-channel-list' contains
- list element send cadr as a channel key.
-
- * irchat-emacs.el (irchat-emacs-widget-convert-button): Make the
- keymap `irchat-widget-keymap' parented from current local map.
-
- * irchat-nick.el (irchat-nick-sort-predicate): New variable.
- (irchat-nick-update): Sort nicknames with
- `irchat-nick-sort-predicate'.
- (irchat-nick-insert): Search sorted position before insertion.
- (irchat-nick-replace): Call `irchat-nick-insert' when
- `irchat-nick-sort-predicate' is valid.
-
- * irchat-message.el (irchat-message-parent-buffer): Add condition
- for private conversation.
-
- * irchat-make.el (make-irchat-info-files): Set language
- environment to `Japanese'.
-
- * irchat-dcc.el (irchat-dcc-channel-representation-format):
- Remove.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Use `string-list-member-ignore-case' instead of
- `string-list-ci-member'.
-
- * irchat-url.el: Remove `irchat-insert-hook'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-font-lock):
- Add `irchat-url-add-buttons' to `irchat-insert-hook'.
-
- * irchat.el (irchat-initialize-buffers): Fix last change.
-
- * irchat-300.el: Enclose autoloads by `eval-and-compile'.
-
- * irchat-channel.el: Declare variable
- `irchat-dcc-channel-representation-format'.
-
-1999-09-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.6.
-
- * irchat.el: Add autoload for `irchat-command-browse-url'; do not
- require `irchat-url' and `irchat-dcc'; add autoload for
- `irchat-command-mail-compose'.
- (irchat-initialize-timers): Rewrite with `dolist'; do
- not check `irchat-timers-list-initialized-p'.
- (irchat-truncate-nickname): Use `truncate-string-to-width' instead
- of `truncate-string'.
- (irchat-buffer-mode-alist): New variable.
- (irchat-dialogue-setup-buffer): Abolish.
- (irchat-others-setup-buffer): Abolish.
- (irchat-channel-list-setup-buffer): Abolish.
- (irchat-private-setup-buffer): Abolish.
- (irchat-KILLS-setup-buffer): Abolish.
- (irchat-IGNORED-setup-buffer): Abolish.
- (irchat-WALLOPS-setup-buffer): Abolish.
- (irchat-CRYPT-setup-buffer): Abolish.
- (irchat-initialize-buffers): Rewrite.
-
- * irchat-ctcp.el (irchat-client-version-insert): Do not indent
- explicitly.
- (irchat-client-message-no-lf): Abolish.
-
- * irchat-300.el, irchat-xemacs.el, irchat-commands.el: Do not
- require `irchat-dcc' and `irchat-mail'.
-
- * irchat-dcc.el (irchat-command-dcc-send): Remove autoload cookie.
-
-1999-09-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-inlines.el (forward-line): Do not advise.
-
- * irchat-intl.el: Do not require `alist'; require `mcharset',
- `static' and `cl' during compilation.
- (irchat-intl-msgid-regexp): Fix regexp.
- (irchat-intl-msgstr-regexp): Ditto.
- (irchat-intl-set-msgstr): Abolish.
- (irchat-intl-load-catalogue): Optimize with side-effects.
-
- * irchat.el (irchat): Load message catalogue only once.
-
-1999-08-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-close-server-internal): Use
- `irchat-server-opened'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-widget):
- Abolish.
-
- * irchat-channel.el (irchat-channel-add-button): Use
- `irchat-widget-convert-button'.
-
- * irchat-nick.el (irchat-nick-insert): Use
- `irchat-widget-convert-button'.
- (irchat-nick-replace): Ditto.
-
- * irchat-compat.el (irchat-widget-convert-button): New alias.
- (irchat-widget-button-click): Alias to `widget-button-click'.
-
- * irchat-emacs.el (irchat-widget-keymap): New variable.
- (irchat-emacs-widget-convert-button): New function.
- (irchat-emacs-widget-button-click): New function.
- (irchat-widget-convert-button): Redefine here.
- (irchat-widget-button-click): Redefine here.
-
- * irchat-url.el (irchat-url-add-buttons): Use
- `irchat-widget-convert-button'.
-
-1999-08-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-emacs.el (irchat-emacs-splash): Use `fontset-pixel-size'.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el: Do not require `wid-browse' during
- compilation.
- (irchat-widget-button-click): New function.
-
- * irchat-emacs.el: Enclose autoloads with `eval-and-compile'.
- (irchat-emacs-create-mode-line-image): Specify
- `:ascent' property when creating the image.
- (irchat-emacs-create-nick-image): Ditto.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Makefile.am (EXTRA_DIST): Add `irchat-emacs.el'.
-
- * irchat-xemacs.el (irchat-xemacs-glyph-nick-buffer): Abolish.
- (irchat-xemacs-glyph-nick-region): Remove interactive spec.
-
- * irchat-intl.el: Do not require `mime-parse'.
-
- * irchat-tcp.el: Bind `ssl-program-arguments'.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-modules.el (irchat-modules-to-compile): Add
- `irchat-emacs'.
-
- * irchat-xemacs.el (irchat-xemacs-glyph-nick-buffer): Refine.
-
- * irchat-vars.el (irchat-icon-directory): Move from
- `irchat-xemacs.el'.; To be used under FSF Emacs 20.4.91.
- (irchat-nick-image-alist): Move from `irchat-xemacs.el'.
-
- * irchat-emacs.el: New file.; Most of FSF Emacs specific routines
- are stored here.
- (irchat-emacs-icon-path): New macro.
- (irchat-emacs-mode-line-buffer-identification): New function.
- (irchat-emacs-mode-line-buffer-identification): New variable.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.xpm: Reduce colors.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-x-face.el (irchat-x-face-insert-function): Don't use
- `eval-when-compile' while checking bitmap-mule.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-splash-pixmap): Renamed from
- `irchat-stipple-pixmap'; use the XPM data under FSF Emacs 20.4.91.
- (irchat-x-splash): Likewise.
-
- * irchat-channel.el (irchat-channel-virtual): Undo last change.
-
-1999-08-15 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-400.el (irchat-handle-400-messages): Do not pass empty
- channel names to `irchat-channel-virtual'.
-
- * irchat-channel.el (irchat-channel-virtual): Make channel ID for
- `!' channels invisible from user.
-
- * irchat-vars.el (irchat-channel-id-length): Default to 5.
-
-1999-08-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-353-channel): Abolish.
- (irchat-handle-366-message): Do not use `irchat-353-channel'.
-
-1999-08-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-200.el (irchat-handle-218-message): Do not indent
- explicitly.
-
-1999-08-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (with-timeout): New macro for compatibility.
-
- * irchat-xemacs.el: Check `horizontal-scrollbar-visible-p' for
- XEmacs 20.4.
-
- * irchat.el (irchat-open-server): Do not truncate trailing `_'.
-
- * Liece 1.3.5.
-
- * irchat-handle.el (irchat-handle-mode-message): Handle channel
- invite list.
- (irchat-handle-join-message): Pass optional argument to
- `match-string'.
-
- * irchat-channel.el (irchat-channel-get-invites): New macro.
- (irchat-channel-add-invite): New macro.
- (irchat-channel-remove-invite): New macro.
- (irchat-channel-set-invite): New macro.
-
- * irchat-300.el: Handle channel invite list.
- (irchat-handle-346-message) <RPL_INVITELIST>: New handler.
- (irchat-handle-347-message) <RPL_ENDOFINVITE>: New handler
-
-1999-08-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-200.el: Register 200 handler again.
- (irchat-handle-200-message): Do not indent explicitly.
- (irchat-handle-201-message): Likewise.
- (irchat-handle-213-message): Likewise.
- (irchat-handle-214-message): Likewise.
- (irchat-handle-262-message) <RPL_ENDOFTRACE>: New handler.
-
- * irchat-300.el (irchat-handle-365-message): Turn hops count into
- string.
-
- * irchat-xemacs.el (irchat-toolbar-map-button-list): Fix typo.
-
-1999-08-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-load-catalogue): Add nil check.
- (irchat-intl-catalogue-path): Fix last change.
-
-1999-08-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-window.el (irchat-window-load-style-file): Cache
- `irchat-window-style-directory'.
-
- * irchat-xemacs.el (irchat-xemacs-icon-path): Cache
- `irchat-icon-directory'.
-
- * irchat-intl.el (irchat-intl-catalogue-path): New macro.
- (irchat-intl-load-catalogue): Use it.
-
- * irchat-make.el (install-update-manifest-file): Fix for data
- directories.
- (config-irchat-package-directory): Splitt into
- `config-irchat-package'.
-
- * irchat-xemacs.el: Do not require `smiley'.
- (irchat-xemacs-icon-path): New macro.
- (irchat-toolbar-icon-plist-get): Use it.
- (irchat-xemacs-setup-toolbar): Use it.
- (irchat-xemacs-create-nick-glyph): Use it.
- (irchat-xemacs-modeline-glyph): Use it.
-
- * irchat-vars.el (irchat-use-smiley): Abolish.
-
- * irchat-hilit.el (irchat-maybe-smiley-region): Abolish. If you
- want to use this functionality, please setup `irchat-insert-hook'.
-
-1999-08-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.xpm: New splash logo.
-
- * irchat-xemacs.el (irchat-xemacs-splash-at-point): Use
- `glyph-width', `glyph-height' and `window-pixel-height' to
- calculate position of the splash logo.
-
-1999-08-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (irchat-find-data-directory): Move from
- `irchat-misc'.
-
- * irchat-intl.el: Use new style macros.
- (irchat-intl-parse-Content-Type): Check statically if
- `mime-content-type-parameter' is available.
- (irchat-intl-load-catalogue): Use `irchat-find-data-directory'.
-
- * irchat.el (irchat-open-server): Add server parameter `relay'.
-
- * irchat-window.el (irchat-window-set-default-style): Use
- `irchat-find-data-directory'.
-
- * irchat-tcp.el: Fix comment string.
- (irchat-tcp-open-rlogin-stream): New function.
- (irchat-tcp-open-rlogin-stream-as-binary): New function.
- (irchat-tcp-default-connection-type): Add rlogin to custom spec.
- (irchat-tcp-rlogin-program): New variable.
- (irchat-tcp-relay-host): New variable.
- (irchat-tcp-rlogin-parameters): New variable.
- (irchat-tcp-rlogin-user-name): New variable.
-
-1999-08-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-config.el (irchat-config-info-file-regexp): New variable.
-
- * irhcat-hilit.el: Require font-lock during compilation.
-
- * irchat-vars.el (irchat-tab-stop-list): New variable.
-
- * irhcat-000.el, irchat-200.el, irchat-300.el, irchat-400.el,
- irchat-ctcp.el: Do not use `mapcar' when registering handlers.
-
- * irchat-misc.el (irchat-find-etc-directory): New function.
-
- * irchat.el: Add autoloads for
- `bitmap-stipple-xbm-file-to-stipple' and
- `bitmap-stipple-insert-pixmap'.
-
- * irchat-xemacs.el (irchat-x-face-insert-with-xemacs): Use xface
- glyph if this feature has been provided and `console-type' returns
- 'tty or 'pc, or otherwise make string glyph.
- [Rename from overriding function `irchat-x-face-insert']
- (irchat-xemacs-create-nick-glyph): Call `console-type' instead of
- referring `window-system'.
- (irchat-xemacs-modeline-glyph): Check current console type.
- (irchat-xemacs-splash-at-point): Ditto.
- (irchat-find-etc-directory): Advise it.
-
- * irchat-compat.el (irchat-static-autoload): New macro.
- (colon-keyword-usable): New facility checking.
-
- * irchat-x-face.el: Add autoloads for `x-face-encode',
- `x-face-read-existing-file-name', `bitmap-insert-xbm-buffer',
- `bitmap-decode-xbm', `bitmap-read-xbm-buffer' and `bitmap-compose'.
- (irchat-x-face-insert-function): New variable.
- (irchat-x-face-insert-with-bitmap): Rename from overriding
- function `irchat-x-face-insert'.
-
- * irchat-url.el: Do not check with requiring browse-url. Assume
- that function `browse-url' have already been autoloaded.
-
-1999-08-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-command-mode): Set local value of
- `next-line-add-newlines' 't.
- (irchat-wait-for-response): Use `with-timeout'.
- (irchat): Do not use `make-variable-buffer-local' when
- `irchat-freeze' and `irchat-own-freeze' are initialized.
- (irchat-dialogue-mode): Define `irchat-freeze' and
- `irchat-own-freeze' here.
-
- * irchat-misc.el (next-line): Abolish.
-
- * irchat-handle.el (irchat-handle-nick-message): Fix typo.
-
-1999-07-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-inlines.el (string-list-modify-ignore-case): Fix typo.
-
-1999-07-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-make.el: Generate file `MANIFEST.liece'.
- (install-update-manifest-file): New function.
-
-1999-07-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-end-of-buffer): Do not use
- `set-window-point'.
-
- * irchat-300.el (irchat-handle-367-message): Use
- `irchat-channel-add-ban' instead of temp variable.
- (irchat-367-channel): Abolish.
- (irchat-367-regexps): Abolish.
- (irchat-handle-348-message): New handler for handling channel
- exception list.
- (irchat-handle-349-message): New handler for handling channel
- exception list.
-
-1999-07-27 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-mode-message): Handle channel
- exception list.
-
- * irchat-channel.el: (irchat-channel-get-exceptions): New macro.
- (irchat-channel-add-exception): New macro.
- (irchat-channel-remove-exception): New macro.
- (irchat-channel-set-exception): New macro.
-
-1999-07-25 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-end-of-buffer): Do not use
- `pop-to-buffer'.
- (irchat-command-describe-briefly): Do not use backquote.
-
-1999-07-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el: Do not refer `widget-minor-mode-map'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-widget): Use
- `current-local-map' instead of `widget-minor-mode-map'.
-
- * Liece 1.3.4.
-
- * irchat-q-ccl.el (irchat-quote-ccl-encode-region): Fix typo.
-
- * irchat-crypt.el: Add autoload for `crc32-string'.
- (irchat-crypt-hash-crc32-string): New function.
- (irchat-crypt-default-hash-function): New variable.
- (irchat-crypt-key-fingerprint): Rewrite with above functions.
-
- * irchat-handle.el (irchat-handle-topic-message): Fix argument
- order of `irchat-channel-set-topic'.
-
- * irchat-misc.el (irchat-maybe-update-channel-indicator): Abolish.
- Call `irchat-set-channel-indicator' directly.
-
- * irchat-nick.el (irchat-nick-replace): Remove widgets.
-
- * irchat-menu.el (irchat-nick-popup-menu): Move "Kick" menu to the
- bottom of menu entries.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Ditto.
-
-1999-07-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-frame-title-format-last): Abolish.
-
- * irchat.el (irchat-accept-response): Call `irchat' with no
- arguments. Here's the point that take care of growing tail.
- (irchat): Call `irchat-window-configuration-pop' and
- `irchat-window-configuration-push' consequently.
-
- * irchat-commands.el (irchat-command-keepalive): Call `irchat'
- with no arguments.
-
- * irchat-filter.el (irchat-sentinel): Call `irchat' with no
- arguments.
-
- * irchat-window.el: Add window configuration stack utility.
- (irchat-window-configuration-push): New function.
- (irchat-window-configuration-pop): New function.
- (irchat-window-configuration-stack): New variable.
-
- * irchat-compat.el: Require wid-edit and wid-browse during
- compilation.
- (widget-minor-mode-map): Bind `mouse-button-3'.
- (irchat-dont-set-event-point): New advice against
- `widget-button-click' for FSF Emacs.
- (irchat-save-current-buffer): New advice against
- `widget-button-click' for FSF Emacs.
- (remassq): New function.
-
- * irchat-channel.el (irchat-channel-push-button): Abolish.
- (irchat-channel-list-insert): Abolish.
- (irchat-channel-button): New widget.
- (irchat-channel-add-button): New function.
- (irchat-channel-button-action): New function.
-
- * irchat-url.el: Use widget.
- (irchat-url-link): New widget.
- (irchat-url-add-button): New function.
- (irchat-url-iterate-buffer): Abolish.
- (irchat-url-search-forward): Abolish.
- (irchat-url-add-to-completion): Abolish
- (irchat-url-link-action): Renamed from irchat-url-push-button.
-
- * irchat-hilit.el: Renamed from irchat-hilight.el.
- (irchat-highlight-overlay-put-mouse-face): Abolish.
- (irchat-highlight-insert-with-mouse-face): Abolish.
- (irchat-highlight-insert-line-with-mouse-face): Abolish.
- (irchat-highlight-with-widget): Abolish.
- (irchat-url-face): Abolish.
- (irchat-mouse-face): Abolish.
- (irchat-highlight-maybe-turn-on-widget): New function.
- This function turns on `widget-minor-mode' in
- `irchat-nick-mode', `irchat-channel-list-mode' or
- `irchat-dialogue-mode'.
-
-1999-07-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.3.
-
- * irchat.el (irchat-override-command-keys): Bind "\C-c\C-a" to
- `irchat-command-previous-channel'.
-
- * irchat-crypt.el: Add routines for encapsulate cipher algorithms.
- (irchat-crypt-import-cipher-algorithm): New function.
- (irchat-crypt-key-fingerprint): New function.
- (irchat-crypt-build-decryption-key): New function.
- (irchat-crypt-build-encryption-key): New function.
- (irchat-crypt-encrypt-string): New function.
- (irchat-crypt-decrypt-string): New function.
- (irchat-crypt-algorithm-major-version): New function.
- (irchat-crypt-algorithm-minor-version): New function.
- (irchat-crypt-secure-passphrase-read): Abolish.
- (irchat-crypt-ignore-suspicious): Abolish.
- (irchat-crypt-ignore-defected): Abolish.
- (irchat-get-idea-decryption-key): Abolish.
- (irchat-command-set-default-key): Check if this function was
- called interactively.
- (irchat-command-add-decryption-key): Renamed from
- `irchat-command-add-new-key'.
- (irchat-command-delete-decryption-key): Renamed from
- `irchat-command-delete-key'.
- (irchat-crypt-decryption-keys): Renamed from
- `irchat-crypt-known-keys'.
- (irchat-crypt-encryption-keys): Renamed from
- `irchat-crypt-default-keys'.
-
- * irchat-coding.el (irchat-default-mime-charset-for-read): New
- variable. Default to 'x-ctext.
-
- * irchat-compat.el: Do not require 'defface.
- (irchat-compat-enable-to-read-multibyte): Abolish.
-
- * irchat-modules.el (irchat-modules-to-compile): Remove
- `irchat-ck-*' and `defface'. Use `japanese-zenkaku-*' with hook.
-
- * irchat-vars.el (irchat-convert-hankaku-katakana): Abolished.
-
- * irchat-inlines.el: All string functions are rewritten.
-
-1999-07-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Register ACTION handler.
-
-1999-07-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-version.el (irchat-emacs-user-agent-value): Modify for
- XEmacs UTF-2000-MULE.
-
- * irchat-crypt.el: Do not use IDEA as the default cipher algorithm.
- (irchat-crypt-cipher-algorithm): New variable.
- (irchat-crypt-encrypt-message-format): Add version field of
- the cipher algorithm.
- (irchat-crypt-current-keys): Always restore the computed keys into
- this variable. [Renamed from irchat-default-idea-key-list]
-
-1999-06-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-use-toolbar): Add custom spec.
- (irchat-toolbar-toggle-crypt): Check irchat-use-toolbar.
- (irchat-setup-toolbar): Ditto.
-
-1999-06-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.2.
-
- * irchat.el (irchat-define-keys): Rewrite.
- (irchat-truncate-nickname): Rewrite; rename from irchat-read-nickname.
-
- * irchat-handle.el, irchat-400.el, irchat-300.el, irchat-200.el,
- irchat-000.el:
- Declarations of hook variables are splitted into each file.
-
- * irchat-300.el: Register 322 reply handler.
-
-1999-06-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-dialogue-mode-map): Bind mouse-button-2 to
- irchat-url-push-button.
-
- * irchat-url.el (irchat-url-push-button): Check all overlays
- around event point.
-
- * irchat-filter.el (irchat-handle-message): Ignore errors which
- occurs during hook evaluation.
-
- * irchat-ctcp.el (irchat-ctcp-message): Ignore errors which
- occurrs during hook evaluation.
- (irchat-ctcp-notice): Likewise.
- (irchat-ctcp-file-notice): Likewise.
-
- * irchat-channel.el (irchat-channel-push-button): Use
- irchat-overlays-at instead of overlays-at.
-
-1999-06-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-hilight.el (irchat-quoted-colors-mirc):
- Rename from irchat-quoted-colors.
- (irchat-quoted-colors-ircle): New color table.
- (irchat-highlight-maybe-hide-prefix): Fix regexp.
- (irchat-highlight-colorize-quote): Check vender specific extension.
-
- * irchat-channel.el (irchat-channel-push-button):
- Check all overlays under the point.
-
- * irchat-filter.el: Rename default backend name to "generic".
-
- * irchat-handle.el: Use multiple values bindings.
- (irchat-handle-notice-message): Fix argument against
- irchat-ctcp-notice.
-
- *irchat-misc.el (irchat-compose-time-string): Use
- format-time-string. Now only accepts encoded time.
-
- * irchat-misc.el (irchat-pick-buffer): Check if chnl is string and
- apropriate buffer does not exist.
- (irchat-pick-buffer-1): Do not return buffer list.
-
-1999-06-10 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-debug-mode-map): Abolish.
- (irchat-debug-keys): Abolish.
- (irchat-command-keys): Fix return key code.
-
- * irchat-window.el (irchat-window-to-buffer):
- Remove irchat-debug-buffer.
-
- * irchat-vars.el (irchat-debug-mode-hook): Abolish.
- (irchat-debug-prefix): Abolish.
-
- * irchat-nick.el (irchat-nick-equal): New alias to string-ci-equal.
- (irchat-nick-member): New function.
- (irchat-command-toggle-nick-buffer-mode): Do not toggle when
- irchat-nick-buffer has not been created.
-
- * llhandler.el, irchat-modules.el (irchat-modules-to-compile):
- Remove llhandler.
-
- * irchat-misc.el (irchat-split-line): New function.
- (irchat-split-rest): Abolish.
- (irchat-with-split-rest): Abolish.
- (irchat-maybe-update-channel-indicator): Do not use backquote.
- (irchat-freeze-toggle): Use irchat-nick-equal.
- (irchat-message-from-ignored): Rename from irchat-msg-from-ignored.
-
- * irchat-message.el (irchat-message-parent-buffer):
- Use irchat-nick-equal.
-
- * irchat-make.el (compile-irchat): Add comments.
-
- * irchat-intl.el (irchat-intl-prepare-prefix):
- Do not treat irchat-debug-prefix.
-
- * irchat-inlines.el (filter-elements): Move from irchat-compat.
-
- * irchat-globals.el (irchat-debug-buffer): Remove.
-
- * irchat-crypt.el (irchat-idea-encrypt-message-format): Rename from
- irchat-idea-encrypt-msg-format.
- (irchat-crypt-maybe-decrypt-message): Use irchat-nick-equal.
-
- * irchat-compat.el: Require cl at load time.
- (buffer-or-string-p): Remove.
- (irchat-get-buffer-window): Enclose with eval-and-compile.
- (irchat-get-buffer-window-list): Ditto.
- (irchat-mode-line-buffer-identification): New alias to 'identity.
- (mapvector): Remove.
-
- * irchat-commands.el (irchat-command-debug): Abolished.
- (irchat-command-join-channel): Use irchat-channel-equal.
- (irchat-command-join): Use force-mode-line-update.
- (irchat-command-private-conversation): Ditto.
- (irchat-command-list): Check if 1st argument is empty string.
- (irchat-command-who): Ditto.
- (irchat-command-names): Ditto.
- (irchat-command-mode+o): Use irchat-nick-member.
-
- * irchat-channel.el (irchat-command-toggle-channel-buffer-mode):
- Do not toggle when
- irchat-channel-buffer has not been created.
-
- * irchat-handle.el, irchat-filter.el, irchat-dcc.el,
- irchat-ctcp.el, irchat-500.el, irchat-400.el, irchat-300.el,
- irchat-200.el, irchat-000.el: Use llunf instead of llhandler.
-
- * llunf.el: New file.
-
- * idea.el, b64.el (>>): Move from irchat-compat.
- (<<): Ditto.
-
-1999-06-06 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-misc.el (irchat-freeze-toggle): Use force-mode-line-update.
- (irchat-own-freeze-toggle): Ditto.
-
- * irchat-dcc.el: Require irchat-minibuf.el.
- (irchat-command-dcc-send): Use
- irchat-minibuffer-completing-default-read.
- (irchat-command-dcc-chat-listen): Ditto.
-
-1999-06-04 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-override-command-keys): Add "\C-v" and "l".
- (irchat-dialogue-keys): Remove "\C-v" and "\C-f".
-
- * irchat.el (irchat-override-command-keys):
- Add "\C-n", "\C-p" and "\C-a".
- (irchat-dialogue-keys): Remove "\C-n" and "\C-p".
-
- * irchat-nick.el (irchat-nick-set-user-at-host): New macro.
- (irchat-nick-mark-as-apart): New macro.
- (irchat-nick-unmark-as-apart): New macro.
-
- * irchat-version.el (irchat-emacs-user-agent-value):
- Ignore parenthesis in
- `emacs-version' for XEmacs 21.2.15.
-
-1999-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-handle.el, irchat-dcc.el, irchat-500.el, irchat-300.el,
- irchat-200.el: Do not check "strange" reply.
-
- * irchat-message.el (irchat-message-parent-buffer):
- Check if irchat-current-channel exists.
-
- * irchat-coding.el: Do not require irchat-vars.
-
- * irchat-menu.el (irchat-nick-popup-menu):
- Enclose save-selected-window.
-
- * irchat-misc.el (irchat-get-buffer-create): Do not use unless.
-
- * irchat-nick.el (irchat-nick-change): Set chnl property internally.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen):
- Use irchat-get-buffer-create instead
- of get-buffer-create.
- (irchat-command-dcc-chat-connect): Ditto.
- (irchat-dcc-compare-hostnames): Ditto.
-
- * irchat-ctcp.el (irchat-file-start):
- Use irchat-get-buffer-create instead of
- get-buffer-create.
- (irchat-file-cont): Ditto.
- (irchat-file-end): Ditto.
- (irchat-ctcp-client-notice): Ditto.
-
- * irchat.el (irchat-open-server-internal):
- Use irchat-get-buffer-create instead of
- get-buffer-create.
- (irchat-dialogue-setup-buffer): Ditto.
- (irchat-others-setup-buffer): Ditto.
- (irchat-channel-list-setup-buffer): Ditto.
- (irchat-private-setup-buffer): Ditto.
- (irchat-KILLS-setup-buffer): Ditto.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-xemacs.el (irchat-xemacs-nick-popup-menu):
- Remove save-excursion.
-
- * irchat-channel.el (irchat-channel-push-button):
- Remove save-excursion, just use save-selected-window instead.
- (irchat-channel-real): Remove save-match-data.
-
- * irchat.el (irchat-clear-system):
- Check irchat-obarray has been initialized.
-
- * Makefile.am (SOURCES): Add irchat-message.el and irchat-coding.el.
- (EXTRA_DIST): Add liece.xbm.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * Liece 1.3.1.
-
- * irchat-url.el (url-irc-liece): New function.
- [should be called from url-irc.el]
-
- * Makefile.am (EXTRA_DIST): Add bitmap-stipple.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-coding.el (irchat-detect-coding-region): New function.
- (irchat-detect-coding-region-function): Use above.
-
- * irchat-coding.el (irchat-detect-coding-string): New function.
- (irchat-detect-coding-string-function): Use above.
-
- * irchat-channel.el (irchat-channel-push-button):
- Switch to channel list buffer.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-nick.el (irchat-nick-update-region): Undo last change.
-
- * irchat-menu.el (irchat-nick-popup-menu): Switch to nick buffer.
-
- * irchat-filter.el: fix comments.
- (irchat-filter): Split multiple lines without string matching.
- (irchat-handle-message): Renamed from irchat-handle-message-2.
- (irchat-parse-user-at-host): New function.
-
- * irchat-coding.el (irchat-detect-coding-region-function): Renamed from
- irchat-custom-detect-coding-region-function.
- (irchat-detect-coding-string-function): Renamed from
- irchat-custom-detect-coding-string-function.
-
-1999-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-command-mode): Do not use mapvector.
-
- * irchat-handle.el (irchat-handle-notice-msg): Fix arguments against
- with-irchat-decryption.
- (irchat-handle-privmsg-msg): Likewise.
-
- * irchat-commands.el (irchat-command-send-message): Fix arguments of
- with-irchat-encryption.
- (irchat-command-message): Likewise.
-
- * irchat-crypt.el (irchat-crypt-maybe-decrypt-message):
- Exchange car with cdr in arglist.
- (with-irchat-encryption): Accept flat arglist.
- (with-irchat-decryption): Likewise.
-
- * irchat.el (irchat-nick-mode-map): Define as prefix commands.
-
- * irchat.el (irchat-channel-mode): Eliminate channel indicator.
- (irchat-others-mode): Likewise.
- (irchat-dialogue-mode): Likewise.
-
- * irchat-misc.el (irchat-set-channel-indicator):
- Eliminate channel indicator.
-
- * irchat-ctcp.el (irchat-ctcp-action-msg):
- Use irchat-display-message.
-
-1999-06-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-400.el: Remove redundancies on regexps.
- (irchat-handle-432-msg) <ERR_ERRONEUSNICKNAME>: Rewrite.
- (irchat-handle-433-msg) <ERR_NICKNAMEINUSE>: Resend NICK command only
- if irchat-auto-iterate-nick is non-nil.
-
- * irchat.el (irchat-command-keys): Add irchat-command-mode+o,
- irchat-command-mode-o, irchat-command-mode+v, irchat-command-mode-v.
- XXX: Should be prefixed commands?
-
-1999-05-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-message.el (irchat-message-predicate):
- Normalize irchat-message-blackets-predicate.
-
- * irchat-inlines.el (irchat-eval-form): New function.
-
- * irchat-message.el (irchat-message-predicate):
- Rename specifier typep to type.
-
- * irchat-misc.el (irchat-own-channel-message):
- Bind irchat-message-direction 'outgoing.
- (irchat-own-private-message): Ditto.
-
- * irchat-message.el (irchat-message-tags): New variable.
- (irchat-message-tags-function): New function.
- (irchat-message-private-buffer): Abolished.
- Use irchat-message-buffer-function.
-
-1999-05-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-update-region):
- Move opening save-excursion.
-
- * irchat-channel.el (irchat-channel-push-button):
- Move point to event ocurred position before calling
- irchat-nick-update-region.
-
- * irchat-nick.el (irchat-nick-update-region):
- Remove argument event from arglist.
-
- * irchat-menu.el (irchat-nick-popup-menu):
- Move point to event ocurred position before calling
- irchat-nick-update-region.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu):
- Remove argument event from arglist.
- (irchat-xemacs-nick-popup-menu): Move point to event ocurred
- position before calling irchat-nick-update-region.
-
- * irchat.el: Use modern key sequence expression.
- (irchat-command-map): New keymap which override
- irchat-dialogue-keys with prefix command ("\C-c").
- (irchat-friends-map): New keymap. [prefix command for friends]
- (irchat-dialogue-keys): Import some useful command keys.
-
- * irchat-channel.el (irchat-channel-parse-representation):
- To remove let, construct representation object directly.
-
- * irchat-channel.el (irchat-channel-list-insert): Remove format.
-
- * irchat-vars.el: Do not require mcharset.
-
- * irchat.el (irchat-nick-mode-map): Do not check xemacs.
-
- * irchat-xemacs.el (irchat-nick-popup-menu): New alias to
- irchat-xemacs-nick-popup-menu which override original one.
-
- * irchat-compat.el: Use emu's mouse-button emulation.
- (irchat-button2): Abolished.
- (irchat-button3): Abolished.
-
- * irchat-vars.el (irchat-variables-files): Do not load
- `~/.irchat3_vars.el' at startup time.
-
- * irchat-vars.el (irchat-debug-prefix): Clear.
-
- * irchat.el: Do not check `set-face-stipple' is bound.
- (irchat-x-splash): Add interactive spec.
-
-1999-05-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-x-splash): Do centering.
-
- * bitmap-stipple.el (bitmap-stipple-insert-pixmap):
- Add optional argument center.
-
- * liece.xbm: New file.
-
- * irchat.el: Check if liece.xbm exists.
-
- * irchat.el (irchat-stipple-pixmap): New variable.
- (irchat-x-splash): New function.
-
- * bitmap-stipple.el: New file.
-
- * irchat-modules.el (irchat-modules-to-compile): Add bitmap-stipple.
-
- * irchat-commands.el (irchat-command-send-action): Fix typo.
-
- * irchat-hilight.el (irchat-highlight-font-lock-keywords):
- Fix regexp.
-
- * irchat-inlines.el (irchat-or): New function.
- (irchat-and): New function.
-
- * irchat-filter.el (irchat-handle-msg-msg): Abolished.
-
- * irchat-crypt.el (irchat-message-encrypted-p): Move into
- irchat-message.
- (irchat-message-suspicious-p): Ditto.
- (irchat-message-garbled-p): Ditto.
- (irchat-message-fingerprint): Ditto.
- (irchat-message-timestamp): Ditto.
-
- * irchat-vars.el: All format strings are removed.
- (irchat-format-string): Abolished.
-
- * irchat-modules.el (irchat-modules-to-compile): Add
- irchat-message.
-
- * irchat-dcc.el (irchat-dcc-chat-filter): Use
- irchat-display-message.
-
- * irchat-commands.el (irchat-command-send-action):
- Bind irchat-message-type.
-
- * irchat-handle.el (irchat-handle-privmsg-msg):
- Use irchat-display-message.
- (irchat-handle-privmsglike-msg): Abolished.
-
- * irchat-misc.el (irchat-own-channel-message):
- Use irchat-display-message.
- (irchat-own-private-message): Likewise.
-
- * irchat-message.el: New file.
-
-1999-05-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el, irchat-vars.el (irchat-before-kill-emacs-hook): New hook.
-
-1999-05-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-signoff-message):
- Renamed from irchat-signoff-msg.
-
- * irchat.el (irchat-obarray-size): Moved from irchat-globals.el.
-
- * irchat-globals.el: Remove obsolete variables.
-
- * irchat-ctcp.el (irchat-client-error-message):
- Moved from irchat-globals.el.
-
- * irchat-commands.el (irchat-save-variables-are-dirty): Renamed
- from irchat-save-vars-is-dirty.
- (irchat-command-send-action): Add prefix.
-
- * irchat-400.el (irchat-nickname-last): Renamed from
- irchat-old-nickname.
-
- * irchat-000.el (irchat-servername): Abolished.
-
-1999-05-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-crypt.el: Do not require 'idea.
-
- * irchat-commands.el (irchat-command-message): Treat channel target.
-
- * irchat-300.el (irchat-handle-317-msg) <RPL_WHOISIDLE>:
- Add argument rest to match-string.
-
-1999-05-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.2.8.25.
-
- * irchat.el (irchat-command-keys): Do not bind lisp-complete-symbol.
-
- * irchat-commands.el (irchat-command-load-vars): Enclose body with
- unwind-protect.
- (irchat-command-complete): Use irchat-minibuffer-finalize-completion.
- (get-word-left): Abolished.
- (irchat-switch-to-channel-1): New function.
- (irchat-switch-to-channel): Use irchat-switch-to-channel-1.
- (irchat-switch-to-channel-no): Likewise.
- (irchat-command-message): Check crypt-type.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Complete ban patterns.
- (irchat-minibuffer-parse-modes): Rename property 'uah to 'ban.
-
- * irchat-handle.el (irchat-handle-mode-msg):
- Use irchat-channel-set-ban.
-
- * irchat-channel.el (irchat-channel-add-ban): New macro.
- (irchat-channel-remove-ban): New macro.
- (irchat-channel-set-ban): New macro.
- (irchat-channel-get-bans): New function.
-
- * irchat-300.el:
- (irchat-handle-317-msg) <RPL_WHOISIDLE>: Remove condtionals for
- obsolete servers. [2.5 or 2.6].
- (irchat-handle-367-msg) <RPL_BANLIST>: Treat it as generic long
- reply handler.
- (irchat-367-channel): New variable.
- (irchat-367-regexps): New variable.
- (irchat-handle-368-msg) <RPL_ENDOF_BANLIST>: Save ban patterns as
- 'ban property.
-
-1999-05-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system):
- Use dotimes when initializing irchat-obarray.
-
-1999-05-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-command-keys):
- Bind irchat-command-display-friends.
-
- * irchat-commands.el (irchat-command-display-friends): New command.
-
- * irchat-vars.el (irchat-display-friends-function): New variable.
-
- * irchat-300.el (irchat-303-display-friends): New function.
- (irchat-303-display-all-friends): New function.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Complete nickname using operators and voices.
- (irchat-minibuffer-parse-modes): Likewise.
- (irchat-minibuffer-finalize-completion): Notice no match found.
-
- * Makefile.am: New file.
-
-1999-05-25 UENO Daiki <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-others-mode): Set parent mode explicitly.
- (irchat-channel-mode): Ditto.
-
-1999-05-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-minibuf.el (irchat-minibuffer-parse-modes): Parse ban
- pattern.
-
- * irchat-200.el (irchat-handle-206-msg) <RPL_TRACESERVER>:
- Use multiline display format.
- (irchat-handle-214-msg) <RPL_STATSNLINE>: Likewise.
- (irchat-handle-213-msg) <RPL_STATSCLINE>: Likewise.
-
- * irchat-ctcp.el (irchat-client-insert): Quote format string.
-
-1999-05-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.2.8.24.
-
- * irchat-ctcp.el (irchat-minibuffer-complete-client-query): Use
- `irchat-minibuffer-finalize-completion'.
-
- * irchat-minibuf.el (irchat-minibuffer-finalize-completion): New
- function.
- (irchat-minibuffer-complete-channel-modes): Use above.
-
- * irchat.el (irchat-check-buffers): Fix loop condition.
-
-1999-05-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-dcc-message): New function.
-
- * irchat-nick.el (irchat-nick-join-1): Check dups.
-
- * irchat-ctcp.el (irchat-client-insert): New function.
-
- * irchat-commands.el (irchat-command-prepare-message-prefix):
- Abolished.
- (irchat-command-prepare-own-message-prefix): Ditto.
-
- * irchat-misc.el (irchat-own-private-message): Generate prefix
- string automatically.
- (irchat-own-channel-message): Likewise.
-
-1999-05-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (run-hook-with-args-until-success): Abolished.
-
- * irchat.el (irchat-command-mode): Change mode-line-format.
- (irchat-open-server): Save password.
- (irchat-insert-internal): Rewrite.
-
- * irchat-200.el (irchat-handle-215-msg) <RPL_STATSILINE>:
- Fix regexp.
- (irchat-handle-242-msg) <RPL_STATSUPTIME>: Cut off preceding `:'.
- (irchat-handle-205-msg) <RPL_TRACEUSER>: Fix typo.
- (irchat-handle-218-msg) <RPL_STATSYLINE>: Fix display format.
-
-1999-05-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-inlines.el (format-quote): Abolished.
-
- * irchat-ctcp.el (irchat-ctcp-action-msg): Pass arguments to
- PRIVMSG handler.
-
- * irchat-hilight.el (irchat-highlight-turn-on-font-lock): Make
- `after-change-hook' local.
-
-1999-05-12 sphere <sphere@pop12.odn.ne.jp>
-
- * irchat-url.el (irchat-command-browse-url): Fix typo.
-
-1999-05-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-crypt.el (irchat-command-set-default-key): Fix typo.
-
- * irchat-window.el (irchat-command-set-window-style): Fix typo.
-
- * irchat-url.el (irchat-command-browse-url): Fix typo.
-
- * irchat-channel.el (irchat-channel-set-voice): Quote regexp.
-
-1999-05-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (irchat-command-client-time): Fix typo.
-
- * irchat.el (irchat-channel-mode): Explicitly define as
- it derives from `irchat-dialogue-mode'.
- (irchat-others-mode): Ditto.
-
- * irchat-compat.el (irchat-kill-all-overlays): New function.
-
- * irchat-nick.el (irchat-nick-update): Do not switch to buffer.
- (irchat-nick-join): Do not check whether nickname has been inserted.
- (irchat-nick-update): Kill all overlays.
-
- * irchat-mail.el: Follow the value of `mail-user-agent'.
- (irchat-mail-pop-to-buffer): Abolished.
- (irchat-mail-compose-with-mail): Abolished.
- (irchat-mail-compose-with-gnus): Abolished.
-
- * irchat-inlines.el (nth1, nth1cdr):Abolished.
- (matching-substring): Abolished.
- (irchat-greater-flags): Abolished.
-
-1999-05-08 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-353-scan-channels): New macro.
-
- * irchat-minibuf.el (irchat-minibuffer-completing-default-read):
- Renamed from `irchat-completing-default-read'.
- (irchat-minibuffer-completing-sequential-read): Renamed from
- `irchat-completing-sequential-read'.
-
- * irchat-channel.el (irchat-channel-set-operator-1): Renamed from
- `irchat-set-channel-operator' within irchat-misc.el.
- Restrict its use to internal only.
- (irchat-channel-set-voice-1): Likewise.
-
- * irchat-commands.el (irchat-command-wait): Abolished.
-
- * irchat-nick.el (irchat-nick-update): Assume that the 2nd
- argument CHNL is one of channels we've already joined.
-
- * irchat-misc.el (irchat-change-nick-of): Change nicks, opers and
- voices properties properly.
- (irchat-change-nick-of-1): New function. Modify nick alist by
- side effect.
- (irchat-change-nick-of-2): New function which resembles above,
- but it acts on singular list.
- (irchat-greet-user): Abolished.
- (irchat-user-on-my-channel): Abolished.
- (irchat-user-on-this-channel): Abolished.
-
- * irchat-handle.el (irchat-handle-channel-msg): Do not use
- `irchat-change-nick-of' directly.
- (irchat-handle-nick-msg): Likewise.
- (irchat-handle-quit-msg): Likewise.
-
-1999-05-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-nickname): Do not set
- `irchat-real-nickname'.
-
-1999-05-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.23.
-
- * irchat-hilight.el (irchat-quoted-colors): New variable.
- (irchat-highlight-colorize-quote): New function.
- (irchat-highlight-turn-on-font-lock): Add buffer locality to
- some members of `after-change-hook'.
-
- * Makefile (install): Do not depend on `dcc'.
-
-1999-05-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Call
- `irchat-channel-part' and `irchat-nick-part' exclusively.
- (irchat-handle-kick-msg): Likewise.
-
- * irchat-channel.el (irchat-channel-equal): New alias.
- (irchat-channel-member): Renamed from `irchat-channel-memberp'.
- (irchat-channel-join-internal): New function.
- (irchat-channel-part-internal): New function.
-
- * irchat-ctcp.el (irchat-ctcp-client-msg): Fix reply string.
-
- * irchat-minibuf.el (irchat-minibuffer-parse-modes): Completion
- fixed for ban pattern.
-
- * irchat-nick.el (irchat-nick-normalize): New macro.
- (irchat-nick-strip): New macro.
- (irchat-nick-parse-nick-after): New function.
-
- * irchat-handle.el (irchat-handle-silence-msg): New handler.
-
-1999-05-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Fix quotation of part
- message.
-
- * irchat-400.el: Fix unconsistent user data returned from pirc.
- (irchat-handle-442-msg): `ERR_NOTONCHANNEL'.
- (irchat-handle-443-msg): `ERR_USERONCHANNEL'.
-
- * irchat-misc.el (irchat-update-thischannel): Abolished.
-
- * irchat-commands.el (irchat-channel-virtual): Save matched data.
- (irchat-channel-real): Likewise.
-
- * irchat-300.el (irchat-handle-364-msg): `RPL_LINKS'. Fix regexp.
- (irchat-handle-333-msg): New hander for `RPL_TOPICWHOTIME'.
- (irchat-handle-namereply-msg): Abolished.
- (irchat-handle-whoreply-msg): Abolished.
-
- * irchat-000.el (irchat-handle-005-msg): `RPL_MAP'.
- Support for ircu server mapping facility.
- (irchat-handle-006-msg): New handler for `RPL_MAPMORE'.
- (irchat-handle-007-msg): New handler for `RPL_MAPEND'.
-
-1999-05-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Handle left message.
-
- * irchat-custom.el (irchat-connection-timeout): New variable.
-
- * irchat.el (irchat-accept-response): Add optional arg timeout.
- (irchat-accept-process-output): New function.
- (irchat-clear-system): Reset `irchat-timers-list-initialized-p'.
- (irchat-initialize-timers): Fix secs parameter.
-
- * irchat-xemacs.el (irchat-xemacs-run-at-time): New function.
-
- * irchat-compat.el (irchat-run-at-time): New alias.
- (irchat-cancel-timer): New alias.
-
- * irchat-commands.el (irchat-command-start-ison-timer): Abolished.
- (irchat-command-cancel-ison-timer): Abolished.
-
- * irchat-timer.el: Removed.
-\f
-1999-04-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-initialize-timers): New function.
-
- * irchat-q-ccl.el (irchat-quote-ccl-decode-region): New function.
- (irchat-quote-ccl-encode-region): New function.
-
- * irchat-q-el.el (irchat-quote-el-decode-region): New function.
- (irchat-quote-el-encode-region): New function.
-
- * irchat-ctcp.el (irchat-complete-client): New macro.
- (irchat-complete-query): New macro.
- (irchat-command-client-time): New command.
- (irchat-ctcp-client-msg): Rename each *-msg-hook to *-hook.
- (irchat-minibuffer-complete-client-query): New function.
-
- * irchat-commands.el (irchat-command-activate-friends): Fix
- completion.
-
- * irchat-compat.el (filter-elements): Add `lisp-indent-function'
- property with value 2.
-
-1999-04-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-dcc-object): Implement as cl-struct.
-
- * irchat-compat.el (irchat-static-require): New macro.
- (irchat-static-require-if): New macro.
- (irchat-static-defun-if): New macro.
-
- * Liece 1.2.8.22.
-
-1999-04-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * README-styles.ja, TODO.ja, sample.dot.liece.ja: Removed.
-
-1999-04-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-inlines.el: Require irchat-setup.
-
- * irchat-x-face.el: Use `static.el'.
-
- * irchat-handle.el (irchat-handle-join-msg): Set user-at-host
- information after calling `irchat-nick-join'.
-
- * irchat-globals.el (irchat-default-channel-candidate): New
- variable.
-
-1999-04-22 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-324-msg): Fix regexp.
-
-1999-04-16 Daiki Ueno <ueno@bleu.ueda.info.waseda.ac.jp>
-
- * irchat-xemacs.el: Add hooks to hide modelines.
-
-1999-04-12 Daiki Ueno <ueno@bleu.ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-refresh-windows): New function.
-
- * irchat-300.el: Remove all occurrences of `matching-substring'.
- (irchat-handle-352-msg): Do not pick-up channel buffer.
-
- * irchat-config.el, irchat-modules.el: New files.
-
-1999-04-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-switch-to-channel-no-*): Use `dotimes' on the
- definitions of themselves.
-
- * irchat-vars.el (irchat-ignore-spec-convert): Fix tag.
-
-1999-04-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * dcc.c (send_file): Use `get_address_externally'.
- (chat_listen): Likewise.
-
-1999-04-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * getaddrinfo.c: Include `stdlib.h'.
-
-1999-04-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.21.
-
- * irchat-handle.el (irchat-handle-mode-msg): Fix channel mode parser.
-
- * irchat-commands.el (irchat-command-ban-kick): New command.
- (irchat-command-ban): New command.
-
- * irchat-ctcp.el (irchat-ctcp-version-msg): Eliminate the client
- version string.
- (irchat-client-version-notice): Fix regexp.
- (irchat-client-version-insert): New function.
-
- * irchat-misc.el (irchat-repair-crlf): Fixed.
-
-1999-04-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * tcp.c (NI_MAXHOST): Add check if it has been already defined.
-
- * irchat.el (irchat-command-keys): Bind `C-c C-j'.
-\f
-1999-03-31 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-mode-msg): Fix regexp.
-
- * irchat-commands.el (irchat-command-finger): Add prefix arg.
-
-1999-03-30 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-filter.el (irchat-handle-message): Fix regexp.
-
- * irchat-handle.el (irchat-handle-join-msg): Fix regexp.
- (irchat-handle-nick-msg): Fix regexp.
-
-1999-03-24 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-finger): Specify nick twice.
-
- * liece-faq.texinfo: Fix URI of APEL's ftp sites.
-
-1999-03-17 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.20.
-
- * irchat-crypt.el (with-irchat-encryption): New macro.
- (with-irchat-decryption): New macro.
-
- * irchat-compat.el (valid-plist-p): Fixed.
-
- * irchat-tcp.el (irchat-tcp-default-connection-type): Renamed from
- `irchat-tcp-connection-type'.
- (irchat-open-network-stream-as-binary): Add optional arg `type'.
- (irchat-open-network-stream): Likewise.
-
- * irchat-vars.el (irchat-server-alist): Add `:prescript' and
- `:type' keywords.
-
-1999-03-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el: Require `pcustom'.
- (point-at-bol): Abolished. Use `line-beginning-position'.
- (point-at-eol): Abolished. Use `line-end-position'.
-
- * tcp.c: New file.
-
- * irchat-tcp.el: New file; TCP/IP emulation using external program.
-
- * irchat-compat.el (read-passwd): New function to keep compatibility.
- (passwd-echo): New variable to keep compatibility.
-
- * irchat-commands.el (irchat-command-who): Confirm really send WHO
- command with no arguments.
- (irchat-command-list): Likewise.
- (irchat-command-names): Likewise.
-
- * irchat-misc.el (irchat-set-crypt-indicator): Activate crypt mode
- also in private mode.
- (irchat-read-passwd): Abolished. Use `read-passwd'.
-
- * irchat-crypt.el (irchat-crypt-maybe-encrypt-message): Renamed
- from `irchat-crypt-with-encrypt-message'.
- (irchat-crypt-maybe-decrypt-message): Likewise.
-
-1999-03-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-join-msg): Fix regexp.
-
- * irchat-hilight.el (irchat-highlight-maybe-hide-quote): Fixed.
-
-1999-03-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.19.
-
- * irchat-commands.el (irchat-command-poll-names): Check if
- `irchat-server-opened' returns t.
- (irchat-command-poll-friends): Likewise.
-
- * irchat-hilight.el (irchat-highlight-turn-on-font-lock): Remove
- all hooks before calling `turn-on-font-lock'.
-
- * irchat-compat.el (run-hook-with-args-until-success): Do not use
- `run-hook-with-args'.
-
- * irchat-filter.el (irchat-handle-message-2): Use
- `run-hook-with-args-until-success' instead of
- `run-hook-with-args'.
-
- * irchat-handle.el (irchat-handle-with-running-cleartext-hook):
- Use `run-hook-with-args-until-success' instead of
- `run-hook-with-args'.
- (irchat-handle-run-cleartext-hook): Likewise.
- (irchat-handle-run-hook-with-args): Likewise.
-
- * irchat-timer.el (irchat-start-timer): Use `run-at-time' with 1st
- argument 0 instead of nil.
-
- * irchat-ctcp.el (irchat-query-client-nick-maybe-change): Return
- with nil explicitly.
-
- * irchat-vars.el (irchat-service-spec): New widget.
- (irchat-service-spec-convert): New function; widget-converter.
- (irchat-server-spec): New widget.
- (irchat-server-spec-convert): New function; widget-converter.
- (irchat-ignore-spec): New widget.
- (irchat-ignore-spec-convert): New function; widget-converter.
-
- * irchat-url.el (irchat-command-browse-url): Use the URL added
- most recently, if `current-prefix' equals `-'.
- (irchat-url-browser-netscape): Do not bind the process buffer.
-
- * irchat-menu.el (irchat-menu-add-button): Add 3rd argument.
-
-1999-03-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-xemacs.el: Use extents instead of overlays.
- (irchat-xemacs-put-text-property): New function.
- (irchat-xemacs-get-text-property): New function.
- (irchat-xemacs-kill-all-overlays): New function.
- (irchat-xemacs-overlays-at): New function.
-
- * irchat-compat.el (irchat-make-overlay): New emulation function.
- (irchat-delete-overlay): Ditto.
- (irchat-overlay-put): Ditto.
- (irchat-move-overlay): Ditto.
- (irchat-overlay-end): Ditto.
- (irchat-overlay-get): Ditto.
- (irchat-overlays-at): Ditto.
- (irchat-kill-all-overlays): Ditto.
-
-1999-03-12 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-toolbar-toggle-crypt): New function.
- (irchat-toolbar-icon-convert): New function; widget-converter.
- (irchat-toolbar-icon): New widget.
- (irchat-toolbar-icon-plist-get): New function.
- (irchat-toolbar-map-button-list): New function.
- (irchat-xemacs-setup-toolbar): Renamed from
- `irchat-xemacs-setup-toolbar-list'.
- (irchat-toolbar-setup-crypt-glyph): New function.
- (irchat-toolbar-toggle-crypt): New function.
- (irchat-use-toolbar): New customizable variable.
-
- * irchat-compat.el (irchat-put-text-property): Implemented as
- function.
-
- * irchat.el (irchat-after-load-startup-hook): New hook variable.
-
- * irchat-hilight.el (irchat-highlight-maybe-turn-on-font-lock):
- New function.
-
- * Liece 1.2.8.18.
-
- * irchat-channel.el (irchat-channel-create-buffer): Use
- `irchat-format-time-function'.
-
- * irchat-hilight.el: Use font-lock.el.
-
-1999-03-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-debug.el (irchat-debug-enter-handler): Moved from
- llhandler.el.
- (irchat-debug-leave-handler): Ditto.
-
- * llhandler.el (llhandler-debug-enter): Abolished.
- (llhandler-debug-leave): Abolished.
-
- * irchat-version.el (irchat-emacs-user-agent-value): New variable
- imported from `mime-edit-user-agent-value' of SEMI.
- (irchat-user-agent-value): New variable.
- (irchat-make-user-agent-string): Abolished.
- (irchat-make-emacs-user-agent-string): Abolished.
- (irchat-command-version): New command.
-
- * irchat-hilight.el (irchat-maybe-highlight-region): New function.
- (irchat-maybe-smiley-region): New function.
- (irchat-maybe-highlight-url-region): New function.
- (irchat-highlight-put-url-properties-region): New function.
-
- * irchat-ctcp.el: Add hooks in order to let
- `irchat-query-client-nick' follow the changes.
- (irchat-query-client-nick-maybe-change): New function.
- (irchat-query-client-nick-maybe-reset): New function.
-
- * irchat-url.el (irchat-url-gather-hook): New hook variable.
- (irchat-command-browse-url): Use `_'.
- (irchat-url-gather-urls-region): New function.
- (irchat-url-search-forward): New function.
-
- * irchat-compat.el (easy-menu-add-item): New alias.
-
- * irchat-xemacs.el (easy-menu-add-item): New advice.
-
-1999-03-10 Tsunehiko Baba <tbaba@mtl.t.u-tokyo.ac.jp>
-
- * dcc.c (main): Add cast against return value of basename(3).
-
-1999-03-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-menu.el (irchat-menu-url-menu): New variable.
-
- * Liece 1.2.8.17.
-
- * irchat-misc.el (irchat-compose-time-string): Renamed from
- `irchat-compose-servertimestring'.
-
- * irchat-compat.el (plist-get): New function for compatibility.
-
- * irchat-ctcp.el (irchat-client-time-notice): New handler.
- (irchat-ctcp-time-msg): Ditto.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Also display candidates when `irchat-minibuffer-parse-modes'
- returns 'flag.
-
- * irchat-400.el (irchat-handle-433-msg): `ERR_NICKNAMEINUSE'.
- Do grow-tail iteration on `irchat-real-nickname' only if
- `irchat-auto-iterate-nick' is specified.
-
- * irchat-vars.el (irchat-server-alist): Enable to specify keywords
- (:host, :service, :password, etc.).
- (irchat-auto-iterate-nick): New customizable variable.
-
- * irchat-menu.el (irchat-menu-add-url): New function.
- (irchat-command-mode-url-menu): New menu entry.
-
- * irchat.el (irchat): Do not ping to server.
- (irchat-open-server): Use new format of `irchat-server-alist'.
-
-1999-03-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-privmsglike-msg): Define as subst.
-
- * irchat-make.el (install-just-print-p): New function
- imported from APEL 9.13's `APEL-MK'.
- (config-irchat-package): Likewise.
- (compile-irchat-package): Likewise.
- (install-irchat-package): Likewise.
- (install-update-package-files): Likewise.
- (make-irchat-sample-files): New function imported from packaged
- version of Liece.
- (make-irchat-info-files): Ditto.
-
- * irchat-300.el (irchat-handle-366-msg): Do not update nicks when
- `irchat-353-nameslist' holds no element.
-
-1999-03-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-quit-msg,
- irchat-handle-mode-msg, irchat-handle-join-msg,
- irchat-handle-part-msg): Quote regexp.
-
-1999-02-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system): Fix backquotes.
-
-1999-02-25 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-303-msg): Fix. Add check for empty
- reply.
-
-1999-02-24 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-notice-msg): Fix. Call handler
- with `funcall'.
-
- * irchat.el (irchat-channel-mode-map): Make keymap as sparse.
- (irchat-others-mode-map): Likewise.
-
- * irchat-commands.el (irchat-command-deactivate-friends):
- Fix argument.
-
- * Liece 1.2.8.16.
-
- * irchat-globals.el (irchat-who-expression): New variable.
-
- * irchat-misc.el (irchat-toggle-command-buffer-mode): Change
- `irchat-private-indicator'.
-
- * irchat-300.el (irchat-handle-315-msg): `RPL_ENDOFWHO'.
- Display `no matches found' message
- (irchat-handle-{322,323,353,366}-msg): Count iterations.
-
- * irchat.el (irchat-command-mode): Do not save
- `frame-title-format' twice. Use `irchat-current-channel' in place
- of `irchat-channel-indicator'.
-
- * llhandler.el (llhandler-debug-enter): New function.
- (llhandler-debug-leave): New function.
- (llhandler-define-handler): New macro.
- (llhandler-eval-args): Abolished.
-
- * irchat-crypt.el (irchat-encrypt-message): Encode messages.
- (irchat-decrypt-message): Likewise. Decode messages.
- (irchat-crypt-with-encrypted-message): Do not encode message which
- has type `cleartext'.
-
-1999-02-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-send-pong): New macro.
- (irchat-increment-long-reply-count): New macro.
- (irchat-reset-long-reply-count): New macro.
- (irchat-check-long-reply-count): New macro.
-
- * irchat-globals.el (irchat-long-reply-count) New variable.
- (irchat-long-reply-max): New variable.
-
- * irchat-commands.el (irchat-command-save-vars): Fix. Set marker
- at output position.
-
-1999-02-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-303-msg): Add differential IsON.
-
- * irchat-commands.el (irchat-command-start-ison-timer,
- irchat-command-cancel-ison-timer, irchat-command-activate-friends,
- irchat-command-deactivate-friends): Do completion case
- insensitively.
-
- * irchat-vars.el (irchat-saved-forms): Add symbol `irchat-friends'
- to be saved its value.
-
-1999-02-20 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.15.
-
- * irchat-filter.el (irchat-sentinel): Do not throw signal, just
- clear whole system.
- (irchat-sentinel-error): Ditto.
-
- * irchat-vars.el (irchat-friends): New user customizable variable.
- (irchat-poll-friends-interval): New user customizable variable.
- (irchat-poll-names-interval): New user customizable variable.
-
- * irchat-commands.el (irchat-command-poll-names): Renamed from
- `irchat-command-pollnames'; implemented as function.
- (irchat-command-keepalive): Implemented as function.
- (irchat-command-poll-friends): New function.
- (irchat-command-activate-friends): New command.
- (irchat-command-deactivate-friends): New command.
-
- * irchat-300.el (irchat-handle-331-msg): Call
- `irchat-set-channel-indicator'.
- (irchat-handle-332-msg): Ditto.
-
- * irchat-globals.el (irchat-channel-status-indicator): New
- variable; default value of `frame-title-format'.
- (irchat-friends-last): New variable.
- (irchat-frame-title-format-last): New variable.
-
- * irchat-misc.el (irchat-set-frame-title-format): Do not calculate
- `frame-title-format' directly.
- (irchat-maybe-update-channel-indicator): New macro.
-
-1999-02-20 P.F.FrontJr. <pff@softai.co.jp>:
-
- * irchat-misc.el (irchat-set-channel-indicator): Display channel
- status on mode line.
-
- * irchat-vars.el (irchat-display-status-on-channel-indicator):
- New user customizable variable.
-
-1999-02-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): Set alternative
- startup file as primary one.
-
- * irchat-timer.el (irchat-start-timer): Do not require `timer' or
- `itimer'; autoload timer functions.
- (irchat-cancel-timer): Ditto.
-
-1999-02-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ck-ccl (irchat-ck-ccl): Remove.
- (irchat-ck-ccl-cj-to-ck-string): Use `ccl-execute-on-string'.
- (irchat-ck-ccl-ck-to-cj-string): Ditto.
-
- * irchat-xemacs.el (irchat-xemacs-setup-toolbar): New function.
-
- * irchat-menu.el (irchat-command-add-menus): New function; add
- menubar menus explicitly.
-
- * irchat-coding.el (irchat-coding-custom-detect-coding-region):
- New variable; set user customizable function to detect coding system.
- (irchat-coding-custom-detect-coding-string): Likewise.
- (irchat-detect-coding-string-tcljp): Transported from
- `tclKanjiUtil.c'; trivial encoding detection routine.
- (irchat-default-coding-system): Moved from `irchat-vars.el'.
- (irchat-default-mime-charset): Ditto.
- (irchat-detect-coding-system): Ditto.
-
- * crc32.el (crc32-region): Remove `mark-active'.
-
- * irchat-timer.el (irchat-cancel-timer): Fix for XEmacs's
- `itimer'.
-
- * Liece 1.2.8.14.
-
- * irchat-dcc.el (irchat-dcc-requests): Rename from
- `irchat-dcc-request-list'; implemented as actually a queue.
-
- * queue-m.el: New file; imported from elib.
-
- * irchat-filter.el (irchat-filter): Remove checking whether
- process output line contains LF; remove duplicated LF checking
- likewise; enclose with `save-match-data'.
- (irchat-handle-message): Add checking user-at-host cookie with
- restricted line.
-
- * irchat-window.el (irchat-window-functionp): Remove; use
- `irchat-functionp'.
-
- * irchat-channel.el (irchat-channel-get-nicks): Fix; apply car
- against each elements.
-
-1999-02-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-mode+o,
- irchat-command-mode+v): Build completion list using
- `filter-elements'.
-
- * irchat-vars.el (irchat-exit-hook): Rename from
- `irchat-Exit-hook'.
-
- * irchat-inlines.el (irchat-functionp): New macro.
-
- * irchat-compat.el (mapvector): New macro.
-
- * irchat-misc.el (irchat-greet-author): Remove.
- (irchat-split-rest): Fix arguments.
- (irchat-completing-default-read): 3rd and later arguments become
- optional.
- (irchat-completing-sequential-read): Evaluate completion table
- consequently; Add optional argument `multiple-candidate', if this
- arg is non-nil always create new table with its initial state.
-
- * llhandler.el (llhandler-define-entry-point): Add debugging
- triger in frount of function definition.
- (llhandler-define-with-return): Ditto.
- (llhandler-define): Ditto.
- (llhandler-enter-format-string): New constant; for debugging use.
- (llhandler-leave-format-string): Ditto.
- (llhandler-eval-args): New macro.
-
- * irchat.el (irchat-open-server-internal): Use
- `open-network-stream-as-binary'.
- (irchat-startup-hook): Rename from `irchat-Startup-hook'.
-
-1999-02-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.13.
-
- * idea.el (idea-ecb-decrypt-string): Enclose Base64 decoded string
- with `string-as-unibyte'.
- (idea-cbc-decrypt-string): Ditto.
-
- * idea.el: Sync up with Irchat-980625-2.
-
- * crc32.el: Ditto.
-
- * irchat-300.el (irchat-handle-303-msg): Fix matched string.
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Check whether
- private message has come from entirely outer.
-
- * irchat-filter.el (irchat-handle-message): Remove all occurence
- of CR out of inputs :(
-
-1999-02-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): Save alternatively
- specified startup file name into `irchat-variables-files'.
-
-1999-02-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-command-dcc-accept): Remove destructive
- checking.
-
- * irchat-make.el: Do not use `add-to-list' for Emacs19.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
-
-1999-02-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-coding.el (irchat-coding-detect-coding-region)
- (irchat-coding-detect-coding-string): New function.
- (irchat-coding-decode-mime-charset-region): Use above directly.
- (irchat-coding-decode-mime-charset-string): Ditto.
-
-1999-02-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-who): Fixed setting
- `irchat-channel-alist.
-
- * Liece 1.2.8.12.
-
- * irchat-nick.el (irchat-nick-get-user-at-host): New macro.
-
- * irchat-compat.el (temp-minibuffer-message): New function.
-
- * irchat-minibuf.el: New file; custom minibuffer completion.
-
- * irchat.el (irchat-open-server-internal): Add check for dotless
- IP or IPv6 address representation.
-
- * irchat-channel.el (irchat-channel-set-voice): Replace with
- regexp.
-
-1999-02-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-319-msg): Fixed channel conversion.
-
- * irchat-commands.el (irchat-command-modec): Fixed completion.
- (irchat-command-mode-o,irchat-command-mode+v,irchat-command-mode-v):
- Fix format string.
-
- * dcc.c (chat_listen): Print connection result.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen): Add dummy
- argument `chat' for compatibility.
-
- * irchat-channel.el (irchat-channel-remove-mode): Use `delq'.
- (irchat-nick-remove-mode): Ditto.
-
- * Liece 1.2.8.11.
-
- * irchat-menu.el (irchat-menu-popup-menu): Check whether XEmacs or
- not compile time.
-\f
-1999-01-31 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (set-keymap-parents): New macro.
-
- * irchat-commands.el (irchat-command-join-channel): Add flag
- whether `irchat-command-buffer-mode' is toggled.
- (irchat-command-join-partner): Ditto.
-
- * irchat-300.el (irchat-count-words-from-string): Count postfix
- white spaces.
-
- * irchat-q-el.el: Splited from `irchat-ctcp.el'; binary data
- quotation in emacs-lisp.
- * irchat-q-ccl.el: Same functionality as above but implemented in
- Emacs CCL.
-
- * b64.el (b64-encode-string, b64-decode-string): Add autoload
- cookie.
-
- * irchat.el (irchat-channel-list-keys): New variable.
- (irchat-define-keys): Add lisp-mode indentation.
- (irchat-channel-mode-map, irchat-others-mode-map): Set
- `irchat-dialogue-mode-map' as its keymap parent.
-
-1999-01-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.10.
-
- * dcc.c: Rewritten but this is obsoleted.
-
- * irchat-commands.el (irchat-command-end-of-buffer): Renamed from
- `irchat-command-eod-buffer'; this works also in `irchat-{channel,
- others}-buffer-mode'.
-
- * dcc.ml (getaddr_ext): New function.
-
- * irchat-dcc.el (irchat-dcc-send-filter): Fix regexp.
- (irchat-dcc-add-to-process-alist): Add process key as symbol.
- (irchat-dcc-get-process-object): Likewise.
- (irchat-command-dcc-receive): Fixed arguments of
- `irchat-dcc-add-to-process-alist'.
- (irchat-command-dcc-send): Likewise.
- (irchat-command-dcc-accept): Fix typo.
-
-1999-01-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-others-mode-map): Add key binding of
- `irchat-command-tag-region'
-
- * irchat-commands.el (irchat-command-join-channel): Use
- `irchat-channel-memberp'.
- (irchat-command-modec): Make completion from supported mode list.
- (irchat-channel-real): Try match with
- `irchat-channel-conversion-map' case insensitively.
- (irchat-channel-virtual): Ditto.
-
-1999-01-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-supported-channel-mode-alist):
- (irchat-supported-user-mode-alist): New variable
-
- * irchat-nick.el (irchat-nick-get-modes): New macro.
- (irchat-nick-add-mode): New macro.
- (irchat-nick-remove-mode): New macro.
- (irchat-nick-set-mode): New macro.
-
- * irchat-000.el (irchat-handle-004-msg): Save server supported
- modes.
-
- * Liece 1.2.8.9.
-
- * irchat-make.el: Add local copy of APEL to `load-path'.
- (autoload-irchat): New function to generate autoload file.
-
- * irchat.el (irchat-command-keys): Add key definition of
- `irchat-command-set-window-style' (C-c s).
- (irchat): Parse `irchat-variables-files' specified in command
- line.
- (irchat-read-variables-files): Add optional argument `file'.
-
- * irchat-window.el (irchat-window-set-default-style): Fallback
- style used when encountered an error at style-file loading time.
-
- * irchat-handle.el (irchat-handle-mode-msg): Gather channel modes
- correctly.
-
- * irchat-channel.el (irchat-channel-get-modes): New macro.
- (irchat-channel-set-mode): New macro.
- (irchat-channel-add-mode): New macro.
- (irchat-channel-remove-mode): New macro.
-
- * irchat-menu.el (irchat-menu-prepare-menus): Fix typo in
- `irchat-command-previous-channel'.
- (irchat-menu-IRC-menu): Add menu items.
-
-1999-01-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-change-nick-of): Fixed.
-
-1999-01-22 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * llhandler.el: New file.
-
- * Liece 1.2.8.8.
-
- * irchat-handle.el (irchat-handler-defun-*): Abolished.
- (irchat-handler-defsubst-*): Abolished.
- (irchat-handler-obarray): New variable.
- (irchat-handle-error-msg): New handler.
- Handler API has been rewritten with `irchat-handler-obarray',
- which enables faster handler lookup from hash.
-
-1999-01-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Rewritten with new handler API.
- (irchat-ctcp-file-save-directory): New user variable.
- (irchat-client-message): New macro.
- (irchat-client-file-message): New macro.
-
- * irchat-vars.el (irchat-gather-channel-modes): New user variable.
- (irchat-*-buffer): Moved into `irchat-globals.el'.
-
- * irchat-misc.el: Require `invisible'.
- (irchat-remove-properties-region): Use
- `next-single-property-change' instead of `next-property-change'.
- (next-visible-point): Add advice to pass optional argument
- `limit'.
- (irchat-change-nick-of): Fixed.
-
-1999-01-20 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (filter-elements): Renamed from `filtercar'.
- Rewritten as macro with referring to `dabbrev-filter-elements'.
-
- * defface.el (defface-set-face-inverse): New function.
- (defface-face-inverse): Ditto.
- (defface-set-face-bold): Abolished. Use `face-set-bold-p'.
- (defface-face-bold): Abolished. Use `face-bold-p'.
- (defface-set-face-italic): Abolished. Use `face-set-italic-p'.
- (defface-face-italic): Abolished. Use `face-italic-p'.
-
-1999-01-19 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-tag-region): Renamed from
- `irchat-dialogue-tag-line'. Add removing 'face and 'invisible
- properties from text moved into kill ring.
-
- * sample.dot.liece{,.ja}: Fixed documentation about window
- configuration.
-
- * irchat-misc.el (irchat-pick-buffer): Assume that channel names
- are associated to channel buffers case insensitively.
- (irchat-remove-properties-region): New macro.
-
-1999-01-18 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (keymap-accept-event-array): Abolished.
-
- * Liece 1.2.8.7.
-
- * irchat-misc.el (matching-substring): Became an alias for
- `match-string'.
-
- * irchat.el (irchat-open-server): Fixed.
- (irchat-open-server-internal): Fixed.
- Do not require `smiley'.
-
-1999-01-17 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-364-msg): Fixed.
-
- * irchat-200.el (irchat-handle-213-msg): Fixed.
-
- * irchat-intl.el (irchat-intl-load-catalogue): Do not bind `lang'
- to `current-language-environment'.
-
- * irchat-window.el (irchat-configure-windows): Switch to
- `irchat-command-buffer' before calling function
- `irchat-window-configure-frame'.
-
- * irchat-timer.el: Enclose statement which has newly styled macros
- with `eval'.
-
- * irchat-compat.el (run-hook-with-args-until-success): New macro
- for compatibility.
-
- * irchat-misc.el (irchat-convert-received-input): New macro.
- No longer require `irchat-filter'.
-
-1999-01-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-caesar.el: Abolished.
-
- * irchat-compat.el (function-documentation): New macro.
-
- * irchat-commands.el (irchat-command-point-back-to-command-buffer):
- New command. Bind key to `c'.
- (irchat-command-caesar-line): Abolished. Use `mule-caesar-region'.
-
- * irchat-misc.el (irchat-is-message-ignored): Moved from
- `irchat.el'.
- (irchat-maybe-poll): Ditto.
- (irchat-set-crypt-indicator): Ditto.
- (irchat-get-buffer-create): Ditto.
- (irchat-hex-char-to-integer): Imported from `misty1.el'.
- (irchat-hex-string-to-integer): Ditto.
-
-1999-01-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): New function.
- (irchat-command-read-variables-files): New alias to
- `irchat-read-variables-files'.
- (irchat-initialize-buffers): New wrapper function.
- (irchat-replace-internal): New macro.
- (irchat-insert-internal): New macro.
-
- * irchat-compat.el (ccl-enable-to-read-multibyte): New broken
- facility.
- (buffer-or-string-p): New macro.
-
- * irchat-misc.el (irchat-send-as-binary): New macro.
- (irchat-send): Add `string-as-unibyte' while checking length of
- string.
- (irchat-replace-in-string): Abolished.
-
- * irchat-ck-ccl.el: CCL version of `ck' to `cj' converter.
-
- * irchat-ck-el.el: Renamed from `irchat-hankana.el'.
-
- * irchat-make.el: irchat-make.el: Add checking whether CCL accepts
- `read-multibyte-character'.
-
-1999-01-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-nickname): New macro.
-
- * irchat-window.el (irchat-configure-windows): Enclose
- calling function `irchat-window-configure-frame' with
- `save-excursion'.
-
- * irchat-crypt.el (irchat-crypt-with-decrypt-message):
- Renamed from `irchat-crypt-with-encrypted-message'.
- (irchat-crypt-with-encrypt-message): New macro.
-
- * irchat-commands.el (irchat-command-join-partner): Fixed.
- (irchat-command-timestamp): Fixed.
- (irchat-command-send-message): Fixed.
- (irchat-command-message): Fixed.
- (irchat-command-prepare-message-prefix): New macro.
- (irchat-command-prepare-own-message-prefix): New macro.
-
- * Liece 1.2.8.6.
-
- * irchat-channel.el (irchat-channel-join): Fixed.
-
- * irchat-url.el (irchat-url-prepare-browser-function): New macro.
- (irchat-url-command-browse-url): Add checking
- `irchat-url-browser-name' prior to `irchat-url-browser-function'.
-
-1999-01-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * README-styles.ja: New file.
-
- * irchat-channel.el (irchat-channel-change): Enclose with
- `save-excursion'.
-
-1999-01-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat): Fixed bug in XEmacs toolbar specification.
-
-1999-01-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-get-joined-channels): New macro.
-
- * irchat-channel.el (irchat-channel-get-nicks): New macro.
- (irchat-channel-get-opers): Ditto.
- (irchat-channel-get-voices): Ditto.
- (irchat-channel-get-topic): Ditto.
-
- * styles/{top,bottom}: Fixed command buffer lines.
-
- * Liece 1.2.8.5.
-
- * irchat.el (irchat-insert): Remove checking "(featurep 'custom)".
-
- * defface.el: New file.
-
-1999-01-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handler-define-entry-point): New alias.
- (irchat-handler-defun-with-return): New macro.
- (irchat-handler-defsubst-with-return): New macro.
-
- * irchat-{000,200,300,400,500}.el: Rewritten with new handler API.
-
- * irchat-handle.el (irchat-handler-entry-point-defun): New macro.
- (irchat-handler-entry-point-defsubst): New macro.
-
- * irchat-handle.el (irchat-handle-with-running-cleartext-hook):
- Renamed from `irchat-handle-with-cleartext-hook'.
- (irchat-handle-run-cleartext-hook):
- Renamed from `irchat-handle-cleartext-hook'.
-
-1999-01-08 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * styles/top: New file.
-
- * irchat-misc.el (irchat-message): New macro.
-
- * Liece 1.2.8.4.
-
- * styles/{bottom,middle}: New file.
-
- * irchat-window.el (irchat-configure-windows): Moved from
- `irchat'.
-
- * irchat-window.el: New file for style-based window configuration.
-
- * irchat-nick.el (irchat-nick-replace): Fixed moving point to
- highlight mouse face.
-
-1999-01-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-update-region): Set point to mouse
- clicked position.
-
- * Liece 1.2.8.3.
-
- * irchat.el (irchat-nick-mode-map): Add popup menu.
-
- * irchat-menu.el (irchat-nick-popup-menu): New function.
- (irchat-menu-popup-menu): New macro.
-
- * irchat-intl.el (irchat-intl-get-msgstr-if): New macro.
-
- * irchat-nick.el (irchat-nick-update-region): New function.
- (irchat-nick-region-nicks): Moved from `irchat-xemacs'.
- (irchat-nick-region-opers): Ditto.
- (irchat-nick-region-voices): Ditto.
-
- * irchat-menu.el (irchat-menu-callback-*): Moved from
- `irchat-xemacs'.
- (irchat-menu-define-menus): Moved to defadviced block.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Shared
- `irchat-nick-update-region'.
-
- * irchat-channel.el (irchat-channel-set-operator): Fixed regexp.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
-
-1999-01-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-replace): Fixed execution order.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
- And enclose `save-restriction'.
-
- * irchat-menu.el: Add easymenu support.
-
- * Liece 1.2.8.2.
-
- * irchat-crypt.el (irchat-crypt-with-encrypted-message):
- New macro.
-
- * irchat-handle.el (irchat-handler-defsubst): New macro.
- (irchat-handler-defun): Ditto.
- (irchat-handler-return): Ditto.
- All handler routines are defined with new form.
- (irchat-handle-with-cleartext-hook): New macro.
- (irchat-handle-cleartext-hook): Ditto.
- (irchat-handle-run-hook-with-args): Ditto.
- Handler code eliminated by global jump.
- (irchat-handle-set-channel-prefix): New macro.
- (irchat-handle-set-dialogue-prefix): Ditto.
- (irchat-handle-set-private-prefix): Ditto.
-
- * irchat-misc.el (irchat-insert-change): New macro.
- (irchat-insert-notice): Ditto.
- (irchat-insert-broadcast): Ditto.
- (irchat-insert-wallops): Ditto.
- (irchat-insert-error): Ditto.
- (irchat-insert-info): Ditto.
- (irchat-insert-timestamp): Ditto.
- (irchat-insert-dcc): Ditto.
- (irchat-insert-client): Ditto.
-
-1999-01-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-switch-to-channel-no): Fixed.
-
- * irchat-hilight.el (irchat-highlight-region): Check
- `irchat-display-prefix-tag'.
-
- * irchat-vars.el (irchat-display-prefix-tag): New variable.
-
- * irchat-hilight.el (irchat-highlight-hide-prefix-region):
- New function.
-
- * irchat-version.el (irchat-version-user-agent-style): Abolished.
- (liece-client-product): New variable.
- (liece-client-name): New macro.
- (liece-client-version-major): Ditto.
- (liece-client-version-minor): Ditto.
- (liece-client-version-beta): Ditto.
- (liece-client-version-alpha): Ditto.
- (liece-client-codename): Ditto.
-
- * irchat-version.el (irchat-make-emacs-user-agent-string): New
- function.
-
- * irchat.el (irchat-insert): Renamed from `irchat-w-insert'.
- (irchat-replace): Renamed from `irchat-w-replace'.
-
- * irchat-intl.el (irchat-intl-domain-to-mime-charset-alist): New
- variable.
-
- * irchat-intl.el (irchat-intl-parse-Content-Type): Do not use
- `mime-parse-Content-Type' when `mime-parse' is not loaded.
-
- * irchat.el: Remove extra calls of `suppress-keymap'.
-
- * irchat-compat.el: Remove all CL emulation.
-
- * Liece 1.2.8.1.
-
- * irchat-intl.el (irchat-intl-use-localized-messages): New
- variable.
-
-1999-01-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-parse-Content-Type): Parse
- "Content-Type:" header to recognize coding used in PO files.
-
-1999-01-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-domains-to-coding-system-alist):
- Abolished.
-
- * irchat-commands.el (irchat-command-find-timestamp): Regexp fixed.
-\f
-1998-12-30 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Add experimental i18n feature.
-
- * po/ja.po: New file.
-
- * irchat-intl.el: New file.
-
- * irchat-ctcp.el (irchat-ctcp-msg): Message format fixed.
-
- * irchat-channel.el (irchat-channel-join): Fixed.
- (irchat-channel-create-buffer): Fixed.
-
-1998-12-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-switch-to-channel{,-no}):
- Do not reconfigure windows.
-
- * TODO.ja: New file.
-
- * Liece 1.2.6.13/1.2.8.0.
-
- * irchat-commands.el (irchat-switch-to-channel): Fixed.
- (irchat-switch-to-channel-no): Fixed.
-
- * irchat-misc.el (irchat-toggle-command-buffer-mode): When hiding
- state of nick buffer is toggled, reconfigure windows every time.
-
- * irchat-handle.el (irchat-handle-join-msg): Check whether joined
- channel is modeless.
-
- * irchat-misc.el (irchat-channel-modeless-p): New macro.
- (irchat-channel-modeless-regexp): New variable.
-
- * irchat-handle.el (irchat-handle-{join,quit,mode,part}-msg):
- Compression of changes reworked.
-
- * irchat-vars.el (irchat-display-time): Rename from
- `irchat-print-time'.
- (irchat-time-prefix-regexp): Regexp for time prefix.
-
- * irchat-mail.el: Add autoloads instead of all requires
- (`gnus-msg', `sendmail', `mime-edit').
- (irchat-mail-compose-with-mail): Add evals to silence
- byte-compiler.
- (irchat-command-mail-compose): Fix completion.
-
- * irchat-channel.el (irchat-channel-buffer-create):
- Rewritten as a macro.
-
- * irchat-nick.el (irchat-nick-buffer-create): Ditto.
-
- * irchat-compat.el: `<<' and `>>' are become aliases of lsh.
-
- * irchat.el: Rename `irchat-Select-keys' to `irchat-select-keys'.
-
- * sample.liece{,.ja}: Add sample setting of
- `irchat-startup-channel-list'.
-
- * irchat.el (irchat-command-keys): Bind `C-c b' and `C-c N b' to
- `irchat-command{,-nick}-scroll-down' (synced up with irchat-2.4jp24f).
- (irchat-nick-keys): Bind scrolling functions.
-
- * irchat.el (irchat-command-mode): Display `minor-mode-alist' on
- mode-line.
-
- * irchat-globals.el (irchat-obarray):
- Set initial array length to 1.
-
- * irchat.el: Remove preparation code of `irchat-obarray'.
-
- * liece-faq.texinfo: Change formatting style.
-
-1998-12-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-nick-scroll-down): Add check
- whether `irchat-nick-buffer' is visible.
- (irchat-command-nick-scroll-up): Ditto.
-
- * irchat-commands.el (irchat-command-scroll-down): Add check
- whether `irchat-channel-buffer' is visible.
- (irchat-command-scroll-up): Ditto.
-
-1998-12-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-set-channel-indicator): Add check for
- `irchat-display-frame-title'.
-
- * irchat.el (irchat-configure-windows): Bind
- `irchat-channel-buffer-mode' and `irchat-nick-buffer-mode' at the
- entry point.
-
- * irchat-channel.el (irchat-channel-switch-to-last): New macro.
-
- * Liece 1.2.6.12.
-
- * irchat-commands.el (irchat-channel-real): Fix spelling.
- (irchat-channel-virtual): Ditto.
-
- * irchat-channel.el (irchat-channel-switch-to-last): New function.
-
- * irchat-channel.el (irchat-channel-last): New macro.
-
- * irchat-misc.el (irchat-change-nick-of): Fixed.
-
-1998-12-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-own-channel-message):
- (ircaht-own-private-message): Remove dialogue buffer from target
- buffers.
-
- * liece-faq.texinfo: Fix hook for auto invisible.
-
-1998-12-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-pick-buffer): Moved to `irchat-misc.el'.
-
- * irchat-highlit.el (irchat-highlight-pattern-alist): Fix regexp
- for DCC chatting line.
-
- * irchat-commands.el (irchat-command-modec): Select target channel.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen):
- (irchat-command-dcc-chat-listen): Use `as-binary-process'
- block.
-
- * irchat.el (irchat-open-server-internal): Ditto.
-
- * irchat-vars.el (irchat-binary-coding-system): Abolished.
-
- * irchat.el (irchat-open-server-internal): Bind
- `file-coding-system-for-{read|write}' for Mule 2.3.
-
- * irchat.el: `irchat-switch-to-channel-no-*' registered automatically.
-
-1998-12-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el: Require `mcharset'.
-
- * Liece 1.2.6.11.
-
- * irchat-vars.el (irchat-default-mime-charset): New variable.
-
- * irchat-coding.el: Use `mcharset' instead of
- `{encode|decode}-coding-*'.
- (irchat-coding-encode-charset-region):
- (irchat-coding-encode-charset-string): New macro.
-
- * irchat-dcc.el (irchat-dcc-pop-request-object): Fixed.
-
- * irchat-compat.el (caar): New macro.
-
- * irchat-misc.el (irchat-repair-crlf): New function.
-
- * Liece 1.2.6.10.
-
- * irchat.el (irchat-dcc-map): New keymap.
-
- * irchat-dcc.el (irchat-command-dcc-accept): New function.
- (irchat-dcc-get-*): Access method for request object.
- (irchat-dcc-pop-request-object): New macro.
-
- * Liece 1.2.6.9.
-
- * irchat-dcc.el: Very experimental DCC chat support added.
- (irchat-command-dcc-chat-listen): New function.
- (irchat-command-dcc-chat-connect): Ditto.
- (irchat-dcc-chat-listen-filter): Ditto.
- (irchat-dcc-chat-connect-filter): Ditto.
- (irchat-dcc-chat-filter): Ditto.
- (irchat-dcc-channel-representation-format): New variable.
-
- * irchat-channel.el: Very experimental multiple server support
- added.
- (irchat-default-channel-representation-format): New variable. This
- is unified channel locater. Set default as
- "@<server abbreviation>+<channel name>".
- (irchat-channel-parse-representation): New function.
- (irchat-channel-prepare-representation): Ditto.
-
- * irchat-misc.el (irchat-own-channel-message): New function.
-
- * irchat-misc.el (irchat-own-message): New macro.
-
- * dcc.ml: Explicitly return with code 0.
-
- * irchat-dcc.el (irchat-dcc-send-filter): Fixed.
- (irchat-dcc-receive-filter): Fixed.
-
-1998-12-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-dcc-prefix): New variable.
-
- * irchat-compat.el (cdddr): New macro.
-
- * irchat-dcc.el (irchat-dcc-add-to-receive-list): New macro.
- (irchat-dcc-add-to-process-alist): Ditto.
- (irchat-dcc-get-process-object): Ditto.
- (irchat-dcc-sentinel): New sentinel function.
- (irchat-dcc-prepare-directory): New function.
- (irchat-ctcp-dcc-msg): Add handler for DCC chat.
- (irchat-command-dcc-send): Rewritten.
- (irchat-command-dcc-receive): Ditto.
- (irchat-command-dcc-list): Ditto.
-
- * Liece 1.2.6.8.
-
- * dcc.ml: New file.
-
- * naddr.mli: Ditto.
-
- * naddr.ml: Ditto.
-
- * irchat-misc.el (irchat-own-message):
- (irchat-own-private-message): Add check whether channel buffer has
- been created.
-
- * sample.dot.liece: Fix typo.
-
- * sample.dot.liece.ja: Ditto.
-
- * irchat-url.el (irchat-url-browser-netscape): Use builtin
- composer when encounted `mailto:'.
-
- * irchat-commands.el (irchat-dialogue-insert): Abolished.
-\f
-1998-11-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-own-private-message): Check if
- `irchat-command-buffer-mode' is not 'chat.
-
- * Liece 1.2.6.7.
-
- * irchat-channel.el (irchat-channel-prepare-partner):
- Fixed for setting `irchat-current-chat-partner'.
-
- * irchat.el: Do not require `irchat-mail'.
-
-1998-11-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el: Set default `truncate-lines'.
-
-1998-11-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-display-frame-title): New variable.
-
- * Liece 1.2.6.6.
-
- * irchat-channel.el (irchat-command-toggle-channel-buffer-mode):
- Remove setting dirty flag.
-
- * irchat-nick.el (irchat-command-toggle-nick-buffer-mode):
- Ditto
-
-1998-11-25 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-mail.el: New file.
-
- * irchat-vars.el (irchat-convert-hankaku-katakana): New variable.
-
- * irchat-hankana.el: New file.
-
- * Liece 1.2.6.5.
-
- * irchat-300.el (irchat-handle-303-msg): Print come back
- messages for private conversation.
-
- * irchat-misc.el (irchat-set-channel-indicator): New macro.
-
- * irchat-handle.el (irchat-handle-nick-msg): Fixed channel indicator.
-
- * irchat.el (irchat-close-server): Set `irchat-server' to nil.
-
- * irchat-handle.el (irchat-handle-join-msg): Fixed for private
- conversation.
-
- * Add copylefts.
-
-1998-11-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-ison-timer): New variable.
-
- * irchat-vars.el (irchat-ison-interval): New variable.
-
- * irchat-commands.el (irchat-command-set-ison-timer): New
- function.
- (irchat-command-cancel-ison-timer): Ditto.
-
- * irchat-misc.el (irchat-completing-sequential-read): New function.
-
- * Liece 1.2.6.4.
-
- * irchat-compat.el (irchat-button3): Moved into `eval-and-compile'
- enclosure.
-
- * irchat.el: Do not require alist.
-
- * irchat-handle.el (irchat-handle-quit-msg): Rewritten.
-
- * irchat-handle.el (irchat-handle-nick-msg): Handle nick message
- and reflect changes to private buffers.
-
-1998-11-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.6.3.
-
- * irchat-misc.el (irchat-channel-p): New macro.
- (irchat-toggle-command-buffer-mode): New wrapper function.
-
- * irchat.el (irchat-windows-reconfiguration-needed): Fixed
- predicate for nick buffer mode and channel list mode.
-
- * irchat.el (irchat-command-keys): Removed duplicated binding of
- `irchat-command-enter-message'(`\C-j' and `\M-\C-j').
-
-1998-11-19 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Fixed.
-
- * etc/ball.*.xpm: Remove background color in each XPM file
- (From Yasushi Shoji <yashi@yashi.com>).
-
- * sample.dot.liece: Add sample customizations of new feature.
- `irchat-channel-list-buffer-mode',
- `irchat-channel-list-window-width-percent',
- `irchat-auto-join-partner'.
-
- * irchat-filter.el (irchat-filter): Remove unreferenced binding.
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Handle private
- message and join automatically.
-
- * Liece 1.2.6.2.
-
- * irchat-vars.el (irchat-auto-join-partner): New variable.
- (irchat-channel-list-window-width-percent): Ditto.
-
- * irchat-compat.el (irchat-button3): New variable.
-
- * irchat-channel.el (irchat-channel-push-button): New handler.
- (irchat-channel-list-insert): New function.
- (irchat-channel-prepare-partner): New function.
-
- * irchat-url.el (irchat-url-push-button): Search URL string around
- event line.
-
- * irchat.el (irchat-channel-list-mode): New major mode.
- (irchat-configure-windows): Fixed for channel list window.
- (irchat-channel-list-mode-map); New keymap.
-
- * All irchat-{`Command', `Nick', `Channel', `Others', `Crypt'}-*
- symbols renamed with uncapitalized one.
-
-1998-11-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.4.4.
-
- * irchat-filter.el: Do not require mcharset.
-
- * irchat-timer.el: Macro expression fixed (for Emacs19).
-
- * Liece 1.2.4.3/1.2.6.1.
-
- * irchat-vars.el (irchat-binary-coding-system):
- New variable.
-
- * irchat-coding.el: New file.
-
- * irchat-filter.el (irchat-run-message-hook-types):
- Abolished.
- (irchat-handle-message): Rewritten.
- (irchat-handle-message-2): Rewritten.
-
-1998-11-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-Dialogue-mode-map):
- (irchat-Channel-mode-map):
- (irchat-Others-mode-map): Add check whether array style keymap
- expression is acceptable.
-
- * liece-faq.texinfo: New FAQ added for older version of emacsen.
-
- * irchat-handle.el (irchat-handle-privmsg-msg):
- Rewritten.
-
- * irchat-200.el (irchat-handle-200-msgs):
- Channel mask regexp fixed.
-
- * irchat-300.el (irchat-handle-300-msgs):
- Ditto.
-
- * irchat-400.el (irchat-handle-400-msgs):
- Ditto.
-
- * sample.dot.liece: Add sample hook for auto invisible.
-
- * Liece 1.2.3.5.
-
- * irchat-vars.el (irchat-default-coding-system):
- Set default to 'iso-2022-jp.
- (irchat-detect-coding-system): New custom variable.
-
- * irchat-misc.el (irchat-send): Add code conversion with
- `encode-coding-region' .
-
- * irchat-filter.el (irchat-filter): Add coding-system detection.
-
- * irchat-compat.el (irchat-set-process-coding-system):
- (irchat-buffer-disable-undo): Abolished.
- (buffer-disable-undo): New macro.
-
- * defsubst.el: Removed.
-
-1998-11-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (irchat-ccl-quote-decode): Fixed.
-
-1998-11-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (ccl-cascade-write):
- (ccl-set-register-right): New broken facility.
- (irchat-ccl-quote-decode): Rewritten with checking broken CCL
- facilities.
-
- * irchat-timer.el (irchat-start-timer):
- Fixed macro expression for older versions of emacsen.
-
- * irchat-compat.el (defface): New macro for older versions of
- emacsen.
-
-1998-11-12 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Add CCL usability checking with `ccl-usable'.
-
-1998-11-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-version.el (irchat-make-user-agent-string):
- (irchat-make-version-string):
- Regexp fixed.
-
- * irchat-ctcp.el (irchat-ccl-quote-decode):
- (irchat-ccl-quote-encode): Check if module `pccl' exists.
-
- * sample.dot.liece: Renamed from sample.irchat3_vars.el.
-
- * irchat-version.el (liece-client-minor-version):
- Numbered as 1.2.3.3.
- (irchat-version-user-agent-style):
- Declaration revereted to `defvar' from `defcustom'.
-
- * Makefile: Removed `-lnsl'.
-\f
-1998-10-20 Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-Nick-update): Bug fixed in splitting 353
- (NAMEREPLY) message.
-
- * irchat-inlines.el (list-to-assoclist): Rewritten.
-
-1998-10-08 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-toolbar-spec-list): Replace
- `irchat-Command-push' and `irchat-Command-pop' with
- `irchat-Command-previous-channel' and `irchat-Command-next-channel'.
- (irchat-x-face-face-insert): Evaluate also when loaded.
-
-1998-10-07 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-crypt.el (base64-encode-string): Fixed autoload with
- `mel' to `mel-b' package.
- (base64-decode-string): Ditto.
-
-1998-10-06 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-xemacs-splash-logo): Splash screen with
- "liece.xpm" on every loadup time.
-
- * irchat-version.el (liece-client-version): Numbered as 1.2.1.
-
- * irchat-x-face.el (irchat-x-face-face-insert): Display X-Face on
- each prefix line align middle.
-
- * irchat-debug.el: New file.
-
-1998-10-02 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat.el (irchat-Debug-mode): New major mode for
- `irchat-Command-debug'.
-
- * liece-faq.texinfo: New file.
-
- * irchat-commands.el (irchat-Client-query-map): Key binding for
- `irchat-Command-client-x-face-from-minibuffer' substituted with
- `irchat-Command-client-x-face-from-xbm-file'.
-
- * irchat-compat.el (replace-in-string): New function from XEmacs
- subr.el.
-
- * irchat-x-face.el: New file.
- (irchat-x-face-insert): Now works properly with GNU Emacs.
-
- * irchat-xemacs.el (irchat-x-face-insert): New function.
- (irchat-x-face-encode): Ditto.
-
- * irchat-ctcp.el (irchat-ctcp-x-face-msg): X-Face query support.
- Now it works only with X-Face utility.
-
- * irchat-version.el (liece-client-version-beta): New variable.
-
-1998-10-01 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system): Restart now reworked.
-
- * irchat-make.el (config-irchat): Add check wheter APEL version is
- 9.0 or later.
-
- * irchat-ctcp.el (irchat-ctcp-version-msg): Rewritten with new
- style version string.
-
- * irchat-version.el (irchat-version-user-agent-style): New
- variable.
- (irchat-make-user-agent-string): New function.
- (irchat-make-client-version-string): Ditto.
- (irchat-make-version-string): Ditto.
-
- * irchat-make.el (config-irchat): Rewritten.
-
- * irchat-ctcp.el: Renamed from irchat-cta.el.
- (irchat-ccl-quote-cs): New coding system for file transfer.
- (irchat-ccl-quote-encode): New CCL program.
- (irchat-ccl-quote-decode): Ditto.
- (irchat-ctcp-msg): Hook checking code eliminated.
- (irchat-ctcp-client-msg): Ditto.
-\f
-1998-09-30 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-hilight.el (irchat-highlight-buffer):
- Add check whether there is point has
-
- * irchat-compat (irchat-get-text-property):
- Add signal handler for XEmacs extents.
-
- * irchat-commands.el: Require `irchat-dcc.el'.
-
- * Makefile: New rule for .texinfo to .info.
-
- * irchat-hilight.el (irchat-highlight-buffer): Bug fix for
- `irchat-highlight-pattern'.
-
-1998-09-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-make.el (install-irchat): Fixed usage of function
- install-files.
-
- * irchat-nick.el: Do not require widget wid-edit.
-
- * irchat-make.el (irchat-modules-to-compile): Added
- irchat-channel, irchat-nick to module list.
-
- * irchat-hilight.el (irchat-highlight-insert-with-mouse-face):
- Addded check whether function widget-create is bounded.
-
- * irchat-compat.el: Require cl.
-
- * Makefile: Require cl. Machine specific option removed.
-
- * irchat-commands.el (irchat-Command-send-message):
- New signal handler for `encode-coding-string' with unknown coding
- system. This encoding is needed when `irchat-crypt-mode-active-p'
- is non nil.
-
- * irchat.el: Renamed from irchat-main.el.
-
- * irchat-main.el: Removed.
-
-1998-09-29 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-crypt.el (irchat-read-passphrase): New alias.
-
-1998-09-28 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-make.el: New file.
-
- * irchat-compat.el: New file.
-
- * irchat-ja.texinfo: New file.
-
- * setpath.el: Removed.
-
- * irchat-url.el (irchat-url-button-push): New handler.
-
- * irchat-main.el (irchat-Select-map): New keymap.
-
- * irchat-filter.el: Added autoloads for entry points of 000, 200,
- 300, 400, 500 message handlers.
-
- * irchat-misc.el (irchat-greet-author): Abolished.
-
- * irchat-channel.el: Splitted from irchat-commands.el.
-
- * irchat-nick.el: Ditto.
+++ /dev/null
-EXTRA_DIST = $(wildcard *.el) Makefile.lisp liece.xpm liece.xbm
-DISTCLEANFILES = liece-setup.el
-
-EMACS = @EMACS@
-XEMACS = @XEMACS@
-PREFIX = @prefix@
-LISPDIR = @lispdir@
-export EMACS XEMACS PREFIX LISPDIR
-
-all: elc
-
-elc package install install-package clean:
- $(MAKE) $(AM_MAKEFLAGS) -f Makefile.lisp $@
+++ /dev/null
-;;; bitmap-stipple.el --- display bitmap file using stipple.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-05-30
-;; Keywords: bitmap, stipple
-
-;; This file is not part of any package.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(defun bitmap-stipple-xbm-file-to-stipple (file)
- "Convert xbm FILE into icon format and return the list of spec and buffers."
- (with-temp-buffer
- (erase-buffer)
- (let ((case-fold-search t) width height xbytes right margin)
- (insert-file-contents file)
- (goto-char (point-min))
- (or (re-search-forward "_width[\t ]+\\([0-9]+\\)" nil t)
- (error "!! Illegal xbm file format" (current-buffer)))
- (setq width (string-to-int (match-string 1))
- xbytes (/ (+ width 7) 8))
- (goto-char (point-min))
- (or (re-search-forward "_height[\t ]+\\([0-9]+\\)" nil t)
- (error "!! Illegal xbm file format" (current-buffer)))
- (setq height (string-to-int (match-string 1)))
-
- (goto-char (point-min))
- (re-search-forward "0x[0-9a-f][0-9a-f],")
- (delete-region (point-min) (match-beginning 0))
-
- (goto-char (point-min))
- (while (re-search-forward "[\n\r\t ,;}]" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (re-search-forward "0x" nil t)
- (replace-match "\\x" nil t))
- (goto-char (point-min))
- (insert "(" (number-to-string width) " " (number-to-string height) " \"")
- (goto-char (point-max))
- (insert "\")")
- (goto-char (point-min))
- (read (current-buffer)))))
-
-(defun bitmap-stipple-insert-pixmap (pixmap &optional center)
- "Insert PIXMAP in the current buffer.
-Optional argument CENTER specified, pixmap will be centered."
- (let (width height beg i)
- (or (facep 'bitmap-stipple-splash)
- (make-face 'bitmap-stipple-splash))
- (setq width (/ (car pixmap) (frame-char-width))
- height (/ (cadr pixmap) (frame-char-height)))
- (set-face-foreground 'bitmap-stipple-splash "red")
- (set-face-stipple 'bitmap-stipple-splash pixmap)
- (if center (insert-char ?\n height))
- (setq i height)
- (while (> i 0)
- (setq beg (point))
- (insert-char ? width)
- (set-text-properties beg (point) '(face bitmap-stipple-splash))
- (insert "\n")
- (decf i))))
-
-;;;###autoload
-(defun bitmap-stipple-insert-xbm-file (file)
- "Insert xbm FILE at point."
- (interactive "fxbm file: ")
- (save-excursion
- (bitmap-stipple-insert-pixmap
- (bitmap-stipple-xbm-file-to-stipple file))))
-
-(provide 'bitmap-stipple)
-
-;;; bitmap-stipple.el ends here
+++ /dev/null
-;;; gettext.el --- GNU gettext interface
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-09-10
-;; Keywords: i18n
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'mcharset)
-(require 'static)
-(require 'poem)
-
-(eval-when-compile
- (autoload 'mime-content-type-parameter "mime-parse")
- (autoload 'mime-read-Content-Type "mime-parse"))
-
-(static-if (fboundp 'string-to-list)
- (defalias 'gettext-string-to-list 'string-to-list)
- ;; Rely on `string-to-char-list' emulation is provided in poem.
- (defalias 'gettext-string-to-list 'string-to-char-list))
-
-(defvar gettext-gmo-endian 1234)
-(defvar gettext-message-domain-to-catalog-alist nil)
-(defvar gettext-default-message-domain "emacs")
-(defvar gettext-default-mime-charset default-mime-charset)
-(defvar gettext-default-locale "C")
-
-(defconst gettext-msgid-regexp "msgid\\s-*\"")
-(defconst gettext-msgstr-regexp "msgstr\\s-*\"")
-
-(defmacro gettext-hex-char-to-integer (character)
- `(if (and (>= ,character ?0) (<= ,character ?9))
- (- ,character ?0)
- (let ((ch (logior ,character 32)))
- (if (and (>= ch ?a) (<= ch ?f))
- (- ch (- ?a 10))
- (error "Invalid hex digit `%c'" ch)))))
-
-(defun gettext-hex-string-to-integer (hex-string)
- (let ((hex-num 0))
- (while (not (equal hex-string ""))
- (setq hex-num (+ (* hex-num 16)
- (gettext-hex-char-to-integer
- (string-to-char hex-string)))
- hex-string (substring hex-string 1)))
- hex-num))
-
-(defun gettext-gmo-read-32bit-word ()
- (let ((word (string-to-char-list
- (buffer-substring (point) (+ (point) 4)))))
- (forward-char 4)
- (apply #'format "%02x%02x%02x%02x"
- (mapcar (lambda (ch) (logand 255 ch))
- (if (= gettext-gmo-endian 1234)
- (nreverse word)
- word)))))
-
-(defmacro gettext-gmo-header-revision (header)
- `(aref header 0))
-
-(defmacro gettext-gmo-header-nn (header)
- `(aref header 1))
-
-(defmacro gettext-gmo-header-oo (header)
- `(aref header 2))
-
-(defmacro gettext-gmo-header-tt (header)
- `(aref header 3))
-
-(defmacro gettext-gmo-header-ss (header)
- `(aref header 4))
-
-(defmacro gettext-gmo-header-hh (header)
- `(aref header 5))
-
-(defmacro gettext-gmo-read-header ()
- (cons 'vector
- (make-list 6 '(gettext-hex-string-to-integer
- (gettext-gmo-read-32bit-word)))))
-
-(defun gettext-gmo-collect-strings (nn)
- (let (strings pos len off)
- (dotimes (i nn)
- (setq len (gettext-hex-string-to-integer
- (gettext-gmo-read-32bit-word))
- off (gettext-hex-string-to-integer
- (gettext-gmo-read-32bit-word))
- pos (point))
- (goto-char (1+ off))
- (push (buffer-substring (point) (+ (point) len))
- strings)
- (goto-char pos))
- (nreverse strings)))
-
-(defun gettext-parse-Content-Type (&optional header)
- "Return the MIME charset of PO file."
- (with-temp-buffer
- (insert header)
- (if (require 'mime-parse nil 'noerror)
- (mime-content-type-parameter (mime-read-Content-Type) "charset")
- (goto-char (point-min))
- (let ((case-fold-search t))
- (if (re-search-forward
- "^\"Content-Type: *text/plain;[ \t]*charset=\\([^\\]+\\)"
- nil t)
- (find-mime-charset-by-charsets
- (list (buffer-substring (match-beginning 1) (match-end 1))))
- gettext-default-mime-charset)))))
-
-(defun gettext-mapcar* (function &rest args)
- "Apply FUNCTION to successive cars of all ARGS.
-Return the list of results."
- (let (result)
- (while (not (memq nil args))
- (push (apply function (mapcar #'car args)) result)
- (setq args (mapcar #'cdr args)))
- (nreverse result)))
-
-(defun gettext-load-message-catalogue (file)
- (with-temp-buffer
- (let (header strings charset gettext-obarray)
- (as-binary-input-file
- (insert-file-contents file)
- (goto-char (point-min))
- (when (looking-at "\x95\x04\x12\xde")
- (setq gettext-gmo-endian 4321))
- (forward-char 4)
- (setq header (gettext-gmo-read-header)
- strings
- (gettext-mapcar* #'cons
- (progn
- (goto-char (1+ (gettext-gmo-header-oo header)))
- (gettext-gmo-collect-strings
- (gettext-gmo-header-nn header)))
- (progn
- (goto-char (1+ (gettext-gmo-header-tt header)))
- (gettext-gmo-collect-strings
- (gettext-gmo-header-nn header))))
- charset (or (gettext-parse-Content-Type
- (cdr (assoc "" strings)))
- 'x-ctext)
- gettext-obarray (make-vector
- (* 2 (gettext-gmo-header-nn header))
- 0)))
- (dolist (oott strings)
- (set (intern (car oott) gettext-obarray)
- (decode-mime-charset-string
- (cdr oott) charset)))
- gettext-obarray)))
-
-(defun gettext-load-portable-message-catalogue (file)
- (with-temp-buffer
- (let (strings charset msgstr msgid state gettext-obarray)
- (as-binary-input-file
- (insert-file-contents file)
- (goto-char (point-min))
- (while (not (eobp))
- (cond
- ((looking-at gettext-msgid-regexp)
- (if (eq state 'msgstr)
- (push (cons msgid msgstr)
- strings))
- (setq msgid (buffer-substring (match-end 0)
- (progn (end-of-line) (point))))
- (when (string-match "\"\\s-*$" msgid)
- (setq msgid (substring msgid 0 (match-beginning 0))))
- (setq state 'msgid))
- ((looking-at gettext-msgstr-regexp)
- (setq msgstr (buffer-substring (match-end 0)
- (progn (end-of-line) (point))))
- (when (string-match "\"\\s-*$" msgstr)
- (setq msgstr (substring msgstr 0 (match-beginning 0))))
- (setq state 'msgstr))
- ((looking-at "\\s-*\"")
- (let ((line (buffer-substring (match-end 0)
- (progn (end-of-line) (point)))))
- (when (string-match "\"\\s-*$" line)
- (setq line (substring line 0 (match-beginning 0))))
- (set state (concat (symbol-value state) line)))))
- (beginning-of-line 2))
- (if (eq state 'msgstr)
- (push (cons msgid msgstr)
- strings))
- ;; Remove quotations
- (erase-buffer)
- (goto-char (point-min))
- (insert "(setq strings '(\n")
- (dolist (oott strings)
- (insert (format "(\"%s\" . \"%s\")\n"
- (car oott) (cdr oott)))
- (insert "))"))
- (ignore-errors (eval-buffer))
- (setq charset (or (gettext-parse-Content-Type
- (cdr (assoc "" strings)))
- 'x-ctext)))
- (dolist (oott strings)
- (set (intern (car oott) gettext-obarray)
- (decode-mime-charset-string
- (cdr oott) charset)))
- gettext-obarray)))
-
-(unless (featurep 'i18n3)
- (eval-and-compile
- (defun dgettext (domain string)
- "Look up STRING in the default message domain and return its translation.
-\[XEmacs I18N level 3 emulating function]"
- (let ((oott (assoc domain gettext-message-domain-to-catalog-alist)))
- (when (stringp (cdr oott))
- (setcdr oott (gettext-load-message-catalogue
- (cdr oott))))
- (or (symbol-value
- (intern-soft string (or (cdr oott) (make-vector 1 0))))
- string))))
-
- (defun gettext (string)
- "Look up STRING in the default message domain and return its translation.
-\[XEmacs I18N level 3 emulating function]"
- (dgettext gettext-default-message-domain string))
-
- (defun bind-text-domain (domain pathname)
- "Associate a pathname with a message domain.
-Here's how the path to message files is constructed under SunOS 5.0:
- {pathname}/{LANG}/LC_MESSAGES/{domain}.mo
-\[XEmacs I18N level 3 emulating function]"
- (let* ((lang (or (getenv "LC_ALL") (getenv "LC_MESSAGES") (getenv "LANG")
- gettext-default-locale))
- (language (progn
- (string-match "\\([^_.]+\\)\\(_[^.]+\\)?\\(\\.[^@]+\\)?"
- lang)
- (match-string 1 lang)))
- (territory (match-string 2 lang))
- (code-set (match-string 3 lang))
- (lang-path (if lang
- (delq nil (list (if (and territory code-set)
- (concat language territory
- code-set))
- (if territory
- (concat language territory))
- (if code-set
- (concat language code-set))
- language))))
- (file (concat domain ".mo"))
- catalog)
- (while (and (setq lang (car lang-path))
- (setq catalog
- (expand-file-name file
- (concat pathname
- "/" lang "/LC_MESSAGES")))
- (not (file-exists-p catalog)))
- (setq lang-path (cdr lang-path)))
- (when (file-exists-p catalog)
- ;;(file-exists-p (setq catalog (expand-file-name file pathname)))
- (push (cons domain catalog) gettext-message-domain-to-catalog-alist))))
-
- (defun set-domain (domain)
- "Specify the domain used for translating messages in this source file.
-The domain declaration may only appear at top-level, and should precede
-all function and variable definitions.
-
-The presence of this declaration in a compiled file effectively sets the
-domain of all functions and variables which are defined in that file.
-\[XEmacs I18N level 3 emulating function]"
- (setq gettext-default-message-domain domain)))
-
-(provide 'gettext)
-
-;;; gettext.el ends here
+++ /dev/null
-;;; liece-000.el --- Handler routines for 000 numeric reply.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-01-26
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-misc))
-
-(defvar liece-tmp-server-name)
-
-(defun* liece-handle-000-messages (number prefix rest)
- (setq liece-nick-accepted 'ok)
- (or (string-match "[^ ]* \\([^ :]*\\) *\\([^ :]*\\) *:\\(.*\\)" rest)
- (return-from liece-handle-000-messages))
- (let ((target1 (match-string 1 rest)) (target2 (match-string 2 rest))
- (msg (match-string 3 rest)))
- (cond
- ((string-equal target1 "")
- (liece-insert liece-000-buffer
- (concat liece-info-prefix msg "\n")))
- ((string-equal target2 "")
- (liece-insert liece-000-buffer
- (format "%s%s (%s)\n" liece-info-prefix msg target1)))
- (t
- (liece-insert liece-000-buffer
- (format "%s%s %s (%s)\n"
- liece-info-prefix target1 msg target2))))))
-
-(defun* liece-handle-001-message (prefix rest)
- "RPL_WELCOME \"Welcome to the Internet Relay Network <nick>\""
- (or (< 0 (length (setq rest (liece-split-line rest))))
- (return-from liece-handle-001-message))
- (let ((nick (car rest)))
- (setq liece-tmp-server-name prefix
- liece-nickname nick
- liece-real-nickname nick
- liece-my-userhost nil)
- (liece-send "USERHOST %s" liece-nickname)
- (liece-insert-info
- liece-000-buffer
- (format
- (_ "Welcome to the Internet Relay Chat world. Your nick is %s.\n")
- nick))))
-
-(defun liece-handle-002-message (prefix rest)
- "RPL_YOURHOST \"Your host is <host>, running version <version>\"."
- (cond
- ((string-match "running version \\(.*\\)" rest)
- (liece-insert-info liece-000-buffer
- (format (_ "Your server is %s (version %s).\n")
- liece-tmp-server-name (match-string 1 rest))))
- (t
- (liece-insert-info liece-000-buffer
- (format (_ "Your client version is %s.\n")
- (liece-version))))))
-
-(defun liece-handle-003-message (prefix rest)
- "RPL_CREATED \"This server was created <time>\"."
- (if (string-match "was created \\(.*\\)" rest)
- (liece-insert-info liece-000-buffer
- (format (_ "Your server was created %s\n")
- (match-string 1 rest)))))
-
-(defmacro char-list-to-string-alist (clist)
- `(mapcar
- (lambda (ch) (list (char-to-string ch)))
- ,clist))
-
-(defun* liece-handle-004-message (prefix rest)
- "RPL_MYINFO \"<umodes> <chnlmodes>\""
- (or (string-match "[^ ]* \\(.*\\)" rest)
- (return-from liece-handle-004-message))
- (let ((rest (match-string 1 rest)))
- (cond
- ((string-match "[^ ]* [^ ]* \\([^ ]+\\) \\(.*\\)" rest)
- (setq liece-supported-user-mode-alist
- (char-list-to-string-alist
- (liece-string-to-list (match-string 1 rest)))
- liece-supported-channel-mode-alist
- (char-list-to-string-alist
- (liece-string-to-list (match-string 2 rest)))))
- (t
- (liece-insert-info liece-000-buffer (concat rest "\n"))))))
-
-\f
-;; Undernet's MAP feature
-(defvar liece-undernet-map nil)
-
-(defun liece-handle-005-message (prefix rest)
- "RPL_MAP \"<server>\"."
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (push rest liece-undernet-map))
-
-(defun liece-handle-006-message (prefix rest)
- "RPL_MAPMORE \"<server> --> *more*\"."
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (if (string-match " --> \*more\*" rest)
- (setq rest (concat "[" (substring rest 0 (match-beginning 0)))) "]*")
- (push rest liece-undernet-map))
-
-(defun liece-handle-007-message (prefix rest)
- "RPL_MAPEND \"End of /MAP\"."
- (liece-reset-long-reply-count)
- (dolist (map liece-undernet-map)
- (liece-insert-info liece-000-buffer (concat map "\n")))
- (setq liece-undernet-map nil))
-
-\f
-;;; @ register message handlers
-;;;
-
-(eval-when-compile (require 'liece-handler))
-
-(liece-handler-define-backend "000")
-
-(defmacro liece-register-000-handler (num)
- `(progn
- (liece-handler-define-function
- ,(format "%03d" num) '(prefix require "000")
- ',(intern (format "liece-handle-%03d-message" num)))
- (defvar ,(intern (format "liece-%03d-hook" num)) nil)
- (defvar ,(intern (format "liece-after-%03d-hook" num)) nil)))
-
-(liece-register-000-handler 001)
-(liece-register-000-handler 002)
-(liece-register-000-handler 003)
-(liece-register-000-handler 004)
-(liece-register-000-handler 005)
-(liece-register-000-handler 006)
-(liece-register-000-handler 007)
-
-(provide 'liece-000)
-
-;;; liece-000.el ends here
+++ /dev/null
-;;; liece-200.el --- Handler routines for 200 numeric reply.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-misc)
- (require 'liece-commands))
-
-(defun* liece-handle-200-messages (number prefix rest)
- "200 replies"
- (or (string-match "[^ ]* \\([^ ]*\\) *\\([^ ]*\\) *:\\(.*\\)" rest)
- (return-from liece-handle-200-messages))
- (let ((target1 (match-string 1 rest)) (target2 (match-string 2 rest))
- (msg (match-string 3 rest)))
- (setq target1 (liece-channel-virtual target1)
- target2 (liece-channel-virtual target2))
- (cond ((string-equal target1 "")
- (liece-insert-info liece-200-buffer (concat msg "\n")))
- ((string-equal target2 "")
- (liece-insert-info
- liece-200-buffer (concat target1 " " msg "\n")))
- (t
- (liece-insert-info
- liece-200-buffer (concat target1 " " msg " (" target2 ")\n"))))))
-
-(defun* liece-handle-200-message (prefix rest)
- "RPL_TRACELINK \"Link <version & debug level> <destination> <next server>\""
- (or (string-match "Link \\([^ ]*\\)[ :]*\\([^ ]*\\)[ :]*\\([^ ]*\\)[ :]*\\([^ ]*\\)[ :]*\\([^ ]*\\)[ :]*\\([^ ]*\\)[ :]*\\(.*\\)" rest)
- (return-from liece-handle-200-message))
- (let ((version (match-string 1 rest)) (dest (match-string 2 rest))
- (next (match-string 3 rest)) (ver (match-string 4 rest))
- (sec (match-string 5 rest))
- (q1 (match-string 6 rest)) (q2 (match-string 7 rest)))
- (liece-insert-info liece-200-buffer
- (concat prefix
- " ("
- version (if ver (concat " " ver) "")
- ") --- " dest "\n"))
- (liece-insert-info liece-200-buffer
- (concat "\t[" (liece-convert-seconds sec) "]"
- (if (not (string= q1 "")) (concat " " q1) "")
- (if (not (string= q2 "")) (concat "/" q2) "")
- " (next " next ")\n"))))
-
-(defun* liece-handle-201-message (prefix rest)
- "RPL_TRACECONNECTING \"Try. <class> <server>\""
- (or (string-match "[^ ]* [^ ]* \\([0-9]*\\)[ :]*\\(.*\\)" rest)
- (return-from liece-handle-201-message))
- (let ((class (match-string 1 rest))
- (server (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (format (_ "%s Trying to connect to %s (class %s)\n")
- prefix server class))))
-
-(defun* liece-handle-202-message (prefix rest)
- "RPL_TRACEHANDSHAKE \"H.S. <class> <server>\""
- (or (string-match "[^ ]* [^ ]* \\([0-9]*\\)[ :]*\\(.*\\)" rest)
- (return-from liece-handle-202-message))
- (let ((class (match-string 1 rest)) (server (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (format (_ "%s Handshaking with %s (class: %s)\n")
- prefix server class))))
-
-(defun* liece-handle-203-message (prefix rest)
- "RPL_TRACEUNKNOWN \"???? <class> [<client IP address in dot form>]\""
- (or (string-match "[^ ]* [^ ]* \\([^ ]*\\)[ :]+\\(.*\\)" rest)
- (return-from liece-handle-203-message))
- (let ((class (match-string 1 rest)) (who (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Class " class ": unknown " who "\n"))))
-
-(defun* liece-handle-204-message (prefix rest)
- "RPL_TRACEOPERATOR \"Oper <class> <nick>\""
- (or (string-match "[^ ]* [^ ]* \\([^ ]*\\)[ :]+\\(.*\\)" rest)
- (return-from liece-handle-204-message))
- (let ((class (match-string 1 rest)) (who (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Class " class ": operator " who "\n"))))
-
-(defun* liece-handle-205-message (prefix rest)
- "RPL_TRACEUSER \"User <class> <nick>\""
- (or (string-match "[^ ]* [^ ]* \\([0-9]*\\)[ :]*\\(.*\\)" rest)
- (return-from liece-handle-205-message))
- (let ((hops (match-string 1 rest)) (where (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Class " hops ": user " where "\n"))))
-
-(defun* liece-handle-206-message (prefix rest)
- "RPL_TRACESERVER \"Serv <class> <int>S <int>C <server> <nick!user|*!*>@<host|server>\""
- (or (string-match "Serv \\([^ ]*\\) \\(.*\\)" rest)
- (return-from liece-handle-206-message))
- (let ((class (match-string 1 rest)) (pars (match-string 2 rest)))
- (cond
- ((string-match "\\([0-9]*\\)S *\\([0-9]*\\)C *\\([^ ]*\\) *\\([^ ]*\\)[ :]*\\(.*\\)" pars)
- (let ((servers (match-string 1 pars)) (clients (match-string 2 pars))
- (next (match-string 3 pars)) (by (match-string 4 pars))
- (type (match-string 5 pars)))
-
- ;; This is automatic connection line
- (setq by (if (string-match "^AutoConn\\.!" by)
- "auto connection"
- (concat "by " by)))
-
- (liece-insert-info liece-200-buffer
- (concat prefix " --- " next "\n"))
- (liece-insert-info liece-200-buffer
- (concat "\t[" clients " clients, "
- servers " servers]"
- " Class " class ", Type " type " " by
- "\n"))))
- (t
- (liece-insert-info liece-200-buffer
- (format "Class %s: server %s --- %s\n"
- class prefix pars))))))
-
-(defun* liece-handle-207-message (prefix rest)
- "RPL_TRACESERVICE \"Service <class> <name> <type> <wants>\""
- (or (string-match "[^ ]* Service \\([0-9]*\\) \\(.*\\)" rest)
- (return-from liece-handle-207-message))
- (let ((class (match-string 1 rest)) (service (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Class " class ": service " service "\n"))))
-
-(defun liece-handle-208-message (prefix rest)
- "RPL_TRACENEWTYPE \"<newtype> 0 <client name>\"."
- (liece-insert-info liece-200-buffer
- (format "%s: RPL_TRACENEWTYPE: Why this?\n" prefix)))
-
-(defun* liece-handle-209-message (prefix rest)
- "RPL_TRACECLASS \"Class <class> <links>\""
- (or (string-match "[^ ]* Class \\([0-9]*\\) \\([0-9]*\\)" rest)
- (return-from liece-handle-209-message))
- (let ((class (match-string 1 rest)) (entries (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Class " class ": " entries
- "entries linked\n"))))
-
-(defun* liece-handle-211-message (prefix rest)
- "RPL_STATSLINKINF \"<linkname> <sendq> <sent messages> <sent bytes> <received messages> <received bytes> <time open>\""
- (or (string-match "\\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\)[ :]+\\(.*\\)" rest)
- (return-from liece-handle-211-message))
- (let ((link (match-string 2 rest)) (sendq (match-string 3 rest))
- (sendm (match-string 4 rest)) (sendb (match-string 5 rest))
- (rcvem (match-string 6 rest)) (rcveb (match-string 7 rest))
- (open (match-string 8 rest)))
- (liece-insert-info liece-200-buffer
- (format "%-35s %s: %5s%7s%10s%7s%10s %s\n"
- link prefix sendq sendm sendb
- rcvem rcveb open))))
-
-(defun* liece-handle-212-message (prefix rest)
- "RPL_STATSCOMMANDS \"<command> <count>\""
- (or (string-match "[^ ]* \\([^ ]*\\) \\([0-9]*\\)" rest)
- (return-from liece-handle-212-message))
- (let ((cmd (match-string 1 rest)) (times (match-string 2 rest)))
- (liece-insert-info liece-200-buffer
- (format "%s has been used %s times after startup\n"
- cmd times))))
-
-(defun* liece-handle-213-message (prefix rest)
- "RPL_STATSCLINE \"C <host> * <name> <port> <class>\""
- (or (string-match "[^ ]* C \\([^ ]*\\) \\* \\([^ ]*\\) \\([0-9]*\\) \\([0-9]*\\)" rest)
- (return-from liece-handle-213-message))
- (let ((canon (match-string 1 rest)) (name (match-string 2 rest))
- (port (match-string 3 rest)) (class (match-string 4 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Connect to " canon ":" port
- (if (not (string= class ""))
- " (Class " class ")" "")
- "\n"))
- (liece-insert-info liece-200-buffer
- (concat "\t[" name "]\n"))))
-
-(defun* liece-handle-214-message (prefix rest)
- "RPL_STATSNLINE \"N <host> * <name> <port> <class>\""
- (or (string-match "[^ ]* N \\([^ ]*\\) \\* \\([^ ]*\\) \\([0-9]*\\) \\([0-9]*\\)" rest)
- (return-from liece-handle-214-message))
- (let ((canon (match-string 1 rest)) (name (match-string 2 rest))
- (port (match-string 3 rest)) (class (match-string 4 rest)))
- (liece-insert-info liece-200-buffer
- (concat "Accept " canon ":" port
- (if (not (string= class ""))
- " (Class " class ")" "")
- "\n"))
- (liece-insert-info liece-200-buffer
- (concat "\t[" name "]\n"))))
-
-(defun* liece-handle-215-message (prefix rest)
- "RPL_STATSILINE \"I <host> * <host> <port> <class>\""
- (or (string-match "[^ ]* I \\([^ ]*\\) \\(.*\\) \\([^ ]*\\)" rest)
- (return-from liece-handle-215-message))
- (let ((domain (match-string 1 rest)) (passwd (match-string 2 rest))
- (redomain (match-string 3 rest)))
- (liece-insert-info liece-200-buffer
- (format "I:%s:%s:%s\n" domain passwd redomain))))
-
-(defun* liece-handle-216-message (prefix rest)
- "RPL_STATSKLINE \"K <host> * <username> <port> <class>\""
- (or (or (string-match
- "[^ ]* K \\([^ ]*\\) \\(.\\) \\([^ ]*\\) 0 -1" rest)
- (string-match
- "[^ ]* K \\([^ ]*\\) \\([^ ]*\\) \\([^ ]*\\) 0 [:]*-1" rest))
- (return-from liece-handle-216-message))
- (let ((host (match-string 1 rest)) (pass (match-string 2 rest))
- (user (match-string 3 rest)))
- (liece-insert-info liece-200-buffer
- (format "K:%s:%s:%s\n" host pass user))))
-
-(defun* liece-handle-217-message (prefix rest)
- "RPL_STATSQLINE \"Q %s %s %s %d %d\""
- (or (string-match
- "[^ ]* Q \\([^ ]*\\) \\(.\\) \\([^ ]*\\) \\(.*\\)" rest)
- (return-from liece-handle-217-message))
- (let ((reason (match-string 1 rest)) (star (match-string 2 rest))
- (host (match-string 3 rest)) (stuff (match-string 4 rest)))
- (liece-insert-info liece-200-buffer
- (format "Q:%s:%s:%s:%s\n" reason star host stuff))))
-
-(defun* liece-handle-218-message (prefix rest)
- "RPL_STATSYLINE \"Y <class> <ping frequency> <connect frequency> <max sendq>\""
- (or (string-match "[^ ]* Y " rest)
- (return-from liece-handle-218-message))
- (let* ((args (split-string (substring rest (match-end 0))))
- (class (pop args)) (pingfreq (pop args)) (confreq (pop args))
- (maxlinks (pop args)) (qlen (pop args)))
- (liece-insert-info liece-200-buffer
- (concat "Class " class ": \n"))
- (liece-insert-info liece-200-buffer
- (concat "\tPing frequency " pingfreq " (sec)\n"))
- (liece-insert-info liece-200-buffer
- (concat "\tConnection frequency " confreq " (sec)\n"))
- (liece-insert-info liece-200-buffer
- (concat "\tMaximum links " maxlinks "\n"))
- (when qlen
- (liece-insert-info liece-200-buffer
- (concat "\tMaximum amount of send buffer "
- qlen " (bytes)\n")))))
-
-(defun liece-handle-219-message (prefix rest)
- "RPL_ENDOFSTATS \"<stats letter> :End of /STATS report\"."
- nil)
-
-(defun liece-handle-221-message (prefix rest)
- "RPL_UMODEIS \"<user mode string>\"."
- (if (string-match "[^ ]* \\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (format (_ "Mode for you is %s\n")
- (match-string 1 rest)))))
-
-;;;
-;;; 230 series not implemented as 7/94
-;;;
-(defun liece-handle-231-message (prefix rest)
- nil)
-
-(defun liece-handle-232-message (prefix rest)
- nil)
-
-(defun liece-handle-233-message (prefix rest)
- nil)
-
-(defun liece-handle-234-message (prefix rest)
- nil)
-
-(defun liece-handle-235-message (prefix rest)
- nil)
-
-(defun liece-handle-241-message (prefix rest)
- "RPL_STATSLLINE \"L <hostmask> * <servername> <maxdepth>\"."
- (if (string-match "[^ ]* \\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (concat (match-string 1 rest) "\n"))))
-
-(defun liece-handle-242-message (prefix rest)
- "RPL_STATSUPTIME \":Server Up %d days %d:%02d:%02d\"."
- (if (string-match "[^ ]* :\\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (concat (match-string 1 rest) "\n"))))
-
-(defun liece-handle-243-message (prefix rest)
- "RPL_STATSOLINE \"O <hostmask> * <name>\"."
- (if (string-match "[^ ]* \\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (concat (match-string 1 rest) "\n"))))
-
-(defun liece-handle-244-message (prefix rest)
- "RPL_STATSHLINE \"H <hostmask> * <servername>\"."
- (if (string-match "[^ ]* \\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (concat (match-string 1 rest) "\n"))))
-
-(defun liece-handle-245-message (prefix rest)
- "RPL_STATSSLINE \"S <hostmask> * <servicename> <servicetype> <class>\"."
- (if (string-match "[^ ]* \\(.*\\)" rest)
- (liece-insert-info liece-200-buffer
- (concat (match-string 1 rest) "\n"))))
-
-(defun liece-handle-262-message (prefix rest)
- "RPL_ENDOFTRACE \"<nickname> <target> <version> :End of TRACE\"."
- nil)
-
-\f
-;;; @ register message handlers
-;;;
-
-(eval-when-compile (require 'liece-handler))
-
-(liece-handler-define-backend "200")
-
-(defmacro liece-register-200-handler (num)
- `(progn
- (liece-handler-define-function
- ,(number-to-string num) '(prefix rest "200")
- ',(intern (format "liece-handle-%03d-message" num)))
- (defvar ,(intern (format "liece-%03d-hook" num)) nil)
- (defvar ,(intern (format "liece-after-%03d-hook" num)) nil)))
-
-(liece-register-200-handler 200)
-(liece-register-200-handler 201)
-(liece-register-200-handler 202)
-(liece-register-200-handler 203)
-(liece-register-200-handler 204)
-(liece-register-200-handler 205)
-(liece-register-200-handler 206)
-(liece-register-200-handler 207)
-(liece-register-200-handler 208)
-(liece-register-200-handler 209)
-
-(liece-register-200-handler 211)
-(liece-register-200-handler 212)
-(liece-register-200-handler 213)
-(liece-register-200-handler 214)
-(liece-register-200-handler 215)
-(liece-register-200-handler 216)
-(liece-register-200-handler 217)
-(liece-register-200-handler 218)
-(liece-register-200-handler 219)
-
-(liece-register-200-handler 221)
-
-(liece-register-200-handler 231)
-(liece-register-200-handler 232)
-(liece-register-200-handler 233)
-(liece-register-200-handler 234)
-(liece-register-200-handler 235)
-
-(liece-register-200-handler 241)
-(liece-register-200-handler 242)
-(liece-register-200-handler 243)
-(liece-register-200-handler 244)
-(liece-register-200-handler 245)
-(liece-register-200-handler 262)
-
-(provide 'liece-200)
-
-;;; liece-200.el ends here
+++ /dev/null
-;;; liece-300.el --- Handler routines for 300 numeric reply.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-misc)
- (require 'liece-commands))
-
-(eval-and-compile
- (autoload 'liece-dcc-compare-hostnames "liece-dcc"))
-
-(defvar liece-recursing-whois nil)
-(defvar liece-recursing-whowas nil)
-
-(defun* liece-handle-300-messages (number prefix rest)
- "300 replies"
- (or (string-match "[^ ]* \\([^ ]*\\) *\\([^ ]*\\) *:\\(.*\\)" rest)
- (return-from liece-handle-300-messages))
- (let ((target1 (liece-channel-virtual (match-string 1 rest)))
- (target2 (liece-channel-virtual (match-string 2 rest)))
- (msg (match-string 3 rest)))
- (cond ((string= target1 "")
- (liece-insert-info liece-300-buffer (concat msg "\n")))
- ((string= target2 "")
- (liece-insert-info liece-300-buffer
- (format "%s (%s)\n" msg target1)))
- (t
- (liece-insert-info liece-300-buffer
- (format "%s %s (%s)\n" target1 msg target2))))))
-
-(defun liece-handle-301-message (prefix rest)
- "RPL_AWAY \"<nickname> :<away message>\"."
- (if (string-match "^[^ ]+ \\([^ ]+\\) +:\\(.*\\)" rest)
- (let ((who (match-string 1 rest)) (iswhat (match-string 2 rest)))
- (or liece-recursing-whois
- (liece-insert-info liece-300-buffer
- (concat who " is marked as being away, "
- "but left the message:\n"
- iswhat "\n"))))))
-
-(defun liece-handle-302-message (prefix rest)
- "RPL_USERHOST \":[<reply>{<space><reply>}]\"."
- (while (string-match
- "^[^ ]* :[ ]*\\([^*=]+\\)\\([*]*\\)=\\([+-]\\)\\([^ ]+\\)" rest)
- (let ((nick (match-string 1 rest)) (oper (match-string 2 rest))
- (away (match-string 3 rest)) (who (match-string 4 rest))
- (end (match-end 4)))
- (if (liece-nick-equal nick liece-real-nickname)
- (setq liece-my-userhost who))
- (liece-insert-info liece-300-buffer
- (format "Nick %s is %s [%s%s, %s%s]\n"
- nick who
- (if (string= oper "") "Not ") "operator"
- (if (string= away "+") "Not ") "away"))
- (setq rest (concat " :" (substring rest end nil))))))
-
-(defun liece-303-display-friends (nicks)
- (let ((on (filter-elements nick nicks
- (not (string-list-member-ignore-case nick liece-friends-last))))
- (off (filter-elements nick liece-friends-last
- (not (string-list-member-ignore-case nick nicks)))))
- (setq liece-friends-last nicks)
- (if on
- (liece-insert-info liece-300-buffer
- (format (_ "Following people are now on: %s\n")
- (mapconcat 'identity on " "))))
- (if off
- (liece-insert-info liece-300-buffer
- (format (_ "Following people are now off: %s\n")
- (mapconcat 'identity off " "))))))
-
-(defun* liece-handle-303-message (prefix rest)
- "RPL_ISON \":[<nickname> {<space><nickname>}]\""
- (or (string-match "[^ ]+ :\\(.*\\)" rest)
- (return-from liece-handle-303-message))
- (setq rest (match-string 1 rest))
- (or (string= rest "")
- (setq rest (substring rest 0 -1)))
- (let ((nicks (split-string rest)))
- (when (and (null nicks) (null liece-friends))
- (liece-insert-info liece-300-buffer
- (_ "No one you requested is on now.\n"))
- (return-from liece-handle-303-message))
- (dolist (nick nicks)
- (when (and (string-list-member-ignore-case
- nick liece-current-chat-partners)
- (get (intern nick liece-obarray) 'part))
- (liece-insert-change (liece-pick-buffer nick)
- (format (_ "%s has come back\n") nick))
- (put (intern nick liece-obarray) 'part nil)))
- (unless liece-friends
- (liece-insert-info liece-300-buffer
- (format (_ "Following people are on: %s\n") rest))
- (return-from liece-handle-303-message))
- (if (fboundp liece-display-friends-function)
- (funcall liece-display-friends-function nicks))))
-
-(defun* liece-handle-305-message (prefix rest)
- "RPL_UNAWAY \":You are no longer marked as being away\""
- (or (string-equal liece-away-indicator "A")
- (return-from liece-handle-305-message))
- (setq liece-away-indicator "-")
- (liece-maybe-poll)
- (when (string-match "[^:]:\\(.*\\)" rest)
- (setq rest (match-string 1 rest))
- (liece-insert-info liece-300-buffer
- (format "%s (%s)\n"
- rest (funcall liece-format-time-function
- (current-time))))))
-
-(defun liece-handle-306-message (prefix rest)
- "RPL_NOWAWAY \":You have been marked as being away\"."
- (setq liece-away-indicator "A")
- (if (string-match "[^:]:\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (format "%s (%s)\n"
- (match-string 1 rest)
- (funcall liece-format-time-function
- (current-time))))))
-
-(defun liece-handle-311-message (prefix rest)
- "RPL_WHOISUSER \"<nickname> <user> <host> * :<real name>\"."
- (and (string-match "[^ ]+ \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) :\\(.*\\)" rest)
- (not liece-recursing-whois)
- (liece-insert-info liece-300-buffer
- (format "%s is %s (%s@%s)\n"
- (match-string 1 rest) ; nick
- (match-string 5 rest) ; realname
- (match-string 2 rest) ; username
- (match-string 3 rest) ; machine
- ))))
-
-(defun* liece-handle-312-message (prefix rest)
- "RPL_WHOISSERVER \"<nickname> <server> :<server info>\""
- (or (string-match "^[^ ]+ \\(\\([^ ]+\\) \\)?\\([^ ]+\\) :\\(.*\\)" rest)
- (return-from liece-handle-312-message))
- (let ((who (match-string 2 rest))
- (server (match-string 3 rest))
- (real (match-string 4 rest)))
- (if (and liece-dcc-resolve-server
- (not (liece-dcc-compare-hostnames server (liece-server-host)))
- (not liece-recursing-whois)
- (not liece-recursing-whowas))
- (progn
- (setq liece-recursing-whois t)
- (liece-send "WHOIS %s %s" server who))
- (setq liece-recursing-whois nil)
- (liece-insert-info liece-300-buffer
- (format "on via server %s (%s)\n" server real)))))
-
-(defun liece-handle-313-message (prefix rest)
- "RPL_WHOISOPERATOR \"<nickname> :is an IRC operator\"."
- (if (string-match "^[^ ]+ \\([^ ]+\\) :\\(.*\\)" rest)
- (or liece-recursing-whois
- (liece-insert-info liece-300-buffer
- (concat (match-string 2 rest)
- " is an IRC operator\n")))))
-
-(defun liece-handle-316-message (prefix rest)
- "RPL_WHOISCHANOP."
- (cond ((string-match "^\\([^ ]+\\) :\\(.*\\)" rest)
- (if (not liece-recursing-whois)
- (liece-insert-info liece-300-buffer
- (concat "Status: "
- (match-string 2 rest) "\n"))))
- ((string-match "^\\([^ ]+\\) \\([^ ]+\\) :\\(.*\\)" rest)
- (if (not liece-recursing-whois)
- (liece-insert-info liece-300-buffer
- (concat "Status: "
- (match-string 3 rest) "\n"))))))
-
-(defun* liece-handle-319-message (prefix rest)
- "RPL_WHOISCHANNELS \"<nickname> :{[@|+]<channel><space>}\""
- (or (string-match "^\\([^ ]+\\) \\([^ ]+\\) :\\(.*\\)" rest)
- (return-from liece-handle-319-message))
- (let ((chnls (split-string (match-string 3 rest)))
- isonchnls flag)
- (dolist (chnl chnls)
- (if (and (or (eq ?@ (string-to-char chnl))
- (eq ?+ (string-to-char chnl)))
- (liece-channel-p (substring chnl 1)))
- (progn
- (setq flag (substring chnl 0 1)
- chnl (substring chnl 1)))
- (setq flag ""))
- (push (concat flag (liece-channel-virtual chnl)) isonchnls))
- (if (not liece-recursing-whois)
- (liece-insert-info liece-300-buffer
- (format (_ "Channels: %s\n")
- (mapconcat (function identity)
- (nreverse isonchnls) " "))))))
-
-(defun liece-handle-314-message (prefix rest)
- "RPL_WHOWASUSER \"<nickname> <user> <host> * :<real name>\"."
- (if (string-match
- "[^ ]+ \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) :\\(.*\\)"
- rest)
- (let ((nick (match-string 1 rest)) (username (match-string 2 rest))
- (machine (match-string 3 rest)) (chnl (match-string 4 rest))
- (realname (match-string 5 rest)))
- (setq liece-recursing-whowas t)
- (liece-insert-info liece-300-buffer
- (format "%s [%s] was %s (%s@%s)\n"
- nick
- (if (string= chnl "*") "Private" chnl)
- realname username machine)))))
-
-(defun liece-handle-315-message (prefix rest)
- "RPL_ENDOFWHO."
- (if (zerop liece-long-reply-count)
- (liece-insert-info liece-300-buffer
- (concat "No matches found"
- (if liece-who-expression
- (concat ": " liece-who-expression)
- "")
- "\n")))
- (setq liece-who-expression nil)
- (liece-reset-long-reply-count))
-
-(defun liece-handle-317-message (prefix rest)
- "RPL_WHOISIDLE \"<nickname> <integer> :seconds idle\"."
- (cond ((string-match "^[^ ]+ [^ ]+ \\([0-9]*\\) :\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (concat "Idle for "
- (liece-convert-seconds
- (match-string 1 rest))
- "\n")))
- ((string-match "^[^ ]+ \\([0-9]*\\) :\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (concat "Idle for "
- (liece-convert-seconds
- (match-string 1 rest))
- "\n")))))
-
-(defun liece-handle-318-message (prefix rest)
- "RPL_ENDOFWHOIS \"<nickname> :End of /WHOIS list\"."
- nil)
-
-(defun liece-handle-321-message (prefix rest)
- "RPL_LISTSTART \"Channel :Users Name\"."
- (liece-insert-info liece-300-buffer
- (format "%-10s%6s %s\n"
- (_ "Channel") (_ "Users") (_ "Topic"))))
-
-(defun* liece-handle-322-message (prefix rest)
- "RPL_LIST \"<channel> <# visible> :<topic>\""
- (or (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) :\\(.*\\)" rest)
- (return-from liece-handle-322-message))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (let ((chnl (match-string 2 rest))
- (users (match-string 3 rest))
- (topic (match-string 4 rest)))
- (when (or (string= liece-channel-filter (downcase chnl))
- (string= liece-channel-filter "")
- (and (string= liece-channel-filter "0")
- (string= chnl "*")))
- (setq chnl (liece-channel-virtual chnl))
- (put (intern chnl liece-obarray) 'topic topic)
- (liece-insert-info (append (liece-pick-buffer chnl) liece-300-buffer)
- (format "%-10s%6s user%s%s%s\n"
- (if (string= chnl "*") "Priv" chnl)
- users
- (if (> (string-to-int users) 1) "s" "")
- (if (string= "" topic) "" ": ")
- topic)))))
-
-(defun liece-handle-323-message (prefix rest)
- "RPL_LISTEND \":End of /LIST\"."
- (liece-reset-long-reply-count))
-
-(defun liece-handle-324-message (prefix rest)
- "RPL_CHANNELMODEIS \"<channel> <mode> <mode params>\"."
- (if (string-match "[^ ]* \\([^ ]*\\) +\\+\\([^ ]*\\)\\( *[^ ]*\\)" rest)
- (let ((chnl (match-string 1 rest))
- (mode (match-string 2 rest))
- (param (match-string 3 rest)))
- (setq chnl (liece-channel-virtual chnl))
- (put (intern chnl liece-obarray) 'mode mode)
- (liece-insert-info (append (liece-pick-buffer chnl)
- liece-300-buffer)
- (format (_ "Mode for %s is %s%s\n")
- chnl mode param))
- (liece-set-channel-indicator))))
-
-(defun liece-handle-331-message (prefix rest)
- "RPL_NOTOPIC \"<channel> :No topic is set\"."
- (if (string-match "[^ ]* \\([^ ]*\\) \\(.*\\)" rest)
- (let ((chnl (match-string 1 rest)))
- (setq chnl (liece-channel-virtual chnl))
- (put (intern chnl liece-obarray) 'topic nil)
- (liece-insert-info (append (liece-pick-buffer chnl)
- liece-300-buffer)
- (_ "No topic is set\n"))
- (liece-set-channel-indicator))))
-
-(defun liece-handle-332-message (prefix rest)
- "RPL_TOPIC \"<channel> :<topic>\"."
- (if (string-match "[^ ]* \\([^ ]*\\) +:\\(.*\\)" rest)
- (let ((chnl (liece-channel-virtual (match-string 1 rest)))
- (topic (match-string 2 rest)))
- (liece-channel-set-topic topic chnl)
- (liece-insert-info (liece-pick-buffer chnl)
- (format (_ "Topic: %s\n") topic))
- (liece-insert-info liece-300-buffer
- (format (_ "Topic for %s: %s\n") chnl topic))
- (liece-set-channel-indicator))))
-
-(defun liece-handle-333-message (prefix rest)
- "RPL_TOPICWHOTIME <channel> <nickname> <time>."
- (if (string-match "[^ ]* \\([^ ]*\\) +\\([^ ]*\\) +\\([^ ]*\\)" rest)
- (let ((chnl (liece-channel-virtual (match-string 1 rest)))
- (nick (match-string 2 rest))
- (time (funcall liece-format-time-function
- (liece-seconds-to-time
- (string-to-int (match-string 3 rest))))))
- (liece-insert-info (liece-pick-buffer chnl)
- (format (_ "Topic set by %s at %s\n")
- nick time))
- (liece-insert-info liece-300-buffer
- (format (_ "Topic for %s set by %s at %s\n")
- chnl nick time))
- (liece-set-channel-indicator))))
-
-(defun liece-handle-341-message (prefix rest)
- "RPL_INVITING \"<channel> <nickname>\"."
- (if (string-match "^\\([^ ]+\\) +\\([^ ]+\\) +\\([-#&0-9+][^ ]*\\)" rest)
- (let ((nick (match-string 2 rest))
- (chnl (liece-channel-virtual (match-string 3 rest))))
- (liece-insert-info (liece-pick-buffer chnl)
- (format (_ "Inviting user %s\n") nick))
- (liece-insert-info liece-300-buffer
- (format (_ "Inviting user %s to channel %s\n")
- nick chnl)))))
-
-(defun liece-handle-346-message (prefix rest)
- "RPL_INVITELIST \"<channel> <inviteid>\"."
- (when (string-match "[^ ]* \\([^ ]*\\) \\([^ ]*\\)" rest)
- (let* ((regexp (match-string 2 rest))
- (chnl (liece-channel-virtual (match-string 1 rest))))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (or (> liece-polling 0)
- (liece-channel-add-invite regexp chnl)))))
-
-(defun liece-handle-347-message (prefix rest)
- "RPL_ENDOFINVITELIST \"<channel> :End of Channel Invite List\"."
- (when (string-match "[^ ]* \\([^ ]*\\)" rest)
- (let* ((chnl (liece-channel-virtual (match-string 1 rest)))
- (invites (liece-channel-get-invites chnl)))
- (liece-reset-long-reply-count)
- (liece-insert-info liece-300-buffer
- (concat "Following users are invited to " chnl
- ": \n"))
- (dolist (invite invites)
- (liece-insert-info liece-300-buffer
- (concat "\t" invite "\n"))))))
-
-(defun liece-handle-348-message (prefix rest)
- "RPL_EXCEPTLIST \"<channel> <exceptid>\"."
- (when (string-match "[^ ]* \\([^ ]*\\) \\([^ ]*\\)" rest)
- (let* ((regexp (match-string 2 rest))
- (chnl (liece-channel-virtual (match-string 1 rest))))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (or (> liece-polling 0)
- (liece-channel-add-exception regexp chnl)))))
-
-(defun liece-handle-349-message (prefix rest)
- "RPL_ENDOFEXCEPTLIST \"<channel> :End of Channel Exception List\"."
- (when (string-match "[^ ]* \\([^ ]*\\)" rest)
- (let* ((chnl (liece-channel-virtual (match-string 1 rest)))
- (exceptions (liece-channel-get-exceptions chnl)))
- (liece-reset-long-reply-count)
- (liece-insert-info liece-300-buffer
- (concat "Following users are welcome to " chnl
- ": \n"))
- (dolist (exception exceptions)
- (liece-insert-info liece-300-buffer
- (concat "\t" exception "\n"))))))
-
-(defun liece-handle-351-message (prefix rest)
- "RPL_VERSION \"<version>.<debuglevel> <server> :<comments>\"."
- (if (string-match "[^ ]+ \\([^ ]+\\) :*\\([^ ]+\\)[ :]*\\(.*\\)" rest)
- (liece-insert-info
- liece-300-buffer
- (format (_ "Machine %s is running IRC version %s (%s)\n")
- (match-string 2 rest) ; machine
- (match-string 1 rest) ; version
- (match-string 3 rest) ; comments
- ))))
-
-(defun liece-handle-352-message (prefix rest)
- "RPL_WHOREPLY \"<channel> <user> <host> <server> <nickname> <H|G>[*][@|+] :<hopcount> <real name>\"."
- (if (string-match "\\([^ ]*\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) :[0-9]* ?\\(.*\\)" rest)
- (let ((chnl (liece-channel-virtual (match-string 1 rest)))
- (user (match-string 2 rest)) (host (match-string 3 rest))
- (nick (match-string 5 rest)) (oper (match-string 6 rest))
- (name (match-string 7 rest)))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (liece-nick-set-user-at-host nick (concat user "@" host))
- (liece-insert-info liece-300-buffer
- (format "%3s %10s %9s %-29s %s\n"
- oper (if (memq (aref chnl 0) '(?* ?0))
- "Private" chnl)
- nick
- (concat "(" user "@"
- (liece-clean-hostname host)
- ")")
- name)))))
-
-(defvar liece-353-names nil)
-
-(defmacro liece-353-scan-channels (chnl)
- `(or (string-assoc-ignore-case ,chnl liece-channel-alist)
- (push (list ,chnl) liece-channel-alist)))
-
-(defun liece-handle-353-message (prefix rest)
- "RPL_NAMREPLY \"<channel> :[[@|+]<nick> [[@|+]<nick> [...]]]\"."
- (when (string-match "[^ =*@]?[=*@] \\([^ ]*\\) :\\(.*\\)" rest)
- (let ((chnl (liece-channel-virtual (match-string 1 rest)))
- (users (delete "" (split-string (match-string 2 rest)))))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (or (> liece-polling 0)
- (setq liece-353-names
- (append (nreverse users) liece-353-names )))
- (liece-353-scan-channels chnl))))
-
-(defun liece-handle-361-message (prefix rest)
- "RPL_KILLDONE."
- (if (string-match "[^ ]+ \\([^ ]+\\) +:\\(.*\\)" rest)
- (let ((who (match-string 1 rest))
- (message (match-string 2 rest)))
- (liece-insert-info liece-300-buffer
- (format (_ "You just killed %s. %s\n")
- who message)))))
-
-(defstruct liece-364-link from to hop info)
-(defvar liece-364-links nil)
-
-(defun liece-handle-364-message (prefix rest)
- "RPL_LINKS \"<mask> <server> :<hopcount> <server info>\"."
- (if (string-match
- "[^ ]+ \\([^ ]+\\) +\\([^ ]*\\) +:\\(\\(.*\\) +\\(.*\\)\\)" rest)
- (let ((from (match-string 1 rest)) (to (match-string 2 rest))
- (hop (string-to-int (match-string 4 rest)))
- (info (match-string 5 rest)) link)
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (setq rest (match-string 3 rest)
- link (make-liece-364-link
- :from from :to to :hop hop :info info))
- (push link liece-364-links))))
-
-(defun liece-handle-365-message (prefix rest)
- "RPL_ENDOFLINKS \"<mask> :End of /LINKS list\"."
- (liece-reset-long-reply-count)
- (dolist (link liece-364-links)
- (liece-insert-info liece-300-buffer
- (concat (liece-364-link-from link)
- " --"
- (number-to-string (liece-364-link-hop link))
- "-- "
- (liece-364-link-to link) "\n")))
- (setq liece-364-links nil))
-
-(defun liece-handle-366-message (prefix rest)
- "RPL_ENDOFNAME \"<channel> :End of /NAMES list\"."
- (when (string-match "[^ ]* \\([^ ]*\\)" rest)
- (let ((level (- liece-polling 1))
- (users (length liece-353-names))
- (names (mapconcat #'identity liece-353-names " "))
- (chnl (liece-channel-virtual (match-string 1 rest))))
- (liece-reset-long-reply-count)
- (setq liece-polling (max 0 level))
- (liece-insert-info (append (liece-pick-buffer chnl)
- liece-300-buffer)
- (format "%-10s%6d user%s: %s\n"
- (if (memq chnl '(?* ?0))
- "Private"
- chnl)
- users (if (= users 1) "" "s") names))
- (and liece-353-names
- (liece-channel-member chnl liece-current-channels)
- (liece-nick-update chnl liece-353-names))
- (setq liece-353-names nil))))
-
-(defun liece-handle-367-message (prefix rest)
- "RPL_BANLIST \"<channel> <banid>\"."
- (when (string-match "[^ ]* \\([^ ]*\\) \\([^ ]*\\)" rest)
- (let* ((regexp (match-string 2 rest))
- (chnl (liece-channel-virtual (match-string 1 rest))))
- (liece-increment-long-reply-count)
- (liece-check-long-reply-count)
- (or (> liece-polling 0)
- (liece-channel-add-ban regexp chnl)))))
-
-(defun liece-handle-368-message (prefix rest)
- "RPL_ENDOFBANLIST \"<channel> :End of channel ban list\"."
- (when (string-match "[^ ]* \\([^ ]*\\)" rest)
- (let* ((chnl (liece-channel-virtual (match-string 1 rest)))
- (bans (liece-channel-get-bans chnl)))
- (liece-reset-long-reply-count)
- (liece-insert-info liece-300-buffer
- (concat "Following users are banned on " chnl
- ": \n"))
- (dolist (ban bans)
- (liece-insert-info liece-300-buffer
- (concat "\t" ban "\n"))))))
-
-(defun liece-handle-369-message (prefix rest)
- "RPL_ENDOFWHOWAS \"<nickname> :End of WHOWAS\"."
- (setq liece-recursing-whowas nil))
-
-(defun liece-handle-371-message (prefix rest)
- "RPL_INFO \":<string>\"."
- (if (string-match "^\\([^ ]+\\) +:?\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (concat (match-string 2 rest) "\n"))))
-
-(defun liece-handle-372-message (prefix rest)
- "RPL_MOTD \":- <text>\"."
- (if (string-match "^\\([^ ]+\\) +:?\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (concat (match-string 2 rest) "\n"))))
-
-(defun liece-handle-381-message (prefix rest)
- "RPL_YOUREOPER \":You are now an IRC operator\"."
- (if (string-match "^\\([^ ]+\\) +:\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (format "You are now an IRC operator (%s)\n"
- (match-string 2 rest)))))
-
-(defun liece-handle-382-message (prefix rest)
- "RPL_REHASHING \"<config file> :Rehashing\"."
- (if (string-match "^\\([^ ]+\\) +:\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (concat (match-string 2 rest) " "
- (match-string 1 rest) "\n"))))
-
-(defun liece-handle-391-message (prefix rest)
- "RPL_TIME \"<server> :<string showing server's local time>\"."
- (if (string-match "^\\([^ ]+\\) +\\(.*\\)" rest)
- (liece-insert-info liece-300-buffer
- (format (_ "Server time is %s\n")
- (match-string 2 rest)))))
-
-\f
-;;; @ register message handlers
-;;;
-
-(eval-when-compile (require 'liece-handler))
-
-(liece-handler-define-backend "300")
-
-(defmacro liece-register-300-handler (num)
- `(progn
- (liece-handler-define-function
- ,(number-to-string num) '(prefix rest "300")
- ',(intern (format "liece-handle-%03d-message" num)))
- (defvar ,(intern (format "liece-%03d-hook" num)) nil)
- (defvar ,(intern (format "liece-after-%03d-hook" num)) nil)))
-
-(liece-register-300-handler 301)
-(liece-register-300-handler 302)
-(liece-register-300-handler 303)
-(liece-register-300-handler 305)
-(liece-register-300-handler 306)
-
-(liece-register-300-handler 311)
-(liece-register-300-handler 312)
-(liece-register-300-handler 313)
-(liece-register-300-handler 314)
-(liece-register-300-handler 315)
-(liece-register-300-handler 316)
-(liece-register-300-handler 317)
-(liece-register-300-handler 318)
-(liece-register-300-handler 319)
-
-(liece-register-300-handler 321)
-(liece-register-300-handler 322)
-(liece-register-300-handler 323)
-(liece-register-300-handler 324)
-
-(liece-register-300-handler 331)
-(liece-register-300-handler 332)
-(liece-register-300-handler 333)
-
-(liece-register-300-handler 341)
-(liece-register-300-handler 348)
-(liece-register-300-handler 349)
-
-(liece-register-300-handler 351)
-(liece-register-300-handler 352)
-(liece-register-300-handler 353)
-
-(liece-register-300-handler 361)
-(liece-register-300-handler 364)
-(liece-register-300-handler 365)
-(liece-register-300-handler 366)
-(liece-register-300-handler 367)
-(liece-register-300-handler 368)
-(liece-register-300-handler 369)
-
-(liece-register-300-handler 371)
-(liece-register-300-handler 372)
-
-(liece-register-300-handler 381)
-(liece-register-300-handler 382)
-
-(liece-register-300-handler 391)
-
-(provide 'liece-300)
-
-;;; liece-300.el ends here
+++ /dev/null
-;;; liece-400.el --- Handler routines for 400 numeric reply.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-misc))
-
-(defun* liece-handle-400-messages (number prefix rest)
- "400 replies -- ERRORS"
- (or (string-match "[^ ]* \\([^ ]*\\) *\\([^ ]*\\) *:\\(.*\\)" rest)
- (return-from liece-handle-400-messages))
- (let ((target1 (match-string 1 rest)) (target2 (match-string 2 rest))
- (msg (match-string 3 rest)))
- (setq target1 (liece-channel-virtual target1)
- target2 (liece-channel-virtual target2))
- (cond ((string= target1 "")
- (liece-insert-error liece-400-buffer
- (concat msg "\n")))
- ((string= target2 "")
- (liece-insert-error liece-400-buffer
- (concat msg " (" target1 ")\n")))
- (t
- (liece-insert-error liece-400-buffer
- (format"%s %s (%s)\n" target1 msg target2))))))
-
-(defun liece-handle-401-message (prefix rest)
- "ERR_NOSUCHNICK \"<nickname> :No such nick/channel\"."
- (if (string-match "[^ ]+ \\([^ ]+\\)" rest)
- (let ((name (match-string 1 rest)))
- (liece-nick-change name nil)
- (liece-send "WHOWAS %s" name))))
-
-(defun liece-handle-406-message (prefix rest)
- "ERR_WASNOSUCHNICK \"<nickname> :There was no such nickname\"."
- (if (string-match "[^ ]+ \\([^ ]+\\)" rest)
- (let ((nick (match-string 1 rest)))
- (liece-nick-change nick nil)
- (liece-message (_ "No such user %s") nick))))
-
-(defun liece-handle-412-message (prefix rest)
- "ERR_NOTEXTTOSEND \":No text to send\"."
- (liece-message (_ "No text to send")))
-
-(defun liece-iterate-nick (nick)
- (let* ((fmt (format "%s_" nick))
- (new (substring fmt 0 (min 9 (length fmt)))))
- (if (string= nick new)
- (liece-iterate-nick (format "_%s" nick))
- new)))
-
-(defun liece-handle-432-message (prefix rest)
- "ERR_ERRONEUSNICKNAME \"<nickname> :Erroneous nickname\"."
- (let ((nick (cond ((string-match "^[^ ]+ +\\([^ ]+\\)" rest)
- (match-string 1 rest))
- ((string-match "^ *\\([^ ]+\\)" rest)
- (match-string 1 rest)))))
- (with-current-buffer liece-command-buffer
- (if (eq liece-nick-accepted 'ok)
- (setq liece-real-nickname liece-nickname-last))
- (liece-message
- (_ "Erroneous nickname %s. Choose a new one with %s.")
- nick (substitute-command-keys "\\[liece-command-nickname]"))
- (liece-beep))))
-
-(defun liece-handle-433-message (prefix rest)
- "ERR_NICKNAMEINUSE \"<nickname> :Nickname is already in use\"."
- (let ((nick (cond ((string-match "^[^ ]+ +\\([^ ]+\\)" rest)
- (match-string 1 rest))
- ((string-match "^ *\\([^ ]+\\)" rest)
- (match-string 1 rest)))))
- (cond
- ((and (not (eq liece-nick-accepted 'ok))
- liece-auto-iterate-nick)
- (liece-send "NICK %s" (liece-iterate-nick nick))
- (setq liece-nick-accepted 'sent))
- (t
- (if (eq liece-nick-accepted 'ok)
- (setq liece-real-nickname liece-nickname-last))
- (with-current-buffer liece-command-buffer
- (liece-message
- (_ "Nickname %s already in use. Choose a new one with %s.")
- nick (substitute-command-keys "\\[liece-command-nickname]"))
- (liece-beep))))))
-
-(defun liece-handle-442-message (prefix rest)
- "ERR_NOTONCHANNEL \"<channel> :You're not on that channel\"."
- (if (string-match "[^ ]+ \\([^ ]+\\) +:\\(.*\\)" rest)
- (let* ((chnl (liece-channel-virtual (match-string 1 rest)))
- (rest (match-string 2 rest)))
- (if (liece-channel-member chnl liece-current-channels)
- (liece-channel-part chnl)
- (liece-message (_ "You're not on channel %s") chnl)))))
-
-(defun liece-handle-443-message (prefix rest)
- "ERR_USERONCHANNEL \"<channel> <nickname> :is already on channel\"."
- (if (string-match "[^ ]+ \\([^ ]+\\) \\([^ ]+\\)" rest)
- (let ((chnl (match-string 1 rest))
- (rest (match-string 2 rest)))
- (when (prog1 (liece-channel-p chnl)
- (setq chnl (liece-channel-virtual chnl)))
- (or (liece-channel-member chnl liece-current-channels)
- (liece-channel-join chnl)))
- (liece-message (_ "You're already on channel %s") chnl))))
-
-(defun liece-handle-464-message (prefix rest)
- "ERR_PASSWDMISMATCH \":Password incorrect\"."
- (liece-message
- (_ "Password incorrect from %s. Try again with password.") prefix)
- (setq liece-reconnect-with-password t))
-
-(defun liece-handle-482-message (prefix rest)
- "ERR_CHANOPRIVSNEEDED \"<channel> :You're not channel operator\"."
- (liece-message (_ "You are not a channel operator")))
-
-\f
-;;; @ register message handlers
-;;;
-
-(eval-when-compile (require 'liece-handler))
-
-(liece-handler-define-backend "400")
-
-(defmacro liece-register-400-handler (num)
- `(progn
- (liece-handler-define-function
- ,(number-to-string num) '(prefix require "400")
- ',(intern (format "liece-handle-%03d-message" num)))
- (defvar ,(intern (format "liece-%03d-hook" num)) nil)
- (defvar ,(intern (format "liece-after-%03d-hook" num)) nil)))
-
-(liece-register-400-handler 401)
-(liece-register-400-handler 406)
-
-(liece-register-400-handler 412)
-
-(liece-register-400-handler 432)
-(liece-register-400-handler 433)
-
-(liece-register-400-handler 442)
-(liece-register-400-handler 443)
-
-(liece-register-400-handler 464)
-
-(liece-register-400-handler 482)
-
-(provide 'liece-400)
-
-;;; liece-400.el ends here
+++ /dev/null
-;;; liece-500.el --- Handler routines for 500 numeric reply.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-misc))
-
-(defun* liece-handle-500-messages (number prefix rest)
- (or (string-match "[^ ]* \\([^ :]*\\) *\\([^ :]*\\) *:\\(.*\\)" rest)
- (return-from liece-handle-500-messages))
- (let ((target1 (match-string 1 rest)) (target2 (match-string 2 rest))
- (msg (match-string 3 rest)))
- (cond ((string-equal target1 "")
- (liece-insert-error liece-500-buffer (concat msg "\n")))
- ((string-equal target2 "")
- (liece-insert-error liece-500-buffer
- (concat msg " (" target1 ")\n")))
- (t
- (liece-insert-error liece-500-buffer
- (format "%s %s (%s)\n"
- target1 msg target2))))))
-
-(provide 'liece-500)
-
-;;; liece-500.el ends here
+++ /dev/null
-;;; liece-channel.el --- Various facility for channel operation.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-05-05
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'liece-inlines))
-(eval-when-compile (require 'liece-misc))
-
-(eval-when-compile (require 'liece-clfns))
-
-(defconst liece-channel-regexp "[+&#!]")
-(defconst liece-channel-modeless-regexp "[+!]")
-
-(defvar liece-default-channel-representation-format "%s+%s")
-
-(defconst liece-dcc-channel-representation-format "=%s")
-
-(define-widget 'liece-channel-push-button 'push-button
- "A channel button."
- :action 'liece-channel-push-button-action)
-
-(defun liece-channel-push-button-action (widget &optional event)
- (let ((chnl (liece-channel-virtual (widget-value widget))))
- (if (or (liece-channel-member chnl liece-current-channels)
- (y-or-n-p (format "Do you really join %s? " chnl)))
- (liece-command-join chnl))))
-
-;;; Reader conventions
-(defun liece-channel-p (chnl)
- (string-match (concat "^" liece-channel-regexp) chnl))
-
-(defun liece-channel-modeless-p (chnl)
- (string-match (concat "^" liece-channel-modeless-regexp) chnl))
-
-(defun liece-channel-equal (c1 c2)
- (string-equal-ignore-case c1 c2))
-
-(defun liece-channel-member (chnl chnls)
- "Return non-nil if CHNL is member of CHNLS."
- (member-if
- (lambda (item)
- (and (stringp item) (liece-channel-equal chnl item)))
- chnls))
-
-(defun liece-channel-unread-p (chnl)
- "Return non-nil if CHNL is unread channel."
- (member-if
- (lambda (item)
- (and (stringp item) (liece-channel-equal chnl item)))
- liece-channel-unread-list))
-
-(defun liece-channel-get-nicks (&optional chnl)
- "Return CHNL or current channels's members as list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'nick))
-
-(defun liece-channel-get-operators (&optional chnl)
- "Return CHNL or current channels's operators as list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'oper))
-
-(defun liece-channel-get-voices (&optional chnl)
- "Return CHNL or current channels's voices as list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'voice))
-
-(defun liece-channel-get-topic (&optional chnl)
- "Return CHNL or current channels's topic."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'topic))
-
-(defun liece-channel-get-modes (&optional chnl)
- "Return CHNL or current channels's mode."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'mode))
-
-(defun liece-channel-get-bans (&optional chnl)
- "Return CHNL or current channels's ban list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'ban))
-
-(defun liece-channel-get-invites (&optional chnl)
- "Return CHNL or current channels's invite list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'invite))
-
-(defun liece-channel-get-exceptions (&optional chnl)
- "Return CHNL or current channels's exception list."
- (get (intern (or chnl liece-current-channel) liece-obarray) 'exception))
-
-;;; Channel status functions
-(defun liece-channel-remove (channel channels)
- "Remove CHANNEL from CHANNELS."
- (remove-if
- (lambda (item)
- (and (stringp item) (liece-channel-equal channel item)))
- channels))
-
-(defun liece-channel-delete (channel channels)
- "Delete CHANNEL from CHANNELS."
- (delete-if
- (lambda (item)
- (and (stringp item) (liece-channel-equal channel item)))
- channels))
-
-(defun liece-channel-set-topic (topic &optional channel)
- "Set CHANNEL's topic."
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'topic topic))
-
-(defun liece-channel-add-mode (mode &optional channel)
- "Add MODE to CHANNEL.
-MODE is a string splitted into characters one by one."
- (let ((modes
- (liece-string-to-list
- (or (liece-channel-get-modes channel)
- ""))))
- (or (memq mode modes)
- (push mode modes))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'mode (mapconcat #'char-to-string modes ""))))
-
-(defun liece-channel-remove-mode (mode &optional channel)
- "Remove MODE from CHANNEL.
-MODE is a string splitted into characters one by one."
- (let ((modes
- (liece-string-to-list
- (or (liece-channel-get-modes channel)
- ""))))
- (delq mode modes)
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'mode (mapconcat #'char-to-string modes ""))))
-
-(defun liece-channel-set-mode (channel mode flag)
- "Add or remove channel MODE of CHANNEL.
-MODE is a string splitted into characters one by one.
-If FLAG is non-nil, given modes are added to the channel.
-Otherwise they are removed from the channel."
- (if flag
- (liece-channel-add-mode mode channel)
- (liece-channel-remove-mode mode channel)))
-
-(defun liece-channel-add-ban (pattern &optional channel)
- "Add ban PATTERN to CHANNEL."
- (let ((patterns (liece-channel-get-bans channel)))
- (or (string-list-member-ignore-case pattern patterns)
- (push pattern patterns))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'ban patterns)))
-
-(defun liece-channel-remove-ban (pattern &optional channel)
- "Remove ban PATTERN from CHANNEL."
- (let ((patterns
- (remove-if
- (lambda (elm) (string-equal pattern elm))
- (liece-channel-get-bans channel))))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'ban patterns)))
-
-(defun liece-channel-set-ban (channel pattern flag)
- "Add or remove ban PATTERN to CHANNEL.
-If FLAG is non-nil, given ban patterns are added to the channel.
-Otherwise they are removed from the channel."
- (if flag
- (liece-channel-add-ban pattern channel)
- (liece-channel-remove-ban pattern channel)))
-
-(defun liece-channel-add-exception (pattern &optional channel)
- "Add exception PATTERN to CHANNEL."
- (let ((patterns (liece-channel-get-exceptions channel)))
- (or (string-list-member-ignore-case pattern patterns)
- (push pattern patterns))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'exception patterns)))
-
-(defun liece-channel-remove-exception (pattern &optional channel)
- "Remove exception PATTERN from CHANNEL."
- (let ((patterns
- (remove-if
- (lambda (elm) (string-equal pattern elm))
- (liece-channel-get-exceptions channel))))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'exception patterns)))
-
-(defun liece-channel-set-exception (channel pattern flag)
- "Add or remove exception PATTERN to CHANNEL.
-If FLAG is non-nil, given exception patterns are added to the channel.
-Otherwise they are removed from the channel."
- (if flag
- (liece-channel-add-exception pattern channel)
- (liece-channel-remove-exception pattern channel)))
-
-(defun liece-channel-add-invite (pattern &optional channel)
- "Add invite PATTERN to CHANNEL."
- (let ((patterns (liece-channel-get-invites channel)))
- (or (string-list-member-ignore-case pattern patterns)
- (push pattern patterns))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'invite patterns)))
-
-(defun liece-channel-remove-invite (pattern &optional channel)
- "Remove invite PATTERN from CHANNEL."
- (let ((patterns
- (remove-if
- (lambda (elm) (string-equal pattern elm))
- (liece-channel-get-invites channel))))
- (put (intern (or channel liece-current-channel) liece-obarray)
- 'invite patterns)))
-
-(defun liece-channel-set-invite (channel pattern flag)
- "Add or remove invite PATTERN to CHANNEL.
-If FLAG is non-nil, given invite patterns are added to the channel.
-Otherwise they are removed from the channel."
- (if flag
- (liece-channel-add-invite pattern channel)
- (liece-channel-remove-invite pattern channel)))
-
-(defun liece-channel-virtual (channel)
- "Convert channel name into internal representation.
-\(For example if CHANNEL is a string \"#...:*\", it will be converted into
-\"%...\"\)"
- (let ((mapping liece-channel-conversion-map) match)
- (while mapping
- (if (string-equal-ignore-case (caar mapping) channel)
- (setq match (cdar mapping)))
- (pop mapping))
- (if match
- match
- (save-match-data
- (cond
- ((string-match
- (format "^[#+]\\(.*\\):%s$"
- (regexp-quote liece-channel-conversion-default-mask))
- channel)
- (if (eq ?+ (aref channel 0))
- (concat "-" (match-string 1 channel))
- (concat "%" (match-string 1 channel))))
-;;; ((and (not (equal channel "")) (eq ?! (aref channel 0)))
-;;; (concat "!" (substring channel (1+ liece-channel-id-length))))
- (t channel))))))
-
-(defun liece-channel-real (channel)
- "Convert channel name into external representation.
-\(For example if CHANNEL is a string \"%...\", it will be converted into
-\"#...:*\"\)"
- (let ((mapping liece-channel-conversion-map) match)
- (while mapping
- (if (string-equal-ignore-case (cdar mapping) channel)
- (setq match (caar mapping)))
- (pop mapping))
- (cond
- (match match)
- ((eq ?% (aref channel 0))
- (concat "#" (substring channel 1) ":"
- liece-channel-conversion-default-mask))
- ((eq ?- (aref channel 0))
- (concat "+" (substring channel 1) ":"
- liece-channel-conversion-default-mask))
- (t channel))))
-
-;;;###liece-autoload
-(defun liece-command-toggle-channel-buffer-mode ()
- "Toggle visibility of channel buffer."
- (interactive)
- (if (get-buffer liece-channel-buffer)
- (setq liece-channel-buffer-mode (not liece-channel-buffer-mode)))
- (liece-configure-windows))
-
-(defun liece-channel-buffer-create (chnl)
- "Create channel buffer of CHNL."
- (with-current-buffer
- (liece-get-buffer-create (format liece-channel-buffer-format chnl))
- (let (buffer-read-only)
- (liece-insert-info (current-buffer)
- (concat (funcall liece-format-time-function
- (current-time))
- " Created.\n")))
- (unless (eq major-mode 'liece-channel-mode)
- (liece-channel-mode))
- (set-alist 'liece-channel-buffer-alist chnl (current-buffer))
- (current-buffer)))
-
-(defun liece-channel-join-internal (item chnls &optional hints)
- (let (binding inserted)
- (if (liece-channel-member item hints)
- (do ((hint hints (cdr hint)) (chnl chnls (cdr chnl)))
- ((not (or hint chnl)))
- (if (and (car hint) (liece-channel-equal (car hint) item))
- (push item binding)
- (push (car chnl) binding)))
- (do ((hint hints (cdr hint)) (chnl chnls (cdr chnl)))
- ((not (or hint chnl)))
- (if (and (not inserted)
- (not (or (car hint) (car chnl))))
- (progn
- (push item binding)
- (setq inserted t))
- (push (car chnl) binding))))
- (or (liece-channel-member item binding)
- (push item binding))
- (nreverse binding)))
-
-(defun liece-channel-join (chnl &optional nosw)
- "Initialize channel variables of CHNL.
-If NOSW is non-nil do not switch to newly created channel."
- (let ((cbuf (cdr (string-assoc-ignore-case chnl liece-channel-buffer-alist)))
- (nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
- (or cbuf
- (setq cbuf (liece-channel-buffer-create chnl)))
- (or nbuf
- (setq nbuf (liece-nick-buffer-create chnl)))
- (if (liece-channel-p (liece-channel-real chnl))
- (setq liece-current-channels
- (liece-channel-join-internal
- chnl liece-current-channels liece-default-channel-binding))
- (setq liece-current-chat-partners
- (liece-channel-join-internal chnl liece-current-chat-partners
- liece-default-partner-binding)))
- (unless nosw
- (liece-switch-to-channel chnl)
- (setq liece-channel-buffer cbuf
- liece-nick-buffer nbuf))
- (liece-channel-change)))
-
-(defmacro liece-channel-switch-to-last (chnls)
- `(let ((chnl (liece-channel-last ,chnls)))
- (if chnl
- (liece-switch-to-channel chnl))
- (liece-channel-change)))
-
-(defun liece-channel-part-internal (item chnls &optional hints)
- (if hints
- (mapcar
- (lambda (chnl)
- (if (and chnl (liece-channel-equal item chnl)) nil chnl))
- chnls)
- (liece-channel-remove item chnls)))
-
-(defun liece-channel-part (chnl &optional nosw)
- "Finalize channel variables of CHNL.
-If NOSW is non-nil do not switch to newly created channel."
- (cond
- ((eq liece-command-buffer-mode 'chat)
- (setq liece-current-chat-partners
- (liece-channel-part-internal chnl liece-current-chat-partners
- liece-default-partner-binding))
- (unless nosw
- (liece-channel-switch-to-last liece-current-chat-partners)))
- (t
- (setq liece-current-channels
- (liece-channel-part-internal chnl liece-current-channels
- liece-default-channel-binding))
- (unless nosw
- (liece-channel-switch-to-last liece-current-channels)))))
-
-(defun liece-channel-last (chnls)
- (car (last (delq nil (copy-sequence chnls)))))
-
-(defun liece-channel-change ()
- (let ((chnls (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels))
- (string "")
- chnl)
- (with-current-buffer liece-channel-list-buffer
- (let ((n 1) buffer-read-only)
- (erase-buffer)
- (dolist (chnl chnls)
- (when chnl
- (setq chnl (liece-channel-virtual chnl)
- string (format "%s,%d:%s" string n chnl))
- (liece-channel-list-add-button n chnl))
- (incf n))))
- (if (string-equal string "")
- (if (eq liece-command-buffer-mode 'chat)
- (setq liece-channels-indicator "No partner")
- (setq liece-channels-indicator "No channel"))
- (setq liece-channels-indicator (substring string 1)))
- (liece-set-channel-indicator)
- (setq chnl (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-current-channel))
- (when chnl
- (save-excursion
- (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
- (liece-redisplay-unread-mark)
- (liece-configure-windows)))
-
-(defsubst liece-channel-set-operator-1 (chnl user val)
- (let* ((chnl (intern chnl liece-obarray)) (opers (get chnl 'oper)))
- (if val
- (or (string-list-member-ignore-case user opers)
- (put chnl 'oper (cons user opers)))
- (if (string-list-member-ignore-case user opers)
- (put chnl 'oper (string-list-remove-ignore-case user opers))))))
-
-(defsubst liece-channel-set-voice-1 (chnl user val)
- (let* ((chnl (intern chnl liece-obarray)) (voices (get chnl 'voice)))
- (if val
- (or (string-list-member-ignore-case user voices)
- (put chnl 'voice (cons user voices)))
- (if (string-list-member-ignore-case user voices)
- (put chnl 'voice (string-list-remove-ignore-case user voices))))))
-
-(defun liece-channel-set-operator (chnl user val)
- (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist)))
- (xuser user))
- (liece-channel-set-operator-1 chnl user val)
- (liece-channel-set-voice-1 chnl user val)
- (setq user (concat (if val "@" " ") user)
- xuser (concat (if val "[ +]" "@") (regexp-quote xuser)))
- (with-current-buffer nbuf
- (let (buffer-read-only)
- (goto-char (point-min))
- (liece-nick-replace xuser user nil t)))))
-
-(defun liece-channel-set-voice (chnl user val)
- (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist)))
- (xuser user))
- (liece-channel-set-voice-1 chnl user val)
- (setq user (concat (if val "+" " ") user)
- xuser (concat (if val " " "\\+") (regexp-quote xuser)))
- (with-current-buffer nbuf
- (let (buffer-read-only)
- (goto-char (point-min))
- (liece-nick-replace xuser user nil t)))))
-
-(defun liece-channel-prepare-partner (join-channel-var)
- (setq liece-current-chat-partner
- (or liece-current-chat-partner join-channel-var))
- (let ((liece-command-buffer-mode 'chat))
- (liece-channel-join join-channel-var t))
- (liece-channel-change))
-
-(defun liece-channel-buffer-invisible-p (chnl mode)
- (let ((cbuf (liece-pick-buffer chnl)))
- (or (liece-frozen (car cbuf))
- (and (eq mode 'chat)
- (not (and (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- (string-equal-ignore-case
- chnl liece-current-chat-partner))))
- (not (and (eq liece-command-buffer-mode 'channel)
- liece-current-channel
- (string-equal-ignore-case
- chnl liece-current-channel))))))
-
-(defun liece-channel-prepare-representation (chnl &optional method name)
- (cond
- ((eq method 'dcc)
- (format liece-dcc-channel-representation-format chnl))
- (name
- (format liece-default-channel-representation-format name chnl))
- (t chnl)))
-
-(defun liece-channel-parse-representation (str)
- (cond
- ((string-match
- (format
- (regexp-quote liece-dcc-channel-representation-format)
- "\\([^ ]+\\)")
- str)
- (vector 'dcc nil (match-string 1 str)))
- ((string-match
- (format
- (regexp-quote liece-default-channel-representation-format)
- "\\([^ ]+\\)" "\\([^ ]+\\)")
- str)
- (vector 'irc (match-string 1 str) (match-string 2 str)))
- (t (vector 'irc nil str))))
-
-(defun liece-channel-list-add-button (n chnl)
- (insert (format "%2d: " n))
- (if liece-highlight-mode
- (let ((st (point)))
- (insert chnl)
- (liece-widget-convert-button
- 'liece-channel-push-button st (point) chnl))
- (insert chnl))
- (insert "\n"))
-
-(defun liece-channel-add-buttons (start end)
- (save-excursion
- (goto-char start)
- (while (re-search-forward
- (eval-when-compile
- (concat "\\(^\\(" liece-time-prefix-regexp "\\)?"
- "[][=<>(-][][=<>(-]?\\|\\s-+[+@]?\\)"
- "\\([&#!%][^ :]*\\)"))
- end t)
- ;;(re-search-forward "\\s-+\\(\\)\\([-+]\\S-*\\)" end t)
- (let* ((chnl-start (match-beginning 3))
- (chnl-end (match-end 3))
- (chnl (buffer-substring chnl-start chnl-end)))
- (when liece-highlight-mode
- (liece-widget-convert-button
- 'liece-channel-push-button chnl-start chnl-end chnl))))))
-
-;;;###liece-autoload
-(defun liece-channel-redisplay-buffer (chnl)
- (let ((buffer
- (cdr (string-assoc-ignore-case
- chnl liece-channel-buffer-alist)))
- (window (liece-get-buffer-window liece-channel-buffer)))
- (when (liece-channel-unread-p chnl)
- (setq liece-channel-unread-list
- (delete chnl liece-channel-unread-list))
- (run-hook-with-args 'liece-channel-read-functions chnl))
- (and buffer window
- (with-current-buffer buffer
- (set-window-buffer window buffer)
- (unless (liece-frozen buffer)
- (set-window-point window (point-max)))
- (setq liece-channel-buffer buffer)))))
-
-;;;###liece-autoload
-(defun liece-channel-list-redisplay-buffer (chnl)
- (let ((window (liece-get-buffer-window liece-channel-list-buffer)))
- (when window
- (save-selected-window
- (select-window window)
- (goto-char (point-min))
- (search-forward chnl nil t)
- (set-window-point window (match-beginning 0))
- (when liece-highlight-mode
- (let ((overlay (make-overlay (point)(match-end 0))))
- (liece-map-overlays
- (lambda (ovl)
- (if (overlay-get ovl 'liece-channel)
- (delete-overlay ovl))))
- (overlay-put overlay 'face 'underline)
- (overlay-put overlay 'liece-channel t)))))))
-
-(provide 'liece-channel)
-
-;;; liece-channel.el ends here
+++ /dev/null
-;;; liece-clfns.el --- compiler macros for emulating cl functions
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 2000-03-19
-;; Keywords: cl, compile
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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 is borrowed from `gnus-clfns.el' from T-gnus.
-;; Avoid cl runtime functions for FSF Emacsen.
-
-;;; Code:
-
-(defun liece-clfns-subr-fboundp (symbol)
- "Return t if SYMBOL's function definition is a basic function."
- (and (fboundp symbol)
- (or (subrp (symbol-function symbol))
- (and (fboundp 'symbol-file)
- (string-equal (symbol-file symbol) "subr")))))
-
-(if (featurep 'xemacs)
- nil
- (require 'cl)
-
- (define-compiler-macro last (&whole form x &optional n)
- (if (liece-clfns-subr-fboundp 'last)
- form
- (if n
- `(let* ((x ,x) (n ,n) (m 0) (p x))
- (while (consp p)
- (incf m)
- (pop p))
- (if (<= n 0)
- p
- (if (< n m)
- (nthcdr (- m n) x)
- x)))
- `(let ((x ,x))
- (while (consp (cdr x))
- (pop x))
- x))))
-
- (define-compiler-macro remq (&whole form elt list)
- (if (liece-clfns-subr-fboundp 'remq)
- form
- `(let ((elt ,elt)
- (list ,list))
- (if (memq elt list)
- (delq elt (copy-sequence list))
- list))))
-
- (define-compiler-macro member-if (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'member-if)
- form
- `(let ((fn ,pred)
- (seq ,list))
- (while (and seq (not (funcall fn (car seq))))
- (pop seq))
- seq)))
-
- (define-compiler-macro member-if-not (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'member-if-not)
- form
- `(let ((fn ,pred)
- (seq ,list))
- (while (and seq (funcall fn (car seq)))
- (pop seq))
- seq)))
-
- (define-compiler-macro delete-if (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'delete-if)
- form
- `(let* ((fn ,pred) (seq ,list) (p seq))
- (while (and p (not (funcall fn (car p))))
- (pop p))
- (if p (delq (car p) seq)))))
-
- (define-compiler-macro remove-if (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'remove-if)
- form
- `(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
- (while (and p (not (funcall fn (car p))))
- (pop p))
- (if p (delq (car p) seq) seq))))
-
- (define-compiler-macro remove-if-not (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'remove-if-not)
- form
- `(let* ((fn ,pred) (seq (copy-sequence ,list)) (p seq))
- (while (and p (funcall fn (car p)))
- (pop p))
- (if p (delq (car p) seq) seq))))
-
- (define-compiler-macro assoc-if (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'assoc-if)
- form
- `(let ((fn ,pred) (seq ,list))
- (while (and seq (not (funcall fn (caar seq))))
- (pop seq))
- (car seq))))
-
- (define-compiler-macro rassoc-if (&whole form pred list)
- (if (liece-clfns-subr-fboundp 'rassoc-if)
- form
- `(let ((fn ,pred) (seq ,list))
- (while (and seq (not (funcall fn (cdar seq))))
- (pop seq))
- (car seq)))))
-
-(provide 'liece-clfns)
-
-;;; liece-clfns.el ends here
+++ /dev/null
-;;; liece-coding.el --- Converting string with apropriate coding system.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-06-02
-;; Keywords: IRC, liece, coding-system, MULE
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'poem)
-(require 'mcharset)
-
-(eval-when-compile (require 'liece-compat))
-
-(defgroup liece-coding nil
- "Code conversion group"
- :tag "Coding"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-mime-charset-for-write
- (if (mime-charset-to-coding-system 'iso-2022-jp-2)
- 'iso-2022-jp-2
- default-mime-charset-for-write)
- "Charset used in any transferred messages."
- :type 'mime-charset
- :group 'liece-coding)
-
-(defcustom liece-mime-charset-for-read
- (if (mime-charset-to-coding-system 'x-ctext)
- 'x-ctext
- default-mime-charset)
- "Charset used in any transferred messages."
- :type 'mime-charset
- :group 'liece-coding)
-
-(static-when (featurep 'xemacs)
- (define-obsolete-variable-alias 'liece-default-mime-charset
- 'liece-mime-charset-for-write)
- (define-obsolete-variable-alias 'liece-default-mime-charset-for-read
- 'liece-mime-charset-for-read))
-
-(defcustom liece-detect-coding-system nil
- "Whether use coding system auto detection."
- :type 'boolean
- :group 'liece-coding)
-
-(defcustom liece-detect-coding-region-function
- (function liece-detect-coding-region)
- "User customizable `detect-coding-region'."
- :type 'function
- :group 'liece-coding)
-
-(defcustom liece-detect-coding-string-function
- (function liece-detect-coding-string)
- "User customizable detect-coding-string."
- :type 'function
- :group 'liece-coding)
-
-(defcustom liece-decode-coding-string-function
- (function decode-coding-string)
- "User customizable `decode-coding-string'."
- :type 'function
- :group 'liece-coding)
-
-(defun liece-coding-encode-charset-region (start end &optional lbt)
- (encode-mime-charset-region start end liece-mime-charset-for-write lbt))
-
-(defun liece-coding-decode-charset-region (start end)
- (let ((cs (if (and liece-detect-coding-system
- (fboundp liece-detect-coding-region-function))
- (funcall liece-detect-coding-region-function start end)
- (mime-charset-to-coding-system liece-mime-charset-for-read))))
- (decode-coding-region start end cs)))
-
-(defun liece-detect-coding-region (start end)
- (let ((cs (detect-coding-region start end)))
- (if (listp cs)
- (setq cs (car cs)))
- (if (featurep 'xemacs)
- (eval '(setq cs (coding-system-name cs))))
- cs))
-
-(defun liece-coding-encode-charset-string (str &optional lbt)
- (encode-mime-charset-string str liece-mime-charset-for-write lbt))
-
-(eval-and-compile
- (when (fboundp 'detect-coding-string)
- (defun liece-detect-coding-string (str)
- (let ((cs (detect-coding-string str)))
- (if (listp cs)
- (setq cs (car cs)))
- (static-if (fboundp 'coding-system-name)
- (coding-system-name cs)
- cs)))))
-
-(defun liece-coding-decode-charset-string (str)
- (let ((cs (or (and liece-detect-coding-system
- (fboundp liece-detect-coding-string-function)
- (funcall liece-detect-coding-string-function str))
- (mime-charset-to-coding-system liece-mime-charset-for-read))))
- (funcall liece-decode-coding-string-function str cs)))
-
-(provide 'liece-coding)
-
-;;; liece-coding.el ends here
+++ /dev/null
-;;; liece-commands.el --- Interactive commands in command buffer.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-12-24
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-misc))
-
-(require 'liece-channel)
-(require 'liece-nick)
-(require 'liece-coding)
-(require 'liece-intl)
-(require 'liece-minibuf)
-
-(autoload 'liece-dcc-chat-send "liece-dcc")
-
-(autoload 'liece-command-ctcp-action "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-version "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-userinfo "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-userinfo-from-minibuffer "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-help "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-clientinfo "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-ping "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-time "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-x-face "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-x-face-from-xbm-file "liece-ctcp" nil t)
-(autoload 'liece-command-ctcp-comment "liece-ctcp" nil t)
-
-(defun liece-command-poll-names ()
- "Handler for polling NAMES."
- (when (liece-server-opened)
- (setq liece-polling
- (+ liece-polling
- (length liece-channel-alist)))
- (dolist (chnl liece-channel-alist)
- (liece-send "NAMES %s" (car chnl)))))
-
-(defun liece-command-poll-friends ()
- "Handler for polling ISON."
- (and liece-friends
- (liece-server-opened)
- (liece-send "ISON %s" (mapconcat 'identity liece-friends " "))))
-
-(defun liece-command-find-timestamp ()
- "Find recent timestamp in dialogue buffer."
- (interactive)
- (save-excursion
- (let ((range "")
- (regexp (concat "^\\(" liece-time-prefix-regexp "\\)?"
- (regexp-quote liece-timestamp-prefix))))
- (unless (eq 'liece-dialogue-mode (derived-mode-class major-mode))
- (set-buffer liece-dialogue-buffer)
- (goto-char (point-max)))
- (if (re-search-backward regexp (point-min) t)
- (setq range (concat (buffer-substring (match-end 0)
- (line-end-position))
- " --- ")))
- (if (re-search-forward regexp (point-max) t)
- (setq range (concat range (buffer-substring (match-end 0)
- (line-end-position)))))
- (liece-message range))))
-
-(defun liece-command-keepalive ()
- "Handler for polling server connection."
- (if (not (liece-server-opened))
- (liece)
- (liece-ping-if-idle)))
-
-(defvar liece-last-timestamp-time nil "Last time timestamp was inserted.")
-(defvar liece-last-timestamp-no-cons-p nil "Last timestamp was no-cons.")
-
-(defun liece-command-timestamp-if-interval-expired (&optional no-cons)
- "If interval timer has expired, insert timestamp into dialogue buffer.
-And save variables into `liece-variable-file' if there are variables to save.
-Optional argument NO-CONS specifies timestamp format is cons cell."
- (interactive)
- (when (and (not (and no-cons
- liece-last-timestamp-no-cons-p))
- (numberp liece-timestamp-interval)
- (> liece-timestamp-interval 0)
- (or (null liece-last-timestamp-time)
- (> (liece-time-difference liece-last-timestamp-time
- (current-time))
- liece-timestamp-interval)))
- (if liece-save-variables-are-dirty
- (liece-command-save-vars))
- (liece-command-timestamp)
- (setq liece-last-timestamp-no-cons-p no-cons)))
-
-(defun liece-command-timestamp ()
- "Insert timestamp into dialogue buffer."
- (interactive)
- (let ((stamp (format liece-timestamp-format
- (funcall liece-format-time-function (current-time))))
- (liece-timestamp-interval 0))
- (liece-insert liece-D-buffer (concat stamp "\n"))
- (setq liece-last-timestamp-time (current-time))))
-
-(defun liece-command-point-back-to-command-buffer ()
- "Set point back to command buffer."
- (interactive)
- (let ((win (liece-get-buffer-window liece-command-buffer)))
- (if win (select-window win))))
-
-(defun liece-command-send-message (message)
- "Send MESSAGE to current chat partner of current channel."
- (if (string-equal message "")
- (progn (liece-message (_ "No text to send")) nil)
- (let ((addr (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-current-channel))
- repr method name target)
- (cond
- ((eq liece-command-buffer-mode 'chat)
- (or liece-current-chat-partner
- (error
- (substitute-command-keys
- "Type \\[liece-command-join] to start private conversation")))
- (setq repr (liece-channel-parse-representation
- liece-current-chat-partner)
- method (aref repr 0)
- name (aref repr 1)
- target (aref repr 2))
- (cond ((eq method 'dcc)
- (liece-dcc-chat-send target message))
- ((eq method 'irc)
- (liece-send "PRIVMSG %s :%s"
- liece-current-chat-partner message)))
- (liece-own-private-message message))
- (t
- (or liece-current-channel
- (error
- (substitute-command-keys
- "Type \\[liece-command-join] to join a channel")))
- (liece-send
- "PRIVMSG %s :%s"
- (liece-channel-real liece-current-channel) message)
- (liece-own-channel-message message))))))
-
-(defun liece-command-enter-message ()
- "Enter the current line as an entry in the IRC dialogue."
- (interactive)
- (beginning-of-line)
- (liece-command-send-message
- (buffer-substring (point)(progn (end-of-line) (point))))
- (liece-next-line 1))
-
-(defun liece-dialogue-enter-message ()
- "Ask for a line as an entry in the IRC dialogue on the current channel."
- (interactive)
- (let (message)
- (while (not (string-equal (setq message (read-string "> ")) ""))
- (liece-command-send-message message))))
-
-(defun liece-command-join-channel (join-channel-var key)
- "Join a JOIN-CHANNEL-VAR with KEY."
- (let ((nicks liece-nick-alist) nick)
- (while (and nicks
- (not (and
- (car nick)
- (liece-channel-equal join-channel-var (car nick)))))
- (setq nick (pop nicks)))
- (when nicks
- (setq join-channel-var
- (or (car (liece-nick-get-joined-channels (car nick)))
- join-channel-var)))
- (if (liece-channel-member join-channel-var liece-current-channels)
- (progn
- (setq liece-current-channel join-channel-var)
- (liece-switch-to-channel liece-current-channel)
- (liece-channel-change))
- (liece-send "JOIN %s %s" (liece-channel-real join-channel-var) key))))
-
-(defun liece-command-join-partner (join-channel-var)
- "Join a JOIN-CHANNEL-VAR."
- (if (liece-channel-member join-channel-var liece-current-chat-partners)
- (progn
- (setq liece-current-chat-partner join-channel-var)
- (liece-switch-to-channel liece-current-chat-partner))
- (setq liece-current-chat-partner join-channel-var)
- (liece-channel-join liece-current-chat-partner))
- (liece-channel-change))
-
-(defun liece-command-join (join-channel-var &optional key)
- "Join a JOIN-CHANNEL-VAR with KEY.
-If user nickname is given join the same set of channels as the specified user.
-If command-buffer is in chat-mode, start private conversation
-with specified user."
- (interactive
- (let (join-channel-var key (completion-ignore-case t))
- (setq join-channel-var
- (if (numberp current-prefix-arg)
- current-prefix-arg
- (liece-channel-virtual
- (if (eq liece-command-buffer-mode 'chat)
- (liece-minibuffer-completing-read
- (_ "Start private conversation with: ")
- liece-nick-alist nil nil nil nil liece-privmsg-partner)
- (liece-minibuffer-completing-read
- (_ "Join channel: ")
- (append liece-channel-alist liece-nick-alist)
- nil nil nil nil liece-default-channel-candidate)))))
- (if (and current-prefix-arg
- (not (numberp current-prefix-arg)))
- (setq key
- (if (eq current-prefix-arg '-)
- (read-string
- (format (_ "Key for channel %s: ") join-channel-var))
- (liece-read-passwd
- (format (_ "Key for channel %s: ") join-channel-var)))))
- (list join-channel-var key)))
- (let ((real-chnl (liece-channel-real join-channel-var)))
- (if (numberp join-channel-var)
- (liece-switch-to-channel-no join-channel-var)
- (setq liece-default-channel-candidate nil)
- (if (liece-channel-p real-chnl)
- (liece-toggle-command-buffer-mode 'channel)
- (liece-toggle-command-buffer-mode 'chat))
- (if (eq liece-command-buffer-mode 'chat)
- (liece-command-join-partner join-channel-var)
- (if (null key)
- (setq key (get (intern join-channel-var liece-obarray) 'key)))
- (put (intern join-channel-var liece-obarray) 'key key)
- (if (null key)
- (setq key ""))
- (liece-command-join-channel join-channel-var key))
- (force-mode-line-update))))
-
-(defun liece-command-part (part-channel-var &optional part-msg)
- "Part a PART-CHANNEL-VAR with PART-MSG."
- (interactive
- (let (part-channel-var
- (completion-ignore-case t)
- (part-msg "bye..."))
- (setq part-channel-var
- (liece-channel-virtual
- (if (eq liece-command-buffer-mode 'chat)
- (liece-minibuffer-completing-read
- (_ "End private conversation with: ")
- (list-to-alist liece-current-chat-partners)
- nil nil nil nil liece-current-chat-partner)
- (liece-minibuffer-completing-read
- (_ "Part channel: ")
- (list-to-alist liece-current-channels)
- nil nil nil nil liece-current-channel))))
- (when current-prefix-arg
- (setq part-msg (read-string (_ "Part Message: "))))
- (list part-channel-var part-msg)))
- (let ((real-chnl (liece-channel-real part-channel-var)))
- (if (liece-channel-p real-chnl)
- (progn
- (if (liece-channel-member part-channel-var liece-current-channels)
- (setq liece-current-channel part-channel-var))
- (liece-send "PART %s :%s" real-chnl part-msg)
- (setq liece-default-channel-candidate part-channel-var))
- (setq liece-current-chat-partners
- (liece-channel-remove part-channel-var
- liece-current-chat-partners)
- liece-current-chat-partner
- (car liece-current-chat-partners))
- (liece-set-channel-indicator)
- (liece-channel-part part-channel-var))))
-
-(defun liece-command-kill (kill-nickname-var &optional timeout silent)
- "Ignore messages from KILL-NICKNAME-VAR.
-Username can be given as case insensitive regular expression of form
-\".*@.*\.sub.domain\".
-If already ignoring him/her, toggle.
-If `liece-variables-file' is defined and the file is writable,
-settings are updated automatically for future sessions.
-Optional argument TIMEOUT says expiration.
-If SILENT is non-nil, don't notify current status."
- (interactive
- (let (kill-nickname-var timeout (completion-ignore-case t))
- (setq kill-nickname-var (completing-read
- (_ "Ignore nickname or regexp: ")
- (append liece-nick-alist
- liece-kill-nickname)))
- (or (string-equal "" kill-nickname-var)
- (string-assoc-ignore-case kill-nickname-var liece-kill-nickname)
- (setq timeout (string-to-int (read-from-minibuffer
- (_ "Timeout [RET for none]: ")))))
- (list kill-nickname-var timeout)))
- ;; empty, just list them
- (if (string-equal "" kill-nickname-var)
- (with-current-buffer liece-dialogue-buffer
- (let ((ignores liece-kill-nickname) (time (current-time))
- buffer-read-only expire expiretime)
- (goto-char (point-max))
- (liece-insert-info liece-D-buffer (_ "Currently ignoring:"))
- (dolist (ignore ignores)
- (setq expiretime (if (cdr ignore)
- (/ (liece-time-difference time (cdr ignore))
- 60))
- expire (cond ((not expiretime) "")
- ((>= expiretime 0)
- (format (_ " (%d min)") expiretime))
- ((< expiretime 0)
- (_ " expired"))))
- (liece-insert liece-D-buffer
- (concat " " (car ignore) expire "\n")))))
- ;; else not empty, check if exists
- (let ((ignore
- (string-assoc-ignore-case
- kill-nickname-var liece-kill-nickname)))
- (if ignore
- (when (setq ignore (string-assoc-ignore-case
- (car ignore) liece-kill-nickname))
- (setq liece-kill-nickname
- (delq ignore liece-kill-nickname))
- (liece-insert-info liece-D-buffer
- (format (_ "No longer ignoring: %s.\n")
- (car ignore))))
- ;; did not find, add to ignored ones
- (let ((expire-time (if (> timeout 0)
- (liece-time-elapsed (current-time)
- (* timeout 60)))))
- (and silent (> timeout 0)
- (setcar (cdr (cdr expire-time)) -1))
- (setq liece-kill-nickname
- (cons (cons kill-nickname-var expire-time)
- liece-kill-nickname))
- (unless silent
- (liece-insert-info liece-D-buffer
- (format (_ "Ignoring %s") kill-nickname-var))
- (liece-insert-info liece-D-buffer
- (if (> timeout 0)
- (format " for %d minutes.\n" timeout)
- (format ".\n")))))))
- (setq liece-save-variables-are-dirty t)))
-
-(defun liece-command-kick (nick &optional msg)
- "Kick this NICK out with MSG."
- (interactive
- (let ((completion-ignore-case t)
- (nicks (liece-channel-get-nicks)) nick msg)
- (setq nick (completing-read
- (_ "Kick out nickname: ")
- (list-to-alist nicks)))
- (if current-prefix-arg
- (setq msg (concat " :" (read-string (_ "Kick Message: ")))))
- (list nick msg)))
- (liece-send "KICK %s %s%s"
- (liece-channel-real liece-current-channel)
- nick (or msg "")))
-
-(defun liece-command-ban (ban)
- "BAN this user out."
- (interactive
- (let* ((completion-ignore-case t)
- (nicks (liece-channel-get-nicks))
- (uahs (mapcar
- (function
- (lambda (nick)
- (list
- (concat nick "!" (liece-nick-get-user-at-host nick)))))
- nicks))
- ban nick msg)
- (setq ban (liece-minibuffer-completing-read
- (_ "Ban pattern: ") uahs nil nil nil nil
- (concat nick "!" (liece-nick-get-user-at-host nick))))
- (list ban)))
- (liece-send "MODE %s :+b %s"
- (liece-channel-real liece-current-channel) ban))
-
-(defun liece-command-ban-kick (ban nick &optional msg)
- "BAN kick this NICK out with MSG."
- (interactive
- (let* ((completion-ignore-case t)
- (nicks (liece-channel-get-nicks))
- (uahs (mapcar
- (function
- (lambda (nick)
- (list
- (concat nick "!" (liece-nick-get-user-at-host nick)))))
- nicks))
- ban nick msg)
- (setq nick (completing-read (_ "Kick out nickname: ")
- (list-to-alist nicks))
- ban (liece-minibuffer-completing-read
- (_ "Ban pattern: ") uahs nil nil nil nil
- (concat nick "!" (liece-nick-get-user-at-host nick))))
- (if current-prefix-arg
- (setq msg (concat " :" (read-string (_ "Kick Message: "))))
- (setq msg ""))
- (list ban nick msg)))
- (liece-send "MODE %s :+b %s"
- (liece-channel-real liece-current-channel) ban)
- (liece-send "KICK %s %s%s"
- (liece-channel-real liece-current-channel)
- nick (or msg "")))
-
-(defun liece-command-list (&optional channel)
- "List the given CHANNEL and its topics.
-If you enter only Control-U as argument, list the current channel.
-With - as argument, list all channels."
- (interactive
- (if (or current-prefix-arg (null liece-current-channel))
- (if (eq current-prefix-arg '-)
- (list current-prefix-arg))
- (let ((completion-ignore-case t) channel)
- (setq channel (liece-minibuffer-completing-read
- (_ "LIST channel: ")
- liece-channel-alist nil nil nil nil liece-current-channel))
- (unless (string-equal "" channel)
- (list channel)))))
-
- (cond ((not channel)
- (if liece-current-channel
- (liece-send "LIST %s"
- (liece-channel-real liece-current-channel))))
- ((and (eq channel '-)
- (y-or-n-p (_ "Do you really query LIST without argument?")))
- (liece-send "LIST"))
- ((not (string-equal channel ""))
- (liece-send "LIST %s" (liece-channel-real channel))
- )))
-
-(defun liece-command-modec (chnl change)
- "Send a MODE command to this CHNL.
-Argument CHANGE ."
- (interactive
- (let ((completion-ignore-case t)
- (chnl liece-current-channel)
- liece-minibuffer-complete-function prompt)
- (if current-prefix-arg
- (setq chnl
- (liece-minibuffer-completing-read
- (_ "Channel/User: ")
- (append liece-channel-alist liece-nick-alist)
- nil nil nil nil liece-current-channel)))
- (cond
- ((liece-channel-p (liece-channel-real chnl))
- (setq prompt (format
- (_ "Mode for channel %s [%s]: ")
- chnl (or (liece-channel-get-modes chnl) ""))
- liece-minibuffer-complete-function
- (function liece-minibuffer-complete-channel-modes)))
- (t
- (setq prompt (format
- (_ "Mode for user %s [%s]: ")
- chnl (or (liece-nick-get-modes chnl) ""))
- liece-minibuffer-complete-function
- (function liece-minibuffer-complete-user-modes))))
- (list chnl (read-from-minibuffer prompt nil liece-minibuffer-map))))
- (liece-send "MODE %s %s" (liece-channel-real chnl) change))
-
-(defun liece-command-qualify-nicks (mode nicks val)
- (liece-send
- "MODE %s %c%s %s"
- (liece-channel-real liece-current-channel)
- (if val ?+ ?-) (make-string (length nicks) mode)
- (string-join nicks " ")))
-
-(defun liece-command-set-operators (nicks &optional arg)
- (interactive
- (let ((opers (liece-channel-get-operators))
- (completion-ignore-case t)
- nicks)
- (if current-prefix-arg
- (setq nicks (liece-minibuffer-completing-read-multiple
- (_ "Divest operational privilege from: ")
- (list-to-alist opers)))
- (setq nicks (liece-channel-get-nicks)
- nicks (filter-elements nick nicks
- (not (liece-nick-member nick opers)))
- nicks (liece-minibuffer-completing-read-multiple
- (_ "Assign operational privilege to: ")
- (list-to-alist nicks))))
- (list nicks current-prefix-arg)))
- (let (run)
- (unwind-protect
- (dolist (nick nicks)
- (push nick run)
- (when (= (length run) liece-compress-mode-length)
- (liece-command-qualify-nicks ?o run (not arg))
- (setq run nil)))
- (when run
- (liece-command-qualify-nicks ?o run (not arg))))))
-
-(defun liece-command-set-voices (nicks &optional arg)
- (interactive
- (let ((voices (liece-channel-get-voices))
- (completion-ignore-case t)
- nicks)
- (if current-prefix-arg
- (setq nicks (liece-minibuffer-completing-read-multiple
- (_ "Forbid to speak: ") (list-to-alist voices)))
- (setq voices (append voices (liece-channel-get-operators))
- nicks (liece-channel-get-nicks)
- nicks (filter-elements nick nicks
- (not (liece-nick-member nick voices)))
- nicks (liece-minibuffer-completing-read-multiple
- (_ "Allow to speak: ") (list-to-alist nicks))))
- (list nicks current-prefix-arg)))
- (let (run)
- (unwind-protect
- (dolist (nick nicks)
- (push nick run)
- (when (= (length run) liece-compress-mode-length)
- (liece-command-qualify-nicks ?v run (not arg))
- (setq run nil)))
- (when run
- (liece-command-qualify-nicks ?v run (not arg))))))
-
-(defun liece-command-message (address message)
- "Send ADDRESS a private MESSAGE."
- (interactive
- (let ((completion-ignore-case t) address)
- (setq address
- (liece-channel-virtual
- (liece-minibuffer-completing-read
- (_ "Private message to: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
- (list address
- (read-string
- (format
- (_ "Private message to %s: ")
- address)))))
- (if (funcall liece-message-empty-predicate message)
- (progn (liece-message (_ "No text to send")) nil)
- (let ((chnl (liece-channel-real address)))
- (liece-send "PRIVMSG %s :%s" chnl message)
- (if (liece-channel-p chnl)
- (liece-own-channel-message message
- (liece-channel-virtual address))
- (liece-own-private-message message address)))))
-
-(defun liece-command-mta-private (partner)
- "Send a private message (current line) to PARTNER."
- (interactive
- (let ((completion-ignore-case t))
- (setq liece-privmsg-partner
- (liece-channel-virtual
- (liece-minibuffer-completing-read
- (_ "To whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
- (list liece-privmsg-partner)))
- (let ((message (buffer-substring (progn (beginning-of-line) (point))
- (progn (end-of-line) (point)))))
- (if (> (length message) 0)
- (progn
- (liece-command-message liece-privmsg-partner message)
- (liece-next-line 1))
- (liece-message (_ "No text to send")))))
-
-(defun liece-command-names (&optional expr)
- "List the nicknames of the current IRC users on given EXPR.
-With an Control-U as argument, only the current channel is listed.
-With - as argument, list all channels."
- (interactive
- (if (or current-prefix-arg (null liece-current-channel))
- (if (eq current-prefix-arg '-)
- (list current-prefix-arg))
- (let ((completion-ignore-case t) expr)
- (setq expr (liece-minibuffer-completing-read
- (_ "Names on channel: ")
- liece-channel-alist nil nil nil nil liece-current-channel))
- (unless (string-equal "" expr)
- (list expr)))))
- (when (or (and (eq expr '-)
- (y-or-n-p
- (_ "Do you really query NAMES without argument?")))
- (not (or expr
- (if liece-current-channel
- (setq expr (liece-channel-real
- liece-current-channel))))))
- (setq expr ""))
- (when expr
- (liece-send "NAMES %s" expr)))
-
-(defun liece-command-nickname (nick)
- "Set your nickname to NICK."
- (interactive "sEnter your nickname: ")
- (let ((nickname (truncate-string-to-width nick liece-nick-max-length)))
- (if (zerop (length nickname))
- (liece-message (_ "illegal nickname \"%s\"; not changed") nickname)
- (liece-send "NICK %s" nick))))
-
-(defun liece-command-who (&optional expr)
- "Lists tue users that match the given expression EXPR.
-If you enter only Control-U as argument, list the current channel.
-With - as argument, list all users."
- (interactive
- (if (or current-prefix-arg (null liece-current-channel))
- (if (eq current-prefix-arg '-)
- (list current-prefix-arg))
- (let ((completion-ignore-case t) expr)
- (setq expr (completing-read
- (_ "WHO expression: ")
- (append liece-channel-alist liece-nick-alist)))
- (unless (string-equal "" expr)
- (list expr)))))
- (when (or (and (eq expr '-)
- (y-or-n-p
- (_ "Do you really query WHO without argument?")))
- (not (or expr
- (if liece-current-channel
- (setq expr (liece-channel-real
- liece-current-channel))))))
- (setq expr ""))
- (when expr
- (liece-send "WHO %s" expr)
- (setq liece-who-expression expr)))
-
-(defun liece-command-finger (finger-nick-var &optional server)
- "Get information about a specific user FINGER-NICK-VAR.
-If called with optional argument SERVER or any prefix argument,
-query information to the foreign server."
- (interactive
- (let (finger-nick-var (completion-ignore-case t))
- (setq finger-nick-var
- (completing-read (_ "Finger whom: ") liece-nick-alist))
- (list finger-nick-var (and current-prefix-arg finger-nick-var))))
- (if server
- (liece-send "WHOIS %s %s" server finger-nick-var)
- (liece-send "WHOIS %s" finger-nick-var)))
-
-(defun liece-command-topic (topic)
- "Change TOPIC of the current channel."
- (interactive
- (list (read-from-minibuffer
- "Topic: " (cons (or (liece-channel-get-topic) "") 0))))
- (liece-send "TOPIC %s :%s"
- (liece-channel-real liece-current-channel) topic))
-
-(defun liece-command-invite (&optional invite-nick-var invite-channel-var)
- "Invite INVITE-NICK-VAR to INVITE-CHANNEL-VAR."
- (interactive
- (let ((completion-ignore-case t) invite-channel-var invite-nick-var)
- (if current-prefix-arg
- (setq invite-channel-var
- (liece-channel-virtual
- (completing-read
- (_ "Invite channel: ")
- (list-to-alist liece-current-channels)))))
- (setq invite-nick-var
- (completing-read
- (_ "Invite whom: ")
- liece-nick-alist))
- (list invite-nick-var invite-channel-var)))
- (or invite-channel-var
- (setq invite-channel-var liece-current-channel))
- (liece-send "INVITE %s %s"
- invite-nick-var (liece-channel-real invite-channel-var)))
-
-(defun liece-command-away (awaymsg)
- "Mark/unmark yourself as being away.
-Leave message AWAYMSG."
- (interactive "sAway message: ")
- (liece-send "AWAY :%s" awaymsg)
- (setq liece-away-message awaymsg))
-
-(defun liece-command-scroll-down (lines)
- "Scroll LINES down dialogue buffer from command buffer."
- (interactive "P")
- (let ((other-window-scroll-buffer
- (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)))
- (when (liece-get-buffer-window other-window-scroll-buffer)
- (condition-case nil
- (scroll-other-window-down lines)
- (beginning-of-buffer
- (message "Beginning of buffer"))))))
-
-(defun liece-command-scroll-up (lines)
- "Scroll LINES up dialogue buffer from command buffer."
- (interactive "P")
- (let* ((other-window-scroll-buffer
- (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)))
- (when (liece-get-buffer-window other-window-scroll-buffer)
- (condition-case nil
- (scroll-other-window lines)
- (end-of-buffer
- (message "End of buffer"))))))
-
-(defun liece-command-nick-scroll-down (lines)
- "Scroll LINES down nick buffer from command buffer."
- (interactive "P")
- (let ((other-window-scroll-buffer liece-nick-buffer))
- (when (liece-get-buffer-window other-window-scroll-buffer)
- (condition-case nil
- (scroll-other-window-down lines)
- (beginning-of-buffer
- (message "Beginning of buffer"))))))
-
-(defun liece-command-nick-scroll-up (lines)
- "Scroll LINES up nick buffer from command buffer."
- (interactive "P")
- (let* ((other-window-scroll-buffer liece-nick-buffer))
- (when (liece-get-buffer-window other-window-scroll-buffer)
- (condition-case nil
- (scroll-other-window lines)
- (end-of-buffer
- (message "End of buffer"))))))
-
-(defun liece-command-freeze (&optional arg)
- "Prevent automatic scrolling of the dialogue window.
-If prefix argument ARG is non-nil, toggle frozen status."
- (interactive "P")
- (liece-freeze (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)
- (if arg (prefix-numeric-value arg))))
-
-(defun liece-command-own-freeze (&optional arg)
- "Prevent automatic scrolling of the dialogue window.
-The difference from `liece-command-freeze' is that your messages are hidden.
-If prefix argument ARG is non-nil, toggle frozen status."
- (interactive "P")
- (liece-own-freeze (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)
- (if arg (prefix-numeric-value arg))))
-
-(defun liece-command-beep (&optional arg)
- "Toggle the automatic beep notice when the channel message is received."
- (interactive "P")
- (liece-set-beep (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer)
- (if arg (prefix-numeric-value arg))))
-
-(defun liece-command-quit (&optional arg)
- "Quit IRC.
-If prefix argument ARG is non-nil, leave signoff message."
- (interactive "P")
- (when (and (liece-server-opened)
- (y-or-n-p (_ "Quit IRC? ")))
- (message "")
- (let ((quit-string
- (if arg (read-string (_ "Signoff message: "))
- (or liece-signoff-message
- (product-name (product-find 'liece-version))))))
- (liece-close-server quit-string))))
-
-(defun liece-command-generic (message)
- "Enter a generic IRC MESSAGE, which is sent to the server.
-A ? lists the useful generic messages."
- (interactive "sIRC command (? to help): ")
- (if (string-equal message "?")
- (with-output-to-temp-buffer "*IRC Help*"
- (princ "The following generic IRC messages may be of interest to you:
-TOPIC <new topic> set the topic of your channel
-INVITE <nickname> invite another user to join your channel
-LINKS lists the currently reachable IRC servers
-SUMMON <user@host> invites an user not currently in IRC
-USERS <host> lists the users on a host
-AWAY <reason> marks you as not really actively using IRC
- (an empty reason clears it)
-WALL <message> send to everyone on IRC
-NAMES <channel> lists users per channel
-"))
- (liece-send "%s" message)))
-
-(defun liece-command-irc-compatible ()
- "If entered at column 0, allow you to enter a generic IRC message."
- (interactive)
- (if (zerop (current-column))
- (call-interactively (function liece-command-generic))
- (self-insert-command 1)))
-
-(defun liece-command-yank-send (&optional arg)
- "Send message from yank buffer.
-Prefix argument ARG is regarded as distance from yank pointer."
- (interactive)
- (when (y-or-n-p (_ "Really SEND from Yank Buffer?"))
- (save-restriction
- (narrow-to-region (point) (point))
- (insert (car kill-ring-yank-pointer))
- (goto-char (point-min))
- (while (eobp)
- (liece-command-enter-message)
- (set-buffer liece-command-buffer)))))
-
-(defun liece-command-complete ()
- "Complete word before point from userlist."
- (interactive)
- (let ((completion-ignore-case t)
- (alist (if liece-current-channel
- (list-to-alist (liece-channel-get-nicks))
- liece-nick-alist))
- candidate completion all)
- (setq candidate (current-word)
- completion (try-completion candidate alist)
- all (all-completions candidate alist))
- (liece-minibuffer-finalize-completion completion candidate all)))
-
-(defun liece-command-load-vars ()
- "Load configuration from liece-variables-file."
- (interactive)
- (let ((nick liece-real-nickname))
- (unwind-protect
- (liece-read-variables-files)
- (setq liece-real-nickname nick)
- (liece-command-reconfigure-windows))))
-
-(defun liece-command-save-vars ()
- "Save current settings to `liece-variables-file'."
- (interactive)
- (let* ((output-buffer
- (find-file-noselect
- (expand-file-name liece-variables-file)))
- output-marker p)
- (save-excursion
- (set-buffer output-buffer)
- (goto-char (point-min))
- (cond ((re-search-forward "^;; Saved Settings *\n" nil 'move)
- (setq p (match-beginning 0))
- (goto-char p)
- (or (re-search-forward
- "^;; End of Saved Settings *\\(\n\\|\\'\\)" nil t)
- (error
- (concat "can't find END of saved state in "
- liece-variables-file)))
- (delete-region p (match-end 0)))
- (t
- (goto-char (point-max))
- (insert "\n")))
- (setq output-marker (point-marker))
- (let ((print-readably t)
- (print-escape-newlines t)
- (standard-output output-marker))
- (princ ";; Saved Settings\n")
- (dolist (var liece-saved-forms)
- (if (symbolp var)
- (prin1 (list 'setq var
- (let ((val (symbol-value var)))
- (if (memq val '(t nil))
- val
- (list 'quote val)))))
- (setq var (eval var))
- (cond ((eq (car-safe var) 'progn)
- (while (setq var (cdr var))
- (prin1 (car var))
- (princ "\n")
- (if (cdr var) (princ " "))))
- (var
- (prin1 "xx")(prin1 var))))
- (if var (princ "\n")))
- (princ "\n")
- (princ ";; End of Saved Settings\n")))
- (set-marker output-marker nil)
- (save-excursion
- (set-buffer output-buffer)
- (save-buffer)))
- (setq liece-save-variables-are-dirty nil))
-
-(defun liece-command-reconfigure-windows ()
- "Rearrange window splitting."
- (interactive)
- (let ((command-window (liece-get-buffer-window liece-command-buffer))
- (dialogue-window (liece-get-buffer-window liece-dialogue-buffer))
- (obuffer (current-buffer)))
- (if (and command-window dialogue-window)
- (let ((ch (window-height command-window))
- (dh (window-height dialogue-window)))
- (delete-window command-window)
- (pop-to-buffer liece-dialogue-buffer)
- (enlarge-window (+ ch dh (- dh))))
- (pop-to-buffer liece-dialogue-buffer))
- (liece-configure-windows)
- (if liece-one-buffer-mode
- (pop-to-buffer liece-dialogue-buffer)
- (pop-to-buffer obuffer))))
-
-(defun liece-command-end-of-buffer ()
- "Get end of the dialogue buffer."
- (interactive)
- (let (buffer window)
- (setq buffer (if liece-channel-buffer-mode
- liece-channel-buffer
- liece-dialogue-buffer))
- (or (setq window (liece-get-buffer-window buffer))
- (setq window (liece-get-buffer-window liece-dialogue-buffer)
- buffer liece-dialogue-buffer))
- (when window
- (save-selected-window
- (select-window window)
- (goto-char (point-max))))))
-
-(defun liece-command-private-conversation (arg)
- "Toggle between private conversation mode and channel mode.
-User can then join and part to a private conversation as he would
-join or part to a channel.
-
-If there are no private conversations or argument is given user is
-prompted the partner/channel (return as partner/channel means toggle
-mode, the current channel and current chat partner are not altered)
-Argument ARG is prefix argument of toggle status."
- (interactive
- (let ((completion-ignore-case t))
- (list
- (if current-prefix-arg
- ;; prefixed, ask where to continue
- (if (eq liece-command-buffer-mode 'chat)
- (liece-minibuffer-completing-read
- (_ "Return to channel: ")
- (append liece-channel-alist liece-nick-alist)
- nil nil nil nil liece-current-channel)
- (completing-read
- (_ "Start private conversation with: ")
- liece-nick-alist nil nil))
- ;; no prefix, see if going to chat
- (if (eq liece-command-buffer-mode 'channel)
- ;; and if we have chat partner, select that
- (if liece-current-chat-partner
- liece-current-chat-partner
- (completing-read
- (_ "Start private conversation with: ")
- liece-nick-alist )))))))
-
- (liece-toggle-command-buffer-mode)
- (if (and arg (not (string-equal arg "")))
- (liece-command-join arg))
- (liece-set-channel-indicator)
- ;; refresh mode line
- (force-mode-line-update))
-
-(defun liece-command-next-channel ()
- "Select next channel or chat partner, and *DONT* rotate list."
- (interactive)
- (let ((rest (copy-sequence
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels)))
- (chnl (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-current-channel)))
- (liece-switch-to-channel
- (or (cadr (liece-channel-member chnl (delq nil rest)))
- (car (delq nil rest))
- chnl))))
-
-(defun liece-command-previous-channel ()
- "Select previous channel or chat partner, and *DONT* rotate list."
- (interactive)
- (let ((rest
- (reverse
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels)))
- (chnl
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-current-channel)))
- (liece-switch-to-channel
- (or (cadr (liece-channel-member chnl (delq nil rest)))
- (car (delq nil rest))
- chnl))))
-
-(defun liece-command-unread-channel ()
- "Select unread channel or chat partner."
- (interactive)
- (let ((chnl (car liece-channel-unread-list)))
- (if chnl
- (liece-switch-to-channel chnl)
- (liece-message (_ "No unread channel or chat partner.")))))
-
-(defun liece-command-push ()
- "Select next channel or chat partner, and rotate list."
- (interactive)
- (let* ((rest
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels))
- (temp (car (last rest)))
- (len (length rest)))
- (unwind-protect
- (while (< 1 len)
- (setcar (nthcdr (1- len) rest) (nth (- len 2) rest))
- (decf len))
- (when rest
- (setcar rest temp)))
- (liece-channel-change)))
-
-(defun liece-command-pop ()
- "Select previous channel or chat partner, and rotate list."
- (interactive)
- (let* ((rest
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels))
- (temp (car rest))
- (len (length rest)))
- (unwind-protect
- (dotimes (i len)
- (setcar (nthcdr i rest) (nth (1+ i) rest)))
- (when rest
- (setcar (last rest) temp)))
- (liece-channel-change)))
-
-(defvar liece-redisplay-buffer-functions
- '(liece-channel-redisplay-buffer
- liece-nick-redisplay-buffer
- liece-channel-list-redisplay-buffer))
-
-(defun liece-switch-to-channel (chnl)
- "Switch the current channel to CHNL."
- (if (liece-channel-p (liece-channel-real chnl))
- (progn
- (liece-toggle-command-buffer-mode 'channel)
- (setq liece-current-channel chnl)
- (liece-set-channel-indicator))
- (liece-toggle-command-buffer-mode 'chat)
- (setq liece-current-chat-partner chnl)
- (liece-set-channel-indicator))
- (save-excursion
- (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
-
-(defun liece-switch-to-channel-no (num)
- "Switch the current channel to NUM."
- (let* ((mode liece-command-buffer-mode)
- (chnls (if (eq mode 'chat)
- liece-current-chat-partners
- liece-current-channels)))
- (if (and (integerp num)
- (stringp (nth num chnls)))
- (let ((chnl (nth num chnls)))
- (if (eq mode 'chat)
- (progn
- (liece-toggle-command-buffer-mode 'chat)
- (setq liece-current-chat-partner chnl)
- (liece-set-channel-indicator))
- (liece-toggle-command-buffer-mode 'channel)
- (setq liece-current-channel chnl)
- (liece-set-channel-indicator))
- (save-excursion
- (run-hook-with-args 'liece-redisplay-buffer-functions chnl)))
- (message "Invalid channel!"))))
-
-(defun liece-command-ping ()
- "Send PING to server."
- (interactive)
- (if (stringp liece-server-name)
- (liece-send "PING %s" liece-server-name)))
-
-(defun liece-command-ison (nicks)
- "IsON users NICKS."
- (interactive
- (let (nicks (completion-ignore-case t))
- (setq nicks (liece-minibuffer-completing-read-multiple
- "IsON" liece-nick-alist))
- (list nicks)))
- (liece-send "ISON :%s" (mapconcat #'identity nicks " ")))
-
-(defun liece-command-activate-friends (nicks)
- "Register NICKS to the frinends list."
- (interactive
- (let (nicks (completion-ignore-case t))
- (setq nicks
- (liece-minibuffer-completing-read-multiple
- (_ "Friend")
- (filter-elements nick liece-nick-alist
- (not (string-list-member-ignore-case
- (car nick) liece-friends)))))
- (list nicks)))
- (setq liece-friends (append nicks liece-friends)))
-
-(defun liece-command-deactivate-friends ()
- "Clear current friends list."
- (interactive)
- (setq liece-friends nil))
-
-(defun liece-command-display-friends ()
- "Display status of the friends."
- (interactive)
- (with-output-to-temp-buffer " *IRC Friends*"
- (set-buffer standard-output)
- (insert "Friends status: \n\n")
- (dolist (friend liece-friends)
- (if (string-list-member-ignore-case friend liece-friends-last)
- (insert "+ " friend "\n")
- (insert "- " friend "\n")))))
-
-(defun liece-command-show-last-kill ()
- "Dig last kill from KILL and show it."
- (interactive)
- (liece-insert-info
- (append liece-D-buffer liece-O-buffer)
- (save-excursion
- (set-buffer liece-KILLS-buffer)
- (goto-char (point-max))
- (forward-line -1)
- (concat (buffer-substring (point) (point-max)) "\n"))))
-
-(defun liece-command-toggle-private ()
- "Toggle private mode / channel mode."
- (interactive)
- (case (prog1 liece-command-buffer-mode
- (liece-toggle-command-buffer-mode))
- (chat
- (if liece-current-channel
- (liece-switch-to-channel liece-current-channel))
- (setq liece-command-buffer-mode-indicator "Channels"))
- (channel
- (if liece-current-chat-partner
- (liece-switch-to-channel liece-current-chat-partner))
- (setq liece-command-buffer-mode-indicator "Partners")))
- (liece-channel-change))
-
-(defun liece-command-tag-region (start end)
- "Move current region between START and END to `kill-ring'."
- (interactive
- (if (region-active-p)
- (list (region-beginning)(region-end))
- (list (line-beginning-position)(line-end-position))))
- (static-if (fboundp 'extent-property)
- (kill-ring-save start end)
- (let ((start (set-marker (make-marker) start))
- (end (set-marker (make-marker) end))
- (inhibit-read-only t)
- buffer-read-only
- buffer-undo-list)
- (liece-remove-properties-region start end)
- (kill-ring-save start end)
- (push nil buffer-undo-list)
- (undo))))
-
-(provide 'liece-commands)
-
-;;; liece-commands.el ends here
+++ /dev/null
-;;; liece-compat.el --- Provide compatibility for various emacsen.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-12-19
-;; Keywords: IRC, liece, APEL
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(require 'pcustom)
-(require 'wid-edit)
-
-(defalias 'liece-widget-convert-button 'widget-convert-button)
-(defalias 'liece-widget-button-click 'widget-button-click)
-
-(defun-maybe region-active-p ()
- "Return non-nil if the region is active.
-If `zmacs-regions' is true, this is equivalent to `region-exists-p'.
-Otherwise, this function always returns false.
-\[XEmacs emulating function]"
- (static-if (and (boundp 'transient-mark-mode) (boundp 'mark-active))
- (and transient-mark-mode mark-active)))
-
-(defun liece-map-overlays (function)
- "Map FUNCTION over the extents which overlap the current buffer."
- (let* ((overlayss (overlay-lists))
- (buffer-read-only nil)
- (overlays (delq nil (nconc (car overlayss) (cdr overlayss)))))
- (dolist (overlay overlays)
- (funcall function overlay))))
-
-(defun liece-kill-all-overlays ()
- "Delete all overlays in the current buffer."
- (liece-map-overlays #'delete-overlay))
-
-(defmacro liece-get-buffer-window (buffer)
- "Traverse all frames and return a window currently displaying BUFFER."
- `(get-buffer-window ,buffer t))
-
-(static-if (fboundp 'window-displayed-height)
- (defalias 'liece-window-height 'window-displayed-height)
- (defalias 'liece-window-height 'window-height))
-
-(static-if (fboundp 'string-to-list)
- (defalias 'liece-string-to-list 'string-to-list)
- ;; Rely on `string-to-char-list' emulation is provided in poem.
- (defalias 'liece-string-to-list 'string-to-char-list))
-
-(defalias 'liece-mode-line-buffer-identification 'identity)
-
-(defun liece-suppress-mode-line-format ()
- "Remove unnecessary information from `mode-line-format'."
- (let ((value (rassq 'mode-line-modified mode-line-format)))
- (if value
- (setq mode-line-format (delq value (copy-sequence mode-line-format)))
- mode-line-format)))
-
-(defun liece-locate-data-directory (name &optional dir-list)
- "Locate a directory in a search path DIR-LIST (a list of directories)."
- (let ((dir-list
- (or dir-list
- (cons data-directory
- (mapcar (lambda (path) (concat path "etc/"))
- load-path))))
- dir)
- (while dir-list
- (if (and (car dir-list)
- (file-directory-p
- (setq dir (concat
- (file-name-directory
- (directory-file-name (car dir-list)))
- name "/"))))
- (setq dir-list nil)
- (setq dir-list (cdr dir-list))))
- dir))
-
-(defvar-maybe completion-display-completion-list-function
- 'display-completion-list)
-
-(defalias-maybe 'easy-menu-add-item 'ignore)
-
-;; from XEmacs's minibuf.el
-(defun-maybe temp-minibuffer-message (m)
- (let ((savemax (point-max)))
- (save-excursion
- (goto-char (point-max))
- (message nil)
- (insert m))
- (let ((inhibit-quit t))
- (sit-for 2)
- (delete-region savemax (point-max)))))
-
-(defvar liece-read-passwd nil)
-(defun liece-read-passwd (prompt)
- (if (not liece-read-passwd)
- (if (functionp 'read-passwd)
- (setq liece-read-passwd 'read-passwd)
- (if (load "passwd" t)
- (setq liece-read-passwd 'read-passwd)
- (autoload 'ange-ftp-read-passwd "ange-ftp")
- (setq liece-read-passwd 'ange-ftp-read-passwd))))
- (funcall liece-read-passwd prompt))
-
-;; XEmacs.
-(defun-maybe replace-in-string (str regexp newtext &optional literal)
- "Replace all matches in STR for REGEXP with NEWTEXT string,
- and returns the new string.
-Optional LITERAL non-nil means do a literal replacement.
-Otherwise treat `\\' in NEWTEXT as special:
- `\\&' in NEWTEXT means substitute original matched text.
- `\\N' means substitute what matched the Nth `\\(...\\)'.
- If Nth parens didn't match, substitute nothing.
- `\\\\' means insert one `\\'.
- `\\u' means upcase the next character.
- `\\l' means downcase the next character.
- `\\U' means begin upcasing all following characters.
- `\\L' means begin downcasing all following characters.
- `\\E' means terminate the effect of any `\\U' or `\\L'."
- (if (> (length str) 50)
- (with-temp-buffer
- (insert str)
- (goto-char 1)
- (while (re-search-forward regexp nil t)
- (replace-match newtext t literal))
- (buffer-string))
- (let ((start 0) newstr)
- (while (string-match regexp str start)
- (setq newstr (replace-match newtext t literal str)
- start (+ (match-end 0) (- (length newstr) (length str)))
- str newstr))
- str)))
-
-(provide 'liece-compat)
-
-;;; liece-compat.el ends here
+++ /dev/null
-;;; liece-config.el --- Installation settings.
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-04-12
-;; Revised: 1999-04-12
-;; Keywords: IRC, liece, APEL
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(setq load-path (cons (expand-file-name "../apel") load-path))
-
-(defvar default-load-path load-path)
-
-(and (expand-file-name "../../site-lisp/apel" data-directory)
- (setq load-path (cons
- (expand-file-name "../../site-lisp/apel" data-directory)
- load-path )))
-
-(when (and (boundp 'LISPDIR) LISPDIR)
- (or (member LISPDIR default-load-path)
- (setq default-load-path (cons LISPDIR default-load-path)) )
- (or (member LISPDIR load-path) (setq load-path (cons LISPDIR load-path)))
- (or (member (expand-file-name "apel" LISPDIR) load-path)
- (setq load-path (cons (expand-file-name "apel" LISPDIR) load-path))))
-
-(setq load-path (cons (expand-file-name ".") load-path))
-
-(defvar VERSION_SPECIFIC_LISPDIR nil)
-(if (and VERSION_SPECIFIC_LISPDIR
- (null (member VERSION_SPECIFIC_LISPDIR load-path)) )
- (setq load-path (cons VERSION_SPECIFIC_LISPDIR load-path)) )
-
-(require 'install)
-
-
-;;; @ Please specify prefix of install directory.
-;;;
-
-;; Please specify install path prefix.
-;; If it is omitted, shared directory (maybe /usr/local is used).
-(defvar PREFIX install-prefix)
-;;(setq PREFIX "~/")
-
-\f
-
-;;; @ optional settings
-;;;
-
-(defvar VERSION_SPECIFIC_LISPDIR
- (install-detect-elisp-directory PREFIX nil 'version-specific))
-
-;; It is generated by automatically. Please set variable `PREFIX'.
-;; If you don't like default directory tree, please set it.
-(defvar LISPDIR (install-detect-elisp-directory PREFIX))
-;; (setq install-default-elisp-directory "~/lib/emacs/lisp")
-
-(defvar PACKAGEDIR
- (if (boundp 'early-packages)
- (let ((dirs (append (if early-package-load-path
- early-packages)
- (if late-package-load-path
- late-packages)
- (if last-package-load-path
- last-packages)))
- dir)
- (while (and dirs (not (file-exists-p (setq dir (car dirs)))))
- (setq dirs (cdr dirs)) )
- dir )))
-
-(defconst liece-config-info-file-regexp
- (concat "^liece-faq\\.info\\(-[0-9]+\\)?$"))
-
-;;; liece-config.el ends here
+++ /dev/null
-;;; liece-ctcp.el --- CTCP handlers and commands.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece, CTCP
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'liece-inlines))
-(eval-when-compile (require 'liece-misc))
-
-(require 'liece-handler)
-
-;; (require 'pccl)
-
-;; (if-broken ccl-usable
-;; (require 'liece-q-el)
-;; (require 'liece-q-ccl))
-(require 'liece-q-el)
-
-(require 'liece-x-face)
-
-(autoload 'liece-ctcp-dcc-message "liece-dcc")
-
-(eval-and-compile
- (defconst liece-ctcp-supported-symbols
- '(version userinfo clientinfo ping time x-face comment help)))
-
-(defun liece-ctcp-make-menu-command-wrapper (symbol)
- (fset (intern (format "liece-menu-callback-ctcp-%s" symbol))
- `(lambda ()
- (interactive)
- (dolist (nick liece-nick-region-nicks)
- (funcall (symbol-function
- (intern (format "liece-command-ctcp-%s" ',symbol)))
- nick)))))
-
-(dolist (symbol liece-ctcp-supported-symbols)
- (liece-ctcp-make-menu-command-wrapper symbol))
-
-(defvar liece-ctcp-message
- (eval-when-compile
- (concat liece-client-prefix "%s(%s) = %s"))
- "Message in which info of other clients is displayed.")
-
-(defvar liece-ctcp-buffer (append liece-D-buffer liece-O-buffer))
-
-(defvar liece-ctcp-ping-time '(0 0 0))
-
-(defvar liece-ctcp-last-command nil
- "The last command executed.")
-
-(defvar liece-ctcp-last-nick nil
- "The last nick being queried.")
-
-(defconst liece-ctcp-error-message "Unrecognized command: '%s'"
- "Error message given to anyone asking wrong CLIENT data.")
-
-(defun liece-ctcp-last-nick-maybe-change (prefix rest)
- (if (equal prefix liece-ctcp-last-nick)
- (setq liece-ctcp-last-nick rest))
- nil)
-
-(defun liece-ctcp-last-nick-maybe-reset (prefix rest)
- (if (equal prefix liece-ctcp-last-nick)
- (setq liece-ctcp-last-nick nil)))
-
-(add-hook 'liece-nick-hook 'liece-ctcp-last-nick-maybe-change t)
-(add-hook 'liece-quit-hook 'liece-ctcp-last-nick-maybe-reset)
-
-(defcustom liece-ctcp-file-save-directory liece-directory
- "Directory to save received files."
- :type 'directory
- :group 'liece-ctcp)
-
-(liece-handler-define-backend "ctcp-message")
-
-(defmacro liece-register-ctcp-message-handler (name)
- `(liece-handler-define-function
- ,name '(from chnl data "ctcp-message")
- ',(intern (format "liece-ctcp-%s-message" name))))
-
-(liece-register-ctcp-message-handler "version")
-(liece-register-ctcp-message-handler "userinfo")
-(liece-register-ctcp-message-handler "clientinfo")
-(liece-register-ctcp-message-handler "ping")
-(liece-register-ctcp-message-handler "time")
-(liece-register-ctcp-message-handler "file")
-(liece-register-ctcp-message-handler "x-face")
-(liece-register-ctcp-message-handler "comment")
-(liece-register-ctcp-message-handler "help")
-(liece-register-ctcp-message-handler "action")
-(liece-register-ctcp-message-handler "dcc")
-(liece-register-ctcp-message-handler "errmsg")
-
-(defun* liece-ctcp-message (from chnl rest)
- (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
- (return-from liece-ctcp-message))
- (let (hook after-hook data message)
- (setq data (match-string 2 rest)
- rest (concat
- (match-string 1 rest)
- (substring rest (match-end 0))))
- (if (string-match "^\\([^ ]*\\) *:?" data)
- (setq message (downcase (match-string 1 data))
- data (substring data (match-end 0)))
- (setq message "errmsg"
- data (_ "Couldn't figure out what was said.")))
- (setq hook
- (intern-soft
- (concat "liece-ctcp-" message "-hook"))
- after-hook
- (intern-soft
- (concat "liece-after-ctcp-" message "-hook")))
- (if (run-hook-with-args-until-success hook from chnl data)
- (return-from liece-ctcp-message rest))
- (let ((func
- (liece-handler-find-function
- message '(from chnl data) "ctcp-message")))
- (if func
- (funcall func from chnl data)
- (liece-ctcp-messages message from chnl data))
- (run-hook-with-args after-hook from chnl data))
- rest))
-
-(defun liece-ctcp-messages (message from chnl rest)
- (liece-send "NOTICE %s :\001ERRMSG %s :%s\001"
- from (upcase message)
- (format liece-ctcp-error-message
- (upcase message)))
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert (upcase message) from chnl rest))
-
-(defun liece-ctcp-action-message (from chnl rest)
- "CTCP ACTION handler."
- (let ((liece-message-target (liece-channel-virtual chnl))
- (liece-message-speaker from)
- (liece-message-type 'action))
- (liece-display-message rest)))
-
-(defun liece-ctcp-insert (message from &optional chnl rest)
- (if (or (null chnl)
- (liece-nick-equal chnl liece-real-nickname))
- (liece-message "%s query from %s." message from)
- (liece-message "%s query from %s (%s)." message from chnl)
- (liece-insert-client
- (liece-pick-buffer chnl)
- (format "%s query from %s%s\n"
- message from (if rest (concat ":" rest) "")))))
-
-(defun liece-ctcp-version-message (from chnl rest)
- "CTCP VERSION handler."
- (liece-send "NOTICE %s :\001VERSION %s :\001"
- from (liece-version))
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "VERSION" from chnl rest))
-
-(defun liece-ctcp-userinfo-message (from chnl rest)
- "CTCP USERINFO handler."
- (liece-send "NOTICE %s :\001USERINFO %s\001"
- from liece-ctcp-userinfo)
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "USERINFO" from chnl))
-
-(defun liece-ctcp-clientinfo-message (from chnl rest)
- "CTCP CLIENTINFO handler."
- (liece-send "NOTICE %s :\001CLIENTINFO %s\001"
- from
- (eval-when-compile
- (mapconcat
- (lambda (symbol) (upcase (symbol-name symbol)))
- liece-ctcp-supported-symbols " ")))
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "CLIENTINFO" from chnl))
-
-(defvar liece-ctcp-help-message
- "This is a help message for CTCP requests.
-\"VERSION\" gives version of this client.
-\"USERINFO\" gives user supplied information if any.
-\"CLIENTINFO\" gives commands this client knows.
-\"PING\" returns the arguments it receives.
-\"TIME\" tells you the time on the user's host.
-\"FILE\" send a small file via IRC messages.
-\"X-FACE\" gives you user supplied X-Face.
-\"COMMENT\" returns string sent by other person.
-\"HELP\" gives this help message"
- "Help message for CTCP requests.")
-
-(defun liece-ctcp-help-message (from chnl rest)
- "CTCP HELP handler."
- (liece-send
- "NOTICE %s :\001HELP %s\001"
- from (liece-quote-encode-string liece-ctcp-help-message))
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "HELP" from chnl))
-
-(defun liece-ctcp-comment-message (from chnl rest)
- "CTCP COMMENT handler."
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "COMMENT" from chnl))
-
-(defun liece-ctcp-ping-message (from chnl rest)
- "CTCP PING handler."
- (liece-send "NOTICE %s :\001PING %s\001" from rest)
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "PING" from chnl))
-
-(defun liece-ctcp-time-message (from chnl rest)
- "CTCP TIME handler."
- (liece-send "NOTICE %s :\001TIME %s\001"
- from (funcall liece-format-time-function
- (current-time)))
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "TIME" from chnl))
-
-(defun liece-ctcp-x-face-message (from chnl rest)
- "CTCP X-FACE handler."
- (liece-send "NOTICE %s :\001X-FACE %s\001"
- from liece-ctcp-x-face)
- (setq chnl (liece-channel-virtual chnl))
- (liece-ctcp-insert "X-FACE" from chnl))
-
-(liece-handler-define-backend "ctcp-notice")
-
-(defmacro liece-register-ctcp-notice-handler (name)
- `(liece-handler-define-function
- ,name '(prefix rest "ctcp-notice")
- ',(intern (format "liece-ctcp-%s-notice" name))))
-
-(liece-register-ctcp-notice-handler "version")
-(liece-register-ctcp-notice-handler "userinfo")
-(liece-register-ctcp-notice-handler "clientinfo")
-(liece-register-ctcp-notice-handler "ping")
-(liece-register-ctcp-notice-handler "time")
-(liece-register-ctcp-notice-handler "file")
-(liece-register-ctcp-notice-handler "x-face")
-(liece-register-ctcp-notice-handler "comment")
-(liece-register-ctcp-notice-handler "help")
-(liece-register-ctcp-notice-handler "dcc")
-(liece-register-ctcp-notice-handler "errmsg")
-
-(defun* liece-ctcp-notice (prefix rest)
- (or (string-match "^\\([^\001]*\\)\001\\([^\001]*\\)\001" rest)
- (return-from liece-ctcp-notice))
- (let (hook after-hook data message)
- (setq data (match-string 2 rest)
- rest (concat
- (match-string 1 rest)
- (substring rest (match-end 0))))
- (if (string-match "^\\([^ ]*\\) *:?" data)
- (setq message (downcase (match-string 1 data))
- data (substring data (match-end 0)))
- (setq message "errmsg"
- data (_ "Couldn't figure out what was said.")))
- (setq hook
- (intern-soft
- (concat "liece-ctcp-" message "-notice-hook"))
- after-hook
- (intern-soft
- (concat "liece-after-ctcp-" message "-notice-hook")))
- (if (run-hook-with-args-until-success hook prefix data)
- (return-from liece-ctcp-notice rest))
- (let ((func
- (liece-handler-find-function
- message '(prefix data) "ctcp-notice")))
- (if func
- (funcall func prefix data)
- (liece-ctcp-notices message prefix data)))
- (run-hook-with-args after-hook prefix data)
- rest))
-
-(defun liece-ctcp-notices (message prefix rest)
- (liece-message
- (_ "Unknown ctcp notice \":%s %s %s\"")
- prefix (upcase message) rest))
-
-(liece-handler-define-backend "ctcp-file")
-
-(defmacro liece-register-file-handler (name)
- `(liece-handler-define-function
- ,name '(prefix name data "ctcp-file")
- ',(intern (format "liece-file-%s" name))))
-
-(liece-register-file-handler "start")
-(liece-register-file-handler "cont")
-(liece-register-file-handler "end")
-
-(defun* liece-ctcp-file-notice (prefix rest)
- (when liece-file-accept
- (multiple-value-bind (message name data)
- (liece-split-line rest)
- (setq message (downcase message))
- (let ((hook
- (intern-soft
- (concat "liece-file-" message "-hook")))
- (after-hook
- (intern-soft
- (concat "liece-after-file-" message "-hook")))
- func)
- (if (run-hook-with-args-until-success hook prefix name)
- (return-from liece-ctcp-file-notice))
- (setq func (liece-handler-find-function
- message '(prefix name data) 'ctcp-file))
- (if func
- (funcall func prefix name data)
- (liece-file-notices message prefix name data))
- (run-hook-with-args after-hook prefix name)))))
-
-(defun liece-file-notices (message prefix name data)
- (liece-message
- (_ "Unknown FILE message \":%s %s %s %s\"")
- prefix (upcase message) name data))
-
-(defun liece-file-start (prefix name data)
- "CTCP FILE start handler."
- (save-excursion
- (set-buffer
- (liece-get-buffer-create
- (format " *ctcp-file:%s*" name)))
- (buffer-disable-undo)
- (set-buffer-multibyte nil)
- (erase-buffer)
- (insert data)))
-
-(defun liece-file-cont (prefix name data)
- "CTCP FILE cont handler."
- (save-excursion
- (set-buffer
- (liece-get-buffer-create
- (format " *ctcp-file:%s*" name)))
- (goto-char (point-max))
- (insert data)))
-
-(defun liece-file-end (prefix name data)
- "CTCP FILE cont handler."
- (save-excursion
- (set-buffer
- (liece-get-buffer-create
- (format " *ctcp-file:%s*" name)))
- (goto-char (point-max))
- (insert data)
- (liece-quote-decode-region (point-min)(point-max))
- (goto-char (point-min))
- (when (or (null liece-file-confirm-save)
- (y-or-n-p "Save file? "))
- (or (file-directory-p liece-ctcp-file-save-directory)
- (make-directory liece-ctcp-file-save-directory))
- (write-region-as-binary
- (point-min)(point-max)
- (expand-file-name
- (file-name-nondirectory
- (concat name "-" prefix))
- liece-ctcp-file-save-directory))
- (kill-buffer (current-buffer)))))
-
-(defun liece-ctcp-version-insert (buffer prefix name
- &optional version environment)
- (or (listp buffer)
- (setq buffer (list buffer)))
- (liece-insert buffer
- (concat (format liece-ctcp-message
- "VERSION" prefix "")
- name "\n"))
- (when version
- (liece-insert buffer
- (concat (format liece-ctcp-message
- "VERSION" prefix "")
- "\t" version
- (if environment
- (concat " " environment))
- "\n"))))
-
-(defun liece-ctcp-version-notice (prefix rest)
- "CTCP VERSION reply handler."
- (if (null rest)
- (liece-message (_ "Empty CLIENT version notice from \"%s\".") prefix)
- (cond
- ((string-match "^\\([^:]*\\):\\([^:]+\\):?\\([^:]*\\)" rest)
- (liece-ctcp-version-insert liece-ctcp-buffer
- prefix (match-string 1 rest)
- (match-string 2 rest)
- (match-string 3 rest)))
- ((string-match "^\\([^:]*\\):\\(.*\\)" rest)
- (liece-ctcp-version-insert liece-ctcp-buffer
- prefix (match-string 1 rest)))
- (t
- (liece-ctcp-version-insert liece-ctcp-buffer prefix rest)))))
-
-(defun liece-ctcp-clientinfo-notice (prefix rest)
- "CTCP CLIENTINFO reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "CLIENTINFO" prefix rest)))
-
-(defun liece-ctcp-userinfo-notice (prefix rest)
- "CTCP USERINFO reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "USERINFO" prefix rest)))
-
-(defun liece-ctcp-help-notice (prefix rest)
- "CTCP HELP reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "HELP" prefix rest)))
-
-(defun liece-ctcp-x-face-notice (prefix rest)
- "CTCP X-FACE reply handler."
- (let ((buffer liece-ctcp-buffer))
- (liece-insert buffer
- (format liece-ctcp-message
- "X-FACE" prefix ""))
- (if (and liece-use-x-face
- (string-match "[^ \t]" rest))
- (liece-x-face-insert
- buffer (replace-in-string rest "[ \t\r\n]+" "") prefix)
- (liece-insert buffer rest))
- (let (liece-display-time)
- (liece-insert buffer "\n"))))
-
-(defun liece-ctcp-errmsg-notice (prefix rest)
- "CTCP ERRMSG reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "ERRMSG" prefix rest)))
-
-(defun liece-ctcp-comment-notice (from rest)
- "CTCP COMMENT reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "COMMENT" from rest))
- (liece-message "COMMENT query from %s." from))
-
-(defmacro liece-ctcp-prepare-ping-seconds (timenow)
- `(format (_ "%d sec")
- (+ (* 65536 (- (car ,timenow) (car liece-ctcp-ping-time)))
- (- (cadr ,timenow) (cadr liece-ctcp-ping-time)))))
-
-(defun liece-ctcp-ping-notice (from rest)
- "CTCP PING reply handler."
- (let ((timenow (current-time)))
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "PING" from
- (liece-ctcp-prepare-ping-seconds timenow)))))
-
-(defun liece-ctcp-time-notice (from rest)
- "CTCP TIME reply handler."
- (liece-insert liece-ctcp-buffer
- (format (concat liece-ctcp-message "\n")
- "TIME" from rest)))
-
-(defmacro liece-complete-client ()
- '(let ((completion-ignore-case t) (nick liece-ctcp-last-nick))
- (liece-minibuffer-completing-read
- (_ "Whose client: ") liece-nick-alist nil nil nil nil
- (if nick (liece-channel-virtual nick)))))
-
-(defun liece-minibuffer-complete-client-query ()
- (let* ((alist
- (eval-when-compile
- (list-to-alist
- (mapcar
- (lambda (symbol) (downcase (symbol-name symbol)))
- liece-ctcp-supported-symbols))))
- (candidate (liece-minibuffer-prepare-candidate))
- (completion (try-completion candidate alist))
- (all (all-completions candidate alist)))
- (liece-minibuffer-finalize-completion completion candidate all)))
-
-(defmacro liece-complete-query ()
- '(let ((completion-ignore-case t)
- (liece-minibuffer-complete-function
- (function liece-minibuffer-complete-client-query)))
- (read-from-minibuffer
- (_ "Which query: ") liece-ctcp-last-command
- liece-minibuffer-map)))
-
-(defun liece-ctcp-make-command-wrapper (symbol)
- (fset (intern (format "liece-command-ctcp-%s" symbol))
- `(lambda (client)
- (interactive (list (liece-complete-client)))
- (setq client (liece-channel-real client)
- liece-ctcp-last-nick client
- ,@(if (eq symbol 'ping)
- '(liece-ctcp-ping-time
- (current-time))))
- (liece-send "PRIVMSG %s :\001%s\001"
- client (upcase (symbol-name ',symbol))))))
-
-(dolist (symbol liece-ctcp-supported-symbols)
- (liece-ctcp-make-command-wrapper symbol))
-
-(defun liece-command-ctcp-action (&optional arg)
- "Send CTCP action."
- (interactive
- (if current-prefix-arg
- (list current-prefix-arg)))
- (let ((completion-ignore-case t)
- (liece-message-type 'action)
- message)
- (if arg
- (setq liece-privmsg-partner
- (liece-channel-virtual
- (liece-minibuffer-completing-read
- (_ "To whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner))))
- (beginning-of-line)
- (setq message (buffer-substring (point)(progn (end-of-line)(point))))
- (if (string= message "")
- (setq message (read-string "Action: "))
- (liece-next-line 1))
- (liece-send "PRIVMSG %s :\001ACTION %s\001"
- (if arg
- liece-privmsg-partner
- (liece-channel-real liece-current-channel))
- message)
- (if arg
- (liece-own-private-message message)
- (liece-own-channel-message message))))
-
-(define-obsolete-function-alias 'liece-command-send-action
- 'liece-command-ctcp-action)
-
-(defun liece-command-ctcp-generic (nick command)
- "Ask about someones client clientinfo."
- (interactive (list (liece-complete-client) (liece-complete-query)))
- (setq nick (liece-channel-real nick)
- liece-ctcp-last-nick nick
- liece-ctcp-last-command command)
- (if (string-equal-ignore-case liece-ctcp-last-command "ping")
- (setq liece-ctcp-ping-time (current-time)))
- (liece-send "PRIVMSG %s :\001%s\001" nick command))
-
-(defun liece-command-ctcp-userinfo-from-minibuffer (info)
- "Ask about someones client clientinfo."
- (interactive
- (list (read-from-minibuffer "New userinfo: " liece-ctcp-userinfo)))
- (setq liece-ctcp-userinfo info))
-
-(defun liece-command-ctcp-x-face-from-xbm-file (file)
- (interactive "fXBM File: ")
- (let (data)
- (and (file-exists-p file) (file-readable-p file)
- (setq data (liece-x-face-encode file))
- (setq liece-ctcp-x-face
- (replace-in-string (cadr (nth 3 data)) "[ \t\n]" "")))))
-
-(defun liece-command-send-file (file to)
- "Send a file to given user."
- (interactive "fFile name: \nsTo whom: ")
- (save-excursion
- (set-buffer (liece-get-buffer-create (format " *ctcp-file:%s*" file)))
- (buffer-disable-undo)
- (set-buffer-multibyte nil)
- (erase-buffer)
- (insert-file-contents-as-binary file)
- (liece-quote-encode-region (point-min)(point-max))
- (goto-char (point-min))
- (let ((bound (min (point-max) (+ 80 (point))))
- (liece-mime-charset-for-write 'binary))
- (liece-send
- "NOTICE %s :\001FILE START %s :%s\001"
- to file (buffer-substring (point) bound))
- (goto-char bound)
- (while (not (eobp))
- (if (= 1 (mod (point) 800))
- (sit-for 1))
- (setq bound (min (point-max) (+ 80 (point))))
- (liece-send "NOTICE %s :\001FILE CONT %s :%s\001"
- to file (buffer-substring (point) bound))
- (goto-char bound)))
- (liece-send "NOTICE %s :\001FILE END %s : \001" to file)
- (kill-buffer (current-buffer))))
-
-(provide 'liece-ctcp)
-
-;;; liece-ctcp.el ends here
+++ /dev/null
-;;; liece-dcc.el --- DCC handlers and commands.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece, DCC
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-intl)
- (require 'liece-inlines)
- (require 'liece-channel)
- (require 'liece-misc))
-
-(eval-when-compile (require 'queue-m))
-
-(require 'liece-coding)
-(require 'liece-misc)
-(require 'liece-minibuf)
-
-(defvar liece-dcc-requests (queue-create))
-(defvar liece-dcc-receive-direct t)
-(defvar liece-dcc-process-alist nil)
-
-(defconst liece-dcc-acceptable-messages '("SEND" "CHAT"))
-
-(defstruct liece-dcc-object type from host port file size)
-
-(defun liece-dcc-start-process (args)
- (let ((program
- (or (car-safe liece-dcc-program)
- liece-dcc-program)))
- (apply #'start-process " *DCC*" nil program args)))
-
-(defun liece-dcc-enqueue-request (type &rest args)
- (let ((request (apply #'make-liece-dcc-object :type type args)))
- (inline (queue-enqueue liece-dcc-requests request))))
-
-(defun liece-dcc-dequeue-request (&optional type)
- (when (or (not type)
- (eq (liece-dcc-object-type
- (queue-first liece-dcc-requests))
- type))
- (inline (queue-dequeue liece-dcc-requests))))
-
-(defmacro liece-dcc-add-to-process-alist (process type &rest args)
- `(push (cons (process-name ,process)
- (make-liece-dcc-object :type ,type ,@args))
- liece-dcc-process-alist))
-
-(defmacro liece-dcc-get-process-object (process)
- `(cdr (assoc (process-name ,process) liece-dcc-process-alist)))
-
-(defmacro liece-dcc-message (&rest msg)
- `(message "DCC %s" (format ,@msg)))
-
-(defun* liece-ctcp-dcc-message (from chnl rest)
- (cond
- ((string-match "^SEND +" rest)
- (multiple-value-bind (filename host port size)
- (split-string (substring rest (match-end 0)))
- (setq filename (file-name-nondirectory filename))
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (format (_ "SEND request from %s: %s (%s bytes)\n")
- from filename size))
- (liece-dcc-enqueue-request
- 'send :from from :host host :port port :file filename :size size)
- (when liece-dcc-receive-direct
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (format (_ "SEND applied autoreceive: %s (%s bytes)\n")
- filename size))
- (liece-command-dcc-receive))))
- ((string-match "^CHAT [^ ]+ +" rest)
- (multiple-value-bind (host port)
- (split-string (substring rest (match-end 0)))
- (liece-dcc-enqueue-request 'chat :from from :host host :port port)
- (liece-insert-dcc
- (append liece-O-buffer liece-D-buffer)
- (concat "CHAT request from " from "\n"))))))
-
-(defun liece-command-dcc-send (filename towhom)
- "Send file to user."
- (interactive
- (list (expand-file-name
- (read-file-name
- (_ "File to send: ")
- default-directory nil))
- (liece-minibuffer-completing-read
- (_ "To whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
-
- (setq liece-privmsg-partner towhom)
- (let ((process
- (liece-dcc-start-process
- (list "send" (int-to-string liece-dcc-port) filename))))
- (set-process-filter process #'liece-dcc-send-filter)
- (set-process-sentinel process #'liece-dcc-sentinel))
- (or (zerop liece-dcc-port)
- (incf liece-dcc-port)))
-
-(defun liece-dcc-sentinel (process output)
- (let* ((object (liece-dcc-get-process-object process))
- (type (liece-dcc-object-type object)))
- (if (null object)
- (delete-process process)
- (if (string-match "^finished" output)
- (cond
- ((eq type 'send)
- (liece-dcc-message (_ "Sent file to %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'receive)
- (liece-dcc-message (_ "Received file from %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'chat)
- (liece-dcc-message (_ "Chat connection with %s finished")
- (liece-dcc-object-from object))))
- (liece-dcc-message
- (_ "%s error (%s %s %s) is %s\n")
- (capitalize (downcase (prin1-to-string
- (liece-dcc-object-type object))))
- (or (liece-dcc-object-file object) "")
- (cond ((eq type 'send) "to")
- ((eq type 'receive) "from")
- ((eq type 'chat) "with"))
- (liece-dcc-object-from object)
- (substring output 0 (1- (length output))))))))
-
-(defun liece-dcc-send-filter (process output)
- (if (string-match "DCC send +" output)
- (multiple-value-bind (filename port host size)
- (split-string (substring output (match-end 0)))
- (setq filename (file-name-nondirectory filename))
- (liece-send "PRIVMSG %s :\001DCC SEND %s %s %s %s\001"
- liece-privmsg-partner filename host port size)
- (liece-dcc-message (_ "Sending file to %s: %s (%s bytes)")
- liece-privmsg-partner filename size)
- (liece-dcc-add-to-process-alist process 'send
- :host host
- :port port
- :from liece-privmsg-partner
- :file filename
- :size size))
- (liece-dcc-message (_ "send error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output))))))
-
-(defmacro liece-dcc-prepare-directory ()
- '(or (file-directory-p (expand-file-name liece-dcc-directory))
- (and (y-or-n-p (_ "DCC directory does not exist. Create it? "))
- (make-directory (expand-file-name liece-dcc-directory)))))
-
-(defun liece-command-dcc-receive (&optional number)
- "Receive next file from list."
- (interactive "P")
- (let ((object (liece-dcc-dequeue-request 'send)))
- (if (not object)
- (liece-message (_ "DCC No send request has been arrived."))
- (liece-dcc-message (_ "Getting file from %s: %s (%s bytes)")
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object))
- (liece-dcc-prepare-directory)
- (let ((file
- (expand-file-name
- (liece-dcc-object-file object)
- liece-dcc-directory))
- (process
- (liece-dcc-start-process
- (list "receive"
- (liece-dcc-object-host object)
- (liece-dcc-object-port object)
- (liece-dcc-object-size object)
- (expand-file-name
- (liece-dcc-object-file object)
- liece-dcc-directory)))))
- (set-process-filter process #'liece-dcc-receive-filter)
- (set-process-sentinel process #'liece-dcc-sentinel)
- (liece-dcc-add-to-process-alist
- process 'receive
- :from (liece-dcc-object-from object)
- :host (liece-dcc-object-host object)
- :port (liece-dcc-object-port object)
- :file file
- :size (liece-dcc-object-size object))))))
-
-(defun liece-dcc-receive-filter (process output)
- (liece-dcc-message "%s" (substring output 0 (1- (length output)))))
-
-(defun liece-command-dcc-chat-listen (towhom)
- (interactive
- (list (liece-minibuffer-completing-read
- (_ "With whom: ")
- (append liece-nick-alist liece-channel-alist)
- nil nil nil nil liece-privmsg-partner)))
- (setq liece-privmsg-partner towhom)
- (let ((process
- (as-binary-process
- (liece-dcc-start-process
- (list "chat" "listen" (int-to-string liece-dcc-port))))))
- (set-process-buffer
- process
- (liece-get-buffer-create (format " DCC:%s" (process-id process))))
- (set-process-filter process 'liece-dcc-chat-listen-filter)
- (set-process-sentinel process 'liece-dcc-sentinel))
- (unless (zerop liece-dcc-port)
- (setq liece-dcc-port (1+ liece-dcc-port))))
-
-(defun liece-dcc-chat-listen-filter (process output)
- (cond
- ((string-match "DCC chat +" output)
- (multiple-value-bind (host port)
- (split-string (substring output (match-end 0)))
- (liece-send "PRIVMSG %s :\001DCC CHAT chat %s %s\001"
- liece-privmsg-partner host port)
- (liece-dcc-message (_ "Ringing user %s")
- liece-privmsg-partner)
- (liece-dcc-add-to-process-alist
- process 'chat :from liece-privmsg-partner)))
- ((string-match "^DCC chat established" output)
- (set-process-filter process 'liece-dcc-chat-filter)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-dcc-object-from object)))
- (setq nick (liece-channel-prepare-representation nick 'dcc))
- (liece-channel-prepare-partner nick)
- (liece-dcc-message (_ "Chat connection established with: %s")
- nick))
- (message ""))
- (t
- (liece-dcc-message (_ "listen error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output)))))))
-
-(defun liece-command-dcc-chat-connect (&optional number)
- (interactive "P")
- (let* ((object (liece-dcc-dequeue-request 'chat))
- (nick (liece-dcc-object-from object))
- process)
- (if (not object)
- (liece-message (_ "DCC No chat request has been arrived."))
- (liece-dcc-message (_ "Connecting to: %s") nick)
- (setq liece-privmsg-partner nick)
- (setq process
- (as-binary-process
- (liece-dcc-start-process
- (list "chat" "connect"
- (liece-dcc-object-host object)
- (liece-dcc-object-port object)))))
- (set-process-buffer
- process
- (liece-get-buffer-create
- (format " DCC:%s" (process-id process))))
- (set-process-filter process #'liece-dcc-chat-connect-filter)
- (set-process-sentinel process #'liece-dcc-sentinel)
- (liece-dcc-add-to-process-alist
- process 'chat :from liece-privmsg-partner))))
-
-(defun liece-dcc-chat-connect-filter (process output)
- (if (string-match "^DCC chat established" output)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-dcc-object-from object)))
- (set-process-filter process #'liece-dcc-chat-filter)
- (setq nick (liece-channel-prepare-representation nick 'dcc))
- (liece-channel-prepare-partner nick)
- (liece-dcc-message (_ "Chat connection established with: %s")
- nick)
- (message ""))
- (liece-dcc-message
- (_ "connect error to %s: %s")
- liece-privmsg-partner
- (substring output 0 (1- (length output))))))
-
-(defun liece-dcc-chat-filter (process output)
- (save-match-data
- (with-current-buffer (process-buffer process)
- (let* ((object (liece-dcc-get-process-object process))
- (nick (liece-channel-prepare-representation
- (liece-dcc-object-from object) 'dcc)))
- (goto-char (point-max))
- (insert output)
- (goto-char (point-min))
- (while (search-forward "\n\n" (point-max) t)
- (delete-char -1))
- (goto-char (point-min))
- (when (string-match "\n" output)
- (let (st nd line)
- (while (looking-at ".*\n")
- (setq st (match-beginning 0) nd (match-end 0)
- line (liece-coding-decode-charset-string
- (buffer-substring st (1- nd))))
- (delete-region st nd)
- (let ((liece-message-target (liece-current-nickname))
- (liece-message-speaker nick))
- (liece-display-message line)))))))))
-
-(defun liece-dcc-chat-nick-to-process (nick)
- "Convert NICK to process symbol."
- (let ((alist liece-dcc-process-alist)
- pair)
- (catch 'found
- (while alist
- (setq pair (pop alist))
- (if (and (eq 'chat (cadr pair))
- (liece-nick-equal nick (caddr pair)))
- (throw 'found (car pair))))
- nil)))
-
-(defun liece-dcc-chat-send (nick message)
- "Send MSG string to NICK via DCC chat."
- (let ((process (liece-dcc-chat-nick-to-process nick)))
- (if (not process)
- (liece-message (_ "DCC chat has not been started."))
- (with-current-buffer liece-command-buffer
- (setq message (liece-coding-encode-charset-string message)
- message (if (string-match "\r$" message) message
- (concat message "\r\n")))
- (process-send-string process message)))))
-
-(defun liece-command-dcc-accept ()
- "Dispatch one DCC request."
- (interactive)
- (let* ((object (queue-first liece-dcc-requests))
- (type (liece-dcc-object-type object)))
- (cond ((eq type 'send)
- (liece-command-dcc-receive))
- ((eq type 'chat)
- (liece-command-dcc-chat-connect))
- (t
- (liece-message
- (_ "DCC No request has been arrived."))))))
-
-(defun liece-command-dcc-list ()
- "List files in receive queue."
- (interactive)
- (if (queue-empty liece-dcc-requests)
- (liece-dcc-message (_ "No DCC request here"))
- (let ((i 0) (objects (queue-all liece-dcc-requests)) type)
- (dolist (object objects)
- (setq type (liece-dcc-object-type object))
- (cond ((eq type 'send)
- (liece-dcc-message
- (_ "(%d) %s request %s: %s (%s bytes)")
- i (upcase (symbol-name type))
- (liece-dcc-object-from object)
- (liece-dcc-object-file object)
- (liece-dcc-object-size object)))
- ((eq type 'chat)
- (liece-dcc-message
- (_ "(%d) %s request from %s")
- i (upcase (symbol-name type))
- (liece-dcc-object-from object))))
- (incf i)))))
-
-(defun liece-dcc-compare-hostnames (h1 h2)
- "Compare two internet domain hostnames. Return true iff they resolve to the
-same IP-address."
- (or
- (string-equal-ignore-case h1 h2)
- (if liece-dcc-program
- (let ((pob (liece-get-buffer-create "*IRC DCC resolve*"))
- (output) (domatch nil))
- (save-excursion
- (call-process liece-dcc-program nil pob nil "resolve" h1 h2)
- (set-buffer pob)
- (goto-char (point-min))
- (setq output (buffer-substring (point-min) (point-max)))
- (if (string-match "\\([^ ]+\\)\n\\([^ ]+\\)\n" output)
- (if (string= (match-string 1 output)
- (match-string 2 output))
- (setq domatch t))))
- (kill-buffer pob)
- domatch)
- (string-equal-ignore-case h1 h2))))
-
-(provide 'liece-dcc)
-
-;;; liece-dcc.el ends here
+++ /dev/null
-;;; liece-emacs.el --- FSF Emacs specific routines.
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-08-21
-;; Keywords: emulation
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-compat)
- (require 'liece-vars)
- (require 'liece-misc))
-
-(eval-when-compile (ignore-errors (require 'image)))
-
-(require 'pces)
-(require 'derived)
-
-(eval-and-compile
- (autoload 'bitmap-stipple-xbm-file-to-stipple "bitmap-stipple")
- (autoload 'bitmap-stipple-insert-pixmap "bitmap-stipple"))
-
-;;; @ widget emulation
-;;;
-(defvar liece-widget-keymap nil)
-
-(unless liece-widget-keymap
- (setq liece-widget-keymap (copy-keymap widget-keymap))
- (substitute-key-definition
- 'widget-button-click 'liece-widget-button-click
- liece-widget-keymap)
- (define-key liece-widget-keymap [mouse-3]
- 'liece-widget-button-click))
-
-(defun liece-emacs-widget-convert-button (type from to &rest args)
- (apply 'widget-convert-button type from to args)
- (let ((map (copy-keymap liece-widget-keymap)))
- (set-keymap-parent map (current-local-map))
- (overlay-put (make-overlay from to) 'local-map map)))
-
-(defun liece-emacs-widget-button-click (event)
- (interactive "e")
- (let* ((window (posn-window (event-start event)))
- (point (window-point window))
- (buffer (window-buffer window)))
- (with-current-buffer buffer
- (unwind-protect
- (progn
- (goto-char (widget-event-point event))
- (cond
- ((widget-at (point)))
- ((> (point) (save-excursion
- (widget-forward 0)
- (point)))
- (widget-backward 0))
- ((< (point) (save-excursion
- (widget-backward 0)
- (point)))
- (widget-forward 0)))
- (call-interactively (function widget-button-click)))
- (if (windowp (setq window (get-buffer-window buffer)))
- (set-window-point window point))))))
-
-(fset 'liece-widget-convert-button
- 'liece-emacs-widget-convert-button)
-(fset 'liece-widget-button-click
- 'liece-emacs-widget-button-click)
-
-;;; @ startup splash
-;;;
-(defvar liece-splash-image
- (eval-when-compile
- (let ((file (expand-file-name "liece.xpm" default-directory)))
- (if (file-exists-p file)
- (with-temp-buffer
- (insert-file-contents-as-binary file)
- (buffer-string))))))
-
-(defun liece-emacs-splash-with-image ()
- (or (eq (car-safe liece-splash-image) 'image)
- (setq liece-splash-image
- (create-image liece-splash-image 'xpm 'data)))
- (setq cursor-type nil)
- (when liece-splash-image
- (let ((image-size (image-size liece-splash-image)))
- (insert (make-string (max 0 (/ (- (window-height)
- (floor (cdr image-size)))
- 2))
- ?\n))
- (make-string (max 0 (/ (- (window-width)
- (floor (car image-size)))
- 2))
- ?\ )
- (insert-image liece-splash-image))))
-
-(defun liece-emacs-splash-with-stipple ()
- (bitmap-stipple-insert-pixmap
- (eval-when-compile
- (let ((file (expand-file-name "liece.xbm" default-directory)))
- (if (file-exists-p file)
- (bitmap-stipple-xbm-file-to-stipple file))))
- 'center))
-
-(defvar liece-splash-buffer nil)
-
-(defvar liece-emacs-splash-function nil)
-
-(defun liece-emacs-splash (&optional arg)
- (interactive "P")
- (unless (and liece-splash-buffer (buffer-live-p liece-splash-buffer))
- (let ((liece-insert-environment-version nil))
- (save-excursion
- (setq liece-splash-buffer (generate-new-buffer
- (concat (if arg "*" " *")
- (liece-version) "*")))
- (push liece-splash-buffer liece-buffer-list)
- (set-buffer liece-splash-buffer)
- (erase-buffer)
- (funcall liece-emacs-splash-function)
- (insert-char ?\ (max 0 (/ (- (window-width)
- (length (liece-version)))
- 2)))
- (put-text-property (point) (prog2 (insert (liece-version))(point)
- (insert "\n"))
- 'face 'underline))))
- (if arg
- (switch-to-buffer liece-splash-buffer)
- (save-window-excursion
- (switch-to-buffer liece-splash-buffer)
- (sit-for 2))))
-
-;;; @ modeline decoration
-;;;
-(defvar liece-mode-line-image nil)
-
-(defun liece-emacs-create-mode-line-image ()
- (let ((file (liece-locate-icon-file "liece-pointer.xpm")))
- (if (file-exists-p file)
- (create-image file nil nil :ascent 99))))
-
-(defun liece-emacs-mode-line-buffer-identification (line)
- (let ((id (copy-sequence (car line))) image)
- (or liece-mode-line-image
- (setq liece-mode-line-image (liece-emacs-create-mode-line-image)))
- (when (and liece-mode-line-image
- (stringp id) (string-match "^Liece:" id))
- (add-text-properties 0 (length id)
- (list 'display
- liece-mode-line-image
- 'rear-nonsticky (list 'display))
- id)
- (setcar line id))
- line))
-
-;;; @ nick buffer decoration
-;;;
-(defun liece-emacs-create-nick-image (file)
- (let ((file (liece-locate-icon-file file)))
- (if (file-exists-p file)
- (create-image file nil nil :ascent 99))))
-
-(defun liece-emacs-nick-image-region (start end)
- (save-excursion
- (goto-char start)
- (beginning-of-line)
- (setq start (point))
-
- (goto-char end)
- (beginning-of-line 2)
- (setq end (point))
-
- (save-restriction
- (narrow-to-region start end)
- (let ((buffer-read-only nil)
- (inhibit-read-only t)
- (case-fold-search nil)
- mark image)
- (dolist (entry liece-nick-image-alist)
- (setq mark (car entry)
- image (cdr entry))
- (if (stringp image)
- (setq image
- (setcdr entry (liece-emacs-create-nick-image image))))
- (goto-char start)
- (while (not (eobp))
- (when (eq (char-after) mark)
- (add-text-properties (point) (1+ (point))
- (list 'display
- image
- 'rear-nonsticky (list 'display))))
- (beginning-of-line 2)))))))
-
-;;; @ unread mark
-;;;
-(defun liece-emacs-unread-mark (chnl)
- (if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
- (goto-char (match-end 0))
- (insert (concat " " liece-channel-unread-character)))))))
-
-(defun liece-emacs-read-mark (chnl)
- (if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (when (re-search-forward
- (concat "^ ?[0-9]+: " chnl " "
- liece-channel-unread-character "$") nil t)
- (goto-char (- (match-end 0) 2))
- (delete-char 2))))))
-
-(defun liece-emacs-redisplay-unread-mark ()
- (if liece-display-unread-mark
- (dolist (chnl liece-channel-unread-list)
- (liece-emacs-unread-mark chnl))))
-
-(if (and (fboundp 'image-type-available-p)
- (and (display-color-p)
- (image-type-available-p 'xpm)))
- (progn
- (fset 'liece-mode-line-buffer-identification
- 'liece-emacs-mode-line-buffer-identification)
- (setq liece-emacs-splash-function #'liece-emacs-splash-with-image)
- (add-hook 'liece-nick-insert-hook 'liece-emacs-nick-image-region)
- (add-hook 'liece-nick-replace-hook 'liece-emacs-nick-image-region))
- (fset 'liece-mode-line-buffer-identification 'identity)
- (setq liece-emacs-splash-function #'liece-emacs-splash-with-stipple))
-
-(when (and (not liece-inhibit-startup-message) window-system)
- (liece-emacs-splash))
-
-(fset 'liece-redisplay-unread-mark 'liece-emacs-redisplay-unread-mark)
-(add-hook 'liece-channel-unread-functions 'liece-emacs-unread-mark)
-(add-hook 'liece-channel-read-functions 'liece-emacs-read-mark)
-
-(provide 'liece-emacs)
-
-;;; liece-emacs.el ends here
+++ /dev/null
-;;; liece-filter.el --- Process filters for IRC process.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-inlines)
-(require 'liece-misc)
-(require 'liece-intl)
-(require 'liece-handler)
-
-(defvar liece-current-function nil)
-
-(defun* liece-handle-message (prefix message line)
- (let ((hook (intern (concat "liece-" message "-hook")))
- (after-hook (intern (concat "liece-after-" message "-hook")))
- (number (car (read-from-string message)))
- function)
- (if (run-hook-with-args-until-success hook prefix line)
- (return-from liece-handle-message))
- (if (not (numberp number))
- (setq function (liece-handler-find-function message '(prefix line) "generic"))
- (let ((base (format "%03d" (- number (mod number 100)))))
- (require (intern (concat "liece-" base)) nil 'noerror)
- (setq function (liece-handler-find-function message '(prefix line) base))
- (or function
- (setq function
- (let ((default (concat "liece-handle-" base "-messages")))
- `(lambda (prefix line)
- (funcall (intern ,default) ,message prefix line)))))))
- (if function
- (funcall function prefix line))
- (run-hook-with-args after-hook prefix line)))
-
-(defun liece-parse-user-at-host ()
- (let ((cookie
- (and (stringp liece-user-at-host)
- (> (length liece-user-at-host) 2)
- (string-to-char liece-user-at-host))))
- (cond
- ((null cookie)
- (setq liece-user-at-host-type 'invalid))
- ((or (eq cookie ?^) (eq cookie ?=))
- (setq liece-user-at-host (substring liece-user-at-host 1)
- liece-user-at-host-type 'fake))
- ((or (eq cookie ?~) (eq cookie ?-))
- (setq liece-user-at-host (substring liece-user-at-host 1)
- liece-user-at-host-type 'not-verified))
- ((eq cookie ?+)
- (setq liece-user-at-host (substring liece-user-at-host 1)
- liece-user-at-host-type 'ok))
- (t (setq liece-user-at-host-type 'ok)))))
-
-(defun liece-parse-line (line)
- (let (prefix message)
- (when (or (string-match "^\\(:[^! ]*\\)!\\([^ ]*\\) +\\([^ ]+\\) +:?"
- line)
- (string-match "^\\(:[^ ]*\\)?\\(\\) *\\([^ ]+\\) +:?"
- line)
- (string-match "^\\(:[^! \t]*\\)!\\([^ \t]*\\) +\\([^ \t]+\\) +:?"
- line)
- (string-match "^\\(:[^ ]*\\)?\\(\\) *\\([^ \t]+\\) +:?"
- line))
- (setq prefix (if (match-beginning 1)
- (substring (match-string 1 line) 1))
- liece-user-at-host (match-string 2 line)
- message (downcase (match-string 3 line))
- line (liece-coding-decode-charset-string
- (substring line (match-end 0))))
-
- (liece-parse-user-at-host)
- (setq liece-current-function (list prefix message))
- (liece-handle-message prefix message line)
- (setq liece-current-function '("" "")))))
-
-(defun liece-filter (process output)
- "Filter function for IRC server process."
- (with-current-buffer (process-buffer process)
- (goto-char (point-max))
- (insert (liece-convert-received-input output))
- (goto-char (point-min))
- (while (progn (end-of-line) (and (not (eobp)) (eq (char-after) ?\n)))
- (if (eq (char-after (1- (point))) ?\r) ; cut off preceding LF
- (delete-region (1- (point)) (point)))
- (liece-parse-line (buffer-substring (point-min) (point)))
- (delete-region (point-min) (progn (beginning-of-line 2) (point))))))
-
-(defun liece-sentinel (proc status)
- "Sentinel function for Liece process."
- (cond
- ((or (not liece-server-process) (liece-server-opened)))
- ((not (or liece-reconnect-automagic liece-reconnect-with-password))
- (if (process-id proc)
- (liece-sentinel-error proc status)
- (liece-message (_ "Connection closed. (%s)")
- (substring status 0 (1- (length status)))))
- (liece-close-server))
- (liece-reconnect-with-password
- (liece))
- (t
- (condition-case nil
- (progn
- (set-process-filter liece-server-process nil)
- (set-process-sentinel liece-server-process nil))
- (wrong-type-argument nil))
- (setq liece-server-process nil)
- (liece))))
-
-(defun liece-sentinel-error (proc status)
- (if (not (string-match "^exited abnormally with code \\([0-9]+\\)" status))
- (liece-message (_ "Connection closed. (%s)")
- (substring status 0 (1- (length status))))
- (let ((status (string-to-int (match-string 1 status))))
- (cond
- ((= 99 status) ;; unsupported command
- (liece-message (_ "Please use a newer \"%s\".") liece-dcc-program))
- ((= 98 status) ;; bad argment number
- (liece-message (_ "Please use a newer \"%s\".") liece-dcc-program))
- ((= 97 status)
- (liece-message (_ "Cannot connect to IRC server.")))
- (t
- (liece-message (_ "Server connection closed.")))))))
-
-(provide 'liece-filter)
-
-;;; liece-filter.el ends here
+++ /dev/null
-;;; liece-globals.el --- Global variables and constants.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-version)
-
-(defvar liece-server-name nil)
-(defvar liece-server-process nil)
-(defvar liece-status-message-string nil)
-(defvar liece-polling 0
- "Wheter we are automatically polling the server.")
-
-(defvar liece-real-nickname nil)
-(defvar liece-nick-accepted nil)
-
-(defvar liece-current-channel nil
- "The channel you currently have joined.")
-
-(defvar liece-current-channels nil
- "The channels you have currently joined.")
-
-(defvar liece-current-chat-partner nil
- "The person you are in a private conversation with.")
-
-(defvar liece-current-chat-partners nil
- "An list containing nics user is chatting with.")
-
-(defvar liece-privmsg-partner nil
- "The person who got your last private message.")
-
-(defvar liece-nick-alist nil
- "An alist containing the nicknames of users known to be on IRC.
-Each element in the list is a list containing a nickname.")
-
-(defvar liece-channel-alist nil
- "An alist containing the channels on IRC.
-Each element in the list is a list containing a channel name.")
-
-(defvar liece-operator-alist nil
- "An alist of operators on channel.
-Each element in the list is a list containing a nickname.")
-
-(defvar liece-supported-user-mode-alist nil
- "User modes supported by server.")
-
-(defvar liece-supported-channel-mode-alist nil
- "Channel modes supported by server.")
-
-;; Caches
-(defvar liece-save-variables-are-dirty nil
- "Non nil if liece_vars.el is changed but not saved.")
-
-(defvar liece-user-at-host ""
- "The user@host for the current line.")
-
-(defvar liece-user-at-host-type nil
- "The authentication of uerathost. 'ok 'not-verified 'fake or 'invalid.")
-
-(defvar liece-channel-filter ""
- "Enables use of \\[universal-argument] with NAMES and TOPIC.")
-
-(defvar liece-default-channel-candidate nil)
-
-(defvar liece-nickname-last nil
- "Place to keep old nickname.")
-
-(defvar liece-friends-last nil)
-(defvar liece-who-expression nil)
-
-(defconst liece-long-reply-max 38)
-(defvar liece-long-reply-count 0)
-
-(defvar liece-obarray nil)
-
-\f
-;; Modeline indicators
-(defvar liece-channel-indicator "No channel"
- "The current channel, \"pretty-printed.\".")
-
-(defvar liece-private-indicator nil
- "String displayed in the modeline indicating private conversation.")
-
-(defvar liece-channels-indicator "No channel"
- "The current joined channels, \"pretty-printed.\".")
-
-(defvar liece-away-indicator "-")
-(defvar liece-command-buffer-mode-indicator "Channels")
-(defvar liece-channel-status-indicator "")
-
-(defvar liece-beep-indicator nil)
-(defvar liece-freeze-indicator nil)
-(defvar liece-own-freeze-indicator nil)
-(defvar liece-beep nil)
-(defvar liece-freeze nil)
-(defvar liece-own-freeze nil)
-
-(defvar liece-own-freeze nil
- "If non-nil, dialogue window will not be scrolled automatically.")
-
-(defvar liece-command-buffer-mode 'channel
- "Current command buffer mode.
-Which value is 'chat or 'channel.")
-
-;; Buffers
-(defvar liece-command-buffer "*Commands*"
- "Name of command input buffer.")
-
-(defvar liece-dialogue-buffer "*Dialogue*"
- "Name of dialogue output buffer.")
-
-(defvar liece-private-buffer "*Private*"
- "Name of private message buffer.")
-
-(defvar liece-others-buffer "*Others*"
- "Name of others message buffer.")
-
-(defvar liece-channel-buffer "*Channel*"
- "Name of Channel message buffer.")
-
-(defvar liece-channel-buffer-format " *Channel:%s*"
- "Format of Channel message buffer.")
-
-(defvar liece-channel-list-buffer "*Channels*"
- "Name of Channel list buffer.")
-
-(defvar liece-nick-buffer " *Nicks*"
- "Name of nick list message buffer.")
-
-(defvar liece-nick-buffer-format " *Nicks:%s*"
- "Format of nick list buffer.")
-
-(defvar liece-KILLS-buffer " *KILLS*")
-(defvar liece-IGNORED-buffer " *IGNORED*")
-(defvar liece-WALLOPS-buffer " *WALLOPS*")
-
-(defvar liece-server-buffer nil)
-
-;; Buffer display variables
-(defvar liece-channel-buffer-alist nil)
-(defvar liece-nick-buffer-alist nil)
-
-(defvar liece-buffer-list nil
- "A list of buffers used in displaying messages.")
-
-(defvar liece-D-buffer (list liece-dialogue-buffer)
- "A list of buffer where normal dialogue is sent.")
-
-(defvar liece-O-buffer (list liece-others-buffer)
- "A list of buffer where other messages are sent.")
-
-(defvar liece-P-buffer
- (list liece-dialogue-buffer liece-private-buffer liece-others-buffer)
- "A list of buffers where private messages to me are sent.")
-
-(defvar liece-I-buffer (list liece-IGNORED-buffer)
- "A list of buffers where private messages to me are sent.")
-
-(defvar liece-W-buffer (list liece-WALLOPS-buffer)
- "A list of buffers where WALLOPS messages to me are sent.")
-
-(defvar liece-K-buffer (list liece-KILLS-buffer)
- "A list of buffers where KILL messages to me are sent.")
-
-(defvar liece-000-buffer
- (list liece-dialogue-buffer liece-others-buffer)
- "A list of buffers where 000 messages to me are sent.")
-
-(defvar liece-200-buffer
- (list liece-dialogue-buffer liece-others-buffer)
- "A list of buffers where 200 messages to me are sent.")
-
-(defvar liece-300-buffer
- (list liece-dialogue-buffer liece-others-buffer)
- "A list of buffers where 300 messages to me are sent.")
-
-(defvar liece-400-buffer
- (list liece-dialogue-buffer liece-others-buffer)
- "A list of buffers where 400 messages to me are sent.")
-
-(defvar liece-500-buffer
- (list liece-dialogue-buffer liece-others-buffer)
- "A list of buffers where 500 messages to me are sent.")
-
-(provide 'liece-globals)
-
-;;; liece-globals.el ends here
+++ /dev/null
-;;; liece-handle.el --- implementation of IRC message handlers
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-misc)
- (require 'liece-intl))
-
-(require 'liece-message)
-(require 'liece-filter)
-
-(require 'liece-handler)
-
-(defmacro liece-handle-prepare-comment (rest &optional quote)
- `(if (zerop (length ,rest))
- ""
- (if ,quote
- (regexp-quote (format " (%s)" ,rest))
- (format " (%s)" ,rest))))
-
-(defmacro liece-handle-message-check-empty (msg)
- `(string= ,msg ""))
-
-(defmacro liece-handle-message-check-ignored (prefix rest)
- `(and ,prefix
- (liece-ignore-this-p ,prefix liece-user-at-host)
- (liece-message-from-ignored ,prefix ,rest)))
-
-(defmacro liece-handle-check-changes-ignored ()
- 'liece-ignore-changes)
-
-(defconst liece-handle-ctcp-message-regexp "\001\\(.*\\)\001")
-
-(defmacro liece-handle-ctcp-message-p (msg)
- `(string-match liece-handle-ctcp-message-regexp ,msg))
-
-(autoload 'liece-ctcp-message "liece-ctcp")
-(autoload 'liece-ctcp-notice "liece-ctcp")
-
-\f
-(liece-handler-define-backend "generic")
-
-(mapcar
- (lambda (message)
- (liece-handler-define-function
- message '(prefix rest "generic")
- (intern (format "liece-handle-%s-message" message)))
- (defvar ,(intern (format "liece-%s-hook" message)) nil)
- (defvar ,(intern (format "liece-after-%s-hook" message)) nil))
- '("nick" "notice" "privmsg" "ping" "wall" "wallops" "quit" "topic"
- "mode" "kick" "invite" "kill" "join" "part" "silence"))
-
-(defun* liece-handle-nick-message (prefix rest)
- (let ((chnls (liece-nick-get-joined-channels prefix)))
- (liece-nick-change prefix rest)
- (cond
- ((liece-nick-equal prefix liece-real-nickname)
- (setq liece-nickname-last liece-real-nickname
- liece-real-nickname rest))
- ((liece-nick-member prefix liece-current-chat-partners)
- (setq liece-current-chat-partners
- (string-list-modify-ignore-case (list (cons prefix rest))
- liece-current-chat-partners))
- (setcar (string-assoc-ignore-case prefix liece-nick-buffer-alist)
- rest)
- (setcar (string-assoc-ignore-case prefix liece-channel-buffer-alist)
- rest)
- (if (liece-nick-equal prefix liece-current-chat-partner)
- (setq liece-current-chat-partner rest))
- (add-to-list 'chnls rest)
- (liece-channel-change)))
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-nick-message))
- (liece-insert-change (append (liece-pick-buffer chnls)
- liece-D-buffer liece-O-buffer)
- (format (_ "%s is now known as %s\n") prefix rest))))
-
-(defun* liece-handle-notice-message (prefix rest)
- (if (liece-handle-message-check-ignored prefix rest)
- (return-from liece-handle-notice-message))
- (or liece-ignore-extra-notices
- prefix
- (string-match "as being away" rest)
- (return-from liece-handle-notice-message))
-
- ;; No prefix. This is a server notice.
- (when (and (null prefix) (string-match "^[^ ]* +:?" rest))
- (liece-insert-notice (append liece-D-buffer liece-O-buffer)
- (concat (substring rest (match-end 0)) "\n"))
- (return-from liece-handle-notice-message))
- (multiple-value-bind (chnl temp) (liece-split-line rest)
- ;; This is a ctcp reply but contains additional messages
- ;; at the left or/and right side.
- (if (liece-handle-ctcp-message-p temp)
- (setq temp (liece-ctcp-notice prefix temp)))
- (if (liece-handle-message-check-empty temp)
- (return-from liece-handle-notice-message))
-
- ;; Normal message via notice.
- (setq chnl (liece-channel-virtual chnl))
- (let ((liece-message-target chnl)
- (liece-message-speaker prefix)
- (liece-message-type 'notice))
- (liece-display-message temp))))
-
-(defun* liece-handle-privmsg-message (prefix rest)
- (if (liece-handle-message-check-ignored prefix rest)
- (return-from liece-handle-privmsg-message))
- (multiple-value-bind (chnl temp) (liece-split-line rest)
- (setq temp (or temp ""))
- ;; This is a ctcp request but contains additional messages
- ;; at the left or/and right side.
- (if (liece-handle-ctcp-message-p temp)
- (setq temp (liece-ctcp-message prefix chnl temp)))
- (if (liece-handle-message-check-empty temp)
- (return-from liece-handle-privmsg-message))
-
- (setq chnl (liece-channel-virtual chnl))
-
- (when liece-beep-on-bells
- (if (string-match "\007" rest)
- (liece-beep))
- (if (liece-nick-equal chnl liece-real-nickname)
- (and liece-beep-when-privmsg (liece-beep))
- (with-current-buffer (if liece-channel-buffer-mode
- (liece-pick-buffer-1 chnl)
- liece-dialogue-buffer)
- (if liece-beep
- (liece-beep))))
- (dolist (word liece-beep-words-list)
- (if (string-match word rest)
- (liece-beep))))
-
- ;; Append timestamp if we are being away.
- (if (and (string-equal "A" liece-away-indicator)
- (liece-nick-equal chnl liece-real-nickname))
- (setq temp
- (concat temp " ("
- (funcall liece-format-time-function (current-time))
- ")")))
-
- ;; Normal message.
- (let ((liece-message-target chnl)
- (liece-message-speaker prefix)
- (liece-message-type 'privmsg))
- (liece-display-message temp))
-
- ;; Append to the unread list.
- (let ((item (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- liece-current-channel)))
- (unless (liece-channel-equal chnl item)
- (if (liece-channel-unread-p chnl)
- (setq liece-channel-unread-list
- (delete chnl liece-channel-unread-list)))
- (setq liece-channel-unread-list
- (cons chnl liece-channel-unread-list))
- (run-hook-with-args 'liece-channel-unread-functions chnl)))
-
- (if (and (liece-nick-equal chnl liece-real-nickname)
- (not (liece-nick-equal prefix liece-current-chat-partner)))
- (liece-message (_ "A private message has arrived from %s")
- prefix))))
-
-(defun liece-handle-ping-message (prefix rest)
- (liece-send "PONG :%s" rest)
- (liece-command-timestamp-if-interval-expired t)
- (liece-maybe-poll))
-
-(defun liece-handle-wall-message (prefix rest)
- (liece-insert-broadcast (append liece-D-buffer liece-O-buffer)
- (concat (if prefix (concat "from " prefix) "") " "
- rest "\n")))
-
-(defun liece-handle-wallops-message (prefix rest)
- (if liece-show-wallops
- (liece-insert-wallops (append liece-D-buffer liece-O-buffer)
- (concat (if prefix prefix "UNKNOWN")
- ": " rest "\n")))
- (liece-insert-wallops liece-W-buffer
- (concat (if prefix (concat "from " prefix) "") " "
- rest "\n")))
-
-(defun* liece-handle-quit-message (prefix rest)
- (let ((chnls (liece-nick-get-joined-channels prefix)) text match default)
- ;; Mark temporary apart, if quitting user is one of our chat partners.
- (when (liece-nick-member prefix liece-current-chat-partners)
- (add-to-list 'chnls prefix)
- (liece-nick-mark-as-part t prefix))
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-quit-message))
- (cond
- (liece-compress-changes
- (setq text (format (_ " \\(has\\|have\\) left IRC%s")
- (liece-handle-prepare-comment rest t))
- match (format "^%s%s.*%s$"
- (if liece-display-time
- liece-time-prefix-regexp "")
- (regexp-quote liece-change-prefix)
- (regexp-quote text))
- default (format (_ "%s%s has left IRC%s\n")
- liece-change-prefix prefix
- (liece-handle-prepare-comment rest)))
- (liece-replace (append (liece-pick-buffer chnls)
- liece-D-buffer liece-O-buffer)
- match default text
- (format (_ ", %s have left IRC%s")
- prefix (liece-handle-prepare-comment rest))))
- (t
- (liece-insert-change (append (liece-pick-buffer chnls)
- liece-D-buffer liece-O-buffer)
- (format (_ "%s has left IRC%s\n")
- (liece-handle-prepare-comment rest)))))
- (liece-nick-change prefix nil)))
-
-(defun* liece-handle-topic-message (prefix rest)
- (multiple-value-bind (chnl topic) (liece-split-line rest)
- (setq chnl (liece-channel-virtual chnl)
- topic (or topic ""))
- (liece-channel-set-topic topic chnl)
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-topic-message))
- (liece-insert-change (liece-pick-buffer chnl)
- (format (_ "New topic on channel %s set by %s: %s\n")
- chnl prefix topic))
- (liece-insert-change (if (liece-nick-equal chnl liece-current-channel)
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer))
- (format (_ "New topic on channel %s set by %s: %s\n")
- chnl prefix topic))
- (liece-set-channel-indicator)))
-
-(defun* liece-handle-mode-message (prefix rest)
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-mode-message))
- (let (mflgs margs val chnl mode chnlp)
- (if (string-match "\\([^ ]*\\) *:?" rest)
- (progn
- (setq chnl (match-string 1 rest)
- mode (substring rest (match-end 0)))
- (if (liece-channel-p chnl)
- (setq chnl (liece-channel-virtual chnl) chnlp t))
- (if (string-match " *$" mode)
- (setq mode (substring mode 0 (match-beginning 0)))))
- (return-from liece-handle-mode-message))
- ;; parse modes
- (when (string-match "\\([^ ]*\\) *" mode)
- (setq mflgs (liece-string-to-list (match-string 1 mode))
- margs (delete "" (split-string
- (substring mode (match-end 0))
- "[ ]+")))
- (while mflgs
- (cond ((eq ?- (car mflgs)) (setq val nil))
- ((eq ?+ (car mflgs)) (setq val t))
- ((and chnlp (eq ?o (car mflgs)))
- (liece-channel-set-operator chnl (car margs) val)
- (setq margs (cdr margs)))
- ((and chnlp (eq ?v (car mflgs)))
- (liece-channel-set-voice chnl (car margs) val)
- (setq margs (cdr margs)))
- ((and chnlp (eq ?b (car mflgs)))
- (liece-channel-set-ban chnl (car margs) val)
- (setq margs (cdr margs)))
- ((and chnlp (eq ?e (car mflgs)))
- (liece-channel-set-exception chnl (car margs) val)
- (setq margs (cdr margs)))
- ((and chnlp (eq ?I (car mflgs)))
- (liece-channel-set-invite chnl (car margs) val)
- (setq margs (cdr margs)))
- (chnlp (liece-channel-set-mode chnl (car mflgs) val))
- (t (liece-nick-set-mode chnl (car mflgs) val)))
- (setq mflgs (cdr mflgs))))
- (liece-set-channel-indicator)
- (cond
- (liece-compress-changes
- (let* ((text (concat (regexp-quote rest) "\n"))
- (match (format (_ "^%s%sNew mode for %s set by %s: ")
- (if liece-display-time
- liece-time-prefix-regexp "")
- (regexp-quote liece-change-prefix)
- (regexp-quote chnl) (regexp-quote prefix)))
- (default (format (_ "%sNew mode for %s set by %s: %s\n")
- liece-change-prefix chnl prefix mode)))
- (liece-replace (liece-pick-buffer chnl)
- match default text (concat ", " mode "\n"))
- (liece-replace (if (and liece-current-channel
- (liece-channel-equal
- chnl liece-current-channel))
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer))
- match default text (concat ", " mode "\n"))))
- (t
- (liece-insert-change (liece-pick-buffer chnl)
- (format (_ "New mode for %s set by %s: %s\n")
- chnl prefix mode))
- (liece-insert-change (if (and liece-current-channel
- (liece-channel-equal
- chnl liece-current-channel))
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer))
- (format (_ "New mode for %s set by %s: %s\n")
- chnl prefix mode))))))
-
-(defun* liece-handle-kick-message (prefix rest)
- (if (/= 3 (length (setq rest (liece-split-line rest))))
- (return-from liece-handle-kick-message))
- (multiple-value-bind (chnl nick message) rest
- (setq chnl (liece-channel-virtual chnl))
-
- (if (liece-nick-equal nick liece-real-nickname)
- (progn
- (liece-insert-change
- (liece-pick-buffer chnl)
- (format (_ "You were kicked off channel %s by %s (%s).\n")
- chnl prefix message))
- (liece-channel-part chnl))
- (liece-nick-part nick chnl))
-
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-kick-message))
-
- (liece-insert-change
- (append (liece-pick-buffer chnl)
- (if (liece-channel-equal chnl liece-current-channel)
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer)))
- (format "%s has kicked %s out%s%s\n"
- prefix nick
- (if (string= (or liece-current-channel "") chnl)
- ""
- (format " from channel %s" chnl))
- (if (not message)
- ""
- (format " (%s)" message))))))
-
-(defun* liece-handle-invite-message (prefix rest)
- (or (string-match " +:" rest)
- (return-from liece-handle-invite-message))
- (and liece-beep-when-invited liece-beep-on-bells
- (liece-beep))
- (let ((chnl (liece-channel-virtual (substring rest (match-end 0)))))
- (liece-insert-info (append liece-D-buffer liece-O-buffer)
- (format "%s invites you to channel %s\n"
- prefix chnl))
- (setq liece-default-channel-candidate chnl)))
-
-(defun* liece-handle-kill-message (prefix rest)
- (or (string-match " +:" rest)
- (return-from liece-handle-kill-message))
- (let ((path (substring rest (match-end 0))))
- (liece-insert-info (append liece-D-buffer liece-O-buffer)
- (format "You were killed by %s. (Path: %s. RIP)\n"
- prefix path)))
- (liece-close-server))
-
-(defun* liece-handle-join-message (prefix rest)
- (let (flag (xnick prefix) (nick prefix) (chnl rest))
- (cond
- ((string-match "\007[ov]" chnl)
- (setq flag (aref (match-string 0 chnl) 1)
- chnl (substring rest 0 (match-beginning 0))))
- ((string-match " +$" chnl)
- (setq chnl (substring chnl 0 (match-beginning 0)))))
- (setq chnl (liece-channel-virtual chnl))
- (liece-nick-set-user-at-host nick liece-user-at-host)
- (if (liece-nick-equal nick liece-real-nickname)
- (progn
- (and liece-gather-channel-modes
- (not (liece-channel-modeless-p (liece-channel-real chnl)))
- (liece-send "MODE %s " (liece-channel-real chnl)))
- (liece-channel-join chnl))
- (liece-nick-join nick chnl))
- (cond
- ((eq flag ?o)
- (liece-channel-set-operator chnl xnick t)
- (setq xnick (concat "@" xnick)))
- ((eq flag ?v)
- (liece-channel-set-voice chnl xnick t)
- (setq xnick (concat "+" xnick))))
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-join-message))
- ;; Restore the private conversation to its original state.
- (when (and (liece-nick-member nick liece-current-chat-partners)
- (get (intern nick liece-obarray) 'part))
- (liece-insert-change (liece-pick-buffer nick)
- (format (_ "%s has come back as (%s)\n")
- nick liece-user-at-host))
- (liece-nick-mark-as-part nil nick))
- (cond
- (liece-compress-changes
- (let* ((text (format (_ " \\(has\\|have\\) joined channel %s")
- (regexp-quote chnl)))
- (match (format "^%s%s.*%s$"
- (if liece-display-time
- liece-time-prefix-regexp "")
- (regexp-quote liece-change-prefix)
- (regexp-quote text)))
- (default (format (_ "%s%s (%s) has joined channel %s\n")
- liece-change-prefix
- nick liece-user-at-host chnl)))
- (liece-replace (liece-pick-buffer chnl)
- match default text
- (format (_ ", %s (%s) have joined channel %s")
- nick liece-user-at-host chnl))
- (liece-replace (if (and liece-current-channel
- (liece-channel-equal chnl
- liece-current-channel))
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer))
- match default text
- (format (_ ", %s (%s) have joined channel %s")
- nick liece-user-at-host chnl))))
- (t
- (liece-insert-change (liece-pick-buffer chnl)
- (format (_ "%s (%s) has joined channel %s\n")
- nick liece-user-at-host chnl))
- (liece-insert-change (if (liece-channel-equal chnl
- liece-current-channel)
- liece-D-buffer
- (append liece-D-buffer liece-O-buffer))
- (format (_ "%s (%s) has joined channel %s\n")
- nick liece-user-at-host chnl))))))
-
-(defun* liece-handle-part-message (prefix rest)
- (multiple-value-bind (chnl comment text match default buf) (liece-split-line rest)
- (setq chnl (liece-channel-virtual chnl)
- comment (liece-handle-prepare-comment comment))
-
- (if (liece-nick-equal prefix liece-real-nickname)
- (liece-channel-part chnl)
- (liece-nick-part prefix chnl))
-
- (if (liece-handle-check-changes-ignored)
- (return-from liece-handle-part-message))
-
- (setq buf (append liece-D-buffer (liece-pick-buffer chnl)))
- (unless (and liece-current-channel
- (liece-channel-equal chnl liece-current-channel))
- (setq buf (append buf liece-O-buffer)))
- (cond
- (liece-compress-changes
- (setq text (format (_ " \\(has\\|have\\) left channel %s%s")
- (regexp-quote chnl) (regexp-quote comment))
- match (format "^%s%s.*%s$"
- (if liece-display-time
- liece-time-prefix-regexp "")
- (regexp-quote liece-change-prefix)
- (regexp-quote text))
- default (format (_ "%s%s has left channel %s%s\n")
- liece-change-prefix prefix chnl comment))
- (liece-replace buf
- match default text
- (format (_ ", %s have left channel %s%s")
- prefix chnl comment)))
- (t
- (liece-insert-change buf
- (format (_ "%s has left channel %s%s\n")
- prefix chnl comment))))))
-
-(defun* liece-handle-silence-message (prefix rest)
- (let* ((flag (aref rest 0)) (rest (substring rest 1)))
- (liece-insert-info (append liece-D-buffer liece-O-buffer)
- (concat "User " rest
- (if (eq flag ?-) "unsilenced" "silenced")))))
-
-(provide 'liece-handle)
-
-;;; liece-handle.el ends here
+++ /dev/null
-;;; liece-handler.el --- function overloading facilities
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-06-05
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-(eval-when-compile (require 'liece-inlines))
-
-(eval-when-compile (require 'liece-clfns))
-
-(defmacro liece-handler-make-obarray (backend)
- `(defvar ,(intern (format "liece-handler-%s-obarray" backend))
- (make-vector 107 0)))
-
-(defmacro liece-handler-obarray (backend)
- `(symbol-value (intern-soft (format "liece-handler-%s-obarray" ,backend))))
-
-(defun liece-handler-override-function-definition (name backend args function)
- (let ((ref (symbol-name (liece-gensym))))
- (if (symbolp name)
- (setq name (symbol-name name)))
- (put (intern name (liece-handler-obarray backend)) 'unifiers
- (nconc (get (intern name (liece-handler-obarray backend)) 'unifiers)
- (list `(,(intern ref (liece-handler-obarray backend))
- ,@args))))
- (fset (intern ref (liece-handler-obarray backend)) function)))
-
-(defun liece-handler-unify-argument-list-function (args unifiers)
- (let ((index 0)
- (unfs (copy-alist unifiers))
- (len (length args))
- type)
- (setq unfs
- (remove-if (lambda (unf) (/= (length (cdr unf)) len)) unfs))
- (dolist (arg args)
- (if (listp arg)
- (setq unfs (remove-if-not
- (lambda (unf)
- (let ((spec (nth index (cdr unf))))
- (or (not (listp spec))
- (eq (car spec) (car arg)))))
- unfs)))
- (incf index))
- (if (caar unfs)
- (symbol-function (caar unfs)))))
-
-(defmacro liece-handler-define-backend (type &optional parents)
- `(liece-handler-make-obarray ,type))
-
-(defun liece-handler-find-function (name args backend)
- (let* ((fsym (intern-soft name (liece-handler-obarray backend)))
- (unifiers (if fsym (get fsym 'unifiers))))
- (liece-handler-unify-argument-list-function args unifiers)))
-
-(defun liece-handler-define-function (name specs function)
- (let ((args (butlast specs))
- (backend (car (last specs))))
- (liece-handler-override-function-definition name backend args function)))
-
-(provide 'liece-handler)
-
-;;; liece-handler.el ends here
+++ /dev/null
-;;; liece-hilit.el --- coloring IRC buffers
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'invisible)
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'font-lock))
-
-(autoload 'liece-url-add-buttons "liece-url")
-(autoload 'liece-channel-add-buttons "liece-channel")
-(autoload 'liece-nick-add-buttons "liece-nick")
-
-(defgroup liece-highlight nil
- "Highlight your IRC buffer"
- :tag "Highlight"
- :prefix "liece-"
- :group 'liece)
-
-(defgroup liece-highlight-faces nil
- "Faces for highlight your IRC buffer"
- :tag "Faces"
- :prefix "liece-highlight-"
- :group 'liece-highlight)
-
-(defcustom liece-change-face 'liece-change-face
- "Face used for displaying \"*** Change:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-notice-face 'liece-notice-face
- "Face used for displaying \"*** Notice:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-broadcast-face 'liece-broadcast-face
- "Face used for displaying \"*** Broadcast:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-wallops-face 'liece-wallops-face
- "Face used for displaying \"*** Wallops:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-error-face 'liece-error-face
- "Face used for displaying \"*** Error:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-info-face 'liece-info-face
- "Face used for displaying \"*** Info:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-timestamp-face 'liece-timestamp-face
- "Face used for displaying \"*** Time:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-client-face 'liece-client-face
- "Face used for displaying \"CLIENT@\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-dcc-face 'liece-dcc-face
- "Face used for displaying \"*** DCC:\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-prefix-face 'liece-prefix-face
- "Face used for displaying \"<nick>\" extent."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-priv-prefix-face 'liece-priv-prefix-face
- "Face used for displaying \"=nick\" line."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-pattern-face 'liece-pattern-face
- "Face used for displaying user defined pattern."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-quoted-bold-face 'liece-quoted-bold-face
- "Face used for displaying \002 quoted string."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-quoted-inverse-face 'liece-quoted-inverse-face
- "Face used for displaying \026 quoted string."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-quoted-underline-face 'liece-quoted-underline-face
- "Face used for displaying \037 quoted string."
- :type 'face
- :group 'liece-highlight-faces)
-
-(defcustom liece-quoted-colors-ircle
- '("white" "black" "red" "orange" "yellow" "LightGreen" "DarkOliveGreen"
- "cyan4" "turquoise" "blue" "black" "black" "black" "black" "black"
- "DarkBlue" "purple1" "purple2" "purple3" "magenta")
- "Color list for displaying \003 quoted string."
- :type '(repeat (radio string face))
- :group 'liece-highlight)
-
-(defcustom liece-quoted-colors-mirc
- '("white" "black" "blue" "DarkOliveGreen" "red" "brown" "purple"
- "orange" "yellow" "green" "cyan4" "turquoise" "RoyalBlue" "HotPink"
- "gray50" "gray75" "black" "black" "black" "black")
- "Color list for displaying \013 quoted string."
- :type '(repeat (radio string face))
- :group 'liece-highlight)
-
-(defcustom liece-highlight-jingle-function nil
- "Function playing jingles."
- :type 'function
- :group 'liece-highlight)
-
-(defface liece-change-face
- '((((class color)
- (background dark))
- (:foreground "cyan" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Change:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-notice-face
- '((((class color)
- (background dark))
- (:foreground "green2" :bold t))
- (((class color)
- (background light))
- (:foreground "MidnightBlue" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Notice:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-broadcast-face
- '((((class color)
- (background dark))
- (:foreground "Plum1" :italic t))
- (((class color)
- (background light))
- (:foreground "purple" :italic t))
- (t
- (:italic t)))
- "Face used for displaying \"*** Broadcast:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-wallops-face
- '((((class color)
- (background dark))
- (:foreground "yellow" :bold t))
- (((class color)
- (background light))
- (:foreground "blue4" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Wallops:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-error-face
- '((((class color)
- (background dark))
- (:foreground "cornflower blue" :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- (:bold t)))
- "Face used for displaying \"*** Error:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-info-face
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- (:bold t)))
- "Face used for displaying \"*** Info:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-timestamp-face
- '((((class color)
- (background dark))
- (:foreground "yellow" :bold t))
- (((class color)
- (background light))
- (:foreground "blue4" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Time:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-client-face
- '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "red"))
- (t
- (:bold nil)))
- "Face used for displaying \"CLIENT@\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-dcc-face
- '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "red"))
- (t
- (:bold nil)))
- "Face used for displaying \"*** DCC:\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-prefix-face
- '((((class color)
- (background dark))
- (:foreground "moccasin"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- (:bold nil)))
- "Face used for displaying \"<nick>\" extent"
- :group 'liece-highlight-faces)
-
-(defface liece-priv-prefix-face
- '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "grey40"))
- (t
- (:bold nil)))
- "Face used for displaying \"=nick\" line"
- :group 'liece-highlight-faces)
-
-(defface liece-pattern-face
- '((((class color)
- (background dark))
- (:foreground "red"))
- (((class color)
- (background light))
- (:foreground "red"))
- (t
- (:bold nil)))
- "Face used for displaying user defined pattern"
- :group 'liece-highlight-faces)
-
-(defface liece-quoted-bold-face
- '((t (:bold t)))
- "Face used for displaying \002 quoted string"
- :group 'liece-highlight-faces)
-
-(defface liece-quoted-inverse-face
- '((t (:inverse-video t)))
- "Face used for displaying \026 quoted string"
- :group 'liece-highlight-faces)
-
-(defface liece-quoted-underline-face
- '((t (:underline t)))
- "Face used for displaying \037 quoted string"
- :group 'liece-highlight-faces)
-
-(defcustom liece-highlight-font-lock-keywords
- (append
- ;; setting property occurred once
- (list
- `(,(concat
- "^\\(" liece-time-prefix-regexp "\\)?"
- "\\(\\([][<>(-][][<>(-]?[^ <>)]*[][<>)-][][<>)-]?\\)\\|"
- "\\(=[^ ]*=\\|\\*\\*[^ \*]*\\*\\*\\)\\) ")
- (3 liece-prefix-face append t)
- (4 liece-priv-prefix-face append t)
- ("\\(\002\\)\\([^\002\026\037\003]*\\)" nil nil
- (2 liece-quoted-bold-face t t))
- ("\\(\026\\)\\([^\002\026\037\003]*\\)" nil nil
- (2 liece-quoted-inverse-face t t))
- ("\\(\037\\)\\([^\002\026\037\003]*\\)" nil nil
- (2 liece-quoted-underline-face t t))))
- ;; set property whole line
- (mapcar
- (lambda (line)
- (cons
- (concat
- "^\\(" liece-time-prefix-regexp "\\)?\\("
- (regexp-quote
- (symbol-value (intern (format "liece-%s-prefix" line))))
- ".*\\)$")
- (list 2 (intern (format "liece-%s-face" line)) t t)))
- '(change notice broadcast wallops error info timestamp client dcc))
- '((eval . (cons liece-highlight-pattern liece-pattern-face))))
- "Normal and deformed faces for IRC normal line."
- :type '(repeat (list string))
- :group 'liece-highlight)
-
-(put 'liece-channel-mode 'font-lock-defaults
- '(liece-highlight-font-lock-keywords t))
-(put 'liece-others-mode 'font-lock-defaults
- '(liece-highlight-font-lock-keywords t))
-(put 'liece-dialogue-mode 'font-lock-defaults
- '(liece-highlight-font-lock-keywords t))
-
-;;; This is a kludge for fontifying buffer whose name starts with a space.
-;;; Font-lock isn't responsible for (maybe) invisible buffers.
-(defadvice font-lock-mode
- (around liece-replace-space-in-buffer-name activate)
- (if (char-equal (aref (buffer-name) 0) ? )
- (unwind-protect
- (progn
- (aset (buffer-name) 0 ?_)
- ad-do-it)
- (aset (buffer-name) 0 ? ))
- ad-do-it))
-
-(add-hook 'liece-after-load-startup-hook
- 'liece-highlight-maybe-turn-on-font-lock)
-
-(defun liece-highlight-maybe-turn-on-font-lock ()
- (when liece-highlight-mode
- (add-hook 'liece-channel-mode-hook
- 'liece-highlight-turn-on-font-lock)
- (add-hook 'liece-others-mode-hook
- 'liece-highlight-turn-on-font-lock)
- (add-hook 'liece-dialogue-mode-hook
- 'liece-highlight-turn-on-font-lock)
- (add-hook 'liece-after-insert-functions 'liece-url-add-buttons)
- (add-hook 'liece-after-insert-functions 'liece-channel-add-buttons)
- ;;(add-hook 'liece-after-insert-functions 'liece-nick-add-buttons)
- ))
-
-(defun liece-highlight-turn-on-font-lock ()
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(liece-highlight-font-lock-keywords t))
- (make-local-variable 'font-lock-verbose)
- (setq font-lock-verbose nil)
- (make-local-variable 'font-lock-support-mode)
- (setq font-lock-support-mode nil)
- (make-local-hook 'font-lock-mode-hook)
- (setq font-lock-mode-hook nil)
- (turn-on-font-lock)
- (make-local-hook 'after-change-functions)
- (or liece-display-prefix-tag
- (add-hook 'after-change-functions
- 'liece-highlight-maybe-hide-prefix nil 'local))
- (add-hook 'after-change-functions
- 'liece-highlight-colorize-quote nil 'local)
- (add-hook 'after-change-functions
- 'liece-highlight-maybe-hide-quote 'append 'local)
- (when (and (eq major-mode 'liece-dialogue-mode)
- (liece-functionp liece-highlight-jingle-function))
- (add-hook 'after-change-functions
- 'liece-highlight-maybe-play-jingle 'append 'local)))
-
-(defun liece-highlight-maybe-hide-prefix (st nd len)
- (save-excursion
- (goto-char st)
- (if (looking-at liece-generic-prefix-tag-regexp)
- (invisible-region
- (match-beginning 1) (match-end 1)))))
-
-(defun liece-highlight-maybe-hide-quote (st nd len)
- (save-excursion
- (goto-char st)
- (while (re-search-forward "[\002\026\037]\\|[\003\013][0-9:;<=]+" nd t)
- (invisible-region
- (match-beginning 0) (match-end 0)))))
-
-(defun liece-highlight-maybe-play-jingle (st nd len)
- (save-excursion
- (goto-char st)
- (when (re-search-forward
- (if (listp liece-highlight-pattern)
- (car liece-highlight-pattern)
- liece-highlight-pattern)
- nd t)
- (funcall liece-highlight-jingle-function))))
-
-(defun liece-highlight-colorize-quote (st nd len)
- (save-excursion
- (goto-char st)
- (let (num face faces vender name ovl)
- (while (re-search-forward "\\([\003\013][0-9:;<=]+\\)\\([^\002\026\037\003\013]*\\)" nd t)
- (setq ovl (make-overlay (match-beginning 2) (match-end 2))
- num (match-string 1)
- vender (cond ((eq ?\003 (aref num 0)) 'ircle)
- ((eq ?\013 (aref num 0)) 'mirc))
- num (if (< 57 (char-int (aref num 1)))
- (- (char-int (aref num 1)) 43)
- (string-to-int (substring num 1)))
- faces (nthcdr num (symbol-value
- (intern (format "liece-quoted-colors-%s"
- vender))))
- face (car faces))
- (when (stringp face)
- (setq face (make-face (intern (format "liece-quoted-color-%s-%d"
- vender num))))
- (set-face-foreground face (car faces))
- (setcar faces face))
- (overlay-put ovl 'face face)))))
-
-(provide 'liece-hilit)
-
-;;; liece-hilit.el ends here
+++ /dev/null
-;;; liece-inlines.el --- Inline macros for various use.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-globals)
-(require 'liece-compat)
-(require 'liece-setup)
-(require 'liece-vars)
-
-(eval-when-compile (require 'liece-clfns))
-
-;;; @ string functions
-;;;
-(defmacro string-times (str n)
- `(apply #'concat (make-list ,n ,str)))
-
-(defmacro string-join (strlst &optional del)
- `(mapconcat #'identity ,strlst ,del))
-
-(defmacro string-equal-ignore-case (s1 s2)
- `(string-equal (upcase ,s1) (upcase ,s2)))
-
-(defsubst string-list-member-ignore-case (thing list)
- "Returns t if thing is member of list, not funcallable"
- (member-if
- (lambda (item)
- (and (stringp item) (string-equal-ignore-case thing item)))
- list))
-
-(defsubst string-list-remove-ignore-case (thing list)
- (let ((element (string-list-member-ignore-case thing list)))
- (if element
- (remq (car element) list)
- list)))
-
-(defsubst string-list-delete-ignore-case (thing list)
- (let ((element (string-list-member-ignore-case thing list)))
- (if element
- (delq (car element) list)
- list)))
-
-(defsubst string-list-remove (thing list)
- (let ((element (member thing list)))
- (if element
- (remq (car element) list)
- list)))
-
-(defsubst string-list-delete (thing list)
- (let ((element (member thing list)))
- (if element
- (delq (car element) list)
- list)))
-
-(defsubst string-list-modify-ignore-case (modifiers list)
- (dolist (modifier modifiers)
- (let ((p list))
- (while p
- (if (string-equal-ignore-case (car modifier) (car p))
- (setcar p (cdr modifier)))
- (setq p (cdr p)))))
- list)
-
-(static-if (fboundp 'assoc-ignore-case)
- (defalias 'string-assoc-ignore-case 'assoc-ignore-case)
- (defsubst string-assoc-ignore-case (key list)
- (assoc-if
- (lambda (item) (string-equal-ignore-case item key))
- list)))
-
-(defsubst regexp-assoc-ignore-case (key list)
- "Assoc with REGEXP-KEY from LIST."
- (save-match-data
- (assoc-if
- (lambda (item)
- (string-match (concat "^" (upcase key)) "$") (upcase item))
- list)))
-
-(defsubst regexp-rassoc-ignore-case (key list)
- "Assoc with KEY from LIST, in which keys are regexps."
- (rassoc-if
- (lambda (item)
- (string-match (concat "^" (upcase key) "$") (upcase item)))
- list))
-
-(defmacro list-to-alist (list)
- `(mapcar #'list ,list))
-
-(put 'filter-elements 'lisp-indent-function 2)
-
-(defmacro filter-elements (element list condition)
- `(let (result tail ,element)
- (setq tail ,list)
- (while tail
- (setq ,element (car tail))
- (if ,condition
- (setq result (cons ,element result)))
- (setq tail (cdr tail)))
- (nreverse result)))
-
-\f
-;;; @ helper functions
-;;;
-(defmacro liece-functionp (form)
- `(or (and (symbolp ,form) (fboundp ,form))
- (and (listp ,form) (eq (car ,form) 'lambda))
- (byte-code-function-p ,form)))
-
-(defun liece-eval-form (form)
- (cond
- ((and (listp form) (liece-functionp (car form)))
- (eval form))
- ((and (symbolp form) (boundp form))
- (symbol-value form))
- (t form)))
-
-(defun liece-or (&rest elems)
- "Return non-nil if any of the elements are non-nil."
- (catch 'found
- (while elems
- (when (pop elems)
- (throw 'found t)))))
-
-(defun liece-and (&rest elems)
- "Return non-nil if all of the elements are non-nil."
- (catch 'found
- (while elems
- (unless (pop elems)
- (throw 'found nil)))
- t))
-
-(defun liece-locate-path (subdir &optional filename)
- (let ((dir (liece-locate-data-directory
- (downcase (product-name (product-find 'liece-version))))))
- (when (and dir (file-directory-p dir))
- (if filename
- (expand-file-name filename (concat dir subdir))
- (concat dir subdir)))))
-
-(defun liece-locate-icon-file (filename)
- (or liece-icon-directory
- (setq liece-icon-directory (liece-locate-path "icons")))
- (expand-file-name filename liece-icon-directory))
-
-(defmacro liece-next-line (arg)
- `(let ((i 0))
- (while (< i ,arg)
- (if (eobp) (newline)(next-line 1))
- (setq i (1+ i)))))
-
-;; Borrowed from `edebug.el'.
-(defvar liece-gensym-index 0
- "Integer used by `liece-gensym' to produce new names.")
-
-(defun liece-gensym (&optional prefix)
- "Generate a fresh uninterned symbol.
-There is an optional argument, PREFIX. PREFIX is the
-string that begins the new name. Most people take just the default,
-except when debugging needs suggest otherwise."
- (if (null prefix)
- (setq prefix "G"))
- (let ((newsymbol nil)
- (newname ""))
- (while (not newsymbol)
- (setq newname (concat prefix (int-to-string liece-gensym-index))
- liece-gensym-index (1+ liece-gensym-index))
- (if (not (intern-soft newname))
- (setq newsymbol (make-symbol newname))))
- newsymbol))
-
-(provide 'liece-inlines)
-
-;;; liece-inlines.el ends here
+++ /dev/null
-;;; liece-intl.el --- Localized messages for IRC.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-12-30
-;; Revised: 1999-09-03
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl)
- (require 'liece-compat))
-
-(require 'gettext)
-
-(defgroup liece-intl nil
- "Convert messages to localized them"
- :group 'liece-vars)
-
-(defcustom liece-intl-catalogue-directory nil
- "Normal position of PO files."
- :type 'directory
- :group 'liece-intl)
-
-(defcustom liece-intl-use-localized-messages t
- "If non-nil display localized messages."
- :type 'boolean
- :group 'liece-intl)
-
-(defvar liece-intl-message-alist nil)
-(defvar liece-intl-default-mime-charset 'x-ctext)
-(defvar liece-intl-mime-charset nil)
-(defvar liece-intl-domain "liece")
-
-;;;###liece-autoload
-(defmacro liece-intl-get-msgstr (msgid)
- `(if liece-intl-use-localized-messages
- (dgettext liece-intl-domain ,msgid)
- ,msgid))
-
-;;;###liece-autoload
-(defalias '_ 'liece-intl-get-msgstr)
-
-(defun liece-intl-load-catalogue ()
- (if (null liece-intl-catalogue-directory)
- (setq liece-intl-catalogue-directory
- (liece-locate-path "locale")))
- (bind-text-domain liece-intl-domain liece-intl-catalogue-directory))
-
-(provide 'liece-intl)
-
-;;; liece-intl.el ends here
+++ /dev/null
-;;; liece-mail.el --- Message composing and sending utility.
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-12-29
-;; Keywords: IRC, liece, Gnus
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-version)
-
-(defgroup liece-mail nil
- "Compose and send mail in IRC buffer"
- :group 'liece-vars)
-
-(defcustom liece-mail-draft-buffer " *mail*"
- "Generic draft buffer."
- :group 'liece-mail
- :type 'string)
-
-(defcustom liece-maintainer-address
- "liece@unixuser.org (Liece developers)"
- "The mail address of the Liece maintainers."
- :group 'liece-mail
- :type 'string)
-
-(defun liece-command-mail-compose (nick)
- (interactive
- (let ((completion-ignore-case t))
- (list
- (liece-minibuffer-completing-read
- "To whom: " liece-nick-alist nil nil nil nil liece-current-chat-partner))))
- (let ((composefunc (get mail-user-agent 'composefunc)) (to nick)
- (user-agent (liece-version)) uah)
- (if (setq uah (liece-nick-get-user-at-host nick))
- (setq to (concat to " <" uah ">")))
- (if (fboundp composefunc)
- (funcall composefunc to nil (` (("User-Agent" . (, user-agent))))))))
-
-(defun liece-command-submit-bug-report ()
- "Send a bug report to the Gnus maintainers."
- (interactive)
- (require 'reporter)
-
- (reporter-submit-bug-report
- liece-maintainer-address
- (liece-version)
- (let ((base (list 'window-system
- 'liece-highlight-mode
- 'liece-detect-coding-system)))
- base)))
-
-(provide 'liece-mail)
-
-;;; liece-mail.el ends here
+++ /dev/null
-;;; liece-make.el --- Generic make procedures.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-03-02
-;; Keywords: IRC, liece, APEL
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'cl)
-
-(defun install-just-print-p ()
- (let ((flag (getenv "MAKEFLAGS"))
- case-fold-search)
- (princ (format "%s\n" flag))
- (if flag
- (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
-
-(defun config-liece ()
- (let (prefix exec-prefix lisp-dir version-specific-lisp-dir)
- (and (setq prefix (car command-line-args-left))
- (or (string-equal "NONE" prefix)
- (setq PREFIX prefix)))
- (setq command-line-args-left (cdr command-line-args-left))
- (and (setq lisp-dir (car command-line-args-left))
- (or (string-equal "NONE" lisp-dir)
- (setq LISPDIR lisp-dir)))
- (setq command-line-args-left (cdr command-line-args-left))
- (and (setq version-specific-lisp-dir (car command-line-args-left))
- (or (string-equal "NONE" version-specific-lisp-dir)
- (progn
- (defvar VERSION_SPECIFIC_LISPDIR version-specific-lisp-dir)
- (princ (format "VERSION_SPECIFIC_LISPDIR=%s\n"
- VERSION_SPECIFIC_LISPDIR)))))
- (setq command-line-args-left (cdr command-line-args-left))
- (setq load-path (cons (expand-file-name ".") load-path))
- (load "liece-config")
- (or (boundp 'liece-modules-to-compile)
- (load "liece-modules"))
- (princ (format "PREFIX=%s\tLISPDIR=%s\n" PREFIX LISPDIR))))
-
-(defun compile-liece ()
- ;;(setq byte-compile-dynamic t)
- (config-liece)
- (compile-elisp-modules liece-modules-to-compile "."))
-
-(defun install-liece ()
- (compile-liece)
- (let ((just-print (install-just-print-p))
- (dir (expand-file-name "liece" LISPDIR)))
- (princ (format "%s\n" emacs-version))
- (install-elisp-modules liece-modules "." dir just-print)))
-
-(defun install-update-manifest-file (package dir &optional just-print)
- (message "Generating MANIFEST.%s for the package..." package)
- (unless just-print
- (with-temp-buffer
- (insert "pkginfo/MANIFEST." package "\n"
- "lisp/" package "/"
- (mapconcat #'identity
- (sort
- (mapcar (lambda (symbol)
- (format "%s.el\nlisp/%s/%s.elc"
- symbol package symbol))
- liece-modules-to-compile)
- #'string-lessp)
- (concat "\nlisp/" package "/"))
- "\n")
- (when (file-directory-p "../doc")
- (insert "info/"
- (mapconcat #'identity
- (sort
- (directory-files
- "../doc" nil liece-config-info-file-regexp)
- #'string-lessp)
- "\ninfo/")
- "\n"))
- (let ((dirs '("icons" "po" "styles")))
- (dolist (dir dirs)
- (when (file-directory-p (concat "../etc/" dir))
- (insert "etc/" package "/" dir "/"
- (mapconcat #'identity
- (sort (directory-files (concat "../etc/" dir)
- nil nil nil t)
- #'string-lessp)
- (concat "\netc/" package "/" dir "/"))
- "\n"))))
- (write-file (expand-file-name (concat "MANIFEST." package) dir)))))
-
-(defun install-update-package-files (package dir &optional just-print)
- (cond (just-print
- (princ (format "Updating autoloads in directory %s..\n\n" dir))
-
- (princ (format "Processing %s\n" dir))
- (princ "Generating custom-load.el...\n\n")
-
- (princ (format "Compiling %s...\n"
- (expand-file-name "auto-autoloads.el" dir)))
- (princ (format "Wrote %s\n"
- (expand-file-name "auto-autoloads.elc" dir)))
-
- (princ (format "Compiling %s...\n"
- (expand-file-name "custom-load.el" dir)))
- (princ (format "Wrote %s\n"
- (expand-file-name "custom-load.elc" dir))))
- (t
- (if (fboundp 'batch-update-directory-autoloads)
- (progn
- (setq command-line-args-left
- (cons package (cons dir command-line-args-left)))
- (batch-update-directory-autoloads))
- (setq autoload-package-name package)
- (add-to-list 'command-line-args-left dir)
- (batch-update-directory))
-
- (add-to-list 'command-line-args-left dir)
- (Custom-make-dependencies)
-
- (byte-compile-file (expand-file-name "auto-autoloads.el" dir))
- (byte-compile-file (expand-file-name "custom-load.el" dir)))))
-
-(defun config-liece-package-directory ()
- (if (boundp 'early-packages)
- (let ((dirs (append (if early-package-load-path
- early-packages)
- (if late-package-load-path
- late-packages)
- (if last-package-load-path
- last-packages)))
- dir)
- (while (and dirs (not (file-exists-p
- (setq dir (car dirs)))))
- (setq dirs (cdr dirs)))
- (defvar PACKAGEDIR dir)
- (princ (format "PACKAGEDIR=%s\n" PACKAGEDIR)))))
-
-(defun config-liece-package ()
- (let (package-dir)
- (and (setq package-dir (car command-line-args-left))
- (or (string= "NONE" package-dir)
- (defvar PACKAGEDIR package-dir)))
- (config-liece)
- (config-liece-package-directory)
- (setq command-line-args-left (cdr command-line-args-left))))
-
-(defun compile-liece-package ()
- (config-liece-package)
- (compile-elisp-modules liece-modules-to-compile "."))
-
-(defun install-liece-package ()
- (config-liece-package)
- (let ((just-print (install-just-print-p))
- (dir (expand-file-name "lisp/liece" PACKAGEDIR))
- (pkginfo-dir (expand-file-name "pkginfo" PACKAGEDIR)))
- (install-elisp-modules liece-modules "." dir just-print)
- (install-update-package-files "liece" dir just-print)
- (install-update-manifest-file "liece" pkginfo-dir just-print)))
-
-(defun autoload-liece ()
- (config-liece)
- (require 'autoload)
- (let* ((generated-autoload-file "liece-setup.el")
- (generate-autoload-cookie ";;;###liece-autoload")
- (buf (find-file-noselect generated-autoload-file))
- make-backup-files)
- (set-buffer buf)
- (delete-region (point-min) (point-max))
- (insert-string
- (format "(if (not (featurep '%s)) (progn\n"
- (file-name-sans-extension generated-autoload-file)))
- (mapcar
- (function
- (lambda (file)
- (generate-file-autoloads
- (concat (symbol-name file) ".el"))))
- liece-modules-to-compile)
- (goto-char (point-max))
- (insert-string
- (format "(provide '%s)))\n"
- (file-name-sans-extension generated-autoload-file)))
- (save-buffer)))
-
-(provide 'liece-make)
-
-;;; liece-make.el ends here
+++ /dev/null
-;;; liece-menu.el --- Define menus.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-09-06
-;; Revised: 1999-09-06
-;; Keywords: menu, easymenu
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'easymenu)
- (require 'advice)
- (require 'liece-compat)
- (require 'liece-commands)
- (require 'liece-intl)
- (require 'liece-nick))
-
-(defvar liece-use-localized-menu (featurep 'meadow))
-
-(defvar liece-nick-popup-menu
- '("Liece"
- ["Finger" liece-menu-callback-finger
- liece-nick-region-nicks]
- "----"
- ["CTCP VERSION" liece-menu-callback-ctcp-version
- liece-nick-region-nicks]
- ["CTCP USERINFO" liece-menu-callback-ctcp-userinfo
- liece-nick-region-nicks]
- ["CTCP HELP" liece-menu-callback-ctcp-help
- liece-nick-region-nicks]
- ["CTCP CLIENTINFO" liece-menu-callback-ctcp-clientinfo
- liece-nick-region-nicks]
- ["CTCP PING" liece-menu-callback-ctcp-ping
- liece-nick-region-nicks]
- "----"
- ["Set Channel Operator(s)" liece-menu-callback-set-operators
- liece-nick-region-nicks]
- ["Set Channel Voice(s)" liece-menu-callback-set-voices
- liece-nick-region-nicks]
- ["Unset Channel Operator(s)" liece-menu-callback-unset-operators
- liece-nick-region-nicks]
- ["Unset Channel Voice(s)" liece-menu-callback-unset-voices
- liece-nick-region-nicks]
- "----"
- ["Kick" liece-menu-callback-kick
- liece-nick-region-nicks]))
-
-(defvar liece-menu-url-menu '("URL" "----"))
-(defvar liece-menu-dcc-menu
- '("DCC"
- ["Send file" liece-command-dcc-send t]
- ["Receive file" liece-command-dcc-receive t]
- "----"
- ["Send chat request" liece-command-dcc-chat-listen t]
- ["Accept chat request" liece-command-dcc-chat-connect t]
- "----"
- ["List DCC request" liece-command-dcc-list t]
- ["Dispatch stacked DCC requests" liece-command-dcc-accept t]))
-
-(defvar liece-menu-private-menu
- '("Private"
- ["Toggle private conversation" liece-command-toggle-private
- (liece-server-opened)]
- ["IsON" liece-command-ison (liece-server-opened)]
- ["Register friends" liece-command-activate-friends t]
- ["Unregister friends" liece-command-deactivate-friends t]
- ["Display userhost" liece-command-userhost (liece-server-opened)]
- ["Ignore nicks / regexp" liece-command-kill t]
- ["Compose mail" liece-command-mail-compose t]))
-
-(defvar liece-menu-ctcp-menu
- '("CTCP"
- ["ACTION" liece-command-ctcp-action
- liece-current-channel]
- ["VERSION" liece-command-ctcp-version
- liece-current-channel]
- ["USERINFO" liece-command-ctcp-userinfo
- liece-current-channel]
- ["HELP" liece-command-ctcp-help
- liece-current-channel]
- ["CLIENTINFO" liece-command-ctcp-clientinfo
- liece-current-channel]
- ["PING" liece-command-ctcp-ping
- liece-current-channel]
- "----"
- ["Request X-Face" liece-command-ctcp-x-face
- liece-current-channel]
- ["Set my X-Face" liece-command-ctcp-x-face-from-xbm-file
- liece-current-channel]))
-
-(defvar liece-menu-channel-menu
- (nconc
- '("Channel"
- ["Join channel" liece-command-join
- (liece-server-opened)]
- ["Part channel" liece-command-part
- (or liece-current-channels liece-current-chat-partners)]
- ["Go to next channel" liece-command-next-channel
- (or liece-current-channels liece-current-chat-partners)]
- ["Go to previous channel" liece-command-previous-channel
- (or liece-current-channels liece-current-chat-partners)]
- ["Go to unread channel" liece-command-unread-channel
- (or liece-current-channels liece-current-chat-partners)]
- ["Rotate left channels" liece-command-pop
- (or liece-current-channels liece-current-chat-partners)]
- ["Rotate right channels" liece-command-push
- (or liece-current-channels liece-current-chat-partners)]
- "----"
- ["Invite to this channel" liece-command-invite
- liece-current-channel]
- ["Kick out from this channel" liece-command-kick
- liece-current-channel]
- "----"
- ["Set mode of this channel" liece-command-modec
- liece-current-channel]
- ["Set topic of this channel" liece-command-topic
- liece-current-channel]
- "----"
- ["Toggle freeze of this channel" liece-command-freeze
- liece-current-channel]
- ["Toggle own freeze of this channel" liece-command-own-freeze
- liece-current-channel]
- ["Toggle beep notice of this channel" liece-dialogue-beep
- liece-current-channel]
- "----"
- ["List channel" liece-command-list
- (liece-server-opened)]
- ["Display names of channel" liece-command-names
- (liece-server-opened)]
- ["Display who are on the channel" liece-command-names
- (liece-server-opened)]
- "----"
- ["Set default key of this channel" liece-command-set-default-key
- (or liece-current-channel liece-current-chat-partner)]
- "----")
- (list liece-menu-ctcp-menu)))
-
-(defvar liece-menu-IRC-menu
- '("IRC"
- ["Load variables file" liece-command-load-vars t]
- ["Save variables file" liece-command-save-vars t]
- "----"
- ["Change window style" liece-command-set-window-style t]
- ["Reload style file" liece-command-reload-window-style t]
- ["Reconfigure windows" liece-command-reconfigure-windows t]
- ["Toggle channel buffer display state"
- liece-command-toggle-channel-buffer-mode t]
- ["Toggle nick buffer display state"
- liece-command-toggle-nick-buffer-mode t]
- "----"
- ["Enter debug mode" liece-command-debug t]
- ["Quit IRC" liece-command-quit t]))
-
-(defvar liece-menu-alist
- '(
- (liece-menu-IRC-menu "IRC Menu.")
- (liece-menu-channel-menu "Channel Menu.")
- (liece-menu-private-menu "Private Menu.")
- (liece-menu-dcc-menu "DCC Menu.")
- (liece-menu-url-menu "URL Menu.")))
-
-(defvar liece-menu-IRC-menu-map)
-(defvar liece-menu-channel-menu-map)
-(defvar liece-menu-private-menu-map)
-(defvar liece-menu-dcc-menu-map)
-(defvar liece-menu-url-menu-map)
-
-;;; @ popup menus
-;;;
-(defmacro liece-menu-bogus-filter-constructor (name menu)
- `(let (x y)
- (setq x (x-popup-menu t ,menu)
- y (and x (lookup-key ,menu (apply #'vector x))))
- (if (and x y)
- (funcall y))))
-
-(defmacro liece-menu-popup-menu (event menu)
- (if (featurep 'xemacs)
- `(popup-menu ,menu)
- `(let (bogus-menu)
- (easy-menu-define bogus-menu nil nil ,menu)
- (liece-menu-bogus-filter-constructor "Popup" bogus-menu))))
-
-(defun liece-nick-popup-menu (widget &optional event)
- (let ((menu (copy-sequence liece-nick-popup-menu))
- (pos (widget-event-point event)))
- (when pos
- (goto-char pos)
- (if (eq major-mode 'liece-nick-mode)
- (liece-nick-update-region))
- (liece-menu-popup-menu event menu))))
-
-;;; @ initialize menus
-;;;
-(when (or (featurep 'menubar); XEmacs
- (featurep 'menu-bar))
- (add-hook 'liece-command-mode-hook 'liece-command-define-menus)
- (add-hook 'liece-command-mode-hook 'liece-command-add-menus 'append)
- (add-hook 'liece-add-url-functions 'liece-menu-add-url))
-
-(defun liece-menu-define (menu)
- (eval (list 'easy-menu-define
- (intern (concat (symbol-name (car menu)) "-map"))
- 'liece-command-mode-map (cadr menu)
- '(symbol-value (car menu)))))
-
-(defun liece-command-define-menus-1 (value)
- (dolist (spec value)
- (cond
- ((stringp spec))
- ((vectorp spec)
- (when liece-use-localized-menu
- (aset spec 0 (liece-intl-get-msgstr (aref spec 0)))))
- ((listp spec)
- (liece-command-define-menus-1 spec)))))
-
-(defun liece-command-define-menus ()
- (dolist (menu (reverse liece-menu-alist))
- (let ((value (symbol-value (car menu))))
- (liece-command-define-menus-1 value)
- (liece-menu-define menu))))
-
-(defun liece-command-add-menus ()
- (dolist (menu liece-menu-alist)
- (easy-menu-add (symbol-value (car menu)) liece-command-mode-map)))
-
-(defun liece-menu-add-url (url)
- (when (boundp 'liece-menu-url-menu-map)
- (with-current-buffer liece-command-buffer
- (easy-menu-add-item
- nil (list (car liece-menu-url-menu))
- (vector url (list 'liece-command-browse-url url) t)))))
-
-;;; @ menu callbacks
-;;;
-(autoload 'liece-menu-callback-ctcp-version "liece-ctcp" nil t)
-(autoload 'liece-menu-callback-ctcp-userinfo "liece-ctcp" nil t)
-(autoload 'liece-menu-callback-ctcp-help "liece-ctcp" nil t)
-(autoload 'liece-menu-callback-ctcp-clientinfo "liece-ctcp" nil t)
-(autoload 'liece-menu-callback-ctcp-ping "liece-ctcp" nil t)
-
-(defun liece-menu-callback-finger ()
- (interactive)
- (dolist (nick liece-nick-region-nicks)
- (liece-command-finger nick)))
-
-(defun liece-menu-callback-kick ()
- (interactive)
- (dolist (nick liece-nick-region-nicks)
- (liece-command-kick nick)))
-
-(defun liece-menu-callback-set-operators ()
- (interactive)
- (let ((opers (liece-channel-get-operators)))
- (setq liece-nick-region-nicks
- (filter-elements nick liece-nick-region-nicks
- (not (liece-nick-member nick opers)))))
- (liece-command-set-operators liece-nick-region-nicks))
-
-(defun liece-menu-callback-set-voices ()
- (interactive)
- (let ((voices (liece-channel-get-voices)))
- (setq liece-nick-region-nicks
- (filter-elements nick liece-nick-region-nicks
- (not (liece-nick-member nick voices)))))
- (liece-command-set-voices liece-nick-region-nicks))
-
-(defun liece-menu-callback-unset-operators ()
- (interactive)
- (let ((opers (liece-channel-get-operators)))
- (setq liece-nick-region-nicks
- (filter-elements nick liece-nick-region-nicks
- (liece-nick-member nick opers))))
- (liece-command-set-operators liece-nick-region-nicks t))
-
-(defun liece-menu-callback-unset-voices ()
- (interactive)
- (let ((voices (liece-channel-get-voices)))
- (setq liece-nick-region-nicks
- (filter-elements nick liece-nick-region-nicks
- (liece-nick-member nick voices))))
- (liece-command-set-voices liece-nick-region-nicks t))
-
-(provide 'liece-menu)
-
-;;; liece-menu.el ends here
+++ /dev/null
-;;; liece-message.el --- generate and display message line
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-05-30
-;; Keywords: message
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'liece-misc))
-
-(defgroup liece-message nil
- "Messages"
- :tag "Message"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-message-brackets
- '(((type notice)
- ("-" "-"))
- ((and (type action) (direction outgoing))
- ("]" "["))
- ((type action)
- ("[" "]"))
- ((and (range private) (direction incoming))
- ("=" "="))
- ((direction outgoing)
- (">" "<"))
- ((range external)
- ("(" ")"))
- (t
- ("<" ">")))
- "Brackets."
- :group 'liece-message)
-
-(defcustom liece-message-tags
- '(((and (direction outgoing) (range private))
- (liece-message-target liece-message-target))
- ((range private)
- (liece-message-speaker liece-message-speaker))
- (t
- (liece-message-speaker
- (concat liece-message-target ":" liece-message-speaker))))
- "Primary tags."
- :group 'liece-message)
-
-(defcustom liece-message-empty-predicate
- (function (lambda (message) (string-equal "" message)))
- "Return non-nil if message is regarded as empty string."
- :group 'liece-message)
-
-(defvar liece-message-type nil)
-(defvar liece-message-target nil)
-(defvar liece-message-speaker nil)
-(defvar liece-message-direction nil)
-
-(defun liece-message-predicate (val)
- (cond
- ((null val)
- nil)
- ((eq val t)
- t)
- ((listp val)
- (let ((pred (pop val)))
- (cond
- ((eq pred 'or)
- (apply 'liece-or (mapcar 'liece-message-predicate val)))
- ((eq pred 'and)
- (apply 'liece-and (mapcar 'liece-message-predicate val)))
- ((eq pred 'not)
- (not (liece-message-predicate (car val))))
- ((eq pred 'type)
- (eq liece-message-type (car val)))
- ((eq pred 'direction)
- (cond
- ((eq (car val) 'outgoing)
- liece-message-direction)
- ((eq (car val) 'incoming)
- (not liece-message-direction))))
- ((eq pred 'mode)
- (eq liece-command-buffer-mode (car val)))
- ((eq pred 'range)
- (cond
- ((eq (car val) 'private)
- (not (liece-channel-p (liece-channel-real liece-message-target))))
- ((eq (car val) 'external)
- (not (liece-channel-member
- liece-message-target (liece-nick-get-joined-channels
- liece-message-speaker))))))
- ((liece-functionp pred)
- (liece-eval-form (cons pred val)))
- (t
- (liece-message-predicate pred)))))
- (t
- (liece-eval-form val))))
-
-(defun liece-message-brackets-function ()
- (let* ((specs liece-message-brackets) spec
- (brackets
- (catch 'found
- (while specs
- (setq spec (pop specs))
- (if (liece-message-predicate (car spec))
- (throw 'found (cadr spec)))))))
- brackets))
-
-(defun liece-message-tags-function ()
- (let* ((specs liece-message-tags) spec
- (tags
- (catch 'found
- (while specs
- (setq spec (pop specs))
- (if (liece-message-predicate (car spec))
- (throw 'found (cadr spec)))))))
- (list (eval (car tags)) (eval (cadr tags)))))
-
-(defun liece-message-buffer-function ()
- (let* ((target (if (liece-message-predicate
- '(and (range private) (direction incoming)))
- liece-message-speaker
- liece-message-target))
- (buffer (liece-pick-buffer target)))
- (cond
- ((car buffer) buffer)
- (liece-auto-join-partner
- (liece-channel-prepare-partner target)
- (liece-pick-buffer target)))))
-
-(defun liece-message-parent-buffer (cbuffer)
- (if (or (and (car cbuffer) (liece-frozen (car cbuffer)))
- (and (eq liece-command-buffer-mode 'channel)
- liece-current-channel
- (not (liece-channel-equal liece-message-target
- liece-current-channel)))
- (and (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partner
- (not (eq liece-message-direction 'outgoing))
- (or
- (not (liece-nick-equal liece-message-speaker
- liece-current-chat-partner))
- (not (liece-nick-equal liece-message-target
- (liece-current-nickname))))))
- (append liece-D-buffer liece-O-buffer)
- liece-D-buffer))
-
-;;;###liece-autoload
-(defun liece-display-message (temp)
- (let* ((brackets (liece-message-brackets-function))
- (tags (liece-message-tags-function))
- (buffer (liece-message-buffer-function))
- (parent (liece-message-parent-buffer buffer)))
- (liece-insert buffer
- (concat (car brackets) (car tags) (cadr brackets)
- " " temp "\n"))
- (liece-insert parent
- (concat (car brackets) (cadr tags) (cadr brackets)
- " " temp "\n"))
- (run-hook-with-args 'liece-display-message-hook temp)))
-
-(provide 'liece-message)
-
-;;; liece-message.el ends here
+++ /dev/null
-;;; liece-minibuf.el --- Minibuffer custom completion.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-02-02
-;; Revised: 1999-02-02
-;; Keywords: minibuffer, completion
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-compat)
-(require 'liece-intl)
-(require 'liece-nick)
-(eval-when-compile
- (require 'liece-channel)
- (require 'liece-inlines))
-
-(defvar liece-minibuffer-map nil)
-(defvar liece-minibuffer-complete-function nil)
-
-(autoload 'completing-read-multiple "crm")
-(defvar crm-separator)
-
-(unless liece-minibuffer-map
- (setq liece-minibuffer-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map " " nil)
- (define-key map "\t" 'liece-minibuffer-complete)
- (define-key map "\r" 'exit-minibuffer)
- (define-key map "\n" 'exit-minibuffer)
- map)))
-
-(defun liece-minibuffer-complete ()
- (interactive)
- (if (and liece-minibuffer-complete-function
- (fboundp liece-minibuffer-complete-function))
- (funcall liece-minibuffer-complete-function)))
-
-(defun liece-minibuffer-parse-modes ()
- (save-excursion
- (let (preceding-char (state 'flag) type)
- (beginning-of-buffer)
- (while (not (eobp))
- (forward-char)
- (setq preceding-char (char-before))
- (cond
- ((and (eq state 'flag) (memq preceding-char '(+ ?-)))
- (setq state 'mode
- type nil))
- ((and (eq state 'mode) (eq preceding-char ? ))
- (setq state 'arg))
- ((and (eq state 'mode) (memq preceding-char '(?o ?v)))
- (setq type (nconc type (list 'nick preceding-char
- (char-before (1- (point)))))))
- ((and (eq state 'mode) (eq preceding-char ?b))
- (setq type (nconc type (list 'ban (char-before (1- (point)))))))))
- (cons state type))))
-
-(defun liece-minibuffer-prepare-candidate ()
- (let ((point (point)))
- (skip-syntax-backward "^ ")
- (prog1 (buffer-substring (point) point)
- (goto-char point))))
-
-(defun liece-minibuffer-delete-candidate ()
- (let ((point (point)))
- (skip-syntax-backward "^ ")
- (delete-region (point) point)))
-
-(defun liece-minibuffer-finalize-completion (completion pattern all)
- (cond
- ((eq completion t))
- ((null completion)
- (temp-minibuffer-message (_ "[No match]")))
- ((not (string= pattern completion))
- (liece-minibuffer-delete-candidate)
- (insert completion))
- (t
- (with-output-to-temp-buffer "*Completions*"
- (funcall completion-display-completion-list-function
- (sort all (function (lambda (x y)
- (string-lessp
- (or (car-safe x) x)
- (or (car-safe y) y))))))))))
-
-(defun liece-minibuffer-complete-channel-modes ()
- (let* ((preceding-char (char-before)) completion candidate all
- (modes (mapconcat
- (function car)
- liece-supported-channel-mode-alist ""))
- (nicks (liece-channel-get-nicks))
- uahs
- (context (liece-minibuffer-parse-modes))
- (state (car context)) (type (cdr context)))
- (cond
- ((memq state '(flag mode))
- (temp-minibuffer-message
- (format (_ "[Modes are: %s]") modes)))
- ((and (eq state 'arg) (memq 'ban type))
- (if (memq ?- type)
- (setq uahs (list-to-alist (liece-channel-get-bans)))
- (setq uahs (mapcar
- (function
- (lambda (nick)
- (list (concat nick "!"
- (liece-nick-get-user-at-host nick)))))
- nicks)))
- (setq candidate (liece-minibuffer-prepare-candidate)
- completion (try-completion candidate uahs)
- all (all-completions candidate uahs)))
- ((and (eq state 'arg) (memq 'nick type))
- (let* ((masks (cond ((memq ?o type) (liece-channel-get-operators))
- ((memq ?v type) (liece-channel-get-voices))))
- (nicks
- (if (memq ?- type)
- masks
- (remove-if
- `(lambda (item)
- (and (stringp item)
- (string-list-member-ignore-case item ',masks)))
- nicks))))
- (setq nicks (mapcar (function list) nicks)
- candidate (liece-minibuffer-prepare-candidate)
- completion (try-completion candidate nicks)
- all (all-completions candidate nicks)))))
- (liece-minibuffer-finalize-completion completion candidate all)))
-
-(defun liece-minibuffer-complete-user-modes ()
- (temp-minibuffer-message
- (format
- (_ "[Modes are: %s]")
- (mapconcat (function car) liece-supported-user-mode-alist ""))))
-
-(defun liece-minibuffer-completing-read
- (prompt table &optional predicate require-match initial-input history
- default)
- (let ((result
- (completing-read
- (if default
- (format "%s(default %s) " prompt default)
- prompt)
- table predicate require-match initial-input history)))
- (if (and default (equal result ""))
- default
- result)))
-
-(defvar liece-minibuffer-completion-separator ","
- "Separator used for separating strings in `liece-minibuffer-completing-read-multiple'.
-It should be regular expression which doesn't match word-continuent characters.")
-
-(defvar liece-minibuffer-completion-table nil)
-
-(defun liece-minibuffer-completing-read-multiple-1 (string predicate flag)
- "Function used by `liece-minibuffer-completing-read-multiple'.
-The value of STRING is the string to be completed.
-
-The value of PREDICATE is a function to filter possible matches, or
-nil if none.
-
-The value of FLAG is used to specify the type of completion operation.
-A value of nil specifies `try-completion'. A value of t specifies
-`all-completions'. A value of lambda specifes a test for an exact match.
-
-For more information on STRING, PREDICATE, and FLAG, see the Elisp
-Reference sections on 'Programmed Completion' and 'Basic Completion
-Functions'."
- (let ((except
- (split-string string liece-minibuffer-completion-separator))
- (table
- (copy-sequence liece-minibuffer-completion-table))
- lead)
- ;; Remove a partially matched word construct if it exists.
- (or (string-match
- (concat liece-minibuffer-completion-separator "$")
- string)
- (setq except (butlast except)))
- (when (string-match
- (concat ".*" liece-minibuffer-completion-separator)
- string)
- (setq lead (substring string 0 (match-end 0))
- string (substring string (match-end 0))))
- (while except
- (setq table (remassoc (car except) table)
- except (cdr except)))
- (if (null flag)
- (progn
- (setq string (try-completion string table predicate))
- (or (eq t string)
- (concat lead string)))
- (if (eq flag 'lambda)
- (eq t (try-completion string table predicate))
- (if flag
- (all-completions string table predicate))))))
-
-(defun liece-minibuffer-completing-read-multiple
- (prompt table &optional predicate require-match initial-input
- history default multiple-candidate)
- "Execute `completing-read' consequently.
-
-See the documentation for `completing-read' for details on the arguments:
-PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HISTORY, DEFAULT."
- (let ((prompt
- (format "%s(punctuate by \"%s\") "
- prompt liece-minibuffer-completion-separator)))
- (if multiple-candidate
- (let ((crm-separator
- liece-minibuffer-completion-separator))
- (completing-read-multiple
- prompt table predicate require-match initial-input
- history default))
- (let ((liece-minibuffer-completion-table
- table))
- (split-string
- (liece-minibuffer-completing-read
- prompt #'liece-minibuffer-completing-read-multiple-1
- predicate require-match initial-input history default)
- liece-minibuffer-completion-separator)))))
-
-(provide 'liece-minibuf)
-
-;;; liece-minibuf.el ends here
+++ /dev/null
-;;; liece-misc.el --- Miscellaneous routines.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-and-compile
- (require 'invisible)
- (require 'liece-inlines)
- (require 'liece-coding))
-
-(eval-when-compile
- (autoload '_ "liece-intl" nil nil 'macro))
-
-(defmacro liece-insert-change (buffer msg)
- `(liece-insert ,buffer (concat liece-change-prefix ,msg)))
-
-(defmacro liece-insert-notice (buffer msg)
- `(liece-insert ,buffer (concat liece-notice-prefix ,msg)))
-
-(defmacro liece-insert-broadcast (buffer msg)
- `(liece-insert ,buffer (concat liece-broadcast-prefix ,msg)))
-
-(defmacro liece-insert-wallops (buffer msg)
- `(liece-insert ,buffer (concat liece-wallops-prefix ,msg)))
-
-(defmacro liece-insert-error (buffer msg)
- `(liece-insert ,buffer (concat liece-error-prefix ,msg)))
-
-(defmacro liece-insert-info (buffer msg)
- `(liece-insert ,buffer (concat liece-info-prefix ,msg)))
-
-(defmacro liece-insert-timestamp (buffer msg)
- `(liece-insert ,buffer (concat liece-timestamp-prefix ,msg)))
-
-(defmacro liece-insert-dcc (buffer msg)
- `(liece-insert ,buffer (concat liece-dcc-prefix ,msg)))
-
-(defmacro liece-insert-client (buffer msg)
- `(liece-insert ,buffer (concat liece-client-prefix ,msg)))
-
-(defun liece-toggle-command-buffer-mode (&optional mode)
- "Toggle command buffer MODE."
- (let ((mode
- (or mode
- (if (eq liece-command-buffer-mode 'chat)
- 'channel
- 'chat)))
- (hide (get 'liece-nick-buffer-mode 'hide)))
- (cond
- ((eq mode 'chat)
- (put 'liece-nick-buffer-mode 'hide t)
- (setq liece-private-indicator "P"))
- (t
- (put 'liece-nick-buffer-mode 'hide nil)
- (setq liece-private-indicator "-")))
- (and (not (eq liece-command-buffer-mode mode))
- (not (eq hide (get 'liece-nick-buffer-mode 'hide)))
- liece-nick-window-auto-hide
- (liece-configure-windows))
- (setq liece-command-buffer-mode mode)
- liece-command-buffer-mode))
-
-(defsubst liece-set-frame-title-format ()
- "Inline function for modifying `frame-title-format'."
- (let ((frame-indicator liece-channel-indicator))
- (when (eq liece-command-buffer-mode 'channel)
- (if liece-display-status-on-channel-indicator
- (setq frame-indicator liece-channel-indicator)
- (setq frame-indicator
- (format "%s: %s [%s]"
- liece-channel-indicator
- (or (and liece-current-channel
- (liece-channel-get-topic))
- "")
- (or (and liece-current-channel
- (liece-channel-get-modes))
- "")))))
- (setq liece-channel-status-indicator frame-indicator)))
-
-(defsubst liece-set-channel-indicator ()
- "Inline-function for modifying `liece-channel-indicator'."
- (if (eq liece-command-buffer-mode 'chat)
- (setq liece-channel-indicator
- (if liece-current-chat-partner
- (format (_ "Chatting with %s")
- liece-current-chat-partner)
- (_ "No partner")))
- (setq liece-channel-indicator
- (if liece-current-channel
- (concat liece-current-channel
- (if liece-display-status-on-channel-indicator
- (format ": %s [%s]"
- (or (and liece-current-channel
- (liece-channel-get-topic))
- "")
- (or (and liece-current-channel
- (liece-channel-get-modes))
- ""))
- ""))
- (_ "No channel"))))
- (with-current-buffer liece-command-buffer
- (force-mode-line-update))
- (if liece-display-frame-title
- (liece-set-frame-title-format)))
-
-(defun liece-set-beep (buffer &optional arg)
- (with-current-buffer buffer
- (setq liece-beep (if arg (plusp arg) (not liece-beep))
- liece-beep-indicator (if liece-beep "B" "-"))
- (force-mode-line-update)))
-
-(defmacro liece-beep (&optional arg)
- (list 'funcall 'liece-beep-function arg))
-
-(defun liece-freeze (buffer &optional arg)
- (with-current-buffer buffer
- (setq liece-freeze (if arg (plusp arg) (not liece-freeze))
- liece-freeze-indicator (if liece-freeze "F" "-"))
- (force-mode-line-update)))
-
-(defun liece-frozen (buffer)
- (with-current-buffer buffer liece-freeze))
-
-(defun liece-own-freeze (buffer &optional arg)
- (with-current-buffer buffer
- (setq liece-own-freeze (if arg (plusp arg) (not liece-own-freeze))
- liece-own-freeze-indicator (if liece-own-freeze "M" "-"))
- (force-mode-line-update)))
-
-(defun liece-own-frozen (buffer)
- (with-current-buffer buffer liece-own-freeze))
-
-(defun liece-ignore-this-p (nick user-at-host)
- ;; Remove entries which are expired.
- (let ((time (current-time)) expire-time)
- (dolist (kill liece-kill-nickname)
- (setq expire-time (if (cdr kill)
- (liece-time-difference time (cdr kill))
- 1))
- (when (< expire-time 0)
- (if (zerop (cadddr kill))
- (liece-insert-info liece-D-buffer
- (format (_ "Ignore timeout for %s expired.\n")
- (car kill))))
- (when (setq kill (string-assoc-ignore-case
- (car kill) liece-kill-nickname))
- (setq liece-kill-nickname (delq kill liece-kill-nickname)
- liece-save-variables-are-dirty t)))))
- ;; Search on `liece-kill-nickname' and return non-nil if matches.
- (unless (run-hook-with-args-until-success
- 'liece-custom-ignore-this-p nick user-at-host)
- (let ((case-fold-search t))
- (member-if
- (lambda (kill)
- (or (liece-nick-equal (car kill) nick)
- (string-match (concat "\\<" (car kill) "\\>") nick)
- (and (string-match "@" (car kill))
- (or (string-equal-ignore-case
- (car kill) user-at-host)
- (string-match (concat "^" (car kill) "$")
- user-at-host)))))
- liece-kill-nickname))))
-
-(defun liece-split-line (line)
- (cond
- ((eq ?: (aref line 0))
- (list (substring line 1)))
- (t
- (let (args)
- (catch 'done
- (while (string-match "^\\([^ ]+\\) +" line)
- (setq args (nconc args (list (match-string 1 line)))
- line (substring line (match-end 0)))
- (and (not (string= "" line)) (eq ?: (aref line 0))
- (setq line (substring line 1))
- (throw 'done nil))))
- (or (string= "" line)
- (setq args (nconc args (list line))))
- args))))
-
-(defmacro liece-message (&rest message)
- `(message "%s: %s"
- (product-name (product-find 'liece-version))
- (format ,@message)))
-
-(defmacro liece-own-channel-message (message &optional chnl)
- `(let* ((chnl (or ,chnl (liece-current-channel)))
- (liece-message-target chnl)
- (liece-message-speaker (liece-current-nickname))
- (liece-message-direction 'outgoing))
- (liece-display-message ,message)))
-
-(defmacro liece-own-private-message (message &optional partner)
- `(let* ((partner (or ,partner liece-current-chat-partner))
- (liece-message-target partner)
- (liece-message-speaker (liece-current-nickname))
- (liece-message-direction 'outgoing))
- (liece-display-message ,message)))
-
-(defmacro liece-own-message (message)
- `(if (eq liece-command-buffer-mode 'channel)
- (liece-own-channel-message ,message)
- (liece-own-channel-message ,message)))
-
-(defvar liece-idle-point nil "Timestamp of last idle reset.")
-
-(defmacro liece-reset-idle ()
- "Reset idle counter and return last idle."
- '(prog1 (liece-idle) (setq liece-idle-point (current-time))))
-
-(defmacro liece-idle ()
- "How long has liece been idle."
- '(if liece-idle-point
- (liece-time-difference liece-idle-point (current-time))
- 9999999))
-
-(defmacro liece-ping-if-idle (&optional limit)
- `(if (<= (liece-idle) (or ,limit 120))
- nil
- (liece-command-ping)
- t))
-
-(defmacro liece-convert-received-input (input)
- "Convert input before it is processed"
- `(let ((conv-list liece-receive-convert-list)
- (input ,input)
- i f s s1 s2)
- (while (and conv-list (not liece-polling))
- (setq i (car conv-list)
- f (car i)
- s (cadr i)
- s1 (if (stringp f) f (funcall f input))
- s2 (if (stringp s) s (funcall s s1))
- input (replace-in-string input s1 s2)
- conv-list (cdr conv-list)))
- input))
-
-(defun liece-send (&rest args)
- "Send message to IRC server."
- (liece-reset-idle)
- (let ((string (apply #'format args)) send-string len)
- (dolist (convert liece-send-convert-list)
- (setq string (apply #'replace-in-string string convert)))
- (with-current-buffer liece-command-buffer
- (setq send-string (liece-coding-encode-charset-string string)
- send-string (if (string-match "\r$" send-string) send-string
- (concat send-string "\r\n"))
- len (length send-string)))
- (if (< len 512)
- (process-send-string liece-server-process send-string)
- (message "Protocol message too long (%d). Truncated." len)
- (if liece-beep-on-bells (beep)))
- (if (string-match "^list\\s-*" (setq string (downcase string)))
- (setq liece-channel-filter (substring string (match-end 0))))))
-
-(defmacro liece-send-pong ()
- '(liece-send "PONG :%s" liece-tmp-server-name))
-
-(defmacro liece-increment-long-reply-count ()
- '(incf liece-long-reply-count))
-
-(defmacro liece-reset-long-reply-count ()
- '(setq liece-long-reply-count 0))
-
-(defmacro liece-check-long-reply-count ()
- '(when (> liece-long-reply-count liece-long-reply-max)
- (liece-reset-long-reply-count)
- (liece-send-pong)))
-
-(defmacro liece-server-host ()
- '(if (listp liece-server)
- (plist-get liece-server ':host)
- (if (or (string-match "^\\[\\([^]]+\\)\\]:?[0-9]*" liece-server)
- (string-match "^\\([^:]+\\):?[0-9]*" liece-server))
- (match-string 1 liece-server)
- liece-server)))
-
-(defmacro liece-clean-hostname (hostname)
- "Return the arg HOSTNAME, but if is a dotted-quad, put brackets around it."
- `(save-match-data
- (if (string-match "[0-9]+\\.[0-9]+\\.[0-9]+\\.[0-9]+" ,hostname)
- (concat "[" ,hostname "]")
- ,hostname)))
-
-(defun liece-current-nickname ()
- "Return the current nickname."
- liece-real-nickname)
-
-(defun liece-current-channel ()
- "Return the current channel."
- liece-current-channel)
-
-(defun liece-current-channels ()
- "Return the current channels."
- liece-current-channels)
-
-(defun liece-current-chat-partner ()
- "Return the current chat partner."
- liece-current-chat-partner)
-
-(defun liece-current-chat-partners ()
- "Return the current chat partners."
- liece-current-chat-partners)
-
-(defmacro liece-scroll-if-visible (window)
- `(if ,window (set-window-point ,window (point-max))))
-
-(defmacro liece-pick-buffer-1 (chnl)
- `(cdr (string-assoc-ignore-case ,chnl liece-channel-buffer-alist)))
-
-(defun liece-pick-buffer (chnl)
- (cond
- ((stringp chnl)
- (let ((buf (liece-pick-buffer-1 chnl)))
- (if buf (list buf))))
- ((and chnl (listp chnl))
- (let ((buf (liece-pick-buffer-1 (car chnl))))
- (if buf (cons buf (liece-pick-buffer (cdr chnl))))))
- (t nil)))
-
-\f
-;;; Date and time handling functions
-(defun liece-compose-time-string (time)
- (format-time-string "%A %B %e %Y %R" time))
-
-(defun liece-convert-seconds (time)
- "Convert seconds to printable string."
- (let* ((seconds (string-to-int time))
- (minutes (/ seconds 60))
- (seconds (if minutes (% seconds 60) seconds))
- (hours (/ minutes 60))
- (minutes (if hours (% minutes 60) minutes))
- (days (/ hours 24))
- (hours (if days (% hours 24) hours))
- (ds (and (/= 0 days)
- (format "%d day%s, " days
- (if (> days 1) "s" ""))))
- (hs (and (/= 0 hours)
- (format "%d hour%s, " hours
- (if (> hours 1) "s" ""))))
- (ms (and (/= 0 minutes)
- (format "%d minute%s " minutes
- (if (> minutes 1) "s" ""))))
- (ss (format "%d seconds" seconds)))
- (concat ds hs ms (if seconds ss ""))))
-
-(defmacro liece-insert-time-string ()
- '(insert (substring (current-time-string) 11 16) " "))
-
-(defmacro liece-maybe-poll ()
- '(liece-send "PING %s" (system-name)))
-
-(defun liece-get-buffer-create (name)
- "Get or create buffer, keep track on its NAME so we can kill it."
- (let ((buffer (get-buffer-create name)))
- (or (memq buffer liece-buffer-list)
- (push buffer liece-buffer-list))
- buffer))
-
-(defmacro liece-message-from-ignored (prefix rest)
- `(save-excursion
- (liece-insert liece-I-buffer (concat ,prefix "::" ,rest "\n"))
- t))
-
-(defmacro liece-is-message-ignored (string buffer)
- `(let (found (case-fold-search t) msg str msgstr who)
- (catch 'ignore
- (when (member ,buffer liece-no-ignore-buffers)
- (throw 'ignore t))
- (dolist (ignore-entry liece-ignore-list)
- ;; Check message type
- (cond
- ((consp (car ignore-entry))
- (setq msg (caar ignore-entry)
- str (cdar ignore-entry)))
- ((fboundp (car ignore-entry))
- (setq msgstr (apply (car ignore-entry) (list ,string))
- msg (car msgstr)
- str (cdr msgstr)))
- (t
- (liece-message
- (_ "Malformed ignore-list, no msg+str function."))))
- ;; Check message from whom
- (cond
- ((listp (cadr ignore-entry))
- (setq who (cadr ignore-entry)))
- ((fboundp (cadr ignore-entry))
- (setq who (apply (cadr ignore-entry) (list ,string))))
- ((not (cadr ignore-entry))
- (liece-message
- (_ "Malformed ignore-list, no user function."))))
- ;; Handle regexp
- (save-match-data
- (when (and (or msg str)
- (and msg
- (string-match
- msg (cadr liece-current-function)))
- (and str (string-match str ,string)))
- (while who
- (when (string-match (car who) (car liece-current-function))
- (setq found t)
- (throw 'ignore t))
- (setq who (cdr who)))))))
- found))
-
-;;; stolen (and renamed) from time-date.el.
-(defun liece-subtract-time (t1 t2)
- "Subtract two internal times."
- (let ((borrow (< (cadr t1) (cadr t2))))
- (list (- (car t1) (car t2) (if borrow 1 0))
- (- (+ (if borrow 65536 0) (cadr t1)) (cadr t2)))))
-
-(defun liece-time-difference (t1 t2)
- "Return the differnce between two internal times in seconds."
- (let ((sub (liece-subtract-time t1 t2)))
- (+ (* (car sub) 65536) (cadr sub))))
-
-(defun liece-time-elapsed (time seconds)
- "Add SECONDS to TIME."
- (list (+ (car time) (/ (+ (cadr time) seconds) 65536))
- (% (+ (cadr time) seconds) 65536)
- (nth 2 time)))
-
-;;; stolen (and renamed) from time-date.el.
-(defun liece-seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to an Emacs time structure."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
-
-(defun liece-generate-hex-timestamp (&optional time)
- "Generate timestamp string as hexadecimal.
-If optional argument TIME is nil, calculate timestamp using current time."
- (or time
- (setq time (current-time)))
- (format "%04x%04x" (car time) (cadr time)))
-
-(defmacro liece-hex-char-to-integer (character)
- "Convert single hex digit CHARACTER to integer."
- `(if (and (>= ,character ?0) (<= ,character ?9))
- (- ,character ?0)
- (let ((ch (logior ,character 32)))
- (if (and (>= ch ?a) (<= ch ?f))
- (- ch (- ?a 10))
- (error "Invalid hex digit `%c'" ch)))))
-
-(defmacro liece-hex-string-to-integer (hex-string)
- "Convert a HEX-STRING like ffff to the decimal integer."
- `(let ((hex-string ,hex-string) (hex-num 0))
- (while (not (equal hex-string ""))
- (setq hex-num (+ (* hex-num 16)
- (liece-hex-char-to-integer
- (string-to-char hex-string))))
- (setq hex-string (substring hex-string 1)))
- hex-num))
-
-(defmacro liece-hex-timestamp-valid (timestamp limit)
- "Is TIMESTAMP valid within LIMIT?"
- `(let (t1 t2 diff (timestamp ,timestamp))
- (if (not (and (stringp timestamp)
- (string-match
- "^[0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f][0-9a-f]$" timestamp)))
- nil
- (setq t1 (liece-hex-string-to-integer (substring timestamp 0 4))
- t2 (liece-hex-string-to-integer (substring timestamp 4 8))
- diff (liece-time-difference
- (list t1 t2 0) (current-time)))
- (or (>= ,limit 0)
- (and (< diff ,limit) (> diff (- 0 ,limit)))))))
-
-(defmacro liece-remove-properties-region (start end)
- (unless (fboundp 'make-extent)
- `(save-excursion
- (save-restriction
- (narrow-to-region ,start ,end)
- (goto-char (point-min))
- (let (start)
- (while (setq start (next-single-property-change
- (point) 'invisible))
- (when (invisible-p start)
- (delete-region start (next-visible-point start))
- (goto-char start))
- (remove-text-properties (point-min)(point-max) '(face))))))))
-
-(provide 'liece-misc)
-
-;;; liece-misc.el ends here
+++ /dev/null
-;;; liece-modules.el --- Module definitions.
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-04-12
-;; Keywords: IRC, liece, APEL
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(defvar liece-modules-to-compile
- '(gettext
- liece-clfns
- liece-handler
- liece-compat
- liece-version
- liece-vars
- liece-globals
- liece-inlines
- liece-filter
- liece-coding
- liece-dcc
- liece-menu
- liece-000
- liece-200
- liece-300
- liece-400
- liece-500
- liece-nick
- liece-channel
- liece-commands
- liece-ctcp
- liece-q-el
- liece-message
- liece-handle
- liece-hilit
- liece-intl
- liece-mail
- liece-minibuf
- liece-misc
- liece-tcp
- liece-url
- liece-x-face
- liece-window
- liece))
-
-(if (featurep 'xemacs)
- (push 'liece-xemacs liece-modules-to-compile)
- (push 'liece-emacs liece-modules-to-compile))
-
-(if (fboundp 'set-face-stipple)
- (push 'bitmap-stipple liece-modules-to-compile))
-
-;; (require 'pccl)
-;; (unless-broken ccl-usable
-;; (push 'liece-q-ccl liece-modules-to-compile))
-
-(setq liece-modules (cons 'liece-setup liece-modules-to-compile))
-
-(push 'queue-m liece-modules-to-compile)
-
-(provide 'liece-modules)
-
-;;; liece-modules.el ends here
+++ /dev/null
-;;; liece-nick.el --- Various facility for nick operation.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'liece-inlines))
-
-(require 'liece-hilit)
-
-(defalias 'liece-nick-set-operator 'liece-channel-set-operator)
-(defalias 'liece-nick-set-voice 'liece-channel-set-voice)
-(defun liece-nick-equal (n1 n2)
- (string-equal-ignore-case n1 n2))
-
-(defun liece-nick-member (nick nicks)
- "Return non-nil if NICK is member of NICKS."
- (member-if
- (lambda (item)
- (and (stringp item) (liece-nick-equal nick item)))
- nicks))
-
-(defvar liece-nick-insert-hook nil)
-(defvar liece-nick-replace-hook nil)
-
-(define-widget 'liece-nick-push-button 'push-button
- "A nick button."
- :action 'liece-nick-popup-menu)
-
-(defcustom liece-nick-sort-nicks nil
- "If t, sort nick list in each time."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-nick-sort-predicate 'string-lessp
- "Function for sorting nick buffers."
- :type 'function
- :group 'liece-vars)
-
-;;; Nick status functions
-(defun liece-nick-get-joined-channels (nick)
- "Return channels as list NICK is joined."
- (get (intern (or nick liece-real-nickname) liece-obarray) 'join))
-
-(defun liece-nick-get-user-at-host (nick)
- "Return user-at-host as string NICK is joined."
- (get (intern (or nick liece-real-nickname) liece-obarray) 'user-at-host))
-
-(defun liece-nick-set-user-at-host (nick user-at-host)
- "Set user at host as string NICK is joined."
- (put (intern (or nick liece-real-nickname) liece-obarray)
- 'user-at-host user-at-host))
-
-(defun liece-nick-mark-as-part (part &optional nick)
- "Mark NICK is temporary apart."
- (put (intern (or nick liece-real-nickname) liece-obarray) 'part part))
-
-(defun liece-nick-get-modes (&optional nick)
- "Return modes as string NICK is joined."
- (get (intern (or nick liece-real-nickname) liece-obarray) 'mode))
-
-(defun liece-nick-add-mode (mode &optional nick)
- "Add MODE as char to NICK.
-MODE is a string splitted into characters one by one."
- (let ((modes
- (liece-string-to-list
- (or (liece-nick-get-modes nick) ""))))
- (or (memq mode modes)
- (push mode modes))
- (put (intern (or nick liece-real-nickname) liece-obarray)
- 'mode (mapconcat #'char-to-string modes ""))))
-
-(defun liece-nick-remove-mode (mode &optional nick)
- "Remove MODE from NICK.
-MODE is a string splitted into characters one by one."
- (let ((modes
- (liece-string-to-list
- (or (liece-nick-get-modes nick) ""))))
- (delq mode modes)
- (put (intern (or nick liece-real-nickname) liece-obarray)
- 'mode (mapconcat #'char-to-string modes ""))))
-
-(defun liece-nick-set-mode (nick mode toggle)
- "Add or remove channel MODE of NICK.
-MODE is a string splitted into characters one by one.
-If FLAG is non-nil, given modes are added to the user.
-Otherwise they are removed from the user."
- (if toggle
- (liece-nick-add-mode mode nick)
- (liece-nick-remove-mode mode nick)))
-
-(defmacro liece-nick-strip (nick)
- `(if (and ,nick (memq (aref ,nick 0) '(?@ ?+ ? )))
- (substring ,nick 1)
- ,nick))
-
-(defmacro liece-nick-normalize (nick)
- `(if (and ,nick (memq (aref ,nick 0) '(?@ ?+ ? )))
- ,nick
- (concat " " ,nick)))
-
-;;; @ display
-;;;
-(defun liece-nick-insert (nick)
- ;; Find sorted position
- (cond
- ((and (eq liece-nick-sort-nicks t)
- (liece-functionp liece-nick-sort-predicate))
- (let (nicks found)
- (goto-char (point-min))
- (while (and (not (eobp)) (not found))
- (if (condition-case nil
- (funcall liece-nick-sort-predicate
- (liece-nick-strip nick)
- (widget-value (widget-at (1+ (point)))))
- (void-function nil))
- (setq found t)
- (beginning-of-line 2)))))
- ((eq liece-nick-sort-nicks 'reverse)
- (goto-char (point-min)))
- (t (goto-char (point-max))))
-
- (insert (substring nick 0 1))
- (let ((st (point)) (nick (liece-nick-strip nick)))
- (insert nick)
- (when liece-highlight-mode
- (liece-widget-convert-button
- 'liece-nick-push-button st (point) nick))
- (insert "\n")
- (run-hook-with-args 'liece-nick-insert-hook st (point))))
-
-(defun liece-nick-replace (old new &optional limit regexp)
- (if regexp
- (setq old (concat "^\\(" old "\\)$"))
- (setq old (concat "^\\([ @+]\\)\\(" (regexp-quote old) "\\)$")))
- (let (case-fold-search beg end)
- (when (re-search-forward old limit t)
- (unless regexp
- (setq new (concat (match-string 1) new)))
- (if (and (eq liece-nick-sort-nicks t)
- (liece-functionp liece-nick-sort-predicate))
- (progn
- (delete-region (match-beginning 0)
- (progn (goto-char (match-end 0))
- (forward-char) (point)))
- (liece-nick-insert new))
- (condition-case nil
- (widget-delete (widget-at (1+ (point))))
- (void-function nil))
- (replace-match new t t)
- (setq end (point)
- beg (progn (beginning-of-line) (1+ (point))))
- (when liece-highlight-mode
- (liece-widget-convert-button
- 'liece-nick-push-button beg end (substring new 1)))
- (run-hook-with-args 'liece-nick-replace-hook beg end)))))
-
-;;;###liece-autoload
-(defun liece-command-toggle-nick-buffer-mode ()
- (interactive)
- (when (and (eq liece-command-buffer-mode 'channel)
- (get-buffer liece-nick-buffer))
- (setq liece-nick-buffer-mode (not liece-nick-buffer-mode)))
- (liece-configure-windows))
-
-(defun liece-nick-buffer-create (chnl)
- (with-current-buffer
- (liece-get-buffer-create (format liece-nick-buffer-format chnl))
- (unless (eq major-mode 'liece-nick-mode)
- (liece-nick-mode))
- (set-alist 'liece-nick-buffer-alist chnl (current-buffer))
- (current-buffer)))
-
-(defun liece-change-nick-of-1 (old new nicks)
- (if new
- (do ((nicks nicks (cdr nicks)))
- ((or (null nicks)
- (if (liece-nick-equal (caar nicks) old)
- (setcar (car nicks) new))))
- nil)
- (delete-if
- `(lambda (nick) (liece-nick-equal (car nick) ,old))
- nicks)))
-
-(defun liece-change-nick-of-2 (old new nicks)
- (if new
- (do ((nicks nicks (cdr nicks)))
- ((or (not nicks)
- (if (liece-nick-equal (car nicks) old)
- (setcar nicks new))))
- nil)
- (delete-if
- `(lambda (nick) (liece-nick-equal nick ,old))
- nicks)))
-
-(defun liece-change-nick-of (old new)
- (liece-change-nick-of-1 old new liece-nick-alist)
- (let ((chnls (liece-nick-get-joined-channels old)))
- (dolist (chnl chnls)
- (liece-change-nick-of-2 old new (liece-channel-get-nicks chnl))
- (liece-change-nick-of-2 old new (liece-channel-get-operators chnl))
- (liece-change-nick-of-2 old new (liece-channel-get-voices chnl)))))
-
-(defmacro liece-nick-join-1 (user chnl)
- "Add CHNL to list of channels USER belongs to."
- `(let* ((flag (string-to-char user))
- (user (liece-nick-strip ,user))
- (u (intern user liece-obarray))
- (c (intern ,chnl liece-obarray)))
- (or (string-assoc-ignore-case user liece-nick-alist)
- (push (list user) liece-nick-alist))
- (cond
- ((char-equal flag ?@)
- (liece-channel-set-operator ,chnl user t))
- ((char-equal flag ?+)
- (liece-channel-set-voice ,chnl user t)))
- (or (string-list-member-ignore-case ,chnl (get u 'join))
- (put u 'join (cons ,chnl (get u 'join))))
- (or (string-list-member-ignore-case user (get c 'nick))
- (put c 'nick (cons user (get c 'nick))))))
-
-(defmacro liece-nick-part-1 (user chnl)
- "Remove USER information from his CHNL."
- `(let ((u (intern ,user liece-obarray))
- (c (intern ,chnl liece-obarray)))
- (liece-channel-set-operator ,chnl ,user nil)
- (liece-channel-set-voice ,chnl ,user nil)
- (put u 'join (string-list-remove-ignore-case ,chnl (get u 'join)))
- (put c 'nick (string-list-remove-ignore-case ,user (get c 'nick)))))
-
-;;;###liece-autoload
-(defun liece-nick-join (user chnl)
- (liece-nick-join-1 user chnl)
- (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
- (with-current-buffer nbuf
- (let (buffer-read-only)
- (liece-nick-insert (liece-nick-normalize user))))))
-
-;;;###liece-autoload
-(defun liece-nick-part (user chnl)
- (let ((nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
- (setq user (liece-nick-strip user))
- (with-current-buffer nbuf
- (let ((case-fold-search t) buffer-read-only)
- (goto-char (point-min))
- (when (re-search-forward (concat "^." (regexp-quote user) "$") nil t)
- (delete-region (match-beginning 0)
- (progn (goto-char (match-end 0))
- (forward-char) (point)))
- (liece-nick-part-1 user chnl))))))
-
-;;;###liece-autoload
-(defun liece-nick-change (old new)
- (let* ((old (liece-nick-strip old)) (new (liece-nick-strip new))
- (chnls (get (intern old liece-obarray) 'join)) chnl nbuf)
- (liece-change-nick-of old new)
- (if new
- (put (intern new liece-obarray) 'join chnls))
- (unintern old liece-obarray)
- (dolist (chnl chnls)
- (if (null new)
- (liece-nick-part old chnl)
- (setq nbuf (cdr (string-assoc-ignore-case
- chnl liece-nick-buffer-alist)))
- (with-current-buffer nbuf
- (let (buffer-read-only)
- (goto-char (point-min))
- (liece-nick-replace old new)))))))
-
-;;;###liece-autoload
-(defun liece-nick-update (chnl users)
- (let ((c (intern chnl liece-obarray))
- (nbuf (cdr (string-assoc-ignore-case chnl liece-nick-buffer-alist))))
- (mapcar (lambda (prop) (put c prop nil)) '(nick oper voice))
- (with-current-buffer nbuf
- (let (buffer-read-only)
- (liece-kill-all-overlays)
- (erase-buffer)))
- (when (and liece-nick-sort-nicks
- (liece-functionp liece-nick-sort-predicate))
- (setq users (sort users
- (lambda (s1 s2)
- (funcall liece-nick-sort-predicate
- (liece-nick-strip s1)
- (liece-nick-strip s2))))))
- (let (liece-nick-sort-predicate)
- (dolist (user users)
- (liece-nick-join user chnl)))))
-
-(defvar liece-nick-region-nicks nil)
-
-;;;###liece-autoload
-(defun liece-nick-update-region ()
- (setq liece-nick-region-nicks nil)
- (save-excursion
- (let (region nick)
- (if (not (region-active-p))
- (setq region (cons (line-beginning-position)
- (line-beginning-position 2)))
- (setq region (cons (region-beginning) (region-end)))
- (goto-char (car region))
- (setcar region (line-beginning-position))
- (goto-char (cdr region))
- (if (eobp)
- (setcdr region (line-beginning-position))
- (setcdr region (line-beginning-position 2))))
- (save-restriction
- (narrow-to-region (car region) (cdr region))
- (goto-char (point-min))
- (while (not (eobp))
- (setq nick (widget-value (widget-at (1+ (point)))))
- (push nick liece-nick-region-nicks)
- (beginning-of-line 2))))))
-
-(defun liece-nick-add-buttons (start end)
- (save-excursion
- (goto-char start)
- (while (re-search-forward
- (eval-when-compile
- (concat "^\\(" liece-time-prefix-regexp "\\)?"
- "[][=<>(][][=<>(]?\\([^:]*:\\)?\\([^][=<>(]+\\)"))
- end t)
- (let* ((nick-start (match-beginning 3))
- (nick-end (match-end 3))
- (nick (buffer-substring nick-start nick-end)))
- (when liece-highlight-mode
- (liece-widget-convert-button
- 'liece-nick-push-button nick-start nick-end nick))))))
-
-;;;###liece-autoload
-(defun liece-nick-redisplay-buffer (chnl)
- (let ((buffer
- (cdr (string-assoc-ignore-case
- chnl liece-nick-buffer-alist)))
- (window (liece-get-buffer-window liece-nick-buffer)))
- (and buffer window
- (with-current-buffer buffer
- (set-window-buffer window buffer)
- (unless (liece-frozen buffer)
- (set-window-start window (point-min)))
- (setq liece-nick-buffer buffer)))))
-
-(provide 'liece-nick)
-
-;;; liece-nick.el ends here
+++ /dev/null
-;;; liece-q-ccl.el --- CTCP binary data quotation in CCL.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-01-31
-;; Revised: 1999-01-31
-;; Keywords: IRC, liece, CTCP
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'broken)
-(require 'pccl)
-(require 'poem) ;char-int
-
-(eval-and-compile
- (defconst liece-quote-ccl-256-table
- (let ((i 0)
- table)
- (while (< i 256)
- (setq table (nconc table (list i))
- i (1+ i)))
- table)))
-
-(broken-facility ccl-cascading-write
- "Emacs CCL write command does not accept more than 2 arguments."
- (condition-case nil
- (progn
- (define-ccl-program cascading-read-test
- '(1
- (write r0 r1 r2)))
- t)
- (error nil)))
-
-(define-ccl-program liece-quote-ccl-decode
- `(1
- (loop
- (read-if
- (r0 == ?\\)
- ((read-if
- (r1 == ?\\)
- (write r1)
- (branch
- r1
- ,@(mapcar
- (lambda (r1)
- (cond
- ((= r1 (char-int ?a))
- `(write ?\x01))
- ((= r1 (char-int ?n))
- `(write ?\n))
- ((= r1 (char-int ?r))
- `(write ?\r))
- (t
- (if-broken ccl-cascading-write
- `((write r0)
- (write r1))
- `(write r0 r1)))))
- liece-quote-ccl-256-table))))
- (write r0))
- (repeat))))
-
-(define-ccl-program liece-quote-ccl-encode
- `(2
- (loop
- (read-branch
- r0
- ,@(mapcar
- (lambda (r0)
- (cond
- ((= r0 (char-int ?\\))
- `(write-repeat "\\\\"))
- ((= r0 (char-int ?\x01))
- `(write-repeat "\\a"))
- ((= r0 (char-int ?\n))
- `(write-repeat "\\n"))
- ((= r0 (char-int ?\r))
- `(write-repeat "\\r"))
- (t
- `(write-repeat r0))))
- liece-quote-ccl-256-table)))))
-
-(make-ccl-coding-system
- 'liece-quote-ccl-cs ?Q "CTCP Quote Decoder/Encoder"
- 'liece-quote-ccl-decode 'liece-quote-ccl-encode)
-
-(defun liece-quote-ccl-decode-string (string-to-decode)
- (decode-coding-string string-to-decode 'liece-quote-ccl-cs))
-
-(defun liece-quote-ccl-encode-string (string-to-encode)
- (encode-coding-string string-to-encode 'liece-quote-ccl-cs))
-
-(defun liece-quote-ccl-decode-region (min max)
- (decode-coding-region min max 'liece-quote-ccl-cs))
-
-(defun liece-quote-ccl-encode-region (min max)
- (encode-coding-region min max 'liece-quote-ccl-cs))
-
-(defalias 'liece-quote-decode-string 'liece-quote-ccl-decode-string)
-(defalias 'liece-quote-encode-string 'liece-quote-ccl-encode-string)
-
-(defalias 'liece-quote-decode-region 'liece-quote-ccl-decode-region)
-(defalias 'liece-quote-encode-region 'liece-quote-ccl-encode-region)
-
-(provide 'liece-q-ccl)
-
-;;; liece-q-ccl.el ends here
+++ /dev/null
-;;; liece-q-el.el --- CTCP binary data quotation in emacs-lisp.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-01-31
-;; Revised: 1999-01-31
-;; Keywords: IRC, liece, CTCP
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(defconst liece-quote-strings
- '(("\\\\" . "\\") ("\\a" . "\ 1") ("\\n" . "\n") ("\\r" . "\r")))
-
-(defun liece-quote-el-decode-region (start end)
- "Decode binary data between START and END."
- (interactive "r")
- (save-restriction
- (narrow-to-region start end)
- (dolist (pair liece-quote-strings)
- (goto-char (point-min)) (replace-string (car pair) (cdr pair)))))
-
-(defun liece-quote-el-decode-string (string)
- "Decode binary data from STRING."
- (interactive)
- (save-excursion
- (with-temp-buffer
- (insert string)
- (liece-quote-el-decode-string (point-min) (point-max))
- (buffer-substring (point-min) (point-max)))))
-
-(defun liece-quote-el-encode-region (start end)
- "Encode binary data between START and END."
- (interactive "r")
- (save-restriction
- (narrow-to-region start end)
- (goto-char (point-min))
- (while (search-forward "\\" nil t) (insert "\\"))
- (goto-char (point-min))
- (while (search-forward "\ 1" nil t)
- (backward-delete-char 1)
- (insert "\\a"))
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (backward-delete-char 1)
- (insert "\\n"))
- (goto-char (point-min))
- (while (search-forward "\r" nil t)
- (backward-delete-char 1)
- (insert "\\r"))))
-
-(defun liece-quote-el-encode-string (string)
- "Encode binary data from STRING."
- (interactive)
- (save-excursion
- (with-temp-buffer
- (erase-buffer)
- (insert string)
- (liece-quote-el-encode-region (point-min) (point-max))
- (buffer-substring (point-min) (point-max)))))
-
-(defalias 'liece-quote-decode-string 'liece-quote-el-decode-string)
-(defalias 'liece-quote-encode-string 'liece-quote-el-encode-string)
-
-(defalias 'liece-quote-decode-region 'liece-quote-el-decode-region)
-(defalias 'liece-quote-encode-region 'liece-quote-el-encode-region)
-
-(provide 'liece-q-el)
-
-;;; liece-q-el.el ends here
-
+++ /dev/null
-;;; liece-tcp.el --- TCP/IP stream emulation.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Masanobu Umeda <umerin@mse.kyutech.ac.jp>
-;; Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-03-16 renamed from tcp.el
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-
-;; Notes on TCP package:
-;;
-;; This package provides a TCP/IP stream emulation for GNU Emacs. If
-;; the function `open-network-stream' is not defined in Emacs, but
-;; your operating system has a capability of network stream
-;; connection, this tcp package can be used for communicating with
-;; NNTP server.
-;;
-;; The tcp package runs inferior process which actually does the role
-;; of `open-network-stream'. The program `tcp' provided with this
-;; package can be used for such purpose. Before loading the package,
-;; compile `tcp.c' and install it as `tcp' in a directory in the emacs
-;; search path. If you modify `tcp.c', please send diffs to the author
-;; of GNUS. I'll include some of them in the next releases.
-
-;;; Code:
-
-(require 'poe)
-(require 'poem)
-
-(eval-when-compile
- (require 'liece-compat)
- (require 'liece-globals))
-
-(defgroup liece-tcp nil
- "TCP/IP Emulation"
- :tag "TCP"
- :prefix "liece-"
- :group 'liece-server)
-
-(defcustom liece-tcp-program "ltcp"
- "The name of the program emulating `open-network-stream' function."
- :type 'file
- :group 'liece-tcp)
-
-(defcustom liece-tcp-default-connection-type 'network
- "TCP/IP Connection type."
- :type '(choice
- (const :tag "Network" network)
- (const :tag "Program" program)
- (const :tag "SSLeay" ssl)
- (const :tag "rlogin" rlogin))
- :group 'liece-tcp)
-
-(defvar liece-tcp-connection-type liece-tcp-default-connection-type)
-
-(eval-and-compile
- (autoload 'open-ssl-stream "ssl")
- (defvar ssl-program-arguments))
-
-(defcustom liece-tcp-ssl-protocol-version "3"
- "SSL protocol version."
- :type 'integer
- :group 'liece-tcp)
-
-(defcustom liece-tcp-ssl-default-service 993
- "Default SSL service."
- :type 'liece-service-spec
- :group 'liece-tcp)
-
-(defcustom liece-tcp-rlogin-program "rsh"
- "Program used to log in on remote machines.
-The default is \"rsh\", but \"ssh\" is a popular alternative."
- :type 'file
- :group 'liece-tcp)
-
-(defcustom liece-tcp-relay-host "localhost"
- "Remote host address."
- :type 'file
- :group 'liece-tcp)
-
-(defcustom liece-tcp-rlogin-parameters '("socket" "-q")
- "Parameters to `liece-tcp-open-rlogin'."
- :type '(repeat string)
- :group 'liece-tcp)
-
-(defcustom liece-tcp-rlogin-user-name nil
- "User name on remote system when using the rlogin connect method."
- :type 'string
- :group 'liece-tcp)
-
-(defvar liece-tcp-stream-alist
- '((network open-network-stream)
- (program liece-tcp-open-program-stream)
- (ssl liece-tcp-open-ssl-stream)
- (rlogin liece-tcp-open-rlogin-stream)))
-
-\f
-;;;###liece-autoload
-(defun liece-open-network-stream (name buffer host service)
- (let ((method
- (nth 1 (assq liece-tcp-connection-type
- liece-tcp-stream-alist))))
- (or method
- (error "Invalid stream"))
- (funcall method name buffer host service)))
-
-(defun liece-tcp-open-program-stream (name buffer host service)
- "Open a TCP connection for a service to a host.
-Returns a subprocess-object to represent the connection.
-Input and output work as for subprocesses; `delete-process' closes it.
-Args are NAME BUFFER HOST SERVICE.
-NAME is name for process. It is modified if necessary to make it unique.
-BUFFER is the buffer (or `buffer-name') to associate with the process.
- Process output goes at end of that buffer, unless you specify
- an output stream or filter function to handle the output.
- BUFFER may be also nil, meaning that this process is not associated
- with any buffer
-Third arg is name of the host to connect to.
-Fourth arg SERVICE is name of the service desired, or an integer
- specifying a service number to connect to."
- (let ((proc (start-process name buffer
- liece-tcp-program
- host
- (if (stringp service)
- service
- (int-to-string service)))))
- (process-kill-without-query proc)
- ;; Return process
- proc))
-
-(defun liece-tcp-open-ssl-stream-1 (name buffer server service extra-arg)
- (let* ((service (or service liece-tcp-ssl-default-service))
- (ssl-program-arguments (list extra-arg "-connect"
- (format "%s:%d" server service)))
- (process (open-ssl-stream name buffer server service)))
- (and process (memq (process-status process) '(open run))
- process)))
-
-(defun liece-tcp-open-ssl-stream (name buffer server service)
- (if (string-equal liece-tcp-ssl-protocol-version "2")
- (liece-tcp-open-ssl-stream-1
- name buffer server service "-ssl2")
- (or (liece-tcp-open-ssl-stream-1
- name buffer server service "-ssl3")
- (liece-tcp-open-ssl-stream-1
- name buffer server service "-ssl2"))))
-
-(defun liece-tcp-open-rlogin-stream (name buffer server service)
- "Open a connection to SERVER using rsh."
- (let* ((service (if (stringp service)
- service
- (int-to-string service)))
- (args `(,liece-tcp-rlogin-program
- ,@(if liece-tcp-rlogin-user-name
- (list "-l" liece-tcp-rlogin-user-name))
- ,liece-tcp-relay-host
- ,@liece-tcp-rlogin-parameters ,server ,service))
- (process-connection-type nil))
- (apply #'start-process-shell-command name buffer args)))
-
-(provide 'liece-tcp)
-
-;;; liece-tcp.el ends here
+++ /dev/null
-;;; liece-url.el --- URL browsing.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-intl)
- (require 'liece-menu))
-
-(defvar browse-url-browser-function)
-
-(defgroup liece-url nil
- "URL Browsing in IRC buffer."
- :group 'liece-vars)
-
-(defcustom liece-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,]*[-a-zA-Z0-9_=#$@~`%&*+|\\/]"
- "Regular expression that matches URLs."
- :group 'liece-url
- :type 'regexp)
-
-(defcustom liece-url-browser-function browse-url-browser-function
- "Default URL Browser."
- :group 'liece-url)
-
-(defcustom liece-url-alist nil
- "Alist for URL completion."
- :type 'alist
- :group 'liece-url)
-
-(define-widget 'liece-url-link 'link
- "A link to an www page."
- :help-echo 'widget-url-link-help-echo
- :action 'liece-url-link-action)
-
-(defun liece-url-link-action (widget &optional event)
- (let ((browse-url-browser-function liece-url-browser-function))
- (browse-url (widget-value widget))))
-
-(defvar liece-add-url-functions nil)
-
-(defun liece-url-add-buttons (start end)
- (save-excursion
- (goto-char start)
- (while (re-search-forward liece-url-regexp end t)
- (let ((url (match-string 0)))
- (if liece-highlight-mode
- (liece-widget-convert-button
- 'url-link (match-beginning 0)(match-end 0) url))
- (unless (assoc url liece-url-alist)
- (push (list url) liece-url-alist)
- (run-hook-with-args 'liece-add-url-functions url))))))
-
-(defun liece-command-browse-url (&optional url)
- (interactive
- (let (url)
- (if (and current-prefix-arg (eq current-prefix-arg '-))
- (setq url (caar liece-url-alist))
- (setq url (completing-read (_ "Open URL:") liece-url-alist)))
- (list url)))
- (let ((browse-url-browser-function liece-url-browser-function))
- (browse-url url)))
-
-(defun url-irc-liece (host port channel user password)
- (let ((liece-server
- `(:host ,host :service ,port :password ,password))
- (liece-startup-channel channel))
- (liece)))
-
-(provide 'liece-url)
-
-;;; liece-url.el ends here
+++ /dev/null
-;;; liece-vars.el --- Customization.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-compat)
- (require 'liece-globals))
-
-;; User modifiable variables.
-(defgroup liece nil
- "liece specific customize group")
-
-(defgroup liece-vars nil
- "liece user customizable variables"
- :tag "Variables"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-saved-forms
- (purecopy
- '(liece-kill-nickname
- liece-server-alist
- liece-channel-buffer-mode
- liece-nick-buffer-mode
- liece-friends))
- "Variables whose values are saved via command liece-command-save-vars."
- :type 'string
- :group 'liece-vars)
-
-(defgroup liece-look nil
- "Look & Feels"
- :tag "Look"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-command-window-height 4
- "How large should command window be on startup."
- :type 'integer
- :group 'liece-look)
-
-(defcustom liece-truncate-partial-width-windows nil
- "If non-nil, truncate lines in splitting windows such as others buffer."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-use-full-window t
- "If non-nil, IRCHAT will use whole Emacs window."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-display-frame-title t
- "If non-nil, IRCHAT displays channel information on frame title."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-display-unread-mark nil
- "If non-nil, display unread mark as XEmacs glyphs or character to channel
-list buffer."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-channel-unread-character "!"
- "Channel unread character."
- :type 'character
- :group 'liece-look)
-
-(defcustom liece-tab-stop-list '(2 4 6 8 10 12 14 16)
- "List of tab stop positions in dialogue buffer."
- :type '(repeat integer)
- :group 'liece-look)
-
-(defcustom liece-icon-directory nil
- "Normal position of liece icons."
- :type 'directory
- :group 'liece-look)
-
-(defcustom liece-nick-image-alist
- '((?@ . "ball.red.xpm")
- (? . "ball.blank.xpm")
- (?+ . "ball.gray.xpm"))
- "Normal and deformed faces for operators and voices."
- :type '(repeat (list (character :tag "Mark")
- (string :tag "Image")))
- :group 'liece-look)
-
-(defcustom liece-inhibit-startup-message nil
- "If non-nil, the startup message will not be displayed.
-This variable is used before `.liece/init.el' is loaded, so it should
-be set in `.emacs' instead."
- :group 'liece-look
- :type 'boolean)
-
-(defcustom liece-want-traditional nil
- "Do we want /commands."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-command-window-on-top nil
- "If non-nil, the command window will be put at the top of the screen."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-one-buffer-mode nil
- "When non-nil, liece will put up only a dialogue buffer.
-Useful for those (perverts) who use 24 line terminals."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-display-status-on-channel-indicator nil
- "When non-nil, liece will display channel topic on modeline."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-directory "~/.liece"
- "Where to look for data files."
- :type 'directory
- :group 'liece-vars)
-
-(defcustom liece-variables-file (expand-file-name "init.el" liece-directory)
- "Where to look for variables. Helps to remove clutter from your .emacs.
-This feature is most likely to dissappear in near future. The preferred
-way is to put liece variables on .emacs or file loaded from there."
- :type 'file
- :group 'liece-vars)
-
-(defcustom liece-variables-files
- (list liece-variables-file)
- "Where to look for variables. Helps to remove clutter from your .emacs.
-This feature is most likely to dissappear in near future. The preferred
-way is to put liece variables on .emacs or file loaded from there."
- :type '(repeat (file :tag "Initialization File"))
- :group 'liece-vars)
-
-;; Where to connect.
-(defgroup liece-server nil
- "Server Settings"
- :tag "Server"
- :prefix "liece-"
- :group 'liece)
-
-(defgroup liece-channel nil
- "Channel Settings"
- :tag "Channel"
- :prefix "liece-"
- :group 'liece)
-
-(define-widget 'liece-service-spec 'radio
- "Edit service spec entries"
- :convert-widget 'liece-service-spec-convert)
-
-(defun liece-service-spec-convert (widget)
- (widget-put widget :args '((integer :tag "Port Number")
- (string :tag "Name")))
- widget)
-
-(define-widget 'liece-server-spec 'repeat
- "Edit server spec entries"
- :match (lambda (widget value)
- (eval
- (` (and
- (,@ (mapcar
- (lambda (entry)
- (or (stringp (cdr entry))
- (listp (cdr entry))))
- value))))))
- :convert-widget 'liece-server-spec-convert)
-
-(defun liece-server-spec-convert (widget)
- (let* ((host '(const :format "" :value :host))
- (service '(const :format "" :value :service))
- (host
- (` (group :inline t (, host) (string :tag "Host"))))
- (service
- (` (group :inline t (, service) liece-service-spec)))
- (spec
- (` (cons
- (string :tag "Name")
- (radio (string :tag "Host")
- (list (, host) (, service))))))
- (args (` ((, spec)))))
- (widget-put widget :args args)
- widget))
-
-(defcustom liece-server-alist
- '(("WIDE Project Kyoto NOC, Japan" . "irc.kyoto.wide.ad.jp")
- ("WIDE Project Tokyo NOC, Japan" . "irc.tokyo.wide.ad.jp")
- ("Hokkaido University, Sapporo, Japan" . "irc.huie.hokudai.ac.jp")
- ("DTI, Akasaka Tokyo, Japan" . "irc.dti.ne.jp")
- ("WIDE Project Fujisawa NOC, Japan" . "irc.fujisawa.wide.ad.jp")
- ("WIDE Project Kyoto NOC, Japan (IPv6)" . "irc6.kyoto.wide.ad.jp"))
- "IRC server assoc-list which is used for input IRC server."
- :type 'liece-server-spec
- :group 'liece-server)
-
-(defcustom liece-server (or (getenv "IRCSERVER") nil)
- "Name of the host running the IRC server.
-Value initialized from the IRCSERVER environment variable if one is set"
- :type 'string
- :group 'liece-server)
-
-(defcustom liece-service
- (let ((ircport-env (getenv "IRCPORT")))
- (if ircport-env
- (if (> (string-to-int ircport-env) 0)
- (string-to-int ircport-env)
- ircport-env)
- 6667))
- "IRC service name or (port) number."
- :type 'liece-service-spec
- :group 'liece-server)
-
-(defcustom liece-my-userhost nil
- "You can explicitly indicate own hostname here."
- :type '(radio (string :tag "Hostname")
- (const :tag "Autodetect" nil))
- :group 'liece-server)
-
-(defcustom liece-password (or (getenv "IRCPASSWORD") nil)
- "Your password when connecting to server."
- :type '(radio (string :tag "Password")
- (const :tag "No" nil))
- :group 'liece-server)
-
-(defcustom liece-name (or (getenv "IRCNAME") (user-real-login-name))
- "The nickname you want to use in IRC.
-Default is the environment variable IRCNICK, or your login name."
- :type 'string
- :group 'liece-server)
-
-(defcustom liece-nickname (or (getenv "IRCNICK") (user-real-login-name))
- "The nickname you want to use in IRC.
-Default is the environment variable IRCNICK, or your login name."
- :type 'string
- :group 'liece-server)
-
-(defcustom liece-nick-max-length 9
- "Maximum length of the nickname."
- :type 'integer
- :group 'liece-server)
-
-(defvar liece-real-nickname nil)
-
-(defcustom liece-startup-channel nil
- "The channel to join automatically at startup.
-If nil, do not join any channel."
- :type '(radio (string :tag "Channels")
- (const nil))
- :group 'liece-channel)
-
-(defcustom liece-startup-channel-list nil
- "The channel list to join automatically at startup.
-If nil, do not join any channel."
- :type '(repeat (string :tag "Startup Channel"))
- :group 'liece-channel)
-
-(defcustom liece-auto-join-partner t
- "Whether join automatically at arriving private message."
- :type 'boolean
- :group 'liece-channel)
-
-(defcustom liece-reconnect-automagic nil
- "Automatic reconnection, default is disabled."
- :type 'boolean
- :group 'liece-server)
-
-(defcustom liece-ask-for-nickname nil
- "Ask for nickname if liece was entered with \\[universal-argument]."
- :type 'boolean
- :group 'liece-server)
-
-(defcustom liece-ask-for-password nil
- "Ask for password when connecting to server."
- :type 'boolean
- :group 'liece-server)
-
-(defcustom liece-ask-for-channel-password nil
- "Ask for channel password when joining channel with password."
- :type 'boolean
- :group 'liece-server)
-
-(defcustom liece-reconnect-with-password nil
- "Auto recconect to server with password after incorrect password."
- :type 'boolean
- :group 'liece-server)
-
-(defcustom liece-grow-tail "_"
- "Add liece-grow-tail to nick when reconnecting.
-Otherwise you might get killed again if automagic reconnect is too fast."
- :type 'string
- :group 'liece-server)
-
-(defcustom liece-auto-iterate-nick nil
- "When nickname has already been in use, grow-tail automagically."
- :type 'boolean
- :group 'liece-server)
-
-(defvar liece-after-registration nil
- "After my registration.")
-
-(defvar liece-status-message-string nil)
-
-(defvar liece-channel-unread-list nil)
-
-;; Hooks.
-(defgroup liece-hook nil
- "Hooks"
- :tag "Hooks"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-command-mode-hook nil
- "A hook for IRCHAT command mode."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-dialogue-mode-hook nil
- "A hook for IRCHAT dialogue mode."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-others-mode-hook nil
- "A hook for IRCHAT others mode."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-channel-mode-hook nil
- "A hook for IRCHAT Channel mode."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-nick-mode-hook nil
- "A hook for IRCHAT nick mode."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-exit-hook nil
- "A hook executed when signing off IRC."
- :type 'hook
- :group 'liece-hook)
-
-(defcustom liece-before-kill-emacs-hook nil
- "A hook executed when exitting Emacs."
- :type 'hook
- :group 'liece-hook)
-
-;; Channel buffers.
-(defcustom liece-channel-buffer-mode t
- "When non-nil, liece will display a channel buffer."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-channel-window-height-percent 63
- "How large percent should Current channel window be on startup."
- :type 'integer
- :group 'liece-look)
-
-(defcustom liece-default-beep nil
- "If non nil, channel buffer local beep flag is on at starting."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-default-freeze nil
- "If non nil, channel buffer local freeze flag is on at starting."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-default-own-freeze nil
- "If non nil, channel buffer local own freeze flag is on at starting."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-default-channel-binding nil
- "The channel list to bind the channel number when joining."
- :type '(repeat (radio (string :tag "Bound Channel")
- (const nil)))
- :group 'liece-channel)
-
-(defcustom liece-default-partner-binding nil
- "The chat partner list to bind the partner's number."
- :type '(repeat (radio (string :tag "Bound Partner")
- (const nil)))
- :group 'liece-partner)
-
-;; Nick buffers.
-(defcustom liece-nick-buffer-mode t
- "When non-nil, liece will display a nick list buffer."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-nick-window-width-percent 18
- "How large percent should Current nick list window be on startup."
- :type 'integer
- :group 'liece-look)
-
-(defcustom liece-nick-window-auto-hide t
- "Hide nick window in priv buffer automatically."
- :type 'boolean
- :group 'liece-look)
-
-;; Channel list buffer.
-(defcustom liece-channel-list-buffer-mode t
- "When non-nil, liece will display a channel list buffer."
- :type 'boolean
- :group 'liece-look)
-
-(defcustom liece-channel-list-window-width-percent 18
- "How large percent should Current channel list window be on startup."
- :type 'integer
- :group 'liece-look)
-
-;; Highlight.
-(defcustom liece-highlight-mode t
- "If non nil, IRC buffer is highlighted by specific rule."
- :type 'boolean
- :group 'liece-highlight)
-
-(defcustom liece-highlight-pattern "$^"
- "If non nil, this pattern used for user defined highlight rule."
- :type '(regexp :tag "Highlighting Pattern")
- :group 'liece-highlight)
-
-;; DCC
-(defgroup liece-dcc nil
- "DCC Settings"
- :tag "DCC"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-dcc-program "ldcc"
- "Name of the external dcc-program.
-Current version takes the one which is earlier in path \(if many\)."
- :type '(file :tag "DCC program path")
- :group 'liece-dcc)
-
-(defcustom liece-dcc-directory "~/tmp"
- "Directory where liece-dcc puts its files."
- :type 'directory
- :group 'liece-dcc)
-
-(defcustom liece-dcc-port 0
- "Default port for DCC operations."
- :type 'integer
- :group 'liece-dcc)
-
-(defcustom liece-dcc-resolve-server nil
- "Resolve IRC server FQDN with external DCC command."
- :type 'boolean
- :group 'liece-dcc)
-
-;; Prefix strings for various messages.
-(defgroup liece-prefix nil
- "Various message prefix"
- :tag "Prefix"
- :prefix "liece-"
- :group 'liece)
-
-(defgroup liece-prefix-string nil
- "Various prefix string"
- :tag "Prefix string"
- :prefix "liece-"
- :group 'liece-prefix)
-
-(defcustom liece-change-prefix "*** Change: "
- "String to add before changing messages."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-notice-prefix "*** Notice: "
- "String to add before any notice message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-broadcast-prefix "*** Broadcast: "
- "String to add before any Broadcast message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-wallops-prefix "*** Notice: "
- "String to add before any WALLOPS message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-error-prefix "*** Error: "
- "String to add before any ERROR message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-info-prefix "*** Info: "
- "String to add before any informational message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-timestamp-prefix "*** Time: "
- "String to add before any timestamp message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-client-prefix "*** Client: "
- "String to add before any CTCP message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-dcc-prefix "*** DCC: "
- "String to add before any DCC message."
- :type 'string
- :group 'liece-prefix-string)
-
-(defcustom liece-time-prefix-regexp "[0-9][0-9]:[0-9][0-9] "
- "Time prefix regexp."
- :type 'regexp
- :group 'liece-prefix)
-
-(defcustom liece-display-time t
- "If non-nil, print time prefix on each line in channel buffer."
- :type 'boolean
- :group 'liece-prefix)
-
-(defcustom liece-display-prefix-tag nil
- "If non-nil, print prefix tag on each line in channel buffer."
- :type 'boolean
- :group 'liece-prefix)
-
-(defcustom liece-generic-prefix-tag-regexp "\\*\\*\\* \\([^:]+: \\)"
- "Regular expression for generic prefix tag."
- :type 'regexp
- :group 'liece-prefix)
-
-;; Misc.
-(defcustom liece-blink-parens nil
- "Should we blink matching parenthesis in liece command buffer?"
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-show-wallops t
- "Show wallops messages if usermode +ws."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-ignore-extra-notices t
- "Don't show any notice unless they come from the local server."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-shorten-kills t
- "Shorten KILL messages to about one line."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-ignore-changes nil
- "Ignore changes? Good in topic-wars/link troubles."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-ignore-fakes nil
- "If non nil, ignore fake notices if receiving them."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-signoff-message nil
- "Default signoff message."
- :type '(radio (string :tag "Signoff message"))
- :group 'liece-vars)
-
-(defcustom liece-away-message ""
- "Default away message."
- :type 'string
- :group 'liece-vars)
-
-(defcustom liece-beep-on-bells 'always
- "If non-nil, and the IRC dialogue buffer is not selected in a window,
-an IRC message arriving containing a bell character, will cause you
-to be notified.
-If value is 'always, an arriving bell will always cause a beep (or flash)."
- :type '(radio (const :tag "Always" always) (const :tag "No" nil))
- :group 'liece-vars)
-
-(defcustom liece-beep-function (function ding)
- "Function to beep."
- :type 'function
- :group 'liece-vars)
-
-(defcustom liece-beep-when-invited nil
- "If non-nil, beep when invited."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-beep-when-privmsg nil
- "If non-nil, beep when received privmsg."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-beep-words-list nil
- "This list used for user defined beep rules."
- :type '(repeat (string :tag "Beep Rules List"))
- :group 'liece-vars)
-
-(defcustom liece-system-fqdname (system-name)
- "The fully qualified domain name of the system.
-Default is what (system-name) returns."
- :type 'string
- :group 'liece-vars)
-
-(defcustom liece-gather-channel-modes t
- "Gather channel modes when joining channels."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-use-x-face nil
- "Display X-Face in dialogue buffer."
- :type 'boolean
- :group 'liece-look)
-
-;; Send/Receive files.
-(defcustom liece-file-accept nil
- "Do we accept files."
- :type 'boolean
- :group 'liece-ctcp)
-
-(defcustom liece-file-confirm-save nil
- "Do we want confirmation on saving files."
- :type 'boolean
- :group 'liece-ctcp)
-
-;; Userinfos.
-(defgroup liece-ctcp nil
- "CTCP Settings"
- :tag "CTCP"
- :prefix "liece-"
- :group 'liece)
-
-(defcustom liece-ctcp-userinfo "No user information given."
- "Userinfo message given to anyone asking."
- :type 'string
- :group 'liece-ctcp)
-
-(defcustom liece-ctcp-x-face ""
- "X-Face message given to anyone asking. Proper form is \"X-Face: ....\"."
- :type 'string
- :group 'liece-ctcp)
-
-(static-when (featurep 'xemacs)
- (define-obsolete-variable-alias 'liece-client-userinfo
- 'liece-ctcp-userinfo)
- (define-obsolete-variable-alias 'liece-client-x-face
- 'liece-ctcp-x-face))
-
-(defcustom liece-timers
- '((liece-command-poll-names liece-poll-names-interval)
- (liece-command-keepalive liece-keepalive-interval)
- (liece-command-poll-friends liece-poll-friends-interval))
- "Symbol name to store timer, timer-function and timer-interval."
- :type '(repeat (list symbol symbol))
- :group 'liece-server)
-
-(defcustom liece-friends nil
- "Friends to be checked consequently."
- :type '(repeat (string :tag "Nick"))
- :group 'liece-vars)
-
-(defcustom liece-display-friends-function 'liece-303-display-friends
- "Function to display friends status."
- :type 'function
- :group 'liece-vars)
-
-(defcustom liece-poll-friends-interval 30
- "Interval on seconds the existence of friends."
- :type '(repeat
- (integer :tag "Polling Interval in Seconds")
- (const :tag "No" nil))
- :group 'liece-server)
-
-(defcustom liece-keepalive-interval nil
- "Interval on seconds the existence of server connection is checked."
- :type '(radio
- (integer :tag "Seconds"
- :doc "Connection Interval in Seconds")
- (const :tag "No" nil))
- :group 'liece-server)
-
-(defcustom liece-poll-names-interval nil
- "Interval the names are polled from server."
- :type '(radio
- (integer :tag "Seconds"
- :doc "NAMES Polling Interval in Seconds")
- (const :tag "No" nil))
- :group 'liece-server)
-
-(defcustom liece-timestamp-interval (* 60 10)
- "Interval in seconds between timestamps in dialogue-buffer, nil for none."
- :type '(radio
- (integer :tag "Seconds"
- :doc "Timestamp Interval in Seconds")
- (const "No" nil))
- :group 'liece-server)
-
-(defcustom liece-connection-timeout 60
- "Default timeout interval."
- :type 'integer
- :group 'liece-server)
-
-(defcustom liece-timestamp-format (concat liece-timestamp-prefix "%s")
- "Format-string for timestamp."
- :type 'string
- :group 'liece-format-string)
-
-;; Conversions: Not used.
-(defcustom liece-send-convert-list nil
- "Convert characters before sending to server."
- :type '(repeat (character :tag "Character"
- :doc "Convert Character"))
- :group 'liece-vars)
-
-(defcustom liece-receive-convert-list nil
- "Convert characters after receiving from server."
- :type '(repeat (character :tag "Character"
- :doc "Convert Character"))
- :group 'liece-vars)
-
-;; Ignores
-(defgroup liece-ignore nil
- "Ignore Settings"
- :tag "Ignore"
- :prefix "liece-"
- :group 'liece-vars)
-
-(defcustom liece-kill-nickname nil
- "List of nicknames to be ignored.
-Messages from these people won't be displayed."
- :type '(repeat (string :tag "Nick" :doc "Ignore Nick"))
- :group 'liece-ignore)
-
-(defcustom liece-kill-realname nil
- "List of real names to be ignored.
-Messages from them won't be displayed."
- :type '(repeat (string :tag "Realname" :doc "Ignore Realname"))
- :group 'liece-ignore)
-
-(defcustom liece-kill-logon nil
- "List of logon names (user@host.dom.ain) to be ignored.
-Messages from them won't be displayed."
- :type '(repeat (string :tag "Logon" :doc "Ignore Logon Name"))
- :group 'liece-ignore)
-
-;; New style ignore.
-(defcustom liece-no-ignore-buffers nil
- "A list of buffers that don't adhere to ignore-list."
- :type '(repeat (string :tag "Buffer" :doc "Don't Ignore Buffer Names"))
- :group 'liece-ignore)
-
-(define-widget 'liece-ignore-spec 'repeat
- "Edit server spec entries"
- :convert-widget 'liece-ignore-spec-convert)
-
-(defun liece-ignore-spec-convert (widget)
- (let* ((type
- '(radio
- (string :tag "Type" :doc "Match for messagetype")
- (const nil)))
- (match
- '(radio
- (string :tag "Match" :doc "Match for string-in-message")
- (const nil)))
- (info-func
- '(function :doc "Function whose return value is ignore info"))
- (user-func
- '(function :doc "Function whose return value is ignore user list"))
- (name
- '(repeat :tag "Name" (string :doc "Ignore user name")))
- (spec
- (` (list :value (nil nil)
- (choice :tag "Message"
- (cons (, type) (, match)) (const nil) (, info-func))
- (choice :tag "User" (const nil) (, user-func) (, name)))))
- (args (` ((, spec)))))
- (widget-put widget :args args)
- widget))
-
-(defcustom liece-ignore-list nil
- "A list of buffers that don't adhere to ignore-list."
- :type 'liece-ignore-spec
- :group 'liece-ignore)
-
-(defcustom liece-compress-changes t
- "Set to t if we want instant compressed messages in the old format."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-compress-treshold 1
- "Number of lines to search back for a previous matching join/part/quit/mode."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-compress-mode-length 3
- "Number of mode compression length."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-buffer-max-size 4242424
- "Maximum size of buffers, the number of characters."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-buffer-min-size (- liece-buffer-max-size 200000)
- "Minimum size of buffers, the number of characters."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-buffer-check-interval (* 60 10)
- "Interval between `buffer-size' checks."
- :type 'integer
- :group 'liece-vars)
-
-(static-when (featurep 'xemacs)
- (define-obsolete-variable-alias 'liece-buffer-maxsize
- 'liece-buffer-max-size)
- (define-obsolete-variable-alias 'liece-buffer-defsize
- 'liece-buffer-min-size)
- (define-obsolete-variable-alias 'liece-checkbuffer-interval
- 'liece-buffer-check-interval))
-
-(defcustom liece-buffer-dispose-function (function bury-buffer)
- "Function called after the buffer was disposed of."
- :type 'function
- :group 'liece-vars)
-
-(defcustom liece-private-window-height 4
- "How tall is the window for private messages when shown."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-format-time-function
- 'liece-compose-time-string
- "Function to convert `current-time-string' to the human readable form.
-If you like to have the short format, set this to nil or to a
-funtion (defun my-format (s) s)."
- :type 'function
- :group 'liece-vars)
-
-(defcustom liece-keep-buffers t
- "When (re)starting IRC, erase contents of old buffers."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-scroll-step nil
- "The number of lines to try scrolling a window by when point moves out."
- :type '(radio (integer :tag "Scroll Step")
- (const nil))
- :group 'liece-look)
-
-(defcustom liece-swap-private nil
- "When showing private is it between under dialogue or not."
- :type 'boolean
- :group 'liece-vars)
-
-(defcustom liece-buffer-preferences
- (list
- (cons ".*" liece-D-buffer))
- "List of lists that contain regexp to match and `buffer-list' to insert.
-Setting this as
-(list
- (cons \"#report\" (list \"*report-buffer*\"))
- (cons \".*\" liece-D-buffer))
-would cause messages from and to channel #report to be displayed on
-buffer named *report-buffer* and all other messages are displayed on
-dialogue-buffer."
- :type '(repeat (cons (string :tag "Channel Name")
- (list (variable :tag "Buffe or Name"))))
- :group 'liece-vars)
-
-(defcustom liece-channel-conversion-map nil
- "The map of channel conversion."
- :type '(repeat (cons (string :tag "Channel Name")
- (string :tag "Channel Name (After Conversion)")))
- :group 'liece-vars)
-
-(defcustom liece-channel-conversion-default-mask "*.jp"
- "The default mask of channel conversion."
- :type 'string
- :group 'liece-vars)
-
-(defcustom liece-channel-id-length 5
- "Length of channel ID for ! channels."
- :type 'integer
- :group 'liece-vars)
-
-(defcustom liece-insert-environment-version nil
- "If non-nil, display version description of current environment."
- :type 'boolean
- :group 'liece-vars)
-
-(provide 'liece-vars)
-
-;;; liece-vars.el ends here
+++ /dev/null
-;;; liece-version.el --- Version information for Liece.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-12-23
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-;;; @ version number constants
-;;;
-
-(require 'product)
-(provide 'liece-version)
-
-(product-provide 'liece-version
- (product-define "Liece" nil '(1 4 9)))
-
-(defconst liece-environment-version
- (concat
- (if (fboundp 'apel-version)
- (concat (apel-version) " ")
- nil)
- (if (featurep 'xemacs)
- (concat (cond
- ((featurep 'utf-2000)
- (concat "UTF-2000-MULE/" utf-2000-version))
- ((featurep 'mule) "MULE"))
- " XEmacs"
- (if (string-match "^[0-9]+\\(\\.[0-9]+\\)" emacs-version)
- (concat
- "/"
- (substring emacs-version 0 (match-end 0))
- (cond ((and (boundp 'xemacs-betaname)
- xemacs-betaname)
- ;; It does not exist in XEmacs
- ;; versions prior to 20.3.
- (concat " " xemacs-betaname))
- ((and (boundp 'emacs-patch-level)
- emacs-patch-level)
- ;; It does not exist in FSF Emacs or in
- ;; XEmacs versions earlier than 21.1.1.
- (format " (patch %d)" emacs-patch-level))
- (t ""))
- " (" xemacs-codename ") ("
- system-configuration ")")
- " (" emacs-version ")"))
- (let ((ver (if (string-match "\\.[0-9]+$" emacs-version)
- (substring emacs-version 0 (match-beginning 0))
- emacs-version)))
- (if (featurep 'mule)
- (if (boundp 'enable-multibyte-characters)
- (concat "Emacs/" ver
- " (" system-configuration ")"
- (if enable-multibyte-characters
- (concat " MULE/" mule-version)
- " (with unibyte mode)")
- (if (featurep 'meadow)
- (let ((mver (Meadow-version)))
- (if (string-match "^Meadow-" mver)
- (concat " Meadow/"
- (substring mver
- (match-end 0))))))
- (if (boundp 'NEMACS)
- (let ((nemacs-version
- (condition-case ()
- (eval '(nemacs-version))
- (error ""))))
- (when (string-match
- "Nemacs version \\([^ ]*\\)"
- nemacs-version)
- (setq nemacs-version
- (match-string 1 nemacs-version)))
- (concat " NEmacs/" nemacs-version))))
- (concat "MULE/" mule-version
- " (based on Emacs " ver ")"))
- (concat "Emacs/" ver " (" system-configuration ")"))))))
-
-(defun liece-version ()
- "Print Liece version."
- (interactive)
- (let ((product-info
- (concat (product-string-1 'liece-version t)
- (if liece-insert-environment-version
- (concat " " liece-environment-version)
- nil))))
- (if (interactive-p)
- (message "%s" product-info)
- product-info)))
-
-;;; liece-version.el ends here
+++ /dev/null
-;;; liece-window.el --- Window configuration style utility.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-01-08
-;; Revised: 1999-07-05
-;; Keywords: window, window configuration
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-misc)
-(require 'liece-intl)
-
-(require 'calist)
-(eval-when-compile (require 'cl))
-
-(defgroup liece-window nil
- "Window configuration"
- :tag "Window configuration"
- :group 'liece)
-
-(defcustom liece-window-min-width 2
- "Minimal width of liece window."
- :type 'integer
- :group 'liece-window)
-
-(defcustom liece-window-min-height 2
- "Minimal height of liece window."
- :type 'integer
- :group 'liece-window)
-
-(defcustom liece-window-style-directory nil
- "Normal position of style configuration files."
- :type 'directory
- :group 'liece-window)
-
-(defcustom liece-window-default-style "bottom"
- "Default style."
- :type 'string
- :group 'liece-window)
-
-(defcustom liece-window-to-buffer
- '((channel . liece-channel-buffer)
- (others . liece-others-buffer)
- (dialogue . liece-dialogue-buffer)
- (command . liece-command-buffer)
- (channel-list . liece-channel-list-buffer)
- (nick . liece-nick-buffer))
- "Window abbreviation to buffer alist."
- :type '(repeat
- (cons (symbol :tag "Abbrev")
- (symbol :tag "Buffer")))
- :group 'liece-window)
-
-(defconst liece-window-split-types '(horizontal vertical))
-
-(defvar liece-window-style-configuration-alist nil)
-(defvar liece-window-current-style nil)
-(defvar liece-window-configuration-stack nil)
-
-(defun liece-window-field-match-method-as-default-rule
- (calist field-type field-value)
- (let* ((field (assq field-type calist)) (value (cdr field)))
- (cond ((null field)
- (cons (cons field-type field-value) calist))
- ((and (symbolp field-value) (eq field-value 'any))
- calist)
- ((and (symbolp value) (eq field-value value))
- calist))))
-
-(define-calist-field-match-method
- 'command-buffer-mode
- 'liece-window-field-match-method-as-default-rule)
-
-(define-calist-field-match-method
- 'channel-buffer-mode
- 'liece-window-field-match-method-as-default-rule)
-
-(define-calist-field-match-method
- 'nick-buffer-mode
- 'liece-window-field-match-method-as-default-rule)
-
-(define-calist-field-match-method
- 'channel-list-buffer-mode
- 'liece-window-field-match-method-as-default-rule)
-
-(defmacro liece-window-add-style (&rest calist)
- `(ctree-set-calist-strictly 'liece-window-style-configuration-alist
- ',calist))
-
-(defmacro liece-window-define-reconfiguration-predicate (name &rest body)
- `(defun-maybe ,name ,@body))
-
-(put 'liece-window-define-reconfiguration-predicate
- 'lisp-indent-function 'defun)
-
-(defmacro liece-window-set-default-style ()
- "Set window configuration with fallback style."
- '(liece-window-add-style
- (command-buffer-mode . any)
- (channel-buffer-mode . any)
- (nick-buffer-mode . any)
- (channel-list-buffer-mode . any)
- (configuration
- (vertical
- 1.0
- (dialogue 1.0)
- (command 4 point)))))
-
-(defsubst liece-window-load-style-file (style)
- "Load style file."
- (condition-case nil
- (progn
- (if (null liece-window-style-directory)
- (setq liece-window-style-directory
- (liece-locate-path "styles")))
- (setq liece-window-style-configuration-alist nil)
- (load (expand-file-name style liece-window-style-directory))
- (setq liece-window-current-style style))
- (error
- (liece-message "Style file load failed.")
- (liece-window-set-default-style))))
-
-(defmacro liece-window-percent-to-rate (percent)
- `(/ ,percent 100.0))
-
-(defmacro liece-window-to-buffer-helper (window)
- `(cond ((symbolp ,window)
- (symbol-value ,window))
- (t ,window)))
-
-(defmacro liece-window-safe-select-window (window)
- `(if ,window (select-window ,window)))
-
-;;;###liece-autoload
-(defun liece-command-set-window-style (style)
- (interactive
- (let ((styles (directory-files liece-window-style-directory)))
- (list
- (liece-minibuffer-completing-read
- "Window style: " (list-to-alist styles) nil t nil nil
- liece-window-current-style))))
- (liece-window-load-style-file style))
-
-(defun liece-command-reload-window-style ()
- (interactive)
- (liece-window-load-style-file
- (or liece-window-current-style
- liece-window-default-style)))
-
-(defmacro liece-window-default-reconfiguration-predicate ()
- '(or (one-window-p t)
- (null (liece-get-buffer-window liece-command-buffer))
- (and (not liece-channel-buffer-mode)
- (null (liece-get-buffer-window liece-dialogue-buffer)))
- (and liece-channel-buffer-mode
- (null (liece-get-buffer-window liece-channel-buffer))
- (null (liece-get-buffer-window liece-others-buffer)))
- (and liece-channel-buffer-mode
- (if liece-nick-buffer-mode
- (null (liece-get-buffer-window liece-nick-buffer))
- (not (null (liece-get-buffer-window liece-nick-buffer)))))
- (if liece-channel-list-buffer-mode
- (null (liece-get-buffer-window liece-channel-list-buffer))
- (not (null (liece-get-buffer-window liece-channel-list-buffer))))))
-
-;;;###liece-autoload
-(defun liece-configure-windows ()
- (let ((liece-nick-buffer-mode liece-nick-buffer-mode)
- (liece-channel-buffer-mode liece-channel-buffer-mode)
- situation calist split predicate)
- (if (and (get 'liece-nick-buffer-mode 'hide)
- liece-nick-window-auto-hide)
- (setq liece-nick-buffer-mode nil))
- (if (not (liece-channel-last
- (if (eq liece-command-buffer-mode 'chat)
- liece-current-chat-partners
- liece-current-channels)))
- (setq liece-channel-buffer-mode nil))
- (setq situation
- `((channel-buffer-mode . ,liece-channel-buffer-mode)
- (nick-buffer-mode . ,liece-nick-buffer-mode)
- (channel-list-buffer-mode . ,liece-channel-list-buffer-mode)
- (command-buffer-mode . ,liece-command-buffer-mode)))
- (or liece-window-current-style
- (liece-command-set-window-style liece-window-default-style))
- (setq calist (ctree-match-calist liece-window-style-configuration-alist
- situation)
- split (cadr (assq 'configuration calist))
- predicate (cdr (assq 'reconfiguration-predicate calist)))
- (when (and split
- (or (null predicate)
- (and predicate
- (liece-functionp predicate)
- (funcall predicate))))
- (if (not (eq liece-truncate-partial-width-windows
- truncate-partial-width-windows))
- (setq truncate-partial-width-windows
- liece-truncate-partial-width-windows))
- (if liece-use-full-window (delete-other-windows))
- (save-excursion
- (switch-to-buffer liece-command-buffer) ;; u-mu.
- (liece-window-configure-frame split)))))
-
-(defun liece-window-configure-frame (split &optional window)
- (or window
- (setq window (get-buffer-window (current-buffer))))
- (liece-window-safe-select-window window)
- (while (and (not (assq (car split) liece-window-to-buffer))
- (liece-functionp (car split)))
- (setq split (eval split)))
- (let* ((type (car split))
- (subs (cddr split))
- (len (if (eq type 'horizontal) (window-width) (window-height)))
- (total 0)
- (window-min-width
- (or liece-window-min-width window-min-width))
- (window-min-height
- (or liece-window-min-height window-min-height))
- s result new-win rest comp-subs size sub)
- (cond
- ;; Nothing to do here.
- ((null split))
- ;; Don't switch buffers.
- ((null type)
- (and (memq 'point split) window))
- ;; This is a buffer to be selected.
- ((not (memq type '(horizontal vertical)))
- (let ((buffer (cond ((stringp type) type)
- (t (cdr (assq type liece-window-to-buffer))))))
- (unless buffer
- (error "Illegal buffer type: %s" type))
- (switch-to-buffer
- (liece-window-to-buffer-helper buffer))
- ;; We return the window if it has the `point' spec.
- (and (memq 'point split) window)))
- (t
- (when (> (length subs) 0)
- ;; First we have to compute the sizes of all new windows.
- (while subs
- (setq sub (append (pop subs) nil))
- (while (and (not (assq (car sub) liece-window-to-buffer))
- (liece-functionp (car sub)))
- (setq sub (eval sub)))
- (when sub
- (push sub comp-subs)
- (setq size (cadar comp-subs))
- (cond ((equal size 1.0)
- (setq rest (car comp-subs))
- (setq s 0))
- ((floatp size)
- (setq s (floor (* size len))))
- ((integerp size)
- (setq s size))
- ((symbolp size)
- (setq s
- (floor
- (* (liece-window-percent-to-rate
- (symbol-value size))
- len))))
- (t
- (error "Illegal size: %s" size)))
- ;; Try to make sure that we are inside the safe limits.
- (cond ((zerop s))
- ((eq type 'horizontal)
- (setq s (max s window-min-width)))
- ((eq type 'vertical)
- (setq s (max s window-min-height))))
- (setcar (cdar comp-subs) s)
- (incf total s)))
- ;; Take care of the "1.0" spec.
- (if rest
- (setcar (cdr rest) (- len total))
- (error "No 1.0 specs in %s" split))
- ;; The we do the actual splitting in a nice recursive
- ;; fashion.
- (setq comp-subs (nreverse comp-subs))
- (while comp-subs
- (if (null (cdr comp-subs))
- (setq new-win window)
- (setq new-win
- (split-window window (cadar comp-subs)
- (eq type 'horizontal))))
- (setq result (or (liece-window-configure-frame
- (car comp-subs) window)
- result))
- (liece-window-safe-select-window new-win)
- (setq window new-win)
- (setq comp-subs (cdr comp-subs))))
- ;; Return the proper window, if any.
- (liece-window-safe-select-window result)))))
-
-(defun liece-window-configuration-push ()
- (let ((frame (selected-frame))
- (config (current-window-configuration)))
- (push (list frame config)
- liece-window-configuration-stack)))
-
-(defun liece-window-configuration-pop ()
- (let* ((frame (selected-frame))
- (triple (assq frame liece-window-configuration-stack)))
- (when (and triple (window-configuration-p (cadr triple)))
- (set-window-configuration (cadr triple))
- (if (setq frame (assq frame liece-window-configuration-stack))
- (setq liece-window-configuration-stack
- (delq frame liece-window-configuration-stack))))
- liece-window-configuration-stack))
-
-(provide 'liece-window)
-
-;;; liece-window.el ends here
+++ /dev/null
-;;; liece-x-face.el --- X-Face wrappers.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1998-11-25
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile (require 'liece-compat))
-
-(require 'path-util)
-
-(defvar liece-x-face-insert-function
- (when (and (module-installed-p 'bitmap) (module-installed-p 'x-face))
- (function liece-x-face-insert-with-bitmap)))
-
-(eval-and-compile
- (autoload 'x-face-encode "x-face")
- (autoload 'x-face-read-existing-file-name "x-face")
- (autoload 'x-face-icons-to-xbm "x-face")
- (autoload 'x-face-x-face-encoded-string-to-icon-string "x-face")
- (autoload 'bitmap-insert-xbm-buffer "bitmap")
- (autoload 'bitmap-decode-xbm "bitmap")
- (autoload 'bitmap-read-xbm-buffer "bitmap")
- (autoload 'bitmap-compose "bitmap"))
-
-(defalias 'liece-x-face-encode 'x-face-encode)
-(defalias 'liece-x-face-read-existing-file-name
- 'x-face-read-existing-file-name)
-
-(defun liece-x-face-insert-with-bitmap (buffer str nick)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-max))
- (let* (buffer-read-only
- (buf (x-face-icons-to-xbm
- nick 1 1
- (x-face-x-face-encoded-string-to-icon-string str)))
- (cmp (bitmap-decode-xbm (bitmap-read-xbm-buffer buf)))
- (len (length cmp)) (col (current-column))
- (prefix (buffer-substring
- (line-beginning-position) (point))) pt)
- (delete-region (line-beginning-position) (point))
- (dotimes (i len)
- (insert ?\n)
- (if (= i (/ len 2))
- (insert prefix)
- (move-to-column col t))
- (setq pt (point))
- (insert (bitmap-compose (aref cmp i)))
- (overlay-put
- (make-overlay pt (point)) 'face 'liece-client-face)))))
-
-(defun liece-x-face-insert (buffers str nick)
- (cond
- ((or (not buffers) (listp buffers))
- (dolist (buffer buffers)
- (liece-x-face-insert buffer str nick)))
- ((fboundp liece-x-face-insert-function)
- (funcall liece-x-face-insert-function buffers str nick))))
-
-(provide 'liece-x-face)
-
-;;; liece-x-face.el ends here
+++ /dev/null
-;;; liece-xemacs.el --- XEmacs specific routines.
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 1999-08-22
-;; Keywords: emulation
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'liece-inlines)
- (require 'liece-misc)
- (require 'liece-commands))
-
-(autoload 'liece-command-dcc-send "liece-dcc")
-(defvar liece-nick-popup-menu)
-
-(defgroup liece-toolbar nil
- "Toolbar of your XEmacs"
- :tag "Toolbar"
- :group 'liece)
-
-(defgroup liece-toolbar-icons nil
- "Toolbar Icons of your XEmacs"
- :tag "Toolbar Icons"
- :prefix "liece-toolbar-"
- :group 'liece)
-
-(defmacro liece-xemacs-icon-path (file)
- "Search icon FILE and return absolete path of the file."
- `(or (and liece-icon-directory
- (expand-file-name ,file liece-icon-directory))
- (let ((path (liece-find-path ,file "icons")))
- (when path
- (setq liece-icon-directory
- (file-name-directory path)))
- path)))
-
-(define-widget 'liece-toolbar-icon 'list
- "Edit toolbar spec entries"
- :match (lambda (widget value)
- (valid-plist-p value))
- :convert-widget 'liece-toolbar-icon-convert)
-
-(eval-and-compile
- (defconst liece-toolbar-icon-states
- '(:up :down :disabled :cap-up :cap-down :cap-disabled)
- "toolbar event states")
-
- (defun liece-toolbar-icon-convert-1 (state)
- (list 'group :inline t :format "%t: %v"
- :tag (capitalize (substring (symbol-name state) 1))
- (list 'const :format "" :value state
- (list 'radio '(const :tag "none" nil) 'file)))))
-
-(defun liece-toolbar-icon-convert (widget)
- "Widget converter of the WIDGET `liece-toolbar-icon'."
- (apply #'widget-put widget :args
- (eval-when-compile
- (mapcar #'liece-toolbar-icon-convert-1
- liece-toolbar-icon-states)))
- widget)
-
-(defcustom liece-use-toolbar (if (featurep 'toolbar)
- 'default-toolbar
- nil)
- "*If nil, do not use a toolbar.
-If it is non-nil, it must be a toolbar. The five valid values are
-`default-toolbar', `top-toolbar', `bottom-toolbar',
-`right-toolbar', and `left-toolbar'."
- :type '(choice (const default-toolbar)
- (const top-toolbar) (const bottom-toolbar)
- (const left-toolbar) (const right-toolbar)
- (const :tag "no toolbar" nil))
- :group 'liece-toolbar)
-
-(defcustom liece-toolbar-back-icon '(:up "back.xpm")
- "Back button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-forward-icon '(:up "forward.xpm")
- "Forward button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-reload-icon '(:up "reload.xpm")
- "Reload button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-home-icon '(:up "home.xpm")
- "Home button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-search-icon '(:up "search.xpm")
- "Search button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-location-icon '(:up "location.xpm")
- "Location button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-toolbar-stop-icon '(:up "stop.xpm")
- "Stop button."
- :type 'liece-toolbar-icon
- :group 'liece-toolbar-icons)
-
-(defcustom liece-xemacs-unread-icon "balloon.xpm"
- "Unread icon."
- :type 'file
- :group 'liece-look)
-
-;;; @ internal variables
-;;;
-(defvar liece-glyph-cache nil)
-(defvar liece-toolbar-position (if (featurep 'toolbar)
- (default-toolbar-position)
- nil))
-
-(defvar liece-toolbar-back-glyph nil)
-(defvar liece-toolbar-forward-glyph nil)
-(defvar liece-toolbar-reload-glyph nil)
-(defvar liece-toolbar-home-glyph nil)
-(defvar liece-toolbar-search-glyph nil)
-(defvar liece-toolbar-location-glyph nil)
-(defvar liece-toolbar-stop-glyph nil)
-
-(defvar liece-toolbar-spec-list
- '([liece-toolbar-back-glyph
- liece-command-previous-channel t "Previous Channel"]
- [liece-toolbar-forward-glyph
- liece-command-next-channel t "Next Channel"]
- [liece-toolbar-reload-glyph
- liece-command-list t "List Channel"]
- [liece-toolbar-home-glyph
- liece-switch-to-channel-no-1 t "Go Home Channel"]
- [liece-toolbar-search-glyph
- liece-command-finger t "Finger"]
- [liece-toolbar-location-glyph
- liece-command-join t "Join Channel"]
- [liece-toolbar-stop-glyph
- liece-command-quit t "Quit IRC"]))
-
-;;; @ toolbar icons
-;;;
-(defun liece-toolbar-icon-plist-get (spec prop)
- "Return absolete path of icon file which SPEC has PROP."
- (let ((icon (plist-get spec prop)))
- (if icon (liece-locate-icon-file icon))))
-
-(defun liece-toolbar-map-button-list (plist)
- "Make toolbar icon list based on status PLIST."
- (apply #'toolbar-make-button-list
- (mapcar
- (lambda (prop)
- (liece-toolbar-icon-plist-get plist prop))
- liece-toolbar-icon-states)))
-
-(defun liece-xemacs-setup-toolbar (bar &optional force)
- "Prepare icons of toolbar BAR.
-If optional argument FORCE is non-nil, always update toolbar."
- (let (icon plist)
- (set-default-toolbar-position liece-toolbar-position)
- (dolist (spec bar)
- (setq icon (aref spec 0)
- plist (symbol-value
- (intern (concat
- (substring (prin1-to-string icon) -5 0)
- "icon"))))
- (when (or force
- (not (symbol-value icon)))
- (set icon (liece-toolbar-map-button-list plist))))
- (run-hooks 'liece-xemacs-setup-toolbar-hook)))
-
-;;; @ modeline decoration
-;;;
-(defun liece-xemacs-hide-modeline ()
- "Remove modeline from current window."
- (set-specifier has-modeline-p nil (current-buffer)))
-
-(when (featurep 'scrollbar)
- (defun liece-xemacs-hide-scrollbars ()
- (static-cond
- ((boundp 'horizontal-scrollbar-visible-p)
- (set-specifier horizontal-scrollbar-visible-p nil (current-buffer)))
- ((boundp 'scrollbar-height)
- (set-specifier scrollbar-height 0 (current-buffer)))))
- (add-hook 'liece-nick-mode-hook 'liece-xemacs-hide-scrollbars)
- (add-hook 'liece-channel-list-mode-hook 'liece-xemacs-hide-scrollbars))
-
-(add-hook 'liece-nick-mode-hook 'liece-xemacs-hide-modeline)
-(add-hook 'liece-channel-list-mode-hook 'liece-xemacs-hide-modeline)
-
-(defvar liece-xemacs-modeline-left-extent
- (let ((ext (copy-extent modeline-buffer-id-left-extent)))
- ext))
-
-(defvar liece-xemacs-modeline-right-extent
- (let ((ext (copy-extent modeline-buffer-id-right-extent)))
- ext))
-
-(add-hook 'liece-command-mode-hook 'liece-setup-toolbar)
-
-(defun liece-setup-toolbar ()
- "Prepare toolbar if wanted."
- (when liece-use-toolbar
- (liece-xemacs-setup-toolbar liece-toolbar-spec-list)
- (set-specifier (symbol-value liece-use-toolbar) liece-toolbar-spec-list
- (current-buffer))))
-
-(defun liece-xemacs-modeline-glyph ()
- "Return a glyph of modeline pointer."
- (let ((glyph
- (let (file)
- (make-glyph
- (nconc
- (if (and (featurep 'xpm)
- (setq file (liece-locate-icon-file "liece-pointer.xpm")))
- (list (vector 'xpm :file file)))
- (if (and (featurep 'xbm)
- (setq file (liece-locate-icon-file "liece-pointer.xbm")))
- (list (vector 'xbm :file file)))
- '([string :data "Liece:"]))))))
- (set-glyph-face glyph 'modeline-buffer-id)
- glyph))
-
-(defun liece-xemacs-mode-line-buffer-identification (line)
- "Decorate 1st element of `mode-line-buffer-identification' LINE.
-Modify whole identification by side effect."
- (let ((id (car line)) chop)
- (if (and (stringp id) (string-match "^Liece:" id))
- (progn
- (setq chop (match-end 0))
- (nconc
- (list
- (let ((glyph (liece-xemacs-modeline-glyph)))
- (if glyph
- (cons liece-xemacs-modeline-left-extent glyph)
- (cons liece-xemacs-modeline-left-extent
- (substring id 0 chop))))
- (cons liece-xemacs-modeline-right-extent
- (substring id chop)))
- (cdr line)))
- line)))
-
-(defun liece-xemacs-suppress-modeline-format ()
- "Remove unnecessary information from `modeline-format'."
- (setq modeline-format
- (remrassq 'modeline-modified
- (delq 'modeline-multibyte-status
- (copy-sequence mode-line-format)))))
-
-;;; @ menus
-;;;
-(defun liece-xemacs-nick-popup-menu (widget &optional event)
- "Trigger function for popup menu."
- (let ((pos (widget-event-point event)))
- (when pos
- (goto-char pos)
- (if (eq major-mode 'liece-nick-mode)
- (liece-nick-update-region))
- (let ((menu (cdr liece-nick-popup-menu)))
- (setq menu (nconc (list "IRCHAT" ; title: not displayed
- " IRC commands"
- "--:shadowDoubleEtchedOut")
- (mapcar (lambda (spec)
- (if (stringp spec)
- "--:shadowEtchedOut"
- spec))
- menu)))
- (let (popup-menu-titles)
- (popup-menu menu))))))
-
-(fset 'liece-nick-popup-menu 'liece-xemacs-nick-popup-menu)
-
-;;; @ nick buffer decoration
-;;;
-(defun liece-xemacs-create-nick-glyph (file &optional string)
- "Return a glyph of nick indicator from FILE or STRING."
- (or
- (cdr-safe (assoc file liece-glyph-cache))
- (let ((glyph
- (make-glyph
- (nconc
- (if (and (featurep 'xpm)
- (setq file (liece-locate-icon-file file)))
- (list (vector 'xpm :file file)))
- (if string
- (list (vector 'string :data string)))))))
- (push (cons file glyph) liece-glyph-cache)
- (set-glyph-face glyph 'default)
- glyph)))
-
-(defun liece-xemacs-glyph-nick-region (start end)
- "Decorate nick buffer between START and END."
- (save-excursion
- (setq start (progn (goto-char start)(beginning-of-line)(point))
- end (progn (goto-char end)(beginning-of-line 2)(point)))
- (save-restriction
- (narrow-to-region start end)
- (let ((buffer-read-only nil)
- (inhibit-read-only t)
- (case-fold-search nil)
- mark file glyph ext ant)
- (map-extents
- (lambda (e void)
- (when (or
- (extent-property
- e 'liece-xemacs-glyph-nick-extent)
- (extent-property
- e 'liece-xemacs-glyph-nick-annotation))
- (delete-extent e)))
- (current-buffer) start end)
- (dolist (entry liece-nick-image-alist)
- (setq mark (car entry)
- file (cdr entry)
- glyph (liece-xemacs-create-nick-glyph
- file (char-to-string mark)))
- (when glyph
- (goto-char start)
- (while (not (eobp))
- (when (eq (char-after) mark)
- (mapcar 'delete-annotation
- (annotations-at (1+ (point))))
- (setq ext (make-extent (point) (1+ (point)))
- ant (make-annotation glyph (1+ (point)) 'text))
- (set-extent-property ext 'end-open t)
- (set-extent-property ext 'start-open t)
- (set-extent-property ext 'invisible t)
- (set-extent-property ext 'intangible t)
- (set-extent-property
- ant 'liece-xemacs-glyph-nick-extent ext)
- (set-extent-property
- ext 'liece-xemacs-glyph-nick-annotation ant))
- (beginning-of-line 2))))))))
-
-(defun liece-xemacs-set-drop-functions (start end)
- "Initialize drag and drop in DCC between START and END.
-This function needs window system independent drag and drop
-support (21.0 b39 or later)"
- (interactive "r")
- (liece-xemacs-set-drop-functions-buffer
- (current-buffer) start end)
- (goto-char end))
-
-(defun liece-xemacs-set-drop-functions-buffer (&optional buffer start end)
- "Initialize BUFFER drag and drop DCC settings between START and END.
-This function needs window system independent drag and drop
-support (21.0 b39 or later)"
- (interactive)
- (when (and (featurep 'x) (featurep 'dragdrop))
- (save-excursion
- (when buffer
- (set-buffer buffer))
- (setq start (or start (point-min))
- end (or end (point-max)))
- (goto-char start)
- (setq start (line-beginning-position))
- (goto-char end)
- (setq end (line-beginning-position))
- (goto-char end)
- (when (not (eobp))
- (beginning-of-line 2)
- (setq end (point)))
- (save-restriction
- (narrow-to-region start end)
- (let (buffer-read-only case-fold-search)
- (map-extents
- (function
- (lambda (e void)
- (when (extent-property e 'liece-xemacs-drop-extent)
- (delete-extent e))))
- buffer start end)
- (goto-char start)
- (let (st nd nick func)
- (while (not (eobp))
- (forward-char)
- (setq st (point)
- nd (line-end-position)
- nick (buffer-substring st nd))
- (mapcar 'delete-annotation (annotations-at nd))
- (setq func (intern (concat "liece-xemacs-drop-function-" nick)))
- (fset func
- (list 'lambda (list 'object)
- (list 'liece-xemacs-drop-function 'object nick)))
- (let ((ext (make-extent st nd)))
- (set-extent-property ext 'liece-xemacs-drop-extent t)
- (set-extent-property ext 'dragdrop-drop-functions (list func)))
- (beginning-of-line 2))))))))
-
-(defun liece-xemacs-drop-function (object nick)
- "Drag and drop handler.
-Always two arguments are passed, OBJECT and NICK."
- (if (and (eq (car object) 'dragdrop_URL)
- (stringp (cdr object))
- (string-match "^[^:]*:\\(.*\\)" (cdr object)))
- (let ((filename (match-string 1 (cdr object))))
- (liece-command-dcc-send filename nick))))
-
-(eval-and-compile
- (setq liece-x-face-insert-function
- (function liece-x-face-insert-with-xemacs))
-
- (defun liece-x-face-insert-with-xemacs (buffer str nick)
- (save-excursion
- (let ((glyph (cdr-safe (assoc nick liece-glyph-cache))))
- (unless glyph
- (setq glyph (make-glyph
- (list (vector 'xface :data str)
- (vector 'string :data str))))
- (when glyph
- (push (cons nick glyph) liece-glyph-cache)
- (set-glyph-face glyph 'default)))
- (set-buffer buffer)
- (goto-char (point-max))
- (when glyph
- (set-extent-end-glyph (make-extent (point) (point)) glyph))))))
-
-;;; @ startup splash
-;;;
-(eval-when-compile
- (defvar filename)
- (setq load-path
- `(,(if (and (boundp 'filename)
- (stringp filename)
- (file-exists-p filename))
- (file-name-directory filename)
- default-directory)
- ,@load-path)))
-
-(when (featurep 'xpm)
- (eval-when-compile
- (defmacro liece-xemacs-logo ()
- (let ((logo "liece.xpm")
- (dir (if (and (boundp 'filename)
- (stringp filename)
- (file-exists-p filename))
- (file-name-directory filename)
- default-directory)))
- (setq logo (expand-file-name logo dir))
- (if (file-exists-p logo)
- (let ((buffer (generate-new-buffer " *liece-logo*"))
- (coding-system-for-read (quote binary))
- buffer-file-format format-alist
- insert-file-contents-post-hook
- insert-file-contents-pre-hook)
- (prog1
- (save-excursion
- (set-buffer buffer)
- (insert-file-contents logo)
- (buffer-string))
- (kill-buffer buffer)))
- (progn
- (byte-compile-warn
- "Warning: file \"%s\" not found." logo)
- (sit-for 2)
- nil))))))
-
-(defconst liece-xemacs-logo
- (when (featurep 'xpm)
- (liece-xemacs-logo)))
-
-(defun liece-xemacs-splash-at-point (&optional height)
- "Display splash logo in HEIGHT."
- (or (bolp) (insert "\n"))
- (let ((bow (point))
- (glyph (make-glyph
- (list (vector 'xpm :data liece-xemacs-logo)
- [nothing])))
- (lh (/ (window-pixel-height) (window-height)))
- (lw (/ (window-pixel-width) (window-width)))
- (liece-insert-environment-version nil)
- bov)
-
- (insert-char ?\n (max 0 (/ (- (or height (window-height))
- (/ (glyph-height glyph) lh))
- 2)))
- (insert-char ?\ (max 0 (/ (- (window-width)
- (/ (glyph-width glyph) lw))
- 2)))
- (set-extent-end-glyph
- (make-extent (point) (point))
- glyph)
- (insert "\n")
- (insert-char ?\ (max 0 (/ (- (window-width) (length (liece-version))) 2)))
- (setq bov (point))
- (insert (liece-version))
- (and (find-face 'bold-italic)
- (put-text-property bov (point) 'face 'bold-italic))
- (goto-char bow)
- (set-window-start (get-buffer-window (current-buffer)) (point))
- (redisplay-frame)))
-
-(defun liece-xemacs-splash (&optional arg)
- "Display splash logo interactively.
-If ARG is given, don't hide splash buffer."
- (interactive "P")
- (and liece-xemacs-logo
- (let ((frame (selected-frame))
- config buffer
- (liece-insert-environment-version nil))
- (and frame
- (unwind-protect
- (progn
- (setq config (current-window-configuration))
- (setq buffer (generate-new-buffer
- (concat (if arg "*" " *")
- (liece-version) "*")))
- (switch-to-buffer buffer)
- (delete-other-windows)
- (liece-xemacs-splash-at-point)
- (set-buffer-modified-p nil)
- (or arg (sleep-for 2)))
- (unless arg
- (kill-buffer buffer)
- (set-window-configuration config)
- (redisplay-frame frame)))))))
-
-(unless (or liece-inhibit-startup-message
- (eq 'stream (device-type)))
- (liece-xemacs-splash))
-
-;;; @ unread mark
-;;;
-(defun liece-xemacs-unread-mark (chnl)
- (if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let* ((buffer-read-only nil)
- (file (liece-locate-icon-file liece-xemacs-unread-icon))
- (glyph
- (make-glyph
- (nconc (if (and (featurep 'xpm) file)
- (list (vector 'xpm :file file)))
- (list (vector 'string
- :data liece-channel-unread-character)))))
- ext)
- (goto-char (point-min))
- (when (re-search-forward (concat "^ ?[0-9]+: " chnl "$") nil t)
- (goto-char (match-end 0))
- (insert " ")
- (setq ext (make-extent (match-end 0) (1+ (match-end 0))))
- (set-extent-end-glyph ext glyph))))))
-
-(defun liece-xemacs-read-mark (chnl)
- (if liece-display-unread-mark
- (with-current-buffer liece-channel-list-buffer
- (let ((buffer-read-only nil))
- (goto-char (point-min))
- (when (re-search-forward (concat "^ ?[0-9]+: " chnl " $") nil t)
- (goto-char (1- (match-end 0)))
- (delete-char 1))))))
-
-(defun liece-xemacs-redisplay-unread-mark ()
- (if liece-display-unread-mark
- (dolist (chnl liece-channel-unread-list)
- (liece-xemacs-unread-mark chnl))))
-
-\f
-;;; @ emulation functions
-;;;
-(defun liece-xemacs-map-extents (function)
- "Map FUNCTION over the extents which overlap the current buffer."
- (map-extents (lambda (extent ignore)
- (if (overlayp extent) (funcall function extent)))))
-
-(defun liece-xemacs-kill-all-overlays ()
- "Delete all extents in the current buffer."
- (liece-xemacs-map-extents #'delete-extent))
-
-(defun liece-xemacs-overlays-at (pos)
- "Return a list of the overlays that contain position POS."
- (let ((ext (extent-at pos)))
- (and ext (overlayp ext) (list ext))))
-
-(fset 'liece-mode-line-buffer-identification
- 'liece-xemacs-mode-line-buffer-identification)
-
-(fset 'liece-suppress-mode-line-format
- 'liece-xemacs-suppress-modeline-format)
-
-(fset 'liece-kill-all-overlays 'liece-xemacs-kill-all-overlays)
-(fset 'liece-map-overlays 'liece-xemacs-map-extents)
-(fset 'liece-locate-data-directory 'locate-data-directory)
-
-(add-hook 'liece-nick-insert-hook 'liece-xemacs-glyph-nick-region)
-(add-hook 'liece-nick-insert-hook 'liece-xemacs-set-drop-functions)
-
-(add-hook 'liece-nick-replace-hook 'liece-xemacs-glyph-nick-region)
-(add-hook 'liece-nick-replace-hook 'liece-xemacs-set-drop-functions)
-
-(fset 'liece-redisplay-unread-mark 'liece-xemacs-redisplay-unread-mark)
-(add-hook 'liece-channel-unread-functions 'liece-xemacs-unread-mark)
-(add-hook 'liece-channel-read-functions 'liece-xemacs-read-mark)
-
-(provide 'liece-xemacs)
-
-;;; liece-xemacs.el ends here
-
+++ /dev/null
-;;; liece.el --- IRC client for Emacsen
-;; Copyright (C) 1998-2000 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Revised: 2000-03-20
-;; Keywords: IRC, liece
-
-;; This file is part of Liece.
-
-;; This program 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.
-
-;; This program 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:
-;;
-
-;;; Code:
-
-(require 'liece-inlines)
-(require 'liece-handle)
-(require 'liece-filter)
-(require 'liece-hilit)
-(require 'liece-intl)
-(require 'liece-menu)
-(require 'liece-window)
-(require 'liece-tcp)
-(if (featurep 'xemacs)
- (require 'liece-xemacs)
- (require 'liece-emacs))
-(require 'liece-commands)
-
-(autoload 'mule-caesar-region "mule-caesar" nil t)
-(autoload 'liece-command-browse-url "liece-url" nil t)
-(autoload 'liece-command-dcc-send "liece-dcc" nil t)
-(autoload 'liece-command-dcc-receive "liece-dcc" nil t)
-(autoload 'liece-command-dcc-list "liece-dcc" nil t)
-(autoload 'liece-command-dcc-chat-listen "liece-dcc" nil t)
-(autoload 'liece-command-dcc-chat-connect "liece-dcc" nil t)
-(autoload 'liece-command-dcc-accept "liece-dcc" nil t)
-(autoload 'liece-command-mail-compose "liece-mail" nil t)
-(autoload 'liece-command-submit-bug-report "liece-mail" nil t)
-
-(eval-and-compile
- (defvar liece-server-keyword-map
- '((:host (getenv "IRCSERVER"))
- (:service liece-service)
- (:password liece-password)
- (:prescript)
- (:prescript-delay)
- (:type liece-tcp-connection-type)
- (:relay))
- "Mapping from keywords to default values.
-All keywords that can be used must be listed here."))
-
-(add-hook 'kill-emacs-hook 'liece-command-quit)
-
-(defvar liece-tmp-server-name nil "Temporaly server name.")
-(defvar liece-buffer-last-check-time nil)
-(defvar liece-timers-list-initialized-p nil
- "Are liece internal timers in place?")
-
-(defconst liece-obarray-size 1327
- "The size of obarray used by liece on channelname and username space.
-For efficiency this should be prime. See documentation of intern and
-`make-vector' for more information. Here is a list of some small primes...
-
-13, 29, 37, 47, 59, 71, 89, 107, 131, 163, 197, 239, 293, 353, 431, 521,
-631, 761, 919, 1103, 1327, 1597, 1931, 2333, 2801, 3371, 4049, 4861, 5839,
-7013, 8419, 10103, 12143, 14591, 17519, 21023, 25229, 30293, 36353,
-43627, 52361, 62851, 75431, 90523, 108631, 130363, 156437, 187751,
-225307, 270371, 324449, 389357, 467237, 560689, 672827, 807403, 968897,
-1162687, 1395263, 1674319, 2009191, 2411033, 2893249.")
-
-(defvar liece-channel-list-mode-map (make-sparse-keymap))
-(defvar liece-nick-mode-map (make-sparse-keymap))
-(defvar liece-client-query-map (make-sparse-keymap))
-(defvar liece-dcc-map (make-sparse-keymap))
-(defvar liece-friends-map (make-sparse-keymap))
-
-(defvar liece-dialogue-mode-map
- (let ((keymap (make-keymap)))
- (suppress-keymap keymap 'nodigit)
- keymap))
-
-(defvar liece-command-mode-map (make-keymap))
-(defvar liece-command-map (make-sparse-keymap))
-
-(defvar liece-command-mode-syntax-table nil)
-
-(put 'liece-command-mode 'mode-class 'special)
-(put 'liece-dialogue-mode 'mode-class 'special)
-(put 'liece-channel-list-mode 'mode-class 'special)
-(put 'liece-nick-mode 'mode-class 'special)
-(put 'liece-channel-mode 'derived-mode-parent 'liece-dialogue-mode)
-(put 'liece-others-mode 'derived-mode-parent 'liece-dialogue-mode)
-
-(defvar liece-buffer-mode-alist
- '((liece-dialogue-buffer liece-dialogue-mode)
- (liece-others-buffer liece-others-mode)
- (liece-channel-list-buffer liece-channel-list-mode)
- (liece-private-buffer liece-dialogue-mode)
- (liece-KILLS-buffer)
- (liece-IGNORED-buffer)
- (liece-WALLOPS-buffer)))
-
-(eval-and-compile
- (dotimes (n 20)
- (fset (intern (format "liece-switch-to-channel-no-%d" (1+ n)))
- `(lambda ()
- (interactive)
- (funcall #'liece-switch-to-channel-no ,n)))))
-
-(defvar liece-select-keys
- '("1" liece-switch-to-channel-no-1
- "2" liece-switch-to-channel-no-2
- "3" liece-switch-to-channel-no-3
- "4" liece-switch-to-channel-no-4
- "5" liece-switch-to-channel-no-5
- "6" liece-switch-to-channel-no-6
- "7" liece-switch-to-channel-no-7
- "8" liece-switch-to-channel-no-8
- "9" liece-switch-to-channel-no-9
- "0" liece-switch-to-channel-no-10
- "\C-c1" liece-switch-to-channel-no-11
- "\C-c2" liece-switch-to-channel-no-12
- "\C-c3" liece-switch-to-channel-no-13
- "\C-c4" liece-switch-to-channel-no-14
- "\C-c5" liece-switch-to-channel-no-15
- "\C-c6" liece-switch-to-channel-no-16
- "\C-c7" liece-switch-to-channel-no-17
- "\C-c8" liece-switch-to-channel-no-18
- "\C-c9" liece-switch-to-channel-no-19
- "\C-c0" liece-switch-to-channel-no-20))
-
-;;; Keymap macros. -- borrowed from `gnus-util.el'.
-(defmacro liece-local-set-keys (&rest plist)
- "Set the keys in PLIST in the current keymap."
- `(liece-define-keys-1 (current-local-map) ',plist))
-
-(defmacro liece-define-keys (keymap &rest plist)
- "Assign KEYMAP keys from PLIST."
- `(liece-define-keys-1 ',keymap ',plist))
-
-(defmacro liece-define-keys-safe (keymap &rest plist)
- "Assign KEYMAP keys from PLIST without overwriting previous definitions."
- `(liece-define-keys-1 ',keymap ',plist t))
-
-(put 'liece-define-keys 'lisp-indent-function 1)
-(put 'liece-define-keys-safe 'lisp-indent-function 1)
-(put 'liece-local-set-keys 'lisp-indent-function 1)
-
-(defun liece-define-keys-1 (keymap plist &optional safe)
- "Assign KEYMAP keys from PLIST.
-If optional argument SAFE is nil, overwrite previous definitions."
- (unless keymap
- (error "Can't set keys in a null keymap"))
- (cond
- ((symbolp keymap)
- (setq keymap (symbol-value keymap)))
- ((keymapp keymap))
- ((listp keymap)
- (set (car keymap) nil)
- (define-prefix-command (car keymap))
- (define-key (symbol-value (caddr keymap)) (cadr keymap) (car keymap))
- (setq keymap (symbol-value (car keymap)))))
- (let (key)
- (while plist
- (when (symbolp (setq key (pop plist)))
- (setq key (symbol-value key)))
- (if (or (not safe)
- (eq (lookup-key keymap key) 'undefined))
- (define-key keymap key (pop plist))
- (pop plist)))))
-
-(when t
- (liece-define-keys liece-dialogue-mode-map
- "\177" scroll-down
- [delete] scroll-down
- [backspace] scroll-down
- [return] scroll-up
- " " scroll-up
- "$" end-of-buffer
- "/" liece-command-generic
- ">" end-of-buffer
- "<" beginning-of-buffer
- "|" liece-command-show-last-kill
- "a" liece-command-away
- "b" liece-command-submit-bug-report
- "B" liece-dialogue-beep
- "c" liece-command-point-back-to-command-buffer
- "f" liece-command-finger
- "F" liece-dialogue-freeze
- "O" liece-dialogue-own-freeze
- "i" liece-command-invite
- "j" liece-command-join
- "k" liece-command-kill
- "\C-k" liece-command-kick
- "l" liece-command-list
- "L" liece-command-load-vars
- "S" liece-command-save-vars
- "m" liece-dialogue-enter-message
- "M" liece-command-modec
- "n" liece-command-nickname
- "o" other-window
- "p" liece-command-mta-private
- "P" liece-command-toggle-private
- "q" liece-command-quit
- "r" liece-command-reconfigure-windows
- "x" liece-command-tag-region
- "t" liece-command-topic
- "T" liece-command-timestamp
- "\C-t" liece-command-find-timestamp
- "v" liece-command-browse-url
- "w" liece-command-who)
-
- (liece-define-keys (liece-client-query-map "\C-c" liece-dialogue-mode-map)
- "a" liece-command-ctcp-action
- "v" liece-command-ctcp-version
- "u" liece-command-ctcp-userinfo
- "h" liece-command-ctcp-help
- "c" liece-command-ctcp-clientinfo
- "g" liece-command-ctcp-generic
- "p" liece-command-ctcp-ping
- "t" liece-command-ctcp-time
- "x" liece-command-ctcp-x-face
- "X" liece-command-ctcp-x-face-from-xbm-file
- "U" liece-command-ctcp-userinfo-from-minibuffer)
-
- (liece-define-keys (liece-dcc-map "\C-d" liece-dialogue-mode-map)
- "s" liece-command-dcc-send
- "r" liece-command-dcc-receive
- "l" liece-command-dcc-list
- "cl" liece-command-dcc-chat-listen
- "cc" liece-command-dcc-chat-connect
- "g" liece-command-dcc-accept)
-
- (liece-define-keys (liece-friends-map "\C-i" liece-dialogue-mode-map)
- " " liece-command-ison
- "a" liece-command-activate-friends
- "d" liece-command-deactivate-friends
- "s" liece-command-display-friends)
-
- (liece-define-keys liece-command-mode-map
- "\r" liece-command-enter-message
- [tab] liece-command-complete
- [(meta control c) >] liece-command-push
- [(meta control c) <] liece-command-pop)
-
- (liece-define-keys (liece-command-map "\C-c" liece-command-mode-map)
- "\177" liece-command-scroll-down
- [delete] liece-command-scroll-down
- [backspace] liece-command-scroll-down
- " " liece-command-scroll-up
- "$" liece-command-end-of-buffer
- ">" liece-command-next-channel
- "<" liece-command-previous-channel
- "a" liece-command-away
- "\C-f" liece-command-freeze
- "\C-j" liece-command-next-channel
- "\C-n" liece-command-names
- "\C-u" liece-command-unread-channel
- "l" liece-command-list
- "L" liece-command-load-vars
- "M" liece-command-own-freeze
- "\C-m" liece-command-modec
- "o" liece-command-set-operators
- "O" liece-command-toggle-nick-buffer-mode
- "\C-o" liece-command-toggle-channel-buffer-mode
- "\C-p" liece-command-part
- "r" liece-command-reconfigure-windows
- "\C-r" mule-caesar-region
- "s" liece-command-set-window-style
- "S" liece-command-save-vars
- "v" liece-command-set-voices
- "\C-v" liece-command-browse-url
- "\C-y" liece-command-yank-send)
- (set-keymap-parent liece-command-map liece-dialogue-mode-map)
-
- (liece-define-keys liece-nick-mode-map
- "o" liece-command-set-operators
- "v" liece-command-set-voices
- "f" liece-command-finger
- " " liece-command-nick-scroll-up
- "\177" liece-command-nick-scroll-down
- [delete] liece-command-nick-scroll-down
- [backspace] liece-command-nick-scroll-down
- "m" liece-command-mail-compose
- "c" liece-command-point-back-to-command-buffer)
-
- (liece-define-keys liece-channel-list-mode-map
- ">" liece-command-next-channel
- "<" liece-command-previous-channel
- "u" liece-command-unread-channel
- "o" other-window
- "c" liece-command-point-back-to-command-buffer)
-
- (liece-define-keys-1 liece-dialogue-mode-map liece-select-keys)
- (liece-define-keys-1 liece-channel-list-mode-map liece-select-keys))
-
-;;;###liece-autoload
-(defmacro liece-server-opened ()
- "Return server process status.
-Return non-nil if stream is opened."
- '(and liece-server-process
- (memq (process-status liece-server-process)
- '(open run))))
-
-(defun liece-start-server (&optional confirm)
- "Open network stream to remote irc server.
-If optional argument CONFIRM is non-nil, ask the host that the server
-is running on."
- (when (or confirm
- (null (or liece-server
- (setq liece-server (getenv "IRCSERVER")))))
- (setq liece-server (completing-read (_ "IRC server: ") liece-server-alist)))
- (unless (listp liece-server)
- (let ((entry (assoc liece-server liece-server-alist)))
- (if entry
- (if (listp (cdr entry))
- (setq liece-server (cdr entry))
- (setq liece-server (liece-server-parse-string (cdr entry))))
- (let ((plist (liece-server-parse-string liece-server)))
- (set-alist 'liece-server-alist liece-server plist)
- (setq liece-save-variables-are-dirty t)
- (setq liece-server plist)))))
- (when (or (and confirm liece-ask-for-nickname)
- (null liece-nickname))
- (setq liece-nickname (read-string (_ "Enter your nickname: ") liece-nickname)))
- (let ((host (liece-server-host)))
- (liece-message
- (_ "Connecting to IRC server on %s...") host)
- (liece-open-server liece-server liece-service)))
-
-(defun liece-close-server-internal ()
- "Close connection to chat server."
- (if (liece-server-opened)
- (delete-process liece-server-process))
- (if liece-server-buffer
- (kill-buffer liece-server-buffer))
- (setq liece-server-buffer nil
- liece-server-process nil
- liece-server nil))
-
-;;;###liece-autoload
-(defun liece-close-server (&optional quit-string)
- "Close chat server."
- (unwind-protect
- (progn
- ;; Unset default sentinel function before closing connection.
- (when (and liece-server-process
- (eq 'liece-sentinel
- (process-sentinel liece-server-process)))
- (set-process-sentinel liece-server-process nil))
- (if (liece-server-opened)
- (if quit-string
- (liece-send "QUIT :%s" quit-string)
- (liece-send "QUIT"))))
- (liece-close-server-internal)
- ;; Save settings to the `~/.liece/init.el' file.
- (if liece-save-variables-are-dirty
- (liece-command-save-vars))
- ;; Reset everything.
- (liece-clear-system)
- (liece-window-configuration-pop)
- ;; Allow the user to do things after cleaning up.
- (run-hooks 'liece-exit-hook)))
-
-(defmacro liece-server-keyword-bind (plist &rest body)
- "Return a `let' form that binds all variables in PLIST.
-After this is done, BODY will be executed in the scope
-of the `let' form.
-
-The variables bound and their default values are described by
-the `liece-server-keyword-map' variable."
- `(let ,(mapcar
- (lambda (keyword)
- (list (intern (substring (symbol-name (car keyword)) 1))
- (if (cadr keyword)
- `(or (plist-get ,plist ',(car keyword))
- ,(cadr keyword))
- `(plist-get ,plist ',(car keyword)))))
- liece-server-keyword-map)
- ,@body))
-
-(put 'liece-server-keyword-bind 'lisp-indent-function 1)
-(put 'liece-server-keyword-bind 'edebug-form-spec '(form body))
-
-(defun liece-server-parse-string (string)
- "Convert a STRING set as `liece-server' and return a property list."
- (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
- (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
- (let ((host (match-string 1 string))
- (service (match-string 2 string))
- (password (substring string (match-end 0)))
- plist)
- (push `(:host ,host) plist)
- (unless (string= service "")
- (push `(:service ,(string-to-int service)) plist))
- (cond
- ((string= password ":")
- (setq liece-ask-for-password t))
- ((string= password ""))
- (t (push `(:password ,(substring password 1)) plist)))
- (apply #'nconc plist))))
-
-(defun liece-open-server (host &optional service)
- "Open chat server on HOST.
-If HOST is nil, use value of environment variable \"IRCSERVER\".
-If optional argument SERVICE is non-nil, open by the service name."
- (liece-server-keyword-bind host
- (when prescript
- (if (fboundp prescript)
- (funcall prescript)
- (call-process shell-file-name nil nil nil
- shell-command-switch prescript))
- (when prescript-delay
- (sleep-for prescript-delay)))
- (if password
- (setq liece-ask-for-password nil
- liece-password password))
- (if (and (memq type '(rlogin telnet)) relay)
- (setq liece-tcp-relay-host relay))
- (setq liece-tmp-server-name host)
- (setq liece-server-process (liece-open-server-internal host service type))
- (setq liece-after-registration nil)
- (liece-maybe-poll)
- (if (null (liece-wait-for-response "^:[^ ]+ [4P][5O][1N][ G]"))
- (progn
- ;; We have to close connection here, since the function
- ;; `liece-server-opened' may return incorrect status.
- (liece-close-server-internal)
- (error (_ "Connection to %s timed out") host))
- (set-process-sentinel liece-server-process 'liece-sentinel)
- (set-process-filter liece-server-process 'liece-filter)
- (if (or liece-ask-for-password liece-reconnect-with-password)
- (let ((password
- (liece-read-passwd (_ "Server Password: "))))
- (or (string= password "")
- (setq liece-password password))))
- (if liece-password
- (liece-send "PASS %s" liece-password))
- (setq liece-reconnect-with-password nil)
- (liece-send "USER %s * * :%s"
- (or (user-real-login-name) "Nobody")
- (if (and liece-name (not (string= liece-name "")))
- liece-name
- "No Name"))
- (liece-send "NICK %s" liece-nickname)
- ;; We have to set `liece-real-nickname' here because IRC server doesn't
- ;; notify the real nickname to the user.
- (or liece-real-nickname
- (setq liece-real-nickname
- (truncate-string-to-width liece-nickname liece-nick-max-length)))
- (setq liece-nickname-last liece-real-nickname
- liece-nick-accepted 'sent
- liece-after-registration t))))
-
-(defun liece-open-server-internal (host &optional service type)
- "Open connection to chat server on HOST by SERVICE (default is irc).
-Optional argument TYPE specifies connection types such as `program'."
- (let ((liece-tcp-connection-type type)
- process)
- (as-binary-process
- (setq process
- (liece-open-network-stream
- "IRC" " *IRC*" host (or service "irc"))))
- (setq liece-server-buffer (process-buffer process))
- (save-excursion
- (set-buffer liece-server-buffer)
- (set-buffer-multibyte nil)
- (kill-all-local-variables)
- (buffer-disable-undo)
- (erase-buffer))
- process))
-
-(defun liece-initialize-timers ()
- "Initialise internal timers."
- (dolist (timer liece-timers)
- (if (caddr timer)
- (cancel-timer (caddr timer))
- (let ((handler (car timer)) (interval (cadr timer)))
- (and (liece-functionp handler)
- (symbolp interval) (boundp interval)
- (setq interval (symbol-value interval))
- (setcdr (cdr timer)
- (list (run-at-time 1 interval handler)))))))
- (setq liece-timers-list-initialized-p t))
-
-(defun liece-read-variables-files (&optional file)
- "Read variables FILEs."
- (and (not (file-directory-p liece-directory))
- (file-exists-p liece-directory)
- (yes-or-no-p "Upgrade the location of the data files? ")
- (let ((file
- (expand-file-name
- (make-temp-name "liece") temporary-file-directory)))
- (unwind-protect
- (progn
- (rename-file liece-directory file 'ok-if-exists)
- (make-directory liece-directory)
- (copy-file file (expand-file-name
- (file-name-nondirectory liece-variables-file)
- liece-directory)))
- (ignore-errors (delete-file file)))))
- (or (file-directory-p liece-directory)
- (make-directory liece-directory))
- (let ((files (if file
- (progn
- (setq liece-variables-file file
- liece-variables-files (list file)))
- liece-variables-files)))
- (dolist (file files)
- (if (file-readable-p (expand-file-name file))
- (load (expand-file-name file) t)))))
-
-;;;###autoload
-(defun liece (&optional confirm)
- "Connect to the IRC server and start chatting.
-If optional argument CONFIRM is non-nil, ask which IRC server to connect.
-If already connected, just pop up the windows."
- (interactive "P")
- (liece-read-variables-files
- (car command-line-args-left))
- (pop command-line-args-left)
- (run-hooks 'liece-after-load-startup-hook)
- ;; Save initial state of window configuration.
- (when (interactive-p)
- (liece-window-configuration-push))
- (unless liece-intl-message-alist
- (liece-intl-load-catalogue))
- (if (liece-server-opened)
- (liece-configure-windows)
- (switch-to-buffer (liece-get-buffer-create liece-command-buffer))
- (unless (eq major-mode 'liece-command-mode)
- (liece-command-mode))
- (liece-start-server confirm)
- (let (buffer-read-only)
- (unless liece-keep-buffers
- (erase-buffer))
- (sit-for 0))
- (liece-initialize-buffers)
- (liece-configure-windows)
- (setq liece-current-channels nil)
- (let ((startup-channels
- (if liece-startup-channel
- (list liece-startup-channel)
- liece-startup-channel-list)))
- (dolist (chnl startup-channels)
- (if (listp chnl)
- (liece-command-join (car chnl) (cadr chnl))
- (liece-command-join chnl))))
- (unless (string-equal liece-away-message "")
- (liece-command-away liece-away-message))
- (run-hooks 'liece-startup-hook)
- (setq liece-obarray
- (or liece-obarray (make-vector liece-obarray-size nil)))
- (unless liece-timers-list-initialized-p
- (liece-initialize-timers))
- (liece-command-timestamp)
- (message (substitute-command-keys "Type \\[describe-mode] for help"))))
-
-;;;###liece-autoload
-(defun liece-command-mode ()
- "Major mode for Liece. Normal edit function are available.
-Typing Return or Linefeed enters the current line in the dialogue.
-The following special commands are available:
-For a list of the generic commands type \\[liece-command-generic] ? RET.
-\\{liece-command-mode-map}"
- (interactive)
- (kill-all-local-variables)
-
- (setq liece-nick-alist (list (list liece-nickname))
- major-mode 'liece-command-mode
- mode-name "Commands"
- liece-privmsg-partner nil
- liece-private-indicator nil
- liece-away-indicator "-"
- liece-beep-indicator "-"
- liece-freeze-indicator "-"
- liece-own-freeze-indicator "-"
- mode-line-buffer-identification
- (liece-mode-line-buffer-identification
- '("Liece: "
- mode-line-modified
- liece-private-indicator
- liece-away-indicator
- "-- " liece-current-channel " " liece-real-nickname)))
- (liece-suppress-mode-line-format)
- (use-local-map liece-command-mode-map)
-
- (when liece-display-frame-title
- (make-local-variable 'frame-title-format)
- (setq frame-title-format 'liece-channel-status-indicator))
-
- (unless liece-blink-parens
- (make-local-variable 'blink-matching-paren)
- (setq blink-matching-paren nil))
-
- (unless liece-command-mode-syntax-table
- (setq liece-command-mode-syntax-table
- (copy-syntax-table (syntax-table)))
- (set-syntax-table liece-command-mode-syntax-table)
- (mapcar
- (lambda (c) (modify-syntax-entry c "w"))
- "^[]{}'`"))
-
- (run-hooks 'liece-command-mode-hook))
-
-;;;###liece-autoload
-(defun liece-dialogue-mode ()
- "Major mode for displaying the IRC dialogue.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{liece-dialogue-mode-map}"
- (kill-all-local-variables)
-
- (make-local-variable 'liece-beep)
- (make-local-variable 'liece-beep-indicator)
- (make-local-variable 'liece-freeze)
- (make-local-variable 'liece-freeze-indicator)
- (make-local-variable 'liece-own-freeze)
- (make-local-variable 'liece-own-freeze-indicator)
- (make-local-variable 'tab-stop-list)
-
- (setq liece-beep liece-default-beep
- liece-beep-indicator (if liece-beep "B" "-")
- liece-freeze liece-default-freeze
- liece-freeze-indicator (if liece-freeze "F" "-")
- liece-own-freeze liece-default-own-freeze
- liece-own-freeze-indicator (if liece-own-freeze "M" "-")
-
- major-mode 'liece-dialogue-mode
- mode-name "Dialogue"
- mode-line-buffer-identification
- (liece-mode-line-buffer-identification
- '("Liece: "
- mode-line-modified
- liece-away-indicator
- liece-beep-indicator
- liece-freeze-indicator
- liece-own-freeze-indicator
- " " liece-channels-indicator " "))
- buffer-read-only t
- tab-stop-list liece-tab-stop-list)
- (liece-suppress-mode-line-format)
- (use-local-map liece-dialogue-mode-map)
- (buffer-disable-undo)
-
- (unless liece-keep-buffers
- (erase-buffer))
-
- (run-hooks 'liece-dialogue-mode-hook))
-
-;;;###liece-autoload
-(define-derived-mode liece-others-mode liece-dialogue-mode
- "Others"
- "Major mode for displaying the IRC others message except current channel.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{liece-others-mode-map}")
-
-;;;###liece-autoload
-(define-derived-mode liece-channel-mode liece-dialogue-mode
- "Channel"
- "Major mode for displaying the IRC current channel buffer.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{liece-channel-mode-map}"
- (setq mode-line-buffer-identification
- (liece-mode-line-buffer-identification
- '("Liece: "
- mode-line-modified
- liece-away-indicator
- liece-beep-indicator
- liece-freeze-indicator
- liece-own-freeze-indicator
- " "
- liece-channel-indicator))))
-
-;;;###liece-autoload
-(defun liece-channel-list-mode ()
- "Major mode for displaying channel list.
-All normal editing commands are turned off."
- (kill-all-local-variables)
- (setq major-mode 'liece-channel-list-mode
- mode-name "Channels"
- mode-line-buffer-identification
- (liece-mode-line-buffer-identification
- '("Liece: " liece-command-buffer-mode-indicator " "))
- truncate-lines t
- buffer-read-only t)
- (use-local-map liece-channel-list-mode-map)
- (run-hooks 'liece-channel-list-mode-hook))
-
-;;;###liece-autoload
-(defun liece-nick-mode ()
- "Major mode for displaying members in the IRC current channel buffer.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{liece-nick-mode-map}"
- (kill-all-local-variables)
- (setq mode-line-modified "--- "
- major-mode 'liece-nick-mode
- mode-name "Liece Channel member"
- mode-line-buffer-identification
- (liece-mode-line-buffer-identification
- '("Liece: " liece-channel-indicator " "))
- truncate-lines t
- buffer-read-only t)
- (if (boundp 'transient-mark-mode)
- (set (make-local-variable 'transient-mark-mode) t))
- (use-local-map liece-nick-mode-map)
- (run-hooks 'liece-nick-mode-hook))
-
-(fset 'liece-dialogue-beep 'liece-command-beep)
-(fset 'liece-dialogue-freeze 'liece-command-freeze)
-(fset 'liece-dialogue-own-freeze 'liece-command-own-freeze)
-
-(defun liece-initialize-buffers ()
- "Initialize buffers."
- (dolist (spec liece-buffer-mode-alist)
- (let ((buffer (symbol-value (car spec)))
- (mode (cadr spec)))
- (or (get-buffer buffer)
- (save-excursion
- (set-buffer (liece-get-buffer-create buffer))
- (or (eq major-mode mode)
- (null mode)
- (funcall mode)))))))
-
-;;;###liece-autoload
-(defun liece-clear-system ()
- "Clear all Liece variables and buffers."
- (interactive)
- (dolist (buffer liece-buffer-list)
- (when (and (get-buffer buffer) (buffer-live-p buffer))
- (funcall liece-buffer-dispose-function buffer)))
- (if (vectorp liece-obarray)
- (dotimes (i liece-obarray-size)
- (aset liece-obarray i nil)))
- (dolist (timer liece-timers)
- (if (caddr timer)
- (cancel-timer (caddr timer)))
- (if (cdr timer)
- (setcdr (cdr timer) nil)))
- (setq liece-channel-buffer-alist nil
- liece-nick-buffer-alist nil
- liece-current-channels nil
- liece-current-channel nil
- liece-current-chat-partners nil
- liece-current-chat-partner nil
- liece-timers-list-initialized-p nil
- liece-friends-last nil
- liece-polling 0
- liece-channel-indicator "No channel"))
-
-(defun liece-wait-for-response (regexp &optional timeout)
- "Wait for server response which match REGEXP.
-Optional argument TIMEOUT specifies connection timeout."
- (save-excursion
- (let ((status t) (wait t) (timeout (or timeout liece-connection-timeout)))
- (set-buffer liece-server-buffer)
- (with-timeout (timeout nil)
- (while wait
- (liece-accept-response)
- (goto-char (point-min))
- (cond ((looking-at "ERROR") (setq status nil wait nil))
- ((looking-at ".") (setq wait nil))))
- ;; Save status message.
- (end-of-line)
- (setq liece-status-message-string
- (buffer-substring (point-min) (point)))
- (when status
- (while wait
- (goto-char (point-max))
- (forward-line -1)
- (if (looking-at regexp)
- (setq wait 0)
- (liece-message (_ "Reading..."))
- (liece-accept-response))))
- ;; Successfully received server response.
- t))))
-
-(defun liece-accept-process-output (process &optional timeout)
- "Wait for output from PROCESS and message some dots.
-Optional argument TIMEOUT specifies connection timeout."
- (save-excursion
- (set-buffer liece-server-buffer)
- (accept-process-output process (or timeout 1))))
-
-(defun liece-accept-response ()
- "Read response of server. Only used at startup time."
- (unless (liece-server-opened)
- (cond
- ((not liece-reconnect-automagic)
- (error "Liece: Connection closed"))
- (liece-grow-tail
- (let ((liece-nickname (concat liece-nickname liece-grow-tail)))
- (liece)))
- (t (liece))))
- (condition-case code
- (liece-accept-process-output liece-server-process)
- (error
- (or (string-equal "select error: Invalid argument" (nth 1 code))
- (signal (car code) (cdr code))))))
-
-(defmacro liece-replace-internal (buffer match defstring oldstring newstring)
- "Helper function only used from `liece-replace'.
-
-Replace in buffer or list of buffers BUFFER with matching MATCH.
-Argument DEFSTRING used when no matches are there.
-Argument OLDSTRING is replaced with NEWSTRING."
- `(save-excursion
- (set-buffer (get-buffer ,buffer))
- (let (buffer-read-only (inhibit-read-only t))
- (goto-char (point-max))
- (previous-line liece-compress-treshold)
- (save-match-data
- (if (not (re-search-forward ,match nil t))
- (liece-insert ,buffer ,defstring)
- (while (re-search-forward ,match nil t))
- (beginning-of-line)
- (if (re-search-forward ,oldstring nil t)
- (replace-match ,newstring nil t)
- (liece-insert ,buffer ,defstring))
- (liece-insert ,buffer ""))))))
-
-;;;###liece-autoload
-(defun liece-replace (buffer match defstring oldstring newstring)
- "Replace in buffer or list of buffers BUFFER with matching MATCH.
-Argument DEFSTRING used when no matches are there.
-Argument OLDSTRING is replaced with NEWSTRING."
- (unless (listp buffer)
- (setq buffer (list buffer)))
- (dolist (buf buffer)
- (when (get-buffer buf)
- (liece-replace-internal buf match defstring oldstring newstring))))
-
-(defun liece-check-buffers ()
- "Check if there is a buffer larger than `liece-buffer-max-size'.
-If such a buffer is found, shrink it."
- (let ((liece-buffer-check-interval 0))
- (when (> liece-buffer-max-size 0)
- (save-excursion
- (dolist (buffer liece-channel-buffer-alist)
- (set-buffer (cdr buffer))
- (when (< liece-buffer-max-size (buffer-size))
- (let ((inhibit-read-only t)
- buffer-read-only)
- (delete-region (point-min)
- (progn
- (goto-char (- (buffer-size)
- liece-buffer-min-size))
- (beginning-of-line -1)
- (point)))
- (garbage-collect)
- (setq liece-buffer-last-check-time (current-time)))))))))
-
-(defun liece-check-buffers-if-interval-expired ()
- "Timer handler for `liece-check-buffers'.
-Only used from `liece-before-insert-functions'."
- (and (> liece-buffer-check-interval 0)
- (or (null liece-buffer-last-check-time)
- (> (liece-time-difference (current-time)
- liece-buffer-last-check-time)
- liece-buffer-check-interval))
- (liece-check-buffers)))
-
-(defun liece-refresh-buffer-window (buffer)
- "Center point in window of BUFFER and redisplay frame."
- (let ((window (liece-get-buffer-window buffer))
- (last-point (point-max)))
- ;; skip last white spaces
- (while (memq (char-before last-point) '(?\n ?\t ?\ ))
- (setq last-point (1- last-point)))
- (when (and window (not (pos-visible-in-window-p last-point window)))
- (save-selected-window
- (select-window window)
- (goto-char last-point)
- (recenter (- (or liece-scroll-step 1)))))))
-
-(defmacro liece-save-point (&rest body)
- "Execute BODY, then goto the point that was around before BODY."
- (let ((liece-save-point (liece-gensym "lsp")))
- `(let ((,liece-save-point (point-marker)))
- (unwind-protect
- (progn ,@body)
- (goto-char ,liece-save-point)
- (set-marker ,liece-save-point nil)))))
-
-(defvar liece-before-insert-functions
- '(liece-check-buffers-if-interval-expired
- liece-command-timestamp-if-interval-expired))
-
-(defun liece-insert-internal (buffer string)
- "Helper function only used from `liece-insert'.
-
-Insert before point of BUFFER STRING with decorating."
- (run-hooks 'liece-before-insert-functions)
- (with-current-buffer (liece-get-buffer-create buffer)
- (or (eq (derived-mode-class major-mode) 'liece-dialogue-mode)
- (liece-dialogue-mode))
- (liece-save-point
- (let ((inhibit-read-only t)
- buffer-read-only
- (from (goto-char (point-max))))
- (unless (liece-is-message-ignored string (current-buffer))
- (and liece-display-time (not (string-equal string ""))
- (liece-insert-time-string))
- (insert string)
- (run-hook-with-args 'liece-after-insert-functions from (point)))))
- (unless (liece-frozen (current-buffer))
- (liece-refresh-buffer-window (current-buffer)))))
-
-;;;###liece-autoload
-(defun liece-insert (buffer string)
- "Insert before point of BUFFER STRING with decorating."
- (or (listp buffer)
- (setq buffer (list buffer)))
- (dolist (buf buffer)
- (when (get-buffer buf)
- (liece-insert-internal buf string))))
-
-(provide 'liece)
-
-;;; liece.el ends here
+++ /dev/null
-#define noname_width 500
-#define noname_height 200
-static char noname_bits[] = {
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x06,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x0d,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,
- 0x1a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xc0,0x1b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x8a,0x25,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x0e,0x29,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0x1b,0x5d,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x6a,
- 0xd2,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xc0,0xf6,0x6e,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0xad,0x9d,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x86,0x31,0xdb,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0x1a,0xee,0x9d,0x03,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x38,0x1d,0x2b,
- 0xfb,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xb8,0x6b,0x54,0x95,0x06,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x66,0x4c,0xb6,0xd3,0x0c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0xaa,0xd3,0x68,0xde,0x07,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x7b,0x6e,0x88,0x2e,0x1c,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x55,0x96,0xf1,
- 0x56,0x13,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x1e,
- 0xfa,0x28,0x29,0xf7,0x5c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x0b,0xb6,0xdc,0xa3,0xa2,0x2d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xc0,0x34,0x4a,0x61,0x66,0xcd,0x6a,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x4a,0x34,0x5b,0x85,0x12,0x5b,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x6d,0x74,0x51,0xcd,
- 0x1b,0x15,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x0d,0x92,
- 0x98,0x56,0x0d,0x27,0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x80,0x12,0xef,0xb8,0xa6,0x9a,0x6d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x60,0x6f,0xdc,0x61,0xcd,0x15,0x56,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x04,0x00,0x00,0x98,0x28,0xa6,0xb2,0x4a,0x1a,0x32,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x71,0x00,0x00,0xa4,0xd6,0xd4,0x22,0xa9,0x2d,
- 0x1c,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xde,0x00,0x00,0xea,0x6a,0x68,
- 0xc3,0x9b,0x32,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0xbb,0x07,0x00,
- 0x56,0x1c,0x90,0x4c,0x66,0x0b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,
- 0xef,0x12,0x00,0x6e,0x01,0x70,0x8b,0xaa,0x35,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xd0,0xba,0x0f,0x00,0xec,0x08,0xd0,0x86,0xbb,0x15,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0xe0,0xef,0x2a,0x3d,0x92,0x57,0x60,0x19,0x55,0x07,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa8,0xba,0xdf,0xcd,0x54,0xd5,0x43,
- 0x25,0x54,0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0x77,0x55,0x5d,
- 0x6c,0xbb,0x4f,0x3a,0xfa,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x74,
- 0xdd,0xff,0xd2,0x59,0x97,0x80,0x67,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xda,0x77,0x7d,0xab,0xb0,0x59,0x9f,0x6a,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x74,0xdd,0xef,0xbb,0x43,0xb7,0x34,0xb7,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0xde,0x77,0xb5,0x4a,0xa2,0x7a,0x35,
- 0x4b,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf6,0xba,0x7f,0xb3,
- 0x06,0x80,0x4d,0xea,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0xdb,
- 0xef,0xfa,0xcb,0x02,0x28,0x5d,0x14,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x80,0xbf,0xba,0xf7,0xb6,0x03,0x34,0xce,0x28,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xc8,0xea,0xef,0x7e,0x97,0x0f,0x5b,0x2e,0x08,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x60,0xff,0xba,0xef,0xb9,0x15,0xb3,0x5a,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd4,0xd5,0xef,0x7a,0x5b,
- 0x2a,0xc5,0x25,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x7f,
- 0x75,0xff,0xb6,0x6d,0xba,0x3d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x80,0xde,0xd5,0xdf,0xdd,0x39,0x55,0x24,0x15,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x20,0xf4,0x7e,0x75,0xfb,0x56,0xd7,0x58,0x07,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xaf,0xeb,0xdf,0xdf,0x36,0x6e,0x60,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x48,0xfb,0x7e,0xf5,0xbd,0xe9,
- 0x52,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf2,0x6d,0xeb,
- 0xaf,0x5e,0xb7,0x4c,0x03,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,
- 0x68,0xdf,0xbf,0xfa,0x3f,0xf6,0xd9,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x08,0xbf,0x75,0xf5,0xaf,0x2f,0x86,0x59,0x01,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0xe2,0xee,0xdf,0x5f,0xf5,0x4f,0x74,0x52,0x01,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x49,0xfd,0xbb,0x7a,0xf5,0xdf,0x0b,0x68,
- 0x27,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xb5,0x5b,0xdd,0xaf,0xbf,
- 0xf5,0x2f,0x58,0x0b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0xee,
- 0x77,0xfd,0xea,0xfe,0x8e,0x92,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xac,0x7b,0xdd,0x57,0xbf,0xff,0xb5,0xa5,0x01,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x74,0xef,0xbb,0xfe,0xf5,0x6e,0xf7,0x53,0x00,0x00,0x00,
- 0x00,0x10,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd8,0xba,0xee,0x57,0xdf,0xdf,0x16,0x0c,
- 0x00,0x00,0x00,0x00,0x44,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xf0,0xf7,0xbb,0xfe,0xfa,
- 0x57,0xbb,0x03,0x00,0x00,0x00,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x5d,
- 0xdd,0xab,0xff,0xad,0xc4,0x05,0x00,0x00,0x00,0x00,0x60,0x05,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xb0,0xf7,0x77,0xff,0xbf,0x8b,0x75,0x01,0x00,0x00,0x00,0x00,0xfd,0x11,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xe8,0x59,0xdd,0xf5,0xf7,0x0d,0x5e,0x00,0x00,0x00,0x00,
- 0x40,0xbc,0x0b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xb0,0xf0,0xfb,0xdf,0xbe,0x0e,0x2a,0x00,
- 0x00,0x00,0x00,0x00,0xf7,0x26,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa1,0xb5,0x7e,0xed,0x6b,
- 0x19,0x04,0x00,0x00,0x00,0x00,0x80,0xde,0x1f,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x67,0xf8,
- 0xfd,0x15,0xbb,0x1f,0x00,0x00,0x00,0x00,0x00,0x80,0x7b,0xbf,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xb0,0x08,0x5a,0x57,0x4a,0xaa,0x3c,0x00,0x00,0x00,0x00,0x00,0x80,0xee,0x6b,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0xa8,0x1a,0xee,0x5f,0x01,0x55,0x19,0x00,0x00,0x00,0x00,0x00,
- 0x80,0xbf,0xbf,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x56,0x95,0x7a,0x3f,0x00,0xac,0x0e,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xeb,0x76,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xed,0x1a,0xd7,0x4b,0x10,0x38,
- 0x03,0x00,0x00,0x00,0x00,0x00,0x00,0xfe,0x5f,0x01,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x2d,0x4b,0xfd,
- 0x1f,0x00,0xf0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xb8,0xfd,0x04,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,
- 0x95,0x82,0xeb,0x3f,0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xea,0x57,
- 0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x9c,0x6a,0xd4,0xbe,0x35,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x50,0xad,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x17,0x6d,0xe1,0xeb,0x5b,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xa4,0x2a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0x6a,0xd3,0x52,0xed,0xd6,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x05,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x33,0x6a,0xf8,0x9b,
- 0x25,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x10,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x1e,
- 0x9a,0x50,0xb7,0xbe,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xcc,0x06,0x24,0xfe,0x5d,0xd6,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x73,0x0e,0x5c,0x5a,0x2f,0x94,0x02,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x16,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x50,0x0f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0xe0,0x5a,0x0b,0x00,0xef,0x1f,0xbc,0x01,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x40,0x01,0x00,0x00,0x00,0x80,0xf4,0x3f,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xea,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd0,0xa5,0x92,0x91,0xba,0x35,
- 0x68,0x00,0x00,0x00,0x00,0x00,0x01,0x00,0x00,0x5e,0x00,0x00,0x00,0x00,0xdd,
- 0xff,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0xfe,0xff,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x2c,0xed,0xf6,
- 0xc1,0xd7,0x1f,0x28,0x00,0x00,0x00,0x00,0x00,0x04,0x00,0xd0,0x3f,0x00,0x00,
- 0x00,0xa8,0xff,0xf6,0x00,0x00,0x00,0x00,0x48,0x05,0x00,0x00,0xc8,0xff,0x7b,
- 0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x52,0xc7,0xae,0x4b,0xed,0x3b,0x00,0x00,0x00,0x00,0x00,0x00,0x0c,0x00,0xa0,
- 0x6f,0x02,0x00,0x00,0xc2,0xde,0xff,0x05,0x00,0x00,0x00,0xe2,0x3f,0x00,0x00,
- 0xf1,0xff,0xff,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x80,0x48,0x81,0x49,0xe0,0x5b,0x25,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x2d,0x00,0xe4,0xba,0x00,0x00,0x00,0xf8,0xfb,0xde,0x12,0x00,0x00,0x20,0xfd,
- 0x7f,0x00,0x00,0xfc,0xff,0x7f,0x05,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x20,0x24,0x40,0x55,0xf5,0xbe,0x3b,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x9c,0x00,0xb1,0xff,0x0a,0x00,0x00,0xfd,0xff,0xf7,0x0b,0x00,
- 0x00,0x88,0xff,0xfe,0x02,0x40,0xfe,0xef,0xfe,0x0a,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa9,0xff,0x0b,0xbb,0xa8,0xfd,0x0b,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x0a,0x00,0xfc,0xb6,0x02,0x00,0x20,0x9f,0xb6,
- 0x7f,0x03,0x00,0x00,0xf1,0xff,0xff,0x02,0x00,0x9f,0xfe,0xf7,0x05,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xfa,0xab,0x5d,0x26,
- 0xb8,0x57,0x18,0x00,0x00,0x00,0x00,0x00,0x00,0xbc,0x02,0xd8,0xef,0x01,0x00,
- 0x88,0x47,0xf9,0xfd,0x17,0x00,0x40,0xbc,0xdd,0xef,0x09,0xd0,0x47,0xf9,0xff,
- 0x13,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0xad,
- 0x7e,0xf7,0x28,0x4f,0xad,0x07,0x00,0x00,0x00,0x00,0x00,0x00,0x4c,0x40,0x7f,
- 0x7b,0x05,0x00,0xc0,0xa9,0xea,0xb7,0x05,0x00,0x10,0x47,0xf4,0xfd,0x02,0xe0,
- 0xa9,0xfa,0x7f,0x05,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x48,0xfb,0xd7,0xbd,0x87,0x5a,0x7f,0x05,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xbc,0x02,0xda,0xff,0x02,0x00,0xe8,0xaa,0x72,0xff,0x2b,0x00,0xc4,0x13,0x52,
- 0xff,0x17,0xf4,0x52,0xf9,0xfe,0x0b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xe0,0xaf,0x7e,0xf7,0x9e,0x63,0xed,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x15,0xa0,0x7f,0xbb,0x02,0x00,0x72,0x94,0xf0,0xff,0x02,0x00,
- 0xf8,0x40,0xd5,0xb6,0x04,0x79,0x94,0xf0,0x77,0x01,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0xf5,0xd7,0xad,0xf7,0x7e,0x11,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x5c,0x89,0xd6,0x7f,0x01,0x00,0xb8,0x4a,0xe4,
- 0xb6,0x0b,0x40,0xfe,0x94,0x90,0x7a,0x43,0xbc,0x4a,0xfa,0xff,0x0a,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xdd,0x5f,0xbd,0x7f,0xdd,
- 0xb9,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x56,0xc2,0x7f,0xaf,0x08,0x80,
- 0xbe,0x12,0xf1,0xff,0x02,0x00,0x3f,0x4a,0x44,0x4a,0x09,0x1e,0x25,0xf0,0xdf,
- 0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xe8,0xea,
- 0xef,0xd5,0xb7,0xe6,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0xac,0xe0,0xed,
- 0x5b,0x00,0x00,0x2c,0x25,0xb0,0x7b,0x09,0xa0,0x5b,0x05,0x00,0xa0,0x02,0x5f,
- 0x09,0xf9,0x7e,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x60,0xbe,0xbf,0xba,0xbe,0xfe,0xab,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xae,0xa8,0xff,0x27,0x01,0x20,0x5f,0x01,0xfd,0xaf,0x02,0xc4,0xaf,0x12,0x00,
- 0x09,0xa0,0x4f,0x05,0xfc,0xb7,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x20,0xad,0xd5,0xdf,0xeb,0xab,0xbe,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x4e,0xf2,0x6b,0x15,0x00,0x40,0xaf,0x2a,0xb4,0xdd,0x00,0xf0,
- 0xbf,0x02,0x00,0x00,0x80,0x57,0x01,0xfd,0x5f,0x04,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x30,0xfe,0xbf,0x6a,0x5f,0xff,0x55,0x01,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x40,0x2b,0xb8,0xfe,0x0a,0x00,0x80,0x4b,0x80,0x7e,
- 0x37,0x00,0xf9,0x6d,0x01,0x00,0x40,0xc8,0xab,0x28,0x5f,0x95,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0xd7,0x56,0xfd,0xf5,0x55,
- 0xff,0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x56,0xed,0xbf,0x02,0x00,0xa0,
- 0x17,0x89,0xaf,0x9a,0x00,0xf8,0xbf,0x08,0x00,0x00,0x40,0x07,0xc0,0x5f,0x2b,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x81,0xfd,0x4b,
- 0xab,0xdf,0xfe,0xda,0x27,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x27,0xbc,0x6d,
- 0x01,0x00,0xc0,0x85,0xf4,0xd3,0x05,0x80,0xde,0xab,0x02,0x00,0x00,0xe8,0x93,
- 0xfe,0xe3,0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,
- 0x23,0xb7,0x2d,0xd4,0xb5,0xaf,0x77,0x9d,0x00,0x00,0x00,0x00,0x00,0x00,0x80,
- 0x55,0xee,0x5f,0x00,0x00,0xe8,0xf7,0xbf,0xa8,0x2a,0x00,0x7e,0x7f,0x00,0x00,
- 0x00,0xe0,0xf7,0x7f,0x94,0x12,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x38,0x05,0xfd,0x8e,0x50,0xff,0xfa,0xde,0x77,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xd0,0x2b,0x7b,0x2b,0x01,0x00,0x60,0xbf,0x0b,0x92,0x00,0x40,0xfb,
- 0xaf,0x00,0x00,0x00,0xf4,0xff,0x05,0x29,0x01,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0xd8,0x42,0xdb,0x15,0x04,0x54,0x5f,0xb7,0xdd,0x0b,
- 0x00,0x00,0x00,0x00,0x00,0xc4,0x12,0xde,0x1f,0x00,0x00,0xe8,0xdb,0xa0,0x4a,
- 0x04,0x00,0xff,0x5f,0x00,0x00,0x00,0xf0,0x5b,0xa0,0x54,0x02,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x51,0x05,0xb7,0x2a,0x20,0xfe,0xf5,
- 0xfd,0x76,0x47,0x00,0x00,0x00,0x00,0x00,0x70,0x8d,0x7b,0x23,0x00,0x00,0x70,
- 0x2f,0x95,0x24,0x01,0x90,0xdf,0x3d,0x01,0x00,0x00,0xf9,0xad,0x96,0x02,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0x53,0x0d,0xbb,0x6a,
- 0x00,0xab,0xbe,0xae,0xdf,0x3d,0x00,0x00,0x00,0x00,0x00,0xd2,0x92,0xee,0x1d,
- 0x00,0x00,0xf2,0xfb,0x24,0x09,0x00,0x80,0xf7,0x5f,0x00,0x00,0x40,0xf8,0x7f,
- 0x21,0x28,0x00,0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xb0,0xd2,
- 0x0f,0xbb,0x75,0xc8,0xfe,0xeb,0x7b,0x7d,0xf7,0x02,0x00,0x00,0x00,0x00,0x7c,
- 0x8d,0xbf,0x03,0x00,0x00,0xd8,0x2f,0x09,0x00,0x00,0xa4,0x7f,0xb7,0x00,0x00,
- 0x00,0xde,0x2b,0x8a,0x00,0x00,0xc0,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x98,0xa6,0x38,0x6e,0x8a,0x82,0x6b,0x7d,0xdd,0xd7,0x5d,0x2b,0x00,0x00,
- 0x00,0x80,0xba,0xa6,0xed,0x5f,0x00,0x00,0x72,0x5b,0x82,0x00,0x00,0xc1,0xfd,
- 0x5f,0x00,0x00,0x10,0xfb,0x5f,0x01,0x00,0x00,0x31,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x50,0x62,0x1b,0x55,0xd5,0xe8,0xaa,0xd7,0x77,0x7d,0xf7,
- 0x2d,0x01,0x00,0x00,0x28,0x6f,0x89,0xbf,0x02,0x00,0x10,0xfc,0xaf,0x00,0x00,
- 0x00,0xf8,0xef,0xbf,0x00,0x00,0xc5,0xfd,0x26,0x10,0x00,0x00,0x18,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x8d,0x2c,0xae,0x0b,0xf4,0xd4,0xba,
- 0xdd,0xd7,0x7d,0xff,0x10,0x00,0x00,0xc0,0xbb,0x85,0xeb,0x27,0x00,0x04,0xef,
- 0x3d,0x11,0x00,0x80,0xd8,0xff,0xbd,0x04,0x40,0x70,0xf8,0x9f,0x02,0x00,0x40,
- 0x8e,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x61,0xc9,0x6a,0x9a,0x20,
- 0x1b,0x15,0xd4,0x76,0x7f,0xd7,0xd5,0x97,0x10,0x90,0xfa,0xaf,0xd2,0x7e,0x9f,
- 0x52,0xd0,0xb9,0x77,0x04,0x00,0x08,0xce,0xbe,0x6f,0x02,0x04,0x9e,0xfc,0x7f,
- 0x00,0x00,0x04,0x27,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0xc7,0x96,
- 0xad,0x74,0xc8,0x5e,0x4a,0xa9,0xdf,0xd5,0x7d,0xbf,0x7d,0x85,0x84,0xb6,0x6a,
- 0x85,0xef,0xf6,0x00,0xfd,0xf8,0xff,0x43,0x24,0xc2,0xc7,0xf7,0xff,0x20,0xa1,
- 0x2f,0xdc,0xff,0x4b,0x12,0xd1,0x85,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x5c,0x24,0xe9,0xd2,0xac,0xff,0x4b,0x09,0xa0,0xba,0x7f,0xb7,0xf5,0xb6,0x7f,
- 0xfb,0xff,0x57,0xe0,0xbe,0xdf,0xff,0x77,0x6d,0xdb,0x1f,0x81,0xe8,0xe9,0xff,
- 0xfd,0x05,0xfc,0x47,0xfd,0xff,0x17,0x40,0xf8,0x11,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x27,0xcd,0xaa,0x6c,0xd9,0x57,0xad,0x22,0x88,0xee,0xd5,0xef,
- 0xbf,0xef,0xdb,0x7e,0xdb,0xba,0x82,0xeb,0x77,0xff,0xbe,0xf8,0xff,0xfd,0x55,
- 0xfe,0xc5,0xbd,0xdf,0xff,0xf7,0x53,0xf8,0x7d,0xff,0x2d,0xff,0x25,0x01,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0xc0,0xdd,0x8e,0xbe,0xdb,0x74,0xf5,0x15,0x04,0x40,
- 0xb8,0xbe,0xba,0xf6,0xbe,0xee,0xeb,0x7d,0x57,0xc0,0x7f,0xfd,0xdd,0xab,0xb2,
- 0xbb,0xef,0xff,0x7f,0xd4,0xff,0xff,0xff,0xbf,0x94,0xfa,0xff,0xff,0xff,0x3f,
- 0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0xf2,0x19,0x45,0x57,0xb3,0x4d,
- 0x49,0x01,0x00,0xca,0xef,0xef,0xbb,0xeb,0xfb,0x7e,0xd7,0x2d,0x80,0xda,0xbf,
- 0xf7,0x5f,0xf9,0xee,0x7e,0xff,0xb7,0x8a,0xef,0xfb,0xbb,0xff,0x4a,0xf8,0xef,
- 0xff,0xff,0xbf,0x52,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x95,0x2e,0xd5,
- 0x54,0x75,0xa7,0x22,0x00,0x00,0x50,0xbd,0xbe,0xef,0xbe,0xaf,0xdb,0x7f,0x93,
- 0x80,0x7f,0xdb,0x5f,0x6b,0xf5,0xff,0xfb,0x6d,0x5f,0xe5,0x7e,0xdf,0xfe,0xaf,
- 0x2a,0xbc,0xff,0xfb,0xff,0x57,0x05,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x40,
- 0x33,0x29,0xb6,0xd1,0xaa,0x15,0x08,0x00,0x00,0x80,0xee,0xeb,0xba,0x6f,0xfb,
- 0x7f,0xfb,0x0d,0x00,0xdb,0xff,0xfa,0xbf,0xa0,0xfb,0xef,0xff,0xdf,0x8a,0xfb,
- 0xff,0xff,0xbb,0x05,0xf0,0xff,0xff,0xff,0xef,0x12,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xc0,0x65,0x55,0x94,0x29,0xb5,0x47,0x02,0x00,0x00,0x24,0xb9,0xbf,
- 0xef,0xfa,0x5d,0xf5,0xaf,0x02,0x00,0xff,0xf6,0xef,0x56,0xf2,0x6f,0x7f,0xff,
- 0xba,0x80,0xdf,0xf7,0xef,0x6e,0x15,0xf0,0xbf,0xbf,0xbb,0x5b,0x01,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0xc0,0x01,0x7b,0x6e,0xb4,0xd3,0xae,0x00,0x00,0x00,0x00,
- 0x00,0xd2,0xea,0xbb,0x6f,0xf7,0xbf,0xbb,0x00,0x00,0xb6,0xbf,0xfd,0x2f,0xc0,
- 0xfd,0xff,0xb7,0xdf,0x0a,0xff,0xfe,0xff,0x5f,0x01,0xc0,0xf7,0xff,0xff,0xbf,
- 0x04,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa8,0x81,0x55,0x6b,0xcc,0xe4,0x4a,0x01,
- 0x00,0x00,0x00,0x00,0xa8,0xbf,0xfe,0xfe,0xdf,0xf6,0x4d,0x02,0x00,0xfa,0xf6,
- 0x77,0x95,0x80,0xdf,0xed,0xfd,0x37,0x01,0xfe,0xbf,0xfd,0x5b,0x04,0xe0,0xfe,
- 0xfd,0xff,0x26,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa8,0x02,0xa5,0x35,0xb0,
- 0x25,0x19,0x20,0x00,0x00,0x00,0x00,0x40,0xea,0xaf,0x57,0xb5,0x7f,0x2b,0x00,
- 0x00,0xbc,0xdf,0xfe,0x05,0x40,0xf7,0xbf,0xff,0x4d,0x00,0xec,0xfb,0xff,0xaa,
- 0x00,0x80,0xff,0xef,0xff,0x5b,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x5c,0x03,
- 0xb4,0x2e,0x98,0xcd,0x06,0x00,0x00,0x00,0x00,0x00,0x21,0x6d,0xfd,0xfe,0xff,
- 0xef,0x02,0x00,0x00,0xf0,0xfe,0x5f,0x09,0x00,0xbd,0xfb,0xb7,0x2b,0x00,0xf9,
- 0xff,0xb7,0x0b,0x00,0x40,0xff,0x7f,0xb7,0x05,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xb0,0x0c,0x74,0x39,0x60,0x4d,0x05,0x00,0x00,0x00,0x00,0x00,0x00,0xa8,
- 0xb7,0xdb,0xfe,0x3a,0x49,0x00,0x00,0xc8,0xeb,0xb7,0x02,0x00,0xfa,0xff,0xfe,
- 0x0a,0x00,0x74,0xbf,0xff,0x12,0x00,0x08,0xbd,0xff,0xff,0x2a,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x20,0xa8,0x05,0x94,0x0a,0x20,0x91,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xa1,0xfa,0xff,0xeb,0x45,0x00,0x00,0x00,0x50,0xbf,0x2a,0x00,0x80,
- 0x6c,0xef,0x5f,0x05,0x00,0xd0,0xfb,0x96,0x08,0x00,0x00,0xfa,0xff,0xad,0x02,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x70,0xb0,0x0d,0xb8,0x03,0xc0,0x1d,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x4a,0xb5,0x5d,0x2a,0x02,0x00,0x00,0x82,0xea,
- 0x16,0x01,0x00,0xa8,0xfb,0x6b,0x11,0x00,0xa0,0xee,0x55,0x02,0x00,0x80,0xa4,
- 0xbb,0xb7,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x4e,0xa0,0x0f,0xa8,0x04,0xa0,
- 0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x88,0xa8,0xaa,0xaa,0x00,0x00,0x00,
- 0x00,0x20,0x55,0x21,0x00,0x00,0x50,0xaf,0x16,0x00,0x00,0x88,0x5a,0x0b,0x00,
- 0x00,0x00,0x68,0xed,0x4a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xad,0x81,0x30,
- 0x50,0x0d,0xc0,0x16,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x49,0x05,
- 0x12,0x00,0x00,0x00,0x00,0x48,0x04,0x00,0x00,0x84,0xb4,0x49,0x01,0x00,0x20,
- 0xa5,0x44,0x00,0x00,0x00,0x10,0x5b,0x15,0x04,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,
- 0x76,0xe1,0x16,0xb0,0x06,0x00,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x24,0x24,0x10,0x00,0x00,0x00,0x00,0x80,0x24,0x00,0x00,0x00,0x20,0x49,0x02,
- 0x00,0x00,0x00,0x08,0x10,0x00,0x00,0x00,0x40,0xaa,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0xc0,0x4d,0x87,0x6d,0xa0,0x1d,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x80,0x00,0x00,0x00,
- 0x00,0x92,0x10,0x00,0x00,0x00,0x42,0x01,0x00,0x00,0x00,0x00,0x01,0x0a,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x40,0x52,0x85,0xad,0x40,0x19,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x02,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x04,0x00,0x00,0x00,0x10,0x00,0x00,0x00,0x00,0x00,
- 0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x6d,0x0b,0x59,0xc0,0x3d,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xc0,0x75,0x0b,0xad,
- 0x80,0x22,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xcb,0x3a,0x9a,0x81,0x6a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x6d,0x53,0x6c,0x29,0xad,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x69,0x75,0xca,0x76,0x3a,0x00,0x00,0x00,0x00,
- 0x00,0x28,0x0a,0x00,0x00,0x50,0x01,0x00,0x00,0x40,0x01,0x00,0x00,0xa0,0x16,
- 0x00,0x00,0x30,0x04,0x03,0x00,0x00,0x00,0x28,0x14,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x02,0x00,0x00,0x80,0x00,0x00,0x00,0x00,0xa0,0x02,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x4b,0x8b,0x18,0x4f,0x06,0x00,
- 0x00,0x00,0x00,0x00,0x08,0x04,0x00,0x01,0xa0,0x00,0x00,0x00,0x81,0x00,0x00,
- 0x00,0x40,0x29,0x00,0x00,0x08,0x80,0x00,0x00,0x00,0x00,0x10,0x14,0x00,0x00,
- 0x00,0x00,0x00,0x80,0x00,0x00,0x00,0xa0,0x00,0x40,0x00,0x00,0x40,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd6,0xb4,0xd4,
- 0xea,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x42,0x45,0x05,0x90,0x20,0x85,0x42,
- 0x45,0x0a,0x2a,0x54,0x40,0x10,0x2a,0x54,0x21,0x16,0x50,0x42,0x50,0x01,0x54,
- 0x0a,0x28,0xa8,0x50,0xa1,0x82,0x0a,0x21,0x05,0x15,0x40,0x88,0x90,0x80,0x20,
- 0x22,0x90,0x40,0x02,0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x6c,0x76,0x59,0xb6,0x00,0x00,0x00,0x00,0x00,0x00,0x28,0x21,0x89,0x04,0x48,
- 0xa8,0x62,0x85,0xa4,0x94,0x12,0x12,0x40,0x10,0x29,0x28,0x89,0x88,0xa2,0xaa,
- 0x48,0x02,0x28,0x04,0x25,0x24,0x24,0x90,0xa2,0x8a,0x50,0xa1,0x12,0xa0,0x50,
- 0x21,0x29,0x41,0xd5,0x20,0x83,0xa4,0x0a,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0xca,0x54,0xa3,0x56,0x00,0x00,0x00,0x00,0x00,0x00,0x90,0x42,
- 0x44,0x01,0x48,0x11,0x14,0x48,0x81,0x08,0x41,0x04,0x40,0x28,0x42,0x80,0x90,
- 0x86,0x10,0x89,0x14,0x01,0x08,0x2a,0xa2,0x04,0x08,0x00,0x51,0x08,0x21,0x8a,
- 0x08,0x20,0x14,0x55,0x10,0x45,0x20,0x81,0x50,0x41,0x04,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0xac,0x9a,0x65,0x2f,0x00,0x00,0x00,0x00,0x00,
- 0x00,0xa0,0x10,0x44,0x00,0x84,0x08,0x21,0x44,0x20,0x48,0x30,0x05,0xa0,0x92,
- 0x20,0x40,0x14,0x01,0x21,0x42,0x04,0x01,0x32,0x89,0x40,0x02,0x04,0x20,0x22,
- 0x44,0x09,0x62,0x14,0x40,0x00,0x22,0x04,0x12,0x08,0x10,0x25,0x10,0x08,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xd0,0x67,0x5a,0x02,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x40,0xa8,0x8a,0x00,0x84,0x10,0x15,0x94,0x40,0x94,0x0d,
- 0x02,0xa0,0x0a,0x55,0x5a,0x09,0x81,0x10,0x84,0xaa,0x02,0x84,0x12,0x2d,0x2a,
- 0x54,0xac,0x12,0x0a,0x28,0x14,0x08,0x50,0x18,0x11,0x74,0x51,0x30,0x48,0x11,
- 0x60,0x05,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x28,0xb4,0xd2,
- 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x20,0x90,0xa0,0x00,0x55,0x09,0x12,0x48,
- 0x50,0x48,0x10,0x01,0x10,0x42,0x09,0x45,0x84,0x40,0x08,0xa1,0x44,0x00,0x52,
- 0x89,0x20,0x54,0xa8,0x10,0x09,0xc4,0x10,0x21,0x04,0x20,0x84,0x28,0x08,0x21,
- 0x00,0x94,0x12,0x88,0x08,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0xd8,0x56,0x3f,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0xa0,0x10,0x40,0x00,0x92,
- 0x14,0x11,0x44,0x20,0x84,0x00,0x04,0x40,0x84,0x00,0x81,0x10,0x81,0x28,0x45,
- 0x02,0x00,0x42,0x50,0x01,0x40,0x40,0x04,0x29,0x04,0x08,0x15,0x08,0x50,0x08,
- 0x09,0x04,0x10,0x18,0x04,0x11,0x28,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0xb0,0x6a,0x09,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x50,0x08,
- 0x10,0x80,0x40,0x88,0x0a,0x22,0x10,0xa8,0x80,0x02,0x28,0x42,0x00,0xa1,0x8c,
- 0x40,0x08,0x22,0x04,0x00,0xa1,0x88,0x00,0x20,0x80,0x8a,0x10,0xa1,0x04,0x12,
- 0x0a,0x00,0x8a,0x10,0x0a,0x10,0x10,0x82,0x08,0x10,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x40,0x8b,0x16,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x10,0x50,0xc5,0x80,0x42,0x85,0x20,0x45,0x21,0x44,0x14,0x01,0x20,0x4a,
- 0x25,0x4a,0x40,0xa5,0x14,0x41,0x95,0x00,0x42,0x90,0x2a,0x40,0x41,0x84,0x52,
- 0x86,0x10,0x61,0x05,0x50,0x04,0x29,0x24,0x21,0x08,0x2a,0x51,0x28,0x02,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x70,0x8e,0x05,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x20,0x50,0x22,0x03,0x81,0x04,0xa9,0x50,0x12,0x82,0x89,
- 0x00,0x28,0x14,0x95,0x2a,0x86,0x48,0x08,0x21,0x54,0x80,0x22,0x88,0x12,0x55,
- 0x5a,0xaa,0x50,0x21,0x8c,0x90,0x00,0x28,0x42,0xa4,0x48,0x08,0x04,0x94,0xa8,
- 0xa1,0x02,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x1a,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x10,0x80,0x40,0x40,0x00,0x09,0x00,0x00,
- 0x01,0x04,0x02,0x02,0x00,0x80,0x00,0x40,0x00,0x02,0x80,0x00,0x00,0x00,0x40,
- 0x10,0x04,0x09,0x04,0x10,0x00,0x84,0x00,0x02,0x06,0x00,0x00,0x11,0x90,0x20,
- 0x10,0x00,0x01,0x90,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x40,0x0b,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x54,0x01,0x00,0xa8,0x04,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x80,0x2e,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x48,0x01,0x00,0x50,
- 0x01,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x80,0x04,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x03,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,
- 0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00,0x00};
+++ /dev/null
-/* XPM */
-static char * liece_xpm[] = {
-"500 200 25 1",
-" c None",
-". c #2B050D",
-"+ c #AFAEAC",
-"@ c #818180",
-"# c #B3082C",
-"$ c #5F595B",
-"% c #DE6A7C",
-"& c #969493",
-"* c #E3DBDB",
-"= c #820B24",
-"- c #C9606E",
-"; c #3E3637",
-"> c #9E9E9C",
-", c #C2C2C0",
-"' c #5C051A",
-") c #AF5460",
-"! c #E3717F",
-"~ c #EDC2C8",
-"{ c #E99EA4",
-"] c #262221",
-"^ c #8D454C",
-"/ c #BA485D",
-"( c #F2EFEF",
-"_ c #D496A3",
-": c #B54159",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" >* ",
-" +;;+( ",
-" (>;-!-$, ",
-" ,$!!!!]@* ",
-" ( *@;]]!]$, ",
-" *@@>*(,$]%!-!@*( ",
-" ,>$];;&((&$%!%!;+* ",
-" ,@]]];];>*,$!!];!@* ",
-" ,$]%!!-!]@*>]!%]-;>* ",
-" *@])!]!]]]@,@]%%!]@, ",
-" (*** *$-%;-!;!]$@;])%-$&* ",
-" (>@$@>( @;-!!!;!!]$$];!!];+( ",
-" ,@;%-%$;@* *$)]!!;]-]!]]]!-]!@* ",
-" +$;]!!;%!];&* +;;]!]!!]]!];]];%;+( ",
-" *@;]]!);--$-;+(*@]!!!!!-!%%!!%]%$$, ",
-" *@]!!!])%!!;!!$+ +;!!;!%]]%%!-!]%%]>( ",
-" +]!!!-$@]!%!!-]@*(>;%]!%!]]]]!];]!]@, ",
-" *( (@]!%]]$(@]]]!!;$> *$%%%%%]]]!!!!!!%]@* ",
-" *@& (&^%!]-$>,;%-!-!!$( >;]^!-;;$%%%%%!-!;+( ",
-" +@]%] @;%%]]]$,>!%!!!%;>(,@;)!];;,$]];!!]]]@, ",
-" ,&$]!]-&( +$]%]]!;,*;]-!;]!$,(+;%!%!!@+$-]%!])!;+* ",
-" (&]!%%!!;, *$%-%!%%$,+!!!]!!]&(*@;!-!%]*,$]%%!]%)$* ",
-" (,;!!-!-!&**&;!]]!!]>(;!%$%!!$+(*$!!]!!&*+@]!);!;$* ",
-" *(( @]!!]!%;+(*@%];%!;@,>;!]%%%]$( @]];!%;+(,@%!-;@,( ",
-" +@$@,((+$%!-!!-$((+]!%!%!]@,@%!%]!;$+(,$];]!!$*(,$$@,* ",
-" +$!;!!$>((&]]]!!]]>(*@;]%%%!;+,;!!%-!]$( >;;]!!;& *,* ",
-" (**,( (>$;!;;]!)$,(,$;;]);];( ,$]-!;;;@,>]]!!!!;+(,@]!%%!] ( ",
-" ,~~~~~~* ( ,@]!!!!%!%!]$,(>;!!%!%%&**@;!-!%!;+(;-!%$%]@((,$-!;$@* ",
-" ~~~~_-::_*(*(( *$%!!!%!-%%$!;+ ($%%!]!!;,(,@!!!!!)@,>]]-];!@( *&$$@,* ",
-" ,~~{:######>**(*( @$-%]]$@$!%-;@,( ,$%!]%-;@((+]!]]!!;>*$!!!!-$* ,@>*( ",
-" ~~~{#########@,**(( *$]%!%]&,@]);@,( (@]%%!-%]> *$!!]!!!$+>]!%!!@( *( ",
-" *~~{:##########>,,*(( *;;]!-;&,,@&,*( ,$)]!!$%; +;!]!%!]$;]%!!]>( ",
-" (~~~############=>+,*(( ,+** ,$;;!]];>(,*((( (&;;];;!!+(*@;;!];%);-!!)$, ",
-" ~~~/#######=#####$&+,,>@;;;$,*(@!!!!!!]$$@@>&,,( ,$;%!%%!$,(,$!%!;%!!]];@, ",
-" *~~!###########=##=@&@$;-!;!!;>(+]!%!!!];!!;!];$@+((>;%%!-%^&((+$%%]!%!!]$+( ",
-" (~~{###############=$$;))%-;]!]@,(@)!]^%]]!!;$%]]]]@ (@-!]!!]$+ (,$);;];$@* ",
-" ~~~-########=######=.]]$--%%-!-]$ *]%!%!]]!%]%%!%!!%>*+;!]%!!;$ *&&@&+,* ",
-" *~~!############=####'].^);-!!!!]%,(>;]-!];!%]%-!%!;];+,&]])%!;]> (( ( ",
-" (~~~##################=]]^]@$;]-!]%$*(>$;!]]%%;]%^%%)$!$,,$]]!-]!;* ",
-" {~~/##############=###=];^]@+$]!!!!], (,+@$@$;$]]-!!]!!;&,&;%%!!!!+( ",
-" ~~~!###########=####=##=..^^;(>;!%]!;+( (*((**++>$]!;]-!$(*$!%!]]$,( ",
-" *~~{####################'.];^]>+@!!;!$, (,&&+*,@%;]!!;, +;!]@>,( ",
-" ~~~~###############=#####'].^^]$&$-!;;$,*( ,$!;$, +]]!!!;& (@$@,( ",
-" *~~~/#################=###'..;^]]$;!!;];$$>( ,@-!!;$&*,$]]%!$, ,,(( ",
-" *~~~/#############=#####=##'].;^)-;;%!];@;-],(,$]!-;%$>&]%]%!$, ( ",
-" *~~~/######################='..^^)-%]-!-!%%!!$,*@;!!!%!]]!%%!;>( ",
-" (~~~~/##################=####=]]].^]--];$;^%]]%]& *$%%;)!;]!];;>* ",
-" *~~~~:################=####=##'.]];))%!];,>;-!!%!$,(+;!!!!%!%]$@* ",
-" ~~~~{##########################.];;]))-%;%+,$;;-%!]$ (+]%%%%];$>( ",
-" *,~~~!#####################=###==.];$;)];%;;$++$;;!]]!, +>$$@++( ",
-" (*~~~~{:###################=######=..]$@$]--%;]^@*@^!-!%_$* ((**(( ",
-" (*~~~~{%#########################=##'...;&>$]%%]]-],,;)%%%-^> ",
-" (*~~~~~{%#############################=..]]$>,>;]%;;];$*&$]!]]-@* ",
-" (**~~~~~~{/#######################=##=###=...]$@+*,@]!!!!;],,$;!!^;&* ",
-" *****,~~~~~~~~_%################################=...];@+,*(,$!%%%%!$,&;%]@+*( ",
-" *~~~~~~~~~!%:#################################=#....]$>,*(((&;!]]%]]&*>@+* ",
-" *!%/:::##################################=###=.....];>,((((*$!%!!]%$,(,( ",
-" !##########################################'..]]];^]@*(+@>(>;%!%!;@* ",
-" (-#######################################=.....;;^^)$+&$;$+,@;!]@,* (* ",
-" ((/#####################################'.]]]];;.])-;;];]]$*,@@>, ,~~ ",
-" ((*/#################################='...];$$]^)]--]!%!!!;>*,*( ~~~_@*(((( ",
-" ((*~:##############################='.....];@@@^);!-]-!;;!$+( ( (,~~{==:*(((( ",
-" (*~{%###########################=....].]]]@>>,$-%-!-!-]$$+* (~~~~#='=@*,**(( ",
-" ((*&;:=######################='......]];^^$+,*>;%!%]]]$&*( (~~~!======&,,*(( ",
-" (,$]^.=%%/##############='......]]].;^.^]$+(((&;]%]$@,* ~~~!========&+,,(( ",
-" ( *$]/))~~{########'...]]];]]]]]];;]]^^^))]>( ,$!;&,* *~~!=='==='===>+,**( ",
-" ,,,*(+;-]_~~%#######..]];;;;$$$;];=^^:;)))--]$, (,$>, ~~{============&+,**( ",
-" *>@;$$$,(@$>~~{#######=]]];$$$@@@@&@;^^^];-];]];;+ *( *~-========'=='=$+,*(( ",
-" (@;]-%%!!$+,,~~~:######'.]]$$@@&&>>++,@;-/-;%-%!]]]@( (~:====='========$+,*(( ",
-" ,]!]!!-!!]$,~~~%#######..];$@>+,,,,*,*,&]%-%%%%%!];>( *:========'==='=^>+**(( ",
-" +$;!!!)!!--!${~~{#######].]]$@&,,**((((((,$]-]%%!-]@>, {=========='==;$@>+*(( ",
-" *$!]!!];]!-!%$,~~:######'.]]]$>,**((((((( (,$%;%!]$&,( ((&===='====='];$@&,**( ",
-" (,;!]]!$>@;]!;~~~%######...]];],,(((( (,]]^;&,* (*>)=====''.]];$@>+*(( ",
-" >,( @]!!!$@*,@;@~~~_######=]]..;.]@((( (@@$+( ((*,>@$;;];]];;$$@+,*( ",
-" *&$;$,*@^!%%%;+,,>,~~{######^]].];^^];, (,** ((*,>&$$;$;$$$@&>,,((( ",
-" (+@$;-;+(+;%;;%]$@+,~~~/#####:$;]].]^)]-@* ((*,,>&@@@$@@@&+,**( ",
-" >;;$!!!$,,;!!%!!;^!{~~%#####^$$;$];^)--!;+ ((**,++>>>>++,,*((( ",
-" *>$^%];%!]$+*&!%)!!]!~~~!######$;;$@$])--%%!$( (((**,*,,,,**(((( ",
-" ,@;;]%%;]]@+( *;!]!!;&~~~#####=]]$$$@&@;]]]!!;> (((((**((*(((( *((**( (((**( ",
-" ,,;!%]%!]]@,( (>;%%!{~~~######';.;$&>,>$]-;!%]$( ((((((((( (**,~~~~~~~* ( (,~~~~~~~~*( ( ",
-" *&$]*&]!]!%;]@ @$:_~~~/#####;;;];$&,*,&;-]!!%-+( *,~,* ( (*~~~~~~~__!:&_**((( *~~~~~~~+!&^-&,*(((( ",
-" ,&$]!!@>$;%!%]%] *,((+&~~~-#####^=.;;]$>**(*$!;]!]@+ *( ,~~~~~~((( (*~~~~~_%='''''''=>**((( (( *,~~~~{!^........$**((( ",
-" ,@;]]-!]&>]!%!-!!@,>@$+ (~~~!####=];]]=;]]>*(((>;-]$>,( (~, (~~~{/==')(**(( (~~~~~{-=''='''''''''&,,*(( (*~,~~,~,*( (*~~~~~-;............$,,*(( ",
-" (@;-!!!]!;@,@;]!]]!;@$]]@*~~~!####/@$.;.^^]]@(( (@$@,( (~~!, ( ( *~~~{#======***((( *~~~~_:'''=''''''''''''+,***( (*,~~~~~~~~__~~(((( **~~~{)................@+,**( ",
-" ,+$@$!!]!];@,(,;]!]]!!]$];;~~~~####=;$$;]]^^]]$( *,*( *~!==**((( (~~~_======'=$,,,(( (~~~~_:''=''''=''''''''''$>+**( *~~~~~~{!^='.'..]),(*(( ~~~~{)..................;&+,*(( ",
-" (*,~~~~~~~~~+&@+(( $]-!!-!%!%!~~~{####:^.;@$;]^-)%@* ( ~!==_***(( ~~~!=========^&+,*(( *~~~{)'''''=''''''='''''''$@&,*(( (,~~~~~_)'.'....'.'...,***(( (,~~~-]...................]@&+,(( ",
-" (*~~~~~~~~!_!_!{~~~~*((+$-!-!!!!!&~~{:####^];]$@;])--]@( ~!==),*,*(( ~~~{===========@>+,*( ~~~~{=='='=''''=''''''''''';$@+,*( *~~~~*,!='.'.'.'.'..'.'.],,**( ~~~~{^.....................]$@>,*(( ",
-" (,~~~~~!%:##########/!_~~*&;;^%];%&~~~:###=);];.;$]]]-;$, ~~#=:,,,**( *~~{#=========';$@>,*(( ,~~~)''''=@))^'='''''''''''';$@>,*( *,~**(~^'...'..'..'..'...'.&+,*(( *~~~_.....$@$;].............];@&+*(( ",
-" *~~~~{%##################/{~&;-%%;{~~~/###&;.^^^^^)--%-]>( ~{==^+++,*(( *~~~============;;@&,*( (~~~~='''-++&@@@{=''=''''''''.;;$>,*( (*~~~* _''.'^^^^.'.'..'...'...@@+,*(( (~~~~^...;&+&@@@_;............];$@,,* ",
-" ,~~~{########################!~@--_~~{/###~>$];=$^))--];>( ~~#=^&>>,*(( (~~~/===========.];$&,,(( (~~~~=='={++&@@$@+-'''''''''''.;$@>,*(( *~~~~*-.''&~*,,+>>@^''..'.'...'$@&,,(( ,~~~)...&,_>&@@$&~............];$&+*(( ",
-" ~~~~%###########################-~{~~{####_+@@$]]])];);@>* (~~==^&>>,,(((~~~%=#=========.];$@>,*( (~~{_=''),+>@&@&@@{~'='=''''''.]];@>,*( (~~~~~-'.'&*,,,+++>&@@$$;''...']]$$@,,(( ~~~~]..]_+>&@@@&@&~;..........]]$$>+*( ",
-" ,~~{###############################-{~:##/~@$;@@$;]]];$@,( (~~#=:@&>+**(*~~!===========.]];$@>,*( ~~~_''=:,+>&@&&&+>,~:''''''''']];$@+**( *~~~~)'.'',,,,,,+++>>&@@@$$;;;]];;$@&+*((*~~{'..'+++&&&&>&>,~!..........]]$@>,*( ",
-" ~~~~######################################$@;.]$&,>&@+,*( *~_==^&@>,,(~~~{#========='.]];$@>,*(( ~~~_'='^,>&&&&>+,,,~~:''''''''.];;@&,*(( (~~~~!=.'.=+++++++,++,++>&&@@@$$;$;$$@>,*(*~~~;..'++&&@&&++,,~~@.........]];$&+**( ",
-" *~~{######################################{$]];^;@+*((( ~~!=#)&&>+,*~~~==========..]];$@@+,*(( *~~{=='=>>&@@>++,**~~~^'''''''..];$@+,(( (,~~{^'.'''+++&>>,+,,,*,*,,++>@@@@$@@@>+,(*~~~^...@+&&&&>+,**~~~-........]]]$@>,*(( ",
-" ,~~~:#######################################%_^;^]$+*( (~~-==@@&>+*~~~/#======='.]];;$@&+,((( *~~~=''=&>@@&&+,,*(~~~_''''''']]];$@>,,(( *~~~_=.''.'@&&@>>+,*****(****,,,++>>&>>,,*(~~~)...)>&@@&++,***~~~]........]]$@@+**( ",
-" ,@@~~-##########################################_!^;@,(( *~~:#=&&@>,~~~!====#===']]];;@@&+,*(( ~~~/===)>&@@&+,***~~~~:'''''']]];$@&+*(( *~~~!''.'.'^@@@@&>,,**(((((((((***,,,,,,*((~~~!...'+&@@&&+**(~~~~-......]]];;@@+,*(( ",
-" *@]_~{#####:;;;^;;################################:_>+*((( ~~{===>@&>~~~_========]]];;$$@>,,*(( *~~!'''=>@@@&>,,*~~~~{:'''=';;]];$$&,,*(( (~~~)'.'''.'$$$@@&,,*((( ( ( ((((*((*****(((~~~'...@@@@@>,,*~~~~~@.....]]]];$$@+,*(( ",
-" @]~~!####'..];;$$;$;=##############################-{,**(( *~~-=#)>@@+~~{#=======]]];;$@>+,*((( ~~{=='=)&@@@+,~~~~~~!=''''^^;;;$$@&+,*(( (~~~:.''.''.;$$$$&+,*((( (((((((((((*~~^...;&@@@>+~~~~~~{;.....$$;;;$$&+,*(( ",
-" (,,( (+@~~####^^;];];@$@$@$$:##############################!,,*((( ~~~#==@&&&~~~-======#];];$$@>+,**(( *~~-'='=+_~~~~~~~~~_=''''^$@$$;$$@&,,((( (~~~!'.''.''';;$$@>,*(( ( ( (~~_.'.._+{~~~~~~~~_^.....$@$$$$$@&>,**( ",
-" *>@$, *&~~###']];.^.;@>>&@@@$$:##############################!~,*((( ,~~%==#>&@>~~_=======];];$$&>,,(((( ~~{'='=)~~~~{~__^:''''=)>&&$$$@@@>,,*(( *~~!.''.''.''];;@&+,((( ~~~=...'~~~~~{,_)$.....;&>&@$$$$@&+,*((( ",
-" ,$$];@( (+~{###^].;.^^;$+,,,++&@@)##############################:!,,*((( *~~{#==)&@&{~~#==#====]];$@@+,**(( *~~)='=':^^=^'''''''^)>,+>&@&$@@>+,,((( (~~~='''.'''.'];;@>,*( (~~_....;^^;=........^@,+>&@@@@&&>,,*(( ",
-" ,@]!%!%$+ ,~!##:;;].]^)]]@,**,,,+&@@%###############################{,**((( (~~~:==#+@@&~~{=======;];;$@+,,((( ~~{='=''''''''==)-&,,,+>>&&@&@>>,,*((( *~~^.'.''.'.''];$@+,*( *~~;'..'........^^&+,,++>&@@@@&>+,*((( ",
-" (* ,$;-]]!;@( ~!##^.;;;;)-;%],*((**,,+~~~-##############################:-~,*((( (~~{-===)&@@+~~:#======];;$@>,*(( (~~)=''='===^^@+++++++>+>>&>>>+,,**(( (~~_'''''''''..];$@,,(( ~~_.....';';^$>++,++++>+>>>>>+,,,*((( ",
-" >@+*@!!!-!!;+( ~!##)^]$$))--%%$+((((**~~~~-########################=########!~***(( *~~~_#===>@@@~~{========]]$$>,**(( *~~=='=''$;$$$@>>++>>+>+>+++,,,,(*(( *~~='.'..'.'.''];$&+*(( *~~~).....;;;$@@>>>>+>+>>>++++,,,(((( ,( ",
-" +$);$ *]%!!!%]@, ~~##^;^;@;^-%%!!$*( ((~~{~:###############################=##=#-~,**((( ~~~~!==##@&@@&~~)========];$@>,*( *~_='='=';;;$@&&+>++++++,,,,,*((((( ~~~~''''''.''.'.];$&,,( (~~*~~'.....;;;$$@&>+++++,+,,,,,*(*((( (~* * ",
-" (+@;!;;]+(&%]]]^];&((~##:^.]@+$%!%%];&( *~~~~:####''=####################=##=#######=-_~,*(( *~~~~-====)&@@@_~~#========';$@+,(( ,~~%'=''''^];$@@>+++,,,,,***(((((( (,~~~-.'.'.''.''.'';$&+*(( (,~( *)...'..'';;$$@>+++,,,,,*,(*((((( *~( *]>( ( ",
-" *@]!!%%!;(*;!%%%];$,(~%##^^^$,&]%%!!!]&~~~~~####/@;;=;###############=###########=#####:!{~,*((( *~~~~{:#=#=:@@$@&{~{==#======;;$@+,(( (*~*~~:'='='='$;$@>+,,,**(***((((( *~~(~:''''''.''.''..]$@+,(( (~~~* {';-.......;;$@&+,,,,***(*(((((( (~~* >.+((((( ",
-" *&]!!!!%!+(@;)-!%]]&((_##)^^;>+$-!%!!@~~~~!####!&@$$$$$^######################=#####=##=#=/!~,~**( (**~~~~%======@@@@@&,~_==========:>@+,(* *,~~* {:'='='''='_&@+,,(**((((((( (,~~ ~'''.'.'.''.'.''']$@>,(( (,~~*(~;.)~)........^&@&+,**(*((((((( ,~~*($.>(**(((( ",
-" (*** *$]]!-!-$,*$!!%!]!;,*+)##!@);$]!-_{~~~~{:###:+>@@@@$@@$$:#############=##=###=##=########=##/!~~,~,**( (**~~~~~~%#=#=#=#@@$$@&+~~-=========='^,,,**(( ((*~~~~~*~:':'=''='=''')~++**(((((( (~~~*(-'=_''.''''.''.'.'.$@&,,*( (*~~~~*,^.=+~~^.........;{,,,**(((((( (*~~~(_].>******(( ",
-" ,+@$@+( &$]!!!!-@ +]-!!^!]@**$:##{~&&_{~~~~~!/####!{+&@@@@>>>>@@$:#####=###=#####=####=##=#=#=####=#=#:-!~~~~,~~,*****,~~~~~~~_-#======#$$$@@@>,~~:=============){~,~~,~,~~~~~~~~!^'=)~='='=''='='=!~~,*(((( *,~~~*{;''~!.'''.'.''.''.''.@>+,((( (**,~~~~~{^..^,~~~^...........){~~*(((( (,~~~~*^..&**,,***(( ",
-" ,$!-;];>(*$;%!]!!;>+$]!;]%%$+*>;###-{~~~~~{^#####/++>&@&&>+,,,,+&@@$=###############=####=#####=#=###=#=#=#::_!{~~~~~~~~~~~{!:#=#=#=#=#=$@$$$@&,*~~:==============':)_{~~~~~~__/:'=='_~!='''='=''''''=){~~~**(***(***~~~~~~_^''^,~_'.'.'''.'.'.'.''.)~~,,*,~~~~~~~~_-'...),,,~~..............^_,~~******(***~~~~~~{@..]>*,,,,,**(( ",
-" *>$$%-!!-!;+(+$-!!!-!;$]!!%!%!]$,,$-:####:########:;@+&&&&&>+,*****,+&@@$=######=#=######=###=#=#=##=#=##=###=#=#=#=##::::::#=#=#=========$$$$$&>+***~:#=========='=========='='=='='==&,~_'='='''='='=''''=)_~~~~~~~~~~~~~{!='''^*,~%'''.'.'.''.''.'.'.'!~~~~~~~~_-^'....'+,,++,~'................^!{,~~~~~~~~~~~~!;....,,,+,,,**(( ",
-" *+$;%%!!!!!!;$,*&]%%!!%!!]%%!]%%];&(>)]::#########::;$@>&&>>+,***(((**,,+&@$^=#=######=#=##=#=######=###=#=#=#=#=##=#==#=###=#==#===##=#=#=$$$$$@&,,*((~:=============='=='='===='=='='=&>&{~''''='=''''''='''''''^^!_!_!_-:='''''^++>~&'.'''''''.'.'.'.'...'.^:^^'.'....'.^++>>>++~^....................;^-&!&!&!^;......+++++,,,*((( ",
-" (@$;;^;;);;%!;;@ *$!]]];]!]]-!]])]-$,+$.]^:]:^@-$];;$@&>&>>+,,**((( ((((*,,+&@$^#####=#########=#=#=##==##=#=#=#=#==#=##=#==#=#=#=#=#=====;$;;$$@>+,*(((~!========'======'==='='='='==':@@@&>~:='='''='='''''''''''''''.'''''''.'.-+>>>+~''.'...'.'.'.'.'.''..'.......'.'.]@>&&&>>+,~-...................................;+>>&>++,*((( ",
-" ($!-!!!%;$$]!!!$;,(&]%%!!%%!]]%%%!)%]@,@^])^.^;&+@$$@&>>>>+,,,*((( (((**,,>@@$==###=##=#=#=###=##=###=#=#=##=#=##=#==#=#=#=#=======#=#;;;$$$@&,,((( (({==========='===='==='===='='^$$@@@&_)''''='''='='='''''''''''''''''''''$&@&@&>~=.'''''.'.'.'.'.'.'.'.'.''.'.'..^@@@@@&>+,,*_..................................;&&@&&>+,**(( ",
-" (@!!!%!!;+>$$%]]!$ ($!%%!!%]$&$)!-]!%$,&;]))]^;$+>&@&>++,,,**(((( (((**,++&@$;###=######=###=##=#=#=###=#=#=#==#=#=#===#==#=#=#==';;;;$$&>+,*(( (~:========'==='==='==='='==';;$$$@@>+{='=''=''''''''='''''''''''''.'.''@$@@@@>+~)'.'.'.''.''.'.'..'..'....'...'$$$@@@&&+,,**~;................................$$@@@@&+,**(( ",
-" *]!]%!!;@+&$%^]!!*(>$)%]%%;$(*^!!]%!]@+$;--])]@+++,+,,,,,**((( (((**,+&&$$==#=#=#=##=#=#=##=##=#==#=##=#=#=#=#=#=#==#====#']]];;$@@>,*((( (*-==='========='==='==='='=;;;$$@&>,,~/''=''='='='''''=''''''''''''''=$$$$@@>+,,{''.'''.'.'.'.'.'.'.'.''.'..';;$$$$@@>+,*(*(*_...............................;$$$$@&+,,*(( ",
-" +, @]]!!%%]@*$%%!%%@**@]%%!%];, $!!!!-!$&+;--];$>,,,,~,**((((( (((**,,+>@@$==###=#=##=##=##=#=##=#===#=#=#==#=#==#==#=#']]];;$$@&+,,(*( (*:====='========'==''===']];;$$&>+***+==''='''''''=''''''''''''.''';;;$$$@>+,**,)'.'.''.'.'.'.'.'..'...'.'';;;$$$@@>,,**((((*^............................];;$$$@&>,*((( ",
-" *&;]@* *$]]%!;]$,>;]]!]$, ,$%]%!]]$(*;%;]!];$,$%]@+,**(**(*((((( ((***,+>@@$;=####=##=#=#=#=#==#=##=#=#==#=#==#=#=#='.]]];$$@@&,,**( **_========'=='==='===''.]];;$@&>,,*(**_''''='''=''''''''''''''''''];;;$$@&+,**(*,'''.'.'''.'.'.'.'.'.'...]]];;$$@&+,**((( ((*+'..........................]];;;$@&>,,*(( ",
-" *>@]!]$>( >]$%-]%]@>]^;!]$* *&]^!!;%!+(&]]%%!%]@&$&,*((((((((((( ((**,,+&@@$;;#=#=#=#=#=##=##=#==#=#=#==#===#==='.]]];$$$@&+,,((( ((,@===='==='=='=='='=..]];;$@&>,*((((*,-'=''='''''''''''''''''''..]];$$&>+***(((*&'.''...'.'.'.'.'..'.'.]]];$$@@&+,,*(( (((*>]........................]]];;@@@+,*((( ",
-" +]%!!)!$,( ($%!!!!!];%!%!;@* ,$-%%]%!$,,$%%!!!]@,*( ( ( ((( (((**,,>>@@$$;==###=#=#=#==#=#=#==#=#=#=#=='..]]];;$$@&>+***((( (*,)=========='====..]];;$@@>,,**( (((*,)''''='='''='''''''''''.]];;$@@>+,*((((((,-'.'''.'.'.'.'..'....]];;$$@&+,**((( (*,&........................]];$$@&+,*((( ",
-" (>]]!!!!;&* *!-!];%))!];%$+ &;-%]]%]&(,;-!;;@*( (((**,,+>@@$$$]==##=#=###=#=#=#=#==#=''..]]];;$$@@&>,,*((( ((*+@=='=='='=='''.]]];$$@&+,,((( (**+@'='''''''''''''''''.]]];;$@@+,*(((( ((*,@''.'.'.'..'.'.'.].]];$$@@>+,**(( ((*,@]....................]];;$$@>,,*((( ",
-" * *$$;!;!!$, @%%^]!-%%%];&* *&]%%%%]$,($%;@+** ((((*,,+>&@@$$;;;''===#==#=#==='..]]]];]$;$$@@&>,,**((( (((,+&^======''.]]]];;$@@>+,*((( ((*,+@^'''''''''''''''..]];;$@@>+,**(( ((,+@;'.'.''.'.'...]];;;$@@>+,**(( ((**+&$.................]]];$$@&+,**((( ",
-" ,&+ (>$%!]!-]@* ,;!%!!!!%%$, +;!!!%%%$ *$>,( (((**,,+&&@@$$$;;;]]]]]]]]]]];];;;;$$$@@@>>,,**(((( ((*,+&@$;;]]]];];$$$@@>+,**((( ((*,+@$^''='''''''..]]]];$$@&>,,(((( (((,+&$^''.''.].]]];;$$@@&+,,(*((( (*,+&@;............]]]];$$@@>,,**(( ",
-" *&]]$* *@]!];%!;+ @]];!]]]& *&;]%%!];* *( ((((**,,++>&@@@$$$$$;;;;;;;$;$$$$@@@@>+,,,**((( ((*,+&@@$$$;$;$$$@@>+,,**(( (**,+@@$$=;]'.]]]]]];$$$@&>+,**(( ((*,+&@$$;;;;];;;$$$@@>+,,**(( ((*,+&@@;;]].].]]]]];;$$$@>+,,(((( ",
-" ,&$]!!-@,( (,$!;]$]]&* *$)]!%!!$* ,$]%%%]@* (((***,,++>>&&@@@@$@$@$@$@@@@&&>+,,,**(((( ((*,,>@@@@@$@@@>>+,,*((( ((*,+>@@$$;$;;;;;$$$$@@>+,**((( ((*,+>@@$$$$$$$$@@&++,,*(((( (((,,>@@$$;$;;;;;;$$$@@>+,,*((( ",
-" ,>$]]!-!!]@* *&!!!%!%;>* ,!!%!!!]@* (&]!]$,,( (((((***,,,+>&&>>>&&>>>>>++,,,,***((((( (((**,,+>>>>>++,,***((( (((**++&@@@$$$$@$$@@>>,,**((( (((,,+>&@@@@@&&>++,***(( (**,+>&@@$$$$$@$@@@++,,**(( ",
-" (@]!!;]!;]!;>( ,$]%%!-!$* *@]!-%%]$+ ,@$>, ((((*(*,*,*,,,,,,,,,,,,***((((((( (((***,,,,,,***((( ((**,,+>>>&&@&&>>+,,***((( (((*,,,++>+++,,,***((( (((**,+>>>&&&@&>>+,,,((((( ",
-" +]]!!]!!-;!]$> (>;]!]]!;@* *]%]]-];@, ,*(( ( ((((((*(*(******((((((((( ((((*(*(((*((((( ((((***,+,+,+,,,***(((( (((*,*,*,**,(((((( ((***,,+,+,+,,,,**(((( ",
-" *;$%%-!!!!!!];* ,$]!%]%!$, @]!!!%-;& ( (((((((((((((((((( (((((((((( ((**********(*(((( ((((((*(*((((( ((((((***,(**(((((( ",
-" (@$]!]]!;]!];-@*((+$%%]!-;&* ,$-]!]]]$* ( ( ( ( ( ( ((((((((((((( ( (((((( (((((((((((((( ",
-" (+$;!!!!;]!!]!]@* *&-!]!!!;+( &^%%!!!;>( ( ( ( ( ( ( ( ( ",
-" *$;%-!!;;]%^!-;&*(,;!]!!!-@, ((,$!-!)!!;, ",
-" (+;!];%;@$^]!!;$& (>^;%-;!;>*,+>,*]!!;%]&* ( ",
-" (;!!!!;@@;%!!]-]* ,$]!!;!!$>$;]&($%!;$>, ~-%+ _%-* ,* _%-%+ ,* !-_ ,%-!-%-%+ _%- + {-_ !%-* *-%- {-_ ,!-_ ,* (!%-%%, ",
-" @]!%%!$>@]!%!!!$,*>;!!!%!]]]!%$+,;$&,(( %!! (!!{ (!* (!!%!{ (!* *!!~ ~!!!!!!!% _%! ,! ,{~ (%!!~ ,!!% ,{~ ~%!{ (!* ,!!_{{( ",
-" *;]-!%$@+@]!]]!;+*,@]%;%-;]%-]]@*,,(( {!-( _!! *+___+* *{!%{_, {%_!%_ ~_+(___, *_-%-_( *{!%_{, ~%%~___, (~____, __~+__( {!- {%%* *+___+* ______, !!_ ~_!!__(({_* (__*~__, *__+ *____,( {!!!, !%!-( (~____, *_____* ~_____ *______( (~_____, ({{* *__({__+ *+_____( {!!, *__({__+ *{!%{_, (~____, __,{_{~_%!~*( *______( *_____* *+___+* ",
-" *@;!!%]$*,]!]]!!$&,+$!!%!]]%!;;@*( ,!!~~%%* *!!!!!%! _%!%!!~ *%%*!%{ _!%!!!!! *%%!{!!! _!!!!!~ _!%!!!!%* !!!!!!!~ (!%!!!! %!! _!% *!!!!!%! !!!!!!! *!%~(%!!!!! (!!~ !%!!!%%{!!!%{ +%!!!!%{ _%-!{ ,!!!%* !!!!!!!~ *!!!!!%( +%!!!!_ *%!!!!%{ (!!!!!!!{ (%%~ *%!!!!!%~ ,!!!!!!%~ %!% *%!!!!!%~_!!%!!~ !!!!!!!~ (!!!!!!!!%!!%* *%!!!!%{ ,!!!!!%~*!!!!!%! ",
-" (>$-!!]!, $!!-!-!;&*@%!-!%]%]$>, *!%_!!+ {%!*~~%%~~!!!~*( !!{ %!_ !!!~~!!- !!!( (!!~~%!!~*( !!!~*!%%(~!%~~*!!_ ~!!{~** *%!_ (!-_ {%!*~~%%, (*~*!!! ~%!~({!%{*, ~!!( ~%!{{_!!!{_!!{(%!{*~{%- *%%_%_ _%%%%, ~!%~~*!!_ !%_ *!%~ **~~!!+ !!%{{{!!+ ~%!( {!%~~{%!**!!!{{_!!* *!!! {!%~~{!!~~!!!~*(~%!~~*!!_ ~!!{~*~{%%_{{ **~~!!{(!!!~~** {!!*~~%%, ",
-" *$;!%;;@>$!]!%!]!],,$;!%];;@,(( !%!!! *%%~ (%%*~!!* ,%!( %!{ *!!~ _%_*%!~ %!~*%!* (!!~ {!! !%_ _%{ _!!( *%%!%-!%%~*%%~ (!!* *~*~*!!{ _%% _!% {!% _!%( ~!!~ (%%{~%%( ~%! {!!{!{*!%{%!~ !!_ _!{ !%{ ~!!~ ,*~*~%!~~!!~ ~!%~ +!% !!_ ~%%({%!( _-! ,!%_ !!_ {!!(~!!* !%_ _%{ _!!( ~!%* ,*~*~!!*~%!~ *%%~ (!!* ",
-" >;%%$]]$]%!]%%-!!$,@]!!;@,* {%!%* {%!%%%!!! {%%( (!!{ -%_ ~%!* %%{{!! %!~{%%( ~%!* !%_*!%%-%!%!* !!! {!%%!%%!{ {%%%%%%%% {!!!!!!%, !!! !-_ _!_ !%_ {%! ~!!~!%!%%%%!_ !!~{!!_!{{%!**%%%-%%%%* %!-!_* ~!%%_+( !!!!%!%!(_%! {%% {!_ (!%+ {%%(%!{ !!_ {-!, (!%+ {!% {%%( *!%%-%!%!* !!! {%% !!!!%%%%({%% {%%%%%%%% ",
-" ,;!!%!!%-!%]!%%!%!@+$;$&, *%%{ _!!{{{_{{ _!! {%!{_{!!! _%! ,!%~!!{ ,!! _%! _!! %!~~!!{{{{_{( %!{ !!! _%! {!!{{{{{{ !!!~~{%%~ %!_ (%!{ -!{ (!!{ !!_ {!! %!!{{{{{~ ,!!(~%%!%(~!%~*!!{{{{_{( +!!!%%* (_%!%%!(*%%{~~!%% %%{ %!_ -!{ *%!~ %!{~!!~ ,!!~ %!!( ~!!~ %!{ _%! *%!{{{{_{( %!{ !%{ ,!!!*~!%! %%{ _!!{{{{{{ ",
-" @]%]]!^!!;$%%]];];@++*( {%!, !%{ %%_ *!!%%!!!!- !%_ ~!!(!!, _!! !!_ !!_ ~!!~{%% ~!!, (!!_ {%!, !!{ *%!* {!% *!%, ~%!, *!!* ~%%, !%+ !%_~!!~ {!_ ~!!%_ ~!!~{!% ~_%%_ (~!!%~{%! %%{~!!, *!%+ *!!, {%% (%%~{%% {%%* (!!! {!% (%%, !!_ {!% ~!!, (!!, {!! %%{(%%+ !!{ ",
-" ,;%!%!]%;&&]!%%!;$>(( !!! %!{ * ,!!~ ( _%_~*~*%!!(!!~ _!! !!~ *%!{*%%~ ((!!~ {!! {!% (* +!!* ,!%{ *%%{ -%{ * {!% -!! ,!%* _!%( (~%%( _!!( ,!!~ (%%{*!%* * (%-~ ~!%%* ~!!~{%% (* (%!{ ~%!~!!{ ,!%~~!%_ (_!%~ ~%!( _!_ *%%*{!%~ *!!% ~!!{ _!! *%%*~%%~ (_!- (* +!!* ~%!* !!{ ,!!~~!%{ (%!{ * ",
-" (@!%%!^!$**>]--;@+* (!%_ !-%__{__ ~!%{~,* ~%%* %%!~!-* !!_ %!{((_%%(~%!+~~*~%%* _%_ {%%____! {!% {!!, %%%, !%%__{__ {%%_{{!!_ {!% _!%*~+ {!- !!! {%% ~!!*~%!!____, ~%%( ~!!! ~!%*{%%_____ , ({!!~, *!!! !!%{{_!!~(!%%%!!!% {%% %%+ {%! {%%%%_!!_ {%!, !!+ {!% ~!!+~~*{%%____! {!% {%% !!%{{_%%*~!!!,~_{*!%-__{__ ",
-" >]]!%]]], *@$$&,( *%%_ _!!!!%!~ _!%!!% !!{ %%%{!! *%%* +!%%%%!* _%%!!! ,%! %-{ *%%%!!!{ -%{ !!! _%!! _!%!!!!~ +!%%%{%!~ %%_ %%%!!{ !!{ *!!{ _!_ _!%( %%!!!!! !!_ (!!~ *%!~*%%%!!%{ _%-%!%!!(!%-!!%!{ !!%%!_!% {%%%~!!! !!{ ,!%~ !!{ (!!%!~%%~ !!%( ,!!~ !%{ _%%!!! ~!%%!!!{ -%{ !%{ !!%%!{%% !!%%!%! _!!!!%!~ ",
-" (+!%%!!]@*(,+,( ~{{, ({{{{{+ ~{{{{, ({{, {{{~{_ *{{~ *{{{~ ~{{{{, ~{_ {{* ~{{{{_( {{, {{_ ~{{, ({{{{{+ ({{{~*{{* {{+ {{{{{* {{, ({{, {{+ ~{{( *{{{{{, {{, {_ *{{~ ~{{{{_( {{{{{{~ ({{{{{{* *{{{({{_ * *!!+ ~_~ *{{* {{+ * {%%* {{{( *{{* {{+ ~{{{_~ ~{{{{_( {{, {{, *{{{({{_ ({{{{{* ({{{{{+ ",
-" $-!]!!$, (( %%-!%%%!* *%%-%%!-! ",
-" +]%];;@* !!%%!%!~ *!!%%!!!( ",
-" ^!!;>*( (*~*~* **~*~( ",
-" @;>,* ",
-" (,( ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-;;;; $Id$
-;;;; This file implements a simple FIFO queue using macros.
-
-;; Copyright (C) 1991-1995 Free Software Foundation
-
-;; Author: Inge Wallin <inge@lysator.liu.se>
-;; Maintainer: elib-maintainers@lysator.liu.se
-;; Created: before 12 May 1991
-;; Keywords: extensions, lisp
-
-;;;;
-;;;; This file is part of the GNU Emacs lisp library, Elib.
-;;;;
-;;;; GNU Elib 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 Elib 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 Elib; see the file COPYING. If not, write to
-;;;; the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;;;; Boston, MA 02111-1307, USA
-;;;;
-;;;; Author: Inge Wallin
-;;;;
-
-;;; Commentary:
-
-;;; The queue is implemented as a two cons cell list, the first
-;;; containing the tag 'QUEUE. The car of the the second cons
-;;; cell points at the first element of the queue and the cdr points
-;;; at the last. All entries and removals are done using destructive
-;;; functions.
-;;;
-;;; This file implements the short functions as macros for speed in
-;;; compiled code.
-;;;
-
-
-;;; Code:
-
-;; Provide the function version and remove the macro version
-(provide 'queue-m)
-(setq features (delq 'queue-f features))
-
-
-;;; ================================================================
-
-
-(defmacro queue-create ()
- "Create an empty fifo queue."
- (` (cons 'QUEUE (cons nil nil))))
-
-
-(defmacro queue-p (queue)
- "Return t if QUEUE is a queue, otherwise return nil."
- (` (eq (car-safe (, queue)) 'QUEUE)))
-
-
-(defun queue-enqueue (queue element)
- "Enter an element into a queue.
-Args: QUEUE ELEMENT"
- (let ((elementcell (cons element nil)))
- (if (null (car (cdr queue)))
- ;; QUEUE is empty
- (setcar (cdr queue)
- (setcdr (cdr queue)
- elementcell))
- (setcdr (cdr (cdr queue))
- elementcell)
- (setcdr (cdr queue)
- elementcell))))
-
-
-(defun queue-dequeue (queue)
- "Remove the first element of QUEUE and return it.
-If QUEUE is empty, return nil and do nothing."
- (if (not (null (car (cdr queue))))
- (prog1
- (car (car (cdr queue)))
- (setcar (cdr queue)
- (cdr (car (cdr queue))))
- (if (null (car (cdr queue)))
- (setcdr (cdr queue) nil)))))
-
-
-(defmacro queue-empty (queue)
- "Return t if QUEUE is empty, otherwise return nil."
- (` (null (car (cdr (, queue))))))
-
-
-(defmacro queue-first (queue)
- "Return the first element of QUEUE or nil if it is empty.
-The element is not removed."
- (` (car-safe (car (cdr (, queue))))))
-
-
-(defmacro queue-nth (queue n)
- "Return the nth element of a queue, but don't remove it.
-Args: QUEUE N
-If the length of the queue is less than N, return nil.
-
-The oldest element (the first one) has number 0."
- (` (nth (, n) (car (cdr (, queue))))))
-
-
-(defmacro queue-last (queue)
- "Return the last element of QUEUE or nil if it is empty."
- (` (car-safe (cdr (cdr (, queue))))))
-
-
-(defmacro queue-all (queue)
- "Return a list of all elements of QUEUE or nil if it is empty.
-The oldest element in the queue is the first in the list."
- (` (car (cdr (, queue)))))
-
-
-(defun queue-copy (queue)
- "Return a copy of QUEUE. All entries in QUEUE are also copied."
- (let* ((first (copy-sequence (car (cdr queue))))
- (last first))
- (while (cdr last)
- (setq last (cdr last)))
- (cons 'QUEUE (cons first last))))
-
-
-(defmacro queue-length (queue)
- "Return the number of elements in QUEUE."
- (` (length (car (cdr (, queue))))))
-
-
-(defmacro queue-clear (queue)
- "Remove all elements from QUEUE."
- (` (setcdr (, queue) (cons nil nil))))
-
-;;; queue-m.el ends here
+++ /dev/null
-(liece
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority high
- category CATEGORY
- dump nil
- description "IRC (Internet Relay Chat) client for Emacs."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (liece-xemacs gettext liece-clfns liece-handler liece-compat liece-version liece-vars liece-globals liece-inlines liece-filter liece-coding liece-dcc liece-menu liece-000 liece-200 liece-300 liece-400 liece-500 liece-nick liece-channel liece-commands liece-ctcp liece-q-el liece-message liece-handle liece-hilit liece-intl liece-mail liece-minibuf liece-misc liece-tcp liece-url liece-x-face liece-window liece)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-Copyright (C) 1998-2005 Daiki Ueno
-Copyright (C) 1989 Tor Lillqvist
-
-Riece is mainly written by Daiki Ueno <ueno@unixuser.org>.
-
-The development of Riece has started to redesign the Liece IRC client.
-Liece was mainly written by the same author of Riece. Liece is based
-on Irchat (version 3.01) which has been distributed under GNU General
-Public License version 1 or later. Tor Lillqvist <tml@iki.fi> is the
-original author of Irchat. The current Riece source code, however,
-doesn't contain any code from Irchat. For the historical reason, the
-original copyright statement of Irchat is filed under
-doc/irchat-copyright.el.
-
-Riece has many code borrowed from other GPL'ed elisp packages such as
-Gnus, Emacs-w3m, ECB, and SEMI. I would like to thank the developers
-of these packages.
-
-Other authors:
-
-TAKAHASHI Kaoru <kaoru@kaisei.org>
-OHASHI Akira <bg66@koka-in.org>
-Yoichi NAKAYAMA <yoichi@geiin.org>
-Masatake YAMATO <jet@gyve.org> (riece-yank.el)
-Steve Youngs <steve@sxemacs.org> (riece-xfaceb.el)
\ No newline at end of file
+++ /dev/null
-2014-06-22 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.26 released.
-
-2014-06-02 Jerry James <james@xemacs.org>
-
- * Makefile (COMPILE_INFO_AS_MULE): Enable when bulding with MULE
- to properly process Japanese info files.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.25 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.24 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * doc/.cvsignore: Remove.
- * lisp/.cvsignore: Remove.
- * lisp/test/.cvsignore: Remove.
- * .hgignore: New file.
- * doc/irchat-copyright.el: Restore CVS keyword expansions.
- * doc/riece-en.texi: Update for texinfo 5.x.
- * doc/riece-ja.texi: Ditto.
-
-2007-03-20 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.23 released.
-
-2007-01-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.2 released.
- * configure.ac: Bump up version to 3.1.2.
-
-2006-12-18 Daiki Ueno <ueno@unixuser.org>
-
- * configure.ac: Generate lisp/riece-package-info.el.
-
-2006-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.1 released.
- * configure.ac: Bump up version to 3.1.1.
-
-2006-07-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.0 released.
- * configure.ac: Bump up version to 3.1.0.
-
-2006-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.0.0 released.
- * configure.ac: Bump up version to 3.0.0.
-
-2006-01-13 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.22 released.
-
-2006-01-13 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile (ELCS): Added riece.elc.
- From Mike FABIAN <mfabian@suse.de>.
-
-2005-11-21 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.21 released.
-
-2005-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.2 released.
- * configure.ac: Bump up version to 2.0.2.
-
-2005-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.1 released.
- * configure.ac: Bump up version to 2.0.1.
-
-2005-08-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.20 released.
-
-2005-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.0 released.
- * configure.ac: Bump up version to 2.0.0.
-
-2005-08-06 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile.am (EXTRA_DIST): Add HACKING.ja.
-
-2005-03-21 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.19 released.
-
-2005-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile (DATA_DEST): Put *.xpm files into etc/riece/.
-
-2005-03-20 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2005-03-06 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.8 released.
- * configure.ac: Bump up version to 1.0.8.
-
-2005-02-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.7 released.
- * configure.ac: Bump up version to 1.0.7.
-
-2004-12-07 Daiki Ueno <ueno@unixuser.org>
-
- * README.ja: New file.
-
-2004-12-07 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2004-12-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.6 released.
- * configure.ac: Bump up version to 1.0.6.
-
-2004-11-07 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.5 released.
- * configure.ac: Bump up version to 1.0.5.
-
-2004-10-11 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.4 released.
- * configure.ac: Bump up version to 1.0.4.
-
-2004-09-06 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2004-06-27 Ilya N. Golubev <gin@mo.msk.ru>
-
- * .cvsignore: Remove `Makefile'.
-
-2004-09-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.3 released.
- * configure.ac: Bump up version to 1.0.3.
-
-2004-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.2 released.
- * configure.ac: Bump up version to 1.0.2.
-
-2004-07-10 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.1 released.
- * configure.ac: Bump up version to 1.0.1.
-
-2004-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.0 released.
- * configure.ac: Bump up version to 1.0.0.
-
-2004-05-07 Daiki Ueno <ueno@unixuser.org>
-
- * configure.ac: Set AM_CONDITIONAL XEMACS.
- * Makefile.am: Emit install-package and package target only if
- EMACS_FLAVOR = xemacs.
-
-2004-05-05 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2004-05-04 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.2 released.
- * configure.ac: Bump up version to 0.2.2.
-
-2004-03-09 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.1 released.
- * configure.ac: Bump up version to 0.2.1.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.0 released.
- * configure.ac: Bump up version to 0.2.0.
-
-2004-01-28 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.8 released.
- * configure.ac: Bump up version to 0.1.8.
-
-2003-12-28 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-12-25 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.7 released.
- * configure.ac: Bump up version to 0.1.7.
-
-2003-11-10 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.6 released.
- * configure.ac: Bump up version to 0.1.6.
-
-2003-12-01 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.13 released.
-
-2003-12-01 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile: Fix a copy-cat error.
-
-2003-10-29 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.12 released.
-
-2003-10-26 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile: Don't add "skk" to REQUIRES even when building with
- MULE.
-
-2003-10-25 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.11 released.
-
-2003-10-24 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.5 released.
- * configure.ac: Bump up version to 0.1.5.
-
-2003-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.4 released.
- * configure.ac: Bump up version to 0.1.4.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.3 released.
- * configure.ac: Bump up version to 0.1.3.
-
-2003-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.2 released.
- * configure.ac: Bump up version to 0.1.2.
-
-2003-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.1 released.
- * configure.ac: Bump up version to 0.1.1.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.0 released.
- * configure.ac: Bump up version to 0.1.0.
-
-2003-08-03 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.4 released.
- * configure.ac: Bump up version to 0.0.4.
-
-2003-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.3 released.
- * configure.ac: Bump up version to 0.0.3.
-
- * Makefile.am (SUBDIRS): Add doc.
-
-2003-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * configure.ac: Simplified.
- * Makefile.am (SUBDIRS): Remove dcc.
-
-2003-05-30 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.2 released.
- * configure.ac: Bump up version to 0.0.2.
-
- * INSTALL-CVS: New file.
- * Makefile.am (EXTRA_DIST): Add INSTALL-CVS.
-
-2003-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile.am (AUTOMAKE_OPTIONS): Add "no-dependencies".
-
-2003-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.1 released.
-
+++ /dev/null
-Development of Riece uses CVS, Concurrent Versions System.
-Latest developing version is available at CVS.
-
-(0) logging in to anonymous CVS server.
-
- % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login
-
- CVS password: [CR] # NULL string
-
-(1) checkout modules
-
- % cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root checkout riece
-
-Specify revision tag in front of the module name.
-
-(2) bootstrapping
-
- % autoreconf -f -i
-
-You will need newer versions of autoconf & automake.
+++ /dev/null
-# Makefile for Riece lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# This XEmacs package contains the riece IRC client package
-
-VERSION = 1.26
-AUTHOR_VERSION = 3.1.2
-MAINTAINER = Daiki Ueno <ueno@unixuser.org>
-PACKAGE = riece
-PKG_TYPE = regular
-REQUIRES = xemacs-base mail-lib bbdb
-CATEGORY = standard
-
-include ../../Local.rules.inc
-
-ELCS = lisp/riece.elc lisp/riece-000.elc lisp/riece-200.elc \
-lisp/riece-300.elc lisp/riece-400.elc lisp/riece-500.elc \
-lisp/riece-addon-modules.elc lisp/riece-addon.elc lisp/riece-alias.elc \
-lisp/riece-async.elc lisp/riece-biff.elc lisp/riece-button.elc \
-lisp/riece-cache.elc lisp/riece-channel.elc lisp/riece-coding.elc \
-lisp/riece-commands.elc lisp/riece-compat.elc lisp/riece-complete.elc \
-lisp/riece-ctcp.elc lisp/riece-ctlseq.elc lisp/riece-debug.elc \
-lisp/riece-develop.elc lisp/riece-display.elc lisp/riece-doctor.elc \
-lisp/riece-epg.elc lisp/riece-eval-ruby.elc lisp/riece-eval.elc \
-lisp/riece-filter.elc lisp/riece-foolproof.elc lisp/riece-globals.elc \
-lisp/riece-google.elc lisp/riece-guess.elc lisp/riece-handle.elc \
-lisp/riece-hangman.elc lisp/riece-highlight.elc lisp/riece-history.elc \
-lisp/riece-icon.elc lisp/riece-identity.elc lisp/riece-ignore.elc \
-lisp/riece-irc.elc lisp/riece-kakasi.elc lisp/riece-keepalive.elc \
-lisp/riece-keyword.elc lisp/riece-layout.elc lisp/riece-log.elc \
-lisp/riece-lsdb.elc lisp/riece-menu.elc lisp/riece-message.elc \
-lisp/riece-mini.elc lisp/riece-misc.elc lisp/riece-mode.elc \
-lisp/riece-naming.elc lisp/riece-options.elc \
-lisp/riece-package-info.elc lisp/riece-rdcc.elc lisp/riece-ruby.elc \
-lisp/riece-server.elc lisp/riece-shrink-buffer.elc \
-lisp/riece-signal.elc lisp/riece-toolbar.elc lisp/riece-unread.elc \
-lisp/riece-url.elc lisp/riece-user.elc lisp/riece-version.elc \
-lisp/riece-xemacs.elc lisp/riece-xface.elc lisp/riece-xfaceb.elc \
-lisp/riece-yank.elc
-
-EXTRA_SOURCES = lisp/riece-emacs.el lisp/riece-ndcc.el \
- lisp/riece-skk-kakutei.el lisp/riece-mcat.el \
- lisp/riece-mcat-japanese.el lisp/riece-package-info.el.in \
- lisp/url-riece.el
-AUTOLOAD_PATH = lisp
-
-EXPLICIT_DOCS = doc/riece-en.texi
-ifeq ($(BUILD_WITHOUT_MULE),)
-COMPILE_INFO_AS_MULE = t
-EXPLICIT_DOCS += doc/riece-ja.texi
-ELCS += lisp/riece-skk-kakutei.elc lisp/riece-mcat.elc \
- lisp/riece-mcat-japanese.elc
-endif
-
-PRELOADS = -eval \("push \"./lisp\" load-path"\)
-
-DATA_FILES = AUTHORS NEWS NEWS.ja README README.ja doc/HACKING doc/HACKING.ja
-DATA_DEST = $(PACKAGE)
-
-DATA_1_FILES = $(wildcard lisp/*.xpm)
-DATA_1_DEST = $(PACKAGE)
-
-DATA_2_FILES = $(wildcard lisp/*.rb)
-DATA_2_DEST = $(PACKAGE)
-
-include ../../XEmacs.rules
+++ /dev/null
-SUBDIRS = lisp doc
-EXTRA_DIST = INSTALL-CVS README.ja NEWS.ja
-AUTOMAKE_OPTIONS = no-dependencies
-
-if XEMACS
-install-package package:
- list='$(SUBDIRS)'; for subdir in $$list; do \
- (cd $$subdir && $(MAKE) $(AM_MAKEFLAGS) $@) \
- done
-endif
+++ /dev/null
-* Major changes in 3.1.2
-
-** Message catalog. (ueno)
-
-* Major changes in 3.1.1
-
-** riece-async works again. (ueno)
-
-** riece-shrink-buffer is now enabled by default. (ueno)
-
-** New window layout "spiral". (URABE Shyouhei)
-
-* Major changes in 3.1.0
-
-** Prevent reentrace of message handlers. This might fix some long
- standing bug in message handling. (ueno)
-
-** Removed dependency on the calc package from riece-ndcc.el. (ueno)
-
-** Fixed a bug in the 353 message handler. (ueno)
-
-* Major changes in 3.0.0
-
-** Changed the meaning of riece-username. If you set this option, you
- will need to set riece-realname instead. (ueno)
-
-** Cause an error if a user requests to close already closed server. (yoichi)
-
-** New add-on riece-epg.el, which enables secure conversation using
- GnuPG. (ueno)
-
-** Fixed a couple of bugs in inviting users. (Steve Youngs)
-
-** Fixed a redisplay bug when a user leaves a channel. (ueno)
-
-** Reverted the default value of riece-alias-alternate-separator to
- "@". (ueno)
-
-* Major changes in 2.0.2
-
-** Fixed C-c l (riece-command-list) behavior. It didn't display
- channel TOPIC correctly. (ueno)
-
-** Don't alter case of user/channel names when completing user
- input. (ueno)
-
-** Changed default value of alternate separator of a channel name and an
- IRC server name to "%". (ueno)
-
-* Major changes in 2.0.1
-
-** If there is a message in previously selected channel, Riece 2.0.0
- doesn't treat it as an unread channel. 2.0.1 fixes it. (ueno)
-
-** New add-on riece-xfaceb.el, which displays X-Face/Colour Face in
- IRC buffers. (Steve Youngs)
-
-* Major changes in 2.0.0
-
-** Support multiple coding-systems on a server.
- You can use different coding-systems for different channels. (ueno)
- For example:
- (setq riece-channel-coding-system-alist
- '(("#euc-jp" . euc-jp)
- ("#utf-8 irc.freenode.net" . utf-8)))
-
-** Support uninstall, unload (dangerous) operations for add-ons.
- Now you can fully customize riece-addons in the add-on listing
- mode. (ueno)
-
-** New mechanism for executing Ruby programs. To use it, see the
- commentary section of riece-ruby.el. (ueno)
-
-** New add-on riece-eval-ruby.el, which regards user input prefixed by
- ",ruby " as a Ruby program and sends the result to the current
- channel. (ueno)
-
-** New add-on riece-shrink-buffer.el, which now takes care of periodic
- buffer shrinking. If you have set riece-max-buffer-size, you will
- need to enable the riece-shrink-buffer add-on in the add-on listing
- mode. (ueno)
-
-** Don't signal an error when a user is quitting, and who has joined a
- channel where you left. (ueno)
-
-** When saving a log file, suffix the name of the coding-system used
- onto the filename. This will avoid mojibake even
- riece-log-coding-system is not set. (ueno)
-
-** While traversing channel list with C-c g, offer channels in order
- of precedence where they have newer unread messages. (ueno)
-
-** Allow "@" instead of " " as a separator of a channel name and an
- IRC server name. (ueno)
-
-** Rewrite the Japanese manual (riece-ja.texi) for IRC & Emacs
- newbies. (ueno)
-
-** Allow users to hide *Others* buffer. (ueno)
-
-** Use seperate buffer to store debugging output. (ueno)
-
-** Added new make rule for byte-compiling elisp files individually.
- To use it, after configure, do "make compile-individually" in
- lisp/. (ueno)
-
-** Include a document for developers (doc/HACKING{,.ja}) (ueno)
-
-* Major changes in 1.0.8
-
-** Mitigate file locking scheme of riece-log. (ueno)
-
-** Format idle seconds in human readable form. (ueno)
-
-** Separate riece-obarray into riece-channel-obarray and
- riece-user-obarray. (kaoru)
-
-** Fixed bugs caused by mishandling of channel names (which should be
- case insensitive.) (ueno)
-
-** Support SXEmacs version names. (Steve Youngs)
-
-** Support CTCP TIME. (Steve Youngs)
-
-** Ignore directories under ~/.riece/addons. (kaoru)
-
-** Fixed wrong-number-of-arguments error on riece-command-part. (yoichi)
-
-** Fixed a bug which assumes existence of ~/.riece/addons when
- startup. (ueno)
-
-* Major changes in 1.0.7
-
-** New add-on riece-toolbar. (ueno)
- riece-toolbar displays icons on toolbar. Currently not all the
- icons are included.
-
-** New add-on riece-keepalive. (ueno)
- riece-keepalive spontaneously sends a PING message to server to
- keep an IRC connection.
-
-** New add-on riece-google. (bg66)
- riece-google searches on Google and sends the result to the channel.
-
-** New add-on riece-eval. (bg66)
- riece-eval evaluates elisp expression and sends the result to the channel.
-
-** Some add-ons are enabled by default. (ueno)
- riece-log, riece-alias, riece-ctlseq, and riece-keyword are now
- enabled by default.
-
-** New command riece-command-suspend-resume. (ueno)
- riece-command-suspend-resume saves or restores the current window
- configuration.
-
-** Preserve cursor position when clicking button widget. (ueno)
-
-** Decorate modeline indicator with faces. (ueno)
-
-** Count users in NAMES reply. (ueno)
-
-** New user option riece-part-message. (ueno)
-
-** Add-ons located in riece-addon-directory are automatically enabled. (ueno)
-
-** Default value of riece-buffer-dispose-function is now kill-buffer. (ueno)
-
-** Backtrace when encountered an error in process-filter. (ueno)
-
-** Ask channel key to user when it is required. (ueno)
-
-** Automatic buffer shrinking is now disabled by default. (ueno)
-
-** New directory structure for riece-log. (ueno)
-
-** Fixed a bug in user-renamed signal-filter. (kaoru)
-
-** Fixed a bug in riece-command-enable-addon and
- riece-command-disable-addon. (yoichi)
-
-* Major changes in 1.0.6
-
-** Bundle url-riece, a backend of url-irc which comes with the recent
- GNU Emacs. (Yamato-san)
-
-** New user option riece-url-regexp-alist to allow users to define
- mapping from arbitrary strings (such as "Bug#12345") to URL. (This
- feature is a backport from Liece) (ueno)
-
-** New modeline indicator which represents user's channel operator
- status in the current channel. (ueno, thanks to k-to)
-
-** Remove multiple lines at a time when shrinking channel buffers.
- Number of lines to be removed is controlled by
- riece-shrink-buffer-remove-lines option. (ueno, thanks to ysjj)
-
-** riece-alias-alist now works again. (ueno)
-
-** Fixed a bug in flow control for sending long messages, introduced
- in 1.0.4. (ueno)
-
-** New command riece-submit-bug-report to generate a template for good
- problem report. (ueno)
-
-** Accept radical IRC proxy programs which break with tradition of the
- original IRC server implementation. (ueno, thanks to k-to san)
-
-** New key bind C-c # <number> to switch channel by number. (ueno,
- thanks to ysjj)
-
-** If a prefix-argument is given, riece-yank sends message as a NOTICE. (bg66)
-
-* Major changes in 1.0.5
-
-** Added some test cases. (ueno)
-
-** Alternate separator string for channel names. (ueno)
- In case riece-alias-alternate-separator set to "@", rewriting will
- be done as follows:
-
- "#riece" -> "#riece"
- "#riece localhost" -> "#riece@localhost"
- "#ch@nnel" -> "#ch@@nnel"
- "#ch@nnel localhost" -> "#ch@@nnel@localhost"
-
-** Fixed interop bug in DCC. (ueno)
-
-** New add-on riece-yank to send strings from kill-ring. (by Yamato-san)
-
-** English translation of texinfo document is included. (ueno)
-
-* Major changes in 1.0.4
-
-** Do "flow control" to avoid flooding. (ueno)
-
-** Automatically open servers when joining channels at startup. Users
- can now omit riece-startup-server-list settings. (ueno)
-
-** riece-mini provides a command to browse recent messages. (bg66)
-
-* Major changes in 1.0.3
-
-NOTE: This release includes some fixes to long standing bugs in essential features. I recommend to upgrade from the older versions.
-
-** Remove nonexistent users from user list. (Thanks to Yamashita-san)
-
-** Improved line truncation customizability. Users can now control it
- by simply setting truncate-lines on each buffer. (Thanks to
- Yamashita-san)
-
-** Added new user option riece-window-center-line to control buffer
- scrolling behavior.
-
-** Fixed completion bug in command buffer. (Thanks to Yamashita-san)
-
-** Remove chat partner from channel list when he/she resigned from
- IRC. (Thanks to Morimoto-san)
-
-** Exit immediately after an error occurred in connecting to the
- default IRC server. (Thanks to k-to san)
-
-* Major changes in 1.0.2
-
-** Fixed problem hiding menubar menus when riece-url is enabled.
-
-** Split IRC protocol interface from the core modules.
-
-** Fixed minor bugs.
-
-* Major changes in 1.0.1
-
-** Arranged background colors of modeline faces (for XEmacs)
-
-** When changing channel modes, do not prepend ":" to MODE message
- (Thanks to Yamada-san)
-
-** Added riece-foolproof add-on which prevents miss posting to
- channels (by Takahashi-san)
-
-** Arranged the order of modeline elements on channel buffers (by
- Takahashi-san)
-
-** Changed open/close bracket for displaying own notices (by Takahashi-san)
-
-** Don't register signal-slot functions duplicatedly.
-
-** New user command riece-command-beginning-of-buffer bound to C-c Home.
-
-** For frozen channels, preserve cursor position of channel buffers
- while zapping between other channels.
-
-** Follow the change in emacs-cvs, check the return value of
- current-word (by Nakayama-san)
-
-** Fixed random number generation logic for riece-hangman (by Takahashi-san)
-
-** Signal "No text to send" error if user types C-c p on an empty line.
-
-** New user option riece-startup-ignored-user-list: which can be used
- to set up riece-ignored-user-list in ~/.riece/init.el.
-
-** Allow sending/receiving files whose names contain whitespaces.
-
-* Major changes in 1.0.0
-
-** New UI for enabling/disabling add-ons (to enter this mode, C-c ^)
-
-** Fixed bug that a user couldn't quit password input with C-g.
-
-** New add-on "riece-hangman" which allows channel members to play hangman(6).
-
-** Display error message on C-c q when no IRC process are running.
-
-** New add-on "riece-ignore" which allows to ignore messages from
- particular users.
-
-** Accept nicknames consisting more than 9 letters.
-
-** Avoid duplicate initialization of add-ons.
-
-** New add-on "riece-biff" which displays biff mark ("[R]") on
- mode-line. (by Ohashi-san)
-
-** New add-on "riece-kakasi" which converts Japanese to roman string.
-
-** Fixed prompt strings to indicate the current action more
- precisely. (suggested by Yamashita-san)
-
-* Major changes in 0.2.2
-
-** Interpret control sequences used in IRC such as ^B, ^V, ^_, etc.
- This feature is implemented as an add-on called riece-ctlseq.
-
-** Fixed bug that private messages were not treated as unread.
-
-** Buffer "freeze" status can be toggled in each buffer respectively.
- (use C-t C-f)
-
-** Use canonicalized channel names to locate directories where log
- files are stored. (by Ohashi-san)
-
-* Major changes in 0.2.0
-
-** Introduced "signal-slot" (as in Qt, GTK+) mechanism to routing
- display events.
-
-** When a user requests NAMES, insert nicknames into the channel buffer.
-
-** Fixed bug in riece-lsdb. (by Nakayama-san)
-
-* Major changes in 0.1.8
-
-** Added riece-lsdb add-on which cooperates with LSDB.
-** Added riece-xface add-on which displays X-Faces in user list buffer.
-
-** Fixed bug that channel names were treated case sensitively.
-
-** Handle messages from other clients which use the same IRC proxy.
- (by Takahashi-san)
-
-* Major changes in 0.1.7
-
-** Added riece-async add-on which provides safe connection to an IRC
- server via local proxy which responds to PING requests while Emacs
- is busy or suspended.
-
-** Fixed changing user away status bug when riece-away-message is set.
- (Thanks to Fujimura-san)
-
-** Remove side effects on standard-syntax-table when loading.
- (Thanks to Hori-san)
-
-** Can join channels on several servers at startup by setting
- riece-startup-server-list as well as riece-startup-channel-list.
-
-** New user option `riece-log-coding-system' to specify default coding
- system used for log files.
-
-** New user option `riece-keyword-notify-functions' called when
- someone spoke a message including the specified keyword. Please use
- it instead of `riece-notify-keyword-functions'(very confusing
- name!).
-
-** riece-log-flashback also restores faces and buttons.
-
-** riece-{unread,mini} ignores NOTICE and CTCP ACTION messages.
-
-* Major changes in 0.1.6
-
-** Fixed running problems on Emacs 20.7.
-
-** Fixed compilation failure on XEmacs 21.1.
-
-** Allow riece-rdcc to receive large files without memory consumption.
-
-** Check channel modes when joinning if riece-gather-channel-modes == t.
-
-** Fixed run-idle-timer usage to shrink channel buffers.
-
-** Fixed buffer scrolling behavior when switching channels.
-
-** Allow to specify qualified channel names in
- riece-log-directory-map. (by Ohashi-san)
-
-* Major changes in 0.1.5
-
-** Added 6 new window layouts.
-
-** Automatically save/restore the current window layout.
-
-** Added riece-icon add-on which decorates buffers with icons.
-
-** Speedup in redrawing the user list buffer.
-
-** Improve usability of CTCP ACTION (Thanks to knu-san)
-
-** Fixed bug in riece-rdcc which causes freeze on DCC SEND.
-
-** When riece server was opened, Do riece-command-configure-windows
- instead of signaling. (Thanks to Ohashi-san)
-
-** Fixed bug in C-c o (riece-command-set-operators) and C-c v
- (riece-command-set-speakers).
-
-** Shrink buffers when they exceeds riece-max-buffer-size.
-
-* Major changes in 0.1.4
-
-** Bind "N" instead of "\C-n" to riece-command-names in channel
- buffers. (thanks to Takahashi-san)
-
-** Fixed bug causing an error when the user typed C-c C-t a
- (riece-command-toggle-away). (thanks to Maeda-san)
-
-** Don't redisplay buffers when the current selected window doesn't
- display Riece buffers.
-
-** Don't reuse buffers created by different programs. Genereate new
- buffer in such case.
-
-** Fixed bug which doesn't allow to join a channel whose name is
- beginning with "!!".
-
-** When riece-keyword is effective, don't check if the message from
- myself contains given keywords.
-
-** Signal an error when the user issues a command which assumes the
- current channel though the current channel is not available.
-
-** Added riece-menu add-on which adds a menu entry in the menubar.
-
-* Major changes in 0.1.3
-
-** Treat channel names in PRIVMSG/NOTICE messages case-insensitively.
-
-** When riece-history is effective, mark the last visited channel with "+".
-
-** Added riece-button add-on which decorates buffers with buttons and
- define some popup-menus.
-
-** Added riece-keyword add-on which notifies the user when the arrived
- message contains given keywords.
-
- If you are using XEmacs and want to be notified of keywords with
- sound, add the following lines to your ~/.riece/init.el:
-
- (load-default-sounds)
- (setq riece-keywords '("foo" "bar"))
- (add-hook 'riece-notify-keyword-functions
- (lambda (keyword) (play-sound 'cuckoo)))
-
-* Major changes in 0.1.2
-
-** Fixed bug when joinning a channel using a key.
-
-** Revive riece-startup-channel-list.
-
-** New user option riece-rdcc-save-directory is added.
-
-** Fixed unable to interrupt password input.
-
-** Fixed bug in the INVITE handler.
-
-** Prompt a channel name when the user joins the invited channel.
-
-** Fixed bug that occasionally kept riece-channel-list-indicator not
- up to date.
-
-* Major changes in 0.1.1
-
-** Load some add-ons by default.
-
-** Fixed bug with riece-default-channel-binding not working.
-
-** Mark the current channel with "*" in *Channels* buffer.
-
-** If riece-debug is turned off, don't report connection status when exiting.
-
-** New add-on: riece-history manages channel switching history.
-
-** New add-on: riece-guess offers the next channel user may want to check.
-
- Tips:
-
- If you have the following lines in ~/.riece/init.el:
-
- (setq riece-guess-channel-try-functions
- '(riece-guess-channel-from-unread
- riece-guess-channel-from-history))
-
- By hitting `C-c g' repeatedly, you can check channels in the
- following order:
-
- 1. Channels where there is unread message.
- 2. Channels where you have visited recently.
- 3. The rest.
-
-* Major changes in 0.1.0
-
-** Use vectors to represent channels and users.
-
-** Improve process management:
- -- Server names are now embedded in process names.
- -- Integrate scattered connection management code into riece-server.el.
- -- Force disconnect if the server does not respond after sending QUIT.
-
-** New add-on: riece-doctor.el allows to pretended to be a doctor.
-
-** Window configuration can be easily switched by hitting C-c t l.
-
-** New add-on: riece-skk-kakutei.el avoids \e$B"&\e(B being included in
- spoken text, when you are using SKK. (by Takahashi-san)
-
-** New predefined layout which emulates "top" window-style as in Liece.
- (by Takahashi-san)
-
-* Major changes in 0.0.4
-
-** Added riece-mini add-on which allows conversation through a
- minibuffer (by Ohashi-san).
-
-** Added log collector add-on (riece-log) (by Ohashi-san).
-
-** riece-command-next-channel (C-c >) and
- riece-command-previous-channel (C-c <) now follow the channel list
- circularly (by Nakayama-san).
-
-** When riece-unread is enabled, you can quickly check the unread
- channels by hitting C-c C-u (by Ohashi-san).
-
-** Display of status indicators obeys some IRC messages.
-
-** Replaced ptexinfmt.el with the version which does not depend on
- APEL (Thanks to Yamaoka-san).
-
-* Major changes in 0.0.3
-
-** Fix bug connecting to two servers which require passwords (Thanks
- to Nakayama-san)
-
-** Fix inconsistency when changing case of letters in nickname
-
-** Catch all errors occured in handler hooks
-
-** Support DCC file transfer (riece-ndcc.el, riece-rdcc.el)
-
-** Add "mark unread channels" add-on (riece-unread.el)
-
-** Add Japanese texinfo manual (I'll translate it in the future)
-
-* Major changes in 0.0.2
-
-** Don't use APEL functions (pop, push)
-
-** "depcomp" was missing in the previous archive (sorry!)
-
-** Fix bug building on Windows environment (Thanks to Ohashi-san)
-
-** Fix inconsistency when changing nickname
-
-** Fix bug on C-c C-t u (M-x riece-command-toggle-user-list-mode)
-
-** Provide add-on mechanism
-
-** Partial support for CTCP
-
-** Make font-lock related module (riece-highlight) add-on
-
-** Revive URL collector (formerly liece-url) as add-on
-
-* Major changes in 0.0.1
-
-** Initial release.
-
-* For details of changes, see the file ChangeLog.
-\f
-Local variables:
-mode: text
-mode: outline
-paragraph-separate: "[ \f]*$"
-end:
+++ /dev/null
-* Riece 3.1.1 \e$B$N<g$JJQ99E@\e(B
-
-** riece-async \e$B$r:F$SF0:n$9$k$h$&$K$7$?\e(B (ueno)
-
-** riece-shrink-buffer \e$B$r%G%U%)%k%H$GM-8z$K$7$?\e(B (ueno)
-
-** \e$B?75,%&%#%s%I%&%l%$%"%&%H\e(B "spiral" \e$B$rDI2C\e(B (URABE Shyouhei)
-
-* Riece 3.1.0 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%a%C%;!<%8%O%s%I%i$N:FF~6X;_$K$7$?\e(B (ueno)
-
-** riece-ndcc.el \e$B$,\e(B calc \e$B$K0MB8$7$J$$$h$&$K$7$?\e(B (ueno)
-
-** 353 \e$B%O%s%I%i$N%P%0$N=$@5\e(B (ueno)
-
-* Riece 3.0.0 \e$B$N<g$JJQ99E@\e(B
-
-** \e$BJQ?t\e(B riece-username \e$B$N0UL#$rJQ99\e(B (ueno)
- \e$B$3$NJQ?t$r@_Dj$7$F$$$k%f!<%6$O!"\e(Briece-realname \e$B$KJQ?tL>$rJQ99$9$kI,\e(B
- \e$BMW$,$"$k!#\e(B
-
-** \e$B@ZCG:Q$_$N%5!<%P$r:FEY@ZCG$7$h$&$H$7$?>l9g$K!"%(%i!<$K$J$k$h$&$K$7\e(B
- \e$B$?\e(B (yoichi)
-
-** \e$B?75,%"%I%*%s\e(B riece-epg.el \e$B$rF3F~!#\e(BGnuPG \e$B$r;H$C$?0BA4$J2qOC$,2DG=\e(B (ueno)
-
-** \e$B%f!<%6$r>7BT\e(B (invite) \e$B$9$k:]$N%P%0$r\e(B 2 \e$B$D=$@5\e(B (Steve Youngs)
-
-** \e$B%f!<%6$,%A%c%s%M%k$rN%C&$7$?>lLL$G$N!":FIA2h$N%P%0$r=$@5\e(B (ueno)
-
-** riece-alias-alternate-separator \e$B$N%G%U%)%k%HCM$r\e(B "@" \e$B$KLa$7$?\e(B (ueno)
-
-* Riece 2.0.2 \e$B$N<g$JJQ99E@\e(B
-
-** C-c l (riece-command-list) \e$B$G!"%A%c%s%M%k$N%H%T%C%/$NBe$o$j$K;22C<T\e(B
- \e$B?t$,I=<($5$l$k%P%0$r=$@5\e(B (ueno)
-
-** \e$B%K%C%/%M!<%`$d%A%c%s%M%kL>$NJd408uJd$NI=<($GBgJ8;z>.J8;z$rJ]B8$9$k\e(B
- \e$B$h$&$K$7$?\e(B (ueno)
-
-** \e$B%A%c%s%M%kL>$H%5!<%PL>$N6h@Z$jJ8;zNs$N%G%U%)%k%HCM$r\e(B "@" \e$B$+$i\e(B "%"
- \e$B$KJQ99\e(B (ueno)
-
-* Riece 2.0.1 \e$B$N<g$JJQ99E@\e(B
-
-** \e$BD>A0$KA*Br$7$F$$$?%A%c%s%M%k$KL$FI%a%C%;!<%8$,$"$k>l9g$K\e(B unread \e$B%^!<\e(B
- \e$B%/$,I=<($5$l$J$$IT6q9g$N=$@5\e(B (ueno)
-
-** \e$B?75,%"%I%*%s\e(B riece-xfaceb.el \e$B$rF3F~!#\e(BBBDB \e$B$+$i\e(B X-Face/Face \e$B$r8!:w$7!"\e(B
- \e$B%f!<%60lMw$KI=<($9$k\e(B (Steve Youngs)
-
-* Riece 2.0.0 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%A%c%s%M%kKh$K%(%s%3!<%G%#%s%0$r;XDj$G$-$k$h$&$K$7$?\e(B (ueno)
- \e$B@_DjNc!'\e(B
- (setq riece-channel-coding-system-alist
- '(("#euc-jp" . euc-jp)
- ("#utf-8 irc.freenode.net" . utf-8)))
-
-** \e$B%"%I%*%s$N\e(B uninstall, unload (\e$B4m81\e(B) \e$B$KBP1~!#\e(B
- \e$B%"%I%*%s0lMw%b!<%I$G\e(B riece-addons \e$B$N%+%9%?%^%$%:$,2DG=\e(B (ueno)
-
-** Ruby \e$B$N%W%m%0%i%`$rI>2A$9$k5!9=$NF3F~!#\e(B
- \e$BMxMQJ}K!$O\e(B riece-ruby.el \e$BKAF,$N%3%a%s%H$r;2>H\e(B (ueno)
-
-** \e$B?75,%"%I%*%s\e(B riece-eval-ruby.el \e$B$rF3F~!#\e(B",ruby " \e$B$KB3$$$FG$0U$N\e(B
- Ruby \e$B$N%W%m%0%i%`$rH/8@$9$k$H!"I>2A7k2L$r%A%c%s%M%k$KAw?.$9$k\e(B (ueno)
-
-** \e$BDj4|E*$K%P%C%U%!$r@Z$j5M$a$k5!G=$r%"%I%*%s$KJ,N%\e(B
- \e$B$3$l$^$G\e(B riece-max-buffer-size \e$B$r@_Dj$7$F$$$??M$O!"\e(B
- riece-shrink-buffer \e$B%"%I%*%s$rM-8z$K$9$kI,MW$,$"$k$N$GCm0U\e(B (ueno)
-
-** \e$BN%C&$7$?%A%c%s%M%k$K;22C$7$F$$$?%f!<%6$,\e(B IRC \e$B$r$d$a$?>l9g$K!"%(%i!<\e(B
- \e$B$,H/@8$9$kIT6q9g$N=$@5\e(B (ueno)
-
-** \e$B%m%0$NJ]B8;~$K!";HMQ$7$?\e(B coding-system \e$B$NL>A0$r%U%!%$%kL>$KKd$a9~$`\e(B
- \e$B$h$&$K$7$?!#$3$l$K$h$j\e(B riece-log-coding-system \e$B$r@_Dj$7$J$/$F$bJ8;z\e(B
- \e$B2=$1$,H/@8$7$K$/$/$J$C$?\e(B (ueno)
-
-** C-c g \e$B$G%A%c%s%M%k$r0\F0$9$k:]$K!"?7$7$$H/8@$,$"$C$?%A%c%s%M%k$+$i\e(B
- \e$BC)$k$h$&$K$7$?\e(B (ueno)
-
-** \e$B%A%c%s%M%kL>$H%5!<%PL>$N6h@Z$jJ8;zNs$H$7$F\e(B " " \e$B0J30$K\e(B "@" \e$B$b5v$9$h\e(B
- \e$B$&$K$7$?\e(B (ueno)
-
-** \e$BF|K\8l%^%K%e%"%k\e(B (riece-ja.texi) \e$B$r=i?4<T$rBP>]$K=q$-D>$7$?\e(B (ueno)
-
-** *Others* \e$B%P%C%U%!$r1#$;$k$h$&$K$7$?\e(B (ueno)
-
-** \e$B%G%P%C%0=PNO$r@lMQ$N%P%C%U%!$KJ,N%\e(B (ueno)
-
-** elisp \e$B%U%!%$%k$r#1$D$:$D\e(B byte-compile \e$B$9$k\e(B make \e$B%k!<%k$r@_$1$?!#\e(B
- configure \e$B8e!"\e(Blisp/ \e$B0J2<$G\e(B make compile-individually (ueno)
-
-** \e$B3+H/<T8~$1$NJ8=q\e(B (doc/HACKING{,.ja}) \e$B$rF1:-\e(B (ueno)
-
-* Riece 1.0.8 \e$B$N<g$JJQ99E@\e(B
-
-** riece-log \e$B$N%m%C%/$N4KOB\e(B (ueno)
-
-** RPL_WHOISIDLE \e$B$NIC?t$rF|;~J,IC7A<0$GI=<(\e(B (ueno)
-
-** riece-obarray \e$B$r\e(B riece-channel-obarray, riece-user-obarray \e$B$KJ,N%\e(B
- (kaoru)
-
-** \e$B$$$/$D$+$N8D=j$G%A%c%s%M%kL>$NBgJ8;z>.J8;z$,6hJL$5$l$k%P%0$X$NBP1~\e(B (ueno)
-
-** SXEmacs \e$B$N%P!<%8%g%sI=5-$KBP1~\e(B (Steve Youngs)
-
-** CTCP TIME \e$B$KBP1~\e(B (Steve Youngs)
-
-** ~/.riece/addons \e$B0J2<$N%G%#%l%/%H%j$rFI$_9~$^$J$$$h$&$K$7$?\e(B (kaoru)
-
-** riece-command-part \e$B$,%(%i!<$K$J$k%P%0$N=$@5\e(B (yoichi)
-
-** ~/.riece/addons \e$B%G%#%l%/%H%j$,$J$$$H5/F0;~$K%(%i!<$K$J$k%P%0$N=$@5\e(B (ueno)
-
-* Riece 1.0.7 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B?75,%"%I%*%s\e(B riece-toolbar (ueno)
- riece-toolbar \e$B$O%D!<%k%P!<$K%"%$%3%s$rI=<($7$^$9!#8=;~E@$G$OA4$F$N\e(B
- \e$B%"%$%3%s$,4^$^$l$F$$$k$o$1$G$O$"$j$^$;$s!#\e(B
-
-** \e$B?75,%"%I%*%s\e(B riece-keepalive (ueno)
- riece-keepalive \e$B$O<+H/E*$K%5!<%P$K\e(B PING \e$B%a%C%;!<%8$rAw$k$3$H$G\e(B IRC
- \e$B$N%3%M%/%7%g%s$r;}B3$5$;$^$9!#\e(B
-
-** \e$B?75,%"%I%*%s\e(B riece-google (bg66)
- riece-google \e$B$O\e(B Google \e$B$G$N8!:w7k2L$r%A%c%s%M%k$KAw$j$^$9!#\e(B
-
-** \e$B?75,%"%I%*%s\e(B riece-eval (bg66)
- riece-eval \e$B$O\e(B elisp \e$B$N<0$NI>2A7k2L$r%A%c%s%M%k$KAw$j$^$9!#\e(B
-
-** \e$B$$$/$D$+$N%"%I%*%s$r%G%U%)%k%H$GM-8z2=\e(B (ueno)
- riece-log, riece-alias, riece-ctlseq, riece-keyword \e$B$,:#2s$+$i%G%U%)\e(B
- \e$B%k%H$GM-8z$K$J$j$^$9!#\e(B
-
-** \e$B?75,%3%^%s%I\e(B riece-command-suspend-resume (ueno)
- riece-command-suspend-resume \e$B$O8=:_$N%&%#%s%I%&9=@.$rJ]B8!&:F8=$7$^$9!#\e(B
-
-** \e$B%\%?%s%&%#%8%'%C%H%/%j%C%/;~$N%+!<%=%k0\F0$NM^;_\e(B (ueno)
-
-** \e$B%b!<%I%i%$%s$N%$%s%8%1!<%?$r\e(B face \e$B$GAu>~\e(B (ueno)
-
-** NAMES \e$B%j%W%i%$$K4^$^$l$k%f!<%6?t$r?t$($k$h$&$K$J$j$^$7$?\e(B (ueno)
-
-** \e$B?75,%f!<%6%*%W%7%g%s\e(B riece-part-message (ueno)
-
-** riece-addon-directory \e$B0J2<$KCV$+$l$?%"%I%*%s$r<+F0E*$KM-8z2=\e(B (ueno)
-
-** riece-buffer-dispose-function \e$B$N%G%U%)%k%HCM$,:#2s$+$i\e(B kill-buffer
- \e$B$K$J$j$^$7$?\e(B (ueno)
-
-** process-filter \e$BFb$G%(%i!<$,H/@8$7$?>l9g!"\e(Bbacktrace \e$B$r9T$J$&$h$&$K$J\e(B
- \e$B$j$^$7$?\e(B (ueno)
-
-** \e$BI,MW$K1~$8$F%A%c%s%M%k%-!<$rLd$$9g$o$;$k$h$&$K$7$^$7$?\e(B (ueno)
-
-** \e$B%P%C%U%!$N<+F0E*$J@Z$j5M$a$r%G%U%)%k%H$G$OL58z2=\e(B (ueno)
-
-** riece-log \e$B$N$?$a$N?7$7$$%G%#%l%/%H%j9=@.\e(B (ueno)
-
-** user-renamed signal-filter \e$B$N%P%0$r=$@5\e(B (kaoru)
-
-** riece-command-enable-addon \e$B$H\e(B riece-command-disable-addon \e$B$N%P%0$N\e(B
- \e$B=$@5\e(B (yoichi)
-
-* Riece 1.0.6 \e$B$N<g$JJQ99E@\e(B
-
-** CVS \e$BHG\e(B GNU Emacs \e$B$KF1:-$5$l$?\e(B url \e$B%Q%C%1!<%8$N\e(B irc: \e$B%9%-!<%^BP1~$N\e(B
- \e$B%P%C%/%(%s%I$H$7$F\e(B Riece \e$B$r;HMQ$G$-$k$h$&$K$9$k%W%m%0%i%`\e(B url-riece \e$B$r\e(B
- \e$BF1:-\e(B (\e$BBgOB$5$s\e(B)
-
-** "Bug#12345" \e$B$N$h$&$JJ8;zNs$r\e(B URL \e$B$K%^%C%W$9$k%*%W%7%g%s\e(B
- riece-url-regexp-alist \e$B$r?7@_\e(B (Liece \e$B$+$i%P%C%/%]!<%H\e(B) (ueno)
-
-** \e$B%b!<%I%i%$%s$K<+?H$N%A%c%s%M%k%*%Z%l!<%?$N0u\e(B(@, +)\e$B$rI=<($9$k$h$&$K\e(B
- \e$B$7$?\e(B (ueno, thanks to k-to \e$B$5$s\e(B)
-
-** \e$B%P%C%U%!$r@Z$j5M$a$k:]$K!"0l9T$:$D$G$O$J$/J#?t9T0lEY$K:o=|$9$k$h$&\e(B
- \e$B$K$7$?\e(B (riece-shrink-buffer-remove-lines \e$B%*%W%7%g%s$G@_Dj2DG=\e(B) (ueno,
- thanks to ysjj \e$B$5$s\e(B)
-
-** riece-alias-alist \e$B$,>e<j$/F0$$$F$$$J$+$C$?IT6q9g$N=$@5\e(B (ueno)
-
-** 1.0.4 \e$B0J9_!"\e(BGNU Emacs \e$B$G!"%a%C%;!<%8Aw?.;~$N%U%m!<@)8f$,>e<j$/F0$$\e(B
- \e$B$F$$$J$+$C$?IT6q9g$N=$@5\e(B (ueno)
-
-** \e$B%P%0Js9pMQ$N%3%^%s%I\e(B riece-submit-bug-report \e$B$r?7@_\e(B (ueno)
-
-** nadoka \e$B$d\e(B Tiarra \e$B$J$I$N\e(B IRC proxy \e$B$,!"\e(BIRC \e$B%5!<%P<BAu$NEAE}$K1h$o$J\e(B
- \e$B$$%a%C%;!<%8$rJV$9$3$H$X$NBP=h\e(B (ueno, thanks to k-to \e$B$5$s\e(B)
-
-** C-c # \e$B?t;z$G;XDj$7$?HV9f$N%A%c%s%M%k$K0\F0$G$-$k$h$&$K$7$?\e(B (ueno,
- thanks to ysjj \e$B$5$s\e(B)
-
-** riece-yank \e$B$G!"A0CV0z?t$r;XDj$9$k$3$H$K$h$j!"%a%C%;!<%8$r\e(B NOTICE \e$B$H\e(B
- \e$B$7$FAw?.$G$-$k$h$&$K$7$?\e(B (bg66)
-
-* Riece 1.0.5 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%f%K%C%H%F%9%H$rDI2C!#\e(B(ueno)
-
-** \e$BJ#?t%5!<%P@\B3;~$K!"%A%c%s%M%kL>$H%5!<%PL>$N6h@Z$j$K6uGr0J30$NJ8;z\e(B
- \e$BNs$r;H$($k$h$&$K$7$?!#\e(B(ueno)
-
- riece-alias-alternate-separator == "@" \e$B$N;~$NJQ495,B'$O0J2<$NDL$j!'\e(B
-
- "#riece" -> "#riece"
- "#riece localhost" -> "#riece@localhost"
- "#ch@nnel" -> "#ch@@nnel"
- "#ch@nnel localhost" -> "#ch@@nnel@localhost"
-
-** DCC \e$B$,B>$N%/%i%$%"%s%H$H$N4V$G$&$^$/F0$+$J$$IT6q9g$N=$@5!#\e(B(ueno)
-
-** kill-ring \e$B$+$iJ8;zNs$rAw?.$9$k%"%I%*%s\e(B riece-yank \e$B$rDI2C!#\e(B(by \e$BBgOB$5$s\e(B)
-
-** \e$B1Q8l$NJ8=q$rDI2C!#\e(B(ueno)
-
-* Riece 1.0.4 \e$B$N<g$JJQ99E@\e(B
-
-** \e$BBgNL$N%a%C%;!<%8$rAw$k>l9g$K!"%U%m!<@)8f$r9T$&$h$&$K$7$?!#\e(B(ueno)
-
-** \e$B5/F0;~$KJ#?t%5!<%P>e$N%A%c%s%M%k$K;22C$9$k@_Dj$G!"\e(B
- riece-startup-server-list \e$B$N@_Dj$r>JN,2DG=$K$7$?!#\e(B(ueno)
-
-** riece-mini \e$B;HMQ;~$K2a5n$N%a%C%;!<%8$r1\Mw$9$k5!G=$r@_$1$?!#\e(B(bg66)
-
-* Riece 1.0.3 \e$B$N<g$JJQ99E@\e(B
-
-** NAMES \e$BH/9T;~$K!V$$$J$$$O$:$N%f!<%6!W$r%f!<%60lMw$+$i=|30$9$k$h$&$K\e(B
- \e$B$7$?\e(B (Thanks to \e$B;32<$5$s\e(B)
-
-** \e$B9T$N@^$jJV$7$r3F%P%C%U%!$N\e(B truncate-lines \e$B$NCM$G%+%9%?%^%$%:$G$-$k\e(B
- \e$B$h$&$K$7$?\e(B(Thanks to \e$B;32<$5$s\e(B)
-
-** \e$B%A%c%s%M%k%P%C%U%!$N%9%/%m!<%kF0:n$r@)8f$9$k%*%W%7%g%s\e(B
- riece-window-center-line \e$B$rDI2C\e(B
-
-** \e$B%3%^%s%I%P%C%U%!$G$NJd40$NIT6q9g$r=$@5\e(B (Thanks to \e$B;32<$5$s\e(B)
-
-** \e$B0lBP0l$N2qOC$G!"Aj<j$,\e(B quit \e$B$7$?>l9g!"%A%c%s%M%k0lMw$+$i=|30$9$k$h\e(B
- \e$B$&$K$7$?\e(B (Thanks to \e$B?9K\$5$s\e(B)
-
-** \e$B%G%U%)%k%H$N\e(B IRC \e$B%5!<%P$X$N@\B3;~$K%(%i!<$,=P$?>l9g$K$O!"B(:B$K=*N;\e(B
- \e$B$9$k$h$&$K$7$?\e(B(Thanks to k-to \e$B$5$s\e(B)
-
-* Riece 1.0.2 \e$B$N<g$JJQ99E@\e(B
-
-** riece-url \e$B;HMQ;~$K%a%K%e!<%P!<$N%a%K%e!<$,GK2u$5$l$kIT6q9g$N=$@5\e(B
-
-** Jabber \e$BBP1~$K8~$1!"%W%m%H%3%k%$%s%?!<%U%'!<%9$rJ,$1$?\e(B
-
-** \e$B$=$NB>!";(B?$J=$@5\e(B
-
-* Riece 1.0.1 \e$B$N<g$JJQ99E@\e(B
-
-** XEmacs \e$B$G!"%b!<%I%i%$%s$KI=<($5$l$k%A%c%s%M%k$NGX7J?'$r%b!<%I%i%$%s\e(B
- \e$B$N?'$K$"$o$;$?\e(B
-
-** \e$B%A%c%s%M%k$N%b!<%IJQ99;~$K!"%b!<%I;XDj$N@hF,$K\e(B ":" \e$B$rIU$1$FAw$C$F$$\e(B
- \e$B$?IT6q9g$N=$@5\e(B
- (Thanks to \e$B$d$^$@$5$s\e(B)
-
-** \e$B%A%c%s%M%k%_%9$rKI$0%"%I%*%s\e(B riece-foolproof \e$B$rDI2C\e(B (by \e$B9b66$5$s\e(B)
-
-** \e$B%A%c%s%M%k%P%C%U%!$N%b!<%I%i%$%s$KI=<($5$l$kMWAG$N=gHV$rJQ99\e(B (by \e$B9b66$5$s\e(B)
-
-** NOTICE \e$B$GH/8@$7$?;~$NI=<($rJQ99\e(B (by \e$B9b66$5$s\e(B)
-
-** \e$B:F5/F0;~$K%7%0%J%k4X?t$rFs=E$KEPO?$7$F$$$?IT6q9g$N=$@5\e(B
-
-** C-c Home \e$B$G%A%c%s%M%k%P%C%U%!$N@hF,$K%+!<%=%k$r0\F0$9$k%3%^%s%I$rDI2C\e(B
-
-** \e$B%U%j!<%:>uBV$N%A%c%s%M%k$G$O!"%A%c%s%M%k$r0\F0$7$F$b%A%c%s%M%k%P%C\e(B
- \e$B%U%!$N%+!<%=%k0LCV$rJ]$D$h$&$K$7$?\e(B
-
-** CVS \e$BHG$N\e(B Emacs \e$B$G!"0z?t$J$7$N\e(B current-word \e$B$,\e(B nil \e$B$rJV$9$h$&$K$J$C$?$?$a!"\e(B
- riece-command-complete-user \e$B$,%(%i!<$K$J$kIT6q9g$N=$@5\e(B (by \e$BCf;3$5$s\e(B)
-
-** riece-hangman \e$B$NMp?tH/@8%m%8%C%/$N=$@5\e(B (by \e$B9b66$5$s\e(B)
-
-** \e$B6u9T$N>e$G!"\e(BC-c p \e$B$G%a%C%;!<%8$rAw$m$&$H$7$?>l9g!"%(%i!<$rDLCN$9$k\e(B
- \e$B$h$&$K$7$?\e(B
-
-** riece-ignore \e$B;HMQ;~$K!"@_Dj%U%!%$%k$GL5;k$9$k%f!<%6$r;XDj$G$-$k$h$&!"\e(B
- \e$B%*%W%7%g%s\e(B riece-startup-ignored-user-list \e$B$r?7@_\e(B
-
-** riece-rdcc \e$B;HMQ;~$K!"%U%!%$%kL>$K6uGr$,F~$C$?%U%!%$%k$rAw<u?.$G$-$k\e(B
- \e$B$h$&$K$7$?\e(B
-
-* Riece 1.0.0 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%"%I%*%s$N0lMwI=<(%b!<%I$rDI2C$7!"<B9T;~$K%"%I%*%s$rM-8z2=!&L58z2=\e(B
- \e$B$G$-$k$h$&$K$7$?\e(B (C-c ^)
-
-** GNU Emacs \e$B$G!"%Q%9%o!<%IF~NOCf$K\e(B Quit (C-g) \e$B$G$-$J$$IT6q9g$N=$@5\e(B
-
-** \e$B%A%c%s%M%kFb$G\e(B hangman(6) \e$B$GM7$V%"%I%*%s\e(B riece-hangman \e$B$rDI2C\e(B
-
-** \e$B%W%m%;%9$,0l$D$b$J$$>l9g$K\e(B C-c q \e$B$7$?>l9g$N%a%C%;!<%8$rJQ99\e(B
-
-** \e$B%f!<%6$rL5;k$9$k%"%I%*%s\e(B riece-ignore \e$B$rDI2C\e(B
-
-** 9 \e$BJ8;z0J>e$N%K%C%/%M!<%`$b<u$1IU$1$k$h$&$K$7$?\e(B
-
-** \e$B:F5/F0$7$?:]$K!"%"%I%*%s$rFs=E$KAH$_9~$^$J$$$h$&$K$7$?\e(B
-
-** \e$BB>$N%P%C%U%!$K$$$k;~$KH/8@$,$"$k$H%b!<%I%i%$%s$K0u\e(B ("[R]") \e$B$rI=<($9\e(B
- \e$B$k%"%I%*%s\e(B riece-biff \e$B$rDI2C\e(B (by \e$BBg66$5$s\e(B)
-
-** \e$BF|K\8l$NDL$i$J$$C<Kv$G!"F|K\8l$r%m!<%^;z$GI=<($9$k%"%I%*%s\e(B
- riece-kakasi \e$B$rDI2C\e(B
-
-** \e$B%3%^%s%I%W%m%s%W%H$K%"%/%7%g%s$r<($9J8;zNs$rDI2C\e(B (suggested by \e$B;32<$5$s\e(B)
-
-* Riece 0.2.2 \e$B$N<g$JJQ99E@\e(B
-
-** ^B, ^V, ^_ \e$B$J$I$N%3%s%H%m!<%k%7!<%1%s%9$K$h$kJ8;zNs$N6/D4$KBP1~\e(B
- (riece-ctlseq \e$B%"%I%*%s$rDI2C\e(B)
-
-** \e$B%W%j%V$,L$FI07$$$5$l$J$$IT6q9g$N=$@5\e(B
-
-** \e$B%A%c%s%M%k%P%C%U%!!"\e(B*Others* \e$B%P%C%U%!$rFHN)$K\e(B freeze \e$B$G$-$k$h$&$K$7\e(B
- \e$B$?!#\e(B(\e$B3F%P%C%U%!$G\e(B C-t C-f \e$B$G%H%0%k\e(B)
-
-** riece-log \e$B$G!"%m%0$NJ]B8@h%G%#%l%/%H%j$r\e(B canonicalize \e$B$7$?%A%c%s%M\e(B
- \e$B%kL>$+$i5a$a$k$h$&$K$7$?!#\e(B(by \e$BBg66$5$s\e(B)
-
-* Riece 0.2.0 \e$B$N<g$JJQ99E@\e(B
-
-** Qt \e$B$d\e(B GTK+ \e$B$HF1MM$N%7%0%J%k$rF3F~$7!"ItJ,E*$K:FIA2h$9$k$h$&$K$7$?!#\e(B
-
-** C-c C-n \e$B$G!"%A%c%s%M%k%P%C%U%!$K$bL>A0$N0lMw$rI=<($9$k$h$&$K$7$?!#\e(B
-
-** riece-lsdb \e$B;HMQ;~$NIT6q9g$N=$@5\e(B (by \e$BCf;3$5$s\e(B)
-
-* Riece 0.1.8 \e$B$N<g$JJQ99E@\e(B
-
-** LSDB \e$B$HO"7H$9$k%"%I%*%s\e(B riece-lsdb \e$B$rDI2C\e(B
-
-** \e$B%f!<%60lMw$K\e(B X-Face \e$B$rI=<($9$k%"%I%*%s\e(B riece-xface \e$B$rDI2C\e(B (\e$BMW\e(B LSDB)\e$B!%\e(B
-\e$B%9%/%j!<%s%7%g%C%H!'\e(B
-http://wiliki.designflaw.org/riece-xface.png
-
-** \e$B%A%c%s%M%kL>$NBgJ8;z>.J8;z$,6hJL$5$l$F$7$^$&%P%0$r=$@5\e(B
-
-** IRC proxy \e$B$KB>$N%/%i%$%"%s%H$H0l=o$K@\B3$7$F$$$k>l9g$G$b!$<+J,$NH/\e(B
- \e$B8@$r$-$A$s$H07$&$h$&$K$7$?\e(B (by \e$B9b66$5$s\e(B)
-
-* Riece 0.1.7 \e$B$N<g$JJQ99E@\e(B
-
-** Emacs \e$B$,\e(B busy or suspend \e$B>uBV$K$J$k$3$H$KHw$(!"\e(B
- PING \e$B$K1~Ez$9$k\e(B local proxy \e$B7PM3$G\e(B IRC \e$B%5!<%P$K@\B3$9$k%"%I%*%s\e(B
- riece-async \e$B$rDI2C\e(B
-
-** riece-away-message \e$B$,;XDj$5$l$?>l9g$K\e(B AWAY \e$B>uBV$N%H%0%k$K<:GT$9$k%P\e(B
- \e$B%0$r=$@5\e(B (Thanks to \e$BF#B<$5$s\e(B)
-
-** GNU Emacs \e$B$G!"%m!<%I;~$K\e(B standard-syntax-table \e$B$rJQ99$7$F$7$^$&%P%0$r=$@5\e(B
- (Thanks to Hori \e$B$5$s\e(B)
-
-** riece-startup-channel-list \e$B$K2C$(!"\e(Briece-startup-server-list \e$B$r;XDj\e(B
- \e$B$9$k$3$H$G!"5/F0;~$KJ#?t$N%5!<%P>e$N%A%c%s%M%k$K;22C$G$-$k$h$&$K$7$?\e(B
-
-** riece-log \e$B;HMQ;~$K%m%0%U%!%$%k$N\e(B coding system \e$B$r;XDj$9$k%*%W%7%g%s\e(B
- riece-log-coding-system \e$B$rDI2C\e(B
-
-** riece-keyword \e$B;HMQ;~$K;XDj$7$?%-!<%o!<%I$NH/8@$,$"$C$?;~$K8F$P$l$k\e(B
- riece-keyword-notify-functions \e$B$rDI2C!#4{B8$N\e(B
- riece-notify-keyword-functions(\e$B$J$s$FJ6$i$o$7$$L>A0\e(B!) \e$B$NBe$o$j$K$3$A$i\e(B
- \e$B$r;HMQ$7$F$/$@$5$$\e(B
-
-** riece-log \e$B;HMQ;~$K\e(B riece-log-flashback \e$B$,%O%$%i%$%H$d%\%?%s$bI|85$9\e(B
- \e$B$k$h$&$K$7$?\e(B
-
-** riece-{unread,mini} \e$B$r\e(B NOTICE \e$B$d\e(B CTCP ACTION \e$B$K$OH?1~$7$J$$$h$&$K$7$?\e(B
-
-* Riece 0.1.6 \e$B$N<g$JJQ99E@\e(B
-
-** Emacs 20.7 \e$B$G$&$^$/F0:n$7$J$$IT6q9g$N=$@5!#\e(B
-
-** XEmacs 21.1 \e$B$G%3%s%Q%$%k$K<:GT$9$kIT6q9g$N=$@5\e(B(\e$BF0:n$OL5J]>Z\e(B)\e$B!#\e(B
-
-** riece-rdcc \e$B$G!"5pBg$J%U%!%$%k$r<u?.$7$F$b%a%b%j$r?)$o$J$$$h$&$K$7$?!#\e(B
-
-** riece-gather-channel-modes == t \e$B$N>l9g!"%A%c%s%M%k;22C;~$K%A%c%s%M\e(B
- \e$B%k$N%b!<%I$rD4$Y$k$h$&$K$7$?!#\e(B
-
-** \e$B%A%c%s%M%k%P%C%U%!$N%5%$%:$r@Z$j5M$a$k%?%$%_%s%0$r=$@5!#\e(B
-
-** \e$B%A%c%s%M%k0\F0;~$K!"%P%C%U%!$,<+F0E*$K%9%/%m!<%k$7$J$$IT6q9g$N=$@5!#\e(B
-
-** riece-log \e$B$G!"\e(Briece-log-directory-map \e$B$K%5!<%PL>IU$-$N%A%c%s%M%k$r\e(B
- \e$B;XDj$G$-$k$h$&$K$7$?!#\e(B(by \e$BBg66$5$s\e(B)
-
-* Riece 0.1.5 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%G%U%)%k%H$GMxMQ2DG=$J%&%#%s%I%&%l%$%"%&%H$K!"\e(B
- {top,middle,bottom}-{left,right} \e$B$rDI2C!#\e(B
-
-** \e$BA*BrCf$N%&%#%s%I%&%l%$%"%&%H$rJ]B8$9$k$h$&$K$7$?!#\e(B
-
-** \e$B%"%$%3%s$rI=<($9$k%"%I%*%s\e(B (riece-icon) \e$B$rDI2C!#\e(B
- ([http://wiliki.designflaw.org/riecess1.png \e$B%9%/%j!<%s%7%g%C%H\e(B])
-
-** \e$B%f!<%6%j%9%H$N:FIA2h$N9bB.2=!#\e(B
-
-** CTCP ACTION \e$B$N2~NI!#\e(B(Thanks to knu \e$B$5$s\e(B)
-
-** riece-rdcc \e$B$r;H$C$F\e(B DCC \e$B$N%U%!%$%kE>Aw$r;O$a$k:]$K!"$?$^$K8G$^$k%P%0$r=$@5!#\e(B
-
-** \e$B4{$K\e(B Riece \e$B$,5/F0$7$?>uBV$G$b$&0lEY5/F0$7$?>l9g!"%(%i!<$rDLCN$9$k$N\e(B
- \e$B$G$O$J$/!"\e(Briece-command-configure-windows \e$B$r8F$V$h$&$K$7$?\e(B (Thanks
- to \e$BBg66$5$s\e(B)
-
-** C-c o (riece-command-set-operators) \e$B$H\e(B C-c v
- (riece-command-set-speakers) \e$B$G!"\e(B3 \e$B?M0J>e$N%f!<%6$rBP>]$K$7$?>l9g$N%P\e(B
- \e$B%0$r=$@5!#\e(B
-
-** \e$B%P%C%U%!$N%5%$%:$,\e(B riece-max-buffer-size \e$B$r1[$($?>l9g!"<+F0E*$K@Z$j\e(B
- \e$B5M$a$k$h$&$K$7$?!#\e(B
-
-* Riece 0.1.4 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%A%c%s%M%k%P%C%U%!$G\e(B riece-command-names \e$B$N%-!<%P%$%s%I$r\e(B C-n \e$B$+$i\e(B
- N \e$B$KJQ99!#\e(B(thanks to \e$B9b66$5$s\e(B)
-
-** C-c C-t a (riece-command-toggle-away) \e$B$,%(%i!<$K$J$k%P%0$r=$@5!#\e(B
- (thanks to \e$BA0ED$5$s\e(B)
-
-** Riece \e$B$N%P%C%U%!$rA*Br$7$F$$$J$$;~$K$O!":FIA2h$r9T$o$J$$$h$&$K$7$?!#\e(B
-
-** \e$BF1L>$N%P%C%U%!$,\e(B Riece \e$B0J30$N%W%m%0%i%`$K;H$o$l$F$$$k;~!"\e(B
- generate-new-buffer \e$B$G?7$7$$%P%C%U%!$r:n@.$7$FMxMQ$9$k$h$&$K$7$?!#\e(B
-
-** ! \e$B$G=i$^$k%A%c%s%M%k$r:n@.$G$-$J$$%P%0$r=$@5!#\e(B
-
-** riece-keyword \e$B;HMQ;~$K!"<+J,$NH/8@$K4^$^$l$k%-!<%o!<%I$KH?1~$7$J$$\e(B
- \e$B$h$&$K$7$?!#\e(B
-
-** \e$B$R$H$D$b%A%c%s%M%k$KF~$C$F$$$J$$;~!"%A%c%s%M%kFb$G$N$_M-8z$J%3%^%s\e(B
- \e$B%I$r<B9T$9$k$H%(%i!<$r=P$9$h$&$K$7$?!#\e(B
-
-** \e$B%a%K%e!<%P!<$K%a%K%e!<$rDI2C$9$k%"%I%*%s\e(B (riece-menu) \e$B$r?7@_!#\e(B
-
-* Riece 0.1.3 \e$B$N<g$JJQ99E@\e(B
-
-** PRIVMSG \e$B$d\e(B NOTICE \e$B$N<u?.;~$K!$%A%c%s%M%kL>$NBgJ8;z>.J8;z$r6hJL$7$J\e(B
- \e$B$$$h$&$K$7$?!#\e(B
-
-** riece-history \e$B;HMQ;~$K!$%R%9%H%j$N@hF,$K$"$k%A%c%s%M%k$K\e(B "+" \e$B%^!<%/\e(B
- \e$B$r$D$1$k$h$&$K$7$?!#\e(B
-
-** \e$B%\%?%s$H%]%C%W%"%C%W%a%K%e!<$rI=<($9$k%"%I%*%s\e(B (riece-button) \e$B$rDI2C!#\e(B
-
-** \e$B%-!<%o!<%I$r8!=P$9$k%"%I%*%s\e(B (riece-keyword) \e$B$rDI2C!#\e(B
-
- XEmacs \e$B$r$*;H$$$J$i!$0J2<$N@_Dj$r\e(B ~/.riece/init.el \e$B$K2C$($k$3$H$G!$\e(B
- "\e$B$[$2\e(B" \e$B$d\e(B "\e$B$U$,\e(B" \e$B$KH?1~$7$F2;$rLD$i$9$3$H$,$G$-$^$9!%\e(B
-
- (load-default-sounds)
- (setq riece-keywords '("\e$B$[$2\e(B" "\e$B$U$,\e(B"))
- (add-hook 'riece-notify-keyword-functions
- (lambda (keyword) (play-sound 'cuckoo)))
-
-* Riece 0.1.2 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%Q%9%o!<%IIU$-$N%A%c%s%M%k$K\e(B JOIN \e$B$G$-$J$$%P%0$r=$@5\e(B
-
-** riece-startup-channel-list \e$B$rI|3h\e(B
-
-** riece-rdcc-save-directory \e$B$r?7@_\e(B
-
-** \e$B%Q%9%o!<%IF~NO$rCfCG$G$-$J$$%P%0$r=$@5\e(B
-
-** INVITE \e$B%O%s%I%i$N%P%0$r=$@5\e(B
-
-** INVITE \e$B$5$l$?8e$K\e(B JOIN \e$B$9$k>l9g!"%G%U%)%k%H$N%A%c%s%M%kL>$r;H$&$h$&$K$7$?!#\e(B
-
-** JOIN \e$B$N%?%$%_%s%0$K$h$j\e(B riece-channel-list-indicator \e$B$,99?7$5$l$J$$\e(B
- \e$B%P%0$r=$@5\e(B
-
-* Riece 0.1.1 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B$$$/$D$+$N%"%I%*%s$r%G%U%)%k%H$GFI$_9~$`$h$&$K$7$?\e(B
-
-** riece-default-channel-binding \e$B$,8z$+$J$$%P%0$r<#$7$?\e(B
-
-** *Channels* \e$B%P%C%U%!$G!"8=:_$$$k%A%c%s%M%kL>$NF,$K%^!<%/\e(B "*" \e$B$rIU$1$k\e(B
- \e$B$h$&$K$7$?\e(B
-
-** riece-debug == nil \e$B$N>l9g!"@ZCG;~$N%a%C%;!<%8$r4JN,2=$7$?\e(B
-
-** \e$B%A%c%s%M%k0\F0$NMzNr$r4IM}$9$k%"%I%*%s\e(B riece-history \e$B$rDI2C\e(B
-
-** \e$B0\F0@h$N%A%c%s%M%k$r?dB,$9$k%"%I%*%s\e(B riece-guess \e$B$rDI2C\e(B
-
-Tips:
-
-~/.riece/init.el \e$B$K0J2<$N$h$&$K;XDj$9$k$H!"\e(B
-
- (setq riece-guess-channel-try-functions
- '(riece-guess-channel-from-unread
- riece-guess-channel-from-history))
-
-C-c g \e$B$G0J2<$N=g=x$G0\F0$G$-$^$9!#\e(B
-
-# \e$BL$FI$N%a%C%;!<%8$N$"$k%A%c%s%M%k\e(B
-# \e$B:G6aK,$l$?%A%c%s%M%k\e(B
-# \e$B$=$l0J30\e(B
-
-* Riece 0.1.0 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%A%c%s%M%k$NFbItI=8=$rJ8;zNs$+$i%Y%/%?!<$K$h$kI=8=$KJQ99$7$?\e(B
-
-** \e$B%W%m%;%94IM}$r$^$H$b$K$7$?\e(B
-
-*** \e$B%W%m%;%9L>$G%5!<%P$r<1JL$9$k$h$&$KJQ99$7$?\e(B
-
-*** \e$B@\B3!&@ZCG$N=hM}$r\e(B riece-server.el \e$B$K$^$H$a$?\e(B
-
-*** QUIT \e$B$rEj$2$F$b1~Ez$,$J$$>l9g!"6/@)E*$K@ZCG$9$k$h$&$K$7$?\e(B
-
-** M-x doctor \e$B$HO"7H$9$k%"%I%*%s$rDI2C\e(B
-
-** \e$BH/8@$K\e(B SKK \e$B$NJQ49Cf$N0u"&$,:.$6$i$J$$$h$&$K$9$k%"%I%*%s$rDI2C\e(B (by \e$B9b66$5$s\e(B)
-
-** \e$B%&%#%s%I%&%l%$%"%&%H$rJQ99$G$-$k$h$&$K$7$?\e(B (C-c t l)
-
-** Liece \e$B$N\e(B "top" \e$B%9%?%$%k$K;w$?%&%#%s%I%&%l%$%"%&%H$rDI2C\e(B (by \e$B9b66$5$s\e(B)
-
-* Riece 0.0.4 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%_%K%P%C%U%!$@$1$G\e(B IRC \e$B$9$k%"%I%*%s\e(B riece-mini \e$B$rDI2C\e(B (by \e$BBg66$5$s\e(B)
-
-** \e$B%m%0<}=8%"%I%*%s\e(B riece-log \e$B$rDI2C\e(B (by \e$BBg66$5$s\e(B)
-
-** riece-command-next-channel (C-c >), riece-command-previous-channel
- (C-c <) \e$B$G%A%c%s%M%k$r$0$k$0$k0\F0$G$-$k$h$&$K$7$?\e(B (by \e$BCf;3$5$s\e(B)
-
-** riece-unread \e$B%"%I%*%s;HMQ;~$KH/8@$N$"$C$?%A%c%s%M%k$K\e(B C-c C-u \e$B$G0\\e(B
- \e$BF0$G$-$k$h$&$K$7$?\e(B (by \e$BBg66$5$s\e(B)
-
-** IRC \e$B%a%C%;!<%8$K=>$C$F%$%s%8%1!<%?$r99?7$9$k$h$&$K$7$?\e(B
-
-** ptexinfmt.el \e$B$r\e(B APEL free \e$B$J$b$N$KCV$-49$($?\e(B (Thanks to \e$B;32,$5$s\e(B)
-
-* Riece 0.0.3 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B%Q%9%o!<%I$,I,MW$J%5!<%P$KFs$D0J>e@\B3$G$-$J$$%P%0$N=$@5\e(B (Thanks to
- \e$BCf;3$5$s\e(B)
-
-** \e$B%K%C%/$NBgJ8;z>.J8;z$@$1$rJQ99$9$k$H0l4S@-$,<:$o$l$kLdBj$r=$@5\e(B
-
-** \e$B%O%s%I%i%U%C%/$GH/@8$7$?%(%i!<$rJaB*\e(B
-
-** DCC \e$B$K$h$k%U%!%$%kE>Aw$KBP1~\e(B (riece-ndcc.el, riece-rdcc.el)
-
-** \e$BH/8@$N$"$C$?%A%c%s%M%k$K\e(B "!" \e$B%^!<%/$r$D$1$k%"%I%*%s$NDI2C\e(B (riece-unread.el)
-
-** \e$BF|K\8l$N%^%K%e%"%k$NDI2C\e(B
-
-* Riece 0.0.2 \e$B$N<g$JJQ99E@\e(B
-
-** APEL \e$B$N4X?t\e(B (pop, push) \e$B$NB`<#\e(B
-
-** "depcomp" \e$B$,F1:-$5$l$J$$LdBj$N=$@5\e(B (autoreconf \e$B$N%P%0\e(B?)
-
-** Windows \e$B4D6-$G%S%k%I$G$-$J$$IT6q9g$N=$@5\e(B (Thanks to \e$BBg66$5$s\e(B)
-
-** \e$B%K%C%/JQ99;~$K0l4S@-$,<:$o$l$kLdBj$N=$@5\e(B
-
-** C-c C-t u (M-x riece-command-toggle-user-list-mode) \e$B$NIT6q9g$N=$@5\e(B
-
-** \e$B%"%I%*%s$NF3F~\e(B
-
-** CTCP \e$B$KItJ,E*$KBP1~\e(B (VERSION \e$B$H\e(B PING \e$B$N$_\e(B)
-
-** font-lock \e$B%b%8%e!<%k\e(B (riece-highlight) \e$B$N%"%I%*%s2=\e(B
-
-** URL \e$B<}=85!G=$N%"%I%*%s2=\e(B
-
-* Riece 0.0.1 \e$B$N<g$JJQ99E@\e(B
-
-** \e$B:G=i$N%j%j!<%9\e(B
-
-* For details of changes, see the file ChangeLog.
-\f
-Local variables:
-mode: text
-mode: outline
-paragraph-separate: "[ \f]*$"
-coding: iso-2022-jp
-end:
+++ /dev/null
-* What's this?
-
-Riece is an IRC client for Emacs.
-
-Riece provides the following features:
-
-- Several IRC servers may be used at the same time.
-- Essential features can be built upon the extension framework (called
- "add-on") capable of dependency tracking.
-- Installation is easy. Riece doesn't depend on other packages.
-- Setup is easy. Automatically save/restore the configuration.
-- Riece uses separate windows to display users, channels, and
- dialogues. The user can select the window layout.
-- Step-by-step instructions (in info format) are included.
-- Mostly compliant with RFC 2812.
-
-* Directory tree
-
-This package contains following directories:
-
-lisp/ - Emacs Lisp files.
-doc/ - Documentation files.
-
-* Requirements
-
-- Emacs 20.7 or later / XEmacs 21.4 or later
-- Ruby 1.8 or later (optional)
-
-* Installation
-
-$ ./configure
-$ sudo make install
-
-Add the following line to your Emacs startup file such as ~/.emacs.
-
- (autoload 'riece "riece" "Start Riece" t)
-
-If you are using XEmacs and want to install as a package, supply
-"--with-xemacs" option to the configure script and use
-"install-package" target instead of "install".
-
-* Manuals
-
-Info manuals are available after installation. To read, start Emacs
-and type M-x info and select "Riece-en".
-
-* Bug reports
-
-If you write a bug report, please send them to the Liece Mailing List
-(liece@unixuser.org).
+++ /dev/null
-* \e$B$3$l$O2?$+\e(B?
-
-Riece \e$B$O\e(B Emacs \e$B8~$1\e(B IRC \e$B%/%i%$%"%s%H$G$9!#\e(B
-
-Riece \e$B$K$O0J2<$K5s$2$kFCD9$,$"$j$^$9\e(B:
-
-- \e$BJ#?t$N\e(B IRC \e$B%5!<%P$KF1;~$K@\B32DG=\e(B
-- \e$B%"%I%*%s$K$h$j3HD%5!G=$NDI2C$d<h$j30$7$,2DG=\e(B
-- \e$BB>$N\e(B elisp \e$B%Q%C%1!<%8$K0MB8$7$J$$$?$a!"%$%s%9%H!<%k$,4JC1\e(B
-- \e$B@_Dj$,4JC1$G!"A02s5/F0;~$N@_Dj$r5-O?!&I|85$9$k;EAH$_$rDs6!\e(B
-- \e$BCJ3,E*$JA`:n@bL@=q\e(B (info \e$B7A<0\e(B) \e$B$,ImB0\e(B
-- \e$B:G?7$N\e(B IRC \e$B$N%/%i%$%"%s%H%W%m%H%3%k\e(B (RFC2812) \e$B$K=`5r\e(B
-
-* \e$B%G%#%l%/%H%j9=@.\e(B
-
-\e$B$3$N%Q%C%1!<%8$O0J2<$N%G%#%l%/%H%j$+$i@.$j$^$9\e(B:
-
-lisp/ - Emacs Lisp \e$B$N%U%!%$%k\e(B
-doc/ - \e$BJ8=q%U%!%$%k\e(B
-
-* \e$BI,MW$J$b$N\e(B
-
-- Emacs 20.7 \e$B0J9_!"$^$?$O\e(B XEmacs 21.4 \e$B0J9_\e(B
-- Ruby 1.8 \e$B0J9_\e(B (\e$BG$0U\e(B)
-
-* \e$B%$%s%9%H!<%k\e(B
-
-$ ./configure
-$ sudo make install
-
-~/.emacs \e$BEy$K0J2<$N0l9T$rDI2C$7$F$/$@$5$$!#\e(B
-
- (autoload 'riece "riece" "Start Riece" t)
-
-XEmacs \e$B$G;H$&>l9g$K$O\e(B "--with-xemacs" \e$B%*%W%7%g%s$r\e(B configure \e$B%9%/%j%W\e(B
-\e$B%H$KM?$($F$/$@$5$$!#$^$?!"\e(B"make install" \e$B$NBe$o$j$K\e(B "make
-install-package" \e$B$H$9$k$3$H$G\e(BXEmacs \e$B$N%Q%C%1!<%8$H$7$F%$%s%9%H!<%k$9$k\e(B
-\e$B$3$H$,$G$-$^$9!#\e(B
-
-* \e$B%^%K%e%"%k\e(B
-
-\e$B;H$$J}$OF1:-$N%^%K%e%"%k$K5-:\$5$l$F$$$^$9!#\e(B
-\e$B%^%K%e%"%k$rFI$`$K$O\e(B "M-x info" \e$B$G0J2<$N%a%K%e!<$rA*Br$7$^$9!#\e(B
-
- * Riece-ja: (riece-ja). An IRC client for Emacsen
-
-* \e$B%P%0Js9p\e(B
-
-\e$B%P%0Js9p$O!"\e(BLiece \e$B%a!<%j%s%0%j%9%H\e(B (liece@unixuser.org) \e$B$K$*Aw$j$/$@$5\e(B
-\e$B$$!#\e(BRiece \e$B$N<B9TCf$K\e(B "M-x riece-submit-bug-report" \e$B$G%P%0Js9p$N%F%s%W\e(B
-\e$B%l!<%H$r:n@.$G$-$^$9!#\e(B
+++ /dev/null
-AC_DEFUN([AC_DEFINE_GNUS_PRODUCT_NAME],
- [echo $ac_n "defining gnus product name... $ac_c"
- AC_CACHE_VAL(EMACS_cv_GNUS_PRODUCT_NAME,[EMACS_cv_GNUS_PRODUCT_NAME=$1])
- GNUS_PRODUCT_NAME=${EMACS_cv_GNUS_PRODUCT_NAME}
- AC_MSG_RESULT(${GNUS_PRODUCT_NAME})
- AC_SUBST(GNUS_PRODUCT_NAME)])
-
-AC_DEFUN([AC_CHECK_EMACS],
- [dnl Check for Emacsen.
-
- dnl Apparently, if you run a shell window in Emacs, it sets the EMACS
- dnl environment variable to 't'. Lets undo the damage.
- test "$EMACS" = t && EMACS=
-
- dnl Ignore cache.
- unset ac_cv_prog_EMACS; unset ac_cv_prog_XEMACS;
-
- AC_ARG_WITH(emacs,
- [ --with-emacs=EMACS compile with EMACS [EMACS=emacs, mule...]],
- [if test "$withval" = yes -o -z "$withval"; then
- AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs)
- else
- AC_CHECK_PROG(EMACS, $withval, $withval, emacs)
- fi])
- AC_ARG_WITH(xemacs,
- [ --with-xemacs=XEMACS compile with XEMACS [XEMACS=xemacs]],
- [if test "$withval" = yes -o -z "$withval"; then
- AC_CHECK_PROG(XEMACS, xemacs, xemacs, xemacs)
- else
- AC_CHECK_PROG(XEMACS, $withval, $withval, xemacs)
- fi
- EMACS=$XEMACS],
- [XEMACS=xemacs
- test -z "$EMACS" && AC_CHECK_PROGS(EMACS, emacs xemacs mule, emacs)])
- AC_SUBST(EMACS)
- AC_SUBST(XEMACS)])
-
-AC_DEFUN([AC_EMACS_LISP], [
-elisp="$2"
-if test -z "$3"; then
- AC_MSG_CHECKING(for $1)
-fi
-AC_CACHE_VAL(EMACS_cv_SYS_$1,[
- OUTPUT=./conftest-$$
- echo ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1
- eval ${EMACS}' -batch -eval '\''(let ((x '${elisp}')) (write-region (if (stringp x) (princ x) (prin1-to-string x)) nil "'${OUTPUT}'" nil 5))'\' >& AC_FD_CC 2>&1
- retval=`cat ${OUTPUT}`
- echo "=> ${retval}" >& AC_FD_CC 2>&1
- rm -f ${OUTPUT}
- EMACS_cv_SYS_$1=$retval
-])
-$1=${EMACS_cv_SYS_$1}
-if test -z "$3"; then
- AC_MSG_RESULT($$1)
-fi
-])
-
-AC_DEFUN([AC_CHECK_EMACS_FLAVOR],
- [AC_MSG_CHECKING([what flavor does $EMACS have])
-
- dnl Ignore cache.
- unset EMACS_cv_SYS_flavor;
-
- AC_EMACS_LISP(flavor,
- (cond ((featurep (quote xemacs)) \"XEmacs\")\
- ((boundp (quote MULE)) \"MULE\")\
- (t \"FSF Emacs\")),
- "noecho")
- case $EMACS_cv_SYS_flavor in
- XEmacs)
- EMACS_FLAVOR=xemacs;;
- MULE)
- EMACS_FLAVOR=mule;;
- *)
- EMACS_FLAVOR=emacs;;
- esac
- AC_MSG_RESULT($EMACS_cv_SYS_flavor)])
-
-AC_DEFUN([AC_PATH_LISPDIR], [
- AC_CHECK_EMACS_FLAVOR
- if test "$prefix" = NONE; then
- AC_MSG_CHECKING([prefix for your Emacs])
- AC_EMACS_LISP(prefix,(expand-file-name \"..\" invocation-directory),"noecho")
- prefix=${EMACS_cv_SYS_prefix}
- AC_MSG_RESULT($prefix)
- fi
- AC_ARG_WITH(lispdir,
- [ --with-lispdir=DIR Where to install lisp files
- (for XEmacs package, use --with-packagedir instead)],
- lispdir=${withval})
- AC_MSG_CHECKING([where lisp files should go])
- if test -z "$lispdir"; then
- dnl Set default value
- theprefix=$prefix
- if test "$theprefix" = NONE; then
- theprefix=$ac_default_prefix
- fi
- lispdir="\$(datadir)/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}"
- for thedir in share lib; do
- potential=
- if test -d ${theprefix}/${thedir}/${EMACS_FLAVOR}/site-lisp; then
- lispdir="\$(prefix)/${thedir}/${EMACS_FLAVOR}/site-lisp/${GNUS_PRODUCT_NAME}"
- break
- fi
- done
- fi
- if test ${EMACS_FLAVOR} = xemacs; then
- AC_MSG_RESULT([$lispdir
- (it will be ignored when \"make install-package[[-ja]]\" is done)])
- else
- AC_MSG_RESULT([$lispdir])
- fi
- AC_SUBST(lispdir)
-])
-
-AC_DEFUN([AC_PATH_ETCDIR], [
- AC_ARG_WITH(etcdir,[ --with-etcdir=DIR Where to install etc files], etcdir=${withval})
- AC_MSG_CHECKING([where etc files should go])
- if test -z "$etcdir"; then
- dnl Set default value
- etcdir="\$(lispdir)/../etc"
- fi
- AC_MSG_RESULT($etcdir)
- AC_SUBST(etcdir)
-])
-
-dnl
-dnl Check whether a function exists in a library
-dnl All '_' characters in the first argument are converted to '-'
-dnl
-AC_DEFUN([AC_EMACS_CHECK_LIB], [
-if test -z "$3"; then
- AC_MSG_CHECKING(for $2 in $1)
-fi
-library=`echo $1 | tr _ -`
-AC_EMACS_LISP($1,(progn (fmakunbound (quote $2)) (condition-case nil (progn (require (quote $library)) (fboundp (quote $2))) (error (prog1 nil (message \"$library not found\"))))),"noecho")
-if test "${EMACS_cv_SYS_$1}" = nil; then
- EMACS_cv_SYS_$1=no
-fi
-if test "${EMACS_cv_SYS_$1}" = t; then
- EMACS_cv_SYS_$1=yes
-fi
-HAVE_$1=${EMACS_cv_SYS_$1}
-AC_SUBST(HAVE_$1)
-if test -z "$3"; then
- AC_MSG_RESULT($HAVE_$1)
-fi
-])
-
-dnl
-dnl Perform sanity checking and try to locate the W3 package
-dnl
-AC_DEFUN([AC_CHECK_W3], [
-AC_MSG_CHECKING(for acceptable W3 version)
-
-dnl Ignore cache.
-unset EMACS_cv_ACCEPTABLE_W3;
-unset EMACS_cv_SYS_w3_dir;
-unset EMACS_cv_SYS_w3_forms;
-
-AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_W3,[
-AC_EMACS_CHECK_LIB(w3_forms, w3-form-encode-xwfu,"noecho")
-if test "${HAVE_w3_forms}" = yes; then
- EMACS_cv_ACCEPTABLE_W3=yes
-else
- EMACS_cv_ACCEPTABLE_W3=
-fi
-
-if test "${EMACS_cv_ACCEPTABLE_W3}" = yes; then
- AC_EMACS_LISP(w3_dir,(file-name-directory (locate-library \"w3-forms\")),"noecho")
- EMACS_cv_ACCEPTABLE_W3=$EMACS_cv_SYS_w3_dir
-fi
-])
- AC_ARG_WITH(w3,[ --with-w3=DIR Specify where to find the w3 package], [ EMACS_cv_ACCEPTABLE_W3=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ])
- W3=${EMACS_cv_ACCEPTABLE_W3}
- AC_SUBST(W3)
- if test -z "${EMACS_cv_ACCEPTABLE_W3}"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT(${W3})
- fi
-])
-
-dnl
-dnl Perform sanity checking and try to locate the W3 package
-dnl
-AC_DEFUN([AC_CHECK_URL], [
-AC_MSG_CHECKING(for acceptable URL version)
-
-dnl Ignore cache.
-unset EMACS_cv_ACCEPTABLE_URL;
-unset EMACS_cv_SYS_url_dir;
-unset EMACS_cv_SYS_url;
-
-AC_CACHE_VAL(EMACS_cv_ACCEPTABLE_URL,[
-AC_EMACS_CHECK_LIB(url, url-retrieve, "noecho")
-if test "${HAVE_url}" = yes; then
- EMACS_cv_ACCEPTABLE_URL=yes
-else
- EMACS_cv_ACCEPTABLE_URL=
-fi
-
-if test "${EMACS_cv_ACCEPTABLE_URL}" = yes; then
- AC_EMACS_LISP(url_dir,(file-name-directory (locate-library \"url\")),"noecho")
- EMACS_cv_ACCEPTABLE_URL=$EMACS_cv_SYS_url_dir
-fi
-])
- AC_ARG_WITH(url,[ --with-url=DIR Specify where to find the url package], [ EMACS_cv_ACCEPTABLE_URL=`( cd $withval && pwd || echo "$withval" ) 2> /dev/null` ])
- URL=${EMACS_cv_ACCEPTABLE_URL}
- AC_SUBST(URL)
- if test -z "${EMACS_cv_ACCEPTABLE_URL}"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT("${URL}")
- fi
-])
-
-dnl
-dnl Perform checking available fonts: Adobe Bembo, Adobe Futura and
-dnl Bitstream Courier.
-dnl
-
-AC_DEFUN([GNUS_CHECK_FONTS], [
-test "$LATEX" = t && LATEX=
-test "$LATEX" || AC_PATH_PROGS(LATEX, latex, no)
-AC_MSG_CHECKING(for available fonts)
-AC_ARG_WITH(fonts,[ --with-fonts Assume all fonts required are available],[USE_FONTS="$withval"])
-WITH_FONTS_bembo='%'
-WITHOUT_FONTS_bembo=
-WITH_FONTS_pfu='%'
-WITHOUT_FONTS_pfu=
-WITH_FONTS_bcr='%'
-WITHOUT_FONTS_bcr=
-if test -z "${USE_FONTS}"; then
- if test "${LATEX}" = no; then
- :
- else
- OUTPUT=./conftest-$$
- echo '\nonstopmode\documentclass{article}\usepackage{bembo}\begin{document}\end{document}' > ${OUTPUT}
- if ${LATEX} ${OUTPUT} </dev/null >& AC_FD_CC 2>&1 ; then
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Adobe Bembo"
- else
- USE_FONTS="${USE_FONTS}, Adobe Bembo"
- fi
- WITH_FONTS_bembo=
- WITHOUT_FONTS_bembo='%'
- fi
- echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{pfu}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT}
- if retval=`${LATEX} ${OUTPUT} </dev/null 2>& AC_FD_CC`; then
- if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then
- :
- else
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Adobe Futura"
- else
- USE_FONTS="${USE_FONTS}, Adobe Futura"
- fi
- WITH_FONTS_pfu=
- WITHOUT_FONTS_pfu='%'
- fi
- fi
- echo '\nonstopmode\documentclass{article}\begin{document}{\fontfamily{bcr}\fontsize{10pt}{10}\selectfont test}\end{document}' > ${OUTPUT}
- if retval=`${LATEX} ${OUTPUT} </dev/null 2>& AC_FD_CC`; then
- if echo "$retval" | grep 'Some font shapes were not available' >& AC_FD_CC 2>&1 ; then
- :
- else
- if test -z "${USE_FONTS}"; then
- USE_FONTS="Bitstream Courier"
- else
- USE_FONTS="${USE_FONTS}, Bitstream Courier"
- fi
- WITH_FONTS_bcr=
- WITHOUT_FONTS_bcr='%'
- fi
- fi
- rm -f ${OUTPUT} ${OUTPUT}.aux ${OUTPUT}.log ${OUTPUT}.dvi
- fi
-elif test "${USE_FONTS}" = yes ; then
- WITH_FONTS_bembo=
- WITHOUT_FONTS_bembo='%'
- WITH_FONTS_pfu=
- WITHOUT_FONTS_pfu='%'
- WITH_FONTS_bcr=
- WITHOUT_FONTS_bcr='%'
-fi
-AC_SUBST(WITH_FONTS_bembo)
-AC_SUBST(WITHOUT_FONTS_bembo)
-AC_SUBST(WITH_FONTS_pfu)
-AC_SUBST(WITHOUT_FONTS_pfu)
-AC_SUBST(WITH_FONTS_bcr)
-AC_SUBST(WITHOUT_FONTS_bcr)
-if test -z "${USE_FONTS}" ; then
- USE_FONTS=no
-fi
-USE_FONTS=`echo "${USE_FONTS}" | sed 's/,\([[^,]]*\)$/ and\1/'`
-AC_MSG_RESULT("${USE_FONTS}")
-if test "${USE_FONTS}" = yes ; then
- USE_FONTS='Set in Adobe Bembo, Adobe Futura and Bitstream Courier.'
-elif test "${USE_FONTS}" = no ; then
- USE_FONTS=''
-else
- USE_FONTS="Set in ${USE_FONTS}."
-fi
-AC_SUBST(USE_FONTS)
-])
-
-AC_DEFUN([AC_EXAMINE_PACKAGEDIR],
- [dnl Examine PACKAGEDIR.
- AC_EMACS_LISP(PACKAGEDIR,
- (let (package-dir)\
- (if (boundp (quote early-packages))\
- (let ((dirs (delq nil (append (if early-package-load-path\
- early-packages)\
- (if late-package-load-path\
- late-packages)\
- (if last-package-load-path\
- last-packages)))))\
- (while (and dirs (not package-dir))\
- (if (file-directory-p (car dirs))\
- (setq package-dir (car dirs)\
- dirs (cdr dirs))))))\
- (or package-dir \"\")),
- "noecho")])
-
-AC_DEFUN([AC_PATH_PACKAGEDIR],
- [dnl Check for PACKAGEDIR.
- if test ${EMACS_FLAVOR} = xemacs; then
- AC_MSG_CHECKING([where the XEmacs package is])
- AC_ARG_WITH(packagedir,
- [ --with-packagedir=DIR package DIR for XEmacs],
- [if test "$withval" != yes -a -n "$withval"; then
- PACKAGEDIR=$withval
- else
- AC_EXAMINE_PACKAGEDIR
- fi],
- AC_EXAMINE_PACKAGEDIR)
- if test -z "$PACKAGEDIR"; then
- AC_MSG_RESULT(not found)
- else
- AC_MSG_RESULT($PACKAGEDIR)
- fi
- else
- PACKAGEDIR=
- fi
- AC_SUBST(PACKAGEDIR)])
-
-AC_DEFUN([AC_ADD_LOAD_PATH],
- [dnl Check for additional load path.
- AC_ARG_WITH(addpath,
- [ --with-addpath=PATH search Emacs-Lisp libraries with PATH
- use colons to separate directory names],
- [if test "$withval" != yes -a -n "$withval"; then
- AC_MSG_CHECKING([where to find the additional elisp libraries])
- ADDITIONAL_LOAD_PATH=$withval
- AC_MSG_RESULT($ADDITIONAL_LOAD_PATH)
- fi],
- ADDITIONAL_LOAD_PATH=)
- AC_SUBST(ADDITIONAL_LOAD_PATH)])
+++ /dev/null
-AC_INIT
-AC_CONFIG_SRCDIR([configure.ac])
-AC_PREREQ(2.59)
-AM_INIT_AUTOMAKE(riece, 3.1.2)
-
-AC_CHECK_EMACS
-AC_PATH_LISPDIR
-AC_PATH_PACKAGEDIR
-
-AM_CONDITIONAL(XEMACS, test ${EMACS_FLAVOR} = xemacs)
-
-AC_CONFIG_FILES([Makefile
-lisp/Makefile
-lisp/riece-package-info.el
-lisp/test/Makefile
-doc/Makefile])
-AC_OUTPUT
+++ /dev/null
--*- mode: text -*-
-
-This document is for Riece developers. The information necessary for
-Riece development is explained (i.e. its development process and the
-internals.)
-
-* Development process
-
-** Bug report
-
-You can create a template of a bug report by clicking the "bug" button
-in a toolbar, or M-x riece-submit-bug-report. It is necessary to set
-riece-debug to t before preparing a bug report.
-
-** Debug output
-
-If the riece-debug variable is set to t, Riece begins to collect
-debugging information in *Debug* buffer. Interactions with IRC
-servers are stored in " *IRC*<IRC-server-name>" buffers. Note that
-these buffers have names starting with a whitespace character (" ").
-
-** Joining the development
-
-To join the development, send us a patch or an add-on.
-
-** CVS
-
-Development of Riece uses CVS. Latest developing version is available
-at CVS. Please note that the version from CVS may NOT be reliable,
-and you can only use it at your own risk. We may ignore bug reports
-for that version. The instruction to access the CVS server is below.
-
-(1) logging in to anonymous CVS server
-
- cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login
- CVS password: [CR] # NULL string
-
-(2) checkout modules
-
- cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root checkout riece
-
-(3) generate configure script
-
- autoreconf -f -i -v
-
-You will need newer version of GNU Automake.
-
-* Internals
-
-** Modules
-
-Riece consists of many elisp modules listed below, ordered by the
-number of dependencies they have.
-
-- riece-globals
- This module defines global variables.
-
-- riece-options
- This module defines user options.
-
-- riece-version
- This module defines the version of Riece.
-
-- riece-coding
- This module provides functions which support character code conversions.
-
-- riece-complete
- This module provides functions which support tab completion feature
- in a mini buffer.
-
-- riece-addon
- This module manages add-ons.
-
-- riece-mode
- This module manages modes of riece-channel/riece-user objects.
-
-- riece-identity
- This module defines the riece-identity object type which represents
- global names of riece-channel/riece-user objects.
-
-- riece-channel
- This module defines the riece-channel object type.
-
-- riece-user
- This module defines the riece-user object type.
-
-- riece-misc
- This module provides miscellaneous functions.
-
-- riece-signal
- This module defines the riece-signal object type used to manage
- display events.
-
-- riece-layout
- This module manages window layouts.
-
-- riece-display
- This module manages display events.
-
-- riece-server
- This module manages connections to IRC servers.
-
-- riece-naming
- This module is a so called the Mediator design pattern. It knows
- relationships of riece-channel/riece-user objects.
-
-- riece-message
- This module defines the riece-message object type.
-
-- riece-filter
- This module only provides the process filter function.
-
-- riece-handle
- This module provides handler functions for IRC messages. These
- functions are called from riece-filter.
-
-- riece-000
- This module provides handler functions for numeric replies whose
- response codes are in 000 to 100 range. These handlers are called
- from riece-filter.
-
-- riece-200
- This module provides handler functions for numeric replies whose
- response codes are in 200 to 300 range. These handlers are called
- from riece-filter.
-
-- riece-300
- This module provides handler functions for numeric replies whose
- response codes are in 300 to 400 range. These handlers are called
- from riece-filter.
-
-- riece-400
- This module provides handler functions for numeric replies whose
- response codes are in 400 to 500 range. These handlers are called
- from riece-filter.
-
-- riece-500
- This module provides handler functions for numeric replies whose
- response codes are in 500 to 600 range. These handlers are called
- from riece-filter.
-
-- riece-commands
- This module provides user commands.
-
-- riece-irc
- This module provides the binding for the IRC protocol.
-
-- riece
- This module is the entry point of M-x riece.
-
-** Namespace management
-
-Riece is capable to connect to several IRC servers.
-
-Riece has separate namespace (obarray) for each connection. These
-namespaces can be accessed as buffer local variables of process
-buffer.
-
-*** Obtaining server buffer
-
-To access to the buffer local variables of process buffer, it is
-needed to distinguish process object of each connection by its name.
-
-It can be known by:
-
-(1) checking the value of riece-overriding-server-name,
-
-(2) checking the value of riece-server-name,
- (If the variable riece-server-name is local to the current buffer,
- you are already in the process buffer.)
-
-(3) or parsing riece-identity objects
-
-Once you get the name of the IRC server, you can get the process
-object by passing the name to the function riece-server-process.
-
-*** riece-identity objects
-
-A riece-identity object represents a name of a channel/user. It is
-used to distinguish a channel/user among several servers.
-
-A riece-identity object is actually a vector, which consists of two
-elements listed below.
-
-- prefix
- A channel/user name local to an IRC server.
-
-- server
- The name of the IRC server.
-
-Methods to manipulate riece-identity object are listed below.
-
-- riece-make-identity prefix &optional server
- Create a new riece-identity object. If the server argument is
- omitted, it sets the server part to the value returned by the
- riece-find-server-name function.
-
-- riece-identity-prefix identity
- Return the prefix element from the given riece-identity object.
-
-- riece-identity-server identity
- Return the server element from the given riece-identity object.
-
-- riece-identity-equal ident1 ident2
- Return t, if two riece-identity objects are equal.
-
-- riece-identity-equal-no-server ident1 ident2
- Return t, if two riece-identity objects are equal. This function
- only consider a prefix part of a riece-identity object.
-
-- riece-identity-member elt list
- Return non-nil if a riece-identity object is an element of a list.
-
-*** Channels and users
-
-A riece-channel object provides an abstraction of a channel.
-Likewise, a riece-user object provides an abstraction of a user.
-
-**** riece-channel objects
-
-A riece-channel object has many information about a channel. A
-riece-channel object is actually a vector whose seven elements are listed
-below.
-
-- users
- A list of nicknames which are of users in this channel.
-
-- operators
- A list of nicknames which are of channel operators in this channel.
-
-- speakers
- A list of nicknames which are of users who have the right to speak
- in this channel.
-
-- modes
- An alist which represents modes of this channel.
-
-- banned
- A list of patterns set by MODE +b.
-
-- invited
- A list of patterns set by MODE +I.
-
-- uninvited
- A list of patterns set by MODE +e.
-
-**** riece-user objects
-
-A riece-user object has many information about a user. A riece-user
-object is actually a vector whose four elements are listed below.
-
-- channels
- A list of channel names this user is participating.
-
-- user-at-host
- Connection information of this user, set in "<user>@<host>" format.
-
-- modes
- An alist which represents modes of this user.
-
-- away
- A flag represent whether this user is AWAY.
-
-**** The Mediator pattern
-
-The riece-naming module is used to manage relationships between
-channels and users. It utilizes the Mediator design pattern.
-
-Using the riece-naming module allows to safely access to the namespace
-rather than directly connects riece-channel/riece-user objects.
-
-The riece-naming module provides the following functions.
-
-- riece-naming-assert-join user-name channel-name
- Assert that a user is a member of a channel.
-
-- riece-naming-assert-part user-name channel-name
- Assert that a user is no longer a member of a channel.
-
-- riece-naming-assert-rename old-name new-name
- Assert that a user changed his nickname.
-
-** Signals
-
-There is a mechanism to connect events and display objects (windows,
-buffers, and modeline indicators). This is done by signals.
-
-When it is needed to redraw, a signal is emitted. The concept of
-signals is corresponding to signals in generic window system toolkit
-such as Qt or GTK+.
-
-To emit a signal, use riece-emit-signal.
-
-- riece-emit-signal signal-name &rest args
- Emit a signal named signal-name with args.
-
-To define a function called when a signal is emitted, use
-riece-connect-signal.
-
-- riece-connect-signal signal-name slot-function &optional
- filter-function handback
-
- Give a signal a slot-function. The slot-function gets two
- arguments: the signal object itself and a handback object given as
- the fourth argument of riece-connect-signal.
-
- If the third argument filter-function is specified, the
- slot-function is called conditionally. The filter-function gets the
- signal object and returns nil or t. If the return value is nil, the
- slot-function is not called.
-
-To access to a signal object, use the following functions.
-
-- riece-signal-name signal
- Return the name of a signal.
-
-- riece-signal-args
- Return the data of a signal.
-
-Below is a list of signal names reserved.
-
-- channel-list-changed
- Need update the channel list.
-
-- user-list-changed
- Need update the user list.
- (This signal gets a riece-identity object as an argument which
- represents the channel.)
-
-- channel-switched
- A user selected another channel.
-
-- user-joined-channel
- A user joined a channel.
- (This signal gets two riece-identity objects as arguments
- corresponding to the user and the channel respectively.)
-
-- user-left-channel
- A user left a channel.
- (This signal gets two riece-identity objects as arguments
- corresponding to the user and the channel respectively.)
-
-- user-renamed
- A user changed his nickname.
- (This signal gets two riece-identity objects as arguments
- corresponding to the old and the new nickname respectively.)
-
-- user-away-changed
- A user changed his AWAY status.
- (This signal gets a riece-identity object as an argument which
- represents the user.)
-
-- user-operator-changed
- A user changed his IRC operator status.
- (This signal gets a riece-identity object as an argument which
- represents the user.)
-
-- channel-topic-changed
- A topic of a channel changed.
- (This signal gets a riece-identity object as an argument which
- represents the channel.)
-
-- channel-modes-changed
- Modes of a channel changed.
- (This signal gets a riece-identity object as an argument which
- represents the channel.)
-
-- channel-operators-changed
- A list of operators in a channel changed.
- (This signal gets a riece-identity object as an argument which
- represents the channel.)
-
-- channel-speakers-changed
- A list of users who have the right to speak in a channel changed.
- (This signal gets a riece-identity object as an argument which
- represents the channel.)
-
-- buffer-freeze-changed
- A buffer is frozen or unfrozen.
- (This signal gets a buffer as an argument.)
-
-** Writing add-ons
-
-Elisp modules that satisfy add-on spec should provide the following
-functions.
-
-- <module-name>-requires (optional)
- Return a list of names of other add-ons this add-on depends.
-
-- <module-name>-insinuate
- Called on initialization of this module.
-
-- <module-name>-uninstall (optional)
- Called on uninstallation of this module.
-
-- <module-name>-enable (optional)
- Called when this add-on is enabled.
-
-- <module-name>-disable (optional)
- Called when this add-on is disabled.
-
-It is recommended to set short explanation of the add-on to
-<module-name>-description variable which is displayed on add-on
-listing shown up by C-c ^ (M-x riece-command-list-addons).
-
-To see the add-on's enabled/disabled status, check riece-addon-enabled
-property set on <module-name> symbol.
-
-Riece does the following procedure on add-ons when startup.
-
-(1) Load add-ons listed in the riece-addons variable.
-
-(2) Call <module-name>-requires on each add-on (if exists) and build a
- dependency graph.
-
-(3) Sort the dependency graph.
-
-(4) Call <module-name>-insinuate on each add-on in order of the
- dependencies.
-
-(5) Call <module-name>-enable on each add-on, iff it supports
- enabling/disabling and is not disabled explicitly.
-
-Add-ons are loaded from directories listed in load-path, or from
-~/.riece/addons/.
-
-** Handler hooks
-
-There are hooks called "handler hooks " which have special meaning in
-Riece. Handler hooks are called before/after processing IRC messages.
-
-- riece-<message>-hook
- Called before processing an IRC message.
-
-- riece-after-<message>-hook
- Called after processing an IRC message.
-
-Where <message> is a type of IRC message and consists only lowercase
-characters.
-
-If riece-<message>-hook returns non-nil, <message> is not processed.
-In this case riece-after-<message>-hook is not called.
-
-Handler hooks gets two arguments corresponding to prefix and
-parameters in RFC2812.
+++ /dev/null
--*- mode: text; coding: iso-2022-jp -*-
-
-\e$B$3$NJ8=q$G$O!"\e(BRiece \e$B$N3+H/%W%m%;%9$dFbIt9=B$$J$I!"3+H/$KI,MW$J>pJs$r$^\e(B
-\e$B$H$a$F$$$^$9!#\e(B
-
-* \e$B3+H/%W%m%;%9\e(B
-
-** \e$B%P%0Js9p\e(B
-
-\e$B%P%0Js9p$O!"%D!<%k%P!<$NCn$N%"%$%3%s$r%/%j%C%/$9$k$+!"\e(B
-M-x riece-submit-bug-report \e$B$G:n@.$7$F$/$@$5$$!#$^$?!"%P%0Js9p$N:n@.$N\e(B
-\e$BA0$K%G%P%C%0=PNO$rM-8z$K$7$F$*$/I,MW$,$"$j$^$9!#\e(B
-
-** \e$B%G%P%C%0=PNO\e(B
-
-\e$BJQ?t\e(B riece-debug \e$B$r\e(B t \e$B$K@_Dj$9$k$H!"\e(BRiece \e$B$N<B9TCf$K%G%P%C%0>pJs$,=PNO\e(B
-\e$B$5$l$k$h$&$K$J$j$^$9!#%G%P%C%0>pJs$O\e(B *Debug* \e$B%P%C%U%!$KC_@Q$5$l$^$9!#\e(B
-
-\e$B$^$?!"\e(BIRC \e$B%5!<%P$H$N$d$j$H$j$,\e(B " *IRC*<IRC \e$B%5!<%P$NL>A0\e(B>" \e$B%P%C%U%!$KC_\e(B
-\e$B@Q$5$l$^$9!#%P%C%U%!$NL>A0$,6uGr\e(B " " \e$B$G;O$^$k$3$H$K$4Cm0U$/$@$5$$!#\e(B
-
-** \e$B3+H/$X$N;22C\e(B
-
-\e$B%Q%C%A$+%"%I%*%s$r=q$$$FAw$C$F$/$@$5$$!#E,@Z$J$b$N$G$"$l$P<h$j9~$_$^$9!#\e(B
-
-** CVS
-
-Riece \e$B$N3+H/$K$O\e(B CVS \e$B$rMxMQ$7$F$$$^$9!#8x3+\e(B CVS \e$B%5!<%P$+$i:G?7HG$N%=!<\e(B
-\e$B%9%3!<%I$r<hF@$9$k$K$O0J2<$N$h$&$K$7$^$9!#\e(B
-
-CVS \e$BHG$N%=!<%9%3!<%I$O!"$"$/$^$G3+H/ES>e$N$b$N$G$"$j!"MxMQ$O8D?M$N@UG$\e(B
-\e$B$G$*4j$$$7$^$9!#\e(BCVS \e$BHG$K4X$9$k%P%0Js9p$O<u$1IU$1$^$;$s!#\e(B
-
-(1) CVS \e$B%5!<%P$X$N%m%0%$%s\e(B
-
- cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root login
- CVS password: [CR] # NULL string
-
-(2) \e$B%b%8%e!<%k$N%A%'%C%/%"%&%H\e(B
-
- cvs -d :pserver:anonymous@cvs.m17n.org:/cvs/root checkout riece
-
-(3) configure \e$B%9%/%j%W%H$N@8@.\e(B
-
- autoreconf -f -i -v
-
-\e$B$3$N:n6H$K$O:G?7$N\e(B GNU Automake \e$B$,I,MW$+$b$7$l$^$;$s!#\e(B
-
-* \e$BFbIt9=B$\e(B
-
-** \e$B%b%8%e!<%k$N9=@.\e(B
-
-Riece \e$B$r9=@.$9$k\e(B elisp \e$B%b%8%e!<%k$r0J2<$KNs5s$7$^$9!#0MB84X78$N>e0L$K\e(B
-\e$B$"$k$b$N$r@h$K5s$2$^$9!#\e(B
-
-- riece-globals
- \e$BBg0hJQ?t$NDj5A\e(B
-
-- riece-options
- \e$B%f!<%6%*%W%7%g%s$NDj5A\e(B
-
-- riece-version
- \e$B%P!<%8%g%s$NDj5A\e(B
-
-- riece-coding
- \e$B%3!<%G%#%s%0%7%9%F%`4XO"$N4X?t$NDj5A\e(B
-
-- riece-complete
- \e$B%_%K%P%C%U%!$G$NJd40$r=u$1$k4X?t$NDj5A\e(B
-
-- riece-addon
- \e$B%"%I%*%s4IM}\e(B
-
-- riece-mode
- riece-channel/riece-user \e$B%*%V%8%'%/%H$N%b!<%I4IM}\e(B
-
-- riece-identity
- riece-channel/riece-user \e$B%*%V%8%'%/%H\e(B \e$B$NBg0hI=5-$rA`:n$9$k4X?t$NDj5A\e(B
-
-- riece-channel
- riece-channel \e$B%*%V%8%'%/%H\e(B \e$B4XO"$NDj5A\e(B
-
-- riece-user
- riece-user \e$B%*%V%8%'%/%H\e(B \e$B4XO"$NDj5A\e(B
-
-- riece-misc
- \e$B;(B?$J4X?t$NDj5A\e(B
-
-- riece-signal
- \e$B%7%0%J%k4IM}\e(B
-
-- riece-layout
- \e$B%&%#%s%I%&%l%$%"%&%H4IM}\e(B
-
-- riece-display
- \e$BI=<(MQ%P%C%U%!$N4IM}\e(B
-
-- riece-server
- IRC \e$B%5!<%P$H$N@\B34IM}\e(B
-
-- riece-naming
- \e$B%A%c%s%M%k$X$N%f!<%6$N;22C!&N%C&$r4IM}$9$k\e(B mediator
-
-- riece-message
- riece-message \e$B%*%V%8%'%/%H\e(B \e$B4XO"$NDj5A\e(B
-
-- riece-filter
- \e$B%W%m%;%9%U%#%k%?$N%(%s%H%j%]%$%s%H\e(B
-
-- riece-handle
- \e$BDL>o$N%a%C%;!<%8$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-000
- 000\e$BHVBf$N\e(B numeric reply \e$B$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-200
- 200\e$BHVBf$N\e(B numeric reply \e$B$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-300
- 300\e$BHVBf$N\e(B numeric reply \e$B$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-400
- 400\e$BHVBf$N\e(B numeric reply \e$B$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-500
- 500\e$BHVBf$N\e(B numeric reply \e$B$N%O%s%I%i!#\e(Briece-filter \e$B$+$i8F$P$l$k\e(B
-
-- riece-commands
- \e$B%3%^%s%I$NDj5A\e(B
-
-- riece-irc
- IRC \e$B%W%m%H%3%k$KBP1~$7$?\e(B process-filter \e$B$J$I$N@_Dj\e(B
-
-- riece
- \e$B5/F0;~$N%(%s%H%j%]%$%s%H!#3F%P%C%U%!$N%a%8%c!<%b!<%I$N@_Dj$J$I\e(B
-
-** \e$BL>A06u4V$N4IM}\e(B
-
-Riece \e$B$OF1;~$KJ#?t$N\e(B IRC \e$B%5!<%P$K@\B3$G$-$k$N$G!"\e(BIRC \e$B%5!<%PKh$KJL!9$N\e(B
-\e$BL>A06u4V$r4IM}$9$kI,MW$,$"$j$^$9!#$3$N$h$&$JL>A06u4V$K$O!"\e(BIRC \e$B%5!<%P$H\e(B
-\e$B$N@\B3%W%m%;%9$K7k$SIU$1$i$l$?%P%C%U%!$N%m!<%+%kJQ?t$r2p$7$F%"%/%;%9$7\e(B
-\e$B$^$9!#\e(B
-
-*** \e$B%W%m%;%9%P%C%U%!$N<hF@\e(B
-
-IRC \e$B%5!<%P$H$N@\B3%W%m%;%9$r<hF@$9$k$K$O\e(B IRC \e$B%5!<%P$NL>A0$rCN$kI,MW$,\e(B
-\e$B$"$j$^$9!#\e(BIRC \e$B%5!<%P$NL>A0$O0J2<$K5s$2$k$$$/$D$+$NJ}K!$G<hF@$G$-$^$9!#\e(B
-
-(1) \e$BJQ?t\e(B riece-overrinding-server-name \e$B$NCM\e(B
-
-(2) \e$BJQ?t\e(B riece-server-name \e$B$NCM\e(B
-
- riece-server-name \e$B$,%+%l%s%H%P%C%U%!$N%m!<%+%kJQ?t$G$"$k$J$i$P!"4{$K%W\e(B
- \e$B%m%;%9$N%P%C%U%!$K$$$k$H$_$J$;$k$N$G!"\e(Briece-server-name \e$B$NCM$=$N$b$N\e(B
-
-(3) \e$BA*BrCf$N%A%c%s%M%k$rI=$9\e(B riece-identity \e$B%*%V%8%'%/%H$+$i@Z$j=P$7$?\e(B
- IRC \e$B%5!<%P$NL>A0\e(B
-
-\e$B$3$&$7$F<hF@$7$?\e(B IRC \e$B%5!<%P$NL>A0$r0z?t$K4X?t\e(B riece-server-process \e$B$r\e(B
-\e$B8F=P$7!"%5!<%P$N%W%m%;%9$r<hF@$7$^$9!#\e(B
-
-*** riece-identity \e$B%*%V%8%'%/%H\e(B
-
-\e$BJ#?t$N\e(B IRC \e$B%5!<%P$K@\B3$7$F$$$k>l9g!"%A%c%s%M%kL>$d%K%C%/%M!<%`$rBg0h\e(B
-\e$BE*$K6hJL$9$kI,MW$,@8$8$^$9!#$3$N$h$&$JL>A0$rI=8=$9$k$N$,\e(B
-riece-identity \e$B%*%V%8%'%/%H$G$9!#\e(B
-
-riece-identity \e$B%*%V%8%'%/%H$O0J2<$N\e(B 2 \e$B$D$NMWAG$r$b$D%Y%/%?!<$G$9!#\e(B
-
-- prefix
- \e$B%A%c%s%M%kL>$d%K%C%/%M!<%`$J$I!"\e(BIRC \e$B%5!<%P$K8GM-$NL>A0\e(B
-
-- server
- IRC \e$B%5!<%P$NL>A0\e(B
-
-riece-identity \e$B%*%V%8%'%/%H$KE,MQ2DG=$JA`:n$K$O0J2<$N$h$&$J$b$N$,$"$j$^$9!#\e(B
-
-- riece-make-identity prefix &optional server
- riece-identity \e$B%*%V%8%'%/%H$r?75,$K:n@.$7$^$9!#\e(Bserver \e$B0z?t$,>JN,$5$l$?\e(B
- \e$B>l9g$K$O!"4X?t\e(B riece-find-server-name \e$B$G<hF@$7$?%5!<%PL>$r;H$$$^$9\e(B
-
-- riece-identity-prefix identity
- riece-identity \e$B%*%V%8%'%/%H$+$i\e(B IRC \e$B%5!<%P$K8GM-$NL>A0$r@Z$j=P$7$^$9!#\e(B
-
-- riece-identity-server identity
- riece-identity \e$B%*%V%8%'%/%H$+$i%5!<%P$NL>A0$r@Z$j=P$7$^$9!#\e(B
-
-- riece-identity-equal ident1 ident2
- 2 \e$B$D$N\e(B riece-identity \e$B%*%V%8%'%/%H$,F1Ey$G$"$k$+D4$Y$^$9!#\e(B
-
-- riece-identity-equal-no-server ident1 ident2
- 2 \e$B$D$N\e(B riece-identity \e$B%*%V%8%'%/%H$N!"\e(BIRC \e$B%5!<%P$K8GM-$NL>A0$,F1Ey$G$"\e(B
- \e$B$k$+D4$Y$^$9!#\e(B
-
-- riece-identity-member elt list
- riece-identity \e$B%*%V%8%'%/%H\e(B elt \e$B$,\e(B list \e$B$K4^$^$l$k$+D4$Y$^$9!#\e(B
-
-*** \e$B%A%c%s%M%k$H%f!<%6$N4IM}\e(B
-
-riece-identity \e$B%*%V%8%'%/%H$+$i@Z$j=P$5$l$?\e(B IRC \e$B%5!<%P$K8GM-$NL>A0!"$9\e(B
-\e$B$J$o$A%A%c%s%M%kL>$H$H%K%C%/%M!<%`$K$h$jI=$o$5$l$k%A%c%s%M%k$H%f!<%6$N\e(B
-\e$B<BBN$O$=$l$>$l\e(B riece-channel \e$B%*%V%8%'%/%H$H\e(B riece-user \e$B%*%V%8%'%/%H$G\e(B
-\e$BI=8=$5$l$^$9!#\e(B
-
-**** riece-channel \e$B%*%V%8%'%/%H\e(B
-
-riece-channel \e$B$O%A%c%s%M%k$rI=$9%*%V%8%'%/%H$G!"0J2<$NMWAG$r;}$A$^$9!#\e(B
-
-- users
- \e$B;22C$7$F$$$k%f!<%6$N%K%C%/%M!<%`$N%j%9%H\e(B
-
-- operators
- \e$B%*%Z%l!<%?8"8B$r$b$D%f!<%6$N%K%C%/%M!<%`$N%j%9%H\e(B
-
-- speakers
- \e$BH/8@8"$r$b$D%f!<%6$N%K%C%/%M!<%`$N%j%9%H\e(B
-
-- modes
- \e$B%A%c%s%M%k$N%b!<%I\e(B
-
-- banned
- MODE +b \e$B$G;XDj$5$l$?%Q%?!<%s$N0lMw\e(B
-
-- invited
- MODE +I \e$B$G;XDj$5$l$?%Q%?!<%s$N0lMw\e(B
-
-- uninvited
- MODE +e \e$B$G;XDj$5$l$?%Q%?!<%s$N0lMw\e(B
-
-**** riece-user \e$B%*%V%8%'%/%H\e(B
-
-riece-user \e$B$O!"\e(BIRC \e$B$K;22C$7$F$$$k%f!<%6$rI=$9%*%V%8%'%/%H$G!"0J2<$NMW\e(B
-\e$BAG$r;}$A$^$9!#\e(B
-
-- channels
- \e$B;22C$7$F$$$k%A%c%s%M%kL>$N%j%9%H\e(B
-
-- user-at-host
- "<user>@<host>" \e$B$N7A$GM?$($i$l$k%f!<%6$N@\B3>pJs\e(B
-
-- modes
- \e$B%f!<%6$N%b!<%I\e(B
-
-- away
- \e$BN%@JCf$+$I$&$+\e(B
-
-**** Mediator \e$B%Q%?!<%s\e(B
-
-\e$B%A%c%s%M%k$X$N%f!<%6$N;22C!&N%C&$r4IM}$9$k$?$a$K!"\e(B riece-naming \e$B%b%8%e!<\e(B
-\e$B%k$r;H$$$^$9!#\e(Briece-naming \e$B$O!"%G%6%$%s%Q%?!<%s$G$$$&$H$3$m$N\e(B Mediator
-\e$B%Q%?!<%s$KAjEv$9$k$b$N$G$9!#\e(B
-
-riece-naming \e$B$r2p$9$k$3$H$G!"A0=R$N\e(B riece-channel, riece-user \e$B%*%V%8%'\e(B
-\e$B%/%H$rD>@\A`:n$9$k$3$H$J$/!"0BA4$KL>A06u4V$K%"%/%;%9$9$k$3$H$,$G$-$^$9!#\e(B
-
-riece-naming \e$B$,Ds6!$9$k<g$J4X?t$O0J2<$N\e(B 3 \e$B$D$G$9!#\e(B
-
-- riece-naming-assert-join user-name channel-name
- \e$B%f!<%6$,%A%c%s%M%k$K;22C$7$?$3$H$rI=L@$7$^$9\e(B
-
-- riece-naming-assert-part user-name channel-name
- \e$B%f!<%6$,%A%c%s%M%k$+$iN%C&$7$?$3$H$rI=L@$7$^$9\e(B
-
-- riece-naming-assert-rename old-name new-name
- \e$B%f!<%6$NL>A0$,JQ99$5$l$?$3$H$rI=L@$7$^$9\e(B
-
-** \e$B%7%0%J%k\e(B
-
-\e$B%7%0%J%k$H$O!"2hLL$N:FIA2h$r8zN(NI$/9T$&$?$a$K!"%$%Y%s%H$HIA2hBP>]$N%*\e(B
-\e$B%V%8%'%/%H\e(B(\e$B%P%C%U%!$d!"%b!<%I%i%$%s$N0u\e(B)\e$B$r7k$SIU$1$k5!9=$G$9!#\e(B
-
-\e$B%&%#%s%I%&$N:FIA2h$rH<$&%$%Y%s%H$,H/@8$9$k$H!"%7%0%J%k$,Aw=P$5$l$^$9!#\e(B
-\e$B%7%0%J%k$N35G0$O!"\e(BQt \e$B$d\e(B GTK+ \e$B$H$$$C$?0lHLE*$J\e(B GUI \e$B%D!<%k%-%C%H$KMQ0U$5\e(B
-\e$B$l$F$$$k$b$N$HF1MM$G$9!#\e(B
-
-\e$B%7%0%J%k$rAw?.$9$k$K$O!"\e(Briece-emit-signal \e$B$r;H$$$^$9!#\e(B
-
-- riece-emit-signal signal-name &rest args
- \e$B0z?t\e(B signal-name \e$B$G;X<($5$l$k%7%0%J%k$r!"0z?t\e(B args \e$B$H$H$b$KAw=P$7$^\e(B
- \e$B$9\e(B
-
-\e$B%7%0%J%k$K1~Ez$9$k=hM}$O!"\e(Briece-connect-signal \e$B$r;H$C$FDj5A$7$^$9!#\e(B
-
-- riece-connect-signal signal-name slot-function &optional
- filter-function handback
-
- \e$B0z?t\e(B signal-name \e$B$G;XDj$5$l$?%7%0%J%k$K1~Ez$9$k4X?t\e(B slot-function \e$B$r\e(B
- \e$B@_Dj$7$^$9!#\e(Bslot-function \e$B$K;XDj$5$l$?4X?t$O\e(B 2 \e$B$D$N0z?t$r<h$j$^$9!#\e(B
- \e$B$R$H$D$O%7%0%J%k$G!"$b$&0l$D$O!"0z?t\e(B handback \e$B$GM?$($i$l$?%*%V%8%'%/\e(B
- \e$B%H$,$=$N$^$^EO$5$l$^$9!#\e(B
-
- \e$B0z?t\e(B filter-function \e$B$O!"<u?.$7$?%7%0%J%k$K1~Ez$9$Y$-$+$I$&$+$rH=Dj\e(B
- \e$B$9$k4X?t$G$9!#$3$N4X?t$O0z?t$H$7$F%7%0%J%k%*%V%8%'%/%H$r<u$1<h$j!"\e(B
- nil \e$B$^$?$O\e(B t \e$B$rJV$7$^$9!#JV$jCM$,\e(B nil \e$B$N>l9g$K$O!"\e(Bslot-function \e$B$O<B\e(B
- \e$B9T$5$l$^$;$s!#\e(B
-
-\e$B%7%0%J%k%*%V%8%'%/%H$K%"%/%;%9$9$k$K$O!"0J2<$N4X?t$r;H$$$^$9!#\e(B
-
-- riece-signal-name signal
- \e$B%7%0%J%k$NL>A0$rJV$7$^$9!#\e(B
-
-- riece-signal-args
- \e$B%7%0%J%k$NAw?.;~$KM?$($i$l$?0z?t$rJV$7$^$9!#\e(B
-
-\e$B8=:_!"0J2<$N%7%0%J%k$,;HMQ$5$l$F$$$^$9!#\e(B
-
-- channel-list-changed
- \e$B;22C$7$F$$$k%A%c%s%M%k$N0lMw$NJQ2=\e(B
-
-- user-list-changed
- \e$B%A%c%s%M%k$N;22C<T0lMw$NJQ2=\e(B
- (\e$B0z?t$O%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- channel-switched
- \e$B8=:_$N%A%c%s%M%k$r0\F0\e(B
-
-- user-joined-channel
- \e$B%f!<%6$,%A%c%s%M%k$K;22C\e(B
- (\e$B0z?t$O!"%f!<%6$*$h$S%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- user-left-channel
- \e$B%f!<%6$,%A%c%s%M%k$+$iN%C&\e(B
- (\e$B0z?t$O!"%f!<%6$*$h$S%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- user-renamed
- \e$B%f!<%6$,L>A0$rJQ99\e(B
- (\e$B0z?t$O!"0JA0$H8=:_$NL>A0$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- user-away-changed
- \e$B%f!<%6$NN%@J>uBV$NJQ2=\e(B
- (\e$B0z?t$O!"%f!<%6$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- user-operator-changed
- \e$B%f!<%6$N%*%Z%l!<%?>uBV$NJQ2=\e(B
- (\e$B0z?t$O!"%f!<%6$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- channel-topic-changed
- \e$B%A%c%s%M%k$N%H%T%C%/$NJQ2=\e(B
- (\e$B0z?t$O!"%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- channel-modes-changed
- \e$B%A%c%s%M%k$N%b!<%I$NJQ2=\e(B
- (\e$B0z?t$O!"%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- channel-operators-changed
- \e$B%A%c%s%M%k$G%*%Z%l!<%?8"8B$r;}$D%f!<%6$N0lMw$NJQ2=\e(B
- (\e$B0z?t$O!"%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- channel-speakers-changed
- \e$B%A%c%s%M%k$GH/8@8"$r;}$D%f!<%6$N0lMw$NJQ2=\e(B
- (\e$B0z?t$O!"%A%c%s%M%k$KAjEv$9$k\e(B riece-identity \e$B%*%V%8%'%/%H\e(B)
-
-- buffer-freeze-changed
- \e$B%P%C%U%!$NE`7k>uBV$NJQ2=\e(B
- (\e$B0z?t$O%P%C%U%!\e(B)
-
-** \e$B%"%I%*%s$N=q$-J}\e(B
-
-\e$B%"%I%*%s$N>r7o$rK~$?$9%b%8%e!<%k$O0J2<$N4X?t$rDs6!$7$^$9!#\e(B
-
-- <\e$B%b%8%e!<%kL>\e(B>-requires (\e$B%*%W%7%g%s\e(B)
- \e$B0MB8$9$kB>$N%"%I%*%s\e(B(\e$B%7%s%\%k$N%j%9%H\e(B)\e$B$rJV$7$^$9\e(B
-
-- <\e$B%b%8%e!<%kL>\e(B>-insinuate
- \e$B=i4|2==hM}$r9T$$$^$9\e(B
-
-- <\e$B%b%8%e!<%kL>\e(B>-uninstall (\e$B%*%W%7%g%s\e(B)
- \e$B%"%I%*%s$r%"%s%$%s%9%H!<%k$9$k$H8F$P$l$^$9\e(B
-
-- <\e$B%b%8%e!<%kL>\e(B>-enable (\e$B%*%W%7%g%s\e(B)
- \e$B%"%I%*%s$NM-8z$K$9$k$H8F$P$l$^$9\e(B
-
-- <\e$B%b%8%e!<%kL>\e(B>-disable (\e$B%*%W%7%g%s\e(B)
- \e$B%"%I%*%s$NL58z$K$9$k$H8F$P$l$^$9\e(B
-
-\e$B$^$?!"%"%I%*%s$N4JC1$J@bL@$r!"JQ?t\e(B <\e$B%b%8%e!<%kL>\e(B>-description \e$B$K@_Dj$9\e(B
-\e$B$k$HNI$$$G$7$g$&!#$3$NJ8;zNs$O\e(B C-c ^ (M-x riece-command-list-addons)
-\e$B$K$h$k%"%I%*%s$N0lMw$GI=<($5$l$^$9!#\e(B
-
-\e$B%"%I%*%s$NM-8z!&L58z$N>uBV$O!"\e(B<\e$B%b%8%e!<%kL>\e(B> \e$B$N%7%s%\%k$K\e(B
-\e$BIUM?$5$l$k\e(B riece-addon-enabled \e$B%W%m%Q%F%#$GD4$Y$k$3$H$,$G$-$^$9!#\e(B
-
-Riece \e$B$O5/F0;~$K0J2<$N=hM}$r9T$$$^$9!#\e(B
-
-(1) \e$BJQ?t\e(B riece-addons \e$B$KNs5s$5$l$?%b%8%e!<%k$rFI$_9~$`\e(B
-
-(2) \e$B$=$l$>$l$N%b%8%e!<%k$KBP$7!"\e(B<\e$B%b%8%e!<%kL>\e(B>-requires \e$B$,MQ0U\e(B
- \e$B$5$l$F$$$l$P8F$S=P$7!"0MB8%0%i%U$r:n$k\e(B
-
-(3) \e$B0MB8%0%i%U$KBP$7$F%H%]%m%8%+%k%=!<%H$r9T$&\e(B
-
-(4) \e$BF@$i$l$?0MB8=g=x$K=>$C$F\e(B <\e$B%b%8%e!<%kL>\e(B>-insinuate \e$B8F$S=P$9\e(B
-
-(5) \e$B$b$7!"%"%I%*%s$,M-8z2=!&L58z2=$KBP1~$7$F$*$j!"L@<(E*$KL58z2=$5$l$F\e(B
- \e$B$$$J$1$l$P!"\e(B<\e$B%b%8%e!<%kL>\e(B>-enable \e$B$r8F$S=P$9!#\e(B
-
-\e$B:n@.$7$?%"%I%*%s$O!"\e(Bload-path \e$B$NDL$C$?%G%#%l%/%H%j$+!"\e(B
-~/.riece/addons/ \e$B0J2<$KG[CV$9$k$HAH$_9~$_2DG=$J>uBV$K$J$j$^$9!#\e(B
-
-** \e$B%O%s%I%i%U%C%/\e(B
-
-Riece \e$B$K$O!"%O%s%I%i%U%C%/$H8F$P$l$kFCJL$J0UL#$r;}$D%U%C%/$,$"$j$^$9!#\e(B
-\e$B%O%s%I%i%U%C%/$O\e(B IRC \e$B$N%a%C%;!<%8$r<u$1<h$C$?A08e$G<B9T$5$l$^$9!#\e(B
-
-<message> \e$B$r\e(B IRC \e$B$N%a%C%;!<%8$r>.J8;z$K$7$?$b$N$H$9$k$H!"%O%s%I%i%U%C\e(B
-\e$B%/$O<!$NFs$D$G$9!#\e(B
-
-- riece-<message>-hook
- \e$B%a%C%;!<%8$,FO$$$?$H$-$K:G=i$K8F$P$l$k%U%C%/\e(B
-
-- riece-after-<message>-hook
- \e$B%a%C%;!<%8$N=hM}$,=*$o$C$?8e$K8F$P$l$k%U%C%/\e(B
-
-\e$BNc$($P!"\e(BPRIVMSG \e$B$K4X$7$F$O!"\e(Briece-privmsg-hook,
-riece-after-privmsg-hook \e$B$NFs$D$N%U%C%/$,8F$P$l$^$9!#\e(B
-
-\e$B$3$3$G\e(B riece-<message>-hook \e$B$NJV$jCM$K$O0UL#$,$"$j!"\e(Bt \e$B$rJV$9$b$N$,$"$l\e(B
-\e$B$P!"$=$N8e$N=hM}$r$*$3$J$$$^$;$s!#$^$?!"$=$N>l9g$K$O\e(B
-riece-after-<message>-hook \e$B$b8F$S=P$5$l$^$;$s!#\e(B
-
-\e$B%U%C%/$N0z?t$K$O\e(B RFC2812 \e$B$N\e(B prefix \e$B$H\e(B parameters \e$B$,EO$j$^$9!#\e(B
\ No newline at end of file
+++ /dev/null
-EXTRA_DIST = texinfo.tex infohack.el ptexinfmt.el irchat-copyright.el \
- HACKING HACKING.ja
-
-info_TEXINFOS = riece-ja.texi riece-en.texi
-
-package: all
- $(MAKE) EMACS=$(XEMACS)
-
-install-package: package
- $(MAKE) infodir=$(PACKAGEDIR)/info install
-
-%.info: %.texi
- $(EMACS) -batch -q -no-site-file -l ./infohack.el -f batch-makeinfo $<
+++ /dev/null
-
-@node GNU Free Documentation License
-@appendixsec GNU Free Documentation License
-
-@cindex FDL, GNU Free Documentation License
-@center Version 1.1, March 2000
-
-@display
-Copyright @copyright{} 2000 Free Software Foundation, Inc.
-59 Temple Place, Suite 330, Boston, MA 02111-1307, USA
-
-Everyone is permitted to copy and distribute verbatim copies
-of this license document, but changing it is not allowed.
-@end display
-
-@enumerate 0
-@item
-PREAMBLE
-
-The purpose of this License is to make a manual, textbook, or other
-written document @dfn{free} in the sense of freedom: to assure everyone
-the effective freedom to copy and redistribute it, with or without
-modifying it, either commercially or noncommercially. Secondarily,
-this License preserves for the author and publisher a way to get
-credit for their work, while not being considered responsible for
-modifications made by others.
-
-This License is a kind of ``copyleft'', which means that derivative
-works of the document must themselves be free in the same sense. It
-complements the GNU General Public License, which is a copyleft
-license designed for free software.
-
-We have designed this License in order to use it for manuals for free
-software, because free software needs free documentation: a free
-program should come with manuals providing the same freedoms that the
-software does. But this License is not limited to software manuals;
-it can be used for any textual work, regardless of subject matter or
-whether it is published as a printed book. We recommend this License
-principally for works whose purpose is instruction or reference.
-
-@item
-APPLICABILITY AND DEFINITIONS
-
-This License applies to any manual or other work that contains a
-notice placed by the copyright holder saying it can be distributed
-under the terms of this License. The ``Document'', below, refers to any
-such manual or work. Any member of the public is a licensee, and is
-addressed as ``you''.
-
-A ``Modified Version'' of the Document means any work containing the
-Document or a portion of it, either copied verbatim, or with
-modifications and/or translated into another language.
-
-A ``Secondary Section'' is a named appendix or a front-matter section of
-the Document that deals exclusively with the relationship of the
-publishers or authors of the Document to the Document's overall subject
-(or to related matters) and contains nothing that could fall directly
-within that overall subject. (For example, if the Document is in part a
-textbook of mathematics, a Secondary Section may not explain any
-mathematics.) The relationship could be a matter of historical
-connection with the subject or with related matters, or of legal,
-commercial, philosophical, ethical or political position regarding
-them.
-
-The ``Invariant Sections'' are certain Secondary Sections whose titles
-are designated, as being those of Invariant Sections, in the notice
-that says that the Document is released under this License.
-
-The ``Cover Texts'' are certain short passages of text that are listed,
-as Front-Cover Texts or Back-Cover Texts, in the notice that says that
-the Document is released under this License.
-
-A ``Transparent'' copy of the Document means a machine-readable copy,
-represented in a format whose specification is available to the
-general public, whose contents can be viewed and edited directly and
-straightforwardly with generic text editors or (for images composed of
-pixels) generic paint programs or (for drawings) some widely available
-drawing editor, and that is suitable for input to text formatters or
-for automatic translation to a variety of formats suitable for input
-to text formatters. A copy made in an otherwise Transparent file
-format whose markup has been designed to thwart or discourage
-subsequent modification by readers is not Transparent. A copy that is
-not ``Transparent'' is called ``Opaque''.
-
-Examples of suitable formats for Transparent copies include plain
-@sc{ascii} without markup, Texinfo input format, La@TeX{} input format,
-@acronym{SGML} or @acronym{XML} using a publicly available
-@acronym{DTD}, and standard-conforming simple @acronym{HTML} designed
-for human modification. Opaque formats include PostScript,
-@acronym{PDF}, proprietary formats that can be read and edited only by
-proprietary word processors, @acronym{SGML} or @acronym{XML} for which
-the @acronym{DTD} and/or processing tools are not generally available,
-and the machine-generated @acronym{HTML} produced by some word
-processors for output purposes only.
-
-The ``Title Page'' means, for a printed book, the title page itself,
-plus such following pages as are needed to hold, legibly, the material
-this License requires to appear in the title page. For works in
-formats which do not have any title page as such, ``Title Page'' means
-the text near the most prominent appearance of the work's title,
-preceding the beginning of the body of the text.
-
-@item
-VERBATIM COPYING
-
-You may copy and distribute the Document in any medium, either
-commercially or noncommercially, provided that this License, the
-copyright notices, and the license notice saying this License applies
-to the Document are reproduced in all copies, and that you add no other
-conditions whatsoever to those of this License. You may not use
-technical measures to obstruct or control the reading or further
-copying of the copies you make or distribute. However, you may accept
-compensation in exchange for copies. If you distribute a large enough
-number of copies you must also follow the conditions in section 3.
-
-You may also lend copies, under the same conditions stated above, and
-you may publicly display copies.
-
-@item
-COPYING IN QUANTITY
-
-If you publish printed copies of the Document numbering more than 100,
-and the Document's license notice requires Cover Texts, you must enclose
-the copies in covers that carry, clearly and legibly, all these Cover
-Texts: Front-Cover Texts on the front cover, and Back-Cover Texts on
-the back cover. Both covers must also clearly and legibly identify
-you as the publisher of these copies. The front cover must present
-the full title with all words of the title equally prominent and
-visible. You may add other material on the covers in addition.
-Copying with changes limited to the covers, as long as they preserve
-the title of the Document and satisfy these conditions, can be treated
-as verbatim copying in other respects.
-
-If the required texts for either cover are too voluminous to fit
-legibly, you should put the first ones listed (as many as fit
-reasonably) on the actual cover, and continue the rest onto adjacent
-pages.
-
-If you publish or distribute Opaque copies of the Document numbering
-more than 100, you must either include a machine-readable Transparent
-copy along with each Opaque copy, or state in or with each Opaque copy
-a publicly-accessible computer-network location containing a complete
-Transparent copy of the Document, free of added material, which the
-general network-using public has access to download anonymously at no
-charge using public-standard network protocols. If you use the latter
-option, you must take reasonably prudent steps, when you begin
-distribution of Opaque copies in quantity, to ensure that this
-Transparent copy will remain thus accessible at the stated location
-until at least one year after the last time you distribute an Opaque
-copy (directly or through your agents or retailers) of that edition to
-the public.
-
-It is requested, but not required, that you contact the authors of the
-Document well before redistributing any large number of copies, to give
-them a chance to provide you with an updated version of the Document.
-
-@item
-MODIFICATIONS
-
-You may copy and distribute a Modified Version of the Document under
-the conditions of sections 2 and 3 above, provided that you release
-the Modified Version under precisely this License, with the Modified
-Version filling the role of the Document, thus licensing distribution
-and modification of the Modified Version to whoever possesses a copy
-of it. In addition, you must do these things in the Modified Version:
-
-@enumerate A
-@item
-Use in the Title Page (and on the covers, if any) a title distinct
-from that of the Document, and from those of previous versions
-(which should, if there were any, be listed in the History section
-of the Document). You may use the same title as a previous version
-if the original publisher of that version gives permission.
-
-@item
-List on the Title Page, as authors, one or more persons or entities
-responsible for authorship of the modifications in the Modified
-Version, together with at least five of the principal authors of the
-Document (all of its principal authors, if it has less than five).
-
-@item
-State on the Title page the name of the publisher of the
-Modified Version, as the publisher.
-
-@item
-Preserve all the copyright notices of the Document.
-
-@item
-Add an appropriate copyright notice for your modifications
-adjacent to the other copyright notices.
-
-@item
-Include, immediately after the copyright notices, a license notice
-giving the public permission to use the Modified Version under the
-terms of this License, in the form shown in the Addendum below.
-
-@item
-Preserve in that license notice the full lists of Invariant Sections
-and required Cover Texts given in the Document's license notice.
-
-@item
-Include an unaltered copy of this License.
-
-@item
-Preserve the section entitled ``History'', and its title, and add to
-it an item stating at least the title, year, new authors, and
-publisher of the Modified Version as given on the Title Page. If
-there is no section entitled ``History'' in the Document, create one
-stating the title, year, authors, and publisher of the Document as
-given on its Title Page, then add an item describing the Modified
-Version as stated in the previous sentence.
-
-@item
-Preserve the network location, if any, given in the Document for
-public access to a Transparent copy of the Document, and likewise
-the network locations given in the Document for previous versions
-it was based on. These may be placed in the ``History'' section.
-You may omit a network location for a work that was published at
-least four years before the Document itself, or if the original
-publisher of the version it refers to gives permission.
-
-@item
-In any section entitled ``Acknowledgments'' or ``Dedications'',
-preserve the section's title, and preserve in the section all the
-substance and tone of each of the contributor acknowledgments
-and/or dedications given therein.
-
-@item
-Preserve all the Invariant Sections of the Document,
-unaltered in their text and in their titles. Section numbers
-or the equivalent are not considered part of the section titles.
-
-@item
-Delete any section entitled ``Endorsements''. Such a section
-may not be included in the Modified Version.
-
-@item
-Do not retitle any existing section as ``Endorsements''
-or to conflict in title with any Invariant Section.
-@end enumerate
-
-If the Modified Version includes new front-matter sections or
-appendices that qualify as Secondary Sections and contain no material
-copied from the Document, you may at your option designate some or all
-of these sections as invariant. To do this, add their titles to the
-list of Invariant Sections in the Modified Version's license notice.
-These titles must be distinct from any other section titles.
-
-You may add a section entitled ``Endorsements'', provided it contains
-nothing but endorsements of your Modified Version by various
-parties---for example, statements of peer review or that the text has
-been approved by an organization as the authoritative definition of a
-standard.
-
-You may add a passage of up to five words as a Front-Cover Text, and a
-passage of up to 25 words as a Back-Cover Text, to the end of the list
-of Cover Texts in the Modified Version. Only one passage of
-Front-Cover Text and one of Back-Cover Text may be added by (or
-through arrangements made by) any one entity. If the Document already
-includes a cover text for the same cover, previously added by you or
-by arrangement made by the same entity you are acting on behalf of,
-you may not add another; but you may replace the old one, on explicit
-permission from the previous publisher that added the old one.
-
-The author(s) and publisher(s) of the Document do not by this License
-give permission to use their names for publicity for or to assert or
-imply endorsement of any Modified Version.
-
-@item
-COMBINING DOCUMENTS
-
-You may combine the Document with other documents released under this
-License, under the terms defined in section 4 above for modified
-versions, provided that you include in the combination all of the
-Invariant Sections of all of the original documents, unmodified, and
-list them all as Invariant Sections of your combined work in its
-license notice.
-
-The combined work need only contain one copy of this License, and
-multiple identical Invariant Sections may be replaced with a single
-copy. If there are multiple Invariant Sections with the same name but
-different contents, make the title of each such section unique by
-adding at the end of it, in parentheses, the name of the original
-author or publisher of that section if known, or else a unique number.
-Make the same adjustment to the section titles in the list of
-Invariant Sections in the license notice of the combined work.
-
-In the combination, you must combine any sections entitled ``History''
-in the various original documents, forming one section entitled
-``History''; likewise combine any sections entitled ``Acknowledgments'',
-and any sections entitled ``Dedications''. You must delete all sections
-entitled ``Endorsements.''
-
-@item
-COLLECTIONS OF DOCUMENTS
-
-You may make a collection consisting of the Document and other documents
-released under this License, and replace the individual copies of this
-License in the various documents with a single copy that is included in
-the collection, provided that you follow the rules of this License for
-verbatim copying of each of the documents in all other respects.
-
-You may extract a single document from such a collection, and distribute
-it individually under this License, provided you insert a copy of this
-License into the extracted document, and follow this License in all
-other respects regarding verbatim copying of that document.
-
-@item
-AGGREGATION WITH INDEPENDENT WORKS
-
-A compilation of the Document or its derivatives with other separate
-and independent documents or works, in or on a volume of a storage or
-distribution medium, does not as a whole count as a Modified Version
-of the Document, provided no compilation copyright is claimed for the
-compilation. Such a compilation is called an ``aggregate'', and this
-License does not apply to the other self-contained works thus compiled
-with the Document, on account of their being thus compiled, if they
-are not themselves derivative works of the Document.
-
-If the Cover Text requirement of section 3 is applicable to these
-copies of the Document, then if the Document is less than one quarter
-of the entire aggregate, the Document's Cover Texts may be placed on
-covers that surround only the Document within the aggregate.
-Otherwise they must appear on covers around the whole aggregate.
-
-@item
-TRANSLATION
-
-Translation is considered a kind of modification, so you may
-distribute translations of the Document under the terms of section 4.
-Replacing Invariant Sections with translations requires special
-permission from their copyright holders, but you may include
-translations of some or all Invariant Sections in addition to the
-original versions of these Invariant Sections. You may include a
-translation of this License provided that you also include the
-original English version of this License. In case of a disagreement
-between the translation and the original English version of this
-License, the original English version will prevail.
-
-@item
-TERMINATION
-
-You may not copy, modify, sublicense, or distribute the Document except
-as expressly provided for under this License. Any other attempt to
-copy, modify, sublicense or distribute the Document is void, and will
-automatically terminate your rights under this License. However,
-parties who have received copies, or rights, from you under this
-License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
-@item
-FUTURE REVISIONS OF THIS LICENSE
-
-The Free Software Foundation may publish new, revised versions
-of the GNU Free Documentation License from time to time. Such new
-versions will be similar in spirit to the present version, but may
-differ in detail to address new problems or concerns. See
-@uref{http://www.gnu.org/copyleft/}.
-
-Each version of the License is given a distinguishing version number.
-If the Document specifies that a particular numbered version of this
-License ``or any later version'' applies to it, you have the option of
-following the terms and conditions either of that specified version or
-of any later version that has been published (not as a draft) by the
-Free Software Foundation. If the Document does not specify a version
-number of this License, you may choose any version ever published (not
-as a draft) by the Free Software Foundation.
-@end enumerate
-
-@page
-@appendixsubsec ADDENDUM: How to use this License for your documents
-
-To use this License in a document you have written, include a copy of
-the License in the document and put the following copyright and
-license notices just after the title page:
-
-@smallexample
-@group
- Copyright (C) @var{year} @var{your name}.
- Permission is granted to copy, distribute and/or modify this document
- under the terms of the GNU Free Documentation License, Version 1.1
- or any later version published by the Free Software Foundation;
- with the Invariant Sections being @var{list their titles}, with the
- Front-Cover Texts being @var{list}, and with the Back-Cover Texts being @var{list}.
- A copy of the license is included in the section entitled ``GNU
- Free Documentation License''.
-@end group
-@end smallexample
-
-If you have no Invariant Sections, write ``with no Invariant Sections''
-instead of saying which ones are invariant. If you have no
-Front-Cover Texts, write ``no Front-Cover Texts'' instead of
-``Front-Cover Texts being @var{list}''; likewise for Back-Cover Texts.
-
-If your document contains nontrivial examples of program code, we
-recommend releasing these examples in parallel under your choice of
-free software license, such as the GNU General Public License,
-to permit their use in free software.
-
-@c Local Variables:
-@c ispell-local-pdict: "ispell-dict"
-@c End:
-
+++ /dev/null
-;;; infohack.el --- a hack to format info file.
-;; Copyright (C) 2001 Free Software Foundation, Inc.
-
-;; Author: Shenghuo Zhu <zsh@cs.rochester.edu>
-;; Keywords: info
-
-;; 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-;(let ((default-directory (expand-file-name "../lisp/"))
-; (features (cons 'w3-forms (copy-sequence features))))
-; ;; Adjust `load-path' for APEL.
-; (load-file "dgnushack.el"))
-(load-file (expand-file-name "ptexinfmt.el" "./"))
-
-(defun infohack-remove-unsupported ()
- (goto-char (point-min))
- (while (re-search-forward "@\\(end \\)?ifnottex" nil t)
- (replace-match ""))
- (goto-char (point-min))
- (while (search-forward "\n@iflatex\n" nil t)
- (delete-region (1+ (match-beginning 0))
- (search-forward "\n@end iflatex\n"))))
-
-(defun infohack (file)
- (let ((dest-directory default-directory)
- (max-lisp-eval-depth (max max-lisp-eval-depth 600))
- coding-system)
- (find-file file)
- (setq buffer-read-only nil)
- (setq coding-system (if (boundp 'buffer-file-coding-system)
- buffer-file-coding-system
- file-coding-system))
- (infohack-remove-unsupported)
- (texinfo-every-node-update)
- (texinfo-format-buffer t) ;; Don't save any file.
- (setq default-directory dest-directory)
- (setq buffer-file-name
- (expand-file-name (file-name-nondirectory buffer-file-name)
- default-directory))
- (setq buffer-file-coding-system coding-system
- file-coding-system coding-system)
- (if (> (buffer-size) 100000)
- (Info-split))
- (save-buffer)))
-
-(eval-and-compile
- (when (string-match "windows-nt\\|os/2\\|emx\\|cygwin"
- (symbol-name system-type))
- (defun subst-char-in-region (START END FROMCHAR TOCHAR &optional NOUNDO)
- "From START to END, replace FROMCHAR with TOCHAR each time it occurs.
-If optional arg NOUNDO is non-nil, don't record this change for undo
-and don't mark the buffer as really changed.
-Both characters must have the same length of multi-byte form."
- (let ((original-buffer-undo-list buffer-undo-list)
- (modified (buffer-modified-p)))
- (if NOUNDO
- (setq buffer-undo-list t))
- (goto-char START)
- (let ((from (char-to-string FROMCHAR))
- (to (char-to-string TOCHAR)))
- (while (search-forward from END t)
- (replace-match to t t)))
- (if NOUNDO
- (progn (setq buffer-undo-list original-buffer-undo-list)
- (set-buffer-modidifed-p modified)))))))
-
-(defun batch-makeinfo ()
- "Emacs makeinfo in batch mode."
- (infohack-texi-format (car command-line-args-left)
- (car (cdr command-line-args-left)))
- (setq command-line-args-left nil))
-
-\f
-(defun infohack-texi-format (file &optional addsuffix)
- (let ((auto-save-default nil)
- (find-file-run-dired nil)
- coding-system-for-write
- output-coding-system
- (error 0))
- (condition-case err
- (progn
- (find-file file)
- (setq buffer-read-only nil)
- (buffer-disable-undo (current-buffer))
- (if (boundp 'MULE)
- (setq output-coding-system file-coding-system)
- (setq coding-system-for-write buffer-file-coding-system))
- ;; Remove ignored areas first.
- (while (re-search-forward "^@ignore[\t\r ]*$" nil t)
- (delete-region (match-beginning 0)
- (if (re-search-forward
- "^@end[\t ]+ignore[\t\r ]*$" nil t)
- (1+ (match-end 0))
- (point-max))))
- (infohack-remove-unsupported)
- (goto-char (point-min))
- ;; Add suffix if it is needed.
- (when (and addsuffix
- (re-search-forward "^@setfilename[\t ]+\\([^\t\n ]+\\)"
- nil t)
- (not (string-match "\\.info$" (match-string 1))))
- (insert ".info")
- (goto-char (point-min)))
- ;; process @include before updating node
- ;; This might produce some problem if we use @lowersection or
- ;; such.
- (let ((input-directory default-directory)
- (texinfo-command-end))
- (while (re-search-forward "^@include" nil t)
- (setq texinfo-command-end (point))
- (let ((filename (concat input-directory
- (texinfo-parse-line-arg))))
- (re-search-backward "^@include")
- (delete-region (point) (save-excursion
- (forward-line 1)
- (point)))
- (message "Reading included file: %s" filename)
- (save-excursion
- (save-restriction
- (narrow-to-region
- (point) (+ (point)
- (car (cdr (insert-file-contents filename)))))
- (goto-char (point-min))
- ;; Remove `@setfilename' line from included file,
- ;; if any, so @setfilename command not duplicated.
- (if (re-search-forward "^@setfilename"
- (save-excursion
- (forward-line 100)
- (point))
- t)
- (progn
- (beginning-of-line)
- (delete-region (point) (save-excursion
- (forward-line 1)
- (point))))))))))
- (texinfo-mode)
- (texinfo-every-node-update)
- (set-buffer-modified-p nil)
- (message "texinfo formatting %s..." file)
- (texinfo-format-buffer nil)
- (if (buffer-modified-p)
- (progn (message "Saving modified %s" (buffer-file-name))
- (save-buffer))))
- (error
- (message ">> Error: %s" (prin1-to-string err))
- (message ">> point at")
- (let ((s (buffer-substring (point) (min (+ (point) 100) (point-max))))
- (tem 0))
- (while (setq tem (string-match "\n+" s tem))
- (setq s (concat (substring s 0 (match-beginning 0))
- "\n>> "
- (substring s (match-end 0)))
- tem (1+ tem)))
- (message ">> %s" s))
- (setq error 1)))
- (kill-emacs error)))
-
-;;; infohack.el ends here
+++ /dev/null
-;;; -*- emacs-lisp -*-
-;;;
-;;; $Id: irchat-copyright.el,v 1.7 2007-03-19 09:52:59 daiki Exp $
-;;;
-(defvar irchat-copyright "
- $Id: irchat-copyright.el,v 1.7 2007-03-19 09:52:59 daiki Exp $
- Internet Relay CHAT interface for GNU Emacs
- Copyright (C) 1989 Tor Lillqvist
-
- This program 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 1, or (at your option)
- any later version.
-
- This program 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; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
- Author's email address is <tml@hemuli.atk.vtt.fi>
-
- Following people have made major improvements to irchat. Also there
- are numerous people who have given suggestions and improvements. If
- you think your name should be included here, give us a note...
- Kai Keinänen <kmk@iki.fi>
- Markku Järvinen <mta@cc.tut.fi>
- Jukka Partanen <jtp@iki.fi>
- Kim Nyberg <kny@iki.fi>
- Tero T. Mononen <tmo@iki.fi>
-
- You can ftp the latest version from cs.hut.fi:/pub/irchat
-
- There is a mailing list, irchat@cc.tut.fi for those interested
- in developments in irchat. Mail irchat-request@cc.tut.fi if you
- are interested in joining.
-
- Current team is:
- Janne Liimatainen <jsl@iki.fi>
- Tero T. Mononen <tmo@iki.fi>
- Kim Nyberg <kny@iki.fi>
- Tomi Ollila <too@iki.fi>
- Jukka Partanen <jtp@iki.fi>
- Timo J. Rinne <tri@iki.fi>
-" "Basically GPL")
-
-;;;
-;;; $Log: irchat-copyright.el,v $
-;;; Revision 1.7 2007-03-19 09:52:59 daiki
-;;; Sync riece with upstream version 3.1.2
-;;;
-;;; Revision 1.1 2003/10/22 20:07:07 ueno
-;;; (EXTRA_DIST) Add irchat-copyright.el.
-;;;
-;;; Revision 3.2 1997/02/27 10:19:14 jsl
-;;; changed irchat-nickname to irchat-real-nickname
-;;; users should only change irchat-nickname
-;;;
-;;;Revision 3.1 1997/02/24 16:00:02 tri
-;;;Promoted revision to 3.1.
-;;;
-;;; Revision 1.2 1997/02/13 09:10:47 tri
-;;; Added Domo to "current" team.
-;;;
-;;; Revision 1.1 1996/12/19 14:54:48 tri
-;;; Initial revision
-;;;
-;;; Revision 0.1.1 1995/01/15 11:43:37 tmo
-;;; Initial revision
-;;;
-;;; Revision 0.1.2 1993/07/13 11:56:52 tmo
-;;; made this file to be defvar
-;;;
-;;; Revision 0.1.2 1993/07/13 11:56:52 tmo
-;;; made this file to be defvar
-;;;
-;;; Revision 0.1.1 1993/07/10 13:23:50 tmo
-;;; Initial revision
-;;;
+++ /dev/null
-;;; ptexinfmt.el -- portable Texinfo formatter.
-
-;; Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993,
-;; 1994, 1995, 1996, 1997 Free Software Foundation, Inc.
-;; Copyright (C) 1999 Yoshiki Hayashi <yoshiki@xemacs.org>
-;; Copyright (C) 2000, 2001, 2002 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
-;; Author: TAKAHASHI Kaoru <kaoru@kaisei.org>
-;; Yoshiki Hayashi <yoshiki@xemacs.org>
-;; Katsumi Yamaoka <yamaoka@jpl.org>
-;; Maintainer: TAKAHASHI Kaoru <kaoru@kaisei.org>
-;; Created: 7 Jul 2000
-;; Keywords: maint, tex, docs, emulation, compatibility
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; Original code: Yoshiki Hayashi <yoshiki@xemacs.org>
-;; makeinfo.el (gnujdoc project)
-
-;; Support texinfmt.el 2.32 or later.
-
-;; Modified by Yamaoka not to use APEL functions.
-
-;;; Code:
-
-(require 'backquote)
-(require 'texinfmt)
-
-;;; Broken
-(defvar ptexinfmt-disable-broken-notice-flag t
- "If non-nil disable notice, when call `ptexinfmt-broken-facility'.
-This is last argument in `ptexinfmt-broken-facility'.")
-
-(put 'ptexinfmt-broken-facility 'lisp-indent-function 'defun)
-(defmacro ptexinfmt-broken-facility (facility docstring assertion
- &optional dummy)
- "Declare a symbol FACILITY is broken if ASSERTION is nil.
-DOCSTRING will be printed if ASSERTION is nil and
-`ptexinfmt-disable-broken-notice-flag' is nil."
- (` (let ((facility '(, facility))
- (docstring (, docstring))
- (assertion (eval '(, assertion))))
- (put facility 'broken (not assertion))
- (if assertion
- nil
- (put facility 'broken-docstring docstring)
- (if ptexinfmt-disable-broken-notice-flag
- nil
- (message "BROKEN FACILITY DETECTED: %s" docstring))))))
-
-(put 'ptexinfmt-defun-if-broken 'lisp-indent-function 'defun)
-(defmacro ptexinfmt-defun-if-broken (&rest args)
- "Redefine a function just like `defun' if it is considered broken."
- (let ((name (list 'quote (car args))))
- (setq args (cdr args))
- (` (prog1
- (, name)
- (if (get (, name) 'broken)
- (defalias (, name)
- (function (lambda (,@ args)))))))))
-
-(put 'ptexinfmt-defun-if-void 'lisp-indent-function 'defun)
-(defmacro ptexinfmt-defun-if-void (&rest args)
- "Define a function just like `defun' unless it is already defined."
- (let ((name (list 'quote (car args))))
- (setq args (cdr args))
- (` (prog1
- (, name)
- (if (fboundp (, name))
- nil
- (defalias (, name)
- (function (lambda (,@ args)))))))))
-
-(put 'ptexinfmt-defvar-if-void 'lisp-indent-function 'defun)
-(defmacro ptexinfmt-defvar-if-void (&rest args)
- "Define a variable just like `defvar' unless it is already defined."
- (let ((name (car args)))
- (setq args (cdr args))
- (` (prog1
- (defvar (, name))
- (if (boundp '(, name))
- nil
- (defvar (, name) (,@ args)))))))
-
-;; sort -fd
-(ptexinfmt-broken-facility texinfo-format-printindex
- "Can't sort on Mule for Windows."
- (if (and (memq system-type '(windows-nt ms-dos))
-;;; I don't know version threshold.
-;;; (string< texinfmt-version "2.37 of 24 May 1997")
- (boundp 'MULE) (not (featurep 'meadow))) ; Mule for Windows
- nil
- t))
-
-;; @var
-(ptexinfmt-broken-facility texinfo-format-var
- "Don't perse @var argument."
- (condition-case nil
- (with-temp-buffer
- (let (texinfo-enclosure-list texinfo-alias-list)
- (texinfo-mode)
- (insert "@var{@asis{foo}}\n")
- (texinfo-format-expand-region (point-min) (point-max))
- t))
- (error nil)))
-
-;; @xref
-(ptexinfmt-broken-facility texinfo-format-xref
- "Can't format @xref, 1st argument is empty."
- (condition-case nil
- (with-temp-buffer
- (let (texinfo-enclosure-list texinfo-alias-list)
- (texinfo-mode)
- (insert "@xref{, xref, , file}\n")
- (texinfo-format-expand-region (point-min) (point-max))
- t))
- (error nil)))
-
-;; @uref
-(ptexinfmt-broken-facility texinfo-format-uref
- "Parse twice @uref argument."
- (condition-case nil
- (with-temp-buffer
- (let (texinfo-enclosure-list texinfo-alias-list)
- (texinfo-mode)
- (insert "@uref{mailto:foo@@noncommand.example.com}\n")
- (texinfo-format-expand-region (point-min) (point-max))
- t))
- (error nil)))
-
-;; @multitable
-(ptexinfmt-broken-facility texinfo-multitable-widths
- "`texinfo-multitable-widths' unsupport wide-char."
- (if (fboundp 'texinfo-multitable-widths)
- (with-temp-buffer
- (let ((str "\e$BI}9-J8;z\e(B"))
- (texinfo-mode)
- (insert (format " {%s}\n" str))
- (goto-char (point-min))
- (if (= (car (texinfo-multitable-widths)) (length str))
- nil
- t)))
- ;; function definition is void
- t))
-
-(ptexinfmt-broken-facility texinfo-multitable-item
- "`texinfo-multitable-item' unsupport wide-char."
- (not (get 'texinfo-multitable-widths 'broken)))
-
-
-;;; Hardcopy and HTML (discard)
-;; html
-(put 'documentlanguage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'documentencoding 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'documentdescription 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; size
-(put 'smallbook 'texinfo-format 'texinfo-discard-line)
-(put 'letterpaper 'texinfo-format 'texinfo-discard-line)
-(put 'afourpaper 'texinfo-format 'texinfo-discard-line)
-(put 'afourlatex 'texinfo-format 'texinfo-discard-line)
-(put 'afourwide 'texinfo-format 'texinfo-discard-line)
-(put 'afivepaper 'texinfo-format 'texinfo-discard-line)
-(put 'pagesizes 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; style
-(put 'setchapternewpage 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'kbdinputstyle 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; flags
-(put 'setcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
-(put 'setshortcontentsaftertitlepage 'texinfo-format 'texinfo-discard-line)
-(put 'novalidate 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; head & foot
-(put 'headings 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'evenfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'evenheading 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'oddfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'oddheading 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'everyfooting 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'everyheading 'texinfo-format 'texinfo-discard-line-with-args)
-
-;; misc
-(put 'page 'texinfo-format 'texinfo-discard-line)
-(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
-
-;; @tie{} (makeinfo 4.3 or later)
-(put 'tie 'texinfo-format 'texinfo-format-tie)
-(ptexinfmt-defun-if-void texinfo-format-tie ()
- (texinfo-parse-arg-discard)
- (insert " "))
-
-\f
-;;; Directory File
-;; @direcategory
-(put 'dircategory 'texinfo-format 'texinfo-format-dircategory)
-(ptexinfmt-defun-if-void texinfo-format-dircategory ()
- (let ((str (texinfo-parse-arg-discard)))
- (delete-region (point)
- (progn
- (skip-chars-forward " ")
- (point)))
- (insert "INFO-DIR-SECTION " str "\n")))
-
-;; @direntry
-(put 'direntry 'texinfo-format 'texinfo-format-direntry)
-(ptexinfmt-defun-if-void texinfo-format-direntry ()
- (texinfo-push-stack 'direntry nil)
- (texinfo-discard-line)
- (insert "START-INFO-DIR-ENTRY\n"))
-
-(put 'direntry 'texinfo-end 'texinfo-end-direntry)
-(ptexinfmt-defun-if-void texinfo-end-direntry ()
- (texinfo-discard-command)
- (insert "END-INFO-DIR-ENTRY\n\n")
- (texinfo-pop-stack 'direntry))
-
-
-;;; Block Enclosing
-;; @detailmenu ... @end detailmenu
-(put 'detailmenu 'texinfo-format 'texinfo-discard-line)
-(put 'detailmenu 'texinfo-end 'texinfo-discard-command)
-
-;; @smalldisplay ... @end smalldisplay
-(put 'smalldisplay 'texinfo-format 'texinfo-format-example)
-(put 'smalldisplay 'texinfo-end 'texinfo-end-example)
-
-;; @smallformat ... @end smallformat
-(put 'smallformat 'texinfo-format 'texinfo-format-flushleft)
-(put 'smallformat 'texinfo-end 'texinfo-end-flushleft)
-
-;; @cartouche ... @end cartouche
-(put 'cartouche 'texinfo-format 'texinfo-discard-line)
-(put 'cartouche 'texinfo-end 'texinfo-discard-command)
-
-
-;;; Conditional
-;; @ifnottex ... @end ifnottex (makeinfo 3.11 or later)
-(put 'ifnottex 'texinfo-format 'texinfo-discard-line)
-(put 'ifnottex 'texinfo-end 'texinfo-discard-command)
-
-;; @ifnothtml ... @end ifnothtml (makeinfo 3.11 or later)
-(put 'ifnothtml 'texinfo-format 'texinfo-discard-line)
-(put 'ifnothtml 'texinfo-end 'texinfo-discard-command)
-
-;; @ifnotplaintext ... @end ifnotplaintext (makeinfo 4.2 or later)
-(put 'ifnotplaintext 'texinfo-format 'texinfo-discard-line)
-(put 'ifnotplaintext 'texinfo-end 'texinfo-discard-command)
-
-
-;; @ifnotinfo ... @end ifnotinfo (makeinfo 3.11 or later)
-(put 'ifnotinfo 'texinfo-format 'texinfo-format-ifnotinfo)
-(ptexinfmt-defun-if-void texinfo-format-ifnotinfo ()
- (delete-region texinfo-command-start
- (progn (re-search-forward "@end ifnotinfo[ \t]*\n")
- (point))))
-
-;; @html ... @end html (makeinfo 3.11 or later)
-(put 'html 'texinfo-format 'texinfo-format-html)
-(ptexinfmt-defun-if-void texinfo-format-html ()
- (delete-region texinfo-command-start
- (progn (re-search-forward "@end html[ \t]*\n")
- (point))))
-
-;; @ifhtml ... @end ifhtml (makeinfo 3.8 or later)
-(put 'ifhtml 'texinfo-format 'texinfo-format-ifhtml)
-(defun texinfo-format-ifhtml ()
- (delete-region texinfo-command-start
- (progn (re-search-forward "@end ifhtml[ \t]*\n")
- (point))))
-
-;; @ifplaintext ... @end ifplaintext (makeinfo 4.2 or later)
-(put 'ifplaintext 'texinfo-format 'texinfo-format-ifplaintext)
-(ptexinfmt-defun-if-void texinfo-format-ifplaintext ()
- (delete-region texinfo-command-start
- (progn (re-search-forward "@end ifplaintext[ \t]*\n")
- (point))))
-
-
-\f
-;;; Marking
-;; @url, @env, @command
-(put 'url 'texinfo-format 'texinfo-format-code)
-(put 'env 'texinfo-format 'texinfo-format-code)
-(put 'command 'texinfo-format 'texinfo-format-code)
-
-;; @acronym
-(put 'acronym 'texinfo-format 'texinfo-format-var)
-
-(ptexinfmt-defun-if-broken texinfo-format-var ()
- (let ((arg (texinfo-parse-expanded-arg)))
- (texinfo-discard-command)
- (insert (upcase arg))))
-
-;; @key
-(put 'key 'texinfo-format 'texinfo-format-key)
-(ptexinfmt-defun-if-void texinfo-format-key ()
- (insert (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @email{EMAIL-ADDRESS[, DISPLAYED-TEXT]}
-(put 'email 'texinfo-format 'texinfo-format-email)
-(ptexinfmt-defun-if-void texinfo-format-email ()
- "Format EMAIL-ADDRESS and optional DISPLAYED-TXT.
-Insert < ... > around EMAIL-ADDRESS."
- (let ((args (texinfo-format-parse-args)))
- (texinfo-discard-command)
- ;; if displayed-text
- (if (nth 1 args)
- (insert (nth 1 args) " <" (nth 0 args) ">")
- (insert "<" (nth 0 args) ">"))))
-
-;; @option
-(put 'option 'texinfo-format 'texinfo-format-option)
-(ptexinfmt-defun-if-void texinfo-format-option ()
- "Insert ` ... ' around arg unless inside a table; in that case, no quotes."
- ;; `looking-at-backward' not available in v. 18.57, 20.2
- ;; searched-for character is a control-H
- (if (not (search-backward "\010"
- (save-excursion (beginning-of-line) (point))
- t))
- (insert "`" (texinfo-parse-arg-discard) "'")
- (insert (texinfo-parse-arg-discard)))
- (goto-char texinfo-command-start))
-
-;; @verb{<char>TEXT<char>} (makeinfo 4.1 or later)
-(put 'verb 'texinfo-format 'texinfo-format-verb)
-(ptexinfmt-defun-if-void texinfo-format-verb ()
- "Format text between non-quoted unique delimiter characters verbatim.
-Enclose the verbatim text, including the delimiters, in braces. Print
-text exactly as written (but not the delimiters) in a fixed-width.
-
-For example, @verb\{|@|\} results in @ and
-@verb\{+@'e?`!`+} results in @'e?`!`."
-
- (let ((delimiter (buffer-substring-no-properties
- (1+ texinfo-command-end) (+ 2 texinfo-command-end))))
- (unless (looking-at "{")
- (error "Not found: @verb start brace"))
- (delete-region texinfo-command-start (+ 2 texinfo-command-end))
- (search-forward delimiter))
- (delete-backward-char 1)
- (unless (looking-at "}")
- (error "Not found: @verb end brace"))
- (delete-char 1))
-
-\f
-;;; Accents and Special characters
-;; @pounds{} ==> # Pounds Sterling
-(put 'pounds 'texinfo-format 'texinfo-format-pounds)
-(ptexinfmt-defun-if-void texinfo-format-pounds ()
- (texinfo-parse-arg-discard)
- (insert "#"))
-
-;; @OE{} ==> OE French-OE-ligature
-(put 'OE 'texinfo-format 'texinfo-format-French-OE-ligature)
-(ptexinfmt-defun-if-void texinfo-format-French-OE-ligature ()
- (insert "OE" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @oe{} ==> oe
-(put 'oe 'texinfo-format 'texinfo-format-French-oe-ligature)
-(ptexinfmt-defun-if-void texinfo-format-French-oe-ligature () ; lower case
- (insert "oe" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @AA{} ==> AA Scandinavian-A-with-circle
-(put 'AA 'texinfo-format 'texinfo-format-Scandinavian-A-with-circle)
-(ptexinfmt-defun-if-void texinfo-format-Scandinavian-A-with-circle ()
- (insert "AA" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @aa{} ==> aa
-(put 'aa 'texinfo-format 'texinfo-format-Scandinavian-a-with-circle)
-(ptexinfmt-defun-if-void texinfo-format-Scandinavian-a-with-circle () ; lower case
- (insert "aa" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @AE{} ==> AE Latin-Scandinavian-AE
-(put 'AE 'texinfo-format 'texinfo-format-Latin-Scandinavian-AE)
-(ptexinfmt-defun-if-void texinfo-format-Latin-Scandinavian-AE ()
- (insert "AE" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @ae{} ==> ae
-(put 'ae 'texinfo-format 'texinfo-format-Latin-Scandinavian-ae)
-(ptexinfmt-defun-if-void texinfo-format-Latin-Scandinavian-ae () ; lower case
- (insert "ae" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @ss{} ==> ss German-sharp-S
-(put 'ss 'texinfo-format 'texinfo-format-German-sharp-S)
-(ptexinfmt-defun-if-void texinfo-format-German-sharp-S ()
- (insert "ss" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @questiondown{} ==> ? upside-down-question-mark
-(put 'questiondown 'texinfo-format 'texinfo-format-upside-down-question-mark)
-(ptexinfmt-defun-if-void texinfo-format-upside-down-question-mark ()
- (insert "?" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @exclamdown{} ==> ! upside-down-exclamation-mark
-(put 'exclamdown 'texinfo-format 'texinfo-format-upside-down-exclamation-mark)
-(ptexinfmt-defun-if-void texinfo-format-upside-down-exclamation-mark ()
- (insert "!" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @L{} ==> L/ Polish suppressed-L (Lslash)
-(put 'L 'texinfo-format 'texinfo-format-Polish-suppressed-L)
-(ptexinfmt-defun-if-void texinfo-format-Polish-suppressed-L ()
- (insert (texinfo-parse-arg-discard) "/L")
- (goto-char texinfo-command-start))
-
-;; @l{} ==> l/ Polish suppressed-L (Lslash) (lower case)
-(put 'l 'texinfo-format 'texinfo-format-Polish-suppressed-l-lower-case)
-(ptexinfmt-defun-if-void texinfo-format-Polish-suppressed-l-lower-case ()
- (insert (texinfo-parse-arg-discard) "/l")
- (goto-char texinfo-command-start))
-
-;; @O{} ==> O/ Scandinavian O-with-slash
-(put 'O 'texinfo-format 'texinfo-format-Scandinavian-O-with-slash)
-(ptexinfmt-defun-if-void texinfo-format-Scandinavian-O-with-slash ()
- (insert (texinfo-parse-arg-discard) "O/")
- (goto-char texinfo-command-start))
-
-;; @o{} ==> o/ Scandinavian O-with-slash (lower case)
-(put 'o 'texinfo-format 'texinfo-format-Scandinavian-o-with-slash-lower-case)
-(ptexinfmt-defun-if-void texinfo-format-Scandinavian-o-with-slash-lower-case ()
- (insert (texinfo-parse-arg-discard) "o/")
- (goto-char texinfo-command-start))
-
-;; @,{c} ==> c, cedilla accent
-(put ', 'texinfo-format 'texinfo-format-cedilla-accent)
-(ptexinfmt-defun-if-void texinfo-format-cedilla-accent ()
- (insert (texinfo-parse-arg-discard) ",")
- (goto-char texinfo-command-start))
-
-
-;; @dotaccent{o} ==> .o overdot-accent
-(put 'dotaccent 'texinfo-format 'texinfo-format-overdot-accent)
-(ptexinfmt-defun-if-void texinfo-format-overdot-accent ()
- (insert "." (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @ubaraccent{o} ==> _o underbar-accent
-(put 'ubaraccent 'texinfo-format 'texinfo-format-underbar-accent)
-(ptexinfmt-defun-if-void texinfo-format-underbar-accent ()
- (insert "_" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @udotaccent{o} ==> o-. underdot-accent
-(put 'udotaccent 'texinfo-format 'texinfo-format-underdot-accent)
-(ptexinfmt-defun-if-void texinfo-format-underdot-accent ()
- (insert (texinfo-parse-arg-discard) "-.")
- (goto-char texinfo-command-start))
-
-;; @H{o} ==> ""o long Hungarian umlaut
-(put 'H 'texinfo-format 'texinfo-format-long-Hungarian-umlaut)
-(ptexinfmt-defun-if-void texinfo-format-long-Hungarian-umlaut ()
- (insert "\"\"" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @ringaccent{o} ==> *o ring accent
-(put 'ringaccent 'texinfo-format 'texinfo-format-ring-accent)
-(ptexinfmt-defun-if-void texinfo-format-ring-accent ()
- (insert "*" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @tieaccent{oo} ==> [oo tie after accent
-(put 'tieaccent 'texinfo-format 'texinfo-format-tie-after-accent)
-(ptexinfmt-defun-if-void texinfo-format-tie-after-accent ()
- (insert "[" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @u{o} ==> (o breve accent
-(put 'u 'texinfo-format 'texinfo-format-breve-accent)
-(ptexinfmt-defun-if-void texinfo-format-breve-accent ()
- (insert "(" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @v{o} ==> <o hacek accent
-(put 'v 'texinfo-format 'texinfo-format-hacek-accent)
-(ptexinfmt-defun-if-void texinfo-format-hacek-accent ()
- (insert "<" (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @dotless{i} ==> i dotless i and dotless j
-(put 'dotless 'texinfo-format 'texinfo-format-dotless)
-(ptexinfmt-defun-if-void texinfo-format-dotless ()
- (insert (texinfo-parse-arg-discard))
- (goto-char texinfo-command-start))
-
-;; @.
-(put '\. 'texinfo-format 'texinfo-format-\.)
-(ptexinfmt-defun-if-void texinfo-format-\. ()
- (texinfo-discard-command)
- (insert "."))
-
-;; @:
-(put '\: 'texinfo-format 'texinfo-format-\:)
-(ptexinfmt-defun-if-void texinfo-format-\: ()
- (texinfo-discard-command))
-
-;; @-
-(put '\- 'texinfo-format 'texinfo-format-soft-hyphen)
-(ptexinfmt-defun-if-void texinfo-format-soft-hyphen ()
- (texinfo-discard-command))
-
-;; @/
-(put '\/ 'texinfo-format 'texinfo-format-\/)
-(ptexinfmt-defun-if-void texinfo-format-\/ ()
- (texinfo-discard-command))
-
-\f
-;;; Cross References
-;; @ref, @xref
-(put 'ref 'texinfo-format 'texinfo-format-xref)
-
-(ptexinfmt-defun-if-broken texinfo-format-xref ()
- (let ((args (texinfo-format-parse-args)))
- (texinfo-discard-command)
- (insert "*Note ")
- (let ((fname (or (nth 1 args) (nth 2 args))))
- (if (null (or fname (nth 3 args)))
- (insert (nth 0 args) "::")
- (insert (or fname (nth 0 args)) ": ")
- (if (nth 3 args)
- (insert "(" (nth 3 args) ")"))
- (unless (null (nth 0 args))
- (insert (nth 0 args)))))))
-
-;; @uref{URL [,TEXT] [,REPLACEMENT]}
-(put 'uref 'texinfo-format 'texinfo-format-uref)
-(ptexinfmt-defun-if-broken texinfo-format-uref ()
- "Format URL and optional URL-TITLE.
-Insert ` ... ' around URL if no URL-TITLE argument;
-otherwise, insert URL-TITLE followed by URL in parentheses."
- (let ((args (texinfo-format-parse-args)))
- (texinfo-discard-command)
- ;; if url-title
- (if (nth 1 args)
- (insert (nth 1 args) " (" (nth 0 args) ")")
- (insert "`" (nth 0 args) "'"))))
-
-;; @inforef
-(put 'inforef 'texinfo-format 'texinfo-format-inforef)
-(ptexinfmt-defun-if-void texinfo-format-inforef ()
- (let ((args (texinfo-format-parse-args)))
- (texinfo-discard-command)
- (if (nth 1 args)
- (insert "*Note " (nth 1 args) ": (" (nth 2 args) ")" (car args))
- (insert "*Note " "(" (nth 2 args) ")" (car args) "::"))))
-
-
-;; @anchor
-;; don't emulation
-;; If support @anchor for Mule 2.3, We must fix informat.el and info.el:
-;; - Info-tagify suport @anthor-*-refill.
-;; - info.el support Ref in Tag table.
-(unless (get 'anchor 'texinfo-format)
- (put 'anchor 'texinfo-format 'texinfo-discard-command-and-arg))
-
-
-\f
-;;; New command definition
-;; @alias NEW=EXISTING
-(put 'alias 'texinfo-format 'texinfo-alias)
-(ptexinfmt-defun-if-void texinfo-alias ()
- (let ((start (1- (point)))
- args)
- (skip-chars-forward " ")
- (save-excursion (end-of-line) (setq texinfo-command-end (point)))
- (if (not (looking-at "\\([^=]+\\)=\\(.*\\)"))
- (error "Invalid alias command")
- (setq texinfo-alias-list
- (cons
- (cons
- (buffer-substring (match-beginning 1) (match-end 1))
- (buffer-substring (match-beginning 2) (match-end 2)))
- texinfo-alias-list))
- (texinfo-discard-command))))
-
-\f
-;;; Indent
-;; @exampleindent INDENT (makeinfo 4.0 or later)
-
-;; @paragraphindent INDENT (makeinfo 4.0 or later)
-;; INDENT: asis, 0, n
-
-;; @firstparagraphindent WORD (makeinfo 4.6 or later)
-;; WORD: none, insert
-
-
-\f
-;;; Special
-;; @image{FILENAME [, WIDTH] [, HEIGHT]}
-(put 'image 'texinfo-format 'texinfo-format-image)
-(ptexinfmt-defun-if-void texinfo-format-image ()
- ;; I don't know makeinfo parse FILENAME.
- (let ((args (texinfo-format-parse-args))
- filename)
- (when (null (nth 0 args))
- (error "Invalid image command"))
- (texinfo-discard-command)
- ;; makeinfo uses FILENAME.txt
- (setq filename (format "%s.txt" (nth 0 args)))
- (message "Reading included file: %s" filename)
- ;; verbatim for Info output
- (goto-char (+ (point) (cadr (insert-file-contents filename))))
- (message "Reading included file: %s...done" filename)))
-
-;; @hyphenation command discards an argument within braces
-(put 'hyphenation 'texinfo-format 'texinfo-discard-command-and-arg)
-(ptexinfmt-defun-if-void texinfo-discard-command-and-arg ()
- "Discard both @-command and its argument in braces."
- (goto-char texinfo-command-end)
- (forward-list 1)
- (setq texinfo-command-end (point))
- (delete-region texinfo-command-start texinfo-command-end))
-
-\f
-;;; @multitable ... @end multitable
-(ptexinfmt-defvar-if-void texinfo-extra-inter-column-width 0
- "*Number of extra spaces between entries (columns) in @multitable.")
-
-(ptexinfmt-defvar-if-void texinfo-multitable-buffer-name
- "*multitable-temporary-buffer*")
-(ptexinfmt-defvar-if-void texinfo-multitable-rectangle-name
- "texinfo-multitable-temp-")
-
-;; These commands are defined in texinfo.tex for printed output.
-(put 'multitableparskip 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitableparindent 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitablecolmargin 'texinfo-format 'texinfo-discard-line-with-args)
-(put 'multitablelinespace 'texinfo-format 'texinfo-discard-line-with-args)
-
-(put 'multitable 'texinfo-format 'texinfo-multitable)
-
-(ptexinfmt-defun-if-void texinfo-multitable ()
- "Produce multi-column tables."
-
-;; This function pushes information onto the `texinfo-stack'.
-;; A stack element consists of:
-;; - type-of-command, i.e., multitable
-;; - the information about column widths, and
-;; - the position of texinfo-command-start.
-;; e.g., ('multitable (1 2 3 4) 123)
-;; The command line is then deleted.
- (texinfo-push-stack
- 'multitable
- ;; push width information on stack
- (texinfo-multitable-widths))
- (texinfo-discard-line-with-args))
-
-(put 'multitable 'texinfo-end 'texinfo-end-multitable)
-(ptexinfmt-defun-if-void texinfo-end-multitable ()
- "Discard the @end multitable line and pop the stack of multitable."
- (texinfo-discard-command)
- (texinfo-pop-stack 'multitable))
-
-(ptexinfmt-defun-if-broken texinfo-multitable-widths ()
- "Return list of widths of each column in a multi-column table."
- (let (texinfo-multitable-width-list)
- ;; Fractions format:
- ;; @multitable @columnfractions .25 .3 .45
- ;;
- ;; Template format:
- ;; @multitable {Column 1 template} {Column 2} {Column 3 example}
- ;; Place point before first argument
- (skip-chars-forward " \t")
- (cond
- ;; Check for common misspelling
- ((looking-at "@columnfraction ")
- (error "In @multitable, @columnfractions misspelled"))
- ;; Case 1: @columnfractions .25 .3 .45
- ((looking-at "@columnfractions")
- (forward-word 1)
- (while (not (eolp))
- (setq texinfo-multitable-width-list
- (cons
- (truncate
- (1-
- (* fill-column (read (get-buffer (current-buffer))))))
- texinfo-multitable-width-list))))
- ;;
- ;; Case 2: {Column 1 template} {Column 2} {Column 3 example}
- ((looking-at "{")
- (let ((start-of-templates (point)))
- (while (not (eolp))
- (skip-chars-forward " \t")
- (let* ((start-of-template (1+ (point)))
- (end-of-template
- ;; forward-sexp works with braces in Texinfo mode
- (progn (forward-sexp 1) (1- (point)))))
- (setq texinfo-multitable-width-list
- (cons (- (progn
- (goto-char end-of-template)
- (current-column))
- (progn
- (goto-char start-of-template)
- (current-column)))
- texinfo-multitable-width-list))
- ;; Remove carriage return from within a template, if any.
- ;; This helps those those who want to use more than
- ;; one line's worth of words in @multitable line.
- (narrow-to-region start-of-template end-of-template)
- (goto-char (point-min))
- (while (search-forward "\n" nil t)
- (delete-char -1))
- (goto-char (point-max))
- (widen)
- (forward-char 1)))))
- ;;
- ;; Case 3: Trouble
- (t
- (error "\
-You probably need to specify column widths for @multitable correctly")))
- ;; Check whether columns fit on page.
- (let ((desired-columns
- (+
- ;; between column spaces
- (length texinfo-multitable-width-list)
- ;; additional between column spaces, if any
- texinfo-extra-inter-column-width
- ;; sum of spaces for each entry
- (apply '+ texinfo-multitable-width-list))))
- (if (> desired-columns fill-column)
- (error (format "\
-Multi-column table width, %d chars, is greater than page width, %d chars."
- desired-columns fill-column))))
- texinfo-multitable-width-list))
-
-;; @item A1 @tab A2 @tab A3
-(ptexinfmt-defun-if-void texinfo-multitable-extract-row ()
- "Return multitable row, as a string.
-End of row is beginning of next @item or beginning of @end.
-Cells within rows are separated by @tab."
- (skip-chars-forward " \t")
- (let* ((start (point))
- (end (progn
- (re-search-forward "@item\\|@end")
- (match-beginning 0)))
- (row (progn (goto-char end)
- (skip-chars-backward " ")
- ;; remove whitespace at end of argument
- (delete-region (point) end)
- (buffer-substring start (point)))))
- (delete-region texinfo-command-start end)
- row))
-
-(put 'multitable 'texinfo-item 'texinfo-multitable-item)
-(ptexinfmt-defun-if-void texinfo-multitable-item ()
- "Format a row within a multicolumn table.
-Cells in row are separated by @tab.
-Widths of cells are specified by the arguments in the @multitable line.
-All cells are made to be the same height.
-This command is executed when texinfmt sees @item inside @multitable."
- (let ((original-buffer (current-buffer))
- (table-widths (reverse (car (cdr (car texinfo-stack)))))
- (existing-fill-column fill-column)
- start
- end
- (table-column 0)
- (table-entry-height 0)
- ;; unformatted row looks like: A1 @tab A2 @tab A3
- ;; extract-row command deletes the source line in the table.
- (unformated-row (texinfo-multitable-extract-row)))
- ;; Use a temporary buffer
- (set-buffer (get-buffer-create texinfo-multitable-buffer-name))
- (delete-region (point-min) (point-max))
- (insert unformated-row)
- (goto-char (point-min))
-;; 1. Check for correct number of @tab in line.
- (let ((tab-number 1)) ;; one @tab between two columns
- (while (search-forward "@tab" nil t)
- (setq tab-number (1+ tab-number)))
- (if (/= tab-number (length table-widths))
- (error "Wrong number of @tab's in a @multitable row")))
- (goto-char (point-min))
-;; 2. Format each cell, and copy to a rectangle
- ;; buffer looks like this: A1 @tab A2 @tab A3
- ;; Cell #1: format up to @tab
- ;; Cell #2: format up to @tab
- ;; Cell #3: format up to eob
- (while (not (eobp))
- (setq start (point))
- (setq end (save-excursion
- (if (search-forward "@tab" nil 'move)
- ;; Delete the @tab command, including the @-sign
- (delete-region
- (point)
- (progn (forward-word -1) (1- (point)))))
- (point)))
- ;; Set fill-column *wider* than needed to produce inter-column space
- (setq fill-column (+ 1
- texinfo-extra-inter-column-width
- (nth table-column table-widths)))
- (narrow-to-region start end)
- ;; Remove whitespace before and after entry.
- (skip-chars-forward " ")
- (delete-region (point) (save-excursion (beginning-of-line) (point)))
- (goto-char (point-max))
- (skip-chars-backward " ")
- (delete-region (point) (save-excursion (end-of-line) (point)))
- ;; Temorarily set texinfo-stack to nil so texinfo-format-scan
- ;; does not see an unterminated @multitable.
- (let (texinfo-stack) ;; nil
- (texinfo-format-scan))
- (let (fill-prefix) ;; no fill prefix
- (fill-region (point-min) (point-max)))
- (setq table-entry-height
- (max table-entry-height (count-lines (point-min) (point-max))))
-;; 3. Move point to end of bottom line, and pad that line to fill column.
- (goto-char (point-min))
- (forward-line (1- table-entry-height))
- (let* ((beg (point)) ;; beginning of line
- ;; add one more space for inter-column spacing
- (needed-whitespace
- (1+
- (- fill-column
- (progn
- (end-of-line)
- (current-column)))))) ;; end of existing line
- (insert (make-string
- (if (> needed-whitespace 0) needed-whitespace 1)
- ? )))
- ;; now, put formatted cell into a rectangle
- (set (intern (concat texinfo-multitable-rectangle-name
- (int-to-string table-column)))
- (extract-rectangle (point-min) (point)))
- (delete-region (point-min) (point))
- (goto-char (point-max))
- (setq table-column (1+ table-column))
- (widen))
-;; 4. Add extra lines to rectangles so all are of same height
- (let ((total-number-of-columns table-column)
- (column-number 0)
- here)
- (while (> table-column 0)
- (let ((this-rectangle (int-to-string table-column)))
- (while (< (length this-rectangle) table-entry-height)
- (setq this-rectangle (append this-rectangle '("")))))
- (setq table-column (1- table-column)))
-;; 5. Insert formatted rectangles in original buffer
- (switch-to-buffer original-buffer)
- (open-line table-entry-height)
- (while (< column-number total-number-of-columns)
- (setq here (point))
- (insert-rectangle
- (eval (intern
- (concat texinfo-multitable-rectangle-name
- (int-to-string column-number)))))
- (goto-char here)
- (end-of-line)
- (setq column-number (1+ column-number))))
- (kill-buffer texinfo-multitable-buffer-name)
- (setq fill-column existing-fill-column)))
-
-\f
-(ptexinfmt-defun-if-broken texinfo-format-printindex ()
- (let ((indexelts (symbol-value
- (cdr (assoc (texinfo-parse-arg-discard)
- texinfo-indexvar-alist))))
- opoint)
- (insert "\n* Menu:\n\n")
- (setq opoint (point))
- (texinfo-print-index nil indexelts)
-
- (if (memq system-type '(vax-vms windows-nt ms-dos))
- (texinfo-sort-region opoint (point))
- (shell-command-on-region opoint (point) "sort -fd" 1))))
-
-(provide 'ptexinfmt)
-
-;;; ptexinfmt.el ends here
+++ /dev/null
-\input texinfo @c -*- mode: texinfo -*-
-@c %**start of header
-@setfilename riece-en.info
-@settitle Riece -- An IRC client for Emacsen --
-@c %**end of header
-@include version-en.texi
-@c @documentlanguage en
-
-@dircategory GNU Emacs Lisp
-@direntry
-* Riece-en: (riece-en). An IRC client for Emacsen
-@end direntry
-
-@ifnottex
-This file describes Riece.
-
-Copyright (C) 2003,2004,2005 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end ifnottex
-
-@tex
-
-@titlepage
-@title Riece
-
-@author by Daiki Ueno
-@page
-
-@vskip 0pt plus 1filll
-Copyright @copyright{} 2003,2004,2005 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end titlepage
-@page
-
-@end tex
-
-@node Top, Overview, (dir), (dir)
-@top Riece user's manual
-
-This manual documents Riece version @value{VERSION}. In addition to this
-manual, you may find useful information about Riece from Riece's official
-home page @uref{http://www.nongnu.org/riece/}.
-
-@menu
-* Overview:: Read me first.
-* Getting started:: Let's talk with other people.
-* Basic usage::
-* Index::
-* Function Index::
-* Variable Index::
-@end menu
-
-@node Overview, Getting started, Top, Top
-@chapter Overview
-
-Riece is a user interface for IRC (Internet Relay Chat). You should
-spell it with the first letter capitalized and pronounce it as /ri:s/.
-
-The features of Riece are as follows:
-
-@itemize @bullet
-@item
-Several IRC servers may be used at the same time.
-
-@item
-Many features built upon the extension mechanism called add-on.
-Currently 30 such add-ons are available.
-
-@item
-Installation is easy. Riece doesn't depend on other packages.
-
-@item
-Setup is easy. Automatically save/restore the configuration.
-
-@item
-Step-by-step instructions are included.
-
-@item
-Mostly compliant with the latest IRC client protocol (RFC 2812).
-@end itemize
-
-@node Getting started, Basic usage, Overview, Top
-@chapter Getting started
-
-To start Riece, follow the instruction below:
-
-@enumerate
-@item
-@kbd{M-x load-library riece}
-
-@item
-@kbd{M-x riece}
-@end enumerate
-
-In case that @samp{Cannot open load file: riece} is signalled in (1),
-you should probably have an installation problem. If you installed
-Riece from source tarball, please read README again. If you are
-trying to use a package distribution, check out the documentation.
-
-Once Riece started successfully, you will be asked the name of the IRC
-server to connect. IRC servers publicly available are taken from the
-Web pages of IRC networks:
-
-@itemize @bullet
-@item http://irc.kyoto-u.ac.jp
-@item http://freenode.net
-@end itemize
-
-You may see the following message:
-
-@example
-Nickname "ueno" already in use. Choose a new one:
-@end example
-
-In IRC, users are identified by @emph{nicknames}. If the nickname you
-selected has already used by another person, you must select the new one.
-
-In IRC, users join the @emph{channels} to start multi user
-conversation. To join a channel, type @kbd{C-c j}. On IRCnet, there
-is a channel named @samp{#Riece} where you can do some tests to get
-experienced with Riece.
-
-After you joined a channel, the layout of windows are changed to the
-following:
-
-@example
-+-----+-----------------+
-| | |
-| | |
-| (1) | (2) |
-| | |
-| | |
-+-----+-----------------+
-| | (4) |
-| +-----------------+
-| (3) | |
-| | (5) |
-| | |
-+-----+-----------------+
-@end example
-
-You can send messages by entering messages in (4). Messages from
-other persons are shown in (2).
-
-@node Basic usage, Index, Getting started, Top
-@chapter Basic usage
-
-To start Riece, you just type @kbd{M-x riece}. Then you will prompted
-for the name of an IRC server. A typical IRC network may consist of
-several IRC servers and you will need to pick up appropriate one. Most
-of IRC networks provide a list of available servers on their Web pages:
-
-@itemize @bullet
-@item http://irc.kyoto-u.ac.jp
-@item http://freenode.net
-@end itemize
-
-If your nickname is taken, you will be asked to use different one. The
-initial nickname can be set via the variable @code{riece-nickname}. By
-default, your nickname is generated from your login name.
-@vindex riece-nickname
-
-After successfully connecting to an IRC server, you can join a channel
-and talk with people there. To join a channel, type @kbd{C-c j}. By
-the way there is a channel called @samp{#Riece} on IRCnet, so feel free
-to use it for testing.
-
-Now you enter a message and it will be seen by everyone else on the
-channel. Messages from other people will appear on the top-left window.
-
-@menu
-* Windows::
-* Indicators::
-* Commands::
-* Connecting to multiple servers::
-@end menu
-
-@node Windows, Indicators, Basic usage, Basic usage
-@section Windows
-
-By default, Riece uses 5 windows to inform user of his status:
-
-@example
-+-----+-----------------+
-| | |
-| | |
-| (1) | (2) |
-| | |
-| | |
-+-----+-----------------+
-| | (4) |
-| +-----------------+
-| (3) | |
-| | (5) |
-| | |
-+-----+-----------------+
-@end example
-
-Each window is used for different purpose:
-
-@enumerate
-@item
-"user list window" (@samp{*Users XXX*}). Users on the current
-channel are listed in this window.
-
-@item
-"channel window" (@samp{*Channel XXX*}). This window keeps
-dialogues on the current channel.
-
-@item
-"channel list window" (@samp{*Channels*}). All channels you are
-joined are listed in this window.
-
-@item
-"command window" (@samp{*Commands*}). This window is used for either
-sending messages or issueing commands.
-
-@item
-"others buffer" (@samp{*Others*}). This window displays dialogues on
-channels except the current channel.
-@end enumerate
-
-@node Indicators, Commands, Windows, Basic usage
-@section Indicators
-
-Indicators are characters which indicate your status. Usually they are
-put on the left side of the modeline like:
-
-@example
-Riece: --- ueno #Riece [n]
-@end example
-
-In this case, @samp{---} are indicators. From left to right their
-meanings are:
-
-@enumerate
-@item
-You are not "away". (If you marked yourself as "away", it would be
-@samp{A})
-
-@item
-You are not an IRC operator. (If you entered operator mode, it would be
-@samp{O})
-
-@item
-The channel window is not locked.
-(If it was locked, it would be @samp{F}. If it was locked until next
-send, it would be @samp{f})
-@end enumerate
-
-@node Commands, Connecting to multiple servers, Indicators, Basic usage
-@section Commands
-
-The buffer used for sending messages is called "command buffer".
-You can issue various commands from the command buffer.
-
-@subsection IRC commands
-@table @kbd
-@item RET
-@findex riece-command-enter-message
-Send the current line. (@code{riece-command-enter-message})
-@item C-RET
-@findex riece-command-enter-message-as-notice
-Send the current line as NOTICE. (@code{riece-command-enter-message-as-notice})
-@item C-c j
-@findex riece-command-join
-Join a channel. (@code{riece-command-join})
-@item C-c C-p
-@findex riece-command-part
-Part from a channel. (@code{riece-command-part})
-@item C-c p
-@findex riece-command-enter-message-to-user
-Send the current line to particular
-user. (@code{riece-command-enter-message-to-user})
-@item C-c q
-@findex riece-command-quit
-Quit from IRC. (@code{riece-command-quit})
-@item C-c n
-@findex riece-command-change-nickname
-Change your nickname. (@code{riece-command-change-nickname})
-@item C-c f
-@findex riece-command-finger
-Get information of a user. (@code{riece-command-finger})
-@item C-c C-k
-@findex riece-command-kick
-Kick a user from the current channel. (@code{riece-command-kick})
-@item C-c i
-@findex riece-command-invite
-Invite a user to the current channel. (@code{riece-command-invite})
-@item C-c l
-@findex riece-command-list
-Issue a LIST command with specified pattern. (@code{riece-command-list})
-@item C-c C-n
-@findex riece-command-names
-Issue a NAMES command with specified pattern. (@code{riece-command-names})
-@item C-c w
-@findex riece-command-who
-Issue a WHO command with specified pattern. (@code{riece-command-who})
-@item C-c t
-@findex riece-command-topic
-Set topic of the current channel. (@code{riece-command-topic})
-@item C-c C-m
-@findex riece-command-change-mode
-Change the mode of the current channel. (@code{riece-command-change-mode})
-@item C-c o
-@findex riece-command-set-operators
-Assign channel operator privilege to a user. If a prefix argument
-(@kbd{C-u}) is given, remove the privilege from a
-user. (@code{riece-command-set-operators})
-@item C-c v
-@findex riece-command-set-speakers
-Allow a user to speak in the current channel. If a prefix argument
-(@kbd{C-u}) is given, disallow a user to
-speak. (@code{riece-command-set-speakers})
-@item C-c V
-@findex riece-version
-Display version number of Riece. If a prefix argument (@kbd{C-u}) is
-given, use User-Agent format.
-@item C-c /
-@findex riece-command-raw
-Send raw IRC command. (@code{riece-command-raw})
-@end table
-
-@subsection Window manipulating commands
-@table @kbd
-@item C-c r
-@findex riece-command-configure-windows
-Redraw windows. (@code{riece-command-configure-windows})
-@item C-c C-j
-@findex riece-command-next-channel
-Switch to the next channel in the channel
-list. (@code{riece-command-next-channel})
-@item C-c <
-@findex riece-command-previous-channel
-Switch to the previous channel in the channel
-list. (@code{riece-command-previous-channel})
-@item C-c >
-@findex riece-command-next-channel
-Switch to the next channel in the channel
-list. (@code{riece-command-next-channel})
-@item C-c ^
-@findex riece-command-list-addons
-Browse add-ons currently insinuated. (@code{riece-command-list-addons})
-@item C-c digit
-@findex riece-command-switch-to-channel-by-number
-Switch to @var{n}th channel in the channel
-list. (@code{riece-command-switch-to-channel-by-number})
-@item C-c C-c digit
-@findex riece-command-switch-to-channel-by-number
-Switch to @var{n} + 10th channel in the channel
-list. (@code{riece-command-switch-to-channel-by-number})
-@item C-c Home
-@findex riece-command-beginning-of-buffer
-Move point to the beginning of the buffer in the channel window.
-(@code{riece-command-beginning-of-buffer})
-@item C-c $
-@findex riece-command-end-of-buffer
-Move point to the end of the buffer in the channel window.
-(@code{riece-command-end-of-buffer})
-@item C-c SPC
-@findex riece-command-scroll-up
-Scroll text of the channel window up. (@code{riece-command-scroll-up})
-@item C-c DEL
-@findex riece-command-scroll-down
-Scroll text of the channel window down. (@code{riece-command-scroll-down})
-@end table
-
-@subsection Status toggle commands
-@table @kbd
-@item C-c C-t c
-@findex riece-command-toggle-channel-buffer-mode
-Toggle visibility of the channel
-window. (@code{riece-command-toggle-channel-buffer-mode})
-@item C-c C-t C
-@findex riece-command-toggle-channel-list-buffer-mode
-Toggle visibility of the channel list
-window. (@code{riece-command-toggle-channel-list-buffer-mode})
-@item C-c C-t u
-@findex riece-command-toggle-user-list-buffer-mode
-Toggle visibility of the user list
-window. (@code{riece-command-toggle-user-list-buffer-mode})
-@item C-c C-t f
-@findex riece-command-toggle-freeze
-Disable scrolling of the channel window. (@code{riece-command-toggle-freeze})
-@item C-c C-t o
-@findex riece-command-toggle-own-freeze
-Disable scrolling of the channel window until next
-send. (@code{riece-command-toggle-own-freeze})
-@item C-c C-t a
-@findex riece-command-toggle-away
-Mark or unmark yourself as "away". (@code{riece-command-toggle-away})
-@end table
-
-@node Connecting to multiple servers, , Commands, Basic usage
-@section Connecting to multiple servers
-
-One of the most important features of Riece is that users can use
-several IRC servers at the same time.
-
-The procedure to use multiple servers consists (1) connecting to the
-foreign server and (2) joinning a channel:
-
-@enumerate
-@item
-Type @kbd{C-c O} (@code{riece-command-open-server}), and then you will
-be asked the server name.
-
-@item
-Type @kbd{C-c j} (@code{riece-command-join}) to join a channel. Here
-the server name follows the channel name. To input a space character,
-use @kbd{C-q}. For example, if you want to join the channel
-@samp{#Riece} on the server @samp{irc6}, type @kbd{C-c j #Riece C-q SPC
-irc6}.
-@end enumerate
-
-If you want to send IRC command without joinning a channel, @kbd{C-c M}
-(@code{riece-command-universal-server-name-argument}) may be useful.
-
-Commands used for connection management are listed below:
-
-@table @kbd
-@item C-c O
-@findex riece-command-open-server
-Connect to the foreign server. (@code{riece-command-open-server})
-@item C-c C
-@findex riece-command-close-server
-Close the connection to the server. (@code{riece-command-close-server})
-@item C-c M
-@findex riece-command-universal-server-name-argument
-Issue a command on the specified
-server. (@code{riece-command-universal-server-name-argument})
-@end table
-
-@node Index, Function Index, Basic usage, Top
-@chapter Index
-@printindex cp
-
-@node Function Index, Variable Index, Index, Top
-@chapter Function Index
-@printindex fn
-
-@node Variable Index, , Function Index, Top
-@chapter Variable Index
-@printindex vr
-
-@summarycontents
-@contents
-@bye
-
-@c End:
+++ /dev/null
-\input texinfo @c -*- mode: texinfo; coding: iso-2022-jp -*-
-@c %**start of header
-@setfilename riece-ja.info
-@settitle Riece -- An IRC client for Emacsen --
-@c %**end of header
-@include version-ja.texi
-@c @documentlanguage ja
-
-@dircategory GNU Emacs Lisp
-@direntry
-* Riece-ja: (riece-ja). An IRC client for Emacsen
-@end direntry
-
-@ifnottex
-This file describes Riece.
-
-Copyright (C) 2003,2004,2005,2006 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end ifnottex
-
-@tex
-
-@titlepage
-@title Riece
-
-@author by Daiki Ueno
-@page
-
-@vskip 0pt plus 1filll
-Copyright @copyright{} 2003,2004,2005,2006 Daiki Ueno.
-
-Permission is granted to copy, distribute and/or modify this document
-under the terms of the GNU Free Documentation License, Version 1.1 or
-any later version published by the Free Software Foundation; with no
-Invariant Sections, with no Front-Cover Texts, and with no Back-Cover
-Texts. A copy of the license is included in the section entitled "GNU
-Free Documentation License".
-@end titlepage
-@page
-
-@end tex
-
-@node Top, Overview, (dir), (dir)
-@top Riece user's manual
-
-\e$B$3$N%^%K%e%"%k$G$O!"\e(BRiece \e$B%P!<%8%g%s\e(B @value{VERSION} \e$B$K$D$$$F2r@b$7$^$9!#\e(B
-\e$B$3$N%^%K%e%"%k$G07$&HO0O$r1[$($?>pJs$O\e(B Riece \e$B$N8x<0%[!<%`%Z!<%8\e(B
-@uref{http://www.nongnu.org/riece/} \e$B$+$iF@$i$l$k$+$b$7$l$^$;$s!#\e(B
-
-@menu
-* Overview:: \e$B$O$8$a$KFI$s$G$M\e(B
-* Getting started:: IRC \e$B%5!<%P$K@\B3$7$F2qOC$7$F$_$h$&\e(B
-* Basic usage:: \e$B4pK\E*$J;H$$J}\e(B
-* Advanced usage:: \e$B?J$s$@;H$$J}\e(B
-* Tips:: \e$BJXMx$J@_Dj\e(B
-* Index::
-* Function Index::
-* Variable Index::
-@end menu
-
-@node Overview, Getting started, Top, Top
-@chapter Overview
-
-Riece \e$B$O\e(B IRC (Internet Relay Chat) \e$B$N@$3&$G%A%c%C%H$r3Z$7$`$?$a$N%f!<%6\e(B
-\e$B%$%s%?!<%U%'!<%9$G$9!#\e(BRiece \e$B$O!V$j!<$9!W$HFI$_$^$9!#\e(B
-
-Riece \e$B$N<g$JFCD9$O0J2<$NDL$j$G$9!#\e(B
-
-@itemize @bullet
-@item \e$BJ#?t$N\e(B IRC \e$B%5!<%P$KF1;~$K@\B32DG=\e(B
-@item \e$B%"%I%*%s$K$h$j5!G=$NDI2C$d<h$j30$7$,MF0W\e(B
-@item \e$BB>$N\e(B elisp \e$B%Q%C%1!<%8$K0MB8$7$J$$$?$a!"%$%s%9%H!<%k$,4JC1\e(B
-@item \e$B@_Dj$,4JC1$G!"A02s5/F0;~$N@_Dj$r5-O?!&I|85$9$k;EAH$_$rDs6!\e(B
-@item \e$BCJ3,E*$JA`:n@bL@=q$,ImB0\e(B
-@item \e$B:G?7$N\e(B IRC \e$B$N%/%i%$%"%s%H%W%m%H%3%k\e(B (RFC2812) \e$B$K=`5r\e(B
-@end itemize
-
-@node Getting started, Basic usage, Overview, Top
-@chapter Getting started
-
-Riece \e$B$r5/F0$9$k<j=g$O<!$NDL$j$G$9!#\e(B
-
-@enumerate
-@item
-@kbd{M-x load-library riece}
-
-@item
-@kbd{M-x riece}
-@end enumerate
-
-\e$B$b$7\e(B (1) \e$B$G\e(B @samp{Cannot open load file: riece} \e$B$N%(%i!<$,H/@8$9$k>l9g$K\e(B
-\e$B$O%$%s%9%H!<%k$K<:GT$7$F$$$^$9!#<+J,$G%=!<%9$+$i%$%s%9%H!<%k$7$?>l9g$K$O\e(B
-README \e$B$r$b$&0lEYFI$_D>$7$F$/$@$5$$!#\e(BOS\e$B!&%G%#%9%H%j%S%e!<%7%g%s$N%Q%C%1!<\e(B
-\e$B%8$+$i%$%s%9%H!<%k$7$?>l9g$K$O!"%Q%C%1!<%8$K4^$^$l$kJ8=q$r$43NG'$/$@$5$$!#\e(B
-
-Riece \e$B$r5/F0$9$k$H!"\e(BIRC \e$B%5!<%P$NL>A0$rJ9$+$l$^$9!#8x6&$KMxMQ2DG=$J\e(B IRC
-\e$B%5!<%P$N0lMw$O\e(B Web \e$B%Z!<%8$J$I$+$iF@$k$3$H$,$G$-$^$9!#\e(B
-
-@itemize @bullet
-@item http://irc.kyoto-u.ac.jp
-@item http://freenode.net
-@end itemize
-
-\e$B$^$?!"0J2<$N$h$&$J%a%C%;!<%8$,I=<($5$l$k$+$b$7$l$^$;$s!#\e(B
-
-@example
-Nickname "ueno" already in use. Choose a new one:
-@end example
-
-IRC \e$B$G$O!";22C<T$rI=$9$N$K\e(B@emph{\e$B%K%C%/%M!<%`\e(B}\e$B$H8F$P$l$kC;$$8F>N$,;H$o$l\e(B
-\e$B$^$9!#$b$74uK>$N%K%C%/%M!<%`$,B>$NC/$+$K;HMQ$5$l$F$$$k>l9g!"JL$N%K%C%/%M!<\e(B
-\e$B%`$rA*$VI,MW$,$"$j$^$9!#\e(B
-
-IRC \e$B%5!<%P$K@\B3$G$-$?$i!"<!$O2qOC$r$7$F$_$^$7$g$&!#\e(BIRC \e$B$G$O\e(B@emph{\e$B%A%c%s%M%k\e(B}
-\e$B$H8F$P$l$k2>A[E*$J2q5D<<$K;22C$7$F2qOC$r9T$J$$$^$9!#%A%c%s%M%k$KF~$k$K$O\e(B
-@kbd{C-c j} \e$B$H%?%$%W$7$^$9!#;22C$9$k%A%c%s%M%kL>$r?R$M$i$l$?$i!"E,@Z$J%A%c\e(B
-\e$B%s%M%kL>$rF~NO$7$^$7$g$&!#\e(BIRCnet \e$B$K$O\e(B @samp{#Riece} \e$B$H$$$&%A%c%s%M%k$,$"\e(B
-\e$B$k$N$G!"%F%9%H$r$7$?$$>l9g$K$O<+M3$K$*;H$$$/$@$5$$!#\e(B
-
-\e$B%A%c%s%M%k$KF~$k$H!"2<$N?^$K<($9$h$&$J\e(B 5 \e$B$D$N%&%#%s%I%&\e(B
-@footnote{\e$B$^$.$i$o$7$$$G$9$,!"\e(BEmacs \e$B$N@$3&$G$O%P%C%U%!$rI=<($9$kNN0h$r%&%#\e(B
-\e$B%s%I%&$H8F$S$^$9!#\e(B}\e$B$+$i$J$k2hLL$K@Z$jBX$o$j$^$9!#\e(B
-
-@example
-+-----+-----------------+
-| | |
-| | |
-| (1) | (2) |
-| | |
-| | |
-+-----+-----------------+
-| | (4) |
-| +-----------------+
-| (3) | |
-| | (5) |
-| | |
-+-----+-----------------+
-@end example
-
-(4) \e$B$N%&%#%s%I%&$KI=<($5$l$k%P%C%U%!$KJ8>O$rF~NO$7$F%j%?!<%s%-!<$r2!$9$H\e(B
-\e$BH/8@$G$-$^$9!#B>$N;22C<T$NH/8@$O\e(B (2) \e$B$N%&%#%s%I%&$KI=<($5$l$^$9!#\e(B
-
-@node Basic usage, Advanced usage, Getting started, Top
-@chapter Basic usage
-
-@menu
-* Windows:: \e$B2hLL9=@.\e(B
-* Indicators:: \e$B<+J,$N>uBV$NI=<(\e(B
-* Commands:: \e$B%3%^%s%I$N0lMw\e(B
-@end menu
-
-@node Windows, Indicators, Basic usage, Basic usage
-@section Windows
-
-@example
-+-----+-----------------+
-| | |
-| | |
-| (1) | (2) |
-| | |
-| | |
-+-----+-----------------+
-| | (4) |
-| +-----------------+
-| (3) | |
-| | (5) |
-| | |
-+-----+-----------------+
-@end example
-
-\e$B3F%&%#%s%I%&$KI=<($5$l$k%P%C%U%!$NLr3d$O0J2<$NDL$j$G$9!#\e(B
-
-@enumerate
-@item
-\e$B%f!<%6%j%9%H%P%C%U%!\e(B (@samp{ *Users*})\e$B!#%A%c%s%M%k$K;22C$7$F$$$k%f!<\e(B
-\e$B%6$N%K%C%/%M!<%`$N0lMw$,I=<($5$l$^$9!#\e(B
-
-@item
-\e$B%A%c%s%M%k%P%C%U%!\e(B (@samp{ *Channel:XXX*})\e$B!#%A%c%s%M%kFb$N2qOC$,I=<($5$l\e(B
-\e$B$^$9!#\e(B
-
-@item
-\e$B%A%c%s%M%k%j%9%H%P%C%U%!\e(B (@samp{ *Channels*})\e$B!#<+J,$,;22C$7$F$$$k%A%c%s%M\e(B
-\e$B%k$N0lMw$,I=<($5$l$^$9!#\e(B
-
-@item
-\e$B%3%^%s%I%P%C%U%!\e(B (@samp{*Command*})\e$B!#J8>O$d%3%^%s%I$rAw?.$9$k$?$a$K;H$$\e(B
-\e$B$^$9!#\e(B
-
-@item
-\e$B%"%6!<%:%P%C%U%!\e(B (@samp{ *Others*})\e$B!#8=:_A*BrCf$N%A%c%s%M%k0J30$N2qOC$,N.\e(B
-\e$B$l$^$9!#\e(B
-@end enumerate
-
-@node Indicators, Commands, Windows, Basic usage
-@section Indicators
-
-\e$B%b!<%I%i%$%s$N:8C<$K$O!"8=:_$N<+J,$N>uBV$r<($90u$,I=<($5$l$^$9!#\e(B
-@footnote{\e$B$b$72hA|$rI=<($G$-$k\e(B Emacs \e$B$r$*;H$$$J$i!":8C<$K\e(B "R" \e$B$N%"%$%3%s\e(B
-\e$B$,I=<($5$l$^$9!#\e(B}
-
-@example
-Riece: ---- ueno #Riece [n]
-@end example
-
-\e$B$3$3$G!"\e(B@samp{----} \e$B$NItJ,$K$O:8$+$i=g$K0J2<$N0UL#$,$"$j$^$9!#\e(B
-
-@enumerate
-@item
-\e$BN%@J>uBV\e(B (\e$BN%@J$7$F$$$l$P\e(B @samp{A})
-
-@item
-IRC \e$B%*%Z%l!<%?>uBV\e(B (IRC \e$B%M%C%H%o!<%/$N4IM}<T8"8B$r;}$C$F$$$l$P\e(B @samp{O})
-
-@item
-\e$B%&%#%s%I%&$N<+F0%9%/%m!<%k$N6X;_\e(B (\e$B40A4$K6X;_$7$F$$$l$P\e(B @samp{F}\e$B!"<+J,$N\e(B
-\e$B<!2s$NH/8@$^$G6X;_$7$F$$$k$N$G$"$l$P\e(B @samp{f})
-
-@item
-\e$B%A%c%s%M%k%*%Z%l!<%?>uBV\e(B (\e$B%A%c%s%M%k$N4IM}<T8"8B$r;}$C$F$$$l$P\e(B @samp{@@})
-@end enumerate
-
-@node Commands, , Indicators, Basic usage
-@section Commands
-
-@ref{Basic usage}\e$B$GJ8>O$rF~NO$7$?%P%C%U%!$O%3%^%s%I%P%C%U%!$H8F$P$l$^$9!#\e(B
-\e$B%3%^%s%I%P%C%U%!$+$i$OJ8>O$rAw?.$9$k0J30$K!"MM!9$J%3%^%s%I$rH/9T$9$k$3$H\e(B
-\e$B$,$G$-$^$9!#0J2<$K0lIt$r5s$2$^$9!#\e(B
-
-\e$B:G=i$O$J$+$J$+3P$($K$/$$$G$9$,!"\e(B@kbd{C-h b}
- (@kbd{M-x describe-bindings})
\e$B$G;HMQ2DG=$J%-!<A`:n$N0lMw$,I=<($5$l$k$N
\e(B
-\e$B$G>/$7$:$D3P$($F$$$/$HNI$$$G$7$g$&!#\e(B
-
-@subsection IRC commands
-@table @kbd
-@item RET
-@findex riece-command-enter-message
-\e$BJ8>O$rAw$j$^$9\e(B(@code{riece-command-enter-message})
-@item C-RET
-@findex riece-command-enter-message-as-notice
-\e$BJ8>O$r\e(B NOTICE \e$B$H$7$FAw$j$^$9\e(B(@code{riece-command-enter-message-as-notice})
-@item C-c j
-@findex riece-command-join
-\e$B%A%c%s%M%k$K;22C$7$^$9\e(B(@code{riece-command-join})
-@item C-c C-p
-@findex riece-command-part
-\e$B%A%c%s%M%k$+$iN%C&$7$^$9\e(B(@code{riece-command-part})
-@item C-c p
-@findex riece-command-enter-message-to-user
-\e$B08@h$r;XDj$7$F8=:_$N9T$rAw$j$^$9\e(B(@code{riece-command-enter-message-to-user})
-@item C-c q
-@findex riece-command-quit
-IRC \e$B$r$d$a$^$9\e(B(@code{riece-command-quit})
-@item C-c n
-@findex riece-command-change-nickname
-\e$B<+J,$N%K%C%/%M!<%`$rJQ99$7$^$9\e(B(@code{riece-command-change-nickname})
-@item C-c f
-@findex riece-command-finger
-\e$B%f!<%6$N>pJs$rD4$Y$^$9\e(B(@code{riece-command-finger})
-@item C-c C-k
-@findex riece-command-kick
-\e$B%f!<%6$r%A%c%s%M%k$+$i=3$j=P$7$^$9\e(B(@code{riece-command-kick})
-@item C-c i
-@findex riece-command-invite
-\e$B%f!<%6$r%A%c%s%M%k$K>7BT$7$^$9\e(B(@code{riece-command-invite})
-@item C-c l
-@findex riece-command-list
-\e$B%Q%?!<%s$KBP$7$F\e(B LIST \e$B$rH/9T$7$^$9\e(B(@code{riece-command-list})
-@item C-c C-n
-@findex riece-command-names
-\e$B%Q%?!<%s$KBP$7$F\e(B NAMES \e$B$rH/9T$7$^$9\e(B(@code{riece-command-names})
-@item C-c w
-@findex riece-command-who
-\e$B%Q%?!<%s$KBP$7$F\e(B WHO \e$B$rH/9T$7$^$9\e(B(@code{riece-command-who})
-@item C-c t
-@findex riece-command-topic
-\e$B%A%c%s%M%k$N%H%T%C%/$r@_Dj$7$^$9\e(B(@code{riece-command-topic})
-@item C-c C-m
-@findex riece-command-change-mode
-\e$B%A%c%s%M%k$N%b!<%I$r@_Dj$7$^$9\e(B(@code{riece-command-change-mode})
-@item C-c o
-@findex riece-command-set-operators
-\e$B%f!<%6$K%A%c%s%M%k$N4IM}<T8"8B$rM?$($^$9!#\e(B@kbd{C-u C-c o} \e$B$G$O5U$K!"%f!<%6$+$i%A%c%s%M%k$N4IM}<T8"8B$rC%$$$^$9\e(B(@code{riece-command-set-operators})
-@item C-c v
-@findex riece-command-set-speakers
-\e$B%f!<%6$K%A%c%s%M%k$G$NH/8@8"$rM?$($^$9!#\e(B@kbd{C-u C-c v} \e$B$G$O5U$K!"%f!<%6$+$i%A%c%s%M%k$G$NH/8@8"$rC%$$$^$9\e(B(@code{riece-command-set-speakers})
-@item C-c V
-@findex riece-version
-Riece \e$B$N%P!<%8%g%s$rI=<($7$^$9!#\e(B(@kbd{C-u C-c V}) \e$B$G!"$h$j>\:Y$J>pJs$rI=<($7$^$9!#\e(B
-@item C-c /
-@findex riece-command-raw
-IRC \e$B%3%^%s%I$rD>@\Aw$j$^$9\e(B(@code{riece-command-raw})
-@end table
-
-@subsection Window manipulating commands
-@table @kbd
-@item C-c r
-@findex riece-command-configure-windows
-\e$B%U%l!<%`A4BN$r:FIA2h$7$^$9\e(B(@code{riece-command-configure-windows})
-@item C-c C-j \e$B$^$?$O\e(B C-c >
-@findex riece-command-next-channel
-\e$B%A%c%s%M%k0lMw$G<!$N%A%c%s%M%k$rA*Br$7$^$9\e(B(@code{riece-command-next-channel})
-@item C-c <
-@findex riece-command-previous-channel
-\e$B%A%c%s%M%k0lMw$GA0$N%A%c%s%M%k$rA*Br$7$^$9\e(B(@code{riece-command-previous-channel})
-@item C-c ^
-@findex riece-command-list-addons
-\e$B%"%I%*%s$N0lMw$rI=<($7$^$9\e(B(@code{riece-command-list-addons})
-@item C-c \e$B?t;z\e(B
-@findex riece-command-switch-to-channel-by-number
-\e$B%A%c%s%M%k0lMw$G\e(B @var{n}\e$BHVL\$N%A%c%s%M%k$rA*Br$7$^$9\e(B(@code{riece-command-switch-to-channel-by-number})
-@item C-c C-c \e$B?t;z\e(B
-@findex riece-command-switch-to-channel-by-number
-\e$B%A%c%s%M%k0lMw$G\e(B @var{n} + 10\e$BHVL\$N%A%c%s%M%k$rA*Br$7$^$9\e(B(@code{riece-command-switch-to-channel-by-number})
-@item C-c Home
-@findex riece-command-beginning-of-buffer
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r>eC<$^$G%9%/%m!<%k$7$^$9\e(B(@code{riece-command-beginning-of-buffer})
-@item C-c $
-@findex riece-command-end-of-buffer
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r2<C<$^$G%9%/%m!<%k$7$^$9\e(B(@code{riece-command-end-of-buffer})
-@item C-c SPC
-@findex riece-command-scroll-up
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r>eJ}8~$K%9%/%m!<%k$7$^$9\e(B(@code{riece-command-scroll-up})
-@item C-c DEL
-@findex riece-command-scroll-down
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r2<J}8~$K%9%/%m!<%k$7$^$9\e(B(@code{riece-command-scroll-down})
-@end table
-
-@subsection Status toggle commands
-@table @kbd
-@item C-c C-t c
-@findex riece-command-toggle-channel-buffer-mode
-\e$B%A%c%s%M%k%P%C%U%!$NI=<(!&HsI=<($r@Z$jBX$($^$9\e(B(@code{riece-command-toggle-channel-buffer-mode})
-@item C-c C-t C
-@findex riece-command-toggle-channel-list-buffer-mode
-\e$B%A%c%s%M%k%j%9%H%P%C%U%!$NI=<(!&HsI=<($r@Z$jBX$($^$9\e(B(@code{riece-command-toggle-channel-list-buffer-mode})
-@item C-c C-t u
-@findex riece-command-toggle-user-list-buffer-mode
-\e$B%f!<%6%j%9%H%P%C%U%!$NI=<(!&HsI=<($r@Z$jBX$($^$9\e(B(@code{riece-command-toggle-user-list-buffer-mode})
-@item C-c C-t f
-@findex riece-command-toggle-freeze
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$N<+F0%9%/%m!<%k$r6X;_$7$^\e(B
-\e$B$9\e(B(@code{riece-command-toggle-freeze})
-@item C-c C-t o
-@findex riece-command-toggle-own-freeze
-\e$B%A%c%s%M%k%P%C%U%!!"$^$?$O%@%$%"%m%0%P%C%U%!$r!"<+J,$,H/8@$9$k$^$G!"<+F0\e(B
-\e$B%9%/%m!<%k$r6X;_$7$^$9\e(B(@code{riece-command-toggle-own-freeze})
-@item C-c C-t a
-@findex riece-command-toggle-away
-\e$B<+J,$NN%@J>uBV$r@Z$jBX$($^$9\e(B(@code{riece-command-toggle-away})
-@end table
-
-@node Advanced usage, Tips, Basic usage, Top
-@chapter Advanced usage
-
-\e$B$3$N>O$G$O!"$b$C$H?J$s$@;H$$J}$r2r@b$7$^$9!#\e(B
-
-@menu
-* Startup File:: \e$B@_Dj%U%!%$%k\e(B
-* Server settings:: \e$B%5!<%P$N>\:Y@_Dj\e(B
-* Connecting to multiple servers:: \e$BF1;~$KJ#?t$N%5!<%P$K@\B3$9$k$K$O\e(B
-* Add-ons:: \e$B%"%I%*%s$H$O\e(B
-@end menu
-
-@node Startup File, Server settings, Advanced usage, Advanced usage
-@section Startup file
-
-\e$B$3$N>O$G$O!"@_Dj%U%!%$%k$K$D$$$F2r@b$7$^$9!#\e(BRiece \e$B$N@_Dj$O\e(B Emacs \e$B$N@_Dj\e(B
-\e$B%U%!%$%k$K=q$$$F$bNI$$$G$9$,!"\e(BRiece \e$B$K8GM-$N@_Dj$O$J$k$Y$/\e(B
-@file{~/.riece/init} \e$B$K=q$/$3$H$r4+$a$^$9!#\e(B
-
-\e$B$^$?!"\e(BRiece \e$B$r;H$$;O$a$k$H\e(B @file{~/.riece/save} \e$B$H$$$&%U%!%$%k$,:n@.$5$l\e(B
-\e$B$^$9!#$3$N%U%!%$%k$K$OA02s5/F0;~$N@_Dj$N0lIt\e(B(\e$B%&%#%s%I%&9=@.Ey\e(B)\e$B$,<+F0E*$K\e(B
-\e$BJ]B8$5$l$^$9!#\e(B
-
-\e$B5/F0;~$K$O!":G=i$K\e(B @file{~/.riece/save} \e$B$r!"<!$K\e(B @file{~/.riece/init}\e$B$r\e(B
-\e$BFI$_9~$_$^$9!#$D$^$j!"A02s5/F0;~$K\e(B @file{~/.riece/save} \e$B$KJ]B8$5$l$?FbMF\e(B
-\e$B$O!"\e(B@file{~/.riece/init} \e$B$NFbMF$G>e=q$-$5$l$^$9!#\e(B
-
-@node Server settings, Connecting to multiple servers, Startup File, Advanced usage
-@section Server settings
-
-\e$B5/F0;~$K@\B3$9$k\e(B IRC \e$B%5!<%P$NL>A0$OJQ?t\e(B @code{riece-server} \e$B$G;XDj$7$^$9!#\e(B
-@vindex riece-server
-
-@code{riece-server} \e$B$N7A<0$O<!$NDL$j$G$9!#\e(B
-@example
-<\e$B%5!<%P$N%[%9%HL>\e(B>:<\e$B%]!<%HHV9f\e(B>[:<\e$B%Q%9%o!<%I\e(B>]
-@end example
-
-@code{riece-server-alist} \e$B$r@_Dj$9$k$H!"$h$jJ#;($J;XDj$,2DG=$K$J$j$^$9!#\e(B
-@vindex riece-server-alist
-
-\e$B0J2<$NNc$r9M$($^$9!#\e(B
-
-@example
-(setq riece-server-alist
- '(("foo" :host "irc.example.com" :coding shift_jis)
- ("bar" :host "irc.example.net" :nickname "baz")))
-
-(setq riece-server "foo")
-@end example
-
-\e$B$3$N@_Dj$N0UL#$O0J2<$NDL$j$G$9!#\e(B
-
-@itemize
-@item
-@samp{foo} \e$B$H$$$&L>A0$N\e(B IRC \e$B%5!<%P$N%[%9%HL>$O\e(B @samp{irc.example.com} \e$B$G!";HMQ$9$kJ8;z%3!<%I$O\e(B Shift_JIS
-
-@item
-@samp{bar} \e$B$H$$$&L>A0$N\e(B IRC \e$B%5!<%P$N%[%9%HL>$O\e(B @samp{irc.example.net} \e$B$G!"$3$N%5!<%P$G$O%K%C%/%M!<%`\e(B @samp{baz} \e$B$r;H$&\e(B
-@end itemize
-
-\e$B;XDj$G$-$k%-!<%o!<%I$N0lMw$O0J2<$NDL$j$G$9!#\e(B
-
-@table @code
-@item :host
-\e$B%5!<%P$N%[%9%HL>$^$?$O\e(B IP \e$B%"%I%l%9\e(B
-@item :service
-\e$B%5!<%P$N%5!<%S%9L>$^$?$O%]!<%HHV9f\e(B
-@item :nickname
-\e$B@\B3;~$N%K%C%/%M!<%`\e(B
-@item :username
-\e$B@\B3;~$N%f!<%6%M!<%`\e(B
-@item :password
-\e$B@\B3;~$N%Q%9%o!<%I\e(B
-@item :function
-\e$B@\B3MQ4X?t\e(B
-@item :coding
-\e$BJ8;z%3!<%I\e(B
-@end table
-
-@node Connecting to multiple servers, Add-ons, Server settings, Advanced usage
-@section Connecting to multiple servers
-
-\e$BF1;~$KJ#?t$N%5!<%P$K@\B3$9$k<j=g$r0J2<$K<($7$^$9!#\e(B
-
-\e$B4{$KFCDj$N%5!<%P$K@\B3$7$F$$$k>uBV$G!"JL$N%5!<%P$K@\B3$9$k$K$O\e(B @kbd{C-c O} (@code{riece-command-open-server}) \e$B$r;H$$$^$9!#\e(B
-
-\e$BJL$N%5!<%P>e$N%A%c%s%M%k$K;22C$9$k$K$O!"\e(B@kbd{C-c j}
-(@code{riece-command-join})\e$B$G%A%c%s%M%kL>$K\e(B @samp{@@} \e$B$KB3$$$F%5!<%PL>$r\e(B
-\e$BB3$1$^$9!#\e(B
-
-\e$B$?$H$($P!"%5!<%P\e(B @samp{irc.freenode.net} \e$B>e$N\e(B @samp{#Riece} \e$B$O<!$N$h$&\e(B
-\e$B$KI=5-$7$^$9!#\e(B
-
-@example
-#Riece@@irc.freenode.net
-@end example
-
-\e$B%A%c%s%M%kL>$H%5!<%P$N6h@Z$jJ8;z\e(B @samp{@@} \e$B$O\e(B
-\e$BJQ?t\e(B @code{riece-alias-alternate-separator} \e$B$GJQ99$G$-$^$9!#\e(B
-
-\e$B$^$?$O!"6uGrJ8;z$G$bBeMQ$G$-$^$9!#$3$N;~$K$O!"\e(B@kbd{C-q SPC} \e$B$HF~NO$9$k\e(B
-\e$BI,MW$,$"$j$^$9!#\e(B
-
-\e$BJ#?t$N@\B3$rA`:n$9$k%3%^%s%I$r0J2<$K$^$H$a$^$9!#\e(B
-
-@table @kbd
-@item C-c O
-@findex riece-command-open-server
-\e$BJL$N%5!<%P$K@\B3$7$^$9\e(B(@code{riece-command-open-server})
-@item C-c C
-@findex riece-command-close-server
-\e$B%5!<%P$H$N@\B3$r@ZCG$7$^$9\e(B(@code{riece-command-close-server})
-@item C-c M
-@findex riece-command-universal-server-name-argument
-\e$BFCDj$N%5!<%P$KBP$7$F!"B3$/%3%^%s%I$rH/9T$7$^$9\e(B(@code{riece-command-universal-server-name-argument})
-@end table
-
-@node Add-ons, , Connecting to multiple servers, Advanced usage
-@section Add-ons
-
-Riece \e$B$G$O!";(B?$J5!G=$rA*BrE*$KMxMQ$G$-$k$h$&!"%"%I%*%s$H8F$P$l$k5!9=\e(B
-\e$B$rMQ0U$7$F$$$^$9!#%"%I%*%s$ODL>o$N\e(B elisp \e$B%b%8%e!<%k$r3HD%$7$?$b$N$G!"\e(B
-\e$B0BA4$J<h$j30$7$d!"%"%I%*%s4V$N=i4|2==hM}$N0MB84X78$J$I$NLLE]$r$_$^$9!#\e(B
-
-\e$B%"%I%*%s$K$O<!$N;M<oN`$N>uBV$,$"$j$^$9!#\e(B
-
-@table @asis
-@item unloaded
-\e$BFI$_9~$_A0!#%"%I%*%s$N\e(B elisp \e$B%b%8%e!<%k$,FI$_9~$^$l$F$$$J$$>uBV\e(B
-
-@item insinuated
-\e$BAH$_9~$_:Q$_!#%"%I%*%s$N\e(B elisp \e$B%b%8%e!<%k$,FI$_9~$^$l!"=i4|2==hM}$,40N;$7$?>uBV\e(B
-
-@item enabled
-\e$BM-8z!#%"%I%*%s$,F0:nCf\e(B
-
-@item disabled
-\e$BL58z!#%"%I%*%s$NF0:n$,Dd;_Cf\e(B
-
-@end table
-
-@menu
-* Add-on browser:: \e$B%"%I%*%s$N0lMwI=<(\e(B
-* Available add-ons:: \e$BI8=`E:IU$N%"%I%*%s$N>R2p\e(B
-@end menu
-
-@node Add-on browser, Available add-ons, Add-ons, Add-ons
-@subsection Add-on browser
-
-Riece \e$B$NF0:nCf$K%"%I%*%s$N0lMw$rD/$a$k$K$O%"%I%*%s%V%i%&%6$r;H$&$HJXMx$G$9!#\e(B
-\e$B%3%^%s%I%P%C%U%!$G\e(B @kbd{C-c ^} \e$B$H$9$k$H!"<!$N$h$&$KI=<($5$l$^$9!#\e(B
-
-@example
-+ riece-alias Define aliases for IRC names.
- riece-async Connect to IRC server via async proxy.
- riece-biff Be notified if messages arrives.
-+ riece-button Display useful buttons in IRC buffers.
-+ riece-ctcp CTCP (Client To Client Protocol) support.
-+ riece-ctlseq Mark up control sequences in IRC buffers.
-@end example
-
-\e$B3F9T$N:8C<$N%^!<%/$O%"%I%*%s$N>uBV$rI=$o$7$F$$$^$9!#\e(B@samp{+} \e$B$OAH9~$^\e(B
-\e$B$l$FM-8z$J%"%I%*%s!"6uGr$O%m!<%I$5$l$F$$$J$$%"%I%*%s$G$9!#\e(B
-
-\e$B$3$3$G!"\e(Briece-button \e$B$rL58z$K$7$?$$>l9g!";M9TL\$N@hF,$G\e(B @kbd{-} \e$B$H$7$^\e(B
-\e$B$9!#$9$k$H!"@hF,$N%^!<%/$,\e(B @samp{+} \e$B$+$i\e(B @samp{-} \e$B$KJQ2=$7$^$9!#\e(B
-
-@example
-+ riece-alias Define aliases for IRC names.
- riece-async Connect to IRC server via async proxy.
- riece-biff Be notified if messages arrives.
-- riece-button Display useful buttons in IRC buffers.
-+ riece-ctcp CTCP (Client To Client Protocol) support.
-+ riece-ctlseq Mark up control sequences in IRC buffers.
-@end example
-
-\e$B$5$i$K!"\e(B@samp{u} \e$B$H$9$k$H!"\e(Briece-button \e$B$r%"%I%*%s$N@_Dj$+$i=|30$7$^$9!#\e(B
-\e$B$5$i$K!"\e(B@samp{U} \e$B$H$9$k$H!"\e(Briece-button \e$B$r40A4$K%"%s%m!<%I$7$^$9!#\e(B
-
-\e$B$3$N>uBV$G!"\e(B@samp{s} \e$B$^$?$O\e(B @samp{M-x riece-command-save-variables} \e$B$H\e(B
-\e$B$9$k$H!"@_Dj$rJ]B8$7$^$9!#\e(B
-
-@file{~/.riece/init} \e$B$G%"%I%*%s$rAH$_9~$`$K$O\e(B @code{riece-addons} \e$B$r@_\e(B
-\e$BDj$7$^$9!#$?$H$($P\e(B @samp{riece-alias} \e$B$rAH$_9~$`>l9g$K$O!"0J2<$N$h$&$K\e(B
-\e$B5-=R$7$^$9!#\e(B
-@vindex riece-addons
-
-@example
-(add-to-list 'riece-addons 'riece-mini)
-@end example
-
-@node Available add-ons, , Add-on browser, Add-ons
-@subsection Available add-ons
-
-\e$BMxMQ2DG=$J%"%I%*%s$O<!$NDL$j$G$9!#$3$l$i$N$&$A$NB?$/$OI8=`$GAH$_9~$^$l\e(B
-\e$B$F$$$^$9!#\e(B
-
-@table @samp
-@item riece-alias
-\e$B%A%c%s%M%kL>$d%K%C%/%M!<%`$NJLL>$rDj5A\e(B
-@item riece-async
-Emacs \e$B$,\e(B busy or suspend \e$B>uBV$K$J$k$3$H$KHw$(!"\e(B
-PING \e$B$K1~Ez$9$k\e(B local proxy \e$B7PM3$G\e(B IRC \e$B%5!<%P$K@\B3\e(B
-@item riece-biff
-\e$BB>$N%P%C%U%!$K$$$k;~$KH/8@$,$"$k$H%b!<%I%i%$%s$K0u\e(B ("[R]") \e$B$rI=<(\e(B
-@item riece-button
-\e$B%\%?%s$d%]%C%W%"%C%W%a%K%e!<$NI=<(\e(B
-@item riece-ctcp
-CTCP (Client To Client Protocol)
-@item riece-ctlseq
-\e$B%3%s%H%m!<%k%7!<%1%s%9\e(B (^B \e$B$J$I\e(B) \e$B$K$h$k6/D4I=<(\e(B
-@item riece-doctor
-doctor.el \e$B$HO"7H$7$F@:?@2J0e$K$J$j$9$^$9\e(B
-@item riece-epg
-EasyPG @uref{http://www.easypg.org} \e$B$K$h$k2qOC$N0E9f2=\e(B
-@item riece-eval-ruby
-\e$BF~NO$5$l$?J8;zNs$r\e(B Ruby \e$B$N<0$H$7$FI>2A\e(B
-@item riece-eval
-\e$BF~NO$5$l$?J8;zNs$r\e(B Emacs Lisp \e$B$N<0$H$7$FI>2A\e(B
-@item riece-foolproof
-\e$B%A%c%s%M%k%_%9$rKI$0\e(B
-@item riece-google
-\e$B%-!<%o!<%I$r\e(B Google \e$B$G8!:w\e(B
-@item riece-guess
-\e$B?'!9$JJ}K!$G0\F0@h$N%A%c%s%M%k$r?dB,\e(B
-@item reice-hangman
-\e$B%A%c%s%M%kFb$G\e(B hangman \e$B$GM7$V\e(B
-@item riece-highlight
-\e$B%P%C%U%!$N?'IU$1\e(B
-@item riece-history
-\e$B%A%c%s%M%k0\F0$NMzNr4IM}\e(B
-@item riece-icon
-\e$B%P%C%U%!Cf$K%"%$%3%s$rI=<(\e(B
-@item riece-ignore
-\e$B;XDj$7$?%f!<%6$NH/8@$rL5;k\e(B
-@item riece-kakasi
-\e$BF|K\8l$NDL$i$J$$C<Kv$G!"F|K\8l$r%m!<%^;z$GI=<(\e(B
-@item riece-keepalive
-IRC \e$B%5!<%P$H$N@\B3$rJ];}\e(B
-@item riece-keyword
-\e$B%-!<%o!<%I$N6/D4I=<(\e(B
-@item riece-log
-\e$B2qOC$N%m%0$r%U%!%$%k$KJ]B8\e(B
-@item riece-lsdb
-\e$B%"%I%l%9D"\e(B LSDB (Lovely Sister Database)
-@uref{http://lsdb.sourceforge.jp} \e$B$HO"7H\e(B
-@item riece-mcat
-\e$B%a%C%;!<%8%+%?%m%0\e(B
-@item riece-menu
-\e$B%a%K%e!<%P!<$K%a%K%e!<$rEPO?\e(B
-@item riece-mini
-\e$B%_%K%P%C%U%!$N$_$G\e(B IRC \e$B$r$9$k\e(B
-@item riece-ndcc
-DCC (Direct Client to Client protocol) \e$B$K$h$k%U%!%$%kE>Aw\e(B
-(Emacs 22 \e$B$G$N$_F0:n\e(B)
-@item riece-rdcc
-DCC (Direct Client to Client protocol) \e$B$K$h$k%U%!%$%kE>Aw\e(B
-@item riece-shrink-buffer
-\e$B%a%b%j3NJ]$N$?$a!"%P%C%U%!$rDj4|E*$K@Z$j5M$a$k\e(B
-@item riece-skk-kakutei
-SKK \e$B;HMQ;~$KJQ49%b!<%I$N0u$rH/8@$+$i<h$j=|$/\e(B
-@item riece-toolbar
-\e$B%D!<%k%P!<$rI=<(\e(B
-@item riece-unread
-\e$BH/8@$N$"$C$?%A%c%s%M%k$K\e(B@samp{!}\e$B%^!<%/$r$D$1$k\e(B
-@item riece-url
-\e$B2qOC$K8=$l$?\e(B URL \e$B$N<}=8\e(B
-@item riece-xface
-\e$B%f!<%6%j%9%H%P%C%U%!$K%f!<%6$N\e(B X-Face \e$B$rI=<(\e(B
-@item riece-xfaceb
-\e$B%f!<%6%j%9%H%P%C%U%!$K%f!<%6$N\e(B X-Face \e$B$rI=<(\e(B
-(BBDB @uref{http://bbdb.sourceforge.net} \e$B$,I,MW\e(B)
-@item riece-yank
-@kbd{C-c y} \e$B$G\e(B kill-ring \e$B$+$iJ8;zNs$rAw?.\e(B
-@end table
-
-@node Tips, Index, Advanced usage, Top
-@comment node-name, next, previous, up
-@chapter Tips
-
-
\e$B$3$N>O$G$O!"$h$/J9$+$l$k<ALd$KBP$9$kEz$($HJXMx$J@_DjNc$r>R2p$7$^$9!#
\e(B
-
-@section \e$BD>A0$KA*Br$7$F$$$?%A%c%s%M%k$K0\F0$7$?$$\e(B
-@vindex riece-guess-channel-try-functions
-
-\e$B0J2<$N9T$r\e(B @file{~/.riece/init} \e$B$KDI2C$9$k$3$H$G!"\e(B@kbd{C-c g} \e$B$GMzNr$rC)\e(B
-\e$B$j$D$D0\F0$G$-$^$9!#\e(B@samp{riece-guess} \e$B%"%I%*%s$O!"%A%c%s%M%kA*Br$NMzNr\e(B
-\e$B$dL$FI%a%C%;!<%8$NM-L5$J$I$+$i<!$KA*Br$9$k%A%c%s%M%k$r?dB,$7$F$/$l$k%"%I\e(B
-\e$B%*%s$G!"I8=`$GAH$_9~$^$l$F$$$^$9!#\e(B
-
-@example
-(add-hook 'riece-guess-channel-try-functions
- 'riece-guess-channel-from-history)
-@end example
-
-@section \e$BH/8@$,$"$k$H%P%C%U%!$,%9%/%m!<%k$9$k$N$r;_$a$?$$\e(B
-
-@kbd{C-c C-t f} \e$B$G$9!#\e(B@emph{t}oggle @emph{f}reeze \e$B$H3P$($k$HNI$$$G$7$g$&!#\e(B
-
-@section \e$BAu>~$rM^@)$7$?$$\e(B
-
-@code{riece-addons} \e$B$+$iAu>~$N$?$a$N%"%I%*%s$r=|30$7$^$9!#\e(B
-\e$BDL>oM-8z$K$J$C$F$$$kAu>~$N$?$a$N%"%I%*%s$O<!$NDL$j$G$9!#\e(B
-
-@itemize
-@item
-\e$B?'IU$1\e(B (@samp{riece-highlight})
-
-@item
-\e$B%\%?%sI=<(\e(B (@samp{riece-button})
-
-@item
-\e$B%"%$%3%s2hA|$NI=<(\e(B (@samp{riece-icon})
-@end itemize
-
-\e$B$?$H$($P?'IU$1$r$d$a$?$$$N$G$"$l$P!"0J2<$N9T$r\e(B @file{~/.riece/init} \e$B$KDI\e(B
-\e$B2C$7$^$9!'\e(B
-
-@example
-(setq riece-addons (delq 'riece-highlight riece-addons))
-@end example
-
-@section \e$BFCDj$NJ8;zNs$r<u?.$7$?$i2;$rLD$i$7$?$$\e(B
-@vindex riece-keyword-notify-functions
-
-\e$B0J2<$N@_Dj$r\e(B @file{~/.riece/init} \e$B$K2C$($^$9!#\e(B@samp{riece-keywords} \e$B%"%I\e(B
-\e$B%*%s$r;H$&$HFCDj$NJ8;zNs$r<u?.$7$?:]$NF0:n$r;XDj$G$-$^$9!#\e(B
-
-@example
-(setq riece-keywords '("\e$B$[$2\e(B" "\e$B$U$,\e(B"))
-(add-hook 'riece-keyword-notify-functions
- (lambda (keyword message) (ding)))
-@end example
-
-@section SKK \e$B$r;H$C$F$$$F!"JQ49Cf$N0u\e(B (\e$B"&\e(B) \e$B$rAw?.$7$F$7$^$&$3$H$,$"$k\e(B
-
-\e$B0J2<$N9T$r\e(B @file{~/.riece/init} \e$B$KDI2C$7$^$9!#\e(B
-
-@example
-(add-to-list 'riece-addons 'riece-skk-kakutei)
-@end example
-
-@section \e$B%A%c%s%M%k0lMw$NJB$S=g$r8GDj$7$?$$\e(B
-@vindex riece-default-channel-binding
-
-\e$B0J2<$N9T$r\e(B @file{~/.riece/init} \e$B$KDI2C$7$^$9!#\e(B
-
-@example
-(setq riece-default-channel-binding
- '("#Riece" "#emacsen" nil "#debianjp"))
-@end example
-
-\e$B$3$N@_DjNc$G$O!"%A%c%s%M%k0lMw$NJB$S=g$O<!$N$h$&$K$J$j$^$9!#\e(B
-
-@enumerate
-@item
-#Riece
-@item
-#emacsen
-@item
-\e$B$J$7\e(B
-@item
-#debianjp
-@end enumerate
-
-3 \e$BHVL\$N%A%c%s%M%k$,6u@J$H$J$C$F$$$k$3$H$K$4Cm0U$/$@$5$$!#?7$?$J%A%c%s%M\e(B
-\e$B%k$K;22C$7$?>l9g!"$=$N%A%c%s%M%k$,\e(B 3 \e$BHVL\$N0LCV$K3dEv$F$i$l$^$9!#\e(B
-
-@section \e$B5/F0;~$K<+F0E*$K%A%c%s%M%k$K;22C$7$?$$\e(B
-@vindex riece-startup-channel-list
-
-\e$BJQ?t\e(B @samp{riece-startup-channel-list} \e$B$r@_Dj$7$^$9!#\e(B
-
-@example
-(setq riece-startup-channel-list
- '("#Riece" "#public"))
-@end example
-
-\e$B$3$N@_DjNc$O!"\e(B@samp{#Riece} \e$B$H\e(B @samp{#public} \e$B$K;22C$9$k$3$H$r0UL#$7$F$$\e(B
-\e$B$^$9!#%A%c%s%M%k$K;22C$9$k:]$K%Q%9%o!<%I$,I,MW$J>l9g$K$O<!$N$h$&$K@_Dj$7\e(B
-\e$B$^$9!#\e(B
-
-@example
-(setq riece-startup-channel-list
- '("#Riece" "#public" ("#private" "password")))
-@end example
-
-@section \e$B5/F0;~$K<+F0E*$KJ#?t$N\e(B IRC \e$B%5!<%P$K@\B3$7$?$$\e(B
-@vindex riece-startup-server-list
-
-\e$BJQ?t\e(B @samp{riece-startup-server-list} \e$B$r@_Dj$7$^$9!#\e(B
-
-@example
-(setq riece-server "ircnet"
- riece-server-alist '(("ircnet" :host "irc.tokyo.wide.ad.jp")
- ("freenode" :host "irc.ipv6.freenode.net")))
-@end example
-
-\e$B$3$N@_DjNc$G$O!"5/F0;~$K@\B3$9$k$N$O\e(B "ircnet" \e$B$@$1$G$9!#\e(B
-@samp{riece-startup-server-list} \e$B$r0J2<$N$h$&$K@_Dj$9$k$H!"\e(B
-"freenode" \e$B$K$b@\B3$9$k$h$&$K$J$j$^$9!#\e(B
-
-@example
-(setq riece-startup-server-list '("freenode"))
-@end example
-
-@section HTTP \e$B%W%m%-%7$r2p$7$F\e(B IRC \e$B%5!<%P$K@\B3$7$?$$\e(B
-@file{relay.el} \e$B$H\e(B @file{connect.c} \e$B$r;H$&$H!"\e(B
-HTTP \e$B%W%m%-%7$r2p$7$F\e(B IRC \e$B%5!<%P$K@\B3$9$k$3$H$,$G$-$^$9!#\e(B
-
-@table @asis
-@item relay.el
-@uref{http://www.taiyo.co.jp/~gotoh/lisp/relay.el}
-
-@item connect.c
-@uref{http://www.taiyo.co.jp/~gotoh/ssh/connect.html}
-@end table
-
-\e$B$?$H$($P!"\e(B@samp{proxy.example.com:8080} \e$B7PM3$G\e(B
-@samp{irc.tokyo.wide.ad.jp} \e$B$K@\B3$9$k>l9g$K$O!"0J2<$N9T$r\e(B
-@file{~/.riece/init} \e$B$KDI2C$7$^$9!#\e(B
-
-@example
-(require 'relay)
-(setq relay-command-alist (cons '("^irc\.tokyo\.wide\.ad\.jp$"
- "connect" "-H" "proxy.example.com:8080"
- host service)
- relay-command-alist)
- riece-server-alist (cons '("proxy-tokyo" :host "irc.tokyo.wide.ad.jp"
- :function relay-open-network-stream)
- riece-server-alist))
-@end example
-
-@section \e$B2qOC$N%m%0$r%U%!%$%k$KJ]B8$7$?$$\e(B
-@vindex riece-log-directory-map
-
-@samp{riece-log} \e$B%"%I%*%s$r;H$&$H!"2qOC$N%m%0$r%U%!%$%k$KJ]B8$7!":F5/F0\e(B
-\e$B;~$K;2>H$G$-$^$9!#\e(B@samp{riece-log} \e$B%"%I%*%s$OI8=`$GAH$_9~$^$l$F$$$^$9!#\e(B
-
-\e$BDL>o$O\e(B @file{~/.riece/log} \e$B$N2<$K\e(B IRC \e$B%5!<%P$NL>A0!"%A%c%s%M%kL>$N%G%#%l\e(B
-\e$B%/%j$,:n@.$5$l!"$=$NCf$KF|$K$AKh$KJ,JL$5$l$FJ]B8$5$l$^$9!#\e(B
-
-\e$B%G%#%l%/%H%jL>$,J8;z2=$1$9$k>l9g$K$O!"\e(B
-@code{file-name-coding-system} \e$B$NCM$rE,@Z$K@_Dj$9$k$+!"$"$k$$$O\e(B
-@code{riece-log-directory-map} \e$B$r;H$C$F%A%c%s%M%kL>$r\e(B US-ASCII \e$BJ8;zNs$K\e(B
-\e$BJQ49$9$kI,MW$,$"$j$^$9!#\e(B
-
-@example
-(setq riece-log-directory-map '(("#\e$B$j!<$9\e(B" . "riece")))
-@end example
-
-@section \e$B%&%#%s%I%&4V$r<+M3$K0\F0$7$?$$\e(B
-
-GNU Emacs \e$B$KImB0$N\e(B @samp{windmove.el} \e$B$r;H$&$HJXMx$G$9!#>\:Y$O\e(B
-@samp{windmove.el} \e$B$N%3%a%s%H$r;2>H$/$@$5$$!#\e(B@samp{windmove.el} \e$B$O\e(B
-\e$B:n<T$N%Z!<%8\e(B (@uref{http://hovav.net/elisp/}) \e$B$+$i$b<hF@$G$-$^$9!#\e(B
-
-@node Index, Function Index, Tips, Top
-@chapter Index
-@printindex cp
-
-@node Function Index, Variable Index, Index, Top
-@chapter Function Index
-@printindex fn
-
-@node Variable Index, , Function Index, Top
-@chapter Variable Index
-@printindex vr
-
-@summarycontents
-@contents
-@bye
-
-@c End:
+++ /dev/null
-% texinfo.tex -- TeX macros to handle Texinfo files.
-%
-% Load plain if necessary, i.e., if running under initex.
-\expandafter\ifx\csname fmtname\endcsname\relax\input plain\fi
-%
-\def\texinfoversion{2005-07-05.19}
-%
-% Copyright (C) 1985, 1986, 1988, 1990, 1991, 1992, 1993, 1994, 1995,
-% 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003, 2004, 2005 Free Software
-% Foundation, Inc.
-%
-% This texinfo.tex file 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.
-%
-% This texinfo.tex file 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 this texinfo.tex file; see the file COPYING. If not, write
-% to the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
-% Boston, MA 02110-1301, USA.
-%
-% As a special exception, when this file is read by TeX when processing
-% a Texinfo source document, you may use the result without
-% restriction. (This has been our intent since Texinfo was invented.)
-%
-% Please try the latest version of texinfo.tex before submitting bug
-% reports; you can get the latest version from:
-% http://www.gnu.org/software/texinfo/ (the Texinfo home page), or
-% ftp://tug.org/tex/texinfo.tex
-% (and all CTAN mirrors, see http://www.ctan.org).
-% The texinfo.tex in any given distribution could well be out
-% of date, so if that's what you're using, please check.
-%
-% Send bug reports to bug-texinfo@gnu.org. Please include including a
-% complete document in each bug report with which we can reproduce the
-% problem. Patches are, of course, greatly appreciated.
-%
-% To process a Texinfo manual with TeX, it's most reliable to use the
-% texi2dvi shell script that comes with the distribution. For a simple
-% manual foo.texi, however, you can get away with this:
-% tex foo.texi
-% texindex foo.??
-% tex foo.texi
-% tex foo.texi
-% dvips foo.dvi -o # or whatever; this makes foo.ps.
-% The extra TeX runs get the cross-reference information correct.
-% Sometimes one run after texindex suffices, and sometimes you need more
-% than two; texi2dvi does it as many times as necessary.
-%
-% It is possible to adapt texinfo.tex for other languages, to some
-% extent. You can get the existing language-specific files from the
-% full Texinfo distribution.
-%
-% The GNU Texinfo home page is http://www.gnu.org/software/texinfo.
-
-
-\message{Loading texinfo [version \texinfoversion]:}
-
-% If in a .fmt file, print the version number
-% and turn on active characters that we couldn't do earlier because
-% they might have appeared in the input file name.
-\everyjob{\message{[Texinfo version \texinfoversion]}%
- \catcode`+=\active \catcode`\_=\active}
-
-\message{Basics,}
-\chardef\other=12
-
-% We never want plain's \outer definition of \+ in Texinfo.
-% For @tex, we can use \tabalign.
-\let\+ = \relax
-
-% Save some plain tex macros whose names we will redefine.
-\let\ptexb=\b
-\let\ptexbullet=\bullet
-\let\ptexc=\c
-\let\ptexcomma=\,
-\let\ptexdot=\.
-\let\ptexdots=\dots
-\let\ptexend=\end
-\let\ptexequiv=\equiv
-\let\ptexexclam=\!
-\let\ptexfootnote=\footnote
-\let\ptexgtr=>
-\let\ptexhat=^
-\let\ptexi=\i
-\let\ptexindent=\indent
-\let\ptexinsert=\insert
-\let\ptexlbrace=\{
-\let\ptexless=<
-\let\ptexnewwrite\newwrite
-\let\ptexnoindent=\noindent
-\let\ptexplus=+
-\let\ptexrbrace=\}
-\let\ptexslash=\/
-\let\ptexstar=\*
-\let\ptext=\t
-
-% If this character appears in an error message or help string, it
-% starts a new line in the output.
-\newlinechar = `^^J
-
-% Use TeX 3.0's \inputlineno to get the line number, for better error
-% messages, but if we're using an old version of TeX, don't do anything.
-%
-\ifx\inputlineno\thisisundefined
- \let\linenumber = \empty % Pre-3.0.
-\else
- \def\linenumber{l.\the\inputlineno:\space}
-\fi
-
-% Set up fixed words for English if not already set.
-\ifx\putwordAppendix\undefined \gdef\putwordAppendix{Appendix}\fi
-\ifx\putwordChapter\undefined \gdef\putwordChapter{Chapter}\fi
-\ifx\putwordfile\undefined \gdef\putwordfile{file}\fi
-\ifx\putwordin\undefined \gdef\putwordin{in}\fi
-\ifx\putwordIndexIsEmpty\undefined \gdef\putwordIndexIsEmpty{(Index is empty)}\fi
-\ifx\putwordIndexNonexistent\undefined \gdef\putwordIndexNonexistent{(Index is nonexistent)}\fi
-\ifx\putwordInfo\undefined \gdef\putwordInfo{Info}\fi
-\ifx\putwordInstanceVariableof\undefined \gdef\putwordInstanceVariableof{Instance Variable of}\fi
-\ifx\putwordMethodon\undefined \gdef\putwordMethodon{Method on}\fi
-\ifx\putwordNoTitle\undefined \gdef\putwordNoTitle{No Title}\fi
-\ifx\putwordof\undefined \gdef\putwordof{of}\fi
-\ifx\putwordon\undefined \gdef\putwordon{on}\fi
-\ifx\putwordpage\undefined \gdef\putwordpage{page}\fi
-\ifx\putwordsection\undefined \gdef\putwordsection{section}\fi
-\ifx\putwordSection\undefined \gdef\putwordSection{Section}\fi
-\ifx\putwordsee\undefined \gdef\putwordsee{see}\fi
-\ifx\putwordSee\undefined \gdef\putwordSee{See}\fi
-\ifx\putwordShortTOC\undefined \gdef\putwordShortTOC{Short Contents}\fi
-\ifx\putwordTOC\undefined \gdef\putwordTOC{Table of Contents}\fi
-%
-\ifx\putwordMJan\undefined \gdef\putwordMJan{January}\fi
-\ifx\putwordMFeb\undefined \gdef\putwordMFeb{February}\fi
-\ifx\putwordMMar\undefined \gdef\putwordMMar{March}\fi
-\ifx\putwordMApr\undefined \gdef\putwordMApr{April}\fi
-\ifx\putwordMMay\undefined \gdef\putwordMMay{May}\fi
-\ifx\putwordMJun\undefined \gdef\putwordMJun{June}\fi
-\ifx\putwordMJul\undefined \gdef\putwordMJul{July}\fi
-\ifx\putwordMAug\undefined \gdef\putwordMAug{August}\fi
-\ifx\putwordMSep\undefined \gdef\putwordMSep{September}\fi
-\ifx\putwordMOct\undefined \gdef\putwordMOct{October}\fi
-\ifx\putwordMNov\undefined \gdef\putwordMNov{November}\fi
-\ifx\putwordMDec\undefined \gdef\putwordMDec{December}\fi
-%
-\ifx\putwordDefmac\undefined \gdef\putwordDefmac{Macro}\fi
-\ifx\putwordDefspec\undefined \gdef\putwordDefspec{Special Form}\fi
-\ifx\putwordDefvar\undefined \gdef\putwordDefvar{Variable}\fi
-\ifx\putwordDefopt\undefined \gdef\putwordDefopt{User Option}\fi
-\ifx\putwordDeffunc\undefined \gdef\putwordDeffunc{Function}\fi
-
-% In some macros, we cannot use the `\? notation---the left quote is
-% in some cases the escape char.
-\chardef\backChar = `\\
-\chardef\colonChar = `\:
-\chardef\commaChar = `\,
-\chardef\dotChar = `\.
-\chardef\exclamChar= `\!
-\chardef\plusChar = `\+
-\chardef\questChar = `\?
-\chardef\semiChar = `\;
-\chardef\underChar = `\_
-
-\chardef\spaceChar = `\ %
-\chardef\spacecat = 10
-\def\spaceisspace{\catcode\spaceChar=\spacecat}
-
-{% for help with debugging.
- % example usage: \expandafter\show\activebackslash
- \catcode`\! = 0 \catcode`\\ = \active
- !global!def!activebackslash{\}
-}
-
-% Ignore a token.
-%
-\def\gobble#1{}
-
-% The following is used inside several \edef's.
-\def\makecsname#1{\expandafter\noexpand\csname#1\endcsname}
-
-% Hyphenation fixes.
-\hyphenation{
- Flor-i-da Ghost-script Ghost-view Mac-OS Post-Script
- ap-pen-dix bit-map bit-maps
- data-base data-bases eshell fall-ing half-way long-est man-u-script
- man-u-scripts mini-buf-fer mini-buf-fers over-view par-a-digm
- par-a-digms rath-er rec-tan-gu-lar ro-bot-ics se-vere-ly set-up spa-ces
- spell-ing spell-ings
- stand-alone strong-est time-stamp time-stamps which-ever white-space
- wide-spread wrap-around
-}
-
-% Margin to add to right of even pages, to left of odd pages.
-\newdimen\bindingoffset
-\newdimen\normaloffset
-\newdimen\pagewidth \newdimen\pageheight
-
-% For a final copy, take out the rectangles
-% that mark overfull boxes (in case you have decided
-% that the text looks ok even though it passes the margin).
-%
-\def\finalout{\overfullrule=0pt}
-
-% @| inserts a changebar to the left of the current line. It should
-% surround any changed text. This approach does *not* work if the
-% change spans more than two lines of output. To handle that, we would
-% have adopt a much more difficult approach (putting marks into the main
-% vertical list for the beginning and end of each change).
-%
-\def\|{%
- % \vadjust can only be used in horizontal mode.
- \leavevmode
- %
- % Append this vertical mode material after the current line in the output.
- \vadjust{%
- % We want to insert a rule with the height and depth of the current
- % leading; that is exactly what \strutbox is supposed to record.
- \vskip-\baselineskip
- %
- % \vadjust-items are inserted at the left edge of the type. So
- % the \llap here moves out into the left-hand margin.
- \llap{%
- %
- % For a thicker or thinner bar, change the `1pt'.
- \vrule height\baselineskip width1pt
- %
- % This is the space between the bar and the text.
- \hskip 12pt
- }%
- }%
-}
-
-% Sometimes it is convenient to have everything in the transcript file
-% and nothing on the terminal. We don't just call \tracingall here,
-% since that produces some useless output on the terminal. We also make
-% some effort to order the tracing commands to reduce output in the log
-% file; cf. trace.sty in LaTeX.
-%
-\def\gloggingall{\begingroup \globaldefs = 1 \loggingall \endgroup}%
-\def\loggingall{%
- \tracingstats2
- \tracingpages1
- \tracinglostchars2 % 2 gives us more in etex
- \tracingparagraphs1
- \tracingoutput1
- \tracingmacros2
- \tracingrestores1
- \showboxbreadth\maxdimen \showboxdepth\maxdimen
- \ifx\eTeXversion\undefined\else % etex gives us more logging
- \tracingscantokens1
- \tracingifs1
- \tracinggroups1
- \tracingnesting2
- \tracingassigns1
- \fi
- \tracingcommands3 % 3 gives us more in etex
- \errorcontextlines16
-}%
-
-% add check for \lastpenalty to plain's definitions. If the last thing
-% we did was a \nobreak, we don't want to insert more space.
-%
-\def\smallbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\smallskipamount
- \removelastskip\penalty-50\smallskip\fi\fi}
-\def\medbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\medskipamount
- \removelastskip\penalty-100\medskip\fi\fi}
-\def\bigbreak{\ifnum\lastpenalty<10000\par\ifdim\lastskip<\bigskipamount
- \removelastskip\penalty-200\bigskip\fi\fi}
-
-% For @cropmarks command.
-% Do @cropmarks to get crop marks.
-%
-\newif\ifcropmarks
-\let\cropmarks = \cropmarkstrue
-%
-% Dimensions to add cropmarks at corners.
-% Added by P. A. MacKay, 12 Nov. 1986
-%
-\newdimen\outerhsize \newdimen\outervsize % set by the paper size routines
-\newdimen\cornerlong \cornerlong=1pc
-\newdimen\cornerthick \cornerthick=.3pt
-\newdimen\topandbottommargin \topandbottommargin=.75in
-
-% Main output routine.
-\chardef\PAGE = 255
-\output = {\onepageout{\pagecontents\PAGE}}
-
-\newbox\headlinebox
-\newbox\footlinebox
-
-% \onepageout takes a vbox as an argument. Note that \pagecontents
-% does insertions, but you have to call it yourself.
-\def\onepageout#1{%
- \ifcropmarks \hoffset=0pt \else \hoffset=\normaloffset \fi
- %
- \ifodd\pageno \advance\hoffset by \bindingoffset
- \else \advance\hoffset by -\bindingoffset\fi
- %
- % Do this outside of the \shipout so @code etc. will be expanded in
- % the headline as they should be, not taken literally (outputting ''code).
- \setbox\headlinebox = \vbox{\let\hsize=\pagewidth \makeheadline}%
- \setbox\footlinebox = \vbox{\let\hsize=\pagewidth \makefootline}%
- %
- {%
- % Have to do this stuff outside the \shipout because we want it to
- % take effect in \write's, yet the group defined by the \vbox ends
- % before the \shipout runs.
- %
- \indexdummies % don't expand commands in the output.
- \shipout\vbox{%
- % Do this early so pdf references go to the beginning of the page.
- \ifpdfmakepagedest \pdfdest name{\the\pageno} xyz\fi
- %
- \ifcropmarks \vbox to \outervsize\bgroup
- \hsize = \outerhsize
- \vskip-\topandbottommargin
- \vtop to0pt{%
- \line{\ewtop\hfil\ewtop}%
- \nointerlineskip
- \line{%
- \vbox{\moveleft\cornerthick\nstop}%
- \hfill
- \vbox{\moveright\cornerthick\nstop}%
- }%
- \vss}%
- \vskip\topandbottommargin
- \line\bgroup
- \hfil % center the page within the outer (page) hsize.
- \ifodd\pageno\hskip\bindingoffset\fi
- \vbox\bgroup
- \fi
- %
- \unvbox\headlinebox
- \pagebody{#1}%
- \ifdim\ht\footlinebox > 0pt
- % Only leave this space if the footline is nonempty.
- % (We lessened \vsize for it in \oddfootingxxx.)
- % The \baselineskip=24pt in plain's \makefootline has no effect.
- \vskip 2\baselineskip
- \unvbox\footlinebox
- \fi
- %
- \ifcropmarks
- \egroup % end of \vbox\bgroup
- \hfil\egroup % end of (centering) \line\bgroup
- \vskip\topandbottommargin plus1fill minus1fill
- \boxmaxdepth = \cornerthick
- \vbox to0pt{\vss
- \line{%
- \vbox{\moveleft\cornerthick\nsbot}%
- \hfill
- \vbox{\moveright\cornerthick\nsbot}%
- }%
- \nointerlineskip
- \line{\ewbot\hfil\ewbot}%
- }%
- \egroup % \vbox from first cropmarks clause
- \fi
- }% end of \shipout\vbox
- }% end of group with \indexdummies
- \advancepageno
- \ifnum\outputpenalty>-20000 \else\dosupereject\fi
-}
-
-\newinsert\margin \dimen\margin=\maxdimen
-
-\def\pagebody#1{\vbox to\pageheight{\boxmaxdepth=\maxdepth #1}}
-{\catcode`\@ =11
-\gdef\pagecontents#1{\ifvoid\topins\else\unvbox\topins\fi
-% marginal hacks, juha@viisa.uucp (Juha Takala)
-\ifvoid\margin\else % marginal info is present
- \rlap{\kern\hsize\vbox to\z@{\kern1pt\box\margin \vss}}\fi
-\dimen@=\dp#1 \unvbox#1
-\ifvoid\footins\else\vskip\skip\footins\footnoterule \unvbox\footins\fi
-\ifr@ggedbottom \kern-\dimen@ \vfil \fi}
-}
-
-% Here are the rules for the cropmarks. Note that they are
-% offset so that the space between them is truly \outerhsize or \outervsize
-% (P. A. MacKay, 12 November, 1986)
-%
-\def\ewtop{\vrule height\cornerthick depth0pt width\cornerlong}
-\def\nstop{\vbox
- {\hrule height\cornerthick depth\cornerlong width\cornerthick}}
-\def\ewbot{\vrule height0pt depth\cornerthick width\cornerlong}
-\def\nsbot{\vbox
- {\hrule height\cornerlong depth\cornerthick width\cornerthick}}
-
-% Parse an argument, then pass it to #1. The argument is the rest of
-% the input line (except we remove a trailing comment). #1 should be a
-% macro which expects an ordinary undelimited TeX argument.
-%
-\def\parsearg{\parseargusing{}}
-\def\parseargusing#1#2{%
- \def\next{#2}%
- \begingroup
- \obeylines
- \spaceisspace
- #1%
- \parseargline\empty% Insert the \empty token, see \finishparsearg below.
-}
-
-{\obeylines %
- \gdef\parseargline#1^^M{%
- \endgroup % End of the group started in \parsearg.
- \argremovecomment #1\comment\ArgTerm%
- }%
-}
-
-% First remove any @comment, then any @c comment.
-\def\argremovecomment#1\comment#2\ArgTerm{\argremovec #1\c\ArgTerm}
-\def\argremovec#1\c#2\ArgTerm{\argcheckspaces#1\^^M\ArgTerm}
-
-% Each occurence of `\^^M' or `<space>\^^M' is replaced by a single space.
-%
-% \argremovec might leave us with trailing space, e.g.,
-% @end itemize @c foo
-% This space token undergoes the same procedure and is eventually removed
-% by \finishparsearg.
-%
-\def\argcheckspaces#1\^^M{\argcheckspacesX#1\^^M \^^M}
-\def\argcheckspacesX#1 \^^M{\argcheckspacesY#1\^^M}
-\def\argcheckspacesY#1\^^M#2\^^M#3\ArgTerm{%
- \def\temp{#3}%
- \ifx\temp\empty
- % We cannot use \next here, as it holds the macro to run;
- % thus we reuse \temp.
- \let\temp\finishparsearg
- \else
- \let\temp\argcheckspaces
- \fi
- % Put the space token in:
- \temp#1 #3\ArgTerm
-}
-
-% If a _delimited_ argument is enclosed in braces, they get stripped; so
-% to get _exactly_ the rest of the line, we had to prevent such situation.
-% We prepended an \empty token at the very beginning and we expand it now,
-% just before passing the control to \next.
-% (Similarily, we have to think about #3 of \argcheckspacesY above: it is
-% either the null string, or it ends with \^^M---thus there is no danger
-% that a pair of braces would be stripped.
-%
-% But first, we have to remove the trailing space token.
-%
-\def\finishparsearg#1 \ArgTerm{\expandafter\next\expandafter{#1}}
-
-% \parseargdef\foo{...}
-% is roughly equivalent to
-% \def\foo{\parsearg\Xfoo}
-% \def\Xfoo#1{...}
-%
-% Actually, I use \csname\string\foo\endcsname, ie. \\foo, as it is my
-% favourite TeX trick. --kasal, 16nov03
-
-\def\parseargdef#1{%
- \expandafter \doparseargdef \csname\string#1\endcsname #1%
-}
-\def\doparseargdef#1#2{%
- \def#2{\parsearg#1}%
- \def#1##1%
-}
-
-% Several utility definitions with active space:
-{
- \obeyspaces
- \gdef\obeyedspace{ }
-
- % Make each space character in the input produce a normal interword
- % space in the output. Don't allow a line break at this space, as this
- % is used only in environments like @example, where each line of input
- % should produce a line of output anyway.
- %
- \gdef\sepspaces{\obeyspaces\let =\tie}
-
- % If an index command is used in an @example environment, any spaces
- % therein should become regular spaces in the raw index file, not the
- % expansion of \tie (\leavevmode \penalty \@M \ ).
- \gdef\unsepspaces{\let =\space}
-}
-
-
-\def\flushcr{\ifx\par\lisppar \def\next##1{}\else \let\next=\relax \fi \next}
-
-% Define the framework for environments in texinfo.tex. It's used like this:
-%
-% \envdef\foo{...}
-% \def\Efoo{...}
-%
-% It's the responsibility of \envdef to insert \begingroup before the
-% actual body; @end closes the group after calling \Efoo. \envdef also
-% defines \thisenv, so the current environment is known; @end checks
-% whether the environment name matches. The \checkenv macro can also be
-% used to check whether the current environment is the one expected.
-%
-% Non-false conditionals (@iftex, @ifset) don't fit into this, so they
-% are not treated as enviroments; they don't open a group. (The
-% implementation of @end takes care not to call \endgroup in this
-% special case.)
-
-
-% At runtime, environments start with this:
-\def\startenvironment#1{\begingroup\def\thisenv{#1}}
-% initialize
-\let\thisenv\empty
-
-% ... but they get defined via ``\envdef\foo{...}'':
-\long\def\envdef#1#2{\def#1{\startenvironment#1#2}}
-\def\envparseargdef#1#2{\parseargdef#1{\startenvironment#1#2}}
-
-% Check whether we're in the right environment:
-\def\checkenv#1{%
- \def\temp{#1}%
- \ifx\thisenv\temp
- \else
- \badenverr
- \fi
-}
-
-% Evironment mismatch, #1 expected:
-\def\badenverr{%
- \errhelp = \EMsimple
- \errmessage{This command can appear only \inenvironment\temp,
- not \inenvironment\thisenv}%
-}
-\def\inenvironment#1{%
- \ifx#1\empty
- out of any environment%
- \else
- in environment \expandafter\string#1%
- \fi
-}
-
-% @end foo executes the definition of \Efoo.
-% But first, it executes a specialized version of \checkenv
-%
-\parseargdef\end{%
- \if 1\csname iscond.#1\endcsname
- \else
- % The general wording of \badenverr may not be ideal, but... --kasal, 06nov03
- \expandafter\checkenv\csname#1\endcsname
- \csname E#1\endcsname
- \endgroup
- \fi
-}
-
-\newhelp\EMsimple{Press RETURN to continue.}
-
-
-%% Simple single-character @ commands
-
-% @@ prints an @
-% Kludge this until the fonts are right (grr).
-\def\@{{\tt\char64}}
-
-% This is turned off because it was never documented
-% and you can use @w{...} around a quote to suppress ligatures.
-%% Define @` and @' to be the same as ` and '
-%% but suppressing ligatures.
-%\def\`{{`}}
-%\def\'{{'}}
-
-% Used to generate quoted braces.
-\def\mylbrace {{\tt\char123}}
-\def\myrbrace {{\tt\char125}}
-\let\{=\mylbrace
-\let\}=\myrbrace
-\begingroup
- % Definitions to produce \{ and \} commands for indices,
- % and @{ and @} for the aux/toc files.
- \catcode`\{ = \other \catcode`\} = \other
- \catcode`\[ = 1 \catcode`\] = 2
- \catcode`\! = 0 \catcode`\\ = \other
- !gdef!lbracecmd[\{]%
- !gdef!rbracecmd[\}]%
- !gdef!lbraceatcmd[@{]%
- !gdef!rbraceatcmd[@}]%
-!endgroup
-
-% @comma{} to avoid , parsing problems.
-\let\comma = ,
-
-% Accents: @, @dotaccent @ringaccent @ubaraccent @udotaccent
-% Others are defined by plain TeX: @` @' @" @^ @~ @= @u @v @H.
-\let\, = \c
-\let\dotaccent = \.
-\def\ringaccent#1{{\accent23 #1}}
-\let\tieaccent = \t
-\let\ubaraccent = \b
-\let\udotaccent = \d
-
-% Other special characters: @questiondown @exclamdown @ordf @ordm
-% Plain TeX defines: @AA @AE @O @OE @L (plus lowercase versions) @ss.
-\def\questiondown{?`}
-\def\exclamdown{!`}
-\def\ordf{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{a}}}
-\def\ordm{\leavevmode\raise1ex\hbox{\selectfonts\lllsize \underbar{o}}}
-
-% Dotless i and dotless j, used for accents.
-\def\imacro{i}
-\def\jmacro{j}
-\def\dotless#1{%
- \def\temp{#1}%
- \ifx\temp\imacro \ptexi
- \else\ifx\temp\jmacro \j
- \else \errmessage{@dotless can be used only with i or j}%
- \fi\fi
-}
-
-% The \TeX{} logo, as in plain, but resetting the spacing so that a
-% period following counts as ending a sentence. (Idea found in latex.)
-%
-\edef\TeX{\TeX \spacefactor=1000 }
-
-% @LaTeX{} logo. Not quite the same results as the definition in
-% latex.ltx, since we use a different font for the raised A; it's most
-% convenient for us to use an explicitly smaller font, rather than using
-% the \scriptstyle font (since we don't reset \scriptstyle and
-% \scriptscriptstyle).
-%
-\def\LaTeX{%
- L\kern-.36em
- {\setbox0=\hbox{T}%
- \vbox to \ht0{\hbox{\selectfonts\lllsize A}\vss}}%
- \kern-.15em
- \TeX
-}
-
-% Be sure we're in horizontal mode when doing a tie, since we make space
-% equivalent to this in @example-like environments. Otherwise, a space
-% at the beginning of a line will start with \penalty -- and
-% since \penalty is valid in vertical mode, we'd end up putting the
-% penalty on the vertical list instead of in the new paragraph.
-{\catcode`@ = 11
- % Avoid using \@M directly, because that causes trouble
- % if the definition is written into an index file.
- \global\let\tiepenalty = \@M
- \gdef\tie{\leavevmode\penalty\tiepenalty\ }
-}
-
-% @: forces normal size whitespace following.
-\def\:{\spacefactor=1000 }
-
-% @* forces a line break.
-\def\*{\hfil\break\hbox{}\ignorespaces}
-
-% @/ allows a line break.
-\let\/=\allowbreak
-
-% @. is an end-of-sentence period.
-\def\.{.\spacefactor=\endofsentencespacefactor\space}
-
-% @! is an end-of-sentence bang.
-\def\!{!\spacefactor=\endofsentencespacefactor\space}
-
-% @? is an end-of-sentence query.
-\def\?{?\spacefactor=\endofsentencespacefactor\space}
-
-% @frenchspacing on|off says whether to put extra space after punctuation.
-%
-\def\onword{on}
-\def\offword{off}
-%
-\parseargdef\frenchspacing{%
- \def\temp{#1}%
- \ifx\temp\onword \plainfrenchspacing
- \else\ifx\temp\offword \plainnonfrenchspacing
- \else
- \errhelp = \EMsimple
- \errmessage{Unknown @frenchspacing option `\temp', must be on/off}%
- \fi\fi
-}
-
-% @w prevents a word break. Without the \leavevmode, @w at the
-% beginning of a paragraph, when TeX is still in vertical mode, would
-% produce a whole line of output instead of starting the paragraph.
-\def\w#1{\leavevmode\hbox{#1}}
-
-% @group ... @end group forces ... to be all on one page, by enclosing
-% it in a TeX vbox. We use \vtop instead of \vbox to construct the box
-% to keep its height that of a normal line. According to the rules for
-% \topskip (p.114 of the TeXbook), the glue inserted is
-% max (\topskip - \ht (first item), 0). If that height is large,
-% therefore, no glue is inserted, and the space between the headline and
-% the text is small, which looks bad.
-%
-% Another complication is that the group might be very large. This can
-% cause the glue on the previous page to be unduly stretched, because it
-% does not have much material. In this case, it's better to add an
-% explicit \vfill so that the extra space is at the bottom. The
-% threshold for doing this is if the group is more than \vfilllimit
-% percent of a page (\vfilllimit can be changed inside of @tex).
-%
-\newbox\groupbox
-\def\vfilllimit{0.7}
-%
-\envdef\group{%
- \ifnum\catcode`\^^M=\active \else
- \errhelp = \groupinvalidhelp
- \errmessage{@group invalid in context where filling is enabled}%
- \fi
- \startsavinginserts
- %
- \setbox\groupbox = \vtop\bgroup
- % Do @comment since we are called inside an environment such as
- % @example, where each end-of-line in the input causes an
- % end-of-line in the output. We don't want the end-of-line after
- % the `@group' to put extra space in the output. Since @group
- % should appear on a line by itself (according to the Texinfo
- % manual), we don't worry about eating any user text.
- \comment
-}
-%
-% The \vtop produces a box with normal height and large depth; thus, TeX puts
-% \baselineskip glue before it, and (when the next line of text is done)
-% \lineskip glue after it. Thus, space below is not quite equal to space
-% above. But it's pretty close.
-\def\Egroup{%
- % To get correct interline space between the last line of the group
- % and the first line afterwards, we have to propagate \prevdepth.
- \endgraf % Not \par, as it may have been set to \lisppar.
- \global\dimen1 = \prevdepth
- \egroup % End the \vtop.
- % \dimen0 is the vertical size of the group's box.
- \dimen0 = \ht\groupbox \advance\dimen0 by \dp\groupbox
- % \dimen2 is how much space is left on the page (more or less).
- \dimen2 = \pageheight \advance\dimen2 by -\pagetotal
- % if the group doesn't fit on the current page, and it's a big big
- % group, force a page break.
- \ifdim \dimen0 > \dimen2
- \ifdim \pagetotal < \vfilllimit\pageheight
- \page
- \fi
- \fi
- \box\groupbox
- \prevdepth = \dimen1
- \checkinserts
-}
-%
-% TeX puts in an \escapechar (i.e., `@') at the beginning of the help
-% message, so this ends up printing `@group can only ...'.
-%
-\newhelp\groupinvalidhelp{%
-group can only be used in environments such as @example,^^J%
-where each line of input produces a line of output.}
-
-% @need space-in-mils
-% forces a page break if there is not space-in-mils remaining.
-
-\newdimen\mil \mil=0.001in
-
-% Old definition--didn't work.
-%\parseargdef\need{\par %
-%% This method tries to make TeX break the page naturally
-%% if the depth of the box does not fit.
-%{\baselineskip=0pt%
-%\vtop to #1\mil{\vfil}\kern -#1\mil\nobreak
-%\prevdepth=-1000pt
-%}}
-
-\parseargdef\need{%
- % Ensure vertical mode, so we don't make a big box in the middle of a
- % paragraph.
- \par
- %
- % If the @need value is less than one line space, it's useless.
- \dimen0 = #1\mil
- \dimen2 = \ht\strutbox
- \advance\dimen2 by \dp\strutbox
- \ifdim\dimen0 > \dimen2
- %
- % Do a \strut just to make the height of this box be normal, so the
- % normal leading is inserted relative to the preceding line.
- % And a page break here is fine.
- \vtop to #1\mil{\strut\vfil}%
- %
- % TeX does not even consider page breaks if a penalty added to the
- % main vertical list is 10000 or more. But in order to see if the
- % empty box we just added fits on the page, we must make it consider
- % page breaks. On the other hand, we don't want to actually break the
- % page after the empty box. So we use a penalty of 9999.
- %
- % There is an extremely small chance that TeX will actually break the
- % page at this \penalty, if there are no other feasible breakpoints in
- % sight. (If the user is using lots of big @group commands, which
- % almost-but-not-quite fill up a page, TeX will have a hard time doing
- % good page breaking, for example.) However, I could not construct an
- % example where a page broke at this \penalty; if it happens in a real
- % document, then we can reconsider our strategy.
- \penalty9999
- %
- % Back up by the size of the box, whether we did a page break or not.
- \kern -#1\mil
- %
- % Do not allow a page break right after this kern.
- \nobreak
- \fi
-}
-
-% @br forces paragraph break (and is undocumented).
-
-\let\br = \par
-
-% @page forces the start of a new page.
-%
-\def\page{\par\vfill\supereject}
-
-% @exdent text....
-% outputs text on separate line in roman font, starting at standard page margin
-
-% This records the amount of indent in the innermost environment.
-% That's how much \exdent should take out.
-\newskip\exdentamount
-
-% This defn is used inside fill environments such as @defun.
-\parseargdef\exdent{\hfil\break\hbox{\kern -\exdentamount{\rm#1}}\hfil\break}
-
-% This defn is used inside nofill environments such as @example.
-\parseargdef\nofillexdent{{\advance \leftskip by -\exdentamount
- \leftline{\hskip\leftskip{\rm#1}}}}
-
-% @inmargin{WHICH}{TEXT} puts TEXT in the WHICH margin next to the current
-% paragraph. For more general purposes, use the \margin insertion
-% class. WHICH is `l' or `r'.
-%
-\newskip\inmarginspacing \inmarginspacing=1cm
-\def\strutdepth{\dp\strutbox}
-%
-\def\doinmargin#1#2{\strut\vadjust{%
- \nobreak
- \kern-\strutdepth
- \vtop to \strutdepth{%
- \baselineskip=\strutdepth
- \vss
- % if you have multiple lines of stuff to put here, you'll need to
- % make the vbox yourself of the appropriate size.
- \ifx#1l%
- \llap{\ignorespaces #2\hskip\inmarginspacing}%
- \else
- \rlap{\hskip\hsize \hskip\inmarginspacing \ignorespaces #2}%
- \fi
- \null
- }%
-}}
-\def\inleftmargin{\doinmargin l}
-\def\inrightmargin{\doinmargin r}
-%
-% @inmargin{TEXT [, RIGHT-TEXT]}
-% (if RIGHT-TEXT is given, use TEXT for left page, RIGHT-TEXT for right;
-% else use TEXT for both).
-%
-\def\inmargin#1{\parseinmargin #1,,\finish}
-\def\parseinmargin#1,#2,#3\finish{% not perfect, but better than nothing.
- \setbox0 = \hbox{\ignorespaces #2}%
- \ifdim\wd0 > 0pt
- \def\lefttext{#1}% have both texts
- \def\righttext{#2}%
- \else
- \def\lefttext{#1}% have only one text
- \def\righttext{#1}%
- \fi
- %
- \ifodd\pageno
- \def\temp{\inrightmargin\righttext}% odd page -> outside is right margin
- \else
- \def\temp{\inleftmargin\lefttext}%
- \fi
- \temp
-}
-
-% @include file insert text of that file as input.
-%
-\def\include{\parseargusing\filenamecatcodes\includezzz}
-\def\includezzz#1{%
- \pushthisfilestack
- \def\thisfile{#1}%
- {%
- \makevalueexpandable
- \def\temp{\input #1 }%
- \expandafter
- }\temp
- \popthisfilestack
-}
-\def\filenamecatcodes{%
- \catcode`\\=\other
- \catcode`~=\other
- \catcode`^=\other
- \catcode`_=\other
- \catcode`|=\other
- \catcode`<=\other
- \catcode`>=\other
- \catcode`+=\other
- \catcode`-=\other
-}
-
-\def\pushthisfilestack{%
- \expandafter\pushthisfilestackX\popthisfilestack\StackTerm
-}
-\def\pushthisfilestackX{%
- \expandafter\pushthisfilestackY\thisfile\StackTerm
-}
-\def\pushthisfilestackY #1\StackTerm #2\StackTerm {%
- \gdef\popthisfilestack{\gdef\thisfile{#1}\gdef\popthisfilestack{#2}}%
-}
-
-\def\popthisfilestack{\errthisfilestackempty}
-\def\errthisfilestackempty{\errmessage{Internal error:
- the stack of filenames is empty.}}
-
-\def\thisfile{}
-
-% @center line
-% outputs that line, centered.
-%
-\parseargdef\center{%
- \ifhmode
- \let\next\centerH
- \else
- \let\next\centerV
- \fi
- \next{\hfil \ignorespaces#1\unskip \hfil}%
-}
-\def\centerH#1{%
- {%
- \hfil\break
- \advance\hsize by -\leftskip
- \advance\hsize by -\rightskip
- \line{#1}%
- \break
- }%
-}
-\def\centerV#1{\line{\kern\leftskip #1\kern\rightskip}}
-
-% @sp n outputs n lines of vertical space
-
-\parseargdef\sp{\vskip #1\baselineskip}
-
-% @comment ...line which is ignored...
-% @c is the same as @comment
-% @ignore ... @end ignore is another way to write a comment
-
-\def\comment{\begingroup \catcode`\^^M=\other%
-\catcode`\@=\other \catcode`\{=\other \catcode`\}=\other%
-\commentxxx}
-{\catcode`\^^M=\other \gdef\commentxxx#1^^M{\endgroup}}
-
-\let\c=\comment
-
-% @paragraphindent NCHARS
-% We'll use ems for NCHARS, close enough.
-% NCHARS can also be the word `asis' or `none'.
-% We cannot feasibly implement @paragraphindent asis, though.
-%
-\def\asisword{asis} % no translation, these are keywords
-\def\noneword{none}
-%
-\parseargdef\paragraphindent{%
- \def\temp{#1}%
- \ifx\temp\asisword
- \else
- \ifx\temp\noneword
- \defaultparindent = 0pt
- \else
- \defaultparindent = #1em
- \fi
- \fi
- \parindent = \defaultparindent
-}
-
-% @exampleindent NCHARS
-% We'll use ems for NCHARS like @paragraphindent.
-% It seems @exampleindent asis isn't necessary, but
-% I preserve it to make it similar to @paragraphindent.
-\parseargdef\exampleindent{%
- \def\temp{#1}%
- \ifx\temp\asisword
- \else
- \ifx\temp\noneword
- \lispnarrowing = 0pt
- \else
- \lispnarrowing = #1em
- \fi
- \fi
-}
-
-% @firstparagraphindent WORD
-% If WORD is `none', then suppress indentation of the first paragraph
-% after a section heading. If WORD is `insert', then do indent at such
-% paragraphs.
-%
-% The paragraph indentation is suppressed or not by calling
-% \suppressfirstparagraphindent, which the sectioning commands do.
-% We switch the definition of this back and forth according to WORD.
-% By default, we suppress indentation.
-%
-\def\suppressfirstparagraphindent{\dosuppressfirstparagraphindent}
-\def\insertword{insert}
-%
-\parseargdef\firstparagraphindent{%
- \def\temp{#1}%
- \ifx\temp\noneword
- \let\suppressfirstparagraphindent = \dosuppressfirstparagraphindent
- \else\ifx\temp\insertword
- \let\suppressfirstparagraphindent = \relax
- \else
- \errhelp = \EMsimple
- \errmessage{Unknown @firstparagraphindent option `\temp'}%
- \fi\fi
-}
-
-% Here is how we actually suppress indentation. Redefine \everypar to
-% \kern backwards by \parindent, and then reset itself to empty.
-%
-% We also make \indent itself not actually do anything until the next
-% paragraph.
-%
-\gdef\dosuppressfirstparagraphindent{%
- \gdef\indent{%
- \restorefirstparagraphindent
- \indent
- }%
- \gdef\noindent{%
- \restorefirstparagraphindent
- \noindent
- }%
- \global\everypar = {%
- \kern -\parindent
- \restorefirstparagraphindent
- }%
-}
-
-\gdef\restorefirstparagraphindent{%
- \global \let \indent = \ptexindent
- \global \let \noindent = \ptexnoindent
- \global \everypar = {}%
-}
-
-
-% @asis just yields its argument. Used with @table, for example.
-%
-\def\asis#1{#1}
-
-% @math outputs its argument in math mode.
-%
-% One complication: _ usually means subscripts, but it could also mean
-% an actual _ character, as in @math{@var{some_variable} + 1}. So make
-% _ active, and distinguish by seeing if the current family is \slfam,
-% which is what @var uses.
-{
- \catcode\underChar = \active
- \gdef\mathunderscore{%
- \catcode\underChar=\active
- \def_{\ifnum\fam=\slfam \_\else\sb\fi}%
- }
-}
-% Another complication: we want \\ (and @\) to output a \ character.
-% FYI, plain.tex uses \\ as a temporary control sequence (why?), but
-% this is not advertised and we don't care. Texinfo does not
-% otherwise define @\.
-%
-% The \mathchar is class=0=ordinary, family=7=ttfam, position=5C=\.
-\def\mathbackslash{\ifnum\fam=\ttfam \mathchar"075C \else\backslash \fi}
-%
-\def\math{%
- \tex
- \mathunderscore
- \let\\ = \mathbackslash
- \mathactive
- $\finishmath
-}
-\def\finishmath#1{#1$\endgroup} % Close the group opened by \tex.
-
-% Some active characters (such as <) are spaced differently in math.
-% We have to reset their definitions in case the @math was an argument
-% to a command which sets the catcodes (such as @item or @section).
-%
-{
- \catcode`^ = \active
- \catcode`< = \active
- \catcode`> = \active
- \catcode`+ = \active
- \gdef\mathactive{%
- \let^ = \ptexhat
- \let< = \ptexless
- \let> = \ptexgtr
- \let+ = \ptexplus
- }
-}
-
-% @bullet and @minus need the same treatment as @math, just above.
-\def\bullet{$\ptexbullet$}
-\def\minus{$-$}
-
-% @dots{} outputs an ellipsis using the current font.
-% We do .5em per period so that it has the same spacing in a typewriter
-% font as three actual period characters.
-%
-\def\dots{%
- \leavevmode
- \hbox to 1.5em{%
- \hskip 0pt plus 0.25fil
- .\hfil.\hfil.%
- \hskip 0pt plus 0.5fil
- }%
-}
-
-% @enddots{} is an end-of-sentence ellipsis.
-%
-\def\enddots{%
- \dots
- \spacefactor=\endofsentencespacefactor
-}
-
-% @comma{} is so commas can be inserted into text without messing up
-% Texinfo's parsing.
-%
-\let\comma = ,
-
-% @refill is a no-op.
-\let\refill=\relax
-
-% If working on a large document in chapters, it is convenient to
-% be able to disable indexing, cross-referencing, and contents, for test runs.
-% This is done with @novalidate (before @setfilename).
-%
-\newif\iflinks \linkstrue % by default we want the aux files.
-\let\novalidate = \linksfalse
-
-% @setfilename is done at the beginning of every texinfo file.
-% So open here the files we need to have open while reading the input.
-% This makes it possible to make a .fmt file for texinfo.
-\def\setfilename{%
- \fixbackslash % Turn off hack to swallow `\input texinfo'.
- \iflinks
- \tryauxfile
- % Open the new aux file. TeX will close it automatically at exit.
- \immediate\openout\auxfile=\jobname.aux
- \fi % \openindices needs to do some work in any case.
- \openindices
- \let\setfilename=\comment % Ignore extra @setfilename cmds.
- %
- % If texinfo.cnf is present on the system, read it.
- % Useful for site-wide @afourpaper, etc.
- \openin 1 texinfo.cnf
- \ifeof 1 \else \input texinfo.cnf \fi
- \closein 1
- %
- \comment % Ignore the actual filename.
-}
-
-% Called from \setfilename.
-%
-\def\openindices{%
- \newindex{cp}%
- \newcodeindex{fn}%
- \newcodeindex{vr}%
- \newcodeindex{tp}%
- \newcodeindex{ky}%
- \newcodeindex{pg}%
-}
-
-% @bye.
-\outer\def\bye{\pagealignmacro\tracingstats=1\ptexend}
-
-
-\message{pdf,}
-% adobe `portable' document format
-\newcount\tempnum
-\newcount\lnkcount
-\newtoks\filename
-\newcount\filenamelength
-\newcount\pgn
-\newtoks\toksA
-\newtoks\toksB
-\newtoks\toksC
-\newtoks\toksD
-\newbox\boxA
-\newcount\countA
-\newif\ifpdf
-\newif\ifpdfmakepagedest
-
-% when pdftex is run in dvi mode, \pdfoutput is defined (so \pdfoutput=1
-% can be set). So we test for \relax and 0 as well as \undefined,
-% borrowed from ifpdf.sty.
-\ifx\pdfoutput\undefined
-\else
- \ifx\pdfoutput\relax
- \else
- \ifcase\pdfoutput
- \else
- \pdftrue
- \fi
- \fi
-\fi
-
-% PDF uses PostScript string constants for the names of xref targets, to
-% for display in the outlines, and in other places. Thus, we have to
-% double any backslashes. Otherwise, a name like "\node" will be
-% interpreted as a newline (\n), followed by o, d, e. Not good.
-% http://www.ntg.nl/pipermail/ntg-pdftex/2004-July/000654.html
-% (and related messages, the final outcome is that it is up to the TeX
-% user to double the backslashes and otherwise make the string valid, so
-% that's we do).
-
-% double active backslashes.
-%
-{\catcode`\@=0 \catcode`\\=\active
- @gdef@activebackslash{@catcode`@\=@active @otherbackslash}
- @gdef@activebackslashdouble{%
- @catcode@backChar=@active
- @let\=@doublebackslash}
-}
-
-% To handle parens, we must adopt a different approach, since parens are
-% not active characters. hyperref.dtx (which has the same problem as
-% us) handles it with this amazing macro to replace tokens. I've
-% tinkered with it a little for texinfo, but it's definitely from there.
-%
-% #1 is the tokens to replace.
-% #2 is the replacement.
-% #3 is the control sequence with the string.
-%
-\def\HyPsdSubst#1#2#3{%
- \def\HyPsdReplace##1#1##2\END{%
- ##1%
- \ifx\\##2\\%
- \else
- #2%
- \HyReturnAfterFi{%
- \HyPsdReplace##2\END
- }%
- \fi
- }%
- \xdef#3{\expandafter\HyPsdReplace#3#1\END}%
-}
-\long\def\HyReturnAfterFi#1\fi{\fi#1}
-
-% #1 is a control sequence in which to do the replacements.
-\def\backslashparens#1{%
- \xdef#1{#1}% redefine it as its expansion; the definition is simply
- % \lastnode when called from \setref -> \pdfmkdest.
- \HyPsdSubst{(}{\backslashlparen}{#1}%
- \HyPsdSubst{)}{\backslashrparen}{#1}%
-}
-
-{\catcode\exclamChar = 0 \catcode\backChar = \other
- !gdef!backslashlparen{\(}%
- !gdef!backslashrparen{\)}%
-}
-
-\ifpdf
- \input pdfcolor
- \pdfcatalog{/PageMode /UseOutlines}%
- \def\dopdfimage#1#2#3{%
- \def\imagewidth{#2}%
- \def\imageheight{#3}%
- % without \immediate, pdftex seg faults when the same image is
- % included twice. (Version 3.14159-pre-1.0-unofficial-20010704.)
- \ifnum\pdftexversion < 14
- \immediate\pdfimage
- \else
- \immediate\pdfximage
- \fi
- \ifx\empty\imagewidth\else width \imagewidth \fi
- \ifx\empty\imageheight\else height \imageheight \fi
- \ifnum\pdftexversion<13
- #1.pdf%
- \else
- {#1.pdf}%
- \fi
- \ifnum\pdftexversion < 14 \else
- \pdfrefximage \pdflastximage
- \fi}
- \def\pdfmkdest#1{{%
- % We have to set dummies so commands such as @code, and characters
- % such as \, aren't expanded when present in a section title.
- \atdummies
- \activebackslashdouble
- \def\pdfdestname{#1}%
- \backslashparens\pdfdestname
- \pdfdest name{\pdfdestname} xyz%
- }}%
- %
- % used to mark target names; must be expandable.
- \def\pdfmkpgn#1{#1}%
- %
- \let\linkcolor = \Blue % was Cyan, but that seems light?
- \def\endlink{\Black\pdfendlink}
- % Adding outlines to PDF; macros for calculating structure of outlines
- % come from Petr Olsak
- \def\expnumber#1{\expandafter\ifx\csname#1\endcsname\relax 0%
- \else \csname#1\endcsname \fi}
- \def\advancenumber#1{\tempnum=\expnumber{#1}\relax
- \advance\tempnum by 1
- \expandafter\xdef\csname#1\endcsname{\the\tempnum}}
- %
- % #1 is the section text, which is what will be displayed in the
- % outline by the pdf viewer. #2 is the pdf expression for the number
- % of subentries (or empty, for subsubsections). #3 is the node text,
- % which might be empty if this toc entry had no corresponding node.
- % #4 is the page number
- %
- \def\dopdfoutline#1#2#3#4{%
- % Generate a link to the node text if that exists; else, use the
- % page number. We could generate a destination for the section
- % text in the case where a section has no node, but it doesn't
- % seem worth the trouble, since most documents are normally structured.
- \def\pdfoutlinedest{#3}%
- \ifx\pdfoutlinedest\empty
- \def\pdfoutlinedest{#4}%
- \else
- % Doubled backslashes in the name.
- {\activebackslashdouble \xdef\pdfoutlinedest{#3}%
- \backslashparens\pdfoutlinedest}%
- \fi
- %
- % Also double the backslashes in the display string.
- {\activebackslashdouble \xdef\pdfoutlinetext{#1}%
- \backslashparens\pdfoutlinetext}%
- %
- \pdfoutline goto name{\pdfmkpgn{\pdfoutlinedest}}#2{\pdfoutlinetext}%
- }
- %
- \def\pdfmakeoutlines{%
- \begingroup
- % Thanh's hack / proper braces in bookmarks
- \edef\mylbrace{\iftrue \string{\else}\fi}\let\{=\mylbrace
- \edef\myrbrace{\iffalse{\else\string}\fi}\let\}=\myrbrace
- %
- % Read toc silently, to get counts of subentries for \pdfoutline.
- \def\numchapentry##1##2##3##4{%
- \def\thischapnum{##2}%
- \def\thissecnum{0}%
- \def\thissubsecnum{0}%
- }%
- \def\numsecentry##1##2##3##4{%
- \advancenumber{chap\thischapnum}%
- \def\thissecnum{##2}%
- \def\thissubsecnum{0}%
- }%
- \def\numsubsecentry##1##2##3##4{%
- \advancenumber{sec\thissecnum}%
- \def\thissubsecnum{##2}%
- }%
- \def\numsubsubsecentry##1##2##3##4{%
- \advancenumber{subsec\thissubsecnum}%
- }%
- \def\thischapnum{0}%
- \def\thissecnum{0}%
- \def\thissubsecnum{0}%
- %
- % use \def rather than \let here because we redefine \chapentry et
- % al. a second time, below.
- \def\appentry{\numchapentry}%
- \def\appsecentry{\numsecentry}%
- \def\appsubsecentry{\numsubsecentry}%
- \def\appsubsubsecentry{\numsubsubsecentry}%
- \def\unnchapentry{\numchapentry}%
- \def\unnsecentry{\numsecentry}%
- \def\unnsubsecentry{\numsubsecentry}%
- \def\unnsubsubsecentry{\numsubsubsecentry}%
- \readdatafile{toc}%
- %
- % Read toc second time, this time actually producing the outlines.
- % The `-' means take the \expnumber as the absolute number of
- % subentries, which we calculated on our first read of the .toc above.
- %
- % We use the node names as the destinations.
- \def\numchapentry##1##2##3##4{%
- \dopdfoutline{##1}{count-\expnumber{chap##2}}{##3}{##4}}%
- \def\numsecentry##1##2##3##4{%
- \dopdfoutline{##1}{count-\expnumber{sec##2}}{##3}{##4}}%
- \def\numsubsecentry##1##2##3##4{%
- \dopdfoutline{##1}{count-\expnumber{subsec##2}}{##3}{##4}}%
- \def\numsubsubsecentry##1##2##3##4{% count is always zero
- \dopdfoutline{##1}{}{##3}{##4}}%
- %
- % PDF outlines are displayed using system fonts, instead of
- % document fonts. Therefore we cannot use special characters,
- % since the encoding is unknown. For example, the eogonek from
- % Latin 2 (0xea) gets translated to a | character. Info from
- % Staszek Wawrykiewicz, 19 Jan 2004 04:09:24 +0100.
- %
- % xx to do this right, we have to translate 8-bit characters to
- % their "best" equivalent, based on the @documentencoding. Right
- % now, I guess we'll just let the pdf reader have its way.
- \indexnofonts
- \setupdatafile
- \activebackslash
- \input \jobname.toc
- \endgroup
- }
- %
- \def\skipspaces#1{\def\PP{#1}\def\D{|}%
- \ifx\PP\D\let\nextsp\relax
- \else\let\nextsp\skipspaces
- \ifx\p\space\else\addtokens{\filename}{\PP}%
- \advance\filenamelength by 1
- \fi
- \fi
- \nextsp}
- \def\getfilename#1{\filenamelength=0\expandafter\skipspaces#1|\relax}
- \ifnum\pdftexversion < 14
- \let \startlink \pdfannotlink
- \else
- \let \startlink \pdfstartlink
- \fi
- \def\pdfurl#1{%
- \begingroup
- \normalturnoffactive\def\@{@}%
- \makevalueexpandable
- \leavevmode\Red
- \startlink attr{/Border [0 0 0]}%
- user{/Subtype /Link /A << /S /URI /URI (#1) >>}%
- \endgroup}
- \def\pdfgettoks#1.{\setbox\boxA=\hbox{\toksA={#1.}\toksB={}\maketoks}}
- \def\addtokens#1#2{\edef\addtoks{\noexpand#1={\the#1#2}}\addtoks}
- \def\adn#1{\addtokens{\toksC}{#1}\global\countA=1\let\next=\maketoks}
- \def\poptoks#1#2|ENDTOKS|{\let\first=#1\toksD={#1}\toksA={#2}}
- \def\maketoks{%
- \expandafter\poptoks\the\toksA|ENDTOKS|\relax
- \ifx\first0\adn0
- \else\ifx\first1\adn1 \else\ifx\first2\adn2 \else\ifx\first3\adn3
- \else\ifx\first4\adn4 \else\ifx\first5\adn5 \else\ifx\first6\adn6
- \else\ifx\first7\adn7 \else\ifx\first8\adn8 \else\ifx\first9\adn9
- \else
- \ifnum0=\countA\else\makelink\fi
- \ifx\first.\let\next=\done\else
- \let\next=\maketoks
- \addtokens{\toksB}{\the\toksD}
- \ifx\first,\addtokens{\toksB}{\space}\fi
- \fi
- \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
- \next}
- \def\makelink{\addtokens{\toksB}%
- {\noexpand\pdflink{\the\toksC}}\toksC={}\global\countA=0}
- \def\pdflink#1{%
- \startlink attr{/Border [0 0 0]} goto name{\pdfmkpgn{#1}}
- \linkcolor #1\endlink}
- \def\done{\edef\st{\global\noexpand\toksA={\the\toksB}}\st}
-\else
- \let\pdfmkdest = \gobble
- \let\pdfurl = \gobble
- \let\endlink = \relax
- \let\linkcolor = \relax
- \let\pdfmakeoutlines = \relax
-\fi % \ifx\pdfoutput
-
-
-\message{fonts,}
-
-% Change the current font style to #1, remembering it in \curfontstyle.
-% For now, we do not accumulate font styles: @b{@i{foo}} prints foo in
-% italics, not bold italics.
-%
-\def\setfontstyle#1{%
- \def\curfontstyle{#1}% not as a control sequence, because we are \edef'd.
- \csname ten#1\endcsname % change the current font
-}
-
-% Select #1 fonts with the current style.
-%
-\def\selectfonts#1{\csname #1fonts\endcsname \csname\curfontstyle\endcsname}
-
-\def\rm{\fam=0 \setfontstyle{rm}}
-\def\it{\fam=\itfam \setfontstyle{it}}
-\def\sl{\fam=\slfam \setfontstyle{sl}}
-\def\bf{\fam=\bffam \setfontstyle{bf}}\def\bfstylename{bf}
-\def\tt{\fam=\ttfam \setfontstyle{tt}}
-
-% Texinfo sort of supports the sans serif font style, which plain TeX does not.
-% So we set up a \sf.
-\newfam\sffam
-\def\sf{\fam=\sffam \setfontstyle{sf}}
-\let\li = \sf % Sometimes we call it \li, not \sf.
-
-% We don't need math for this font style.
-\def\ttsl{\setfontstyle{ttsl}}
-
-% Default leading.
-\newdimen\textleading \textleading = 13.2pt
-
-% Set the baselineskip to #1, and the lineskip and strut size
-% correspondingly. There is no deep meaning behind these magic numbers
-% used as factors; they just match (closely enough) what Knuth defined.
-%
-\def\lineskipfactor{.08333}
-\def\strutheightpercent{.70833}
-\def\strutdepthpercent {.29167}
-%
-\def\setleading#1{%
- \normalbaselineskip = #1\relax
- \normallineskip = \lineskipfactor\normalbaselineskip
- \normalbaselines
- \setbox\strutbox =\hbox{%
- \vrule width0pt height\strutheightpercent\baselineskip
- depth \strutdepthpercent \baselineskip
- }%
-}
-
-% Set the font macro #1 to the font named #2, adding on the
-% specified font prefix (normally `cm').
-% #3 is the font's design size, #4 is a scale factor
-\def\setfont#1#2#3#4{\font#1=\fontprefix#2#3 scaled #4}
-
-% Use cm as the default font prefix.
-% To specify the font prefix, you must define \fontprefix
-% before you read in texinfo.tex.
-\ifx\fontprefix\undefined
-\def\fontprefix{cm}
-\fi
-% Support font families that don't use the same naming scheme as CM.
-\def\rmshape{r}
-\def\rmbshape{bx} %where the normal face is bold
-\def\bfshape{b}
-\def\bxshape{bx}
-\def\ttshape{tt}
-\def\ttbshape{tt}
-\def\ttslshape{sltt}
-\def\itshape{ti}
-\def\itbshape{bxti}
-\def\slshape{sl}
-\def\slbshape{bxsl}
-\def\sfshape{ss}
-\def\sfbshape{ss}
-\def\scshape{csc}
-\def\scbshape{csc}
-
-% Text fonts (11.2pt, magstep1).
-\def\textnominalsize{11pt}
-\edef\mainmagstep{\magstephalf}
-\setfont\textrm\rmshape{10}{\mainmagstep}
-\setfont\texttt\ttshape{10}{\mainmagstep}
-\setfont\textbf\bfshape{10}{\mainmagstep}
-\setfont\textit\itshape{10}{\mainmagstep}
-\setfont\textsl\slshape{10}{\mainmagstep}
-\setfont\textsf\sfshape{10}{\mainmagstep}
-\setfont\textsc\scshape{10}{\mainmagstep}
-\setfont\textttsl\ttslshape{10}{\mainmagstep}
-\font\texti=cmmi10 scaled \mainmagstep
-\font\textsy=cmsy10 scaled \mainmagstep
-
-% A few fonts for @defun names and args.
-\setfont\defbf\bfshape{10}{\magstep1}
-\setfont\deftt\ttshape{10}{\magstep1}
-\setfont\defttsl\ttslshape{10}{\magstep1}
-\def\df{\let\tentt=\deftt \let\tenbf = \defbf \let\tenttsl=\defttsl \bf}
-
-% Fonts for indices, footnotes, small examples (9pt).
-\def\smallnominalsize{9pt}
-\setfont\smallrm\rmshape{9}{1000}
-\setfont\smalltt\ttshape{9}{1000}
-\setfont\smallbf\bfshape{10}{900}
-\setfont\smallit\itshape{9}{1000}
-\setfont\smallsl\slshape{9}{1000}
-\setfont\smallsf\sfshape{9}{1000}
-\setfont\smallsc\scshape{10}{900}
-\setfont\smallttsl\ttslshape{10}{900}
-\font\smalli=cmmi9
-\font\smallsy=cmsy9
-
-% Fonts for small examples (8pt).
-\def\smallernominalsize{8pt}
-\setfont\smallerrm\rmshape{8}{1000}
-\setfont\smallertt\ttshape{8}{1000}
-\setfont\smallerbf\bfshape{10}{800}
-\setfont\smallerit\itshape{8}{1000}
-\setfont\smallersl\slshape{8}{1000}
-\setfont\smallersf\sfshape{8}{1000}
-\setfont\smallersc\scshape{10}{800}
-\setfont\smallerttsl\ttslshape{10}{800}
-\font\smalleri=cmmi8
-\font\smallersy=cmsy8
-
-% Fonts for title page (20.4pt):
-\def\titlenominalsize{20pt}
-\setfont\titlerm\rmbshape{12}{\magstep3}
-\setfont\titleit\itbshape{10}{\magstep4}
-\setfont\titlesl\slbshape{10}{\magstep4}
-\setfont\titlett\ttbshape{12}{\magstep3}
-\setfont\titlettsl\ttslshape{10}{\magstep4}
-\setfont\titlesf\sfbshape{17}{\magstep1}
-\let\titlebf=\titlerm
-\setfont\titlesc\scbshape{10}{\magstep4}
-\font\titlei=cmmi12 scaled \magstep3
-\font\titlesy=cmsy10 scaled \magstep4
-\def\authorrm{\secrm}
-\def\authortt{\sectt}
-
-% Chapter (and unnumbered) fonts (17.28pt).
-\def\chapnominalsize{17pt}
-\setfont\chaprm\rmbshape{12}{\magstep2}
-\setfont\chapit\itbshape{10}{\magstep3}
-\setfont\chapsl\slbshape{10}{\magstep3}
-\setfont\chaptt\ttbshape{12}{\magstep2}
-\setfont\chapttsl\ttslshape{10}{\magstep3}
-\setfont\chapsf\sfbshape{17}{1000}
-\let\chapbf=\chaprm
-\setfont\chapsc\scbshape{10}{\magstep3}
-\font\chapi=cmmi12 scaled \magstep2
-\font\chapsy=cmsy10 scaled \magstep3
-
-% Section fonts (14.4pt).
-\def\secnominalsize{14pt}
-\setfont\secrm\rmbshape{12}{\magstep1}
-\setfont\secit\itbshape{10}{\magstep2}
-\setfont\secsl\slbshape{10}{\magstep2}
-\setfont\sectt\ttbshape{12}{\magstep1}
-\setfont\secttsl\ttslshape{10}{\magstep2}
-\setfont\secsf\sfbshape{12}{\magstep1}
-\let\secbf\secrm
-\setfont\secsc\scbshape{10}{\magstep2}
-\font\seci=cmmi12 scaled \magstep1
-\font\secsy=cmsy10 scaled \magstep2
-
-% Subsection fonts (13.15pt).
-\def\ssecnominalsize{13pt}
-\setfont\ssecrm\rmbshape{12}{\magstephalf}
-\setfont\ssecit\itbshape{10}{1315}
-\setfont\ssecsl\slbshape{10}{1315}
-\setfont\ssectt\ttbshape{12}{\magstephalf}
-\setfont\ssecttsl\ttslshape{10}{1315}
-\setfont\ssecsf\sfbshape{12}{\magstephalf}
-\let\ssecbf\ssecrm
-\setfont\ssecsc\scbshape{10}{1315}
-\font\sseci=cmmi12 scaled \magstephalf
-\font\ssecsy=cmsy10 scaled 1315
-
-% Reduced fonts for @acro in text (10pt).
-\def\reducednominalsize{10pt}
-\setfont\reducedrm\rmshape{10}{1000}
-\setfont\reducedtt\ttshape{10}{1000}
-\setfont\reducedbf\bfshape{10}{1000}
-\setfont\reducedit\itshape{10}{1000}
-\setfont\reducedsl\slshape{10}{1000}
-\setfont\reducedsf\sfshape{10}{1000}
-\setfont\reducedsc\scshape{10}{1000}
-\setfont\reducedttsl\ttslshape{10}{1000}
-\font\reducedi=cmmi10
-\font\reducedsy=cmsy10
-
-% In order for the font changes to affect most math symbols and letters,
-% we have to define the \textfont of the standard families. Since
-% texinfo doesn't allow for producing subscripts and superscripts except
-% in the main text, we don't bother to reset \scriptfont and
-% \scriptscriptfont (which would also require loading a lot more fonts).
-%
-\def\resetmathfonts{%
- \textfont0=\tenrm \textfont1=\teni \textfont2=\tensy
- \textfont\itfam=\tenit \textfont\slfam=\tensl \textfont\bffam=\tenbf
- \textfont\ttfam=\tentt \textfont\sffam=\tensf
-}
-
-% The font-changing commands redefine the meanings of \tenSTYLE, instead
-% of just \STYLE. We do this because \STYLE needs to also set the
-% current \fam for math mode. Our \STYLE (e.g., \rm) commands hardwire
-% \tenSTYLE to set the current font.
-%
-% Each font-changing command also sets the names \lsize (one size lower)
-% and \lllsize (three sizes lower). These relative commands are used in
-% the LaTeX logo and acronyms.
-%
-% This all needs generalizing, badly.
-%
-\def\textfonts{%
- \let\tenrm=\textrm \let\tenit=\textit \let\tensl=\textsl
- \let\tenbf=\textbf \let\tentt=\texttt \let\smallcaps=\textsc
- \let\tensf=\textsf \let\teni=\texti \let\tensy=\textsy
- \let\tenttsl=\textttsl
- \def\curfontsize{text}%
- \def\lsize{reduced}\def\lllsize{smaller}%
- \resetmathfonts \setleading{\textleading}}
-\def\titlefonts{%
- \let\tenrm=\titlerm \let\tenit=\titleit \let\tensl=\titlesl
- \let\tenbf=\titlebf \let\tentt=\titlett \let\smallcaps=\titlesc
- \let\tensf=\titlesf \let\teni=\titlei \let\tensy=\titlesy
- \let\tenttsl=\titlettsl
- \def\curfontsize{title}%
- \def\lsize{chap}\def\lllsize{subsec}%
- \resetmathfonts \setleading{25pt}}
-\def\titlefont#1{{\titlefonts\rm #1}}
-\def\chapfonts{%
- \let\tenrm=\chaprm \let\tenit=\chapit \let\tensl=\chapsl
- \let\tenbf=\chapbf \let\tentt=\chaptt \let\smallcaps=\chapsc
- \let\tensf=\chapsf \let\teni=\chapi \let\tensy=\chapsy
- \let\tenttsl=\chapttsl
- \def\curfontsize{chap}%
- \def\lsize{sec}\def\lllsize{text}%
- \resetmathfonts \setleading{19pt}}
-\def\secfonts{%
- \let\tenrm=\secrm \let\tenit=\secit \let\tensl=\secsl
- \let\tenbf=\secbf \let\tentt=\sectt \let\smallcaps=\secsc
- \let\tensf=\secsf \let\teni=\seci \let\tensy=\secsy
- \let\tenttsl=\secttsl
- \def\curfontsize{sec}%
- \def\lsize{subsec}\def\lllsize{reduced}%
- \resetmathfonts \setleading{16pt}}
-\def\subsecfonts{%
- \let\tenrm=\ssecrm \let\tenit=\ssecit \let\tensl=\ssecsl
- \let\tenbf=\ssecbf \let\tentt=\ssectt \let\smallcaps=\ssecsc
- \let\tensf=\ssecsf \let\teni=\sseci \let\tensy=\ssecsy
- \let\tenttsl=\ssecttsl
- \def\curfontsize{ssec}%
- \def\lsize{text}\def\lllsize{small}%
- \resetmathfonts \setleading{15pt}}
-\let\subsubsecfonts = \subsecfonts
-\def\reducedfonts{%
- \let\tenrm=\reducedrm \let\tenit=\reducedit \let\tensl=\reducedsl
- \let\tenbf=\reducedbf \let\tentt=\reducedtt \let\reducedcaps=\reducedsc
- \let\tensf=\reducedsf \let\teni=\reducedi \let\tensy=\reducedsy
- \let\tenttsl=\reducedttsl
- \def\curfontsize{reduced}%
- \def\lsize{small}\def\lllsize{smaller}%
- \resetmathfonts \setleading{10.5pt}}
-\def\smallfonts{%
- \let\tenrm=\smallrm \let\tenit=\smallit \let\tensl=\smallsl
- \let\tenbf=\smallbf \let\tentt=\smalltt \let\smallcaps=\smallsc
- \let\tensf=\smallsf \let\teni=\smalli \let\tensy=\smallsy
- \let\tenttsl=\smallttsl
- \def\curfontsize{small}%
- \def\lsize{smaller}\def\lllsize{smaller}%
- \resetmathfonts \setleading{10.5pt}}
-\def\smallerfonts{%
- \let\tenrm=\smallerrm \let\tenit=\smallerit \let\tensl=\smallersl
- \let\tenbf=\smallerbf \let\tentt=\smallertt \let\smallcaps=\smallersc
- \let\tensf=\smallersf \let\teni=\smalleri \let\tensy=\smallersy
- \let\tenttsl=\smallerttsl
- \def\curfontsize{smaller}%
- \def\lsize{smaller}\def\lllsize{smaller}%
- \resetmathfonts \setleading{9.5pt}}
-
-% Set the fonts to use with the @small... environments.
-\let\smallexamplefonts = \smallfonts
-
-% About \smallexamplefonts. If we use \smallfonts (9pt), @smallexample
-% can fit this many characters:
-% 8.5x11=86 smallbook=72 a4=90 a5=69
-% If we use \scriptfonts (8pt), then we can fit this many characters:
-% 8.5x11=90+ smallbook=80 a4=90+ a5=77
-% For me, subjectively, the few extra characters that fit aren't worth
-% the additional smallness of 8pt. So I'm making the default 9pt.
-%
-% By the way, for comparison, here's what fits with @example (10pt):
-% 8.5x11=71 smallbook=60 a4=75 a5=58
-%
-% I wish the USA used A4 paper.
-% --karl, 24jan03.
-
-
-% Set up the default fonts, so we can use them for creating boxes.
-%
-\textfonts \rm
-
-% Define these so they can be easily changed for other fonts.
-\def\angleleft{$\langle$}
-\def\angleright{$\rangle$}
-
-% Count depth in font-changes, for error checks
-\newcount\fontdepth \fontdepth=0
-
-% Fonts for short table of contents.
-\setfont\shortcontrm\rmshape{12}{1000}
-\setfont\shortcontbf\bfshape{10}{\magstep1} % no cmb12
-\setfont\shortcontsl\slshape{12}{1000}
-\setfont\shortconttt\ttshape{12}{1000}
-
-%% Add scribe-like font environments, plus @l for inline lisp (usually sans
-%% serif) and @ii for TeX italic
-
-% \smartitalic{ARG} outputs arg in italics, followed by an italic correction
-% unless the following character is such as not to need one.
-\def\smartitalicx{\ifx\next,\else\ifx\next-\else\ifx\next.\else
- \ptexslash\fi\fi\fi}
-\def\smartslanted#1{{\ifusingtt\ttsl\sl #1}\futurelet\next\smartitalicx}
-\def\smartitalic#1{{\ifusingtt\ttsl\it #1}\futurelet\next\smartitalicx}
-
-% like \smartslanted except unconditionally uses \ttsl.
-% @var is set to this for defun arguments.
-\def\ttslanted#1{{\ttsl #1}\futurelet\next\smartitalicx}
-
-% like \smartslanted except unconditionally use \sl. We never want
-% ttsl for book titles, do we?
-\def\cite#1{{\sl #1}\futurelet\next\smartitalicx}
-
-\let\i=\smartitalic
-\let\slanted=\smartslanted
-\let\var=\smartslanted
-\let\dfn=\smartslanted
-\let\emph=\smartitalic
-
-% @b, explicit bold.
-\def\b#1{{\bf #1}}
-\let\strong=\b
-
-% @sansserif, explicit sans.
-\def\sansserif#1{{\sf #1}}
-
-% We can't just use \exhyphenpenalty, because that only has effect at
-% the end of a paragraph. Restore normal hyphenation at the end of the
-% group within which \nohyphenation is presumably called.
-%
-\def\nohyphenation{\hyphenchar\font = -1 \aftergroup\restorehyphenation}
-\def\restorehyphenation{\hyphenchar\font = `- }
-
-% Set sfcode to normal for the chars that usually have another value.
-% Can't use plain's \frenchspacing because it uses the `\x notation, and
-% sometimes \x has an active definition that messes things up.
-%
-\catcode`@=11
- \def\plainfrenchspacing{%
- \sfcode\dotChar =\@m \sfcode\questChar=\@m \sfcode\exclamChar=\@m
- \sfcode\colonChar=\@m \sfcode\semiChar =\@m \sfcode\commaChar =\@m
- \def\endofsentencespacefactor{1000}% for @. and friends
- }
- \def\plainnonfrenchspacing{%
- \sfcode`\.3000\sfcode`\?3000\sfcode`\!3000
- \sfcode`\:2000\sfcode`\;1500\sfcode`\,1250
- \def\endofsentencespacefactor{3000}% for @. and friends
- }
-\catcode`@=\other
-\def\endofsentencespacefactor{3000}% default
-
-\def\t#1{%
- {\tt \rawbackslash \plainfrenchspacing #1}%
- \null
-}
-\def\samp#1{`\tclose{#1}'\null}
-\setfont\keyrm\rmshape{8}{1000}
-\font\keysy=cmsy9
-\def\key#1{{\keyrm\textfont2=\keysy \leavevmode\hbox{%
- \raise0.4pt\hbox{\angleleft}\kern-.08em\vtop{%
- \vbox{\hrule\kern-0.4pt
- \hbox{\raise0.4pt\hbox{\vphantom{\angleleft}}#1}}%
- \kern-0.4pt\hrule}%
- \kern-.06em\raise0.4pt\hbox{\angleright}}}}
-% The old definition, with no lozenge:
-%\def\key #1{{\ttsl \nohyphenation \uppercase{#1}}\null}
-\def\ctrl #1{{\tt \rawbackslash \hat}#1}
-
-% @file, @option are the same as @samp.
-\let\file=\samp
-\let\option=\samp
-
-% @code is a modification of @t,
-% which makes spaces the same size as normal in the surrounding text.
-\def\tclose#1{%
- {%
- % Change normal interword space to be same as for the current font.
- \spaceskip = \fontdimen2\font
- %
- % Switch to typewriter.
- \tt
- %
- % But `\ ' produces the large typewriter interword space.
- \def\ {{\spaceskip = 0pt{} }}%
- %
- % Turn off hyphenation.
- \nohyphenation
- %
- \rawbackslash
- \plainfrenchspacing
- #1%
- }%
- \null
-}
-
-% We *must* turn on hyphenation at `-' and `_' in @code.
-% Otherwise, it is too hard to avoid overfull hboxes
-% in the Emacs manual, the Library manual, etc.
-
-% Unfortunately, TeX uses one parameter (\hyphenchar) to control
-% both hyphenation at - and hyphenation within words.
-% We must therefore turn them both off (\tclose does that)
-% and arrange explicitly to hyphenate at a dash.
-% -- rms.
-{
- \catcode`\-=\active
- \catcode`\_=\active
- %
- \global\def\code{\begingroup
- \catcode`\-=\active \catcode`\_=\active
- \ifallowcodebreaks
- \let-\codedash
- \let_\codeunder
- \else
- \let-\realdash
- \let_\realunder
- \fi
- \codex
- }
-}
-
-\def\realdash{-}
-\def\codedash{-\discretionary{}{}{}}
-\def\codeunder{%
- % this is all so @math{@code{var_name}+1} can work. In math mode, _
- % is "active" (mathcode"8000) and \normalunderscore (or \char95, etc.)
- % will therefore expand the active definition of _, which is us
- % (inside @code that is), therefore an endless loop.
- \ifusingtt{\ifmmode
- \mathchar"075F % class 0=ordinary, family 7=ttfam, pos 0x5F=_.
- \else\normalunderscore \fi
- \discretionary{}{}{}}%
- {\_}%
-}
-\def\codex #1{\tclose{#1}\endgroup}
-
-% An additional complication: the above will allow breaks after, e.g.,
-% each of the four underscores in __typeof__. This is undesirable in
-% some manuals, especially if they don't have long identifiers in
-% general. @allowcodebreaks provides a way to control this.
-%
-\newif\ifallowcodebreaks \allowcodebreakstrue
-
-\def\keywordtrue{true}
-\def\keywordfalse{false}
-
-\parseargdef\allowcodebreaks{%
- \def\txiarg{#1}%
- \ifx\txiarg\keywordtrue
- \allowcodebreakstrue
- \else\ifx\txiarg\keywordfalse
- \allowcodebreaksfalse
- \else
- \errhelp = \EMsimple
- \errmessage{Unknown @allowcodebreaks option `\txiarg'}%
- \fi\fi
-}
-
-% @kbd is like @code, except that if the argument is just one @key command,
-% then @kbd has no effect.
-
-% @kbdinputstyle -- arg is `distinct' (@kbd uses slanted tty font always),
-% `example' (@kbd uses ttsl only inside of @example and friends),
-% or `code' (@kbd uses normal tty font always).
-\parseargdef\kbdinputstyle{%
- \def\txiarg{#1}%
- \ifx\txiarg\worddistinct
- \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\ttsl}%
- \else\ifx\txiarg\wordexample
- \gdef\kbdexamplefont{\ttsl}\gdef\kbdfont{\tt}%
- \else\ifx\txiarg\wordcode
- \gdef\kbdexamplefont{\tt}\gdef\kbdfont{\tt}%
- \else
- \errhelp = \EMsimple
- \errmessage{Unknown @kbdinputstyle option `\txiarg'}%
- \fi\fi\fi
-}
-\def\worddistinct{distinct}
-\def\wordexample{example}
-\def\wordcode{code}
-
-% Default is `distinct.'
-\kbdinputstyle distinct
-
-\def\xkey{\key}
-\def\kbdfoo#1#2#3\par{\def\one{#1}\def\three{#3}\def\threex{??}%
-\ifx\one\xkey\ifx\threex\three \key{#2}%
-\else{\tclose{\kbdfont\look}}\fi
-\else{\tclose{\kbdfont\look}}\fi}
-
-% For @indicateurl, @env, @command quotes seem unnecessary, so use \code.
-\let\indicateurl=\code
-\let\env=\code
-\let\command=\code
-
-% @uref (abbreviation for `urlref') takes an optional (comma-separated)
-% second argument specifying the text to display and an optional third
-% arg as text to display instead of (rather than in addition to) the url
-% itself. First (mandatory) arg is the url. Perhaps eventually put in
-% a hypertex \special here.
-%
-\def\uref#1{\douref #1,,,\finish}
-\def\douref#1,#2,#3,#4\finish{\begingroup
- \unsepspaces
- \pdfurl{#1}%
- \setbox0 = \hbox{\ignorespaces #3}%
- \ifdim\wd0 > 0pt
- \unhbox0 % third arg given, show only that
- \else
- \setbox0 = \hbox{\ignorespaces #2}%
- \ifdim\wd0 > 0pt
- \ifpdf
- \unhbox0 % PDF: 2nd arg given, show only it
- \else
- \unhbox0\ (\code{#1})% DVI: 2nd arg given, show both it and url
- \fi
- \else
- \code{#1}% only url given, so show it
- \fi
- \fi
- \endlink
-\endgroup}
-
-% @url synonym for @uref, since that's how everyone uses it.
-%
-\let\url=\uref
-
-% rms does not like angle brackets --karl, 17may97.
-% So now @email is just like @uref, unless we are pdf.
-%
-%\def\email#1{\angleleft{\tt #1}\angleright}
-\ifpdf
- \def\email#1{\doemail#1,,\finish}
- \def\doemail#1,#2,#3\finish{\begingroup
- \unsepspaces
- \pdfurl{mailto:#1}%
- \setbox0 = \hbox{\ignorespaces #2}%
- \ifdim\wd0>0pt\unhbox0\else\code{#1}\fi
- \endlink
- \endgroup}
-\else
- \let\email=\uref
-\fi
-
-% Check if we are currently using a typewriter font. Since all the
-% Computer Modern typewriter fonts have zero interword stretch (and
-% shrink), and it is reasonable to expect all typewriter fonts to have
-% this property, we can check that font parameter.
-%
-\def\ifmonospace{\ifdim\fontdimen3\font=0pt }
-
-% Typeset a dimension, e.g., `in' or `pt'. The only reason for the
-% argument is to make the input look right: @dmn{pt} instead of @dmn{}pt.
-%
-\def\dmn#1{\thinspace #1}
-
-\def\kbd#1{\def\look{#1}\expandafter\kbdfoo\look??\par}
-
-% @l was never documented to mean ``switch to the Lisp font'',
-% and it is not used as such in any manual I can find. We need it for
-% Polish suppressed-l. --karl, 22sep96.
-%\def\l#1{{\li #1}\null}
-
-% Explicit font changes: @r, @sc, undocumented @ii.
-\def\r#1{{\rm #1}} % roman font
-\def\sc#1{{\smallcaps#1}} % smallcaps font
-\def\ii#1{{\it #1}} % italic font
-
-% @acronym for "FBI", "NATO", and the like.
-% We print this one point size smaller, since it's intended for
-% all-uppercase.
-%
-\def\acronym#1{\doacronym #1,,\finish}
-\def\doacronym#1,#2,#3\finish{%
- {\selectfonts\lsize #1}%
- \def\temp{#2}%
- \ifx\temp\empty \else
- \space ({\unsepspaces \ignorespaces \temp \unskip})%
- \fi
-}
-
-% @abbr for "Comput. J." and the like.
-% No font change, but don't do end-of-sentence spacing.
-%
-\def\abbr#1{\doabbr #1,,\finish}
-\def\doabbr#1,#2,#3\finish{%
- {\plainfrenchspacing #1}%
- \def\temp{#2}%
- \ifx\temp\empty \else
- \space ({\unsepspaces \ignorespaces \temp \unskip})%
- \fi
-}
-
-% @pounds{} is a sterling sign, which Knuth put in the CM italic font.
-%
-\def\pounds{{\it\$}}
-
-% @euro{} comes from a separate font, depending on the current style.
-% We use the free feym* fonts from the eurosym package by Henrik
-% Theiling, which support regular, slanted, bold and bold slanted (and
-% "outlined" (blackboard board, sort of) versions, which we don't need).
-% It is available from http://www.ctan.org/tex-archive/fonts/eurosym.
-%
-% Although only regular is the truly official Euro symbol, we ignore
-% that. The Euro is designed to be slightly taller than the regular
-% font height.
-%
-% feymr - regular
-% feymo - slanted
-% feybr - bold
-% feybo - bold slanted
-%
-% There is no good (free) typewriter version, to my knowledge.
-% A feymr10 euro is ~7.3pt wide, while a normal cmtt10 char is ~5.25pt wide.
-% Hmm.
-%
-% Also doesn't work in math. Do we need to do math with euro symbols?
-% Hope not.
-%
-%
-\def\euro{{\eurofont e}}
-\def\eurofont{%
- % We set the font at each command, rather than predefining it in
- % \textfonts and the other font-switching commands, so that
- % installations which never need the symbol don't have to have the
- % font installed.
- %
- % There is only one designed size (nominal 10pt), so we always scale
- % that to the current nominal size.
- %
- % By the way, simply using "at 1em" works for cmr10 and the like, but
- % does not work for cmbx10 and other extended/shrunken fonts.
- %
- \def\eurosize{\csname\curfontsize nominalsize\endcsname}%
- %
- \ifx\curfontstyle\bfstylename
- % bold:
- \font\thiseurofont = \ifusingit{feybo10}{feybr10} at \eurosize
- \else
- % regular:
- \font\thiseurofont = \ifusingit{feymo10}{feymr10} at \eurosize
- \fi
- \thiseurofont
-}
-
-% @registeredsymbol - R in a circle. The font for the R should really
-% be smaller yet, but lllsize is the best we can do for now.
-% Adapted from the plain.tex definition of \copyright.
-%
-\def\registeredsymbol{%
- $^{{\ooalign{\hfil\raise.07ex\hbox{\selectfonts\lllsize R}%
- \hfil\crcr\Orb}}%
- }$%
-}
-
-% Laurent Siebenmann reports \Orb undefined with:
-% Textures 1.7.7 (preloaded format=plain 93.10.14) (68K) 16 APR 2004 02:38
-% so we'll define it if necessary.
-%
-\ifx\Orb\undefined
-\def\Orb{\mathhexbox20D}
-\fi
-
-
-\message{page headings,}
-
-\newskip\titlepagetopglue \titlepagetopglue = 1.5in
-\newskip\titlepagebottomglue \titlepagebottomglue = 2pc
-
-% First the title page. Must do @settitle before @titlepage.
-\newif\ifseenauthor
-\newif\iffinishedtitlepage
-
-% Do an implicit @contents or @shortcontents after @end titlepage if the
-% user says @setcontentsaftertitlepage or @setshortcontentsaftertitlepage.
-%
-\newif\ifsetcontentsaftertitlepage
- \let\setcontentsaftertitlepage = \setcontentsaftertitlepagetrue
-\newif\ifsetshortcontentsaftertitlepage
- \let\setshortcontentsaftertitlepage = \setshortcontentsaftertitlepagetrue
-
-\parseargdef\shorttitlepage{\begingroup\hbox{}\vskip 1.5in \chaprm \centerline{#1}%
- \endgroup\page\hbox{}\page}
-
-\envdef\titlepage{%
- % Open one extra group, as we want to close it in the middle of \Etitlepage.
- \begingroup
- \parindent=0pt \textfonts
- % Leave some space at the very top of the page.
- \vglue\titlepagetopglue
- % No rule at page bottom unless we print one at the top with @title.
- \finishedtitlepagetrue
- %
- % Most title ``pages'' are actually two pages long, with space
- % at the top of the second. We don't want the ragged left on the second.
- \let\oldpage = \page
- \def\page{%
- \iffinishedtitlepage\else
- \finishtitlepage
- \fi
- \let\page = \oldpage
- \page
- \null
- }%
-}
-
-\def\Etitlepage{%
- \iffinishedtitlepage\else
- \finishtitlepage
- \fi
- % It is important to do the page break before ending the group,
- % because the headline and footline are only empty inside the group.
- % If we use the new definition of \page, we always get a blank page
- % after the title page, which we certainly don't want.
- \oldpage
- \endgroup
- %
- % Need this before the \...aftertitlepage checks so that if they are
- % in effect the toc pages will come out with page numbers.
- \HEADINGSon
- %
- % If they want short, they certainly want long too.
- \ifsetshortcontentsaftertitlepage
- \shortcontents
- \contents
- \global\let\shortcontents = \relax
- \global\let\contents = \relax
- \fi
- %
- \ifsetcontentsaftertitlepage
- \contents
- \global\let\contents = \relax
- \global\let\shortcontents = \relax
- \fi
-}
-
-\def\finishtitlepage{%
- \vskip4pt \hrule height 2pt width \hsize
- \vskip\titlepagebottomglue
- \finishedtitlepagetrue
-}
-
-%%% Macros to be used within @titlepage:
-
-\let\subtitlerm=\tenrm
-\def\subtitlefont{\subtitlerm \normalbaselineskip = 13pt \normalbaselines}
-
-\def\authorfont{\authorrm \normalbaselineskip = 16pt \normalbaselines
- \let\tt=\authortt}
-
-\parseargdef\title{%
- \checkenv\titlepage
- \leftline{\titlefonts\rm #1}
- % print a rule at the page bottom also.
- \finishedtitlepagefalse
- \vskip4pt \hrule height 4pt width \hsize \vskip4pt
-}
-
-\parseargdef\subtitle{%
- \checkenv\titlepage
- {\subtitlefont \rightline{#1}}%
-}
-
-% @author should come last, but may come many times.
-% It can also be used inside @quotation.
-%
-\parseargdef\author{%
- \def\temp{\quotation}%
- \ifx\thisenv\temp
- \def\quotationauthor{#1}% printed in \Equotation.
- \else
- \checkenv\titlepage
- \ifseenauthor\else \vskip 0pt plus 1filll \seenauthortrue \fi
- {\authorfont \leftline{#1}}%
- \fi
-}
-
-
-%%% Set up page headings and footings.
-
-\let\thispage=\folio
-
-\newtoks\evenheadline % headline on even pages
-\newtoks\oddheadline % headline on odd pages
-\newtoks\evenfootline % footline on even pages
-\newtoks\oddfootline % footline on odd pages
-
-% Now make TeX use those variables
-\headline={{\textfonts\rm \ifodd\pageno \the\oddheadline
- \else \the\evenheadline \fi}}
-\footline={{\textfonts\rm \ifodd\pageno \the\oddfootline
- \else \the\evenfootline \fi}\HEADINGShook}
-\let\HEADINGShook=\relax
-
-% Commands to set those variables.
-% For example, this is what @headings on does
-% @evenheading @thistitle|@thispage|@thischapter
-% @oddheading @thischapter|@thispage|@thistitle
-% @evenfooting @thisfile||
-% @oddfooting ||@thisfile
-
-
-\def\evenheading{\parsearg\evenheadingxxx}
-\def\evenheadingxxx #1{\evenheadingyyy #1\|\|\|\|\finish}
-\def\evenheadingyyy #1\|#2\|#3\|#4\finish{%
-\global\evenheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
-
-\def\oddheading{\parsearg\oddheadingxxx}
-\def\oddheadingxxx #1{\oddheadingyyy #1\|\|\|\|\finish}
-\def\oddheadingyyy #1\|#2\|#3\|#4\finish{%
-\global\oddheadline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
-
-\parseargdef\everyheading{\oddheadingxxx{#1}\evenheadingxxx{#1}}%
-
-\def\evenfooting{\parsearg\evenfootingxxx}
-\def\evenfootingxxx #1{\evenfootingyyy #1\|\|\|\|\finish}
-\def\evenfootingyyy #1\|#2\|#3\|#4\finish{%
-\global\evenfootline={\rlap{\centerline{#2}}\line{#1\hfil#3}}}
-
-\def\oddfooting{\parsearg\oddfootingxxx}
-\def\oddfootingxxx #1{\oddfootingyyy #1\|\|\|\|\finish}
-\def\oddfootingyyy #1\|#2\|#3\|#4\finish{%
- \global\oddfootline = {\rlap{\centerline{#2}}\line{#1\hfil#3}}%
- %
- % Leave some space for the footline. Hopefully ok to assume
- % @evenfooting will not be used by itself.
- \global\advance\pageheight by -\baselineskip
- \global\advance\vsize by -\baselineskip
-}
-
-\parseargdef\everyfooting{\oddfootingxxx{#1}\evenfootingxxx{#1}}
-
-
-% @headings double turns headings on for double-sided printing.
-% @headings single turns headings on for single-sided printing.
-% @headings off turns them off.
-% @headings on same as @headings double, retained for compatibility.
-% @headings after turns on double-sided headings after this page.
-% @headings doubleafter turns on double-sided headings after this page.
-% @headings singleafter turns on single-sided headings after this page.
-% By default, they are off at the start of a document,
-% and turned `on' after @end titlepage.
-
-\def\headings #1 {\csname HEADINGS#1\endcsname}
-
-\def\HEADINGSoff{%
-\global\evenheadline={\hfil} \global\evenfootline={\hfil}
-\global\oddheadline={\hfil} \global\oddfootline={\hfil}}
-\HEADINGSoff
-% When we turn headings on, set the page number to 1.
-% For double-sided printing, put current file name in lower left corner,
-% chapter name on inside top of right hand pages, document
-% title on inside top of left hand pages, and page numbers on outside top
-% edge of all pages.
-\def\HEADINGSdouble{%
-\global\pageno=1
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\folio\hfil\thistitle}}
-\global\oddheadline={\line{\thischapter\hfil\folio}}
-\global\let\contentsalignmacro = \chapoddpage
-}
-\let\contentsalignmacro = \chappager
-
-% For single-sided printing, chapter title goes across top left of page,
-% page number on top right.
-\def\HEADINGSsingle{%
-\global\pageno=1
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\thischapter\hfil\folio}}
-\global\oddheadline={\line{\thischapter\hfil\folio}}
-\global\let\contentsalignmacro = \chappager
-}
-\def\HEADINGSon{\HEADINGSdouble}
-
-\def\HEADINGSafter{\let\HEADINGShook=\HEADINGSdoublex}
-\let\HEADINGSdoubleafter=\HEADINGSafter
-\def\HEADINGSdoublex{%
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\folio\hfil\thistitle}}
-\global\oddheadline={\line{\thischapter\hfil\folio}}
-\global\let\contentsalignmacro = \chapoddpage
-}
-
-\def\HEADINGSsingleafter{\let\HEADINGShook=\HEADINGSsinglex}
-\def\HEADINGSsinglex{%
-\global\evenfootline={\hfil}
-\global\oddfootline={\hfil}
-\global\evenheadline={\line{\thischapter\hfil\folio}}
-\global\oddheadline={\line{\thischapter\hfil\folio}}
-\global\let\contentsalignmacro = \chappager
-}
-
-% Subroutines used in generating headings
-% This produces Day Month Year style of output.
-% Only define if not already defined, in case a txi-??.tex file has set
-% up a different format (e.g., txi-cs.tex does this).
-\ifx\today\undefined
-\def\today{%
- \number\day\space
- \ifcase\month
- \or\putwordMJan\or\putwordMFeb\or\putwordMMar\or\putwordMApr
- \or\putwordMMay\or\putwordMJun\or\putwordMJul\or\putwordMAug
- \or\putwordMSep\or\putwordMOct\or\putwordMNov\or\putwordMDec
- \fi
- \space\number\year}
-\fi
-
-% @settitle line... specifies the title of the document, for headings.
-% It generates no output of its own.
-\def\thistitle{\putwordNoTitle}
-\def\settitle{\parsearg{\gdef\thistitle}}
-
-
-\message{tables,}
-% Tables -- @table, @ftable, @vtable, @item(x).
-
-% default indentation of table text
-\newdimen\tableindent \tableindent=.8in
-% default indentation of @itemize and @enumerate text
-\newdimen\itemindent \itemindent=.3in
-% margin between end of table item and start of table text.
-\newdimen\itemmargin \itemmargin=.1in
-
-% used internally for \itemindent minus \itemmargin
-\newdimen\itemmax
-
-% Note @table, @ftable, and @vtable define @item, @itemx, etc., with
-% these defs.
-% They also define \itemindex
-% to index the item name in whatever manner is desired (perhaps none).
-
-\newif\ifitemxneedsnegativevskip
-
-\def\itemxpar{\par\ifitemxneedsnegativevskip\nobreak\vskip-\parskip\nobreak\fi}
-
-\def\internalBitem{\smallbreak \parsearg\itemzzz}
-\def\internalBitemx{\itemxpar \parsearg\itemzzz}
-
-\def\itemzzz #1{\begingroup %
- \advance\hsize by -\rightskip
- \advance\hsize by -\tableindent
- \setbox0=\hbox{\itemindicate{#1}}%
- \itemindex{#1}%
- \nobreak % This prevents a break before @itemx.
- %
- % If the item text does not fit in the space we have, put it on a line
- % by itself, and do not allow a page break either before or after that
- % line. We do not start a paragraph here because then if the next
- % command is, e.g., @kindex, the whatsit would get put into the
- % horizontal list on a line by itself, resulting in extra blank space.
- \ifdim \wd0>\itemmax
- %
- % Make this a paragraph so we get the \parskip glue and wrapping,
- % but leave it ragged-right.
- \begingroup
- \advance\leftskip by-\tableindent
- \advance\hsize by\tableindent
- \advance\rightskip by0pt plus1fil
- \leavevmode\unhbox0\par
- \endgroup
- %
- % We're going to be starting a paragraph, but we don't want the
- % \parskip glue -- logically it's part of the @item we just started.
- \nobreak \vskip-\parskip
- %
- % Stop a page break at the \parskip glue coming up. However, if
- % what follows is an environment such as @example, there will be no
- % \parskip glue; then the negative vskip we just inserted would
- % cause the example and the item to crash together. So we use this
- % bizarre value of 10001 as a signal to \aboveenvbreak to insert
- % \parskip glue after all. Section titles are handled this way also.
- %
- \penalty 10001
- \endgroup
- \itemxneedsnegativevskipfalse
- \else
- % The item text fits into the space. Start a paragraph, so that the
- % following text (if any) will end up on the same line.
- \noindent
- % Do this with kerns and \unhbox so that if there is a footnote in
- % the item text, it can migrate to the main vertical list and
- % eventually be printed.
- \nobreak\kern-\tableindent
- \dimen0 = \itemmax \advance\dimen0 by \itemmargin \advance\dimen0 by -\wd0
- \unhbox0
- \nobreak\kern\dimen0
- \endgroup
- \itemxneedsnegativevskiptrue
- \fi
-}
-
-\def\item{\errmessage{@item while not in a list environment}}
-\def\itemx{\errmessage{@itemx while not in a list environment}}
-
-% @table, @ftable, @vtable.
-\envdef\table{%
- \let\itemindex\gobble
- \tablecheck{table}%
-}
-\envdef\ftable{%
- \def\itemindex ##1{\doind {fn}{\code{##1}}}%
- \tablecheck{ftable}%
-}
-\envdef\vtable{%
- \def\itemindex ##1{\doind {vr}{\code{##1}}}%
- \tablecheck{vtable}%
-}
-\def\tablecheck#1{%
- \ifnum \the\catcode`\^^M=\active
- \endgroup
- \errmessage{This command won't work in this context; perhaps the problem is
- that we are \inenvironment\thisenv}%
- \def\next{\doignore{#1}}%
- \else
- \let\next\tablex
- \fi
- \next
-}
-\def\tablex#1{%
- \def\itemindicate{#1}%
- \parsearg\tabley
-}
-\def\tabley#1{%
- {%
- \makevalueexpandable
- \edef\temp{\noexpand\tablez #1\space\space\space}%
- \expandafter
- }\temp \endtablez
-}
-\def\tablez #1 #2 #3 #4\endtablez{%
- \aboveenvbreak
- \ifnum 0#1>0 \advance \leftskip by #1\mil \fi
- \ifnum 0#2>0 \tableindent=#2\mil \fi
- \ifnum 0#3>0 \advance \rightskip by #3\mil \fi
- \itemmax=\tableindent
- \advance \itemmax by -\itemmargin
- \advance \leftskip by \tableindent
- \exdentamount=\tableindent
- \parindent = 0pt
- \parskip = \smallskipamount
- \ifdim \parskip=0pt \parskip=2pt \fi
- \let\item = \internalBitem
- \let\itemx = \internalBitemx
-}
-\def\Etable{\endgraf\afterenvbreak}
-\let\Eftable\Etable
-\let\Evtable\Etable
-\let\Eitemize\Etable
-\let\Eenumerate\Etable
-
-% This is the counter used by @enumerate, which is really @itemize
-
-\newcount \itemno
-
-\envdef\itemize{\parsearg\doitemize}
-
-\def\doitemize#1{%
- \aboveenvbreak
- \itemmax=\itemindent
- \advance\itemmax by -\itemmargin
- \advance\leftskip by \itemindent
- \exdentamount=\itemindent
- \parindent=0pt
- \parskip=\smallskipamount
- \ifdim\parskip=0pt \parskip=2pt \fi
- \def\itemcontents{#1}%
- % @itemize with no arg is equivalent to @itemize @bullet.
- \ifx\itemcontents\empty\def\itemcontents{\bullet}\fi
- \let\item=\itemizeitem
-}
-
-% Definition of @item while inside @itemize and @enumerate.
-%
-\def\itemizeitem{%
- \advance\itemno by 1 % for enumerations
- {\let\par=\endgraf \smallbreak}% reasonable place to break
- {%
- % If the document has an @itemize directly after a section title, a
- % \nobreak will be last on the list, and \sectionheading will have
- % done a \vskip-\parskip. In that case, we don't want to zero
- % parskip, or the item text will crash with the heading. On the
- % other hand, when there is normal text preceding the item (as there
- % usually is), we do want to zero parskip, or there would be too much
- % space. In that case, we won't have a \nobreak before. At least
- % that's the theory.
- \ifnum\lastpenalty<10000 \parskip=0in \fi
- \noindent
- \hbox to 0pt{\hss \itemcontents \kern\itemmargin}%
- \vadjust{\penalty 1200}}% not good to break after first line of item.
- \flushcr
-}
-
-% \splitoff TOKENS\endmark defines \first to be the first token in
-% TOKENS, and \rest to be the remainder.
-%
-\def\splitoff#1#2\endmark{\def\first{#1}\def\rest{#2}}%
-
-% Allow an optional argument of an uppercase letter, lowercase letter,
-% or number, to specify the first label in the enumerated list. No
-% argument is the same as `1'.
-%
-\envparseargdef\enumerate{\enumeratey #1 \endenumeratey}
-\def\enumeratey #1 #2\endenumeratey{%
- % If we were given no argument, pretend we were given `1'.
- \def\thearg{#1}%
- \ifx\thearg\empty \def\thearg{1}\fi
- %
- % Detect if the argument is a single token. If so, it might be a
- % letter. Otherwise, the only valid thing it can be is a number.
- % (We will always have one token, because of the test we just made.
- % This is a good thing, since \splitoff doesn't work given nothing at
- % all -- the first parameter is undelimited.)
- \expandafter\splitoff\thearg\endmark
- \ifx\rest\empty
- % Only one token in the argument. It could still be anything.
- % A ``lowercase letter'' is one whose \lccode is nonzero.
- % An ``uppercase letter'' is one whose \lccode is both nonzero, and
- % not equal to itself.
- % Otherwise, we assume it's a number.
- %
- % We need the \relax at the end of the \ifnum lines to stop TeX from
- % continuing to look for a <number>.
- %
- \ifnum\lccode\expandafter`\thearg=0\relax
- \numericenumerate % a number (we hope)
- \else
- % It's a letter.
- \ifnum\lccode\expandafter`\thearg=\expandafter`\thearg\relax
- \lowercaseenumerate % lowercase letter
- \else
- \uppercaseenumerate % uppercase letter
- \fi
- \fi
- \else
- % Multiple tokens in the argument. We hope it's a number.
- \numericenumerate
- \fi
-}
-
-% An @enumerate whose labels are integers. The starting integer is
-% given in \thearg.
-%
-\def\numericenumerate{%
- \itemno = \thearg
- \startenumeration{\the\itemno}%
-}
-
-% The starting (lowercase) letter is in \thearg.
-\def\lowercaseenumerate{%
- \itemno = \expandafter`\thearg
- \startenumeration{%
- % Be sure we're not beyond the end of the alphabet.
- \ifnum\itemno=0
- \errmessage{No more lowercase letters in @enumerate; get a bigger
- alphabet}%
- \fi
- \char\lccode\itemno
- }%
-}
-
-% The starting (uppercase) letter is in \thearg.
-\def\uppercaseenumerate{%
- \itemno = \expandafter`\thearg
- \startenumeration{%
- % Be sure we're not beyond the end of the alphabet.
- \ifnum\itemno=0
- \errmessage{No more uppercase letters in @enumerate; get a bigger
- alphabet}
- \fi
- \char\uccode\itemno
- }%
-}
-
-% Call \doitemize, adding a period to the first argument and supplying the
-% common last two arguments. Also subtract one from the initial value in
-% \itemno, since @item increments \itemno.
-%
-\def\startenumeration#1{%
- \advance\itemno by -1
- \doitemize{#1.}\flushcr
-}
-
-% @alphaenumerate and @capsenumerate are abbreviations for giving an arg
-% to @enumerate.
-%
-\def\alphaenumerate{\enumerate{a}}
-\def\capsenumerate{\enumerate{A}}
-\def\Ealphaenumerate{\Eenumerate}
-\def\Ecapsenumerate{\Eenumerate}
-
-
-% @multitable macros
-% Amy Hendrickson, 8/18/94, 3/6/96
-%
-% @multitable ... @end multitable will make as many columns as desired.
-% Contents of each column will wrap at width given in preamble. Width
-% can be specified either with sample text given in a template line,
-% or in percent of \hsize, the current width of text on page.
-
-% Table can continue over pages but will only break between lines.
-
-% To make preamble:
-%
-% Either define widths of columns in terms of percent of \hsize:
-% @multitable @columnfractions .25 .3 .45
-% @item ...
-%
-% Numbers following @columnfractions are the percent of the total
-% current hsize to be used for each column. You may use as many
-% columns as desired.
-
-
-% Or use a template:
-% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
-% @item ...
-% using the widest term desired in each column.
-
-% Each new table line starts with @item, each subsequent new column
-% starts with @tab. Empty columns may be produced by supplying @tab's
-% with nothing between them for as many times as empty columns are needed,
-% ie, @tab@tab@tab will produce two empty columns.
-
-% @item, @tab do not need to be on their own lines, but it will not hurt
-% if they are.
-
-% Sample multitable:
-
-% @multitable {Column 1 template} {Column 2 template} {Column 3 template}
-% @item first col stuff @tab second col stuff @tab third col
-% @item
-% first col stuff
-% @tab
-% second col stuff
-% @tab
-% third col
-% @item first col stuff @tab second col stuff
-% @tab Many paragraphs of text may be used in any column.
-%
-% They will wrap at the width determined by the template.
-% @item@tab@tab This will be in third column.
-% @end multitable
-
-% Default dimensions may be reset by user.
-% @multitableparskip is vertical space between paragraphs in table.
-% @multitableparindent is paragraph indent in table.
-% @multitablecolmargin is horizontal space to be left between columns.
-% @multitablelinespace is space to leave between table items, baseline
-% to baseline.
-% 0pt means it depends on current normal line spacing.
-%
-\newskip\multitableparskip
-\newskip\multitableparindent
-\newdimen\multitablecolspace
-\newskip\multitablelinespace
-\multitableparskip=0pt
-\multitableparindent=6pt
-\multitablecolspace=12pt
-\multitablelinespace=0pt
-
-% Macros used to set up halign preamble:
-%
-\let\endsetuptable\relax
-\def\xendsetuptable{\endsetuptable}
-\let\columnfractions\relax
-\def\xcolumnfractions{\columnfractions}
-\newif\ifsetpercent
-
-% #1 is the @columnfraction, usually a decimal number like .5, but might
-% be just 1. We just use it, whatever it is.
-%
-\def\pickupwholefraction#1 {%
- \global\advance\colcount by 1
- \expandafter\xdef\csname col\the\colcount\endcsname{#1\hsize}%
- \setuptable
-}
-
-\newcount\colcount
-\def\setuptable#1{%
- \def\firstarg{#1}%
- \ifx\firstarg\xendsetuptable
- \let\go = \relax
- \else
- \ifx\firstarg\xcolumnfractions
- \global\setpercenttrue
- \else
- \ifsetpercent
- \let\go\pickupwholefraction
- \else
- \global\advance\colcount by 1
- \setbox0=\hbox{#1\unskip\space}% Add a normal word space as a
- % separator; typically that is always in the input, anyway.
- \expandafter\xdef\csname col\the\colcount\endcsname{\the\wd0}%
- \fi
- \fi
- \ifx\go\pickupwholefraction
- % Put the argument back for the \pickupwholefraction call, so
- % we'll always have a period there to be parsed.
- \def\go{\pickupwholefraction#1}%
- \else
- \let\go = \setuptable
- \fi%
- \fi
- \go
-}
-
-% multitable-only commands.
-%
-% @headitem starts a heading row, which we typeset in bold.
-% Assignments have to be global since we are inside the implicit group
-% of an alignment entry. Note that \everycr resets \everytab.
-\def\headitem{\checkenv\multitable \crcr \global\everytab={\bf}\the\everytab}%
-%
-% A \tab used to include \hskip1sp. But then the space in a template
-% line is not enough. That is bad. So let's go back to just `&' until
-% we encounter the problem it was intended to solve again.
-% --karl, nathan@acm.org, 20apr99.
-\def\tab{\checkenv\multitable &\the\everytab}%
-
-% @multitable ... @end multitable definitions:
-%
-\newtoks\everytab % insert after every tab.
-%
-\envdef\multitable{%
- \vskip\parskip
- \startsavinginserts
- %
- % @item within a multitable starts a normal row.
- % We use \def instead of \let so that if one of the multitable entries
- % contains an @itemize, we don't choke on the \item (seen as \crcr aka
- % \endtemplate) expanding \doitemize.
- \def\item{\crcr}%
- %
- \tolerance=9500
- \hbadness=9500
- \setmultitablespacing
- \parskip=\multitableparskip
- \parindent=\multitableparindent
- \overfullrule=0pt
- \global\colcount=0
- %
- \everycr = {%
- \noalign{%
- \global\everytab={}%
- \global\colcount=0 % Reset the column counter.
- % Check for saved footnotes, etc.
- \checkinserts
- % Keeps underfull box messages off when table breaks over pages.
- %\filbreak
- % Maybe so, but it also creates really weird page breaks when the
- % table breaks over pages. Wouldn't \vfil be better? Wait until the
- % problem manifests itself, so it can be fixed for real --karl.
- }%
- }%
- %
- \parsearg\domultitable
-}
-\def\domultitable#1{%
- % To parse everything between @multitable and @item:
- \setuptable#1 \endsetuptable
- %
- % This preamble sets up a generic column definition, which will
- % be used as many times as user calls for columns.
- % \vtop will set a single line and will also let text wrap and
- % continue for many paragraphs if desired.
- \halign\bgroup &%
- \global\advance\colcount by 1
- \multistrut
- \vtop{%
- % Use the current \colcount to find the correct column width:
- \hsize=\expandafter\csname col\the\colcount\endcsname
- %
- % In order to keep entries from bumping into each other
- % we will add a \leftskip of \multitablecolspace to all columns after
- % the first one.
- %
- % If a template has been used, we will add \multitablecolspace
- % to the width of each template entry.
- %
- % If the user has set preamble in terms of percent of \hsize we will
- % use that dimension as the width of the column, and the \leftskip
- % will keep entries from bumping into each other. Table will start at
- % left margin and final column will justify at right margin.
- %
- % Make sure we don't inherit \rightskip from the outer environment.
- \rightskip=0pt
- \ifnum\colcount=1
- % The first column will be indented with the surrounding text.
- \advance\hsize by\leftskip
- \else
- \ifsetpercent \else
- % If user has not set preamble in terms of percent of \hsize
- % we will advance \hsize by \multitablecolspace.
- \advance\hsize by \multitablecolspace
- \fi
- % In either case we will make \leftskip=\multitablecolspace:
- \leftskip=\multitablecolspace
- \fi
- % Ignoring space at the beginning and end avoids an occasional spurious
- % blank line, when TeX decides to break the line at the space before the
- % box from the multistrut, so the strut ends up on a line by itself.
- % For example:
- % @multitable @columnfractions .11 .89
- % @item @code{#}
- % @tab Legal holiday which is valid in major parts of the whole country.
- % Is automatically provided with highlighting sequences respectively
- % marking characters.
- \noindent\ignorespaces##\unskip\multistrut
- }\cr
-}
-\def\Emultitable{%
- \crcr
- \egroup % end the \halign
- \global\setpercentfalse
-}
-
-\def\setmultitablespacing{%
- \def\multistrut{\strut}% just use the standard line spacing
- %
- % Compute \multitablelinespace (if not defined by user) for use in
- % \multitableparskip calculation. We used define \multistrut based on
- % this, but (ironically) that caused the spacing to be off.
- % See bug-texinfo report from Werner Lemberg, 31 Oct 2004 12:52:20 +0100.
-\ifdim\multitablelinespace=0pt
-\setbox0=\vbox{X}\global\multitablelinespace=\the\baselineskip
-\global\advance\multitablelinespace by-\ht0
-\fi
-%% Test to see if parskip is larger than space between lines of
-%% table. If not, do nothing.
-%% If so, set to same dimension as multitablelinespace.
-\ifdim\multitableparskip>\multitablelinespace
-\global\multitableparskip=\multitablelinespace
-\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
- %% than skip between lines in the table.
-\fi%
-\ifdim\multitableparskip=0pt
-\global\multitableparskip=\multitablelinespace
-\global\advance\multitableparskip-7pt %% to keep parskip somewhat smaller
- %% than skip between lines in the table.
-\fi}
-
-
-\message{conditionals,}
-
-% @iftex, @ifnotdocbook, @ifnothtml, @ifnotinfo, @ifnotplaintext,
-% @ifnotxml always succeed. They currently do nothing; we don't
-% attempt to check whether the conditionals are properly nested. But we
-% have to remember that they are conditionals, so that @end doesn't
-% attempt to close an environment group.
-%
-\def\makecond#1{%
- \expandafter\let\csname #1\endcsname = \relax
- \expandafter\let\csname iscond.#1\endcsname = 1
-}
-\makecond{iftex}
-\makecond{ifnotdocbook}
-\makecond{ifnothtml}
-\makecond{ifnotinfo}
-\makecond{ifnotplaintext}
-\makecond{ifnotxml}
-
-% Ignore @ignore, @ifhtml, @ifinfo, and the like.
-%
-\def\direntry{\doignore{direntry}}
-\def\documentdescription{\doignore{documentdescription}}
-\def\docbook{\doignore{docbook}}
-\def\html{\doignore{html}}
-\def\ifdocbook{\doignore{ifdocbook}}
-\def\ifhtml{\doignore{ifhtml}}
-\def\ifinfo{\doignore{ifinfo}}
-\def\ifnottex{\doignore{ifnottex}}
-\def\ifplaintext{\doignore{ifplaintext}}
-\def\ifxml{\doignore{ifxml}}
-\def\ignore{\doignore{ignore}}
-\def\menu{\doignore{menu}}
-\def\xml{\doignore{xml}}
-
-% Ignore text until a line `@end #1', keeping track of nested conditionals.
-%
-% A count to remember the depth of nesting.
-\newcount\doignorecount
-
-\def\doignore#1{\begingroup
- % Scan in ``verbatim'' mode:
- \catcode`\@ = \other
- \catcode`\{ = \other
- \catcode`\} = \other
- %
- % Make sure that spaces turn into tokens that match what \doignoretext wants.
- \spaceisspace
- %
- % Count number of #1's that we've seen.
- \doignorecount = 0
- %
- % Swallow text until we reach the matching `@end #1'.
- \dodoignore{#1}%
-}
-
-{ \catcode`_=11 % We want to use \_STOP_ which cannot appear in texinfo source.
- \obeylines %
- %
- \gdef\dodoignore#1{%
- % #1 contains the command name as a string, e.g., `ifinfo'.
- %
- % Define a command to find the next `@end #1', which must be on a line
- % by itself.
- \long\def\doignoretext##1^^M@end #1{\doignoretextyyy##1^^M@#1\_STOP_}%
- % And this command to find another #1 command, at the beginning of a
- % line. (Otherwise, we would consider a line `@c @ifset', for
- % example, to count as an @ifset for nesting.)
- \long\def\doignoretextyyy##1^^M@#1##2\_STOP_{\doignoreyyy{##2}\_STOP_}%
- %
- % And now expand that command.
- \obeylines %
- \doignoretext ^^M%
- }%
-}
-
-\def\doignoreyyy#1{%
- \def\temp{#1}%
- \ifx\temp\empty % Nothing found.
- \let\next\doignoretextzzz
- \else % Found a nested condition, ...
- \advance\doignorecount by 1
- \let\next\doignoretextyyy % ..., look for another.
- % If we're here, #1 ends with ^^M\ifinfo (for example).
- \fi
- \next #1% the token \_STOP_ is present just after this macro.
-}
-
-% We have to swallow the remaining "\_STOP_".
-%
-\def\doignoretextzzz#1{%
- \ifnum\doignorecount = 0 % We have just found the outermost @end.
- \let\next\enddoignore
- \else % Still inside a nested condition.
- \advance\doignorecount by -1
- \let\next\doignoretext % Look for the next @end.
- \fi
- \next
-}
-
-% Finish off ignored text.
-\def\enddoignore{\endgroup\ignorespaces}
-
-
-% @set VAR sets the variable VAR to an empty value.
-% @set VAR REST-OF-LINE sets VAR to the value REST-OF-LINE.
-%
-% Since we want to separate VAR from REST-OF-LINE (which might be
-% empty), we can't just use \parsearg; we have to insert a space of our
-% own to delimit the rest of the line, and then take it out again if we
-% didn't need it.
-% We rely on the fact that \parsearg sets \catcode`\ =10.
-%
-\parseargdef\set{\setyyy#1 \endsetyyy}
-\def\setyyy#1 #2\endsetyyy{%
- {%
- \makevalueexpandable
- \def\temp{#2}%
- \edef\next{\gdef\makecsname{SET#1}}%
- \ifx\temp\empty
- \next{}%
- \else
- \setzzz#2\endsetzzz
- \fi
- }%
-}
-% Remove the trailing space \setxxx inserted.
-\def\setzzz#1 \endsetzzz{\next{#1}}
-
-% @clear VAR clears (i.e., unsets) the variable VAR.
-%
-\parseargdef\clear{%
- {%
- \makevalueexpandable
- \global\expandafter\let\csname SET#1\endcsname=\relax
- }%
-}
-
-% @value{foo} gets the text saved in variable foo.
-\def\value{\begingroup\makevalueexpandable\valuexxx}
-\def\valuexxx#1{\expandablevalue{#1}\endgroup}
-{
- \catcode`\- = \active \catcode`\_ = \active
- %
- \gdef\makevalueexpandable{%
- \let\value = \expandablevalue
- % We don't want these characters active, ...
- \catcode`\-=\other \catcode`\_=\other
- % ..., but we might end up with active ones in the argument if
- % we're called from @code, as @code{@value{foo-bar_}}, though.
- % So \let them to their normal equivalents.
- \let-\realdash \let_\normalunderscore
- }
-}
-
-% We have this subroutine so that we can handle at least some @value's
-% properly in indexes (we call \makevalueexpandable in \indexdummies).
-% The command has to be fully expandable (if the variable is set), since
-% the result winds up in the index file. This means that if the
-% variable's value contains other Texinfo commands, it's almost certain
-% it will fail (although perhaps we could fix that with sufficient work
-% to do a one-level expansion on the result, instead of complete).
-%
-\def\expandablevalue#1{%
- \expandafter\ifx\csname SET#1\endcsname\relax
- {[No value for ``#1'']}%
- \message{Variable `#1', used in @value, is not set.}%
- \else
- \csname SET#1\endcsname
- \fi
-}
-
-% @ifset VAR ... @end ifset reads the `...' iff VAR has been defined
-% with @set.
-%
-% To get special treatment of `@end ifset,' call \makeond and the redefine.
-%
-\makecond{ifset}
-\def\ifset{\parsearg{\doifset{\let\next=\ifsetfail}}}
-\def\doifset#1#2{%
- {%
- \makevalueexpandable
- \let\next=\empty
- \expandafter\ifx\csname SET#2\endcsname\relax
- #1% If not set, redefine \next.
- \fi
- \expandafter
- }\next
-}
-\def\ifsetfail{\doignore{ifset}}
-
-% @ifclear VAR ... @end ifclear reads the `...' iff VAR has never been
-% defined with @set, or has been undefined with @clear.
-%
-% The `\else' inside the `\doifset' parameter is a trick to reuse the
-% above code: if the variable is not set, do nothing, if it is set,
-% then redefine \next to \ifclearfail.
-%
-\makecond{ifclear}
-\def\ifclear{\parsearg{\doifset{\else \let\next=\ifclearfail}}}
-\def\ifclearfail{\doignore{ifclear}}
-
-% @dircategory CATEGORY -- specify a category of the dir file
-% which this file should belong to. Ignore this in TeX.
-\let\dircategory=\comment
-
-% @defininfoenclose.
-\let\definfoenclose=\comment
-
-
-\message{indexing,}
-% Index generation facilities
-
-% Define \newwrite to be identical to plain tex's \newwrite
-% except not \outer, so it can be used within macros and \if's.
-\edef\newwrite{\makecsname{ptexnewwrite}}
-
-% \newindex {foo} defines an index named foo.
-% It automatically defines \fooindex such that
-% \fooindex ...rest of line... puts an entry in the index foo.
-% It also defines \fooindfile to be the number of the output channel for
-% the file that accumulates this index. The file's extension is foo.
-% The name of an index should be no more than 2 characters long
-% for the sake of vms.
-%
-\def\newindex#1{%
- \iflinks
- \expandafter\newwrite \csname#1indfile\endcsname
- \openout \csname#1indfile\endcsname \jobname.#1 % Open the file
- \fi
- \expandafter\xdef\csname#1index\endcsname{% % Define @#1index
- \noexpand\doindex{#1}}
-}
-
-% @defindex foo == \newindex{foo}
-%
-\def\defindex{\parsearg\newindex}
-
-% Define @defcodeindex, like @defindex except put all entries in @code.
-%
-\def\defcodeindex{\parsearg\newcodeindex}
-%
-\def\newcodeindex#1{%
- \iflinks
- \expandafter\newwrite \csname#1indfile\endcsname
- \openout \csname#1indfile\endcsname \jobname.#1
- \fi
- \expandafter\xdef\csname#1index\endcsname{%
- \noexpand\docodeindex{#1}}%
-}
-
-
-% @synindex foo bar makes index foo feed into index bar.
-% Do this instead of @defindex foo if you don't want it as a separate index.
-%
-% @syncodeindex foo bar similar, but put all entries made for index foo
-% inside @code.
-%
-\def\synindex#1 #2 {\dosynindex\doindex{#1}{#2}}
-\def\syncodeindex#1 #2 {\dosynindex\docodeindex{#1}{#2}}
-
-% #1 is \doindex or \docodeindex, #2 the index getting redefined (foo),
-% #3 the target index (bar).
-\def\dosynindex#1#2#3{%
- % Only do \closeout if we haven't already done it, else we'll end up
- % closing the target index.
- \expandafter \ifx\csname donesynindex#2\endcsname \undefined
- % The \closeout helps reduce unnecessary open files; the limit on the
- % Acorn RISC OS is a mere 16 files.
- \expandafter\closeout\csname#2indfile\endcsname
- \expandafter\let\csname\donesynindex#2\endcsname = 1
- \fi
- % redefine \fooindfile:
- \expandafter\let\expandafter\temp\expandafter=\csname#3indfile\endcsname
- \expandafter\let\csname#2indfile\endcsname=\temp
- % redefine \fooindex:
- \expandafter\xdef\csname#2index\endcsname{\noexpand#1{#3}}%
-}
-
-% Define \doindex, the driver for all \fooindex macros.
-% Argument #1 is generated by the calling \fooindex macro,
-% and it is "foo", the name of the index.
-
-% \doindex just uses \parsearg; it calls \doind for the actual work.
-% This is because \doind is more useful to call from other macros.
-
-% There is also \dosubind {index}{topic}{subtopic}
-% which makes an entry in a two-level index such as the operation index.
-
-\def\doindex#1{\edef\indexname{#1}\parsearg\singleindexer}
-\def\singleindexer #1{\doind{\indexname}{#1}}
-
-% like the previous two, but they put @code around the argument.
-\def\docodeindex#1{\edef\indexname{#1}\parsearg\singlecodeindexer}
-\def\singlecodeindexer #1{\doind{\indexname}{\code{#1}}}
-
-% Take care of Texinfo commands that can appear in an index entry.
-% Since there are some commands we want to expand, and others we don't,
-% we have to laboriously prevent expansion for those that we don't.
-%
-\def\indexdummies{%
- \escapechar = `\\ % use backslash in output files.
- \def\@{@}% change to @@ when we switch to @ as escape char in index files.
- \def\ {\realbackslash\space }%
- % Need these in case \tex is in effect and \{ is a \delimiter again.
- % But can't use \lbracecmd and \rbracecmd because texindex assumes
- % braces and backslashes are used only as delimiters.
- \let\{ = \mylbrace
- \let\} = \myrbrace
- %
- % Do the redefinitions.
- \commondummies
-}
-
-% For the aux and toc files, @ is the escape character. So we want to
-% redefine everything using @ as the escape character (instead of
-% \realbackslash, still used for index files). When everything uses @,
-% this will be simpler.
-%
-\def\atdummies{%
- \def\@{@@}%
- \def\ {@ }%
- \let\{ = \lbraceatcmd
- \let\} = \rbraceatcmd
- %
- % Do the redefinitions.
- \commondummies
-}
-
-% Called from \indexdummies and \atdummies.
-%
-\def\commondummies{%
- %
- % \definedummyword defines \#1 as \string\#1\space, thus effectively
- % preventing its expansion. This is used only for control% words,
- % not control letters, because the \space would be incorrect for
- % control characters, but is needed to separate the control word
- % from whatever follows.
- %
- % For control letters, we have \definedummyletter, which omits the
- % space.
- %
- % These can be used both for control words that take an argument and
- % those that do not. If it is followed by {arg} in the input, then
- % that will dutifully get written to the index (or wherever).
- %
- \def\definedummyword ##1{\def##1{\string##1\space}}%
- \def\definedummyletter##1{\def##1{\string##1}}%
- \let\definedummyaccent\definedummyletter
- %
- \commondummiesnofonts
- %
- \definedummyletter\_%
- %
- % Non-English letters.
- \definedummyword\AA
- \definedummyword\AE
- \definedummyword\L
- \definedummyword\OE
- \definedummyword\O
- \definedummyword\aa
- \definedummyword\ae
- \definedummyword\l
- \definedummyword\oe
- \definedummyword\o
- \definedummyword\ss
- \definedummyword\exclamdown
- \definedummyword\questiondown
- \definedummyword\ordf
- \definedummyword\ordm
- %
- % Although these internal commands shouldn't show up, sometimes they do.
- \definedummyword\bf
- \definedummyword\gtr
- \definedummyword\hat
- \definedummyword\less
- \definedummyword\sf
- \definedummyword\sl
- \definedummyword\tclose
- \definedummyword\tt
- %
- \definedummyword\LaTeX
- \definedummyword\TeX
- %
- % Assorted special characters.
- \definedummyword\bullet
- \definedummyword\comma
- \definedummyword\copyright
- \definedummyword\registeredsymbol
- \definedummyword\dots
- \definedummyword\enddots
- \definedummyword\equiv
- \definedummyword\error
- \definedummyword\euro
- \definedummyword\expansion
- \definedummyword\minus
- \definedummyword\pounds
- \definedummyword\point
- \definedummyword\print
- \definedummyword\result
- %
- % We want to disable all macros so that they are not expanded by \write.
- \macrolist
- %
- \normalturnoffactive
- %
- % Handle some cases of @value -- where it does not contain any
- % (non-fully-expandable) commands.
- \makevalueexpandable
-}
-
-% \commondummiesnofonts: common to \commondummies and \indexnofonts.
-%
-% Better have this without active chars.
-{
- \catcode`\~=\other
- \gdef\commondummiesnofonts{%
- % Control letters and accents.
- \definedummyletter\!%
- \definedummyaccent\"%
- \definedummyaccent\'%
- \definedummyletter\*%
- \definedummyaccent\,%
- \definedummyletter\.%
- \definedummyletter\/%
- \definedummyletter\:%
- \definedummyaccent\=%
- \definedummyletter\?%
- \definedummyaccent\^%
- \definedummyaccent\`%
- \definedummyaccent\~%
- \definedummyword\u
- \definedummyword\v
- \definedummyword\H
- \definedummyword\dotaccent
- \definedummyword\ringaccent
- \definedummyword\tieaccent
- \definedummyword\ubaraccent
- \definedummyword\udotaccent
- \definedummyword\dotless
- %
- % Texinfo font commands.
- \definedummyword\b
- \definedummyword\i
- \definedummyword\r
- \definedummyword\sc
- \definedummyword\t
- %
- % Commands that take arguments.
- \definedummyword\acronym
- \definedummyword\cite
- \definedummyword\code
- \definedummyword\command
- \definedummyword\dfn
- \definedummyword\emph
- \definedummyword\env
- \definedummyword\file
- \definedummyword\kbd
- \definedummyword\key
- \definedummyword\math
- \definedummyword\option
- \definedummyword\samp
- \definedummyword\strong
- \definedummyword\tie
- \definedummyword\uref
- \definedummyword\url
- \definedummyword\var
- \definedummyword\verb
- \definedummyword\w
- }
-}
-
-% \indexnofonts is used when outputting the strings to sort the index
-% by, and when constructing control sequence names. It eliminates all
-% control sequences and just writes whatever the best ASCII sort string
-% would be for a given command (usually its argument).
-%
-\def\indexnofonts{%
- % Accent commands should become @asis.
- \def\definedummyaccent##1{\let##1\asis}%
- % We can just ignore other control letters.
- \def\definedummyletter##1{\let##1\empty}%
- % Hopefully, all control words can become @asis.
- \let\definedummyword\definedummyaccent
- %
- \commondummiesnofonts
- %
- % Don't no-op \tt, since it isn't a user-level command
- % and is used in the definitions of the active chars like <, >, |, etc.
- % Likewise with the other plain tex font commands.
- %\let\tt=\asis
- %
- \def\ { }%
- \def\@{@}%
- % how to handle braces?
- \def\_{\normalunderscore}%
- %
- % Non-English letters.
- \def\AA{AA}%
- \def\AE{AE}%
- \def\L{L}%
- \def\OE{OE}%
- \def\O{O}%
- \def\aa{aa}%
- \def\ae{ae}%
- \def\l{l}%
- \def\oe{oe}%
- \def\o{o}%
- \def\ss{ss}%
- \def\exclamdown{!}%
- \def\questiondown{?}%
- \def\ordf{a}%
- \def\ordm{o}%
- %
- \def\LaTeX{LaTeX}%
- \def\TeX{TeX}%
- %
- % Assorted special characters.
- % (The following {} will end up in the sort string, but that's ok.)
- \def\bullet{bullet}%
- \def\comma{,}%
- \def\copyright{copyright}%
- \def\registeredsymbol{R}%
- \def\dots{...}%
- \def\enddots{...}%
- \def\equiv{==}%
- \def\error{error}%
- \def\euro{euro}%
- \def\expansion{==>}%
- \def\minus{-}%
- \def\pounds{pounds}%
- \def\point{.}%
- \def\print{-|}%
- \def\result{=>}%
- %
- % We need to get rid of all macros, leaving only the arguments (if present).
- % Of course this is not nearly correct, but it is the best we can do for now.
- % makeinfo does not expand macros in the argument to @deffn, which ends up
- % writing an index entry, and texindex isn't prepared for an index sort entry
- % that starts with \.
- %
- % Since macro invocations are followed by braces, we can just redefine them
- % to take a single TeX argument. The case of a macro invocation that
- % goes to end-of-line is not handled.
- %
- \macrolist
-}
-
-\let\indexbackslash=0 %overridden during \printindex.
-\let\SETmarginindex=\relax % put index entries in margin (undocumented)?
-
-% Most index entries go through here, but \dosubind is the general case.
-% #1 is the index name, #2 is the entry text.
-\def\doind#1#2{\dosubind{#1}{#2}{}}
-
-% Workhorse for all \fooindexes.
-% #1 is name of index, #2 is stuff to put there, #3 is subentry --
-% empty if called from \doind, as we usually are (the main exception
-% is with most defuns, which call us directly).
-%
-\def\dosubind#1#2#3{%
- \iflinks
- {%
- % Store the main index entry text (including the third arg).
- \toks0 = {#2}%
- % If third arg is present, precede it with a space.
- \def\thirdarg{#3}%
- \ifx\thirdarg\empty \else
- \toks0 = \expandafter{\the\toks0 \space #3}%
- \fi
- %
- \edef\writeto{\csname#1indfile\endcsname}%
- %
- \ifvmode
- \dosubindsanitize
- \else
- \dosubindwrite
- \fi
- }%
- \fi
-}
-
-% Write the entry in \toks0 to the index file:
-%
-\def\dosubindwrite{%
- % Put the index entry in the margin if desired.
- \ifx\SETmarginindex\relax\else
- \insert\margin{\hbox{\vrule height8pt depth3pt width0pt \the\toks0}}%
- \fi
- %
- % Remember, we are within a group.
- \indexdummies % Must do this here, since \bf, etc expand at this stage
- \def\backslashcurfont{\indexbackslash}% \indexbackslash isn't defined now
- % so it will be output as is; and it will print as backslash.
- %
- % Process the index entry with all font commands turned off, to
- % get the string to sort by.
- {\indexnofonts
- \edef\temp{\the\toks0}% need full expansion
- \xdef\indexsorttmp{\temp}%
- }%
- %
- % Set up the complete index entry, with both the sort key and
- % the original text, including any font commands. We write
- % three arguments to \entry to the .?? file (four in the
- % subentry case), texindex reduces to two when writing the .??s
- % sorted result.
- \edef\temp{%
- \write\writeto{%
- \string\entry{\indexsorttmp}{\noexpand\folio}{\the\toks0}}%
- }%
- \temp
-}
-
-% Take care of unwanted page breaks:
-%
-% If a skip is the last thing on the list now, preserve it
-% by backing up by \lastskip, doing the \write, then inserting
-% the skip again. Otherwise, the whatsit generated by the
-% \write will make \lastskip zero. The result is that sequences
-% like this:
-% @end defun
-% @tindex whatever
-% @defun ...
-% will have extra space inserted, because the \medbreak in the
-% start of the @defun won't see the skip inserted by the @end of
-% the previous defun.
-%
-% But don't do any of this if we're not in vertical mode. We
-% don't want to do a \vskip and prematurely end a paragraph.
-%
-% Avoid page breaks due to these extra skips, too.
-%
-% But wait, there is a catch there:
-% We'll have to check whether \lastskip is zero skip. \ifdim is not
-% sufficient for this purpose, as it ignores stretch and shrink parts
-% of the skip. The only way seems to be to check the textual
-% representation of the skip.
-%
-% The following is almost like \def\zeroskipmacro{0.0pt} except that
-% the ``p'' and ``t'' characters have catcode \other, not 11 (letter).
-%
-\edef\zeroskipmacro{\expandafter\the\csname z@skip\endcsname}
-%
-% ..., ready, GO:
-%
-\def\dosubindsanitize{%
- % \lastskip and \lastpenalty cannot both be nonzero simultaneously.
- \skip0 = \lastskip
- \edef\lastskipmacro{\the\lastskip}%
- \count255 = \lastpenalty
- %
- % If \lastskip is nonzero, that means the last item was a
- % skip. And since a skip is discardable, that means this
- % -\skip0 glue we're inserting is preceded by a
- % non-discardable item, therefore it is not a potential
- % breakpoint, therefore no \nobreak needed.
- \ifx\lastskipmacro\zeroskipmacro
- \else
- \vskip-\skip0
- \fi
- %
- \dosubindwrite
- %
- \ifx\lastskipmacro\zeroskipmacro
- % If \lastskip was zero, perhaps the last item was a penalty, and
- % perhaps it was >=10000, e.g., a \nobreak. In that case, we want
- % to re-insert the same penalty (values >10000 are used for various
- % signals); since we just inserted a non-discardable item, any
- % following glue (such as a \parskip) would be a breakpoint. For example:
- %
- % @deffn deffn-whatever
- % @vindex index-whatever
- % Description.
- % would allow a break between the index-whatever whatsit
- % and the "Description." paragraph.
- \ifnum\count255>9999 \penalty\count255 \fi
- \else
- % On the other hand, if we had a nonzero \lastskip,
- % this make-up glue would be preceded by a non-discardable item
- % (the whatsit from the \write), so we must insert a \nobreak.
- \nobreak\vskip\skip0
- \fi
-}
-
-% The index entry written in the file actually looks like
-% \entry {sortstring}{page}{topic}
-% or
-% \entry {sortstring}{page}{topic}{subtopic}
-% The texindex program reads in these files and writes files
-% containing these kinds of lines:
-% \initial {c}
-% before the first topic whose initial is c
-% \entry {topic}{pagelist}
-% for a topic that is used without subtopics
-% \primary {topic}
-% for the beginning of a topic that is used with subtopics
-% \secondary {subtopic}{pagelist}
-% for each subtopic.
-
-% Define the user-accessible indexing commands
-% @findex, @vindex, @kindex, @cindex.
-
-\def\findex {\fnindex}
-\def\kindex {\kyindex}
-\def\cindex {\cpindex}
-\def\vindex {\vrindex}
-\def\tindex {\tpindex}
-\def\pindex {\pgindex}
-
-\def\cindexsub {\begingroup\obeylines\cindexsub}
-{\obeylines %
-\gdef\cindexsub "#1" #2^^M{\endgroup %
-\dosubind{cp}{#2}{#1}}}
-
-% Define the macros used in formatting output of the sorted index material.
-
-% @printindex causes a particular index (the ??s file) to get printed.
-% It does not print any chapter heading (usually an @unnumbered).
-%
-\parseargdef\printindex{\begingroup
- \dobreak \chapheadingskip{10000}%
- %
- \smallfonts \rm
- \tolerance = 9500
- \everypar = {}% don't want the \kern\-parindent from indentation suppression.
- %
- % See if the index file exists and is nonempty.
- % Change catcode of @ here so that if the index file contains
- % \initial {@}
- % as its first line, TeX doesn't complain about mismatched braces
- % (because it thinks @} is a control sequence).
- \catcode`\@ = 11
- \openin 1 \jobname.#1s
- \ifeof 1
- % \enddoublecolumns gets confused if there is no text in the index,
- % and it loses the chapter title and the aux file entries for the
- % index. The easiest way to prevent this problem is to make sure
- % there is some text.
- \putwordIndexNonexistent
- \else
- %
- % If the index file exists but is empty, then \openin leaves \ifeof
- % false. We have to make TeX try to read something from the file, so
- % it can discover if there is anything in it.
- \read 1 to \temp
- \ifeof 1
- \putwordIndexIsEmpty
- \else
- % Index files are almost Texinfo source, but we use \ as the escape
- % character. It would be better to use @, but that's too big a change
- % to make right now.
- \def\indexbackslash{\backslashcurfont}%
- \catcode`\\ = 0
- \escapechar = `\\
- \begindoublecolumns
- \input \jobname.#1s
- \enddoublecolumns
- \fi
- \fi
- \closein 1
-\endgroup}
-
-% These macros are used by the sorted index file itself.
-% Change them to control the appearance of the index.
-
-\def\initial#1{{%
- % Some minor font changes for the special characters.
- \let\tentt=\sectt \let\tt=\sectt \let\sf=\sectt
- %
- % Remove any glue we may have, we'll be inserting our own.
- \removelastskip
- %
- % We like breaks before the index initials, so insert a bonus.
- \nobreak
- \vskip 0pt plus 3\baselineskip
- \penalty 0
- \vskip 0pt plus -3\baselineskip
- %
- % Typeset the initial. Making this add up to a whole number of
- % baselineskips increases the chance of the dots lining up from column
- % to column. It still won't often be perfect, because of the stretch
- % we need before each entry, but it's better.
- %
- % No shrink because it confuses \balancecolumns.
- \vskip 1.67\baselineskip plus .5\baselineskip
- \leftline{\secbf #1}%
- % Do our best not to break after the initial.
- \nobreak
- \vskip .33\baselineskip plus .1\baselineskip
-}}
-
-% \entry typesets a paragraph consisting of the text (#1), dot leaders, and
-% then page number (#2) flushed to the right margin. It is used for index
-% and table of contents entries. The paragraph is indented by \leftskip.
-%
-% A straightforward implementation would start like this:
-% \def\entry#1#2{...
-% But this frozes the catcodes in the argument, and can cause problems to
-% @code, which sets - active. This problem was fixed by a kludge---
-% ``-'' was active throughout whole index, but this isn't really right.
-%
-% The right solution is to prevent \entry from swallowing the whole text.
-% --kasal, 21nov03
-\def\entry{%
- \begingroup
- %
- % Start a new paragraph if necessary, so our assignments below can't
- % affect previous text.
- \par
- %
- % Do not fill out the last line with white space.
- \parfillskip = 0in
- %
- % No extra space above this paragraph.
- \parskip = 0in
- %
- % Do not prefer a separate line ending with a hyphen to fewer lines.
- \finalhyphendemerits = 0
- %
- % \hangindent is only relevant when the entry text and page number
- % don't both fit on one line. In that case, bob suggests starting the
- % dots pretty far over on the line. Unfortunately, a large
- % indentation looks wrong when the entry text itself is broken across
- % lines. So we use a small indentation and put up with long leaders.
- %
- % \hangafter is reset to 1 (which is the value we want) at the start
- % of each paragraph, so we need not do anything with that.
- \hangindent = 2em
- %
- % When the entry text needs to be broken, just fill out the first line
- % with blank space.
- \rightskip = 0pt plus1fil
- %
- % A bit of stretch before each entry for the benefit of balancing
- % columns.
- \vskip 0pt plus1pt
- %
- % Swallow the left brace of the text (first parameter):
- \afterassignment\doentry
- \let\temp =
-}
-\def\doentry{%
- \bgroup % Instead of the swallowed brace.
- \noindent
- \aftergroup\finishentry
- % And now comes the text of the entry.
-}
-\def\finishentry#1{%
- % #1 is the page number.
- %
- % The following is kludged to not output a line of dots in the index if
- % there are no page numbers. The next person who breaks this will be
- % cursed by a Unix daemon.
- \def\tempa{{\rm }}%
- \def\tempb{#1}%
- \edef\tempc{\tempa}%
- \edef\tempd{\tempb}%
- \ifx\tempc\tempd
- \ %
- \else
- %
- % If we must, put the page number on a line of its own, and fill out
- % this line with blank space. (The \hfil is overwhelmed with the
- % fill leaders glue in \indexdotfill if the page number does fit.)
- \hfil\penalty50
- \null\nobreak\indexdotfill % Have leaders before the page number.
- %
- % The `\ ' here is removed by the implicit \unskip that TeX does as
- % part of (the primitive) \par. Without it, a spurious underfull
- % \hbox ensues.
- \ifpdf
- \pdfgettoks#1.%
- \ \the\toksA
- \else
- \ #1%
- \fi
- \fi
- \par
- \endgroup
-}
-
-% Like \dotfill except takes at least 1 em.
-\def\indexdotfill{\cleaders
- \hbox{$\mathsurround=0pt \mkern1.5mu ${\it .}$ \mkern1.5mu$}\hskip 1em plus 1fill}
-
-\def\primary #1{\line{#1\hfil}}
-
-\newskip\secondaryindent \secondaryindent=0.5cm
-\def\secondary#1#2{{%
- \parfillskip=0in
- \parskip=0in
- \hangindent=1in
- \hangafter=1
- \noindent\hskip\secondaryindent\hbox{#1}\indexdotfill
- \ifpdf
- \pdfgettoks#2.\ \the\toksA % The page number ends the paragraph.
- \else
- #2
- \fi
- \par
-}}
-
-% Define two-column mode, which we use to typeset indexes.
-% Adapted from the TeXbook, page 416, which is to say,
-% the manmac.tex format used to print the TeXbook itself.
-\catcode`\@=11
-
-\newbox\partialpage
-\newdimen\doublecolumnhsize
-
-\def\begindoublecolumns{\begingroup % ended by \enddoublecolumns
- % Grab any single-column material above us.
- \output = {%
- %
- % Here is a possibility not foreseen in manmac: if we accumulate a
- % whole lot of material, we might end up calling this \output
- % routine twice in a row (see the doublecol-lose test, which is
- % essentially a couple of indexes with @setchapternewpage off). In
- % that case we just ship out what is in \partialpage with the normal
- % output routine. Generally, \partialpage will be empty when this
- % runs and this will be a no-op. See the indexspread.tex test case.
- \ifvoid\partialpage \else
- \onepageout{\pagecontents\partialpage}%
- \fi
- %
- \global\setbox\partialpage = \vbox{%
- % Unvbox the main output page.
- \unvbox\PAGE
- \kern-\topskip \kern\baselineskip
- }%
- }%
- \eject % run that output routine to set \partialpage
- %
- % Use the double-column output routine for subsequent pages.
- \output = {\doublecolumnout}%
- %
- % Change the page size parameters. We could do this once outside this
- % routine, in each of @smallbook, @afourpaper, and the default 8.5x11
- % format, but then we repeat the same computation. Repeating a couple
- % of assignments once per index is clearly meaningless for the
- % execution time, so we may as well do it in one place.
- %
- % First we halve the line length, less a little for the gutter between
- % the columns. We compute the gutter based on the line length, so it
- % changes automatically with the paper format. The magic constant
- % below is chosen so that the gutter has the same value (well, +-<1pt)
- % as it did when we hard-coded it.
- %
- % We put the result in a separate register, \doublecolumhsize, so we
- % can restore it in \pagesofar, after \hsize itself has (potentially)
- % been clobbered.
- %
- \doublecolumnhsize = \hsize
- \advance\doublecolumnhsize by -.04154\hsize
- \divide\doublecolumnhsize by 2
- \hsize = \doublecolumnhsize
- %
- % Double the \vsize as well. (We don't need a separate register here,
- % since nobody clobbers \vsize.)
- \vsize = 2\vsize
-}
-
-% The double-column output routine for all double-column pages except
-% the last.
-%
-\def\doublecolumnout{%
- \splittopskip=\topskip \splitmaxdepth=\maxdepth
- % Get the available space for the double columns -- the normal
- % (undoubled) page height minus any material left over from the
- % previous page.
- \dimen@ = \vsize
- \divide\dimen@ by 2
- \advance\dimen@ by -\ht\partialpage
- %
- % box0 will be the left-hand column, box2 the right.
- \setbox0=\vsplit255 to\dimen@ \setbox2=\vsplit255 to\dimen@
- \onepageout\pagesofar
- \unvbox255
- \penalty\outputpenalty
-}
-%
-% Re-output the contents of the output page -- any previous material,
-% followed by the two boxes we just split, in box0 and box2.
-\def\pagesofar{%
- \unvbox\partialpage
- %
- \hsize = \doublecolumnhsize
- \wd0=\hsize \wd2=\hsize
- \hbox to\pagewidth{\box0\hfil\box2}%
-}
-%
-% All done with double columns.
-\def\enddoublecolumns{%
- \output = {%
- % Split the last of the double-column material. Leave it on the
- % current page, no automatic page break.
- \balancecolumns
- %
- % If we end up splitting too much material for the current page,
- % though, there will be another page break right after this \output
- % invocation ends. Having called \balancecolumns once, we do not
- % want to call it again. Therefore, reset \output to its normal
- % definition right away. (We hope \balancecolumns will never be
- % called on to balance too much material, but if it is, this makes
- % the output somewhat more palatable.)
- \global\output = {\onepageout{\pagecontents\PAGE}}%
- }%
- \eject
- \endgroup % started in \begindoublecolumns
- %
- % \pagegoal was set to the doubled \vsize above, since we restarted
- % the current page. We're now back to normal single-column
- % typesetting, so reset \pagegoal to the normal \vsize (after the
- % \endgroup where \vsize got restored).
- \pagegoal = \vsize
-}
-%
-% Called at the end of the double column material.
-\def\balancecolumns{%
- \setbox0 = \vbox{\unvbox255}% like \box255 but more efficient, see p.120.
- \dimen@ = \ht0
- \advance\dimen@ by \topskip
- \advance\dimen@ by-\baselineskip
- \divide\dimen@ by 2 % target to split to
- %debug\message{final 2-column material height=\the\ht0, target=\the\dimen@.}%
- \splittopskip = \topskip
- % Loop until we get a decent breakpoint.
- {%
- \vbadness = 10000
- \loop
- \global\setbox3 = \copy0
- \global\setbox1 = \vsplit3 to \dimen@
- \ifdim\ht3>\dimen@
- \global\advance\dimen@ by 1pt
- \repeat
- }%
- %debug\message{split to \the\dimen@, column heights: \the\ht1, \the\ht3.}%
- \setbox0=\vbox to\dimen@{\unvbox1}%
- \setbox2=\vbox to\dimen@{\unvbox3}%
- %
- \pagesofar
-}
-\catcode`\@ = \other
-
-
-\message{sectioning,}
-% Chapters, sections, etc.
-
-% \unnumberedno is an oxymoron, of course. But we count the unnumbered
-% sections so that we can refer to them unambiguously in the pdf
-% outlines by their "section number". We avoid collisions with chapter
-% numbers by starting them at 10000. (If a document ever has 10000
-% chapters, we're in trouble anyway, I'm sure.)
-\newcount\unnumberedno \unnumberedno = 10000
-\newcount\chapno
-\newcount\secno \secno=0
-\newcount\subsecno \subsecno=0
-\newcount\subsubsecno \subsubsecno=0
-
-% This counter is funny since it counts through charcodes of letters A, B, ...
-\newcount\appendixno \appendixno = `\@
-%
-% \def\appendixletter{\char\the\appendixno}
-% We do the following ugly conditional instead of the above simple
-% construct for the sake of pdftex, which needs the actual
-% letter in the expansion, not just typeset.
-%
-\def\appendixletter{%
- \ifnum\appendixno=`A A%
- \else\ifnum\appendixno=`B B%
- \else\ifnum\appendixno=`C C%
- \else\ifnum\appendixno=`D D%
- \else\ifnum\appendixno=`E E%
- \else\ifnum\appendixno=`F F%
- \else\ifnum\appendixno=`G G%
- \else\ifnum\appendixno=`H H%
- \else\ifnum\appendixno=`I I%
- \else\ifnum\appendixno=`J J%
- \else\ifnum\appendixno=`K K%
- \else\ifnum\appendixno=`L L%
- \else\ifnum\appendixno=`M M%
- \else\ifnum\appendixno=`N N%
- \else\ifnum\appendixno=`O O%
- \else\ifnum\appendixno=`P P%
- \else\ifnum\appendixno=`Q Q%
- \else\ifnum\appendixno=`R R%
- \else\ifnum\appendixno=`S S%
- \else\ifnum\appendixno=`T T%
- \else\ifnum\appendixno=`U U%
- \else\ifnum\appendixno=`V V%
- \else\ifnum\appendixno=`W W%
- \else\ifnum\appendixno=`X X%
- \else\ifnum\appendixno=`Y Y%
- \else\ifnum\appendixno=`Z Z%
- % The \the is necessary, despite appearances, because \appendixletter is
- % expanded while writing the .toc file. \char\appendixno is not
- % expandable, thus it is written literally, thus all appendixes come out
- % with the same letter (or @) in the toc without it.
- \else\char\the\appendixno
- \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi
- \fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi\fi}
-
-% Each @chapter defines this as the name of the chapter.
-% page headings and footings can use it. @section does likewise.
-% However, they are not reliable, because we don't use marks.
-\def\thischapter{}
-\def\thissection{}
-
-\newcount\absseclevel % used to calculate proper heading level
-\newcount\secbase\secbase=0 % @raisesections/@lowersections modify this count
-
-% @raisesections: treat @section as chapter, @subsection as section, etc.
-\def\raisesections{\global\advance\secbase by -1}
-\let\up=\raisesections % original BFox name
-
-% @lowersections: treat @chapter as section, @section as subsection, etc.
-\def\lowersections{\global\advance\secbase by 1}
-\let\down=\lowersections % original BFox name
-
-% we only have subsub.
-\chardef\maxseclevel = 3
-%
-% A numbered section within an unnumbered changes to unnumbered too.
-% To achive this, remember the "biggest" unnum. sec. we are currently in:
-\chardef\unmlevel = \maxseclevel
-%
-% Trace whether the current chapter is an appendix or not:
-% \chapheadtype is "N" or "A", unnumbered chapters are ignored.
-\def\chapheadtype{N}
-
-% Choose a heading macro
-% #1 is heading type
-% #2 is heading level
-% #3 is text for heading
-\def\genhead#1#2#3{%
- % Compute the abs. sec. level:
- \absseclevel=#2
- \advance\absseclevel by \secbase
- % Make sure \absseclevel doesn't fall outside the range:
- \ifnum \absseclevel < 0
- \absseclevel = 0
- \else
- \ifnum \absseclevel > 3
- \absseclevel = 3
- \fi
- \fi
- % The heading type:
- \def\headtype{#1}%
- \if \headtype U%
- \ifnum \absseclevel < \unmlevel
- \chardef\unmlevel = \absseclevel
- \fi
- \else
- % Check for appendix sections:
- \ifnum \absseclevel = 0
- \edef\chapheadtype{\headtype}%
- \else
- \if \headtype A\if \chapheadtype N%
- \errmessage{@appendix... within a non-appendix chapter}%
- \fi\fi
- \fi
- % Check for numbered within unnumbered:
- \ifnum \absseclevel > \unmlevel
- \def\headtype{U}%
- \else
- \chardef\unmlevel = 3
- \fi
- \fi
- % Now print the heading:
- \if \headtype U%
- \ifcase\absseclevel
- \unnumberedzzz{#3}%
- \or \unnumberedseczzz{#3}%
- \or \unnumberedsubseczzz{#3}%
- \or \unnumberedsubsubseczzz{#3}%
- \fi
- \else
- \if \headtype A%
- \ifcase\absseclevel
- \appendixzzz{#3}%
- \or \appendixsectionzzz{#3}%
- \or \appendixsubseczzz{#3}%
- \or \appendixsubsubseczzz{#3}%
- \fi
- \else
- \ifcase\absseclevel
- \chapterzzz{#3}%
- \or \seczzz{#3}%
- \or \numberedsubseczzz{#3}%
- \or \numberedsubsubseczzz{#3}%
- \fi
- \fi
- \fi
- \suppressfirstparagraphindent
-}
-
-% an interface:
-\def\numhead{\genhead N}
-\def\apphead{\genhead A}
-\def\unnmhead{\genhead U}
-
-% @chapter, @appendix, @unnumbered. Increment top-level counter, reset
-% all lower-level sectioning counters to zero.
-%
-% Also set \chaplevelprefix, which we prepend to @float sequence numbers
-% (e.g., figures), q.v. By default (before any chapter), that is empty.
-\let\chaplevelprefix = \empty
-%
-\outer\parseargdef\chapter{\numhead0{#1}} % normally numhead0 calls chapterzzz
-\def\chapterzzz#1{%
- % section resetting is \global in case the chapter is in a group, such
- % as an @include file.
- \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
- \global\advance\chapno by 1
- %
- % Used for \float.
- \gdef\chaplevelprefix{\the\chapno.}%
- \resetallfloatnos
- %
- \message{\putwordChapter\space \the\chapno}%
- %
- % Write the actual heading.
- \chapmacro{#1}{Ynumbered}{\the\chapno}%
- %
- % So @section and the like are numbered underneath this chapter.
- \global\let\section = \numberedsec
- \global\let\subsection = \numberedsubsec
- \global\let\subsubsection = \numberedsubsubsec
-}
-
-\outer\parseargdef\appendix{\apphead0{#1}} % normally apphead0 calls appendixzzz
-\def\appendixzzz#1{%
- \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
- \global\advance\appendixno by 1
- \gdef\chaplevelprefix{\appendixletter.}%
- \resetallfloatnos
- %
- \def\appendixnum{\putwordAppendix\space \appendixletter}%
- \message{\appendixnum}%
- %
- \chapmacro{#1}{Yappendix}{\appendixletter}%
- %
- \global\let\section = \appendixsec
- \global\let\subsection = \appendixsubsec
- \global\let\subsubsection = \appendixsubsubsec
-}
-
-\outer\parseargdef\unnumbered{\unnmhead0{#1}} % normally unnmhead0 calls unnumberedzzz
-\def\unnumberedzzz#1{%
- \global\secno=0 \global\subsecno=0 \global\subsubsecno=0
- \global\advance\unnumberedno by 1
- %
- % Since an unnumbered has no number, no prefix for figures.
- \global\let\chaplevelprefix = \empty
- \resetallfloatnos
- %
- % This used to be simply \message{#1}, but TeX fully expands the
- % argument to \message. Therefore, if #1 contained @-commands, TeX
- % expanded them. For example, in `@unnumbered The @cite{Book}', TeX
- % expanded @cite (which turns out to cause errors because \cite is meant
- % to be executed, not expanded).
- %
- % Anyway, we don't want the fully-expanded definition of @cite to appear
- % as a result of the \message, we just want `@cite' itself. We use
- % \the<toks register> to achieve this: TeX expands \the<toks> only once,
- % simply yielding the contents of <toks register>. (We also do this for
- % the toc entries.)
- \toks0 = {#1}%
- \message{(\the\toks0)}%
- %
- \chapmacro{#1}{Ynothing}{\the\unnumberedno}%
- %
- \global\let\section = \unnumberedsec
- \global\let\subsection = \unnumberedsubsec
- \global\let\subsubsection = \unnumberedsubsubsec
-}
-
-% @centerchap is like @unnumbered, but the heading is centered.
-\outer\parseargdef\centerchap{%
- % Well, we could do the following in a group, but that would break
- % an assumption that \chapmacro is called at the outermost level.
- % Thus we are safer this way: --kasal, 24feb04
- \let\centerparametersmaybe = \centerparameters
- \unnmhead0{#1}%
- \let\centerparametersmaybe = \relax
-}
-
-% @top is like @unnumbered.
-\let\top\unnumbered
-
-% Sections.
-\outer\parseargdef\numberedsec{\numhead1{#1}} % normally calls seczzz
-\def\seczzz#1{%
- \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
- \sectionheading{#1}{sec}{Ynumbered}{\the\chapno.\the\secno}%
-}
-
-\outer\parseargdef\appendixsection{\apphead1{#1}} % normally calls appendixsectionzzz
-\def\appendixsectionzzz#1{%
- \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
- \sectionheading{#1}{sec}{Yappendix}{\appendixletter.\the\secno}%
-}
-\let\appendixsec\appendixsection
-
-\outer\parseargdef\unnumberedsec{\unnmhead1{#1}} % normally calls unnumberedseczzz
-\def\unnumberedseczzz#1{%
- \global\subsecno=0 \global\subsubsecno=0 \global\advance\secno by 1
- \sectionheading{#1}{sec}{Ynothing}{\the\unnumberedno.\the\secno}%
-}
-
-% Subsections.
-\outer\parseargdef\numberedsubsec{\numhead2{#1}} % normally calls numberedsubseczzz
-\def\numberedsubseczzz#1{%
- \global\subsubsecno=0 \global\advance\subsecno by 1
- \sectionheading{#1}{subsec}{Ynumbered}{\the\chapno.\the\secno.\the\subsecno}%
-}
-
-\outer\parseargdef\appendixsubsec{\apphead2{#1}} % normally calls appendixsubseczzz
-\def\appendixsubseczzz#1{%
- \global\subsubsecno=0 \global\advance\subsecno by 1
- \sectionheading{#1}{subsec}{Yappendix}%
- {\appendixletter.\the\secno.\the\subsecno}%
-}
-
-\outer\parseargdef\unnumberedsubsec{\unnmhead2{#1}} %normally calls unnumberedsubseczzz
-\def\unnumberedsubseczzz#1{%
- \global\subsubsecno=0 \global\advance\subsecno by 1
- \sectionheading{#1}{subsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno}%
-}
-
-% Subsubsections.
-\outer\parseargdef\numberedsubsubsec{\numhead3{#1}} % normally numberedsubsubseczzz
-\def\numberedsubsubseczzz#1{%
- \global\advance\subsubsecno by 1
- \sectionheading{#1}{subsubsec}{Ynumbered}%
- {\the\chapno.\the\secno.\the\subsecno.\the\subsubsecno}%
-}
-
-\outer\parseargdef\appendixsubsubsec{\apphead3{#1}} % normally appendixsubsubseczzz
-\def\appendixsubsubseczzz#1{%
- \global\advance\subsubsecno by 1
- \sectionheading{#1}{subsubsec}{Yappendix}%
- {\appendixletter.\the\secno.\the\subsecno.\the\subsubsecno}%
-}
-
-\outer\parseargdef\unnumberedsubsubsec{\unnmhead3{#1}} %normally unnumberedsubsubseczzz
-\def\unnumberedsubsubseczzz#1{%
- \global\advance\subsubsecno by 1
- \sectionheading{#1}{subsubsec}{Ynothing}%
- {\the\unnumberedno.\the\secno.\the\subsecno.\the\subsubsecno}%
-}
-
-% These macros control what the section commands do, according
-% to what kind of chapter we are in (ordinary, appendix, or unnumbered).
-% Define them by default for a numbered chapter.
-\let\section = \numberedsec
-\let\subsection = \numberedsubsec
-\let\subsubsection = \numberedsubsubsec
-
-% Define @majorheading, @heading and @subheading
-
-% NOTE on use of \vbox for chapter headings, section headings, and such:
-% 1) We use \vbox rather than the earlier \line to permit
-% overlong headings to fold.
-% 2) \hyphenpenalty is set to 10000 because hyphenation in a
-% heading is obnoxious; this forbids it.
-% 3) Likewise, headings look best if no \parindent is used, and
-% if justification is not attempted. Hence \raggedright.
-
-
-\def\majorheading{%
- {\advance\chapheadingskip by 10pt \chapbreak }%
- \parsearg\chapheadingzzz
-}
-
-\def\chapheading{\chapbreak \parsearg\chapheadingzzz}
-\def\chapheadingzzz#1{%
- {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\raggedright
- \rm #1\hfill}}%
- \bigskip \par\penalty 200\relax
- \suppressfirstparagraphindent
-}
-
-% @heading, @subheading, @subsubheading.
-\parseargdef\heading{\sectionheading{#1}{sec}{Yomitfromtoc}{}
- \suppressfirstparagraphindent}
-\parseargdef\subheading{\sectionheading{#1}{subsec}{Yomitfromtoc}{}
- \suppressfirstparagraphindent}
-\parseargdef\subsubheading{\sectionheading{#1}{subsubsec}{Yomitfromtoc}{}
- \suppressfirstparagraphindent}
-
-% These macros generate a chapter, section, etc. heading only
-% (including whitespace, linebreaking, etc. around it),
-% given all the information in convenient, parsed form.
-
-%%% Args are the skip and penalty (usually negative)
-\def\dobreak#1#2{\par\ifdim\lastskip<#1\removelastskip\penalty#2\vskip#1\fi}
-
-%%% Define plain chapter starts, and page on/off switching for it
-% Parameter controlling skip before chapter headings (if needed)
-
-\newskip\chapheadingskip
-
-\def\chapbreak{\dobreak \chapheadingskip {-4000}}
-\def\chappager{\par\vfill\supereject}
-\def\chapoddpage{\chappager \ifodd\pageno \else \hbox to 0pt{} \chappager\fi}
-
-\def\setchapternewpage #1 {\csname CHAPPAG#1\endcsname}
-
-\def\CHAPPAGoff{%
-\global\let\contentsalignmacro = \chappager
-\global\let\pchapsepmacro=\chapbreak
-\global\let\pagealignmacro=\chappager}
-
-\def\CHAPPAGon{%
-\global\let\contentsalignmacro = \chappager
-\global\let\pchapsepmacro=\chappager
-\global\let\pagealignmacro=\chappager
-\global\def\HEADINGSon{\HEADINGSsingle}}
-
-\def\CHAPPAGodd{%
-\global\let\contentsalignmacro = \chapoddpage
-\global\let\pchapsepmacro=\chapoddpage
-\global\let\pagealignmacro=\chapoddpage
-\global\def\HEADINGSon{\HEADINGSdouble}}
-
-\CHAPPAGon
-
-% Chapter opening.
-%
-% #1 is the text, #2 is the section type (Ynumbered, Ynothing,
-% Yappendix, Yomitfromtoc), #3 the chapter number.
-%
-% To test against our argument.
-\def\Ynothingkeyword{Ynothing}
-\def\Yomitfromtockeyword{Yomitfromtoc}
-\def\Yappendixkeyword{Yappendix}
-%
-\def\chapmacro#1#2#3{%
- \pchapsepmacro
- {%
- \chapfonts \rm
- %
- % Have to define \thissection before calling \donoderef, because the
- % xref code eventually uses it. On the other hand, it has to be called
- % after \pchapsepmacro, or the headline will change too soon.
- \gdef\thissection{#1}%
- \gdef\thischaptername{#1}%
- %
- % Only insert the separating space if we have a chapter/appendix
- % number, and don't print the unnumbered ``number''.
- \def\temptype{#2}%
- \ifx\temptype\Ynothingkeyword
- \setbox0 = \hbox{}%
- \def\toctype{unnchap}%
- \gdef\thischapter{#1}%
- \else\ifx\temptype\Yomitfromtockeyword
- \setbox0 = \hbox{}% contents like unnumbered, but no toc entry
- \def\toctype{omit}%
- \gdef\thischapter{}%
- \else\ifx\temptype\Yappendixkeyword
- \setbox0 = \hbox{\putwordAppendix{} #3\enspace}%
- \def\toctype{app}%
- % We don't substitute the actual chapter name into \thischapter
- % because we don't want its macros evaluated now. And we don't
- % use \thissection because that changes with each section.
- %
- \xdef\thischapter{\putwordAppendix{} \appendixletter:
- \noexpand\thischaptername}%
- \else
- \setbox0 = \hbox{#3\enspace}%
- \def\toctype{numchap}%
- \xdef\thischapter{\putwordChapter{} \the\chapno:
- \noexpand\thischaptername}%
- \fi\fi\fi
- %
- % Write the toc entry for this chapter. Must come before the
- % \donoderef, because we include the current node name in the toc
- % entry, and \donoderef resets it to empty.
- \writetocentry{\toctype}{#1}{#3}%
- %
- % For pdftex, we have to write out the node definition (aka, make
- % the pdfdest) after any page break, but before the actual text has
- % been typeset. If the destination for the pdf outline is after the
- % text, then jumping from the outline may wind up with the text not
- % being visible, for instance under high magnification.
- \donoderef{#2}%
- %
- % Typeset the actual heading.
- \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
- \hangindent=\wd0 \centerparametersmaybe
- \unhbox0 #1\par}%
- }%
- \nobreak\bigskip % no page break after a chapter title
- \nobreak
-}
-
-% @centerchap -- centered and unnumbered.
-\let\centerparametersmaybe = \relax
-\def\centerparameters{%
- \advance\rightskip by 3\rightskip
- \leftskip = \rightskip
- \parfillskip = 0pt
-}
-
-
-% I don't think this chapter style is supported any more, so I'm not
-% updating it with the new noderef stuff. We'll see. --karl, 11aug03.
-%
-\def\setchapterstyle #1 {\csname CHAPF#1\endcsname}
-%
-\def\unnchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt\raggedright
- \rm #1\hfill}}\bigskip \par\nobreak
-}
-\def\chfopen #1#2{\chapoddpage {\chapfonts
-\vbox to 3in{\vfil \hbox to\hsize{\hfil #2} \hbox to\hsize{\hfil #1} \vfil}}%
-\par\penalty 5000 %
-}
-\def\centerchfopen #1{%
-\chapoddpage {\chapfonts \vbox{\hyphenpenalty=10000\tolerance=5000
- \parindent=0pt
- \hfill {\rm #1}\hfill}}\bigskip \par\nobreak
-}
-\def\CHAPFopen{%
- \global\let\chapmacro=\chfopen
- \global\let\centerchapmacro=\centerchfopen}
-
-
-% Section titles. These macros combine the section number parts and
-% call the generic \sectionheading to do the printing.
-%
-\newskip\secheadingskip
-\def\secheadingbreak{\dobreak \secheadingskip{-1000}}
-
-% Subsection titles.
-\newskip\subsecheadingskip
-\def\subsecheadingbreak{\dobreak \subsecheadingskip{-500}}
-
-% Subsubsection titles.
-\def\subsubsecheadingskip{\subsecheadingskip}
-\def\subsubsecheadingbreak{\subsecheadingbreak}
-
-
-% Print any size, any type, section title.
-%
-% #1 is the text, #2 is the section level (sec/subsec/subsubsec), #3 is
-% the section type for xrefs (Ynumbered, Ynothing, Yappendix), #4 is the
-% section number.
-%
-\def\sectionheading#1#2#3#4{%
- {%
- % Switch to the right set of fonts.
- \csname #2fonts\endcsname \rm
- %
- % Insert space above the heading.
- \csname #2headingbreak\endcsname
- %
- % Only insert the space after the number if we have a section number.
- \def\sectionlevel{#2}%
- \def\temptype{#3}%
- %
- \ifx\temptype\Ynothingkeyword
- \setbox0 = \hbox{}%
- \def\toctype{unn}%
- \gdef\thissection{#1}%
- \else\ifx\temptype\Yomitfromtockeyword
- % for @headings -- no section number, don't include in toc,
- % and don't redefine \thissection.
- \setbox0 = \hbox{}%
- \def\toctype{omit}%
- \let\sectionlevel=\empty
- \else\ifx\temptype\Yappendixkeyword
- \setbox0 = \hbox{#4\enspace}%
- \def\toctype{app}%
- \gdef\thissection{#1}%
- \else
- \setbox0 = \hbox{#4\enspace}%
- \def\toctype{num}%
- \gdef\thissection{#1}%
- \fi\fi\fi
- %
- % Write the toc entry (before \donoderef). See comments in \chfplain.
- \writetocentry{\toctype\sectionlevel}{#1}{#4}%
- %
- % Write the node reference (= pdf destination for pdftex).
- % Again, see comments in \chfplain.
- \donoderef{#3}%
- %
- % Output the actual section heading.
- \vbox{\hyphenpenalty=10000 \tolerance=5000 \parindent=0pt \raggedright
- \hangindent=\wd0 % zero if no section number
- \unhbox0 #1}%
- }%
- % Add extra space after the heading -- half of whatever came above it.
- % Don't allow stretch, though.
- \kern .5 \csname #2headingskip\endcsname
- %
- % Do not let the kern be a potential breakpoint, as it would be if it
- % was followed by glue.
- \nobreak
- %
- % We'll almost certainly start a paragraph next, so don't let that
- % glue accumulate. (Not a breakpoint because it's preceded by a
- % discardable item.)
- \vskip-\parskip
- %
- % This is purely so the last item on the list is a known \penalty >
- % 10000. This is so \startdefun can avoid allowing breakpoints after
- % section headings. Otherwise, it would insert a valid breakpoint between:
- %
- % @section sec-whatever
- % @deffn def-whatever
- \penalty 10001
-}
-
-
-\message{toc,}
-% Table of contents.
-\newwrite\tocfile
-
-% Write an entry to the toc file, opening it if necessary.
-% Called from @chapter, etc.
-%
-% Example usage: \writetocentry{sec}{Section Name}{\the\chapno.\the\secno}
-% We append the current node name (if any) and page number as additional
-% arguments for the \{chap,sec,...}entry macros which will eventually
-% read this. The node name is used in the pdf outlines as the
-% destination to jump to.
-%
-% We open the .toc file for writing here instead of at @setfilename (or
-% any other fixed time) so that @contents can be anywhere in the document.
-% But if #1 is `omit', then we don't do anything. This is used for the
-% table of contents chapter openings themselves.
-%
-\newif\iftocfileopened
-\def\omitkeyword{omit}%
-%
-\def\writetocentry#1#2#3{%
- \edef\writetoctype{#1}%
- \ifx\writetoctype\omitkeyword \else
- \iftocfileopened\else
- \immediate\openout\tocfile = \jobname.toc
- \global\tocfileopenedtrue
- \fi
- %
- \iflinks
- {\atdummies
- \edef\temp{%
- \write\tocfile{@#1entry{#2}{#3}{\lastnode}{\noexpand\folio}}}%
- \temp
- }
- \fi
- \fi
- %
- % Tell \shipout to create a pdf destination on each page, if we're
- % writing pdf. These are used in the table of contents. We can't
- % just write one on every page because the title pages are numbered
- % 1 and 2 (the page numbers aren't printed), and so are the first
- % two pages of the document. Thus, we'd have two destinations named
- % `1', and two named `2'.
- \ifpdf \global\pdfmakepagedesttrue \fi
-}
-
-
-% These characters do not print properly in the Computer Modern roman
-% fonts, so we must take special care. This is more or less redundant
-% with the Texinfo input format setup at the end of this file.
-%
-\def\activecatcodes{%
- \catcode`\"=\active
- \catcode`\$=\active
- \catcode`\<=\active
- \catcode`\>=\active
- \catcode`\\=\active
- \catcode`\^=\active
- \catcode`\_=\active
- \catcode`\|=\active
- \catcode`\~=\active
-}
-
-
-% Read the toc file, which is essentially Texinfo input.
-\def\readtocfile{%
- \setupdatafile
- \activecatcodes
- \input \jobname.toc
-}
-
-\newskip\contentsrightmargin \contentsrightmargin=1in
-\newcount\savepageno
-\newcount\lastnegativepageno \lastnegativepageno = -1
-
-% Prepare to read what we've written to \tocfile.
-%
-\def\startcontents#1{%
- % If @setchapternewpage on, and @headings double, the contents should
- % start on an odd page, unlike chapters. Thus, we maintain
- % \contentsalignmacro in parallel with \pagealignmacro.
- % From: Torbjorn Granlund <tege@matematik.su.se>
- \contentsalignmacro
- \immediate\closeout\tocfile
- %
- % Don't need to put `Contents' or `Short Contents' in the headline.
- % It is abundantly clear what they are.
- \def\thischapter{}%
- \chapmacro{#1}{Yomitfromtoc}{}%
- %
- \savepageno = \pageno
- \begingroup % Set up to handle contents files properly.
- \raggedbottom % Worry more about breakpoints than the bottom.
- \advance\hsize by -\contentsrightmargin % Don't use the full line length.
- %
- % Roman numerals for page numbers.
- \ifnum \pageno>0 \global\pageno = \lastnegativepageno \fi
-}
-
-
-% Normal (long) toc.
-\def\contents{%
- \startcontents{\putwordTOC}%
- \openin 1 \jobname.toc
- \ifeof 1 \else
- \readtocfile
- \fi
- \vfill \eject
- \contentsalignmacro % in case @setchapternewpage odd is in effect
- \ifeof 1 \else
- \pdfmakeoutlines
- \fi
- \closein 1
- \endgroup
- \lastnegativepageno = \pageno
- \global\pageno = \savepageno
-}
-
-% And just the chapters.
-\def\summarycontents{%
- \startcontents{\putwordShortTOC}%
- %
- \let\numchapentry = \shortchapentry
- \let\appentry = \shortchapentry
- \let\unnchapentry = \shortunnchapentry
- % We want a true roman here for the page numbers.
- \secfonts
- \let\rm=\shortcontrm \let\bf=\shortcontbf
- \let\sl=\shortcontsl \let\tt=\shortconttt
- \rm
- \hyphenpenalty = 10000
- \advance\baselineskip by 1pt % Open it up a little.
- \def\numsecentry##1##2##3##4{}
- \let\appsecentry = \numsecentry
- \let\unnsecentry = \numsecentry
- \let\numsubsecentry = \numsecentry
- \let\appsubsecentry = \numsecentry
- \let\unnsubsecentry = \numsecentry
- \let\numsubsubsecentry = \numsecentry
- \let\appsubsubsecentry = \numsecentry
- \let\unnsubsubsecentry = \numsecentry
- \openin 1 \jobname.toc
- \ifeof 1 \else
- \readtocfile
- \fi
- \closein 1
- \vfill \eject
- \contentsalignmacro % in case @setchapternewpage odd is in effect
- \endgroup
- \lastnegativepageno = \pageno
- \global\pageno = \savepageno
-}
-\let\shortcontents = \summarycontents
-
-% Typeset the label for a chapter or appendix for the short contents.
-% The arg is, e.g., `A' for an appendix, or `3' for a chapter.
-%
-\def\shortchaplabel#1{%
- % This space should be enough, since a single number is .5em, and the
- % widest letter (M) is 1em, at least in the Computer Modern fonts.
- % But use \hss just in case.
- % (This space doesn't include the extra space that gets added after
- % the label; that gets put in by \shortchapentry above.)
- %
- % We'd like to right-justify chapter numbers, but that looks strange
- % with appendix letters. And right-justifying numbers and
- % left-justifying letters looks strange when there is less than 10
- % chapters. Have to read the whole toc once to know how many chapters
- % there are before deciding ...
- \hbox to 1em{#1\hss}%
-}
-
-% These macros generate individual entries in the table of contents.
-% The first argument is the chapter or section name.
-% The last argument is the page number.
-% The arguments in between are the chapter number, section number, ...
-
-% Chapters, in the main contents.
-\def\numchapentry#1#2#3#4{\dochapentry{#2\labelspace#1}{#4}}
-%
-% Chapters, in the short toc.
-% See comments in \dochapentry re vbox and related settings.
-\def\shortchapentry#1#2#3#4{%
- \tocentry{\shortchaplabel{#2}\labelspace #1}{\doshortpageno\bgroup#4\egroup}%
-}
-
-% Appendices, in the main contents.
-% Need the word Appendix, and a fixed-size box.
-%
-\def\appendixbox#1{%
- % We use M since it's probably the widest letter.
- \setbox0 = \hbox{\putwordAppendix{} M}%
- \hbox to \wd0{\putwordAppendix{} #1\hss}}
-%
-\def\appentry#1#2#3#4{\dochapentry{\appendixbox{#2}\labelspace#1}{#4}}
-
-% Unnumbered chapters.
-\def\unnchapentry#1#2#3#4{\dochapentry{#1}{#4}}
-\def\shortunnchapentry#1#2#3#4{\tocentry{#1}{\doshortpageno\bgroup#4\egroup}}
-
-% Sections.
-\def\numsecentry#1#2#3#4{\dosecentry{#2\labelspace#1}{#4}}
-\let\appsecentry=\numsecentry
-\def\unnsecentry#1#2#3#4{\dosecentry{#1}{#4}}
-
-% Subsections.
-\def\numsubsecentry#1#2#3#4{\dosubsecentry{#2\labelspace#1}{#4}}
-\let\appsubsecentry=\numsubsecentry
-\def\unnsubsecentry#1#2#3#4{\dosubsecentry{#1}{#4}}
-
-% And subsubsections.
-\def\numsubsubsecentry#1#2#3#4{\dosubsubsecentry{#2\labelspace#1}{#4}}
-\let\appsubsubsecentry=\numsubsubsecentry
-\def\unnsubsubsecentry#1#2#3#4{\dosubsubsecentry{#1}{#4}}
-
-% This parameter controls the indentation of the various levels.
-% Same as \defaultparindent.
-\newdimen\tocindent \tocindent = 15pt
-
-% Now for the actual typesetting. In all these, #1 is the text and #2 is the
-% page number.
-%
-% If the toc has to be broken over pages, we want it to be at chapters
-% if at all possible; hence the \penalty.
-\def\dochapentry#1#2{%
- \penalty-300 \vskip1\baselineskip plus.33\baselineskip minus.25\baselineskip
- \begingroup
- \chapentryfonts
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
- \endgroup
- \nobreak\vskip .25\baselineskip plus.1\baselineskip
-}
-
-\def\dosecentry#1#2{\begingroup
- \secentryfonts \leftskip=\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
-\endgroup}
-
-\def\dosubsecentry#1#2{\begingroup
- \subsecentryfonts \leftskip=2\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
-\endgroup}
-
-\def\dosubsubsecentry#1#2{\begingroup
- \subsubsecentryfonts \leftskip=3\tocindent
- \tocentry{#1}{\dopageno\bgroup#2\egroup}%
-\endgroup}
-
-% We use the same \entry macro as for the index entries.
-\let\tocentry = \entry
-
-% Space between chapter (or whatever) number and the title.
-\def\labelspace{\hskip1em \relax}
-
-\def\dopageno#1{{\rm #1}}
-\def\doshortpageno#1{{\rm #1}}
-
-\def\chapentryfonts{\secfonts \rm}
-\def\secentryfonts{\textfonts}
-\def\subsecentryfonts{\textfonts}
-\def\subsubsecentryfonts{\textfonts}
-
-
-\message{environments,}
-% @foo ... @end foo.
-
-% @point{}, @result{}, @expansion{}, @print{}, @equiv{}.
-%
-% Since these characters are used in examples, it should be an even number of
-% \tt widths. Each \tt character is 1en, so two makes it 1em.
-%
-\def\point{$\star$}
-\def\result{\leavevmode\raise.15ex\hbox to 1em{\hfil$\Rightarrow$\hfil}}
-\def\expansion{\leavevmode\raise.1ex\hbox to 1em{\hfil$\mapsto$\hfil}}
-\def\print{\leavevmode\lower.1ex\hbox to 1em{\hfil$\dashv$\hfil}}
-\def\equiv{\leavevmode\lower.1ex\hbox to 1em{\hfil$\ptexequiv$\hfil}}
-
-% The @error{} command.
-% Adapted from the TeXbook's \boxit.
-%
-\newbox\errorbox
-%
-{\tentt \global\dimen0 = 3em}% Width of the box.
-\dimen2 = .55pt % Thickness of rules
-% The text. (`r' is open on the right, `e' somewhat less so on the left.)
-\setbox0 = \hbox{\kern-.75pt \tensf error\kern-1.5pt}
-%
-\setbox\errorbox=\hbox to \dimen0{\hfil
- \hsize = \dimen0 \advance\hsize by -5.8pt % Space to left+right.
- \advance\hsize by -2\dimen2 % Rules.
- \vbox{%
- \hrule height\dimen2
- \hbox{\vrule width\dimen2 \kern3pt % Space to left of text.
- \vtop{\kern2.4pt \box0 \kern2.4pt}% Space above/below.
- \kern3pt\vrule width\dimen2}% Space to right.
- \hrule height\dimen2}
- \hfil}
-%
-\def\error{\leavevmode\lower.7ex\copy\errorbox}
-
-% @tex ... @end tex escapes into raw Tex temporarily.
-% One exception: @ is still an escape character, so that @end tex works.
-% But \@ or @@ will get a plain tex @ character.
-
-\envdef\tex{%
- \catcode `\\=0 \catcode `\{=1 \catcode `\}=2
- \catcode `\$=3 \catcode `\&=4 \catcode `\#=6
- \catcode `\^=7 \catcode `\_=8 \catcode `\~=\active \let~=\tie
- \catcode `\%=14
- \catcode `\+=\other
- \catcode `\"=\other
- \catcode `\|=\other
- \catcode `\<=\other
- \catcode `\>=\other
- \escapechar=`\\
- %
- \let\b=\ptexb
- \let\bullet=\ptexbullet
- \let\c=\ptexc
- \let\,=\ptexcomma
- \let\.=\ptexdot
- \let\dots=\ptexdots
- \let\equiv=\ptexequiv
- \let\!=\ptexexclam
- \let\i=\ptexi
- \let\indent=\ptexindent
- \let\noindent=\ptexnoindent
- \let\{=\ptexlbrace
- \let\+=\tabalign
- \let\}=\ptexrbrace
- \let\/=\ptexslash
- \let\*=\ptexstar
- \let\t=\ptext
- \let\frenchspacing=\plainfrenchspacing
- %
- \def\endldots{\mathinner{\ldots\ldots\ldots\ldots}}%
- \def\enddots{\relax\ifmmode\endldots\else$\mathsurround=0pt \endldots\,$\fi}%
- \def\@{@}%
-}
-% There is no need to define \Etex.
-
-% Define @lisp ... @end lisp.
-% @lisp environment forms a group so it can rebind things,
-% including the definition of @end lisp (which normally is erroneous).
-
-% Amount to narrow the margins by for @lisp.
-\newskip\lispnarrowing \lispnarrowing=0.4in
-
-% This is the definition that ^^M gets inside @lisp, @example, and other
-% such environments. \null is better than a space, since it doesn't
-% have any width.
-\def\lisppar{\null\endgraf}
-
-% This space is always present above and below environments.
-\newskip\envskipamount \envskipamount = 0pt
-
-% Make spacing and below environment symmetrical. We use \parskip here
-% to help in doing that, since in @example-like environments \parskip
-% is reset to zero; thus the \afterenvbreak inserts no space -- but the
-% start of the next paragraph will insert \parskip.
-%
-\def\aboveenvbreak{{%
- % =10000 instead of <10000 because of a special case in \itemzzz and
- % \sectionheading, q.v.
- \ifnum \lastpenalty=10000 \else
- \advance\envskipamount by \parskip
- \endgraf
- \ifdim\lastskip<\envskipamount
- \removelastskip
- % it's not a good place to break if the last penalty was \nobreak
- % or better ...
- \ifnum\lastpenalty<10000 \penalty-50 \fi
- \vskip\envskipamount
- \fi
- \fi
-}}
-
-\let\afterenvbreak = \aboveenvbreak
-
-% \nonarrowing is a flag. If "set", @lisp etc don't narrow margins; it will
-% also clear it, so that its embedded environments do the narrowing again.
-\let\nonarrowing=\relax
-
-% @cartouche ... @end cartouche: draw rectangle w/rounded corners around
-% environment contents.
-\font\circle=lcircle10
-\newdimen\circthick
-\newdimen\cartouter\newdimen\cartinner
-\newskip\normbskip\newskip\normpskip\newskip\normlskip
-\circthick=\fontdimen8\circle
-%
-\def\ctl{{\circle\char'013\hskip -6pt}}% 6pt from pl file: 1/2charwidth
-\def\ctr{{\hskip 6pt\circle\char'010}}
-\def\cbl{{\circle\char'012\hskip -6pt}}
-\def\cbr{{\hskip 6pt\circle\char'011}}
-\def\carttop{\hbox to \cartouter{\hskip\lskip
- \ctl\leaders\hrule height\circthick\hfil\ctr
- \hskip\rskip}}
-\def\cartbot{\hbox to \cartouter{\hskip\lskip
- \cbl\leaders\hrule height\circthick\hfil\cbr
- \hskip\rskip}}
-%
-\newskip\lskip\newskip\rskip
-
-\envdef\cartouche{%
- \ifhmode\par\fi % can't be in the midst of a paragraph.
- \startsavinginserts
- \lskip=\leftskip \rskip=\rightskip
- \leftskip=0pt\rightskip=0pt % we want these *outside*.
- \cartinner=\hsize \advance\cartinner by-\lskip
- \advance\cartinner by-\rskip
- \cartouter=\hsize
- \advance\cartouter by 18.4pt % allow for 3pt kerns on either
- % side, and for 6pt waste from
- % each corner char, and rule thickness
- \normbskip=\baselineskip \normpskip=\parskip \normlskip=\lineskip
- % Flag to tell @lisp, etc., not to narrow margin.
- \let\nonarrowing = t%
- \vbox\bgroup
- \baselineskip=0pt\parskip=0pt\lineskip=0pt
- \carttop
- \hbox\bgroup
- \hskip\lskip
- \vrule\kern3pt
- \vbox\bgroup
- \kern3pt
- \hsize=\cartinner
- \baselineskip=\normbskip
- \lineskip=\normlskip
- \parskip=\normpskip
- \vskip -\parskip
- \comment % For explanation, see the end of \def\group.
-}
-\def\Ecartouche{%
- \ifhmode\par\fi
- \kern3pt
- \egroup
- \kern3pt\vrule
- \hskip\rskip
- \egroup
- \cartbot
- \egroup
- \checkinserts
-}
-
-
-% This macro is called at the beginning of all the @example variants,
-% inside a group.
-\def\nonfillstart{%
- \aboveenvbreak
- \hfuzz = 12pt % Don't be fussy
- \sepspaces % Make spaces be word-separators rather than space tokens.
- \let\par = \lisppar % don't ignore blank lines
- \obeylines % each line of input is a line of output
- \parskip = 0pt
- \parindent = 0pt
- \emergencystretch = 0pt % don't try to avoid overfull boxes
- \ifx\nonarrowing\relax
- \advance \leftskip by \lispnarrowing
- \exdentamount=\lispnarrowing
- \else
- \let\nonarrowing = \relax
- \fi
- \let\exdent=\nofillexdent
-}
-
-% If you want all examples etc. small: @set dispenvsize small.
-% If you want even small examples the full size: @set dispenvsize nosmall.
-% This affects the following displayed environments:
-% @example, @display, @format, @lisp
-%
-\def\smallword{small}
-\def\nosmallword{nosmall}
-\let\SETdispenvsize\relax
-\def\setnormaldispenv{%
- \ifx\SETdispenvsize\smallword
- \smallexamplefonts \rm
- \fi
-}
-\def\setsmalldispenv{%
- \ifx\SETdispenvsize\nosmallword
- \else
- \smallexamplefonts \rm
- \fi
-}
-
-% We often define two environments, @foo and @smallfoo.
-% Let's do it by one command:
-\def\makedispenv #1#2{
- \expandafter\envdef\csname#1\endcsname {\setnormaldispenv #2}
- \expandafter\envdef\csname small#1\endcsname {\setsmalldispenv #2}
- \expandafter\let\csname E#1\endcsname \afterenvbreak
- \expandafter\let\csname Esmall#1\endcsname \afterenvbreak
-}
-
-% Define two synonyms:
-\def\maketwodispenvs #1#2#3{
- \makedispenv{#1}{#3}
- \makedispenv{#2}{#3}
-}
-
-% @lisp: indented, narrowed, typewriter font; @example: same as @lisp.
-%
-% @smallexample and @smalllisp: use smaller fonts.
-% Originally contributed by Pavel@xerox.
-%
-\maketwodispenvs {lisp}{example}{%
- \nonfillstart
- \tt
- \let\kbdfont = \kbdexamplefont % Allow @kbd to do something special.
- \gobble % eat return
-}
-
-% @display/@smalldisplay: same as @lisp except keep current font.
-%
-\makedispenv {display}{%
- \nonfillstart
- \gobble
-}
-
-% @format/@smallformat: same as @display except don't narrow margins.
-%
-\makedispenv{format}{%
- \let\nonarrowing = t%
- \nonfillstart
- \gobble
-}
-
-% @flushleft: same as @format, but doesn't obey \SETdispenvsize.
-\envdef\flushleft{%
- \let\nonarrowing = t%
- \nonfillstart
- \gobble
-}
-\let\Eflushleft = \afterenvbreak
-
-% @flushright.
-%
-\envdef\flushright{%
- \let\nonarrowing = t%
- \nonfillstart
- \advance\leftskip by 0pt plus 1fill
- \gobble
-}
-\let\Eflushright = \afterenvbreak
-
-
-% @quotation does normal linebreaking (hence we can't use \nonfillstart)
-% and narrows the margins. We keep \parskip nonzero in general, since
-% we're doing normal filling. So, when using \aboveenvbreak and
-% \afterenvbreak, temporarily make \parskip 0.
-%
-\envdef\quotation{%
- {\parskip=0pt \aboveenvbreak}% because \aboveenvbreak inserts \parskip
- \parindent=0pt
- %
- % @cartouche defines \nonarrowing to inhibit narrowing at next level down.
- \ifx\nonarrowing\relax
- \advance\leftskip by \lispnarrowing
- \advance\rightskip by \lispnarrowing
- \exdentamount = \lispnarrowing
- \else
- \let\nonarrowing = \relax
- \fi
- \parsearg\quotationlabel
-}
-
-% We have retained a nonzero parskip for the environment, since we're
-% doing normal filling.
-%
-\def\Equotation{%
- \par
- \ifx\quotationauthor\undefined\else
- % indent a bit.
- \leftline{\kern 2\leftskip \sl ---\quotationauthor}%
- \fi
- {\parskip=0pt \afterenvbreak}%
-}
-
-% If we're given an argument, typeset it in bold with a colon after.
-\def\quotationlabel#1{%
- \def\temp{#1}%
- \ifx\temp\empty \else
- {\bf #1: }%
- \fi
-}
-
-
-% LaTeX-like @verbatim...@end verbatim and @verb{<char>...<char>}
-% If we want to allow any <char> as delimiter,
-% we need the curly braces so that makeinfo sees the @verb command, eg:
-% `@verbx...x' would look like the '@verbx' command. --janneke@gnu.org
-%
-% [Knuth]: Donald Ervin Knuth, 1996. The TeXbook.
-%
-% [Knuth] p.344; only we need to do the other characters Texinfo sets
-% active too. Otherwise, they get lost as the first character on a
-% verbatim line.
-\def\dospecials{%
- \do\ \do\\\do\{\do\}\do\$\do\&%
- \do\#\do\^\do\^^K\do\_\do\^^A\do\%\do\~%
- \do\<\do\>\do\|\do\@\do+\do\"%
-}
-%
-% [Knuth] p. 380
-\def\uncatcodespecials{%
- \def\do##1{\catcode`##1=\other}\dospecials}
-%
-% [Knuth] pp. 380,381,391
-% Disable Spanish ligatures ?` and !` of \tt font
-\begingroup
- \catcode`\`=\active\gdef`{\relax\lq}
-\endgroup
-%
-% Setup for the @verb command.
-%
-% Eight spaces for a tab
-\begingroup
- \catcode`\^^I=\active
- \gdef\tabeightspaces{\catcode`\^^I=\active\def^^I{\ \ \ \ \ \ \ \ }}
-\endgroup
-%
-\def\setupverb{%
- \tt % easiest (and conventionally used) font for verbatim
- \def\par{\leavevmode\endgraf}%
- \catcode`\`=\active
- \tabeightspaces
- % Respect line breaks,
- % print special symbols as themselves, and
- % make each space count
- % must do in this order:
- \obeylines \uncatcodespecials \sepspaces
-}
-
-% Setup for the @verbatim environment
-%
-% Real tab expansion
-\newdimen\tabw \setbox0=\hbox{\tt\space} \tabw=8\wd0 % tab amount
-%
-\def\starttabbox{\setbox0=\hbox\bgroup}
-\begingroup
- \catcode`\^^I=\active
- \gdef\tabexpand{%
- \catcode`\^^I=\active
- \def^^I{\leavevmode\egroup
- \dimen0=\wd0 % the width so far, or since the previous tab
- \divide\dimen0 by\tabw
- \multiply\dimen0 by\tabw % compute previous multiple of \tabw
- \advance\dimen0 by\tabw % advance to next multiple of \tabw
- \wd0=\dimen0 \box0 \starttabbox
- }%
- }
-\endgroup
-\def\setupverbatim{%
- \let\nonarrowing = t%
- \nonfillstart
- % Easiest (and conventionally used) font for verbatim
- \tt
- \def\par{\leavevmode\egroup\box0\endgraf}%
- \catcode`\`=\active
- \tabexpand
- % Respect line breaks,
- % print special symbols as themselves, and
- % make each space count
- % must do in this order:
- \obeylines \uncatcodespecials \sepspaces
- \everypar{\starttabbox}%
-}
-
-% Do the @verb magic: verbatim text is quoted by unique
-% delimiter characters. Before first delimiter expect a
-% right brace, after last delimiter expect closing brace:
-%
-% \def\doverb'{'<char>#1<char>'}'{#1}
-%
-% [Knuth] p. 382; only eat outer {}
-\begingroup
- \catcode`[=1\catcode`]=2\catcode`\{=\other\catcode`\}=\other
- \gdef\doverb{#1[\def\next##1#1}[##1\endgroup]\next]
-\endgroup
-%
-\def\verb{\begingroup\setupverb\doverb}
-%
-%
-% Do the @verbatim magic: define the macro \doverbatim so that
-% the (first) argument ends when '@end verbatim' is reached, ie:
-%
-% \def\doverbatim#1@end verbatim{#1}
-%
-% For Texinfo it's a lot easier than for LaTeX,
-% because texinfo's \verbatim doesn't stop at '\end{verbatim}':
-% we need not redefine '\', '{' and '}'.
-%
-% Inspired by LaTeX's verbatim command set [latex.ltx]
-%
-\begingroup
- \catcode`\ =\active
- \obeylines %
- % ignore everything up to the first ^^M, that's the newline at the end
- % of the @verbatim input line itself. Otherwise we get an extra blank
- % line in the output.
- \xdef\doverbatim#1^^M#2@end verbatim{#2\noexpand\end\gobble verbatim}%
- % We really want {...\end verbatim} in the body of the macro, but
- % without the active space; thus we have to use \xdef and \gobble.
-\endgroup
-%
-\envdef\verbatim{%
- \setupverbatim\doverbatim
-}
-\let\Everbatim = \afterenvbreak
-
-
-% @verbatiminclude FILE - insert text of file in verbatim environment.
-%
-\def\verbatiminclude{\parseargusing\filenamecatcodes\doverbatiminclude}
-%
-\def\doverbatiminclude#1{%
- {%
- \makevalueexpandable
- \setupverbatim
- \input #1
- \afterenvbreak
- }%
-}
-
-% @copying ... @end copying.
-% Save the text away for @insertcopying later.
-%
-% We save the uninterpreted tokens, rather than creating a box.
-% Saving the text in a box would be much easier, but then all the
-% typesetting commands (@smallbook, font changes, etc.) have to be done
-% beforehand -- and a) we want @copying to be done first in the source
-% file; b) letting users define the frontmatter in as flexible order as
-% possible is very desirable.
-%
-\def\copying{\checkenv{}\begingroup\scanargctxt\docopying}
-\def\docopying#1@end copying{\endgroup\def\copyingtext{#1}}
-%
-\def\insertcopying{%
- \begingroup
- \parindent = 0pt % paragraph indentation looks wrong on title page
- \scanexp\copyingtext
- \endgroup
-}
-
-\message{defuns,}
-% @defun etc.
-
-\newskip\defbodyindent \defbodyindent=.4in
-\newskip\defargsindent \defargsindent=50pt
-\newskip\deflastargmargin \deflastargmargin=18pt
-
-% Start the processing of @deffn:
-\def\startdefun{%
- \ifnum\lastpenalty<10000
- \medbreak
- \else
- % If there are two @def commands in a row, we'll have a \nobreak,
- % which is there to keep the function description together with its
- % header. But if there's nothing but headers, we need to allow a
- % break somewhere. Check specifically for penalty 10002, inserted
- % by \defargscommonending, instead of 10000, since the sectioning
- % commands also insert a nobreak penalty, and we don't want to allow
- % a break between a section heading and a defun.
- %
- \ifnum\lastpenalty=10002 \penalty2000 \fi
- %
- % Similarly, after a section heading, do not allow a break.
- % But do insert the glue.
- \medskip % preceded by discardable penalty, so not a breakpoint
- \fi
- %
- \parindent=0in
- \advance\leftskip by \defbodyindent
- \exdentamount=\defbodyindent
-}
-
-\def\dodefunx#1{%
- % First, check whether we are in the right environment:
- \checkenv#1%
- %
- % As above, allow line break if we have multiple x headers in a row.
- % It's not a great place, though.
- \ifnum\lastpenalty=10002 \penalty3000 \fi
- %
- % And now, it's time to reuse the body of the original defun:
- \expandafter\gobbledefun#1%
-}
-\def\gobbledefun#1\startdefun{}
-
-% \printdefunline \deffnheader{text}
-%
-\def\printdefunline#1#2{%
- \begingroup
- % call \deffnheader:
- #1#2 \endheader
- % common ending:
- \interlinepenalty = 10000
- \advance\rightskip by 0pt plus 1fil
- \endgraf
- \nobreak\vskip -\parskip
- \penalty 10002 % signal to \startdefun and \dodefunx
- % Some of the @defun-type tags do not enable magic parentheses,
- % rendering the following check redundant. But we don't optimize.
- \checkparencounts
- \endgroup
-}
-
-\def\Edefun{\endgraf\medbreak}
-
-% \makedefun{deffn} creates \deffn, \deffnx and \Edeffn;
-% the only thing remainnig is to define \deffnheader.
-%
-\def\makedefun#1{%
- \expandafter\let\csname E#1\endcsname = \Edefun
- \edef\temp{\noexpand\domakedefun
- \makecsname{#1}\makecsname{#1x}\makecsname{#1header}}%
- \temp
-}
-
-% \domakedefun \deffn \deffnx \deffnheader
-%
-% Define \deffn and \deffnx, without parameters.
-% \deffnheader has to be defined explicitly.
-%
-\def\domakedefun#1#2#3{%
- \envdef#1{%
- \startdefun
- \parseargusing\activeparens{\printdefunline#3}%
- }%
- \def#2{\dodefunx#1}%
- \def#3%
-}
-
-%%% Untyped functions:
-
-% @deffn category name args
-\makedefun{deffn}{\deffngeneral{}}
-
-% @deffn category class name args
-\makedefun{defop}#1 {\defopon{#1\ \putwordon}}
-
-% \defopon {category on}class name args
-\def\defopon#1#2 {\deffngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
-
-% \deffngeneral {subind}category name args
-%
-\def\deffngeneral#1#2 #3 #4\endheader{%
- % Remember that \dosubind{fn}{foo}{} is equivalent to \doind{fn}{foo}.
- \dosubind{fn}{\code{#3}}{#1}%
- \defname{#2}{}{#3}\magicamp\defunargs{#4\unskip}%
-}
-
-%%% Typed functions:
-
-% @deftypefn category type name args
-\makedefun{deftypefn}{\deftypefngeneral{}}
-
-% @deftypeop category class type name args
-\makedefun{deftypeop}#1 {\deftypeopon{#1\ \putwordon}}
-
-% \deftypeopon {category on}class type name args
-\def\deftypeopon#1#2 {\deftypefngeneral{\putwordon\ \code{#2}}{#1\ \code{#2}} }
-
-% \deftypefngeneral {subind}category type name args
-%
-\def\deftypefngeneral#1#2 #3 #4 #5\endheader{%
- \dosubind{fn}{\code{#4}}{#1}%
- \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
-}
-
-%%% Typed variables:
-
-% @deftypevr category type var args
-\makedefun{deftypevr}{\deftypecvgeneral{}}
-
-% @deftypecv category class type var args
-\makedefun{deftypecv}#1 {\deftypecvof{#1\ \putwordof}}
-
-% \deftypecvof {category of}class type var args
-\def\deftypecvof#1#2 {\deftypecvgeneral{\putwordof\ \code{#2}}{#1\ \code{#2}} }
-
-% \deftypecvgeneral {subind}category type var args
-%
-\def\deftypecvgeneral#1#2 #3 #4 #5\endheader{%
- \dosubind{vr}{\code{#4}}{#1}%
- \defname{#2}{#3}{#4}\defunargs{#5\unskip}%
-}
-
-%%% Untyped variables:
-
-% @defvr category var args
-\makedefun{defvr}#1 {\deftypevrheader{#1} {} }
-
-% @defcv category class var args
-\makedefun{defcv}#1 {\defcvof{#1\ \putwordof}}
-
-% \defcvof {category of}class var args
-\def\defcvof#1#2 {\deftypecvof{#1}#2 {} }
-
-%%% Type:
-% @deftp category name args
-\makedefun{deftp}#1 #2 #3\endheader{%
- \doind{tp}{\code{#2}}%
- \defname{#1}{}{#2}\defunargs{#3\unskip}%
-}
-
-% Remaining @defun-like shortcuts:
-\makedefun{defun}{\deffnheader{\putwordDeffunc} }
-\makedefun{defmac}{\deffnheader{\putwordDefmac} }
-\makedefun{defspec}{\deffnheader{\putwordDefspec} }
-\makedefun{deftypefun}{\deftypefnheader{\putwordDeffunc} }
-\makedefun{defvar}{\defvrheader{\putwordDefvar} }
-\makedefun{defopt}{\defvrheader{\putwordDefopt} }
-\makedefun{deftypevar}{\deftypevrheader{\putwordDefvar} }
-\makedefun{defmethod}{\defopon\putwordMethodon}
-\makedefun{deftypemethod}{\deftypeopon\putwordMethodon}
-\makedefun{defivar}{\defcvof\putwordInstanceVariableof}
-\makedefun{deftypeivar}{\deftypecvof\putwordInstanceVariableof}
-
-% \defname, which formats the name of the @def (not the args).
-% #1 is the category, such as "Function".
-% #2 is the return type, if any.
-% #3 is the function name.
-%
-% We are followed by (but not passed) the arguments, if any.
-%
-\def\defname#1#2#3{%
- % Get the values of \leftskip and \rightskip as they were outside the @def...
- \advance\leftskip by -\defbodyindent
- %
- % How we'll format the type name. Putting it in brackets helps
- % distinguish it from the body text that may end up on the next line
- % just below it.
- \def\temp{#1}%
- \setbox0=\hbox{\kern\deflastargmargin \ifx\temp\empty\else [\rm\temp]\fi}
- %
- % Figure out line sizes for the paragraph shape.
- % The first line needs space for \box0; but if \rightskip is nonzero,
- % we need only space for the part of \box0 which exceeds it:
- \dimen0=\hsize \advance\dimen0 by -\wd0 \advance\dimen0 by \rightskip
- % The continuations:
- \dimen2=\hsize \advance\dimen2 by -\defargsindent
- % (plain.tex says that \dimen1 should be used only as global.)
- \parshape 2 0in \dimen0 \defargsindent \dimen2
- %
- % Put the type name to the right margin.
- \noindent
- \hbox to 0pt{%
- \hfil\box0 \kern-\hsize
- % \hsize has to be shortened this way:
- \kern\leftskip
- % Intentionally do not respect \rightskip, since we need the space.
- }%
- %
- % Allow all lines to be underfull without complaint:
- \tolerance=10000 \hbadness=10000
- \exdentamount=\defbodyindent
- {%
- % defun fonts. We use typewriter by default (used to be bold) because:
- % . we're printing identifiers, they should be in tt in principle.
- % . in languages with many accents, such as Czech or French, it's
- % common to leave accents off identifiers. The result looks ok in
- % tt, but exceedingly strange in rm.
- % . we don't want -- and --- to be treated as ligatures.
- % . this still does not fix the ?` and !` ligatures, but so far no
- % one has made identifiers using them :).
- \df \tt
- \def\temp{#2}% return value type
- \ifx\temp\empty\else \tclose{\temp} \fi
- #3% output function name
- }%
- {\rm\enskip}% hskip 0.5 em of \tenrm
- %
- \boldbrax
- % arguments will be output next, if any.
-}
-
-% Print arguments in slanted roman (not ttsl), inconsistently with using
-% tt for the name. This is because literal text is sometimes needed in
-% the argument list (groff manual), and ttsl and tt are not very
-% distinguishable. Prevent hyphenation at `-' chars.
-%
-\def\defunargs#1{%
- % use sl by default (not ttsl),
- % tt for the names.
- \df \sl \hyphenchar\font=0
- %
- % On the other hand, if an argument has two dashes (for instance), we
- % want a way to get ttsl. Let's try @var for that.
- \let\var=\ttslanted
- #1%
- \sl\hyphenchar\font=45
-}
-
-% We want ()&[] to print specially on the defun line.
-%
-\def\activeparens{%
- \catcode`\(=\active \catcode`\)=\active
- \catcode`\[=\active \catcode`\]=\active
- \catcode`\&=\active
-}
-
-% Make control sequences which act like normal parenthesis chars.
-\let\lparen = ( \let\rparen = )
-
-% Be sure that we always have a definition for `(', etc. For example,
-% if the fn name has parens in it, \boldbrax will not be in effect yet,
-% so TeX would otherwise complain about undefined control sequence.
-{
- \activeparens
- \global\let(=\lparen \global\let)=\rparen
- \global\let[=\lbrack \global\let]=\rbrack
- \global\let& = \&
-
- \gdef\boldbrax{\let(=\opnr\let)=\clnr\let[=\lbrb\let]=\rbrb}
- \gdef\magicamp{\let&=\amprm}
-}
-
-\newcount\parencount
-
-% If we encounter &foo, then turn on ()-hacking afterwards
-\newif\ifampseen
-\def\amprm#1 {\ampseentrue{\bf\ }}
-
-\def\parenfont{%
- \ifampseen
- % At the first level, print parens in roman,
- % otherwise use the default font.
- \ifnum \parencount=1 \rm \fi
- \else
- % The \sf parens (in \boldbrax) actually are a little bolder than
- % the contained text. This is especially needed for [ and ] .
- \sf
- \fi
-}
-\def\infirstlevel#1{%
- \ifampseen
- \ifnum\parencount=1
- #1%
- \fi
- \fi
-}
-\def\bfafterword#1 {#1 \bf}
-
-\def\opnr{%
- \global\advance\parencount by 1
- {\parenfont(}%
- \infirstlevel \bfafterword
-}
-\def\clnr{%
- {\parenfont)}%
- \infirstlevel \sl
- \global\advance\parencount by -1
-}
-
-\newcount\brackcount
-\def\lbrb{%
- \global\advance\brackcount by 1
- {\bf[}%
-}
-\def\rbrb{%
- {\bf]}%
- \global\advance\brackcount by -1
-}
-
-\def\checkparencounts{%
- \ifnum\parencount=0 \else \badparencount \fi
- \ifnum\brackcount=0 \else \badbrackcount \fi
-}
-\def\badparencount{%
- \errmessage{Unbalanced parentheses in @def}%
- \global\parencount=0
-}
-\def\badbrackcount{%
- \errmessage{Unbalanced square braces in @def}%
- \global\brackcount=0
-}
-
-
-\message{macros,}
-% @macro.
-
-% To do this right we need a feature of e-TeX, \scantokens,
-% which we arrange to emulate with a temporary file in ordinary TeX.
-\ifx\eTeXversion\undefined
- \newwrite\macscribble
- \def\scantokens#1{%
- \toks0={#1}%
- \immediate\openout\macscribble=\jobname.tmp
- \immediate\write\macscribble{\the\toks0}%
- \immediate\closeout\macscribble
- \input \jobname.tmp
- }
-\fi
-
-\def\scanmacro#1{%
- \begingroup
- \newlinechar`\^^M
- \let\xeatspaces\eatspaces
- % Undo catcode changes of \startcontents and \doprintindex
- % When called from @insertcopying or (short)caption, we need active
- % backslash to get it printed correctly. Previously, we had
- % \catcode`\\=\other instead. We'll see whether a problem appears
- % with macro expansion. --kasal, 19aug04
- \catcode`\@=0 \catcode`\\=\active \escapechar=`\@
- % ... and \example
- \spaceisspace
- %
- % Append \endinput to make sure that TeX does not see the ending newline.
- %
- % I've verified that it is necessary both for e-TeX and for ordinary TeX
- % --kasal, 29nov03
- \scantokens{#1\endinput}%
- \endgroup
-}
-
-\def\scanexp#1{%
- \edef\temp{\noexpand\scanmacro{#1}}%
- \temp
-}
-
-\newcount\paramno % Count of parameters
-\newtoks\macname % Macro name
-\newif\ifrecursive % Is it recursive?
-
-% List of all defined macros in the form
-% \definedummyword\macro1\definedummyword\macro2...
-% Currently is also contains all @aliases; the list can be split
-% if there is a need.
-\def\macrolist{}
-
-% Add the macro to \macrolist
-\def\addtomacrolist#1{\expandafter \addtomacrolistxxx \csname#1\endcsname}
-\def\addtomacrolistxxx#1{%
- \toks0 = \expandafter{\macrolist\definedummyword#1}%
- \xdef\macrolist{\the\toks0}%
-}
-
-% Utility routines.
-% This does \let #1 = #2, with \csnames; that is,
-% \let \csname#1\endcsname = \csname#2\endcsname
-% (except of course we have to play expansion games).
-%
-\def\cslet#1#2{%
- \expandafter\let
- \csname#1\expandafter\endcsname
- \csname#2\endcsname
-}
-
-% Trim leading and trailing spaces off a string.
-% Concepts from aro-bend problem 15 (see CTAN).
-{\catcode`\@=11
-\gdef\eatspaces #1{\expandafter\trim@\expandafter{#1 }}
-\gdef\trim@ #1{\trim@@ @#1 @ #1 @ @@}
-\gdef\trim@@ #1@ #2@ #3@@{\trim@@@\empty #2 @}
-\def\unbrace#1{#1}
-\unbrace{\gdef\trim@@@ #1 } #2@{#1}
-}
-
-% Trim a single trailing ^^M off a string.
-{\catcode`\^^M=\other \catcode`\Q=3%
-\gdef\eatcr #1{\eatcra #1Q^^MQ}%
-\gdef\eatcra#1^^MQ{\eatcrb#1Q}%
-\gdef\eatcrb#1Q#2Q{#1}%
-}
-
-% Macro bodies are absorbed as an argument in a context where
-% all characters are catcode 10, 11 or 12, except \ which is active
-% (as in normal texinfo). It is necessary to change the definition of \.
-
-% It's necessary to have hard CRs when the macro is executed. This is
-% done by making ^^M (\endlinechar) catcode 12 when reading the macro
-% body, and then making it the \newlinechar in \scanmacro.
-
-\def\scanctxt{%
- \catcode`\"=\other
- \catcode`\+=\other
- \catcode`\<=\other
- \catcode`\>=\other
- \catcode`\@=\other
- \catcode`\^=\other
- \catcode`\_=\other
- \catcode`\|=\other
- \catcode`\~=\other
-}
-
-\def\scanargctxt{%
- \scanctxt
- \catcode`\\=\other
- \catcode`\^^M=\other
-}
-
-\def\macrobodyctxt{%
- \scanctxt
- \catcode`\{=\other
- \catcode`\}=\other
- \catcode`\^^M=\other
- \usembodybackslash
-}
-
-\def\macroargctxt{%
- \scanctxt
- \catcode`\\=\other
-}
-
-% \mbodybackslash is the definition of \ in @macro bodies.
-% It maps \foo\ => \csname macarg.foo\endcsname => #N
-% where N is the macro parameter number.
-% We define \csname macarg.\endcsname to be \realbackslash, so
-% \\ in macro replacement text gets you a backslash.
-
-{\catcode`@=0 @catcode`@\=@active
- @gdef@usembodybackslash{@let\=@mbodybackslash}
- @gdef@mbodybackslash#1\{@csname macarg.#1@endcsname}
-}
-\expandafter\def\csname macarg.\endcsname{\realbackslash}
-
-\def\macro{\recursivefalse\parsearg\macroxxx}
-\def\rmacro{\recursivetrue\parsearg\macroxxx}
-
-\def\macroxxx#1{%
- \getargs{#1}% now \macname is the macname and \argl the arglist
- \ifx\argl\empty % no arguments
- \paramno=0%
- \else
- \expandafter\parsemargdef \argl;%
- \fi
- \if1\csname ismacro.\the\macname\endcsname
- \message{Warning: redefining \the\macname}%
- \else
- \expandafter\ifx\csname \the\macname\endcsname \relax
- \else \errmessage{Macro name \the\macname\space already defined}\fi
- \global\cslet{macsave.\the\macname}{\the\macname}%
- \global\expandafter\let\csname ismacro.\the\macname\endcsname=1%
- \addtomacrolist{\the\macname}%
- \fi
- \begingroup \macrobodyctxt
- \ifrecursive \expandafter\parsermacbody
- \else \expandafter\parsemacbody
- \fi}
-
-\parseargdef\unmacro{%
- \if1\csname ismacro.#1\endcsname
- \global\cslet{#1}{macsave.#1}%
- \global\expandafter\let \csname ismacro.#1\endcsname=0%
- % Remove the macro name from \macrolist:
- \begingroup
- \expandafter\let\csname#1\endcsname \relax
- \let\definedummyword\unmacrodo
- \xdef\macrolist{\macrolist}%
- \endgroup
- \else
- \errmessage{Macro #1 not defined}%
- \fi
-}
-
-% Called by \do from \dounmacro on each macro. The idea is to omit any
-% macro definitions that have been changed to \relax.
-%
-\def\unmacrodo#1{%
- \ifx #1\relax
- % remove this
- \else
- \noexpand\definedummyword \noexpand#1%
- \fi
-}
-
-% This makes use of the obscure feature that if the last token of a
-% <parameter list> is #, then the preceding argument is delimited by
-% an opening brace, and that opening brace is not consumed.
-\def\getargs#1{\getargsxxx#1{}}
-\def\getargsxxx#1#{\getmacname #1 \relax\getmacargs}
-\def\getmacname #1 #2\relax{\macname={#1}}
-\def\getmacargs#1{\def\argl{#1}}
-
-% Parse the optional {params} list. Set up \paramno and \paramlist
-% so \defmacro knows what to do. Define \macarg.blah for each blah
-% in the params list, to be ##N where N is the position in that list.
-% That gets used by \mbodybackslash (above).
-
-% We need to get `macro parameter char #' into several definitions.
-% The technique used is stolen from LaTeX: let \hash be something
-% unexpandable, insert that wherever you need a #, and then redefine
-% it to # just before using the token list produced.
-%
-% The same technique is used to protect \eatspaces till just before
-% the macro is used.
-
-\def\parsemargdef#1;{\paramno=0\def\paramlist{}%
- \let\hash\relax\let\xeatspaces\relax\parsemargdefxxx#1,;,}
-\def\parsemargdefxxx#1,{%
- \if#1;\let\next=\relax
- \else \let\next=\parsemargdefxxx
- \advance\paramno by 1%
- \expandafter\edef\csname macarg.\eatspaces{#1}\endcsname
- {\xeatspaces{\hash\the\paramno}}%
- \edef\paramlist{\paramlist\hash\the\paramno,}%
- \fi\next}
-
-% These two commands read recursive and nonrecursive macro bodies.
-% (They're different since rec and nonrec macros end differently.)
-
-\long\def\parsemacbody#1@end macro%
-{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
-\long\def\parsermacbody#1@end rmacro%
-{\xdef\temp{\eatcr{#1}}\endgroup\defmacro}%
-
-% This defines the macro itself. There are six cases: recursive and
-% nonrecursive macros of zero, one, and many arguments.
-% Much magic with \expandafter here.
-% \xdef is used so that macro definitions will survive the file
-% they're defined in; @include reads the file inside a group.
-\def\defmacro{%
- \let\hash=##% convert placeholders to macro parameter chars
- \ifrecursive
- \ifcase\paramno
- % 0
- \expandafter\xdef\csname\the\macname\endcsname{%
- \noexpand\scanmacro{\temp}}%
- \or % 1
- \expandafter\xdef\csname\the\macname\endcsname{%
- \bgroup\noexpand\macroargctxt
- \noexpand\braceorline
- \expandafter\noexpand\csname\the\macname xxx\endcsname}%
- \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
- \egroup\noexpand\scanmacro{\temp}}%
- \else % many
- \expandafter\xdef\csname\the\macname\endcsname{%
- \bgroup\noexpand\macroargctxt
- \noexpand\csname\the\macname xx\endcsname}%
- \expandafter\xdef\csname\the\macname xx\endcsname##1{%
- \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
- \expandafter\expandafter
- \expandafter\xdef
- \expandafter\expandafter
- \csname\the\macname xxx\endcsname
- \paramlist{\egroup\noexpand\scanmacro{\temp}}%
- \fi
- \else
- \ifcase\paramno
- % 0
- \expandafter\xdef\csname\the\macname\endcsname{%
- \noexpand\norecurse{\the\macname}%
- \noexpand\scanmacro{\temp}\egroup}%
- \or % 1
- \expandafter\xdef\csname\the\macname\endcsname{%
- \bgroup\noexpand\macroargctxt
- \noexpand\braceorline
- \expandafter\noexpand\csname\the\macname xxx\endcsname}%
- \expandafter\xdef\csname\the\macname xxx\endcsname##1{%
- \egroup
- \noexpand\norecurse{\the\macname}%
- \noexpand\scanmacro{\temp}\egroup}%
- \else % many
- \expandafter\xdef\csname\the\macname\endcsname{%
- \bgroup\noexpand\macroargctxt
- \expandafter\noexpand\csname\the\macname xx\endcsname}%
- \expandafter\xdef\csname\the\macname xx\endcsname##1{%
- \expandafter\noexpand\csname\the\macname xxx\endcsname ##1,}%
- \expandafter\expandafter
- \expandafter\xdef
- \expandafter\expandafter
- \csname\the\macname xxx\endcsname
- \paramlist{%
- \egroup
- \noexpand\norecurse{\the\macname}%
- \noexpand\scanmacro{\temp}\egroup}%
- \fi
- \fi}
-
-\def\norecurse#1{\bgroup\cslet{#1}{macsave.#1}}
-
-% \braceorline decides whether the next nonwhitespace character is a
-% {. If so it reads up to the closing }, if not, it reads the whole
-% line. Whatever was read is then fed to the next control sequence
-% as an argument (by \parsebrace or \parsearg)
-\def\braceorline#1{\let\next=#1\futurelet\nchar\braceorlinexxx}
-\def\braceorlinexxx{%
- \ifx\nchar\bgroup\else
- \expandafter\parsearg
- \fi \next}
-
-
-% @alias.
-% We need some trickery to remove the optional spaces around the equal
-% sign. Just make them active and then expand them all to nothing.
-\def\alias{\parseargusing\obeyspaces\aliasxxx}
-\def\aliasxxx #1{\aliasyyy#1\relax}
-\def\aliasyyy #1=#2\relax{%
- {%
- \expandafter\let\obeyedspace=\empty
- \addtomacrolist{#1}%
- \xdef\next{\global\let\makecsname{#1}=\makecsname{#2}}%
- }%
- \next
-}
-
-
-\message{cross references,}
-
-\newwrite\auxfile
-
-\newif\ifhavexrefs % True if xref values are known.
-\newif\ifwarnedxrefs % True if we warned once that they aren't known.
-
-% @inforef is relatively simple.
-\def\inforef #1{\inforefzzz #1,,,,**}
-\def\inforefzzz #1,#2,#3,#4**{\putwordSee{} \putwordInfo{} \putwordfile{} \file{\ignorespaces #3{}},
- node \samp{\ignorespaces#1{}}}
-
-% @node's only job in TeX is to define \lastnode, which is used in
-% cross-references. The @node line might or might not have commas, and
-% might or might not have spaces before the first comma, like:
-% @node foo , bar , ...
-% We don't want such trailing spaces in the node name.
-%
-\parseargdef\node{\checkenv{}\donode #1 ,\finishnodeparse}
-%
-% also remove a trailing comma, in case of something like this:
-% @node Help-Cross, , , Cross-refs
-\def\donode#1 ,#2\finishnodeparse{\dodonode #1,\finishnodeparse}
-\def\dodonode#1,#2\finishnodeparse{\gdef\lastnode{#1}}
-
-\let\nwnode=\node
-\let\lastnode=\empty
-
-% Write a cross-reference definition for the current node. #1 is the
-% type (Ynumbered, Yappendix, Ynothing).
-%
-\def\donoderef#1{%
- \ifx\lastnode\empty\else
- \setref{\lastnode}{#1}%
- \global\let\lastnode=\empty
- \fi
-}
-
-% @anchor{NAME} -- define xref target at arbitrary point.
-%
-\newcount\savesfregister
-%
-\def\savesf{\relax \ifhmode \savesfregister=\spacefactor \fi}
-\def\restoresf{\relax \ifhmode \spacefactor=\savesfregister \fi}
-\def\anchor#1{\savesf \setref{#1}{Ynothing}\restoresf \ignorespaces}
-
-% \setref{NAME}{SNT} defines a cross-reference point NAME (a node or an
-% anchor), which consists of three parts:
-% 1) NAME-title - the current sectioning name taken from \thissection,
-% or the anchor name.
-% 2) NAME-snt - section number and type, passed as the SNT arg, or
-% empty for anchors.
-% 3) NAME-pg - the page number.
-%
-% This is called from \donoderef, \anchor, and \dofloat. In the case of
-% floats, there is an additional part, which is not written here:
-% 4) NAME-lof - the text as it should appear in a @listoffloats.
-%
-\def\setref#1#2{%
- \pdfmkdest{#1}%
- \iflinks
- {%
- \atdummies % preserve commands, but don't expand them
- \edef\writexrdef##1##2{%
- \write\auxfile{@xrdef{#1-% #1 of \setref, expanded by the \edef
- ##1}{##2}}% these are parameters of \writexrdef
- }%
- \toks0 = \expandafter{\thissection}%
- \immediate \writexrdef{title}{\the\toks0 }%
- \immediate \writexrdef{snt}{\csname #2\endcsname}% \Ynumbered etc.
- \writexrdef{pg}{\folio}% will be written later, during \shipout
- }%
- \fi
-}
-
-% @xref, @pxref, and @ref generate cross-references. For \xrefX, #1 is
-% the node name, #2 the name of the Info cross-reference, #3 the printed
-% node name, #4 the name of the Info file, #5 the name of the printed
-% manual. All but the node name can be omitted.
-%
-\def\pxref#1{\putwordsee{} \xrefX[#1,,,,,,,]}
-\def\xref#1{\putwordSee{} \xrefX[#1,,,,,,,]}
-\def\ref#1{\xrefX[#1,,,,,,,]}
-\def\xrefX[#1,#2,#3,#4,#5,#6]{\begingroup
- \unsepspaces
- \def\printedmanual{\ignorespaces #5}%
- \def\printedrefname{\ignorespaces #3}%
- \setbox1=\hbox{\printedmanual\unskip}%
- \setbox0=\hbox{\printedrefname\unskip}%
- \ifdim \wd0 = 0pt
- % No printed node name was explicitly given.
- \expandafter\ifx\csname SETxref-automatic-section-title\endcsname\relax
- % Use the node name inside the square brackets.
- \def\printedrefname{\ignorespaces #1}%
- \else
- % Use the actual chapter/section title appear inside
- % the square brackets. Use the real section title if we have it.
- \ifdim \wd1 > 0pt
- % It is in another manual, so we don't have it.
- \def\printedrefname{\ignorespaces #1}%
- \else
- \ifhavexrefs
- % We know the real title if we have the xref values.
- \def\printedrefname{\refx{#1-title}{}}%
- \else
- % Otherwise just copy the Info node name.
- \def\printedrefname{\ignorespaces #1}%
- \fi%
- \fi
- \fi
- \fi
- %
- % Make link in pdf output.
- \ifpdf
- \leavevmode
- \getfilename{#4}%
- {\turnoffactive
- % See comments at \activebackslashdouble.
- {\activebackslashdouble \xdef\pdfxrefdest{#1}%
- \backslashparens\pdfxrefdest}%
- %
- \ifnum\filenamelength>0
- \startlink attr{/Border [0 0 0]}%
- goto file{\the\filename.pdf} name{\pdfxrefdest}%
- \else
- \startlink attr{/Border [0 0 0]}%
- goto name{\pdfmkpgn{\pdfxrefdest}}%
- \fi
- }%
- \linkcolor
- \fi
- %
- % Float references are printed completely differently: "Figure 1.2"
- % instead of "[somenode], p.3". We distinguish them by the
- % LABEL-title being set to a magic string.
- {%
- % Have to otherify everything special to allow the \csname to
- % include an _ in the xref name, etc.
- \indexnofonts
- \turnoffactive
- \expandafter\global\expandafter\let\expandafter\Xthisreftitle
- \csname XR#1-title\endcsname
- }%
- \iffloat\Xthisreftitle
- % If the user specified the print name (third arg) to the ref,
- % print it instead of our usual "Figure 1.2".
- \ifdim\wd0 = 0pt
- \refx{#1-snt}%
- \else
- \printedrefname
- \fi
- %
- % if the user also gave the printed manual name (fifth arg), append
- % "in MANUALNAME".
- \ifdim \wd1 > 0pt
- \space \putwordin{} \cite{\printedmanual}%
- \fi
- \else
- % node/anchor (non-float) references.
- %
- % If we use \unhbox0 and \unhbox1 to print the node names, TeX does not
- % insert empty discretionaries after hyphens, which means that it will
- % not find a line break at a hyphen in a node names. Since some manuals
- % are best written with fairly long node names, containing hyphens, this
- % is a loss. Therefore, we give the text of the node name again, so it
- % is as if TeX is seeing it for the first time.
- \ifdim \wd1 > 0pt
- \putwordsection{} ``\printedrefname'' \putwordin{} \cite{\printedmanual}%
- \else
- % _ (for example) has to be the character _ for the purposes of the
- % control sequence corresponding to the node, but it has to expand
- % into the usual \leavevmode...\vrule stuff for purposes of
- % printing. So we \turnoffactive for the \refx-snt, back on for the
- % printing, back off for the \refx-pg.
- {\turnoffactive
- % Only output a following space if the -snt ref is nonempty; for
- % @unnumbered and @anchor, it won't be.
- \setbox2 = \hbox{\ignorespaces \refx{#1-snt}{}}%
- \ifdim \wd2 > 0pt \refx{#1-snt}\space\fi
- }%
- % output the `[mynode]' via a macro so it can be overridden.
- \xrefprintnodename\printedrefname
- %
- % But we always want a comma and a space:
- ,\space
- %
- % output the `page 3'.
- \turnoffactive \putwordpage\tie\refx{#1-pg}{}%
- \fi
- \fi
- \endlink
-\endgroup}
-
-% This macro is called from \xrefX for the `[nodename]' part of xref
-% output. It's a separate macro only so it can be changed more easily,
-% since square brackets don't work well in some documents. Particularly
-% one that Bob is working on :).
-%
-\def\xrefprintnodename#1{[#1]}
-
-% Things referred to by \setref.
-%
-\def\Ynothing{}
-\def\Yomitfromtoc{}
-\def\Ynumbered{%
- \ifnum\secno=0
- \putwordChapter@tie \the\chapno
- \else \ifnum\subsecno=0
- \putwordSection@tie \the\chapno.\the\secno
- \else \ifnum\subsubsecno=0
- \putwordSection@tie \the\chapno.\the\secno.\the\subsecno
- \else
- \putwordSection@tie \the\chapno.\the\secno.\the\subsecno.\the\subsubsecno
- \fi\fi\fi
-}
-\def\Yappendix{%
- \ifnum\secno=0
- \putwordAppendix@tie @char\the\appendixno{}%
- \else \ifnum\subsecno=0
- \putwordSection@tie @char\the\appendixno.\the\secno
- \else \ifnum\subsubsecno=0
- \putwordSection@tie @char\the\appendixno.\the\secno.\the\subsecno
- \else
- \putwordSection@tie
- @char\the\appendixno.\the\secno.\the\subsecno.\the\subsubsecno
- \fi\fi\fi
-}
-
-% Define \refx{NAME}{SUFFIX} to reference a cross-reference string named NAME.
-% If its value is nonempty, SUFFIX is output afterward.
-%
-\def\refx#1#2{%
- {%
- \indexnofonts
- \otherbackslash
- \expandafter\global\expandafter\let\expandafter\thisrefX
- \csname XR#1\endcsname
- }%
- \ifx\thisrefX\relax
- % If not defined, say something at least.
- \angleleft un\-de\-fined\angleright
- \iflinks
- \ifhavexrefs
- \message{\linenumber Undefined cross reference `#1'.}%
- \else
- \ifwarnedxrefs\else
- \global\warnedxrefstrue
- \message{Cross reference values unknown; you must run TeX again.}%
- \fi
- \fi
- \fi
- \else
- % It's defined, so just use it.
- \thisrefX
- \fi
- #2% Output the suffix in any case.
-}
-
-% This is the macro invoked by entries in the aux file. Usually it's
-% just a \def (we prepend XR to the control sequence name to avoid
-% collisions). But if this is a float type, we have more work to do.
-%
-\def\xrdef#1#2{%
- \expandafter\gdef\csname XR#1\endcsname{#2}% remember this xref value.
- %
- % Was that xref control sequence that we just defined for a float?
- \expandafter\iffloat\csname XR#1\endcsname
- % it was a float, and we have the (safe) float type in \iffloattype.
- \expandafter\let\expandafter\floatlist
- \csname floatlist\iffloattype\endcsname
- %
- % Is this the first time we've seen this float type?
- \expandafter\ifx\floatlist\relax
- \toks0 = {\do}% yes, so just \do
- \else
- % had it before, so preserve previous elements in list.
- \toks0 = \expandafter{\floatlist\do}%
- \fi
- %
- % Remember this xref in the control sequence \floatlistFLOATTYPE,
- % for later use in \listoffloats.
- \expandafter\xdef\csname floatlist\iffloattype\endcsname{\the\toks0{#1}}%
- \fi
-}
-
-% Read the last existing aux file, if any. No error if none exists.
-%
-\def\tryauxfile{%
- \openin 1 \jobname.aux
- \ifeof 1 \else
- \readdatafile{aux}%
- \global\havexrefstrue
- \fi
- \closein 1
-}
-
-\def\setupdatafile{%
- \catcode`\^^@=\other
- \catcode`\^^A=\other
- \catcode`\^^B=\other
- \catcode`\^^C=\other
- \catcode`\^^D=\other
- \catcode`\^^E=\other
- \catcode`\^^F=\other
- \catcode`\^^G=\other
- \catcode`\^^H=\other
- \catcode`\^^K=\other
- \catcode`\^^L=\other
- \catcode`\^^N=\other
- \catcode`\^^P=\other
- \catcode`\^^Q=\other
- \catcode`\^^R=\other
- \catcode`\^^S=\other
- \catcode`\^^T=\other
- \catcode`\^^U=\other
- \catcode`\^^V=\other
- \catcode`\^^W=\other
- \catcode`\^^X=\other
- \catcode`\^^Z=\other
- \catcode`\^^[=\other
- \catcode`\^^\=\other
- \catcode`\^^]=\other
- \catcode`\^^^=\other
- \catcode`\^^_=\other
- % It was suggested to set the catcode of ^ to 7, which would allow ^^e4 etc.
- % in xref tags, i.e., node names. But since ^^e4 notation isn't
- % supported in the main text, it doesn't seem desirable. Furthermore,
- % that is not enough: for node names that actually contain a ^
- % character, we would end up writing a line like this: 'xrdef {'hat
- % b-title}{'hat b} and \xrdef does a \csname...\endcsname on the first
- % argument, and \hat is not an expandable control sequence. It could
- % all be worked out, but why? Either we support ^^ or we don't.
- %
- % The other change necessary for this was to define \auxhat:
- % \def\auxhat{\def^{'hat }}% extra space so ok if followed by letter
- % and then to call \auxhat in \setq.
- %
- \catcode`\^=\other
- %
- % Special characters. Should be turned off anyway, but...
- \catcode`\~=\other
- \catcode`\[=\other
- \catcode`\]=\other
- \catcode`\"=\other
- \catcode`\_=\other
- \catcode`\|=\other
- \catcode`\<=\other
- \catcode`\>=\other
- \catcode`\$=\other
- \catcode`\#=\other
- \catcode`\&=\other
- \catcode`\%=\other
- \catcode`+=\other % avoid \+ for paranoia even though we've turned it off
- %
- % This is to support \ in node names and titles, since the \
- % characters end up in a \csname. It's easier than
- % leaving it active and making its active definition an actual \
- % character. What I don't understand is why it works in the *value*
- % of the xrdef. Seems like it should be a catcode12 \, and that
- % should not typeset properly. But it works, so I'm moving on for
- % now. --karl, 15jan04.
- \catcode`\\=\other
- %
- % Make the characters 128-255 be printing characters.
- {%
- \count1=128
- \def\loop{%
- \catcode\count1=\other
- \advance\count1 by 1
- \ifnum \count1<256 \loop \fi
- }%
- }%
- %
- % @ is our escape character in .aux files, and we need braces.
- \catcode`\{=1
- \catcode`\}=2
- \catcode`\@=0
-}
-
-\def\readdatafile#1{%
-\begingroup
- \setupdatafile
- \input\jobname.#1
-\endgroup}
-
-\message{insertions,}
-% including footnotes.
-
-\newcount \footnoteno
-
-% The trailing space in the following definition for supereject is
-% vital for proper filling; pages come out unaligned when you do a
-% pagealignmacro call if that space before the closing brace is
-% removed. (Generally, numeric constants should always be followed by a
-% space to prevent strange expansion errors.)
-\def\supereject{\par\penalty -20000\footnoteno =0 }
-
-% @footnotestyle is meaningful for info output only.
-\let\footnotestyle=\comment
-
-{\catcode `\@=11
-%
-% Auto-number footnotes. Otherwise like plain.
-\gdef\footnote{%
- \let\indent=\ptexindent
- \let\noindent=\ptexnoindent
- \global\advance\footnoteno by \@ne
- \edef\thisfootno{$^{\the\footnoteno}$}%
- %
- % In case the footnote comes at the end of a sentence, preserve the
- % extra spacing after we do the footnote number.
- \let\@sf\empty
- \ifhmode\edef\@sf{\spacefactor\the\spacefactor}\ptexslash\fi
- %
- % Remove inadvertent blank space before typesetting the footnote number.
- \unskip
- \thisfootno\@sf
- \dofootnote
-}%
-
-% Don't bother with the trickery in plain.tex to not require the
-% footnote text as a parameter. Our footnotes don't need to be so general.
-%
-% Oh yes, they do; otherwise, @ifset (and anything else that uses
-% \parseargline) fails inside footnotes because the tokens are fixed when
-% the footnote is read. --karl, 16nov96.
-%
-\gdef\dofootnote{%
- \insert\footins\bgroup
- % We want to typeset this text as a normal paragraph, even if the
- % footnote reference occurs in (for example) a display environment.
- % So reset some parameters.
- \hsize=\pagewidth
- \interlinepenalty\interfootnotelinepenalty
- \splittopskip\ht\strutbox % top baseline for broken footnotes
- \splitmaxdepth\dp\strutbox
- \floatingpenalty\@MM
- \leftskip\z@skip
- \rightskip\z@skip
- \spaceskip\z@skip
- \xspaceskip\z@skip
- \parindent\defaultparindent
- %
- \smallfonts \rm
- %
- % Because we use hanging indentation in footnotes, a @noindent appears
- % to exdent this text, so make it be a no-op. makeinfo does not use
- % hanging indentation so @noindent can still be needed within footnote
- % text after an @example or the like (not that this is good style).
- \let\noindent = \relax
- %
- % Hang the footnote text off the number. Use \everypar in case the
- % footnote extends for more than one paragraph.
- \everypar = {\hang}%
- \textindent{\thisfootno}%
- %
- % Don't crash into the line above the footnote text. Since this
- % expands into a box, it must come within the paragraph, lest it
- % provide a place where TeX can split the footnote.
- \footstrut
- \futurelet\next\fo@t
-}
-}%end \catcode `\@=11
-
-% In case a @footnote appears in a vbox, save the footnote text and create
-% the real \insert just after the vbox finished. Otherwise, the insertion
-% would be lost.
-% Similarily, if a @footnote appears inside an alignment, save the footnote
-% text to a box and make the \insert when a row of the table is finished.
-% And the same can be done for other insert classes. --kasal, 16nov03.
-
-% Replace the \insert primitive by a cheating macro.
-% Deeper inside, just make sure that the saved insertions are not spilled
-% out prematurely.
-%
-\def\startsavinginserts{%
- \ifx \insert\ptexinsert
- \let\insert\saveinsert
- \else
- \let\checkinserts\relax
- \fi
-}
-
-% This \insert replacement works for both \insert\footins{foo} and
-% \insert\footins\bgroup foo\egroup, but it doesn't work for \insert27{foo}.
-%
-\def\saveinsert#1{%
- \edef\next{\noexpand\savetobox \makeSAVEname#1}%
- \afterassignment\next
- % swallow the left brace
- \let\temp =
-}
-\def\makeSAVEname#1{\makecsname{SAVE\expandafter\gobble\string#1}}
-\def\savetobox#1{\global\setbox#1 = \vbox\bgroup \unvbox#1}
-
-\def\checksaveins#1{\ifvoid#1\else \placesaveins#1\fi}
-
-\def\placesaveins#1{%
- \ptexinsert \csname\expandafter\gobblesave\string#1\endcsname
- {\box#1}%
-}
-
-% eat @SAVE -- beware, all of them have catcode \other:
-{
- \def\dospecials{\do S\do A\do V\do E} \uncatcodespecials % ;-)
- \gdef\gobblesave @SAVE{}
-}
-
-% initialization:
-\def\newsaveins #1{%
- \edef\next{\noexpand\newsaveinsX \makeSAVEname#1}%
- \next
-}
-\def\newsaveinsX #1{%
- \csname newbox\endcsname #1%
- \expandafter\def\expandafter\checkinserts\expandafter{\checkinserts
- \checksaveins #1}%
-}
-
-% initialize:
-\let\checkinserts\empty
-\newsaveins\footins
-\newsaveins\margin
-
-
-% @image. We use the macros from epsf.tex to support this.
-% If epsf.tex is not installed and @image is used, we complain.
-%
-% Check for and read epsf.tex up front. If we read it only at @image
-% time, we might be inside a group, and then its definitions would get
-% undone and the next image would fail.
-\openin 1 = epsf.tex
-\ifeof 1 \else
- % Do not bother showing banner with epsf.tex v2.7k (available in
- % doc/epsf.tex and on ctan).
- \def\epsfannounce{\toks0 = }%
- \input epsf.tex
-\fi
-\closein 1
-%
-% We will only complain once about lack of epsf.tex.
-\newif\ifwarnednoepsf
-\newhelp\noepsfhelp{epsf.tex must be installed for images to
- work. It is also included in the Texinfo distribution, or you can get
- it from ftp://tug.org/tex/epsf.tex.}
-%
-\def\image#1{%
- \ifx\epsfbox\undefined
- \ifwarnednoepsf \else
- \errhelp = \noepsfhelp
- \errmessage{epsf.tex not found, images will be ignored}%
- \global\warnednoepsftrue
- \fi
- \else
- \imagexxx #1,,,,,\finish
- \fi
-}
-%
-% Arguments to @image:
-% #1 is (mandatory) image filename; we tack on .eps extension.
-% #2 is (optional) width, #3 is (optional) height.
-% #4 is (ignored optional) html alt text.
-% #5 is (ignored optional) extension.
-% #6 is just the usual extra ignored arg for parsing this stuff.
-\newif\ifimagevmode
-\def\imagexxx#1,#2,#3,#4,#5,#6\finish{\begingroup
- \catcode`\^^M = 5 % in case we're inside an example
- \normalturnoffactive % allow _ et al. in names
- % If the image is by itself, center it.
- \ifvmode
- \imagevmodetrue
- \nobreak\bigskip
- % Usually we'll have text after the image which will insert
- % \parskip glue, so insert it here too to equalize the space
- % above and below.
- \nobreak\vskip\parskip
- \nobreak
- \line\bgroup\hss
- \fi
- %
- % Output the image.
- \ifpdf
- \dopdfimage{#1}{#2}{#3}%
- \else
- % \epsfbox itself resets \epsf?size at each figure.
- \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \epsfxsize=#2\relax \fi
- \setbox0 = \hbox{\ignorespaces #3}\ifdim\wd0 > 0pt \epsfysize=#3\relax \fi
- \epsfbox{#1.eps}%
- \fi
- %
- \ifimagevmode \hss \egroup \bigbreak \fi % space after the image
-\endgroup}
-
-
-% @float FLOATTYPE,LABEL,LOC ... @end float for displayed figures, tables,
-% etc. We don't actually implement floating yet, we always include the
-% float "here". But it seemed the best name for the future.
-%
-\envparseargdef\float{\eatcommaspace\eatcommaspace\dofloat#1, , ,\finish}
-
-% There may be a space before second and/or third parameter; delete it.
-\def\eatcommaspace#1, {#1,}
-
-% #1 is the optional FLOATTYPE, the text label for this float, typically
-% "Figure", "Table", "Example", etc. Can't contain commas. If omitted,
-% this float will not be numbered and cannot be referred to.
-%
-% #2 is the optional xref label. Also must be present for the float to
-% be referable.
-%
-% #3 is the optional positioning argument; for now, it is ignored. It
-% will somehow specify the positions allowed to float to (here, top, bottom).
-%
-% We keep a separate counter for each FLOATTYPE, which we reset at each
-% chapter-level command.
-\let\resetallfloatnos=\empty
-%
-\def\dofloat#1,#2,#3,#4\finish{%
- \let\thiscaption=\empty
- \let\thisshortcaption=\empty
- %
- % don't lose footnotes inside @float.
- %
- % BEWARE: when the floats start float, we have to issue warning whenever an
- % insert appears inside a float which could possibly float. --kasal, 26may04
- %
- \startsavinginserts
- %
- % We can't be used inside a paragraph.
- \par
- %
- \vtop\bgroup
- \def\floattype{#1}%
- \def\floatlabel{#2}%
- \def\floatloc{#3}% we do nothing with this yet.
- %
- \ifx\floattype\empty
- \let\safefloattype=\empty
- \else
- {%
- % the floattype might have accents or other special characters,
- % but we need to use it in a control sequence name.
- \indexnofonts
- \turnoffactive
- \xdef\safefloattype{\floattype}%
- }%
- \fi
- %
- % If label is given but no type, we handle that as the empty type.
- \ifx\floatlabel\empty \else
- % We want each FLOATTYPE to be numbered separately (Figure 1,
- % Table 1, Figure 2, ...). (And if no label, no number.)
- %
- \expandafter\getfloatno\csname\safefloattype floatno\endcsname
- \global\advance\floatno by 1
- %
- {%
- % This magic value for \thissection is output by \setref as the
- % XREFLABEL-title value. \xrefX uses it to distinguish float
- % labels (which have a completely different output format) from
- % node and anchor labels. And \xrdef uses it to construct the
- % lists of floats.
- %
- \edef\thissection{\floatmagic=\safefloattype}%
- \setref{\floatlabel}{Yfloat}%
- }%
- \fi
- %
- % start with \parskip glue, I guess.
- \vskip\parskip
- %
- % Don't suppress indentation if a float happens to start a section.
- \restorefirstparagraphindent
-}
-
-% we have these possibilities:
-% @float Foo,lbl & @caption{Cap}: Foo 1.1: Cap
-% @float Foo,lbl & no caption: Foo 1.1
-% @float Foo & @caption{Cap}: Foo: Cap
-% @float Foo & no caption: Foo
-% @float ,lbl & Caption{Cap}: 1.1: Cap
-% @float ,lbl & no caption: 1.1
-% @float & @caption{Cap}: Cap
-% @float & no caption:
-%
-\def\Efloat{%
- \let\floatident = \empty
- %
- % In all cases, if we have a float type, it comes first.
- \ifx\floattype\empty \else \def\floatident{\floattype}\fi
- %
- % If we have an xref label, the number comes next.
- \ifx\floatlabel\empty \else
- \ifx\floattype\empty \else % if also had float type, need tie first.
- \appendtomacro\floatident{\tie}%
- \fi
- % the number.
- \appendtomacro\floatident{\chaplevelprefix\the\floatno}%
- \fi
- %
- % Start the printed caption with what we've constructed in
- % \floatident, but keep it separate; we need \floatident again.
- \let\captionline = \floatident
- %
- \ifx\thiscaption\empty \else
- \ifx\floatident\empty \else
- \appendtomacro\captionline{: }% had ident, so need a colon between
- \fi
- %
- % caption text.
- \appendtomacro\captionline{\scanexp\thiscaption}%
- \fi
- %
- % If we have anything to print, print it, with space before.
- % Eventually this needs to become an \insert.
- \ifx\captionline\empty \else
- \vskip.5\parskip
- \captionline
- %
- % Space below caption.
- \vskip\parskip
- \fi
- %
- % If have an xref label, write the list of floats info. Do this
- % after the caption, to avoid chance of it being a breakpoint.
- \ifx\floatlabel\empty \else
- % Write the text that goes in the lof to the aux file as
- % \floatlabel-lof. Besides \floatident, we include the short
- % caption if specified, else the full caption if specified, else nothing.
- {%
- \atdummies
- % since we read the caption text in the macro world, where ^^M
- % is turned into a normal character, we have to scan it back, so
- % we don't write the literal three characters "^^M" into the aux file.
- \scanexp{%
- \xdef\noexpand\gtemp{%
- \ifx\thisshortcaption\empty
- \thiscaption
- \else
- \thisshortcaption
- \fi
- }%
- }%
- \immediate\write\auxfile{@xrdef{\floatlabel-lof}{\floatident
- \ifx\gtemp\empty \else : \gtemp \fi}}%
- }%
- \fi
- \egroup % end of \vtop
- %
- % place the captured inserts
- %
- % BEWARE: when the floats start float, we have to issue warning whenever an
- % insert appears inside a float which could possibly float. --kasal, 26may04
- %
- \checkinserts
-}
-
-% Append the tokens #2 to the definition of macro #1, not expanding either.
-%
-\def\appendtomacro#1#2{%
- \expandafter\def\expandafter#1\expandafter{#1#2}%
-}
-
-% @caption, @shortcaption
-%
-\def\caption{\docaption\thiscaption}
-\def\shortcaption{\docaption\thisshortcaption}
-\def\docaption{\checkenv\float \bgroup\scanargctxt\defcaption}
-\def\defcaption#1#2{\egroup \def#1{#2}}
-
-% The parameter is the control sequence identifying the counter we are
-% going to use. Create it if it doesn't exist and assign it to \floatno.
-\def\getfloatno#1{%
- \ifx#1\relax
- % Haven't seen this figure type before.
- \csname newcount\endcsname #1%
- %
- % Remember to reset this floatno at the next chap.
- \expandafter\gdef\expandafter\resetallfloatnos
- \expandafter{\resetallfloatnos #1=0 }%
- \fi
- \let\floatno#1%
-}
-
-% \setref calls this to get the XREFLABEL-snt value. We want an @xref
-% to the FLOATLABEL to expand to "Figure 3.1". We call \setref when we
-% first read the @float command.
-%
-\def\Yfloat{\floattype@tie \chaplevelprefix\the\floatno}%
-
-% Magic string used for the XREFLABEL-title value, so \xrefX can
-% distinguish floats from other xref types.
-\def\floatmagic{!!float!!}
-
-% #1 is the control sequence we are passed; we expand into a conditional
-% which is true if #1 represents a float ref. That is, the magic
-% \thissection value which we \setref above.
-%
-\def\iffloat#1{\expandafter\doiffloat#1==\finish}
-%
-% #1 is (maybe) the \floatmagic string. If so, #2 will be the
-% (safe) float type for this float. We set \iffloattype to #2.
-%
-\def\doiffloat#1=#2=#3\finish{%
- \def\temp{#1}%
- \def\iffloattype{#2}%
- \ifx\temp\floatmagic
-}
-
-% @listoffloats FLOATTYPE - print a list of floats like a table of contents.
-%
-\parseargdef\listoffloats{%
- \def\floattype{#1}% floattype
- {%
- % the floattype might have accents or other special characters,
- % but we need to use it in a control sequence name.
- \indexnofonts
- \turnoffactive
- \xdef\safefloattype{\floattype}%
- }%
- %
- % \xrdef saves the floats as a \do-list in \floatlistSAFEFLOATTYPE.
- \expandafter\ifx\csname floatlist\safefloattype\endcsname \relax
- \ifhavexrefs
- % if the user said @listoffloats foo but never @float foo.
- \message{\linenumber No `\safefloattype' floats to list.}%
- \fi
- \else
- \begingroup
- \leftskip=\tocindent % indent these entries like a toc
- \let\do=\listoffloatsdo
- \csname floatlist\safefloattype\endcsname
- \endgroup
- \fi
-}
-
-% This is called on each entry in a list of floats. We're passed the
-% xref label, in the form LABEL-title, which is how we save it in the
-% aux file. We strip off the -title and look up \XRLABEL-lof, which
-% has the text we're supposed to typeset here.
-%
-% Figures without xref labels will not be included in the list (since
-% they won't appear in the aux file).
-%
-\def\listoffloatsdo#1{\listoffloatsdoentry#1\finish}
-\def\listoffloatsdoentry#1-title\finish{{%
- % Can't fully expand XR#1-lof because it can contain anything. Just
- % pass the control sequence. On the other hand, XR#1-pg is just the
- % page number, and we want to fully expand that so we can get a link
- % in pdf output.
- \toksA = \expandafter{\csname XR#1-lof\endcsname}%
- %
- % use the same \entry macro we use to generate the TOC and index.
- \edef\writeentry{\noexpand\entry{\the\toksA}{\csname XR#1-pg\endcsname}}%
- \writeentry
-}}
-
-\message{localization,}
-% and i18n.
-
-% @documentlanguage is usually given very early, just after
-% @setfilename. If done too late, it may not override everything
-% properly. Single argument is the language abbreviation.
-% It would be nice if we could set up a hyphenation file here.
-%
-\parseargdef\documentlanguage{%
- \tex % read txi-??.tex file in plain TeX.
- % Read the file if it exists.
- \openin 1 txi-#1.tex
- \ifeof 1
- \errhelp = \nolanghelp
- \errmessage{Cannot read language file txi-#1.tex}%
- \else
- \input txi-#1.tex
- \fi
- \closein 1
- \endgroup
-}
-\newhelp\nolanghelp{The given language definition file cannot be found or
-is empty. Maybe you need to install it? In the current directory
-should work if nowhere else does.}
-
-
-% @documentencoding should change something in TeX eventually, most
-% likely, but for now just recognize it.
-\let\documentencoding = \comment
-
-
-% Page size parameters.
-%
-\newdimen\defaultparindent \defaultparindent = 15pt
-
-\chapheadingskip = 15pt plus 4pt minus 2pt
-\secheadingskip = 12pt plus 3pt minus 2pt
-\subsecheadingskip = 9pt plus 2pt minus 2pt
-
-% Prevent underfull vbox error messages.
-\vbadness = 10000
-
-% Don't be so finicky about underfull hboxes, either.
-\hbadness = 2000
-
-% Following George Bush, just get rid of widows and orphans.
-\widowpenalty=10000
-\clubpenalty=10000
-
-% Use TeX 3.0's \emergencystretch to help line breaking, but if we're
-% using an old version of TeX, don't do anything. We want the amount of
-% stretch added to depend on the line length, hence the dependence on
-% \hsize. We call this whenever the paper size is set.
-%
-\def\setemergencystretch{%
- \ifx\emergencystretch\thisisundefined
- % Allow us to assign to \emergencystretch anyway.
- \def\emergencystretch{\dimen0}%
- \else
- \emergencystretch = .15\hsize
- \fi
-}
-
-% Parameters in order: 1) textheight; 2) textwidth;
-% 3) voffset; 4) hoffset; 5) binding offset; 6) topskip;
-% 7) physical page height; 8) physical page width.
-%
-% We also call \setleading{\textleading}, so the caller should define
-% \textleading. The caller should also set \parskip.
-%
-\def\internalpagesizes#1#2#3#4#5#6#7#8{%
- \voffset = #3\relax
- \topskip = #6\relax
- \splittopskip = \topskip
- %
- \vsize = #1\relax
- \advance\vsize by \topskip
- \outervsize = \vsize
- \advance\outervsize by 2\topandbottommargin
- \pageheight = \vsize
- %
- \hsize = #2\relax
- \outerhsize = \hsize
- \advance\outerhsize by 0.5in
- \pagewidth = \hsize
- %
- \normaloffset = #4\relax
- \bindingoffset = #5\relax
- %
- \ifpdf
- \pdfpageheight #7\relax
- \pdfpagewidth #8\relax
- \fi
- %
- \setleading{\textleading}
- %
- \parindent = \defaultparindent
- \setemergencystretch
-}
-
-% @letterpaper (the default).
-\def\letterpaper{{\globaldefs = 1
- \parskip = 3pt plus 2pt minus 1pt
- \textleading = 13.2pt
- %
- % If page is nothing but text, make it come out even.
- \internalpagesizes{46\baselineskip}{6in}%
- {\voffset}{.25in}%
- {\bindingoffset}{36pt}%
- {11in}{8.5in}%
-}}
-
-% Use @smallbook to reset parameters for 7x9.25 trim size.
-\def\smallbook{{\globaldefs = 1
- \parskip = 2pt plus 1pt
- \textleading = 12pt
- %
- \internalpagesizes{7.5in}{5in}%
- {\voffset}{.25in}%
- {\bindingoffset}{16pt}%
- {9.25in}{7in}%
- %
- \lispnarrowing = 0.3in
- \tolerance = 700
- \hfuzz = 1pt
- \contentsrightmargin = 0pt
- \defbodyindent = .5cm
-}}
-
-% Use @smallerbook to reset parameters for 6x9 trim size.
-% (Just testing, parameters still in flux.)
-\def\smallerbook{{\globaldefs = 1
- \parskip = 1.5pt plus 1pt
- \textleading = 12pt
- %
- \internalpagesizes{7.4in}{4.8in}%
- {-.2in}{-.4in}%
- {0pt}{14pt}%
- {9in}{6in}%
- %
- \lispnarrowing = 0.25in
- \tolerance = 700
- \hfuzz = 1pt
- \contentsrightmargin = 0pt
- \defbodyindent = .4cm
-}}
-
-% Use @afourpaper to print on European A4 paper.
-\def\afourpaper{{\globaldefs = 1
- \parskip = 3pt plus 2pt minus 1pt
- \textleading = 13.2pt
- %
- % Double-side printing via postscript on Laserjet 4050
- % prints double-sided nicely when \bindingoffset=10mm and \hoffset=-6mm.
- % To change the settings for a different printer or situation, adjust
- % \normaloffset until the front-side and back-side texts align. Then
- % do the same for \bindingoffset. You can set these for testing in
- % your texinfo source file like this:
- % @tex
- % \global\normaloffset = -6mm
- % \global\bindingoffset = 10mm
- % @end tex
- \internalpagesizes{51\baselineskip}{160mm}
- {\voffset}{\hoffset}%
- {\bindingoffset}{44pt}%
- {297mm}{210mm}%
- %
- \tolerance = 700
- \hfuzz = 1pt
- \contentsrightmargin = 0pt
- \defbodyindent = 5mm
-}}
-
-% Use @afivepaper to print on European A5 paper.
-% From romildo@urano.iceb.ufop.br, 2 July 2000.
-% He also recommends making @example and @lisp be small.
-\def\afivepaper{{\globaldefs = 1
- \parskip = 2pt plus 1pt minus 0.1pt
- \textleading = 12.5pt
- %
- \internalpagesizes{160mm}{120mm}%
- {\voffset}{\hoffset}%
- {\bindingoffset}{8pt}%
- {210mm}{148mm}%
- %
- \lispnarrowing = 0.2in
- \tolerance = 800
- \hfuzz = 1.2pt
- \contentsrightmargin = 0pt
- \defbodyindent = 2mm
- \tableindent = 12mm
-}}
-
-% A specific text layout, 24x15cm overall, intended for A4 paper.
-\def\afourlatex{{\globaldefs = 1
- \afourpaper
- \internalpagesizes{237mm}{150mm}%
- {\voffset}{4.6mm}%
- {\bindingoffset}{7mm}%
- {297mm}{210mm}%
- %
- % Must explicitly reset to 0 because we call \afourpaper.
- \globaldefs = 0
-}}
-
-% Use @afourwide to print on A4 paper in landscape format.
-\def\afourwide{{\globaldefs = 1
- \afourpaper
- \internalpagesizes{241mm}{165mm}%
- {\voffset}{-2.95mm}%
- {\bindingoffset}{7mm}%
- {297mm}{210mm}%
- \globaldefs = 0
-}}
-
-% @pagesizes TEXTHEIGHT[,TEXTWIDTH]
-% Perhaps we should allow setting the margins, \topskip, \parskip,
-% and/or leading, also. Or perhaps we should compute them somehow.
-%
-\parseargdef\pagesizes{\pagesizesyyy #1,,\finish}
-\def\pagesizesyyy#1,#2,#3\finish{{%
- \setbox0 = \hbox{\ignorespaces #2}\ifdim\wd0 > 0pt \hsize=#2\relax \fi
- \globaldefs = 1
- %
- \parskip = 3pt plus 2pt minus 1pt
- \setleading{\textleading}%
- %
- \dimen0 = #1
- \advance\dimen0 by \voffset
- %
- \dimen2 = \hsize
- \advance\dimen2 by \normaloffset
- %
- \internalpagesizes{#1}{\hsize}%
- {\voffset}{\normaloffset}%
- {\bindingoffset}{44pt}%
- {\dimen0}{\dimen2}%
-}}
-
-% Set default to letter.
-%
-\letterpaper
-
-
-\message{and turning on texinfo input format.}
-
-% Define macros to output various characters with catcode for normal text.
-\catcode`\"=\other
-\catcode`\~=\other
-\catcode`\^=\other
-\catcode`\_=\other
-\catcode`\|=\other
-\catcode`\<=\other
-\catcode`\>=\other
-\catcode`\+=\other
-\catcode`\$=\other
-\def\normaldoublequote{"}
-\def\normaltilde{~}
-\def\normalcaret{^}
-\def\normalunderscore{_}
-\def\normalverticalbar{|}
-\def\normalless{<}
-\def\normalgreater{>}
-\def\normalplus{+}
-\def\normaldollar{$}%$ font-lock fix
-
-% This macro is used to make a character print one way in \tt
-% (where it can probably be output as-is), and another way in other fonts,
-% where something hairier probably needs to be done.
-%
-% #1 is what to print if we are indeed using \tt; #2 is what to print
-% otherwise. Since all the Computer Modern typewriter fonts have zero
-% interword stretch (and shrink), and it is reasonable to expect all
-% typewriter fonts to have this, we can check that font parameter.
-%
-\def\ifusingtt#1#2{\ifdim \fontdimen3\font=0pt #1\else #2\fi}
-
-% Same as above, but check for italic font. Actually this also catches
-% non-italic slanted fonts since it is impossible to distinguish them from
-% italic fonts. But since this is only used by $ and it uses \sl anyway
-% this is not a problem.
-\def\ifusingit#1#2{\ifdim \fontdimen1\font>0pt #1\else #2\fi}
-
-% Turn off all special characters except @
-% (and those which the user can use as if they were ordinary).
-% Most of these we simply print from the \tt font, but for some, we can
-% use math or other variants that look better in normal text.
-
-\catcode`\"=\active
-\def\activedoublequote{{\tt\char34}}
-\let"=\activedoublequote
-\catcode`\~=\active
-\def~{{\tt\char126}}
-\chardef\hat=`\^
-\catcode`\^=\active
-\def^{{\tt \hat}}
-
-\catcode`\_=\active
-\def_{\ifusingtt\normalunderscore\_}
-\let\realunder=_
-% Subroutine for the previous macro.
-\def\_{\leavevmode \kern.07em \vbox{\hrule width.3em height.1ex}\kern .07em }
-
-\catcode`\|=\active
-\def|{{\tt\char124}}
-\chardef \less=`\<
-\catcode`\<=\active
-\def<{{\tt \less}}
-\chardef \gtr=`\>
-\catcode`\>=\active
-\def>{{\tt \gtr}}
-\catcode`\+=\active
-\def+{{\tt \char 43}}
-\catcode`\$=\active
-\def${\ifusingit{{\sl\$}}\normaldollar}%$ font-lock fix
-
-% If a .fmt file is being used, characters that might appear in a file
-% name cannot be active until we have parsed the command line.
-% So turn them off again, and have \everyjob (or @setfilename) turn them on.
-% \otherifyactive is called near the end of this file.
-\def\otherifyactive{\catcode`+=\other \catcode`\_=\other}
-
-\catcode`\@=0
-
-% \backslashcurfont outputs one backslash character in current font,
-% as in \char`\\.
-\global\chardef\backslashcurfont=`\\
-\global\let\rawbackslashxx=\backslashcurfont % let existing .??s files work
-
-% \rawbackslash defines an active \ to do \backslashcurfont.
-% \otherbackslash defines an active \ to be a literal `\' character with
-% catcode other.
-{\catcode`\\=\active
- @gdef@rawbackslash{@let\=@backslashcurfont}
- @gdef@otherbackslash{@let\=@realbackslash}
-}
-
-% \realbackslash is an actual character `\' with catcode other, and
-% \doublebackslash is two of them (for the pdf outlines).
-{\catcode`\\=\other @gdef@realbackslash{\} @gdef@doublebackslash{\\}}
-
-% \normalbackslash outputs one backslash in fixed width font.
-\def\normalbackslash{{\tt\backslashcurfont}}
-
-\catcode`\\=\active
-
-% Used sometimes to turn off (effectively) the active characters
-% even after parsing them.
-@def@turnoffactive{%
- @let"=@normaldoublequote
- @let\=@realbackslash
- @let~=@normaltilde
- @let^=@normalcaret
- @let_=@normalunderscore
- @let|=@normalverticalbar
- @let<=@normalless
- @let>=@normalgreater
- @let+=@normalplus
- @let$=@normaldollar %$ font-lock fix
- @unsepspaces
-}
-
-% Same as @turnoffactive except outputs \ as {\tt\char`\\} instead of
-% the literal character `\'. (Thus, \ is not expandable when this is in
-% effect.)
-%
-@def@normalturnoffactive{@turnoffactive @let\=@normalbackslash}
-
-% Make _ and + \other characters, temporarily.
-% This is canceled by @fixbackslash.
-@otherifyactive
-
-% If a .fmt file is being used, we don't want the `\input texinfo' to show up.
-% That is what \eatinput is for; after that, the `\' should revert to printing
-% a backslash.
-%
-@gdef@eatinput input texinfo{@fixbackslash}
-@global@let\ = @eatinput
-
-% On the other hand, perhaps the file did not have a `\input texinfo'. Then
-% the first `\{ in the file would cause an error. This macro tries to fix
-% that, assuming it is called before the first `\' could plausibly occur.
-% Also turn back on active characters that might appear in the input
-% file name, in case not using a pre-dumped format.
-%
-@gdef@fixbackslash{%
- @ifx\@eatinput @let\ = @normalbackslash @fi
- @catcode`+=@active
- @catcode`@_=@active
-}
-
-% Say @foo, not \foo, in error messages.
-@escapechar = `@@
-
-% These look ok in all fonts, so just make them not special.
-@catcode`@& = @other
-@catcode`@# = @other
-@catcode`@% = @other
-
-
-@c Local variables:
-@c eval: (add-hook 'write-file-hooks 'time-stamp)
-@c page-delimiter: "^\\\\message"
-@c time-stamp-start: "def\\\\texinfoversion{"
-@c time-stamp-format: "%:y-%02m-%02d.%02H"
-@c time-stamp-end: "}"
-@c End:
-
-@c vim:sw=2:
-
-@ignore
- arch-tag: e1b36e32-c96e-4135-a41a-0b2efa2ea115
-@end ignore
+++ /dev/null
-@set UPDATED 18 December 2006
-@set UPDATED-MONTH December 2006
-@set EDITION 3.1.2
-@set VERSION 3.1.2
+++ /dev/null
-@set UPDATED 29 January 2007
-@set UPDATED-MONTH January 2007
-@set EDITION 3.1.2
-@set VERSION 3.1.2
+++ /dev/null
-;;; -*- Emacs-Lisp -*-
-
-(defvar riece-modules
- (cons 'riece-compat
- (cons (if (featurep 'xemacs)
- 'riece-xemacs
- 'riece-emacs)
- '(riece-globals
- riece-options
- riece-debug
- riece-package-info
- riece-version
- riece-coding
- riece-complete
- riece-mcat
- riece-addon-modules
- riece-addon
- riece-ruby
- riece-cache
-
- riece-mode
- ;; riece-identity -+-> riece-channel
- ;; +-> riece-user
- riece-identity
- riece-channel
- riece-user
-
- riece-misc
- riece-signal
-
- ;; riece-layout ---> riece-display
- riece-layout
- riece-display
- riece-server
-
- ;; riece-channel -+-> riece-naming
- ;; riece-user -+
- riece-naming
- riece-message
-
- ;; riece-filter calls riece-{handle,000,200,300,400,500}
- riece-filter
- riece-handle
- riece-000
- riece-200
- riece-300
- riece-400
- riece-500
-
- riece-commands
- riece-irc
- riece))))
-
-(defvar riece-mcat-modules
- '(riece-mcat-japanese))
-
-(defvar riece-icons
- '("riece-command-quit.xpm"
- "riece-command-join.xpm"
- "riece-command-part.xpm"
- "riece-command-previous-channel.xpm"
- "riece-command-next-channel.xpm"
- "riece-command-change-layout.xpm"
- "riece-submit-bug-report.xpm"))
-
-(defvar riece-scripts
- '("server.rb"
- "aproxy.rb"))
-
-(defun riece-compile-modules (modules)
- (let ((load-path (cons nil load-path))
- error-modules)
- (while modules
- (let ((source (expand-file-name
- (concat (symbol-name (car modules)) ".el"))))
- (if (file-newer-than-file-p source (concat source "c"))
- (condition-case error
- (byte-compile-file source)
- (error
- (setq error-modules (cons (car modules) error-modules))))))
- (setq modules (cdr modules)))
- (if error-modules
- (princ (concat "\n\
- WARNING: ---------------------------------------------------------
- WARNING: Couldn't compile following modules:
- WARNING:
- WARNING: " (mapconcat #'symbol-name error-modules ", ") "\n\
- WARNING:
- WARNING: You should probably stop here, try \"make distclean\" to clear
- WARNING: the last build, and then reconfigure.
- WARNING: ---------------------------------------------------------\n\n")))))
-
-(defun riece-compile-module ()
- (let ((load-path (cons nil load-path)))
- (let ((source (expand-file-name
- (concat (car command-line-args-left) ".el"))))
- (if (file-newer-than-file-p source (concat source "c"))
- (byte-compile-file source)))))
-
-(defun riece-install-modules (modules dest just-print)
- (unless (or just-print (file-exists-p dest))
- (make-directory dest t))
- (while modules
- (let ((name (symbol-name (car modules))))
- (princ (format "%s.el -> %s\n" name dest))
- (unless just-print
- (copy-file (expand-file-name (concat name ".el"))
- (expand-file-name (concat name ".el") dest)
- t t))
- (princ (format "%s.elc -> %s\n" name dest))
- (unless just-print
- (if (file-exists-p (expand-file-name (concat name ".elc")))
- (copy-file (expand-file-name (concat name ".elc"))
- (expand-file-name (concat name ".elc") dest)
- t t)
- (princ (format "(%s was not successfully compiled, ignored)\n"
- name)))))
- (setq modules (cdr modules))))
-
-(defun riece-install-icons (icons dest just-print)
- (unless (or just-print (file-exists-p dest))
- (make-directory dest t))
- (while icons
- (when (file-exists-p (expand-file-name (car icons)))
- (princ (format "%s -> %s\n" (car icons) dest))
- (unless just-print
- (copy-file (expand-file-name (car icons))
- (expand-file-name (car icons) dest)
- t t)))
- (setq icons (cdr icons))))
-
-(defun riece-install-scripts (scripts dest just-print)
- (unless (or just-print (file-exists-p dest))
- (make-directory dest t))
- (while scripts
- (when (file-exists-p (expand-file-name (car scripts)))
- (princ (format "%s -> %s\n" (car scripts) dest))
- (unless just-print
- (copy-file (expand-file-name (car scripts))
- (expand-file-name (car scripts) dest)
- t t)))
- (setq scripts (cdr scripts))))
-
-(defun riece-install-just-print-p ()
- (let ((flag (getenv "MAKEFLAGS"))
- case-fold-search)
- (if flag
- (string-match "^\\(\\(--[^ ]+ \\)+-\\|[^ =-]\\)*n" flag))))
-
-(defun riece-examine-modules ()
- (let ((load-path (cons nil load-path)))
- (require 'riece-mcat)
- (require 'riece-addon-modules)
- (append riece-modules
- riece-mcat-modules
- (mapcar #'car riece-addon-modules))))
-
-(defun riece-examine ()
- (princ (mapconcat #'symbol-name (riece-examine-modules) " ")))
-
-(defun riece-update-mcat ()
- (let ((modules (riece-examine-modules))
- (pointer riece-mcat-modules)
- files)
- (while pointer
- (setq modules (delq (car pointer) modules)
- pointer (cdr pointer)))
- (setq files (mapcar (lambda (module)
- (concat (symbol-name module) ".el"))
- modules)
- pointer riece-mcat-modules)
- (while pointer
- (riece-mcat-update files (concat (symbol-name (car pointer)) ".el")
- (intern (concat (symbol-name (car pointer))
- "-alist")))
- (setq pointer (cdr pointer)))))
-
-(defun riece-compile ()
- (riece-compile-modules (riece-examine-modules)))
-
-(defun riece-install ()
- (riece-install-modules
- (riece-examine-modules)
- (expand-file-name "riece" (car command-line-args-left))
- (riece-install-just-print-p))
- (riece-install-icons
- riece-icons
- (expand-file-name "riece" (car command-line-args-left))
- (riece-install-just-print-p))
- (riece-install-scripts
- riece-scripts
- (expand-file-name "riece" (car command-line-args-left))
- (riece-install-just-print-p)))
-
-(defun riece-compile-package ()
- (setq autoload-package-name "riece")
- (add-to-list 'command-line-args-left ".")
- (batch-update-directory)
- (add-to-list 'command-line-args-left ".")
- (Custom-make-dependencies)
- (riece-compile-modules
- (append (riece-examine-modules)
- '(auto-autoloads custom-load))))
-
-(defun riece-install-package ()
- (riece-install-modules
- (append (riece-examine-modules)
- '(auto-autoloads custom-load))
- (expand-file-name "lisp/riece" (car command-line-args-left))
- (riece-install-just-print-p))
- (riece-install-icons
- riece-icons
- (expand-file-name "etc/riece" (car command-line-args-left))
- (riece-install-just-print-p))
- (riece-install-scripts
- riece-scripts
- (expand-file-name "etc/riece" (car command-line-args-left))
- (riece-install-just-print-p)))
-
-(defun riece-test ()
- (let ((load-path (cons (expand-file-name "test") (cons nil load-path)))
- (files (directory-files "test" t "^test-.*\\.el$"))
- suite)
- (require 'lunit-report)
- (setq suite (lunit-make-test-suite))
- (while files
- (when (file-regular-p (car files))
- (load-file (car files))
- (lunit-test-suite-add-test
- suite
- (lunit-make-test-suite-from-class
- (intern (file-name-sans-extension
- (file-name-nondirectory (car files)))))))
- (setq files (cdr files)))
- (lunit-report suite (car command-line-args-left))))
+++ /dev/null
-2007-01-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.2 released.
-
-2007-01-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-handle-ctcp-ping-request): Removed useless
- argument for `format'.
- * riece-mcat.el (riece-mcat-extract): New local variable `pointer'.
- * riece-epg.el (epg-cancel): Autoload.
- * riece-options.el (riece): Specify :group.
-
-2007-01-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mcat.el (riece-mcat-extract): Abolished ALIST arg.
-
-2007-01-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-addons): Insinuate riece-mcat by default.
- * riece-addon-modules.el (riece-addon-modules): Add riece-mcat.
- * riece-mcat.el: Implement add-on interface.
- (riece-mcat-alist): Removed.
- (riece-mcat-description): New constant.
- (riece-mcat-insinuate): New function.
- (riece-mcat-uninstall): New function.
-
-2007-01-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mcat.el (riece-mcat-update): New function.
- * Makefile.am (update-mcat): New target.
- * COMPILE (riece-modules): Moved riece-mcat-japanese.el to
- riece-mcat-modules.
- (riece-mcat-modules): New variable.
- (riece-examine-modules): Append riece-mcat-modules.
- (riece-update-mcat): New function.
-
-2007-01-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mcat.el: New file.
- * riece-mcat-japanese.el: New file.
- * COMPILE (riece-modules): Added riece-mcat and riece-mcat-japanese.
- * Makefile.am (EXTRA_DIST): Added riece-mcat.el and
- riece-mcat-japanese.el.
-
-2006-12-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-package-info.el.in: New file.
- * COMPILE (riece-modules): Added riece-package-info.
- * Makefile.am (DISTCLEANFILES): Added riece-package-info.el.
-
-2006-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.1 released.
- * configure.ac: Bump up version to 3.1.1.
-
-2006-09-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-list-addons): Describe "save the
- current setting".
- (riece-command-enable-addon): Make sure the addon to be insinuated.
-
-2006-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-layout.el (riece-layout-alist): Added
- riece-configure-windows-spiral.
- (riece-configure-windows-spiral): New window layout. Written by
- URABE Shyouhei <root@mput.dip.jp>.
-
- * riece-options.el (riece-addons): Enable riece-shrink-buffer by
- default.
-
- * aproxy.rb (AProxy::start): Fixed a typo (@out -> $stdout).
-
-2006-07-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.1.0 released.
- * configure.ac: Bump up version to 3.1.0.
-
-2006-07-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-join-channel): Simplified by
- using riece-server-opened.
- (riece-command-part-channel): Ditto.
-
-2006-07-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-save-variables-files): Place ";;; Do not edit
- this file!" at the beginning of ~/.riece/save.
-
- * riece-server.el (riece-reset-process-buffer): Make
- riece-filter-running local to the server buffer.
- * riece-filter.el (riece-filter): Allow only a message handler to
- run at a time.
- * riece-globals.el (riece-filter-running): New variable.
-
-2006-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ndcc.el: Don't use calc.
-
- * riece-300.el (riece-handle-353-message): Append " " to every 353
- line before inserting it to riece-353-message-alist.
-
-2006-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 3.0.0 released.
- * configure.ac: Bump up version to 3.0.0.
-
-2006-05-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-realname): New user option.
-
- * riece-irc.el (riece-irc-open-server): Changed the meaning of
- riece-username. i.e. now riece-username represents the user's
- login name and riece-realname is the replacement of the former
- riece-username.
- * riece-server.el (riece-server-keyword-map): New keyword :realname.
-
-2006-05-06 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-commands.el (riece-command-close-server): Cause error
- on non-existent server process.
-
-2006-04-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-skk-kakutei.el: Declare some variables and autoload
- 'skk-kakutei to suppress compilation warnings.
-
- * riece-xfaceb.el: Don't enclose autoloads with ignore-errors;
- autoloads should not report errors.
-
- * riece-commands.el (riece-command-save-variables): New command.
-
- * riece-epg.el
- (riece-epg-passphrase-callback-function-for-decrypt): New
- function.
- (riece-command-set-passphrase): Renamed.
- (riece-epg-message-filter): Don't query passphrase; if decryption
- fails add button to try again.
- (riece-epg-add-encrypted-button): New function.
- (riece-epg-encrypted-button-notify): New function.
-
-2006-04-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-epg.el: New add-on.
- * riece-addon-modules.el (riece-addon-modules): Added riece-epg.
- * Makefile.am (EXTRA_DIST): Added riece-epg.el.
-
-2006-04-13 Steve Youngs <steve@sxemacs.org>
-
- * riece-commands.el (riece-command-invite): Add missing `:' to
- string sent to server.
-
- * riece-300.el (riece-handle-341-message): swap values for
- `channel' and `user'.
-
-2006-04-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-buffer-alist): " *Debug*" -> "*Debug*".
- (riece-save-variables-files): Fixed a typo in the docstring.
-
-2006-01-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-part-channel): Emit
- 'channel-list-changed signal.
-
-2005-12-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-alternate-separator): Reverted the
- default value.
-
-2005-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.2 released.
- * configure.ac: Bump up version to 2.0.2.
-
-2005-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-alternate-separator): Changed from
- "@" -> "%".
-
- * test/test-riece-cache.el: New test cases.
- * test/Makefile.am (EXTRA_DIST): Added test-riece-cache.el.
-
- * Makefile.am (EXTRA_DIST): Added riece-cache.el.
-
- * riece-commands.el (riece-command-part-channel): Signal an error
- if TARGET server has not opened.
-
- * riece-channel.el: Require 'riece-cache.
- (riece-find-channel): Increase priority of given channel name in
- riece-channel-cache.
- (riece-forget-channel): Remove given channel name from
- riece-channel-cache.
- (riece-get-channel): Register given channel name in
- riece-channel-cache (if it is being added to riece-channel-obarray.)
- * riece-server.el (riece-reset-process-buffer): Initialize
- riece-channel-cache.
- * riece-options.el (riece-channel-cache-max-size): New user
- option.
- * riece-misc.el (riece-get-channels-on-server): Get channel names
- from riece-channel-cache.
- * riece-globals.el (riece-channel-cache): New variable.
-
-2005-11-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-cache.el: Renamed from riece-lru.el.
-
-2005-11-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-user.el: Require 'riece-lru.
- (riece-find-user): Increase priority of given username in
- riece-user-lru.
- (riece-forget-user): Remove given username from riece-user-lru.
- (riece-rename-user): Rename given username in riece-user-lru.
- (riece-get-user): Register given username in riece-user-lru (if
- it is being added to riece-user-obarray.)
- * riece-server.el: Require 'riece-lru.
- (riece-reset-process-buffer): Initialize riece-user-lru.
- * riece-options.el (riece-user-lru-max-size): New user option.
- * riece-misc.el: Require 'riece-lru.
- (riece-get-users-on-server): Get usernames from riece-user-lru.
- * riece-globals.el (riece-user-lru): New variable.
- * COMPILE (riece-modules): Added riece-lru.
- * riece-lru.el: New file.
-
- * riece-develop.el: New file.
-
-2005-10-27 Masatake YAMATO <jet@gyve.org>
-
- * url-riece.el (url-irc-riece): Use `server-name'
- to create an argument for `riece-parse-identity'.
- `server' was used.
-
-2005-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.1 released.
- * configure.ac: Bump up version to 2.0.1.
-
-2005-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-list-addons): Adjust width of 2nd
- column to the length of the longest add-on name.
-
-2005-09-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-abbrev-identity-string): Compare car
- of riece-alias-alist with identities case insensitively.
-
-2005-09-05 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile.am (EXTRA_DIST): Added riece-xfaceb.el.
- * riece-addon-modules.el (riece-addon-modules): Added riece-xfaceb.
-
-2005-09-03 Steve Youngs <steve@sxemacs.org>
-
- * riece-xfaceb.el: New file. Display X-Face and colour Face
- images in IRC buffer, getting the image data from BBDB records.
-
-2005-08-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-requires): Require 'riece-history.
-
-2005-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 2.0.0 released.
- * riece-version.el (riece-version-number): Bump up to 2.0.0.
-
-2005-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-log.el
- (test-riece-log-display-message-function): Enable riece-log addon.
-
- * test/test-riece-ruby.el (lunit-test-case-teardown): Reset
- riece-ruby-output-handler-alist and riece-ruby-output-queue-alist.
-
- * riece-server.el (riece-server-keyword-map): Abolished
- :coding-system-alist keyword.
- (riece-send-string): Take the target identity as the 2nd argument.
-
- * riece-identity.el (riece-channel-coding-system-alist): Renamed
- from riece-coding-system-alist.
-
- * riece-globals.el (riece-coding-system-alist): Abolished.
-
- * riece-commands.el (riece-command-topic): Pass the target
- identity to riece-send-string.
- (riece-command-kick): Ditto.
- (riece-command-send-message): Ditto.
- (riece-command-enter-message-to-user): Ditto.
- (riece-command-join-channel): Ditto.
- (riece-command-part-channel): Ditto.
-
-2005-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-coding-system-for-identity): Moved from
- riece-coding.el.
- (riece-decoded-string-for-identity): Ditto.
-
- * riece-300.el (riece-handle-322-message): Decode message per
- channel.
- (riece-handle-set-topic): Ditto.
-
- * riece-handle.el (riece-handle-notice-message): Decode message
- per channel.
- (riece-handle-part-message): Ditto.
- (riece-handle-kick-message): Ditto.
- (riece-handle-topic-message): Ditto.
-
-2005-08-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-handle-privmsg-message): Use
- riece-decoded-string & riece-decoded-string-for-identity.
-
- * riece-coding.el (riece-coding-system-alist): New user option.
- (riece-coding-system-for-identity): New function.
- (riece-encoded-string): New function.
- (riece-decoded-string): New alias.
- (riece-decoded-string-for-identity): New function.
-
-2005-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-uninstall-addon): Don't check the add-on
- is enabled.
- (riece-uninstall-addon): Don't use riece-remprop.
- (riece-enable-addon): Put 'riece-addon-enabled property on the
- add-on feature.
- (riece-disable-addon): Ditto.
- (riece-command-list-addons): Check 'riece-addon-enabled property
- instead of riece-*-enabled variables.
-
-2005-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-shrink-buffer-idle-time-delay):
- Abolished; moved to riece-shrink-buffer.el.
- (riece-max-buffer-size): Ditto.
- (riece-shrink-buffer-remove-chars): Ditto.
-
- * riece.el (riece-shrink-buffer-idle-timer): Abolished; moved to
- riece-shrink-buffer.el.
- (riece): Don't set riece-shrink-buffer-idle-timer here.
- (riece-exit): Don't cancel riece-shrink-buffer-idle-timer here.
-
- * riece-shrink-buffer.el: New add-on.
- * riece-addon-modules.el (riece-addon-modules): Added
- riece-shrink-buffer.
- * Makefile.am (EXTRA_DIST): Added riece-shrink-buffer.el.
-
-2005-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-highlight-uninstall): Use
- riece-remprop instead of remprop.
-
- * riece-addon.el (riece-uninstall-addon): Use riece-remprop
- instead of remprop.
-
- * riece-xemacs.el (riece-remprop): New alias.
- * riece-emacs.el (riece-remprop): New function.
-
- * COMPILE (riece-compile-modules): Add current directory to load-path.
-
- * riece-history.el (riece-history-requires): New function.
- * riece-addon.el (riece-insinuate-addon-1): Require add-on feature.
-
-2005-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-foolproof.el (riece-foolproof-description): Made it more
- descriptive.
-
- * riece-url.el (riece-url-uninstall): Call easy-menu-remove-item.
-
- * riece-addon.el (riece-addon-list-mode-map): Bind
- riece-command-unload-addon.
- (riece-insinuate-addon-1): New function; renamed from
- riece-insinuate-addon.
- (riece-insinuate-addon): Use it; re-insinuate add-ons preceding to
- the add-on.
- (riece-addon-list-set-point): New function.
- (riece-command-unload-addon): New command.
-
-2005-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-menu.el (riece-menu-uninstall): Call easy-menu-remove.
-
- * riece-toolbar.el (riece-toolbar-original-toolbar) [XEmacs]: New
- variable.
- (riece-unset-toolbar): New function.
- (riece-toolbar-uninstall): Call riece-unset-toolbar.
- (riece-toolbar-command-mode-hook): Renamed from
- riece-toolbar-insinuate-in-command-buffer.
-
- * riece-icon.el (riece-icon-enable): Update
- mode-line-buffer-identification here.
- (riece-icon-disable): Ditto.
-
-2005-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-uninstall-addon): Update
- riece-addon-dependencies.
-
-2005-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-command-mode): Set
- riece-mode-line-buffer-identification.
- (riece-dialogue-mode): Ditto.
- (riece-channel-mode): Ditto.
- (riece-channel-list-mode): Ditto.
- (riece-user-list-mode): Ditto.
- * riece-icon.el
- (riece-icon-update-mode-line-buffer-identification): New function.
- (riece-icon-insinuate): Use it.
- (riece-icon-uninstall): Use it.
- * riece-globals.el (riece-mode-line-buffer-identification): New
- variable.
-
-2005-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * Make add-ons uninstallable.
-
- * riece-xface.el (riece-xface-user-list-mode-hook): New function.
- (riece-xface-insinuate): Use it.
- (riece-xface-uninstall): New function.
- * riece-url.el (riece-url-command-mode-hook): New function.
- (riece-url-insinuate): Use it.
- (riece-url-uninstall): New function.
- * riece-unread.el (riece-unread-uninstall): New function.
- * riece-toolbar.el (riece-toolbar-uninstall): New function.
- * riece-rdcc.el (riece-rdcc-uninstall): New function.
- * riece-ndcc.el (riece-ndcc-uninstall): New function.
- * riece-mini.el (riece-mini-uninstall): New function.
- * riece-menu.el (riece-menu-uninstall): New function.
- * riece-lsdb.el: New function.
- * riece-log.el (riece-log-uninstall): New function.
- * riece-keyword.el (riece-keyword-uninstall): New function.
- * riece-keepalive.el (riece-keepalive-uninstall): New function.
- * riece-kakasi.el (riece-kakasi-uninstall): New function.
- * riece-ignore.el (riece-ignore-uninstall): New function.
- * riece-icon.el (riece-icon-user-list-mode-hook): New function.
- (riece-icon-channel-list-mode-hook): New function.
- (riece-icon-original-mode-line-buffer-identification): New variable.
- (riece-icon-insinuate): Use them.
- (riece-icon-uninstall): New function.
- * riece-history.el
- (riece-history-after-switch-to-channel-functions): New function.
- (riece-history-insinuate): Use it.
- (riece-history-uninstall): New function.
- * riece-highlight.el (riece-highlight-uninstall): New function.
- * riece-hangman.el (riece-hangman-uninstall): New function.
- * riece-google.el (riece-google-uninstall): New function.
- * riece-foolproof.el (riece-foolproof-uninstall): New function.
- * riece-eval.el (riece-eval-uninstall): New function.
- * riece-eval-ruby.el (riece-eval-ruby-uninstall): New function.
- * riece-doctor.el (riece-doctor-uninstall): New function.
- * riece-ctlseq.el (riece-ctlseq-uninstall): New function.
- * riece-ctcp.el (riece-ctcp-dialogue-font-lock-keywords): New variable.
- (riece-ctcp-uninstall): New function.
- * riece-button.el (riece-button-channel-list-mode-hook): New function.
- * riece-biff.el (riece-biff-uninstall): New function.
-
-2005-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-saved-forms): Added riece-addons.
-
- * riece-addon.el: Require 'riece-addon-modules.
- (riece-command-list-addons): List all available add-ons from
- riece-addon-modules.
- (riece-addon-list-mode-map): Bind riece-command-insinuate-addon
- and riece-command-uninstall-addon.
- (riece-insinuate-addon): Rebuild riece-addon-dependencies.
- (riece-command-insinuate-addon): New command.
- (riece-command-uninstall-addon): New command.
-
- * COMPILE (riece-examine-modules): New function.
- (riece-examine): Use it.
- (riece-compile): Use it.
- (riece-install): Use it.
- (riece-compile-package): Use it.
- (riece-install-package): Use it.
-
- * Makefile.am (EXTRA_DIST): Added riece-addon-modules.el.
-
- * riece-addon-modules.el: New file.
-
-2005-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-list-addons): Use
- riece-addon-dependencies instead of riece-addons.
- (riece-command-enable-addon): Ditto.
- (riece-command-disable-addon): Ditto.
- (riece-uninstall-addon): New function.
-
-2005-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece): Don't override riece-addons setting.
-
- * riece-globals.el (riece-addon-dependencies): New variable.
-
- * riece-addon.el (riece-sort-addon-dependencies): Rename from
- riece-resolve-addon-dependencies; return addon dependencies as an
- alist, instead of returning a list of addons.
-
-2005-08-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-enable-addon): Redraw entire
- add-on list.
- (riece-command-disable-addon): Ditto.
-
-2005-08-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-handle-message): Use
- riece-funcall-ignore-errors instead of riece-ignore-errors.
-
- * riece-ctcp.el (riece-handle-ctcp-request): Use
- riece-funcall-ignore-errors instead of riece-ignore-errors.
- (riece-handle-ctcp-response): Ditto.
-
-2005-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-data-directory): Use load-file-name.
-
-2005-08-15 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-options.el (riece-data-directory): Avoid compile time
- error when locate-data-directory undefined.
-
-2005-08-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-quit-timeout): Set default to 1.
-
- * riece-irc.el (riece-irc-quit-server-process): Display message
- before/after sending QUIT.
-
-2005-08-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-addons-insinuated): Abolished.
- (riece): Don't check riece-addons-insinuated.
-
- * riece-addon.el (riece-insinuate-addon): Put
- 'riece-addon-insinuated property on add-on feature.
-
-2005-08-13 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-install-package): Install *.xpm and *.rb in etc/riece.
-
- * riece-async.el (riece-async-open-network-stream): Locate Ruby
- script files in riece-data-directory.
- * riece-toolbar.el (riece-make-toolbar-from-menu): Locate icon
- files in riece-data-directory.
- * riece-ruby.el (riece-ruby-execute): Locate Ruby script files in
- riece-data-directory.
- * riece-options.el (riece-data-directory): New user option.
-
-2005-08-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el (riece-ruby-filter): Pass timestamp of output
- event to output-handler.
-
-2005-08-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-button.el (riece-user-button-popup-menu): Simplified
- menu item titles.
-
- * COMPILE (riece-compile-module): New function.
- (riece-examine): New function.
-
- * Makefile.am (compile-individually): New rule.
-
- * riece-log.el (riece-log-file-name-regexp): New constant.
- (riece-log-get-file): Add 2nd argument coding-system.
- (riece-log-get-files): Add 2nd argument time.
- (riece-log-insert): Simplified; determine coding-system from
- suffix of each log file.
- (riece-log-dired): Renamed from riece-log-open-directory.
- (riece-log-open-directory-function): Abolished.
- (riece-log-make-file-name): Renamed from riece-log-get-file.
- (riece-log-list-files): Renamed from riece-log-get-files.
- (riece-log-directory): Renamed from riece-log-get-directory.
-
- * Makefile.am (EXTRA_DIST): Added aproxy.rb.
-
- * COMPILE (riece-scripts): Added "aproxy.rb".
-
- * riece-async.el (riece-async-buffer-size): Renamed from
- riece-async-max-buffer-size.
- (riece-async-backup-file): New user option.
- (riece-async-server-program): New variable.
- (riece-async-server-program-arguments): New variable.
- (riece-async-open-network-stream): Use aproxy.rb.
-
- * aproxy.rb: New file.
-
- * riece-ruby.el (riece-ruby-out-file): New user option.
- (riece-ruby-err-file): New user option.
- (riece-ruby-log-file): New user option..
- (riece-ruby-server-program-arguments): New variable.
- (riece-ruby-filter): Call output-handler within
- riece-debug-with-backtrace; erase process output.
- (riece-ruby-run-exit-handler): Call exit-handler within
- riece-debug-with-backtrace.
-
- * server.rb: Don't bind @err in execution environment;
- added logging feature.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * server.rb: Connect $stdout and $stderr to StringIO objects.
-
- * riece-async.el: Use riece-ruby (partially).
-
- * riece-eval-ruby.el (riece-eval-ruby-prefix-regexp): New user option.
- (riece-eval-ruby-exit-handler): Print "nil".
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-hangman.el (riece-hangman-hello-regexp): Changed regexp.
- (riece-hangman-bye-regexp): Ditto.
-
- * riece-doctor.el (riece-doctor-hello-regexp): Changed regexp.
- (riece-doctor-bye-regexp): Ditto.
-
- * riece-ruby.el: Moved add-on stuff to riece-eval-ruby.el.
-
- * riece-eval-ruby.el: New add-on.
- * COMPILE (riece-modules): Add riece-eval-ruby.
- * Makefile.am (EXTRA_DIST): Add riece-eval-ruby.el.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * server.rb (Server::unescape): Fixed.
-
- * riece-ruby.el: Implement add-on API.
- (riece-ruby-filter): Fixed regexp; fixed argument order of
- output-handler.
- (riece-ruby-run-exit-handler): Remove exit-handler entry before
- running it to avoid recursion; call riece-ruby-clear if
- exit-handler is specified.
- (riece-ruby-exit-handler): Don't call riece-ruby-clear.
-
- * riece-rdcc.el: Use riece-ruby.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el (riece-ruby-property-alist): New variable
- (riece-ruby-set-property): New function.
- (riece-ruby-property): New function.
- (riece-ruby-execute): Locate server.rb from load-path.
-
- * Makefile.am (EXTRA_DIST): Added riece-ruby.el and server.rb.
-
- * COMPILE (riece-modules): Added riece-ruby.
- (riece-icons): Use filename instead of symbol.
- (riece-scripts): New variable.
- (riece-install-icons): Use filename instead of symbol.
- (riece-install-scripts): New function.
- (riece-install): Call riece-install-scripts.
- (riece-install-package): Ditto.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el: Add docs for variables.
- (riece-ruby-substitute-variables): Substitute multiple variables.
- (riece-ruby-filter): Call output-handler/exit-handler with program
- name.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * server.rb: Renamed from rubyserv.rb; s/RubyServ/Server/.
- * riece-ruby.el (riece-ruby-server-program): Follow the filename
- change.
- (riece-ruby-set-output-handler): New function.
-
-2005-08-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el: Fixed example.
- (riece-ruby-server-program): New variable.
- (riece-ruby-status-alist): New variable.
- (riece-ruby-status): Abolished.
- (riece-ruby-escaped-data): Renamed from riece-ruby-input.
- (riece-ruby-reset-process-buffer): New function.
- (riece-ruby-send-exit): New function.
- (riece-ruby-filter): Call riece-ruby-run-exit-handler if the
- program is exited.
- (riece-ruby-run-exit-handler): New function.
- (riece-ruby-execute): Don't expect program name.
- (riece-ruby-clear): New function.
- (riece-ruby-set-exit-handler): New function.
-
- * rubyserv.rb (RubyServ::dispatch_eval): Don't expect program
- name; eval under the binding of RubyServ::C.
- (RubyServ::dispatch_poll): Don't clear @thr.
- (RubyServ::dispatch_exit): New method.
-
-2005-08-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el: New file.
- * rubyserv.rb: Rewrite.
-
-2005-08-09 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mini.el (riece-mini-message-no-log): Defined as a
- function.
- (riece-mini-requires): Fixed indent.
-
-2005-08-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-dialogue-mode-map): Bind
- riece-command-toggle-others-buffer-mode.
-
- * riece-commands.el (riece-command-toggle-others-buffer-mode): New
- command.
-
- * riece-layout.el (riece-configure-windows): Hide
- riece-others-buffer if riece-others-buffer-mode is nil.
-
- * riece-options.el (riece-saved-forms): Add
- riece-others-buffer-mode and riece-channel-list-buffer-mode.
- (riece-others-buffer-mode): New user option.
-
-2005-08-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-alternate-separator): Set to "@".
-
-2005-07-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-debug.el: Don't bind unused variable; prepend time to
- debug message.
-
-2005-07-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-guess-channel-from-unread): Return
- reversed copy of riece-unread-channels.
-
- * riece-server.el (riece-server-parse-string): Use
- string-to-number instead of string-to-int.
-
-2005-07-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-channel-buffer): Return nil when
- channel-buffer is killed.
-
- * riece-debug.el (riece-debug-1): New function.
- (riece-debug): Always return nil.
-
-2005-06-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-server-keyword-map): Add :coding-system-alist.
-
- * riece-irc.el (riece-irc-open-server): Init riece-coding-system-alist.
-
- * riece-handle.el (riece-handle-privmsg-message): Retry with the
- channel's coding-system if it differs from the server's
- coding-system.
-
- * riece-commands.el (riece-command-send-message): Pass prefix to
- riece-send-string.
-
- * riece-globals.el (riece-coding-system-alist): New variable.
-
- * riece-coding.el (riece-decode-coding-string-1): Split from
- riece-decode-coding-string; set riece-coding-encoded-string and
- riece-coding-decoded-coding-system properties on decoded string.
- (riece-retry-decode-coding-string): New function.
- (riece-decoded-coding-system): Use it.
-
-2005-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ruby.el: New file.
-
-2005-04-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-get-channels-on-server): New function.
- (riece-get-users-on-server): Don't use riece-user-p.
- (riece-get-identities-on-server): Call
- riece-get-channels-on-server and riece-get-users-on-server.
-
- * riece-identity.el (riece-completing-read-identity): Don't signal
- an error when input string does not match riece-channel-regexp nor
- riece-user-regexp.
-
- * riece-300.el (riece-handle-366-message): Don't use riece-user-regexp.
- (riece-handle-302-message): Ditto.
- (riece-handle-313-message): Ditto.
-
-2005-03-22 Daiki Ueno <ueno@unixuser.org>
-
- * rubyserv.rb: New file.
-
-2005-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-toolbar.el [XEmacs] (riece-make-toolbar-from-menu):
- Pick up toolbar icons from etc/riece/.
-
-2005-03-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-buffer-alist): Init riece-debug-buffer.
- (riece-submit-bug-report): Insert content of riece-debug-buffer.
-
- * riece-globals.el (riece-debug-buffer): New variable.
- * riece-filter.el (riece-sentinel): Use riece-debug.
- * riece-display.el (riece-channel-buffer-name): Use riece-debug.
- * riece-button.el (riece-identity-button-click): Use riece-debug.
- * riece-debug.el (riece-debug): New function.
- (riece-ignore-errors): Use it.
-
- * riece-filter.el (riece-filter): Removed (eobp) check.
-
-2005-03-06 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.8 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.8.
-
-2005-03-06 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-compile-modules): Print summary.
-
-2005-03-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-version.el: Bind emacs-program-version.
- * riece-debug.el: Require 'riece-options for riece-debug.
-
- * riece-log.el (riece-log-insinuate): Use user-uid instead of
- user-login-name and escape system-name for riece-log-lock-file.
-
-2005-03-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-log.el (riece-log-lock-file): Define with defvar.
- (riece-log-display-message-function): Use riece-log-lock-file as
- LOCKNAME of write-region.
- (riece-log-insinuate): Generate name for riece-log-lock-file.
-
-2005-02-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-300.el (riece-handle-317-message): Format idle seconds in
- human readable form.
- (riece-handle-301-message): Don't use riece-user-regexp.
- (riece-handle-311-message): Ditto.
- (riece-handle-312-message): Ditto.
- (riece-handle-317-message): Ditto.
- (riece-handle-319-message): Ditto.
-
- * riece-ctcp.el (riece-handle-ctcp-action-request): Prepend target.
- (riece-command-ctcp-action): Ditto.
-
-2005-02-25 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-globals.el (riece-obarray-size, riece-obarray): Abolish.
- (riece-channel-obarray-size, riece-user-obarray-size)
- (riece-channel-obaary, riece-user-obarray): New variables.
- * riece-user.el (riece-find-user, riece-forget-user)
- (riece-rename-user, riece-get-user): Use `riece-user-obarray'
- instead of `riece-user-obarray'.
- * riece-channel.el (riece-find-channel, riece-forget-channel)
- (riece-get-channel): Use `riece-channel-obarray' instead of
- `riece-obarray'.
- * riece-misc.el (riece-get-identities-on-server): Ditto.
- * riece-server.el (riece-reset-process-buffer): Ditto.
-
-2005-02-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-switch-to-channel-function):
- Clear riece-unread-channels case insensitively.
-
- * riece-300.el (riece-handle-353-message): Use
- riece-identity-assoc to pick an entry from
- riece-353-message-alist.
- (riece-handle-366-message): Ditto.
- Reported by Steve Youngs <steve@sxemacs.org>.
-
-2005-02-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-debug.el (riece-funcall-ignore-errors): New function.
- * riece-signal.el (riece-emit-signal): Use riece-funcall-ignore-errors.
- * riece-filter.el (riece-handle-numeric-reply): Use
- riece-funcall-ignore-errors.
- (riece-handle-message): Ditto.
- * riece-ctcp.el (riece-handle-ctcp-request): Use
- riece-funcall-ignore-errors.
-
-2005-02-18 Steve Youngs <steve@sxemacs.org>
-
- * riece-ctcp.el (riece-handle-ctcp-time-request): New.
- (riece-handle-ctcp-time-response): New.
- (riece-command-ctcp-time): New.
- (riece-ctcp-enable): Add `riece-command-ctcp-time'.
- (riece-ctcp-disable): Ditto.
-
- * riece-layout.el (riece-layout-alist): Minor doc string fix --
- escape a couple of parens.
-
- * riece-version.el: defvar sxemacs-codename at compile time.
- (riece-extended-version): Simplify the XEmacs section, add support
- for SXEmacs.
-
-2005-02-17 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-addon.el (riece-resolve-addons): Fixed
- avoid add directory to addons condition.
-
-2005-02-10 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-addon.el (riece-resolve-addons): Don't add directory to
- addons.
-
-2005-02-09 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-commands.el (riece-command-part): Fix argument.
-
-2005-02-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-filter): Simplified.
-
- * riece-addon.el (riece-resolve-addons): Check the existence of
- riece-addon-directory.
-
-2005-02-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-filter): Modified regexp.
-
-2005-02-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Clear riece-window-configuration frame
- parameter.
- * riece-commands.el (riece-command-suspend-resume): Don't attempt
- to restore window-configuration if the cdr of
- riece-window-configuration frame parameter is nil.
-
- * riece-filter.el (riece-chomp-string): New function.
- (riece-filter): Use it.
-
-2005-02-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.7 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.7.
-
-2005-02-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-keyword.el (riece-keyword-face): Change defface spec for tty.
-
- * riece-toolbar.el (riece-toolbar-description): New constant.
-
- * riece-keepalive.el: Require 'riece-options.
- (riece-keepalive-ping-repeat): Define with defcustom.
- (riece-keepalive-description): New constant.
-
- * riece.el (riece-dialogue-mode-map): Bind
- riece-command-suspend-resume.
- * riece-commands.el (riece-command-suspend-resume): New command.
-
- * riece-options.el (riece-addons): Enable riece-keyword by default.
-
- * riece-button.el (riece-identity-button-popup-menu): Changed
- interactivbe spect "@e" -> "e".
- (riece-identity-button-click): New function.
- (riece-make-identity-button-map): Bind riece-identity-button-click.
-
-2005-02-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-part-message): New user option.
- (riece-addons): Enable riece-alias and riece-ctlseq by default.
- (riece-max-buffer-size): Change the default value to nil.
-
- * riece-commands.el (riece-command-part): Use riece-part-message.
-
-2005-02-04 OHASHI Akira <bg66@koka-in.org>
-
- * riece-eval.el (riece-eval-form): New function.
- (riece-eval-display-message-function): Use it.
-
-2005-02-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-000.el (riece-handle-001-message): Use
- riece-command-join-channel to join startup channels.
-
- * riece-filter.el (riece-filter): Accept lines which end with LF.
-
- * riece-300.el (riece-353-message-alist): Renamed from riece-353-users.
- (riece-handle-353-message): Don't parse the reply.
- (riece-handle-366-message): Parse 353 replies here; count users.
-
- * riece-log.el (riece-log-enable): Add debug message.
-
- * riece-keepalive.el: New add-on.
- * COMPILE (riece-modules): Add riece-keepalive.
- * Makefile.am (EXTRA_DIST): Add riece-keepalive.el.
-
-2005-02-04 OHASHI Akira <bg66@koka-in.org>
-
- * riece-biff.el (riece-biff-functions): Abolish.
- (riece-biff-after-display-message-function): Follow the change above.
-
-2005-02-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-close-server-process): Switch to process
- buffer when running riece-after-close-hook.
-
- * COMPILE (riece-icons): Add all symbols from riece-toolbar-items.
-
- * Makefile.am (EXTRA_DIST): Add riece-command-previous-channel.xpm,
- riece-command-next-channel.xpm, and riece-submit-bug-report.xpm.
-
- * riece-menu.el (riece-menu-items): Add "Submit Bug Report".
-
- * riece-toolbar.el (riece-toolbar-items): Add riece-submit-bug-report.
-
- * riece-compat.el (riece-read-passwd): Changed default value.
-
- * riece-400.el (riece-handle-475-message): Don't bind inhibit-quit
- when reading channel key.
-
- * riece-irc.el (riece-irc-open-server): Don't bind inhibit-quit
- when reading password.
-
- * riece-compat.el (riece-read-passwd): Bind inhibit-quit.
-
- * riece-commands.el (riece-command-join): Abolished prefix-arg
- (channel key).
-
- * riece-options.el (riece-buffer-dispose-function): Changed the
- default value from bury-buffer to kill-buffer.
- * riece-log.el (riece-log-lock-directory): New user option.
- (riece-log-enable): Create lock directory.
- (riece-log-disable): Remove lock directory.
-
- * riece-addon.el (riece-resolve-addons): Don't use FILES-ONLY
- argument of directory-files.
-
-2005-02-04 OHASHI Akira <bg66@koka-in.org>
-
- * riece-google.el (riece-google-default-lang): Change value.
- (riece-google-display-message-function): Follow the change above.
-
-2005-02-03 OHASHI Akira <bg66@koka-in.org>
-
- * riece-google.el: New add-on.
- * COMPILE (riece-modules): Add riece-google.
- * Makefile.am (EXTRA_DIST): Add riece-google.el.
-
-2005-02-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-400.el (riece-handle-475-message): New handler; query
- channel key.
-
-2005-02-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-resolve-addon-dependencies): Rename from
- riece-resolve-addon.
- (riece-resolve-addon): Append add-ons under riece-addon-directory.
-
-2005-02-02 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-message.el (riece-display-message): When filter-function
- return nil, escape from while loop.
-
-2005-02-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-debug.el (riece-debug-standard-output-buffer): Use
- riece-temp-buffer.
- * riece.el: Add riece-temp-buffer.
- * riece-globals.el (riece-temp-buffer): New variable.
-
-2005-02-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-signal.el (riece-emit-signal): Use riece-ignore-errors.
-
- * riece-filter.el (riece-handle-numeric-reply): Use
- riece-ignore-errors.
- (riece-handle-message): Ditto.
-
- * riece-ctcp.el (riece-handle-ctcp-request): Use
- riece-ignore-errors.
- (riece-handle-ctcp-response): Ditto.
-
- * riece-debug.el: New file.
- * COMPILE (riece-modules): Add riece-debug.
- * Makefile.am (EXTRA_DIST): Add riece-debug.el.
-
-2005-02-02 OHASHI Akira <bg66@koka-in.org>
-
- * riece-eval.el (riece-eval-regexp): Fix regexp.
- (riece-eval-display-message-function): Follow the change above.
-
-2005-02-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-close-server-process): Run
- riece-after-close-hook.
-
- * riece-log.el (riece-log-insert): Bind file-name-coding-system
- and default-file-name-coding-system to nil.
-
-2005-02-01 OHASHI Akira <bg66@koka-in.org>
-
- * riece-eval.el: New add-on.
- * COMPILE (riece-modules): Add riece-eval.
- * Makefile.am (EXTRA_DIST): Add riece-eval.el.
-
-2005-01-30 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-display.el (riece-display-connect-signals): Check nick or
- channel, before call `riece-channel-get-users'.
-
-2004-12-15 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-addon.el (riece-command-enable-addon): Fixed.
- (riece-command-disable-addon): Ditto.
-
-2004-12-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-abbrev-identity-string): Return a
- copy of a string since text properties will be set on it.
- (riece-alias-expand-identity-string): Ditto.
-
- * riece-emacs.el (riece-normalize-modeline-string): Don't
- concatenate elements in modeline string.
-
-2004-12-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-update-channel-list-indicator):
- Normalize modeline indicator.
-
- * riece-xemacs.el (riece-normalize-modeline-string): New alias.
- * riece-emacs.el (riece-normalize-modeline-string): New function.
- (riece-normalize-modeline-string-1): New function.
-
-2004-12-13 Daiki Ueno <ueno@unixuser.org>
-
- * test/Makefile.am (EXTRA_DIST): Add test-riece.el.
- * test/test-riece.el: New test cases.
-
- * riece.el (riece-shrink-buffer): Fixed bug.
-
- * riece-options.el (riece-username): Changed the default value to
- user-full-name.
-
-2004-12-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-command-previous-channel.xpm: New file.
- * riece-command-next-channel.xpm: New file.
-
- * COMPILE (riece-icons): New variable.
- (riece-install-icons): New function.
- (riece-install): Install icons.
- (riece-install-package): Ditto.
-
-2004-12-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-addons): Add riece-toolbar.
-
- * riece-log.el (riece-log-flashback): Fixed regexp.
-
- * riece-menu.el (riece-menu-items): Add "Next Channel" and
- "Previous Channel".
-
- * riece-toolbar.el: Support XEmacs.
- (riece-toolbar-items): Renamed from
- riece-toolbar-item-list.
- (riece-tool-bar-local-item-from-menu): Abolished.
- (riece-toolbar-find-menu-item): New function.
- (riece-make-toolbar-from-menu): New function.
- (riece-set-toolbar): New function.
- (riece-toolbar-insinuate-in-command-buffer): Use them.
-
-2004-12-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-toolbar.el: New add-on.
- * COMPILE (riece-modules): Add riece-toolbar.
- * Makefile.am (EXTRA_DIST): Add riece-toolbar.el.
-
-2004-12-10 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-log.el
- (test-riece-log-display-message-function): "yes" -> "true".
-
- * test/Makefile.am (EXTRA_DIST): Add lunit-report.el and
- test-riece-log.el.
-
-2004-12-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-shrink-buffer): Shrink buffer based on chars
- instead of lines.
-
- * riece-options.el (riece-shrink-buffer-remove-chars): New user option.
- (riece-shrink-buffer-remove-lines): Abolish.
-
-2004-12-08 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-log.el (test-riece-log-delete-directory):
- Suppress file-name encoding.
-
- * riece-log.el (riece-log-get-directory): Fixed bug in
- riece-log-directory-map handling.
-
- * test/test-riece-log.el
- (test-riece-log-display-message-function): New test case.
-
-2004-12-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-log.el (riece-log-flashback): Fixed custom spec.
- (riece-log-date-face): New face.
- (riece-log-insert): Don't append date string to the end of log
- lines if they arrived today.
- (riece-log-flashback): Insert "Recent messages ...:"; call
- riece-after-insert-functions.
-
- * riece-handle.el (riece-handle-part-message): Call riece-naming
- assert-part after inserting changes in channel buffers.
- * riece-display.el (riece-part-channel): Call
- riece-buffer-dispose-function on parted channel buffer.
-
-2004-12-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-log.el (riece-log-display-message-function): Suppress
- further file-name encoding.
-
-2004-12-07 Daiki Ueno <ueno@unixuser.org>
-
- * test/lunit-report.el: New file split from lunit.el.
-
- * riece-options.el (riece-addons): Add 'riece-log.
-
- * test/test-riece-log.el (lunit-test-case-setup): #riece -> =23riece.
-
- * riece-log.el (riece-log-insert): Renamed from
- riece-log-flashback-1; simplified.
- (riece-log-get-files): Check existence of directory.
- (riece-log-get-directory): New implementation.
- [cf. <Liece:00396>]
-
-2004-12-07 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-foolproof.el (riece-foolproof-command-send-message-function):
- Check invisible text.
-
-2004-12-07 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-log.el (test-riece-log-encode-file-name): New
- test case.
- (test-riece-log-encode-file-name-mule): New test case.
- (test-riece-log-decode-file-name): New test case.
- (test-riece-log-decode-file-name-mule): New test case.
-
- * riece-log.el (riece-log-file-name-coding-system): New user option.
- (riece-log-encode-file-name): New function.
- (riece-log-decode-file-name): New function.
-
-2004-12-06 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-log.el: New test cases.
-
- * riece-log.el: Collect logs across dates.
- (riece-log-get-files): New function.
- (riece-log-flashback-1): New function.
- (riece-log-flashback): Use it.
-
-2004-12-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-message.el (riece-display-message-1): Call
- riece-after-display-message-functions in riece-message-buffer.
- [cf. <Liece:00391>]
-
-2004-12-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.6 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.6.
-
-2004-12-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-update-channel-status-indicator): Fixed typo.
-
-2004-11-28 Daiki Ueno <ueno@unixuser.org>
-
- * test/lunit.el (lunit-report): Accept output filename as the 2nd arg.
- * Makefile.am (check-local): Supply riece-test with output filename.
- * COMPILE (riece-test): Supply lunit-report with output filename.
-
- * test/lunit.el: Require 'pp.
- (lunit-escape-quote): Rename from lunit-test-reporter-format-sexp.
- (lunit-report): Add "emacs-version" property.
-
-2004-11-28 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-test): Use lunit-report instead of lunit.
-
- * test/lunit.el: Report test result as XML.
- (lunit-time-since): New function.
- (lunit-test-reporter): New test-listener.
- (lunit-test-reporter-format-sexp): New function.
- (lunit-report): New function.
-
-2004-11-27 Daiki Ueno <ueno@unixuser.org>
-
- * test/lunit.el: Update copyright year.
- (lunit-test-result-run): Fixed the argument of
- lunit-test-listener-error listener.
-
-2004-11-26 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-test): Require 'lunit after when ./test is added
- to load-path.
-
- * test/test-riece-yank.el (test-riece-yank-strip-space): Use
- lunit-assert-2 instead of lunit-assert.
-
- * test/test-riece-url.el (test-riece-url-replace-match): Use
- lunit-assert-2 instead of lunit-assert.
- (test-riece-url-regexp-alist): Ditto.
-
- * test/test-riece-alias.el (test-riece-alias-percent-hack): Use
- lunit-assert-2 instead of lunit-assert.
- (test-riece-alias-alist-1): Ditto.
- (test-riece-alias-alist-2): Ditto.
- (test-riece-alias-altsep-1): Ditto.
- (test-riece-alias-altsep-2): Ditto.
- (test-riece-alias-altsep-3): Ditto.
- (test-riece-alias-altsep-4): Ditto.
-
- * test/test-riece-addon.el (test-riece-resolve-addons-1): Use
- lunit-assert-2 instead of lunit-assert.
- (test-riece-resolve-addons-2): Ditto.
-
- * test/lunit.el: Count assertions in test-case methods.
- (lunit-test-result): Add assert-count slot.
- (lunit-make-test-result): Reset assert-count to 0.
- (lunit-test-result-run): Count assertions.
- (lunit-test-result-failure): Abolished.
- (lunit-test-case): Add assert-count slot; define internal
- accesssors for them.
- (lunit-make-test-case): Reset assert-count to 0.
- (lunit-assert-2): New macro.
- (lunit): Display assertion count.
-
-2004-11-25 Daiki Ueno <ueno@unixuser.org>
-
- * Makefile.am (EXTRA_DIST): Add url-riece.el.
- * url-riece.el: url-irc backend provided by Masatake YAMATO
- <jet@gyve.org>.
- [cf. <Liece:00373>]
-
-2004-11-25 Daiki Ueno <ueno@unixuser.org>
-
- * test/Makefile.am (EXTRA_DIST): Add test-riece-url.el.
- * test/test-riece-url.el: New test cases.
-
- * riece-url.el (riece-url-regexp-alist): Backport from Liece 2.0.
- (riece-url-replace-match): New function.
- (riece-url-scan-region): Handle riece-url-regexp-alist.
-
-2004-11-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-server-properties): New function.
-
-2004-11-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-update-status-indicators): Format
- riece-user-indicator as an identity.
-
-2004-11-22 Daiki Ueno <ueno@unixuser.org>
-
- * test/test-riece-alias.el (test-riece-alias-alist-1): New test case.
- (test-riece-alias-alist-2): New test case.
-
- * riece-alias.el (riece-alias-abbrev-identity-string): Fixed
- riece-alias-alist handling.
- (riece-alias-expand-identity-string): Ditto.
-
-2004-11-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-shrink-buffer-remove-lines): New user option.
- * riece.el (riece-shrink-buffer): Remove lines specified by
- riece-shrink-buffer-remove-lines at a time.
-
-2004-11-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece): Remove nonexistent buffer from
- riece-buffer-list when running riece-shrink-buffer.
-
-2004-11-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-update-buffers): Check existence of each
- buffer in riece-buffer-list.
- * riece.el (riece): Ditto.
-
-2004-11-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el: Bind reporter-prompt-for-summary-p.
-
-2004-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-submit-bug-report): Query VERSION.
-
-2004-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-submit-bug-report): Query CTCP VERSION before
- inspecting *IRC* buffer.
-
-2004-11-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-submit-bug-report): use
- riece-server-process-opened instead of process-live-p.
-
- * riece-server.el (riece-flush-send-queue): Use
- riece-server-process-opened instead of process-live-p.
-
- * riece-yank.el (riece-yank-strip-space): Bind space-width.
-
- * riece-xemacs.el (riece-recent-messages): New function.
- * riece-emacs.el (riece-recent-messages): New function.
- * riece.el (riece-submit-bug-report): Use riece-recent-messages
- instead of (with-output-string (print-recent-messages ...)).
-
-2004-11-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-submit-bug-report): New command.
-
-2004-11-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-insert): Don't bind unused variable `buffer'.
-
-2004-11-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece-300.el (riece-handle-302-message): Don't expect leading
- ":" before parameter list.
- (riece-handle-301-message): Ditto.
- (riece-handle-311-message): Ditto.
- (riece-handle-312-message): Ditto.
- (riece-handle-317-message): Ditto.
- (riece-handle-319-message): Ditto.
- (riece-handle-351-message): Ditto.
- (riece-handle-353-message): Ditto.
- (riece-handle-322-message): Ditto.
- (riece-handle-set-topic): Ditto.
- (riece-handle-366-message): Ditto.
-
-2004-11-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Reset riece-channel-status-indicator.
- (riece-command-mode): Display riece-channel-status-indicator.
- (riece-dialogue-mode): Ditto.
- (riece-channel-mode): Ditto.
-
- * riece-display.el (riece-update-channel-status-indicator): New
- function.
- (riece-update-indicator-functions): Add it.
-
- * riece-globals.el (riece-channel-status-indicator): New indicator.
-
-2004-11-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-select-keys): Bind
- riece-command-switch-to-channel-by-number to "#".
-
-2004-11-11 Masatake YAMATO <jet@gyve.org>
-
- * riece-yank.el (riece-command-yank): Fix a typo in comments.
-
-2004-11-09 OHASHI Akira <bg66@koka-in.org>
-
- * riece-yank.el (riece-command-yank): Take a 1st argument to send
- messages as notice.
-
-2004-11-07 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.5 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.5.
-
-2004-11-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-yank.el (riece-yank-strip-space): New function split from
- riece-command-yank.
- * test/test-riece-addon.el: New test cases.
- * test/test-riece-yank.el: New test cases.
-
-2004-11-05 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-test): New function.
- * Makefile.am (check-local): New target.
- * test/luna.el: New file.
- * test/lunit.el: New file.
- * test/test-riece-alias.el: New test cases.
-
-2004-11-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-alternate-separator): New user
- option.
- (riece-alias-use-atmark): Abolished.
- (riece-alias-escape-alternate-separator): Renamed from
- riece-alias-escape-atmark; use riece-alias-alternate-separator
- instead of hard-coded "@".
- (riece-alias-abbrev-alternate-separator): Renamed from
- riece-alias-abbrev-atmark; use riece-alias-alternate-separator
- instead of hard-coded "@".
- (riece-alias-expand-alternate-separator): Renamed from
- riece-alias-expand-atmark; use riece-alias-alternate-separator
- instead of hard-coded "@".
-
-2004-11-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-abbrev-atmark): Don't append "@" to
- a channel on default server.
-
-2004-11-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-alias.el (riece-alias-use-atmark): New user option. If
- this option enabled, atmark "@" will be used to separate prefix
- and server. (e.g. "#riece@server")
- (riece-alias-escape-atmark): New function.
- (riece-alias-abbrev-atmark): New function.
- (riece-alias-expand-atmark): New function.
- (riece-alias-abbrev-identity-string): Call
- riece-alias-abbrev-atmark.
- (riece-alias-expand-identity-string): Call
- riece-alias-expand-atmark.
-
- * riece-rdcc.el (riece-rdcc-block-size): Changed default value to
- 1024 due to the DCC specification.
- (riece-rdcc-send-program): Wait ack from a recipient.
- (riece-rdcc-filter): Send ack each time data arrives.
-
-2004-10-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-yank.el (riece-yank-strip-space): New user option.
- (riece-command-yank): Strip spaces if riece-yank-strip-space is
- non-nil.
-
-2004-10-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-yank.el: New add-on from Masatake YAMATO <jet@gyve.org>.
- * COMPILE (riece-modules): Add riece-yank.
- * Makefile.am (EXTRA_DIST): Add riece-yank.el.
-
-2004-10-11 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.4 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.4.
-
-2004-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece): Scan riece-startup-channel-list and open servers.
-
-2004-09-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-send-delay): Set default to 2.
-
- * riece-server.el (riece-make-queue): New function.
- (riece-queue-enqueue): New function.
- (riece-queue-dequeue): New function.
- (riece-queue-empty): New function.
- (riece-flush-send-queue): Use a queue object; check the process
- is active.
-
-2004-09-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el: Implement flood protection.
- (riece-flush-send-queue): New function.
- (riece-process-send-string): Use it.
- (riece-reset-process-buffer): Reset riece-send-queue,
- riece-send-size, and riece-last-send-time.
- (riece-seconds-to-time): New function.
- (riece-time-less-p): New function.
- (riece-time-since): New function.
- * riece-options.el (riece-max-send-size): New user option.
- (riece-send-delay): New user option.
- * riece-globals.el (riece-send-queue): New variable.
- (riece-send-size): New variable.
-
-2004-09-14 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-flashback): Run riece-button-update-buffer
- only when riece-button is enabled.
-
- * riece-mini.el: Require 'riece-biff.
- (riece-mini-requires): New function.
- (riece-mini-show-backlog): Run riece-biff-clear when riece-biff is
- enabled.
-
-2004-09-13 OHASHI Akira <bg66@koka-in.org>
-
- * riece-mini.el (riece-mini-show-backlog): Fix for long messages.
- (riece-mini-backlog-size): Change default value.
-
-2004-09-12 OHASHI Akira <bg66@koka-in.org>
-
- * riece-mini.el (riece-mini-show-backlog): Protect 1st arg of
- `riece-mini-message-no-log'.
-
-2004-09-11 OHASHI Akira <bg66@koka-in.org>
-
- * riece-mini.el (riece-mini-display-message-function): Remove
- properties and "\n" of the end.
- (riece-mini-show-backlog): Follow the change above.
- (riece-mini-display-message-function): Save the history always.
-
-2004-09-10 OHASHI Akira <bg66@koka-in.org>
-
- * riece-mini.el (riece-mini-display-message-function): Don't use
- cl macro.
- (riece-mini-show-backlog): Follow the change above.
-
- * riece-mini.el (riece-mini): New group.
- (riece-mini-backlog-size): New user option.
- (riece-mini-backlog-history): New internal variable.
- (riece-mini-backlog-shown): Ditto.
- (riece-mini-show-backlog): New function.
- (riece-mini-pre-command): Ditto.
- (riece-mini-display-message-function): Use them.
- (riece-mini-insinuate): Ditto.
-
- * riece-biff.el (toplevel): Remove eval-when-compile.
- * riece-log.el (toplevel): Ditto.
- * riece-mini.el (toplevel): Ditto.
-
-2004-09-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.3 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.3.
-
-2004-09-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-naming.el (riece-naming-assert-channel-users): Remove
- nonexistent users.
- * riece-300.el (riece-353-users): New variable.
- (riece-handle-353-message): Don't update user-list.
- (riece-handle-366-message): Update user-list here.
-
- * riece-channel.el (riece-channel-toggle-operator): Don't add ?o
- if it already appears in user's mode.
- (riece-channel-toggle-speaker): Don't add ?v if it already appears
- in user's mode.
-
-2004-08-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-command-mode): Set truncate-lines to nil.
- (riece-dialogue-mode): Ditto.
- (riece-channel-list-mode): Make
- truncate-partial-width-windows local to channel buffers and set it
- to nil.
- (riece-user-list-mode): Ditto.
-
-2004-08-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-dialogue-mode): Make
- truncate-partial-width-windows local to channel buffers and set it
- to nil.
- (riece-command-mode): Ditto.
-
- * riece-layout.el (riece-configure-windows): Don't affect
- truncate-partial-width-windows.
- (riece-configure-windows-top): Ditto.
- * riece-options.el (riece-truncate-partial-width-windows):
- Abolished unused user option.
-
-2004-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-window-center-line): New user option.
- * riece-misc.el (riece-insert): Check if the current point is not
- visible in the window.
-
-2004-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-insert): Don't use 2nd argument WINDOW of
- recenter since it is not supported by GNU Emacs.
-
-2004-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-insert): Use (recenter -1) to set window
- point instead of doing so manually.
-
-2004-08-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xemacs.el (riece-put-text-property-nonsticky): New function.
- * riece-emacs.el (riece-put-text-property-nonsticky): New function.
- * riece-identity.el (riece-format-identity): Use it instead of
- put-text-property.
-
-2004-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-complete-user): Move point to
- the end of the current word.
-
-2004-08-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-irc.el (riece-irc-open-server): Display error message if
- connection-function fails.
- * riece-server.el (riece-open-server): Ignore errors from
- riece-*-open-server function.
- * riece.el (riece): If no server process is available, exit
- immediately.
-
-2004-08-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-handle-quit-message): Pass
- riece-part-channel the identity object of the quitting user
- instead of his name.
-
-2004-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-highlight-server-match): Simplified.
-
-2004-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.2 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.2.
-
-2004-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-highlight-server-match): New match
- function for font-lock-keywords to highlight "(from XXX)" only if
- 'riece-server-name property is set.
- (riece-dialogue-font-lock-keywords): Use it.
-
-2004-08-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-handle-nick-message): Remove nil from
- channel buffers.
- (riece-handle-quit-message): Ditto.
- (riece-handle-kill-message): Ditto.
-
- * riece-misc.el (riece-concat-server-name): Put 'riece-server-name
- property on "(from XXX)".
-
-2004-07-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-menu.el: Do not support enable/disable addon since
- easy-menu-remove is not working.
-
-2004-07-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-open-server): Call protocol interface.
- (riece-quit-server-process): Ditto.
-
- * riece-options.el (riece-protocol): New user option.
-
- * riece-server.el: Don't require 'riece-filter.
-
- * riece-irc.el: New file split from riece-server.el.
- * COMPILE (riece-modules): Add riece-irc.
- * Makefile.am (EXTRA_DIST): Add riece-irc.el.
-
-2004-07-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el: Don't require 'riece-filter.
- * riece-server.el: Require 'riece-filter.
-
- * riece-500.el: Autoload riece-default-handle-numeric-reply from
- "riece-handle".
- * riece-400.el: Autoload riece-default-handle-numeric-reply from
- "riece-handle".
- * riece-300.el: Don't require 'riece-filter; autoload
- riece-default-handle-numeric-reply from "riece-handle".
- * riece-200.el: Autoload riece-default-handle-numeric-reply from
- "riece-handle".
- * riece-000.el: Don't require 'riece-filter; autoload
- riece-default-handle-numeric-reply from "riece-handle".
-
- * riece-filter.el (riece-filter): Simplified.
-
- * riece-server.el (riece-server-keyword-map): Add :protocol.
-
- * riece-handle.el (riece-300): Require 'riece-000, 'riece-200,
- 'riece-300, 'riece-400, and 'riece-500.
- (riece-default-handle-numeric-reply): Moved from riece-filter.el.
- * riece-filter.el (riece-handle-numeric-reply): Don't load
- riece-{000,200,300,400,500}.el on demand.
-
-2004-07-10 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.1 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.1.
-
-2004-07-09 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ignore.el (riece-startup-ignored-user-list): New user
- option.
- (riece-ignore-insinuate): Add identity objects from
- riece-startup-ignored-user-list to riece-ignored-user-list.
-
-2004-07-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-enter-message-to-user): Signal
- "No text to send" error if user attempt to call this command on
- an empty line.
-
-2004-07-04 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-commands.el (riece-command-complete-user): current-word
- can return nil (follow the change in emacs-cvs).
-
-2004-07-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Clear signal-slots.
- * riece-signal.el (riece-clear-signal-slots): New function.
-
-2004-06-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-split-parameters): Fixed parenthesis.
-
-2004-06-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-change-mode): Don't send ":".
- [cf. <Liece:00191>]
-
-2004-06-18 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-display.el (riece-update-long-channel-indicator): Change
- order to channel, mode, topic.
-
- * riece-message.el (riece-message-make-open-bracket): Come in
- first notice message.
- (riece-message-make-close-bracket): Ditto.
-
-2004-06-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-beginning-of-buffer): New command.
- * riece.el (riece-dialogue-mode-map): Bind beginning-of-buffer to Home.
- (riece-command-map): Bind riece-command-beginning-of-buffer to Home.
-
-2004-06-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-dialogue-mode-map): Bind end-of-buffer to End.
- (riece-command-map): Bind riece-command-end-of-buffer to End.
-
-2004-06-12 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-commands.el (riece-command-send-message): Run
- riece-command-send-message-hook.
-
- * riece-foolproof.el (riece-foolproof-dmacro-override): Removed.
- (riece-foolproof-command-send-message-function): New function.
- (riece-foolproof-insinuate): Use hook instead of advice.
- (riece-foolproof-enable, riece-foolproof-disable): Simplified.
-
-2004-06-11 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-foolproof.el (riece-foolproof-dmacro-override): New
- function.
- (riece-foolproof-insinuate): Check keyboard macro.
-
-2004-06-10 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-foolproof.el: New add-on.
- * COMPILE (riece-modules): Add riece-foolproof.
- * Makefile.am (EXTRA_DIST): Add riece-foolproof.el.
-
-2004-06-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-change-mode): Don't send ":" to
- query a channel mode.
- * riece-mode.el (riece-parse-modes): Accept mode spec not
- delimited with " " such as "-n+s".
-
-2004-06-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece-layout.el (riece-set-window-points): Restore window-point
- of the channel buffer from riece-channel-buffer-window-point.
-
- * riece-display.el (riece-switch-to-channel): Set
- riece-channel-buffer-window-point.
-
- * riece.el (riece-channel-mode): Make
- riece-channel-buffer-window-point buffer local.
-
- * riece-globals.el (riece-channel-buffer-window-point): New variable.
-
-2004-06-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-command-dcc-send): Replace whitespace with
- "_".
- (riece-command-dcc-receive): Convert default filename with
- convert-standard-filename.
- (riece-handle-dcc-request): Handle filenames enclosed with "...".
-
-2004-06-04 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-hangman.el (riece-hangman-word): Check killed-buffer or
- not. Fix random number generation logic.
-
-2004-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-open-server): When password input is
- quitted, delete the current server process manually.
- (riece-close-server-process): Always kill process buffer.
- (riece-quit-server-process): If the connection is timed out,
- delete the current server process manually.
-
-2004-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el: Use riece-facep to check existence of
- 'riece-modeline-unread-face.
- * riece-history.el: Use riece-facep to check existence of
- 'riece-modeline-history-face.
- * riece-highlight.el: Use riece-facep to check existence of
- 'riece-modeline-current-face.
-
- * riece-xemacs.el (riece-facep): Define as an alias of 'find-face.
- * riece-emacs.el (riece-facep): Define as an alias of 'facep.
-
-2004-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-button.el (riece-button-disable): On XEmacs, BUFFER arg of
- widget-map-buttons is ignored.
-
-2004-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-modeline-unread-face): New face;
- setup the properties are inherited from 'modeline.
- * riece-history.el (riece-modeline-history-face): New face;
- setup the properties are inherited from 'modeline.
- * riece-highlight.el (riece-modeline-current-face): New face;
- setup the properties are inherited from 'modeline.
-
- * riece-server.el (riece-close-server-process): Reset
- process-filter/process-sentinel.
-
-2004-05-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece-hangman.el (riece-hangman-after-privmsg-hook): Display answer.
- (riece-hangman-enable): Initialize random seed.
-
-2004-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 1.0.0 released.
- * riece-version.el (riece-version-number): Bump up to 1.0.0.
-
-2004-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-finger): Complete user names
- without server-name.
- (riece-command-invite): Ditto.
- (riece-command-change-mode): Ditto.
- (riece-command-enter-message-to-user): Ditto.
-
- * riece-identity.el (riece-completing-read-identity): Add extra
- 8th arg "no-server".
-
-2004-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el: Move autoload setting for 'riece-exit before
- riece-open-server.
-
- * riece-message.el (riece-format-message): Use speaker's
- server-name instead of the current server-name.
-
- * riece-ignore.el: Autoload 'riece-dialogue-mode.
-
- * riece-identity.el (riece-format-identity): Put
- 'riece-format-identity-prefix-only property.
-
- * riece-icon.el: Require 'riece-globals and 'riece-signal.
-
- * riece-history.el: Require 'riece-signal.
-
- * riece-highlight.el: Require 'riece-misc.
-
- * riece-alias.el: Require 'riece-signal.
-
- * riece-addon.el: Require 'font-lock, 'riece-options,
- 'riece-compat, and 'riece-misc.
-
-2004-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-switch-to-channel): Change prompt.
- (riece-command-switch-to-channel-by-number): Ditto.
- (riece-command-change-layout): Ditto.
- (riece-command-finger): Ditto.
- (riece-command-topic): Ditto.
- (riece-command-invite): Ditto.
- (riece-command-kick): Ditto.
- (riece-command-names): Ditto.
- (riece-command-who): Ditto.
- (riece-command-list): Ditto.
- (riece-command-change-mode): Ditto.
- (riece-command-set-operators): Ditto.
- (riece-command-set-speakers): Ditto.
- (riece-command-enter-message-to-user): Ditto.
- (riece-command-join): Ditto.
- (riece-command-part): Ditto.
- (riece-command-open-server): Ditto.
- (riece-command-close-server): Ditto.
-
-2004-05-28 OHASHI Akira <bg66@koka-in.org>
-
- * riece-biff.el (riece-biff-insinuate): Add riece-biff-disable to
- riece-exit-hook.
-
-2004-05-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-message.el (riece-message-set-speaker): New function.
- (riece-message-set-target): New function.
- (riece-message-set-text): New function.
- (riece-message-set-type): New function.
- (riece-message-set-own-p): New function.
-
- * riece-kakasi.el: New add-on.
- * COMPILE (riece-modules): Add riece-kakasi.
- * Makefile.am (EXTRA_DIST): Add riece-kakasi.el.
-
-2004-05-27 OHASHI Akira <bg66@koka-in.org>
-
- * riece-biff.el: New add-on.
- * COMPILE (riece-modules): Add riece-biff.
- * Makefile.am (EXTRA_DIST): Add riece-biff.el.
-
-2004-05-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Don't disable addons.
-
- * riece-commands.el (riece-command-quit): Don't query user to
- input y/n if there is no server process.
-
-2004-05-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el: Require 'derived.
- (riece-highlight-setup-dialogue): Turn on font-lock if
- riece-highlight-enabled.
- (riece-highlight-setup-channel-list): Ditto.
-
-2004-05-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-list-addons): Sort add-ons.
-
-2004-05-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-menu.el: Don't put 'riece-addon-default-disabled property.
-
- * riece-log.el (riece-log-flashback): Don't check riece-log-enabled.
-
- * riece.el (riece): Enable add-ons after startup.
-
-2004-05-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-disable): Reset riece-unread-channels.
-
-2004-05-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-message.el (riece-format-message): Don't append
- server-name if the 2nd arg is not specified.
-
- * riece-hangman.el (riece-hangman-word): Fixed regexp.
-
-2004-05-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xface.el: Support enable/disable.
- (riece-xface-enabled): New flag.
- (riece-xface-description): New variable.
- (riece-xface-update-user-list-buffer): Check riece-xface-enabled.
- (riece-xface-enable): New function.
- (riece-xface-disable): New function.
-
- * riece-url.el: Support enable/disable.
- (riece-url-enabled): New flag.
- (riece-url-description): New variable.
- (riece-url-enable): New function; bind command keys here.
- (riece-url-disable): New function.
-
- * riece-unread.el: Support enable/disable.
- (riece-unread-enabled): New flag.
- (riece-unread-description): New variable.
- (riece-unread-after-display-message-function): Check
- riece-unread-enabled.
- (riece-unread-after-switch-to-channel-function): Ditto.
- (riece-unread-format-identity-for-channel-list-buffer): Ditto.
- (riece-unread-format-identity-for-channel-list-indicator): Ditto.
- (riece-unread-enable): New function; bind command keys here.
- (riece-unread-disable): New function.
-
- * riece-rdcc.el: Support enable/disable.
- (riece-rdcc-enabled): New flag.
- (riece-rdcc-description): New variable.
- (riece-handle-dcc-request): Check riece-rdcc-enabled.
- (riece-rdcc-enable): New function; bind command keys here.
- (riece-rdcc-disable): New function.
-
- * riece-ndcc.el: Support enable/disable.
- (riece-ndcc-enabled): New flag.
- (riece-ndcc-description): New variable.
- (riece-handle-dcc-request): Check riece-ndcc-enabled.
- (riece-ndcc-enable): New function; bind command keys here.
- (riece-ndcc-disable): New function.
-
- * riece-menu.el: Support enable/disable; put
- riece-addon-default-disabled property.
- (riece-menu-enabled): New flag.
- (riece-menu-description): New variable.
- (riece-menu-enable): New function.
- (riece-menu-disable): New function.
-
- * riece-lsdb.el: Support enable/disable.
- (riece-lsdb-enabled): New flag.
- (riece-lsdb-description): New variable.
- (riece-lsdb-enable): New function; bind command keys here.
- (riece-lsdb-disable): New function.
-
- * riece-keyword.el: Support enable/disable.
- (riece-keyword-enabled): New flag.
- (riece-keyword-description): New variable.
- (riece-keyword-message-filter): Check riece-keyword-enabled.
- (riece-keyword-enable): New function.
- (riece-keyword-disable): New function.
-
- * riece-ignore.el: Support enable/disable.
- (riece-ignore-enabled): New flag.
- (riece-ignore-description): New variable.
- (riece-ignore-message-filter): Check riece-ignore-enabled.
- (riece-ignore-enable): New function; bind command keys here.
- (riece-ignore-disable): New function.
-
- * riece-icon.el: Support enable/disable.
- (riece-icon-enabled): New flag.
- (riece-icon-description): New variable.
- (riece-icon-update-user-list-buffer): Check riece-icon-enabled.
- (riece-icon-update-channel-list-buffer): Check riece-icon-enabled.
- (riece-icon-enable): New function.
- (riece-icon-disable): New function.
-
- * riece-history.el: Support enable/disable.
- (riece-history-enabled): New flag.
- (riece-history-description): New variable.
- (riece-history-format-identity-for-channel-list-buffer): Check
- riece-history-enabled.
- (riece-history-format-identity-for-channel-list-indicator): Ditto.
- (riece-history-enable): New function.
- (riece-history-disable): New function.
-
- * riece-hangman.el: Support enable/disable; put
- riece-addon-default-disabled property.
- (riece-hangman-enabled): New flag.
- (riece-hangman-description): New variable.
- (riece-hangman-after-privmsg-hook): Check riece-hangman-enabled.
- (riece-hangman-enable): New function.
- (riece-hangman-disable): New function.
-
- * riece-guess.el: Support enable/disable.
- (riece-guess-enabled): New flag.
- (riece-guess-description): New variable.
- (riece-guess-insinuate): Nothing to do.
- (riece-guess-enable): New function; bind command keys here.
- (riece-guess-disable): New function.
-
- * riece-doctor.el: Support enable/disable; put
- 'riece-addon-default-disabled property.
- (riece-doctor-enabled): New flag.
- (riece-doctor-description): New variable.
- (riece-doctor-after-privmsg-hook): Check riece-doctor-enabled.
- (riece-doctor-enable): New function.
- (riece-doctor-disable): New function.
-
- * riece-ctlseq.el: Support enable/disable.
- (riece-ctlseq-enabled): New flag.
- (riece-ctlseq-description): New variable.
- (riece-ctlseq-message-filter): Check riece-ctlseq-enabled.
- (riece-ctlseq-enable): New function.
- (riece-ctlseq-disable): New function.
-
- * riece-button.el: Support enable/disable.
- (riece-button-enabled): New flag
- (riece-button-description): New variable.
- (riece-button-enable): New function.
- (riece-button-disable): New function.
-
- * riece-async.el (riece-async-description): New variable.
-
- * riece-alias.el: Support enable/disable.
- (riece-alias-enabled): New flag.
- (riece-alias-description): New variable.
- (riece-alias-insinuate): Nothing to do.
- (riece-alias-enable): New function.
- (riece-alias-disable): New function.
-
- * riece-addon.el (riece-addon-list-mark-face-alist): Change mark
- for addons which does not support enable/disable.
- (riece-addon-list-font-lock-keywords): Follow the above change.
- (riece-command-list-addons): Ditto.
-
- * riece.el (riece): Check 'riece-addon-default-disabled property.
- (riece-exit): Disable addons.
-
-2004-05-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-addon-list-mode): Call font-lock-set-defaults.
-
- * riece-highlight.el (riece-highlight-setup-dialogue): Call
- font-lock-set-defaults.
- (riece-highlight-setup-channel-list): Ditto.
-
- * riece.el (riece): Enable add-ons after startup.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-dialogue-mode-map): Bind
- riece-command-list-addons as "^".
-
-2004-05-21 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-skk-kakutei.el (riece-skk-kakutei-enabled): New flag.
- (riece-skk-kakutei-description): New variable.
- (riece-skk-kakutei-insinuate): Nothing to do.
- (riece-skk-kakutei-enable): New function.
- (riece-skk-kakutei-disable): New function.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-highlight-setup-dialogue): Simplified.
- (riece-highlight-setup-channel-list): Simplified.
-
- * riece.el (riece): Enable add-ons just after insinuate them.
-
- * riece-addon.el (riece-addon-list-enabled-face): New face.
- (riece-addon-list-disabled-face): New face.
- (riece-addon-list-unsupported-face): New face.
- (riece-addon-list-unknown-face): New face.
- (riece-addon-list-description-face): New face.
- (riece-addon-list-mark-face-alist): New user option.
- (riece-addon-list-font-lock-keywords): New variable.
- (riece-addon-list-mode-map): Bind some keys.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-insinuate-addon): Add optional 2nd
- argument `verbose'
- (riece-enable-addon): Ditto.
- (riece-disable-addon): Ditto.
- (riece-command-enable-addon): Call riece-enable-addon with the 2nd
- arg.
- (riece-command-disable-addon): Call riece-disable-addon with the
- 2nd arg.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-addon.el (riece-command-list-addons): Change "no
- description" -> "(no description)"; show key bindings.
-
- * riece-ctcp.el (riece-ctcp-description): New variable.
- * riece-highlight.el (riece-highlight-description): New variable
- * riece-log.el (riece-log-description): New variable.
- * riece-mini.el (riece-mini-description): New variable.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-ctcp-enable): Fixed typo.
-
- * riece-addon.el (riece-addon-list-mode-map): New keymap.
- (riece-addon-list-mode): New function.
- (riece-command-list-addons): New command.
- (riece-command-enable-addon): New command.
- (riece-command-disable-addon): New command.
- (riece-disable-addon): Fixed typo.
-
-2004-05-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mini.el (riece-mini-enabled): New flag.
- (riece-mini-display-message-function): Check riece-mini-enabled.
- (riece-mini-enable): New function.
- (riece-mini-disable): New function.
-
- * riece-log.el (riece-log-enabled): New flag.
- (riece-log-display-message-function): Check riece-log-enabled.
- (riece-log-insinuate): Don't bind command key.
- (riece-log-enable): New function.
- (riece-log-disable): New function.
-
- * riece-highlight.el (riece-highlight-enabled): New flag.
- (riece-highlight-setup-dialogue): Renamed from
- riece-dialogue-turn-on-font-lock; don't call turn-on-font-lock.
- (riece-highlight-setup-channel-list): Renamed from
- riece-channel-list-turn-on-font-lock; don't call
- turn-on-font-lock.
- (riece-highlight-hide-prefix): Renamed from
- riece-dialogue-hide-prefix.
- (riece-highlight-put-overlay-faces): Renamed from
- riece-put-overlay-faces; check riece-highlight-enabled.
- (riece-highlight-format-identity-for-channel-list-indicator):
- Check riece-highlight-enabled.
- (riece-highlight-insinuate): Follow the name changes.
- (riece-highlight-enable): New function.
- (riece-highlight-disable): New function.
-
- * riece-ctcp.el (riece-ctcp-enabled): New flag.
- (riece-ctcp-insinuate): Don't bind command keys.
- (riece-ctcp-enable): New function.
- (riece-ctcp-disable): New function.
- (riece-handle-ctcp-request): Check riece-ctcp-enabled.
- (riece-handle-ctcp-response): Ditto.
-
- * riece.el: Moved add-on arrangement code to riece-addon.el.
- (riece-addons-insinuated): New flag.
- (riece): Don't (re)insinuate add-ons if at least an IRC server is
- opened; enable add-ons after calling riece-startup-hook.
-
- * riece-addon.el: New file.
- * COMPILE (riece-modules): Add riece-addon.
- * Makefile.am (EXTRA_DIST): Add riece-addon.el.
-
-2004-05-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-doctor.el (riece-doctor-buffer-name): Assume that the 1st
- argument is nickname rather than identity object.
- (riece-doctor-after-privmsg-hook): Don't send formatted identity
- as a patient's nickname.
-
-2004-05-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-hangman.el (riece-hangman-player-context-alist): Renamed
- from riece-hangman-players.
- (riece-hangman-make-context): Add doc.
- (riece-hangman-context-word): Add doc.
- (riece-hangman-context-guessed): Add doc.
- (riece-hangman-context-missed-count): Add doc.
- (riece-hangman-context-set-guessed): Add doc.
- (riece-hangman-context-set-missed-count): Add doc.
- (riece-hangman-word): Add doc.
- (riece-hangman-reply-with-context): Prefix user name.
-
-2004-05-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-doctor.el (riece-doctor-after-privmsg-hook): Prefix user
- name to reply.
-
- * riece-hangman.el: New add-on.
- * COMPILE (riece-modules): Add riece-hangman.
- * Makefile.am (EXTRA_DIST): Add riece-hangman.el.
-
-2004-05-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-400.el (riece-handle-read-string): Append "Quit" to prompt
- if user quits input.
-
-2004-05-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-complete-user): New command.
- * riece.el: Bind riece-command-complete-user.
-
-2004-05-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-400.el (riece-handle-read-string): New function.
- (riece-handle-432-message): Use it.
- (riece-handle-433-message): Use it.
-
- * riece-server.el (riece-open-server): Don't inhibit quit and
- catch it when reading server password.
-
-2004-05-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ignore.el (riece-ignore-message-filter): Set the
- major-mode of riece-ignore-buffer riece-dialogue-mode.
-
-2004-05-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ignore.el (riece-ignore-buffer-name): New user option.
- (riece-ignore-discard-message): Fixed custom spec to follow the
- logging option.
- (riece-ignore-buffer): New variable.
-
- * riece-log.el (riece-log-display-message-function): Use
- riece-format-message.
-
- * riece-message.el (riece-format-message): New function splitted
- from riece-display-message-1.
- (riece-display-message-1): Use it.
-
-2004-05-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ignore.el (riece-ignore-user): Renamed from
- riece-ignore-by-user.
-
-2004-05-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-signal.el (riece-connect-signal): Fixed doc.
- (riece-disconnect-signal): New function.
-
- * riece-ignore.el (riece-ignore-discard-message): New user option.
- (riece-ignored-user-list): Renamed from riece-ignored-user.
- (riece-ignore-by-user): Support unignore.
-
-2004-05-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-url.el (riece-url-regexp): Accept ";".
-
- * riece-ignore.el: New add-on.
- * COMPILE (riece-modules): Add riece-ignore.
- * Makefile.am (EXTRA_DIST): Add riece-ignore.el.
-
-2004-05-13 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-get-directory): Follow the name change
- of riece-channel-regexp.
-
-2004-05-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-globals.el (riece-strict-channel-regexp): Renamed from
- riece-channel-regexp.
- (riece-strict-user-regexp): Renamed from riece-user-regexp.
- (riece-laxed-channel-regexp): New constant.
- (riece-laxed-user-regexp): New constant.
- (riece-channel-regexp): Define as variable (its default value is
- set to riece-laxed-channel-regexp).
- (riece-user-regexp): Define as variable (its default value is set
- to riece-laxed-user-regexp).
-
-2004-05-10 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctlseq.el (riece-ctlseq-scan-region): Abolish.
- (riece-ctlseq-requires): New function.
- (riece-ctlseq-message-filter): Assume the existence of
- riece-put-overlay-faces, add 'riece-overlay-face property.
-
- * riece-keyword.el (riece-keyword-scan-region): Abolish.
- (riece-keyword-message-filter): Assume the existence of
- riece-put-overlay-faces, add 'riece-overlay-face property.
-
- * riece-highlight.el (riece-put-overlay-faces): New function.
- (riece-highlight-insinuate): Add riece-put-overlay-faces to
- riece-after-insert-functions.
-
-2004-05-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-split-parameters): Don't remove a trailing
- string even if it is empty.
-
-2004-05-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctlseq.el: Require 'riece-message for riece-message-text;
- require 'riece-misc for riece-scan-property-region.
-
- * riece-ctcp.el: Require 'riece-display for riece-channel-buffer.
-
-2004-05-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-300.el (riece-handle-312-message): Use server name
- returned by WHOIS instead of riece-real-server-name.
- [cf. <Liece:00170>]
-
-2004-05-04 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.2 released.
- * riece-version.el (riece-version-number): Bump up to 0.2.2.
-
- * riece-ctlseq.el (riece-ctlseq-hide-controls): New user option.
-
- * riece-keyword.el (riece-keyword): Fixed the parent custom group.
- * riece-url.el (riece-url): Fixed the parent custom group.
-
-2004-05-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctlseq.el: New add-on.
- * COMPILE (riece-modules): Add riece-ctlseq.
- * Makefile.am (EXTRA_DIST): Add riece-ctlseq.el.
-
-2004-04-29 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-get-directory): Use a canonicalized
- channel name.
- (riece-log-open-directory-function): New user option.
- (riece-log-open-directory): Use it.
- (riece-log-insinuate): Add new key bind.
-
-2004-04-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-button.el (riece-button-requires): Abolish.
-
-2004-03-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-buffer-alist): Rename *Commands* -> *Command*.
- (riece-command-mode): Rename Commands -> Command.
-
-2004-03-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-signal.el: Require 'riece-options for riece-debug.
- * riece-async.el: Require 'riece-options for riece-debug.
-
-2004-03-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-command-mode): Don't display
- riece-freeze-indicator on the modeline of the command buffer.
- (riece-dialogue-mode): Make riece-freeze-indicator local to the
- buffer whose major-mode is derived from riece-dialogue-mode.
-
- * riece-display.el: Add autoload setting for derived-mode-class.
- (riece-update-status-indicators): Check riece-freeze flag for each
- buffer visible in the selected frame.
-
- * riece-commands.el: Add autoload setting for derived-mode-class.
- (riece-command-toggle-freeze): Don't switch to the channel buffer
- if major-mode of the current buffer is derived from
- riece-dialogue-mode. Which allows to lock "*Others*" buffer.
- (riece-command-toggle-own-freeze): Ditto.
-
- * riece-globals.el (riece-freeze): Fix doc.
- (riece-freeze-indicator): Add doc.
- (riece-channel-indicator): Fix doc.
- (riece-long-channel-indicator): Fix doc.
- (riece-channel-list-indicator): Fix doc.
- (riece-user-indicator): Fix doc.
- (riece-away-indicator): Add doc.
- (riece-operator-indicator): Add doc.
-
-2004-03-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Treat private messages as unread.
-
-2004-03-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Don't clear riece-user-list-buffer and
- riece-channel-list-buffer.
-
-2004-03-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-exit): Clear riece-channel-buffer,
- riece-user-list-buffer, and riece-channel-list-buffer.
-
-2004-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-open-server): Append the server-name to
- the prompt string.
-
-2004-03-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-display-connect-signals): Update
- riece-long-channel-indicator on 'channel-modes-changed signal.
-
- * riece-naming.el (riece-naming-assert-channel-modes): New
- function renamed from riece-handle-channel-modes.
-
- * riece-misc.el: Require 'riece-mode.
- (riece-concat-channel-modes): Display mode parameter.
-
- * riece-channel.el: Require 'riece-mode.
- (riece-channel-toggle-mode): Store mode "objects" instead of mode
- "flags".
- * riece-user.el: Require 'riece-mode.
- (riece-user-toggle-mode): Store mode "objects" instead of mode
- "flags".
-
- * riece-handle.el: Require 'riece-mode.
- (riece-handle-mode-message): Use riece-parse-mode.
- (riece-parse-mode): Moved to riece-mode.el.
- (riece-handle-channel-modes): Moved to riece-naming.el.
-
- * riece-300.el: Require 'riece-mode.
- (riece-handle-324-message): Use riece-parse-mode.
-
- * riece-mode.el: New file.
- * Makefile.am (EXTRA_DIST): Add riece-mode.el.
- * COMPILE (riece-modules): Add riece-mode.
-
-2004-03-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el: "Error occurred in XXX" -> "Error in XXX".
- * riece-filter.el: "Error occurred in XXX" -> "Error in XXX".
- * riece-signal.el: "Error occurred in XXX" -> "Error in XXX".
-
-2004-03-09 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.1 released.
- * riece-version.el (riece-version-number): Bump up to 0.2.1.
-
-2004-03-09 Daiki Ueno <ueno@unixuser.org>
-
- * riece-emacs.el (riece-propertize-modeline-string): Fix arguments
- for add-text-properties.
-
-2004-03-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xface.el (riece-xface-insinuate): Use
- riece-user-list-mode-hook to setup riece-update-buffer-functions
- in user-list buffer.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.2.0 released.
- * riece-version.el (riece-version-number): Bump up to 0.2.0.
-
- * riece-ctcp.el (riece-handle-ctcp-version-request): Fixed bug in
- formatting target identity.
- (riece-handle-ctcp-ping-request): Ditto.
- (riece-handle-ctcp-clientinfo-request): Ditto.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el: Rename some signals.
-
- * riece-commands.el (riece-command-set-operators): Reverse user-list.
- (riece-command-set-speakers): Ditto.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el
- (riece-unread-format-identity-for-channel-list-indicator): Escape
- % -> %%; use riece-propertize-modeline-string.
-
- * riece-history.el
- (riece-history-format-identity-for-channel-list-indicator): Escape
- % -> %%; use riece-propertize-modeline-string.
-
- * riece-highlight.el
- (riece-highlight-format-identity-for-channel-list-indicator):
- Escape % -> %%; use riece-propertize-modeline-string.
-
- * riece-display.el
- (riece-format-identity-for-channel-list-indicator): Escape % ->
- %%.
- (riece-update-channel-list-indicator): Rewrite.
-
- * riece-emacs.el (riece-propertize-modeline-string): New function.
- * riece-xemacs.el (riece-propertize-modeline-string): New function.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el
- (riece-unread-format-identity-for-channel-list-indicator): New
- function.
- (riece-unread-insinuate): Setup
- riece-format-identity-for-channel-list-indicator-functions.
-
- * riece-history.el
- (riece-history-format-identity-for-channel-list-buffer): New
- function.
- (riece-history-insinuate): Setup
- riece-format-identity-for-channel-list-indicator-functions.
-
- * riece-highlight.el
- (riece-highlight-format-identity-for-channel-list-indicator): New
- function.
- (riece-highlight-insinuate): Setup
- riece-format-identity-for-channel-list-indicator-functions.
-
- * riece-display.el
- (riece-format-identity-for-channel-list-buffer): Rename from
- riece-format-channel-list-line.
- (riece-format-identity-for-channel-list-indicator): New function.
- (riece-update-channel-list-indicator): Use it.
-
-2004-03-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-parse-modes): Make sure that mode params
- are started at the beginning of the mode string.
- (riece-handle-channel-modes): Fixed arguments passed to
- riece-channel-toggle-*.
-
-2004-03-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xface.el (riece-xface-insinuate): Set
- 'riece-update-buffer-functions local to the user-list buffer.
-
- * riece-unread.el: Require 'riece-signal instead of
- 'riece-display.
- (riece-unread-after-display-message-function): Emit
- 'riece-update-buffer signal instead of
- 'riece-unread-channel-list-update signal.
-
- * riece-ndcc.el: Don't require 'riece-display.
-
- * riece-naming.el: Require 'riece-signal instead of
- 'riece-display.
- (riece-naming-assert-rename): Don't rename buffer.
-
- * riece-history.el (riece-history-format-channel-list-line): Don't
- append "\n".
-
- * riece-handle.el: Require 'riece-signal instead of
- 'riece-display.
- (riece-parse-modes): Rename from riece-parse-channel-modes; don't
- update channel modes.
- (riece-handle-channel-modes): New function which processes the
- result of riece-parse-modes.
- (riece-handle-mode-message): Use it.
-
- * riece-filter.el: Don't require 'riece-display.
- * riece-display.el: Require 'riece-signal; connect
- 'riece-update-buffer signal.
-
- * riece-ctcp.el: Don't require 'riece-display.
-
- * riece-signal.el: New module splitted from riece-display.el.
- * Makefile.am (EXTRA_DIST): Add riece-signal.
- * COMPILE (riece-modules): Add riece-signal.
-
-2004-03-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Emit 'riece-unread-channel-list-update signal.
- (riece-unread-insinuate): Connect the signal to the function which
- updates channel-list buffer.
-
- * riece-display.el (riece-display-connect-signals): Fix parenthesis.
-
-2004-03-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-emit-signal): Fixed bug that errors
- during signal filter execution were not caught.
- (riece-display-connect-signals): Check riece-current-channel is set.
-
-2004-03-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-display-connect-signals): Fixed bug in
- signal filters.
-
- * riece-handle.el (riece-handle-mode-message): Don't call
- riece-parse-channel-modes if channel doesn't match with
- riece-channel-regexp.
-
-2004-02-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-display-connect-signals): Connect some
- signals.
-
- * riece-naming.el (riece-naming-assert-join): Don't change the
- current channel manually.
- (riece-naming-assert-part): Ditto.
- (riece-naming-assert-rename): Ditto.
- (riece-naming-assert-channel-users): Ditto.
-
-2004-02-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-emit-signal): Create signal object
- internally.
-
- * riece-message.el (riece-display-message-1): Emit
- 'riece-buffer-toggle-freeze signal.
-
- * riece-commands.el (riece-command-toggle-freeze): Emit
- 'riece-buffer-toggle-freeze signal; don't update status indicators
- manually.
- (riece-command-toggle-own-freeze): Ditto.
-
- * riece-naming.el (riece-naming-assert-join): Rename signal 'join
- -> 'riece-naming-assert-join.
- (riece-naming-assert-part): Rename signal 'part ->
- 'riece-naming-assert-part.
- (riece-naming-assert-rename): Rename signal 'rename ->
- 'riece-naming-assert-rename.
- (riece-naming-assert-channel-users): Rename from
- riece-naming-assert-users; rename signal 'users ->
- 'riece-naming-assert-channel-users.
-
- * riece-handle.el (riece-handle-topic-message): Emit
- 'riece-channel-set-topic signal.
- (riece-parse-channel-modes): Emit 'riece-channel-toggle-operator,
- 'riece-channel-toggle-speaker, and 'riece-channel-toggle-modes signals.
-
- * riece-display.el (riece-display-connect-signals): Rename some
- signals; connect more signals.
-
- * riece-300.el (riece-handle-302-message): Emit
- 'riece-user-toggle-away, and 'riece-user-toggle-operator signals;
- don't update status indicators manually.
- (riece-handle-301-message): Emit 'riece-user-toggle-away signal;
- don't update status indicators manually.
- (riece-handle-305-message): Ditto.
- (riece-handle-306-message): Ditto.
- (riece-handle-353-message): Follow the name change of
- riece-naming-assert-users.
- (riece-handle-324-message): Emit 'riece-channel-toggle-modes
- signal; don't update status indicators manually.
- (riece-handle-set-topic): Emit 'riece-channel-set-topic signal;
- don't update channel indicator manually.
- (riece-handle-352-message): Emit 'riece-user-toggle-away, and
- 'riece-user-toggle-operator signals; don't update status
- indicators manually.
-
-2004-02-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-connect-signal): Create slot object
- internally.
-
-2004-02-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece): Setup signal slots.
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Don't call riece-redisplay-buffers.
-
- * riece-naming.el (riece-naming-assert-names): New function.
- (riece-naming-assert-join): Emit 'join signal.
- (riece-naming-assert-part): Emit 'part signal.
- (riece-naming-assert-rename): Emit 'rename signal.
-
- * riece-message.el (riece-message-buffer): Don't call
- riece-redisplay-buffers.
-
- * riece-handle.el (riece-handle-nick-message): Don't call
- riece-redisplay-buffers.
- (riece-handle-join-message): Ditto.
- (riece-handle-part-message): Ditto.
- (riece-handle-kick-message): Ditto.
- (riece-handle-kill-message): Ditto.
- (riece-handle-topic-message): Ditto.
- (riece-parse-channel-modes): Ditto.
-
- * riece-display.el (riece-update-user-list-buffer): Use
- riece-with-server-buffer.
- (riece-emit-signal): Notify if signal filter fails.
- (riece-display-connect-signals): New function.
- (riece-update-user-list-buffer): Don't switch to user-list buffer.
- (riece-update-channel-list-buffer): Don't switch to channel-list
- buffer.
- (riece-switch-to-channel): Emit 'switch-to-channel signal.
- (riece-switch-to-nearest-channel): Ditto.
-
- * riece-commands.el (riece-command-switch-to-channel): Don't call
- riece-redisplay-buffers.
- (riece-command-join-partner): Ditto.
- (riece-command-part): Ditto.
-
- * riece-300.el (riece-handle-353-message): Save match data before
- calling riece-naming-assert-names; don't call riece-redisplay-buffers.
- (riece-handle-322-message): Don't call riece-redisplay-buffers.
-
-2004-02-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el: Introduce Qt like "signal-slot" abstraction
- for routing display events.
- (riece-signal-slot-obarray): New variable.
- (riece-make-slot): New function.
- (riece-slot-function): New function.
- (riece-slot-filter): New function.
- (riece-slot-handback): New function.
- (riece-make-signal): New function.
- (riece-signal-name): New function.
- (riece-signal-args): New function.
- (riece-connect-signal): New function.
- (riece-emit-signal): New function.
-
-2004-02-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-300.el (riece-handle-353-message): Add 'riece-identity
- property on user list string.
-
-2004-02-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el: Add autoload setting for
- lsdb-rebuild-secondary-hash-tables to suppress warning.
-
-2004-02-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece-300.el (riece-handle-353-message): Print user list in
- channel buffer.
-
-2004-02-14 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-lsdb.el (riece-lsdb-lookup-records): Build
- riece-lsdb-cache if necessary.
-
-2004-01-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-handle-ctcp-version-request): Format target
- identity before display.
- (riece-handle-ctcp-ping-request): Ditto.
- (riece-handle-ctcp-clientinfo-request): Ditto.
-
-2004-01-28 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.8 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.8.
-
-2004-01-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el: Require 'riece-identity; add autoload setting for
- lsdb-update-record; bind lsdb-hash-table, riece-command-mode-map.
-
-2004-01-23 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-handle.el (riece-handle-privmsg-message): Check own
- message from server. For deal with another client that connected
- same irc proxy (e.g. plum, pirc).
- (riece-handle-notice-message): Ditto.
-
-2004-01-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-identity-canonicalize-prefix): Convert
- characters in prefix to lower case.
-
-2004-01-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-concat-user-status): New function.
-
- * riece-300.el (riece-handle-302-message): Simplify user status
- display. (i.e. don't display "not operator", "not away", ...)
- (riece-handle-352-message): Ditto.
-
-2004-01-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el (riece-lsdb-add-user): Always pass canonical
- address for 'net entry.
-
-2004-01-04 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-300.el (riece-handle-317-message): Fix regexp for signon
- time extenstion.
-
-2004-01-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el: Add autoload setting for lsdb-maphash.
- (riece-lsdb-update-cache): Don't alter existing entry.
- (riece-lsdb-delete-cache): Ditto.
- (riece-lsdb-add-user): New command.
- (riece-lsdb-insinuate): Bind riece-lsdb-add-user.
-
-2004-01-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el (riece-lsdb-insinuate): Don't require 'lsdb.
-
-2004-01-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-lsdb.el: New add-on.
- * COMPILE (riece-modules): Add riece-lsdb.
- * Makefile.am (EXTRA_DIST): Add riece-lsdb.el
-
- * riece-xface.el: New add-on.
- * COMPILE (riece-modules): Add riece-xface.
- * Makefile.am (EXTRA_DIST): Add riece-xface.el
-
-2003-12-25 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.7 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.7.
-
-2003-12-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-keyword.el (riece-notify-keyword-functions): Mark as
- obsolete.
- (riece-keyword-notify-functions): New user option.
- (riece-keyword-message-filter): Don't restore the match data when
- calling riece-notify-keyword-functions; call
- riece-keyword-notify-functions with the matched message object.
- Thanks to OHASHI Akira <bg66@koka-in.org>
- [cf. <Liece:00134>]
-
-2003-12-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-log.el (riece-log-flashback): Use
- riece-match-string-no-properties instead of match-string-no-properties.
-
- * riece-xemacs.el (riece-match-string-no-properties): New function.
- * riece-emacs.el (riece-match-string-no-properties): New alias.
-
- * riece-identity.el: Don't require 'riece-compat.
- (riece-identity-prefix-case-table): Abolish.
- (riece-identity-prefix-case-pair-alist): New constant.
- (riece-identity-canonicalize-prefix): Don't use case-table.
-
- * riece-emacs.el (riece-set-case-syntax-pair): Abolish.
- (riece-copy-case-table): Abolish.
- * riece-xmacs.el (riece-set-case-syntax-pair): Abolish.
- (riece-copy-case-table): Abolish.
-
-2003-12-15 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el: Require 'riece-version.
- (riece-quit-message): Set default to (riece-extended-version).
- (riece-away-message): Set default to "Gone".
-
- * riece-commands.el: Don't require 'riece-version.
- (riece-command-quit): Don't check riece-quit-message.
- (riece-command-close-server): Ditto.
- (riece-command-toggle-away): Always supply a parameter to the AWAY
- command when the user is not away. Thanks to Yuki Fujimura
- <fujimura@wakhok.ac.jp>
- [cf. <Liece:00139>]
-
-2003-12-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece): Connect to servers in riece-startup-server-list.
-
- * riece-000.el (riece-handle-001-message): Ignore entries in
- riece-startup-channel-list which doesn't match riece-server-name.
-
- * riece-options.el (riece-startup-server-list): New user option.
-
- * riece-async.el (riece-async-max-buffer-size): New user option.
- (riece-async-server-program): Use io/nonblock & IO#syswrite to
- check whether the write end of pipe (i.e. input to emacs process)
- would block.
-
-2003-12-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-default-open-connection-function): New
- user option.
-
- * riece-server.el (riece-server-keyword-map): Use
- riece-default-open-connection-function.
-
- * riece-async.el: New add-on.
- * COMPILE (riece-modules): Add riece-async.
- * Makefile.am (EXTRA_DIST): Add riece-async.el
-
-2003-12-09 OHASHI Akira <bg66@koka-in.org>
-
- * riece-mini.el (riece-mini-display-message-function): Don't set
- riece-mini-last-channel when message is not a privmsg.
-
-2003-12-04 OHASHI Akira <bg66@koka-in.org>
-
- * riece-server.el (riece-with-server-buffer): Store 'edebug-form-spec
- property.
-
-2003-12-03 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-requires): New function.
- (riece-log-flashback): Revert 'riece-identity property and button.
-
-2003-11-28 OHASHI Akira <bg66@koka-in.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Do nothing when message is not a privmsg.
-
-2003-11-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-log.el (riece-log-coding-system): New user option.
- (riece-log-display-message-function): Bind
- coding-system-for-write; don't create temp buffer.
-
- * riece-rdcc.el (riece-rdcc-filter): Use write-region instead of
- append-to-file to suppress "Wrote file" messages.
-
-2003-11-10 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.6 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.6.
-
-2003-11-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-command-ctcp-action): Display channel names
- in "*Others*" buffer.
-
-2003-11-05 OHASHI Akira <bg66@koka-in.org>
-
- * riece-unread.el (riece-unread-switch-to-channel): Protect
- switching to the channel not existing.
-
-2003-10-29 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-get-directory): Support riece-identity
- for mapping.
-
-2003-10-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-layout.el (riece-set-window-points): Move point in
- the channel-buffer's window.
-
- * riece-ctcp.el (riece-command-ctcp-version): Prompt to select
- an identity on the current server.
- (riece-command-ctcp-ping): Ditto.
- (riece-command-ctcp-clientinfo): Ditto.
- (riece-command-ctcp-action): Ditto.
-
- * riece-commands.el (riece-command-change-mode): Prompt to select
- an identity on the current server.
- (riece-command-join): Ditto.
-
-2003-10-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-keyword.el (riece-keywords): Change custom spec.
- (riece-keyword-message-filter): Normalize riece-keywords.
-
- * riece-identity.el (riece-identity-prefix-case-table): Use
- riece-copy-case-table to define.
-
- * riece-xemacs.el (riece-set-case-syntax-pair): Workaround for
- XEmacs 21.1.
- (riece-copy-case-table): Ditto.
-
- * riece-emacs.el (riece-copy-case-table): New alias.
-
- * riece-globals.el (riece-channel-regexp): Use
- riece-make-interval-regexp to define.
- (riece-user-regexp): Ditto.
-
- * riece-compat.el (riece-make-interval-regexp): New function.
-
- * riece-icon.el (riece-icon-available-p): Check
- the existence of image-type-available-p.
-
-2003-10-27 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-get-directory): Fix for server name and
- private messages handling.
-
-2003-10-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xemacs.el (riece-run-with-idle-timer): Pass an integer to
- the RESTART argument of start-itimer.
-
- * riece-commands.el (riece-command-user-list-scroll-down): Rename
- from riece-command-nick-scroll-down.
- (riece-command-user-list-scroll-up): Rename from
- riece-command-nick-scroll-up.
- (riece-command-scroll-down): Check if riece-current-channel is bound.
- (riece-command-scroll-up): Ditto.
- (riece-command-quit): Clean up if no server process is available.
-
-2003-10-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el: Bind temporary-file-directory.
- (riece-rdcc-send-program): Allow block-size to be controlled from
- elisp.
- (riece-rdcc-block-size): New user option.
- (riece-rdcc-temp-file): New variable.
- (riece-rdcc-received-size): New variable.
- (riece-rdcc-filter): Don't keep received bytes in the process
- buffer; use riece-rdcc-format-size to display progress.
- (riece-command-dcc-receive): Create a temporary directory which
- holds a received file.
-
-2003-10-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-gather-channel-modes): Default to nil.
- * riece-handle.el (riece-handle-join-message): Send MODE if
- riece-gather-channel-modes is non-nil.
-
- * riece-url.el: Add autoload setting for 'browse-url.
-
- * riece-menu.el: Require 'riece-options, 'riece-globals,
- 'riece-identity, 'riece-layout, and 'riece-server; bind
- riece-command-mode-map.
-
- * riece-history.el: Require 'riece-options, 'riece-globals,
- 'riece-highlight, and 'riece-identity.
-
- * riece-naming.el (riece-naming-assert-rename): Fixed.
-
-2003-10-24 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.5 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.5.
-
-2003-10-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-command-ctcp-action): If the current
- command line is not empty, insert it into the minibuffer before
- reading input. Thanks to Akinori MUSHA <knu@iDaemons.org>
- [cf. <Liece:00123>]
-
- * riece.el: Add autoload setting for derived-mode-class.
- (riece-shrink-buffer-idle-timer): New variable.
- (riece): Set idle timer to shrink channel buffers.
- (riece-shrink-buffer): New function.
-
- * riece-xemacs.el (riece-overlays-in): New function.
- (riece-delete-overlay): New alias.
- (riece-kill-all-overlays): New function.
-
- * riece-server.el (riece-quit-server-process): Don't set timer if
- riece-quit-timeout is nil.
-
- * riece-options.el (riece-quit-timeout): Change custom type.
- (riece-shrink-buffer-idle-time-delay): New user option.
- (riece-max-buffer-size): New user option.
-
- * riece-icon.el (riece-icon-add-image-region) [XEmacs]: Delete
- extents if already exists.
-
- * riece-emacs.el (riece-overlays-in): New alias.
- (riece-delete-overlay): New alias.
- (riece-kill-all-overlays): New function.
- (riece-run-with-idle-timer): New alias.
- (riece-cancel-timer): New alias.
-
- * riece-display.el (riece-update-user-list-buffer): Kill all
- overlays in buffer.
- (riece-update-channel-list-buffer): Ditto.
-
- * riece-commands.el (riece-command-set-operators): Reset group.
- (riece-command-set-speakers): Ditto.
-
-2003-10-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-naming.el (riece-naming-assert-rename): Follow the
- change of riece-channel.el.
-
- * riece-message.el (riece-message-external-p): Follow the
- change of riece-channel.el.
-
- * riece-display.el (riece-update-user-list-buffer): Follow the
- change of riece-channel.el.
-
- * riece-commands.el (riece-command-kick): Follow the change of
- riece-channel.el.
- (riece-command-set-operators): Ditto.
- (riece-command-set-speakers): Ditto.
-
- * riece-button.el (riece-user-button-set-operators): Follow the
- change of riece-channel.el.
- (riece-user-button-set-speakers): Ditto.
-
- * riece-channel.el (riece-make-channel): Abolish 2nd and 3rd
- arguments.
- (riece-get-channel): Follow the change of riece-make-channel.
- (riece-channel-operators): Abolish.
- (riece-channel-speakers): Abolish.
- (riece-channel-set-operators): Abolish.
- (riece-channel-set-speakers): Abolish.
- (riece-channel-get-operators): Abolish.
- (riece-channel-get-speakers): Abolish.
- (riece-channel-toggle-user): Follow the change of the return type
- of riece-channel-users.
- (riece-channel-toggle-operator): Ditto.
- (riece-channel-toggle-speaker): Ditto.
- (riece-channel-operator-p): Abolish.
- (riece-channel-speaker-p): Abolish.
- (riece-channel-intern-user): Abolish.
-
-2003-10-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-identity-member): Take an optional 3rd
- argument to instruct to use riece-identity-equal-no-server.
- (riece-identity-assoc): Ditto.
-
- * riece-display.el (riece-update-user-list-buffer): Use
- riece-channel-operator-p and riece-channel-speaker-p.
-
- * riece-button.el (riece-user-button-set-operators): Use
- riece-channel-operator-p.
- (riece-user-button-set-speakers): Use riece-channel-speaker-p.
-
- * riece-channel.el (riece-channel-intern-user): New function.
- (riece-channel-toggle-operator): Use it.
- (riece-channel-toggle-speaker): Use it.
- (riece-channel-operator-p): New function.
- (riece-channel-speaker-p): New function.
-
-2003-10-23 OHASHI Akira <bg66@koka-in.org>
-
- * riece-log.el (riece-log-get-directory): Follow the change of
- `riece-channel-regexp'.
-
-2003-10-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-format-identity): Return copied strings.
-
-2003-10-22 OHASHI Akira <bg66@koka-in.org>
-
- * riece.el (riece): When riece server was opened, Do
- `riece-command-configure-windows' instead of signaling.
-
-2003-10-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-rdcc-send-program): Flush $stdout before
- accepting a connection.
- (riece-command-dcc-send): Use riece-completing-read-identity; take
- an identity object in the 1st argument.
- (riece-rdcc-format-size): New function.
- (riece-handle-dcc-request): Use it.
-
- * riece-ndcc.el (riece-command-dcc-send): Use
- riece-completing-read-identity; take an identity object in the 1st
- argument.
-
- * riece-display.el (riece-update-buffers): Run
- riece-update-buffer-hook.
-
- * riece-button.el (riece-user-button-finger): Pass an identity
- object instead of the prefix.
-
- * riece-ctcp.el: Require 'riece-highlight.
- (riece-ctcp-action-face): New face.
- (riece-ctcp-action-face): New variable.
- (riece-ctcp-action-prefix): New variable.
- (riece-ctcp-requires): Require 'riece-highlight if it is enabled.
- (riece-ctcp-insinuate): Modify riece-dialogue-font-lock-keywords
- if 'riece-highlight is enabled.
- (riece-handle-ctcp-action-request): Prepend
- riece-ctcp-action-prefix instead of riece-change-prefix.
- (riece-command-ctcp-action): Ditto.
-
- * riece-server.el (riece-quit-server-process): Use riece-run-at-time.
- * riece-xemacs.el (riece-run-at-time): New function.
- * riece-emacs.el (riece-run-at-time): New alias.
-
- * riece-misc.el (riece-get-identities-on-server): New function.
- (riece-get-users-on-server): Use it.
-
- * riece-ctcp.el (riece-ctcp-completing-read-identity): Abolish.
- (riece-command-ctcp-version): Use riece-completing-read-identity
- and riece-get-identities-on-server.
- (riece-command-ctcp-ping): Ditto.
- (riece-command-ctcp-clientinfo): Ditto.
- (riece-command-ctcp-action): Ditto.
-
- * riece-commands.el (riece-command-finger): Pass the current
- server name to riece-get-users-on-server; use
- riece-completing-read-identity.
- (riece-command-invite): Ditto.
- (riece-command-enter-message-to-user): Ditto.
-
- * riece-000.el (riece-handle-001-message): Register myself with
- riece-obarray.
-
-2003-10-21 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-ctcp-completing-read-identity): New
- function.
- (riece-command-ctcp-version): Use it.
- (riece-command-ctcp-ping): Ditto.
- (riece-command-ctcp-clientinfo): Ditto.
- (riece-command-ctcp-action): Ditto; don't encode CHANNEL identity
- twice.
-
-2003-10-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xemacs.el (riece-xemacs-mode-line-buffer-identification):
- Abolish.
- (riece-mode-line-buffer-identification): Don't define alias.
-
- * riece-server.el (riece-open-server): Handle errors occurred
- during reading password.
-
- * riece-options.el (riece-addons): Add riece-icon.
-
- * riece-layout.el (riece-configure-windows-top): Collect arguments.
-
- * riece-icon.el: New add-on.
- * COMPILE (riece-modules): Add riece-icon.
- * Makefile.am (EXTRA_DIST): Add riece-icon.el
-
-2003-10-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-saved-forms): Add riece-layout.
-
- * riece-layout.el (riece-layout-alist): Change format.
- (riece-configure-windows): Take 2 args to specify the position of
- the command buffer window.
-
- * riece-commands.el (riece-command-change-layout): Set
- riece-save-variables-are-dirty.
-
-2003-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.4 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.4.
-
-2003-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-server-process-opened): Return t.
-
- * riece.el (riece-dialogue-mode-map): Bind "p" to
- riece-command-enter-message-to-user.
-
- * riece-misc.el (riece-current-nickname): Use
- riece-current-server-name.
- (riece-get-users-on-server): Ditto.
-
- * riece-server.el (riece-current-server-name): New function.
- (riece-send-string): Use it.
-
- * riece-commands.el (riece-command-enter-message-to-user): New command.
-
-2003-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-menu.el (riece-menu-create-layouts-menu): New function.
- (riece-menu-items): Use it.
-
- * riece-server.el (riece-server-process-opened): New function.
- (riece-server-opened): Use it.
-
- * riece-url.el: Require 'riece-menu.
- (riece-url-insinuate): Add "Open URL..." menu in
- riece-command-mode-hook.
-
- * riece-options.el (riece-addons): Add riece-menu.
-
- * riece-menu.el: New add-on.
- * COMPILE (riece-modules): Add riece-menu.
- * Makefile.am (EXTRA_DIST): Add riece-menu.el
-
-2003-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-version.el (riece-extended-version): Remove interactive spec.
- (riece-version): New command.
- * riece.el (riece-command-map): Bind "V" to riece-version.
-
- * riece-options.el (riece-command-prefix): New user option.
- (riece-tab-stop-list): Abolish.
-
- * riece.el (riece-define-keys-1): If keymap is a list, eval the
- 2nd element of it.
- (riece-select-keys): Use riece-command-prefix instead of "\C-c".
- (riece-command-map): Ditto.
- (riece-dialogue-mode): Don't set tab-stop-list.
-
-2003-10-18 Daiki Ueno <ueno@unixuser.org>
-
- * riece-keyword.el (riece-keyword-message-filter): Ignore messages
- which belongs to myself.
-
- * riece-commands.el (riece-command-topic): Use
- riece-check-channel-commands-are-usable.
- (riece-command-invite): Ditto.
- (riece-command-kick): Ditto.
- (riece-command-change-mode): Ditto.
- (riece-command-set-operators): Ditto.
- (riece-command-set-speakers): Ditto.
- (riece-command-send-message): Ditto.
- (riece-command-part): Ditto.
-
- * riece-misc.el (riece-get-users-on-server): If
- riece-current-channel is not set, check the default server.
- (riece-check-channel-commands-are-usable): New function.
-
- * riece-globals.el (riece-channel-regexp): Accept channel names
- beginning with "!!".
-
-2003-10-16 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-commands.el (riece-command-universal-server-name-argument):
- Fix parenthesis.
-
-2003-10-16 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-buffer-alist): Rename from
- riece-buffer-mode-alist.
-
- * riece-misc.el (riece-get-buffer-create): Takes an optional 2nd
- argument, init-major-mode, which is used to assert the major-mode
- of the created buffer.
-
- * riece-naming.el (riece-naming-assert-rename): Merged buffer
- renaming logic that riece-handle-nick-message was responsible for.
-
- * riece-globals.el (riece-server-process-alist): Revive.
- (riece-process-list): Abolish.
- (riece-command-buffer): Set default to nil.
- (riece-dialogue-buffer): Ditto.
- (riece-others-buffer): Ditto.
- (riece-channel-list-buffer): Ditto.
- (riece-user-list-buffer): Ditto.
- (riece-private-buffer): Abolish.
- (riece-wallops-buffer): Abolish.
-
- * riece-display.el (riece-channel-buffer-format): Moved from
- riece-globals.
- (riece-channel-buffer-alist): New variable.
- (riece-channel-buffer-create): Assert the major-mode of the
- created buffer is 'riece-channel-mode.
- (riece-channel-buffer): New function.
- (riece-switch-to-channel): Use riece-channel-buffer instead of
- directly using get-buffer.
-
-2003-10-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-toggle-away): Check user away
- status in the server buffer.
- [cf. <Liece:00119>]
- (riece-command-names): Use identity prefix
- instead of formatted identity.
- (riece-command-who): Ditto.
-
-2003-10-14 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece.el (riece-dialogue-mode-map): Bind "N" instead of "\C-n"
- to `riece-command-name'.
-
-2003-10-14 Daiki Ueno <ueno@unixuser.org>
-
- * riece-layout.el (riece-reconfigure-windows-predicate): Simplified.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.3 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.3.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-button.el (riece-button-map-identity-region): Abolish.
- (riece-user-button-set-operators): Use riece-scan-property-region.
- (riece-user-button-set-speakers): Ditto.
- (riece-button-add-identity-button): Ditto.
-
- * riece-keyword.el: Require 'riece-message.
- (riece-keyword-map-region): Abolish.
- (riece-keyword-scan-region): Use riece-scan-property-region.
-
- * riece-misc.el (riece-scan-property-region): New function.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xemacs.el (riece-make-overlay): New alias.
- (riece-overlay-put): New alias.
- (riece-overlay-start): New alias.
- (riece-overlay-buffer): New alias.
-
- * riece-emacs.el (riece-make-overlay): New alias.
- (riece-overlay-put): New alias.
- (riece-overlay-start): New alias.
- (riece-overlay-buffer): New alias.
-
- * riece-keyword.el: New add-on.
- * COMPILE (riece-modules): Add riece-keyword.
- * Makefile.am (EXTRA_DIST): Add riece-keyword.el
-
- * riece-message.el (riece-message-filter-functions): New user option.
- (riece-display-message-1): New function.
- (riece-display-message): Use it.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-channel-list-mode): Initialize
- riece-update-buffer-functions.
- (riece-user-list-mode): Ditto.
-
- * riece-globals.el (riece-channel-indicator): Rename from
- riece-short-channel-indicator.
- (riece-long-channel-indicator): Rename from
- riece-channel-indicator.
-
- * riece-display.el (riece-update-buffer-functions): Default to
- nil.
- (riece-update-indicator-functions): New variable splitted from
- riece-update-buffer-functions.
- (riece-update-channel-indicator): Rename from
- riece-update-short-channel-indicator.
- (riece-update-long-channel-indicator): Rename from
- riece-update-channel-indicator.
- (riece-update-buffers): Don't set riece-channel-buffer.
- (riece-switch-to-channel): Set riece-channel-buffer here.
-
- * riece-button.el (riece-user-button-popup-menu): Change order.
- (riece-button-update-buffer): Unify
- riece-button-update-channel-list-buffer and
- riece-button-update-user-list-buffer.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-history.el (riece-history-insinuate): In
- riece-after-switch-to-channel-functions, check whether the last
- channel is nil.
-
- * riece-xemacs.el (riece-event-buffer): New alias.
- (riece-event-point): New alias.
-
- * riece-emacs.el (riece-event-buffer): New function.
- (riece-event-point): New function.
-
- * riece-display.el (riece-update-user-list-buffer): Use
- riece-format-identity to add 'riece-identity property to user
- names.
-
- * riece-button.el (riece-user-button-popup-menu): New variable.
- (riece-identity-button): Rename from riece-channel-button.
- (riece-button-switch-to-identity): Rename from
- riece-channel-button-action.
- (riece-identity-button-popup-menu): Rename from
- riece-channel-button-popup-menu; set point to the position the
- event occurred.
- (riece-user-button-join-partner): New function.
- (riece-user-button-set-operators): New function.
- (riece-user-button-set-speakers): New function.
- (riece-user-button-finger): New function.
- (riece-make-identity-button-map): New function.
- (riece-button-map-identity-region): New function; splitted from
- riece-button-add-identity-button.
- (riece-button-add-identity-button): Use it.
- (riece-button-update-user-list-buffer): New function.
- (riece-button-insinuate): Add riece-button-update-user-list-buffer
- to riece-update-buffer-functions.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-xemacs.el (riece-mouse-2): New variable.
- (riece-popup-menu-popup): New function.
-
- * riece-emacs.el (riece-mouse-2): New variable.
- (riece-popup-menu-bogus-filter-constructor): New macro.
- (riece-popup-menu-popup): New function.
-
- * riece-commands.el (riece-command-list): Use identity prefix
- instead of formatted identity.
-
- * riece-button.el (riece-channel-button-popup-menu): New variable.
- (riece-channel-button): Arrange help-echo.
- (riece-channel-button-switch-to-channel): New function.
- (riece-channel-button-part): New function.
- (riece-channel-button-list): New function.
- (riece-channel-button-map): New variable.
- (riece-button-add-channel-buttons): Add 'local-map and 'keymap
- properties on channel buttons.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-button.el (riece-button-insinuate): Buttonize channel buffers.
-
- * riece-history.el (riece-channel-list-history-face): New face.
- (riece-history-format-channel-list-line): New function.
- (riece-history-insinuate): Add ?+ to
- riece-channel-list-mark-face-alist; add
- riece-history-format-channel-list-line to
- riece-format-channel-list-line-functions.
-
- * riece-highlight.el (riece-channel-list-current-face): Arrange colors.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Do nothing when message-target is already in
- riece-unread-channels; call riece-redisplay-buffers.
- (riece-unread-update-channel-list-buffer): Abolish.
- (riece-unread-after-switch-to-channel-function): Don't call
- riece-unread-update-channel-list-buffer.
- (riece-unread-format-channel-list-line): New function.
- (riece-unread-insinuate): Add
- riece-unread-format-channel-list-line to
- riece-format-channel-list-line; don't add
- riece-unread-update-channel-list-buffer to
- riece-update-buffer-functions.
-
- * riece-highlight.el (riece-channel-list-mark-current-channel):
- Abolish; merged into riece-update-channel-list-buffer.
- (riece-highlight-insinuate): Don't add
- riece-channel-list-mark-current-channel to
- riece-after-switch-to-channel-functions.
-
- * riece-display.el (riece-channel-list-changed): Abolish.
- (riece-update-channel-list-buffer): Always redisplay channel-list
- buffer.
- (riece-update-channel-list-indicator): Always redisplay
- channel-list indicator.
- (riece-format-channel-list-line): New function.
- (riece-update-buffers): Don't clear riece-channel-list-changed.
- (riece-join-channel): Don't set riece-channel-list-changed.
- (riece-part-channel): Ditto.
-
-2003-10-13 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-addons): Add riece-button.
-
- * riece-display.el (riece-update-channel-list-buffer): Avoid to
- use format to preserve 'riece-identity property.
-
- * riece-unread.el (riece-unread-update-channel-list-buffer):
- Simplified.
- (riece-unread-insinuate): Delay adding
- riece-unread-update-channel-list-buffer to
- riece-update-buffer-functions.
-
- * riece-button.el: New add-on.
- * COMPILE (riece-modules): Add riece-button.
- * Makefile.am (EXTRA_DIST): Add riece-button.el
-
-2003-10-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-close-server-process):
- (riece-quit-server-process): Call riece-close-server-process
- instead of kill-process; call riece-exit if no process is available.
-
-2003-10-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-channel-buffer-name): Check whether
- IDENTITY is a member of riece-current-channels.
-
-2003-10-07 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-commands.el (riece-command-kick): Fix completing-read
- collection argument.
-
-2003-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-000.el: Require 'riece-commands.
- * riece-200.el: Don't require 'riece-commands.
- * riece-300.el: Ditto.
-
-2003-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.2 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.2.
-
-2003-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-sentinel): Don't clear
- riece-reconnect-with-password.
- * riece-server.el (riece-open-server): Clear
- riece-reconnect-with-password here.
-
-2003-10-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-globals.el (riece-join-channel-candidate): New variable.
- * riece-commands.el (riece-command-join): Prompt
- riece-join-channel-candidate.
-
- * riece-handle.el (riece-handle-invite-message): Set
- riece-join-channel-candidate when the user is invited.
- * riece-naming.el (riece-naming-assert-join): Clear
- riece-join-channel-candidate.
-
-2003-10-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-completing-read-identity): Pass 6th &
- 7th arguments to completing-read.
-
- * riece-commands.el (riece-command-part): Use 6th argument DEFAULT
- of riece-completing-read-identity.
-
- * riece-handle.el (riece-handle-invite-message): Fix parsing of
- parameters.
-
- * riece-display.el (riece-update-channel-list-buffer): Don't clear
- riece-channel-list-changed.
- (riece-update-buffers): Clear it.
-
-2003-10-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-rdcc-save-directory): New user option.
-
-2003-09-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-000.el (riece-handle-001-message): Parse elements in
- riece-startup-channel-list.
-
-2003-09-21 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-skk-kakutei.el
- (riece-skk-kakutei-command-enter-message-as-notice): Fix typo.
-
-2003-09-20 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-startup-channel-list): Revive.
- * riece-000.el (riece-handle-001-message): Process
- riece-startup-channel-list.
-
- * riece-server.el (riece-open-server): Display "Logging in to
- XXX..." message.
- * riece-000.el (riece-handle-001-message): Clear "Logging in to
- XXX..." message; call riece-after-login-hook.
-
-2003-09-07 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Simplified.
-
-2003-09-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-join): Extract target
- identity-prefix before applying riece-channel-p; format target.
-
-2003-08-30 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.1 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.1.
-
-2003-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-guess.el (riece-guess-channel-try-functions): Default to
- nil.
- (riece-default-guess-channel): Abolish.
- (riece-command-guess-switch-to-channel): Reconstruct
- riece-guess-candidates when it is empty.
-
-2003-08-28 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-dialogue-change-face): Use defvar to
- define.
- (riece-dialogue-notice-face): Ditto.
- (riece-dialogue-wallops-face): Ditto.
- (riece-dialogue-error-face): Ditto.
- (riece-dialogue-info-face): Ditto.
- (riece-dialogue-server-face): Ditto.
- (riece-dialogue-prefix-face): Ditto.
- (riece-channel-list-default-face): Ditto.
- (riece-channel-list-current-face): Ditto.
-
- * riece-unread.el (riece-channel-list-unread-face): Use defvar to
- define.
-
-2003-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-history.el (riece-history-insinuate): Don't set
- riece-guess-channel-try-functions here.
- (riece-history-requires): Don't require riece-guess.
-
- * riece-unread.el (riece-unread-requires): Don't require
- riece-guess.
- (riece-unread-insinuate): Don't set
- riece-guess-channel-try-functions here.
-
-2003-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-after-display-message-function):
- Rename from riece-unread-display-message-function.
- (riece-unread-after-switch-to-channel-function): Rename from
- riece-unread-channel-switch-hook.
- (riece-guess-channel-from-unread): New function.
- (riece-unread-requires): Require 'riece-guess and 'riece-history.
- (riece-unread-insinuate): Setup riece-guess-channel-try-functions.
-
- * riece-options.el (riece-addons): Add riece-guess, riece-history,
- and riece-url.
-
- * riece-layout.el (riece-reconfigure-windows-predicate): Don't
- check riece-last-channel.
-
- * riece-display.el (riece-switch-to-channel): Rename
- riece-channel-switch-hook to
- riece-after-switch-to-channel-functions.
- (riece-switch-to-nearest-channel): Ditto.
-
- * riece-guess.el: New add-on.
- * COMPILE (riece-modules): Add riece-guess.
- * Makefile.am (EXTRA_DIST): Add riece-guess.el
-
- * riece-history.el: New add-on.
- * COMPILE (riece-modules): Add riece-history.
- * Makefile.am (EXTRA_DIST): Add riece-history.el
-
-2003-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-connection-timeout): Abolish.
-
- * riece-server.el (riece-clear-system): Abolish.
- * riece.el (riece-exit): Merge riece-clear-system.
-
-2003-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-sentinel): Suppress status message when
- riece-debug is nil.
-
-2003-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-highlight.el (riece-channel-list-mark-current-channel):
- New function.
-
- * riece-display.el (riece-channel-list-changed): New variable.
- (riece-update-channel-list-buffer): Check riece-channel-list-changed.
- (riece-update-channel-list-indicator): Ditto.
-
-2003-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-addons): Enable riece-unread by default.
-
- * riece-highlight.el (riece-channel-list-current-face): New variable.
- (riece-channel-list-default-face): New face.
-
- * riece-globals.el (riece-channel-list-buffer): Strip leading
- whitespace.
-
-2003-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el: Require 'riece-highlight when compiling.
- (riece-unread): New custom group.
- (riece-channel-list-unread-face): New variable.
- (riece-channel-list-unread-face): New face.
- (riece-unread-requires): New function.
- (riece-unread-insinuate): Add ?! to riece-channel-list-mark-face-alist.
-
- * riece-highlight.el: Highlight *Channels* buffer; rename
- riece-*-face -> riece-dialogue-*-face, riece-highlight-* ->
- riece-dialogue-*.
- (riece-channel-list-font-lock-keywords): New variable.
- (riece-channel-list-mark-face-alist): New variable.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-update-channel-list-buffer):
- Restore channel marks if exist.
-
- * riece-naming.el (riece-naming-assert-join): Don't set
- riece-redisplay-buffers.
- (riece-naming-assert-part): Ditto.
- (riece-naming-assert-rename): Ditto.
-
- * riece-display.el (riece-redisplay-buffers): Abolish.
- (riece-update-user-list-buffer): Don't check
- riece-redisplay-buffers.
- (riece-update-channel-list-buffer): Ditto; prefix "*" at the
- beginning of the current channel.
- (riece-switch-to-channel): Don't set riece-redisplay-buffers.
- (riece-join-channel): Ditto.
- (riece-part-channel): Ditto.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-join-channel): Parse non-nil elements in
- riece-default-channel-binding.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-format-identity): Add 'riece-identity
- property to the resulting string.
-
- * riece-misc.el (riece-concat-channel-topic): Don't append ":" if
- topic is "".
-
- * riece-300.el (riece-handle-322-message): Simplify message.
-
- * riece-commands.el (riece-command-change-layout): Call
- riece-command-configure-windows; Use setq instead of
- custom-set-variables.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.1.0 released.
- * riece-version.el (riece-version-number): Bump up to 0.1.0.
-
-2003-08-25 Daiki Ueno <ueno@unixuser.org>
-
- * COMPILE (riece-compile-modules): Ignore errors during byte
- compilation.
- (riece-install-modules): If there lacks a compiled module, don't
- attempt to install it.
-
- * riece-options.el (riece-quit-timeout): Default to 10.
-
- * riece.el (riece-dialogue-mode-map): Bind riece-command-change-layout.
- (riece): Switch to riece-command-buffer before riece-redisplay-buffers.
-
- * riece-unread.el: Require 'riece-commands.
-
- * riece-server.el: Require 'riece-identity and 'riece-compat.
-
- * riece-ndcc.el: Require 'riece-globals, 'riece-options,
- 'riece-display.
- (riece-handle-dcc-request): Use riece-channel-buffer-name.
-
- * riece-identity.el: Don't require 'riece-server.
-
- * riece-doctor.el: Require 'riece-globals, 'riece-identity,
- 'riece-message, and 'riece-server.
-
- * riece-ctcp.el: Require 'riece-display.
-
- * riece-commands.el: Require 'riece-layout.
- (riece-command-change-layout): New command.
-
- * riece-alias.el: Require 'riece-identity.
-
- * riece-layout.el: No longer provided as an add-on.
- * riece-display.el: Remove window configuration stuff.
-
-2003-08-24 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-command-dcc-send): Bind
- process-connection-type to nil.
-
- * riece-300.el (riece-handle-319-message): New handler.
-
- * riece.el (riece-buffer-mode-alist): Add riece-command-buffer.
- (riece): Signal an error when a server is opened;
- No need to initialize riece-command-buffer specially.
-
-2003-08-22 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-display.el (riece-configure-windows-top): Set
- `truncate-partial-width-windows' nil, when horizontal window
- split.
-
-2003-08-21 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-display.el (riece-configure-windows-top): Change
- user-list-buffer and channel-list-buffer window create logic.
-
- * riece-skk-kakutei.el (riece-skk-kakutei-insinuate): Add
- require riece.el when compile.
-
- * riece.el (riece): Use `riece-redisplay-buffers' instead of
- `riece-configure-windows'.
-
-2003-08-20 TAKAHASHI Kaoru <kaoru@kaisei.org>
-
- * riece-display.el (riece-configure-windows-top): New function.
- * riece-layout.el (riece-layout-alist): Add top.
-
- * riece-skk-kakutei.el: New add-on.
- * COMPILE (riece-modules): Add riece-skk-kakutei.
- * Makefile.am (EXTRA_DIST): Add riece-skk-kakutei.el
-
-2003-08-19 Daiki Ueno <ueno@unixuser.org>
-
- * riece-layout.el: New add-on.
- * COMPILE (riece-modules): Add riece-layout.
- * Makefile.am (EXTRA_DIST): Add riece-layout.el
-
-2003-08-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-options.el (riece-quit-timeout): New user option.
- * riece-server.el (riece-quit-server-process): New function.
- * riece-commands.el (riece-command-quit): Use it.
- (riece-command-close-server): Use it.
-
-2003-08-17 Daiki Ueno <ueno@unixuser.org>
-
- * riece-commands.el (riece-command-previous-channel): Skip nil in
- riece-current-channels.
-
-2003-08-09 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-command-dcc-send): Accept output only from
- the ruby process.
-
- * riece-xemacs.el: Don't require 'riece-compat.
-
-2003-08-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-unread.el (riece-unread-update-channel-list-buffer): Call
- riece-parse-identity.
-
-2003-08-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-find-server-name): Abolish.
-
- * riece-alias.el: Add usage.
-
-2003-08-04 Daiki Ueno <ueno@unixuser.org>
-
- * riece-mini.el (riece-mini-send-message): Use
- riece-completing-read-identity; don't use riece-own-channel-message.
-
- * riece-identity.el: Require 'riece-compat.
- (riece-identity-prefix-case-table): New variable.
- (riece-abbrev-identity-string-function): New variable.
- (riece-expand-identity-string-function): New variable.
- (riece-format-identity): Rename from riece-decode-identity.
- (riece-parse-identity): Rename from riece-encode-identity.
- (riece-with-identity-buffer): Abolish.
- (riece-identity-canonicalize-prefix): Use case-table.
-
- * riece-filter.el (riece-handle-numeric-reply): Decode messages.
- (riece-handle-message): Ditto.
-
- * riece-alias.el: New add-on.
- * COMPILE (riece-modules): Add riece-alias.
- * Makefile.am (EXTRA_DIST): Add riece-alias.el.
-
- * riece-emacs.el (riece-set-case-syntax-pair): New alias.
- * riece-xemacs.el (riece-set-case-syntax-pair): New alias.
- * riece-identity.el (riece-identity-canonicalize-prefix): Simplified.
-
-2003-08-03 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.4 released.
- * riece-version.el (riece-version-number): Bump up to 0.0.4.
-
-2003-06-24 OHASHI Akira <bg66@koka-in.org>
-
- * riece-unread.el (riece-unread-display-message-function): Don't check
- `selected-window'. It doesn't work as expected.
-
-2003-06-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-misc.el (riece-channel-p): Moved from riece-channel.el.
-
- * riece-300.el: Rewrite using riece-decode-identity.
-
- * riece-identity.el (riece-completing-read-identity): Signal an
- error when the encoded channel name is not matched with
- riece-channel-regexp.
-
- * riece-globals.el (riece-channel-regexp): Moved from
- riece-channel.el.
- (riece-user-regexp): Moved form riece-user.el.
-
-2003-06-23 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-handle-join-message): Don't call
- riece-switch-to-channel.
- (riece-handle-part-message): Don't decode message if it is empty.
- (riece-handle-kick-message): Ditto.
- (riece-handle-quit-message): Ditto.
- (riece-handle-kill-message): Ditto.
-
- * riece-commands.el (riece-command-part): Show the current channel
- as default candidate.
-
- * riece-identity.el (riece-completing-read-identity): Accept
- optional 5th argument `initial'.
-
- * riece-unread.el (riece-unread-update-channel-list-buffer):
- Simplified.
-
- * riece-filter.el (riece-sentinel): Don't bind
- riece-inhibit-update-buffers.
-
- * riece-display.el (riece-redisplay-buffer): New variable.
- (riece-inhibit-update-buffers): Abolish.
- (riece-update-channel-list-buffer): Memorize
- encoded identity as text property on each line.
-
- * riece.el (riece-channel-list-mode): Make riece-redisplay-buffer
- buffer local.
- (riece-user-list-mode): Ditto.
-
-2003-06-22 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-log.el, riece-mini.el, riece-unread.el, riece-url.el:
- Fix example setting, don't use 3rd arg of add-to-list.
-
- * riece-coding.el (riece-default-coding-system): Fix default value.
-
-2003-06-22 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-inhibit-update-buffers): New variable.
- * riece-filter.el (riece-sentinel): Bind
- riece-inhibit-update-buffers while removing channels from
- riece-current-channels.
- * riece-unread.el (riece-unread-display-message-function): Don't
- update channel list buffer when riece-inhibit-update-buffers is
- non-nil.
- (riece-unread-channel-switch-hook): Ditto.
- (riece-unread-insinuate): Add
- riece-unread-update-channel-list-buffer to
- riece-update-buffer-functions.
-
- * riece-commands.el (riece-command-switch-to-channel): Call
- riece-redisplay-buffers instead of riece-command-configure-windows.
-
- * riece-identity.el (riece-completing-read-identity): Remove nil
- from riece-current-channels before converting it to an alist.
-
-2003-06-17 OHASHI Akira <bg66@koka-in.org>
-
- * riece-unread.el (riece-unread-display-message-function): Check a
- `selected-window'.
-
- * riece-mini.el: New add-on.
- * COMPILE (riece-modules): Add `riece-mini'.
- * Makefile.am (EXTRA_DIST): Add `riece-mini.el'.
-
- * riece-display.el (riece-channel-buffer-create): Add new hook.
- * riece-log.el: New add-on for saving irc logs.
- * COMPILE (riece-modules): Add `riece-log'.
- * Makefile.am (EXTRA_DIST): Add `riece-log.el'.
-
- * riece-commands.el (riece-command-join): Use `let*' instead of `let'.
- (riece-command-part): Ditto.
-
-2003-06-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-naming.el (riece-naming-assert-join): Call
- riece-update-buffers.
- (riece-naming-assert-part): Ditto.
-
- * riece-filter.el (riece-sentinel): Don't bind
- riece-overriding-server-name; use riece-part-channel.
-
- * riece-display.el (riece-switch-to-channel): Don't set
- riece-channel-buffer.
- (riece-update-buffers): Set riece-channel-buffer here.
-
- * riece-commands.el (riece-command-switch-to-channel-by-number): Fixed.
- (riece-command-close-server): Fixed completion bug.
- (riece-command-universal-server-name-argument): Ditto.
-
-2003-06-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-doctor.el: Don't require 'doctor; autoload doctor-mode and
- doctor-read-print.
-
- * riece-handle.el (riece-handle-nick-message): Use
- riece-decode-identity to decode user.
- (riece-handle-join-message): Ditto.
- (riece-handle-part-message): Ditto.
- (riece-handle-kick-message): Ditto.
- (riece-handle-quit-message): Ditto.
- (riece-handle-kill-message): Ditto.
- (riece-handle-invite-message): Ditto.
- (riece-handle-topic-message): Ditto.
- (riece-handle-mode-message): Ditto.
-
-2003-06-12 Daiki Ueno <ueno@unixuser.org>
-
- * riece-message.el (riece-own-channel-message): Abolish.
-
- * riece-commands.el (riece-command-send-message): Don't use
- riece-own-channel-message.
-
- * riece-doctor.el (riece-doctor-reply): Don't use
- riece-own-channel-message.
- (riece-doctor-hello-regexp): New user option.
- (riece-doctor-bye-regexp): New user option.
-
-2003-06-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-identity-member-no-server): Abolish.
-
- * riece-doctor.el (riece-doctor-patients): Make it global variable.
- (riece-doctor-after-privmsg-hook): Use riece-identity-member
- instead of riece-identity-member-no-server.
-
-2003-06-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-doctor.el: New add-on.
- * COMPILE (riece-modules): Add riece-doctor.
- * Makefile.am (EXTRA_DIST): Add riece-doctor.el
-
-2003-06-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-handle.el (riece-handle-nick-message): Follow the change
- of riece-identity-member.
-
- * riece-commands.el (riece-command-next-channel): Use
- riece-identity-member instead of riece-identity-member-no-server.
- (riece-command-previous-channel): Ditto.
-
-2003-06-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-completing-read-identity): Remove nil
- from channels before completing-read.
-
- * riece-message.el (riece-message-make-name): Fix condition for priv.
- (riece-message-make-global-name): Ditto.
- (riece-message-buffer): Ditto.
-
- * riece-misc.el (riece-current-nickname): Use
- riece-with-identity-buffer.
-
-2003-06-11 Daiki Ueno <ueno@unixuser.org>
-
- * riece-message.el (riece-message-parent-buffers): Regard message's
- speaker as target when priv mode.
-
- * riece-display.el (riece-update-channel-indicator): Decode
- riece-current-channel even in priv mode.
-
- * riece-identity.el (riece-decode-identity): Respect prefix-only.
- (riece-completing-read-identity): Check if illegal characters in
- channel name.
-
-2003-06-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-buffer-mode-alist): Add riece-user-list-buffer.
- * riece-globals.el (riece-user-buffer-format): Abolish.
- (riece-user-list-buffer): Default to " *Users*".
- * riece-display.el (riece-user-list-buffer-name): Abolish.
- (riece-user-list-buffer-create): Abolish.
-
-2003-06-08 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-handle-numeric-reply): Don't decode messages.
- (riece-handle-message): Ditto.
- (riece-sentinel): Clear system here.
-
- * riece-server.el (riece-server-process-name): New function.
- (riece-server-process): New function.
- (riece-close-server): Abolish.
-
- * riece-identity.el: Adopt vector object representation for
- identity objects.
- (riece-with-identity-buffer): New macro.
- (riece-decode-identity): New function.
- (riece-encode-identity): New function.
-
- * riece-globals.el (riece-process-list): New variable.
- (riece-server-process-alist): Abolish.
- (riece-channel-buffer-alist): Abolish.
- (riece-user-list-buffer-alist): Abolish.
- (riece-short-channel-indicator): New variable.
-
- * riece-channel.el: Assume that we are already in the server buffer.
- * riece-user.el: Likewise.
-
-2003-06-06 OHASHI Akira <bg66@koka-in.org>
-
- * riece-ndcc.el (riece-ndcc-server-sentinel): Close a parenthesis.
-
- * riece-rdcc.el (riece-rdcc-insinuate): Don't use the 3rd argument of
- `add-to-list'.
-
-2003-06-06 Daiki Ueno <ueno@unixuser.org>
-
- * riece-channel.el (riece-forget-channel): Fixed.
- (riece-channel-modeless-regexp): Abolish.
- (riece-channel-modeless-p): Abolish.
-
-2003-06-06 OHASHI Akira <bg66@koka-in.org>
-
- * riece-unread.el (riece-unread-display-message-function): Delete the
- target before adding to list.
- (riece-unread-switch-to-channel): New function.
- (riece-unread-insinuate): Bind "\C-c\C-u" to riece-command-mode-map.
- Bind "u" to riece-dialogue-mode-map.
- Bind "u" to riece-channel-list-mode-map.
-
- * riece.el (riece-channel-list-mode-map): Don't bind
- `riece-command-unread-channel'.
-
-2003-06-04 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-000.el,riece-200.el,riece-300.el,riece-400.el,riece-500.el,
- riece-commands.el,riece-filter.el,riece-handle.el,riece-highlight.el
- riece-identity.el,riece-message.el,riece-misc.el,riece-naming.el,
- riece.el: Don't require riece-inlines since it has been removed.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-update-user-list-buffer): Rename from
- riece-user-list-update-buffer.
- (riece-update-channel-list-buffer): Rename from
- riece-channel-list-update-buffer.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-identity.el (riece-identity-canonicalize-prefix): Moved
- from riece-inlines.el; renamed from scandinavian-downcase.
- (riece-identity-equal-no-server): Moved from riece-inlines.el;
- renamed from scandinavian-equal-ignore-case.
- (riece-identity-equal-no-server-safe): New function.
- (riece-identity-member-no-server): Moved from riece-inlines.el;
- renamed from scandinavian-member-ignore-case.
- (riece-identity-member-no-server-safe): New function.
-
- * riece-inlines.el: Removed.
- * COMPILE (riece-modules): Remove riece-inlines.
- * Makefile.am (EXTRA_DIST): Remove riece-inlines.el.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-rdcc-sentinel): Don't call delete-process
- explicitly.
- * riece-ndcc.el: Don't call delete-process explicitly.
- * riece-server.el (riece-close-server-process): Don't call
- delete-process explicitly unless riece-debug == t.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-inlines.el (scandinavian-downcase): New inline function.
- (scandinavian-equal-ignore-case): Rename from
- string-equal-ignore-case.
- (scandinavian-member-ignore-case): Rename from
- string-list-member-ignore-case.
-
- * riece-identity.el (riece-identity-equal): Rename from
- riece-identity-equal-no-server; use scandinavian-equal-ignore-case.
- (riece-identity-equal-safe): Rename from riece-identity-equal.
- (riece-identity-member): Rename from riece-identity-member-no-server.
- (riece-identity-member-safe): Rename from riece-identity-member.
- (riece-identity-assoc): Rename from riece-identity-assoc-no-server.
- (riece-identity-assoc-safe): Rename from riece-identity-assoc.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el: Require 'riece-ctcp.
- (riece-rdcc-insinuate): Add "DCC" to
- riece-ctcp-additional-clientinfo.
-
- * riece-ctcp.el (riece-ctcp-additional-clientinfo): New variable.
- (riece-command-ctcp-clientinfo): New command.
- (riece-ctcp-insinuate): Bind it in riece-dialogue-mode-map.
- (riece-handle-ctcp-clientinfo-request): New handler.
- (riece-handle-ctcp-clientinfo-response): New handler.
-
- * riece-server.el (riece-open-server): No need to use
- get-buffer-create to reuse process buffer.
-
-2003-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el (riece-command-dcc-send): Generate new buffer for
- DCC process.
- (riece-command-dcc-receive): Likewise; don't set buffer-file-name.
-
- * riece-server.el (riece-server-keyword-map): `:coding-system' ->
- `:coding'.
- (riece-open-server): Follow the change.
-
- * riece-ctcp.el (riece-command-ctcp-action): New command.
- (riece-ctcp-insinuate): Bind it in riece-dialogue-mode-map.
- (riece-handle-ctcp-action-request): New handler.
-
- * riece.el (riece-command-mode): Enclose status indicators with
- `{}'; show riece-user-indicator.
- (riece-channel-mode): Likewise.
- (riece-dialogue-mode): Enclose status indicators with `{}'.
- * riece-globals.el (riece-user-indicator): New indicator.
- (riece-freeze-indicator): Default to "-".
- * riece-display.el (riece-update-channel-indicator): Don't update
- modeline.
- (riece-update-status-indicators): Set riece-user-indicator.
- * riece-300.el (riece-handle-324-message): Update channel indicator.
-
-2003-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-command-mode): Don't set riece-freeze-indicator.
- (riece-dialogue-mode): Call riece-update-status-indicators.
- (riece-channel-mode): Add riece-operator-indicator to
- mode-line-buffer-identification.
- * riece-user.el (riece-make-user): New attribute `operator'.
- (riece-user-operator): New function.
- (riece-user-set-operator): New function.
- (riece-user-toggle-away): New function.
- (riece-user-toggle-operator): New function.
- * riece-misc.el (riece-own-frozen): Revive.
- * riece-message.el (riece-display-message): Reset riece-freeze if
- riece-freeze == 'own && (riece-message-own-p message).
- * riece-globals.el (riece-own-freeze): Abolish; use riece-freeze.
- (riece-operator-indicator): New variable.
- * riece-display.el (riece-update-status-indicators): New function.
- (riece-update-buffer-functions): Add it.
- * riece-commands.el (riece-command-toggle-freeze): Don't call
- riece-freeze.
- (riece-command-toggle-own-freeze): Don't call riece-own-freeze.
- * riece-300.el (riece-handle-302-message): Use
- riece-user-toggle-away instead of riece-user-set-away.
- (riece-handle-301-message): Ditto.
- (riece-handle-305-message): Ditto.
- (riece-handle-306-message): Ditto.
- (riece-handle-352-message): Ditto.
-
-2003-06-02 Yoichi NAKAYAMA <yoichi@geiin.org>
-
- * riece-commands.el (riece-command-next-channel): Circularly
- follow the channel list.
- (riece-command-previous-channel): Ditto.
-
-2003-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece.el (riece-command-mode): Set default value of riece-freeze
- & riece-own-freeze.
- * riece-options.el (riece-away-message): New user option.
- * riece-commands.el (riece-command-toggle-away): Query user away
- message.
- * riece-300.el (riece-handle-301-message): Set user's away status.
- (riece-handle-305-message): Ditto.
- (riece-handle-306-message): Ditto.
- (riece-handle-302-message): Ditto.
- (riece-handle-352-message): Ditto.
-
-2003-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el: Require riece-globals, riece-misc, riece-channel,
- and riece-identity.
- (riece-command-dcc-receive): Check the existence of
- set-buffer-multibyte.
-
-2003-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.3 released.
- * riece-version.el (riece-version-number): Bump up to 0.0.3.
-
- * riece-ctcp.el (riece-handle-ctcp-request): Catch errors occured
- in hooks.
- (riece-handle-ctcp-response): Ditto.
-
-2003-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-user.el (riece-rename-user): Don't modify entry when
- old-name == new-name.
-
- * riece-display.el (riece-configure-windows): Use window-buffer
- instead of current-buffer.
-
- * riece-rdcc.el (riece-rdcc-server-address): Default to nil.
- (riece-rdcc-ruby-command): New user option.
- (riece-rdcc-send-program): New user option.
- (riece-rdcc-decode-address-program): New user option.
- (riece-rdcc-substitute-variables): New function.
- (riece-command-dcc-send): Use it.
- (riece-rdcc-decode-address): Use it.
-
-2003-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-rdcc.el: New add-on.
-
- * Makefile.am (EXTRA_DIST): Add riece-rdcc.el
-
-2003-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ndcc.el: New add-on.
- * Makefile.am (EXTRA_DIST): Add riece-ndcc.el
-
-2003-05-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-open-server): Simplify message.
-
- * riece-commands.el (riece-command-open-server): Throw an error
- when the server is already opened.
-
- * riece-filter.el (riece-sentinel): Simplified.
-
- * riece-display.el (riece-user-list-update-buffer): Check the
- existence of riece-user-list-buffer.
- (riece-channel-list-update-buffer): Check the existence of
- riece-channel-list-buffer.
- (riece-set-window-points): Ditto.
-
- * riece-commands.el (riece-command-open-server): Simplified.
- (riece-command-toggle-channel-buffer-mode): Set
- riece-save-variables-are-dirty to t.
- (riece-command-toggle-user-list-buffer-mode): Ditto.
- (riece-command-toggle-channel-list-buffer-mode): Ditto.
-
- * riece-server.el (riece-start-server): Abolish.
- (riece-open-server): Set riece-server-process-alist and
- riece-server-process here.
-
-2003-05-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece-filter.el (riece-sentinel): Close process even if
- riece-reconnect-with-password == t.
- (riece-handle-message): Catch errors occured in hooks.
-
- * riece-server.el (riece-open-server): Reuse server buffer.
- (riece-close-server-process): Delete process even if process is
- not running.
-
-2003-05-31 Daiki Ueno <ueno@unixuser.org>
-
- * riece-server.el (riece-open-server): No need to reset
- riece-reconnect-with-password.
-
- * riece-filter.el (riece-sentinel): Don't call riece when
- riece-reconnect-with-password = t and process !=
- riece-server-process.
-
- * riece-url.el: Fix usage.
-
- * riece-inlines.el (string-list-member-ignore-case): Remove docstring.
-
- * riece-unread.el: New add-on.
- * COMPILE (riece-modules): Add riece-unread.
- * Makefile.am (EXTRA_DIST): Add riece-unread.el
-
- * riece-300.el (riece-handle-322-message): New handler.
- (riece-handle-323-message): New handler.
-
-2003-05-30 Daiki Ueno <ueno@unixuser.org>
-
- * riece-display.el (riece-configure-windows): Select other window
- when minibuffer is active.
-
- * riece-commands.el (riece-command-list): New command.
- (riece-command-enter-message-as-notice): New command.
- * riece.el (riece-command-mode-map): Bind
- riece-command-enter-message-as-notice and riece-command-list.
-
- * riece-server.el (riece-close-server): Skip nil when leaving
- channels before closing server.
-
-2003-05-30 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.2 released.
- * riece-version.el (riece-version-number): Bump up to 0.0.2.
-
- * riece.el (riece-load-and-build-addon-dependencies): Fixed.
- * riece-url.el (riece-url-requires): Don't assert dependency on
- riece-highlight unless it appears in riece-addons.
-
- * riece-url.el: New add-on.
- * COMPILE (riece-modules): Add riece-url.
-
- * riece-message.el (riece-message-make-bracket): Abolish.
- * riece-highlight.el (riece-highlight-font-lock-keywords):
- Give up to fontify "-nick-" or "-nick server-".
-
- * riece-highlight.el (riece-highlight-font-lock-keywords):
- Simplified regexp.
-
- * riece-ctcp.el (riece-handle-ctcp-request): Don't bind user.
- (riece-handle-ctcp-response): Ditto.
-
- * riece-highlight.el: Make it an add-on.
- (riece-highlight-insinuate): New function.
- * riece.el: Don't require 'riece-highlight.
- * riece-options.el (riece-addons): Turn on riece-highlight and
- riece-ctcp by default.
-
- * riece-display.el (riece-configure-windows-predicate): New function.
- (riece-configure-windows-predicate): New user option.
- (riece-redisplay-buffers): Use it.
-
- * riece-complete.el: Require 'cl for butlast.
-
- * Makefile.am (elc): Renamed from "compile".
-
- * riece.el (riece-dialogue-mode-map): Bind
- riece-command-toggle-channel-list-buffer-mode.
-
- * riece-display.el (riece-configure-windows): Typo fixed.
-
- * riece-user.el (riece-user-toggle-channel): Use member instead of
- memq.
-
-2003-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * riece-ctcp.el (riece-ctcp-insinuate): New function.
-
- * riece-options.el (riece-addons): New user option.
- (riece-addon-directory): New user option.
-
- * riece.el (riece-load-and-build-addon-dependencies): New function.
- (riece-insinuate-addons): New function.
- (riece): Call riece-insinuate-addons.
-
- * riece-misc.el (riece-get-users-on-server): Moved from
- riece-commands.el.
-
- * riece-ctcp.el: New file.
- * COMPILE (riece-modules): Add riece-ctcp.
- * Makefile.am (EXTRA_DIST): Add riece-ctcp.el
-
-2003-05-29 Daiki Ueno <ueno@unixuser.org>
-
- * Riece: Version 0.0.1 released.
-
- * riece-commands.el (riece-command-names): New command.
- (riece-command-who): New command.
-
- * riece.el (riece-dialogue-mode-map): Bind riece-command-names and
- riece-command-who.
-
- * riece-300.el (riece-handle-341-message): New handler.
- (riece-handle-352-message): New handler.
-
- * riece-commands.el (riece-command-invite): Don't accept channel
- argument; throw an error when user is not on a channel.
- (riece-command-kick): New command.
+++ /dev/null
-2003-05-24 Daiki Ueno <ueno@unixuser.org>
-
- * liece-000.el (liece-handle-000-messages): Don't set liece-nickname.
- * liece-400.el (liece-iterate-nick): Abolish.
- (liece-handle-433-message): Don't use liece-iterate-nick.
- * liece-channel.el: Abolish channel representation format.
- (liece-default-channel-representation-format): Abolish.
- (liece-dcc-channel-representation-format): Abolish.
- (liece-channel-prepare-representation): Abolish.
- (liece-channel-parse-representation): Abolish.
- * liece-commands.el (liece-command-save-variables): Rename from
- liece-command-save-vars; simplify using with-temp-file.
- * liece-ctcp.el: Require liece-version.
- * liece-globals.el: Rearrange variables by usage; don't require
- liece-version.
- (liece-last-nickname): Rename from liece-nickname-last.
- (liece-last-who-expression): Rename from liece-who-expression.
- (liece-real-userhost): Rename from liece-my-userhost.
- (liece-last-chat-partner): Rename from liece-privmsg-partner.
- (liece-last-friends): Rename from liece-friends-last.
- (liece-real-server-name): New variable.
- (liece-server-process-alist): New variable.
- (liece-command-buffer-mode-indicator): Rename from
- liece-private-indicator.
- (liece-server-buffer): Abolish.
- * liece-inlines.el (liece-next-line): Abolish.
- * liece-misc.el (liece-send-pong): Abolish.
- (liece-increment-long-reply-count): Define as function.
- (liece-reset-long-reply-count): Ditto.
- (liece-check-long-reply-count): Ditto.
- * liece-q-el.el (liece-quote-el-decode-string): Fix typo.
- * liece-vars.el (liece-saved-forms): Don't purecopy.
- (liece-want-traditional): Abolish.
- (liece-command-window-on-top): Abolish.
- (liece-one-buffer-mode): Abolish.
- (liece-saved-variables-file): New variable.
- (liece-server-alist): Default to nil.
- (liece-my-userhost): Remove.
- (liece-nick-max-length): Abolish.
- (liece-real-nickname): Remove.
- (liece-grow-tail): Abolish.
- (liece-retry-with-new-nickname): Rename from liece-auto-iterate-nick.
- (liece-after-registration): Abolish.
- (liece-status-message-string): Abolish.
- (liece-channel-unread-list): Moved to liece-globals.el.
- * liece-version.el: Bind utf-2000-version, and mule-version.
- * liece-xemacs.el: Require liece-version.
- * liece.el (liece-tmp-server-name): Abolish.
- (liece-read-variables-files): Remove migration logic.
- (liece): Don't add liece-nickname to liece-nick-alist.
- (liece-accept-response): Don't retry with the new nickname.
-
-2003-05-23 Daiki Ueno <ueno@unixuser.org>
-
- * liece-message.el: Overhaul; don't depend on dynamic binding.
- (liece-message-brackets): Abolish.
- (liece-message-tags): Abolish.
- (liece-message-empty-predicate): Abolish.
- (liece-message-make-open-bracket-function): New variable.
- (liece-message-make-close-bracket-function): New variable.
- (liece-message-make-name-function): New variable.
- (liece-message-make-global-name-function): New variable.
- (liece-message-type): Abolish; define as function.
- (liece-message-target): Abolish; define as function.
- (liece-message-speaker): Abolish; define as function.
- (liece-message-direction): Abolish; use liece-message-own-p.
- (liece-message-predicate): Abolish.
- (liece-message-brackets-function): Abolish.
- (liece-message-tags-function): Abolish.
- (liece-message-buffer-function): Rename to liece-message-buffers.
- (liece-message-parent-buffer): Rename to liece-message-parent-buffers.
- (liece-message-make-open-bracket): New function.
- (liece-message-make-close-bracket): New function.
- (liece-message-make-bracket): New function.
- (liece-message-make-name): New function.
- (liece-message-make-global-name): New function.
- (liece-display-message): Rewrite; remove autoload cookie.
- (liece-make-message): New function.
- (liece-message-private-p): New function.
- (liece-message-external-p): New function.
- * liece-misc.el (liece-own-channel-message): Move to liece-message.el.
- (liece-own-private-message): Ditto.
- * liece-commands.el (liece-command-message): Don't use
- liece-message-empty-predicate.
- * liece-ctcp.el (liece-ctcp-action-message): Use new API.
- (liece-ctcp-insert): Ditto.
- * liece-dcc.el (liece-dcc-chat-filter): Use new API.
- * liece-handle.el (liece-handle-notice-message): Use new API.
- (liece-handle-privmsg-message): Ditto.
-
-2003-05-23 Daiki Ueno <ueno@unixuser.org>
-
- * liece-misc.el (liece-insert-timestamp): Abolish.
- (liece-own-frozen): Abolish.
- (liece-own-message): Abolish.
- (liece-scroll-if-visible): Abolish.
- (liece-generate-hex-timestamp): Abolish.
- (liece-hex-timestamp-valid): Abolish.
-
-2003-05-22 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-tag-region): Simplify.
- * liece-misc.el (liece-remove-properties-region): Abolish.
-
-2003-05-18 OHASHI Akira <bg66@koka-in.org>
-
- * liece.el (liece-dialogue-mode-map): Don't bind
- `liece-command-open-server'.
-
-2003-04-30 OHASHI Akira <bg66@koka-in.org>
-
- * liece-channel.el (liece-channel-list-redisplay-buffer): Search a
- channel correctly.
-
-2003-04-17 Daiki Ueno <daiki@xemacs.org>
-
- * liece-channel.el: Require 'liece-misc when compiling.
- (liece-channel-equal): Define as function.
- (liece-channel-buffer-create): Define as function.
- (liece-channel-switch-to-last): Define before it is used.
- * liece-ctcp.el: Require 'liece-misc when compiling.
- * liece-message.el: Require 'liece-misc when compiling.
- * liece-misc.el: Move some macros to the beginning of the file.
- * liece-nick.el: Require 'liece-inlines when compiling.
- (liece-nick-equal): Define as function.
- (liece-nick-buffer-create): Define as function.
-
-2003-03-26 Steve Youngs <youngs@xemacs.org>
-
- * liece-channel.el (liece-channel-p): Don't wrap the string-match
- in a 'eval-when-compile' to avoid a void variable error.
- (liece-channel-modeless-p): Ditto.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile.lisp:
- * Makefile.lisp (autoload): New.
- Separate autoload building from elc building.
-
- * liece-make.el (install-update-package-files):
- Use new `batch-update-directory-autoloads' if available.
-
-2002-12-08 Ville Skyttä <scop@xemacs.org>
-
- * Makefile.lisp (all): Not a double-colon any more.
-
-2002-10-11 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
-
- * liece-emacs.el: Require pces to avoid compile error.
-
-2002-09-26 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el (liece-minibuf-completing-read): Don't use the
- 7th argument of completing-read.
-
-2002-09-24 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): Check chnlp before
- passing mode argument to liece-channel-set-*.
- [cf. <Bug#161779>]
-
-2002-09-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-quit-message): Don't use
- liece-nick-mark-as-apart.
- (liece-handle-join-message): Ditto.
- [cf. <Liece:00080>]
-
-2002-09-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): The arglist of
- liece-nick-set-mode was changed.
-
-2002-08-27 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-join-channel): User
- liece-nick-get-joined-channels.
-
- * liece-channel.el (liece-channel-set-topic): Define as function.
- (liece-channel-add-mode): Ditto.
- (liece-channel-remove-mode): Ditto.
- (liece-channel-set-mode): Ditto.
- (liece-channel-add-ban): Ditto.
- (liece-channel-remove-ban): Ditto.
- (liece-channel-set-ban): Ditto.
- (liece-channel-add-exception): Ditto.
- (liece-channel-remove-exception): Ditto.
- (liece-channel-set-exception): Ditto.
- (liece-channel-add-invite): Ditto.
- (liece-channel-remove-invite): Ditto.
- (liece-channel-set-invite): Ditto.
- * liece-nick.el (liece-nick-mark-as-part): Replace
- liece-nick-{mark,unmark}-as-apart.
- (liece-nick-get-modes): Define as function.
- (liece-nick-add-mode): Ditto.
- (liece-nick-remove-mode): Ditto.
- (liece-nick-set-mode): Ditto.
- * liece-handle.el (liece-handle-mode-message): Follow the changes
- of arglists of liece-channel-set-mode and liece-nick-set-mode.
-
- * liece.el: Fix typo.
- * liece-misc.el (liece-current-nickname): Define as function.
- (liece-current-channel): Ditto.
- (liece-current-channels): Ditto.
- (liece-current-chat-partner): Ditto.
- (liece-current-chat-partners): Ditto.
-
-2002-08-26 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-mode-message): Care
- liece-channel-set-* are defined as macros.
- * liece-inlines.el (string-equal-ignore-case): Don't use
- compare-strings.
- (string-list-member-ignore-case): Don't use member-ignore-case.
- Suggested by "Akinori MUSHA" <knu@iDaemons.org>.
- [cf. <Liece:00075>]
-
-2002-08-11 OHASHI Akira <bg66@koka-in.org>
-
- * liece-window.el (liece-configure-windows): Set
- `liece-channel-buffer' to nil when `liece-current-chat-partner' or
- `liece-current-channel' is nil.
- (Suggested by Kazushige Maeda <pff@softai.co.jp>.)
-
- * liece-dcc.el (liece-dcc-dequeue-request): Do nothing when
- `liece-dcc-requests' is empty.
- (liece-command-dcc-accept): Ditto.
- (liece-command-dcc-chat-connect): Ditto.
-
-2002-07-15 Daiki Ueno <ueno@unixuser.org>
-
- * liece-url.el (liece-url-regexp-alist): New user option.
- (liece-url-add-buttons): Respect liece-url-regexp-alist. This
- function is the slightly modified version of the implementation by
- akira yamada <akira@arika.org>. [cf. <Liece:00070>]
-
-2002-07-13 Daiki Ueno <daiki@xemacs.org>
-
- * liece-menu.el (liece-menu-add-url): Always switch to *Commands*
- buffer.
- * liece-xemacs.el (liece-fix-menu-path-switch-buffer): Removed old
- defadvice to easy-menu-add-item.
-
-2002-06-08 Adrian Aichner <adrian@xemacs.org>
-
- * liece-commands.el (liece-command-nickname): Use
- truncate-string-to-width instead of non-existent truncate-string.
- * liece.el (liece-open-server): Ditto.
-
-2002-06-05 Steve Youngs <youngs@xemacs.org>
-
- * liece-inlines.el (string-equal-ignore-case): Don't try to use
- 'compare-strings'.
-
-2002-05-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-modeline-glyph): Check 'xbm.
-
-2002-05-04 Stephen J. Turnbull <stephen@xemacs.org>
-
- * liece-make.el (config-liece-package-directory):
- * liece-config.el (PACKAGEDIR):
- Handle case when dirs is nil.
-
- * Makefile.lisp (package): Preload advice.
-
-2002-05-12 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-default-locale): New variable.
- (bind-text-domain): Use it.
-
-2002-05-07 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-mapcar*): Eliminate recursion.
-
-2002-04-14 Daiki Ueno <ueno@unixuser.org>
-
- * bitmap-stipple.el (bitmap-stipple-frame-char-width): New function.
- (bitmap-stipple-frame-char-height): New function.
-
- * liece-compat.el (liece-region-active-p): New function.
- (liece-truncate-string-to-width): New function.
-
- * liece-misc.el: Sort macrodefs.
- (liece-maybe-poll): Abolish.
-
- * liece-channel.el (liece-channel-last): Simplified.
- (liece-channel-switch-to-last): Define as function.
-
- * liece-commands.el (liece-command-ping): Send system-name until
- liece-server-name is determined.
-
- * liece-ctcp.el: Load `liece-q-*' even when compiling.
-
- * liece-hilit.el (liece-highlight-turn-on-font-lock): Don't set
- font-lock-support-mode if it isn't bound.
-
-2002-03-28 Daiki Ueno <ueno@unixuser.org>
-
- * liece-400.el (liece-handle-475-message): New handler.
-
- * liece-commands.el (liece-command-join): Don't encode a channel
- name before treating it as an integer.
-
- * liece-ctcp.el: Don't throw an error when liece-q-ccl is not found.
-
-2002-04-08 Daiki Ueno <daiki@xemacs.org>
-
- * liece-misc.el: Don't require pccl and broken.
-
-2002-04-07 Daiki Ueno <daiki@xemacs.org>
-
- * liece-modules.el: Don't compile liece-q-ccl.el.
- * liece-ctcp.el: Don't require liece-q-ccl.el.
-
-2002-03-24 Daiki Ueno <daiki@xemacs.org>
-
- * liece-coding.el (liece-mime-charset-for-write): Use
- `mime-charset-to-coding-system' instead of `mime-charset-p'.
- (liece-mime-charset-for-read): Ditto.
-
-2002-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (bind-text-domain): Respect LC_ALL and LC_MESSAGES;
- reverse lang-paths.
-
-2002-03-20 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el (gettext-parse-Content-Type): Bind `case-fold-search'
- to t to extract Content-Type: field properly.
-
-2002-03-19 Daiki Ueno <ueno@unixuser.org>
-
- * gettext.el: Autoload `mime-content-type-parameter' and
- `mime-read-Content-Type' only when compiling.
- (gettext-parse-Content-Type): Add bogus detection logic.
-
-2002-03-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (liece-string-to-list): New definition.
- * liece-000.el (liece-handle-004-message): Use it.
- * liece-nick.el (liece-nick-remove-mode): Use it.
- * liece-channel.el (liece-channel-read-mode): Use it.
- * liece-handle.el (liece-handle-mode-message): Use it.
-
- * gettext.el: Require `poem' and `static'.
- (gettext-string-to-list): New definition.
-
-2002-02-17 OHASHI Akira <bg66@koka-in.org>
-
- * gettext.el (bind-text-domain): Implement a catalog probe mechanism.
- (Implemented by YAMASHITA Junji <ysjj@unixuser.org>)
-
-2002-02-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-modules.el (liece-modules-to-compile): Add `liece-coding'.
-
- * liece-coding.el (liece-mime-charset-for-write): Use
- default-mime-charset-for-write as its default.
- (liece-mime-charset-for-read): Use default-mime-charset as its
- default.
-
-2002-01-28 Daiki Ueno <ueno@unixuser.org>
-
- * liece-dcc.el (liece-dcc-start-process): New function.
- (liece-command-dcc-send): Use it.
- (liece-command-dcc-receive): Use it.
- (liece-command-dcc-chat-listen): Use it.
- (liece-command-dcc-chat-connect): Use it.
-
-2001-11-09 Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>
-
- * liece-vars.el (liece-truncate-partial-width-windows): Change
- default value to fix the inconsistency with docstring.
-
- * liece-window.el (liece-configure-windows): Ditto.
-
-2001-11-03 OHASHI Akira <bg66@koka-in.org>
-
- * liece-emacs.el (liece-emacs-unread-mark): Use regexp-quote.
- (liece-emacs-read-mark): Ditto.
- * liece-xemacs.el (liece-xemacs-unread-mark): Ditto.
- (liece-xemacs-read-mark): Ditto.
-
-2001-10-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-misc.el (liece-subtract-time): New function.
- (liece-time-difference): Use it.
-
-2001-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-misc.el (liece-time-difference): Fix the arglist.
- [cf. <Liece:45>]
-
-2001-10-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (replace-in-string): Follow a change in XEmacs.
-
-2001-10-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-buffer-min-size): Rename from
- `liece-buffer-default-size'.
-
- * liece-commands.el (liece-command-kill): Use `liece-time-elapsed'
- instead of `liece-time-add'.
-
- * liece.el (liece-check-buffers-if-interval-expired): Swap the
- arguments supplied to `liece-time-difference'.
- (liece-check-buffers): Use `liece-buffer-min-size' instead of
- `liece-buffer-default-size'.
-
- * liece-misc.el (liece-time-difference): Define as function.
- (liece-time-elapsed): Rename from `liece-time-add'.
- (liece-generate-hex-timestamp): Define as function.
-
-2001-10-02 Katsuhiro Hermit Endo <hermit@koka-in.org>
-
- * liece-misc.el (liece-time-difference): Use `abs' for
- `liece-check-buffers-if-interval-expired'.
-
-2001-09-16 Katsuhiro Hermit Endo <hermit@koka-in.org>
-
- * liece-vars.el (liece-server-alist): Update default value.
-
-2001-06-19 OHASHI Akira <bg66@koka-in.org>
-
- * liece-url.el (liece-url-regexp): Fix regexp.
-
- * liece-vars.el (liece-display-unread-mark): Set default to t.
-
-2001-06-14 OHASHI Akira <bg66@koka-in.org>
-
- * liece-channel.el (liece-channel-add-buttons): Fix regexp.
-
- * liece-handle.el (liece-handle-notice-message): Don't set `temp'
- to nil.
-
- * liece-menu.el (liece-menu-channel-menu): Don't enable
- `liece-command-unread-channel' if `liece-channel-unread-list' is nil.
- (liece-menu-private-menu): Don't bind `liece-command-userhost'.
-
- * liece-window.el (liece-command-set-window-style): Run
- `liece-command-reconfigure-windows'.
-
-2001-06-09 OHASHI Akira <bg66@koka-in.org>
-
- * liece-handle.el (liece-handle-privmsg-message): Don't compare when
- `item' and `liece-current-chat-partner' are nil.
-
-2001-02-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el (liece-read-passwd): Revive.
-
- * liece-clfns.el (liece-clfns-subr-fboundp): Check existence of
- the function `symbol-file'.
-
- * liece-q-ccl.el: Require `poem' for char-int.
- (liece-quote-ccl-256-table): Simplified.
-
-2001-01-02 Daiki Ueno <ueno@unixuser.org>
-
- * liece-modules.el: Simplified.
-
-2000-12-09 Tanaka Akira <akr@m17n.org>
-
- * liece.el (liece-refresh-buffer-window): Simplified.
-
-2000-11-30 Tanaka Akira <akr@m17n.org>
-
- * liece.el (liece-refresh-buffer-window): Force to display a last
- non-empty line in last line in a window on Emacs 21.
-
-2000-10-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-ctcp.el: Remove autoload cookies of
- `liece-command-ctcp-generic',
- `liece-command-ctcp-userinfo-from-minibuffer',
- `liece-command-ctcp-x-face-from-xbm-file' and
- `liece-command-send-file'.
-
- * liece-commands.el: Add autoload setting for
- `liece-command-ctcp-action',
- `liece-command-ctcp-userinfo-from-minibuffer' and
- `liece-command-ctcp-x-face-from-xbm-file'.
-
-2000-10-16 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-quit): Use `liece-close-server'.
-
- * liece.el (liece): Simplify.
- (liece-close-server): Accept optional argument `quit-string'.
-
-2000-10-12 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-menu.el (liece-menu-ctcp-menu): Follow the CTCP command
- changed from `liece-command-client-*' to `liece-command-ctcp-*'.
-
-2000-10-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-qualify-nicks): Refer 1st argument.
-
-2000-10-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el (liece-minibuffer-complete-channel-modes):
- Don't use old style backquotes.
- (liece-minibuffer-completing-read-multiple-1): Remove a partially
- matched word construct if it exists.
-
-2000-10-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-set-operators): Reset `run'.
- (liece-command-set-voices): Ditto.
-
-2000-09-30 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-modeline-glyph): Add 'xpm check.
- (liece-xemacs-create-nick-glyph): Ditto.
- (liece-xemacs-unread-mark): Ditto.
-
-2000-09-23 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-menu.el (liece-command-toggle-freeze): Rename from
- `liece-command-freeze'.
- (liece-command-toggle-own-freeze): Rename from
- `liece-command-own-freeze'.
- (liece-command-toggle-beep): Rename from `liece-dialogue-beep'.
-
-2000-09-22 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-kill-message): Call
- `liece-close-server' instead of `liece-clear-system'.
-
- * liece-commands.el: Don't autoload `liece-window-configuration-pop'.
- (liece-command-quit): Just send quit.
-
- * liece.el (liece-close-server): Run `liece-exit-hook'; abolish
- argument `quit-string'.
-
- * liece-filter.el (liece-sentinel): Call `liece-close-server'.
-
-2000-09-20 Daiki Ueno <ueno@unixuser.org>
-
- * liece-compat.el: Require `wid-edit'.
-
- * liece-inlines.el (liece-locate-icon-file): Don't check existence
- of the file.
-
- * liece-emacs.el: Don't require `static' and `wid-edit'.
- (liece-splash-image): Set default to nil.
- (liece-emacs-splash-function): New variable.
- (liece-emacs-splash-with-image): New function splitted from
- `liece-emacs-splash'; use `image-size'; hide cursor.
- (liece-emacs-splash-with-stipple): New function.
-
-2000-09-20 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-toggle-away): Rename from
- `liece-command-away'.
- (liece-command-toggle-freeze): Rename from `liece-command-freeze'.
- (liece-command-toggle-own-freeze): Rename from
- `liece-command-own-freeze'.
- (liece-command-toggle-beep): Rename from `liece-command-beep'.
- (liece-command-load-vars): Abolish.
-
- * liece.el (liece-dialogue-beep): Abolish.
- (liece-dialogue-freeze): Abolish.
- (liece-dialogue-own-freeze): Abolish.
- (liece-initialize-buffers): Don't parse error message.
- (liece): Assume `liece-away-message' is nil.
- (liece-command-map): Don't bind `liece-command-freeze' and
- `liece-command-own-freeze'.
- (liece-dialogue-mode-map): Don't bind `liece-command-timestamp'
- and `liece-command-find-timestamp'; bind
- `liece-command-toggle-private' to "C-t p"; bind
- `liece-command-toggle-away' to "C-t a"; bind
- `liece-command-toggle-freeze' to "C-t f"; bind
- `liece-command-toggle-own-freeze' to "C-t o".
-
- * liece-minibuf.el (liece-minibuffer-parse-modes): Don't complete
- mode flags when completing an argument.
-
-2000-09-19 Daiki Ueno <ueno@unixuser.org>
-
- * liece-version.el (liece-version): Bump up to 2.0.0.
-
- * liece-menu.el (liece-menu-callback-set-operators): Rename from
- `liece-menu-callback-mode+o'.
- (liece-menu-callback-set-voices): Rename from
- `liece-menu-callback-mode+v'.
- (liece-menu-callback-unset-operators): Rename from
- `liece-menu-callback-mode-o'.
- (liece-menu-callback-unset-voices): Rename from
- `liece-menu-callback-mode-v'.
-
- * liece-nick.el (liece-nick-region-opers): Abolish.
- (liece-nick-region-voices): Abolish.
- (liece-nick-update-region): Don't set them.
-
- * liece.el (liece-dialogue-mode-map): Don't bind `liece-command-exec',
- `liece-command-lusers' and `liece-command-userhost'.
-
- * liece-commands.el (liece-command-exec): Abolish.
- (liece-command-inline): Abolish.
- (liece-command-set-operators): Rename from `liece-command-mode+o'.
- (liece-command-set-voices): Rename from `liece-command-mode+v'.
- (liece-command-qualify-nicks): New function.
- (liece-command-mode-o): Abolish.
- (liece-command-mode-v): Abolish.
- (liece-command-userhost): Abolish.
- (liece-command-lusers): Abolish.
-
-2000-09-18 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-channel-buffer-mode): Set default to t.
- (liece-nick-buffer-mode): Ditto.
- (liece-channel-list-buffer-mode): Ditto.
-
- * liece.el (liece-open-server-internal): Simplify.
- (liece-open-server): Strip bracketed server name here.
- (liece-start-server): Fix last change.
-
-2000-09-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-highlight-mode): Set default to t.
-
- * liece.el (liece-open-server): Simplify.
- (liece-start-server): Canonicalize `liece-server' here.
-
-2000-09-17 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-menu.el (liece-menu-channel-menu): Move `liece-command-freeze'
- from `liece-menu-IRC-menu'.
- (liece-menu-channel-menu): Move `liece-command-own-freeze'
- from 'liece-menu-IRC-menu'.
- (liece-menu-channel-menu): New menu item `liece-dialogue-beep'.
- (liece-menu-channel-menu): New menu item
- `liece-command-unread-channel'.
-
-2000-09-17 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-read-functions): Rename from
- `liece-channel-read-hook'.
-
- * liece-handle.el (liece-channel-unread-functions): Rename from
- `liece-channel-unread-hook'.
-
- * liece-emacs.el (toplevel): Use them.
-
- * liece-xemacs.el (toplevel): Ditto.
-
-2000-09-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-make.el (make-liece-sample-files): Abolish.
- (make-liece-info-files): Abolish.
-
- * liece-url.el (liece-add-url-functions): Rename from `liece-url-add-hook'.
-
- * liece.el (liece-after-insert-functions): Rename from `liece-insert-hook'.
- (liece-before-insert-functions): Rename from `liece-before-insert-hook'.
-
- * liece-handle.el (liece-notice-cleartext-hook): Abolish.
- (liece-privmsg-cleartext-hook): Abolish.
-
- * liece-filter.el (liece-handle-message): Simplify.
-
- * liece-ctcp.el (liece-ctcp-message): Don't ignore errors in hooks.
- (liece-ctcp-notice): Ditto.
- (liece-ctcp-file-notice): Ditto.
-
- * liece-channel.el (liece-channel-add-mode): Don't use pushnew.
- (liece-channel-add-exception): Ditto.
- (liece-channel-add-invite): Ditto.
-
-2000-09-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-vars.el (liece-inhibit-startup-message): New user option.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-splash-at-point): Don't check `console-type'.
- (liece-x-face-insert-with-xemacs): Ditto.
-
-2000-09-11 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-emacs.el (liece-emacs-unread-character): Abolish.
-
- * liece-vars.el (liece-channel-unread-character): New variable.
-
- * liece-xemacs.el (liece-xemacs-unread-mark): Simplify; Don't use
- `featurep' and `console-type'.
- (toplevel): Ditto.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-minibuf.el: Autoload `completing-read-multiple'; declare
- `crm-separator'.
- (liece-minibuffer-completing-read): Rename from
- `liece-minibuffer-completing-default-read'; accept optional arguments
- `history' and `default'.
- (liece-minibuffer-completion-separator): New variable.
- (liece-minibuffer-completion-table): New variable.
- (liece-minibuffer-completing-read-multiple-1): New completion function.
- (liece-minibuffer-completing-read-multiple): Rename from
- `liece-minibuffer-completing-sequential-read'; accept optional
- arguments `history' and `default'; use `completing-read-multiple'
- when optional 8th argument `multiple-candidate' is specified.
-
- * liece-xemacs.el (liece-xemacs-redisplay-unread-mark): Don't bind `chnl'.
-
-2000-09-11 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el (liece-command-quit): Don't send QUIT.
-
- * liece-emacs.el (liece-emacs-splash): Use `generate-new-buffer'
- instead of `liece-get-buffer-create'
-
- * liece-xemacs.el (liece-xemacs-splash): Synch with liece-emacs.el
-
- * liece.el (liece-clear-system): Call
- `liece-buffer-dispose-function' instead of burying buffer.
- (liece-open-server-internal): Simplify; Don't use
- `liece-get-buffer-create' to prepare process-buffer.
- (liece-close-server): Accept optional argument `quit-string'.
-
- * liece-vars.el (liece-buffer-dispose-function): New variable.
-
-2000-09-10 Daiki Ueno <ueno@unixuser.org>
-
- * liece-inlines.el (string-list-remove-ignore-case): Remove car of the element.
- (string-list-delete-ignore-case): Ditto.
- (string-list-remove): Ditto.
- (string-list-delete): Ditto.
-
-2000-09-06 Daiki Ueno <ueno@unixuser.org>
-
- * liece-clfns.el (remq): New compiler macro.
-
-2000-09-05 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-redisplay-buffer): New hook
- `liece-channel-read-hook'.
- (liece-channel-change): Run `liece-redisplay-unread-mark'.
-
- * liece-handle.el (liece-handle-privmsg-message): New hook
- `liece-channel-unread-hook'.
-
- * liece-vars.el (liece-display-unread-mark): New variable.
-
- * liece-xemacs.el (liece-xemacs-unread-icon): Rename from
- `liece-xemacs-channel-balloon-icon'.
- (liece-xemacs-unread-mark): Rename and simplified from
- `liece-xemacs-channel-balloon'.
- (liece-xemacs-read-mark): Rename and simplified from
- `liece-xemacs-channel-balloon-kill'.
- (liece-xemacs-redisplay-unread-mark): New function.
- (toplevel): Add them to hook.
-
- * liece-emacs.el (liece-emacs-unread-character): New variable.
- (liece-emacs-unread-mark): New function.
- (liece-emacs-read-mark): Ditto.
- (liece-emacs-redisplay-unread-mark): Ditto.
- (toplevel): Add them to hook.
-
-2000-09-04 Daiki Ueno <ueno@unixuser.org>
-
- * liece-inlines.el (string-equal-ignore-case): Check return value
- of `compare-strings'.
-
-2000-09-03 Daiki Ueno <ueno@unixuser.org>
-
- * liece-clfns.el: Require `pym'.
- (liece-clfns-subr-fboundp): New macro.
- (last,member-if,member-if-not,delete-if,remove-if,remove-if-not,
- assoc-if,rassoc-if): Use it.
-
- * liece-inlines.el (string-list-member-ignore-case): Use
- `member-ignore-case'.
- (string-list-remove-ignore-case): Use remq.
- (string-list-member): Abolish.
- (string-list-delete-ignore-case): Use delq.
- (string-equal-ignore-case): Use `compare-strings' if available.
-
-2000-09-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-channel.el (liece-channel-change): Handle
- `liece-current-chat-partner'.
-
- * Makefile.am (SOURCES): Remove `liece-crypt'.
-
- * liece-crypt.el: Remove.
-
- * liece-400.el (liece-handle-433-message): Use `liece-beep'
- (liece-handle-432-message): Ditto.
-
- * liece-misc.el (liece-beep): New macro.
- (liece-set-beep): Rename from `liece-beep'.
-
- * liece-xemacs.el (liece-xemacs-channel-balloon): Abolish local
- variable `chnl'.
-
- * liece.el: Don't require `liece-crypt'.
- (liece-crypt-map): Abolish.
- (liece-buffer-mode-alist): Remove `liece-CRYPT-buffer'.
- (liece-command-mode-map): Don't bind
- `liece-command-enter-message-opposite-crypt-mode'.
- (liece): Don't initialize crypt indicator.
- (liece-command-mode): Ditto.
- (liece-dialogue-mode): Ditto.
- (liece-channel-mode): Ditto.
-
- * liece-xemacs.el: Don't require `liece-crypt'.
- (liece-toolbar-crypt-active-icon): Abolish.
- (liece-toolbar-crypt-inactive-icon): Abolish.
- (liece-toolbar-crypt-icon): Abolish.
- (liece-toolbar-crypt-glyph): Abolish.
- (liece-toolbar-crypt-active-glyph): Abolish.
- (liece-toolbar-crypt-inactive-glyph): Abolish.
- (liece-toolbar-spec-list): Don't set `liece-toolbar-crypt-glyph'.
- (liece-xemacs-setup-toolbar-hook): Remove `liece-toolbar-setup-crypt-glyph'.
- (liece-toolbar-setup-crypt-glyph): Abolish.
- (liece-toolbar-toggle-crypt): Abolish.
-
- * liece-vars.el (liece-defected-message-prefix): Abolish.
- (liece-suspicious-message-prefix): Abolish.
- (liece-beep-function): New variable.
-
- * liece-message.el (liece-message-brackets-function): Don't handle
- `liece-message-encrypted-p'.
- (liece-message-encrypted-p): Abolish.
- (liece-message-suspicious-p): Abolish.
- (liece-message-garbled-p): Abolish.
- (liece-message-fingerprint): Abolish.
- (liece-message-timestamp): Abolish.
-
- * liece-menu.el (liece-menu-crypt-menu): Abolish.
- (liece-menu-channel-menu): Remove `liece-menu-crypt-menu'.
- (liece-menu-alist): Ditto.
- (liece-menu-crypt-menu-map): Abolish.
-
- * liece-handle.el (liece-handle-notice-message): Don't use
- `with-liece-decryption'.
- (liece-handle-privmsg-message): Ditto.
- Use `liece-beep' instead of `beep'.
-
- * liece-modules.el (liece-modules-to-compile): Remove `liece-crypt'.
-
- * liece-globals.el (liece-crypt-indicator): Abolish.
- (liece-CRYPT-buffer): Abolish.
- (liece-C-buffer): Abolish.
-
- * liece-commands.el: Don't require `liece-crypt'.
- (liece-command-send-message): Abolish optional argument ARG and KEY.
- (liece-command-enter-message): Ditto.
- (liece-command-message): Ditto.
- (liece-enter-message): Abolish.
- (liece-command-part): Don't set crypt indicator.
- (liece-switch-to-channel): Ditto.
- (liece-switch-to-channel-no): Ditto.
- (liece-command-private-conversation): Ditto.
- (liece-command-toggle-crypt): Abolish.
-
-2000-08-31 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-handle.el (liece-handle-privmsg-message): Fixed.
-
-2000-08-30 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-commands.el (liece-command-unread-channel): New function.
-
- * liece.el (liece-command-map): Bind "\C-u" to it.
- (liece-channel-list-mode-map): Bind "u" to it.
-
-2000-08-29 Daiki Ueno <ueno@unixuser.org>
-
- * liece-channel.el (liece-channel-change): Run
- `liece-redisplay-buffer-functions' only when
- `liece-current-channel' is non-nil.
-
- * liece-commands.el (liece-command-who): Check
- `liece-current-channel'.
- (liece-command-names): Ditto.
- Suggested by: Yoichi NAKAYAMA <yoichi@eken.phys.nagoya-u.ac.jp>.
-
-2000-08-30 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-vars.el (liece-channel-unread-list): New variable.
-
- * liece-channel.el (liece-channel-unread-p): New function.
- (liece-channel-redisplay-buffer): Use it.
-
- * liece-handle.el (liece-handle-privmsg-message): Ditto.
-
-2000-08-29 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-channel.el (liece-channel-change): Run
- `liece-redisplay-buffer-functions'.
-
-2000-08-23 Daiki Ueno <ueno@unixuser.org>
-
- * liece-handle.el (liece-handle-privmsg-message): Use
- `liece-pick-buffer-1' to construct channel buffer name.
-
-2000-08-23 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-xemacs.el (liece-xemacs-channel-balloon): New function.
- Show balloon icon to `liece-cahnnel-list-buffer' as XEmacs glyphs
- when non-current channel message is received.
- (liece-xemacs-channel-balloon-kill): New function.
- Kill the balloon icon.
-
-2000-08-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-server-keyword-map): Bind connection type.
-
-2000-08-16 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-open-server-internal): Use
- `liece-open-network-stream'; bind liece-tcp-connection-type.
-
- * liece-tcp.el (liece-tcp-open-program-stream-as-binary): Abolish.
- (liece-tcp-open-ssl-stream-as-binary): Abolish.
- (liece-tcp-open-rlogin-stream-as-binary): Abolish.
- (liece-tcp-wait-for-string): Abolish.
- (liece-tcp-stream-alist): New variable.
- (liece-open-network-stream): Abolish 5th argument `type'.
-
-2000-08-01 Yoshiki Hayashi <yoshiki@xemacs.org>
-
- * liece-xemacs.el (liece-toolbar-position): Use
- function defaul-toolbar-position instead of variable.
-
-2000-07-17 Daiki Ueno <ueno@unixuser.org>
-
- * liece-emacs.el (create-image): Don't advise.
- (liece-widget-keymap): Remove checking about 'button3.
- (liece-emacs-widget-button-click): Save point in window explicitly.
-
- * liece-ctcp.el (liece-command-ctcp-generic): Fix format string.
-
-2000-07-16 Akira Ohashi <bg66@luck.gr.jp>
-
- * liece-commands.el (liece-command-beep): New function.
- Toggle the automatic beep notice when the channel message is received.
-
- * liece.el (liece-dialogue-mode-map): Bind "B" to liece-dialogue-beep.
-
- * liece-vars.el (liece-default-beep): New variable.
- (liece-beep-when-invited): Ditto.
- (liece-beep-when-privmsg): Ditto.
- (liece-beep-words-list): Ditto.
-
-2000-05-07 Daiki Ueno <ueno@unixuser.org>
-
- * liece-tcp.el
- (liece-tcp-rlogin-parameters): Use `socket' instead of `telnet'.
- (liece-tcp-open-rlogin-stream): Don't wait for a connection.
- (liece-tcp-open-rlogin-stream-as-binary): Simply wrap
- `liece-tcp-open-rlogin-stream'.
-
-2000-04-21 Daiki Ueno <ueno@unixuser.org>
-
- * liece-ctcp.el
- (liece-ctcp-make-menu-command-wrapper): Quote CTCP subcommands.
-
- * liece-mail.el (liece-maintainer-address): New ML address.
-
-2000-04-12 Daiki Ueno <ueno@unixuser.org>
-
- * liece-url.el: Don't require browse-url when compiling.
- (liece-url-browser-name): Abolish.
- (liece-url-prepare-browser-function): Abolish.
- (liece-url-mail-regexp): Abolish.
- (liece-url-browser-function): Abolish.
- (liece-url-link-action): Use browse-url directly.
- (liece-command-browse-url): Ditto.
- (liece-url-add-buttons): Remove local variable `url-start',
- `url-end' and `url'.
- Suggested by: Kenichi OKADA <okada@opaopa.org>
-
- * liece-xemacs.el
- (liece-toolbar-position): Check feature 'toolbar was provided.
-
-2000-04-08 Daiki Ueno <ueno@unixuser.org>
-
- * liece-xemacs.el (liece-xemacs-setup-toolbar): Run
- `liece-xemacs-setup-toolbar-hook' only once.
- (liece-setup-toolbar): Don't check return value
- of `liece-xemacs-setup-toolbar'.
- Reported by: Yosuke MITSUMASU <werdna@ntn.org>
-
-2000-04-05 Daiki Ueno <ueno@unixuser.org>
-
- * liece-commands.el: Add autoload for liece-command-ctcp-version,
- liece-command-ctcp-userinfo,liece-command-ctcp-clientinfo,
- liece-command-ctcp-ping,liece-command-ctcp-time,
- liece-command-ctcp-x-face,liece-command-ctcp-comment,
- liece-command-ctcp-help.
- Suggested by: HARUYAMA Seigo <haruyama@unixuser.org>.
-
- * liece-ctcp.el
- (liece-ctcp-make-menu-command-wrapper): Don't use `#'.
- (liece-ctcp-make-command-wrapper): Ditto.
-
-2000-04-04 Daiki Ueno <ueno@unixuser.org>
-
- * liece.el (liece-client-query-keys): Rename all commands.
-
- * liece-vars.el
- (liece-ctcp-userinfo): Rename from `liece-client-userinfo'.
- (liece-ctcp-x-face): Ditto.
-
- * liece-ctcp.el (liece-ctcp-message): Abolish macro.
- (liece-ctcp-file-message): Ditto.
-
-2000-03-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el: Require `derived'.
-
-2000-03-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-inlines.el (liece-locate-path): Use
- `liece-locate-data-directory' instead of `locate-data-directory'.
-
-2000-03-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-q-ccl.el (ccl-set-register-right): Abolish.
- (liece-quote-ccl-decode): Simplified.
-
- * liece-compat.el (liece-suppress-mode-line-format): Copy original
- `mode-line-format' before modification.
- (locate-data-directory): Abolish.
- (liece-locate-data-directory): New function.
-
- * liece-xemacs.el (liece-xemacs-suppress-modeline-format): Ditto.
- (liece-locate-data-directory): Override with `locate-data-directory'.
-
- * liece.el
- (liece-command-mode): Define `mode-line-format' as buffer local.
- (liece-dialogue-mode): Exchange `mode-line-modified' position.
- (liece-clear-system): Check buffer status.
-
- * liece-ctcp.el (liece-ctcp-xyzzy-message): Abolish.
- (liece-command-send-file): Don't narrowing buffer.
- (liece-ctcp-file-save-directory): Default to `liece-directory'.
- (liece-register-file-handler): New macro.
- (liece-ctcp-notice): Rewrite.
- (liece-ctcp-message): Rewrite.
- (liece-query-client-insert-to-generic): Abolish.
- (liece-query-client-version): Abolish.
- (liece-query-client-userinfo): Abolish.
- (liece-query-client-help): Abolish.
- (liece-query-client-clientinfo): Abolish.
- (liece-query-client-ping): Abolish.
- (liece-query-client-time): Abolish.
- (liece-query-client-x-face): Abolish.
- (liece-query-client-last-command): Rename from
- `liece-query-client-lastcommand'.
- (liece-query-client-alist): Abolish.
- (liece-ctcp-last-nick): Rename from `liece-query-client-nick'.
- (liece-command-ctcp-x-face-from-minibuffer): Abolish.
- (liece-command-ctcp-x-face-from-commandbuffer): Abolish.
- (liece-command-ctcp-userinfo-from-commandbuffer): Abolish.
-
-2000-03-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-xemacs.el (liece-xemacs-icon-path): Abolish.
- (liece-toolbar-position): Default to `default-toolbar-position'.
- (liece-xemacs-setup-toolbar): Remove directory checking.
- (liece-xemacs-modeline-glyph): Suppress glyph specs.
- (liece-xemacs-create-nick-glyph): Ditto.
-
- * liece-emacs.el (liece-emacs-icon-path): Abolish.
-
- * liece-intl.el (liece-intl-load-catalogue): Rewrite with
- `liece-locate-path'; remove local binding.
-
- * liece-window.el (liece-window-load-style-file): Rewrite with
- `liece-locate-path'; remove local binding.
-
- * liece-compat.el (locate-data-directory): New function.
-
- * liece-inlines.el (liece-find-data-directory): Abolish.
- (liece-locate-path): Rename from `liece-find-path'; use
- `locate-data-directory'; reorder arguments.
- (liece-locate-icon-file): New function.
-
-2000-03-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-globals.el
- (liece-command-buffer,liece-dialogue-buffer,liece-private-buffer,
- liece-others-buffer,liece-channel-buffer,
- liece-channel-buffer-format,liece-channel-list-buffer,
- liece-nick-buffer,liece-nick-buffer-format,
- liece-KILLS-buffer,liece-IGNORED-buffer,liece-WALLOPS-buffer,
- liece-CRYPT-buffer,liece-server-buffer): Remove preceding `*IRC*'.
-
- * liece-xemacs.el
- (liece-xemacs-splash-at-point): Bind
- `liece-insert-environment-version' to nil.
- (liece-xemacs-splash): Ditto.
- (liece-xemacs-suppress-modeline-format): New function.
- (liece-suppress-mode-line-format): Override with
- `liece-xemacs-suppress-modeline-format'.
- (liece-xemacs-mode-line-buffer-identification): Decorate 1st
- element and modify whole identification by side effect.
-
- * liece-compat.el (current-language-environment): Abolish.
- (frame-title-format): Abolish.
- (enable-multibyte-characters): Abolish.
- (liece-suppress-mode-line-format): New function.
-
- * liece-version.el: Use product.el.
- (liece-version): New function.
- (liece-user-interface-product): Abolish.
- (liece-product-name): Abolish.
- (liece-product-version): Abolish.
- (liece-product-code-name): Abolish.
- (liece-user-agent-value): Abolish.
- (liece-command-version): Abolish.
- (liece-environment-version): Rename from
- `liece-emacs-user-agent-value'.
-
- * bitmap-stipple.el
- (bitmap-stipple-insert-pixmap): Don't set point to `point-min'.
-
- * liece-xbm.el: Update.
-
- * liece-emacs.el (liece-emacs-splash): Display version number;
- bind `liece-insert-environment-version' to nil.
- (liece-emacs-mode-line-buffer-identification): Decorate 1st
- element and modify whole identification by side effect.
-
- * liece-vars.el (liece-nick-max-length): New variable.
- (liece-insert-environment-version): New variable.
-
- * liece.el (liece-truncate-nickname): Abolish.
- (liece-client-query-keys,liece-dialogue-keys,
- liece-select-keys,liece-crypt-keys): Define as a plist.
- (liece-local-set-keys): New function borrowed from gnus-util.el.
- (liece-define-keys): Ditto.
- (liece-define-keys-safe): Ditto.
- (liece-define-keys-1): Ditto.
- (liece-command-map): Bind "\C-m" to liece-command-modec.
- (liece-command-mode): Don't set `mode-line-format' directly;
- exchange `mode-line-modified' position;
- (liece-dialogue-mode): Ditto.
- (liece-others-mode): Ditto.
- (liece-channel-mode): Ditto.
- (liece-nick-mode): Ditto.
- (liece-channel-list-mode): Ditto.
-
-2000-03-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (bind-text-domain): Don't refer "PATHNAME/DOMAIN.mo"
- directly.
-
- * bitmap-stipple.el,gettext.el,liece-000.el,liece-200.el,
- liece-300.el,liece-400.el,liece-500.el,liece-commands.el,
- liece-config.el,liece-crypt.el,liece-ctcp.el,liece-dcc.el,
- liece-filter.el,liece-globals.el,liece-handle.el,liece-hilit.el,
- liece-inlines.el,liece-intl.el,liece-mail.el,liece-make.el,
- liece-menu.el,liece-message.el,liece-minibuf.el,liece-misc.el,
- liece-nick.el,liece-q-ccl.el,liece-q-el.el,liece-tcp.el,
- liece-version.el,liece-window.el,liece-x-face.el: Checkdoc.
-
- * liece-menu.el (liece-nick-popup-menu): Use copy-sequence instead
- of copy-tree.
-
- * liece-modules.el (liece-modules-to-compile): Modify for
- `liece-clfns' and `liece-handler'.
-
- * liece-handler.el: Rename from llunf.el.
-
- * liece-clfns.el: New file.
-
- * liece-channel.el (liece-channel-add-buttons): Fix regexp.
- (liece-channel-add-ban): Use add-to-list instead of pushnew.
-
- * liece-coding.el
- (liece-default-coding-system): Abolish.
- (liece-mime-charset-for-write): Rename from
- `liece-default-mime-charset'.
- (liece-mime-charset-for-read): Rename from
- `liece-default-mime-charset-for-read'.
-
- * liece.el (liece-client-query-map,liece-dcc-map,
- liece-crypt-map,liece-friends-map,liece-channel-list-mode-map,
- liece-nick-mode-map,): Use make-sparse-keymap when initialising.
- (liece-command-mode): Don't set liece-display-frame-title to nil.
- (liece-dialogue-mode-map): Bind `L' to liece-command-load-vars
- instead of `C-l'; bind `S' to liece-command-save-vars instead of
- `s'; bind `M' to liece-command-modec instead of `C-m'; bind `O' to
- liece-dialogue-own-freeze instead of `M'.
- (liece-buffer-last-check-time): Rename from
- `liece-last-checkbuffer-time'.
- (liece-check-buffers): Define as function.
- (liece-check-buffers-if-interval-expired): Simplified.
-
- * liece-vars.el
- (liece-buffer-max-size): Rename from `liece-buffer-maxsize'.
- (liece-buffer-default-size): Rename from `liece-buffer-defsize'.
- (liece-buffer-check-interval): Rename from
- `liece-checkbuffer-interval'.
-
- * liece-emacs.el (liece-emacs-widget-button-click): Don't use
- `event-buffer'.
-
- * liece-xemacs.el
- (liece-xemacs-get-buffer-window-list): Abolish.
- (liece-xemacs-run-at-time): Abolish.
- (liece-xemacs-put-text-property): Abolish.
- (liece-xemacs-add-text-property): Abolish.
-
- * liece-minibuf.el (liece-minibuffer-map): Use `set-keymap-parent'
- instead of `liece-set-keymap-parents'.
-
- * liece-compat.el: Don't require emu, broken, alist.
- (remassoc): Abolish.
- (remassq): Abolish.
- (liece-run-at-time): Abolish.
- (liece-cancel-timer): Abolish.
- (with-timeout): Abolish.
- (with-timeout-handler): Abolish.
- (liece-get-buffer-window-list): Abolish.
- (liece-set-keymap-parents): Abolish.
- (event-buffer): Abolish.
- (event-point): Abolish.
- (truncate-string-to-width): Abolish.
- (plist-get): Abolish.
- (read-passwd): Abolish.
- (colon-keyword-usable): Abolish.
- (turn-on-font-lock): Abolish.
- (liece-make-overlay): Abolish.
- (liece-delete-overlay): Abolish.
- (liece-overlay-put): Abolish.
- (liece-move-overlay): Abolish.
- (liece-overlay-end): Abolish.
- (liece-overlay-get): Abolish.
- (liece-overlays-at): Abolish.
- (liece-put-text-property): Abolish.
- (liece-add-text-property): Abolish.
- (buffer-disable-undo): Abolish.
- (valid-plist-p): Abolish.
-
- * liece-url.el (liece-url-browser-netscape): Abolish.
-
-2000-03-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-compat.el (liece-get-buffer-window): Search all frames.
-
-2000-02-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-command-mode): Set frame-title-format when
- running on window-system environment.
-
-2000-02-18 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Use `frame-char-width' and
- `frame-char-height' when calculating logo centering.
-
-2000-02-17 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-400.el (liece-handle-443-message): Check channel name.
-
-2000-02-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-coding.el
- (liece-coding-encode-charset-region): Define as function.
- (liece-coding-encode-charset-string): Define as function.
-
- * liece-dcc.el
- (liece-dcc-chat-send): Switch to liece-command-buffer.
- (liece-dcc-enqueue-request): Rename.
- (liece-dcc-dequeue-request): Ditto.
-
- * liece-misc.el (liece-send-as-binary): Abolish.
- (liece-repair-crlf): Abolish.
- (liece-send): Switch to liece-command-buffer.
-
- * liece-emacs.el (liece-emacs-splash): Use `font-info' if 'font
- parameter of the selected frame is not a fontset name.
-
- * liece.el (liece-open-server-internal): Set process-buffer of
- open-network-stream as unibyte.
-
-2000-02-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-xemacs.el (liece-toolbar-icon-convert-1): New function.
- (liece-toolbar-icon-states): New variable.
-
- * liece-emacs.el (liece-emacs-widget-button-click): Don't preserve
- previously selected window.
-
-2000-01-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el: Require `image' when compiling.
- (create-image): Add optional argument `data-p'.
-
-2000-01-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-message.el (liece-message-empty-predicate): New variable.
-
- * liece-commands.el
- (liece-command-message): Use `liece-message-empty-predicate'.
-
-2000-01-16 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-modules.el (liece-modules): Don't install `queue-m'.
-
- * liece-dcc.el: Don't require `queue-m' at runtime.
-
- * liece-hilit.el:
- Add autoload setting for `liece-channel-add-buttons' and
- `liece-nick-add-buttons'.
- (liece-highlight-maybe-turn-on-font-lock): Activate
- `liece-channel-add-buttons' and `liece-nick-add-buttons' when
- inserting every line.
-
- * liece-compat.el (liece-map-overlays): New function.
- (liece-kill-all-overlays): Use it.
-
- * liece-xemacs.el (liece-xemacs-map-extents): New function.
- (liece-xemacs-kill-all-overlays): Use it.
- (liece-map-overlays): New alias to `liece-xemacs-map-extents'.
-
- * liece-nick.el (liece-nick-redisplay-buffer): New function.
- (liece-nick-add-buttons): New function.
-
- * liece-channel.el
- (liece-channel-redisplay-buffer): New function.
- (liece-channel-list-redisplay-buffer): New function.
- (liece-channel-buffer-invisible-p): Remove redundant cond.
- (liece-channel-part-internal): Remove redundant `function'.
- (liece-channel-list-add-button): Rename from
- `liece-channel-add-button'.
- (liece-channel-push-button-action): Use `liece-command-join'
- instead of `liece-switch-to-channel'.
-
- * liece-commands.el (liece-switch-to-channel-1): Abolish.
- (liece-redisplay-buffer-functions): New variable.
-
-2000-01-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el
- (liece-command-next-channel): Traverse channel list circularly.
- (liece-command-previous-channel): Likewise.
-
-1999-12-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el
- (liece-command-previous-channel): Remove nil from channel list.
- (liece-command-next-channel): Ditto.
-
-1999-12-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Check whether logo height
- is larger than frame height.
-
- * liece-crypt.el (liece-crypt-maybe-encrypt-message): Simplified.
-
- * liece-commands.el
- (liece-command-enter-message-encrypted): Abolish.
- (liece-command-enter-message-cleartext): Abolish.
- (liece-command-enter-message-opposite-crypt-mode): Abolish.
- (liece-command-enter-message-with-key): Abolish.
-
-1999-12-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-user-agent-value): Add APEL version.
-
- * liece-inlines.el (liece-next-line): New macro.
-
- * liece-ctcp.el
- (liece-command-client-action): Use `liece-next-line'.
- (liece-command-client-userinfo-from-commandbuffer): Ditto.
-
- * liece-channel.el (liece-channel-member): Use `member-if' instead
- of `find-if'.
-
- * liece.el (liece): Don't use `liece-command-describe-briefly'.
- (liece-command-mode): Don't bind `next-line-add-newlines'.
- (liece-dialogue-keys): Don't bind `C-u'.
-
- * liece-commands.el (liece-command-topic): If called with prefix
- argument insert the current topic as default.
- (liece-command-finger): Add documentation about optional 2nd
- argument.
- (liece-command-describe-briefly): Abolish.
- (liece-enter-message): Abolish local variable `message'.
- (liece-command-join-channel): Fix paren style.
- (liece-command-join-partner): Ditto.
- (liece-command-join): Ditto.
- (liece-command-part): Ditto.
- (liece-switch-to-channel-no): Ditto.
- (liece-command-complete): Ditto.
- (liece-command-next-channel): Rewrite with using
- `liece-channel-member'.
- (liece-command-previous-channel):
- (liece-command-push): Abolish local variable `rest-sym' and
- `item'; don't use `liece-channel-remove'.
- (liece-command-pop): Abolish local variable `rest-sym'.
- (liece-command-tag-region): Don't create temp buffer.
-
-1999-12-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-set-channel-indicator): Switch to
- `liece-command-buffer' when updating modeline.
-
-1999-12-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-minibuf.el (liece-minibuffer-map): Don't use
- `set-keymap-parents'.
-
- * liece-compat.el (liece-set-keymap-parents): Rename from
- `set-keymap-parents'.
- (turn-on-font-lock,event-buffer,event-point,region-active-p,
- remassoc,remassq,valid-plist-p,plist-get): Add document.
-
-1999-12-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-insert-internal): Don't bind `tab-stop-list'.
- (liece-dialogue-mode): Declare `tab-stop-list' as buffer local.
-
-1999-12-01 Daiki Ueno <ueno@unixuser.org>
-
- * liece-message.el (liece-message-parent-buffer): Add condtion.
-
-1999-11-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-read-variables-files): Make the `~/.liece/'
- directory if there is no initialization file.
-
-1999-11-10 Kenichi OKADA <okada@opaopa.org>
-
- * liece-xemacs.el (liece-xemacs-splash-at-point): Calculate
- horizontal position of the splash logo.
-
-1999-11-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-emacs.el (liece-emacs-splash): Check the number of
- the arguments of `insert-image'.
-
-1999-11-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-coding.el (detect-coding-string): Remove.
- (liece-detect-coding-string): Don't define if
- `detect-coding-string' does not exist.
-
-1999-11-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-url.el (liece-url-add-buttons): Accept optional arguments
- `start' and `end'.
-
- * liece.el (liece-save-point): New macro; borrowed from SKK.
- (liece-before-insert-hook): New variable.
- (liece-insert-internal): Refine.
-
-1999-11-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-get-buffer-create): Use memq instead of
- member to search over buffers list.
-
-1999-10-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-handle.el (liece-handle-ping-message): Return the
- argument correctly.
-
- * liece.el (liece-insert-internal): Remove `inline'.
-
-1999-10-27 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-nick-scroll-down): Fix
- argument list.
- (liece-command-nick-scroll-up): Ditto.
-
- * liece-hilit.el (liece-highlight-turn-on-font-lock): Set
- `liece-highlight-maybe-play-jingle' as local hook.
- (liece-highlight-font-lock-keywords): Undo last change.
-
-1999-10-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-refresh-windows): Remove.
- (liece-refresh-buffer-window): New function `liece-refresh-windows'.
- (liece-insert-internal): Preserve old point unconditionally when
- the buffer is frozen.
-
-1999-10-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-freeze): Rename from `liece-freeze-toggle'.
- (liece-own-freeze): Rename from `liece-own-freeze-toggle'.
-
- * liece.el: Add autoload for `liece-command-submit-bug-report'.
- (liece-overriding-command-keys): Rename.
- (liece-dialogue-keys): Bind `liece-command-submit-bug-report'.
-
- * liece-commands.el (liece-command-scroll-down): Use
- `scroll-other-window'; accept prefix value.
- (liece-command-scroll-up): Ditto.
- (liece-command-nick-scroll-down): Ditto.
- (liece-command-nick-scroll-up): Ditto.
- (liece-command-freeze): Accept prefix argument.
- (liece-command-own-freeze): Ditto.
- (liece-command-quit): Refine.
-
-1999-10-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-display-friends): Remove
- `save-excursion'.
-
- * liece.el (liece-read-variables-files): Prepare startup
- directory if it does not exist.
-
- * liece-vars.el (liece-directory): New variable.
- (liece-variables-file): Relocate under `liece-directory'.
-
- * liece-ctcp.el (liece-ctcp-version-message): Refer
- `liece-user-agent-value'.
-
- * liece-menu.el: Check features about menubars.
-
- * liece-xemacs.el (liece-xemacs-hide-scrollbars): Set
- `scrollbar-height' to 0 if `horizontal-scrollbar-visible-p' is not
- available.
-
- * liece-mail.el (liece-command-submit-bug-report): New function.
- (liece-maintainer-address): New variable.
-
- * gettext.el (gettext-load-message-catalogue): Enclose with
- `as-binary-input-file' instead of using `set-buffer-multibyte' twice.
- (gettext-load-portable-message-catalogue): Likewise.
- (dgettext): Check the cdr of catalogue entry.
- (gettext-gmo-read-32bit-word): Mask each byte with 255.
-
- * liece-compat.el (truncate-string-to-width): New alias.
-
- * liece.el (liece-server-keyword-bind): Quote colon keywords.
-
- * liece-make.el (make-liece-info-files): Check if
- `set-language-environment' exists.
-
- * liece-misc.el (liece-server-host): Quote colon keyword.
-
-1999-10-19 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-hilit.el (liece-highlight-font-lock-keywords): Undo last
- change; accept partial matcher as the value of
- `liece-highlight-pattern'.
- (liece-highlight-maybe-play-jingle): New function.
- (liece-highlight-maybe-turn-on-font-lock): Add
- `liece-highlight-maybe-play-jingle' to `after-change-functions'.
-
-1999-10-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (gettext-load-message-catalogue): Use hashtable.
- (gettext-load-portable-message-catalogue): Likewise.
-
-1999-10-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (next-visible-point): Don't advise.
- (liece-remove-properties-region): Enclose by `save-restriction'.
-
-1999-10-12 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-commands.el (liece-command-send-action): Remove.
-
- * liece-ctcp.el (liece-command-client-action): Move from
- `liece-commands.el'; mark `liece-command-send-action' as obsolete.
- (liece-client-x-face-notice): Remove whitespaces.
-
- * liece-handle.el (liece-handle-kick-message): Fix message.
-
-1999-10-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * gettext.el (gettext-default-mime-charset): New variable.
- (gettext-parse-Content-Type): Use it.
-
-1999-10-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-misc.el (liece-message): Fix message prefix.
-
- * liece-compat.el (liece-find-data-directory): Move to
- `liece-inlines'.
-
- * liece-xemacs.el (liece-xemacs-icon-path): Use `liece-find-path'.
-
- * liece-emacs.el (liece-emacs-icon-path): Use `liece-find-path'.
-
- * liece-inlines.el (liece-find-path): New function.
-
-1999-10-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-user-interface-product): Renamed from
- `liece-client-product'.
- (liece-client-version-major): Abolish.
- (liece-client-version-minor): Abolish.
- (liece-client-version-beta): Abolish.
- (liece-client-version-alpha): Abolish.
- (liece-client-version-codename): Abolish.
- (liece-product-name): New macro.
- (liece-product-version): New macro.
- (liece-product-code-name): New macro.
-
-1999-10-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-hilit.el (liece-highlight-jingle-function): New variable.
- (liece-highlight-font-lock-keywords): If liece-highlight-pattern
- matches, play jingle.
-
-1999-10-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-message.el (liece-message-parent-buffer): Check the
- message direction in private conversation.
-
-1999-09-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-version.el (liece-emacs-user-agent-value): Include
- `emacs-patch-level'. It exists in XEmacs 21.1.1 or later.
-
-1999-09-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-channel-mode): Make `truncate-lines' local.
- (liece-others-mode): Ditto.
- (liece-channel-list-mode): Ditto.
- (liece-nick-mode): Ditto.
-
-1999-09-18 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-open-server): Set `liece-status-message-string'
- when timeout is expired.
-
-1999-09-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-menu.el (liece-use-localized-menu): New variable.
- (liece-command-define-menus): Use it.
- (liece-command-define-menus-1): New function; to raverse menu
- items recursively.
-
- * liece.el (liece): Call `liece-intl-load-catalogue' before switch
- to the command buffer.
-
- * liece-dcc.el: Refine.
-
- * liece-ctcp.el (liece-client-x-face-notice): Do not decode empty
- `X-Face'.
-
-1999-09-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-vars.el (liece-dcc-program): Rename to `ldcc'.
-
- * liece-tcp.el (liece-tcp-program): Rename to `ltcp'.
-
- * gettext.el (gettext-parse-Content-Type): Require `path-util'.
-
- * liece-x-face.el: Require `path-util'.
-
-1999-09-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Makefile.am (SOURCES): Add `gettext.el'.
-
- * liece-modules.el (liece-modules-to-compile): Add `gettext.el'.
-
- * liece-intl.el: Use `gettext.el'.
- (liece-intl-domains-alist): Abolish.
- (liece-intl-domain-to-mime-charset-alist): Abolish.
- (liece-intl-prepare-prefix): Abolish.
- (liece-intl-parse-Content-Type): Abolish.
- (liece-intl-convert-string): Abolish.
- (liece-intl-catalogue-path): Abolish.
-
- * gettext.el: New file.
-
- * liece-ctcp.el: Add autoload setting for `liece-ctcp-dcc-message'.
-
- * liece.el (liece): Save window splitting only when called
- interactively.
- (liece-clear-system): Do not restore window splitting.
- (liece-command-mode): Set syntax table explicitly; make
- `frame-title-format' buffer local.
-
- * liece-window.el (liece-window-configuration-push): Do not save
- `frame-title-format'.
- (liece-window-configuration-pop): Likewise.
-
- * liece-commands.el (liece-command-quit): Restore window splitting
- only when called interactively.
-
-1999-09-09 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.el (liece-server-keyword-map): New variable.
- (liece-server-keyword-bind): New macro modified version of
- `mail-source-bind' from `mail-source.el'.
- (liece-server-parse-string): New function.
- (liece-open-server): Use them.
-
-1999-09-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece-300.el (liece-handle-353-message): Reverse reply list.
-
- * All files are renamed from `irchat-*' to `liece-*'.
- All symbols are renamed too.
-
- * irchat-vars.el (irchat-connection-timeout): Default to 60.
-
- * irchat-nick.el (irchat-nick-insert): Handle reverse order
- sorting.
-
-1999-09-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat): Call `irchat-command-mode' just once.
- (irchat-initialize-buffers): Likewise.
-
- * irchat-channel.el (irchat-channel-buffer-create): Call
- `irchat-channel-mode' just once.
-
- * irchat-nick.el (irchat-nick-buffer-create): Call
- `irchat-nick-mode' just once.
-
- * irchat-message.el (irchat-message-parent-buffer): Fix condition.
-
-1999-09-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-sort-nicks): New variable.
-
- * irchat-intl.el (irchat-intl-load-catalogue): Ignore all errors
- when reading catalogue file.
-
- * irchat-menu.el: Do not require `irchat-ctcp'; add autoload
- settings for `irchat-menu-callback-ctcp-version',
- `irchat-menu-callback-ctcp-userinfo',
- `irchat-menu-callback-ctcp-help',
- `irchat-menu-callback-ctcp-clientinfo' and
- `irchat-menu-callback-ctcp-ping'; add `irchat-menu-add-url' to
- `irchat-url-add-hook'.
-
- * irchat-url.el (irchat-url-add-buttons): Enclose with
- `save-excursion'; run `irchat-url-add-hook'.
-
-1999-09-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.7.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Abolish.
-
- * irchat-intl.el (irchat-intl-get-msgstr-if): Abolish.
-
- * irchat-vars.el: Remove defconst for colon keyword.
-
-1999-09-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-menu.el: All the menu specs are expanded immediately.
- (irchat-menu-prepare-menus): Abolish.
- (irchat-menu-define): New function.
- (irchat-menu-alist): New variable.
-
- * irchat-handle.el (irchat-handle-topic-message): Check empty
- topic line.
-
- * irchat.el (irchat): When `irchat-startup-channel-list' contains
- list element send cadr as a channel key.
-
- * irchat-emacs.el (irchat-emacs-widget-convert-button): Make the
- keymap `irchat-widget-keymap' parented from current local map.
-
- * irchat-nick.el (irchat-nick-sort-predicate): New variable.
- (irchat-nick-update): Sort nicknames with
- `irchat-nick-sort-predicate'.
- (irchat-nick-insert): Search sorted position before insertion.
- (irchat-nick-replace): Call `irchat-nick-insert' when
- `irchat-nick-sort-predicate' is valid.
-
- * irchat-message.el (irchat-message-parent-buffer): Add condition
- for private conversation.
-
- * irchat-make.el (make-irchat-info-files): Set language
- environment to `Japanese'.
-
- * irchat-dcc.el (irchat-dcc-channel-representation-format):
- Remove.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Use `string-list-member-ignore-case' instead of
- `string-list-ci-member'.
-
- * irchat-url.el: Remove `irchat-insert-hook'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-font-lock):
- Add `irchat-url-add-buttons' to `irchat-insert-hook'.
-
- * irchat.el (irchat-initialize-buffers): Fix last change.
-
- * irchat-300.el: Enclose autoloads by `eval-and-compile'.
-
- * irchat-channel.el: Declare variable
- `irchat-dcc-channel-representation-format'.
-
-1999-09-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.6.
-
- * irchat.el: Add autoload for `irchat-command-browse-url'; do not
- require `irchat-url' and `irchat-dcc'; add autoload for
- `irchat-command-mail-compose'.
- (irchat-initialize-timers): Rewrite with `dolist'; do
- not check `irchat-timers-list-initialized-p'.
- (irchat-truncate-nickname): Use `truncate-string-to-width' instead
- of `truncate-string'.
- (irchat-buffer-mode-alist): New variable.
- (irchat-dialogue-setup-buffer): Abolish.
- (irchat-others-setup-buffer): Abolish.
- (irchat-channel-list-setup-buffer): Abolish.
- (irchat-private-setup-buffer): Abolish.
- (irchat-KILLS-setup-buffer): Abolish.
- (irchat-IGNORED-setup-buffer): Abolish.
- (irchat-WALLOPS-setup-buffer): Abolish.
- (irchat-CRYPT-setup-buffer): Abolish.
- (irchat-initialize-buffers): Rewrite.
-
- * irchat-ctcp.el (irchat-client-version-insert): Do not indent
- explicitly.
- (irchat-client-message-no-lf): Abolish.
-
- * irchat-300.el, irchat-xemacs.el, irchat-commands.el: Do not
- require `irchat-dcc' and `irchat-mail'.
-
- * irchat-dcc.el (irchat-command-dcc-send): Remove autoload cookie.
-
-1999-09-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-inlines.el (forward-line): Do not advise.
-
- * irchat-intl.el: Do not require `alist'; require `mcharset',
- `static' and `cl' during compilation.
- (irchat-intl-msgid-regexp): Fix regexp.
- (irchat-intl-msgstr-regexp): Ditto.
- (irchat-intl-set-msgstr): Abolish.
- (irchat-intl-load-catalogue): Optimize with side-effects.
-
- * irchat.el (irchat): Load message catalogue only once.
-
-1999-08-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-close-server-internal): Use
- `irchat-server-opened'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-widget):
- Abolish.
-
- * irchat-channel.el (irchat-channel-add-button): Use
- `irchat-widget-convert-button'.
-
- * irchat-nick.el (irchat-nick-insert): Use
- `irchat-widget-convert-button'.
- (irchat-nick-replace): Ditto.
-
- * irchat-compat.el (irchat-widget-convert-button): New alias.
- (irchat-widget-button-click): Alias to `widget-button-click'.
-
- * irchat-emacs.el (irchat-widget-keymap): New variable.
- (irchat-emacs-widget-convert-button): New function.
- (irchat-emacs-widget-button-click): New function.
- (irchat-widget-convert-button): Redefine here.
- (irchat-widget-button-click): Redefine here.
-
- * irchat-url.el (irchat-url-add-buttons): Use
- `irchat-widget-convert-button'.
-
-1999-08-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-emacs.el (irchat-emacs-splash): Use `fontset-pixel-size'.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el: Do not require `wid-browse' during
- compilation.
- (irchat-widget-button-click): New function.
-
- * irchat-emacs.el: Enclose autoloads with `eval-and-compile'.
- (irchat-emacs-create-mode-line-image): Specify
- `:ascent' property when creating the image.
- (irchat-emacs-create-nick-image): Ditto.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Makefile.am (EXTRA_DIST): Add `irchat-emacs.el'.
-
- * irchat-xemacs.el (irchat-xemacs-glyph-nick-buffer): Abolish.
- (irchat-xemacs-glyph-nick-region): Remove interactive spec.
-
- * irchat-intl.el: Do not require `mime-parse'.
-
- * irchat-tcp.el: Bind `ssl-program-arguments'.
-
-1999-08-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-modules.el (irchat-modules-to-compile): Add
- `irchat-emacs'.
-
- * irchat-xemacs.el (irchat-xemacs-glyph-nick-buffer): Refine.
-
- * irchat-vars.el (irchat-icon-directory): Move from
- `irchat-xemacs.el'.; To be used under FSF Emacs 20.4.91.
- (irchat-nick-image-alist): Move from `irchat-xemacs.el'.
-
- * irchat-emacs.el: New file.; Most of FSF Emacs specific routines
- are stored here.
- (irchat-emacs-icon-path): New macro.
- (irchat-emacs-mode-line-buffer-identification): New function.
- (irchat-emacs-mode-line-buffer-identification): New variable.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.xpm: Reduce colors.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-x-face.el (irchat-x-face-insert-function): Don't use
- `eval-when-compile' while checking bitmap-mule.
-
-1999-08-20 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-splash-pixmap): Renamed from
- `irchat-stipple-pixmap'; use the XPM data under FSF Emacs 20.4.91.
- (irchat-x-splash): Likewise.
-
- * irchat-channel.el (irchat-channel-virtual): Undo last change.
-
-1999-08-15 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-400.el (irchat-handle-400-messages): Do not pass empty
- channel names to `irchat-channel-virtual'.
-
- * irchat-channel.el (irchat-channel-virtual): Make channel ID for
- `!' channels invisible from user.
-
- * irchat-vars.el (irchat-channel-id-length): Default to 5.
-
-1999-08-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-353-channel): Abolish.
- (irchat-handle-366-message): Do not use `irchat-353-channel'.
-
-1999-08-13 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-200.el (irchat-handle-218-message): Do not indent
- explicitly.
-
-1999-08-08 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (with-timeout): New macro for compatibility.
-
- * irchat-xemacs.el: Check `horizontal-scrollbar-visible-p' for
- XEmacs 20.4.
-
- * irchat.el (irchat-open-server): Do not truncate trailing `_'.
-
- * Liece 1.3.5.
-
- * irchat-handle.el (irchat-handle-mode-message): Handle channel
- invite list.
- (irchat-handle-join-message): Pass optional argument to
- `match-string'.
-
- * irchat-channel.el (irchat-channel-get-invites): New macro.
- (irchat-channel-add-invite): New macro.
- (irchat-channel-remove-invite): New macro.
- (irchat-channel-set-invite): New macro.
-
- * irchat-300.el: Handle channel invite list.
- (irchat-handle-346-message) <RPL_INVITELIST>: New handler.
- (irchat-handle-347-message) <RPL_ENDOFINVITE>: New handler
-
-1999-08-07 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-200.el: Register 200 handler again.
- (irchat-handle-200-message): Do not indent explicitly.
- (irchat-handle-201-message): Likewise.
- (irchat-handle-213-message): Likewise.
- (irchat-handle-214-message): Likewise.
- (irchat-handle-262-message) <RPL_ENDOFTRACE>: New handler.
-
- * irchat-300.el (irchat-handle-365-message): Turn hops count into
- string.
-
- * irchat-xemacs.el (irchat-toolbar-map-button-list): Fix typo.
-
-1999-08-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-load-catalogue): Add nil check.
- (irchat-intl-catalogue-path): Fix last change.
-
-1999-08-06 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-window.el (irchat-window-load-style-file): Cache
- `irchat-window-style-directory'.
-
- * irchat-xemacs.el (irchat-xemacs-icon-path): Cache
- `irchat-icon-directory'.
-
- * irchat-intl.el (irchat-intl-catalogue-path): New macro.
- (irchat-intl-load-catalogue): Use it.
-
- * irchat-make.el (install-update-manifest-file): Fix for data
- directories.
- (config-irchat-package-directory): Splitt into
- `config-irchat-package'.
-
- * irchat-xemacs.el: Do not require `smiley'.
- (irchat-xemacs-icon-path): New macro.
- (irchat-toolbar-icon-plist-get): Use it.
- (irchat-xemacs-setup-toolbar): Use it.
- (irchat-xemacs-create-nick-glyph): Use it.
- (irchat-xemacs-modeline-glyph): Use it.
-
- * irchat-vars.el (irchat-use-smiley): Abolish.
-
- * irchat-hilit.el (irchat-maybe-smiley-region): Abolish. If you
- want to use this functionality, please setup `irchat-insert-hook'.
-
-1999-08-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * liece.xpm: New splash logo.
-
- * irchat-xemacs.el (irchat-xemacs-splash-at-point): Use
- `glyph-width', `glyph-height' and `window-pixel-height' to
- calculate position of the splash logo.
-
-1999-08-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (irchat-find-data-directory): Move from
- `irchat-misc'.
-
- * irchat-intl.el: Use new style macros.
- (irchat-intl-parse-Content-Type): Check statically if
- `mime-content-type-parameter' is available.
- (irchat-intl-load-catalogue): Use `irchat-find-data-directory'.
-
- * irchat.el (irchat-open-server): Add server parameter `relay'.
-
- * irchat-window.el (irchat-window-set-default-style): Use
- `irchat-find-data-directory'.
-
- * irchat-tcp.el: Fix comment string.
- (irchat-tcp-open-rlogin-stream): New function.
- (irchat-tcp-open-rlogin-stream-as-binary): New function.
- (irchat-tcp-default-connection-type): Add rlogin to custom spec.
- (irchat-tcp-rlogin-program): New variable.
- (irchat-tcp-relay-host): New variable.
- (irchat-tcp-rlogin-parameters): New variable.
- (irchat-tcp-rlogin-user-name): New variable.
-
-1999-08-03 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-config.el (irchat-config-info-file-regexp): New variable.
-
- * irhcat-hilit.el: Require font-lock during compilation.
-
- * irchat-vars.el (irchat-tab-stop-list): New variable.
-
- * irhcat-000.el, irchat-200.el, irchat-300.el, irchat-400.el,
- irchat-ctcp.el: Do not use `mapcar' when registering handlers.
-
- * irchat-misc.el (irchat-find-etc-directory): New function.
-
- * irchat.el: Add autoloads for
- `bitmap-stipple-xbm-file-to-stipple' and
- `bitmap-stipple-insert-pixmap'.
-
- * irchat-xemacs.el (irchat-x-face-insert-with-xemacs): Use xface
- glyph if this feature has been provided and `console-type' returns
- 'tty or 'pc, or otherwise make string glyph.
- [Rename from overriding function `irchat-x-face-insert']
- (irchat-xemacs-create-nick-glyph): Call `console-type' instead of
- referring `window-system'.
- (irchat-xemacs-modeline-glyph): Check current console type.
- (irchat-xemacs-splash-at-point): Ditto.
- (irchat-find-etc-directory): Advise it.
-
- * irchat-compat.el (irchat-static-autoload): New macro.
- (colon-keyword-usable): New facility checking.
-
- * irchat-x-face.el: Add autoloads for `x-face-encode',
- `x-face-read-existing-file-name', `bitmap-insert-xbm-buffer',
- `bitmap-decode-xbm', `bitmap-read-xbm-buffer' and `bitmap-compose'.
- (irchat-x-face-insert-function): New variable.
- (irchat-x-face-insert-with-bitmap): Rename from overriding
- function `irchat-x-face-insert'.
-
- * irchat-url.el: Do not check with requiring browse-url. Assume
- that function `browse-url' have already been autoloaded.
-
-1999-08-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-command-mode): Set local value of
- `next-line-add-newlines' 't.
- (irchat-wait-for-response): Use `with-timeout'.
- (irchat): Do not use `make-variable-buffer-local' when
- `irchat-freeze' and `irchat-own-freeze' are initialized.
- (irchat-dialogue-mode): Define `irchat-freeze' and
- `irchat-own-freeze' here.
-
- * irchat-misc.el (next-line): Abolish.
-
- * irchat-handle.el (irchat-handle-nick-message): Fix typo.
-
-1999-07-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-inlines.el (string-list-modify-ignore-case): Fix typo.
-
-1999-07-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-make.el: Generate file `MANIFEST.liece'.
- (install-update-manifest-file): New function.
-
-1999-07-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-end-of-buffer): Do not use
- `set-window-point'.
-
- * irchat-300.el (irchat-handle-367-message): Use
- `irchat-channel-add-ban' instead of temp variable.
- (irchat-367-channel): Abolish.
- (irchat-367-regexps): Abolish.
- (irchat-handle-348-message): New handler for handling channel
- exception list.
- (irchat-handle-349-message): New handler for handling channel
- exception list.
-
-1999-07-27 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-mode-message): Handle channel
- exception list.
-
- * irchat-channel.el: (irchat-channel-get-exceptions): New macro.
- (irchat-channel-add-exception): New macro.
- (irchat-channel-remove-exception): New macro.
- (irchat-channel-set-exception): New macro.
-
-1999-07-25 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-end-of-buffer): Do not use
- `pop-to-buffer'.
- (irchat-command-describe-briefly): Do not use backquote.
-
-1999-07-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el: Do not refer `widget-minor-mode-map'.
-
- * irchat-hilit.el (irchat-highlight-maybe-turn-on-widget): Use
- `current-local-map' instead of `widget-minor-mode-map'.
-
- * Liece 1.3.4.
-
- * irchat-q-ccl.el (irchat-quote-ccl-encode-region): Fix typo.
-
- * irchat-crypt.el: Add autoload for `crc32-string'.
- (irchat-crypt-hash-crc32-string): New function.
- (irchat-crypt-default-hash-function): New variable.
- (irchat-crypt-key-fingerprint): Rewrite with above functions.
-
- * irchat-handle.el (irchat-handle-topic-message): Fix argument
- order of `irchat-channel-set-topic'.
-
- * irchat-misc.el (irchat-maybe-update-channel-indicator): Abolish.
- Call `irchat-set-channel-indicator' directly.
-
- * irchat-nick.el (irchat-nick-replace): Remove widgets.
-
- * irchat-menu.el (irchat-nick-popup-menu): Move "Kick" menu to the
- bottom of menu entries.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Ditto.
-
-1999-07-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-frame-title-format-last): Abolish.
-
- * irchat.el (irchat-accept-response): Call `irchat' with no
- arguments. Here's the point that take care of growing tail.
- (irchat): Call `irchat-window-configuration-pop' and
- `irchat-window-configuration-push' consequently.
-
- * irchat-commands.el (irchat-command-keepalive): Call `irchat'
- with no arguments.
-
- * irchat-filter.el (irchat-sentinel): Call `irchat' with no
- arguments.
-
- * irchat-window.el: Add window configuration stack utility.
- (irchat-window-configuration-push): New function.
- (irchat-window-configuration-pop): New function.
- (irchat-window-configuration-stack): New variable.
-
- * irchat-compat.el: Require wid-edit and wid-browse during
- compilation.
- (widget-minor-mode-map): Bind `mouse-button-3'.
- (irchat-dont-set-event-point): New advice against
- `widget-button-click' for FSF Emacs.
- (irchat-save-current-buffer): New advice against
- `widget-button-click' for FSF Emacs.
- (remassq): New function.
-
- * irchat-channel.el (irchat-channel-push-button): Abolish.
- (irchat-channel-list-insert): Abolish.
- (irchat-channel-button): New widget.
- (irchat-channel-add-button): New function.
- (irchat-channel-button-action): New function.
-
- * irchat-url.el: Use widget.
- (irchat-url-link): New widget.
- (irchat-url-add-button): New function.
- (irchat-url-iterate-buffer): Abolish.
- (irchat-url-search-forward): Abolish.
- (irchat-url-add-to-completion): Abolish
- (irchat-url-link-action): Renamed from irchat-url-push-button.
-
- * irchat-hilit.el: Renamed from irchat-hilight.el.
- (irchat-highlight-overlay-put-mouse-face): Abolish.
- (irchat-highlight-insert-with-mouse-face): Abolish.
- (irchat-highlight-insert-line-with-mouse-face): Abolish.
- (irchat-highlight-with-widget): Abolish.
- (irchat-url-face): Abolish.
- (irchat-mouse-face): Abolish.
- (irchat-highlight-maybe-turn-on-widget): New function.
- This function turns on `widget-minor-mode' in
- `irchat-nick-mode', `irchat-channel-list-mode' or
- `irchat-dialogue-mode'.
-
-1999-07-21 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.3.
-
- * irchat.el (irchat-override-command-keys): Bind "\C-c\C-a" to
- `irchat-command-previous-channel'.
-
- * irchat-crypt.el: Add routines for encapsulate cipher algorithms.
- (irchat-crypt-import-cipher-algorithm): New function.
- (irchat-crypt-key-fingerprint): New function.
- (irchat-crypt-build-decryption-key): New function.
- (irchat-crypt-build-encryption-key): New function.
- (irchat-crypt-encrypt-string): New function.
- (irchat-crypt-decrypt-string): New function.
- (irchat-crypt-algorithm-major-version): New function.
- (irchat-crypt-algorithm-minor-version): New function.
- (irchat-crypt-secure-passphrase-read): Abolish.
- (irchat-crypt-ignore-suspicious): Abolish.
- (irchat-crypt-ignore-defected): Abolish.
- (irchat-get-idea-decryption-key): Abolish.
- (irchat-command-set-default-key): Check if this function was
- called interactively.
- (irchat-command-add-decryption-key): Renamed from
- `irchat-command-add-new-key'.
- (irchat-command-delete-decryption-key): Renamed from
- `irchat-command-delete-key'.
- (irchat-crypt-decryption-keys): Renamed from
- `irchat-crypt-known-keys'.
- (irchat-crypt-encryption-keys): Renamed from
- `irchat-crypt-default-keys'.
-
- * irchat-coding.el (irchat-default-mime-charset-for-read): New
- variable. Default to 'x-ctext.
-
- * irchat-compat.el: Do not require 'defface.
- (irchat-compat-enable-to-read-multibyte): Abolish.
-
- * irchat-modules.el (irchat-modules-to-compile): Remove
- `irchat-ck-*' and `defface'. Use `japanese-zenkaku-*' with hook.
-
- * irchat-vars.el (irchat-convert-hankaku-katakana): Abolished.
-
- * irchat-inlines.el: All string functions are rewritten.
-
-1999-07-05 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Register ACTION handler.
-
-1999-07-04 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-version.el (irchat-emacs-user-agent-value): Modify for
- XEmacs UTF-2000-MULE.
-
- * irchat-crypt.el: Do not use IDEA as the default cipher algorithm.
- (irchat-crypt-cipher-algorithm): New variable.
- (irchat-crypt-encrypt-message-format): Add version field of
- the cipher algorithm.
- (irchat-crypt-current-keys): Always restore the computed keys into
- this variable. [Renamed from irchat-default-idea-key-list]
-
-1999-06-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-use-toolbar): Add custom spec.
- (irchat-toolbar-toggle-crypt): Check irchat-use-toolbar.
- (irchat-setup-toolbar): Ditto.
-
-1999-06-14 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.3.2.
-
- * irchat.el (irchat-define-keys): Rewrite.
- (irchat-truncate-nickname): Rewrite; rename from irchat-read-nickname.
-
- * irchat-handle.el, irchat-400.el, irchat-300.el, irchat-200.el,
- irchat-000.el:
- Declarations of hook variables are splitted into each file.
-
- * irchat-300.el: Register 322 reply handler.
-
-1999-06-11 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-dialogue-mode-map): Bind mouse-button-2 to
- irchat-url-push-button.
-
- * irchat-url.el (irchat-url-push-button): Check all overlays
- around event point.
-
- * irchat-filter.el (irchat-handle-message): Ignore errors which
- occurs during hook evaluation.
-
- * irchat-ctcp.el (irchat-ctcp-message): Ignore errors which
- occurrs during hook evaluation.
- (irchat-ctcp-notice): Likewise.
- (irchat-ctcp-file-notice): Likewise.
-
- * irchat-channel.el (irchat-channel-push-button): Use
- irchat-overlays-at instead of overlays-at.
-
-1999-06-10 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-hilight.el (irchat-quoted-colors-mirc):
- Rename from irchat-quoted-colors.
- (irchat-quoted-colors-ircle): New color table.
- (irchat-highlight-maybe-hide-prefix): Fix regexp.
- (irchat-highlight-colorize-quote): Check vender specific extension.
-
- * irchat-channel.el (irchat-channel-push-button):
- Check all overlays under the point.
-
- * irchat-filter.el: Rename default backend name to "generic".
-
- * irchat-handle.el: Use multiple values bindings.
- (irchat-handle-notice-message): Fix argument against
- irchat-ctcp-notice.
-
- *irchat-misc.el (irchat-compose-time-string): Use
- format-time-string. Now only accepts encoded time.
-
- * irchat-misc.el (irchat-pick-buffer): Check if chnl is string and
- apropriate buffer does not exist.
- (irchat-pick-buffer-1): Do not return buffer list.
-
-1999-06-10 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-debug-mode-map): Abolish.
- (irchat-debug-keys): Abolish.
- (irchat-command-keys): Fix return key code.
-
- * irchat-window.el (irchat-window-to-buffer):
- Remove irchat-debug-buffer.
-
- * irchat-vars.el (irchat-debug-mode-hook): Abolish.
- (irchat-debug-prefix): Abolish.
-
- * irchat-nick.el (irchat-nick-equal): New alias to string-ci-equal.
- (irchat-nick-member): New function.
- (irchat-command-toggle-nick-buffer-mode): Do not toggle when
- irchat-nick-buffer has not been created.
-
- * llhandler.el, irchat-modules.el (irchat-modules-to-compile):
- Remove llhandler.
-
- * irchat-misc.el (irchat-split-line): New function.
- (irchat-split-rest): Abolish.
- (irchat-with-split-rest): Abolish.
- (irchat-maybe-update-channel-indicator): Do not use backquote.
- (irchat-freeze-toggle): Use irchat-nick-equal.
- (irchat-message-from-ignored): Rename from irchat-msg-from-ignored.
-
- * irchat-message.el (irchat-message-parent-buffer):
- Use irchat-nick-equal.
-
- * irchat-make.el (compile-irchat): Add comments.
-
- * irchat-intl.el (irchat-intl-prepare-prefix):
- Do not treat irchat-debug-prefix.
-
- * irchat-inlines.el (filter-elements): Move from irchat-compat.
-
- * irchat-globals.el (irchat-debug-buffer): Remove.
-
- * irchat-crypt.el (irchat-idea-encrypt-message-format): Rename from
- irchat-idea-encrypt-msg-format.
- (irchat-crypt-maybe-decrypt-message): Use irchat-nick-equal.
-
- * irchat-compat.el: Require cl at load time.
- (buffer-or-string-p): Remove.
- (irchat-get-buffer-window): Enclose with eval-and-compile.
- (irchat-get-buffer-window-list): Ditto.
- (irchat-mode-line-buffer-identification): New alias to 'identity.
- (mapvector): Remove.
-
- * irchat-commands.el (irchat-command-debug): Abolished.
- (irchat-command-join-channel): Use irchat-channel-equal.
- (irchat-command-join): Use force-mode-line-update.
- (irchat-command-private-conversation): Ditto.
- (irchat-command-list): Check if 1st argument is empty string.
- (irchat-command-who): Ditto.
- (irchat-command-names): Ditto.
- (irchat-command-mode+o): Use irchat-nick-member.
-
- * irchat-channel.el (irchat-command-toggle-channel-buffer-mode):
- Do not toggle when
- irchat-channel-buffer has not been created.
-
- * irchat-handle.el, irchat-filter.el, irchat-dcc.el,
- irchat-ctcp.el, irchat-500.el, irchat-400.el, irchat-300.el,
- irchat-200.el, irchat-000.el: Use llunf instead of llhandler.
-
- * llunf.el: New file.
-
- * idea.el, b64.el (>>): Move from irchat-compat.
- (<<): Ditto.
-
-1999-06-06 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-misc.el (irchat-freeze-toggle): Use force-mode-line-update.
- (irchat-own-freeze-toggle): Ditto.
-
- * irchat-dcc.el: Require irchat-minibuf.el.
- (irchat-command-dcc-send): Use
- irchat-minibuffer-completing-default-read.
- (irchat-command-dcc-chat-listen): Ditto.
-
-1999-06-04 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-override-command-keys): Add "\C-v" and "l".
- (irchat-dialogue-keys): Remove "\C-v" and "\C-f".
-
- * irchat.el (irchat-override-command-keys):
- Add "\C-n", "\C-p" and "\C-a".
- (irchat-dialogue-keys): Remove "\C-n" and "\C-p".
-
- * irchat-nick.el (irchat-nick-set-user-at-host): New macro.
- (irchat-nick-mark-as-apart): New macro.
- (irchat-nick-unmark-as-apart): New macro.
-
- * irchat-version.el (irchat-emacs-user-agent-value):
- Ignore parenthesis in
- `emacs-version' for XEmacs 21.2.15.
-
-1999-06-03 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-handle.el, irchat-dcc.el, irchat-500.el, irchat-300.el,
- irchat-200.el: Do not check "strange" reply.
-
- * irchat-message.el (irchat-message-parent-buffer):
- Check if irchat-current-channel exists.
-
- * irchat-coding.el: Do not require irchat-vars.
-
- * irchat-menu.el (irchat-nick-popup-menu):
- Enclose save-selected-window.
-
- * irchat-misc.el (irchat-get-buffer-create): Do not use unless.
-
- * irchat-nick.el (irchat-nick-change): Set chnl property internally.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen):
- Use irchat-get-buffer-create instead
- of get-buffer-create.
- (irchat-command-dcc-chat-connect): Ditto.
- (irchat-dcc-compare-hostnames): Ditto.
-
- * irchat-ctcp.el (irchat-file-start):
- Use irchat-get-buffer-create instead of
- get-buffer-create.
- (irchat-file-cont): Ditto.
- (irchat-file-end): Ditto.
- (irchat-ctcp-client-notice): Ditto.
-
- * irchat.el (irchat-open-server-internal):
- Use irchat-get-buffer-create instead of
- get-buffer-create.
- (irchat-dialogue-setup-buffer): Ditto.
- (irchat-others-setup-buffer): Ditto.
- (irchat-channel-list-setup-buffer): Ditto.
- (irchat-private-setup-buffer): Ditto.
- (irchat-KILLS-setup-buffer): Ditto.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-xemacs.el (irchat-xemacs-nick-popup-menu):
- Remove save-excursion.
-
- * irchat-channel.el (irchat-channel-push-button):
- Remove save-excursion, just use save-selected-window instead.
- (irchat-channel-real): Remove save-match-data.
-
- * irchat.el (irchat-clear-system):
- Check irchat-obarray has been initialized.
-
- * Makefile.am (SOURCES): Add irchat-message.el and irchat-coding.el.
- (EXTRA_DIST): Add liece.xbm.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * Liece 1.3.1.
-
- * irchat-url.el (url-irc-liece): New function.
- [should be called from url-irc.el]
-
- * Makefile.am (EXTRA_DIST): Add bitmap-stipple.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-coding.el (irchat-detect-coding-region): New function.
- (irchat-detect-coding-region-function): Use above.
-
- * irchat-coding.el (irchat-detect-coding-string): New function.
- (irchat-detect-coding-string-function): Use above.
-
- * irchat-channel.el (irchat-channel-push-button):
- Switch to channel list buffer.
-
-1999-06-02 Daiki Ueno <ueno@unixuser.org>
-
- * irchat-nick.el (irchat-nick-update-region): Undo last change.
-
- * irchat-menu.el (irchat-nick-popup-menu): Switch to nick buffer.
-
- * irchat-filter.el: fix comments.
- (irchat-filter): Split multiple lines without string matching.
- (irchat-handle-message): Renamed from irchat-handle-message-2.
- (irchat-parse-user-at-host): New function.
-
- * irchat-coding.el (irchat-detect-coding-region-function): Renamed from
- irchat-custom-detect-coding-region-function.
- (irchat-detect-coding-string-function): Renamed from
- irchat-custom-detect-coding-string-function.
-
-1999-06-01 Daiki Ueno <ueno@unixuser.org>
-
- * irchat.el (irchat-command-mode): Do not use mapvector.
-
- * irchat-handle.el (irchat-handle-notice-msg): Fix arguments against
- with-irchat-decryption.
- (irchat-handle-privmsg-msg): Likewise.
-
- * irchat-commands.el (irchat-command-send-message): Fix arguments of
- with-irchat-encryption.
- (irchat-command-message): Likewise.
-
- * irchat-crypt.el (irchat-crypt-maybe-decrypt-message):
- Exchange car with cdr in arglist.
- (with-irchat-encryption): Accept flat arglist.
- (with-irchat-decryption): Likewise.
-
- * irchat.el (irchat-nick-mode-map): Define as prefix commands.
-
- * irchat.el (irchat-channel-mode): Eliminate channel indicator.
- (irchat-others-mode): Likewise.
- (irchat-dialogue-mode): Likewise.
-
- * irchat-misc.el (irchat-set-channel-indicator):
- Eliminate channel indicator.
-
- * irchat-ctcp.el (irchat-ctcp-action-msg):
- Use irchat-display-message.
-
-1999-06-01 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-400.el: Remove redundancies on regexps.
- (irchat-handle-432-msg) <ERR_ERRONEUSNICKNAME>: Rewrite.
- (irchat-handle-433-msg) <ERR_NICKNAMEINUSE>: Resend NICK command only
- if irchat-auto-iterate-nick is non-nil.
-
- * irchat.el (irchat-command-keys): Add irchat-command-mode+o,
- irchat-command-mode-o, irchat-command-mode+v, irchat-command-mode-v.
- XXX: Should be prefixed commands?
-
-1999-05-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-message.el (irchat-message-predicate):
- Normalize irchat-message-blackets-predicate.
-
- * irchat-inlines.el (irchat-eval-form): New function.
-
- * irchat-message.el (irchat-message-predicate):
- Rename specifier typep to type.
-
- * irchat-misc.el (irchat-own-channel-message):
- Bind irchat-message-direction 'outgoing.
- (irchat-own-private-message): Ditto.
-
- * irchat-message.el (irchat-message-tags): New variable.
- (irchat-message-tags-function): New function.
- (irchat-message-private-buffer): Abolished.
- Use irchat-message-buffer-function.
-
-1999-05-31 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-update-region):
- Move opening save-excursion.
-
- * irchat-channel.el (irchat-channel-push-button):
- Move point to event ocurred position before calling
- irchat-nick-update-region.
-
- * irchat-nick.el (irchat-nick-update-region):
- Remove argument event from arglist.
-
- * irchat-menu.el (irchat-nick-popup-menu):
- Move point to event ocurred position before calling
- irchat-nick-update-region.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu):
- Remove argument event from arglist.
- (irchat-xemacs-nick-popup-menu): Move point to event ocurred
- position before calling irchat-nick-update-region.
-
- * irchat.el: Use modern key sequence expression.
- (irchat-command-map): New keymap which override
- irchat-dialogue-keys with prefix command ("\C-c").
- (irchat-friends-map): New keymap. [prefix command for friends]
- (irchat-dialogue-keys): Import some useful command keys.
-
- * irchat-channel.el (irchat-channel-parse-representation):
- To remove let, construct representation object directly.
-
- * irchat-channel.el (irchat-channel-list-insert): Remove format.
-
- * irchat-vars.el: Do not require mcharset.
-
- * irchat.el (irchat-nick-mode-map): Do not check xemacs.
-
- * irchat-xemacs.el (irchat-nick-popup-menu): New alias to
- irchat-xemacs-nick-popup-menu which override original one.
-
- * irchat-compat.el: Use emu's mouse-button emulation.
- (irchat-button2): Abolished.
- (irchat-button3): Abolished.
-
- * irchat-vars.el (irchat-variables-files): Do not load
- `~/.irchat3_vars.el' at startup time.
-
- * irchat-vars.el (irchat-debug-prefix): Clear.
-
- * irchat.el: Do not check `set-face-stipple' is bound.
- (irchat-x-splash): Add interactive spec.
-
-1999-05-30 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-x-splash): Do centering.
-
- * bitmap-stipple.el (bitmap-stipple-insert-pixmap):
- Add optional argument center.
-
- * liece.xbm: New file.
-
- * irchat.el: Check if liece.xbm exists.
-
- * irchat.el (irchat-stipple-pixmap): New variable.
- (irchat-x-splash): New function.
-
- * bitmap-stipple.el: New file.
-
- * irchat-modules.el (irchat-modules-to-compile): Add bitmap-stipple.
-
- * irchat-commands.el (irchat-command-send-action): Fix typo.
-
- * irchat-hilight.el (irchat-highlight-font-lock-keywords):
- Fix regexp.
-
- * irchat-inlines.el (irchat-or): New function.
- (irchat-and): New function.
-
- * irchat-filter.el (irchat-handle-msg-msg): Abolished.
-
- * irchat-crypt.el (irchat-message-encrypted-p): Move into
- irchat-message.
- (irchat-message-suspicious-p): Ditto.
- (irchat-message-garbled-p): Ditto.
- (irchat-message-fingerprint): Ditto.
- (irchat-message-timestamp): Ditto.
-
- * irchat-vars.el: All format strings are removed.
- (irchat-format-string): Abolished.
-
- * irchat-modules.el (irchat-modules-to-compile): Add
- irchat-message.
-
- * irchat-dcc.el (irchat-dcc-chat-filter): Use
- irchat-display-message.
-
- * irchat-commands.el (irchat-command-send-action):
- Bind irchat-message-type.
-
- * irchat-handle.el (irchat-handle-privmsg-msg):
- Use irchat-display-message.
- (irchat-handle-privmsglike-msg): Abolished.
-
- * irchat-misc.el (irchat-own-channel-message):
- Use irchat-display-message.
- (irchat-own-private-message): Likewise.
-
- * irchat-message.el: New file.
-
-1999-05-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el, irchat-vars.el (irchat-before-kill-emacs-hook): New hook.
-
-1999-05-29 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-signoff-message):
- Renamed from irchat-signoff-msg.
-
- * irchat.el (irchat-obarray-size): Moved from irchat-globals.el.
-
- * irchat-globals.el: Remove obsolete variables.
-
- * irchat-ctcp.el (irchat-client-error-message):
- Moved from irchat-globals.el.
-
- * irchat-commands.el (irchat-save-variables-are-dirty): Renamed
- from irchat-save-vars-is-dirty.
- (irchat-command-send-action): Add prefix.
-
- * irchat-400.el (irchat-nickname-last): Renamed from
- irchat-old-nickname.
-
- * irchat-000.el (irchat-servername): Abolished.
-
-1999-05-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-crypt.el: Do not require 'idea.
-
- * irchat-commands.el (irchat-command-message): Treat channel target.
-
- * irchat-300.el (irchat-handle-317-msg) <RPL_WHOISIDLE>:
- Add argument rest to match-string.
-
-1999-05-28 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.2.8.25.
-
- * irchat.el (irchat-command-keys): Do not bind lisp-complete-symbol.
-
- * irchat-commands.el (irchat-command-load-vars): Enclose body with
- unwind-protect.
- (irchat-command-complete): Use irchat-minibuffer-finalize-completion.
- (get-word-left): Abolished.
- (irchat-switch-to-channel-1): New function.
- (irchat-switch-to-channel): Use irchat-switch-to-channel-1.
- (irchat-switch-to-channel-no): Likewise.
- (irchat-command-message): Check crypt-type.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Complete ban patterns.
- (irchat-minibuffer-parse-modes): Rename property 'uah to 'ban.
-
- * irchat-handle.el (irchat-handle-mode-msg):
- Use irchat-channel-set-ban.
-
- * irchat-channel.el (irchat-channel-add-ban): New macro.
- (irchat-channel-remove-ban): New macro.
- (irchat-channel-set-ban): New macro.
- (irchat-channel-get-bans): New function.
-
- * irchat-300.el:
- (irchat-handle-317-msg) <RPL_WHOISIDLE>: Remove condtionals for
- obsolete servers. [2.5 or 2.6].
- (irchat-handle-367-msg) <RPL_BANLIST>: Treat it as generic long
- reply handler.
- (irchat-367-channel): New variable.
- (irchat-367-regexps): New variable.
- (irchat-handle-368-msg) <RPL_ENDOF_BANLIST>: Save ban patterns as
- 'ban property.
-
-1999-05-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system):
- Use dotimes when initializing irchat-obarray.
-
-1999-05-26 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-command-keys):
- Bind irchat-command-display-friends.
-
- * irchat-commands.el (irchat-command-display-friends): New command.
-
- * irchat-vars.el (irchat-display-friends-function): New variable.
-
- * irchat-300.el (irchat-303-display-friends): New function.
- (irchat-303-display-all-friends): New function.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Complete nickname using operators and voices.
- (irchat-minibuffer-parse-modes): Likewise.
- (irchat-minibuffer-finalize-completion): Notice no match found.
-
- * Makefile.am: New file.
-
-1999-05-25 UENO Daiki <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-others-mode): Set parent mode explicitly.
- (irchat-channel-mode): Ditto.
-
-1999-05-24 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-minibuf.el (irchat-minibuffer-parse-modes): Parse ban
- pattern.
-
- * irchat-200.el (irchat-handle-206-msg) <RPL_TRACESERVER>:
- Use multiline display format.
- (irchat-handle-214-msg) <RPL_STATSNLINE>: Likewise.
- (irchat-handle-213-msg) <RPL_STATSCLINE>: Likewise.
-
- * irchat-ctcp.el (irchat-client-insert): Quote format string.
-
-1999-05-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * Liece 1.2.8.24.
-
- * irchat-ctcp.el (irchat-minibuffer-complete-client-query): Use
- `irchat-minibuffer-finalize-completion'.
-
- * irchat-minibuf.el (irchat-minibuffer-finalize-completion): New
- function.
- (irchat-minibuffer-complete-channel-modes): Use above.
-
- * irchat.el (irchat-check-buffers): Fix loop condition.
-
-1999-05-23 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-dcc-message): New function.
-
- * irchat-nick.el (irchat-nick-join-1): Check dups.
-
- * irchat-ctcp.el (irchat-client-insert): New function.
-
- * irchat-commands.el (irchat-command-prepare-message-prefix):
- Abolished.
- (irchat-command-prepare-own-message-prefix): Ditto.
-
- * irchat-misc.el (irchat-own-private-message): Generate prefix
- string automatically.
- (irchat-own-channel-message): Likewise.
-
-1999-05-22 Daiki Ueno <ueno@ueda.info.waseda.ac.jp>
-
- * irchat-compat.el (run-hook-with-args-until-success): Abolished.
-
- * irchat.el (irchat-command-mode): Change mode-line-format.
- (irchat-open-server): Save password.
- (irchat-insert-internal): Rewrite.
-
- * irchat-200.el (irchat-handle-215-msg) <RPL_STATSILINE>:
- Fix regexp.
- (irchat-handle-242-msg) <RPL_STATSUPTIME>: Cut off preceding `:'.
- (irchat-handle-205-msg) <RPL_TRACEUSER>: Fix typo.
- (irchat-handle-218-msg) <RPL_STATSYLINE>: Fix display format.
-
-1999-05-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-inlines.el (format-quote): Abolished.
-
- * irchat-ctcp.el (irchat-ctcp-action-msg): Pass arguments to
- PRIVMSG handler.
-
- * irchat-hilight.el (irchat-highlight-turn-on-font-lock): Make
- `after-change-hook' local.
-
-1999-05-12 sphere <sphere@pop12.odn.ne.jp>
-
- * irchat-url.el (irchat-command-browse-url): Fix typo.
-
-1999-05-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-crypt.el (irchat-command-set-default-key): Fix typo.
-
- * irchat-window.el (irchat-command-set-window-style): Fix typo.
-
- * irchat-url.el (irchat-command-browse-url): Fix typo.
-
- * irchat-channel.el (irchat-channel-set-voice): Quote regexp.
-
-1999-05-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (irchat-command-client-time): Fix typo.
-
- * irchat.el (irchat-channel-mode): Explicitly define as
- it derives from `irchat-dialogue-mode'.
- (irchat-others-mode): Ditto.
-
- * irchat-compat.el (irchat-kill-all-overlays): New function.
-
- * irchat-nick.el (irchat-nick-update): Do not switch to buffer.
- (irchat-nick-join): Do not check whether nickname has been inserted.
- (irchat-nick-update): Kill all overlays.
-
- * irchat-mail.el: Follow the value of `mail-user-agent'.
- (irchat-mail-pop-to-buffer): Abolished.
- (irchat-mail-compose-with-mail): Abolished.
- (irchat-mail-compose-with-gnus): Abolished.
-
- * irchat-inlines.el (nth1, nth1cdr):Abolished.
- (matching-substring): Abolished.
- (irchat-greater-flags): Abolished.
-
-1999-05-08 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-353-scan-channels): New macro.
-
- * irchat-minibuf.el (irchat-minibuffer-completing-default-read):
- Renamed from `irchat-completing-default-read'.
- (irchat-minibuffer-completing-sequential-read): Renamed from
- `irchat-completing-sequential-read'.
-
- * irchat-channel.el (irchat-channel-set-operator-1): Renamed from
- `irchat-set-channel-operator' within irchat-misc.el.
- Restrict its use to internal only.
- (irchat-channel-set-voice-1): Likewise.
-
- * irchat-commands.el (irchat-command-wait): Abolished.
-
- * irchat-nick.el (irchat-nick-update): Assume that the 2nd
- argument CHNL is one of channels we've already joined.
-
- * irchat-misc.el (irchat-change-nick-of): Change nicks, opers and
- voices properties properly.
- (irchat-change-nick-of-1): New function. Modify nick alist by
- side effect.
- (irchat-change-nick-of-2): New function which resembles above,
- but it acts on singular list.
- (irchat-greet-user): Abolished.
- (irchat-user-on-my-channel): Abolished.
- (irchat-user-on-this-channel): Abolished.
-
- * irchat-handle.el (irchat-handle-channel-msg): Do not use
- `irchat-change-nick-of' directly.
- (irchat-handle-nick-msg): Likewise.
- (irchat-handle-quit-msg): Likewise.
-
-1999-05-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-nickname): Do not set
- `irchat-real-nickname'.
-
-1999-05-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.23.
-
- * irchat-hilight.el (irchat-quoted-colors): New variable.
- (irchat-highlight-colorize-quote): New function.
- (irchat-highlight-turn-on-font-lock): Add buffer locality to
- some members of `after-change-hook'.
-
- * Makefile (install): Do not depend on `dcc'.
-
-1999-05-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Call
- `irchat-channel-part' and `irchat-nick-part' exclusively.
- (irchat-handle-kick-msg): Likewise.
-
- * irchat-channel.el (irchat-channel-equal): New alias.
- (irchat-channel-member): Renamed from `irchat-channel-memberp'.
- (irchat-channel-join-internal): New function.
- (irchat-channel-part-internal): New function.
-
- * irchat-ctcp.el (irchat-ctcp-client-msg): Fix reply string.
-
- * irchat-minibuf.el (irchat-minibuffer-parse-modes): Completion
- fixed for ban pattern.
-
- * irchat-nick.el (irchat-nick-normalize): New macro.
- (irchat-nick-strip): New macro.
- (irchat-nick-parse-nick-after): New function.
-
- * irchat-handle.el (irchat-handle-silence-msg): New handler.
-
-1999-05-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Fix quotation of part
- message.
-
- * irchat-400.el: Fix unconsistent user data returned from pirc.
- (irchat-handle-442-msg): `ERR_NOTONCHANNEL'.
- (irchat-handle-443-msg): `ERR_USERONCHANNEL'.
-
- * irchat-misc.el (irchat-update-thischannel): Abolished.
-
- * irchat-commands.el (irchat-channel-virtual): Save matched data.
- (irchat-channel-real): Likewise.
-
- * irchat-300.el (irchat-handle-364-msg): `RPL_LINKS'. Fix regexp.
- (irchat-handle-333-msg): New hander for `RPL_TOPICWHOTIME'.
- (irchat-handle-namereply-msg): Abolished.
- (irchat-handle-whoreply-msg): Abolished.
-
- * irchat-000.el (irchat-handle-005-msg): `RPL_MAP'.
- Support for ircu server mapping facility.
- (irchat-handle-006-msg): New handler for `RPL_MAPMORE'.
- (irchat-handle-007-msg): New handler for `RPL_MAPEND'.
-
-1999-05-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-part-msg): Handle left message.
-
- * irchat-custom.el (irchat-connection-timeout): New variable.
-
- * irchat.el (irchat-accept-response): Add optional arg timeout.
- (irchat-accept-process-output): New function.
- (irchat-clear-system): Reset `irchat-timers-list-initialized-p'.
- (irchat-initialize-timers): Fix secs parameter.
-
- * irchat-xemacs.el (irchat-xemacs-run-at-time): New function.
-
- * irchat-compat.el (irchat-run-at-time): New alias.
- (irchat-cancel-timer): New alias.
-
- * irchat-commands.el (irchat-command-start-ison-timer): Abolished.
- (irchat-command-cancel-ison-timer): Abolished.
-
- * irchat-timer.el: Removed.
-\f
-1999-04-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-initialize-timers): New function.
-
- * irchat-q-ccl.el (irchat-quote-ccl-decode-region): New function.
- (irchat-quote-ccl-encode-region): New function.
-
- * irchat-q-el.el (irchat-quote-el-decode-region): New function.
- (irchat-quote-el-encode-region): New function.
-
- * irchat-ctcp.el (irchat-complete-client): New macro.
- (irchat-complete-query): New macro.
- (irchat-command-client-time): New command.
- (irchat-ctcp-client-msg): Rename each *-msg-hook to *-hook.
- (irchat-minibuffer-complete-client-query): New function.
-
- * irchat-commands.el (irchat-command-activate-friends): Fix
- completion.
-
- * irchat-compat.el (filter-elements): Add `lisp-indent-function'
- property with value 2.
-
-1999-04-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-dcc-object): Implement as cl-struct.
-
- * irchat-compat.el (irchat-static-require): New macro.
- (irchat-static-require-if): New macro.
- (irchat-static-defun-if): New macro.
-
- * Liece 1.2.8.22.
-
-1999-04-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * README-styles.ja, TODO.ja, sample.dot.liece.ja: Removed.
-
-1999-04-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-inlines.el: Require irchat-setup.
-
- * irchat-x-face.el: Use `static.el'.
-
- * irchat-handle.el (irchat-handle-join-msg): Set user-at-host
- information after calling `irchat-nick-join'.
-
- * irchat-globals.el (irchat-default-channel-candidate): New
- variable.
-
-1999-04-22 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-324-msg): Fix regexp.
-
-1999-04-16 Daiki Ueno <ueno@bleu.ueda.info.waseda.ac.jp>
-
- * irchat-xemacs.el: Add hooks to hide modelines.
-
-1999-04-12 Daiki Ueno <ueno@bleu.ueda.info.waseda.ac.jp>
-
- * irchat.el (irchat-refresh-windows): New function.
-
- * irchat-300.el: Remove all occurrences of `matching-substring'.
- (irchat-handle-352-msg): Do not pick-up channel buffer.
-
- * irchat-config.el, irchat-modules.el: New files.
-
-1999-04-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-switch-to-channel-no-*): Use `dotimes' on the
- definitions of themselves.
-
- * irchat-vars.el (irchat-ignore-spec-convert): Fix tag.
-
-1999-04-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * dcc.c (send_file): Use `get_address_externally'.
- (chat_listen): Likewise.
-
-1999-04-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * getaddrinfo.c: Include `stdlib.h'.
-
-1999-04-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.21.
-
- * irchat-handle.el (irchat-handle-mode-msg): Fix channel mode parser.
-
- * irchat-commands.el (irchat-command-ban-kick): New command.
- (irchat-command-ban): New command.
-
- * irchat-ctcp.el (irchat-ctcp-version-msg): Eliminate the client
- version string.
- (irchat-client-version-notice): Fix regexp.
- (irchat-client-version-insert): New function.
-
- * irchat-misc.el (irchat-repair-crlf): Fixed.
-
-1999-04-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * tcp.c (NI_MAXHOST): Add check if it has been already defined.
-
- * irchat.el (irchat-command-keys): Bind `C-c C-j'.
-\f
-1999-03-31 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-mode-msg): Fix regexp.
-
- * irchat-commands.el (irchat-command-finger): Add prefix arg.
-
-1999-03-30 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-filter.el (irchat-handle-message): Fix regexp.
-
- * irchat-handle.el (irchat-handle-join-msg): Fix regexp.
- (irchat-handle-nick-msg): Fix regexp.
-
-1999-03-24 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-finger): Specify nick twice.
-
- * liece-faq.texinfo: Fix URI of APEL's ftp sites.
-
-1999-03-17 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.20.
-
- * irchat-crypt.el (with-irchat-encryption): New macro.
- (with-irchat-decryption): New macro.
-
- * irchat-compat.el (valid-plist-p): Fixed.
-
- * irchat-tcp.el (irchat-tcp-default-connection-type): Renamed from
- `irchat-tcp-connection-type'.
- (irchat-open-network-stream-as-binary): Add optional arg `type'.
- (irchat-open-network-stream): Likewise.
-
- * irchat-vars.el (irchat-server-alist): Add `:prescript' and
- `:type' keywords.
-
-1999-03-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el: Require `pcustom'.
- (point-at-bol): Abolished. Use `line-beginning-position'.
- (point-at-eol): Abolished. Use `line-end-position'.
-
- * tcp.c: New file.
-
- * irchat-tcp.el: New file; TCP/IP emulation using external program.
-
- * irchat-compat.el (read-passwd): New function to keep compatibility.
- (passwd-echo): New variable to keep compatibility.
-
- * irchat-commands.el (irchat-command-who): Confirm really send WHO
- command with no arguments.
- (irchat-command-list): Likewise.
- (irchat-command-names): Likewise.
-
- * irchat-misc.el (irchat-set-crypt-indicator): Activate crypt mode
- also in private mode.
- (irchat-read-passwd): Abolished. Use `read-passwd'.
-
- * irchat-crypt.el (irchat-crypt-maybe-encrypt-message): Renamed
- from `irchat-crypt-with-encrypt-message'.
- (irchat-crypt-maybe-decrypt-message): Likewise.
-
-1999-03-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-join-msg): Fix regexp.
-
- * irchat-hilight.el (irchat-highlight-maybe-hide-quote): Fixed.
-
-1999-03-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.19.
-
- * irchat-commands.el (irchat-command-poll-names): Check if
- `irchat-server-opened' returns t.
- (irchat-command-poll-friends): Likewise.
-
- * irchat-hilight.el (irchat-highlight-turn-on-font-lock): Remove
- all hooks before calling `turn-on-font-lock'.
-
- * irchat-compat.el (run-hook-with-args-until-success): Do not use
- `run-hook-with-args'.
-
- * irchat-filter.el (irchat-handle-message-2): Use
- `run-hook-with-args-until-success' instead of
- `run-hook-with-args'.
-
- * irchat-handle.el (irchat-handle-with-running-cleartext-hook):
- Use `run-hook-with-args-until-success' instead of
- `run-hook-with-args'.
- (irchat-handle-run-cleartext-hook): Likewise.
- (irchat-handle-run-hook-with-args): Likewise.
-
- * irchat-timer.el (irchat-start-timer): Use `run-at-time' with 1st
- argument 0 instead of nil.
-
- * irchat-ctcp.el (irchat-query-client-nick-maybe-change): Return
- with nil explicitly.
-
- * irchat-vars.el (irchat-service-spec): New widget.
- (irchat-service-spec-convert): New function; widget-converter.
- (irchat-server-spec): New widget.
- (irchat-server-spec-convert): New function; widget-converter.
- (irchat-ignore-spec): New widget.
- (irchat-ignore-spec-convert): New function; widget-converter.
-
- * irchat-url.el (irchat-command-browse-url): Use the URL added
- most recently, if `current-prefix' equals `-'.
- (irchat-url-browser-netscape): Do not bind the process buffer.
-
- * irchat-menu.el (irchat-menu-add-button): Add 3rd argument.
-
-1999-03-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-xemacs.el: Use extents instead of overlays.
- (irchat-xemacs-put-text-property): New function.
- (irchat-xemacs-get-text-property): New function.
- (irchat-xemacs-kill-all-overlays): New function.
- (irchat-xemacs-overlays-at): New function.
-
- * irchat-compat.el (irchat-make-overlay): New emulation function.
- (irchat-delete-overlay): Ditto.
- (irchat-overlay-put): Ditto.
- (irchat-move-overlay): Ditto.
- (irchat-overlay-end): Ditto.
- (irchat-overlay-get): Ditto.
- (irchat-overlays-at): Ditto.
- (irchat-kill-all-overlays): Ditto.
-
-1999-03-12 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-toolbar-toggle-crypt): New function.
- (irchat-toolbar-icon-convert): New function; widget-converter.
- (irchat-toolbar-icon): New widget.
- (irchat-toolbar-icon-plist-get): New function.
- (irchat-toolbar-map-button-list): New function.
- (irchat-xemacs-setup-toolbar): Renamed from
- `irchat-xemacs-setup-toolbar-list'.
- (irchat-toolbar-setup-crypt-glyph): New function.
- (irchat-toolbar-toggle-crypt): New function.
- (irchat-use-toolbar): New customizable variable.
-
- * irchat-compat.el (irchat-put-text-property): Implemented as
- function.
-
- * irchat.el (irchat-after-load-startup-hook): New hook variable.
-
- * irchat-hilight.el (irchat-highlight-maybe-turn-on-font-lock):
- New function.
-
- * Liece 1.2.8.18.
-
- * irchat-channel.el (irchat-channel-create-buffer): Use
- `irchat-format-time-function'.
-
- * irchat-hilight.el: Use font-lock.el.
-
-1999-03-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-debug.el (irchat-debug-enter-handler): Moved from
- llhandler.el.
- (irchat-debug-leave-handler): Ditto.
-
- * llhandler.el (llhandler-debug-enter): Abolished.
- (llhandler-debug-leave): Abolished.
-
- * irchat-version.el (irchat-emacs-user-agent-value): New variable
- imported from `mime-edit-user-agent-value' of SEMI.
- (irchat-user-agent-value): New variable.
- (irchat-make-user-agent-string): Abolished.
- (irchat-make-emacs-user-agent-string): Abolished.
- (irchat-command-version): New command.
-
- * irchat-hilight.el (irchat-maybe-highlight-region): New function.
- (irchat-maybe-smiley-region): New function.
- (irchat-maybe-highlight-url-region): New function.
- (irchat-highlight-put-url-properties-region): New function.
-
- * irchat-ctcp.el: Add hooks in order to let
- `irchat-query-client-nick' follow the changes.
- (irchat-query-client-nick-maybe-change): New function.
- (irchat-query-client-nick-maybe-reset): New function.
-
- * irchat-url.el (irchat-url-gather-hook): New hook variable.
- (irchat-command-browse-url): Use `_'.
- (irchat-url-gather-urls-region): New function.
- (irchat-url-search-forward): New function.
-
- * irchat-compat.el (easy-menu-add-item): New alias.
-
- * irchat-xemacs.el (easy-menu-add-item): New advice.
-
-1999-03-10 Tsunehiko Baba <tbaba@mtl.t.u-tokyo.ac.jp>
-
- * dcc.c (main): Add cast against return value of basename(3).
-
-1999-03-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-menu.el (irchat-menu-url-menu): New variable.
-
- * Liece 1.2.8.17.
-
- * irchat-misc.el (irchat-compose-time-string): Renamed from
- `irchat-compose-servertimestring'.
-
- * irchat-compat.el (plist-get): New function for compatibility.
-
- * irchat-ctcp.el (irchat-client-time-notice): New handler.
- (irchat-ctcp-time-msg): Ditto.
-
- * irchat-minibuf.el (irchat-minibuffer-complete-channel-modes):
- Also display candidates when `irchat-minibuffer-parse-modes'
- returns 'flag.
-
- * irchat-400.el (irchat-handle-433-msg): `ERR_NICKNAMEINUSE'.
- Do grow-tail iteration on `irchat-real-nickname' only if
- `irchat-auto-iterate-nick' is specified.
-
- * irchat-vars.el (irchat-server-alist): Enable to specify keywords
- (:host, :service, :password, etc.).
- (irchat-auto-iterate-nick): New customizable variable.
-
- * irchat-menu.el (irchat-menu-add-url): New function.
- (irchat-command-mode-url-menu): New menu entry.
-
- * irchat.el (irchat): Do not ping to server.
- (irchat-open-server): Use new format of `irchat-server-alist'.
-
-1999-03-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-privmsglike-msg): Define as subst.
-
- * irchat-make.el (install-just-print-p): New function
- imported from APEL 9.13's `APEL-MK'.
- (config-irchat-package): Likewise.
- (compile-irchat-package): Likewise.
- (install-irchat-package): Likewise.
- (install-update-package-files): Likewise.
- (make-irchat-sample-files): New function imported from packaged
- version of Liece.
- (make-irchat-info-files): Ditto.
-
- * irchat-300.el (irchat-handle-366-msg): Do not update nicks when
- `irchat-353-nameslist' holds no element.
-
-1999-03-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-quit-msg,
- irchat-handle-mode-msg, irchat-handle-join-msg,
- irchat-handle-part-msg): Quote regexp.
-
-1999-02-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system): Fix backquotes.
-
-1999-02-25 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-303-msg): Fix. Add check for empty
- reply.
-
-1999-02-24 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-notice-msg): Fix. Call handler
- with `funcall'.
-
- * irchat.el (irchat-channel-mode-map): Make keymap as sparse.
- (irchat-others-mode-map): Likewise.
-
- * irchat-commands.el (irchat-command-deactivate-friends):
- Fix argument.
-
- * Liece 1.2.8.16.
-
- * irchat-globals.el (irchat-who-expression): New variable.
-
- * irchat-misc.el (irchat-toggle-command-buffer-mode): Change
- `irchat-private-indicator'.
-
- * irchat-300.el (irchat-handle-315-msg): `RPL_ENDOFWHO'.
- Display `no matches found' message
- (irchat-handle-{322,323,353,366}-msg): Count iterations.
-
- * irchat.el (irchat-command-mode): Do not save
- `frame-title-format' twice. Use `irchat-current-channel' in place
- of `irchat-channel-indicator'.
-
- * llhandler.el (llhandler-debug-enter): New function.
- (llhandler-debug-leave): New function.
- (llhandler-define-handler): New macro.
- (llhandler-eval-args): Abolished.
-
- * irchat-crypt.el (irchat-encrypt-message): Encode messages.
- (irchat-decrypt-message): Likewise. Decode messages.
- (irchat-crypt-with-encrypted-message): Do not encode message which
- has type `cleartext'.
-
-1999-02-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-send-pong): New macro.
- (irchat-increment-long-reply-count): New macro.
- (irchat-reset-long-reply-count): New macro.
- (irchat-check-long-reply-count): New macro.
-
- * irchat-globals.el (irchat-long-reply-count) New variable.
- (irchat-long-reply-max): New variable.
-
- * irchat-commands.el (irchat-command-save-vars): Fix. Set marker
- at output position.
-
-1999-02-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-303-msg): Add differential IsON.
-
- * irchat-commands.el (irchat-command-start-ison-timer,
- irchat-command-cancel-ison-timer, irchat-command-activate-friends,
- irchat-command-deactivate-friends): Do completion case
- insensitively.
-
- * irchat-vars.el (irchat-saved-forms): Add symbol `irchat-friends'
- to be saved its value.
-
-1999-02-20 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.15.
-
- * irchat-filter.el (irchat-sentinel): Do not throw signal, just
- clear whole system.
- (irchat-sentinel-error): Ditto.
-
- * irchat-vars.el (irchat-friends): New user customizable variable.
- (irchat-poll-friends-interval): New user customizable variable.
- (irchat-poll-names-interval): New user customizable variable.
-
- * irchat-commands.el (irchat-command-poll-names): Renamed from
- `irchat-command-pollnames'; implemented as function.
- (irchat-command-keepalive): Implemented as function.
- (irchat-command-poll-friends): New function.
- (irchat-command-activate-friends): New command.
- (irchat-command-deactivate-friends): New command.
-
- * irchat-300.el (irchat-handle-331-msg): Call
- `irchat-set-channel-indicator'.
- (irchat-handle-332-msg): Ditto.
-
- * irchat-globals.el (irchat-channel-status-indicator): New
- variable; default value of `frame-title-format'.
- (irchat-friends-last): New variable.
- (irchat-frame-title-format-last): New variable.
-
- * irchat-misc.el (irchat-set-frame-title-format): Do not calculate
- `frame-title-format' directly.
- (irchat-maybe-update-channel-indicator): New macro.
-
-1999-02-20 P.F.FrontJr. <pff@softai.co.jp>:
-
- * irchat-misc.el (irchat-set-channel-indicator): Display channel
- status on mode line.
-
- * irchat-vars.el (irchat-display-status-on-channel-indicator):
- New user customizable variable.
-
-1999-02-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): Set alternative
- startup file as primary one.
-
- * irchat-timer.el (irchat-start-timer): Do not require `timer' or
- `itimer'; autoload timer functions.
- (irchat-cancel-timer): Ditto.
-
-1999-02-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ck-ccl (irchat-ck-ccl): Remove.
- (irchat-ck-ccl-cj-to-ck-string): Use `ccl-execute-on-string'.
- (irchat-ck-ccl-ck-to-cj-string): Ditto.
-
- * irchat-xemacs.el (irchat-xemacs-setup-toolbar): New function.
-
- * irchat-menu.el (irchat-command-add-menus): New function; add
- menubar menus explicitly.
-
- * irchat-coding.el (irchat-coding-custom-detect-coding-region):
- New variable; set user customizable function to detect coding system.
- (irchat-coding-custom-detect-coding-string): Likewise.
- (irchat-detect-coding-string-tcljp): Transported from
- `tclKanjiUtil.c'; trivial encoding detection routine.
- (irchat-default-coding-system): Moved from `irchat-vars.el'.
- (irchat-default-mime-charset): Ditto.
- (irchat-detect-coding-system): Ditto.
-
- * crc32.el (crc32-region): Remove `mark-active'.
-
- * irchat-timer.el (irchat-cancel-timer): Fix for XEmacs's
- `itimer'.
-
- * Liece 1.2.8.14.
-
- * irchat-dcc.el (irchat-dcc-requests): Rename from
- `irchat-dcc-request-list'; implemented as actually a queue.
-
- * queue-m.el: New file; imported from elib.
-
- * irchat-filter.el (irchat-filter): Remove checking whether
- process output line contains LF; remove duplicated LF checking
- likewise; enclose with `save-match-data'.
- (irchat-handle-message): Add checking user-at-host cookie with
- restricted line.
-
- * irchat-window.el (irchat-window-functionp): Remove; use
- `irchat-functionp'.
-
- * irchat-channel.el (irchat-channel-get-nicks): Fix; apply car
- against each elements.
-
-1999-02-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-mode+o,
- irchat-command-mode+v): Build completion list using
- `filter-elements'.
-
- * irchat-vars.el (irchat-exit-hook): Rename from
- `irchat-Exit-hook'.
-
- * irchat-inlines.el (irchat-functionp): New macro.
-
- * irchat-compat.el (mapvector): New macro.
-
- * irchat-misc.el (irchat-greet-author): Remove.
- (irchat-split-rest): Fix arguments.
- (irchat-completing-default-read): 3rd and later arguments become
- optional.
- (irchat-completing-sequential-read): Evaluate completion table
- consequently; Add optional argument `multiple-candidate', if this
- arg is non-nil always create new table with its initial state.
-
- * llhandler.el (llhandler-define-entry-point): Add debugging
- triger in frount of function definition.
- (llhandler-define-with-return): Ditto.
- (llhandler-define): Ditto.
- (llhandler-enter-format-string): New constant; for debugging use.
- (llhandler-leave-format-string): Ditto.
- (llhandler-eval-args): New macro.
-
- * irchat.el (irchat-open-server-internal): Use
- `open-network-stream-as-binary'.
- (irchat-startup-hook): Rename from `irchat-Startup-hook'.
-
-1999-02-07 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.13.
-
- * idea.el (idea-ecb-decrypt-string): Enclose Base64 decoded string
- with `string-as-unibyte'.
- (idea-cbc-decrypt-string): Ditto.
-
- * idea.el: Sync up with Irchat-980625-2.
-
- * crc32.el: Ditto.
-
- * irchat-300.el (irchat-handle-303-msg): Fix matched string.
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Check whether
- private message has come from entirely outer.
-
- * irchat-filter.el (irchat-handle-message): Remove all occurence
- of CR out of inputs :(
-
-1999-02-06 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): Save alternatively
- specified startup file name into `irchat-variables-files'.
-
-1999-02-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-dcc.el (irchat-command-dcc-accept): Remove destructive
- checking.
-
- * irchat-make.el: Do not use `add-to-list' for Emacs19.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
-
-1999-02-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-coding.el (irchat-coding-detect-coding-region)
- (irchat-coding-detect-coding-string): New function.
- (irchat-coding-decode-mime-charset-region): Use above directly.
- (irchat-coding-decode-mime-charset-string): Ditto.
-
-1999-02-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-who): Fixed setting
- `irchat-channel-alist.
-
- * Liece 1.2.8.12.
-
- * irchat-nick.el (irchat-nick-get-user-at-host): New macro.
-
- * irchat-compat.el (temp-minibuffer-message): New function.
-
- * irchat-minibuf.el: New file; custom minibuffer completion.
-
- * irchat.el (irchat-open-server-internal): Add check for dotless
- IP or IPv6 address representation.
-
- * irchat-channel.el (irchat-channel-set-voice): Replace with
- regexp.
-
-1999-02-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-319-msg): Fixed channel conversion.
-
- * irchat-commands.el (irchat-command-modec): Fixed completion.
- (irchat-command-mode-o,irchat-command-mode+v,irchat-command-mode-v):
- Fix format string.
-
- * dcc.c (chat_listen): Print connection result.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen): Add dummy
- argument `chat' for compatibility.
-
- * irchat-channel.el (irchat-channel-remove-mode): Use `delq'.
- (irchat-nick-remove-mode): Ditto.
-
- * Liece 1.2.8.11.
-
- * irchat-menu.el (irchat-menu-popup-menu): Check whether XEmacs or
- not compile time.
-\f
-1999-01-31 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (set-keymap-parents): New macro.
-
- * irchat-commands.el (irchat-command-join-channel): Add flag
- whether `irchat-command-buffer-mode' is toggled.
- (irchat-command-join-partner): Ditto.
-
- * irchat-300.el (irchat-count-words-from-string): Count postfix
- white spaces.
-
- * irchat-q-el.el: Splited from `irchat-ctcp.el'; binary data
- quotation in emacs-lisp.
- * irchat-q-ccl.el: Same functionality as above but implemented in
- Emacs CCL.
-
- * b64.el (b64-encode-string, b64-decode-string): Add autoload
- cookie.
-
- * irchat.el (irchat-channel-list-keys): New variable.
- (irchat-define-keys): Add lisp-mode indentation.
- (irchat-channel-mode-map, irchat-others-mode-map): Set
- `irchat-dialogue-mode-map' as its keymap parent.
-
-1999-01-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.8.10.
-
- * dcc.c: Rewritten but this is obsoleted.
-
- * irchat-commands.el (irchat-command-end-of-buffer): Renamed from
- `irchat-command-eod-buffer'; this works also in `irchat-{channel,
- others}-buffer-mode'.
-
- * dcc.ml (getaddr_ext): New function.
-
- * irchat-dcc.el (irchat-dcc-send-filter): Fix regexp.
- (irchat-dcc-add-to-process-alist): Add process key as symbol.
- (irchat-dcc-get-process-object): Likewise.
- (irchat-command-dcc-receive): Fixed arguments of
- `irchat-dcc-add-to-process-alist'.
- (irchat-command-dcc-send): Likewise.
- (irchat-command-dcc-accept): Fix typo.
-
-1999-01-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-others-mode-map): Add key binding of
- `irchat-command-tag-region'
-
- * irchat-commands.el (irchat-command-join-channel): Use
- `irchat-channel-memberp'.
- (irchat-command-modec): Make completion from supported mode list.
- (irchat-channel-real): Try match with
- `irchat-channel-conversion-map' case insensitively.
- (irchat-channel-virtual): Ditto.
-
-1999-01-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-supported-channel-mode-alist):
- (irchat-supported-user-mode-alist): New variable
-
- * irchat-nick.el (irchat-nick-get-modes): New macro.
- (irchat-nick-add-mode): New macro.
- (irchat-nick-remove-mode): New macro.
- (irchat-nick-set-mode): New macro.
-
- * irchat-000.el (irchat-handle-004-msg): Save server supported
- modes.
-
- * Liece 1.2.8.9.
-
- * irchat-make.el: Add local copy of APEL to `load-path'.
- (autoload-irchat): New function to generate autoload file.
-
- * irchat.el (irchat-command-keys): Add key definition of
- `irchat-command-set-window-style' (C-c s).
- (irchat): Parse `irchat-variables-files' specified in command
- line.
- (irchat-read-variables-files): Add optional argument `file'.
-
- * irchat-window.el (irchat-window-set-default-style): Fallback
- style used when encountered an error at style-file loading time.
-
- * irchat-handle.el (irchat-handle-mode-msg): Gather channel modes
- correctly.
-
- * irchat-channel.el (irchat-channel-get-modes): New macro.
- (irchat-channel-set-mode): New macro.
- (irchat-channel-add-mode): New macro.
- (irchat-channel-remove-mode): New macro.
-
- * irchat-menu.el (irchat-menu-prepare-menus): Fix typo in
- `irchat-command-previous-channel'.
- (irchat-menu-IRC-menu): Add menu items.
-
-1999-01-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-change-nick-of): Fixed.
-
-1999-01-22 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * llhandler.el: New file.
-
- * Liece 1.2.8.8.
-
- * irchat-handle.el (irchat-handler-defun-*): Abolished.
- (irchat-handler-defsubst-*): Abolished.
- (irchat-handler-obarray): New variable.
- (irchat-handle-error-msg): New handler.
- Handler API has been rewritten with `irchat-handler-obarray',
- which enables faster handler lookup from hash.
-
-1999-01-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Rewritten with new handler API.
- (irchat-ctcp-file-save-directory): New user variable.
- (irchat-client-message): New macro.
- (irchat-client-file-message): New macro.
-
- * irchat-vars.el (irchat-gather-channel-modes): New user variable.
- (irchat-*-buffer): Moved into `irchat-globals.el'.
-
- * irchat-misc.el: Require `invisible'.
- (irchat-remove-properties-region): Use
- `next-single-property-change' instead of `next-property-change'.
- (next-visible-point): Add advice to pass optional argument
- `limit'.
- (irchat-change-nick-of): Fixed.
-
-1999-01-20 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (filter-elements): Renamed from `filtercar'.
- Rewritten as macro with referring to `dabbrev-filter-elements'.
-
- * defface.el (defface-set-face-inverse): New function.
- (defface-face-inverse): Ditto.
- (defface-set-face-bold): Abolished. Use `face-set-bold-p'.
- (defface-face-bold): Abolished. Use `face-bold-p'.
- (defface-set-face-italic): Abolished. Use `face-set-italic-p'.
- (defface-face-italic): Abolished. Use `face-italic-p'.
-
-1999-01-19 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-tag-region): Renamed from
- `irchat-dialogue-tag-line'. Add removing 'face and 'invisible
- properties from text moved into kill ring.
-
- * sample.dot.liece{,.ja}: Fixed documentation about window
- configuration.
-
- * irchat-misc.el (irchat-pick-buffer): Assume that channel names
- are associated to channel buffers case insensitively.
- (irchat-remove-properties-region): New macro.
-
-1999-01-18 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-compat.el (keymap-accept-event-array): Abolished.
-
- * Liece 1.2.8.7.
-
- * irchat-misc.el (matching-substring): Became an alias for
- `match-string'.
-
- * irchat.el (irchat-open-server): Fixed.
- (irchat-open-server-internal): Fixed.
- Do not require `smiley'.
-
-1999-01-17 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-300.el (irchat-handle-364-msg): Fixed.
-
- * irchat-200.el (irchat-handle-213-msg): Fixed.
-
- * irchat-intl.el (irchat-intl-load-catalogue): Do not bind `lang'
- to `current-language-environment'.
-
- * irchat-window.el (irchat-configure-windows): Switch to
- `irchat-command-buffer' before calling function
- `irchat-window-configure-frame'.
-
- * irchat-timer.el: Enclose statement which has newly styled macros
- with `eval'.
-
- * irchat-compat.el (run-hook-with-args-until-success): New macro
- for compatibility.
-
- * irchat-misc.el (irchat-convert-received-input): New macro.
- No longer require `irchat-filter'.
-
-1999-01-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-caesar.el: Abolished.
-
- * irchat-compat.el (function-documentation): New macro.
-
- * irchat-commands.el (irchat-command-point-back-to-command-buffer):
- New command. Bind key to `c'.
- (irchat-command-caesar-line): Abolished. Use `mule-caesar-region'.
-
- * irchat-misc.el (irchat-is-message-ignored): Moved from
- `irchat.el'.
- (irchat-maybe-poll): Ditto.
- (irchat-set-crypt-indicator): Ditto.
- (irchat-get-buffer-create): Ditto.
- (irchat-hex-char-to-integer): Imported from `misty1.el'.
- (irchat-hex-string-to-integer): Ditto.
-
-1999-01-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-read-variables-files): New function.
- (irchat-command-read-variables-files): New alias to
- `irchat-read-variables-files'.
- (irchat-initialize-buffers): New wrapper function.
- (irchat-replace-internal): New macro.
- (irchat-insert-internal): New macro.
-
- * irchat-compat.el (ccl-enable-to-read-multibyte): New broken
- facility.
- (buffer-or-string-p): New macro.
-
- * irchat-misc.el (irchat-send-as-binary): New macro.
- (irchat-send): Add `string-as-unibyte' while checking length of
- string.
- (irchat-replace-in-string): Abolished.
-
- * irchat-ck-ccl.el: CCL version of `ck' to `cj' converter.
-
- * irchat-ck-el.el: Renamed from `irchat-hankana.el'.
-
- * irchat-make.el: irchat-make.el: Add checking whether CCL accepts
- `read-multibyte-character'.
-
-1999-01-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-nickname): New macro.
-
- * irchat-window.el (irchat-configure-windows): Enclose
- calling function `irchat-window-configure-frame' with
- `save-excursion'.
-
- * irchat-crypt.el (irchat-crypt-with-decrypt-message):
- Renamed from `irchat-crypt-with-encrypted-message'.
- (irchat-crypt-with-encrypt-message): New macro.
-
- * irchat-commands.el (irchat-command-join-partner): Fixed.
- (irchat-command-timestamp): Fixed.
- (irchat-command-send-message): Fixed.
- (irchat-command-message): Fixed.
- (irchat-command-prepare-message-prefix): New macro.
- (irchat-command-prepare-own-message-prefix): New macro.
-
- * Liece 1.2.8.6.
-
- * irchat-channel.el (irchat-channel-join): Fixed.
-
- * irchat-url.el (irchat-url-prepare-browser-function): New macro.
- (irchat-url-command-browse-url): Add checking
- `irchat-url-browser-name' prior to `irchat-url-browser-function'.
-
-1999-01-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * README-styles.ja: New file.
-
- * irchat-channel.el (irchat-channel-change): Enclose with
- `save-excursion'.
-
-1999-01-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat): Fixed bug in XEmacs toolbar specification.
-
-1999-01-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-get-joined-channels): New macro.
-
- * irchat-channel.el (irchat-channel-get-nicks): New macro.
- (irchat-channel-get-opers): Ditto.
- (irchat-channel-get-voices): Ditto.
- (irchat-channel-get-topic): Ditto.
-
- * styles/{top,bottom}: Fixed command buffer lines.
-
- * Liece 1.2.8.5.
-
- * irchat.el (irchat-insert): Remove checking "(featurep 'custom)".
-
- * defface.el: New file.
-
-1999-01-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handler-define-entry-point): New alias.
- (irchat-handler-defun-with-return): New macro.
- (irchat-handler-defsubst-with-return): New macro.
-
- * irchat-{000,200,300,400,500}.el: Rewritten with new handler API.
-
- * irchat-handle.el (irchat-handler-entry-point-defun): New macro.
- (irchat-handler-entry-point-defsubst): New macro.
-
- * irchat-handle.el (irchat-handle-with-running-cleartext-hook):
- Renamed from `irchat-handle-with-cleartext-hook'.
- (irchat-handle-run-cleartext-hook):
- Renamed from `irchat-handle-cleartext-hook'.
-
-1999-01-08 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * styles/top: New file.
-
- * irchat-misc.el (irchat-message): New macro.
-
- * Liece 1.2.8.4.
-
- * styles/{bottom,middle}: New file.
-
- * irchat-window.el (irchat-configure-windows): Moved from
- `irchat'.
-
- * irchat-window.el: New file for style-based window configuration.
-
- * irchat-nick.el (irchat-nick-replace): Fixed moving point to
- highlight mouse face.
-
-1999-01-05 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-update-region): Set point to mouse
- clicked position.
-
- * Liece 1.2.8.3.
-
- * irchat.el (irchat-nick-mode-map): Add popup menu.
-
- * irchat-menu.el (irchat-nick-popup-menu): New function.
- (irchat-menu-popup-menu): New macro.
-
- * irchat-intl.el (irchat-intl-get-msgstr-if): New macro.
-
- * irchat-nick.el (irchat-nick-update-region): New function.
- (irchat-nick-region-nicks): Moved from `irchat-xemacs'.
- (irchat-nick-region-opers): Ditto.
- (irchat-nick-region-voices): Ditto.
-
- * irchat-menu.el (irchat-menu-callback-*): Moved from
- `irchat-xemacs'.
- (irchat-menu-define-menus): Moved to defadviced block.
-
- * irchat-xemacs.el (irchat-xemacs-setup-menu): Shared
- `irchat-nick-update-region'.
-
- * irchat-channel.el (irchat-channel-set-operator): Fixed regexp.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
-
-1999-01-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-nick-replace): Fixed execution order.
-
- * irchat-nick.el (irchat-nick-replace): Fixed regexp.
- And enclose `save-restriction'.
-
- * irchat-menu.el: Add easymenu support.
-
- * Liece 1.2.8.2.
-
- * irchat-crypt.el (irchat-crypt-with-encrypted-message):
- New macro.
-
- * irchat-handle.el (irchat-handler-defsubst): New macro.
- (irchat-handler-defun): Ditto.
- (irchat-handler-return): Ditto.
- All handler routines are defined with new form.
- (irchat-handle-with-cleartext-hook): New macro.
- (irchat-handle-cleartext-hook): Ditto.
- (irchat-handle-run-hook-with-args): Ditto.
- Handler code eliminated by global jump.
- (irchat-handle-set-channel-prefix): New macro.
- (irchat-handle-set-dialogue-prefix): Ditto.
- (irchat-handle-set-private-prefix): Ditto.
-
- * irchat-misc.el (irchat-insert-change): New macro.
- (irchat-insert-notice): Ditto.
- (irchat-insert-broadcast): Ditto.
- (irchat-insert-wallops): Ditto.
- (irchat-insert-error): Ditto.
- (irchat-insert-info): Ditto.
- (irchat-insert-timestamp): Ditto.
- (irchat-insert-dcc): Ditto.
- (irchat-insert-client): Ditto.
-
-1999-01-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-switch-to-channel-no): Fixed.
-
- * irchat-hilight.el (irchat-highlight-region): Check
- `irchat-display-prefix-tag'.
-
- * irchat-vars.el (irchat-display-prefix-tag): New variable.
-
- * irchat-hilight.el (irchat-highlight-hide-prefix-region):
- New function.
-
- * irchat-version.el (irchat-version-user-agent-style): Abolished.
- (liece-client-product): New variable.
- (liece-client-name): New macro.
- (liece-client-version-major): Ditto.
- (liece-client-version-minor): Ditto.
- (liece-client-version-beta): Ditto.
- (liece-client-version-alpha): Ditto.
- (liece-client-codename): Ditto.
-
- * irchat-version.el (irchat-make-emacs-user-agent-string): New
- function.
-
- * irchat.el (irchat-insert): Renamed from `irchat-w-insert'.
- (irchat-replace): Renamed from `irchat-w-replace'.
-
- * irchat-intl.el (irchat-intl-domain-to-mime-charset-alist): New
- variable.
-
- * irchat-intl.el (irchat-intl-parse-Content-Type): Do not use
- `mime-parse-Content-Type' when `mime-parse' is not loaded.
-
- * irchat.el: Remove extra calls of `suppress-keymap'.
-
- * irchat-compat.el: Remove all CL emulation.
-
- * Liece 1.2.8.1.
-
- * irchat-intl.el (irchat-intl-use-localized-messages): New
- variable.
-
-1999-01-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-parse-Content-Type): Parse
- "Content-Type:" header to recognize coding used in PO files.
-
-1999-01-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-intl.el (irchat-intl-domains-to-coding-system-alist):
- Abolished.
-
- * irchat-commands.el (irchat-command-find-timestamp): Regexp fixed.
-\f
-1998-12-30 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Add experimental i18n feature.
-
- * po/ja.po: New file.
-
- * irchat-intl.el: New file.
-
- * irchat-ctcp.el (irchat-ctcp-msg): Message format fixed.
-
- * irchat-channel.el (irchat-channel-join): Fixed.
- (irchat-channel-create-buffer): Fixed.
-
-1998-12-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-switch-to-channel{,-no}):
- Do not reconfigure windows.
-
- * TODO.ja: New file.
-
- * Liece 1.2.6.13/1.2.8.0.
-
- * irchat-commands.el (irchat-switch-to-channel): Fixed.
- (irchat-switch-to-channel-no): Fixed.
-
- * irchat-misc.el (irchat-toggle-command-buffer-mode): When hiding
- state of nick buffer is toggled, reconfigure windows every time.
-
- * irchat-handle.el (irchat-handle-join-msg): Check whether joined
- channel is modeless.
-
- * irchat-misc.el (irchat-channel-modeless-p): New macro.
- (irchat-channel-modeless-regexp): New variable.
-
- * irchat-handle.el (irchat-handle-{join,quit,mode,part}-msg):
- Compression of changes reworked.
-
- * irchat-vars.el (irchat-display-time): Rename from
- `irchat-print-time'.
- (irchat-time-prefix-regexp): Regexp for time prefix.
-
- * irchat-mail.el: Add autoloads instead of all requires
- (`gnus-msg', `sendmail', `mime-edit').
- (irchat-mail-compose-with-mail): Add evals to silence
- byte-compiler.
- (irchat-command-mail-compose): Fix completion.
-
- * irchat-channel.el (irchat-channel-buffer-create):
- Rewritten as a macro.
-
- * irchat-nick.el (irchat-nick-buffer-create): Ditto.
-
- * irchat-compat.el: `<<' and `>>' are become aliases of lsh.
-
- * irchat.el: Rename `irchat-Select-keys' to `irchat-select-keys'.
-
- * sample.liece{,.ja}: Add sample setting of
- `irchat-startup-channel-list'.
-
- * irchat.el (irchat-command-keys): Bind `C-c b' and `C-c N b' to
- `irchat-command{,-nick}-scroll-down' (synced up with irchat-2.4jp24f).
- (irchat-nick-keys): Bind scrolling functions.
-
- * irchat.el (irchat-command-mode): Display `minor-mode-alist' on
- mode-line.
-
- * irchat-globals.el (irchat-obarray):
- Set initial array length to 1.
-
- * irchat.el: Remove preparation code of `irchat-obarray'.
-
- * liece-faq.texinfo: Change formatting style.
-
-1998-12-10 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-commands.el (irchat-command-nick-scroll-down): Add check
- whether `irchat-nick-buffer' is visible.
- (irchat-command-nick-scroll-up): Ditto.
-
- * irchat-commands.el (irchat-command-scroll-down): Add check
- whether `irchat-channel-buffer' is visible.
- (irchat-command-scroll-up): Ditto.
-
-1998-12-09 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-set-channel-indicator): Add check for
- `irchat-display-frame-title'.
-
- * irchat.el (irchat-configure-windows): Bind
- `irchat-channel-buffer-mode' and `irchat-nick-buffer-mode' at the
- entry point.
-
- * irchat-channel.el (irchat-channel-switch-to-last): New macro.
-
- * Liece 1.2.6.12.
-
- * irchat-commands.el (irchat-channel-real): Fix spelling.
- (irchat-channel-virtual): Ditto.
-
- * irchat-channel.el (irchat-channel-switch-to-last): New function.
-
- * irchat-channel.el (irchat-channel-last): New macro.
-
- * irchat-misc.el (irchat-change-nick-of): Fixed.
-
-1998-12-04 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-own-channel-message):
- (ircaht-own-private-message): Remove dialogue buffer from target
- buffers.
-
- * liece-faq.texinfo: Fix hook for auto invisible.
-
-1998-12-03 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-pick-buffer): Moved to `irchat-misc.el'.
-
- * irchat-highlit.el (irchat-highlight-pattern-alist): Fix regexp
- for DCC chatting line.
-
- * irchat-commands.el (irchat-command-modec): Select target channel.
-
- * irchat-dcc.el (irchat-command-dcc-chat-listen):
- (irchat-command-dcc-chat-listen): Use `as-binary-process'
- block.
-
- * irchat.el (irchat-open-server-internal): Ditto.
-
- * irchat-vars.el (irchat-binary-coding-system): Abolished.
-
- * irchat.el (irchat-open-server-internal): Bind
- `file-coding-system-for-{read|write}' for Mule 2.3.
-
- * irchat.el: `irchat-switch-to-channel-no-*' registered automatically.
-
-1998-12-02 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el: Require `mcharset'.
-
- * Liece 1.2.6.11.
-
- * irchat-vars.el (irchat-default-mime-charset): New variable.
-
- * irchat-coding.el: Use `mcharset' instead of
- `{encode|decode}-coding-*'.
- (irchat-coding-encode-charset-region):
- (irchat-coding-encode-charset-string): New macro.
-
- * irchat-dcc.el (irchat-dcc-pop-request-object): Fixed.
-
- * irchat-compat.el (caar): New macro.
-
- * irchat-misc.el (irchat-repair-crlf): New function.
-
- * Liece 1.2.6.10.
-
- * irchat.el (irchat-dcc-map): New keymap.
-
- * irchat-dcc.el (irchat-command-dcc-accept): New function.
- (irchat-dcc-get-*): Access method for request object.
- (irchat-dcc-pop-request-object): New macro.
-
- * Liece 1.2.6.9.
-
- * irchat-dcc.el: Very experimental DCC chat support added.
- (irchat-command-dcc-chat-listen): New function.
- (irchat-command-dcc-chat-connect): Ditto.
- (irchat-dcc-chat-listen-filter): Ditto.
- (irchat-dcc-chat-connect-filter): Ditto.
- (irchat-dcc-chat-filter): Ditto.
- (irchat-dcc-channel-representation-format): New variable.
-
- * irchat-channel.el: Very experimental multiple server support
- added.
- (irchat-default-channel-representation-format): New variable. This
- is unified channel locater. Set default as
- "@<server abbreviation>+<channel name>".
- (irchat-channel-parse-representation): New function.
- (irchat-channel-prepare-representation): Ditto.
-
- * irchat-misc.el (irchat-own-channel-message): New function.
-
- * irchat-misc.el (irchat-own-message): New macro.
-
- * dcc.ml: Explicitly return with code 0.
-
- * irchat-dcc.el (irchat-dcc-send-filter): Fixed.
- (irchat-dcc-receive-filter): Fixed.
-
-1998-12-01 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-dcc-prefix): New variable.
-
- * irchat-compat.el (cdddr): New macro.
-
- * irchat-dcc.el (irchat-dcc-add-to-receive-list): New macro.
- (irchat-dcc-add-to-process-alist): Ditto.
- (irchat-dcc-get-process-object): Ditto.
- (irchat-dcc-sentinel): New sentinel function.
- (irchat-dcc-prepare-directory): New function.
- (irchat-ctcp-dcc-msg): Add handler for DCC chat.
- (irchat-command-dcc-send): Rewritten.
- (irchat-command-dcc-receive): Ditto.
- (irchat-command-dcc-list): Ditto.
-
- * Liece 1.2.6.8.
-
- * dcc.ml: New file.
-
- * naddr.mli: Ditto.
-
- * naddr.ml: Ditto.
-
- * irchat-misc.el (irchat-own-message):
- (irchat-own-private-message): Add check whether channel buffer has
- been created.
-
- * sample.dot.liece: Fix typo.
-
- * sample.dot.liece.ja: Ditto.
-
- * irchat-url.el (irchat-url-browser-netscape): Use builtin
- composer when encounted `mailto:'.
-
- * irchat-commands.el (irchat-dialogue-insert): Abolished.
-\f
-1998-11-28 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-misc.el (irchat-own-private-message): Check if
- `irchat-command-buffer-mode' is not 'chat.
-
- * Liece 1.2.6.7.
-
- * irchat-channel.el (irchat-channel-prepare-partner):
- Fixed for setting `irchat-current-chat-partner'.
-
- * irchat.el: Do not require `irchat-mail'.
-
-1998-11-27 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el: Set default `truncate-lines'.
-
-1998-11-26 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-vars.el (irchat-display-frame-title): New variable.
-
- * Liece 1.2.6.6.
-
- * irchat-channel.el (irchat-command-toggle-channel-buffer-mode):
- Remove setting dirty flag.
-
- * irchat-nick.el (irchat-command-toggle-nick-buffer-mode):
- Ditto
-
-1998-11-25 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-mail.el: New file.
-
- * irchat-vars.el (irchat-convert-hankaku-katakana): New variable.
-
- * irchat-hankana.el: New file.
-
- * Liece 1.2.6.5.
-
- * irchat-300.el (irchat-handle-303-msg): Print come back
- messages for private conversation.
-
- * irchat-misc.el (irchat-set-channel-indicator): New macro.
-
- * irchat-handle.el (irchat-handle-nick-msg): Fixed channel indicator.
-
- * irchat.el (irchat-close-server): Set `irchat-server' to nil.
-
- * irchat-handle.el (irchat-handle-join-msg): Fixed for private
- conversation.
-
- * Add copylefts.
-
-1998-11-23 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-globals.el (irchat-ison-timer): New variable.
-
- * irchat-vars.el (irchat-ison-interval): New variable.
-
- * irchat-commands.el (irchat-command-set-ison-timer): New
- function.
- (irchat-command-cancel-ison-timer): Ditto.
-
- * irchat-misc.el (irchat-completing-sequential-read): New function.
-
- * Liece 1.2.6.4.
-
- * irchat-compat.el (irchat-button3): Moved into `eval-and-compile'
- enclosure.
-
- * irchat.el: Do not require alist.
-
- * irchat-handle.el (irchat-handle-quit-msg): Rewritten.
-
- * irchat-handle.el (irchat-handle-nick-msg): Handle nick message
- and reflect changes to private buffers.
-
-1998-11-21 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.6.3.
-
- * irchat-misc.el (irchat-channel-p): New macro.
- (irchat-toggle-command-buffer-mode): New wrapper function.
-
- * irchat.el (irchat-windows-reconfiguration-needed): Fixed
- predicate for nick buffer mode and channel list mode.
-
- * irchat.el (irchat-command-keys): Removed duplicated binding of
- `irchat-command-enter-message'(`\C-j' and `\M-\C-j').
-
-1998-11-19 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Fixed.
-
- * etc/ball.*.xpm: Remove background color in each XPM file
- (From Yasushi Shoji <yashi@yashi.com>).
-
- * sample.dot.liece: Add sample customizations of new feature.
- `irchat-channel-list-buffer-mode',
- `irchat-channel-list-window-width-percent',
- `irchat-auto-join-partner'.
-
- * irchat-filter.el (irchat-filter): Remove unreferenced binding.
-
- * irchat-handle.el (irchat-handle-privmsg-msg): Handle private
- message and join automatically.
-
- * Liece 1.2.6.2.
-
- * irchat-vars.el (irchat-auto-join-partner): New variable.
- (irchat-channel-list-window-width-percent): Ditto.
-
- * irchat-compat.el (irchat-button3): New variable.
-
- * irchat-channel.el (irchat-channel-push-button): New handler.
- (irchat-channel-list-insert): New function.
- (irchat-channel-prepare-partner): New function.
-
- * irchat-url.el (irchat-url-push-button): Search URL string around
- event line.
-
- * irchat.el (irchat-channel-list-mode): New major mode.
- (irchat-configure-windows): Fixed for channel list window.
- (irchat-channel-list-mode-map); New keymap.
-
- * All irchat-{`Command', `Nick', `Channel', `Others', `Crypt'}-*
- symbols renamed with uncapitalized one.
-
-1998-11-16 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * Liece 1.2.4.4.
-
- * irchat-filter.el: Do not require mcharset.
-
- * irchat-timer.el: Macro expression fixed (for Emacs19).
-
- * Liece 1.2.4.3/1.2.6.1.
-
- * irchat-vars.el (irchat-binary-coding-system):
- New variable.
-
- * irchat-coding.el: New file.
-
- * irchat-filter.el (irchat-run-message-hook-types):
- Abolished.
- (irchat-handle-message): Rewritten.
- (irchat-handle-message-2): Rewritten.
-
-1998-11-15 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat.el (irchat-Dialogue-mode-map):
- (irchat-Channel-mode-map):
- (irchat-Others-mode-map): Add check whether array style keymap
- expression is acceptable.
-
- * liece-faq.texinfo: New FAQ added for older version of emacsen.
-
- * irchat-handle.el (irchat-handle-privmsg-msg):
- Rewritten.
-
- * irchat-200.el (irchat-handle-200-msgs):
- Channel mask regexp fixed.
-
- * irchat-300.el (irchat-handle-300-msgs):
- Ditto.
-
- * irchat-400.el (irchat-handle-400-msgs):
- Ditto.
-
- * sample.dot.liece: Add sample hook for auto invisible.
-
- * Liece 1.2.3.5.
-
- * irchat-vars.el (irchat-default-coding-system):
- Set default to 'iso-2022-jp.
- (irchat-detect-coding-system): New custom variable.
-
- * irchat-misc.el (irchat-send): Add code conversion with
- `encode-coding-region' .
-
- * irchat-filter.el (irchat-filter): Add coding-system detection.
-
- * irchat-compat.el (irchat-set-process-coding-system):
- (irchat-buffer-disable-undo): Abolished.
- (buffer-disable-undo): New macro.
-
- * defsubst.el: Removed.
-
-1998-11-14 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (irchat-ccl-quote-decode): Fixed.
-
-1998-11-13 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el (ccl-cascade-write):
- (ccl-set-register-right): New broken facility.
- (irchat-ccl-quote-decode): Rewritten with checking broken CCL
- facilities.
-
- * irchat-timer.el (irchat-start-timer):
- Fixed macro expression for older versions of emacsen.
-
- * irchat-compat.el (defface): New macro for older versions of
- emacsen.
-
-1998-11-12 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-ctcp.el: Add CCL usability checking with `ccl-usable'.
-
-1998-11-11 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-version.el (irchat-make-user-agent-string):
- (irchat-make-version-string):
- Regexp fixed.
-
- * irchat-ctcp.el (irchat-ccl-quote-decode):
- (irchat-ccl-quote-encode): Check if module `pccl' exists.
-
- * sample.dot.liece: Renamed from sample.irchat3_vars.el.
-
- * irchat-version.el (liece-client-minor-version):
- Numbered as 1.2.3.3.
- (irchat-version-user-agent-style):
- Declaration revereted to `defvar' from `defcustom'.
-
- * Makefile: Removed `-lnsl'.
-\f
-1998-10-20 Daiki Ueno <daiki@kake.info.waseda.ac.jp>
-
- * irchat-nick.el (irchat-Nick-update): Bug fixed in splitting 353
- (NAMEREPLY) message.
-
- * irchat-inlines.el (list-to-assoclist): Rewritten.
-
-1998-10-08 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-toolbar-spec-list): Replace
- `irchat-Command-push' and `irchat-Command-pop' with
- `irchat-Command-previous-channel' and `irchat-Command-next-channel'.
- (irchat-x-face-face-insert): Evaluate also when loaded.
-
-1998-10-07 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-crypt.el (base64-encode-string): Fixed autoload with
- `mel' to `mel-b' package.
- (base64-decode-string): Ditto.
-
-1998-10-06 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-xemacs.el (irchat-xemacs-splash-logo): Splash screen with
- "liece.xpm" on every loadup time.
-
- * irchat-version.el (liece-client-version): Numbered as 1.2.1.
-
- * irchat-x-face.el (irchat-x-face-face-insert): Display X-Face on
- each prefix line align middle.
-
- * irchat-debug.el: New file.
-
-1998-10-02 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat.el (irchat-Debug-mode): New major mode for
- `irchat-Command-debug'.
-
- * liece-faq.texinfo: New file.
-
- * irchat-commands.el (irchat-Client-query-map): Key binding for
- `irchat-Command-client-x-face-from-minibuffer' substituted with
- `irchat-Command-client-x-face-from-xbm-file'.
-
- * irchat-compat.el (replace-in-string): New function from XEmacs
- subr.el.
-
- * irchat-x-face.el: New file.
- (irchat-x-face-insert): Now works properly with GNU Emacs.
-
- * irchat-xemacs.el (irchat-x-face-insert): New function.
- (irchat-x-face-encode): Ditto.
-
- * irchat-ctcp.el (irchat-ctcp-x-face-msg): X-Face query support.
- Now it works only with X-Face utility.
-
- * irchat-version.el (liece-client-version-beta): New variable.
-
-1998-10-01 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat.el (irchat-clear-system): Restart now reworked.
-
- * irchat-make.el (config-irchat): Add check wheter APEL version is
- 9.0 or later.
-
- * irchat-ctcp.el (irchat-ctcp-version-msg): Rewritten with new
- style version string.
-
- * irchat-version.el (irchat-version-user-agent-style): New
- variable.
- (irchat-make-user-agent-string): New function.
- (irchat-make-client-version-string): Ditto.
- (irchat-make-version-string): Ditto.
-
- * irchat-make.el (config-irchat): Rewritten.
-
- * irchat-ctcp.el: Renamed from irchat-cta.el.
- (irchat-ccl-quote-cs): New coding system for file transfer.
- (irchat-ccl-quote-encode): New CCL program.
- (irchat-ccl-quote-decode): Ditto.
- (irchat-ctcp-msg): Hook checking code eliminated.
- (irchat-ctcp-client-msg): Ditto.
-\f
-1998-09-30 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-hilight.el (irchat-highlight-buffer):
- Add check whether there is point has
-
- * irchat-compat (irchat-get-text-property):
- Add signal handler for XEmacs extents.
-
- * irchat-commands.el: Require `irchat-dcc.el'.
-
- * Makefile: New rule for .texinfo to .info.
-
- * irchat-hilight.el (irchat-highlight-buffer): Bug fix for
- `irchat-highlight-pattern'.
-
-1998-09-29 Daiki Ueno <daiki@kiss.kake.info.waseda.ac.jp>
-
- * irchat-make.el (install-irchat): Fixed usage of function
- install-files.
-
- * irchat-nick.el: Do not require widget wid-edit.
-
- * irchat-make.el (irchat-modules-to-compile): Added
- irchat-channel, irchat-nick to module list.
-
- * irchat-hilight.el (irchat-highlight-insert-with-mouse-face):
- Addded check whether function widget-create is bounded.
-
- * irchat-compat.el: Require cl.
-
- * Makefile: Require cl. Machine specific option removed.
-
- * irchat-commands.el (irchat-Command-send-message):
- New signal handler for `encode-coding-string' with unknown coding
- system. This encoding is needed when `irchat-crypt-mode-active-p'
- is non nil.
-
- * irchat.el: Renamed from irchat-main.el.
-
- * irchat-main.el: Removed.
-
-1998-09-29 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-crypt.el (irchat-read-passphrase): New alias.
-
-1998-09-28 Daiki Ueno <daiki@dice.cache.waseda.ac.jp>
-
- * irchat-make.el: New file.
-
- * irchat-compat.el: New file.
-
- * irchat-ja.texinfo: New file.
-
- * setpath.el: Removed.
-
- * irchat-url.el (irchat-url-button-push): New handler.
-
- * irchat-main.el (irchat-Select-map): New keymap.
-
- * irchat-filter.el: Added autoloads for entry points of 000, 200,
- 300, 400, 500 message handlers.
-
- * irchat-misc.el (irchat-greet-author): Abolished.
-
- * irchat-channel.el: Splitted from irchat-commands.el.
-
- * irchat-nick.el: Ditto.
+++ /dev/null
-SUBDIRS = test
-
-EXTRA_DIST = COMPILE ChangeLog ChangeLog.Liece \
- riece-000.el riece-200.el riece-300.el riece-400.el riece-500.el \
- riece-addon-modules.el riece-addon.el riece-cache.el riece-channel.el \
- riece-coding.el riece-commands.el riece-compat.el riece-complete.el \
- riece-debug.el riece-display.el riece-emacs.el riece-filter.el \
- riece-globals.el riece-handle.el riece-highlight.el riece-identity.el \
- riece-mcat.el riece-message.el riece-misc.el riece-mode.el \
- riece-naming.el riece-options.el riece-ruby.el riece-server.el \
- riece-signal.el riece-user.el riece-version.el riece-xemacs.el \
- riece-irc.el riece.el \
- riece-mcat-japanese.el \
- riece-ctcp.el riece-url.el riece-unread.el riece-ndcc.el \
- riece-rdcc.el riece-log.el riece-mini.el riece-doctor.el \
- riece-alias.el riece-layout.el riece-skk-kakutei.el riece-guess.el \
- riece-history.el riece-button.el riece-keyword.el riece-menu.el \
- riece-icon.el riece-async.el riece-lsdb.el riece-xface.el \
- riece-ctlseq.el riece-ignore.el riece-hangman.el riece-biff.el \
- riece-kakasi.el riece-foolproof.el riece-yank.el riece-toolbar.el \
- riece-eval.el riece-google.el riece-keepalive.el riece-eval-ruby.el \
- riece-shrink-buffer.el riece-xfaceb.el riece-epg.el url-riece.el \
- riece-command-previous-channel.xpm riece-command-next-channel.xpm \
- riece-submit-bug-report.xpm \
- server.rb aproxy.rb
-
-CLEANFILES = auto-autoloads.el custom-load.el *.elc
-DISTCLEANFILES = riece-package-info.el
-FLAGS ?= -batch -q -no-site-file
-
-all: elc
-
-elc:
- $(EMACS) $(FLAGS) -l COMPILE -f riece-compile
-
-install: elc
- $(EMACS) $(FLAGS) -l COMPILE -f riece-install $(lispdir) # $(MAKE)
-
-package:
- $(XEMACS) $(FLAGS) -l COMPILE -f riece-compile-package
-
-install-package: package
- $(XEMACS) $(FLAGS) -l COMPILE -f riece-install-package \
- $(PACKAGEDIR) # $(MAKE)
-
-check-local:
- $(EMACS) $(FLAGS) -l COMPILE -f riece-test lunit-report.xml
-
-compile-individually:
- @for i in `$(EMACS) $(FLAGS) -l COMPILE -f riece-examine`; do \
- echo $(EMACS) $(FLAGS) -l COMPILE \
- -f riece-compile-module $$i; \
- $(EMACS) $(FLAGS) -l COMPILE \
- -f riece-compile-module $$i; \
- done
-
-update-mcat:
- $(EMACS) $(FLAGS) -l COMPILE -f riece-update-mcat
+++ /dev/null
-# aproxy.rb --- async proxy between an IRC server and a client
-# Copyright (C) 1998-2005 Daiki Ueno
-
-# Author: Daiki Ueno <ueno@unixuser.org>
-# Created: 1998-09-28
-# Keywords: IRC, riece
-
-# This file is part of Riece.
-
-# This program 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.
-
-# This program 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., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301, USA.
-
-require 'io/nonblock'
-require 'socket'
-
-class AProxy
- def initialize(host, port, size, back)
- @host = host
- @port = port
- @size = size
- @back = File.new(back, 'a') if back
- end
-
- def start
- $stdout.nonblock = true
- trap('STOP', 'IGNORE')
- trap('TSTP', 'IGNORE')
- socket = TCPSocket.new(@host, @port)
- $stdout.write("NOTICE CONNECTED #{$$}\r\n")
- wfds_in = []
- buf = ''
- loop do
- rfds, wfds, = select([socket, $stdin], wfds_in)
- unless wfds.empty?
- if buf.length > @size
- s = buf.slice!(0 ... @size)
- @back.write(s) if @back
- end
- begin
- until buf.empty?
- len = $stdout.syswrite(buf)
- buf.slice!(0 .. len)
- end
- wfds_in.clear
- rescue Errno::EAGAIN
- end
- end
- if rfds.include?(socket)
- line = socket.gets("\r\n")
- break unless line
- if line =~ /\A(?::\S+\s+)?PING\s+(.*)\r\n/i
- socket.write("PONG #{$1}\r\n")
- else
- wfds_in = [$stdout]
- buf << line
- end
- end
- if rfds.include?($stdin)
- line = $stdin.gets("\r\n")
- break unless line
- socket.write(line)
- end
- end
- socket.close
- end
-end
-
-if $0 == __FILE__
- require 'optparse'
-
- opt_size, opt_back = nil, nil
- opts = OptionParser.new do |opts|
- opts.banner = <<"End"
-Usage: #{$0} [OPTIONS] host port
-End
- opts.on('-s', '--size SIZE', 'Size of buffer.') do |size|
- opt_size = size.to_i
- end
- opts.on('-b', '--back BACK', 'Send outdated messages to BACK.') do |back|
- opt_back = back
- end
- opts.on_tail('--help', '-h', 'Show this message.') do
- $stdout.print(opts.to_s)
- exit(0)
- end
- end
- begin
- opts.parse!(ARGV)
- rescue OptionParser::ParseError
- $stderr.print(opts.to_s)
- exit(1)
- end
-
- AProxy.new(ARGV.shift, ARGV.shift, opt_size, opt_back).start
-end
+++ /dev/null
-;;; riece-000.el --- handlers for 000 replies
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-misc)
-(require 'riece-version)
-(require 'riece-commands) ;riece-command-join
-
-(eval-when-compile
- (autoload 'riece-default-handle-numeric-reply "riece-handle"))
-(defun riece-handle-default-000-message (prefix number name string)
- (setq riece-nick-accepted 'ok)
- (riece-default-handle-numeric-reply
- riece-info-prefix prefix number name string))
-
-(defun riece-handle-001-message (prefix number name string)
- "RPL_WELCOME \"Welcome to the Internet Relay Network <nick>!<user>@<host>\""
- (if riece-real-server-name
- (error (riece-mcat "Already registered")))
- (setq riece-real-server-name prefix
- riece-real-nickname name
- riece-real-userhost nil)
- ;; Before sending USERHOST, register myself with riece-obarray
- ;; because it may take some time.
- (riece-get-user name)
- (riece-send-string (format "USERHOST %s\r\n" riece-real-nickname))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat (substring string 1) "\n"))
- (if (equal riece-server-name "")
- (message (riece-mcat "Logging in to IRC server...done"))
- (message (riece-mcat "Logging in to %s...done") riece-server-name))
- (let ((channel-list riece-startup-channel-list)
- entry identity)
- (while channel-list
- (unless (listp (setq entry (car channel-list)))
- (setq entry (list (car channel-list))))
- (if (equal (riece-identity-server
- (setq identity (riece-parse-identity (car entry))))
- riece-server-name)
- (riece-command-join-channel identity (nth 1 entry)))
- (setq channel-list (cdr channel-list))))
- (run-hooks 'riece-after-login-hook))
-
-(defun riece-handle-004-message (prefix number name string)
- "RPL_MYINFO \"<umodes> <chnlmodes>\""
- (if (string-match "^[^ ]+ +[^ ]+ +\\([^ ]+\\) +" string)
- (setq riece-supported-user-modes
- (string-to-list (match-string 1 string))
- riece-supported-channel-modes
- (string-to-list (substring string (match-end 0))))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat string "\n"))))
-
-(provide 'riece-000)
-
-;;; riece-000.el ends here
+++ /dev/null
-;;; riece-200.el --- handlers for 200 replies
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-misc)
-
-(eval-when-compile
- (autoload 'riece-default-handle-numeric-reply "riece-handle"))
-(defun riece-handle-default-200-message (prefix number name string)
- (riece-default-handle-numeric-reply
- riece-info-prefix prefix number name string))
-
-(provide 'riece-200)
-
-;;; riece-200.el ends here
+++ /dev/null
-;;; riece-300.el --- handlers for 300 replies
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-misc)
-(require 'riece-naming)
-(require 'riece-signal)
-(require 'riece-display)
-
-(eval-when-compile
- (autoload 'riece-default-handle-numeric-reply "riece-handle"))
-(defun riece-handle-default-300-message (prefix number name string)
- (riece-default-handle-numeric-reply
- riece-info-prefix prefix number name string))
-
-(defun riece-handle-302-message (prefix number name string)
- "RPL_USERHOST \":*1<reply> *( \" \" <reply> )\""
- (let ((replies (split-string (if (eq (aref string 0) ?:)
- (substring string 1)
- string)
- " ")))
- (while replies
- (if (string-match
- (concat "^\\([^ ]+\\)\\(\\*\\)?=\\([-+]\\)\\([^ ]+\\)")
- (car replies))
- (let ((user (match-string 1 (car replies)))
- (operator (not (null (match-beginning 2))))
- (away (eq (match-string 3 (car replies)) ?-))
- (user-at-host (match-string 4 (car replies)))
- status)
- (if away
- (setq status (cons "away" status)))
- (if operator
- (setq status (cons "operator" status)))
- (riece-user-toggle-away user away)
- (riece-emit-signal 'user-away-changed
- (riece-make-identity user riece-server-name)
- away)
- (riece-user-toggle-operator user operator)
- (riece-emit-signal 'user-operator-changed
- (riece-make-identity user riece-server-name)
- operator)
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-user-status
- status
- (format (riece-mcat "%s is (%s)")
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- (riece-strip-user-at-host user-at-host))))
- "\n"))))
- (setq replies (cdr replies)))))
-
-(defun riece-handle-303-message (prefix number name string)
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (concat (riece-mcat "Online: ")
- (mapconcat
- (lambda (user)
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t))
- (split-string (if (eq (aref string 0) ?:)
- (substring string 1)
- string)
- " ")
- "")))
- "\n")))
-
-(defun riece-handle-301-message (prefix number name string)
- (if (string-match (concat "^\\([^ ]+\\) :?") string)
- (let ((user (match-string 1 string))
- (message (substring string (match-end 0))))
- (riece-user-toggle-away user t)
- (riece-emit-signal 'user-away-changed
- (riece-make-identity user riece-server-name)
- t)
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s is away: %s")
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- message))
- "\n")))))
-
-(defun riece-handle-305-message (prefix number name string)
- (riece-user-toggle-away riece-real-nickname nil)
- (riece-emit-signal 'user-away-changed
- (riece-make-identity riece-real-nickname
- riece-server-name)
- nil))
-
-(defun riece-handle-306-message (prefix number name string)
- (riece-user-toggle-away riece-real-nickname t)
- (riece-emit-signal 'user-away-changed
- (riece-make-identity riece-real-nickname
- riece-server-name)
- t))
-
-(defun riece-handle-311-message (prefix number name string)
- (if (string-match
- (concat "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\* :?")
- string)
- (let ((user (match-string 1 string))
- (name (substring string (match-end 0)))
- (user-at-host (concat (match-string 2 string) "@"
- (match-string 3 string))))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s is %s (%s)")
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- name
- user-at-host))
- "\n")))))
-
-(defun riece-handle-312-message (prefix number name string)
- (if (string-match
- (concat "^\\([^ ]+\\) \\([^ ]+\\) :?")
- string)
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "on via server %s: %s")
- (match-string 2 string)
- (substring string (match-end 0))))
- "\n"))))
-
-(defun riece-handle-313-message (prefix number name string)
- (if (string-match "^[^ ]+" string)
- (let ((user (match-string 0 string)))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format "%s is an IRC operator"
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)))
- "\n")))))
-
-(defun riece-handle-317-message (prefix number name string)
- (if (string-match
- (concat "^\\([^ ]+\\) \\([0-9]+\\) ")
- string)
- (let* ((user (match-string 1 string))
- (seconds (string-to-number (match-string 2 string)))
- (units (list (cons (/ seconds 60 60 24) (riece-mcat "days"))
- (cons (mod (/ seconds 60 60) 24)
- (riece-mcat "hours"))
- (cons (mod (/ seconds 60) 60) (riece-mcat "minutes"))
- (cons (mod seconds 60) (riece-mcat "seconds")))))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s is %s idle")
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- (mapconcat #'identity
- (delq nil
- (mapcar
- (lambda (unit)
- (if (/= (car unit) 0)
- (format "%d %s"
- (car unit) (cdr unit))))
- units))
- " ")))
- "\n")))))
-
-(defun riece-handle-319-message (prefix number name string)
- (if (string-match (concat "^\\([^ ]+\\) :?") string)
- (let ((user (match-string 1 string))
- (channels
- (mapconcat
- (lambda (channel)
- (if (string-match
- (concat "^\\([@+]?\\)\\(" riece-channel-regexp "\\)")
- channel)
- (concat
- (match-string 1 channel)
- (riece-format-identity
- (riece-make-identity (match-string 2 channel)
- riece-server-name)
- t))))
- (split-string (substring string (match-end 0)) " ")
- " ")))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format "%s: %s"
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- channels))
- "\n")))))
-
-(defun riece-handle-351-message (prefix number name string)
- (if (string-match "\\([^ ]+\\.[^ ]+\\) \\([^ ]+\\) :?" string)
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s is running on %s: %s")
- (match-string 1 string)
- (match-string 2 string)
- (substring string (match-end 0))))
- "\n"))))
-
-(defvar riece-353-message-alist nil)
-(defun riece-handle-353-message (prefix number name string)
- "RPL_NAMREPLY \"[=\*@] <channel> :[[@|+]<nick> [[@|+]<nick> [...]]]\"."
- (make-local-variable 'riece-353-message-alist)
- (if (string-match "^[=\*@] *\\([^ ]+\\) +:?" string)
- (let* ((channel (match-string 1 string))
- (entry (riece-identity-assoc channel riece-353-message-alist t)))
- (if entry
- (setcdr entry
- (concat (cdr entry)
- (substring string (match-end 0)) " "))
- (setq riece-353-message-alist
- (cons (cons channel
- (concat (substring string (match-end 0)) " "))
- riece-353-message-alist))))))
-
-(defun riece-handle-322-message (prefix number name decoded)
- (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
- (channel (car parameters))
- (visible (nth 1 parameters))
- (channel-identity (riece-make-identity channel riece-server-name))
- (buffer (riece-channel-buffer channel-identity))
- topic)
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity decoded
- channel-identity))
- topic (nth 2 parameters))
- (riece-channel-set-topic (riece-get-channel channel) topic)
- (riece-insert-info buffer (format (riece-mcat "%s users, topic: %s\n")
- visible topic))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s: %s users, topic: %s")
- (riece-format-identity channel-identity t) visible topic))
- "\n"))))
-
-(defun riece-handle-324-message (prefix number name string)
- (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) " string)
- (let* ((channel (match-string 1 string))
- (mode-string (match-string 2 string)))
- (riece-naming-assert-channel-modes channel
- (riece-parse-modes mode-string))
- (let* ((channel-identity (riece-make-identity channel
- riece-server-name))
- (buffer (riece-channel-buffer channel-identity)))
- (riece-insert-info buffer (concat (riece-mcat "Mode: ") mode-string
- "\n"))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "Mode for %s: %s")
- (riece-format-identity channel-identity t)
- mode-string))
- "\n"))))))
-
-(defun riece-handle-set-topic (prefix number name decoded remove)
- (let* ((parameters (riece-split-parameters (riece-decoded-string decoded)))
- (channel (car parameters))
- topic
- (channel-identity (riece-make-identity channel riece-server-name))
- (buffer (riece-channel-buffer channel-identity)))
- (if remove
- (riece-channel-set-topic (riece-get-channel channel) nil)
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity decoded
- channel-identity))
- topic (nth 1 parameters))
- (riece-channel-set-topic (riece-get-channel channel) topic)
- (riece-insert-info buffer (concat (riece-mcat "Topic: ") topic "\n"))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "Topic for %s: %s")
- (riece-format-identity channel-identity t)
- topic))
- "\n")))
- (riece-emit-signal 'channel-topic-changed channel-identity topic)))
-
-(defun riece-handle-331-message (prefix number name string)
- (riece-handle-set-topic prefix number name string t))
-
-(defun riece-handle-332-message (prefix number name string)
- (riece-handle-set-topic prefix number name string nil))
-
-(defun riece-handle-341-message (prefix number name string)
- (if (string-match "^\\([^ ]+\\) " string)
- (let* ((channel (substring string (match-end 0)))
- (user (match-string 1 string))
- (channel-identity (riece-make-identity channel riece-server-name))
- (buffer (riece-channel-buffer channel-identity)))
- (riece-insert-info buffer (format (riece-mcat "Inviting %s\n") user))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "Inviting %s to %s") user
- (riece-format-identity channel-identity t)))
- "\n")))))
-
-(defun riece-handle-352-message (prefix number name string)
- (if (string-match "^\\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([HG]\\)\\(\\*\\)?\\([@+]\\)? :\\([0-9]+\\) " string)
- (let* ((channel (match-string 1 string))
- (user (match-string 2 string))
- (host (match-string 3 string))
- (server (match-string 4 string))
- (nick (match-string 5 string))
- (away (equal (match-string 6 string) "G"))
- (operator (not (null (match-beginning 7))))
- (flag (match-string 8 string))
- (hops (match-string 9 string))
- (name (substring string (match-end 0)))
- (buffer (riece-channel-buffer (riece-make-identity
- channel riece-server-name)))
- (info (format "%10s = %s (%s)"
- (concat
- (if (memq flag '(?@ ?+))
- (char-to-string flag)
- " ")
- (riece-format-identity
- (riece-make-identity nick riece-server-name)
- t))
- name
- (riece-strip-user-at-host
- (concat user "@" host))))
- status)
- (if operator
- (setq status (cons "operator" status)))
- (if away
- (setq status (cons "away" status)))
- (unless (equal hops "0")
- (setq status (cons (concat "on " server)
- (cons (concat hops " hops")
- status))))
- (if status
- (setq status (nreverse status)))
- (riece-naming-assert-join nick channel)
- (riece-user-toggle-away user away)
- (riece-emit-signal 'user-away-changed
- (riece-make-identity user riece-server-name)
- away)
- (riece-user-toggle-operator user operator)
- (riece-emit-signal 'user-operator-changed
- (riece-make-identity user riece-server-name)
- operator)
- (riece-insert-info buffer (concat (riece-concat-user-status
- status info)
- "\n"))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-user-status
- status
- (concat
- (riece-format-identity
- (riece-make-identity channel riece-server-name)
- t)
- " "
- info)))
- "\n")))))
-
-(defun riece-handle-315-message (prefix number name string))
-(defun riece-handle-318-message (prefix number name string))
-(defun riece-handle-323-message (prefix number name string))
-
-(defun riece-handle-366-message (prefix number name string)
- "RPL_ENDOFNAMES \"<channel> :End of NAMES list\""
- (if (string-match "^\\([^ ]+\\) " string)
- (let* ((channel (match-string 1 string))
- (channel-identity (riece-make-identity channel
- riece-server-name))
- (buffer (riece-channel-buffer channel-identity))
- (entry (riece-identity-assoc channel riece-353-message-alist t))
- (string (cdr entry))
- (start 0)
- users)
- (if entry
- (setq riece-353-message-alist
- (delq entry riece-353-message-alist)))
- (while (string-match
- (concat "\\([@+]\\)?\\([^ ]+\\) +")
- string start)
- (put-text-property (match-beginning 2) (match-end 2)
- 'riece-identity
- (riece-make-identity (match-string 2 string)
- riece-server-name)
- string)
- (setq start (match-end 0)
- users (cons (if (match-beginning 1)
- (if (eq (aref string (match-beginning 1)) ?@)
- (list (match-string 2 string) ?o)
- (if (eq (aref string (match-beginning 1)) ?+)
- (list (match-string 2 string) ?v)))
- (list (match-string 2 string)))
- users)))
- (setq users (nreverse users))
- (riece-naming-assert-channel-users users channel)
- (riece-insert-info
- buffer
- (concat (format (riece-mcat "%d users: ") (length users)) string
- "\n"))
- (riece-insert-info
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (concat (format (riece-mcat "%d users on %s: ")
- (length users)
- (riece-format-identity channel-identity t))
- string))
- "\n")))))
-
-(provide 'riece-300)
-
-;;; riece-300.el ends here
+++ /dev/null
-;;; riece-400.el --- handlers for 400 replies
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-misc)
-(require 'riece-mcat)
-
-(eval-when-compile
- (autoload 'riece-default-handle-numeric-reply "riece-handle"))
-(defun riece-handle-default-400-message (prefix number name string)
- (riece-default-handle-numeric-reply
- riece-error-prefix prefix number name string))
-
-(defun riece-handle-read-string (prompt)
- (condition-case nil
- (let (inhibit-quit)
- (read-string prompt))
- (quit
- (ignore (message "%s" (concat prompt "Quit"))))))
-
-(defun riece-handle-432-message (prefix number name string)
- "ERR_ERRONEUSNICKNAME \"<nick> :Erroneous nickname\"."
- (let ((nickname
- (riece-handle-read-string
- (format (riece-mcat "Erroneous nickname \"%s\". Choose a new one: ")
- (car (riece-split-parameters string))))))
- (if nickname
- (riece-send-string (format "NICK %s\r\n" nickname)))))
-
-(defun riece-handle-433-message (prefix number name string)
- "ERR_NICKNAMEINUSE \"<nick> :Nickname is already in use\"."
- (let ((nickname
- (riece-handle-read-string
- (format (riece-mcat "Nickname \"%s\" already in use. Choose a new one: ")
- (car (riece-split-parameters string))))))
- (if nickname
- (riece-send-string (format "NICK %s\r\n" nickname)))))
-
-(defun riece-handle-464-message (prefix number name string)
- "ERR_PASSWDMISMATCH \":Password incorrect\"."
- (message (riece-mcat "Password incorrect from %s.") prefix)
- (setq riece-reconnect-with-password t))
-
-(defun riece-handle-475-message (prefix number name string)
- "ERR_BADCHANNELKEY \"<channel> :Cannot join channel (+k)\"."
- (let* ((parameters (riece-split-parameters string))
- (channel-identity (riece-make-identity (car parameters)
- riece-server-name))
- key)
- (setq key
- (condition-case nil
- (let (inhibit-quit)
- (riece-read-passwd
- (format (riece-mcat "Key for %s: ")
- (riece-format-identity channel-identity t))))
- (quit
- (message (riece-mcat "Key for %s: Quit")
- (riece-format-identity channel-identity t))
- 'quit)))
- (unless (eq key 'quit)
- (riece-command-join-channel channel-identity key))))
-
-(provide 'riece-400)
-
-;;; riece-400.el ends here
+++ /dev/null
-;;; riece-500.el --- handlers for 500 replies
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-misc)
-
-(eval-when-compile
- (autoload 'riece-default-handle-numeric-reply "riece-handle"))
-(defun riece-handle-default-500-message (prefix number name string)
- (riece-default-handle-numeric-reply
- riece-error-prefix prefix number name string))
-
-(provide 'riece-500)
-
-;;; riece-500.el ends here
+++ /dev/null
-(defconst riece-addon-modules
- '((riece-alias . "Define aliases for IRC names.")
- (riece-async . "Connect to IRC server via async proxy.")
- (riece-biff . "Be notified if messages arrives.")
- (riece-button . "Display useful buttons in IRC buffers.")
- (riece-ctcp . "CTCP (Client To Client Protocol) support.")
- (riece-ctlseq . "Mark up control sequences in IRC buffers.")
- (riece-doctor . "Pretend to be a psychotherapist.")
- (riece-epg . "Encrypt/decrypt messages.")
- (riece-eval-ruby . "Evaluate input string as a Ruby program.")
- (riece-eval . "Evaluate an input string as an elisp form.")
- (riece-foolproof . "Prevent miss-operation in the command buffer.")
- (riece-google . "Search keywords by Google.")
- (riece-guess . "Guess the next channel, using multiple methods.")
- (riece-hangman . "Allow channel members to play the hangman game.")
- (riece-highlight . "Highlight IRC buffers.")
- (riece-history . "Manage history of channel shifting.")
- (riece-icon . "Display icons in IRC buffers.")
- (riece-ignore . "Ignore messages from some users.")
- (riece-kakasi . "Convert Japanese to roman string by KAKASI.")
- (riece-keepalive . "Keep an IRC connection.")
- (riece-keyword . "Detect keywords in IRC buffers.")
- (riece-log . "Save IRC logs.")
- (riece-lsdb . "Help register nicknames in LSDB rolodex program.")
- (riece-mcat . "Translate messages.")
- (riece-menu . "Setup Riece's command menus.")
- (riece-mini . "Use Riece only on the minibuffer.")
- ;;(riece-ndcc . "DCC file sending protocol support (written in elisp.)")
- (riece-rdcc . "DCC file sending protocol support (written in Ruby.)")
- (riece-shrink-buffer . "Free old IRC messages to save memory usage.")
- (riece-skk-kakutei . "Remove SKK's preedit mark before sending messages.")
- (riece-toolbar . "Display toolbar icons.")
- (riece-unread . "Mark channels where new messages arrived.")
- (riece-url . "Collect URL in IRC buffers.")
- (riece-xface . "Display X-Face in IRC buffers.")
- (riece-xfaceb . "Display X-Face & Colour Face images in IRC buffers \(BBDB\).")
- (riece-yank . "Enter the element of kill-ring.")))
-
-(provide 'riece-addon-modules)
\ No newline at end of file
+++ /dev/null
-;;; riece-addon.el --- add-on management
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'font-lock)
-(require 'riece-options)
-(require 'riece-compat)
-(require 'riece-misc)
-(require 'riece-addon-modules)
-(require 'riece-mcat)
-
-(defgroup riece-addon-list nil
- "Add-on listing."
- :tag "Addon list"
- :prefix "riece-addon-list-"
- :group 'riece)
-
-(defgroup riece-addon-list-faces nil
- "Faces for riece-addon-list-mode."
- :tag "Faces"
- :prefix "riece-addon-list-"
- :group 'riece-addon-list)
-
-(defface riece-addon-list-enabled-face
- '((((class color) (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (t
- (:bold t)))
- "Face used for displaying the enabled addon."
- :group 'riece-addon-list-faces)
-(defvar riece-addon-list-enabled-face 'riece-addon-list-enabled-face)
-
-(defface riece-addon-list-disabled-face
- '((((class color) (background dark))
- (:foreground "PaleTurquoise" :italic t))
- (t
- ()))
- "Face used for displaying the disabled addon."
- :group 'riece-addon-list-faces)
-(defvar riece-addon-list-disabled-face 'riece-addon-list-disabled-face)
-
-(defface riece-addon-list-uninstalled-face
- '((t
- (:italic t)))
- "Face used for displaying the uninstalled addon."
- :group 'riece-addon-list-faces)
-(defvar riece-addon-list-uninstalled-face 'riece-addon-list-uninstalled-face)
-
-(defface riece-addon-list-unloaded-face
- '((t
- (:italic t :inverse-video t)))
- "Face used for displaying the unloaded addon."
- :group 'riece-addon-list-faces)
-(defvar riece-addon-list-unloaded-face 'riece-addon-list-unloaded-face)
-
-(defface riece-addon-list-description-face
- '((((class color)
- (background dark))
- (:foreground "lightyellow"))
- (((class color)
- (background light))
- (:foreground "blue4"))
- (t
- ()))
- "Face used for displaying the description addon."
- :group 'riece-addon-list-faces)
-(defvar riece-addon-list-description-face 'riece-addon-list-description-face)
-
-(defcustom riece-addon-list-mark-face-alist
- '((?+ . riece-addon-list-enabled-face)
- (?- . riece-addon-list-disabled-face)
- (?? . riece-addon-list-uninstalled-face)
- (? . riece-addon-list-unloaded-face))
- "An alist mapping marks on riece-addon-list-buffer to faces."
- :type 'list
- :group 'riece-addon-list)
-
-(defcustom riece-addon-list-font-lock-keywords
- '(("^\\([-+? ] \\S-+\\)\\s-+\\(.*\\)"
- (1 (cdr (assq (aref (match-string 1) 0)
- riece-addon-list-mark-face-alist)))
- (2 riece-addon-list-description-face)))
- "Default expressions to addon in riece-addon-list-mode."
- :type '(repeat (list string))
- :group 'riece-addon-list)
-
-(eval-when-compile
- (autoload 'riece-command-save-variables "riece-commands"))
-
-(defvar riece-addon-list-mode-map
- (let ((keymap (make-sparse-keymap)))
- (define-key keymap "+" 'riece-command-enable-addon)
- (define-key keymap "-" 'riece-command-disable-addon)
- (define-key keymap "i" 'riece-command-insinuate-addon)
- (define-key keymap "u" 'riece-command-uninstall-addon)
- (define-key keymap "U" 'riece-command-unload-addon)
- (define-key keymap "n" 'next-line)
- (define-key keymap "p" 'previous-line)
- (define-key keymap " " 'scroll-up)
- (define-key keymap [delete] 'scroll-down)
- (define-key keymap "q" 'bury-buffer)
- (define-key keymap "s" 'riece-command-save-variables)
- keymap))
-
-(defun riece-load-and-build-addon-dependencies (addons)
- (let ((load-path (cons riece-addon-directory load-path))
- dependencies)
- (while addons
- (require (car addons)) ;error will be reported here
- (let* ((requires-function
- (intern-soft
- (concat (symbol-name (car addons)) "-requires")))
- (requires
- (if (and requires-function
- (fboundp requires-function))
- (funcall requires-function)))
- (pointer requires)
- entry)
- ;; Increment succs' pred count.
- (if (setq entry (assq (car addons) dependencies))
- (setcar (cdr entry) (+ (length requires) (nth 1 entry)))
- (setq dependencies (cons (list (car addons) (length requires))
- dependencies)))
- ;; Merge pred's succs.
- (while pointer
- (if (setq entry (assq (car pointer) dependencies))
- (setcdr (cdr entry) (cons (car addons) (nthcdr 2 entry)))
- (setq dependencies (cons (list (car pointer) 0 (car addons))
- dependencies)))
- (setq pointer (cdr pointer))))
- (setq addons (cdr addons)))
- dependencies))
-
-(defun riece-sort-addon-dependencies (dependencies)
- (let ((pointer dependencies)
- addons queue)
- (while pointer
- (if (zerop (nth 1 (car pointer)))
- (setq dependencies (delq (car pointer) dependencies)
- queue (cons (car pointer) queue)))
- (setq pointer (cdr pointer)))
- (while queue
- (setq addons (cons (cons (car (car queue)) (nthcdr 2 (car queue)))
- addons)
- pointer (nthcdr 2 (car queue)))
- (while pointer
- (let* ((entry (assq (car pointer) dependencies))
- (count (1- (nth 1 entry))))
- (if (zerop count)
- (setq dependencies (delq entry dependencies)
- queue (nconc queue (list entry)))
- (setcar (cdr entry) count)))
- (setq pointer (cdr pointer)))
- (setq queue (cdr queue)))
- (if dependencies
- (error "Circular add-on dependency found: %S" dependencies))
- (nreverse addons)))
-
-(defun riece-resolve-addons (addons)
- ;; Add files in riece-addon-directory to addons.
- (if (file-directory-p riece-addon-directory)
- (setq addons (nconc
- addons
- (mapcar
- (lambda (name)
- (unless (file-directory-p
- (expand-file-name name riece-addon-directory))
- (intern (file-name-sans-extension name))))
- (directory-files riece-addon-directory nil "\\`[^.]")))))
- ;; Sort & uniquify.
- (setq addons (sort addons (lambda (symbol1 symbol2)
- (string-lessp (symbol-name symbol1)
- (symbol-name symbol2)))))
- (let ((pointer addons))
- (while pointer
- (if (memq (car pointer) (cdr pointer))
- (setcar pointer nil))
- (setq pointer (cdr pointer)))
- (delq nil addons))
- ;; Build & resolve dependencies.
- (riece-sort-addon-dependencies
- (riece-load-and-build-addon-dependencies addons)))
-
-(defun riece-insinuate-addon-1 (addon verbose)
- (if (get addon 'riece-addon-insinuated)
- (if verbose
- (message (riece-mcat "Add-on %S is already insinuated") addon))
- (require addon)
- (funcall (intern (concat (symbol-name addon) "-insinuate")))
- (put addon 'riece-addon-insinuated t)
- (if verbose
- (message (riece-mcat "Add-on %S is insinuated") addon))
- (unless (get addon 'riece-addon-default-disabled)
- (riece-enable-addon addon t))))
-
-(defun riece-insinuate-addon (addon &optional verbose)
- (unless (assq addon riece-addon-dependencies)
- (setq riece-addons (cons addon riece-addons)
- riece-save-variables-are-dirty t
- riece-addon-dependencies
- (riece-resolve-addons
- (cons addon (mapcar #'car riece-addon-dependencies)))))
- (let ((pointer riece-addon-dependencies)
- addons)
- (while pointer
- (unless (get (car (car pointer)) 'riece-addon-insinuated)
- (setq addons (cons (car (car pointer)) addons)))
- (if (eq (car (car pointer)) addon)
- (setq pointer nil)
- (setq pointer (cdr pointer))))
- (setq addons (nreverse addons))
- (if (and (> (length addons) 1)
- (eq verbose 'ask)
- (not (y-or-n-p (format (riece-mcat
- "%s will be insinuated. Continue? ")
- (mapconcat #'symbol-name addons ", ")))))
- (error "Insinuate operation was cancelled"))
- (while addons
- (riece-insinuate-addon-1 (car addons) verbose)
- (setq addons (cdr addons)))))
-
-(defun riece-uninstall-addon (addon &optional verbose)
- (if (not (get addon 'riece-addon-insinuated))
- (if verbose
- (message (riece-mcat "Add-on %S is not insinuated") addon))
- (let ((entry (assq addon riece-addon-dependencies))
- (uninstall (intern-soft (concat (symbol-name addon) "-uninstall"))))
- (if entry
- (if (cdr entry)
- (if (= (length (cdr entry)) 1)
- (error "%S depends on %S" (car (cdr entry)) addon)
- (error "%s depend on %S"
- (mapconcat #'symbol-name (cdr entry) ", ")
- addon))
- (riece-disable-addon addon verbose)
- (if (and uninstall
- (fboundp uninstall))
- (funcall uninstall))
- (setq riece-addon-dependencies
- (delq entry riece-addon-dependencies))
- (put addon 'riece-addon-insinuated nil)
- (setq riece-addons (delq addon riece-addons)
- riece-save-variables-are-dirty t
- riece-addon-dependencies
- (riece-resolve-addons
- (delq addon (mapcar #'car riece-addon-dependencies))))))
- (if verbose
- (message (riece-mcat "Add-on %S is uninstalled") addon)))))
-
-(defun riece-enable-addon (addon &optional verbose)
- (unless (get addon 'riece-addon-insinuated)
- (error "Add-on %S is not insinuated" addon))
- (if (get addon 'riece-addon-enabled)
- (if verbose
- (message (riece-mcat "Add-on %S is already enabled") addon))
- (let ((enable (intern-soft (concat (symbol-name addon) "-enable"))))
- (if (and enable
- (fboundp enable))
- (funcall enable))
- (put addon 'riece-addon-enabled t)
- (if verbose
- (message (riece-mcat "Add-on %S enabled") addon)))))
-
-(defun riece-disable-addon (addon &optional verbose)
- (unless (get addon 'riece-addon-insinuated)
- (error "Add-on %S is not insinuated" addon))
- (if (not (get addon 'riece-addon-enabled))
- (if verbose
- (message (riece-mcat "Add-on %S is already disabled") addon))
- (let ((disable (intern-soft (concat (symbol-name addon) "-disable"))))
- (if (and disable
- (fboundp disable))
- (funcall disable))
- (put addon 'riece-addon-enabled nil)
- (if verbose
- (message (riece-mcat "Add-on %S disabled") addon)))))
-
-(put 'riece-addon-list-mode 'font-lock-defaults
- '(riece-addon-list-font-lock-keywords t))
-
-(defun riece-addon-list-mode ()
- "Major mode for displaying addon list.
-All normal editing commands are turned off."
- (kill-all-local-variables)
- (buffer-disable-undo)
- (setq major-mode 'riece-addon-list-mode
- mode-name "AddOns"
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification '("Riece: %12b"))
- truncate-lines t
- buffer-read-only t)
- (use-local-map riece-addon-list-mode-map)
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(riece-addon-list-font-lock-keywords t))
- ;; In XEmacs, auto-initialization of font-lock is not effective
- ;; if buffer-file-name is not set.
- (font-lock-set-defaults)
- (run-hooks 'riece-addon-list-mode-hook))
-
-(defun riece-command-list-addons ()
- (interactive)
- (set-buffer (riece-get-buffer-create "*AddOn*" 'riece-addon-list-mode))
- (riece-addon-list-mode)
- (let ((inhibit-read-only t)
- buffer-read-only
- (pointer riece-addon-dependencies)
- module-description-alist
- description point longest)
- (while pointer
- (setq description (intern-soft (concat (symbol-name (car (car pointer)))
- "-description"))
- module-description-alist
- (cons (cons (car (car pointer))
- (if (and description
- (boundp description))
- (symbol-value description)
- (riece-mcat "(no description)")))
- module-description-alist)
- pointer (cdr pointer)))
- (setq pointer riece-addon-modules)
- (while pointer
- (unless (assq (car (car pointer))
- module-description-alist)
- (setq module-description-alist
- (cons (car pointer) module-description-alist)))
- (setq pointer (cdr pointer)))
- (erase-buffer)
- (riece-kill-all-overlays)
- (setq pointer module-description-alist
- longest "")
- (while pointer
- (if (> (length (symbol-name (car (car pointer))))
- (length longest))
- (setq longest (symbol-name (car (car pointer)))))
- (setq pointer (cdr pointer)))
- (setq pointer (sort module-description-alist
- (lambda (entry1 entry2)
- (string-lessp (symbol-name (car entry1))
- (symbol-name (car entry2))))))
- (while pointer
- (setq point (point))
- (insert (format (format "%%c %%-%dS %%s\n" (length longest))
- (if (not (featurep (car (car pointer))))
- ?
- (if (not (get (car (car pointer))
- 'riece-addon-insinuated))
- ??
- (if (get (car (car pointer)) 'riece-addon-enabled)
- ?+
- ?-)))
- (car (car pointer))
- (cdr (car pointer))))
- (put-text-property point (point) 'riece-addon (car (car pointer)))
- (setq pointer (cdr pointer)))
- (insert (riece-mcat "
-Symbols in the leftmost column:
-
- + The add-on is enabled.
- - The add-on is disabled.
- ? The add-on is not insinuated.
- The add-on is not loaded.
-"))
- (insert (substitute-command-keys (riece-mcat "
-Useful keys:
-
- `\\[riece-command-enable-addon]' to enable the current add-on.
- `\\[riece-command-disable-addon]' to disable the current add-on.
- `\\[riece-command-insinuate-addon]' to insinuate the current add-on.
- `\\[riece-command-uninstall-addon]' to uninstall the current add-on.
- `\\[riece-command-unload-addon]' to unload the current add-on.
- `\\[riece-command-save-variables]' to save the current setting.
-")))
- (goto-char (point-min))
- (pop-to-buffer (current-buffer))
- (delete-other-windows)))
-
-(defun riece-addon-list-set-point (addon)
- (let ((point (point-min)))
- (while (and (not (eq (get-text-property point 'riece-addon) addon))
- (setq point (next-single-property-change point
- 'riece-addon))))
- (if point
- (goto-char point))))
-
-(defun riece-command-enable-addon (addon)
- (interactive
- (list
- (or (if (eq major-mode 'riece-addon-list-mode)
- (get-text-property (point) 'riece-addon))
- (intern-soft
- (completing-read (riece-mcat "Add-on: ")
- (mapcar (lambda (dependency)
- (list (symbol-name (car dependency))))
- riece-addon-dependencies)
- (lambda (pointer)
- (let ((enabled
- (intern-soft (concat (car pointer)
- "-enabled"))))
- (and enabled
- (null (symbol-value enabled)))))
- t)))))
- (riece-command-insinuate-addon addon)
- (riece-enable-addon addon t)
- (when (eq major-mode 'riece-addon-list-mode)
- (riece-command-list-addons)
- (riece-addon-list-set-point addon)))
-
-(defun riece-command-disable-addon (addon)
- (interactive
- (list
- (or (if (eq major-mode 'riece-addon-list-mode)
- (get-text-property (point) 'riece-addon))
- (intern-soft
- (completing-read (riece-mcat "Add-on: ")
- (mapcar (lambda (dependency)
- (list (symbol-name (car dependency))))
- riece-addon-dependencies)
- (lambda (pointer)
- (let ((enabled
- (intern-soft (concat (car pointer)
- "-enabled"))))
- (and enabled
- (symbol-value enabled))))
- t)))))
- (riece-disable-addon addon t)
- (when (eq major-mode 'riece-addon-list-mode)
- (riece-command-list-addons)
- (riece-addon-list-set-point addon)))
-
-(defun riece-command-insinuate-addon (addon)
- (interactive
- (list
- (or (if (eq major-mode 'riece-addon-list-mode)
- (get-text-property (point) 'riece-addon))
- (intern-soft
- (completing-read (riece-mcat "Add-on: ")
- (mapcar (lambda (dependency)
- (list (symbol-name (car dependency))))
- riece-addon-modules)
- (lambda (pointer)
- (not (get (car pointer) 'riece-addon-insinuated)))
- t)))))
- (riece-insinuate-addon addon 'ask)
- (when (eq major-mode 'riece-addon-list-mode)
- (riece-command-list-addons)
- (riece-addon-list-set-point addon)))
-
-(defun riece-command-uninstall-addon (addon)
- (interactive
- (list
- (or (if (eq major-mode 'riece-addon-list-mode)
- (get-text-property (point) 'riece-addon))
- (intern-soft
- (completing-read (riece-mcat "Add-on: ")
- (mapcar (lambda (dependency)
- (list (symbol-name (car dependency))))
- riece-addon-dependencies)
- (lambda (pointer)
- (get (car pointer) 'riece-addon-insinuated))
- t)))))
- (riece-uninstall-addon addon t)
- (when (eq major-mode 'riece-addon-list-mode)
- (riece-command-list-addons)
- (riece-addon-list-set-point addon)))
-
-(defun riece-command-unload-addon (addon)
- (interactive
- (list
- (or (if (eq major-mode 'riece-addon-list-mode)
- (get-text-property (point) 'riece-addon))
- (intern-soft
- (completing-read (riece-mcat "Add-on: ")
- (mapcar (lambda (dependency)
- (list (symbol-name (car dependency))))
- riece-addon-dependencies)
- (lambda (pointer)
- (get (car pointer) 'riece-addon-insinuated))
- t)))))
- (riece-uninstall-addon addon t)
- (if (get addon 'riece-addon-not-unloadable)
- (message (riece-mcat "Add-on %S is not allowed to unload") addon)
- (unload-feature addon)
- (message (riece-mcat "Add-on %S is unloaded") addon))
- (when (eq major-mode 'riece-addon-list-mode)
- (riece-command-list-addons)
- (riece-addon-list-set-point addon)))
-
-(provide 'riece-addon)
-
-;;; riece-addon.el ends here
+++ /dev/null
-;;; riece-alias.el --- define aliases for IRC names
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; This add-on allows you to define aliases for IRC names.
-
-;; For example, if you want to define an alias `#r' for `#riece', you
-;; can customize riece-alias-alist as follows:
-;; (setq riece-alias-alist '(("#riece" . "#r")))
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-signal)
-
-(defgroup riece-alias nil
- "Aliases of channel/user names."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-alias-percent-hack-mask "*.jp"
- "The mask of local IRC network"
- :type 'string
- :group 'riece-alias)
-
-(defcustom riece-alias-enable-percent-hack t
- "If non-nil, the target mask is abbreviated with `%'."
- :type 'boolean
- :group 'riece-alias)
-
-(defcustom riece-alias-alternate-separator "@"
- "A string to separate prefix and server."
- :type '(choice (const nil) string)
- :group 'riece-alias)
-
-(defcustom riece-alias-alist nil
- "An alist mapping aliases to names."
- :type 'list
- :group 'riece-alias)
-
-(defconst riece-alias-description
- "Define aliases for IRC names.")
-
-(defun riece-alias-abbrev-percent-hack (string)
- (if (string-match (concat "^#\\([^ ]+\\):"
- (regexp-quote riece-alias-percent-hack-mask)
- "\\( .+\\|$\\)")
- string)
- (replace-match "%\\1\\2" nil nil string)
- string))
-
-(defun riece-alias-expand-percent-hack (string)
- (if (string-match "^%\\([^ ]+\\)\\( .+\\|$\\)" string)
- (replace-match (concat "#\\1:" riece-alias-percent-hack-mask "\\2")
- nil nil string)
- string))
-
-(defun riece-alias-escape-alternate-separator (string)
- (let ((index 0))
- (while (string-match (regexp-quote riece-alias-alternate-separator)
- string index)
- (setq index (1+ (match-end 0))
- string (replace-match (concat riece-alias-alternate-separator
- riece-alias-alternate-separator)
- nil t string)))
- string))
-
-(defun riece-alias-abbrev-alternate-separator (string)
- (if (string-match " " string)
- (let ((prefix (substring string 0 (match-beginning 0)))
- (server (substring string (match-end 0))))
- (concat (riece-alias-escape-alternate-separator prefix)
- riece-alias-alternate-separator
- (riece-alias-escape-alternate-separator server)))
- (riece-alias-escape-alternate-separator string)))
-
-(defun riece-alias-expand-alternate-separator (string)
- (let ((index 0)
- prefix
- server)
- (while (and (null prefix)
- (string-match
- (concat (regexp-quote riece-alias-alternate-separator)
- (regexp-quote riece-alias-alternate-separator)
- "\\|\\("
- (regexp-quote riece-alias-alternate-separator)
- "\\)")
- string index))
- (if (match-beginning 1) ;found a separator
- (setq prefix (substring string 0 (match-beginning 1))
- index (match-end 1))
- (setq string (replace-match riece-alias-alternate-separator
- nil t string)
- index (- (match-end 0)
- (length riece-alias-alternate-separator)))))
- (if (null prefix)
- string
- (setq server (substring string index)
- index 0)
- (if (equal server "")
- (while (string-match (regexp-quote
- (concat riece-alias-alternate-separator
- riece-alias-alternate-separator))
- server index)
- (setq server (replace-match riece-alias-alternate-separator
- nil t server)
- index (- (match-end 0)
- (length riece-alias-alternate-separator))))
- (concat prefix " " server)))))
-
-(defun riece-alias-abbrev-identity-string (string)
- (if riece-alias-enable-percent-hack
- (setq string (riece-alias-abbrev-percent-hack string)))
- (if riece-alias-alternate-separator
- (setq string (riece-alias-abbrev-alternate-separator string)))
- (let ((alist riece-alias-alist))
- (while alist
- (if (equal (downcase (car (car alist))) (downcase string))
- (setq string (cdr (car alist))
- alist nil)
- (setq alist (cdr alist)))))
- (copy-sequence string))
-
-(defun riece-alias-expand-identity-string (string)
- (let ((alist riece-alias-alist))
- (while alist
- (if (equal (downcase (cdr (car alist))) (downcase string))
- (setq string (car (car alist))
- alist nil)
- (setq alist (cdr alist)))))
- (if riece-alias-alternate-separator
- (setq string (riece-alias-expand-alternate-separator string)))
- (if riece-alias-enable-percent-hack
- (setq string (riece-alias-expand-percent-hack string)))
- (copy-sequence string))
-
-(defun riece-alias-insinuate ()
- )
-
-(defun riece-alias-enable ()
- (setq riece-abbrev-identity-string-function
- #'riece-alias-abbrev-identity-string
- riece-expand-identity-string-function
- #'riece-alias-expand-identity-string)
- (riece-emit-signal 'channel-list-changed))
-
-(defun riece-alias-disable ()
- (setq riece-abbrev-identity-string-function nil
- riece-expand-identity-string-function nil)
- (riece-emit-signal 'channel-list-changed))
-
-(provide 'riece-alias)
-
-;;; riece-alias.el ends here
+++ /dev/null
-;;; riece-async.el --- connect to IRC server via async proxy
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; This program allows to connect to an IRC server via local proxy
-;; which responds to PING requests from server.
-
-;; If you want to enable this feature per server, write the server
-;; spec like this:
-;; (add-to-list 'riece-server-alist
-;; '("async" :host "irc.tokyo.wide.ad.jp"
-;; :function riece-async-open-network-stream))
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-ruby) ;riece-ruby-command
-
-(defgroup riece-async nil
- "Connect to IRC server via async proxy."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-async-buffer-size 65535
- "Maximum size of the write buffer."
- :type 'integer
- :group 'riece-async)
-
-(defcustom riece-async-backup-file (expand-file-name "riece-async.bak"
- riece-directory)
- "A file which contains outdated messages."
- :type 'string
- :group 'riece-async)
-
-(defvar riece-async-server-program "aproxy.rb"
- "The server program file. If the filename is not absolute, it is
-assumed that the file is in the same directory of this file.")
-
-(defvar riece-async-server-program-arguments
- (list "-s" (number-to-string riece-async-buffer-size)
- "-b" riece-async-backup-file)
- "Command line arguments passed to `riece-async-server-program'.")
-
-(defconst riece-async-description
- "Connect to IRC server via async proxy.")
-
-;;;###autoload
-(defun riece-async-open-network-stream (name buffer host service)
- (let* (process-connection-type
- (process
- (apply #'start-process name buffer riece-ruby-command
- (expand-file-name riece-async-server-program
- riece-data-directory)
- riece-async-server-program-arguments)))
- (if buffer
- (save-excursion
- (set-buffer (process-buffer process))
- (while (and (eq (process-status process) 'run)
- (progn
- (goto-char (point-min))
- (not (looking-at (format "NOTICE CONNECTED %d"
- (process-id process))))))
- (accept-process-output process))))
- (process-kill-without-query process)
- process))
-
-(defun riece-async-insinuate ()
- (setq riece-default-open-connection-function
- #'riece-async-open-network-stream))
-
-(provide 'riece-async)
-
-;;; riece-async.el ends here
+++ /dev/null
-;;; riece-biff.el --- be notified if messages arrives
-;; Copyright (C) 2004 OHASHI Akira
-
-;; Author: OHASHI Akira <bg66@koka-in.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-message)
-
-(defgroup riece-biff nil
- "Be notified if messages arrives."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-biff-check-channels nil
- "*If non-nil, riece-biff checks only the channel contained in this list."
- :type '(repeat string)
- :group 'riece-biff)
-
-(defcustom riece-biff-default-mode-string "[-]"
- "*String displayed when there is no arrival message."
- :type 'string
- :group 'riece-biff)
-
-(defcustom riece-biff-biff-mode-string "[R]"
- "*String displayed when there are new arrival messages."
- :type 'string
- :group 'riece-biff)
-
-(defvar riece-biff-mode-string 'riece-biff-default-mode-string)
-
-(defconst riece-biff-description
- "Be notified if messages arrives.")
-
-(defun riece-biff-after-display-message-function (message)
- (when (and (get 'riece-biff 'riece-addon-enabled)
- (not (or (eq (window-buffer (selected-window))
- (get-buffer riece-command-buffer))
- (riece-message-own-p message)
- (riece-message-type message))))
- (when (or (null riece-biff-check-channels)
- (member (riece-format-identity (riece-message-target message))
- riece-biff-check-channels))
- (setq riece-biff-mode-string 'riece-biff-biff-mode-string))))
-
-(defun riece-biff-clear (&optional dummy)
- (when (get 'riece-biff 'riece-addon-enabled)
- (setq riece-biff-mode-string 'riece-biff-default-mode-string)))
-
-(defun riece-biff-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-biff-after-display-message-function)
- (add-hook 'riece-redisplay-buffers-hook 'riece-biff-clear)
- (add-hook 'riece-after-switch-to-channel-functions 'riece-biff-clear)
- (add-hook 'riece-exit-hook 'riece-biff-disable))
-
-(defun riece-biff-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-biff-after-display-message-function)
- (remove-hook 'riece-redisplay-buffers-hook 'riece-biff-clear)
- (remove-hook 'riece-after-switch-to-channel-functions 'riece-biff-clear)
- (remove-hook 'riece-exit-hook 'riece-biff-disable))
-
-(defun riece-biff-enable ()
- (setq global-mode-string
- (cond
- ((nlistp global-mode-string)
- (list "" 'riece-biff-mode-string global-mode-string))
- ((not (memq 'riece-biff-mode-string global-mode-string))
- (append '("" riece-biff-mode-string)
- (remove "" global-mode-string)))
- (t
- global-mode-string))))
-
-(defun riece-biff-disable ()
- (setq global-mode-string
- (cond
- ((and (listp global-mode-string)
- (memq 'riece-biff-mode-string global-mode-string))
- (remq 'riece-biff-mode-string global-mode-string))
- (t
- global-mode-string)))
- (riece-biff-clear))
-
-(provide 'riece-biff)
-
-;;; riece-biff.el ends here
+++ /dev/null
-;;; riece-button.el --- display useful buttons in IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-commands)
-(require 'riece-identity)
-(require 'riece-misc)
-(require 'wid-edit)
-
-(defconst riece-channel-button-popup-menu
- '("Channel"
- ["Switch To Channel" riece-channel-button-switch-to-channel]
- ["Part Channel" riece-channel-button-part]
- ["List Channel" riece-channel-button-list])
- "Menu for channel buttons.")
-
-(defconst riece-user-button-popup-menu
- '("User"
- ["Finger (WHOIS)" riece-user-button-finger]
- ["Start Private Conversation" riece-user-button-join-partner]
- ["Set +o" riece-user-button-set-operators]
- ["Set +v" riece-user-button-set-speakers])
- "Menu for user buttons.")
-
-(defconst riece-button-description
- "Display useful buttons in IRC buffers.")
-
-(defvar help-echo-owns-message)
-(define-widget 'riece-identity-button 'push-button
- "A channel button."
- :action 'riece-button-switch-to-identity
- :help-echo
- (lambda (widget/window &optional overlay pos)
- ;; Needed to properly clear the message due to a bug in
- ;; wid-edit (XEmacs only).
- (if (boundp 'help-echo-owns-message)
- (setq help-echo-owns-message t))
- (format (riece-mcat "%S: switch to %s; down-mouse-3: more options")
- (aref riece-mouse-2 0)
- ;; XEmacs will get a single widget arg; Emacs 21 will get
- ;; window, overlay, position.
- (riece-format-identity
- (if overlay
- (with-current-buffer (riece-overlay-buffer overlay)
- (widget-value (widget-at (riece-overlay-start overlay))))
- (widget-value widget/window))))))
-
-(defun riece-button-switch-to-identity (widget &optional event)
- "Switch to identity stored in WIDGET.
-This function is used as a callback for a channel button."
- (let ((channel (widget-value widget)))
- (if (riece-identity-member channel riece-current-channels)
- (riece-command-switch-to-channel channel)
- (message "%s" (substitute-command-keys
- (riece-mcat
- "Type \\[riece-command-join] to join the channel"))))))
-
-(defun riece-identity-button-click (event)
- "Call widget-button-click and select the last selected window."
- (interactive "e") ;widget-button-click has
- ;interactive spec "@e"
- (let ((buffer (current-buffer))
- (point (point))
- window)
- (unwind-protect
- (save-excursion
- (set-buffer (riece-event-buffer event))
- (goto-char (riece-event-point event))
- (widget-button-click event))
- ;; riece-button-switch-to-identity changes window-configuration
- ;; so we must select the last selected window by _buffer_.
- (if (setq window (get-buffer-window buffer))
- (progn
- (select-window window)
- (set-window-point window point))
- (if riece-debug
- (riece-debug (format "buffer %s not visible"
- (buffer-name buffer))))))))
-
-(defun riece-identity-button-popup-menu (event)
- "Popup the menu for identity buttons."
- (interactive "e")
- (save-excursion
- (set-buffer (riece-event-buffer event))
- (goto-char (riece-event-point event))
- (riece-popup-menu-popup
- (if (riece-channel-p (riece-identity-prefix
- (get-text-property (point) 'riece-identity)))
- riece-channel-button-popup-menu
- riece-user-button-popup-menu)
- event)))
-
-(defun riece-channel-button-switch-to-channel ()
- (interactive)
- (riece-command-switch-to-channel
- (get-text-property (point) 'riece-identity)))
-
-(defun riece-channel-button-part ()
- (interactive)
- (riece-command-part
- (get-text-property (point) 'riece-identity)))
-
-(defun riece-channel-button-list ()
- (interactive)
- (riece-command-list
- (riece-identity-prefix (get-text-property (point) 'riece-identity))))
-
-(defun riece-user-button-join-partner ()
- (interactive)
- (riece-command-join-partner
- (get-text-property (point) 'riece-identity)))
-
-(defun riece-user-button-set-operators ()
- (interactive)
- (let (group users)
- (if (riece-region-active-p)
- (save-excursion
- (riece-scan-property-region
- 'riece-identity
- (region-beginning) (region-end)
- (lambda (start end)
- (setq group (cons (get-text-property start 'riece-identity)
- group)))))
- (setq group (list (get-text-property (point) 'riece-identity))))
- (setq users (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))))
- (if (setq group
- (delq nil
- (mapcar
- (lambda (identity)
- (unless (memq ?o (cdr (riece-identity-assoc
- (riece-identity-prefix identity)
- users
- t)))
- identity))
- group)))
- (riece-command-set-operators (mapcar #'riece-identity-prefix group)))))
-
-(defun riece-user-button-set-speakers ()
- (interactive)
- (let (group users)
- (if (riece-region-active-p)
- (save-excursion
- (riece-scan-property-region
- 'riece-identity
- (region-beginning) (region-end)
- (lambda (start end)
- (setq group (cons (get-text-property start 'riece-identity)
- group)))))
- (setq group (list (get-text-property (point) 'riece-identity))))
- (setq users (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))))
- (if (setq group
- (delq nil
- (mapcar
- (lambda (identity)
- (unless (memq ?v (cdr (riece-identity-assoc
- (riece-identity-prefix identity)
- users
- t)))
- identity))
- group)))
- (riece-command-set-speakers (mapcar #'riece-identity-prefix group)))))
-
-(defun riece-user-button-finger ()
- (interactive)
- (riece-command-finger (get-text-property (point) 'riece-identity)))
-
-(defun riece-make-identity-button-map ()
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map (current-local-map))
- (define-key map [down-mouse-2] 'riece-identity-button-click)
- (define-key map [down-mouse-3] 'riece-identity-button-popup-menu)
- map))
-
-(defvar riece-identity-button-map)
-(defun riece-button-add-identity-button (start end)
- (if (get 'riece-button 'riece-addon-enabled)
- (riece-scan-property-region
- 'riece-identity
- start end
- (lambda (start end)
- (let ((inhibit-read-only t)
- buffer-read-only)
- (widget-convert-button 'riece-identity-button start end
- (get-text-property start 'riece-identity))
- (add-text-properties
- start end
- (list 'local-map riece-identity-button-map
- 'keymap riece-identity-button-map)))))))
-
-(defun riece-button-update-buffer ()
- (riece-button-add-identity-button (point-min) (point-max)))
-
-(defvar riece-channel-list-mode-map)
-(defvar riece-user-list-mode-map)
-(defvar riece-dialogue-mode-map)
-
-(defun riece-button-channel-list-mode-hook ()
- (set-keymap-parent riece-channel-list-mode-map widget-keymap)
- (set (make-local-variable 'riece-identity-button-map)
- (riece-make-identity-button-map))
- (add-hook 'riece-update-buffer-functions
- 'riece-button-update-buffer t t))
-
-(defun riece-button-user-list-mode-hook ()
- (set-keymap-parent riece-user-list-mode-map widget-keymap)
- (set (make-local-variable 'riece-identity-button-map)
- (riece-make-identity-button-map))
- (add-hook 'riece-update-buffer-functions
- 'riece-button-update-buffer t t))
-
-(defun riece-button-dialogue-mode-hook ()
- (set-keymap-parent riece-dialogue-mode-map widget-keymap)
- (set (make-local-variable 'riece-identity-button-map)
- (riece-make-identity-button-map)))
-
-(defun riece-button-insinuate ()
- (save-excursion
- (when riece-channel-list-buffer
- (set-buffer riece-channel-list-buffer)
- (riece-button-channel-list-mode-hook))
- (when riece-user-list-buffer
- (set-buffer riece-user-list-buffer)
- (riece-button-user-list-mode-hook))
- (let ((buffers riece-buffer-list))
- (while buffers
- (set-buffer (car buffers))
- (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (riece-button-dialogue-mode-hook))
- (setq buffers (cdr buffers)))))
- (add-hook 'riece-channel-list-mode-hook
- 'riece-button-channel-list-mode-hook)
- (add-hook 'riece-user-list-mode-hook
- 'riece-button-user-list-mode-hook)
- (add-hook 'riece-dialogue-mode-hook
- 'riece-button-dialogue-mode-hook)
- (add-hook 'riece-after-insert-functions 'riece-button-add-identity-button))
-
-(defun riece-button-uninstall ()
- (let ((buffers riece-buffer-list))
- (save-excursion
- (while buffers
- (set-buffer (car buffers))
- (remove-hook 'riece-update-buffer-functions
- 'riece-button-update-buffer t)
- (if (local-variable-p 'riece-identity-button-map
- (car buffers))
- (kill-local-variable 'riece-identity-button-map))
- (setq buffers (cdr buffers)))))
- (remove-hook 'riece-channel-list-mode-hook
- 'riece-button-channel-list-mode-hook)
- (remove-hook 'riece-user-list-mode-hook
- 'riece-button-user-list-mode-hook)
- (remove-hook 'riece-dialogue-mode-hook
- 'riece-button-dialogue-mode-hook)
- (remove-hook 'riece-after-insert-functions
- 'riece-button-add-identity-button))
-
-(defun riece-button-enable ()
- (let ((pointer riece-buffer-list))
- (while pointer
- (with-current-buffer (car pointer)
- (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (riece-button-update-buffer)))
- (setq pointer (cdr pointer)))
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (riece-emit-signal 'channel-list-changed)))
-
-(defun riece-button-disable ()
- (save-excursion
- (let ((pointer riece-buffer-list))
- (while pointer
- ;; On XEmacs, BUFFER arg of widget-map-buttons is ignored.
- (set-buffer (car pointer))
- (widget-map-buttons
- (lambda (widget maparg)
- (widget-leave-text widget)))
- (setq pointer (cdr pointer))))))
-
-(provide 'riece-button)
-
-;;; riece-button.el ends here
+++ /dev/null
-;;; riece-cache.el --- LRU cache
-;; Copyright (C) 1998-2005 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(defun riece-cache-make-node (key value &optional previous next)
- "Make riece-cache-node object."
- (vector key value previous next))
-
-(defun riece-cache-node-key (node)
- "Return key of NODE."
- (aref node 0))
-
-(defun riece-cache-node-value (node)
- "Return value of NODE."
- (aref node 1))
-
-(defun riece-cache-node-set-value (node value)
- "Set value of NODE to VALUE."
- (aset node 1 value))
-
-(defun riece-cache-node-next (node)
- "Return next of NODE."
- (aref node 3))
-
-(defun riece-cache-node-set-next (node next)
- "Set next of NODE to NEXT."
- (aset node 3 next))
-
-(defun riece-cache-node-previous (node)
- "Return previous of NODE."
- (aref node 2))
-
-(defun riece-cache-node-set-previous (node previous)
- "Set previous of NODE to PREVIOUS."
- (aset node 2 previous))
-
-(defun riece-make-cache (max-length)
- "Make riece-cache object."
- (vector max-length (make-vector (* max-length 2) 0) 0 nil nil))
-
-(defun riece-cache-max-length (cache)
- "Return max-length of CACHE."
- (aref cache 0))
-
-(defun riece-cache-hash-obarray (cache)
- "Return hash-obarray of CACHE."
- (aref cache 1))
-
-(defun riece-cache-hash-length (cache)
- "Return hash-length of CACHE."
- (aref cache 2))
-
-(defun riece-cache-set-hash-length (cache hash-length)
- "Set hash-length of CACHE to HASH-LENGTH."
- (aset cache 2 hash-length))
-
-(defun riece-cache-first (cache)
- "Return first of CACHE."
- (aref cache 3))
-
-(defun riece-cache-set-first (cache first)
- "Set first of CACHE to FIRST."
- (aset cache 3 first))
-
-(defun riece-cache-last (cache)
- "Return last of CACHE."
- (aref cache 4))
-
-(defun riece-cache-set-last (cache last)
- "Set last of CACHE to LAST."
- (aset cache 4 last))
-
-(defun riece-cache-contains (cache key)
- "Return t if CACHE contains an entry whose key is KEY."
- (intern-soft key (riece-cache-hash-obarray cache)))
-
-(defun riece-cache-get (cache key)
- "Return the value associated with KEY in CACHE.
-If KEY is not associated in CACHE, it returns nil."
- (let ((node (riece-cache-get-node cache key)))
- (if node
- (riece-cache-node-value node))))
-
-(defun riece-cache-get-node (cache key)
- "Return a node object associcated with KEY in CACHE.
-If KEY is not associated in CACHE, it returns nil."
- (let ((symbol (intern-soft key (riece-cache-hash-obarray cache)))
- previous next last node)
- (when symbol
- (setq node (symbol-value symbol)
- previous (riece-cache-node-previous node)
- next (riece-cache-node-next node)
- last (riece-cache-last cache))
- (if previous
- (riece-cache-node-set-next previous next))
- (if next
- (riece-cache-node-set-previous next previous))
- (riece-cache-node-set-next node nil)
- (riece-cache-node-set-previous node last)
- (riece-cache-node-set-next last node)
- (riece-cache-set-last cache node)
- (if (and (eq node (riece-cache-first cache)) next)
- (riece-cache-set-first cache next))
- node)))
-
-(defun riece-cache-delete (cache key)
- "Remove an entry from CACHE whose key is KEY."
- (let ((symbol (intern-soft key (riece-cache-hash-obarray cache)))
- previous next node)
- (when symbol
- (setq node (symbol-value symbol)
- previous (riece-cache-node-previous node)
- next (riece-cache-node-next node))
- (if previous
- (riece-cache-node-set-next previous next))
- (if next
- (riece-cache-node-set-previous next previous))
- (if (eq (riece-cache-last cache) node)
- (riece-cache-set-last cache previous))
- (if (eq (riece-cache-first cache) node)
- (riece-cache-set-first cache next))
- (unintern symbol (riece-cache-hash-obarray cache))
- (riece-cache-set-hash-length cache
- (1- (riece-cache-hash-length cache)))
- (riece-cache-node-value node))))
-
-(defun riece-cache-set (cache key value)
- "Associate KEY with VALUE in CACHE."
- (let ((node (riece-cache-get-node cache key)))
- (if node
- (riece-cache-node-set-value node value)
- (if (>= (riece-cache-hash-length cache)
- (riece-cache-max-length cache))
- (riece-cache-delete cache (riece-cache-node-key
- (riece-cache-first cache))))
- (setq node (riece-cache-make-node key value (riece-cache-last cache)))
- (set (intern key (riece-cache-hash-obarray cache)) node)
- (riece-cache-set-hash-length cache
- (1+ (riece-cache-hash-length cache)))
- (unless (riece-cache-first cache)
- (riece-cache-set-first cache node))
- (when (riece-cache-last cache)
- (riece-cache-node-set-next (riece-cache-last cache) node)
- (riece-cache-node-set-previous node (riece-cache-last cache)))
- (riece-cache-set-last cache node))))
-
-(provide 'riece-cache)
-
-;;; riece-cache.el ends here
+++ /dev/null
-;;; riece-channel.el --- a channel object
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-globals)
-(require 'riece-identity)
-(require 'riece-mode)
-(require 'riece-cache)
-
-;;; Channel object:
-(defun riece-find-channel (name)
- "Get a channel object named NAME from the server buffer."
- (riece-cache-get riece-channel-cache name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)
- riece-channel-obarray)))
- (if symbol
- (symbol-value symbol))))
-
-(defun riece-forget-channel (name)
- (riece-cache-delete riece-channel-cache name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)
- riece-channel-obarray)))
- (when symbol
- (makunbound symbol)
- (unintern (symbol-name symbol) riece-channel-obarray))))
-
-(defun riece-make-channel (users topic modes banned invited uninvited key)
- "Make an instance of channel object.
-Arguments are appropriate to channel users, topic, modes, banned
-users, invited users, uninvited users, and the channel key,
-respectively."
- (vector users topic modes banned invited uninvited))
-
-(defun riece-get-channel (name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)
- riece-channel-obarray)))
- (if symbol
- (progn
- (riece-cache-get riece-channel-cache name)
- (symbol-value symbol))
- (riece-cache-set riece-channel-cache name name)
- (set (intern (riece-identity-canonicalize-prefix name)
- riece-channel-obarray)
- (riece-make-channel nil nil nil nil nil nil nil)))))
-
-(defun riece-channel-users (channel)
- "Return the users of CHANNEL."
- (aref channel 0))
-
-(defun riece-channel-topic (channel)
- "Return the topic of CHANNEL."
- (aref channel 1))
-
-(defun riece-channel-modes (channel)
- "Return the modes of CHANNEL."
- (aref channel 2))
-
-(defun riece-channel-banned (channel)
- "Return the banned users of CHANNEL."
- (aref channel 3))
-
-(defun riece-channel-invited (channel)
- "Return the invited users of CHANNEL."
- (aref channel 4))
-
-(defun riece-channel-uninvited (channel)
- "Return the uninvited users of CHANNEL."
- (aref channel 5))
-
-(defun riece-channel-key (channel)
- "Return the key of CHANNEL."
- (aref channel 6))
-
-(defun riece-channel-set-users (channel value)
- "Set the users of CHANNEL to VALUE."
- (aset channel 0 value))
-
-(defun riece-channel-set-topic (channel value)
- "Set the topic of CHANNEL to VALUE."
- (aset channel 1 value))
-
-(defun riece-channel-set-modes (channel value)
- "Set the modes of CHANNEL to VALUE."
- (aset channel 2 value))
-
-(defun riece-channel-set-banned (channel value)
- "Set the banned users of CHANNEL to VALUE."
- (aset channel 3 value))
-
-(defun riece-channel-set-invited (channel value)
- "Set the invited users of CHANNEL to VALUE."
- (aset channel 4 value))
-
-(defun riece-channel-set-uninvited (channel value)
- "Set the uninvited users of CHANNEL to VALUE."
- (aset channel 5 value))
-
-(defun riece-channel-set-key (channel value)
- "Set the key of CHANNEL to VALUE."
- (aset channel 6 value))
-
-(defun riece-channel-get-users (name)
- "Return channel's users as list."
- (riece-channel-users (riece-get-channel name)))
-
-(defun riece-channel-get-topic (name)
- "Return channel's topic."
- (riece-channel-topic (riece-get-channel name)))
-
-(defun riece-channel-get-modes (name)
- "Return channel's modes as list."
- (riece-channel-modes (riece-get-channel name)))
-
-(defun riece-channel-get-banned (name)
- "Return channel's banned users as list."
- (riece-channel-banned (riece-get-channel name)))
-
-(defun riece-channel-get-invited (name)
- "Return channel's invited users as list."
- (riece-channel-invited (riece-get-channel name)))
-
-(defun riece-channel-get-uninvited (name)
- "Return channel's uninvited users as list."
- (riece-channel-uninvited (riece-get-channel name)))
-
-(defun riece-channel-get-key (name)
- "Return channel's key."
- (riece-channel-key (riece-get-channel name)))
-
-;;; Functions called from `riece-handle-mode-message':
-(defun riece-channel-toggle-mode (name mode flag)
- "Add or remove channel MODE of channel."
- (let* ((channel (riece-get-channel name))
- (modes (riece-channel-modes channel))
- (old (riece-mode-assoc (riece-mode-flag mode) modes)))
- (if flag
- (unless old
- (riece-channel-set-modes channel (cons mode modes)))
- (if old
- (riece-channel-set-modes channel (delq old modes))))))
-
-(defun riece-channel-toggle-banned (name pattern flag)
- "Add or remove banned PATTERN of channel."
- (let* ((channel (riece-get-channel name))
- (banned (riece-channel-banned channel)))
- (if flag
- (unless (member pattern banned)
- (riece-channel-set-banned channel (cons pattern banned)))
- (if (setq pattern (car (member pattern banned)))
- (riece-channel-set-banned channel (delq pattern banned))))))
-
-(defun riece-channel-toggle-invited (name pattern flag)
- "Add or remove invited PATTERN of channel."
- (let* ((channel (riece-get-channel name))
- (invited (riece-channel-invited channel)))
- (if flag
- (unless (member pattern invited)
- (riece-channel-set-invited channel (cons pattern invited)))
- (if (setq pattern (car (member pattern invited)))
- (riece-channel-set-invited channel (delq pattern invited))))))
-
-(defun riece-channel-toggle-uninvited (name pattern flag)
- "Add or remove uninvited PATTERN to channel."
- (let* ((channel (riece-get-channel name))
- (uninvited (riece-channel-uninvited channel)))
- (if flag
- (unless (member pattern uninvited)
- (riece-channel-set-uninvited channel (cons pattern uninvited)))
- (if (setq pattern (car (member pattern uninvited)))
- (riece-channel-set-uninvited
- channel (delq pattern uninvited))))))
-
-(defun riece-channel-toggle-user (name user flag)
- "Add or remove an user to channel."
- (let* ((channel (riece-get-channel name))
- (users (riece-channel-users channel)))
- (if flag
- (unless (riece-identity-assoc user users t)
- (riece-channel-set-users channel (cons (list user) users)))
- (if (setq user (riece-identity-assoc user users t))
- (riece-channel-set-users channel (delq user users))))))
-
-(defun riece-channel-toggle-operator (name user flag)
- "Add or remove an operator to channel."
- (let* ((channel (riece-get-channel name))
- (users (riece-channel-users channel)))
- (setq user (riece-identity-assoc user users t))
- (if flag
- (if user
- (unless (memq ?o (cdr user))
- (setcdr user (cons ?o (cdr user))))
- (riece-channel-set-users channel (cons (list user ?o) users)))
- (if user
- (setcdr user (delq ?o (cdr user)))))))
-
-(defun riece-channel-toggle-speaker (name user flag)
- "Add or remove an speaker to channel."
- (let* ((channel (riece-get-channel name))
- (users (riece-channel-users channel)))
- (setq user (riece-identity-assoc user users t))
- (if flag
- (if user
- (unless (memq ?v (cdr user))
- (setcdr user (cons ?v (cdr user))))
- (riece-channel-set-users channel (cons (list user ?v) users)))
- (if user
- (setcdr user (delq ?v (cdr user)))))))
-
-(provide 'riece-channel)
-
-;;; riece-channel.el ends here
+++ /dev/null
-;;; riece-coding.el --- converting string with coding system
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece, coding-system, MULE
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-
-(defgroup riece-coding nil
- "Coding system."
- :tag "Coding"
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-default-coding-system
- (if (featurep 'mule)
- (cons 'ctext 'iso-2022-jp-2))
- "Coding system for process I/O.
-The value is a coding system, or a cons cell (DECODING . ENCODING)
-specifying the coding systems for decoding and encoding respectively."
- :type '(choice (symbol :tag "Coding system")
- (cons (symbol :tag "Input coding system")
- (symbol :tag "Output coding system"))
- (const nil :tag "No conversion"))
- :group 'riece-coding)
-
-(defun riece-encode-coding-string (string)
- (if (and (local-variable-p 'riece-coding-system (current-buffer))
- riece-coding-system) ;should be nil on non-Mule environment
- (encode-coding-string string (if (consp riece-coding-system)
- (cdr riece-coding-system)
- riece-coding-system))
- string))
-
-(defun riece-decode-coding-string (string)
- (if (and (local-variable-p 'riece-coding-system (current-buffer))
- riece-coding-system) ;should be nil on non-Mule environment
- (riece-decode-coding-string-1 string
- (if (consp riece-coding-system)
- (car riece-coding-system)
- riece-coding-system))
- string))
-
-(defun riece-decode-coding-string-1 (string coding-system)
- (let* ((decoded (decode-coding-string string coding-system))
- (length (length decoded)))
- (put-text-property 0 length 'riece-decoded-encoded-string
- string decoded)
- (put-text-property 0 length 'riece-decoded-coding-system
- coding-system decoded)
- decoded))
-
-;; The following functions are API used by handler functions. For the
-;; meantime DECODED is actually a string (with some text properties).
-;; In the future, however, the implementation _should_ be changed so
-;; that decoding phase is delayed until the body of handler functions.
-(defun riece-decoded-coding-system (decoded)
- "Return the coding-system used for decoding DECODED."
- (get-text-property 0 'riece-decoded-coding-system decoded))
-
-(defun riece-decoded-encoded-string (decoded)
- "Return the string before decoding."
- (get-text-property 0 'riece-decoded-encoded-string decoded))
-
-(defalias 'riece-decoded-string 'identity)
-
-(provide 'riece-coding)
-
-;;; riece-coding.el ends here
+++ /dev/null
-/* XPM */
-static char * right_xpm[] = {
-"32 32 32 1",
-" c #000200",
-". c #090A06",
-"+ c #111310",
-"@ c #191A18",
-"# c #212220",
-"$ c #282827",
-"% c #2E2F2E",
-"& c #363835",
-"* c #3E403D",
-"= c #464845",
-"- c #4D4E4C",
-"; c #535453",
-"> c #5B5D5A",
-", c #636562",
-"' c #6A6C6A",
-") c #828100",
-"! c #747573",
-"~ c #8A8903",
-"{ c #7C7D7B",
-"] c #939214",
-"^ c #9A970C",
-"/ c #9EA119",
-"( c #A9AB27",
-"_ c #B4B532",
-": c #C1C13F",
-"< c #CDCD4B",
-"[ c #D8D855",
-"} c #CACCC9",
-"| c #E3E25F",
-"1 c #F0EE6B",
-"2 c #FDFA77",
-"3 c #FEFFFC",
-" ",
-" ",
-" ",
-" ",
-" ",
-" } ",
-" },} ",
-" }>'} ",
-" }>>;} ",
-" };,;;} ",
-" }}}}}}}}}}}}}}}}}}[;>;;} ",
-" }[<[<;;;;<<<[;;;;[<<<;;;;} ",
-" };<<<<---;<<<<----<<<<---;} ",
-" }=-<<<:-=--:<:<==--<<<:----} ",
-" }***::::=*==::::=**=::::***-} ",
-" }*=*=::::****::::=***::::****}",
-" }:****:_::****:_::****::::***}",
-" }__&&*%:___&&&&____&&*%____&} ",
-" }___%&&&____&&&&____%&&&___} ",
-" }(___%%%%(___%%%%(___%&%%(} ",
-" }%(((_%%%%((((%%%%((((%%%} ",
-" }}}}}}}}}}}}}}}}}}(((($} ",
-" }#/](} ",
-" }#$]} ",
-" }@#} ",
-" }@} ",
-" } ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-/* XPM */
-static char * left_xpm[] = {
-"32 32 33 1",
-" c None",
-". c #000200",
-"+ c #090A06",
-"@ c #111310",
-"# c #191A18",
-"$ c #212220",
-"% c #282827",
-"& c #2E2F2E",
-"* c #363835",
-"= c #3E403D",
-"- c #464845",
-"; c #4D4E4C",
-"> c #535453",
-", c #5B5D5A",
-"' c #636562",
-") c #6A6C6A",
-"! c #828100",
-"~ c #747573",
-"{ c #8A8903",
-"] c #7C7D7B",
-"^ c #939214",
-"/ c #9A970C",
-"( c #9EA119",
-"_ c #A9AB27",
-": c #B4B532",
-"< c #C1C13F",
-"[ c #CDCD4B",
-"} c #D8D855",
-"| c #CACCC9",
-"1 c #E3E25F",
-"2 c #F0EE6B",
-"3 c #FDFA77",
-"4 c #FEFFFC",
-" ",
-" ",
-" ",
-" ",
-" ",
-" | ",
-" |)| ",
-" |11| ",
-" |111| ",
-" |>>}}| ",
-" |>,>>}|||||||||||||||||| ",
-" |}[>>>>[[[}>>>>}[[[>>>>[[| ",
-" |[[[[;;;>[[[[;;;;[[[[;;;>[| ",
-" |-;[[[<;-;;<[<[--;;[[[<;;;;| ",
-" |-===<<<<-=--<<<<-==-<<<<===| ",
-"|<<=-=-<<<<====<<<<-===<<<<==| ",
-"|:<<====<:<<====<:<<====<<<<=| ",
-" |:::**=&<:::****::::**=&::::| ",
-" |:::&***::::****::::&***:::| ",
-" |:::&&&&_:::&&&&_:::&*&&_:| ",
-" |__:&&&&____&&&&____&&&&_| ",
-" |___%%|||||||||||||||||| ",
-" |/__%| ",
-" |^/^| ",
-" |(^| ",
-" |(| ",
-" | ",
-" ",
-" ",
-" ",
-" ",
-" "};
+++ /dev/null
-;;; riece-commands.el --- commands available in command buffer
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-channel)
-(require 'riece-complete)
-(require 'riece-layout)
-(require 'riece-display)
-(require 'riece-server)
-(require 'riece-misc)
-(require 'riece-identity)
-(require 'riece-message)
-(require 'riece-mcat)
-
-(autoload 'derived-mode-class "derived")
-
-;;; Channel movement:
-(defun riece-command-switch-to-channel (channel)
- (interactive (list (riece-completing-read-identity
- (riece-mcat "Switch to channel/user: ")
- riece-current-channels nil t)))
- (unless (equal channel riece-current-channel)
- (riece-switch-to-channel channel)))
-
-(defun riece-command-switch-to-channel-by-number (number)
- (interactive
- (let ((command-name (symbol-name this-command)))
- (if (string-match "[0-9]+$" command-name)
- (list (string-to-number (match-string 0 command-name)))
- (list (string-to-number (read-string (riece-mcat "Switch to number: ")))))))
- (let ((channel (nth (1- number) riece-current-channels)))
- (if channel
- (riece-command-switch-to-channel channel)
- (error "No such number!"))))
-
-(eval-and-compile
- (let ((number 1))
- (while (<= number 20)
- (defalias (intern (concat "riece-command-switch-to-channel-by-number-"
- (number-to-string number)))
- 'riece-command-switch-to-channel-by-number)
- (setq number (1+ number)))))
-
-(defun riece-command-next-channel ()
- "Select the next channel."
- (interactive)
- (when (> (length riece-current-channels) 1)
- (let ((pointer (cdr (riece-identity-member
- riece-current-channel
- riece-current-channels))))
- (while (and pointer
- (null (car pointer)))
- (setq pointer (cdr pointer)))
- (when (null pointer)
- (setq pointer riece-current-channels)
- (while (and pointer
- (null (car pointer)))
- (setq pointer (cdr pointer))))
- (if (car pointer)
- (riece-command-switch-to-channel (car pointer))
- (error "No such channel!")))))
-
-(defun riece-command-previous-channel ()
- "Select the previous channel."
- (interactive)
- (when (> (length riece-current-channels) 1)
- (let ((pointer (riece-identity-member
- riece-current-channel
- riece-current-channels))
- (start riece-current-channels)
- channel)
- (while (and start (not (eq start pointer)))
- (if (car start)
- (setq channel (car start)))
- (setq start (cdr start)))
- (when (null channel)
- (setq start (copy-sequence riece-current-channels))
- (setq start (delq nil start))
- (and (> (length start) 1)
- (setq channel (nth (1- (length start)) start))))
- (if channel
- (riece-command-switch-to-channel channel)
- (error "No such channel!")))))
-
-(defun riece-command-select-command-buffer ()
- "Select the command buffer."
- (interactive)
- (let ((window (get-buffer-window riece-command-buffer)))
- (if window
- (select-window window))))
-
-(defun riece-command-configure-windows ()
- (interactive)
- "Reconfigure windows with the current layout."
- (riece-redisplay-buffers t))
-
-(defun riece-command-suspend-resume ()
- (interactive)
- "Save or restore the current window configuration."
- (let ((entry (assq 'riece-window-configuration (frame-parameters))))
- (modify-frame-parameters (selected-frame)
- (list (cons 'riece-window-configuration
- (current-window-configuration))))
- (if (cdr entry)
- (set-window-configuration (cdr entry))
- (delete-other-windows))
- (message
- (substitute-command-keys
- "\\[riece-command-suspend-resume] to get back the last windows"))))
-
-(defun riece-command-change-layout (name)
- "Select a layout-name from all current available layouts and change
-the layout to the selected layout-name."
- (interactive (list (completing-read (riece-mcat "Change layout: ")
- riece-layout-alist)))
- (setq riece-layout name
- riece-save-variables-are-dirty t)
- (riece-command-configure-windows))
-
-(defun riece-command-toggle-channel-buffer-mode ()
- (interactive)
- (setq riece-channel-buffer-mode
- (not riece-channel-buffer-mode)
- riece-save-variables-are-dirty t)
- (riece-command-configure-windows))
-
-(defun riece-command-toggle-others-buffer-mode ()
- (interactive)
- (setq riece-others-buffer-mode
- (not riece-others-buffer-mode)
- riece-save-variables-are-dirty t)
- (riece-command-configure-windows))
-
-(defun riece-command-toggle-user-list-buffer-mode ()
- (interactive)
- (setq riece-user-list-buffer-mode
- (not riece-user-list-buffer-mode)
- riece-save-variables-are-dirty t)
- (riece-command-configure-windows))
-
-(defun riece-command-toggle-channel-list-buffer-mode ()
- (interactive)
- (setq riece-channel-list-buffer-mode
- (not riece-channel-list-buffer-mode)
- riece-save-variables-are-dirty t)
- (riece-command-configure-windows))
-
-(defun riece-command-finger (user &optional recurse)
- (interactive
- (let* ((completion-ignore-case t)
- (user (riece-completing-read-identity
- (riece-mcat "Finger user: ")
- (riece-get-users-on-server (riece-current-server-name))
- nil nil nil nil nil t)))
- (list user current-prefix-arg)))
- (if recurse
- (riece-send-string (format "WHOIS %s %s\r\n"
- (riece-identity-prefix user)
- (riece-identity-prefix user)))
- (riece-send-string (format "WHOIS %s\r\n" (riece-identity-prefix user)))))
-
-(defun riece-command-topic (topic)
- (interactive
- (progn
- (riece-check-channel-commands-are-usable t)
- (list (read-from-minibuffer
- (riece-mcat "Set topic: ")
- (cons (or (riece-with-server-buffer
- (riece-identity-server
- riece-current-channel)
- (riece-channel-get-topic
- (riece-identity-prefix
- riece-current-channel)))
- "")
- 0)))))
- (riece-send-string (format "TOPIC %s :%s\r\n"
- (riece-identity-prefix riece-current-channel)
- topic)
- riece-current-channel))
-
-(defun riece-command-invite (user)
- (interactive
- (let ((completion-ignore-case t))
- (riece-check-channel-commands-are-usable t)
- (list (riece-completing-read-identity
- (riece-mcat "Invite user: ")
- (riece-get-users-on-server (riece-current-server-name))
- nil nil nil nil nil t))))
- (riece-send-string (format "INVITE %s :%s\r\n"
- (riece-identity-prefix user)
- (riece-identity-prefix riece-current-channel))))
-
-(defun riece-command-kick (user &optional message)
- (interactive
- (let ((completion-ignore-case t))
- (riece-check-channel-commands-are-usable t)
- (list (completing-read
- (riece-mcat "Kick user: ")
- (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))))
- (if current-prefix-arg
- (read-string "Message: ")))))
- (riece-send-string
- (if message
- (format "KICK %s %s :%s\r\n"
- (riece-identity-prefix riece-current-channel)
- user message)
- (format "KICK %s %s\r\n"
- (riece-identity-prefix riece-current-channel)
- user))
- riece-current-channel))
-
-(defun riece-command-names (pattern)
- (interactive
- (let ((completion-ignore-case t))
- (list (read-from-minibuffer
- (riece-mcat "NAMES pattern: ")
- (if (and riece-current-channel
- (riece-channel-p (riece-identity-prefix
- riece-current-channel)))
- (cons (riece-identity-prefix riece-current-channel)
- 0))))))
- (if (or (not (equal pattern ""))
- (yes-or-no-p (riece-mcat
- "Really want to query NAMES without argument? ")))
- (riece-send-string (format "NAMES %s\r\n" pattern))))
-
-(defun riece-command-who (pattern)
- (interactive
- (let ((completion-ignore-case t))
- (list (read-from-minibuffer
- (riece-mcat "WHO pattern: ")
- (if (and riece-current-channel
- (riece-channel-p (riece-identity-prefix
- riece-current-channel)))
- (cons (riece-identity-prefix riece-current-channel)
- 0))))))
- (if (or (not (equal pattern ""))
- (yes-or-no-p (riece-mcat
- "Really want to query WHO without argument? ")))
- (riece-send-string (format "WHO %s\r\n" pattern))))
-
-(defun riece-command-list (pattern)
- (interactive
- (let ((completion-ignore-case t))
- (list (read-from-minibuffer
- (riece-mcat "LIST pattern: ")
- (if (and riece-current-channel
- (riece-channel-p (riece-identity-prefix
- riece-current-channel)))
- (cons (riece-identity-prefix riece-current-channel)
- 0))))))
- (if (or (not (equal pattern ""))
- (yes-or-no-p (riece-mcat
- "Really want to query LIST without argument? ")))
- (riece-send-string (format "LIST %s\r\n" pattern))))
-
-(defun riece-command-change-mode (channel change)
- (interactive
- (let* ((completion-ignore-case t)
- (channel
- (if current-prefix-arg
- (riece-completing-read-identity
- (riece-mcat "Change mode for channel/user: ")
- (riece-get-identities-on-server (riece-current-server-name))
- nil nil nil nil nil t)
- (riece-check-channel-commands-are-usable t)
- riece-current-channel))
- (riece-overriding-server-name (riece-identity-server channel))
- (riece-temp-minibuffer-message
- (concat (riece-mcat "[Available modes: ")
- (riece-with-server-buffer (riece-identity-server channel)
- (if (riece-channel-p (riece-identity-prefix channel))
- (if riece-supported-channel-modes
- (apply #'string riece-supported-channel-modes))
- (if riece-supported-user-modes
- (apply #'string riece-supported-user-modes))))
- "]")))
- (list channel
- (read-from-minibuffer
- (concat (riece-concat-channel-modes
- channel (riece-mcat "Mode (? for help)")) ": ")
- nil riece-minibuffer-map))))
- (if (equal change "")
- (riece-send-string (format "MODE %s\r\n"
- (riece-identity-prefix channel)))
- (riece-send-string (format "MODE %s %s\r\n"
- (riece-identity-prefix channel)
- change))))
-
-(defun riece-command-set-operators (users &optional arg)
- (interactive
- (progn
- (riece-check-channel-commands-are-usable t)
- (let ((completion-ignore-case t))
- (list (riece-completing-read-multiple
- (if current-prefix-arg
- (riece-mcat "Unset +o for users")
- (riece-mcat "Set +o for users"))
- (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel)))
- (if current-prefix-arg
- (lambda (user)
- (memq ?o (cdr user)))
- (lambda (user)
- (not (memq ?o (cdr user))))))
- current-prefix-arg))))
- (let (group)
- (while users
- (setq group (cons (car users) group)
- users (cdr users))
- (when (or (= (length group) 3)
- (null users))
- (riece-send-string
- (format "MODE %s %c%s %s\r\n"
- (riece-identity-prefix riece-current-channel)
- (if current-prefix-arg
- ?-
- ?+)
- (make-string (length group) ?o)
- (mapconcat #'identity (nreverse group) " ")))
- (setq group nil)))))
-
-(defun riece-command-set-speakers (users &optional arg)
- (interactive
- (progn
- (riece-check-channel-commands-are-usable t)
- (let ((completion-ignore-case t))
- (list (riece-completing-read-multiple
- (if current-prefix-arg
- (riece-mcat "Unset +v for users")
- (riece-mcat "Set +v for users"))
- (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel)))
- (if current-prefix-arg
- (lambda (user)
- (memq ?v (cdr user)))
- (lambda (user)
- (not (memq ?v (cdr user))))))
- current-prefix-arg))))
- (let (group)
- (while users
- (setq group (cons (car users) group)
- users (cdr users))
- (when (or (= (length group) 3)
- (null users))
- (riece-send-string
- (format "MODE %s %c%s %s\r\n"
- (riece-identity-prefix riece-current-channel)
- (if current-prefix-arg
- ?-
- ?+)
- (make-string (length group) ?v)
- (mapconcat #'identity (nreverse group) " ")))
- (setq group nil)))))
-
-(defun riece-command-send-message (message notice)
- "Send MESSAGE to the current channel."
- (run-hooks 'riece-command-send-message-hook)
- (if (equal message "")
- (error (riece-mcat "No text to send")))
- (riece-check-channel-commands-are-usable)
- (if notice
- (progn
- (riece-send-string
- (format "NOTICE %s :%s\r\n"
- (riece-identity-prefix riece-current-channel)
- message)
- riece-current-channel)
- (riece-display-message
- (riece-make-message (riece-current-nickname) riece-current-channel
- message 'notice t)))
- (riece-send-string
- (format "PRIVMSG %s :%s\r\n"
- (riece-identity-prefix riece-current-channel)
- message)
- riece-current-channel)
- (riece-display-message
- (riece-make-message (riece-current-nickname) riece-current-channel
- message nil t))))
-
-(defun riece-command-enter-message ()
- "Send the current line to the current channel."
- (interactive)
- (riece-command-send-message (buffer-substring
- (riece-line-beginning-position)
- (riece-line-end-position))
- nil)
- (let ((next-line-add-newlines t))
- (next-line 1)))
-
-(defun riece-command-enter-message-as-notice ()
- "Send the current line to the current channel as NOTICE."
- (interactive)
- (riece-command-send-message (buffer-substring
- (riece-line-beginning-position)
- (riece-line-end-position))
- t)
- (let ((next-line-add-newlines t))
- (next-line 1)))
-
-(defun riece-command-enter-message-to-user (user)
- "Send the current line to USER."
- (interactive
- (if (and (bolp) (eolp))
- (error "No text to send")
- (let ((completion-ignore-case t))
- (list (riece-completing-read-identity
- (riece-mcat "Message to user: ")
- (riece-get-users-on-server (riece-current-server-name))
- nil nil nil nil nil t)))))
- (let ((text (buffer-substring
- (riece-line-beginning-position)
- (riece-line-end-position))))
- (riece-send-string
- (format "PRIVMSG %s :%s\r\n" (riece-identity-prefix user) text)
- user)
- (riece-display-message
- (riece-make-message (riece-current-nickname) user text nil t)))
- (let ((next-line-add-newlines t))
- (next-line 1)))
-
-(defun riece-command-join-channel (target key)
- (unless (riece-server-opened (riece-identity-server target))
- (error "%s" (substitute-command-keys
- "Type \\[riece-command-open-server] to open server.")))
- (riece-send-string (if key
- (format "JOIN %s :%s\r\n"
- (riece-identity-prefix target)
- key)
- (format "JOIN %s\r\n"
- (riece-identity-prefix target)))
- target))
-
-(defun riece-command-join-partner (target)
- (let ((pointer (riece-identity-member target riece-current-channels)))
- (if pointer
- (riece-command-switch-to-channel (car pointer))
- (riece-join-channel target)
- (riece-switch-to-channel target))))
-
-(defun riece-command-join (target)
- (interactive
- (let ((completion-ignore-case t))
- (list
- (if riece-join-channel-candidate
- (let ((default (riece-format-identity
- riece-join-channel-candidate)))
- (riece-completing-read-identity
- (format (riece-mcat "Join channel/user (default %s): ") default)
- (riece-get-identities-on-server (riece-current-server-name))
- nil nil nil nil default))
- (riece-completing-read-identity
- (riece-mcat "Join channel/user: ")
- (riece-get-identities-on-server (riece-current-server-name)))))))
- (let ((pointer (riece-identity-member target riece-current-channels)))
- (if pointer
- (riece-command-switch-to-channel (car pointer))
- (if (riece-channel-p (riece-identity-prefix target))
- (riece-command-join-channel target nil)
- (riece-command-join-partner target)))))
-
-(defun riece-command-part-channel (target message)
- (unless (riece-server-opened (riece-identity-server target))
- (error "%s" (substitute-command-keys
- "Type \\[riece-command-open-server] to open server.")))
- (riece-send-string (if message
- (format "PART %s :%s\r\n"
- (riece-identity-prefix target)
- message)
- (format "PART %s\r\n"
- (riece-identity-prefix target)))
- target))
-
-(defun riece-command-part (target &optional message)
- (interactive
- (progn
- (riece-check-channel-commands-are-usable)
- (let* ((completion-ignore-case t)
- (target
- (riece-completing-read-identity
- (format (riece-mcat "Part from channel/user (default %s): ")
- (riece-format-identity riece-current-channel))
- riece-current-channels nil nil nil nil
- (riece-format-identity riece-current-channel)))
- (message
- (if current-prefix-arg
- (read-string (riece-mcat "Message: "))
- riece-part-message)))
- (list target message))))
- (if (riece-identity-member target riece-current-channels)
- (if (riece-channel-p (riece-identity-prefix target))
- (riece-command-part-channel target message)
- (riece-part-channel target))
- (error "You are not talking with %s" target)))
-
-(defun riece-command-change-nickname (nickname)
- "Change your nickname to NICK."
- (interactive "sEnter your nickname: ")
- (riece-send-string (format "NICK %s\r\n" nickname)))
-
-(defun riece-command-scroll-down (lines)
- "Scroll LINES down dialogue buffer from command buffer."
- (interactive "P")
- (let ((buffer (if (and riece-channel-buffer-mode
- riece-current-channel)
- riece-channel-buffer
- riece-dialogue-buffer)))
- (if (get-buffer-window buffer)
- (condition-case nil
- (let ((other-window-scroll-buffer buffer))
- (scroll-other-window-down lines))
- (beginning-of-buffer
- (message (riece-mcat "Beginning of buffer")))))))
-
-(defun riece-command-scroll-up (lines)
- "Scroll LINES up dialogue buffer from command buffer."
- (interactive "P")
- (let ((buffer (if (and riece-channel-buffer-mode
- riece-current-channel)
- riece-channel-buffer
- riece-dialogue-buffer)))
- (if (get-buffer-window buffer)
- (condition-case nil
- (let ((other-window-scroll-buffer buffer))
- (scroll-other-window lines))
- (end-of-buffer
- (message (riece-mcat "End of buffer")))))))
-
-(defun riece-command-user-list-scroll-down (lines)
- "Scroll LINES down user list buffer from command buffer."
- (interactive "P")
- (if (get-buffer-window riece-user-list-buffer)
- (condition-case nil
- (let ((other-window-scroll-buffer riece-user-list-buffer))
- (scroll-other-window-down lines))
- (beginning-of-buffer
- (message (riece-mcat "Beginning of buffer"))))))
-
-(defun riece-command-user-list-scroll-up (lines)
- "Scroll LINES up user list buffer from command buffer."
- (interactive "P")
- (if (get-buffer-window riece-user-list-buffer)
- (condition-case nil
- (let ((other-window-scroll-buffer riece-user-list-buffer))
- (scroll-other-window lines))
- (end-of-buffer
- (message (riece-mcat "End of buffer"))))))
-
-(defun riece-command-toggle-away (&optional message)
- "Mark yourself as being away."
- (interactive
- (if (and (not (riece-with-server-buffer (riece-identity-server
- (riece-current-nickname))
- (riece-user-get-away (riece-identity-prefix
- (riece-current-nickname)))))
- current-prefix-arg)
- (list (read-from-minibuffer
- (riece-mcat "Away message: ") (cons (or riece-away-message "")
- 0)))))
- (if (riece-with-server-buffer (riece-identity-server
- (riece-current-nickname))
- (riece-user-get-away (riece-identity-prefix
- (riece-current-nickname))))
- (riece-send-string "AWAY\r\n")
- (riece-send-string (format "AWAY :%s\r\n" (or message
- riece-away-message)))))
-
-(defun riece-command-toggle-freeze (&optional arg)
- "Prevent automatic scrolling of the dialogue window.
-If prefix argument ARG is non-nil, toggle frozen status."
- (interactive "P")
- (with-current-buffer (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (current-buffer)
- (if (and riece-channel-buffer-mode
- riece-channel-buffer)
- riece-channel-buffer
- riece-dialogue-buffer))
- (setq riece-freeze (if arg
- (< 0 (prefix-numeric-value arg))
- (not riece-freeze)))
- (riece-emit-signal 'buffer-freeze-changed
- (current-buffer) riece-freeze)))
-
-(defun riece-command-toggle-own-freeze (&optional arg)
- "Prevent automatic scrolling of the dialogue window.
-The difference from `riece-command-freeze' is that your messages are hidden.
-If prefix argument ARG is non-nil, toggle frozen status."
- (interactive "P")
- (with-current-buffer (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (current-buffer)
- (if (and riece-channel-buffer-mode
- riece-channel-buffer)
- riece-channel-buffer
- riece-dialogue-buffer))
- (if (if arg
- (< 0 (prefix-numeric-value arg))
- (not (eq riece-freeze 'own)))
- (setq riece-freeze 'own)
- (setq riece-freeze nil))
- (riece-emit-signal 'buffer-freeze-changed
- (current-buffer) riece-freeze)))
-
-(eval-when-compile
- (autoload 'riece-exit "riece"))
-(defun riece-command-quit (&optional arg)
- "Quit IRC."
- (interactive "P")
- (if (null riece-server-process-alist)
- (progn
- (message (riece-mcat "No server process"))
- (ding))
- (if (y-or-n-p (riece-mcat "Really quit IRC? "))
- (let ((message
- (if arg
- (read-string (riece-mcat "Message: "))
- riece-quit-message))
- (alist riece-server-process-alist))
- (while alist
- (riece-quit-server-process (cdr (car alist)) message)
- (setq alist (cdr alist)))))))
-
-(defun riece-command-raw (command)
- "Enter raw IRC command, which is sent to the server."
- (interactive "sIRC command: ")
- (riece-send-string (concat command "\r\n")))
-
-(defun riece-command-beginning-of-buffer ()
- "Scroll channel buffer to the beginning."
- (interactive)
- (let (buffer window)
- (setq buffer (if riece-channel-buffer-mode
- riece-channel-buffer
- riece-dialogue-buffer))
- (or (setq window (get-buffer-window buffer))
- (setq window (get-buffer-window riece-dialogue-buffer)
- buffer riece-dialogue-buffer))
- (when window
- (save-selected-window
- (select-window window)
- (goto-char (point-min))))))
-
-(defun riece-command-end-of-buffer ()
- "Scroll channel buffer to the end."
- (interactive)
- (let (buffer window)
- (setq buffer (if riece-channel-buffer-mode
- riece-channel-buffer
- riece-dialogue-buffer))
- (or (setq window (get-buffer-window buffer))
- (setq window (get-buffer-window riece-dialogue-buffer)
- buffer riece-dialogue-buffer))
- (when window
- (save-selected-window
- (select-window window)
- (goto-char (point-max))))))
-
-(defun riece-command-copy-region (start end)
- "Move current region between START and END to `kill-ring'."
- (interactive "r")
- (kill-new (buffer-substring-no-properties start end)))
-
-(defun riece-command-complete-user ()
- "Complete a user name in the current buffer."
- (interactive)
- (let* ((completion-ignore-case t)
- (table (mapcar (lambda (user)
- (list (riece-format-identity user t)))
- (riece-get-users-on-server
- (riece-current-server-name))))
- (current (or (current-word) ""))
- (completion (try-completion current table))
- (all (all-completions current table)))
- (if (eq completion t)
- nil
- (if (null completion)
- (message (riece-mcat "Can't find completion for \"%s\"") current)
- (if (equal current completion)
- (with-output-to-temp-buffer "*Help*"
- (display-completion-list all))
- (re-search-forward "\\>" nil t)
- (delete-region (point) (- (point) (length current)))
- (insert completion))))))
-
-(defun riece-command-open-server (server-name)
- (interactive
- (list (completing-read (riece-mcat "Open server: ") riece-server-alist)))
- (if (riece-server-process server-name)
- (error "%s is already opened" server-name))
- (riece-open-server
- (riece-server-name-to-server server-name)
- server-name))
-
-(defun riece-command-close-server (server-name &optional message)
- (interactive
- (list (completing-read (riece-mcat "Close server: ")
- riece-server-process-alist)
- (if current-prefix-arg
- (read-string (riece-mcat "Message: "))
- riece-quit-message)))
- (let ((process (riece-server-process server-name)))
- (unless process
- (error "%s is not opened" server-name))
- (riece-quit-server-process process message)))
-
-(defun riece-command-universal-server-name-argument ()
- (interactive)
- (let* ((riece-overriding-server-name
- (completing-read (riece-mcat "Server: ") riece-server-process-alist))
- (command
- (key-binding (read-key-sequence
- (format (riece-mcat "Command to execute on \"%s\":")
- riece-overriding-server-name)))))
- (message "")
- (call-interactively command)))
-
-(eval-when-compile
- (autoload 'riece-save-variables-files "riece"))
-(defun riece-command-save-variables ()
- "Save `riece-variables-file'."
- (interactive)
- (if (or riece-save-variables-are-dirty
- (y-or-n-p (riece-mcat "No changes made. Save anyway? ")))
- (riece-save-variables-files)))
-
-(provide 'riece-commands)
-
-;;; riece-commands.el ends here
+++ /dev/null
-;;; riece-compat.el --- compatibility functions
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece, APEL
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(if (featurep 'xemacs)
- (require 'riece-xemacs)
- (require 'riece-emacs))
-
-(defalias 'riece-mode-line-buffer-identification
- 'identity)
-
-(defun riece-simplify-mode-line-format ()
- "Remove unnecessary information from `mode-line-format'."
- (let ((value (rassq 'mode-line-modified mode-line-format)))
- (if value
- (setq mode-line-format (delq value (copy-sequence mode-line-format)))
- mode-line-format)))
-
-(defun riece-line-beginning-position ()
- (save-excursion
- (beginning-of-line)
- (point)))
-
-(defun riece-line-end-position ()
- (save-excursion
- (end-of-line)
- (point)))
-
-(autoload 'read-passwd "passwd")
-(defvar riece-read-passwd #'read-passwd)
-(defun riece-read-passwd (prompt)
- (funcall riece-read-passwd prompt))
-
-(if (string-match "0\\{0\\}" "")
- (defun riece-make-interval-regexp (regexp min &optional max)
- (if max
- (format "%s\\{%d,%d\\}" regexp min max)
- (format "%s\\{%d\\}" regexp min)))
- ;; Emacs 20.7 doesn't support \{...\} in regexps.
- (defun riece-make-interval-regexp (regexp min &optional max)
- (mapconcat #'identity
- (nconc (make-list min regexp)
- (if max
- (make-list (- max min) (concat regexp "?"))))
- "")))
-
-(provide 'riece-compat)
-
-;;; riece-compat.el ends here
+++ /dev/null
-;;; riece-complete.el --- completion
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-02-02
-;; Keywords: minibuffer, completion
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(eval-when-compile (require 'cl)) ;butlast
-
-(require 'riece-compat)
-
-(defvar riece-minibuffer-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-parent map minibuffer-local-map)
- (define-key map "?" 'riece-minibuffer-help)
- map))
-
-(defvar riece-temp-minibuffer-message nil)
-
-;; stolen (and renamed) from XEmacs's minibuf.el.
-(defun riece-temp-minibuffer-message (message)
- (let ((end (point-max)))
- (save-excursion
- (goto-char (point-max))
- (message nil)
- (insert message))
- (let ((inhibit-quit t))
- (sit-for 2)
- (delete-region end (point-max)))))
-
-(defun riece-minibuffer-help ()
- (interactive)
- (if riece-temp-minibuffer-message
- (riece-temp-minibuffer-message riece-temp-minibuffer-message)))
-
-;;; stolen (and renamed) from crm.el.
-(defvar riece-completing-read-multiple-separator ",")
-(defvar riece-completing-read-multiple-table nil)
-
-(defun riece-completing-read-multiple-1 (string predicate flag)
- "Function used by `riece-completing-read-multiple'.
-The value of STRING is the string to be completed.
-
-The value of PREDICATE is a function to filter possible matches, or
-nil if none.
-
-The value of FLAG is used to specify the type of completion operation.
-A value of nil specifies `try-completion'. A value of t specifies
-`all-completions'. A value of lambda specifes a test for an exact match.
-
-For more information on STRING, PREDICATE, and FLAG, see the Elisp
-Reference sections on 'Programmed Completion' and 'Basic Completion
-Functions'."
- (let ((except (split-string string riece-completing-read-multiple-separator))
- (table (copy-sequence riece-completing-read-multiple-table))
- lead)
- ;; Remove a partially matched word construct if it exists.
- (or (string-match
- (concat riece-completing-read-multiple-separator "$")
- string)
- (setq except (butlast except)))
- (when (string-match
- (concat ".*" riece-completing-read-multiple-separator)
- string)
- (setq lead (substring string 0 (match-end 0))
- string (substring string (match-end 0))))
- (while except
- (let ((entry (assoc (car except) table)))
- (if entry
- (setq table (delq entry table)))
- (setq except (cdr except))))
- (if (null flag)
- (progn
- (setq string (try-completion string table predicate))
- (or (eq t string)
- (concat lead string)))
- (if (eq flag 'lambda)
- (eq t (try-completion string table predicate))
- (if flag
- (all-completions string table predicate))))))
-
-(defun riece-completing-read-multiple
- (prompt table &optional predicate require-match initial-input
- history default)
- "Execute `completing-read' consequently.
-
-See the documentation for `completing-read' for details on the arguments:
-PROMPT, TABLE, PREDICATE, REQUIRE-MATCH, INITIAL-INPUT, HISTORY, DEFAULT."
- (let ((prompt
- (format "%s (separated by \"%s\"): "
- prompt riece-completing-read-multiple-separator))
- (riece-completing-read-multiple-table table))
- (split-string
- (completing-read
- prompt #'riece-completing-read-multiple-1
- predicate require-match initial-input history default)
- riece-completing-read-multiple-separator)))
-
-(provide 'riece-complete)
-
-;;; riece-complete.el ends here
+++ /dev/null
-;;; riece-ctcp.el --- CTCP (Client To Client Protocol) support
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-version)
-(require 'riece-misc)
-(require 'riece-highlight)
-(require 'riece-display)
-(require 'riece-debug)
-(require 'riece-mcat)
-
-(defface riece-ctcp-action-face
- '((((class color)
- (background dark))
- (:foreground "PaleGreen" :italic t))
- (((class color)
- (background light))
- (:foreground "ForestGreen" :italic t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Action:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-ctcp-action-face 'riece-ctcp-action-face)
-
-(defconst riece-ctcp-action-prefix "*** Action: ")
-
-(defvar riece-ctcp-ping-time nil)
-(defvar riece-ctcp-additional-clientinfo nil)
-
-(defvar riece-dialogue-mode-map)
-
-(defconst riece-ctcp-description
- "CTCP (Client To Client Protocol) support.")
-
-(defun riece-handle-ctcp-request (prefix string)
- (when (and (get 'riece-ctcp 'riece-addon-enabled) prefix string
- (riece-prefix-nickname prefix))
- (let* ((parameters (riece-split-parameters string))
- (targets (split-string (car parameters) ","))
- (message (nth 1 parameters)))
- (if (string-match "\1\\([^ ]+\\)\\( .+\\)?\1" message)
- (let ((request (downcase (match-string 1 message))))
- (if (match-beginning 2)
- (setq message (substring (match-string 2 message) 1)))
- (let ((hook
- (intern (concat "riece-ctcp-" request "-request-hook")))
- (function
- (intern-soft (concat "riece-handle-ctcp-" request
- "-request")))
- (after-hook
- (intern (concat "riece-ctcp-after-" request
- "-request-hook"))))
- (unless (riece-funcall-ignore-errors
- (symbol-name hook)
- #'run-hook-with-args-until-success
- hook prefix (car targets) message)
- (if function
- (riece-funcall-ignore-errors (symbol-name function)
- function prefix (car targets)
- message))
- (riece-funcall-ignore-errors (symbol-name after-hook)
- #'run-hook-with-args-until-success
- after-hook prefix (car targets)
- message)))
- t)))))
-
-(defun riece-handle-ctcp-version-request (prefix target string)
- (let* ((target-identity (riece-make-identity target riece-server-name))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer target-identity)))
- (user (riece-prefix-nickname prefix)))
- (riece-send-string
- (format "NOTICE %s :\1VERSION %s\1\r\n" user (riece-extended-version)))
- (riece-insert-change buffer (format "CTCP VERSION from %s\n" user))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP VERSION from %s (%s) to %s")
- user
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- (riece-format-identity target-identity t)))
- "\n"))))
-
-(defun riece-handle-ctcp-ping-request (prefix target string)
- (let* ((target-identity (riece-make-identity target riece-server-name))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer target-identity)))
- (user (riece-prefix-nickname prefix)))
- (riece-send-string
- (if string
- (format "NOTICE %s :\1PING %s\1\r\n" user string)
- (format "NOTICE %s :\1PING\1\r\n" user)))
- (riece-insert-change buffer (format "CTCP PING from %s\n" user))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP PING from %s (%s) to %s")
- user
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- (riece-format-identity target-identity t)))
- "\n"))))
-
-(defun riece-handle-ctcp-clientinfo-request (prefix target string)
- (let* ((target-identity (riece-make-identity target riece-server-name))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer target-identity)))
- (user (riece-prefix-nickname prefix)))
- (riece-send-string
- (format "NOTICE %s :\1CLIENTINFO %s\1\r\n"
- user
- (let (messages)
- (mapatoms
- (lambda (atom)
- (let ((case-fold-search t))
- (if (and (fboundp atom)
- (string-match
- "riece-handle-ctcp-\\(.+\\)-request"
- (symbol-name atom)))
- (setq messages
- (cons (match-string 1 (symbol-name atom))
- messages))))))
- (mapconcat #'upcase (append messages
- riece-ctcp-additional-clientinfo)
- " "))))
- (riece-insert-change buffer (format "CTCP CLIENTINFO from %s\n" user))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP CLIENTINFO from %s (%s) to %s")
- user
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- (riece-format-identity target-identity t)))
- "\n"))))
-
-(defun riece-handle-ctcp-action-request (prefix target string)
- (let ((buffer (if (riece-channel-p target)
- (riece-channel-buffer (riece-make-identity
- target riece-server-name))))
- (user (riece-prefix-nickname prefix)))
- (riece-insert buffer (concat riece-ctcp-action-prefix
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- " " string
- "\n"))
- (riece-insert
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat (riece-concat-server-name
- (concat riece-ctcp-action-prefix
- (riece-format-identity
- (riece-make-identity target riece-server-name)
- t)
- ": "
- (riece-format-identity
- (riece-make-identity user riece-server-name)
- t)
- " " string)) "\n"))))
-
-(defun riece-handle-ctcp-time-request (prefix target string)
- (let* ((target-identity (riece-make-identity target riece-server-name))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer target-identity)))
- (user (riece-prefix-nickname prefix))
- (time (format-time-string "%c")))
- (riece-send-string
- (format "NOTICE %s :\1TIME %s\1\r\n" user time))
- (riece-insert-change buffer (format (riece-mcat "CTCP TIME from %s\n")
- user))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP TIME from %s (%s) to %s")
- user
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- (riece-format-identity target-identity t)))
- "\n"))))
-
-(defun riece-handle-ctcp-response (prefix string)
- (when (and (get 'riece-ctcp 'riece-addon-enabled) prefix string
- (riece-prefix-nickname prefix))
- (let* ((parameters (riece-split-parameters string))
- (targets (split-string (car parameters) ","))
- (message (nth 1 parameters)))
- (if (string-match "\1\\([^ ]+\\)\\( .+\\)?\1" message)
- (let ((response (downcase (match-string 1 message))))
- (if (match-beginning 2)
- (setq message (substring (match-string 2 message) 1)))
- (let ((hook
- (intern (concat "riece-ctcp-" response "-response-hook")))
- (function (intern-soft (concat "riece-handle-ctcp-"
- response "-response")))
- (after-hook
- (intern (concat "riece-ctcp-after-" response
- "-response-hook"))))
- (unless (riece-funcall-ignore-errors
- (symbol-name hook)
- #'run-hook-with-args-until-success
- hook prefix (car targets) message)
- (if function
- (riece-funcall-ignore-errors
- (symbol-name function)
- function prefix (car targets) message))
- (riece-funcall-ignore-errors (symbol-name after-hook)
- #'run-hook-with-args-until-success
- after-hook prefix (car targets)
- message)))
- t)))))
-
-(defun riece-handle-ctcp-version-response (prefix target string)
- (riece-insert-change
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP VERSION for %s (%s) = %s")
- (riece-prefix-nickname prefix)
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- string))
- "\n")))
-
-(defun riece-handle-ctcp-ping-response (prefix target string)
- (let* ((now (current-time))
- (elapsed (+ (* 65536 (- (car now) (car riece-ctcp-ping-time)))
- (- (nth 1 now) (nth 1 riece-ctcp-ping-time)))))
- (riece-insert-change
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP PING for %s (%s) = %d sec")
- (riece-prefix-nickname prefix)
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- elapsed))
- "\n"))))
-
-(defun riece-handle-ctcp-clientinfo-response (prefix target string)
- (riece-insert-change
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP CLIENTINFO for %s (%s) = %s")
- (riece-prefix-nickname prefix)
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- string))
- "\n")))
-
-(defun riece-handle-ctcp-time-response (prefix target string)
- (riece-insert-change
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "CTCP TIME for %s (%s) = %s")
- (riece-prefix-nickname prefix)
- (riece-strip-user-at-host (riece-prefix-user-at-host prefix))
- string))
- "\n")))
-
-(defun riece-command-ctcp-version (target)
- (interactive
- (list (riece-completing-read-identity
- (riece-mcat "Channel/User: ")
- (riece-get-identities-on-server (riece-current-server-name)))))
- (riece-send-string (format "PRIVMSG %s :\1VERSION\1\r\n"
- (riece-identity-prefix target))))
-
-(defun riece-command-ctcp-ping (target)
- (interactive
- (list (riece-completing-read-identity
- (riece-mcat "Channel/User: ")
- (riece-get-identities-on-server (riece-current-server-name)))))
- (riece-send-string (format "PRIVMSG %s :\1PING\1\r\n"
- (riece-identity-prefix target)))
- (setq riece-ctcp-ping-time (current-time)))
-
-(defun riece-command-ctcp-clientinfo (target)
- (interactive
- (list (riece-completing-read-identity
- (riece-mcat "Channel/User: ")
- (riece-get-identities-on-server (riece-current-server-name)))))
- (riece-send-string (format "PRIVMSG %s :\1CLIENTINFO\1\r\n"
- (riece-identity-prefix target))))
-
-(defun riece-command-ctcp-action (target action)
- (interactive
- (list (if current-prefix-arg
- (riece-completing-read-identity
- (riece-mcat "Channel/User: ")
- (riece-get-identities-on-server (riece-current-server-name)))
- riece-current-channel)
- (let (message)
- (beginning-of-line)
- (setq message (buffer-substring (point)
- (progn (end-of-line) (point))))
- (if (equal message "")
- (read-string (riece-mcat "Action: "))
- (prog1 (read-from-minibuffer (riece-mcat "Action: ")
- (cons message 0))
- (let ((next-line-add-newlines t))
- (next-line 1)))))))
- (if (equal action "")
- (error "No action"))
- (riece-send-string (format "PRIVMSG %s :\1ACTION %s\1\r\n"
- (riece-identity-prefix target)
- action))
- (let ((buffer (riece-channel-buffer target)))
- (riece-insert
- buffer
- (concat riece-ctcp-action-prefix
- (riece-identity-prefix (riece-current-nickname)) " " action "\n"))
- (riece-insert
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-with-server-buffer (riece-identity-server target)
- (riece-concat-server-name
- (concat riece-ctcp-action-prefix
- (riece-format-identity target t) ": "
- (riece-identity-prefix (riece-current-nickname)) " " action)))
- "\n"))))
-
-(defun riece-command-ctcp-time (target)
- (interactive
- (list (riece-completing-read-identity
- (riece-mcat "Channel/User: ")
- (riece-get-identities-on-server (riece-current-server-name)))))
- (riece-send-string (format "PRIVMSG %s :\1TIME\1\r\n"
- (riece-identity-prefix target))))
-
-(defun riece-ctcp-requires ()
- (if (memq 'riece-highlight riece-addons)
- '(riece-highlight)))
-
-(defvar riece-ctcp-dialogue-font-lock-keywords
- (list (concat "^" riece-time-prefix-regexp "\\("
- (regexp-quote riece-ctcp-action-prefix)
- ".*\\)$")
- 1 riece-ctcp-action-face t t))
-
-(defun riece-ctcp-insinuate ()
- (add-hook 'riece-privmsg-hook 'riece-handle-ctcp-request)
- (add-hook 'riece-notice-hook 'riece-handle-ctcp-response)
- (if (memq 'riece-highlight riece-addons)
- (setq riece-dialogue-font-lock-keywords
- (cons riece-ctcp-dialogue-font-lock-keywords
- riece-dialogue-font-lock-keywords))))
-
-(defun riece-ctcp-uninstall ()
- (remove-hook 'riece-privmsg-hook 'riece-handle-ctcp-request)
- (remove-hook 'riece-notice-hook 'riece-handle-ctcp-response)
- (setq riece-dialogue-font-lock-keywords
- (delq riece-ctcp-dialogue-font-lock-keywords
- riece-dialogue-font-lock-keywords)))
-
-(defun riece-ctcp-enable ()
- (define-key riece-dialogue-mode-map "\C-cv" 'riece-command-ctcp-version)
- (define-key riece-dialogue-mode-map "\C-cp" 'riece-command-ctcp-ping)
- (define-key riece-dialogue-mode-map "\C-ca" 'riece-command-ctcp-action)
- (define-key riece-dialogue-mode-map "\C-cc" 'riece-command-ctcp-clientinfo)
- (define-key riece-dialogue-mode-map "\C-ct" 'riece-command-ctcp-time))
-
-(defun riece-ctcp-disable ()
- (define-key riece-dialogue-mode-map "\C-cv" nil)
- (define-key riece-dialogue-mode-map "\C-cp" nil)
- (define-key riece-dialogue-mode-map "\C-ca" nil)
- (define-key riece-dialogue-mode-map "\C-cc" nil)
- (define-key riece-dialogue-mode-map "\C-ct" nil))
-
-(provide 'riece-ctcp)
-
-;;; riece-ctcp.el ends here
+++ /dev/null
-;;; riece-ctlseq.el --- mark up control sequences in IRC buffers
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-message)
-(require 'riece-misc)
-
-(defgroup riece-ctlseq nil
- "Mark up control sequences in IRC buffer."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-ctlseq-colors
- '("white" "black" "red" "orange" "yellow" "LightGreen" "DarkOliveGreen"
- "cyan4" "turquoise" "blue" "black" "black" "black" "black" "black"
- "DarkBlue" "purple1" "purple2" "purple3" "magenta")
- "List of colors can be used with ^C<fg>,<bg>."
- :group 'riece-ctlseq
- :type '(repeat (string :tag "Color")))
-
-(defcustom riece-ctlseq-hide-controls t
- "If non-nil, control characters are hidden."
- :group 'riece-ctlseq
- :type 'boolean)
-
-(defcustom riece-ctlseq-face-cache-size 128
- "Maximum length of the internal face cache."
- :group 'riece-ctlseq
- :type 'integer)
-
-(defvar riece-ctlseq-face-cache nil)
-(defvar riece-ctlseq-face-counter 0)
-
-(defconst riece-ctlseq-description
- "Mark up control sequences in IRC buffers.")
-
-(defun riece-ctlseq-compatible-attributes-p (this other)
- (let ((pointer this))
- (catch 'mismatched
- (while pointer
- (unless (equal (plist-get other (car pointer)) (nth 1 pointer))
- (throw 'mismatched nil))
- (setq pointer (nthcdr 2 pointer)))
- t)))
-
-(defun riece-ctlseq-face-foreground-name (face)
- "Return the name of FACE's foreground color."
- (if (fboundp 'face-foreground-name) ;XEmacs
- (face-foreground-name face)
- (face-foreground face)))
-
-(defun riece-ctlseq-face-background-name (face)
- "Return the name of FACE's background color."
- (if (fboundp 'face-background-name) ;XEmacs
- (face-background-name face)
- (face-background face)))
-
-(defun riece-ctlseq-make-face (attrs)
- (let* ((face-name (intern (format "riece-ctlseq-face-%d"
- (prog1 riece-ctlseq-face-counter
- (setq riece-ctlseq-face-counter
- (1+ riece-ctlseq-face-counter))))))
- (face (make-face face-name))
- foreground
- background)
- (if (plist-get attrs 'bold)
- (make-face-bold face))
- (if (plist-get attrs 'underline)
- (set-face-underline-p face t))
- (if (setq foreground (plist-get attrs 'foreground))
- (set-face-foreground face foreground))
- (if (setq background (plist-get attrs 'background))
- (set-face-background face background))
- (when (plist-get attrs 'inverse-video)
- (setq foreground (or (riece-ctlseq-face-background-name face)
- (riece-ctlseq-face-background-name 'default))
- background (or (riece-ctlseq-face-foreground-name face)
- (riece-ctlseq-face-foreground-name 'default)))
- (set-face-foreground face foreground)
- (set-face-background face background))
- (put face-name 'riece-ctlseq-attributes attrs)
- face-name))
-
-(defun riece-ctlseq-face-from-cache (attrs)
- (if (null attrs)
- 'default
- (let ((pointer riece-ctlseq-face-cache)
- last-pointer
- other)
- (catch 'found
- (while pointer
- (setq other (get (car pointer) 'riece-ctlseq-attributes))
- (when (and (riece-ctlseq-compatible-attributes-p attrs other)
- (riece-ctlseq-compatible-attributes-p other attrs))
- (if last-pointer
- (setcdr last-pointer (cdr pointer)))
- (throw 'found (setcar riece-ctlseq-face-cache (car pointer))))
- (setq last-pointer pointer
- pointer (cdr pointer)))
- (if (>= (length riece-ctlseq-face-cache)
- riece-ctlseq-face-cache-size)
- (setq riece-ctlseq-face-cache
- (butlast riece-ctlseq-face-cache)))
- (setq riece-ctlseq-face-cache
- (cons (riece-ctlseq-make-face attrs)
- riece-ctlseq-face-cache))
- (car riece-ctlseq-face-cache)))))
-
-(defun riece-ctlseq-update-attributes (tag attrs)
- (cond
- ((eq (aref tag 0) ?\x2) ;^B
- (plist-put attrs 'bold (not (plist-get attrs 'bold))))
- ((eq (aref tag 0) ?\xF)) ;^O
- ((eq (aref tag 0) ?\x16) ;^V
- (plist-put attrs 'inverse-video (not (plist-get attrs 'inverse-video))))
- ((eq (aref tag 0) ?\x1F) ;^_
- (plist-put attrs 'underline (not (plist-get attrs 'underline))))
- ((string-match "\x3\\([0-9]+\\)?\\(,[0-9]+\\)?" tag) ;^C<fg>,<bg>
- (if (match-beginning 1)
- (setq attrs (plist-put attrs 'foreground
- (nth (string-to-number (match-string 1 tag))
- riece-ctlseq-colors))))
- (if (match-beginning 2)
- (setq attrs (plist-put attrs 'background
- (nth (string-to-number
- (substring (match-string 2 tag) 1))
- riece-ctlseq-colors))))
- attrs)))
-
-(defun riece-ctlseq-message-filter (message)
- (if (get 'riece-ctlseq 'riece-addon-enabled)
- (let ((start 0)
- (end (length (riece-message-text message)))
- attrs)
- (while (string-match
- "[\x2\xF\x16\x1F]\\|\x3\\([0-9]+\\)?\\(,[0-9]+\\)?"
- (riece-message-text message) start)
- (if riece-ctlseq-hide-controls
- (put-text-property (match-beginning 0) (match-end 0)
- 'invisible 'riece-ctlseq
- (riece-message-text message)))
- (if attrs
- (put-text-property start (match-beginning 0)
- 'riece-ctlseq-attributes (copy-sequence attrs)
- (riece-message-text message)))
- (setq start (match-end 0)
- attrs (riece-ctlseq-update-attributes
- (match-string 0 (riece-message-text message)) attrs)))
- (if (and (< start end) attrs)
- (put-text-property start end
- 'riece-overlay-face
- (riece-ctlseq-face-from-cache attrs)
- (riece-message-text message)))))
- message)
-
-(defun riece-ctlseq-requires ()
- '(riece-highlight))
-
-(defun riece-ctlseq-insinuate ()
- (add-hook 'riece-message-filter-functions 'riece-ctlseq-message-filter))
-
-(defun riece-ctlseq-uninstall ()
- (remove-hook 'riece-message-filter-functions 'riece-ctlseq-message-filter))
-
-(provide 'riece-ctlseq)
-
-;;; riece-ctlseq.el ends here
+++ /dev/null
-;;; riece-debug.el --- debug support
-;; Copyright (C) 1998-2005 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-options)
-
-(defun riece-debug-1 (message detail)
- (message "riece-debug: %s" message)
- (save-excursion
- (set-buffer riece-debug-buffer)
- (goto-char (point-max))
- (let ((time (format-time-string "%Y-%m-%d:%H:%M:%S")))
- (if detail
- (insert "*** " time ": " message "\n" detail "\n")
- (insert "*** " time ": " message "\n")))))
-
-(defun riece-debug (message &optional detail)
- "Print a one-line debug MESSAGE at the bottom of the frame.
-If the optional 2nd argument DETAIL is specified, it is stored into
-`riece-debug-buffer'."
- (ignore (riece-debug-1 message detail)))
-
-(defun riece-debug-reset-standard-output ()
- "Reset `riece-temp-buffer' to be used as `standard-output'."
- (save-excursion
- (set-buffer riece-temp-buffer)
- (buffer-disable-undo)
- (erase-buffer)))
-
-(defmacro riece-debug-with-backtrace (&rest body)
- "Execute BODY and send a backtrace to `riece-temp-buffer'."
- `(unwind-protect
- (progn ,@body)
- (riece-debug-reset-standard-output)
- (let ((standard-output riece-temp-buffer))
- (backtrace))))
-
-(put 'riece-debug-with-backtrace 'lisp-indent-function 0)
-(put 'riece-debug-with-backtrace 'edebug-form-spec '(form body))
-
-(defmacro riece-ignore-errors (location &rest body)
- "Execute BODY; if an error occurs, return nil.
-Otherwise, return result of last FORM.
-If `riece-debug' is non-nil and an error occurred, it sends a
-backtrace to standard-output."
- `(condition-case error
- (if riece-debug
- (riece-debug-with-backtrace ,@body)
- ,@body)
- (error
- (if riece-debug
- (save-excursion
- (set-buffer riece-temp-buffer)
- (goto-char (point-min))
- (if (re-search-forward "^ signal(" nil t)
- (delete-region (point-min) (match-beginning 0)))
- (riece-debug (format "Error in `%s': %S" ,location error)
- (buffer-string))))
- nil)))
-
-(put 'riece-ignore-errors 'lisp-indent-function 1)
-(put 'riece-ignore-errors 'edebug-form-spec '(form body))
-
-(defun riece-funcall-ignore-errors (location function &rest args)
- "Call FUNCTION with ARGS; if an error occurs, return nil.
-Otherwise, return result of the function.
-If `riece-debug' is non-nil and an error occurred, it sends a
-backtrace to standard-output."
- (riece-ignore-errors location
- (apply function args)))
-
-(provide 'riece-debug)
-
-;;; riece-debug.el ends here
+++ /dev/null
-(defun riece-insert-struct-template (prefix struct)
- (interactive "sPrefix:
-sStruct: ")
- (let (attributes
- optional-attributes
- name
- pointer
- arglist
- strings
- (index 0))
- (if (and prefix
- (not (string-match "-\\'" prefix)))
- (setq prefix (concat prefix "-")))
- (catch 'finish
- (while t
- (setq name (read-from-minibuffer "Attribute: "))
- (if (equal name "")
- (throw 'finish nil))
- (setq attributes
- (cons (vector name
- (y-or-n-p "Optional? ")
- (y-or-n-p "Readable? ")
- (y-or-n-p "Writable? "))
- attributes))))
- (setq attributes (nreverse attributes)
- pointer (cons (vector "" nil nil nil) attributes))
- (while (cdr pointer)
- (if (aref (car (cdr pointer)) 1)
- (progn
- (setq optional-attributes (cons (car (cdr pointer))
- optional-attributes))
- (setcdr pointer (nthcdr 2 pointer)))
- (setq pointer (cdr pointer))))
- (setq optional-attributes (nreverse optional-attributes)
- arglist (mapconcat (lambda (attribute)
- (aref attribute 0))
- attributes " "))
- (if optional-attributes
- (setq arglist (concat arglist " &optional "
- (mapconcat (lambda (attribute)
- (aref attribute 0))
- optional-attributes " "))))
- (setq strings (list (format "\
-\(defun %smake-%s (%s)
- \"Make %s%s object.\"
- (vector %s))"
- prefix struct arglist
- prefix struct
- (mapconcat (lambda (attribute)
- (aref attribute 0))
- (append attributes
- optional-attributes)
- " "))))
- (setq pointer (append attributes optional-attributes))
- (while pointer
- (if (aref (car pointer) 2)
- (setq strings (cons (format "\
-\(defun %s%s-%s (%s)
- \"Return %s of %s.\"
- (aref %s %d))"
- prefix struct (aref (car pointer) 0)
- struct
- (aref (car pointer) 0)
- (upcase struct)
- struct index)
- strings)))
- (if (aref (car pointer) 3)
- (setq strings (cons (format "\
-\(defun %s%s-set-%s (%s %s)
- \"Set %s of %s to %s.\"
- (aset %s %d %s))"
- prefix struct (aref (car pointer) 0)
- struct (aref (car pointer) 0)
- (aref (car pointer) 0)
- (upcase struct)
- (upcase (aref (car pointer) 0))
- struct index (aref (car pointer) 0))
- strings)))
- (setq pointer (cdr pointer)
- index (1+ index)))
- (insert (mapconcat #'identity (nreverse strings) "\n\n"))))
+++ /dev/null
-;;; riece-display.el --- buffer arrangement
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-channel)
-(require 'riece-misc)
-(require 'riece-layout)
-(require 'riece-signal)
-(require 'riece-mcat)
-
-(autoload 'derived-mode-class "derived")
-
-(defvar riece-channel-buffer-format "*Channel:%s*"
- "Format of channel message buffer.")
-(defvar riece-channel-buffer-alist nil
- "An alist mapping identities to channel buffers.")
-
-(defvar riece-update-buffer-functions nil
- "Functions to redisplay the buffer.
-Local to the buffer in `riece-buffer-list'.")
-
-(defvar riece-update-indicator-functions
- '(riece-update-status-indicators
- riece-update-channel-status-indicator
- riece-update-channel-indicator
- riece-update-long-channel-indicator
- riece-update-channel-list-indicator)
- "Functions to update modeline indicators.")
-
-(defun riece-display-connect-signals ()
- (riece-connect-signal
- 'channel-list-changed
- (lambda (signal handback)
- (save-excursion
- (set-buffer riece-channel-list-buffer)
- (run-hooks 'riece-update-buffer-functions))
- (riece-update-channel-list-indicator)))
- (riece-connect-signal
- 'user-list-changed
- (lambda (signal handback)
- (save-excursion
- (set-buffer riece-user-list-buffer)
- (run-hooks 'riece-update-buffer-functions)))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'channel-switched
- (lambda (signal handback)
- (riece-update-status-indicators)
- (riece-update-channel-status-indicator)
- (riece-update-channel-indicator)
- (riece-update-long-channel-indicator)
- (force-mode-line-update t)
- (riece-emit-signal 'channel-list-changed)
- (riece-emit-signal 'user-list-changed riece-current-channel)
- (save-excursion
- (riece-redraw-layout))))
- (riece-connect-signal
- 'user-joined-channel
- (lambda (signal handback)
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (nth 1 (riece-signal-args signal))
- riece-current-channel)
- (not (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))))
- (riece-connect-signal
- 'user-joined-channel
- (lambda (signal handback)
- (riece-join-channel (nth 1 (riece-signal-args signal)))
- (riece-switch-to-channel (nth 1 (riece-signal-args signal)))
- (setq riece-join-channel-candidate nil))
- (lambda (signal)
- (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))
- (riece-connect-signal
- 'user-left-channel
- (lambda (signal handback)
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (nth 1 (riece-signal-args signal))
- riece-current-channel)
- (not (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))))
- (riece-connect-signal
- 'user-left-channel
- (lambda (signal handback)
- (riece-part-channel (nth 1 (riece-signal-args signal))))
- (lambda (signal)
- (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))
- (riece-connect-signal
- 'user-renamed
- (lambda (signal handback)
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (lambda (signal)
- (and riece-current-channel
- (equal (riece-identity-server (nth 1 (riece-signal-args signal)))
- (riece-identity-server riece-current-channel))
- (riece-with-server-buffer (riece-identity-server
- riece-current-channel)
- (when (riece-channel-p (riece-identity-prefix
- riece-current-channel))
- (riece-identity-assoc
- (riece-identity-prefix (nth 1 (riece-signal-args signal)))
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))
- t))))))
- (riece-connect-signal
- 'user-renamed
- (lambda (signal handback)
- (riece-update-status-indicators)
- (riece-update-channel-indicator)
- (force-mode-line-update t))
- (lambda (signal)
- (riece-identity-equal (nth 1 (riece-signal-args signal))
- (riece-current-nickname))))
- (riece-connect-signal
- 'user-renamed
- (lambda (signal handback)
- (riece-switch-to-channel (nth 1 (riece-signal-args signal))))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'user-renamed
- (lambda (signal handback)
- (let* ((old-identity (car (riece-signal-args signal)))
- (new-identity (nth 1 (riece-signal-args signal)))
- (pointer (riece-identity-member old-identity
- riece-current-channels)))
- ;; Rename the channel buffer.
- (when pointer
- (setcar pointer new-identity)
- (with-current-buffer (riece-channel-buffer old-identity)
- (rename-buffer (riece-channel-buffer-name new-identity) t)
- (setq riece-channel-buffer-alist
- (cons (cons new-identity (current-buffer))
- (delq (riece-identity-assoc old-identity
- riece-channel-buffer-alist)
- riece-channel-buffer-alist))))))))
- (riece-connect-signal
- 'user-away-changed
- (lambda (signal handback)
- (riece-update-status-indicators)
- (force-mode-line-update t))
- (lambda (signal)
- (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))
- (riece-connect-signal
- 'user-operator-changed
- (lambda (signal handback)
- (riece-update-status-indicators)
- (force-mode-line-update t))
- (lambda (signal)
- (riece-identity-equal (car (riece-signal-args signal))
- (riece-current-nickname))))
- (riece-connect-signal
- 'channel-topic-changed
- (lambda (signal handback)
- (riece-update-long-channel-indicator)
- (force-mode-line-update t))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'channel-modes-changed
- (lambda (signal handback)
- (riece-update-long-channel-indicator)
- (force-mode-line-update t))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'channel-operators-changed
- (lambda (signal handback)
- (riece-update-channel-status-indicator)
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'channel-speakers-changed
- (lambda (signal handback)
- (riece-update-channel-status-indicator)
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (lambda (signal)
- (and riece-current-channel
- (riece-identity-equal (car (riece-signal-args signal))
- riece-current-channel))))
- (riece-connect-signal
- 'buffer-freeze-changed
- (lambda (signal handback)
- (riece-update-status-indicators)
- (force-mode-line-update t))))
-
-(defun riece-update-user-list-buffer ()
- (save-excursion
- (if (and riece-current-channel
- (riece-channel-p (riece-identity-prefix riece-current-channel)))
- (let* ((users
- (riece-with-server-buffer (riece-identity-server
- riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))))
- (inhibit-read-only t)
- buffer-read-only)
- (erase-buffer)
- (riece-kill-all-overlays)
- (while users
- (insert (if (memq ?o (cdr (car users)))
- "@"
- (if (memq ?v (cdr (car users)))
- "+"
- " "))
- (riece-format-identity
- (riece-make-identity (car (car users))
- (riece-identity-server
- riece-current-channel))
- t)
- "\n")
- (setq users (cdr users)))))))
-
-(defun riece-format-identity-for-channel-list-buffer (index identity)
- (or (run-hook-with-args-until-success
- 'riece-format-identity-for-channel-list-buffer-functions index identity)
- (concat (format "%2d:%c" index
- (if (riece-identity-equal identity riece-current-channel)
- ?*
- ? ))
- (riece-format-identity identity))))
-
-(defun riece-update-channel-list-buffer ()
- (save-excursion
- (let ((inhibit-read-only t)
- buffer-read-only
- (index 1)
- (channels riece-current-channels))
- (erase-buffer)
- (riece-kill-all-overlays)
- (while channels
- (if (car channels)
- (insert (riece-format-identity-for-channel-list-buffer
- index (car channels))
- "\n"))
- (setq index (1+ index)
- channels (cdr channels))))))
-
-(defun riece-update-channel-indicator ()
- (setq riece-channel-indicator
- (if riece-current-channel
- (riece-format-identity riece-current-channel)
- (riece-mcat "None"))))
-
-(defun riece-update-long-channel-indicator ()
- (setq riece-long-channel-indicator
- (if riece-current-channel
- (if (riece-channel-p (riece-identity-prefix riece-current-channel))
- (riece-concat-channel-topic
- riece-current-channel
- (riece-concat-channel-modes
- riece-current-channel
- (riece-format-identity riece-current-channel)))
- (riece-format-identity riece-current-channel))
- (riece-mcat "None"))))
-
-(defun riece-format-identity-for-channel-list-indicator (index identity)
- (or (run-hook-with-args-until-success
- 'riece-format-identity-for-channel-list-indicator-functions
- index identity)
- (let ((string (riece-format-identity identity))
- (start 0))
- ;; Escape % -> %%.
- (while (string-match "%" string start)
- (setq start (1+ (match-end 0))
- string (replace-match "%%" nil nil string)))
- (format "%d:%s" index string))))
-
-(defun riece-update-channel-list-indicator ()
- (if (and riece-current-channels
- ;; There is at least one channel.
- (delq nil (copy-sequence riece-current-channels)))
- (let ((index 1)
- pointer)
- (setq riece-channel-list-indicator
- (delq
- nil
- (mapcar
- (lambda (channel)
- (prog1
- (if channel
- (riece-format-identity-for-channel-list-indicator
- index channel))
- (setq index (1+ index))))
- riece-current-channels))
- pointer riece-channel-list-indicator)
- (while pointer
- (if (cdr pointer)
- (setcdr pointer (cons "," (cdr pointer))))
- (setq pointer (cdr (cdr pointer))))
- (setq riece-channel-list-indicator
- (riece-normalize-modeline-string riece-channel-list-indicator)))
- (setq riece-channel-list-indicator (riece-mcat "No channel"))))
-
-(defun riece-update-status-indicators ()
- (let ((server-name (riece-current-server-name)))
- (if server-name
- (with-current-buffer riece-command-buffer
- (riece-with-server-buffer server-name
- (setq riece-away-indicator
- (if (and riece-real-nickname
- (riece-user-get-away riece-real-nickname))
- "A"
- "-")
- riece-operator-indicator
- (if (and riece-real-nickname
- (riece-user-get-operator riece-real-nickname))
- "O"
- "-")
- riece-user-indicator
- (riece-format-identity
- (riece-make-identity riece-real-nickname riece-server-name)
- t))))))
- (walk-windows
- (lambda (window)
- (with-current-buffer (window-buffer window)
- (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (setq riece-freeze-indicator
- (if (eq riece-freeze 'own)
- "f"
- (if riece-freeze
- "F"
- "-"))))))))
-
-(defun riece-update-channel-status-indicator ()
- (if (and riece-current-channel
- (riece-channel-p (riece-identity-prefix riece-current-channel)))
- (let ((users
- (riece-with-server-buffer (riece-identity-server
- riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel))))
- (nickname
- (riece-with-server-buffer (riece-identity-server
- riece-current-channel)
- riece-real-nickname)))
- (with-current-buffer riece-command-buffer
- (setq riece-channel-status-indicator
- (if nickname
- (let ((user (cdr (riece-identity-assoc nickname users t))))
- (if (memq ?o user)
- "@"
- (if (memq ?v user)
- "+"
- "-")))
- "-"))))))
-
-(defun riece-update-buffers (&optional buffers)
- (unless buffers
- (setq buffers riece-buffer-list))
- (while buffers
- (if (buffer-live-p (car buffers))
- (save-excursion
- (set-buffer (car buffers))
- (run-hooks 'riece-update-buffer-functions)))
- (setq buffers (cdr buffers)))
- (run-hooks 'riece-update-indicator-functions)
- (force-mode-line-update t)
- (run-hooks 'riece-update-buffer-hook))
-
-(defun riece-channel-buffer-name (identity)
- (let ((channels (riece-identity-member identity riece-current-channels)))
- (if channels
- (setq identity (car channels))
- (if riece-debug
- (riece-debug (format "%S is not a member of riece-current-channels"
- identity))))
- (format riece-channel-buffer-format (riece-format-identity identity))))
-
-(eval-when-compile
- (autoload 'riece-channel-mode "riece"))
-(defun riece-channel-buffer-create (identity)
- (with-current-buffer
- (riece-get-buffer-create (riece-channel-buffer-name identity)
- 'riece-channel-mode)
- (setq riece-channel-buffer-alist
- (cons (cons identity (current-buffer))
- riece-channel-buffer-alist))
- (unless (eq major-mode 'riece-channel-mode)
- (riece-channel-mode)
- (let (buffer-read-only)
- (riece-insert-info (current-buffer)
- (format (riece-mcat "Created on %s\n")
- (funcall riece-format-time-function
- (current-time))))
- (run-hook-with-args 'riece-channel-buffer-create-functions identity)))
- (current-buffer)))
-
-(defun riece-channel-buffer (identity)
- (let ((entry (riece-identity-assoc identity riece-channel-buffer-alist)))
- (if entry
- (if (buffer-live-p (cdr entry))
- (cdr entry)
- (if riece-debug
- (riece-debug
- (format "riece-channel-buffer: nonexistent buffer: %s"
- (riece-format-identity identity))))))))
-
-(defun riece-switch-to-channel (identity)
- (let ((last riece-current-channel)
- window)
- (if (and riece-channel-buffer
- (setq window (get-buffer-window riece-channel-buffer)))
- (with-current-buffer riece-channel-buffer
- (setq riece-channel-buffer-window-point (window-point window))))
- (setq riece-current-channel identity
- riece-channel-buffer (riece-channel-buffer riece-current-channel))
- (run-hook-with-args 'riece-after-switch-to-channel-functions last)
- (riece-emit-signal 'channel-switched)))
-
-(defun riece-join-channel (identity)
- (unless (riece-identity-member identity riece-current-channels)
- (setq riece-current-channels
- (riece-identity-assign-binding
- identity riece-current-channels
- (mapcar
- (lambda (channel)
- (if channel
- (riece-parse-identity channel)))
- riece-default-channel-binding)))
- (riece-channel-buffer-create identity)))
-
-(defun riece-switch-to-nearest-channel (pointer)
- (let ((start riece-current-channels)
- identity)
- (while (and start (not (eq start pointer)))
- (if (car start)
- (setq identity (car start)))
- (setq start (cdr start)))
- (unless identity
- (while (and pointer
- (null (car pointer)))
- (setq pointer (cdr pointer)))
- (setq identity (car pointer)))
- (if identity
- (riece-switch-to-channel identity)
- (let ((last riece-current-channel))
- (run-hook-with-args 'riece-after-switch-to-channel-functions last)
- (setq riece-current-channel nil)
- (riece-emit-signal 'channel-switched)))))
-
-(defun riece-part-channel (identity)
- (let ((pointer (riece-identity-member identity riece-current-channels)))
- (unless pointer
- (error "No such channel!"))
- (setcar pointer nil)
- (if (riece-identity-equal identity riece-current-channel)
- (riece-switch-to-nearest-channel pointer)
- (riece-emit-signal 'channel-list-changed))
- (funcall riece-buffer-dispose-function (riece-channel-buffer identity))))
-
-(defun riece-redisplay-buffers (&optional force)
- (riece-update-buffers)
- (riece-redraw-layout force)
- (run-hooks 'riece-redisplay-buffers-hook))
-
-(provide 'riece-display)
-
-;;; riece-display.el ends here
+++ /dev/null
-;;; riece-doctor.el --- pretend to be a psychotherapist
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-identity)
-(require 'riece-message)
-(require 'riece-server)
-
-(defgroup riece-doctor nil
- "Interface to doctor.el."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-doctor-hello-regexp "^,doctor$"
- "Pattern of string patients start consultation."
- :type 'string
- :group 'riece-doctor)
-
-(defcustom riece-doctor-bye-regexp "^,doctor bye$"
- "Pattern of string patients end consultation."
- :type 'string
- :group 'riece-doctor)
-
-(defvar riece-doctor-patients nil)
-
-(defconst riece-doctor-description
- "Pretend to be a psychotherapist.")
-
-(put 'riece-doctor 'riece-addon-default-disabled t)
-
-(autoload 'doctor-mode "doctor")
-(autoload 'doctor-read-print "doctor")
-
-(defun riece-doctor-buffer-name (user)
- (concat " *riece-doctor*"
- (riece-format-identity
- (riece-make-identity user riece-server-name))))
-
-(defun riece-doctor-reply (target string)
- (riece-display-message
- (riece-make-message (riece-make-identity riece-real-nickname
- riece-server-name)
- (riece-make-identity target riece-server-name)
- string 'notice t))
- (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
-
-(defun riece-doctor-after-privmsg-hook (prefix string)
- (if (get 'riece-doctor 'riece-addon-enabled)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters string))
- (targets (split-string (car parameters) ","))
- (message (nth 1 parameters)))
- (if (string-match riece-doctor-hello-regexp message)
- (if (riece-identity-member user riece-doctor-patients t)
- (riece-doctor-reply
- (car targets)
- (format "%s: You are already talking with me." user))
- (save-excursion
- (set-buffer (get-buffer-create
- (riece-doctor-buffer-name user)))
- (erase-buffer)
- (doctor-mode))
- (setq riece-doctor-patients (cons user riece-doctor-patients))
- (riece-doctor-reply
- (car targets)
- (format
- "%s: I am the psychotherapist. \
-Please, describe your problems."
- user)))
- (if (string-match riece-doctor-bye-regexp message)
- (let ((pointer (riece-identity-member user
- riece-doctor-patients t)))
- (when pointer
- (kill-buffer (riece-doctor-buffer-name user))
- (setq riece-doctor-patients (delq (car pointer)
- riece-doctor-patients))
- (riece-doctor-reply
- (car targets)
- (format "%s: Good bye." user))))
- (if (riece-identity-member user riece-doctor-patients t)
- (let (string)
- (save-excursion
- (set-buffer (get-buffer (riece-doctor-buffer-name user)))
- (goto-char (point-max))
- (insert message "\n")
- (let ((point (point)))
- (doctor-read-print)
- (setq string (buffer-substring (1+ point)
- (- (point) 2))))
- (with-temp-buffer
- (insert string)
- (subst-char-in-region (point-min) (point-max) ?\n ? )
- (setq string (buffer-string))))
- (riece-doctor-reply
- (car targets)
- (format "%s: %s" user string)))))))))
-
-(defun riece-doctor-insinuate ()
- (add-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook))
-
-(defun riece-doctor-uninstall ()
- (remove-hook 'riece-after-privmsg-hook 'riece-doctor-after-privmsg-hook))
-
-(provide 'riece-doctor)
-
-;;; riece-doctor.el ends here
+++ /dev/null
-;;; riece-emacs.el --- FSF Emacs specific functions
-;; Copyright (C) 1999 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1999-08-21
-;; Keywords: emulation
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-;;; stolen (and renamed) from gnus-ems.el.
-;;; In GNU Emacs, user can intercept whole mouse tracking events by
-;;; assigning [mouse-X]. In XEmacs, however, which causes different
-;;; effect, that is, the command assigned to [mouse-X] only catches
-;;; button-release events.
-(defvar riece-mouse-2 [mouse-2])
-
-;;; popup-menu compatibility stuff, stolen (and renamed) from
-;;; semi-def.el.
-(defmacro riece-popup-menu-bogus-filter-constructor (menu)
- ;; #### Kludge for FSF Emacs-style menu.
- (let ((bogus-menu (make-symbol "bogus-menu")))
- `(let (,bogus-menu selection function)
- (easy-menu-define ,bogus-menu nil nil ,menu)
- (setq selection (x-popup-menu t ,bogus-menu))
- (when selection
- (setq function (lookup-key ,bogus-menu (apply #'vector selection)))
- ;; If a callback entry has no name, easy-menu wraps its value.
- ;; See `easy-menu-make-symbol'.
- (if (eq t (compare-strings "menu-function-" 0 nil
- (symbol-name function) 0 14))
- (car (last (symbol-function function)))
- function)))))
-
-(defun riece-popup-menu-popup (menu event)
- (let ((function (riece-popup-menu-bogus-filter-constructor menu)))
- (if function
- (funcall function))))
-
-(defun riece-event-buffer (event)
- "Return the buffer of the window over which mouse event EVENT occurred."
- (window-buffer (posn-window (event-start event))))
-
-(defun riece-event-point (event)
- "Return the character position of the mouse event EVENT."
- (posn-point (event-start event)))
-
-;;; stolen (and renamed) from gnus-ems.el.
-(defun riece-region-active-p ()
- "Say whether the region is active."
- (and (boundp 'transient-mark-mode)
- transient-mark-mode
- (boundp 'mark-active)
- mark-active))
-
-(defalias 'riece-make-overlay 'make-overlay)
-(defalias 'riece-overlay-put 'overlay-put)
-(defalias 'riece-overlay-start 'overlay-start)
-(defalias 'riece-overlay-buffer 'overlay-buffer)
-(defalias 'riece-overlays-in 'overlays-in)
-(defalias 'riece-delete-overlay 'delete-overlay)
-
-(defun riece-kill-all-overlays ()
- "Delete all overlays in the current buffer."
- (let* ((overlay-lists (overlay-lists))
- (buffer-read-only nil)
- (overlays (delq nil (nconc (car overlay-lists) (cdr overlay-lists)))))
- (while overlays
- (delete-overlay (car overlays))
- (setq overlays (cdr overlays)))))
-
-(defalias 'riece-run-at-time 'run-at-time)
-(defalias 'riece-run-with-idle-timer 'run-with-idle-timer)
-(defalias 'riece-cancel-timer 'cancel-timer)
-
-(defalias 'riece-match-string-no-properties 'match-string-no-properties)
-
-(defun riece-propertize-modeline-string (string &rest properties)
- (add-text-properties 0 (length string) properties string)
- string)
-
-(defun riece-normalize-modeline-string-1 (string)
- (if string
- (if (listp (car string))
- (cons (car (car string)) (riece-normalize-modeline-string-1
- (append (cdr (car string)) (cdr string))))
- (cons (car string) (riece-normalize-modeline-string-1
- (cdr string))))))
-
-(defun riece-normalize-modeline-string (string)
- (if (listp string)
- (list (apply #'concat (riece-normalize-modeline-string-1 string)))
- string))
-
-(defun riece-put-text-property-nonsticky (start end prop value
- &optional object)
- (add-text-properties start end
- (list prop value 'front-sticky nil 'rear-nonsticky t)
- object))
-
-(defalias 'riece-facep 'facep)
-
-;;; stolen (and renamed) from emacsbug.el.
-(defun riece-recent-messages (n)
- "Return N most recent messages, most recent first.
-If N is nil, all messages will be returned."
- (let ((message-buf (get-buffer "*Messages*")))
- (if message-buf
- (with-temp-buffer
- (let (beg-pos end-pos)
- (with-current-buffer message-buf
- (setq end-pos (goto-char (point-max)))
- (if n
- (progn
- (forward-line (- n))
- (setq beg-pos (point)))
- (setq beg-pos (point-min))))
- (insert-buffer-substring message-buf beg-pos end-pos)
- (reverse-region (point-min) (point-max))
- (buffer-string))))))
-
-(defun riece-remprop (symbol property)
- (let ((plist (symbol-plist symbol)))
- (if (eq (car plist) property)
- (setplist symbol (cdr (cdr plist)))
- (while (and (nthcdr 2 plist)
- (not (eq (car (nthcdr 2 plist)) property)))
- (setq plist (nthcdr 2 plist)))
- (if (nthcdr 2 plist)
- (setcdr (cdr plist) (nthcdr 4 plist))))))
-
-(provide 'riece-emacs)
-
-;;; riece-emacs.el ends here
+++ /dev/null
-;;; riece-epg.el --- Encrypt/decrypt messages add-on
-;; Copyright (C) 2006 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-message)
-(require 'riece-identity)
-
-(autoload 'widget-convert-button "wid-edit")
-(autoload 'epg-make-context "epg")
-(autoload 'epg-decrypt-string "epg")
-(autoload 'epg-encrypt-string "epg")
-(autoload 'epg-passphrase-callback-function "epg")
-(autoload 'epg-context-set-passphrase-callback "epg")
-(autoload 'epg-cancel "epg")
-
-(eval-when-compile
- (autoload 'riece-command-send-message "riece-commands"))
-
-(defgroup riece-epg nil
- "Encrypt/decrypt messages."
- :group 'riece)
-
-(defconst riece-epg-description
- "Encrypt/decrypt messages.")
-
-(defvar riece-epg-passphrase-alist nil)
-
-(defun riece-epg-passphrase-callback-function (context key-id identity)
- (if (eq key-id 'SYM)
- (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist))
- passphrase)
- (or (copy-sequence (cdr entry))
- (progn
- (unless entry
- (setq entry (list identity)
- riece-epg-passphrase-alist (cons entry
- riece-epg-passphrase-alist)))
- (setq passphrase (epg-passphrase-callback-function context
- key-id nil))
- (setcdr entry (copy-sequence passphrase))
- passphrase)))
- (epg-passphrase-callback-function context key-id nil)))
-
-(defun riece-epg-passphrase-callback-function-for-decrypt (context key-id
- identity)
- (if (eq key-id 'SYM)
- (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
- (if (cdr entry)
- (copy-sequence (cdr entry))
- (epg-cancel context)))
- (epg-passphrase-callback-function context key-id nil)))
-
-(defun riece-epg-funcall-clear-passphrase (identity function &rest args)
- (condition-case error
- (apply function args)
- (error
- (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
- (if entry
- (setq riece-epg-passphrase-alist
- (delq entry riece-epg-passphrase-alist))))
- (signal (car error) (cdr error)))))
-
-(defun riece-command-enter-encrypted-message ()
- "Encrypt the current line and send it to the current channel."
- (interactive)
- (let ((context (epg-make-context))
- (string (buffer-substring (riece-line-beginning-position)
- (riece-line-end-position))))
- (epg-context-set-passphrase-callback
- context
- (cons #'riece-epg-passphrase-callback-function
- riece-current-channel))
- (riece-send-string
- (format "PRIVMSG %s :[encrypted:%s]\r\n"
- (riece-identity-prefix riece-current-channel)
- (base64-encode-string
- (riece-epg-funcall-clear-passphrase
- riece-current-channel
- #'epg-encrypt-string
- context
- (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-encode-coding-string-for-identity
- string
- riece-current-channel))
- nil)
- t)))
- (riece-display-message
- (riece-make-message (riece-current-nickname) riece-current-channel
- (concat "[encrypted:" string "]") nil t))
- (let ((next-line-add-newlines t))
- (next-line 1))))
-
-(defun riece-command-set-passphrase (identity passphrase)
- "Set PASSPHRASE associated with IDENTITY."
- (interactive
- (let ((identity
- (riece-completing-read-identity
- "Channel/user: "
- riece-current-channels nil t nil nil
- (riece-format-identity riece-current-channel))))
- (list identity
- (read-passwd (format "Passphrase for %s: "
- (riece-format-identity identity))))))
- (let ((entry (riece-identity-assoc identity riece-epg-passphrase-alist)))
- (if (equal passphrase "")
- (if entry
- (setq riece-epg-passphrase-alist
- (delq entry riece-epg-passphrase-alist)))
- (if entry
- (setcdr entry passphrase)
- (setq riece-epg-passphrase-alist
- (cons (cons identity passphrase)
- riece-epg-passphrase-alist))))))
-
-(defun riece-epg-decrypt-string-for-identity (context cipher target)
- (let ((coding-system
- (or (riece-coding-system-for-identity target)
- riece-default-coding-system)))
- (riece-with-server-buffer (riece-identity-server target)
- (decode-coding-string
- (riece-epg-funcall-clear-passphrase
- target
- #'epg-decrypt-string
- context
- (base64-decode-string cipher))
- (if (consp coding-system)
- (car coding-system)
- coding-system)))))
-
-(defun riece-epg-message-filter (message)
- (if (get 'riece-epg 'riece-addon-enabled)
- (when (string-match "\\`\\[encrypted:\\(.*\\)]"
- (riece-message-text message))
- (let ((context (epg-make-context))
- (string (match-string 1 (riece-message-text message))))
- (epg-context-set-passphrase-callback
- context
- (cons #'riece-epg-passphrase-callback-function-for-decrypt
- riece-current-channel))
- (condition-case error
- (progn
- (riece-message-set-text
- message
- (format "[encrypted:%s]"
- (riece-epg-decrypt-string-for-identity
- context string (riece-message-target message)))))
- (error
- (riece-put-text-property-nonsticky
- 0 (length (riece-message-text message))
- 'riece-epg-encryption-target (riece-message-target message)
- (riece-message-text message))
- (if riece-debug
- (message "Couldn't decrypt: %s" (cdr error))
- (message "Couldn't decrypt")))))))
- message)
-
-(defun riece-epg-add-encrypted-button (start end)
- (if (and (get 'riece-button 'riece-addon-enabled)
- (get 'riece-epg 'riece-addon-enabled))
- (riece-scan-property-region
- 'riece-epg-encryption-target
- start end
- (lambda (start end)
- (let ((inhibit-read-only t)
- buffer-read-only)
- (widget-convert-button
- 'link start end
- :help-echo "Click to decrypt"
- :notify #'riece-epg-encrypted-button-notify
- (get-text-property start 'riece-epg-encryption-target)))))))
-
-(defun riece-epg-encrypted-button-notify (widget &rest ignore)
- (let* ((from (marker-position (widget-get widget :from)))
- (to (marker-position (widget-get widget :to)))
- (target (widget-get widget :value))
- (cipher (buffer-substring from to))
- (inhibit-read-only t)
- buffer-read-only
- plain)
- (when (string-match "\\`\\[encrypted:\\(.*\\)]" cipher)
- (setq plain (riece-epg-decrypt-string-for-identity
- (epg-make-context) (match-string 1 cipher) target))
- (widget-delete widget)
- (delete-region from to)
- (save-excursion
- (goto-char from)
- (insert "[encrypted:" plain "]")))))
-
-(defun riece-epg-requires ()
- (if (memq 'riece-button riece-addons)
- '(riece-button)))
-
-(defun riece-epg-insinuate ()
- (add-hook 'riece-message-filter-functions 'riece-epg-message-filter)
- (add-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
-
-(defun riece-epg-uninstall ()
- (remove-hook 'riece-message-filter-functions 'riece-epg-message-filter)
- (remove-hook 'riece-after-insert-functions 'riece-epg-add-encrypted-button))
-
-(defvar riece-command-mode-map)
-(defun riece-epg-enable ()
- (define-key riece-command-mode-map
- "\C-ce" 'riece-command-enter-encrypted-message)
- (define-key riece-command-mode-map
- "\C-c\C-ec" 'riece-command-set-passphrase))
-
-(defun riece-epg-disable ()
- (define-key riece-command-mode-map
- "\C-ce" nil)
- (define-key riece-command-mode-map
- "\C-c\C-ec" nil))
-
-(provide 'riece-epg)
-
-;;; riece-epg.el ends here
+++ /dev/null
-;;; riece-eval-ruby.el --- evaluate input string as a Ruby program
-;; Copyright (C) 1998-2005 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece, Ruby
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-ruby)
-(require 'riece-message)
-
-(defgroup riece-eval-ruby nil
- "Evaluate input string as a Ruby program."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-eval-ruby-prefix-regexp "^,ruby\\s-+"
- "Pattern of of the prefix for sending Ruby programs."
- :type 'string
- :group 'riece-eval-ruby)
-
-(defconst riece-eval-ruby-description
- "Evaluate input string as a Ruby program.")
-
-(defun riece-eval-ruby-exit-handler (name)
- (riece-ruby-inspect name)
- (let* ((data (copy-sequence (or riece-ruby-data "nil")))
- (length (length data))
- (index 0))
- (while (< index length)
- (if (eq (aref data index) ?\n)
- (aset data index ? ))
- (setq index (1+ index)))
- (riece-send-string
- (format "NOTICE %s :%s\r\n"
- (riece-identity-prefix
- (riece-ruby-property name 'riece-eval-ruby-target))
- data))
- (riece-display-message
- (riece-make-message (riece-current-nickname)
- (riece-ruby-property name 'riece-eval-ruby-target)
- data
- 'notice))))
-
-(defun riece-eval-ruby-display-message-function (message)
- (if (and (get 'riece-eval-ruby 'riece-addon-enabled)
- (riece-message-own-p message)
- (string-match riece-eval-ruby-prefix-regexp
- (riece-message-text message)))
- (let ((name (riece-ruby-execute
- (substring (riece-message-text message)
- (match-end 0)))))
- (riece-ruby-set-property name
- 'riece-eval-ruby-target
- (riece-message-target message))
- (riece-ruby-set-exit-handler name
- #'riece-eval-ruby-exit-handler))))
-
-(defun riece-eval-ruby-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-eval-ruby-display-message-function))
-
-(defun riece-eval-ruby-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-eval-ruby-display-message-function))
-
-(provide 'riece-eval-ruby)
-
-;;; riece-eval-ruby.el ends here
+++ /dev/null
-;;; riece-eval.el --- evaluate input string as an elisp form
-;; Copyright (C) 2005 OHASHI Akira
-
-;; Author: OHASHI Akira <bg66@koka-in.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'pp)
-(require 'riece-message)
-
-(defgroup riece-eval nil
- "Evaluate an input string as an elisp form."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-eval-regexp "^, \\(.+\\)"
- "*Pattern of string evaluating."
- :type 'string
- :group 'riece-eval)
-
-(defcustom riece-eval-ignore-error nil
- "*If non-nil, an error is ignored."
- :type 'boolean
- :group 'riece-eval)
-
-(defconst riece-eval-description
- "Evaluate an input string as an elisp form.")
-
-(defun riece-eval-display-message-function (message)
- (when (and (get 'riece-eval 'riece-addon-enabled)
- (riece-message-own-p message)
- (string-match riece-eval-regexp (riece-message-text message)))
- (let* ((form (match-string 1 (riece-message-text message)))
- (string (riece-eval-form form)))
- (unless (equal string "")
- (riece-send-string
- (format "NOTICE %s :%s\r\n"
- (riece-identity-prefix (riece-message-target message))
- string))
- (riece-display-message
- (riece-make-message (riece-current-nickname)
- (riece-message-target message)
- string 'notice))))))
-
-(defun riece-eval-form (form)
- (condition-case err
- (let ((object (eval (read form))))
- (cond
- ((stringp object) object)
- ((and (listp object)
- (not (eq object nil)))
- (let ((string (pp-to-string object)))
- (substring string 0 (1- (length string)))))
- ((numberp object)
- (number-to-string object))
- ((eq object nil) "")
- (t (pp-to-string object))))
- (error
- (unless riece-eval-ignore-error
- (format "Error evaluating %s: %s" form err)))))
-
-(defun riece-eval-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-eval-display-message-function))
-
-(defun riece-eval-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-eval-display-message-function))
-
-(provide 'riece-eval)
-
-;;; riece-eval.el ends here
+++ /dev/null
-;;; riece-filter.el --- process filter and sentinel
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-handle)
-(require 'riece-misc)
-(require 'riece-server) ;riece-close-server
-(require 'riece-identity)
-(require 'riece-debug)
-
-(defun riece-handle-numeric-reply (prefix number name string)
- (let ((base-number (* (/ number 100) 100))
- function)
- (setq function (intern-soft (format "riece-handle-%03d-message" number)))
- (unless (and function
- (symbol-function function))
- (setq function
- (intern-soft
- (format "riece-handle-default-%03d-message" base-number))))
- (if (and function
- (symbol-function function))
- (riece-funcall-ignore-errors (symbol-name function)
- function prefix number name
- (riece-decode-coding-string string)))))
-
-(defun riece-handle-message (prefix message string)
- (if (and prefix
- (string-match "![^\x00\x0d\x0a @]+@" prefix))
- (riece-user-set-user-at-host
- (riece-get-user (substring prefix 0 (match-beginning 0)))
- (riece-parse-user-at-host (substring prefix (1+ (match-beginning 0))))))
- (setq message (downcase message)
- string (riece-decode-coding-string string))
- (let ((function (intern-soft (concat "riece-handle-" message "-message")))
- (hook (intern (concat "riece-" message "-hook")))
- (after-hook (intern (concat "riece-after-" message "-hook"))))
- (unless (riece-funcall-ignore-errors (symbol-name hook)
- #'run-hook-with-args-until-success
- hook prefix string)
- (if function
- (riece-funcall-ignore-errors (symbol-name function)
- function prefix string))
- (riece-funcall-ignore-errors (symbol-name after-hook)
- #'run-hook-with-args-until-success
- after-hook prefix string))))
-
-(defsubst riece-chomp-string (string)
- (if (string-match "\r\\'" string)
- (substring string 0 (match-beginning 0))
- string))
-
-(defun riece-filter (process input)
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-max))
- (insert input)
- (unless riece-filter-running
- (unwind-protect
- (progn
- (setq riece-filter-running t)
- (goto-char riece-read-point)
- (beginning-of-line)
- (while (looking-at ".*\n") ;the input line is finished
- (save-excursion
- (if (looking-at
- ":\\([^ ]+\\) +\\([0-5][0-9][0-9]\\) +\\([^ ]+\\)\
- +\\(.*\\)")
- (riece-handle-numeric-reply
- (match-string 1) ;prefix
- (string-to-number (match-string 2)) ;number
- (match-string 3) ;name
- (riece-chomp-string (match-string 4))) ;reply string
- (if (looking-at "\\(:\\([^ ]+\\) +\\)?\\([^ ]+\\) +\\(.*\\)")
- (riece-handle-message
- (match-string 2) ;optional prefix
- (match-string 3) ;command
- (riece-chomp-string (match-string 4))
- ;params & trailing
- )
- (if riece-debug
- (message "Weird message from server: %s"
- (buffer-substring (point) (progn
- (end-of-line)
- (point))))))))
- (forward-line))
- (unless riece-debug
- (delete-region (point-min) (point)))
- (setq riece-read-point (point)))
- (setq riece-filter-running nil)))))
-
-(eval-when-compile
- (autoload 'riece-exit "riece"))
-(defun riece-sentinel (process status)
- (if riece-reconnect-with-password
- (let ((server-name
- (with-current-buffer (process-buffer process)
- riece-server-name)))
- (riece-close-server-process process)
- (riece-open-server
- (if (equal server-name "")
- riece-server
- (riece-server-name-to-server server-name))
- server-name))
- (let ((server-name (with-current-buffer (process-buffer process)
- riece-server-name)))
- (if riece-debug
- (if (equal server-name "")
- (riece-debug (format "Connection closed: %s"
- (substring status 0 (1- (length status)))))
- (riece-debug (format "Connection to \"%s\" closed: %s"
- server-name
- (substring status 0 (1- (length status))))))
- (if (equal server-name "")
- (message "Connection closed")
- (message "Connection to \"%s\" closed" server-name)))
- (let ((channels riece-current-channels))
- (while channels
- (if (and (car channels)
- (equal (riece-identity-server (car channels))
- server-name))
- (riece-part-channel (car channels)))
- (setq channels (cdr channels))))
- (riece-redisplay-buffers)
- (riece-close-server-process process)
- ;; If no server process is available, exit.
- (unless riece-server-process-alist
- (riece-exit)))))
-
-(provide 'riece-filter)
-
-;;; riece-filter.el ends here
+++ /dev/null
-;;; riece-foolproof.el --- prevent miss-operation in the command buffer
-;; Copyright (C) 2004 TAKAHASHI Kaoru
-
-;; Author: TAKAHASHI "beatmaria" Kaoru <kaoru@kaisei.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(eval-when-compile
- (require 'riece-identity)
- (require 'riece-display))
-
-(defconst riece-foolproof-description
- "Prevent miss-operation in the command buffer.")
-
-(defun riece-foolproof-get-channel-window (identity)
- (get-buffer-window
- (cdr (riece-identity-assoc
- identity riece-channel-buffer-alist))))
-
-(defun riece-foolproof-command-send-message-function ()
- (when (get 'riece-foolproof 'riece-addon-enabled)
- (unless (or (not riece-channel-buffer-mode)
- (riece-foolproof-get-channel-window
- riece-current-channel))
- (error "Channel %s is not displayed"
- (riece-identity-prefix riece-current-channel)))
- (when (text-property-not-all
- (riece-line-beginning-position) (riece-line-end-position)
- 'invisible nil)
- (error "Invisible text included: %s"
- (buffer-substring-no-properties
- (riece-line-beginning-position)
- (riece-line-end-position))))
- (when executing-kbd-macro
- (error "%s" "Forbidden to run keyboard macro"))))
-
-(defun riece-foolproof-insinuate ()
- (add-hook 'riece-command-send-message-hook
- 'riece-foolproof-command-send-message-function))
-
-(defun riece-foolproof-uninstall ()
- (remove-hook 'riece-command-send-message-hook
- 'riece-foolproof-command-send-message-function))
-
-(provide 'riece-foolproof)
-
-;;; riece-foolproof.el ends here
+++ /dev/null
-;;; riece-globals.el --- global variables and constants.
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-compat) ;riece-make-interval-regexp
-
-;;; Constants:
-(defconst riece-strict-channel-regexp
- (concat "\\([+&#]\\|!"
- (riece-make-interval-regexp "[A-Z0-9]" 5)
- "\\|!!\\)[^\0\7\r\n ,:]*\\(:[^\0\7\r\n ,:]*\\)?"))
-
-(defconst riece-strict-user-regexp
- (concat "[][\\\\`_^{|}A-Za-z]"
- (riece-make-interval-regexp "[][\\\\`_^{|}A-Za-z0-9-]" 0 8)))
-
-(defconst riece-laxed-channel-regexp
- "[+&#!][^\0\7\r\n ,:]*\\(:[^\0\7\r\n ,:]*\\)?")
-
-(defconst riece-laxed-user-regexp
- "[][\\\\`_^{|}A-Za-z][][\\\\`_^{|}A-Za-z0-9-]*")
-
-(defvar riece-channel-regexp riece-laxed-channel-regexp)
-(defvar riece-user-regexp riece-laxed-user-regexp)
-
-;;; Global variables:
-(defvar riece-server-process-alist nil
- "An alist mapping server names to processes.")
-
-(defvar riece-current-channel nil
- "The channel you currently have joined.")
-(defvar riece-current-channels nil
- "The channels you have currently joined.")
-(defvar riece-join-channel-candidate nil
- "The candidate for channel to be used with the next join command.")
-
-(defvar riece-save-variables-are-dirty nil
- "Non nil if the variables in `riece-saved-forms' are changed.")
-
-(defvar riece-polling 0
- "Interval for polling the server.")
-
-(defvar riece-reconnect-with-password nil
- "If non-nil, attempt to reconnect with password.")
-
-(defvar riece-user-obarray-size 1327
- "The size of obarray used by riece on user name space.")
-
-(defvar riece-channel-obarray-size 103
- "The size of obarray used by riece on channel name space.")
-
-(defvar riece-addon-dependencies nil)
-
-;;; Variables local to the server buffers:
-(defvar riece-server-name nil
- "The name of the server.
-Local to the server buffers.")
-(defvar riece-real-nickname nil
- "Your nickname the server offers.
-Local to the server buffers.")
-(defvar riece-last-nickname nil
- "The last nickname you requested.
-Local to the server buffers.")
-(defvar riece-nick-accepted nil
- "The flag your nickname is accepted by the server.
-Possible values are nil, `ok', and `sent'.
-Local to the server buffers.")
-(defvar riece-real-server-name nil
- "The server name offered by the server.
-Local to the server buffers.")
-(defvar riece-real-userhost nil
- "Your hostname the server offers.
-Local to the server buffers.")
-(defvar riece-user-at-host ""
- "The user@host for the current input.
-Local to the server buffers.")
-(defvar riece-user-at-host-type nil
- "The authentication type of `riece-user-at-host'.
-Possible values are 'ok 'not-verified 'fake or 'invalid.
-Local to the server buffers.")
-(defvar riece-supported-user-modes nil
- "User modes supported by server.
-Local to the server buffers.")
-(defvar riece-supported-channel-modes nil
- "Channel modes supported by server.
-Local to the server buffers.")
-(defvar riece-channel-filter ""
- "Filter of the result of NAMES or LIST.
-This enables us to use \\[universal-argument] with NAMES and TOPIC.
-Local to the server buffers.")
-(defvar riece-read-point nil
- "Point at the last input was seen.
-Local to the server buffers.")
-(defvar riece-filter-running nil
- "Lock of the process filter; non-nil indicates the process filter is running.
-Local to the server buffers.")
-(defvar riece-send-queue nil
- "Send queue for avoiding client flood.
-Local to the server buffers.")
-(defvar riece-send-size nil
- "Size of the last send.
-Local to the server buffers.")
-(defvar riece-last-send-time nil
- "Timestamp of the last send.
-Local to the server buffers.")
-(defvar riece-user-obarray nil
- "USER namespace of the IRC world.
-Local to the server buffers.")
-(defvar riece-channel-obarray nil
- "Channel namespace of the IRC world.
-Local to the server buffers.")
-(defvar riece-coding-system nil
- "Coding system for process I/O.
-Local to the server buffers.")
-(defvar riece-channel-cache nil
- "Cache of channel names.
-Local to the server buffers.")
-(defvar riece-user-cache nil
- "Cache of user names.
-Local to the server buffers.")
-
-;;; Variables local to the channel buffers:
-(defvar riece-freeze nil
- "If t, channel window is locked and will not be scrolled.
-If 'own, channel window is locked until the user begins to speak.
-Local to the channel buffers.")
-
-(defvar riece-freeze-indicator nil
- "String displayed on the modeline to allow the user to tell if the
-channel buffer is locked.
-Local to the channel buffers.")
-
-(defvar riece-channel-buffer-window-point nil
- "Last value of point in window which displayed the channel buffer.
-Local to the channel buffers.")
-
-;;; Modeline indicators:
-(defvar riece-mode-line-buffer-identification nil)
-(defvar riece-channel-indicator "None"
- "String displayed on the modeline to indicate the current channel.")
-(defvar riece-long-channel-indicator "None"
- "String displayed on the modeline to indicate the current channel.
-Generally, this string will contain more information than
-riece-channel-indicator.")
-(defvar riece-channel-list-indicator "No channel"
- "String displayed on the modeline to show the joined channels.")
-(defvar riece-user-indicator nil
- "String displayed on the modeline to show the current nickname.")
-
-(defvar riece-away-indicator "-"
- "String displayed on the modeline to allow the user to tell if the
-user is away.")
-(defvar riece-operator-indicator "-"
- "String displayed on the modeline to allow the user to tell if the
-user is an operator.")
-(defvar riece-channel-status-indicator "-"
- "String displayed on the modeline to allow the user to tell if the
-user's status on the current channel.")
-
-;;; Buffers:
-(defvar riece-command-buffer nil
- "The command buffer.")
-(defvar riece-dialogue-buffer nil
- "Buffer for whole conversation.")
-(defvar riece-others-buffer nil
- "Buffer for other messages.")
-(defvar riece-channel-list-buffer nil
- "Buffer for channel list.")
-(defvar riece-user-list-buffer nil
- "Buffer for user list.")
-(defvar riece-channel-buffer nil
- "Buffer for messages arrived in the current channel.")
-(defvar riece-temp-buffer nil
- "Buffer for temporally use.")
-(defvar riece-debug-buffer nil
- "Buffer for debug output.")
-
-(defvar riece-buffer-list nil)
-(defvar riece-overriding-server-name nil)
-
-(defconst riece-change-prefix "*** Change: ")
-(defconst riece-notice-prefix "*** Notice: ")
-(defconst riece-wallops-prefix "*** Notice: ")
-(defconst riece-error-prefix "*** Error: ")
-(defconst riece-info-prefix "*** Info: ")
-(defconst riece-prefix-regexp "\\*\\*\\* \\([^:]+: \\)")
-
-(defconst riece-time-prefix-regexp "[0-9][0-9]:[0-9][0-9] ")
-
-(provide 'riece-globals)
-
-;;; riece-globals.el ends here
+++ /dev/null
-;;; riece-google.el --- search keywords by Google
-;; Copyright (C) 2005 OHASHI Akira
-
-;; Author: OHASHI Akira <bg66@koka-in.org>
-;; SASADA Koichi <ko1 at atdot.net>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; Ruby code was stolen (and modified) from nadoka.
-
-;;; Code:
-
-(require 'riece-message)
-
-(defgroup riece-google nil
- "Search keywords by Google."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-google-ruby-command "ruby"
- "Command name for Ruby interpreter."
- :type 'string
- :group 'riece-google)
-
-(defcustom riece-google-program
- '("\
-# Copyright (c) 2004 SASADA Koichi <ko1 at atdot.net>
-#
-# This program is free software with ABSOLUTELY NO WARRANTY.
-# You can re-distribute and/or modify this program under
-# the same terms of the Ruby's lisence.
-
-require 'soap/wsdlDriver'
-require 'iconv'
-require 'kconv'
-require 'cgi'
-
-keywords = '" keywords "'
-max_results = " max-results "
-license_key = '" license-key "'
-default_lang = '" lang "'
-google_wsdl = 'http://api.google.com/GoogleSearch.wsdl'
-google = SOAP::WSDLDriverFactory.new(google_wsdl).create_driver
-
-def erace_tag str
- CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, ''))
-end
-
-def lang_check lang
- if lang.empty? || /^lang_/ =~ lang
- lang
- else
- 'lang_' + lang
- end
-end
-
-def show_char_code_and_erace_tag str
- case $KCODE
- when 'EUC', 'SJIS'
- CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, '')).tojis
- when 'NONE', 'UTF-8'
- begin
- str = Iconv.conv(\"EUC-JP\", \"UTF-8\", str)
- CGI.unescapeHTML(str.gsub(/\\<.+?\\>/, '')).tojis
- rescue => e
- \"(char code problem: #{e.class}[#{e.message.dump}])\"
- end
- else
- str
- end
-end
-
-def search_char_code str
- case $KCODE
- when 'EUC', 'SJIS'
- str.toeuc
- when 'NONE'
- begin
- Iconv.conv(\"UTF-8\", \"EUC-JP\", str.toeuc)
- rescue => e
- \"(char code problem: #{e.class})\"
- end
- when 'UTF-8'
- str
- else
- raise
- end
-end
-
-begin
- lang = lang_check(default_lang)
- word = search_char_code(keywords)
- result = google.doGoogleSearch(
- license_key, word, 0, max_results, false, \"\",
- false, lang, 'utf-8', 'utf-8'
- )
-
- count = result.estimatedTotalResultsCount
- if count > 0
- word = show_char_code_and_erace_tag(keywords)
- count = count.to_s.gsub(/(\\d)(?=\\d{3}+$)/, '\\\\1,')
- time = result.searchTime.to_s
- print \"Search results for #{word} (Hits: #{count}: Time: #{time}):\\n\"
-
- result.resultElements.each_with_index{|e, i|
- title = show_char_code_and_erace_tag(e.title)
- url = e.URL
- print \"#{title} - #{url}\\n\"
- }
- else
- print \"no match\\n\"
- end
-
-rescue Exception => e
- print \"#{e.class}(#{e.message})\"
-end
-")
- "Ruby program for searching by Google."
- :type 'list
- :group 'riece-google)
-
-(defcustom riece-google-license-key nil
- "*License key for Google API."
- :type 'string
- :group 'riece-google)
-
-(defcustom riece-google-default-lang '("lang_en" "lang_ja")
- "*Default language for searching keywords."
- :type '(repeat (choice (const "lang_en" :tag "English")
- (const "lang_ja" :tag "Japanese")
- (string :tag "The other language")))
- :group 'riece-google)
-
-(defconst riece-google-regexp
- "^go\\(o+\\)gle\\(:\\([a-z]+\\)\\)?>\\s-*\\(.*\\)")
-
-(defconst riece-google-description
- "Search keywords by Google.")
-
-(defvar riece-google-target nil)
-
-(defun riece-google-display-message-function (message)
- (when (and (get 'riece-google 'riece-addon-enabled)
- (stringp riece-google-license-key)
- (string-match riece-google-regexp (riece-message-text message)))
- (let ((keywords (match-string 4 (riece-message-text message)))
- (max-results (number-to-string
- (length
- (match-string 1 (riece-message-text message)))))
- (lang (or (match-string 3 (riece-message-text message))
- riece-google-default-lang))
- (process-connection-type nil)
- selective-display
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (process (start-process "Google" (generate-new-buffer " *Google*")
- riece-google-ruby-command)))
- (when (listp lang)
- (setq lang (mapconcat #'identity lang " ")))
- (setq riece-google-target (riece-message-target message))
- (process-send-string process
- (apply #'concat
- (riece-google-substitute-variables
- (riece-google-substitute-variables
- (riece-google-substitute-variables
- (riece-google-substitute-variables
- riece-google-program
- 'keywords keywords)
- 'max-results max-results)
- 'license-key riece-google-license-key)
- 'lang lang)))
- (process-send-eof process)
- (with-current-buffer (process-buffer process)
- (set-buffer-multibyte t)
- (erase-buffer)
- (set-buffer-modified-p nil))
- (set-process-filter process #'riece-google-filter)
- (set-process-sentinel process #'riece-google-sentinel))))
-
-(defun riece-google-filter (process output)
- (when (buffer-live-p (process-buffer process))
- (with-current-buffer (process-buffer process)
- (goto-char (point-max))
- (insert output)
- (goto-char (point-min))
- (while (progn (end-of-line) (and (not (eobp)) (eq (char-after) ?\n)))
- (if (eq (char-after (1- (point))) ?\r) ; cut off preceding LF
- (delete-region (1- (point)) (point)))
- (riece-google-send-string riece-google-target
- (buffer-substring (point-min) (point)))
- (delete-region (point-min) (progn (beginning-of-line 2) (point)))))))
-
-(defun riece-google-sentinel (process string)
- (delete-process process))
-
-(defun riece-google-send-string (target message)
- (riece-send-string
- (format "NOTICE %s :%s\r\n" (riece-identity-prefix target) message))
- (riece-display-message
- (riece-make-message (riece-current-nickname) target message 'notice)))
-
-(defun riece-google-substitute-variables (program variable value)
- (setq program (copy-sequence program))
- (let ((pointer program))
- (while pointer
- (setq pointer (memq variable program))
- (if pointer
- (setcar pointer value)))
- program))
-
-(defun riece-google-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-google-display-message-function))
-
-(defun riece-google-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-google-display-message-function))
-
-(provide 'riece-google)
-
-;;; riece-google.el ends here
+++ /dev/null
-;;; riece-guess.el --- guess the next channel, using multiple methods
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-commands)
-
-(defgroup riece-guess nil
- "Guess the next channel."
- :tag "Guess"
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-guess-channel-try-functions nil
- "Functions which returns a list of channels the user wants to switch."
- :type '(repeat function)
- :group 'riece-guess)
-
-(defconst riece-guess-description
- "Guess the next channel, using multiple methods.")
-
-(defvar riece-current-channels)
-
-(defun riece-guess-candidates ()
- "Build candidate list.
-This function calls \\[riece-guess-channel-try-functions] in turn and
-merge the results."
- (let ((functions riece-guess-channel-try-functions)
- candidates)
- (while functions
- (setq candidates
- (nconc candidates
- (delq nil (mapcar
- (lambda (channel)
- (unless (riece-identity-member
- channel candidates)
- channel))
- (funcall (car functions)))))
- functions (cdr functions)))
- ;; Merge the default.
- (setq candidates
- (nconc candidates
- (delq nil (mapcar
- (lambda (channel)
- (if (and channel
- (not (riece-identity-member
- channel candidates)))
- channel))
- riece-current-channels))))
- candidates))
-
-(defvar riece-guess-candidates nil)
-
-(defun riece-command-guess-switch-to-channel ()
- "Try to switch to the channel where the user is interested in."
- (interactive)
- (unless (and (eq last-command this-command)
- riece-guess-candidates)
- (setq riece-guess-candidates (riece-guess-candidates)))
- (unless riece-guess-candidates
- (error "No channel"))
- (riece-command-switch-to-channel
- (prog1 (car riece-guess-candidates)
- (setq riece-guess-candidates (cdr riece-guess-candidates)))))
-
-(defvar riece-command-mode-map)
-(defvar riece-dialogue-mode-map)
-(defvar riece-channel-list-mode-map)
-
-(defun riece-guess-insinuate ()
- )
-
-(defun riece-guess-enable ()
- (define-key riece-command-mode-map
- "\C-cg" 'riece-command-guess-switch-to-channel)
- (define-key riece-dialogue-mode-map
- "g" 'riece-command-guess-switch-to-channel)
- (define-key riece-channel-list-mode-map
- "g" 'riece-command-guess-switch-to-channel))
-
-(defun riece-guess-disable ()
- (define-key riece-command-mode-map
- "\C-cg" nil)
- (define-key riece-dialogue-mode-map
- "g" nil)
- (define-key riece-channel-list-mode-map
- "g" nil))
-
-(provide 'riece-guess)
-
-;;; riece-guess.el ends here
+++ /dev/null
-;;; riece-handle.el --- basic message handlers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-misc)
-(require 'riece-message)
-(require 'riece-channel)
-(require 'riece-naming)
-(require 'riece-signal)
-(require 'riece-mode)
-(require 'riece-000)
-(require 'riece-200)
-(require 'riece-300)
-(require 'riece-400)
-(require 'riece-500)
-
-(defun riece-default-handle-numeric-reply
- (client-prefix prefix number name string)
- (riece-insert
- (list riece-dialogue-buffer riece-others-buffer)
- (concat client-prefix
- (riece-concat-server-name
- (mapconcat #'identity (riece-split-parameters string) " "))
- "\n")))
-
-(defun riece-handle-nick-message (prefix string)
- (let* ((old (riece-prefix-nickname prefix))
- (new (car (riece-split-parameters string)))
- (old-identity (riece-make-identity old riece-server-name))
- (new-identity (riece-make-identity new riece-server-name))
- (channels (riece-user-get-channels old))
- (visible (riece-identity-member
- riece-current-channel
- (mapcar (lambda (channel)
- (riece-make-identity channel riece-server-name))
- channels))))
- (riece-naming-assert-rename old new)
- (if (riece-identity-member old-identity riece-current-channels)
- (setq channels (cons new channels)))
- (riece-insert-change (delq nil (mapcar
- (lambda (channel)
- (riece-channel-buffer
- (riece-make-identity
- channel riece-server-name)))
- channels))
- (format "%s -> %s\n"
- (riece-format-identity old-identity t)
- (riece-format-identity new-identity t)))
- (riece-insert-change (if visible
- riece-dialogue-buffer
- (list riece-dialogue-buffer riece-others-buffer))
- (concat
- (riece-concat-server-name
- (format "%s -> %s"
- (riece-format-identity old-identity t)
- (riece-format-identity new-identity t)))
- "\n"))))
-
-(defun riece-handle-privmsg-message (prefix decoded)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters (riece-decoded-string decoded)))
- (targets (split-string (car parameters) ","))
- message)
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity
- decoded
- (riece-make-identity (car targets) riece-server-name)))
- message (nth 1 parameters))
- (riece-display-message
- (riece-make-message (riece-make-identity user
- riece-server-name)
- (riece-make-identity (car targets)
- riece-server-name)
- message
- nil
- (riece-identity-equal-no-server
- user riece-real-nickname)))))
-
-(defun riece-handle-notice-message (prefix decoded)
- (let* ((user (if prefix
- (riece-prefix-nickname prefix)))
- (parameters (riece-split-parameters (riece-decoded-string decoded)))
- (targets (split-string (car parameters) ","))
- message)
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity
- decoded
- (riece-make-identity (car targets) riece-server-name)))
- message (nth 1 parameters))
- (if user
- (riece-display-message
- (riece-make-message (riece-make-identity user
- riece-server-name)
- (riece-make-identity (car targets)
- riece-server-name)
- message 'notice
- (riece-identity-equal-no-server
- user riece-real-nickname)))
- ;; message from server
- (riece-insert-notice
- (list riece-dialogue-buffer riece-others-buffer)
- (concat (riece-concat-server-name message) "\n")))))
-
-(defun riece-handle-ping-message (prefix string)
- (riece-send-string (format "PONG :%s\r\n"
- (if (eq (aref string 0) ?:)
- (substring string 1)
- string))))
-
-(defun riece-handle-join-message (prefix string)
- (let* ((user (riece-prefix-nickname prefix))
- ;; RFC2812 3.2.1 doesn't recommend server to send join
- ;; messages which contain multiple targets.
- (channels (split-string (car (riece-split-parameters string)) ","))
- (user-identity (riece-make-identity user riece-server-name)))
- (while channels
- (riece-naming-assert-join user (car channels))
- (if (and riece-gather-channel-modes
- (riece-identity-equal-no-server user riece-real-nickname))
- (riece-send-string (format "MODE %s\r\n" (car channels))))
- (let* ((channel-identity (riece-make-identity (car channels)
- riece-server-name))
- (buffer (riece-channel-buffer channel-identity)))
- (riece-insert-change
- buffer
- (format (riece-mcat "%s (%s) has joined %s\n")
- (riece-format-identity user-identity t)
- (riece-user-get-user-at-host user)
- (riece-format-identity channel-identity t)))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s (%s) has joined %s")
- (riece-format-identity user-identity t)
- (riece-user-get-user-at-host user)
- (riece-format-identity channel-identity t)))
- "\n")))
- (setq channels (cdr channels)))))
-
-(defun riece-handle-part-message (prefix decoded)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters (riece-decoded-string decoded)))
- ;; RFC2812 3.2.2 doesn't recommend server to send part
- ;; messages which contain multiple targets.
- (channels (split-string (car parameters) ","))
- (user-identity (riece-make-identity user riece-server-name)))
- (while channels
- (let* ((channel-identity (riece-make-identity (car channels)
- riece-server-name))
- (buffer (riece-channel-buffer channel-identity))
- message)
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity decoded
- channel-identity))
- message (nth 1 parameters))
- (riece-insert-change
- buffer
- (concat
- (riece-concat-message
- (format (riece-mcat "%s has left %s")
- (riece-format-identity user-identity t)
- (riece-format-identity channel-identity t))
- message)
- "\n"))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-message
- (format (riece-mcat "%s has left %s")
- (riece-format-identity user-identity t)
- (riece-format-identity channel-identity t))
- message))
- "\n")))
- (riece-naming-assert-part user (car channels))
- (setq channels (cdr channels)))))
-
-(defun riece-handle-kick-message (prefix decoded)
- (let* ((kicker (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters (riece-decoded-string decoded)))
- (channel (car parameters))
- (user (nth 1 parameters))
- message
- (kicker-identity (riece-make-identity kicker riece-server-name))
- (channel-identity (riece-make-identity channel riece-server-name))
- (user-identity (riece-make-identity user riece-server-name)))
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity decoded
- channel-identity))
- message (nth 2 parameters))
- (riece-naming-assert-part user channel)
- (let ((buffer (riece-channel-buffer channel-identity)))
- (riece-insert-change
- buffer
- (concat
- (riece-concat-message
- (format (riece-mcat "%s kicked %s out from %s")
- (riece-format-identity kicker-identity t)
- (riece-format-identity user-identity t)
- (riece-format-identity channel-identity t))
- message)
- "\n"))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-message
- (format (riece-mcat "%s kicked %s out from %s\n")
- (riece-format-identity kicker-identity t)
- (riece-format-identity user-identity t)
- (riece-format-identity channel-identity t))
- message))
- "\n")))))
-
-(defun riece-handle-quit-message (prefix string)
- (let* ((user (riece-prefix-nickname prefix))
- (channels (copy-sequence (riece-user-get-channels user)))
- (pointer channels)
- (parameters (riece-split-parameters string))
- (message (car parameters))
- (user-identity (riece-make-identity user riece-server-name)))
- ;; If you are talking with the user, quit it.
- (if (riece-identity-member user-identity riece-current-channels)
- (riece-part-channel user-identity))
- (setq pointer channels)
- (while pointer
- (riece-naming-assert-part user (car pointer))
- (setq pointer (cdr pointer)))
- (let ((buffers
- (delq nil (mapcar
- (lambda (channel)
- (riece-channel-buffer (riece-make-identity
- channel riece-server-name)))
- channels))))
- (riece-insert-change
- buffers
- (concat
- (riece-concat-message
- (format (riece-mcat "%s has left IRC")
- (riece-format-identity user-identity t))
- message)
- "\n"))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (memq riece-channel-buffer buffers)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-message
- (format (riece-mcat "%s has left IRC")
- (riece-format-identity user-identity t))
- message))
- "\n")))))
-
-(defun riece-handle-kill-message (prefix string)
- (let* ((killer (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters string))
- (user (car parameters))
- (message (nth 1 parameters))
- (channels (copy-sequence (riece-user-get-channels user)))
- (killer-identity (riece-make-identity killer riece-server-name))
- (user-identity (riece-make-identity user riece-server-name))
- pointer)
- ;; If you are talking with the user, quit it.
- (if (riece-identity-member user-identity riece-current-channels)
- (riece-part-channel user))
- (setq pointer channels)
- (while pointer
- (riece-naming-assert-part user (car pointer))
- (setq pointer (cdr pointer)))
- (let ((buffers
- (delq nil (mapcar
- (lambda (channel)
- (riece-channel-buffer (riece-make-identity
- channel riece-server-name)))
- channels))))
- (riece-insert-change
- buffers
- (concat
- (riece-concat-message
- (format (riece-mcat "%s killed %s")
- (riece-format-identity killer-identity t)
- (riece-format-identity user-identity t))
- message)
- "\n"))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (memq riece-channel-buffer buffers)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (riece-concat-message
- (format (riece-mcat "%s killed %s")
- (riece-format-identity killer-identity t)
- (riece-format-identity user-identity t))
- message))
- "\n")))))
-
-(defun riece-handle-invite-message (prefix string)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters string))
- (invited (car parameters))
- (channel (nth 1 parameters))
- (channel-identity (riece-make-identity channel riece-server-name)))
- (if (riece-identity-equal-no-server invited riece-real-nickname)
- (setq riece-join-channel-candidate channel-identity))
- (riece-insert-info
- (list riece-dialogue-buffer riece-others-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "%s invites %s to %s")
- (riece-format-identity (riece-make-identity
- user riece-server-name))
- (riece-format-identity (riece-make-identity
- invited riece-server-name))
- (riece-format-identity channel-identity)))
- "\n"))))
-
-(defun riece-handle-topic-message (prefix decoded)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters (riece-decoded-string decoded)))
- (channel (car parameters))
- topic
- (user-identity (riece-make-identity user riece-server-name))
- (channel-identity (riece-make-identity channel riece-server-name)))
- (setq parameters (riece-split-parameters
- (riece-decoded-string-for-identity decoded
- channel-identity))
- topic (nth 1 parameters))
- (riece-channel-set-topic (riece-get-channel channel) topic)
- (riece-emit-signal 'channel-topic-changed
- channel-identity topic)
- (let ((buffer (riece-channel-buffer channel-identity)))
- (riece-insert-change
- buffer
- (format (riece-mcat "Topic by %s: %s\n")
- (riece-format-identity user-identity t)
- topic))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "Topic on %s by %s: %s")
- (riece-format-identity channel-identity t)
- (riece-format-identity user-identity t)
- topic))
- "\n")))))
-
-(defun riece-handle-mode-message (prefix string)
- (let* ((user (riece-prefix-nickname prefix))
- (user-identity (riece-make-identity user riece-server-name))
- channel)
- (when (string-match "^\\([^ ]+\\) *:?" string)
- (setq channel (match-string 1 string)
- string (substring string (match-end 0)))
- (if (string-match (concat "^" riece-channel-regexp "$") channel)
- (riece-naming-assert-channel-modes channel
- (riece-parse-modes string)))
- (let* ((channel-identity (riece-make-identity channel riece-server-name))
- (buffer (riece-channel-buffer channel-identity)))
- (riece-insert-change
- buffer
- (format (riece-mcat "Mode by %s: %s\n")
- (riece-format-identity user-identity t)
- string))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format (riece-mcat "Mode on %s by %s: %s")
- (riece-format-identity channel-identity t)
- (riece-format-identity user-identity t)
- string))
- "\n"))))))
-
-(provide 'riece-handle)
-
-;;; riece-handle.el ends here
+++ /dev/null
-;;; riece-hangman.el --- allow channel members to play the hangman game
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-identity)
-(require 'riece-message)
-(require 'riece-server)
-
-(defgroup riece-hangman nil
- "Allow channel members to play the hangman game."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-hangman-hello-regexp "^,hangman$"
- "Pattern of string to start the game."
- :type 'string
- :group 'riece-hangman)
-
-(defcustom riece-hangman-bye-regexp "^,hangman bye$"
- "Pattern of string to end the game."
- :type 'string
- :group 'riece-hangman)
-
-(defcustom riece-hangman-words-file "/usr/share/dict/words"
- "Location of words file."
- :type 'file
- :group 'riece-hangman)
-
-(defvar riece-hangman-player-context-alist nil)
-(defvar riece-hangman-words-buffer nil)
-
-(defconst riece-hangman-description
- "Allow channel members to play the hangman game.")
-
-(put 'riece-hangman 'riece-addon-default-disabled t)
-
-(defun riece-hangman-make-context (word)
- "Make an instance of player context object.
-This function is for internal use only."
- (vector word nil 0))
-
-(defun riece-hangman-context-word (context)
- "Return the correct word of CONTEXT.
-This function is for internal use only."
- (aref context 0))
-
-(defun riece-hangman-context-guessed (context)
- "Return the guessed letters in this CONTEXT.
-This function is for internal use only."
- (aref context 1))
-
-(defun riece-hangman-context-missed-count (context)
- "Return the count of missed guesses in this CONTEXT.
-This function is for internal use only."
- (aref context 2))
-
-(defun riece-hangman-context-set-guessed (context guessed)
- "Set the GUESSED letters in this CONTEXT.
-This function is for internal use only."
- (aset context 1 guessed))
-
-(defun riece-hangman-context-set-missed-count (context missed-count)
- "Set the count of MISSED guesses in this CONTEXT.
-This function is for internal use only."
- (aset context 2 missed-count))
-
-(defun riece-hangman-word ()
- "Return random word.
-The wordlist is read from `riece-hangman-words-file'."
- (unless (and riece-hangman-words-buffer
- (buffer-name riece-hangman-words-buffer))
- (setq riece-hangman-words-buffer (generate-new-buffer " *riece-hangman*"))
- (save-excursion
- (set-buffer riece-hangman-words-buffer)
- (buffer-disable-undo)
- (insert-file-contents riece-hangman-words-file)
- (let ((case-fold-search nil))
- (delete-non-matching-lines "^[a-z][a-z][a-z][a-z][a-z][a-z]+"))))
- (save-excursion
- (set-buffer riece-hangman-words-buffer)
- (goto-char (1+ (random (buffer-size))))
- (if (eobp)
- (beginning-of-line -1)
- (beginning-of-line))
- (buffer-substring (point) (progn (end-of-line) (point)))))
-
-(defun riece-hangman-reply (target string)
- (riece-display-message
- (riece-make-message (riece-make-identity riece-real-nickname
- riece-server-name)
- (riece-make-identity target riece-server-name)
- string 'notice t))
- (riece-send-string (format "NOTICE %s :%s\r\n" target string)))
-
-(defun riece-hangman-reply-with-context (user target context)
- (let ((masked-word (make-string
- (length (riece-hangman-context-word context))
- ?-))
- (guessed (copy-sequence (riece-hangman-context-guessed context)))
- (index 0))
- (while (< index (length (riece-hangman-context-word context)))
- (if (memq (aref (riece-hangman-context-word context) index) guessed)
- (aset masked-word index
- (aref (riece-hangman-context-word context) index)))
- (setq index (1+ index)))
- (riece-hangman-reply
- target
- (format "%s: Word: %s, Guessed: %s"
- user masked-word
- (if guessed
- (apply #'string (sort guessed #'<))
- "")))))
-
-(defun riece-hangman-after-privmsg-hook (prefix string)
- (if (get 'riece-hangman 'riece-addon-enabled)
- (let* ((user (riece-prefix-nickname prefix))
- (parameters (riece-split-parameters string))
- (targets (split-string (car parameters) ","))
- (message (nth 1 parameters))
- case-fold-search
- pointer word guessed index)
- (if (string-match riece-hangman-hello-regexp message)
- (if (riece-identity-assoc user riece-hangman-player-context-alist
- t)
- (riece-hangman-reply
- (car targets)
- (format "%s: You are already playing the game." user))
- (let ((context (riece-hangman-make-context
- (riece-hangman-word))))
- (setq riece-hangman-player-context-alist
- (cons (cons user context)
- riece-hangman-player-context-alist))
- (riece-hangman-reply-with-context user (car targets) context)))
- (if (string-match riece-hangman-bye-regexp message)
- (when (setq pointer (riece-identity-assoc
- user riece-hangman-player-context-alist t))
- (setq riece-hangman-player-context-alist
- (delq pointer riece-hangman-player-context-alist))
- (riece-hangman-reply
- (car targets)
- (format "%s: Sorry, the word was \"%s\""
- user
- (riece-hangman-context-word (cdr pointer)))))
- (if (setq pointer (riece-identity-assoc
- user riece-hangman-player-context-alist t))
- (if (or (/= (length message) 1)
- (not (string-match "[a-z]" message)))
- (riece-hangman-reply
- (car targets)
- (format "%s: Not a valid guess: %s" user message))
- (if (memq (aref message 0)
- (riece-hangman-context-guessed (cdr pointer)))
- (riece-hangman-reply (car targets)
- (format "%s: Already guessed '%c'"
- user (aref message 0)))
- (setq guessed (riece-hangman-context-set-guessed
- (cdr pointer)
- (cons (aref message 0)
- (riece-hangman-context-guessed
- (cdr pointer))))
- word (riece-hangman-context-word (cdr pointer)))
- (unless (catch 'found
- (setq index 0)
- (while (< index (length word))
- (if (eq (aref word index) (aref message 0))
- (throw 'found t))
- (setq index (1+ index))))
- (riece-hangman-context-set-missed-count
- (cdr pointer)
- (1+ (riece-hangman-context-missed-count
- (cdr pointer)))))
- (if (>= (riece-hangman-context-missed-count (cdr pointer))
- 7)
- (progn
- (riece-hangman-reply
- (car targets)
- (format "%s: Sorry, the word was \"%s\""
- user
- (riece-hangman-context-word (cdr pointer))))
- (setq riece-hangman-player-context-alist
- (delq pointer
- riece-hangman-player-context-alist)))
- (if (catch 'missing
- (setq index 0)
- (while (< index (length word))
- (unless (memq (aref word index) guessed)
- (throw 'missing t))
- (setq index (1+ index))))
- (riece-hangman-reply-with-context user (car targets)
- (cdr pointer))
- (riece-hangman-reply (car targets)
- (format "%s: You got it! (%s)"
- user word))
- (setq riece-hangman-player-context-alist
- (delq
- pointer
- riece-hangman-player-context-alist))))))))))))
-
-(defun riece-hangman-insinuate ()
- (add-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
-
-(defun riece-hangman-uninstall ()
- (remove-hook 'riece-after-privmsg-hook 'riece-hangman-after-privmsg-hook))
-
-(defun riece-hangman-enable ()
- (random t))
-
-(provide 'riece-hangman)
-
-;;; riece-hangman.el ends here
+++ /dev/null
-;;; riece-highlight.el --- highlight IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-options) ;riece-channel-list-buffer-mode
-(require 'riece-identity) ;riece-format-identity
-(require 'riece-misc)
-(require 'font-lock)
-(require 'derived)
-
-(defgroup riece-highlight nil
- "Decorate IRC buffers with faces and fonts."
- :tag "Highlight"
- :prefix "riece-"
- :group 'riece)
-
-(defgroup riece-highlight-faces nil
- "Faces for highlight IRC buffers."
- :tag "Faces"
- :prefix "riece-highlight-"
- :group 'riece-highlight)
-
-(defface riece-dialogue-change-face
- '((((class color)
- (background dark))
- (:foreground "cyan" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Change:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-change-face 'riece-dialogue-change-face)
-
-(defface riece-dialogue-notice-face
- '((((class color)
- (background dark))
- (:foreground "green2" :bold t))
- (((class color)
- (background light))
- (:foreground "MidnightBlue" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Notice:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-notice-face 'riece-dialogue-notice-face)
-
-(defface riece-dialogue-wallops-face
- '((((class color)
- (background dark))
- (:foreground "yellow" :bold t))
- (((class color)
- (background light))
- (:foreground "blue4" :bold t))
- (t
- (:bold t)))
- "Face used for displaying \"*** Wallops:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-wallops-face 'riece-dialogue-wallops-face)
-
-(defface riece-dialogue-error-face
- '((((class color)
- (background dark))
- (:foreground "cornflower blue" :bold t))
- (((class color)
- (background light))
- (:foreground "DarkGreen"))
- (t
- (:bold t)))
- "Face used for displaying \"*** Error:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-error-face 'riece-dialogue-error-face)
-
-(defface riece-dialogue-info-face
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise" :bold t))
- (((class color)
- (background light))
- (:foreground "RoyalBlue"))
- (t
- (:bold t)))
- "Face used for displaying \"*** Info:\" line"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-info-face 'riece-dialogue-info-face)
-
-(defface riece-dialogue-server-face
- '((((class color)
- (background dark))
- (:foreground "Gray70"))
- (((class color)
- (background light))
- (:foreground "DimGray"))
- (t
- (:bold t)))
- "Face used for displaying \"(from server)\" extent."
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-server-face 'riece-dialogue-server-face)
-
-(defface riece-dialogue-prefix-face
- '((((class color)
- (background dark))
- (:foreground "moccasin"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- (:bold nil)))
- "Face used for displaying \"<nick>\" extent"
- :group 'riece-highlight-faces)
-(defvar riece-dialogue-prefix-face 'riece-dialogue-prefix-face)
-
-(defcustom riece-dialogue-font-lock-keywords
- (append
- (list (list (concat "^" riece-time-prefix-regexp
- "\\(<[^>]+>\\|>[^<]+<\\|([^)]+)\\|{[^}]+}\\|=[^=]+=\\)")
- '(1 riece-dialogue-prefix-face append t)))
- ;; set property to the whole line
- (mapcar
- (lambda (line)
- (cons
- (concat
- "^" riece-time-prefix-regexp "\\("
- (regexp-quote
- (symbol-value (intern (format "riece-%s-prefix" line))))
- ".*\\)$")
- (list 1 (intern (format "riece-dialogue-%s-face" line)) t t)))
- '(change notice wallops error info))
- '((riece-highlight-server-match 0 riece-dialogue-server-face t)))
- "Default expressions to highlight in riece-dialogue-mode."
- :type '(repeat (list string))
- :group 'riece-highlight)
-
-(defface riece-channel-list-default-face
- '((t ()))
- "Face used for displaying channels."
- :group 'riece-highlight-faces)
-(defvar riece-channel-list-default-face 'riece-channel-list-default-face)
-
-(defface riece-channel-list-current-face
- '((((class color)
- (background dark))
- (:foreground "turquoise" :underline t))
- (((class color)
- (background light))
- (:foreground "SeaGreen" :underline t))
- (t
- ()))
- "Face used for displaying the current channel."
- :group 'riece-highlight-faces)
-(defvar riece-channel-list-current-face 'riece-channel-list-current-face)
-
-(defcustom riece-channel-list-mark-face-alist
- '((?* . riece-channel-list-current-face))
- "An alist mapping marks on riece-channel-list-buffer to faces."
- :type 'list
- :group 'riece-highlight)
-
-(defcustom riece-channel-list-font-lock-keywords
- '(("^[ 0-9][0-9]:\\(.\\)\\(.*\\)"
- (2 (or (cdr (assq (aref (match-string 1) 0)
- riece-channel-list-mark-face-alist))
- riece-channel-list-default-face))))
- "Default expressions to highlight in riece-channel-list-mode."
- :type '(repeat (list string))
- :group 'riece-highlight)
-
-(unless (riece-facep 'riece-modeline-current-face)
- (make-face 'riece-modeline-current-face
- "Face used for displaying the current channel in modeline.")
- (if (featurep 'xemacs)
- (set-face-parent 'riece-modeline-current-face 'modeline))
- (set-face-foreground 'riece-modeline-current-face
- (face-foreground 'riece-channel-list-current-face)))
-
-(defconst riece-highlight-description
- "Highlight IRC buffers.")
-
-(defun riece-highlight-server-match (limit)
- (and (re-search-forward "(from [^)]+)$" limit t)
- (get-text-property (match-beginning 0) 'riece-server-name)))
-
-(defun riece-highlight-setup-dialogue ()
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(riece-dialogue-font-lock-keywords t))
- ;; In XEmacs, auto-initialization of font-lock is not affective
- ;; when buffer-file-name is not set.
- (font-lock-set-defaults)
- (make-local-hook 'after-change-functions)
- (add-hook 'after-change-functions
- 'riece-highlight-hide-prefix nil t)
- (if (get 'riece-highlight 'riece-addon-enabled)
- (font-lock-mode 1)))
-
-(defun riece-highlight-setup-channel-list ()
- (make-local-variable 'font-lock-defaults)
- (setq font-lock-defaults '(riece-channel-list-font-lock-keywords t))
- ;; In XEmacs, auto-initialization of font-lock is not affective
- ;; when buffer-file-name is not set.
- (font-lock-set-defaults)
- (if (get 'riece-highlight 'riece-addon-enabled)
- (font-lock-mode 1)))
-
-(defun riece-highlight-hide-prefix (start end length)
- (save-excursion
- (goto-char start)
- (if (looking-at riece-prefix-regexp)
- (put-text-property (match-beginning 1) (match-end 1) 'invisible t))))
-
-(defun riece-highlight-put-overlay-faces (start end)
- (if (get 'riece-highlight 'riece-addon-enabled)
- (riece-scan-property-region
- 'riece-overlay-face
- start end
- (lambda (start end)
- (riece-overlay-put (riece-make-overlay start end)
- 'face
- (get-text-property start 'riece-overlay-face))))))
-
-(defun riece-highlight-format-identity-for-channel-list-indicator (index
- identity)
- (if (and (get 'riece-highlight 'riece-addon-enabled)
- (riece-identity-equal identity riece-current-channel))
- (let ((string (riece-format-identity identity))
- (start 0))
- ;; Escape % -> %%.
- (while (string-match "%" string start)
- (setq start (1+ (match-end 0))
- string (replace-match "%%" nil nil string)))
- (list (format "%d:" index)
- (riece-propertize-modeline-string
- string 'face 'riece-modeline-current-face)))))
-
-(defun riece-highlight-insinuate ()
- (put 'riece-channel-mode 'font-lock-defaults
- '(riece-dialogue-font-lock-keywords t))
- (put 'riece-others-mode 'font-lock-defaults
- '(riece-dialogue-font-lock-keywords t))
- (put 'riece-dialogue-mode 'font-lock-defaults
- '(riece-dialogue-font-lock-keywords t))
- (add-hook 'riece-dialogue-mode-hook
- 'riece-highlight-setup-dialogue)
- (put 'riece-channel-list-mode 'font-lock-defaults
- '(riece-channel-list-font-lock-keywords t))
- (add-hook 'riece-channel-list-mode-hook
- 'riece-highlight-setup-channel-list)
- (add-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-highlight-format-identity-for-channel-list-indicator)
- (add-hook 'riece-after-insert-functions
- 'riece-highlight-put-overlay-faces))
-
-(defun riece-highlight-uninstall ()
- (let ((buffers riece-buffer-list))
- (save-excursion
- (while buffers
- (set-buffer (car buffers))
- (if (eq (derived-mode-class major-mode)
- 'riece-dialogue-mode)
- (remove-hook 'after-change-functions
- 'riece-highlight-hide-prefix t))
- (setq buffers (cdr buffers)))))
- (riece-remprop 'riece-channel-mode 'font-lock-defaults)
- (riece-remprop 'riece-others-mode 'font-lock-defaults)
- (riece-remprop 'riece-dialogue-mode 'font-lock-defaults)
- (remove-hook 'riece-dialogue-mode-hook
- 'riece-highlight-setup-dialogue)
- (riece-remprop 'riece-channel-list-mode 'font-lock-defaults)
- (remove-hook 'riece-channel-list-mode-hook
- 'riece-highlight-setup-channel-list)
- (remove-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-highlight-format-identity-for-channel-list-indicator)
- (remove-hook 'riece-after-insert-functions
- 'riece-highlight-put-overlay-faces))
-
-(defun riece-highlight-enable ()
- (let ((buffers riece-buffer-list))
- (while buffers
- (if (memq (derived-mode-class
- (with-current-buffer (car buffers)
- major-mode))
- '(riece-dialogue-mode riece-channel-list-mode))
- (with-current-buffer (car buffers)
- (font-lock-mode 1)))
- (setq buffers (cdr buffers)))))
-
-(defun riece-highlight-disable ()
- (let ((buffers riece-buffer-list))
- (while buffers
- (if (memq (derived-mode-class
- (with-current-buffer (car buffers)
- major-mode))
- '(riece-dialogue-mode riece-channel-list-mode))
- (with-current-buffer (car buffers)
- (font-lock-mode 0)))
- (setq buffers (cdr buffers)))))
-
-(provide 'riece-highlight)
-
-;;; riece-highlight.el ends here
+++ /dev/null
-;;; riece-history.el --- manage history of channel shifting
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; You can check recently visited channels via `C-c g' in the commands
-;; buffer, by adding the following lines to ~/.riece/init.el:
-
-;; (add-hook 'riece-guess-channel-try-functions
-;; 'riece-guess-channel-from-history)
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-globals)
-(require 'riece-identity)
-(require 'riece-signal)
-(require 'ring)
-(require 'riece-highlight)
-
-(defgroup riece-history nil
- "Manage history of channel shifting."
- :tag "History"
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-channel-history-length 3
- "Length of riece-channel-history."
- :type 'integer
- :group 'riece-history)
-
-(defface riece-channel-list-history-face
- '((((class color)
- (background dark))
- (:foreground "PaleTurquoise"))
- (((class color)
- (background light))
- (:foreground "SeaGreen3"))
- (t
- (:bold t)))
- "Face used for displaying history channels."
- :group 'riece-highlight-faces)
-(defvar riece-channel-list-history-face 'riece-channel-list-history-face)
-
-(unless (riece-facep 'riece-modeline-history-face)
- (make-face 'riece-modeline-history-face
- "Face used for displaying history channels in modeline.")
- (if (featurep 'xemacs)
- (set-face-parent 'riece-modeline-history-face 'modeline))
- (set-face-foreground 'riece-modeline-history-face
- (face-foreground 'riece-channel-list-history-face)))
-
-(defvar riece-modeline-history-face 'riece-modeline-history-face)
-
-(defvar riece-channel-history nil)
-
-(defconst riece-history-description
- "Manage history of channel shifting.")
-
-(defun riece-guess-channel-from-history ()
- (let ((length (ring-length riece-channel-history))
- (index 0)
- result)
- (while (< index length)
- (setq result (cons (ring-ref riece-channel-history index) result)
- index (1+ index)))
- (nreverse result)))
-
-(defun riece-history-format-identity-for-channel-list-buffer (index identity)
- (if (and (get 'riece-history 'riece-addon-enabled)
- (not (ring-empty-p riece-channel-history))
- (riece-identity-equal identity (ring-ref riece-channel-history 0)))
- (concat (format "%2d:+" index)
- (riece-format-identity identity))))
-
-(defun riece-history-format-identity-for-channel-list-indicator (index
- identity)
- (if (and (get 'riece-history 'riece-addon-enabled)
- (not (ring-empty-p riece-channel-history))
- (riece-identity-equal identity (ring-ref riece-channel-history 0)))
- (let ((string (riece-format-identity identity))
- (start 0))
- ;; Escape % -> %%.
- (while (string-match "%" string start)
- (setq start (1+ (match-end 0))
- string (replace-match "%%" nil nil string)))
- (list (format "%d:" index)
- (riece-propertize-modeline-string
- string 'face 'riece-modeline-history-face)))))
-
-;;; (defun riece-history-requires ()
-;;; (if (memq 'riece-guess riece-addons)
-;;; '(riece-guess)))
-
-(defun riece-history-after-switch-to-channel-functions (last)
- (if (and (get 'riece-history 'riece-addon-enabled) last
- (not (riece-identity-equal last riece-current-channel)))
- (ring-insert riece-channel-history last)))
-
-(defun riece-history-requires ()
- (if (memq 'riece-highlight riece-addons)
- '(riece-highlight)))
-
-(defun riece-history-insinuate ()
- (add-hook 'riece-after-switch-to-channel-functions
- 'riece-history-after-switch-to-channel-functions)
- (add-hook 'riece-format-identity-for-channel-list-buffer-functions
- 'riece-history-format-identity-for-channel-list-buffer)
- (add-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-history-format-identity-for-channel-list-indicator)
- (if (memq 'riece-highlight riece-addons)
- (setq riece-channel-list-mark-face-alist
- (cons '(?+ . riece-channel-list-history-face)
- riece-channel-list-mark-face-alist)))
-;;; (if (memq 'riece-guess riece-addons)
-;;; (add-hook 'riece-guess-channel-try-functions
-;;; 'riece-guess-channel-from-history))
- )
-
-(defun riece-history-uninstall ()
- (remove-hook 'riece-after-switch-to-channel-functions
- 'riece-history-after-switch-to-channel-functions)
- (remove-hook 'riece-format-identity-for-channel-list-buffer-functions
- 'riece-history-format-identity-for-channel-list-buffer)
- (remove-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-history-format-identity-for-channel-list-indicator)
- (setq riece-channel-list-mark-face-alist
- (delq (assq ?+ riece-channel-list-mark-face-alist)
- riece-channel-list-mark-face-alist)))
-
-(defun riece-history-enable ()
- (setq riece-channel-history
- (make-ring riece-channel-history-length))
- (riece-emit-signal 'channel-list-changed))
-
-(defun riece-history-disable ()
- (setq riece-channel-history nil)
- (riece-emit-signal 'channel-list-changed))
-
-(provide 'riece-history)
-
-;;; riece-history.el ends here
+++ /dev/null
-;;; riece-icon.el --- display icons in IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-signal)
-
-(defvar riece-channel-list-icons
- '((" " . "/* XPM */
-static char * blank_xpm[] = {
-\"12 12 1 1\",
-\" c None\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- ("!" . "/* XPM */
-static char * balloon_xpm[] = {
-\"12 12 3 1\",
-\" c None\",
-\"+ c #FFDD99\",
-\"@ c #000000\",
-\" \",
-\" ++++ \",
-\" ++++++++ \",
-\" ++@@@@@@++ \",
-\" ++++++++++ \",
-\" ++@@@@@@++ \",
-\" ++++++++++ \",
-\" ++@@@@@@++ \",
-\" ++++++++ \",
-\" ++++++ \",
-\" +++ \",
-\" + \"};")
- ("+" . "/* XPM */
-static char * check_xpm[] = {
-\"12 12 3 1\",
-\" c None\",
-\". c #9696FF\",
-\"+ c #5959FF\",
-\" \",
-\" \",
-\" .. .. \",
-\".++. .++.\",
-\" .++. .++. \",
-\" .++..++. \",
-\" .++++. \",
-\" .++. \",
-\" .. \",
-\" \",
-\" \",
-\" \"};")
- ("*" . "/* XPM */
-static char * active_xpm[] = {
-\"12 12 3 1\",
-\" c None\",
-\". c #96FF96\",
-\"+ c #59FF59\",
-\" \",
-\" .. \",
-\" .+. \",
-\" .....++. \",
-\" .+++++++. \",
-\" .++++++++. \",
-\" .+++++++. \",
-\" .....++. \",
-\" .+. \",
-\" .. \",
-\" \",
-\" \"};")))
-
-(defvar riece-user-list-icons
- '((" " . "/* XPM */
-static char * blank_xpm[] = {
-\"12 12 1 1\",
-\" c None\",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \",
-\" \"};")
- ("@" . "/* XPM */
-static char * spiral_xpm[] = {
-\"12 12 3 1\",
-\" c None\",
-\". c #FF5959\",
-\"+ c #FF9696\",
-\" \",
-\" \",
-\" +++++ \",
-\" ++...++ \",
-\" ++.+++.++ \",
-\" +.++.++.+ \",
-\" +.+.+.+.+ \",
-\" +.+.+++.+ \",
-\" +.++...++ \",
-\" ++.+++++.+\",
-\" ++.....+ \",
-\" ++++++ \"};")
- ("+" . "/* XPM */
-static char * cross_xpm[] = {
-\"12 12 3 1\",
-\" c None\",
-\". c #7F7F7F\",
-\"+ c #B2B2B2\",
-\" ++ \",
-\" +..+ \",
-\" +..+ \",
-\" +++..+++ \",
-\" +........+ \",
-\" +........+ \",
-\" +++..+++ \",
-\" +..+ \",
-\" +..+ \",
-\" +..+ \",
-\" +..+ \",
-\" ++ \"};")))
-
-(defvar riece-pointer-icon
- "/* XPM */
-static char * a_xpm[] = {
-\"14 14 5 1\",
-\" c None\",
-\". c #FF9646\",
-\"+ c #FF5909\",
-\"@ c #FF7020\",
-\"* c #FFA500\",
-\" \",
-\" @@@@@@@@@@@ \",
-\" @*.++++++.**@\",
-\" @*.++...++.*@\",
-\" @*.++.*.++.*@\",
-\" @*.++...+.**@\",
-\" @*.+++.+.***@\",
-\" @*.++.*.+.**@\",
-\" @*.++.*.++.*@\",
-\" @*.++.*.++.*@\",
-\" @*.++.*.++.*@\",
-\" @**..***..**@\",
-\" @@@@@@@@@@@ \",
-\" \"};")
-
-(defconst riece-icon-description
- "Display icons in IRC buffers.")
-
-(defun riece-icon-available-p ()
- (if (featurep 'xemacs)
- (featurep 'xpm)
- (if (fboundp 'image-type-available-p)
- (image-type-available-p 'xpm))))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (defun riece-icon-make-image (data string)
- (make-glyph (list (vector 'xpm :data data)
- (vector 'string :data string))))
- (defun riece-icon-make-image (data string)
- (create-image data 'xpm t :ascent 'center))))
-
-(defun riece-icon-make-images (alist)
- (let ((pointer (setq alist (copy-alist alist))))
- (while pointer
- (setcdr (car pointer)
- (riece-icon-make-image (cdr (car pointer)) (car (car pointer))))
- (setq pointer (cdr pointer)))
- alist))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (defun riece-icon-add-image-region (image start end)
- (map-extents
- (lambda (extent ignore)
- (if (or (extent-property extent 'riece-icon-user-list-extent)
- (extent-property extent 'riece-icon-user-list-annotation))
- (delete-extent extent)))
- (current-buffer) start end)
- (let ((extent (make-extent start end))
- (annotation (make-annotation image end 'text)))
- (set-extent-property extent 'end-open t)
- (set-extent-property extent 'start-open t)
- (set-extent-property extent 'invisible t)
- (set-extent-property extent 'intangible t)
- (set-extent-property annotation
- 'riece-icon-user-list-extent extent)
- (set-extent-property extent
- 'riece-icon-user-list-annotation annotation)))
- (defun riece-icon-add-image-region (image start end)
- (let ((inhibit-read-only t)
- buffer-read-only)
- (add-text-properties start end
- (list 'display
- image
- 'rear-nonsticky (list 'display)))))))
-
-(defun riece-icon-update-user-list-buffer ()
- (if (get 'riece-icon 'riece-addon-enabled)
- (let ((images (riece-icon-make-images riece-user-list-icons)))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^[ @+]" nil t)
- (riece-icon-add-image-region
- (cdr (assoc (match-string 0) images))
- (1- (point)) (point)))))))
-
-(defun riece-icon-update-channel-list-buffer ()
- (if (get 'riece-icon 'riece-addon-enabled)
- (let ((images (riece-icon-make-images riece-channel-list-icons)))
- (save-excursion
- (goto-char (point-min))
- (while (re-search-forward "^ ?[0-9]+:\\([ !+*]\\)" nil t)
- (riece-icon-add-image-region
- (cdr (assoc (match-string 1) images))
- (match-beginning 1) (match-end 1)))))))
-
-(eval-and-compile
- (if (featurep 'xemacs)
- (progn
- (defvar riece-icon-xemacs-modeline-left-extent
- (copy-extent modeline-buffer-id-left-extent))
-
- (defvar riece-icon-xemacs-modeline-right-extent
- (copy-extent modeline-buffer-id-right-extent))
-
- (defun riece-icon-modeline-buffer-identification (line)
- "Decorate 1st element of `mode-line-buffer-identification' LINE.
-Modify whole identification by side effect."
- (let ((id (car line)) chopped)
- (if (and (stringp id) (string-match "^Riece:" id))
- (progn
- (setq chopped (substring id 0 (match-end 0))
- id (substring id (match-end 0)))
- (nconc
- (list
- (let ((glyph
- (make-glyph
- (nconc
- (if (featurep 'xpm)
- (list (vector 'xpm :data
- riece-pointer-icon)))
- (list (vector 'string :data chopped))))))
- (set-glyph-face glyph 'modeline-buffer-id)
- (cons riece-icon-xemacs-modeline-left-extent glyph))
- (cons riece-icon-xemacs-modeline-right-extent id))
- (cdr line)))
- line))))
- (condition-case nil
- (progn
- (require 'image)
- (defun riece-icon-modeline-buffer-identification (line)
- "Decorate 1st element of `mode-line-buffer-identification' LINE.
-Modify whole identification by side effect."
- (let ((id (copy-sequence (car line)))
- (image
- (if (image-type-available-p 'xpm)
- (create-image riece-pointer-icon 'xpm t
- :ascent 'center))))
- (when (and image
- (stringp id) (string-match "^Riece:" id))
- (add-text-properties 0 (length id)
- (list 'display image
- 'rear-nonsticky (list 'display))
- id)
- (setcar line id))
- line)))
- (error
- (defalias 'riece-icon-modeline-buffer-identification 'identity)))))
-
-(defun riece-icon-user-list-mode-hook ()
- (if (riece-icon-available-p)
- (add-hook 'riece-update-buffer-functions
- 'riece-icon-update-user-list-buffer t t)))
-
-(defun riece-icon-channel-list-mode-hook ()
- (if (riece-icon-available-p)
- (add-hook 'riece-update-buffer-functions
- 'riece-icon-update-channel-list-buffer t t)))
-
-(defun riece-icon-insinuate ()
- (save-excursion
- (when riece-user-list-buffer
- (set-buffer riece-user-list-buffer)
- (riece-icon-user-list-mode-hook))
- (when riece-channel-list-buffer
- (set-buffer riece-channel-list-buffer)
- (riece-icon-channel-list-mode-hook)))
- (add-hook 'riece-user-list-mode-hook
- 'riece-icon-user-list-mode-hook)
- (add-hook 'riece-channel-list-mode-hook
- 'riece-icon-channel-list-mode-hook))
-
-(defun riece-icon-uninstall ()
- (save-excursion
- (when riece-user-list-buffer
- (set-buffer riece-user-list-buffer)
- (remove-hook 'riece-update-buffer-functions
- 'riece-icon-update-user-list-buffer t))
- (when riece-channel-list-buffer
- (set-buffer riece-channel-list-buffer)
- (remove-hook 'riece-update-buffer-functions
- 'riece-icon-update-channel-list-buffer t)))
- (remove-hook 'riece-user-list-mode-hook
- 'riece-icon-user-list-mode-hook)
- (remove-hook 'riece-channel-list-mode-hook
- 'riece-icon-channel-list-mode-hook))
-
-(defvar riece-icon-original-mode-line-buffer-identification nil)
-
-(defun riece-icon-update-mode-line-buffer-identification ()
- (let ((buffers riece-buffer-list))
- (save-excursion
- (while buffers
- (set-buffer (car buffers))
- (if (local-variable-p 'riece-mode-line-buffer-identification
- (car buffers))
- (setq mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)))
- (setq buffers (cdr buffers))))))
-
-(defun riece-icon-enable ()
- (setq riece-icon-original-mode-line-buffer-identification
- (symbol-function 'riece-mode-line-buffer-identification))
- (defalias 'riece-mode-line-buffer-identification
- 'riece-icon-modeline-buffer-identification)
- (riece-icon-update-mode-line-buffer-identification)
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (riece-emit-signal 'channel-list-changed))
-
-(defun riece-icon-disable ()
- (fset 'riece-mode-line-buffer-identification
- riece-icon-original-mode-line-buffer-identification)
- (riece-icon-update-mode-line-buffer-identification)
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel))
- (riece-emit-signal 'channel-list-changed))
-
-(provide 'riece-icon)
-
-;;; riece-icon.el ends here
+++ /dev/null
-;;; riece-identity.el --- an identity object
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-coding)
-
-(defcustom riece-channel-coding-system-alist nil
- "An alist mapping from channels to coding-systems."
- :type '(repeat (cons (string :tag "Channel")
- (symbol :tag "Coding system")))
- :group 'riece-coding)
-
-(defvar riece-abbrev-identity-string-function nil)
-(defvar riece-expand-identity-string-function nil)
-
-(defconst riece-identity-prefix-case-pair-alist
- '((?\[ . ?{)
- (?\] . ?})
- (?\\ . ?|)
- (?~ . ?^))
- "An alist used to canonicalize identity-prefix.
-RFC2812, 2.2 \"Character codes\" says:
- Because of IRC's Scandinavian origin, the characters {}|^ are
- considered to be the lower case equivalents of the characters []\~,
- respectively. This is a critical issue when determining the
- equivalence of two nicknames or channel names.")
-
-(defun riece-identity-prefix (identity)
- "Return the component sans its server name from IDENTITY."
- (aref identity 0))
-
-(defun riece-identity-server (identity)
- "Return the server name component in IDENTITY."
- (aref identity 1))
-
-(defun riece-make-identity (prefix server)
- "Make an identity object from PREFIX and SERVER."
- (vector prefix server))
-
-(defun riece-identity-equal (ident1 ident2)
- "Return t, if IDENT1 and IDENT2 are equal."
- (and (riece-identity-equal-no-server
- (riece-identity-prefix ident1)
- (riece-identity-prefix ident2))
- (equal
- (riece-identity-server ident1)
- (riece-identity-server ident2))))
-
-(defun riece-identity-canonicalize-prefix (prefix)
- "Canonicalize identity PREFIX."
- (let ((i 0)
- c)
- (setq prefix (downcase prefix))
- (while (< i (length prefix))
- (if (setq c (cdr (assq (aref prefix i)
- riece-identity-prefix-case-pair-alist)))
- (aset prefix i c))
- (setq i (1+ i)))
- prefix))
-
-(defun riece-identity-equal-no-server (prefix1 prefix2)
- "Return t, if IDENT1 and IDENT2 are equal without server part."
- (equal (riece-identity-canonicalize-prefix prefix1)
- (riece-identity-canonicalize-prefix prefix2)))
-
-(defun riece-identity-member (elt list &optional no-server)
- "Return non-nil if an identity ELT is an element of LIST."
- (catch 'found
- (while list
- (if (and (car list) ;needed because riece-current-channels
- ;contains nil.
- (if no-server
- (riece-identity-equal-no-server (car list) elt)
- (riece-identity-equal (car list) elt)))
- (throw 'found list)
- (setq list (cdr list))))))
-
-(defun riece-identity-assoc (elt alist &optional no-server)
- "Return non-nil if an identity ELT matches the car of an element of ALIST."
- (catch 'found
- (while alist
- (if (if no-server
- (riece-identity-equal-no-server (car (car alist)) elt)
- (riece-identity-equal (car (car alist)) elt))
- (throw 'found (car alist))
- (setq alist (cdr alist))))))
-
-(defun riece-identity-assign-binding (item list binding)
- (let ((slot (riece-identity-member item binding))
- pointer)
- (unless list ;we need at least one room
- (setq list (list nil)))
- (setq pointer list)
- (if slot
- (while (not (eq binding slot))
- (unless (cdr pointer)
- (setcdr pointer (list nil)))
- (setq pointer (cdr pointer)
- binding (cdr binding)))
- (while (or (car pointer) (car binding))
- (unless (cdr pointer)
- (setcdr pointer (list nil)))
- (setq pointer (cdr pointer)
- binding (cdr binding))))
- (setcar pointer item)
- list))
-
-(defun riece-format-identity (identity &optional prefix-only)
- "Convert IDENTITY object to a string.
-If the optional 2nd argument PREFIX-ONLY is non-nil, don't append
-server part of the identity.
-
-The returned string will be abbreviated by
-`riece-abbrev-identity-string-function', and `riece-identity' property
-will be added."
- (let ((string
- (if (or prefix-only
- (equal (riece-identity-server identity) ""))
- (copy-sequence (riece-identity-prefix identity))
- (concat (riece-identity-prefix identity) " "
- (riece-identity-server identity)))))
- (if riece-abbrev-identity-string-function
- (setq string (funcall riece-abbrev-identity-string-function string)))
- (riece-put-text-property-nonsticky 0 (length string)
- 'riece-identity identity
- string)
- (if prefix-only
- (riece-put-text-property-nonsticky 0 (length string)
- 'riece-format-identity-prefix-only t
- string))
- string))
-
-(defun riece-parse-identity (string)
- "Convert STRING to an identity object.
-The string will be expanded by
-`riece-expand-identity-string-function'."
- (if riece-expand-identity-string-function
- (setq string (funcall riece-expand-identity-string-function string)))
- (riece-make-identity (if (string-match " " string)
- (substring string 0 (match-beginning 0))
- string)
- (if (string-match " " string)
- (substring string (match-end 0))
- "")))
-
-(defun riece-completing-read-identity (prompt channels
- &optional predicate require-match
- initial history default
- no-server)
- "Read an identity object in the minibuffer, with completion.
-PROMPT is a string to prompt with; normally it ends in a colon and a space.
-CHANNELS is a list of identity objects.
-The rest of arguments are the same as `completing-read'."
- (let* ((string
- (completing-read
- prompt
- (mapcar (lambda (channel)
- (list (riece-format-identity channel no-server)))
- (delq nil (copy-sequence (or channels
- riece-current-channels))))
- predicate require-match initial history default))
- (identity
- (riece-parse-identity string)))
-;;; (unless (string-match (concat "^\\(" riece-channel-regexp "\\|"
-;;; riece-user-regexp "\\)")
-;;; (riece-identity-prefix identity))
-;;; (error "Invalid channel name!"))
- identity))
-
-(defun riece-coding-system-for-identity (identity)
- (let ((alist riece-channel-coding-system-alist)
- matcher)
- (catch 'found
- (while alist
- (setq matcher (riece-parse-identity (car (car alist))))
- (if (and (equal (riece-identity-server matcher)
- (riece-identity-server identity))
- (equal (riece-identity-prefix matcher)
- (riece-identity-prefix identity)))
- (throw 'found (cdr (car alist))))
- (setq alist (cdr alist))))))
-
-(defun riece-decoded-string-for-identity (decoded identity)
- "Return the string decoded for IDENTITY."
- (let ((coding-system (riece-coding-system-for-identity identity)))
- (if (and coding-system
- (not (eq (riece-decoded-coding-system decoded)
- (if (consp coding-system)
- (car coding-system)
- coding-system))))
- (riece-decode-coding-string-1 (riece-decoded-encoded-string decoded)
- coding-system)
- decoded)))
-
-(defun riece-encode-coding-string-for-identity (string identity)
- (let ((coding-system (riece-coding-system-for-identity identity)))
- (if coding-system
- (encode-coding-string string
- (if (consp coding-system)
- (cdr coding-system)
- coding-system))
- (riece-encode-coding-string string))))
-
-(provide 'riece-identity)
-
-;;; riece-identity.el ends here
+++ /dev/null
-;;; riece-ignore.el --- ignore messages from some users
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-signal)
-(require 'riece-identity)
-(require 'riece-message)
-
-(defgroup riece-ignore nil
- "Ignore messages from some users."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-ignore-discard-message 'log
- "If t, messages from ignored user are completely discarded.
-If 'log, messages are removed from IRC buffers, but they are saved in
-`riece-ignore-buffer'.
-Otherwise, they are not removed from IRC buffers, but are hidden with
-'invisible text-property."
- :group 'riece-ignore
- :type '(choice (const :tag "Discard completely" t)
- (const :tag "Discard but save logs" log)
- (const :tag "Make messages invisible" nil)))
-
-(defcustom riece-ignore-buffer-name "*Ignore*"
- "The name of buffer where ignored messages are stored."
- :group 'riece-ignore
- :type 'string)
-
-(defcustom riece-startup-ignored-user-list nil
- "List of user names whose messages are ignored."
- :group 'riece-ignore
- :type '(repeat string))
-
-(defvar riece-ignore-buffer nil)
-
-(defconst riece-ignore-description
- "Ignore messages from some users.")
-(defvar riece-ignored-user-list nil)
-
-(defun riece-ignore-user-rename-signal-function (signal handback)
- (let ((pointer (riece-identity-member (car (riece-signal-args signal))
- riece-ignored-user-list)))
- (if pointer
- (setcar pointer (nth 1 (riece-signal-args signal))))))
-
-(defun riece-ignore-user (user toggle)
- (interactive
- (let ((completion-ignore-case t))
- (list (if current-prefix-arg
- (riece-completing-read-identity
- "Unignore user: "
- riece-ignored-user-list)
- (riece-completing-read-identity
- "Ignore user: "
- (riece-get-users-on-server (riece-current-server-name))
- (lambda (user)
- (not (riece-identity-member
- (riece-parse-identity (car user))
- riece-ignored-user-list)))))
- (not current-prefix-arg))))
- (if toggle
- (progn
- (setq riece-ignored-user-list (cons user riece-ignored-user-list))
- (riece-connect-signal
- 'user-renamed
- #'riece-ignore-user-rename-signal-function))
- (let ((pointer (riece-identity-member user riece-ignored-user-list)))
- (setq riece-ignored-user-list (delq (car pointer)
- riece-ignored-user-list))
- (riece-disconnect-signal
- 'user-renamed
- #'riece-ignore-user-rename-signal-function))))
-
-(eval-when-compile
- (autoload 'riece-dialogue-mode "riece"))
-(defun riece-ignore-message-filter (message)
- (if (and (get 'riece-ignore 'riece-addon-enabled)
- (riece-identity-member (riece-message-speaker message)
- riece-ignored-user-list))
- (if riece-ignore-discard-message
- (when (eq riece-ignore-discard-message 'log)
- (unless riece-ignore-buffer
- (with-current-buffer (setq riece-ignore-buffer
- (riece-get-buffer-create
- riece-ignore-buffer-name
- 'riece-dialogue-mode))
- (riece-dialogue-mode)))
- (save-excursion
- (set-buffer riece-ignore-buffer)
- (goto-char (point-max))
- (let ((inhibit-read-only t)
- buffer-read-only)
- (insert (concat (format-time-string "%H:%M") " "
- (riece-format-message message t))))))
- (put-text-property 0 (length (riece-message-text message))
- 'invisible 'riece-ignore
- (riece-message-text message))
- message)
- message))
-
-(defvar riece-command-mode-map)
-(defun riece-ignore-insinuate ()
- (setq riece-ignored-user-list
- (mapcar #'riece-parse-identity riece-startup-ignored-user-list))
- (add-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
-
-(defun riece-ignore-uninstall ()
- (setq riece-ignored-user-list nil)
- (remove-hook 'riece-message-filter-functions 'riece-ignore-message-filter))
-
-(defun riece-ignore-enable ()
- (define-key riece-command-mode-map
- "\C-ck" 'riece-ignore-user))
-
-(defun riece-ignore-disable ()
- (define-key riece-command-mode-map
- "\C-ck" nil))
-
-(provide 'riece-ignore)
-
-;;; riece-ignore.el ends here
\ No newline at end of file
+++ /dev/null
-;;; riece-irc.el --- IRC protocol
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-filter)
-(require 'riece-server)
-(require 'riece-mcat)
-
-(defun riece-irc-open-server (server server-name)
- (riece-server-keyword-bind server
- (let (selective-display
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- process)
- (if (equal server-name "")
- (message (riece-mcat "Connecting to IRC server..."))
- (message (riece-mcat "Connecting to %s...") server-name))
- (condition-case error
- (setq process
- (funcall function (riece-server-process-name server-name)
- (concat " *IRC*" server-name)
- host service))
- (error
- (if (equal server-name "")
- (message (riece-mcat "Connecting to IRC server...failed: %S")
- error)
- (message (riece-mcat "Connecting to %s...failed: %S") server-name
- error))
- (signal (car error) (cdr error))))
- (if (equal server-name "")
- (message (riece-mcat "Connecting to IRC server...done"))
- (message (riece-mcat "Connecting to %s...done") server-name))
- (riece-reset-process-buffer process)
- (with-current-buffer (process-buffer process)
- (setq riece-server-name server-name))
- (set-process-sentinel process 'riece-sentinel)
- (set-process-filter process 'riece-filter)
- (if (equal server-name "")
- (message (riece-mcat "Logging in to IRC server..."))
- (message (riece-mcat "Logging in to %s...") server-name))
- (if riece-reconnect-with-password ;password incorrect or not set.
- (unwind-protect
- (setq password
- (condition-case nil
- (let (inhibit-quit)
- (if (equal server-name "")
- (riece-read-passwd (riece-mcat "Password: "))
- (riece-read-passwd
- (format (riece-mcat "Password for %s: ")
- server-name))))
- (quit
- (if (equal server-name "")
- (message (riece-mcat "Password: Quit"))
- (message (riece-mcat "Password for %s: Quit")
- server-name))
- 'quit)))
- (setq riece-reconnect-with-password nil)))
- (if (eq password 'quit)
- (delete-process process)
- (if password
- (riece-process-send-string process
- (format "PASS %s\r\n" password)))
- (riece-process-send-string process
- (format "USER %s * * :%s\r\n"
- (or username
- (user-real-login-name))
- (or realname
- "No information given")))
- (riece-process-send-string process (format "NICK %s\r\n" nickname))
- (with-current-buffer (process-buffer process)
- (setq riece-last-nickname riece-real-nickname
- riece-nick-accepted 'sent
- riece-coding-system coding))
- process))))
-
-(defun riece-irc-quit-server-process (process &optional message)
- (if riece-quit-timeout
- (riece-run-at-time riece-quit-timeout nil
- (lambda (process)
- (if (rassq process riece-server-process-alist)
- (delete-process process)))
- process))
- (let ((server-name (with-current-buffer (process-buffer process)
- riece-server-name)))
- (if (equal server-name "")
- (message (riece-mcat "Sending QUIT..."))
- (message (riece-mcat "Sending QUIT to \"%s\"...") server-name))
- (riece-process-send-string process
- (if message
- (format "QUIT :%s\r\n" message)
- "QUIT\r\n"))
- (if (equal server-name "")
- (message (riece-mcat "Sending QUIT...done"))
- (message (riece-mcat "Sending QUIT to \"%s\"...done") server-name))))
-
-(provide 'riece-irc)
-
-;;; riece-irc.el ends here
+++ /dev/null
-;;; riece-kakasi.el --- convert Japanese to roman string by KAKASI
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(defconst riece-kakasi-description
- "Convert Japanese to roman string by KAKASI.")
-
-(defvar riece-kakasi-process nil)
-
-(require 'riece-message)
-
-(defun riece-kakasi-convert-string (string)
- (process-send-string riece-kakasi-process (concat string "\n"))
- (save-excursion
- (set-buffer (process-buffer riece-kakasi-process))
- (while (progn
- (goto-char (point-min))
- (not (search-forward "\n" nil t)))
- (accept-process-output riece-kakasi-process))
- (prog1 (buffer-substring (point-min) (1- (point)))
- (delete-region (point-min) (point)))))
-
-(defun riece-kakasi-message-filter (message)
- (if (get 'riece-kakasi 'riece-addon-enabled)
- (riece-message-set-text message
- (riece-kakasi-convert-string
- (riece-message-text message))))
- message)
-
-(defun riece-kakasi-insinuate ()
- (add-hook 'riece-message-filter-functions 'riece-kakasi-message-filter))
-
-(defun riece-kakasi-uninstall ()
- (remove-hook 'riece-message-filter-functions 'riece-kakasi-message-filter))
-
-(defun riece-kakasi-enable ()
- (setq riece-kakasi-process
- (start-process "kakasi" (generate-new-buffer " *riece-kakasi*")
- "kakasi" "-Ha" "-Ka" "-Ja" "-Ea" "-ka"))
- (with-current-buffer (process-buffer riece-kakasi-process)
- (buffer-disable-undo)
- (erase-buffer)))
-
-(defun riece-kakasi-disable ()
- (kill-buffer (process-buffer riece-kakasi-process)))
-
-(provide 'riece-kakasi)
-
-;;; riece-kakasi.el ends here
+++ /dev/null
-;;; riece-keepalive.el --- keep an IRC connection
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-server)
-
-(defgroup riece-keepalive nil
- "Keep an IRC connection."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-keepalive-ping-repeat 120
- "Interval for sending PING to server."
- :type 'integer
- :group 'riece-keepalive)
-
-(defvar riece-keepalive-timer nil)
-
-(defconst riece-keepalive-description
- "Keep an IRC connection.")
-
-(defun riece-keepalive-after-login-hook ()
- (make-local-variable 'riece-keepalive-timer)
- (unless riece-keepalive-timer
- (setq riece-keepalive-timer
- (riece-run-at-time
- riece-keepalive-ping-repeat riece-keepalive-ping-repeat
- (lambda (buffer)
- (save-excursion
- (set-buffer buffer)
- (riece-send-string "PING riece-keepalive\r\n")))
- (current-buffer)))))
-
-(defun riece-keepalive-after-close-hook ()
- (when riece-keepalive-timer
- (riece-cancel-timer riece-keepalive-timer)
- (setq riece-keepalive-timer nil)))
-
-(defun riece-keepalive-insinuate ()
- (add-hook 'riece-after-login-hook 'riece-keepalive-after-login-hook)
- (add-hook 'riece-after-close-hook 'riece-keepalive-after-close-hook))
-
-(defun riece-keepalive-uninstall ()
- (remove-hook 'riece-after-login-hook 'riece-keepalive-after-login-hook)
- (remove-hook 'riece-after-close-hook 'riece-keepalive-after-close-hook))
-
-(provide 'riece-keepalive)
-
-;;; riece-ignore.el ends here
+++ /dev/null
-;;; riece-keyword.el --- detect keywords in IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-message)
-
-(defgroup riece-keyword nil
- "Detect keywords in IRC buffers."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-keywords nil
- "Keywords to be highlightened."
- :type '(repeat (choice (string :tag "Keyword")
- (cons (string :tag "Regexp")
- (integer :tag "Match"))))
- :group 'riece-keyword)
-
-(defcustom riece-notify-keyword-functions nil
- "Functions used to notify keyword match."
- :type '(list function)
- :group 'riece-keyword)
-
-(make-obsolete-variable 'riece-notify-keyword-functions
- 'riece-keyword-notify-functions)
-
-(defcustom riece-keyword-notify-functions nil
- "Functions used to notify keyword match.
-Two arguments are passed to each function: the keyword used to match
-and the matched message object."
- :type '(list function)
- :group 'riece-keyword)
-
-(defface riece-keyword-face
- '((((class color))
- (:foreground "red" :underline t))
- (t
- (:underline t)))
- "Face used for highlightening matching keyword."
- :group 'riece-highlight-faces)
-(defvar riece-keyword-face 'riece-keyword-face)
-
-(defconst riece-keyword-description
- "Detect keywords in IRC buffers.")
-
-;;; The old XEmacs package doesn't have autoload setting for regexp-opt.
-(autoload 'regexp-opt "regexp-opt")
-(defun riece-keyword-message-filter (message)
- (if (and (get 'riece-keyword 'riece-addon-enabled)
- riece-keywords
- ;; Ignore messages which belongs to myself.
- (not (riece-message-own-p message)))
- (let* (keywords
- (alist
- (nconc
- (delq nil (mapcar
- (lambda (matcher)
- (if (stringp matcher)
- (ignore
- (setq keywords (cons matcher keywords)))
- matcher))
- riece-keywords))
- (list (cons (regexp-opt keywords) 0))))
- index)
- (while alist
- (setq index 0)
- (while (string-match (car (car alist))
- (riece-message-text message) index)
- (put-text-property (match-beginning (cdr (car alist)))
- (match-end (cdr (car alist)))
- 'riece-overlay-face riece-keyword-face
- (riece-message-text message))
- (run-hook-with-args 'riece-notify-keyword-functions
- (match-string (cdr (car alist))
- (riece-message-text message)))
- (run-hook-with-args 'riece-keyword-notify-functions
- (cdr (car alist))
- message)
- (setq index (match-end (cdr (car alist)))))
- (setq alist (cdr alist)))))
- message)
-
-(defun riece-keyword-requires ()
- (if (memq 'riece-highlight riece-addons)
- '(riece-highlight)))
-
-(defun riece-keyword-insinuate ()
- (add-hook 'riece-message-filter-functions 'riece-keyword-message-filter))
-
-(defun riece-keyword-uninstall ()
- (remove-hook 'riece-message-filter-functions 'riece-keyword-message-filter))
-
-(provide 'riece-keyword)
-
-;;; riece-keyword.el ends here
\ No newline at end of file
+++ /dev/null
-;;; riece-layout.el --- layout management
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; TAKAHASHI "beatmaria" Kaoru <kaoru@kaisei.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-misc)
-
-(defgroup riece-layout nil
- "Window layouts."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-layout "default"
- "Current layout setting."
- :type 'string
- :group 'riece-layout)
-
-(defcustom riece-layout-alist
- '(("middle-right" riece-configure-windows right middle)
- ("middle-left" riece-configure-windows left middle)
- ("top-right" riece-configure-windows right top)
- ("top-left" riece-configure-windows left top)
- ("bottom-right" riece-configure-windows right bottom)
- ("bottom-left" riece-configure-windows left bottom)
- ("top" riece-configure-windows-top)
- ("spiral" riece-configure-windows-spiral)
- ("default" . "middle-right"))
- "An alist mapping the names to layout functions.
-An element of this alist is either in the following forms:
-
-\(NAME CONFIGURE-FUNCTION [PARAMETERS]\)
-\(NAME1 . NAME2\)
-
-In the first form, NAME is a string which specifies the layout
-setting, and CONFIGURE-FUNCTION is a function which does window
-splitting, etc. PARAMETERS are collected and passed to CONFIGURE-FUNCTION.
-In the second form, NAME1 is an alias for NAME2."
- :type 'list
- :group 'riece-layout)
-
-(defun riece-redraw-layout (&optional force)
- "Reconfigure windows with the current layout.
-If optional argument FORCE is non-nil, window reconfiguration will
-happen unconditionally."
- (let ((layout (cdr (assoc riece-layout riece-layout-alist))))
- (unless layout
- (error "No such layout!"))
- (if (stringp layout)
- (let ((riece-layout layout))
- (riece-redraw-layout force))
- (if (or force
- (riece-reconfigure-windows-predicate))
- (apply (car layout) (cdr layout))))))
-
-(defun riece-set-window-points ()
- (if (get-buffer-window riece-user-list-buffer)
- (with-current-buffer riece-user-list-buffer
- (unless (riece-frozen riece-user-list-buffer)
- (set-window-start (get-buffer-window riece-user-list-buffer)
- (point-min)))))
- (if (get-buffer-window riece-channel-list-buffer)
- (with-current-buffer riece-channel-list-buffer
- (unless (riece-frozen riece-channel-list-buffer)
- (set-window-start (get-buffer-window riece-channel-list-buffer)
- (point-min)))))
- (if (and riece-channel-buffer
- (get-buffer-window riece-channel-buffer))
- (with-current-buffer riece-channel-buffer
- (if (riece-frozen riece-channel-buffer)
- (if riece-channel-buffer-window-point
- (set-window-point (get-buffer-window riece-channel-buffer)
- riece-channel-buffer-window-point))
- (set-window-point (get-buffer-window riece-channel-buffer)
- (point-max)))))
- (if (get-buffer-window riece-others-buffer)
- (with-current-buffer riece-others-buffer
- (unless (riece-frozen riece-others-buffer)
- (set-window-point (get-buffer-window riece-others-buffer)
- (point-max)))))
- (if (get-buffer-window riece-dialogue-buffer)
- (with-current-buffer riece-dialogue-buffer
- (unless (riece-frozen riece-dialogue-buffer)
- (set-window-point (get-buffer-window riece-dialogue-buffer)
- (point-max))))))
-
-(defun riece-reconfigure-windows-predicate ()
- "Return t, if window reconfiguration is needed.
-This function is used by \"default\" layout."
- (memq (window-buffer (selected-window))
- riece-buffer-list))
-
-(defun riece-configure-windows (hpos vpos)
- (let ((buffer (window-buffer))
- (show-user-list
- (and riece-user-list-buffer-mode
- riece-current-channel
- ;; User list buffer is nuisance for private conversation.
- (riece-channel-p (riece-identity-prefix
- riece-current-channel)))))
- ;; Can't expand minibuffer to full frame.
- (if (eq (selected-window) (minibuffer-window))
- (other-window 1))
- (delete-other-windows)
- (if (and riece-current-channel
- (or show-user-list riece-channel-list-buffer-mode))
- (let ((rest-window (split-window (selected-window)
- (if (eq hpos 'left)
- (- (window-width)
- (/ (window-width) 5))
- (/ (window-width) 5))
- t)))
- (when (eq hpos 'left)
- (setq rest-window (selected-window))
- (other-window 1))
- (if (and show-user-list riece-channel-list-buffer-mode)
- (progn
- (set-window-buffer (split-window)
- riece-channel-list-buffer)
- (set-window-buffer (selected-window)
- riece-user-list-buffer))
- (if show-user-list
- (set-window-buffer (selected-window)
- riece-user-list-buffer)
- (if riece-channel-list-buffer-mode
- (set-window-buffer (selected-window)
- riece-channel-list-buffer))))
- (select-window rest-window)))
- (if (and riece-current-channel
- riece-channel-buffer-mode)
- (progn
- (if (eq vpos 'top)
- (let ((rest-window (split-window nil 4)))
- (set-window-buffer (selected-window)
- riece-command-buffer)
- (select-window rest-window)
- (if riece-others-buffer-mode
- (set-window-buffer (split-window rest-window)
- riece-others-buffer))
- (set-window-buffer (selected-window)
- riece-channel-buffer))
- (if (and (eq vpos 'middle)
- riece-others-buffer-mode)
- (let ((rest-window (split-window)))
- (set-window-buffer (selected-window)
- riece-channel-buffer)
- (set-window-buffer (split-window rest-window 4)
- riece-others-buffer)
- (set-window-buffer rest-window
- riece-command-buffer))
- (let ((rest-window (split-window nil (- (window-height) 4))))
- (if riece-others-buffer-mode
- (progn
- (set-window-buffer (selected-window)
- riece-others-buffer)
- (set-window-buffer (split-window)
- riece-channel-buffer))
- (set-window-buffer (selected-window)
- riece-channel-buffer))
- (set-window-buffer rest-window
- riece-command-buffer)))))
- (if (eq vpos 'bottom)
- (progn
- (set-window-buffer (selected-window)
- riece-command-buffer)
- (set-window-buffer (split-window (selected-window) 4)
- riece-dialogue-buffer))
- (set-window-buffer (split-window (selected-window) 4)
- riece-dialogue-buffer)
- (set-window-buffer (selected-window)
- riece-command-buffer)))
- (riece-set-window-points)
- (select-window (or (get-buffer-window buffer)
- (get-buffer-window riece-command-buffer)))))
-
-(defun riece-configure-windows-top (&rest plist)
- "Candidate of `riece-configure-windows-function'.
-PLIST accept :command-height, :user-list-width, and :channel-list-width."
- (let ((command-height (or (plist-get plist :command-height) 4))
- (user-list-width (or (plist-get plist :user-list-width) (+ 9 1 1)))
- (channel-list-width (or (plist-get plist :channel-list-width) 18))
- (buffer (window-buffer))
- (show-user-list
- (and riece-user-list-buffer-mode
- riece-current-channel
- ;; User list buffer is nuisance for private conversation.
- (riece-channel-p (riece-identity-prefix
- riece-current-channel)))))
- ;; Can't expand minibuffer to full frame.
- (when (eq (selected-window) (minibuffer-window))
- (other-window 1))
- (delete-other-windows)
- ;; top of frame
- (let ((rest-window (split-window (selected-window) command-height)))
- (set-window-buffer (selected-window)
- riece-command-buffer)
- (select-window rest-window))
- ;; middle of frame (vertical-spilit when need)
- (when (or (and riece-current-channel riece-channel-buffer-mode)
- show-user-list)
- (let ((rest-window
- (split-window (selected-window)
- (/ (* 5 (+ (window-height) command-height)) 8))))
- (cond
- ;; channel-buffer + user-list
- ((and show-user-list
- (and riece-current-channel riece-channel-buffer-mode))
- (let ((user-list-window (split-window (selected-window) nil t)))
- (set-window-buffer (selected-window) riece-channel-buffer)
- (set-window-buffer user-list-window riece-user-list-buffer)
- (select-window user-list-window)
- (shrink-window-horizontally (- (window-width) user-list-width))))
- ;; only user-list
- (show-user-list
- (set-window-buffer (selected-window) riece-user-list-buffer))
- ;; only channel-buffer
- (riece-channel-buffer-mode
- (set-window-buffer (selected-window) riece-channel-buffer)))
- (select-window rest-window)))
- ;; bottom of frame
- (if (and riece-current-channel
- riece-channel-list-buffer-mode)
- (let ((channel-list-window (split-window (selected-window) nil t)))
- (set-window-buffer (selected-window) riece-others-buffer)
- (set-window-buffer channel-list-window riece-channel-list-buffer)
- (select-window channel-list-window)
- (shrink-window-horizontally (- (window-width) channel-list-width)))
- (set-window-buffer (selected-window) riece-dialogue-buffer))
- (riece-set-window-points)
- (select-window (or (get-buffer-window buffer)
- (get-buffer-window riece-command-buffer)))))
-
-;; +---+-------------------+---+
-;; | c | channel | u |
-;; | h | | s |
-;; | a | | e |
-;; | n |-------------------+ r | | +---+
-;; | n | command | s | | | |
-;; | e +-------------------+---+ | +-> |
-;; | l | others | +-----+
-;; | s | |
-;; +---+-----------------------+
-(defun riece-configure-windows-spiral ()
- "spiral placement of windows"
-;; (interactive)
- (let ((command-height 4)
- (users-width 15)
- (channels-width 30)
- (buffer (window-buffer)))
- (when (eq (selected-window) (minibuffer-window)) (other-window 1))
- (delete-other-windows)
-
- ;; (1) create channels window
- (let ((rest (split-window (selected-window) channels-width t)))
- (set-window-buffer (selected-window) riece-channel-list-buffer)
- (select-window rest))
-
- ;; (2) create others window
- (set-window-buffer (split-window (selected-window)
- (+ (/ (window-height) 2)
- command-height))
- riece-others-buffer)
-
- ;; (3) create users window
- (set-window-buffer (split-window (selected-window)
- (- (window-width) users-width) t)
- riece-user-list-buffer)
-
- ;; (4) create current channel window
- (let ((rest (split-window (selected-window)
- (- (window-height) command-height))))
- (set-window-buffer rest riece-command-buffer)
- (set-window-buffer (selected-window) riece-channel-buffer))
-
- (riece-set-window-points)
- (select-window (or (get-buffer-window buffer)
- (get-buffer-window riece-command-buffer)))))
-
-(provide 'riece-layout)
-
-;;; riece-layout.el ends here
+++ /dev/null
-;;; riece-log.el --- Save IRC logs
-;; Copyright (C) 2003 OHASHI Akira
-;; Copyright (C) 2004 Daiki Ueno
-
-;; Author: OHASHI Akira <bg66@koka-in.org>
-;; Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-message)
-(require 'riece-button)
-(require 'riece-mcat)
-
-(defgroup riece-log nil
- "Save IRC logs."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-log-directory
- (expand-file-name "log" riece-directory)
- "*Where to look for log files."
- :type 'directory
- :group 'riece-log)
-
-(defcustom riece-log-directory-map nil
- "*The map of channel name and directory name."
- :type '(repeat (cons (string :tag "Channel name")
- (string :tag "Directory name")))
- :group 'riece-log)
-
-(defcustom riece-log-flashback 10
- "*If non-nil, irc messages flash back from log files.
-If integer, flash back only this line numbers. t means all lines."
- :type '(choice (integer :tag "line numbers")
- (const t :tag "of the day")
- (const nil :tag "no flashback"))
- :group 'riece-log)
-
-(defcustom riece-log-coding-system nil
- "*Coding system used for log files."
- :type 'symbol
- :group 'riece-log)
-
-(defcustom riece-log-file-name-coding-system
- (if (boundp 'file-name-coding-system)
- file-name-coding-system)
- "*Coding system used for filenames of log files."
- :type 'symbol
- :group 'riece-log)
-
-(defface riece-log-date-face
- '((((class color)
- (background dark))
- (:foreground "Gray70"))
- (((class color)
- (background light))
- (:foreground "DimGray"))
- (t
- (:bold t)))
- "Face used for displaying \"(YYYY/MM/dd)\" extent."
- :group 'riece-highlight-faces)
-(defvar riece-log-date-face 'riece-log-date-face)
-
-(defvar riece-log-lock-file nil
- "Lock file for riece-log.
-It is created if there is at least one instance of Emacs running riece-log.")
-
-(defconst riece-log-file-name-regexp
- (concat (riece-make-interval-regexp "[0-9]" 8) "\\.txt\\(\\.\\(.*\\)\\)?$"))
-
-(defconst riece-log-description
- "Save IRC logs.")
-
-(defun riece-log-display-message-function (message)
- (if (get 'riece-log 'riece-addon-enabled)
- (let* ((coding-system-for-write
- (if (featurep 'mule)
- (or riece-log-coding-system
- (car (get-language-info current-language-environment
- 'coding-system)))))
- (file (riece-log-make-file-name (riece-message-target message)
- coding-system-for-write))
- file-name-coding-system
- default-file-name-coding-system)
- (unless (file-directory-p (file-name-directory file))
- (make-directory (file-name-directory file) t))
- (write-region (concat (format-time-string "%H:%M") " "
- (riece-format-message message))
- nil file t 0
- riece-log-lock-file))))
-
-(defun riece-log-make-file-name (identity coding-system)
- (expand-file-name (if (featurep 'mule)
- (format "%s.txt.%s"
- (format-time-string "%Y%m%d")
- coding-system)
- (format "%s.txt"
- (format-time-string "%Y%m%d")))
- (riece-log-directory identity)))
-
-(defun riece-log-list-files (identity time)
- (let ((directory (riece-log-directory identity))
- (time-prefix (format-time-string "%Y%m%d" (or time '(0 0))))
- files)
- (when (file-directory-p directory)
- (setq files (nreverse (sort (directory-files
- directory t
- (concat "^" riece-log-file-name-regexp)
- t)
- #'string-lessp)))
- (while (and files
- (string-lessp (file-name-nondirectory (car files))
- time-prefix))
- (setq files (cdr files)))
- files)))
-
-(defun riece-log-directory (identity)
- (let ((prefix (riece-identity-canonicalize-prefix
- (riece-identity-prefix identity)))
- (server (riece-identity-server identity))
- (map (assoc (riece-format-identity identity) riece-log-directory-map)))
- (if map
- (expand-file-name (cdr map) riece-log-directory)
- (expand-file-name (riece-log-encode-file-name prefix)
- (expand-file-name
- (concat "." (riece-log-encode-file-name server))
- riece-log-directory)))))
-
-(defun riece-log-encode-file-name (file-name)
- (if riece-log-file-name-coding-system
- (setq file-name
- (encode-coding-string file-name
- riece-log-file-name-coding-system)))
- (let ((index 0)
- c)
- (while (string-match "[^-0-9A-Za-z_\x80-\xFF]" file-name index)
- (setq c (aref file-name (match-beginning 0)))
- (if (eq c ?=)
- (setq file-name (replace-match "==" nil t file-name)
- index (1+ (match-end 0)))
- (setq file-name (replace-match (format "=%02X" c) nil t file-name)
- index (+ 2 (match-end 0)))))
- file-name))
-
-(defun riece-log-decode-file-name (file-name)
- (let ((index 0))
- (while (string-match "==\\|=\\([0-7][0-9A-F]\\)" file-name index)
- (setq file-name (replace-match
- (if (eq (aref file-name (1- (match-end 0))) ?=)
- "="
- (char-to-string
- (car (read-from-string
- (concat "?\\x" (match-string 1 file-name))))))
- nil t file-name)
- index (1+ (match-beginning 0))))
- file-name)
- (if riece-log-file-name-coding-system
- (setq file-name
- (decode-coding-string file-name
- riece-log-file-name-coding-system)))
- file-name)
-
-(defun riece-log-insert (identity lines)
- "Insert logs for IDENTITY at most LINES.
-If LINES is t, insert today's logs entirely."
- (let* (file-name-coding-system
- default-file-name-coding-system
- (files (riece-log-list-files identity
- (if (eq lines t) (current-time))))
- name coding-system date point)
- (while (and (or (eq lines t) (> lines 0)) files)
- (save-restriction
- (narrow-to-region (point) (point))
- (if (and (string-match
- (concat "^" riece-log-file-name-regexp)
- (setq name (file-name-nondirectory (car files))))
- (match-beginning 2))
- (progn
- (setq coding-system
- (intern (substring name (match-beginning 2))))
- (if (featurep 'xemacs)
- (setq coding-system (find-coding-system coding-system))
- (unless (coding-system-p coding-system)
- (setq coding-system nil)))
- (if coding-system
- (let ((coding-system-for-read coding-system))
- (insert-file-contents (car files)))
- ;;don't insert file contents if they use non
- ;;supported coding-system.
- ))
- ;;if the filename has no coding-system suffix, decode with
- ;;riece-log-coding-system.
- (let ((coding-system-for-read riece-log-coding-system))
- (insert-file-contents (car files))))
- ;;lines in the file contents are in reversed order.
- (unless (eq lines t)
- (goto-char (point-max))
- (setq lines (- (forward-line (- lines))))
- (delete-region (point-min) (point)))
- ;;add (YYYY/MM/dd) suffix on each line left in the current buffer.
- (unless (equal (substring name 0 8) (format-time-string "%Y%m%d"))
- (setq date (concat " (" (substring name 0 4) "/"
- (substring name 4 6) "/"
- (substring name 6 8) ")"))
- (while (not (eobp))
- (end-of-line)
- (setq point (point))
- (insert date)
- (put-text-property point (point)
- 'riece-overlay-face 'riece-log-date-face)
- (forward-line))
- (goto-char (point-min))))
- (setq files (cdr files)))))
-
-(defun riece-log-flashback (identity)
- (when riece-log-flashback
- (riece-insert-info (current-buffer)
- (if (eq riece-log-flashback t)
- (riece-mcat "Recent messages of the day:\n")
- (format (riece-mcat
- "Recent messages up to %d lines:\n")
- riece-log-flashback)))
- (let (buffer-read-only
- (point (goto-char (point-max))))
- (insert (with-temp-buffer
- (riece-log-insert identity riece-log-flashback)
- (buffer-string)))
- (goto-char point)
- (while (re-search-forward
- (concat "^" riece-time-prefix-regexp
- "\\(<[^>]+>\\|>[^<]+<\\|([^)]+)\\|{[^}]+}\\|=[^=]+=\\)")
- nil t)
- (put-text-property (1+ (match-beginning 1)) (1- (match-end 1))
- 'riece-identity
- (riece-make-identity
- (buffer-substring (1+ (match-beginning 1))
- (1- (match-end 1)))
- (riece-identity-server identity))))
- (run-hook-with-args 'riece-after-insert-functions
- point (goto-char (point-max)))
- (set-window-point (get-buffer-window (current-buffer))
- (point)))))
-
-(defun riece-log-dired (&optional channel)
- (interactive)
- (let ((directory (riece-log-directory (or channel riece-current-channel))))
- (if (file-directory-p directory)
- (dired directory)
- (error "No log directory"))))
-
-(defun riece-log-requires ()
- (if (memq 'riece-button riece-addons)
- '(riece-button)))
-
-(defun riece-log-insinuate ()
- (make-directory riece-log-directory t)
- (setq riece-log-lock-file
- (expand-file-name (format "!%s-%d-%d"
- (riece-log-encode-file-name (system-name))
- (user-uid)
- (emacs-pid))
- riece-log-directory))
- ;; FIXME: Use `riece-after-insert-functions' for trapping change,
- ;; notice, wallops and so on. But must add argument.
- (add-hook 'riece-after-display-message-functions
- 'riece-log-display-message-function)
- (add-hook 'riece-channel-buffer-create-functions
- 'riece-log-flashback))
-
-(defun riece-log-uninstall ()
- (setq riece-log-lock-file nil)
- (remove-hook 'riece-after-display-message-functions
- 'riece-log-display-message-function)
- (remove-hook 'riece-channel-buffer-create-functions
- 'riece-log-flashback))
-
-(defvar riece-command-mode-map)
-(defun riece-log-enable ()
- (define-key riece-command-mode-map "\C-cd" 'riece-log-dired))
-
-(defun riece-log-disable ()
- (define-key riece-command-mode-map "\C-cd" nil))
-
-(provide 'riece-log)
-
-;;; riece-log.el ends here
+++ /dev/null
-;;; riece-lsdb.el --- help register nicknames in LSDB rolodex program
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-identity)
-
-(eval-when-compile
- (autoload 'lsdb-maybe-load-hash-tables "lsdb")
- (autoload 'lsdb-rebuild-secondary-hash-tables "lsdb")
- (autoload 'lsdb-lookup-records "lsdb")
- (autoload 'lsdb-puthash "lsdb")
- (autoload 'lsdb-maphash "lsdb")
- (autoload 'lsdb-gethash "lsdb")
- (autoload 'lsdb-display-records "lsdb")
- (autoload 'lsdb-update-record "lsdb"))
-
-(defvar riece-lsdb-cache nil)
-
-(defconst riece-lsdb-description
- "Help register nicknames in LSDB rolodex program.")
-
-(defun riece-lsdb-update-cache (record)
- (let ((irc (cdr (assq 'irc record))))
- (while irc
- (lsdb-puthash (car irc)
- (cons (car record)
- (lsdb-gethash (car irc) riece-lsdb-cache))
- riece-lsdb-cache)
- (setq irc (cdr irc)))))
-
-(defun riece-lsdb-delete-cache (record)
- (let ((irc (cdr (assq 'irc record))))
- (while irc
- (lsdb-puthash (car irc)
- (delete (car record)
- (lsdb-gethash (car irc) riece-lsdb-cache))
- riece-lsdb-cache)
- (setq irc (cdr irc)))))
-
-(defun riece-lsdb-lookup-records (user)
- (lsdb-maybe-load-hash-tables)
- (unless riece-lsdb-cache
- (lsdb-rebuild-secondary-hash-tables))
- (let ((names (lsdb-gethash (riece-format-identity user t)
- riece-lsdb-cache))
- records)
- (while names
- (setq records (append records (lsdb-lookup-records (car names))))
- (setq names (cdr names)))
- records))
-
-(defun riece-lsdb-display-records (user)
- (interactive
- (let ((completion-ignore-case t))
- (list (riece-completing-read-identity
- "User: "
- (riece-get-users-on-server (riece-current-server-name))))))
- (let ((records (riece-lsdb-lookup-records user)))
- (if records
- (lsdb-display-records records)
- (message "No entry for `%s'" (riece-format-identity user t)))))
-
-(defvar lsdb-hash-table)
-(defun riece-lsdb-add-user (user full-name)
- (interactive
- (let ((completion-ignore-case t)
- (table lsdb-hash-table))
- (unless (vectorp table)
- (setq table (make-vector 29 0))
- (lsdb-maphash (lambda (key value)
- (intern key table))
- lsdb-hash-table))
- (list (riece-completing-read-identity
- "User: "
- (riece-get-users-on-server (riece-current-server-name)))
- (completing-read "Full name: " table))))
- (let* ((record (lsdb-gethash full-name lsdb-hash-table))
- (irc (riece-format-identity user t))
- (old (cdr (assq 'irc record))))
- ;; Remove all properties before adding entry.
- (set-text-properties 0 (length irc) nil irc)
- (unless (member irc old)
- (lsdb-update-record (list full-name
- ;; LSDB does not allow empty 'net entry.
- (or (nth 1 (assq 'net (lsdb-lookup-records
- full-name)))
- ""))
- (list (cons 'irc (cons irc old)))))))
-
-(defvar riece-command-mode-map)
-(defvar lsdb-secondary-hash-tables)
-(defvar lsdb-after-update-record-functions)
-(defvar lsdb-after-delete-record-functions)
-(defun riece-lsdb-insinuate ()
- (require 'lsdb)
- (add-to-list 'lsdb-secondary-hash-tables
- 'riece-lsdb-cache)
- (add-to-list 'lsdb-after-update-record-functions
- 'riece-lsdb-update-cache)
- (add-to-list 'lsdb-after-delete-record-functions
- 'riece-lsdb-delete-cache))
-
-(defun riece-lsdb-uninstall ()
- (setq lsdb-secondary-hash-tables
- (delq 'riece-lsdb-cache lsdb-secondary-hash-tables)
- lsdb-after-update-record-functions
- (delq 'riece-lsdb-update-cache lsdb-after-update-record-functions)
- lsdb-after-delete-record-functions
- (delq 'riece-lsdb-delete-cache lsdb-after-delete-record-functions)))
-
-(defun riece-lsdb-enable ()
- (define-key riece-command-mode-map
- "\C-c\C-ll" 'riece-lsdb-display-records)
- (define-key riece-command-mode-map
- "\C-c\C-la" 'riece-lsdb-add-user))
-
-(defun riece-lsdb-disable ()
- (define-key riece-command-mode-map
- "\C-c\C-ll" nil)
- (define-key riece-command-mode-map
- "\C-c\C-la" nil))
-
-(provide 'riece-lsdb)
-
-;;; riece-lsdb.el ends here
+++ /dev/null
-;;; riece-mcat.el --- message catalog for Japanese -*- coding: iso-2022-jp -*-
-;; Copyright (C) 2007 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; To update riece-mcat-japanese-alist, do `make update-mcat'.
-
-;;; Code:
-
-(defconst riece-mcat-japanese-alist
- '(("\nSymbols in the leftmost column:\n\n + The add-on is enabled.\n - The add-on is disabled.\n ? The add-on is not insinuated.\n The add-on is not loaded.\n" . "\n\e$B:8C<$N%7%s%\%k\e(B:\n\n + \e$BM-8z$J%"%I%*%s\e(B\n - \e$BL58z$J%"%I%*%s\e(B\n ? \e$BAH$_9~$^$l$F$$$J$$%"%I%*%s\e(B\n \e$B%m!<%I$5$l$F$$$J$$%"%I%*%s\e(B\n")
- ("\nUseful keys:\n\n `\\[riece-command-enable-addon]' to enable the current add-on.\n `\\[riece-command-disable-addon]' to disable the current add-on.\n `\\[riece-command-insinuate-addon]' to insinuate the current add-on.\n `\\[riece-command-uninstall-addon]' to uninstall the current add-on.\n `\\[riece-command-unload-addon]' to unload the current add-on.\n `\\[riece-command-save-variables]' to save the current setting.\n" . "\n\e$BJXMx$J%-!<\e(B:\n\n `\\[riece-command-enable-addon]' \e$B%"%I%*%s$rM-8z2=\e(B\n `\\[riece-command-disable-addon]' \e$B%"%I%*%s$rL58z2=\e(B\n `\\[riece-command-insinuate-addon]' \e$B%"%I%*%s$rAH$_9~$_\e(B\n `\\[riece-command-uninstall-addon]' \e$B%"%I%*%s$N=|30\e(B\n `\\[riece-command-unload-addon]' \e$B%"%I%*%s$r%"%s%m!<%I\e(B\n `\\[riece-command-save-variables]' \e$B@_Dj$rJ]B8\e(B\n")
- ("%2d: %s %s (%d bytes)\n" . "%2d: %s %s (%d \e$B%P%$%H\e(B)\n")
- ("%S: switch to %s; down-mouse-3: more options" . "%S: %s \e$B$K0\F0\e(B; down-mouse-3: \e$B$=$NB>$N%*%W%7%g%s\e(B")
- ("%d users on %s: " . "%d \e$B?M$,\e(B %s \e$B$K$$$^$9\e(B: ")
- ("%d users: " . "%d \e$B?M\e(B: ")
- ("%s (%s) has joined %s" . "%s (%s) \e$B$,\e(B %s \e$B$K;22C$7$^$7$?\e(B")
- ("%s (%s) has joined %s\n" . "%s (%s) \e$B$,\e(B %s \e$B$K;22C$7$^$7$?\e(B\n")
- ("%s has left %s" . "%s \e$B$,\e(B %s \e$B$rN%$l$^$7$?\e(B")
- ("%s has left IRC" . "%s \e$B$,\e(B IRC \e$B$rN%$l$^$7$?\e(B")
- ("%s invites %s to %s" . "%s \e$B$,\e(B %s \e$B$r\e(B %s \e$B$K>7BT$7$F$$$^$9\e(B")
- ("%s is %s (%s)" . "%s \e$B$O\e(B %s (%s)")
- ("%s is %s idle" . "%s \e$B$O\e(B %s \e$B%"%$%I%k>uBV\e(B")
- ("%s is (%s)" . "%s \e$B$O\e(B (%s)")
- ("%s is away: %s" . "%s \e$B$ON%@JCf\e(B: %s")
- ("%s is running on %s: %s" . "%s \e$B$,\e(B %s \e$B$GF0$$$F$$$^$9\e(B: %s")
- ("%s kicked %s out from %s" . "%s \e$B$,\e(B %s \e$B$r\e(B %s \e$B$+$i=3$j=P$7$^$7$?\e(B")
- ("%s kicked %s out from %s\n" . "%s \e$B$,\e(B %s \e$B$r\e(B %s \e$B$+$i=3$j=P$7$^$7$?\e(B\n")
- ("%s killed %s" . "%s \e$B$,\e(B %s \e$B$r\e(B KILL \e$B$7$^$7$?\e(B")
- ("%s users, topic: %s\n" . "%s \e$B?M!"%H%T%C%/\e(B: %s\n")
- ("%s will be insinuated. Continue? " . "%s \e$B$OAH$_9~$^$l$F$$$^$;$s!#B39T$7$^$9$+\e(B? ")
- ("%s: %s users, topic: %s" . "%s: %s \e$B?M!"%H%T%C%/\e(B: %s\n")
- ("(no description)" . "(\e$B@bL@$J$7\e(B)")
- ("Action: " . "\e$B%"%/%7%g%s\e(B: ")
- ("Add-on %S disabled" . "\e$B%"%I%*%s\e(B %S \e$B$,L58z$K$J$j$^$7$?\e(B")
- ("Add-on %S enabled" . "\e$B%"%I%*%s\e(B %S \e$B$,M-8z$K$J$j$^$7$?\e(B")
- ("Add-on %S is already disabled" . "\e$B%"%I%*%s\e(B %S \e$B$O4{$KL58z$G$9\e(B")
- ("Add-on %S is already enabled" . "\e$B%"%I%*%s\e(B %S \e$B$O4{$KM-8z$G$9\e(B")
- ("Add-on %S is already insinuated" . "\e$B%"%I%*%s\e(B %S \e$B$O4{$KAH$_9~$^$l$F$$$^$9\e(B")
- ("Add-on %S is insinuated" . "\e$B%"%I%*%s\e(B %S \e$B$,AH$_9~$^$l$^$7$?\e(B")
- ("Add-on %S is not allowed to unload" . "\e$B%"%I%*%s\e(B %S \e$B$O%"%s%m!<%I$G$-$^$;$s\e(B")
- ("Add-on %S is not insinuated" . "\e$B%"%I%*%s\e(B %S \e$B$OAH$_9~$^$l$F$$$^$;$s\e(B")
- ("Add-on %S is uninstalled" . "\e$B%"%I%*%s\e(B %S \e$B$,=|30$5$l$^$7$?\e(B")
- ("Add-on %S is unloaded" . "\e$B%"%I%*%s\e(B %S \e$B$,%"%s%m!<%I$5$l$^$7$?\e(B")
- ("Add-on: " . "\e$B%"%I%*%s\e(B: ")
- ("Already registered" . "\e$BEPO?:Q$_$G$9\e(B")
- ("Away message: " . "\e$BN%@J$N%a%C%;!<%8\e(B: ")
- ("Beginning of buffer" . "\e$B%P%C%U%!$N@hF,$G$9\e(B")
- ("CTCP CLIENTINFO for %s (%s) = %s" . "%s (%s) \e$B$N\e(B CTCP CLIENTINFO = %s")
- ("CTCP CLIENTINFO from %s (%s) to %s" . "%s (%s) \e$B$,\e(B %s \e$B$K\e(B CTCP CLIENTINFO")
- ("CTCP PING for %s (%s) = %d sec" . "%s (%s) \e$B$N\e(B CTCP PING = %d \e$BIC\e(B")
- ("CTCP PING from %s (%s) to %s" . "%s (%s) \e$B$,\e(B %s \e$B$K\e(B CTCP PING")
- ("CTCP TIME for %s (%s) = %s" . "%s (%s) \e$B$N\e(B CTCP TIME = %s")
- ("CTCP TIME from %s\n" . "%s \e$B$+$i\e(B CTCP TIME\n")
- ("CTCP TIME from %s (%s) to %s" . "%s (%s) \e$B$,\e(B %s \e$B$K\e(B CTCP TIME")
- ("CTCP VERSION for %s (%s) = %s" . "%s (%s) \e$B$N\e(B CTCP VERSION = %s")
- ("CTCP VERSION from %s (%s) to %s" . "%s (%s) \e$B$,\e(B %s \e$B$K\e(B CTCP VERSION")
- ("Can't find completion for \"%s\"" . "\"%s\" \e$B$KBP$9$kJd40$,8+$D$+$j$^$;$s\e(B")
- ("Change layout: " . "\e$BJQ998e$N%l%$%"%&%H\e(B: ")
- ("Change mode for channel/user: " . "\e$B%b!<%I$rJQ99$9$k%A%c%s%M%k$^$?$O%f!<%6\e(B: ")
- ("Channel/User: " . "\e$B%A%c%s%M%k$^$?$O%f!<%6\e(B: ")
- ("Close server: " . "\e$B@\B3$rJD$8$k%5!<%P\e(B: ")
- ("Command to execute on \"%s\":" . "\"%s\" \e$B$G<B9T$9$k%3%^%s%I\e(B: ")
- ("Connecting to %s..." . "%s \e$B$K@\B3$7$F$$$^$9\e(B...")
- ("Connecting to %s...done" . "%s \e$B$K@\B3$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Connecting to %s...failed: %S" . "%s \e$B$K@\B3$7$F$$$^$9\e(B...\e$B<:GT\e(B: %S")
- ("Connecting to IRC server..." . "IRC \e$B%5!<%P$K@\B3$7$F$$$^$9\e(B...")
- ("Connecting to IRC server...done" . "IRC \e$B%5!<%P$K@\B3$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Connecting to IRC server...failed: %S" . "IRC \e$B%5!<%P$K@\B3$7$F$$$^$9\e(B...\e$B<:GT\e(B: %S")
- ("Created on %s\n" . "%s \e$B$K:n@.$5$l$^$7$?\e(B\n")
- ("End of buffer" . "\e$B%P%C%U%!$N=*C<$G$9\e(B")
- ("Erroneous nickname \"%s\". Choose a new one: " . "\e$BIT@5$J%K%C%/%M!<%`\e(B \"%s\"\e$B!#?7$7$$%K%C%/%M!<%`\e(B: ")
- ("File: " . "\e$B%U%!%$%k\e(B: ")
- ("Finger user: " . "\e$B?H85$rD4$Y$k%f!<%6\e(B: ")
- ("Invite user: " . "\e$B>7BT$9$k%f!<%6\e(B: ")
- ("Inviting %s\n" . "%s \e$B$r>7BT$7$F$$$^$9\e(B\n")
- ("Inviting %s to %s" . "%s \e$B$r\e(B %s \e$B$K>7BT$7$F$$$^$9\e(B")
- ("Join channel/user (default %s): " . "\e$B;22C$9$k%A%c%s%M%k$^$?$O%f!<%6\e(B (\e$B4{DjCM\e(B %s): ")
- ("Join channel/user: " . "\e$B;22C$9$k%A%c%s%M%k$^$?$O%f!<%6\e(B: ")
- ("Key for %s: " . "%s \e$B$N%-!<\e(B: ")
- ("Key for %s: Quit" . "%s \e$B$N%-!<\e(B: \e$BCf;_\e(B")
- ("Kick user: " . "\e$B=3$j=P$9%f!<%6\e(B: ")
- ("LIST pattern: " . "LIST \e$B$N%Q%?!<%s\e(B: ")
- ("Logging in to %s..." . "%s \e$B$K%m%0%$%s$7$F$$$^$9\e(B...")
- ("Logging in to %s...done" . "%s \e$B$K%m%0%$%s$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Logging in to IRC server..." . "IRC \e$B%5!<%P$K%m%0%$%s$7$F$$$^$9\e(B...")
- ("Logging in to IRC server...done" . "IRC \e$B%5!<%P$K%m%0%$%s$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Message to user: " . "\e$B%f!<%6$X$N%a%C%;!<%8\e(B: ")
- ("Message: " . "\e$B%a%C%;!<%8\e(B")
- ("Mode (? for help)" . "\e$B%b!<%I\e(B (\e$B%X%k%W$O\e(B ?)")
- ("Mode by %s: %s\n" . "%s \e$B$K$h$k%b!<%I@_Dj\e(B: %s\n")
- ("Mode for %s: %s" . "%s \e$B$N%b!<%I\e(B: %s")
- ("Mode on %s by %s: %s" . "%s \e$B$N%b!<%I$,\e(B %s \e$B$K$h$j@_Dj$5$l$^$7$?\e(B: %s")
- ("Mode: " . "\e$B%b!<%I\e(B: ")
- ("NAMES pattern: " . "NAMES \e$B$N%Q%?!<%s\e(B: ")
- ("Nickname \"%s\" already in use. Choose a new one: " . "\e$B%K%C%/%M!<%`\e(B \"%s\" \e$B$O4{$K;HMQ$5$l$F$$$^$9!#?7$7$$%K%C%/%M!<%`\e(B: ")
- ("No changes made. Save anyway? " . "\e$BJQ99$,$"$j$^$;$s$,!"J]B8$7$^$9$+\e(B? ")
- ("No channel" . "\e$B%A%c%s%M%k$J$7\e(B")
- ("No server process" . "\e$B%5!<%P$N%W%m%;%9$,$"$j$^$;$s\e(B")
- ("No text to send" . "\e$BAw?.$9$k%F%-%9%H$,$"$j$^$;$s\e(B")
- ("None" . "\e$B$J$7\e(B")
- ("Online: " . "\e$B%*%s%i%$%s\e(B: ")
- ("Open server: " . "\e$B@\B3$9$k%5!<%P\e(B: ")
- ("Part from channel/user (default %s): " . "\e$BN%C&$9$k%A%c%s%M%k$^$?$O%f!<%6\e(B (\e$B4{DjCM\e(B %s): ")
- ("Password for %s: " . "%s \e$B$N%Q%9%o!<%I\e(B: ")
- ("Password for %s: Quit" . "%s \e$B$N%Q%9%o!<%I\e(B: \e$BCf;_\e(B")
- ("Password incorrect from %s." . "%s \e$B$N%Q%9%o!<%I$,IT@5$G$9!#\e(B")
- ("Password: " . "\e$B%Q%9%o!<%I\e(B: ")
- ("Password: Quit" . "\e$B%Q%9%o!<%I\e(B: \e$BCf;_\e(B")
- ("Really quit IRC? " . "\e$BK\Ev$K\e(B IRC \e$B$r$d$a$^$9$+\e(B? ")
- ("Really want to query LIST without argument? " . "\e$BK\Ev$K0z?t$J$7$N\e(B LIST \e$B$rH/9T$7$^$9$+\e(B? ")
- ("Really want to query NAMES without argument? " . "\e$BK\Ev$K0z?t$J$7$N\e(B NAMES \e$B$rH/9T$7$^$9$+\e(B? ")
- ("Really want to query WHO without argument? " . "\e$BK\Ev$K0z?t$J$7$N\e(B WHO \e$B$rH/9T$7$^$9$+\e(B? ")
- ("Receiving %s from %s...(%s/%s)" . "%s \e$B$r\e(B %s \e$B$+$i<u?.Cf\e(B...(%s/%s)")
- ("Receiving %s from %s...done" . "%s \e$B$r\e(B %s \e$B$+$i<u?.Cf\e(B...\e$B40N;\e(B")
- ("Recent messages of the day:\n" . "\e$B:G6a$N%a%C%;!<%8\e(B (\e$B:#F|Cf\e(B):\n")
- ("Recent messages up to %d lines:\n" . "\e$B:G6a$N%a%C%;!<%8\e(B (%d \e$B9T$^$G\e(B):\n")
- ("Save as (default %s) " . "\e$BJ]B8@h\e(B (\e$B4{DjCM\e(B %s) ")
- ("Sending %s...(%s/%d)" . "%s \e$B$rAw?.Cf\e(B...(%s/%d)")
- ("Sending %s...done" . "%s \e$B$rAw?.Cf\e(B...\e$B40N;\e(B")
- ("Sending QUIT to \"%s\"..." . "\"%s\" \e$B$K\e(B QUIT \e$B$rAw?.$7$F$$$^$9\e(B...")
- ("Sending QUIT to \"%s\"...done" . "\"%s\" \e$B$K\e(B QUIT \e$B$rAw?.$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Sending QUIT..." . "QUIT \e$B$rAw?.$7$F$$$^$9\e(B...")
- ("Sending QUIT...done" . "QUIT \e$B$rAw?.$7$F$$$^$9\e(B...\e$B40N;\e(B")
- ("Server: " . "\e$B%5!<%P\e(B: ")
- ("Set +o for users" . "+o \e$B$9$k%f!<%6\e(B")
- ("Set +v for users" . "+v \e$B$9$k%f!<%6\e(B")
- ("Set topic: " . "\e$B?7$7$$%H%T%C%/\e(B: ")
- ("Switch to channel/user: " . "\e$B0\F0@h$N%A%c%s%M%k$^$?$O%f!<%6\e(B: ")
- ("Switch to number: " . "\e$B0\F0@h$NHV9f\e(B: ")
- ("Topic by %s: %s\n" . "%s \e$B$K$h$k%H%T%C%/@_Dj\e(B: %s\n")
- ("Topic for %s: %s" . "%s \e$B$N%H%T%C%/\e(B: ")
- ("Topic on %s by %s: %s" . "%s \e$B$N%H%T%C%/$,\e(B %s \e$B$K$h$j@_Dj$5$l$^$7$?\e(B: %s")
- ("Topic: " . "\e$B%H%T%C%/\e(B: ")
- ("Type \\[describe-mode] for help" . "\e$B%X%k%W$r8+$k$K$O\e(B \\[describe-mode]")
- ("Type \\[riece-command-dcc-receive] to receive" . "\e$B<u?.$9$k$K$O\e(B \\[riece-command-dcc-receive]")
- ("Type \\[riece-command-join] to join the channel" . "\e$B%A%c%s%M%k$K;22C$9$k$K$O\e(B \\[riece-command-join]")
- ("Unset +o for users" . "-o \e$B$9$k%f!<%6\e(B")
- ("Unset +v for users" . "-v \e$B$9$k%f!<%6\e(B")
- ("User: " . "\e$B%f!<%6\e(B: ")
- ("WHO pattern: " . "WHO \e$B$N%Q%?!<%s\e(B: ")
- ("[Available modes: " . "[\e$B;HMQ2DG=$J%b!<%I\e(B: ")
- ("days" . "\e$BF|\e(B")
- ("hours" . "\e$B;~4V\e(B")
- ("minutes" . "\e$BJ,\e(B")
- ("on via server %s: %s" . "\e$B%5!<%P\e(B %s \e$B7PM3\e(B: %s")
- ("seconds" . "\e$BIC\e(B")))
-
-(provide 'riece-mcat-japanese)
-
-;;; riece-mcat-japanese.el ends here
+++ /dev/null
-;;; riece-mcat.el --- message catalog
-;; Copyright (C) 2007 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'pp)
-
-(defun riece-mcat (string)
- "Translate STRING in the current language environment."
- (let ((feature (get-language-info current-language-environment
- 'riece-mcat-feature)))
- (if feature
- (progn
- (require feature)
- (or (cdr (assoc string
- (symbol-value
- (intern (concat (symbol-name feature) "-alist")))))
- string))
- string)))
-
-(defun riece-mcat-extract-from-form (form)
- (if (and form (listp form) (listp (cdr form)))
- (if (eq (car form) 'riece-mcat)
- (cdr form)
- (delq nil (apply #'nconc
- (mapcar #'riece-mcat-extract-from-form form))))))
-
-(defun riece-mcat-extract (files)
- (save-excursion
- (let (message-list pointer)
- (while files
- (with-temp-buffer
- (insert-file-contents (car files))
- (goto-char (point-min))
- (while (progn
- (while (progn (skip-chars-forward " \t\n\f")
- (looking-at ";"))
- (forward-line 1))
- (not (eobp)))
- (setq message-list
- (nconc message-list
- (riece-mcat-extract-from-form
- (read (current-buffer)))))))
- (setq files (cdr files)))
- (setq message-list (sort message-list #'string-lessp)
- pointer message-list)
- (while pointer
- (if (member (car pointer) (cdr pointer))
- (setcar pointer nil))
- (setq pointer (cdr pointer)))
- (delq nil message-list))))
-
-(defun riece-mcat-update (files mcat-file mcat-alist-symbol)
- "Update MCAT-FILE."
- (let ((pp-escape-newlines t)
- alist)
- (save-excursion
- (set-buffer (find-file-noselect mcat-file))
- (goto-char (point-min))
- (if (re-search-forward (concat "^\\s-*(\\(defvar\\|defconst\\)\\s-+"
- (regexp-quote (symbol-name
- mcat-alist-symbol)))
- nil t)
- (progn
- (goto-char (match-beginning 0))
- (save-excursion
- (eval (read (current-buffer))))
- (delete-region (point) (progn (forward-sexp) (point))))
- (set mcat-alist-symbol nil))
- (setq alist (mapcar (lambda (message)
- (or (assoc message
- (symbol-value mcat-alist-symbol))
- (list message)))
- (riece-mcat-extract files)))
- (insert "(defconst " (symbol-name mcat-alist-symbol) "\n '(")
- (while alist
- (insert "(" (pp-to-string (car (car alist))) " . "
- (pp-to-string (cdr (car alist))) ")")
- (if (cdr alist)
- (insert "\n "))
- (setq alist (cdr alist)))
- (insert "))")
- (save-buffer))))
-
-(defconst riece-mcat-description "Translate messages")
-
-(defun riece-mcat-insinuate ()
- (set-language-info "Japanese" 'riece-mcat-feature 'riece-mcat-japanese))
-
-(defun riece-mcat-uninstall ()
- (set-language-info "Japanese" 'riece-mcat-feature nil))
-
-(provide 'riece-mcat)
-
-;;; riece-mcat.el ends here
+++ /dev/null
-;;; riece-menu.el --- setup Riece's command menus
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-globals)
-(require 'riece-identity)
-(require 'riece-layout)
-(require 'riece-server)
-
-(defvar riece-menu-items
- `("Riece"
- ["Version" riece-version t]
- ["Submit Bug Report" riece-submit-bug-report t]
- "----"
- ("Change Window Layout..." :filter riece-menu-create-layouts-menu)
- ["Toggle Freeze Channel Buffer"
- riece-command-toggle-freeze t]
- ["Toggle Freeze Channel Buffer Until Next Message"
- riece-command-toggle-own-freeze t]
- ["Toggle Display Channel Buffer"
- riece-command-toggle-channel-buffer-mode t]
- ["Toggle Display Channel List Buffer"
- riece-command-toggle-channel-list-buffer-mode t]
- ["Toggle Display User List Buffer"
- riece-command-toggle-user-list-buffer-mode t]
- "----"
- ["Join Channel" riece-command-join t]
- ["Change Nickname" riece-command-change-nickname t]
- ["Mark As Away" riece-command-toggle-away t]
- ["Quit IRC" riece-command-quit t]
- "----"
- ["Part Channel" riece-command-part riece-current-channel]
- ["Set Channel Topic" riece-command-topic riece-current-channel]
- ["Kick User" riece-command-kick riece-current-channel]
- ["Invite User" riece-command-invite riece-current-channel]
- "----"
- ["Next Channel" riece-command-next-channel riece-current-channels]
- ["Previous Channel" riece-command-previous-channel riece-current-channels]
- "----"
- ("Channels" :filter riece-menu-create-channels-menu)
- ("Servers" :filter riece-menu-create-servers-menu))
- "Menu used in command mode.")
-
-(defconst riece-menu-description
- "Setup Riece's command menus.")
-
-(defun riece-menu-create-layouts-menu (menu)
- (mapcar (lambda (entry)
- (vector (car entry) (list 'riece-command-change-layout (car entry))
- t))
- riece-layout-alist))
-
-(defun riece-menu-create-channels-menu (menu)
- (mapcar (lambda (channel)
- (list (riece-format-identity channel)
- (vector "Switch To Channel"
- (list 'riece-command-switch-to-channel channel) t)
- (vector "Part Channel"
- (list 'riece-command-part channel) t)
- (vector "List Channel"
- (list 'riece-command-list
- (riece-identity-prefix channel)) t)))
- riece-current-channels))
-
-(defun riece-menu-create-servers-menu (menu)
- (mapcar (lambda (entry)
- (list (car entry)
- (vector "Open Server"
- (list 'riece-command-open-server (car entry))
- (not (riece-server-opened (car entry))))
- (vector "Close Server"
- (list 'riece-command-close-server (car entry))
- (riece-server-opened (car entry)))))
- riece-server-alist))
-
-(defvar riece-command-mode-map)
-(defvar riece-menu)
-
-(defun riece-menu-command-mode-hook ()
- (easy-menu-define riece-menu
- riece-command-mode-map
- "Riece Menu"
- riece-menu-items)
- (easy-menu-add riece-menu))
-
-(defun riece-menu-insinuate ()
- (if riece-command-buffer
- (with-current-buffer riece-command-buffer
- (riece-menu-command-mode-hook)))
- (add-hook 'riece-command-mode-hook
- 'riece-menu-command-mode-hook))
-
-(defun riece-menu-uninstall ()
- (if riece-command-buffer
- (with-current-buffer riece-command-buffer
- (easy-menu-remove riece-menu)))
- (remove-hook 'riece-command-mode-hook
- 'riece-menu-command-mode-hook))
-
-(provide 'riece-menu)
-
-;;; riece-menu.el ends here
+++ /dev/null
-;;; riece-message.el --- generate and display message line
-;; Copyright (C) 1999-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: message
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-channel)
-(require 'riece-user)
-(require 'riece-display)
-(require 'riece-misc)
-
-(defgroup riece-message nil
- "Display messages."
- :tag "Message"
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-message-filter-functions nil
- "Functions to filter incoming messages."
- :type 'function
- :group 'riece-message)
-
-(defcustom riece-message-make-open-bracket-function
- #'riece-message-make-open-bracket
- "Function which makes `open-bracket' string for each message."
- :type 'function
- :group 'riece-message)
-
-(defcustom riece-message-make-close-bracket-function
- #'riece-message-make-close-bracket
- "Function which makes `close-bracket' string for each message."
- :type 'function
- :group 'riece-message)
-
-(defcustom riece-message-make-name-function
- #'riece-message-make-name
- "Function which makes local identity for each message."
- :type 'function
- :group 'riece-message)
-
-(defcustom riece-message-make-global-name-function
- #'riece-message-make-global-name
- "Function which makes global identity for each message."
- :type 'function
- :group 'riece-message)
-
-(defun riece-message-make-open-bracket (message)
- "Make `open-bracket' string for MESSAGE."
- (if (eq (riece-message-type message) 'notice)
- "{"
- (if (riece-message-own-p message)
- ">"
- (if (riece-message-private-p message)
- "="
- (if (riece-message-external-p message)
- "("
- "<")))))
-
-(defun riece-message-make-close-bracket (message)
- "Make `close-bracket' string for MESSAGE."
- (if (eq (riece-message-type message) 'notice)
- "}"
- (if (riece-message-own-p message)
- "<"
- (if (riece-message-private-p message)
- "="
- (if (riece-message-external-p message)
- ")"
- ">")))))
-
-(defun riece-message-make-name (message)
- "Make local identity for MESSAGE."
- (if (riece-message-private-p message)
- (if (riece-message-own-p message)
- (riece-format-identity (riece-message-target message) t)
- (riece-format-identity (riece-message-speaker message) t))
- (riece-format-identity (riece-message-speaker message) t)))
-
-(defun riece-message-make-global-name (message)
- "Make global identity for MESSAGE."
- (if (riece-message-private-p message)
- (if (riece-message-own-p message)
- (riece-format-identity (riece-message-target message) t)
- (riece-format-identity (riece-message-speaker message) t))
- (concat (riece-format-identity (riece-message-target message) t) ":"
- (riece-format-identity (riece-message-speaker message) t))))
-
-(defun riece-message-buffer (message)
- "Return the buffer where MESSAGE should appear."
- (let ((target (if (riece-message-private-p message)
- (if (riece-message-own-p message)
- (riece-message-target message)
- (riece-message-speaker message))
- (riece-message-target message))))
- (unless (riece-identity-member target riece-current-channels)
- (riece-join-channel target)
- ;; If you are not joined to any channel,
- ;; switch to the target immediately.
- (unless riece-current-channel
- (riece-switch-to-channel target)))
- (riece-channel-buffer target)))
-
-(defun riece-message-parent-buffers (message buffer)
- "Return the parents of BUFFER where MESSAGE should appear.
-Normally they are *Dialogue* and/or *Others*."
- (if (and buffer (riece-frozen buffer)) ;the message might not be
- ;visible in buffer's window
- (list riece-dialogue-buffer riece-others-buffer)
- (if (and riece-current-channel ;the message is not sent to
- ;the current channel
- (if (riece-message-private-p message)
- (if (riece-message-own-p message)
- (not (riece-identity-equal
- (riece-message-target message)
- riece-current-channel))
- (not (riece-identity-equal
- (riece-message-speaker message)
- riece-current-channel)))
- (not (riece-identity-equal
- (riece-message-target message)
- riece-current-channel))))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)))
-
-(defun riece-format-message (message &optional global)
- (let ((open-bracket
- (funcall riece-message-make-open-bracket-function message))
- (close-bracket
- (funcall riece-message-make-close-bracket-function message))
- (name
- (if global
- (funcall riece-message-make-global-name-function message)
- (funcall riece-message-make-name-function message)))
- (server-name (riece-identity-server (riece-message-speaker message))))
- (riece-with-server-buffer server-name
- (concat
- (if global
- (riece-concat-server-name
- (concat open-bracket name close-bracket
- " " (riece-message-text message)))
- (concat open-bracket name close-bracket
- " " (riece-message-text message)))
- "\n"))))
-
-(defun riece-display-message-1 (message)
- (let ((buffer (riece-message-buffer message))
- parent-buffers)
- (when (and buffer
- (riece-message-own-p message)
- (riece-own-frozen buffer))
- (with-current-buffer buffer
- (setq riece-freeze nil))
- (riece-emit-signal 'buffer-freeze-changed buffer nil))
- (setq parent-buffers (riece-message-parent-buffers message buffer))
- (riece-insert buffer (riece-format-message message))
- (riece-insert parent-buffers (riece-format-message message t))
- (with-current-buffer buffer
- (run-hook-with-args 'riece-after-display-message-functions message))))
-
-(defun riece-display-message (message)
- "Display MESSAGE object."
- (let ((functions riece-message-filter-functions))
- (setq message (copy-sequence message))
- (while (and functions message)
- (setq message (funcall (car functions) message)
- functions (cdr functions)))
- (if message
- (riece-display-message-1 message))))
-
-(defun riece-make-message (speaker target text &optional type own-p)
- "Make an instance of message object.
-Arguments are appropriate to the sender, the receiver, and text
-content, respectively.
-Optional 4th argument TYPE specifies the type of the message.
-Currently possible values are `action' and `notice'.
-Optional 5th argument is the flag to indicate that this message is not
-from the network."
- (vector speaker target text type own-p))
-
-(defun riece-message-speaker (message)
- "Return the sender of MESSAGE."
- (aref message 0))
-
-(defun riece-message-target (message)
- "Return the receiver of MESSAGE."
- (aref message 1))
-
-(defun riece-message-text (message)
- "Return the text part of MESSAGE."
- (aref message 2))
-
-(defun riece-message-type (message)
- "Return the type of MESSAGE.
-Currently possible values are `action' and `notice'."
- (aref message 3))
-
-(defun riece-message-own-p (message)
- "Return t if MESSAGE is not from the network."
- (aref message 4))
-
-(defun riece-message-set-speaker (message speaker)
- "Set the sender of MESSAGE."
- (aset message 0 speaker))
-
-(defun riece-message-set-target (message target)
- "Set the receiver of MESSAGE."
- (aset message 1 target))
-
-(defun riece-message-set-text (message text)
- "Set the text part of MESSAGE."
- (aset message 2 text))
-
-(defun riece-message-set-type (message type)
- "Set the type of MESSAGE.
-Currently possible values are `action' and `notice'."
- (aset message 3 type))
-
-(defun riece-message-set-own-p (message own-p)
- "Set t if MESSAGE is not from the network."
- (aset message 4 own-p))
-
-(defun riece-message-private-p (message)
- "Return t if MESSAGE is a private message."
- (not (or (riece-channel-p (riece-identity-prefix
- (riece-message-speaker message)))
- (riece-channel-p (riece-identity-prefix
- (riece-message-target message))))))
-
-(defun riece-message-external-p (message)
- "Return t if MESSAGE is from outside the channel."
- (not (riece-identity-member
- (riece-message-speaker message)
- (let ((target (riece-message-target message)))
- (riece-with-server-buffer (riece-identity-server target)
- (mapcar
- (lambda (user)
- (riece-make-identity (car user) riece-server-name))
- (riece-channel-get-users (riece-identity-prefix target))))))))
-
-(provide 'riece-message)
-
-;;; riece-message.el ends here
+++ /dev/null
-;;; riece-mini.el --- use Riece only on the minibuffer
-;; Copyright (C) 2003 OHASHI Akira
-
-;; Author: OHASHI Akira <bg66@koka-in.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; This add-on shows arrival messages to minibuffer. And you can send
-;; message using minibuffer.
-;;
-;; By using this add-on, you can use always "mini riece", even if you
-;; are visiting other buffers.
-
-;; To use, add the following line to your ~/.riece/init.el:
-;; (add-to-list 'riece-addons 'riece-mini)
-;;
-;; For using conveniently, bind any global key to
-;; `riece-mini-send-message' and `riece-mini-show-backlog'.
-;; For example:
-;; (global-set-key "\C-cm" 'riece-mini-send-message)
-;; (global-set-key "\C-cb" 'riece-mini-show-backlog)
-
-;;; Code:
-
-(require 'riece-message)
-(require 'riece-biff)
-
-(defgroup riece-mini nil
- "Use Riece only on the minibuffer."
- :group 'riece)
-
-(defcustom riece-mini-backlog-size 5
- "*Line numbers for logging back log."
- :type 'integer
- :group 'riece-mini)
-
-(defvar riece-mini-last-channel nil)
-(defvar riece-mini-backlog-history nil)
-(defvar riece-mini-backlog-shown nil)
-
-(defconst riece-mini-description
- "Use Riece only on the minibuffer.")
-
-(defun riece-mini-message-no-log (string &rest args)
- "Like `message', except that message logging is disabled."
- (if (featurep 'xemacs)
- (if args
- (display-message 'no-log (apply #'format string args))
- (display-message 'no-log string))
- (let (message-log-max)
- (apply #'message string args))))
-
-(defun riece-mini-display-message-function (message)
- "Show arrival messages to minibuffer."
- (let ((string (concat (format-time-string "%H:%M") " "
- (riece-format-message message t))))
- (when (string-match "\\(.*\\)$" string)
- (setq string (riece-match-string-no-properties 1 string)))
- (while (>= (length riece-mini-backlog-history)
- riece-mini-backlog-size)
- (setq riece-mini-backlog-history
- (cdr riece-mini-backlog-history)))
- (setq riece-mini-backlog-history
- (reverse (cons string (reverse riece-mini-backlog-history))))
- (when (and (get 'riece-mini 'riece-addon-enabled)
- (not (or (eq (window-buffer (selected-window))
- (get-buffer riece-command-buffer))
- (riece-message-own-p message)
- (active-minibuffer-window))))
- (unless (riece-message-type message)
- (setq riece-mini-last-channel (riece-message-target message)))
- (riece-mini-message-no-log "%s" string))))
-
-(defun riece-mini-send-message (arg)
- "Send message using minibuffer.
-Prefix argument onece (C-u), send message to last received channel.
-If twice (C-u C-u), then ask the channel."
- (interactive "P")
- (let* ((completion-ignore-case t)
- (target
- (cond
- ((equal arg '(16))
- (riece-completing-read-identity
- "Channel/User: " riece-current-channels nil t))
- (arg (or riece-mini-last-channel riece-current-channel))
- (t riece-current-channel)))
- (message (read-string (format "Message to %s: " target))))
- (unless (equal message "")
- (riece-switch-to-channel target)
- (riece-send-string
- (format "PRIVMSG %s :%s\r\n"
- (riece-identity-prefix target)
- message))
- (riece-display-message
- (riece-make-message (riece-current-nickname) target
- message nil t)))))
-
-(defun riece-mini-show-backlog ()
- "Send back logs to minibuffer."
- (interactive)
- (when riece-mini-backlog-history
- (let ((height (1+ riece-mini-backlog-size)))
- (mapc #'(lambda (string)
- (setq height (+ height
- (/ (length string) (window-width)))))
- riece-mini-backlog-history)
- (let ((max-mini-window-height height)
- (resize-mini-windows t))
- (setq riece-mini-backlog-shown t)
- (when (and (memq 'riece-biff riece-addons)
- (get 'riece-biff 'riece-addon-enabled))
- (riece-biff-clear))
- (riece-mini-message-no-log
- "%s" (mapconcat #'identity riece-mini-backlog-history "\n"))))))
-
-(defun riece-mini-pre-command ()
- (when riece-mini-backlog-shown
- (let ((resize-mini-windows t))
- (setq riece-mini-backlog-shown nil)
- (riece-mini-message-no-log ""))))
-
-(defun riece-mini-requires ()
- (if (memq 'riece-biff riece-addons)
- '(riece-biff)))
-
-(defun riece-mini-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-mini-display-message-function)
- (add-hook 'pre-command-hook 'riece-mini-pre-command))
-
-(defun riece-mini-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-mini-display-message-function)
- (remove-hook 'pre-command-hook 'riece-mini-pre-command))
-
-(provide 'riece-mini)
-
-;;; riece-mini.el ends here
+++ /dev/null
-;;; riece-misc.el --- miscellaneous functions (not inlined)
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-coding)
-(require 'riece-identity)
-(require 'riece-version)
-(require 'riece-channel)
-(require 'riece-server)
-(require 'riece-user)
-(require 'riece-mode)
-(require 'riece-cache)
-
-(defun riece-get-buffer-create (name &optional init-major-mode)
- (let ((buffer (get-buffer name)))
- (unless (and buffer
- (or (null init-major-mode)
- (eq (with-current-buffer buffer
- major-mode)
- init-major-mode)))
- (setq buffer (generate-new-buffer name)))
- (unless (memq buffer riece-buffer-list)
- (setq riece-buffer-list (cons buffer riece-buffer-list)))
- buffer))
-
-(defun riece-scan-property-region (property start end function)
- (catch 'done
- (while t
- ;; Search for the beginning of the property region.
- (unless (get-text-property start property)
- (setq start (next-single-property-change start property nil end)))
- (if (= start end)
- (throw 'done nil))
- ;; Search for the end of the property region.
- (let ((region-end (next-single-property-change start property nil end)))
- (if (= region-end end)
- (throw 'done nil))
- (funcall function start region-end)
- (setq start region-end)))))
-
-(defun riece-insert (buffers string)
- (unless (listp buffers)
- (setq buffers (list buffers)))
- (while buffers
- (run-hooks 'riece-before-insert-functions)
- (save-excursion
- (set-buffer (car buffers))
- (let ((inhibit-read-only t)
- buffer-read-only
- (start (goto-char (point-max)))
- window
- point)
- (insert (format-time-string "%H:%M") " " string)
- (setq point (point))
- (if (and (not (riece-frozen (current-buffer)))
- (setq window (get-buffer-window (current-buffer)))
- (not (pos-visible-in-window-p point window)))
- (save-excursion ;save-selected-window changes
- ;current buffer
- (save-selected-window
- (select-window window)
- (goto-char point) ;select-window changes current point
- (recenter riece-window-center-line))))
- (run-hook-with-args 'riece-after-insert-functions start (point))))
- (setq buffers (cdr buffers))))
-
-(defun riece-insert-change (buffer message)
- (riece-insert buffer (concat riece-change-prefix message)))
-
-(defun riece-insert-notice (buffer message)
- (riece-insert buffer (concat riece-notice-prefix message)))
-
-(defun riece-insert-wallops (buffer message)
- (riece-insert buffer (concat riece-wallops-prefix message)))
-
-(defun riece-insert-error (buffer message)
- (riece-insert buffer (concat riece-error-prefix message)))
-
-(defun riece-insert-info (buffer message)
- (riece-insert buffer (concat riece-info-prefix message)))
-
-(defun riece-frozen (buffer)
- (with-current-buffer buffer
- riece-freeze))
-
-(defun riece-own-frozen (buffer)
- (with-current-buffer buffer
- (eq riece-freeze 'own)))
-
-(defun riece-channel-p (string)
- "Return t if STRING is a channel.
-\(i.e. it matches `riece-channel-regexp')"
- (string-match (concat "^" riece-channel-regexp) string))
-
-(defun riece-user-p (string)
- "Return t if STRING is a user.
-\(i.e. it matches `riece-user-regexp')"
- (string-match (concat "^" riece-user-regexp) string))
-
-(defun riece-current-nickname ()
- "Return the current nickname."
- (riece-with-server-buffer (riece-current-server-name)
- (if riece-real-nickname
- (riece-make-identity riece-real-nickname riece-server-name))))
-
-(defun riece-split-parameters (string)
- (if (eq ?: (aref string 0))
- (list (substring string 1))
- (let (parameters)
- (catch 'done
- (while (string-match "^\\([^ ]+\\) +" string)
- (setq parameters (nconc parameters (list (match-string 1 string)))
- string (substring string (match-end 0)))
- (when (and (not (equal "" string)) (eq ?: (aref string 0)))
- (setq string (substring string 1)
- parameters (nconc parameters (list string)))
- (throw 'done nil)))
- (or (equal "" string)
- (setq parameters (nconc parameters (list string)))))
- parameters)))
-
-(defun riece-concat-channel-topic (target string)
- (riece-with-server-buffer (riece-identity-server target)
- (let ((topic (riece-channel-get-topic (riece-identity-prefix target))))
- (if (or (null topic)
- (equal topic ""))
- string
- (concat string ": " topic)))))
-
-(defun riece-concat-channel-modes (target string)
- (riece-with-server-buffer (riece-identity-server target)
- (let ((modes (riece-channel-get-modes (riece-identity-prefix target))))
- (if modes
- (concat string " ["
- (mapconcat
- (lambda (mode)
- (if (riece-mode-parameter mode)
- (format "%c(%s)"
- (riece-mode-flag mode)
- (riece-mode-parameter mode))
- (char-to-string (riece-mode-flag mode))))
- modes "")
- "]")
- string))))
-
-(defun riece-concat-message (string message)
- (if (or (null message)
- (equal message ""))
- string
- (concat string " (" message ")")))
-
-(defun riece-concat-server-name (string)
- (if (equal riece-server-name "")
- string
- (let ((server-name (concat " (from " riece-server-name ")")))
- (put-text-property 0 (length server-name)
- 'riece-server-name riece-server-name
- server-name)
- (concat string server-name))))
-
-(defun riece-concat-user-status (status string)
- (if status
- (concat string " [" (mapconcat #'identity status ", ") "]")
- string))
-
-(defun riece-prefix-user-at-host (prefix)
- (if (string-match "!" prefix)
- (substring prefix (match-end 0))
- prefix))
-
-(defun riece-prefix-nickname (prefix)
- (if (string-match "!" prefix)
- (substring prefix 0 (match-beginning 0))
- prefix))
-
-(defun riece-parse-user-at-host (user-at-host)
- (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
- (progn
- (if (memq (aref user-at-host 0) '(?^ ?=))
- (setq riece-user-at-host-type 'fake)
- (if (memq (aref user-at-host 0) '(?~ ?-))
- (setq riece-user-at-host-type 'not-verified)
- (if (eq (aref user-at-host 0) ?+)
- (setq riece-user-at-host-type 'ok))))
- (substring user-at-host 1))
- (setq riece-user-at-host-type 'ok)
- user-at-host))
-
-(defun riece-strip-user-at-host (user-at-host)
- (if (memq (aref user-at-host 0) '(?^ ?= ?~ ?- ?+))
- (substring user-at-host 1)
- user-at-host))
-
-(defun riece-get-users-on-server (server-name)
- (riece-with-server-buffer server-name
- (let (identities)
- (mapatoms
- (lambda (user)
- (setq identities
- (cons (riece-make-identity (symbol-name user) server-name)
- identities)))
- (riece-cache-hash-obarray riece-user-cache))
- identities)))
-
-(defun riece-get-channels-on-server (server-name)
- (riece-with-server-buffer server-name
- (let (identities)
- (mapatoms
- (lambda (channel)
- (setq identities
- (cons (riece-make-identity (symbol-name channel) server-name)
- identities)))
- (riece-cache-hash-obarray riece-channel-cache))
- identities)))
-
-(defun riece-get-identities-on-server (server-name)
- (nconc (riece-get-channels-on-server server-name)
- (riece-get-users-on-server server-name)))
-
-(defun riece-check-channel-commands-are-usable (&optional channel)
- (unless riece-current-channel
- (error (substitute-command-keys
- "Type \\[riece-command-join] to join a channel")))
- (if (and channel
- (not (riece-channel-p (riece-identity-prefix
- riece-current-channel))))
- (error "Not on a channel")))
-
-(provide 'riece-misc)
-
-;;; riece-misc.el ends here
+++ /dev/null
-;;; riece-mode.el --- functions for manipulating channel/user modes
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(defun riece-parse-modes (string)
- (let ((start 0)
- result)
- (while (and (string-match "[-+]\\([^-+ ]*\\) *" string start)
- (= (match-beginning 0) start))
- (let ((toggle (eq (aref string start) ?+))
- (modes (string-to-list (match-string 1 string))))
- (setq start (match-end 0))
- (while modes
- (if (and (string-match "\\([^-+][^ ]*\\) *" string start)
- (= (match-beginning 0) start))
- (setq start (match-end 0)
- result (cons (list (riece-make-mode
- (car modes) (match-string 1 string))
- toggle)
- result))
- (setq result (cons (list (riece-make-mode (car modes))
- toggle)
- result)))
- (setq modes (cdr modes)))))
- (nreverse result)))
-
-(defun riece-mode-assoc (flag modes)
- "Return a mode object matched with FLAG in MODES."
- (catch 'found
- (while modes
- (if (eq flag (riece-mode-flag (car modes)))
- (throw 'found (car modes)))
- (setq modes (cdr modes)))))
-
-(defun riece-make-mode (flag &optional parameter)
- "Make an instance of mode object.
-Arguments are appropriate to the flag and the parameter."
- (vector flag parameter))
-
-(defun riece-mode-flag (mode)
- "Return the flag of MODE."
- (aref mode 0))
-
-(defun riece-mode-parameter (mode)
- "Return the parameter of MODE."
- (aref mode 1))
-
-(provide 'riece-mode)
-
-;;; riece-mode.el ends here
\ No newline at end of file
+++ /dev/null
-;;; riece-naming.el --- toplevel naming management
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-channel)
-(require 'riece-user)
-(require 'riece-signal)
-
-(defun riece-naming-assert-join (user-name channel-name)
- (riece-user-toggle-channel user-name channel-name t)
- (riece-channel-toggle-user channel-name user-name t)
- (riece-emit-signal 'user-joined-channel
- (riece-make-identity user-name
- riece-server-name)
- (riece-make-identity channel-name
- riece-server-name)))
-
-(defun riece-naming-assert-part (user-name channel-name)
- (riece-user-toggle-channel user-name channel-name nil)
- (riece-channel-toggle-user channel-name user-name nil)
- (riece-channel-toggle-operator channel-name user-name nil)
- (riece-channel-toggle-speaker channel-name user-name nil)
- (riece-emit-signal 'user-left-channel
- (riece-make-identity user-name
- riece-server-name)
- (riece-make-identity channel-name
- riece-server-name)))
-
-(defun riece-naming-assert-rename (old-name new-name)
- (if (riece-identity-equal-no-server old-name riece-real-nickname)
- (setq riece-last-nickname riece-real-nickname
- riece-real-nickname new-name))
- (let* ((old (riece-get-user old-name))
- (channels (riece-user-channels old))
- users user)
- (while channels
- (setq users (riece-channel-get-users (car channels))
- user (riece-identity-assoc old-name users t))
- (if user
- (setcar user new-name))
- (setq channels (cdr channels)))
- (riece-rename-user old-name new-name))
- (riece-emit-signal 'user-renamed
- (riece-make-identity old-name riece-server-name)
- (riece-make-identity new-name riece-server-name)))
-
-(defun riece-naming-assert-channel-users (users channel-name)
- (let ((channel-identity (riece-make-identity channel-name
- riece-server-name))
- (pointer users))
- (while pointer
- (riece-user-toggle-channel (car (car pointer)) channel-name t)
- (riece-channel-toggle-user channel-name (car (car pointer)) t)
- (if (memq ?o (cdr (car pointer)))
- (riece-channel-toggle-operator channel-name (car (car pointer)) t)
- (if (memq ?v (cdr (car pointer)))
- (riece-channel-toggle-speaker channel-name (car (car pointer)) t)
- (riece-channel-toggle-operator channel-name (car (car pointer)) nil)
- (riece-channel-toggle-speaker channel-name (car (car pointer)) nil)))
- (setq pointer (cdr pointer)))
- ;; Remove nonexistent users.
- (setq pointer (riece-channel-users (riece-get-channel channel-name)))
- (while pointer
- (unless (assoc (car (car pointer)) users)
- (riece-user-toggle-channel (car (car pointer)) channel-name nil)
- (riece-channel-toggle-user channel-name (car (car pointer)) nil))
- (setq pointer (cdr pointer)))
- (riece-emit-signal 'user-list-changed channel-identity)))
-
-(defun riece-naming-assert-channel-modes (channel modes)
- (while modes
- (cond
- ((eq (riece-mode-flag (car (car modes))) ?o)
- (riece-channel-toggle-operator channel
- (riece-mode-parameter (car (car modes)))
- (nth 1 (car modes)))
- (riece-emit-signal 'channel-operators-changed
- (riece-make-identity channel
- riece-server-name)
- (riece-make-identity (riece-mode-parameter
- (car (car modes)))
- riece-server-name)
- (nth 1 (car modes))))
- ((eq (riece-mode-flag (car (car modes))) ?v)
- (riece-channel-toggle-speaker channel
- (riece-mode-parameter (car (car modes)))
- (nth 1 (car modes)))
- (riece-emit-signal 'channel-speakers-changed
- (riece-make-identity channel
- riece-server-name)
- (riece-make-identity (riece-mode-parameter
- (car (car modes)))
- riece-server-name)
- (nth 1 (car modes))))
- ((eq (riece-mode-flag (car (car modes))) ?b)
- (riece-channel-toggle-banned channel
- (riece-mode-parameter (car (car modes)))
- (nth 1 (car modes))))
- ((eq (riece-mode-flag (car (car modes))) ?e)
- (riece-channel-toggle-uninvited channel
- (riece-mode-parameter (car (car modes)))
- (nth 1 (car modes))))
- ((eq (riece-mode-flag (car (car modes))) ?I)
- (riece-channel-toggle-invited channel
- (riece-mode-parameter (car (car modes)))
- (nth 1 (car modes))))
- (t
- (apply #'riece-channel-toggle-mode channel (car modes))))
- (setq modes (cdr modes)))
- (riece-emit-signal 'channel-modes-changed
- (riece-make-identity channel riece-server-name)))
-
-(provide 'riece-naming)
-
-;;; riece-naming.el ends here
+++ /dev/null
-;;; riece-ndcc.el --- DCC file sending protocol support (written in elisp)
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-options)
-
-(defgroup riece-ndcc nil
- "DCC written in elisp."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-ndcc-server-address "127.0.0.1"
- "Local address of the DCC server.
-Only used for sending files."
- :type 'vector
- :group 'riece-ndcc)
-
-(defvar riece-ndcc-requests nil)
-
-(defvar riece-ndcc-request-user nil)
-(defvar riece-ndcc-request-size nil)
-
-(defconst riece-ndcc-description
- "DCC file sending protocol support (written in elisp.)")
-
-(defun riece-ndcc-encode-address (address)
- (unless (string-match
- "^\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)\\.\\([0-9]+\\)$"
- address)
- (error "% is not an IP address" address))
- (let ((string (number-to-string
- (+ (* (float (string-to-number (match-string 1 address)))
- 16777216)
- (* (float (string-to-number (match-string 2 address)))
- 65536)
- (* (float (string-to-number (match-string 3 address)))
- 256)
- (float (string-to-number (match-string 4 address)))))))
- (if (string-match "\\." string)
- (substring string 0 (match-beginning 0))
- string)))
-
-(defun riece-ndcc-decode-address (address)
- (let ((float-address (string-to-number (concat address ".0"))))
- (format "%d.%d.%d.%d"
- (floor (mod (/ float-address 16777216) 256))
- (floor (mod (/ float-address 65536) 256))
- (floor (mod (/ float-address 256) 256))
- (floor (mod float-address 256)))))
-
-(defun riece-ndcc-server-sentinel (process status)
- (when (string-match "^open from " status)
- (let ((parent-name
- (if (string-match " <[^>]+>$" (process-name process))
- (substring (process-name process) 0 (match-beginning 0)))))
- (save-excursion
- (set-buffer (process-buffer (get-process parent-name)))
- (goto-char (point-min))
- (while (not (eobp))
- (process-send-region process
- (point)
- (goto-char (min (+ 1024 (point)) (point-max))))
- (message "Sending %s...(%d/%d)"
- (buffer-file-name) (1- (point)) (buffer-size)))
- (message "Sending %s...done"
- (buffer-file-name)))
- (kill-buffer (process-buffer (get-process parent-name))))
- (kill-buffer (process-buffer process))))
-
-(defun riece-command-dcc-send (user file)
- (interactive
- (let ((completion-ignore-case t))
- (unless riece-ndcc-server-address
- (error "Set riece-ndcc-server-address to your host"))
- (list (riece-completing-read-identity
- "User: "
- (riece-get-users-on-server (riece-current-server-name)))
- (expand-file-name (read-file-name "File: ")))))
- (let* (selective-display
- (coding-system-for-read 'binary)
- format-alist
- jka-compr-compression-info-list
- (buffer (find-file-noselect file))
- process)
- (with-current-buffer buffer ;To throw an error when the
- (setq buffer-read-only t)) ;process has input.
- (setq process (make-network-process :name "DCC" :buffer buffer
- :host riece-ndcc-server-address
- :server t :service t
- :coding 'binary
- :sentinel 'riece-ndcc-server-sentinel))
- (riece-send-string
- (format "PRIVMSG %s :\1DCC SEND %s %s %d %d\1\r\n"
- (riece-identity-prefix user)
- (file-name-nondirectory file)
- (riece-ndcc-encode-address riece-ndcc-server-address)
- (nth 1 (process-contact process))
- (nth 7 (file-attributes file))))))
-
-(defun riece-ndcc-filter (process input)
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-max))
- (insert input)
- (message "Receiving %s from %s...(%d/%d)"
- (file-name-nondirectory buffer-file-name)
- riece-ndcc-request-user
- (1- (point))
- riece-ndcc-request-size)))
-
-(defun riece-ndcc-sentinel (process status)
- (save-excursion
- (set-buffer (process-buffer process))
- (unless (= (buffer-size) riece-ndcc-request-size)
- (error "Premature end of file"))
- (message "Receiving %s from %s...done"
- (file-name-nondirectory buffer-file-name)
- riece-ndcc-request-user)
- (let ((coding-system-for-write 'binary))
- (save-buffer))))
-
-(defun riece-command-dcc-receive (request file)
- (interactive
- (progn
- (unless riece-ndcc-requests
- (error "No request"))
- (list
- (if (= (length riece-ndcc-requests) 1)
- (car riece-ndcc-requests)
- (with-output-to-temp-buffer "*Help*"
- (let ((requests riece-ndcc-requests)
- (index 1))
- (while requests
- (princ (format "%2d: %s %s (%d bytes)\n"
- index
- (car (car requests))
- (nth 1 (car requests))
- (nth 4 (car requests))))
- (setq index (1+ index)
- requests (cdr requests)))))
- (let ((number (read-string "Request#: ")))
- (unless (string-match "^[0-9]+$" number)
- (error "Not a number"))
- (if (or (> (setq number (string-to-number number))
- (length riece-ndcc-requests))
- (< number 1))
- (error "Invalid number"))
- (nth (1- number) riece-ndcc-requests)))
- (expand-file-name (read-file-name "Save as: ")))))
- (let* (selective-display
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- (process (open-network-stream
- "DCC" " *DCC*"
- (riece-ndcc-decode-address (nth 2 request))
- (nth 3 request))))
- (setq riece-ndcc-requests (delq request riece-ndcc-requests))
- (with-current-buffer (process-buffer process)
- (set-buffer-multibyte nil)
- (buffer-disable-undo)
- (setq buffer-file-name file)
- (make-local-variable 'riece-ndcc-request-user)
- (setq riece-ndcc-request-user (car request))
- (make-local-variable 'riece-ndcc-request-size)
- (setq riece-ndcc-request-size (nth 4 request)))
- (set-process-filter process #'riece-ndcc-filter)
- (set-process-sentinel process #'riece-ndcc-sentinel)))
-
-(defun riece-handle-dcc-request (prefix target message)
- (let ((case-fold-search t))
- (when (and (get 'riece-ndcc 'riece-addon-enabled)
- (string-match
- "SEND \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)"
- message))
- (let ((file (match-string 1 message))
- (address (match-string 2 message))
- (port (string-to-number (match-string 3 message)))
- (size (string-to-number (match-string 4 message)))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer (riece-make-identity
- target riece-server-name))))
- (user (riece-prefix-nickname prefix)))
- (setq riece-ndcc-requests
- (cons (list user file address port size)
- riece-ndcc-requests))
- (riece-insert-change buffer (format "DCC SEND from %s\n" user))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format "DCC SEND from %s (%s) to %s"
- user
- (riece-strip-user-at-host
- (riece-prefix-user-at-host prefix))
- target))
- "\n")))
- t)))
-
-(defun riece-ndcc-requires ()
- '(riece-ctcp))
-
-(defvar riece-dialogue-mode-map)
-(defun riece-ndcc-insinuate ()
- (unless (fboundp 'make-network-process)
- (error "This Emacs does not have make-network-process"))
- (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request))
-
-(defun riece-ndcc-uninstall ()
- (remove-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request))
-
-(defun riece-ndcc-enable ()
- (define-key riece-dialogue-mode-map "\C-ds" 'riece-command-dcc-send)
- (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive))
-
-(defun riece-ndcc-disable ()
- (define-key riece-dialogue-mode-map "\C-ds" nil)
- (define-key riece-dialogue-mode-map "\C-dr" nil))
-
-(provide 'riece-ndcc)
-
-;;; riece-ndcc.el ends here
+++ /dev/null
-;;; riece-options.el --- customization
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-version)
-(require 'riece-globals)
-
-;; User modifiable variables.
-(defgroup riece nil
- "Riece specific customize group."
- :prefix "riece-"
- :group 'applications)
-
-(defgroup riece-options nil
- "Riece user customizable variables."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-saved-forms
- '(riece-server-alist
- riece-channel-buffer-mode
- riece-others-buffer-mode
- riece-user-list-buffer-mode
- riece-channel-list-buffer-mode
- riece-layout
- riece-addons)
- "Variables saved after each session is completed."
- :type 'string
- :group 'riece-options)
-
-(defcustom riece-debug nil
- "If non-nil, random debug spews."
- :type 'boolean
- :group 'riece-options)
-
-(defcustom riece-command-prefix "\C-c"
- "Key sequence to be used as prefix for command mode key bindings."
- :type 'string
- :group 'riece-options)
-
-(defgroup riece-looks nil
- "Look and feel."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-use-full-window t
- "If non-nil, whole Emacs window is used to display dialogue."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-window-center-line -2
- "Line number of center point in window when scrolling.
-If nil, erases the entire frame and then redraws with point in the
-center of the window. Negative means relative to bottom of window.
-See the document of the function `recenter'."
- :type 'integer
- :group 'riece-looks)
-
-(defcustom riece-directory (expand-file-name "~/.riece")
- "Where to look for startup files."
- :type 'directory
- :group 'riece-options)
-
-(defcustom riece-addon-directory
- (expand-file-name "addons" riece-directory)
- "Where to look for add-on files."
- :type 'directory
- :group 'riece-options)
-
-(defcustom riece-data-directory
- (if (fboundp 'locate-data-directory)
- (locate-data-directory "riece")
- (file-name-directory load-file-name))
- "Where to look for data files."
- :type 'directory
- :group 'riece-options)
-
-(defcustom riece-variables-file
- (expand-file-name "init" riece-directory)
- "Where to look for variables."
- :type 'file
- :group 'riece-options)
-
-(defcustom riece-saved-variables-file
- (expand-file-name "save" riece-directory)
- "Where to look for variables.
-This file was saved the last session."
- :type 'file
- :group 'riece-options)
-
-(defcustom riece-variables-files
- (list riece-saved-variables-file riece-variables-file)
- "Where to look for variables. Helps to remove clutter from your .emacs.
-This feature is most likely to dissappear in near future. The preferred
-way is to put Riece variables on .emacs or file loaded from there."
- :type '(repeat (file :tag "Initialization File"))
- :group 'riece-options)
-
-(defcustom riece-addons '(riece-highlight
- riece-ctcp
- riece-guess
- riece-unread
- riece-history
- riece-url
- riece-button
- riece-menu
- riece-icon
- riece-ignore
- riece-log
- riece-toolbar
- riece-alias
- riece-ctlseq
- riece-keyword
- riece-shrink-buffer
- riece-mcat)
- "Add-ons insinuated into Riece."
- :type '(repeat symbol)
- :group 'riece-options)
-
-(defgroup riece-server nil
- "Server settings."
- :prefix "riece-"
- :group 'riece)
-
-(defgroup riece-channel nil
- "Channel settings."
- :prefix "riece-"
- :group 'riece)
-
-(define-widget 'riece-service-spec 'radio
- "Edit service spec entries"
- :convert-widget 'riece-service-spec-convert)
-
-(defun riece-service-spec-convert (widget)
- (widget-put widget :args '((integer :tag "Port Number")
- (string :tag "Name")))
- widget)
-
-(define-widget 'riece-server-spec 'repeat
- "Edit server spec entries"
- :match (lambda (widget value)
- (eval `(and ,@(mapcar
- (lambda (entry)
- (or (stringp (cdr entry))
- (listp (cdr entry))))
- value))))
- :convert-widget 'riece-server-spec-convert)
-
-(defun riece-server-spec-convert (widget)
- (let* ((host '(const :format "" :value :host))
- (service '(const :format "" :value :service))
- (host
- `(group :inline t ,host (string :tag "Host")))
- (service
- `(group :inline t ,service riece-service-spec))
- (spec
- `(cons (string :tag "Name")
- (radio (string :tag "Host")
- (list ,host ,service))))
- (args (list spec)))
- (widget-put widget :args args)
- widget))
-
-(defcustom riece-server-alist nil
- "An alist mapping server names to plist."
- :type 'riece-server-spec
- :group 'riece-server)
-
-(defcustom riece-server (getenv "IRCSERVER")
- "IRC server host we are connecting to."
- :type 'string
- :group 'riece-server)
-
-(defcustom riece-protocol 'irc
- "Protocol support."
- :type 'symbol
- :group 'riece-server)
-
-(defcustom riece-max-send-size 512
- "Maximum size of messages to be sent at a time."
- :type 'integer
- :group 'riece-server)
-
-(defcustom riece-send-delay 2
- "Duration of multiple send."
- :type 'integer
- :group 'riece-server)
-
-(defcustom riece-default-password (getenv "IRCPASSWORD")
- "Your password."
- :type '(radio (string :tag "Password")
- (const :tag "No" nil))
- :group 'riece-server)
-
-(defcustom riece-username nil
- "Your login name."
- :type 'string
- :group 'riece-server)
-
-(defcustom riece-realname nil
- "Your user name."
- :type 'string
- :group 'riece-server)
-
-(defcustom riece-nickname (or (getenv "IRCNICK")
- (user-real-login-name))
- "Your nickname."
- :type 'string
- :group 'riece-server)
-
-(defcustom riece-startup-channel-list nil
- "A list of channels to join automatically at startup."
- :type '(repeat (choice (string :tag "Channel")
- (list (string :tag "Channel") (string :tag "Key"))))
- :group 'riece-channel)
-
-(defcustom riece-startup-server-list nil
- "A list of servers to connect automatically at startup."
- :type '(repeat (string :tag "Server"))
- :group 'riece-server)
-
-(defcustom riece-retry-with-new-nickname nil
- "When nickname has already been in use, grow-tail automatically."
- :type 'boolean
- :group 'riece-server)
-
-(defcustom riece-quit-timeout 1
- "Quit timeout when there is no response from server."
- :type '(radio (integer :tag "Seconds")
- (const nil))
- :group 'riece-server)
-
-(defcustom riece-default-open-connection-function #'open-network-stream
- "Default function used for connecting to an IRC server."
- :type 'function
- :group 'riece-server)
-
-(defcustom riece-user-cache-max-size 512
- "Maximum size of cache of user names."
- :type 'integer
- :group 'riece-server)
-
-(defcustom riece-channel-cache-max-size 512
- "Maximum size of cache of channel names."
- :type 'integer
- :group 'riece-server)
-
-(defcustom riece-channel-buffer-mode t
- "When non-nil, Riece will display a channel buffer."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-others-buffer-mode t
- "When non-nil, Riece will display an \"*Others*\" buffer."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-user-list-buffer-mode t
- "When non-nil, Riece will display a nick list buffer."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-channel-list-buffer-mode t
- "When non-nil, Riece will display a channel list buffer."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-default-freeze nil
- "Channel buffer local freeze flag is on at starting."
- :type 'boolean
- :group 'riece-looks)
-
-(defcustom riece-default-channel-binding nil
- "The channel list to bind the channel number when joining."
- :type '(repeat (radio (string :tag "Bound Channel")
- (const nil)))
- :group 'riece-channel)
-
-(defcustom riece-blink-parens nil
- "Should we blink matching parenthesis in the command buffer?"
- :type 'boolean
- :group 'riece-options)
-
-(defcustom riece-quit-message (riece-extended-version)
- "Default quit message."
- :type '(string :tag "Quit message")
- :group 'riece-options)
-
-(defcustom riece-part-message nil
- "Default part message."
- :type '(choice (const :tag "No message" nil)
- (string :tag "Part message"))
- :group 'riece-options)
-
-(defcustom riece-away-message "Gone"
- "Default away message."
- :type '(string :tag "Away message")
- :group 'riece-options)
-
-(defcustom riece-gather-channel-modes nil
- "If non-nil, gather channel modes when we join a channel."
- :type 'boolean
- :group 'riece-options)
-
-(defcustom riece-buffer-dispose-function #'kill-buffer
- "Function called after the buffer was disposed."
- :type 'function
- :group 'riece-options)
-
-(defcustom riece-format-time-function #'current-time-string
- "Function to convert the specified time to the human readable form."
- :type 'function
- :group 'riece-options)
-
-(provide 'riece-options)
-
-;;; riece-options.el ends here
+++ /dev/null
-;;; riece-package-info.el --- package information about Riece
-;; Copyright (C) 2006 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-;;(defconst riece-package-name "riece")
-(defconst riece-package-name "Riece")
-
-(defconst riece-version-number "3.1.2"
- "Version number for this version of Riece.")
-
-(provide 'riece-package-info)
-
-;;; riece-package-info.el ends here
+++ /dev/null
-;;; riece-package-info.el --- package information about Riece
-;; Copyright (C) 2006 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-;;(defconst riece-package-name "@PACKAGE@")
-(defconst riece-package-name "Riece")
-
-(defconst riece-version-number "@VERSION@"
- "Version number for this version of Riece.")
-
-(provide 'riece-package-info)
-
-;;; riece-package-info.el ends here
+++ /dev/null
-;;; riece-rdcc.el --- DCC file sending protocol support (written in Ruby)
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-(require 'riece-misc)
-(require 'riece-channel)
-(require 'riece-identity)
-(require 'riece-ctcp) ;for riece-ctcp-additional-clientinfo
-(require 'riece-ruby)
-(require 'riece-mcat)
-
-(defgroup riece-rdcc nil
- "DCC written in Ruby."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-rdcc-server-address nil
- "Local address of the DCC server.
-Only used for sending files."
- :type 'string
- :group 'riece-rdcc)
-
-(defcustom riece-rdcc-send-program
- '("\
-require 'socket'
-address = " address "
-unless address
- sock = UDPSocket.new
- sock.connect('164.46.176.4', 7) # www.unixuser.org/echo
- address = sock.getsockname[4 .. 7].unpack('CCCC').join('.')
-end
-server = TCPServer.new(address, 0)
-output(\"#{server.addr[3].split(/\\./).collect{|c| c.to_i}.pack('CCCC').unpack('N')[0]} #{server.addr[1]}\")
-session = server.accept
-if session
- total = 0
- File.open(" file ") {|file|
- while (bytes = file.read(" block-size "))
- total += bytes.length
- output(total)
- session.write(bytes)
- begin
- buf = session.read(4)
- end until buf.unpack('N')[0] == total
- end
- }
- session.close
-end
-")
- "Ruby program to send file with DCC."
- :type 'list
- :group 'riece-rdcc)
-
-(defcustom riece-rdcc-decode-address-program
- '("\"#{" address " >> 24 & 0xFF}.#{" address " >> 16 & 0xFF}.#{"
- address " >> 8 & 0xFF}.#{" address " & 0xFF}\"")
- "Ruby program to numeric IP address."
- :type 'list
- :group 'riece-rdcc)
-
-(defcustom riece-rdcc-save-directory nil
- "Default directory where received files are saved in."
- :type 'directory
- :group 'riece-rdcc)
-
-(defcustom riece-rdcc-block-size 1024
- "Number of bytes sent as a block."
- :type 'integer
- :group 'riece-rdcc)
-
-(defvar riece-rdcc-requests nil)
-
-(defvar riece-rdcc-request-user nil)
-(defvar riece-rdcc-request-file nil)
-(defvar riece-rdcc-request-size nil)
-
-(defvar riece-rdcc-temp-file nil)
-(defvar riece-rdcc-received-size nil)
-
-(defconst riece-rdcc-description
- "DCC file sending protocol support (written in Ruby.)")
-
-(defvar temporary-file-directory)
-(defvar jka-compr-compression-info-list)
-(defvar jam-zcat-filename-list)
-
-(defun riece-rdcc-output-handler (name output time)
- (if (string-match "\\([0-9]+\\) \\([0-9]+\\)" output)
- (let ((address (match-string 1 output))
- (port (match-string 2 output)))
- (riece-send-string
- (format "PRIVMSG %s :\1DCC SEND %s %s %s %d\1\r\n"
- (riece-identity-prefix
- (riece-ruby-property name 'riece-rdcc-request-user))
- (file-name-nondirectory
- (riece-ruby-property name 'riece-rdcc-request-file))
- address port
- (riece-ruby-property name 'riece-rdcc-request-size)))))
- (riece-ruby-set-output-handler name #'riece-rdcc-output-handler-2))
-
-(defun riece-rdcc-output-handler-2 (name output time)
- (message (riece-mcat "Sending %s...(%s/%d)")
- (riece-ruby-property name 'riece-rdcc-request-file)
- (string-to-number output)
- (riece-ruby-property name 'riece-rdcc-request-size)))
-
-(defun riece-rdcc-exit-handler (name)
- (message (riece-mcat "Sending %s...done")
- (riece-ruby-property name 'riece-rdcc-request-file)))
-
-(defun riece-command-dcc-send (user file)
- (interactive
- (let ((completion-ignore-case t))
- (list (riece-completing-read-identity
- (riece-mcat "User: ")
- (riece-get-users-on-server (riece-current-server-name)))
- (expand-file-name (read-file-name (riece-mcat "File: "))))))
- (let ((name (riece-ruby-execute
- (riece-ruby-substitute-variables
- riece-rdcc-send-program
- (list (cons 'address
- (if riece-rdcc-server-address
- (concat "'" riece-rdcc-server-address
- "'")
- "nil"))
- (cons 'file
- (concat "'" file "'"))
- (cons 'block-size
- (number-to-string
- riece-rdcc-block-size)))))))
- (riece-ruby-set-property name 'riece-rdcc-request-user user)
- (riece-ruby-set-property name 'riece-rdcc-request-file file)
- (riece-ruby-set-property name 'riece-rdcc-request-size
- (nth 7 (file-attributes file)))
- (riece-ruby-set-output-handler name #'riece-rdcc-output-handler)
- (riece-ruby-set-exit-handler name #'riece-rdcc-exit-handler)))
-
-(defun riece-rdcc-filter (process input)
- (save-excursion
- (set-buffer (process-buffer process))
- (erase-buffer)
- (insert input)
- (let ((coding-system-for-write 'binary)
- jka-compr-compression-info-list jam-zcat-filename-list)
- (write-region (point-min) (point-max) riece-rdcc-temp-file t 0))
- (setq riece-rdcc-received-size (+ (buffer-size) riece-rdcc-received-size))
- (process-send-string
- process
- (format "%c%c%c%c"
- (lsh riece-rdcc-received-size -24)
- (logand (lsh riece-rdcc-received-size -16) 255)
- (logand (lsh riece-rdcc-received-size -8) 255)
- (logand riece-rdcc-received-size 255)))
- (message (riece-mcat "Receiving %s from %s...(%s/%s)")
- (file-name-nondirectory riece-rdcc-request-file)
- riece-rdcc-request-user
- (riece-rdcc-format-size riece-rdcc-received-size)
- (riece-rdcc-format-size riece-rdcc-request-size))
- (if (= riece-rdcc-received-size riece-rdcc-request-size)
- (set-process-filter process nil))))
-
-(defun riece-rdcc-sentinel (process status)
- (save-excursion
- (set-buffer (process-buffer process))
- (unless (= riece-rdcc-received-size riece-rdcc-request-size)
- (error "Premature end of file"))
- (message (riece-mcat "Receiving %s from %s...done")
- (file-name-nondirectory riece-rdcc-request-file)
- riece-rdcc-request-user)
- (condition-case nil
- (progn
- (rename-file riece-rdcc-temp-file riece-rdcc-request-file)
- (delete-directory (file-name-directory riece-rdcc-temp-file)))
- (file-already-exists
- (error "Can't save %s. Temporarily saved in %s"
- riece-rdcc-request-file riece-rdcc-temp-file))))
- (kill-buffer (process-buffer process)))
-
-(defun riece-rdcc-decode-address (address)
- (let ((name (riece-ruby-execute
- (riece-ruby-substitute-variables
- riece-rdcc-decode-address-program
- (list (cons 'address address)))))
- response)
- (while (equal (nth 2 (setq response (riece-ruby-inspect name))) "running")
- (accept-process-output riece-ruby-process))
- (riece-ruby-clear name)
- (nth 1 response)))
-
-(defun riece-command-dcc-receive (request file)
- (interactive
- (progn
- (unless riece-rdcc-requests
- (error "No request"))
- (let* ((request
- (if (= (length riece-rdcc-requests) 1)
- (car riece-rdcc-requests)
- (with-output-to-temp-buffer "*Help*"
- (let ((requests riece-rdcc-requests)
- (index 1))
- (while requests
- (princ (format (riece-mcat "%2d: %s %s (%d bytes)\n")
- index
- (car (car requests))
- (nth 1 (car requests))
- (nth 4 (car requests))))
- (setq index (1+ index)
- requests (cdr requests)))))
- (let ((number (read-string "Request#: ")))
- (unless (string-match "^[0-9]+$" number)
- (error "Not a number"))
- (if (or (> (setq number (string-to-number number))
- (length riece-rdcc-requests))
- (< number 1))
- (error "Invalid number"))
- (nth (1- number) riece-rdcc-requests))))
- (default-name (expand-file-name
- (convert-standard-filename (nth 1 request))
- (or riece-rdcc-save-directory
- default-directory))))
- (list request
- (expand-file-name
- (read-file-name
- (format (riece-mcat "Save as (default %s) ")
- (file-name-nondirectory default-name))
- (file-name-directory default-name)
- default-name))))))
- (let* ((temp-file (expand-file-name
- (file-name-nondirectory file)
- (expand-file-name (make-temp-name "riece-rdcc")
- (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))))
- (orig-mode (default-file-modes))
- selective-display
- (coding-system-for-read 'binary)
- (coding-system-for-write 'binary)
- process)
- (unwind-protect
- (progn
- (set-default-file-modes 448)
- ;; This may throw an error.
- (make-directory (file-name-directory temp-file)))
- (set-default-file-modes orig-mode))
- (setq process (open-network-stream
- "DCC" (generate-new-buffer " *DCC*")
- (riece-rdcc-decode-address (nth 2 request))
- (nth 3 request)))
- (setq riece-rdcc-requests (delq request riece-rdcc-requests))
- (with-current-buffer (process-buffer process)
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
- (buffer-disable-undo)
- (erase-buffer)
- (make-local-variable 'riece-rdcc-request-user)
- (setq riece-rdcc-request-user (car request))
- (make-local-variable 'riece-rdcc-request-file)
- (setq riece-rdcc-request-file file)
- (make-local-variable 'riece-rdcc-request-size)
- (setq riece-rdcc-request-size (nth 4 request))
- (make-local-variable 'riece-rdcc-temp-file)
- (setq riece-rdcc-temp-file temp-file)
- (make-local-variable 'riece-rdcc-received-size)
- (setq riece-rdcc-received-size 0))
- (set-process-filter process #'riece-rdcc-filter)
- (set-process-sentinel process #'riece-rdcc-sentinel)))
-
-(defun riece-rdcc-format-size (size)
- (if (< size 1024)
- (format "%0.1f" size)
- (setq size (/ size 1024.0))
- (if (< size 1024)
- (format "%0.1fKB" size)
- (setq size (/ size 1024.0))
- (if (< size 1024)
- (format "%0.1fMB" size)
- (format "%0.1fGB" (/ size 1024.0))))))
-
-(defun riece-handle-dcc-request (prefix target message)
- (let ((case-fold-search t))
- (when (and (get 'riece-rdcc 'riece-addon-enabled)
- (string-match
- "SEND \\(\\([^ ]+\\)\\|\"\\(.+\\)\"\\) \\([^ ]+\\) \\([^ ]+\\) \\([^ ]+\\)"
- message))
- (let ((file (or (match-string 2 message)
- (match-string 3 message)))
- (address (match-string 4 message))
- (port (string-to-number (match-string 5 message)))
- (size (string-to-number (match-string 6 message)))
- (buffer (if (riece-channel-p target)
- (riece-channel-buffer (riece-make-identity
- target riece-server-name))))
- (user (riece-prefix-nickname prefix)))
- (setq riece-rdcc-requests
- (cons (list user file address port size)
- riece-rdcc-requests))
- (message "%s"
- (with-current-buffer (window-buffer (selected-window))
- (substitute-command-keys
- (format
- (riece-mcat
- "Type \\[riece-command-dcc-receive] to receive")
- user))))
- (riece-insert-change buffer (format "DCC SEND from %s: %s (%s)\n"
- user file
- (riece-rdcc-format-size size)))
- (riece-insert-change
- (if (and riece-channel-buffer-mode
- (not (eq buffer riece-channel-buffer)))
- (list riece-dialogue-buffer riece-others-buffer)
- riece-dialogue-buffer)
- (concat
- (riece-concat-server-name
- (format "DCC SEND from %s (%s) to %s: %s (%s)"
- user
- (riece-strip-user-at-host
- (riece-prefix-user-at-host prefix))
- (riece-decode-coding-string target)
- file
- (riece-rdcc-format-size size)))
- "\n")))
- t)))
-
-(defun riece-rdcc-requires ()
- '(riece-ctcp))
-
-(defvar riece-dialogue-mode-map)
-(defun riece-rdcc-insinuate ()
- (add-to-list 'riece-ctcp-additional-clientinfo "DCC")
- (add-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request))
-
-(defun riece-rdcc-uninstall ()
- (setq riece-ctcp-additional-clientinfo
- (delete "DCC" riece-ctcp-additional-clientinfo))
- (remove-hook 'riece-ctcp-dcc-request-hook 'riece-handle-dcc-request))
-
-(defun riece-rdcc-enable ()
- (define-key riece-dialogue-mode-map "\C-ds" 'riece-command-dcc-send)
- (define-key riece-dialogue-mode-map "\C-dr" 'riece-command-dcc-receive))
-
-(defun riece-rdcc-disable ()
- (define-key riece-dialogue-mode-map "\C-ds" nil)
- (define-key riece-dialogue-mode-map "\C-dr" nil))
-
-(provide 'riece-rdcc)
-
-;;; riece-rdcc.el ends here
+++ /dev/null
-;;; riece-ruby.el --- interact with Ruby interpreter
-;; Copyright (C) 1998-2005 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece, Ruby
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; riece-ruby.el is a library to interact with Ruby interpreter.
-;; It supports concurrent execution of Ruby programs in a single
-;; session. For example:
-;;
-;; (riece-ruby-execute "sleep 30"); returns immediately
-;; => "rubyserv0"
-;;
-;; (riece-ruby-execute "1 + 1")
-;; => "rubyserv1"
-;;
-;; (riece-ruby-execute "\"")
-;; => "rubyserv2"
-;;
-;; (riece-ruby-inspect "rubyserv0")
-;; => ((OK nil) nil (("running")))
-;;
-;; (riece-ruby-inspect "rubyserv1")
-;; => ((OK nil) "2" (("finished")))
-;;
-;; (riece-ruby-inspect "rubyserv2")
-;; => ((OK nil) "(eval):1: unterminated string meets end of file" (("exited")))
-
-;;; Code:
-
-(require 'riece-debug)
-
-(defgroup riece-ruby nil
- "Interact with Ruby interpreter."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-ruby-command "ruby"
- "Command name for Ruby interpreter."
- :type 'string
- :group 'riece-ruby)
-
-(defcustom riece-ruby-out-file (expand-file-name "riece-ruby.out"
- riece-directory)
- "A file which records stdout of Ruby programs."
- :type 'string
- :group 'riece-ruby)
-
-(defcustom riece-ruby-err-file (expand-file-name "riece-ruby.err"
- riece-directory)
- "A file which records stderr of Ruby programs."
- :type 'string
- :group 'riece-ruby)
-
-(defcustom riece-ruby-log-file (expand-file-name "riece-ruby.log"
- riece-directory)
- "A file used to logging."
- :type 'string
- :group 'riece-ruby)
-
-(defvar riece-ruby-server-program "server.rb"
- "The server program file. If the filename is not absolute, it is
-assumed that the file is in the same directory of this file.")
-
-(defvar riece-ruby-server-program-arguments (list "-o" riece-ruby-out-file
- "-e" riece-ruby-err-file
- "-l" riece-ruby-log-file)
- "Command line arguments passed to `riece-ruby-server-program'.")
-
-(defvar riece-ruby-process nil
- "Process object of Ruby interpreter.")
-
-(defvar riece-ruby-lock nil
- "Lock for waiting server response.
-Local to the process buffer.")
-(defvar riece-ruby-response nil
- "The server response.
-Local to the process buffer.")
-(defvar riece-ruby-data nil
- "Data from server.
-Local to the process buffer.")
-(defvar riece-ruby-escaped-data nil
- "Escaped data from server. This variable is cleared every time
-server response arrives.
-Local to the process buffer.")
-(defvar riece-ruby-status-alist nil
- "Status from server.
-Local to the process buffer.")
-
-(defvar riece-ruby-output-queue-alist nil
- "An alist mapping from program name to output data.")
-(defvar riece-ruby-output-handler-alist nil
- "An alist mapping from program name to output handler.
-Output handlers are called every time \"# output\" line arrives.
-Use `riece-ruby-set-output-handler' to set this variable.")
-(defvar riece-ruby-exit-handler-alist nil
- "An alist mapping from program name to exit handler.
-Exit handlers are called once when \"# exit\" line arrives.
-Use `riece-ruby-set-exit-handler' to set this variable.")
-(defvar riece-ruby-property-alist nil
- "An alist mapping from program name to the property list.
-Use `riece-ruby-set-property' to set this variable.")
-
-(defun riece-ruby-escape-data (data)
- (let ((index 0))
- (while (string-match "[%\r\n]+" data index)
- (setq data (replace-match
- (mapconcat (lambda (c) (format "%%%02X" c))
- (match-string 0 data) "")
- nil nil data)
- index (+ (match-end 0)
- (* (- (match-end 0) (match-beginning 0)) 2))))
- data))
-
-(defun riece-ruby-unescape-data (data)
- (let ((index 0))
- (while (string-match "%\\([0-9A-F][0-9A-F]\\)" data index)
- (setq data (replace-match
- (read (concat "\"\\x" (match-string 1 data) "\""))
- nil nil data)
- index (- (match-end 0) 2)))
- data))
-
-(defun riece-ruby-reset-process-buffer ()
- (save-excursion
- (set-buffer (process-buffer riece-ruby-process))
- (buffer-disable-undo)
- (make-local-variable 'riece-ruby-response)
- (setq riece-ruby-response nil)
- (make-local-variable 'riece-ruby-data)
- (setq riece-ruby-data nil)
- (make-local-variable 'riece-ruby-escaped-data)
- (setq riece-ruby-escaped-data nil)
- (make-local-variable 'riece-ruby-status-alist)
- (setq riece-ruby-status-alist nil)))
-
-(defun riece-ruby-send-eval (program)
- (let* ((string (riece-ruby-escape-data program))
- (length (- (length string) 998))
- (index 0)
- data)
- (while (< index length)
- (setq data (cons (substring string index (setq index (+ index 998)))
- data)))
- (setq data (cons (substring string index) data)
- data (nreverse data))
- (process-send-string riece-ruby-process "EVAL\r\n")
- (while data
- (process-send-string riece-ruby-process
- (concat "D " (car data) "\r\n"))
- (setq data (cdr data)))
- (process-send-string riece-ruby-process "END\r\n")))
-
-(defun riece-ruby-send-poll (name)
- (process-send-string riece-ruby-process
- (concat "POLL " name "\r\n")))
-
-(defun riece-ruby-send-exit (name)
- (process-send-string riece-ruby-process
- (concat "EXIT " name "\r\n")))
-
-(defun riece-ruby-filter (process input)
- (save-excursion
- (set-buffer (process-buffer process))
- (goto-char (point-max))
- (insert input)
- (goto-char (point-min))
- (beginning-of-line)
- (while (looking-at ".*\r\n")
- (if (looking-at "OK\\( \\(.*\\)\\)?\r")
- (progn
- (if riece-ruby-escaped-data
- (setq riece-ruby-data (mapconcat #'riece-ruby-unescape-data
- riece-ruby-escaped-data "")))
- (setq riece-ruby-escaped-data nil
- riece-ruby-response (list 'OK (match-string 2))
- riece-ruby-lock nil))
- (if (looking-at "ERR \\([0-9]+\\)\\( \\(.*\\)\\)?\r")
- (progn
- (setq riece-ruby-escaped-data nil
- riece-ruby-response
- (list 'ERR (string-to-number (match-string 1))
- (match-string 3))
- riece-ruby-lock nil))
- (if (looking-at "D \\(.*\\)\r")
- (setq riece-ruby-escaped-data (cons (match-string 1)
- riece-ruby-escaped-data))
- (if (looking-at "S \\([^ ]*\\) \\(.*\\)\r")
- (progn
- (setq riece-ruby-status-alist (cons (cons (match-string 1)
- (match-string 2))
- riece-ruby-status-alist))
- (if (member (car (car riece-ruby-status-alist))
- '("finished" "exited"))
- (riece-ruby-run-exit-handler
- (cdr (car riece-ruby-status-alist)))))
- (if (looking-at "# output \\([^ ]*\\) \\(.*\\)\r")
- (riece-ruby-run-output-handler (match-string 1)
- (match-string 2)
- (current-time))
- (if (looking-at "# exit \\(.*\\)\r")
- (riece-ruby-run-exit-handler (match-string 1))))))))
- (forward-line))
- (delete-region (point-min) (point))))
-
-(defun riece-ruby-run-exit-handler (name)
- (let ((entry (assoc name riece-ruby-exit-handler-alist)))
- (when entry
- (setq riece-ruby-exit-handler-alist
- (delq entry riece-ruby-exit-handler-alist))
- (riece-funcall-ignore-errors (if (symbolp (cdr entry))
- (symbol-name (cdr entry))
- (format "%s-exit-handler" name))
- (cdr entry) (car entry))
- (riece-ruby-clear name))))
-
-(defun riece-ruby-run-output-handler (name output time)
- (let ((handler-entry (assoc name riece-ruby-output-handler-alist))
- (entry (assoc name riece-ruby-output-queue-alist)))
- (if handler-entry
- (riece-funcall-ignore-errors (if (symbolp (cdr handler-entry))
- (symbol-name (cdr handler-entry))
- (format "%s-output-handler" name))
- (cdr handler-entry) name output time)
- (if entry
- (setcdr entry (cons (cons output time) (cdr entry)))
- (setq riece-ruby-output-queue-alist
- (cons (list name (cons output time))
- riece-ruby-output-queue-alist))))))
-
-(defun riece-ruby-sentinel (process status)
- (kill-buffer (process-buffer process)))
-
-(defun riece-ruby-execute (program)
- "Schedule an execution of a Ruby PROGRAM.
-Return a string name assigned by the server."
- (unless (and riece-ruby-process
- (eq (process-status riece-ruby-process) 'run))
- (let (selective-display
- (coding-system-for-write 'binary)
- (coding-system-for-read 'binary))
- (setq riece-ruby-process
- (apply #'start-process "riece-ruby" (generate-new-buffer " *Ruby*")
- riece-ruby-command
- (expand-file-name riece-ruby-server-program
- riece-data-directory)
- riece-ruby-server-program-arguments))
- (process-kill-without-query riece-ruby-process)
- (set-process-filter riece-ruby-process #'riece-ruby-filter)
- (set-process-sentinel riece-ruby-process #'riece-ruby-sentinel)))
- (save-excursion
- (set-buffer (process-buffer riece-ruby-process))
- (riece-ruby-reset-process-buffer)
- (make-local-variable 'riece-ruby-lock)
- (setq riece-ruby-lock t)
- (riece-ruby-send-eval program)
- (while riece-ruby-lock
- (accept-process-output riece-ruby-process))
- (if (eq (car riece-ruby-response) 'ERR)
- (error "Couldn't execute: %S" (cdr riece-ruby-response)))
- (cdr (assoc "name" riece-ruby-status-alist))))
-
-(defun riece-ruby-inspect (name)
- "Inspect a result of program execution distinguished by NAME.
-Return a three element list.
-The car is protocol response line which looks like:
- \(ERR 103 \"Not implemented\").
-The cadr is data from the server, that is, the result of the program.
-The caddr is status from the server."
- (save-excursion
- (set-buffer (process-buffer riece-ruby-process))
- (riece-ruby-reset-process-buffer)
- (make-local-variable 'riece-ruby-lock)
- (setq riece-ruby-lock t)
- (riece-ruby-send-poll name)
- (while riece-ruby-lock
- (accept-process-output riece-ruby-process))
- (list riece-ruby-response
- riece-ruby-data
- riece-ruby-status-alist)))
-
-(defun riece-ruby-clear (name)
- "Clear a result of program execution distinguished by NAME.
-Note that riece-ruby-clear is automatically called iff an exit-handler
-is specified. Otherwise, it should be called explicitly."
- (save-excursion
- (set-buffer (process-buffer riece-ruby-process))
- (riece-ruby-reset-process-buffer)
- (make-local-variable 'riece-ruby-lock)
- (setq riece-ruby-lock t)
- (riece-ruby-send-exit name)
- (while riece-ruby-lock
- (accept-process-output riece-ruby-process)))
- (let ((entry (assoc name riece-ruby-property-alist)))
- (if entry
- (delq entry riece-ruby-property-alist))))
-
-(defun riece-ruby-set-exit-handler (name handler)
- "Set an exit-handler HANDLER for the program distinguished by NAME.
-An exit-handler is called when the program is finished or exited abnormally.
-An exit-handler is called with an argument same as NAME.
-Note that riece-ruby-clear is automatically called iff an exit-handler
-is specified. Otherwise, it should be called explicitly."
- (let ((entry (assoc name riece-ruby-exit-handler-alist)))
- (if handler
- (progn
- (if entry
- (setcdr entry handler)
- (setq riece-ruby-exit-handler-alist
- (cons (cons name handler)
- riece-ruby-exit-handler-alist)))
- ;;check if the program already exited
- (riece-ruby-inspect name))
- (if entry
- (setq riece-ruby-exit-handler-alist
- (delq entry riece-ruby-exit-handler-alist))))))
-
-(defun riece-ruby-set-output-handler (name handler)
- "Set an output-handler HANDLER for the program distinguished by NAME.
-An output-handler is called when the program sends any output by using
-`output' method in the Ruby program.
-An output-handler is called with three argument. The first argument
-is the same as NAME. The second argument is the output string. The
-third argument is the timestamp of the output event."
- (let ((entry (assoc name riece-ruby-output-handler-alist))
- queue-entry pointer)
- (if handler
- (progn
- (when (setq queue-entry (assoc name riece-ruby-output-queue-alist))
- (setq pointer (nreverse (cdr queue-entry))
- riece-ruby-output-queue-alist
- (delq queue-entry riece-ruby-output-queue-alist))
- (while pointer
- (riece-funcall-ignore-errors (if (symbolp handler)
- (symbol-name handler)
- (format "%s-output-handler" name))
- handler name (car (car pointer))
- (cdr (car pointer)))
- (setq pointer (cdr pointer))))
- (if entry
- (setcdr entry handler)
- (setq riece-ruby-output-handler-alist
- (cons (cons name handler)
- riece-ruby-output-handler-alist))))
- (if entry
- (setq riece-ruby-output-handler-alist
- (delq entry riece-ruby-output-handler-alist))))))
-
-(defun riece-ruby-set-property (name property value)
- "Set given PROPERTY/VALUE pair to the program distinguished by NAME."
- (let ((entry (assoc name riece-ruby-property-alist))
- property-entry)
- (unless entry
- (setq entry (list name)
- riece-ruby-property-alist (cons entry riece-ruby-property-alist)))
- (if (setq property-entry (assoc property (cdr entry)))
- (setcdr property-entry value)
- (setcdr entry (cons (cons property value) (cdr entry))))))
-
-(defun riece-ruby-property (name property)
- "Return the value of PROPERTY set to the program distinguished by NAME."
- (cdr (assoc property (cdr (assoc name riece-ruby-property-alist)))))
-
-(defun riece-ruby-substitute-variables (program alist)
- "Substitute symbols in PROGRAM by looking up ALIST.
-Return a string concatenating elements in PROGRAM."
- (setq program (copy-sequence program))
- (while alist
- (let ((pointer program))
- (while pointer
- (setq pointer (memq (car (car alist)) program))
- (if pointer
- (setcar pointer (cdr (car alist))))))
- (setq alist (cdr alist)))
- (apply #'concat program))
-
-(provide 'riece-ruby)
-
-;;; riece-ruby.el ends here
+++ /dev/null
-;;; riece-server.el --- functions to open and close servers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-globals) ;for server local variables.
-(require 'riece-coding) ;riece-default-coding-system
-(require 'riece-identity)
-(require 'riece-compat)
-(require 'riece-cache)
-
-(eval-and-compile
- (defvar riece-server-keyword-map
- '((:host)
- (:service 6667)
- (:nickname riece-nickname)
- (:realname riece-realname)
- (:username riece-username)
- (:password)
- (:function riece-default-open-connection-function)
- (:coding riece-default-coding-system))
- "Mapping from keywords to default values.
-All keywords that can be used must be listed here."))
-
-(defmacro riece-server-keyword-bind (plist &rest body)
- "Return a `let' form that binds all variables in PLIST.
-After this is done, BODY will be executed in the scope
-of the `let' form.
-
-The variables bound and their default values are described by
-the `riece-server-keyword-map' variable."
- `(let ,(mapcar
- (lambda (keyword)
- (list (intern (substring (symbol-name (car keyword)) 1))
- (if (cadr keyword)
- `(or (plist-get ,plist ',(car keyword))
- ,(cadr keyword))
- `(plist-get ,plist ',(car keyword)))))
- riece-server-keyword-map)
- ,@body))
-
-(put 'riece-server-keyword-bind 'lisp-indent-function 1)
-(put 'riece-server-keyword-bind 'edebug-form-spec '(form body))
-
-(defun riece-server-parse-string (string)
- "Convert a STRING set as `riece-server' and return a property list."
- (when (or (string-match "^\\[\\([^]]+\\)\\]:?\\([0-9]*\\)" string)
- (string-match "^\\([^:]+\\):?\\([0-9]*\\)" string))
- (let ((host (match-string 1 string))
- (service (match-string 2 string))
- (password (substring string (match-end 0)))
- plist)
- (setq plist (cons `(:host ,host) plist))
- (unless (equal service "")
- (setq plist (cons `(:service ,(string-to-number service)) plist)))
- (unless (equal password "")
- (setq plist (cons `(:password ,(substring password 1)) plist)))
- (apply #'nconc plist))))
-
-(defun riece-server-name-to-server (server-name)
- (let ((entry (assoc server-name riece-server-alist)))
- (if entry
- (unless (listp (cdr entry))
- (setcdr entry (riece-server-parse-string (cdr entry))))
- (setq entry (cons server-name (riece-server-parse-string server-name))
- riece-server-alist (cons entry riece-server-alist)
- riece-save-variables-are-dirty t))
- (cdr entry)))
-
-(defun riece-server-process-name (server-name)
- (if (equal server-name "")
- "IRC"
- (format "IRC<%s>" server-name)))
-
-(defun riece-server-process (server-name)
- (cdr (assoc server-name riece-server-process-alist)))
-
-(defmacro riece-with-server-buffer (server-name &rest body)
- `(let ((process (riece-server-process ,server-name)))
- (if process
- (with-current-buffer (process-buffer process)
- ,@body)
- (error "Server closed"))))
-
-(put 'riece-with-server-buffer 'lisp-indent-function 1)
-(put 'riece-with-server-buffer 'edebug-form-spec '(form body))
-
-(defun riece-make-queue ()
- "Make a queue object."
- (vector nil nil))
-
-(defun riece-queue-enqueue (queue object)
- "Add OBJECT to the end of QUEUE."
- (if (aref queue 1)
- (let ((last (list object)))
- (nconc (aref queue 1) last)
- (aset queue 1 last))
- (aset queue 0 (list object))
- (aset queue 1 (aref queue 0))))
-
-(defun riece-queue-dequeue (queue)
- "Remove an object from the beginning of QUEUE."
- (unless (aref queue 0)
- (error "Empty queue"))
- (prog1 (car (aref queue 0))
- (unless (aset queue 0 (cdr (aref queue 0)))
- (aset queue 1 nil))))
-
-(defun riece-queue-empty (queue)
- "Return t if QUEUE is empty."
- (null (aref queue 0)))
-
-;; stolen (and renamed) from time-date.el.
-(defun riece-seconds-to-time (seconds)
- "Convert SECONDS (a floating point number) to a time value."
- (list (floor seconds 65536)
- (floor (mod seconds 65536))
- (floor (* (- seconds (ffloor seconds)) 1000000))))
-
-;; stolen (and renamed) from time-date.el.
-(defun riece-time-less-p (t1 t2)
- "Say whether time value T1 is less than time value T2."
- (or (< (car t1) (car t2))
- (and (= (car t1) (car t2))
- (< (nth 1 t1) (nth 1 t2)))))
-
-;; stolen (and renamed) from time-date.el.
-(defun riece-time-since (time)
- "Return the time elapsed since TIME."
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time)))))
-
-(defun riece-flush-send-queue (process)
- (with-current-buffer (process-buffer process)
- (let ((length 0)
- string)
- (if (riece-time-less-p (riece-seconds-to-time riece-send-delay)
- (riece-time-since riece-last-send-time))
- (setq riece-send-size 0))
- (while (and (not (riece-queue-empty riece-send-queue))
- (<= riece-send-size riece-max-send-size))
- (setq string (riece-queue-dequeue riece-send-queue)
- length (length string))
- (if (> length riece-max-send-size)
- (message "Long message (%d > %d)" length riece-max-send-size)
- (setq riece-send-size (+ riece-send-size length))
- (when (<= riece-send-size riece-max-send-size)
- (process-send-string process string)
- (setq riece-last-send-time (current-time)))))
- (unless (riece-queue-empty riece-send-queue)
- (riece-run-at-time riece-send-delay nil
- (lambda (process)
- (if (riece-server-process-opened process)
- (riece-flush-send-queue process)))
- process)))))
-
-(defun riece-process-send-string (process string)
- (with-current-buffer (process-buffer process)
- (riece-queue-enqueue riece-send-queue string))
- (riece-flush-send-queue process))
-
-(defun riece-current-server-name ()
- (or riece-overriding-server-name
- ;already in the server buffer
- (if (local-variable-p 'riece-server-name (current-buffer))
- riece-server-name
- (if riece-current-channel
- (riece-identity-server riece-current-channel)
- (if (riece-server-opened "")
- "")))))
-
-(defun riece-send-string (string &optional identity)
- (let* ((server-name (if identity
- (riece-identity-server identity)
- (riece-current-server-name)))
- (process (riece-server-process server-name)))
- (unless process
- (error "%s" (substitute-command-keys
- "Type \\[riece-command-open-server] to open server.")))
- (riece-process-send-string
- process
- (with-current-buffer (process-buffer process)
- (if identity
- (riece-encode-coding-string-for-identity string identity)
- (riece-encode-coding-string string))))))
-
-(defun riece-open-server (server server-name)
- (let ((protocol (or (plist-get server :protocol)
- riece-protocol))
- function
- process)
- (condition-case nil
- (require (intern (concat "riece-" (symbol-name protocol))))
- (error))
- (setq function (intern-soft (concat "riece-"
- (symbol-name protocol)
- "-open-server")))
- (unless function
- (error "\"%S\" is not supported" protocol))
- (condition-case nil
- (setq process (funcall function server server-name))
- (error))
- (when process
- (with-current-buffer (process-buffer process)
- (make-local-variable 'riece-protocol)
- (setq riece-protocol protocol))
- (setq riece-server-process-alist
- (cons (cons server-name process)
- riece-server-process-alist)))))
-
-(defun riece-quit-server-process (process &optional message)
- (let ((function (intern-soft
- (concat "riece-"
- (with-current-buffer (process-buffer process)
- (symbol-name riece-protocol))
- "-quit-server-process"))))
- (if function
- (funcall function process message))))
-
-(defun riece-reset-process-buffer (process)
- (save-excursion
- (set-buffer (process-buffer process))
- (if (fboundp 'set-buffer-multibyte)
- (set-buffer-multibyte nil))
- (kill-all-local-variables)
- (make-local-variable 'riece-real-nickname)
- (make-local-variable 'riece-last-nickname)
- (make-local-variable 'riece-nick-accepted)
- (make-local-variable 'riece-real-server-name)
- (make-local-variable 'riece-real-userhost)
- (make-local-variable 'riece-user-at-host)
- (make-local-variable 'riece-user-at-host-type)
- (make-local-variable 'riece-supported-user-modes)
- (make-local-variable 'riece-supported-channel-modes)
- (make-local-variable 'riece-channel-filter)
- (make-local-variable 'riece-server-name)
- (make-local-variable 'riece-read-point)
- (setq riece-read-point (point-min))
- (make-local-variable 'riece-filter-running)
- (make-local-variable 'riece-send-queue)
- (setq riece-send-queue (riece-make-queue))
- (make-local-variable 'riece-send-size)
- (setq riece-send-size 0)
- (make-local-variable 'riece-last-send-time)
- (setq riece-last-send-time '(0 0 0))
- (make-local-variable 'riece-user-obarray)
- (setq riece-user-obarray (make-vector riece-user-obarray-size 0))
- (make-local-variable 'riece-channel-obarray)
- (setq riece-channel-obarray (make-vector riece-channel-obarray-size 0))
- (make-local-variable 'riece-coding-system)
- (make-local-variable 'riece-channel-cache)
- (setq riece-channel-cache (riece-make-cache riece-channel-cache-max-size))
- (make-local-variable 'riece-user-cache)
- (setq riece-user-cache (riece-make-cache riece-user-cache-max-size))
- (buffer-disable-undo)
- (erase-buffer)))
-
-(defun riece-close-server-process (process)
- (with-current-buffer (process-buffer process)
- (run-hooks 'riece-after-close-hook))
- (kill-buffer (process-buffer process))
- (setq riece-server-process-alist
- (delq (rassq process riece-server-process-alist)
- riece-server-process-alist)))
-
-(defun riece-server-process-opened (process)
- (not (null (memq (process-status process) '(open run)))))
-
-(defun riece-server-opened (&optional server-name)
- (if server-name
- (let ((process (riece-server-process server-name)))
- (and process
- (riece-server-process-opened process)))
- (let ((alist riece-server-process-alist))
- (catch 'found
- (while alist
- (if (riece-server-process-opened (cdr (car alist)))
- (throw 'found t))
- (setq alist (cdr alist)))))))
-
-(defun riece-server-properties (server-name)
- "Return a list of properties associated with SERVER-NAME."
- (if (equal server-name "")
- riece-server
- (let ((entry (assoc server-name riece-server-alist)))
- (unless entry
- (error "No such server"))
- (cdr entry))))
-
-(provide 'riece-server)
-
-;;; riece-server.el ends here
+++ /dev/null
-;;; riece-shrink-buffer.el --- free old IRC messages to save memory usage
-;; Copyright (C) 1998-2005 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-globals)
-
-(defgroup riece-shrink-buffer nil
- "Free old IRC messages to save memory usage."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-shrink-buffer-idle-time-delay 5
- "Number of idle seconds to wait before shrinking channel buffers."
- :type 'integer
- :group 'riece-shrink-buffer)
-
-(defcustom riece-max-buffer-size 65536
- "Maximum size of channel buffers."
- :type '(integer :tag "Number of characters")
- :group 'riece-shrink-buffer)
-
-(defcustom riece-shrink-buffer-remove-chars (/ riece-max-buffer-size 2)
- "Number of chars removed when shrinking channel buffers."
- :type 'integer
- :group 'riece-shrink-buffer)
-
-(defvar riece-shrink-buffer-idle-timer nil
- "Timer object to periodically shrink channel buffers.")
-
-(defconst riece-shrink-buffer-description
- "Free old IRC messages to save memory usage.")
-
-(defun riece-shrink-buffer-idle-timer ()
- (let ((buffers riece-buffer-list))
- (while buffers
- (if (and (get 'riece-shrink-buffer 'riece-addon-enabled)
- (buffer-live-p (car buffers))
- (eq (derived-mode-class
- (with-current-buffer (car buffers)
- major-mode))
- 'riece-dialogue-mode))
- (riece-shrink-buffer (car buffers)))
- (setq buffers (cdr buffers)))))
-
-(defun riece-shrink-buffer (buffer)
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (while (> (buffer-size) riece-max-buffer-size)
- (let* ((inhibit-read-only t)
- buffer-read-only
- (end (progn
- (goto-char riece-shrink-buffer-remove-chars)
- (beginning-of-line 2)
- (point)))
- (overlays (riece-overlays-in (point-min) end)))
- (while overlays
- (riece-delete-overlay (car overlays))
- (setq overlays (cdr overlays)))
- (delete-region (point-min) end)))))
-
-(defun riece-shrink-buffer-startup-hook ()
- (setq riece-shrink-buffer-idle-timer
- (riece-run-with-idle-timer
- riece-shrink-buffer-idle-time-delay t
- 'riece-shrink-buffer-idle-timer)))
-
-(defun riece-shrink-buffer-exit-hook ()
- (if riece-shrink-buffer-idle-timer
- (riece-cancel-timer riece-shrink-buffer-idle-timer)))
-
-(defun riece-shrink-buffer-insinuate ()
- (add-hook 'riece-startup-hook
- 'riece-shrink-buffer-startup-hook)
- ;; Reset the timer since riece-shrink-buffer-insinuate will be
- ;; called before running riece-startup-hook.
- (unless riece-shrink-buffer-idle-timer
- (riece-shrink-buffer-startup-hook))
- (add-hook 'riece-exit-hook
- 'riece-shrink-buffer-exit-hook))
-
-(defun riece-shrink-buffer-uninstall ()
- (riece-shrink-buffer-exit-hook)
- (remove-hook 'riece-startup-hook
- 'riece-shrink-buffer-startup-hook)
- (remove-hook 'riece-exit-hook
- 'riece-shrink-buffer-exit-hook))
-
-(provide 'riece-shrink-buffer)
-
-;;; riece-shrink-buffer.el ends here
+++ /dev/null
-;;; riece-signal.el --- "signal-slot" abstraction for routing display events
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;;; This module implements Qt like "signal-slot" abstraction for
-;;; routing display events.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-debug)
-
-(defvar riece-signal-slot-obarray
- (make-vector 31 0))
-
-(defun riece-make-slot (function &optional filter handback)
- "Make an instance of slot object.
-Arguments are corresponding to callback function, filter function, and
-a handback object, respectively.
-This function is for internal use only."
- (vector function filter handback))
-
-(defun riece-slot-function (slot)
- "Return the callback function of SLOT.
-This function is for internal use only."
- (aref slot 0))
-
-(defun riece-slot-filter (slot)
- "Return the filter function of SLOT.
-This function is for internal use only."
- (aref slot 1))
-
-(defun riece-slot-handback (slot)
- "Return the handback object of SLOT.
-This function is for internal use only."
- (aref slot 2))
-
-(defun riece-make-signal (name args)
- "Make an instance of signal object.
-The 1st arguments is the name of the signal and the rest of arguments
-are the data of the signal.
-This function is for internal use only."
- (vector name args))
-
-(defun riece-signal-name (signal)
- "Return the name of SIGNAL."
- (aref signal 0))
-
-(defun riece-signal-args (signal)
- "Return the data of SIGNAL."
- (aref signal 1))
-
-(defun riece-connect-signal (signal-name function &optional filter handback)
- "Add FUNCTION as a listener of a signal identified by SIGNAL-NAME."
- (let ((symbol (intern (symbol-name signal-name) riece-signal-slot-obarray)))
- (set symbol (cons (riece-make-slot function filter handback)
- (if (boundp symbol)
- (symbol-value symbol))))))
-
-(defun riece-disconnect-signal (signal-name function)
- "Remove FUNCTION from the listener of the signal identified by SIGNAL-NAME."
- (let* ((symbol (intern-soft (symbol-name signal-name)
- riece-signal-slot-obarray))
- (slots (symbol-value symbol)))
- (while slots
- (if (eq (riece-slot-function (car slots))
- function)
- (set symbol (delq (car slots) (symbol-value symbol))))
- (setq slots (cdr slots)))))
-
-(defun riece-clear-signal-slots ()
- "Remove all functions from listeners list."
- (fillarray riece-signal-slot-obarray 0))
-
-(defun riece-emit-signal (signal-name &rest args)
- "Emit SIGNAL."
- (let ((symbol (intern-soft (symbol-name signal-name)
- riece-signal-slot-obarray))
- signal
- slots)
- (when symbol
- (setq signal (riece-make-signal signal-name args)
- slots (symbol-value symbol))
- (while slots
- (if (or (null (riece-slot-filter (car slots)))
- (riece-funcall-ignore-errors (format "signal filter for \"%S\""
- signal-name)
- (riece-slot-filter (car slots))
- signal))
- (riece-funcall-ignore-errors (format "slot function for \"%S\""
- signal-name)
- (riece-slot-function (car slots))
- signal
- (riece-slot-handback (car slots))))
- (setq slots (cdr slots))))))
-
-(provide 'riece-signal)
-
-;;; riece-signal.el ends here
+++ /dev/null
-;;; riece-skk-kakutei.el --- remove SKK's preedit mark before sending messages
-;; Copyright (C) 2003 TAKAHASHI Kaoru
-
-;; Author: TAKAHASHI "beatmaria" Kaoru <kaoru@kaisei.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(eval-when-compile (require 'riece))
-
-(defvar skk-mode)
-(defvar skk-henkan-mode)
-(defvar skk-henkan-on)
-(defvar skk-egg-like-newline)
-(autoload 'skk-kakutei "skk")
-
-(defconst riece-skk-kakutei-description
- "Remove SKK's preedit mark before sending messages.")
-
-(defun riece-skk-kakutei-command-enter-message ()
- "Send the current line to the current channel."
- (interactive)
- (when (riece-skk-kakutei)
- (riece-command-enter-message)))
-
-(defun riece-skk-kakutei-command-enter-message-as-notice ()
- "Send the current line to the current channel as NOTICE."
- (interactive)
- (when (riece-skk-kakutei)
- (riece-command-enter-message-as-notice)))
-
-(defun riece-skk-kakutei ()
- "When required after-follow return `t'."
- (interactive)
- (cond ((or (not (boundp 'skk-mode)) (not skk-mode))
- t)
- ((and (boundp 'skk-henkan-mode) (not skk-henkan-mode))
- t)
- ((and (boundp 'skk-henkan-on) (not skk-henkan-on))
- t)
- (skk-egg-like-newline
- (skk-kakutei)
- nil)
- (t
- (skk-kakutei)
- t)))
-
-(defun riece-skk-kakutei-insinuate ()
- )
-
-(defun riece-skk-kakutei-enable ()
- (riece-define-keys riece-command-mode-map
- "\r" riece-skk-kakutei-command-enter-message
- [(control return)] riece-skk-kakutei-command-enter-message-as-notice))
-
-(defun riece-skk-kakutei-disable ()
- (riece-define-keys riece-command-mode-map
- "\r" riece-command-enter-message
- [(control return)] riece-command-enter-message-as-notice))
-
-(provide 'riece-skk-kakutei)
-
-;;; riece-skk-kakutei.el ends here
+++ /dev/null
-/* XPM */
-static char *bug-buddy[] = {
-/* columns rows colors chars-per-pixel */
-"32 32 139 2",
-" c #1C1D1B",
-". c #1E201C",
-"X c #20221E",
-"o c #262E1F",
-"O c #323A12",
-"+ c #242522",
-"@ c #272824",
-"# c #2A2B26",
-"$ c #2C2D29",
-"% c #2D3129",
-"& c #31342B",
-"* c #35392C",
-"= c #393C2D",
-"- c #343533",
-"; c #363833",
-": c #3A3B36",
-"> c #3A3B39",
-", c #3D412E",
-"< c #3F4235",
-"1 c #3E413A",
-"2 c #414532",
-"3 c #42443E",
-"4 c #464B36",
-"5 c #484D36",
-"6 c #494E3D",
-"7 c #4C5431",
-"8 c #4C533A",
-"9 c #515A2D",
-"0 c #50573D",
-"q c #51583F",
-"w c #65591F",
-"e c #444443",
-"r c #444840",
-"t c #494C45",
-"y c #4B4C4A",
-"u c #4C5344",
-"i c #505247",
-"p c #50544C",
-"a c #545B41",
-"s c #54584F",
-"d c #585B4E",
-"f c gray33",
-"g c #565951",
-"h c #595C54",
-"j c #5C5C5C",
-"k c #5A6246",
-"l c #5C6B4F",
-"z c #5C6256",
-"x c #606547",
-"c c #61664B",
-"v c #636B4B",
-"b c #616656",
-"n c #62655A",
-"m c #656854",
-"M c #68714D",
-"N c #6B7251",
-"B c #70735C",
-"V c #727955",
-"C c #777E59",
-"Z c #787D57",
-"A c #787D59",
-"S c #646464",
-"D c #6B6E62",
-"F c #6C6C6C",
-"G c #717468",
-"H c #747473",
-"J c #777877",
-"K c #787A73",
-"L c #7B7B7B",
-"P c #7B825B",
-"I c #80865E",
-"U c #918656",
-"Y c #9C954F",
-"T c #949658",
-"R c #858B63",
-"E c #808B68",
-"W c #888F65",
-"Q c #80817E",
-"! c #8E946B",
-"~ c #869675",
-"^ c #91986D",
-"/ c #969C72",
-"( c #989F75",
-") c #9A9F7A",
-"_ c #9CA37A",
-"` c #A0A67D",
-"' c #A5AA7F",
-"] c #838383",
-"[ c #878986",
-"{ c #8B8C84",
-"} c #8C8C8C",
-"| c #9A9F89",
-" . c #919191",
-".. c gray62",
-"X. c #A2A588",
-"o. c #A4AB84",
-"O. c #A1A495",
-"+. c #A1A29F",
-"@. c #A8AC91",
-"#. c #ACB18B",
-"$. c #B0B690",
-"%. c #B5B996",
-"&. c #B5B99B",
-"*. c #B8BC9C",
-"=. c #A3A3A3",
-"-. c #ACACAC",
-";. c #B4B7A3",
-":. c #B4B6A8",
-">. c #BDBFA5",
-",. c #BBBEAC",
-"<. c #B3B3B3",
-"1. c #BABBB7",
-"2. c #BABBBA",
-"3. c #BFC1A8",
-"4. c #C2C4AC",
-"5. c #C5CBAD",
-"6. c #CAC6AF",
-"7. c #C3C7B1",
-"8. c #C5CAB2",
-"9. c #C8CCB5",
-"0. c #CED1BC",
-"q. c #D1D3BE",
-"w. c #C3C3C3",
-"e. c #CDCDC4",
-"r. c #CCCCCC",
-"t. c #D2D5C3",
-"y. c #D6D8C4",
-"u. c #D9D6C4",
-"i. c #D9DBC9",
-"p. c #D1D1D1",
-"a. c #D9D9D7",
-"s. c #DCDCDC",
-"d. c #E2E2DF",
-"f. c #E8E5DA",
-"g. c #E3E3E3",
-"h. c #ECECEB",
-"j. c #F3F3F3",
-"k. c #FEFEFE",
-"l. c None",
-/* pixels */
-"l.l.l.l.l.l.l.l.l.l.l.k.k.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.l.k.r.h.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.k.p.] g.k.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.j.} } g.k.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.h.J =.g.f.u.8.g.k.k.k.k.l.l.l.k.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.g.j } 2.U Y w J a.e.h.j.k.l.l.h.k.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.p.e H { c B B u 7 T A r.h.k.r.1.k.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.r.: K | #.5.8.~ l 9 O L g.h.<.=.k.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.g.D ;.4.3.%.#.X.P a o H w.g.=.[ j.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.k.d.7.9.9.8.3.X._ / C k [ -.-.Q 2.s.k.l.l.l.l.l.",
-"l.l.l.l.l.l.k.l.h.q.0.y.y.0.;.h o._ R A G F - J ..r.k.l.l.l.l.l.",
-"l.l.l.l.j.p...2.t.9.0.i.i.y.K r #._ W A k + > F -.h.l.l.l.l.l.l.",
-"l.l.l.j.=.y 3 n *.4.q.y.i.O.1 s $._ R C x > f ] s.k.l.l.l.l.l.l.",
-"l.l.j.-.H ] =.@.*.4.7.0.,.g t z #._ I V x t S =.h.k.l.l.l.l.l.l.",
-"l.l.w.H ..1.:._ #.%.4.4.D > g n ' ! P M k i H 1.h.k.l.l.l.l.l.l.",
-"l.l.r.F -.g.X.! _ #.%.X.& t h m / R C M a f Q 1.g.k.l.l.l.l.l.l.",
-"l.l.2.J 1.1.P I ! ( ) 8 1 h p m R A M k 8 h [ <.h.j.l.l.l.l.l.l.",
-"l.k.a.<.2.G M V P W N @ t z u c Z N k 8 4 e ] <.g.j.l.l.l.l.l.l.",
-"l.k.j.h.K 2 a v N V % - h g 3 k v k q 5 3 $ > .g.k.l.l.l.l.l.l.",
-"l.k.j.w.y 6 8 q k 8 + 1 h p < q a 8 4 2 1 e - f s.j.l.l.l.l.l.l.",
-"l.j.s.] ] s 2 5 8 $ # y p 3 * 8 4 4 , = r j j e r.k.l.l.l.l.l.l.",
-"l.k.=.H =.n = , * . ; p t 1 % 2 , = & * y F L e -.g.k.l.l.l.l.l.",
-"l.k. .j 1.Q % * X > t > $ # * & % % # j Q S S 1.g.l.l.l.l.l.l.",
-"l.l. .L r.1.; % X . ; 3 - + # & % % @ . j . .-.s.k.l.l.l.l.l.l.",
-"l.k.=.w.h.s.H 3 e $ $ + $ $ $ $ $ @ S -.s.h.k.l.l.l.l.l.l.l.",
-"l.k.g.j.k.h.w.] L y $ $ + $ $ $ $ e e > F 2.j.k.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.j.g.p.-.} H j f - & > j L S S L r.k.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.k.k.h.p.1...} F j S H } .S L .r.k.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.k.j.j.s.r.<.<.-.<.<.F S ..1.g.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.k.j.j.h.g.s.s.s.<.H w.a.h.k.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.l.l.k.k.k.k.j.a.p.k.k.l.l.l.l.l.l.l.l.l.l.l.l.",
-"l.l.l.l.l.l.l.l.l.l.l.l.l.l.k.k.j.k.l.l.l.l.l.l.l.l.l.l.l.l.l.l."
-};
+++ /dev/null
-;;; riece-toolbar.el --- display toolbar icons
-;; Copyright (C) 1998-2004 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-menu)
-
-(defconst riece-toolbar-description
- "Display toolbar icons.")
-
-(defvar riece-toolbar-items
- '(riece-command-quit
- riece-command-join
- riece-command-part
- riece-command-previous-channel
- riece-command-next-channel
- riece-command-change-layout
- riece-submit-bug-report))
-
-(defun riece-toolbar-find-menu-item (command)
- (let ((pointer riece-menu-items)
- item)
- (while pointer
- (if (and (not (stringp (car pointer)))
- (vectorp (car pointer))
- (eq (aref (car pointer) 1) command))
- (setq item (car pointer)
- pointer nil)
- (setq pointer (cdr pointer))))
- item))
-
-(if (featurep 'xemacs)
- (if (featurep 'toolbar)
- (progn
- (defun riece-make-toolbar-from-menu (items menu-items map)
- (let ((pointer items)
- toolbar
- file
- menu-item)
- (while pointer
- (setq file (locate-file (symbol-name (car pointer))
- (cons riece-data-directory load-path)
- '(".xpm" ".pbm" ".xbm"))
- menu-item (riece-toolbar-find-menu-item (car pointer)))
- (if (and file (file-exists-p file))
- (setq toolbar
- (toolbar-add-item
- toolbar
- (toolbar-new-button
- file
- (car pointer)
- (if menu-item
- (aref menu-item 0)
- (symbol-name (car pointer)))))))
- (setq pointer (cdr pointer)))
- toolbar))
- (defvar riece-toolbar-original-toolbar nil)
- (defun riece-set-toolbar (toolbar)
- (make-local-variable 'riece-toolbar-original-toolbar)
- (setq riece-toolbar-original-toolbar
- (specifier-specs default-toolbar (current-buffer)))
- (set-specifier default-toolbar toolbar (current-buffer)))
- (defun riece-unset-toolbar ()
- (if riece-toolbar-original-toolbar
- (set-specifier default-toolbar riece-toolbar-original-toolbar
- (current-buffer))
- (remove-specifier default-toolbar (current-buffer)))
- (kill-local-variable 'riece-toolbar-original-toolbar)))
- (defalias 'riece-make-toolbar-from-menu 'ignore)
- (defalias 'riece-set-toolbar 'ignore)
- (defalias 'riece-unset-toolbar 'ignore))
- (defun riece-make-toolbar-from-menu (items menu-items map)
- (let ((pointer items)
- (tool-bar-map (make-sparse-keymap)))
- (while pointer
- (tool-bar-add-item-from-menu (car pointer)
- (symbol-name (car pointer))
- map)
- (setq pointer (cdr pointer)))
- tool-bar-map))
- (defun riece-set-toolbar (toolbar)
- (make-local-variable 'tool-bar-map)
- (setq tool-bar-map toolbar))
- (defun riece-unset-toolbar ()
- (kill-local-variable 'tool-bar-map)))
-
-(defvar riece-command-mode-map)
-(defun riece-toolbar-command-mode-hook ()
- (riece-set-toolbar
- (riece-make-toolbar-from-menu
- riece-toolbar-items
- riece-menu-items
- riece-command-mode-map)))
-
-(defun riece-toolbar-requires ()
- '(riece-menu))
-
-(defun riece-toolbar-insinuate ()
- (if riece-command-buffer
- (with-current-buffer riece-command-buffer
- (riece-toolbar-command-mode-hook)))
- (add-hook 'riece-command-mode-hook
- 'riece-toolbar-command-mode-hook t))
-
-(defun riece-toolbar-uninstall ()
- (if riece-command-buffer
- (with-current-buffer riece-command-buffer
- (riece-unset-toolbar)))
- (remove-hook 'riece-command-mode-hook
- 'riece-toolbar-command-mode-hook))
-
-(provide 'riece-toolbar)
-
-;;; riece-toolbar.el ends here
\ No newline at end of file
+++ /dev/null
-;;; riece-unread.el --- mark channels where new messages arrived
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;; This add-on marks channels where new messages arrived.
-
-;; You can check the unread channels via `C-c g' in the commands
-;; buffer, by adding the following lines to ~/.riece/init.el:
-
-;; (add-hook 'riece-guess-channel-try-functions
-;; 'riece-guess-channel-from-unread)
-
-;;; Code:
-
-(require 'riece-message)
-(require 'riece-commands)
-(require 'riece-signal)
-(require 'riece-highlight)
-
-(defgroup riece-unread nil
- "Mark unread channels."
- :tag "Unread"
- :prefix "riece-"
- :group 'riece)
-
-(defface riece-channel-list-unread-face
- '((((class color)
- (background dark))
- (:foreground "orange"))
- (((class color)
- (background light))
- (:foreground "firebrick"))
- (t
- (:bold t)))
- "Face used for displaying unread channels."
- :group 'riece-highlight-faces)
-(defvar riece-channel-list-unread-face 'riece-channel-list-unread-face)
-
-(unless (riece-facep 'riece-modeline-unread-face)
- (make-face 'riece-modeline-unread-face
- "Face used for displaying unread channels in modeline.")
- (if (featurep 'xemacs)
- (set-face-parent 'riece-modeline-unread-face 'modeline))
- (set-face-foreground 'riece-modeline-unread-face
- (face-foreground 'riece-channel-list-unread-face)))
-
-(defvar riece-unread-channels nil)
-
-(defconst riece-unread-description
- "Mark channels where new messages arrived.")
-
-(defun riece-unread-after-display-message-function (message)
- (if (get 'riece-unread 'riece-addon-enabled)
- (let ((target (if (riece-message-private-p message)
- (riece-message-speaker message)
- (riece-message-target message))))
- (unless (or (riece-message-own-p message)
- (riece-message-type message)
- (riece-identity-equal target riece-current-channel)
- (riece-identity-member target riece-unread-channels))
- (setq riece-unread-channels (cons target riece-unread-channels))
- (riece-emit-signal 'channel-list-changed)))))
-
-(defun riece-unread-after-switch-to-channel-function (last)
- (if (get 'riece-unread 'riece-addon-enabled)
- (setq riece-unread-channels
- (delq (car (riece-identity-member riece-current-channel
- riece-unread-channels))
- riece-unread-channels))))
-
-(defun riece-unread-format-identity-for-channel-list-buffer (index identity)
- (if (and (get 'riece-unread 'riece-addon-enabled)
- (riece-identity-member identity riece-unread-channels))
- (concat (format "%2d:!" index)
- (riece-format-identity identity))))
-
-(defun riece-unread-format-identity-for-channel-list-indicator (index identity)
- (if (and (get 'riece-unread 'riece-addon-enabled)
- (riece-identity-member identity riece-unread-channels))
- (let ((string (riece-format-identity identity))
- (start 0))
- ;; Escape % -> %%.
- (while (string-match "%" string start)
- (setq start (1+ (match-end 0))
- string (replace-match "%%" nil nil string)))
- (list (format "%d:" index)
- (riece-propertize-modeline-string
- string 'face 'riece-modeline-unread-face)))))
-
-(defun riece-unread-switch-to-channel ()
- (interactive)
- (if riece-unread-channels
- (let ((channel (car riece-unread-channels)))
- (if (riece-identity-member channel riece-current-channels)
- (riece-command-switch-to-channel channel)
- (setq riece-unread-channels
- (delete channel riece-unread-channels))
- (riece-unread-switch-to-channel)))
- (error "No unread channel!")))
-
-(defun riece-guess-channel-from-unread ()
- (reverse riece-unread-channels))
-
-(defun riece-unread-requires ()
- (let (requires)
- (if (memq 'riece-highlight riece-addons)
- (setq requires (cons 'riece-highlight requires)))
- ;; To override riece-history's channel mark in the channel list buffer.
- (if (memq 'riece-history riece-addons)
- (setq requires (cons 'riece-history requires)))
-;;; (if (memq 'riece-guess riece-addons)
-;;; (setq requires (cons 'riece-guess requires)))
- requires))
-
-(defun riece-unread-insinuate ()
- (add-hook 'riece-after-display-message-functions
- 'riece-unread-after-display-message-function)
- (add-hook 'riece-after-switch-to-channel-functions
- 'riece-unread-after-switch-to-channel-function)
- (add-hook 'riece-format-identity-for-channel-list-buffer-functions
- 'riece-unread-format-identity-for-channel-list-buffer)
- (add-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-unread-format-identity-for-channel-list-indicator)
- (if (memq 'riece-highlight riece-addons)
- (setq riece-channel-list-mark-face-alist
- (cons '(?! . riece-channel-list-unread-face)
- riece-channel-list-mark-face-alist)))
-;;; (if (memq 'riece-guess riece-addons)
-;;; (add-hook 'riece-guess-channel-try-functions
-;;; 'riece-guess-channel-from-unread))
- )
-
-(defun riece-unread-uninstall ()
- (remove-hook 'riece-after-display-message-functions
- 'riece-unread-after-display-message-function)
- (remove-hook 'riece-after-switch-to-channel-functions
- 'riece-unread-after-switch-to-channel-function)
- (remove-hook 'riece-format-identity-for-channel-list-buffer-functions
- 'riece-unread-format-identity-for-channel-list-buffer)
- (remove-hook 'riece-format-identity-for-channel-list-indicator-functions
- 'riece-unread-format-identity-for-channel-list-indicator)
- (setq riece-channel-list-mark-face-alist
- (delq (assq ?! riece-channel-list-mark-face-alist)
- riece-channel-list-mark-face-alist))
-;;; (if (memq 'riece-guess riece-addons)
-;;; (add-hook 'riece-guess-channel-try-functions
-;;; 'riece-guess-channel-from-unread))
- )
-
-(defvar riece-command-mode-map)
-(defvar riece-dialogue-mode-map)
-(defvar riece-channel-list-mode-map)
-(defun riece-unread-enable ()
- (define-key riece-command-mode-map
- "\C-c\C-u" 'riece-unread-switch-to-channel)
- (define-key riece-dialogue-mode-map
- "u" 'riece-unread-switch-to-channel)
- (define-key riece-channel-list-mode-map
- "u" 'riece-unread-switch-to-channel)
- (riece-emit-signal 'channel-list-changed))
-
-(defun riece-unread-disable ()
- (define-key riece-command-mode-map
- "\C-c\C-u" nil)
- (define-key riece-dialogue-mode-map
- "u" nil)
- (define-key riece-channel-list-mode-map
- "u" nil)
- (setq riece-unread-channels nil)
- (riece-emit-signal 'channel-list-changed))
-
-(provide 'riece-unread)
-
-;;; riece-unread.el ends here
+++ /dev/null
-;;; riece-url.el --- collect URL in IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-options)
-(require 'riece-menu) ;riece-menu-items
-
-(autoload 'browse-url "browse-url")
-(defvar browse-url-browser-function)
-
-(defgroup riece-url nil
- "URL Browsing in IRC buffer."
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-url-regexp "\\b\\(s?https?\\|ftp\\|file\\|gopher\\|news\\|telnet\\|wais\\|mailto\\):\\(//[-a-zA-Z0-9_.]+:[0-9]*\\)?[-a-zA-Z0-9_=?#$@~`%&*+|\\/.,;]*[-a-zA-Z0-9_=#$@~`%&*+|\\/;]"
- "Regular expression that matches URLs."
- :group 'riece-url
- :type 'regexp)
-
-(defcustom riece-url-regexp-alist nil
- "An alist mapping regexp to URL.
-For example:
- (setq riece-url-regexp-alist
- '((\"\\\\bBug#\\\\([0-9]+\\\\)\\\\b\" .
- \"http://bugs.debian.org/\\\\1\")))
-
-This maps a string \"Bug#12345\" to a URL
-\"http://bugs.debian.org/12345\"."
- :type 'alist
- :group 'riece-url)
-
-(defvar riece-urls nil
- "A list of URL which appears in Riece buffers.")
-
-(defconst riece-url-description
- "Collect URL in IRC buffers.")
-
-(autoload 'widget-convert-button "wid-edit")
-
-(defun riece-url-replace-match (string)
- (let ((match-data (match-data))
- (index 0)
- number
- replacement)
- (while (string-match "\\\\[&1-9\\\\]" string index)
- (if (eq (aref string (1+ (match-beginning 0))) ?&)
- (setq number 0)
- (unless (eq (aref string (1+ (match-beginning 0))) ?\\)
- (setq number (string-to-number (substring (match-string 0 string)
- 1)))))
- (if number
- (setq replacement
- (buffer-substring (nth (* number 2) match-data)
- (nth (1+ (* number 2)) match-data)))
- (setq replacement "\\"))
- (setq string (concat (substring string 0 (match-beginning 0))
- replacement
- (substring string (match-end 0)))
- index (+ index (length replacement))))
- string))
-
-(defun riece-url-scan-region (start end)
- (let ((alist (cons (cons riece-url-regexp "\\&")
- riece-url-regexp-alist)))
- (while alist
- (save-excursion
- (goto-char start)
- (while (re-search-forward (car (car alist)) end t)
- (let ((url (save-match-data
- (riece-url-replace-match (cdr (car alist))))))
- (if (memq 'riece-highlight riece-addons)
- (widget-convert-button
- 'url-link (match-beginning 0) (match-end 0) url))
- (unless (member url riece-urls)
- (setq riece-urls (cons url riece-urls))))))
- (setq alist (cdr alist)))))
-
-(defun riece-command-browse-url (&optional url)
- (interactive
- (list (completing-read "Open URL: " (mapcar #'list riece-urls))))
- (browse-url url))
-
-(defun riece-url-create-menu (menu)
- (mapcar (lambda (url)
- (vector url (list 'browse-url url)))
- riece-urls))
-
-(defvar riece-dialogue-mode-map)
-
-(defun riece-url-requires ()
- (append (if (memq 'riece-highlight riece-addons)
- '(riece-highlight))
- (if (memq 'riece-menu riece-addons)
- '(riece-menu))))
-
-(defun riece-url-command-mode-hook ()
- (easy-menu-add-item
- nil (list (car riece-menu-items))
- '("Open URL..." :filter riece-url-create-menu)))
-
-(defun riece-url-insinuate ()
- (add-hook 'riece-after-insert-functions 'riece-url-scan-region)
- (if (memq 'riece-menu riece-addons)
- (add-hook 'riece-command-mode-hook
- 'riece-url-command-mode-hook
- t)))
-
-(defun riece-url-uninstall ()
- (easy-menu-remove-item
- nil (list (car riece-menu-items))
- "Open URL...")
- (remove-hook 'riece-after-insert-functions 'riece-url-scan-region)
- (remove-hook 'riece-command-mode-hook
- 'riece-url-command-mode-hook))
-
-(defun riece-url-enable ()
- (define-key riece-dialogue-mode-map "U" 'riece-command-browse-url))
-
-(defun riece-url-disable ()
- (define-key riece-dialogue-mode-map "U" nil))
-
-(provide 'riece-url)
-
-;;; riece-url.el ends here
+++ /dev/null
-;;; riece-user.el --- a user object
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-mode)
-(require 'riece-cache)
-
-;;; User object:
-(defun riece-find-user (name)
- "Get a user object named NAME from the server buffer."
- (riece-cache-get riece-user-cache name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)
- riece-user-obarray)))
- (if symbol
- (symbol-value symbol))))
-
-(defun riece-forget-user (name)
- (riece-cache-delete riece-user-cache name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name))))
- (when symbol
- (makunbound symbol)
- (unintern (symbol-name symbol) riece-user-obarray))))
-
-(defun riece-rename-user (old-name new-name)
- (riece-cache-delete riece-user-cache old-name)
- (riece-cache-set riece-user-cache new-name new-name)
- (unless (equal (riece-identity-canonicalize-prefix old-name)
- (riece-identity-canonicalize-prefix new-name))
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix old-name)
- riece-user-obarray)))
- (when symbol
- (set (intern (riece-identity-canonicalize-prefix new-name)
- riece-user-obarray)
- (symbol-value symbol))
- (makunbound symbol)
- (unintern (symbol-name symbol) riece-user-obarray)))))
-
-(defun riece-make-user (channels user-at-host modes away operator)
- "Make an instance of user object.
-Arguments are appropriate to joined channels, user-at-host, mode, and
-away status, respectively."
- (vector channels user-at-host modes away operator))
-
-(defun riece-get-user (name)
- (let ((symbol (intern-soft (riece-identity-canonicalize-prefix name)
- riece-user-obarray)))
- (if symbol
- (progn
- (riece-cache-get riece-user-cache name)
- (symbol-value symbol))
- (riece-cache-set riece-user-cache name name)
- (set (intern (riece-identity-canonicalize-prefix name)
- riece-user-obarray)
- (riece-make-user nil nil nil nil nil)))))
-
-(defun riece-user-channels (user)
- "Return joined channels of USER."
- (aref user 0))
-
-(defun riece-user-user-at-host (user)
- "Return the user-at-host of USER."
- (aref user 1))
-
-(defun riece-user-modes (user)
- "Return the modes of USER."
- (aref user 2))
-
-(defun riece-user-away (user)
- "Return t, if USER has been marked as away."
- (aref user 3))
-
-(defun riece-user-operator (user)
- "Return t, if USER has operator privilege."
- (aref user 4))
-
-(defun riece-user-set-channels (user value)
- "Set the joined channels of USER to VALUE."
- (aset user 0 value))
-
-(defun riece-user-set-user-at-host (user value)
- "Set the user-at-host of USER to VALUE."
- (aset user 1 value))
-
-(defun riece-user-set-modes (user value)
- "Set the modes of USER to VALUE."
- (aset user 2 value))
-
-(defun riece-user-set-away (user value)
- "Set the away status of USER to VALUE."
- (aset user 3 value))
-
-(defun riece-user-set-operator (user value)
- "Set the operator status of USER to VALUE."
- (aset user 4 value))
-
-(defun riece-user-get-channels (name)
- (riece-user-channels (riece-get-user name)))
-
-(defun riece-user-get-user-at-host (name)
- (riece-user-user-at-host (riece-get-user name)))
-
-(defun riece-user-get-modes (name)
- (riece-user-modes (riece-get-user name)))
-
-(defun riece-user-get-away (name)
- (riece-user-away (riece-get-user name)))
-
-(defun riece-user-get-operator (name)
- (riece-user-operator (riece-get-user name)))
-
-(defun riece-user-toggle-channel (name channel flag)
- "Add or remove the joined channel of user."
- (let* ((user (riece-get-user name))
- (channels (riece-user-channels user)))
- (if flag
- (unless (member channel channels)
- (riece-user-set-channels user (cons channel channels)))
- (if (setq channel (car (member channel channels)))
- (riece-user-set-channels user (delq channel channels))))))
-
-(defun riece-user-toggle-mode (name mode flag)
- "Add or remove user MODE of user."
- (let* ((user (riece-get-user name))
- (modes (riece-user-modes user))
- (old (riece-mode-assoc (riece-mode-flag mode) modes)))
- (if flag
- (unless old
- (riece-user-set-modes user (cons mode modes)))
- (if old
- (riece-user-set-modes user (delq mode modes))))))
-
-(defun riece-user-toggle-away (name flag)
- (riece-user-set-away (riece-get-user name) flag))
-
-(defun riece-user-toggle-operator (name flag)
- (riece-user-set-operator (riece-get-user name) flag))
-
-(provide 'riece-user)
-
-;;; riece-user.el ends here
+++ /dev/null
-;;; riece-version.el --- version information handling
-;; Copyright (C) 1995, 1996, 1997, 1998, 1999, 2000, 2001, 2002, 2003
-;; Free Software Foundation, Inc.
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-package-info)
-
-;; NOTE: Most part of this file is copied from Gnus.
-
-(defcustom riece-user-agent 'emacs-riece-type
- "Which information should be exposed in the User-Agent header.
-
-It can be one of the symbols `riece' \(show only Riece version\), `emacs-riece'
-\(show only Emacs and Riece versions\), `emacs-riece-config' \(same as
-`emacs-riece' plus system configuration\), `emacs-riece-type' \(same as
-`emacs-riece' plus system type\) or a custom string. If you set it to a
-string, be sure to use a valid format, see RFC 2616."
- :group 'riece-options
- :type '(choice
- (item :tag "Show Riece and Emacs versions and system type"
- emacs-riece-type)
- (item :tag "Show Riece and Emacs versions and system configuration"
- emacs-riece-config)
- (item :tag "Show Riece and Emacs versions" emacs-riece)
- (item :tag "Show only Riece version" riece)
- (string :tag "Other")))
-
-(defconst riece-version (format "%s v%s" riece-package-name
- riece-version-number)
- "Version string for this version of Riece.")
-
-(eval-when-compile
- (defvar emacs-program-version)
- (defvar xemacs-codename)
- (defvar sxemacs-codename))
-
-(defun riece-extended-version ()
- "Stringified Riece version and Emacs version.
-See the variable `riece-user-agent'."
- (let* ((riece-v
- (concat riece-package-name "/"
- (prin1-to-string riece-version-number t)))
- (system-v
- (cond
- ((eq riece-user-agent 'emacs-riece-config)
- system-configuration)
- ((eq riece-user-agent 'emacs-riece-type)
- (symbol-name system-type))
- (t nil)))
- (emacs-v
- (cond
- ((eq riece-user-agent 'riece)
- nil)
- ((string-match "^\\(\\([.0-9]+\\)*\\)\\.[0-9]+$" emacs-version)
- (concat "Emacs/" (match-string 1 emacs-version)
- (if system-v
- (concat " (" system-v ")")
- "")))
- ((featurep 'sxemacs)
- (concat "SXEmacs/" emacs-program-version
- (when system-v
- (concat " ("
- (when sxemacs-codename
- (concat sxemacs-codename ", "))
- system-v ")"))))
- ((featurep 'xemacs)
- (concat "XEmacs/" emacs-program-version
- (when system-v
- (concat " ("
- (when xemacs-codename
- (concat xemacs-codename ", "))
- system-v ")"))))
- (t emacs-version))))
- (if (stringp riece-user-agent)
- riece-user-agent
- (concat riece-v
- (when emacs-v
- (concat " " emacs-v))))))
-
-(defun riece-version (&optional arg)
- "Version number of this version of Riece.
-If ARG, use user-agent format."
- (interactive "P")
- (if arg
- (message "%s" (riece-extended-version))
- (message "%s" riece-version)))
-
-(provide 'riece-version)
-
-;;; riece-version.el ends here
+++ /dev/null
-;;; riece-xemacs.el --- XEmacs specific functions
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: emulation
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(defun riece-xemacs-hide-modeline ()
- "Remove modeline from current window."
- (set-specifier has-modeline-p nil (current-buffer)))
-
-(when (featurep 'scrollbar)
- (defun riece-xemacs-hide-scrollbars ()
- (if (boundp 'horizontal-scrollbar-visible-p)
- (set-specifier horizontal-scrollbar-visible-p nil (current-buffer))
- (if (boundp 'scrollbar-height)
- (set-specifier scrollbar-height 0 (current-buffer)))))
- (add-hook 'riece-user-list-mode-hook 'riece-xemacs-hide-scrollbars)
- (add-hook 'riece-channel-list-mode-hook 'riece-xemacs-hide-scrollbars))
-
-(add-hook 'riece-user-list-mode-hook 'riece-xemacs-hide-modeline)
-(add-hook 'riece-channel-list-mode-hook 'riece-xemacs-hide-modeline)
-
-(defun riece-xemacs-simplify-modeline-format ()
- "Remove unnecessary information from `modeline-format'."
- (setq modeline-format
- (remrassq 'modeline-modified
- (delq 'modeline-multibyte-status
- (copy-sequence mode-line-format)))))
-
-(defalias 'riece-simplify-mode-line-format
- 'riece-xemacs-simplify-modeline-format)
-
-;;; stolen (and renamed) from gnus-xmas.el.
-;;; In GNU Emacs, user can intercept whole mouse tracking events by
-;;; assigning [mouse-X]. In XEmacs, however, which causes different
-;;; effect, that is, the command assigned to [mouse-X] only catches
-;;; button-release events.
-(defvar riece-mouse-2 [button2])
-
-;;; popup-menu compatibility stuff, stolen (and renamed) from
-;;; semi-def.el.
-(defun riece-popup-menu-popup (menu event)
- (let ((response (get-popup-menu-response menu event)))
- (if response
- (funcall (event-function response) (event-object response)))))
-
-(defalias 'riece-event-buffer 'event-buffer)
-(defalias 'riece-event-point 'event-point)
-
-;;; stolen (and renamed) from gnus-xmas.el.
-(defalias 'riece-region-active-p 'region-active-p)
-
-(defalias 'riece-make-overlay 'make-extent)
-(defalias 'riece-overlay-put 'set-extent-property)
-(defalias 'riece-overlay-start 'extent-start-position)
-(defalias 'riece-overlay-buffer 'extent-buffer)
-
-(defun riece-overlays-in (start end)
- (extent-list (current-buffer) start end))
-
-(defalias 'riece-delete-overlay 'delete-extent)
-
-(defun riece-kill-all-overlays ()
- "Delete all extents in the current buffer."
- (map-extents (lambda (extent ignore)
- (delete-extent extent)
- nil)))
-
-;;; stolen (and renamed) from nnheaderxm.el.
-(defun riece-xemacs-generate-timer-name (&optional prefix)
- (let ((counter '(0)))
- (format "%s-%d"
- (or prefix
- "riece-xemacs-timer")
- (prog1 (car counter)
- (setcar counter (1+ (car counter)))))))
-
-(defun riece-run-at-time (time repeat function &rest args)
- (let ((name (riece-xemacs-generate-timer-name "riece-run-at-time")))
- (start-itimer
- name
- `(lambda ()
- (,function ,@args))
- time repeat)
- name))
-
-(defun riece-run-with-idle-timer (time repeat function &rest args)
- (let ((name (riece-xemacs-generate-timer-name "riece-run-with-idle-timer")))
- (start-itimer
- name
- `(lambda ()
- (,function ,@args))
- time (if repeat 1) t)
- name))
-
-(defalias 'riece-cancel-timer 'delete-itimer)
-
-(defun riece-match-string-no-properties (number &optional string)
- (format "%s" (match-string number string)))
-
-(defun riece-propertize-modeline-string (string &rest properties)
- (let ((extent (make-extent nil nil)))
- (set-extent-properties extent properties)
- (cons extent string)))
-
-(defalias 'riece-normalize-modeline-string 'identity)
-
-(defalias 'riece-facep 'find-face)
-
-(defun riece-put-text-property-nonsticky (start end prop value
- &optional object)
- (add-text-properties start end (list prop value 'start-open t 'end-open t)
- object))
-
-(defun riece-recent-messages (n)
- "Return N most recent messages, most recent first.
-If N is nil, all messages will be returned."
- (with-output-to-string
- (print-recent-messages n)))
-
-(defalias 'riece-remprop 'remprop)
-
-(provide 'riece-xemacs)
-
-;;; riece-xemacs.el ends here
+++ /dev/null
-;;; riece-xface.el --- display X-Face in IRC buffers
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-globals)
-(require 'riece-display)
-(require 'riece-lsdb)
-
-(defconst riece-xface-description
- "Display X-Face in IRC buffers.")
-
-(defvar lsdb-insert-x-face-function)
-
-(defun riece-xface-update-user-list-buffer ()
- (if (get 'riece-xface 'riece-addon-enabled)
- (riece-scan-property-region
- 'riece-identity (point-min)(point-max)
- (lambda (start end)
- (let ((records (riece-lsdb-lookup-records (get-text-property
- start 'riece-identity)))
- xface)
- (while (and records
- (null xface))
- (setq xface (nth 1 (assq 'x-face (car records)))
- records (cdr records)))
- (if (and xface
- (not (eq (char-after end) ? )))
- (let ((inhibit-read-only t)
- buffer-read-only)
- (goto-char end)
- (insert " ")
- (funcall lsdb-insert-x-face-function xface))))))))
-
-(defun riece-xface-requires ()
- '(riece-lsdb))
-
-(defun riece-xface-user-list-mode-hook ()
- (add-hook 'riece-update-buffer-functions
- 'riece-xface-update-user-list-buffer t t))
-
-(defun riece-xface-insinuate ()
- (if riece-user-list-buffer
- (with-current-buffer riece-user-list-buffer
- (riece-xface-user-list-mode-hook)))
- (add-hook 'riece-user-list-mode-hook
- 'riece-xface-user-list-mode-hook))
-
-(defun riece-xface-uninstall ()
- (if riece-user-list-buffer
- (with-current-buffer riece-user-list-buffer
- (remove-hook 'riece-update-buffer-functions
- 'riece-xface-update-user-list-buffer t)))
- (remove-hook 'riece-user-list-mode-hook
- 'riece-xface-user-list-mode-hook))
-
-(defun riece-xface-enable ()
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel)))
-
-(defun riece-xface-disable ()
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel)))
-
-(provide 'riece-xface)
-
-;;; riece-xface.el ends here
+++ /dev/null
-;;; riece-xfaceb.el --- display X-Face/Colour Face in IRC buffers
-;; Copyright (C) 2005 Daiki Ueno
-
-;; Author: Steve Youngs <steve@sxemacs.org>
-;; Created: 2005-09-03
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece. It is adapted from
-;; `riece-xface' but gets the image data from BBDB instead of LSDB.
-
-;; This add-on displays either X-Face or colour Face images in the
-;; Riece "Users" buffers. The image data comes from entries in a BBDB
-;; db. Consequently it does require a little setting up in BBDB...
-
-;; BBDB Setup:
-
-;; You need a new field called "ircnick" for each IRC contact that is
-;; in your BBDB. Its value is the IRC nickname of the contact (what
-;; is listed in the Riece "Users" buffer).
-
-;; M-x bbdb-insert-new-field RET ircnick RET
-;; answer `yes' to the prompt about the field not being defined
-;; then give it a value which will be that record's IRC nickname
-
-;; Then you'll need to collect X-Face: and Face: headers from your mail.
-;; To do that see: <http://www.emacswiki.org/cgi-bin/wiki/BbdbFaces>
-
-;;; Code:
-
-(require 'riece-identity)
-(require 'riece-globals)
-(require 'riece-display)
-
-(autoload 'bbdb-records "bbdb")
-(autoload 'bbdb-record-getprop "bbdb")
-
-(defconst riece-xfaceb-description
- "Display X-Face & Colour Face images in IRC buffers \(BBDB\).")
-
-(defcustom riece-xfaceb-prefer-cface-to-xface (featurep 'png)
- "*When non-nil, display colour face images instead of X-Face."
- :type 'boolean
- :group 'riece-looks)
-
-(defun riece-xfaceb-face-to-png (face)
- "Base64 decode a Face header into a PNG.
-Returns a string."
- (with-temp-buffer
- (insert face)
- (base64-decode-region (point-min) (point-max))
- (buffer-string)))
-
-(defun riece-xfaceb-update-user-list-buffer ()
- "Add X-Face or Colour Face images to channel users' buffer."
- (when (get 'riece-xfaceb 'riece-addon-enabled)
- (let ((users (ignore-errors
- (riece-with-server-buffer
- (riece-identity-server riece-current-channel)
- (riece-channel-get-users (riece-identity-prefix
- riece-current-channel)))))
- all-records cface xface nick name record)
- (while users
- (setq name (caar users))
- (setq all-records (bbdb-records))
- (while all-records
- (setq record (car all-records)
- nick (bbdb-record-getprop record 'ircnick)
- xface (bbdb-record-getprop record 'face)
- cface (bbdb-record-getprop record 'cface))
- (when (and (equal nick name)
- (or xface cface))
- (with-current-buffer riece-user-list-buffer
- (goto-char (point-min))
- (re-search-forward (regexp-quote name) nil t)
- (beginning-of-line)
- (when (and xface
- (or (not riece-xfaceb-prefer-cface-to-xface)
- (not cface)))
- (set-extent-begin-glyph
- (extent-at (point))
- (make-glyph (list (vector 'xface
- :data (concat "X-Face: " xface)
- :foreground "black"
- :background "white")))))
- (when (and (featurep 'png)
- riece-xfaceb-prefer-cface-to-xface
- cface)
- (set-extent-begin-glyph
- (extent-at (point))
- (make-glyph (list (vector 'png
- :data (riece-xfaceb-face-to-png cface)))))))
- ;; We have a match, get out of the inner loop
- (setq all-records nil))
- (setq all-records (cdr all-records)))
- (setq users (cdr users))))))
-
-(defun riece-xfaceb-requires ()
- )
-
-(defun riece-xfaceb-user-list-mode-hook ()
- (add-hook 'riece-update-buffer-functions
- 'riece-xfaceb-update-user-list-buffer t t))
-
-(defun riece-xfaceb-insinuate ()
- (if riece-user-list-buffer
- (with-current-buffer riece-user-list-buffer
- (riece-xfaceb-user-list-mode-hook)))
- (add-hook 'riece-user-list-mode-hook
- 'riece-xfaceb-user-list-mode-hook))
-
-(defun riece-xfaceb-uninstall ()
- (if riece-user-list-buffer
- (with-current-buffer riece-user-list-buffer
- (remove-hook 'riece-update-buffer-functions
- 'riece-xfaceb-update-user-list-buffer t)))
- (remove-hook 'riece-user-list-mode-hook
- 'riece-xfaceb-user-list-mode-hook))
-
-(defun riece-xfaceb-enable ()
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel)))
-
-(defun riece-xfaceb-disable ()
- (if riece-current-channel
- (riece-emit-signal 'user-list-changed riece-current-channel)))
-
-(provide 'riece-xfaceb)
-
-;;; riece-xfaceb.el ends here
-
+++ /dev/null
-;;; riece-yank.el --- enter the element of kill-ring
-;; Copyright (C) 2004 Masatake YAMATO
-
-;; Author: Masatake YAMATO <jet@gyve.org>
-;; Keywords: IRC, riece
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; NOTE: This is an add-on module for Riece.
-
-;;; Code:
-(require 'riece-commands)
-
-(defgroup riece-yank nil
- "Enter the element of kill-ring."
- :tag "Yank"
- :prefix "riece-"
- :group 'riece)
-
-(defcustom riece-yank-tick 1
- "Time span in second to send multiple lines."
- :type 'number
- :group 'riece-yank)
-
-(defcustom riece-yank-strip-space nil
- "If non-nil, strip common spaces in front of lines and blank lines
-before/after the first/last non-blank line."
- :type 'boolean
- :group 'riece-yank)
-
-(defconst riece-yank-description
- "Enter the element of kill-ring.")
-
-(defun riece-yank-insinuate ()
- )
-
-(defvar riece-command-mode-map)
-(defun riece-yank-enable ()
- (define-key riece-command-mode-map "\C-cy" 'riece-command-yank))
-(defun riece-yank-disable ()
- (define-key riece-command-mode-map "\C-cy" 'undefined))
-
-(defun riece-yank-strip-space (string)
- (with-temp-buffer
- (insert string)
- (untabify (point-min) (point-max))
- ;; Delete blank lines before the first non-blank line.
- (goto-char (point-min))
- (while (looking-at " *$")
- (delete-region (point) (progn (forward-line) (point))))
- ;; Delete blank lines after the last non-blank line.
- (goto-char (point-max))
- (while (progn (beginning-of-line) (looking-at " *$"))
- (delete-region (point) (progn (end-of-line 0) (point))))
- ;; Delete common spaces in front of lines.
- (let ((space-width (point-max)))
- (while (looking-at " +")
- (setq space-width (min space-width (length (match-string 0))))
- (forward-line))
- (goto-char (point-min))
- (while (not (eobp))
- (delete-char space-width)
- (forward-line)))
- (buffer-string)))
-
-(defun riece-command-yank (arg prefix)
- (interactive "P\nsPrefix: ")
- (when (or (not prefix)
- (string= prefix ""))
- (setq prefix " "))
- (let* ((kill (current-kill 0))
- msg)
- (unless kill
- (error "Nothing to send in kill-ring"))
- (if riece-yank-strip-space
- (setq kill (riece-yank-strip-space kill)))
- (setq msg (split-string kill "\n"))
- (when (y-or-n-p (format "Send \"%s\"\n? " kill))
- (mapcar
- (lambda (x)
- (riece-command-send-message (concat prefix x) arg)
- ;; Without next line, you will be kicked out from ircd.
- ;; It may mean "Don't send much data at once."
- (sit-for riece-yank-tick))
- msg))))
-
-(provide 'riece-yank)
-;;; riece-yank.el ends here
+++ /dev/null
-;;; riece.el --- IRC client for Emacsen
-;; Copyright (C) 1998-2003 Daiki Ueno
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Created: 1998-09-28
-;; Keywords: IRC, riece
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'riece-display)
-(require 'riece-server)
-(require 'riece-compat)
-(require 'riece-commands)
-(require 'riece-addon)
-(require 'riece-signal)
-
-(autoload 'derived-mode-class "derived")
-
-(defvar riece-channel-list-mode-map (make-sparse-keymap))
-(defvar riece-user-list-mode-map (make-sparse-keymap))
-
-(defvar riece-dialogue-mode-map
- (let ((keymap (make-keymap)))
- (suppress-keymap keymap 'nodigit)
- keymap))
-
-(defvar riece-command-mode-map (make-keymap))
-(defvar riece-command-map (make-sparse-keymap))
-
-(defvar riece-command-mode-syntax-table nil)
-
-(put 'riece-command-mode 'mode-class 'special)
-(put 'riece-dialogue-mode 'mode-class 'special)
-(put 'riece-others-mode 'derived-mode-parent 'riece-dialogue-mode)
-(put 'riece-channel-list-mode 'mode-class 'special)
-(put 'riece-user-list-mode 'mode-class 'special)
-(put 'riece-channel-mode 'derived-mode-parent 'riece-dialogue-mode)
-
-(defvar riece-buffer-alist
- '((riece-command-buffer "*Command*" riece-command-mode)
- (riece-dialogue-buffer "*Dialogue*" riece-dialogue-mode)
- (riece-others-buffer "*Others*" riece-others-mode)
- (riece-channel-list-buffer "*Channels*" riece-channel-list-mode)
- (riece-user-list-buffer " *Users*" riece-user-list-mode)
- (riece-temp-buffer " *Temp*")
- (riece-debug-buffer "*Debug*")))
-
-(defvar riece-select-keys
- `("#" riece-command-switch-to-channel-by-number
- "1" riece-command-switch-to-channel-by-number-1
- "2" riece-command-switch-to-channel-by-number-2
- "3" riece-command-switch-to-channel-by-number-3
- "4" riece-command-switch-to-channel-by-number-4
- "5" riece-command-switch-to-channel-by-number-5
- "6" riece-command-switch-to-channel-by-number-6
- "7" riece-command-switch-to-channel-by-number-7
- "8" riece-command-switch-to-channel-by-number-8
- "9" riece-command-switch-to-channel-by-number-9
- "0" riece-command-switch-to-channel-by-number-10
- ,(concat riece-command-prefix "1")
- riece-command-switch-to-channel-by-number-11
- ,(concat riece-command-prefix "2")
- riece-command-switch-to-channel-by-number-12
- ,(concat riece-command-prefix "3")
- riece-command-switch-to-channel-by-number-13
- ,(concat riece-command-prefix "4")
- riece-command-switch-to-channel-by-number-14
- ,(concat riece-command-prefix "5")
- riece-command-switch-to-channel-by-number-15
- ,(concat riece-command-prefix "6")
- riece-command-switch-to-channel-by-number-16
- ,(concat riece-command-prefix "7")
- riece-command-switch-to-channel-by-number-17
- ,(concat riece-command-prefix "8")
- riece-command-switch-to-channel-by-number-18
- ,(concat riece-command-prefix "9")
- riece-command-switch-to-channel-by-number-19
- ,(concat riece-command-prefix "0")
- riece-command-switch-to-channel-by-number-20))
-
-;;; Keymap macros. -- borrowed from `gnus-util.el'.
-(defmacro riece-local-set-keys (&rest plist)
- "Set the keys in PLIST in the current keymap."
- `(riece-define-keys-1 (current-local-map) ',plist))
-
-(defmacro riece-define-keys (keymap &rest plist)
- "Assign KEYMAP keys from PLIST."
- `(riece-define-keys-1 ',keymap ',plist))
-
-(defmacro riece-define-keys-safe (keymap &rest plist)
- "Assign KEYMAP keys from PLIST without overwriting previous definitions."
- `(riece-define-keys-1 ',keymap ',plist t))
-
-(put 'riece-define-keys 'lisp-indent-function 1)
-(put 'riece-define-keys-safe 'lisp-indent-function 1)
-(put 'riece-local-set-keys 'lisp-indent-function 1)
-
-(defun riece-define-keys-1 (keymap plist &optional safe)
- "Assign KEYMAP keys from PLIST.
-If optional argument SAFE is nil, overwrite previous definitions."
- (unless keymap
- (error "Can't set keys in a null keymap"))
- (cond
- ((symbolp keymap)
- (setq keymap (symbol-value keymap)))
- ((keymapp keymap))
- ((listp keymap)
- (set (car keymap) nil)
- (define-prefix-command (car keymap))
- (define-key (symbol-value (nth 2 keymap))
- (if (symbolp (nth 1 keymap))
- (symbol-value (nth 1 keymap))
- (nth 1 keymap))
- (car keymap))
- (setq keymap (symbol-value (car keymap)))))
- (let (key)
- (while plist
- (if (symbolp (setq key (car plist)))
- (setq key (symbol-value key)))
- (setq plist (cdr plist))
- (if (or (not safe)
- (eq (lookup-key keymap key) 'undefined))
- (define-key keymap key (car plist))
- (car plist))
- (setq plist (cdr plist)))))
-
-(when t
- (riece-define-keys riece-dialogue-mode-map
- "\177" scroll-down
- [delete] scroll-down
- [backspace] scroll-down
- [return] scroll-up
- " " scroll-up
- [home] beginning-of-buffer
- "$" end-of-buffer
- [end] end-of-buffer
- "/" riece-command-raw
- ">" end-of-buffer
- "<" beginning-of-buffer
- "^" riece-command-list-addons
- "\C-ta" riece-command-toggle-away
- "c" riece-command-select-command-buffer
- "f" riece-command-finger
- "\C-tf" riece-command-toggle-freeze
- "\C-to" riece-command-toggle-own-freeze
- "\C-tO" riece-command-toggle-others-buffer-mode
- "\C-tu" riece-command-toggle-user-list-buffer-mode
- "\C-tc" riece-command-toggle-channel-buffer-mode
- "\C-tC" riece-command-toggle-channel-list-buffer-mode
- "\C-tl" riece-command-change-layout
- "i" riece-command-invite
- "j" riece-command-join
- "\C-k" riece-command-kick
- "l" riece-command-list
- "M" riece-command-change-mode
- "n" riece-command-change-nickname
- "N" riece-command-names
- "o" other-window
- "O" riece-command-open-server
- "C" riece-command-close-server
- "M" riece-command-universal-server-name-argument
- "p" riece-command-enter-message-to-user
- "q" riece-command-quit
- "r" riece-command-configure-windows
- "s" riece-command-save-variables
- "x" riece-command-copy-region
- "t" riece-command-topic
- "w" riece-command-who
- "z" riece-command-suspend-resume)
-
- (riece-define-keys riece-command-mode-map
- "\r" riece-command-enter-message
- [(control return)] riece-command-enter-message-as-notice
- [tab] riece-command-complete-user)
-
- (riece-define-keys (riece-command-map riece-command-prefix
- riece-command-mode-map)
- "\177" riece-command-scroll-down
- [delete] riece-command-scroll-down
- [backspace] riece-command-scroll-down
- " " riece-command-scroll-up
- [home] riece-command-beginning-of-buffer
- "$" riece-command-end-of-buffer
- [end] riece-command-end-of-buffer
- ">" riece-command-next-channel
- "<" riece-command-previous-channel
- "\C-j" riece-command-next-channel
- "\C-n" riece-command-names
- "l" riece-command-list
- "\C-m" riece-command-change-mode
- "o" riece-command-set-operators
- "\C-p" riece-command-part
- "r" riece-command-configure-windows
- "v" riece-command-set-speakers
- "V" riece-version)
- (set-keymap-parent riece-command-map riece-dialogue-mode-map)
-
- (riece-define-keys riece-user-list-mode-map
- "o" riece-command-set-operators
- "v" riece-command-set-voices
- "f" riece-command-finger
- " " riece-command-user-list-scroll-up
- "\177" riece-command-user-list-scroll-down
- [delete] riece-command-user-list-scroll-down
- [backspace] riece-command-user-list-scroll-down
- "c" riece-command-select-command-buffer)
-
- (riece-define-keys riece-channel-list-mode-map
- ">" riece-command-next-channel
- "<" riece-command-previous-channel
- "o" other-window
- "c" riece-command-select-command-buffer)
-
- (riece-define-keys-1 riece-dialogue-mode-map riece-select-keys)
- (riece-define-keys-1 riece-channel-list-mode-map riece-select-keys))
-
-(defun riece-read-variables-files (&optional file)
- "Read variables FILEs."
- (or (file-directory-p riece-directory)
- (make-directory riece-directory))
- (let ((files (if file
- (setq riece-variables-file file
- riece-variables-files (list file))
- riece-variables-files)))
- (while files
- (condition-case nil
- (load (expand-file-name (car files)))
- (file-error nil))
- (setq files (cdr files)))))
-
-(defvar print-quoted)
-(defvar print-escape-multibyte)
-(defun riece-save-variables-files ()
- "Save current settings to `riece-saved-variables-file'."
- (with-temp-file riece-saved-variables-file
- (insert ";;; This file is generated automatically by " riece-version ".\n"
- ";;; Do not edit this file!\n\n")
- (let ((print-quoted t)
- (print-readably t)
- print-escape-multibyte
- print-level
- print-length
- (variables riece-saved-forms))
- (while variables
- (prin1 `(setq ,(car variables)
- ',(symbol-value (car variables)))
- (current-buffer))
- (insert "\n")
- (setq variables (cdr variables)))))
- (setq riece-save-variables-are-dirty nil))
-
-;;;###autoload
-(defun riece (&optional confirm)
- "Connect to the IRC server and start chatting.
-If optional argument CONFIRM is non-nil, ask which IRC server to connect."
- (interactive "P")
- (riece-read-variables-files (if noninteractive
- (car command-line-args-left)))
- (run-hooks 'riece-after-load-startup-hook)
- (if (riece-server-opened)
- (riece-command-configure-windows)
- (modify-frame-parameters (selected-frame)
- (list (cons 'riece-window-configuration
- (current-window-configuration))))
- (setq riece-addon-dependencies (riece-resolve-addons
- (copy-sequence riece-addons)))
- (let ((pointer riece-addon-dependencies))
- (while pointer
- (riece-insinuate-addon (car (car pointer)) riece-debug)
- (setq pointer (cdr pointer))))
- (if (or confirm (null riece-server))
- (setq riece-server (completing-read (riece-mcat "Server: ")
- riece-server-alist)))
- (if (stringp riece-server)
- (setq riece-server (riece-server-name-to-server riece-server)))
- (riece-create-buffers)
- (switch-to-buffer riece-command-buffer)
- (riece-display-connect-signals)
- (riece-redisplay-buffers)
- (riece-open-server riece-server "")
- ;; If no server process is available, exit.
- (if (null riece-server-process-alist)
- (riece-exit)
- (let ((server-list riece-startup-server-list))
- (while server-list
- (riece-command-open-server (car server-list))
- (setq server-list (cdr server-list))))
- (let ((channel-list riece-startup-channel-list)
- server)
- (while channel-list
- (setq server (riece-identity-server
- (riece-parse-identity (car channel-list))))
- (unless (riece-server-opened server)
- (riece-command-open-server server))
- (setq channel-list (cdr channel-list))))
- (let ((pointer riece-addon-dependencies))
- (while pointer
- (unless (get (car (car pointer)) 'riece-addon-default-disabled)
- (riece-enable-addon (car (car pointer)) riece-debug))
- (setq pointer (cdr pointer))))
- (run-hooks 'riece-startup-hook)
- (message "%s" (substitute-command-keys
- (riece-mcat "Type \\[describe-mode] for help"))))))
-
-(defun riece-exit ()
- (if riece-save-variables-are-dirty
- (riece-save-variables-files))
- (while riece-buffer-list
- (if (and (get-buffer (car riece-buffer-list))
- (buffer-live-p (car riece-buffer-list)))
- (funcall riece-buffer-dispose-function (car riece-buffer-list)))
- (setq riece-buffer-list (cdr riece-buffer-list)))
- (riece-clear-signal-slots)
- (setq riece-server nil
- riece-current-channels nil
- riece-current-channel nil
- riece-channel-buffer nil
- riece-channel-buffer-alist nil
- riece-user-indicator nil
- riece-long-channel-indicator (riece-mcat "None")
- riece-channel-list-indicator (riece-mcat "No channel")
- riece-away-indicator "-"
- riece-operator-indicator "-"
- riece-channel-status-indicator "-"
- riece-freeze-indicator "-")
- (modify-frame-parameters (selected-frame)
- (list (list 'riece-window-configuration)))
- (delete-other-windows)
- (run-hooks 'riece-exit-hook))
-
-(defun riece-command-mode ()
- "Major mode for Riece. Normal edit function are available.
-Typing Return or Linefeed enters the current line in the dialogue.
-The following special commands are available:
-For a list of the generic commands type \\[riece-command-generic] ? RET.
-\\{riece-command-mode-map}"
- (interactive)
- (kill-all-local-variables)
-
- ;; Make `truncate-partial-width-windows' buffer local and set it to
- ;; nil. This causes `truncate-lines' to directly control line
- ;; truncation.
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
-
- (make-local-variable 'riece-mode-line-buffer-identification)
- (setq riece-away-indicator "-"
- riece-operator-indicator "-"
- riece-channel-status-indicator "-"
- major-mode 'riece-command-mode
- mode-name "Command"
- riece-mode-line-buffer-identification
- '("Riece: "
- riece-away-indicator
- riece-operator-indicator
- riece-channel-status-indicator
- " "
- riece-user-indicator
- " "
- riece-channel-indicator)
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)
- truncate-lines nil)
- (riece-simplify-mode-line-format)
- (use-local-map riece-command-mode-map)
-
- (unless riece-command-mode-syntax-table
- (setq riece-command-mode-syntax-table
- (copy-syntax-table (syntax-table)))
- (set-syntax-table riece-command-mode-syntax-table)
- (mapcar
- (lambda (c) (modify-syntax-entry c "w"))
- "^[]{}'`"))
-
- (run-hooks 'riece-command-mode-hook))
-
-(defun riece-dialogue-mode ()
- "Major mode for displaying the IRC dialogue.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{riece-dialogue-mode-map}"
- (kill-all-local-variables)
- (make-local-variable 'riece-freeze)
- (make-local-variable 'riece-freeze-indicator)
-
- ;; Make `truncate-partial-width-windows' buffer local and set it to
- ;; nil. This causes `truncate-lines' to directly control line truncation.
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
-
- (make-local-variable 'riece-mode-line-buffer-identification)
- (setq riece-freeze riece-default-freeze
- riece-away-indicator "-"
- riece-operator-indicator "-"
- riece-channel-status-indicator "-"
- major-mode 'riece-dialogue-mode
- mode-name "Dialogue"
- riece-mode-line-buffer-identification
- '("Riece: "
- riece-away-indicator
- riece-operator-indicator
- riece-freeze-indicator
- riece-channel-status-indicator
- " "
- riece-channel-list-indicator " ")
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)
- truncate-lines nil
- buffer-read-only t)
- (riece-simplify-mode-line-format)
- (use-local-map riece-dialogue-mode-map)
- (buffer-disable-undo)
- (run-hooks 'riece-dialogue-mode-hook))
-
-(define-derived-mode riece-others-mode riece-dialogue-mode
- "Others"
- "Major mode for displaying the IRC others message except current channel.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{riece-others-mode-map}")
-
-(define-derived-mode riece-channel-mode riece-dialogue-mode
- "Channel"
- "Major mode for displaying the IRC current channel buffer.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{riece-channel-mode-map}"
- (make-local-variable 'riece-channel-buffer-window-point)
- (make-local-variable 'riece-mode-line-buffer-identification)
- (setq riece-mode-line-buffer-identification
- '("Riece: "
- riece-away-indicator
- riece-operator-indicator
- riece-freeze-indicator
- riece-channel-status-indicator
- " "
- riece-long-channel-indicator)
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)))
-
-(defun riece-channel-list-mode ()
- "Major mode for displaying channel list.
-All normal editing commands are turned off."
- (kill-all-local-variables)
- (buffer-disable-undo)
-
- ;; Make `truncate-partial-width-windows' buffer local and set it to
- ;; nil. This causes `truncate-lines' to directly control line truncation.
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
-
- (make-local-variable 'riece-mode-line-buffer-identification)
- (setq major-mode 'riece-channel-list-mode
- mode-name "Channels"
- riece-mode-line-buffer-identification '("Riece: ")
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)
- truncate-lines t
- buffer-read-only t)
- (make-local-hook 'riece-update-buffer-functions)
- (add-hook 'riece-update-buffer-functions
- 'riece-update-channel-list-buffer nil t)
- (use-local-map riece-channel-list-mode-map)
- (run-hooks 'riece-channel-list-mode-hook))
-
-(defun riece-user-list-mode ()
- "Major mode for displaying members in the IRC current channel buffer.
-All normal editing commands are turned off.
-Instead, these commands are available:
-\\{riece-user-list-mode-map}"
- (kill-all-local-variables)
- (buffer-disable-undo)
-
- ;; Make `truncate-partial-width-windows' buffer local and set it to
- ;; nil. This causes `truncate-lines' to directly control line truncation.
- (make-local-variable 'truncate-partial-width-windows)
- (setq truncate-partial-width-windows nil)
-
- (make-local-variable 'riece-mode-line-buffer-identification)
- (setq major-mode 'riece-user-list-mode
- mode-name "Users"
- riece-mode-line-buffer-identification
- '("Riece: " riece-long-channel-indicator " ")
- mode-line-buffer-identification
- (riece-mode-line-buffer-identification
- riece-mode-line-buffer-identification)
- truncate-lines t
- buffer-read-only t)
- (if (boundp 'transient-mark-mode)
- (set (make-local-variable 'transient-mark-mode) t))
- (make-local-hook 'riece-update-buffer-functions)
- (add-hook 'riece-update-buffer-functions
- 'riece-update-user-list-buffer nil t)
- (use-local-map riece-user-list-mode-map)
- (run-hooks 'riece-user-list-mode-hook))
-
-(defun riece-create-buffers ()
- (let ((alist riece-buffer-alist))
- (while alist
- (save-excursion
- (set-buffer (apply #'riece-get-buffer-create
- (cdr (car alist))))
- (set (car (car alist)) (current-buffer))
- (unless (or (null (nth 2 (car alist)))
- (eq major-mode (nth 2 (car alist))))
- (funcall (nth 2 (car alist))))
- (setq alist (cdr alist))))))
-
-(defvar reporter-prompt-for-summary-p)
-(defun riece-submit-bug-report (&optional recent-messages recent-keys)
- "Submit via mail a bug report on Riece."
- ;; This strange form ensures that (recent-keys) is the value before
- ;; the bug subject string is read.
- (interactive (list (riece-recent-messages 20) (recent-keys)))
- (message "Querying server version...")
- (let ((pointer riece-server-process-alist)
- nickname)
- (while pointer
- (when (riece-server-process-opened (cdr (car pointer)))
- (process-send-string (cdr (car pointer)) "VERSION\r\n")
- (if (setq nickname
- (with-current-buffer (process-buffer (cdr (car pointer)))
- riece-real-nickname))
- (process-send-string
- (cdr (car pointer))
- (format "PRIVMSG %s :\1VERSION\1\r\n" nickname))))
- (setq pointer (cdr pointer))))
- (sit-for 3)
- (message "Querying server version...done")
- (require 'reporter)
- (let ((reporter-prompt-for-summary-p t))
- (unless riece-debug
- (error "Please turn on riece-debug and restart Riece."))
- (reporter-submit-bug-report
- "liece@unixuser.org"
- (riece-version)
- '(riece-debug)
- nil
- nil
- "This bug report will be sent to the Riece Development Team,
-not to your local site managers!!
-
-Please write in Japanese or English, because the Riece maintainers do
-not have translators to read other languages for them.
-
-Please describe as succinctly as possible:
-\t- What happened.
-\t- What you thought should have happened.
-\t- Precisely what you were doing at the time.
-
-Also include a reliable recipe for triggering the bug, as well as
-any lisp back-traces that you may have.
-\(setq stack-trace-on-error t\), or \(setq debug-on-error t\) if you
-are familiar with the debugger, to get a lisp back-trace.")
- (delete-other-windows)
- (save-excursion
- (goto-char (point-max))
- (insert
- "\nAdd-on state:\n"
- "------------\n"
- (save-window-excursion
- (save-excursion
- (riece-command-list-addons)
- (search-forward "\n\n")
- (buffer-substring (point-min) (point)))))
- (insert "Recent messages from servers:\n"
- "--------------------------")
- (let ((pointer riece-server-process-alist))
- (while pointer
- (insert "\n- \"" (car (car pointer)) "\", \n"
- (format "%S" (if (equal (car (car pointer)) "")
- riece-server
- (cdr (assoc (car (car pointer))
- riece-server-alist))))
- "\n"
- (if (riece-server-process-opened (cdr (car pointer)))
- (save-excursion
- (set-buffer (process-buffer (cdr (car pointer))))
- (goto-char (point-max))
- (beginning-of-line -60)
- (buffer-substring (point) (point-max)))
- "(closed server)"))
- (setq pointer (cdr pointer))))
- (insert "\n\nRecent debug messages:\n"
- "-----------------------------------\n"
- (with-current-buffer riece-debug-buffer
- (buffer-string)))
- ;; Insert recent keystrokes.
- (insert "\n\nRecent keystrokes:\n"
- "-----------------\n\n")
- (let ((before-keys (point)))
- (insert (key-description recent-keys))
- (save-restriction
- (narrow-to-region before-keys (point))
- (goto-char before-keys)
- (while (progn (move-to-column 50) (not (eobp)))
- (search-forward " " nil t)
- (insert "\n"))))
- ;; Insert recent minibuffer messages.
- (insert "\n\nRecent messages (most recent first):\n"
- "-----------------------------------\n"
- recent-messages))))
-
-(provide 'riece)
-
-;;; riece.el ends here
+++ /dev/null
-# server.rb --- A simple IPC server executing Ruby programs.
-# Copyright (C) 1998-2005 Daiki Ueno
-
-# Author: Daiki Ueno <ueno@unixuser.org>
-# Created: 1998-09-28
-# Keywords: IRC, riece, Ruby
-
-# This file is part of Riece.
-
-# This program 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.
-
-# This program 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., 51 Franklin Street, Fifth Floor,
-# Boston, MA 02110-1301, USA.
-
-require 'thread'
-require 'stringio'
-
-class Server
- def initialize(outfile, errfile, logfile)
- @out = $stdout
- @err = $stderr
- $stdout = outfile ? File.new(outfile, 'a') : StringIO.new
- $stderr = errfile ? File.new(errfile, 'a') : StringIO.new
- @log = File.new(logfile, 'a') if logfile
-
- @buf = ''
- @que = Queue.new
- @thr = Hash.new
- @cnt = 0
- end
-
- def dispatch(line)
- @log.puts(line) if @log
- case line.chomp
- when /\AD /
- @buf << $'
- when /\A(\S+)\s*/
- c = $1
- r = $'
- d = "dispatch_#{c.downcase}"
- if respond_to?(d, true)
- Thread.start do
- self.send(d, c, r)
- end
- else
- send_line("ERR 103 Unknown command\r\n")
- end
- end
- end
-
- def dispatch_cancel(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_bye(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_auth(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_reset(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_end(c, r)
- enq_data
- end
-
- def dispatch_help(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_quit(c, r)
- send_line("ERR 100 Not implemented\r\n")
- end
-
- def dispatch_eval(c, r)
- r = deq_data if r.empty?
- name = nil
- Thread.exclusive do
- while @thr.include?(name = @cnt.to_s)
- @cnt += 1
- end
- @thr[name] = Thread.current
- end
- send_line("S name #{name}\r\n")
- send_line("OK\r\n")
- Thread.current[:rubyserv_name] = name
- begin
- Thread.current[:rubyserv_error] = false
- Thread.current[:rubyserv_response] = eval(r, exec_env.empty_binding)
- rescue Exception => e
- Thread.current[:rubyserv_error] = true
- Thread.current[:rubyserv_response] =
- e.to_s.sub(/\A.*?\n#{Regexp.quote(__FILE__)}:\d+: /o, '')
- end
- send_line("# exit #{name}\r\n")
- end
-
- def dispatch_poll(c, r)
- thr = @thr[r]
- if !thr
- send_line("ERR 105 Parameter error: no such name \"#{r}\"\r\n")
- elsif thr.alive?
- send_line("S running #{r}\r\n")
- send_line("OK\r\n")
- else
- if thr[:rubyserv_error]
- send_line("S exited #{r}\r\n")
- else
- send_line("S finished #{r}\r\n")
- end
- if d = thr[:rubyserv_response]
- send_data(d.to_s)
- end
- send_line("OK\r\n")
- end
- end
-
- def dispatch_exit(c, r)
- thr = @thr[r]
- if !thr
- send_line("ERR 105 Parameter error: no such name \"#{r}\"\r\n")
- return
- end
- thr.kill if thr.alive?
- @thr.delete(r)
- send_line("OK\r\n")
- end
-
- def escape(s)
- s.gsub(/[%\r\n]/) {|m| '%%%02X' % m[0]}
- end
-
- def unescape(s)
- s.gsub(/%([0-9A-Z][0-9A-Z])/) {[$1].pack('H*')}
- end
-
- def send_data(d)
- d = escape(d)
- begin
- len = [d.length, 998].min # 998 = 1000 - "D "
- send_line("D #{d[0 ... len]}\r\n")
- d = d[len .. -1]
- end until d.empty?
- end
-
- def enq_data
- d = unescape(@buf)
- @buf = ''
- @que.enq(d)
- end
-
- def deq_data
- @que.deq
- end
-
- def send_line(line)
- @out.puts(line)
- @log.puts(line) if @log
- end
-
- def exec_env
- env = Object.new
- def env.empty_binding
- binding
- end
- out, log = @out, @log
- env.instance_eval {@out, @log = out, log}
- def env.send_line(line)
- @out.puts(line)
- @log.puts(line) if @log
- end
- def env.output(s)
- send_line("# output #{Thread.current[:rubyserv_name]} #{s}\r\n")
- end
- env
- end
-end
-
-if $0 == __FILE__
- require 'optparse'
-
- opt_outfile, opt_errfile, opt_logfile = nil, nil, nil
- opts = OptionParser.new do |opts|
- opts.banner = <<"End"
-Usage: #{$0} [OPTIONS]
-End
- opts.on('-o', '--out OUTFILE', 'Send stdout to OUTFILE.') do |outfile|
- opt_outfile = outfile
- end
- opts.on('-e', '--err ERRFILE', 'Send stderr to ERRFILE.') do |errfile|
- opt_errfile = errfile
- end
- opts.on('-l', '--log LOGFILE', 'Send log to LOGFILE.') do |logfile|
- opt_logfile = logfile
- end
- opts.on_tail('--help', '-h', 'Show this message.') do
- $stdout.print(opts.to_s)
- exit(0)
- end
- end
- begin
- opts.parse!(ARGV)
- rescue OptionParser::ParseError
- $stderr.print(opts.to_s)
- exit(1)
- end
-
- server = Server.new(opt_outfile, opt_errfile, opt_logfile)
- while gets
- server.dispatch($_)
- end
-end
+++ /dev/null
-EXTRA_DIST = luna.el lunit.el lunit-report.el \
- test-riece-addon.el test-riece-alias.el test-riece-cache.el \
- test-riece-eval.el test-riece-log.el test-riece-shrink-buffer.el \
- test-riece-url.el test-riece-yank.el
+++ /dev/null
-;;; luna.el --- tiny OOP system kernel
-
-;; Copyright (C) 1999,2000,2002 Free Software Foundation, Inc.
-
-;; Author: MORIOKA Tomohiko <tomo@m17n.org>
-;; Keywords: OOP
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(eval-when-compile (require 'cl))
-
-
-;;; @ class
-;;;
-
-(defmacro luna-find-class (name)
- "Return a luna-class that has NAME."
- `(get ,name 'luna-class))
-
-;; Give NAME (symbol) the luna-class CLASS.
-(defmacro luna-set-class (name class)
- `(put ,name 'luna-class ,class))
-
-;; Return the obarray of luna-class CLASS.
-(defmacro luna-class-obarray (class)
- `(aref ,class 1))
-
-;; Return the parents of luna-class CLASS.
-(defmacro luna-class-parents (class)
- `(aref ,class 2))
-
-;; Return the number of slots of luna-class CLASS.
-(defmacro luna-class-number-of-slots (class)
- `(aref ,class 3))
-
-(defmacro luna-define-class (class &optional parents slots)
- "Define CLASS as a luna-class.
-CLASS always inherits the luna-class `standard-object'.
-
-The optional 1st arg PARENTS is a list luna-class names. These
-luna-classes are also inheritted by CLASS.
-
-The optional 2nd arg SLOTS is a list of slots CLASS will have."
- `(luna-define-class-function ',class ',(append parents '(standard-object))
- ',slots))
-
-
-;; Define CLASS as a luna-class. PARENTS, if non-nil, is a list of
-;; luna-class names inherited by CLASS. SLOTS, if non-nil, is a list
-;; of slots belonging to CLASS.
-
-(defun luna-define-class-function (class &optional parents slots)
- (let ((oa (make-vector 31 0))
- (rest parents)
- parent name
- (i 2)
- b j)
- (while rest
- (setq parent (pop rest)
- b (- i 2))
- (mapatoms (lambda (sym)
- (when (setq j (get sym 'luna-slot-index))
- (setq name (symbol-name sym))
- (unless (intern-soft name oa)
- (put (intern name oa) 'luna-slot-index (+ j b))
- (setq i (1+ i)))))
- (luna-class-obarray (luna-find-class parent))))
- (setq rest slots)
- (while rest
- (setq name (symbol-name (pop rest)))
- (unless (intern-soft name oa)
- (put (intern name oa) 'luna-slot-index i)
- (setq i (1+ i))))
- (luna-set-class class (vector 'class oa parents i))))
-
-
-;; Return a member (slot or method) of CLASS that has name
-;; MEMBER-NAME.
-
-(defun luna-class-find-member (class member-name)
- (or (stringp member-name)
- (setq member-name (symbol-name member-name)))
- (intern-soft member-name (luna-class-obarray class)))
-
-
-;; Return a member (slot or method) of CLASS that has name
-;; MEMBER-NAME. If CLASS doesnt' have such a member, make it in
-;; CLASS.
-
-(defsubst luna-class-find-or-make-member (class member-name)
- (or (stringp member-name)
- (setq member-name (symbol-name member-name)))
- (intern member-name (luna-class-obarray class)))
-
-
-;; Return the index number of SLOT-NAME in CLASS.
-
-(defmacro luna-class-slot-index (class slot-name)
- `(get (luna-class-find-member ,class ,slot-name) 'luna-slot-index))
-
-(defmacro luna-define-method (name &rest definition)
- "Define NAME as a method of a luna class.
-
-Usage of this macro follows:
-
- (luna-define-method NAME [METHOD-QUALIFIER] ARGLIST [DOCSTRING] BODY...)
-
-The optional 1st argument METHOD-QUALIFIER specifies when and how the
-method is called.
-
-If it is :before, call the method before calling the parents' methods.
-
-If it is :after, call the method after calling the parents' methods.
-
-If it is :around, call the method only. The parents' methods can be
-executed by calling the function `luna-call-next-method' in BODY.
-
-Otherwize, call the method only, and the parents' methods are never
-executed. In this case, METHOD-QUALIFIER is treated as ARGLIST.
-
-ARGLIST has the form ((VAR CLASS) METHOD-ARG ...), where VAR is a
-variable name that should be bound to an entity that receives the
-message NAME, CLASS is a class name. The first argument to the method
-is VAR, and the remaining arguments are METHOD-ARGs.
-
-If VAR is nil, arguments to the method are METHOD-ARGs. This kind of
-methods can't be called from generic-function (see
-`luna-define-generic').
-
-The optional 4th argument DOCSTRING is the documentation of the
-method. If it is not string, it is treated as BODY.
-
-The optional 5th BODY is the body of the method."
- (let ((method-qualifier (pop definition))
- args specializer class self)
- (if (memq method-qualifier '(:before :after :around))
- (setq args (pop definition))
- (setq args method-qualifier
- method-qualifier nil))
- (setq specializer (car args)
- class (nth 1 specializer)
- self (car specializer))
- `(let ((func (lambda ,(if self
- (cons self (cdr args))
- (cdr args))
- ,@definition))
- (sym (luna-class-find-or-make-member
- (luna-find-class ',class) ',name))
- (cache (get ',name 'luna-method-cache)))
- (and cache
- (fboundp sym)
- (mapatoms
- (lambda (s)
- (if (memq (symbol-function sym) (symbol-value s))
- (unintern s cache)))
- cache))
- (fset sym func)
- (put sym 'luna-method-qualifier ,method-qualifier))))
-
-(put 'luna-define-method 'lisp-indent-function 'defun)
-
-(def-edebug-spec luna-define-method
- (&define name [&optional &or ":before" ":after" ":around"]
- ((arg symbolp)
- [&rest arg]
- [&optional ["&optional" arg &rest arg]]
- &optional ["&rest" arg])
- def-body))
-
-
-;; Return a list of method functions named SERVICE registered in the
-;; parents of CLASS.
-
-(defun luna-class-find-parents-functions (class service)
- (let ((parents (luna-class-parents class))
- ret)
- (while (and parents
- (null
- (setq ret (luna-class-find-functions
- (luna-find-class (pop parents))
- service)))))
- ret))
-
-;; Return a list of method functions named SERVICE registered in CLASS
-;; and the parents..
-
-(defun luna-class-find-functions (class service)
- (let ((sym (luna-class-find-member class service)))
- (if (fboundp sym)
- (cond ((eq (get sym 'luna-method-qualifier) :before)
- (cons (symbol-function sym)
- (luna-class-find-parents-functions class service)))
- ((eq (get sym 'luna-method-qualifier) :after)
- (nconc (luna-class-find-parents-functions class service)
- (list (symbol-function sym))))
- ((eq (get sym 'luna-method-qualifier) :around)
- (cons sym (luna-class-find-parents-functions class service)))
- (t
- (list (symbol-function sym))))
- (luna-class-find-parents-functions class service))))
-
-
-;;; @ instance (entity)
-;;;
-
-(defmacro luna-class-name (entity)
- "Return class-name of the ENTITY."
- `(aref ,entity 0))
-
-(defmacro luna-set-class-name (entity name)
- `(aset ,entity 0 ,name))
-
-(defmacro luna-get-obarray (entity)
- `(aref ,entity 1))
-
-(defmacro luna-set-obarray (entity obarray)
- `(aset ,entity 1 ,obarray))
-
-(defmacro luna-slot-index (entity slot-name)
- `(luna-class-slot-index (luna-find-class (luna-class-name ,entity))
- ,slot-name))
-
-(defsubst luna-slot-value (entity slot)
- "Return the value of SLOT of ENTITY."
- (aref entity (luna-slot-index entity slot)))
-
-(defsubst luna-set-slot-value (entity slot value)
- "Store VALUE into SLOT of ENTITY."
- (aset entity (luna-slot-index entity slot) value))
-
-(defmacro luna-find-functions (entity service)
- `(luna-class-find-functions (luna-find-class (luna-class-name ,entity))
- ,service))
-
-(defsubst luna-send (entity message &rest luna-current-method-arguments)
- "Send MESSAGE to ENTITY, and return the result.
-ENTITY is an instance of a luna class, and MESSAGE is a method name of
-the luna class.
-LUNA-CURRENT-METHOD-ARGUMENTS is arguments of the MESSAGE."
- (let ((luna-next-methods (luna-find-functions entity message))
- luna-current-method
- luna-previous-return-value)
- (while (and luna-next-methods
- (progn
- (setq luna-current-method (pop luna-next-methods)
- luna-previous-return-value
- (apply luna-current-method
- luna-current-method-arguments))
- (if (symbolp luna-current-method)
- (not (eq (get luna-current-method
- 'luna-method-qualifier) :around))
- t))))
- luna-previous-return-value))
-
-(eval-when-compile
- (defvar luna-next-methods nil)
- (defvar luna-current-method-arguments nil))
-
-(defun luna-call-next-method ()
- "Call the next method in the current method function.
-A method function that has :around qualifier should call this function
-to execute the parents' methods."
- (let (luna-current-method
- luna-previous-return-value)
- (while (and luna-next-methods
- (progn
- (setq luna-current-method (pop luna-next-methods)
- luna-previous-return-value
- (apply luna-current-method
- luna-current-method-arguments))
- (if (symbolp luna-current-method)
- (not (eq (get luna-current-method
- 'luna-method-qualifier) :around))
- t))))
- luna-previous-return-value))
-
-(defun luna-make-entity (class &rest init-args)
- "Make an entity (instance) of luna-class CLASS and return it.
-INIT-ARGS is a plist of the form (:SLOT1 VAL1 :SLOT2 VAL2 ...),
-where SLOTs are slots of CLASS and the VALs are initial values of
-the corresponding SLOTs."
- (let* ((c (get class 'luna-class))
- (v (make-vector (luna-class-number-of-slots c) nil)))
- (luna-set-class-name v class)
- (luna-set-obarray v (make-vector 7 0))
- (apply #'luna-send v 'initialize-instance v init-args)))
-
-
-;;; @ interface (generic function)
-;;;
-
-;; Find a method of ENTITY that handles MESSAGE, and call it with
-;; arguments LUNA-CURRENT-METHOD-ARGUMENTS.
-
-(defun luna-apply-generic (entity message &rest luna-current-method-arguments)
- (let* ((class (luna-class-name entity))
- (cache (get message 'luna-method-cache))
- (sym (intern-soft (symbol-name class) cache))
- luna-next-methods)
- (if sym
- (setq luna-next-methods (symbol-value sym))
- (setq luna-next-methods
- (luna-find-functions entity message))
- (set (intern (symbol-name class) cache)
- luna-next-methods))
- (luna-call-next-method)))
-
-
-;; Convert ARGLIST (argument list spec for a method function) to the
-;; actual list of arguments.
-
-(defsubst luna-arglist-to-arguments (arglist)
- (let (dest)
- (while arglist
- (let ((arg (car arglist)))
- (or (memq arg '(&optional &rest))
- (setq dest (cons arg dest))))
- (setq arglist (cdr arglist)))
- (nreverse dest)))
-
-
-(defmacro luna-define-generic (name args &optional doc)
- "Define a function NAME that provides a generic interface to the method NAME.
-ARGS is the argument list for NAME. The first element of ARGS is an
-entity.
-
-The function handles a message sent to the entity by calling the
-method with proper arguments.
-
-The optional 3rd argument DOC is the documentation string for NAME."
- (if doc
- `(progn
- (defun ,(intern (symbol-name name)) ,args
- ,doc
- (luna-apply-generic ,(car args) ',name
- ,@(luna-arglist-to-arguments args)))
- (put ',name 'luna-method-cache (make-vector 31 0)))
- `(progn
- (defun ,(intern (symbol-name name)) ,args
- (luna-apply-generic ,(car args) ',name
- ,@(luna-arglist-to-arguments args)))
- (put ',name 'luna-method-cache (make-vector 31 0)))))
-
-(put 'luna-define-generic 'lisp-indent-function 'defun)
-
-
-;;; @ accessor
-;;;
-
-(defun luna-define-internal-accessors (class-name)
- "Define internal accessors for instances of the luna class CLASS-NAME.
-
-Internal accessors are macros to refer and set a slot value of the
-instances. For instance, if the class has SLOT, macros
-CLASS-NAME-SLOT-internal and CLASS-NAME-set-SLOT-internal are defined.
-
-CLASS-NAME-SLOT-internal accepts one argument INSTANCE, and returns
-the value of SLOT.
-
-CLASS-NAME-set-SLOT-internal accepts two arguemnt INSTANCE and VALUE,
-and sets SLOT to VALUE."
- (let ((entity-class (luna-find-class class-name))
- parents parent-class)
- (mapatoms
- (lambda (slot)
- (if (luna-class-slot-index entity-class slot)
- (catch 'derived
- (setq parents (luna-class-parents entity-class))
- (while parents
- (setq parent-class (luna-find-class (car parents)))
- (if (luna-class-slot-index parent-class slot)
- (throw 'derived nil))
- (setq parents (cdr parents)))
- (eval
- `(progn
- (defmacro ,(intern (format "%s-%s-internal"
- class-name slot))
- (entity)
- (list 'aref entity
- ,(luna-class-slot-index entity-class
- (intern (symbol-name slot)))))
- (defmacro ,(intern (format "%s-set-%s-internal"
- class-name slot))
- (entity value)
- (list 'aset entity
- ,(luna-class-slot-index
- entity-class (intern (symbol-name slot)))
- value)))))))
- (luna-class-obarray entity-class))))
-
-
-;;; @ standard object
-;;;
-
-;; Define super class of all luna classes.
-(luna-define-class-function 'standard-object)
-
-(luna-define-method initialize-instance ((entity standard-object)
- &rest init-args)
- "Initialize slots of ENTITY by INIT-ARGS."
- (let* ((c (luna-find-class (luna-class-name entity)))
- (oa (luna-class-obarray c))
- s i)
- (while init-args
- (setq s (intern-soft (substring (symbol-name (pop init-args)) 1) oa)
- i (pop init-args))
- (if s
- (aset entity (get s 'luna-slot-index) i)))
- entity))
-
-
-;;; @ end
-;;;
-
-(provide 'luna)
-
-;; luna.el ends here
+++ /dev/null
-;;; lunit-report.el --- output test report in XML compatible with JUnitTask
-
-;; Copyright (C) 2004 Daiki Ueno.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-
-;; This file is part of Riece.
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Code:
-
-(require 'lunit)
-
-(eval-and-compile
- (luna-define-class lunit-test-reporter (lunit-test-listener)
- (buffer
- start-time))
-
- (luna-define-internal-accessors 'lunit-test-reporter))
-
-;; stolen (and renamed) from time-date.el.
-(defun lunit-time-since (time)
- "Return the time elapsed since TIME."
- (let* ((current (current-time))
- (rest (when (< (nth 1 current) (nth 1 time))
- (expt 2 16))))
- (list (- (+ (car current) (if rest -1 0)) (car time))
- (- (+ (or rest 0) (nth 1 current)) (nth 1 time))
- (- (nth 2 current) (nth 2 time)))))
-
-(defun lunit-escape-quote (string)
- (let ((index 0))
- (while (string-match "\"" string index)
- (setq string (replace-match """ nil t string)
- index (+ 5 index)))
- string))
-
-(luna-define-method lunit-test-listener-error ((reporter lunit-test-reporter)
- case error)
- (save-excursion
- (set-buffer (lunit-test-reporter-buffer-internal reporter))
- (insert (format "\
- <error message=\"%s\" type=\"error\"/>
-"
- (lunit-escape-quote (pp-to-string error))))))
-
-(luna-define-method lunit-test-listener-failure ((reporter lunit-test-reporter)
- case failure)
- (save-excursion
- (set-buffer (lunit-test-reporter-buffer-internal reporter))
- (insert (format "\
- <failure message=\"%s\" type=\"failure\"/>
-"
- (lunit-escape-quote (pp-to-string failure))))))
-
-(luna-define-method lunit-test-listener-start ((reporter lunit-test-reporter)
- case)
- (save-excursion
- (set-buffer (lunit-test-reporter-buffer-internal reporter))
- (goto-char (point-max))
- (narrow-to-region (point) (point))
- (insert (format "\
- <testcase name=\"%s\" classname=\"%s\">
-"
- (lunit-test-name-internal case)
- (luna-class-name case)))
- (lunit-test-reporter-set-start-time-internal reporter (current-time))))
-
-(luna-define-method lunit-test-listener-end ((reporter lunit-test-reporter)
- case)
- (let ((elapsed
- (lunit-time-since
- (lunit-test-reporter-start-time-internal reporter))))
- (save-excursion
- (set-buffer (lunit-test-reporter-buffer-internal reporter))
-
- (insert "\
- </testcase>
-")
- (goto-char (point-min))
- (looking-at " *<testcase\\>")
- (goto-char (match-end 0))
- (insert (format " time=\"%.03f\" "
- (+ (nth 1 elapsed)
- (/ (nth 2 elapsed) 1000000.0))))
- (widen))))
-
-(defun lunit-report (test file)
- "Run TEST and output result as XML."
- (let* ((printer
- (luna-make-entity 'lunit-test-printer))
- (result
- (lunit-make-test-result printer))
- (buffer (find-file-noselect file))
- start-time)
- (save-excursion
- (set-buffer buffer)
- (erase-buffer))
- (lunit-test-result-add-listener
- result
- (luna-make-entity 'lunit-test-reporter :buffer buffer))
- (setq start-time (current-time))
- (lunit-test-run test result)
- (let ((assert-count
- (lunit-test-result-assert-count-internal result))
- (failures
- (lunit-test-result-failures-internal result))
- (errors
- (lunit-test-result-errors-internal result))
-
- (elapsed (lunit-time-since start-time)))
- (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
- (lunit-test-number-of-tests test)
- assert-count
- (length failures)
- (length errors)))
- (save-excursion
- (set-buffer buffer)
- (goto-char (point-min))
- (insert (format "\
-<?xml version=\"1.0\" encoding=\"UTF-8\"?>
-<testsuites>
- <testsuite name=\"\" tests=\"%d\" failures=\"%d\" \
-errors=\"%d\" time =\"%.03f\">
- <properties>
- <property name=\"emacs-version\" value=\"%s\"/>
- </properties>
-"
- (lunit-test-number-of-tests test)
- (length failures)
- (length errors)
- (+ (nth 1 elapsed)
- (/ (nth 2 elapsed) 1000000.0))
- (lunit-escape-quote (emacs-version))))
- (goto-char (point-max))
- (insert "\
- </testsuite>
-</testsuites>")
- (save-buffer)))))
-
-(provide 'lunit-report)
\ No newline at end of file
+++ /dev/null
-;;; lunit.el --- simple testing framework for luna
-
-;; Copyright (C) 2000-2004 Daiki Ueno.
-
-;; Author: Daiki Ueno <ueno@unixuser.org>
-;; Keywords: OOP, XP
-
-;; This file is part of FLIM (Faithful Library about Internet Message).
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-
-;; This module is inspired by "JUnit A Cook's Tour".
-;; <URL:http://www.junit.org/junit/doc/cookstour/cookstour.htm>
-
-;; (require 'lunit)
-;;
-;; (luna-define-class silly-test-case (lunit-test-case))
-;;
-;; (luna-define-method test-1 ((case silly-test-case))
-;; (lunit-assert-2 case (integerp "a")))
-;;
-;; (luna-define-method test-2 ((case silly-test-case))
-;; (lunit-assert-2 case (stringp "b")))
-;;
-;; (with-output-to-temp-buffer "*Lunit Results*"
-;; (lunit (lunit-make-test-suite-from-class 'silly-test-case)))
-;; ______________________________________________________________________
-;; Running `silly-test-case#test-1'... failure: (integerp "a")
-;; Running `silly-test-case#test-2'...
-;; 2 runs, 2 assertions, 1 failures, 0 errors
-
-;;; Code:
-
-(require 'luna)
-
-(eval-when-compile (require 'cl))
-
-(require 'pp)
-
-;;; @ test
-;;;
-
-(eval-and-compile
- (luna-define-class lunit-test ()
- (name))
-
- (luna-define-internal-accessors 'lunit-test))
-
-(luna-define-generic lunit-test-number-of-tests (test)
- "Count the number of test cases that will be run by the test.")
-
-(luna-define-generic lunit-test-run (test result)
- "Run the test and collects its result in result.")
-
-(luna-define-generic lunit-test-suite-add-test (suite test)
- "Add the test to the suite.")
-
-;;; @ test listener
-;;;
-
-(luna-define-class lunit-test-listener)
-
-;;; @ test result
-;;;
-
-(put 'lunit-error 'error-message "test error")
-(put 'lunit-error 'error-conditions '(lunit-error error))
-
-(put 'lunit-failure 'error-message "test failure")
-(put 'lunit-failure 'error-conditions '(lunit-failure lunit-error error))
-
-(eval-and-compile
- (luna-define-class lunit-test-result ()
- (errors
- failures
- listeners
- assert-count))
-
- (luna-define-internal-accessors 'lunit-test-result))
-
-(luna-define-generic lunit-test-result-run (result case)
- "Run the test case.")
-
-(luna-define-generic lunit-test-result-notify (result message &rest args)
- "Report the current state of execution.")
-
-(luna-define-generic lunit-test-result-add-listener (result listener)
- "Add listener to the list of listeners.")
-
-(defun lunit-make-test-result (&rest listeners)
- "Return a newly allocated `lunit-test-result' instance with LISTENERS."
- (luna-make-entity 'lunit-test-result :listeners listeners :assert-count 0))
-
-(luna-define-method lunit-test-result-notify ((result lunit-test-result)
- message args)
- (let ((listeners
- (lunit-test-result-listeners-internal result)))
- (dolist (listener listeners)
- (apply #'luna-send listener message listener args))))
-
-(luna-define-method lunit-test-result-run ((result lunit-test-result) case)
- (lunit-test-result-notify result 'lunit-test-listener-start case)
- (condition-case error
- (lunit-test-case-run case)
- (lunit-failure
- (lunit-test-result-set-failures-internal
- result
- (nconc (lunit-test-result-failures-internal result)
- (list (cons case (cdr error)))))
- (lunit-test-result-notify
- result 'lunit-test-listener-failure case (cdr error)))
- (lunit-error
- (lunit-test-result-set-errors-internal
- result
- (nconc (lunit-test-result-errors-internal result)
- (list (cons case (cdr error)))))
- (lunit-test-result-notify
- result 'lunit-test-listener-error case (cdr error))))
- (lunit-test-result-set-assert-count-internal
- result
- (+ (lunit-test-result-assert-count-internal result)
- (lunit-test-case-assert-count-internal case)))
- (lunit-test-result-notify result 'lunit-test-listener-end case))
-
-(luna-define-method lunit-test-result-add-listener ((result lunit-test-result)
- listener)
- (let ((listeners
- (lunit-test-result-listeners-internal result)))
- (setq listeners (nconc listeners (list listener)))
- (lunit-test-result-set-listeners-internal result listeners)))
-
-;;; @ test case
-;;;
-
-(eval-and-compile
- (luna-define-class lunit-test-case (lunit-test)
- (assert-count))
-
- (luna-define-internal-accessors 'lunit-test-case))
-
-(luna-define-generic lunit-test-case-run (case)
- "Run the test case.")
-
-(luna-define-generic lunit-test-case-setup (case)
- "Setup the test case.")
-
-(luna-define-generic lunit-test-case-teardown (case)
- "Clear the test case.")
-
-(defun lunit-make-test-case (class name)
- "Return a newly allocated `lunit-test-case'.
-CLASS is a symbol for class derived from `lunit-test-case'.
-NAME is name of the method to be tested."
- (luna-make-entity class :name name :assert-count 0))
-
-(luna-define-method lunit-test-number-of-tests ((case lunit-test-case))
- 1)
-
-(luna-define-method lunit-test-run ((case lunit-test-case) result)
- (lunit-test-result-run result case))
-
-(luna-define-method lunit-test-case-setup ((case lunit-test-case)))
-(luna-define-method lunit-test-case-teardown ((case lunit-test-case)))
-
-(luna-define-method lunit-test-case-run ((case lunit-test-case))
- (lunit-test-case-setup case)
- (unwind-protect
- (let* ((name
- (lunit-test-name-internal case))
- (functions
- (luna-find-functions case name)))
- (unless functions
- (error "Method \"%S\" not found" name))
- (condition-case error
- (funcall (car functions) case)
- (lunit-failure
- (signal (car error)(cdr error)))
- (error
- (signal 'lunit-error error))))
- (lunit-test-case-teardown case)))
-
-;;; @ test suite
-;;;
-
-(eval-and-compile
- (luna-define-class lunit-test-suite (lunit-test)
- (tests))
-
- (luna-define-internal-accessors 'lunit-test-suite))
-
-(defun lunit-make-test-suite (&rest tests)
- "Return a newly allocated `lunit-test-suite' instance.
-TESTS holds a number of instances of `lunit-test'."
- (luna-make-entity 'lunit-test-suite :tests tests))
-
-(luna-define-method lunit-test-suite-add-test ((suite lunit-test-suite) test)
- (let ((tests (lunit-test-suite-tests-internal suite)))
- (lunit-test-suite-set-tests-internal suite (nconc tests (list test)))))
-
-(luna-define-method lunit-test-number-of-tests ((suite lunit-test-suite))
- (let ((tests (lunit-test-suite-tests-internal suite))
- (accu 0))
- (dolist (test tests)
- (setq accu (+ accu (lunit-test-number-of-tests test))))
- accu))
-
-(luna-define-method lunit-test-run ((suite lunit-test-suite) result)
- (let ((tests (lunit-test-suite-tests-internal suite)))
- (dolist (test tests)
- (lunit-test-run test result))))
-
-;;; @ test runner
-;;;
-
-(defmacro lunit-assert (condition-expr)
- "Verify that CONDITION-EXPR returns non-nil; signal an error if not."
- `(unless ,condition-expr
- (signal 'lunit-failure (list ',condition-expr))))
-
-(defmacro lunit-assert-2 (case condition-expr)
- "In regard to CASE, verify that CONDITION-EXPR returns non-nil;
-signal an error if not."
- `(let ((case ,case))
- (lunit-test-case-set-assert-count-internal
- case
- (1+ (lunit-test-case-assert-count-internal case)))
- (unless ,condition-expr
- (signal 'lunit-failure (list ',condition-expr)))))
-
-(luna-define-class lunit-test-printer (lunit-test-listener))
-
-(luna-define-method lunit-test-listener-error ((printer lunit-test-printer)
- case error)
- (princ (format " error: %S" error)))
-
-(luna-define-method lunit-test-listener-failure ((printer lunit-test-printer)
- case failure)
- (princ (format " failure: %S" failure)))
-
-(luna-define-method lunit-test-listener-start ((printer lunit-test-printer)
- case)
- (princ (format "Running `%S#%S'..."
- (luna-class-name case)
- (lunit-test-name-internal case))))
-
-(luna-define-method lunit-test-listener-end ((printer lunit-test-printer) case)
- (princ "\n"))
-
-(defun lunit-make-test-suite-from-class (class)
- "Make a test suite from all test methods of the CLASS."
- (let (tests)
- (mapatoms
- (lambda (symbol)
- (if (and (fboundp symbol)
- (string-match "^test" (symbol-name symbol))
- (null (get symbol 'luna-method-qualifier)))
- (push (lunit-make-test-case class symbol) tests)))
- (luna-class-obarray (luna-find-class class)))
- (apply #'lunit-make-test-suite tests)))
-
-(defun lunit (test)
- "Run TEST and display the result."
- (let* ((printer
- (luna-make-entity 'lunit-test-printer))
- (result
- (lunit-make-test-result printer)))
- (lunit-test-run test result)
- (let ((assert-count
- (lunit-test-result-assert-count-internal result))
- (failures
- (lunit-test-result-failures-internal result))
- (errors
- (lunit-test-result-errors-internal result)))
- (princ (format "%d runs, %d assertions, %d failures, %d errors\n"
- (lunit-test-number-of-tests test)
- assert-count
- (length failures)
- (length errors))))))
-
-(defvar imenu-create-index-function)
-(defun lunit-create-index-function ()
- (require 'imenu)
- (save-excursion
- (unwind-protect
- (progn
- (goto-char (point-min))
- (setq imenu-generic-expression
- '((nil "^\\s-*(def\\(un\\|subst\\|macro\\)\\s-+\\([-A-Za-z0-9+*|:]+\\)" 2)))
- (funcall imenu-create-index-function))
- (setq imenu-create-index-function lisp-imenu-generic-expression))))
-
-(defun lunit-generate-template (file)
- (interactive "fGenerate lunit template for: ")
- (save-excursion
- (set-buffer (find-file-noselect file))
- (let ((index-alist
- (lunit-create-index-function)))
- (with-output-to-temp-buffer "*Lunit template*"
- (let* ((feature
- (file-name-sans-extension
- (file-name-nondirectory file)))
- (class
- (concat "test-" feature)))
- (set-buffer standard-output)
- (insert "\
-\(require 'lunit)
-\(require '" feature ")
-
-\(luna-define-class " class " (lunit-test-case))
-
-")
- (dolist (index index-alist)
- (insert "\
-\(luna-define-method " class "-" (car index) " ((case " class "))
- (lunit-assert nil))
-
-")))))))
-
-(provide 'lunit)
-
-;;; lunit.el ends here
+++ /dev/null
-(require 'riece-addon)
-
-(defun test-riece-addon-1-requires ()
- '(test-riece-addon-2))
-(provide 'test-riece-addon-1)
-
-(defun test-riece-addon-2-requires ()
- '(test-riece-addon-3 test-riece-addon-4))
-(provide 'test-riece-addon-2)
-
-(defun test-riece-addon-3-requires ())
-(provide 'test-riece-addon-3)
-
-(defun test-riece-addon-4-requires ())
-(provide 'test-riece-addon-4)
-
-(defun test-riece-addon-5-requires ()
- '(test-riece-addon-6))
-(provide 'test-riece-addon-5)
-
-(defun test-riece-addon-6-requires ()
- '(test-riece-addon-5))
-(provide 'test-riece-addon-6)
-
-(luna-define-class test-riece-addon (lunit-test-case))
-
-(luna-define-method test-riece-resolve-addons-1 ((case test-riece-addon))
- (lunit-assert-2
- case
- (equal
- (mapcar #'car (riece-resolve-addons
- '(test-riece-addon-1 test-riece-addon-2)))
- '(test-riece-addon-3 test-riece-addon-4
- test-riece-addon-2 test-riece-addon-1))))
-
-(luna-define-method test-riece-resolve-addons-2 ((case test-riece-addon))
- (lunit-assert-2
- case
- (condition-case error
- (progn
- (riece-resolve-addons '(test-riece-addon-5 test-riece-addon-6))
- nil)
- (error (nth 1 error)))))
+++ /dev/null
-(require 'riece-alias)
-
-(luna-define-class test-riece-alias (lunit-test-case))
-
-(luna-define-method test-riece-alias-percent-hack ((case test-riece-alias))
- (let ((riece-alias-percent-hack-mask "*.jp"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-percent-hack "#riece:*.jp")
- "%riece"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-percent-hack "%riece")
- "#riece:*.jp"))))
-
-(luna-define-method test-riece-alias-alist-1 ((case test-riece-alias))
- (let ((riece-alias-alist '(("#riece" . "#r"))))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-identity-string "#riece")
- "#r"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-identity-string "#r")
- "#riece"))))
-
-(luna-define-method test-riece-alias-alist-2 ((case test-riece-alias))
- (let ((riece-alias-alist '(("%riece" . "%r")))
- (riece-alias-percent-hack-mask "*.jp"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-identity-string "#riece:*.jp")
- "%r"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-identity-string "%r")
- "#riece:*.jp"))))
-
-(luna-define-method test-riece-alias-altsep-1 ((case test-riece-alias))
- (let ((riece-alias-alternate-separator "@"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#riece")
- "#riece"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#riece localhost")
- "#riece@localhost"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#ch@nnel")
- "#ch@@nnel"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#ch@nnel localhost")
- "#ch@@nnel@localhost"))))
-
-(luna-define-method test-riece-alias-altsep-2 ((case test-riece-alias))
- (let ((riece-alias-alternate-separator "@@"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#riece")
- "#riece"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#riece localhost")
- "#riece@@localhost"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#ch@@nnel")
- "#ch@@@@nnel"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-abbrev-alternate-separator "#ch@@nnel localhost")
- "#ch@@@@nnel@@localhost"))))
-
-(luna-define-method test-riece-alias-altsep-3 ((case test-riece-alias))
- (let ((riece-alias-alternate-separator "@"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#riece")
- "#riece"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#riece@localhost")
- "#riece localhost"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#ch@@nnel")
- "#ch@nnel"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#ch@@nnel@localhost")
- "#ch@nnel localhost"))))
-
-(luna-define-method test-riece-alias-altsep-4 ((case test-riece-alias))
- (let ((riece-alias-alternate-separator "@@"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#riece")
- "#riece"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#riece@@localhost")
- "#riece localhost"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#ch@@@@nnel")
- "#ch@@nnel"))
- (lunit-assert-2
- case
- (equal
- (riece-alias-expand-alternate-separator "#ch@@@@nnel@@localhost")
- "#ch@@nnel localhost"))))
\ No newline at end of file
+++ /dev/null
-(require 'riece-cache)
-
-(luna-define-class test-riece-cache (lunit-test-case))
-
-(luna-define-method test-riece-cache-get-set ((case test-riece-cache))
- (let ((cache (riece-make-cache 3)))
- (riece-cache-set cache "0" 0)
- (lunit-assert-2
- case
- (= (riece-cache-get cache "0") 0))))
-
-(luna-define-method test-riece-cache-set-overflow ((case test-riece-cache))
- (let ((cache (riece-make-cache 3)))
- (riece-cache-set cache "0" 0)
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 1))
- (riece-cache-set cache "1" 1)
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 2))
- (riece-cache-set cache "2" 2)
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 3))
- (riece-cache-set cache "3" 3)
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 3))
- (lunit-assert-2
- case
- (null (riece-cache-get cache "0")))))
-
-(luna-define-method test-riece-cache-get-increase-key ((case test-riece-cache))
- (let ((cache (riece-make-cache 3)))
- (riece-cache-set cache "0" 0)
- (riece-cache-set cache "1" 1)
- (riece-cache-set cache "2" 2)
- (lunit-assert-2
- case
- (equal (riece-cache-node-key (riece-cache-first cache)) "0"))
- (lunit-assert-2
- case
- (equal (riece-cache-node-key (riece-cache-last cache)) "2"))
- (riece-cache-get cache "1")
- (lunit-assert-2
- case
- (equal (riece-cache-node-key (riece-cache-last cache)) "1"))))
-
-(luna-define-method test-riece-cache-delete ((case test-riece-cache))
- (let ((cache (riece-make-cache 3)))
- (riece-cache-set cache "0" 0)
- (riece-cache-set cache "1" 1)
- (riece-cache-set cache "2" 2)
- (riece-cache-delete cache "1")
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 2))
- (lunit-assert-2
- case
- (null (riece-cache-get cache "1")))
- (riece-cache-set cache "1" 1)
- (riece-cache-delete cache "0")
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 2))
- (lunit-assert-2
- case
- (null (riece-cache-get cache "0")))
- (riece-cache-set cache "0" 0)
- (riece-cache-delete cache "2")
- (lunit-assert-2
- case
- (= (riece-cache-hash-length cache) 2))
- (lunit-assert-2
- case
- (null (riece-cache-get cache "2")))))
+++ /dev/null
-(require 'riece-eval)
-
-(luna-define-class test-riece-eval (lunit-test-case))
-
-(luna-define-method test-riece-eval-string ((case test-riece-eval))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "\"abc\"")
- "abc"))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "(concat \"d\" \"e\" \"f\")")
- "def")))
-
-(luna-define-method test-riece-eval-list ((case test-riece-eval))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "'(a b c)")
- "(a b c)"))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "(cons 'd \"e\")")
- "(d . \"e\")")))
-
-(luna-define-method test-riece-eval-number ((case test-riece-eval))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "123")
- "123"))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "(+ 123 45.6)")
- "168.6")))
-
-(luna-define-method test-riece-eval-nil ((case test-riece-eval))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "nil")
- ""))
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "'()")
- "")))
-
-(luna-define-method test-riece-eval-error ((case test-riece-eval))
- (let (riece-eval-ignore-error symbol)
- (makunbound 'symbol)
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "symbol")
- "Error evaluating symbol: (void-variable symbol)"))
- (setq riece-eval-ignore-error t)
- (lunit-assert-2
- case
- (equal
- (riece-eval-form "symbol")
- nil))))
+++ /dev/null
-(require 'riece-log)
-
-(luna-define-class test-riece-log (lunit-test-case))
-
-(defun test-riece-log-delete-directory (directory)
- (let (file-name-coding-system
- default-file-name-coding-system
- (files (directory-files directory t nil t)))
- (while files
- (if (file-directory-p (car files))
- (unless (member (file-name-nondirectory (car files)) '("." ".."))
- (test-riece-log-delete-directory (car files)))
- (delete-file (car files)))
- (setq files (cdr files)))
- (delete-directory directory)))
-
-(luna-define-method lunit-test-case-setup ((case test-riece-log))
- (setq riece-log-directory
- (expand-file-name (make-temp-name "test-riece-log")
- (if (featurep 'xemacs)
- (temp-directory)
- temporary-file-directory))
- test-riece-log-directory
- (expand-file-name "=23riece" riece-log-directory))
- (make-directory riece-log-directory)
- (make-directory test-riece-log-directory)
- (write-region "03:14 <test> a b c\n03:15 <test> a b c\n" nil
- (expand-file-name "19700102.txt" test-riece-log-directory)
- t 0)
- (write-region "03:14 <test> 1 2 3\n" nil
- (expand-file-name "19700101.txt" test-riece-log-directory)
- t 0))
-
-(luna-define-method lunit-test-case-teardown ((case test-riece-log))
- (test-riece-log-delete-directory riece-log-directory))
-
-(luna-define-method test-riece-log-insert-1 ((case test-riece-log))
- (let (riece-log-directory-map)
- (lunit-assert-2
- case
- (equal
- (concat "03:14 <test> 1 2 3 (1970/01/01)\n"
- "03:14 <test> a b c (1970/01/02)\n"
- "03:15 <test> a b c (1970/01/02)\n")
- (with-temp-buffer
- (riece-log-insert (riece-make-identity "#riece" "") 3)
- (buffer-string))))))
-
-(luna-define-method test-riece-log-insert-2 ((case test-riece-log))
- (let (riece-log-directory-map)
- (lunit-assert-2
- case
- (equal ""
- (with-temp-buffer
- (riece-log-insert (riece-make-identity "#riece" "") t)
- (buffer-string))))))
-
-(luna-define-method test-riece-log-encode-file-name ((case test-riece-log))
- (let (riece-log-file-name-coding-system)
- (lunit-assert-2
- case
- (equal "=23riece"
- (riece-log-encode-file-name "#riece")))
- (lunit-assert-2
- case
- (equal "=23riece=3A=2A=2Ejp"
- (riece-log-encode-file-name "#riece:*.jp")))
- (lunit-assert-2
- case
- (equal "=23riece=="
- (riece-log-encode-file-name "#riece=")))))
-
-(luna-define-method test-riece-log-encode-file-name-mule
- ((case test-riece-log))
- (let ((riece-log-file-name-coding-system 'iso-8859-1))
- (lunit-assert-2
- case
- (equal "=23\xABriece\xBB"
- (riece-log-encode-file-name
- (format "#%criece%c"
- (make-char 'latin-iso8859-1 43)
- (make-char 'latin-iso8859-1 59))))))
- (let ((riece-log-file-name-coding-system 'iso-2022-jp))
- (lunit-assert-2
- case
- (equal "=23=1B=24B=24j=21=3C=249=1B=28B"
- (riece-log-encode-file-name
- (format "#%c%c%c"
- (make-char 'japanese-jisx0208 36 106)
- (make-char 'japanese-jisx0208 33 60)
- (make-char 'japanese-jisx0208 36 57)))))))
-
-(luna-define-method test-riece-log-decode-file-name ((case test-riece-log))
- (let (riece-log-file-name-coding-system)
- (lunit-assert-2
- case
- (equal "#riece"
- (riece-log-decode-file-name "=23riece")))
- (lunit-assert-2
- case
- (equal "#riece:*.jp"
- (riece-log-decode-file-name "=23riece=3A=2A=2Ejp")))
- (lunit-assert-2
- case
- (equal "#riece="
- (riece-log-decode-file-name "=23riece==")))))
-
-(luna-define-method test-riece-log-decode-file-name-mule
- ((case test-riece-log))
- (let ((riece-log-file-name-coding-system 'iso-8859-1))
- (lunit-assert-2
- case
- (equal (format "#%criece%c"
- (make-char 'latin-iso8859-1 43)
- (make-char 'latin-iso8859-1 59))
- (riece-log-decode-file-name
- "=23\xABriece\xBB"))))
- (let ((riece-log-file-name-coding-system 'iso-2022-jp))
- (lunit-assert-2
- case
- (equal (format "#%c%c%c"
- (make-char 'japanese-jisx0208 36 106)
- (make-char 'japanese-jisx0208 33 60)
- (make-char 'japanese-jisx0208 36 57))
- (riece-log-decode-file-name
- "=23=1B=24B=24j=21=3C=249=1B=28B")))))
-
-(luna-define-method test-riece-log-display-message-function
- ((case test-riece-log))
- (let ((riece-log-file-name-coding-system 'euc-jp)
- (riece-log-enabled t)
- riece-log-directory-map
- (riece-server-process-alist
- (list (cons "" (start-process "" (current-buffer) "true")))))
- (put 'riece-log 'riece-addon-enabled t)
- (riece-log-display-message-function
- (riece-make-message
- (riece-make-identity "ueno" "")
- (riece-make-identity (format "#%c%c%c"
- (make-char 'japanese-jisx0208 36 106)
- (make-char 'japanese-jisx0208 33 60)
- (make-char 'japanese-jisx0208 36 57))
- "")
- "a b c\n" nil t))
- (put 'riece-log 'riece-addon-enabled nil))
- (let (file-name-coding-system
- default-file-name-coding-system)
- (lunit-assert-2
- case
- (file-directory-p
- (expand-file-name
- (encode-coding-string
- (format "=23%c%c%c"
- (make-char 'japanese-jisx0208 36 106)
- (make-char 'japanese-jisx0208 33 60)
- (make-char 'japanese-jisx0208 36 57))
- 'euc-jp)
- riece-log-directory)))))
+++ /dev/null
-(require 'riece-ruby)
-
-(luna-define-class test-riece-ruby (lunit-test-case))
-
-(luna-define-method lunit-test-case-teardown ((case test-riece-ruby))
- (setq riece-ruby-output-handler-alist nil
- riece-ruby-output-queue-alist nil)
- (riece-ruby-execute "exit!")
- (sleep-for 1))
-
-(luna-define-method test-riece-ruby-execute-1 ((case test-riece-ruby))
- (lunit-assert-2
- case
- (equal (riece-ruby-execute "sleep 30") "0"))
- (lunit-assert-2
- case
- (equal (riece-ruby-execute "1 << 32") "1"))
- (lunit-assert-2
- case
- (equal (riece-ruby-execute "\"") "2")))
-
-(luna-define-method test-riece-ruby-inspect-1 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "sleep 30")))
- (lunit-assert-2
- case
- (eq (car (car (riece-ruby-inspect name))) 'OK))
- (lunit-assert-2
- case
- (assoc "running" (nth 2 (riece-ruby-inspect name))))))
-
-(luna-define-method test-riece-ruby-inspect-2 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "1 << 32")))
- (lunit-assert-2
- case
- (eq (car (car (riece-ruby-inspect name))) 'OK))
- (lunit-assert-2
- case
- (equal (nth 1 (riece-ruby-inspect name)) "4294967296"))
- (lunit-assert-2
- case
- (assoc "finished" (nth 2 (riece-ruby-inspect name))))))
-
-(luna-define-method test-riece-ruby-inspect-3 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "\"")))
- (lunit-assert-2
- case
- (eq (car (car (riece-ruby-inspect name))) 'OK))
- (lunit-assert-2
- case
- (equal (nth 1 (riece-ruby-inspect name))
- "unterminated string meets end of file"))
- (lunit-assert-2
- case
- (assoc "exited" (nth 2 (riece-ruby-inspect name))))))
-
-(luna-define-method test-riece-ruby-clear-1 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "sleep 30")))
- (riece-ruby-clear name)
- (lunit-assert-2
- case
- (eq (car (car (riece-ruby-inspect name))) 'ERR))
- (lunit-assert-2
- case
- (= (nth 1 (car (riece-ruby-inspect name))) 105))))
-
-(defvar test-riece-ruby-exit-handler-1 nil)
-(luna-define-method test-riece-ruby-exit-handler-1 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "1 << 32")))
- (riece-ruby-set-exit-handler
- name
- (lambda (name)
- (setq test-riece-ruby-exit-handler-1 name)))
- (sleep-for 1)
- (lunit-assert-2
- case
- (equal test-riece-ruby-exit-handler-1 name))))
-
-(defvar test-riece-ruby-output-handler-1 nil)
-(luna-define-method test-riece-ruby-output-handler-1 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "output(1 << 32)")))
- (riece-ruby-set-output-handler
- name
- (lambda (name output time)
- (setq test-riece-ruby-output-handler-1 output)))
- (sleep-for 1)
- (lunit-assert-2
- case
- (equal test-riece-ruby-output-handler-1 "4294967296"))))
-
-(defvar test-riece-ruby-output-handler-2 nil)
-(luna-define-method test-riece-ruby-output-handler-2 ((case test-riece-ruby))
- (let ((name (riece-ruby-execute "output(1 << 32)")))
- (sleep-for 1)
- (riece-ruby-set-output-handler
- name
- (lambda (name output time)
- (setq test-riece-ruby-output-handler-2 output)))
- (lunit-assert-2
- case
- (equal test-riece-ruby-output-handler-2 "4294967296"))))
+++ /dev/null
-(require 'riece-shrink-buffer)
-
-(luna-define-class test-riece-shrink-buffer (lunit-test-case))
-
-(luna-define-method test-riece-shrink-buffer ((case test-riece-shrink-buffer))
- (let* ((riece-max-buffer-size 255)
- (riece-shrink-buffer-remove-chars 128)
- (line (concat (make-string 15 ? ) "\n"))
- (index 0))
- (with-temp-buffer
- (while (< index 16)
- (insert line)
- (setq index (1+ index)))
- (riece-shrink-buffer (current-buffer))
- (lunit-assert-2
- case
- (equal
- (apply #'concat (make-list 8 line))
- (buffer-string))))))
+++ /dev/null
-(require 'riece-url)
-
-(luna-define-class test-riece-url (lunit-test-case))
-
-(luna-define-method test-riece-url-replace-match ((case test-riece-url))
- (with-temp-buffer
- (insert "111\n222\n333\n")
- (goto-char (point-min))
- (re-search-forward "2\\(2\\)2")
- (lunit-assert-2
- case
- (equal (save-match-data
- (riece-url-replace-match "\\&"))
- "222"))
- (lunit-assert-2
- case
- (equal (save-match-data
- (riece-url-replace-match "\\0"))
- "\\0"))
- (lunit-assert-2
- case
- (equal (save-match-data
- (riece-url-replace-match "\\1"))
- "2"))
- (lunit-assert-2
- case
- (equal (save-match-data
- (riece-url-replace-match "\\\\"))
- "\\"))))
-
-(luna-define-method test-riece-url-regexp-alist ((case test-riece-url))
- (with-temp-buffer
- (insert "Bug#12345\n")
- (let ((riece-url-regexp-alist
- '(("\\bBug#\\([0-9]+\\)\\b" .
- "http://bugs.debian.org/\\1")))
- riece-urls
- riece-addons)
- (riece-url-scan-region (point-min) (point-max))
- (lunit-assert-2
- case
- (member "http://bugs.debian.org/12345" riece-urls)))))
+++ /dev/null
-(require 'riece-yank)
-
-(luna-define-class test-riece-yank (lunit-test-case))
-
-(luna-define-method test-riece-yank-strip-space ((case test-riece-yank))
- (lunit-assert-2
- case
- (equal
- (riece-yank-strip-space "\
- def a
- 0.times do
- 0.times do
- p 1 # this line begins with a TAB
- end
- end
- end
-
-")
- "\
-def a
- 0.times do
- 0.times do
- p 1 # this line begins with a TAB
- end
- end
-end")))
+++ /dev/null
-;;; url-riece.el --- Adapting `riece' to `url-irc'
-;; Copyright (C) 2004 Masatake YAMATO
-
-;; Author: Masatake YAMATO <jet@gyve.org>
-;; Keywords: IRC, riece, url, comm, data, processes
-
-;; This program 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.
-
-;; This program 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., 51 Franklin Street, Fifth Floor,
-;; Boston, MA 02110-1301, USA.
-
-;;; Commentary:
-;;
-;; With this package you can opne an url which protocol is irc by
-;; riece via url package of GNU Emacs.
-;;
-;; e.g.
-;; (url-retrieve-synchronously "irc://irc.gnome.org:6667/#gtk+")
-;; (url-mm-url "irc://irc.gnome.org:6667/#gtk+")
-;;
-
-;;; Code:
-(require 'riece)
-(require 'url)
-(require 'url-irc)
-
-(defun url-irc-riece-ready-p ()
- "Riece is active or not.
-\(If it is active, a server named \"\" may exists.)"
- (and (boundp 'riece-server-process-alist)
- riece-server-process-alist))
-
-;; Based on the code posted to liece ml by Daiki Ueno <ueno@unixuser.org>
-;; Message-Id: <612cb699-83c0-47ad-a991-423c46bc8384@well-done.deisui.org>
-(defun url-irc-riece-find-server (host &optional port)
- "Find an entry for HOST:PORT in `riece-server-process-alist'."
- (unless port (setq port 6667))
- (catch 'found
- (let (name name-sans-service plist)
- (mapc (lambda (pointer)
- (setq name (car pointer)
- name-sans-service (plist-get
- (riece-server-name-to-server name)
- :host)
- plist (if (equal name "")
- riece-server
- (cdr (or (assoc name riece-server-alist)
- (assoc name-sans-service riece-server-alist)))))
- (when (and plist
- (equal (plist-get plist :host) host)
- (eq (or (plist-get plist :service) 6667) port))
- (throw 'found pointer)))
- riece-server-process-alist)
- nil)))
-;(url-irc-riece-find-server "localhost")
-;(url-irc-riece-find-server "localhost" 6667)
-;(url-irc-riece-find-server "irc.gnome.org")
-
-(defun url-irc-riece (host port channel user password)
- "Adapting `riece' to `url-irc'.
-See the documentation of `url-irc-function'about HOST, PORT, CHANNEL, USER
-and PASSWORD. Just give nil to it."
- (unless user (setq user riece-nickname))
- (let ((server (if port (format "%s:%d" host port) host)))
- (cond
- ((not (url-irc-riece-ready-p))
- (setq riece-server server)
- (let ((riece-default-password password)
- (riece-nickname user))
- ;; Just start riece
- (riece))
- (url-irc-riece host port channel user password))
- ((not (url-irc-riece-find-server host port))
- (let ((riece-default-password password)
- (riece-nickname user))
- ;; Just open the server
- (riece-command-open-server server))
- (url-irc-riece host port channel user password))
- (t
- (let ((server-name (car (url-irc-riece-find-server host port))))
- (riece-command-join
- (riece-parse-identity (if (string= server-name "")
- channel
- (format "%s %s" channel server-name)))))
- ;; Show the windows
- (riece)))))
-; (url-irc-riece "localhost" nil "#mandara" "jetgx" nil)
-; (url-irc-riece "localhost" nil "#misc" "jetgx" nil)
-; (url-irc-riece "irc.gnome.org" nil "#mandara" "jetgx" nil)
-; (url-irc-riece "irc.gnome.org" nil "#misc" "jetgx" nil)
-
-(setq url-irc-function 'url-irc-riece)
-
-(provide 'url-riece)
-
-;; arch-tag: b54bcdf0-0ee3-447b-bc07-e7329d9f2f45
-;;; url-riece.el ends here
+++ /dev/null
-(riece
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority high
- category CATEGORY
- dump nil
- description "IRC (Internet Relay Chat) client for Emacs."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (riece-compat riece-xemacs riece-globals riece-options riece-debug riece-version riece-coding riece-complete riece-addon-modules riece-addon riece-ruby riece-cache riece-mode riece-identity riece-channel riece-user riece-misc riece-signal riece-layout riece-display riece-server riece-naming riece-message riece-filter riece-handle riece-000 riece-200 riece-300 riece-400 riece-500 riece-commands riece-irc riece riece-alias riece-async riece-biff riece-button riece-ctcp riece-ctlseq riece-doctor riece-eval-ruby riece-eval riece-foolproof riece-google riece-guess riece-hangman riece-highlight riece-history riece-icon riece-ignore riece-kakasi riece-keepalive riece-keyword riece-log riece-lsdb riece-menu riece-mini riece-rdcc riece-shrink-buffer riece-skk-kakutei riece-toolbar riece-unread riece-url riece-xface riece-xfaceb riece-yank)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2003-09-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try
- to build custom-loads, this package doesn't have any.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2000-10-05 Martin Buchholz <martin@xemacs.org>
-
- * *: Mega typo fix.
-
-1998-07-25 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: removed.
-
-1998-07-18 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Elimination of Lisp read-time macros.
-
-1998-01-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (VERSION): Update to package standard 1.0.
- * package-info.in: Ditto.
-
-1998-01-11 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (VERSION): Update to newer package interface.
-
-1998-01-04 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: New file from standard dumped-lisp.el.
-
-1997-12-21 SL Baur <steve@altair.xemacs.org>
-
- * Makefile: Created.
-
+++ /dev/null
-# Makefile for tooltalk lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.17
-AUTHOR_VERSION =
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
-PACKAGE = tooltalk
-PKG_TYPE = regular
-REQUIRES =
-CATEGORY = standard
-
-ELCS = tooltalk-init.elc tooltalk-macros.elc tooltalk-util.elc
-
-include ../../XEmacs.rules
+++ /dev/null
-# @(#)Makefile 1.4 94/04/19
-
-EMACS=../../src/xemacs
-
-TOOLTALK.el = tooltalk-macros.el tooltalk-init.el tooltalk-util.el
-TOOLTALK.elc = $(TOOLTALK.el:.el=.elc)
-
-all: $(TOOLTALK.elc)
-
-.INIT: tooltalk-load.el $(TOOLTALK.el)
-
-.SUFFIXES: .elc .el
-
-.el.elc:
- $(EMACS) -batch -q -f batch-byte-compile $(@:.elc=.el)
-
-clean:
- $(RM) $(TOOLTALK.elc)
+++ /dev/null
-(tooltalk
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority low
- category CATEGORY
- dump nil
- description "Support for building with Tooltalk."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides ()
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-;;; -*- Mode: Emacs-Lisp -*-
-;;;
-;;; Registration of the default Tooltalk patterns and handlers.
-;;;
-;;; @(#)tooltalk-init.el 1.8 94/02/22
-
-
-(defvar tooltalk-eval-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "emacs-eval"
- callback tooltalk-eval-handler))
-
-(defvar tooltalk-load-file-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "emacs-load-file"
- args ((TT_IN "file" "string"))
- callback tooltalk-load-file-handler))
-
-(defvar tooltalk-make-client-frame-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "emacs-make-client-screen"
- callback tooltalk-make-client-frame-handler))
-
-(defvar tooltalk-status-pattern
- '(category TT_HANDLE
- scope TT_SESSION
- op "emacs-status"
- callback tooltalk-status-handler))
-
-
-(defvar initial-tooltalk-patterns ())
-
-(defun dispatch-initial-tooltalk-message (m)
- (let ((op (get-tooltalk-message-attribute m 'op))
- (patterns initial-tooltalk-patterns))
- (if (stringp op)
- (while patterns
- (let ((p (car patterns)))
- (if (eq (intern op) (tooltalk-pattern-prop-get p 'opsym))
- (let ((callback (tooltalk-pattern-prop-get p 'callback)))
- (if callback (funcall callback m p))
- (setq patterns '()))
- (setq patterns (cdr patterns))))))))
-
-(defun make-initial-tooltalk-pattern (args)
- (let ((opcdr (cdr (memq 'op args)))
- (cbcdr (cdr (memq 'callback args))))
- (if (and (consp opcdr) (consp cbcdr))
- (let ((plist (list 'opsym (intern (car opcdr)) 'callback (car cbcdr))))
- (make-tooltalk-pattern (append args (list 'plist plist))))
- (make-tooltalk-pattern args))))
-
-(defun register-initial-tooltalk-patterns ()
- (mapcar #'register-tooltalk-pattern
- (setq initial-tooltalk-patterns
- (mapcar #'make-initial-tooltalk-pattern
- (list tooltalk-eval-pattern
- tooltalk-load-file-pattern
- tooltalk-make-client-frame-pattern
- tooltalk-status-pattern))))
- (add-hook 'tooltalk-unprocessed-message-hook 'dispatch-initial-tooltalk-message))
-
-
-(defun unregister-initial-tooltalk-patterns ()
- (mapcar 'destroy-tooltalk-pattern initial-tooltalk-patterns)
- (setq initial-tooltalk-patterns ())
- (remove-hook 'tooltalk-unprocessed-message-hook 'dispatch-initial-tooltalk-message))
-
-
-(defun tooltalk:prin1-to-string (form)
- "Like prin1-to-string except: if the string contains embedded nulls (unlikely
-but possible) then replace each one with \"\\000\"."
- (let ((string (prin1-to-string form)))
- (let ((parts '())
- index)
- (while (setq index (string-match "\0" string))
- (setq parts
- (apply 'list "\\000" (substring string 0 index) parts))
- (setq string (substring string (1+ index))))
- (if (not parts)
- string
- (setq parts (apply 'list string parts))
- (apply 'concat (nreverse parts))))))
-
-;; Backwards compatibility
-(fset 'tooltalk::prin1-to-string-carefully 'tooltalk:prin1-to-string)
-
-
-(defun tooltalk:read-from-string (str)
- "Like read-from-string except: an error is signalled if the entire
-string can't be parsed."
- (let ((res (read-from-string str)))
- (if (< (cdr res) (length str))
- (error "Parse of input string ended prematurely."
- str))
- (car res)))
-
-
-(defun tooltalk::eval-string (str)
- (let ((result (eval (car (read-from-string str)))))
- (tooltalk:prin1-to-string result)))
-
-
-(defun tooltalk-eval-handler (msg pat)
- (let ((str (get-tooltalk-message-attribute msg 'arg_val 0))
- (result-str nil)
- (failp t))
- (unwind-protect
- (cond
- ;; Assume That the emacs debugger will handle errors.
- ;; If the user throws from the debugger to the cleanup
- ;; form below, failp will remain t.
- (debug-on-error
- (setq result-str (tooltalk::eval-string str)
- failp nil))
-
- ;; If an error occurs as a result of evaluating
- ;; the string or printing the result, then we'll return
- ;; a string version of error-info.
- (t
- (condition-case error-info
- (setq result-str (tooltalk::eval-string str)
- failp nil)
- (error
- (let ((error-str (tooltalk:prin1-to-string error-info)))
- (setq result-str error-str
- failp t))))))
-
- ;; If we get to this point and result-str is still nil, the
- ;; user must have thrown out of the debugger
- (let ((reply-type (if failp 'fail 'reply))
- (reply-value (or result-str "(debugger exit)")))
- (set-tooltalk-message-attribute reply-value msg 'arg_val 0)
- (return-tooltalk-message msg reply-type)))))
-
-
-(defun tooltalk-make-client-frame-handler (m p)
- (let ((nargs (get-tooltalk-message-attribute m 'args_count)))
- (if (not (= 3 nargs))
- (progn
- (set-tooltalk-message-attribute "wrong number of arguments" m 'status_string)
- (return-tooltalk-message m 'fail))))
-
- ;; Note: relying on the fact that arg_ival is returned as a string
-
- (let* ((name (get-tooltalk-message-attribute m 'arg_val 0))
- (window (get-tooltalk-message-attribute m 'arg_ival 1))
- (args (list (cons 'name name) (cons 'window-id window)))
- (frame (make-frame args)))
- (set-tooltalk-message-attribute (frame-name frame) m 'arg_val 2)
- (return-tooltalk-message m 'reply)))
-
-
-
-(defun tooltalk-load-file-handler (m p)
- (let ((path (get-tooltalk-message-attribute m 'file)))
- (condition-case error-info
- (progn
- (load-file path)
- (return-tooltalk-message m 'reply))
- (error
- (let ((error-string (tooltalk:prin1-to-string error-info)))
- (set-tooltalk-message-attribute error-string m 'status_string)
- (return-tooltalk-message m 'fail))))))
-
-
-(defun tooltalk-status-handler (m p)
- (return-tooltalk-message m 'reply))
-
-\f
-;; Hack the command-line.
-
-(defun command-line-do-tooltalk (arg)
- "Connect to the ToolTalk server."
-; (setq command-line-args-left
-; (cdr (tooltalk-open-connection (cons (car command-line-args)
-; command-line-args-left))))
- (if (tooltalk-open-connection)
- (register-initial-tooltalk-patterns)
- (display-warning 'tooltalk "Warning: unable to connect to a ToolTalk server.")))
-
-(setq command-switch-alist
- (append command-switch-alist
- '(("-tooltalk" . command-line-do-tooltalk))))
-
-;; Add some selection converters.
-
-(defun xselect-convert-to-ttprocid (selection type value)
- (let* ((msg (create-tooltalk-message))
- (ttprocid (get-tooltalk-message-attribute msg 'sender)))
- (destroy-tooltalk-message msg)
- ttprocid
- ))
-
-(defun xselect-convert-to-ttsession (selection type value)
- (let* ((msg (create-tooltalk-message))
- (ttsession (get-tooltalk-message-attribute msg 'session)))
- (destroy-tooltalk-message msg)
- ttsession
- ))
-
-(if (boundp 'selection-converter-alist)
- (setq selection-converter-alist
- (append
- selection-converter-alist
- '((SPRO_PROCID . xselect-convert-to-ttprocid)
- (SPRO_SESSION . xselect-convert-to-ttsession)
- )))
- (setq selection-converter-alist
- '((SPRO_PROCID . xselect-convert-to-ttprocid)
- (SPRO_SESSION . xselect-convert-to-ttsession))))
-
+++ /dev/null
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Date: Wed Dec 16 17:40:58 1992
-;;; File: tooltalk-macros.el
-;;; Title: Useful macros for ToolTalk/elisp interface
-;;; SCCS: @(#)tooltalk-macros.el 1.5 21 Jan 1993 19:09:24
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defmacro destructuring-bind-tooltalk-message (variables
- args-count
- message
- &rest body)
- "
-arglist: (variables args-count message &rest body)
-
-Binds VARIABLES to the ARG_VALs and ARG_IVALs of MESSAGE,
-starting from N = 0, and executes BODY in that context.
-Binds actual number of message args to ARGS-COUNT.
-
-VARIABLES is a list of local variables to bind.
-Each item in VARIABLES is either nil, a symbol, or a list of the form:
-
- (symbol type)
-
-If the item is nil, the nth ARG_VAL or ARG_IVAL of MESSAGE is skipped.
-If the item is a symbol, the nth ARG_VAL of MESSAGE is bound.
-If the item is a list
- If type = \"int\" the nth ARG_IVAL of MESSAGE is bound,
- otherwise the nth ARG_VAL of MESSAGE is bound.
-
-If there are more items than actual arguments in MESSAGE, the extra
-items are bound to nil.
-
-For example,
-
-(destructuring-bind-tooltalk-message (a (b \"int\") nil d) foo msg
- x y z)
-
-expands to
-
-(let* ((foo (get-tooltalk-message-attribute msg 'args_count))
- (a (if (< 0 foo)
- (get-tooltalk-message-attribute msg 'arg_val 0)))
- (b (if (< 1 foo)
- (get-tooltalk-message-attribute msg 'arg_val 1)))
- (d (if (< 3 foo)
- (get-tooltalk-message-attribute msg 'arg_val 3))))
- x y z)
-
-See GET-TOOLTALK-MESSAGE-ATTRIBUTE for more information.
-"
- (let* ((var-list variables)
- (nargs args-count)
- (msg message)
- (n -1)
- var-item
- var
- type
- request
- bindings)
- (setq bindings (cons
- (list nargs
- (list
- 'get-tooltalk-message-attribute
- msg
- ''args_count))
- bindings))
- (while var-list
- (setq var-item (car var-list)
- var-list (cdr var-list))
- (if (eq 'nil var-item)
- (setq n (1+ n))
- (progn
- (if (listp var-item)
- (setq var (car var-item)
- type (car (cdr var-item)))
- (setq var var-item
- type "string"))
- (setq n (1+ n))
- (setq request (list
- 'get-tooltalk-message-attribute
- msg
- (if (equal "int" type)
- ''arg_ival
- ''arg_val)
- n))
- (setq bindings (cons
- (list var
- (list 'if
- (list '< n nargs)
- request))
- bindings)))))
- (nconc (list 'let* (nreverse bindings)) body)))
+++ /dev/null
-;;; -*- Mode: Emacs-Lisp -*-
-;;;
-;;; Emacs Tooltalk Utility Functions
-;;;
-;;; @(#)tooltalk-util.el 1.7 93/12/07
-
-
-(defun initialize-tooltalk-message-arg (msg n mode value vtype)
- "Initialize the Nth tooltalk message argument of MSG.
-A new argument is created if necessary. No attempt to distinguish
-between strings that contain binary data and ordinary strings is made;
-all non integer argument values are converted to a string (if not a
-string already) and loaded with tt_message_arg_val_set().
-Applications that need to put binary data into a ToolTalk message
-argument should initialize the argument with:
-
- (set-tooltalk-message-attribute bin-string msg 'arg_bval arg-n)"
- (let ((n-args-needed
- (- (1+ n) (get-tooltalk-message-attribute msg 'args_count))))
- (while (> n-args-needed 0)
- (add-tooltalk-message-arg msg mode vtype)
- (setq n-args-needed (1- n-args-needed))))
-
- (cond
- ((integerp value)
- (set-tooltalk-message-attribute value msg 'arg_ival n))
- ((stringp value)
- (set-tooltalk-message-attribute value msg 'arg_val n))
- (t
- (error "The value specified for msg %s argument %d, %s, must be a string or an integer"
- (prin1-to-string msg)
- n
- (prin1-to-string value)))))
-
-
-
-(defconst tooltalk-arg-mode-ids
- (list 'TT_IN 'TT_OUT 'TT_INOUT TT_IN TT_OUT TT_INOUT))
-
-(defun initialize-tooltalk-message/pattern-args (initfn msg args)
- "Apply INITFN to each the position mode value and type of
-each argument in the list. The value of INITFN should be either
-'initialize-tooltalk-message-arg or 'initialize-tooltalk-pattern-arg.
-See `make-tooltalk-message' for a description of how arguments are specified.
-We distinguish the short form for arguments, e.g. \"just-a-value\",
-from the long form by checking to see if the argument is a list whose
-car is one of the ToolTalk mode values like TT_INOUT."
- (let ((n 0))
- (while args
- (let* ((arg (car args))
- (long-form
- (and (consp arg)
- (member (car arg) tooltalk-arg-mode-ids)))
- (mode
- (if long-form (car arg) TT_IN))
- (value
- (cond
- ((not long-form) arg)
- ((cdr arg) (car (cdr arg)))
- (t "")))
- (type
- (cond
- ((and long-form
- (cdr (cdr arg))
- (stringp (car (cdr (cdr arg)))))
- (car (cdr (cdr arg))))
- ((integerp value) "int")
- (t "string"))))
- (funcall initfn msg n mode value type))
- (setq args (cdr args))
- (setq n (1+ n)))))
-
-
-(defun initialize-tooltalk-message-attributes (msg attributes)
- "Initialize the tooltalk message attributes. The value of
-attributes must be a property list in the same form as for
-make-tooltalk-message. This function can be used to reset
-an existing message or to initialize a new one. See
-initialize-tooltalk-message-args for a description of how
-arguments are initialized."
- (let ((args attributes)
- (initfn 'initialize-tooltalk-message-arg))
- (while (and args (cdr args))
- (let ((indicator (car args))
- (value (car (cdr args))))
- (if (eq indicator 'args)
- (initialize-tooltalk-message/pattern-args initfn msg value)
- (set-tooltalk-message-attribute value msg indicator)))
- (setq args (cdr (cdr args))))))
-
-
-(defun make-tooltalk-message (attributes &optional no-callback)
- "Create a tooltalk message and initialize its attributes.
-The value of attributes must be a list of alternating keyword/values,
-where keywords are symbols that name valid message attributes.
-For example:
-
- (make-tooltalk-message
- '(class TT_NOTICE
- scope TT_SESSION
- address TT_PROCEDURE
- op \"do-something\"
- args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
-
-Values must always be strings, integers, or symbols that
-represent Tooltalk constants. Attribute names are the same as
-those supported by set-tooltalk-message-attribute, plus 'args.
-
-The value of args should be a list of message arguments where
-each message argument has the following form:
-
- (mode [value [type]]) or just value
-
-Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.
-If type isn't specified then \"int\" is used if the value is a
-number otherwise \"string\" is used. If only a value is specified
-then mode defaults to TT_IN. If mode is TT_OUT then value and
-type don't need to be specified. You can find out more about the
-semantics and uses of ToolTalk message arguments in chapter 4 of the
-Tooltalk Programmer's Guide.
-
-The no-callback arg is a hack to prevent the registration of the
-C-level callback. This hack is needed by the current SPARCworks
-tool startup mechanism. Yucko."
- (let ((msg (create-tooltalk-message no-callback)))
- (initialize-tooltalk-message-attributes msg attributes)
- msg))
-
-
-(defun describe-tooltalk-message (msg &optional stream)
- "Print tooltalk message MSG's attributes and arguments to STREAM.
-This is often useful for debugging."
- (let ((attrs
- '(address
- class
- disposition
- file
- gid
- handler
- handler_ptype
- object
- op
- opnum
- otype
- scope
- sender
- sender_ptype
- session
- state
- status
- status_string
- uid
- callback)))
- (terpri stream)
- (while attrs
- (princ (car attrs) stream)
- (princ " " stream)
- (prin1 (get-tooltalk-message-attribute msg (car attrs)) stream)
- (terpri stream)
- (setq attrs (cdr attrs))))
-
- (let ((n (get-tooltalk-message-attribute msg 'args_count))
- (i 0))
- (while (< i n)
- (princ "Argument " stream)
- (princ i stream)
- (princ " " stream)
- (let ((type (get-tooltalk-message-attribute msg 'arg_type i)))
- (princ
- (prin1-to-string
- (list
- (get-tooltalk-message-attribute msg 'arg_mode i)
- (if (equal type "int")
- (get-tooltalk-message-attribute msg 'arg_ival i)
- (get-tooltalk-message-attribute msg 'arg_val i))
- type))
- stream))
- (terpri stream)
- (setq i (1+ i)))))
-
-
-(defun initialize-tooltalk-pattern-arg (pat n mode value vtype)
- "Add one argument to tooltalk pattern PAT.
-No support for specifying pattern arguments whose value is a vector
-of binary data is provided."
- (let ((converted-value
- (if (or (integerp value) (stringp value))
- value
- (prin1-to-string value))))
- (add-tooltalk-pattern-arg pat mode vtype converted-value)))
-
-
-(defun initialize-tooltalk-pattern-attributes (pat attributes)
- "Initialize tooltalk pattern PAT's attributes.
-ATTRIBUTES must be a property list in the same form as for
-`make-tooltalk-pattern'. The value of each attribute (except 'category)
-can either be a single value or a list of values. If a list of
-values is provided then the pattern will match messages with
-a corresponding attribute that matches any member of the list.
-
-This function can be used to add attribute values to an existing
-pattern or to initialize a new one. See
-`initialize-tooltalk-message/pattern-args' for a description of how
-arguments are initialized."
- (let ((args attributes)
- (initfn 'initialize-tooltalk-pattern-arg))
- (while (and args (cdr args))
- (let ((indicator (car args))
- (value (car (cdr args))))
- (cond
- ((eq indicator 'args)
- (initialize-tooltalk-message/pattern-args initfn pat value))
- ((eq indicator 'plist)
- (let ((values value))
- (while values
- (let ((prop (car values))
- (propval (car (cdr values))))
- (tooltalk-pattern-prop-set pat prop propval))
- (setq values (cdr (cdr values))))))
- ((consp value)
- (let ((values value))
- (while values
- (add-tooltalk-pattern-attribute (car values) pat indicator)
- (setq values (cdr values)))))
- (t
- (add-tooltalk-pattern-attribute value pat indicator))))
- (setq args (cdr (cdr args))))))
-
-
-
-(defun make-tooltalk-pattern (attributes)
- "Create a tooltalk pattern and initialize its attributes.
-The value of attributes must be a list of alternating keyword/values,
-where keywords are symbols that name valid pattern attributes
-or lists of valid attributes. For example:
-
- (make-tooltalk-pattern
- '(category TT_OBSERVE
- scope TT_SESSION
- op (\"operation1\" \"operation2\")
- args (\"arg1\" 12345 (TT_INOUT \"arg3\" \"string\"))))
-
-
-Values must always be strings, integers, or symbols that
-represent Tooltalk constants or lists of same. When a list
-of values is provided all of the list elements are added to
-the attribute. In the example above, messages whose op
-attribute is \"operation1\" or \"operation2\" would match the pattern.
-
-The value of args should be a list of pattern arguments where
-each pattern argument has the following form:
-
- (mode [value [type]]) or just value
-
-Where mode is one of TT_IN, TT_OUT, TT_INOUT and type is a string.
-If type isn't specified then \"int\" is used if the value is a
-number otherwise \"string\" is used. If only a value is specified
-then mode defaults to TT_IN. If mode is TT_OUT then value and type
-don't need to be specified. You can find out more about the semantics
-and uses of ToolTalk pattern arguments in chapter 3 of the Tooltalk
-Programmers Guide.
-"
- (let ((pat (create-tooltalk-pattern)))
- (initialize-tooltalk-pattern-attributes pat attributes)
- pat))
-
-
-
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.24 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.23 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * .hgignore: New file.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.22 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try
- to build custom-loads, this package doesn't have any.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile:
- Delete explicit compile:: and binkit: rules.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2002-06-04 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.21 released.
-
-2002-06-02 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.20 released.
-
-2002-05-31 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.19 released.
-
-2002-05-25 Steve Youngs <youngs@xemacs.org>
-
- * package-info.in (provides): Use "vc-cc" not "vc".
-
-2001-12-10 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (ELCS): Remove tq.elc, moved to xemacs-base.
-
-2001-10-16 Michael Diers <mdiers@elego.de>
-
- * vc.el (vc-cleardiff-command): Add new defvar.
- (vc-backend-diff): Use vc-cleardiff-command if non-nil. This
- change allows specification of an alternate diff command, yet
- retains the default behaviour of using cleartool.
-
-2001-06-21 Ben Wing <ben@xemacs.org>
-
- * Makefile (ELCS): Compile the newly named files, not the old ones.
-
-2001-06-19 Ben Wing <ben@xemacs.org>
-
- * vc-cc-hooks.el: Renamed from vc-hooks.el.
- * vc-cc.el: Renamed from vc.el.
- Removed all autoloads from these files and renamed them, so that
- there will be no more conflict with vc. Changed provides and
- requires in these files accordingly. Added a messages about
- how you need to explicitly load vc-cc if you want it.
-
-2000-06-20 Raymond Toy <toy@rtp.ericsson.se>
-
- * vc-hooks.el (vc-consult-headers): Add new defvar.
- (vc-consult-rcs-headers): Add new function, stolen from
- vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
- vc-cc.
- (vc-workfile-version): Add new function, stolen from
- vc/vc-hooks.el, and changed vc-backend to vc-backend-deduce for
- vc-cc.
-
-1998-12-09 SL Baur <steve@altair.xemacs.org>
-
- * vc-hooks.el (toplevel): Guard against no menubars.
-
-1998-07-24 Peter Windle <peterw@ugsolutions.com>
-
- * vc.el (vc-backend-checkout): Use vc-checkout-switches when
- checking out. Clean up comment with vc-cleanup-comment; this was
- previously done on checkin only.
-
-1998-07-23 SL Baur <steve@altair.xemacs.org>
-
- * vc-hooks.el: Guard against menu-bar-final-items not being bound.
-
-1998-07-18 SL Baur <steve@altair.xemacs.org>
-
- * dumped-lisp.el: Removed.
-
-1998-06-30 Raymond Toy <toy@rtp.ericsson.se>
-
- * vc.el (vc-cleartool-program): Added defvar vc-cleartool-program
- to hold the pathname of where cleartool is. Changed all
- references to "/usr/atria/bin/cleartool" to vc-cleartool-program.
-
-1998-01-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile (VERSION): Update to package standard 1.0.
- * package-info.in: Ditto.
-
-1998-01-12 SL Baur <steve@altair.xemacs.org>
-
- * Makefile: Update to newer package interface.
-
-1997-12-24 SL Baur <steve@altair.xemacs.org>
-
- * Makefile: Created.
+++ /dev/null
-# Makefile for VC with ClearCase lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-# NOTE: This package is incompatible with the regular `vc' package.
-
-VERSION = 1.24
-AUTHOR_VERSION =
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
-PACKAGE = vc-cc
-PKG_TYPE = regular
-REQUIRES = dired xemacs-base
-CATEGORY = standard
-
-ELCS = vc-cc-hooks.elc vc-cc.elc
-
-include ../../XEmacs.rules
+++ /dev/null
-(vc-cc
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority low
- category CATEGORY
- dump nil
- description "Version Control for ClearCase (UnFree) systems."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (vc-cc vc-cc-hooks)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-;;; vc-cc-hooks.el --- support for vc-cc.el, formerly resident
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: ttn@netcom.com
-;; Version: 5.3 + CVS hacks by ceder@lysator.liu.se made in Jan-Feb 1994.
-;;
-;; XEmacs fixes, CVS fixes, and general improvements
-;; by Jonathan Stigelman <Stig@hackvan.com>
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: FSF 19.28.
-
-;;; Commentary:
-
-;; This is like vc-hooks.el, but for vc-cc. See the commentary of
-;; vc-hooks.el and vc-cc.el.
-
-;;; Code:
-
-(eval-and-compile
- (require 'advice))
-
-;; Using defconst only because we may have already loaded another version of
-;; this library!
-(defconst vc-master-templates
- '(("%sRCS/%s,v" . RCS) ("%s%s,v" . RCS) ("%sRCS/%s" . RCS)
- ("%sSCCS/s.%s" . SCCS) ("%ss.%s". SCCS)
- vc-cc-registered
- vc-find-cvs-master)
- "*Where to look for version-control master files.
-The first pair corresponding to a given back end is used as a template
-when creating new masters.")
-
-(defconst ClearCase "@@")
-
-(defvar vc-path
- (if (file-exists-p "/usr/sccs")
- '("/usr/sccs") nil)
- "*List of extra directories to search for version control commands.")
-
-(defvar vc-make-backup-files nil
- "*If non-nil, backups of registered files are made as with other files.
-If nil (the default), files covered by version control don't get backups.")
-
-(defvar vc-follow-symlinks 'ask
- "*Indicates what to do if you visit a symbolic link to a file
-that is under version control. Editing such a file through the
-link bypasses the version control system, which is dangerous and
-probably not what you want.
- If this variable is t, VC follows the link and visits the real file,
-telling you about it in the echo area. If it is `ask', VC asks for
-confirmation whether it should follow the link. If nil, the link is
-visited and a warning displayed.")
-
-(defvar vc-display-status t
- "*If non-nil, display revision number and lock status in modeline.
-Otherwise, not displayed.")
-
-(defvar vc-cc-display-branch t
- "*If non-nil, full branch name of ClearCase working file displayed in modeline.
-Otherwise, just the version number or label is displayed.")
-
-(defvar vc-auto-dired-mode t
- "*If non-nil, automatically enter `vc-dired-mode' in dired-mode buffers where
-version control is set-up.")
-
-(defvar vc-cc-pwv nil ;; (getenv "CLEARCASE_ROOT")
- "The ClearCase present working view for the current buffer.")
-(make-variable-buffer-local 'vc-cc-pwv)
-
-(defvar vc-consult-headers t
- "*If non-nil, identify work files by searching for version headers.")
-
-(defconst vc-elucidated (string-match "Lucid" emacs-version))
-
-;; Tell Emacs about this new kind of minor mode
-(if (not (assoc 'vc-mode minor-mode-alist))
- (setq minor-mode-alist (cons '(vc-mode vc-mode)
- minor-mode-alist)))
-;; We don't really need to have the toggling feature provided by this command,
-;; so in deference to FSF Emacs, I won't use it.
-;;(add-minor-mode 'vc-mode 'vc-mode)
-
-(defvar vc-mode nil) ; used for modeline flag
-(make-variable-buffer-local 'vc-mode)
-(set-default 'vc-mode nil)
-(put 'vc-mode 'permanent-local t)
-
-(defvar vc-dired-mode nil)
-(make-variable-buffer-local 'vc-dired-mode)
-
-;; We need a notion of per-file properties because the version
-;; control state of a file is expensive to derive --- we don't
-;; want to recompute it even on every find.
-
-(defmacro vc-error-occurred (&rest body)
- (list 'condition-case nil (cons 'progn (append body '(nil))) '(error t)))
-
-(defvar vc-file-prop-obarray (make-vector 17 0)
- "Obarray for per-file properties.")
-
-(defun vc-file-setprop (file property value)
- ;; set per-file property
- (put (intern file vc-file-prop-obarray) property value))
-
-(defun vc-file-getprop (file property)
- ;; get per-file property
- (get (intern file vc-file-prop-obarray) property))
-
-(defun vc-file-clearprops (file)
- ;; clear all properties of a given file
- (setplist (intern file vc-file-prop-obarray) nil))
-
-;;; actual version-control code starts here
-
-(defun vc-registered (file)
- (let (handler)
- (if (boundp 'file-name-handler-alist)
- (setq handler (find-file-name-handler file 'vc-registered)))
- (if handler
- (funcall handler 'vc-registered file)
- ;; Search for a master corresponding to the given file
- (let ((dirname (or (file-name-directory file) ""))
- (basename (file-name-nondirectory file)))
- (catch 'found
- (mapcar
- (function
- (lambda (s)
- (if (atom s)
- (funcall s dirname basename)
- (let ((trial (format (car s) dirname basename)))
- (if (and (file-exists-p trial)
- ;; This ensures that directories are not considered
- ;; to be registered files (this happens with the
- ;; third RCS pattern in vc-master-templates).
- (not (equal basename ""))
- ;; Make sure the file we found with name
- ;; TRIAL is not the source file itself.
- ;; That can happen with RCS-style names
- ;; if the file name is truncated
- ;; (e.g. to 14 chars). See if either
- ;; directory or attributes differ.
- (or (not (string= dirname
- (file-name-directory trial)))
- (not (equal
- (file-attributes file)
- (file-attributes trial)))))
- (throw 'found (cons trial (cdr s))))))))
- vc-master-templates)
- nil)))))
-
-(defun vc-cc-registered (dirname basename)
- ;; Check if DIRNAME/BASENAME is a ClearCase element
- ;; If it is, do a (throw 'found (cons MASTER '@@)).
- ;; Use general purpose function for real check
- ;; This should only be used in vc-master-template.
- (let ((fullname (concat dirname basename)))
- ;; If this is a symlink to a ClearCase file, it will think that it is
- ;; under control, but won't be able to get all information with
- ;; vc-fetch-properties. We should leave it up to the user to chase the
- ;; link, or simply not edit the file through the link.
- (if (and (not (file-symlink-p fullname))
- (clearcase-element-p fullname))
- (throw 'found (cons fullname '@@))))
- )
-
-(defun vc-find-cvs-master (dirname basename)
- ;; Check if DIRNAME/BASENAME is handled by CVS.
- ;; If it is, do a (throw 'found (cons MASTER 'CVS)).
- ;; Note: If the file is ``cvs add''ed but not yet ``cvs commit''ed
- ;; the MASTER will not actually exist yet. The other parts of VC
- ;; checks for this condition. This function returns something random if
- ;; DIRNAME/BASENAME is not handled by CVS.
- ;; This should only be used in vc-master-template.
- (and (string= "" dirname) (setq dirname default-directory))
- (if (and (file-directory-p (concat dirname "CVS/"))
- (file-readable-p (concat dirname "CVS/Entries")))
- (let ((fname (concat dirname basename))
- sbuf rev)
- (unwind-protect
- (save-excursion
- (set-buffer (generate-new-buffer " vc-scratch"))
- (setq sbuf (current-buffer))
- (insert-file-contents (concat dirname "CVS/Entries"))
- (cond
- ((re-search-forward
- (concat "^/" (regexp-quote basename) "/\\([0-9.]*\\)/.*/\\(T\\([^/\n]+\\)\\)?$")
- nil t)
- ;; We found it. Store version number, and branch tag
- (setq rev (buffer-substring (match-beginning 1)
- (match-end 1)))
- (vc-file-setprop fname 'vc-your-latest-version rev)
- ;; XEmacs - we put something useful in the modeline
- (vc-file-setprop fname 'sticky-tag
- (cond ((string= "0" rev) "newfile")
- ((match-beginning 3)
- (buffer-substring (match-beginning 3)
- (match-end 3)))
- (t "main")))
- (erase-buffer)
- (insert-file-contents (concat dirname "CVS/Repository"))
- (let ((master
- (concat (file-name-as-directory
- (buffer-substring (point-min)
- (1- (point-max))))
- basename
- ",v")))
- (throw 'found (cons master 'CVS))))))
- (kill-buffer sbuf)))))
-
-(defun vc-name (file)
- "Return the master name of a file, nil if it is not registered."
- (or (vc-file-getprop file 'vc-name)
- (let ((name-and-type (vc-registered file)))
- (if name-and-type
- (progn
- (vc-file-setprop file 'vc-backend (cdr name-and-type))
- (vc-file-setprop file 'vc-name (car name-and-type)))))))
-
-(defun vc-backend-deduce (file)
- "Return the version-control type of a file, nil if it is not registered."
- (and file
- (or (vc-file-getprop file 'vc-backend)
- (let ((name-and-type (vc-registered file)))
- (if name-and-type
- (progn
- (vc-file-setprop file 'vc-name (car name-and-type))
- (vc-file-setprop file 'vc-backend (cdr name-and-type))))))))
-
-(defun vc-toggle-read-only (&optional verbose)
- "Change read-only status of current buffer, perhaps via version control.
-If the buffer is visiting a file registered with a form of version control
-that locks files by making them read-only (i.e.: not CVS), then check the
-file in or out. Otherwise, just change the read-only flag of the buffer.
-
-If you provide a prefix argument, we pass it on to `vc-next-action'."
- (interactive "P")
- (let ((vc-type (vc-backend-deduce (buffer-file-name))))
- (cond ((and vc-type
- buffer-read-only
- (file-writable-p buffer-file-name)
- (/= 0 (user-uid)))
- ;; XEmacs - The buffer isn't read-only because it's locked, so
- ;; keep vc out of this...
- (toggle-read-only))
- ((and vc-type (not (eq 'CVS vc-type)))
- (vc-next-action verbose))
- (t
- (toggle-read-only)))
- ))
-
-;; Map the vc-toggle-read-only key whereever toggle-read-only was
-(let ((where (where-is-internal 'toggle-read-only global-map)))
- (if where
- (mapcar (lambda (key)
- (define-key global-map
- key 'vc-toggle-read-only))
- where))
- )
-;;(define-key global-map "\C-x\C-q" 'vc-toggle-read-only)
-
-;; For other cases, try advising...
-(defadvice toggle-read-only (around vc activate)
- "If file is under version control, perform `vc-next-action'."
- (if vc-mode
- (let ((vc-type (vc-backend-deduce (buffer-file-name))))
- (cond ((and vc-type
- buffer-read-only
- (file-writable-p buffer-file-name)
- (/= 0 (user-uid)))
- ;; XEmacs - The buffer isn't read-only because it's locked, so
- ;; keep vc out of this...
- ad-do-it)
- ((and vc-type (not (eq 'CVS vc-type)))
- (vc-next-action (ad-get-arg 0)))
- (t ad-do-it))
- )
- ad-do-it
- ))
-
-(defun vc-file-owner (file)
- ;; XEmacs - vc-locking-user is just WAY too slow.
- (let* ((fa (file-attributes file)))
- (cond ((eq ?w (aref (nth 8 fa) 2)) ; -rw-r--r--
- ;; #### - if it's writable, we trust unix...dumb move?
- (user-login-name (nth 2 fa)))
- (t
- ;; big slowness here...
- (require 'vc)
- (vc-locking-user file)
- ))))
-
-(defun vc-mode-line (file &optional label)
- "Set `vc-mode' to display type of version control for FILE.
-The value is set in the current buffer, which should be the buffer
-visiting FILE. Second optional arg LABEL is put in place of version
-control system name."
- (interactive (list buffer-file-name nil))
- (if file
- (let ((vc-type (vc-backend-deduce file)))
- (setq vc-mode
- (if vc-type
- (concat " " (or label (symbol-name vc-type))
- (if vc-display-status
- (vc-status file vc-type)))))
- ;; Even root shouldn't modify a registered file without
- ;; locking it first.
- (and vc-type
- (not (string= (user-login-name) (vc-file-owner file)))
- (setq buffer-read-only t))
- (and (null vc-type)
- (file-symlink-p file)
- (let ((link-type (vc-backend-deduce (file-symlink-p file))))
- (if link-type
- (message
- "Warning: symbolic link to %s-controlled source file"
- link-type))))
- (redraw-modeline)
- ;;(set-buffer-modified-p (buffer-modified-p)) ;;use this if Emacs 18
- vc-type)))
-
-(defun vc-status (file vc-type)
- ;; Return string for placement in modeline by `vc-mode-line'.
- ;; If FILE is not registered, return nil.
- ;; If FILE is registered but not locked, return " REV" if there is a head
- ;; revision and " @@" otherwise.
- ;; If FILE is locked then return all locks in a string of the
- ;; form " LOCKER1:REV1 LOCKER2:REV2 ...", where "LOCKERi:" is empty if you
- ;; are the locker, and otherwise is the name of the locker followed by ":".
-
- ;; Algorithm:
-
- ;; Check for master file corresponding to FILE being visited.
- ;;
- ;; RCS: Insert the first few characters of the master file into a
- ;; work buffer. Search work buffer for "locks...;" phrase; if not
- ;; found, then keep inserting more characters until the phrase is
- ;; found. Extract the locks, and remove control characters
- ;; separating them, like newlines; the string " user1:revision1
- ;; user2:revision2 ..." is returned.
- ;;
- ;; SCCS: Check if the p-file exists. If it does, read it and
- ;; extract the locks, giving them the right format. Else use prs to
- ;; find the revision number.
- ;;
- ;; CVS: vc-find-cvs-master has already stored the current revision
- ;; number and sticky-tag for the file. XEmacs displays the sticky-tag.
-
- ;; Limitations:
-
- ;; The output doesn't show which version you are actually looking at.
- ;; The modeline can get quite cluttered when there are multiple locks.
- ;; The head revision is probably not what you want if you've used `rcs -b'.
-
- (let ((master (vc-name file))
- found
- status)
-
- ;; If master file exists, then parse its contents, otherwise we
- ;; return the nil value of this if form.
- (if (and master vc-type)
- (save-excursion
-
- ;; Create work buffer.
- (set-buffer (get-buffer-create " *vc-status*"))
- (setq buffer-read-only nil
- default-directory (file-name-directory master))
- (erase-buffer)
-
- ;; Set the `status' var to the return value.
- (cond
-
- ;; RCS code.
- ((eq vc-type 'RCS)
- ;; Check if we have enough of the header.
- ;; If not, then keep including more.
- (while
- (not (or found
- (let ((s (buffer-size)))
- (goto-char (1+ s))
- (zerop (car (cdr (insert-file-contents
- master nil s (+ s 8192))))))))
- (beginning-of-line)
- (setq found (re-search-forward "^locks\\([^;]*\\);" nil t)))
-
- (if found
- ;; Clean control characters and self-locks from text.
- (let* ((lock-pattern
- (concat "[ \b\t\n\v\f\r]+\\("
- (regexp-quote (user-login-name))
- ":\\)?"))
- (locks
- (save-restriction
- (narrow-to-region (match-beginning 1) (match-end 1))
- (goto-char (point-min))
- (while (re-search-forward lock-pattern nil t)
- (replace-match (if (eobp) "" ":") t t))
- (buffer-string))))
- (setq status
- (if (not (string-equal locks ""))
- locks
- (goto-char (point-min))
- (if (looking-at "head[ \b\t\n\v\f\r]+\\([.0-9]+\\)")
- (concat "-"
- (buffer-substring (match-beginning 1)
- (match-end 1)))
- " @@"))))))
-
- ;; SCCS code.
- ((eq vc-type 'SCCS)
- ;; Build the name of the p-file and put it in the work buffer.
- (insert master)
- (search-backward "/s.")
- (delete-char 2)
- (insert "/p")
- (if (not (file-exists-p (buffer-string)))
- ;; No lock.
- (let ((exec-path (if (boundp 'vc-path) (append exec-path vc-path)
- exec-path)))
- (erase-buffer)
- (insert "-")
- (if (zerop (call-process "prs" nil t nil "-d:I:" master))
- (setq status (buffer-substring 1 (1- (point-max))))))
- ;; Locks exist.
- (insert-file-contents (buffer-string) nil nil nil t)
- (while (looking-at "[^ ]+ \\([^ ]+\\) \\([^ ]+\\).*\n")
- (replace-match " \\2:\\1"))
- (setq status (buffer-string))
- (aset status 0 ?:)))
- ;; CVS code.
- ((eq vc-type 'CVS)
- ;; sticky-tag is initialized by vc-backend-deduce
- (setq status (concat ":" (vc-file-getprop file 'sticky-tag) "-"
- (vc-file-getprop file 'vc-your-latest-version)
- ))
- )
- ;; ClearCase code.
- ((eq vc-type '@@)
- (require 'vc)
- ;; Display the explicitly specified version or the latest version
- (let ((version (or (vc-cc-version-name file)
- (vc-latest-version file)
- ;; Make sure version is a string in case the
- ;; file is not really a versioned object
- "")))
- ;; Check if the user wants to see the branch
- (if vc-cc-display-branch
- (setq status version)
- (setq status (concat ":" (file-name-nondirectory version))))
- ))
- )
-
- ;; Clean work buffer.
- (erase-buffer)
- (set-buffer-modified-p nil)
- status))))
-
-;;;;; install a call to the above as a find-file hook
-
-(defun vc-follow-link ()
- ;; If the current buffer visits a symbolic link, this function makes it
- ;; visit the real file instead. If the real file is already visited in
- ;; another buffer, make that buffer current, and kill the buffer
- ;; that visits the link.
- (let* ((truename (abbreviate-file-name (file-chase-links buffer-file-name)))
- (true-buffer (find-buffer-visiting truename))
- (this-buffer (current-buffer)))
- (if (eq true-buffer this-buffer)
- (progn
- (kill-buffer this-buffer)
- ;; In principle, we could do something like set-visited-file-name.
- ;; However, it can't be exactly the same as set-visited-file-name.
- ;; I'm not going to work out the details right now. -- rms.
- (set-buffer (find-file-noselect truename)))
- (set-buffer true-buffer)
- (kill-buffer this-buffer))))
-
-(defun vc-set-auto-mode ()
- "Check again for the mode of the current buffer when using ClearCase version extended paths."
-
- (if (eq (vc-file-getprop buffer-file-name 'vc-backend) '@@)
- (let* ((version (vc-cc-version-name buffer-file-name))
- (buffer-file-name (vc-cc-element-name buffer-file-name)))
- ;; Need to recheck the major mode only if a version was appended
- (if version (set-auto-mode))
- ;; Set a buffer-local variable for the working view
- (setq vc-cc-pwv (vc-cc-pwv buffer-file-name))
- ))
- )
-
-(defun vc-find-file-hook ()
- ;; Recompute whether file is version controlled,
- ;; if user has killed the buffer and revisited.
- (cond
- (buffer-file-name
- (vc-file-clearprops buffer-file-name)
- (cond
- ((vc-backend-deduce buffer-file-name)
- (vc-mode-line buffer-file-name)
- (cond ((not vc-make-backup-files)
- ;; Use this variable, not make-backup-files,
- ;; because this is for things that depend on the file name.
- (make-local-variable 'backup-inhibited)
- (setq backup-inhibited t)))
- (vc-set-auto-mode))
- ((let* ((link (file-symlink-p buffer-file-name))
- (link-type (and link (vc-backend-deduce (file-chase-links link)))))
- (if link-type
- (cond ((null vc-follow-symlinks)
- (message
- "Warning: symbolic link to %s-controlled source file" link-type))
- ((or (not (eq vc-follow-symlinks 'ask))
- ;; If we already visited this file by following
- ;; the link, don't ask again if we try to visit
- ;; it again. GUD does that, and repeated questions
- ;; are painful.
- (let ((find-file-compare-truenames nil))
- ;; If compare-truenames is t, this will always be t
- (get-file-buffer
- (abbreviate-file-name (file-chase-links buffer-file-name)))))
-
- (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
- (t
- (if (yes-or-no-p
- (format
- "Symbolic link to %s-controlled source file; follow link? "
- link-type))
- (progn (vc-follow-link)
- (message "Followed link to %s" buffer-file-name)
- (vc-find-file-hook))
- (message
- "Warning: editing through the link bypasses version control")
- ))))
- (vc-set-auto-mode)))
- ))))
-
-;;; install a call to the above as a find-file hook
-(add-hook 'find-file-hooks 'vc-find-file-hook)
-
-;; Handle ClearCase version files correctly.
-;;
-;; This little bit of magic causes the buffer name to be set to
-;; <filename>@@/<branch path>/<version>, if you find a specific version of
-;; a file. Without this the name of the buffer will just be the version
-;; number.
-
-(defun vc-check-cc-name ()
- (let ((match (string-match "@@" default-directory)))
- (if match
- (progn
- (while (and (> match 0)
- (not (equal (elt default-directory match)
- (string-to-char "/"))))
- (setq match (1- match)))
-
-
- (let ((new-buffer-name
- (concat (substring default-directory (1+ match))
- (buffer-name)))
- (new-dir
- (substring default-directory 0 (1+ match))))
- (or (string= new-buffer-name (buffer-name))
- ;; Uniquify the name, if necessary.
- ;;
- (let ((n 2)
- (uniquifier-string ""))
- (while (get-buffer (concat new-buffer-name uniquifier-string))
- (setq uniquifier-string (format "<%d>" n))
- (setq n (1+ n)))
- (rename-buffer
- (concat new-buffer-name uniquifier-string))))
- (setq default-directory new-dir)))
- nil)))
-
-(add-hook 'find-file-hooks 'vc-check-cc-name)
-
-(defun vc-find-dir-hook ()
- ;; Recompute whether file is version controlled,
- ;; if user has killed the buffer and revisited.
- (vc-file-clearprops default-directory)
- (if default-directory
- (vc-file-setprop default-directory 'vc-backend nil))
-
- ;; Let dired decide whether the file should be read-only
- (let (buffer-read-only)
- (vc-mode-line default-directory))
-
- ;; If in vc-dired-mode, reformat the buffer
- (if vc-dired-mode
- (vc-reformat-dired-buffer)
- ;; Otherwise, check if we should automatically enter vc-dired-mode
- (let ((default-directory (dired-current-directory)))
- (if (and vc-auto-dired-mode
- (or vc-mode
- (file-directory-p "SCCS")
- (file-directory-p "RCS")
- (file-directory-p "CVS")))
- (vc-dired-mode 1))))
- )
-
-(add-hook 'dired-after-readin-hook 'vc-find-dir-hook)
-
-;;; more hooks, this time for file-not-found
-(defun vc-file-not-found-hook ()
- "When file is not found, try to check it out from RCS or SCCS.
-Returns t if checkout was successful, nil otherwise."
- (if (vc-backend-deduce buffer-file-name)
- (save-excursion
- (require 'vc)
- (not (vc-error-occurred (vc-checkout buffer-file-name))))))
-
-(add-hook 'find-file-not-found-hooks 'vc-file-not-found-hook)
-
-;;; Now arrange for bindings and autoloading of the main package.
-;;; Bindings for this have to go in the global map, as we'll often
-;;; want to call them from random buffers.
-
-(add-to-list 'file-name-handler-alist '("^/view/[^/]+/" . vc-cc-file-handler))
-(add-to-list 'file-name-handler-alist '("^/view[/]*$" . vc-cc-view-handler))
-
-; XEmacs - this is preloaded. let's not be obtuse!
-(defconst vc-prefix-map
- (let ((map (make-sparse-keymap)))
- (set-keymap-name map 'vc-prefix-map)
- (define-key map "a" 'vc-update-change-log)
- (define-key map "c" 'vc-cancel-version)
- (define-key map "d" 'vc-directory)
- (define-key map "h" 'vc-insert-headers)
- (define-key map "i" 'vc-register)
- (define-key map "l" 'vc-print-log)
- (define-key map "n" 'vc-assign-name)
- (define-key map "r" 'vc-retrieve-snapshot)
- (define-key map "s" 'vc-create-snapshot)
- (define-key map "u" 'vc-revert-buffer)
- (define-key map "v" 'vc-next-action)
- (define-key map "=" 'vc-diff)
- (define-key map "?" 'vc-file-status) ; XEmacs - this doesn't fit elsewhere
- (define-key map "~" 'vc-version-other-window)
- ;; ClearCase only stuff
- (define-key map "e" 'vc-edit-config)
- (define-key map "b" 'vc-cc-browse-versions)
- (define-key map "m" 'vc-mkbrtype)
- (define-key map "t" 'vc-graph-history)
- (define-key map "w" 'vc-cc-what-rule)
- (global-set-key "\C-xv" map)
- map
- ))
-
-;;; Emacs 19 menus.
-(if (and (not vc-elucidated) (boundp 'menu-bar-final-items))
- (progn
- (defvar menu-bar-vc-menu
- (make-sparse-keymap "VC"))
- (or (memq
- 'vc menu-bar-final-items)
- (setq menu-bar-final-items
- (cons
- 'vc menu-bar-final-items)))
- (define-key menu-bar-vc-menu [vc-report-bug]
- '("Report Bug in Clearcase VC" . cc-vc-submit-bug-report))
- (define-key menu-bar-vc-menu [vc-directory-registered]
- '("List Registered Files" . vc-directory-registered))
- (define-key menu-bar-vc-menu [vc-directory]
- '("List Locked Files Any User" . vc-directory))
- (define-key menu-bar-vc-menu [vc-directory-locked]
- '("List Locked Files" . vc-directory-locked))
- (put 'vc-print-log 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-print-log]
- '("Show Edit History" . vc-print-log))
- (put 'vc-version-other-window 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-version-other-window]
- '("Visit Previous Revision..." . vc-version-other-window))
- (put 'vc-diff-since-revision 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-diff-since-revision]
- '("Show Changes Since Revision..." . vc-diff-since-revision))
- (put 'vc-diff 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-diff]
- '("Show Changes" . vc-diff))
- (put 'vc-rename-this-file 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-rename-this-file]
- '("Rename File" . vc-rename-this-file))
- (put 'vc-revert-buffer 'menu-enable 'vc-mode)
- (define-key menu-bar-vc-menu [vc-revert-buffer]
- '("Revert File" . vc-revert-buffer))
- (define-key menu-bar-vc-menu [vc-update-directory]
- '("Update Current Directory" . vc-update-directory))
- (define-key menu-bar-vc-menu [next-action]
- '("Next Action" . vc-next-action))
- (define-key global-map [menu-bar vc]
- (cons "VC" menu-bar-vc-menu))))
-
-;;; Lucid Emacs menus..
-(defconst vc-default-menu
- '(:filter vc-menu-filter
- ["NEXT-OPERATION" vc-next-action t nil]
- ["Update Current Directory" vc-update-directory t]
- "----"
- ["Revert to Last Revision" vc-revert-buffer t nil]
- ["Cancel Last Checkin" vc-cancel-version t nil]
- ["Rename File" vc-rename-this-file t nil]
- "----"
- ["Diff Against Last Version" vc-diff t]
- ["Diff Between Revisions..." vc-diff-since-revision t]
- ["Visit Other Version..." vc-version-other-window t]
- ["Show Edit History" vc-print-log t]
- ["Assign Label..." vc-assign-name t]
- "----"
- ["List Locked Files" (progn
- (setq current-prefix-arg '(16))
- (call-interactively 'vc-directory)) t]
- ["List Locked Files Any User" vc-directory t]
- ["List Registered Files" (progn
- (setq current-prefix-arg '(4))
- (call-interactively 'vc-directory)) t])
- "Menubar entry for using the revision control system.")
-
-(defconst vc-cvs-menu
- '(:filter vc-menu-filter
- ["Update Current Directory" vc-cvs-update-directory t]
- ["Revert File" vc-revert-file t nil]
- "----"
- ["Show Changes" vc-show-changes t]
- ["Show Changes Since Revision..." vc-show-revision-changes t]
- ["Visit Previous Revision..." vc-version-other-window t]
- ["Show File Status" vc-cvs-file-status t]
- ["Show Edit History" vc-show-history t])
- "Menubar entry for using the revision control system with CVS.")
-
-(defconst vc-cc-menu
- '(["Edit Config Spec..." vc-edit-config t]
- ["Browse Versions" vc-cc-browse-versions t]
- ["Make Branch Type..." vc-mkbrtype t]
- ["View Graph History" vc-graph-history t]
- ["Show Rule" vc-cc-what-rule t])
- "Menubar entries to add to the VC menu when using ClearCase.")
-
-;; This function may be called as a menubar hook, or as a menu filter
-;; The filter is much more efficient, and doesn't slow down menubar selection
-;; for every single menu action, as does the hook method.
-(defun vc-menu-filter (&optional menu)
- (if (null menu)
- (progn
- (setq menu (find-menu-item current-menubar '("Tools" "Version Control")))
- ;; Get just the menu portion
- (if menu (setq menu (cdr (car menu))))
- ))
- (if (null menu)
- nil
- (let* ((rest menu)
- (case-fold-search t)
- (filepath (cond ((and vc-dired-mode
- (dired-get-filename nil 'no-error)))
- (buffer-file-name)
- (t (buffer-name))))
- (file (and filepath (file-name-nondirectory filepath)))
- (vc-file (and filepath (vc-name filepath)))
- owner
- command
- item)
- (while rest
- (setq item (car rest))
-
- (if (not (vectorp item))
- nil
- (setq command (aref item 1))
- (cond
- ;; Display the correct action for vc-next-action command
- ((eq 'vc-next-action command)
- (aset item 0
- (cond ((not vc-file)
- "Register File")
- ((not (setq owner
- ;; Just check properties, it's too
- ;; slow (and dangerous) to fetch
- ;; properties
- (vc-file-getprop filepath 'vc-locking-user)))
- ;;(vc-locking-user filepath)))
- "Check out File")
- ((not (string-equal owner (user-login-name)))
- "Steal File Lock")
- (t "Check in File")))
- (aset item 2 (or buffer-file-name
- (and vc-dired-mode "Marked")))
- )
-
- ;; Check for commands to disable
- ((memq command
- '(vc-revert-buffer
- vc-cancel-version
- vc-rename-this-file
- vc-diff
- vc-diff-since-revision
- vc-version-other-window
- vc-visit-previous-revision
- vc-print-log
- vc-assign-name))
- (aset item 2 vc-file))
-
- (t nil))
-
- ;; Add the file to the menu suffix if not disabled
- (if (and (> (length item) 3) (aref item 2))
- (aset item 3
- (if vc-dired-mode "Marked" file)))
- )
-
- (setq rest (cdr rest)))
-
- ;; Return menu plus the ClearCase menu if needed
- (if (and vc-file (clearcase-element-p filepath))
- ;; Must use append here - nconc will create looped list
- (append menu '("----") vc-cc-menu)
- menu)
- )))
-
-;; vc-menu-filter was once called vc-sensitize-menu, so just in case another
-;; version of vc was loaded:
-(defalias 'vc-sensitize-menu 'vc-menu-filter)
-
-(if (and (fboundp 'add-submenu) (not (featurep 'infodock)) vc-elucidated)
- (progn
- (add-submenu '("Tools") (append (list "Version Control") vc-default-menu))
-;; Only add the hook if the :filter method is unavailable. I don't know which
-;; version of XEmacs introduced it, but it's been available at least since 19.13
-;; (add-hook 'activate-menubar-hook 'vc-sensitize-menu)))
- ))
-
-;; #### called by files.el. Define it like this until we're merged.
-(defun vc-after-save ())
-
-;;---------------------------------------------------------------------------
-;; Utility functions for ClearCase
-;;---------------------------------------------------------------------------
-
-(defun clearcase-element-p (path)
- "Determine if PATH refers to a Clearcase element."
-
- (let (extended-path versioned-path)
-
- (if (string-match "@@" path)
- (setq extended-path (substring path 0 (match-end 0))
- versioned-path t)
- (setq extended-path (concat path "@@")))
-
- (and (file-exists-p path)
- (file-directory-p extended-path)
-
- ;; Non-checked-out elements have the same inode-number
- ;; as the extended name ("foo@@").
- ;; Not so for checked out, and therefore writeable elements.
- ;;
- (or (file-writable-p path)
- versioned-path
- (eq (file-inode path)
- (file-inode extended-path)))
- )))
-
-(if (not (fboundp 'file-inode))
- (defun file-inode (file)
- (nth 10 (file-attributes file))))
-
-(defun vc-cc-element-name (path)
- (if (string-match "@@" path)
- (substring path 0 (match-beginning 0))
- path))
-
-(defun vc-cc-version-name (path)
- (if (string-match "@@" path)
- (substring path (match-end 0))
- nil))
-
-(defsubst vc-cc-relpath (str)
- (and str
- (stringp str)
- (string-match "^/view/\\([^/]+\\)" str)
- (substring str
- (match-end 1))))
-
-(defun vc-cc-build-version (file version &optional view-tag)
- "Build a ClearCase version-extended pathname for ELEMENT's version VERSION.
-If ELEMENT is actually a version-extended pathname, substitute VERSION for
-the version included in ELEMENT. If VERSION is nil, remove the version-extended
-pathname.
-
-If optional VIEW-TAG is specified, make a view-relative pathname, possibly
-replacing the existing view prefix."
- (let* ((element (vc-cc-element-name file))
- (glue-fmt (if (and (> (length version) 0)
- (= (aref version 0) ?/))
- "%s@@%s"
- "%s@@/%s"))
- (relpath (vc-cc-relpath element)))
- (if view-tag
- (setq element (concat "/view/" view-tag (or relpath element))))
- (if version
- (format glue-fmt element version)
- element)
- ))
-
-;; These stolen from vc. pcl-cvs wants to call these in
-;; cvs-mark-buffer-changed. (Basically only changed vc-backend to
-;; vc-backend-deduce.)
-
-(defun vc-consult-rcs-headers (file)
- ;; Search for RCS headers in FILE, and set properties
- ;; accordingly. This function can be disabled by setting
- ;; vc-consult-headers to nil.
- ;; Returns: nil if no headers were found
- ;; (or if the feature is disabled,
- ;; or if there is currently no buffer
- ;; visiting FILE)
- ;; 'rev if a workfile revision was found
- ;; 'rev-and-lock if revision and lock info was found
- (cond
- ((or (not vc-consult-headers)
- (not (get-file-buffer file))) nil)
- ((let (status version locking-user)
- (save-excursion
- (set-buffer (get-file-buffer file))
- (goto-char (point-min))
- (cond
- ;; search for $Id or $Header
- ;; -------------------------
- ((or (and (search-forward "$Id: " nil t)
- (looking-at "[^ ]+ \\([0-9.]+\\) "))
- (and (progn (goto-char (point-min))
- (search-forward "$Header: " nil t))
- (looking-at "[^ ]+ \\([0-9.]+\\) ")))
- (goto-char (match-end 0))
- ;; if found, store the revision number ...
- (setq version (buffer-substring-no-properties (match-beginning 1)
- (match-end 1)))
- ;; ... and check for the locking state
- (cond
- ((looking-at
- (concat "[0-9]+[/-][01][0-9][/-][0-3][0-9] " ; date
- "[0-2][0-9]:[0-5][0-9]+:[0-6][0-9]+\\([+-][0-9:]+\\)? " ; time
- "[^ ]+ [^ ]+ ")) ; author & state
- (goto-char (match-end 0)) ; [0-6] in regexp handles leap seconds
- (cond
- ;; unlocked revision
- ((looking-at "\\$")
- (setq locking-user 'none)
- (setq status 'rev-and-lock))
- ;; revision is locked by some user
- ((looking-at "\\([^ ]+\\) \\$")
- (setq locking-user
- (buffer-substring-no-properties (match-beginning 1)
- (match-end 1)))
- (setq status 'rev-and-lock))
- ;; everything else: false
- (nil)))
- ;; unexpected information in
- ;; keyword string --> quit
- (nil)))
- ;; search for $Revision
- ;; --------------------
- ((re-search-forward (concat "\\$"
- "Revision: \\([0-9.]+\\) \\$")
- nil t)
- ;; if found, store the revision number ...
- (setq version (buffer-substring-no-properties (match-beginning 1)
- (match-end 1)))
- ;; and see if there's any lock information
- (goto-char (point-min))
- (if (re-search-forward (concat "\\$" "Locker:") nil t)
- (cond ((looking-at " \\([^ ]+\\) \\$")
- (setq locking-user (buffer-substring-no-properties
- (match-beginning 1)
- (match-end 1)))
- (setq status 'rev-and-lock))
- ((looking-at " *\\$")
- (setq locking-user 'none)
- (setq status 'rev-and-lock))
- (t
- (setq locking-user 'none)
- (setq status 'rev-and-lock)))
- (setq status 'rev)))
- ;; else: nothing found
- ;; -------------------
- (t nil)))
- (if status (vc-file-setprop file 'vc-workfile-version version))
- (and (eq status 'rev-and-lock)
- (eq (vc-backend-deduce file) 'RCS)
- (vc-file-setprop file 'vc-locking-user locking-user)
- ;; If the file has headers, we don't want to query the master file,
- ;; because that would eliminate all the performance gain the headers
- ;; brought us. We therefore use a heuristic for the checkout model
- ;; now: If we trust the file permissions, and the file is not
- ;; locked, then if the file is read-only the checkout model is
- ;; `manual', otherwise `implicit'.
- (not (vc-mistrust-permissions file))
- (not (vc-locking-user file))
- (if (string-match ".r-..-..-." (nth 8 (file-attributes file)))
- (vc-file-setprop file 'vc-checkout-model 'manual)
- (vc-file-setprop file 'vc-checkout-model 'implicit)))
- status))))
-
-(defun vc-workfile-version (file)
- ;; Return version level of the current workfile FILE
- ;; This is attempted by first looking at the RCS keywords.
- ;; If there are no keywords in the working file,
- ;; vc-master-workfile-version is taken.
- ;; Note that this property is cached, that is, it is only
- ;; looked up if it is nil.
- ;; For SCCS, this property is equivalent to vc-latest-version.
- (cond ((vc-file-getprop file 'vc-workfile-version))
- ((eq (vc-backend-deduce file) 'SCCS) (vc-latest-version file))
- ((eq (vc-backend-deduce file) 'RCS)
- (if (vc-consult-rcs-headers file)
- (vc-file-getprop file 'vc-workfile-version)
- (let ((rev (cond ((vc-master-workfile-version file))
- ((vc-latest-version file)))))
- (vc-file-setprop file 'vc-workfile-version rev)
- rev)))
- ((eq (vc-backend-deduce file) 'CVS)
- (if (vc-consult-rcs-headers file) ;; CVS
- (vc-file-getprop file 'vc-workfile-version)
- (catch 'found
- (vc-find-cvs-master (file-name-directory file)
- (file-name-nondirectory file)))
- (vc-file-getprop file 'vc-workfile-version)))))
-
-(provide 'vc-cc-hooks)
-
-;;; vc-cc-hooks.el ends here
+++ /dev/null
-;;; vc-cc.el --- ClearCase version of vc.el
-
-;; Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-;; Copyright (C) 1995 Tinker Systems and INS Engineering Corp.
-
-;; Author: Eric S. Raymond <esr@snark.thyrsus.com>
-;; Maintainer: ttn@netcom.com
-;; Version: 5.6
-
-;; This file is part of XEmacs.
-
-;; XEmacs 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.
-
-;; XEmacs 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 XEmacs; see the file COPYING. If not, write to the
-;; Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-;; Boston, MA 02111-1307, USA.
-
-;;; Synched up with: It's not clear at this point.
-;;; mly synched this with FSF at version 5.4. Stig did a whole lot
-;;; of stuff to it since then, and so has the FSF.
-
-;;; ################## NOTE:
-
-;;; ################## This is NOT the standard vc.el, and it
-;;; conflicts with vc.el. If you want to use this, you need to
-;;; explicitly load it using `M-x load-library vc-cc', *BEFORE* doing
-;;; anything that loads vc.el. (It might work if loaded after vc.el,
-;;; but we make no guarantees.) You can ensure this by putting a line
-;;; like this in your init file:
-
-;;; (load-library "vc-cc")
-
-;;; If you want to be really cool, merge the ClearCase changes in this
-;;; file into vc.el.
-
-
-;;; Commentary:
-
-;; This mode is fully documented in the Emacs user's manual.
-;;
-;; This was designed and implemented by Eric Raymond <esr@snark.thyrsus.com>.
-;; Paul Eggert <eggert@twinsun.com>, Sebastian Kremer <sk@thp.uni-koeln.de>,
-;; and Richard Stallman contributed valuable criticism, support, and testing.
-;; CVS support was added by Per Cederqvist <ceder@lysator.liu.se>
-;; in Jan-Feb 1994.
-;;
-;; XEmacs fixes, CVS fixes, and general improvements
-;; by Jonathan Stigelman <Stig@hackvan.com>
-;;
-;; Merged ClearCase features from ClearCase extensions version: 2.2.3 and
-;; added highlighting and menubar access to vc-dired-mode by Chris Felaco
-;; <felaco@iatcmail.ed.ray.com>.
-;;
-;; Supported version-control systems presently include SCCS, RCS, and CVS.
-;; The RCS lock-stealing code doesn't work right unless you use RCS 5.6.2
-;; or newer. Currently (January 1994) that is only a beta test release.
-;; Even initial checkins will fail if your RCS version is so old that ci
-;; doesn't understand -t-; this has been known to happen to people running
-;; NExTSTEP 3.0.
-;;
-;; The RCS code assumes strict locking. You can support the RCS -x option
-;; by adding pairs to the vc-master-templates list.
-;;
-;; Proper function of the SCCS diff commands requires the shellscript vcdiff
-;; to be installed somewhere on Emacs's path for executables.
-;;
-;; If your site uses the ChangeLog convention supported by Emacs, the
-;; function vc-comment-to-change-log should prove a useful checkin hook.
-;;
-;; This code depends on call-process passing back the subprocess exit
-;; status. Thus, you need Emacs 18.58 or later to run it. For the
-;; vc-directory command to work properly as documented, you need 19.
-;; You also need Emacs 19's ring.el.
-;;
-;; The vc code maintains some internal state in order to reduce expensive
-;; version-control operations to a minimum. Some names are only computed
-;; once. If you perform version control operations with RCS/SCCS/CVS while
-;; vc's back is turned, or move/rename master files while vc is running,
-;; vc may get seriously confused. Don't do these things!
-;;
-;; Developer's notes on some concurrency issues are included at the end of
-;; the file.
-
-;;; Code:
-
-(require 'vc-cc-hooks)
-(require 'ring)
-(eval-when-compile (require 'dired)) ; for dired-map-over-marks macro
-
-(put 'vc-backend-dispatch 'lisp-indent-hook 0)
-(require 'comint)
-(require 'tq) ;; For ClearCase support
-
-(defconst cc-vc-version "2.2.3")
-(defconst cc-vc-maintainer-address "bug-cc-vc@bloom-beacon.mit.edu")
-
-(defun cc-vc-submit-bug-report ()
- "Submit via mail a bug report on ClearCase VC"
- (interactive)
- (require 'reporter)
- (and (y-or-n-p "Do you really want to submit a report on CC-VC? ")
- (reporter-submit-bug-report
- cc-vc-maintainer-address
- (concat "vc.el " cc-vc-version)
- '(vc-diff-on-checkin vc-keep-workfiles vc-default-back-end
- vc-master-templates))))
-
-(defvar vc-alternate-lsvtree nil
- "*Use an alternate external program instead of xlsvtree")
-
-(defvar vc-diff-on-checkin nil
- "*Display diff on checkin to help you compose the checkin comment.")
-
-(if (not (assoc 'vc-parent-buffer minor-mode-alist))
- (setq minor-mode-alist
- (cons '(vc-parent-buffer vc-parent-buffer-name)
- minor-mode-alist)))
-
-;; General customization
-
-(defvar vc-default-back-end nil
- "*Back-end actually used by this interface; may be SCCS or RCS.
-The value is only computed when needed to avoid an expensive search.")
-(defvar vc-suppress-confirm nil
- "*If non-nil, treat user as expert; suppress yes-no prompts on some things.")
-(defvar vc-keep-workfiles t
- "*If non-nil, don't delete working files after registering changes.
-If the back-end is CVS, workfiles are always kept, regardless of the
-value of this flag.")
-(defvar vc-initial-comment nil
- "*Prompt for initial comment when a file is registered.")
-(defvar vc-command-messages nil
- "*Display run messages from back-end commands.")
-(defvar vc-mistrust-permissions 'file-symlink-p
- "*Don't assume that permissions and ownership track version-control status.")
-(defvar vc-checkin-switches nil
- "*Extra switches passed to the checkin program by \\[vc-checkin].")
-(defvar vc-default-comment "[no seeded comment]"
- "*Default comment for when no checkout comment is available, or
-for those version control systems which don't support checkout comments.")
-(defvar vc-checkin-on-register nil
- "*If t, file will be checked-in when first registered.
-This only applies to version control systems that by default leave files
-checked-out when first registered.")
-(defvar vc-suppress-checkout-comments nil
- "*Suppress prompts for checkout comments for those version control
-systems which use them.")
-(defvar vc-checkout-switches nil
- "*Extra switches passed to the checkout program by \\[vc-checkout].")
-(defvar vc-directory-exclusion-list '("SCCS" "RCS" "lost+found")
- "*Directory names ignored by functions that recursively walk file trees.")
-
-(defvar vc-dired-highlight t
- "*If non-nil, highlight registered and reserved files in vc-dired buffers.")
-
-(defvar vc-checkout-dir-on-register 'ask
- "*If t, automatically checkout the directory (if needed) when registering files.
-If nil, don't checkout the directory and cancel the registration.
-If `ask', prompt before checking out the directory.
-
-This only applies to version control systems with versioned directories (namely
-ClearCase.")
-
-(defconst vc-maximum-comment-ring-size 32
- "Maximum number of saved comments in the comment ring.")
-
-;;; XEmacs - This is dumped into loaddefs.el already.
-;(defvar diff-switches "-c"
-; "*A string or list of strings specifying switches to be passed to diff.")
-
-;;;dont ###autoload, it conflicts with vc.el
-(defvar vc-checkin-hook nil
- "*List of functions called after a checkin is done. See `run-hooks'.")
-
-;;;dont ###autoload, it conflicts with vc.el
-(defvar vc-before-checkin-hook nil
- "*List of functions called before a checkin is done. See `run-hooks'.")
-
-(defvar vc-make-buffer-writable-hook nil
- "*List of functions called when a buffer is made writable. See `run-hooks.'
-This hook is only used when the version control system is CVS. It
-might be useful for sites who uses locking with CVS, or who uses link
-farms to gold trees.")
-
-;; Header-insertion hair
-
-(defvar vc-header-alist
- '((SCCS "\%W\%") (RCS "\$Id\$") (CVS "\$Id\$"))
- "*Header keywords to be inserted when `vc-insert-headers' is executed.")
-(defvar vc-static-header-alist
- '(("\\.c$" .
- "\n#ifndef lint\nstatic char vcid[] = \"\%s\";\n#endif /* lint */\n"))
- "*Associate static header string templates with file types. A \%s in the
-template is replaced with the first string associated with the file's
-version-control type in `vc-header-alist'.")
-
-(defvar vc-comment-alist
- '((nroff-mode ".\\\"" ""))
- "*Special comment delimiters to be used in generating vc headers only.
-Add an entry in this list if you need to override the normal comment-start
-and comment-end variables. This will only be necessary if the mode language
-is sensitive to blank lines.")
-
-;; Default is to be extra careful for super-user.
-(defvar vc-checkout-carefully (= (user-uid) 0) ; #### - this prevents preloading!
- "*Non-nil means be extra-careful in checkout.
-Verify that the file really is not locked
-and that its contents match what the master file says.")
-
-;; Variables the user doesn't need to know about.
-(defvar vc-log-entry-mode nil)
-(defvar vc-log-operation nil)
-(defvar vc-log-after-operation-hook nil)
-(defvar vc-log-writable nil)
-(defvar vc-checkout-writable-buffer-hook 'vc-checkout-writable-buffer)
-;; In a log entry buffer, this is a local variable
-;; that points to the buffer for which it was made
-;; (either a file, or a VC dired buffer).
-(defvar vc-parent-buffer nil)
-(defvar vc-parent-buffer-name nil)
-
-(defvar vc-log-file)
-(defvar vc-log-version)
-
-(defconst vc-name-assoc-file "VC-names")
-
-(defvar vc-comment-ring nil)
-(defvar vc-comment-ring-index nil)
-(defvar vc-last-comment-match nil)
-(defvar vc-window-config nil)
-
-(defvar vc-cleartool-path
- "/usr/atria/bin/cleartool"
- "Path to ClearCase cleartool")
-
-(defvar vc-cleardiff-command nil
- "*Name of ClearCase differencing tool; if nil, use cleardiff as default.
-If not nil, the command specified is expected to handle one or two
-filename arguments just as cleardiff would.")
-
-;; File property caching
-
-(defun vc-clear-context ()
- "Clear all cached file properties and the comment ring."
- (interactive)
- (fillarray vc-file-prop-obarray nil)
- ;; Note: there is potential for minor lossage here if there is an open
- ;; log buffer with a nonzero local value of vc-comment-ring-index.
- (setq vc-comment-ring nil))
-
-;; Random helper functions
-
-(defun vc-registration-error (file)
- (if file
- (error "File %s is not under version control" file)
- (error "Buffer %s is not associated with a file" (buffer-name))))
-
-(defvar vc-binary-assoc nil)
-
-(defun vc-find-binary (name)
- "Look for a command anywhere on the subprocess-command search path."
- (or (cdr (assoc name vc-binary-assoc))
- ;; XEmacs - use locate-file
- (let ((full (locate-file name exec-path nil 1)))
- (if full
- (setq vc-binary-assoc (cons (cons name full) vc-binary-assoc)))
- full)))
-
-(defun vc-do-command (okstatus command file last &rest flags)
- "Execute a version-control command, notifying user and checking for errors.
-The command is successful if its exit status does not exceed OKSTATUS.
-Output from COMMAND goes to buffer *vc*. The last argument of the command is
-the master name of FILE if LAST is 'MASTER, or the workfile of FILE if LAST is
-'WORKFILE; this is appended to an optional list of FLAGS."
- (setq file (expand-file-name file))
- (let ((camefrom (current-buffer))
- (pwd (file-name-directory (expand-file-name file)))
- (squeezed nil)
- (vc-file (and file (vc-name file)))
- status)
-;;; #### - don't know why this code was here...to beautify the echo message?
-;;; the version of code below doesn't break default-directory, but it
-;;; still might mess up CVS and RCS because they like to operate on
-;;; files in the current directory. --Stig
-;;;
-;;; (if (string-match (concat "^" (regexp-quote pwd)) file)
-;;; (setq file (substring file (match-end 0)))
-;;; (setq pwd (file-name-directory file)))
- (if vc-command-messages
- (message "Running %s on %s..." command file))
- (set-buffer (get-buffer-create "*vc*"))
- (setq default-directory pwd
- file (file-name-nondirectory file))
-
- (set (make-local-variable 'vc-parent-buffer) camefrom)
- (set (make-local-variable 'vc-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
-
- (erase-buffer)
-
- (mapcar
- (function (lambda (s) (and s (setq squeezed (append squeezed (list s))))))
- flags)
- (if (and vc-file (eq last 'MASTER))
- (setq squeezed (append squeezed (list vc-file))))
- (if (eq last 'WORKFILE)
- (setq squeezed (append squeezed (list file))))
- (let ((exec-path (if vc-path (append vc-path exec-path) exec-path))
- ;; Add vc-path to PATH for the execution of this command.
- (process-environment (copy-sequence process-environment)))
- (setenv "PATH" (mapconcat 'identity exec-path ":"))
- (setq status (apply 'call-process command nil t nil squeezed)))
- (goto-char (point-max))
- (set-buffer-modified-p nil) ; XEmacs - fsf uses `not-modified'
- (forward-line -1)
- (if (or (not (integerp status)) (< okstatus status))
- (progn
- (pop-to-buffer "*vc*")
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer)
- (error "Running %s...FAILED (%s)" command
- (if (integerp status)
- (format "status %d" status)
- status))
- )
- (if vc-command-messages
- (message "Running %s...OK" command))
- )
- (set-buffer camefrom)
- status)
- )
-
-;;; Save a bit of the text around POSN in the current buffer, to help
-;;; us find the corresponding position again later. This works even
-;;; if all markers are destroyed or corrupted.
-(defun vc-position-context (posn)
- (list posn
- (buffer-size)
- (buffer-substring posn
- (min (point-max) (+ posn 100)))))
-
-;;; Return the position of CONTEXT in the current buffer, or nil if we
-;;; couldn't find it.
-(defun vc-find-position-by-context (context)
- (let ((context-string (nth 2 context)))
- (if (equal "" context-string)
- (point-max)
- (save-excursion
- (let ((diff (- (nth 1 context) (buffer-size))))
- (if (< diff 0) (setq diff (- diff)))
- (goto-char (nth 0 context))
- (if (or (search-forward context-string nil t)
- ;; Can't use search-backward since the match may continue
- ;; after point.
- (progn (goto-char (- (point) diff (length context-string)))
- ;; goto-char doesn't signal an error at
- ;; beginning of buffer like backward-char would
- (search-forward context-string nil t)))
- ;; to beginning of OSTRING
- (- (point) (length context-string))))))))
-
-(defun vc-revert-buffer1 (&optional arg no-confirm)
- ;; Most of this was shamelessly lifted from Sebastian Kremer's rcs.el mode.
- ;; Revert buffer, try to keep point and mark where user expects them in spite
- ;; of changes because of expanded version-control key words.
- ;; This is quite important since otherwise typeahead won't work as expected.
- (interactive "P")
- (widen)
- (let ((point-context (vc-position-context (point)))
- ;; Use mark-marker to avoid confusion in transient-mark-mode.
- ;; XEmacs - mark-marker t
- (mark-context (if (eq (marker-buffer (mark-marker t)) (current-buffer))
- (vc-position-context (mark-marker t))))
- ;; We may want to reparse the compilation buffer after revert
- (reparse (and (boundp 'compilation-error-list) ;compile loaded
- ;; Construct a list; each elt is nil or a buffer
- ;; iff that buffer is a compilation output buffer
- ;; that contains markers into the current buffer.
- (save-excursion
- (mapcar (function
- (lambda (buffer)
- (set-buffer buffer)
- (let ((errors (or
- (symbol-value 'compilation-old-error-list)
- (symbol-value 'compilation-error-list)))
- (buffer-error-marked-p nil))
- (while (and (consp errors)
- (not buffer-error-marked-p))
- (and (markerp (cdr (car errors)))
- (eq buffer
- (marker-buffer
- (cdr (car errors))))
- (setq buffer-error-marked-p t))
- (setq errors (cdr errors)))
- (if buffer-error-marked-p buffer))))
- (buffer-list))))))
-
- ;; The FSF version intentionally runs font-lock here. That
- ;; usually just leads to a correctly font-locked buffer being
- ;; redone. #### We should detect the cases where the font-locking
- ;; may be incorrect (such as on reverts). We know that it is fine
- ;; during regular checkin and checkouts.
-
- ;; the actual revisit
- (revert-buffer arg no-confirm)
-
- ;; Reparse affected compilation buffers.
- (while reparse
- (if (car reparse)
- (save-excursion
- (set-buffer (car reparse))
- (let ((compilation-last-buffer (current-buffer)) ;select buffer
- ;; Record the position in the compilation buffer of
- ;; the last error next-error went to.
- (error-pos (marker-position
- (car (car-safe compilation-error-list)))))
- ;; Reparse the error messages as far as they were parsed before.
- (if (fboundp 'compile-reinitialize-errors)
- (if vc-elucidated
- (compile-reinitialize-errors '(4))
- (compile-reinitialize-errors '(4) compilation-parsing-end)))
- ;; Move the pointer up to find the error we were at before
- ;; reparsing. Now next-error should properly go to the next one.
- (while (and compilation-error-list
- (/= error-pos (car (car compilation-error-list))))
- (setq compilation-error-list (cdr compilation-error-list))))))
- (setq reparse (cdr reparse)))
-
- ;; Restore point and mark
- (let ((new-point (vc-find-position-by-context point-context)))
- (if new-point (goto-char new-point)))
- (if mark-context
- (let ((new-mark (vc-find-position-by-context mark-context)))
- (if new-mark (set-mark new-mark))))))
-
-
-(defun vc-buffer-sync (&optional not-urgent)
- ;; Make sure the current buffer and its working file are in sync
- ;; NOT-URGENT means it is ok to continue if the user says not to save.
- (if (buffer-modified-p)
- (if (or vc-suppress-confirm
- (y-or-n-p (format "Buffer %s modified; save it? " (buffer-name))))
- (save-buffer)
- (if not-urgent
- nil
- (error "Aborted")))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-file-status ()
- "Display the current status of the file being visited.
-Currently, this is only defined for CVS and ClearCase.
-The information provided in the modeline is generally sufficient for
-RCS and SCCS."
- ;; by Stig@hackvan.com
- (interactive)
-
- (let* ((file (if vc-dired-mode (dired-get-filename)
- (vc-buffer-sync t) buffer-file-name))
- (type (vc-backend-deduce file)))
- (cond ((null type)
- (if file
- (message "`%s' is not registered with a version control system."
- file)
- (ding)
- (message "Buffer `%s' has no associated file."
- (buffer-name (current-buffer)))))
- ((eq 'CVS type)
- (vc-do-command 0 "cvs" file 'WORKFILE "status" "-v")
- (set-buffer "*vc*")
- (set-buffer-modified-p nil)
- ;; reparse the status information, since we have it handy...
- (vc-parse-buffer '("Status: \\(.*\\)") file '(vc-cvs-status))
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer
- (display-buffer (current-buffer))))
- ((eq '@@ type)
- (vc-do-command 0 "cleartool" file 'WORKFILE "describe")
- (set-buffer "*vc*")
- (set-buffer-modified-p nil)
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer
- (display-buffer (current-buffer))))
- (t
- (ding)
- (message "Operation not yet defined for RCS or SCCS.")))
- ))
-
-(defun vc-workfile-unchanged-p (file &optional want-differences-if-changed)
- ;; Has the given workfile changed since last checkout?
- (cond ((and (eq 'CVS (vc-backend-deduce file))
- (not want-differences-if-changed))
-
- (let ((status (vc-file-getprop file 'vc-cvs-status)))
- ;; #### - should this have some kind of timeout? how often does
- ;; this get called? possibly the cached information should be
- ;; flushed out of hand. The only concern is the VC menu, which
- ;; may indirectly call this function.
- (or status ; #### - caching is error-prone
- (setq status (car (vc-log-info "cvs" file 'WORKFILE '("status")
- '("Status: \\(.*\\)")
- '(vc-cvs-status)))))
- (string= status "Up-to-date")))
- (t
- (let ((checkout-time (vc-file-getprop file 'vc-checkout-time))
- (lastmod (nth 5 (file-attributes file)))
- unchanged)
- (or (equal checkout-time lastmod)
- (and (or (not checkout-time) want-differences-if-changed)
- (setq unchanged
- (zerop (vc-backend-diff file nil nil
- (not want-differences-if-changed))))
- ;; 0 stands for an unknown time; it can't match any mod time.
- (vc-file-setprop file 'vc-checkout-time (if unchanged lastmod 0))
- unchanged))))))
-
-(defun vc-owner-equal (o1 o2)
- (let ((len1 (length o1))
- (len2 (length o2)))
- (string-equal (substring o1 0 (min len1 8))
- (substring o2 0 (min len2 8)))))
-
-(defun vc-next-action-on-file (file verbose &optional comment)
- ;;; If comment is specified, it will be used as an admin or checkin comment.
- (let ((vc-file (vc-name file))
- (vc-type (vc-backend-deduce file))
- owner version)
- (cond
-
- ;; if there is no master file corresponding, create one
- ((not vc-file)
- (vc-register verbose comment))
-
- ;; if there is no lock on the file, assert one and get it
- ((and (not (eq vc-type 'CVS)) ;There are no locks in CVS.
- (not (setq owner (vc-locking-user file))))
- (if (and vc-checkout-carefully
- (not (vc-workfile-unchanged-p file t)))
- (if (save-window-excursion
- (pop-to-buffer "*vc*")
- (goto-char (point-min))
- (insert (format "Changes to %s since last lock:\n\n" file))
- (not (beep))
- (yes-or-no-p
- "File has unlocked changes, claim lock retaining changes? "))
- (progn (vc-backend-steal file)
- (vc-mode-line file))
- (if (not (yes-or-no-p "Revert to checked-in version, instead? "))
- (error "Checkout aborted.")
- (vc-revert-buffer1 t t)
- (vc-checkout-writable-buffer file))
- )
- (vc-checkout-writable-buffer file)))
-
- ;; a checked-out version exists, but the user may not own the lock
- ((and (not (eq vc-type 'CVS)) ;There are no locks in CVS.
- (not (string-equal owner (user-login-name))))
- (if comment
- (error "Sorry, you can't steal the lock on %s this way" file))
- (vc-steal-lock
- file
- (and verbose (read-string "Version to steal: "))
- owner))
-
- ;; changes to the master file needs to be merged back into the
- ;; working file
- ((and (eq vc-type 'CVS)
- ;; "0" means "added, but not yet committed"
- (not (string= (vc-file-getprop file 'vc-your-latest-version) "0"))
- (progn
- (vc-fetch-properties file)
- (not (string= (vc-file-getprop file 'vc-your-latest-version)
- (vc-file-getprop file 'vc-latest-version)))))
- (vc-buffer-sync)
- (if (yes-or-no-p (format "%s is not up-to-date. Merge in changes now? "
- (buffer-name)))
- (progn
- (if (and (buffer-modified-p)
- (not (yes-or-no-p
- (format
- "Buffer %s modified; merge file on disc anyhow? "
- (buffer-name)))))
- (error "Merge aborted"))
- (if (not (zerop (vc-backend-merge-news file)))
- ;; Overlaps detected - what now? Should use some
- ;; fancy RCS conflict resolving package, or maybe
- ;; emerge, but for now, simply warn the user with a
- ;; message.
- (message "Conflicts detected!"))
- (vc-resynch-window file t (not (buffer-modified-p))))
-
- (error "%s needs update" (buffer-name))))
-
- ((and buffer-read-only (eq vc-type 'CVS))
- (toggle-read-only)
- ;; Sites who make link farms to a read-only gold tree (or
- ;; something similar) can use the hook below to break the
- ;; sym-link.
- (run-hooks 'vc-make-buffer-writable-hook))
-
- ;; OK, user owns the lock on the file (or we are running CVS)
- (t
- (find-file file)
-
- ;; give luser a chance to save before checking in.
- (vc-buffer-sync)
-
- ;; Revert if file is unchanged and buffer is too.
- ;; If buffer is modified, that means the user just said no
- ;; to saving it; in that case, don't revert,
- ;; because the user might intend to save
- ;; after finishing the log entry.
- (if (and (vc-workfile-unchanged-p file)
- (not (buffer-modified-p)))
- (progn
- (if (eq vc-type 'CVS)
- (message "No changes to %s" file)
-
- (vc-backend-revert file)
- ;; DO NOT revert the file without asking the user!
- (vc-resynch-window file t nil)))
-
- ;; user may want to set nonstandard parameters
- (if verbose
- (setq version (read-string "New version level: ")))
-
- ;; OK, let's do the checkin
- (vc-checkin file version comment)
- )))
- ))
-
-(defun vc-next-action-on-dir (dirname verbose &optional comment)
- ;;; If comment is specified, it will be used as an admin or checkin comment.
- (let ((vc-file (vc-name dirname))
- (vc-type (vc-backend-deduce dirname))
- owner version)
- (cond
-
- ;; if there is no master file corresponding, create one
- ((not vc-file)
- (vc-register verbose comment))
-
- ;; if there is no lock on the file, assert one and get it
- ((not (setq owner (vc-locking-user dirname)))
- (vc-checkout-writable-buffer dirname))
-
- ;; a checked-out version exists, but the user may not own the lock
- ((not (string-equal owner (user-login-name)))
-
- (if comment
- (error "Sorry, you can't steal the lock on %s this way" dirname))
- (vc-steal-lock
- dirname
- (and verbose (read-string "Version to steal: "))
- owner))
-
- ;; OK, user owns the lock on the file
- (t
- ;; TODO: figure out how to check if directory is unchanged
-
- ;; user may want to set nonstandard parameters
- (if verbose
- (setq version (read-string "New version level: ")))
-
- ;; OK, let's do the checkin
- (vc-checkin dirname version comment)
- ))
- ))
-
-(defun vc-next-action-dired (file &optional writable rev workfile comment)
- ;; We've accepted a log comment, now do a vc-next-action using it on all
- ;; marked files.
- (set-buffer vc-parent-buffer)
- (dired-map-over-marks
- (save-window-excursion
- ;;; !!! dired-get-filename doesn't DTRT if the filename entry is
- ;;; an absolute pathname..
- (let ((file (dired-get-filename)))
- (message "Processing %s..." file)
- (save-window-excursion
- (vc-next-action-on-file file nil comment)
- (message "Processing %s...done" file))))
- nil t)
- )
-
-(defun vc-next-dir-action (verbose)
- (let* ((file default-directory)
- (owner (vc-locking-user file)))
- (cond
- ((not owner)
- (vc-checkout-writable-buffer file))
- ((vc-owner-equal owner (user-login-name))
- (vc-checkin file nil nil))
- (t
- (error "Now what do we do?")))))
-
-;; Here's the major entry point.
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-next-action (verbose)
- "Do the next logical checkin or checkout operation on the current file.
-
-For RCS and SCCS files:
- If the file is not already registered, this registers it for version
-control and then retrieves a writable, locked copy for editing.
- If the file is registered and not locked by anyone, this checks out
-a writable and locked file ready for editing.
- If the file is checked out and locked by the calling user, this
-first checks to see if the file has changed since checkout. If not,
-it performs a revert.
- If the file has been changed, this pops up a buffer for entry
-of a log message; when the message has been entered, it checks in the
-resulting changes along with the log message as change commentary. If
-the variable `vc-keep-workfiles' is non-nil (which is its default), a
-read-only copy of the changed file is left in place afterwards.
- If the file is registered and locked by someone else, you are given
-the option to steal the lock.
-
-For CVS files:
- If the file is not already registered, this registers it for version
-control. This does a \"cvs add\", but no \"cvs commit\".
- If the file is added but not committed, it is committed.
- If the file has not been changed, neither in your working area or
-in the repository, a message is printed and nothing is done.
- If your working file is changed, but the repository file is
-unchanged, this pops up a buffer for entry of a log message; when the
-message has been entered, it checks in the resulting changes along
-with the logmessage as change commentary. A writable file is retained.
- If the repository file is changed, you are asked if you want to
-merge in the changes into your working copy.
-
-The following is true regardless of which version control system you
-are using:
-
- If you call this from within a VC dired buffer with no files marked,
-it will operate on the file in the current line.
- If you call this from within a VC dired buffer, and one or more
-files are marked, it will accept a log message and then operate on
-each one. The log message will be used as a comment for any register
-or checkin operations, but ignored when doing checkouts. Attempted
-lock steals will raise an error.
-
- For checkin, a prefix argument lets you specify the version number to use."
- (interactive "P")
- (catch 'nogo
- (if (or vc-dired-mode
- (and (eq major-mode 'dired-mode)
- (string= "\C-xvv" (if vc-elucidated
- (events-to-keys (this-command-keys))
- (this-command-keys)))))
- (let ((files (dired-get-marked-files)))
- (if (= (length files) 1)
- (if (file-directory-p (car files))
- (let* ((dirname (car files))
- (registered (vc-registered dirname)))
- (if (and registered (eq '@@ (cdr registered)))
- (progn (vc-next-action-on-dir dirname nil)
- (throw 'nogo nil)))
- (vc-registration-error nil))
- (find-file-other-window (car files)))
- (vc-start-entry nil nil nil
- "Enter a change comment for the marked files."
- 'vc-next-action-dired
- nil
- nil ;after-hook could be used here??
- )
- (throw 'nogo nil))))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (if buffer-file-name
- (vc-next-action-on-file buffer-file-name verbose)
- ;; TODO: Add code to operate on ClearCase directories here.
- (vc-registration-error nil))))
-
-;;; These functions help the vc-next-action entry point
-
-(defun vc-checkout-writable-buffer (&optional file)
- "Retrieve a writable copy of the latest version of the current buffer's file."
- (if (and (vc-file-getprop file 'vc-need-pre-checkout-message)
- (not vc-suppress-checkout-comments))
- (progn
- (vc-start-entry file nil nil "Enter a checkout comment." 'vc-backend-checkout t 'vc-checkout))
- (vc-checkout (or file (buffer-file-name)) t)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-register (&optional override comment)
- "Register the current file into your version-control system."
- (interactive "P")
- (let ((master (vc-name buffer-file-name)))
- (and master (file-exists-p master)
- (error "This file is already registered"))
- (and master
- (not (y-or-n-p "Previous master file has vanished. Make a new one? "))
- (error "This file is already registered")))
- ;; Watch out for new buffers of size 0: the corresponding file
- ;; does not exist yet, even though buffer-modified-p is nil.
- (if (and (not (buffer-modified-p))
- (zerop (buffer-size))
- (not (file-exists-p buffer-file-name)))
- (set-buffer-modified-p t))
- (vc-buffer-sync)
- (vc-admin
- buffer-file-name
- (and override
- (read-string
- (format "Initial version level for %s: " buffer-file-name)))
- comment)
- )
-
-(defun vc-resynch-window (file &optional keep noquery)
- ;; If the given file is in the current buffer,
- ;; either revert on it so we see expanded keyworks,
- ;; or unvisit it (depending on vc-keep-workfiles)
- ;; NOQUERY if non-nil inhibits confirmation for reverting.
- ;; NOQUERY should be t *only* if it is known the only difference
- ;; between the buffer and the file is due to RCS rather than user editing!
- (and (string= buffer-file-name file)
- (if keep
- (progn
- (vc-revert-buffer1 t noquery)
- (vc-mode-line buffer-file-name))
- (progn
- (delete-window)
- (kill-buffer (current-buffer))))))
-
-(defsubst vc-log-buffer-name (file-name)
- (format "*Log-%s*" (or file-name "Marked")))
-
-(defun vc-start-entry (file rev comment msg action &optional writable after-hook before-hook)
- ;; Accept a comment for an operation on FILE revision REV. If COMMENT
- ;; is nil, pop up a VC-log buffer, emit MSG, and set the
- ;; action on close to ACTION; otherwise, do action immediately.
- ;; Remember the file's buffer in vc-parent-buffer (current one if no file).
- ;; AFTER-HOOK specifies the local value for vc-log-operation-hook.
- ;; BEFORE-HOOK specifies a hook to run before even asking for the
- ;; checkin comments.
- (let* ((parent (if file (find-file-noselect file) (current-buffer)))
- (log-buffer-name (vc-log-buffer-name (if file (file-name-nondirectory file))))
- (log-buffer (get-buffer-create log-buffer-name)))
- (when before-hook
- (save-excursion
- (set-buffer parent)
- (run-hooks before-hook)))
- (if comment
- (set-buffer log-buffer)
- (let ((old-window-config (current-window-configuration)))
- (pop-to-buffer log-buffer)
- (set (make-local-variable 'vc-window-config) old-window-config)))
- (set (make-local-variable 'vc-parent-buffer) parent)
-;; (set (make-local-variable 'vc-parent-buffer-name)
-;; (concat " from " (buffer-name vc-parent-buffer)))
- (vc-mode-line (or file " (no file)"))
- ;; If file is not checked out, the log buffer will be read-only
- (setq buffer-read-only nil)
- (vc-log-mode)
- (make-local-variable 'vc-log-after-operation-hook)
- (if after-hook
- (setq vc-log-after-operation-hook after-hook))
- (setq vc-log-operation action)
- (setq vc-log-file file)
- (setq vc-log-version rev)
- (setq vc-log-writable writable)
- (if comment
- (progn
- (erase-buffer)
- (if (eq comment t)
- (vc-finish-logentry t)
- (insert comment)
- (vc-finish-logentry nil)))
- (or writable
- (vc-backend-fetch-default-comment file rev))
- (message "%s Type C-c C-c when done." msg))))
-
-(defun vc-admin (file rev &optional comment)
- "Check a file into your version-control system.
-FILE is the unmodified name of the file. REV should be the base version
-level to check it in under. COMMENT, if specified, is the checkin comment."
-
- ;; For ClearCase, we need to checkout the directory
- (let ((filedir (file-name-directory file)) user)
- (if (eq (vc-backend-deduce filedir) '@@)
- (progn
- (setq user (vc-locking-user filedir))
- (if user
- (if (not (equal user (user-login-name)))
- (error "Directory is locked by %s." user))
- (if (cond
- ((eq vc-checkout-dir-on-register 'ask)
- (y-or-n-p (format "Checkout directory %s " filedir)))
- (vc-checkout-dir-on-register)
- (t nil))
- (vc-backend-checkout filedir t rev nil comment)
- (error "Can't register file unless directory is reserved.")
- )))))
-
- (vc-start-entry file rev
- (or comment (not vc-initial-comment))
- "Enter initial comment." 'vc-backend-admin
- nil nil 'vc-before-checkin-hook))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-checkout (file &optional writable)
- "Retrieve a copy of the latest version of the given file."
- ;; XEmacs - ftp is suppressed by the check for a filename handler in
- ;; vc-registered, so this is needless surplussage
- ;; If ftp is on this system and the name matches the ange-ftp format
- ;; for a remote file, the user is trying something that won't work.
- ;; (if (and (string-match "^/[^/:]+:" file) (vc-find-binary "ftp"))
- ;; (error "Sorry, you can't check out files over FTP"))
- (vc-backend-checkout file writable)
- (if (string-equal file buffer-file-name)
- (vc-resynch-window file t t))
- )
-
-(defun vc-steal-lock (file rev &optional owner)
- "Steal the lock on the current workfile."
- (let (file-description)
- (if (not owner)
- (setq owner (vc-locking-user file)))
- (if rev
- (setq file-description (format "%s:%s" file rev))
- (setq file-description file))
- (if (not (y-or-n-p (format "Take the lock on %s from %s? "
- file-description owner)))
- (error "Steal cancelled"))
- (pop-to-buffer (get-buffer-create "*VC-mail*"))
- (setq default-directory (expand-file-name "~/"))
- (auto-save-mode auto-save-default)
- (mail-mode)
- (erase-buffer)
- (mail-setup owner (format "Stolen lock on %s" file-description) nil nil nil
- (list (list 'vc-finish-steal file rev)))
- (goto-char (point-max))
- (insert
- (format "I stole the lock on %s, " file-description)
- (current-time-string)
- ".\n")
- (message "Please explain why you stole the lock. Type C-c C-c when done.")))
-
-;; This is called when the notification has been sent.
-(defun vc-finish-steal (file version)
- (vc-backend-steal file version)
- (if (get-file-buffer file)
- (save-excursion
- (set-buffer (get-file-buffer file))
- (vc-resynch-window file t t))))
-
-(defun vc-checkin (file &optional rev comment)
- "Check in the file specified by FILE.
-The optional argument REV may be a string specifying the new version level
-\(if nil increment the current level). The file is either retained with write
-permissions zeroed, or deleted (according to the value of `vc-keep-workfiles').
-If the back-end is CVS, a writable workfile is always kept.
-COMMENT is a comment string; if omitted, a buffer is
-popped up to accept a comment."
- (vc-start-entry file rev comment
- "Enter a change comment." 'vc-backend-checkin
- nil 'vc-checkin-hook 'vc-before-checkin-hook)
- (if (and (not comment) (not (file-directory-p file)) vc-diff-on-checkin)
- (save-excursion
- (let ((tmp-buffer (current-buffer)))
- (message "Running diff...")
- (vc-diff nil)
- (message "Running diff...done")
- (set-buffer "*vc*")
- (if (get-buffer "*vc-diff*")
- (kill-buffer "*vc-diff*"))
- (rename-buffer "*vc-diff*")
- (pop-to-buffer tmp-buffer)))))
-
-;;; Here is a checkin hook that may prove useful to sites using the
-;;; ChangeLog facility supported by Emacs.
-(defun vc-comment-to-change-log (&optional whoami file-name)
- "Enter last VC comment into change log file for current buffer's file.
-Optional arg (interactive prefix) non-nil means prompt for user name and site.
-Second arg is file name of change log. \
-If nil, uses `change-log-default-name'."
- (interactive (if current-prefix-arg
- (list current-prefix-arg
- (prompt-for-change-log-name))))
- ;; Make sure the defvar for add-log-current-defun-function has been executed
- ;; before binding it.
- (require 'add-log)
- (let (;; Extract the comment first so we get any error before doing anything.
- (comment (ring-ref vc-comment-ring 0))
- ;; Don't let add-change-log-entry insert a defun name.
- (add-log-current-defun-function 'ignore)
- end)
- ;; Call add-log to do half the work.
- (add-change-log-entry whoami file-name t t)
- ;; Insert the VC comment, leaving point before it.
- (setq end (save-excursion (insert comment) (point-marker)))
- (if (looking-at "\\s *\\s(")
- ;; It starts with an open-paren, as in "(foo): Frobbed."
- ;; So remove the ": " add-log inserted.
- (delete-char -2))
- ;; Canonicalize the white space between the file name and comment.
- (just-one-space)
- ;; Indent rest of the text the same way add-log indented the first line.
- (let ((indentation (current-indentation)))
- (save-excursion
- (while (< (point) end)
- (forward-line 1)
- (indent-to indentation))
- (setq end (point))))
- ;; Fill the inserted text, preserving open-parens at bol.
- (let ((paragraph-separate (concat paragraph-separate "\\|^\\s *\\s("))
- (paragraph-start (concat paragraph-start "\\|^\\s *\\s(")))
- (beginning-of-line)
- (fill-region (point) end))
- ;; Canonicalize the white space at the end of the entry so it is
- ;; separated from the next entry by a single blank line.
- (skip-syntax-forward " " end)
- (delete-char (- (skip-syntax-backward " ")))
- (or (eobp) (looking-at "\n\n")
- (insert "\n"))))
-
-
-(defun vc-cc-save-logentry (comment buffer)
- (save-excursion
- (set-buffer buffer)
- (let* ((file (buffer-file-name))
- (target (concat (vc-latest-version file))))
- (cond ((string-match "/CHECKEDOUT$" target)
- (vc-do-cleartool-command "chevent"
- (vc-cc-build-version file target)
- (vc-cleanup-comment comment) "-replace"))
- (t
- (error "Can't change comment of checked-in version with this interface"))))))
-
-(defun vc-save-logentry ()
- "Checkpoint currently entered comment"
- (interactive)
- (let ((comment-string (buffer-string))
- (parent-buffer vc-parent-buffer))
- (if (not (buffer-modified-p))
- (message "(No changes need to be saved)")
- (progn
- (save-excursion
- (set-buffer parent-buffer)
- (vc-backend-dispatch buffer-file-name
- (error "Logentry saves not supported under SCCS")
- (error "Logentry saves not supported under RCS")
- (error "Logentry saves not supported under CVS")
- (vc-cc-save-logentry comment-string parent-buffer)))
- (set-buffer-modified-p nil)))))
-
-(defun vc-num-num-error ()
- (interactive)
- (message "Perhaps you wanted to type C-c C-c instead?"))
-
-(defun vc-finish-logentry (&optional nocomment)
- "Complete the operation implied by the current log entry."
- (interactive)
- ;; Check and record the comment, if any.
- (let ((log-buffer (current-buffer)))
- (if (not nocomment)
- (progn
- (goto-char (point-max))
- (if (not (bolp))
- (newline))
- ;; Comment too long?
- (vc-backend-logentry-check vc-log-file)
- ;; Record the comment in the comment ring
- (if (null vc-comment-ring)
- (setq vc-comment-ring (make-ring vc-maximum-comment-ring-size)))
- (ring-insert vc-comment-ring (buffer-string))
- ))
- ;; Sync parent buffer in case the user modified it while editing the comment.
- ;; But not if it is a vc-dired buffer.
- (save-excursion
- (set-buffer vc-parent-buffer)
- (or vc-dired-mode
- (vc-buffer-sync)))
- ;; OK, do it to it
- (if vc-log-operation
- (save-excursion
- (funcall vc-log-operation
- vc-log-file
- vc-log-writable
- vc-log-version
- nil
- (buffer-string)))
- (error "No log operation is pending"))
- ;; Return to "parent" buffer of this checkin and remove checkin window
- ;; save the vc-log-after-operation-hook of log buffer
- (let ((after-hook vc-log-after-operation-hook)
- (old-window-config vc-window-config))
- (pop-to-buffer vc-parent-buffer)
- (delete-windows-on log-buffer)
- (kill-buffer log-buffer)
- (if old-window-config (set-window-configuration old-window-config))
- ;; Now make sure we see the expanded headers
- (if buffer-file-name
- (vc-resynch-window buffer-file-name vc-keep-workfiles t))
- (if (and (not (eq vc-log-operation 'vc-next-action-dired))
- (eq major-mode 'dired-mode))
- (revert-buffer t t))
- (run-hooks after-hook))))
-
-;; Code for access to the comment ring
-
-(defun vc-previous-comment (arg)
- "Cycle backwards through comment history."
- (interactive "*p")
- (let ((len (ring-length vc-comment-ring)))
- (cond ((or (not len) (<= len 0)) ; XEmacs change from Barry Warsaw
- (message "Empty comment ring")
- (ding))
- (t
- (erase-buffer)
- ;; Initialize the index on the first use of this command
- ;; so that the first M-p gets index 0, and the first M-n gets
- ;; index -1.
- (if (null vc-comment-ring-index)
- (setq vc-comment-ring-index
- (if (> arg 0) -1
- (if (< arg 0) 1 0))))
- (setq vc-comment-ring-index
- (mod (+ vc-comment-ring-index arg) len))
- (message "%d" (1+ vc-comment-ring-index))
- (insert (ring-ref vc-comment-ring vc-comment-ring-index))))))
-
-(defun vc-next-comment (arg)
- "Cycle forwards through comment history."
- (interactive "*p")
- (vc-previous-comment (- arg)))
-
-(defun vc-comment-search-reverse (str)
- "Searches backwards through comment history for substring match."
- (interactive "sComment substring: ")
- (if (string= str "")
- (setq str vc-last-comment-match)
- (setq vc-last-comment-match str))
- (if (null vc-comment-ring-index)
- (setq vc-comment-ring-index -1))
- (let ((str (regexp-quote str))
- (len (ring-length vc-comment-ring))
- (n (1+ vc-comment-ring-index)))
- (while (and (< n len) (not (string-match str (ring-ref vc-comment-ring n))))
- (setq n (+ n 1)))
- (cond ((< n len)
- (vc-previous-comment (- n vc-comment-ring-index)))
- (t (error "Not found")))))
-
-(defun vc-comment-search-forward (str)
- "Searches forwards through comment history for substring match."
- (interactive "sComment substring: ")
- (if (string= str "")
- (setq str vc-last-comment-match)
- (setq vc-last-comment-match str))
- (if (null vc-comment-ring-index)
- (setq vc-comment-ring-index 0))
- (let ((str (regexp-quote str))
- (n vc-comment-ring-index))
- (while (and (>= n 0) (not (string-match str (ring-ref vc-comment-ring n))))
- (setq n (- n 1)))
- (cond ((>= n 0)
- (vc-next-comment (- n vc-comment-ring-index)))
- (t (error "Not found")))))
-
-;; Additional entry points for examining version histories
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-diff (historic &optional not-urgent)
- "Display diffs between file versions.
-Normally this compares the current file and buffer with the most recent
-checked in version of that file. This uses no arguments.
-With a prefix argument, it reads the file name to use
-and two version designators specifying which versions to compare."
- (interactive "P")
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename))))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (if historic
- (call-interactively 'vc-version-diff)
- (if (or (null buffer-file-name) (null (vc-name buffer-file-name)))
- (error
- "There is no version-control master associated with this buffer"))
- (let ((file buffer-file-name)
- unchanged)
- (or (and file (vc-name file))
- (vc-registration-error file))
- (vc-buffer-sync not-urgent)
- (setq unchanged (vc-workfile-unchanged-p buffer-file-name))
- (if unchanged
- (message "No changes to %s since latest version." file)
- (vc-backend-diff file)
- ;; Ideally, we'd like at this point to parse the diff so that
- ;; the buffer effectively goes into compilation mode and we
- ;; can visit the old and new change locations via next-error.
- ;; Unfortunately, this is just too painful to do. The basic
- ;; problem is that the `old' file doesn't exist to be
- ;; visited. This plays hell with numerous assumptions in
- ;; the diff.el and compile.el machinery.
- (pop-to-buffer "*vc*")
- (setq default-directory (file-name-directory file))
- (if (= 0 (buffer-size))
- (progn
- (setq unchanged t)
- (message "No changes to %s since latest version." file))
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer)))
- (not unchanged))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-version-diff (file rel1 rel2)
- "For FILE, report diffs between two stored versions REL1 and REL2 of it.
-If FILE is a directory, generate diffs between versions for all registered
-files in or below it."
- (interactive
- (progn
- (let ((file (read-file-name "File or directory to diff: "
- default-directory nil t nil)))
- (if (file-directory-p file)
- (let ((r1 (read-string "Older version: "))
- (r2 (read-string "Newer version: ")))
- (list file r1 r2))
- (let ((r1 (vc-read-version
- (format "Older version of %s: "
- (file-name-nondirectory file))
- file))
- (r2 (vc-read-version
- (format "Newer version of %s: "
- (file-name-nondirectory file))
- file)))
- (list file r1 r2))))))
- (if (string-equal rel1 "") (setq rel1 nil))
- (if (string-equal rel2 "") (setq rel2 nil))
- (if (file-directory-p file)
- (let ((camefrom (current-buffer)))
- (set-buffer (get-buffer-create "*vc-status*"))
- (set (make-local-variable 'vc-parent-buffer) camefrom)
- (set (make-local-variable 'vc-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
- (erase-buffer)
- (insert "Diffs between "
- (or rel1 "last version checked in")
- " and "
- (or rel2 "current workfile(s)")
- ":\n\n")
- (set-buffer (get-buffer-create "*vc*"))
- (cd file)
- (vc-file-tree-walk
- (function (lambda (f)
- (message "Looking at %s" f)
- (and
- (not (file-directory-p f))
- (vc-registered f)
- (vc-backend-diff f rel1 rel2)
- (append-to-buffer "*vc-status*" (point-min) (point-max)))
- )))
- (pop-to-buffer "*vc-status*")
- (insert "\nEnd of diffs.\n")
- (goto-char (point-min))
- (set-buffer-modified-p nil)
- )
- (if (zerop (vc-backend-diff file rel1 rel2))
- (message "No changes to %s between %s and %s." file rel1 rel2)
- (pop-to-buffer "*vc*"))))
-
-(defun vc-read-version (prompt file)
- (vc-backend-dispatch file
- (read-string prompt (vc-latest-version file))
- (read-string prompt (vc-latest-version file))
- (read-string prompt (vc-latest-version file))
- ;; For ClearCase, use the version-extended path
- (let* (;; Don't show the whole gory path
- (insert-default-directory nil)
- ;; Fetch the latest version for defaults - it's not critical that
- ;; it be up-to-date, so try the property-list first.
- (latest (or (vc-file-getprop file 'vc-latest-version)
- (vc-latest-version file)))
- (default (vc-cc-build-version file latest))
- ;; Make the current directory the branch of the latest version
- ;; This is the only way that read-file-name will work properly, if
- ;; I pass in this directory, it doesn't complete properly when
- ;; subdirectories are used.
- (default-directory (expand-file-name
- (vc-cc-build-version file
- (file-name-directory latest))))
- )
- ;; Extract just version name, but still complete
- (vc-cc-version-name
- (expand-file-name
- (read-file-name (format "%s (default %s): " prompt latest)
- nil
- default
- t
- nil
- ))
- )
-;; ;; The completing-read method safer, but slower
-;; (completing-read prompt (vc-cc-enumerate-versions file) nil t
-;; (or (vc-cc-version-name file) (vc-latest-version file)))
- )
- ))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-version-other-window (rev)
- "Visit version REV of the current buffer in another window.
-If the current buffer is named `F', the version is named `F.~REV~'.
-If `F.~REV~' already exists, it is used instead of being re-created.
-
-ClearCase uses the normal version-extended naming convention instead."
- (interactive
- (list
- (progn
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename))))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (vc-read-version (format "Version of %s to visit: "
- (file-name-nondirectory buffer-file-name))
- buffer-file-name))))
-
- (if (and buffer-file-name (vc-name buffer-file-name))
- (let* ((version (if (string-equal rev "")
- (vc-latest-version buffer-file-name)
- rev))
- (filename (vc-backend-dispatch
- buffer-file-name
- (concat buffer-file-name ".~" version" ~") ;; SCCS
- (concat buffer-file-name ".~" version" ~") ;; RCS
- (concat buffer-file-name ".~" version" ~") ;; CVS
- (vc-cc-build-version
- (vc-cc-element-name buffer-file-name)
- version) ;; ClearCase
- )))
- (or (file-exists-p filename)
- (vc-backend-checkout buffer-file-name nil version filename nil))
- (find-file-other-window filename))
- (vc-registration-error buffer-file-name)))
-
-;; Header-insertion code
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-insert-headers ()
- "Insert headers in a file for use with your version-control system.
-Headers desired are inserted at the start of the buffer, and are pulled from
-the variable `vc-header-alist'."
- (interactive)
- (if vc-dired-mode
- (find-file-other-window (dired-get-filename)))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (save-excursion
- (save-restriction
- (widen)
- (if (or (not (vc-check-headers))
- (y-or-n-p "Version headers already exist. Insert another set? "))
- (progn
- (let* ((delims (cdr (assq major-mode vc-comment-alist)))
- (comment-start-vc (or (car delims) comment-start "#"))
- (comment-end-vc (or (car (cdr delims)) comment-end ""))
- (hdstrings (cdr (assoc (vc-backend-deduce (buffer-file-name)) vc-header-alist))))
- (mapcar (function (lambda (s)
- (insert comment-start-vc s
- comment-end-vc "\n")))
- hdstrings)
- (if vc-static-header-alist
- (mapcar (function (lambda (f)
- (if (and buffer-file-name
- (string-match (car f) buffer-file-name))
- (insert (format (cdr f) (car hdstrings))))))
- vc-static-header-alist))
- )
- )))))
-
-;; The VC directory submode. Coopt Dired for this.
-;; All VC commands get mapped into logical equivalents.
-
-(defvar vc-dired-prefix-map (make-sparse-keymap))
-(define-key vc-dired-prefix-map "\C-xv" vc-prefix-map)
-
-(if (not (fboundp 'set-keymap-name))
- (defun set-keymap-name (&rest args)
- nil))
-
-(set-keymap-name vc-dired-prefix-map 'vc-dired-prefix-map)
-
-(or (not (boundp 'minor-mode-map-alist))
- (assq 'vc-dired-mode (symbol-value 'minor-mode-map-alist))
- (setq minor-mode-map-alist
- (cons (cons 'vc-dired-mode vc-dired-prefix-map)
- minor-mode-map-alist)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-dired-mode (&optional arg)
- "The augmented Dired minor mode used in VC directory buffers.
-All Dired commands operate normally. Users currently locking listed files
-are listed in place of the file's owner and group.
-Keystrokes bound to VC commands will execute as though they had been called
-on a buffer attached to the file named in the current Dired buffer line."
- (interactive "P")
-
- ;; Behave like a proper minor-mode
- (setq vc-dired-mode
- (if (interactive-p)
- (if (null arg)
- (not vc-dired-mode)
- ;; Check if the numeric arg is positive
- (> (prefix-numeric-value arg) 0)
- )
- ;; else
- ;; Use the car if it's a list
- (if (consp arg) (setq arg (car arg)))
-
- (if (symbolp arg)
- (if (null arg)
- (not vc-dired-mode) ;; toggle mode switch
- (not (eq '- arg))) ;; True if symbol is not '-
- ;; else
- ;; assume it's a number and check that
- (> arg 0)
- )))
-
- (if (or (not (eq major-mode 'dired-mode)))
- (setq vc-dired-mode nil))
-
- (if (and vc-dired-mode vc-dired-highlight)
- (progn
- (vc-reformat-dired-buffer)
- (setq vc-mode " under VC")
- )
- (setq vc-mode ""))
- )
-
-;;(defvar vc-dired-width 15
-;; "Field width of locking-user information inserted into dired buffer")
-
-;; Create a face for highlighting checked out files in vc-dired
-(if (not (memq 'vc-dired-checkedout-face (face-list)))
- (progn
- (make-face 'vc-dired-checkedout-face)
- (set-face-doc-string 'vc-dired-checkedout-face
- "Checked out files in VC dired buffers")
- (set-face-foreground 'vc-dired-checkedout-face "yellow")))
-
-;; Create a face for highlighting registered files in vc-dired
-(if (not (memq 'vc-dired-registered-face (face-list)))
- (progn
- (make-face 'vc-dired-registered-face)
- (set-face-doc-string 'vc-dired-registered-face
- "Registered files in VC dired buffers")
- (set-face-foreground 'vc-dired-registered-face "#6920ac")))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-reformat-dired-buffer (&optional filelist)
- "Reformats the current dired buffer using the given file alist."
- (let* ((givenlist filelist)
- (directory default-directory)
- subdir)
- (save-excursion
- (goto-char (point-min))
-
- (while (not (eobp))
- (cond
- ;; Look for directory markers
- ((setq subdir (dired-get-subdir))
- (setq directory subdir)
- ;; If no filelist was passed in, look up the checkouts.
- ;; The routine vc-list-registered-files is optimized (at least for
- ;; SCCS and ClearCase) to return the checked out files quickly.
- ;; This routine should be much faster than checking each file.
- (if (not givenlist)
- (setq filelist (vc-list-registered-files 'all nil directory)))
- ;; If no registered files are found, we don't need to check each
- ;; file, and it's very slow. The filelist should contain something
- ;; so it doesn't attempt to do this.
- (if (null filelist) (setq filelist '(nil)))
- (message "Reformatting %s..." directory))
-
- ;; Look for files (the safest way to get the filename)
- ((setq fullpath (dired-get-filename nil t))
- ;; Expand it to get rid of . and .. entries
- (setq fullpath (expand-file-name fullpath))
- (looking-at
- "..\\([drwxlts-]+ \\) *[0-9]+ \\(.+\\) +[0-9]+\\( [^ 0-9]+ [0-9 ][0-9] .*\\)")
- (let* ((file-registered (assoc fullpath filelist))
- (owner (if file-registered (cdr file-registered)
- ;; If a filelist was not specified, try to find the
- ;; locking user. The only time this should happen
- ;; is when we are updating a single file entry. For
- ;; whole subdirectories, the filelist should have
- ;; been generated.
- (save-match-data
- (and (null filelist)
- (vc-registered fullpath)
- (vc-locking-user fullpath)))))
- (info-length (- (match-end 2) (match-beginning 2)))
- (rep (format "%-8s RESERVED" owner))
- )
-
- ;; Remove this element from the alist (in case multiple users have
- ;; a file checked out)
- (if (consp file-registered) (setcar file-registered nil))
-
- ;; Highlight the line if the file is reserved
- (if owner
- (progn
- (goto-char (match-beginning 2))
- ;; Replace the user/group with user/RESERVED
- (let ((buffer-read-only nil))
- (cond ((>= info-length 17) (setq info-length 17))
- ((>= info-length 8) (setq info-length 8))
- (t (error "Bad format.")))
-
- (delete-char info-length)
- (insert (substring rep 0 info-length))
- )
-
- ;; Highlight the checked out files sort of like xclearcase
- (if (featurep 'text-props)
- (put-text-property (match-beginning 2) (match-end 2)
- 'face 'vc-dired-checkedout-face)))
- ;; Else if it is registered, but not checked out
- (if (or file-registered
- (and (not filelist)
- (save-match-data (vc-registered fullpath))))
- ;; Highlight the registered files
- (if (featurep 'text-props)
- (put-text-property (match-beginning 2) (match-end 2)
- 'face 'vc-dired-registered-face)))
- ))))
- (forward-line 1)) ;; go to next line
- ))
- (message "Reformatting...Done")
- )
-
-(defvar vc-dired-listing-switches (concat dired-listing-switches "d"))
-
-(defun vc-list-registered-files (verbose recurse &optional directory)
- "Returns an alist of files to users in the directory."
- (or directory (setq directory default-directory))
- (let ((filelist nil) (default-directory directory))
- (cond
- ;; ClearCase
- ((eq (vc-backend-deduce directory) '@@)
-
- (message "Listing ClearCase checkouts...")
-
- ;; File-tree walk is too slow to use for ClearCase
- (setq filelist (vc-cc-list-checkouts directory verbose recurse))
-
- ;; Check if the directory itself is checked-out
- (let* ((dirname (directory-file-name directory))
- (user (vc-locking-user dirname)))
- (if user (setq filelist (cons (cons dirname user) filelist)))
- ;; Check the parent too, he's in the list
- (setq dirname (directory-file-name (expand-file-name (concat directory "..")))
- user (vc-locking-user dirname))
- (if user (setq filelist (cons (cons dirname user) filelist))))
-
- ;; List all registered files if requested
- (if (eq verbose 'all)
- ;; Add all the rest of the non-private files to the list
- (let ((tree-walk-function
- (function (lambda (file)
- (let ((fullpath (expand-file-name file directory)))
- (if (and (not (assoc fullpath filelist))
- (clearcase-element-p file))
- (setq filelist (cons (cons fullpath nil)
- filelist))
- ))))))
- ;; Add all the rest of the non-private files to the list
- (if recurse
- (vc-file-tree-walk tree-walk-function)
- (vc-dir-all-files tree-walk-function))
- ))
- (message "Listing ClearCase checkouts...done")
- )
- ;; SCCS
- ((or (file-directory-p "SCCS") (eq vc-default-back-end 'SCCS))
-
- (message "Listing SCCS checkouts...")
-
- ;; If recursive was requested, use vc-subdir-tree-walk
- (if recurse
- (vc-subdir-tree-walk 'vc-sccs-info-list verbose)
- (vc-sccs-info-list directory verbose))
-
- ;; List all registered files if requested
- (if (eq verbose 'all)
- (let ((tree-walk-function
- (function (lambda (file)
- (let ((fullpath (expand-file-name file directory)))
- (if (and (not (file-directory-p fullpath))
- (not (assoc fullpath filelist))
- ;; Cut to the chase
- (file-exists-p
- (format
- "%sSCCS/s.%s"
- (file-name-directory file)
- (file-name-nondirectory file)))
- )
- (setq filelist (cons (cons fullpath nil)
- filelist))
- ))))))
- ;; Add all the rest of the registered files to the list
- (if recurse
- (vc-file-tree-walk tree-walk-function)
- (vc-dir-all-files tree-walk-function))
- ))
-
- (message "Listing SCCS checkouts...done")
- )
- (t
- ;; All other VC systems... this may be too slow for comfort
- (let ((tree-walk-function
- (function (lambda (f)
- (if (vc-registered f)
- (let ((user (vc-locking-user f)))
- (if (cond ((null verbose))
- ((eq verbose 'all))
- ((eq verbose 'yours) (string-equal user (user-login-name))))
- (setq filelist
- (cons (cons f user) filelist)))))))))
- (if recurse
- (vc-file-tree-walk tree-walk-function)
- (vc-dir-all-files tree-walk-function)))
- )
- )
- ;; Return the filelist
- filelist
- ))
-
-(defun vc-cc-list-checkouts (directory verbose &optional recurse)
- (or directory (setq directory default-directory))
- (vc-cc-cd directory)
-
- (let* (;; Trim off the view specifier
- (reldir (vc-cc-relpath directory))
- ;; Don't use avobs, it takes way too long
- (cmd (concat
- "lsco -fmt \"%n %u %Tf\\n\""
- (if (eq verbose 'yours) " -me" "")
- ;; If recursive list requested, use "-r", otherwise,
- ;; assume the request is for a single vc-dired-mode
- ;; directory, and use "-cview" to restrict list to
- ;; checkouts in the current view.
- (if recurse " -r" " -cview")
- ;; Put the directory so all names will be fullpaths
- ;; For some reason ClearCase adds an extra slash if you leave
- ;; the trailing slash on the directory, so we need to remove it.
- " " (directory-file-name (or reldir directory))))
- (string (vc-cleartool-cmd (or reldir directory) cmd))
- (tmplist (split-string string "\n")))
- ;; Return the reversed alist constructed from the file/version pairs
- (cdr (nreverse
- (mapcar (function
- (lambda (string)
- (let* ((split-list (split-string string " "))
- (fullname (vc-cc-build-version
- (car split-list) nil
- (if (or reldir recurse)
- (caddr split-list))))
- (locking-user (cadr split-list)))
- ;; Record the locking user for future operations
- (vc-file-setprop fullname 'vc-locking-user locking-user)
- (cons fullname locking-user))
- ))
- tmplist)))
- ))
-
-;; This assumes that the caller has defined the variable filelist.
-;; Should be used only by vc-list-registered-files.
-(defun vc-sccs-info-list (directory verbose)
- "List the SCCS checked out files in the given directory."
-
- (if (file-directory-p (concat directory "SCCS/"))
- (save-excursion
- ;; Call sccs info to list all checked out files
- (apply 'vc-do-command 0 "sccs" directory nil
- "info" (if (eq verbose 'yours) '("-U") nil))
- (set-buffer "*vc*")
- (beginning-of-buffer)
-
- ;; Find all lines matching the format and create a filelist
- (while (re-search-forward
- "^[ \t]*\\([^ \t\n]*\\): being edited: \\([0-9.]+\\) \\([0-9.]+\\) \\([^ \t\n]+\\) .*$"
- nil t)
- (let* ((file (match-string 1))
- (user (match-string 4))
- (fullpath (expand-file-name file directory)))
-
- ;; Add the entry to the filelist if not there already
- (if (not (assoc fullpath filelist))
- (setq filelist (cons (cons fullpath user) filelist)))
-
- ;; Record the locking user for future operations
- (vc-file-setprop (expand-file-name file directory)
- 'vc-locking-user user)
- ))
- )
- ))
-
-;; This is a very useful function, and I'm surprised that I couldn't find an
-;; equivalent
-(defun find-base-dir (dirlist)
- "Find the base directory of the given list of directories."
- (let ((dirlist (mapcar (function (lambda (x) (split-string x "/")))
- dirlist))
- prelist first postlist)
- (setq postlist
- (catch 'done
- (while t
- (setq
- first nil
- dirlist (mapcar (function (lambda (list)
- (if first
- (if (not (string-equal first (car list)))
- (throw 'done prelist))
- (setq first (car list)))
- (if (consp list) (cdr list) list)))
- dirlist))
- (setq prelist (append prelist (list first)))
- )))
- (if postlist
- (concat (mapconcat 'identity postlist "/") "/")
- "/")
- ))
-
-
-;;; Note in Emacs 18 the following defun gets overridden
-;;; with the symbol 'vc-directory-18. See below.
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-directory (dir verbose)
- "Show version-control status of all files under the directory DIR.
-With a single prefix argument, all registered files are listed.
-With two prefix arguments, only files you have checked out are listed.
-
-Files are listed in a dired buffer, in `vc-dired-mode'."
- (interactive "DVC status of directory: \nP")
-
- ;; Determine value of verbose flag from prefix arg
- (setq verbose (cond ((equal '(4) verbose) 'all)
- ((equal '(16) verbose) 'yours)
- (t nil)))
-
- (if (null dir) (setq dir default-directory))
-
- (let* (nonempty
- dired-buf
- (default-directory dir)
- (filelist (vc-list-registered-files verbose t)))
- (if filelist
- (save-excursion
- ;; This uses a semi-documented feature of dired; giving a switch
- ;; argument forces the buffer to refresh each time.
- (message "Reading directory entries...")
- ;; Because ClearCase lists the views the files were found in, the
- ;; top-level of the directory tree must be root.
- (let ((uniquify-buffer-name-style nil)
- (files (mapcar 'car filelist))) ;; shut off uniquify temporarily
- (dired (cons (find-base-dir files)
- (nreverse files))
- vc-dired-listing-switches))
- (message "Reading directory entries...done")
- (setq dired-buf (current-buffer))
- (rename-buffer (generate-new-buffer-name
- (concat "VC:" (or (vc-cc-relpath dir) dir))))
- (setq nonempty (not (zerop (buffer-size))))))
- (if nonempty
- (progn
- (pop-to-buffer dired-buf)
- (setq vc-dired-mode t
- vc-mode " under VC")
- (vc-reformat-dired-buffer filelist)
- )
-
- (message "No files are currently %s under %s"
- (cond ((eq 'all verbose) "registered")
- ((eq 'yours verbose) "locked by you")
- (t "locked"))
- default-directory))
- ))
-
-;; Emacs 18 version
-(defun vc-directory-18 (dir verbose)
- "Show version-control status of all files under the directory DIR.
-With a single prefix argument, all registered files are listed.
-With two prefix arguments, only files you have checked out are listed.
-
-Files are listed in a plain buffer, with the name of the locking user."
- (interactive "DVC status of directory: \nP")
-
- ;; Determine value of verbose flag from prefix arg
- (setq verbose (cond ((equal '(4) verbose) 'all)
- ((equal '(16) verbose) 'yours)
- (t nil)))
-
- (if (null dir) (setq dir default-directory))
-
- (let ((default-directory dir)
- (action (cond ((eq 'all verbose) "registered")
- ((eq 'yours verbose) "locked by you")
- (t "locked"))))
- (save-excursion
- (set-buffer (get-buffer-create "*vc-status*"))
- (erase-buffer)
- (cd dir)
- (insert "Files " action " under " default-directory "\n\n")
- (display-buffer "*vc-status*")
- (sit-for 0)
-
- ;; Map over the file list and print
- (let ((filelist (vc-list-registered-files verbose t default-directory)))
- (if filelist
- (progn
- (mapcar
- (function (lambda (f)
- (let ((user (cdr f)) (f (car f)))
- (if (cond ((null verbose) user)
- ((eq verbose 'all))
- ((eq verbose 'yours) (equal user (user-login-name))))
- (progn
- (insert (format
- "%s %s\n"
- (concat user) f)))))))
- filelist)
-
- (pop-to-buffer "*vc-status*" t)
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer))
- (message "No files are currently %s under %s"
- action default-directory)))
- )))
-
-(cond ((string-lessp emacs-version "18")
- (fset 'vc-directory 'vc-directory-18)
- ;; Emacs 18 also lacks these.
- (or (boundp 'compilation-old-error-list)
- (setq compilation-old-error-list nil))
- )
- ;; XEmacs with efs does work
- ((and (string-match "Lucid" emacs-version)
- (or (and
- (= emacs-major-version 19)
- (<= emacs-minor-version 14))
- (< emacs-major-version 19)))
- ;; lucid emacs does not have the new dired yet
- (fset 'vc-directory 'vc-directory-18)
- )
- )
-
-;; Named-configuration support for SCCS
-
-(defun vc-add-triple (name file rev)
- (save-excursion
- (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
- (goto-char (point-max))
- (insert name "\t:\t" file "\t" rev "\n")
- (basic-save-buffer)
- (kill-buffer (current-buffer))
- ))
-
-(defun vc-record-rename (file newname)
- (save-excursion
- (find-file (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file))
- (goto-char (point-min))
- ;; (replace-regexp (concat ":" (regexp-quote file) "$") (concat ":" newname))
- (while (re-search-forward (concat ":" (regexp-quote file) "$") nil t)
- (replace-match (concat ":" newname) nil nil))
- (basic-save-buffer)
- (kill-buffer (current-buffer))
- ))
-
-(defun vc-lookup-triple (file name)
- ;; Return the numeric version corresponding to a named snapshot of file
- ;; If name is nil or a version number string it's just passed through
- (cond ((null name) name)
- ((let ((firstchar (aref name 0)))
- (and (>= firstchar ?0) (<= firstchar ?9)))
- name)
- (t
- (car (vc-master-info
- (concat (vc-backend-subdirectory-name file) "/" vc-name-assoc-file)
- (list (concat name "\t:\t" file "\t\\(.+\\)"))))
- )))
-
-;; Named-configuration entry points
-
-(defun vc-locked-example ()
- ;; Return an example of why the current directory is not ready to be snapshot
- ;; or nil if no such example exists.
- (catch 'vc-locked-example
- (vc-file-tree-walk
- (function (lambda (f)
- (if (and (vc-registered f) (vc-locking-user f))
- (throw 'vc-locked-example f)))))
- nil))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-create-snapshot (name)
- "Make a snapshot called NAME.
-The snapshot is made from all registered files at or below the current
-directory. For each file, the version level of its latest
-version becomes part of the named configuration."
- (interactive "sNew snapshot name: ")
- (let ((locked (vc-locked-example)))
- (if locked
- (error "File %s is locked" locked)
- (progn
- (vc-backend-define-name default-directory name)
- (vc-file-tree-walk
- (function (lambda (f) (and
- (vc-name f)
- (vc-backend-assign-name f name)))))
- ))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-assign-name (name)
- "Assign a NAME to the current file version.
-In vc-dired-mode all marked files are labeled."
- (interactive (list (vc-read-label "Label: ")))
- (let ((filelist
- (if vc-dired-mode (dired-get-marked-files)
- (list (buffer-file-name))))
- file)
- (while filelist
- (setq file (car filelist) filelist (cdr filelist))
- (if (and (vc-registered file) (vc-locking-user file))
- (error "File %s is locked" file)
- (vc-backend-assign-name file name))
- )))
-
-(defun vc-read-label (prompt)
- "Read a label name."
- (if (eq (vc-backend-deduce default-directory) '@@)
- (let* ((string (vc-cleartool-cmd default-directory
- "lstype -kind lbtype -short"))
- labels)
- (mapcar (function (lambda (arg)
- (if (string-match "(locked)" arg)
- nil
- (setq labels (cons (list arg) labels)))))
- (split-string string "\n"))
- (completing-read prompt labels nil t))
- ;; Otherwise, just read any string
- (read-string prompt)
- ))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-retrieve-snapshot (name)
- "Retrieve the snapshot called NAME.
-This function fails if any files are locked at or below the current directory
-Otherwise, all registered files are checked out (unlocked) at their version
-levels in the snapshot."
- (interactive "sSnapshot name to retrieve: ")
- (let ((locked (vc-locked-example)))
- (if locked
- (error "File %s is locked" locked)
- (vc-file-tree-walk
- (function (lambda (f) (and
- (vc-name f)
- (vc-error-occurred
- (vc-backend-checkout f nil name))))))
- )))
-
-;; Miscellaneous other entry points
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-print-log ()
- "List the change log of the current buffer in a window."
- (interactive)
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename))))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (if (and buffer-file-name (vc-name buffer-file-name))
- (let ((file buffer-file-name))
- (vc-backend-print-log file)
- (pop-to-buffer (get-buffer-create "*vc*"))
- (setq default-directory (file-name-directory file))
- (while (looking-at "=*\n")
- (delete-char (- (match-end 0) (match-beginning 0)))
- (forward-line -1))
- (goto-char (point-min))
- (if (looking-at "[\b\t\n\v\f\r ]+")
- (delete-char (- (match-end 0) (match-beginning 0))))
- (shrink-window-if-larger-than-buffer)
- )
- (vc-registration-error buffer-file-name)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-revert-buffer ()
- "Revert the current buffer's file back to the latest checked-in version.
-This asks for confirmation if the buffer contents are not identical
-to that version.
-If the back-end is CVS, this will give you the most recent revision of
-the file on the branch you are editing."
- (interactive)
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (let (filelist file changed keep-buffer new-buffer
- (obuf (current-buffer)))
-
- (if vc-dired-mode
- (setq filelist (dired-get-marked-files))
- (setq filelist (list (buffer-file-name))))
-
- (while filelist
- (setq file (car filelist) filelist (cdr filelist)
- changed nil)
-
- (if (file-directory-p file)
- (setq new-buffer nil keep-buffer t)
-
- ;; Otherwise find the file
- (setq new-buffer (find-buffer-visiting file))
-
- (if new-buffer
- (setq keep-buffer t)
- (setq new-buffer (find-file-noselect file)
- keep-buffer nil))
-
- (set-buffer new-buffer)
- )
-
- (if (or
- (not (vc-name file))
- (not (equal (vc-locking-user file) (user-login-name)))
- (and (not (file-directory-p file))
- (setq changed (vc-diff nil t))
- (or vc-suppress-confirm
- (not (yes-or-no-p "Discard changes? ")))))
- (progn
- (unless keep-buffer (kill-buffer new-buffer))
- (message "Revert of %s cancelled" file))
- (set-buffer obuf)
- (if changed
- (delete-window))
- (vc-backend-revert file)
- (vc-resynch-window file t t)
- (if keep-buffer
- (if new-buffer (progn (set-buffer new-buffer) (revert-buffer nil t)))
- (kill-buffer new-buffer))
-
- ;; See if we can keep dired up-to-date
- (if (fboundp 'dired-relist-file)
- (dired-relist-file file)
- ))
- )))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cancel-version (norevert)
- "Get rid of most recently checked in version of this file.
-A prefix argument means do not revert the buffer afterwards."
- (interactive "P")
- (if vc-dired-mode
- (find-file-other-window (dired-get-filename)))
- (while vc-parent-buffer
- (pop-to-buffer vc-parent-buffer))
- (let* ((target (concat (vc-latest-version (buffer-file-name))))
- (yours (concat (vc-your-latest-version (buffer-file-name))))
- (prompt (if (string-equal yours target)
- "Remove your version %s from master? "
- "Version %s was not your change. Remove it anyway? ")))
- (if (null (yes-or-no-p (format prompt target)))
- nil
- (vc-backend-uncheck (buffer-file-name) target)
- (if (or norevert
- (not (yes-or-no-p "Revert buffer to most recent remaining version? ")))
- (vc-mode-line (buffer-file-name))
- (vc-checkout (buffer-file-name) nil)))
- ))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-rename-file (old new)
- "Rename file OLD to NEW, and rename its master file likewise."
- (interactive "fVC rename file: \nFRename to: ")
- ;; There are several ways of renaming files under CVS 1.3, but they all
- ;; have serious disadvantages. See the FAQ (available from think.com in
- ;; pub/cvs/). I'd rather send the user an error, than do something he might
- ;; consider to be wrong. When the famous, long-awaited rename database is
- ;; implemented things might change for the better. This is unlikely to occur
- ;; until CVS 2.0 is released. --ceder 1994-01-23 21:27:51
- (if (eq (vc-backend-deduce old) 'CVS)
- (error "Renaming files under CVS is dangerous and not supported in VC."))
- (if (eq (vc-backend-deduce old) '@@)
- (error "VC's ClearCase support cannot rename files."))
- (let ((oldbuf (get-file-buffer old)))
- (if (and oldbuf (buffer-modified-p oldbuf))
- (error "Please save files before moving them"))
- (if (get-file-buffer new)
- (error "Already editing new file name"))
- (if (file-exists-p new)
- (error "New file already exists"))
- (let ((oldmaster (vc-name old)))
- (if oldmaster
- (progn
- (if (vc-locking-user old)
- (error "Please check in files before moving them"))
- (if (or (file-symlink-p oldmaster)
- ;; This had FILE, I changed it to OLD. -- rms.
- (file-symlink-p (vc-backend-subdirectory-name old)))
- (error "This is not a safe thing to do in the presence of symbolic links"))
- (rename-file
- oldmaster
- (let ((backend (vc-backend-deduce old))
- (newdir (or (file-name-directory new) ""))
- (newbase (file-name-nondirectory new)))
- (catch 'found
- (mapcar
- (function
- (lambda (s)
- (if (eq backend (cdr s))
- (let* ((newmaster (format (car s) newdir newbase))
- (newmasterdir (file-name-directory newmaster)))
- (if (or (not newmasterdir)
- (file-directory-p newmasterdir))
- (throw 'found newmaster))))))
- vc-master-templates)
- (error "New file lacks a version control directory"))))))
- (if (or (not oldmaster) (file-exists-p old))
- (rename-file old new)))
- ;; ?? Renaming a file might change its contents due to keyword expansion.
- ;; We should really check out a new copy if the old copy was precisely equal
- ;; to some checked in version. However, testing for this is tricky....
- (if oldbuf
- (save-excursion
- (set-buffer oldbuf)
- (set-visited-file-name new)
- (set-buffer-modified-p nil))))
- ;; This had FILE, I changed it to OLD. -- rms.
- (vc-backend-dispatch old
- (vc-record-rename old new) ;SCCS
- ;; #### - This CAN kinda be done for both rcs and
- ;; cvs. It needs to be implemented. -- Stig
- nil ;RCS
- nil ;CVS
- nil ;CC
- )
- )
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-update-change-log (&rest args)
- "Find change log file and add entries from recent RCS logs.
-The mark is left at the end of the text prepended to the change log.
-With prefix arg of C-u, only find log entries for the current buffer's file.
-With any numeric prefix arg, find log entries for all files currently visited.
-Otherwise, find log entries for all registered files in the default directory.
->From a program, any arguments are passed to the `rcs2log' script."
- (interactive
- (cond ((consp current-prefix-arg) ;C-u
- (list buffer-file-name))
- (current-prefix-arg ;Numeric argument.
- (let ((files nil)
- (buffers (buffer-list))
- file)
- (while buffers
- (setq file (buffer-file-name (car buffers)))
- (and file (vc-backend-deduce file)
- (setq files (cons file files)))
- (setq buffers (cdr buffers)))
- files))
- (t
- (let ((RCS (concat default-directory "RCS")))
- (and (file-directory-p RCS)
- (mapcar (function
- (lambda (f)
- (if (string-match "\\(.*\\),v$" f)
- (substring f 0 (match-end 1))
- f)))
- (directory-files RCS nil "...\\|^[^.]\\|^.[^.]")))))))
- (let ((odefault default-directory))
- (find-file-other-window (find-change-log))
- (barf-if-buffer-read-only)
- (vc-buffer-sync)
- (undo-boundary)
- (goto-char (point-min))
- (push-mark)
- (message "Computing change log entries...")
- (message "Computing change log entries... %s"
- (if (or (null args)
- (eq 0 (apply 'call-process "rcs2log" nil t nil
- "-n"
- (user-login-name)
- (user-full-name)
- user-mail-address
- (mapcar (function
- (lambda (f)
- (file-relative-name
- (if (file-name-absolute-p f)
- f
- (concat odefault f)))))
- args))))
- "done" "failed"))))
-
-;; Functions for querying the master and lock files.
-
-(defun vc-match-substring (bn)
- (buffer-substring (match-beginning bn) (match-end bn)))
-
-(defun vc-parse-buffer (patterns &optional file properties nodates)
- ;; Each pattern is of the form:
- ;; regex ; subex is 1, and date-subex is 2 (or nil)
- ;; (regex subex date-subex)
- ;;
- ;; Use PATTERNS to parse information out of the current buffer by matching
- ;; each REGEX in the list and the returning the string matched by SUBEX.
- ;; If a DATE-SUBEX is present, then the SUBEX from the match with the
- ;; highest value for DATE-SUBEX (string comparison is used) will be
- ;; returned.
- ;;
- ;; If FILE and PROPERTIES are given, the latter must be a list of
- ;; properties of the same length as PATTERNS; each property is assigned
- ;; the corresponding value.
- (mapcar (function (lambda (p)
- (goto-char (point-min))
- (if (and (not nodates) (string-match "\\\\(.*\\\\(" p))
- (let ((latest-date "") (latest-val))
- (while (re-search-forward p nil t)
- (let ((date (vc-match-substring 2)))
- (if (string< latest-date date)
- (progn
- (setq latest-date date)
- (setq latest-val
- (vc-match-substring 1))))))
- latest-val))
- (prog1
- (let ((value nil))
- (if (re-search-forward p nil t)
- (setq value (vc-match-substring 1)))
- (if file
- (vc-file-setprop file (car properties) value))
- value)
- (setq properties (cdr properties)))))
- patterns)
- )
-
-(defun vc-master-info (file fields &optional rfile properties)
- ;; Search for information in a master file.
- (if (and file (file-exists-p file))
- (save-excursion
- (let ((buf))
- (setq buf (create-file-buffer file))
- (set-buffer buf))
- (erase-buffer)
- (insert-file-contents file nil)
- (set-buffer-modified-p nil)
- (auto-save-mode nil)
- (prog1
- (vc-parse-buffer fields rfile properties)
- (kill-buffer (current-buffer)))
- )
- (if rfile
- (mapcar
- (function (lambda (p) (vc-file-setprop rfile p nil)))
- properties))
- )
- )
-
-(defun vc-log-info (command file last flags patterns &optional properties nodates)
- ;; Search for information in log program output
- (if (and file (file-exists-p file))
- (save-excursion
- (let ((buf))
- (setq buf (get-buffer-create "*vc*"))
- (set-buffer buf)
- ;; Special case for cleartool commands
- (if (string-equal command "cleartool")
- (insert (vc-cleartool-cmd file
- ;; Concatenate each flag and the file name into a
- ;; single space separated string.
- (mapconcat 'identity (nconc flags (list file)) " ")))
- (apply 'vc-do-command 0 command file last flags))
- (set-buffer-modified-p nil)
- (prog1
- (vc-parse-buffer patterns file properties nodates)
- (kill-buffer buf))))
- (if file
- (mapcar
- (function (lambda (p) (vc-file-setprop file p nil)))
- properties))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-locking-user (file)
- "Return the name of the person currently holding a lock on FILE.
-Return nil if there is no such person.
-Under CVS, a file is considered locked if it has been modified since it
-was checked out...even though it may well be writable by you."
- (setq file (expand-file-name file)) ; use full pathname
- (cond ((eq (vc-backend-deduce file) 'CVS)
- (if (vc-workfile-unchanged-p file t)
- nil
- ;; XEmacs - ahead of the pack...
- (user-login-name (nth 2 (file-attributes file)))))
- (t
- ;; #### - this can probably be cleaned up as a result of the changes to
- ;; user-login-name...
- (if (or (not vc-keep-workfiles)
- (eq vc-mistrust-permissions 't)
- (and vc-mistrust-permissions
- (funcall vc-mistrust-permissions (vc-backend-subdirectory-name
- file)))
- (vc-file-newer file))
- (vc-true-locking-user file)
- ;; This implementation assumes that any file which is under version
- ;; control and has -rw-r--r-- is locked by its owner. This is true
- ;; for both RCS and SCCS, which keep unlocked files at -r--r--r--.
- ;; We have to be careful not to exclude files with execute bits on;
- ;; scripts can be under version control too. Also, we must ignore
- ;; the group-read and other-read bits, since paranoid users turn them off.
- ;; This hack wins because calls to the very expensive vc-fetch-properties
- ;; function only have to be made if (a) the file is locked by someone
- ;; other than the current user, or (b) some untoward manipulation
- ;; behind vc's back has changed the owner or the `group' or `other'
- ;; write bits.
- (let ((attributes (file-attributes file)))
- (cond ((string-match ".r-..-..-." (nth 8 attributes))
- nil)
- ((and (= (nth 2 attributes) (user-uid))
- (string-match ".rw..-..-." (nth 8 attributes)))
- (user-login-name))
- (t
- (vc-true-locking-user file)))) ; #### - this looks recursive!!!
- ))))
-
-(defun vc-true-locking-user (file)
- ;; The slow but reliable version
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-locking-user))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-latest-version (file)
- ;; Return version level of the latest version of FILE
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-latest-version))
-
-(defun vc-your-latest-version (file)
- ;; Return version level of the latest version of FILE checked in by you
- (vc-fetch-properties file)
- (vc-file-getprop file 'vc-your-latest-version))
-
-(defun vc-cc-previous-version (file version)
- (let ((ext-name (if version
- (vc-cc-build-version file version)
- file)))
- (vc-fetch-properties ext-name )
- (vc-file-getprop ext-name 'vc-pred-version)))
-
-;; Collect back-end-dependent stuff here
-;;
-;; Everything eventually funnels through these functions. To implement
-;; support for a new version-control system, add another branch to the
-;; vc-backend-dispatch macro and fill it in in each call. The variable
-;; vc-master-templates in vc-hooks.el will also have to change.
-
-(put 'vc-backend-dispatch 'lisp-indent-function 'defun)
-
-(defmacro vc-backend-dispatch (f s r c a)
- "Execute FORM1, FORM2, FORM3 or FORM4 depending whether we're using
-SCCS, RCS, CVS or ClearCase.
-If FORM3 is RCS, use FORM2 even if we are using CVS. (CVS shares some code
-with RCS)."
- (list 'let (list (list 'type (list 'vc-backend-deduce f)))
- (list 'cond
- (list (list 'eq 'type (quote 'SCCS)) s) ; SCCS
- (list (list 'eq 'type (quote 'RCS)) r) ; RCS
- (list (list 'eq 'type (quote 'CVS)) ; CVS
- (if (eq c 'RCS) r c))
- (list (list 'eq 'type (quote '@@)) a) ; CC
- )))
-
-(defun vc-lock-file (file)
- ;; Generate lock file name corresponding to FILE
- (let ((master (vc-name file)))
- (and
- master
- (string-match "\\(.*/\\)s\\.\\(.*\\)" master)
- (concat
- (substring master (match-beginning 1) (match-end 1))
- "p."
- (substring master (match-beginning 2) (match-end 2))))))
-
-
-(defun vc-fetch-properties (file)
- ;; Re-fetch all properties associated with the given file.
- ;; Currently these properties are:
- ;; vc-locking-user
- ;; vc-locked-version
- ;; vc-latest-version
- ;; vc-your-latest-version
- ;; vc-cvs-status (cvs only)
- ;; vc-cc-predecessor (ClearCase only)
- (vc-backend-dispatch
- file
- ;; SCCS
- (progn
- (vc-master-info (vc-lock-file file)
- (list
- "^[^ ]+ [^ ]+ \\([^ ]+\\)"
- "^\\([^ ]+\\)")
- file
- '(vc-locking-user vc-locked-version))
- (vc-master-info (vc-name file)
- (list
- "^\001d D \\([^ ]+\\)"
- (concat "^\001d D \\([^ ]+\\) .* "
- (regexp-quote (user-login-name)) " ")
- )
- file
- '(vc-latest-version vc-your-latest-version))
- )
- ;; RCS
- (vc-log-info "rlog" file 'MASTER nil
- (list
- "^locks: strict\n\t\\([^:]+\\)"
- "^locks: strict\n\t[^:]+: \\(.+\\)"
- "^revision[\t ]+\\([0-9.]+\\).*\ndate: \\([ /0-9:]+\\);"
- (concat
- "^revision[\t ]+\\([0-9.]+\\)\n.*author: "
- (regexp-quote (user-login-name))
- ";"))
- '(vc-locking-user vc-locked-version
- vc-latest-version vc-your-latest-version))
- ;; CVS
- ;; Don't fetch vc-locking-user and vc-locked-version here, since they
- ;; should always be nil anyhow. Don't fetch vc-your-latest-version, since
- ;; that is done in vc-find-cvs-master.
- (vc-log-info
- "cvs" file 'WORKFILE '("status")
- ;; CVS 1.3 says "RCS Version:", other releases "RCS Revision:",
- ;; and CVS 1.4a1 says "Repository revision:". The regexp below
- ;; matches much more, but because of the way vc-log-info is
- ;; implemented it is impossible to use additional groups.
- '(("\\(RCS Version\\|RCS Revision\\|Repository revision\\):[\t ]+\\([0-9.]+\\)" 2)
- "Status: \\(.*\\)")
- '(vc-latest-version
- vc-cvs-status))
- ;; CC
- (progn
- (vc-file-setprop file 'vc-need-pre-checkout-message t)
- (vc-log-info "cleartool" file nil (list "describe" file)
- (list
- "checked out .* by .* (\\([^ .]+\\)..*@.*)"
- "from \\([^ ]+\\) (reserved)"
- "version [^\"]*\".*@@\\([^ ]+\\)\""
-;; "version [^\"]*\".*@@\\([^ ]+\\)\""
- "predecessor version: \\([^ ]+\\)\n")
- '(vc-locking-user
- vc-locked-version
- vc-latest-version
-;; vc-your-latest-version
- vc-cc-predecessor))
- ;; Rather than search twice, why not just set the property manually
- (vc-file-setprop file 'vc-your-latest-version
- (vc-file-getprop file 'vc-latest-version))
- )
- ))
-
-
-(defun vc-backend-subdirectory-name (&optional file)
- ;; Where the master and lock files for the current directory are kept
- (let ((backend
- (or
- (and file (vc-backend-deduce file))
- vc-default-back-end
- (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))))
- (cond
- ((eq backend 'SCCS) "SCCS")
- ((eq backend 'RCS) "RCS")
- ((eq backend 'CVS) "CVS")
- ((eq backend '@@) "@@"))
- ))
-
-(defun vc-backend-admin (file &optional writable rev workfile comment)
- ;; Register a file into the version-control system
- ;; Automatically retrieves a read-only version of the file with
- ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
- ;; it deletes the workfile.
- (vc-file-clearprops file)
- (or vc-default-back-end
- (setq vc-default-back-end (if (vc-find-binary "rcs") 'RCS 'SCCS)))
- (message "Registering %s..." file)
- (let ((backend
- (cond
- ((file-exists-p (vc-backend-subdirectory-name)) vc-default-back-end)
- ((file-exists-p "RCS") 'RCS)
- ((file-exists-p "SCCS") 'SCCS)
- ((file-exists-p "CVS") 'CVS)
- ((file-exists-p "@@") '@@)
- (t vc-default-back-end))))
- (cond ((eq backend 'SCCS)
- (vc-do-command 0 "admin" file 'MASTER ; SCCS
- (and rev (concat "-r" rev))
- "-fb"
- (concat "-i" file)
- (and comment (concat "-y" comment))
- (format
- (car (rassq 'SCCS vc-master-templates))
- (or (file-name-directory file) "")
- (file-name-nondirectory file)))
- (delete-file file)
- (if vc-keep-workfiles
- (vc-do-command 0 "get" file 'MASTER)))
- ((eq backend 'RCS)
- (vc-do-command 0 "ci" file 'MASTER ; RCS
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (and comment (concat "-t-" comment))
- file))
- ((eq backend 'CVS)
- ;; #### - should maybe check to see if the master file is
- ;; already in the repository...in which case we need to add the
- ;; appropriate branch tag and do an update.
- ;; #### - note that adding a file is a 2 step process in CVS...
- (vc-do-command 0 "cvs" file 'WORKFILE "add")
- (vc-do-command 0 "cvs" file 'WORKFILE "commit"
- (and comment (not (string= comment ""))
- (concat "-m" comment)))
- )
- ((eq backend '@@)
- (if vc-checkin-on-register
- (vc-do-cleartool-command "mkelem" file comment "-ci")
- (vc-do-cleartool-command "mkelem" file comment)
- ;; clearcase mkelem leaves file checked out!
- (vc-file-setprop file 'vc-checkout-time '(0 . 0))))
- (t (error "Backend %s unknown!" backend))))
- (message "Registering %s...done" file)
- ;; See if we can keep dired up-to-date
- (if (fboundp 'dired-relist-file)
- (dired-relist-file file))
- )
-
-(defun vc-backend-checkout (file &optional writable rev workfile comment)
- ;; Retrieve a copy of a saved version into a workfile
- (let ((filename (or workfile file)))
- (message "Checking out %s..." filename)
- (save-excursion
- ;; Clean up comment prior to checkout (in case user ci's outside vc-cc)
- (setq comment (vc-cleanup-comment comment nil))
- ;; Change buffers to get local value of vc-checkout-switches.
- (set-buffer (or (get-file-buffer file) (current-buffer)))
- (vc-backend-dispatch
- file
- ;; SCCS
- (if workfile
- ;; Some SCCS implementations allow checking out directly to a
- ;; file using the -G option, but then some don't so use the
- ;; least common denominator approach and use the -p option
- ;; ala RCS.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- 0 "/bin/sh" file 'MASTER "-c"
- ;; Some shells make the "" dummy argument into $0
- ;; while others use the shell's name as $0 and
- ;; use the "" as $1. The if-statement
- ;; converts the latter case to the former.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec get \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-e")
- "-p" (and rev
- (concat "-r" (vc-lookup-triple file rev)))
- vc-checkout-switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- (apply 'vc-do-command 0 "get" file 'MASTER ; SCCS
- (if writable "-e")
- (and rev (concat "-r" (vc-lookup-triple file rev)))
- vc-checkout-switches))
- ;; RCS
- (if workfile
- ;; RCS doesn't let us check out into arbitrary file names directly.
- ;; Use `co -p' and make stdout point to the correct file.
- (let ((vc-modes (logior (file-modes (vc-name file))
- (if writable 128 0)))
- (failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- 0 "/bin/sh" file 'MASTER "-c"
- ;; See the SCCS case, above, regarding the
- ;; if-statement.
- (format "if [ x\"$1\" = x ]; then shift; fi; \
- umask %o; exec >\"$1\" || exit; \
- shift; umask %o; exec co \"$@\""
- (logand 511 (lognot vc-modes))
- (logand 511 (lognot (default-file-modes))))
- "" ; dummy argument for shell's $0
- filename
- (if writable "-l")
- (concat "-p" rev)
- vc-checkout-switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- (apply 'vc-do-command 0 "co" file 'MASTER
- (if writable "-l")
- (and rev (concat "-r" rev))
- vc-checkout-switches))
- ;; CVS
- (if workfile
- ;; CVS is much like RCS
- (let ((failed t))
- (unwind-protect
- (progn
- (apply 'vc-do-command
- 0 "/bin/sh" file 'WORKFILE "-c"
- "exec >\"$1\" || exit; shift; exec cvs update \"$@\""
- "" ; dummy argument for shell's $0
- workfile
- (concat "-r" rev)
- "-p"
- vc-checkout-switches)
- (setq failed nil))
- (and failed (file-exists-p filename) (delete-file filename))))
- (apply 'vc-do-command 0 "cvs" file 'WORKFILE
- "update"
- (and rev (concat "-r" rev))
- file
- vc-checkout-switches))
- ;; CC
- (if writable
- (vc-do-cleartool-command "co" file
- comment
- (and rev "-branch")
- rev
- vc-checkout-switches))
- ))
- (or workfile
- (vc-file-setprop file
- 'vc-checkout-time (nth 5 (file-attributes file))))
- (message "Checking out %s...done" filename))
- ;; See if we can keep dired up-to-date
- (if (fboundp 'dired-relist-file)
- (dired-relist-file file))
- )
-
-
-(defun vc-backend-logentry-check (file)
- (vc-backend-dispatch file
- (if (>= (buffer-size) 512) ; SCCS
- (progn
- (goto-char 512)
- (error
- "Log must be less than 512 characters; point is now at pos 512")))
- nil ; RCS
- nil ; CVS
- nil) ; CC
- )
-
-(defun vc-backend-checkin (file &optional writable rev workfile comment)
- ;; Register changes to FILE as level REV with explanatory COMMENT.
- ;; Automatically retrieves a read-only version of the file with
- ;; keywords expanded if vc-keep-workfiles is non-nil, otherwise
- ;; it deletes the workfile.
- (message "Checking in %s..." file)
- (save-excursion
- (setq comment (vc-cleanup-comment comment nil))
- ;; Change buffers to get local value of vc-checkin-switches.
- (set-buffer (or (get-file-buffer file) (current-buffer)))
- (vc-backend-dispatch file
- ;; SCCS
- (progn
- (apply 'vc-do-command 0 "delta" file 'MASTER
- (if rev (concat "-r" rev))
- (if comment (concat "-y" comment))
- vc-checkin-switches)
- (if vc-keep-workfiles
- (vc-do-command 0 "get" file 'MASTER))
- )
- ;; RCS
- (apply 'vc-do-command 0 "ci" file 'MASTER
- (concat (if vc-keep-workfiles "-u" "-r") rev)
- (if comment (concat "-m" comment))
- vc-checkin-switches)
- ;; CVS
- (progn
- (apply 'vc-do-command 0 "cvs" file 'WORKFILE
- "ci"
- (if comment (concat "-m" comment))
- vc-checkin-switches)
- (vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file))))
- ;; ClearCase
- (progn
- (apply 'vc-do-cleartool-command "ci" file comment
- vc-checkin-switches)
- (vc-file-setprop file 'vc-checkout-time
- (nth 5 (file-attributes file))))
- ))
- (vc-file-setprop file 'vc-locking-user nil)
- (message "Checking in %s...done" file)
- ;; See if we can keep dired up-to-date
- (if (fboundp 'dired-relist-file)
- (dired-relist-file file))
- )
-
-(defun vc-backend-revert (file)
- ;; Revert file to latest checked-in version.
- (message "Reverting %s..." file)
- (vc-backend-dispatch
- file
- (progn ; SCCS
- (vc-do-command 0 "unget" file 'MASTER nil)
- (vc-do-command 0 "get" file 'MASTER nil))
- (vc-do-command 0 "co" file 'MASTER ; RCS. This deletes the work file.
- "-f" "-u")
- (progn ; CVS
- (delete-file file)
- (vc-do-command 0 "cvs" file 'WORKFILE "update"))
- (vc-do-cleartool-command "unco" file 'unused "-rm") ;CC
- )
- (vc-file-setprop file 'vc-locking-user nil)
- (message "Reverting %s...done" file)
- )
-
-(defun vc-backend-steal (file &optional rev)
- ;; Steal the lock on the current workfile. Needs RCS 5.6.2 or later for -M.
- (message "Stealing lock on %s..." file)
- (vc-backend-dispatch file
- (progn ; SCCS
- (vc-do-command 0 "unget" file 'MASTER "-n" (if rev (concat "-r" rev)))
- (vc-do-command 0 "get" file 'MASTER "-g" (if rev (concat "-r" rev)))
- )
- (vc-do-command 0 "rcs" file 'MASTER ; RCS
- "-M" (concat "-u" rev) (concat "-l" rev))
- (error "You cannot steal a CVS lock; there are no CVS locks to steal.") ; CVS
- (error "VC's ClearCase support cannot steal locks.") ; CC
- )
- (vc-file-setprop file 'vc-locking-user (user-login-name))
- (message "Stealing lock on %s...done" file)
- )
-
-(defun vc-backend-uncheck (file target)
- ;; Undo the latest checkin. Note: this code will have to get a lot
- ;; smarter when we support multiple branches.
- (message "Removing last change from %s..." file)
- (vc-backend-dispatch file
- (vc-do-command 0 "rmdel" file 'MASTER (concat "-r" target))
- (vc-do-command 0 "rcs" file 'MASTER (concat "-o" target))
- (error "Unchecking files under CVS is dangerous and not supported in VC.")
- (let ((vc-command-messages t))
- (cond ((string-match "/CHECKEDOUT$" target)
- (vc-do-cleartool-command "unco" file 'unused "-rm"))
- ((string-match "/0$" target)
- (vc-do-cleartool-command
- "rmbranch"
- (vc-cc-build-version file
- (substring target 0 (match-beginning 0)))
- "Removing empty branch"
- "-force"))
- (t
- (vc-do-cleartool-command "rmver"
- (vc-cc-build-version file target)
- nil "-force"))))
- )
- (message "Removing last change from %s...done" file)
- ;; See if we can keep dired up-to-date
- (if (fboundp 'dired-relist-file)
- (dired-relist-file file))
- )
-
-(defun vc-backend-print-log (file)
- ;; Print change log associated with FILE to buffer *vc*.
- (vc-backend-dispatch
- file
- (vc-do-command 0 "prs" file 'MASTER)
- (vc-do-command 0 "rlog" file 'MASTER)
- (vc-do-command 0 "cvs" file 'WORKFILE "log")
- (vc-do-cleartool-command "lshistory" file 'unused))
- )
-
-(defun vc-backend-define-name (file name)
- ;; Under directory FILE, allow NAME as a version name.
- (vc-backend-dispatch file
- nil
- nil
- nil
- (vc-do-cleartool-command "mklbtype" nil nil "-vob" file name)))
-
-(defun vc-backend-assign-name (file name)
- ;; Assign to a FILE's latest version a given NAME.
- (vc-backend-dispatch file
- (vc-add-triple name file (vc-latest-version file)) ; SCCS
- (vc-do-command 0 "rcs" file 'MASTER (concat "-n" name ":")) ; RCS
- (vc-do-command 0 "cvs" file 'WORKFILE "tag" name) ; CVS
- (vc-do-cleartool-command "mklabel" file nil "-replace" name) ; CC
- )
- )
-
-(defun vc-backend-diff (file &optional oldvers newvers cmp)
- ;; Get a difference report between two versions of FILE.
- ;; Get only a brief comparison report if CMP, a difference report otherwise.
- (let ((backend (vc-backend-deduce file)))
- (cond
- ((eq backend 'SCCS)
- (setq oldvers (vc-lookup-triple file oldvers))
- (setq newvers (vc-lookup-triple file newvers))))
- (cond
- ;; SCCS and RCS shares a lot of code.
- ((or (eq backend 'SCCS) (eq backend 'RCS))
- (let* ((command (if (eq backend 'SCCS)
- "vcdiff"
- "rcsdiff"))
- (mode (if (eq backend 'RCS) 'WORKFILE 'MASTER))
- (options (append (list (and cmp "--brief")
- "-q"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers)))
- (and (not cmp)
- (if (listp diff-switches)
- diff-switches
- (list diff-switches)))))
- (status (apply 'vc-do-command 2 command file mode options)))
- ;; Some RCS versions don't understand "--brief"; work around this.
- (if (eq status 2)
- (apply 'vc-do-command 1 command file 'WORKFILE
- (if cmp (cdr options) options))
- status)))
- ;; CVS is different.
- ;; cmp is not yet implemented -- we always do a full diff.
- ((eq backend 'CVS)
- (if (string= (vc-file-getprop file 'vc-your-latest-version) "0") ; CVS
- ;; This file is added but not yet committed; there is no master file.
- ;; diff it against /dev/null.
- (if (or oldvers newvers)
- (error "No revisions of %s exists" file)
- (apply 'vc-do-command
- 1 "diff" file 'WORKFILE "/dev/null"
- (if (listp diff-switches)
- diff-switches
- (list diff-switches))))
- (apply 'vc-do-command
- 1 "cvs" file 'WORKFILE "diff"
- (and oldvers (concat "-r" oldvers))
- (and newvers (concat "-r" newvers))
- (if (listp diff-switches)
- diff-switches
- (list diff-switches)))))
- ;; ClearCase is completely different.
- ((eq backend '@@)
- (let
- ((cmd (or vc-cleardiff-command "cleardiff")))
- (apply 'vc-do-command 2 cmd file nil
- (unless vc-cleardiff-command
- (if cmp "-status_only")
-
- ;; Like the "-w" flag to diff
- "-blank_ignore"
-
- ;; Display as much as possible of the file
- "-columns" (format "%d" (window-width)))
- (vc-cc-build-version file
- (or oldvers
- (vc-file-getprop file 'vc-cc-predecessor)))
- (if newvers
- (concat file "@@" newvers) file)
- nil
- )))
- (t
- (vc-registration-error file)))))
-
-(defun vc-backend-merge-news (file)
- ;; Merge in any new changes made to FILE.
- (vc-backend-dispatch
- file
- (error "vc-backend-merge-news not meaningful for SCCS files") ; SCCS
- (error "vc-backend-merge-news not meaningful for RCS files") ; RCS
- (vc-do-command 1 "cvs" file 'WORKFILE "update") ; CVS
- (error "vc-backend-merge-news not meaningful for ClearCase files") ; CC
- ))
-
-(defun vc-backend-fetch-default-comment (file rev)
- "Fetch default comment, if any, and insert into the current buffer"
- (vc-backend-dispatch file
- (insert vc-default-comment) ;; SCCS
- (insert vc-default-comment) ;; RCS
- (insert vc-default-comment) ;; CVS
- (vc-clearcase-fetch-default-comment file)))
-
-(defun vc-cleanup-comment (string &optional from-describe)
- (if string
- (let (tmpbuf)
- (unwind-protect
- (progn
- (setq tmpbuf (get-buffer-create " *vc-cleanup*"))
- (set-buffer tmpbuf)
- (erase-buffer)
- (insert string)
- (if from-describe
- (progn
- (goto-char (point-min))
- (while (re-search-forward "^ " nil t)
- (replace-match ""))))
- (goto-char (point-min))
- (while (re-search-forward "[ \t]+$" nil t)
- (replace-match ""))
- (goto-char (point-max))
- (skip-chars-backward " \n\t")
- (delete-region (point) (point-max))
- (if (= (point) (point-min))
- nil
- (buffer-string)))
- (if tmpbuf
- (kill-buffer tmpbuf))))))
-
-(defun vc-clearcase-fetch-default-comment (file)
- "Fetch default comment, if any, and insert into current buffer."
- (insert
- (save-excursion
- (let ((vc-command-messages t))
- ;; Use the fmt feature to get just the comment
- (or (vc-file-getprop file 'vc-old-comment)
- (vc-file-setprop file 'vc-old-comment
- (vc-cleanup-comment
- (vc-cleartool-cmd (or (file-name-directory file) default-directory)
- (format "describe -fmt %%c %s" file)) t))
- vc-default-comment
- )))))
-
-(defun vc-check-headers ()
- "Check if the current file has any headers in it."
- (interactive)
- (save-excursion
- (goto-char (point-min))
- (vc-backend-dispatch buffer-file-name
- (re-search-forward "%[MIRLBSDHTEGUYFPQCZWA]%" nil t) ; SCCS
- (re-search-forward "\\$[A-Za-z\300-\326\330-\366\370-\377]+\\(: [\t -#%-\176\240-\377]*\\)?\\$" nil t) ; RCS
- 'RCS ; CVS works like RCS in this regard.
- nil ; ClearCase does not recognise headers.
- )
- ))
-
-;; Back-end-dependent stuff ends here.
-
-;; Set up key bindings for use while editing log messages
-
-(defun vc-log-mode ()
- "Minor mode for driving version-control tools.
-These bindings are added to the global keymap when you enter this mode:
-\\[vc-next-action] perform next logical version-control operation on current file
-\\[vc-register] register current file
-\\[vc-toggle-read-only] like next-action, but won't register files
-\\[vc-insert-headers] insert version-control headers in current file
-\\[vc-print-log] display change history of current file
-\\[vc-revert-buffer] revert buffer to latest version
-\\[vc-cancel-version] undo latest checkin
-\\[vc-diff] show diffs between file versions
-\\[vc-version-other-window] visit old version in another window
-\\[vc-directory] show all files locked by any user in or below .
-\\[vc-update-change-log] add change log entry from recent checkins
-
-While you are entering a change log message for a version, the following
-additional bindings will be in effect.
-
-\\[vc-finish-logentry] proceed with check in, ending log message entry
-
-Whenever you do a checkin, your log comment is added to a ring of
-saved comments. These can be recalled as follows:
-
-\\[vc-next-comment] replace region with next message in comment ring
-\\[vc-previous-comment] replace region with previous message in comment ring
-\\[vc-comment-search-reverse] search backward for regexp in the comment ring
-\\[vc-comment-search-forward] search backward for regexp in the comment ring
-
-Entry to the change-log submode calls the value of text-mode-hook, then
-the value of vc-log-mode-hook.
-
-Global user options:
- vc-initial-comment If non-nil, require user to enter a change
- comment upon first checkin of the file.
-
- vc-keep-workfiles Non-nil value prevents workfiles from being
- deleted when changes are checked in
-
- vc-suppress-confirm Suppresses some confirmation prompts,
- notably for reversions.
-
- vc-header-alist Which keywords to insert when adding headers
- with \\[vc-insert-headers]. Defaults to
- '(\"\%\W\%\") under SCCS, '(\"\$Id\$\") under
- RCS and CVS.
-
- vc-static-header-alist By default, version headers inserted in C files
- get stuffed in a static string area so that
- ident(RCS/CVS) or what(SCCS) can see them in
- the compiled object code. You can override
- this by setting this variable to nil, or change
- the header template by changing it.
-
- vc-command-messages if non-nil, display run messages from the
- actual version-control utilities (this is
- intended primarily for people hacking vc
- itself).
-"
- (interactive)
- (set-syntax-table text-mode-syntax-table)
- (use-local-map vc-log-entry-mode)
- (setq local-abbrev-table text-mode-abbrev-table)
- (setq major-mode 'vc-log-mode)
- (setq mode-name "VC-Log")
- (make-local-variable 'vc-log-file)
- (make-local-variable 'vc-log-version)
- (make-local-variable 'vc-comment-ring-index)
- (make-local-variable 'vc-log-writable)
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (run-hooks 'text-mode-hook 'vc-log-mode-hook)
- )
-
-;; Initialization code, to be done just once at load-time
-(if vc-log-entry-mode
- nil
- (setq vc-log-entry-mode (make-sparse-keymap))
- (define-key vc-log-entry-mode "\M-n" 'vc-next-comment)
- (define-key vc-log-entry-mode "\M-p" 'vc-previous-comment)
- (define-key vc-log-entry-mode "\M-r" 'vc-comment-search-reverse)
- (define-key vc-log-entry-mode "\M-s" 'vc-comment-search-forward)
- (define-key vc-log-entry-mode "\C-c\C-c" 'vc-finish-logentry)
- (define-key vc-log-entry-mode "\C-x\C-s" 'vc-save-logentry)
- (define-key vc-log-entry-mode "\C-x\C-q" 'vc-num-num-error)
- )
-
-;;; These things should probably be generally available
-
-(defun vc-file-tree-walk (func &rest args)
- "Walk recursively through default directory.
-Invoke FUNC f ARGS on each non-directory file f underneath it."
- (vc-file-tree-walk-internal default-directory func args nil)
- (message "Traversing directory %s...done" default-directory))
-
-(defun vc-file-tree-walk-internal (file func args quiet)
- (if (not (file-directory-p file))
- (apply func file args)
- (or quiet
- (message "Traversing directory %s..." file))
- (let ((dir (file-name-as-directory file)))
- (mapcar
- (function
- (lambda (f) (or
- (string-equal f ".")
- (string-equal f "..")
- (member f vc-directory-exclusion-list)
- (let ((dirf (concat dir f)))
- (or
- (file-symlink-p dirf) ;; Avoid possible loops
- (vc-file-tree-walk-internal dirf func args quiet))))))
- (directory-files dir)))))
-
-(defun vc-subdir-tree-walk (func &rest args)
- "Walk recursively through default directory.
-Invoke FUNC f ARGS on each subdirectory underneath it."
- (vc-subdir-tree-walk-internal default-directory func args nil)
- (message "Traversing directory %s...done" default-directory))
-
-(defun vc-subdir-tree-walk-internal (file func args quiet)
- (if (file-directory-p file)
- (let ((dir (file-name-as-directory file)))
- (apply func dir args)
- (or quiet
- (message "Traversing directory %s..." file))
- (mapcar
- (function
- (lambda (f) (or
- (string-equal f ".")
- (string-equal f "..")
- (member f vc-directory-exclusion-list)
- (let ((dirf (concat dir f)))
- (or
- (file-symlink-p dirf) ;; Avoid possible loops
- (vc-subdir-tree-walk-internal dirf func args quiet))))))
- (directory-files dir)))
- ))
-
-(defun vc-dir-all-files (func &rest args)
- "Invoke FUNC f ARGS on each regular file f in default directory."
- (let ((dir default-directory))
- (message "Scanning directory %s..." dir)
- (mapcar (function (lambda (f)
- (let ((dirf (expand-file-name f dir)))
- (apply func dirf args))))
- (directory-files dir))
- (message "Scanning directory %s...done" dir)))
-
-;;; Lucid Emacs-specific code.
-(defun vc-file-newer (file)
- (or (null file)
- (let ((vc-file (vc-file-getprop file 'vc-name)))
- (or (null vc-file)
- (let ((time (vc-file-getprop file 'vc-file-timestamp)))
- (or (null time)
- (> time (nth 5 (file-attributes vc-file)))))))))
-
-(defun vc-revision-diff (arg)
- "Compare the version being edited with the last checked-in revision.
-With a prefix argument prompt for revision to compare with."
- (interactive "P")
- (save-excursion
- (if vc-dired-mode
- (set-buffer (find-file-noselect (dired-get-filename))))
- ;; check that the file is not modified
- (if (and (buffer-modified-p)
- (or
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name)))))
- (save-buffer))
- (if arg
- (vc-version-diff buffer-file-name
- (vc-read-version "Revision to compare against: "
- (buffer-file-name))
- ())
- (vc-diff ())))
- )
-
-(defun vc-diff-since-revision ()
- (interactive)
- (vc-revision-diff '(4)))
-
-(defun vc-backend-checkout-in-buffer (file rev)
- ;; Retrieve a copy of a saved version into the current buffer
- (message "Checking out %s..." file)
- (vc-backend-dispatch file
- (progn
- (vc-do-command 0 "get" file 'WORKFILE ;; SCCS
- "-p" "-s"
- (and rev (concat "-r" (vc-lookup-triple file rev))))
- )
- (vc-do-command 0 "co" file 'WORKFILE ;; RCS
- "-p" "-q"
- (and rev (concat "-r" rev)))
- (error "Command not yet supported in CVS.")
- (error "Just use ClearCase extended naming.")
- )
- (message "Checking out %s...done" file)
- )
-
-
-;;;(defun vc-visit-previous-revision (revision)
-;;; "Show a previous revision of the current file"
-;;; (interactive "sShow previous revision number: ")
-;;; (if (not buffer-file-name)
-;;; (error "There is no file associated with buffer %s" (buffer-name)))
-;;; (let* ((file buffer-file-name)
-;;; (other-file
-;;; (make-temp-name
-;;; (concat (or revision "current") "-" (file-name-nondirectory file)
-;;; "-")))
-;;; (buffer-name (concat (file-name-nondirectory file)
-;;; "<" (vc-backend-deduce file) " " revision ">")))
-;;; (vc-backend-checkout-in-buffer file revision)
-;;; (save-excursion
-;;; (set-buffer "*vc*")
-;;; (write-region (point-min) (point-max) other-file t 0)
-;;; (erase-buffer))
-;;; (pop-to-buffer (get-buffer-create buffer-name))
-;;; (erase-buffer)
-;;; (insert-file other-file)
-;;; ;; get the same major mode as the original file
-;;; (setq buffer-file-name file)
-;;; (normal-mode)
-;;; (setq buffer-file-name ())
-;;; (set-buffer-modified-p ())
-;;; (toggle-read-only)
-;;; (delete-file other-file)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-rename-this-file (new)
- "Rename the file of the current buffer.
-It also renames the source control archive with it"
- (interactive "FVC rename file to: ")
- (if (and (buffer-modified-p)
- (y-or-n-p (format "%s has been modified. Write it out? "
- (buffer-name))))
- (save-buffer))
- (vc-rename-file buffer-file-name new)
- (let ((old-buffer (current-buffer))
- (new-buffer (find-file-noselect new)))
- (set-window-buffer (selected-window) new-buffer)
- (pop-to-buffer (current-buffer))
- (bury-buffer old-buffer)))
-
-(defun vc-update-directory ()
- "Updates the current directory by getting the latest copies of the files"
- (interactive)
- (save-some-buffers)
- (let ((failed ())
- (any-updated ())
- (dir default-directory))
- (save-excursion
- (set-buffer (get-buffer-create "*vc-update*"))
- (setq default-directory dir)
- (erase-buffer)
- (insert "Updating " default-directory "\n\n")
- (display-buffer (current-buffer))
- (sit-for 0)
- (condition-case ()
- (vc-file-tree-walk
- (function (lambda (f)
- (if (and f (vc-registered f))
- (progn
- (cond ((file-newer-than-file-p f (vc-name f)))
- ((equal (vc-locking-user f)
- (user-login-name)))
- ((not (zerop (vc-backend-diff f nil)))
- (vc-backend-checkout f nil nil nil nil)
- (insert "updated " f "\n")
- (setq any-updated t)
- (sit-for 0))))))))
- (error (setq failed t)))
- (if (null any-updated)
- (insert "No files needed to be updated\n")
- (goto-char (point-max))
- (insert "\ndone\n")))
- (if failed
- (save-excursion
- (set-buffer "*vc*")
- (append-to-buffer "*vc-update*" (point-min) (point-max)))
- (save-excursion
- (set-buffer "*vc*")
- (goto-char (point-min))))
- (pop-to-buffer "*vc-update*")
- (if failed
- (error "update failed"))))
-
-(provide 'vc-cc)
-
-;;; DEVELOPER'S NOTES ON CONCURRENCY PROBLEMS IN THIS CODE
-;;;
-;;; These may be useful to anyone who has to debug or extend the package.
-;;;
-;;; A fundamental problem in VC is that there are time windows between
-;;; vc-next-action's computations of the file's version-control state and
-;;; the actions that change it. This is a window open to lossage in a
-;;; multi-user environment; someone else could nip in and change the state
-;;; of the master during it.
-;;;
-;;; The performance problem is that rlog/prs calls are very expensive; we want
-;;; to avoid them as much as possible.
-;;;
-;;; ANALYSIS:
-;;;
-;;; The performance problem, it turns out, simplifies in practice to the
-;;; problem of making vc-locking-user fast. The two other functions that call
-;;; prs/rlog will not be so commonly used that the slowdown is a problem; one
-;;; makes snapshots, the other deletes the calling user's last change in the
-;;; master.
-;;;
-;;; The race condition implies that we have to either (a) lock the master
-;;; during the entire execution of vc-next-action, or (b) detect and
-;;; recover from errors resulting from dispatch on an out-of-date state.
-;;;
-;;; Alternative (a) appears to be unfeasible. The problem is that we can't
-;;; guarantee that the lock will ever be removed. Suppose a user starts a
-;;; checkin, the change message buffer pops up, and the user, having wandered
-;;; off to do something else, simply forgets about it?
-;;;
-;;; Alternative (b), on the other hand, works well with a cheap way to speed up
-;;; vc-locking-user. Usually, if a file is registered, we can read its locked/
-;;; unlocked state and its current owner from its permissions.
-;;;
-;;; This shortcut will fail if someone has manually changed the workfile's
-;;; permissions; also if developers are munging the workfile in several
-;;; directories, with symlinks to a master (in this latter case, the
-;;; permissions shortcut will fail to detect a lock asserted from another
-;;; directory).
-;;;
-;;; Note that these cases correspond exactly to the errors which could happen
-;;; because of a competing checkin/checkout race in between two instances of
-;;; vc-next-action.
-;;;
-;;; For VC's purposes, a workfile/master pair may have the following states:
-;;;
-;;; A. Unregistered. There is a workfile, there is no master.
-;;;
-;;; B. Registered and not locked by anyone.
-;;;
-;;; C. Locked by calling user and unchanged.
-;;;
-;;; D. Locked by the calling user and changed.
-;;;
-;;; E. Locked by someone other than the calling user.
-;;;
-;;; This makes for 25 states and 20 error conditions. Here's the matrix:
-;;;
-;;; VC's idea of state
-;;; |
-;;; V Actual state RCS action SCCS action Effect
-;;; A B C D E
-;;; A . 1 2 3 4 ci -u -t- admin -fb -i<file> initial admin
-;;; B 5 . 6 7 8 co -l get -e checkout
-;;; C 9 10 . 11 12 co -u unget; get revert
-;;; D 13 14 15 . 16 ci -u -m<comment> delta -y<comment>; get checkin
-;;; E 17 18 19 20 . rcs -u -M ; rcs -l unget -n ; get -g steal lock
-;;;
-;;; All commands take the master file name as a last argument (not shown).
-;;;
-;;; In the discussion below, a "self-race" is a pathological situation in
-;;; which VC operations are being attempted simultaneously by two or more
-;;; Emacsen running under the same username.
-;;;
-;;; The vc-next-action code has the following windows:
-;;;
-;;; Window P:
-;;; Between the check for existence of a master file and the call to
-;;; admin/checkin in vc-buffer-admin (apparent state A). This window may
-;;; never close if the initial-comment feature is on.
-;;;
-;;; Window Q:
-;;; Between the call to vc-workfile-unchanged-p in and the immediately
-;;; following revert (apparent state C).
-;;;
-;;; Window R:
-;;; Between the call to vc-workfile-unchanged-p in and the following
-;;; checkin (apparent state D). This window may never close.
-;;;
-;;; Window S:
-;;; Between the unlock and the immediately following checkout during a
-;;; revert operation (apparent state C). Included in window Q.
-;;;
-;;; Window T:
-;;; Between vc-locking-user and the following checkout (apparent state B).
-;;;
-;;; Window U:
-;;; Between vc-locking-user and the following revert (apparent state C).
-;;; Includes windows Q and S.
-;;;
-;;; Window V:
-;;; Between vc-locking-user and the following checkin (apparent state
-;;; D). This window may never be closed if the user fails to complete the
-;;; checkin message. Includes window R.
-;;;
-;;; Window W:
-;;; Between vc-locking-user and the following steal-lock (apparent
-;;; state E). This window may never close if the user fails to complete
-;;; the steal-lock message. Includes window X.
-;;;
-;;; Window X:
-;;; Between the unlock and the immediately following re-lock during a
-;;; steal-lock operation (apparent state E). This window may never cloce
-;;; if the user fails to complete the steal-lock message.
-;;;
-;;; Errors:
-;;;
-;;; Apparent state A ---
-;;;
-;;; 1. File looked unregistered but is actually registered and not locked.
-;;;
-;;; Potential cause: someone else's admin during window P, with
-;;; caller's admin happening before their checkout.
-;;;
-;;; RCS: ci will fail with a "no lock set by <user>" message.
-;;; SCCS: admin will fail with error (ad19).
-;;;
-;;; We can let these errors be passed up to the user.
-;;;
-;;; 2. File looked unregistered but is actually locked by caller, unchanged.
-;;;
-;;; Potential cause: self-race during window P.
-;;;
-;;; RCS: will revert the file to the last saved version and unlock it.
-;;; SCCS: will fail with error (ad19).
-;;;
-;;; Either of these consequences is acceptable.
-;;;
-;;; 3. File looked unregistered but is actually locked by caller, changed.
-;;;
-;;; Potential cause: self-race during window P.
-;;;
-;;; RCS: will register the caller's workfile as a delta with a
-;;; null change comment (the -t- switch will be ignored).
-;;; SCCS: will fail with error (ad19).
-;;;
-;;; 4. File looked unregistered but is locked by someone else.
-;;;
-;;; Potential cause: someone else's admin during window P, with
-;;; caller's admin happening *after* their checkout.
-;;;
-;;; RCS: will fail with a "no lock set by <user>" message.
-;;; SCCS: will fail with error (ad19).
-;;;
-;;; We can let these errors be passed up to the user.
-;;;
-;;; Apparent state B ---
-;;;
-;;; 5. File looked registered and not locked, but is actually unregistered.
-;;;
-;;; Potential cause: master file got nuked during window P.
-;;;
-;;; RCS: will fail with "RCS/<file>: No such file or directory"
-;;; SCCS: will fail with error ut4.
-;;;
-;;; We can let these errors be passed up to the user.
-;;;
-;;; 6. File looked registered and not locked, but is actually locked by the
-;;; calling user and unchanged.
-;;;
-;;; Potential cause: self-race during window T.
-;;;
-;;; RCS: in the same directory as the previous workfile, co -l will fail
-;;; with "co error: writable foo exists; checkout aborted". In any other
-;;; directory, checkout will succeed.
-;;; SCCS: will fail with ge17.
-;;;
-;;; Either of these consequences is acceptable.
-;;;
-;;; 7. File looked registered and not locked, but is actually locked by the
-;;; calling user and changed.
-;;;
-;;; As case 6.
-;;;
-;;; 8. File looked registered and not locked, but is actually locked by another
-;;; user.
-;;;
-;;; Potential cause: someone else checks it out during window T.
-;;;
-;;; RCS: co error: revision 1.3 already locked by <user>
-;;; SCCS: fails with ge4 (in directory) or ut7 (outside it).
-;;;
-;;; We can let these errors be passed up to the user.
-;;;
-;;; Apparent state C ---
-;;;
-;;; 9. File looks locked by calling user and unchanged, but is unregistered.
-;;;
-;;; As case 5.
-;;;
-;;; 10. File looks locked by calling user and unchanged, but is actually not
-;;; locked.
-;;;
-;;; Potential cause: a self-race in window U, or by the revert's
-;;; landing during window X of some other user's steal-lock or window S
-;;; of another user's revert.
-;;;
-;;; RCS: succeeds, refreshing the file from the identical version in
-;;; the master.
-;;; SCCS: fails with error ut4 (p file nonexistent).
-;;;
-;;; Either of these consequences is acceptable.
-;;;
-;;; 11. File is locked by calling user. It looks unchanged, but is actually
-;;; changed.
-;;;
-;;; Potential cause: the file would have to be touched by a self-race
-;;; during window Q.
-;;;
-;;; The revert will succeed, removing whatever changes came with
-;;; the touch. It is theoretically possible that work could be lost.
-;;;
-;;; 12. File looks like it's locked by the calling user and unchanged, but
-;;; it's actually locked by someone else.
-;;;
-;;; Potential cause: a steal-lock in window V.
-;;;
-;;; RCS: co error: revision <rev> locked by <user>; use co -r or rcs -u
-;;; SCCS: fails with error un2
-;;;
-;;; We can pass these errors up to the user.
-;;;
-;;; Apparent state D ---
-;;;
-;;; 13. File looks like it's locked by the calling user and changed, but it's
-;;; actually unregistered.
-;;;
-;;; Potential cause: master file got nuked during window P.
-;;;
-;;; RCS: Checks in the user's version as an initial delta.
-;;; SCCS: will fail with error ut4.
-;;;
-;;; This case is kind of nasty. It means VC may fail to detect the
-;;; loss of previous version information.
-;;;
-;;; 14. File looks like it's locked by the calling user and changed, but it's
-;;; actually unlocked.
-;;;
-;;; Potential cause: self-race in window V, or the checkin happening
-;;; during the window X of someone else's steal-lock or window S of
-;;; someone else's revert.
-;;;
-;;; RCS: ci will fail with "no lock set by <user>".
-;;; SCCS: delta will fail with error ut4.
-;;;
-;;; 15. File looks like it's locked by the calling user and changed, but it's
-;;; actually locked by the calling user and unchanged.
-;;;
-;;; Potential cause: another self-race --- a whole checkin/checkout
-;;; sequence by the calling user would have to land in window R.
-;;;
-;;; SCCS: checks in a redundant delta and leaves the file unlocked as usual.
-;;; RCS: reverts to the file state as of the second user's checkin, leaving
-;;; the file unlocked.
-;;;
-;;; It is theoretically possible that work could be lost under RCS.
-;;;
-;;; 16. File looks like it's locked by the calling user and changed, but it's
-;;; actually locked by a different user.
-;;;
-;;; RCS: ci error: no lock set by <user>
-;;; SCCS: unget will fail with error un2
-;;;
-;;; We can pass these errors up to the user.
-;;;
-;;; Apparent state E ---
-;;;
-;;; 17. File looks like it's locked by some other user, but it's actually
-;;; unregistered.
-;;;
-;;; As case 13.
-;;;
-;;; 18. File looks like it's locked by some other user, but it's actually
-;;; unlocked.
-;;;
-;;; Potential cause: someone released a lock during window W.
-;;;
-;;; RCS: The calling user will get the lock on the file.
-;;; SCCS: unget -n will fail with cm4.
-;;;
-;;; Either of these consequences will be OK.
-;;;
-;;; 19. File looks like it's locked by some other user, but it's actually
-;;; locked by the calling user and unchanged.
-;;;
-;;; Potential cause: the other user relinquishing a lock followed by
-;;; a self-race, both in window W.
-;;;
-;;; Under both RCS and SCCS, both unlock and lock will succeed, making
-;;; the sequence a no-op.
-;;;
-;;; 20. File looks like it's locked by some other user, but it's actually
-;;; locked by the calling user and changed.
-;;;
-;;; As case 19.
-;;;
-;;; PROBLEM CASES:
-;;;
-;;; In order of decreasing severity:
-;;;
-;;; Cases 11 and 15 under RCS are the only one that potentially lose work.
-;;; They would require a self-race for this to happen.
-;;;
-;;; Case 13 in RCS loses information about previous deltas, retaining
-;;; only the information in the current workfile. This can only happen
-;;; if the master file gets nuked in window P.
-;;;
-;;; Case 3 in RCS and case 15 under SCCS insert a redundant delta with
-;;; no change comment in the master. This would require a self-race in
-;;; window P or R respectively.
-;;;
-;;; Cases 2, 10, 19 and 20 do extra work, but make no changes.
-;;;
-;;; Unfortunately, it appears to me that no recovery is possible in these
-;;; cases. They don't yield error messages, so there's no way to tell that
-;;; a race condition has occurred.
-;;;
-;;; All other cases don't change either the workfile or the master, and
-;;; trigger command errors which the user will see.
-;;;
-;;; Thus, there is no explicit recovery code.
-
-;;; ClearCase extensions:
-
-;;; vc-edit-config
-
-(defvar vc-config-edit-mode nil)
-
-(defvar vc-tag-name nil
- "Name of view tag which is currently being edited")
-
-(if vc-config-edit-mode
- nil
- (setq vc-config-edit-mode (make-sparse-keymap))
- (define-key vc-config-edit-mode "\C-c\C-c" 'vc-finish-config)
- (define-key vc-config-edit-mode "\C-x\C-s" 'vc-save-config))
-
-(defsubst vc-temp-filename ()
- (make-temp-name "/tmp/VC-"))
-
-(defun vc-save-config ()
- (interactive)
- (if (not (buffer-modified-p))
- (message "Configuration not changed since last saved")
- (let ((tmp (vc-temp-filename)))
- (unwind-protect
- (progn
- (message "Setting configuration for %s..." vc-tag-name)
- (write-region (point-min) (point-max) tmp nil 'dont-mention-it)
- (let ((vc-command-messages t))
- (vc-cleartool-cmd default-directory
- (format "setcs -tag %s %s" vc-tag-name tmp)))
- (set-buffer-modified-p nil)
- (message "Setting configuration for %s...done" vc-tag-name))
- (if (file-exists-p tmp)
- (delete-file tmp))))))
-
-(defun vc-finish-config ()
- (interactive)
- (let ((old-buffer (current-buffer)))
- (vc-save-config)
- (bury-buffer nil)
-;; (if (bufferp vc-parent-buffer)
-;; (pop-to-buffer vc-parent-buffer))
- (kill-buffer old-buffer)))
-
-(defun vc-config-edit-mode ()
- (interactive)
- (set-syntax-table text-mode-syntax-table)
- (use-local-map vc-config-edit-mode)
- (setq major-mode 'vc-config-edit-mode)
- (setq mode-name "VC-Config")
- (make-variable-buffer-local 'vc-parent-buffer)
- (set-buffer-modified-p nil)
- (setq buffer-file-name nil)
- (run-hooks 'text-mode-hook 'vc-config-edit-mode-hook))
-
-(defun vc-cc-tagname (str)
- "Extract the view tag name from a view-extended-pathname"
- (and str
- (stringp str)
- (string-match "^/view/\\([^/]+\\)" str)
- (substring str
- (match-beginning 1)
- (match-end 1))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cc-pwv (path)
- (or (vc-cc-tagname path)
- (vc-cc-tagname (getenv "CLEARCASE_ROOT"))))
-
-(defvar vc-tag-history ()
- "History of view tags used in vc-edit-config")
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-edit-config (tag-name)
- "Edit a ClearCase configuration specification"
- (interactive
- (let ((vxname (vc-cc-pwv default-directory)))
- (list (directory-file-name
- (completing-read "View Tag: "
- (vc-cc-get-view-cache-noslash)
- nil
- 'fascist
- vxname
- 'vc-tag-history)))))
- (let ((start (current-buffer))
- (buffer-name (format "*VC-Config-%s*" tag-name)))
- (kill-buffer (get-buffer-create buffer-name))
- (pop-to-buffer (get-buffer-create buffer-name))
- (auto-save-mode auto-save-default)
- (erase-buffer)
- (insert (vc-cleartool-cmd default-directory
- (format "catcs -tag %s" tag-name)))
- (goto-char (point-min))
- (re-search-forward "^[^#\n]" nil 'end)
- (beginning-of-line)
- (vc-config-edit-mode)
- (setq vc-parent-buffer start)
- (make-local-variable 'vc-tag-name)
- (setq vc-tag-name tag-name))
- )
-
-(defun vc-nosupport (which op)
- (error (format "%s does not support %s" which op)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-graph-history (arg)
- "Display a graph of a file's history"
- (interactive "p")
- (let ((pathname (cond (vc-dired-mode (dired-get-filename))
- (buffer-file-name)
- (default-directory)))
- (vtreearg (cond ((eq arg 1) nil)
- ((eq arg 4) "-all ")
- ((eq arg 16) "-nmerge ")))
- (debug-on-error t))
- (vc-backend-dispatch
- pathname
- (vc-nosupport 'SCCS 'graph-history)
- (vc-nosupport 'RCS 'graph-history)
- (vc-nosupport 'CVS 'graph-history)
- (progn
- (if vc-alternate-lsvtree
- (start-process "lsvtree" (get-buffer-create "*lsvtree*")
- vc-alternate-lsvtree pathname)
- (vc-cleartool-cmd pathname
- (concat "xlsvtree " vtreearg pathname)))
- (message "xlsvtree window for %s should appear shortly" pathname)))))
-
-(defvar cleartool-tq nil
- "Transaction queue to talk to ClearTool in a subprocess")
-
-(defvar vc-return nil
- "Return value when we're involved in a blocking call")
-
-(defvar cleartool-view ""
- "Current view of cleartool subprocess, or the empty string if none")
-
-(defvar cleartool-wdir ""
- "Current working directory of cleartool subprocess, or the empty string if none")
-
-(defvar vc-running nil)
-
-(defconst vc-subproc-timeout 30
- "Timeout on calls to subprocess")
-
-(defun vc-accept-process-output (proc timeout)
- (if vc-elucidated
- (accept-process-output proc)
- (accept-process-output proc timeout)))
-
-(defun vc-start-cleartool ()
- (interactive)
- (let ((process-environment (append '("ATRIA_NO_BOLD=1"
- "ATRIA_FORCE_GUI=1")
- ;;; emacs is a GUI, right? :-)
- process-environment)))
- (let ((cleartool-process (start-process "cleartool" "*cleartool*" vc-cleartool-path)))
- (process-kill-without-query cleartool-process)
- (setq cleartool-view "")
- (setq cleartool-tq (tq-create cleartool-process))
- (tq-enqueue cleartool-tq "" "[.\n]*cleartool> " 'vc-running 'set)
- (while (not vc-running)
- (message "waiting for cleartool to start...")
- (vc-accept-process-output (tq-process cleartool-tq) vc-subproc-timeout))
- (message "waiting for cleartool to start...done"))))
-
-(defun vc-kill-cleartool ()
- "Kill off cleartool subprocess. If another one is needed,
-it will be restarted. This may be useful if you're debugging clearcase."
- (interactive)
- (vc-kill-tq))
-
-(defun vc-callback (arg val)
- (setq vc-return (substring val 0 -11)))
-
-;;(defun vc-foo (cmd)
-;; (interactive)
-;; (tq-enqueue cleartool-tq cmd "[.\n]*\ncleartool> " nil 'vc-callback)
-;; )
-
-(defvar vc-cc-uninteresting-commands "\\(describe\\|lsview\\)")
-
-(defun vc-do-cleartool-command (command file comment &rest flags)
- "Execute a cleartool version-control command, notifying user and checking for errors.
-Output from COMMAND goes to buffer *vc*. The last argument of the command is
-the master name of FILE; this is appended to an optional list of FLAGS."
- (if file
- (setq file (expand-file-name file)))
- (if (listp command)
-;; (progn
-;; (setq flags (append (cdr command) flags))
-;; (setq command (car command)))
- (error "command must not be a list"))
- (if vc-command-messages
- (message "Running %s on %s..." command file))
- (let ((obuf (current-buffer)) (camefrom (current-buffer))
- (squeezed nil)
- (vc-file (and file (or (vc-name file) file)))
- status)
- (set-buffer (get-buffer-create "*vc*"))
- (set (make-local-variable 'vc-parent-buffer) camefrom)
- (set (make-local-variable 'vc-parent-buffer-name)
- (concat " from " (buffer-name camefrom)))
- (erase-buffer)
- ;; This is so that command arguments typed in the *vc* buffer will
- ;; have reasonable defaults.
- (if file
- (setq default-directory (file-name-directory file)))
-
- (mapcar
- (function (lambda (s)
- (and s
- (setq squeezed
- (concat squeezed " " s)))))
- flags)
- (let ((tmpfile (vc-temp-filename)))
- (unwind-protect
- (progn
- (if (not (eq comment 'unused))
- (if comment
- (progn
- (write-region comment nil tmpfile nil 'noprint)
- (setq squeezed (concat squeezed " -cfile " tmpfile)))
- (setq squeezed (concat squeezed " -nc"))))
- (if vc-file
- (setq squeezed (concat squeezed " " vc-file)))
- (let ((default-directory (file-name-directory
- (or file default-directory))))
- (vc-cc-cd default-directory)
- (if vc-command-messages
- (message "Running %s %s..." command squeezed))
- (insert
- (vc-cleartool-cmd file (concat command " " squeezed)))
- (if vc-command-messages
- (message "Running %s %s...done" command squeezed))))
- (if (file-exists-p tmpfile)
- (delete-file tmpfile))))
- (goto-char (point-min))
- (if (re-search-forward "^cleartool: Error:.*$" nil t)
- (progn
- (setq status (buffer-substring (match-beginning 0) (match-end 0)))
- (pop-to-buffer "*vc*")
- (goto-char (point-min))
- (shrink-window-if-larger-than-buffer)
- (error "Running %s...FAILED (%s)" squeezed status))
- (if vc-command-messages
- (message "Running %s...OK" command)))
- (set-buffer obuf)
- status))
-
-(defun vc-cc-cd (dir)
- (if (or (not dir)
- (string= dir cleartool-wdir))
- cleartool-wdir
- (vc-setview (vc-cc-pwv dir))
- (let ((ret (vc-cleartool-blocking-call (format "cd %s" dir))))
- (if (string-match "cleartool: Error:" ret)
- (error (substring ret (match-end 0)))
- (setq cleartool-wdir dir)))))
-
-(defun vc-setview (view)
- "Set the cleartool subprocess to a named view"
- (if (or (not view)
- (string= view cleartool-view))
- cleartool-view
- (let ((ret (vc-cleartool-blocking-call (format "setview %s" view))))
- (if (string-match "cleartool: Error:" ret)
- (error (substring ret (match-end 0)))
- (setq cleartool-view view)))))
-
-(defun vc-cleartool-cmd (path cmd)
- (vc-setview (vc-cc-pwv path))
- (vc-cleartool-blocking-call cmd))
-
-(defun vc-cleartool-blocking-call (cmd)
- (interactive)
- (save-excursion
- (setq vc-return nil)
- (if (not cleartool-tq)
- (vc-start-cleartool))
- (unwind-protect
- (progn
- (tq-enqueue cleartool-tq (concat cmd "\n") "[.\n]*cleartool> " nil 'vc-callback)
- (while (not vc-return)
- (vc-accept-process-output (tq-process cleartool-tq) vc-subproc-timeout)))
- (while (tq-queue cleartool-tq)
- (tq-queue-pop cleartool-tq))))
- vc-return)
-
-(defun vc-kill-tq ()
- (process-send-eof (tq-process cleartool-tq))
- (kill-process (tq-process cleartool-tq))
- (setq vc-running nil)
- (setq cleartool-tq nil))
-
-(defun vc-what-the-hey ()
- (let ((kill-buffer-hook nil))
- (if (eq (current-buffer) (tq-buffer cleartool-tq))
- (error "Don't kill TQ buffer %s, use `vc-kill-tq'" (current-buffer)))
- ))
-;; (debug nil "Killing TQ buffer" (current-buffer)))))
-(add-hook 'kill-buffer-hook 'vc-what-the-hey)
-
-(defun vc-split-string (pat str &optional indir suffix)
- (let ((ret nil)
- (start 0)
- (last (length str)))
- (while (< start last)
- (if (string-match pat str start)
- (progn
- (let ((tmp (substring str start (match-beginning 0))))
- (if suffix (setq tmp (concat tmp suffix)))
- (setq ret (cons (if indir (cons tmp nil)
- tmp)
- ret)))
- (setq start (match-end 0)))
- (setq start last)
- (setq ret (cons (substring str start) ret))))
- (nreverse ret)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-mkbrtype (typename comment)
- (interactive "sBranch type name: \nsBranch type comment: ")
- (message "%s" (vc-cleartool-cmd default-directory
- (format "mkbrtype -vob %s -c '%s' %s"
- default-directory comment typename))))
-
-;;; warn when editing files which *should* be under change
-;;; control, but aren't.
-;;;
-
-(defvar vc-controlled-trees ()
- "*A list of regexps; if any of these match buffer-file name, and
-the file in question is not under version control, an error will be signalled")
-
-(defun vc-edit-warn ()
- (let ((need-work
- (and buffer-file-name
- buffer-file-number
- (not vc-mode)
- (let ((paths vc-controlled-trees))
- (catch 'break
- (while paths
- (if (string-match (car paths) buffer-file-name)
- (throw 'break t))
- (setq paths (cdr paths))))))))
- (if need-work
- (progn
- (vc-register)
- (if buffer-read-only
- (vc-toggle-read-only))))))
-
-;; This causes XEmacs 19.15 VM MIME to fail.
-;; (add-hook 'first-change-hook 'vc-edit-warn)
-
-;;; completions, view autostart in /view given view registry
-
-(defvar vc-cc-known-view-cache nil
- "Cache of views known to the local system.")
-
-(defvar vc-cc-view-cache-timeout 300
- "*Default timeout of view list cache, in seconds.")
-
-(defun vc-timeout (delay function arg)
- (if (fboundp 'start-itimer)
- (start-itimer "VC-CC-Cache" function delay)
- (if (fboundp 'run-at-time)
- (run-at-time (format "%s sec" delay) nil function arg)
- (error "vc-timeout: don't know how to set a timeout function"))))
-
-(defun vc-cc-known-views ()
- (message "Fetching view names...")
- (let ((raw-views (vc-cleartool-blocking-call "lsview -short")))
- (prog1
- (vc-split-string "\n *" raw-views t "/")
- (message "Fetching view names...done"))))
-
-(defun vc-cc-get-view-cache ()
- (or vc-cc-known-view-cache
- (progn
- (let ((default-directory "/"))
- (vc-timeout vc-cc-view-cache-timeout
- (function (lambda (&rest ignore)
- (setq vc-cc-known-view-cache nil)))
- nil))
- (setq vc-cc-known-view-cache (vc-cc-known-views)))))
-
-(defun vc-cc-get-view-cache-noslash ()
- (let ((cache (vc-cc-get-view-cache)))
- (mapcar (lambda (vn)
- (let ((tmp (car vn)))
- (cons (substring tmp 0 (- (length tmp) 1))
- (cdr vn))))
- cache)))
-
-(defun vc-cc-start-view (view-tag)
- (let ((tagfile (file-name-as-directory view-tag)))
- (if (assoc tagfile (vc-cc-get-view-cache))
- (let ((tagname (directory-file-name view-tag)))
- (message "Starting view server for %s..." tagname)
- (vc-cleartool-blocking-call (format "startview %s"
- (directory-file-name tagname)))
- (message "Starting view server for %s...done" tagname)))))
-
-(defun vc-syslog (buf value)
- (save-excursion
- (let ((tmpbuf (get-buffer buf)))
- (if (bufferp tmpbuf)
- (progn
- (set-buffer buf)
- (goto-char (point-max))
- (insert (format "%s\n" value)))))))
-
-(defun vc-cc-dedouble (pathname)
- (let ((root (file-name-as-directory (or (getenv "CLEARCASE_ROOT") ""))))
- (if (stringp pathname)
- (cond ((string-match "^/view/[^/]+\\(/view/\\)" pathname)
- (vc-cc-dedouble (substring pathname (match-beginning 1))))
- ((string= root "/")
- pathname)
- ((and (< (length root) (length pathname))
- (string= root (substring pathname 0 (length root))))
- (vc-cc-dedouble (substring pathname (- (length root) 1))))
- (t
- pathname)))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cc-file-handler (operation &rest args)
- (save-match-data
- (let* ((file-name-handler-alist nil)
- (path (vc-cc-dedouble (car args)))
- (tag (vc-cc-tagname path)))
- (setq default-directory (vc-cc-dedouble default-directory))
- (vc-syslog "*FH*" (cons operation args))
- (if tag
- (or (file-exists-p (format "/view/%s" tag))
- (vc-cc-start-view tag)))
- (apply operation args))))
-
-(defun vc-view-completion (file dir)
- (try-completion file (vc-cc-get-view-cache)))
-
-(defun vc-view-completions (file dir)
- (all-completions file (vc-cc-get-view-cache)))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cc-view-handler (operation &rest args)
- (save-match-data
- (vc-syslog "*FH*" (cons "VIEW:" (cons operation args)))
- (let ((file-name-handler-alist nil))
- (cond ((eq operation 'file-name-completion)
- (apply 'vc-view-completion args))
- ((eq operation 'file-name-all-completions)
- (apply 'vc-view-completions args))
- (t (apply operation args))))))
-
-;; vc-cc-what
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cc-what-rule (file)
- (interactive (list (cond (vc-dired-mode (dired-get-filename))
- (buffer-file-name)
- (default-directory))))
-
- ;; File should not have a version extension, it will not have a rule!
- (setq file (vc-cc-element-name file))
-
- (let ((result (vc-cleartool-cmd file (format "ls -d %s" file))))
- (if (string-match "Rule: \\(.*\\)\n" result)
- (message (substring result
- ;; Be a little more verbose
- (match-beginning 0) (match-end 1)))
- (error result)
- )))
-
-;;(defun vc-cc-enumerate-versions (file)
-;; "Produce an alist, suitable for the completion functions, of the
-;;versions of the element named by FILE"
-;; (message "Finding versions of %s..." file)
-;; (let ((versions nil))
-;; (vc-file-tree-walk-internal
-;; (vc-cc-build-version file "")
-;; (function (lambda (f &rest args)
-;; (if (not (string-match "/CHECKEDOUT[^/]*$" f))
-;; (setq versions
-;; (cons (list (vc-cc-version-name f))
-;; versions)))))
-;; nil
-;; t)
-;; (message "Finding versions of %s...done" file)
-;; (nreverse versions)))
-
-(defun vc-cc-enumerate-versions (file)
- "Produce an alist, suitable for the completion functions, of the
-versions of the element named by FILE"
- (message "Finding versions of %s..." file)
- (let ((raw-info (vc-cleartool-cmd
- default-directory
- (format "lsvtree -all -nco -short %s" file))))
- (prog1
- (mapcar (function (lambda (x)
- (list (vc-cc-version-name x))))
- (vc-split-string "\n" raw-info))
- (message "Finding versions of %s...done" file))))
-
-(defsubst vc-buffer-match (tag)
- (buffer-substring (match-beginning tag)
- (match-end tag)))
-
-(defun vc-extract-environ-from-view-1 (tag)
- (let ((tmp-buffer (generate-new-buffer " *env temp*"))
- ret)
- (unwind-protect
- (save-excursion
- (set-buffer tmp-buffer)
- (insert (vc-cleartool-blocking-call (format "catcs -tag %s" tag)))
- (goto-char (point-min))
- (keep-lines "%ENV%")
- (goto-char (point-min))
- (while (re-search-forward "^.*%ENV%[ \t]\\(.*\\)=\\(.*\\)$" nil t)
- (setq ret (cons (format "%s=%s"
- (vc-buffer-match 1)
- (vc-buffer-match 2))
- ret)))
- ret)
- (kill-buffer tmp-buffer))))
-
-(defun vc-add-env (env var)
- (catch 'return
- (let ((a env)
- (vname (substring var 0
- (and (string-match "=" var)
- (match-end 0)))))
- (let ((vnl (length vname)))
- (while a
- (if (and (> (length (car a)) vnl)
- (string= (substring (car a) 0 vnl)
- vname))
- (throw 'return env))
- (setq a (cdr a)))
- (cons var env)))))
-
-(defun vc-extract-environ-from-view (old-env tag &optional add-ons)
- (let ((newenv nil)
- (cc-env (vc-extract-environ-from-view-1 tag)))
- (while add-ons
- (setq newenv (vc-add-env newenv (car add-ons)))
- (setq add-ons (cdr add-ons)))
- (while cc-env
- (setq newenv (vc-add-env newenv (car cc-env)))
- (setq cc-env (cdr cc-env)))
- (while old-env
- (setq newenv (vc-add-env newenv (car old-env)))
- (setq old-env (cdr old-env)))
- newenv))
-
-(defsubst vc-setview-arglist (dir args)
- (let ((r (concat (if dir (format "cd %s; " dir) "")
- "exec "
- (mapconcat 'identity args " "))))
- (insert r "\n")
- r))
-
-(if (not (fboundp 'dired-get-filename))
-(defun dired-get-filename (&optional localp no-error-if-not-filep)
- "In dired, return name of file mentioned on this line.
-Value returned normally includes the directory name.
-Optional arg LOCALP with value `no-dir' means don't include directory
- name in result. A value of t means construct name relative to
- `default-directory', which still may contain slashes if in a subdirectory.
-Optional arg NO-ERROR-IF-NOT-FILEP means return nil if no filename on
- this line, otherwise an error occurs."
- (let (case-fold-search file p1 p2)
- (save-excursion
- (if (setq p1 (dired-move-to-filename (not no-error-if-not-filep)))
- (setq p2 (dired-move-to-end-of-filename no-error-if-not-filep))))
- ;; nil if no file on this line, but no-error-if-not-filep is t:
- (if (setq file (and p1 p2 (format "%s" (buffer-substring p1 p2))))
- ;; Check if ls quoted the names, and unquote them.
- ;; Using read to unquote is much faster than substituting
- ;; \007 (4 chars) -> ^G (1 char) etc. in a lisp loop.
- (cond ((string-match "b" dired-actual-switches) ; System V ls
- ;; This case is about 20% slower than without -b.
- (setq file
- (read
- (concat "\""
- ;; some ls -b don't escape quotes, argh!
- ;; This is not needed for GNU ls, though.
- (or (dired-string-replace-match
- "\\([^\\]\\)\"" file "\\1\\\\\"")
- file)
- "\""))))
- ;; If you do this, update dired-insert-subdir-validate too
- ;; ((string-match "Q" dired-actual-switches) ; GNU ls
- ;; (setq file (read file)))
- ))
- (if (or (eq localp 'no-dir) (null file) (eq (aref file 0) ?/))
- file
- (concat (dired-current-directory localp) file)))))
-
-;;;dont ###autoload, it conflicts with vc.el
-(defun vc-cc-browse-versions ()
- (interactive)
- (let ((file (cond (vc-dired-mode (dired-get-filename))
- (buffer-file-name)
- (default-directory))))
- (if (clearcase-element-p file)
- (if (boundp 'vc-mode)
- (let* ((clearcase-extended-name
- (concat (vc-cc-element-name file)
- "@@"
- (or (vc-cc-version-name file)
- (vc-latest-version file))))
- (dired-listing-switches (concat dired-listing-switches
- "tr"))
-;; (file-name-handler-alist nil) ;; shut off my special handler
- (clearcase-branch (file-name-directory clearcase-extended-name)))
- (if (file-exists-p clearcase-extended-name)
- (progn
- ;; Invoke dired on the directory of the version branch
- (dired clearcase-branch)
-
- (if (re-search-forward (concat "[ \t]+"
- "\\("
- (regexp-quote clearcase-branch)
- "\\)"
- "$")
- nil
- t)
- (goto-char (match-beginning 1))))
- (dired (concat file "@@")))))
- (error "Not a Clearcase element"))))
-
-;;----------------------------------------------------------------------------
-;; Advise various other functions to properly handle ClearCase extended paths
-;;----------------------------------------------------------------------------
-(defadvice gud-find-file (before vc-gud-find-file protect activate)
- "Sets the current view and comint-file-name-prefix if necessary for ClearCase support."
- (let ((tag (and (string-match "^\\(/view/[^/]+\\)" default-directory)
- (substring default-directory
- (match-beginning 1)
- (match-end 1)))))
- (and tag
- (ad-set-arg 0 (concat tag (ad-get-arg 0))))))
-
-(defadvice comint-exec-1 (around vc-comint-exec-1 protect activate)
- "Sets the current view and comint-file-name-prefix if necessary for ClearCase support."
- (let ((tag (vc-cc-pwv default-directory))
- (view-rel (vc-cc-relpath default-directory))
- (wdir-in-clearcase (file-directory-p ".@@/main")))
- (if (or (not (or (string-match "^/view/" default-directory)
- wdir-in-clearcase))
- (string= tag (vc-cc-pwv (getenv "CLEARCASE_ROOT"))))
- ad-do-it
- (let ((process-environment
- ;; If using termcap, we specify `emacs' as the terminal type
- ;; because that lets us specify a width.
- ;; If using terminfo, we specify `unknown' because that is
- ;; a defined terminal type. `emacs' is not a defined terminal
- ;; type and there is no way for us to define it here.
- ;; Some programs that use terminfo get very confused
- ;; if TERM is not a valid terminal type.
- (vc-extract-environ-from-view process-environment tag
- (if (and (boundp 'system-uses-terminfo)
- (symbol-value 'system-uses-terminfo))
- (list "EMACS=t" "TERM=unknown"
- (format "COLUMNS=%d" (frame-width)))
- (list "EMACS=t" "TERM=emacs"
- (format "TERMCAP=emacs:co#%d:tc=unknown" (frame-width)))))))
- (insert "setview " tag "\n")
- (make-variable-buffer-local 'comint-file-name-prefix)
- (setq comint-file-name-prefix (format "/view/%s" tag))
- (setq ad-return-value
- (start-process name buffer vc-cleartool-path
- "setview" "-exec"
-
- (vc-setview-arglist view-rel (cons command switches))
- tag))))))
-
-(defadvice start-process-shell-command (around vc-spsc protect activate)
- "Sets the current view and comint-file-name-prefix if necessary for ClearCase support."
- (let ((tag (vc-cc-pwv default-directory))
- (view-rel (vc-cc-relpath default-directory))
- (wdir-in-clearcase (file-directory-p ".@@/main")))
- (if (null wdir-in-clearcase)
- ad-do-it
- (let ((process-environment (vc-extract-environ-from-view process-environment tag)))
- (if (string= tag (vc-cc-pwv (getenv "CLEARCASE_ROOT")))
- ad-do-it
- (progn
- (insert "setview " tag "\n")
- (make-variable-buffer-local 'comint-file-name-prefix)
- (setq comint-file-name-prefix (format "/view/%s" tag))
-
- (setq ad-return-value
- (start-process name buffer vc-cleartool-path
- "setview" "-exec"
- (vc-setview-arglist view-rel args)
- tag))))))))
-
-;;; Hook into jka-compr so it knows a little about clearcase
-;;; version-extended names..
-
-(defvar vc-jka-compr-hook-installed nil
- "Is hook for vc installed in jka-compr?")
-
-(if (and (not vc-jka-compr-hook-installed)
- (fboundp 'jka-compr-installed-p)
- (jka-compr-installed-p))
- (progn
- (jka-compr-uninstall)
- (setq jka-compr-compression-info-list
- (append '(["\\.gz\\(@@.*\\)\\'"
- "zipping" "gzip" ("-c" "-q")
- "unzipping" "gzip" ("-c" "-q" "-d") nil t])
- jka-compr-compression-info-list))
- (setq auto-mode-alist
- (append '(("\\.gz\\(~\\|\\.~[0-9]+~\\)?\\'" nil jka-compr))
- auto-mode-alist))
- (setq vc-jka-compr-hook-installed t)
- (jka-compr-install)))
-
-;;; vc-cc.el ends here
-
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.04 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.03 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .hgignore: New file.
-
-2008-02-11 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.02 released.
-
-2007-11-30 Michael Sperber <mike@xemacs.org>
-
- * xetla-browse.el (jde-tree-widget): tree-widget.el has been
- renamed to jde-tree-widget.el.
-
-2005-12-29 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.01 released.
-
-2005-12-24 Steve Youngs <steve@sxemacs.org>
-
- * steve@eicq.org--2005/xetla--main--1.1--version-0 is released.
- See ./ChangeLog.d/ChangeLog-1.1 for details.
-
- * ChangeLog.d/*: New files.
-
- * package-info.in (description): Mention (S)XEmacs in the
- description.
- (provides): Remove smerge, it isn't part of XEtla anymore.
-
- * Makefile (AUTHOR_VERSION): Bump to
- steve@eicq.org--2005/xetla--main--1.1--version-0
- (ELCS): Remove smerge.el, it isn't part of XEtla anymore.
-
-2005-04-04 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.00 released.
-
-2005-04-04 Steve Youngs <steve@sxemacs.org>
-
- * New package
-
+++ /dev/null
-# do not edit -- automatically generated by arch changelog
-# non-id: automatic-ChangeLog--steve@eicq.org--2004/xetla--main--0.1
-#
-
-2004-12-21 04:18:48 GMT Steve Youngs <steve@eicq.org> patch-24
-
- Summary:
- Font lock updates.
- Revision:
- xetla--main--0.1--patch-24
-
- * xetla-defs.el (xetla-log-edit-font-lock-keywords): Add some colour to
- the Summary and Keywords header content.
- (xetla-cat-log-font-lock-keywords): Add font-locking to the entire
- buffer, not just the log headers.
-
-
- modified files:
- xetla-defs.el
-
-
-2004-12-20 17:40:42 GMT Steve Youngs <steve@eicq.org> patch-23
-
- Summary:
- remove unnecessary defvar from xetla-build.el
- Revision:
- xetla--main--0.1--patch-23
-
-
- modified files:
- xetla-build.el
-
-
-2004-12-20 17:26:41 GMT Steve Youngs <steve@eicq.org> patch-22
-
- Summary:
- Fix font-locking and "markerp nil" error from `C-x T a'
- Revision:
- xetla--main--0.1--patch-22
-
- * xetla.el (xetla-log-edit-mode): Call `font-lock-mode'.
- (xetla-cat-log-mode): Ditto.
- (xetla-changes-mode): Ditto.
- (xetla-changelog-mode): Ditto.
- (xetla-show-changes-buffer): Remove void variable
- `global-font-lock-mode'.
-
- * xetla-defs.el (xetla-changelog-font-lock-keywords): Rewrite, specifying
- the keywords without relying on `change-log-font-lock-keywords'. The
- format from `tla changelog' is slightly different from GNU style Changelog
- files so just using `change-log-font-lock-keywords' will not work.
-
- * xetla-defs.el (xetla-log-edit-font-lock-keywords): Use
- `xetla-changelog-font-lock-keywords'.
-
-
- modified files:
- xetla-defs.el xetla.el
-
-
-2004-12-17 05:59:49 GMT Steve Youngs <steve@eicq.org> patch-21
-
- Summary:
- Add autoload cookie to xetla-version<f>
- Revision:
- xetla--main--0.1--patch-21
-
-
- modified files:
- xetla.el
-
-
-2004-12-17 03:24:56 GMT Steve Youngs <steve@eicq.org> patch-20
-
- Summary:
- Improve `xetla-reload'.
- Revision:
- xetla--main--0.1--patch-20
-
- * xetla-core.el (xetla-reload): Handle XEtla's auto-autoloads.el file.
-
-
- modified files:
- xetla-core.el
-
-
-2004-12-17 03:06:31 GMT Steve Youngs <steve@eicq.org> patch-19
-
- Summary:
- Get rid of the need for xetla-xemacs.el.
- Revision:
- xetla--main--0.1--patch-19
-
- This patch removes the need to have xetla-xemacs.el.
-
- All of the "Use `foo' instead of `bar' are GNU/Emacs -> XEmacs
- corrections.
-
- * Makefile (SOURCES): Remove xetla-xemacs.el
-
- * xetla-browse.el (xetla-widget-archives-root-node-register-archive): Use
- `match-string' instead of `match-string-no-properties'.
-
- * xetla-browse.el (xetla-widget-archive-node-convert-to-source): Ditto.
-
- * xetla-browse.el (xetla-widget-version-control-show-revisions): Use
- `point-at-*' instead of `line-*-position' functions.
-
- * xetla-browse.el (xetla-browse-toggle-subtree-maybe): Ditto.
-
- * xetla-browse.el (xetla-browse-dash): Ditto.
-
- * xetla-build.el: No need to conditionalise on featurep 'xemacs.
- Remove cruft about mouse-avoidance.
- Add a defvar for `global-font-lock-mode' and
- `xetla-dead-process-buffer-queue'.
-
- * xetla-core.el: Don't require xetla-xemacs.
-
- * xetla-core.el (xetla-version-head): Use `point-at-*' instead of
- `line-*-position' functions.
-
- * xetla-core.el (xetla-archive-tree-build-archives): Ditto.
-
- * xetla-core.el (xetla-archive-tree-build-categories): Ditto.
-
- * xetla-core.el (xetla-archive-tree-build-branches): Ditto.
-
- * xetla-core.el (xetla-archive-tree-build-versions): Ditto.
-
- * xetla-core.el (xetla-archive-tree-build-revisions): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-archives): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-categories): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-branches): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-versions): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-revisions): Ditto.
-
- * xetla-core.el (xetla-name-read-refresh-cache): Use `buffer-substring'
- instead of `minibuffer-contents'.
-
- * xetla-core.el (xetla-reload): Don't try to unload `xetla-xemacs' or
- `xetla-emacs'.
-
- * xetla-defs.el (clone-process): Define it with `defun-when-void'.
-
- * xetla-defs.el (clone-buffer): Moved here from xetla-xemacs.el and
- defined with `defun-when-void'.
-
- * xetla-defs.el (xetla-name-read-minibuf-map): Use `window-minibuffer-p'
- and `buffer-substring' in place of `minibufferp' and
- `minibuffer-contents' respectively.
-
- * xetla-tips.el: Don't require xetla-xemacs or xetla-emacs.
-
- * xetla.el: Don't require xetla-xemacs.
-
- * xetla.el (xetla-generic-popup-menu-by-keyboard): Use `point-at-*'
- instead of `line-*-position'.
-
- * xetla.el (xetla-edit-log): Ditto.
-
- * xetla.el (xetla-add-log-entry-internal): Ditto.
-
- * xetla.el (xetla-show-changes-buffer): Ditto.
-
- * xetla.el (xetla-view-conflicts): Ditto.
-
- * xetla.el (xetla-file-get-revision-in-file): Ditto.
-
- * xetla.el (xetla-revisions-parse-list): Ditto.
-
- * xetla.el (xetla-bookmarks-missing-parse-changes): Ditto.
-
- * xetla.el (xetla-log-edit-next-field): Ditto.
-
- * xetla.el (xetla-log-edit-insert-log-for-merge): Ditto.
-
- * xetla.el (xetla-log-edit-insert-memorized-log): Ditto.
-
- * xetla.el (xetla-log-edit-keywords): Ditto.
-
- * xetla.el (xetla-log-edit-keywords-insert): Ditto.
-
- * xetla.el (xetla-changes-jump-to-change): Ditto.
-
- * xetla.el (xetla-changes-diff-or-list): Ditto.
-
- * xetla.el (xetla-changes-prev): Ditto.
-
- * xetla.el (xetla-changes-ediff): Ditto.
-
- * xetla.el (xetla-changes-get-file-at-point): Ditto.
-
- * xetla.el (xetla-tree-lint-parse-buffer): Ditto.
-
- * xetla.el (xetla-version): Ditto.
-
- * xetla.el (xetla-gnus-article-extract-log-message): Ditto.
-
- * xetla.el (xetla-generic-popup-menu-by-keyboard): Remove mouse-avoidence
- crud.
-
- * xetla.el (xetla-name-read-insert-default-archive): Use
- `window-minibuffer-p' and `buffer-substring' in place of `minibufferp'
- and `minibuffer-contents' respectively.
-
- * xetla.el (xetla-name-read-insert-info-at-point): Ditto.
-
- * xetla.el (xetla-name-read-insert-partner-previous): Ditto.
-
- * xetla.el (xetla-name-read-insert-partner-next): Ditto.
-
- * xetla.el (xetla-name-read-insert-ancestor): Ditto.
-
- * xetla.el (xetla-name-read-insert-bookmark-previous): Ditto.
-
- * xetla.el (xetla-name-read-insert-bookmark-next): Ditto.
-
- * xetla.el (xetla-register-archive): Use `match-string' instead of
- `match-string-no-properties'.
-
- * xetla.el (xetla-merge-summary-line-for-log): Ditto.
-
- * xetla.el: Defvar `vc-ignore-vc-files' at compile time.
-
- * xetla.el (xetla-find-file-hook): Simplify somebody's idea of logic by
- removing a useless `if' sexp.
-
-
- removed files:
- .arch-ids/xetla-xemacs.el.id xetla-xemacs.el
-
- modified files:
- Makefile xetla-browse.el xetla-build.el xetla-core.el
- xetla-defs.el xetla-tips.el xetla.el
-
-
-2004-12-16 23:57:55 GMT Steve Youngs <steve@eicq.org> patch-18
-
- Summary:
- Improve the list of log keywords.
- Revision:
- xetla--main--0.1--patch-18
-
- * xetla-defs.el (xetla-log-edit-keywords): Richer set of keywords.
- Remove autoload cookie.
-
-
- modified files:
- xetla-defs.el
-
-
-2004-12-16 17:45:45 GMT Steve Youngs <steve@eicq.org> patch-17
-
- Summary:
- Remove a bogus doc string
- Revision:
- xetla--main--0.1--patch-17
-
-
- modified files:
- xetla.el
-
-
-2004-12-16 17:40:06 GMT Steve Youngs <steve@eicq.org> patch-16
-
- Summary:
- Make `xetla-log-edit-done' mimic `add-log-exit' a bit more.
- Revision:
- xetla--main--0.1--patch-16
-
- * xetla.el (xetla-log-edit-done): Don't run `tla commit' unless there's a
- prefix arg.
-
-
- modified files:
- xetla.el
-
-
-2004-12-16 14:39:53 GMT Steve Youngs <steve@eicq.org> patch-15
-
- Summary:
- merge from hrop (finish removing buffers menu crap)
- Revision:
- xetla--main--0.1--patch-15
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-14
- flush install-buffers instead of commenting'em out
-
-
- modified files:
- xetla-browse.el xetla-core.el xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-14
-
-
-2004-12-16 05:20:45 GMT Steve Youngs <steve@eicq.org> patch-14
-
- Summary:
- merge from hrop (remove buffers menu)
- Revision:
- xetla--main--0.1--patch-14
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-12
- star merge from steve --patch-12 --patch-13
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-13
- flushing xetla-buffers menu
-
-
- modified files:
- xetla-browse.el xetla-core.el xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-12
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-13
-
-
-2004-12-09 09:09:55 GMT Steve Youngs <steve@eicq.org> patch-13
-
- Summary:
- merge from hrop... yet another -- to - fubar
- Revision:
- xetla--main--0.1--patch-13
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-11
- fix, some more s/-/--/ issue
-
-
- modified files:
- xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-11
-
-
-2004-12-06 23:34:26 GMT Steve Youngs <steve@eicq.org> patch-12
-
- Summary:
- merge from hrop
- Revision:
- xetla--main--0.1--patch-12
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-9
- fix, some more parsing corrections for dealing with tla archive strings
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-10
- fix, inventory mode now correctly respects prefix arguments
-
-
- modified files:
- xetla-core.el xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-9
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-10
-
-
-2004-12-02 09:00:45 GMT Steve Youngs <steve@eicq.org> patch-11
-
- Summary:
- merge from hrop
- Revision:
- xetla--main--0.1--patch-11
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-8
- abstraction
-
-
- modified files:
- xetla-core.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-8
-
-
-2004-11-29 21:19:36 GMT Steve Youngs <steve@eicq.org> patch-10
-
- Summary:
- merge from hrop (fix xetla-tree-version-list)
- Revision:
- xetla--main--0.1--patch-10
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-7
- minor fix to correctly identify tree version
-
-
- modified files:
- xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-7
-
-
-2004-11-27 00:36:28 GMT Steve Youngs <steve@eicq.org> patch-9
-
- Summary:
- merge from hrop (overlay -> extent conversion)
- Revision:
- xetla--main--0.1--patch-9
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-5
- star-merge <=patch-8 of steve-line
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-6
- evaporation of overlay cruft
-
-
- modified files:
- xetla-browse.el xetla-xemacs.el xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-5
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-6
-
-
-2004-11-25 11:28:01 GMT Steve Youngs <steve@eicq.org> patch-8
-
- Summary:
- Fix faces to work with XEmacs and fix tla cmd line args
- Revision:
- xetla--main--0.1--patch-8
-
- Looks like the initial xtla -> xetla renaming caused more problems than
- it solved. All the external tla command line args (the long options) got
- one of the leading dashes deleted. This fixes it.
-
- This patch goes a long way toward getting faces and font-locking working
- properly. It's not quite right yet, but at least there aren't any errors
- any more.
-
- * xetla-defs.el: Redo all the faces to work properly with XEmacs.
- (xetla-inventory-file-font-lock-keywords): Syntax fix for XEmacs.
- (xetla-log-edit-font-lock-keywords): Ditto.
- (xetla-changes-font-lock-keywords): Ditto.
- (xetla-changelog-font-lock-keywords): Ditto.
-
- * xetla-browse.el: Ditto.
-
- * xetla.el (xetla-inventory): Fix tla command line args that got messed
- up with the initial renaming.
-
- * xetla.el (xetla-changes): Ditto.
-
- * xetla.el (xetla-changes-internal): Ditto.
-
- * xetla.el (xetla-show-changeset): Ditto.
-
- * xetla.el (xetla-apply-changeset-internal): Ditto.
-
- * xetla.el (xetla-commit): Ditto.
-
- * xetla.el (xetla-logs): Ditto.
-
- * xetla.el (xetla-library-delete): Ditto.
-
- * xetla.el (xetla-library-find): Ditto.
-
- * xetla.el (xetla-star-merge): Ditto.
-
- * xetla.el (xetla-replay): Ditto.
-
- * xetla.el (xetla-tag): Ditto.
-
- * xetla.el (xetla-missing-refresh): Ditto.
-
- * xetla.el (xetla-bookmarks-tag): Ditto.
-
- * xetla.el (xetla-unregister-archive): Ditto.
-
- * xetla.el (xetla-make-archive-internal): Ditto.
-
- * xetla.el (xetla-mirror-archive): Ditto.
-
- * xetla.el (xetla-mirror-from-archive): Ditto.
-
- * xetla.el (xetla-cat-config): Ditto.
-
- * xetla.el (xetla-add): Ditto.
-
- * xetla.el (xetla-remove): Ditto.
-
- * xetla.el (xetla-start-project): Ditto.
-
- * xetla-core.el (xetla-archive-tree-build-revisions): Ditto.
-
- * xetla-core.el (xetla-revlib-tree-build-revisions): Ditto.
-
- * xetla-core.el (xetla-compute-direct-ancestor): Ditto.
-
- * xetla-core.el (xetla-escape): Ditto.
-
- * xetla-xemacs.el: Remove the font compatibility code.
-
- modified files:
- xetla-browse.el xetla-core.el xetla-defs.el xetla-xemacs.el
- xetla.el
-
-
-2004-11-25 05:55:35 GMT Steve Youngs <steve@eicq.org> patch-7
-
- Summary:
- Code audit - removing xtla/gna.org references.
- Revision:
- xetla--main--0.1--patch-7
-
- * xetla-tips.el (xetla-tips-array): Remove reference to gna.org.
-
- * xetla.el (xetla-submit-patch): Send patches to
- xetla-devel@youngs.au.com.
-
- * xetla.el (xetla-submit-bug-report): Send bugs to
- xetla-devel@youngs.au.com.
-
- * xetla.el (xetla): Update displayed info to be XEtla-centric.
-
-
- modified files:
- xetla-tips.el xetla.el
-
-
-2004-11-25 03:46:36 GMT Steve Youngs <steve@eicq.org> patch-6
-
- Summary:
- Build fixes for ewoc.el
- Revision:
- xetla--main--0.1--patch-6
-
- * ewoc.el (ewoc-dll): Remove this dummy variable and undo the `dll ->
- ewoc-dll' renaming.
- (dll): Bind as a variable at compile time only.
-
- This patch gives a clean compile for ewoc.el, and pretty much undoes
- Sebastian's attempt to fix it. :-P The problem with Sebastian's patch
- was that he did a global `dll -> ewoc-dll' replacement and there was a
- data type that relied on having 'dll'.
-
-
-
-
- modified files:
- ewoc.el
-
-
-2004-11-25 01:27:46 GMT Steve Youngs <steve@eicq.org> patch-5
-
- Summary:
- syncing up patch logs from hrop
- Revision:
- xetla--main--0.1--patch-5
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--base-0
- tag of steve@eicq.org--2004/xetla--main--0.1--base-0
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-2
- bypass compiler warnings
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-3
- fixing my fuckups
-
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--base-0
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-2
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-3
-
-
-2004-11-25 01:26:24 GMT Steve Youngs <steve@eicq.org> patch-4
-
- Summary:
- merge from hrop (ewoc.el warning fix)
- Revision:
- xetla--main--0.1--patch-4
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-4
- bypass compiler warnings
-
-
- modified files:
- ewoc.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-4
-
-
-2004-11-24 23:42:57 GMT Steve Youngs <steve@eicq.org> patch-3
-
- Summary:
- New file xetla.texi
- Revision:
- xetla--main--0.1--patch-3
-
-
- new files:
- .arch-ids/xetla.texi.id xetla.texi
-
-
-2004-11-24 23:41:43 GMT Steve Youngs <steve@eicq.org> patch-2
-
- Summary:
- Fix the rest of the renaming fubars and add a Makefile
- Revision:
- xetla--main--0.1--patch-2
-
- * xetla.el (xetla-revision-sync-tree): buxetlast -> butlast
- (xetla-revision-star-merge): Ditto.
- (xetla-revision-replay): Ditto.
- (xetla-library-add-internal): New, renamed from `xetla-library-add'. In
- the initial xtla -> xetla renaming there was a `tla-library-add' and a
- `tla--library-add', the keyboard macro I used to do the renaming didn't
- take this situation into account.
- (xetla-library-add-interactive): Use `xetla-library-add-internal'.
- (xetla-register-archive): Use `xetla-register-archive-internal'.
- (xetla-register-archive-internal): New.
- (xetla-edit-archive-location): Use `xetla-register-archive-internal'.
- (xetla-use-as-default-mirror): Ditto.
- (xetla-archive-convert-to-source-archive): Ditto.
- (xetla-make-archive-internal): New.
- (xetla-make-archive): Use it.
-
- * xetla-core.el (xetla-name-read-refresh-cache): Ditto.
-
- * xetla-browse.el (xetla-widget-archives-root-node-register-archive): Use
- `xetla-register-archive-internal'.
-
- * xetla-browse.el (xetla-widget-archives-root-node-make-archive): Use
- `xetla-make-archive-internal'.
-
- * Makefile: New.
-
- When I did the initial global renaming from xtla to xetla my keyboard
- macro didn't take into account things like `tla-foo-bar' and
- `tla--foo-bar' both existing. This patch takes care of that.
-
- It also introduces a Makefile for people who wish to byte-compile xetla.
-
-
- new files:
- .arch-ids/Makefile.id Makefile
-
- modified files:
- xetla-browse.el xetla-core.el xetla.el
-
-
-2004-11-24 21:17:37 GMT Steve Youngs <steve@eicq.org> patch-1
-
- Summary:
- from hrop... minor renaming fixes
- Revision:
- xetla--main--0.1--patch-1
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-1
- minor fixes
-
-
- modified files:
- xetla-core.el xetla-defs.el xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-1
-
-
-2004-11-24 15:43:59 GMT Steve Youngs <steve@eicq.org> base-0
-
- Summary:
- Initial import of XEtla
- Revision:
- xetla--main--0.1--base-0
-
- Initial import of XEtla.
- XEtla is based heavily on xtla, except that the emphasis is
- on XEmacs. We suspect that XEtla will diverge quite significantly
- from xtla.
-
- new files:
- BINDINGS COPYING FEATURES TODO ewoc.el smerge.el
- xetla-browse.el xetla-build.el xetla-core.el xetla-defs.el
- xetla-tips.el xetla-xemacs.el xetla.el
-
-
+++ /dev/null
-# do not edit -- automatically generated by arch changelog
-# non-id: automatic-ChangeLog--steve@eicq.org--2005/xetla--main--0.2
-#
-
-2005-03-11 13:31:17 GMT Steve Youngs <steve@eicq.org> version-0
-
- Summary:
- 0.2--version-0 is released
- Revision:
- xetla--main--0.2--version-0
-
-
-
-2005-03-11 06:34:11 GMT Steve Youngs <steve@eicq.org> patch-7
-
- Summary:
- Keymap fixes -- use `buttonN' not `mouse-N'
- Revision:
- xetla--main--0.2--patch-7
-
- * xetla.el (xetla-insert-button): Use `button' not `mouse' in keymaps.
- (xetla-inventory-insert-headers): Ditto.
-
- * xetla-defs.el (xetla-context-map-template): Ditto.
- (xetla-bookmarks-entry-map): Ditto.
- (xetla-inventory-item-map): Ditto.
- (xetla-inventory-tagging-method-map): Ditto.
- (xetla-tree-lint-file-map): Ditto.
- (xetla-archive-archive-map): Ditto.
- (xetla-category-category-map): Ditto.
- (xetla-branch-branch-map): Ditto.
- (xetla-version-version-map): Ditto.
- (xetla-revision-revision-map): Ditto.
- (xetla-changes-file-map): Ditto.
-
- * xetla-browse.el (xetla-widget-node-map): Ditto.
-
- * xetla-core.el (xetla-log-printer-print-buffer): Ditto.
-
-
- modified files:
- xetla-browse.el xetla-core.el xetla-defs.el xetla.el
-
-
-2005-03-10 06:29:43 GMT Steve Youngs <steve@eicq.org> patch-6
-
- Summary:
- Fix up some of the tips... Xetla -> XEtla
- Revision:
- xetla--main--0.2--patch-6
-
- * xetla-tips.el (xetla-tips-popup): Typo fix.
- (xetla-tips-array): Ditto.
-
-
- modified files:
- xetla-tips.el
-
-
-2005-03-10 06:18:31 GMT Steve Youngs <steve@eicq.org> patch-5
-
- Summary:
- Nuke the local vars in the source to avoid merge conflicts
- Revision:
- xetla--main--0.2--patch-5
-
- * xetla-browse.el: Remove local vars and "Last-Modified" header, it
- causes too many conflicts when merging.
-
- * xetla-build.el: Ditto.
-
- * xetla-core.el: Ditto.
-
- * xetla-defs.el: Ditto.
-
- * xetla-tips.el: Ditto.
-
- * xetla.el: Ditto.
-
- * xetla.texi: Ditto.
-
-
- modified files:
- xetla-browse.el xetla-build.el xetla-core.el xetla-defs.el
- xetla-tips.el xetla.el xetla.texi
-
-
-2005-03-10 06:11:01 GMT Steve Youngs <steve@eicq.org> patch-4
-
- Summary:
- Fix commit max-specpdl-size bug
- Revision:
- xetla--main--0.2--patch-4
-
- * xetla.el (xetla-commit): Set the :finished key to "handler" only. If
- handler is nil the default `xetla-default-finish-function' will be
- used.
-
- This fixes the variable exceeds max-specpdl-size bug.
-
- This patch was committed from XEtla itself using `C-u C-c C-c' in the
- xetla-log-edit buffer without error or warning.
-
- modified files:
- xetla.el
-
-
-2005-01-30 00:21:36 GMT Steve Youngs <steve@eicq.org> patch-3
-
- Summary:
- Typo in `xetla-delta', add a couple of keywords.
- Revision:
- xetla--main--0.2--patch-3
-
- * xetla.el (xetla-delta): `-diffs' -> `--diffs'.
-
- * xetla-defs.el (xetla-log-edit-keywords): Add `sync' and `security'.
-
-
- modified files:
- xetla-defs.el xetla.el
-
-
-2005-01-07 07:34:52 GMT Steve Youngs <steve@eicq.org> patch-2
-
- Summary:
- Some doc string clean up "xetla" -> "tla"
- Revision:
- xetla--main--0.2--patch-2
-
- * xetla.el (xetla-changes): Update doc strings -- "Run xetla foo" => "Run
- tla foo"
- (xetla-delta): Ditto.
- (xetla-show-changeset): Ditto.
- (xetla-redo): Ditto.
- (xetla-commit): Ditto.
- (xetla-import): Ditto.
- (xetla-logs): Ditto.
- (xetla-help): Ditto.
- (xetla-tree-root-xetla): Ditto.
- (xetla-my-id): Ditto.
- (xetla-my-revision-library): Ditto.
- (xetla-library-config): Ditto.
- (xetla-archive-fixup): Ditto.
- (xetla-tag): Ditto.
- (xetla-set-tree-version): Ditto.
- (xetla-tree-revisions): Ditto.
- (xetla-build-config): Ditto.
- (xetla-cat-config): Ditto.
- (xetla-get): Ditto.
- (xetla-update): Ditto.
- (xetla-inventory-star-merge): Ditto.
- (xetla-inventory-changes): Ditto.
- (xetla-inventory-replay): Ditto.
- (xetla-inventory-update): Ditto.
- (xetla-inventory-missing): Ditto.
- (xetla-inventory-delta): Ditto.
- (xetla-generic-set-tree-version): Ditto.
- (xetla-version-tag): Ditto.
- (xetla-revision-delta): Ditto.
- (xetla-revision-tag-from-head): Ditto.
- (xetla-revision-tag-from-here): Ditto.
- (xetla-revision-update): Ditto.
- (xetla-changes-diff): Ditto.
- (xetla-tree-lint): Ditto.
-
- * xetla-browse.el (xetla-widget-version-node-tag): Ditto.
-
- * xetla-core.el (xetla-run-tla-async): Ditto.
- (xetla-run-tla-sync): Ditto.
-
-
- modified files:
- xetla-browse.el xetla-core.el xetla.el
-
-
-2004-12-31 23:39:42 GMT Steve Youngs <steve@eicq.org> patch-1
-
- Summary:
- Add changelog from prev version, bump VER in Makefile
- Revision:
- xetla--main--0.2--patch-1
-
-
- new files:
- ChangeLog.d/.arch-ids/=id
- ChangeLog.d/.arch-ids/ChangeLog-0.1.id
- ChangeLog.d/ChangeLog-0.1
-
- modified files:
- Makefile
-
- new directories:
- ChangeLog.d ChangeLog.d/.arch-ids
-
-
-2004-12-31 21:40:56 GMT Steve Youngs <steve@eicq.org> base-0
-
- Summary:
- tag of steve@eicq.org--2004/xetla--main--0.1--patch-24
- Revision:
- xetla--main--0.2--base-0
-
- (automatically generated log message)
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--base-0
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-1
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-2
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-3
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-4
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-5
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-6
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-7
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-8
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-9
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-10
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-11
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-12
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-13
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--base-0
- steve@eicq.org--2004/xetla--main--0.1--patch-1
- steve@eicq.org--2004/xetla--main--0.1--patch-2
- steve@eicq.org--2004/xetla--main--0.1--patch-3
- steve@eicq.org--2004/xetla--main--0.1--patch-4
- steve@eicq.org--2004/xetla--main--0.1--patch-5
- steve@eicq.org--2004/xetla--main--0.1--patch-6
- steve@eicq.org--2004/xetla--main--0.1--patch-7
- steve@eicq.org--2004/xetla--main--0.1--patch-8
- steve@eicq.org--2004/xetla--main--0.1--patch-9
- steve@eicq.org--2004/xetla--main--0.1--patch-10
- steve@eicq.org--2004/xetla--main--0.1--patch-11
- steve@eicq.org--2004/xetla--main--0.1--patch-12
- steve@eicq.org--2004/xetla--main--0.1--patch-13
- steve@eicq.org--2004/xetla--main--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--patch-15
- steve@eicq.org--2004/xetla--main--0.1--patch-16
- steve@eicq.org--2004/xetla--main--0.1--patch-17
- steve@eicq.org--2004/xetla--main--0.1--patch-18
- steve@eicq.org--2004/xetla--main--0.1--patch-19
- steve@eicq.org--2004/xetla--main--0.1--patch-20
- steve@eicq.org--2004/xetla--main--0.1--patch-21
- steve@eicq.org--2004/xetla--main--0.1--patch-22
- steve@eicq.org--2004/xetla--main--0.1--patch-23
- steve@eicq.org--2004/xetla--main--0.1--patch-24
-
-
+++ /dev/null
-# do not edit -- automatically generated by arch changelog
-# non-id: automatic-ChangeLog--steve@eicq.org--2005/xetla--main--1.0
-#
-
-2005-03-30 22:03:25 GMT Steve Youngs <steve@eicq.org> version-0
-
- Summary:
- XEtla 1.0 is released
- Revision:
- xetla--main--1.0--version-0
-
-
-
-2005-03-30 01:13:07 GMT Steve Youngs <steve@eicq.org> patch-7
-
- Summary:
- Fix tips buffer display
- Revision:
- xetla--main--1.0--patch-7
-
- Under certain circumstances the tips buffer was being split into two
- windows and displayed twice. This fixes that by not trying to split the
- tips buffer, just display it in the current window.
-
- * xetla-tips.el (xetla-tips-popup-number): Remove NOSWITCH arg and don't
- split any windows when displaying the tips.
- (xetla-tips-popup): Remove NOSWITCH arg.
- (xetla-tips-next-tip): Call `xetla-tips-popup' with one arg not two.
- (xetla-tips-previous-tip): Ditto.
-
-
- modified files:
- xetla-tips.el
-
-
-2005-03-28 04:51:49 GMT Steve Youngs <steve@eicq.org> patch-6
-
- Summary:
- Clean up the build in readiness for XE package inclusion
- Revision:
- xetla--main--1.0--patch-6
-
- * xetla-core.el: Autoload `xetla-tree-root' and `xetla-flash-line' at
- compile time. This ensures a clean build in XE packages hierarchy.
-
- * xetla-defs.el (xetla-clone-process): Renamed from `clone-process'. For
- avoiding a compiler warning in XE packages hierarchy.
-
- * xetla-defs.el (clone-buffer): Use it.
-
- * xetla.el (xetla-insinuate-gnus): Don't require any Gnus libs directly
- in this function. Autoload what is required at compile time instead.
-
-
- modified files:
- xetla-core.el xetla-defs.el xetla.el
-
-
-2005-03-20 13:22:14 GMT Steve Youngs <steve@eicq.org> patch-5
-
- Summary:
- fix my stupidity
- Revision:
- xetla--main--1.0--patch-5
-
-
- modified files:
- xetla.el
-
-
-2005-03-20 09:50:41 GMT Steve Youngs <steve@eicq.org> patch-4
-
- Summary:
- Add missing face for bookmark names
- Revision:
- xetla--main--1.0--patch-4
-
- * xetla.el (xetla-bookmark-face): Add definition of missing face.
-
-
- modified files:
- xetla.el
-
-
-2005-03-18 09:19:09 GMT Steve Youngs <steve@eicq.org> patch-3
-
- Summary:
- General code clean up.
- Revision:
- xetla--main--1.0--patch-3
-
- * Makefile (VER): Bump to 1.0
- (INSTALL): Don't set any args to install so mere mortal users can install
- too.
- (PRELOADS): Don't load xetla-build... it doesn't exist anymore.
-
- * xetla-browse.el: Autoload `easy-mmode-define-keymap' at compile time.
- (xetla-widget-branch-node-get-branch): Use `read-directory-name'
- instead of `xetla-read-directory-name'.
- (xetla-widget-version-node-get-version): Ditto.
-
- * xetla-core.el: Autoload `read-passwd' at compile time.
- (xetla-temp-directory): Set default with `temp-directory'.
- (xetla-read-directory-name): Removed. It didn't give anything that
- `read-directory-name' didn't already give.
- (xetla-add-to-list): Removed. It didn't give anything that
- `add-to-list' didn't already give.
- (xetla-show-internal-buffers-on-menu): Default to nil.
-
- * xetla-defs.el: Remove a gazillion useless autoload cookies.
- Lots of typo updates:
- Xetla -> XEtla
- xetla -> tla
- - -> --
- Set all the hook variable defcustoms to nil instead of `()
- Put the call to `auto-mode-alist' inline with the autoload cookie
- comment. This avoids it getting loaded twice.
-
- * xetla-tips.el: Typo fixes.
-
- * xetla.el: Fix a condition-case form designed to skip an error.
- Move the guts of xetla-build.el here. Some went to other files, the
- but majority is here.
- (xetla-tree-version-list-xetla): Renambed to
- `xetla-tree-version-list-tla'.
- (xetla-tree-version-list-tla): New. from
- `xetla-tree-version-list-xetla' .
- (xetla-delete-file): New. Replaces hack to maybe define
- `dired-delete-file'.
- Also lots of typo fixes.
- Use `read-directory-name' instead of `xetla-read-directory-name'
- throughout.
- Use `add-to-list' instead of `xetla-add-to-list' throughout.
-
- removed files:
- .arch-ids/xetla-build.el.id xetla-build.el
-
- modified files:
- Makefile xetla-browse.el xetla-core.el xetla-defs.el
- xetla-tips.el xetla.el
-
-
-2005-03-11 14:44:57 GMT Steve Youngs <steve@eicq.org> patch-2
-
- Summary:
- Typo fixes -- xetla -> tla
- Revision:
- xetla--main--1.0--patch-2
-
- * xetla.el (xetla-changes-internal): xetla -> tla typo fixes.
- (xetla-changes): Ditto.
- (xetla-changes-save): Ditto.
- (xetla-changes-save-as-tgz): Ditto.
- (xetla-delta-show-diff-on-buffer): Ditto.
- (xetla-prepare-changes-buffer): Ditto.
- (xetla-file-diff): Ditto.
- (xetla-pristines): Ditto.
- (xetla-changelog): Ditto.
- (xetla-bookmarks-tag): Ditto.
- (xetla-bookmarks-inventory): Ditto.
- (xetla-bookmarks-get): Ditto.
- (xetla-start-project): Ditto.
- (xetla-cat-log-any): Ditto.
-
- * xetla-defs.el: Ditto.
- (xetla-read-project-tree-mode): Ditto.
-
- * xetla-core.el (xetla-build-xetla-command): Ditto.
- (minor-mode-alist): Ditto.
- (xetla-unescape): Ditto.
-
- * xetla-browse.el (xetla-widget-branch-node-get-branch): Ditto.
- (xetla-widget-version-node-get-version): Ditto.
-
-
-
-
- modified files:
- xetla-browse.el xetla-core.el xetla-defs.el xetla.el
-
-
-2005-03-11 13:52:10 GMT Steve Youngs <steve@eicq.org> patch-1
-
- Summary:
- Add the 0.2 ChangeLog file
- Revision:
- xetla--main--1.0--patch-1
-
-
- new files:
- ChangeLog.d/.arch-ids/ChangeLog-0.2.id
- ChangeLog.d/ChangeLog-0.2
-
-
-2005-03-11 13:43:46 GMT Steve Youngs <steve@eicq.org> base-0
-
- Summary:
- tag of steve@eicq.org--2005/xetla--main--0.2--version-0
- Revision:
- xetla--main--1.0--base-0
-
- (automatically generated log message)
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--base-0
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-1
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-2
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-3
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-4
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-5
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-6
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-7
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-8
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-9
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-10
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-11
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-12
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-13
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--base-0
- steve@eicq.org--2004/xetla--main--0.1--patch-1
- steve@eicq.org--2004/xetla--main--0.1--patch-2
- steve@eicq.org--2004/xetla--main--0.1--patch-3
- steve@eicq.org--2004/xetla--main--0.1--patch-4
- steve@eicq.org--2004/xetla--main--0.1--patch-5
- steve@eicq.org--2004/xetla--main--0.1--patch-6
- steve@eicq.org--2004/xetla--main--0.1--patch-7
- steve@eicq.org--2004/xetla--main--0.1--patch-8
- steve@eicq.org--2004/xetla--main--0.1--patch-9
- steve@eicq.org--2004/xetla--main--0.1--patch-10
- steve@eicq.org--2004/xetla--main--0.1--patch-11
- steve@eicq.org--2004/xetla--main--0.1--patch-12
- steve@eicq.org--2004/xetla--main--0.1--patch-13
- steve@eicq.org--2004/xetla--main--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--patch-15
- steve@eicq.org--2004/xetla--main--0.1--patch-16
- steve@eicq.org--2004/xetla--main--0.1--patch-17
- steve@eicq.org--2004/xetla--main--0.1--patch-18
- steve@eicq.org--2004/xetla--main--0.1--patch-19
- steve@eicq.org--2004/xetla--main--0.1--patch-20
- steve@eicq.org--2004/xetla--main--0.1--patch-21
- steve@eicq.org--2004/xetla--main--0.1--patch-22
- steve@eicq.org--2004/xetla--main--0.1--patch-23
- steve@eicq.org--2004/xetla--main--0.1--patch-24
- steve@eicq.org--2005/xetla--main--0.2--base-0
- steve@eicq.org--2005/xetla--main--0.2--patch-1
- steve@eicq.org--2005/xetla--main--0.2--patch-2
- steve@eicq.org--2005/xetla--main--0.2--patch-3
- steve@eicq.org--2005/xetla--main--0.2--patch-4
- steve@eicq.org--2005/xetla--main--0.2--patch-5
- steve@eicq.org--2005/xetla--main--0.2--patch-6
- steve@eicq.org--2005/xetla--main--0.2--patch-7
- steve@eicq.org--2005/xetla--main--0.2--version-0
-
-
+++ /dev/null
-# do not edit -- automatically generated by arch changelog
-# non-id: automatic-ChangeLog--steve@eicq.org--2005/xetla--main--1.1
-#
-
-2005-12-24 03:53:37 GMT Steve Youngs <steve@eicq.org> version-0
-
- Summary:
- xetla--main--1.1--version-0 is released!
- Revision:
- xetla--main--1.1--version-0
-
-
-
-2005-12-24 02:45:19 GMT Steve Youngs <steve@eicq.org> patch-26
-
- Summary:
- Tiny cleanup before release.
- Revision:
- xetla--main--1.1--patch-26
-
- * TODO: Re-write. I've missed a lot of stuff that should be in this
- file, so ADD TO IT!!
-
-
- removed files:
- .arch-ids/BINDINGS.id .arch-ids/FEATURES.id BINDINGS FEATURES
-
- modified files:
- TODO
-
-
-2005-12-18 23:30:21 GMT Steve Youngs <steve@eicq.org> patch-25
-
- Summary:
- Merged from hrop (patch 10) -- fix buffer-live-p errors
- Revision:
- xetla--main--1.1--patch-25
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-10
- minor fix, improve handling of killed buffers
-
- modified files:
- xetla-core.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-10
-
-
-2005-11-27 03:27:38 GMT Steve Youngs <steve@eicq.org> patch-24
-
- Summary:
- Enhance the tips buffer with `substitute-command-keys'.
- Revision:
- xetla--main--1.1--patch-24
-
- * xetla-tips.el (xetla-tips-array): Add more tips and use a syntax
- compatible with `substitute-command-keys'.
- (xetla-tips-popup-number): Pass the tip through
- `substitute-command-keys'.
-
-
- modified files:
- xetla-tips.el
-
-
-2005-11-26 22:53:44 GMT Steve Youngs <steve@eicq.org> patch-23
-
- Summary:
- Support `tla changelog ARCHIVE/VERSION' in `xetla-changelog'
- Revision:
- xetla--main--1.1--patch-23
-
- This changeset improves `xetla-changelog'. With a prefix arg you can now
- specify a archive/version to show a ChangeLog for.
-
- It also puts the changelog buffer in `view-mode' to make it easier to
- scroll around the buffer.
-
- * xetla.el (xetla-changelog): Support the VERSION arg to `tla
- changelog'. And put the changelog buffer into `view-mode' for easier
- scrolling.
-
-
- modified files:
- xetla.el
-
-
-2005-11-13 09:15:07 GMT Steve Youngs <steve@sxemacs.org> patch-22
-
- Summary:
- Tidy up bookmark code
- Revision:
- xetla--main--1.1--patch-22
-
- This changeset tidies up the bookmark code. It ensures that anything
- that can operate on a local tree takes the situation of multiple local
- trees into account.
-
- It also makes sure that all bookmark operations that switch buffers
- honour `xetla-switch-to-buffer-mode'.
-
- * xetla.el (xetla-bookmarks-inventory): Support
- `xetla-switch-to-buffer-mode'.
- (xetla-bookmarks-inventory): Support the possibility of having mulitple
- local trees.
- (xetla-bookmarks-load-from-file-OBSOLETE): Removed.
- (xetla-bookmarks-load-from-file): Remove condition-case.
- (xetla-bookmarks-missing): Use `substitute-command-keys' to show how to
- get to the bookmarks buffer.
- (xetla-bookmarks-open-tree): Update doc string, mention prefix arg usage.
- (xetla-bookmarks-find-file): Support multiple local trees via a prefix
- arg.
- (xetla-bookmarks-tag): Use `substitute-command-keys' to show how to get
- to the bookmarks buffer.
- (xetla-bookmarks-changes): Support both "full" and "summary" format
- changes as well as mulitple local trees. All done through prefix
- args...
- No prefix arg -- full format, default tree.
- One prefix arg -- summary format, default tree.
- Two prefix args -- full format, prompt for tree.
- Three prefix args -- summary format, prompt for tree.
- (xetla-bookmarks): xetla -> XEtla in doc string.
- (xetla-bookmarks-mode): Ditto.
-
-
-
- modified files:
- xetla.el
-
-
-2005-11-10 04:08:35 GMT Steve Youngs <steve@eicq.org> patch-21
-
- Summary:
- Make xetla-star-merge interactive
- Revision:
- xetla--main--1.1--patch-21
-
- * xetla.el (xetla-star-merge): Make it interactive so it can be called
- directly instead of just from bookmarks or inventory buffers.
-
-
- modified files:
- xetla.el
-
-
-2005-11-09 00:28:43 GMT Steve Youngs <steve@eicq.org> patch-20
-
- Summary:
- Open non-default local tree of a bookmark
- Revision:
- xetla--main--1.1--patch-20
-
- I discovered the other day that if a bookmark had more than one local
- tree associated with it there was no way to open any tree apart from the
- "default" tree. This fixes that.
-
- In the bookmarks buffer:
-
- `o' -- open "default tree"
- `C-u o' -- ask user which tree to open, completing on the trees
- associated with that particular bookmark. User is
- then asked if they want to make their choice the
- default.
-
- * xetla.el (xetla-bookmarks-open-tree): Use a prefix arg to handle a
- bookmark having multiple local trees.
-
-
- modified files:
- xetla.el
-
-
-2005-10-30 15:14:36 GMT Steve Youngs <steve@sxemacs.org> patch-19
-
- Summary:
- Make bookmarks honour `xetla-switch-to-buffer-mode'
- Revision:
- xetla--main--1.1--patch-19
-
- * xetla.el (xetla-bookmarks-open-tree): Only run dired in another window
- if `xetla-switch-to-buffer-mode' is something other than
- `single-window'.
- (xetla-bookmarks): Put the bookmarks buffer in the same window if
- `xetla-switch-to-buffer-mode' is `single-window'.
-
-
- modified files:
- xetla.el
-
-
-2005-07-28 10:21:43 GMT Steve Youngs <steve@sxemacs.org> patch-18
-
- Summary:
- Fix `xetla-arch-version-number'
- Revision:
- xetla--main--1.1--patch-18
-
- * xetla.el (xetla-arch-version-number): Fix regexp.
-
-
- modified files:
- xetla.el
-
-
-2005-07-01 12:20:53 GMT Steve Youngs <steve@eicq.org> patch-17
-
- Summary:
- Update tips
- Revision:
- xetla--main--1.1--patch-17
-
- * xetla-tips.el (xetla-tips-array): Remove tip about smerge.
-
-
- modified files:
- xetla-tips.el
-
-
-2005-07-01 12:10:26 GMT Steve Youngs <steve@eicq.org> patch-16
-
- Summary:
- Fix committing from the log buffer.
- Revision:
- xetla--main--1.1--patch-16
-
- * xetla.el (xetla-commit-fix): Fix regex.
- (xetla-log-edit-done): When current-prefix-arg is numeric, it's
- actually a list, so use its `car'. Also, kill the log buffer _before_
- running `tla commit', otherwise the user gets asked a cryptic question
- about killing a process.
-
-
- modified files:
- xetla.el
-
-
-2005-07-01 09:58:58 GMT Steve Youngs <steve@eicq.org> patch-15
-
- Summary:
- Ignore the duplicate logs for patch-12 to patch-14 (whee hiccup with XEtla)
- Revision:
- xetla--main--1.1--patch-15
-
-
-
-2005-07-01 09:37:07 GMT Steve Youngs <steve@eicq.org> patch-14
-
- Summary:
- Improve handling of seal/fix commits
- Revision:
- xetla--main--1.1--patch-14
-
- This improves the implementation of seal/fix commits. It makes it
- possible to seal/fix from the log edit buffer by using the normal
- existing C-c C-c keybinding...
-
- C-c C-c -- Save and bury the log buffer
- C-u C-c C-c -- Save and kill the log + commit
- C-u C-u C-c C-c -- Save and kill the log + commit with seal
- C-u C-u C-u C-c C-c -- Save and kill the log + commit with fix
-
- It also guards against trying to seal or fix when that isn't
- appropriate. For example, it won't let you "fix" an archive that isn't
- sealed. Neither will it let you "seal" an archive that is already sealed
- or fixed.
-
- * xetla.el (xetla-get-current-revision): New. Returns the latest fully
- qualified revision in the current directory.
- (xetla-commit-seal): Check against sealing when sealing is the wrong
- thing to do.
- (xetla-commit-fix): Ditto.
- (xetla-log-edit-done): Rewrite. Handle sealing and fixing commits.
- Make it possible to seal and fix from the existing keymap using prefix
- args. See the doc string for the details.
- (xetla-log-edit-done-with-sealing): Removed. This isn't needed
- anymore.
- (xetla-log-edit-done-with-fixing): Ditto.
-
-
-
-2005-07-01 09:32:48 GMT Steve Youngs <steve@eicq.org> patch-13
-
- Summary:
- Improve handling of seal/fix commits
- Revision:
- xetla--main--1.1--patch-13
-
- This improves the implementation of seal/fix commits. It makes it
- possible to seal/fix from the log edit buffer by using the normal
- existing C-c C-c keybinding...
-
- C-c C-c -- Save and bury the log buffer
- C-u C-c C-c -- Save and kill the log + commit
- C-u C-u C-c C-c -- Save and kill the log + commit with seal
- C-u C-u C-u C-c C-c -- Save and kill the log + commit with fix
-
- It also guards against trying to seal or fix when that isn't
- appropriate. For example, it won't let you "fix" an archive that isn't
- sealed. Neither will it let you "seal" an archive that is already sealed
- or fixed.
-
- * xetla.el (xetla-get-current-revision): New. Returns the latest fully
- qualified revision in the current directory.
- (xetla-commit-seal): Check against sealing when sealing is the wrong
- thing to do.
- (xetla-commit-fix): Ditto.
- (xetla-log-edit-done): Rewrite. Handle sealing and fixing commits.
- Make it possible to seal and fix from the existing keymap using prefix
- args. See the doc string for the details.
- (xetla-log-edit-done-with-sealing): Removed. This isn't needed
- anymore.
- (xetla-log-edit-done-with-fixing): Ditto.
-
-
-
-2005-07-01 09:32:04 GMT Steve Youngs <steve@eicq.org> patch-12
-
- Summary:
- Improve handling of seal/fix commits
- Revision:
- xetla--main--1.1--patch-12
-
- This improves the implementation of seal/fix commits. It makes it
- possible to seal/fix from the log edit buffer by using the normal
- existing C-c C-c keybinding...
-
- C-c C-c -- Save and bury the log buffer
- C-u C-c C-c -- Save and kill the log + commit
- C-u C-u C-c C-c -- Save and kill the log + commit with seal
- C-u C-u C-u C-c C-c -- Save and kill the log + commit with fix
-
- It also guards against trying to seal or fix when that isn't
- appropriate. For example, it won't let you "fix" an archive that isn't
- sealed. Neither will it let you "seal" an archive that is already sealed
- or fixed.
-
- * xetla.el (xetla-get-current-revision): New. Returns the latest fully
- qualified revision in the current directory.
- (xetla-commit-seal): Check against sealing when sealing is the wrong
- thing to do.
- (xetla-commit-fix): Ditto.
- (xetla-log-edit-done): Rewrite. Handle sealing and fixing commits.
- Make it possible to seal and fix from the existing keymap using prefix
- args. See the doc string for the details.
- (xetla-log-edit-done-with-sealing): Removed. This isn't needed
- anymore.
- (xetla-log-edit-done-with-fixing): Ditto.
-
-
-
-2005-07-01 09:31:35 GMT Steve Youngs <steve@eicq.org> patch-11
-
- Summary:
- Improve handling of seal/fix commits
- Revision:
- xetla--main--1.1--patch-11
-
- This improves the implementation of seal/fix commits. It makes it
- possible to seal/fix from the log edit buffer by using the normal
- existing C-c C-c keybinding...
-
- C-c C-c -- Save and bury the log buffer
- C-u C-c C-c -- Save and kill the log + commit
- C-u C-u C-c C-c -- Save and kill the log + commit with seal
- C-u C-u C-u C-c C-c -- Save and kill the log + commit with fix
-
- It also guards against trying to seal or fix when that isn't
- appropriate. For example, it won't let you "fix" an archive that isn't
- sealed. Neither will it let you "seal" an archive that is already sealed
- or fixed.
-
- * xetla.el (xetla-get-current-revision): New. Returns the latest fully
- qualified revision in the current directory.
- (xetla-commit-seal): Check against sealing when sealing is the wrong
- thing to do.
- (xetla-commit-fix): Ditto.
- (xetla-log-edit-done): Rewrite. Handle sealing and fixing commits.
- Make it possible to seal and fix from the existing keymap using prefix
- args. See the doc string for the details.
- (xetla-log-edit-done-with-sealing): Removed. This isn't needed
- anymore.
- (xetla-log-edit-done-with-fixing): Ditto.
-
-
- modified files:
- xetla.el
-
-
-2005-06-30 04:30:32 GMT Steve Youngs <steve@eicq.org> patch-10
-
- Summary:
- Merged from hroptatyr@sxemacs.org--sxemacs (patch 6-7) -- seal/fix
- Revision:
- xetla--main--1.1--patch-10
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-6
- new, add support for --seal and --fix commits
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-7
- fix, minor enhancement to xetla-log-edit-done
-
- modified files:
- xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-6
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-7
-
-
-2005-05-26 02:49:43 GMT Steve Youngs <steve@eicq.org> patch-9
-
- Summary:
- Try to be smart about having both XEtla and Xtla installed
- Revision:
- xetla--main--1.1--patch-9
-
- Having both XEtla and Xtla installed at the same time is _NOT_ a good
- idea. This changeset attempts to get around it. It pops up a warning
- buffer to tell the user what is going on and offers a way to disable
- either XEtla or Xtla for the current session. This isn't a "fix" as such
- and the warning advises the user that the only real solution is to
- physically remove either XEtla or Xtla.
-
- * xetla.el (xetla-dont-warn-about-xtla): New. When non-nil don't warn
- the user about having both XEtla and Xtla installed.
- (xetla-warn-about-xtla-text): Text used in warning buffer when XEtla
- and Xtla are installed.
- (xetla-warn-about-xtla): Pop up a warning if both XEtla and Xtla are
- installed.
- (xetla-attempt-xetla-removal): Attempt to disable XEtla in the current
- session.
- (xetla-attempt-xtla-removal): Same as `xetla-attempt-xetla-removal' but
- for Xtla instead of XEtla.
-
-
- modified files:
- xetla.el
-
-
-2005-05-21 01:20:18 GMT Steve Youngs <steve@eicq.org> patch-8
-
- Summary:
- Fix build (missing ad-add-advice)
- Revision:
- xetla--main--1.1--patch-8
-
- * xetla-browse.el: Autoload `ad-add-advice' at compile time
-
-
- modified files:
- xetla-browse.el
-
-
-2005-05-21 01:09:39 GMT Steve Youngs <steve@eicq.org> patch-7
-
- Summary:
- Merged from hroptatyr@sxemacs.org--sxemacs (patch 4) -- conflict handling
- Revision:
- xetla--main--1.1--patch-7
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-4
- new, warn the users in case of .rej files
-
- removed files:
- .arch-ids/smerge.el.id smerge.el
-
- modified files:
- Makefile xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-4
-
-
-2005-04-18 03:20:36 GMT Steve Youngs <steve@eicq.org> patch-6
-
- Summary:
- Fix bug of x-f-f-h trying to use a VC var when VC isn't loaded
- Revision:
- xetla--main--1.1--patch-6
-
- * xetla.el (vc-ignore-vc-files): This is not only needed at compile time
- but also at run-time. Especially for people who do _not_ have the vc
- package installed or loaded. So don't wrap in a eval-when-compile. This
- fixes a "symbol's definition as variable is void: vc-ignore-vc-files"
- error that xetla-find-file-hook was generating.
-
-
- modified files:
- xetla.el
-
-
-2005-04-09 21:31:25 GMT Steve Youngs <steve@eicq.org> patch-5
-
- Summary:
- Merged from hroptatyr@sxemacs.org--sxemacs (patch 2) -- fix tla add
- Revision:
- xetla--main--1.1--patch-5
-
- Patches applied:
-
- * hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-2
- fix, use `tla add' or `tla add-id' depending on which tla version is installed
-
- modified files:
- xetla.el
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--1.1--patch-2
-
-
-2005-04-09 02:52:17 GMT Steve Youngs <steve@eicq.org> patch-4
-
- Summary:
- Improve xetla-help -- enable displaying `tla help'
- Revision:
- xetla--main--1.1--patch-4
-
- * xetla.el (xetla-help): Handle `tla help RET'. If the user doesn't give
- a command to get help on, display the output of `tla help'.
- (xetla-display-global-help): New. Used to display a buffer containing
- the output from `tla help'. Each tla command displayed in the buffer
- is an extent which allows you to display the help for that command.
- (xetla-help-extent-map): New. Keymap used in the `xetla-display-global-help'
- buffer.
- (xetla-help-via-mouse): New. Display help for tla command via mouse.
- (xetla-help-via-keyb): New. Display help for tla command via keyboard.
-
- * xetla-core.el (xetla-process-buffer-mode): Typo Xetla -> XEtla.
-
-
- modified files:
- xetla-core.el xetla.el
-
-
-2005-04-07 23:54:09 GMT Steve Youngs <steve@eicq.org> patch-3
-
- Summary:
- Broken backward imcompatibility of tla 1.3.1 -- add -> add-id
- Revision:
- xetla--main--1.1--patch-3
-
- * xetla.el (xetla-add-id): New. Uses `tla add-id' instead of `tla add'.
- (xetla-add): An alias to `xetla-add-id'.
- (xetla-inventory-add-files): Use `xetla-add-id'.
- (xetla-regenerate-id-for-file): Ditto.
- (xetla-tree-lint-add-files): Ditto.
-
-
- modified files:
- xetla.el
-
-
-2005-04-06 14:00:48 GMT Steve Youngs <steve@eicq.org> patch-2
-
- Summary:
- Remove =partner-versions file
- Revision:
- xetla--main--1.1--patch-2
-
-
-
-2005-03-30 22:44:04 GMT Steve Youngs <steve@eicq.org> patch-1
-
- Summary:
- Start 1.1
- Revision:
- xetla--main--1.1--patch-1
-
- * Makefile (VER): Bump to 1.1
-
- Add ChangeLog file for previous release
-
-
- new files:
- ChangeLog.d/.arch-ids/ChangeLog-1.0.id
- ChangeLog.d/ChangeLog-1.0
-
- modified files:
- Makefile
-
-
-2005-03-30 22:39:14 GMT Steve Youngs <steve@eicq.org> base-0
-
- Summary:
- tag of steve@eicq.org--2005/xetla--main--1.0--version-0
- Revision:
- xetla--main--1.1--base-0
-
- (automatically generated log message)
-
- new patches:
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--base-0
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-1
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-2
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-3
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-4
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-5
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-6
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-7
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-8
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-9
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-10
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-11
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-12
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-13
- hroptatyr@sxemacs.org--sxemacs/xetla--hrop--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--base-0
- steve@eicq.org--2004/xetla--main--0.1--patch-1
- steve@eicq.org--2004/xetla--main--0.1--patch-2
- steve@eicq.org--2004/xetla--main--0.1--patch-3
- steve@eicq.org--2004/xetla--main--0.1--patch-4
- steve@eicq.org--2004/xetla--main--0.1--patch-5
- steve@eicq.org--2004/xetla--main--0.1--patch-6
- steve@eicq.org--2004/xetla--main--0.1--patch-7
- steve@eicq.org--2004/xetla--main--0.1--patch-8
- steve@eicq.org--2004/xetla--main--0.1--patch-9
- steve@eicq.org--2004/xetla--main--0.1--patch-10
- steve@eicq.org--2004/xetla--main--0.1--patch-11
- steve@eicq.org--2004/xetla--main--0.1--patch-12
- steve@eicq.org--2004/xetla--main--0.1--patch-13
- steve@eicq.org--2004/xetla--main--0.1--patch-14
- steve@eicq.org--2004/xetla--main--0.1--patch-15
- steve@eicq.org--2004/xetla--main--0.1--patch-16
- steve@eicq.org--2004/xetla--main--0.1--patch-17
- steve@eicq.org--2004/xetla--main--0.1--patch-18
- steve@eicq.org--2004/xetla--main--0.1--patch-19
- steve@eicq.org--2004/xetla--main--0.1--patch-20
- steve@eicq.org--2004/xetla--main--0.1--patch-21
- steve@eicq.org--2004/xetla--main--0.1--patch-22
- steve@eicq.org--2004/xetla--main--0.1--patch-23
- steve@eicq.org--2004/xetla--main--0.1--patch-24
- steve@eicq.org--2005/xetla--main--0.2--base-0
- steve@eicq.org--2005/xetla--main--0.2--patch-1
- steve@eicq.org--2005/xetla--main--0.2--patch-2
- steve@eicq.org--2005/xetla--main--0.2--patch-3
- steve@eicq.org--2005/xetla--main--0.2--patch-4
- steve@eicq.org--2005/xetla--main--0.2--patch-5
- steve@eicq.org--2005/xetla--main--0.2--patch-6
- steve@eicq.org--2005/xetla--main--0.2--patch-7
- steve@eicq.org--2005/xetla--main--0.2--version-0
- steve@eicq.org--2005/xetla--main--1.0--base-0
- steve@eicq.org--2005/xetla--main--1.0--patch-1
- steve@eicq.org--2005/xetla--main--1.0--patch-2
- steve@eicq.org--2005/xetla--main--1.0--patch-3
- steve@eicq.org--2005/xetla--main--1.0--patch-4
- steve@eicq.org--2005/xetla--main--1.0--patch-5
- steve@eicq.org--2005/xetla--main--1.0--patch-6
- steve@eicq.org--2005/xetla--main--1.0--patch-7
- steve@eicq.org--2005/xetla--main--1.0--version-0
-
-
+++ /dev/null
-# Makefile for XEtla
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.04
-AUTHOR_VERSION = steve@eicq.org--2005/xetla--main--1.1--version-0
-MAINTAINER = Steve Youngs <steve@youngs.au.com>
-PACKAGE = xetla
-PKG_TYPE = regular
-REQUIRES = ediff xemacs-base jde mail-lib dired prog-modes
-CATEGORY = standard
-
-ELCS = \
- ewoc.elc \
- xetla-version.elc \
- xetla-browse.elc \
- xetla-core.elc \
- xetla-defs.elc \
- xetla-tips.elc \
- xetla.elc
-
-# XEtla can use Gnus, but it is optional. So instead of making Gnus a
-# dependency of XEtla, just put the Gnus directory into the load-path
-# to avoid byte-compiler warnings. --SY.
-PRELOADS = -eval \("push \"../gnus/lisp\" load-path"\)
-
-include ../../XEmacs.rules
+++ /dev/null
-;;; ewoc.el --- utility to maintain a view of a list of objects in a buffer
-
-;; Copyright (C) 1991, 92, 93, 94, 95, 96, 97, 98, 99, 2000 Free Software Foundation
-
-;; Author: Per Cederqvist <ceder@lysator.liu.se>
-;; Inge Wallin <inge@lysator.liu.se>
-;; Maintainer: monnier@gnu.org
-;; Created: 3 Aug 1992
-;; Keywords: extensions, lisp
-
-;; 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:
-
-;; Ewoc Was Once Cookie
-;; But now it's Emacs' Widget for Object Collections
-
-;; As the name implies this derives from the `cookie' package (part
-;; of Elib). The changes are pervasive though mostly superficial:
-
-;; - uses CL (and its `defstruct')
-;; - separate from Elib.
-;; - uses its own version of a doubly-linked list which allows us
-;; to merge the elib-wrapper and the elib-node structures into ewoc-node
-;; - dropping functions not used by PCL-CVS (the only client of ewoc at the
-;; time of writing)
-;; - removing unused arguments
-;; - renaming:
-;; elib-node ==> ewoc--node
-;; collection ==> ewoc
-;; tin ==> ewoc--node
-;; cookie ==> data or element or elem
-
-;; Introduction
-;; ============
-;;
-;; Ewoc is a package that implements a connection between an
-;; dll (a doubly linked list) and the contents of a buffer.
-;; Possible uses are dired (have all files in a list, and show them),
-;; buffer-list, kom-prioritize (in the LysKOM elisp client) and
-;; others. pcl-cvs.el uses ewoc.el.
-;;
-;; Ewoc can be considered as the `view' part of a model-view-controller.
-;;
-;; A `element' can be any lisp object. When you use the ewoc
-;; package you specify a pretty-printer, a function that inserts
-;; a printable representation of the element in the buffer. (The
-;; pretty-printer should use "insert" and not
-;; "insert-before-markers").
-;;
-;; A `ewoc' consists of a doubly linked list of elements, a
-;; header, a footer and a pretty-printer. It is displayed at a
-;; certain point in a certain buffer. (The buffer and point are
-;; fixed when the ewoc is created). The header and the footer
-;; are constant strings. They appear before and after the elements.
-;;
-;; Ewoc does not affect the mode of the buffer in any way. It
-;; merely makes it easy to connect an underlying data representation
-;; to the buffer contents.
-;;
-;; A `ewoc--node' is an object that contains one element. There are
-;; functions in this package that given an ewoc--node extract the data, or
-;; give the next or previous ewoc--node. (All ewoc--nodes are linked together
-;; in a doubly linked list. The `previous' ewoc--node is the one that appears
-;; before the other in the buffer.) You should not do anything with
-;; an ewoc--node except pass it to the functions in this package.
-;;
-;; An ewoc is a very dynamic thing. You can easily add or delete elements.
-;; You can apply a function to all elements in an ewoc, etc, etc.
-;;
-;; Remember that an element can be anything. Your imagination is the
-;; limit! It is even possible to have another ewoc as an
-;; element. In that way some kind of tree hierarchy can be created.
-;;
-;; Full documentation will, God willing, soon be available in a
-;; Texinfo manual.
-
-;; In the mean time `grep '^(.*ewoc-[^-]' emacs-lisp/ewoc.el' can help
-;; you find all the exported functions:
-;;
-;; (defun ewoc-create (pretty-printer &optional header footer)
-;; (defalias 'ewoc-data 'ewoc--node-data)
-;; (defun ewoc-location (node)
-;; (defun ewoc-enter-first (ewoc data)
-;; (defun ewoc-enter-last (ewoc data)
-;; (defun ewoc-enter-after (ewoc node data)
-;; (defun ewoc-enter-before (ewoc node data)
-;; (defun ewoc-next (ewoc node)
-;; (defun ewoc-prev (ewoc node)
-;; (defun ewoc-nth (ewoc n)
-;; (defun ewoc-map (map-function ewoc &rest args)
-;; (defun ewoc-filter (ewoc predicate &rest args)
-;; (defun ewoc-locate (ewoc &optional pos guess)
-;; (defun ewoc-invalidate (ewoc &rest nodes)
-;; (defun ewoc-goto-prev (ewoc arg)
-;; (defun ewoc-goto-next (ewoc arg)
-;; (defun ewoc-goto-node (ewoc node)
-;; (defun ewoc-refresh (ewoc)
-;; (defun ewoc-collect (ewoc predicate &rest args)
-;; (defun ewoc-buffer (ewoc)
-;; (defun ewoc-get-hf (ewoc)
-;; (defun ewoc-set-hf (ewoc header footer)
-
-;; Coding conventions
-;; ==================
-;;
-;; All functions of course start with `ewoc'. Functions and macros
-;; starting with the prefix `ewoc--' are meant for internal use,
-;; while those starting with `ewoc-' are exported for public use.
-;; There are currently no global or buffer-local variables used.
-
-
-;;; Code:
-
-(eval-when-compile (require 'cl)) ;because of CL compiler macros
-
-;; The doubly linked list is implemented as a circular list
-;; with a dummy node first and last. The dummy node is used as
-;; "the dll" (or rather is the dll handle passed around).
-
-(defstruct (ewoc--node
- (:type vector) ;required for ewoc--node-branch hack
- (:constructor ewoc--node-create (start-marker data)))
- left right data start-marker)
-
-(eval-when-compile (defvar dll))
-
-(defalias 'ewoc--node-branch 'aref)
-
-(defun ewoc--dll-create ()
- "Create an empty doubly linked list."
- (let ((dummy-node (ewoc--node-create 'DL-LIST 'DL-LIST)))
- (setf (ewoc--node-right dummy-node) dummy-node)
- (setf (ewoc--node-left dummy-node) dummy-node)
- dummy-node))
-
-(defun ewoc--node-enter-before (node elemnode)
- "Insert ELEMNODE before NODE in a DLL."
- (assert (and (null (ewoc--node-left elemnode)) (null (ewoc--node-right elemnode))))
- (setf (ewoc--node-left elemnode) (ewoc--node-left node))
- (setf (ewoc--node-right elemnode) node)
- (setf (ewoc--node-right (ewoc--node-left node)) elemnode)
- (setf (ewoc--node-left node) elemnode))
-
-(defun ewoc--node-enter-first (dll node)
- "Add a free floating NODE first in DLL."
- (ewoc--node-enter-before (ewoc--node-right dll) node))
-
-(defun ewoc--node-enter-last (dll node)
- "Add a free floating NODE last in DLL."
- (ewoc--node-enter-before dll node))
-
-(defun ewoc--node-next (dll node)
- "Return the node after NODE, or nil if NODE is the last node."
- (unless (eq (ewoc--node-right node) dll) (ewoc--node-right node)))
-
-(defun ewoc--node-prev (dll node)
- "Return the node before NODE, or nil if NODE is the first node."
- (unless (eq (ewoc--node-left node) dll) (ewoc--node-left node)))
-
-(defun ewoc--node-delete (node)
- "Unbind NODE from its doubly linked list and return it."
- ;; This is a no-op when applied to the dummy node. This will return
- ;; nil if applied to the dummy node since it always contains nil.
- (setf (ewoc--node-right (ewoc--node-left node)) (ewoc--node-right node))
- (setf (ewoc--node-left (ewoc--node-right node)) (ewoc--node-left node))
- (setf (ewoc--node-left node) nil)
- (setf (ewoc--node-right node) nil)
- node)
-
-(defun ewoc--node-nth (dll n)
- "Return the Nth node from the doubly linked list DLL.
-N counts from zero. If DLL is not that long, nil is returned.
-If N is negative, return the -(N+1)th last element.
-Thus, (ewoc--node-nth dll 0) returns the first node,
-and (ewoc--node-nth dll -1) returns the last node."
- ;; Branch 0 ("follow left pointer") is used when n is negative.
- ;; Branch 1 ("follow right pointer") is used otherwise.
- (let* ((branch (if (< n 0) 0 1))
- (node (ewoc--node-branch dll branch)))
- (if (< n 0) (setq n (- -1 n)))
- (while (and (not (eq dll node)) (> n 0))
- (setq node (ewoc--node-branch node branch))
- (setq n (1- n)))
- (unless (eq dll node) node)))
-
-(defun ewoc-location (node)
- "Return the start location of NODE."
- (ewoc--node-start-marker node))
-
-\f
-;;; The ewoc data type
-
-(defstruct (ewoc
- (:constructor nil)
- (:constructor ewoc--create
- (buffer pretty-printer header footer dll))
- (:conc-name ewoc--))
- buffer pretty-printer header footer dll last-node)
-
-(defmacro ewoc--set-buffer-bind-dll-let* (ewoc varlist &rest forms)
- "Execute FORMS with ewoc--buffer selected as current buffer,
-dll bound to dll, and VARLIST bound as in a let*.
-dll will be bound when VARLIST is initialized, but the current
-buffer will *not* have been changed.
-Return value of last form in FORMS."
- (let ((old-buffer (make-symbol "old-buffer"))
- (hnd (make-symbol "ewoc")))
- (` (let* (((, old-buffer) (current-buffer))
- ((, hnd) (, ewoc))
- (dll (ewoc--dll (, hnd)))
- (,@ varlist))
- (set-buffer (ewoc--buffer (, hnd)))
- (unwind-protect
- (progn (,@ forms))
- (set-buffer (, old-buffer)))))))
-
-(defmacro ewoc--set-buffer-bind-dll (ewoc &rest forms)
- `(ewoc--set-buffer-bind-dll-let* ,ewoc nil ,@forms))
-
-(defsubst ewoc--filter-hf-nodes (ewoc node)
- "Evaluate NODE once and return it.
-BUT if it is the header or the footer in EWOC return nil instead."
- (unless (or (eq node (ewoc--header ewoc))
- (eq node (ewoc--footer ewoc)))
- node))
-
-
-(defun ewoc--create-node (data pretty-printer pos)
- "Call PRETTY-PRINTER with point set at POS in current buffer.
-Remember the start position. Create a wrapper containing that
-start position and the element DATA."
- (save-excursion
- ;; Remember the position as a number so that it doesn't move
- ;; when we insert the string.
- (when (markerp pos) (setq pos (marker-position pos)))
- (goto-char pos)
- (let ((inhibit-read-only t))
- ;; Insert the trailing newline using insert-before-markers
- ;; so that the start position for the next element is updated.
- (insert-before-markers ?\n)
- ;; Move back, and call the pretty-printer.
- (backward-char 1)
- (funcall pretty-printer data)
- (ewoc--node-create (copy-marker pos) data))))
-
-
-(defun ewoc--delete-node-internal (ewoc node)
- "Delete a data string from EWOC.
-Can not be used on the footer. Returns the wrapper that is deleted.
-The start-marker in the wrapper is set to nil, so that it doesn't
-consume any more resources."
- (let ((dll (ewoc--dll ewoc))
- (inhibit-read-only t))
- ;; If we are about to delete the node pointed at by last-node,
- ;; set last-node to nil.
- (if (eq (ewoc--last-node ewoc) node)
- (setf (ewoc--last-node ewoc) nil))
-
- (delete-region (ewoc--node-start-marker node)
- (ewoc--node-start-marker (ewoc--node-next dll node)))
- (set-marker (ewoc--node-start-marker node) nil)
- ;; Delete the node, and return the wrapper.
- (ewoc--node-delete node)))
-
-
-(defun ewoc--refresh-node (pp node)
- "Redisplay the element represented by NODE using the pretty-printer PP."
- (let ((inhibit-read-only t))
- (save-excursion
- ;; First, remove the string from the buffer:
- (delete-region (ewoc--node-start-marker node)
- (1- (marker-position
- (ewoc--node-start-marker (ewoc--node-right node)))))
- ;; Calculate and insert the string.
- (goto-char (ewoc--node-start-marker node))
- (funcall pp (ewoc--node-data node)))))
-\f
-;;; ===========================================================================
-;;; Public members of the Ewoc package
-
-
-(defun ewoc-create (pretty-printer &optional header footer)
- "Create an empty ewoc.
-
-The ewoc will be inserted in the current buffer at the current position.
-
-PRETTY-PRINTER should be a function that takes one argument, an
-element, and inserts a string representing it in the buffer (at
-point). The string PRETTY-PRINTER inserts may be empty or span
-several linse. A trailing newline will always be inserted
-automatically. The PRETTY-PRINTER should use insert, and not
-insert-before-markers.
-
-Optional third argument HEADER is a string that will always be
-present at the top of the ewoc. HEADER should end with a
-newline. Optionaly fourth argument FOOTER is similar, and will
-be inserted at the bottom of the ewoc."
- (let ((new-ewoc
- (ewoc--create (current-buffer)
- pretty-printer nil nil (ewoc--dll-create)))
- (pos (point)))
- (ewoc--set-buffer-bind-dll new-ewoc
- ;; Set default values
- (unless header (setq header ""))
- (unless footer (setq footer ""))
- (setf (ewoc--node-start-marker dll) (copy-marker pos))
- (let ((foot (ewoc--create-node footer (lambda (x) (insert footer)) pos))
- (head (ewoc--create-node header (lambda (x) (insert header)) pos)))
- (ewoc--node-enter-first dll head)
- (ewoc--node-enter-last dll foot)
- (setf (ewoc--header new-ewoc) head)
- (setf (ewoc--footer new-ewoc) foot)))
- ;; Return the ewoc
- new-ewoc))
-
-(defalias 'ewoc-data 'ewoc--node-data)
-
-(defun ewoc-enter-first (ewoc data)
- "Enter DATA first in EWOC."
- (ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-after ewoc (ewoc--node-nth dll 0) data)))
-
-(defun ewoc-enter-last (ewoc data)
- "Enter DATA last in EWOC."
- (ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-before ewoc (ewoc--node-nth dll -1) data)))
-
-
-(defun ewoc-enter-after (ewoc node data)
- "Enter a new element DATA after NODE in EWOC.
-Returns the new NODE."
- (ewoc--set-buffer-bind-dll ewoc
- (ewoc-enter-before ewoc (ewoc--node-next dll node) data)))
-
-(defun ewoc-enter-before (ewoc node data)
- "Enter a new element DATA before NODE in EWOC.
-Returns the new NODE."
- (ewoc--set-buffer-bind-dll ewoc
- (ewoc--node-enter-before
- node
- (ewoc--create-node
- data
- (ewoc--pretty-printer ewoc)
- (ewoc--node-start-marker node)))))
-
-(defun ewoc-next (ewoc node)
- "Get the next node.
-Returns nil if NODE is nil or the last element."
- (when node
- (ewoc--filter-hf-nodes
- ewoc (ewoc--node-next (ewoc--dll ewoc) node))))
-
-(defun ewoc-prev (ewoc node)
- "Get the previous node.
-Returns nil if NODE is nil or the first element."
- (when node
- (ewoc--filter-hf-nodes
- ewoc
- (ewoc--node-prev (ewoc--dll ewoc) node))))
-
-
-(defun ewoc-nth (ewoc n)
- "Return the Nth node.
-N counts from zero. Nil is returned if there is less than N elements.
-If N is negative, return the -(N+1)th last element.
-Thus, (ewoc-nth dll 0) returns the first node,
-and (ewoc-nth dll -1) returns the last node.
-Use `ewoc--node-data' to extract the data from the node."
- ;; Skip the header (or footer, if n is negative).
- (setq n (if (< n 0) (1- n) (1+ n)))
- (ewoc--filter-hf-nodes ewoc
- (ewoc--node-nth (ewoc--dll ewoc) n)))
-
-(defun ewoc-map (map-function ewoc &rest args)
- "Apply MAP-FUNCTION to all elements in EWOC.
-MAP-FUNCTION is applied to the first element first.
-If MAP-FUNCTION returns non-nil the element will be refreshed (its
-pretty-printer will be called once again).
-
-Note that the buffer for EWOC will be current buffer when MAP-FUNCTION
-is called. MAP-FUNCTION must restore the current buffer to BUFFER before
-it returns, if it changes it.
-
-If more than two arguments are given, the remaining
-arguments will be passed to MAP-FUNCTION."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((footer (ewoc--footer ewoc))
- (node (ewoc--node-nth dll 1)))
- (while (not (eq node footer))
- (if (apply map-function (ewoc--node-data node) args)
- (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))
- (setq node (ewoc--node-next dll node)))))
-
-(defun ewoc-filter (ewoc predicate &rest args)
- "Remove all elements in EWOC for which PREDICATE returns nil.
-Note that the buffer for EWOC will be current-buffer when PREDICATE
-is called. PREDICATE must restore the current buffer before it returns
-if it changes it.
-The PREDICATE is called with the element as its first argument. If any
-ARGS are given they will be passed to the PREDICATE."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((node (ewoc--node-nth dll 1))
- (footer (ewoc--footer ewoc))
- (next nil))
- (while (not (eq node footer))
- (setq next (ewoc--node-next dll node))
- (unless (apply predicate (ewoc--node-data node) args)
- (ewoc--delete-node-internal ewoc node))
- (setq node next))))
-
-(defun ewoc-locate (ewoc &optional pos guess)
- "Return the node that POS (a buffer position) is within.
-POS may be a marker or an integer. It defaults to point.
-GUESS should be a node that it is likely that POS is near.
-
-If POS points before the first element, the first node is returned.
-If POS points after the last element, the last node is returned.
-If the EWOC is empty, nil is returned."
- (unless pos (setq pos (point)))
- (ewoc--set-buffer-bind-dll-let* ewoc
- () ;; ((footer (ewoc--footer ewoc)))
-
- (cond
- ;; Nothing present?
- ((eq (ewoc--node-nth dll 1) (ewoc--node-nth dll -1))
- nil)
-
- ;; Before second elem?
- ((< pos (ewoc--node-start-marker (ewoc--node-nth dll 2)))
- (ewoc--node-nth dll 1))
-
- ;; After one-before-last elem?
- ((>= pos (ewoc--node-start-marker (ewoc--node-nth dll -2)))
- (ewoc--node-nth dll -2))
-
- ;; We now know that pos is within a elem.
- (t
- ;; Make an educated guess about which of the three known
- ;; node'es (the first, the last, or GUESS) is nearest.
- (let* ((best-guess (ewoc--node-nth dll 1))
- (distance (abs (- pos (ewoc--node-start-marker best-guess)))))
- (when guess
- (let ((d (abs (- pos (ewoc--node-start-marker guess)))))
- (when (< d distance)
- (setq distance d)
- (setq best-guess guess))))
-
- (let* ((g (ewoc--node-nth dll -1)) ;Check the last elem
- (d (abs (- pos (ewoc--node-start-marker g)))))
- (when (< d distance)
- (setq distance d)
- (setq best-guess g)))
-
- (when (ewoc--last-node ewoc) ;Check "previous".
- (let* ((g (ewoc--last-node ewoc))
- (d (abs (- pos (ewoc--node-start-marker g)))))
- (when (< d distance)
- (setq distance d)
- (setq best-guess g))))
-
- ;; best-guess is now a "best guess".
- ;; Find the correct node. First determine in which direction
- ;; it lies, and then move in that direction until it is found.
-
- (cond
- ;; Is pos after the guess?
- ((>= pos
- (ewoc--node-start-marker best-guess))
- ;; Loop until we are exactly one node too far down...
- (while (>= pos (ewoc--node-start-marker best-guess))
- (setq best-guess (ewoc--node-next dll best-guess)))
- ;; ...and return the previous node.
- (ewoc--node-prev dll best-guess))
-
- ;; Pos is before best-guess
- (t
- (while (< pos (ewoc--node-start-marker best-guess))
- (setq best-guess (ewoc--node-prev dll best-guess)))
- best-guess)))))))
-
-(defun ewoc-invalidate (ewoc &rest nodes)
- "Refresh some elements.
-The pretty-printer that for EWOC will be called for all NODES."
- (ewoc--set-buffer-bind-dll ewoc
- (dolist (node nodes)
- (ewoc--refresh-node (ewoc--pretty-printer ewoc) node))))
-
-(defun ewoc-goto-prev (ewoc arg)
- "Move point to the ARGth previous element.
-Don't move if we are at the first element, or if EWOC is empty.
-Returns the node we moved to."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((node (ewoc-locate ewoc (point))))
- (when node
- ;; If we were past the last element, first jump to it.
- (when (>= (point) (ewoc--node-start-marker (ewoc--node-right node)))
- (setq arg (1- arg)))
- (while (and node (> arg 0))
- (setq arg (1- arg))
- (setq node (ewoc--node-prev dll node)))
- ;; Never step above the first element.
- (unless (ewoc--filter-hf-nodes ewoc node)
- (setq node (ewoc--node-nth dll 1)))
- (ewoc-goto-node ewoc node))))
-
-(defun ewoc-goto-next (ewoc arg)
- "Move point to the ARGth next element.
-Returns the node (or nil if we just passed the last node)."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((node (ewoc-locate ewoc (point))))
- (while (and node (> arg 0))
- (setq arg (1- arg))
- (setq node (ewoc--node-next dll node)))
- ;; Never step below the first element.
- ;; (unless (ewoc--filter-hf-nodes ewoc node)
- ;; (setq node (ewoc--node-nth dll -2)))
- (ewoc-goto-node ewoc node)))
-
-(defun ewoc-goto-node (ewoc node)
- "Move point to NODE."
- (ewoc--set-buffer-bind-dll ewoc
- (goto-char (ewoc--node-start-marker node))
- (if goal-column (move-to-column goal-column))
- (setf (ewoc--last-node ewoc) node)))
-
-(defun ewoc-refresh (ewoc)
- "Refresh all data in EWOC.
-The pretty-printer that was specified when the EWOC was created
-will be called for all elements in EWOC.
-Note that `ewoc-invalidate' is more efficient if only a small
-number of elements needs to be refreshed."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((footer (ewoc--footer ewoc)))
- (let ((inhibit-read-only t))
- (delete-region (ewoc--node-start-marker (ewoc--node-nth dll 1))
- (ewoc--node-start-marker footer))
- (goto-char (ewoc--node-start-marker footer))
- (let ((node (ewoc--node-nth dll 1)))
- (while (not (eq node footer))
- (set-marker (ewoc--node-start-marker node) (point))
- (funcall (ewoc--pretty-printer ewoc)
- (ewoc--node-data node))
- (insert "\n")
- (setq node (ewoc--node-next dll node)))))
- (set-marker (ewoc--node-start-marker footer) (point))))
-
-(defun ewoc-collect (ewoc predicate &rest args)
- "Select elements from EWOC using PREDICATE.
-Return a list of all selected data elements.
-PREDICATE is a function that takes a data element as its first argument.
-The elements on the returned list will appear in the same order as in
-the buffer. You should not rely on in which order PREDICATE is
-called.
-Note that the buffer the EWOC is displayed in is current-buffer
-when PREDICATE is called. If PREDICATE must restore current-buffer if
-it changes it.
-If more than two arguments are given the
-remaining arguments will be passed to PREDICATE."
- (ewoc--set-buffer-bind-dll-let* ewoc
- ((header (ewoc--header ewoc))
- (node (ewoc--node-nth dll -2))
- result)
- (while (not (eq node header))
- (if (apply predicate (ewoc--node-data node) args)
- (push (ewoc--node-data node) result))
- (setq node (ewoc--node-prev dll node)))
- (nreverse result)))
-
-(defun ewoc-buffer (ewoc)
- "Return the buffer that is associated with EWOC.
-Returns nil if the buffer has been deleted."
- (let ((buf (ewoc--buffer ewoc)))
- (when (buffer-name buf) buf)))
-
-(defun ewoc-get-hf (ewoc)
- "Return a cons cell containing the (HEADER . FOOTER) of EWOC."
- (cons (ewoc--node-data (ewoc--header ewoc))
- (ewoc--node-data (ewoc--footer ewoc))))
-
-(defun ewoc-set-hf (ewoc header footer)
- "Set the HEADER and FOOTER of EWOC."
- (setf (ewoc--node-data (ewoc--header ewoc)) header)
- (setf (ewoc--node-data (ewoc--footer ewoc)) footer)
- (ewoc--refresh-node (lambda (x) (insert header)) (ewoc--header ewoc))
- (ewoc--refresh-node (lambda (x) (insert footer)) (ewoc--footer ewoc)))
-
-\f
-(provide 'ewoc)
-
-;;; Local Variables:
-;;; eval: (put 'ewoc--set-buffer-bind-dll 'lisp-indent-hook 1)
-;;; eval: (put 'ewoc--set-buffer-bind-dll-let* 'lisp-indent-hook 2)
-;;; End:
-
-;;; ewoc.el ends here
+++ /dev/null
-(xetla
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority low
- category CATEGORY
- dump nil
- description "(S)XEmacs Frontend to GNU/arch (tla)."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (ewoc xetla-browse xetla-core
- xetla-defs xetla-tips xetla-version xetla)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-;;; xetla-browse.el --- Arch archives/library browser
-
-;; Copyright (C) 2004 by Stefan Reichoer (GPL)
-;; Copyright (C) 2004 Steve Youngs (BSD)
-
-;; Author: Steve Youngs <steve@eicq.org>
-;; Maintainer: Steve Youngs <steve@eicq.org>
-;; Created: 2004-11-25
-;; Keywords: archive arch tla
-
-;; Based on xtla-browse.el by: Masatake YAMATO <jet@gyve.org>
-
-;; This file is part of XEtla.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;; may be used to endorse or promote products derived from this
-;; software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
-;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; Commentary:
-;;
-;; Contributions from:
-;; Stefan Reichoer, <stefan@xsteve.at>
-;; Matthieu Moy <Matthieu.Moy@imag.fr>
-;; Masatake YAMATO <jet@gyve.org>
-;; Milan Zamazal <pdm@zamazal.org>
-;; Martin Pool <mbp@sourcefrog.net>
-;; Robert Widhopf-Fenk <hack@robf.de>
-;; Mark Triggs <mst@dishevelled.net>
-
-;; 1. Load xetla-browse.el
-;; 2. M-x xetla-browse RET
-
-;;; TODO:
-;; - Generic refresh
-;;
-
-;;; History:
-;;
-
-;;; Code:
-(eval-when-compile
- (require 'cl)
- (autoload 'easy-mmode-define-keymap "easy-mmode")
- (autoload 'ad-add-advice "advice"))
-
-(require 'jde-tree-widget)
-(require 'xetla)
-
-(defvar xetla-browse-buffer-name "*xetla-browse*")
-(defvar xetla-browse-buffer-type 'browse)
-(xetla-add-buffer-type xetla-browse-buffer-type
- xetla-browse-buffer-name)
-
-;; --------------------------------------
-;; Open node tracking
-;; --------------------------------------
-(defvar xetla-browse-open-list '()
- "List holding the name of open nodes.")
-
-(defun xetla-browse-open-list-member (archive
- &optional category branch version)
- "Return a node, ARCHIVE/CATEGORY-BRANCH-VERSION is opend or not.
-CATEGORY, BRANCH, VERSION are optional."
- (let ((name (list archive category branch version nil)))
- (member name xetla-browse-open-list)))
-
-(defun xetla-browse-open-list-add (archive
- &optional category branch version)
- "Add a node specified by the arguments to 'xetla-browse-open-list'.
-ARCHIVE/CATEGORY-BRANCH-VERSION, ARCHIVE/CATEGORY-BRANCH,
-ARCHIVE/CATEGORY, ARCHIVE are added. CATEGORY, BRANCH, VERSION
-are optional."
- (xetla-browse-open-list-add-internal (list archive category branch version nil))
- (xetla-browse-open-list-add-internal (list archive category branch nil nil))
- (xetla-browse-open-list-add-internal (list archive category nil nil nil))
- (xetla-browse-open-list-add-internal (list archive nil nil nil nil))
- (xetla-browse-open-list-add-internal (list nil nil nil nil nil)))
-
-(defun xetla-browse-open-list-add-internal (name)
- "Add NAME to `xetla-browse-open-list'."
- (unless (xetla-browse-open-list-member (xetla-name-archive name)
- (xetla-name-category name)
- (xetla-name-branch name)
- (xetla-name-version name))
- (push name xetla-browse-open-list)))
-
-(defun xetla-browse-open-list-remove (archive
- &optional category branch version)
- "Remove ARCHIVE/CATEGORY-BRANCH-VERSION from `xetla-browse-open-list'.
-CATEGORY, BRANCH and VERSION are optional."
- (let ((name (list archive category branch version nil)))
- (setq xetla-browse-open-list (delete name xetla-browse-open-list))))
-
-(defun xetla-browse-open-tracker (tree)
- "Add or remove a node represented by TREE to/from `xetla-browse-open-list'.
-If TREE is opened, it is added. Else it is removed."
- (let* ((node (widget-get tree :node))
- (a (widget-get node :archive))
- (c (widget-get node :category))
- (b (widget-get node :branch))
- (v (widget-get node :version)))
- (if (widget-get tree :open)
- (xetla-browse-open-list-add a c b v)
- (xetla-browse-open-list-remove a c b v))))
-
-(defun xetla-browse-find-archives-root-widget ()
- "Return the root widget of archives tree."
- (save-excursion
- (goto-char (point-min))
- (re-search-forward " Archives$")
- (backward-char 1)
- (xetla-widget-node-get-at)))
-
-(defun xetla-browse-find-named-widget (parent name type)
- "Find a widget specified with arguments.
-PARENT specifies the parent widget.
-NAME is the name of the widget.
-TYPE is the type of widget. You can specify :archive, :category,
-:branch, or :version."
- (let* ((args (widget-get parent :args))
- (index (position name args :test (lambda (e w)
- (let ((node (widget-get w :node)))
- ;; Next line is hack for version node.
- (unless node (setq node w))
- (string= e (widget-get node type))))))
- (tree (when index (nth index (widget-get parent :children))))
- (node (when tree (save-excursion (goto-char (widget-get tree :from))
- (goto-char (next-single-property-change (point) 'widget))
- (xetla-widget-node-get-at)))))
- node))
-
-
-(defun xetla-browse-find-widget (archive
- &optional category branch version)
- "Return a list of widgets: (root archive category branch version)
-root is always the root of the tree, of type `xetla-widget-root-node'.
-archive is the widget representing ARCHIVE, of type
-`xetla-widget-archive-node'. The last items are potentially nil if
-CATEGORY, BRANCH or VERSION is nil. Otherwise, they are respectively
-of type `xetla-widget-category-node', `xetla-widget-revision-node' and
-`xetla-widget-version-node'."
- (let* ((root (xetla-browse-find-archives-root-widget))
- (a (xetla-browse-find-named-widget
- (widget-get root :parent) archive :archive))
- (c (and a category
- (xetla-browse-find-named-widget
- (widget-get a :parent) category :category)))
- (b (and c branch
- (xetla-browse-find-named-widget
- (widget-get c :parent) branch :branch)))
- (v (and b version
- (xetla-browse-find-named-widget
- (widget-get b :parent) version :version))))
- (list root a c b v)))
-
-(defun xetla-browse-find-single-widget (archive
- &optional category branch
- version)
- "Similar to `xetla-browse-find-widget'.
-Difference is it returns only the widget representing the last non-nil
-widget of the list. The means of ARCHIVE, CATEGORY, BRANCH and VERSION
-are the same as that of `xetla-browse-find-widget'."
- (let ((widgets (xetla-browse-find-widget archive category branch
- version)))
- (or (nth 4 widgets)
- (nth 3 widgets)
- (nth 2 widgets)
- (nth 1 widgets)
- (error "Widget not found. Please fill-in a bug report"))))
-
-(defun xetla-browse-find-real-widget (widget)
- "Find real(complete) widget from incomplete WIDGET.
-When trying to find widgets using (widget-get ... :args), we
-sometimes find an incomplete widget, having no :from or :to
-information for example. This function takes as an argument an
-incomplete widget, and finds the corresponding full widget.
-
-WIDGET must be of type xetla-widget-*-node."
- (case (widget-type widget)
- (xetla-widget-archive-node
- (xetla-browse-find-single-widget
- (widget-get widget :archive)))
- (xetla-widget-category-node
- (xetla-browse-find-single-widget
- (widget-get widget :archive)
- (widget-get widget :category)))
- (xetla-widget-branch-node
- (xetla-browse-find-single-widget
- (widget-get widget :archive)
- (widget-get widget :category)
- (widget-get widget :branch)))
- (xetla-widget-version-node
- (xetla-browse-find-single-widget
- (widget-get widget :archive)
- (widget-get widget :category)
- (widget-get widget :version)))))
-
-(defun* xetla-browse-open (flash archive
- &optional category branch version)
- (let (widgets root a c b v)
-
- (unless archive
- (return-from xetla-browse-open nil))
- (setq widgets (xetla-browse-find-widget archive category branch nil))
- (setq root (nth 0 widgets))
- (unless root
- (error "Cannot find root archives node"))
- (xetla-widget-node-toggle-subtree-internal root 'open)
-
- (setq widgets (xetla-browse-find-widget archive category branch nil))
- (setq a (nth 1 widgets))
- (unless category
- (if a
- (progn (when flash
- (goto-char (widget-get a :from))
- (xetla-flash-line))
- (return-from xetla-browse-open nil))
- (error "Cannot find archive node for: %s" archive)))
- (xetla-widget-node-toggle-subtree-internal a 'open)
-
- (setq widgets (xetla-browse-find-widget archive category branch nil))
- (setq c (nth 2 widgets))
- (unless branch
- (if c
- (progn (when flash
- (goto-char (widget-get c :from))
- (xetla-flash-line))
- (return-from xetla-browse-open nil))
- (error "Cannot find category node for: %s/%s" archive category)))
- (xetla-widget-node-toggle-subtree-internal c 'open)
-
- (setq widgets (xetla-browse-find-widget archive category branch nil))
- (setq b (nth 3 widgets))
- (unless version
- (if b
- (progn (when flash
- (goto-char (widget-get b :from))
- (xetla-flash-line))
- (return-from xetla-browse-open nil))
- (error "Cannot find branch node for: %s/%s-%s" archive category branch)))
- (xetla-widget-node-toggle-subtree-internal b 'open)
-
- (setq widgets (xetla-browse-find-widget archive category branch version))
- (setq v (nth 4 widgets))
- (if v
- (progn (when flash
- (goto-char (widget-get v :from))
- (xetla-flash-line))
- (return-from xetla-browse-open nil))
- (error "Cannot find branch node for: %s/%s-%s-%s" archive category branch version)))
- )
-
-;; --------------------------------------
-;; Abstract Super Widget
-;; --------------------------------------
-(define-widget 'xetla-widget-node 'item
- "Abstract super widget for xetla-widget-*-node."
- :xetla-type nil
- :format "%[ %t%]%{%v%}\n"
- :face nil
- :keymap nil
- :menu nil
- :marks " "
- :keep '(:marks :open)
- :open-subtree (if (fboundp 'tree-widget-open-node)
- 'tree-widget-open-node
- 'xetla-tree-widget-node-toggle-subtree-for-tree-widget-v1)
- :close-subtree (if (fboundp 'tree-widget-open-node)
- 'tree-widget-close-node
- 'xetla-tree-widget-node-toggle-subtree-for-tree-widget-v1))
-
-(defvar xetla-widget-node-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [return]
- 'xetla-widget-node-toggle-subtree)
- (define-key map [button2]
- 'xetla-widget-node-toggle-subtree-by-mouse)
- (define-key map "\C-m"
- 'xetla-widget-node-toggle-subtree)
- (define-key map (xetla-prefix-buffer ?p)
- 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L)
- 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark)
- 'xetla-bookmarks)
- (define-key map xetla-keyvec-kill-ring
- 'xetla-widget-node-save-name-to-kill-ring)
- (define-key map xetla-keyvec-add-bookmark
- 'xetla-widget-node-add-bookmark)
- map)
- "Keymap commonly used in xetla-widget-*-node.")
-
-(defun xetla-widget-node-value-create (widget keyword)
- "Create value for WIDGET.
-KEYWORD is used to get the base string to create the value."
- (insert (let* ((marks (widget-get widget :marks))
- (string (widget-get widget keyword))
- (value (xetla-widget-node-install-ui-element
- widget (if (string= string "") "<empty>"
- string))))
- (concat marks value))))
-
-(defun xetla-widget-node-install-ui-element (widget value &optional face)
- "Create a string with keymap, menu and face properties.
-The keymap and menu are retrieved from WIDGET.
-The string is copied from VALUE.
-FACE is useds as the face."
- (let ((prop-value (xetla-face-add value
- (if face face (widget-get widget :face))
- (widget-get widget :keymap)
- (widget-get widget :menu))))
- (put-text-property 0 (length value)
- 'widget widget
- prop-value)
- prop-value))
-
-(defun xetla-widget-node-get-at (&optional point)
- "Get widget at POINT."
- (get-text-property (if point point (point)) 'widget))
-
-(defun xetla-widget-node-get-name (&optional point)
- "Get name list associated widget under the POINT."
- (let ((widget (xetla-widget-node-get-at point)))
- (list (widget-get widget :archive)
- (widget-get widget :category)
- (widget-get widget :branch)
- (widget-get widget :version)
- nil)))
-
-(defun xetla-widget-node-get-type (&optional point)
- "Get type of widget under the POINT.
-
-Can be either 'archive, 'category, 'branch, 'version or nil for the
-root of the tree."
- (let ((widget (xetla-widget-node-get-at point)))
- (widget-get widget :xetla-type)))
-
-(defun xetla-widget-get-ancestor (widget level)
- "Get the ancestor widget of WIDGET.
-\"ancestor\" widget stands for the LEVEL upper widget
-in the archives tree."
- (let ((i 0)
- (parent widget))
- (while (< i level)
- (setq parent (widget-get parent :parent)
- i (1+ i)))
- parent))
-
-(defun xetla-widget-node-refresh (&optional level point
- archive
- category
- branch)
- "Refresh node and LEVEL subnode at the POINT.
-Before refreshing node, names cache are also refreshed if
-ARCHIVE, CATEGORY, and/or BRANCH are specified."
- (interactive)
- (unless level (setq level 1))
- (unless point (setq point (point)))
- (if branch
- (xetla-archive-tree-build-versions archive
- category
- branch
- nil t)
- (if category
- (xetla-archive-tree-build-branches archive
- category
- nil t)
- (if archive
- (xetla-archive-tree-build-categories archive
- nil
- t)
- (xetla-archive-tree-build-archives nil t))))
- (let* ((widget (xetla-widget-node-get-at point))
- (tree (xetla-widget-get-ancestor widget level)))
- (widget-put tree :args nil)
- (widget-value-set tree (widget-value tree))
- (widget-setup)))
-
-(defun xetla-widget-node-synchronize-mirror-to-remote ()
- "Synchronizes the mirror for the archive at point to remote from local."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (type (xetla-archive-type archive))
- mirror source)
- (cond
- ((eq type 'normal)
- (setq mirror (xetla-archive-name-mirror archive t))
- (unless mirror
- (error "No mirror archive for `%s'" archive)))
- ((eq type 'mirror)
- (setq source (xetla-archive-name-source archive t))
- (if source
- (setq archive source)
- (error "No source archive for `%s'" archive)))
- (t (error "Cannot mirror to a source archive: `%s'" archive)))
- (xetla-archive-mirror archive
- (xetla-name-category name)
- (xetla-name-branch name)
- (xetla-name-version name)
- nil)))
-
-(defun xetla-widget-node-synchronize-mirror-to-local ()
- "Synchronizes the mirror for the archive at point to local from remote."
- (interactive)
- ;; TODO
- )
-
-(defun xetla-widget-node-save-name-to-kill-ring ()
- "Save the name under point to `kill-ring'."
- (interactive)
- (let ((name (xetla-name-construct (xetla-widget-node-get-name))))
- (when (equal "" name)
- (error "No widget under the point"))
- (kill-new name)
- (message "Name: %s" name)))
-
-(defun xetla-widget-node-add-bookmark ()
- "Add a name associated with a widget at point to xetla's bookmarks."
- (interactive)
- (let* ((target (xetla-widget-node-get-name))
- (target-fq (xetla-name-construct target))
- (bookmark (read-from-minibuffer (format "Name of Bookmark for `%s': "
- target-fq))))
- (xetla-bookmarks-add bookmark target)
- (when (y-or-n-p "View bookmarks? ")
- (xetla-bookmarks))
- (message "bookmark %s(=> %s) added." bookmark target-fq)))
-
-(defun xetla-widget-node-toggle-subtree (&optional point force)
- "Toggle between closing and opening the node at POINT.
-You can specify a symbol, `open' or `close' to FORCE to force
-the node to open or to close."
- (interactive)
- (xetla-widget-node-toggle-subtree-internal
- (xetla-widget-node-get-at point) force))
-
-(defun xetla-widget-node-toggle-subtree-recursive (&optional point
- force)
- "Same as `xetla-widget-node-toggle-subtree'.
-The difference is that when the node is expanded, expands it
-recursively, which means all the children will also be expanded. (this
-may take looong).
-Meaning of POINT and FORCE are the same as that of
-`xetla-widget-node-toggle-subtree'."
- (interactive)
- (xetla-widget-node-toggle-subtree-internal
- (xetla-widget-node-get-at point) force t))
-
-(defun xetla-widget-node-toggle-subtree-internal (widget force
- &optional
- recursive)
- "Toggle between closing and opening the WIDGET.
-You can specify a symbol, `open' or `close' to FORCE to force
-the node to open or to close. If RECURSIVE is non-nil, the opening
-or closing are applied recursively."
- (let* ((open-subtree (widget-get widget :open-subtree))
- (close-subtree (widget-get widget :close-subtree)))
- (cond
- ((or (eq force 'open)
- (and (not force)
- (not (widget-get (widget-get widget :parent) :open))))
- (when open-subtree (funcall open-subtree widget))
- (when recursive
- (xetla-widget-node-toggle-subtree-recursion widget 'open)))
- ((or (eq force 'close)
- (and (not force)
- (widget-get (widget-get widget :parent) :open)))
- (when (and recursive
- (widget-get (widget-get widget :parent) :open))
- (when open-subtree (funcall open-subtree widget))
- (xetla-widget-node-toggle-subtree-recursion widget 'close))
- (when close-subtree (funcall close-subtree widget))))))
-
-(defun xetla-widget-node-toggle-subtree-recursion (widget force)
- "A helper function for 'xetla-widget-node-toggle-subtree-internal'.
-Apply all sub node of WIDGET opening or closing which is specified
-by FORCE."
- (let ((args (widget-get (widget-get widget :parent) :args)))
- (dolist (arg args)
- (let* ((t-widget (widget-get arg :node))
- ;; surprisingly, t-widget doesn't have all the
- ;; necessary fields. Look for the _real_ widget.
- (full-widget
- (xetla-browse-find-real-widget t-widget)))
- (unless (eq (widget-type t-widget)
- (widget-type full-widget))
- (error "Incorrect widget. Please contact the developers"))
- (when full-widget
- (xetla-widget-node-toggle-subtree-internal
- full-widget force t))))))
-
-(defun xetla-tree-widget-node-toggle-subtree-for-tree-widget-v1 (widget)
- "Toggle tree node function used in `xetla-browse' with tree-widget ver.1.0.5.
-The code is the almost same as in tree-widget-toggle-folding tree-widget version
-1.0.5.
-
-Original documents say:
- \"Toggle a `tree-widget' folding.
-WIDGET is a `tree-widget-node-handle-widget' and its parent the
-`tree-widget' itself. IGNORE other arguments.\""
- (let* ((parent (widget-get widget :parent))
- ;; Original code
- ; (open (widget-value widget))
- ;; Here `parent' is used instead of `widget'.
- (open (widget-value parent)))
- (if open
- (tree-widget-children-value-save parent))
- (widget-put parent :open (not open))
- (widget-value-set parent (not open))
- (run-hook-with-args 'tree-widget-after-toggle-functions parent)))
-
-(xetla-make-bymouse-function xetla-widget-node-toggle-subtree)
-
-;; --------------------------------------
-;; My-id
-;; --------------------------------------
-(define-widget 'xetla-widget-my-id 'push-button
- "Widget to control xetla's my-id."
- :format "%{My-id:%} %[%t%]"
- :sample-face 'bold
- :button-face 'widget-field-face
- :notify 'xetla-widget-my-id-set
- :help-echo "Click here to change my-id")
-
-(defun xetla-widget-my-id-set (self changed event)
- "Set my-id to my-id-widget.
-SELF is not used. CHANGED is just passed to `widget-value-set'.
-EVENT is also not used."
- (let ((new-id (xetla-my-id t)))
- (widget-value-set changed new-id)
- (widget-setup)))
-
-;; --------------------------------------
-;; Root node
-;; --------------------------------------
-(define-widget 'xetla-widget-root-node 'xetla-widget-node
- "Root node widget for trees in xetla-browse buffer."
- :value-create 'xetla-widget-root-node-value-create
- :format " %v\n"
- :face 'bold)
-
-(defun xetla-widget-root-node-value-create (widget)
- "Create a value for root node represented by WIDGET."
- (insert (xetla-widget-node-install-ui-element
- widget
- (widget-get widget :tag))))
-
-(defvar xetla-widget-archives-root-node-map
- (let ((map (copy-keymap xetla-widget-node-map)))
- (define-key map xetla-keyvec-refresh
- 'xetla-widget-node-refresh)
- (define-key map (xetla-prefix-add ?a)
- 'xetla-widget-archives-root-node-make-archive)
- (define-key map (xetla-prefix-add ?r)
- 'xetla-widget-archives-root-node-register-archive)
- map)
- "Keymap used on the archives root node.")
-
-(easy-menu-define xetla-widget-archives-root-node-menu nil
- "Menu used on the root archives item in `xetla-browse-mode' buffer."
- '("Archives Root"
- ["Update Archives List"
- xetla-widget-node-refresh t]
- ["Make New Archive..."
- xetla-widget-archives-root-node-make-archive t]
- ["Register Archive"
- xetla-widget-archives-root-node-register-archive t]))
-
-(defun xetla-widget-archives-root-node-make-archive ()
- "Call `xetla-make-archive-internal' interactively then update the tree of `xetla-browse'."
- (interactive)
- (call-interactively 'xetla-make-archive-internal)
- (xetla-widget-node-refresh 1))
-
-(defun xetla-widget-archives-root-node-goto (name)
- "Move the point to beginning of line in where the NAME is.
-This may be useful to search an archive named NAME."
- (goto-char (point-min))
- (search-forward name)
- (beginning-of-line))
-
-(defun xetla-widget-archives-root-node-register-archive ()
- "Call `xetla-register-archive-internal' interactively ; then update the tree of `xetla-browse'."
- (interactive)
- (let* ((result (call-interactively 'xetla-register-archive-internal))
- (archive-registered (nth 0 result))
- (archive (nth 1 result))
- (xetla-response (nth 3 result)))
- (when archive-registered
- (xetla-widget-node-refresh 1)
- (message xetla-response)
- (xetla-widget-archives-root-node-goto
- (if (string-match ".+: \\(.+\\)" xetla-response)
- (match-string 1 xetla-response)
- archive))
- (xetla-flash-line))))
-
-
-;; --------------------------------------
-;; Archive
-;; --------------------------------------
-(defface xetla-location
- '((((class color) (background dark)) (:foreground "gray"))
- (((class color) (background light)) (:foreground "gray"))
- (t (:bold t)))
- "Face to highlight xetla's archive location."
- :group 'xetla-faces)
-
-(make-face 'xetla-location-ftp
- "Face to highlight xetla's archive ftp location.")
-(set-face-parent 'xetla-location-ftp 'xetla-location)
-
-(make-face 'xetla-location-sftp
- "Face to highlight xetla's archive sftp location.")
-(set-face-parent 'xetla-location-sftp 'xetla-location)
-(set-face-foreground 'xetla-location-sftp "gray50")
-
-(make-face 'xetla-location-http
- "Face to highlight xetla's archive sftp location.")
-(set-face-parent 'xetla-location-http 'xetla-location)
-(set-face-foreground 'xetla-location-http "gray60")
-
-(make-face 'xetla-location-local
- "Face to highlight xetla's local archive.")
-(set-face-parent 'xetla-location-local 'xetla-location)
-(set-face-foreground 'xetla-location-local "gray30")
-
-(defvar xetla-widget-archive-node-map
- (let ((map (copy-keymap xetla-widget-node-map)))
- (define-key map xetla-keyvec-refresh
- 'xetla-widget-archive-node-refresh)
- (define-key map "*" 'xetla-widget-archive-node-select-default)
- (define-key map xetla-keyvec-remove
- 'xetla-widget-archive-node-unregister-archive)
- (define-key map (xetla-prefix-add ?c)
- 'xetla-widget-archive-node-make-category)
- (define-key map (xetla-prefix-apply-from-here xetla-key-reflect)
- 'xetla-widget-archive-node-start-project)
- (define-key map xetla-keyvec-reflect
- 'xetla-widget-node-synchronize-mirror-to-remote)
- (define-key map xetla-keyvec-get
- 'xetla-widget-node-synchronize-mirror-to-local)
- (define-key map (xetla-prefix-add xetla-key-reflect)
- 'xetla-widget-archive-node-make-mirror-at-remote)
- (define-key map (xetla-prefix-add xetla-key-get)
- 'xetla-widget-archive-node-make-mirror-at-local)
- map)
- "Keymap used on xetla-widget-archive-node.")
-
-(easy-menu-define xetla-widget-archive-node-menu nil
- "Menu used on a archive item in `xetla-browse-mode' buffer."
- '("Archive"
- ["Update Categories List" xetla-widget-archive-node-refresh t]
- ["Set Default Archive" xetla-widget-archive-node-select-default t]
- ["Remove Archive Registration" xetla-widget-archive-node-unregister-archive t]
- ["Make New Category..." xetla-widget-archive-node-make-category t]
- ["Start Project from Here" xetla-widget-archive-node-start-project t]
- ["Add a Bookmark" xetla-widget-node-add-bookmark t]
- ("Remote Mirror"
- ["Synchronize Mirror to Remote From Local"
- xetla-widget-node-synchronize-mirror-to-remote
- (let* ((archive (xetla-name-archive (xetla-widget-node-get-name)))
- (type (xetla-archive-type archive)))
- (or (and (eq type 'normal)
- (xetla-archive-name-mirror archive t))
- (and (eq type 'mirror)
- (xetla-archive-name-source archive t))))]
- ["Create a Mirror at Remote"
- xetla-widget-archive-node-make-mirror-at-remote
- (eq (xetla-archive-type (xetla-name-archive (xetla-widget-node-get-name)))
- 'normal)])
- ("Local Mirror"
- ["Synchronize Mirror to Local[TODO]"
- ;; TODO
- xetla-widget-node-synchronize-mirror-to-local nil]
- ["Create a Mirror at Local" xetla-widget-archive-node-make-mirror-at-local
- (eq (xetla-archive-type (xetla-name-archive (xetla-widget-node-get-name)))
- 'source)]
- "-"
- ["Convert to SOURCE archive" xetla-widget-archive-node-convert-to-source
- (eq (xetla-archive-type (xetla-name-archive (xetla-widget-node-get-name)))
- 'normal)])
- ["Save Name to Kill Ring" xetla-widget-node-save-name-to-kill-ring t]))
-
-(defconst xetla-widget-archive-node-tag "a")
-(defconst xetla-widget-archive-node-default-tag "A")
-
-(define-widget 'xetla-widget-archive-node 'xetla-widget-node
- "Archive node in xetla-browse."
- :tag xetla-widget-archive-node-tag
- :value-create 'xetla-widget-archive-node-value-create
- :xetla-type 'archive
- :face 'xetla-archive-name
- :keymap 'xetla-widget-archive-node-map
- :menu xetla-widget-archive-node-menu
- :archive nil
- :archive-location nil
- :archive-defaultp nil)
-
-(defvar xetla-widget-archive-node-list nil)
-(defun xetla-browse-expand-archives (root)
- "Expand ROOT widget."
- (or (and (not current-prefix-arg) (widget-get root :args))
- (let ((default-archive (xetla-my-default-archive)))
- (setq xetla-widget-archive-node-list nil)
- (mapcar
- (lambda (archive)
- (let ((res
- `(tree-widget
- :open ,(xetla-browse-open-list-member (car archive))
- :has-children t
- :dynargs xetla-browse-expand-categories
- :node (xetla-widget-archive-node
- :tag ,(if (equal default-archive (car archive))
- xetla-widget-archive-node-default-tag
- xetla-widget-archive-node-tag)
- :archive ,(car archive)
- :archive-location ,(cadr archive)
- :archive-defaultp ,(equal
- default-archive
- (car
- archive))))))
- (widget-put (widget-get res :node) :parent res)
- res))
- (let* ((l xetla-archive-tree))
- (when (or (null l) current-prefix-arg)
- (xetla-archive-tree-build-archives nil t))
- xetla-archive-tree)))))
-
-(defun xetla-widget-archive-node-value-create (widget)
- "Create values for WIDGET."
- (push widget xetla-widget-archive-node-list)
- (insert (let* ((archive (widget-get widget :archive))
- (location (widget-get widget :archive-location))
- (defaultp (widget-get widget :archive-defaultp))
- (marks (widget-get widget :marks))
- (value (progn
- (case (xetla-archive-type archive)
- (mirror (widget-put widget :face 'xetla-mirror-archive-name))
- (source (widget-put widget :face 'xetla-source-archive-name)))
- ;;
- ;; It seems that XEmacs's format hides text properties.
- ;;
- (concat marks
- (xetla-widget-node-install-ui-element
- widget archive (when defaultp
- 'xetla-marked))
- " => "
- (xetla-widget-archive-put-face-on-location
- location)))))
- value)))
-
-(defun xetla-widget-archive-put-face-on-location (location)
- "Set face to LOCATION based on the location type(ftp, sftp, http or local)."
-(let ((face (case (xetla-location-type location)
- (ftp 'xetla-location-ftp)
- (sftp 'xetla-location-sftp)
- (http 'xetla-location-http)
- (local 'xetla-location-local)))
- (location (copy-sequence location)))
- (put-text-property 0 (length location)
- 'face face location)
- location))
-
-(defun xetla-widget-archive-node-refresh ()
- "Refresh an archive node under the point."
- (interactive)
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive
- (xetla-widget-node-get-name))))
-
-(defun xetla-widget-archive-node-select-default ()
- "Mark a widget associated with the default archive.
-Unmark widgets not associated with the default archive.
-`:archive-defaultp' keyword is used to mark."
- (interactive)
- (mapc
- (lambda (widget)
- (when (equal xetla-widget-archive-node-default-tag
- (widget-get widget :tag))
- (widget-put widget :tag xetla-widget-archive-node-tag)
- (widget-put widget :archive-defaultp nil)
- (widget-value-set widget (widget-value widget))))
- xetla-widget-archive-node-list)
- (let* ((widget (xetla-widget-node-get-at))
- (archive (xetla-name-archive (xetla-widget-node-get-name) )))
- (xetla-my-default-archive archive)
- (widget-put widget :tag xetla-widget-archive-node-default-tag)
- (widget-put widget :archive-defaultp t)
- (widget-value-set widget (widget-value widget))))
-
-(defun xetla-widget-archive-node-unregister-archive ()
- "Delete the registration of the archive under the point."
- (interactive)
- (let ((archive (xetla-name-archive (xetla-widget-node-get-name))))
- (if archive
- (progn (xetla-unregister-archive archive t)
- (xetla-widget-node-refresh 2))
- (error "No archive under the point"))))
-
-(defun xetla-widget-archive-node-make-category ()
- "Make new category in the archive under the point."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (l (xetla-name-read "New Category: "
- archive
- 'prompt)))
- (xetla-make-category (xetla-name-archive l) (xetla-name-category l))
- (xetla-widget-node-refresh 1 nil (xetla-name-archive l))
- (xetla-browse-open t
- (xetla-name-archive l)
- (xetla-name-category l))
- ))
-
-(defun xetla-widget-archive-node-convert-to-source ()
- "Convert the archive under the point to a source archive."
- (interactive)
- (let* ((widget (xetla-widget-node-get-at))
- (archive (widget-get widget :archive))
- (location (widget-get widget :archive-location))
- (result (xetla-archive-convert-to-source-archive archive location)))
- (let ((archive-registered (nth 0 result))
- (archive (nth 1 result))
- (xetla-response (nth 3 result)))
- (when archive-registered
- (xetla-widget-node-refresh 2)
- (message xetla-response)
- (xetla-widget-archives-root-node-goto
- (if (string-match ".+: \\(.+\\)" xetla-response)
- (match-string 1 xetla-response)
- archive))
- (xetla-flash-line)))))
-
-(defun xetla-widget-archive-node-start-project ()
- "Start new project in the archive unde the point."
- (interactive)
- (let* ((archive (xetla-name-archive (xetla-widget-node-get-name)))
- (buffer (current-buffer))
- (p (point))
- (result (xetla-start-project archive 'synchronously))
- (category (xetla-name-category (car result)))
- (branch (xetla-name-branch (car result)))
- (version (xetla-name-version (car result)))
- )
- (with-current-buffer buffer
- (xetla-widget-node-refresh 1 p archive)
- (xetla-browse-open t
- archive category branch version))))
-
-(defun xetla-widget-archive-node-make-mirror-at-remote ()
- "Create a mirror for the local archive under the point at somewhere remote."
- (interactive)
- (let ((archive (xetla-name-archive (xetla-widget-node-get-name))))
- (unless archive
- (error "No archive under the point"))
- (xetla-mirror-archive archive nil nil nil nil)
- (xetla-widget-node-refresh 2)
- (xetla-widget-archives-root-node-goto (format "%s-MIRROR" archive))
- (xetla-flash-line)))
-
-(defun xetla-widget-archive-node-make-mirror-at-local ()
- "Create a mirror for the remote archive under the point to local."
- (interactive)
- (let ((archive (xetla-name-archive (xetla-widget-node-get-name))))
- (unless archive
- (error "No archive under the point"))
- (xetla-mirror-from-archive archive nil)
- (xetla-widget-node-refresh 2)
- (string-match "\\(.*\\)-SOURCE$" archive)
- (xetla-widget-archives-root-node-goto
- ;; Adding a space not to match SOURCE archive.
- (concat (match-string 1 archive) " "))
- (xetla-flash-line)))
-
-;; --------------------------------------
-;; Categories
-;; --------------------------------------
-(defvar xetla-widget-category-node-map
- (let ((map (copy-keymap xetla-widget-node-map)))
- (define-key map xetla-keyvec-refresh
- 'xetla-widget-category-node-refresh)
- (define-key map (xetla-prefix-add ?b)
- 'xetla-widget-category-node-make-branch)
- map)
- "Keymap used on xetla-widget-category-node.")
-
-(easy-menu-define xetla-widget-category-node-menu nil
- "Menu used on a archive item in `xetla-browse-mode' buffer."
- '("Category"
- ["Update Branches List" xetla-widget-category-node-refresh t]
- ["Remove Category[NOT IMPLEMENTED]" nil t]
- ["Make New Branch..." xetla-widget-category-node-make-branch t]
- ["Add a Bookmark" xetla-widget-node-add-bookmark t]
- ["Synchronize Mirror to Remote"
- xetla-widget-node-synchronize-mirror-to-remote t]
- ["Save Name to Kill Ring" xetla-widget-node-save-name-to-kill-ring t]))
-
-(define-widget 'xetla-widget-category-node 'xetla-widget-node
- "Category node in xetla-browse."
- :tag "c"
- :value-create 'xetla-widget-category-node-value-create
- :xetla-type 'category
- :face 'xetla-category-name
- :keymap 'xetla-widget-category-node-map
- :menu xetla-widget-category-node-menu
- :archive nil
- :category nil)
-
-(defun xetla-browse-expand-categories (archive)
- "Expand ARCHIVE widget."
- (or (and (not current-prefix-arg) (widget-get archive :args))
- (let ((archive-name (widget-get
- (widget-get archive :node)
- :archive)))
- (mapcar
- (lambda (category)
- (let ((res `(tree-widget
- :open ,(xetla-browse-open-list-member archive-name
- (car category))
- :has-children t
- :dynargs xetla-browse-expand-branches
- :node (xetla-widget-category-node
- :archive ,archive-name
- :category ,(car category)))))
- (widget-put (widget-get res :node) :parent res)
- res))
- (let* ((l (cddr (xetla-archive-tree-get-archive
- archive-name))))
- (when (or (null l) current-prefix-arg)
- (xetla-archive-tree-build-categories archive-name nil t))
- (cddr (xetla-archive-tree-get-archive archive-name)))))))
-
-(defun xetla-widget-category-node-value-create (widget)
- "Create values for category WIDGET."
- (xetla-widget-node-value-create widget :category))
-
-(defun xetla-widget-category-node-refresh ()
- "Refresh a category widget at the point."
- (interactive)
- (let ((name (xetla-widget-node-get-name)))
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive name)
- (xetla-name-category name))))
-
-(defun xetla-widget-category-node-make-branch ()
- "Make new branch in the category under the point."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (category (xetla-name-category name))
- (l (xetla-name-read "New Branch: "
- archive
- category
- 'prompt)))
- (xetla-make-branch (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l))
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive l)
- (xetla-name-category l))
- (xetla-browse-open t
- (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l))))
-
-;; --------------------------------------
-;; Branch
-;; --------------------------------------
-(defvar xetla-widget-branch-node-map
- (let ((map (copy-keymap xetla-widget-node-map)))
- (define-key map xetla-keyvec-refresh
- 'xetla-widget-branch-node-refresh)
- (define-key map (xetla-prefix-add ?v)
- 'xetla-widget-branch-node-make-version)
- (define-key map xetla-keyvec-get
- 'xetla-widget-branch-node-get-branch)
- map)
- "Keymap used on xetla-widget-branch-node.")
-
-(easy-menu-define xetla-widget-branch-node-menu nil
- "Menu used on a archive item in `xetla-browse-mode' buffer."
- '("Branch"
- ["Update Version List" xetla-widget-branch-node-refresh t]
- ["Remove Branch Registration[NOT IMPLEMENTED]" nil t]
- ["Make New Version..." xetla-widget-branch-node-make-version t]
- ["Get..." xetla-widget-branch-node-get-branch t]
- ["Add a Bookmark" xetla-widget-node-add-bookmark t]
- ["Synchronize Mirror to Remote"
- xetla-widget-node-synchronize-mirror-to-remote t]
- ["Save Name to Kill Ring" xetla-widget-node-save-name-to-kill-ring t]))
-
-(define-widget 'xetla-widget-branch-node 'xetla-widget-node
- "Branch node in xetla-browse."
- :tag "b"
- :value-create 'xetla-widget-branch-node-value-create
- :xetla-type 'branch
- :face 'xetla-branch-name
- :keymap 'xetla-widget-branch-node-map
- :menu xetla-widget-branch-node-menu
- :archive nil
- :category nil
- :branch nil)
-
-(defun xetla-browse-expand-branches (category)
- "Expand CATEGORY widget."
- (or (and (not current-prefix-arg) (widget-get category :args))
- (let* ((parent-node (widget-get category :node))
- (archive-name (widget-get parent-node :archive))
- (category-name (widget-get parent-node :category)))
- (mapcar
- (lambda (branch)
- (let ((res
- `(tree-widget
- :open ,(xetla-browse-open-list-member archive-name
- category-name
- (car branch))
- :has-children t
- :leaf-control xetla-widget-version-control
- :dynargs xetla-browse-expand-versions
- :node (xetla-widget-branch-node
- :archive ,archive-name
- :category ,category-name
- :branch ,(car branch)))))
- (widget-put (widget-get res :node) :parent res)
- res))
- (let* ((l (cdr (xetla-archive-tree-get-category
- archive-name
- category-name))))
- (when (or (null l) current-prefix-arg)
- (xetla-archive-tree-build-branches archive-name
- category-name
- nil t))
- (cdr (xetla-archive-tree-get-category archive-name
- category-name)))))))
-
-(defun xetla-widget-branch-node-value-create (widget)
- "Create values for branch WIDGET."
- (xetla-widget-node-value-create widget :branch))
-
-(defun xetla-widget-branch-node-refresh ()
- "Refresh a branch widget at the point."
- (interactive)
- (let ((name (xetla-widget-node-get-name)))
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive name)
- (xetla-name-category name)
- (xetla-name-branch name))))
-
-(defun xetla-widget-branch-node-make-version ()
- "Make new version in the branch under the point."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (category (xetla-name-category name))
- (branch (xetla-name-category name))
- (l (xetla-name-read "New Version: "
- archive
- category
- branch
- 'prompt)))
- (xetla-make-version (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l)
- (xetla-name-version l))
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l))
- (xetla-browse-open t
- (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l)
- (xetla-name-version l))))
-
-(defun xetla-widget-branch-node-get-branch ()
- "Run `tla get' against the branch at point."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (category (xetla-name-category name))
- (branch (xetla-name-branch name))
- (directory (expand-file-name
- (read-directory-name
- (format "Restore \"%s\" to: "
- (progn
- (unless branch
- (error "No branch under the point"))
- (xetla-name-construct
- archive category branch)))))))
- (if branch
- (xetla-get directory
- 'ask
- archive
- category
- branch)
- (error "No branch under the point"))))
-
-
-;; --------------------------------------
-;; Version
-;; --------------------------------------
-(defvar xetla-widget-version-node-map
- (let ((map (copy-keymap xetla-widget-node-map)))
- (define-key map xetla-keyvec-refresh
- 'xetla-widget-version-node-show-revisions)
- (define-key map xetla-keyvec-get
- 'xetla-widget-version-node-get-version)
- (define-key map xetla-keyvec-tag 'xetla-widget-version-node-tag)
- map)
- "Keymap used on xetla-widget-version-node.")
-
-(easy-menu-define xetla-widget-version-node-menu nil
- "Menu used on a archive item in `xetla-browse-mode' buffer."
- '("Version"
- ["Show Revisions" xetla-widget-version-node-show-revisions t]
- ["Remove Version Registration[NOT IMPLEMENTED]" nil t]
- ["Get..." xetla-widget-version-node-get-version t]
- ["Add a Bookmark" xetla-widget-node-add-bookmark t]
- ["Synchronize Mirror to Remote"
- xetla-widget-node-synchronize-mirror-to-remote t]
- ["Put Tag..." xetla-widget-version-node-tag t]
- ["Save Name to Kill Ring" xetla-widget-node-save-name-to-kill-ring t]))
-
-(define-widget 'xetla-widget-version-node 'xetla-widget-node
- "Version node in xetla-browse."
- :tag "v"
- :value-create 'xetla-widget-version-node-value-create
- :xetla-type 'version
- :face 'xetla-version-name
- :keymap 'xetla-widget-version-node-map
- :menu xetla-widget-version-node-menu
- :archive nil
- :category nil
- :branch nil
- :version nil
- :open-subtree 'xetla-widget-version-node-open-subtree
- :close-subtree 'xetla-widget-version-node-open-subtree)
-
-
-(define-widget 'xetla-widget-version-control 'tree-widget-empty-control
- "Control widget that represents a leaf version node."
- :tag "[->]"
- :format "%[%t%]"
- :action 'xetla-widget-version-control-show-revisions)
-
-(defun xetla-widget-version-control-show-revisions (widget &optional event)
- "Show revisions in a version associated with WIDGET.
-The version is under the point or place where click EVENT is created."
- (if event
- (mouse-set-point event))
- (let ((pos (next-single-property-change (point)
- 'widget
- (current-buffer)
- (point-at-eol))))
- (when pos
- (xetla-widget-version-node-show-revisions pos))))
-
-(defun xetla-browse-expand-versions (branch)
- "Expand BRANCH widget."
- (or (and (not current-prefix-arg) (widget-get branch :args))
- (let* ((parent-node (widget-get branch :node))
- (archive-name (widget-get parent-node :archive))
- (category-name (widget-get parent-node :category))
- (branch-name (widget-get parent-node :branch)))
- (mapcar (lambda (version)
- `(xetla-widget-version-node
- :archive ,archive-name
- :category ,category-name
- :branch ,branch-name
- :version ,(car version)))
- (let* ((l (cdr (xetla-archive-tree-get-branch archive-name
- category-name
- branch-name))))
- (when (or (null l) current-prefix-arg)
- (xetla-archive-tree-build-versions archive-name
- category-name
- branch-name
- nil t))
- (cdr (xetla-archive-tree-get-branch archive-name
- category-name
- branch-name)))))))
-
-(defun xetla-widget-version-node-value-create (widget)
- "Create values for version WIDGET."
- (xetla-widget-node-value-create widget :version))
-
-(defun xetla-widget-version-node-show-revisions (&optional point)
- "Show revisions in the version under the POINT.
-If POINT is nil, use the point under `point'."
- (interactive)
- (let ((name (xetla-widget-node-get-name (or point (point)))))
- (xetla-revisions (xetla-name-archive name)
- (xetla-name-category name)
- (xetla-name-branch name)
- (xetla-name-version name)
- nil nil)))
-
-(defun xetla-widget-version-node-get-version ()
- "Run \"tla get\" against the version at point."
- (interactive)
- (let* ((name (xetla-widget-node-get-name))
- (archive (xetla-name-archive name))
- (category (xetla-name-category name))
- (branch (xetla-name-branch name))
- (version (xetla-name-version name))
- (directory (expand-file-name
- (read-directory-name
- (format "Restore \"%s\" to: "
- (progn
- (unless version
- (error "No version under the point"))
- (xetla-name-construct
- archive category branch version)))))))
- (if version
- (xetla-get directory
- 'ask
- archive
- category
- branch
- version)
- (error "No version under the point"))))
-
-(defun xetla-widget-version-node-tag ()
- "Run tla tag from the version under the point."
- (interactive)
- (let* ((from (xetla-widget-node-get-name))
- (from-fq (xetla-name-construct from))
- (to (xetla-name-read (format "Tag from `%s' to: " from-fq)
- 'prompt 'prompt 'prompt 'prompt))
- (to-fq (xetla-name-construct to)))
- (unless from
- (error "No version under the point"))
- (unless to-fq
- (error "Wrong version tagged to is given"))
- (save-excursion
- (xetla-version-tag-internal from-fq to-fq 'synchronously))
- (xetla-widget-node-refresh 1 nil
- (xetla-name-archive to-fq)
- (xetla-name-category to-fq)
- (xetla-name-branch to-fq))
- (xetla-browse-open t
- (xetla-name-archive to-fq)
- (xetla-name-category to-fq)
- (xetla-name-branch to-fq)
- (xetla-name-version to-fq))))
-
-(defun xetla-widget-version-node-open-subtree (widget)
- "List revisions in the version associated with WIDGET."
- (xetla-revisions (widget-get widget :archive)
- (widget-get widget :category)
- (widget-get widget :branch)
- (widget-get widget :version)
- nil nil))
-
-;; --------------------------------------
-;; Entry point
-;; --------------------------------------
-;; TODO: Filtered by GROUP in bookmark
-;;;###autoload
-(defun xetla-browse (&optional initial-open-list append)
- "Browse registered archives as trees within one buffer.
-You can specify the node should be opened by alist,
-INITIAL-OPEN-LIST. If APPEND is nil, the nodes not in
-INITIAL-OPEN-LIST are made closed. If non-nil, the nodes
-already opened are kept open."
-
- (interactive)
- (switch-to-buffer (xetla-get-buffer-create
- xetla-browse-buffer-type))
- (make-local-variable 'xetla-browse-open-list)
- (setq truncate-lines t)
-
- (let (building)
- (if (zerop (buffer-size))
- (progn (setq building t)
- (xetla-browse-set-initial-open-list initial-open-list t))
- (if append
- (progn
- (setq building nil)
- (xetla-browse-set-initial-open-list initial-open-list nil))
- (if (y-or-n-p (format "Remove old %s? " (buffer-name)))
- (progn (setq building t)
- (xetla-browse-set-initial-open-list initial-open-list nil))
- (setq building nil)
- (xetla-browse-set-initial-open-list initial-open-list t))))
-
- (if building
- (progn
- (xetla-browse-erase-buffer)
- (xetla-browse-build-buffer))
- (mapc
- (lambda (elt)
- (xetla-browse-open nil
- (xetla-name-archive elt)
- (xetla-name-category elt)
- (xetla-name-branch elt)
- (xetla-name-version elt)))
- xetla-browse-open-list)))
- (goto-char (point-min))
- (xetla-browse-mode))
-
-(defun xetla-browse-set-initial-open-list (list clearp)
- "Insert LIST to `xetla-browse-open-list'.
-If CLEARP is set, clear `xetla-browse-open-list' before insertion.
-This is a helper function for `xetla-browse'."
- (when clearp
- (setq xetla-browse-open-list nil))
- (mapc
- (lambda (elt)
- (xetla-browse-open-list-add (xetla-name-archive elt)
- (xetla-name-category elt)
- (xetla-name-branch elt)
- (xetla-name-version elt)))
- list))
-(defun xetla-browse-erase-buffer ()
- "Erase *xetla-browse* buffer."
- (let ((inhibit-read-only t))
- (erase-buffer))
- ;; remove-extent is not portable enough.
- (mapc #'delete-extent
- (mapcar-extents #'identity
- nil nil (point-min) (point-max)
- 'all-extents-closed-open)))
-
-(defun xetla-browse-build-buffer ()
- "Insert contents of *xetla-buffer*."
- ;; Xetla config
- (widget-create 'tree-widget
- :open t
- :node '(item :format "%[%t%]\n"
- :tag "Personal Configuration")
- :has-chidren t
- `(xetla-widget-my-id ,(xetla-my-id)))
-
- (widget-insert "\n")
-
- ;; Archives
- (add-hook 'tree-widget-after-toggle-functions
- 'xetla-browse-open-tracker)
- (widget-create 'tree-widget
- :open t
- :node `(xetla-widget-root-node
- :xetla-type archives-root
- :tag "Archives"
- :keymap xetla-widget-archives-root-node-map
- :menu ,xetla-widget-archives-root-node-menu)
- :has-children t
- :dynargs 'xetla-browse-expand-archives)
- ;; Libraries
- ;; TODO
- (widget-setup))
-
-(defun xetla-browse-toggle-subtree-maybe ()
- "Run `xetla-browse-toggle-subtree'.
-Before running a widget is searched and move the point to
-the widget if it is found. If no widget is found,
-`widget-button-press'."
- (interactive)
- (let ((p (next-single-property-change (point-at-bol)
- 'widget
- nil
- (point-at-eol))))
- (if (and p (xetla-widget-node-get-type p))
- (xetla-widget-node-toggle-subtree p)
- (widget-button-press (point)))))
-
-(defun xetla-browse-dash ()
- "Move the point to the place where a widget is in the current line."
- (interactive)
- (let ((p (next-single-property-change (point-at-bol)
- 'widget
- nil
- (point-at-eol))))
- (when (and p (xetla-widget-node-get-type p))
- (goto-char p)
- (xetla-flash-line))))
-
-(defvar xetla-browse-map
- (let ((map (copy-keymap widget-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
- (define-key map [return] 'xetla-browse-toggle-subtree-maybe)
- (define-key map "\C-m" 'xetla-browse-toggle-subtree-maybe)
- (define-key map " " 'xetla-browse-dash)
- (define-key map xetla-keyvec-next 'next-line)
- (define-key map xetla-keyvec-previous 'previous-line)
- (define-key map xetla-keyvec-quit 'kill-this-buffer)
- (define-key map [?+] 'xetla-widget-node-toggle-subtree-recursive)
- map)
- "Keymap used in `xetla-browse-mode'.")
-
-(defun xetla-browse-mode ()
- "Mode for browsing xetla's archives.
-Don't use this function. Instead call `xetla-browse'."
- (setq major-mode 'xetla-browse-mode
- mode-name "xetla-browse")
- (use-local-map xetla-browse-map)
- (set-buffer-modified-p nil)
- (run-hooks 'xetla-browse-mode-hook))
-
-(provide 'xetla-browse)
-
-;;; xetla-browse.el ends here
+++ /dev/null
-;;; xetla-core.el --- Core of xetla
-
-;; Copyright (C) 2003-2004 by Stefan Reichoer (GPL)
-;; Copyright (C) 2004 Steve Youngs (BSD)
-
-;; Author: Steve Youngs <steve@eicq.org>
-;; Maintainer: Steve Youngs <steve@eicq.org>
-;; Created: 2004-11-25
-;; Keywords: arch archive tla
-
-;; Based on xtla-core.el by: Stefan Reichoer, <stefan@xsteve.at>
-
-;; This file is part of XEtla.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;; may be used to endorse or promote products derived from this
-;; software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
-;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; Commentary:
-
-;; Contributions from:
-;; Matthieu Moy <Matthieu.Moy@imag.fr>
-;; Masatake YAMATO <jet@gyve.org>
-;; Milan Zamazal <pdm@zamazal.org>
-;; Martin Pool <mbp@sourcefrog.net>
-;; Robert Widhopf-Fenk <hack@robf.de>
-;; Mark Triggs <mst@dishevelled.net>
-
-
-;; This file provides the low-level functions used by xetla.el
-
-
-;;; Code:
-
-(require 'xetla-defs)
-(require 'ewoc)
-
-;; --------------------------------------
-;; Compatibility stuff
-;; --------------------------------------
-(eval-when-compile
- (require 'cl)
- (autoload 'read-passwd "passwd"))
-
-(require 'pp)
-
-(defvar xetla-buffer-type-alist
- '((changes "*xetla-changes*" root)
- (inventory "*xetla-inventory*" path)
- (missing "*xetla-missing*" single)
- (cat-log "*xetla-cat-log(%s)*" string)
- (file-diff "*xetla-file-diff*" path)
- (changelog "*xetla-changelog*" root)
- (tree-lint "*xetla-tree-lint*" root)
- (logs "*xetla-logs*" root)
- (errors "*xetla-error*" multiple)
- (generic "*xetla-process*" multiple)
- (browse "*xetla-browse*" single)
- (changeset "*xetla-changeset(%s)*" string))
- "List of (type name mode) used to generate a name for a buffer.
-
-TYPE is the type of buffer to create, passed as the first argument to
-`xetla-get-buffer-create'.
-
-NAME is a string, used as a name for the returned buffer.
-
-MODE is a symbol defining the way to manage (value of
-`default-directory' in the created buffer) paths for this type of
-buffers. It can have the following values:
-
- * 'root: `default-directory' will be the tree-root of the specified
- directory.
-
- * 'path: `default-directory' will be the path specified.
-
-For 'root and 'path, `xetla-get-buffer-create' will return the existing
-buffer for this type and this path if it exists, or create a new one
-otherwise.
-
- * 'single: There is only one buffer of this type for each Emacs
- instance. If a path is provided, `default-directory' is set to that
- path. Otherwise, the path is left unchanged when a buffer is
- reused, and set to the current directory on buffer creation.
-
- * 'multiple: `default-directory' is set to the path specified. A new
- buffer is returned anyway. (No buffer reuse).
-
- * 'string: The path specified is actually a string. It won't be used
- to set `default-directory'. The name of the created buffer will be
- (format name string).")
-
-(defvar xetla-buffers-tree nil
- "Tree containing all xetla buffers.
-
-Must be of the form
- ((type1 (\"path1\" buffer \"original name of buffer\")
- (\"path2\" buffer2 \"original name of buffer2\"))
- (type2 (\"path1\" buffer3 \"original name of buffer3\")
- (\"path3\" buffer4 \"original name of buffer4\")))
-Used to keep track of all the xetla related buffers.")
-
-(defun xetla-buffers-tree-remove (buffer)
- "Remove BUFFER from the buffers tree."
- (dolist (type-cons xetla-buffers-tree)
- (dolist (path-buffer (cdr type-cons))
- (when (eq (cadr path-buffer) buffer)
- (setcdr type-cons (delete path-buffer (cdr type-cons)))))))
-
-(defun xetla-buffers-tree-add (type path buffer)
- "Add a buffer of TYPE visiting PATH to the buffers tree.
-BUFFER should be the buffer to add."
- (let ((current-assoc (assoc type xetla-buffers-tree)))
- (if current-assoc
- (setcdr current-assoc
- (cons (list path buffer (buffer-name buffer))
- (cdr current-assoc)))
- (setq xetla-buffers-tree
- (cons `(,type (,path ,buffer ,(buffer-name buffer))) xetla-buffers-tree)))))
-
-(defvar xetla-temp-directory (temp-directory)
- "Temporary directory for some xetla operations.")
-
-(defun xetla-make-temp-name (file)
- "Generate a temporary file name based on FILE.
-The path for the file name can be set via `xetla-temp-directory'."
- (make-temp-name (concat (xetla-uniquify-file-name xetla-temp-directory) file)))
-
-(defun xetla-uniquify-file-name (path)
- "Return a unique string designating PATH.
-If PATH is a directory,the returned contains one and exactly one trailing
-slash. If PATH is nil, then nil is returned."
- (and path
- (let ((expanded (expand-file-name
- (if (file-directory-p path)
- (file-name-as-directory path)
- path))))
- (if (featurep 'xemacs)
- (replace-regexp-in-string "/+$" "/" expanded)
- expanded))))
-
-(defun xetla-config-file-full-path (file &optional create-config-dir)
- "Return the full path for the config file FILE.
-FILE will be stored in the `xetla-config-directory'.
-If CREATE-CONFIG-DIR is non nil, ensure that the `xetla-config-directory'
-does exist."
- (let ((full-name (xetla-uniquify-file-name
- (concat xetla-config-directory file))))
- (unless (file-exists-p xetla-config-directory)
- (when create-config-dir
- (make-directory xetla-config-directory t)
- (message "The config files of Xetla will be stored in %s!"
- xetla-config-directory)
- (sit-for 5)))
- ;; TODO remove migration code as some time in the future
- (unless (file-exists-p (expand-file-name xetla-bookmarks-file-name
- xetla-config-directory))
- (let ((old-ones (list (list (expand-file-name xetla-bookmarks-file-name
- xetla-config-directory)
- "~/.xetla-bookmarks.el"
- "~/.xetla/.xetla-bookmarks.el")))
- o olds n)
- (while old-ones
- (setq olds (car old-ones) old-ones (cdr old-ones))
- (if olds (setq n (car olds) olds (cdr olds)))
- (while olds
- (setq o (expand-file-name (car olds)) olds (cdr olds))
- (if (file-exists-p o)
- (if (yes-or-no-p (format "Migrate %s to %s? " o n))
- (rename-file o n)
- (if (yes-or-no-p (format "Delete %s? " o))
- (delete-file o))))))))
- ;; return full-name
- full-name))
-
-(defun xetla-stringise (uberstring &rest args)
- "Create a string from UBERSTRING.
-I.e. you can pass
-- a string which evals to itself
-- a variable whose value is a string
-- a function which is called and should eval to a string
-- a form which is evaluated and should return a string.
-
-All results are run against `xetla-stringise' again
-until finally a string is produced."
- (cond ((stringp uberstring)
- uberstring)
- ((and (symbolp uberstring)
- (boundp uberstring))
- (xetla-stringise (symbol-value uberstring)))
- ((and (symbolp uberstring)
- (fboundp uberstring))
- (xetla-stringise (apply uberstring args)))
- ((ignore-errors (xetla-stringise (eval uberstring))))
- ((ignore-errors (xetla-stringise (eval (cons 'progn uberstring)))))
- (t nil)))
-
-;; this is useful since i can now have something like:
-;;
-;; (set-alist 'xetla-buffer-type-alist
-;; 'inventory
-;; '((format "*xetla-inventory%s*"
-;; (let ((dir (replace-regexp-in-string
-;; "^.+/\\([^/]+\\).?$"
-;; "\\1"
-;; (expand-file-name path))))
-;; (if dir (format " (%s)" dir)
-;; "")))))
-;;
-;; to always have the path in the buffer name of the inventory
-
-(defun xetla-get-buffer-type (type)
- "Get entry in `xetla-buffer-type-alist' for given TYPE."
- (assoc type xetla-buffer-type-alist))
-
-(defun xetla-get-buffer-name (type)
- "Get name part of `xetla-buffer-type-alist' for given TYPE."
- (let ((name (cadr (xetla-get-buffer-type type))))
- (xetla-stringise name)))
-
-(defun xetla-get-buffer-mode (type)
- "Get name part of `xetla-buffer-type-alist' for given TYPE."
- (let ((mode (caddr (xetla-get-buffer-type type))))
- mode))
-
-(eval-when-compile
- (autoload 'xetla-tree-root "xetla"))
-
-(defun xetla-get-buffer-create (type &optional path)
- "Get a buffer of type TYPE for the path PATH.
-
-Maybe reuse one if it exists, according to the value of
-`xetla-buffer-type-alist' (see its docstring), or, call
-`create-file-buffer' to create the buffer.
-
-See also `xetla-get-buffer'"
- ;; Inspired from `cvs-get-buffer-create'
- (let* ((path (or path default-directory))
- (elem (assoc type xetla-buffer-type-alist))
- (mode (caddr elem)))
- (or (xetla-get-buffer type path mode)
- ;; Buffer couldn't be reused. Create one
- (let ((path (case mode
- (root (xetla-uniquify-file-name
- (xetla-tree-root path)))
- (string path)
- (t (xetla-uniquify-file-name path))))
- (name (xetla-get-buffer-name type)))
- (let ((buffer
- (if (eq mode 'string)
- (get-buffer-create (format name path))
- (let ((default-directory (or path default-directory)))
- (create-file-buffer (or name "*xetla-buffer*"))))))
- (with-current-buffer buffer
- (xetla-buffers-tree-add type path buffer)
- buffer))))))
-
-(add-hook 'kill-buffer-hook 'xetla-kill-buffer-function)
-
-(defun xetla-kill-buffer-function ()
- "Function run when a buffer is killed."
- (xetla-buffers-tree-remove (current-buffer))
- (xetla-kill-process-maybe (current-buffer)))
-
-(defun xetla-get-buffer (type &optional path mode)
- "Get a buffer of type TYPE for the path PATH.
-
-Maybe reuse one if it exists, depending on the value of MODE (see
-`xetla-buffer-type-alist' 's third element), otherwise, return nil. See
-also `xetla-get-buffer-create'."
- (let ((mode (or mode (xetla-get-buffer-mode type)))
- (path (or path default-directory)))
- (if (eq mode 'single)
- ;; nothing to do about PATH. Reuse anyway
- (let* ((list-path (cdr (assoc type xetla-buffers-tree)))
- (first-elem (car list-path)))
- (if list-path
- (if (string= (buffer-name (cadr first-elem))
- (caddr first-elem))
- (cadr first-elem)
- (setcdr (assoc type xetla-buffers-tree) nil)
- nil)
- nil))
- (let ((path (and path
- (case mode
- (root (xetla-uniquify-file-name
- (xetla-tree-root path)))
- (string path)
- (t (xetla-uniquify-file-name path))))))
- (if (eq mode 'multiple)
- ;; no need to search an existing buffer
- nil
- (let* ((list-path (assoc type xetla-buffers-tree))
- (elem (assoc path (cdr list-path)))
- (buffer (cadr elem)))
- (when buffer
- (if (and (buffer-live-p buffer)
- ;; the buffer has not been renamed
- (string= (buffer-name buffer)
- (caddr elem)))
- buffer
- ;; remove the buffer and try again
- (setcdr list-path
- (delq (assoc path (cdr list-path))
- (cdr list-path)))
- (xetla-get-buffer type path mode)))))))))
-
-(defun xetla-add-buffer-type (type name)
- "Define a new TYPE of buffer whose buffer will be named NAME."
- (unless (assoc type xetla-buffer-type-alist)
- (push (list type name) xetla-buffer-type-alist)))
-
-(defun xetla-position (item seq)
- "Position of ITEM in list, or nil if not found.
-Return 0 if ITEM is the first element of SEQ"
- (let ((pos 0)
- (seq-int seq))
- (while (and seq-int
- (not (eq (car seq-int) item)))
- (setq seq-int (cdr seq-int))
- (setq pos (1+ pos)))
- (when seq-int pos)))
-
-
-(defun xetla-last-visited-inventory-buffer ()
- "Return the last visited xetla's inventory buffer."
- (let ((inventories (remove nil (mapcar
- (lambda (elt)
- (when (buffer-live-p (cadr elt))
- elt))
- (cdr (assoc 'inventory xetla-buffers-tree)))))
- (bl (buffer-list)))
- (cadr (car (sort inventories (lambda (a b)
- (let ((aindex (xetla-position (cadr a) bl))
- (bindex (xetla-position (cadr b) bl)))
- (< aindex bindex))))))))
-
-(defun xetla-show-inventory-buffer ()
- "Switch to the last visited inventory buffer."
- (interactive)
- (xetla-switch-to-buffer (xetla-last-visited-inventory-buffer)))
-
-;; --------------------------------------
-;; Process buffers
-;; --------------------------------------
-
-(defcustom xetla-process-buffer " *xetla-process*"
- "*Name of the process buffer."
- :type 'string
- :group 'xetla-internal)
-
-(defcustom xetla-error-buffer " *xetla-errors*"
- "*Name of the buffer to which xetla's stderr is redirected."
- :type 'string
- :group 'xetla-internal)
-
-(defcustom xetla-number-of-dead-process-buffer 20
- "*Number of process buffers to keep after process termination.
-When the number of process buffers exceeds this number, the most ancient
-is killed. This includes both the process buffer and the error
-buffer (to which stderr is redirected).
-
-A nil value here means \"Never kill any process buffer\". Useful for
-debugging, but this will eat the memory of your computer ;-)"
- :type 'integer
- :group 'xetla-internal)
-
-(defcustom xetla-show-internal-buffers-on-menu nil
- "Toggle display of dead process buffers in the buffer menu."
- :type 'boolean
- :group 'xetla-internal)
-
-(defvar xetla-dead-process-buffer-queue nil
- "List of process buffers belonging to terminated processes.
-When the list is greater than `xetla-number-of-dead-process-buffer', the last
-ones are killed.")
-
-(defun xetla-kill-process-buffer (buffer)
- "Don't actually kill BUFFER, but add it to `xetla-dead-process-buffer-queue'.
-It will eventually be killed when the number of buffers in
-`xetla-dead-process-buffer-queue'exceeds `xetla-number-of-dead-process-buffer'."
- (add-to-list 'xetla-dead-process-buffer-queue buffer t)
- (setq xetla-dead-process-buffer-queue
- (remove-if-not #'buffer-live-p xetla-dead-process-buffer-queue))
- (when xetla-number-of-dead-process-buffer
- (while (> (length xetla-dead-process-buffer-queue)
- (max 2 xetla-number-of-dead-process-buffer))
- (let ((currbuf (car xetla-dead-process-buffer-queue)))
- ;; just to be completely certain
- (when (buffer-live-p currbuf)
- (kill-buffer currbuf))
- ;; now remove that killed buffer
- (setq xetla-dead-process-buffer-queue
- (cdr xetla-dead-process-buffer-queue))))))
-
-(defvar xetla-last-process-buffer nil
- "The last created process buffer.")
-
-(defvar xetla-last-error-buffer nil
- "The last created process buffer.")
-
-(defun xetla-new-process-buffer (to-be-deleted)
- "Create a new process buffer.
-If TO-BE-DELETED is non-nil, make this buffer a candidate for eventually
-being deleted."
- (let ((buffer (create-file-buffer xetla-process-buffer)))
- (setq xetla-last-process-buffer buffer)
- (when to-be-deleted (xetla-kill-process-buffer buffer))
- buffer))
-
-(defun xetla-new-error-buffer (to-be-deleted)
- "Create a new error buffer.
-If TO-BE-DELETED is non-nil, make this buffer a candidate for eventually
-being deleted."
- (let ((buffer (create-file-buffer xetla-error-buffer)))
- (setq xetla-last-error-buffer buffer)
- (when to-be-deleted (xetla-kill-process-buffer buffer))
- buffer))
-
-;; --------------------------------------
-;; Process management
-;; --------------------------------------
-
-;; Candidates for process handlers
-(defun xetla-default-error-function (output error status arguments)
- "Default function called when a xetla process ends with a non-zero status.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (if (> (with-current-buffer error (point-max)) 1)
- (xetla-show-error-buffer error)
- (if (> (with-current-buffer output (point-max)) 1)
- (xetla-show-error-buffer output)
- (error "`tla %s' failed with code %d and no output!"
- (mapconcat 'identity arguments " ")
- status)))
- (error "`tla %s' failed with code %d"
- (mapconcat 'identity arguments " ")
- status))
-
-(defvar xetla-default-killed-function-noerror 0
- "The number of killed processes we will ignore until throwing an error.
-If the value is 0, `xetla-default-killed-function' will throw an error.
-See `xetla-default-killed-function'.")
-
-(defun xetla-default-killed-function (output error status arguments)
- "Default function called when a xetla process is killed.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (if (> xetla-default-killed-function-noerror 0)
- (setq xetla-default-killed-function-noerror
- (- xetla-default-killed-function-noerror 1))
- (xetla-switch-to-buffer error)
- (error "`tla %s' process killed !"
- (mapconcat 'identity arguments " "))))
-
-(defun xetla-null-handler (output error status arguments)
- "Handle a finished process without doing anything.
-Candidate as an argument for one of the keywords :finished, :error or :killed
-in `xetla-run-tla-sync' or `xetla-run-tla-async'.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- nil)
-
-(defun xetla-status-handler (output error status arguments)
- "Return an integer value that reflects the process status.
-Candidate as an argument for one of the keywords :finished, :error or :killed
-in `xetla-run-tla-sync' or `xetla-run-tla-async'.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (cond ((numberp status) status)
- ((string-match "^exited abnormally with code \\(.*\\)" status)
- (string-to-int (match-string 1)))
- (t (error status))))
-
-(defun xetla-output-buffer-handler (output error status arguments)
- "Return the output of a finished process, stripping any trailing newline.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (xetla-buffer-content output))
-
-(defun xetla-output-buffer-split-handler (output error status arguments)
- "Return the output of a finished process as a list of lines.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (split-string (xetla-buffer-content output) "\n"))
-
-(defun xetla-default-finish-function (output error status arguments)
- "Default function called when a xetla process terminates.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (with-current-buffer output
- (xetla-process-buffer-mode))
- (xetla-switch-to-buffer output)
- (message "`tla %s' process finished !"
- (mapconcat 'identity arguments " "))
- status)
-
-(defun xetla-finish-function-without-buffer-switch (output error status arguments)
- "Similar to `xetla-default-finish-function' but no buffer switch.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-STATUS indicates the return status of the program.
-ARGUMENTS is a list of the arguments that the process was called with."
- (message "`tla %s' process finished !"
- (mapconcat 'identity arguments " "))
- status)
-
-(defvar xetla-log-cookie nil)
-
-(defstruct (xetla-event) output-buffer error-buffer related-buffer
- command tree event time)
-
-(defun xetla-strip-final-newline (string)
- "Strip the final newline from STRING if there's one."
- (if (eq (aref string (- (length string) 1)) ?\n)
- (substring string 0 (- (length string) 1))
- string))
-
-(defsubst xetla-log-printer-print-buffer (buffer function)
- "Helper function for `xetla-log-printer'.
-Print a buffer filed for BUFFER during printing a log event.
-The printed name of BUFFER is mouse sensitive. If the user
-clicks it, FUNCTION is invoked."
- (xetla-face-add
- (or (buffer-name buffer)
- (pp-to-string buffer))
- 'xetla-buffer
- (when (buffer-live-p buffer)
- (let ((map (make-sparse-keymap)))
- (define-key map [button2] function)
- map))
- nil
- "Show the buffer"))
-
-(defun xetla-log-printer (elem)
- "XEtla event printer which prints ELEM."
- (let ((event (xetla-event-event elem))
- (p (point)))
- (insert
- "Command: " (xetla-event-command elem)
- "\nDirectory: " (xetla-face-add (xetla-event-tree elem)
- 'xetla-local-directory)
- "\nDate: " (format-time-string "%c" (xetla-event-time elem))
- "\nRelated Buffer: " (xetla-log-printer-print-buffer
- (xetla-event-related-buffer elem)
- 'xetla-switch-to-related-buffer-by-mouse)
- "\nOutput Buffer: " (xetla-log-printer-print-buffer
- (xetla-event-output-buffer elem)
- 'xetla-switch-to-output-buffer-by-mouse)
- "\nError Buffer: " (xetla-log-printer-print-buffer
- (xetla-event-error-buffer elem)
- 'xetla-switch-to-error-buffer-by-mouse)
- (if (not (string= event "started"))
- (concat "\nEvent: " event)
- "")
- "\n")
- ;; Reflect the point to `default-directory'.
- ;; NOTE: XEmacs doesn't have `point-entered' special text property.
- (put-text-property
- p (point)
- 'point-entered (lambda (old new)
- (setq default-directory
- (xetla-event-tree
- (ewoc-data
- (ewoc-locate xetla-log-cookie))))))
- ))
-
-(defvar xetla-process-running nil
- "List of xetla processes running.
-A value of nil indicates no processes are running.
-
-The list is a list of pairs (process event) where EVENT is the event
-corresponding to the beginning of the execution of process. It can be
-used to get more info about the process.")
-
-(defmacro xetla-switch-to-buffer-macro (function accessor)
- "Define a FUNCTION for switching to the buffer associated with some event.
-ACCESSOR is a function for retrieving the appropriate buffer from a
-`xetla-event'structure."
- `(defun ,function ()
- "In a log buffer, pops to the output or error buffer corresponding to the
-process at point"
- (interactive)
- (let ((buffer (,accessor
- (ewoc-data (ewoc-locate xetla-log-cookie)))))
- (cond ((buffer-live-p buffer)
- (xetla-switch-to-buffer buffer)
- (unless (member buffer
- (mapcar (lambda (p)
- (process-buffer (car p)))
- xetla-process-running))
- (xetla-process-buffer-mode)))
- (t (error "Buffer has been killed"))))))
-
-(xetla-switch-to-buffer-macro xetla-switch-to-output-buffer
- xetla-event-output-buffer)
-
-(xetla-switch-to-buffer-macro xetla-switch-to-error-buffer
- xetla-event-error-buffer)
-
-(xetla-switch-to-buffer-macro xetla-switch-to-related-buffer
- xetla-event-related-buffer)
-
-(defmacro xetla-make-bymouse-function (function)
- "Create a new function by adding mouse interface to FUNCTION.
-The new function is named FUNCTION-by-mouse; and takes one argument,
-a mouse click event.
-Thew new function moves the point to the place where mouse is clicked
-then invoke FUNCTION."
- `(defun ,(intern (concat (symbol-name function) "-by-mouse")) (event)
- ,(concat "`" (symbol-name function) "'" " with mouse interface.")
- (interactive "e")
- (mouse-set-point event)
- (,function)))
-
-(xetla-make-bymouse-function xetla-switch-to-output-buffer)
-(xetla-make-bymouse-function xetla-switch-to-error-buffer)
-(xetla-make-bymouse-function xetla-switch-to-related-buffer)
-
-(defun xetla-log-event (output error command tree event)
- "Log an event in the `xetla-log-buffer' buffer.
-OUTPUT is the buffer containing process standard output.
-ERROR is the buffer containing process error output.
-COMMAND is the command that was executed.
-TREE is the process's working directory.
-EVENT is the event that occurred.
-Returns that event."
- (unless (and xetla-log-cookie
- (buffer-live-p (ewoc-buffer xetla-log-cookie)))
- (with-current-buffer (get-buffer-create xetla-log-buffer)
- (setq xetla-log-cookie
- (ewoc-create 'xetla-log-printer))
- (xetla-log-buffer-mode)))
- (let ((related-buffer (current-buffer)))
- (with-current-buffer (ewoc-buffer xetla-log-cookie)
- (let ((elem (make-xetla-event :output-buffer output
- :error-buffer error
- :related-buffer related-buffer
- :command command
- :tree tree
- :event event
- :time (current-time)))
- buffer-read-only)
- (ewoc-enter-last xetla-log-cookie elem)
- (ewoc-refresh xetla-log-cookie)
- elem))))
-
-(defun xetla-log-next ()
- "Move to the next log entry."
- (interactive)
- (let ((next (ewoc-next xetla-log-cookie
- (ewoc-locate xetla-log-cookie))))
- (when next (goto-char (ewoc-location next)))))
-
-(defun xetla-log-prev ()
- "Move to the previous log entry."
- (interactive)
- (let ((prev (ewoc-prev xetla-log-cookie
- (ewoc-locate xetla-log-cookie))))
- (when prev (goto-char (ewoc-location prev)))))
-
-(define-derived-mode xetla-log-buffer-mode fundamental-mode "XEtla Log"
- "Major mode for Xetla's internal log buffer. You can open this buffer
-with `xetla-open-internal-log-buffer'."
- (toggle-read-only 1))
-
-(define-derived-mode xetla-process-buffer-mode fundamental-mode
- "XEtla Process"
- "Major mode for process buffers. Mainly defines \\[bury-buffer]
-to quit the buffer"
- (toggle-read-only 1))
-
-(defmacro xetla-with-keywords (keywords plist &rest body)
- "Execute a body of code with keywords bound.
-Each keyword listed in KEYWORDS is bound to its value from PLIST, then
-BODY is evaluated."
- (flet ((keyword-to-symbol (keyword)
- (intern (substring (symbol-name keyword) 1))))
- (let ((keyword (make-symbol "keyword"))
- (default (make-symbol "default")))
- `(let ,(mapcar (lambda (keyword-entry)
- (keyword-to-symbol (if (consp keyword-entry)
- (car keyword-entry)
- keyword-entry)))
- keywords)
- (dolist (keyword-entry ',keywords)
- (let ((,keyword (if (consp keyword-entry)
- (car keyword-entry)
- keyword-entry))
- (,default (if (consp keyword-entry)
- (cadr keyword-entry)
- nil)))
- (set (intern (substring (symbol-name ,keyword) 1))
- (or (cadr (member ,keyword ,plist))
- ,default))))
- ,@body))))
-(put 'xetla-with-keywords 'lisp-indent-function 1)
-
-(defun xetla-build-xetla-command (list-args)
- "Build a shell command to run tla with args LIST-ARGS."
- (mapconcat 'shell-quote-argument
- (cons xetla-tla-executable
- (delq nil list-args))
- " "))
-
-
-(defcustom xetla-password-prompt-regexp
- "[Pp]ass\\(word\\|phrase\\).*:\\s *\\'"
- "*Regexp matching prompts for passwords in the inferior process.
-This is used by `eshell-watch-for-password-prompt'."
- :type 'regexp
- :group 'xetla)
-
-(defun xetla-process-filter (proc string)
- "Filter PROC's STRING.
-Prompt for password with `read-passwd' if the output of PROC matches
-`xetla-password-prompt-regexp'."
- (with-current-buffer (process-buffer proc)
- (insert (replace-regexp-in-string "\015" "\n" string))
- (when (string-match xetla-password-prompt-regexp string)
- (string-match "^\\([^\n]+\\)\n*\\'" string)
- (let ((passwd (read-passwd (match-string 1 string))))
- (process-send-string proc (concat passwd "\n"))))))
-
-(defun xetla-run-tla-async (arguments &rest keys)
- "Run tla asynchronously.
-ARGUMENTS is a list of arguments. nil values in this list are removed.
-KEYS is a list of keywords and values. Possible keywords are:
-
- :finished ....... Function run when the process finishes. If none
- specified, `xetla-default-finish-function' is run.
-
- :killed ......... Function run when the process is killed. If none
- specified, `xetla-default-killed-function' is run.
-
- :error .......... Function run when the process exits with a non 0
- status. If none specified,
- `xetla-default-error-function' is run.
-
-All these functions take 4 arguments : output, error, status, and
-arguments.
-
- - \"output\" is the output buffer
- - \"error\" is the buffer where standard error is redirected
- - \"status\" is the numeric exit-status or the signal number
- - \"arguments\" is the list of arguments, as a list of strings,
- like '(\"changes\" \"-diffs\")
-
- `xetla-null-handler' can be used here if there's nothing to do.
-
- :output-buffer .. Buffer where the output of the process should be
- redirected. If none specified, a new one is
- created, and will be entered in
- `xetla-dead-process-buffer-queue' to be killed
- later.
-
- :error-buffer ... Buffer where the standard error of the process
- should be redirected.
-
- :related-buffer . Defaults to `current-buffer'. This is the buffer
- where the result of the process will be used. If
- this buffer is killed before the end of the
- execution, the user is prompted if he wants to kill
- the process.
-
-Example:
- (xetla-run-tla-async `(\"changes\" ,(unless arg \"-diffs\"))
- :finished
- (lambda (output error status arguments)
- (message \"No changes in this working copy\"))
- :error
- (lambda (output error status arguments)
- (xetla-show-changes-buffer output)))"
- (xetla-with-keywords
- (:finished :killed :error :output-buffer :error-buffer :related-buffer)
- keys
- (let* ((output-buf (or (and output-buffer (get-buffer-create output-buffer))
- (xetla-new-process-buffer nil)))
- (error-buf (or (and error-buffer (get-buffer-create error-buffer))
- (xetla-new-error-buffer nil)))
- (error-file (xetla-make-temp-name "arch-errors"))
- (command (xetla-build-xetla-command arguments))
- ;; Make the `default-directory' unique. The trailing slash
- ;; may be necessary in some cases.
- (default-directory (xetla-uniquify-file-name default-directory))
- (process (start-process
- xetla-tla-executable output-buf
- "sh" "-c"
- (format "%s 2> %s"
- command error-file)))
- (process-event
- (list process
- (xetla-log-event output-buf
- error-buf
- command
- default-directory "started"))))
- (with-current-buffer (or related-buffer (current-buffer))
- (message "running process `%s' in `%s'" command default-directory)
- (add-to-list 'xetla-process-running process-event)
- (set-process-filter process 'xetla-process-filter)
- (set-process-sentinel
- process
- `(lambda (process event)
- (let ((default-directory ,default-directory))
- (xetla-log-event ,output-buf ,error-buf ,command
- ,default-directory
- (xetla-strip-final-newline event))
- (setq xetla-process-running
- (delq ',process-event xetla-process-running))
- (when (file-exists-p ,error-file)
- (with-current-buffer ,error-buf
- (insert-file-contents ,error-file))
- (delete-file ,error-file))
- (let ((state (process-status process))
- (status (process-exit-status process)))
- (unwind-protect
- (cond ((and (eq state 'exit) (= status 0))
- (funcall (or (quote ,finished)
- 'xetla-default-finish-function)
- ,output-buf ,error-buf
- status (quote ,arguments)))
- ((eq state 'signal)
- (funcall (or (quote ,killed)
- 'xetla-default-killed-function)
- ,output-buf ,error-buf status
- (quote ,arguments)))
- ((eq state 'exit) ;; status != 0
- (funcall (or (quote ,error)
- 'xetla-default-error-function)
- ,output-buf ,error-buf status
- (quote ,arguments)))))
- ;; Schedule any buffers we created for killing
- (unless ,output-buffer (xetla-kill-process-buffer ,output-buf))
- (unless ,error-buffer (xetla-kill-process-buffer ,error-buf))))))
- process))))
-
-(defun xetla-run-tla-sync (arguments &rest keys)
- "Run tla synchronously.
-See `xetla-run-tla-async' for details on possible ARGUMENTS and KEYS."
- (xetla-with-keywords
- (:finished :killed :error :output-buffer :error-buffer :related-buffer)
- keys
- (let ((output-buf (or (and output-buffer (get-buffer-create output-buffer))
- (xetla-new-process-buffer t)))
- (error-buf (or (and error-buffer (get-buffer-create error-buffer))
- (xetla-new-error-buffer t)))
- (command (xetla-build-xetla-command arguments))
- (error-file (xetla-make-temp-name "arch-errors"))
- ;; Make the `default-directory' unique. The trailing slash
- ;; may be necessary in some cases.
- (default-directory (xetla-uniquify-file-name default-directory)))
- (with-current-buffer (or related-buffer (current-buffer))
- (xetla-log-event output-buf error-buf command default-directory "started")
- (let ((status (call-process "sh" nil output-buf nil "-c"
- (format "%s 2> %s"
- command
- error-file))))
- (when (file-exists-p error-file)
- (with-current-buffer error-buf
- (insert-file-contents error-file))
- (delete-file error-file))
- (unwind-protect
- (cond ((stringp status)
- (when (string= status "Terminated")
- (funcall (or killed 'xetla-default-killed-function)
- output-buf error-buf status arguments)))
- ((numberp status)
- (if (zerop status)
- (funcall (or finished 'xetla-default-finish-function)
- output-buf error-buf status arguments)
- (funcall (or error 'xetla-default-error-function)
- output-buf error-buf status arguments)))
- (t (message "Unknown status - %s" status)))
- ;; Schedule any buffers we created for killing
- (unless output-buffer (xetla-kill-process-buffer output-buf))
- (unless error-buffer (xetla-kill-process-buffer error-buf))))))))
-
-(defun xetla-kill-process-maybe (buffer)
- "Prompts and possibly kill process whose related buffer is BUFFER."
- (let ((process-list nil))
- (dolist (process-buffer xetla-process-running)
- (when (eq (xetla-event-related-buffer (cadr process-buffer))
- buffer)
- (add-to-list 'process-list (car process-buffer))))
- (let ((l (length process-list)))
- (when (and process-list
- (y-or-n-p (format "%s process%s running in buffer %s. Kill %s? "
- l (if (> l 1) "es" "")
- (buffer-name buffer)
- (if (> l 1) "Them" "it"))))
- (dolist (process process-list)
- (setq xetla-default-killed-function-noerror
- (1+ xetla-default-killed-function-noerror))
- (if (eq (process-status process) 'run)
- (kill-process process)))))))
-
-;;;###autoload
-(add-to-list 'minor-mode-alist
- '(xetla-process-running
- (:eval (if (equal (length xetla-process-running) 1)
- " tla running"
- (concat " tla running("
- (int-to-string (length xetla-process-running))
- ")")))))
-
-(eval-when-compile
- (autoload 'xetla-flash-line "xetla"))
-
-(defun xetla-open-internal-log-buffer ()
- "Switch to the XEtla's internal log buffer.
-This buffer contains a list of all the tla commands previously executed.
-The buffer uses the mode `xetla-log-buffer-mode'"
- (interactive)
- (let ((buffer-name (buffer-name)))
- (xetla-switch-to-buffer xetla-log-buffer)
- (goto-char (point-max))
- (when (re-search-backward (concat " Buffer: "
- (regexp-quote buffer-name)
- "$")
- nil t)
- (xetla-flash-line))))
-
-(defun xetla-clear-log-buffer ()
- "Kill the log buffer."
- (when (bufferp (get-buffer xetla-log-buffer))
- (kill-buffer xetla-log-buffer)))
-
-(defun xetla-buffer-content (buffer)
- "Return the content of BUFFER as a string.
-Strips the final newline if there is one."
- (with-current-buffer buffer
- (buffer-substring-no-properties
- (point-min)
- (progn (goto-char (point-max))
- (if (eq (char-before) ?\n)
- (- (point) 1)
- (point))))))
-
-(defun xetla-get-process-output ()
- "Return the content of the last process buffer.
-Strips the final newline if there is one."
- (xetla-buffer-content xetla-last-process-buffer))
-
-(defun xetla-get-error-output ()
- "Return the content of the last error buffer.
-Strips the final newline if there is one."
- (xetla-buffer-content xetla-last-error-buffer))
-
-(defvar xetla-switched-buffer nil)
-(defvar xetla-switched-from-buffer nil)
-
-(defun xetla-switch-to-buffer (buffer)
- "Switch to BUFFER using the user's preferred method.
-See `xetla-switch-to-buffer-mode' for possible settings."
- (setq xetla-switched-from-buffer (current-buffer))
- (cond ((eq xetla-switch-to-buffer-mode 'pop-to-buffer)
- (pop-to-buffer buffer))
- ((eq xetla-switch-to-buffer-mode 'single-window)
- (switch-to-buffer buffer))
- ((eq xetla-switch-to-buffer-mode 'show-in-other-window)
- (pop-to-buffer buffer)
- (setq xetla-switched-buffer (current-buffer))
- (pop-to-buffer xetla-switched-from-buffer))
- ;; TODO : dedicated frame.
- (t
- (error "Switch mode %s not implemented" xetla-switch-to-buffer-mode))))
-
-(defun xetla-post-switch-to-buffer ()
- "Executed when showing a changeset.
-
-If `xetla-switched-buffer' is non-nil, show this buffer, but keep
-cursor position in previous buffer."
- (when xetla-switched-buffer
- (pop-to-buffer xetla-switched-buffer)
- (setq xetla-switched-buffer nil)
- (goto-char (point-min))
- (pop-to-buffer xetla-switched-from-buffer)))
-
-
-(defun xetla-show-process-buffer ()
- "Show the process buffer of the last started xetla command."
- (interactive)
- (xetla-switch-to-buffer xetla-last-process-buffer)
- (unless (member xetla-last-process-buffer
- (mapcar (lambda (p)
- (process-buffer (car p)))
- xetla-process-running))
- (xetla-process-buffer-mode)))
-
-(defun xetla-show-last-process-buffer (&optional type mode path)
- "Switch to the last used process buffer in a new buffer of TYPE.
-If MODE is specified, it is a function that will be run in the
-new buffer. Otherwise, the buffer will remain in fundamental mode, in
-read-only.
-
-If PATH is specified, it will be passed to `xetla-get-buffer-create'."
- (when (buffer-live-p xetla-last-process-buffer)
- (let ((content (with-current-buffer xetla-last-process-buffer
- (buffer-string))))
- (xetla-switch-to-buffer (xetla-get-buffer-create
- (or type 'generic) path))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert content)))
- (if mode
- (funcall mode)
- (xetla-process-buffer-mode))))
-
-(defun xetla-show-error-buffer (buffer &optional type mode)
- "Pops up the error buffer.
-Works like `xetla-show-last-process-buffer', but displays BUFFER, of type
-'errors if TYPE is not specified.
-If MODE is specified, the buffer will use that mode."
- (when (buffer-live-p buffer)
- (let ((content (with-current-buffer buffer
- (buffer-string))))
- (xetla-switch-to-buffer (xetla-get-buffer-create
- (or type 'errors)))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert content)))
- (if mode
- (funcall mode)
- (xetla-process-buffer-mode))))
-
-;; --------------------------------------
-;; Arch name manipulators
-;; ======================
-;;
-;; Normally in XEtla, a name, a revision specifier is represented as a
-;; list like:
-;;
-;; ("archive" "category" "branch" "version" "revision")
-;;
-;; Nil is permitted as the element. However the list length must be 5
-;; like:
-;;
-;; (nil "category" "branch" nil nil)
-;;
-;; In other hand, in tla command, the name must be represented as a
-;; string like:
-;;
-;; "archive/category-branch-version-revision"
-;;
-;; So we have to convert a name in different representation in many
-;; cases.
-;;
-;; * xetla-name-split-* is for converting from a string representation
-;; to a list representation. There are semi-qualified version and
-;; fully-qualified version.
-;;
-;; - semi-qualified: "category-branch-version-revision".
-;; `xetla-name-split-semi-qualified' expects a name string without
-;; archive component. The archive field of returned list is filled
-;; with nil.
-;;
-;; - fully-qualified: "archive/category-branch-version-revision".
-;; `xetla-name-split' expects a name string including archive.
-;;
-;; * xetla-name-construct-* is for converting from a list
-;; representation to a string representation. The functions accept
-;; arguments two ways.
-;;
-;; - normal passing: (xetla-name-construct "archive" "category"...)
-;; - packed passing: (xetla-name-construct '("archive" "category"...))
-;;
-;; There are semi-qualified version and fully-qualified version.
-;; - semi-qualified: `xetla-name-construct-semi-qualified' connects
-;; arguments with "-".
-;; - fully-qualified: `xetla-name-construct" connects the first argument
-;; and the rest with "/". About the rest,
-;; `xetla-name-construct-semi-qualified' is applied.
-;;
-;; * xetla-name-{archive|category|branch|version|revision} is for
-;; extracting a component from a name. The both representations are
-;; acceptable.
-;;
-;; * xetla-name-mask is for replace a component in the name list with nil.
-;;
-;; --------------------------------------
-
-;;
-;; String representation -> List representation
-;;
-(defun xetla-name-split-semi-qualified (name &optional archive)
- "Split \"--\" connected string NAME into 5 elements list.
-The first element is always nil if ARCHIVE is not given.
-If ARCHIVE is given, use it as the first.
-Even if the elements in name are less than 5, the list is filled by nil
-to make the length 5.
-
- ELISP> (xetla-name-split-semi-qualified \"branch--category--version--revision\"
- \"archive\")
- (\"archive\" \"branch\" \"category\" \"version\" \"revision\")
-
- ELISP> (xetla-name-split-semi-qualified
- \"branch--category--version--revision\")
- (nil \"branch\" \"category\" \"version\" \"revision\")
-
- ELISP> (xetla-name-split-semi-qualified \"branch--category--version\")
- (nil \"branch\" \"category\" \"version\" nil)
-
- ELISP> (xetla-name-split-semi-qualified
- \"branch--category--version\" \"archive\")
- (\"archive\" \"branch\" \"category\" \"version\" nil)
-
- ELISP> (xetla-name-split-semi-qualified \"branch--category\" \"archive\")
- (\"archive\" \"branch\" \"category\" nil nil)
-
- ELISP> (xetla-name-split-semi-qualified \"branch--category\"nil)
- (nil \"branch\" \"category\" nil nil)
-
- ELISP> (xetla-name-split-semi-qualified \"branch--category--\" nil)
- (nil \"branch\" \"category\" \"\" nil)"
- (let ((list (xetla-name-split-semi-qualified-internal name)))
- (while (> 4 (length list))
- (setq list (cons nil list)))
- (let ((result (cons archive (nreverse list))))
- (when (xetla-is-version-string (caddr result))
- (setq result (list (car result)
- (cadr result)
- ""
- (caddr result)
- (cadddr result))))
- result)))
-
-(defun xetla-is-version-string (string)
- "Non-nil if STRING is a candidate for a version name.
-That is, if it contains only digits and dots.
-The regexp here is less strict than the one of xetla, but must verify
-\(xetla-is-version-string string) => string can't be a branch name."
- (and string (string-match "^[0-9\.]+$" string)))
-
-(defun xetla-name-split-semi-qualified-internal (name)
- "Helper function for `xetla-name-split-semi-qualified'.
-Splits a semi-qualified NAME."
- (if (string-match "^\\(.+\\)--\\(\\([^-]\\|-[^-]\\)*\\)" name)
- (cons (match-string 2 name)
- (xetla-name-split-semi-qualified-internal
- (match-string 1 name)))
- (cons name nil)))
-
-(defun xetla-name-split (name)
- "Parse a fully qualified revision NAME, but possibly incomplete.
-email@address.com--arch/cat--branch--ver ->
- (\"email@address.com--arch\" \"cat\" \"branch\" \"ver\" nil)
-email@address.com--arch/cat ->
- (\"email@address.com--arch\" \"cat\" nil nil nil)
-email@address.com--arch ->
- (\"email@address.com-arch\" nil nil nil nil)"
- (if (string-match "\\(.*\\)/\\(.*\\)" name)
- (xetla-name-split-semi-qualified (match-string 2 name) (match-string 1 name))
- (if (string= name "")
- (list nil nil nil nil nil)
- (list name nil nil nil nil))))
-
-
-;;
-;; List representation -> string
-;;
-(defun xetla-name-construct-semi-qualified (&rest comp)
- "Concatenate COMP with \"-\".
-This function can accept strings or a list which contains strings.
-
- ELISP> (xetla-name-construct-semi-qualified \"a\" \"b\" \"c\")
- \"a--b--c\"
- ELISP> (xetla-name-construct-semi-qualified (list \"a\" \"b\" \"c\"))
- \"a--b--c\""
- (if (consp (car comp)) (setq comp (car comp)))
- (if (string= (cadr comp) "")
- ;; Unnamed branch.
- (concat (car comp) "--"
- (mapconcat 'identity (remove nil (cddr comp)) "--"))
- (mapconcat 'identity (remove nil comp) "--")))
-
-(defun xetla-name-construct (archive &optional
- category
- branch
- version
- revision)
- "Create the revision name ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION.
-The arguments may be nil. If ARCHIVE is a revision name list like
- (archive category branch version revision), the list element is mapped
-to arguments before creating the fully qualified revision name.
-
-If the branch name is the empty string and the version is defined,
-then, we have an unnamed branch. The full name is
-archive/category-version."
- (when (consp archive)
- (setq category (xetla-name-category archive)
- branch (xetla-name-branch archive)
- version (xetla-name-version archive)
- revision (xetla-name-revision archive)
- ;; archive must be last
- archive (xetla-name-archive archive)))
- (let ((semi (xetla-name-construct-semi-qualified
- category branch version revision)))
- (concat
- (and archive (not (string= archive ""))
- (concat archive (when category "/")))
- semi)))
-
-;;
-;; Get a component from a list or string.
-;;
-(defun xetla-name-archive (target)
- "Get archive component from TARGET.
-Both representation of TARGET, a string and a list is acceptable."
- (when (stringp target)
- (setq target (xetla-name-split target)))
- (car target))
-
-(defun xetla-name-category (target)
- "Get category component from TARGET.
-Both representation of TARGET, a string and a list is acceptable."
- (when (stringp target)
- (setq target (xetla-name-split target)))
- (cadr target))
-
-(defun xetla-name-branch (target)
- "Get branch component from a TARGET.
-Both representation of TARGET, a string and a list is acceptable."
- (when (stringp target)
- (setq target (xetla-name-split target)))
- (caddr target))
-
-(defun xetla-name-version (target)
- "Get version component from TARGET.
-Both representation of TARGET, a string and a list is acceptable."
- (when (stringp target)
- (setq target (xetla-name-split target)))
- (cadddr target))
-
-(defun xetla-name-revision (target)
- "Get revision component from TARGET.
-Both representation of TARGET, a string and a list is acceptable."
- (when (stringp target)
- (setq target (xetla-name-split target)))
- (cadddr (cdr target)))
-
-;;
-;; Utilities
-;; Mask a specified component in the name.
-;;
-(defun xetla-name-mask (original do-construct-p
- &optional
- archive-mask
- category-mask
- branch-mask
- version-mask
- revision-mask)
- "Mask ORIGINAL, a xetla revision name by masks; and return the masked value.
-
-If DO-CONSTRUCT-P is given, the result is converted to a string by
-`xetla-name-construct'.
-
-ARCHIVE-MASK, CATEGORY-MASK, BRANCH-MASK, VERSION-MASK and REVISION-MASK should
-be either nil or t, and indicate whether that field should be masked.
-
-If a mask value is nil, the associated element in ORIGINAL is set to nil.
-Else If a mask value is a string, the associated element in ORIGINAL is set
-to the string.
-Else the associated element in ORIGINAL is not changed.
-
-Examples:
- ELISP> (xetla-name-mask '(\"a\" \"c\" \"b\" \"v\" \"r\") nil t t t t nil)
- (\"a\" \"c\" \"b\" \"v\" nil)
-
- ELISP> (xetla-name-mask '(\"a\" \"c\" \"b\" \"v\" \"r\") nil t t t nil nil)
- (\"a\" \"c\" \"b\" nil nil)
-
- ELISP> (xetla-name-mask '(\"a\" \"c\" \"b\" \"v\" \"r\") t t t t nil nil)
- \"a/c-b\"
- ELISP> (xetla-name-mask '(\"a\" \"c\" \"b\" \"v\" \"r\") t nil nil nil nil t)
- \"r\"
- ELISP> (xetla-name-mask '(\"a\" \"c\" \"b\" \"v\" \"r\") t nil nil nil t t)
- \"v-r\"
- ELISP>"
- (when (consp original)
- (let ((masked (list
- (if archive-mask
- (if (stringp archive-mask)
- archive-mask
- (xetla-name-archive original)))
- (if category-mask
- (if (stringp category-mask)
- category-mask
- (xetla-name-category original)))
- (if branch-mask
- (if (stringp branch-mask)
- branch-mask
- (xetla-name-branch original)))
- (if version-mask
- (if (stringp version-mask)
- version-mask
- (xetla-name-version original)))
- (if revision-mask
- (if (stringp revision-mask)
- revision-mask
- (xetla-name-revision original))))))
- (if do-construct-p
- (xetla-name-construct masked)
- masked))))
-
-(defun xetla-name-match (target mask)
-"Compare the fully qualified revision list TARGET with a MASK.
-Each parameter is a list. The elements of the both lists are compared
-via a regexp match. When the mask part of a component is nil, this
-comparision is skipped.
-Here are some examples:
-\(xetla-name-match
- '(\"xsteve@nit.at-public\" \"xetla\" \"main\" \"0.1\" \"patch-116\")
- '(nil \"xt.*\" \"main\" nil nil)) => t
-\(xetla-name-match
- '(\"xsteve@nit.at-public\" \"xetla\" \"main\" \"0.1\" \"patch-116\")
- '(nil \"xt.*\" \"devel\" nil nil)) => nil" ;"
- (let ((tl target)
- (ml mask)
- (t-part)
- (m-part)
- (matching t))
- (while tl
- (setq t-part (car tl))
- (setq m-part (car ml))
- (when m-part
- (setq matching (string-match m-part t-part)))
- (if matching
- (progn
- (setq tl (cdr tl))
- (setq ml (cdr ml)))
- (setq tl nil)))
- (if matching t nil)))
-
-
-(defun xetla-name-match-from-list (target match-list)
- "Match TARGET against a list of possible matches.
-Every entry of MATCH-LIST is a list that contains a
-match element and a possible result.
-The target is matched against the elements in the match-list.
-If a match is found return the corresponding result,
-otherwise return nil."
- (let ((ml match-list)
- (match)
- (data)
- (result))
- (while (and (not result) ml)
- (setq match (caar ml))
- (setq data (cadar ml))
- (message "match: %s, data: %s" match data)
- (setq result (when (xetla-name-match target match) data))
- (setq ml (cdr ml)))
- result))
-
-;; TODO: Use xetla-archive-tree.
-(defun xetla-version-head (archive category branch version)
- "Return the newest revision for ARCHIVE/CATEGORY-BRANCH-VERSION."
- (xetla-run-tla-sync (list "revisions"
- (xetla-name-construct
- archive
- category
- branch
- version))
- :finished (lambda (output error status arguments)
- (with-current-buffer output
- (goto-char (point-max))
- (re-search-backward "^.")
- (buffer-substring-no-properties
- (point) (point-at-eol))))))
-
-;; --------------------------------------
-;; Archive tree manipulators
-;; --------------------------------------
-
-(defvar xetla-archive-tree nil
- "Arch archive/category/branch/version/revision are stored in assoc list:
-
- ((\"xsteve@nit.at-public\" \"http://arch.xsteve.at/2004\")
- [...]
- (\"mbp@sourcefrog.net-2004\"
- \"http://sourcefrog.net/arch/mbp@sourcefrog.net-2004\"
- (\"xetla\")
- (\"tilly\")
- [...]
- (\"dupes\"
- (\"mainline\"
- (\"0.1\")))
- [...]
- (\"archzoom\"))
- (\"mark@dishevelled.net-2003-mst\"
- \"http://members.iinet.net.au/~mtriggs/arch/\")
- (\"lord@emf.net-2004\"
- \"http://regexps.srparish.net/{archives}/lord@emf.net-2004\")
- [...]
- (\"Matthieu.Moy@imag.fr-public\"
- \"http://www-verimag.imag.fr/webdav/moy/public\"
- (\"xetla\"
- (\"main\"
- (\"0.1\"
- (\"patch-228\"
- \"Merged from Robert (patch8-9), Milan (patch21-22), Stefan (patch5-8)\"
- \"Matthieu Moy <Matthieu.Moy@imag.fr>\"
- \"2004-06-03 20:13:11 GMT\")
- (\"patch-227\"
- \"Fix default-directory in xetla-run-tla-sync, fix in xetla-changes-ediff\"
- \"Matthieu Moy <Matthieu.Moy@imag.fr>\"
- \"2004-06-03 15:26:15 GMT\")
- [...]
- (\"patch-1\"
- \"typo\"
- \"Matthieu Moy <Matthieu.Moy@imag.fr>\"
- \"2004-04-07 22:57:00 GMT\")
- (\"base-0\"
- \"tag of xsteve@nit.at-public/xetla-main-0.1-patch-5\"
- \"Matthieu Moy <Matthieu.Moy@imag.fr>\" \"2004-04-07 22:52:39 GMT\")))))
- [...]
- )
-
-This list is initially empty, and is built/rebuilt on demand.")
-
-;; Utilities
-(defun xetla-archive-tree-setcdr (parent value &optional rest)
- "In PARENT, update VALUE.
-REST are the items that are already present."
- (let* ((current (cdr parent))
- (list-details (assoc value current)))
- (if (or (null current) (null list-details))
- ;; rest is '("summary" "creator" "date") when value is "patch-N"
- (setcdr parent (cons (cons value rest) current))
- (if (and list-details rest)
- ;; Field already there. update details.
- (setcdr list-details rest)))))
-
-(defun xetla-archive-tree-setcddr (parent value)
- "In PARENT, update VALUE."
- (let ((current (cddr parent)))
- (if (or (null current) (null (assoc value current)))
- (setcdr (cdr parent) (cons (cons value nil) current)))))
-
-;; Archive
-(defun xetla-archive-tree-add-archive (archive location &optional old)
- "Add ARCHIVE at LOCATION to the archive tree.
-If OLD is provided, it is an old archive tree from which some
-information can be found (this is useful to keep the category/branch/version
-info for existing archives)."
- (if (xetla-archive-tree-get-archive archive)
- (let* ((a (xetla-archive-tree-get-archive archive))
- (val (cdr a))
- (oldlocation (car val))
- (category (cdr val)))
- (setcdr a (cons (or location oldlocation) category)))
- (let ((oldinfo (xetla-archive-tree-get-archive archive old))
- (newinfo (list archive location)))
- (when oldinfo
- (setcdr (cdr newinfo) (cddr oldinfo))) ;; list of versions.
- (setq xetla-archive-tree (cons newinfo
- xetla-archive-tree)))))
-
-(defun xetla-archive-tree-get-archive (archive &optional archive-tree)
- "Get the value of ARCHIVE from ARCHIVE-TREE.
-If ARCHIVE-TREE is not given, `xetla-archive-tree' is used."
- (assoc archive (or archive-tree xetla-archive-tree)))
-
-;; Category
-(defun xetla-archive-tree-add-category (archive category)
- "Add a new category to ARCHIVE named CATEGORY."
- (xetla-archive-tree-add-archive archive nil)
- (xetla-archive-tree-setcddr
- (xetla-archive-tree-get-archive archive)
- category))
-
-(defun xetla-archive-tree-get-category (archive category)
- "From ARCHIVE, get CATEGORY."
- (assoc category (cdr (cdr (xetla-archive-tree-get-archive archive)))))
-
-;; Branch
-(defun xetla-archive-tree-add-branch (archive category branch)
- "Add a new branch to ARCHIVE's CATEGORY named BRANCH."
- (xetla-archive-tree-add-category archive category)
- (xetla-archive-tree-setcdr
- (xetla-archive-tree-get-category archive category)
- branch))
-
-(defun xetla-archive-tree-get-branch (archive category branch)
- "Get a branch from ARCHIVE's CATEGORY named BRANCH."
- (assoc branch (cdr (xetla-archive-tree-get-category
- archive category))))
-
-;; Version
-(defun xetla-archive-tree-add-version (archive category branch version)
- "Add a new version to ARCHIVE CATEGORY BRANCH named VERSION."
- (xetla-archive-tree-add-branch archive category branch)
- (xetla-archive-tree-setcdr
- (xetla-archive-tree-get-branch archive category branch )
- version))
-
-(defun xetla-archive-tree-get-version (archive category branch version)
- "Get a version from ARCHIVE CATEGORY BRANCH named VERSION."
- (assoc version (cdr (xetla-archive-tree-get-branch
- archive category branch))))
-
-;; Revision
-(defun xetla-archive-tree-add-revision (archive category branch version revision
- &optional summary creator date)
- "Add a new revision to ARCHIVE CATEGORY BRANCH VERSION named REVISION."
- (xetla-archive-tree-add-version archive category branch version)
- (xetla-archive-tree-setcdr
- (xetla-archive-tree-get-version archive category branch version)
- revision (list summary creator date)))
-
-(defun xetla-archive-tree-get-revision (archive category branch version revision)
- "Get a revision from ARCHIVE CATEGORY BRANCH VERSION named REVISION."
- (assoc revision (cdr (xetla-archive-tree-get-version
- archive category branch version))))
-
-;; Archive tree builders
-(defun xetla-archive-tree-build (basename &optional use-cache ignore-error)
- "Generic version of xetla-archive-tree-build-*.
-BASENAME is used as a base for this tree.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (stringp basename)
- (setq basename (xetla-name-split basename)))
- (let ((archive (xetla-name-archive basename))
- (category (xetla-name-category basename))
- (branch (xetla-name-branch basename))
- (version (xetla-name-version basename)))
- (cond
- (version
- (xetla-archive-tree-build-revisions archive
- category
- branch
- version
- use-cache
- ignore-error))
- (branch
- (xetla-archive-tree-build-versions archive
- category
- branch
- use-cache
- ignore-error))
- (category
- (xetla-archive-tree-build-branches archive
- category
- use-cache
- ignore-error))
- (archive
- (xetla-archive-tree-build-categories archive
- use-cache
- ignore-error))
- (t
- (xetla-archive-tree-build-archives use-cache
- ignore-error)))))
-
-(defun xetla-archive-tree-build-archives (&optional use-cache ignore-error)
- "Builds the list of archives.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (or (not use-cache)
- (not xetla-archive-tree))
- (xetla-run-tla-sync '("archives")
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (let ((old-archive-tree xetla-archive-tree))
- (setq xetla-archive-tree nil)
- (save-excursion
- (let ((archive-name)
- (archive-location))
- (set-buffer xetla-last-process-buffer)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq archive-name (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (beginning-of-line-text 2)
- (setq archive-location (buffer-substring-no-properties
- (point) (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-archive archive-name
- archive-location
- old-archive-tree)))))))
-
-(defun xetla-archive-tree-build-categories (archive &optional
- use-cache
- ignore-error)
- "Build the list of categories for ARCHIVE in `xetla-archive-tree'.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (or (not use-cache)
- (not (cddr (xetla-archive-tree-get-archive archive))))
- (let ((basename archive))
- (message "building categories for `%s'..." basename)
- (xetla-run-tla-sync (list "categories" "-A" basename)
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (message "building categories for `%s'...done" basename)
- (sit-for 0)
- (message nil))
- (with-current-buffer xetla-last-process-buffer
- (let (category)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq category (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-category archive category)
- )))))
-
-(defun xetla-archive-tree-build-branches (archive category
- &optional
- use-cache
- ignore-error)
- "Build the list of branches for ARCHIVE/CATEGORY in `xetla-archive-tree'.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (or (not use-cache)
- (not (cdr (xetla-archive-tree-get-category archive category))))
- (let ((basename (xetla-name-construct archive category)))
- (message "building branches for `%s'..." basename)
- (xetla-run-tla-sync (list "branches" basename)
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (message "building branches for `%s'...done" basename)
- (sit-for 0)
- (message nil))
- (with-current-buffer xetla-last-process-buffer
- (let (branch)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq branch (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (xetla-archive-tree-add-branch
- archive
- category
- (if (looking-at ".*-")
- (xetla-name-branch (xetla-name-split-semi-qualified
- branch))
- ;; unnamed branch
- ""))
- (forward-line 1))))))
-
-(defun xetla-archive-tree-build-versions (archive category branch
- &optional
- use-cache
- ignore-error)
- "Build the version list in ARCHIVE/CATEGORY-BRANCH in `xetla-archive-tree'.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (or (not use-cache)
- (not (cdr (xetla-archive-tree-get-branch archive category
- branch))))
- (let ((basename (xetla-name-construct archive category branch)))
- (message "building versions for `%s'..." basename)
- (xetla-run-tla-sync (list "versions" basename)
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (message "building versions for `%s'...done" basename)
- (sit-for 0)
- (message nil))
- (with-current-buffer xetla-last-process-buffer
- (let (version)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq version (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-version
- archive
- category
- branch
- (xetla-name-version (xetla-name-split-semi-qualified version))))))))
-
-(defun xetla-archive-tree-build-revisions (archive category branch version
- &optional
- use-cache
- ignore-error)
-
- "Build the revision list in ARCHIVE/CATEGORY-BRANCH-VERSION.
-Updates `xetla-archive-tree'.
-If USE-CACHE is non-nil, load details from the cache where possible.
-If IGNORE-ERROR is non-nil, don't throw errors."
- (when (or (not use-cache)
- (not (cdr (xetla-archive-tree-get-version archive category branch
- version))))
- (let ((details (or xetla-revisions-shows-summary
- xetla-revisions-shows-date
- xetla-revisions-shows-creator))
- (basename (xetla-name-construct
- archive category branch version)))
- (message "building revisions for `%s'..." basename)
- (if details
- (progn
- (xetla-run-tla-sync (list "revisions"
- "--summary" "--date" "--creator"
- basename)
- :finished 'xetla-null-handler
- :error (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function)))
- (progn
- (xetla-run-tla-sync (list "revisions" basename)
- :finished 'xetla-null-handler
- :error (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))))
- (message "building revisions for `%s'...done" basename)
- (sit-for 0)
- (message nil)
- (with-current-buffer xetla-last-process-buffer
- (let (revision date creator summary)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq revision (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (when details
- (skip-chars-forward " ")
- (setq date (buffer-substring-no-properties (point)
- (point-at-eol)))
- (forward-line 1)
- (skip-chars-forward " ")
- (setq creator (buffer-substring-no-properties (point)
- (point-at-eol)))
- (forward-line 1)
- (skip-chars-forward " ")
- (setq summary (buffer-substring-no-properties
- (point)
- (progn (re-search-forward "^\\([^ \t]\\|$\\)")
- (previous-line 1)
- (end-of-line)
- (point))))
- (forward-line 1))
- (xetla-archive-tree-add-revision
- archive
- category
- branch
- version
- revision
- summary
- creator
- date)))))))
-
-
-(defun xetla-revisions-tree-contains-details
- (archive category branch version)
- "Whether VERSION has already been listed full details.
-Details include summary lines, dates, and creator in the archive tree."
- (let ((vtree (xetla-archive-tree-get-version archive category branch
- version)))
- (and (cdr vtree) ;; revision list is here
- (cadr (cadr vtree))))) ;; summary line also
-
-;; --------------------------------------
-;; Revlib tree manipulators
-;; --------------------------------------
-(defvar xetla-revlib-tree nil)
-(defun xetla-revlib-tree-get-archive (archive &optional archive-tree)
- "Get ARCHIVE from ARCHIVE-TREE.
-If ARCHIVE-TREE is not given, `xetla-revlib-tree' is used instead."
- (assoc archive (or archive-tree xetla-revlib-tree)))
-
-(defun xetla-revlib-tree-build-archives (&optional use-cache ignore-error)
- "Build the list of archives in `xetla-revlib-tree'.
-If USE-CACHE is non-nil, load from the cache where possible.
-If IGNORE-ERROR is non-nil, error is not reported.
-Return non-nil if the tree entry for archives are updated."
- (when (or (not use-cache)
- (not xetla-revlib-tree))
- (xetla-run-tla-sync '("library-archives")
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (let ((old-revlib-tree xetla-revlib-tree) )
- (setq xetla-revlib-tree nil)
- (save-excursion
- (let ((archive-name)
- (tmp xetla-archive-tree)
- (xetla-archive-tree xetla-revlib-tree)
- result)
- (set-buffer xetla-last-process-buffer)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq result t)
- (setq archive-name (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-archive archive-name
- nil
- old-revlib-tree))
- (setq xetla-revlib-tree xetla-archive-tree
- xetla-archive-tree tmp)
- result)))))
-
-(defun xetla-revlib-tree-get-category (archive category)
- "Get a category from ARCHIVE named CATEGORY."
- (assoc category (cdr (cdr (xetla-revlib-tree-get-archive archive)))))
-
-(defun xetla-revlib-tree-build-categories (archive &optional
- use-cache
- ignore-error)
- "Builds the list of categories for an ARCHIVE in `xetla-revlib-tree'.
-If USE-CACHE is non-nil, load from the cache where possible.
-If IGNORE-ERROR is non-nil, error is not reported.
-Return non-nil if the tree entry for categories are updated."
- (when (or (not use-cache)
- (not (cddr (xetla-revlib-tree-get-archive archive))))
- (xetla-run-tla-sync (list "library-categories" "-A" archive)
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (with-current-buffer xetla-last-process-buffer
- (let (category
- (tmp xetla-archive-tree)
- (xetla-archive-tree xetla-revlib-tree)
- result)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq result t)
- (setq category (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-category archive category))
- (setq xetla-revlib-tree xetla-archive-tree
- xetla-archive-tree tmp)
- result))))
-
-(defun xetla-revlib-tree-get-branch (archive category branch)
- "From ARCHIVE/CATEGORY, get BRANCH."
- (assoc branch (cdr (xetla-revlib-tree-get-category
- archive category))))
-
-(defun xetla-revlib-tree-build-branches (archive category
- &optional
- use-cache
- ignore-error)
- "Build the list of branches for ARCHIVE/CATEGORY in `xetla-revlib-tree'.
-If USE-CACHE is non-nil, load from the cache where possible.
-If IGNORE-ERROR is non-nil, error is not reported.
-Return non-nil if the tree entry for branches are updated."
- (when (or (not use-cache)
- (not (cdr (xetla-revlib-tree-get-category archive category))))
- (xetla-run-tla-sync (list "library-branches" "-A" archive category)
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (with-current-buffer xetla-last-process-buffer
- (let (branch
- (tmp xetla-archive-tree)
- (xetla-archive-tree xetla-revlib-tree)
- result)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq result t)
- (setq branch (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-branch
- archive
- category
- (xetla-name-branch (xetla-name-split-semi-qualified branch))))
- (setq xetla-revlib-tree xetla-archive-tree
- xetla-archive-tree tmp)
- result))))
-
-(defun xetla-revlib-tree-get-version (archive category branch version)
- "Get ARCHIVE/CATEGORY-BRANCH-VERSION from the revlib tree."
- (assoc version (cdr (xetla-revlib-tree-get-branch
- archive category branch))))
-
-(defun xetla-revlib-tree-build-versions (archive category branch
- &optional
- use-cache
- ignore-error)
- "Build the versions list in ARCHIVE/CATEGORY/BRANCH in `xetla-archive-tree'.
-If USE-CACHE is non-nil, load from the cache where possible.
-If IGNORE-ERROR is non-nil, error is not reported.
-Return non-nil if the tree entry for versions are updated."
- (when (or (not use-cache)
- (not (cdr (xetla-revlib-tree-get-branch archive category
- branch))))
- (xetla-run-tla-sync (list "library-versions"
- (xetla-name-construct
- archive category branch))
- :finished 'xetla-null-handler
- :error
- (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (with-current-buffer xetla-last-process-buffer
- (let (version
- (tmp xetla-archive-tree)
- (xetla-archive-tree xetla-revlib-tree)
- result)
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq result t)
- (setq version (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (xetla-archive-tree-add-version
- archive
- category
- branch
- (xetla-name-version (xetla-name-split-semi-qualified version))))
- (setq xetla-revlib-tree xetla-archive-tree
- xetla-archive-tree tmp)
- result))))
-
-(defun xetla-revlib-tree-get-revision (archive category branch version revision)
- "Get ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION from the revlib tree."
- (assoc revision (cdr (xetla-revlib-tree-get-version
- archive category branch version))))
-
-(defun xetla-revlib-tree-build-revisions (archive category branch version
- &optional
- use-cache
- ignore-error)
-
- "Build the revision list of ARCHIVE/CATEGORY-BRANCH-VERSION.
-Updates `xetla-revlib-tree'.
-If IGNORE-ERROR is non-nil, error is not reported.
-Return non-nil if the tree entry for revisions are updated."
- (when (or (not use-cache)
- (not (cdr (xetla-revlib-tree-get-version archive category branch
- version))))
- (xetla-run-tla-sync (list "library-revisions"
- "--summary" "--date" "--creator"
- (xetla-name-construct
- archive category branch version))
- :finished 'xetla-null-handler
- :error (if ignore-error
- 'xetla-null-handler
- 'xetla-default-error-function))
- (with-current-buffer xetla-last-process-buffer
- (let (revision
- date
- creator
- summary
- (tmp xetla-archive-tree)
- (xetla-archive-tree xetla-revlib-tree)
- result)
-
- (goto-char (point-min))
- (while (> (point-at-eol) (point-at-bol))
- (setq result t)
- (setq revision (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))
- (forward-line 1)
- (skip-chars-forward " ")
- (setq date (buffer-substring-no-properties (point)
- (point-at-eol)))
- (forward-line 1)
- (skip-chars-forward " ")
- (setq creator (buffer-substring-no-properties (point)
- (point-at-eol)))
- (forward-line 1)
- (skip-chars-forward " ")
- (setq summary (buffer-substring-no-properties
- (point)
- (progn (re-search-forward "^\\([^ \t]\\|$\\)")
- (previous-line 1)
- (end-of-line)
- (point))))
- (forward-line 1)
- (xetla-archive-tree-add-revision
- archive
- category
- branch
- version
- revision
- summary
- creator
- date))
- (setq xetla-revlib-tree xetla-archive-tree
- xetla-archive-tree tmp)
- result
- ))))
-
-;; --------------------------------------
-;; Name reading engine
-;; --------------------------------------
-;;Currently only able to read a full revision starting from nothing.
-(defun xetla-name-read-refresh-cache ()
- "Function to be called from the minibuffer while reading a name."
- (interactive)
- (xetla-archive-tree-build
- (xetla-name-construct
- (butlast (delete nil (xetla-name-split (buffer-substring))))))
- (setq xetla-archive-tree nil))
-
-(defvar xetla-name-read-arguments "This value should not be refereed."
- "Used to suppress warnings from the byte code compiler.
-This variable is a just placeholder introduced to suppress the
-warnings from byte code compiler. Variable `xetla-name-read-arguments'
-should be bound in `let'. Variable `xetla-name-read-arguments' is used
-for passing information from `xetla-name-read' to functions called internally
-from `xetla-name-read'. Use function `xetla-name-read-arguments' to get the
-information")
-
-(defun xetla-name-read-arguments (key)
- "Get `xetla-name-read' context information associated to KEY.
-`xetla-name-read' calls some functions to read a xetla name.
-In the functions, the arguments passed to `xetla-name-read'(context information)
-are needed to know. However, `xetla-name-read' cannot pass the context
-information directly to the functions because the functions are something to do
-with Emacs's completion mechanism; and the mechanism specifies the number
-of arguments of the functions. So the context information is passed via
-a local variable, `xetla-name-read-arguments', defined in let.
-
-Symbol `archive', `category', `branch', `version', or `revision' are
-acceptable as KEY."
- (cdr (assoc key xetla-name-read-arguments)))
-
-
-(defun xetla-name-read-complete (string predicate what)
- "Completion function for name reading.
-
-Displays STRING and prompts for something satisfying PREDICATE.
-
-This function uses the free variables archive, category, branch,
-version, and revision. If one of these variables is non-nil, it means
-the corresponding value must be read from keyboard.
-
-REMINDER: this function may be called several times, with different
-values for WHAT:
-
- - nil : The function must return the longest prefix
- - t : The function must return the list of completions
- - 'lambda : The function must return t if the completion correspond
- to an exact match, nil otherwise. (so that Emacs can distinguish
- between \"sole completion\" and \"complete, but not unique\"."
- (if (and (eq what 'lambda)
- (string-match "/\\(.*--\\)?$" string))
- ;; The caller just want to know whether this is a full
- ;; completion. This can not be the case with such suffix.
- nil
- (let* ((empty-branch nil)
- (use-cache (not current-prefix-arg))
- (splited (xetla-name-split string))
- (archive-loc (xetla-name-archive splited))
- (category-loc (xetla-name-category splited))
- (branch-loc (xetla-name-branch splited))
- (version-loc (xetla-name-version splited))
- (revision-loc (xetla-name-revision splited))
- (suffix (cond
- ((and (xetla-name-read-arguments 'category)
- (not category-loc) "/"))
- ((and (xetla-name-read-arguments 'branch)
- (not branch-loc) "--"))
- ((and (xetla-name-read-arguments 'version)
- (not version-loc) "--"))
- ((and (xetla-name-read-arguments 'revision)
- (not revision-loc) "--"))
- (t nil)))
- (maybep (cond
- ((eq 'maybe (xetla-name-read-arguments 'category))
- t)
- ((and (eq 'maybe (xetla-name-read-arguments 'branch))
- archive-loc category-loc)
- t)
- ((and (eq 'maybe (xetla-name-read-arguments 'version))
- archive-loc category-loc branch-loc)
- t)
- ((and (eq 'maybe (xetla-name-read-arguments 'revision))
- archive-loc category-loc branch-loc version-loc)
- t)
- (t nil)))
- (completions
- (cond
- ;; If the user started to write a revision ...
- (revision-loc
- ;; ... and if the user is supposed to be prompted a
- ;; revision
- (when (xetla-name-read-arguments 'revision)
- (let ((xetla-revisions-shows-summary nil)
- (xetla-revisions-shows-date nil)
- (xetla-revisions-shows-creator nil))
- (xetla-archive-tree-build-revisions
- archive-loc category-loc branch-loc version-loc use-cache t))
- (cdr (xetla-archive-tree-get-version
- archive-loc category-loc branch-loc version-loc))))
- (version-loc
- (when (xetla-name-read-arguments 'version)
- (xetla-archive-tree-build-versions
- archive-loc category-loc branch-loc use-cache t)
- (cdr (xetla-archive-tree-get-branch
- archive-loc category-loc branch-loc))))
- ;; If the user started a branch ...
- (branch-loc
- ;; And a branch is needed
- (when (xetla-name-read-arguments 'branch)
- (xetla-archive-tree-build-branches
- archive-loc category-loc use-cache t)
- (let ((result (cdr (xetla-archive-tree-get-category
- archive-loc category-loc))))
- (when (and (string= branch-loc "")
- (xetla-name-read-arguments 'version)
- (let ((empty-br-exists nil))
- (dolist (branch
- (cdr (xetla-archive-tree-get-category
- archive-loc category-loc)))
- (when (string= (car branch) "")
- (setq empty-br-exists t)))
- empty-br-exists))
- (xetla-archive-tree-build-versions
- archive-loc category-loc "")
- (setq empty-branch (xetla-archive-tree-get-branch
- archive-loc category-loc ""))
- (when empty-branch
- ;; Remove the "" branch to avoid the --
- ;; completion.
- (let ((tmp result))
- (setq result nil)
- (while tmp
- (when (not (string= (caar tmp) ""))
- (setq result (cons (car tmp) result)))
- (setq tmp (cdr tmp))))))
- result)))
- (category-loc
- (when (xetla-name-read-arguments 'category)
- (xetla-archive-tree-build-categories archive-loc use-cache t)
- (cddr (xetla-archive-tree-get-archive archive-loc))))
- (t
- (when (xetla-name-read-arguments 'archive)
- (xetla-archive-tree-build-archives use-cache t)
- xetla-archive-tree)))))
- (let* ((base (mapcar (lambda (x)
- (xetla-name-construct
- (delete
- nil
- (list
- (when category-loc archive-loc)
- (when branch-loc category-loc)
- (when version-loc branch-loc)
- (when revision-loc version-loc)
- (car x)))))
- completions))
- (sans-suffix
- (and maybep suffix))
- (empty-branch-versions
- (and empty-branch
- (mapcar (lambda (x)
- (xetla-name-construct
- archive-loc category-loc "" (car x)))
- (cdr empty-branch))))
- (completions (funcall 'all-completions
- string
- (nconc (mapcar
- (lambda (x)
- (list (concat x suffix)))
- base)
- (when sans-suffix
- (mapcar
- (lambda (x) (list x))
- base))
- (when empty-branch
- (mapcar
- (lambda (x) (list x))
- empty-branch-versions)))
- predicate)))
- (let ((result
- (cond ((eq what t)
- ;; We just want the list of completions
- completions)
- ((eq (length completions) 1)
- ;; There's only one completion
- (if (eq what 'lambda)
- (string= (car completions) string)
- (cond ((string= (car completions) string) t)
- (t (car completions)))))
- ;; there are several possible completions
- (t (if (eq what 'lambda)
- ;; complete, but not unique ?
- (member string completions)
- (try-completion string (mapcar 'list
- completions)))))))
-;; (xetla-trace "string=%s predicate=%S what=%s ==> result=%S\ncompletions=%S"
-;; string predicate what result completions)
- result)))))
-
-;; Test cases
-;; (xetla-name-read "enter category: " "Matthieu.Moy@imag.fr--public" 'prompt)
-;; (xetla-name-read "branch: " "lord@emf.net--2004" 'prompt 'prompt)
-;; (xetla-name-read "revision: " 'prompt 'prompt 'prompt 'prompt 'prompt)
-;; (xetla-name-read "revision or version: " 'prompt 'prompt 'prompt 'prompt 'maybe)
-;; (xetla-name-read "revision or version: " "jet@gyve.org--xetla" "xetla" "jet" 'prompt 'maybe)
-;;
-(defvar xetla-name-read-history nil) ; TODO: multiple history list?
-(defvar xetla-name-read-debug nil
- "If non-nil, `condition-case' in `xetla-name-read' is made disabled.")
-(defun xetla-name-read (&optional prompt archive category
- branch version revision)
- "Read a name.
-To get help on the user interface of `xetla-name-read', please type
-M-x xetla-name-read-help RET.
-
-Function reading an archive location from keyboard.
-Read name is expressed in a list built by `xetla-name-split'.
-
-First argument PROMPT is the prompt the user will get. Next arguments
-ARCHIVE CATEGORY BRANCH VERSION and REVISION are either the default
-value, or a request for a value. They can take four values:
-
- - A string means the default value, and will be used as an initial
- input.
-
- - The symbol 'prompt means the value will be prompted from the user.
- The user will HAVE to give this value.
-
- - The symbol 'maybe means the value will be prompted, but is optional
- for the user.
-
- - nil means the value won't be prompted.
-
-They should appear in the same order as above.
-
-Example:
-- Read a category in archive \"Matthieu.Moy@imag.fr--public\":
- (xetla-name-read \"enter category: \" \"Matthieu.Moy@imag.fr--public\" 'prompt)
-- Read a revision, anywhere:
- (xetla-name-read \"revision: \" 'prompt 'prompt 'prompt 'prompt 'prompt)
-- Read either a revision or a version:
- (xetla-name-read \"revision: \" 'prompt 'prompt 'prompt 'prompt 'maybe)
-
-While prompting, a menu \"Xetla\" is added to the menubar. The
-following commands are available:
-
-\\{xetla-name-read-minibuf-map}"
- (let ((xetla-name-read-arguments `((archive . ,archive)
- (category . ,category)
- (branch . ,branch)
- (version . ,version)
- (revision . ,revision))))
- (if xetla-name-read-debug
- (xetla-name-read-internal prompt archive category branch version revision)
- (condition-case reason
- (xetla-name-read-internal prompt archive category branch version revision)
- ((quit error)
- (run-hooks 'xetla-name-read-error-hook)
- (signal (car reason) (cdr reason)))))))
-
-(defun xetla-name-read-internal (prompt archive category branch version revision)
- "See `xetla-name-read'."
- (run-hooks 'xetla-name-read-init-hook)
- (let* ((minibuffer-local-completion-map xetla-name-read-minibuf-map)
- (result (xetla-name-construct
- (delete
- 'maybe
- (delete 'prompt (list archive category
- branch version)))))
- (first-try t)
- not-finished too-long last-empty)
- ;; Without in some case 'maybe is ignored by xetla-prompt-not-finished
- ;; and never the control flow enters the while loop.
- ;; We need C language's do-while loop.
- (while (or first-try
- not-finished
- too-long
- last-empty)
- (unless first-try
- (unless (eq this-command 'choose-completion)
- (ding)
- (message (cond (not-finished "%s%s [incomplete input: %s]")
- (too-long "%s%s [too long input for: %s]")
- (last-empty (concat "%s%s [empty " last-empty
- " name]"))
- (t (error
- (concat "case not managed."
- " Please submit a bug report"))))
- prompt result
- (xetla-name-read-required-input archive
- category
- branch
- version
- revision))
- (sit-for 2)
- (message nil)))
-
- (setq result (completing-read
- (or prompt "Location: ")
- 'xetla-name-read-complete
- nil nil result
- 'xetla-name-read-history)
- first-try nil)
- (setq not-finished (xetla-prompt-not-finished
- result archive category branch
- version revision))
- (setq too-long (xetla-prompt-too-long
- result archive category branch
- version revision))
- (setq last-empty (xetla-prompt-last-empty result)))
-
- (when result
- (setq result (xetla-name-split result)))
- (run-hook-with-args 'xetla-name-read-final-hook result)
- result))
-
-(defun xetla-prompt-not-finished (result archive category branch
- version revision)
- "Check whether user input is complete.
-True if RESULT (a string) is not sufficient when the user is
-prompted for ARCHIVE CATEGORY BRANCH VERSION REVISION."
- (let ((res-split (xetla-name-split result)))
- (or (and (eq archive 'prompt) ;; archive required
- (not (xetla-name-archive res-split))) ;; but not provided
- (and (eq category 'prompt)
- (not (xetla-name-category res-split)))
- (and (eq branch 'prompt)
- (not (xetla-name-branch res-split)))
- (and (eq version 'prompt)
- (not (xetla-name-version res-split)))
- (and (eq revision 'prompt)
- (not (xetla-name-revision res-split))))))
-
-(defun xetla-prompt-too-long (result archive category branch
- version revision)
- "Check whether the user has entered too many elements.
-True if RESULT (a string) contains too many elements when the user
-is prompted for ARCHIVE CATEGORY BRANCH VERSION REVISION.
-
-For example, will return true if the user entered
-foo@bar-2004/xetla-main while prompted only for a category."
- (let ((res-split (xetla-name-split result)))
- (or (and (not revision) ;; revision not needed
- (xetla-name-revision res-split)) ;; but provided
- (and (not version)
- (xetla-name-version res-split))
- (and (not branch)
- (xetla-name-branch res-split))
- (and (not category)
- (xetla-name-category res-split))
- (and (not archive)
- (xetla-name-archive res-split)))))
-
-(defun xetla-prompt-last-empty (result)
- "Check whether the last field is empty.
-Non-nil if RESULT (a string) is terminated by \"--\" or \"/\". This
-means the user entered a delimiter but not the element after.
-
-When non-nil, the returned value is a string giving the name of the
-item that is currently empty. (eg: archive, category, ...)"
- (let ((res-split (xetla-name-split result)))
- (cond ((equal (xetla-name-archive res-split) "") "archive" )
- ((equal (xetla-name-category res-split) "") "category")
- ((and (equal (xetla-name-branch res-split) "")
- (not (xetla-name-version res-split))) "branch" )
- ((equal (xetla-name-version res-split) "") "version" )
- ((equal (xetla-name-revision res-split) "") "revision")
- (t nil))))
-
-
-(defun xetla-name-read-required-input (archive
- category
- branch
- version
- revision)
- "Return string which represents the elements to be readin `xetla-name-read'.
-If ARCHIVE, CATEGORY, BRANCH, VERSION or REVISION are equal to 'maybe, the
-corresponding element will be optionally read.
-If any of these are non-nil (but not 'maybe), the corresponding element will be
-required.
-If any of these are nil, the correpsonding element is not required."
- (concat
- (cond ((eq archive 'maybe) "[A]")
- (archive "A")
- (t ""))
- (cond ((eq category 'maybe) "[/C]")
- (category "/C")
- (t ""))
- (cond ((eq branch 'maybe) "[--B]")
- (branch "--B")
- (t ""))
- (cond ((eq version 'maybe) "[--V]")
- (version "--V")
- (t ""))
- (cond ((eq revision 'maybe) "[--R]")
- (revision "--R")
- (t ""))))
-
-
-
-(defun xetla-location-type (location)
- "Return the type of LOCATION."
- (cond
- ((string-match "^ftp://" location) 'ftp)
- ((string-match "^sftp://" location) 'sftp)
- ((string-match "^http://" location) 'http)
- (t 'local)))
-
-(defun xetla-archive-type (archive)
- "Return the type of ARCHIVE."
- (cond
- ((string-match "SOURCE$" archive) 'source)
- ;; archive-MIRROR, archive-MIRROR-2 should be treated as mirror
- ((string-match ".+-MIRROR" archive) 'mirror)
- (t 'normal)))
-
-;; (xetla-archive-name-source "a")
-;; (xetla-archive-name-source "a-SOURCE")
-;; (xetla-archive-name-source "a-MIRROR")
-(defun xetla-archive-name-source (archive &optional existence-check)
- "Make source archive name from ARCHIVE.
-If EXISTENCE-CHECK is non-nil, check whether the made source archive name
-already exists or not; return nil if it doesn't exists.
-Example:
-ELISP> (xetla-archive-name-source \"jet@gyve.org-xetla\")
-\"jet@gyve.org-xetla-SOURCE\"
-ELISP> (xetla-archive-name-source \"jet@gyve.org-xetla-MIRROR\")
-\"jet@gyve.org-xetla\"
-ELISP> (xetla-archive-name-source \"jet@gyve.org-xetla-SOURCE\")
-nil"
- (let* ((type (xetla-archive-type archive))
- (source (cond
- ((eq 'normal type)
- (concat archive "-SOURCE"))
- ((eq 'mirror type)
- (string-match "\\(.*\\)-MIRROR$" archive)
- (match-string 1 archive))
- (t nil))))
- (if existence-check
- (progn
- (xetla-archive-tree-build-archives t)
- (when (and source (xetla-archive-tree-get-archive source))
- source))
- source)))
-
-;; (xetla-archive-name-mirror "a")
-;; (xetla-archive-name-mirror "a-SOURCE")
-;; (xetla-archive-name-mirror "a-MIRROR")
-(defun xetla-archive-name-mirror (archive &optional existence-check)
- "Make mirror archive name from ARCHIVE.
-If EXISTENCE-CHECK is non-nil, check whether the made mirror archive name
-already exists or not; return nil if it doesn't exists.
-Example:
-ELISP> (xetla-archive-name-mirror \"jet@gyve.org--xetla\")
-\"jet@gyve.org--xetla-MIRROR\"
-ELISP> (xetla-archive-name-mirror \"jet@gyve.org--xetla-SOURCE\")
-\"jet@gyve.org--xetla\"
-ELISP> (xetla-archive-name-mirror \"jet@gyve.org--xetla-MIRROR\")
-nil"
- (let* ((type (xetla-archive-type archive))
- (mirror (cond
- ((eq 'normal type)
- (concat archive "-MIRROR"))
- ((eq 'source type)
- (string-match "\\(.*\\)-SOURCE" archive)
- (match-string 1 archive))
- (t nil))))
- (if existence-check
- (progn
- (xetla-archive-tree-build-archives t)
- (when (and mirror (xetla-archive-tree-get-archive mirror))
- mirror))
- mirror)))
-
-(defun xetla-compute-direct-ancestor (&optional revision)
- "Compute the direct ancestor of REVISION.
-REVISION must be provided as a list, and a list is returned.
-If revision is nil, return the ancestor of the last revision
-of the local tree."
- (interactive
- (list (xetla-name-read "Compute direct ancestor of: "
- 'prompt 'prompt 'prompt 'prompt 'prompt)))
- (let ((ancestor
- (xetla-run-tla-sync (list "ancestry-graph" "--immediate"
- (and revision
- (xetla-name-construct revision)))
- :finished (lambda (output error status arguments)
- (xetla-name-split
- (xetla-buffer-content
- output))))))
- (when (interactive-p)
- (message "Ancestor of: %s\n is: %s"
- (xetla-name-construct ancestor)
- (xetla-name-construct revision)))
- ancestor))
-
-;; Copied from ediff-mouse-event-p. I prefer keeping this duplication
-;; to avoid one more dependancy on ediff.el (whose interface may
-;; change one day ...)
-(defsubst xetla-mouse-event-p (event)
- "Return true if EVENT is a mouse-related event."
- (if (featurep 'xemacs)
- (xetla-do-in-xemacs (button-event-p event))
- (xetla-do-in-gnu-emacs
- (string-match "mouse" (format "%S" (event-basic-type event))))))
-
-;; --------------------------------------
-;; Face manipulators
-;; --------------------------------------
-(defun xetla-face-add (str face &optional keymap menu help)
- "Add to string STR the face FACE.
-Optionally, also add the text properties KEYMAP, MENU and HELP.
-
-If KEYMAP is a symbol, (symbol-value KEYMAP) is used
-as a keymap; and `substitute-command-keys' result
-against (format \"\\{%s}\" (symbol-name keymap)) is appended to HELP.
-
-If HELP is nil and if MENU is non nil, the MENU title is used as HELP."
- (if xetla-highlight
- (let* ((strcpy (copy-sequence str))
- (key-help (when (symbolp keymap)
- (substitute-command-keys (format "\\{%s}" (symbol-name keymap)))))
- (prefix-help (if help help (when (and menu (stringp (cadr menu))) (cadr menu))))
- (long-help (if key-help
- (if prefix-help (concat prefix-help "\n"
- ;; Sigh. Font used on tooltips in GNU Emacs with Gtk+
- ;; is a proportional.
- ;; (make-string (length help) ?=) "\n"
- "================" "\n"
- key-help) key-help)
- help))
- (keymap (if (symbolp keymap) (symbol-value keymap) keymap)))
- (add-text-properties 0 (length strcpy)
- `(face ,face
-;;; Even if we define a face in a buffer, it seems that
-;;; font-lock mode just ignore it or remove the face property.
-;;; I don't know the detail but in xetla-inventory buffer,
-;;; I cannot make both font-lock keywords and faces put by tl-face-add
-;;; highlight at once. When font-lock-face is defined, I can do.
-;;; See "Special Properties" subsection in the emacs lisp reference manual.
-;;; `font-lock-face' property is new in Emacs 21.4. However, I guess there is
-;;; no wrong side effect if I define font-lock-face property here.
- font-lock-face ,face
- ,@(when keymap
- `(mouse-face highlight
- keymap ,keymap
- help-echo ,long-help))
- ,@(when menu
- `(menu ,menu))
- )
- strcpy)
- strcpy)
- str))
-
-;; --------------------------------------
-;; Debugging facilities
-;; --------------------------------------
-(defvar xetla-debug t)
-
-(defun xetla-trace (&rest msg)
- "Display the trace message MSG.
-Same as `message' if `xetla-debug' is non-nil.
-Does nothing otherwise. Please use it for your debug messages."
- (when xetla-debug
- (apply 'message (concat "xetla: " (car msg)) (cdr msg))))
-
-(defun xetla-reload (directory)
- "Reloads xetla \(usually for debugging purpose\).
-
-With prefix arg, prompts for the DIRECTORY in which xetla should be
-loaded. Useful to switch from one branch to the other.
-
-If a Makefile is present in the directory where xetla is to be loaded,
-run \"make\"."
- (interactive
- (list (when current-prefix-arg
- (let* ((other (read-directory-name
- "Load XEtla from: "))
- (lispdir (concat (file-name-as-directory other)
- "lisp")))
- (if (file-directory-p lispdir)
- lispdir
- other)))))
- (when directory
- (let ((current-path (file-name-directory (locate-library
- "xetla"))))
- (setq load-path
- (cons directory (remove current-path load-path)))))
- (let ((default-directory (file-name-directory (locate-library "xetla"))))
- (when (file-exists-p
- "Makefile")
- (shell-command "make")))
- (when (featurep 'xetla-tips) (unload-feature 'xetla-tips t))
- (when (featurep 'xetla-browse) (unload-feature 'xetla-browse t))
- (when (featurep 'xetla) (unload-feature 'xetla t))
- (when (featurep 'xetla-core) (unload-feature 'xetla-core t))
- (when (featurep 'xetla-defs) (unload-feature 'xetla-defs t))
- (when (featurep 'xetla-autoloads) (unload-feature 'xetla-autoloads t))
- (ignore-errors (require 'xetla-autoloads))
- (require 'xetla))
-
-;; --------------------------------------
-;; Supports spaces in filenames
-;; --------------------------------------
-(defvar xetla-supports-spaces-in-filenames nil
- "Wether xetla supports spaces in filenames.
-
-Possible values are nil (don't know), 'yes, or 'no. Don't use this
-variable directly. Use `xetla-supports-spaces-in-filenames' instead.")
-
-(defun xetla-supports-spaces-in-filenames ()
- "Wether xetla supports spaces in filenames.
-
-Returns 't or nil.
-
-If `xetla-supports-spaces' is non-nil, use its value. Otherwise, test
-if \"escape\" is listed by \"xetla help\", and memorize the result in
-`xetla-supports-spaces-in-filenames'"
- (interactive)
- (let ((answer
- (cond ((eq xetla-supports-spaces-in-filenames 'yes) t)
- ((eq xetla-supports-spaces-in-filenames 'no) nil)
- (t (xetla-run-tla-sync
- '("help")
- :finished (lambda (output error status arguments)
- (with-current-buffer output
- (goto-char (point-min))
- (search-forward "escape :"
- nil t))))))))
- (when (interactive-p)
- (message (if answer "Yes" "No")))
- (setq xetla-supports-spaces-in-filenames
- (if answer 'yes 'no))
- answer))
-
-(defun xetla-escape (string &optional unescape message)
- "Return the pika escaped value of STRING.
-If pika escaping is not supported by xetla, return STRING.
-If UNESCAPE is non-nil, returns the unescaped version of string.
-If MESSAGE is non-nil or if run interactively, also display the value
-as a message."
- (interactive "sString to escape: ")
- (let ((res (if (and (string-match (if unescape "\\\\"
- "[^a-zA-Z._+,{}-]") string)
- ;; We need to do the (un)escaping
- (xetla-supports-spaces-in-filenames))
- (xetla-run-tla-sync
- (list "escape" (when unescape "--unescaped") string)
- :finished (lambda (output error status arguments)
- (xetla-buffer-content output)))
- string)))
- (when (or (interactive-p) message)
- (message res))
- res))
-
-(defun xetla-unescape (string)
- "Run \"tla escape -unescaped\" on STRING.
-
-Return STRING if \"tla escape\" is not available."
- (interactive "sString to unescape: ")
- (xetla-escape string t (interactive-p)))
-
-(defun xetla-regexp-quote (string)
- "Return a regexp string which matches exactly STRING and nothing else.
-Special characters are escaped to leave STRING in a suitable form for
-Arch."
- (let ((quoted (regexp-quote string)))
- (replace-regexp-in-string
- "\\([{}()|]\\)"
- (concat "\\\\" ; leading slash
- "\\1") ; quoted character
- quoted)))
-
-;; --------------------------------------
-;; Saving and loading state variables
-;; --------------------------------------
-(defun xetla-pp-to-string (sexp)
- "Return sexp pretty printed by `pp-to-string'."
- (let ((print-readably t)
- print-level print-length)
- (pp-to-string sexp)))
-
-(defun xetla-save-state (&optional vars state-file pp)
- "Save variables from VARS list to file STATE-FILE.
-The default for VARS is `xetla-state-variables-list'
-The default for STATE-FILE is `xetla-state-file-name'.
-If PP is non-nil use `xetla-pp-to-string' to format object.
-
-The file will contain a setq setting the vars during loading by
-`xetla-load-state'."
- (let ((state-file (or state-file
- (expand-file-name xetla-state-file-name
- xetla-config-directory)))
- (vars (or vars xetla-state-variables-list))
- v)
- (if (not (file-exists-p (file-name-directory state-file)))
- (make-directory (file-name-directory state-file) t))
- (save-excursion
- (set-buffer (get-buffer-create " *xetla-state*"))
- (erase-buffer)
- (insert ";; Generated file. Do not edit!!!\n(setq\n")
- (if pp
- (while vars
- (setq v (car vars) vars (cdr vars))
- (insert (format "%s\n'%s"
- (symbol-name v)
- (xetla-pp-to-string (symbol-value v)))))
- (while vars
- (setq v (car vars) vars (cdr vars))
- (insert (format " %s '%S\n"
- (symbol-name v)
- (symbol-value v)))))
- (insert " )")
- (write-region (point-min) (point-max) state-file))))
-
-(defun xetla-load-state (&optional state-file)
- "Load `xetla-state-file-name`, i.e. evaluate its content."
- (let ((state-file (or state-file
- (expand-file-name xetla-state-file-name
- xetla-config-directory))))
- (if (file-exists-p state-file)
- (load state-file nil t t))))
-
-;; (setq xetla-archive-tree nil)
-;; (setq xetla-revlib-tree nil)
-
-(provide 'xetla-core)
-;;; xetla-core.el ends here
+++ /dev/null
-;;; xetla-defs.el --- UI XEtla's element definitions
-
-;; Copyright (C) 2003-2004 by Stefan Reichoer (GPL)
-;; Copyright (C) 2004 Steve Youngs (BSD)
-
-;; Author: Steve Youngs <steve@eicq.org>
-;; Maintainer: Steve Youngs <steve@eicq.org>
-;; Created: 2004-11-25
-;; Keywords: arch archive tla
-
-;; Based on xtla-defs.el by: Stefan Reichoer, <stefan@xsteve.at>
-
-;; This file is part of XEtla.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;; may be used to endorse or promote products derived from this
-;; software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
-;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; Commentary:
-
-;; Contributions from:
-;; Matthieu Moy <Matthieu.Moy@imag.fr>
-;; Masatake YAMATO <jet@gyve.org>
-;; Milan Zamazal <pdm@zamazal.org>
-;; Martin Pool <mbp@sourcefrog.net>
-;; Robert Widhopf-Fenk <hack@robf.de>
-;; Mark Triggs <mst@dishevelled.net>
-
-;; In order to keep UI consistency, especially about key binding,
-;; we gather all UI definition in this separated file.
-;;
-
-
-;;; History:
-;;
-
-;;; Code:
-
-(eval-when-compile
- (require 'cl))
-
-(eval-and-compile
- (autoload 'ad-add-advice "advice")
- (require 'ediff)
- (require 'diff-mode)
- (require 'font-lock)
- (require 'add-log)
- (require 'ffap)
- (require 'easymenu))
-
-;; Macros to generate correct code for different emacs variants
-;; This doesn't really belong here, but then again it doesn't "fit"
-;; anywhere else.
-;;;###autoload
-(defmacro xetla-do-in-gnu-emacs (&rest body)
- "Execute BODY if in GNU/Emacs."
- (unless running-xemacs `(progn ,@body)))
-(put 'xetla-do-in-gnu-emacs 'lisp-indent-hook 'defun)
-
-;;;###autoload
-(defmacro xetla-do-in-xemacs (&rest body)
- "Execute BODY if in XEmacs."
- (when running-xemacs `(progn ,@body)))
-(put 'xetla-do-in-xemacs 'lisp-indent-hook 'defun)
-
-(defmacro xetla-funcall-if-exists (function &rest args)
- "Call FUNCTION with ARGS as parameters if it exists."
- (if (fboundp function)
- `(funcall ',function ,@args)))
-
-(defun xetla-clone-process (process &optional newname)
- "Create a twin copy of PROCESS.
-If NEWNAME is nil, it defaults to PROCESS' name;
-NEWNAME is modified by adding or incrementing <N> at the end as necessary.
-If PROCESS is associated with a buffer, the new process will be associated
- with the current buffer instead.
-Returns nil if PROCESS has already terminated."
- (setq newname (or newname (process-name process)))
- (if (string-match "<[0-9]+>\\'" newname)
- (setq newname (substring newname 0 (match-beginning 0))))
- (when (memq (process-status process) '(run stop open))
- (let* ((process-connection-type (process-tty-name process))
- (old-kwoq (process-kill-without-query process nil))
- (new-process
- (if (memq (process-status process) '(open))
- (apply 'open-network-stream newname
- (if (process-buffer process) (current-buffer)))
- (apply 'start-process newname
- (if (process-buffer process) (current-buffer))
- (process-command process)))))
- (process-kill-without-query new-process old-kwoq)
- (process-kill-without-query process old-kwoq)
- (set-process-filter new-process (process-filter process))
- (set-process-sentinel new-process (process-sentinel process))
- new-process)))
-
-(defun-when-void clone-buffer (&optional newname display-flag)
- "Create a twin copy of the current buffer.
-If NEWNAME is nil, it defaults to the current buffer's name;
-NEWNAME is modified by adding or incrementing <N> at the end as necessary.
-
-If DISPLAY-FLAG is non-nil, the new buffer is shown with `pop-to-buffer'.
-This runs the normal hook `clone-buffer-hook' in the new buffer
-after it has been set up properly in other respects."
- (interactive (list (if current-prefix-arg (read-string "Name: "))
- t))
- (if buffer-file-name
- (error "Cannot clone a file-visiting buffer"))
- (if (get major-mode 'no-clone)
- (error "Cannot clone a buffer in %s mode" mode-name))
- (setq newname (or newname (buffer-name)))
- (if (string-match "<[0-9]+>\\'" newname)
- (setq newname (substring newname 0 (match-beginning 0))))
- (let ((buf (current-buffer))
- (ptmin (point-min))
- (ptmax (point-max))
- (pt (point))
- (mk (mark t))
- (modified (buffer-modified-p))
- (mode major-mode)
- (lvars (buffer-local-variables))
- (process (get-buffer-process (current-buffer)))
- (new (generate-new-buffer (or newname (buffer-name)))))
- (save-restriction
- (widen)
- (with-current-buffer new
- (insert-buffer-substring buf)))
- (with-current-buffer new
- (narrow-to-region ptmin ptmax)
- (goto-char pt)
- (if mk (set-mark mk))
- (set-buffer-modified-p modified)
-
- ;; Clone the old buffer's process, if any.
- (when process (xetla-clone-process process))
-
- ;; Now set up the major mode.
- (funcall mode)
-
- ;; Set up other local variables.
- (mapcar (lambda (v)
- (condition-case () ;in case var is read-only
- (if (symbolp v)
- (makunbound v)
- (set (make-local-variable (car v)) (cdr v)))
- (error nil)))
- lvars)
-
- ;; Run any hooks (typically set up by the major mode
- ;; for cloning to work properly).
- (run-hooks 'clone-buffer-hook))
- (if display-flag (pop-to-buffer new))
- new))
-
-
-;; --------------------------------------
-;; Key bindings
-;; --------------------------------------
-;;
-;; Conventions
-;;
-;; - Meta Rules:
-;; 0. If you feel a binding odd more than 3 times, report it to xetla dev mailing
-;; list. Especially about some danger functions like undo, merge; and functions
-;; taking longer time to be executed.
-;;
-;; 1. Our key binding should not surprise "general users" even if the
-;; binding is convenience. Instead, provide hooks for customization.
-;; We know it is difficult to define "general users".
-;;
-;; 2. Write the result of discussion here.
-;;
-;; 3. See http://mail.gnu.org/archive/html/emacs-devel/2004-03/msg00608.html
-;;
-;;
-;; - Generic Rules:
-;;
-;; 1. xetla-inventory should have similar key bindings to pcl-cvs.
-;; If a pcl-cvs's binding is too odd, talk it in xetla dev mailing list.
-;;
-;; 2. Define common prefix for command groups like '>'.
-;; So a key binding for a grouped command has following structure:
-;;
-;; ?{prefix} ?{suffix}
-;;
-;; e.g. `get something commands' should have `>' as prefix.
-;;
-;; About suffix part, ? should show the help for the groups.
-;;
-;; e.g. `help for `get something commands'' is >?.
-;;
-;; BTW, The prefix ? is for help related command.
-;; So `? >' can stand for "show the help for get-something related
-;; command". In other word, prefix and suffix is swappable if
-;; prefix or suffix is `?'.
-;;
-;; 3. Upper case for commands taking longer time to be executed.
-;; 4. Lower case for commands taking shorter time to be executed.
-;; 5. dired's binding is also helpful.
-;;
-;;
-;; - Concrete Rules:
-;;
-
-;; t ? list all toggles
-;; c xetla-edit-log
-;; RET Open the thing at point
-;;
-
-;;
-;; Definitions for key concrete rules
-;;
-
-;; common keys
-(defvar xetla-key-help ??) ; help
-(defvar xetla-key-mark-prefix ?*) ; other mark related command prefix
-(defvar xetla-key-apply-from-here ?.) ; apply something from here
-(defvar xetla-key-add-bookmark ?b) ; add this to bookmark
-(defvar xetla-key-get ?>) ; prefix for getting something
-(defvar xetla-key-reflect ?<) ; mirror, apply, install...
-(defvar xetla-key-parent ?^) ; visit uppper XX. e.g. directory
-(defvar xetla-key-apply-from-head ?@) ; Do something head revision
-(defvar xetla-key-diff ?=) ; one shot
-
-(defvar xetla-key-add ?a) ; prefix for adding something
-(defvar xetla-key-show-bookmark ?b) ; show bookmark
-(defvar xetla-key-diff-prefix ?d)
-(defvar xetla-key-file-diff ?d)
-(defvar xetla-key-tree-lint ?l)
-(defvar xetla-key-logs ?L)
-(defvar xetla-key-ediff ?e)
-(defvar xetla-key-log-entry ?a)
-(defvar xetla-key-refresh ?g) ; refresh buffer
-(defvar xetla-key-inventory ?i) ; inventory
-(defvar xetla-key-mark ?m) ; mark
-(defvar xetla-key-next ?n) ; next item
-(defvar xetla-key-previous ?p) ; previous item
-(defvar xetla-key-quit ?q) ; quit
-(defvar xetla-key-remove ?r) ; prefix for remove something
-(defvar xetla-key-move ?R) ; prefix for move/rename something
-(defvar xetla-key-toggle ?t) ; prefix for toggle
-(defvar xetla-key-unmark ?u) ; unmark
-(defvar xetla-key-popup-menu ?\C-j)
-(defvar xetla-key-kill-ring-prefix ?w)
-(defvar xetla-key-commit ?c) ; actually edit-log, but
- ; that's what you do when you
- ; want to commit.
-(defvar xetla-key-update ?u) ; to run tla update
-(defvar xetla-key-replay ?r) ; to run tla replay
-(defvar xetla-key-star-merge ?s) ; to run tla star-merge
-(defvar xetla-key-missing ?m) ; to run tla missing
-
-(defvar xetla-key-buffer-prefix ?B) ; perfix for switching XX buffer
-(defvar xetla-key-directory-prefix ?D)
-(defvar xetla-key-merge-prefix ?M)
-(defvar xetla-key-tag ?T)
-(defvar xetla-key-revert ?U)
-(defvar xetla-key-working-copy ?W) ; Affecting on working copy
-(defvar xetla-key-partner-file-prefix ?f)
-(defvar xetla-key-tagging-method-prefix ?#)
-(defvar xetla-key-id ?i)
-
-;; functions for creating key groups
-(defun xetla-key-group (prefix &rest keys)
- (apply 'vector prefix keys))
-
-(defun xetla-prefix-toggle (&rest keys)
- (xetla-key-group xetla-key-toggle keys))
-
-(defun xetla-prefix-add (&rest keys)
- (xetla-key-group xetla-key-add keys))
-
-(defun xetla-prefix-remove (&rest keys)
- (xetla-key-group xetla-key-remove keys))
-
-(defun xetla-prefix-move (&rest keys)
- (xetla-key-group xetla-key-move keys))
-
-(defun xetla-prefix-apply-from-here (&rest keys)
- (xetla-key-group xetla-key-apply-from-here keys))
-
-(defun xetla-prefix-apply-from-head (&rest keys)
- (xetla-key-group xetla-key-apply-from-head keys))
-
-(defun xetla-prefix-mark (&rest keys)
- (xetla-key-group xetla-key-mark-prefix keys))
-
-(defun xetla-prefix-diff (&rest keys)
- (xetla-key-group xetla-key-diff-prefix keys))
-
-(defun xetla-prefix-merge (&rest keys)
- (xetla-key-group xetla-key-merge-prefix keys))
-
-(defun xetla-prefix-directory (&rest keys)
- (xetla-key-group xetla-key-directory-prefix keys))
-
-(defun xetla-prefix-kill-ring (&rest keys)
- (xetla-key-group xetla-key-kill-ring-prefix keys))
-
-(defun xetla-prefix-buffer (&rest keys)
- (xetla-key-group xetla-key-buffer-prefix keys))
-
-(defun xetla-prefix-working-copy (&rest keys)
- (xetla-key-group xetla-key-working-copy keys))
-
-(defun xetla-prefix-partner-file (&rest keys)
- (xetla-key-group xetla-key-partner-file-prefix keys))
-
-(defun xetla-prefix-tag (&rest keys)
- (xetla-key-group xetla-key-tag keys))
-
-(defun xetla-prefix-tagging-method (&rest keys)
- (xetla-key-group xetla-key-tagging-method-prefix keys))
-
-;; predefined key vectors
-(defvar xetla-keyvec-toggle-set (xetla-prefix-toggle ?+))
-(defvar xetla-keyvec-toggle-reset (xetla-prefix-toggle ?-))
-(defvar xetla-keyvec-toggle-invert (xetla-prefix-toggle ?~))
-
-
-(defvar xetla-keyvec-help (vector xetla-key-help))
-(defvar xetla-keyvec-parent (vector xetla-key-parent))
-(defvar xetla-keyvec-add (vector xetla-key-add))
-(defvar xetla-keyvec-remove (vector xetla-key-remove))
-(defvar xetla-keyvec-get (vector xetla-key-get))
-(defvar xetla-keyvec-refresh (vector xetla-key-refresh))
-
-(defvar xetla-keyvec-next (vector xetla-key-next))
-(defvar xetla-keyvec-previous (vector xetla-key-previous))
-
-(defvar xetla-keyvec-mark (vector xetla-key-mark))
-(defvar xetla-keyvec-unmark (vector xetla-key-unmark))
-(defvar xetla-keyvec-mark-all (xetla-prefix-mark ?*))
-(defvar xetla-keyvec-unmark-all (xetla-prefix-mark ?!))
-(defvar xetla-keyvec-quit (vector xetla-key-quit))
-(defvar xetla-keyvec-popup-menu (vector xetla-key-popup-menu))
-
-
-
-(defvar xetla-keyvec-ediff (vector xetla-key-ediff))
-
-(defvar xetla-keyvec-tree-lint (vector xetla-key-tree-lint))
-
-(defvar xetla-keyvec-logs (vector xetla-key-logs))
-
-(defvar xetla-keyvec-log-entry (vector xetla-key-log-entry))
-
-(defvar xetla-keyvec-diff (vector xetla-key-diff))
-
-(defvar xetla-keyvec-file-diff (vector xetla-key-file-diff))
-
-(defvar xetla-keyvec-file-diff (vector xetla-key-file-diff))
-
-(defvar xetla-keyvec-commit (vector xetla-key-commit))
-
-(defvar xetla-keyvec-update (vector xetla-key-update))
-(defvar xetla-keyvec-replay (vector xetla-key-replay))
-(defvar xetla-keyvec-star-merge (vector xetla-key-star-merge))
-
-(defvar xetla-keyvec-reflect (vector xetla-key-reflect))
-(defvar xetla-keyvec-revert (vector xetla-key-revert))
-
-
-(defvar xetla-keyvec-inventory (vector xetla-key-inventory))
-
-
-(defvar xetla-keyvec-show-bookmark (vector xetla-key-show-bookmark))
-(defvar xetla-keyvec-add-bookmark (vector xetla-key-add-bookmark))
-
-(defvar xetla-keyvec-tag (vector xetla-key-tag))
-(defvar xetla-keyvec-kill-ring (vector xetla-key-kill-ring-prefix))
-
-(defvar xetla-keyvec-id (vector xetla-key-id))
-(defvar xetla-keyvec-toggle (vector xetla-key-toggle))
-;;
-;; Global
-;;
-
-(defvar xetla-global-keymap
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-log-entry 'xetla-add-log-entry)
- (define-key map [?A] 'xetla-archives)
- (define-key map xetla-keyvec-show-bookmark 'xetla-bookmarks)
- (define-key map xetla-keyvec-file-diff 'xetla-file-diff)
- (define-key map xetla-keyvec-ediff 'xetla-file-ediff)
- (define-key map [?o] 'xetla-file-view-original)
- (define-key map xetla-keyvec-diff 'xetla-changes)
- (define-key map xetla-keyvec-commit 'xetla-edit-log)
- (define-key map [?t] 'xetla-tag-insert)
- (define-key map xetla-keyvec-inventory 'xetla-inventory)
- (define-key map [?r] 'xetla-tree-revisions)
- (define-key map xetla-keyvec-logs 'xetla-logs)
- (define-key map xetla-keyvec-tree-lint 'xetla-tree-lint)
- (define-key map xetla-keyvec-update 'xetla-update)
- (define-key map xetla-keyvec-help 'xetla-help)
- map)
- "Global keymap used by Xetla.")
-
-
-(define-key ctl-x-4-map [?T] 'xetla-add-log-entry)
-
-;;
-;; Minibuffer(for reading engine)
-;;
-(defvar xetla-name-read-partner-menu (cons "Insert Partner Version" nil))
-(fset 'xetla-name-read-partner-menu (cons 'keymap xetla-name-read-partner-menu))
-(defvar xetla-name-read-bookmark-menu (cons "Insert Version in Bookmarks" nil))
-(fset 'xetla-name-read-bookmark-menu (cons 'keymap xetla-name-read-bookmark-menu))
-
-
-(defvar xetla-name-read-extension-keydefs
- '(([(control r)] . xetla-name-read-refresh-cache)
- ([(meta *)] . xetla-name-read-insert-default-archive)
- ([(meta \.)] . xetla-name-read-insert-info-at-point)
- ([(meta \;)] . xetla-name-read-insert-version-associated-with-default-directory)
- ([(control n)] . xetla-name-read-insert-partner-next)
- ([(control p)] . xetla-name-read-insert-partner-previous)
- ([(control v)] . xetla-name-read-insert-bookmark-next)
- ([(meta v)] . xetla-name-read-insert-bookmark-previous)
- ([(meta ^)] . xetla-name-read-insert-ancestor)
- ([(control h)] . xetla-name-read-help)
- ([(meta \?)] . xetla-name-read-inline-help))
- "Key definitions table for `xetla-name-read-minibuf-map'.
-The reason these definitions are defined separately from
-`xetla-name-read-minibuf-map' is that to reuse these definitions
-in `xetla-name-read-help'. Don't forget to evalute
-`xetla-name-read-minibuf-map' again after updating this value.")
-
-
-(defvar xetla-name-read-minibuf-map
- (let ((map (copy-keymap minibuffer-local-completion-map)))
- ;; Keys
- (mapc
- (lambda (pair)
- (let ((key (car pair))
- (func (cdr pair)))
- (define-key map key func)))
- xetla-name-read-extension-keydefs)
- ;; Menus
- (define-key map [menu-bar xetla]
- (cons "XEtla" (make-sparse-keymap "XEtla")))
- (define-key map [menu-bar xetla refresh]
- (list 'menu-item "Refresh Completion Cache"
- 'xetla-name-read-refresh-cache))
- (define-key map [menu-bar xetla ancestor]
- (list 'menu-item "Insert Ancestor"
- 'xetla-name-read-insert-ancestor
- :enable '(and
- (window-minibuffer-p)
- (equal "" (buffer-substring))
- (member archive '(prompt maybe))
- (not (eq this-command 'xetla-compute-direct-ancestor))
- )))
- (define-key map [menu-bar xetla default]
- (list 'menu-item "Insert Default Archive"
- 'xetla-name-read-insert-default-archive
- :enable '(and
- (window-minibuffer-p)
- (equal "" (buffer-substring))
- (member archive '(prompt maybe)))))
- (define-key map [menu-bar xetla here]
- (list 'menu-item "Insert Thing at Point"
- 'xetla-name-read-insert-info-at-point
- :enable '(and (window-minibuffer-p)
- (equal "" (buffer-substring))
- xetla-name-read-insert-info-at-point)))
- (define-key map [menu-bar xetla bookmark]
- (list 'menu-item "Insert Version in Bookmark" 'xetla-name-read-bookmark-menu
- :enable '(let* ((l (condition-case nil
- (let ((default-version (xetla-tree-version-list default-directory)))
- (xetla-bookmarks-get-partner-versions default-version))
- (error nil))))
- (and l (< 0 (length l))))))
- (define-key map [menu-bar xetla partner]
- (list 'menu-item "Insert Partner Version" 'xetla-name-read-partner-menu
- :enable '(let* ((l (condition-case nil (xetla-partner-list)
- (error nil))))
- (and l (< 0 (length l))))))
- map)
- "Keymap to input a gnuarch revision at the minibuffer.")
-
-;;
-;; Context keymap template
-;;
-(defvar xetla-context-map-template
- (let ((map (make-sparse-keymap)))
- ;; TODO: [return[, "\C-m" => xetla-generic-context-action
- (define-key map (xetla-prefix-apply-from-here xetla-key-help) 'describe-bindings)
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map [button3] 'xetla-generic-popup-menu)
- (define-key map xetla-keyvec-popup-menu 'xetla-generic-popup-menu-by-keyboard)
- map)
- "Template for keymaps used in items, files, changes, etc.")
-
-;;
-;; Bookmarks mode
-;;
-(defvar xetla-bookmarks-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- ;; Move
- (define-key map xetla-keyvec-next 'xetla-bookmarks-next)
- (define-key map xetla-keyvec-previous 'xetla-bookmarks-previous)
- (define-key map [?N] 'xetla-bookmarks-move-down)
- (define-key map [?P] 'xetla-bookmarks-move-up)
- ;; Actions
- (define-key map (xetla-prefix-merge xetla-key-star-merge)
- 'xetla-bookmarks-star-merge)
- (define-key map (xetla-prefix-merge xetla-key-replay)
- 'xetla-bookmarks-replay)
- (define-key map (xetla-prefix-merge xetla-key-update)
- 'xetla-bookmarks-update)
- (define-key map (xetla-prefix-merge xetla-key-missing)
- 'xetla-bookmarks-missing)
- (define-key map (xetla-prefix-merge xetla-key-tag)
- 'xetla-bookmarks-tag)
- (define-key map [?o] 'xetla-bookmarks-open-tree)
- (define-key map [(control x) (control f)] 'xetla-bookmarks-find-file)
- (define-key map xetla-keyvec-diff 'xetla-bookmarks-changes)
- (define-key map xetla-keyvec-get 'xetla-bookmarks-get)
- (define-key map "\C-m" 'xetla-bookmarks-goto)
- ;; Marks
- (define-key map xetla-keyvec-mark 'xetla-bookmarks-mark)
- (define-key map xetla-keyvec-unmark 'xetla-bookmarks-unmark)
- (define-key map xetla-keyvec-unmark-all 'xetla-bookmarks-unmark-all)
- (define-key map (xetla-prefix-mark ?g) 'xetla-bookmarks-select-by-group)
- ;; Partners
- (define-key map [(meta p)] 'xetla-bookmarks-marked-are-partners)
- (define-key map (xetla-prefix-add ?p)
- 'xetla-bookmarks-add-partner-interactive)
- (define-key map (xetla-prefix-remove ?p)
- 'xetla-bookmarks-delete-partner-interactive)
- (define-key map (xetla-prefix-partner-file ?r)
- 'xetla-bookmarks-add-partners-from-file)
- (define-key map (xetla-prefix-partner-file ?w)
- 'xetla-bookmarks-write-partners-to-file)
- ;; Bookmark manipulation
- (define-key map (xetla-prefix-add ?b) 'xetla-bookmarks-add)
- (define-key map (xetla-prefix-remove ?b) 'xetla-bookmarks-delete)
- (define-key map [?e] 'xetla-bookmarks-edit)
- (define-key map xetla-keyvec-toggle 'xetla-bookmarks-toggle-details)
- ;; Fields
- (define-key map (xetla-prefix-add ?t) 'xetla-bookmarks-add-tree-interactive)
- (define-key map (xetla-prefix-remove ?t) 'xetla-bookmarks-delete-tree-interactive)
- (define-key map (xetla-prefix-add ?g) 'xetla-bookmarks-add-group-interactive)
- (define-key map (xetla-prefix-remove ?g) 'xetla-bookmarks-delete-group-interactive)
- (define-key map (xetla-prefix-add ?n) 'xetla-bookmarks-add-nickname-interactive)
- (define-key map (xetla-prefix-remove ?n) 'xetla-bookmarks-delete-nickname-interactive)
- ;; Switch to other buffers
- (define-key map xetla-keyvec-inventory 'xetla-bookmarks-inventory)
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in `xetla-bookmarks-mode' buffers.")
-
-(defvar xetla-bookmarks-entry-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-bookmarks-goto-by-mouse)
- map)
- "Keymap used on entries in `xetla-bookmarks-mode' buffers.")
-
-;;
-;; Inventory mode
-;;
-(defvar xetla-inventory-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map xetla-keyvec-refresh 'xetla-generic-refresh)
- (define-key map xetla-keyvec-add 'xetla-inventory-add-files)
- (define-key map xetla-keyvec-remove 'xetla-inventory-remove-files)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map xetla-keyvec-next 'xetla-inventory-next)
- (define-key map xetla-keyvec-previous 'xetla-inventory-previous)
- (define-key map xetla-keyvec-parent 'xetla-inventory-parent-directory)
- ;;
- ;;
- ;;
- (define-key map [?X] 'xetla-inventory-delete-files)
- (define-key map (xetla-prefix-move xetla-key-move) 'xetla-inventory-move)
- (define-key map xetla-keyvec-commit 'xetla-inventory-edit-log) ;; mnemonic for commit
- (define-key map [?l] 'xetla-changelog)
- (define-key map xetla-keyvec-logs 'xetla-logs)
- ;;
- ;; Find file group
- ;;
- (define-key map [?f] 'xetla-inventory-find-file)
- (define-key map [return] 'xetla-inventory-find-file)
- (define-key map "\C-m" 'xetla-inventory-find-file)
- (define-key map [?o] 'xetla-generic-find-file-other-window)
- (define-key map [?v] 'xetla-generic-view-file)
- ;;
- ;; Diffs group
- ;;
- (define-key map (xetla-prefix-merge xetla-key-missing)
- 'xetla-inventory-missing)
- (define-key map (xetla-prefix-diff xetla-key-diff)
- 'xetla-inventory-changes)
- (define-key map (xetla-prefix-diff ?l) 'xetla-changes-last-revision)
- (define-key map (xetla-prefix-diff xetla-key-ediff)
- 'xetla-inventory-file-ediff)
- (define-key map (xetla-prefix-diff xetla-key-get)
- 'xetla-inventory-delta)
- ;; Alias for above bindings
- (define-key map xetla-keyvec-diff 'xetla-inventory-changes)
- (define-key map xetla-keyvec-ediff 'xetla-inventory-file-ediff)
- ;;
- (define-key map xetla-keyvec-reflect 'xetla-inventory-mirror)
- ;;
- ;; Merge group
- ;;
- (define-key map (xetla-prefix-merge xetla-key-star-merge)
- 'xetla-inventory-star-merge)
- (define-key map (xetla-prefix-merge xetla-key-replay)
- 'xetla-inventory-replay)
- (define-key map (xetla-prefix-merge xetla-key-update)
- 'xetla-inventory-update)
- (define-key map (xetla-prefix-merge xetla-key-reflect)
- 'xetla-inventory-apply-changeset)
- ;;
- ;; Buffers group
- ;;
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
- ;;
- ;; Undo and redo group
- ;;
- (define-key map xetla-keyvec-revert 'xetla-inventory-revert)
- (define-key map (xetla-prefix-working-copy xetla-key-revert) 'xetla-inventory-undo)
- (define-key map (xetla-prefix-working-copy ?R) 'xetla-inventory-redo)
- ;;
- ;; Patches group
- ;;
- (define-key map (xetla-prefix-working-copy ?S) 'xetla-changes-save)
- (define-key map (xetla-prefix-working-copy ?s) 'xetla-changes-save-as-tgz)
- (define-key map (xetla-prefix-working-copy ?V) 'xetla-show-changeset)
- (define-key map (xetla-prefix-working-copy ?v) 'xetla-show-changeset-from-tgz)
- (define-key map (xetla-prefix-working-copy ?A) 'xetla-inventory-apply-changeset)
- (define-key map (xetla-prefix-working-copy ?a) 'xetla-inventory-apply-changeset-from-tgz)
- ;;
- ;; Kill ring group
- ;;
- (define-key map (xetla-prefix-kill-ring ?a) 'xetla-save-archive-to-kill-ring)
- ;;
- ;; Tree lint
- ;;
- (define-key map (xetla-prefix-working-copy xetla-key-tree-lint)
- 'xetla-tree-lint)
- ;;
- ;; Mark group
- ;;
- (define-key map (xetla-prefix-mark xetla-key-mark) 'xetla-inventory-mark-file)
- (define-key map (xetla-prefix-mark xetla-key-unmark) 'xetla-inventory-unmark-file)
- ;; (define-key map xetla-keyvec-mark-all 'xetla-inventory-mark-all)
- (define-key map xetla-keyvec-unmark-all 'xetla-inventory-unmark-all)
- ;; Alias for above bindings
- (define-key map xetla-keyvec-mark 'xetla-inventory-mark-file)
- (define-key map xetla-keyvec-unmark 'xetla-inventory-unmark-file)
- ;;
- ;; Tagging method
- ;;
- (define-key map (xetla-prefix-tagging-method ?=) 'xetla-edit-=tagging-method-file)
- (define-key map (xetla-prefix-tagging-method ?.) 'xetla-edit-.arch-inventory-file)
- ;;
- ;; Exclude, junk, precious, unrecognized...
- ;;
- (define-key map (xetla-prefix-move ?j) 'xetla-inventory-make-junk)
- (define-key map (xetla-prefix-move ?,) 'xetla-inventory-make-junk)
- (define-key map (xetla-prefix-move ?p) 'xetla-inventory-make-precious)
- (define-key map (xetla-prefix-move ?+) 'xetla-inventory-make-precious)
- (define-key map (xetla-prefix-tagging-method ?M) 'xetla-generic-set-id-tagging-method)
- (define-key map (xetla-prefix-tagging-method ?V) 'xetla-generic-set-tree-version)
- (define-key map (xetla-prefix-tagging-method ?x) 'xetla-generic-add-to-exclude) ; alias
- (define-key map (xetla-prefix-tagging-method ?e) 'xetla-generic-add-to-exclude) ; alias
- (define-key map (xetla-prefix-tagging-method ?j) 'xetla-generic-add-to-junk)
- (define-key map (xetla-prefix-tagging-method ?b) 'xetla-generic-add-to-backup)
- (define-key map (xetla-prefix-tagging-method ?~) 'xetla-generic-add-to-backup) ; alias
- (define-key map (xetla-prefix-tagging-method ?p) 'xetla-generic-add-to-precious)
- (define-key map (xetla-prefix-tagging-method ?u) 'xetla-generic-add-to-unrecognized)
- ;;
- ;; Toggles
- ;;
- (define-key map xetla-keyvec-toggle-set 'xetla-inventory-set-all-toggle-variables)
- (define-key map xetla-keyvec-toggle-reset 'xetla-inventory-reset-all-toggle-variables)
- (define-key map xetla-keyvec-toggle-invert 'xetla-inventory-toggle-all-toggle-variables)
- map)
- "Keymap used in `xetla-inventory-mode' buffers.")
-
-(defvar xetla-inventory-item-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-inventory-find-file-by-mouse)
- map)
- "Keymap used on items in `xetla-inventory-mode' buffers.")
-
-(defvar xetla-inventory-default-version-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [return] 'xetla-generic-set-tree-version)
- (define-key map "\C-m" 'xetla-generic-set-tree-version)
- map)
- "Keymap used on the default version field in `xetla-inventory-mode' buffers.")
-
-(defvar xetla-inventory-tagging-method-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-generic-set-id-tagging-method-by-mouse)
- (define-key map [return] 'xetla-generic-set-id-tagging-method)
- (define-key map "\C-m" 'xetla-inventory-id-tagging-method)
- map)
- "Keymap used on the tagging method field in `xetla-inventory-mode' buffers.")
-
-
-(defconst xetla-inventory-file-types-manipulators
- '((?S xetla-inventory-display-source
- xetla-inventory-toggle-source ?s "source")
- (?P xetla-inventory-display-precious
- xetla-inventory-toggle-precious ?p "precious")
- (?J xetla-inventory-display-junk
- xetla-inventory-toggle-junk ?j "junk")
- (?B xetla-inventory-display-backup
- xetla-inventory-toggle-backup ?b "backup")
- (?T xetla-inventory-display-tree
- xetla-inventory-toggle-tree ?t "tree root")
- (?U xetla-inventory-display-unrecognized
- xetla-inventory-toggle-unrecognized ?u "unrecognized"))
- "List of possible file types in inventory.")
-
-(dolist (type-arg xetla-inventory-file-types-manipulators)
- (define-key xetla-inventory-mode-map `[?t ,(cadddr type-arg)] (caddr type-arg)))
-
-
-(dolist (type-arg xetla-inventory-file-types-manipulators)
- (eval `(defcustom ,(cadr type-arg) t
- ,(concat "Whether " (nth 4 type-arg)
- " should be printed in inventory")
- :group 'xetla-inventory
- :type 'boolean)))
-
-(defvar xetla-tree-lint-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map xetla-keyvec-refresh 'xetla-generic-refresh)
- (define-key map xetla-keyvec-add 'xetla-tree-lint-add-files)
- (define-key map xetla-keyvec-remove 'xetla-tree-lint-delete-files)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map xetla-keyvec-next 'xetla-tree-lint-next)
- (define-key map xetla-keyvec-previous 'xetla-tree-lint-previous)
- (define-key map [down] 'xetla-tree-lint-next)
- (define-key map [up] 'xetla-tree-lint-previous)
- (define-key map xetla-keyvec-id 'xetla-tree-lint-regenerate-id)
- (define-key map (xetla-prefix-move ?j) 'xetla-tree-lint-make-junk)
- (define-key map (xetla-prefix-move ?,) 'xetla-tree-lint-make-junk)
- (define-key map (xetla-prefix-move ?p) 'xetla-tree-lint-make-precious)
- (define-key map (xetla-prefix-move ?+) 'xetla-tree-lint-make-precious)
- ;;
- (define-key map (xetla-prefix-tagging-method ?=) 'xetla-edit-=tagging-method-file)
- (define-key map (xetla-prefix-tagging-method ?.) 'xetla-edit-.arch-inventory-file)
- (define-key map (xetla-prefix-tagging-method ?M) 'xetla-generic-set-id-tagging-method)
- (define-key map (xetla-prefix-tagging-method ?V) 'xetla-generic-set-tree-version)
- (define-key map (xetla-prefix-tagging-method ?x) 'xetla-generic-add-to-exclude) ; alias
- (define-key map (xetla-prefix-tagging-method ?e) 'xetla-generic-add-to-exclude) ; alias
- (define-key map (xetla-prefix-tagging-method ?j) 'xetla-generic-add-to-junk)
- (define-key map (xetla-prefix-tagging-method ?b) 'xetla-generic-add-to-backup)
- (define-key map (xetla-prefix-tagging-method ?~) 'xetla-generic-add-to-backup) ; alias
- (define-key map (xetla-prefix-tagging-method ?p) 'xetla-generic-add-to-precious)
- (define-key map (xetla-prefix-tagging-method ?u) 'xetla-generic-add-to-unrecognized)
- ;;
- (define-key map [return] 'xetla-generic-find-file-at-point)
- (define-key map "\C-m" 'xetla-generic-find-file-at-point)
- (define-key map [?o] 'xetla-generic-find-file-other-window)
- (define-key map [?v] 'xetla-generic-view-file)
- ;;
- ;; Mark group
- ;;
- (define-key map (xetla-prefix-mark xetla-key-mark) 'xetla-tree-lint-mark-file)
- (define-key map (xetla-prefix-mark xetla-key-unmark) 'xetla-tree-lint-unmark-file)
- ;; TODO
- ;; (define-key map xetla-keyvec-mark-all 'xetla-tree-lint-mark-all)
- (define-key map xetla-keyvec-unmark-all 'xetla-tree-lint-unmark-all)
- ;; Alias for above bindings
- (define-key map xetla-keyvec-mark 'xetla-tree-lint-mark-file)
- (define-key map xetla-keyvec-unmark 'xetla-tree-lint-unmark-file)
- ;;
- ;; Buffers group
- ;;
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
- map)
- "Keymap used in `xetla-tree-lint-mode' buffers.")
-
-(defvar xetla-tree-lint-file-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-generic-find-file-at-point-by-mouse)
- map)
- "Keymap used on files in xetla-lint-mode buffers.")
-
-;;
-;; Cat-Log mdoe
-;;
-(defvar xetla-cat-log-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map xetla-keyvec-inventory 'xetla-pop-to-inventory)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in `xetla-cat-log-mode' buffers.")
-
-;;
-;; Log edit mode
-;;
-(defvar xetla-log-edit-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [(control ?c) (control ?c)] 'xetla-log-edit-done)
- (define-key map [(control ?c) (control ?d)] 'xetla-changes)
- (define-key map [(control ?c) (control ?l)] 'xetla-changelog)
- (define-key map [(control ?c) (control ?m)] 'xetla-log-edit-insert-log-for-merge)
- (define-key map [(control ?c) ?m ]
- 'xetla-log-edit-insert-log-for-merge-and-headers)
- (define-key map [(control ?c) (control ?p)] 'xetla-log-edit-insert-memorized-log)
- (define-key map [(control ?c) (control ?q)] 'xetla-log-edit-abort)
- (define-key map [(control ?c) (control ?s)] 'xetla-log-goto-summary)
- (define-key map [(control ?c) (control ?b)] 'xetla-log-goto-body)
- (define-key map [(control ?c) (control ?k)] 'xetla-log-edit-keywords)
- (define-key map "\t" 'xetla-log-edit-next-field)
- map)
- "Keymap used in `xetla-log-edit-mode' buffers.")
-
-;;
-;; Archive list mode
-;;
-(defvar xetla-archive-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map (xetla-prefix-kill-ring ?a) 'xetla-save-archive-to-kill-ring)
- (define-key map "\C-m" 'xetla-archive-list-categories)
- (define-key map [return] 'xetla-archive-list-categories)
-
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
-
- (define-key map xetla-keyvec-add-bookmark 'xetla-bookmarks-add)
- (define-key map [?o] 'xetla-archive-browse-archive)
- (define-key map [?*] 'xetla-archive-select-default)
- (define-key map (xetla-prefix-add ?r) 'xetla-register-archive)
- (define-key map (xetla-prefix-add ?a) 'xetla-make-archive)
- (define-key map (xetla-prefix-add ?m) 'xetla-archive-mirror-archive)
- (define-key map xetla-keyvec-remove 'xetla-archive-unregister-archive)
- (define-key map [?g] 'xetla-archives)
- (define-key map [?s] 'xetla-archive-synchronize-archive)
- (define-key map [?e] 'xetla-archive-edit-archive-location)
- (define-key map [down] 'xetla-archive-next)
- (define-key map [up] 'xetla-archive-previous)
- (define-key map [?n] 'xetla-archive-next)
- (define-key map [?p] 'xetla-archive-previous)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in `xetla-archive-list-mode' buffers.")
-
-(defvar xetla-archive-archive-map
- (let ((map (make-sparse-keymap)))
- (define-key map [button2] 'xetla-archive-list-categories-by-mouse)
- map)
- "Keymap used archives in `xetla-archive-list-mode' buffers.")
-
-;;
-;; Category list mode
-;;
-(defvar xetla-category-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map "\C-m" 'xetla-category-list-branches)
- (define-key map [return] 'xetla-category-list-branches)
-
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
-
- (define-key map xetla-keyvec-add-bookmark 'xetla-category-bookmarks-add)
- (define-key map (xetla-prefix-apply-from-here
- xetla-key-add-bookmark) 'xetla-category-bookmarks-add-here)
- (define-key map [?^] 'xetla-archives)
- (define-key map (xetla-prefix-add ?c) 'xetla-category-make-category)
- (define-key map [?g] 'xetla-category-refresh)
- (define-key map [?s] 'xetla-category-mirror-archive)
- (define-key map [down] 'xetla-category-next)
- (define-key map [up] 'xetla-category-previous)
- (define-key map [?n] 'xetla-category-next)
- (define-key map [?p] 'xetla-category-previous)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in `xetla-category-list-mode' buffers.")
-
-(defvar xetla-category-category-map
- (let ((map (make-sparse-keymap)))
- (define-key map [button2] 'xetla-category-list-branches-by-mouse)
- map)
- "Keymap used categories in `xetla-category-list-mode' buffers.")
-
-;;
-;; Branch list mode section
-;;
-(defvar xetla-branch-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map "\C-m" 'xetla-branch-list-versions)
- (define-key map [return] 'xetla-branch-list-versions)
-
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
-
- (define-key map xetla-keyvec-parent 'xetla-branch-list-parent-category)
- (define-key map (xetla-prefix-add ?b) 'xetla-branch-make-branch)
- (define-key map [?>] 'xetla-branch-get-branch)
- (define-key map [?g] 'xetla-branch-refresh)
- (define-key map [?s] 'xetla-branch-mirror-archive)
- (define-key map [down] 'xetla-category-next)
- (define-key map [up] 'xetla-category-previous)
- (define-key map [?n] 'xetla-category-next)
- (define-key map [?p] 'xetla-category-previous)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map (xetla-prefix-apply-from-here
- xetla-key-add-bookmark) 'xetla-branch-bookmarks-add-here)
- (define-key map xetla-keyvec-add-bookmark 'xetla-branch-bookmarks-add)
- map)
- "Keymap used in `xetla-branch-list-mode' buffers.")
-
-(defvar xetla-branch-branch-map
- (let ((map (make-sparse-keymap)))
- (define-key map [button2] 'xetla-branch-list-versions-by-mouse)
- map)
- "Keymap used branches in `xetla-branch-list-mode' buffers.")
-
-;;
-;; Version list mode
-;;
-(defvar xetla-version-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map "\C-m" 'xetla-version-list-revisions)
- (define-key map [return] 'xetla-version-list-revisions)
-
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
-
- (define-key map xetla-keyvec-parent 'xetla-version-list-parent-branch)
- (define-key map (xetla-prefix-add ?v) 'xetla-version-make-version)
- (define-key map [?>] 'xetla-version-get-version)
- (define-key map [?g] 'xetla-version-refresh)
- (define-key map [?s] 'xetla-version-mirror-archive)
- (define-key map [down] 'xetla-category-next)
- (define-key map [up] 'xetla-category-previous)
- (define-key map [?n] 'xetla-category-next)
- (define-key map [?p] 'xetla-category-previous)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map (xetla-prefix-apply-from-here
- xetla-key-add-bookmark) 'xetla-version-bookmarks-add-here)
- (define-key map xetla-keyvec-add-bookmark 'xetla-version-bookmarks-add)
- (define-key map xetla-keyvec-tag 'xetla-version-tag)
- map)
- "Keymap used in `xetla-version-list-mode' buffers.")
-
-(defvar xetla-version-version-map
- (let ((map (make-sparse-keymap)))
- (define-key map [button2] 'xetla-version-list-revisions-by-mouse)
- map)
- "Keymap used versions in `xetla-version-list-mode' buffers.")
-
-;;
-;; Revision list mode
-;;
-(defvar xetla-revision-list-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map xetla-keyvec-parent 'xetla-revision-list-parent-version)
- (define-key map [?> ?g] 'xetla-revision-get-revision)
- (define-key map [?> ?C] 'xetla-revision-cache-revision)
- (define-key map [?> ?L] 'xetla-revision-add-to-library)
-
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
-
- (define-key map [?b] 'xetla-bookmarks-add)
- (define-key map (xetla-prefix-toggle ??) 'xetla-revision-toggle-help)
- (define-key map (xetla-prefix-toggle ?d) 'xetla-revision-toggle-date)
- (define-key map (xetla-prefix-toggle ?c) 'xetla-revision-toggle-creator)
- (define-key map (xetla-prefix-toggle ?s) 'xetla-revision-toggle-summary)
- (define-key map (xetla-prefix-toggle ?l) 'xetla-revision-toggle-library)
- (define-key map (xetla-prefix-toggle ?m) 'xetla-revision-toggle-merges)
- (define-key map (xetla-prefix-toggle ?b) 'xetla-revision-toggle-merged-by)
- (define-key map (xetla-prefix-toggle ?r) 'xetla-revision-toggle-reverse)
-
- ;;
- ;; Star merge
- ;; from here
- (define-key map (xetla-prefix-apply-from-here
- xetla-key-star-merge) 'xetla-revision-star-merge)
- ;; from head
- (define-key map (xetla-prefix-apply-from-head xetla-key-star-merge)
- 'xetla-revision-star-merge-version)
- (define-key map (xetla-prefix-merge xetla-key-star-merge)
- 'xetla-revision-star-merge-version)
- (define-key map xetla-keyvec-star-merge 'xetla-revision-star-merge-version)
-
- ;;
- ;; Replay
- ;; from here
- (define-key map (xetla-prefix-apply-from-here xetla-key-replay)
- 'xetla-revision-replay)
- ;; from head
- (define-key map (xetla-prefix-apply-from-head xetla-key-replay)
- 'xetla-revision-replay-version)
- (define-key map xetla-keyvec-replay 'xetla-revision-replay-version)
-
- (define-key map (xetla-prefix-apply-from-here ?y)
- 'xetla-revision-sync-tree)
- ;;
- ;; Update
- (define-key map (xetla-prefix-merge xetla-key-update)
- 'xetla-revision-update)
- ;;
- ;; Tag
- ;; from here
- (define-key map (xetla-prefix-apply-from-here
- xetla-key-tag) 'xetla-revision-tag-from-here)
-
- (define-key map (xetla-prefix-tag
- xetla-key-apply-from-here) 'xetla-revision-tag-from-here)
- ;; from head
- (define-key map (xetla-prefix-apply-from-head
- xetla-key-tag) 'xetla-revision-tag-from-head)
- (define-key map (xetla-prefix-tag
- xetla-key-apply-from-head) 'xetla-revision-tag-from-head)
-
- (define-key map [?g] 'xetla-generic-refresh)
- (define-key map [down] 'xetla-revision-next)
- (define-key map [up] 'xetla-revision-prev)
- (define-key map [?n] 'xetla-revision-next)
- (define-key map [?p] 'xetla-revision-prev)
- (define-key map [?N] 'xetla-revision-next-unmerged)
- (define-key map [?P] 'xetla-revision-prev-unmerged)
- (define-key map [?l] 'xetla-revision-cat-log)
- (define-key map "\C-m" 'xetla-revision-show-changeset)
- (define-key map [return] 'xetla-revision-show-changeset)
- (define-key map xetla-keyvec-mark 'xetla-revision-mark-revision)
- (define-key map xetla-keyvec-unmark 'xetla-revision-unmark-revision)
- (define-key map (xetla-prefix-diff xetla-key-diff) 'xetla-revision-delta)
- (define-key map (xetla-prefix-diff xetla-key-get) 'xetla-revision-store-delta)
- (define-key map [?=] 'xetla-revision-changeset)
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
- (define-key map xetla-keyvec-inventory 'xetla-pop-to-inventory)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map xetla-keyvec-add-bookmark 'xetla-revision-bookmarks-add)
- map)
- "Keymap used in `xetla-revision-list-mode' buffers.")
-
-(defstruct (xetla-revision)
- revision ;; The revision, as a list
- summary creator date
- merges ;; List of patches merged by this revision
- merged-by ;; List of patches merging this revision
- )
-
-(defvar xetla-revision-revision-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-revision-show-changeset-by-mouse)
- map)
- "Keymap used on revisions in `xetla-revision-list-mode' buffers.")
-
-;;
-;; Changes mode
-;;
-(defvar xetla-changes-mode-map
- (let ((map (copy-keymap diff-mode-shared-map)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map "\C-m" 'xetla-changes-jump-to-change)
- (define-key map [return] 'xetla-changes-jump-to-change)
- (define-key map [?=] 'xetla-changes-diff)
- (define-key map xetla-keyvec-ediff 'xetla-changes-ediff)
- (define-key map xetla-keyvec-refresh 'xetla-generic-refresh)
- (define-key map xetla-keyvec-commit 'xetla-changes-edit-log)
- (define-key map [?I] 'xetla-inventory)
- (define-key map xetla-keyvec-inventory 'xetla-pop-to-inventory)
- (define-key map xetla-keyvec-next 'xetla-changes-next)
- (define-key map xetla-keyvec-previous 'xetla-changes-prev)
- (define-key map xetla-keyvec-revert 'xetla-changes-revert)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map [?d] 'xetla-changes-rm)
- (define-key map xetla-keyvec-mark 'xetla-changes-mark-file)
- (define-key map xetla-keyvec-unmark 'xetla-changes-unmark-file)
- (define-key map [?v] 'xetla-changes-view-source)
- (define-key map xetla-keyvec-parent 'xetla-changes-master-buffer)
- (define-key map [?j] 'xetla-changes-diff-or-list)
- ;; Buffers group
- (define-key map (xetla-prefix-buffer ?p) 'xetla-show-process-buffer)
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
- (define-key map (xetla-prefix-buffer xetla-key-show-bookmark) 'xetla-bookmarks)
- map)
- "Keymap used in `xetla-changes-mode'.")
-
-(defvar xetla-changes-file-map
- (let ((map (copy-keymap xetla-context-map-template)))
- (define-key map [button2] 'xetla-changes-jump-to-change-by-mouse)
- map)
- "Keymap used on files in `xetla-changes-mode' buffers.")
-
-
-;;
-;; ChangeLog mode section
-;;
-(defvar xetla-changelog-mode-map
- (let ((map (copy-keymap change-log-mode-map)))
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in `xetla-changelog-mode'.")
-
-
-;;
-;; Log buffer mode section
-;;
-(defvar xetla-log-buffer-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-help 'describe-mode)
- (define-key map [?o] 'xetla-switch-to-output-buffer)
- (define-key map "\C-m" 'xetla-switch-to-output-buffer)
- (define-key map [?e] 'xetla-switch-to-error-buffer)
- (define-key map [?r] 'xetla-switch-to-related-buffer)
- (define-key map [?n] 'xetla-log-next)
- (define-key map [?p] 'xetla-log-prev)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in XEtla's log buffer.")
-
-;;
-;; Process buffer mode section
-;;
-(defvar xetla-process-buffer-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map (xetla-prefix-buffer ?L) 'xetla-open-internal-log-buffer)
-
- (define-key map xetla-keyvec-inventory 'xetla-show-inventory-buffer)
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- map)
- "Keymap used in XEtla's log buffer.")
-
-;;
-;; Log edit buffer mode section
-;;
-
-(defvar xetla-log-edit-keywords-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map [?n] 'xetla-log-edit-keywords-next)
- (define-key map [?p] 'xetla-log-edit-keywords-previous)
- (define-key map [?m] 'xetla-log-edit-keywords-mark)
- (define-key map [?u] 'xetla-log-edit-keywords-unmark)
- (define-key map [?t] 'xetla-log-edit-keywords-toggle-mark)
- (define-key map [?* ?!] 'xetla-log-edit-keywords-unmark-all)
- (define-key map [?* ?*] 'xetla-log-edit-keywords-mark-all)
- (define-key map "\C-c\C-c" 'xetla-log-edit-keywords-insert)
- map)
- "Keymap used in xetla-log-edit-keywords-mode buffers.")
-
-\f
-;; --------------------------------------
-;; Menu entries
-;; --------------------------------------
-;;
-;; Conventions
-;;
-;; 1. Each Nouns and verbs in menu items are should be capitalized.
-;; 2. TODO: Consider menu items order.
-
-;;
-;; Common submenus
-;;
-
-(defconst xetla-.arch-inventory-menu-list
- '("Put to .arch-inventory"
- ["Junk" xetla-generic-add-to-junk t]
- ["Backup" xetla-generic-add-to-backup t]
- ["Precious" xetla-generic-add-to-precious t]
- ["Unrecognized" xetla-generic-add-to-unrecognized t]))
-
-(defconst xetla-=tagging-method-menu-list
- '("Put to =tagging-method"
- ["Junk" (xetla-generic-add-to-junk t) t]
- ["Backup" (xetla-generic-add-to-backup t) t]
- ["Precious" (xetla-generic-add-to-precious t) t]
- ["Unrecognized" (xetla-generic-add-to-junk t) t]))
-
-
-;;
-;; Global
-;;
-
-(easy-menu-add-item
- (or (xetla-do-in-gnu-emacs menu-bar-tools-menu) nil)
- (or (xetla-do-in-xemacs '("Tools")) nil)
- '("XEtla"
- ["Browse Archives" xetla-archives t]
- ["Show Bookmarks" xetla-bookmarks t]
- ["Start New Project" xetla-start-project t]
- "--"
- "Tree Commands:"
- ["View Changes" xetla-changes t]
- ["View Inventory" xetla-inventory t]
- ["View Tree Lint" xetla-tree-lint t]
- ["Show Tree Revisions" xetla-tree-revisions t]
- ["Edit Arch Log" xetla-edit-log t]
- "--"
- "File Commands:"
- ["Insert Arch Tag" xetla-tag-insert t]
- ["Add Log Entry" xetla-add-log-entry t]
- ["View File Diff" xetla-file-diff t]
- ["View File Ediff" xetla-file-ediff t]
- ["View Original" xetla-file-view-original t]
- ["View Conflicts" xetla-view-conflicts t]
- "--"
- ("Quick Configuration"
- ["Three Way Merge" xetla-toggle-three-way-merge
- :style toggle :selected xetla-three-way-merge]
- ["Use --forward" xetla-toggle-use-forward-option
- :style toggle :selected xetla-use-forward-option]
- ["Use --skip-present" xetla-toggle-use-skip-present-option
- :style toggle :selected xetla-use-skip-present-option]
- )
- )
- "PCL-CVS")
-
-;;
-;; Bookmarks mode
-;;
-(defconst xetla-bookmarks-entry-menu-list
- '("Bookmark Entry"
- ["Delete" xetla-bookmarks-delete t]
- ["Goto Location" xetla-bookmarks-goto t]
- ("File Tree"
- ["Find File" xetla-bookmarks-find-file t]
- ["Run Dired" xetla-bookmarks-open-tree t]
- ["Run Inventory" xetla-bookmarks-inventory t]
- ["View Changes" xetla-bookmarks-changes t]
- )
- ("Merge"
- ["View Missing Patches" xetla-bookmarks-missing t]
- ["Replay" xetla-bookmarks-replay t]
- ["Update" xetla-bookmarks-update t]
- ["Star-merge" xetla-bookmarks-star-merge t]
- )
- ("Edit"
- ["Edit Bookmark" xetla-bookmarks-edit t]
- ["Add Nickname" xetla-bookmarks-add-nickname-interactive t]
- ["Remove Nickname" xetla-bookmarks-delete-nickname-interactive t]
- ["Add Local Tree" xetla-bookmarks-add-tree-interactive t]
- ["Remove Local Tree" xetla-bookmarks-delete-tree-interactive t]
- ["Add Group" xetla-bookmarks-add-group-interactive t]
- ["Remove Group" xetla-bookmarks-delete-group-interactive t]
- ["Add Partner" xetla-bookmarks-add-partner-interactive t]
- ["Remove Partner" xetla-bookmarks-delete-partner-interactive t]
- )
- ("Partners"
- ["Add Partner" xetla-bookmarks-add-partner-interactive t]
- ["Remove Partner" xetla-bookmarks-delete-partner-interactive t]
- ["Write to Partner File" xetla-bookmarks-write-partners-to-file t]
- ["Load from Partner File" xetla-bookmarks-add-partners-from-file t]
- ["View Missing Patches" xetla-bookmarks-missing t]
- ))
- "Used both for the local and the global menu."
- )
-
-(easy-menu-define xetla-bookmarks-mode-menu xetla-bookmarks-mode-map
- "`xetla-bookmarks-mode' menu"
- `("XEtla-Bookmarks"
- ["Add Bookmark" xetla-bookmarks-add t]
- ["Show Details" xetla-bookmarks-toggle-details
- :style toggle :selected xetla-bookmarks-show-details]
- ["Select by Group" xetla-bookmarks-select-by-group t]
- ["Cleanup 'local-tree fields" xetla-bookmarks-cleanup-local-trees t]
- ,xetla-bookmarks-entry-menu-list
- ))
-
-(easy-menu-define xetla-bookmarks-entry-menu nil
- "Menu used on a xetla bookmark entry."
- xetla-bookmarks-entry-menu-list)
-
-;;
-;; Inventory mode
-;;
-(easy-menu-define xetla-inventory-mode-partners-menu xetla-inventory-mode-map
- "`xetla-inventory-mode' partners menu"
- '("Partners"
- ["Add Partner..." xetla-partner-add t]
- ("Set Tree Version" :filter (lambda (x)
- (xetla-partner-create-menu
- 'xetla-generic-set-tree-version)))
- "--"
- ("Show Changes" :filter (lambda (x)
- (xetla-partner-create-menu
- '(lambda (x)
- (xetla-changes current-prefix-arg
- (list 'revision (xetla-name-split x)))))))
- ("Show Missing" :filter (lambda (x)
- (xetla-partner-create-menu
- '(lambda (x)
- (xetla-missing default-directory x)))))
- "--"
- ("Replay" :filter (lambda (x)
- (xetla-partner-create-menu
- 'xetla-inventory-replay)))
- ("Star-merge" :filter (lambda (x)
- (xetla-partner-create-menu
- 'xetla-inventory-star-merge)))))
-
-(defconst xetla-inventory-item-menu-list
- `("Inventory Item"
- ["Open File" xetla-inventory-find-file t]
- ["Redo" xetla-inventory-redo (xetla-inventory-maybe-undo-directory)]
- "--"
- ["Add" xetla-inventory-add-files t]
- ["Move" xetla-inventory-move t]
- ["Remove" xetla-inventory-remove-files t]
- ["Delete" xetla-inventory-delete-files t]
- "--"
- ["Make Junk" xetla-inventory-make-junk t]
- ["Make Precious" xetla-inventory-make-precious t]
- ,xetla-.arch-inventory-menu-list
- ,xetla-=tagging-method-menu-list)
- "Used both in the context and the global menu for inventory.")
-
-(easy-menu-define xetla-inventory-mode-menu xetla-inventory-mode-map
- "`xetla-inventory-mode' menu"
- `("Inventory"
- ["Edit Log" xetla-inventory-edit-log t]
- "--"
- ["Show Changes" xetla-inventory-changes t]
- ["Show Changelog" xetla-changelog t]
- ["Show Logs" xetla-logs t]
- ["Show Missing" xetla-inventory-missing t]
- "--"
- ,xetla-inventory-item-menu-list
- "--"
- ["Update" xetla-inventory-update t]
- ["Replay" xetla-inventory-replay t]
- ["Star-merge" xetla-inventory-star-merge t]
- ("Changesets"
- ["Save actual changes in directory" xetla-changes-save t]
- ["Save actual changes in tarball" xetla-changes-save-as-tgz t]
- ["View changeset from directory" xetla-show-changeset t]
- ["View changeset from tarball" xetla-show-changeset-from-tgz t]
- ["Apply changeset from directory" xetla-inventory-apply-changeset t]
- ["Apply changeset from tarball" xetla-inventory-apply-changeset-from-tgz t]
- )
- "--"
- ["Undo" xetla-inventory-undo t]
- ["Redo" xetla-inventory-redo t]
- "--"
- ["Synchronize Mirror" xetla-inventory-mirror t]
- ("Taging Method"
- ["Edit .arch-inventory" xetla-edit-.arch-inventory-file t]
- ["Edit =tagging-method" xetla-edit-=tagging-method-file t]
- ["Set Tagging Method" xetla-generic-set-id-tagging-method t]
- ["Set Tree Version From Scratch" xetla-generic-set-tree-version t]
- )
- ["Tree-lint" xetla-tree-lint t]
- "--"
- ("Toggles"
- ["Set All Toggle Variables" xetla-inventory-set-all-toggle-variables t]
- ["Reset All Toggle Variables" xetla-inventory-reset-all-toggle-variables t]
- ["Toggle All Toggle Variables" xetla-inventory-toggle-all-toggle-variables t] .
- ,(mapcar '(lambda (elem) `[,(concat "Toggle " (car (cddddr elem)))
- ,(caddr elem)
- :style toggle
- :selected ,(cadr elem)])
- xetla-inventory-file-types-manipulators))))
-
-(easy-menu-define xetla-inventory-item-menu nil
- "Menu used on a inventory item."
- xetla-inventory-item-menu-list)
-
-(easy-menu-define xetla-inventory-tagging-method-menu nil
- "Menu used on the taggine method line in a inventory buffer."
- '("Switch Taggine Method"
- ["Tagline" (xetla-generic-set-id-tagging-method "tagline") t]
- ["Explicit" (xetla-generic-set-id-tagging-method "explicit") t]
- ["Names" (xetla-generic-set-id-tagging-method "names") t]
- ["Implicit" (xetla-generic-set-id-tagging-method "implicit") t]))
-
-;;
-;; Cat-log mode
-;;
-(easy-menu-define xetla-cat-log-mode-menu xetla-cat-log-mode-map
- "'xetla-cat-log-mode' menu"
- '("Cat-Log"
- ["Inventory" xetla-pop-to-inventory t]
- ["Quit" xetla-buffer-quit t]
- ))
-
-;;
-;; Log edit mode
-;;
-(easy-menu-define xetla-log-edit-mode-menu xetla-log-edit-mode-map
- "`xetla-log-edit-mode' menu"
- '("Log"
- ["Insert xetla log-for-merge" xetla-log-edit-insert-log-for-merge t]
- ["log-for-merge and headers"
- xetla-log-edit-insert-log-for-merge-and-headers t]
- ["Insert memorized log" xetla-log-edit-insert-memorized-log t]
- ["Show changes" xetla-changes t]
- ["Commit" xetla-log-edit-done t]
- ["Show Changelog" xetla-changelog t]
- ["Goto Summary Field" xetla-log-goto-summary t]
- ["Goto Body" xetla-log-goto-body t]
- ["Edit Keywords Field" xetla-log-edit-keywords t]
- ["Kill Body" xetla-log-kill-body t]
- ["Tree Lint" xetla-tree-lint t]
- ["Abort" xetla-log-edit-abort t]))
-
-;;
-;; Archive list mode
-;;
-(easy-menu-define xetla-archive-list-mode-menu xetla-archive-list-mode-map
- "`xetla-archive-list-mode' menu"
- '("Archives"
- ["Register New Archive" xetla-register-archive t]
- ["Add a Bookmark" xetla-bookmarks-add t]
- ["Update Archives List" xetla-archives t]
- ["Set Default Archive" xetla-archive-select-default t]
- ["Remove Archive Registration" xetla-archive-unregister-archive t]
- ["Edit Archive Location" xetla-archive-edit-archive-location t]
- ["Make New Archive..." xetla-make-archive t]
- ["Create a Mirror" xetla-archive-mirror-archive t]
- ["Use as default Mirror" xetla-archive-use-as-default-mirror t]
- ["Synchronize Mirror" xetla-archive-synchronize-archive t]
- ))
-
-;;
-;; Category list mode
-;;
-(easy-menu-define xetla-category-list-mode-menu xetla-category-list-mode-map
- "`xetla-category-list-mode' menu"
- '("Categories"
- ["List Archives" xetla-archives t]
- ["Update Categories List" xetla-category-refresh t]
- ["Make New Category..." xetla-category-make-category t]
- ["Add a Bookmark" xetla-bookmarks-add t]
- ["Synchronize Mirror" xetla-category-mirror-archive t]
- ))
-
-
-;;
-;; Branch list mode
-;;
-(easy-menu-define xetla-branch-list-mode-menu xetla-branch-list-mode-map
- "`xetla-branch-list-mode' menu"
- '("Branches"
- ["Update Branches List" xetla-branch-refresh t]
- ["List Parent Category" xetla-branch-list-parent-category t]
- ["Make New Branch..." xetla-branch-make-branch t]
- ["Synchronize Mirror" xetla-branch-mirror-archive t]
- ["Bookmark Branch under Point" xetla-branch-bookmarks-add t]
- ["Get..." xetla-branch-get-branch t]
- ))
-
-;;
-;; Version list mode
-;;
-(easy-menu-define xetla-version-list-mode-menu xetla-version-list-mode-map
- "`xetla-version-list-mode' menu"
- '("Versions"
- ["Update Versions List" xetla-version-refresh t]
- ["Get..." xetla-version-get-version t]
- ["Make New Version..." xetla-version-make-version t]
- ["List Parent Branch" xetla-version-list-parent-branch t]
- ["Synchronize Mirror" xetla-version-mirror-archive t]
- ["Bookmark Version under Point" xetla-version-bookmarks-add t]
- ["Tag This Version" xetla-version-tag t]))
-
-;;
-;; Revision list mode
-;;
-(easy-menu-define xetla-revision-list-mode-menu xetla-revision-list-mode-map
- "`xetla-revision-list-mode' menu"
- '("Revisions"
- ["Refresh Revisions List" xetla-generic-refresh t]
- ["List Parent Version" xetla-revision-list-parent-version t]
- "--"
- ["Bookmark Revision under Point" xetla-revision-bookmarks-add t]
- ("Mark"
- ["Mark Revision" xetla-revision-mark-revision t]
- ["Unmark Revision" xetla-revision-unmark-revision t])
- "--"
- ["Show Log" xetla-revision-cat-log t]
- ["Unify Patch Logs with This Revision" xetla-revision-sync-tree t]
- ["View changeset" xetla-revision-changeset t]
- ("Delta"
- ["View" (xetla-revision-delta t) t]
- ["Store to Directory" (xetla-revision-store-delta t) t])
- "--"
- ["Update" xetla-revision-update t]
- ("Replay"
- ["From Head Revision" xetla-revision-replay-version t]
- ["From Revision under Point" xetla-revision-replay t])
- ("Star-Merge"
- ["From Head Revision" xetla-revision-star-merge-version t]
- ["From Revision under Point" xetla-revision-star-merge t])
- ("Get"
- ["Get a Local Copy" xetla-revision-get-revision t]
- ["Make Cache" xetla-revision-cache-revision t]
- ["Add to Library" xetla-revision-add-to-library t])
- ("Tag "
- ["From Head Revision" xetla-revision-tag-from-head t]
- ["From Revision under Point" xetla-revision-tag-from-here t])
- ["Send comment to author" xetla-revision-send-comments t]
- "--"
- ("Filter Display"
- ["Date" xetla-revision-toggle-date
- :style toggle :selected xetla-revisions-shows-date]
- ["Creator" xetla-revision-toggle-creator
- :style toggle :selected xetla-revisions-shows-creator]
- ["Summary" xetla-revision-toggle-summary
- :style toggle :selected xetla-revisions-shows-summary]
- ["Presence in Revlib" xetla-revision-toggle-library
- :style toggle :selected xetla-revisions-shows-library]
- ["Merged Patches" xetla-revision-toggle-merges
- :style toggle :selected xetla-revisions-shows-merges]
- ["Patches Merging ..." xetla-revision-toggle-merged-by
- :style toggle :selected xetla-revisions-shows-merged-by])))
-
-(easy-menu-define xetla-revision-revision-menu nil
- "Menu used on a revision item in `xetla-revision-list-mode' buffer"
- '("Revision"
- ["Show Log" xetla-revision-cat-log t]
- ["Unify Patch Logs with This Revision" xetla-revision-sync-tree t]
- ["View changeset" xetla-revision-changeset t]
- ["Set Bookmark" xetla-revision-bookmarks-add t]
- ("Mark"
- ["Mark Revision" xetla-revision-mark-revision t]
- ["Unmark Revision" xetla-revision-unmark-revision t])
- ("Delta"
- ["In This Version" xetla-revision-delta t]
- ["With Revision in Another Archive" xetla-revision-store-delta t])
- ("Merge"
- ["Star-Merge" xetla-revision-star-merge t]
- ["Replay" xetla-revision-replay t])
- ("Get"
- ["Get a Local Copy" xetla-revision-get-revision t]
- ["Make Cache" xetla-revision-cache-revision t]
- ["Add to Library" xetla-revision-add-to-library t])
- ["Send comment to author" xetla-revision-send-comments t]
- ["Tag from Here" xetla-revision-tag-from-here]))
-
-;;
-;; Changes mode
-;;
-(defconst xetla-changes-file-menu-list
- '("File Changes"
- ["Jump to File" xetla-changes-jump-to-change t]
- ["Jump to Diffs" xetla-changes-diff-or-list t]
- ["View Diff in Separate Buffer" xetla-changes-diff t]
- ["View Diff with Ediff" xetla-changes-ediff t]
- "--"
- ["Delete File" xetla-changes-rm t]
- ["Revert File" xetla-changes-revert t]
- )
- "Used both in the global and the context menu of `xetla-changes-mode'.")
-
-(easy-menu-define xetla-changes-mode-menu xetla-changes-mode-map
- "`xetla-changes' menu"
- `("Changes"
- ["Refresh Buffer" xetla-generic-refresh t]
- ["Edit log before commit" xetla-changes-edit-log t]
- ["View other revisions" xetla-tree-revisions t]
- ,xetla-changes-file-menu-list
- ))
-
-(easy-menu-define xetla-changes-file-menu nil
- "Menu used on a `xetla-changes' file"
- xetla-changes-file-menu-list)
-
-;;
-;; Lint mode
-;;
-(defconst xetla-tree-lint-file-menu-list
- `("File"
- ["Jump to File" xetla-generic-find-file-at-point t]
- ("Mark"
- ["Mark File" xetla-tree-lint-mark-file t]
- ["Unmark File" xetla-tree-lint-unmark-file t])
- "--"
- ["Add File" xetla-tree-lint-add-files t]
- ["Delete File" xetla-tree-lint-delete-files t]
- ["Regenerate ID" xetla-tree-lint-regenerate-id t]
- "--"
- ["Make Junk" xetla-tree-lint-make-junk t]
- ["Make Precious" xetla-tree-lint-make-precious t]
- ,xetla-.arch-inventory-menu-list
- ,xetla-=tagging-method-menu-list
- )
- "Used both for context and global menu.")
-
-(easy-menu-define xetla-tree-lint-file-menu nil
- "Menu used on files listed in `xetla-tree-lint'"
- xetla-tree-lint-file-menu-list
- )
-
-(easy-menu-define xetla-tree-lint-mode-menu xetla-tree-lint-mode-map
- "`xetla-tree-lint' menu"
- `("Tree Lint"
- ["Refresh Buffer" xetla-generic-refresh t]
- ,xetla-tree-lint-file-menu-list
- ))
-
-;;
-;; Event Log buffer
-;;
-(easy-menu-define xetla-log-buffer-mode-menu xetla-log-buffer-mode-map
- "`xetla-log-buffer' menu"
- '("Logs"
- ["Show Related Buffer" xetla-switch-to-related-buffer t]
- ["Show Output Buffer" xetla-switch-to-output-buffer t]
- ["Show Error Buffer" xetla-switch-to-error-buffer t]
- ))
-
-\f
-;; --------------------------------------
-;; User customization section
-;; --------------------------------------
-
-
-(defgroup xetla nil
- "Arch interface for emacs."
- :group 'tools
- :prefix "xetla-")
-
-
-(defgroup xetla-inventory nil
- "This group contains items used in inventory mode."
- :group 'xetla)
-
-
-(defgroup xetla-revisions nil
- "This group contains items used in revisions mode."
- :group 'xetla)
-
-
-(defgroup xetla-file-actions nil
- "This group contains items manipulating finding, saving and reverting files."
- :group 'xetla)
-
-
-(defgroup xetla-bindings nil
- "This group contains items related to key bindings."
- :group 'xetla)
-
-
-(defgroup xetla-faces nil
- "This group contains faces defined for Xetla."
- :group 'xetla)
-
-
-(defcustom xetla-prefix-key [(control x) ?T]
- "Prefix key for most xetla commands."
- :type '(choice (const [(control x) ?T])
- (const [(control x) ?t])
- (const [(control x) ?v])
- (const [(control x) ?V])
- (const [(control x) ?v ?t])
- (sexp))
- :group 'xetla-bindings
- :set (lambda (var value)
- (if (boundp var)
- (global-unset-key (symbol-value var)))
- (set var value)
- (global-set-key (symbol-value var) xetla-global-keymap)))
-
-
-(global-set-key xetla-prefix-key xetla-global-keymap)
-
-
-(defcustom xetla-tla-executable "tla"
- "*The name of the xetla executable."
- :type 'string
- :group 'xetla)
-
-
-(defcustom xetla-diff-executable "diff"
- "*The name of the diff executable."
- :type 'string
- :group 'xetla)
-
-
-(defcustom xetla-patch-executable "patch"
- "*The name of the patch executable."
- :type 'string
- :group 'xetla)
-
-
-(defcustom xetla-highlight t
- "*Use highlighting for XEtla buffers."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-install-command-help-system t
- "*Use f1 to display help for the actual function call during minibuffer input.
-Note: this functionality is provided for all minibuffer prompts."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-do-not-prompt-for-save nil
- "*Whether or not xetla will prompt before saving.
-
-If non nil, xetla will not prompt you before saving buffers of the
-working local tree."
- :type 'boolean
- :group 'xetla-file-actions)
-
-
-(defcustom xetla-automatically-revert-buffers t
- "*Whether or not xetla will automatically revert buffers.
-
-If non nil, xetla will automatically revert unmodified buffers after an
-arch operation modifying the file."
- :type 'boolean
- :group 'xetla-file-actions)
-
-
-(defcustom xetla-changes-recursive t
- "*Whether or not xetla will compute changes recursively.
-
-If non nil, `xetla-changes' will be applied recursively to subprojects
-of the current tree"
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-strict-commits nil
- "*If non-nil, commit operations are invoked with the -strict option."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-commit-check-log-buffer-functions
- '(xetla-commit-check-empty-headers
- xetla-commit-check-empty-line
- xetla-commit-check-missing-space)
- "*List of functions to check the ++log.. buffer.
-
-Each function is called, from the log buffer, with no argument. It
-should raise an error if commit should be canceled."
- :type 'hook
- :group 'xetla)
-
-
-(defcustom xetla-commit-headers-allowed-to-be-empty
- "^\\(Keywords\\)$"
- "*Headers allowed to be empty in the ++log.. buffer.
-
-This should be a regexp matching the header names. Headers not
-matching this regexp should not be empty when committing."
- :type 'string
- :group 'xetla)
-
-
-(defcustom xetla-commit-fix-missing-space t
- "*Whether or not xetla will add missing spaces after header names.
-
-If non-nil, missing spaces after a space will be inserted
-automatically instead of raising an error when committing."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-three-way-merge t
- "*If non-nil, star-merge operations are invoked with -three-way."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-use-forward-option nil
- "*If non-nil, use the -forward option with commands that allow it."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-use-skip-present-option nil
- "*If non-nil, use -skip-present with commands that allow it."
- :type 'boolean
- :group 'xetla)
-
-
-(defun xetla-toggle-use-forward-option ()
- "Toggle the value of `xetla-use-forward-option'."
- (interactive)
- (setq xetla-use-forward-option (not xetla-use-forward-option)))
-
-
-(defun xetla-toggle-use-skip-present-option ()
- "Toggle the value of `xetla-use-skip-present-option'."
- (interactive)
- (setq xetla-use-skip-present-option
- (not xetla-use-skip-present-option)))
-
-
-(defun xetla-toggle-three-way-merge ()
- "Toggle the value of `xetla-three-way-merge'."
- (interactive)
- (setq xetla-three-way-merge (not xetla-three-way-merge)))
-
-
-(defgroup xetla-bookmarks nil
- "xetla bookmarks allows you to save places (archive, category,
-branch, version) in the archive that you use often. Try M-x
-xetla-bookmarks RET to see."
- :group 'xetla)
-
-
-(defcustom xetla-bookmarks-file-name "bookmarks.el"
- "*File in which xetla bookmarks will be saved.
-The bookmark file is stored in the `xetla-config-directory'"
- :type 'file
- :group 'xetla-bookmarks)
-
-
-(defcustom xetla-tag-function 'xetla-tag-uuid
- "Function called to generate the value of the arch-tag.
-
-The function must take no argument, and return a string without a
-final newline."
- :type '(choice (const xetla-tag-uuid)
- (const xetla-tag-name-date-filename)
- function)
- :group 'xetla)
-
-
-(defcustom xetla-config-directory "~/.xetla/"
- "*Directory in which the xetla config files will be stored."
- :type 'directory
- :group 'xetla)
-
-
-(defcustom xetla-log-library "~/.arch-log-library/"
- "*Directory in which the log library will be stored."
- :type 'directory
- :group 'xetla-internal)
-
-
-(defcustom xetla-log-library-greedy t
- "*Whether log files are automatically saved in the log library.
-
-If non-nil, then, whenever xetla needs to access a log file, this file
-will be copied to the log library."
- :type 'boolean
- :group 'xetla-internal)
-
-
-(defcustom xetla-cache-xetla-get-changeset 2
- "*Cache `xetla-get-changeset' calls.
-When nil, don't cache.
-When a number, cache only if the `xetla-get-changeset' call takes
-more seconds than the number.
-Otherwise don't cache the results.
-The cache is kept only in RAM."
- :type 'integer
- :group 'xetla)
-
-
-(defcustom xetla-bookmarks-cleanup-dont-prompt nil
- "*Whether xetla should prompt before cleaning a local tree.
-
-non nil means `xetla-bookmarks-cleanup-local-trees' shouldn't prompt
-before removing a local-tree"
- :type 'boolean
- :group 'xetla-bookmarks)
-
-
-(defgroup xetla-internal nil
- "This group contains items used mainly for debugging."
- :group 'xetla)
-
-
-(defcustom xetla-log-commands t
- "*Non nil means log all xetla commands in the buffer *xetla-log*."
- :type 'boolean
- :group 'xetla-internal)
-
-
-(defcustom xetla-log-buffer " *xetla-log*"
- "*Name of the buffer in which xetla logs main events."
- :type 'string
- :group 'xetla-internal)
-
-
-(defcustom xetla-switch-to-buffer-mode 'pop-to-buffer
- "*Mode for switching to xetla buffers.
-Recommended settings are: 'pop-to-buffer, and 'show-in-other-window
-and 'single-window"
- :type '(choice (const pop-to-buffer)
- (const single-window)
- (const dedicated-frame)
- (const show-in-other-window))
- :group 'xetla)
-
-(defcustom xetla-switch-to-changes-buffer nil
- "Switch to the changes buffer or stay in the current buffer."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-read-project-tree-mode 'sometimes
- "*Mode for prompting project tree directories. Possible values are:
-
-- always: When running a tla command requiring a tree, always prompt
- for it.
-
-- sometimes: If a command is ran inside a project tree, the tree root
- is used. Otherwise, prompt.
-
-- never: If a command is run inside a project tree, use the tree root.
- Othwise, raise an error."
- :type '(choice (const always)
- (const sometimes)
- (const never))
- :group 'xetla)
-
-
-(defcustom xetla-read-directory-mode 'sometimes
- "*How prompting project directories should be done.
-
-Works similarly to `xetla-read-project-tree-mode', but this one is used
-for commands like `xetla-inventory' for which a subdirectory of a
-project tree is accepted."
- :type '(choice (const always)
- (const sometimes)
- (const never))
- :group 'xetla)
-
-
-(defcustom xetla-switch-to-buffer-first t
- "*Switch to newly created buffer on creation of buffers?
-
-If non-nil, xetla commands implementing this feature will switch to the
-newly created buffer when the command is called. Further (potentially
-asynchronous) processes are run without modifying your
-window-configuration. Otherwise, xetla will switch to the new buffer on
-command completion."
- :type 'boolean
- :group 'xetla)
-
-
-(defcustom xetla-buffer-quit-mode 'kill
- "*How *xetla-...* buffer should be killed.
-If the value is 'kill, buffers are actually killed. Otherwise, just
-burry them."
- :type '(choice (const kill)
- (const burry))
- :group 'xetla)
-
-
-(defcustom xetla-log-insert-last t
- "*If non-nil, insert changelog entries at the end of the log file."
- :type 'boolean
- :group 'xetla)
-
-
-(defgroup xetla-hooks nil
- "This group contains hooks into xetla."
- :prefix "xetla-"
- :group 'xetla)
-
-
-(defcustom xetla-archive-list-mode-hook nil
- "*Hooks run after switching to `xetla-archive-list-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-bookmarks-mode-hook nil
- "*Hooks run after switching to `xetla-bookmarks-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-branch-list-mode-hook nil
- "*Hooks run after switching to `xetla-branch-list-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-cat-log-mode-hook nil
- "*Hooks run after switching to `xetla-cat-log-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-category-list-mode-hook nil
- "*Hooks run after switching to `xetla-category-list-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-inventory-file-mode-hook nil
- "*Hooks run after switching to `xetla-inventory-file-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-inventory-mode-hook nil
- "*Hooks run after switching to `xetla-inventory-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-log-edit-mode-hook nil
- "*Hooks run after switching to `xetla-log-edit-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-logs-mode-hook nil
- "*Hooks run after switching to `xetla-logs-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-revision-list-mode-hook nil
- "*Hooks run after switching to `xetla-revision-list-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-version-list-mode-hook nil
- "*Hooks run after switching to `xetla-version-list-mode'."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-make-branch-hook nil
- "*Hooks run after making a branch."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-make-category-hook nil
- "*Hooks run after making a category."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-make-version-hook nil
- "*Hooks run after making a version."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-make-archive-hook nil
- "*Hooks run after creating a new archive."
- :type 'hook
- :group 'xetla-hooks)
-
-
-(defcustom xetla-name-read-init-hook nil
- "*Hooks run when the control enters to `xetla-name-read'."
- :type 'hook
- :group 'xetla-hooks)
-
-(defcustom xetla-name-read-final-hook nil
- "*Hooks run when the control leaves `xetla-name-read'.
-The name read by `xetla-name-read' is passed to functions connected
-to this hook as an argument."
- :type 'hook
- :group 'xetla-hooks)
-
-(defcustom xetla-name-read-error-hook nil
- "*Hooks run when an error is occurred in `xetla-name-read'."
- :type 'hook
- :group 'xetla-hooks)
-
-(defcustom xetla-follow-symlinks 'tree
- "*Follow symlinks of this type."
- :type '(choice (const :tag "None" nil)
- (const :tag "Symlinks into an arch-managed tree" tree)
- (const :tag "Symlinks to an arch-managed file" id))
- :group 'xetla-file-actions)
-
-(defcustom xetla-follow-symlinks-mode 'follow
- "*Before following a symlink do this."
- :type '(choice (const :tag "Ask" ask)
- (const :tag "Follow" follow)
- (const :tag "Warn" warn))
- :group 'xetla-file-actions)
-
-(defcustom xetla-use-arrow-keys-for-navigation nil
- "*Enable left/right for navigation.
-This works best if `xetla-switch-to-buffer-mode' is set to 'single-window.
-
-It enables binding for navigation allowing you to browse by only using the
-cursor keys, which is much faster than n/p/return/^. Use up/down to move to
-an item, right to select it and left to go to its \"logical\" parent!
-
-Got the idea?
-
-See the variable `xetla-use-arrow-keys-for-navigation-list' for a list of
-bindings that will be installed."
- :type '(choice (const :tag "Disabled" nil)
- (const :tag "Enabled" t)
- (const :tag "Enabled with Shift" shift))
- :group 'xetla-bindings)
-
-(defcustom xetla-revisions-shows-summary t
- "*Whether summary should be displayed for `xetla-revisions'."
- :type 'boolean
- :group 'xetla-revisions)
-
-(defcustom xetla-revisions-shows-creator t
- "*Whether creator should be displayed for `xetla-revisions'."
- :type 'boolean
- :group 'xetla-revisions)
-
-(defcustom xetla-revisions-shows-date t
- "*Whether date should be displayed for `xetla-revisions'."
- :type 'boolean
- :group 'xetla-revisions)
-
-(defcustom xetla-revisions-shows-library t
- "*Display library information in revision lists.
-
-If non-nil the presence of this revision in the library should be
-displayed for `xetla-revisions'"
- :type 'boolean
- :group 'xetla-revisions)
-
-(defcustom xetla-revisions-shows-merges nil
- "*Display merge information in revision lists.
-
-If non-nil, the list of merged patches of this revision should be
-displayed for `xetla-revisions'"
- :type 'boolean
- :group 'xetla-revisions)
-
-(defcustom xetla-revisions-shows-merged-by t
- "*Display \"merged-by\" field in revision lists.
-
-If non-nil the list of patches merged by this revision should be
-displayed for `xetla-revisions'"
- :type 'boolean
- :group 'xetla-revisions)
-
-;;; FIXME: This should be an alist of keyword . description, and
-;;; both the keyword and its description should display in the
-;;; *xetla-log-keywords* buffer.
-(defcustom xetla-log-edit-keywords
- '("admin" ; Administrative changes
- "audit" ; Code clean up/audit
- "bugfix" ; The good ol' bug fix
- "build/compile" ; Compile-time related
- "compat" ; Compatibility changes
- "delete" ; File/dir deletion
- "docfix" ; More that just a typo
- "documentation" ; Writing documentation
- "enhancement" ; Extending existing features
- "internal" ; Changes that don't affect the user
- "linting" ; aka "admin", "audit", "whitespace"
- "merge" ; Merging in changes from other repo
- "newfeature" ; New features
- "newfile" ; New file/dir added to the repo
- "release" ; Changes involved with releases
- "rename" ; Rename file/dir/function/var etc
- "revert" ; Revert some previous changes
- "security" ; Security fixes
- "sync" ; Synching code (eg GNU/Emacs -> XEmacs)
- "trivial" ; Tiny fixes/changes
- "typo" ; Typographic changes
- "update" ; General updates
- "ui" ; User-interface related changes
- "user-visible" ; User-visible changes
- "warnfix" ; Build or run-time warning fixes
- "whitespace" ; Whitespace changes
- )
- "A list of keywords for the Keywords field of a log message."
- :type '(repeat (string))
- :group 'xetla)
-
-
-(defcustom xetla-apply-patch-mapping nil
- "*Tree in which patches should be applied.
-
-An alist of rules to match fully qualified revision names to target
-directories.
-
-That variable is used to offer a directory in `xetla-gnus-apply-patch'.
-Example setting: '(((nil \"xetla\" nil nil nil) \"~/work/xetla/xetla\")))"
- :type '(repeat (cons :tag "Rule"
- (cons :tag "Full revision (regexps)"
- (choice (const nil) (regexp :tag "Archive"))
- (cons
- (choice (const nil) (regexp :tag "Category"))
- (cons
- (choice (const nil) (regexp :tag "Branch"))
- (cons
- (choice (const nil) (regexp :tag "Version"))
- (cons (choice (const nil) (string :tag "Revision"))
- (const nil))))))
- (cons (string :tag "tree") (const nil))))
- :group 'xetla)
-
-;;
-;; Tips
-;;
-
-(defgroup xetla-tips nil
- "\"Tip of the day\" feature for XEtla"
- :prefix "xetla-"
- :group 'xetla)
-
-
-(defcustom xetla-tips-enabled t
- "*Set this to nil to disable tips."
- :type 'boolean
- :group 'xetla-tips)
-
-;;
-;; State
-;;
-
-(defgroup xetla-state nil
- "Saving XEtla's state between Emacs sessions."
- :prefix "xetla-"
- :group 'xetla)
-
-
-(defcustom xetla-state-file-name "state.el"
- "*File in which xetla saves state variables between Emacs sessions.
-The file is stored in the `xetla-config-directory'"
- :type 'file
- :group 'xetla-state)
-
-(defcustom xetla-state-variables-list '(xetla-tips-number)
- "*List of variables to store in the state file `xetla-state-file-name'."
- :type '(repeat (symbol))
- :group 'xetla-state)
-
-\f
-;; --------------------------------------
-;; Face
-;; --------------------------------------
-(defface xetla-marked
- '((((class color) (background dark)) (:foreground "yellow"))
- (((class color) (background light)) (:foreground "magenta"))
- (t (:bold t)))
- "Face to highlight a marked entry in xetla buffers"
- :group 'xetla-faces)
-
-(defface xetla-archive-name
- '((((class color) (background dark)) (:foreground "lightskyblue1"))
- (((class color) (background light)) (:foreground "blue4"))
- (t (:bold t)))
- "Face to highlight xetla archive names."
- :group 'xetla-faces)
-
-(make-face 'xetla-source-archive-name
- "Face to highlight xetla source archive names.")
-(set-face-parent 'xetla-source-archive-name 'xetla-archive-name)
-
-(make-face 'xetla-mirror-archive-name
- "Face to highlight xetla mirror archive names.")
-(set-face-parent 'xetla-mirror-archive-name 'xetla-archive-name)
-
-(make-face 'xetla-category-name
- "Face to highlight xetla category names.")
-(set-face-parent 'xetla-category-name 'xetla-archive-name)
-
-(make-face 'xetla-branch-name
- "Face to highlight xetla branch names.")
-(set-face-parent 'xetla-branch-name 'xetla-archive-name)
-
-(make-face 'xetla-version-name
- "Face to highlight xetla version names.")
-(set-face-parent 'xetla-version-name 'xetla-archive-name)
-
-(make-face 'xetla-revision-name
- "Face to highlight xetla revision names.")
-(set-face-parent 'xetla-revision-name 'xetla-archive-name)
-
-(make-face 'xetla-local-directory
- "Face to highlight xetla local directory.")
-(set-face-parent 'xetla-local-directory 'xetla-archive-name)
-
-(make-face 'xetla-buffer
- "Face to highlight buffer names printed in xetla's buffer.")
-(set-face-parent 'xetla-buffer 'xetla-archive-name)
-
-(make-face 'xetla-tagging-method
- "Face to highlight taggine methods.")
-(set-face-parent 'xetla-tagging-method 'xetla-archive-name)
-
-(make-face 'xetla-id
- "Face to highlight an arch id.")
-(set-face-parent 'xetla-id 'font-lock-keyword-face)
-
-(defface xetla-separator
- '((((class color) (background dark)) (:underline t :bold t))
- (((class color) (background light)) (:underline t :bold t)))
- "Face to highlight separators."
- :group 'xetla-faces)
-
-(make-face 'xetla-keyword
- "Face to highlight keywords.")
-(set-face-parent 'xetla-keyword 'font-lock-keyword-face)
-
-(make-face 'xetla-comment
- "Face to highlight comments.")
-(set-face-parent 'xetla-comment 'font-lock-comment-face)
-
-(make-face 'xetla-precious
- "Face to highlight precious entries")
-(set-face-parent 'xetla-precious 'font-lock-comment-face)
-
-(make-face 'xetla-unrecognized
- "Face to highlight unrecognized entries")
-(set-face-parent 'xetla-unrecognized 'font-lock-warning-face)
-
-(make-face 'xetla-duplicate
- "Face to highlight files with duplicate IDs")
-(set-face-parent 'xetla-duplicate 'font-lock-warning-face)
-
-(make-face 'xetla-source
- "Face to highlight source code entries")
-(set-face-parent 'xetla-source 'font-lock-string-face)
-
-(make-face 'xetla-junk
- "Face to highlight junk entries")
-(set-face-parent 'xetla-junk 'font-lock-function-name-face)
-
-(make-face 'xetla-nested-tree
- "Face to highlight nested trees")
-(set-face-parent 'xetla-nested-tree 'font-lock-type-face)
-
-(make-face
- 'xetla-to-add
- "Face to highlight a file that should probably be added to the archive.")
-(set-face-parent 'xetla-to-add 'font-lock-comment-face)
-
-(make-face 'xetla-broken-link
- "Face to highlight a broken link")
-(set-face-parent 'xetla-broken-link 'font-lock-warning-face)
-
-(make-face 'xetla-unmerged
- "Face to highlight unmerged patches")
-(set-face-parent 'xetla-unmerged 'font-lock-keyword-face)
-
-(make-face 'xetla-header
- "Face to highlight header in log mode for example")
-(set-face-parent 'xetla-header 'font-lock-function-name-face)
-
-(make-face 'xetla-conflict
- "Face to highlight conflicts")
-(set-face-parent 'xetla-conflict 'font-lock-warning-face)
-
-(make-face 'xetla-modified
- "Face to highlight modified files")
-(set-face-parent 'xetla-modified 'font-lock-function-name-face)
-
-(make-face 'xetla-move
- "Face to highlight moved files/directory")
-(set-face-parent 'xetla-move 'font-lock-function-name-face)
-
-(make-face 'xetla-deleted
- "Face to highlight deleted files")
-(set-face-parent 'xetla-deleted 'font-lock-warning-face)
-
-(make-face 'xetla-added
- "Face to highlight added files")
-(set-face-parent 'xetla-added 'font-lock-warning-face)
-
-(make-face 'xetla-meta-info
- "Face to highlight files with meta-info changes")
-(set-face-parent 'xetla-meta-info 'font-lock-comment-face)
-
-(make-face 'xetla-messages
- "Face to highlight messages in xetla buffers")
-(set-face-parent 'xetla-messages 'font-lock-function-name-face)
-
-(defface xetla-highlight
- '((((class color) (background dark)) (:background "darkblue"))
- (((class color) (background light)) (:background "gold")))
- "Face to use as an alternative to `highlight' face.
-If there could be more than two highlighted things, the user will confuse.
-In such case use this face."
- :group 'xetla-faces)
-
-(defface xetla-mark
- '((((class color) (background dark)) (:foreground "green" :bold t))
- (((class color) (background light)) (:foreground "green3" :bold t))
- (t (:bold t)))
- "Xetla face used to highlight marked file indicator."
- :group 'xetla-faces)
-
-\f
-;; --------------------------------------
-;; Font lock keywords
-;; --------------------------------------
-
-;;
-;; Inventory file mode
-;;
-(defvar xetla-inventory-file-font-lock-keywords
- '(
- ("^#.*$" . xetla-comment)
- ("^[ \t]*\\(backup\\|exclude\\|junk\\|precious\\|unrecognized\\|source\\)\\>[ ]*\\(.*\\)$"
- (1 font-lock-keyword-face)
- (2 font-lock-string-face))
- ("^[ \t]*\\(untagged-source\\)"
- (1 font-lock-builtin-face))
- ("^[ \t]*\\(untagged-source\\) \\(precious\\|source\\|backup\\|junk\\|unrecognized\\)\\>"
- (1 font-lock-builtin-face)
- (2 font-lock-keyword-face))
- ("^[ \t]*\\(explicit\\|tagline\\|names\\|implicit\\)\\>"
- (1 font-lock-builtin-face))
- )
- "Keywords in xetla-inventory-file mode.")
-
-;;
-;; Logs mode
-;;
-(defvar xetla-logs-font-lock-keywords
- '(("^[^ \t]*\\(base\\|patch\\|version\\(fix\\)?\\)-[0-9]+" .
- font-lock-function-name-face))
- "Keywords in xetla-logs-mode.")
-
-;;
-;; Changes mode
-;;
-(defvar xetla-changes-font-lock-keywords
- (append
- '(("^\\* looking for .* to compare with$" . font-lock-function-name-face)
- ("^\\* comparing to .*$" . font-lock-function-name-face)
- ("^\\* dir metadata changed$" . font-lock-function-name-face)
- ("^\\* file metadata changed$" . font-lock-function-name-face)
- ("^\\* modified files" . font-lock-function-name-face)
- ("^\\* added files" . font-lock-function-name-face)
- ("^\\* removed files" . font-lock-function-name-face)
- ("^ +-?-/ .*$" . xetla-meta-info)
- ("^ +- .*$" . xetla-meta-info)
- ("^ *T. .*$" . xetla-nested-tree))
- diff-font-lock-keywords)
- "Keywords in `xetla-changes' mode.")
-
-;;
-;; ChangeLog mode
-;;
-(defvar xetla-changelog-font-lock-keywords
- '((" \\([^ ].+:\\)\n\\(.*$\\)"
- (1 'xetla-keyword)
- (2 'change-log-acknowledgement-face))
- ("\t\\(patch-[0-9]+\\)" (1 'xetla-keyword))
- ("^#.*$" . xetla-comment)
- ("^\\sw.........[0-9:+ ]* GMT"
- (0 'change-log-date-face)
- ("\\([^<(]+?\\)[ \t]*[(<]\\([A-Za-z0-9_.-]+@[A-Za-z0-9_.-]+\\)[>)]" nil nil
- (1 'change-log-name-face)
- (2 'change-log-email-face)))
- ("^.*\\* \\([^ ,:([\n]+\\)"
- (1 'change-log-file-face)
- ("\\=, \\([^ ,:([\n]+\\)" nil nil (1 'change-log-file-face))
- ("\\= (\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face))
- ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face)))
- ("^.*(\\([^) ,:\n]+\\)"
- (1 'change-log-list-face)
- ("\\=, *\\([^) ,:\n]+\\)" nil nil (1 'change-log-list-face)))
- ("\\[!?\\([^]\n]+\\)\\]\\(:\\| (\\)" (1 'change-log-conditionals-face))
- ("<\\([^>\n]+\\)>\\(:\\| (\\)" (1 'change-log-function-face))
- ("\\(^.*\\| \\)\\(From\\|Patch\\(es\\)? by\\|Report\\(ed by\\| from\\)\\|Suggest\\(ed by\\|ion from\\)\\)"
- 2 'change-log-acknowledgement-face))
- "Keywords in `xetla-changelog' mode.")
-
-;;
-;; Log edit mode
-;;
-(defvar xetla-log-edit-font-lock-keywords
- (append
- '(("^\\(Summary\\|Keywords\\): \\(.*$\\)"
- (1 'xetla-header)
- (2 'change-log-conditionals-face)))
- xetla-changelog-font-lock-keywords)
-
- "Keywords in xetla-log-edit mode.")
-
-;;
-;; Cat-Log mode
-;;
-(defvar xetla-cat-log-font-lock-keywords
- (append
- '(("^\\(Revision\\|Archive\\|Creator\\|Date\\|Standard-date\\|Modified-files\\|New-patches\\|Summary\\|Keywords\\|New-files\\|New-directories\\|Removed-files\\|Removed-directories\\|Renamed-files\\|Renamed-directories\\|Modified-directories\\|Removed-patches\\): \\(.*$\\)"
- (1 'xetla-header)
- (2 'change-log-conditionals-face)))
- xetla-changelog-font-lock-keywords)
- "Keywords in `xetla-cat-log-mode'.")
-
-;;
-;; Tips mode
-;;
-(defvar xetla-tips-mode-map
- (let ((map (make-sparse-keymap)))
- (define-key map xetla-keyvec-quit 'xetla-buffer-quit)
- (define-key map xetla-keyvec-next 'xetla-tips-next-tip)
- (define-key map xetla-keyvec-previous 'xetla-tips-previous-tip)
- (define-key map [?c] 'xetla-tips-customize)
- map))
-
-\f
-;; --------------------------------------
-;; Auto-mode-alist entries
-;; --------------------------------------
-;;;###autoload(add-to-list 'auto-mode-alist '("/\\(=tagging-method\\|\\.arch-inventory\\)$" . xetla-inventory-file-mode))
-
-;; --------------------------------------
-;; Hooks into other packages and/or functions
-;; --------------------------------------
-
-;;
-;; ediff
-;;
-(defvar xetla-ediff-keymap (copy-keymap xetla-global-keymap)
- "Global keymap used by XEtla in the ediff control buffer.")
-
-(define-key xetla-ediff-keymap xetla-keyvec-log-entry 'xetla-ediff-add-log-entry)
-
-(add-hook 'ediff-keymap-setup-hook
- #'(lambda ()
- (define-key ediff-mode-map xetla-prefix-key xetla-ediff-keymap)))
-
-;;
-;; find-file
-;;
-(add-hook 'find-file-hooks 'xetla-find-file-hook)
-
-;; --------------------------------------
-;; Enables arrow key navigation for left/right
-;; --------------------------------------
-(defvar xetla-use-arrow-keys-for-navigation-list
- '((xetla-inventory-mode-map right 'xetla-inventory-find-file)
- (xetla-inventory-mode-map left 'xetla-inventory-parent-directory)
- (xetla-archive-list-mode-map right 'xetla-archive-list-categories)
- (xetla-archive-list-mode-map left 'xetla-buffer-quit)
- (xetla-category-list-mode-map right 'xetla-category-list-branches)
- (xetla-category-list-mode-map left 'xetla-archives)
- (xetla-branch-list-mode-map right 'xetla-branch-list-versions)
- (xetla-branch-list-mode-map left 'xetla-branch-list-parent-category)
- (xetla-version-list-mode-map right 'xetla-version-list-revisions)
- (xetla-version-list-mode-map left 'xetla-version-list-parent-branch)
- (xetla-revision-list-mode-map left 'xetla-revision-list-parent-version)
- (xetla-revision-list-mode-map right 'xetla-revision-show-changeset)
- (xetla-changes-mode-map left 'xetla-changes-jump-to-change)
- (xetla-changes-mode-map right 'xetla-changes-view-source)
- (xetla-changelog-mode-map left 'xetla-buffer-quit)
- (xetla-process-buffer-mode-map left 'xetla-buffer-quit)
- (xetla-bookmarks-mode-map right 'xetla-bookmarks-inventory)
- ))
-
-(defun xetla-use-arrow-keys-for-navigation (&optional uninstall)
- "Bind the left/right keys for navigation.
-
-This function will be called automatically if variable
-`xetla-use-arrow-keys-for-navigation' is non-nil.
-
-If argument UNINSTALL is non-nil, undefine the keys instead of
-defining it."
- (interactive "P")
- (let ((bl xetla-use-arrow-keys-for-navigation-list) b
- (m xetla-use-arrow-keys-for-navigation))
- (while bl
- (setq b (car bl)
- bl (cdr bl))
- (eval
- (append (list 'define-key
- (car b))
- (cond ((eq nil m)
- (list (vector (cadr b)) nil))
- ((eq 'shift m)
- (if uninstall
- (list (vector (list 'shift (cadr b))) nil)
- (list (vector (list 'shift (cadr b))) (caddr b))))
- ((eq t m)
- (if uninstall
- (list (vector (cadr b)) nil)
- (list (vector (cadr b)) (caddr b))))))))
- (if uninstall
- (message "%sleft/right bindings for xetla have been removed."
- (if (eq 'shift m) "Shifted " ""))
- (message "%sleft/right bindings for xetla have been installed."
- (if (eq 'shift m) "Shifted " "")))))
-
-;; install them if customized
-(if xetla-use-arrow-keys-for-navigation
- (xetla-use-arrow-keys-for-navigation))
-
-(provide 'xetla-defs)
-
-;;; xetla-defs.el ends here
+++ /dev/null
-;;; xetla-tips.el --- "Tip of the day" feature for XEtla.
-
-;; Copyright (C) 2004 Free Software Foundation, Inc. (GPL)
-;; Copyright (C) 2004 Steve Youngs (BSD)
-
-;; Author: Steve Youngs <steve@eicq.org>
-;; Maintainer: Steve Youngs <steve@eicq.org>
-;; Created: 2004-11-25
-;; Keywords: arch archive tla
-
-;; Based on xtla-tips.el by: Matthieu Moy <Matthieu.Moy@imag.fr>
-
-;; This file is part of XEtla.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;; may be used to endorse or promote products derived from this
-;; software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
-;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-
-;;; Commentary:
-
-;; To raise the learning curve for xetla.el users. Some commands can
-;; (optionaly) pop-up a buffer with a tip. Currently, `xetla-commit'
-;; does this.
-
-
-;;; Code:
-
-(eval-and-compile
- (require 'xetla-defs)
- (require 'xetla))
-
-(defconst xetla-tips-array
- [
-"Welcome to XEtla. I'm the tip buffer. I will appear from time to time
-to show you interesting features that you may have missed! Disable me
-by setting the variable `xetla-tips-enabled' to nil.
-
-Press `q' to exit, `n' to view next tip, `p' to view previous tip."
- "For the available xetla commands Xetla provides a corresponding interactive
-function.
-Some examples:
-
-M-x xetla-inventory ... runs tla inventory
-M-x xetla-undo ... runs tla undo
-M-x xetla-changes ... runs tla changes
-
-XEtla prompts for the needed parameters."
- "Most interesting commands are available through a global keyboard
-shortcut. Try `C-x T C-h' to get a list"
- "XEtla provides several major modes for different buffers. Each mode
-has its own keybindings. Get help with `\\[describe-mode]'"
- "When XEtla is loaded, `C-M-h' in a minibuffer prompt gives you help
-about the command being run."
- "When you are prompted for an archive, category, branch, version or
-revision name, lots of keybindings are available. Get a list with `C-h'."
- "XEtla allows you to manage a list of bookmarks. Try `\\[xetla-bookmarks]' and add
-bookmarks from the menu. You may also add bookmarks from an archives,
-category, version or revision buffer as well as from the xetla-browse
-buffer."
- "From the bookmark buffer, you can select some bookmarks and make
-them partners with \\<xetla-bookmarks-mode-map>`\\[xetla-bookmarks-marked-are-partners]'. Afterwards, pressing `\\[xetla-bookmarks-missing]' on a bookmark will
-show you the missing patches from his partners."
- "You can add changelog style comments to your commit log by `\\[xetla-add-log-entry]'."
- "You can enable ispell, flyspell or other useful mode for editing
-log files by `M-x customize-variable RET xetla-log-edit-mode-hook RET'."
- "By default, XEtla caches any log file you retrieve with
-`xetla-cat-log' or `xetla-cat-archive-log' in ~/.arch-log-library. This
-speeds up many XEtla operations.
-
-You can disable this by setting `xetla-log-library-greedy' to nil."
- "XEtla is highly customizable.
-Start it by `M-x customize-group RET xetla RET'."
- "In an *xetla-changes* buffer you can quickly jump to the source file by
-`RET', or view the source file in another window by `v', or start
-an ediff session by `e' to inspect/reject parts of the changes."
- "In a *xetla-changes* buffer, you can quickly jump from the list of
-files to the corresponding patch hunk, and come back with `j'"
- "After committing, you can review the last committed patch with
-`M-x xetla-changes-last-revision RET'.
-
-Usefull to review and fix a patch you've just merged without mixing
-manual modifications and merge in the same patch."
- "After a merge, typing \\<xetla-log-edit-mode-map> `\\[xetla-log-edit-insert-log-for-merge-and-headers]' in the log buffer will generate
-for you a summary line, keyword and body. This is highly
-customizable."
- "Report bugs using `M-x xetla-submit-bug-report RET'"
- "You've got a nice, graphical, archive browser one
-`M-x xetla-browse RET' away."
- "In the bookmark buffer, pressing\\<xetla-bookmarks-mode-map> `\\[xetla-bookmarks-find-file] starts with the local
-tree of the bookmark at point for the default directory."
- "`\\[xetla-file-ediff]' in a source file will open an ediff session with the
-unmodified version of the file. From here, you can undo patch hunks
-one by one with the key `b'"
- "In the *tree-lint* buffer, with your cursor on a message, most
-commands will apply to all the files listed under this message."
- "Many XEtla commands accept one or more prefix arguments. For example,
-from the *xetla-log-edit* buffer:
-\\<xetla-log-edit-mode-map>
- `\\[xetla-log-edit-done]' -- Save and kill the log buffer
- `\\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit the changes
- `\\[universal-argument] \\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit and \"seal\"
-`\\[universal-argument] \\[universal-argument] \\[universal-argument] \\[xetla-log-edit-done]' -- Save and kill the log, plus commit and \"fix\"
-
-All of the XEtla commands that accept prefix arguments are documented,
-so use `\\[describe-function] xetla-[command] RET' to see more nifty
-tricks."
- "Give a prefix argument to M-x xetla-changelog and you'll be prompted
-for a version to display a ChangeLog for. This is handy if you want to
-see a ChangeLog for a previous version of a project."
- "In a *xetla-changes* buffer, hit RET with point somewhere in the diff
-and you'll be taken to that exact spot in the source file."
- ]
- "List of tips. Add more !")
-
-(defvar xetla-tips-number 0
- "Number of the last tip viewed.
-Will be saved in state.el")
-
-(defun xetla-tips-message-number (number)
- "Return the message number NUMBER, as a string."
- (let ((number (mod number (length xetla-tips-array))))
- (aref xetla-tips-array number)))
-
-(define-derived-mode xetla-tips-mode fundamental-mode "xetla-tips"
- "Major mode for buffers displaying tip of the day.
-
-Commands:
-\\{xetla-tips-mode-map}"
- (toggle-read-only 1))
-
-
-(defun xetla-tips-popup-number (number)
- "Pops up tip number NUMBER."
- (let ((message (xetla-tips-message-number number)))
- (switch-to-buffer (get-buffer-create "*xetla-tip*"))
- (xetla-tips-mode)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (xetla-face-add
- "************************* Did you know? *************************"
- 'xetla-messages)
- "\n\n")
- (insert (substitute-command-keys message))
- (newline 2)
- (insert (xetla-face-add
- "*********************************************************************"
- 'xetla-messages))
- (goto-char (point-min)))))
-
-(defun xetla-tips-popup-maybe ()
- "Pop up a buffer with a tip if tips are enabled.
-
-see `xetla-tips-enabled'."
- (when xetla-tips-enabled
- (xetla-tips-popup)))
-
-(defun xetla-tips-popup (&optional direction)
- "Pop up a buffer with a tip message.
-
-Don't use this function from XEtla. Use `xetla-tips-popup-maybe'
-instead."
- (interactive)
- (xetla-load-state)
- (xetla-tips-popup-number xetla-tips-number)
- (setq xetla-tips-number
- (mod (+ xetla-tips-number (or direction 1)) (length xetla-tips-array)))
- (xetla-save-state))
-
-(defun xetla-tips-next-tip ()
- "Show next tip."
- (interactive)
- (xetla-tips-popup 1))
-
-(defun xetla-tips-previous-tip ()
- "Show previous tip."
- (interactive)
- (xetla-tips-popup -1))
-
-(eval-when-compile
- (autoload 'customize-group "cus-edit" nil t))
-
-(defun xetla-tips-customize ()
- "Run customize group for xetla-tips."
- (interactive)
- (customize-group 'xetla-tips))
-
-(provide 'xetla-tips)
-;;; xetla-tips.el ends here
+++ /dev/null
-;;; Automatically generated file -- DO NOT EDIT OR DELETE
-;;;###autoload
-(defconst xetla-version
- "steve@eicq.org--2005/xetla--main--1.1--version-0")
-(provide 'xetla-version)
+++ /dev/null
-;;; xetla.el --- Arch (tla) interface for XEmacs
-
-;; Copyright (C) 2003-2004 by Stefan Reichoer (GPL)
-;; Copyright (C) 2004 2005 Steve Youngs (BSD)
-
-;; Author: Steve Youngs <steve@eicq.org>
-;; Maintainer: Steve Youngs <steve@eicq.org>
-;; Created: 2004-11-25
-;; Keywords: arch archive tla
-
-;; Based on xtla.el by: Stefan Reichoer, <stefan@xsteve.at>
-
-;; This file is part of XEtla.
-
-;; Redistribution and use in source and binary forms, with or without
-;; modification, are permitted provided that the following conditions
-;; are met:
-;;
-;; 1. Redistributions of source code must retain the above copyright
-;; notice, this list of conditions and the following disclaimer.
-;;
-;; 2. Redistributions in binary form must reproduce the above copyright
-;; notice, this list of conditions and the following disclaimer in the
-;; documentation and/or other materials provided with the distribution.
-;;
-;; 3. Neither the name of the author nor the names of any contributors
-;; may be used to endorse or promote products derived from this
-;; software without specific prior written permission.
-;;
-;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR "AS IS" AND ANY EXPRESS OR
-;; IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
-;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE
-;; DISCLAIMED. IN NO EVENT SHALL THE REGENTS OR CONTRIBUTORS BE LIABLE
-;; FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR
-;; CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF
-;; SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR
-;; BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
-;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
-;; OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN
-;; IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
-
-;;; Commentary:
-
-;; Contributions from:
-;; Matthieu Moy <Matthieu.Moy@imag.fr>
-;; Masatake YAMATO <jet@gyve.org>
-;; Milan Zamazal <pdm@zamazal.org>
-;; Martin Pool <mbp@sourcefrog.net>
-;; Robert Widhopf-Fenk <hack@robf.de>
-;; Mark Triggs <mst@dishevelled.net>
-
-
-;; The main commands are available with the prefix key C-x T.
-;; Type C-x T C-h for a list.
-
-;; M-x xetla-inventory shows a xetla inventory
-;; In this inventory buffer the following commands are available:
-;; e ... xetla-edit-log
-;; = ... xetla-changes
-;; l ... xetla-changelog
-;; L ... xetla-logs
-
-;; To Edit a logfile issue: M-x xetla-edit-log
-;; In this mode you can hit C-c C-d to show the changes
-;; Edit the log file
-;; After that you issue M-x xetla-commit (bound to C-c C-c) to commit the files
-
-;; M-x xetla-archives starts the interactive archive browser
-
-;; M-x xetla-make-archive creates a new archive directory
-;; Many commands are available from here. Look at the menus, they're
-;; very helpful to begin.
-
-;; M-x xetla-bookmarks RET
-;; Is another good starting point. This is the place where you put the
-;; project you work on most often, and you can get a new version, see
-;; the missing patches, and a few other useful features from here.
-;; Use `a' to add a bookmark. Add your own projects, and your
-;; contributor's projects too. Select several related projects with
-;; `m' (unselect with M-u or M-del). Make them partners with 'M-p'.
-;; Now, with your cursor on a bookmark, view the uncommitted changes,
-;; the missing patches from your archive and your contributors with
-;; 'M'.
-
-;; M-x xetla-file-ediff RET
-;; Is an wrapper to xetla file-diff, ediff to view the changes
-;; interactively.
-
-;; Misc commands:
-;; xetla-tag-insert inserts a arch-tag entry generated with uuidgen
-
-;; If you find xetla.el useful, and you have some ideas to improve it
-;; please share them with us (Patches are preferred :-))
-
-;;; Code:
-
-;;; XEtla/Xtla safety code
-;; You can run into some problems if you have both XEtla and Xtla
-;; installed at the same time. The following attempts to guard
-;; against it by warning the user and giving them a couple of
-;; functions for disabling one of XEtla or Xtla in their current
-;; session. Dangerous stuff!!
-(defvar xetla-dont-warn-about-xtla nil)
-
-(when (and (featurep 'xtla)
- (not xetla-dont-warn-about-xtla))
- (xetla-warn-about-xtla))
-
-(defconst xetla-warn-about-xtla-text
- "We have detected that you have both XEtla and Xtla installed.
-
-This is never a very good idea (unless you _really_ know what you are
-doing) because both packages share similar key bindings and install
-similar hooks.
-
-Our suggestion is that you remove either XEtla or Xtla and just use the
-other. For your convenience there is `xetla-attempt-xetla-removal' and
-`xetla-attempt-xtla-removal', which will attempt to disable one of the
-packages for the current session only.
-
-Use those functions at your own risk. The best answer is to not load
-one of XEtla or Xtla in the first place.
-
-To disable this warning: (setq xetla-dont-warn-about-xtla t).")
-
-(defun xetla-warn-about-xtla ()
- "Pop up a big fat warning about trying to use XEtla and xtla together."
- (get-buffer-create "*XEtla/Xtla Warning*")
- (with-current-buffer "*XEtla/Xtla Warning*"
- (erase-buffer)
- (insert xetla-warn-about-xtla-text))
- (pop-to-buffer "*XEtla/Xtla Warning*"))
-
-(defun xetla-attempt-xetla-removal ()
- "Attempt to disable xetla.
-
-**** This is dangerous, use at your own risk. ****
-
-This function attempts to unload all the XEtla features, remove the
-`xetla-find-file-hook', remove entries from `auto-mode-alist', and
-finally, remove the XEtla lisp directory from the `load-path'. After
-all of this has happened, Xtla should run without problems. Please
-note that we do _NOT_ guarantee that this will work perfectly and you
-really should physically remove either XEtla or Xtla.
-
-Use of this function is only valid in the current session, in other
-words, it ain't saved."
- (interactive)
- ;; unload the features
- (when (featurep 'xetla-tips) (unload-feature 'xetla-tips t))
- (when (featurep 'xetla-browse) (unload-feature 'xetla-browse t))
- (when (featurep 'xetla) (unload-feature 'xetla t))
- (when (featurep 'xetla-core) (unload-feature 'xetla-core t))
- (when (featurep 'xetla-defs) (unload-feature 'xetla-defs t))
- (when (featurep 'xetla-autoloads) (unload-feature 'xetla-autoloads t))
- ;; remove the hooks
- (remove-hook 'find-file-hooks 'xetla-find-file-hook)
- ;; clean out auto-mode-alist
- (setq auto-mode-alist
- (delete '("\\+\\+log\\." . xetla-log-edit-mode) auto-mode-alist))
- (setq auto-mode-alist
- (delete '("/\\(=tagging-method\\|\\.arch-inventory\\)$" . xetla-inventory-file-mode)
- auto-mode-alist))
- ;; clean out the load-path
- (setq load-path
- (remove (file-name-directory (locate-library "xetla")) load-path))
- ;; did I miss anything?
- ;; what can we do about key bindings?
-
- (message "To ensure correct key bindings, please reload Xtla"))
-
-(defun xetla-attempt-xtla-removal ()
- "Attempt to disable Xtla.
-
-**** This is dangerous, use at your own risk. ****
-
-This function attempts to unload all the Xtla features, remove the
-`tla-find-file-hook', remove entries from `auto-mode-alist', and
-finally, remove the XEtla lisp directory from the `load-path'. After
-all of this has happened, XEtla should run without problems. Please
-note that we do _NOT_ guarantee that this will work perfectly and you
-really should physically remove either XEtla or Xtla.
-
-Use of this function is only valid in the current session, in other
-words, it ain't saved."
- (interactive)
- ;; unload the features
- (when (featurep 'xtla-tips) (unload-feature 'xtla-tips t))
- (when (featurep 'xtla-browse) (unload-feature 'xtla-browse t))
- (when (featurep 'xtla) (unload-feature 'xtla t))
- (when (featurep 'xtla-core) (unload-feature 'xtla-core t))
- (when (featurep 'xtla-defs) (unload-feature 'xtla-defs t))
- (when (featurep 'xtla-emacs) (unload-feature 'xtla-emacs t))
- (when (featurep 'xtla-xemacs) (unload-feature 'xtla-xemacs t))
- (when (featurep 'xtla-autoloads) (unload-feature 'xtla-autoloads t))
- ;; remove the hooks
- (remove-hook 'find-file-hooks 'tla-find-file-hook)
- ;; clean out auto-mode-alist
- (setq auto-mode-alist
- (delete '("\\+\\+log\\." . tla-log-edit-mode) auto-mode-alist))
- (setq auto-mode-alist
- (delete '("/\\(=tagging-method\\|\\.arch-inventory\\)$" . tla-inventory-file-mode)
- auto-mode-alist))
- ;; clean out the load-path
- (setq load-path
- (remove (file-name-directory (locate-library "xtla")) load-path))
- ;; did I miss anything?
- ;; what can we do about key bindings?
- (message "To ensure correct key bindings, please reload XEtla"))
-
-;;; End XEtls/Xtla safety code
-
-
-(eval-and-compile
- (when (locate-library "xetla-version")
- (require 'xetla-version)))
-
-(eval-when-compile (require 'cl))
-
-;; gnus is optional. Load it at compile-time to avoid warnings.
-(eval-when-compile
- (autoload 'gnus-article-part-wrapper "gnus-art")
- (autoload 'gnus-article-show-summary "gnus-art" nil t)
- (autoload 'gnus-summary-select-article-buffer "gnus-sum" nil t)
- (autoload 'mm-save-part-to-file "mm-decode")
- (autoload 'mml-attach-file "mml" nil t))
-
-(eval-and-compile
- (require 'ediff)
- (require 'font-lock))
-
-(require 'sendmail)
-(require 'pp)
-(require 'ewoc)
-(require 'diff)
-(require 'diff-mode)
-
-(eval-and-compile
- (require 'xetla-defs)
- (require 'xetla-core))
-
-(eval-when-compile
- (when (locate-library "smerge-mode")
- (require 'smerge-mode))
-
- (when (locate-library "hl-line")
- (require 'hl-line)))
-
-(eval-when-compile
- (autoload 'dired "dired" nil t)
- (autoload 'dired-make-relative "dired")
- (autoload 'dired-other-window "dired" nil t)
- (autoload 'minibuffer-prompt-end "completer")
- (autoload 'regexp-opt "regexp-opt")
- (autoload 'reporter-submit-bug-report "reporter")
- (autoload 'view-file-other-window "view-less" nil t)
- (autoload 'view-mode "view-less" nil t)
- (autoload 'with-electric-help "ehelp"))
-
-;; --------------------------------------
-;; Internal variables
-;; --------------------------------------
-(defvar xetla-edit-arch-command nil)
-(defvar xetla-pre-commit-window-configuration nil)
-(defvar xetla-log-edit-file-name nil)
-(defvar xetla-log-edit-file-buffer nil)
-(defvar xetla-my-id-history nil)
-(defvar xetla-memorized-log-header nil)
-(defvar xetla-memorized-log-message nil)
-(defvar xetla-memorized-version nil)
-
-(defvar xetla-buffer-archive-name nil)
-(defvar xetla-buffer-category-name nil)
-(defvar xetla-buffer-branch-name nil)
-(defvar xetla-buffer-version-name nil)
-(defvar xetla-buffer-refresh-function nil
- "Variable should be local to each buffer.
-Function used to refresh the current buffer")
-(defvar xetla-buffer-marked-file-list nil
- "List of marked files in the current buffer.")
-(defvar xetla-get-revision-info-at-point-function nil
- "Variable should be local to each buffer.
-Function used to get the revision info at point")
-
-(defvar xetla-mode-line-process "")
-(defvar xetla-mode-line-process-status "")
-
-;; Extent category
-(put 'xetla-default-button 'mouse-face 'highlight)
-(put 'xetla-default-button 'evaporate t)
-;;(put 'xetla-default-button 'rear-nonsticky t)
-;;(put 'xetla-default-button 'front-nonsticky t)
-
-;;;###autoload
-(defun xetla ()
- "Displays a welcome message."
- (interactive)
- (let* ((name "*xetla-welcome*")
- (buffer (get-buffer name)))
- (if buffer (xetla-switch-to-buffer buffer)
- (xetla-switch-to-buffer
- (setq buffer (get-buffer-create name)))
- (insert " *** Welcome to XEtla ! ***
-
-XEtla is the XEmacs frontend to the revision control system GNU/arch (tla).
-
-As a starting point, you should look at the \"Tools\" menu, there is a
-\"XEtla\" entry with a lot of interesting commands.
-
-There is also a manual for XEtla. It should be available using the
-Info system, however it is still just a skeleton file with no
-information in it yet. Well, you know how much hackers just love
-doing documentation. :-)
-
-Hope you'll enjoy it !
-")
- (insert
- "\n"
- ""
- "[" (xetla-insert-button "Bookmarks" 'xetla-bookmarks)
- "]"
- "[" (xetla-insert-button "Inventory" 'xetla-inventory)
- "]"
- "[" (xetla-insert-button "Browse Archives" (if (fboundp 'xetla-browse)
- 'xetla-browse
- 'xetla-archives))
- "]"
- "[" (xetla-insert-button "Browse Revisions" 'xetla-revisions)
- "]"
- "[" (xetla-insert-button "Report Bug" 'xetla-submit-bug-report)
- "]"
- "\n")
- (toggle-read-only t)
- (local-set-key [?q] (lambda () (interactive)
- (kill-buffer (current-buffer)))))
- (xetla-message-with-bouncing
- (concat "XEtla core development team: "
- "Steve Youngs <steve@eicq.org>, "
- "Sebastian Freundt <freundt@math.tu-berlin.de> "
- " --- We hope you have as much fun using XEtla "
- "as we have had in hacking it for you."))))
-
-(defun xetla-insert-button (label function)
- "Insert a button labeled with LABEL and launching FUNCTION.
-Helper function for `xetla'."
- (xetla-face-add label 'bold
- (let ((map (make-sparse-keymap)))
- (define-key map [return] function)
- (define-key map "\C-m" function)
- (define-key map [button2] function)
- map)
- nil))
-
-(defun xetla-face-add-with-condition (condition text face1 face2)
- "If CONDITION then add TEXT the face FACE1, else add FACE2."
- (if condition
- (xetla-face-add text face1)
- (xetla-face-add text face2)))
-
-(defun xetla-face-set-temporary-during-popup (face begin end menu &optional prefix)
- "Put FACE on BEGIN and END in the buffer during Popup MENU.
-PREFIX is passed to `popup-menu'."
- (let (o)
- (unwind-protect
- (progn
- (setq o (make-extent begin end))
- (set-extent-face o face)
- (sit-for 0)
- (popup-menu menu prefix))
- (delete-extent o))))
-
-(defconst xetla-mark (xetla-face-add "*" 'xetla-mark)
- "Fontified string used for marking.")
-
-;; --------------------------------------
-;; Macros
-;; --------------------------------------
-(defmacro xetla-toggle-list-entry (list entry)
- "Either add or remove from the value of LIST the value ENTRY."
- `(if (member ,entry ,list)
- (setq ,list (delete ,entry ,list))
- (add-to-list ',list ,entry)))
-
-;; --------------------------------------
-;; Common used functions for many xetla modes
-;; --------------------------------------
-(defun xetla-kill-all-buffers ()
- "Kill all xetla buffers."
- (interactive)
- (let ((number 0))
- (dolist (type-cons xetla-buffers-tree)
- (dolist (path-buffer (cdr type-cons))
- (setq number (1+ number))
- (kill-buffer (cadr path-buffer))))
- (message "Killed %d buffer%s" number
- (if (> number 1) "s" "")))
- (setq xetla-buffers-tree nil))
-
-(defvar xetla-buffer-previous-window-config nil
- "Window-configuration to return to on buffer quit.
-
-If nil, nothing is done special. Otherwise, must be a
-window-configuration. `xetla-buffer-quit' will restore this
-window-configuration.")
-
-(make-variable-buffer-local 'xetla-buffer-previous-window-config)
-
-(defun xetla-buffer-quit ()
- "Quit the current buffer.
-
-If `xetla-buffer-quit-mode' is 'kill, then kill the buffer. Otherwise,
-just burry it."
- (interactive)
- ;; Value is buffer local => keep it before killing the buffer!
- (let ((prev-wind-conf xetla-buffer-previous-window-config))
- (if (eq xetla-buffer-quit-mode 'kill)
- (kill-buffer (current-buffer))
- (bury-buffer))
- (when prev-wind-conf
- (set-window-configuration prev-wind-conf))))
-
-(defun xetla-edit-=tagging-method-file ()
- "Edit the {arch}/=tagging-method file."
- (interactive)
- (find-file (expand-file-name "{arch}/=tagging-method" (xetla-tree-root))))
-
-(defun xetla-edit-.arch-inventory-file (&optional dir)
- "Edit DIR/.arch-inventory file.
-`default-directory' is used as DIR if DIR is nil.
-If it is called interactively and the prefix argument is given via DIR,
-use the directory of a file associated with the point to find .arch-inventory.
-In the case no file is associated with the point, it reads the directory name
-with `read-directory-name'."
- (interactive
- (list (if (not (interactive-p))
- default-directory
- (let ((file (xetla-get-file-info-at-point)))
- (if file
- (if (not (file-name-absolute-p file))
- (concat default-directory
- (file-name-directory file))
- (file-name-directory file))
- (expand-file-name (read-directory-name
- "Directory containing \".arch-inventory\": ")))))))
- (let* ((dir (or dir default-directory))
- (file (expand-file-name ".arch-inventory" dir))
- (newp (not (file-exists-p file))))
- (find-file file)
- (save-excursion
- (when (and newp (y-or-n-p
- (format "Insert arch tag to \"%s\"? " file)))
- (xetla-tag-insert)))))
-
-(defun xetla-ewoc-delete (cookie elem)
- "Remove element from COOKIE the element ELEM."
- (ewoc-filter cookie
- '(lambda (x) (not (eq x (ewoc-data elem))))))
-
-(defun xetla-generic-refresh ()
- "Call the function specified by `xetla-buffer-refresh-function'."
- (interactive)
- (let ((xetla-read-directory-mode 'never)
- (xetla-read-project-tree-mode 'never))
- (funcall xetla-buffer-refresh-function)))
-
-(defun xetla-get-info-at-point ()
- "Get the version information that point is on."
- (when (fboundp xetla-get-revision-info-at-point-function)
- (funcall xetla-get-revision-info-at-point-function)))
-
-(defvar xetla-window-config nil
- "Used for inter-function communication.")
-
-(defun xetla-ediff-buffers (bufferA bufferB)
- "Wrapper around `ediff-buffers'.
-
-Calls `ediff-buffers' on BUFFERA and BUFFERB."
- (let ((xetla-window-config (current-window-configuration)))
- (ediff-buffers bufferA bufferB
- '(xetla-ediff-startup-hook) 'xetla-ediff)))
-
-(defun xetla-insert-right-justified (string count &optional face)
- "Insert a string with a right-justification.
-
-Inserts STRING preceded by spaces so that the line ends exactly at
-COUNT characters (or after if STRING is too long).
-If FACE is non-nil, insert the string fontified with FACE."
- (insert-char ?\ (max 0 (- count (length string))))
- (insert (if face (xetla-face-add string face) string))
- )
-
-(defun xetla-generic-popup-menu (event prefix)
- "Generic function to popup a menu.
-
-The menu is defined in the text property under the point which is
-given by mouse. EVENT is the mouse event that called the function.
-PREFIX is passed to `xetla-generic-popup-menu-by-keyboard'."
- (interactive "e\nP")
- (mouse-set-point event)
- (xetla-generic-popup-menu-by-keyboard prefix))
-
-
-(defun xetla-generic-popup-menu-by-keyboard (prefix)
- "Popup a menu defined in the text property under the point.
-
-PREFIX is passed to `popup-menu'."
- (interactive "P")
- (if (get-text-property (point) 'menu)
- (let* ((menu (get-text-property (point) 'menu))
- (p (previous-single-property-change (point) 'menu nil
- (point-at-bol)))
- (n (next-single-property-change (point) 'menu nil
- (point-at-eol)))
- (b (if (and p (get-text-property p 'menu)) p (point)))
- (e (if n n (point))))
- (xetla-face-set-temporary-during-popup 'xetla-highlight
- b e
- menu
- prefix))
- (error "No context-menu under the point")))
-
-
-;; Test cases
-;; (xetla-message-with-bouncing
-;; (concat "Author: Stefan Reichoer <stefan@xsteve.at>, "
-;; "Contributions from: "
-;; "Matthieu Moy <Matthieu.Moy@imag.fr>, "
-;; "Masatake YAMATO <jet@gyve.org>, "
-;; "Milan Zamazal <pdm@zamazal.org>, "
-;; "Martin Pool <mbp@sourcefrog.net>, "
-;; "Robert Widhopf-Fenk <hack@robf.de>, "
-;; "Mark Triggs <mst@dishevelled.net>"))
-;; (xetla-message-with-rolling
-;; (concat "Author: Stefan Reichoer <stefan@xsteve.at>, "
-;; "Contributions from: "
-;; "Matthieu Moy <Matthieu.Moy@imag.fr>, "
-;; "Masatake YAMATO <jet@gyve.org>, "
-;; "Milan Zamazal <pdm@zamazal.org>, "
-;; "Martin Pool <mbp@sourcefrog.net>, "
-;; "Robert Widhopf-Fenk <hack@robf.de>, "
-;; "Mark Triggs <mst@dishevelled.net>"))
-(defvar xetla-message-long-default-interval 0.2
- "Default animation step interval.
-
-Used in `xetla-message-with-bouncing' and `xetla-message-with-rolling'")
-
-(defvar xetla-message-long-border-interval 1.0
- "Animation step interval when bouncing in `xetla-message-with-bouncing'.")
-
-(defun* xetla-message-with-bouncing (&rest msg)
- "Similar to `message' but display the message in bouncing animation to show long line."
- (setq msg (apply 'format msg))
- (let* ((width (- (window-width (minibuffer-window))
- (+ 1 (length "[<] ") (length " [>]"))))
- (msglen (length msg))
- submsg
- (steps (- msglen width))
- j)
- (if (< msglen width)
- (message "%s" msg)
- (while t
- ;; Go forward
- (dotimes (i steps)
- (setq submsg (substring msg i (+ i width)))
- (message "[<] %s [ ]" submsg)
- (unless (sit-for (cond
- ((eq i 0) xetla-message-long-border-interval)
- (t xetla-message-long-default-interval)))
- (return-from xetla-message-with-bouncing)))
- ;; Go back
- (dotimes (i steps)
- (setq j (- steps i))
- (setq submsg (substring msg j (+ j width)))
- (message "[ ] %s [>]" submsg)
- (unless (sit-for (cond
- ((eq i 0) xetla-message-long-border-interval)
- (t xetla-message-long-default-interval)))
- (return-from xetla-message-with-bouncing)))
- (garbage-collect)))))
-
-(defun* xetla-message-with-rolling (&rest msg)
- "Similar to `message' but display the message in rolling animation to show long line."
- (setq msg (concat " <MESSAGE>: "
- (apply 'format msg)
- " "))
- (let* ((width (- (window-width (minibuffer-window))
- (+ 1 (length "[<] "))))
- (msglen (length msg))
- submsg
- (normal-range (- msglen width)))
- (if (< msglen width)
- (message "%s" msg)
- (while t
- (dotimes (i msglen)
- (setq submsg (if (< i normal-range)
- (substring msg i (+ i width))
- ;; Rolling is needed.
- (concat (substring msg i)
- (substring msg 0 (- (+ i width) msglen)))))
- (message "[<] %s" submsg)
- (unless (sit-for (cond
- ((eq i 0) xetla-message-long-border-interval)
- (t xetla-message-long-default-interval)))
- (return-from xetla-message-with-rolling)))
- (garbage-collect)))))
-
-;; --------------------------------------
-;; Name read engine helpers
-;; --------------------------------------
-;;
-;; Extended version of xetla-read-name
-;;
-(defun xetla-name-read-help ()
- "Displays a help message with keybindings for the minibuffer prompt."
- (interactive)
- (set-buffer (get-buffer-create "*Help*"))
- (let ((inhibit-read-only t))
- (erase-buffer)
- (kill-all-local-variables)
- (help-mode)
- (view-mode -1)
- (insert "This buffer describes the name reading engine for xetla
-
-You are prompted for a fully qualified archive, category, branch,
-version, or revision, which means a string like
-\"John.Smith@rt.fm-arch/xetla-revolutionary-1.0\". Completion is
-available with TAB. Only the item being entered is proposed for
-completion, which means that if you're typing the archive name,
-pressing TAB will give you the list of archives. If you started to
-type the category name, you'll get the list of category for this
-archive.
-
-Here's a list of other interesting bindings available in the
-minibuffer:
-
-")
- (let ((interesting (mapcar (lambda (pair) (cdr pair))
- xetla-name-read-extension-keydefs)))
- (dolist (func interesting)
- (let* ((keys (where-is-internal func xetla-name-read-minibuf-map))
- (keys1 ""))
- (while keys
- (when (not (eq 'menu-bar (aref (car keys) 0)))
- (setq keys1 (if (string= keys1 "") (key-description (car keys))
- (concat keys1 ", "
- (key-description (car keys))))))
- (setq keys (cdr keys)))
- (insert (format "%s%s\t`%s'\n" keys1
- (make-string (max 0 (- 5 (length keys1))) ?\ )
- (symbol-name func))))))
- (goto-char (point-min))
- (xetla-funcall-if-exists
- help-setup-xref (list 'xetla-name-read-help)
- (interactive-p)))
- (display-buffer (current-buffer))
- (toggle-read-only 1))
-
-(defun xetla-name-read-inline-help ()
- "Displays a help message in echo area."
- (interactive)
- (let ((interesting (mapcar (lambda (pair) (cdr pair))
- xetla-name-read-extension-keydefs))
- (line ""))
- (dolist (func interesting)
- (let* ((keys (where-is-internal func xetla-name-read-minibuf-map))
- (keys1 "")
- (func (symbol-name func)))
- (while keys
- (when (not (eq 'menu-bar (aref (car keys) 0)))
- (setq keys1 (if (string= keys1 "") (key-description (car keys))
- (concat keys1 ", "
- (key-description (car keys))))))
- (setq keys (cdr keys)))
- (setq func (progn (string-match "xetla-name-read-\\(.+\\)"
- func)
- (match-string 1 func)))
- (setq line (concat line (format "%s => `%s'" keys1 func) " "))))
- (xetla-message-with-rolling line)
- ))
-
-
-
-
-(defun xetla-read-revision-with-default-tree (&optional prompt tree)
- "Read revision name with `xetla-name-read'.
-PROMPT is passed to `xetla-name-read' without changing.
-Default version associated with TREE, a directory is used as default arguments
-for`xetla-name-read'."
- (setq tree (xetla-tree-root (or tree default-directory) t))
- (let ((tree-rev (xetla-tree-version-list tree)))
- (xetla-name-read prompt
- (if tree-rev (xetla-name-archive tree-rev) 'prompt)
- (if tree-rev (xetla-name-category tree-rev) 'prompt)
- (if tree-rev (xetla-name-branch tree-rev) 'prompt)
- (if tree-rev (xetla-name-version tree-rev) 'prompt)
- 'prompt)))
-
-;;
-;; Version for the tree of default directory
-;;
-(defvar xetla-name-read-insert-version-associated-with-default-directory nil)
-(defun xetla-name-read-insert-version-associated-with-default-directory (&optional force)
- "Insert the version for the tree of the directory specified by .
-
-If FORCE is non-nil, insert the version even if the minibuffer isn't empty."
- (interactive "P")
- (let ((version-for-tree
- (xetla-name-mask
- (xetla-tree-version-list
- (if xetla-name-read-insert-version-associated-with-default-directory
- xetla-name-read-insert-version-associated-with-default-directory
- default-directory))
- t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version))))
- (if (and (window-minibuffer-p (selected-window))
- (or force (equal "" (buffer-substring))))
- (insert version-for-tree))))
-
-;;
-;; Default archive
-;;
-(defun xetla-name-read-insert-default-archive (&optional force)
- "Insert default archive name into the minibuffer if it is empty.
-
-If FORCE is non-nil, insert the archive name even if the minibuffer
-isn't empty."
- (interactive "P")
- (if (and (window-minibuffer-p (selected-window))
- (or (equal "" (buffer-substring)) force)
- (member
- (xetla-name-read-arguments 'archive)
- '(prompt maybe)))
- (insert (xetla-my-default-archive))))
-
-;;
-;; Info at point
-;;
-(defvar xetla-name-read-insert-info-at-point nil)
-(defvar xetla-name-read-insert-info-at-point-extent nil)
-(defun xetla-name-read-insert-info-at-point (&optional force)
- "Insert the info(maybe revision) under the point to the minibuffer.
-
-If FORCE is non-nil, insert the version even if the minibuffer isn't
-empty."
- (interactive "P")
- (let ((info-at-point
- (or xetla-name-read-insert-info-at-point
- (xetla-name-read-insert-version-associated-with-default-directory))))
- (when (and (window-minibuffer-p (selected-window))
- (or (equal "" (buffer-substring)) force)
- info-at-point)
- (insert info-at-point))))
-
-(defun xetla-name-read-insert-info-at-point-init ()
- "This function retrieves the info at point.
-
-Further call to `xetla-name-read-insert-info-at-point-final' will
-actuall insert the value computed here."
- (setq xetla-name-read-insert-info-at-point
- (let ((raw-info (cadr (xetla-get-info-at-point)))
- (b (previous-single-property-change (point) 'menu))
- (e (next-single-property-change (point) 'menu)))
- (when raw-info
- (when (and b e)
- (setq xetla-name-read-insert-info-at-point-extent
- (make-extent (1- b) e))
- (set-extent-property xetla-name-read-insert-info-at-point-extent
- 'face 'xetla-highlight))
- (xetla-name-mask
- (xetla-name-split raw-info) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision))))))
-
-(defun xetla-name-read-insert-info-at-point-final (&optional no-use)
- "Called when exitting the minibuffer prompt.
-
-Cancels the effect of `xetla-name-read-insert-info-at-point-init'.
-
-Argument NO-USE is ignored."
- (when xetla-name-read-insert-info-at-point-extent
- (delete-extent xetla-name-read-insert-info-at-point-extent)
- (setq xetla-name-read-insert-info-at-point-extent nil)))
-
-;;
-;; Partner file
-;;
-(defvar xetla-name-read-insert-partner-ring-position nil)
-(defun xetla-name-read-insert-partner-init ()
- "Initialize \"Insert Partner Version\" menu used in `xetla-name-read'."
- (setq xetla-name-read-insert-partner-ring-position nil)
- ;; Create menu items
- (setq xetla-name-read-partner-menu (cons "Insert Partner Version" nil))
- (let ((partners (reverse (xetla-partner-list))))
- (mapc (lambda (p)
- (setq p (xetla-name-mask
- (xetla-name-split p) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))
- (setcdr xetla-name-read-partner-menu
- (cons (cons p
- (cons p
- `(lambda () (interactive)
- (delete-region
- (minibuffer-prompt-end) (point-max))
- (insert ,p))))
- (cdr xetla-name-read-partner-menu))))
- partners))
- (fset 'xetla-name-read-partner-menu (cons 'keymap xetla-name-read-partner-menu)))
-
-(defun xetla-name-read-insert-partner-previous ()
- "Insert the previous partner version into miniffer."
- (interactive)
- (let* ((partners (xetla-partner-list))
- (plen (length partners))
- (pos (if xetla-name-read-insert-partner-ring-position
- (if (eq xetla-name-read-insert-partner-ring-position 0)
- (1- plen)
- (1- xetla-name-read-insert-partner-ring-position))
- 0))
- (pversion (when partners (xetla-name-mask
- (xetla-name-split (nth pos partners)) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))))
- (when (and (window-minibuffer-p (selected-window))
- partners
- pversion)
- (delete-region (minibuffer-prompt-end) (point-max))
- (insert pversion)
- (setq xetla-name-read-insert-partner-ring-position pos))))
-
-(defun xetla-name-read-insert-partner-next ()
- "Insert the next partner version into the miniffer."
- (interactive)
- (let* ((partners (xetla-partner-list))
- (plen (length partners))
- (pos (if xetla-name-read-insert-partner-ring-position
- (if (eq xetla-name-read-insert-partner-ring-position (1- plen))
- 0
- (1+ xetla-name-read-insert-partner-ring-position))
- 0))
- (pversion (when partners (xetla-name-mask
- (xetla-name-split (nth pos partners)) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))))
- (when (and (window-minibuffer-p (selected-window))
- partners
- pversion)
- (delete-region (minibuffer-prompt-end) (point-max))
- (insert pversion)
- (setq xetla-name-read-insert-partner-ring-position pos))))
-
-;;
-;; Ancestor
-;;
-(defun xetla-name-read-insert-ancestor (&optional force)
- "Insert the ancestor name into the minibuffer if it is empty.
-
-If FORCE is non-nil, insert the ancestor even if the minibuffer isn't
-empty."
- (interactive "P")
- (let* ((version (xetla-tree-version-list default-directory))
- (ancestor (when (and version
- (not (eq this-command 'xetla-compute-direct-ancestor)))
- (xetla-compute-direct-ancestor
- (xetla-name-mask version nil
- t t t t "base-0")))))
- (when (and ancestor
- (window-minibuffer-p (selected-window))
- (or (equal "" (buffer-substring)) force)
- (member
- (xetla-name-read-arguments 'archive)
- '(prompt maybe)))
- (insert (xetla-name-mask
- ancestor t
- t
- (member
- (xetla-name-read-arguments 'category)
- '(prompt maybe))
- (member
- (xetla-name-read-arguments 'branch)
- '(prompt maybe))
- (member
- (xetla-name-read-arguments 'version)
- '(prompt maybe))
- (member
- (xetla-name-read-arguments 'revision)
- '(prompt maybe)))))))
-
-;;
-;; Partners in Bookmark
-;;
-(defvar xetla-name-read-insert-bookmark-ring-position nil)
-(defun xetla-name-read-insert-bookmark-init ()
- "Initialize \"Insert Version in Bookmark\" menu used in `xetla-name-read'."
- (setq xetla-name-read-insert-bookmark-ring-position nil)
- ;; Create menu items
- (setq xetla-name-read-bookmark-menu (cons "Insert Version in Bookmark" nil))
- (let* ((default-version (xetla-tree-version-list default-directory 'no-error))
- (bookmarks (when default-version
- (nreverse (xetla-bookmarks-get-partner-versions default-version)))))
- (mapc (lambda (p)
- (setq p (xetla-name-mask
- p t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))
- (setcdr xetla-name-read-bookmark-menu
- (cons (cons p
- (cons p
- `(lambda () (interactive)
- (delete-region
- (minibuffer-prompt-end) (point-max))
- (insert ,p))))
- (cdr xetla-name-read-bookmark-menu))))
- bookmarks))
- (fset 'xetla-name-read-bookmark-menu (cons 'keymap xetla-name-read-bookmark-menu)))
-
-(defun xetla-name-read-insert-bookmark-previous ()
- "Insert the previous partner version in the bookmark into minibuffer."
- (interactive)
- (let* ((default-version (xetla-tree-version-list default-directory))
- (bookmarks (when default-version
- (nreverse (xetla-bookmarks-get-partner-versions default-version))))
- (plen (length bookmarks))
- (pos (if xetla-name-read-insert-bookmark-ring-position
- (if (eq xetla-name-read-insert-bookmark-ring-position 0)
- (1- plen)
- (1- xetla-name-read-insert-bookmark-ring-position))
- 0))
- (pversion (when bookmarks (xetla-name-mask
- (nth pos bookmarks) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))))
- (when (and (window-minibuffer-p (selected-window))
- bookmarks
- pversion)
- (delete-region (minibuffer-prompt-end) (point-max))
- (insert pversion)
- (setq xetla-name-read-insert-bookmark-ring-position pos))))
-
-(defun xetla-name-read-insert-bookmark-next ()
- "Insert the next partner version in the bookmark into the miniffer."
- (interactive)
- (let* ((default-version (xetla-tree-version-list default-directory))
- (bookmarks (when default-version
- (nreverse (xetla-bookmarks-get-partner-versions default-version))))
- (plen (length bookmarks))
- (pos (if xetla-name-read-insert-bookmark-ring-position
- (if (eq xetla-name-read-insert-bookmark-ring-position (1- plen))
- 0
- (1+ xetla-name-read-insert-bookmark-ring-position))
- 0))
- (pversion (when bookmarks (xetla-name-mask
- (nth pos bookmarks) t
- (xetla-name-read-arguments 'archive)
- (xetla-name-read-arguments 'category)
- (xetla-name-read-arguments 'branch)
- (xetla-name-read-arguments 'version)
- (xetla-name-read-arguments 'revision)))))
- (when (and (window-minibuffer-p (selected-window))
- bookmarks
- pversion)
- (delete-region (minibuffer-prompt-end) (point-max))
- (insert pversion)
- (setq xetla-name-read-insert-bookmark-ring-position pos))))
-
-(add-hook 'xetla-name-read-init-hook
- 'xetla-name-read-insert-info-at-point-init)
-(add-hook 'xetla-name-read-final-hook
- 'xetla-name-read-insert-info-at-point-final)
-(add-hook 'xetla-name-read-error-hook
- 'xetla-name-read-insert-info-at-point-final)
-(add-hook 'xetla-name-read-init-hook
- 'xetla-name-read-insert-partner-init)
-(add-hook 'xetla-name-read-init-hook
- 'xetla-name-read-insert-bookmark-init)
-
-(defun xetla-tree-root (&optional location no-error)
- "Return the tree root for LOCATION, nil if not in a local tree.
-Computation is done from withing Emacs, by looking at an {arch}
-directory in a parent buffer of LOCATION. This is therefore very
-fast.
-
-If NO-ERROR is non-nil, don't raise an error if LOCATION is not an
-arch managed tree (but return nil)."
- (setq location (or location default-directory))
- (let ((pwd location))
- (while (not (or (string= pwd "/")
- (file-exists-p (concat (file-name-as-directory pwd) "{arch}"))))
- (setq pwd (expand-file-name (concat (file-name-as-directory pwd) ".."))))
- (if (file-exists-p (concat pwd "/{arch}/=tagging-method"))
- (expand-file-name
- (replace-regexp-in-string "/+$" "/" pwd))
- (if no-error
- nil
- (error "%S is not in an arch-managed tree!" location)))))
-
-(defun xetla-read-project-tree-maybe (&optional prompt directory)
- "Return a directory name which is the root of some project tree.
-Either prompt from the user or use the current directory. The
-recommended usage is
-
- (defun xetla-some-feature (...)
- (let ((default-directory (xetla-read-project-tree-maybe
- \"Run some feature in\")))
- (code-for-some-feature))
-
-The behavior can be changed according to the value of
-`xetla-read-project-tree-mode'.
-
-PROMPT is used as a user prompt, and DIRECTORY is the default
-directory."
- (let ((root (xetla-tree-root (or directory default-directory) t))
- (default-directory (or (xetla-tree-root
- (or directory default-directory) t)
- directory
- default-directory))
- (prompt (or prompt "Use directory: ")))
- (case xetla-read-project-tree-mode
- (always (xetla-tree-root (read-directory-name prompt)))
- (sometimes (or root
- (xetla-tree-root (read-directory-name prompt))))
- (never (or root
- (error "Not in a project tree")))
- (t (error "Wrong value for xetla-prompt-for-directory")))))
-
-(defun xetla-read-directory-maybe (&optional prompt directory force)
- "Read a directory name inside an arch managed tree.
-
-Return a directory name which is a subdirectory or the root of some
-project tree. Works in a way similar to
-`xetla-read-project-tree-maybe', but is customized with the variable
-`xetla-read-directory-mode'.
-
-PROMPT is the user prompt, and DIRECTORY is the default directory."
- (let ((root (xetla-tree-root (or directory default-directory) t))
- (default-directory (or directory default-directory))
- (prompt (or prompt "Use directory: ")))
- (case xetla-read-directory-mode
- (always (read-directory-name prompt))
- (sometimes
- (cond (force
- (read-directory-name prompt))
- (root
- default-directory)
- (t
- (read-directory-name prompt))))
- (never (if root (or directory default-directory)
- (error "Not in a project tree")))
- (t (error "Wrong value for xetla-read-directory-mode")))))
-
-(defun xetla-save-some-buffers (&optional tree)
- "Save all buffers visiting a file in TREE."
- (let ((ok t)
- (tree (or (xetla-tree-root tree t)
- tree)))
- (unless tree
- (error "Not in a project tree"))
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (buffer-modified-p)
- (let ((file (buffer-file-name)))
- (when file
- (let ((root (xetla-tree-root (file-name-directory file) t))
- (tree-exp (expand-file-name tree)))
- (when (and root
- (string= (file-name-as-directory root) tree-exp)
- ;; buffer is modified and in the tree TREE.
- (or xetla-do-not-prompt-for-save
- (y-or-n-p (concat "Save buffer "
- (buffer-name)
- "? "))
- (setq ok nil)))
- (save-buffer))))))))
- ok))
-
-(defun xetla-revert-some-buffers (&optional tree)
- "Reverts all buffers visiting a file in TREE that aren't modified.
-To be run after an update or a merge."
- (let ((tree (xetla-tree-root tree)))
- (dolist (buffer (buffer-list))
- (with-current-buffer buffer
- (when (not (buffer-modified-p))
- (let ((file (buffer-file-name)))
- (when file
- (let ((root (xetla-uniquify-file-name
- (xetla-tree-root (file-name-directory file) t)))
- (tree-exp (xetla-uniquify-file-name
- (expand-file-name tree))))
- (when (and (string= root tree-exp)
- ;; buffer is modified and in the tree TREE.
- xetla-automatically-revert-buffers)
- ;; Keep the buffer if the file doesn't exist
- (if (file-exists-p file)
- (revert-buffer t t)))))))))))
-
-;; --------------------------------------
-;; xetla help system for commands that get input from the user via the minibuffer
-;; --------------------------------------
-
-;; GENERIC: This functionality should be in emacs itself. >> Masatake
-;; to check: we should use some other binding for this, perhaps f1 C-m
-(defun xetla-display-command-help (command)
- "Help system for commands that get input via the minibuffer.
-
-This is an internal function called by `xetla-show-command-help'.
-
-COMMAND is the last command executed."
- (with-electric-help
- (lambda ()
- (let ((cmd-help (when (fboundp command)
- (documentation command))))
- (delete-region (point-min) (point-max))
- (insert (if cmd-help
- (format "Help for %S:\n%s" command cmd-help)
- (format "No help available for %S" command)))))
- " *xetla-command-help*"))
-
-(defvar xetla-command-stack nil)
-
-(defun xetla-minibuffer-setup ()
- "Function called in `minibuffer-setup-hook'.
-
-Memorize last command run."
- (push this-command xetla-command-stack))
-
-(defun xetla-minibuffer-exit ()
- "Function called in `minibuffer-exit-hook'.
-
-Cancels the effect of `xetla-minibuffer-setup'."
- (pop xetla-command-stack))
-
-(defun xetla-show-command-help ()
- "Help system for commands that get input via the minibuffer.
-
-When the user is asked for input in the minibuffer, a help for the
-command will be shown, if the user hits \\<minibuffer-local-map>\\[xetla-show-command-help].
-This functionality is not only for xetla commands available it is
-available for all Emacs commands."
- (interactive)
- (xetla-display-command-help (car xetla-command-stack)))
-
-(when xetla-install-command-help-system
- (define-key minibuffer-local-map [f1]
- 'xetla-show-command-help)
- (define-key minibuffer-local-completion-map [f1]
- 'xetla-show-command-help)
- (define-key minibuffer-local-must-match-map [f1]
- 'xetla-show-command-help)
- (define-key minibuffer-local-map [(control meta ?h)]
- 'xetla-show-command-help)
- (define-key minibuffer-local-completion-map [(control meta ?h)]
- 'xetla-show-command-help)
- (define-key minibuffer-local-must-match-map [(control meta ?h)]
- 'xetla-show-command-help)
- (add-hook 'minibuffer-setup-hook 'xetla-minibuffer-setup)
- (add-hook 'minibuffer-exit-hook 'xetla-minibuffer-exit))
-
-;; --------------------------------------
-;; Top level xetla commands
-;; --------------------------------------
-(defcustom xetla-make-log-function 'xetla-default-make-log-function
- "*Function used to create the log buffer.
-
-Must return a string which is the absolute name of the log file. This
-function is called only when the log file doesn't exist already. The
-default is `xetla-default-make-log-function', which just calls \"xetla
-make-log\". If you want to override this function, you may just write
-a wrapper around `xetla-default-make-log-function'."
- :type 'function
- :group 'xetla)
-
-(defun xetla-make-log ()
- "Create the log file and return its filename.
-
-If the file exists, its name is returned. Otherwise, the log file is
-created by the function specified by `xetla-make-log-function', which,
-by default, calls \"xetla make-log\"."
- (interactive)
- (let* ((version (xetla-tree-version-list))
- (file (concat (xetla-tree-root) "++log."
- (xetla-name-category version) "--"
- (xetla-name-branch version) "--"
- (xetla-name-version version) "--"
- (xetla-name-archive version))))
- (if (file-exists-p file)
- file
- (funcall xetla-make-log-function))))
-
-(defun xetla-default-make-log-function ()
- "Candidate (and default value) for `xetla-make-log-function'.
-Calls \"xetla make-log\" to generate the log file."
- (xetla-run-tla-sync '("make-log")
- :finished
- (lambda (output error status arguments)
- (xetla-buffer-content output))))
-
-(defun xetla-pop-to-inventory ()
- "Call `xetla-inventory' with a prefix arg."
- (interactive)
- (xetla-inventory nil t))
-
-(defvar xetla-inventory-cookie nil)
-(defvar xetla-inventory-list nil
- "Full list for the inventory.")
-
-(defun xetla-inventory-goto-file (file)
- "Put cursor on FILE. nil return means the file hasn't been found."
- (goto-char (point-min))
- (let ((current (ewoc-locate xetla-inventory-cookie)))
- (while (and current (not (string= (caddr (ewoc-data current))
- file)))
- (setq current (ewoc-next xetla-inventory-cookie current)))
- (when current (xetla-inventory-cursor-goto current))
- current))
-
-
-(defun xetla-inventory-make-toggle-fn-and-var (variable function)
- "Define the VARIABLE and the toggle FUNCTION for type TYPE."
- (make-variable-buffer-local variable)
- (eval `(defun ,function ()
- (interactive)
- (setq ,variable (not ,variable))
- (xetla-inventory-redisplay))))
-
-(dolist (type-arg xetla-inventory-file-types-manipulators)
- (xetla-inventory-make-toggle-fn-and-var (cadr type-arg) (caddr type-arg)))
-
-(defun xetla-inventory-redisplay ()
- "Refresh *xetla-inventory* buffer."
- (let* ((elem (ewoc-locate xetla-inventory-cookie))
- (file (when elem (caddr (ewoc-data elem))))
- (pos (point)))
- (xetla-inventory-display)
- (or (and file
- (xetla-inventory-goto-file file))
- (goto-char pos))
- (xetla-inventory-cursor-goto (ewoc-locate xetla-inventory-cookie))))
-
-
-(defun xetla-inventory-set-toggle-variables (new-value)
- "Set all xetla-inventory-display-* variables.
-If NEW-VALUE is 'toggle set the values to (not xetla-inventory-display-*
-Otherwise set it to NEW-VALUE."
- (dolist (type-arg xetla-inventory-file-types-manipulators)
- (eval `(setq ,(cadr type-arg)
- (if (eq new-value 'toggle)
- (not ,(cadr type-arg))
- new-value)))))
-
-(defun xetla-inventory-set-all-toggle-variables ()
- "Set all inventory toggle variables to t."
- (interactive)
- (xetla-inventory-set-toggle-variables t)
- (xetla-inventory-redisplay))
-
-(defun xetla-inventory-reset-all-toggle-variables ()
- "Set all inventory toggle variables to nil."
- (interactive)
- (xetla-inventory-set-toggle-variables nil)
- (xetla-inventory-redisplay))
-
-(defun xetla-inventory-toggle-all-toggle-variables ()
- "Toggle the value of all inventory toggle variables."
- (interactive)
- (xetla-inventory-set-toggle-variables 'toggle)
- (xetla-inventory-redisplay))
-
-
-;;;###autoload
-(defun xetla-inventory (&optional directory arg)
- "Show a xetla inventory at DIRECTORY.
-When called with a prefix arg, pop to the inventory buffer.
-DIRECTORY defaults to the current one when within an arch managed tree,
-unless prefix argument ARG is non-nil."
- (interactive (list (xetla-read-directory-maybe
- "Run inventory in (directory): "
- nil current-prefix-arg)
- current-prefix-arg))
- (let ((default-directory (or directory default-directory)))
- (if arg
- (pop-to-buffer (xetla-get-buffer-create 'inventory directory))
- (switch-to-buffer (xetla-get-buffer-create 'inventory directory))))
- (xetla-inventory-mode)
- (xetla-run-tla-sync
- ;; We have to provide all file types or xetla inventory won't display
- ;; junk files
- '("inventory" "--both" "--kind" "--source" "--backups" "--junk"
- "--unrecognized" "--precious")
- :finished
- (lambda (output error status arguments)
- (let ((list (split-string (xetla-buffer-content output) "\n"))
- (inventory-list '()))
- (mapc
- (lambda (item)
- (when (string-match "\\([A-Z]\\)\\([\\? ]\\) +\\([^ ]\\) \\(.*\\)"
- item)
- (let ((xetla-type (string-to-char (match-string 1 item)))
- (question (string= (match-string 2 item) "?"))
- (escaped-filename (match-string 4 item))
- (type (string-to-char (match-string 3 item))))
- (push (list xetla-type
- question
- (xetla-unescape escaped-filename)
- type)
- inventory-list))))
- list)
- (setq inventory-list (reverse inventory-list))
- (set (make-local-variable 'xetla-inventory-list)
- inventory-list)
- (xetla-inventory-display)))))
-
-(defun xetla-inventory-display ()
- "Display the inventory.
-This function creates the ewoc from the variable `xetla-inventory-list',
-selecting only files to print."
- (interactive)
- (let (buffer-read-only)
- (erase-buffer)
- (set (make-local-variable 'xetla-inventory-cookie)
- (ewoc-create 'xetla-inventory-printer))
- (xetla-inventory-insert-headers)
- (dolist (elem xetla-inventory-list)
- (let ((type (car elem)))
- (if (eval (cadr (assoc type
- xetla-inventory-file-types-manipulators)))
- (ewoc-enter-last xetla-inventory-cookie elem)))))
- (goto-char (point-min)))
-
-(defun xetla-inventory-chose-face (type)
- "Return a face adapted to TYPE, which can be J, S, P, T or U."
- (case type
- (?P 'xetla-precious)
- (?U 'xetla-unrecognized)
- (?S 'xetla-source)
- (?J 'xetla-junk)
- (?T 'xetla-nested-tree)))
-
-(defun xetla-inventory-printer (elem)
- "Ewoc printer for `xetla-inventory-cookie'.
-Pretty print ELEM."
- (let* ((type (nth 0 elem))
- (question (nth 1 elem))
- (file (nth 2 elem))
- (file-type (nth 3 elem))
- (face (xetla-inventory-chose-face type)))
- (insert (if (member file xetla-buffer-marked-file-list)
- (concat " " xetla-mark " ") " "))
- (insert (xetla-face-add (format "%c%s "
- type
- (if question "?" " "))
- face)
- (xetla-face-add
- (format "%s%s" file
- (case file-type (?d "/") (?> "@") (t "")))
- face
- 'xetla-inventory-item-map
- xetla-inventory-item-menu))))
-
-(defun xetla-inventory-mark-file ()
- "Mark file at point in inventory mode.
-
-Adds it to the variable `xetla-buffer-marked-file-list', and move cursor
-to the next entry."
- (interactive)
- (let ((current (ewoc-locate xetla-inventory-cookie))
- (file (xetla-get-file-info-at-point)))
- (add-to-list 'xetla-buffer-marked-file-list file)
- (ewoc-refresh xetla-inventory-cookie)
- (xetla-inventory-cursor-goto (or (ewoc-next xetla-inventory-cookie
- current)
- current))))
-
-(defun xetla-inventory-unmark-file ()
- "Unmark file at point in inventory mode."
- (interactive)
- (let ((current (ewoc-locate xetla-inventory-cookie))
- (file (xetla-get-file-info-at-point)))
- (setq xetla-buffer-marked-file-list
- (delete file xetla-buffer-marked-file-list))
- (ewoc-refresh xetla-inventory-cookie)
- (xetla-inventory-cursor-goto (or (ewoc-next xetla-inventory-cookie
- current)
- current))))
-
-(defun xetla-inventory-unmark-all ()
- "Unmark all files in inventory mode."
- (interactive)
- (let ((current (ewoc-locate xetla-inventory-cookie)))
- (setq xetla-buffer-marked-file-list nil)
- (ewoc-refresh xetla-inventory-cookie)
- (xetla-inventory-cursor-goto current)))
-
-(defvar xetla-get-file-info-at-point-function nil
- "Function used to get the file at point, anywhere.")
-
-(defun xetla-get-file-info-at-point ()
- "Gets the filename at point, according to mode.
-Actually calls the function `xetla-get-file-info-at-point-function'."
- (when xetla-get-file-info-at-point-function
- (funcall xetla-get-file-info-at-point-function)))
-
-(defvar xetla-generic-select-files-function nil
- "Function called by `xetla-generic-select-files'.
-Must be local to each buffer.")
-
-(defun xetla-generic-select-files (msg-singular
- msg-plural msg-err
- msg-prompt
- &optional
- no-group ignore-marked
- no-prompt
- y-or-n)
- "Get the list of files at point, and ask confirmation of the user.
-
-This is a generic function calling
-`xetla-generic-select-files-function', defined locally for each xetla
-buffer. The behavior should be the following:
-
-Prompt with either MSG-SINGULAR, MSG-PLURAL, MSG-ERR OR MSG-PROMPT. If
-NO-GROUP is nil and if the cursor is on the beginning of a group, all
-the files belonging to this message are selected. If some files are
-marked \(i.e. `xetla-buffer-marked-file-list' is non-nil) and
-IGNORE-MARKED is non-nil, the list of marked files is returned. If
-NO-PROMPT is non-nil, don't ask for confirmation. If Y-OR-N is
-non-nil, then this function is used instead of `y-or-n-p'."
- (when xetla-generic-select-files-function
- (funcall xetla-generic-select-files-function
- msg-singular msg-plural msg-err msg-prompt no-group
- ignore-marked no-prompt y-or-n)))
-
-(defun xetla-generic-find-file-at-point ()
- "Opens the file at point.
-
-The filename is obtained with `xetla-get-file-info-at-point', so, this
-function should be useable in all modes seting
-`xetla-get-file-info-at-point-function'"
- (interactive)
- (let* ((file (xetla-get-file-info-at-point)))
- (cond
- ((not file)
- (error "No file at point"))
- (t
- (find-file file)))))
-
-(xetla-make-bymouse-function xetla-generic-find-file-at-point)
-
-(defun xetla-generic-find-file-other-window ()
- "Visit the current inventory file in the other window."
- (interactive)
- (let ((file (xetla-get-file-info-at-point)))
- (if file
- (progn
- (find-file-other-window file))
- (error "No file at point"))))
-
-(defun xetla-generic-view-file ()
- "Visit the current inventory file in view mode."
- (interactive)
- (let ((file (xetla-get-file-info-at-point)))
- (if file
- (view-file-other-window file)
- (error "No file at point"))))
-
-(defun xetla-inventory-get-file-info-at-point ()
- "Gets the file at point in inventory mode."
- (caddr (ewoc-data (ewoc-locate xetla-inventory-cookie))))
-
-(defun xetla-inventory-insert-headers ()
- "Insert the header (top of buffer) for *xetla-inventory*."
- (let* ((tree-version (xetla-name-construct
- (xetla-tree-version-list nil 'no-error)))
- (tagging-method (xetla-id-tagging-method nil))
- (separator
- (xetla-face-add (make-string
- (max (+ (length "Directory: ") (length default-directory))
- (+ (length "Default Tree Version: ") (length tree-version))
- (+ (length "ID Tagging Method: ") (length tagging-method)))
- ?\ )
- 'xetla-separator)))
- (ewoc-set-hf
- xetla-inventory-cookie
- (concat
- "Directory: " (xetla-face-add default-directory 'xetla-local-directory
- (let ((map (make-sparse-keymap))
- (func `(lambda ()
- (interactive)
- (dired ,default-directory))))
- (define-key map [return] func)
- (define-key map "\C-m" func)
- (define-key map [button2] func)
- map)
- nil
- "Run Dired Here") "\n"
- "Default Tree Version: " (xetla-face-add tree-version 'xetla-archive-name
- 'xetla-inventory-default-version-map
- (xetla-partner-create-menu
- 'xetla-generic-set-tree-version
- "Change the Default Tree Version")) "\n"
- "ID Tagging Method: " (xetla-face-add tagging-method 'xetla-tagging-method
- 'xetla-inventory-tagging-method-map
- xetla-inventory-tagging-method-menu) "\n"
- separator "\n")
- (concat "\n" separator))))
-
-(defvar xetla-buffer-source-buffer nil
- "Buffer from where a command was called.")
-
-;;;###autoload
-(defun xetla-edit-log (&optional insert-changelog source-buffer)
- "Edit the xetla log file.
-
-With an optional prefix argument INSERT-CHANGELOG, insert the last
-group of entries from the ChangeLog file. SOURCE-BUFFER, if non-nil,
-is the buffer from which the function was called. It is used to get
-the list of marked files, and potentially run a selected file commit."
- (interactive "P")
- (setq xetla-pre-commit-window-configuration
- (current-window-configuration))
- (setq xetla-log-edit-file-name (xetla-make-log))
- (xetla-switch-to-buffer
- (find-file-noselect xetla-log-edit-file-name))
- (when insert-changelog
- (goto-char (point-max))
- (let ((buf (find-file-noselect (find-change-log))))
- (insert-buffer buf))
- (when (re-search-forward "^2" nil t)
- (delete-region (point-at-bol)
- (point-at-bol 3)))
- (when (re-search-forward "^2" nil t)
- (delete-region (point-at-bol) (point-max)))
- (goto-char (point-min)))
- (xetla-log-edit-mode)
- (set (make-local-variable 'xetla-buffer-source-buffer)
- source-buffer)
- (end-of-line))
-
-;;;###autoload
-(defun xetla-add-log-entry ()
- "Add new xetla log ChangeLog style entry."
- (interactive)
- (save-restriction
- (xetla-add-log-entry-internal)))
-
-(defun xetla-add-log-entry-internal ()
- "Similar to `add-change-log-entry'.
-
-Inserts the entry in the arch log file instead of the ChangeLog."
- ;; This is mostly copied from add-log.el. Perhaps it would be better to
- ;; split add-change-log-entry into several functions and then use them, but
- ;; that wouldn't work with older versions of Emacs.
- (require 'add-log)
- (let* ((defun (add-log-current-defun))
- (buf-file-name (if (and (boundp 'add-log-buffer-file-name-function)
- add-log-buffer-file-name-function)
- (funcall add-log-buffer-file-name-function)
- buffer-file-name))
- (buffer-file (if buf-file-name (expand-file-name buf-file-name)))
- (file-name (xetla-make-log))
- ;; Set ENTRY to the file name to use in the new entry.
- (entry (add-log-file-name buffer-file file-name))
- beg
- bound
- narrowing)
- (xetla-edit-log)
- (undo-boundary)
- (goto-char (point-min))
- (when (re-search-forward "^Patches applied:" nil t)
- (narrow-to-region (point-min) (match-beginning 0))
- (setq narrowing t)
- (goto-char (point-min)))
- (re-search-forward "\n\n\\|\\'")
- (setq beg (point))
- (setq bound
- (progn
- (if (looking-at "\n*[^\n* \t]")
- (skip-chars-forward "\n")
- (if (and (boundp 'add-log-keep-changes-together)
- add-log-keep-changes-together)
- (goto-char (point-max))
- (forward-paragraph))) ; paragraph delimits entries for file
- (point)))
- (goto-char beg)
- (forward-line -1)
- ;; Now insert the new line for this entry.
- (cond ((re-search-forward "^\\s *\\*\\s *$" bound t)
- ;; Put this file name into the existing empty entry.
- (if entry
- (insert entry)))
- ((let (case-fold-search)
- (re-search-forward
- (concat (regexp-quote (concat "* " entry))
- ;; Don't accept `foo.bar' when
- ;; looking for `foo':
- "\\(\\s \\|[(),:]\\)")
- bound t))
- ;; Add to the existing entry for the same file.
- (re-search-forward "^\\s *$\\|^\\s \\*")
- (goto-char (match-beginning 0))
- ;; Delete excess empty lines; make just 2.
- (while (and (not (eobp)) (looking-at "^\\s *$"))
- (delete-region (point) (point-at-bol 2)))
- (insert-char ?\n 2)
- (forward-line -2)
- (indent-relative-maybe))
- (t
- ;; Make a new entry.
- (if xetla-log-insert-last
- (progn
- (goto-char (point-max))
- (re-search-backward "^.")
- (end-of-line)
- (insert "\n\n* ")
- )
- (forward-line 1)
- (while (looking-at "\\sW")
- (forward-line 1))
- (while (and (not (eobp)) (looking-at "^\\s *$"))
- (delete-region (point) (point-at-bol 2)))
- (insert-char ?\n 3)
- (forward-line -2)
- (indent-to left-margin)
- (insert "* "))
- (if entry (insert entry))))
- (if narrowing (widen))
- ;; Now insert the function name, if we have one.
- ;; Point is at the entry for this file,
- ;; either at the end of the line or at the first blank line.
- (if defun
- (progn
- ;; Make it easy to get rid of the function name.
- (undo-boundary)
- (unless (save-excursion
- (beginning-of-line 1)
- (looking-at "\\s *$"))
- (insert ?\ ))
- ;; See if the prev function name has a message yet or not
- ;; If not, merge the two entries.
- (let ((pos (point-marker)))
- (if (and (skip-syntax-backward " ")
- (skip-chars-backward "):")
- (looking-at "):")
- (progn (delete-region (+ 1 (point)) (+ 2 (point))) t)
- (> fill-column (+ (current-column) (length defun) 3)))
- (progn (delete-region (point) pos)
- (insert ", "))
- (goto-char pos)
- (insert "("))
- (set-marker pos nil))
- (insert defun "): "))
- ;; No function name, so put in a colon unless we have just a star.
- (unless (save-excursion
- (beginning-of-line 1)
- (looking-at "\\s *\\(\\*\\s *\\)?$"))
- (insert ": ")))))
-
-(defvar xetla-changes-cookie nil
- "Ewoc cookie for the changes buffer.
-
-Element should look like
-
- (file \"filename\" \"M\" \"/\")
- (file \"newname\" \"M\" \"/\" \"filename\")
- (subtree \"name\" related-buffer changes?)
- (message \"doing such or such thing\")")
-
-(defun xetla-changes-delete-messages (&optional immediate)
- "Remove messages from the ewoc list of modifications.
-
-if IMMEDIATE is non-nil, refresh the display too."
- (when xetla-changes-cookie
- (ewoc-filter xetla-changes-cookie
- (lambda (elem)
- (not (eq (car elem) 'message))))))
-
-(defvar xetla-changes-summary nil
- "Wether the current buffer display only a summary or a full diff.")
-
-(defvar xetla-changes-buffer-master-buffer nil
- "Master buffer for a nested *xetla-changes* buffer.")
-
-(defvar xetla-changes-summary nil
- "Wether the current buffer display only a summary or a full diff.")
-
-;;;###autoload
-(defun xetla-changes (&optional summary against)
- "Run \"tla changes\".
-
-When called without a prefix argument: show the detailed diffs also.
-When called with a prefix argument SUMMARY: do not show detailed
-diffs. When AGAINST is non-nil, use it as comparison tree."
- (interactive "P")
- (let* ((root (xetla-read-project-tree-maybe
- "Run tla changes in: "))
- (default-directory root)
- (buffer (xetla-prepare-changes-buffer
- (or against
- (list 'last-revision root))
- (list 'local-tree root)
- 'changes
- default-directory)))
- (with-current-buffer buffer
- (set (make-local-variable 'xetla-changes-summary)
- summary))
- (when xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer))
- (xetla-save-some-buffers)
- (xetla-run-tla-async
- '("inventory" "--nested" "--trees")
- :related-buffer buffer
- :finished
- `(lambda (output error status arguments)
- (let ((subtrees (delete ""
- (split-string
- (with-current-buffer
- output (buffer-string)) "\n"))))
- (with-current-buffer ,buffer
- (let ((inhibit-read-only t))
- (ewoc-enter-last
- xetla-changes-cookie
- (list 'message
- (concat "* running tla changes in tree " ,root
- "...\n\n")))
- (ewoc-refresh xetla-changes-cookie))
- (dolist (subtree subtrees)
- (let ((buffer-sub (xetla-get-buffer-create
- 'changes subtree)))
- (with-current-buffer buffer-sub
- (let ((inhibit-read-only t))
- (erase-buffer))
- (xetla-changes-mode)
- (set (make-local-variable
- 'xetla-changes-buffer-master-buffer)
- ,buffer))
- (ewoc-enter-last xetla-changes-cookie
- (list 'subtree buffer-sub subtree
- nil))
- (xetla-changes-internal
- ,(not summary)
- nil ;; TODO "against" what for a nested tree?
- subtree
- buffer-sub
- ,buffer)))
- (xetla-changes-internal ,(not summary)
- (quote ,against)
- ,root ,buffer nil)))))))
-
-;;;###autoload
-(defun xetla-changes-against (&optional summary against)
- "Wrapper for `xetla-changes'.
-
-When called interactively, SUMMARY is the prefix arg, and AGAINST is
-read from the user."
- (interactive (list current-prefix-arg
- (list 'revision (xetla-name-read "Compute changes against: "
- 'prompt 'prompt 'prompt 'prompt
- 'maybe))))
- (xetla-changes summary against))
-
-;;;###autoload
-(defun xetla-changes-last-revision (&optional summary)
- "Run `xetla-changes' against the last but one revision.
-
-The idea is that running this command just after a commit should be
-equivalent to running `xetla-changes' just before the commit.
-
-SUMMARY is passed to `xetla-changes'."
- (interactive "P")
- (let ((default-directory (xetla-read-project-tree-maybe
- "Review last patch in directory: ")))
- (xetla-changes summary (list 'revision
- (xetla-name-construct (xetla-compute-direct-ancestor))))))
-
-(defvar xetla-changes-modified nil
- "MODIFIED revision for the changes currently displayed.
-
-Must be buffer-local.
-
-This variable has the form (type location), and can be either
-
-'(revision (\"archive\" \"category\" \"branch\" \"version\"
- \"revision\"))
-
-or
-
-'(local-tree \"/path/to/local/tree\")
-
-The value nil means we have no information about which local tree or
-revision is used.")
-
-(defvar xetla-changes-base nil
- "BASE revision for the changes currently displayed.
-
-Must be buffer-local.
-
-The values for this variable can be the same as for
-`xetla-changes-modified', plus the values
-
-'(last-revision \"/path/to/tree\"),
-used by `xetla-changes' to mean \"revision on which this local tree is
-based\".
-
-and
-
-'(previous-revision (\"archive\" \"category\" \"branch\" \"version\"
- \"revision\")),
-used by commands like xetla-get-changeset, and means that the changes
-are against the previous revision.")
-
-(defun xetla-changes-internal (diffs against root buffer master-buffer)
- "Internal function to run \"tla changes\".
-
-If DIFFS is non nil, show the detailed diffs also.
-Run the command against tree AGAINST in directory ROOT.
-The output will be displayed in buffer BUFFER.
-
-BUFFER must already be in changes mode, but mustn't contain any change
-information. Only roots of subprojects are already in the ewoc.
-
-If MASTER-BUFFER is non-nil, this run of tla changes is done in a
-nested project of a bigger one. MASTER-BUFFER is the buffer in which
-the root of the projects is displayed."
- (with-current-buffer buffer
- (xetla-run-tla-async
- `("changes" ,(when diffs "--diffs")
- ,(case (car against)
- (local-tree
- (error "Can not run tla changes against a local tree"))
- (previous-revision (xetla-compute-direct-ancestor
- (cadr against)))
- (last-revision (if (string= (xetla-uniquify-file-name
- (cadr against))
- (xetla-uniquify-file-name
- (xetla-tree-root)))
- nil
- (error "tla changes against last %s %s"
- "revision of local tree not"
- "implemented.")))
- (revision (xetla-name-construct (cadr against)))))
- :finished
- `(lambda (output error status arguments)
- (if ,master-buffer
- (message "No changes in subtree %s" ,root)
- (message "No changes in %s" ,root))
- (with-current-buffer ,(current-buffer)
- (let ((inhibit-read-only t))
- (xetla-changes-delete-messages)
- (ewoc-enter-last xetla-changes-cookie
- (list 'message (concat "* No changes in "
- ,root ".\n\n")))
- (when ,master-buffer
- (with-current-buffer ,master-buffer
- (ewoc-map (lambda (x)
- (when (and (eq (car x) 'subtree)
- (eq (cadr x) ,buffer))
- (setcar (cdddr x) 'no-changes))
- )
- ;; (ewoc-refresh xetla-changes-cookie)))
- xetla-changes-cookie)))
- (ewoc-refresh xetla-changes-cookie))))
- :error
- `(lambda (output error status arguments)
- (if (/= 1 status)
- (progn
- (xetla-show-error-buffer error)
- (goto-char (point-min))
- (when (search-forward "try tree-lint" nil t)
- (xetla-tree-lint ,root)))
- (xetla-show-changes-buffer output nil ,buffer ,master-buffer)
- (when ,master-buffer
- (with-current-buffer ,master-buffer
- (ewoc-map (lambda (x)
- (when (and (eq (car x) 'subtree)
- (eq (cadr x) ,buffer))
- (setcar (cdddr x) 'changes))
- )
- xetla-changes-cookie)))))
- )))
-
-(defun xetla-changes-chose-face (modif)
- "Return a face adapted to MODIF, a string, which can be A, M, C, or D."
- (cond
- ((string-match "A" modif) 'xetla-added)
- ((string-match "M" modif) 'xetla-modified)
- ((string-match "-" modif) 'xetla-modified)
- ((string-match "C" modif) 'xetla-conflict)
- ((string-match "D" modif) 'xetla-conflict)
- ((string-match "/" modif) 'xetla-move)
- ((string-match "=" modif) 'xetla-move)
- (t
- (xetla-trace "unknown modif: \"%s\"" modif)
- 'default)))
-
-(defun xetla-changes-printer (elem)
- "Ewoc pretty-printer for `xetla-changes-cookie'.
-
-Pretty-print ELEM."
- (cond
- ((eq (car elem) 'file)
- (let* ((empty-mark " ")
- (mark (when (member (cadr elem) xetla-buffer-marked-file-list)
- (concat xetla-mark " ")))
- (file (cadr elem))
- (modif (caddr elem))
- (dir (cadddr elem))
- (basename (nth 4 elem))
- (line (concat modif dir " "
- (when basename (concat basename "\t"))
- file))
- (face (if mark
- 'xetla-marked
- (xetla-changes-chose-face modif))))
- (if mark
- (insert mark)
- (insert empty-mark))
- (insert (xetla-face-add line
- face
- 'xetla-changes-file-map
- xetla-changes-file-menu))))
- ((eq (car elem) 'subtree)
- (insert " T" (cond ((not (cadddr elem)) "?")
- ((eq (cadddr elem) 'changes) "M")
- ((eq (cadddr elem) 'no-changes) "-"))
- " " (caddr elem)))
- ((eq (car elem) 'message)
- (insert (cadr elem))))
- )
-
-(defconst xetla-verbose-format-spec
- '(("added files" "A" " ")
- ("modified files" "M" " ")
- ("removed files" "D" " "))
- "Internal variable used to parse the output of xetla show-changeset."
- )
-
-(defun xetla-show-changes-buffer (buffer &optional verbose-format
- output-buffer no-switch)
- "Show the *xetla-changes* buffer built from the *xetla-process* BUFFER.
-
-If VERBOSE-FORMAT is non-nil, the format of the *xetla-process* buffer
-should be the one of xetla show-changeset.
-
-Use OUTPUT-BUFFER to display changes if provided. That buffer must
-already be in changes mode.
-
-If NO-SWITCH is nil, don't switch to the created buffer."
- (let* ((root (with-current-buffer buffer
- (xetla-tree-root default-directory t)))
- (changes-buffer (or output-buffer (xetla-get-buffer-create
- 'changes root)))
- (header ""))
- (if (or no-switch xetla-switch-to-buffer-first)
- (set-buffer changes-buffer)
- (xetla-switch-to-buffer changes-buffer))
- (let (buffer-read-only)
- (xetla-changes-delete-messages)
- (unless output-buffer
- (erase-buffer)
- (xetla-changes-mode))
- (with-current-buffer buffer
- (if verbose-format
- (progn
- (goto-char (point-min))
- (while (re-search-forward
- (concat "^\\* \\(" (regexp-opt
- (mapcar 'car xetla-verbose-format-spec))
- "\\)\n")
- nil t)
- (let* ((elem (assoc (match-string 1)
- xetla-verbose-format-spec))
- (modif (cadr elem))
- (dir (caddr elem)))
- (if (string= modif "M")
- (while (re-search-forward "^--- orig/\\(.*\\)$"
- nil t)
- (let ((file (match-string 1)))
- (with-current-buffer changes-buffer
- (ewoc-enter-last
- xetla-changes-cookie
- (list 'file (xetla-unescape file)
- modif dir)))))
- (while (looking-at "^$") (forward-line 1))
- (while (looking-at
- "^ +\\([^ ].*\\)$")
- (let ((file (match-string 1)))
- (with-current-buffer changes-buffer
- (ewoc-enter-last
- xetla-changes-cookie
- (list 'file (xetla-unescape file)
- modif dir)))
- (forward-line 1))))))
- (goto-char (point-min))
- (if (re-search-forward "^---" nil t)
- (forward-line -1)
- (beginning-of-line)))
- (setq header (buffer-substring-no-properties
- (goto-char (point-min))
- (progn (re-search-forward "^[^*]" nil t)
- (beginning-of-line)
- (point))))
- (beginning-of-line)
- (while (or (eq (char-after) ?*)
- (looking-at "^\\(.\\)\\([ /bfl>-]?\\) +\\([^\t\n]*\\)\\(\t\\(.*\\)\\)?$"))
- (if (eq (char-after) ?*)
- (let ((msg (buffer-substring-no-properties
- (point) (point-at-eol))))
- (with-current-buffer changes-buffer
- (ewoc-enter-last xetla-changes-cookie
- (list 'message msg))))
- (let ((file (match-string 3))
- (modif (match-string 1))
- (dir (match-string 2))
- (newname (match-string 5)))
- (with-current-buffer changes-buffer
- (if newname
- (ewoc-enter-last xetla-changes-cookie
- (list 'file
- (xetla-unescape newname)
- modif dir
- (xetla-unescape file)))
- (ewoc-enter-last xetla-changes-cookie
- (list 'file
- (xetla-unescape file)
- modif dir))))))
- (forward-line 1)))
- (let ((footer (concat
- (xetla-face-add (make-string 72 ?\ ) 'xetla-separator)
- "\n\n"
- (buffer-substring-no-properties
- (point) (point-max)))))
- (with-current-buffer changes-buffer
- (ewoc-set-hf xetla-changes-cookie header footer)
- (if root (cd root)))))
- ))
- (toggle-read-only 1)
- (when font-lock-mode
- (let ((font-lock-verbose nil))
- (font-lock-fontify-buffer)))
- (if (ewoc-nth xetla-changes-cookie 0)
- (goto-char (ewoc-location (ewoc-nth xetla-changes-cookie 0)))))
-
-(defun xetla-changes-save (directory)
- "Run \"tla changes -o\" to create a changeset.
-
-The changeset is stored in DIRECTORY."
- (interactive "FDirectory to store the changeset: ")
- (xetla-run-tla-sync (list "changes" "-o" directory)
- :error `(lambda (output error status arguments)
- (case status
- (0 (message "xetla-changes-save: 0"))
- (1 (message (format "xetla-changes-save to %s finished" ,directory)))
- (otherwise (xetla-default-error-function
- output error status arguments))))))
-
-
-(defun xetla-changes-save-as-tgz (file-name)
- "Run \"tla changes -o\" to create .tar.gz file.
-The changeset is stored in the tarball 'FILE-NAME.tar.gz'."
- (interactive "FFile to store the changeset (without .tar.gz extension): ")
- (let* ((changeset-dir (expand-file-name file-name))
- (tgz-file-name (concat changeset-dir ".tar.gz")))
- (when (file-directory-p changeset-dir)
- (error "The changeset directory %s does already exist" changeset-dir))
- (when (file-exists-p tgz-file-name)
- (error "The changeset tarball %s does already exist" tgz-file-name))
- (xetla-changes-save changeset-dir)
- ;;create the archive: tar cfz ,,cset.tar.gz ,,cset
- (let ((default-directory (file-name-directory changeset-dir)))
- ;;(message "Calling tar cfz %s %s" tgz-file-name (file-name-nondirectory changeset-dir))
- (call-process "tar" nil nil nil "cfz" tgz-file-name (file-name-nondirectory changeset-dir)))
- (call-process "rm" nil nil nil "-rf" changeset-dir)
- (message "Created changeset tarball %s" tgz-file-name)))
-
-;;;###autoload
-(defun xetla-delta (base modified &optional directory)
- "Run tla delta BASE MODIFIED.
-If DIRECTORY is a non-empty string, the delta is stored to it.
-If DIRECTORY is ask, a symbol, ask the name of directory.
-If DIRECTORY is nil or an empty string, just show the delta using --diffs."
- (interactive (list
- (xetla-name-construct
- (xetla-name-read "Base: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))
- (xetla-name-construct
- (xetla-name-read "Modified: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))
- (when current-prefix-arg
- 'ask)))
-
- (when (eq directory 'ask)
- (setq directory
- (read-directory-name "Stored to: "
- (xetla-tree-root default-directory t)
- (xetla-tree-root default-directory t)
- nil
- "")))
-
- (when (and directory (stringp directory) (string= directory ""))
- (setq directory nil))
-
- (when (and directory (file-directory-p directory))
- (error "%s already exists" directory))
-
- (let ((args
- (if directory
- (list "delta" base modified directory)
- (list "delta" "--diffs" base modified)))
- (run-dired-p (when directory 'ask)))
- (xetla-run-tla-async args
- :finished
- `(lambda (output error status arguments)
- (if ,directory
- (xetla-delta-show-directory ,directory ',run-dired-p)
- (xetla-delta-show-diff-on-buffer
- output ,base ,modified))))))
-
-(defun xetla-delta-show-diff-on-buffer (output base modified)
- "Show the result of \"delta -diffs\".
-
-OUTPUT is the output buffer of the xetla process.
-BASE is the name of the base revision, and MODIFIED is the name of the
-modified revision, (then command being run is tla delta BASE
-MODIFIED)."
- (with-current-buffer output
- (let ((no-changes
- ;; There were no changes if the last line of
- ;; the buffer is "* changeset report"
- (save-excursion
- (goto-char (point-max))
- (previous-line 1)
- (beginning-of-line)
- (looking-at "^* changeset report")))
- buffer)
- (if no-changes
- (message
- (concat "tla delta finished: "
- "No changes in this arch working copy"))
- (setq buffer (xetla-prepare-changes-buffer
- (list 'revision
- (xetla-name-split base))
- (list 'revision
- (xetla-name-split modified))
- 'delta default-directory))
- (xetla-show-changes-buffer output nil buffer)
- (xetla-switch-to-buffer buffer)
- (message "tla delta finished")))))
-
-(defun xetla-delta-show-directory (directory run-dired-p)
- "Called by `xetla-delta' to show a changeset in DIRECTORY.
-
-If RUN-DIRED-P is non-nil, run dired in the parent directory of the
-changeset."
- (xetla-show-changeset directory nil)
- (when (xetla-do-dired (concat (file-name-as-directory directory) "..") run-dired-p)
- (revert-buffer)
- (goto-char (point-min))
- (re-search-forward (concat
- (regexp-quote (file-name-nondirectory directory))
- "$"))
- (goto-char (match-beginning 0))
- (xetla-flash-line)))
-
-;; (defvar xetla-get-changeset-start-time nil)
-;; (defvar xetla-changeset-cache (make-hash-table :test 'equal)
-;; "The cache for `xetla-get-changeset'.
-;; A hashtable, where the revisions are used as keys.
-;; The value is a list containing the time the cache data was recorded and
-;; the text representation of the changeset.")
-
-;;;###autoload
-(defun xetla-get-changeset (revision justshow &optional destination
- without-diff)
- "Gets the changeset corresponding to REVISION.
-
-When JUSTSHOW is non-nil (no prefix arg), just show the diff.
-Otherwise, store changeset in DESTINATION.
-If WITHOUT-DIFF is non-nil, don't use the -diff option to show the
-changeset."
- (interactive
- (list (let ((current-version (xetla-tree-version nil t)))
- (xetla-name-construct
- (apply 'xetla-name-read "Revision to view: "
- (if current-version
- (append (delete nil (xetla-name-split current-version))
- '(prompt))
- (list 'prompt 'prompt 'prompt 'prompt 'prompt)))))
- (not current-prefix-arg)))
- (let ((buffer (xetla-get-buffer 'changeset revision)))
- (if buffer (save-selected-window (xetla-switch-to-buffer buffer))
- (let* ((dest (or destination
- (xetla-make-temp-name "xetla-changeset")))
- (rev-list (xetla-name-split revision))
- (buffer (and justshow
- (xetla-prepare-changes-buffer
- (list 'previous-revision rev-list)
- (list 'revision rev-list)
- 'changeset revision)))
- (xetla-switch-to-buffer-mode
- (if xetla-switch-to-changes-buffer
- xetla-switch-to-buffer-mode 'show-in-other-window)))
- (when (and justshow xetla-switch-to-buffer-first)
- (xetla-switch-to-buffer buffer))
- ;; (if (gethash revision xetla-changeset-cache)
- ;; (progn
- ;; (message (format "Using changes for revision %S from cache." revision))
- ;; (with-current-buffer buffer
- ;; (let ((buffer-read-only nil))
- ;; (insert (cadr (gethash revision xetla-changeset-cache))))))
- ;; (setq xetla-get-changeset-start-time (current-time))
- (xetla-run-tla-async
- (list "get-changeset" revision dest)
- :finished
- `(lambda (output error status arguments)
- ;; (let* ((xetla-run-time (time-to-seconds (time-since xetla-get-changeset-start-time)))
- ;; (cache-revision (or (and (numberp xetla-cache-xetla-get-changeset)
- ;; (> xetla-run-time xetla-cache-xetla-get-changeset))
- ;; (and (not (numberp xetla-cache-xetla-get-changeset))
- ;; xetla-cache-xetla-get-changeset)))
- ;; )
- (when ,justshow
- (xetla-show-changeset ,dest ,without-diff ,buffer)
- ;; (when cache-revision
- ;; (message (format "caching result from xetla-get-changeset, xetla-run-time=%S"
- ;; xetla-run-time))
- ;; (with-current-buffer ,buffer
- ;; (puthash ,revision
- ;; (list (current-time)
- ;; (buffer-substring-no-properties (point-min) (point-max)))
- ;; xetla-changeset-cache)))
- (call-process "rm" nil nil nil "-rf" ,dest))))))))
- ;; ))
-
-(defun xetla-prepare-changes-buffer (base modified type path)
- "Create and return a buffer to run \"tla changes\" or equivalent.
-
-Sets the local-variables `xetla-changes-base' and
-`xetla-changes-modified' are set according to BASE and MODIFIED.
-
-TYPE and PATH are passed to `xetla-get-buffer-create'."
- (with-current-buffer
- (xetla-get-buffer-create type path)
- (let ((inhibit-read-only t)) (erase-buffer))
- (xetla-changes-mode)
- (set (make-local-variable 'xetla-changes-base) base)
- (set (make-local-variable 'xetla-changes-modified) modified)
- (current-buffer)))
-
-(defun xetla-show-changeset (directory &optional without-diff buffer
- base modified)
- "Run tla show-changeset on DIRECTORY.
-
-If prefix argument, WITHOUT-DIFF is non-nil, just show the summary.
-BUFFER is the target buffer to output. If BUFFER is nil, create a new
-one.
-
-BASE and MODIFIED are the name of the base and modified. Their values
-will be used for the variables `xetla-changes-base' and
-`xetla-changes-modified'."
- (interactive (list (let ((changeset-dir (or (xetla-get-file-info-at-point) "")))
- (unless (file-directory-p (expand-file-name changeset-dir))
- (setq changeset-dir ""))
- (xetla-uniquify-file-name
- (read-directory-name
- "Changeset directory to view: " changeset-dir changeset-dir)))))
- (unless buffer
- (setq buffer (xetla-prepare-changes-buffer base modified
- 'changeset directory))
- (if xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer)))
- (xetla-run-tla-sync (list "show-changeset"
- (unless without-diff
- "--diffs")
- directory)
- :finished
- `(lambda (output error status arguments)
- (xetla-show-changes-buffer output (not ',without-diff)
- ,buffer
- ,xetla-switch-to-buffer-first)
- (xetla-post-switch-to-buffer))))
-
-(defun xetla-show-changeset-from-tgz (file)
- "Show the archived changeset from a tar.gz FILE.
-Such a changeset can be created via `xetla-changes-save-as-tgz'."
- (interactive (list (let ((changeset-tarball (or (xetla-get-file-info-at-point) "")))
- (read-file-name "Changeset tarball to view: " nil changeset-tarball t changeset-tarball))))
- (let ((temp-dir (xetla-make-temp-name "xetla-changeset-tgz"))
- (changeset-dir))
- (message "temp-dir: %s" temp-dir)
- (call-process "mkdir" nil nil nil temp-dir)
- (call-process "tar" nil nil nil "xfz" file "-C" temp-dir)
- (setq changeset-dir (car (delete "." (delete ".." (directory-files temp-dir)))))
- (xetla-show-changeset (concat (xetla-uniquify-file-name temp-dir) changeset-dir))
- (call-process "rm" nil nil nil "-rf" temp-dir)))
-
-;;;###autoload
-(defun xetla-apply-changeset (changeset target &optional reverse)
- "Call \"tla apply-changeset\".
-
-CHANGESET is the changeset to apply, TARGET is the directory in which
-to apply the changeset. If REVERSE is non-nil, apply the changeset in
-reverse."
- (interactive "DChangeset Directory: \nDTarget Directory: \nP")
- (if (file-directory-p changeset)
- (setq changeset (expand-file-name changeset))
- (error "%s is not directory" changeset))
- (if (file-directory-p target)
- (setq target (expand-file-name target))
- (error "%s is not directory" target))
-
- (or (xetla-save-some-buffers target)
- (y-or-n-p
- "Apply-change may delete unsaved changes. Continue anyway? ")
- (error "Not applying"))
- (xetla-apply-changeset-internal changeset target reverse)
- (when (y-or-n-p (format "Run inventory at `%s'? " target))
- (xetla-inventory target)))
-
-(defun xetla-apply-changeset-internal (changeset target reverse)
- "Actually call \"tla apply-changeset CHANGESET TARGET\".
-
-If REVERSE is non-nil, use --reverse too."
- (xetla-run-tla-sync (list "apply-changeset"
- (when reverse "--reverse")
- (when xetla-use-forward-option "--forward")
- changeset target)
- :finished `(lambda (output error status arguments)
- ;; (xetla-show-last-process-buffer)
- (xetla-show-changes-buffer output)
- (message "tla apply-changeset finished")
- (xetla-revert-some-buffers ,target))))
-
-(defun xetla-apply-changeset-from-tgz (file tree)
- "Apply changeset in FILE to TREE."
- (interactive "fApply changeset from tarball: \nDApply to tree: ")
- (let ((target (xetla-tree-root tree))
- (temp-dir (xetla-make-temp-name "xetla-changeset-tgz"))
- (changeset-dir))
- (call-process "mkdir" nil nil nil temp-dir)
- (call-process "tar" nil nil nil "xfz" (expand-file-name file) "-C" temp-dir)
- (setq changeset-dir (concat (xetla-uniquify-file-name temp-dir)
- (car (delete "." (delete ".." (directory-files temp-dir))))))
- (xetla-show-changeset changeset-dir)
- (when (yes-or-no-p "Apply the changeset? ")
- (xetla-apply-changeset changeset-dir target))
- (call-process "rm" nil nil nil "-rf" temp-dir)))
-
-
-;;;###autoload
-(defun xetla-file-ediff-revisions (file &optional base modified)
- "View changes in FILE between BASE and MODIFIED using ediff."
- (interactive (let ((version-list (xetla-tree-version-list)))
- (list (buffer-file-name)
- (list 'revision
- (xetla-name-read "Base revision: "
- (xetla-name-archive version-list)
- (xetla-name-category version-list)
- (xetla-name-branch version-list)
- (xetla-name-version version-list)
- 'prompt))
- (list 'revision
- (xetla-name-read "Modified revision: "
- (xetla-name-archive version-list)
- (xetla-name-category version-list)
- (xetla-name-branch version-list)
- (xetla-name-version version-list)
- 'prompt)))))
- (xetla-ediff-buffers
- (xetla-file-get-revision-in-buffer file base)
- (xetla-file-get-revision-in-buffer file modified)))
-
-;;;###autoload
-(defun xetla-file-diff (file &optional revision)
- "Run \"tla file-diff\" on file FILE.
-
-In interactive mode, the file is the current buffer's file.
-If REVISION is specified, it must be a string representing a revision
-name, and the file will be diffed according to this revision."
- (interactive (list (buffer-file-name)))
- (let ()
- (xetla-run-tla-async (list "file-diffs" file revision)
- :finished
- (lambda (output error status arguments)
- (message "No changes in this arch working copy"))
- :error
- (lambda (output error status arguments)
- (if (= 1 status)
- (xetla-show-last-process-buffer
- 'file-diff
- 'diff-mode)
- (xetla-default-error-function
- output error status arguments))))))
-
-(defvar xetla-mine-string "TREE")
-(defvar xetla-his-string "MERGE-SOURCE")
-
-(eval-when-compile
- (defvar smerge-mode))
-
-;;;###autoload
-(defun xetla-conflicts-finish ()
- "Command to delete .rej file after conflicts resolution.
-Asks confirmation if the file still has diff3 markers."
- (interactive)
- (if (and (boundp 'smerge-mode) smerge-mode)
- (progn
- (when (and
- (save-excursion
- (goto-char (point-min))
- (xetla-funcall-if-exists smerge-find-conflict))
- (not (y-or-n-p (concat "Buffer still has diff3 markers. "
- "Delete .rej file anyway? "))))
- (error "Not deleting .rej file"))
- (xetla-funcall-if-exists smerge-mode -1))
- (when (not (y-or-n-p (concat "Buffer is not in in smerge-mode. "
- "Delete .rej file anyway? ")))
- (error "Not deleting .rej file")))
- (let ((rejfile (concat (buffer-file-name) ".rej")))
- (if (file-exists-p rejfile)
- (progn
- (delete-file rejfile)
- (message "deleted file %s" rejfile))
- (error (format "%s: no such file" rejfile)))))
-
-;;;###autoload
-(defun xetla-view-conflicts (buffer)
- "*** WARNING: semi-deprecated function.
-Use this function if you like, but M-x smerge-mode RET is actually
-better for the same task ****
-
-Graphical view of conflicts after xetla star-merge -three-way. The
-buffer given as an argument must be the content of a file with
-conflicts markers like.
-
- <<<<<<< TREE
- my text
- =======
- his text
- >>>>>>> MERGE-SOURCE
-
-Priority is given to your file by default. (This means all conflicts
-will be rejected if you do nothing)."
- (interactive (list (find-file (read-file-name "View conflicts in: "))))
- (let ((mine-buffer buffer)
- (his-buffer (get-buffer-create "*xetla-his*")))
- (with-current-buffer his-buffer
- (erase-buffer)
- (insert-buffer mine-buffer)
- (goto-char (point-min))
- (while (re-search-forward (concat "^<<<<<<< "
- (regexp-quote xetla-mine-string) "$")
- nil t)
- (beginning-of-line)
- (delete-region (point) (progn
- (re-search-forward "^=======\n")))
- (re-search-forward
- (concat "^>>>>>>> "
- (regexp-quote xetla-his-string) "$"))
- (beginning-of-line)
- (delete-region (point) (1+ (point-at-eol)))
- )
- )
- (with-current-buffer mine-buffer
- (goto-char (point-min))
- (while (re-search-forward (concat "^<<<<<<< "
- (regexp-quote xetla-mine-string) "$")
- nil t)
- (beginning-of-line)
- (delete-region (point) (1+ (point-at-eol)))
- (re-search-forward "^=======$")
- (beginning-of-line)
- (delete-region (point) (progn
- (re-search-forward
- (concat "^>>>>>>> "
- (regexp-quote xetla-his-string) "\n"))))
- ))
- (xetla-ediff-buffers mine-buffer his-buffer)
- ))
-
-(defun xetla-file-get-revision-in-file (file &optional revision)
- "Get the last-committed version of FILE.
-
-If REVISION is non-nil, it must be a cons representing the revision,
-and this revision will be used as a reference.
-
-Return (file temporary). temporary is non-nil when the file is
-temporary and should be deleted."
- (case (car revision)
- (local-tree (list file nil))
- (previous-revision (xetla-file-get-revision-in-file
- file
- (list 'revision
- (xetla-compute-direct-ancestor
- (cadr revision)))))
- ((last-revision revision)
- (let* ((default-directory (if (eq (car revision) 'last-revision)
- (cadr revision)
- (xetla-tree-root file)))
- (revision (if (eq (car revision) 'revision)
- (xetla-name-construct (cadr revision))))
- (original (progn (xetla-run-tla-sync
- (list "file-find" file revision)
- :finished 'xetla-null-handler)
- (with-current-buffer xetla-last-process-buffer
- (goto-char (point-min))
- (re-search-forward "^[^*]")
- (buffer-substring-no-properties
- (point-at-bol)
- (point-at-eol)))))
- (original-to-be-removed nil)
- file-unmodified-p)
- (unless (file-exists-p original)
- ;; Probably xetla is ran remotely or whatever. Well, get the
- ;; file using the old good tla file-diff | patch -R -o ...
- (setq original (xetla-make-temp-name "xetla-ediff")
- original-to-be-removed t)
- (xetla-run-tla-sync (list "file-diffs" file revision)
- :finished 'xetla-null-handler
- :error
- (lambda (output error status arguments)
- (if (not (eq status 1))
- (xetla-default-error-function
- output error status arguments))))
- (with-current-buffer xetla-last-process-buffer
- (if (= (point-min) (point-max))
- (setq file-unmodified-p t))
- (call-process-region (point-min) (point-max)
- xetla-patch-executable
- nil nil nil
- "-R" "-o" original file)))
- (list original file-unmodified-p original-to-be-removed)))))
-
-(defun xetla-file-revert (file &optional revision)
- "Revert the file FILE to the last committed version.
-
-Warning: You use version control to keep backups of your files. This
-function will by definition not keep any backup in the archive.
-
-Most of the time, you should not use this function. Call
-`xetla-file-ediff' instead, and undo the changes one by one with the key
-`b', then save your buffer.
-
-As a last chance, `xetla-file-revert' keeps a backup of the last-saved in
-~ backup file.
-
-If REVISION is non-nil, it must be a cons representing the revision,
-and this revision will be used as a reference."
- (interactive (list (progn (when (and (buffer-modified-p)
- (or xetla-do-not-prompt-for-save
- (y-or-n-p (format "Save buffer %s? "
- (buffer-name
- (current-buffer))))))
- (save-buffer))
- (buffer-file-name))))
- ;; set aside a backup copy
- (copy-file file (car (find-backup-file-name file)) t)
-
- ;; display diff
- (xetla-run-tla-sync (list "file-diffs" file revision)
- :finished
- (lambda (output error status arguments)
- (error "File %s is not modified!" (cadr arguments)))
- :error
- (lambda (output error status arguments)
- (if (/= 1 status)
- (xetla-default-error-function
- output error status arguments)
- (xetla-show-last-process-buffer
- 'file-diff
- (lambda ()
- (goto-char (point-min))
- (let ((inhibit-read-only t))
- (insert
- (format "M %s\n" (cadr arguments))
- "Do you really want to revert ALL the changes listed below?\n")
- (if xetla-highlight (font-lock-fontify-buffer)))
- (diff-mode))))))
-
- (let* ((file-unmo-temp (xetla-file-get-revision-in-file
- file (if revision
- (list 'revision revision)
- (list 'last-revision (xetla-tree-root)))))
- (original (car file-unmo-temp)))
- (unless (yes-or-no-p (format "Really revert %s? " file))
- (bury-buffer)
- (error "Not reverting file %s!" file))
- (bury-buffer)
- (copy-file original file t)
- (let ((buf (get-file-buffer file)))
- (when buf (with-current-buffer buf (revert-buffer))))))
-
-(defun xetla-undo (tree &optional
- archive category branch version revision)
- ; checkdoc-params: (archive category branch version revision)
- "Undo whole local TREE against ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION.
-If ARCHIVE is nil, default ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION
-associated with TREE."
- (interactive
- (if (and (not current-prefix-arg)
- (y-or-n-p "Use default revision to undo? "))
- (list default-directory nil nil nil nil nil)
- (cons default-directory
- (xetla-read-revision-with-default-tree "Undo against archive: "
- default-directory))))
- (xetla-undo-internal tree archive category branch version revision))
-
-
-(defun xetla-undo-internal (tree &optional archive category branch version revision)
- ; checkdoc-params: (tree archive category branch version revision)
- "Internal function used by `xetla-undo'."
- (save-excursion (if archive
- (xetla-changes nil (xetla-name-construct
- archive category branch version revision))
- (xetla-changes)))
- (sit-for 1) ;;xetla-changes should start before the yes-or-no-p query
- (when (yes-or-no-p
- (if archive
- (format "Revert whole local tree (%s) from `%s'? "
- tree (xetla-name-construct
- archive category branch version revision))
- (format "Revert whole local tree (%s) from default revision? " tree)))
- (let ((default-directory tree))
- (xetla-run-tla-sync (if archive
- (list "undo" (xetla-name-construct
- archive category branch version revision))
- (list "undo"))
- ;; TODO in case of files violating the naming
- ;; conventions we could offer to delete them or
- ;; switch to inventory-mode and do it there,
- ;; basically saying YES should delete them and
- ;; perform the undo operation again
- ))
- (xetla-revert-some-buffers tree)))
-
-(defun xetla-get-undo-changeset-names ()
- "Get the list of directories starting with \",,undo-\".
-
-This is used by xetla-redo to get the list of candidates for an undo
-changeset."
- (interactive)
- (directory-files (xetla-tree-root default-directory t) t ",,undo-"))
-
-(defun xetla-select-changeset (dir-list)
- "Select a changeset.
-
-DIR-LIST is intended to be the result of
-`xetla-get-undo-changeset-names'."
- (completing-read "Select changeset: " (mapcar 'list dir-list) nil nil (car dir-list)))
-
-
-(defun xetla-redo (&optional target)
- "Run tla redo.
-If TARGET directroy is given, TARGET should hold undo data generated by `xetla undo'."
- (interactive)
- (let* ((undo-changesets (xetla-get-undo-changeset-names))
- (undo-changeset (or target
- (when (= (length undo-changesets) 1) (car undo-changesets))
- (xetla-select-changeset undo-changesets))))
- (xetla-show-changeset undo-changeset)
- (when (yes-or-no-p (format "Redo the %s changeset? " undo-changeset))
- (xetla-run-tla-sync (list "redo" undo-changeset)))))
-
-
-;;;###autoload
-(defun xetla-file-ediff (file &optional revision)
- "Interactive view of differences in FILE with ediff.
-
-Changes are computed since last commit (or REVISION if specified)."
- (interactive (list (progn (when (and (buffer-modified-p)
- (y-or-n-p (format "Save buffer %s? "
- (buffer-name
- (current-buffer)))))
- (save-buffer))
- (buffer-file-name))))
- (let ((original (xetla-file-get-revision-in-buffer
- file (or revision (list 'last-revision
- (xetla-tree-root))))))
- (when (string= (with-current-buffer original (buffer-string))
- (buffer-string))
- (error "No modification in this file"))
- (xetla-ediff-buffers (or (get-file-buffer file)
- (find-file-noselect file))
- original)))
-
-;;;###autoload
-(defun xetla-file-view-original (file &optional revision)
- "Get the last-committed version of FILE in a buffer.
-
-If REVISION is specified, it must be a cons representing the revision
-for which to get the original."
- (interactive (list (buffer-file-name)))
- (let ((original (xetla-file-get-revision-in-buffer
- file (or revision (list 'last-revision
- (xetla-tree-root))))))
- (when (string= (with-current-buffer original (buffer-string))
- (buffer-string))
- (message "No modification in this file"))
- (xetla-switch-to-buffer original)))
-
-(defun xetla-buffer-for-rev (file revision)
- "Return an empty buffer suitable for viewing FILE in REVISION.
-
-The name of the buffer is chosen according to FILE and REVISION.
-
-REVISION may have one of the values described in the docstring of
-`xetla-changes-modified' or `xetla-changes-base'."
- (let ((name (concat
- (file-name-nondirectory file)
- "(" (cond
- ((eq (car revision) 'revision)
- (xetla-name-construct (cadr revision)))
- ((eq (car revision) 'local-tree)
- (cadr revision))
- ((eq (car revision) 'last-revision) "original")
- ((eq (car revision) 'previous-revision)
- (xetla-name-construct-semi-qualified
- (xetla-compute-direct-ancestor (cadr revision))))
- (t ""))
- ")")))
- (get-buffer-create
- (create-file-buffer name))))
-
-(defun xetla-file-get-revision-in-buffer (file &optional revision)
- "Get the last committed version of FILE in a buffer.
-
-Returned value is the buffer.
-
-REVISION can have any of the values described in the docstring of
-`xetla-changes-base' and `xetla-changes-modified'"
- (let* ((default-directory (xetla-tree-root))
- (file-unmo-temp (xetla-file-get-revision-in-file file revision))
- (original (car file-unmo-temp))
- (original-to-be-removed (cadr file-unmo-temp)))
- (if (eq (car revision) 'local-tree)
- (find-file-noselect original)
- (let ((buffer-orig (xetla-buffer-for-rev file revision)))
- (with-current-buffer buffer-orig
- (erase-buffer)
- (insert-file-contents original)
- (when original-to-be-removed
- (delete-file original)))
- buffer-orig))))
-
-(defun xetla-ediff-startup-hook ()
- "Passed as a startup hook for ediff.
-
-Programs ediff to return to the current window configuration after
-quitting."
- ;; ediff-after-quit-hook-internal is local to an ediff session.
- (add-hook 'ediff-after-quit-hook-internal
- `(lambda ()
- (set-window-configuration
- ,xetla-window-config))
- nil 'local))
-
-(defun xetla-commit-check-empty-line ()
- "Check that the headers are followed by an empty line.
-
-Current buffer must be a log buffer. This function checks it starts
-with RFC822-like headers, followed by an empty line"
- (interactive)
- (goto-char (point-min))
- (while (not (looking-at "^$"))
- (unless (looking-at "^[A-Za-z0-9_-]*:")
- (error "A blank line must follow the last header field"))
- (forward-line 1)
- ;; space and tabs are continuation line.
- (while (looking-at "[ \t]+")
- (forward-line 1))))
-
-(defun xetla-commit-check-empty-headers ()
- "Check that the current buffer starts with non-empty headers.
-
-Also checks that the the line following headers is empty (or the
-notion of \"header\" would loose its meaning)."
- (interactive)
- (goto-char (point-min))
- (while (not (looking-at "^$"))
- (unless (looking-at "^[A-Za-z0-9_-]*:")
- (error "A blank line must follow the last header field"))
- (when (looking-at "^\\([A-Za-z0-9_-]*\\):[ \t]*$")
- (let ((header (match-string 1)))
- (unless (string-match xetla-commit-headers-allowed-to-be-empty
- header)
- (end-of-line)
- (when (eq (char-before) ?:) (insert " "))
- (error (format "Empty \"%s: \" header" header)))))
- (forward-line 1)
- ;; space and tabs are continuation line.
- (while (looking-at "[ \t]+")
- (forward-line 1))))
-
-(defun xetla-commit-check-missing-space ()
- "Check the space after the colon in each header:
-
-Check that no header in the summary buffer miss the SPC character
-following the semicolon. Also checks that the the line following
-headers is empty (or the notion of \"header\" would loose its
-meaning)"
- (interactive)
- (goto-char (point-min))
- (let ((stg-changed))
- (while (not (looking-at "^$"))
- (unless (looking-at "^[A-Za-z0-9_-]*:")
- (error "A blank line must follow the last header field"))
- (when (looking-at "^\\([A-Za-z0-9_-]*\\):[^ ]")
- (let ((header (match-string 1)))
- (if xetla-commit-fix-missing-space
- (progn
- (setq stg-changed t)
- (search-forward ":")
- (insert " "))
- (error (format "Missing space after colon for \"%s:\""
- header)))))
- (forward-line 1)
- ;; space and tabs are continuation line.
- (while (looking-at "[ \t]+")
- (forward-line 1)))
- (when stg-changed
- (save-buffer))))
-
-(defun xetla-commit-check-log-buffer ()
- "Function to call from the ++log... buffer, before comitting.
-
-\(`xetla-commit' calls it automatically). This runs the tests listed in
-`xetla-commit-check-log-buffer-functions'. Each function is called with
-no argument and can raise an error in case the log buffer isn't
-correctly filled in."
- (dolist (function xetla-commit-check-log-buffer-functions)
- (funcall function)))
-
-(defcustom xetla-warn-about-conflict-files t
- "*When non-`nil' ask whether to commit if conflict files are present.
-When `nil' commit anyway."
- :group 'xetla)
-
-(defun xetla-commit-find-conflict-files (dir)
- "Searches for conflict files in the current working directory."
- (when (file-readable-p dir)
- (let* ((dirs (directory-files dir t "^[^.]+$" nil 'subdirs))
- (cur (directory-files dir t "\\.rej"))
- (sub (mapcar #'xetla-commit-find-conflict-files dirs)))
- (setq cur (delete nil cur))
- (setq sub (delete nil sub))
- (if sub
- (append cur sub)
- cur))))
-
-(defun xetla-commit-seal (&optional force)
- "Commit a `version-0' revision to seal a repo.
-
-This calls `tla commit --seal'. With optional argument FORCE, don't
-prompt for confirmation."
- (interactive)
- (when (or force
- (y-or-n-p
- (format "Do you really want to seal `%s'? "
- (xetla-tree-version))))
- (if (string-match "--version\\(-\\|fix-\\)+"
- (xetla-get-current-revision default-directory))
- (error "Revision already sealed, use `xetla-commit-fix' instead")
- (xetla-commit
- (lambda (output error status args)
- (xetla-tips-popup-maybe))
- 'seal))))
-
-(defun xetla-commit-fix (&optional force)
- "Commit a `versionfix' revision.
-
-This calls `tla commit --fix'. With optional argument FORCE, don't
-prompt for confirmation."
- (interactive)
- (when (or force
- (y-or-n-p
- (format "Do you really want to versionfix `%s'? "
- (xetla-tree-version))))
- (if (not (string-match "--version\\(-\\|fix-\\)+"
- (xetla-get-current-revision default-directory)))
- (error "Revision not sealed")
- (xetla-commit
- (lambda (output error status args)
- (xetla-tips-popup-maybe))
- 'fix))))
-
-;;;###autoload
-(defun xetla-commit (&optional handler version-flag)
- "Run tla commit.
-
-Optional argument HANDLER is the process handler for the commit
-command.
-
-Optional argument VERSION-FLAG may be one of the symbols
-'seal to commit a sealed version
-'fix to commit a fix version
-If omitted it defaults to a normal commit.
-
-When the commit finishes successful, `tla-commit-done-hook' is called."
- (interactive)
- (with-current-buffer
- (find-file-noselect (xetla-make-log))
- (condition-case x
- (xetla-commit-check-log-buffer)
- (error (progn (switch-to-buffer (current-buffer))
- (eval x))))
- (or (xetla-save-some-buffers)
- (y-or-n-p
- "Commit with unsaved changes is a bad idea. Continue anyway? ")
- (error "Not committing"))
- (and xetla-warn-about-conflict-files
- ;; fsck it, actually we dont need all the .rej files (yet), so
- ;; speed up would be to unwind the recursion after the first
- ;; occurrence of a .rej
- (xetla-commit-find-conflict-files ".")
- (or (y-or-n-p
- (concat
- "Commit with unresolved conflicts is a bad idea. "
- "Continue anyway? "))
- (error "Not committing")))
- (let* ((file-list (and (buffer-live-p xetla-buffer-source-buffer)
- (with-current-buffer xetla-buffer-source-buffer
- xetla-buffer-marked-file-list)))
- arglist)
- (when file-list (setq arglist (append arglist (cons "--"
- file-list))))
- ;; raises an error if commit isn't possible
- (xetla-run-tla-async
- (cons "commit"
- (cons (when xetla-strict-commits "--strict")
- (cons (cond
- ((eq version-flag 'fix) "--fix")
- ((eq version-flag 'seal) "--seal")
- ((eq version-flag nil) nil)
- (t (error "Wrong version flag: %s" version-flag)))
- (when file-list (cons "--"
- file-list)))))
- :finished handler))))
-
-(defun xetla-import ()
- "Run tla import."
- (interactive)
- (with-current-buffer
- (find-file-noselect (xetla-make-log)))
- (xetla-run-tla-sync (list "import")
- :finished 'xetla-null-handler))
-
-
-;;;###autoload
-(defun xetla-rm (file)
- "Call tla rm on file FILE. Prompts for confirmation before."
- (interactive)
- (when (yes-or-no-p (format "Delete file %s? " file))
- (xetla-run-tla-sync (list "rm" file)
- :finished 'xetla-null-handler)))
-
-(defun xetla-pristines ()
- "Run \"tla pristine\"."
- (interactive)
- (xetla-run-tla-sync '("pristines")))
-
-;;;###autoload
-(defun xetla-changelog (&optional version)
- "Run \"tla changelog\".
-
-Display the result in an improved ChangeLog mode.
-With prefix arg, VERSION, display that version's changelog."
- (interactive "p")
- (let ((default-directory (xetla-read-project-tree-maybe))
- (version (when current-prefix-arg
- (xetla-name-construct
- (xetla-name-read "ChangeLog for version: "
- 'prompt 'prompt 'prompt 'prompt)))))
- (xetla-run-tla-sync (list "changelog" version)
- :finished 'xetla-null-handler)
- (xetla-show-last-process-buffer 'changelog 'xetla-changelog-mode)
- (goto-char (point-min))
- (view-mode nil (lambda (&rest args)
- (xetla-buffer-quit)))))
-
-;;;###autoload
-(defun xetla-logs ()
- "Run tla logs."
- (interactive)
- (let ((default-directory (xetla-read-project-tree-maybe))
-; (details (or xetla-revisions-shows-date
-; xetla-revisions-shows-creator
-; xetla-revisions-shows-summary))
- )
- (xetla-run-tla-async
- (list "logs" "--full"
- ; (when details "-date")
- ; (when details "-creator")
- ; (when details "-summary"))
- )
- :finished
- `(lambda (output error status arguments)
- (let ((buffer (xetla-get-buffer-create 'logs (xetla-tree-root))))
- (xetla-switch-to-buffer buffer)
- (xetla-revision-list-mode)
- (xetla-revisions-parse-list 'logs nil ;;,details
- nil ;; TODO (merges)
- output nil
- xetla-revision-list-cookie)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-logs))))))
-
-(defun xetla-help-via-keyb ()
- (interactive)
- (let ((ext (extent-string (extent-at (point)))))
- (xetla-help ext)))
-
-(defun xetla-help-via-mouse (event)
- (interactive "e")
- (goto-char (event-point event))
- (let ((ext (extent-string (extent-at (point)))))
- (xetla-help ext)))
-
-(defconst xetla-help-extent-map
- (let* ((map (make-sparse-keymap 'xetla-help-extent-map)))
- (define-key map [button2] 'xetla-help-via-mouse)
- (define-key map [return] 'xetla-help-via-keyb)
- map)
- "A keymap for the extents in output from `tla help'.")
-
-(defun xetla-display-global-help (buffer &rest args)
- (switch-to-buffer buffer)
- (xetla-process-buffer-mode)
- (goto-char (point-min))
- (save-excursion
- (while (re-search-forward "\\(\\w+.*\\) : " nil t)
- (let ((extent (make-extent (match-beginning 1) (match-end 1)))
- (echo "RET or button2 for help on this command."))
- (set-extent-property extent 'face 'widget-button-face)
- (set-extent-property extent 'mouse-face 'highlight)
- (set-extent-property extent 'keymap xetla-help-extent-map)
- (set-extent-property extent 'help-echo echo)
- (set-extent-property extent 'balloon-help echo)
- (set-extent-property extent 'duplicable t)))))
-
-;;;###autoload
-(defun xetla-help (command)
- "Run tla COMMAND -H."
- (interactive
- (list (completing-read
- "Get help for: "
- (xetla-run-tla-sync
- '("help")
- :finished
- `(lambda (output error status arguments)
- (with-current-buffer output
- (goto-char (point-min))
- (let (listcmd)
- (while (re-search-forward
- " *\\([^ ]*\\) : " nil t)
- (setq listcmd
- (cons (list (match-string 1))
- listcmd)))
- listcmd)))))))
- (if (string= command "")
- (xetla-run-tla-sync
- '("help")
- :finished 'xetla-display-global-help)
- (xetla-run-tla-sync (list command "-H"))))
-
-(defun xetla-tree-version-list-tla ()
- "Return the tree version, or nil if not in a project tree."
- (xetla-run-tla-sync '("tree-version")
- :finished
- (lambda (output error status arguments)
- (with-current-buffer output
- (and
- (goto-char (point-min))
- (re-search-forward "\\(.*\\)/\\(.*\\)--\\(.*\\)--\\(.*\\)" nil t)
- (list (match-string 1)
- (match-string 2)
- (match-string 3)
- (match-string 4)))))))
-
-(defun xetla-tree-version-list (&optional location no-error)
- "Elisp implementation of `xetla-tree-version-list-tla'.
-
-A string, LOCATION is used as a directory where
-\"/{arch}/++default-version\" is. If NO-ERROR is non-nil, errors are
-not reported; just return nil."
- (let ((version-string (xetla-tree-version location no-error)))
- (and version-string
- (string-match "\\(.*\\)/\\(.*\\)--\\(.*\\)--\\(.*\\)" version-string)
- (list (match-string 1 version-string)
- (match-string 2 version-string)
- (match-string 3 version-string)
- (match-string 4 version-string)))))
-
-(defun xetla-tree-root-xetla ()
- "Run tla tree-root."
- (interactive)
- (xetla-run-tla-sync '("tree-root")
- :finished
- `(lambda (output error status arguments)
- (let ((result (xetla-buffer-content output)))
- (when ,(interactive-p)
- (message "tla tree-root is: %s"
- result))
- result))))
-
-;;;###autoload
-(defun xetla-tree-version (&optional location no-error)
- "Equivalent of xetla tree-version (but implemented in pure elisp).
-
-Optional argument LOCATION is the directory in which the command must
-be ran. If NO-ERROR is non-nil, don't raise errors if ran outside an
-arch managed tree."
- (interactive (list nil nil))
- (let* ((tree-root (xetla-tree-root location no-error))
- (default-version-file (when tree-root
- (expand-file-name
- "{arch}/++default-version"
- tree-root)))
- (version (and (boundp 'xetla-buffer-version-name)
- xetla-buffer-version-name)))
- (if (and (null version)
- default-version-file
- (file-readable-p default-version-file))
- (with-temp-buffer
- (insert-file-contents default-version-file)
- (setq version (buffer-substring-no-properties
- (point-min)
- (if (eq (char-before (point-max)) ?\n)
- (1- (point-max))
- (point-max))))))
- (when (interactive-p)
- (message "%s" version))
- version))
-
-;;;###autoload
-(defun xetla-my-id (&optional arg my-id)
- "Run tla my-id.
-
-When called without a prefix argument ARG, just print the my-id from
-xetla and return it. If MY-ID is not set yet, return an empty string.
-When called with a prefix argument, ask for a new my-id.
-
-The my-id should have the following format:
-
-Your id is recorded in various archives and log messages as you use
-arch. It must consist entirely of printable characters and fit on one
-line. By convention, it should have the form of an email address, as
-in this example:
-
-Jane Hacker <jane.hacker@email.address>"
- (interactive "P")
- (let ((id (xetla-run-tla-sync '("my-id")
- :finished
- (lambda (output error status arguments)
- (xetla-buffer-content output))
- :error
- (lambda (output error status arguments)
- nil))))
- (if arg
- ;; Set the user's ID
- (let ((new-id (or my-id
- (read-string "New arch my-id: "
- id xetla-my-id-history id))))
- (if (string= id new-id)
- (message "Id unchanged! Id = %s" new-id)
- (message "Setting id to: %s" new-id)
- (xetla-run-tla-sync (list "my-id" new-id)
- :finished (lambda (output error status arguments)
- (message "Id changed"))
- :error
- (lambda (output error status arguments)
- (message "Could not change Id")
- (xetla-show-error-buffer error)
- )))
- new-id)
- (cond (id (when (interactive-p)
- (message "Arch my-id: %s" id))
- id)
- (t (when (interactive-p)
- (message (concat "Arch my-id has not been given yet. "
- "Call `%s' to set.")
- "xetla-set-my-id"))
- "")))))
-
-(defun xetla-set-my-id ()
- "Set xetla's my-id."
- (interactive)
- (xetla-my-id 1))
-
-;;
-;; Library
-;;
-
-;;;###autoload
-(defun xetla-my-revision-library (&optional arg)
- "Run tla my-revision-library.
-
-When called without a prefix argument ARG, just print the
-my-revision-library from xetla. When called with a prefix argument, ask
-for a new my-revision-library.
-
-my-revision-library specifies a path, where the revision library is
-stored to speed up tla. For example ~/tmp/arch-lib.
-
-You can configure the parameters for the library via
-`xetla-library-config'."
- (interactive "P")
- (let ((result (xetla-run-tla-sync '("my-revision-library")
- :finished 'xetla-status-handler
- :error 'xetla-null-handler))
- (rev-lib (xetla-get-process-output)))
- (when (eq 0 result)
- (if arg
- (xetla-library-add-interactive rev-lib)
- (if (and rev-lib (string= "" rev-lib))
- (message "Arch my-revision-library has not been given yet. Call `%s' with prefix arguments to set."
- this-command)
- (when (interactive-p) (message "Arch my-revision-library: %s" rev-lib)))
- rev-lib))))
-
-(defun xetla-library-add-interactive (&optional old-rev-lib)
- "Prompts for argument and run `xetla-library-add'.
-
-Argument OLD-REV-LIB is the previously set revision library (a
-string)."
- (unless old-rev-lib (setq old-rev-lib ""))
- (let ((new-rev-lib (expand-file-name (read-directory-name
- "New arch revision library: " old-rev-lib))))
- (if (not (string= old-rev-lib new-rev-lib))
- (progn
- (message "Setting my-revision-library to: %s" new-rev-lib)
- (xetla-library-add-internal new-rev-lib))
- old-rev-lib)))
-
-(defun xetla-library-delete (rev-lib)
- "Unregister revision library REV-LIB."
- (interactive (list (xetla-read-revision-library)))
- (xetla-run-tla-sync (list "my-revision-library" "--delete" rev-lib)
- :finished (lambda (output error status arguments)
- (message "Library %s removed."
- rev-lib))))
-
-(defun xetla-library-add-internal (new-rev-lib)
- "Change the revision library path to NEW-REV-LIB."
- (let ((dir-attr (file-attributes new-rev-lib)))
- (unless dir-attr
- (make-directory new-rev-lib t))
- (xetla-run-tla-sync (list "my-revision-library" new-rev-lib)
- :finished
- (lambda (output error status arguments)
- (message (xetla-buffer-content output))))
- new-rev-lib))
-
-(defun xetla-revision-library-list ()
- "Parse `xetla my-revision-library' into a list of revision libraries."
- (xetla-run-tla-sync '("my-revision-library")
- :finished
- 'xetla-output-buffer-split-handler))
-
-(defvar xetla-library-history nil)
-
-(defun xetla-read-revision-library (&optional prompt)
- "Read a revision library from keyboard.
-Prompt the user with PROMPT if given."
- (let ((list-lib (xetla-revision-library-list)))
- (if (null (cdr list-lib))
- (car list-lib)
- (completing-read (or prompt
- (format "Revision library (default %s): "
- (car list-lib)))
- (mapcar 'list (xetla-revision-library-list))
- nil t nil xetla-library-history
- (car list-lib)))))
-
-(defun xetla-library-config (&optional arg)
- "Run tla library-config.
-When called without prefix argument ARG, just print the config.
-When called with prefix argument ARG, let the user change the config."
- (interactive "P")
- (let ((rev-lib (xetla-read-revision-library))
- (config-param (when arg
- (completing-read "tla library config "
- (mapcar 'list '("--greedy"
- "--sparse"
- "--non-greedy"
- "--non-sparse"))
- nil t "--"))))
- (xetla-run-tla-sync (list "library-config" config-param rev-lib)
- :finished 'xetla-null-handler)
- (message (xetla-get-process-output))))
-
-(defun xetla-library-add (archive category branch version revision)
- "Add ARCHIVE-CATEGORY-BRANCH-VERSION-REVISION to the revision library."
- (xetla-show-last-process-buffer)
- (xetla-run-tla-async `("library-add"
- ,(xetla-name-construct archive category
- branch version
- revision))))
-
-(defun xetla-library-find (archive category branch version revision
- &optional silent)
- "Find ARCHIVE-CATEGORY-BRANCH-VERSION-REVISION in the revision library.
-If the revision is found, return the path for it. Else return nil."
- (if (zerop (xetla-run-tla-sync (list "library-find" (when silent "--silent")
- (xetla-name-construct
- archive category branch
- version revision))
- :finished 'xetla-status-handler
- :error 'xetla-status-handler))
- (xetla-get-process-output)))
-
-;; completing-read: tagline, explicit, names, implicit
-(defvar xetla-id-tagging-method-history nil)
-;;;###autoload
-(defun xetla-id-tagging-method (arg)
- "View (and return) or change the id-tagging method.
-When called without prefix argument ARG: show the actual tagging method.
-When called with prefix argument ARG: Ask the user for the new tagging method."
- (interactive "P")
- (let ((tm (progn (xetla-run-tla-sync '("id-tagging-method")
- :finished
- (lambda (output error status arguments)
- (xetla-buffer-content output)))))
- (new-tagging-method))
- (if arg
- (progn
- (setq new-tagging-method
- (xetla-id-tagging-method-read tm))
- (when (not (string= tm new-tagging-method))
- (xetla-id-tagging-method-set new-tagging-method)))
- (when (interactive-p)
- (message "Arch id tagging method: %s" tm))
- tm
- )))
-
-(defun xetla-id-tagging-method-read (old-method)
- "Read id tagging method.
-If OLD-METHOD is given, use it as the default method."
- (completing-read
- (if old-method
- (format "New id tagging method (default %s): " old-method)
- "New id tagging method: ")
- (mapcar 'list '("tagline" "explicit" "names" "implicit"))
- nil t nil
- xetla-id-tagging-method-history
- old-method))
-
-(defun xetla-id-tagging-method-set (method)
- "Set the tagging method to METHOD."
- (message "Setting tagging method to: %s" method)
- (xetla-run-tla-sync (list "id-tagging-method"
- method)
- :finished 'xetla-null-handler))
-
-(defun xetla-archive-mirror (archive &optional category branch version from)
- "Synchronize the mirror for ARCHIVE.
-Limit to CATEGORY-BRANCH-VERSION. If FROM is provided, mirror from it."
- (interactive (xetla-name-read nil 'prompt))
- (let ((name (xetla-name-construct-semi-qualified category branch version)))
- (when (string= name "") (setq name nil))
- (xetla-run-tla-async (list "archive-mirror"
- archive
- name
- from)
- :finished `(lambda (output error status arguments)
- (message "tla archive-mirror finished"))
- )))
-
-(defun xetla-archive-fixup (archive)
- "Run tla archive-fixup for ARCHIVE."
- (interactive (list (car (xetla-name-read "Archive to fixup: " 'prompt))))
- (xetla-run-tla-async (list "archive-fixup" "-A" archive)
- :finished `(lambda (output error status arguments)
- (message "tla archive-fixup %s finished" ,archive))
- ))
-
-
-(defun xetla-star-merge (from &optional to-tree)
- "Star merge from version/revision FROM to local tree TO-TREE."
- (interactive (list (xetla-name-construct
- (xetla-name-read "Star merge from (version or revision): "
- 'prompt 'prompt 'prompt 'prompt 'maybe))
- (read-directory-name "In tree: ")))
- (let ((to-tree (when to-tree (expand-file-name to-tree))))
- (or (xetla-save-some-buffers (or to-tree default-directory))
- (y-or-n-p
- "Star-merge may delete unsaved changes. Continue anyway? ")
- (error "Not running star-merge"))
- (let* ((default-directory (or to-tree default-directory))
- (arglist '())
- (buffer (xetla-prepare-changes-buffer
- (list 'last-revision default-directory)
- (list 'local-tree default-directory)
- ;; TODO using xetla-changes here makes it simpler.
- ;; The user can just type `g' and get the real
- ;; changes. Maybe a 'star-merge would be better
- ;; here ...
- 'changes default-directory)))
- (when xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer))
- (when xetla-three-way-merge (add-to-list 'arglist "--three-way"))
- (when xetla-use-forward-option (add-to-list 'arglist "--forward"))
- (xetla-run-tla-async `("star-merge" ,@arglist ,from)
- :finished `(lambda (output error status arguments)
- ;; (xetla-show-last-process-buffer)
- (xetla-show-changes-buffer
- output nil ,buffer)
- (message "tla star-merge finished")
- (xetla-revert-some-buffers ,to-tree))
- :error `(lambda (output error status arguments)
- (case status
- ;; 2 stands for an error.
- (2 (xetla-default-error-function
- output error status arguments))
- ;; How about other status?
- (otherwise (xetla-show-changes-buffer output)
- output nil ,buffer)))))))
-
-(defun xetla-replay-arguments ()
- "Build an argument list for the replay command.
-Used to factorize the code of (interactive ...) between `xetla-replay-reverse'
-and `xetla-replay'."
- (list (xetla-name-construct
- (xetla-name-read "Relay version or revision: "
- 'prompt 'prompt 'prompt 'prompt 'maybe))
- (read-directory-name "Replay in tree: ")
- current-prefix-arg))
-
-(defun xetla-replay-reverse (from &optional to-tree arg)
- "Call `xetla-replay' with the REVERSE option."
- (interactive (xetla-replay-arguments))
- (xetla-replay from to-tree arg t))
-
-
-(defun xetla-replay (from &optional to-tree arg reverse)
- "Replay the revision FROM into tree TO-TREE.
-If FROM is a string, it should be a fully qualified revision.
-If FROM is a list, it should be a list of fully qualified revisions to
-be replayed.
-
-If ARG is non-nil, replay all the version instead of the revision only.
-If REVERSE is non-nil, reverse the requested revision."
- (interactive (xetla-replay-arguments))
- (let ((default-directory (or to-tree default-directory)))
- (or (xetla-save-some-buffers)
- (y-or-n-p
- "Replay may delete unsaved changes. Continue anyway? ")
- (error "Not replaying"))
- (xetla-show-last-process-buffer)
- (let ((buffer (xetla-prepare-changes-buffer
- (list 'last-revision default-directory)
- (list 'local-tree default-directory)
- 'changes default-directory)))
- (when xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer))
- (xetla-run-tla-async `("replay"
- ,(when xetla-use-forward-option "--forward")
- ,(when reverse "--reverse")
- ,(when xetla-use-skip-present-option "--skip-present")
- ,@(if (listp from)
- from
- (list from)))
- :finished `(lambda (output error status arguments)
- (xetla-show-changes-buffer output
- nil ,buffer)
- (message "tla replay finished")
- (xetla-revert-some-buffers ,to-tree))
- :error (lambda (output error status arguments)
- (xetla-show-error-buffer error)
- (xetla-show-last-process-buffer))))))
-
-(defun xetla-sync-tree (from &optional to-tree)
- "Synchronize the patch logs of revision FROM and tree TO-TREE."
- (interactive (list
- (xetla-name-construct
- (xetla-name-read "Sync tree with revision: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))
- (read-directory-name "Sync tree: ")))
- (let ((default-directory (or to-tree default-directory)))
- (or (xetla-save-some-buffers)
- (y-or-n-p
- "Update may delete unsaved changes. Continue anyway? ")
- (error "Not updating"))
- (xetla-show-last-process-buffer)
- (xetla-run-tla-async `("sync-tree" ,from)
- :finished `(lambda (output error status arguments)
- (xetla-show-last-process-buffer)
- (message "tla sync-tree finished")
- (xetla-revert-some-buffers ,to-tree))
- :error (lambda (output error status arguments)
- (xetla-show-changes-buffer output)))))
-
-(defun xetla-tag (source-revision tag-version)
- "Create a tag from SOURCE-REVISION to TAG-VERSION.
-Run tla tag --setup."
- (interactive
- (list (xetla-name-construct
- (xetla-name-read "Source revision (or version): " 'prompt 'prompt 'prompt
- 'prompt 'maybe))
- (xetla-name-construct
- (xetla-name-read "Tag version: " 'prompt 'prompt 'prompt
- 'prompt))))
- (xetla-run-tla-async (list "tag" "--setup"
- source-revision tag-version)))
-
-(defun xetla-set-tree-version (version)
- "Run tla set-tree-version VERSION."
- (interactive (list (xetla-name-read "Set tree version to: "
- 'prompt 'prompt 'prompt 'prompt)))
-
- (let ((new-version (xetla-name-construct version))
- (old-version (xetla-tree-version)))
- (when (y-or-n-p (format "Switch tree version from `%s' to `%s'? "
- old-version
- new-version))
- (xetla-run-tla-sync (list "set-tree-version" new-version)))))
-
-;; --------------------------------------
-;; Xetla bookmarks
-;; --------------------------------------
-
-(make-face 'xetla-bookmark-name
- "Face used for bookmark names.")
-(set-face-foreground 'xetla-bookmark-name "magenta")
-
-(defvar xetla-bookmarks-loaded nil
- "Whether `xetla-bookmarks' have been loaded from file.")
-
-(defvar xetla-bookmarks-alist nil
- "Alist containing Xetla bookmarks.")
-
-(defvar xetla-bookmarks-show-details nil
- "Whether `xetla-bookmarks' should show bookmark details.")
-
-(defvar xetla-bookmarks-cookie nil
- "Ewoc dll.")
-
-(defvar xetla-missing-buffer-todolist nil
- "List of (kind info).
-
-Can be
-\(separator \"label\" bookmark \"local-tree\")
-\(changes \"local-tree\")
-\(missing \"local-tree\" \"location\" \"bookmark-name\")")
-
-(defvar xetla-bookmarks-marked-list nil
- "A list of marked bookmarks.")
-
-(defun xetla-bookmarks-load-from-file (&optional force)
- "Load bookmarks from the file `xetla-bookmarks-file-name'.
-
-If FORCE is non-nil, reload the file even if it was loaded before."
- (when (or force (not xetla-bookmarks-loaded))
- (xetla-load-state (xetla-config-file-full-path
- xetla-bookmarks-file-name t))
- (setq xetla-bookmarks-loaded t)))
-
-(defun xetla-bookmarks-save-to-file ()
- "Save `xetla-bookmarks-alist' to the file `xetla-bookmarks-file-name'."
- (xetla-save-state '(xetla-bookmarks-alist)
- (xetla-config-file-full-path xetla-bookmarks-file-name t)
- t))
-
-(defun xetla-bookmarks-toggle-details (&optional val)
- "Toggle the display of bookmark details.
-If VAL is positive, enable bookmark details.
-If VAL is negative, disable bookmark details."
- (interactive "P")
- (let ((current-bookmark (ewoc-locate xetla-bookmarks-cookie)))
- (setq xetla-bookmarks-show-details
- (if val
- (if (> val 0) t
- (if (< val 0) nil
- (not xetla-bookmarks-show-details)))
- (not xetla-bookmarks-show-details)))
- (ewoc-refresh xetla-bookmarks-cookie)
- (xetla-bookmarks-cursor-goto current-bookmark)))
-
-(defvar xetla-bookmarks-align 19
- "Position, in chars, of the `:' when displaying the bookmarks buffer.")
-
-(defun xetla-bookmarks-printer (element)
- "Pretty print ELEMENT, an entry of the bookmark list.
-This is invoked by ewoc when displaying the bookmark list."
- (insert (if (member element xetla-bookmarks-marked-list)
- (concat " " xetla-mark " ") " "))
- (xetla-insert-right-justified (concat (car element) ": ")
- (- xetla-bookmarks-align 3)
- 'xetla-bookmark-name)
- (insert (xetla-face-add (xetla-name-construct
- (cdr (assoc 'location (cdr element))))
- 'xetla-revision-name
- 'xetla-bookmarks-entry-map
- xetla-bookmarks-entry-menu
- ))
- (when xetla-bookmarks-show-details
- (newline)
- (insert-char ?\ xetla-bookmarks-align)
- (insert (cdr (assoc 'timestamp (cdr element))))
- (newline)
- (let ((notes (assoc 'notes (cdr element))))
- (when notes
- (insert-char ?\ xetla-bookmarks-align)
- (insert (cdr notes))
- (newline)))
- (let ((nickname (assoc 'nickname (cdr element))))
- (when nickname
- (xetla-insert-right-justified "nickname: " xetla-bookmarks-align)
- (insert (cadr nickname))
- (newline)))
- (let ((partners (assoc 'partners (cdr element))))
- (when partners
- (xetla-insert-right-justified "partners: " xetla-bookmarks-align)
- (insert (cadr partners))
- (dolist (x (cddr partners))
- (insert ",\n")
- (insert-char ?\ xetla-bookmarks-align)
- (insert x))
- (newline)))
- (let ((local-tree (assoc 'local-tree (cdr element))))
- (when local-tree
- (xetla-insert-right-justified "local trees: " xetla-bookmarks-align)
- (insert (cadr local-tree))
- (dolist (x (cddr local-tree))
- (insert ", " x ))
- (newline)))
- (let ((groups (assoc 'groups (cdr element))))
- (when groups
- (xetla-insert-right-justified "Groups: " xetla-bookmarks-align)
- (insert (cadr groups))
- (dolist (x (cddr groups))
- (insert ", " x ))
- (newline)))
- (let ((summary-format (assoc 'summary-format (cdr element))))
- (when summary-format
- (xetla-insert-right-justified "Summary format: " xetla-bookmarks-align)
- (insert "\"" (cadr summary-format) "\"")
- (newline)))))
-
-(defvar xetla-revision-list-cookie nil
- "Ewoc cookie for xetla-bookmark-missing.")
-
-(defun xetla-bookmarks-read-local-tree (&optional bookmark arg)
- "Read a local tree for BOOKMARK, and possibly add it to the bookmarks.
-If ARG is non-nil, user will be prompted anyway. Otherwise, just use the
-default if it exists."
- (let* ((bookmark (or bookmark
- (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie))))
- (local-trees (assoc 'local-tree (cdr bookmark))))
- (cond
- ((not local-trees)
- (let ((dir (read-directory-name
- (format "Local tree for \"%s\": "
- (car bookmark)))))
- (when (y-or-n-p "Add this tree in your bookmarks? ")
- (xetla-bookmarks-add-tree bookmark dir))
- dir))
- (arg
- ;; multiple local trees.
- (let ((dir (completing-read
- (format "Local tree for \"%s\": "
- (car bookmark))
- (mapcar #'(lambda (x) (cons x nil))
- (cdr local-trees))
- nil nil nil nil (cadr local-trees))))
- (when (and (not (member dir (cdr local-trees)))
- (y-or-n-p "Add this tree in your bookmarks? "))
- (xetla-bookmarks-add-tree bookmark dir))
- (when (and (not (string=
- dir (cadr local-trees)))
- (y-or-n-p "Make this the default? "))
- (xetla-bookmarks-delete-tree bookmark dir)
- (xetla-bookmarks-add-tree bookmark dir))
- dir))
- (t (cadr local-trees)))))
-
-(defun xetla-bookmarks-missing (&optional arg)
- "Show the missing patches from your partners.
-The missing patches are received via xetla missing.
-Additionally the local changes in your working copy are also shown.
-
-If prefix argument ARG is specified, the local tree is prompted even
-if already set in the bookmarks."
- (interactive "P")
- (unless xetla-bookmarks-cookie
- (error "Wrong buffer, run: `%s' and try again"
- (substitute-command-keys "\\[xetla-bookmarks]")))
- (let ((list (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie))))))
- (set-buffer (xetla-get-buffer-create 'missing))
- (xetla-revision-list-mode)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-missing-refresh)
- (let ((xetla-bookmarks-missing-buffer-list-elem
- (mapcar
- #'(lambda (elem)
- (cons
- elem
- (xetla-bookmarks-read-local-tree elem arg)))
- list)))
- (set (make-local-variable 'xetla-missing-buffer-todolist)
- (reverse
- (apply 'append
- (mapcar (lambda (elem)
- (xetla-bookmarks-missing-elem
- (car elem) arg (cdr elem) t t))
- xetla-bookmarks-missing-buffer-list-elem))))
- (xetla-missing-refresh))))
-
-(defvar xetla-nb-active-processes 1
- "Number of active processes in this buffer.
-
-Used internally as a counter to launch a global handler when all
-processes have finished.")
-
-(defun xetla-missing-refresh ()
- "Refreshed a *xetla-missing* buffer.
-
-Process the variable `xetla-missing-buffer-todolist' and launches the
-xetla processes with the appropriate handlers to fill in the ewoc."
- (interactive)
- (set (make-local-variable 'xetla-nb-active-processes) 1)
- (let ((buffer-read-only nil))
- (erase-buffer)
- (set (make-local-variable 'xetla-revision-list-cookie)
- (ewoc-create 'xetla-revision-list-printer))
- (xetla-kill-process-maybe (current-buffer))
- (dolist (item xetla-missing-buffer-todolist)
- (case (car item)
- (missing
- ;; This item is a version that we want to check for missing patches.
- ;; ITEM is of the form:
- ;; (missing <local tree> <fully qualified version> [bookmark name])
- (let* ((local-tree (nth 1 item))
- (version (nth 2 item))
- (bookmark-name (nth 3 item))
- (text (if bookmark-name
- (format "Missing patches from partner %s:"
- bookmark-name)
- (concat "Missing patches from archive " version)))
- (node (ewoc-enter-last xetla-revision-list-cookie
- (list 'separator (concat
- text)
- 'partner))))
- (ewoc-enter-last xetla-revision-list-cookie
- '(message "Checking for missing patches..."))
- (let ((default-directory local-tree))
- ;; Set the default-directory for the *xetla-missing* buffer.
- (cd default-directory)
- (setq xetla-nb-active-processes
- (+ xetla-nb-active-processes 1))
- (xetla-run-tla-async
- `("missing" "--full" ,(when xetla-use-skip-present-option
- "--skip-present");;"-summary" "-creator" "-date"
- ,version)
- :finished
- `(lambda (output error status arguments)
- (when (and (xetla-get-buffer 'missing)
- (buffer-live-p (xetla-get-buffer 'missing)))
- (with-current-buffer (xetla-get-buffer-create 'missing)
- (when (ewoc-p xetla-revision-list-cookie)
- (let* ((cookie xetla-revision-list-cookie)
- (to-delete (ewoc-next cookie ,node))
- (prev (ewoc-prev
- xetla-revision-list-cookie
- to-delete))
- (cur (ewoc-locate
- xetla-revision-list-cookie))
- (deleted (eq cur to-delete)))
- (xetla-revisions-parse-list
- 'missing nil
- nil
- output ,node cookie
- 'xetla-revision-compute-merged-by
- )
- (ewoc--node-delete to-delete)
- (ewoc-refresh xetla-revision-list-cookie)
- (let ((loc (if deleted
- (ewoc-next
- xetla-revision-list-cookie
- prev)
- cur)))
- (when loc
- (goto-char (ewoc-location loc)))))))))
- :error
- `(lambda (output error status arguments)
- (when (and (xetla-get-buffer 'missing)
- (buffer-live-p (xetla-get-buffer 'missing)))
- (with-current-buffer (xetla-get-buffer-create 'missing)
- (when (ewoc-p xetla-revision-list-cookie)
- (let* ((cookie xetla-revision-list-cookie)
- (to-delete (ewoc-next cookie ,node)))
- (setcdr (ewoc-data to-delete) '("Error in xetla process"))))))
- (message "Abnormal exit with code %d!\n%s" status
- (xetla-buffer-content error)))))))
- (separator
- ;; This item is a separator - the name of a bookmark.
- ;; ITEM is of the form:
- ;; (separator <text> bookmark <local tree>)
- (let* ((text (nth 1 item))
- (local-tree (nth 3 item)))
- (ewoc-enter-last xetla-revision-list-cookie
- (list 'separator
- text
- 'bookmark
- local-tree))))
- (changes
- ;; This item is a local-tree that should be checked for changes.
- ;; ITEM is of the form:
- ;; (changes <local tree>)
- (let ((to-delete
- (ewoc-enter-last xetla-revision-list-cookie
- '(message "Checking for local changes..."))))
- (let ((default-directory (nth 1 item)))
- (xetla-run-tla-async
- '("changes")
- :error `(lambda (output error status arguments)
- (with-current-buffer ,(current-buffer)
- (let* ((prev (ewoc-prev
- xetla-revision-list-cookie
- ,to-delete))
- (cur (ewoc-locate
- xetla-revision-list-cookie))
- (deleted (eq cur ,to-delete)))
- (xetla-bookmarks-missing-parse-changes
- output ,(ewoc-nth xetla-revision-list-cookie
- -1))
- (ewoc--node-delete ,to-delete)
- (ewoc-refresh xetla-revision-list-cookie)
- (let ((loc (if deleted
- (ewoc-next
- xetla-revision-list-cookie
- prev)
- cur)))
- (when loc
- (goto-char (ewoc-location loc)))))))
- :finished `(lambda (output error status arguments)
- (with-current-buffer ,(current-buffer)
- (let* ((prev (ewoc-prev
- xetla-revision-list-cookie
- ,to-delete))
- (cur (ewoc-locate
- xetla-revision-list-cookie))
- (deleted (eq cur ,to-delete)))
- (ewoc--node-delete ,to-delete)
- (ewoc-refresh xetla-revision-list-cookie)
- (let ((loc (if deleted
- (ewoc-next
- xetla-revision-list-cookie
- prev)
- cur)))
- (when loc
- (goto-char (ewoc-location loc)))))))
- )))))
- (ewoc-set-hf xetla-revision-list-cookie ""
- (concat "\n" (xetla-face-add "end."
- 'xetla-separator)))))
- (goto-char (point-min))
- ;; If all processes have been run synchronously,
- ;; xetla-nb-active-processes is 1 now, and we should run the
- ;; callback.
- (setq xetla-nb-active-processes
- (- xetla-nb-active-processes 1))
- (when (zerop xetla-nb-active-processes)
- (xetla-revision-compute-merged-by))
- )
-
-(defun xetla-revision-ewoc-map (function ewoc-list)
- "Invoke FUNCTION on 'entry-patch nodes of EWOC-LIST.
-Like (ewoc-map FUNCTION EWOC-LIST), but call FUNCTION only on
-'entry-patch nodes. The argument passed to FUNCTION is a struct of
-type xetla-revisions."
- (ewoc-map (lambda (elem)
- (when (eq (car elem) 'entry-patch)
- (funcall function (caddr elem))))
- ewoc-list))
-
-(defvar xetla-revision-merge-by-computed nil
- "Non-nil when the \"merged-by\" field have been computed.")
-
-(defun xetla-revision-compute-merged-by ()
- "Computes the field \"merged-by:\" for a revision.
-
-In a revision list buffer, with revisions containing the \"merges:\"
-information, compute another field \"merged-by:\", containing the
-reverse information. If revision-A is a merge of revision-B, then,
-you'll get revision-A merges: revision-B revision-B merged-by:
-revision-A"
- (interactive)
- (xetla-revision-ewoc-map (lambda (elem)
- (setf (xetla-revision-merged-by elem) nil))
- xetla-revision-list-cookie)
- (xetla-revision-ewoc-map 'xetla-set-merged-patches
- xetla-revision-list-cookie)
- (xetla-revision-ewoc-map (lambda (elem)
- (unless (xetla-revision-merged-by elem)
- (setf (xetla-revision-merged-by elem) 'nobody)))
- xetla-revision-list-cookie)
- (set (make-local-variable 'xetla-revision-merge-by-computed) t)
- )
-
-(eval-when-compile
- (defvar xetla-merged-rev))
-
-(defun xetla-set-merged-patches (rev)
- "Set the \"merged-by\" field for other revisions according to REV.
-
-Adds REV to the list of all patches merged by REV."
- (dolist (merged-rev (xetla-revision-merges rev))
- (setq xetla-merged-rev merged-rev)
- (xetla-revision-ewoc-map
- `(lambda (rev-to-fill)
- (when (equal (xetla-name-construct
- (xetla-revision-revision rev-to-fill))
- xetla-merged-rev)
- (setf (xetla-revision-merged-by rev-to-fill)
- (cons ,(xetla-name-construct
- (xetla-revision-revision rev))
- (xetla-revision-merged-by rev-to-fill)))))
- xetla-revision-list-cookie)))
-
-(defun xetla-bookmarks-missing-elem (data arg local-tree header
- &optional changes-too)
- "Show missing patches for DATA.
-ARG is currently ignored but is present for backwards compatibility.
-LOCAL-TREE is the local tree for which missing patches should be shown.
-HEADER is currently ignored but is present for backwards compatibility.
-If CHANGES-TOO is non-nil, show changes for DATA as well as missing patches."
- (let* ((default-directory local-tree)
- (partners (assoc 'partners (cdr data)))
- (location (cdr (assoc 'location (cdr data)))))
- (xetla-switch-to-buffer (xetla-get-buffer-create 'missing))
- ;; The buffer was created in a context where we didn't know the
- ;; path to use. Set it now.
- (cd local-tree)
- (let ((item '()))
- (add-to-list 'item
- `(separator
- ,(format "Bookmark %s (%s):"
- (car data)
- (xetla-name-construct location))
- bookmark
- ,local-tree))
- (when changes-too
- (add-to-list 'item `(changes ,local-tree)))
- (dolist (partner (cons (xetla-name-construct
- (cdr (assoc 'location (cdr data)))) ; Me
- (cdr partners))) ; and my partners
- (let* ((bookmark-list
- (mapcar (lambda (bookmark)
- (and (string= partner
- (xetla-name-construct
- (cdr (assoc 'location bookmark))))
- (car bookmark)))
- xetla-bookmarks-alist))
- (bookmark-name (progn (while (and (not (car bookmark-list))
- (cdr bookmark-list))
- (setq bookmark-list
- (cdr bookmark-list)))
- (car bookmark-list))))
- (add-to-list 'item `(missing ,local-tree ,partner ,bookmark-name))))
- item)))
-
-(defun xetla-read-field (field)
- "Read the contents of FIELD from a log buffer.
-Must be called from a log file buffer. Returns the content of the
-field FIELD. FIELD is just the name of the field, without trailing
-\": \""
- (save-excursion
- (goto-char (point-min))
- (if (re-search-forward (concat "^" field ": ") nil t)
- (buffer-substring-no-properties
- (point) (progn
- (re-search-forward "^[^ \t]")
- (- (point) 2))) ;; back to the end of the last line
- ;; of the field.
- "")))
-
-(defun xetla-revisions-parse-list (type details merges buffer
- parent-node cookie
- &optional callback)
- "Parse a list of revisions.
-TYPE can be either 'logs, 'missing, but
-could be extended in the future.
-
-DETAILS must be non-nil if the buffer contains date, author and
-summary.
-MERGES must be non-nil if the buffer contains list of merged patches
-for each revision.
-BUFFER is the buffer to parse.
-
-PARENT-NODE is an ewoc node to which the new items will be appened. If
-nil, append at the end of the ewoc list.
-COOKIE must be the ewoc list containing PARENT-NODE.
-
-If CALLBACK is given, it should be a function (or symbol naming a
-function) that will be called once the revision list has been fully
-parsed."
- (with-current-buffer (ewoc-buffer cookie)
- (set (make-local-variable 'xetla-revision-merge-by-computed) nil))
- (let ((last-node parent-node)
- revision)
- (with-current-buffer (with-current-buffer buffer
- (clone-buffer))
- (goto-char (point-min))
- (re-search-forward ".*/.*--.*--.*--.*" nil t)
- (beginning-of-line)
- (while (progn (> (point-max) (point)))
- (setq revision (buffer-substring-no-properties
- (point) (point-at-eol)))
- (forward-line 1)
- (let* ((rev-struct (make-xetla-revision
- :revision (xetla-name-split revision)))
- (elem (list 'entry-patch nil
- rev-struct)))
- (when (or xetla-revisions-shows-summary
- xetla-revisions-shows-creator
- xetla-revisions-shows-date
- xetla-revisions-shows-merges
- xetla-revisions-shows-merged-by)
- (with-current-buffer (ewoc-buffer cookie)
- (setq xetla-nb-active-processes
- (+ xetla-nb-active-processes 1))
- (xetla-cat-log-any
- (xetla-name-split revision)
- nil
- `(lambda (output error status arguments)
- (with-current-buffer output
- (setf (xetla-revision-date ,rev-struct)
- (xetla-read-field "Standard-date"))
- (setf (xetla-revision-creator ,rev-struct)
- (xetla-read-field "Creator"))
- (setf (xetla-revision-summary ,rev-struct)
- (xetla-read-field "Summary"))
- (setf (xetla-revision-merges ,rev-struct)
- (remove ,revision
- (split-string (xetla-read-field
- "New-patches")))))
- (with-current-buffer ,(ewoc-buffer cookie)
- (setq xetla-nb-active-processes
- (- xetla-nb-active-processes 1))
- (when (and ',callback
- (zerop xetla-nb-active-processes))
- (funcall ',callback)))
- (let* ((cur (ewoc-locate xetla-revision-list-cookie)))
- (ewoc-refresh ,cookie)
- (when cur (goto-char (ewoc-location cur))))))))
- (if last-node
- (setq last-node
- (ewoc-enter-after cookie last-node elem))
- (ewoc-enter-last cookie elem))))
- (kill-buffer (current-buffer)))
- (with-current-buffer (ewoc-buffer cookie)
- (setq xetla-nb-active-processes (- xetla-nb-active-processes 1))
- (when (and callback
- (zerop xetla-nb-active-processes))
- (funcall callback))))
- (ewoc-refresh cookie))
-
-(defun xetla-bookmarks-missing-parse-changes (buffer parent-node)
- "Parse the output of `xetla changes' from BUFFER and update PARENT-NODE."
- (with-current-buffer buffer
- (let ((changes
- (progn (goto-char (point-min))
- (when (re-search-forward "^[^\\*]" nil t)
- (buffer-substring-no-properties
- (point-at-bol)
- (point-max)))))
- (local-tree default-directory))
- (when changes
- (with-current-buffer (xetla-get-buffer-create 'missing)
- (ewoc-enter-after xetla-revision-list-cookie
- parent-node
- (list 'entry-change
- changes
- local-tree)))))))
-
-(defun xetla-bookmarks-open-tree ()
- "Open a local tree in a dired buffer.
-
-With a prefix arg, prompt for a local tree to use."
- (interactive)
- (let ((x-dired (if (eq xetla-switch-to-buffer-mode 'single-window)
- 'dired
- 'dired-other-window))
- (open (if current-prefix-arg
- (xetla-bookmarks-read-local-tree nil 'ask)
- (xetla-bookmarks-read-local-tree))))
- (funcall x-dired open)))
-
-(defun xetla-bookmarks-find-file ()
- "Find a file starting from the local tree of the current bookmark.
-
-This way, you can type C-x C-f in the bookmarks buffer to open a file
-of a bookmarked project.
-
-With a prefix arg, prompt for the local tree to use."
- (interactive)
- (let ((default-directory (xetla-uniquify-file-name
- (if current-prefix-arg
- (xetla-bookmarks-read-local-tree nil 'ask)
- (xetla-bookmarks-read-local-tree)))))
- (call-interactively 'find-file)))
-
-(defun xetla-bookmarks-tag (arg)
- "Run `tla tag' on the current bookmark.
-
-If multiple bookmarks are marked, create a tag for each of them. If a
-prefix argument ARG is given, explicitly ask for the revision to tag
-from."
- (interactive "P")
- (unless xetla-bookmarks-cookie
- (error "Not in bookmarks buffer, run: `%s' and try again"
- (substitute-command-keys "\\[xetla-bookmarks]")))
- (let ((list (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate xetla-bookmarks-cookie))))))
- (let ((tags (mapcar
- (lambda (bookmark)
- (let ((location
- (xetla-name-construct
- (if arg
- (apply 'xetla-name-read "Tag from revision: "
- (append (cdr (assoc 'location bookmark))
- '(prompt)))
- (cdr (assoc 'location bookmark))))))
- (list location
- (xetla-name-construct
- (xetla-name-read (format "Tag version for '%s': "
- location)
- 'prompt 'prompt 'prompt 'prompt))
- (read-string
- "Name of the bookmark for this tag: "))))
- list)))
- (dolist (tag tags)
- (destructuring-bind (src destination name) tag
- (xetla-run-tla-async
- (list "tag" "--setup" src destination)
- :finished
- `(lambda (output error status arguments)
- (xetla-bookmarks-add ,name (xetla-name-split ,destination))
- (xetla-bookmarks-add-partner (assoc ,name xetla-bookmarks-alist)
- ,src t))
- :error
- `(lambda (output error status arguments)
- (error "Fail to create a tag for %s" ,src))))))
- (setq xetla-bookmarks-marked-list nil)
- (ewoc-refresh xetla-bookmarks-cookie)))
-
-(defun xetla-bookmarks-inventory ()
- "Run `tla inventory' on a local tree."
- (interactive)
- (let ((default-directory (if current-prefix-arg
- (xetla-bookmarks-read-local-tree nil 'ask)
- (xetla-bookmarks-read-local-tree))))
- (xetla-inventory nil
- (unless (eq xetla-switch-to-buffer-mode 'single-window)
- t))))
-
-(defun xetla-bookmarks-changes (arg)
- "Run `xetla-changes' on a local tree.
-
-Prefix argument, ARG, determines whether or not to use a full format or
-summary format and if it should prompt for the local tree to use.
-
- No prefix arg -- full format, default tree.
- One prefix arg -- summary format, default tree.
- Two prefix args -- full format, prompt for tree.
- Three prefix args -- summary format, prompt for tree."
- (interactive "p")
- (let* ((arg (car current-prefix-arg))
- (default-directory (if (or (eq arg 16) (eq arg 64))
- (xetla-bookmarks-read-local-tree nil 'ask)
- (xetla-bookmarks-read-local-tree))))
- (if (or (eq arg 4) (eq arg 64))
- (xetla-changes t)
- (xetla-changes))))
-
-(defmacro xetla-make-move-fn (ewoc-direction function cookie
- &optional only-unmerged)
- "Create function to move up or down in `xetla-revision-list-cookie'.
-
-EWOC-DIRECTION is either `ewoc-next' or `ewoc-prev'.
-FUNCTION is the name of the function to declare.
-COOKIE is the ewoc to navigate in.
-if ONLY-UNMERGED is non-nil, then, navigate only through revisions not
-merged by another revision in the same list."
- `(defun ,function ()
- (interactive)
- (let* ((elem (ewoc-locate ,cookie))
- (next (or (,ewoc-direction ,cookie elem) elem)))
- (while (and next
- (if ,only-unmerged
- (not (and (eq (car (ewoc-data next))
- 'entry-patch)
- (eq (xetla-revision-merged-by
- (caddr (ewoc-data next)))
- 'nobody)))
- (eq (car (ewoc-data next)) 'separator))
- (,ewoc-direction ,cookie next))
- (setq next (,ewoc-direction ,cookie next)))
- (while (and next
- (if ,only-unmerged
- (not (and (eq (car (ewoc-data next))
- 'entry-patch)
- (eq (xetla-revision-merged-by
- (caddr (ewoc-data next)))
- 'nobody)))
- (eq (car (ewoc-data next)) 'separator)))
- (setq next (,(if (eq ewoc-direction 'ewoc-next)
- 'ewoc-prev
- 'ewoc-next) ,cookie next)))
- (when next (goto-char (ewoc-location next)))))
- )
-
-(xetla-make-move-fn ewoc-next xetla-revision-next
- xetla-revision-list-cookie)
-
-(xetla-make-move-fn ewoc-prev xetla-revision-prev
- xetla-revision-list-cookie)
-
-(xetla-make-move-fn ewoc-next xetla-revision-next-unmerged
- xetla-revision-list-cookie t)
-
-(xetla-make-move-fn ewoc-prev xetla-revision-prev-unmerged
- xetla-revision-list-cookie t)
-
-;;;###autoload
-(defun xetla-bookmarks (&optional arg)
- "Display XEtla bookmarks in a buffer.
-
-With prefix argument ARG, reload the bookmarks file from disk."
- (interactive "P")
- (xetla-bookmarks-load-from-file arg)
- (if (eq xetla-switch-to-buffer-mode 'single-window)
- (switch-to-buffer (get-buffer-create "*xetla-bookmarks*"))
- (pop-to-buffer (get-buffer-create "*xetla-bookmarks*")))
- (let ((pos (point)))
- (toggle-read-only -1)
- (erase-buffer)
- (set (make-local-variable 'xetla-bookmarks-cookie)
- (ewoc-create 'xetla-bookmarks-printer))
- (set (make-local-variable 'xetla-bookmarks-marked-list) nil)
- (dolist (elem xetla-bookmarks-alist)
- (ewoc-enter-last xetla-bookmarks-cookie elem))
- (xetla-bookmarks-mode)
- (if (equal pos (point-min))
- (if (ewoc-nth xetla-bookmarks-cookie 0)
- (xetla-bookmarks-cursor-goto (ewoc-nth xetla-bookmarks-cookie 0))
- (message "You have no bookmarks, create some in the other buffers"))
- (goto-char pos))))
-
-
-(defun xetla-bookmarks-mode ()
- "Major mode to show XEtla bookmarks.
-
-Commands:
-\\{xetla-bookmarks-mode-map}"
- (interactive)
- (use-local-map xetla-bookmarks-mode-map)
- (setq major-mode 'xetla-bookmarks-mode)
- (setq mode-name "xetla-bookmarks")
- (toggle-read-only 1)
- (run-hooks 'xetla-bookmarks-mode-hook))
-
-(defun xetla-bookmarks-cursor-goto (ewoc-bookmark)
- "Move cursor to the ewoc location of EWOC-BOOKMARK."
- (interactive)
- (goto-char (ewoc-location ewoc-bookmark))
- (search-forward ":"))
-
-(defun xetla-bookmarks-next ()
- "Move the cursor to the next bookmark."
- (interactive)
- (let* ((cookie xetla-bookmarks-cookie)
- (elem (ewoc-locate cookie))
- (next (or (ewoc-next cookie elem) elem)))
- (xetla-bookmarks-cursor-goto next)))
-
-(defun xetla-bookmarks-previous ()
- "Move the cursor to the previous bookmark."
- (interactive)
- (let* ((cookie xetla-bookmarks-cookie)
- (elem (ewoc-locate cookie))
- (previous (or (ewoc-prev cookie elem) elem)))
- (xetla-bookmarks-cursor-goto previous)))
-
-(defun xetla-bookmarks-move-down ()
- "Move the current bookmark down."
- (interactive)
- (let* ((cookie xetla-bookmarks-cookie)
- (elem (ewoc-locate cookie))
- (data (ewoc-data elem))
- (oldname (car data))
- (next (ewoc-next cookie elem)))
- (unless next
- (error "Can't go lower"))
- (xetla-ewoc-delete cookie elem)
- (goto-char (ewoc-location
- (ewoc-enter-after cookie next data)))
- (let ((list xetla-bookmarks-alist)
- newlist)
- (while list
- (if (string= (caar list) oldname)
- (progn
- (setq newlist (cons (car (cdr list)) newlist))
- (setq newlist (cons (car list) newlist))
- (setq list (cdr list)))
- (setq newlist (cons (car list) newlist)))
- (setq list (cdr list)))
- (setq xetla-bookmarks-alist (reverse newlist)))
- (search-forward ":")))
-
-(defun xetla-bookmarks-move-up ()
- "Move the current bookmark up."
- (interactive)
- (let* ((cookie xetla-bookmarks-cookie)
- (elem (ewoc-locate cookie))
- (data (ewoc-data elem))
- (oldname (car data))
- (previous (ewoc-prev cookie elem)))
- (unless previous
- (error "Can't go upper"))
- (xetla-ewoc-delete cookie elem)
- (goto-char (ewoc-location
- (ewoc-enter-before cookie previous data)))
- (let ((list xetla-bookmarks-alist)
- newlist)
- (while list
- (if (string= (caar (cdr list)) oldname)
- (progn
- (setq newlist (cons (car (cdr list)) newlist))
- (setq newlist (cons (car list) newlist))
- (setq list (cdr list)))
- (setq newlist (cons (car list) newlist)))
- (setq list (cdr list)))
- (setq xetla-bookmarks-alist (reverse newlist)))
- (search-forward ":")))
-
-(defun xetla-get-location-as-string ()
- "Construct an a/c-b-v-r string from the current bookmark."
- (let* ((elem (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (location (cdr (assoc 'location elem))))
- (xetla-name-construct location)))
-
-(defun xetla-bookmarks-get (directory)
- "Run `tla get' on the bookmark under point, placing the tree in DIRECTORY."
- (interactive (list (expand-file-name
- (read-directory-name
- (format "Get %s in directory: " (xetla-get-location-as-string))))))
- (let* ((elem (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (location (cdr (assoc 'location elem))))
- (xetla-get directory t
- (xetla-name-archive location)
- (xetla-name-category location)
- (xetla-name-branch location)
- (xetla-name-version location))))
-
-(defun xetla-bookmarks-goto ()
- "Browse the archive of the current bookmark."
- (interactive)
- (let* ((elem (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (location (cdr (assoc 'location elem)))
- (archive (xetla-name-archive location))
- (category (xetla-name-category location))
- (branch (xetla-name-branch location))
- (version (xetla-name-version location)))
- (cond (version (xetla-revisions archive category branch version))
- (branch (xetla-versions archive category branch))
- (category (xetla-branches archive category))
- (archive (xetla-categories archive))
- (t (error "Nothing specified for this bookmark")))))
-
-(xetla-make-bymouse-function xetla-bookmarks-goto)
-
-(defun xetla-bookmarks-star-merge (arg)
- "Star-merge the current bookmark to a local tree.
-Accepts prefix argument ARG for future extension."
- (interactive "P")
- (let* ((elem (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (location (cdr (assoc 'location elem)))
- (local-tree (read-directory-name "Star-merge into: ")))
- (xetla-star-merge (xetla-name-construct location)
- local-tree)))
-
-(defun xetla-bookmarks-replay (arg)
- "Replay the current bookmark to some local tree.
-Accepts prefix argument ARG for future extension."
- (interactive "P")
- (let* ((elem (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (location (xetla-name-construct (cdr (assoc 'location elem))))
- (local-tree (read-directory-name
- (format "Replay %s into: " location))))
- (xetla-replay location local-tree)))
-
-(defun xetla-bookmarks-update (arg)
- "Update the local tree of the current bookmark.
-Accepts prefix argument ARG for future extension."
- (interactive "P")
- (let* ((buf (current-buffer))
- (work-list (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))))
- (update-trees
- (mapcar (lambda (bookmark)
- (let ((local-trees (cdr (assoc 'local-tree bookmark))))
- (xetla-uniquify-file-name
- (cond ((null local-trees)
- (read-directory-name
- (format "Local tree for '%s'?: "
- (car bookmark)) nil nil t))
- ((not (null (cdr local-trees)))
- (completing-read
- (format "Local tree for '%s'?: "
- (car bookmark))
- local-trees nil t))
- (t (car local-trees))))))
- work-list)))
- (mapc 'xetla-update update-trees)
- (with-current-buffer buf
- (setq xetla-bookmarks-marked-list '())
- (ewoc-refresh xetla-bookmarks-cookie))))
-
-(defun xetla-bookmarks-add-elem (name info)
- "Add the association (NAME . INFO) to the list of bookmarks, and save it.
-This is an internal function."
- (when (assoc name xetla-bookmarks-alist)
- (error (concat "Already got a bookmark " name)))
- (let ((elem (cons name info)))
- (add-to-list 'xetla-bookmarks-alist elem t)
- (xetla-bookmarks-save-to-file)
- (ewoc-enter-last xetla-bookmarks-cookie elem)
- ))
-
-(defun xetla-bookmarks-add (name revision-spec)
- "Add a bookmark named NAME for REVISION-SPEC."
- (interactive (let* ((fq (xetla-name-read "Version: "
- 'prompt 'prompt 'prompt 'prompt))
- (n (read-string (format "Name of the bookmark for `%s': "
- (xetla-name-construct fq)))))
- (list n fq)))
- (unless (get-buffer "*xetla-bookmarks*")
- (xetla-bookmarks))
- (with-current-buffer "*xetla-bookmarks*"
- (let* ((info (list (cons 'location
- revision-spec)
- (cons 'timestamp (current-time-string)))))
- (xetla-bookmarks-add-elem name info))))
-
-(defun xetla-bookmarks-mark ()
- "Mark the bookmark at point."
- (interactive)
- (let ((pos (point)))
- (add-to-list 'xetla-bookmarks-marked-list
- (ewoc-data (ewoc-locate xetla-bookmarks-cookie)))
- (ewoc-refresh xetla-bookmarks-cookie)
- (goto-char pos))
- (xetla-bookmarks-next))
-
-(defun xetla-bookmarks-unmark ()
- "Unmark the bookmark at point."
- (interactive)
- (let ((pos (point)))
- (setq xetla-bookmarks-marked-list
- (delq (ewoc-data (ewoc-locate xetla-bookmarks-cookie))
- xetla-bookmarks-marked-list))
- (ewoc-refresh xetla-bookmarks-cookie)
- (goto-char pos))
- (xetla-bookmarks-next))
-
-(defun xetla-bookmarks-unmark-all ()
- "Unmark all bookmarks in current buffer."
- (interactive)
- (let ((pos (point)))
- (setq xetla-bookmarks-marked-list nil)
- (ewoc-refresh xetla-bookmarks-cookie)
- (goto-char pos)))
-
-(defun xetla-bookmarks-marked-are-partners ()
- "Make marked bookmarks mutual partners."
- (interactive)
- (let ((list-arch (mapcar
- #'(lambda (x)
- (format "%s"
- (xetla-name-construct
- (cdr (assoc 'location x)))))
- xetla-bookmarks-marked-list)))
- (dolist (book xetla-bookmarks-marked-list)
- (let ((myloc (xetla-name-construct
- (cdr (assoc 'location book)))))
- (message myloc)
- (dolist (arch list-arch)
- (unless (string= myloc arch)
- (xetla-bookmarks-add-partner book arch t))))))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))
-
-(defun xetla-bookmarks-cleanup-local-trees ()
- "Remove LOCAL-TREE field from bookmarks if they don't exist."
- (interactive)
- (dolist (book xetla-bookmarks-alist)
- (let ()
- (dolist (local-tree (cdr (assoc 'local-tree book)))
- (when (and (not (file-exists-p local-tree))
- (or xetla-bookmarks-cleanup-dont-prompt
- (y-or-n-p
- (format
- "Remove tree %s from bookmarks %s? "
- local-tree
- (car book)))))
- (xetla-bookmarks-delete-tree book local-tree t)))))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))
-
-(defun xetla-bookmarks-delete (elem &optional force)
- "Delete the bookmark entry ELEM.
-If FORCE is non-nil, don't ask for confirmation."
- (interactive (list (ewoc-locate xetla-bookmarks-cookie)))
- (let* ((data (ewoc-data elem)))
- (when (or force
- (yes-or-no-p (format "Delete bookmark \"%s\"? " (car data))))
- (xetla-ewoc-delete xetla-bookmarks-cookie elem)
- (let ((list xetla-bookmarks-alist)
- newlist)
- (while list
- (unless (string= (caar list) (car data))
- (setq newlist (cons (car list) newlist)))
- (setq list (cdr list)))
- (setq xetla-bookmarks-alist (reverse newlist)))
- ;; TODO could be optimized
- (xetla-bookmarks-save-to-file)
- )))
-
-(defun xetla-bookmarks-find-bookmark (location)
- "Find the bookmark whose location is LOCATION (a string)."
- (let ((list xetla-bookmarks-alist)
- result)
- (while list
- (when (string= (xetla-name-construct
- (cdr (assoc 'location (cdar list))))
- location)
- (setq result (car list))
- (setq list nil))
- (setq list (cdr list)))
- result))
-
-(defun xetla-bookmarks-get-field (version field default)
- "Return VERSION'S value of FIELD, or DEFAULT if there is no value."
- (xetla-bookmarks-load-from-file)
- (block dolist
- (dolist (elem xetla-bookmarks-alist)
- (let ((location (cdr (assoc 'location elem))))
- (when (and (string= (xetla-name-archive location)
- (xetla-name-archive version))
- (string= (xetla-name-category location)
- (xetla-name-category version))
- (string= (xetla-name-branch location)
- (xetla-name-branch version))
- (string= (xetla-name-version location)
- (xetla-name-version version)))
- (return-from dolist (or (cadr (assoc field (cdr elem))) default)))))
- default))
-
-(defmacro xetla-bookmarks-make-add-fn (name field message-already message-add)
- "Define a function called NAME for adding FIELD to a bookmark entry.
-This function will display MESSAGE-ALREADY if the user tries to add a field
-twice, and will display MESSAGE-ADD when a new field is successfully added."
- `(defun ,name (bookmark value &optional dont-save)
- "Adds the directory VALUE to the list of local trees of bookmark
-BOOKMARK."
- (let ((local-trees (assoc ,field (cdr bookmark))))
- (if local-trees
- (if (member value (cdr local-trees))
- (message ,message-already)
- (progn
- (message ,message-add)
- (setcdr local-trees (cons value
- (cdr local-trees)))))
- (progn
- (message ,message-add)
- (setcdr bookmark (cons (list ,field value)
- (cdr bookmark)))))
- (unless dont-save
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))))
- )
-
-(xetla-bookmarks-make-add-fn xetla-bookmarks-add-tree
- 'local-tree
- "Local tree already in the list"
- "Local tree added to your bookmarks")
-
-(xetla-bookmarks-make-add-fn xetla-bookmarks-add-partner
- 'partners
- "Partner already in the list"
- "Partner added to your bookmarks")
-
-(xetla-bookmarks-make-add-fn xetla-bookmarks-add-group
- 'groups
- "Group already in the list"
- "Group added to your bookmarks")
-
-(xetla-bookmarks-make-add-fn xetla-bookmarks-add-nickname
- 'nickname
- "Nickname already in the list"
- "Nickname added to your bookmark")
-
-(defmacro xetla-bookmarks-make-delete-fn (name field)
- "Define a function called NAME for removing FIELD from bookmark entries."
- `(defun ,name (bookmark value &optional dont-save)
- "Deletes the directory VALUE to the list of local trees of bookmark
-BOOKMARK."
- (let ((local-trees (assoc ,field (cdr bookmark))))
- (when local-trees
- (let ((rem-list (delete value (cdr (assoc ,field
- bookmark)))))
- (if rem-list
- (setcdr local-trees rem-list)
- ;; Remove the whole ('field ...)
- (setcdr bookmark (delq local-trees (cdr bookmark))))))
- (unless dont-save
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))))
- )
-
-(xetla-bookmarks-make-delete-fn xetla-bookmarks-delete-tree
- 'local-tree)
-
-(xetla-bookmarks-make-delete-fn xetla-bookmarks-delete-partner
- 'partners)
-
-(xetla-bookmarks-make-delete-fn xetla-bookmarks-delete-group
- 'groups)
-
-(xetla-bookmarks-make-delete-fn xetla-bookmarks-delete-nickname
- 'nickname)
-
-(defun xetla-bookmarks-add-partner-interactive ()
- "Add a partner to the current or marked bookmarks."
- (interactive)
- (let ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (partner (xetla-name-construct
- (xetla-name-read "Version: "
- 'prompt 'prompt 'prompt 'prompt))))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-add-partner bookmark partner t))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-add-partners-from-file ()
- "Add a partner to the current or marked bookmarks."
- (interactive)
- (let ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie))))))
- (dolist (bookmark bookmarks)
- (let ((partners (xetla-partner-list
- (xetla-bookmarks-read-local-tree bookmark))))
- (dolist (partner partners)
- (xetla-bookmarks-add-partner bookmark partner t))))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-write-partners-to-file ()
- "Add the partners recorded in the bookmarks to the partner file."
- (interactive)
- (let ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie))))))
- (dolist (bookmark bookmarks)
- (let* ((local-tree (xetla-bookmarks-read-local-tree bookmark))
- (partners (xetla-partner-list local-tree)))
- (with-current-buffer
- (xetla-partner-find-partner-file local-tree)
- (dolist (partner (cdr (assoc 'partners (cdr bookmark))))
- (unless (member partner partners)
- (insert partner "\n")))
- (and (buffer-modified-p)
- (progn (switch-to-buffer (current-buffer))
- (y-or-n-p (format "Save file %s? "
- (buffer-file-name))))
- (save-buffer)))))))
-
-
-(defun xetla-bookmarks-delete-partner-interactive ()
- "Delete a partner from the current or marked bookmarks."
- (interactive)
- (let* ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (choices (apply 'append
- (mapcar #'(lambda (x)
- (cdr (assoc 'partners
- (cdr x))))
- bookmarks)))
- (choices-alist (mapcar #'(lambda (x) (list x)) choices))
- (partner (completing-read "Partner to remove: " choices-alist)))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-delete-partner bookmark partner t))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-add-tree-interactive ()
- "Add a local tree to the current or marked bookmarks."
- (interactive)
- (let ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (local-tree (read-directory-name "Local tree to add: ")))
- (unless (file-exists-p (concat (file-name-as-directory local-tree) "{arch}"))
- (error (concat local-tree " is not an arch local tree.")))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-add-tree bookmark local-tree t))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-delete-tree-interactive ()
- "Add a local tree to the current or marked bookmarks."
- (interactive)
- (let* ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (choices (apply 'append
- (mapcar #'(lambda (x)
- (cdr (assoc 'local-tree
- (cdr x))))
- bookmarks)))
- (choices-alist (mapcar #'(lambda (x) (list x)) choices))
- (local-tree (completing-read "Local tree to remove: " choices-alist)))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-delete-tree bookmark local-tree t))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-list-groups ()
- "Return the list of groups currently used by bookmarks."
- (let ((list (apply 'append
- (mapcar #'(lambda (x)
- (cdr (assoc 'groups
- (cdr x))))
- xetla-bookmarks-alist)))
- result)
- ;; Make elements unique
- (dolist (elem list)
- (add-to-list 'result elem))
- result))
-
-(defun xetla-bookmarks-add-group-interactive ()
- "Add a group entry in the current or marked bookmarks."
- (interactive)
- (let* ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (group (completing-read "Group of bookmarks: "
- (mapcar #'(lambda (x) (list x))
- (xetla-bookmarks-list-groups)))))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-add-group bookmark group t)))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))
-
-
-(defun xetla-bookmarks-delete-group-interactive ()
- "Delete a group of bookmark entry from the current or marked bookmarks."
- (interactive)
- (let* ((bookmarks (or xetla-bookmarks-marked-list
- (list (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))))
- (choices (apply 'append
- (mapcar #'(lambda (x)
- (cdr (assoc 'groups
- (cdr x))))
- bookmarks)))
- (choices-alist (mapcar #'(lambda (x) (list x)) choices))
- (group (completing-read "Group to remove: " choices-alist)))
- (dolist (bookmark bookmarks)
- (xetla-bookmarks-delete-group bookmark group t)))
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks)))
-
-(defun xetla-bookmarks-select-by-group (group)
- "Select all bookmarks in GROUP."
- (interactive (list (completing-read "Group to select: "
- (mapcar #'(lambda (x) (list x))
- (xetla-bookmarks-list-groups)))))
- (dolist (bookmark xetla-bookmarks-alist)
- (when (member group (cdr (assoc 'groups bookmark)))
- (add-to-list 'xetla-bookmarks-marked-list bookmark))
- )
- (ewoc-refresh xetla-bookmarks-cookie))
-
-(defun xetla-bookmarks-add-nickname-interactive ()
- "Add a nickname to the current bookmark."
- (interactive)
- (let* ((bookmark (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))
- (prompt (format "Nickname for %s: " (xetla-name-construct
- (cdr (assoc 'location bookmark))))))
- (xetla-bookmarks-add-nickname bookmark (read-string prompt) t)
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defun xetla-bookmarks-delete-nickname-interactive ()
- "Delete the nickname of the current bookmark."
- (interactive)
- (let* ((bookmark (ewoc-data (ewoc-locate
- xetla-bookmarks-cookie)))
- (nickname (cadr (assoc 'nickname bookmark))))
- (xetla-bookmarks-delete-nickname bookmark nickname t)
- (xetla-bookmarks-save-to-file)
- (save-window-excursion
- (xetla-bookmarks))))
-
-(defvar xetla-buffer-bookmark nil
- "The bookmark manipulated in the current buffer.")
-
-(defun xetla-bookmarks-edit ()
- "Edit the bookmark at point."
- (interactive)
- (let* ((elem (ewoc-locate xetla-bookmarks-cookie))
- (data (ewoc-data elem)))
- (pop-to-buffer (concat "*xetla bookmark " (car data) "*"))
- (erase-buffer)
- (emacs-lisp-mode)
- (make-local-variable 'xetla-buffer-bookmark)
- (setq xetla-buffer-bookmark elem)
- (insert ";; Edit the current bookmark. C-c C-c to finish\n\n")
- (pp data (current-buffer))
- (goto-char (point-min)) (forward-line 2) (forward-char 2)
- (local-set-key [(control ?c) (control ?c)]
- #'(lambda () (interactive)
- (goto-char (point-min))
- (let* ((newval (read (current-buffer)))
- (elem xetla-buffer-bookmark)
- (oldname (car (ewoc-data elem))))
- (kill-buffer (current-buffer))
- (pop-to-buffer "*xetla-bookmarks*")
- (setcar (ewoc-data elem) (car newval))
- (setcdr (ewoc-data elem) (cdr newval))
- (let ((list xetla-bookmarks-alist)
- newlist)
- (while list
- (if (string= (caar list) oldname)
- (setq newlist (cons newval newlist))
- (setq newlist (cons (car list) newlist)))
- (setq list (cdr list)))
- (setq xetla-bookmarks-alist (reverse newlist)))
- (xetla-bookmarks-save-to-file)
- (save-excursion (xetla-bookmarks))
- )))))
-
-(defun xetla-bookmarks-get-partner-versions (version)
- "Return version lists of partners in bookmarks for VERSION.
-Each version in the returned list has a list form.
-If no partner, return nil.
-VERSION is a fully qualified version string or a list."
- (xetla-bookmarks-load-from-file)
- (when (consp version)
- (setq version (xetla-name-mask version t
- t t t t)))
- (let* ((bookmark (xetla-bookmarks-find-bookmark version))
- (groups (cdr (assoc 'groups bookmark)))
- (partners (delete nil (mapcar
- (lambda (b)
- (when (intersection groups (cdr (assoc 'groups b)) :test 'string=)
- (cdr (assoc 'location b))
- ))
- xetla-bookmarks-alist))))
- partners))
-
-;;
-;; Archives
-;;
-;;;###autoload
-(defun xetla-archives ()
- "Start the archive browser."
- (interactive)
- (xetla-archive-tree-build-archives)
- (xetla-switch-to-buffer "*xetla-archives*")
- (let ((a-list xetla-archive-tree)
- (my-default-archive (xetla-my-default-archive))
- defaultp
- archive-name
- archive-location
- p)
- (toggle-read-only -1)
- (erase-buffer)
- (while a-list
- (setq archive-name (caar a-list)
- archive-location (cadar a-list)
- a-list (cdr a-list)
- defaultp (string= archive-name my-default-archive))
- (if defaultp (setq p (point)))
- (xetla-archives-insert-item archive-name archive-location defaultp))
- (if (> (point) (point-min))
- (delete-backward-char 1))
- (when p (goto-char p))
- (xetla-archive-list-mode)))
-
-(defun xetla-archives-insert-item (archive location defaultp)
- "Add an entry for ARCHIVE at LOCATION to the archive list.
-If DEFAULTP is non-nil, this item will be rendered as the default archive."
- (let ((start-pos (point))
- extent)
- (insert (if defaultp xetla-mark " ")
- " "
- (xetla-face-add-with-condition
- defaultp
- archive 'xetla-marked 'xetla-archive-name))
- (newline)
- (insert " " location)
- (newline)
- (setq extent (make-extent start-pos (point)))
- (set-extent-property extent 'category 'xetla-default-button)
- (set-extent-property extent 'keymap xetla-archive-archive-map)
- (set-extent-property extent 'xetla-archive-info archive)))
-
-(defun xetla-archives-goto-archive-by-name (name)
- "Jump to the archive named NAME."
- (unless (string= (buffer-name) "*xetla-archives*")
- (error "`xetla-archives-goto-archive-by-name' can only be called in *xetla-archives* buffer"))
- (goto-char (point-min))
- (search-forward name)
- (beginning-of-line))
-
-(defun xetla-get-archive-info (&optional property)
- "Get some PROPERTY of the archive at point in an archive list buffer."
- (unless property
- (setq property 'xetla-archive-info))
- (let ((extent (car (extents-at (point)))))
- (when extent
- (extent-property extent property))))
-
-(defun xetla-my-default-archive (&optional new-default)
- "Set or get the default archive.
-When called with a prefix argument NEW-DEFAULT: Ask the user for the new
-default archive.
-If NEW-DEFAULT IS A STRING: Set the default archive to this string.
-When called with no argument: return the name of the default argument.
-When called interactively, with no argument: Show the name of the default archive."
- (interactive "P")
- (when (or (numberp new-default) (and (listp new-default) (> (length new-default) 0)))
- (setq new-default (car (xetla-name-read nil 'prompt))))
- (cond ((stringp new-default)
- (message "Setting arch default archive to: %s" new-default)
- (xetla-run-tla-sync (list "my-default-archive" new-default)
- :finished 'xetla-null-handler))
- (t
- (xetla-run-tla-sync '("my-default-archive")
- :finished
- `(lambda (output error status arguments)
- (let ((result (xetla-buffer-content output)))
- (when ,(interactive-p)
- (message "Default arch archive: %s"
- result))
- result))
- :error
- `(lambda (output error status arguments)
- (if (eq status 1)
- (if ,(interactive-p)
- (message "default archive not set")
- "")
- (xetla-default-error-function
- output error status arguments)))))))
-
-(defun xetla-whereis-archive (&optional archive)
- "Call xetla whereis-archive on ARCHIVE."
- (interactive "P")
- (let (location)
- (unless archive
- (setq archive (xetla-name-mask (xetla-name-read "Archive: " 'prompt)
- t
- :archive)))
- (setq location
- (xetla-run-tla-sync (list "whereis-archive" archive)
- :finished
- (lambda (output error status arguments)
- (xetla-buffer-content output))))
- (when (interactive-p)
- (message "archive location for %s: %s" archive location))
- location))
-
-(defun xetla-read-location (prompt)
- "Read the location for an archive operation, prompting with PROMPT.
-The following forms are supported:
-* local path: e.g.: ~/archive2004
-* ftp path: e.g.: ftp://user:passwd@host.name.com/remote-path
-* sftp path: e.g.: sftp://user:passwd@host.name.com/remote-path
-* HTTP/WebDAV path: e.g.: http://user:passwd@host.name.com/remote-path"
- (read-string prompt (ffap-url-at-point)))
-
-(defun xetla-register-archive ()
- "Call `xetla-register-archive-internal' interactively and `xetla-archives' on success."
- (interactive)
- (let* ((result (call-interactively 'xetla-register-archive-internal))
- (archive-registered (nth 0 result))
- (archive (nth 1 result))
- (xetla-response (nth 3 result)))
- (when archive-registered
- (xetla-archives)
- (xetla-archives-goto-archive-by-name
- (progn
- (message xetla-response) ; inform the user about the response from xetla
- (if (string-match ".+: \\(.+\\)" xetla-response)
- (match-string 1 xetla-response)
- archive)))
- (xetla-flash-line))))
-
-(defun xetla-register-archive-internal (location &optional archive)
- "Register arch archive.
-LOCATION should be either a local directory or a remote path.
-When ffap is available the url at point is suggested for LOCATION.
-ARCHIVE is the name is archive. If ARCHIVE is not given or an empty string,
-the default name is used.
-The return value is a list.
-- The first element shows whether the archive is registered or not; t means that
- it is registered, already means that the archive was already
- registered, and nil means that it is not registered.
-- The second element shows archive name.
-- The third element shows archive location.
-- The fourth element is the command output string."
- (interactive (list (xetla-read-location "Location: ")
- (read-string "Archive (empty for default): ")))
- (if (and archive (eq 0 (length archive)))
- (setq archive nil))
- (let ((archive-registered nil)
- (xetla-response nil))
- (xetla-run-tla-sync (list "register-archive" archive location)
- :finished
- (lambda (output error status arguments)
- (setq xetla-response (xetla-get-process-output))
- (setq archive-registered t)
- (message "Registered archive %s (=> %s)" archive location))
- :error
- (lambda (output error status arguments)
- (setq xetla-response (xetla-get-error-output))
- (when (eq status 2) ;; already registered
- (setq archive-registered 'already))))
- (list archive-registered archive location xetla-response)))
-
-(defun xetla-unregister-archive (archive ask-for-confirmation)
- "Delete the registration of ARCHIVE.
-When ASK-FOR-CONFIRMATION is non nil, ask the user for confirmation."
- (unless (xetla-archive-tree-get-archive archive)
- (xetla-archive-tree-build-archives))
- (let ((location (cadr (xetla-archive-tree-get-archive archive))))
- (when (or (not ask-for-confirmation)
- (yes-or-no-p (format "Delete the registration of %s(=> %s)? " archive location)))
- (xetla-run-tla-sync
- (list "register-archive" "--delete" archive)
- :finished
- (lambda (output error status arguments)
- (message "Deleted the registration of %s (=> %s)" archive location))))))
-
-(defun xetla-edit-archive-location (archive)
- "Edit the location of ARCHIVE."
- (let* ((old-location (xetla-whereis-archive archive))
- (new-location (read-string (format "New location for %s: " archive) old-location)))
- (unless (string= old-location new-location)
- (xetla-unregister-archive archive nil)
- (xetla-register-archive-internal new-location archive))))
-
-;;;###autoload
-(defun xetla-make-archive ()
- "Call `xetla-make-archive-internal' interactively then call `xetla-archives'."
- (interactive)
- (call-interactively 'xetla-make-archive-internal)
- (xetla-archives))
-
-(defun xetla-make-archive-internal (name location &optional signed listing)
- "Create a new arch archive.
-NAME is the global name for the archive. It must be an
-email address with a fully qualified domain name, optionally
-followed by \"--\" and a string of letters, digits, periods
-and dashes.
-LOCATION specifies the path, where the archive should be created.
-
-Examples for name are:
-foo.bar@flups.com--public
-foo.bar@flups.com--public-2004
-
-If SIGNED is non-nil, the archive will be created with -signed.
-If LISTING is non-nil, the archive will be created with -listing
- (Usefull for http mirrors)."
- (interactive
- (list (read-string "Archive name: ")
- (let ((path-ok nil)
- location)
- (while (not path-ok)
- (setq location (xetla-read-location "Location: "))
- (setq path-ok t)
- (when (eq 'local (xetla-location-type location))
- (setq location (expand-file-name location))
- (when (file-directory-p location)
- (message "directory already exists: %s" location)
- (setq path-ok nil)
- (sit-for 1))
- (when (not (file-directory-p
- (file-name-directory location)))
- (message "parent directory doesn't exists for %s"
- location)
- (setq path-ok nil)
- (sit-for 1))))
- location)
- (y-or-n-p "Sign the archive? ")
- (y-or-n-p "Create .listing files? ")))
- (xetla-run-tla-sync (list "make-archive"
- (when listing "--listing")
- (when signed "--signed")
- name location)
- :error
- (lambda (output error status arguments)
- (xetla-show-error-buffer error)
- (xetla-show-last-process-buffer)
- (error (format "xetla failed: exits-status=%s"
- status)))))
-
-(defun xetla-mirror-archive (&optional archive location mirror signed
- listing)
- "Create a mirror for ARCHIVE, at location LOCATION, named MIRROR.
-If SIGNED is non-nil, the archive will be signed.
-If LISTING is non-nil, .listing files will be created (useful for HTTP
-mirrors)."
- (interactive)
- (let* ((archive (or archive (car (xetla-name-read "Archive to mirror: " 'prompt))))
- (location (or location (xetla-read-location
- (format "Location of the mirror for %s: " archive))))
- ;;todo: take a look ath the mirror-list, when suggesting a mirror name
- ;;(mirror-list (xetla-get-mirrors-for-archive archive))
- (mirror (or mirror (read-string "Name of the mirror: "
- (concat archive
- "-MIRROR"))))
- (signed (or signed (y-or-n-p "Sign mirror? ")))
- (listing (or listing (y-or-n-p "Create .listing files? "))))
- (xetla-run-tla-sync (list "make-archive"
- (when listing "--listing")
- (when signed "--signed")
- "--mirror"
- archive mirror location))))
-
-(defun xetla-mirror-from-archive (&optional from-archive location)
- "Create a mirror-from archive for FROM-ARCHIVE, at location LOCATION.
-The archive name FROM-ARCHIVE must end with \"-SOURCE\"."
- (interactive)
- (let* ((from-archive (or from-archive
- (car (xetla-name-read "Mirror from archive: " 'prompt))))
- (location (or location (read-string
- (format "Location of the mirror for %s : " from-archive)))))
- (unless (eq (xetla-archive-type from-archive) 'source)
- (error "%s is not SOURCE archive" from-archive))
- (xetla-run-tla-sync (list "make-archive"
- "--mirror-from"
- from-archive location))))
-
-(defun xetla-get-mirrors-for-archive (archive)
- "Get a list of all mirrors for the given ARCHIVE."
- (xetla-archive-tree-build-archives)
- (delete nil (mapcar '(lambda (elem)
- (let ((a-name (car elem)))
- (when (and (eq (xetla-archive-type a-name) 'mirror)
- (string= archive
- (substring a-name 0 (length archive))))
- a-name)))
- xetla-archive-tree)))
-
-;; in xetla-browse use: (xetla-name-archive (xetla-widget-node-get-name))
-;; to get the name of an archive.
-;; in xetla-archives: use (xetla-get-archive-info)
-
-;; (xetla-get-mirrors-for-archive (xetla-get-archive-info))
-;; (xetla-get-mirrors-for-archive "xsteve@nit.at-public")
-
-(defun xetla-mirror-base-name (archive)
- "Return the base name of the mirror ARCHIVE."
- (when (eq (xetla-archive-type archive) 'mirror)
- (substring archive 0 (string-match "-MIRROR.*$" archive))))
-
-(defun xetla-use-as-default-mirror (archive)
- "Use the ARCHIVE as default mirror.
-This function checks, if ARCHIVE is a mirror (contains -MIRROR).
-The default mirror ends with -MIRROR. Other mirrors have some
-other characters after -MIRROR (e.g.: -MIRROR-2.
-This function swaps the location of that -MIRROR and the -MIRROR-2.
-The effect of the swapping is, that the mirroring functions work
-per default on the default mirror."
- (interactive (list (xetla-name-archive (xetla-name-read "Mirror archive name: " 'prompt))))
- (unless (eq (xetla-archive-type archive) 'mirror)
- (error "%s is not a mirror" archive))
- (if (string-match "-MIRROR$" archive)
- (message "%s is already the default mirror." archive)
- (let* ((archive-base-name (xetla-mirror-base-name archive))
- (mirror-list (xetla-get-mirrors-for-archive archive-base-name))
- (default-mirror (concat archive-base-name "-MIRROR"))
- (default-mirror-present (member default-mirror mirror-list))
- (archive-location (xetla-whereis-archive archive))
- (default-mirror-location (and default-mirror-present
- (xetla-whereis-archive default-mirror))))
- (if default-mirror-present
- (message "swapping mirrors %s <-> %s." archive default-mirror)
- (message "using %s as default mirror." archive))
- (xetla-unregister-archive archive nil)
- (when default-mirror-present
- (xetla-unregister-archive default-mirror nil))
- (xetla-register-archive-internal archive-location default-mirror)
- (when default-mirror-present
- (xetla-register-archive-internal default-mirror-location archive)))))
-
-
-(defun xetla-archive-convert-to-source-archive (archive &optional location)
- "Change the name of ARCHIVE to ARCHIVE-SOURCE.
-Sets the archive location to LOCATION."
- (unless location
- (setq location (nth 1 (xetla-archive-tree-get-archive archive))))
- (unless location
- (error "Location for `%s' is unknown" archive))
- (when (eq 'source (xetla-archive-type archive))
- (error "%s is already source" archive))
-; (unless (eq 'http (xetla-location-type location))
-; (error "Read only archive is supported in xetla: " location))
- (xetla-unregister-archive archive nil)
- (xetla-register-archive-internal location (concat archive "-SOURCE")))
-
-;;
-;; Categories
-;;
-(defun xetla-categories (archive)
- "List the categories of ARCHIVE."
- (interactive (list (xetla-name-archive
- (xetla-name-read nil 'prompt))))
- (unless archive
- (setq archive (xetla-my-default-archive)))
- (xetla-archive-tree-build-categories archive)
- (xetla-switch-to-buffer "*xetla-categories*")
- (let ((list (cddr (xetla-archive-tree-get-archive archive)))
- category start-pos extent)
- (toggle-read-only -1)
- (erase-buffer)
- ;; TODO: button to invoke xetla-archives.
- (insert (format "Archive: %s\n%s\n" archive
- (make-string (+ (length archive)
- (length "Archive: ")) ?=)))
- (save-excursion
- (while list
- (setq category (car (car list))
- start-pos (point)
- list (cdr list))
- (insert " " (xetla-face-add category 'xetla-category-name))
- (newline)
- (setq extent (make-extent start-pos (point)))
- (set-extent-property extent 'category 'xetla-default-button)
- (set-extent-property extent 'keymap xetla-category-category-map)
- (set-extent-property extent 'xetla-category-info category)
- )
- (delete-backward-char 1)))
- (xetla-category-list-mode)
- (set (make-local-variable 'xetla-buffer-archive-name)
- archive))
-
-(defun xetla-make-category (archive category)
- "In ARCHIVE, create CATEGORY."
- (interactive (let ((l (xetla-name-read "New Category: " 'prompt 'prompt)))
- (list (xetla-name-archive l)
- (xetla-name-category l))))
- (xetla-run-tla-sync (list "make-category" "-A" archive category))
- (let ((xetla-buffer-archive-name archive))
- (run-hooks 'xetla-make-category-hook)))
-
-;;
-;; Branches
-;;
-(defun xetla-branches (archive category)
- "Display the branches of ARCHIVE/CATEGORY."
- (interactive (let ((l (xetla-name-read nil 'prompt 'prompt)))
- (list (xetla-name-archive l)
- (xetla-name-category l))))
- (xetla-archive-tree-build-branches archive category)
- (xetla-switch-to-buffer "*xetla-branches*")
- (let ((list (cdr (xetla-archive-tree-get-category archive category)))
- alength
- clength
- branch
- start-pos
- extent)
- (toggle-read-only -1)
- (erase-buffer)
- ;; TODO: button to invoke xetla-categories and xetla-archives
- (setq alength (+ (length archive) (length "Archive: "))
- clength (+ (length category) (length "Category: ")))
- (insert (format "Archive: %s\nCategory: %s\n%s\n" archive category
- (make-string (max alength clength) ?=)))
- (save-excursion
- (while list
- (setq branch (car (car list))
- start-pos (point)
- list (cdr list))
- (insert " " (xetla-face-add (if (string= branch "")
- "<empty>" branch)
- 'xetla-branch-name))
- (newline)
- (setq extent (make-extent start-pos (point)))
- (set-extent-property extent 'category 'xetla-default-button)
- (set-extent-property extent 'keymap xetla-branch-branch-map)
- (set-extent-property extent 'xetla-branch-info branch))
- (delete-backward-char 1)))
- (xetla-branch-list-mode)
- (set (make-local-variable 'xetla-buffer-archive-name)
- archive)
- (set (make-local-variable 'xetla-buffer-category-name)
- category))
-
-(defun xetla-make-branch (archive category branch)
- "Make a new branch in ARCHIVE/CATEGORY called BRANCH."
- (interactive (let ((l (xetla-name-read "New Branch: "
- 'prompt 'prompt 'prompt)))
- (list (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l))))
- (xetla-run-tla-sync (list "make-branch"
- (xetla-name-construct
- archive category branch)))
- (let ((xetla-buffer-archive-name archive)
- (xetla-buffer-category-name category))
- (run-hooks 'xetla-make-branch-hook)))
-
-;;
-;; Versions
-;;
-(defun xetla-versions (archive category branch)
- "Display the versions of ARCHIVE/CATEGORY in BRANCH."
- (interactive (let ((l (xetla-name-read nil
- 'prompt 'prompt 'prompt)))
- (list (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l))))
- (xetla-archive-tree-build-versions archive category branch)
- (xetla-switch-to-buffer "*xetla-versions*")
- (let ((list (cdr (xetla-archive-tree-get-branch
- archive category branch)))
- alength
- clength
- blength
- version
- start-pos
- extent)
- (toggle-read-only -1)
- (erase-buffer)
- ;; TODO: button to invoke xetla-categories and xetla-archives
- (setq alength (+ (length archive) (length "Archive: "))
- clength (+ (length category) (length "Category: "))
- blength (+ (length branch) (length "Branch: ")))
- (insert (format "Archive: %s\nCategory: %s\nBranch: %s\n%s\n"
- archive category branch
- (make-string (max alength clength blength) ?=)))
- (save-excursion
- (while list
- (setq version (car (car list))
- start-pos (point)
- list (cdr list))
- (insert " " (xetla-face-add version 'xetla-version-name))
- (newline)
- (setq extent (make-extent start-pos (point)))
- (set-extent-property extent 'category 'xetla-default-button)
- (set-extent-property extent 'keymap xetla-version-version-map)
- (set-extent-property extent 'xetla-version-info version))
- (delete-backward-char 1)))
- (xetla-version-list-mode)
- (set (make-local-variable 'xetla-buffer-archive-name) archive)
- (set (make-local-variable 'xetla-buffer-category-name) category)
- (set (make-local-variable 'xetla-buffer-branch-name) branch))
-
-(defun xetla-make-version (archive category branch version)
- "In ARCHIVE/CATEGORY, add a version to BRANCH called VERSION."
- (interactive (let ((l (xetla-name-read "Version: "
- 'prompt 'prompt 'prompt 'prompt)))
- (list (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l)
- (xetla-name-version l))))
-
- (xetla-run-tla-sync (list "make-version"
- (xetla-name-construct
- archive category branch version)))
- (let ((xetla-buffer-archive-name archive)
- (xetla-buffer-category-name category)
- (xetla-buffer-branch-name branch))
- (run-hooks 'xetla-make-version-hook)))
-
-;;
-;; Revisions
-;;
-
-;; elem should be
-;; ('separator "string" kind)
-;; or
-;; ('entry-patch nil revision) Where "revision" is of xetla-revision
-;; struct type.
-;; ('entry-change "changes")
-;; The second element tells if the element is marked or not.
-(defun xetla-revision-list-printer (elem)
- "Print an element ELEM of the revision list."
- (let ()
- (case (car elem)
- (entry-patch
- (let* ((struct (caddr elem))
- (merged-by (xetla-revision-merged-by struct))
- (unmerged (eq merged-by 'nobody)))
- (insert (if (cadr elem) (concat " " xetla-mark) " ")
- ;; The revision is in library?
- (if (and xetla-revisions-shows-library
- (apply 'xetla-revlib-tree-get-revision
- (xetla-revision-revision struct)))
- ;;
- ;; (apply 'xetla-library-find
- ;; (append (caddr elem) '(t))
-
- "L " " ")
- (xetla-face-add (xetla-name-construct
- (xetla-revision-revision struct))
- (if unmerged 'xetla-unmerged
- 'xetla-revision-name)
- 'xetla-revision-revision-map
- xetla-revision-revision-menu)
- (if unmerged (xetla-face-add " [NOT MERGED]"
- 'xetla-unmerged)
- ""))
- (let ((summary (xetla-revision-summary struct))
- (creator (xetla-revision-creator struct))
- (date (xetla-revision-date struct)))
- (when (and summary xetla-revisions-shows-summary)
- (insert "\n " summary))
- (when (and creator xetla-revisions-shows-creator)
- (insert "\n " creator))
- (when (and date xetla-revisions-shows-date)
- (insert "\n " date)))
- (when (and xetla-revisions-shows-merges
- (xetla-revision-merges struct)
- (not (null (car (xetla-revision-merges struct)))))
- (insert "\n Merges:")
- (dolist (elem (xetla-revision-merges struct))
- (insert "\n " elem)))
- (when xetla-revisions-shows-merged-by
- (cond ((null merged-by) nil)
- ((listp merged-by)
- (insert "\n Merged-by:")
- (dolist (elem merged-by)
- (insert "\n " elem)))))))
- (entry-change (insert (cadr elem)))
- (message (insert (xetla-face-add (cadr elem)
- 'xetla-messages)))
- (separator
- (case (caddr elem)
- (partner (insert "\n" (xetla-face-add (cadr elem)
- 'xetla-separator)))
- (bookmark (insert "\n" (xetla-face-add
- (concat "*** "
- (cadr elem)
- " ***")
- 'xetla-separator) "\n")))))))
-
-(defun xetla-get-current-revision (&optional directory)
- "Return the current revision in DIRECTORY."
- (interactive)
- (let* ((directory (or directory
- (xetla-read-project-tree-maybe
- "Get current revision in: ")))
- (revision (shell-command-to-string
- (concat "tla revisions --full "
- (xetla-tree-version directory)
- "|tail -n1"))))
- (if (interactive-p)
- (message revision)
- revision)))
-
-(defun xetla-tree-revisions ()
- "Call `xetla-revisions' in the current tree."
- (interactive)
- (let* ((default-directory (xetla-read-project-tree-maybe
- "Run tla revisions in: "))
- (version (xetla-tree-version-list)))
- (unless version
- (error "Not in a project tree"))
- (apply 'xetla-revisions version)))
-
-;;;###autoload
-(defun xetla-revisions (archive category branch version
- &optional update-display from-revlib)
- "List the revisions of ARCHIVE/CATEGORY-BRANCH-VERSION."
- (interactive (let ((l (xetla-name-read "Version: " 'prompt 'prompt 'prompt 'prompt)))
- (list
- (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l)
- (xetla-name-version l))))
- ;; TODO: Consdider the case where (and update-display from-revlib) is t.
- (unless (and update-display
- (or (xetla-revisions-tree-contains-details
- archive category branch version)
- (not (or xetla-revisions-shows-summary
- xetla-revisions-shows-creator
- xetla-revisions-shows-date))))
- (if from-revlib
- (xetla-revlib-tree-build-revisions archive category branch version)
- (xetla-archive-tree-build-revisions archive category branch version)))
- (xetla-switch-to-buffer "*xetla-revisions*")
- (let ((list (cdr (if from-revlib
- (xetla-revlib-tree-get-version
- archive category branch version)
- (xetla-archive-tree-get-version
- archive category branch version))))
- first
- separator
- revision
- summary
- creator
- date)
- (xetla-revision-list-mode)
- (toggle-read-only -1)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-revision-refresh)
- (setq separator (xetla-face-add
- (make-string
- (max (+ (length archive) (length "Archive: "))
- (+ (length category) (length "Category: "))
- (+ (length branch) (length "Branch: "))
- (+ (length version) (length "Version: ")))
- ?\ )
- 'xetla-separator))
- (ewoc-set-hf xetla-revision-list-cookie
- (xetla-revisions-header archive category branch version
- from-revlib separator)
- (concat "\n" separator))
- (if xetla-revisions-shows-library
- (xetla-revlib-tree-build-revisions
- archive category branch version nil t))
- (while list
- (setq revision (car (car list))
- summary (car (cdr (car list)))
- creator (car (cddr (car list)))
- date (car (cdddr (car list)))
- list (cdr list))
- (ewoc-enter-last xetla-revision-list-cookie
- (list 'entry-patch nil
- (make-xetla-revision
- :revision (list archive
- category
- branch
- version
- revision)
- :summary summary
- :creator creator
- :date date)))
- (if first
- (goto-char first)
- (goto-char (point-min))
- (re-search-forward "^$")
- (forward-line 1)
- (setq first (point)))
- (sit-for 0)))
-
- (set (make-local-variable 'xetla-buffer-archive-name) archive)
- (set (make-local-variable 'xetla-buffer-category-name) category)
- (set (make-local-variable 'xetla-buffer-branch-name) branch)
- (set (make-local-variable 'xetla-buffer-version-name) version)
- (toggle-read-only t))
-
-(defun xetla-revisions-header (archive category branch version from-revlib separator)
- "Construct a header for the revision ARCHIVE/CATEGORY-BRANCH-VERSION.
-Mark the revision as contained in FROM-REVLIB and use SEPARATOR to separate
-the entries."
- (concat
- "Version: "
- (xetla-face-add archive 'xetla-archive-name) "/"
- (xetla-face-add category 'xetla-category-name) "--"
- (xetla-face-add branch 'xetla-branch-name) "--"
- (xetla-face-add version 'xetla-version-name) "\n"
- "In Revision Library: " (xetla-face-add (if from-revlib "Yes" "No") 'bold)
- "\n"
- separator "\n"))
-
-
-;;;###autoload
-(defun xetla-missing (local-tree location)
- "Search in directory LOCAL-TREE for missing patches from LOCATION.
-If the current buffers default directory is in an arch managed tree use that
-one unless called with a prefix arg. In all other cases prompt for the local
-tree and the location."
- (interactive (let ((dir
- (or (if (not current-prefix-arg)
- (xetla-tree-root nil t))
- (expand-file-name
- (read-directory-name
- "Search missing patches in directory: "
- default-directory default-directory t nil)))))
- (list dir
- (let ((default-directory dir))
- (if current-prefix-arg
- (xetla-name-read
- "From location: "
- 'prompt 'prompt 'prompt 'prompt)
- (xetla-tree-version))))))
- (let ((dir (xetla-tree-root)))
- (pop-to-buffer (xetla-get-buffer-create 'missing))
- (cd dir))
- (xetla-revision-list-mode)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-missing-refresh)
- (set (make-local-variable 'xetla-missing-buffer-todolist)
- `((missing ,local-tree ,(xetla-name-construct location) nil)))
- (xetla-missing-refresh))
-
-
-;;
-;; Rbrowse interface
-;;
-(defun xetla-browse-archive (archive)
- "Browse ARCHIVE.
-
-The interface is rather poor, but xetla-browse does a better job
-anyway ..."
- (interactive (let ((l (xetla-name-read nil 'prompt)))
- (list (xetla-name-archive l))))
- (unless archive
- (setq archive (xetla-my-default-archive)))
- (xetla-run-tla-sync (list "rbrowse" "-A" archive)))
-
-(defun xetla-read-config-file (prompt-tree prompt-file)
- "Interactively read the arguments of `xetla-build-config'and `xetla-cat-config'.
-
-The string PROMPT-TREE will be used when prompting the user for a tree.
-The string PROMPT-FILE will be used when prompting the user for a file."
- (let* ((tree-root (xetla-uniquify-file-name
- (xetla-read-project-tree-maybe
- prompt-tree)))
- (current-file-name
- (and buffer-file-name
- (replace-regexp-in-string
- (concat "^" (regexp-quote tree-root))
- ""
- buffer-file-name)))
- (relative-conf-file
- (replace-regexp-in-string
- (concat "^" (regexp-quote tree-root))
- ""
- (expand-file-name
- (read-file-name prompt-file
- tree-root nil t
- current-file-name)))))
- (when (file-name-absolute-p relative-conf-file)
- ;; The replace-regexp-in-string failed.
- (error "Configuration file must be in a %s"
- "subdirectory of tree-root"))
- (list tree-root relative-conf-file)))
-
-(defun xetla-build-config (tree-root config-file)
- "Run tla build-config in TREE-ROOT, outputting to CONFIG-FILE.
-CONFIG-FILE is the relative path-name of the configuration.
-
-When called interactively, arguments are read with the function
-`xetla-read-project-tree-maybe'."
- (interactive (xetla-read-config-file "Build configuration in directory: "
- "Build configuration: "))
- (let ((default-directory tree-root))
- (xetla-run-tla-async (list "build-config" config-file))))
-
-(defun xetla-cat-config (tree-root config-file snap)
- "Run tla cat-config in TREE-ROOT, showing CONFIG-FILE.
-If SNAP is non-nil, then the --snap option of tla is used.
-
-When called interactively, arguments TREE-ROOT and CONFIG-FILE are
-read with the function `xetla-read-project-tree-maybe'."
- (interactive (append (xetla-read-config-file "Cat configuration in directory: "
- "Cat configuration: ")
- (list (y-or-n-p "Include revision number? "))))
- (let ((default-directory tree-root))
- (xetla-run-tla-async
- (list "cat-config" (when snap "--snap") config-file))))
-
-;;
-;; Get
-;;
-(defun xetla-get (directory run-dired-p archive category branch
- &optional version revision synchronously)
- "Run tla get in DIRECTORY.
-If RUN-DIRED-P is non-nil, display the new tree in dired.
-ARCHIVE, CATEGORY, BRANCH, VERSION and REVISION make up the revision to be
-fetched.
-If SYNCHRONOUSLY is non-nil, run the process synchronously.
-Else, run the process asynchronously."
- ;; run-dired-p => t, nil, ask
- (interactive (let* ((l (xetla-name-read "Get: "
- 'prompt 'prompt 'prompt 'maybe 'maybe))
- (name (xetla-name-construct l))
- (d (read-directory-name (format "Store \"%s\" to: " name))))
- (cons d (cons 'ask l))))
- (setq directory (expand-file-name directory))
- (if (file-exists-p directory)
- (error "Directory %s already exists" directory))
- (let* ((name (xetla-name-construct
- (if (or
- ;; the name element are given in interactive form
- (interactive-p)
- ;; not interactive, but revision(and maybe version) is
- ;; passed tothis function.
- (and revision (stringp revision)))
- (list archive category branch version revision)
- (xetla-name-read "Version-Revision for Get(if necessary): "
- archive category branch
- (if version version 'maybe)
- 'maybe)))))
- (funcall (if synchronously 'xetla-run-tla-sync 'xetla-run-tla-async)
- (list "get" "-A" archive name directory)
- :finished `(lambda (output error status arguments)
- (let ((i (xetla-status-handler output error status arguments)))
- (when (zerop i)
- (xetla-get-do-bookmark ,directory ,archive ,category ,branch ,version)
- (xetla-do-dired ,directory ',run-dired-p)))))))
-
-(defun xetla-get-do-bookmark (directory archive category branch version)
- "Add DIRECTORY to the bookmark for ARCHIVE/CATEGORY-BRANCH-VERSION."
- (let ((bookmark (xetla-bookmarks-find-bookmark
- (xetla-name-construct
- archive category branch version))))
- (when bookmark
- (xetla-bookmarks-add-tree bookmark directory))))
-
-(defun xetla-do-dired (directory run-dired-p)
- "Possible run dired in DIRECTORY.
-If RUN-DIRED-P is 'ask, ask the user whether to run dired.
-If RUN-DIRED-P is nil, do not run dired.
-Otherwise, run dired."
- (setq directory (expand-file-name directory))
- (case run-dired-p
- (ask (when (y-or-n-p (format "Run dired at %s? " directory))
- (dired directory)))
- ('nil nil)
- (t (dired directory))))
-
-;;
-;; Cacherev
-;;
-;; TODO:
-;; - provide the way to run interactively
-;; - show progress
-;;
-(defun xetla-cache-revision (archive category branch version revision)
- "Cache the revision named by ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION."
- (interactive (xetla-name-read "Revision to cache: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))
- (let ((result (xetla-run-tla-async (list "cacherev"
- (xetla-name-construct
- archive category branch version revision)))))
- ;; (xetla-show-last-process-buffer)
- result))
-
-;;
-;; Add
-;;
-(defun xetla-add-id (id &rest files)
- "Using ID, add FILES to this tree."
- (interactive (let ((name
- (read-file-name "Add file as source: "
- nil nil t
- (file-name-nondirectory (or
- (buffer-file-name) ""))))
- (id (read-string "id (empty for default): ")))
- (list id name)))
- (if (and id (string= id ""))
- (setq id nil))
- (setq files (mapcar 'expand-file-name files))
- (let* ((arch-ver (or xetla-arch-version-number
- (xetla-arch-version-number)))
- (add-id-string
- (cond ((> 2 (or (cdr-safe (assoc 'minor arch-ver)) 0))
- "add")
- (t "add-id"))))
- (if id
- (xetla-run-tla-sync `(,add-id-string "--id" ,id . ,files)
- :finished 'xetla-null-handler)
- (xetla-run-tla-sync `(,add-id-string . ,files)
- :finished 'xetla-null-handler))))
-
-(defalias 'xetla-add 'xetla-add-id)
-
-;;
-;; Remove
-;;
-(defun xetla-remove (only-id &rest files)
- "Remove the ids of FILES, possibly also deleting the files.
-If ONLY-ID is non-nil, remove the files as well as their ids. Otherwise,
-just remove the ids."
- (interactive (let* ((name
- (read-file-name "Remove file: "
- nil nil t
- (file-name-nondirectory (or
- (buffer-file-name) ""))))
- (only-id (not (y-or-n-p (format
- "Delete the \"%s\" locally also? "
- name)))))
- (list only-id name)))
- (setq files (mapcar 'expand-file-name files))
- (dolist (f files)
- (when (equal 0 (xetla-run-tla-sync (list "id" "--explicit" f)
- :finished 'xetla-status-handler
- :error 'xetla-status-handler))
- (xetla-run-tla-sync (list "delete-id" f)
- :finished 'xetla-status-handler))
- (unless only-id
- (delete-file f))))
-
-;;
-;; Move
-;;
-(defun xetla-move (from to only-id)
- "Move the file FROM to TO.
-If ONLY-ID is non-nil, move only the ID file."
- (interactive
- (list (read-file-name "Move file: "
- nil nil t
- (file-name-nondirectory
- (or (buffer-file-name) "")))
- nil nil))
- (setq to (or to (read-file-name (format "Move file %S to: " from)
- nil nil nil (file-name-nondirectory from)))
- only-id (if (eq only-id 'ask)
- (not (y-or-n-p "Move the file locally also? "))
- only-id)
- from (expand-file-name from)
- to (expand-file-name to))
- (let ((buffer (get-file-buffer from))
- (cmd (if only-id "move-id" "mv")))
- (if buffer
- (save-excursion
- (set-buffer buffer)
- (set-visited-file-name to)))
- (xetla-run-tla-sync (list cmd from to)
- :finished
- `(lambda (output error status arguments)
- (let ((buf (find-buffer-visiting ,from)))
- (when buf
- (with-current-buffer buf
- (rename-buffer (file-name-nondirectory
- ,to))
- (set-visited-file-name ,to))))
- status))))
-
-(defalias 'xetla-mv 'xetla-move)
-
-;;
-;; Update
-;;
-(defun xetla-update (tree &optional handle)
- "Run tla update in TREE.
-
-After running update, execute HANDLE (function taking no argument)."
- (interactive (list (expand-file-name
- (read-directory-name "Update tree: " nil nil nil ""))))
- (or (xetla-save-some-buffers tree)
- (y-or-n-p
- "Update may delete unsaved changes. Continue anyway? ")
- (error "Not updating"))
- (let* ((default-directory (or tree default-directory))
- (buffer (xetla-prepare-changes-buffer
- (list 'last-revision default-directory)
- (list 'local-tree default-directory)
- 'changes default-directory)))
- (when xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer))
- (xetla-run-tla-async `("update")
- :finished `(lambda (output error status arguments)
- ;; (xetla-show-last-process-buffer)
- (xetla-show-changes-buffer
- output nil ,buffer)
- (message "`tla update' finished")
- (xetla-revert-some-buffers ,tree)
- (when ,handle (funcall ,handle)))
- :error
- (lambda (output error status arguments)
- (xetla-show-error-buffer error)
- (xetla-show-last-process-buffer)
- ))
- (xetla-revert-some-buffers tree)))
-
-;;
-;; Import
-;;
-;;;###autoload
-(defun xetla-start-project (&optional archive synchronously)
- "Start a new project.
-Prompts for the root directory of the project and the fully
-qualified version name to use. Sets up and imports the tree and
-displays an inventory buffer to allow the project's files to be
-added and committed.
-If ARCHIVE is given, use it when reading version.
-Return a cons pair: its car is the new version name string, and
-its cdr is imported location.
-If SYNCHRONOUSLY is non-nil, run \"tla import\" synchronously.
-Else run it asynchronously."
- (interactive)
- (let* ((base (read-directory-name "Directory containing files to import: "
- (or default-directory
- (getenv "HOME"))))
- (l (xetla-name-read (format "Import `%s' to: " base)
- (if archive archive (xetla-my-default-archive))
- 'prompt 'prompt 'prompt))
- (project (xetla-name-construct l)))
- (let ((default-directory (file-name-as-directory base)))
- (xetla-run-tla-sync (list "init-tree" project))
- (save-excursion
- (xetla-inventory default-directory)
- (message "Type %s when ready to import"
- (substitute-command-keys "\\[exit-recursive-edit]"))
- (recursive-edit))
- (funcall (if synchronously 'xetla-run-tla-sync 'xetla-run-tla-async)
- (list "import" "--setup")
- :finished
- `(lambda (output error status arguments)
- (xetla-inventory ,base t)))
- (cons project default-directory))))
-
-(defvar xetla-partner-file-precious "/{arch}/+partner-versions"
- "Precious version of the partner file.
-We strongly suggest keeping the default value since this is a
-convention used by other xetla front-ends like Aba.")
-
-(defvar xetla-partner-file-source "/{arch}/=partner-versions"
- "Source version of the partner file.
-We strongly suggest keeping the default value since this is
-a convention used by other xetla front-ends like Aba.")
-
-;; --------------------------------------
-;; xetla partner stuff
-;; --------------------------------------
-(defun xetla-partner-find-partner-file (&optional local-tree)
- "Do `find-file' xetla-partners file and return the buffer.
-If the file `xetla-partner-file-precious' exists, it is used in priority.
-Otherwise,use `xetla-partner-file-source'. The precious one is meant for user
-configuration, whereas the source one is used for project-wide
-configuration. If LOCAL-TREE is not managed by arch, return nil."
- (interactive)
- (let ((default-directory (or local-tree
- (xetla-tree-root default-directory t))))
- (let* ((partner-file
- (cond ((not default-directory) nil)
- ((file-exists-p (concat (xetla-tree-root)
- xetla-partner-file-precious))
- (concat (xetla-tree-root) xetla-partner-file-precious))
- (t (concat (xetla-tree-root)
- xetla-partner-file-source))))
- (buffer-visiting (and partner-file (find-buffer-visiting partner-file))))
- (if buffer-visiting
- (with-current-buffer buffer-visiting
- (if (buffer-modified-p)
- (if (progn (switch-to-buffer (current-buffer))
- (y-or-n-p (format "Save file %s? "
- (buffer-file-name))))
- (save-buffer)
- (revert-buffer)))
- buffer-visiting)
- (when partner-file
- (find-file-noselect partner-file))))))
-
-
-(defun xetla-partner-add (partner &optional local-tree)
- "Add a partner for this xetla working copy.
-Return nil if PARTNER is alerady in partners file.
-Look for the parners file in LOCAL-TREE.
-For example: Franz.Lustig@foo.bar-public/xetla-main-0.1"
- (interactive (list (xetla-name-construct
- (xetla-name-read
- "Version to Add Partner File: "
- 'prompt 'prompt 'prompt 'prompt))))
- (let ((list (xetla-partner-list local-tree)))
- (if (member partner list)
- nil
- (with-current-buffer (xetla-partner-find-partner-file)
- (goto-char (point-min))
- (insert partner)
- (newline)
- (save-buffer))
- partner)))
-
-(defun xetla-partner-list (&optional local-tree)
- "Read the partner list from partner files in LOCAL-TREE.
-If LOCAL-TREE is nil, use the `xetla-tree-root' of `default-directory' instead.
-If LOCAL-TREE is not managed by arch, return nil."
- (let ((buffer (xetla-partner-find-partner-file local-tree)))
- (when buffer
- (with-current-buffer buffer
- (let ((partners (split-string (buffer-substring (point-min) (point-max)) "\n")))
- (remove "" partners))))))
-
-(defun xetla-partner-member (version &optional local-tree)
- "Predicate to check whether VERSION is in the partners file in LOCAL-TREE."
- (let ((list (xetla-partner-list local-tree)))
- (member version list)))
-
-(defun xetla-partner-read-version (&optional prompt including-self)
- "Specialized version for `xetla-name-read' to read a partner.
-- This function displays PROMPT, reads an archive/category-branch-version,
-and:
-- Return the result in a string form (not in a list form) and
-- Ask to the user whether adding the result to the partner file or not
- if the result is not in the partner file.
-
-If INCLUDING-SELF is non-nil, this function asks a question whether
-using self as partner or not. If the user answers `y' as the question,
-this function returns a symbol, `self'. If the user answers `n' as the
-question, this function runs as the same as if INCLUDING-SELF is nil."
- (unless prompt (setq prompt "Enter Xetla Partner: "))
- (if (and including-self
- (y-or-n-p "Select `self' as partner? "))
- 'self
- (let ((version (xetla-name-construct
- (xetla-name-read
- prompt
- 'prompt 'prompt 'prompt 'prompt))))
- (when (and (not (xetla-partner-member version))
- (y-or-n-p (format "Add `%s' to Partner File? " version)))
- (xetla-partner-add version))
- version)))
-
-;; FIXME: Currently does nothing in XEmacs.
-(defun xetla-partner-create-menu (action &optional prompt)
- "Create the partner menu with ACTION using PROMPT as the menu name."
- (let ((list (xetla-partner-list)))
- (xetla-funcall-if-exists
- easy-menu-create-menu prompt
- (mapcar
- (lambda (item)
- (let ((v (make-vector 3 nil)))
- (aset v 0 item) ; name
- (aset v 1 `(,action ,item))
- (aset v 2 t) ; enable
- ;;(aset v 3 :style)
- ;;(aset v 4 'radio)
- ;;(aset v 5 :selected)
- ;;(aset v 6 (if ...))
- v))
- list))))
-
-;; --------------------------------------
-;; xetla-inventory-mode:
-;; --------------------------------------
-
-(defun xetla-inventory-mode ()
- "Major Mode to show the inventory of a xetla working copy.
-
-This allows you to view the list of files in your local tree. You can
-display only some particular kinds of files with 't' keybindings:
-'\\<xetla-inventory-mode-map>\\[xetla-inventory-toggle-source]' to toggle show sources,
-'\\[xetla-inventory-toggle-precious]' to toggle show precious, ...
-
-Use '\\[xetla-inventory-mark-file]' to mark files, and '\\[xetla-inventory-unmark-file]' to unmark.
-If you commit from this buffer (with '\\[xetla-inventory-edit-log]'), then, the list of selected
-files in this buffer at the time you actually commit with
-\\<xetla-log-edit-mode-map>\\[xetla-log-edit-done].
-
-Commands:
-\\{xetla-inventory-mode-map}"
- (interactive)
- ;; don't kill all local variables : this would clear the values of
- ;; xetla-inventory-display-*, and refresh wouldn't work well anymore.
- ;; (kill-all-local-variables)
- (use-local-map xetla-inventory-mode-map)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-inventory)
- (make-local-variable 'xetla-buffer-marked-file-list)
- (easy-menu-add xetla-inventory-mode-menu)
- (setq major-mode 'xetla-inventory-mode)
- (setq mode-name "xetla-inventory")
- (setq mode-line-process 'xetla-mode-line-process)
- (set (make-local-variable 'xetla-get-file-info-at-point-function)
- 'xetla-inventory-get-file-info-at-point)
- (set (make-local-variable 'xetla-generic-select-files-function)
- 'xetla-inventory-select-files)
- (toggle-read-only 1)
- (run-hooks 'xetla-inventory-mode-hook))
-
-(defun xetla-inventory-cursor-goto (ewoc-inv)
- "Move cursor to the ewoc location of EWOC-INV."
- (interactive)
- (if ewoc-inv
- (progn (goto-char (ewoc-location ewoc-inv))
- (forward-char 6))
- (goto-char (point-min))))
-
-(defun xetla-inventory-next ()
- "Go to the next inventory item."
- (interactive)
- (let* ((cookie xetla-inventory-cookie)
- (elem (ewoc-locate cookie))
- (next (or (ewoc-next cookie elem) elem)))
- (xetla-inventory-cursor-goto next)))
-
-(defun xetla-inventory-previous ()
- "Go to the previous inventory item."
- (interactive)
- (let* ((cookie xetla-inventory-cookie)
- (elem (ewoc-locate cookie))
- (previous (or (ewoc-prev cookie elem) elem)))
- (xetla-inventory-cursor-goto previous)))
-
-(defun xetla-inventory-edit-log (&optional insert-changelog)
- "Wrapper around `xetla-edit-log', setting the source buffer to current buffer.
-If INSERT-CHANGELOG is non-nil, insert a changelog too."
- (interactive "P")
- (xetla-edit-log insert-changelog (current-buffer)))
-
-(defun xetla-inventory-add-files (files)
- "Create explicit inventory ids for FILES."
- (interactive
- (list
- (if xetla-buffer-marked-file-list
- (progn
- (unless (y-or-n-p (if (eq 1 (length xetla-buffer-marked-file-list))
- (format "Add %s? "
- (car xetla-buffer-marked-file-list))
- (format "Add %s files? "
- (length xetla-buffer-marked-file-list))))
- (error "Not adding any file"))
- xetla-buffer-marked-file-list)
- (list (read-file-name "Add file: " default-directory
- nil nil
- (xetla-get-file-info-at-point))))))
- (apply 'xetla-add-id nil files)
- (xetla-inventory))
-
-(defun xetla-inventory-remove-files (files id-only)
- "Remove explicit inventory ids of FILES.
-If ID-ONLY is nil, remove the files as well."
- (interactive
- (let ((read-files
- (if xetla-buffer-marked-file-list
- (progn
- (unless (yes-or-no-p
- (format "Remove %d MARKED file%s? "
- (length xetla-buffer-marked-file-list)
- (if (< (length xetla-buffer-marked-file-list) 2)
- "" "s")))
- (error "Not removing any file"))
- xetla-buffer-marked-file-list)
- (list (let ((file (xetla-get-file-info-at-point)))
- (if (yes-or-no-p (format "Remove %s? " file))
- file
- (error "Not removing any file")))))))
- (list read-files (not (y-or-n-p (format "Delete %d %sfile%s also locally? "
- (length read-files)
- (if xetla-buffer-marked-file-list "MARKED " "")
- (if (< (length read-files) 2) "" "s")))))))
- (apply 'xetla-remove id-only files)
- (xetla-inventory))
-
-(defun xetla-delete-file (file &optional recursive)
- "Delete FILE or directory, recursively if optional RECURSIVE is non-nil.
-RECURSIVE determines what to do with a non-empty directory. If RECURSIVE is:
-Nil, do not delete.
-`always', delete recursively without asking.
-`top', ask for each directory at top level.
-Anything else, ask for each sub-directory."
- (let (files)
- ;; This test is equivalent to
- ;; (and (file-directory-p fn) (not (file-symlink-p fn)))
- ;; but more efficient
- (if (not (eq t (car (file-attributes file))))
- (delete-file file)
- (when (and recursive
- (setq files
- (directory-files
- file t
- "^\\([^.]\\|\\.\\([^.]\\|\\..\\)\\).*")) ; Not empty.
- (or (eq recursive 'always)
- (yes-or-no-p (format "Recursive delete of %s "
- (dired-make-relative file)))))
- (if (eq recursive 'top) (setq recursive 'always)) ; Don't ask again.
- (while files ; Recursively delete (possibly asking).
- (xetla-delete-file (car files) recursive)
- (setq files (cdr files))))
- (delete-directory file))))
-
-(defun xetla-inventory-delete-files (files no-questions)
- "Delete FILES locally.
-This is here for convenience to delete left over, temporary files or files
-avoiding a commit or conflicting with tree-lint.
-
-It is not meant to delete xetla managed files, i.e. files with IDs will be
-passed to `xetla-inventory-remove-files'!
-
-When called with a prefix arg NO-QUESTIONS, just delete the files."
- (interactive
- (list
- (if xetla-buffer-marked-file-list
- (progn
- (or current-prefix-arg
- (unless (yes-or-no-p
- (format "Delete %d files permanently? "
- (length xetla-buffer-marked-file-list)))
- (error "Not deleting any files")))
- xetla-buffer-marked-file-list)
- (if (or current-prefix-arg
- (yes-or-no-p (format "Delete file %S permanently? "
- (xetla-get-file-info-at-point))))
- (list (xetla-get-file-info-at-point))))
- current-prefix-arg))
- (while files
- (let ((f (car files)))
- (if (= 0 (xetla-run-tla-sync (list "id" f)
- :finished 'xetla-status-handler
- :error 'xetla-status-handler))
- (if (or no-questions
- (y-or-n-p (format (concat "File %s is arch managed! "
- "Delete it with its id?") f)))
- (xetla-inventory-remove-files (list f) nil))
- (if (file-directory-p f)
- (condition-case nil
- (delete-directory f)
- (file-error
- (if (or no-questions
- (y-or-n-p (format "Delete non-empty directory %S? " f)))
- (xetla-delete-file f 'always))))
- (delete-file f))))
- (setq files (cdr files)))
- (if xetla-buffer-marked-file-list
- (setq xetla-buffer-marked-file-list nil))
- (xetla-inventory))
-
-(defun xetla-inventory-move ()
- "Rename file at the current point and update its inventory id if present."
- (interactive)
- (if (eq 0 (xetla-move (xetla-get-file-info-at-point) nil 'ask))
- (xetla-generic-refresh)
- (xetla-show-last-process-buffer)))
-
-(defun xetla-inventory-revert ()
- "Reverts file at point."
- (interactive)
- (let* ((file (xetla-get-file-info-at-point))
- (absolute (if (file-name-absolute-p file)
- file
- (expand-file-name
- (concat (file-name-as-directory
- default-directory) file)))))
- (xetla-file-revert absolute)))
-
-(defun xetla-inventory-undo (specify-revision)
- "Undo whole local tree associated with the current inventory buffer.
-If prefix arg, SPECIFY-REVISION is non-nil, read a revision and use it to undo.
-The changes are saved in an ,,undo directory. You can restore them again via
-`xetla-inventory-redo'."
- (interactive "P")
- (let* ((tree (xetla-tree-root default-directory t))
- (revision (if specify-revision
- (xetla-read-revision-with-default-tree
- "Undo against archive: "
- tree)
- (list nil nil nil nil nil))))
- (apply 'xetla-undo-internal (cons tree revision))))
-
-(defun xetla-inventory-maybe-undo-directory ()
- "Return the directory name under point if it may be an ,,undo-? directory.
-Return nil otherwise."
- (car (member (expand-file-name (xetla-get-file-info-at-point))
- (xetla-get-undo-changeset-names))))
-
-(defun xetla-inventory-redo ()
- "Redo whole local tree associated with the current inventory buffer.
-This function restores the saved changes from `xetla-inventory-undo'."
- (interactive)
- (xetla-redo (xetla-inventory-maybe-undo-directory)))
-
-(defun xetla-file-has-conflict-p (file-name)
- "Return non-nil if FILE-NAME has conflicts."
- (let ((rej-file-name (concat default-directory
- (file-name-nondirectory file-name)
- ".rej")))
- (file-exists-p rej-file-name)))
-
-(defun xetla-inventory-find-file ()
- "Visit the current inventory file."
- (interactive)
- (let* ((file (xetla-get-file-info-at-point)))
- (cond
- ((not file)
- (error "No file at point"))
- ((eq t (car (file-attributes file))) ; file is a directory
- (xetla-inventory (expand-file-name file)))
- (t
- (find-file file)))))
-
-(defun xetla-inventory-parent-directory ()
- "Go to parent directory in inventory mode."
- (interactive)
- (xetla-inventory (expand-file-name "..")))
-
-(defun xetla-inventory-mirror ()
- "Create a mirror of version of the current tree."
- (interactive)
- (let ((tree-version (xetla-tree-version-list)))
- (xetla-archive-mirror (xetla-name-archive tree-version)
- (xetla-name-category tree-version)
- (xetla-name-branch tree-version)
- (xetla-name-version tree-version))))
-
-(defun xetla-inventory-star-merge (&optional merge-partner)
- "Run tla star-merge.
-Either use a partner in the tree's \"++tla-partners\" file or ask the user
-for MERGE-PARTNER."
- (interactive (list (xetla-partner-read-version "Star-merge with: ")))
- (when (y-or-n-p (format "Star-merge with %s ? " merge-partner))
- (xetla-star-merge merge-partner)))
-
-(defun xetla-inventory-changes (summary)
- "Run tla changes.
-A prefix argument decides whether the user is asked for a diff partner
-and whether only a summary without detailed diffs will be shown.
-
-When called without a prefix argument: Show the changes for your tree.
-When called with C-u as prefix: Ask the user for a diff partner via `xetla-partner-read-version'.
-When called with a negative prefix: Show only a summary of the changes.
-When called with C- C-u as prefix: Ask the user for a diff partner, show only change summary."
- (interactive "P")
- (let* ((ask-for-compare-partner (and summary (listp summary)))
- (compare-partner (if ask-for-compare-partner
- (xetla-partner-read-version
- "Compare with (default is your tree): "
- t)
- 'self)))
- (if (eq 'self compare-partner)
- (setq compare-partner nil)
- (setq compare-partner (list 'revision (xetla-name-split compare-partner))))
- (when (listp summary)
- (setq summary (car summary)))
- (xetla-changes summary compare-partner)))
-
-(defun xetla-inventory-replay (&optional merge-partner)
- "Run tla replay.
-Either use a partner in the tree's ++xetla-partners file, or ask the user
-for MERGE-PARTNER."
- (interactive (list (xetla-partner-read-version "Replay from: ")))
- (when (y-or-n-p (format "Replay from %s ? " merge-partner))
- (xetla-replay merge-partner)))
-
-(defun xetla-inventory-update ()
- "Run tla update."
- (interactive)
- (xetla-update default-directory))
-
-(defun xetla-inventory-missing (&optional arg)
- "Run tla missing in `default-directory'.
-With an prefix ARG, do this for the archive of one of your partners."
- (interactive "P")
- (if arg
- (let ((missing-partner (xetla-partner-read-version "Check missing against: ")))
- (when (y-or-n-p (format "Check missing against %s ? " missing-partner))
- (xetla-missing default-directory missing-partner)))
- (xetla-missing default-directory (xetla-tree-version))))
-
-(defun xetla-inventory-file-ediff (&optional file)
- "Run `ediff' on FILE."
- (interactive (list (caddr (ewoc-data (ewoc-locate xetla-inventory-cookie)))))
- (xetla-file-ediff file))
-
-(xetla-make-bymouse-function xetla-inventory-find-file)
-
-(defun xetla-inventory-delta ()
- "Run tla delta.
-Use the head revision of the version associated with the current inventory
-buffer as modified tree. Give the base tree interactively."
- (interactive)
- (let* ((modified (xetla-tree-version-list))
- (modified-revision (apply 'xetla-version-head modified))
- (modified-fq (xetla-name-construct
- (xetla-name-archive modified)
- (xetla-name-category modified)
- (xetla-name-branch modified)
- (xetla-name-version modified)
- modified-revision))
- (base (xetla-name-read
- (format "Revision for delta to %s(HEAD) from: " modified-fq)
- 'prompt 'prompt 'prompt 'prompt 'prompt))
- (base-fq (xetla-name-construct base)))
- (xetla-delta base-fq modified-fq 'ask)))
-
-
-(defun xetla-inventory-apply-changeset (reverse)
- "Apply changeset to the tree visited by the current inventory buffer.
-With a prefix argument REVERSE, reverse the changeset."
- (interactive "P")
- (let ((inventory-buffer (current-buffer))
- (target (xetla-tree-root))
- (changeset (let ((changeset-dir (or (xetla-get-file-info-at-point) "")))
- (unless (file-directory-p (expand-file-name changeset-dir))
- (setq changeset-dir ""))
- (xetla-uniquify-file-name
- (read-directory-name
- "Changeset directory: " changeset-dir changeset-dir)))))
- (xetla-show-changeset changeset nil)
- (when (yes-or-no-p (format "Apply the changeset%s? "
- (if reverse " in REVERSE" "")))
- (xetla-apply-changeset changeset target reverse)
- (with-current-buffer inventory-buffer
- (xetla-generic-refresh)))))
-
-(defun xetla-inventory-apply-changeset-from-tgz (file)
- "Apply the changeset in FILE to the currently visited tree."
- (interactive (list (let ((changeset-tarball (or (xetla-get-file-info-at-point) "")))
- (read-file-name "Apply changeset from tarball: " nil changeset-tarball t changeset-tarball))))
- (let ((inventory-buffer (current-buffer))
- (target (xetla-tree-root)))
- (xetla-apply-changeset-from-tgz file target)
- (with-current-buffer inventory-buffer
- (xetla-generic-refresh))))
-
-;; TODO: Use `xetla-inventory-select-file' in other xetla-inventory-*.
-;; TODO: Mouse event check like `xetla-tree-lint-select-files'.
-;; TODO: Unify with `xetla-tree-lint-select-files'.
-(defun xetla-inventory-select-files (prompt-singular
- prompt-plural msg-err
- &optional
- msg-prompt no-group ignore-marked
- no-prompt y-or-n)
- "Get the list of marked files and ask confirmation of the user.
-PROMPT-SINGULAR or PROMPT-PLURAL is used as prompt. If no file is under
-the point MSG-ERR is passed to `error'.
-
-MSG-PROMPT NO-GROUP IGNORE-MARKED NO-PROMPT and Y-OR-N are currently
-ignored."
- (let ((files (if xetla-buffer-marked-file-list
- xetla-buffer-marked-file-list
- (list (xetla-get-file-info-at-point)))))
- (unless files
- (error msg-err))
- (if (y-or-n-p
- (format
- (if (> (length files) 1)
- prompt-plural
- prompt-singular)
- (if (> (length files) 1)
- (length files)
- (car files))))
- files
- (error msg-err))))
-
-(defun xetla-inventory-make-junk (files)
- "Prompts and make the FILES junk.
-If marked files are, use them as FIELS.
-If not, a file under the point is used as FILES."
- (interactive
- (list
- (xetla-inventory-select-files "Make `%s' junk? "
- "Make %s files junk? "
- "Not making any file junk")))
- (xetla-generic-file-prefix files ",,"))
-
-(defun xetla-inventory-make-precious (files)
- "Prompts and make the FILES precious.
-If marked files are, use them as FILES.
-If not, a file under the point is used as FILES."
- (interactive
- (list
- (xetla-inventory-select-files "Make `%s' precious? "
- "Make %s files precious? "
- "Not making any file precious")))
- (xetla-generic-file-prefix files "++"))
-
-(defun xetla-generic-add-to-exclude (=tagging-method)
- "Exclude the file/directory under point by adding it to =TAGGING-METHOD.
-Adds an entry for the file to .arch-inventory or =tagging-method."
- (interactive "P")
- (xetla-generic-add-to-* "exclude" =tagging-method))
-
-(defun xetla-generic-add-to-junk (=tagging-method)
- "Add the file/directory under point to =TAGGING-METHOD.
-Adds an entry for the file to .arch-inventory or =tagging-method."
- (interactive "P")
- (xetla-generic-add-to-* "junk" =tagging-method))
-
-(defun xetla-generic-add-to-backup (=tagging-method)
- "Add the file/directory under the point to =TAGGING-METHOD.
-Adds an entry for the file to .arch-inventory or =tagging-method."
- (interactive "P")
- (xetla-generic-add-to-* "backup" =tagging-method))
-
-(defun xetla-generic-add-to-precious (=tagging-method)
- "Add the file/directory under the point to =TAGGING-METHOD.
-Adds an entry for the file to .arch-inventory or =tagging-method."
- (interactive "P")
- (xetla-generic-add-to-* "precious" =tagging-method))
-
-(defun xetla-generic-add-to-unrecognized (=tagging-method)
- "Add the file/directory under the point as a precious entry
-of .arch-inventory or =tagging-method file."
- (interactive "P")
- (xetla-generic-add-to-* "unrecognized" =tagging-method))
-
-(defun xetla-generic-add-to-* (category =tagging-method)
- "Categorize currently marked files or the file under point.
-Each file is categorized as CATEGORY by adding it to =TAGGING-METHOD."
- (xetla-generic-add-files-to-*
- category =tagging-method
- (xetla-generic-select-files
- (format "Make `%%s' %s? " category)
- (format "Make %%s files %s? " category)
- (format "Not making any file %s? " category)
- (format "Make file %s: " category))))
-
-(defun xetla-generic-add-files-to-* (category =tagging-method files)
- "Categorize FILES as CATEGORY in =TAGGING-METHOD.
-If =TAGGING-METHOD is t, entries for the files are added to =tagging-method.
-Else, they are added to .arch-inventory.
-CATEGORY is one of the following strings: \"unrecognized\", \"precious\",
-\"backup\",\"junk\" or \"exclude\"."
- (let ((point (point))
- (basedir (expand-file-name default-directory)))
- ;; Write down
- (save-excursion
- (mapc (lambda (file)
- (if =tagging-method
- (xetla-edit-=tagging-method-file)
- (xetla-edit-.arch-inventory-file
- (concat basedir (file-name-directory file))))
- (xetla-inventory-file-add-file
- category (xetla-regexp-quote (file-name-nondirectory file)))
- (save-buffer)) files))
- ;; Keep the position
- (prog1
- (xetla-generic-refresh)
- (if (< point (point-max))
- (goto-char point)))))
-
-
-(defun xetla-generic-set-id-tagging-method (method)
- "Set the id tagging method of the current tree to METHOD."
- (interactive (list (xetla-id-tagging-method-read
- (xetla-id-tagging-method nil))))
- (xetla-id-tagging-method-set method)
- (xetla-generic-refresh))
-
-(defun xetla-generic-set-id-tagging-method-by-mouse (dummy-event)
- "Interactively set the id tagging method of the current tree.
-DUMMY-EVENT is ignored."
- (interactive "e")
- (call-interactively 'xetla-generic-set-id-tagging-method))
-
-(defun xetla-generic-set-tree-version (&optional version)
- "Run tla set-tree-version, setting the tree to VERSION."
- (interactive)
- (if version
- (xetla-set-tree-version version)
- (call-interactively 'xetla-set-tree-version))
- (xetla-generic-refresh))
-
-;; --------------------------------------
-;; xetla-cat-log-mode:
-;; --------------------------------------
-(defun xetla-cat-log-mode ()
- "Major Mode to show a specific log message.
-Commands:
-\\{xetla-cat-log-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map xetla-cat-log-mode-map)
- (set (make-local-variable 'font-lock-defaults)
- '(xetla-cat-log-font-lock-keywords t))
- (font-lock-mode)
- (setq major-mode 'xetla-cat-log-mode)
- (setq mode-name "xetla-cat-log")
- (toggle-read-only 1)
- (run-hooks 'xetla-cat-log-mode-hook))
-
-(defun xetla-cat-log (revision-spec)
- "Show the log for REVISION-SPEC."
- (interactive (list (xetla-name-construct
- (xetla-name-read "Revision spec: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))))
- (xetla-run-tla-sync (list "cat-log" revision-spec)
- :finished 'xetla-finish-function-without-buffer-switch)
- (xetla-show-last-process-buffer 'cat-log 'xetla-cat-log-mode revision-spec))
-
-(defun xetla-cat-archive-log (revision-spec)
- "Run cat-archive-log for REVISION-SPEC."
- (interactive (list (xetla-name-construct
- (xetla-name-read "Revision spec: "
- 'prompt 'prompt 'prompt 'prompt 'prompt))))
- (xetla-run-tla-sync (list "cat-archive-log" revision-spec)
- :finished 'xetla-finish-function-without-buffer-switch)
- (xetla-show-last-process-buffer 'cat-log 'xetla-cat-log-mode revision-spec))
-
-(defun xetla-maybe-save-log (revision)
- "Must be called from the buffer containing the log for REVISION.
-Saves this buffer to the corresponding file in the log-library if
-`xetla-log-library-greedy' is non-nil."
- (if xetla-log-library-greedy
- (let ((dir (expand-file-name
- (concat (file-name-as-directory xetla-log-library)
- (car revision))))
- (file (xetla-name-construct-semi-qualified (cdr revision))))
- (unless (file-directory-p dir)
- (make-directory dir))
- (let ((name (concat " *xetla-log-rev-" (xetla-name-construct
- revision) "*"))
- make-backup-files)
- (write-file (concat (file-name-as-directory dir) file))
- (set-visited-file-name
- (concat (file-name-as-directory dir) file))
- (set-buffer-modified-p nil)
- (rename-buffer name)
- (current-buffer)))
- (clone-buffer)))
-
-(defun xetla-cat-log-any (revision &optional tree async-handler)
- "Create a buffer containing the log file for REVISION.
-
-Either call cat-log, cat-archive-log, or read the log from the log library.
-
-REVISION must be specified as a list. If TREE is provided, try a
-cat-log in TREE preferably. Otherwise, try a cat-log in the local
-directory. If both are impossible, run cat-archive-log. (same result,
-but needs to retrieve something from the archive).
-
-Call the function ASYNC-HANDLER in the created buffer, with arguments
- (output error status arguments)."
- ;; (message "xetla-cat-log-any %S" revision)
- ;; See if the log is in the log library
- (when xetla-log-library-greedy
- (if (not (file-directory-p xetla-log-library))
- (make-directory xetla-log-library)))
- (let* ((lib-log (concat (file-name-as-directory xetla-log-library)
- (xetla-name-construct revision)))
- (buffer
- (or (get-file-buffer lib-log)
- (when (file-exists-p lib-log)
- (let* ((name (concat " *xetla-log("
- (xetla-name-construct revision) ")*")))
- (or (get-buffer name)
- ;; Surprisingly, (rename-buffer) didn't rename
- ;; anything here. Solution: Create a buffer with
- ;; the right name, and simulate a find-file.
- (with-current-buffer
- (get-buffer-create name)
- (insert-file-contents lib-log)
- (set-visited-file-name lib-log)
- (rename-buffer name)
- (set-buffer-modified-p nil)
- (current-buffer))))))))
- (if buffer
- (if async-handler
- (funcall async-handler buffer nil 0 "cat-log")
- buffer)
- ;; Try a cat-log
- (let* ((revision-string (xetla-name-construct revision)))
- (let ((run-mode (if async-handler 'xetla-run-tla-async 'xetla-run-tla-sync))
- (handler (if async-handler
- `(lambda (output error status arguments)
- (with-current-buffer output
- (xetla-maybe-save-log ',revision))
- (funcall ,async-handler output error status
- arguments))
- `(lambda (output error status arguments)
- (with-current-buffer output
- (xetla-maybe-save-log ',revision))))))
- (xetla-run-tla-sync ;; Anyway, tla cat-log is fast, so, no
- ;; need for an asynchronous process. For some reason,
- ;; running it asynchronously caused a random bug when
- ;; running tla remotely.
- (list "cat-log" revision-string)
- :finished handler
- ;; cat-log failed: cat-archive-log is needed
- :error `(lambda (output error status arguments)
- (funcall ',run-mode
- (list "cat-archive-log"
- ,revision-string)
- :finished ',handler))))))))
-
-;; Obsolete
-(defun xetla-log-merges (revision &optional callback)
- "Return a list that will contain patches merged by REVISION.
-When the list has been filled in, CALLBACK is called with no arguments."
- (let ((merges (list "")))
- (xetla-cat-log-any
- revision nil
- `(lambda (output error status args)
- (with-current-buffer output
- (goto-char (point-min))
- (unwind-protect
- (let ((list (split-string
- (buffer-substring-no-properties
- (re-search-forward "^New-patches: ")
- (progn (re-search-forward "^[^\t ]")
- (beginning-of-line) (point))))))
- (setq list
- (remove (xetla-name-construct
- ',revision)
- list))
- (setcar ',merges (car list))
- (setcdr ',merges (cdr list)))
- (when ',callback (funcall ',callback))
- (kill-buffer nil)))))
- merges))
-
-;; --------------------------------------
-;; xetla-log-edit-mode:
-;; --------------------------------------
-(defun xetla-log-edit-next-field ()
- "Go to next field in a log edition."
- (interactive)
- (let ((in-field (string-match "^\\([A-Z][A-Za-z]*\\(: ?\\)?\\)?$"
- (buffer-substring
- (point-at-bol) (point)))))
- (if (and in-field
- (string-match "^[A-Z][A-Za-z]*: $"
-\0 (buffer-substring
- (point-at-bol) (point))))
- (forward-line))
- (if in-field (beginning-of-line) (forward-line 1))
- (or (and (looking-at "^[A-Z][a-zA-Z]*: ")
- (goto-char (match-end 0)))
- (and (looking-at "^[A-Z][a-zA-Z]*:$")
- (goto-char (match-end 0))
- (progn (insert " ") t))
- (goto-char (point-max)))))
-
-(defun xetla-log-goto-field (field)
- "Go to FIELD in a log file."
- (goto-char (point-min))
- (re-search-forward field)
- (save-excursion
- (if (not (looking-at " "))
- (insert " ")))
- (forward-char 1))
-
-(defun xetla-log-goto-summary ()
- "Go to the Summary field in a log file."
- (interactive)
- (xetla-log-goto-field "^Summary:"))
-
-(defun xetla-log-goto-keywords ()
- "Go to the Keywords field in a log file."
- (interactive)
- (xetla-log-goto-field "^Keywords:"))
-
-(defun xetla-log-goto-body ()
- "Go to the Body in a log file."
- (interactive)
- (goto-char (point-min))
- (forward-line 3))
-
-(defun xetla-log-kill-body ()
- "Kill the content of the log file body."
- (interactive)
- (xetla-log-goto-body)
- (kill-region (point) (point-max)))
-
-;;;###autoload(add-to-list 'auto-mode-alist '("\\+\\+log\\." . xetla-log-edit-mode))
-
-;;;###autoload
-(define-derived-mode xetla-log-edit-mode text-mode "xetla-log-edit"
- "Major Mode to edit xetla log messages.
-Commands:
-\\{xetla-log-edit-mode-map}
-"
- (use-local-map xetla-log-edit-mode-map)
- (easy-menu-add xetla-log-edit-mode-menu)
- (set (make-local-variable 'font-lock-defaults)
- '(xetla-log-edit-font-lock-keywords t))
- (font-lock-mode)
- (setq fill-column 73)
- (run-hooks 'xetla-log-edit-mode-hook))
-
-(defun xetla-log-edit-abort ()
- "Abort the current log edit."
- (interactive)
- (bury-buffer)
- (set-window-configuration xetla-pre-commit-window-configuration))
-
-(autoload (quote xetla-tips-popup-maybe) "xetla-tips" "\
-Pops up a buffer with a tip if tips are enabled (see
-`xetla-tips-enabled')" nil nil)
-
-(defun xetla-log-edit-done (&optional commit version-flag)
- "Save the current log edit.
-
-When optional argument COMMIT is non-nil, run `tla commit'.
-
-Optional argument VERSION-FLAG is for specifying either a `seal'
-commit or a `fix' commit. It is a symbol and can be either `seal' or
-`fix'.
-
-Both COMMIT and VERSION-FLAG are really meant for non-interactive
-use. When this function is called interactively the same thing can
-be achieved through prefix arguments...
-
-With a single prefix arg, run `tla commit'.
-With 2 prefix args, run `tla commit --seal'.
-With 3 prefix args, run `tla commit --fix'."
- (interactive "p")
- (save-buffer)
- (let ((log-buffer (current-buffer))
- (commit (car current-prefix-arg))
- (type version-flag)
- (dir default-directory))
- (pop-window-configuration)
- (when (interactive-p)
- (cond ((eq commit 4)
- (setq type nil))
- ((eq commit 16)
- (setq type 'seal))
- ((eq commit 64)
- (setq type 'fix))
- (t
- (setq type nil))))
- (if (not commit)
- (bury-buffer log-buffer)
- (if type
- (funcall (intern (format "xetla-commit-%s" type)))
- (if (string-match "--version\\(-\\|fix-\\)+"
- (xetla-get-current-revision dir))
- (error "Can't commit to sealed archive without --fix")
- (kill-buffer log-buffer)
- (xetla-commit
- (lambda (output error status args)
- (xetla-tips-popup-maybe))))))))
-
-(defun xetla-archive-maintainer-name (version)
- "Return the maintainer name for a given VERSION.
-This function looks in the bookmarks file for the nickname field and
-returns it.
-If the nickname field is not present, just return the archive name for
-VERSION."
- (xetla-bookmarks-get-field version 'nickname (xetla-name-archive version)))
-
-(defun xetla-archive-maintainer-id (archive &optional shorter)
- "Return my-id substring from ARCHIVE.
-If SHORTER is non-nil, return login name part of the my-id substring.
-E.g. If ARCHIVE is x@y.z-a, the result is x@y.z.
-If SHORTER is non-nil, the result is x."
- (if (string-match "\\(\\(.+\\)@.+\\)--.+" archive)
- (if shorter
- (match-string 2 archive)
- (match-string 1 archive))))
-
-(defun xetla-archive-default-maintainer-name (version)
- "Return a suitable maintainer name or version name for VERSION.
-Either the nickname if defined in the bookmarks, or the left hand side
-of the email in the archive name."
- (or (xetla-archive-maintainer-name version)
- (xetla-archive-maintainer-id (xetla-name-archive version) t)))
-
-(defun xetla-merge-summary-end-of-sequence (string low high)
- "Pretty-print a range of merged patches.
-STRING is an identifier for this merge, while LOW and HIGH are the lowest
-and highest patches that were merged."
- (let ((elem
- (if (= low high)
- ;; singleton
- (int-to-string low)
- (format "%d-%d" low high))))
- (if (string= string "")
- (concat "patch " elem)
- (concat string ", " elem))))
-
-
-(defun xetla-merge-summary-line (mergelist)
- "Create a suitable log summary line for a list of merges.
-MERGELIST is an alist in the form
-\((maintainer1 12 13 14 25 26)
- ...
- (maintainerN num42))
-The return value is a string in the form
-\"maintainer1 (patch 12-14, 25-26), maintainerN (patch-num42)\""
- (let ((res ""))
- (while mergelist
- (let ((patch-list (sort (cdar mergelist) '<))
- (list-string "")
- last-patch-number-low
- last-patch-number-high)
- ;; patch-list is the list of patch numbers.
- (while patch-list
- (unless last-patch-number-low
- (setq last-patch-number-low (car patch-list))
- (setq last-patch-number-high (- (car patch-list) 1)))
- (if (= (1+ last-patch-number-high) (car patch-list))
- ;; normal sequence
- (setq last-patch-number-high (car patch-list))
- (setq list-string
- (xetla-merge-summary-end-of-sequence
- list-string
- last-patch-number-low
- last-patch-number-high))
- (setq last-patch-number-low (car patch-list)))
- (setq last-patch-number-high (car patch-list))
- (setq patch-list (cdr patch-list)))
- (setq list-string
- (xetla-merge-summary-end-of-sequence
- list-string
- last-patch-number-low
- last-patch-number-high))
- (setq last-patch-number-low nil)
- (setq res
- (let ((maint (format "%s (%s)" (caar mergelist)
- list-string)))
- (if (string= res "")
- maint
- (concat res ", " maint)))))
- (setq mergelist (cdr mergelist)))
- res))
-
-(defun xetla-merge-summary-default-format-function (string)
- "Return an appropriate \"Merged from\" summary line for STRING.
-
-Gets the 'summary-format field for that version in the bookmarks (or
-use \"Merged from %s\" by default), and calls
-\(format summary-format S)."
- (let ((format-string (xetla-bookmarks-get-field
- (xetla-tree-version-list)
- 'summary-format
- "Merged from %s")))
- (format format-string string)))
-
-(defun xetla-merge-summary-line-for-log (&optional
- version-to-name-function
- generate-line-function
- format-line-function)
- "Generate an appropriate summary line after a merge.
-The generated line is of the form
-\"Merged from Robert (167-168, 170), Masatake (209, 213-215, 217-218)\".
-The names \"Robert\" and \"Masatake\" in this example are nicknames
-defined in the bookmarks for the corresponding versions.
-
-First, an alist A like
- ((\"Robert\" 167 168 170) (\"Masatake\" 209 213 214 215 217 218))
-is generated. If VERSION-TO-NAME-FUNCTION is non-nil, then it must be
-a function that is called with the version as an argument, and must
-return a string that will be used to instead of the nickname.
-
-Then, a string S like
-\"Robert (167-168, 170), Masatake (209, 213-215, 217-218)\"
-is generated. This is done by default by `xetla-merge-summary-line',
-which can be overridden by GENERATE-LINE-FUNCTION.
-
-Then, the function FORMAT-LINE-FUNCTION is called with this string S
-as an argument. If FORMAT-LINE-FUNCTION is nil, then,
-`xetla-merge-summary-default-format-function' is called. It retrieves
-the fields summary-format from the bookmark for the tree version, and
-calls (format summary-format S)."
- (save-excursion
- (let ((rev-list)
- (maintainer)
- (rev)
- (patch-list))
- (goto-char (point-min))
- (while (re-search-forward "^ \\* \\(.+@.+--.+/.+--.+\\)$" nil t)
- (setq rev-list (xetla-name-split (match-string 1)))
- (setq maintainer (funcall (or version-to-name-function
- 'xetla-archive-default-maintainer-name)
- rev-list))
- (setq rev (cadr (split-string (xetla-name-revision rev-list) "-")))
- (add-to-list 'patch-list (list maintainer rev)))
- ;; patch-list has now the form
- ;; ((maintainer1 num1) (maintainer1 num2) ... (maintainerN num42))
- (let ((alist))
- (while patch-list
- (let* ((elem (car patch-list))
- (patch-number-list (assoc (car elem) alist)))
- (if patch-number-list
- ;; This maintainer already has a patch in the list
- (setcdr patch-number-list
- (cons (string-to-number (cadr elem))
- (cdr patch-number-list)))
- ;; First patch for this maintainer. add
- ;; (maintainer patch-number) to the alist.
- (setq alist (cons (list (car elem)
- (string-to-number (cadr elem)))
- alist))))
- (setq patch-list (cdr patch-list)))
- ;; alist now has the form
- ;; ((maintainer1 num1 num2)
- ;; ...
- ;; (maintainerN num42))
- ;; where numX are of type integer.
- (funcall (or format-line-function
- 'xetla-merge-summary-default-format-function)
- (funcall (or generate-line-function
- 'xetla-merge-summary-line) alist))))))
-
-(defun xetla-log-edit-insert-log-for-merge-and-headers ()
- "Call `xetla-log-edit-insert-log-for-merge' with a prefix arg."
- (interactive)
- (xetla-log-edit-insert-log-for-merge t))
-
-(defun xetla-log-edit-insert-log-for-merge (arg)
- "Insert the output of xetla log-for-merge at POINT.
-
-When called with a prefix argument ARG, create a standard Merged from
-line as Summary with `xetla-merge-summary-line-for-log'."
- (interactive "P")
- (xetla-run-tla-sync '("log-for-merge")
- :finished
- `(lambda (output error status arguments)
- (let ((content (xetla-buffer-content
- output)))
- (if (= 0 (length content))
- (error "There was no merge!"))
- (with-current-buffer ,(current-buffer)
- (let ((on-summary-line
- (= 1 (count-lines (point-min) (point))))
- (old-pos (point)))
- (if on-summary-line
- (xetla-log-goto-body)
- (goto-char old-pos))
- (insert content)))
- (when arg
- (xetla-log-goto-summary)
- (delete-region (point) (point-at-eol))
- (insert
- (with-current-buffer output
- (xetla-merge-summary-line-for-log)))
- (xetla-log-goto-keywords)
- (delete-region (point) (point-at-eol))
- (insert "merge")
- (xetla-log-goto-summary))))))
-
-
-(defun xetla-log-edit-insert-memorized-log ()
- "Insert a memorized log message."
- (interactive)
- (when xetla-memorized-log-header
- (xetla-log-goto-summary)
- (delete-region (point) (point-at-eol))
- (insert xetla-memorized-log-header))
- (when xetla-memorized-log-message
- (xetla-log-goto-body)
- (insert xetla-memorized-log-message)))
-
-
-;; --------------------------------------
-;; xetla-log-edit-insert-keywords:
-;; --------------------------------------
-
-(defvar xetla-log-edit-keywords-marked-list)
-(defvar xetla-log-edit-keywords-cookie)
-(defvar xetla-log-edit-keywords-log-buffer)
-
-(defun xetla-log-edit-keywords-printer (elem)
- "If ELEM is a keyword, print it differently."
- (insert (if (member elem xetla-log-edit-keywords-marked-list)
- (concat xetla-mark " ") " ")
- elem))
-
-(defun xetla-log-edit-keywords (arg)
- "Add keywords listed in variable `xetla-log-edit-keywords'.
-When called with a prefix argument ARG, delete all current keywords."
- (interactive "P")
- (let ((current-keywords
- (save-excursion
- (xetla-log-goto-keywords)
- (buffer-substring (point) (point-at-eol))))
- (log-buffer (current-buffer))
- keywords)
- (setq current-keywords (replace-regexp-in-string "," " " current-keywords nil t)
- current-keywords (mapcar (lambda (k) (format "%s" k))
- (read (concat "(" current-keywords ")"))))
- (switch-to-buffer " *xetla-log-keywords*")
- (toggle-read-only 0)
- (erase-buffer)
- (make-local-variable 'xetla-log-edit-keywords)
- (make-local-variable 'xetla-log-edit-keywords-marked-list)
- (make-local-variable 'xetla-log-edit-keywords-cookie)
- (make-local-variable 'xetla-log-edit-keywords-log-buffer)
- (setq xetla-log-edit-keywords-log-buffer
- log-buffer
- xetla-log-edit-keywords-marked-list
- current-keywords
- xetla-log-edit-keywords-cookie
- (ewoc-create 'xetla-log-edit-keywords-printer
- "List of keywords from `xetla-log-edit-keywords':"
- (format "type C-c C-c to insert the marked keywords to the buffer\n%s"
- (buffer-name log-buffer))))
-
- (while current-keywords
- (add-to-list 'xetla-log-edit-keywords (car current-keywords))
- (setq current-keywords (cdr current-keywords)))
-
- (setq keywords xetla-log-edit-keywords)
-
- (while keywords
- (add-to-list 'xetla-log-edit-keywords (car keywords))
- (ewoc-enter-last xetla-log-edit-keywords-cookie (car keywords))
- (setq keywords (cdr keywords))))
-
- (use-local-map xetla-log-edit-keywords-mode-map)
- (setq major-mode 'xetla-log-edit-keywords-mode)
- (setq mode-name "xetla-log-keywords")
- (toggle-read-only 1)
- (message "Type C-c C-c to finish.")
- (goto-char (point-min))
- (forward-line 1))
-
-(defun xetla-log-edit-keywords-cursor-goto (elem)
- "Jump to the location of ELEM."
- (interactive)
- (goto-char (ewoc-location elem))
- (re-search-forward "^"))
-
-(defun xetla-log-edit-keywords-next ()
- "Go to the next keyword."
- (interactive)
- (let* ((cookie xetla-log-edit-keywords-cookie)
- (elem (ewoc-locate cookie))
- (next (or (ewoc-next cookie elem) elem)))
- (xetla-log-edit-keywords-cursor-goto next)))
-
-(defun xetla-log-edit-keywords-previous ()
- "Go to the previous keyword."
- (interactive)
- (let* ((cookie xetla-log-edit-keywords-cookie)
- (elem (ewoc-locate cookie))
- (previous (or (ewoc-prev cookie elem) elem)))
- (xetla-log-edit-keywords-cursor-goto previous)))
-
-(defun xetla-log-edit-keywords-mark ()
- "Mark the current keyword."
- (interactive)
- (let ((pos (point)))
- (add-to-list 'xetla-log-edit-keywords-marked-list
- (ewoc-data (ewoc-locate xetla-log-edit-keywords-cookie)))
- (ewoc-refresh xetla-log-edit-keywords-cookie)
- (goto-char pos))
- (xetla-log-edit-keywords-next))
-
-(defun xetla-log-edit-keywords-unmark ()
- "Unmark the current keyword."
- (interactive)
- (let ((pos (point)))
- (setq xetla-log-edit-keywords-marked-list
- (delete (ewoc-data (ewoc-locate xetla-log-edit-keywords-cookie))
- xetla-log-edit-keywords-marked-list))
- (ewoc-refresh xetla-log-edit-keywords-cookie)
- (goto-char pos))
- (xetla-log-edit-keywords-next))
-
-(defun xetla-log-edit-keywords-unmark-all ()
- "Unmark all marked keywords."
- (interactive)
- (let ((pos (point)))
- (setq xetla-log-edit-keywords-marked-list nil)
- (ewoc-refresh xetla-log-edit-keywords-cookie)
- (goto-char pos)))
-
-(defun xetla-log-edit-keywords-mark-all ()
- "Mark all keywords."
- (interactive)
- (let ((pos (point)))
- (setq xetla-log-edit-keywords-marked-list xetla-log-edit-keywords)
- (ewoc-refresh xetla-log-edit-keywords-cookie)
- (goto-char pos)))
-
-(defun xetla-log-edit-keywords-toggle-mark ()
- "Toggle marking of the current keyword."
- (interactive)
- (let ((pos (point)))
- (if (member (ewoc-data (ewoc-locate xetla-log-edit-keywords-cookie))
- xetla-log-edit-keywords-marked-list)
- (xetla-log-edit-keywords-unmark)
- (xetla-log-edit-keywords-mark))
- (ewoc-refresh xetla-log-edit-keywords-cookie)
- (goto-char pos)))
-
-(defun xetla-log-edit-keywords-insert ()
- "Insert marked keywords into log buffer."
- (interactive)
- (let ((keywords xetla-log-edit-keywords-marked-list))
- (switch-to-buffer xetla-log-edit-keywords-log-buffer)
- (kill-buffer " *xetla-log-keywords*")
- (save-excursion
- (xetla-log-goto-keywords)
- (delete-region (point) (point-at-eol))
- (insert (mapconcat 'identity (reverse keywords) ", ")))))
-
-;; --------------------------------------
-;; xetla-archive-list-mode:
-;; --------------------------------------
-(defun xetla-archive-mirror-archive ()
- "Mirror the archive at point."
- (interactive)
- (let ((archive-info (xetla-get-archive-info)))
- (when archive-info
- (xetla-mirror-archive archive-info)
- (xetla-archives))))
-
-(defun xetla-archive-synchronize-archive ()
- "Synchronizes the mirror for the archive at point."
- (interactive)
- (let ((archive-info (xetla-get-archive-info)))
- (when archive-info
- (xetla-archive-mirror archive-info))))
-
-(defun xetla-archive-list-mode ()
- "Major Mode to show arch archives:
-\\{xetla-archive-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map xetla-archive-list-mode-map)
- (easy-menu-add xetla-archive-list-mode-menu)
- (setq major-mode 'xetla-archive-list-mode)
- (setq mode-name "xetla-archives")
-
- (toggle-read-only 1)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'xetla-get-revision-info-at-point-function)
- 'xetla-get-archive-info-at-point)
- (run-hooks 'xetla-archive-list-mode-hook))
-
-(defun xetla-get-archive-info-at-point ()
- "Get archive information."
- (list 'archive (xetla-get-archive-info)))
-
-(defun xetla-archive-select-default ()
- "Select the default archive."
- (interactive)
- (when (xetla-get-archive-info)
- (let ((pos (point)))
- (xetla-my-default-archive (xetla-get-archive-info))
- (xetla-archives)
- (goto-char pos))))
-
-(defun xetla-archive-unregister-archive ()
- "Delete the registration of the selected archive."
- (interactive)
- (let ((archive (xetla-get-archive-info)))
- (if archive
- (progn (xetla-unregister-archive archive t)
- (xetla-archives))
- (error "No archive under the point"))))
-
-(defun xetla-archive-edit-archive-location ()
- "Edit the archive location for a archive.
-This is done by unregistering the archive, followed by a new registration with
-the new location."
- (interactive)
- (let ((archive (xetla-get-archive-info)))
- (xetla-edit-archive-location archive)
- (save-excursion
- (xetla-archives))))
-
-(defun xetla-archive-use-as-default-mirror ()
- "Use the mirror archive as default mirror."
- (interactive)
- (let ((archive (xetla-get-archive-info)))
- (xetla-use-as-default-mirror archive)
- (save-excursion
- (xetla-archives))))
-
-(defun xetla-archive-list-categories ()
- "List the categories for the current archive."
- (interactive)
- (let ((archive (xetla-get-archive-info)))
- (if archive
- (xetla-categories archive)
- (error "No archive under the point"))))
-
-(xetla-make-bymouse-function xetla-archive-list-categories)
-
-(defun xetla-archive-browse-archive ()
- "Browse the current archive."
- (interactive)
- (let ((archive (xetla-get-archive-info)))
- (if archive
- (xetla-browse-archive archive)
- (error "No archive under the point"))))
-
-(defun xetla-archive-next ()
- "Go to the next archive."
- (interactive)
- (forward-line 2)
- (beginning-of-line))
-
-(defun xetla-archive-previous ()
- "Go to the previous archive."
- (interactive)
- (forward-line -2)
- (beginning-of-line))
-
-(defun xetla-save-archive-to-kill-ring ()
- "Save the name of the current archive to the kill ring."
- (interactive)
- (let ((archive (or (xetla-get-archive-info)
- xetla-buffer-archive-name
- (xetla-name-archive (xetla-tree-version-list nil 'no-error)))))
- (unless archive
- (error "No archive name associated with current buffer"))
- (kill-new archive)
- (if (interactive-p)
- (message "%s" archive))
- archive))
-
-;; --------------------------------------
-;; xetla-category-list-mode:
-;; --------------------------------------
-(defun xetla-category-list-mode ()
- "Major Mode to show arch categories:
-\\{xetla-category-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map xetla-category-list-mode-map)
- (easy-menu-add xetla-category-list-mode-menu)
- (setq major-mode 'xetla-category-list-mode)
- (setq mode-name "xetla-category")
- (add-hook 'xetla-make-category-hook 'xetla-category-refresh)
-
- (toggle-read-only 1)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'xetla-get-revision-info-at-point-function)
- 'xetla-get-category-info-at-point)
- (run-hooks 'xetla-category-list-mode-hook))
-
-(defun xetla-get-category-info-at-point ()
- "Get archive/category-branch information."
- (let ((buffer-version (xetla-name-construct
- xetla-buffer-archive-name
- (xetla-get-archive-info 'xetla-category-info))))
- (list 'category buffer-version)))
-
-(defun xetla-category-list-branches ()
- "List branches of the current category."
- (interactive)
- (let ((category (xetla-get-archive-info 'xetla-category-info)))
- (if category
- (xetla-branches xetla-buffer-archive-name category)
- (error "No category under the point"))))
-
-(xetla-make-bymouse-function xetla-category-list-branches)
-
-(defun xetla-category-make-category (category)
- "Create a new category named CATEGORY."
- (interactive "sCategory name: ")
- (xetla-make-category xetla-buffer-archive-name category))
-
-(defun xetla-category-refresh ()
- "Refresh the current category list."
- (interactive)
- (xetla-categories xetla-buffer-archive-name))
-
-(defun xetla-category-next ()
- "Move to the next category."
- (interactive)
- (forward-line 1)
- (beginning-of-line))
-
-(defun xetla-category-previous ()
- "Move to the previous category."
- (interactive)
- (forward-line -1)
- (beginning-of-line)
- (unless (looking-at "^ ")
- (forward-line 1)))
-
-(defun xetla-category-mirror-archive ()
- "Mirror the current category."
- (interactive)
- (let ((category (xetla-get-archive-info 'xetla-category-info)))
- (unless category
- (error "No category at point"))
- (xetla-archive-mirror xetla-buffer-archive-name
- category)))
-
-
-(defun xetla-category-bookmarks-add-here (name)
- "Add a bookmark named NAME for this category."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- (xetla-get-archive-info 'xetla-category-info)
- nil nil nil))
- (message "bookmark %s added." name))
-
-(defun xetla-category-bookmarks-add (name)
- "Add a bookmark named NAME for this category."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name nil nil nil))
- (message "bookmark %s added." name))
-
-;; --------------------------------------
-;; xetla-branch-list-mode
-;; --------------------------------------
-(defun xetla-branch-list-mode ()
- "Major Mode to show arch branches:
-\\{xetla-branch-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map xetla-branch-list-mode-map)
- (easy-menu-add xetla-branch-list-mode-menu)
- (setq major-mode 'xetla-branch-list-mode)
- (setq mode-name "xetla-branch")
- (add-hook 'xetla-make-branch-hook 'xetla-branch-refresh)
-
- (toggle-read-only 1)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'xetla-get-revision-info-at-point-function)
- 'xetla-get-branch-info-at-point)
- (run-hooks 'xetla-branch-list-mode-hook))
-
-(defun xetla-get-branch-info-at-point ()
- "Get archive/category-branch-version information."
- (let ((buffer-version (xetla-name-construct
- xetla-buffer-archive-name
- xetla-buffer-category-name
- (xetla-get-archive-info 'xetla-branch-info))))
- (list 'branch buffer-version)))
-
-(defun xetla-branch-make-branch (branch)
- "Create a new branch named BRANCH."
- (interactive "sBranch name: ")
- (xetla-make-branch xetla-buffer-archive-name
- xetla-buffer-category-name
- branch))
-
-(defun xetla-branch-refresh ()
- "Refresh the current branch list."
- (interactive)
- (xetla-branches
- xetla-buffer-archive-name
- xetla-buffer-category-name))
-
-(defun xetla-branch-list-parent-category ()
- "List the parent category of the current branch."
- (interactive)
- (xetla-categories xetla-buffer-archive-name))
-
-(defun xetla-branch-list-versions ()
- "List the versions of the current branch."
- (interactive)
- (let ((branch (xetla-get-archive-info 'xetla-branch-info)))
- (if branch
- (xetla-versions xetla-buffer-archive-name
- xetla-buffer-category-name
- branch)
- (error "No branch under the point"))))
-
-(xetla-make-bymouse-function xetla-branch-list-versions)
-
-(defun xetla-branch-mirror-archive ()
- "Mirror the current branch."
- (interactive)
- (let ((branch (xetla-get-archive-info 'xetla-branch-info)))
- (unless branch
- (error "No branch under the point"))
- (xetla-archive-mirror xetla-buffer-archive-name
- xetla-buffer-category-name
- branch)))
-
-(defun xetla-branch-get-branch (directory)
- "Get the current branch and place it in DIRECTORY."
- (interactive (list (expand-file-name
- (read-directory-name
- (format "Restore \"%s\" to: "
- (let ((branch
- (xetla-get-archive-info 'xetla-branch-info)))
- (unless branch
- (error "No branch under the point"))
- (xetla-name-construct
- xetla-buffer-archive-name
- xetla-buffer-category-name
- branch)))))))
- (let ((branch (xetla-get-archive-info 'xetla-branch-info)))
- (if branch
- (xetla-get directory
- t
- xetla-buffer-archive-name
- xetla-buffer-category-name
- branch)
- (error "No branch under the point"))))
-
-(defun xetla-branch-bookmarks-add-here (name)
- "Add a bookmark named NAME for the current branch."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- xetla-buffer-category-name
- (xetla-get-archive-info 'xetla-branch-info)
- nil nil))
- (message "bookmark %s added." name))
-
-(defun xetla-branch-bookmarks-add (name)
- "Add a bookmark named NAME for the current branch."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- xetla-buffer-category-name
- nil nil nil))
- (message "bookmark %s added." name))
-
-
-
-
-;; --------------------------------------
-;; xetla-version-list-mode
-;; --------------------------------------
-(defun xetla-version-list-mode ()
- "Major Mode to show arch versions:
-\\{xetla-version-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (use-local-map xetla-version-list-mode-map)
- (easy-menu-add xetla-version-list-mode-menu)
- (setq major-mode 'xetla-version-list-mode)
- (setq mode-name "xetla-version")
- (add-hook 'xetla-make-version-hook 'xetla-version-refresh)
-
- (toggle-read-only 1)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'xetla-get-revision-info-at-point-function)
- 'xetla-get-version-info-at-point)
- (run-hooks 'xetla-version-list-mode-hook))
-
-(defun xetla-get-version-info-at-point ()
- "Get archive/category-branch-version-revision information."
- (let ((buffer-version (xetla-name-construct
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- (xetla-get-archive-info 'xetla-version-info))))
- (list 'version buffer-version)))
-
-(defun xetla-version-refresh ()
- "Refresh the current version list."
- (interactive)
- (xetla-versions
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name))
-
-(defun xetla-version-list-parent-branch ()
- "List the parent branch of this version."
- (interactive)
- (xetla-branches xetla-buffer-archive-name
- xetla-buffer-category-name))
-
-(defun xetla-version-list-revisions ()
- "List the revisions of this version."
- (interactive)
- (let ((version (xetla-get-archive-info 'xetla-version-info)))
- (if version
- (xetla-revisions xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- version)
- (error "No version under the point"))))
-
-(xetla-make-bymouse-function xetla-version-list-revisions)
-
-(defun xetla-version-make-version (version)
- "Create a new version named VERSION."
- (interactive "sVersion name: ")
- (xetla-make-version xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- version))
-
-(defun xetla-version-bookmarks-add-here (name)
- "Add a bookmark named NAME for the current version."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- (xetla-get-archive-info 'xetla-version-info)
- nil))
- (message "bookmark %s added." name))
-
-(defun xetla-version-bookmarks-add (name)
- "Add a bookmark named NAME for the current version."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- nil nil))
- (message "bookmark %s added." name))
-
-(defun xetla-version-get-version (directory)
- "Get a version and place it in DIRECTORY."
- (interactive (list (expand-file-name
- (read-directory-name
- (format "Restore \"%s\" to: "
- (let ((version
- (xetla-get-archive-info 'xetla-version-info)))
- (unless version
- (error "No version under the point"))
- (xetla-name-construct
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- version)))))))
- (let ((version (xetla-get-archive-info 'xetla-version-info)))
- (if version
- (xetla-get directory
- t
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- version)
- (error "No version under the point"))))
-
-
-(defun xetla-version-mirror-archive ()
- "Mirror the current version."
- (interactive)
- (let ((version (xetla-get-archive-info 'xetla-version-info)))
- (if version
- (xetla-archive-mirror xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- version))))
-
-(defun xetla-version-tag (to-archive to-category to-branch to-version)
- "Run tla tag from the current location in version buffer.
-The tag is created in TO-ARCHIVE/TO-CATEGORY-TO-BRANCH-TO-VERSION."
- (interactive
- (let ((l (xetla-name-read "Tag to: " 'prompt 'prompt 'prompt 'prompt)))
- (list
- (xetla-name-archive l)
- (xetla-name-category l)
- (xetla-name-branch l)
- (xetla-name-version l))))
- (let ((to-fq (xetla-name-construct to-archive
- to-category
- to-branch
- to-version))
- from-fq
- (from-version (xetla-get-archive-info 'xetla-version-info)))
- (unless from-version
- (error "No version under the point"))
- (setq from-fq (xetla-name-construct
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- from-version))
- (xetla-version-tag-internal from-fq to-fq)))
-
-
-(defun xetla-version-tag-internal (from-fq to-fq &optional synchronously)
- "Create a tag from FROM-FQ to TO-FQ.
-If SYNCHRONOUSLY is non-nil, internal `xetla-get' runs synchronously.
-Else it runs asynchronously."
- (when (yes-or-no-p (format "Create a tag from `%s' to `%s'? " from-fq to-fq))
- (unless (xetla-tag from-fq to-fq)
- (error "Fail to create a tag"))
- (when (y-or-n-p "Tag created. Get a copy of this revision? ")
- (let* ((prompt "Get a copy in: ")
- dir parent
- to-fq-split)
- (while (not dir)
- (setq dir (read-directory-name prompt dir)
- parent (expand-file-name
- (concat (file-name-as-directory dir) "..")))
- (cond
- ;; Parent directoy must be.
- ((not (file-directory-p parent))
- (message "`%s' is not directory" parent)
- (sit-for 2)
- (setq dir nil))
- ;; dir itself must not be.
- ((file-exists-p dir)
- (message "`%s' exists already" dir)
- (sit-for 2)
- (setq dir nil))))
- (setq to-fq-split (xetla-name-split to-fq))
- (xetla-get dir 'ask
- (nth 0 to-fq-split)
- (nth 1 to-fq-split)
- (nth 2 to-fq-split)
- (nth 3 to-fq-split)
- (nth 4 to-fq-split)
- synchronously)))))
-
-;; --------------------------------------
-;; xetla-revision-list-mode
-;; --------------------------------------
-(defun xetla-revision-list-mode ()
- "Major Mode to show arch revisions:
-\\{xetla-revision-list-mode-map}"
- (interactive)
- (kill-all-local-variables)
- (toggle-read-only -1)
- (use-local-map xetla-revision-list-mode-map)
- (easy-menu-add xetla-revision-list-mode-menu)
- (setq major-mode 'xetla-revision-list-mode)
- (setq mode-name "xetla-revision")
- (add-hook 'xetla-make-revision-hook 'xetla-revision-refresh)
- (erase-buffer)
- (set (make-local-variable 'xetla-revision-list-cookie)
- (ewoc-create 'xetla-revision-list-printer))
- (toggle-read-only 1)
- (set-buffer-modified-p nil)
- (set (make-local-variable 'xetla-get-revision-info-at-point-function)
- 'xetla-get-revision-info-at-point)
- (setq mode-line-process 'xetla-mode-line-process)
- (run-hooks 'xetla-revision-list-mode-hook))
-
-(defun xetla-get-revision-info-at-point ()
- "Get archive/category-branch-version-revision-patch information.
-Returns nil if not on a revision list, or not on a revision entry in a
-revision list."
- (let ((elem (ewoc-data (ewoc-locate xetla-revision-list-cookie))))
- (when (eq (car elem) 'entry-patch)
- (let* ((full (xetla-revision-revision (caddr elem)))
- (buffer-revision (xetla-name-construct full)))
- (list 'revision buffer-revision)))))
-
-(defun xetla-revision-refresh ()
- "Refresh the current list of revisions."
- (interactive)
- (xetla-revisions
- xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- xetla-buffer-version-name))
-
-(defun xetla-revision-list-parent-version ()
- "List the versions of the parent of this revision."
- (interactive)
- (xetla-versions xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name))
-
-(defun xetla-revision-get-revision (directory archive category branch
- version revision)
- "Get a revision and place it in DIRECTORY.
-The revision is named by ARCHIVE/CATEGORY-BRANCH-VERSION-REVISION."
- (interactive
- (let* ((elem (ewoc-data (ewoc-locate xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem)))
- (revision (xetla-name-revision full))
- (archive (xetla-name-archive full))
- (category (xetla-name-category full))
- (branch (xetla-name-branch full))
- (version (xetla-name-version full))
- dir)
- (unless revision
- (error "No revision under the point"))
- (setq dir (expand-file-name
- (read-directory-name
- (format "Restore \"%s\" to: "
- (xetla-name-construct
- archive category branch version revision)))))
- (if (file-exists-p dir)
- (error "Directory %s already exists" dir))
- (list dir archive category branch version revision)))
- (if revision
- (xetla-get directory t archive category branch version revision)
- (error "No revision under the point")))
-
-(defun xetla-revision-cache-revision (archive category branch version revision)
- "Create a cached revision for the revision at point."
- (interactive
- (let* ((elem (ewoc-data (ewoc-locate xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem)))
- (archive (xetla-name-archive full))
- (category (xetla-name-category full))
- (branch (xetla-name-branch full))
- (version (xetla-name-version full))
- (revision (xetla-name-revision full)))
- (unless revision
- (error "No revision under the point"))
- (list archive category branch version revision)))
- (if revision
- (xetla-cache-revision archive category branch version revision)
- (error "No revision under the point")))
-
-(defun xetla-revision-add-to-library (archive category branch version revision)
- "Add the revision at point to library."
- (interactive
- (let* ((elem (ewoc-data (ewoc-locate xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem)))
- (archive (xetla-name-archive full))
- (category (xetla-name-category full))
- (branch (xetla-name-branch full))
- (version (xetla-name-version full))
- (revision (xetla-name-revision full)))
- (unless revision
- (error "No revision under the point"))
- (list archive category branch version revision)))
- (if revision
- (xetla-library-add archive category branch version revision)
- (error "No revision under the point")))
-
-(defun xetla-revision-maybe-refresh ()
- "Refresh the revision list if new information is available.
-If the current ewoc doesn't contain creator, date, and summary, and
-if these values should now be displayed, run the refresh function."
- (when (or xetla-revisions-shows-date
- xetla-revisions-shows-creator
- xetla-revisions-shows-summary
- xetla-revisions-shows-merges
- xetla-revisions-shows-merged-by)
- (let ((stop nil)
- (ewoc-elem (ewoc-nth xetla-revision-list-cookie 0)))
- (while (and ewoc-elem (not stop))
- (let ((elem (ewoc-data ewoc-elem)))
- (if (eq (car elem) 'entry-patch)
- (setq stop t)
- (setq ewoc-elem (ewoc-next xetla-revision-list-cookie
- ewoc-elem)))))
- (when (and ewoc-elem
- (null (xetla-revision-summary (caddr (ewoc-data ewoc-elem)))))
- (xetla-generic-refresh)))))
-
-(defun xetla-revision-toggle-date ()
- "Toggle display of the date in the revision list."
- (interactive)
- (setq xetla-revisions-shows-date (not xetla-revisions-shows-date))
- (xetla-revision-maybe-refresh)
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-toggle-summary ()
- "Toggle display of the summary information in the revision list."
- (interactive)
- (setq xetla-revisions-shows-summary (not xetla-revisions-shows-summary))
- (xetla-revision-maybe-refresh)
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-toggle-creator ()
- "Toggle display of the creator in the revision list."
- (interactive)
- (setq xetla-revisions-shows-creator (not xetla-revisions-shows-creator))
- (xetla-revision-maybe-refresh)
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-toggle-library ()
- "Toggle display of the revision library in the revision list."
- (interactive)
- (setq xetla-revisions-shows-library (not xetla-revisions-shows-library))
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-toggle-merges ()
- "Toggle display of the merges in the revision list."
- (interactive)
- (setq xetla-revisions-shows-merges (not xetla-revisions-shows-merges))
- (xetla-revision-maybe-refresh)
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-toggle-merged-by ()
- "Toggle display of merged-by in the revision list."
- (interactive)
- (setq xetla-revisions-shows-merged-by
- (not xetla-revisions-shows-merged-by))
- (when (and (not xetla-revision-merge-by-computed)
- xetla-revisions-shows-merged-by)
- (xetla-revision-maybe-refresh)
- (xetla-revision-compute-merged-by))
- (ewoc-refresh xetla-revision-list-cookie))
-
-(defun xetla-revision-changeset (arg)
- "Gets and display the changeset at point in a revision list buffer.
-If used with a prefix arg ARG, don't include the diffs from the output."
- (interactive "P")
- (let* ((cookie xetla-revision-list-cookie)
- (full (xetla-revision-revision
- (caddr (ewoc-data (ewoc-locate cookie)))))
- (revision (xetla-name-construct full)))
- (xetla-get-changeset revision t nil arg)))
-
-(defun xetla-revision-store-delta (across-versions)
- "Store a delta between two marked revisions.
-If prefix argument ACROSS-VERSIONS is given, read revision details from the
-user."
- (interactive "P")
- (xetla-revision-delta across-versions t))
-
-(defun xetla-revision-delta (across-versions &optional stored-to-directory)
- "Run tla delta from marked revision to revision at point.
-If prefix-argument ACROSS-VERSIONS is nil, read a revision
-in the current version. If ACROSS-VERSIONS is non-nil, read an archive,
-a category, a branch, a version, and a revision to specify the revision.
-If STORED-TO-DIRECTORY is nil, ask the user whether the changeset is stored
-to or not. If STORED-TO-DIRECTORY is non-nil, don't ask the use and the
-changeset is stored."
- (interactive "P")
- (let* ((modified
- (xetla-revision-revision
- (caddr (ewoc-data (ewoc-locate xetla-revision-list-cookie)))))
- (modified-fq (xetla-name-construct modified))
- (base
- (let ((marked (xetla-revision-marked-revisions)))
- (when (< 1 (length marked))
- (error "Delta can be run against one marked revision as the base revision"))
- (cond ((and marked (null (cdr marked)))
- ;; use the marked revision
- ;; (xetla-revision-unmark-all)
- (xetla-revision-revision (car marked)))
- (t
- (xetla-name-read
- (format "Revision for delta to %s from: "
- (if across-versions
- modified-fq
- (xetla-name-revision modified)))
- (if across-versions 'prompt (xetla-name-archive modified))
- (if across-versions 'prompt (xetla-name-category modified))
- (if across-versions 'prompt (xetla-name-branch modified))
- (if across-versions 'prompt (xetla-name-version modified))
- 'maybe))))))
-
- (unless (xetla-name-archive base)
- (error "Archive for the base is not specified"))
- (unless (xetla-name-category base)
- (error "Cateogory for the base is not specified"))
- (unless (xetla-name-branch base)
- (error "Branch for the base is not specified"))
- (unless (xetla-name-version base)
- (error "Version for the base is not specified"))
- (unless (xetla-name-revision base)
- ;; No revision for modified is specified.
- ;; Use HEAD revision.
- (setcar (nthcdr 4 base)
- (xetla-version-head
- (xetla-name-archive base)
- (xetla-name-category base)
- (xetla-name-branch base)
- (xetla-name-version base))))
-
- (when (or stored-to-directory
- (and (not stored-to-directory)
- (y-or-n-p "Store the delta to a directory? ")))
- (setq stored-to-directory 'ask))
-
- (xetla-delta (xetla-name-construct base)
- modified-fq
- stored-to-directory)))
-
-(defun xetla-revision-bookmarks-add (name)
- "Add a bookmark named NAME for the current revision."
- (interactive "sBookmark name: ")
- (xetla-bookmarks-add name
- (list xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- xetla-buffer-version-name
- nil))
- (message "bookmark %s added." name))
-
-(defun xetla-revision-sync-tree (arg)
- "Unify a tree's patch log with the current revision.
-With prefix argument ARG, use the latest version instead."
- (interactive "P")
- (let* ((last-inventory (xetla-last-visited-inventory-buffer))
- (local-tree (or (if last-inventory
- (with-current-buffer last-inventory
- default-directory)
- default-directory)))
- (current (ewoc-locate xetla-revision-list-cookie)))
- (while (and current
- (not (and (eq (car (ewoc-data current))
- 'separator)
- (eq (caddr (ewoc-data current))
- 'bookmark))))
- (setq current (ewoc-prev xetla-revision-list-cookie current)))
- (when (and current
- (eq (car (ewoc-data current)) 'separator)
- (eq (caddr (ewoc-data current)) 'bookmark))
- (setq local-tree (cadddr (ewoc-data current))))
- (let ((to-tree (read-directory-name "Sync with tree: " local-tree)))
- (let* ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem))))
- (xetla-sync-tree (xetla-name-construct
- (if arg (butlast full) full))
- to-tree)))))
-
-(defun xetla-revision-star-merge-version ()
- "Run star-merge for the version at point."
- (interactive)
- (xetla-revision-star-merge t))
-
-(defun xetla-revision-star-merge (arg)
- "Run star-merge from the revision at point.
-With prefix argument ARG, merge all missing revisions from this version."
- (interactive "P")
- (let* ((last-inventory (xetla-last-visited-inventory-buffer))
- (local-tree (or (if last-inventory
- (with-current-buffer last-inventory
- default-directory)
- default-directory)))
- (current (ewoc-locate xetla-revision-list-cookie)))
- (while (and current
- (not (and (eq (car (ewoc-data current))
- 'separator)
- (eq (caddr (ewoc-data current))
- 'bookmark))))
- (setq current (ewoc-prev xetla-revision-list-cookie current)))
- (when (and current
- (eq (car (ewoc-data current)) 'separator)
- (eq (caddr (ewoc-data current)) 'bookmark))
- (setq local-tree (cadddr (ewoc-data current))))
- (let ((to-tree (read-directory-name "Merge to tree: "
- local-tree)))
- (let* ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem))))
- (xetla-star-merge (xetla-name-construct
- (if arg (butlast full) full))
- to-tree)))))
-
-(defun xetla-revision-replay-version ()
- "Call `xetla-revision-replay' with a prefix arg."
- (interactive)
- (xetla-revision-replay t))
-
-(defun xetla-revision-replay (arg)
- "Run replay from the current location.
-If there are marked revisions, these are replayed.
-Otherwise, if an argument ARG is given, all missing
-revisions from this version are replayed. If there are no marked
-revisions and no argument is given, the revision under the point
-is replayed."
- (interactive "P")
- (let* ((last-inventory (xetla-last-visited-inventory-buffer))
- (local-tree (or (if last-inventory
- (with-current-buffer last-inventory
- default-directory)
- default-directory)))
- (current (ewoc-locate xetla-revision-list-cookie)))
- (while (and current
- (not (and (eq (car (ewoc-data current))
- 'separator)
- (eq (caddr (ewoc-data current))
- 'bookmark))))
- (setq current (ewoc-prev xetla-revision-list-cookie current)))
- (when (and current
- (eq (car (ewoc-data current)) 'separator)
- (eq (caddr (ewoc-data current)) 'bookmark))
- (setq local-tree (cadddr (ewoc-data current))))
- (let ((to-tree (read-directory-name "Replay to tree: " local-tree)))
- (if (xetla-revision-marked-revisions)
- (let ((revisions (mapcar 'xetla-revision-revision
- (xetla-revision-marked-revisions))))
- (xetla-replay (sort (mapcar (lambda (revision)
- (xetla-name-construct
- revision))
- revisions)
- 'string<)
- to-tree))
- (let* ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem))))
- (xetla-replay (xetla-name-construct
- (if arg (butlast full) full))
- to-tree))))))
-
-(defun xetla-revision-mark-revision ()
- "Mark revision at point."
- (interactive)
- (let ((pos (point))
- (data (ewoc-data (ewoc-locate
- xetla-revision-list-cookie))))
- (setcar (cdr data) t)
- (ewoc-refresh xetla-revision-list-cookie)
- (goto-char pos)
- (xetla-revision-next)))
-
-(defun xetla-revision-marked-revisions ()
- "Return the revisions that are currently marked."
- (let ((acc '()))
- (ewoc-map #'(lambda (x) (when (and (eq (car x) 'entry-patch)
- (cadr x))
- (push (caddr x) acc)))
- xetla-revision-list-cookie)
- (nreverse acc)))
-
-(defun xetla-revision-unmark-revision ()
- "Unmark the revision at point."
- (interactive)
- (let ((pos (point))
- (data (ewoc-data (ewoc-locate
- xetla-revision-list-cookie))))
- (setcar (cdr data) nil)
- (ewoc-refresh xetla-revision-list-cookie)
- (goto-char pos)
- (xetla-revision-next)))
-
-(defun xetla-revision-unmark-all ()
- "Unmark all revisions."
- (interactive)
- (let ((pos (point)))
- (ewoc-map #'(lambda (x) (when (and (eq (car x) 'entry-patch)
- (cadr x))
- (setcar (cdr x) nil)))
- xetla-revision-list-cookie)
- (ewoc-refresh xetla-revision-list-cookie)
- (goto-char pos)))
-
-(defun xetla-revision-tag-from-head ()
- "Run tla tag from the newest revision in revision buffer."
- (interactive)
- (let* ((from (when xetla-buffer-archive-name
- (xetla-name-construct xetla-buffer-archive-name
- xetla-buffer-category-name
- xetla-buffer-branch-name
- xetla-buffer-version-name))))
- (unless from (error "No head revision"))
- (xetla-revision-tag-internal from)))
-
-(defun xetla-revision-tag-from-here ()
- "Run tla tag from the current location in revision buffer."
- (interactive)
- (let ((from (when xetla-revision-list-cookie
- (let* ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie))))
- (apply 'xetla-name-construct (aref (caddr elem) 1))))))
- (unless from (error "No revision here"))
- (xetla-revision-tag-internal from)))
-
-(defun xetla-revision-tag-internal (from-fq)
- "Tag from FROM-FQ to some destination."
- (let* ((to (xetla-name-read "Tag to: "
- 'prompt 'prompt 'prompt 'prompt))
- (to-fq (xetla-name-construct to)))
- (xetla-version-tag-internal from-fq to-fq)))
-
-(defun xetla-revision-show-changeset ()
- "Show a changeset for the current revision."
- (interactive)
- (let ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie))))
- (case (car elem)
- (entry-patch (xetla-revision-cat-log))
- (entry-change (let ((default-directory (caddr elem)))
- (xetla-changes))))))
-
-(xetla-make-bymouse-function xetla-revision-show-changeset)
-
-(defun xetla-revision-cat-log ()
- "Show the log entry for the revision at point."
- (interactive)
- (let* ((elem (ewoc-data (ewoc-locate
- xetla-revision-list-cookie)))
- (full (xetla-revision-revision (caddr elem)))
- (cur-buf (current-buffer))
- (log-buf (xetla-cat-log-any full))
- (display-buf (xetla-get-buffer-create 'cat-log
- (xetla-name-construct full))))
- (xetla-switch-to-buffer display-buf)
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (with-current-buffer log-buf
- (buffer-string)))
- (goto-char (point-min)))
- (xetla-cat-log-mode)
- (when (eq xetla-switch-to-buffer-mode 'pop-to-buffer)
- (pop-to-buffer cur-buf))))
-
-(defun xetla-revision-update ()
- "Run tla update for this revision."
- (interactive)
- (let ((local-tree default-directory) ;; Default value
- (current (ewoc-locate xetla-revision-list-cookie)))
- (while (and current
- (not (and (eq (car (ewoc-data current))
- 'separator)
- (eq (caddr (ewoc-data current))
- 'bookmark))))
- (setq current (ewoc-prev xetla-revision-list-cookie current)))
- (when (and current
- (eq (car (ewoc-data current)) 'separator)
- (eq (caddr (ewoc-data current)) 'bookmark))
- (setq local-tree (cadddr (ewoc-data current))))
- (let ((buffer (current-buffer)))
- (xetla-update (read-directory-name "Update tree: "
- local-tree)
- `(lambda ()
- (pop-to-buffer ,buffer)
- (xetla-generic-refresh))))))
-
-(defcustom xetla-send-comments-width 25
- "*Max length for the summary line when using %t in `xetla-send-comments-format'.")
-
-(defcustom xetla-send-comments-format "Your patch %c--%b--%v--%r (%t)"
- "Format for the Subject line for `xetla-revision-send-comments'.
-
-The following substring will be substituted:
-
-%f: Full revision name
-%a: The archive name
-%c: The category name
-%b: The branch name
-%v: The version name
-%r: The revision name
-%s: The summary line
-%t: The summary line, truncated to `xetla-send-comments-width'
-characters.")
-
-(defun xetla-revision-send-comments (revision)
- "Sends comments to the author of REVISION.
-
-The email is extracted from the archive name. A new mail message is
-opened with a description of the revision. REVISION must be the same
-structure as the elem of `xetla-revision-list-cookie'.
-
-When called interactively, REVISION is the revision at point."
- (interactive (list (caddr (ewoc-data (ewoc-locate xetla-revision-list-cookie)))))
- (let* ((full-rev (xetla-revision-revision revision))
- (archive (xetla-name-archive full-rev))
- (email (progn (string-match "\\(.*\\)--\\([^-]\\|-[^-]\\)"
- archive)
- (match-string 1 archive)))
- (summary (xetla-revision-summary revision))
- (subject xetla-send-comments-format))
- (dolist (pair '(("%f" . (xetla-name-construct full-rev))
- ("%a" . archive)
- ("%c" . (xetla-name-category full-rev))
- ("%b" . (xetla-name-branch full-rev))
- ("%v" . (xetla-name-version full-rev))
- ("%r" . (xetla-name-revision full-rev))
- ("%s" . summary)
- ("%t" . (if (> (string-width summary)
- xetla-send-comments-width)
- (concat (truncate-string summary 25)
- "...")
- summary))))
- (setq subject
- (replace-regexp-in-string (car pair) (eval (cdr pair))
- subject)))
- (compose-mail email subject)
- (save-excursion
- (insert "\n\n" (xetla-name-construct full-rev) "\n"
- " " summary "\n"
- " " (xetla-revision-date revision) "\n"
- " " (xetla-revision-creator revision) "\n"))))
-
-;; --------------------------------------
-;; xetla-changes-mode
-;; --------------------------------------
-(define-derived-mode xetla-changes-mode fundamental-mode "xetla-changes"
- "Major mode to display changesets. Derives from `diff-mode'.
-
-Use '\\<xetla-changes-mode-map>\\[xetla-changes-mark-file]' to mark files, and '\\[xetla-changes-unmark-file]' to unmark.
-If you commit from this buffer (with '\\[xetla-changes-edit-log]'), then, the list of selected
-files in this buffer at the time you actually commit with
-\\<xetla-log-edit-mode-map>\\[xetla-log-edit-done].
-
-Commands:
-\\{xetla-changes-mode-map}
-"
- (let ((diff-mode-shared-map (copy-keymap xetla-changes-mode-map))
- major-mode mode-name)
- (diff-mode))
-
- (set (make-local-variable 'font-lock-defaults)
- (list 'xetla-changes-font-lock-keywords t nil nil))
- (font-lock-mode)
- (set (make-local-variable 'xetla-get-file-info-at-point-function)
- 'xetla-changes-get-file-at-point)
- (set (make-local-variable 'xetla-buffer-refresh-function)
- 'xetla-changes-generic-refresh)
- (set (make-local-variable 'xetla-changes-cookie)
- (ewoc-create 'xetla-changes-printer))
- (make-local-variable 'xetla-buffer-marked-file-list)
- (easy-menu-add xetla-changes-mode-menu)
- (toggle-read-only 1)
- (set-buffer-modified-p nil))
-
-(defun xetla-changes-generic-refresh ()
- "Refresh the changes buffer."
- (interactive)
- (if (eq (car xetla-changes-modified) 'local-tree)
- (xetla-changes xetla-changes-summary xetla-changes-base)))
-
-(defun xetla-changes-jump-to-change (&optional other-file)
- "Jump to the corresponding file and location of the change.
-The prefix argument OTHER-FILE controls whether the original or new
-file is visited."
- (interactive "P")
- (let* ((elem (ewoc-locate xetla-changes-cookie))
- (data (ewoc-data elem)))
- (cond ((< (ewoc-location elem) (point-at-bol))
- (xetla-changes-diff-goto-source other-file))
- ((eq (car data) 'file)
- (find-file (cadr data)))
- ((eq (car data) 'subtree)
- (xetla-switch-to-buffer (cadr data)))
- (t (error "Not on a recognized location")))))
-
-(defun xetla-changes-diff-goto-source (other-file)
- "Almost the same as `diff-goto-source'.
-But the target file is transformed by `xetla-changes-what-changed-original-file'
-to handle files in what-changed directory.
-OTHER-FILE controls whether the original or new file is visited."
- (let ((xetla-original-file-exists-p (symbol-function
- 'file-exists-p))
- (xetla-original-find-file-noselect (symbol-function
- 'find-file-noselect)))
- (flet ((file-exists-p (file)
- (unless (string= "/dev/null" file)
- (funcall
- xetla-original-file-exists-p
- (xetla-changes-what-changed-original-file file))))
- (find-file-noselect (file &optional nowarn rawfile wildcards)
- (if (featurep 'xemacs)
- (funcall xetla-original-find-file-noselect
- (xetla-changes-what-changed-original-file file)
- nowarn rawfile)
- (funcall xetla-original-find-file-noselect
- (xetla-changes-what-changed-original-file file)
- nowarn rawfile wildcards))))
- (diff-goto-source other-file))))
-
-(defun xetla-changes-what-changed-original-file (file)
- "Remove what-changed directory part from FILE and return it."
- (if (string-match
- "\\(/,,what-changed[^/]+/new-files-archive\\)"
- file)
- (concat (substring file 0 (match-beginning 1))
- (substring file (match-end 1)))
- file))
-
-(defun xetla-changes-diff-or-list ()
- "Move around the changes buffer.
-When in the list part of the buffer, jump to the corresponding
-patch. When on a patch, jump to the corresponding entry in the list of
-files."
- (interactive)
- (let* ((elem (ewoc-locate xetla-changes-cookie))
- (data (ewoc-data elem)))
- (cond ((< (ewoc-location elem) (point-at-bol))
- (let ((file (xetla-changes-get-file-at-point))
- (elem (ewoc-nth xetla-changes-cookie 0)))
- (while (and elem
- (or (not (eq (car (ewoc-data elem)) 'file))
- (not (string= (expand-file-name
- (cadr (ewoc-data elem)))
- file))))
- (setq elem (ewoc-next xetla-changes-cookie elem)))
- (if elem (goto-char (ewoc-location elem))
- (error (format "Can't find file %s in list" file)))
- ))
- ((eq (car data) 'file)
- (re-search-forward (concat "^--- orig/" (cadr data)))
- (diff-hunk-next))
- ((eq (car data) 'subtree)
- (xetla-switch-to-buffer (cadr data)))
- (t (error "Not on a recognized location")))))
-
-(defun xetla-changes-master-buffer ()
- "Jump to the master *xetla-changes* buffer for a nested changes buffer."
- (interactive)
- (unless xetla-changes-buffer-master-buffer
- (error "No master buffer"))
- (xetla-switch-to-buffer xetla-changes-buffer-master-buffer))
-
-(defun xetla-flash-line-on ()
- "Turn on highline mode or equivalent."
- (or (xetla-funcall-if-exists hl-line-mode)
- (xetla-funcall-if-exists highline-on)))
-
-(defun xetla-flash-line-off ()
- "Turn off highline mode or equivalent."
- (or (xetla-funcall-if-exists hl-line-mode)
- (xetla-funcall-if-exists highline-off)))
-
-(defun xetla-flash-line ()
- "Flash the current line."
- (let ((buffer (current-buffer)))
- (xetla-flash-line-on)
- (sit-for 1000)
- ;; Avoid to switching buffer by asynchronously running
- ;; processes.
- ;; TODO: This is adhoc solution. Something guard-mechanism to avoid
- ;; buffer switching may be needed.
- (set-buffer buffer)
- (xetla-flash-line-off)))
-
-(defun xetla-changes-view-source (&optional other-file)
- "Show the corresponding file and location of the change.
-This function does not switch to the file, but it places the cursor
-temporarily at the location of the change and will stay in the changes
-buffer. Thus you can quickly see more context on a specific change without
-switching buffers.
-The prefix argument OTHER-FILE controls whether the original or new
-file is visited."
- (interactive "P")
- (let ((diff-window (selected-window)))
- (save-excursion
- (diff-goto-source other-file)
- (recenter)
- (xetla-flash-line)
- (select-window diff-window))))
-
-(defun xetla-changes-edit-log (&optional insert-changelog)
- "Wrapper around `xetla-edit-log', setting the source buffer to current
-buffer."
- (interactive "P")
- (xetla-edit-log insert-changelog (current-buffer)))
-
-(defun xetla-changes-rm ()
- "Remove the file under point."
- (interactive)
- (let ((file (xetla-get-file-info-at-point)))
- (unless file
- (error "No file at point"))
- (xetla-rm file)))
-
-(defun xetla-changes-mark-file ()
- "Mark the file under point."
- (interactive)
- (let ((current (ewoc-locate xetla-changes-cookie))
- (file (xetla-get-file-info-at-point)))
- (add-to-list 'xetla-buffer-marked-file-list file)
- (ewoc-refresh xetla-changes-cookie)
- (goto-char (ewoc-location (or (ewoc-next xetla-changes-cookie
- current)
- current)))))
-
-(defun xetla-changes-unmark-file ()
- "Unmark the file under point."
- (interactive)
- (let ((current (ewoc-locate xetla-changes-cookie))
- (file (xetla-get-file-info-at-point)))
- (setq xetla-buffer-marked-file-list
- (delete file xetla-buffer-marked-file-list))
- (ewoc-refresh xetla-changes-cookie)
- (goto-char (ewoc-location (or (ewoc-next xetla-changes-cookie
- current)
- current)))))
-
-(defun xetla-changes-diff ()
- "Run tla file-diff on the file at point in *xetla-changes*."
- (interactive)
- (let ((on-modified-file (xetla-get-file-info-at-point)))
- (if on-modified-file
- (xetla-file-diff on-modified-file)
- (error "Not on a modified file"))))
-
-(defun xetla-changes-next ()
- "Move to the next changes."
- (interactive)
- (let ((cur-location (ewoc-location (ewoc-locate xetla-changes-cookie)))
- (next (ewoc-next xetla-changes-cookie
- (ewoc-locate xetla-changes-cookie))))
- (cond
- ((> cur-location (point))
- (goto-char cur-location))
- (next
- (goto-char (ewoc-location next)))
- (t
- (diff-hunk-next)))))
-
-(defun xetla-changes-prev ()
- "Move to the previous changes."
- (interactive)
- (let* ((current (ewoc-locate xetla-changes-cookie))
- (cur-location (ewoc-location current))
- (prev (ewoc-prev xetla-changes-cookie current))
- (next (ewoc-next xetla-changes-cookie current)))
- (cond (next
- (if prev (goto-char (ewoc-location prev))
- (goto-char cur-location)))
- ((condition-case nil (progn (diff-hunk-prev) t) (error nil)))
- ((> (point-at-bol) cur-location)
- (goto-char cur-location))
- (prev
- (goto-char (ewoc-location prev)))
- (t
- (goto-char cur-location)))
- ))
-
-(defun xetla-changes-in-diff ()
- "Return t if cursor is in the diffs section of the changes buffer."
- (save-excursion (re-search-backward "^--- orig" nil t)))
-
-
-(defun xetla-changes-ediff (&optional other-file)
- "Run ediff on the current changes.
-The prefix argument OTHER-FILE controls whether the original or new
-file is visited."
- (interactive "P")
- (unless (and (car xetla-changes-base)
- (car xetla-changes-base))
- (error "No revision information to base ediff on"))
- (let ((on-modified-file (xetla-get-file-info-at-point))
- (loc (point)))
- (if (and on-modified-file (not (xetla-changes-in-diff)))
- (xetla-file-ediff-revisions on-modified-file
- xetla-changes-base
- xetla-changes-modified)
- (re-search-backward "^--- orig/")
- (re-search-forward "^--- orig/")
- (let ((file (expand-file-name
- (concat (file-name-as-directory default-directory)
- (buffer-substring-no-properties (point)
- (point-at-eol)))))
- (hunk 1))
- (diff-hunk-next)
- (while (<= (re-search-forward "\\(^[\\+-].*\n\\)+" nil t) loc)
- (setq hunk (1+ hunk)))
- (goto-char loc)
- (with-current-buffer
- (xetla-file-ediff-revisions file xetla-changes-base
- xetla-changes-modified)
- (ediff-jump-to-difference hunk))))))
-
-(defun xetla-changes-get-file-at-point ()
- "Find file at point in *xetla-changes*.
-Throw an error when not on a file."
- (let ((elem (ewoc-locate xetla-changes-cookie (point))))
- (or (when (and elem
- (eq (car (ewoc-data elem)) 'file)
- (>= (ewoc-location elem) (point-at-bol)))
- (cadr (ewoc-data elem)))
- (expand-file-name (concat (file-name-as-directory
- default-directory)
- (diff-find-file-name))))))
-
-(defun xetla-changes-jump-to-change-by-mouse (event &optional other-file)
- "Jump to the changes."
- (interactive "e\nP")
- (mouse-set-point event)
- (xetla-changes-jump-to-change other-file))
-
-(defun xetla-changes-revert ()
- "Reverts file at point."
- (interactive)
- (let* ((file (xetla-get-file-info-at-point))
- (absolute (if (file-name-absolute-p file)
- file
- (expand-file-name
- (concat (file-name-as-directory
- default-directory)
- file)))))
- (xetla-file-revert absolute)))
-
-;; --------------------------------------
-;; xetla-changelog-mode
-;; --------------------------------------
-
-(define-derived-mode xetla-changelog-mode change-log-mode "xetla-changelog"
- (set (make-local-variable 'font-lock-defaults)
- (list 'xetla-changelog-font-lock-keywords
- t nil nil 'backward-paragraph))
- (font-lock-mode)
- (use-local-map xetla-changelog-mode-map)
- (toggle-read-only 1)
- (set-buffer-modified-p nil))
-
-;; --------------------------------------
-;; xetla-inventory-file-mode
-;; --------------------------------------
-;;;###autoload
-(defun xetla-inventory-file-mode ()
- "Major mode to edit xetla inventory files (=tagging-method, .arch-inventory)."
- (interactive)
- (kill-all-local-variables)
- (set (make-local-variable 'font-lock-defaults)
- '(xetla-inventory-file-font-lock-keywords t))
- (set (make-local-variable 'comment-start) "# ")
- (setq major-mode 'xetla-inventory-file-mode
- mode-name "xetla-inventory-file")
- (run-hooks 'xetla-inventory-file-mode-hook))
-
-(defun xetla-inventory-file-jump-from-head (category)
- "Search CATEGORY from the head of the buffer."
- (let ((p (save-excursion (goto-char (point-min))
- (re-search-forward
- (concat "^" category) nil t))))
- (when p
- (goto-char p))))
-
-(defun xetla-inventory-file-jump-from-tail (category)
- "Search CATEGORY from the tail of the buffer.
-Return nil if CATEGORY is not found."
- (let ((p (save-excursion (goto-char (point-max))
- (re-search-backward
- (concat "^" category) nil t))))
- (when p
- (goto-char p))))
-
-(defun xetla-inventory-file-add-file (category file)
- "Added FILE to CATEGORY."
- (unless (xetla-inventory-file-jump-from-tail category)
- (goto-char (point-min)))
- (save-excursion (open-line 1))
- ;; TODO regexp quote FILE
- (insert (format "%s ^(%s)$" category file)))
-
-;; --------------------------------------
-;; Find file hook
-;; --------------------------------------
-;; just 99% cut&paste from vc-follow-link in vc-hook.el, but this way there is
-;; no need to load it thus avoiding interfering with VC ...
-(defun xetla-follow-link ()
- "Follow a symbolic link.
-If the current buffer visits a symbolic link, this function makes it
-visit the real file instead. If the real file is already visited in
-another buffer, make that buffer current, and kill the buffer
-that visits the link."
- (let* ((truename (abbreviate-file-name (file-truename buffer-file-name)))
- (true-buffer (find-buffer-visiting truename))
- (this-buffer (current-buffer)))
- (if (eq true-buffer this-buffer)
- (progn
- (kill-buffer this-buffer)
- ;; In principle, we could do something like set-visited-file-name.
- ;; However, it can't be exactly the same as set-visited-file-name.
- ;; I'm not going to work out the details right now. - rms.
- (set-buffer (find-file-noselect truename)))
- (set-buffer true-buffer)
- (kill-buffer this-buffer))))
-
-
-(defvar vc-ignore-vc-files)
-
-;;;###autoload
-(defun xetla-find-file-hook ()
- "Hook executed when opening a file.
-Follow symlinked files/directories to the actual location of a file.
-Enter smerge mode if the file has conflicts (detected by the presence
-of a .rej file)."
- (when (xetla-file-has-conflict-p (buffer-file-name))
- (xetla-funcall-if-exists smerge-mode 1))
- (let (link file result)
- (when (and (not vc-ignore-vc-files)
- xetla-follow-symlinks
- (setq file buffer-file-name)
- (not (string= (setq link (file-truename file)) file)))
- (setq file link
- result (cond ((equal xetla-follow-symlinks 'tree)
- (xetla-tree-root file t))
- ((equal xetla-follow-symlinks 'id)
- (= 0 (xetla-run-tla-sync
- (list "id" file)
- :finished 'xetla-status-handler
- :error 'xetla-status-handler)))))
-
- (if result
- (cond ((eq xetla-follow-symlinks-mode 'warn)
- (message
- "Warning: symbolic link to arch-controlled source file: %s"
- file))
- ((or (eq xetla-follow-symlinks-mode 'follow)
- (find-buffer-visiting file))
- (xetla-follow-link)
- (message "Followed link to arch-controlled %s"
- buffer-file-name))
- ((eq xetla-follow-symlinks-mode 'ask)
- (if (y-or-n-p "Follow symbolic link to arch-controlled source file? ")
- (progn
- (xetla-follow-link)
- (message "Followed link to arch-controlled %s"
- buffer-file-name))
- (message
- "Warning: editing through the link bypasses version control")))
- (t (error "Unknown mode for xetla-follow-symlinks-mode=%s"
- xetla-follow-symlinks-mode)))
- ))))
-
-;; --------------------------------------
-;; Misc functions
-;; --------------------------------------
-(defvar xetla-insert-arch-tag-functions
- '((autoconf-mode . xetla-insert-arch-tag-for-autoconf-mode)
- (makefile-mode . xetla-insert-arch-tag-for-makefile-mode))
- "Alist containing per mode specialized functions for inserting arch-tag.
-Key stands for a major mode. Value is a function which inserts arch-tag.
-The function takes two arguments. The first argument is an uuid string.
-The second argument is a boolean showing whether the point is in a comment
-or not." )
-
-(defconst xetla-arch-tag-string (concat "arch-ta" "g: ")
- "To avoid having the string a-r-c-h-t-a-g: in this buffer ;-).")
-
-(defun xetla-tag-uuid ()
- "Candidate for `xetla-tag-function'.
-Returns a unique string using uuidgen"
- (xetla-strip-final-newline (shell-command-to-string "uuidgen")))
-
-(defun xetla-tag-name-date-filename ()
- "Candidate for `xetla-tag-function'.
-Returns a string containing the name of the user, the precise date,
-and the name of the current file. This should be unique worldwide,
-has the advantage of containing usefull information in addition to
-the unique identifier. The inconvenient in comparison to
-`xetla-tag-uuid' is that an unfortunate modification of the tag is more
-easily made (sed script or manual modification)"
- (concat (user-full-name) ", "
- (format-time-string "%c")
- " (" (file-name-nondirectory (buffer-file-name)) ")"))
-
-;;;###autoload
-(defun xetla-tag-string ()
- "Return a suitable string for an arch-tag.
-Actually calls `xetla-tag-function', which defaults to `xetla-tag-uuid' to generate
-string (and possibly add a comment-end after).
-
-Interactively, you should call `xetla-tag-insert', but this function can
-be usefull to write template files."
- (funcall xetla-tag-function))
-
-;;;###autoload
-(defun xetla-tag-insert ()
- "Insert a unique arch-tag in the current file.
-Actually calls `xetla-tag-function', which defaults to `xetla-tag-uuid' to generate
-string (and possibly add a comment-end after)"
- (interactive)
- (let ((the-tag-itself (xetla-tag-string))
- (in-comment-p (nth 4 (parse-partial-sexp (point) (point-min))))
- (header "")
- (footer "")
- (handler (assoc major-mode xetla-insert-arch-tag-functions)))
- (if (cdr handler)
- (funcall (cdr handler) the-tag-itself in-comment-p)
- (unless in-comment-p
- (setq header (if comment-start
- (concat comment-start
- (if (string-match " $" comment-start)
- "" " "))
- "")
- footer (if (and comment-end (not (string= "" comment-end)))
- (format "\n%s(do not change this comment)%s%s"
- (make-string (length header) ?\ )
- comment-end
- (if (string-match "^ " comment-end)
- "" " "))
- "")))
- (insert (concat header xetla-arch-tag-string the-tag-itself
- footer)))))
-
-;;;###autoload
-(defun xetla-tag-regenerate ()
- "Find an arch tag in the current buffer and regenerates it.
-This means changing the ID of the file, which will usually be done after
-copying a file in the same tree to avoid duplicates ID.
-
-Raises an error when multiple tags are found or when no tag is found."
- (interactive)
- (let ((second-tag
- (save-excursion
- (goto-char (point-min))
- (unless (search-forward xetla-arch-tag-string nil t)
- (error "No arch tag in this buffer"))
- (delete-region (point) (progn (end-of-line) (point)))
- (insert (funcall xetla-tag-function))
- (if (search-forward xetla-arch-tag-string nil t)
- (point)
- nil))))
- (when second-tag
- (goto-char second-tag)
- (beginning-of-line)
- (error "Multiple tag in this buffer"))))
-
-(defun xetla-regenerate-id-for-file (file)
- "Create a new id for the file FILE.
-Does roughly
-
-$ xetla delete file
-$ xetla add file
-
-But also works for the tagline method. When the tagline method is
-used, the file is opened in a buffer. If the file had modifications,
-the tag is modified in the buffer, and the user is prompted for
-saving. If the file had no unsaved modifications, the modification is
-done in the buffer and the file is saved without prompting.
-
-FILE must be an absolute filename. It can also be a directory"
- (interactive "f")
- (if (file-directory-p file)
- (progn
- (delete-file (concat (file-name-as-directory file)
- ".arch-ids/=id"))
- (xetla-add-id nil file))
- (let* ((dir (file-name-directory file))
- (basename (file-name-nondirectory file))
- (id-file (concat dir
- (file-name-as-directory ".arch-ids")
- basename ".id")))
- (if (file-exists-p id-file)
- (progn (delete-file id-file)
- (xetla-add-id nil file))
- (with-current-buffer
- (find-file-noselect file)
- (let ((modif (buffer-modified-p)))
- (xetla-tag-regenerate)
- (if modif
- (when (y-or-n-p (format "Save buffer %s? " (buffer-name)))
- (save-buffer))
- ;; No modif. We can safely save without prompting.
- (save-buffer))))))))
-
-(defun xetla-insert-arch-tag-for-autoconf-mode (uuid in-comment-p)
- "Insert arch-tag, UUID to the current `autoconf-mode' buffer.
-IN-COMMENT-P indicates whether we are currently inside a comment."
- (when in-comment-p
- ;; In current GNU Emacs's autoconf-mode implementation,
- ;; next line is never executed.
- (error "Comment prefix \"dnl\" is not suitable for gnuarch"))
- (let ((header "m4_if(dnl Do not change this comment\n")
- (footer "\n)dnl\n"))
- (insert (concat header " " xetla-arch-tag-string uuid footer))))
-
-(defun xetla-insert-arch-tag-for-makefile-mode (uuid in-comment-p)
- "Insert arch-tag, UUID to the current `makefile-mode' buffer.
-If the file is Makefile.am, input for automake, use `##' as `comment-start'.
-Comment started with `##' in Makefile.am is automatically stripped by automake.
-IN-COMMENT-P indicates whether we are currently inside a comment."
- (let ((xetla-insert-arch-tag-functions
- (assq-delete-all 'makefile-mode
- (copy-sequence xetla-insert-arch-tag-functions)))
- (comment-start (if (and (buffer-file-name)
- (string-match "Makefile.am$" (buffer-file-name)))
- "##"
- comment-start)))
- (xetla-tag-insert)))
-
-;;;###autoload
-(defun xetla-ediff-add-log-entry ()
- "Add a log entry."
- (interactive)
- (pop-to-buffer ediff-buffer-A)
- (xetla-add-log-entry))
-
-;;
-;; Tree-lint mode
-;;
-(defvar xetla-tree-lint-cookie nil
- "Ewoc cookie used in tree-lint mode.")
-
-(define-derived-mode xetla-tree-lint-mode fundamental-mode
- "xetla-tree-lint"
- "Major mode to view tree-lint warnings.
-Commands:
-\\{xetla-tree-lint-mode-map}
-"
- (let ((inhibit-read-only t))
- (erase-buffer))
- (set (make-local-variable 'xetla-buffer-refresh-function)
- `(lambda () (interactive) (xetla-tree-lint ,default-directory)))
- (set (make-local-variable 'xetla-tree-lint-cookie)
- (ewoc-create 'xetla-tree-lint-printer))
- (set (make-local-variable 'xetla-get-file-info-at-point-function)
- 'xetla-tree-lint-get-file-at-point)
- (set (make-local-variable 'xetla-buffer-marked-file-list)
- nil)
- (set (make-local-variable 'xetla-generic-select-files-function)
- 'xetla-tree-lint-select-files)
- (toggle-read-only t))
-
-(defun xetla-tree-lint-get-file-at-point ()
- "Find file at point in *xetla-tree-lint*. Error when not on a file."
- (let ((data (ewoc-data (ewoc-locate xetla-tree-lint-cookie))))
- (if (eq (car data) 'message)
- nil
- (cadr data))))
-
-(defun xetla-tree-lint-prepare-buffer (root)
- "Prepare the buffer to display the tree-lint warnings for tree ROOT."
- (let ((buffer (xetla-get-buffer-create 'tree-lint root)))
- (with-current-buffer buffer
- (xetla-tree-lint-mode)
- (ewoc-enter-last
- xetla-tree-lint-cookie
- (list 'message (format "Running tree-lint in %s ..."
- root)))
- buffer)))
-
-;;;###autoload
-(defun xetla-tree-lint (root)
- "Run tla tree-lint in directory ROOT."
- (interactive
- (list (xetla-read-project-tree-maybe "Run tla tree-lint in: ")))
- (let ((default-directory root)
- (buffer (xetla-tree-lint-prepare-buffer root)))
- (when xetla-switch-to-buffer-first
- (xetla-switch-to-buffer buffer))
- (xetla-run-tla-async
- '("tree-lint")
- :related-buffer buffer
- :finished
- `(lambda (output error status arguments)
- (if (> (buffer-size output) 0)
- (progn
- (save-excursion
- (xetla-tree-lint-parse-buffer output ,buffer))
- (with-current-buffer ,buffer
- (xetla-tree-lint-cursor-goto
- (ewoc-nth xetla-tree-lint-cookie 0))))
- (message "No tree-lint warnings for %s." ,default-directory)
- (with-current-buffer ,buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (ewoc-enter-last
- xetla-tree-lint-cookie
- (list 'message (format "No tree-lint warnings for %s."
- ,default-directory)))))))
- :error
- `(lambda (output error status arguments)
- (save-excursion
- (xetla-tree-lint-parse-buffer output ,buffer))
- (with-current-buffer ,buffer
- (xetla-tree-lint-cursor-goto
- (ewoc-nth xetla-tree-lint-cookie 0)))))))
-
-(defconst xetla-tree-lint-message-alist
- '(("^These files would be source but lack inventory ids"
- missing-file)
- ("^These explicit ids have no corresponding file:"
- id-without-file)
- ("^These files violate naming conventions:"
- unrecognized)
- ("^These symlinks point to nonexistent files:"
- broken-link)
- ("^Duplicated ids among each group of files listed here:"
- duplicate-id)
- ))
-
-(defun xetla-tree-lint-message-type (message)
- "Return a symbol saying which type of message the string MESSAGE is."
- (let ((result nil)
- (iterator xetla-tree-lint-message-alist))
- (while (and iterator (not result))
- (when (string-match (caar iterator) message)
- (setq result (cadar iterator)))
- (setq iterator (cdr iterator)))
- (or result 'unknown)))
-
-(defun xetla-tree-lint-parse-buffer (buffer output-buffer)
- "Parse the output of xetla tree-lint in BUFFER.
-Show in in the tree-lint-mode buffer OUTPUT-BUFFER."
- (with-current-buffer output-buffer
- (let ((inhibit-read-only t))
- (erase-buffer)
- (insert (xetla-face-add (format "Tree lint warnings in %s\n"
- default-directory)
- 'xetla-messages)))
- (setq xetla-tree-lint-cookie
- (ewoc-create 'xetla-tree-lint-printer)))
- (with-current-buffer buffer
- (goto-char (point-min))
- (let ((cookie (with-current-buffer output-buffer
- xetla-tree-lint-cookie)))
- (while (re-search-forward "^." nil t)
- (goto-char (point-at-bol))
- (let* ((message (buffer-substring-no-properties
- (point) (point-at-eol)))
- (type (xetla-tree-lint-message-type message)))
- (ewoc-enter-last cookie (list 'message message))
- (forward-line 2)
- (if (eq type 'duplicate-id)
- (progn
- (while (looking-at "\\([^ \t]*\\)[ \t]+\\(.*\\)")
- (let* ((file (match-string 1))
- (id (match-string 2)))
- ;; Format: (duplicate-id "filename" "id" first? last?)
- (ewoc-enter-last
- cookie (list 'duplicate-id (xetla-unescape file) id
- t nil))
- (forward-line 1)
- (while (not (eq (char-after) ?\n))
- (let ((file (buffer-substring-no-properties
- (point) (point-at-eol))))
- (forward-line 1)
- (ewoc-enter-last cookie
- (list 'duplicate-id
- (xetla-unescape file)
- id nil
- (eq (char-after) ?\n)))))
- (forward-line 1)
- )))
- (while (not (eq (char-after) ?\n))
- (ewoc-enter-last cookie
- (list type (xetla-unescape
- (buffer-substring-no-properties
- (point)
- (point-at-eol)))))
- (forward-line 1)))))
- (let ((inhibit-read-only t))
- (ewoc-refresh cookie)))))
-
-(defvar xetla-tree-lint-printer-first-duplicate nil
- "Internal variable.
-non-nil when the ewoc printer is printing the first group of duplicate ID's")
-
-(defun xetla-tree-lint-printer (elem)
- "Ewoc printer for the tree-lint buffer.
-Displays ELEM."
- (when (not (eq (car elem) 'message))
- (insert (if (member (cadr elem)
- xetla-buffer-marked-file-list)
- (concat " " xetla-mark " ") " ")))
- (case (car elem)
- (message (insert "\n" (xetla-face-add (cadr elem) 'xetla-messages)
- "\n")
- (setq xetla-tree-lint-printer-first-duplicate t))
- (missing-file (insert
- (xetla-face-add (cadr elem) 'xetla-to-add
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu)))
- (id-without-file (insert
- (xetla-face-add (cadr elem) 'xetla-to-add
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu)))
- (unrecognized (insert
- (xetla-face-add (cadr elem)
- 'xetla-unrecognized
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu)))
- (broken-link (insert (xetla-face-add (cadr elem)
- 'xetla-broken-link
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu)))
- (unknown (insert (xetla-face-add (cadr elem)
- 'xetla-unrecognized
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu)))
- (duplicate-id
- (insert (xetla-face-add (cadr elem)
- 'xetla-duplicate
- 'xetla-tree-lint-file-map
- xetla-tree-lint-file-menu))
- (when (nth 3 elem) (insert "\t"
- (xetla-face-add (caddr elem)
- 'xetla-id)))
- (when (nth 4 elem) (insert "\n")))
- (t (error "Unimplemented type of tree-lint error")))
- )
-
-(defun xetla-tree-lint-cursor-goto (ewoc-tree-lint)
- "Move cursor to the ewoc location of EWOC-TREE-LINT."
- (interactive)
- (if ewoc-tree-lint
- (progn (goto-char (ewoc-location ewoc-tree-lint))
- (re-search-forward "." nil t)
- (backward-char 1))
- (goto-char (point-min))))
-
-(defun xetla-tree-lint-next ()
- "Move to the next tree lint item."
- (interactive)
- (let* ((cookie xetla-tree-lint-cookie)
- (elem (ewoc-locate cookie))
- (next (or (ewoc-next cookie elem) elem)))
- (xetla-tree-lint-cursor-goto next)))
-
-(defun xetla-tree-lint-previous ()
- "Move to the previous tree lint item."
- (interactive)
- (let* ((cookie xetla-tree-lint-cookie)
- (elem (ewoc-locate cookie))
- (previous (or (ewoc-prev cookie elem) elem)))
- (xetla-tree-lint-cursor-goto previous)))
-
-(defun xetla-tree-lint-mark-file ()
- "Mark the current tree-lint file."
- (interactive)
- (let ((current (ewoc-locate xetla-tree-lint-cookie))
- (files (xetla-tree-lint-select-files nil nil nil nil nil t t)))
- (when files
- (dolist (file files)
- (add-to-list 'xetla-buffer-marked-file-list file))
- (ewoc-refresh xetla-tree-lint-cookie))
- (xetla-tree-lint-cursor-goto
- (if (eq (car (ewoc-data current)) 'message)
- current
- (ewoc-next xetla-tree-lint-cookie current)))))
-
-(defun xetla-tree-lint-unmark-file ()
- "Unmark the current tree-lint file."
- (interactive)
- (let ((current (ewoc-locate xetla-tree-lint-cookie))
- (files (xetla-tree-lint-select-files nil nil nil nil nil t t)))
- (when files
- (dolist (file files)
- (setq xetla-buffer-marked-file-list
- (delete file xetla-buffer-marked-file-list)))
- (ewoc-refresh xetla-tree-lint-cookie))
- (xetla-tree-lint-cursor-goto
- (if (eq (car (ewoc-data current)) 'message)
- current
- (ewoc-next xetla-tree-lint-cookie current)))))
-
-(defun xetla-tree-lint-unmark-all ()
- "Unmark all tree-lint files."
- (interactive)
- (let ((current (ewoc-locate xetla-tree-lint-cookie)))
- (setq xetla-buffer-marked-file-list nil)
- (ewoc-refresh xetla-tree-lint-cookie)
- (xetla-tree-lint-cursor-goto current)))
-
-
-(defun xetla-tree-lint-select-files (msg-singular
- msg-plural msg-err
- msg-prompt
- &optional
- no-group ignore-marked
- no-prompt
- y-or-n)
- "Get the list of files under cursor, and ask confirmation of the user.
-Prompt with either MSG-SINGULAR, MSG-PLURAL, MSG-ERR OR MSG-PROMPT.
-If NO-GROUP is nil and if the cursor is on a message, all the
-files belonging to this message are selected. If some files are marked
- (i.e. `xetla-buffer-marked-file-list' is non-nil) and IGNORE-MARKED is
-non-nil, the list of marked files is returned. If NO-PROMPT is
-non-nil, don't ask for confirmation. If Y-OR-N is non-nil, then this
-function is used instead of `y-or-n-p'."
- (if (and xetla-buffer-marked-file-list
- (not ignore-marked)
- (not (xetla-mouse-event-p last-input-event)))
- (let ((list xetla-buffer-marked-file-list))
- (unless (or no-prompt
- (funcall (or y-or-n 'y-or-n-p)
- (if (eq 1 (length list))
- (format msg-singular
- (car list))
- (format msg-plural
- (length list))))
- (error msg-err)))
- list)
- (let* ((ewoc-elem (ewoc-locate xetla-tree-lint-cookie))
- (elem (ewoc-data ewoc-elem)))
- (if (eq (car elem) 'message)
- (progn
- (when no-group (error msg-err))
- (let ((list nil))
- (setq ewoc-elem
- (ewoc-next xetla-tree-lint-cookie ewoc-elem))
- (setq elem (and ewoc-elem (ewoc-data ewoc-elem)))
- (while (and ewoc-elem (not (eq (car elem) 'message)))
- (add-to-list 'list (cadr elem))
- (setq ewoc-elem
- (ewoc-next xetla-tree-lint-cookie ewoc-elem))
- (setq elem (and ewoc-elem (ewoc-data ewoc-elem))))
- (progn
- (unless (or no-prompt
- (funcall (or y-or-n 'y-or-n-p)
- (if (eq 1 (length list))
- (format msg-singular
- (car list))
- (format msg-plural
- (length list)))))
- (error msg-err))
- list)))
- (list (if (or no-prompt
- (funcall (or y-or-n 'y-or-n-p)
- (format msg-singular
- (cadr elem))))
- (cadr elem)
- (error msg-err)))))))
-
-(defun xetla-tree-lint-add-files (files)
- "Prompts and add FILES.
-If on a message field, add all the files below this message."
- (interactive
- (list
- (xetla-tree-lint-select-files "Add %s? "
- "Add %s files? "
- "Not adding any file"
- "Add file: ")))
- (apply 'xetla-add-id nil files)
- (xetla-tree-lint default-directory))
-
-(defun xetla-tree-lint-delete-files (files)
- "Prompts and delete FILES.
-If on a message field, delete all the files below this message."
- (interactive
- (list
- (xetla-tree-lint-select-files "Delete %s? "
- "Delete %s files? "
- "Not deleting any file"
- "Delete file: "
- nil nil nil
- 'yes-or-no-p)))
- (mapcar 'delete-file files)
- (xetla-tree-lint default-directory))
-
-(defun xetla-tree-lint-regenerate-id (files)
- "Prompts and regenerate an ID (either explicit or tagline) for FILES."
- (interactive
- (list
- (xetla-tree-lint-select-files "Regenerate ID for %s? "
- "Regenerate ID for %s files? "
- "Not regenerating ID for any file"
- "Regenerate ID for file: "
- t)))
- (mapcar 'xetla-regenerate-id-for-file files)
- (xetla-tree-lint default-directory))
-
-(defun xetla-tree-lint-make-junk (files)
- "Prompts and make the FILES junk.
-If marked files are, use them as FIELS.
-If not, a file under the point is used as FILES.
-If on a message field, make all the files below this message junk."
- (interactive
- (list
- (xetla-tree-lint-select-files "Make %s junk(prefixing \",,\")? "
- "Make %s files junk? "
- "Not making any file junk"
- "Make file junk: "
- nil nil nil
- 'yes-or-no-p)))
- (xetla-generic-file-prefix files ",,"))
-
-(defun xetla-tree-lint-make-precious (files)
- "Prompts and make the FILES precious.
-If marked files are, use them as FIELS.
-If not, a file under the point is used as FILES.
-If on a message field, make all the files below this message precious."
- (interactive
- (list
- (xetla-tree-lint-select-files "Make %s precious(prefixing \"++\")? "
- "Make %s files precious? "
- "Not making any file precious? "
- "Make file precious: "
- nil nil nil
- 'yes-or-no-p)))
- (xetla-generic-file-prefix files "++"))
-
-(defun xetla-generic-file-prefix (files prefix)
- "Rename FILES with adding prefix PREFIX.
-Visited buffer associations also updated."
- (mapcar
- (lambda (from)
- (let* ((buf (find-buffer-visiting from))
- (to (concat
- (file-name-directory from)
- prefix
- (file-name-nondirectory from))))
- (rename-file from to)
- (when buf
- (with-current-buffer buf
- (rename-buffer to)
- (set-visited-file-name to)))))
- files)
- (xetla-generic-refresh))
-
-
-;; end tree-lint-mode
-
-(defvar xetla-arch-version nil
- "Version of the underlying tla binary.")
-
-(defvar xetla-arch-version-number nil
- "Version _number_ of the underlying tla binary.
-It is stored in an alist in the form
-\(\(major . <major>\)
- \(minor . <minor>\)
- \(minor-minor . <minor-minor>\)
- \(fix . <fix>\)\)")
-
-(defun xetla-arch-version ()
- "Return the TLA (arch) version."
- (interactive)
- (setq xetla-arch-version
- (xetla-run-tla-sync '("-V")
- :finished
- (lambda (output error status arguments)
- (xetla-buffer-content output))))
- (if (interactive-p)
- (message xetla-arch-version))
- xetla-arch-version)
-
-(defun xetla-arch-version-number ()
- "Return the TLA (arch) version number.
-This is extremely mandatory since tla 1.3 parameters differ from
-those used in tla 1.2 for example."
- (interactive)
- (unless xetla-arch-version
- (xetla-arch-version))
- (setq xetla-arch-version-number
- (when (string-match
- (concat "([^0-9]+"
- "\\([0-9]\\)"
- "\\.\\([0-9]\\)"
- "\\.?\\([0-9]\\)?"
- ".*\\(?:fix-?\\)?\\([0-9]\\)?.*)")
- xetla-arch-version)
- (mapcar* #'cons
- '(major minor minor-minor fix)
- (mapcar #'string-to-number
- (list (match-string 1 xetla-arch-version)
- (match-string 2 xetla-arch-version)
- (or (match-string 3 xetla-arch-version)
- "")
- (or (match-string 4 xetla-arch-version)
- ""))))))
- (if (interactive-p)
- (message "%S" xetla-arch-version-number))
- xetla-arch-version-number)
-
-
-;;;###autoload
-(defun xetla-version ()
- "Return the XEtla version."
- (interactive)
- (let ((version
- (or (when (locate-library "xetla-version")
- (load-library "xetla-version")
- (when (boundp 'xetla-version)
- xetla-version))
- (let ((default-directory
- (file-name-directory (locate-library "xetla"))))
- (defvar xetla-version nil "Version of xetla")
- (xetla-run-tla-sync '("logs" "-f" "-r")
- :finished
- (lambda (output error status arguments)
- (set-buffer output)
- (goto-char (point-min))
- (setq xetla-version
- (buffer-substring-no-properties
- (point)
- (point-at-eol))))
- :error
- (lambda (output error status arguments)
- (setq xetla-version "unknown")))))))
- (if (not version)
- (progn
- (message "We did not find xetla-version.el nor the arch-tree containing xetla.el!")
- (sit-for 2)
- (message "Are you using a developer version of XEtla?")
- (sit-for 2))
- (if (interactive-p)
- (message xetla-version))
- xetla-version)))
-
-
-;;;###autoload
-(defun xetla-prepare-patch-submission (xetla-tree-root tarball-base-name email version-string
- &optional description subject)
- "Submit a patch to a xetla working copy (at XETLA-TREE-ROOT) via email.
-With this feature it is not necessary to tag an xetla archive.
-You simply edit your checked out copy from your project and call this function.
-The function will create a patch as *.tar.gz file (based on TARBALL-BASE-NAME)
-and send it to the given email address EMAIL.
-VERSION-STRING should indicate the version of xetla that the patch applies to.
-DESCRIPTION is a brief descsription of the patch.
-SUBJECT is the subject for the email message.
-For an example, how to use this function see: `xetla-submit-patch'."
- (interactive)
-
- ;; create the patch
- (let* ((default-directory xetla-tree-root)
- (tarball-full-base-name (concat default-directory tarball-base-name))
- (tarball-full-name (concat tarball-full-base-name ".tar.gz")))
- (xetla-changes-save-as-tgz tarball-full-base-name)
-
- (require 'reporter)
- (delete-other-windows)
- (reporter-submit-bug-report
- email
- nil
- nil
- nil
- nil
- description)
-
- (insert "[VERSION] " version-string)
- (goto-char (point-max))
- (mml-attach-file tarball-full-name "application/octet-stream")
- (xetla-show-changeset-from-tgz tarball-full-name)
- (other-window 1)
-
- (goto-char (point-min))
- (mail-position-on-field "Subject")
- (insert (or subject "[PATCH] "))))
-
-(defvar xetla-package-root-directory nil)
-(defun xetla-submit-patch ()
- "Submit a patch to the XEtla devel list.
-With this feature it is not necessary to tag an xetla.el archive.
-You simply edit your checked out copy from xetla.el and call this function.
-The function will create a patch as *.tar.gz file and send it to the xetla-el-dev list."
- (interactive)
- (xetla-version)
- (xetla-arch-version)
- (xetla-prepare-patch-submission (xetla-tree-root
- (file-name-directory (or xetla-package-root-directory (locate-library "xetla"))))
- (concat ",,xetla-patch-" (format-time-string "%Y-%m-%d_%H-%M-%S" (current-time)))
- "xetla-devel@youngs.au.com"
- xetla-version
- (concat
- "Please change the Subject header to a concise description of your patch.\n"
- "Please describe your patch between the LOG-START and LOG-END markers:\n"
- "<<LOG-START>>\n"
- "\n"
- "<<LOG-END>>\n"
- "\n"
- )))
-
-;; Integration into gnus
-(defvar gnus-summary-xetla-submap nil
- "Key mapping added to gnus summary.")
-
-(eval-when-compile
- (defvar gnus-summary-mode-map))
-
-(defun xetla-insinuate-gnus ()
- "Integrate xetla to gnus.
-The following keybindings are installed for gnus-summary:
-K t v `xetla-gnus-article-view-patch'
-K t a `xetla-gnus-article-apply-patch'
-K t l `xetla-gnus-article-extract-log-message'"
- (interactive)
- (setq gnus-summary-xetla-submap (make-sparse-keymap))
- (define-key gnus-summary-xetla-submap [?v] 'xetla-gnus-article-view-patch)
- (define-key gnus-summary-xetla-submap [?a] 'xetla-gnus-article-apply-patch)
- (define-key gnus-summary-xetla-submap [?l] 'xetla-gnus-article-extract-log-message)
- (define-key gnus-summary-mode-map [?K ?t] gnus-summary-xetla-submap))
-
-(defun xetla-gnus-article-view-patch (n)
- "View MIME part N, as xetla patchset.
-Note, N is forced to 2 at the moment!"
- (interactive "p")
- (setq n 2)
- (gnus-article-part-wrapper n 'xetla-gnus-view-patch))
-
-(defun xetla-gnus-view-patch (handle)
- "View a patch within gnus. HANDLE should be the handle of the part."
- (let ((archive-name (xetla-make-temp-name "gnus-patch-tgz")))
- (mm-save-part-to-file handle archive-name)
- (gnus-summary-select-article-buffer)
- (split-window-vertically)
- (xetla-show-changeset-from-tgz archive-name)
- (delete-file archive-name)))
-
-(defun xetla-gnus-article-apply-patch (n)
- "Apply MIME part N, as xetla patchset.
-Note, N is forced to 2 at the moment!"
- (interactive "p")
- (setq n 2)
- (gnus-article-part-wrapper n 'xetla-gnus-apply-patch))
-
-(defun xetla-gnus-apply-patch (handle)
- "Apply the patch corresponding to HANDLE."
- (let ((archive-name (xetla-make-temp-name "gnus-patch-tgz"))
- (tree))
- (xetla-gnus-article-extract-log-message)
- (mm-save-part-to-file handle archive-name)
- (gnus-summary-select-article-buffer)
- (split-window-vertically)
- (xetla-show-changeset-from-tgz archive-name)
- (setq tree (read-directory-name
- "Apply to tree: "
- (xetla-name-match-from-list
- (when xetla-memorized-version
- (xetla-name-split xetla-memorized-version))
- xetla-apply-patch-mapping)))
- (xetla-apply-changeset-from-tgz archive-name tree)
- (delete-file archive-name)))
-
-(defun xetla-gnus-article-extract-log-message ()
- "Parse the mail and extract the log information.
-Save it to `xetla-memorized-log-header', `xetla-memorized-log-message'
-and `xetla-memorized-version'."
- (interactive)
- (gnus-summary-select-article-buffer)
- (save-excursion
- (goto-char (point-min))
- (let* ((start-pos (search-forward "[PATCH] "))
- (end-pos (point-at-eol))
- (log-header (buffer-substring-no-properties start-pos end-pos)))
- (setq xetla-memorized-log-header log-header))
- (goto-char (point-min))
- (let* ((start-pos (search-forward "[VERSION] " nil t))
- (end-pos (point-at-eol))
- (version (when start-pos (buffer-substring-no-properties start-pos end-pos))))
- (setq xetla-memorized-version (and start-pos version)))
- (goto-char (point-min))
- (let* ((start-pos (+ (search-forward "<<LOG-START>>") 1))
- (end-pos (- (progn (search-forward "<LOG-END>>") (point-at-bol)) 1))
- (log-message (buffer-substring-no-properties start-pos end-pos)))
- (setq xetla-memorized-log-message log-message)
- (message "Extracted the xetla log message from '%s'" xetla-memorized-log-header)))
- (gnus-article-show-summary))
-
-;;;###autoload
-(defun xetla-submit-bug-report ()
- "Submit a bug report, with pertinent information to the XEtla Devel list."
- (interactive)
- (require 'reporter)
- (delete-other-windows)
- (xetla-version)
- (xetla-arch-version)
- (reporter-submit-bug-report
- "xetla-devel@youngs.au.com"
- (concat "XEtla " xetla-version)
- (append
- ;; non user variables
- '(emacs-version
- xetla-version
- xetla-arch-version
- )
- ;; user variables
- (sort (apropos-internal "^xetla-" 'user-variable-p)
- (lambda (v1 v2) (string-lessp (format "%s" v1) (format "%s" v2))))
- ;; see what the user had loaded
- (list 'features)
- )
- nil
- nil
- (concat
- "Please change the Subject header to a concise bug description or feature request.\n"
- "In this report, remember to cover the basics, that is, what you \n"
- "expected to happen and what in fact did happen.\n"
- "Please remove these instructions from your message."))
-
- ;; insert the backtrace buffer content if present
- (let ((backtrace (get-buffer "*Backtrace*")))
- (when backtrace
- (goto-char (point-max))
- (insert "\n\n")
- (insert-buffer-substring backtrace)))
-
- (goto-char (point-min))
- (mail-position-on-field "Subject")
- (insert "[BUG/FEATURE] "))
-
-;; For people used to Debian's reportbug
-(defalias 'xetla-report-bug 'xetla-submit-bug-report)
-;; For people used to Gnus M-x gnus-bug RET
-(defalias 'xetla-bug 'xetla-submit-bug-report)
-;; (reporting bugs should be easy ;-)
-
-(provide 'xetla)
-
-;;; xetla.el ends here
+++ /dev/null
-ZenIRC BUGS list -- Last updated 1996-04-25
-
-* The server parsing code does strange things when it gets lots of
- action at the same time.
-
- Noah Friedman's comments to this 'bug';
-
- No, it's probably because the process filter isn't reentrant, and it
- wasn't intended to be. (It uses a global vector to reduce memory
- consumption). I've never observed that behavior, and I don't know
- how it can happen---the only time the server parser can be called
- recursively is if you are in the debugger or you send back a
- response through a process that has a pty. But that's only
- significant it is gets run from a server hook, since only those get
- called from within the process filter.
-
- You could fix that at the expense of considerably greater consing.
-
-* ISON is limited to 512 characters, make sure ZenIRC groks that.
-
-* ZenIRC doesn't parse the following numerics at all, some of them aren't
- used by either 2.8 nor 2.9. Some other ugly servers use other numerics
- for other stuff as well.
-
- 416 ERR_TOOMANYMATCHES, "%s %s :Output too long (try locally)",
- 434 ERR_SERVICENAMEINUSE, (char *)NULL,
- 435 ERR_SERVICECONFUSED, (char *)NULL,
- 438 ERR_QUOTAEXCEEDED, "%s :Quota exceeded, try again later.",
- 466 ERR_YOUWILLBEBANNED, (char *)NULL,
- 476 ERR_BADCHANMASK, "%s :Bad Channel Mask",
- 484 ERR_RESTRICTED, ":Your connection is restricted!",
- 492 ERR_NOSERVICEHOST, (char *)NULL,
- 304 RPL_TEXT, (char *)NULL,
- 316 RPL_WHOISCHANOP, (char *)NULL,
- 361 RPL_KILLDONE, (char *)NULL,
- 362 RPL_CLOSING, "%s :Closed. Status = %d",
- 363 RPL_CLOSEEND, "%d: Connections Closed",
- 373 RPL_INFOSTART, ":Server INFO",
- 383 RPL_YOURESERVICE, (char *)NULL,
- 384 RPL_MYPORTIS, "%d :Port to local server is\r\n",
- 385 RPL_NOTOPERANYMORE, (char *)NULL,
- 207 RPL_TRACESERVICE, "Service %d %s",
- 231 RPL_SERVICEINFO, (char *)NULL,
- 232 RPL_ENDOFSERVICES, (char *)NULL,
- 233 RPL_SERVICE, (char *)NULL,
- 234 RPL_SERVLIST, "%s %s %s %d %d :%s",
- 235 RPL_SERVLISTEND, "%s %d :End of service listing",
- 245 RPL_STATSSLINE, "%c %s * %s %d %d",
- 246 RPL_STATSPING, "%s %d %d %d %d",
+++ /dev/null
- GNU GENERAL PUBLIC LICENSE
- Version 2, June 1991
-
- Copyright (C) 1989, 1991 Free Software Foundation, Inc.
- 675 Mass Ave, Cambridge, MA 02139, USA
- Everyone is permitted to copy and distribute verbatim copies
- of this license document, but changing it is not allowed.
-
- Preamble
-
- The licenses for most software are designed to take away your
-freedom to share and change it. By contrast, the GNU General Public
-License is intended to guarantee your freedom to share and change free
-software--to make sure the software is free for all its users. This
-General Public License applies to most of the Free Software
-Foundation's software and to any other program whose authors commit to
-using it. (Some other Free Software Foundation software is covered by
-the GNU Library General Public License instead.) You can apply it to
-your programs, too.
-
- When we speak of free software, we are referring to freedom, not
-price. Our General Public Licenses are designed to make sure that you
-have the freedom to distribute copies of free software (and charge for
-this service if you wish), that you receive source code or can get it
-if you want it, that you can change the software or use pieces of it
-in new free programs; and that you know you can do these things.
-
- To protect your rights, we need to make restrictions that forbid
-anyone to deny you these rights or to ask you to surrender the rights.
-These restrictions translate to certain responsibilities for you if you
-distribute copies of the software, or if you modify it.
-
- For example, if you distribute copies of such a program, whether
-gratis or for a fee, you must give the recipients all the rights that
-you have. You must make sure that they, too, receive or can get the
-source code. And you must show them these terms so they know their
-rights.
-
- We protect your rights with two steps: (1) copyright the software, and
-(2) offer you this license which gives you legal permission to copy,
-distribute and/or modify the software.
-
- Also, for each author's protection and ours, we want to make certain
-that everyone understands that there is no warranty for this free
-software. If the software is modified by someone else and passed on, we
-want its recipients to know that what they have is not the original, so
-that any problems introduced by others will not reflect on the original
-authors' reputations.
-
- Finally, any free program is threatened constantly by software
-patents. We wish to avoid the danger that redistributors of a free
-program will individually obtain patent licenses, in effect making the
-program proprietary. To prevent this, we have made it clear that any
-patent must be licensed for everyone's free use or not licensed at all.
-
- The precise terms and conditions for copying, distribution and
-modification follow.
-\f
- GNU GENERAL PUBLIC LICENSE
- TERMS AND CONDITIONS FOR COPYING, DISTRIBUTION AND MODIFICATION
-
- 0. This License applies to any program or other work which contains
-a notice placed by the copyright holder saying it may be distributed
-under the terms of this General Public License. The "Program", below,
-refers to any such program or work, and a "work based on the Program"
-means either the Program or any derivative work under copyright law:
-that is to say, a work containing the Program or a portion of it,
-either verbatim or with modifications and/or translated into another
-language. (Hereinafter, translation is included without limitation in
-the term "modification".) Each licensee is addressed as "you".
-
-Activities other than copying, distribution and modification are not
-covered by this License; they are outside its scope. The act of
-running the Program is not restricted, and the output from the Program
-is covered only if its contents constitute a work based on the
-Program (independent of having been made by running the Program).
-Whether that is true depends on what the Program does.
-
- 1. You may copy and distribute verbatim copies of the Program's
-source code as you receive it, in any medium, provided that you
-conspicuously and appropriately publish on each copy an appropriate
-copyright notice and disclaimer of warranty; keep intact all the
-notices that refer to this License and to the absence of any warranty;
-and give any other recipients of the Program a copy of this License
-along with the Program.
-
-You may charge a fee for the physical act of transferring a copy, and
-you may at your option offer warranty protection in exchange for a fee.
-
- 2. You may modify your copy or copies of the Program or any portion
-of it, thus forming a work based on the Program, and copy and
-distribute such modifications or work under the terms of Section 1
-above, provided that you also meet all of these conditions:
-
- a) You must cause the modified files to carry prominent notices
- stating that you changed the files and the date of any change.
-
- b) You must cause any work that you distribute or publish, that in
- whole or in part contains or is derived from the Program or any
- part thereof, to be licensed as a whole at no charge to all third
- parties under the terms of this License.
-
- c) If the modified program normally reads commands interactively
- when run, you must cause it, when started running for such
- interactive use in the most ordinary way, to print or display an
- announcement including an appropriate copyright notice and a
- notice that there is no warranty (or else, saying that you provide
- a warranty) and that users may redistribute the program under
- these conditions, and telling the user how to view a copy of this
- License. (Exception: if the Program itself is interactive but
- does not normally print such an announcement, your work based on
- the Program is not required to print an announcement.)
-\f
-These requirements apply to the modified work as a whole. If
-identifiable sections of that work are not derived from the Program,
-and can be reasonably considered independent and separate works in
-themselves, then this License, and its terms, do not apply to those
-sections when you distribute them as separate works. But when you
-distribute the same sections as part of a whole which is a work based
-on the Program, the distribution of the whole must be on the terms of
-this License, whose permissions for other licensees extend to the
-entire whole, and thus to each and every part regardless of who wrote it.
-
-Thus, it is not the intent of this section to claim rights or contest
-your rights to work written entirely by you; rather, the intent is to
-exercise the right to control the distribution of derivative or
-collective works based on the Program.
-
-In addition, mere aggregation of another work not based on the Program
-with the Program (or with a work based on the Program) on a volume of
-a storage or distribution medium does not bring the other work under
-the scope of this License.
-
- 3. You may copy and distribute the Program (or a work based on it,
-under Section 2) in object code or executable form under the terms of
-Sections 1 and 2 above provided that you also do one of the following:
-
- a) Accompany it with the complete corresponding machine-readable
- source code, which must be distributed under the terms of Sections
- 1 and 2 above on a medium customarily used for software interchange; or,
-
- b) Accompany it with a written offer, valid for at least three
- years, to give any third party, for a charge no more than your
- cost of physically performing source distribution, a complete
- machine-readable copy of the corresponding source code, to be
- distributed under the terms of Sections 1 and 2 above on a medium
- customarily used for software interchange; or,
-
- c) Accompany it with the information you received as to the offer
- to distribute corresponding source code. (This alternative is
- allowed only for noncommercial distribution and only if you
- received the program in object code or executable form with such
- an offer, in accord with Subsection b above.)
-
-The source code for a work means the preferred form of the work for
-making modifications to it. For an executable work, complete source
-code means all the source code for all modules it contains, plus any
-associated interface definition files, plus the scripts used to
-control compilation and installation of the executable. However, as a
-special exception, the source code distributed need not include
-anything that is normally distributed (in either source or binary
-form) with the major components (compiler, kernel, and so on) of the
-operating system on which the executable runs, unless that component
-itself accompanies the executable.
-
-If distribution of executable or object code is made by offering
-access to copy from a designated place, then offering equivalent
-access to copy the source code from the same place counts as
-distribution of the source code, even though third parties are not
-compelled to copy the source along with the object code.
-\f
- 4. You may not copy, modify, sublicense, or distribute the Program
-except as expressly provided under this License. Any attempt
-otherwise to copy, modify, sublicense or distribute the Program is
-void, and will automatically terminate your rights under this License.
-However, parties who have received copies, or rights, from you under
-this License will not have their licenses terminated so long as such
-parties remain in full compliance.
-
- 5. You are not required to accept this License, since you have not
-signed it. However, nothing else grants you permission to modify or
-distribute the Program or its derivative works. These actions are
-prohibited by law if you do not accept this License. Therefore, by
-modifying or distributing the Program (or any work based on the
-Program), you indicate your acceptance of this License to do so, and
-all its terms and conditions for copying, distributing or modifying
-the Program or works based on it.
-
- 6. Each time you redistribute the Program (or any work based on the
-Program), the recipient automatically receives a license from the
-original licensor to copy, distribute or modify the Program subject to
-these terms and conditions. You may not impose any further
-restrictions on the recipients' exercise of the rights granted herein.
-You are not responsible for enforcing compliance by third parties to
-this License.
-
- 7. If, as a consequence of a court judgment or allegation of patent
-infringement or for any other reason (not limited to patent issues),
-conditions are imposed on you (whether by court order, agreement or
-otherwise) that contradict the conditions of this License, they do not
-excuse you from the conditions of this License. If you cannot
-distribute so as to satisfy simultaneously your obligations under this
-License and any other pertinent obligations, then as a consequence you
-may not distribute the Program at all. For example, if a patent
-license would not permit royalty-free redistribution of the Program by
-all those who receive copies directly or indirectly through you, then
-the only way you could satisfy both it and this License would be to
-refrain entirely from distribution of the Program.
-
-If any portion of this section is held invalid or unenforceable under
-any particular circumstance, the balance of the section is intended to
-apply and the section as a whole is intended to apply in other
-circumstances.
-
-It is not the purpose of this section to induce you to infringe any
-patents or other property right claims or to contest validity of any
-such claims; this section has the sole purpose of protecting the
-integrity of the free software distribution system, which is
-implemented by public license practices. Many people have made
-generous contributions to the wide range of software distributed
-through that system in reliance on consistent application of that
-system; it is up to the author/donor to decide if he or she is willing
-to distribute software through any other system and a licensee cannot
-impose that choice.
-
-This section is intended to make thoroughly clear what is believed to
-be a consequence of the rest of this License.
-\f
- 8. If the distribution and/or use of the Program is restricted in
-certain countries either by patents or by copyrighted interfaces, the
-original copyright holder who places the Program under this License
-may add an explicit geographical distribution limitation excluding
-those countries, so that distribution is permitted only in or among
-countries not thus excluded. In such case, this License incorporates
-the limitation as if written in the body of this License.
-
- 9. The Free Software Foundation may publish revised and/or new versions
-of the General Public License from time to time. Such new versions will
-be similar in spirit to the present version, but may differ in detail to
-address new problems or concerns.
-
-Each version is given a distinguishing version number. If the Program
-specifies a version number of this License which applies to it and "any
-later version", you have the option of following the terms and conditions
-either of that version or of any later version published by the Free
-Software Foundation. If the Program does not specify a version number of
-this License, you may choose any version ever published by the Free Software
-Foundation.
-
- 10. If you wish to incorporate parts of the Program into other free
-programs whose distribution conditions are different, write to the author
-to ask for permission. For software which is copyrighted by the Free
-Software Foundation, write to the Free Software Foundation; we sometimes
-make exceptions for this. Our decision will be guided by the two goals
-of preserving the free status of all derivatives of our free software and
-of promoting the sharing and reuse of software generally.
-
- NO WARRANTY
-
- 11. BECAUSE THE PROGRAM IS LICENSED FREE OF CHARGE, THERE IS NO WARRANTY
-FOR THE PROGRAM, TO THE EXTENT PERMITTED BY APPLICABLE LAW. EXCEPT WHEN
-OTHERWISE STATED IN WRITING THE COPYRIGHT HOLDERS AND/OR OTHER PARTIES
-PROVIDE THE PROGRAM "AS IS" WITHOUT WARRANTY OF ANY KIND, EITHER EXPRESSED
-OR IMPLIED, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
-MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE. THE ENTIRE RISK AS
-TO THE QUALITY AND PERFORMANCE OF THE PROGRAM IS WITH YOU. SHOULD THE
-PROGRAM PROVE DEFECTIVE, YOU ASSUME THE COST OF ALL NECESSARY SERVICING,
-REPAIR OR CORRECTION.
-
- 12. IN NO EVENT UNLESS REQUIRED BY APPLICABLE LAW OR AGREED TO IN WRITING
-WILL ANY COPYRIGHT HOLDER, OR ANY OTHER PARTY WHO MAY MODIFY AND/OR
-REDISTRIBUTE THE PROGRAM AS PERMITTED ABOVE, BE LIABLE TO YOU FOR DAMAGES,
-INCLUDING ANY GENERAL, SPECIAL, INCIDENTAL OR CONSEQUENTIAL DAMAGES ARISING
-OUT OF THE USE OR INABILITY TO USE THE PROGRAM (INCLUDING BUT NOT LIMITED
-TO LOSS OF DATA OR DATA BEING RENDERED INACCURATE OR LOSSES SUSTAINED BY
-YOU OR THIRD PARTIES OR A FAILURE OF THE PROGRAM TO OPERATE WITH ANY OTHER
-PROGRAMS), EVEN IF SUCH HOLDER OR OTHER PARTY HAS BEEN ADVISED OF THE
-POSSIBILITY OF SUCH DAMAGES.
-
- END OF TERMS AND CONDITIONS
-\f
- How to Apply These Terms to Your New Programs
-
- If you develop a new program, and you want it to be of the greatest
-possible use to the public, the best way to achieve this is to make it
-free software which everyone can redistribute and change under these terms.
-
- To do so, attach the following notices to the program. It is safest
-to attach them to the start of each source file to most effectively
-convey the exclusion of warranty; and each file should have at least
-the "copyright" line and a pointer to where the full notice is found.
-
- <one line to give the program's name and a brief idea of what it does.>
- Copyright (C) 19yy <name of author>
-
- This program 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 of the License, or
- (at your option) any later version.
-
- This program 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 this program; if not, write to the Free Software
- Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-Also add information on how to contact you by electronic and paper mail.
-
-If the program is interactive, make it output a short notice like this
-when it starts in an interactive mode:
-
- Gnomovision version 69, Copyright (C) 19yy name of author
- Gnomovision comes with ABSOLUTELY NO WARRANTY; for details type `show w'.
- This is free software, and you are welcome to redistribute it
- under certain conditions; type `show c' for details.
-
-The hypothetical commands `show w' and `show c' should show the appropriate
-parts of the General Public License. Of course, the commands you use may
-be called something other than `show w' and `show c'; they could even be
-mouse-clicks or menu items--whatever suits your program.
-
-You should also get your employer (if you work as a programmer) or your
-school, if any, to sign a "copyright disclaimer" for the program, if
-necessary. Here is a sample; alter the names:
-
- Yoyodyne, Inc., hereby disclaims all copyright interest in the program
- `Gnomovision' (which makes passes at compilers) written by James Hacker.
-
- <signature of Ty Coon>, 1 April 1989
- Ty Coon, President of Vice
-
-This General Public License does not permit incorporating your program into
-proprietary programs. If your program is a subroutine library, you may
-consider it more useful to permit linking proprietary applications with the
-library. If this is what you want to do, use the GNU Library General
-Public License instead of this License.
+++ /dev/null
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.18 released.
-
-2014-05-15 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.17 released.
-
-2014-05-13 Jerry James <james@xemacs.org>
-
- * .cvsignore: Remove.
- * doc/.cvsignore: Remove.
- * src/.cvsignore: Remove.
- * .hgignore: New file.
- * src/zenirc-klingon.el: Restore CVS keyword expansions.
- * src/zenirc-yow-filter.el: Ditto.
- * configure.in: Ditto.
- * doc/zenirc.texi: Update for texinfo 5.x.
-
-2005-05-10 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.16 released.
-
-2004-01-20 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.15 released.
-
-2004-01-15 Jerry James <james@xemacs.org>
-
- * Makefile (PRELOADS): Define x-color-defined-p to something harmless.
-
-2003-10-31 Norbert Koch <viteno@xemacs.org>
-
- * Makefile (VERSION): XEmacs package 1.14 released.
-
-2003-03-30 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Revert previous change.
-
-2003-03-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile (EARLY_GENERATED_LISP): Explicitly set so we don't try
- to build custom-loads, this package doesn't have any.
-
-2003-03-09 Ben Wing <ben@xemacs.org>
-
- * Makefile (GENERATED): Removed.
- Delete explicit compile:: and binkit: rules.
- Use EXPLICIT_DOCS instead of explicitly giving the targets
- and dependencies.
- Move the include of XEmacs.rules to the end of the file.
- Remove MAKEINFO_FLAGS for directory, not needed.
-
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
- * Makefile: Use `compile' instead of hard-coded `all'.
-
-2002-10-15 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (srckit): Remove.
-
-2002-10-14 Ville Skyttä <scop@xemacs.org>
-
- * Makefile (MANUAL): Removed (unused).
-
-2002-07-15 Adrian Aichner <adrian@xemacs.org>
-
- * doc/zenirc.ascii: It's XEmacs, not Xemacs.
-
-2002-01-07 Adrian Aichner <adrian@xemacs.org>
-
- * Makefile (HTML_FILES): New.
- * Makefile (HTML_DEP): New.
-
-2002-01-02 Steve Youngs <youngs@xemacs.org>
-
- * package-info.in (provides): Update to include all provides.
-
-2001-12-30 Adrian Aichner <adrian@xemacs.org>
-
- * doc/zenirc.texi: Add missing direntry.
-
-2001-06-16 Simon Josefsson <jas@extundo.com>
-
- * zenirc.el (zenirc-font-lock-keywords): Some font-lock defaults.
- (toplevel): Put font-lock-defaults on mode.
- (zenirc-mode): Allow font-lock initialization.
-
-2000-10-05 Martin Buchholz <martin@xemacs.org>
-
- * *: Mega typo fix.
-
-2000-08-22 Steve Youngs <youngs@xemacs.org>
-
- * Makefile: Remove target 'clean' because it's covered in XEmacs.rules.
-
-1998-08-15 SL Baur <steve@altair.xemacs.org>
-
- * Initial integration with XEmacs 21.
- * Makefile: New file.
-
+++ /dev/null
-1) Run `./configure' in the same directory as this file.
-
-2) Check Makefile in the same directory as this file to make sure it
- says what you want.
-
-3) Run `make install' in the same directory as this file.
-
-4) If you don't install ZenIRC in the system directories you need to add
- an entry to your "load-path", preferably in your ~/.emacs file;
-
- (setq load-path (cons
- (expand-file-name "/full/path/to/zenirc/directory")
- load-path))
-
-5) Read src/zenirc-example.el for instructions on how to set up ZenIRC
- for daily abuse.
-
-To try it out--run `emacs', M-x load-library zenirc, M-x zenirc, Waste Time.
-If this doesn't work, e-mail your problems to `zenirc-bug@splode.com'.
-
-Per Persson <pp@sno.pp.se> 1996-04-26.
\ No newline at end of file
+++ /dev/null
-# Makefile for zenirc lisp code
-
-# This file is part of XEmacs.
-
-# XEmacs 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.
-
-# XEmacs 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 XEmacs; see the file COPYING. If not, write to
-# the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
-# Boston, MA 02111-1307, USA.
-
-VERSION = 1.18
-AUTHOR_VERSION = 2.112
-MAINTAINER = XEmacs Development Team <xemacs-beta@xemacs.org>
-PACKAGE = zenirc
-PKG_TYPE = regular
-REQUIRES = zenirc
-CATEGORY = standard
-
-ELCS = src/zenirc-18.elc src/zenirc-8ball.elc src/zenirc-away.elc \
- src/zenirc-bork.elc src/zenirc-color.elc src/zenirc-command-queue.elc \
- src/zenirc-complete.elc src/zenirc-ctcp-flood.elc src/zenirc-dcc.elc \
- src/zenirc-doto.elc src/zenirc-eval.elc src/zenirc-example.elc \
- src/zenirc-fill.elc src/zenirc-finnish.elc src/zenirc-format.elc \
- src/zenirc-fortran.elc src/zenirc-french.elc src/zenirc-history.elc \
- src/zenirc-ignore.elc src/zenirc-iwantop.elc src/zenirc-klingon.elc \
- src/zenirc-latin.elc src/zenirc-make.elc src/zenirc-meditate.elc \
- src/zenirc-netsplit.elc src/zenirc-notify.elc src/zenirc-oink.elc \
- src/zenirc-ojnk.elc src/zenirc-pjg.elc src/zenirc-popup.elc \
- src/zenirc-prime-p.elc src/zenirc-random-away.elc \
- src/zenirc-random-nick.elc src/zenirc-signal.elc src/zenirc-stamp.elc \
- src/zenirc-swedish.elc src/zenirc-trigger.elc \
- src/zenirc-yow-filter.elc src/zenirc-yow.elc src/zenirc.elc
-
-EXTRA_SOURCES = BUGS INSTALL NEWS README TODO
-
-EXPLICIT_DOCS = doc/$(PACKAGE).texi
-
-DATA_FILES = $(wildcard doc/[6FRcistu]*)
-DATA_DEST = $(PACKAGE)
-
-PRELOADS = -eval "(defalias 'x-color-defined-p 'ignore)"
-
-AUTOLOAD_PATH = src
-
-include ../../XEmacs.rules
+++ /dev/null
-# Makefile.in for ZenIRC. -*- makefile -*-
-
-# Copyright (C) 1994, 1995 Noah S. Friedman
-# Copyright (C) 1994, 1995, 1996 Per Persson
-
-# This program 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.
-#
-# This program 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 this program; if not, write to the Free Software
-# Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
-
-#### Start of system configuration section. ####
-
-srcdir = @srcdir@
-VPATH = $(srcdir)
-
-INSTALL = @INSTALL@
-INSTALL_PROGRAM = @INSTALL_PROGRAM@
-INSTALL_DATA = @INSTALL_DATA@
-
-prefix = @prefix@
-exec_prefix = @exec_prefix@
-
-# The directory for object files and libraries of object code. Do
-# not install executables here; they belong in `libexecdir' instead.
-libdir = $(exec_prefix)/lib
-
-# The directory for installing the Info files for this package.
-infodir = $(prefix)/info
-
-elispdir = $(libdir)/emacs/site-lisp
-
-AUTOCONF = autoconf
-EMACS = emacs
-ETAGS = etags
-MAKEINFO = makeinfo
-MAKEINFOFLAGS = --no-split -I. -I$(srcdir)
-BATCHFLAGS = -batch -q -no-site-file
-MV = mv
-RM = rm -f
-CP = cp
-TAR = tar
-TEXI2DVI = texi2dvi
-TEXI2DVIFLAGS = #-I. -I$(srcdir)
-
-#### End of system configuration section. ####
-
-SHELL = /bin/sh
-
-DISTFILES = BUGS TODO COPYING NEWS INSTALL README \
- Makefile.in configure configure.in install-sh mkinstalldirs
-
-DOCFILES = FAQ RFC1459 irc-operators tao-of-irc zenirc.ascii \
- README-OLD ctcp.doc server-list tour.of.irc zenirc.info \
- zenirc.texi undernet 666.conspiracy
-
-SRCFILES = $(ELFILES) ChangeLog zenirc-make.el
-
-ELFILES = zenirc-18.el zenirc-away.el zenirc-bork.el zenirc-command-queue.el \
- zenirc-complete.el zenirc-ctcp-flood.el zenirc-dcc.el \
- zenirc-doto.el zenirc-example.el zenirc-fill.el zenirc-finnish.el \
- zenirc-format.el zenirc-fortran.el zenirc-french.el \
- zenirc-ignore.el zenirc-iwantop.el zenirc-klingon.el \
- zenirc-latin.el zenirc-meditate.el zenirc-netsplit.el \
- zenirc-notify.el zenirc-oink.el zenirc-ojnk.el zenirc-pjg.el \
- zenirc-popup.el zenirc-random-away.el zenirc-random-nick.el \
- zenirc-signal.el zenirc-stamp.el zenirc-swedish.el zenirc-yow.el \
- zenirc-history.el zenirc-color.el zenirc-8ball.el zenirc-trigger.el \
- zenirc-yow-filter.el zenirc.el zenirc-prime-p.el zenirc-eval.el
-
-MFLAGS = ELFILES='$(ELFILES)' \
- AUTOCONF='$(AUTOCONF)' EMACS='$(EMACS)' ETAGS='$(ETAGS)' \
- MAKEINFO='$(MAKEINFO)' MAKEINFOFLAGS='$(MAKEINFOFLAGS)' \
- MV='$(MV)' RM='$(RM)' CP='$(CP)' TAR='$(TAR)' \
- TEXI2DVI='$(TEXI2DVI)' TEXI2DVIFLAGS='$(TEXI2DVIFLAGS)' \
- INSTALL='$(INSTALL)' INSTALL_DATA='$(INSTALL_DATA)' \
- INSTALL_PROGRAM='$(INSTALL_PROGRAM)' SHELL='$(SHELL)' \
- elispdir='$(elispdir)' exec_prefix='$(exec_prefix)' \
- infodir='$(infodir)' libdir='$(libdir)' prefix='$(prefix)'
-
-.SUFFIXES: .texi .info
-.texi.info:
- $(MAKEINFO) $(MAKEINFOFLAGS) $<
-
-.SUFFIXES: .texi .dvi
-.texi.dvi:
- $(TEXI2DVI) $(TEXI2DVIFLAGS) $<
-
-all: all-zenirc
-all-info: info
-
-### targets required by GNU Coding standards ###
-
-Makefile: Makefile.in config.status
- $(SHELL) ./config.status
-
-config.status: configure
- $(SHELL) ./config.status --recheck
-
-configure: configure.in
- cd $(srcdir) && $(AUTOCONF)
-
-TAGS:
- cd $(srcdir)/src && $(ETAGS) *.el
-
-.PHONY: clean mostlyclean distclean
-clean:
- $(RM) src/*.elc
-
-mostlyclean: clean
-
-distclean: clean
- $(RM) Makefile config.status config.log config.cache src/TAGS src/*~ *~
-
-.PHONY: maintainer-clean maintclean-warning
-maintainer-clean: maintclean-warning distclean
-
-# Used by maintainer-clean to print a warning before any rm commands are run.
-maintclean-warning:
- @echo "This command is intended for maintainers to use;"
- @echo "it deletes files that may require special tools to rebuild."
-
-realclean: distclean
- $(RM) src/TAGS
-
-.PHONY: dist
-dist:
- echo zenirc-`sed -e '/^(defconst zenirc-version/!d' \
- -e 's/[^0-9.]*\([0-9.]*\).*/\1/' \
- -e q src/zenirc.el` > .fname
- $(RM) -r `cat .fname`
- dst=`cat .fname`; umask 000 && mkdir $$dst $$dst/doc $$dst/src
- dst=`cat .fname`; for f in $(DISTFILES); do \
- ln $$f $$dst/$$f \
- || { echo copying $$f; cp -p $$f $$dst/$$f ; } \
- done
- dst=`cat .fname`/doc; for f in $(DOCFILES); do \
- ln doc/$$f $$dst/$$f \
- || { echo copying doc/$$f; cp -p doc/$$f $$dst/$$f ; } \
- done
- dst=`cat .fname`/src; for f in $(SRCFILES); do \
- ln src/$$f $$dst/$$f \
- || { echo copying src/$$f; cp -p src/$$f $$dst/$$f ; } \
- done
- $(TAR) --gzip -chvf `cat .fname`.tar.gz `cat .fname`
- $(RM) -r `cat .fname` .fname
-
-# Tar up the development sources
-.PHONY: devtar
-devtar:
- echo zenirc-dev-`sed -e '/^(defconst zenirc-version/!d' \
- -e 's/[^0-9.]*\([0-9.]*\).*/\1/' \
- -e q src/zenirc.el` > .fname
- $(RM) -r ../`cat .fname`
- umask 000 && mkdir ../`cat .fname`
- @echo Copying tree to ../`cat .fname`
- $(TAR) -cf - . | (cd ../`cat .fname` && $(TAR) xpvf -)
- @echo Making tar file `cat .fname`
- dst=`cat .fname`; cd .. && $(TAR) --gzip -chvf $$dst.tar.gz $$dst
- dst=`cat .fname`; cd .. && $(RM) -r $$dst
- mv ../`cat .fname`.tar.gz .
-
-.PHONY: installdirs uninstall
-install: all installdirs
- -cd ./src && $(CP) *.elc $(elispdir)
- # -cd ./doc && $(CP) zenirc.info* $(infodir)
-
-installdirs: force
- -$(SHELL) $(srcdir)/mkinstalldirs $(elispdir) #$(infodir)
-
-uninstall: force
- -cd $(elispdir) && { $(RM) $(ELFILES);
- for f in $(ELFILES); do $(RM) $${f}c; done; }
- -cd $(infodir) && $(RM) zenirc.info*
-
-.PHONY: check installcheck force
-check:
- @echo 'Nothing to be done for "check"'
-
-installcheck:
- @echo 'Nothing to be done for "installcheck"'
-
-force:
-
-### program-specific building targets ###
-
-all-zenirc: elisp #info
-elisp:
- -cd ./src && $(EMACS) $(BATCHFLAGS) -l zenirc-make.el \
- -f batch-byte-compile $(ELFILES)
-
-info: zenirc.info
-zenirc.info: zenirc.texi
-
-dvi: zenirc.dvi
-zenirc.dvi: zenirc.texi
-
-# Prevent GNU make v3 from overflowing arg limit on SysV.
-.NOEXPORT:
-
-# Makefile.in ends here
+++ /dev/null
-User-visible changes in ZenIRC-2.112:
-
-* Removed new-lines from all the different language catalouge
- entries. zenirc-messages adds this if appropriate.
-
-* zenirc-prime.el, new script. Calculates prime numbers.
-
-* zenirc-eval.el, new script. Evaluate special commands being sent to
- you from other people on IRC. USE WITH CAUTION!
-
-* zenirc-history.el now binds M-p and M-n to previous- and next-line.
-
-* zenirc-yow-filter.el, new script. Filter out all the annoying
- automated yows.
-
-* zenirc-color.el, new script; colorize your ZenIRC. Should work with
- Emacs-19, Emacs-20 and XEmacs.
-
-* zenirc-8ball.el, new script. Ask 8-ball easy yes/no questions.
-
-* zenirc-trigger.el, new script. Easy creation of triggers to incoming
- messages.
-
-* zenirc-ignore.el is more vocal to the user, also added
- zenirc-ignore-last-privmsg on C-c C-i to ignore the user@host of the
- last seen PRIVMSG.
-
- It's also much brighter when it comes to regexp handling.
-
-* zenirc-notify.el, better handling of upper and lower case
- nicknames. Much better command parser when adding and removing
- victims in real time.
-
-* zenirc-random-nick.el, added code do automatically change nickname
- every x number of seconds.
-
-* zenirc-fill.el, rerwritten to look more like the 2.100
- version. Two new ways of filling are added:
- zenirc-wrap-region-dynamic and -wrap-region-static. Added functions
- to fill outgoing messages as well as incoming ones. The filling
- functions now also uses the correct width of the *right* buffer.
-
-* zenirc-example.el, a lot of new examples.
-
-* All special modes can now be turned on and off with zenirc-*-mode.
-
-* zenirc-signal functions are smarter; doesn't beep when it shouldn't
- anymore.
-
-* zenirc-select uses zenirc-server-alist in a much smarter way.
-
-* zenirc-format-privmsg-or-notice now reckons PRIVMSG's to user@server
- in a better way.
-
-* Better handling of nick!user@host table in zenirc-format.el.
-
-* zenirc-bug, new function.
-
-* zenirc-update-modeline, a function which updates the modeline
- depending on which version of Emacs you are using. Relevant functions
- in ZenIRC now uses this.
-
-* zenirc-channel-list, a list of currently joined channels. If you
- leave your zenirc-current-victim it gets set to the previous channel.
- C-c C-t toggles between all the channels with zenirc-toggle-channel.
-
-* Added a couple of ircII lookalikes:
-
- zenirc-always-show-channelname, new variable. If set to nil, strip
- out the channelnames from incoming PRIVMSGs and NOTICEs if the
- channelname is the same as the current-victim.
-
- zenirc-delete-preceding-whitespaces, newvariable. If set to t, strip
- off leading whitespaces on outgoing messages.
-
- zenirc-whowas-on-401, new variable. If set to t, ZenIRC will issue a
- WHOWAS command if no information is gained by a WHOIS command.
-
-* More additions to conform with ircd2.9 news.
-
-As of 1996-04-24, Per has taken over primary maintenance of ZenIRC.
-
-User-visible changes in ZenIRC 2.101:
-
-* New function, gnus-bug. Initialize mail to make it easier for user
- to report a newly found bug.
-
-* Comments on how to do automatic things while initializing a server
- connection in zenirc-example.el.
-
-* Takes care of more new irc2.9 NUMERICS.
-
-* Responds to CTCP ECHO queries.
-
-As of 1995-06-28, Per started adding patches to ZenIRC alpha versions.
-
-* All the notify code is stripped out of zenirc.el into a -notify.el
- script. The notify code is able to check user@host info on
- notificated persons. Most of the code is also totally rewritten,
- some of the features are much better sanity checking.
-
-* /server, a new command using zenirc-select, lets you connect to
- servers in an easy way. /server irc-2.mit.edu 6667 ben
- The command uses zenirc-server-alist, it also defaults to just about
- every setting you can think of.
-
-* zenirc-ignore.el gives you ircII like /ignore and /unignore, an easier
- way to maintain your zenirc-ignore-list in real time. If you use the
- commands with regexps, it doesn't do it the ircII way.
-
-* /resize command in zenirc-fill.el lets you resize the fill values if
- you change the size of your emacsen.
-
- There also a new way of filling things, based on the first word of the
- string.
-
-* The variable zenirc-command-char lets you decide which char you want
- to use as a command char. "/" is default and you can change it with
- /commandchar.
-
-* zenirc-klingon.el and zenirc-bork.el are two new sets of language
- catalogs.
-
-* /topic is now able to SHOW the topic as well as set it.
-
-* The Makefile is now able to make and install ZenIRC, it uses
- zenirc-make.el to do so. Needs some improvment though.
-
-* zenirc-iwantop.el has better documentation for new users.
-
-* ZenIRC is able to display confirmation messages in the echo area
- instead of in the process buffer, at least better than it did before.
-
-* ZenIRC shows idletime in hours:minutes:seconds instead of plain
- seconds.
-
-* zenirc-history.el gives you shell-like C-p and C-n on C-cC-p and
- C-cC-n.
-
-* ZenIRC groks most of the 2.9 news, as well as some ugly additions to
- 2.8 by digital and comstud. FOLLOW THE RFC OR DIE.
-
-* There's code in zenirc.el to let you timestamp PRIVMSG/NOTICE, the
- code makes it really easy to add timestamps for other thingies.
-
-* Some of the numeric replies parsing are changed to show relevant
- information. 2.9 changes some of the replies so ZenIRC has to do
- more sanity checking (this is not totally perfect yet).
-
-* New funny files in the doc directory.
-
-\f
-As of 1994-10-02, Noah has taken over primary maintenance of zenirc.
-
-User-visible changes in ZenIRC 2.100:
-
-* ZenIRC now configures and installs using an Autoconf-generated configure
- script. [Makefile is only 4/5 finished 1995-03-27]
-
-* The version number no longer directly corresponds with the RCS revision
- number of zenirc.el. A separate version number is used, which will only
- change in each release. As a result, releases won't have arbitrarily
- incremented version numbers.
-
-* The new file zenirc-fill.el provides a minor mode which formats privmsgs,
- notices, and whatever kinds of messages you specify, so that they don't
- exceed the width of your window. Selective control is provided since
- some tables produced by the server will look terrible if anything
- attempts to fold them.
-
-* It is now possible to load multiple language catalogs and switch between
- them using "/language" or `M-x zenirc-lang-set-current-language'.
-
-* The DCC interface has been largely rewritten.
- It uses the message catalogs and has more hooks.
- Another notable change is the fact that subsequent DCC chat requests from
- the same user are stored and previous requests are discarded.
- This is in case the port number or IP address have changed in the new
- request.
-
-* All the external message catalogs have been renamed by removing the
- `-mode' in their name. For example, zenirc-latin-mode.el is now
- zenirc-latin.el. They are updated to use the new catalog mechanism.
-
-* Almost all tables are now implemented as hash tables instead of
- linear lists. This should speed up searches.
-
-* Line input has been completely reimplemented. It's now safe to send very
- long lines in private messages and notices; if necessary they are broken
- into multiple chunks and sent separately.
-
- Also, it's easier to send text line-at-a-time by yanking text into the
- buffer, moving point to the beginning of the new input, and hitting
- return successively. No excess newlines are inserted any more, and point
- is automatically positioned on the next line of unsent input.
-
- You can have confirmation of sending go in the echo area instead of
- inserting lines in the buffer.
-
-* /kick, /kill, /notice, /privmsg, and /squit commands are now sent to the
- server in the proper format.
-
-* zenirc-popup is now a minor mode that can be enabled or disabled with the
- `zenirc-popup-mode' command. It should also work in emacs 18 now.
-
-* The method of display for matching completions can be controlled by the
- user via the variable `zenirc-complete-display-function'. The default is
- to display completions in the echo area if they will fit. Otherwise, use
- a portion of the zenirc window.
-
- The variable `zenirc-complete-add-final-space-p' controls whether a
- trailing space is added to unique completions. The default is to do so
- since this is consistent with completion in emacs and other GNU programs.
-
-* You can now use `;' and `:' to send a private message to the last person
- you sent a private message to, or who sent you a private message. These
- keys only have this special meaning if they are the first character of
- your input.
-
- The other commands which do this used to be bound on `C-c s' and `C-c r'.
- They are now on `C-c C-s' and `C-c C-r', since the former keys are
- reserved for the user's private use. These commands always insert the
- recipient's name at the beginning of your input, rather than wherever
- point happens to be.
-
-* The mechanism for specifying how to connect to servers is completely
- revamped. The variable `zenirc-server-alist' is used to specify a list
- of servers (with optional port/password/nick info). Each one is tried in
- turn until a successful connection is made. It is initialized from your
- IRCSERVER environment variable, which can have the same format as parsed
- by ircII.
-
- You can set the variables `zenirc-server-default', `zenirc-nick-default',
- `zenirc-port-default', etc. Or if these are unset, the appropriate
- environment variables are used.
-
-* By default, any message with more than 4 CTCP queries is ignored.
- This is to avoid being disconnected for flooding.
- To disable this check, remove the appropriate regexp from
- zenirc-ignorance-list.
-
-* A new hook, zenirc-message-hook, is called each time a message is
- inserted in the buffer. The hook zenirc-send-line-hook is called each
- time you send a line of text.
-
-* If a command hook is nil, the command is just sent directly to the server,
- like /quote. To keep a command from going to the server at all, put the
- `ignore' function on the appropriate hook.
-
-* The new script zenirc-iwantop.el allows you to accept ctcp queries from
- users and give them channel operator privileges automatically.
-
-* zenirc-fancy-away.el has been renamed to zenirc-away.el.
- zenirc-fancy-format.el has been renamed to zenirc-format.el.
- zenirc-fancy-signal.el has been renamed to zenirc-signal.el.
-
-* Too many bug fixes and other minor improvments to mention here.
- See the ChangeLog for details.
-
-\f
-Changes to ZenIRC in version 2.16:
-
-* Added /oper command.
-
-\f
-Changes to ZenIRC in version 2.15:
-
-* New scripts: zenirc-popup.el, zenirc-fancy-away.el, and zenirc-yow.el
- The first pops up a window when signals occur and there is presently no
- window displaying that buffer.
- The second insures that you see a user's away message only once, until
- they change it again.
- The last implements the command /yow, and also allows you to
- autoreply to victims with zippy quotes.
-
-* zenirc-complete.el has been completely rewritten.
- The new version is better at insidiously caching data, doesn't tamper
- with the kill-ring, and has fewer bugs.
-
-* Made most files, including zenirc.el, "provide" themselves.
- Also made any scripts which refer to symbols declared in zenirc.el
- require it.
-
- This means that in emacs 19, you can use M-x unload-feature to easily
- undo most of the effects of loading a package, except for top-level
- forms.
-
-* zenirc has a new hook, zenirc-mode-hook, that is called at the end of
- zenirc-mode.
-
-* Many bugs fixes in process filters to keep point and window display from
- being munged incorrectly, to keep signal hooks from running when not
- appropriate (and also so that other hooks can permanently modify the
- state of buffers if desired).
-
-* Made signal hooks run last, after buffer update has already occured.
-
-* Removed recursion from some basic regexp matching routines.
-
-* Fixed bug in DCC chat code that was occasionally dropping bits of
- incoming lines.
-
-* New script, zenirc-random-nick.el, can be used to randomly choose
- nicknames for IRC if you are feeling deconstructionist.
+++ /dev/null
-ZenIRC-2.1 - Wed Apr 24 20:41:48 MET DST 1996 - Per Persson <pp@sno.pp.se>
-
-KNOWN BUGS:
-
-See the BUGS file.
-For missing features, look in the TODO file.
-
-
-KNOWN FEATURES AND INSTRUCTIONS:
-
-See the INSTALL file for help on how to compile and install ZenIRC.
-
-Look at zenirc-example.el for help on how to set up ZenIRC for daily
-usage. If you want more information about ZenIRC internals, read
-doc/README (beware, this file is out of date). In time ZenIRC will
-come with a texinfo manual.
-
-Found a new bug? Report it with "zenirc-bug" and we'll fix it!
-
-
-FURTHER INSTRUCTIONS:
-
-The most current versions of ZenIRC can always be found at;
-
- ftp://ftp.splode.com:/pub/zenirc
-
-There are three email addresses for ZenIRC you might be interested in;
-
- zenirc@splode.com (List for annoucments and important mails.)
- send mail to zenirc-request@splode.com to subscribe.
- zenirc-dev@splode.com (List for ZenIRC developers.)
- send mail to zenirc-dev-request@splode.com to subscribe.
- zenirc-bug@splode.com (List for bug reports.)
- this list is not interesting for you, unless you find a bug.
+++ /dev/null
-ZenIRC TODO list -- Last updated 1998-05-07
-
-* zenirc.el
-
- Strip ^F, ^P, ^U, ^B and ^_ from receieved PRIVMSG, NOTICE and
- TOPIC. Possibly add functions for this in zenirc.color.el at a later
- stage.
-
-* zenirc-fill.el
-
- Add optional function to strip off whitespaces at the end of messages.
-
-* Show Y-class when using /trace command.
-
-* Define current-time for emacs 18.
- Define current-time-string in 18 so that it can format arbitrary time values.
-
-* /ping
-
- Instead of trying to send to hack current-time-string, or represent big
- integers and such, just send the printed representation of a call to
- current-time. Then when the reply comes back, read the result and
- compare the conses. The way to compute the difference of these times is
-
- (defsubst time-difference (a b)
- (+ (lsh (- (car b) (car a)) 16)
- (- (car (cdr b)) (car (cdr a)))))
-
- This returns the number of seconds elapsed.
-
- I would like to remove the kiwi-derived routines anyway.
-
-* zenirc-notify.el
-
- Make it not trigger if you see the person leave or join a channel.
-
-* zenirc-complete.el
-
- Make it add nicks seen based on zenirc-complete-add-list, would be
- nice to add things on /trace and /userhost.
-
-* Allow messages from specific users, or different types of messages, to go
- into different buffers.
-
- If a general mechanism is implemented for this, zenirc-dcc.el should use
- it.
-
- It is likely that zenirc-message will have take a new arg, indicating
- into which buffer the message should go.
-
- [1995-03-16 Noah is working on this as part of a general purpose library
- for emacs.]
-
- [1996-07-22 Jason (and Per) is working on another solution to this.]
-
-* Implement "filters", to distinguish semantics from hooks.
-
- Some things, like the zenirc-format-nickuserhost-hook, don't really want
- to run all the functions; it wants to terminate as soon as a desirable
- formatting is completed.
-
- There are other instances where two hooks do not necessarily want to be
- run independently. For instance, zenirc-away.el only wants to display an
- away message if the current away message for a user is not in its cache
- already.
-
- But in general, hooks want to be run independently of each other since
- they may perform some completely orthogonal action, so if some other hook
- wants to abort running the rest of the hook list, the user is screwed.
-
- I propose a "filter" mechanism which provides a way to specify ordering,
- i.e. they should be able to say "I need to be run before foo but after
- bar" (and this requirement also assumes that bar must necessarily be run
- after foo). Packages which use this new mechamism may have to know some
- details about other packages for this to work, but that's a given. These
- filters would be of a different nature from the hooks now being used.
-
- I do not have a specific interface in mind yet, but I suspect that
- filters will generally be run via the hook mechanism, i.e. one will
- generally do
-
- (zenirc-add-hook 'zenirc-foo-hook
- (function
- (lambda (&rest args)
- (apply 'zenirc-run-filter 'zenirc-foo-filter args))))
-
-* Update non-english message catalogs with new strings added to the client
- since it they were first created.
-
-* Write a texinfo manual.
-
-* Make 'undo' only apply to unsent text.
-
-* Make recieved text 'read-only'.
-
-\f
-Low priority:
-
-* /list with regexp's.
-
-* Finish zenirc-eval.el.
-
- This should operate as a CTCP message that reads a sexp and evaluates it.
- In addition to regular eval, there should be an eval-print or some other
- macro that takes the result and sends it in the CTCP reply. Since irc
- messages are limited to 255 chars or so, the syntactic sugar would be
- helpful.
-
- For the sake of security weenies, it should have an access list, probably
- a list of regexps of user@host addresses which are allowed to send
- messages.
-
- Perhaps there should also be a "novice" flag which displays the form to
- be evaluated in the minibuffer (or a display buffer) and query for
- confirmation before doing anything.
-
-* Write zenirc-alias.el
-
- ircII like alias but not as smart.
-
-* Write zenirc-save.el
- This should save some default values to a special zenirc.rc file
- which ZenIRC loads during startup.
-
-* Write zenirc-eliza.el
-
- This should implement an eliza bot via doctor.el.
-
-* Write zenirc-swedish-chef.el
-
- This should be a process filter that converts everything people say into
- swedish-chef speak, and it should have an abbrev table that dynamically
- converts user input as well.
-
-* Write zenirc-face.el
-
- This should be code for Emacs 19 and XEmacs to support highlighting
- for ^Vregions^V and the like.
-
-* Write zenirc-mcelwane.el
-
- Upcase words RANDOMLY on INPUT!
-
-* zenirc supporting bold controls
-
- From: Andrew J Cosgriff <ajc@bing.wattle.id.au>
- any chance of zenirc supporting bold controls and stuff (^B et al.) ?
-
+++ /dev/null
-#!/bin/sh
-
-# Guess values for system-dependent variables and create Makefiles.
-# Generated automatically using autoconf version 2.1
-# Copyright (C) 1992, 1993, 1994 Free Software Foundation, Inc.
-#
-# This configure script is free software; the Free Software Foundation
-# gives unlimited permission to copy, distribute and modify it.
-
-# Defaults:
-ac_help=
-ac_default_prefix=/usr/local
-# Any additions from configure.in:
-
-# Initialize some variables set by options.
-# The variables have the same names as the options, with
-# dashes changed to underlines.
-build=NONE
-cache_file=./config.cache
-exec_prefix=NONE
-host=NONE
-no_create=
-nonopt=NONE
-no_recursion=
-prefix=NONE
-program_prefix=NONE
-program_suffix=NONE
-program_transform_name=s,x,x,
-silent=
-site=
-srcdir=
-target=NONE
-verbose=
-x_includes=NONE
-x_libraries=NONE
-
-# Initialize some other variables.
-subdirs=
-
-ac_prev=
-for ac_option
-do
-
- # If the previous option needs an argument, assign it.
- if test -n "$ac_prev"; then
- eval "$ac_prev=\$ac_option"
- ac_prev=
- continue
- fi
-
- case "$ac_option" in
- -*=*) ac_optarg=`echo "$ac_option" | sed 's/[-_a-zA-Z0-9]*=//'` ;;
- *) ac_optarg= ;;
- esac
-
- # Accept the important Cygnus configure options, so we can diagnose typos.
-
- case "$ac_option" in
-
- -build | --build | --buil | --bui | --bu | --b)
- ac_prev=build ;;
- -build=* | --build=* | --buil=* | --bui=* | --bu=* | --b=*)
- build="$ac_optarg" ;;
-
- -cache-file | --cache-file | --cache-fil | --cache-fi \
- | --cache-f | --cache- | --cache | --cach | --cac | --ca | --c)
- ac_prev=cache_file ;;
- -cache-file=* | --cache-file=* | --cache-fil=* | --cache-fi=* \
- | --cache-f=* | --cache-=* | --cache=* | --cach=* | --cac=* | --ca=* | --c=*)
- cache_file="$ac_optarg" ;;
-
- -disable-* | --disable-*)
- ac_feature=`echo $ac_option|sed -e 's/-*disable-//'`
- # Reject names that are not valid shell variable names.
- if test -n "`echo $ac_feature| sed 's/[-a-zA-Z0-9_]//g'`"; then
- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
- fi
- ac_feature=`echo $ac_feature| sed 's/-/_/g'`
- eval "enable_${ac_feature}=no" ;;
-
- -enable-* | --enable-*)
- ac_feature=`echo $ac_option|sed -e 's/-*enable-//' -e 's/=.*//'`
- # Reject names that are not valid shell variable names.
- if test -n "`echo $ac_feature| sed 's/[-_a-zA-Z0-9]//g'`"; then
- { echo "configure: error: $ac_feature: invalid feature name" 1>&2; exit 1; }
- fi
- ac_feature=`echo $ac_feature| sed 's/-/_/g'`
- case "$ac_option" in
- *=*) ;;
- *) ac_optarg=yes ;;
- esac
- eval "enable_${ac_feature}='$ac_optarg'" ;;
-
- -exec-prefix | --exec_prefix | --exec-prefix | --exec-prefi \
- | --exec-pref | --exec-pre | --exec-pr | --exec-p | --exec- \
- | --exec | --exe | --ex)
- ac_prev=exec_prefix ;;
- -exec-prefix=* | --exec_prefix=* | --exec-prefix=* | --exec-prefi=* \
- | --exec-pref=* | --exec-pre=* | --exec-pr=* | --exec-p=* | --exec-=* \
- | --exec=* | --exe=* | --ex=*)
- exec_prefix="$ac_optarg" ;;
-
- -gas | --gas | --ga | --g)
- # Obsolete; use --with-gas.
- with_gas=yes ;;
-
- -help | --help | --hel | --he)
- # Omit some internal or obsolete options to make the list less imposing.
- # This message is too long to be a string in the A/UX 3.1 sh.
- cat << EOF
-Usage: configure [options] [host]
-Options: [defaults in brackets after descriptions]
-Configuration:
- --cache-file=FILE cache test results in FILE
- --help print this message
- --no-create do not create output files
- --quiet, --silent do not print \`checking...' messages
- --version print the version of autoconf that created configure
-Directory and file names:
- --prefix=PREFIX install architecture-independent files in PREFIX
- [$ac_default_prefix]
- --exec-prefix=PREFIX install architecture-dependent files in PREFIX
- [same as prefix]
- --srcdir=DIR find the sources in DIR [configure dir or ..]
- --program-prefix=PREFIX prepend PREFIX to installed program names
- --program-suffix=SUFFIX append SUFFIX to installed program names
- --program-transform-name=PROGRAM run sed PROGRAM on installed program names
-Host type:
- --build=BUILD configure for building on BUILD [BUILD=HOST]
- --host=HOST configure for HOST [guessed]
- --target=TARGET configure for TARGET [TARGET=HOST]
-Features and packages:
- --disable-FEATURE do not include FEATURE (same as --enable-FEATURE=no)
- --enable-FEATURE[=ARG] include FEATURE [ARG=yes]
- --with-PACKAGE[=ARG] use PACKAGE [ARG=yes]
- --without-PACKAGE do not use PACKAGE (same as --with-PACKAGE=no)
- --x-includes=DIR X include files are in DIR
- --x-libraries=DIR X library files are in DIR
---enable and --with options recognized:$ac_help
-EOF
- exit 0 ;;
-
- -host | --host | --hos | --ho)
- ac_prev=host ;;
- -host=* | --host=* | --hos=* | --ho=*)
- host="$ac_optarg" ;;
-
- -nfp | --nfp | --nf)
- # Obsolete; use --without-fp.
- with_fp=no ;;
-
- -no-create | --no-create | --no-creat | --no-crea | --no-cre \
- | --no-cr | --no-c)
- no_create=yes ;;
-
- -no-recursion | --no-recursion | --no-recursio | --no-recursi \
- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r)
- no_recursion=yes ;;
-
- -prefix | --prefix | --prefi | --pref | --pre | --pr | --p)
- ac_prev=prefix ;;
- -prefix=* | --prefix=* | --prefi=* | --pref=* | --pre=* | --pr=* | --p=*)
- prefix="$ac_optarg" ;;
-
- -program-prefix | --program-prefix | --program-prefi | --program-pref \
- | --program-pre | --program-pr | --program-p)
- ac_prev=program_prefix ;;
- -program-prefix=* | --program-prefix=* | --program-prefi=* \
- | --program-pref=* | --program-pre=* | --program-pr=* | --program-p=*)
- program_prefix="$ac_optarg" ;;
-
- -program-suffix | --program-suffix | --program-suffi | --program-suff \
- | --program-suf | --program-su | --program-s)
- ac_prev=program_suffix ;;
- -program-suffix=* | --program-suffix=* | --program-suffi=* \
- | --program-suff=* | --program-suf=* | --program-su=* | --program-s=*)
- program_suffix="$ac_optarg" ;;
-
- -program-transform-name | --program-transform-name \
- | --program-transform-nam | --program-transform-na \
- | --program-transform-n | --program-transform- \
- | --program-transform | --program-transfor \
- | --program-transfo | --program-transf \
- | --program-trans | --program-tran \
- | --progr-tra | --program-tr | --program-t)
- ac_prev=program_transform_name ;;
- -program-transform-name=* | --program-transform-name=* \
- | --program-transform-nam=* | --program-transform-na=* \
- | --program-transform-n=* | --program-transform-=* \
- | --program-transform=* | --program-transfor=* \
- | --program-transfo=* | --program-transf=* \
- | --program-trans=* | --program-tran=* \
- | --progr-tra=* | --program-tr=* | --program-t=*)
- program_transform_name="$ac_optarg" ;;
-
- -q | -quiet | --quiet | --quie | --qui | --qu | --q \
- | -silent | --silent | --silen | --sile | --sil)
- silent=yes ;;
-
- -site | --site | --sit)
- ac_prev=site ;;
- -site=* | --site=* | --sit=*)
- site="$ac_optarg" ;;
-
- -srcdir | --srcdir | --srcdi | --srcd | --src | --sr)
- ac_prev=srcdir ;;
- -srcdir=* | --srcdir=* | --srcdi=* | --srcd=* | --src=* | --sr=*)
- srcdir="$ac_optarg" ;;
-
- -target | --target | --targe | --targ | --tar | --ta | --t)
- ac_prev=target ;;
- -target=* | --target=* | --targe=* | --targ=* | --tar=* | --ta=* | --t=*)
- target="$ac_optarg" ;;
-
- -v | -verbose | --verbose | --verbos | --verbo | --verb)
- verbose=yes ;;
-
- -version | --version | --versio | --versi | --vers)
- echo "configure generated by autoconf version 2.1"
- exit 0 ;;
-
- -with-* | --with-*)
- ac_package=`echo $ac_option|sed -e 's/-*with-//' -e 's/=.*//'`
- # Reject names that are not valid shell variable names.
- if test -n "`echo $ac_package| sed 's/[-_a-zA-Z0-9]//g'`"; then
- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
- fi
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- case "$ac_option" in
- *=*) ;;
- *) ac_optarg=yes ;;
- esac
- eval "with_${ac_package}='$ac_optarg'" ;;
-
- -without-* | --without-*)
- ac_package=`echo $ac_option|sed -e 's/-*without-//'`
- # Reject names that are not valid shell variable names.
- if test -n "`echo $ac_package| sed 's/[-a-zA-Z0-9_]//g'`"; then
- { echo "configure: error: $ac_package: invalid package name" 1>&2; exit 1; }
- fi
- ac_package=`echo $ac_package| sed 's/-/_/g'`
- eval "with_${ac_package}=no" ;;
-
- --x)
- # Obsolete; use --with-x.
- with_x=yes ;;
-
- -x-includes | --x-includes | --x-include | --x-includ | --x-inclu \
- | --x-incl | --x-inc | --x-in | --x-i)
- ac_prev=x_includes ;;
- -x-includes=* | --x-includes=* | --x-include=* | --x-includ=* | --x-inclu=* \
- | --x-incl=* | --x-inc=* | --x-in=* | --x-i=*)
- x_includes="$ac_optarg" ;;
-
- -x-libraries | --x-libraries | --x-librarie | --x-librari \
- | --x-librar | --x-libra | --x-libr | --x-lib | --x-li | --x-l)
- ac_prev=x_libraries ;;
- -x-libraries=* | --x-libraries=* | --x-librarie=* | --x-librari=* \
- | --x-librar=* | --x-libra=* | --x-libr=* | --x-lib=* | --x-li=* | --x-l=*)
- x_libraries="$ac_optarg" ;;
-
- -*) { echo "configure: error: $ac_option: invalid option; use --help to show usage" 1>&2; exit 1; }
- ;;
-
- *)
- if test -n "`echo $ac_option| sed 's/[-a-z0-9.]//g'`"; then
- echo "configure: warning: $ac_option: invalid host type" 1>&2
- fi
- if test "x$nonopt" != xNONE; then
- { echo "configure: error: can only configure for one host and one target at a time" 1>&2; exit 1; }
- fi
- nonopt="$ac_option"
- ;;
-
- esac
-done
-
-if test -n "$ac_prev"; then
- { echo "configure: error: missing argument to --`echo $ac_prev | sed 's/_/-/g'`" 1>&2; exit 1; }
-fi
-
-trap 'rm -fr conftest* confdefs* core $ac_clean_files; exit 1' 1 2 15
-
-# File descriptor usage:
-# 0 unused; standard input
-# 1 file creation
-# 2 errors and warnings
-# 3 unused; some systems may open it to /dev/tty
-# 4 checking for... messages and results
-# 5 compiler messages saved in config.log
-if test "$silent" = yes; then
- exec 4>/dev/null
-else
- exec 4>&1
-fi
-exec 5>./config.log
-
-echo "\
-This file contains any messages produced by compilers while
-running configure, to aid debugging if configure makes a mistake.
-" 1>&5
-
-# Strip out --no-create and --no-recursion so they do not pile up.
-# Also quote any args containing shell metacharacters.
-ac_configure_args=
-for ac_arg
-do
- case "$ac_arg" in
- -no-create | --no-create | --no-creat | --no-crea | --no-cre \
- | --no-cr | --no-c) ;;
- -no-recursion | --no-recursion | --no-recursio | --no-recursi \
- | --no-recurs | --no-recur | --no-recu | --no-rec | --no-re | --no-r) ;;
- *" "*|*" "*|*[\[\]\~\#\$\^\&\*\(\)\{\}\\\|\;\<\>\?]*)
- ac_configure_args="$ac_configure_args '$ac_arg'" ;;
- *) ac_configure_args="$ac_configure_args $ac_arg" ;;
- esac
-done
-
-# NLS nuisances.
-# Only set LANG and LC_ALL to C if already set.
-# These must not be set unconditionally because not all systems understand
-# e.g. LANG=C (notably SCO).
-if test "${LC_ALL+set}" = set; then LC_ALL=C; export LC_ALL; fi
-if test "${LANG+set}" = set; then LANG=C; export LANG; fi
-
-# confdefs.h avoids OS command line length limits that DEFS can exceed.
-rm -rf conftest* confdefs.h
-# AIX cpp loses on an empty file, so make sure it contains at least a newline.
-echo > confdefs.h
-
-# A filename unique to this package, relative to the directory that
-# configure is in, which we can look for to find out if srcdir is correct.
-ac_unique_file=Makefile.in
-
-# Find the source files, if location was not specified.
-if test -z "$srcdir"; then
- ac_srcdir_defaulted=yes
- # Try the directory containing this script, then its parent.
- ac_prog=$0
- ac_confdir=`echo $ac_prog|sed 's%/[^/][^/]*$%%'`
- test "x$ac_confdir" = "x$ac_prog" && ac_confdir=.
- srcdir=$ac_confdir
- if test ! -r $srcdir/$ac_unique_file; then
- srcdir=..
- fi
-else
- ac_srcdir_defaulted=no
-fi
-if test ! -r $srcdir/$ac_unique_file; then
- if test "$ac_srcdir_defaulted" = yes; then
- { echo "configure: error: can not find sources in $ac_confdir or .." 1>&2; exit 1; }
- else
- { echo "configure: error: can not find sources in $srcdir" 1>&2; exit 1; }
- fi
-fi
-srcdir=`echo "${srcdir}" | sed 's%\([^/]\)/*$%\1%'`
-
-# Prefer explicitly selected file to automatically selected ones.
-if test -z "$CONFIG_SITE"; then
- if test "x$prefix" != xNONE; then
- CONFIG_SITE="$prefix/share/config.site $prefix/etc/config.site"
- else
- CONFIG_SITE="$ac_default_prefix/share/config.site $ac_default_prefix/etc/config.site"
- fi
-fi
-for ac_site_file in $CONFIG_SITE; do
- if test -r "$ac_site_file"; then
- echo "loading site script $ac_site_file"
- . "$ac_site_file"
- fi
-done
-
-if test -r "$cache_file"; then
- echo "loading cache $cache_file"
- . $cache_file
-else
- echo "creating cache $cache_file"
- > $cache_file
-fi
-
-ac_ext=c
-# CFLAGS is not in ac_cpp because -g, -O, etc. are not valid cpp options.
-ac_cpp='$CPP $CPPFLAGS'
-ac_compile='${CC-cc} $CFLAGS $CPPFLAGS conftest.$ac_ext -c 1>&5 2>&5'
-ac_link='${CC-cc} $CFLAGS $CPPFLAGS $LDFLAGS conftest.$ac_ext -o conftest $LIBS 1>&5 2>&5'
-
-if (echo "testing\c"; echo 1,2,3) | grep c >/dev/null; then
- # Stardent Vistra SVR4 grep lacks -e, says ghazi@caip.rutgers.edu.
- if (echo -n testing; echo 1,2,3) | sed s/-n/xn/ | grep xn >/dev/null; then
- ac_n= ac_c='
-' ac_t=' '
- else
- ac_n=-n ac_c= ac_t=
- fi
-else
- ac_n= ac_c='\c' ac_t=
-fi
-
-
-ac_aux_dir=
-for ac_dir in $srcdir $srcdir/.. $srcdir/../..; do
- if test -f $ac_dir/install-sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install-sh -c"
- break
- elif test -f $ac_dir/install.sh; then
- ac_aux_dir=$ac_dir
- ac_install_sh="$ac_aux_dir/install.sh -c"
- break
- fi
-done
-if test -z "$ac_aux_dir"; then
- { echo "configure: error: can not find install-sh or install.sh in $srcdir $srcdir/.. $srcdir/../.." 1>&2; exit 1; }
-fi
-ac_config_guess=$ac_aux_dir/config.guess
-ac_config_sub=$ac_aux_dir/config.sub
-ac_configure=$ac_aux_dir/configure # This should be Cygnus configure.
-
-# Find a good install program. We prefer a C program (faster),
-# so one script is as good as another. But avoid the broken or
-# incompatible versions:
-# SysV /etc/install, /usr/sbin/install
-# SunOS /usr/etc/install
-# IRIX /sbin/install
-# AIX /bin/install
-# AFS /usr/afsws/bin/install, which mishandles nonexistent args
-# SVR4 /usr/ucb/install, which tries to use the nonexistent group "staff"
-# ./install, which can be erroneously created by make from ./install.sh.
-echo $ac_n "checking for a BSD compatible install""... $ac_c" 1>&4
-if test -z "$INSTALL"; then
-if eval "test \"`echo '${'ac_cv_path_install'+set}'`\" = set"; then
- echo $ac_n "(cached) $ac_c" 1>&4
-else
- IFS="${IFS= }"; ac_save_ifs="$IFS"; IFS="${IFS}:"
- for ac_dir in $PATH; do
- case "$ac_dir" in
- ''|.|/etc|/usr/sbin|/usr/etc|/sbin|/usr/afsws/bin|/usr/ucb) ;;
- *)
- # OSF1 and SCO ODT 3.0 have their own names for install.
- for ac_prog in ginstall installbsd scoinst install; do
- if test -f $ac_dir/$ac_prog; then
- if test $ac_prog = install &&
- grep dspmsg $ac_dir/$ac_prog >/dev/null 2>&1; then
- # AIX install. It has an incompatible calling convention.
- # OSF/1 installbsd also uses dspmsg, but is usable.
- :
- else
- ac_cv_path_install="$ac_dir/$ac_prog -c"
- break 2
- fi
- fi
- done
- ;;
- esac
- done
- IFS="$ac_save_ifs"
- # As a last resort, use the slow shell script.
- test -z "$ac_cv_path_install" && ac_cv_path_install="$ac_install_sh"
-fi
- INSTALL="$ac_cv_path_install"
-fi
-echo "$ac_t""$INSTALL" 1>&4
-
-# Use test -z because SunOS4 sh mishandles braces in ${var-val}.
-# It thinks the first close brace ends the variable substitution.
-test -z "$INSTALL_PROGRAM" && INSTALL_PROGRAM='${INSTALL}'
-
-test -z "$INSTALL_DATA" && INSTALL_DATA='${INSTALL} -m 644'
-
-trap '' 1 2 15
-if test -w $cache_file; then
-echo "updating cache $cache_file"
-cat > $cache_file <<\EOF
-# This file is a shell script that caches the results of configure
-# tests run on this system so they can be shared between configure
-# scripts and configure runs. It is not useful on other systems.
-# If it contains results you don't want to keep, you may remove or edit it.
-#
-# By default, configure uses ./config.cache as the cache file,
-# creating it if it does not exist already. You can give configure
-# the --cache-file=FILE option to use a different cache file; that is
-# what configure does when it calls configure scripts in
-# subdirectories, so they share the cache.
-# Giving --cache-file=/dev/null disables caching, for debugging configure.
-# config.status only pays attention to the cache file if you give it the
-# --recheck option to rerun configure.
-#
-EOF
-# Ultrix sh set writes to stderr and can't be redirected directly.
-(set) 2>&1 |
- sed -n "s/^\([a-zA-Z0-9_]*_cv_[a-zA-Z0-9_]*\)=\(.*\)/: \${\1='\2'}/p" \
- >> $cache_file
-else
-echo "not updating unwritable cache $cache_file"
-fi
-
-trap 'rm -fr conftest* confdefs* core $ac_clean_files; exit 1' 1 2 15
-
-test "x$prefix" = xNONE && prefix=$ac_default_prefix
-# Let make expand exec_prefix.
-test "x$exec_prefix" = xNONE && exec_prefix='${prefix}'
-
-# Any assignment to VPATH causes Sun make to only execute
-# the first set of double-colon rules, so remove it if not needed.
-# If there is a colon in the path, we need to keep it.
-if test "x$srcdir" = x.; then
- ac_vpsub='/^[ ]*VPATH[ ]*=[^:]*$/d'
-fi
-
-trap 'rm -f $CONFIG_STATUS conftest*; exit 1' 1 2 15
-
-# Transform confdefs.h into DEFS.
-# Protect against shell expansion while executing Makefile rules.
-# Protect against Makefile macro expansion.
-cat > conftest.defs <<\EOF
-s%#define \([A-Za-z_][A-Za-z0-9_]*\) \(.*\)%-D\1=\2%g
-s%[ `~#$^&*(){}\\|;'"<>?]%\\&%g
-s%\[%\\&%g
-s%\]%\\&%g
-s%\$%$$%g
-EOF
-DEFS=`sed -f conftest.defs confdefs.h | tr '\012' ' '`
-rm -f conftest.defs
-
-
-# Without the "./", some shells look in PATH for config.status.
-: ${CONFIG_STATUS=./config.status}
-
-echo creating $CONFIG_STATUS
-rm -f $CONFIG_STATUS
-cat > $CONFIG_STATUS <<EOF
-#!/bin/sh
-# Generated automatically by configure.
-# Run this file to recreate the current configuration.
-# This directory was configured as follows,
-# on host `(hostname || uname -n) 2>/dev/null | sed 1q`:
-#
-# $0 $ac_configure_args
-#
-# Compiler output produced by configure, useful for debugging
-# configure, is in ./config.log if it exists.
-
-ac_cs_usage="Usage: $CONFIG_STATUS [--recheck] [--version] [--help]"
-for ac_option
-do
- case "\$ac_option" in
- -recheck | --recheck | --rechec | --reche | --rech | --rec | --re | --r)
- echo "running \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion"
- exec \${CONFIG_SHELL-/bin/sh} $0 $ac_configure_args --no-create --no-recursion ;;
- -version | --version | --versio | --versi | --vers | --ver | --ve | --v)
- echo "$CONFIG_STATUS generated by autoconf version 2.1"
- exit 0 ;;
- -help | --help | --hel | --he | --h)
- echo "\$ac_cs_usage"; exit 0 ;;
- *) echo "\$ac_cs_usage"; exit 1 ;;
- esac
-done
-
-ac_given_srcdir=$srcdir
-ac_given_INSTALL="$INSTALL"
-
-trap 'rm -f Makefile; exit 1' 1 2 15
-
-# Protect against being on the right side of a sed subst in config.status.
-sed 's/%@/@@/; s/@%/@@/; s/%g$/@g/; /@g$/s/[\\\\&%]/\\\\&/g;
- s/@@/%@/; s/@@/@%/; s/@g$/%g/' > conftest.subs <<\CEOF
-$ac_vpsub
-$extrasub
-s%@CFLAGS@%$CFLAGS%g
-s%@CPPFLAGS@%$CPPFLAGS%g
-s%@CXXFLAGS@%$CXXFLAGS%g
-s%@DEFS@%$DEFS%g
-s%@LDFLAGS@%$LDFLAGS%g
-s%@LIBS@%$LIBS%g
-s%@exec_prefix@%$exec_prefix%g
-s%@prefix@%$prefix%g
-s%@program_transform_name@%$program_transform_name%g
-s%@INSTALL_PROGRAM@%$INSTALL_PROGRAM%g
-s%@INSTALL_DATA@%$INSTALL_DATA%g
-
-CEOF
-EOF
-cat >> $CONFIG_STATUS <<EOF
-
-CONFIG_FILES=\${CONFIG_FILES-"Makefile"}
-EOF
-cat >> $CONFIG_STATUS <<\EOF
-for ac_file in .. $CONFIG_FILES; do if test "x$ac_file" != x..; then
- # Support "outfile[:infile]", defaulting infile="outfile.in".
- case "$ac_file" in
- *:*) ac_file_in=`echo "$ac_file"|sed 's%.*:%%'`
- ac_file=`echo "$ac_file"|sed 's%:.*%%'` ;;
- *) ac_file_in="${ac_file}.in" ;;
- esac
-
- # Adjust relative srcdir, etc. for subdirectories.
-
- # Remove last slash and all that follows it. Not all systems have dirname.
- ac_dir=`echo $ac_file|sed 's%/[^/][^/]*$%%'`
- if test "$ac_dir" != "$ac_file" && test "$ac_dir" != .; then
- # The file is in a subdirectory.
- test ! -d "$ac_dir" && mkdir "$ac_dir"
- ac_dir_suffix="/$ac_dir"
- # A "../" for each directory in $ac_dir_suffix.
- ac_dots=`echo $ac_dir_suffix|sed 's%/[^/]*%../%g'`
- else
- ac_dir_suffix= ac_dots=
- fi
-
- case "$ac_given_srcdir" in
- .) srcdir=.
- if test -z "$ac_dots"; then top_srcdir=.
- else top_srcdir=`echo $ac_dots|sed 's%/$%%'`; fi ;;
- /*) srcdir="$ac_given_srcdir$ac_dir_suffix"; top_srcdir="$ac_given_srcdir" ;;
- *) # Relative path.
- srcdir="$ac_dots$ac_given_srcdir$ac_dir_suffix"
- top_srcdir="$ac_dots$ac_given_srcdir" ;;
- esac
-
- case "$ac_given_INSTALL" in
- [/$]*) INSTALL="$ac_given_INSTALL" ;;
- *) INSTALL="$ac_dots$ac_given_INSTALL" ;;
- esac
- echo creating "$ac_file"
- rm -f "$ac_file"
- configure_input="Generated automatically from `echo $ac_file_in|sed 's%.*/%%'` by configure."
- case "$ac_file" in
- *Makefile*) ac_comsub="1i\\
-# $configure_input" ;;
- *) ac_comsub= ;;
- esac
- sed -e "$ac_comsub
-s%@configure_input@%$configure_input%g
-s%@srcdir@%$srcdir%g
-s%@top_srcdir@%$top_srcdir%g
-s%@INSTALL@%$INSTALL%g
-" -f conftest.subs $ac_given_srcdir/$ac_file_in > $ac_file
-fi; done
-rm -f conftest.subs
-
-
-
-exit 0
-EOF
-chmod +x $CONFIG_STATUS
-rm -fr confdefs* $ac_clean_files
-test "$no_create" = yes || ${CONFIG_SHELL-/bin/sh} $CONFIG_STATUS
-
+++ /dev/null
-dnl Process this file with autoconf 2.x to produce a configure script.
-dnl $Id: configure.in,v 1.1.1.1 1998-10-07 11:21:29 jareth Exp $
-AC_INIT(Makefile.in)
-AC_PROG_INSTALL
-AC_OUTPUT(Makefile)
+++ /dev/null
-------- Start of forwarded message -------
-From: Roger Espel Llima <espel@sky.net>
-Newsgroups: alt.humor.best-of-usenet
-
-Subject: Re: Irc 666 Conspiracy
-From: nelson@cs.uwp.edu (Jeremy Nelson)
-Newsgroups: alt.conspiracy, alt.irc, alt.conspiracy.antichrist,
- alt.nostradamus, alt.prophecies
-
-<888@888.888> wrote:
->Do you have noticed that all ports of Irc servers begin with 666??
->The most familiar is 6667 but also 6666,6668,6669.
->Maybe the internet is not so innocent as they want us to believe..
-
-[Fade to black.... Fade into a darkly lit, yet distinctly reddish
-place. A reddish-orange, horned man sits at a desk when the phone rings.]
-
-Bob: "Hello, Internet Porty Authority, wholly owned subsidiary of Hell, Inc.,
- this is Bob. How may I help you?"
-
-Steve: "Hi Bob! This is Steve down in research and development. We've just
- develoepd this KILLER setup where people will waste literally thousands
- of hours of their life doing nothing more than sitting quietly in front
- of a terminal while their brains shrivel slowly into raisins."
-
-Bob: "Hrm... Sounds devilishly clever. What's the code name for it?"
-
-Steve: "Well, a beta-tester named Doug suggested "I Repeat Class". We liked
- the way it formed an easy to grasp acronym, something that would
- slowly make the poor users rue the day they ever heard it. But that
- name seemed far to obvious about the side effects. We needed
- something with more panache. After a joint meeting with the
- Marketing Department, we came up with "Internet Relay Chat"."
-
-Bob: "Oh, thats absolutely perfect. What were the side effects that the
- Punishment and Testing Department came up with?"
-
-Steve: "Initial Addiction rates were nearly 90%. If only we could get that
- kind of response out of Cocaine or Heroin, we'd be set! Also listed
- were a drastic reduction in eating habits, acute lack of sleep, loss
- of intimacy with loved ones, and an *alarming* increase in the
- purchase of keyboards. [1] Also noted was an increase in the
- hostility level, with quite a few observances of users screaming
- at their computer "ILL KILL THE GDMF THAT KICKED ME!" The most
- frightening thing about it was that the testers told their friends
- about the experience, and now their FRIENDS want to join the testing!
- We cant shake people away with a stick!
-
-Bob: "Oh beautiful. This should set back the course of civilization a good
- ten years. Do you have any idea how good its going to be for our
- membership drive if this thing spreads like a viral infection? Within
- ten years of when you deploy this, we'll have 250,000 people trying to
- barge on all the time to get their fix!"
-
-Steve: "Oh, that reminds me of why i called. We need to get a port number
- for the service so we can try some live testing out on the internet.
- Can you spare us any?"
-
-Bob: "Can I? *cackle* Ive been saving a *very special* range of ports for
- just something so evil as this. Something that isnt so blatantly
- obvious, but just sublime enough that the really truly clued in will
- be able to see the obvious conspiracy behind it. I can give you the
- entire range of 6660-6669."
-
-Steve: "Oh, bonus! Ill get on it right away! Thanks again Bob!"
-
-Bob: "Any time. " <Hangs up> "Oh.. i can see it now.. it will be GLORIOUS!"
-------- End of forwarded message -------
-
-
+++ /dev/null
-mrg@mame.mu.oz.au & ben@gnu.ai.mit.edu
-
-This document answers the following frequently asked questions:
-
-1 what is irc ?
-2 why does irc suck ?
-3 why should i irc ?
-4 what is netsex ?
-5 should i have netsex ?
-6 how do i get on irc ?
-7 what is a channel operator ?
-8 what is an irc operator ?
-9 what is a major dweeb ?
-10 what is a major fascist ?
-11 what is a bot ?
-12 what is the piglet way ?
-13 what is a penis extension ?
-14 how do i become of the piglet way ?
-15 does linux suck ?
-16 what is irc like ?
-
-
-1 what is irc ?
-
-irc sucks. irc is reputed to stand for 'internet relay chat',
-but it really means 'i repeat class'. though some people say
-it means 'Irc Really suCks' [capitals only for emphasis].
-
-
-2 why does irc suck ?
-
-because piker and dl are irc operators.
-
-
-3 why should i irc ?
-
-to be rude to irc operators, particularly dl and piker.
-
-
-4 what is netsex ?
-
-netsex is a myth. a long time ago an irc operator called
-wumpus (it rhymes with wimp, sorta) made up a story that
-it wandered on to channel -69 to find people engaging in
-what it called 'netsex', but this was never proven. since
-then people have just been being rude to wumpus for being
-so silly about this 'netsex'
-
-
-5 should i have netsex ?
-
-d'oh! only stupid people who read this question if they
-knew what netsex is (see number 4).
-
-
-6 how do i get on irc ?
-
-take my advice - don't.
-
-
-7 what is a channel operator ?
-
-a major fascist (see number 10).
-
-
-8 what is an irc operator ?
-
-a major dweeb (see number 9).
-
-
-9 what is a major dweeb ?
-
-an irc operator (see number 8).
-
-
-10 what is a major fascist ?
-
-an channel operator (see number 7).
-
-
-11 what is a bot ?
-
-a penis extension. only this penis extension doesn't impresss
-the girlies (or the boys, if you/they are so inclinded [*]).
-
-[*] if you are sexually offended by this, then you lose.
-
-
-12 what is the piglet way ?
-
-ojnk.
-
-
-13 what is a penis extension ?
-
-a bot (see number 11).
-
-
-
-14 how do i become of the piglet way ?
-
-ojnk.
-
-
-15 does linux suck ?
-
-yes. [*]
-
-[*] if you are sexually offended by this, then you lose.
-
-
-16 what is irc like ?
-
-learn by example:
-
-----------------------------------------------------------------------
-Adam Pops My Cherry.
-
-A True Story of the IRC
-by Ben Mesander
-ben@hopper.acs.virginia.edu
-(irc - piglet2)
-
-So one night, Leftist, and I (piglet2) on IRC decide to see what it's
-like to be hot and willing IRC babes. Leftist becomes Julie, I become
-Samantha, and we cruise the #hotsex channel, looking for a little
-action. Julie plays smart, beautiful and passionate... I play dumb with
-big tits (this is more natural for me). An interesting phenomenon arose
-- while I originally was the one that attracted our target, Adam, he
-soon liked Julie better than I. Brains over tits, I guess. In addition,
-there is a little dialogue with catfish, a friend of ours who borrowed
-my nick and wreaked havoc on several channels (she was through by the
-time this log was started). I wish I had the presence of mind to log
-the whole thing. Well I didn't. But to give the story so far, Adam has
-revealed that he has slept with seven women, all of them "nearly
-virgins." He's a college senior in Communications with a 2.0 gpa. Then
-I insisted that he tell me a bedtime story.
-
-What follows is the logfile. Absolute stark naked reality on IRC. This
-is Adam's story, the story of the average college student who's looking
-for a net.fuck on irc.
-
-<Adam> then up the top of your foot
-<Adam> to the inside of your left leg
-<Julie> OOH!
-<Adam> to the knee
--> *catfish* it is so funny.
-<Adam> up to the thigh
-<Adam> still slowly and softly brushing inside
-=> =Julie= she does? why?
-=Julie= Dunno.
-<Adam> up above your glistening vagina
-<Adam> kissing across your abdomen
-=Julie= *Adam* just remember, julie that I don't lie about this stuff.
-<Adam> and coming back down the other thigh's inside
-<Adam> then down the inside....down the foot...
-<Adam> to the toesies
-<Adam> kissing each and every one of them
-<Adam> down from the big one to the little baby
-=Julie= Adam's got bad sentence structure. Let's make his life miserable.
-<Adam> then up the outside of your right leg...
-=> =Julie= tell him you think kissing toes is gross.
-<Adam> over your knee
-*Catfish* piggie, you better be saving some of this :)
-<Adam> to the hip
-<Adam> up your chest
-<Adam> to your breast
-<Adam> over it ever so gently
-=Julie= No. That's in character for you, not me.
-=> =Julie= or maybe that you have a club foot.
-*** Action: Adam pauses for a breather...
-<Samantha> whew!
-<Adam> up to the right side of your neck
-<Adam> then to your right earlobe
-<Adam> tugging at it with my teeth
-<Samantha> mmmm!
-<Adam> then across your neck to your left one (my fave)
-<Samantha> I like that!
-<Adam> then back around to the back of your neck
-<Adam> now, I place my hands firmly but gently on your shoulders
-<Adam> squeezing them a little
-<Adam> your arms are spread out above your head
-=Julie= This guy is probably a 45 second-er.
-<Adam> (like you're doing jumping jacks)
-<Samantha> mmmm.
-<Samantha> and what is julie doing during all this??
-<Julie> Masturbating, actually.
-<Adam> then I run my hands down the sides of your back GENTLY as I SLOWLY AND
-+GENTLY go down your spine with my lips
-<Samantha> ooh. I can feel myself stretched out!
-=Julie= Hahaha, he likes me better.
-=> =Julie= you slut. i bet you 10 net.bucks youre wrong.
-<Adam> then I go to your left "cheek"
-<Adam> and go down the back of your leg, outside
-=Julie= *Adam* I have a DEEP voice. Very sexy voice I'm told. Women love
-+it.
-<Samantha> Squeal!
-<Adam> down to the foot
-=Julie= He's offering to do it to me on the phone later.
-=> =Julie= you win. he's not msging me. but I'm loggin this for planet
-+yip.
-=Julie= Tee-hee.
-<Julie> I'm excited. I'm gonna masturbate with my fingers now.
-<Adam> down the sole of your foot
-<Adam> to the little toesies
-<Adam> kissing every one of them
-=> =Julie= have you ever anally masturbated? tee hee! Lemme find joN's
-+phone number, kay?
-=Julie= -> *adam* Yes. The kbord is getting sticky.
-=Julie= No. K.
-=> =Julie= (804)977-8802
-<Adam> then back up to the inside of your leg...back of your knee (which you
-+would probably kick at this point)
-<Adam> up to your ass
-<Samantha> mmm.
-<Adam> cross over to the other side
-<Adam> then down the leg
-<Adam> to the back of the knee
-<Adam> to the sole of the foot
-<Adam> to the toesies
-*** Adam is adam@rac3.wam.umd.edu (Adam L. Greenberg)
-*** on channels: @#nights
-*** on irc via server tjeeves.acc.Virginia.EDU (Jefferson Server, UVa)
-<Adam> kissing each one
-<Adam> then back up the outside of the leg...
-=Julie= What should I do with joN's number?
-<Adam> hmm now where?
-=> =Julie= this guy is a foot fetishist.
-<Adam> then back to the right ear
-=> =Julie= say it is your number.
-=Julie= Ok.
-<Adam> I lower myself onto you and pull a blanket over us to keep us warm
-<Adam> As I lie on top of you, nibbling your ear and massaging your shoulders,
-+you feel me sticking into your lower back
-=> =Julie= I feel like doing a dieter. "Suddenly, you have become
-+tiresome."
-<Adam> Finally I cannot resist
-=Julie= HE cannot resist!
-<Adam> You slowly spread your legs and I enter you from behind, lying on top
-+of you, spreading your arms out and holding you down to the bed.
-<Samantha> I like that!
-<Samantha> ooh. I'm so wet!
-<Adam> You feel me sliding inside of you and you begin to moan
-=Julie= 3.5 hrs till Calc.
-*Adam* how do I know that?
-<Julie> Masturbate, sam, it works.
--> *adam* know what?
-*Adam* what?
-=Julie= *Adam* I hope I'm making you happy :-)
--> *adam* you asked me how i know that.
-*Adam* how do I know you're really wet and not just saying that, samantha?
-=Julie= -> *adam* HOPELESSLY
-<Adam> I go in and out and in and out.
--> *adam* hmm. you'll have to trust me on this! this is a great bedtime story,
-+you know I needed something like this.
--> *adam* i can't wait to meet you!
-<Adam> We both get up on our knees and I grab your thighs and hold your sweet
-+ass against the front of my legs
-<Julie> mmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmmm
-<Samantha> Julie's getting off!
-<Adam> As I slowly pump you, you get up on all fours...
-<Samantha> I'd love to lick you julie!
-<Julie> oooooh if you only could
-<Samantha> with adam too. friday?
-<Adam> Our bodies don't disconnect but my dick just goes in and out of you
-+rhythmically.
--> *catfish* I'm saving this to a logfile.
-<Julie> if (from "HailOtis@socspy.sci.fau.edu") then save /tmp/clc/priv/purps
-<Adam> then I reach around and play with your clit
-<Samantha> mmmm...
-=Julie= I have to piss. Bad. Cover for me.
-*Catfish* bless you boy!
-=> =Julie= tell im you have to go " finish" yourself.
--> *adam* julie just told me she has to go "finish" herself!
-<Adam> Honey, you have to remember that I like making LOVE not fucking...so
-+this is gonna be slow slow slow
-<Adam> I reach around, lower my chest onto your back as you still stay on all
-+fours...
-<Adam> fingering your hot wet hole
--> *catfish* he appears to have a thing for young girls, feet, and humping on
-+all fours.
-<Adam> every time I touch your clit your hips buck and you feel the tension
-+building
--> *catfish* I guess pretty normal for an irc geek.
-<Samantha> I'm buckin honey.
-*Catfish* how I wish to see this!
-=Julie= *Adam* yeah my hands are beginning to shake
--> *catfish* hee hee. I'm catching about half of it in a logfile.
-=Julie= I wonder why.
-<Adam> then I just ram you one time so smoothly that you scream in pleasure as
-+you feel your pussy grabbing me tighter and tighter
-=> =Julie= catfish sure acts interested in it!
-<Adam> pulsing around me
-<Adam> and it feels good.
-=Julie= She wants you.
-*Catfish* get as much as possible.
-<Adam> with that, I shoot very warmly inside you...
-=> =Julie= 10 net.bucks sez she don't.
-=Julie= I like how not only does he tell us what he does, he tells us what
-+we do.
-<Adam> we have both worked (all worked) up a sweat
-<Adam> and lie down in the bed together
-<Samantha> whew!
-<Samantha> oh honey, I can't wait!
-<Samantha> Julie, I'm gonna go fix your car!
-=Julie= 10 net.bucks sez she likes computer people.
-=> =Julie= puleez - i hate comptuer people.
-<Adam> ain't done yet!
-<Samantha> Well hon, I am pretty done.
-=Julie= Some people find us mystifying.
-<Samantha> And I got to go to work tomorrow!
-<Adam> oh I hope not
-<Samantha> More on friday, but for real?
-<Adam> first a little nap
-<Adam> then a shower
-<Samantha> Don't worry adam, I just need to be rested up four our little party!
-<Samantha> I don't have a phone right now, do you have julie's number?
-*** Action: Adam gets a funny feeling he'll never hear from you guys
-=Julie= -> *ADAM* WHEN? I WILL CALL WHENEVER! But i have to go to bed
-+soon.
-<Samantha> Friday?
-<Adam> I have no LD remember?
-<Samantha> Friday night?
-<Adam> They won't put it on until....no friday is NO GOOD!
-<Samantha> well, if u can call julie on a pay phone? Satruday?
-<Julie> Sam, I will call him.
-<Samantha> julie can pick me up, in her car.
-<Samantha> julie is at 804 977 8802
-<Adam> My LD will be on soon...jeez, let's not rush this all! I'm a little
-+nervous...besides. I
-<Julie> Sam I wanna lick your wetness.
-<Samantha> julie i miss you *hugs*
-=Julie= What do you think joN will think?
-=> =Julie= I'll leave him email...
-<Adam> I'd rather wait until A) I have a haircut! and b) I can take you ladies
-+out for at least a nice dinner!
-<Adam> I want to make a good first impression
-<Julie> ADAM, I don't care about dinner OR hair now!
-<Samantha> But julie is a hairdresser! she can cut your hair!
-<Julie> I only care about feeling your hard cock inside of me.
-<Samantha> I'm so hot tonight.
-=Julie= You're "officially" calling me right after this. So I can avoid
-+calling Adam.
--> *catfish* oh lordie help me.
-<Adam> Well, we're gonna have to have quite a bit of foreplay first because I
-+haven't had any in a long time so I'd probably come pretty quickly. But get
-+me to come two or three times and after that I'll last quite a while,
-+actually.
-=> =Julie= just tell him you can't afford the ld right now either.
-<Adam> The last girl I made love to had to have me stop after about an hour
-+she was in pain
-=Julie= Too late, babe.
-<Julie> It takes me WAY longer than that.
-=> =Julie= a precummer.
-<Samantha> me too!
-<Adam> Not when you're with me it won't
-=Julie= _adam?
-<Samantha> remember you have to please two of us!
-<Julie> PROMISE?
-<Samantha> and we can help eachi other out a little too...
-<Adam> My fingers can make you come in about 5...I'll guarantee it or double
-+your fingering back!
-<Samantha> ooh! I love that!
-<Adam> My voice plays a key role here, too
-<Julie> yum
-=> =Julie= "my voice. gag"
-=Julie= I'm so moist. This is all being logged?
-=> =Julie= u bet.
-=Julie= from where?
-<Samantha> well goodnight! I have to go!
-=> =Julie= on my amiga at home.
-<Adam> hey not so fast!
-<Samantha> mmm, adma, can I give you a kiss?
-=Julie= I mean, where did you start? Do selective editing and send it in.
-<Adam> oh honey you can give me whatever you want
-<Samantha> *hugs* julie!
-<Samantha> oh adam, we will have fun! but I have to work tomorrow! look at the tiem!
-<Samantha> bye!
-
-I'd never had net.sex before. Adam devirginified another babe, and my
-net.cherry is forever lost. I'm checking into the Betty Ford clinic.
-----------------------------------------------------------------------
-
-The following is a conversation between "good-guy" and "R" - R was the only
-op on the channel, and databoy wanted to get rid of me...
-
--> *good-guy* did I op you?
-*good-guy* no <Sun Jan 24 20:22>
--> *good-guy* sorry. :(
-*good-guy* type /mode #christian +o good-guy <Sun Jan 24 20:23>
--> *good-guy* oh, I see. you type +o then your nick name?
-*** good-guy has changed the topic on channel #christian to God love you
-*** good-guy has changed the topic on channel #christian to GOD LOVE YOU
-*good-guy* you got it <Sun Jan 24 20:25>
-*good-guy* do you realize you the away on <Sun Jan 24 20:26>
--> *good-guy* my screen is scrolling too fast. what was the command again?
--> *good-guy* the away on? what does that mean?
-*good-guy* can you op first then I will explain <Sun Jan 24 20:28>
--> *good-guy* my screen is scrolling too fast. what was the command again?
--> *piglet3* I think good-guy is beginning to catch on, just as I started a log.
-*good-guy* type /mode #christian +o good-guy <Sun Jan 24 20:30>
--> *good-guy* what's the last part for?
-*good-guy* type /mode #christian +o good-guy <Sun Jan 24 20:31>
--> *good-guy* what is the <Sun Jan 24 20:31> for? is that the date?
-*good-guy* please op me before this get out of control <Sun Jan 24 20:34>
--> *good-guy* I dont want to type anything if I dont know what it's for.
-*** good-guy is H04LG@cunyvm.cuny.edu (!id ONE OF THE GOOD GUYS)
-*good-guy* well are you going <Sun Jan 24 20:41>
--> *good-guy* going?
-*good-guy* to op me? <Sun Jan 24 20:43>
-*** Signoff: good-guy (good-guy)
--> *good-guy* not until you tell me what the last part of that command is for.
--> *good-guy* I think I understand the rest.
-*** good-guy (H04LG@cunyvm.cuny.edu) has joined channel #christian
--> *good-guy* a friend told me never to type a computer command I didnt understand.
-*good-guy* I see <Sun Jan 24 20:44>
--> *good-guy* especially one involving the word passwd or rhosts.
-*good-guy* okay now can you op me. <Sun Jan 24 20:45>
--> *good-guy* what does that date in the command mean?
-*good-guy* i understand. <Sun Jan 24 20:45>
-*good-guy* it just shows the current date <Sun Jan 24 20:46>
--> *good-guy* but why put it in the command to op someone???!!
-*good-guy* you don't need it <Sun Jan 24 20:46>
--> *good-guy* then why did you type it?
-*good-guy* just try what I told you on me <Sun Jan 24 20:47>
-*good-guy* just trying it out <Sun Jan 24 20:47>
--> *good-guy* I dont understand.
-*good-guy* bye bye <Sun Jan 24 20:48>
--> *good-guy* goodbye
-*good-guy* you do not want to op me <Sun Jan 24 20:48>
--> *good-guy* I dont know why I should. you arent being very clear.
-*** good-guy has left channel #christian
-*good-guy* I have the irc primer <Sun Jan 24 20:52>
--> *good-guy* what does that do?
-*good-guy* I have all the commands for irc. <Sun Jan 24 20:53>
-*good-guy* you should type /away <Sun Jan 24 20:53>
--> *good-guy* what will that do?
-*good-guy* it stop giving me that msg as a manager <Sun Jan 24 20:54>
--> *good-guy* as a manager?
-*** good-guy is away: go on talk to me
-*good-guy* yes <Sun Jan 24 20:54>
-*good-guy* you have not type away <Sun Jan 24 20:55>
-
-----------------------------------------------------------------------
-Random netsexer encounters phone:
-
-*ZeK* Hello..are you female..? <Tue Mar 9 02:32>
--> *ZeK* does that matter ?
-*ZeK* just to know..and i'm looking for a female.. <Tue Mar 9 02:33>
--> *ZeK* What if I was male, and claimed to be female ??
-*ZeK* so i'm asking you.. <Tue Mar 9 02:34>
--> *ZeK* What if I was female, and claimed to be male ??
-*ZeK* are you f or m? <Tue Mar 9 02:34>
--> *ZeK* I could be an automaton
--> *ZeK* I have said these things to many people before.
-*ZeK* so what are you f or m? <Tue Mar 9 02:36>
--> *ZeK* Does it matter ?
-*ZeK* yep.. <Tue Mar 9 02:36>
--> *ZeK* Why does it matter ?
-*ZeK* i need a female.. <Tue Mar 9 02:38>
--> *ZeK* I could be a female. Why do you want a female ?
-*ZeK* imagine why i want one. <Tue Mar 9 02:38>
--> *ZeK* Do you want to net.fuck me ?
-*ZeK* hmm..of course <Tue Mar 9 02:39>
--> *ZeK* I love net.fucking.
-*ZeK* but only if you are female.. <Tue Mar 9 02:40>
--> *ZeK* I love net.fucking horning guys, like yourself (or so you seem to me)
--> *ZeK* So do I get to feel you inside me ?
-*ZeK* are you here..? <Tue Mar 9 02:47>
--> *ZeK* Yes, I am.
-*ZeK* net.fucking..? <Tue Mar 9 02:48>
-*ZeK* ok? <Tue Mar 9 02:49>
--> *ZeK* When big studly net.men get to put their net.cocks inside me.
-*ZeK* go away.. <Tue Mar 9 02:50>
--> *ZeK* I thought you were after a net.fuck from me ?
-*ZeK* yep.. <Tue Mar 9 02:51>
--> *ZeK* Why the change ?
-*ZeK* not changed..go ahead <Tue Mar 9 02:51>
--> *ZeK* I'm not sure. You told me to go away, and I don't like being told to go away.
-*ZeK* no, prob <Tue Mar 9 02:53>
--> *ZeK* I would love you to net.fuck me, but it is 3 am here, and I am tired.
-
-
-<fletcher> any one here know anything about vax?
-<piglet3> a vacuum cleaner?
-<fletcher> i want to know how to make a plan available to people who finger me on irc
-<fletcher> anyone?
-<ckd> Well, is it running VMS, Ultrix, BSD, or what?
-<fletcher> hmm
-<fletcher> is that to me?
-<fletcher> i think vms
-<fletcher> i am pretty sure...
-<fletcher> so any ideas?
-<fletcher> i would like to have something available to people who finger me
-<piglet3> wear a crotchless panty.
-<fletcher> funny....
-<poxaV> ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha ha
-<bpk> haha
-<poxaV> you mean a .plan file.
-<fletcher> yes!
-<fletcher> hmm.. brb... hmm...
-<Daemon> Pox: you see the usend and urecv posted on comp.sys.hp48?
-<fletcher> brb
-<poxaV> oh.. the _new_ IR sender?
-<poxaV> how fast can it go?
-<poxaV> IRSERV can go at 7600 baud or so.
-<Daemon> pox: more than twice as fast as two HP's connected together via wire.
-<poxaV> DAMN!
-<poxaV> no way!
-<Daemon> The've got some test results.. If they're accurate it's DAMN fast.
-<fletcher> creating a .plan file did not create a plan for others to see... any suggestions?
-<piglet3> heh.
-<Daemon> PACMAN directory from goodies disk #7, 8308.5 bytes.
-<Daemon> program used SEND TSEND (v2.0) USEND
-<Daemon> time in seconds 115.026 66.072 28.707
-<Daemon> QED.font from QED1.07, 2244 bytes
-<Daemon> program used SEND TSEND (v2.0) USEND
-<Daemon> time in seconds 42.273
-<Daemon> 23.456 6.252
-<poxaV> holy COW...
-<Daemon> yah..
-<fletcher> well thanks anyway....
-<poxaV> fletcher: SET PROT:W:RE
-<poxaV> fletcher: SET PROT:W:RE .PLAN
-<fletcher> ok whree do i do this?
-<poxaV> from your login directory.
-<Daemon> 289bytes/sec.
-<fletcher> ok then what?
-<poxaV> THEN test it again.
-<poxaV> it's hard to say if that will do it, since i have no idea what TCP/IP software your VMS machine has.
-<poxaV> oh, *AND* a crotchless panty.
-<fletcher> ok.. hold on.. it said i didnt have a .plan file... brb.. thanks...
-<piglet3> hee hee.
-<fletcher> m ric hold on...
-<fletcher> hmm..
-<fletcher> ok it accepted it fine.. only when i put in the whole name of the file though.. which i called irc.plan
-<fletcher> would someone finger me and tell me what my plan says?
-<fletcher> when i did it from another account it didnt work
-<piglet3> TAMU has a fucked up fingerd, I think. sigh.
-<fletcher> still said no plan
-<piglet3> I think I remember that.
-<fletcher> i think so
-<fletcher> hmm
-<poxaV> well, *don't* call it irc.plan.
-<poxaV> call it ".plan", which is what the finger software *looks* for.
-<piglet3> connect: Connection timed out
-<Silek> make sure your $HOME can be read from the outside..
-<poxaV> tamu's fingerd is fascist.
-<poxaV> silek: this is VMS, not unix.
-<piglet3> I can't finger him at all.
-<poxaV> i doubt that anyone not at tamu.edu can.
-<fletcher> yea it works fine for anyone here
-<fletcher> i have just started giving out another accounts password so that they can finger me
-<fletcher> hehhee
-<fletcher> hmm.. let me try to just call it plan....
-<piglet3> please don't tell me this. It reminds me of how lame my users are.
-<poxaV> well, since that's what fingerd *looks* for, it *would* be a good idea.
-<ckd> pox- see if finger @fascistbox.tamu.edu@unixbox.tamu.edu works
-<fletcher> ok now what do i type again?
-<fletcher> i created a .plan file
-<poxaV> ckd: it don't, i'm pretty sure. they've either rewritten it, or put a filter on it... it's VERY fascist.
-<poxaV> SET PROT:W:RE .plan
-<fletcher> ok.. brb
-<poxaV> SET PROT:W:RE SYS$LOGIN:.plan
-<poxaV> lamer.
-<bpk> HAHAHA
-<poxaV> hopefully, he put the .plan file in his root directory already.
-<poxaV> > finger FDP4175@RIGEL.TAMU.EDU@tamsun.tamu.edu
-<poxaV> [tamsun.tamu.edu]
-<bpk> I was once helping a guy set up a .plan file and it turned out all along he was doing a /ctcp finger on himself to test it. *sigh*
-<poxaV> 501:No matches to your query.
-<poxaV> geezz
-<piglet3> He gives out an account and password so that people can finger him.
-<poxaV> yeah. pretty good luser, mm?
-<piglet3> That story gets saved.
-<morkeleb> "here is my root password. now you can login and finger me ! oh and rape my machine too .."
-<poxaV> "... and none of that icky lubricant stuff, either!"
-<bpk> hahha
-<poxaV> i used to have an account inside their gateway, so it'd work... but alas, the machine is gone.
-<fletcher> *sigh*
-<fletcher> fuck me!
-<fletcher> i swear
-<poxaV> no thanks.
-<piglet3> no.
-<fletcher> hmmm
-<bpk> no thanks
-<fletcher> i know
-<fletcher> i knwo
-<ckd> fletcher- you're not my type
-<fletcher> shuwsh
-<poxaV> is .plan in your SYS$LOGIN
-<poxaV> ?
-<bpk> pox, we're beginning to think alike
-<morkeleb> we were just talking about that fletcher.. nevermind ..
-<fletcher> hahaha
-<bpk> mork: hahah
-<fletcher> umm...
-<piglet3> I woke up this morning with a hangover, and my penis was missing.
-<bpk> we were all afraid of rejection
-<piglet3> I mean my fingerd.
-<poxaV> King Missle.
-<poxaV> 'Detachable Penis'
-<poxaV> anybody know where they're from? i THOUGHT they were a local (Dallas/Fort Worth/Metro)) band, but now i'm not sure
-<fletcher> all right who wants to telnet here and get on my frineds account to see what the deal is?
-<piglet3> me meme!!!!
-<bpk> why fletcher, that would be illegal
-<piglet3> me first!
-<piglet3> fletcher, *sigh* it might not be a good idea to give out accounts and passwords.
-<fletcher> i know it was illegal
-<piglet3> someone might do *bad things* to the tamu computers.
-<fletcher> i know
-<fletcher> hehehe
-<poxaV> mememememememememeemememmeme
-<fletcher> shit!
-<morkeleb> piglet: this is a VAX running vms tho keep in mind ..
-<poxaV> 'was'? no 'was' about it. it IS illegal, for any account at tamu.edu
-<fletcher> hmmm.... i know...
-<piglet3> Ewwww. VMS?
-<piglet3> go ask on #hack, fletcher.
-<poxaV> fletcher: you know.... you *COULD* just do it YOURSELF
-<fletcher> shit.. i will just have to try tommorow.. a girl is getting tooo impatient with me...
-<poxaV> *gasp* *arg*
-<fletcher> i know
-<piglet3> I hear they like VMS.
-<bpk> fletch: let me get this straight. you want -US- to risk ourselves to be thrown in jail so WE can fix YOUR fingerd
-<bpk> ?
-<fletcher> but i dont know enough yet
-<fletcher> i know
-<poxaV> not even his fingerd, his .plan
-<fletcher> i know
-<morkeleb> bpk: no no no !
-<fletcher> i am sorry...
-<morkeleb> bpk: he wants you to risk jail so you can edit his .plan
-<piglet3> I wish I had logged this.
-<fletcher> thanks for trying.. maybe i will talk to you tommorow...
-<bpk> "But officer, I was only trying to finger the guy"
-<morkeleb> he doesnt have enough privs to let you *fix* anytthing
-<fletcher> hahhahaa
-<fletcher> i know
-<fletcher> i know
-<Silek> did someone say log ? :)
-<fletcher> be quiet
-<fletcher> i have to go!
-<fletcher> *sigh*
-<piglet3> The girl is getting really impatient.
-<piglet3> REALLY
-<fletcher> bye i know i know
-<fletcher> hehehe
-<fletcher> talk to you later
-<piglet3> she wants to FINGER him.
-<piglet3> if you have a log, silek, email it to me.
-<poxaV> piglet3: i have a full /lastlog...
-<piglet3> Been fingering at tamu?
-<poxaV> x
-<poxaV> ugh.
-<bpk> y
-<poxaV> no. i got caught in a /lastlog 1000
-<bpk> lamer
-<Daemon> pox: /flush /flush /flush
-
-----------------------------------------------------------------------
-
-/whois avante
-[info] Avante (~fccrensh@ws4scogjn.cr.usgs.gov) is Imagine whirled peas
-[info] Avante is on: @#bdsm
-[info] Avante iswas using server irc.colorado.EDU (Univ of Colorado Server (2.8.*))
-[info] End of /whois.
-[info] Joining channel: #bdsm
-[info] #bdsm topic: General Hospital: BDSM in the Medical Field
-[info] Users on #bdsm: vhf Sonya acId Earwax @Avante polgara DrDark @Thoth JAlfred puppy-sis laura Chant Lockjaw @Panki Elkor @Chattel @Hanki
-<puppy-sis!FSLJ@aurora.alaska.edu#bdsm> trot trot trot .. little sturt
-<Lockjaw!reynard@punisher.cco.caltech.edu#bdsm> 'cmon puppy... bring it back... :^)
-<Sonya!GST_BAILEY@laurel.emich.edu#bdsm> Hi JAlfred.
-hi.
-(sent to #bdsm)
-<Thoth!~baphomet@lamar.ColoState.EDU#bdsm> brb
-[info] Thoth stopped wasting time: out of the blue and into the black.....
-/who *
-[info] vhf H #bdsm se0@hopper.acs.Virginia.EDU (0 very high frequency)
-[info] Sonya H #bdsm GST_BAILEY@laurel.emich.edu (0 <Oz never did do nothing for the tin man.>)
-[info] acId H #bdsm ahusayn@lonestar.utsa.edu (3 Ali . Husayn )
-[info] Earwax H #bdsm akelly@cs.uml.edu (0 [* Hand_on_the_\ 2Glock\ 2 *])
-[info] Avante H@ #bdsm ~fccrensh@ws4scogjn.cr.usgs.gov (2 Imagine whirled peas )
-[info] polgara H #bdsm polgara@dontpanic.rz.uni-ulm.de (7 *Unknown*)
-[info] DrDark H #bdsm FELINE@ZEUS.TAMU.EDU (4 <ZCC_Operator>)
-[info] JAlfred H #bdsm gt5754b@hydra-rich.gatech.edu (1 Type your name here)
-[info] puppy-sis H #bdsm FSLJ@aurora.alaska.edu (2 <sister loves teacher very much >)
-[info] laura H #bdsm burkel@ucsu.Colorado.EDU (2 interesting little bitch)
-[info] Chant H #bdsm cmcmaho@emoryu1.cc.emory.edu (1 Whatever)
-[info] Lockjaw H #bdsm reynard@punisher.cco.caltech.edu (1 Horror..Horror and moral terror)
-[info] Panki H@ #bdsm ~baphomet@lamar.ColoState.EDU (2 God of Magick)
-[info] Elkor H #bdsm bilyji@cii3116-25.its.rpi.edu (5 Who wants to live forever if true love must die?)
-[info] Chattel H@ #bdsm khawkes@wombat.gnu.ai.mit.edu (0 Ernest Boutin)
-[info] Hanki H@ #bdsm ~sa114984@hilliard.lance.colostate.edu (1 /MSG Hanki HELP)
-[info] End of /who.
-<Sonya#bdsm> Has anyone seen Red_rose?
-<Chant!cmcmaho@emoryu1.cc.emory.edu#bdsm> well folks I gotta get going
-<Chant#bdsm> Have a good one!
-[info] Earwax!akelly@cs.uml.edu has left #bdsm
-<Avante#bdsm> bye chant have fun !
-<DrDark#bdsm> Sonya: Not at all today, I haven't.
-[info] JAlfred has left #bdsm
-[info] Chant stopped wasting time: Leaving
-<Avante#bdsm> chant if your in colorado somtime look us up luv ;)
-[info] acId!ahusayn@lonestar.utsa.edu has left #bdsm
-<DrDark#bdsm> I already HAVE a good one...
-<puppy-sis#bdsm> pupy brings the ball back to lj
-<puppy-sis#bdsm> and drops it at his feet and waits..fro him to through it again ..e
-ACTION Lockjaw->#bdsm: pulls at the ball... c'mon puppy! Give it back!!!
-<Lockjaw#bdsm> takes the ball
-ACTION Lockjaw->#bdsm: tosses the ball into the center of the room again...
-<puppy-sis#bdsm> wag wag wag ..
-<puppy-sis#bdsm> sis goes after the ball.. gt
-[info] Sonya has left #bdsm
-<puppy-sis#bdsm> the ball rolls uner avante ..:)
-<Avante#bdsm> heh
-<puppy-sis#bdsm> sis goes through avante leg to get the ball
-<Avante#bdsm> *aaack!!
-<Avante#bdsm> *FALLS ON THE FLOOR*
-<Avante#bdsm> *turns caps lock off*
-<puppy-sis#bdsm> eek.. avante falls on the small puppy
-[info] lionness!cf2335@olympus.ir0.ucf.edu has joined #bdsm
-<puppy-sis#bdsm> yap yap yap
-<lionness#bdsm> aloha
-<DrDark#bdsm> 'lo Lionness...
-<lionness#bdsm> hey dd
-<puppy-sis#bdsm> avante is smothing the poor pupy
-<Lockjaw#bdsm> Hiya Lionness!
-<Avante#bdsm> am not
-ACTION lionness->#bdsm: goes and kisses lj
-<puppy-sis#bdsm> you fell on me :) you didnt get up
-<lionness#bdsm> hehe
-<Avante#bdsm> *gets off puppy*
-<puppy-sis#bdsm> grr at ;opmmess
-<lionness#bdsm> what are ya'll up to
-ACTION Lockjaw->#bdsm: pulls lionness close and kisses her deeply... Mmmmmmm
-<DrDark#bdsm> Av: As opposed to *gets puppy off*
-<lionness#bdsm> puppy bashing?
-<lionness#bdsm> hehe
-<puppy-sis#bdsm> grrr at ;opmmess
-<lionness#bdsm> hehe
-<puppy-sis#bdsm> grr lionness
-<lionness#bdsm> hehe
-<puppy-sis#bdsm> puppy goes over and snff at lion
-ACTION lionness->#bdsm: hides behind lj
-<puppy-sis#bdsm> bark bark bark
-ACTION lionness->#bdsm: blows elkor a kiss
-ACTION Lockjaw->#bdsm: looks at puppy.. yes?
-<Avante#bdsm> drdark: #beastiality is over there *points*
-<Elkor!bilyji@cii3116-25.its.rpi.edu#bdsm> *looks at lionness and smiles* Hello there.
-<puppy-sis#bdsm> puppy runs thought lockjaw legs and goes behind lion and bites her ankels
-<lionness#bdsm> hey ps how's teach?
-<DrDark#bdsm> Av: (*chuckle*) I read alt.sex.beast once... Once...
-<Avante#bdsm> *squick*
-ACTION lionness->#bdsm: is getting tired of the little puppy
-ACTION lionness->#bdsm: is getting hungry too
-[info] Steven!skeoch@gateway.bnr.ca has joined #bdsm
-<DrDark#bdsm> Well gee. Lions is bigger than puppies...
-<lionness#bdsm> mmmm, puppy meat
-ACTION Elkor->#bdsm: smiles and offers lionness a steak.
-<DrDark#bdsm> 'lo Steven
-<Elkor#bdsm> here kitty, kitty, kitty...
-<Avante#bdsm> tube steak hehe
-<DrDark#bdsm> lioness: Like chinese? ;-)
-<lionness#bdsm> hehe
-[info] murr!o4g192@anvil.rick.cs.ubc.ca has joined #bdsm
-[info] Panki has changed mode for #bdsm: +o murr
-<lionness#bdsm> yes
-[info] Steven has left #bdsm
-ACTION Lockjaw->#bdsm: askes lionness to be sweet and not eat the puppy... she's too cute.. :^)
-<DrDark#bdsm> 'lo murr!
-<murr#bdsm> well hi all
-<lionness#bdsm> chinese are intelligent peops and good eating
-<murr#bdsm> hi Dr
-<DrDark#bdsm> lioness: They say light colored puppies make the best stew...
-<puppy-sis#bdsm> puppy hops inot lionnnes lap and licks her face.. yeah dont eat teh puppy
-<Avante#bdsm> I want to go play raquet ball..
-ACTION lionness->#bdsm: pushes puppy to lj and struts to elkor and the steak
-<Avante#bdsm> im sick *blea*
-<puppy-sis#bdsm> puppy licks lj face
-[info] Shane!SKUFF@134.29.1.1 has joined #bdsm
-<DrDark#bdsm> Av: You're right. I hate those little rackets...
-<DrDark#bdsm> 'lo Shane...
-<murr#bdsm> bye
-<Shane#bdsm> hi all
-[info] murr has left #bdsm
-<lionness#bdsm> allo
-<puppy-sis#bdsm> wag at shane
-ACTION lionness->#bdsm: licks elkor's frace
-<Elkor#bdsm> *tosses lionness a steak*
-<lionness#bdsm> hehe
-ACTION Lockjaw->#bdsm: gigles at puppy and hugs her tight...
-<puppy-sis#bdsm> yap yap yap
-<Shane#bdsm> pat puppy sis on the head
-<laura#bdsm> =moan=
-ACTION lionness->#bdsm: gulps down the steak
-[info] Shane stopped wasting time: Bad link?
-<DrDark#bdsm> laru
-<DrDark#bdsm> laura: Having fun?
-<lionness#bdsm> hmmm, think i need to trim my nails
-[info] Alessan!WATTS_G@kosmos.wcc.govt.nz has joined #bdsm
-<laura#bdsm> no, I hit my head
-<DrDark#bdsm> 'lo Alessan...
-<Alessan#bdsm> hey all
-<DrDark#bdsm> laura: Yuk!
-<lionness#bdsm> hey alessan
-<DrDark#bdsm> laura: How'd you manage that?
-<laura#bdsm> I would not tell you if I was masturbating
-ACTION Lockjaw->#bdsm: bites the tip of puppy's ear gently...
-<laura#bdsm> the wall was closer than I thought
-<DrDark#bdsm> laura: (*chuckle*)
-<Avante#bdsm> hah
-<Avante#bdsm> dont kiss and tell ea laura
-[info] garcon!Mystics@128.253.96.54 has joined #bdsm
-ACTION lionness->#bdsm: lays down next to elkor and rolls over on her back
-<garcon#bdsm> hi all
-<lionness#bdsm> allo garcon
-<laura#bdsm> i can't kiss myself down there. I am not that flexible
-<garcon#bdsm> hallo lionness
-<lionness#bdsm> hehe
-<lionness#bdsm> not into yoga, laura?
-<Avante#bdsm> laura : shake hands then ;)
-<laura#bdsm> my hand is more medicinal
-[info] Ice9!jshaw@emr1.emr.ca has joined #bdsm
-<Avante#bdsm> ladyice !
-<DrDark#bdsm> Rehi Ice!
-ACTION Lockjaw->#bdsm: saw a gif of a guy who could... well, lets just say if i could, i wouldn't leave the house....
-<Lockjaw#bdsm> Ice!!!!
-<lionness#bdsm> hehe
-<laura#bdsm> you always have your hand
-<lionness#bdsm> ice ice baby
-ACTION Ice9->#bdsm: inclines head to Avante
-<Lockjaw#bdsm> laura: A bit different tho...
-<DrDark#bdsm> laura: Two of 'em, even...
-ACTION Ice9->#bdsm: *HUGS* Lockjaw!
-[info] Alessan has left #bdsm
-<Avante#bdsm> *puts ladyices head in her lap*
-ACTION garcon->#bdsm: says bye to all
-<laura#bdsm> but you aren't that flexible
-<Avante#bdsm> his!
-[info] polgara!polgara@dontpanic.rz.uni-ulm.de stopped wasting time: Leaving
-<lionness#bdsm> tata
-[info] garcon has left #bdsm
-ACTION Lockjaw->#bdsm: hugs Ice9.... Smiles broadly... Good to see ya!!!
-<Ice9#bdsm> bye garcon
-<lionness#bdsm> aw
-[info] SharonSt!~SHAMAS@delphi.com has joined #bdsm
-<DrDark#bdsm> av: I was gonna say... Seeing if SHE can kiss herself?
-[info] RayDon!~ef.21504@gcef.gc.maricopa.edu has joined #bdsm
-<DrDark#bdsm> 'lo Sharon!
-<Avante#bdsm> sharon ooh boy!!
-<SharonSt#bdsm> howdee
-ACTION Ice9->#bdsm: giggles at /avante
-<RayDon#bdsm> hello all
-<laura#bdsm> im confused
-<Lockjaw#bdsm> Hiya Sharon
-[info] chemstud!~cmrobert@midway.ecn.uoknor.edu has joined #bdsm
-ACTION Ice9->#bdsm: kisses herself
-<DrDark#bdsm> 'lo cstud.
-[info] chemstud has left #bdsm
-ACTION Ice9->#bdsm: kisses Lockjaw hello!
-[info] RayDon has left #bdsm
-ACTION lionness->#bdsm: pulls elkor on top of her
-<DrDark#bdsm> Ice9: We were talking about folx who can give themselves oral sex...
-ACTION Lockjaw->#bdsm: kisses Ice9 back....:^)
-<laura#bdsm> wow that was quick
-<Elkor#bdsm> *goes PHOMP on top of lionness*
-<lionness#bdsm> ;/msg sharonst and for time over 20?
-<lionness#bdsm> hehe
-<lionness#bdsm> be careful, elkor, i'm a fragile fem
-<lionness#bdsm> hehe
-ACTION DrDark->#bdsm: grabs the insidious semi-colon from lioness's /m...
-<lionness#bdsm> hehe
-[info] SirRobert!robert@198.67.33.102 has joined #bdsm
-[info] puppy-sis stopped wasting time: Bad link?
-<Ice9#bdsm> DrD: I prolly could.. but that was before I knew about it hee hee!
-<lionness#bdsm> my fingernail hit the semicolon key
-<DrDark#bdsm> Ice9: (*chuckle*)
-<Elkor#bdsm> lionness: i doubt that. *smile*
-<Elkor#bdsm> besides, you are teh one who pulled me on top,.
-[info] MsHacker!mukkj@uxa.ecn.bgu.edu has joined #bdsm
-<lionness#bdsm> hehe
-<DrDark#bdsm> lioness: Ahhhh... makes sense... That one of the reasons you need to clip 'em?
-<Lockjaw#bdsm> Hiya MsHack
-<lionness#bdsm> well, i'[m only 110 lbs
-<DrDark#bdsm> Rehi MsH! (*HUG*)
-<DrDark#bdsm> lioness: how tall?
-[info] Cateyes!catty@w3eax.umd.edu has joined #bdsm
-<lionness#bdsm> hey mh
-<DrDark#bdsm> Rehi Cateyes!
-<lionness#bdsm> hehe
-<Cateyes#bdsm> re hiya!!!!
-<SirRobert#bdsm> lol!
-ACTION MsHacker->#bdsm: wants to fuck DrDark
-<SirRobert#bdsm> forward isn't she
-<Avante#bdsm> hi cateyes :)
-ACTION MsHacker->#bdsm: likez LJ!!!
-<DrDark#bdsm> MsH: Sorry. Have to ask my gf first...
-<SirRobert#bdsm> hi CatEyes
-[info] Sonya has joined #bdsm
-<laura#bdsm> GF?
-<MsHacker#bdsm> CATEYEZ!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-<Elkor#bdsm> *tickles lionness*
-<lionness#bdsm> hehe
-<DrDark#bdsm> laura: Girlfriend...
-<Elkor#bdsm> GF = Girl Friend
-<Cateyes#bdsm> ALLURA!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-<laura#bdsm> I am confused
-<Lockjaw#bdsm> MsHack: Well, i like ya too... :^)
-<MsHacker#bdsm> cateyez: change it for me??
-[info] Cateyes has changed nick to Cateyez
-ACTION lionness->#bdsm: lj likes everyone
-<lionness#bdsm> hehe
-[info] Sonya stopped wasting time: Leaving
-<MsHacker#bdsm> THANK YOU!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-/privmsg #bdsm :do you like hitler?
-<Avante#bdsm> gf goat fuck
-ACTION Lockjaw->#bdsm: phhhhhbts lionness.. *grin*
-<lionness#bdsm> uhoh
-<SirRobert#bdsm> geeze
-<lionness#bdsm> getting late and i got a test to study for
-<Avante#bdsm> good cal llaioness
-<DrDark#bdsm> lioness: You students... (*sigh*)
-<laura#bdsm> so, who likes to fuck while the woman is menstruating?
-<Avante#bdsm> lioness
-<DrDark#bdsm> ;-)
-<Avante#bdsm> *spews lunch*
-<laura#bdsm> who here likes blood?
-<Lockjaw#bdsm> Bye Lionness!
-<DrDark#bdsm> laura: I do! Since my girlfriend isn't on the pill...
-<SirRobert#bdsm> is that your condition, laura?
-<laura#bdsm> 1 vote for, 1 against
-[info] lionness has left #bdsm
-<Elkor#bdsm> WENCH = Women Entitled to Nights of Continual Happiness
-<laura#bdsm> I am at the moment. I don't do it ALL the time
-[info] Malia!thee@mhc.mtholyoke.edu has joined #bdsm
-<SirRobert#bdsm> hope not....:)
-<laura#bdsm> that would really suck
-<laura#bdsm> not to mention swallow
-<Avante#bdsm> laura it would..
-<Avante#bdsm> who like to be tied up ?
-[info] Malia has left #bdsm
-<SirRobert#bdsm> besides there are pleanty of fun things to do beside fuck
-/privmsg #bdsm :do you like to tie people up?
-<DrDark#bdsm> Now, I don't give oral sex during her period, but fucking's wonderful...
-<Cateyez#bdsm> MEMEMEMEME
-<laura#bdsm> it is fun to fuck while bleeding
-<MsHacker#bdsm> avante: tie me up and beat me hard!
-<laura#bdsm> it makes the cramps go away too
-<SirRobert#bdsm> why is that, laura?
-ACTION Cateyez->#bdsm: doesn't get cramps.
-<DrDark#bdsm> laura: That's what I hear...
-ACTION Cateyez->#bdsm: says Happy Happy Joy Joy
-<laura#bdsm> well, I don't know why it makes the cramps go away
-<Lockjaw#bdsm> "Sometimes I gets the cramps reeeeeal bad..."
-<SirRobert#bdsm> new reason to fuck, as if anyone needed one
-<Lockjaw#bdsm> Hahahahahah... Raising Arizona ref...
-ACTION Ice9->#bdsm: looks for a cure for her cramps
-<DrDark#bdsm> Hated that movie...
-<Lockjaw#bdsm> Doc: WHAT!!!! *shakes head...*
-ACTION Avante->#bdsm: gives sharonst some of his chicken soup
-<laura#bdsm> no need to worry about lubrication either
-<Lockjaw#bdsm> God, it's one of my favorites...
-<Avante#bdsm> laura just leave the lights off
-<SirRobert#bdsm> the book was stupid too
-<laura#bdsm> leave the light off?
-<DrDark#bdsm> laura: No doubt, but that generally isn't a problem for my gf and I...
-<laura#bdsm> blood is not a bad thing
-<SirRobert#bdsm> why would that be a porblem anyway, laura
-<Ice9#bdsm> I can't imagine Raising Arizona as a book
-/privmsg #bdsm :you'd be dead without blood.
-<Avante#bdsm> ice9 hahah
-[info] MsHacker stopped wasting time: <trip will be better AFTER the vitamin C!!!>
-<laura#bdsm> i didn't say it was a problem. I said that you don't have to bother staying wet
-<Ice9#bdsm> <---- bloody bithc
-<Ice9#bdsm> bitch
-<laura#bdsm> you can go longer and faster
-<SharonSt#bdsm> <--doesnt have a problem staying wet with or without lblood
-<SirRobert#bdsm> are you really that hard to get along with Ice9
-<Elkor#bdsm> be back in a bit.
-[info] Elkor has left #bdsm
-<DrDark#bdsm> Later Elkor...
-<Avante#bdsm> sharon ooh?
-ACTION SirRobert->#bdsm: wonders how long and fast she wants
-<Cateyez#bdsm> If you fuck long enough you will need extra lubrication.
-<SharonSt#bdsm> yeah, im easy to turn on to a disgusting degree
-<Avante#bdsm> cateyez ture
-<DrDark#bdsm> True...
-<Cateyez#bdsm> Sorry Avante
-<Ice9#bdsm> yes, anyone here will tell you I'm th meanest bitch in the valley
-<SharonSt#bdsm> its no challenege or secret trying to get me off
-<laura#bdsm> i don't think this needs to be a competition.
-<SirRobert#bdsm> sounds like a challange, Ice9
-<laura#bdsm> if you go long enough, you start to get tired and make less
-<laura#bdsm> so, when you're bleeding, you can go longer. end of story
-<Avante#bdsm> laura maybe :)
-<SirRobert#bdsm> I like a women who cums easily and often
-<Cateyez#bdsm> laura: That's when the slippery suff, KY and all those other things are needed.
-<Avante#bdsm> i would like one who dosnt..
-<Avante#bdsm> i dont cum easily
-<Ice9#bdsm> Sir: I am a challenge, sounds like you don't like that
-<laura#bdsm> well,, a woman who cums easily and often bleeds too
-<Avante#bdsm> takes me forever..
-<Cateyez#bdsm> I cum easily if the guy knows what he's doing and what I like.
-<Avante#bdsm> yea
-<Cateyez#bdsm> If not, it's a friggin marathon
-<laura#bdsm> mind fuck as to be a major component.
-ACTION Ice9->#bdsm: looks at Avante and grins
-[info] Thorfinn!~s2105420@cello04.orchestra.cs.unsw.OZ.AU has joined #bdsm
-[info] Panki has changed mode for #bdsm: +o Thorfinn
-<Avante#bdsm> it takes a couple of sessions to get ti right
-<SirRobert#bdsm> I may be up to it, perhaps, but we should talk first. Ice9
-[info] Nickl!irc29545@irc.nsysu.edu.tw has joined #bdsm
-<DrDark#bdsm> re'lo Thorf!
-<laura#bdsm> if a man doesn't make love to my emotions, I don't cum
-<Cateyez#bdsm> Hi Thorfinn
-<Avante#bdsm> <-- loves mind fuck
-<Cateyez#bdsm> Laura: I agree
-<Ice9#bdsm> Sir: uh huh?
-<Cateyez#bdsm> And sometimes my emotions can be very hardcore
-<SharonSt#bdsm> i need a guy i can spoon feed ice cream
-<Thorfinn#bdsm> re
-<SirRobert#bdsm> personally I think bondage makes excellent foreplay
-<Avante#bdsm> i ca ndo that ;)
-<DrDark#bdsm> Half the fun is learning what gets each other off... The other half is using that knowledge...
-<Cateyez#bdsm> And others they're sweet and innocent
-<Avante#bdsm> i have training ;)
-<SharonSt#bdsm> heh
-<Avante#bdsm> sir: yep .. the best
-/privmsg #bdsm :training in what?
-<laura#bdsm> bondage? how so, sirRobert?
-<Avante#bdsm> spoon feeding ice cream
-<SirRobert#bdsm> can one read email on here?
-<SirRobert#bdsm> or is the message I got refering to my UNIX mail box
-<Cateyez#bdsm> Sir I don't think so.
-ACTION Ice9->#bdsm: is a cum virgin (frigid) hence the nick
-<Avante#bdsm> I like bondage yessir i do.
-<SirRobert#bdsm> My favorite actually
-<Cateyez#bdsm> I had a good two today
-<Avante#bdsm> ice i can relate
-ACTION Lockjaw->#bdsm: winks at Ice9... Shyaaaaaaa!
-[info] sPoint!PELKONEN@murray.fordham.edu has joined #bdsm
-<SirRobert#bdsm> Ice9: perhaps we *should* talk
-<DrDark#bdsm> I'm not! I've cum many times!
-<Cateyez#bdsm> I'm sorry, I can't relate
-<sPoint#bdsm> Evening all...
-/privmsg #bdsm :how do you work around it avante?
-<Cateyez#bdsm> evening
-<sPoint#bdsm> ICE! *hug*
-<Lockjaw#bdsm> sPoinT! Hey!
-ACTION Ice9->#bdsm: giggles at Lockjaw
-<sPoint#bdsm> LOCKJAW!!!!
-<laura#bdsm> being powerless is arousing.
-<Avante#bdsm> vhf. .well lets say i know what im doing
-<Cateyez#bdsm> I'm bitchy if a guy cums and he doesn't let me.
-<Avante#bdsm> I dongt have to cum to enjoy sex
-<Avante#bdsm> I love watching my partner go crazy
-<Avante#bdsm> im a tease
-<SirRobert#bdsm> Avante: I agree
-<Avante#bdsm> i LOOVE to tease
-<DrDark#bdsm> Av: I agree. It certainly doesn't hurt, but it's not necessary.
-<laura#bdsm> eww, I hate that too, cateyez
-<Cateyez#bdsm> Avante: you're a teasing slut like I said
-<Avante#bdsm> i can make love for an hour easily
-<SirRobert#bdsm> slut?
-/privmsg avante :what's your favorite way to tease them?
-ACTION Ice9->#bdsm: ***squeezes**** spoint
-<Avante#bdsm> heh
-<sPoint#bdsm> *freezez*
-<Avante#bdsm> vhf its different for different girls..
-<Cateyez#bdsm> It's okay when you want to tease but then when he's like I'm gonna make you cum and he doesn't then I'm bitchy.
-[info] Prism!prism@kropotkin.gnu.ai.mit.edu has joined #bdsm
-<SirRobert#bdsm> never mind Ice9, perhaps you are beyond hope :/
-<Prism#bdsm> hello.
-<Avante#bdsm> cateyez:)
-<Cateyez#bdsm> I make myself cum then somewhere where he can hear but not watch.
-[info] SharonSt stopped wasting time: Bad link?
-<Ice9#bdsm> Sir: could very well be... or just too good to myself
-ACTION Cateyez->#bdsm: is a tease
-<laura#bdsm> I always have my hand.
-[info] Allura!mukkj@uxa.ecn.bgu.edu has joined #bdsm
-<SirRobert#bdsm> (sign) perhaps, Ice
-<laura#bdsm> food sounds good
-<sPoint#bdsm> ALLURA!!!!
-<Allura#bdsm> panki whois allura
-{Panki#bdsm} ==== Allura is a three high freak, pot smoking, hacker 3leete, 2600 Goddess extraordinare. She TOPs she SUBs she Switches, but when it comes to those britchez...she goes straight for the cutest guy in the room. ====
-<Cateyez#bdsm> ALLURA!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-<Avante#bdsm> thats why i dont jsut pick up any old girl .. sex is great o na personal level for me.. if i dont knwo the person.. *shrugg* id rather masturbate
-[info] Chattel!khawkes@wombat.gnu.ai.mit.edu has changed mode for #bdsm: +o Allura
-<DrDark#bdsm> Rehi Allura!!!!
-<Allura#bdsm> thanks Chattel: bark for me?
-<sPoint#bdsm> Evening, Allura *pounce and lick*
-<Chattel#bdsm> WOOF!
-<DrDark#bdsm> BRB folx!
-ACTION Allura->#bdsm: lovez her slave :) cum cuddle with me on da couch :)
-<SirRobert#bdsm> <-- perfers to have a partner
-ACTION Chattel->#bdsm: wags tail at Allura
-[info] DrDark has left #bdsm
-<Allura#bdsm> chattel: u r awesome :)
-[info] spikee has joined #bdsm
-ACTION sPoint->#bdsm: walks over and sits down next to Allura
-<spikee#bdsm> lo all
-<sPoint#bdsm> Evening, Spikee....
-<spikee#bdsm> heeeeeyaaaaaaaaa
-<Cateyez#bdsm> hi spikee
-<spikee#bdsm> hi ya sppint
-[info] DrDark has joined #bdsm
-<spikee#bdsm> err spoint
-<Avante#bdsm> where di dsharonst go?
-<DrDark#bdsm> Much better. :-)
-[info] Sonya has joined #bdsm
-<spikee#bdsm> hello cateyezzzzzz
-<Cateyez#bdsm> she left
-<Lockjaw#bdsm> spikee!!!
-ACTION Allura->#bdsm: lix Cateyez! :)
-<Allura#bdsm> gee hi Lj
-<Avante#bdsm> did she say bye?
-<DrDark#bdsm> Spikee! (*HUG*)
-<spikee#bdsm> lj !!*klink, klank*
-<DrDark#bdsm> Rehi Sonya!
-ACTION spikee->#bdsm: hugs drd hard
-<Sonya#bdsm> HI DrDark.
-<Cateyez#bdsm> no I don't think so
-ACTION Lockjaw->#bdsm: smiles at Allura.. hiya gorgeous.. :^)
-<Avante#bdsm> aah
-ACTION SirRobert->#bdsm: is a sucker fo cat women :)
-<spikee#bdsm> kip_ around?
-<Avante#bdsm> call waiting
-<Cateyez#bdsm> Sir: Cat women with nails?
-<SirRobert#bdsm> newest friend is kytyn
-ACTION sPoint->#bdsm: cuddles on the couch w/allura...
-<Allura#bdsm> Lj: only HALF as gorgeous as u with thos sexy wiskerz baby! :) heh
-<Lockjaw#bdsm> *blush*
-<spikee#bdsm> huh allura?
-<Allura#bdsm> sPoint: took ya long enuff.
-<spikee#bdsm> hmm nevermind
-<DrDark#bdsm> Cateyes: How long ARE your claws?
-<SirRobert#bdsm> you all know kytyn?
-[info] spikee has left #bdsm
-[info] Nika!bioj294@emoryu1.cc.emory.edu has joined #bdsm
-<Nika#bdsm> hi all
-<Avante#bdsm> yes we all know kytyn :)
-<DrDark#bdsm> panki who is kytyn
-{Panki#bdsm} ==== Kytyn is a red-headed cutie, clad in latex like her mistress Dora and looking good in her heels and stockings... ====
-<Allura#bdsm> SR: yeah, VERY good friend o mine why?
-<Avante#bdsm> nika !!
-<DrDark#bdsm> Oh well.
-<Cateyez#bdsm> They're about an inch over my tips.
-<DrDark#bdsm> Nika! (*HUG*)
-<Lockjaw#bdsm> Allura: Actually, right now it's an Eeeeeevil goatee...and i've been pierced since the gif...
-<Nika#bdsm> hmmmm
-<sPoint#bdsm> Nika! gets up hugs her and then cuddles again with his Mistress Allura...
-ACTION Nika->#bdsm: got a very interesting email...wonders if yall got one as well..
-<Allura#bdsm> NIKA U SEXY THANG!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
-<SirRobert#bdsm> we are becomming fast friends kytyn & I, that's all
-[info] spikee has joined #bdsm
-<spikee#bdsm> re all
-[info] Sonya stopped wasting time: Leaving
-<DrDark#bdsm> Cateyez: Sharp? Blunt?
-[info] christian has joined #bdsm
-<sPoint#bdsm> Panki who is sPoint
-<Avante#bdsm> nika i didnt what is it?
-{Panki#bdsm} ==== sPoint is a rebel, and a runner, and a restless young romantic who wants to run the Big Machine ====
-<Nika#bdsm> allura: how am i sexy?
-ACTION Prism->#bdsm: snores gently in the background.
-<sPoint#bdsm> I luuuv that bio. Neal Peart comes to BDSM!
-[info] sPoint has changed nick to neilpeart
-<Avante#bdsm> *outs a potato in prisims mouth
-<Cateyez#bdsm> They grow in perfectly shapped. I don't have to file them or anything except when I get a snaggie on the side.
-<spikee#bdsm> later all
-[info] neilpeart has changed nick to sPoint
-[info] spikee has left #bdsm
-<Ice9#bdsm> brb
-[info] Ice9 stopped wasting time: Leaving
-ACTION Nika->#bdsm: got a mail from some fool who told me i should stop irc'ing and that my irc'ing implies that girls are no longer interesting....?
-[info] RayDon has joined #bdsm
-<DrDark#bdsm> Cateyez: Kool!
-ACTION Prism->#bdsm: gives Avante a narrow-eyed
-ACTION sPoint->#bdsm: curls up against Allura and purrs...
-<Prism#bdsm> look.
-<Avante#bdsm> nika humm?
-<Allura#bdsm> nika i find u VERY interesting ;) heh
-<Nika#bdsm> av: vwery strange
-<Avante#bdsm> heh *5* allura
-ACTION Allura->#bdsm: pets sPoint head and rubs his back.
-[info] RayDon stopped wasting time: Leaving
-ACTION Nika->#bdsm: blushes
-<Avante#bdsm> later folks
-[info] Avante has left #bdsm
-<Allura#bdsm> hey *5* avate!
-<Nika#bdsm> avL: dont go!!!
-ACTION sPoint->#bdsm: purrs softly at Alura's touch
-<Cateyez#bdsm> bye Avante
-<Nika#bdsm> piss
-[info] spade!gt5754b@hydra-rich.gatech.edu has joined #bdsm
-<Allura#bdsm> avante even
-ACTION Lockjaw->#bdsm: has to run.. seeya later folks... :^)
-<sPoint#bdsm> Later lock!
-[info] christian has left #bdsm
-[info] Allura stopped wasting time: Bad link?
-<DrDark#bdsm> 'lo christian.
-<Lockjaw#bdsm> bye spoint
-<DrDark#bdsm> Oops. (*sigh*)
-[info] Lockjaw has left #bdsm
-[info] Avante has joined #bdsm
-[info] Panki has changed mode for #bdsm: +o Avante
-<DrDark#bdsm> Right. So who is actually HERE?
-ACTION Cateyez->#bdsm: smiles
-<Nika#bdsm> i am
-<spade#bdsm> me too
-ACTION Prism->#bdsm: snores gently in the background.
-<Cateyez#bdsm> me
-<Thorfinn#bdsm> I'm just barely...
-[info] mort!brmyers@acacia.itd.uts.EDU.AU has joined #bdsm
-<Thorfinn#bdsm> :)
-<DrDark#bdsm> (*chuckle*)
-<DrDark#bdsm> 'lo mort...
-ACTION SirRobert->#bdsm: thinks this is a hard place to get to know people!
-<Avante#bdsm> hey nika .. miss me?
-ACTION sPoint->#bdsm: pulls nika to him and cuddles and tickles her affectionaletly
-<Nika#bdsm> so kids...anything hot happening?
-<Nika#bdsm> ooh sPoint...yummmm
-<DrDark#bdsm> SirR: Gets crowded sometimes...
-<sPoint#bdsm> Sir-rob not really...just takes time
-<Avante#bdsm> sirrob: naw .. just be patient.
-[info] Ice9 has joined #bdsm
-<DrDark#bdsm> Nika: Just missed an in-depth convo on orgasms...
-<Nika#bdsm> huh?
-ACTION Prism->#bdsm: offers SirRobert a nice lollipop.
-<sPoint#bdsm> *wicked smile and rubs Nika's shoulders
-[info] mort has left #bdsm
-ACTION SirRobert->#bdsm: has not given up yet, but feels frustrated
-ACTION sPoint->#bdsm: groovs to Cypress Hill....
-[info] Razormaid!jlacour@129.105.112.42 has joined #bdsm
-<DrDark#bdsm> 'lo RMaid..
-<Nika#bdsm> SR: on what?
-<Ice9#bdsm> Sir: still trying to cum?
-[info] Nickl stopped wasting time: Ping timeout
-<Nika#bdsm> *gasp*
-<Nika#bdsm> hmmm
-ACTION sPoint->#bdsm: kisses Nika's neck
-ACTION SirRobert->#bdsm: heading back to TPE (best D&S bbs in the US) <-- not so subtle plug
-<Nika#bdsm> ice9: eh?
-<SirRobert#bdsm> hehe
-<Nika#bdsm> TPE...
-ACTION Nika->#bdsm: blushes at sPoint
-[info] Razormaid stopped wasting time: Bad link?
-<Ice9#bdsm> Nika: eh? u Canuck too?
-<Cateyez#bdsm> TPE?????
-ACTION sPoint->#bdsm: holds Nika close...no reason to blush...*smile*
-<Nika#bdsm> SR: explain...TPE?
-[info] REDDWOLF!mudab5@uxa.ecn.bgu.edu has joined #bdsm
-<SirRobert#bdsm> what you never heard of TPE???????
-<Avante#bdsm> i have been ther
-<Nika#bdsm> NO!
-<Avante#bdsm> i have
-[info] REDDWOLF has left #bdsm
-<Cateyez#bdsm> no sorry
-<Avante#bdsm> tpe .. i have an account
-<Ice9#bdsm> Totally Pointless
-<Avante#bdsm> but i cant sue anything
-<Avante#bdsm> use
-<Prism#bdsm> I never heard of TPE.
-<Nika#bdsm> *lauggh*
-<Cateyez#bdsm> What's the # so I can get an account
-<Ice9#bdsm> Excercise (sorry)
-[info] KinkBoy!~EGRAHAM@rcnvms.rcn.mass.edu has joined #bdsm
-<Avante#bdsm> tpe.ncm.com .. login as guest
-<DrDark#bdsm> 'lo KB..
-<SirRobert#bdsm> free time to try it, 20 hours
-<KinkBoy#bdsm> re DD
-<Nika#bdsm> is that a telnet?
-<SirRobert#bdsm> most interesting chat command set
-<Prism#bdsm> Yes.
-<Cateyez#bdsm> coolers. I'll try it later
-<SirRobert#bdsm> yes telnet
-<Avante#bdsm> i cant use anything on it though
-<Cateyez#bdsm> why not Avante?
-<SirRobert#bdsm> commands like /collar /cage /gag
-<Avante#bdsm> nika telnet tpe.ncm.com login as guest
-[info] REDDWOLF has joined #bdsm
-<Nika#bdsm> i have
-<Nika#bdsm> :-)
-<Avante#bdsm> cause they want to cal lme back
-<DrDark#bdsm> Rehi REDD
-<Avante#bdsm> or somthing
-[info] Heirophnt!ailiopou@MAIL.SAS.UPENN.EDU has joined #bdsm
-[info] jaybay!u9348913@rabble.uow.edu.au has joined #bdsm
-<Chattel#bdsm> Oooh /cage I like that
-ACTION sPoint->#bdsm: nuzzles Nika
-<Avante#bdsm> i met a girl from there
-<Avante#bdsm> ryuth
-<Nika#bdsm> av: oh?
-<Avante#bdsm> ruth
-<SirRobert#bdsm> tell you what I'll pull rank
-<DrDark#bdsm> 'lo Heiro...
-<Nika#bdsm> yeah?
-<DrDark#bdsm> 'lo jaybay...
-<Heirophnt#bdsm> ok, i'm checking bdsm now...
-[info] jaybay has left #bdsm
-<Avante#bdsm> hi hei
-<Cateyez#bdsm> oh
-<SirRobert#bdsm> anyone who wants to sign up now, I'll verify them now
-<Heirophnt#bdsm> Heirodule!
-[info] Shane has joined #bdsm
-<Shane#bdsm> hi all
-<Avante#bdsm> your nick is too hard
-<Nika#bdsm> sr i am there now
-<Cateyez#bdsm> I'll sigh up now
-<SirRobert#bdsm> Avante, what handle?
-<Avante#bdsm> sirrobert is it free?
-<Heirophnt#bdsm> what are u running , a 900 chat line something? :)
-<Prism#bdsm> Hmm... They want my real name.
-<Avante#bdsm> my nick there is avante also
-<Prism#bdsm> [tpe]
-<SirRobert#bdsm> 20 hours is free
-<SirRobert#bdsm> nika what handle?
-<Avante#bdsm> but i dont ahve any access to anything
-<Heirophnt#bdsm> geez...bdsm sucks too..what a surprise
-<Cateyez#bdsm> Then after the 20?
-[info] spade stopped wasting time: Bad link?
-[info] laura has left #bdsm
-/privmsg avante :did he say we sucked?????!!!!
-<SirRobert#bdsm> ok I have Avante & nika anyone else?
-<Avante#bdsm> heirophnt what do you mean?
-<Cateyez#bdsm> MEMEMEM
-<sPoint#bdsm> Heiro: what do you expect after being on the channel for 30 seconds
-<Cateyez#bdsm> E
-<Prism#bdsm> No, thanks, SirRobert.
-<sPoint#bdsm> No thanks, sir
-<Avante#bdsm> sir how much is it afer the 20 hrs?
-[info] Shane stopped wasting time: Leaving
-<SirRobert#bdsm> ok Cateyez, what handle?
-*Avante* jsut a jerk picking a fight.. /ignore works great
-ACTION sPoint->#bdsm: runs fingers up and down Nika's bod and cuddles her tight
-<DrDark#bdsm> The love handles, of course...
-ACTION Cateyez->#bdsm: sucks on a pencil.
-[info] Ice9 has left #bdsm
-<DrDark#bdsm> Lucky pencil...
-<Cateyez#bdsm> I'm always sucking on something
-<Avante#bdsm> sirrobert how much after the 20 hrs?
-[info] KinkBoy has left #bdsm
-ACTION Prism->#bdsm: snores gently in the background.
-<Avante#bdsm> *gives cateyes somthig to suck on*
-<DrDark#bdsm> Cateyez: Oral fixation?
-<SirRobert#bdsm> geeze, money? is that the only question?
-<Cateyez#bdsm> DrDark: yes
-[info] giancarlo!~JKC@phobos.ucs.umass.edu has joined #bdsm
-[info] Ice9 has joined #bdsm
-<sPoint#bdsm> Sirrobert it IS a valid question
-[info] Lolita!MCLOUTIER@pattie.wellesley.edu has joined #bdsm
-<Lolita#bdsm> hi
-<Cateyez#bdsm> Avante: A finger? Or something bigger and longer?
-<Chattel#bdsm> Greetings Giancarlo
-<Avante#bdsm> sir if its too much i dont care how cool it is
-<sPoint#bdsm> 'lo giancarlo...Buona sera
-<Nika#bdsm> gc!
-[info] Scigeek!thomasj@uxa.cso.uiuc.edu has joined #bdsm
-<SirRobert#bdsm> not until you see the product, sPoint
-[info] Panki has changed mode for #bdsm: +o Scigeek
-<DrDark#bdsm> sP: I was gonna use the word Pertinent...
-<Avante#bdsm> hi lolita
-<DrDark#bdsm> 'lo Lolita!
-<Lolita#bdsm> hi avante
-<Cateyez#bdsm> SCI!!!!!!!!
-<DrDark#bdsm> Rehi Sci!
-<giancarlo#bdsm> i spoint
-<Scigeek#bdsm> hey all
-<Nika#bdsm> sci!!
-<Lolita#bdsm> hi drdark
-<Avante#bdsm> sir so how much is it?
-<Scigeek#bdsm> CAT!!
-<Prism#bdsm> Avante is a wise man. :-)
-<Scigeek#bdsm> Ice!!! *hugs*
-<Avante#bdsm> wise man on a buget ;)
-<Nika#bdsm> av: *grin*
-<DrDark#bdsm> If I were a rich man...
-*Ice9* have we met?
-/whois ice9
-[info] Ice9 (jshaw@emr1.emr.ca) is HMSC Reliant
-[info] Ice9 is on: #bdsm #christian
-[info] Ice9 iswas using server clique.cdf.utoronto.ca (Experimental IRC Server, 2.8)
-[info] End of /whois.
-ACTION Cateyez->#bdsm: is woman about to get her 1st apartment
-ACTION Scigeek->#bdsm: waves to Nika
-<SirRobert#bdsm> ok I with setup those 3 for free access, now
-ACTION Prism->#bdsm: is not on a budget, but still tries to be wise.
-[info] giancarlo has left #bdsm
-[info] REDDWOLF has left #bdsm
-<DrDark#bdsm> diedle diedle diedle diddle diedle diga diga dum...
-/privmsg ice9 :I don't recall... embarrasing.
-<Prism#bdsm> I won't give my real name. :-)
-<Cateyez#bdsm> Do we still log on as guest/???
-<DrDark#bdsm> Cat: Kool!!! Roomies or alone?
-<Ice9#bdsm> hey giancarlo! :)
-<Cateyez#bdsm> Dr: I haven't decided yet
-<Nika#bdsm> prism: smart guy
-<Avante#bdsm> cateyez will it have a dungeon ?
-[info] Heirophnt has left #bdsm
-<Cateyez#bdsm> Avante: My bedroom can be the dungeon
-ACTION sPoint->#bdsm: nibbles nika's ear
-<Ice9#bdsm> Sci!! :)
-<Prism#bdsm> Thank you, Nika.
-<DrDark#bdsm> cateyez: Where-abouts? I used to live in Fairland apartmens in Montgomery county... Decent, but kinda expensive...
-[info] leborgne!leborgne@s40412.esu.edu has joined #bdsm
-<Avante#bdsm> *throws a dead fish at Heirophnt as hir leaves
-<Cateyez#bdsm> Minneapolis
-<Scigeek#bdsm> Ice: *pounce*
-<sPoint#bdsm> Gotta go all...bbl
-<sPoint#bdsm> Nice shot avante
-<Scigeek#bdsm> bye sP
-<Cateyez#bdsm> Bye Spoint
-<DrDark#bdsm> Cateyez: Ahhhh... Not near U of Md then, eh? :-)
-[info] sPoint stopped wasting time: later all
-<Lolita#bdsm> bye everyoe
-ACTION Nika->#bdsm: hugs spoint bye
-[info] Lolita stopped wasting time: Bad link?
-[info] SanMan!jms8@Isis.MsState.Edu has joined #bdsm
-<DrDark#bdsm> 'lo SM...
-<Cateyez#bdsm> Okay
-ACTION Cateyez->#bdsm: is going to try out TPE
-[info] spade has joined #bdsm
-<SanMan#bdsm> what's up DRdr.
-<Avante#bdsm> i will to.
-<Cateyez#bdsm> bbl or bbr which ever comes first
-<DrDark#bdsm> SM: Not a lot... Workin'. You?
-<DrDark#bdsm> cat: Enjoy!
-<SanMan#bdsm> Drdr: workin on what?
-[info] Sonya has joined #bdsm
-<Cateyez#bdsm> thanks I will
-[info] Cateyez stopped wasting time: Damn, I'm good.
-<Sonya#bdsm> Hello all.
-[info] brian!bccross@zen.holonet.net has joined #bdsm
-<DrDark#bdsm> SM: Workin' at a printer center...
-<leborgne#bdsm> Hello.
-<DrDark#bdsm> Rehi Sonya!
-<SanMan#bdsm> Hey sonya
-<brian#bdsm> Hello all
-<Scigeek#bdsm> hi Sonya:)
-<spade#bdsm> hi brian
-<SanMan#bdsm> Hey brian
-<Sonya#bdsm> Hi DrDark, SanMan, Scigeek.
-<brian#bdsm> hey spade, sanMan
-<SanMan#bdsm> Anybody know anything about pascal?
-<DrDark#bdsm> 'lo brian
-<brian#bdsm> <=== seeking bdsm gay buddies
-<Avante#bdsm> <-- knows pascal
-[info] Ice9 stopped wasting time: sifon.cc.mcgill.ca clique.cdf.utoronto.ca
-<brian#bdsm> Hi DrDark
-<Avante#bdsm> hi brian
-<DrDark#bdsm> SanMan: I've used it... Been a while tho...
-<Prism#bdsm> <-- knows a cat called
-<Prism#bdsm> Pascal.
-<Sonya#bdsm> Pascal? Blaise Pascal?
-<SanMan#bdsm> Avante: how much do you know?
-<Sonya#bdsm> Pascal is the unit of pressure.
-<SirRobert#bdsm> ok I have avante, nika, cateyes, spade any more?
-<Sonya#bdsm> *grins*
-<SanMan#bdsm> Sonya: the programming language.
-<Avante#bdsm> sanman what do you need to knwo?
-<Sonya#bdsm> SirRobert: For?
-/privmsg #bdsm :Pascal is a b&d programming language.
-<brian#bdsm> sub here
-<brian#bdsm> and u, spade?
-[info] SkinnyPup!zens@ucsu.Colorado.EDU has joined #bdsm
-<SirRobert#bdsm> free trial offer here sonya
-<Avante#bdsm> hi spup
-<DrDark#bdsm> 'lo SP.
-<Sonya#bdsm> For what?
-<brian#bdsm> Hi SkinnyPup
-<SanMan#bdsm> I'm having too much trouble with a program that deals with stacks.
-<Avante#bdsm> sanman waht for petes sake
-[info] SkinnyPup has left #bdsm
-[info] jreagl1!jreagl1@umbc8.umbc.edu has joined #bdsm
-<SirRobert#bdsm> for the best D&S bbs in the US
-<Sonya#bdsm> Ahhhh...
-[info] Neysa2!barry@clark.edu has joined #bdsm
-<Avante#bdsm> make a stack object
-[info] leborgne has left #bdsm
-<Avante#bdsm> actually stacks are easy
-<SanMan#bdsm> Avante: Have you ever wrote a program that converts infix notation into quadruples?
-[info] Sonya stopped wasting time: Leaving
-<brian#bdsm> where is that, Sir Robert????
-<Avante#bdsm> humm
-<SirRobert#bdsm> those of you who have accounts give me 10 minutes, the others set it up
-<jreagl1#bdsm> panki rules
-{Panki#bdsm} ==== The rules of #bdsm are: No flooding, no beeping, no flaming or or personal insults or harrassment, including unwanted touching or interference in scenes. Violators of the rules will be warned verbally, then kicked as a second warning, then banned if necessary! ====
-[info] QuietBoy!QuietBoy@kip-sn-107.dartmouth.edu has joined #bdsm
-<Avante#bdsm> nor
-<QuietBoy#bdsm> heyall
-<Avante#bdsm> hi quietboy
-<SanMan#bdsm> Me neither, thats why I'm having trouble.
-<SirRobert#bdsm> hi brian: tpe.ncm.com login: guest
-[info] jreagl1 has left #bdsm
-<Prism#bdsm> Depends on the rules for converting infix notation, doesn't it?
-<Avante#bdsm> what is a quadruple?
-[info] ZooTv!enigma@imecopc16.epfl.ch has joined #bdsm
-<Prism#bdsm> Sounds like a version of RPN.
-<ZooTv#bdsm> hey DR Dark
-<Avante#bdsm> I have done converting infix to postfix ect
-<DrDark#bdsm> 'lo Zoo!
-[info] spade has left #bdsm
-<Avante#bdsm> hi zoo
-<SanMan#bdsm> Prism: The rules are basically the same as the order of ops.
-<ZooTv#bdsm> DrDark: I met byteme today we took him to a restarant and a bar
-[info] SirRobert stopped wasting time: takes out majic wand to upgrade folks
-<DrDark#bdsm> Zoo: Kool!
-[info] QuietBoy has left #bdsm
-<ZooTv#bdsm> DrDark: heheh
-<ZooTv#bdsm> hey avante
-[info] Soleil!~OPERS@193.140.16.1 has joined #bdsm
-<Prism#bdsm> Hmm... SirRobert is soliciting for a commercial interest.. Is that kosher?
-<Avante#bdsm> it has do do with order of the ops
-<Soleil#BDSM> hello all.
-[info] brian stopped wasting time: Leaving
-[info] ZooTv has left #bdsm
-<Avante#bdsm> are you doing this from scratch?
-[info] Elkor has joined #bdsm
-[info] tricia!PML2622@RIGEL.TAMU.EDU has joined #bdsm
-<Avante#bdsm> didnt they give you rules?
-<Scigeek#bdsm> hi Soleil
-<Avante#bdsm> hi tricia
-<Scigeek#bdsm> hi elkor, tricia
-<SanMan#bdsm> Avante: Somewhat, but not very helpful.
-[info] Soleil has left #BDSM
-[info] tricia has left #bdsm
-<Avante#bdsm> well basically .. if you run into a number you push it on the stack
-[info] Nickl has joined #bdsm
-<Avante#bdsm> a rparen you push also
-<Avante#bdsm> no no
-<Avante#bdsm> you need two stacks
-<SanMan#bdsm> Avante: but the problem is that the infix has both binary and unary operators, also the infix doesn't have real numbers, just variables
-<Neysa2#bdsm> hello all
-<Neysa2#bdsm> hi nickl
-<Avante#bdsm> one for operators one for "variables
-<Neysa2#bdsm> hello nika
-<Nika#bdsm> ni N2
-<Nika#bdsm> hi i mean
-<Nika#bdsm> :-)
-[info] tippy!jmsommer@well.sf.ca.us has joined #bdsm
-[info] Nickl has left #bdsm
-<Scigeek#bdsm> hi tippy
-<Avante#bdsm> well the trick is to figure out the rules.. thwe pascal part is easy
-<tippy#bdsm> Hey Scigeek
-<Neysa2#bdsm> hi tippy
-<tippy#bdsm> hey all :)
-<Avante#bdsm> are you writing a compiler or somthing?
-<Avante#bdsm> recursive decent works nice
-<SanMan#bdsm> Avante: Exactly, but I'm not really sure what a quadruple is suppose to look like in this situation.
-<Avante#bdsm> yea i see what you mean
-<tippy#bdsm> brb
-<Avante#bdsm> id do alot of pseudo coding
-[info] tippy has left #bdsm
-<Chattel#bdsm> Ooh squeezed between Panki and Hanki
-<Avante#bdsm> understand it before you start t owrite it
-<SanMan#bdsm> Oh yeah, what are you studyin?
-<Scigeek#bdsm> chattel:heheh
-<Neysa2#bdsm> hello vhf
-<Avante#bdsm> i graduated
-<Avante#bdsm> cs with emphasis in math
-<SanMan#bdsm> What did you study?
-<Avante#bdsm> but im not a brain
-[info] Ice9 has joined #bdsm
-<Scigeek#bdsm> re ICEY!!
-<DrDark#bdsm> BRB folx...
-<Avante#bdsm> i cant remember what a quadruple is
-<Neysa2#bdsm> hi ice9
-[info] tippy has joined #bdsm
-<SanMan#bdsm> Are you in Grad. school or something?
-<Nika#bdsm> av: yes you are *hug*
-<Avante#bdsm> it seems to me its from compiler though
-<Prism#bdsm> m , I'm at home.. You had dinner already?
-<Prism#bdsm> bleah... excuse'm.
-<Avante#bdsm> nika *lick*
-ACTION DrDark->#bdsm: hands prism a /
-<Ice9#BDSM> am I here?
-<tippy#bdsm> prism: you're awake? :)
-<Avante#bdsm> hi ladyice
-ACTION Neysa2->#bdsm: tickles ice9
-<Prism#bdsm> Danke, DrDark.
-ACTION Scigeek->#bdsm: hugs Ice9
-[info] Alessan has joined #bdsm
-<Prism#bdsm> tippy - I'm always awake. :-)
-<DrDark#bdsm> Prism: No prob... :-)
-<Alessan#bdsm> hey all
-<Avante#bdsm> sanman no i have ajod
-<Avante#bdsm> job
-<tippy#bdsm> hey Alessan
-<Prism#bdsm> How else could I type in stuff like "/me snores gently in the background" most of the time? :-)
-<Alessan#bdsm> yo tippy
-<DrDark#bdsm> BRB folx!
-<tippy#bdsm> Prism: good point.
-<Scigeek#bdsm> hi Alessan
-[info] DrDark has left #bdsm
-<Avante#bdsm> prisim /alias snore /me snores .....
-<Chattel#bdsm> When will you visit again
-<SanMan#bdsm> Avante: Oh well, gotta get to work on the damn thing I guess, Later.
-[info] SanMan has left #bdsm
-ACTION Nika->#bdsm: lags
-<Avante#bdsm> good luck san
-<Prism#bdsm> avante - aliases are for wimps. :-)
-<Avante#bdsm> sounds like san is working on a compiler.
-<Chattel#bdsm> well there was ice on the puddle this morning
-[info] luvable!msb0@UNIX7.ANDREW.CMU.EDU has joined #bdsm
-<Chattel#bdsm> thick ice
-<Avante#bdsm> prisim heh
-ACTION tippy->#bdsm: smiles.
-<Avante#bdsm> chattel no more summer hu
-[info] Alessan stopped wasting time: Bad link?
-<Prism#bdsm> I'm being told of about excellent resturants... That people went to. Without me. And me without even eating dinner.
-[info] nixxie!helper@198.67.33.102 has joined #bdsm
-<Avante#bdsm> hi luvable
-[info] Sonya has joined #bdsm
-<luvable#bdsm> hi all!:)
-<Scigeek#bdsm> Ice9?....
-<Avante#bdsm> hi nixxie
-<Nika#bdsm> *gasp*
-<Prism#bdsm> *sniffle* No one loves me any more. :'-(
-<nixxie#bdsm> hello
-<Scigeek#bdsm> hi nixxie
-<Scigeek#bdsm> re sonya
-<luvable#bdsm> hi nika!:)
-ACTION Nika->#bdsm: sits on the couch and relaxes
-<Ice9#BDSM> re SCI!!
-[info] jreagl1 has joined #bdsm
-<Nika#bdsm> hi luv
-ACTION Scigeek->#bdsm: tacklehugs Ice
-ACTION Ice9->#BDSM: dances around Scias the screen scrolls...
-<tippy#bdsm> prism: I doubt it;)
-ACTION luvable->#bdsm: hates Quantum Mechanics.
-<Avante#bdsm> nixxe your fro mtpe :)
-<nixxie#bdsm> yes I am :)
-<Scigeek#bdsm> Quantum....*cringe*
-<Avante#bdsm> nixxie cool beans
-<Prism#bdsm> tippy - :-)
-<luvable#bdsm> scigeek: I have an exam tomorrow in it! *ACK*
-<Avante#bdsm> i tke it your kinky
-ACTION Ice9->#BDSM: wraps arms and legs around Scigeek!!!
-<Neysa2#bdsm> hello nixxie
-<Scigeek#bdsm> luv: ewwwwwwww
-[info] jreagl1 has changed nick to joe
-[info] RonPost!pescej@155.31.2.17 has joined #bdsm
-ACTION Sonya->#bdsm: gets headaches from Quantum Mechanics.
-<nixxie#bdsm> somewhat Avante <g> I suspect you *might* be......
-ACTION Scigeek->#bdsm: falls on the floor with Ice and licks her *slurp*
-<Ice9#BDSM> Quantum luv; dream onit!
-<RonPost#bdsm> re's
-[info] joe has left #bdsm
-ACTION Neysa2->#bdsm: needs to rest his tired head
-<Avante#bdsm> Nixiim normal.. I just like more flavors than vanilla;)
-<luvable#bdsm> :)
-<Avante#bdsm> pardon my typing
-ACTION Ice9->#BDSM: rolls around on floor with Sci and *giggles*
-<Avante#bdsm> im sick and slouching in my chair
-[info] Auduck!KRISHNAN@130.49.254.3 has joined #bdsm
-[info] KinkBoy has joined #bdsm
-<Sonya#bdsm> Hi Auduck.
-<Avante#bdsm> hi auduck
-<Ice9#BDSM> hi there Avante... smile anyway! just because... :) :)
-ACTION Nika->#bdsm: blushes
-<RonPost#bdsm> hmmmm....
-<Auduck#bdsm> hi there gangsters and gangstertettes
-<Avante#bdsm> ladyice: ooh nice smile
-[info] luvable stopped wasting time: Leaving
-<Auduck#bdsm> dern lag
-<Avante#bdsm> really
-[info] joelll!joelll@spiff.gnu.ai.mit.edu has joined #bdsm
-<joelll#bdsm> hullo..
-<nixxie#bdsm> Advante: <sigh> yes can't you tell
-<Ice9#BDSM> hi joelll
-<nixxie#bdsm> <G>
-<Chattel#bdsm> Hello Joelll
-<joelll#bdsm> hihi
-[info] Chattel has changed mode for #bdsm: +o joelll
-<Prism#bdsm> hullo.
-/privmsg noah :lick
-<Avante#bdsm> nixxie : nope.. welcome :)
-<joelll#bdsm> chattel: +o doesn't make much differenct to me, panki would still let me kick people etc..
-ACTION Nika->#bdsm: blushes and walks up to Auduck and kisses him on the cheek
-[info] TPEmember!helper@198.67.33.102 has joined #bdsm
-[info] Lorry!~Michael@safeway.demon.co.uk has joined #bdsm
-<Avante#bdsm> hello tpemember
-<Auduck#bdsm> *blush*
-<Auduck#bdsm> ;)
-<Avante#bdsm> hey lorry
-<Chattel#bdsm> I know.. it was a gesture
-[info] KinkBoy has left #bdsm
-<TPEmember#bdsm> hello
-<Ice9#BDSM> hi to anyonbe I missed in the scroll!
-<nixxie#bdsm> hiya tpemember :)
-<joelll#bdsm> chattel: thank you anyway :)
-<Avante#bdsm> lots of tpepeople floating about
-<Lorry#bdsm> Ullo.
-ACTION Chattel->#bdsm: bows to Joell
-<tippy#bdsm> Avante: what are TPEpeople, if you please?
-<tippy#bdsm> hello Lorry
-<Scigeek#bdsm> yeah....TPE?
-[info] TPEmember has changed nick to Hobit
-<Avante#bdsm> tpe teh power exchang.. a ds bulitin board..
-<Avante#bdsm> bulitin
-<joelll#bdsm> oh!
-<Avante#bdsm> bullitin
-<Avante#bdsm> better
-<nixxie#bdsm> OOO! I knew that was you!!! HUGS!!! and SWATS!!!!!!
-<Scigeek#bdsm> Ah
-<Hobit#bdsm> this is thefirst time to try irc
-<tippy#bdsm> av: got it: Thanks.
-<Avante#bdsm> tpe.ncm.com login as guest
-<Avante#bdsm> hi hobit
-<Ice9#BDSM> hiya Hobit!
-<tippy#bdsm> avante: commercial?
-<Avante#bdsm> nixxie heheh
-<Hobit#bdsm> it is a fun BBS in the washington area
-<Avante#bdsm> tippy apparently *shrug*
-<Nika#bdsm> bbl
-[info] Nika has left #bdsm
-<Avante#bdsm> <-- fun switchin the colorado area
-<tippy#bdsm> Avante: Are you in Colorado?
-<nixxie#bdsm> <sigh> I'm so confused again...
-<Avante#bdsm> tippy yeppers
-<Avante#bdsm> nixxie: why?
-<Hobit#bdsm> that is normal nixxie
-<tippy#bdsm> AV: where? I used to live in Breckenridge.
-<Avante#bdsm> Im in grand Junction..
-<nixxie#bdsm> this is true, Sir.. <G>
-[info] lou!lou@mindvox.phantom.com has joined #bdsm
-<Avante#bdsm> hey lou
-<lou#bdsm> hi avante
-ACTION tippy->#bdsm: reminisces.
-[info] Garner!VT102@AC.Dal.Ca has joined #bdsm
-<Avante#bdsm> tippy hehe breckenrige is nice
-[info] RonPost has left #bdsm
-<tippy#bdsm> avante: kewl, for lack of a better adjective.
-<Avante#bdsm> tippy *5*
-[info] Garner stopped wasting time: Leaving
-<Avante#bdsm> where are you now tippy ?
-<tippy#bdsm> Avante: I want to move back. Fuck this rat race.
-[info] Heatr!albr0014@gold2.tc.umn.edu has joined #bdsm
-<Avante#bdsm> tippy i want to leave :)
-<nixxie#bdsm> Hobit: Catch you on the flip side Sir. :)
-<Avante#bdsm> ironic hu
-/privmsg #bdsm :colorado is a rat race?
-<tippy#bdsm> NJ: I do well but I *know I would be a lot happier in the west with my family.
-<tippy#bdsm> vhf: NJ is a rat race.
-<Hobit#bdsm> see ya nixxie
-<Avante#bdsm> tippy UG.. well now i dont want to go t oNJ.
-<Heatr#bdsm> hello all
-<tippy#bdsm> Avante: why do you want to leave?
-<Avante#bdsm> bye nixxie
-<Avante#bdsm> not alot going on..
-<nixxie#bdsm> bye bye people
-[info] nixxie has left #bdsm
-<Avante#bdsm> I have totravel to denver for fun.
-<Heatr#bdsm> is everyone occupied?
-<Hobit#bdsm> bye bye all. I am going to run.
-[info] garner!VT102@AC.Dal.Ca has joined #bdsm
-<tippy#bdsm> hehe
-<Avante#bdsm> bye hobit
-<garner#bdsm> is there a netsplit tonite?
-<Heatr#bdsm> not here
-<garner#bdsm> hi all BTW :)
-[info] Hobit stopped wasting time: Leaving
-<joelll#bdsm> netsplits aren't planned, and usually last less than a minute...
-<garner#bdsm> i know......
-/privmsg #bdsm :then why do you live at grand junction?
-<Heatr#bdsm> 22, single white female
-<garner#bdsm> shesh
-<tippy#bdsm> Avante: my dream is to climb every 14,000 foot peak in CO.
-<joelll#bdsm> there may have been a bigger problem....
-<Prism#bdsm> we have netsplits all night every night.
-<garner#bdsm> hm,
-<tippy#bdsm> Hi Heatr
-<Avante#bdsm> heatr cool wwhere do you live?
-<Heatr#bdsm> hello tippy
-<Heatr#bdsm> I am in Minnesota
-<garner#bdsm> i fingered an account of someone i know, it says she's on irc, but i can't find her
-<Ice9#BDSM> garner: *.ca was split off just a short while ago
-<Sonya#bdsm> Later.
-[info] Sonya stopped wasting time: Leaving
-<garner#bdsm> oh really?
-<garner#bdsm> maybe that's it
-<Avante#bdsm> are you bi heatr?
-/privmsg #bdsm :some fingers seem to lie about who/what is going on
-<joelll#bdsm> garner...use /who -host hostname.name.etc.edu
-[info] Razormaid has joined #bdsm
-<garner#bdsm> ok
-<garner#bdsm> i get othing
-[info] Chattel stopped wasting time: Leaving
-<joelll#bdsm> then that person may not be on...
-[info] DrDark has joined #bdsm
-<garner#bdsm> that's odd...
-[info] Auduck has left #bdsm
-<garner#bdsm> bbl
-[info] garner stopped wasting time: Leaving
-<DrDark#bdsm> (*mew*)
-<DrDark#bdsm> No it isn't
-[info] Bri!kaplan@pico.cica.indiana.edu has joined #bdsm
-<DrDark#bdsm> 'lo Bri
-[info] TheMaxx!gopher@gopher.csie.nctu.edu.tw has joined #bdsm
-<Bri#bdsm> Hello.
-<TheMaxx#bdsm> hi all.
-/privmsg avante :pardon my asking, but are you bi?
-<TheMaxx#bdsm> what's up?
-[info] Bri has left #bdsm
-[info] spikee has joined #bdsm
-<spikee#bdsm> lo all
-*Avante* well im mostly het.. but i didkiss a guy saturday
-<DrDark#bdsm> Rehi spikee!
-<Scigeek#bdsm> Spikee!
-<spikee#bdsm> re drd *hug*
-<TheMaxx#bdsm> ah, I see.
-[info] Tria!~jackie@brick.purchase.edu has joined #bdsm
-<spikee#bdsm> sci!!!!!!!!!!!!!!!!!!!!!
-<TheMaxx#bdsm> hi spike
-<Tria#bdsm> Hello guys..
-<spikee#bdsm> heheh
-<Avante#bdsm> hello tria
-<TheMaxx#bdsm> hi Tria.
-ACTION DrDark->#bdsm: (*HUGS*) spikee!
-<DrDark#bdsm> 'lo tria...
-/privmsg avante :really? cool. d or s? (if this is uncool, it's okay)
-<Tria#bdsm> Hi there Avante
-<spikee#bdsm> hello themaxx :)
-<Tria#bdsm> Hi there Dr.Fark..
-<Tria#bdsm> ha ha :)
-<spikee#bdsm> scigeek call allura now?
-<joelll#bdsm> hi spikee, tria...
-[info] Tria stopped wasting time: Leaving
-<Ice9#BDSM> hi spikee, tria
-*Avante* switch.. prefer dom
-<DrDark#bdsm> spikee: She still lonely?
-<joelll#bdsm> gotta run...
-[info] joelll stopped wasting time: Leaving
-/privmsg avante :I'm new to this, just checking it out.
-<spikee#bdsm> yuppers
-[info] TheMaxx has left #bdsm
-*Avante* who are you?
-[info] BlueSonja!~law10118@leonis.nus.sg has joined #bdsm
-*Avante* im fairly new
-<DrDark#bdsm> (*sigh*)
-<Scigeek#bdsm> hi Blue
-<DrDark#bdsm> 'lo Blue...
-<BlueSonja#bdsm> Greetings all :) !!
-*Avante* im no expert or anything
-ACTION BlueSonja->#bdsm: waves to SG and DD
-ACTION Prism->#bdsm: snores gently in the background.
-/privmsg avante :steve. eissinger, i'm in virginia
-ACTION BlueSonja->#bdsm: looks at Prism...sleeping *again* ???!
-<DrDark#bdsm> Aha. He must be awake.
-<BlueSonja#bdsm> *grin* DD :)
-[info] sly!01KLHUFFMA@leo.bsuvc.bsu.edu has joined #bdsm
-*Avante* pleased to meet ay steve. :)
-ACTION Prism->#bdsm: snores determinedly.
-<DrDark#bdsm> 'lo sly!
-<BlueSonja#bdsm> haaaaaaaa
-<DrDark#bdsm> (*chuckle*)
-<BlueSonja#bdsm> hi Sly :) !
-<DrDark#bdsm> prism: Snore dammit?
-[info] sly stopped wasting time: Killed (ircserver.cltr.uq.oz.au (sly[jello.qabc.uq.oz.au] != *.uts.edu.au[unknown@138.25.8.1.3015]))
-ACTION BlueSonja->#bdsm: waves to Thorf, Avante, Spikee, Elkor, Neysa2, and all other absent/present people :)
-<Scigeek#bdsm> bbl all
-[info] Scigeek has left #bdsm
-<Prism#bdsm> DrDark - absolutely. :-)
-<BlueSonja#bdsm> where is Less, i wonder...
-<Avante#bdsm> hi sonya
-[info] sly has joined #bdsm
-/privmsg avante :how did you get started in the scene?
-<sly#bdsm> hi guys
-ACTION Prism->#bdsm: snores meaningfully in BlueSonja's direction.
-*Avante* im frank
-[info] sly stopped wasting time: Killed (ircserver.cltr.uq.oz.au (sly[jello.qabc.uq.oz.au] != *.uts.edu.au[unknown@138.25.8.1.3015]))
-ACTION BlueSonja->#bdsm: grins at Avante...*one* person woke up :)
-<Thorfinn#bdsm> Hiya Blue!
-/privmsg avante :hey frank, glad ta meet ya.
-<Ice9#BDSM> bye
-ACTION Thorfinn->#bdsm: awakes.
-<Prism#bdsm> why does sly keep getting killed?
-<Thorfinn#bdsm> Caught me just in time! :)
-[info] Ice9 has left #bdsm
-ACTION BlueSonja->#bdsm: *snorts* meaningfully in Prism's direction
-*Avante* interestingly enough thru irc
-ACTION Thorfinn->#bdsm: hugs Blue.
-<DrDark#bdsm> Prism: was just wondering that myself...
-[info] Sonya has joined #bdsm
-<Avante#bdsm> blue heh
-<BlueSonja#bdsm> heeeeee Thorf!! *grin* *HUGS*
-<Sonya#bdsm> Hello all.
-<DrDark#bdsm> Rehi Sonya1
-[info] sly!#01KLHUFFM@leo.bsuvc.bsu.edu has joined #bdsm
-<sly#bdsm> hi guys i'm back
-<BlueSonja#bdsm> hi Sonya :)
-*Avante* no .. no luck there.
-<BlueSonja#bdsm> re Sly :) back from the dead :)
-<Prism#bdsm> re, sly.
-<DrDark#bdsm> sly: For real this time?
-<BlueSonja#bdsm> Avante : *grin*
-*Avante* im trying
-ACTION Thorfinn->#bdsm: smiles.
-<sly#bdsm> yah..hopefully
-<DrDark#bdsm> sly: (*chuckle*)
-ACTION BlueSonja->#bdsm: gives Thorf a nice stalk of rose :)
-[info] Garner has joined #bdsm
-<Sonya#bdsm> HI Sonya.
-<Garner#bdsm> back :)
-<Sonya#bdsm> Err, BlueSonja.
-<Avante#bdsm> hi garner
-ACTION Prism->#bdsm: turns over and goes back to sleep.
-[info] Heatr has left #bdsm
-<BlueSonja#bdsm> heee Sonya :)
-<Garner#bdsm> hi avante
-[info] lou has left #bdsm
-ACTION Prism->#bdsm: snores gently in the background.
-ACTION Garner->#bdsm: sighs
-<spikee#bdsm> sleep well prism *snicker*
-[info] wetknight!mundv@uxa.ecn.bgu.edu has joined #bdsm
-[info] Bananaman!SHELL@DRYCAS.CLUB.CC.CMU.EDU has joined #bdsm
-<DrDark#bdsm> 'lo wk...
-<DrDark#bdsm> 'lo BMan!
-<wetknight#bdsm> hello DD
-ACTION Thorfinn->#bdsm: smiles at Blue.
-<Thorfinn#bdsm> Thanks!
-<BlueSonja#bdsm> hi WK, BMan :)
-<Avante#bdsm> hi wetknight
-ACTION BlueSonja->#bdsm: bows to Thorf
-<Bananaman#bdsm> Hello folks
-<wetknight#bdsm> salutations to all
-<Lorry#bdsm> Does vhf have a long ariel?
-/privmsg #bdsm :?
-<DrDark#bdsm> vhf: penis joke, I think...
-<Prism#bdsm> Gee.. The person I was wanting to go out to dinner with tonight just told me to order pizza.
-<BlueSonja#bdsm> haaa
-<Prism#bdsm> and then wait patiently.
-<BlueSonja#bdsm> poor Prism! *patpat*
-<Garner#bdsm> prism: brutal
-ACTION Thorfinn->#bdsm: cuddles up to Blue.
-<DrDark#bdsm> Prism: Wow...
-<sly#bdsm> hey bananman have you talked with pickle yet--tonite
-<wetknight#bdsm> tell that person to stick it BlueSonja
-<spikee#bdsm> aww prism
-ACTION Prism->#bdsm: bursts into tears.
-<DrDark#bdsm> Prism: Hope it's worth the wait...
-ACTION BlueSonja->#bdsm: hugs Thorfinn :)
-ACTION spikee->#bdsm: gives prism her hanki
-<Sonya#bdsm> *wands her Lady*
-<Bananaman#bdsm> No, sly, why?
-<Sonya#bdsm> Panki whois sonya
-{Panki#bdsm} ==== Sonya is the cute, cuddly adorable uppity bottom of Lady Penelope. But watch out, she is a master of the Force. ====
-[info] Garner has left #bdsm
-<BlueSonja#bdsm> Wetknight: huh? who? stick what? where? *grinZ*
-<Avante#bdsm> bluesonja hehe
-<spikee#bdsm> heheh cute sonya
-[info] LocalHero!wayne@146.116.1.5 has joined #bdsm
-[info] LocalHero has changed nick to Wayne
-<spikee#bdsm> hello lh!
-<wetknight#bdsm> BlueSonja :)
-<sly#bdsm> hi
-<BlueSonja#bdsm> *grin*
-<DrDark#bdsm> 'lo Wayne..
-<Wayne#bdsm> Greetings my friend
-<BlueSonja#bdsm> Sonya: nice! :)
-ACTION Prism->#bdsm: thanks spikee,wipes his eyes and blows his nose.
-<Neysa2#bdsm> back...front
-<Prism#bdsm> *HONK*
-<BlueSonja#bdsm> hey Wayne! :)
-ACTION Wayne->#bdsm: pokes Sonja in the ribs
-<BlueSonja#bdsm> Neys!!!
-<Neysa2#bdsm> hello heatr
-ACTION Wayne->#bdsm: giggles quietly
-ACTION spikee->#bdsm: hugs prism
-<sly#bdsm> hey everyone
-ACTION BlueSonja->#bdsm: hugs Neys
-<Sonya#bdsm> Hi Wayne.
-<Razormaid#bdsm> better living through pain
-ACTION Thorfinn->#bdsm: smiles.
-ACTION BlueSonja->#bdsm: giggles at being poked
-ACTION Prism->#bdsm: hugs spikee back.
-[info] wetknight has left #bdsm
-ACTION Wayne->#bdsm: smiles happily ;-b
-[info] pep!law33720@leonis.nus.sg has joined #bdsm
-<Neysa2#bdsm> hi tria
-<BlueSonja#bdsm> brb, changing terminals :)
-<Avante#bdsm> hi pep
-<sly#bdsm> hi pep
-[info] BlueSonja stopped wasting time: Leaving
-<Lorry#bdsm> Hehe.
-<pep#bdsm> hello
-[info] Lorry has left #bdsm
-<Neysa2#bdsm> ok, who did I misss
-
-
-----------------------------------------------------------------------
-
-this faq is copyright (c) 1994 to the piglet way (tm).
-you may only modify this if you make it more offensive.
+++ /dev/null
-ZenIRC 2.0 - Sun Feb 27 12:37:31 MST 1994 - ALPHA2
-
-DISCLAIMER:
-
-THIS IS REALLY OUT OF DATE, THE ONLY REASON IT'S KEPT AROUND IS THAT
-IT DOES DESCRIBE SOME THINGS PRETTY GOOD. BEFORE YOU BELIEVE WHAT THIS
-FILE SAYS, LOOK AT `zenirc-example.el' AND THE SOURCE.
-
-KNOWN BUGS:
-
-See the TODO file.
-
-KNOWN FEATURES AND INSTRUCTIONS:
-
-Here is a list of variables you might want to frobnicate in your .emacs or
-on the fly:
-
-zenirc-buffer-name, change the buffer name to something besides "*zenirc*"
-
-zenirc-IRCSERVER-alist - Association list of port/password/nick info for
-each server.
-
-Zenirc will attempt to connect to each `host' at `port' in turn until a
-successful connection is made, using the username `user' (and `password' if
-the server requests one). Your nickname is set to the value `nick'.
-
-The default value of this alist is determined by the value of the
-environment variable `IRCSERVER', which should be in the format
-`host:port:password:nickname:username'. If more than one host:etc group is
-desired, separate each group with any nonzero amount of whitespace composed
-of spaces, tabs, and/or newlines.
-
-The actual data types of the atoms of each association are string (server),
-int (port), string (password), string (nickname), string (username).
-
-zenirc-server - The hostname of the IRC server to which to connect.
-
-This is initialized to the first server in `zenirc-IRCSERVER-alist' if that
-variable is non-`nil', or "irc-2.mit.edu" by default.
-
-zenirc-servername - The server name of the IRC server current connected to.
-(hmm. this should be a setq, I think)
-
-zenirc-port - The TCP port associated with the irc server specified
-by `zenirc-server'.
-
-If the server initially specified in `zenirc-server' appears in
-`zenirc-IRCSERVER-alist', and a port is explicitly associated with that
-server, `zenirc-port' is initialized to that port. Otherwise,
-`zenirc-port' defaults to 6667.
-
-zenirc-user-login-name - the username with which you signon IRC.
-
-This is usually your username on the system as returned by the function
-`user-login-name'. However, if the server initially specified in
-`zenirc-server' appears in `zenirc-IRCSERVER-alist' and a username is
-explicitly associated with that server, `zenirc-user-login-name' is
-initialized to that value.
-
-zenirc-nick - If the server initially specified in `zenirc-server' appears in
-`zenirc-IRCSERVER-alist' and a nickname is explicitly associated with that
-server, `zenirc-nick' is initialized to that nickname. If this is not the
-case but the environment variable `IRCNICK' is set, `zenirc-nick' is
-initialized from that. As a last resort, it defaults to the value of the
-variable `zenirc-user-login-name'.
-
-zenirc-name - The name which you use on IRC.
-The default is your GECOS information.
-
-zenirc-password - Connection password for your IRC server.
-The default is none.
-
-zenirc-userinfo - Reply to USERINFO ctcp
-
-zenirc-mode-map - Sparse keymap for zenirc-mode
-
-zenirc-ignorance-list - A list of regexps matching annoying
-things that should be ignored.
-
-zenirc-signal-list - A list of regexps matching things that should cause the
-user to be notified of them.
-
-zenirc-beep-on-signal - Set to t if notification of something matching a regexp
-in zenirc-signal-list should cause emacs to beep.
-
-zenirc-send-ctcp-errmsg-on-unknown - Set to t if ZenIRC should reply with an
-ERRMSG to unknown CTCP queries.
-
-zenirc-send-ctcp-errmsg-on-unbalanced - Set to t if ZenIRC should send an
-ERRMSG to an unbalanced CTCP query.
-
-zenirc-verbose-ctcp - Set to t if you want ZenIRC to tell you when it sends
-CTCP replies to people who query you.
-
-zenirc-fingerdata - CTCP FINGER reply data.
-
-zenirc-source - CTCP SOURCE reply data
-
-zenirc-text-list - insert note about function to set here
-
-zenirc-clientinfo-list - association list of CTCP CLIENTINFO help strings.
-
-zenirc-clientinfo - Help string, showing list of CTCP commands supported.
-
-zenirc-debug-mainloop, zenirc-debug-ignore, zenirc-debug-signal,
-zenirc-debug-ctcp, zenirc-debug-commands zenirc-debug-timer -
-debugging flags. If you're using these, then the help file is old news
-as you've read the source.
-
-The client is designed to be extensible and customizable, in the
-spirit of ircII. It uses an extended version of the emacs 19 hook
-mechanism, dubbed "zenhooks".
-
-The basic idea behind the zenhook mechanism is that we want to be able to
-attach multiple functions to a given hook. Rather than just specifying a
-single hook by creating a function with a certain name, instead hooks become
-variables which contain a list of functions to be called. You can add a new
-function to a hook variable with the function zenirc-add-hook. If you do
-something like (zenirc-add-hook 'zenirc-timer-hook 'ruru), it will cause
-the function "ruru" to be added to the hook variable, zenirc-timer-hook.
-
-Hooks are removed from a hook variable with the function
-zenirc-delete-hook - ie, (zenirc-delete-hook 'zenirc-timer-hook 'ruru)
-would remove ruru from the list of functions to be called when
-zenirc-timer-hook is run.
-
-zenhooks are run with the function zenirc-run-hook. This function,
-unlike the emacs 19 hook functions, passes any extra arguments to
-zenirc-run-hook to each function in the hook list as it is
-run. In addition, if any function sets zenirc-run-next-hook to nil,
-then remaining hooks in the hooklist are not called, and
-zenirc-run-hook returns immediately.
-
-For the timer code, zenirc uses a hook variable called
-zenirc-timer-hook. This hook is called at most once a minute, and at
-least as often as the irc server pings the client. The functions in
-zenirc-timer-hook take a single argument, a process, the ZenIRC
-process. An example of adding a new function to zenirc-timer-hook is
-scripts/zenirc-stamp.el, which implements Kiwi client style timestamps
-in the ZenIRC buffer.
-
-The signal code is called via a hook variable called
-zenirc-signal-hook. scripts/zenirc-fancy-signal.el shows an example of
-using this hook as well as the variable zenirc-run-next-hook.
-zenirc-signal-hook is called with two arguments, the first is the
-zenirc process, and the second is a string, the unparsed servermessage
-that caused the signal to occur.
-
-In various places in the IRC protocol, the IRC server sends the client
-strings of the form `nick!user@host' where some parts of this are
-optional (see the RFC). The zenhook used to format these is
-`zenirc-format-nickuserhost-hook', and is called with a single argument,
-the string to format. It returns the formatted string.
-
-To add new commands to ZenIRC, you create zenhooks with names of the
-form "zenirc-command-WHATEVER-hook". The hook will be run with
-the arguments "proc" and "parsedcmd". The first argument is the zenirc
-process, and the second argument is a slightly parsed form of what the
-user typed. The "parsedcmd" argument is a list with two elements. The
-first is the first word on the line the user typed, and the second is
-the rest of the line. For instance, if the user issued the command
-"/FOO BAR", then parsedcmd would be set to ("FOO" "BAR"). Commands
-used to use the old hook mechanism, but that is now obsolete.
-
-CTCP is similarly extensible, only the format of the hook variable
-names are zenirc-ctcp-query-WHATEVER-hook and
-zenirc-ctcp-reply-WHATEVER-hook. A "query" is a CTCP inside a PRIVMSG
-server message, and a "reply" is a CTCP inside a NOTICE server
-message. These hooks are called with four arguments, the zenirc filter
-process, a parsed ctcp message of the form ("CTCP_COMMAND" .
-"ARGUMENTS"), the sender of the ctcp, and the reciever of the ctcp.
-CTCP used to use the old hook mechanism, but that is now obsolete.
-
-All server message handling hook variables have names of the form:
-zenirc-server-MESSAGE-hook, and take two arguments, the zenirc filter
-procedure, and a parsed message, which is an array that looks like
-(sender MESSAGE arg1 arg2 ...). If you want to create a handler for a
-message that does not currently have a handler, create your own
-hook variable with a name of this form that accepts these arguments, and
-ZenIRC will call your subroutine whenever it gets that server message.
-To override or modify the behavior of a server message that already
-has a hook, call zenirc-add-hook to add your subroutine to the hook
-variable. You can override by setting zenirc-run-next-hook to nil, and
-you can delete your entry in the hook variable with zenirc-delete-hook.
-
-Some documents that may prove helpful in extending the client are the
-RFC protocol specification for IRC and ctcp.doc. these are both included
-in this archive.
-
-Please send any comments, questions, ideas, bugfixes or whatever to
-bed@gnu.ai.mit.edu
-
+++ /dev/null
-
-
-
-
-
-
-Network Working Group J. Oikarinen
-Request for Comments: 1459 D. Reed
- May 1993
-
-
- Internet Relay Chat Protocol
-
-Status of This Memo
-
- This memo defines an Experimental Protocol for the Internet
- community. Discussion and suggestions for improvement are requested.
- Please refer to the current edition of the "IAB Official Protocol
- Standards" for the standardization state and status of this protocol.
- Distribution of this memo is unlimited.
-
-Abstract
-
- The IRC protocol was developed over the last 4 years since it was
- first implemented as a means for users on a BBS to chat amongst
- themselves. Now it supports a world-wide network of servers and
- clients, and is stringing to cope with growth. Over the past 2 years,
- the average number of users connected to the main IRC network has
- grown by a factor of 10.
-
- The IRC protocol is a text-based protocol, with the simplest client
- being any socket program capable of connecting to the server.
-
-Table of Contents
-
- 1. INTRODUCTION ............................................... 4
- 1.1 Servers ................................................ 4
- 1.2 Clients ................................................ 5
- 1.2.1 Operators .......................................... 5
- 1.3 Channels ................................................ 5
- 1.3.1 Channel Operators .................................... 6
- 2. THE IRC SPECIFICATION ....................................... 7
- 2.1 Overview ................................................ 7
- 2.2 Character codes ......................................... 7
- 2.3 Messages ................................................ 7
- 2.3.1 Message format in 'pseudo' BNF .................... 8
- 2.4 Numeric replies ......................................... 10
- 3. IRC Concepts ................................................ 10
- 3.1 One-to-one communication ................................ 10
- 3.2 One-to-many ............................................. 11
- 3.2.1 To a list .......................................... 11
- 3.2.2 To a group (channel) ............................... 11
- 3.2.3 To a host/server mask .............................. 12
- 3.3 One to all .............................................. 12
-
-
-
-Oikarinen & Reed [Page 1]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 3.3.1 Client to Client ................................... 12
- 3.3.2 Clients to Server .................................. 12
- 3.3.3 Server to Server ................................... 12
- 4. MESSAGE DETAILS ............................................. 13
- 4.1 Connection Registration ................................. 13
- 4.1.1 Password message ................................... 14
- 4.1.2 Nickname message ................................... 14
- 4.1.3 User message ....................................... 15
- 4.1.4 Server message ..................................... 16
- 4.1.5 Operator message ................................... 17
- 4.1.6 Quit message ....................................... 17
- 4.1.7 Server Quit message ................................ 18
- 4.2 Channel operations ...................................... 19
- 4.2.1 Join message ....................................... 19
- 4.2.2 Part message ....................................... 20
- 4.2.3 Mode message ....................................... 21
- 4.2.3.1 Channel modes ................................. 21
- 4.2.3.2 User modes .................................... 22
- 4.2.4 Topic message ...................................... 23
- 4.2.5 Names message ...................................... 24
- 4.2.6 List message ....................................... 24
- 4.2.7 Invite message ..................................... 25
- 4.2.8 Kick message ....................................... 25
- 4.3 Server queries and commands ............................. 26
- 4.3.1 Version message .................................... 26
- 4.3.2 Stats message ...................................... 27
- 4.3.3 Links message ...................................... 28
- 4.3.4 Time message ....................................... 29
- 4.3.5 Connect message .................................... 29
- 4.3.6 Trace message ...................................... 30
- 4.3.7 Admin message ...................................... 31
- 4.3.8 Info message ....................................... 31
- 4.4 Sending messages ........................................ 32
- 4.4.1 Private messages ................................... 32
- 4.4.2 Notice messages .................................... 33
- 4.5 User-based queries ...................................... 33
- 4.5.1 Who query .......................................... 33
- 4.5.2 Whois query ........................................ 34
- 4.5.3 Whowas message ..................................... 35
- 4.6 Miscellaneous messages .................................. 35
- 4.6.1 Kill message ....................................... 36
- 4.6.2 Ping message ....................................... 37
- 4.6.3 Pong message ....................................... 37
- 4.6.4 Error message ...................................... 38
- 5. OPTIONAL MESSAGES ........................................... 38
- 5.1 Away message ............................................ 38
- 5.2 Rehash command .......................................... 39
- 5.3 Restart command ......................................... 39
-
-
-
-Oikarinen & Reed [Page 2]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 5.4 Summon message .......................................... 40
- 5.5 Users message ........................................... 40
- 5.6 Operwall command ........................................ 41
- 5.7 Userhost message ........................................ 42
- 5.8 Ison message ............................................ 42
- 6. REPLIES ..................................................... 43
- 6.1 Error Replies ........................................... 43
- 6.2 Command responses ....................................... 48
- 6.3 Reserved numerics ....................................... 56
- 7. Client and server authentication ............................ 56
- 8. Current Implementations Details ............................. 56
- 8.1 Network protocol: TCP ................................... 57
- 8.1.1 Support of Unix sockets ............................ 57
- 8.2 Command Parsing ......................................... 57
- 8.3 Message delivery ........................................ 57
- 8.4 Connection 'Liveness' ................................... 58
- 8.5 Establishing a server-client connection ................. 58
- 8.6 Establishing a server-server connection ................. 58
- 8.6.1 State information exchange when connecting ......... 59
- 8.7 Terminating server-client connections ................... 59
- 8.8 Terminating server-server connections ................... 59
- 8.9 Tracking nickname changes ............................... 60
- 8.10 Flood control of clients ............................... 60
- 8.11 Non-blocking lookups ................................... 61
- 8.11.1 Hostname (DNS) lookups ............................ 61
- 8.11.2 Username (Ident) lookups .......................... 61
- 8.12 Configuration file ..................................... 61
- 8.12.1 Allowing clients to connect ....................... 62
- 8.12.2 Operators ......................................... 62
- 8.12.3 Allowing servers to connect ....................... 62
- 8.12.4 Administrivia ..................................... 63
- 8.13 Channel membership ..................................... 63
- 9. Current problems ............................................ 63
- 9.1 Scalability ............................................. 63
- 9.2 Labels .................................................. 63
- 9.2.1 Nicknames .......................................... 63
- 9.2.2 Channels ........................................... 64
- 9.2.3 Servers ............................................ 64
- 9.3 Algorithms .............................................. 64
- 10. Support and availability ................................... 64
- 11. Security Considerations .................................... 65
- 12. Authors' Addresses ......................................... 65
-
-
-
-
-
-
-
-
-
-Oikarinen & Reed [Page 3]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-1. INTRODUCTION
-
- The IRC (Internet Relay Chat) protocol has been designed over a
- number of years for use with text based conferencing. This document
- describes the current IRC protocol.
-
- The IRC protocol has been developed on systems using the TCP/IP
- network protocol, although there is no requirement that this remain
- the only sphere in which it operates.
-
- IRC itself is a teleconferencing system, which (through the use of
- the client-server model) is well-suited to running on many machines
- in a distributed fashion. A typical setup involves a single process
- (the server) forming a central point for clients (or other servers)
- to connect to, performing the required message delivery/multiplexing
- and other functions.
-
-1.1 Servers
-
- The server forms the backbone of IRC, providing a point to which
- clients may connect to to talk to each other, and a point for other
- servers to connect to, forming an IRC network. The only network
- configuration allowed for IRC servers is that of a spanning tree [see
- Fig. 1] where each server acts as a central node for the rest of the
- net it sees.
-
-
- [ Server 15 ] [ Server 13 ] [ Server 14]
- / \ /
- / \ /
- [ Server 11 ] ------ [ Server 1 ] [ Server 12]
- / \ /
- / \ /
- [ Server 2 ] [ Server 3 ]
- / \ \
- / \ \
- [ Server 4 ] [ Server 5 ] [ Server 6 ]
- / | \ /
- / | \ /
- / | \____ /
- / | \ /
- [ Server 7 ] [ Server 8 ] [ Server 9 ] [ Server 10 ]
-
- :
- [ etc. ]
- :
-
- [ Fig. 1. Format of IRC server network ]
-
-
-
-Oikarinen & Reed [Page 4]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-1.2 Clients
-
- A client is anything connecting to a server that is not another
- server. Each client is distinguished from other clients by a unique
- nickname having a maximum length of nine (9) characters. See the
- protocol grammar rules for what may and may not be used in a
- nickname. In addition to the nickname, all servers must have the
- following information about all clients: the real name of the host
- that the client is running on, the username of the client on that
- host, and the server to which the client is connected.
-
-1.2.1 Operators
-
- To allow a reasonable amount of order to be kept within the IRC
- network, a special class of clients (operators) is allowed to perform
- general maintenance functions on the network. Although the powers
- granted to an operator can be considered as 'dangerous', they are
- nonetheless required. Operators should be able to perform basic
- network tasks such as disconnecting and reconnecting servers as
- needed to prevent long-term use of bad network routing. In
- recognition of this need, the protocol discussed herein provides for
- operators only to be able to perform such functions. See sections
- 4.1.7 (SQUIT) and 4.3.5 (CONNECT).
-
- A more controversial power of operators is the ability to remove a
- user from the connected network by 'force', i.e. operators are able
- to close the connection between any client and server. The
- justification for this is delicate since its abuse is both
- destructive and annoying. For further details on this type of
- action, see section 4.6.1 (KILL).
-
-1.3 Channels
-
- A channel is a named group of one or more clients which will all
- receive messages addressed to that channel. The channel is created
- implicitly when the first client joins it, and the channel ceases to
- exist when the last client leaves it. While channel exists, any
- client can reference the channel using the name of the channel.
-
- Channels names are strings (beginning with a '&' or '#' character) of
- length up to 200 characters. Apart from the the requirement that the
- first character being either '&' or '#'; the only restriction on a
- channel name is that it may not contain any spaces (' '), a control G
- (^G or ASCII 7), or a comma (',' which is used as a list item
- separator by the protocol).
-
- There are two types of channels allowed by this protocol. One is a
- distributed channel which is known to all the servers that are
-
-
-
-Oikarinen & Reed [Page 5]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- connected to the network. These channels are marked by the first
- character being a only clients on the server where it exists may join
- it. These are distinguished by a leading '&' character. On top of
- these two types, there are the various channel modes available to
- alter the characteristics of individual channels. See section 4.2.3
- (MODE command) for more details on this.
-
- To create a new channel or become part of an existing channel, a user
- is required to JOIN the channel. If the channel doesn't exist prior
- to joining, the channel is created and the creating user becomes a
- channel operator. If the channel already exists, whether or not your
- request to JOIN that channel is honoured depends on the current modes
- of the channel. For example, if the channel is invite-only, (+i),
- then you may only join if invited. As part of the protocol, a user
- may be a part of several channels at once, but a limit of ten (10)
- channels is recommended as being ample for both experienced and
- novice users. See section 8.13 for more information on this.
-
- If the IRC network becomes disjoint because of a split between two
- servers, the channel on each side is only composed of those clients
- which are connected to servers on the respective sides of the split,
- possibly ceasing to exist on one side of the split. When the split
- is healed, the connecting servers announce to each other who they
- think is in each channel and the mode of that channel. If the
- channel exists on both sides, the JOINs and MODEs are interpreted in
- an inclusive manner so that both sides of the new connection will
- agree about which clients are in the channel and what modes the
- channel has.
-
-1.3.1 Channel Operators
-
- The channel operator (also referred to as a "chop" or "chanop") on a
- given channel is considered to 'own' that channel. In recognition of
- this status, channel operators are endowed with certain powers which
- enable them to keep control and some sort of sanity in their channel.
- As an owner of a channel, a channel operator is not required to have
- reasons for their actions, although if their actions are generally
- antisocial or otherwise abusive, it might be reasonable to ask an IRC
- operator to intervene, or for the usersjust leave and go elsewhere
- and form their own channel.
-
- The commands which may only be used by channel operators are:
-
- KICK - Eject a client from the channel
- MODE - Change the channel's mode
- INVITE - Invite a client to an invite-only channel (mode +i)
- TOPIC - Change the channel topic in a mode +t channel
-
-
-
-
-Oikarinen & Reed [Page 6]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- A channel operator is identified by the '@' symbol next to their
- nickname whenever it is associated with a channel (ie replies to the
- NAMES, WHO and WHOIS commands).
-
-2. The IRC Specification
-
-2.1 Overview
-
- The protocol as described herein is for use both with server to
- server and client to server connections. There are, however, more
- restrictions on client connections (which are considered to be
- untrustworthy) than on server connections.
-
-2.2 Character codes
-
- No specific character set is specified. The protocol is based on a a
- set of codes which are composed of eight (8) bits, making up an
- octet. Each message may be composed of any number of these octets;
- however, some octet values are used for control codes which act as
- message delimiters.
-
- Regardless of being an 8-bit protocol, the delimiters and keywords
- are such that protocol is mostly usable from USASCII terminal and a
- telnet connection.
-
- Because of IRC's scandanavian origin, the characters {}| are
- considered to be the lower case equivalents of the characters []\,
- respectively. This is a critical issue when determining the
- equivalence of two nicknames.
-
-2.3 Messages
-
- Servers and clients send eachother messages which may or may not
- generate a reply. If the message contains a valid command, as
- described in later sections, the client should expect a reply as
- specified but it is not advised to wait forever for the reply; client
- to server and server to server communication is essentially
- asynchronous in nature.
-
- Each IRC message may consist of up to three main parts: the prefix
- (optional), the command, and the command parameters (of which there
- may be up to 15). The prefix, command, and all parameters are
- separated by one (or more) ASCII space character(s) (0x20).
-
- The presence of a prefix is indicated with a single leading ASCII
- colon character (':', 0x3b), which must be the first character of the
- message itself. There must be no gap (whitespace) between the colon
- and the prefix. The prefix is used by servers to indicate the true
-
-
-
-Oikarinen & Reed [Page 7]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- origin of the message. If the prefix is missing from the message, it
- is assumed to have originated from the connection from which it was
- received. Clients should not use prefix when sending a message from
- themselves; if they use a prefix, the only valid prefix is the
- registered nickname associated with the client. If the source
- identified by the prefix cannot be found from the server's internal
- database, or if the source is registered from a different link than
- from which the message arrived, the server must ignore the message
- silently.
-
- The command must either be a valid IRC command or a three (3) digit
- number represented in ASCII text.
-
- IRC messages are always lines of characters terminated with a CR-LF
- (Carriage Return - Line Feed) pair, and these messages shall not
- exceed 512 characters in length, counting all characters including
- the trailing CR-LF. Thus, there are 510 characters maximum allowed
- for the command and its parameters. There is no provision for
- continuation message lines. See section 7 for more details about
- current implementations.
-
-2.3.1 Message format in 'pseudo' BNF
-
- The protocol messages must be extracted from the contiguous stream of
- octets. The current solution is to designate two characters, CR and
- LF, as message separators. Empty messages are silently ignored,
- which permits use of the sequence CR-LF between messages
- without extra problems.
-
- The extracted message is parsed into the components <prefix>,
- <command> and list of parameters matched either by <middle> or
- <trailing> components.
-
- The BNF representation for this is:
-
-
-<message> ::= [':' <prefix> <SPACE> ] <command> <params> <crlf>
-<prefix> ::= <servername> | <nick> [ '!' <user> ] [ '@' <host> ]
-<command> ::= <letter> { <letter> } | <number> <number> <number>
-<SPACE> ::= ' ' { ' ' }
-<params> ::= <SPACE> [ ':' <trailing> | <middle> <params> ]
-
-<middle> ::= <Any *non-empty* sequence of octets not including SPACE
- or NUL or CR or LF, the first of which may not be ':'>
-<trailing> ::= <Any, possibly *empty*, sequence of octets not including
- NUL or CR or LF>
-
-<crlf> ::= CR LF
-
-
-
-Oikarinen & Reed [Page 8]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-NOTES:
-
- 1) <SPACE> is consists only of SPACE character(s) (0x20).
- Specially notice that TABULATION, and all other control
- characters are considered NON-WHITE-SPACE.
-
- 2) After extracting the parameter list, all parameters are equal,
- whether matched by <middle> or <trailing>. <Trailing> is just
- a syntactic trick to allow SPACE within parameter.
-
- 3) The fact that CR and LF cannot appear in parameter strings is
- just artifact of the message framing. This might change later.
-
- 4) The NUL character is not special in message framing, and
- basically could end up inside a parameter, but as it would
- cause extra complexities in normal C string handling. Therefore
- NUL is not allowed within messages.
-
- 5) The last parameter may be an empty string.
-
- 6) Use of the extended prefix (['!' <user> ] ['@' <host> ]) must
- not be used in server to server communications and is only
- intended for server to client messages in order to provide
- clients with more useful information about who a message is
- from without the need for additional queries.
-
- Most protocol messages specify additional semantics and syntax for
- the extracted parameter strings dictated by their position in the
- list. For example, many server commands will assume that the first
- parameter after the command is the list of targets, which can be
- described with:
-
- <target> ::= <to> [ "," <target> ]
- <to> ::= <channel> | <user> '@' <servername> | <nick> | <mask>
- <channel> ::= ('#' | '&') <chstring>
- <servername> ::= <host>
- <host> ::= see RFC 952 [DNS:4] for details on allowed hostnames
- <nick> ::= <letter> { <letter> | <number> | <special> }
- <mask> ::= ('#' | '$') <chstring>
- <chstring> ::= <any 8bit code except SPACE, BELL, NUL, CR, LF and
- comma (',')>
-
- Other parameter syntaxes are:
-
- <user> ::= <nonwhite> { <nonwhite> }
- <letter> ::= 'a' ... 'z' | 'A' ... 'Z'
- <number> ::= '0' ... '9'
- <special> ::= '-' | '[' | ']' | '\' | '`' | '^' | '{' | '}'
-
-
-
-Oikarinen & Reed [Page 9]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- <nonwhite> ::= <any 8bit code except SPACE (0x20), NUL (0x0), CR
- (0xd), and LF (0xa)>
-
-2.4 Numeric replies
-
- Most of the messages sent to the server generate a reply of some
- sort. The most common reply is the numeric reply, used for both
- errors and normal replies. The numeric reply must be sent as one
- message consisting of the sender prefix, the three digit numeric, and
- the target of the reply. A numeric reply is not allowed to originate
- from a client; any such messages received by a server are silently
- dropped. In all other respects, a numeric reply is just like a normal
- message, except that the keyword is made up of 3 numeric digits
- rather than a string of letters. A list of different replies is
- supplied in section 6.
-
-3. IRC Concepts.
-
- This section is devoted to describing the actual concepts behind the
- organization of the IRC protocol and how the current
- implementations deliver different classes of messages.
-
-
-
- 1--\
- A D---4
- 2--/ \ /
- B----C
- / \
- 3 E
-
- Servers: A, B, C, D, E Clients: 1, 2, 3, 4
-
- [ Fig. 2. Sample small IRC network ]
-
-3.1 One-to-one communication
-
- Communication on a one-to-one basis is usually only performed by
- clients, since most server-server traffic is not a result of servers
- talking only to each other. To provide a secure means for clients to
- talk to each other, it is required that all servers be able to send a
- message in exactly one direction along the spanning tree in order to
- reach any client. The path of a message being delivered is the
- shortest path between any two points on the spanning tree.
-
- The following examples all refer to Figure 2 above.
-
-
-
-
-
-Oikarinen & Reed [Page 10]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-Example 1:
- A message between clients 1 and 2 is only seen by server A, which
- sends it straight to client 2.
-
-Example 2:
- A message between clients 1 and 3 is seen by servers A & B, and
- client 3. No other clients or servers are allowed see the message.
-
-Example 3:
- A message between clients 2 and 4 is seen by servers A, B, C & D
- and client 4 only.
-
-3.2 One-to-many
-
- The main goal of IRC is to provide a forum which allows easy and
- efficient conferencing (one to many conversations). IRC offers
- several means to achieve this, each serving its own purpose.
-
-3.2.1 To a list
-
- The least efficient style of one-to-many conversation is through
- clients talking to a 'list' of users. How this is done is almost
- self explanatory: the client gives a list of destinations to which
- the message is to be delivered and the server breaks it up and
- dispatches a separate copy of the message to each given destination.
- This isn't as efficient as using a group since the destination list
- is broken up and the dispatch sent without checking to make sure
- duplicates aren't sent down each path.
-
-3.2.2 To a group (channel)
-
- In IRC the channel has a role equivalent to that of the multicast
- group; their existence is dynamic (coming and going as people join
- and leave channels) and the actual conversation carried out on a
- channel is only sent to servers which are supporting users on a given
- channel. If there are multiple users on a server in the same
- channel, the message text is sent only once to that server and then
- sent to each client on the channel. This action is then repeated for
- each client-server combination until the original message has fanned
- out and reached each member of the channel.
-
- The following examples all refer to Figure 2.
-
-Example 4:
- Any channel with 1 client in it. Messages to the channel go to the
- server and then nowhere else.
-
-
-
-
-
-Oikarinen & Reed [Page 11]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-Example 5:
- 2 clients in a channel. All messages traverse a path as if they
- were private messages between the two clients outside a channel.
-
-Example 6:
- Clients 1, 2 and 3 in a channel. All messages to the channel are
- sent to all clients and only those servers which must be traversed
- by the message if it were a private message to a single client. If
- client 1 sends a message, it goes back to client 2 and then via
- server B to client 3.
-
-3.2.3 To a host/server mask
-
- To provide IRC operators with some mechanism to send messages to a
- large body of related users, host and server mask messages are
- provided. These messages are sent to users whose host or server
- information match that of the mask. The messages are only sent to
- locations where users are, in a fashion similar to that of channels.
-
-3.3 One-to-all
-
- The one-to-all type of message is better described as a broadcast
- message, sent to all clients or servers or both. On a large network
- of users and servers, a single message can result in a lot of traffic
- being sent over the network in an effort to reach all of the desired
- destinations.
-
- For some messages, there is no option but to broadcast it to all
- servers so that the state information held by each server is
- reasonably consistent between servers.
-
-3.3.1 Client-to-Client
-
- There is no class of message which, from a single message, results in
- a message being sent to every other client.
-
-3.3.2 Client-to-Server
-
- Most of the commands which result in a change of state information
- (such as channel membership, channel mode, user status, etc) must be
- sent to all servers by default, and this distribution may not be
- changed by the client.
-
-3.3.3 Server-to-Server.
-
- While most messages between servers are distributed to all 'other'
- servers, this is only required for any message that affects either a
- user, channel or server. Since these are the basic items found in
-
-
-
-Oikarinen & Reed [Page 12]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- IRC, nearly all messages originating from a server are broadcast to
- all other connected servers.
-
-4. Message details
-
- On the following pages are descriptions of each message recognized by
- the IRC server and client. All commands described in this section
- must be implemented by any server for this protocol.
-
- Where the reply ERR_NOSUCHSERVER is listed, it means that the
- <server> parameter could not be found. The server must not send any
- other replies after this for that command.
-
- The server to which a client is connected is required to parse the
- complete message, returning any appropriate errors. If the server
- encounters a fatal error while parsing a message, an error must be
- sent back to the client and the parsing terminated. A fatal error
- may be considered to be incorrect command, a destination which is
- otherwise unknown to the server (server, nick or channel names fit
- this category), not enough parameters or incorrect privileges.
-
- If a full set of parameters is presented, then each must be checked
- for validity and appropriate responses sent back to the client. In
- the case of messages which use parameter lists using the comma as an
- item separator, a reply must be sent for each item.
-
- In the examples below, some messages appear using the full format:
-
- :Name COMMAND parameter list
-
- Such examples represent a message from "Name" in transit between
- servers, where it is essential to include the name of the original
- sender of the message so remote servers may send back a reply along
- the correct path.
-
-4.1 Connection Registration
-
- The commands described here are used to register a connection with an
- IRC server as either a user or a server as well as correctly
- disconnect.
-
- A "PASS" command is not required for either client or server
- connection to be registered, but it must precede the server message
- or the latter of the NICK/USER combination. It is strongly
- recommended that all server connections have a password in order to
- give some level of security to the actual connections. The
- recommended order for a client to register is as follows:
-
-
-
-
-Oikarinen & Reed [Page 13]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 1. Pass message
- 2. Nick message
- 3. User message
-
-4.1.1 Password message
-
-
- Command: PASS
- Parameters: <password>
-
- The PASS command is used to set a 'connection password'. The
- password can and must be set before any attempt to register the
- connection is made. Currently this requires that clients send a PASS
- command before sending the NICK/USER combination and servers *must*
- send a PASS command before any SERVER command. The password supplied
- must match the one contained in the C/N lines (for servers) or I
- lines (for clients). It is possible to send multiple PASS commands
- before registering but only the last one sent is used for
- verification and it may not be changed once registered. Numeric
- Replies:
-
- ERR_NEEDMOREPARAMS ERR_ALREADYREGISTRED
-
- Example:
-
- PASS secretpasswordhere
-
-4.1.2 Nick message
-
- Command: NICK
- Parameters: <nickname> [ <hopcount> ]
-
- NICK message is used to give user a nickname or change the previous
- one. The <hopcount> parameter is only used by servers to indicate
- how far away a nick is from its home server. A local connection has
- a hopcount of 0. If supplied by a client, it must be ignored.
-
- If a NICK message arrives at a server which already knows about an
- identical nickname for another client, a nickname collision occurs.
- As a result of a nickname collision, all instances of the nickname
- are removed from the server's database, and a KILL command is issued
- to remove the nickname from all other server's database. If the NICK
- message causing the collision was a nickname change, then the
- original (old) nick must be removed as well.
-
- If the server recieves an identical NICK from a client which is
- directly connected, it may issue an ERR_NICKCOLLISION to the local
- client, drop the NICK command, and not generate any kills.
-
-
-
-Oikarinen & Reed [Page 14]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- Numeric Replies:
-
- ERR_NONICKNAMEGIVEN ERR_ERRONEUSNICKNAME
- ERR_NICKNAMEINUSE ERR_NICKCOLLISION
-
- Example:
-
- NICK Wiz ; Introducing new nick "Wiz".
-
- :WiZ NICK Kilroy ; WiZ changed his nickname to Kilroy.
-
-4.1.3 User message
-
- Command: USER
- Parameters: <username> <hostname> <servername> <realname>
-
- The USER message is used at the beginning of connection to specify
- the username, hostname, servername and realname of s new user. It is
- also used in communication between servers to indicate new user
- arriving on IRC, since only after both USER and NICK have been
- received from a client does a user become registered.
-
- Between servers USER must to be prefixed with client's NICKname.
- Note that hostname and servername are normally ignored by the IRC
- server when the USER command comes from a directly connected client
- (for security reasons), but they are used in server to server
- communication. This means that a NICK must always be sent to a
- remote server when a new user is being introduced to the rest of the
- network before the accompanying USER is sent.
-
- It must be noted that realname parameter must be the last parameter,
- because it may contain space characters and must be prefixed with a
- colon (':') to make sure this is recognised as such.
-
- Since it is easy for a client to lie about its username by relying
- solely on the USER message, the use of an "Identity Server" is
- recommended. If the host which a user connects from has such a
- server enabled the username is set to that as in the reply from the
- "Identity Server".
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_ALREADYREGISTRED
-
- Examples:
-
-
- USER guest tolmoon tolsun :Ronnie Reagan
-
-
-
-Oikarinen & Reed [Page 15]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- ; User registering themselves with a
- username of "guest" and real name
- "Ronnie Reagan".
-
-
- :testnick USER guest tolmoon tolsun :Ronnie Reagan
- ; message between servers with the
- nickname for which the USER command
- belongs to
-
-4.1.4 Server message
-
- Command: SERVER
- Parameters: <servername> <hopcount> <info>
-
- The server message is used to tell a server that the other end of a
- new connection is a server. This message is also used to pass server
- data over whole net. When a new server is connected to net,
- information about it be broadcast to the whole network. <hopcount>
- is used to give all servers some internal information on how far away
- all servers are. With a full server list, it would be possible to
- construct a map of the entire server tree, but hostmasks prevent this
- from being done.
-
- The SERVER message must only be accepted from either (a) a connection
- which is yet to be registered and is attempting to register as a
- server, or (b) an existing connection to another server, in which
- case the SERVER message is introducing a new server behind that
- server.
-
- Most errors that occur with the receipt of a SERVER command result in
- the connection being terminated by the destination host (target
- SERVER). Error replies are usually sent using the "ERROR" command
- rather than the numeric since the ERROR command has several useful
- properties which make it useful here.
-
- If a SERVER message is parsed and attempts to introduce a server
- which is already known to the receiving server, the connection from
- which that message must be closed (following the correct procedures),
- since a duplicate route to a server has formed and the acyclic nature
- of the IRC tree broken.
-
- Numeric Replies:
-
- ERR_ALREADYREGISTRED
-
- Example:
-
-
-
-
-Oikarinen & Reed [Page 16]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-SERVER test.oulu.fi 1 :[tolsun.oulu.fi] Experimental server
- ; New server test.oulu.fi introducing
- itself and attempting to register. The
- name in []'s is the hostname for the
- host running test.oulu.fi.
-
-
-:tolsun.oulu.fi SERVER csd.bu.edu 5 :BU Central Server
- ; Server tolsun.oulu.fi is our uplink
- for csd.bu.edu which is 5 hops away.
-
-4.1.5 Oper
-
- Command: OPER
- Parameters: <user> <password>
-
- OPER message is used by a normal user to obtain operator privileges.
- The combination of <user> and <password> are required to gain
- Operator privileges.
-
- If the client sending the OPER command supplies the correct password
- for the given user, the server then informs the rest of the network
- of the new operator by issuing a "MODE +o" for the clients nickname.
-
- The OPER message is client-server only.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS RPL_YOUREOPER
- ERR_NOOPERHOST ERR_PASSWDMISMATCH
-
- Example:
-
- OPER foo bar ; Attempt to register as an operator
- using a username of "foo" and "bar" as
- the password.
-
-4.1.6 Quit
-
- Command: QUIT
- Parameters: [<Quit message>]
-
- A client session is ended with a quit message. The server must close
- the connection to a client which sends a QUIT message. If a "Quit
- Message" is given, this will be sent instead of the default message,
- the nickname.
-
- When netsplits (disconnecting of two servers) occur, the quit message
-
-
-
-Oikarinen & Reed [Page 17]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- is composed of the names of two servers involved, separated by a
- space. The first name is that of the server which is still connected
- and the second name is that of the server that has become
- disconnected.
-
- If, for some other reason, a client connection is closed without the
- client issuing a QUIT command (e.g. client dies and EOF occurs
- on socket), the server is required to fill in the quit message with
- some sort of message reflecting the nature of the event which
- caused it to happen.
-
- Numeric Replies:
-
- None.
-
- Examples:
-
- QUIT :Gone to have lunch ; Preferred message format.
-
-4.1.7 Server quit message
-
- Command: SQUIT
- Parameters: <server> <comment>
-
- The SQUIT message is needed to tell about quitting or dead servers.
- If a server wishes to break the connection to another server it must
- send a SQUIT message to the other server, using the the name of the
- other server as the server parameter, which then closes its
- connection to the quitting server.
-
- This command is also available operators to help keep a network of
- IRC servers connected in an orderly fashion. Operators may also
- issue an SQUIT message for a remote server connection. In this case,
- the SQUIT must be parsed by each server inbetween the operator and
- the remote server, updating the view of the network held by each
- server as explained below.
-
- The <comment> should be supplied by all operators who execute a SQUIT
- for a remote server (that is not connected to the server they are
- currently on) so that other operators are aware for the reason of
- this action. The <comment> is also filled in by servers which may
- place an error or similar message here.
-
- Both of the servers which are on either side of the connection being
- closed are required to to send out a SQUIT message (to all its other
- server connections) for all other servers which are considered to be
- behind that link.
-
-
-
-
-Oikarinen & Reed [Page 18]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- Similarly, a QUIT message must be sent to the other connected servers
- rest of the network on behalf of all clients behind that link. In
- addition to this, all channel members of a channel which lost a
- member due to the split must be sent a QUIT message.
-
- If a server connection is terminated prematurely (e.g. the server on
- the other end of the link died), the server which detects
- this disconnection is required to inform the rest of the network
- that the connection has closed and fill in the comment field
- with something appropriate.
-
- Numeric replies:
-
- ERR_NOPRIVILEGES ERR_NOSUCHSERVER
-
- Example:
-
- SQUIT tolsun.oulu.fi :Bad Link ? ; the server link tolson.oulu.fi has
- been terminated because of "Bad Link".
-
- :Trillian SQUIT cm22.eng.umd.edu :Server out of control
- ; message from Trillian to disconnect
- "cm22.eng.umd.edu" from the net
- because "Server out of control".
-
-4.2 Channel operations
-
- This group of messages is concerned with manipulating channels, their
- properties (channel modes), and their contents (typically clients).
- In implementing these, a number of race conditions are inevitable
- when clients at opposing ends of a network send commands which will
- ultimately clash. It is also required that servers keep a nickname
- history to ensure that wherever a <nick> parameter is given, the
- server check its history in case it has recently been changed.
-
-4.2.1 Join message
-
- Command: JOIN
- Parameters: <channel>{,<channel>} [<key>{,<key>}]
-
- The JOIN command is used by client to start listening a specific
- channel. Whether or not a client is allowed to join a channel is
- checked only by the server the client is connected to; all other
- servers automatically add the user to the channel when it is received
- from other servers. The conditions which affect this are as follows:
-
- 1. the user must be invited if the channel is invite-only;
-
-
-
-
-Oikarinen & Reed [Page 19]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 2. the user's nick/username/hostname must not match any
- active bans;
-
- 3. the correct key (password) must be given if it is set.
-
- These are discussed in more detail under the MODE command (see
- section 4.2.3 for more details).
-
- Once a user has joined a channel, they receive notice about all
- commands their server receives which affect the channel. This
- includes MODE, KICK, PART, QUIT and of course PRIVMSG/NOTICE. The
- JOIN command needs to be broadcast to all servers so that each server
- knows where to find the users who are on the channel. This allows
- optimal delivery of PRIVMSG/NOTICE messages to the channel.
-
- If a JOIN is successful, the user is then sent the channel's topic
- (using RPL_TOPIC) and the list of users who are on the channel (using
- RPL_NAMREPLY), which must include the user joining.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_BANNEDFROMCHAN
- ERR_INVITEONLYCHAN ERR_BADCHANNELKEY
- ERR_CHANNELISFULL ERR_BADCHANMASK
- ERR_NOSUCHCHANNEL ERR_TOOMANYCHANNELS
- RPL_TOPIC
-
- Examples:
-
- JOIN #foobar ; join channel #foobar.
-
- JOIN &foo fubar ; join channel &foo using key "fubar".
-
- JOIN #foo,&bar fubar ; join channel #foo using key "fubar"
- and &bar using no key.
-
- JOIN #foo,#bar fubar,foobar ; join channel #foo using key "fubar".
- and channel #bar using key "foobar".
-
- JOIN #foo,#bar ; join channels #foo and #bar.
-
- :WiZ JOIN #Twilight_zone ; JOIN message from WiZ
-
-4.2.2 Part message
-
- Command: PART
- Parameters: <channel>{,<channel>}
-
-
-
-
-Oikarinen & Reed [Page 20]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- The PART message causes the client sending the message to be removed
- from the list of active users for all given channels listed in the
- parameter string.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_NOSUCHCHANNEL
- ERR_NOTONCHANNEL
-
- Examples:
-
- PART #twilight_zone ; leave channel "#twilight_zone"
-
- PART #oz-ops,&group5 ; leave both channels "&group5" and
- "#oz-ops".
-
-4.2.3 Mode message
-
- Command: MODE
-
- The MODE command is a dual-purpose command in IRC. It allows both
- usernames and channels to have their mode changed. The rationale for
- this choice is that one day nicknames will be obsolete and the
- equivalent property will be the channel.
-
- When parsing MODE messages, it is recommended that the entire message
- be parsed first and then the changes which resulted then passed on.
-
-4.2.3.1 Channel modes
-
- Parameters: <channel> {[+|-]|o|p|s|i|t|n|b|v} [<limit>] [<user>]
- [<ban mask>]
-
- The MODE command is provided so that channel operators may change the
- characteristics of `their' channel. It is also required that servers
- be able to change channel modes so that channel operators may be
- created.
-
- The various modes available for channels are as follows:
-
- o - give/take channel operator privileges;
- p - private channel flag;
- s - secret channel flag;
- i - invite-only channel flag;
- t - topic settable by channel operator only flag;
- n - no messages to channel from clients on the outside;
- m - moderated channel;
- l - set the user limit to channel;
-
-
-
-Oikarinen & Reed [Page 21]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- b - set a ban mask to keep users out;
- v - give/take the ability to speak on a moderated channel;
- k - set a channel key (password).
-
- When using the 'o' and 'b' options, a restriction on a total of three
- per mode command has been imposed. That is, any combination of 'o'
- and
-
-4.2.3.2 User modes
-
- Parameters: <nickname> {[+|-]|i|w|s|o}
-
- The user MODEs are typically changes which affect either how the
- client is seen by others or what 'extra' messages the client is sent.
- A user MODE command may only be accepted if both the sender of the
- message and the nickname given as a parameter are both the same.
-
- The available modes are as follows:
-
- i - marks a users as invisible;
- s - marks a user for receipt of server notices;
- w - user receives wallops;
- o - operator flag.
-
- Additional modes may be available later on.
-
- If a user attempts to make themselves an operator using the "+o"
- flag, the attempt should be ignored. There is no restriction,
- however, on anyone `deopping' themselves (using "-o"). Numeric
- Replies:
-
- ERR_NEEDMOREPARAMS RPL_CHANNELMODEIS
- ERR_CHANOPRIVSNEEDED ERR_NOSUCHNICK
- ERR_NOTONCHANNEL ERR_KEYSET
- RPL_BANLIST RPL_ENDOFBANLIST
- ERR_UNKNOWNMODE ERR_NOSUCHCHANNEL
-
- ERR_USERSDONTMATCH RPL_UMODEIS
- ERR_UMODEUNKNOWNFLAG
-
- Examples:
-
- Use of Channel Modes:
-
-MODE #Finnish +im ; Makes #Finnish channel moderated and
- 'invite-only'.
-
-MODE #Finnish +o Kilroy ; Gives 'chanop' privileges to Kilroy on
-
-
-
-Oikarinen & Reed [Page 22]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- channel #Finnish.
-
-MODE #Finnish +v Wiz ; Allow WiZ to speak on #Finnish.
-
-MODE #Fins -s ; Removes 'secret' flag from channel
- #Fins.
-
-MODE #42 +k oulu ; Set the channel key to "oulu".
-
-MODE #eu-opers +l 10 ; Set the limit for the number of users
- on channel to 10.
-
-MODE &oulu +b ; list ban masks set for channel.
-
-MODE &oulu +b *!*@* ; prevent all users from joining.
-
-MODE &oulu +b *!*@*.edu ; prevent any user from a hostname
- matching *.edu from joining.
-
- Use of user Modes:
-
-:MODE WiZ -w ; turns reception of WALLOPS messages
- off for WiZ.
-
-:Angel MODE Angel +i ; Message from Angel to make themselves
- invisible.
-
-MODE WiZ -o ; WiZ 'deopping' (removing operator
- status). The plain reverse of this
- command ("MODE WiZ +o") must not be
- allowed from users since would bypass
- the OPER command.
-
-4.2.4 Topic message
-
- Command: TOPIC
- Parameters: <channel> [<topic>]
-
- The TOPIC message is used to change or view the topic of a channel.
- The topic for channel <channel> is returned if there is no <topic>
- given. If the <topic> parameter is present, the topic for that
- channel will be changed, if the channel modes permit this action.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_NOTONCHANNEL
- RPL_NOTOPIC RPL_TOPIC
- ERR_CHANOPRIVSNEEDED
-
-
-
-Oikarinen & Reed [Page 23]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- Examples:
-
- :Wiz TOPIC #test :New topic ;User Wiz setting the topic.
-
- TOPIC #test :another topic ;set the topic on #test to "another
- topic".
-
- TOPIC #test ; check the topic for #test.
-
-4.2.5 Names message
-
- Command: NAMES
- Parameters: [<channel>{,<channel>}]
-
- By using the NAMES command, a user can list all nicknames that are
- visible to them on any channel that they can see. Channel names
- which they can see are those which aren't private (+p) or secret (+s)
- or those which they are actually on. The <channel> parameter
- specifies which channel(s) to return information about if valid.
- There is no error reply for bad channel names.
-
- If no <channel> parameter is given, a list of all channels and their
- occupants is returned. At the end of this list, a list of users who
- are visible but either not on any channel or not on a visible channel
- are listed as being on `channel' "*".
-
- Numerics:
-
- RPL_NAMREPLY RPL_ENDOFNAMES
-
- Examples:
-
- NAMES #twilight_zone,#42 ; list visible users on #twilight_zone
- and #42 if the channels are visible to
- you.
-
- NAMES ; list all visible channels and users
-
-4.2.6 List message
-
- Command: LIST
- Parameters: [<channel>{,<channel>} [<server>]]
-
- The list message is used to list channels and their topics. If the
- <channel> parameter is used, only the status of that channel
- is displayed. Private channels are listed (without their
- topics) as channel "Prv" unless the client generating the query is
- actually on that channel. Likewise, secret channels are not listed
-
-
-
-Oikarinen & Reed [Page 24]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- at all unless the client is a member of the channel in question.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER RPL_LISTSTART
- RPL_LIST RPL_LISTEND
-
- Examples:
-
- LIST ; List all channels.
-
- LIST #twilight_zone,#42 ; List channels #twilight_zone and #42
-
-4.2.7 Invite message
-
- Command: INVITE
- Parameters: <nickname> <channel>
-
- The INVITE message is used to invite users to a channel. The
- parameter <nickname> is the nickname of the person to be invited to
- the target channel <channel>. There is no requirement that the
- channel the target user is being invited to must exist or be a valid
- channel. To invite a user to a channel which is invite only (MODE
- +i), the client sending the invite must be recognised as being a
- channel operator on the given channel.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_NOSUCHNICK
- ERR_NOTONCHANNEL ERR_USERONCHANNEL
- ERR_CHANOPRIVSNEEDED
- RPL_INVITING RPL_AWAY
-
- Examples:
-
- :Angel INVITE Wiz #Dust ; User Angel inviting WiZ to channel
- #Dust
-
- INVITE Wiz #Twilight_Zone ; Command to invite WiZ to
- #Twilight_zone
-
-4.2.8 Kick command
-
- Command: KICK
- Parameters: <channel> <user> [<comment>]
-
- The KICK command can be used to forcibly remove a user from a
- channel. It 'kicks them out' of the channel (forced PART).
-
-
-
-Oikarinen & Reed [Page 25]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- Only a channel operator may kick another user out of a channel.
- Each server that receives a KICK message checks that it is valid
- (ie the sender is actually a channel operator) before removing
- the victim from the channel.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS ERR_NOSUCHCHANNEL
- ERR_BADCHANMASK ERR_CHANOPRIVSNEEDED
- ERR_NOTONCHANNEL
-
- Examples:
-
-KICK &Melbourne Matthew ; Kick Matthew from &Melbourne
-
-KICK #Finnish John :Speaking English
- ; Kick John from #Finnish using
- "Speaking English" as the reason
- (comment).
-
-:WiZ KICK #Finnish John ; KICK message from WiZ to remove John
- from channel #Finnish
-
-NOTE:
- It is possible to extend the KICK command parameters to the
-following:
-
-<channel>{,<channel>} <user>{,<user>} [<comment>]
-
-4.3 Server queries and commands
-
- The server query group of commands has been designed to return
- information about any server which is connected to the network. All
- servers connected must respond to these queries and respond
- correctly. Any invalid response (or lack thereof) must be considered
- a sign of a broken server and it must be disconnected/disabled as
- soon as possible until the situation is remedied.
-
- In these queries, where a parameter appears as "<server>", it will
- usually mean it can be a nickname or a server or a wildcard name of
- some sort. For each parameter, however, only one query and set of
- replies is to be generated.
-
-4.3.1 Version message
-
- Command: VERSION
- Parameters: [<server>]
-
-
-
-
-Oikarinen & Reed [Page 26]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- The VERSION message is used to query the version of the server
- program. An optional parameter <server> is used to query the version
- of the server program which a client is not directly connected to.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER RPL_VERSION
-
- Examples:
-
- :Wiz VERSION *.se ; message from Wiz to check the version
- of a server matching "*.se"
-
- VERSION tolsun.oulu.fi ; check the version of server
- "tolsun.oulu.fi".
-
-4.3.2 Stats message
-
- Command: STATS
- Parameters: [<query> [<server>]]
-
- The stats message is used to query statistics of certain server. If
- <server> parameter is omitted, only the end of stats reply is sent
- back. The implementation of this command is highly dependent on the
- server which replies, although the server must be able to supply
- information as described by the queries below (or similar).
-
- A query may be given by any single letter which is only checked by
- the destination server (if given as the <server> parameter) and is
- otherwise passed on by intermediate servers, ignored and unaltered.
- The following queries are those found in the current IRC
- implementation and provide a large portion of the setup information
- for that server. Although these may not be supported in the same way
- by other versions, all servers should be able to supply a valid reply
- to a STATS query which is consistent with the reply formats currently
- used and the purpose of the query.
-
- The currently supported queries are:
-
- c - returns a list of servers which the server may connect
- to or allow connections from;
- h - returns a list of servers which are either forced to be
- treated as leaves or allowed to act as hubs;
- i - returns a list of hosts which the server allows a client
- to connect from;
- k - returns a list of banned username/hostname combinations
- for that server;
- l - returns a list of the server's connections, showing how
-
-
-
-Oikarinen & Reed [Page 27]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- long each connection has been established and the traffic
- over that connection in bytes and messages for each
- direction;
- m - returns a list of commands supported by the server and
- the usage count for each if the usage count is non zero;
- o - returns a list of hosts from which normal clients may
- become operators;
- y - show Y (Class) lines from server's configuration file;
- u - returns a string showing how long the server has been up.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
- RPL_STATSCLINE RPL_STATSNLINE
- RPL_STATSILINE RPL_STATSKLINE
- RPL_STATSQLINE RPL_STATSLLINE
- RPL_STATSLINKINFO RPL_STATSUPTIME
- RPL_STATSCOMMANDS RPL_STATSOLINE
- RPL_STATSHLINE RPL_ENDOFSTATS
-
- Examples:
-
-STATS m ; check the command usage for the server
- you are connected to
-
-:Wiz STATS c eff.org ; request by WiZ for C/N line
- information from server eff.org
-
-4.3.3 Links message
-
- Command: LINKS
- Parameters: [[<remote server>] <server mask>]
-
- With LINKS, a user can list all servers which are known by the server
- answering the query. The returned list of servers must match the
- mask, or if no mask is given, the full list is returned.
-
- If <remote server> is given in addition to <server mask>, the LINKS
- command is forwarded to the first server found that matches that name
- (if any), and that server is then required to answer the query.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
- RPL_LINKS RPL_ENDOFLINKS
-
- Examples:
-
-
-
-
-Oikarinen & Reed [Page 28]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-LINKS *.au ; list all servers which have a name
- that matches *.au;
-
-:WiZ LINKS *.bu.edu *.edu ; LINKS message from WiZ to the first
- server matching *.edu for a list of
- servers matching *.bu.edu.
-
-4.3.4 Time message
-
- Command: TIME
- Parameters: [<server>]
-
- The time message is used to query local time from the specified
- server. If the server parameter is not given, the server handling the
- command must reply to the query.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER RPL_TIME
-
- Examples:
-
- TIME tolsun.oulu.fi ; check the time on the server
- "tolson.oulu.fi"
-
- Angel TIME *.au ; user angel checking the time on a
- server matching "*.au"
-
-4.3.5 Connect message
-
- Command: CONNECT
- Parameters: <target server> [<port> [<remote server>]]
-
- The CONNECT command can be used to force a server to try to establish
- a new connection to another server immediately. CONNECT is a
- privileged command and is to be available only to IRC Operators. If
- a remote server is given then the CONNECT attempt is made by that
- server to <target server> and <port>.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER ERR_NOPRIVILEGES
- ERR_NEEDMOREPARAMS
-
- Examples:
-
-CONNECT tolsun.oulu.fi ; Attempt to connect a server to
- tolsun.oulu.fi
-
-
-
-Oikarinen & Reed [Page 29]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-:WiZ CONNECT eff.org 6667 csd.bu.edu
- ; CONNECT attempt by WiZ to get servers
- eff.org and csd.bu.edu connected on port
- 6667.
-
-4.3.6 Trace message
-
- Command: TRACE
- Parameters: [<server>]
-
- TRACE command is used to find the route to specific server. Each
- server that processes this message must tell the sender about it by
- sending a reply indicating it is a pass-through link, forming a chain
- of replies similar to that gained from using "traceroute". After
- sending this reply back, it must then send the TRACE message to the
- next server until given server is reached. If the <server> parameter
- is omitted, it is recommended that TRACE command send a message to
- the sender telling which servers the current server has direct
- connection to.
-
- If the destination given by "<server>" is an actual server, then the
- destination server is required to report all servers and users which
- are connected to it, although only operators are permitted to see
- users present. If the destination given by <server> is a nickname,
- they only a reply for that nickname is given.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
-
- If the TRACE message is destined for another server, all intermediate
- servers must return a RPL_TRACELINK reply to indicate that the TRACE
- passed through it and where its going next.
-
- RPL_TRACELINK
- A TRACE reply may be composed of any number of the following numeric
- replies.
-
- RPL_TRACECONNECTING RPL_TRACEHANDSHAKE
- RPL_TRACEUNKNOWN RPL_TRACEOPERATOR
- RPL_TRACEUSER RPL_TRACESERVER
- RPL_TRACESERVICE RPL_TRACENEWTYPE
- RPL_TRACECLASS
-
- Examples:
-
-TRACE *.oulu.fi ; TRACE to a server matching *.oulu.fi
-
-
-
-
-Oikarinen & Reed [Page 30]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-:WiZ TRACE AngelDust ; TRACE issued by WiZ to nick AngelDust
-
-4.3.7 Admin command
-
- Command: ADMIN
- Parameters: [<server>]
-
- The admin message is used to find the name of the administrator of
- the given server, or current server if <server> parameter is omitted.
- Each server must have the ability to forward ADMIN messages to other
- servers.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
- RPL_ADMINME RPL_ADMINLOC1
- RPL_ADMINLOC2 RPL_ADMINEMAIL
-
- Examples:
-
- ADMIN tolsun.oulu.fi ; request an ADMIN reply from
- tolsun.oulu.fi
-
- :WiZ ADMIN *.edu ; ADMIN request from WiZ for first
- server found to match *.edu.
-
-4.3.8 Info command
-
- Command: INFO
- Parameters: [<server>]
-
- The INFO command is required to return information which describes
- the server: its version, when it was compiled, the patchlevel, when
- it was started, and any other miscellaneous information which may be
- considered to be relevant.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
- RPL_INFO RPL_ENDOFINFO
-
- Examples:
-
- INFO csd.bu.edu ; request an INFO reply from
- csd.bu.edu
-
- :Avalon INFO *.fi ; INFO request from Avalon for first
- server found to match *.fi.
-
-
-
-Oikarinen & Reed [Page 31]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- INFO Angel ; request info from the server that
- Angel is connected to.
-
-4.4 Sending messages
-
- The main purpose of the IRC protocol is to provide a base for clients
- to communicate with each other. PRIVMSG and NOTICE are the only
- messages available which actually perform delivery of a text message
- from one client to another - the rest just make it possible and try
- to ensure it happens in a reliable and structured manner.
-
-4.4.1 Private messages
-
- Command: PRIVMSG
- Parameters: <receiver>{,<receiver>} <text to be sent>
-
- PRIVMSG is used to send private messages between users. <receiver>
- is the nickname of the receiver of the message. <receiver> can also
- be a list of names or channels separated with commas.
-
- The <receiver> parameter may also me a host mask (#mask) or server
- mask ($mask). In both cases the server will only send the PRIVMSG
- to those who have a server or host matching the mask. The mask must
- have at least 1 (one) "." in it and no wildcards following the
- last ".". This requirement exists to prevent people sending messages
- to "#*" or "$*", which would broadcast to all users; from
- experience, this is abused more than used responsibly and properly.
- Wildcards are the '*' and '?' characters. This extension to
- the PRIVMSG command is only available to Operators.
-
- Numeric Replies:
-
- ERR_NORECIPIENT ERR_NOTEXTTOSEND
- ERR_CANNOTSENDTOCHAN ERR_NOTOPLEVEL
- ERR_WILDTOPLEVEL ERR_TOOMANYTARGETS
- ERR_NOSUCHNICK
- RPL_AWAY
-
- Examples:
-
-:Angel PRIVMSG Wiz :Hello are you receiving this message ?
- ; Message from Angel to Wiz.
-
-PRIVMSG Angel :yes I'm receiving it !receiving it !'u>(768u+1n) .br ;
- Message to Angel.
-
-PRIVMSG jto@tolsun.oulu.fi :Hello !
- ; Message to a client on server
-
-
-
-Oikarinen & Reed [Page 32]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- tolsun.oulu.fi with username of "jto".
-
-PRIVMSG $*.fi :Server tolsun.oulu.fi rebooting.
- ; Message to everyone on a server which
- has a name matching *.fi.
-
-PRIVMSG #*.edu :NSFNet is undergoing work, expect interruptions
- ; Message to all users who come from a
- host which has a name matching *.edu.
-
-4.4.2 Notice
-
- Command: NOTICE
- Parameters: <nickname> <text>
-
- The NOTICE message is used similarly to PRIVMSG. The difference
- between NOTICE and PRIVMSG is that automatic replies must never be
- sent in response to a NOTICE message. This rule applies to servers
- too - they must not send any error reply back to the client on
- receipt of a notice. The object of this rule is to avoid loops
- between a client automatically sending something in response to
- something it received. This is typically used by automatons (clients
- with either an AI or other interactive program controlling their
- actions) which are always seen to be replying lest they end up in a
- loop with another automaton.
-
- See PRIVMSG for more details on replies and examples.
-
-4.5 User based queries
-
- User queries are a group of commands which are primarily concerned
- with finding details on a particular user or group users. When using
- wildcards with any of these commands, if they match, they will only
- return information on users who are 'visible' to you. The visibility
- of a user is determined as a combination of the user's mode and the
- common set of channels you are both on.
-
-4.5.1 Who query
-
- Command: WHO
- Parameters: [<name> [<o>]]
-
- The WHO message is used by a client to generate a query which returns
- a list of information which 'matches' the <name> parameter given by
- the client. In the absence of the <name> parameter, all visible
- (users who aren't invisible (user mode +i) and who don't have a
- common channel with the requesting client) are listed. The same
- result can be achieved by using a <name> of "0" or any wildcard which
-
-
-
-Oikarinen & Reed [Page 33]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- will end up matching every entry possible.
-
- The <name> passed to WHO is matched against users' host, server, real
- name and nickname if the channel <name> cannot be found.
-
- If the "o" parameter is passed only operators are returned according
- to the name mask supplied.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER
- RPL_WHOREPLY RPL_ENDOFWHO
-
- Examples:
-
- WHO *.fi ; List all users who match against
- "*.fi".
-
- WHO jto* o ; List all users with a match against
- "jto*" if they are an operator.
-
-4.5.2 Whois query
-
- Command: WHOIS
- Parameters: [<server>] <nickmask>[,<nickmask>[,...]]
-
- This message is used to query information about particular user. The
- server will answer this message with several numeric messages
- indicating different statuses of each user which matches the nickmask
- (if you are entitled to see them). If no wildcard is present in the
- <nickmask>, any information about that nick which you are allowed to
- see is presented. A comma (',') separated list of nicknames may be
- given.
-
- The latter version sends the query to a specific server. It is
- useful if you want to know how long the user in question has been
- idle as only local server (ie. the server the user is directly
- connected to) knows that information, while everything else is
- globally known.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER ERR_NONICKNAMEGIVEN
- RPL_WHOISUSER RPL_WHOISCHANNELS
- RPL_WHOISCHANNELS RPL_WHOISSERVER
- RPL_AWAY RPL_WHOISOPERATOR
- RPL_WHOISIDLE ERR_NOSUCHNICK
- RPL_ENDOFWHOIS
-
-
-
-Oikarinen & Reed [Page 34]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- Examples:
-
- WHOIS wiz ; return available user information
- about nick WiZ
-
- WHOIS eff.org trillian ; ask server eff.org for user
- information about trillian
-
-4.5.3 Whowas
-
- Command: WHOWAS
- Parameters: <nickname> [<count> [<server>]]
-
- Whowas asks for information about a nickname which no longer exists.
- This may either be due to a nickname change or the user leaving IRC.
- In response to this query, the server searches through its nickname
- history, looking for any nicks which are lexically the same (no wild
- card matching here). The history is searched backward, returning the
- most recent entry first. If there are multiple entries, up to
- <count> replies will be returned (or all of them if no <count>
- parameter is given). If a non-positive number is passed as being
- <count>, then a full search is done.
-
- Numeric Replies:
-
- ERR_NONICKNAMEGIVEN ERR_WASNOSUCHNICK
- RPL_WHOWASUSER RPL_WHOISSERVER
- RPL_ENDOFWHOWAS
-
- Examples:
-
- WHOWAS Wiz ; return all information in the nick
- history about nick "WiZ";
-
- WHOWAS Mermaid 9 ; return at most, the 9 most recent
- entries in the nick history for
- "Mermaid";
-
- WHOWAS Trillian 1 *.edu ; return the most recent history for
- "Trillian" from the first server found
- to match "*.edu".
-
-4.6 Miscellaneous messages
-
- Messages in this category do not fit into any of the above categories
- but are nonetheless still a part of and required by the protocol.
-
-
-
-
-
-Oikarinen & Reed [Page 35]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-4.6.1 Kill message
-
- Command: KILL
- Parameters: <nickname> <comment>
-
- The KILL message is used to cause a client-server connection to be
- closed by the server which has the actual connection. KILL is used
- by servers when they encounter a duplicate entry in the list of valid
- nicknames and is used to remove both entries. It is also available
- to operators.
-
- Clients which have automatic reconnect algorithms effectively make
- this command useless since the disconnection is only brief. It does
- however break the flow of data and can be used to stop large amounts
- of being abused, any user may elect to receive KILL messages
- generated for others to keep an 'eye' on would be trouble spots.
-
- In an arena where nicknames are required to be globally unique at all
- times, KILL messages are sent whenever 'duplicates' are detected
- (that is an attempt to register two users with the same nickname) in
- the hope that both of them will disappear and only 1 reappear.
-
- The comment given must reflect the actual reason for the KILL. For
- server-generated KILLs it usually is made up of details concerning
- the origins of the two conflicting nicknames. For users it is left
- up to them to provide an adequate reason to satisfy others who see
- it. To prevent/discourage fake KILLs from being generated to hide
- the identify of the KILLer, the comment also shows a 'kill-path'
- which is updated by each server it passes through, each prepending
- its name to the path.
-
- Numeric Replies:
-
- ERR_NOPRIVILEGES ERR_NEEDMOREPARAMS
- ERR_NOSUCHNICK ERR_CANTKILLSERVER
-
-
- KILL David (csd.bu.edu <- tolsun.oulu.fi)
- ; Nickname collision between csd.bu.edu
- and tolson.oulu.fi
-
-
- NOTE:
- It is recommended that only Operators be allowed to kill other users
- with KILL message. In an ideal world not even operators would need
- to do this and it would be left to servers to deal with.
-
-
-
-
-
-Oikarinen & Reed [Page 36]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-4.6.2 Ping message
-
- Command: PING
- Parameters: <server1> [<server2>]
-
- The PING message is used to test the presence of an active client at
- the other end of the connection. A PING message is sent at regular
- intervals if no other activity detected coming from a connection. If
- a connection fails to respond to a PING command within a set amount
- of time, that connection is closed.
-
- Any client which receives a PING message must respond to <server1>
- (server which sent the PING message out) as quickly as possible with
- an appropriate PONG message to indicate it is still there and alive.
- Servers should not respond to PING commands but rely on PINGs from
- the other end of the connection to indicate the connection is alive.
- If the <server2> parameter is specified, the PING message gets
- forwarded there.
-
- Numeric Replies:
-
- ERR_NOORIGIN ERR_NOSUCHSERVER
-
- Examples:
-
- PING tolsun.oulu.fi ; server sending a PING message to
- another server to indicate it is still
- alive.
-
- PING WiZ ; PING message being sent to nick WiZ
-
-4.6.3 Pong message
-
- Command: PONG
- Parameters: <daemon> [<daemon2>]
-
- PONG message is a reply to ping message. If parameter <daemon2> is
- given this message must be forwarded to given daemon. The <daemon>
- parameter is the name of the daemon who has responded to PING message
- and generated this message.
-
- Numeric Replies:
-
- ERR_NOORIGIN ERR_NOSUCHSERVER
-
- Examples:
-
- PONG csd.bu.edu tolsun.oulu.fi ; PONG message from csd.bu.edu to
-
-
-
-Oikarinen & Reed [Page 37]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- tolsun.oulu.fi
-
-4.6.4 Error
-
- Command: ERROR
- Parameters: <error message>
-
- The ERROR command is for use by servers when reporting a serious or
- fatal error to its operators. It may also be sent from one server to
- another but must not be accepted from any normal unknown clients.
-
- An ERROR message is for use for reporting errors which occur with a
- server-to-server link only. An ERROR message is sent to the server
- at the other end (which sends it to all of its connected operators)
- and to all operators currently connected. It is not to be passed
- onto any other servers by a server if it is received from a server.
-
- When a server sends a received ERROR message to its operators, the
- message should be encapsulated inside a NOTICE message, indicating
- that the client was not responsible for the error.
-
- Numerics:
-
- None.
-
- Examples:
-
- ERROR :Server *.fi already exists; ERROR message to the other server
- which caused this error.
-
- NOTICE WiZ :ERROR from csd.bu.edu -- Server *.fi already exists
- ; Same ERROR message as above but sent
- to user WiZ on the other server.
-
-5. OPTIONALS
-
- This section describes OPTIONAL messages. They are not required in a
- working server implementation of the protocol described herein. In
- the absence of the option, an error reply message must be generated
- or an unknown command error. If the message is destined for another
- server to answer then it must be passed on (elementary parsing
- required) The allocated numerics for this are listed with the
- messages below.
-
-5.1 Away
-
- Command: AWAY
- Parameters: [message]
-
-
-
-Oikarinen & Reed [Page 38]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- With the AWAY message, clients can set an automatic reply string for
- any PRIVMSG commands directed at them (not to a channel they are on).
- The automatic reply is sent by the server to client sending the
- PRIVMSG command. The only replying server is the one to which the
- sending client is connected to.
-
- The AWAY message is used either with one parameter (to set an AWAY
- message) or with no parameters (to remove the AWAY message).
-
- Numeric Replies:
-
- RPL_UNAWAY RPL_NOWAWAY
-
- Examples:
-
- AWAY :Gone to lunch. Back in 5 ; set away message to "Gone to lunch.
- Back in 5".
-
- :WiZ AWAY ; unmark WiZ as being away.
-
-
-5.2 Rehash message
-
- Command: REHASH
- Parameters: None
-
- The rehash message can be used by the operator to force the server to
- re-read and process its configuration file.
-
- Numeric Replies:
-
- RPL_REHASHING ERR_NOPRIVILEGES
-
-Examples:
-
-REHASH ; message from client with operator
- status to server asking it to reread its
- configuration file.
-
-5.3 Restart message
-
- Command: RESTART
- Parameters: None
-
- The restart message can only be used by an operator to force a server
- restart itself. This message is optional since it may be viewed as a
- risk to allow arbitrary people to connect to a server as an operator
- and execute this command, causing (at least) a disruption to service.
-
-
-
-Oikarinen & Reed [Page 39]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- The RESTART command must always be fully processed by the server to
- which the sending client is connected and not be passed onto other
- connected servers.
-
- Numeric Replies:
-
- ERR_NOPRIVILEGES
-
- Examples:
-
- RESTART ; no parameters required.
-
-5.4 Summon message
-
- Command: SUMMON
- Parameters: <user> [<server>]
-
- The SUMMON command can be used to give users who are on a host
- running an IRC server a message asking them to please join IRC. This
- message is only sent if the target server (a) has SUMMON enabled, (b)
- the user is logged in and (c) the server process can write to the
- user's tty (or similar).
-
- If no <server> parameter is given it tries to summon <user> from the
- server the client is connected to is assumed as the target.
-
- If summon is not enabled in a server, it must return the
- ERR_SUMMONDISABLED numeric and pass the summon message onwards.
-
- Numeric Replies:
-
- ERR_NORECIPIENT ERR_FILEERROR
- ERR_NOLOGIN ERR_NOSUCHSERVER
- RPL_SUMMONING
-
- Examples:
-
- SUMMON jto ; summon user jto on the server's host
-
- SUMMON jto tolsun.oulu.fi ; summon user jto on the host which a
- server named "tolsun.oulu.fi" is
- running.
-
-
-5.5 Users
-
- Command: USERS
- Parameters: [<server>]
-
-
-
-Oikarinen & Reed [Page 40]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- The USERS command returns a list of users logged into the server in a
- similar format to who(1), rusers(1) and finger(1). Some people
- may disable this command on their server for security related
- reasons. If disabled, the correct numeric must be returned to
- indicate this.
-
- Numeric Replies:
-
- ERR_NOSUCHSERVER ERR_FILEERROR
- RPL_USERSSTART RPL_USERS
- RPL_NOUSERS RPL_ENDOFUSERS
- ERR_USERSDISABLED
-
- Disabled Reply:
-
- ERR_USERSDISABLED
-
- Examples:
-
-USERS eff.org ; request a list of users logged in on
- server eff.org
-
-:John USERS tolsun.oulu.fi ; request from John for a list of users
- logged in on server tolsun.oulu.fi
-
-5.6 Operwall message
-
- Command: WALLOPS
- Parameters: Text to be sent to all operators currently online
-
- Sends a message to all operators currently online. After
- implementing WALLOPS as a user command it was found that it was
- often and commonly abused as a means of sending a message to a lot
- of people (much similar to WALL). Due to this it is recommended
- that the current implementation of WALLOPS be used as an
- example by allowing and recognising only servers as the senders of
- WALLOPS.
-
- Numeric Replies:
-
- ERR_NEEDMOREPARAMS
-
- Examples:
-
- :csd.bu.edu WALLOPS :Connect '*.uiuc.edu 6667' from Joshua; WALLOPS
- message from csd.bu.edu announcing a
- CONNECT message it received and acted
- upon from Joshua.
-
-
-
-Oikarinen & Reed [Page 41]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-5.7 Userhost message
-
- Command: USERHOST
- Parameters: <nickname>{<space><nickname>}
-
- The USERHOST command takes a list of up to 5 nicknames, each
- separated by a space character and returns a list of information
- about each nickname that it found. The returned list has each reply
- separated by a space.
-
- Numeric Replies:
-
- RPL_USERHOST ERR_NEEDMOREPARAMS
-
- Examples:
-
- USERHOST Wiz Michael Marty p ;USERHOST request for information on
- nicks "Wiz", "Michael", "Marty" and "p"
-
-5.8 Ison message
-
- Command: ISON
- Parameters: <nickname>{<space><nickname>}
-
- The ISON command was implemented to provide a quick and efficient
- means to get a response about whether a given nickname was currently
- on IRC. ISON only takes one (1) parameter: a space-separated list of
- nicks. For each nickname in the list that is present, the server
- adds that to its reply string. Thus the reply string may return
- empty (none of the given nicks are present), an exact copy of the
- parameter string (all of them present) or as any other subset of the
- set of nicks given in the parameter. The only limit on the number
- of nicks that may be checked is that the combined length must not be
- too large as to cause the server to chop it off so it fits in 512
- characters.
-
- ISON is only be processed by the server local to the client sending
- the command and thus not passed onto other servers for further
- processing.
-
- Numeric Replies:
-
- RPL_ISON ERR_NEEDMOREPARAMS
-
- Examples:
-
- ISON phone trillian WiZ jarlek Avalon Angel Monstah
- ; Sample ISON request for 7 nicks.
-
-
-
-Oikarinen & Reed [Page 42]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-6. REPLIES
-
- The following is a list of numeric replies which are generated in
- response to the commands given above. Each numeric is given with its
- number, name and reply string.
-
-6.1 Error Replies.
-
- 401 ERR_NOSUCHNICK
- "<nickname> :No such nick/channel"
-
- - Used to indicate the nickname parameter supplied to a
- command is currently unused.
-
- 402 ERR_NOSUCHSERVER
- "<server name> :No such server"
-
- - Used to indicate the server name given currently
- doesn't exist.
-
- 403 ERR_NOSUCHCHANNEL
- "<channel name> :No such channel"
-
- - Used to indicate the given channel name is invalid.
-
- 404 ERR_CANNOTSENDTOCHAN
- "<channel name> :Cannot send to channel"
-
- - Sent to a user who is either (a) not on a channel
- which is mode +n or (b) not a chanop (or mode +v) on
- a channel which has mode +m set and is trying to send
- a PRIVMSG message to that channel.
-
- 405 ERR_TOOMANYCHANNELS
- "<channel name> :You have joined too many \
- channels"
- - Sent to a user when they have joined the maximum
- number of allowed channels and they try to join
- another channel.
-
- 406 ERR_WASNOSUCHNICK
- "<nickname> :There was no such nickname"
-
- - Returned by WHOWAS to indicate there is no history
- information for that nickname.
-
- 407 ERR_TOOMANYTARGETS
- "<target> :Duplicate recipients. No message \
-
-
-
-Oikarinen & Reed [Page 43]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- delivered"
-
- - Returned to a client which is attempting to send a
- PRIVMSG/NOTICE using the user@host destination format
- and for a user@host which has several occurrences.
-
- 409 ERR_NOORIGIN
- ":No origin specified"
-
- - PING or PONG message missing the originator parameter
- which is required since these commands must work
- without valid prefixes.
-
- 411 ERR_NORECIPIENT
- ":No recipient given (<command>)"
- 412 ERR_NOTEXTTOSEND
- ":No text to send"
- 413 ERR_NOTOPLEVEL
- "<mask> :No toplevel domain specified"
- 414 ERR_WILDTOPLEVEL
- "<mask> :Wildcard in toplevel domain"
-
- - 412 - 414 are returned by PRIVMSG to indicate that
- the message wasn't delivered for some reason.
- ERR_NOTOPLEVEL and ERR_WILDTOPLEVEL are errors that
- are returned when an invalid use of
- "PRIVMSG $<server>" or "PRIVMSG #<host>" is attempted.
-
- 421 ERR_UNKNOWNCOMMAND
- "<command> :Unknown command"
-
- - Returned to a registered client to indicate that the
- command sent is unknown by the server.
-
- 422 ERR_NOMOTD
- ":MOTD File is missing"
-
- - Server's MOTD file could not be opened by the server.
-
- 423 ERR_NOADMININFO
- "<server> :No administrative info available"
-
- - Returned by a server in response to an ADMIN message
- when there is an error in finding the appropriate
- information.
-
- 424 ERR_FILEERROR
- ":File error doing <file op> on <file>"
-
-
-
-Oikarinen & Reed [Page 44]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- - Generic error message used to report a failed file
- operation during the processing of a message.
-
- 431 ERR_NONICKNAMEGIVEN
- ":No nickname given"
-
- - Returned when a nickname parameter expected for a
- command and isn't found.
-
- 432 ERR_ERRONEUSNICKNAME
- "<nick> :Erroneus nickname"
-
- - Returned after receiving a NICK message which contains
- characters which do not fall in the defined set. See
- section x.x.x for details on valid nicknames.
-
- 433 ERR_NICKNAMEINUSE
- "<nick> :Nickname is already in use"
-
- - Returned when a NICK message is processed that results
- in an attempt to change to a currently existing
- nickname.
-
- 436 ERR_NICKCOLLISION
- "<nick> :Nickname collision KILL"
-
- - Returned by a server to a client when it detects a
- nickname collision (registered of a NICK that
- already exists by another server).
-
- 441 ERR_USERNOTINCHANNEL
- "<nick> <channel> :They aren't on that channel"
-
- - Returned by the server to indicate that the target
- user of the command is not on the given channel.
-
- 442 ERR_NOTONCHANNEL
- "<channel> :You're not on that channel"
-
- - Returned by the server whenever a client tries to
- perform a channel effecting command for which the
- client isn't a member.
-
- 443 ERR_USERONCHANNEL
- "<user> <channel> :is already on channel"
-
- - Returned when a client tries to invite a user to a
- channel they are already on.
-
-
-
-Oikarinen & Reed [Page 45]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 444 ERR_NOLOGIN
- "<user> :User not logged in"
-
- - Returned by the summon after a SUMMON command for a
- user was unable to be performed since they were not
- logged in.
-
- 445 ERR_SUMMONDISABLED
- ":SUMMON has been disabled"
-
- - Returned as a response to the SUMMON command. Must be
- returned by any server which does not implement it.
-
- 446 ERR_USERSDISABLED
- ":USERS has been disabled"
-
- - Returned as a response to the USERS command. Must be
- returned by any server which does not implement it.
-
- 451 ERR_NOTREGISTERED
- ":You have not registered"
-
- - Returned by the server to indicate that the client
- must be registered before the server will allow it
- to be parsed in detail.
-
- 461 ERR_NEEDMOREPARAMS
- "<command> :Not enough parameters"
-
- - Returned by the server by numerous commands to
- indicate to the client that it didn't supply enough
- parameters.
-
- 462 ERR_ALREADYREGISTRED
- ":You may not reregister"
-
- - Returned by the server to any link which tries to
- change part of the registered details (such as
- password or user details from second USER message).
-
-
- 463 ERR_NOPERMFORHOST
- ":Your host isn't among the privileged"
-
- - Returned to a client which attempts to register with
- a server which does not been setup to allow
- connections from the host the attempted connection
- is tried.
-
-
-
-Oikarinen & Reed [Page 46]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 464 ERR_PASSWDMISMATCH
- ":Password incorrect"
-
- - Returned to indicate a failed attempt at registering
- a connection for which a password was required and
- was either not given or incorrect.
-
- 465 ERR_YOUREBANNEDCREEP
- ":You are banned from this server"
-
- - Returned after an attempt to connect and register
- yourself with a server which has been setup to
- explicitly deny connections to you.
-
- 467 ERR_KEYSET
- "<channel> :Channel key already set"
- 471 ERR_CHANNELISFULL
- "<channel> :Cannot join channel (+l)"
- 472 ERR_UNKNOWNMODE
- "<char> :is unknown mode char to me"
- 473 ERR_INVITEONLYCHAN
- "<channel> :Cannot join channel (+i)"
- 474 ERR_BANNEDFROMCHAN
- "<channel> :Cannot join channel (+b)"
- 475 ERR_BADCHANNELKEY
- "<channel> :Cannot join channel (+k)"
- 481 ERR_NOPRIVILEGES
- ":Permission Denied- You're not an IRC operator"
-
- - Any command requiring operator privileges to operate
- must return this error to indicate the attempt was
- unsuccessful.
-
- 482 ERR_CHANOPRIVSNEEDED
- "<channel> :You're not channel operator"
-
- - Any command requiring 'chanop' privileges (such as
- MODE messages) must return this error if the client
- making the attempt is not a chanop on the specified
- channel.
-
- 483 ERR_CANTKILLSERVER
- ":You cant kill a server!"
-
- - Any attempts to use the KILL command on a server
- are to be refused and this error returned directly
- to the client.
-
-
-
-
-Oikarinen & Reed [Page 47]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 491 ERR_NOOPERHOST
- ":No O-lines for your host"
-
- - If a client sends an OPER message and the server has
- not been configured to allow connections from the
- client's host as an operator, this error must be
- returned.
-
- 501 ERR_UMODEUNKNOWNFLAG
- ":Unknown MODE flag"
-
- - Returned by the server to indicate that a MODE
- message was sent with a nickname parameter and that
- the a mode flag sent was not recognized.
-
- 502 ERR_USERSDONTMATCH
- ":Cant change mode for other users"
-
- - Error sent to any user trying to view or change the
- user mode for a user other than themselves.
-
-6.2 Command responses.
-
- 300 RPL_NONE
- Dummy reply number. Not used.
-
- 302 RPL_USERHOST
- ":[<reply>{<space><reply>}]"
-
- - Reply format used by USERHOST to list replies to
- the query list. The reply string is composed as
- follows:
-
- <reply> ::= <nick>['*'] '=' <'+'|'-'><hostname>
-
- The '*' indicates whether the client has registered
- as an Operator. The '-' or '+' characters represent
- whether the client has set an AWAY message or not
- respectively.
-
- 303 RPL_ISON
- ":[<nick> {<space><nick>}]"
-
- - Reply format used by ISON to list replies to the
- query list.
-
- 301 RPL_AWAY
- "<nick> :<away message>"
-
-
-
-Oikarinen & Reed [Page 48]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- 305 RPL_UNAWAY
- ":You are no longer marked as being away"
- 306 RPL_NOWAWAY
- ":You have been marked as being away"
-
- - These replies are used with the AWAY command (if
- allowed). RPL_AWAY is sent to any client sending a
- PRIVMSG to a client which is away. RPL_AWAY is only
- sent by the server to which the client is connected.
- Replies RPL_UNAWAY and RPL_NOWAWAY are sent when the
- client removes and sets an AWAY message.
-
- 311 RPL_WHOISUSER
- "<nick> <user> <host> * :<real name>"
- 312 RPL_WHOISSERVER
- "<nick> <server> :<server info>"
- 313 RPL_WHOISOPERATOR
- "<nick> :is an IRC operator"
- 317 RPL_WHOISIDLE
- "<nick> <integer> :seconds idle"
- 318 RPL_ENDOFWHOIS
- "<nick> :End of /WHOIS list"
- 319 RPL_WHOISCHANNELS
- "<nick> :{[@|+]<channel><space>}"
-
- - Replies 311 - 313, 317 - 319 are all replies
- generated in response to a WHOIS message. Given that
- there are enough parameters present, the answering
- server must either formulate a reply out of the above
- numerics (if the query nick is found) or return an
- error reply. The '*' in RPL_WHOISUSER is there as
- the literal character and not as a wild card. For
- each reply set, only RPL_WHOISCHANNELS may appear
- more than once (for long lists of channel names).
- The '@' and '+' characters next to the channel name
- indicate whether a client is a channel operator or
- has been granted permission to speak on a moderated
- channel. The RPL_ENDOFWHOIS reply is used to mark
- the end of processing a WHOIS message.
-
- 314 RPL_WHOWASUSER
- "<nick> <user> <host> * :<real name>"
- 369 RPL_ENDOFWHOWAS
- "<nick> :End of WHOWAS"
-
- - When replying to a WHOWAS message, a server must use
- the replies RPL_WHOWASUSER, RPL_WHOISSERVER or
- ERR_WASNOSUCHNICK for each nickname in the presented
-
-
-
-Oikarinen & Reed [Page 49]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- list. At the end of all reply batches, there must
- be RPL_ENDOFWHOWAS (even if there was only one reply
- and it was an error).
-
- 321 RPL_LISTSTART
- "Channel :Users Name"
- 322 RPL_LIST
- "<channel> <# visible> :<topic>"
- 323 RPL_LISTEND
- ":End of /LIST"
-
- - Replies RPL_LISTSTART, RPL_LIST, RPL_LISTEND mark
- the start, actual replies with data and end of the
- server's response to a LIST command. If there are
- no channels available to return, only the start
- and end reply must be sent.
-
- 324 RPL_CHANNELMODEIS
- "<channel> <mode> <mode params>"
-
- 331 RPL_NOTOPIC
- "<channel> :No topic is set"
- 332 RPL_TOPIC
- "<channel> :<topic>"
-
- - When sending a TOPIC message to determine the
- channel topic, one of two replies is sent. If
- the topic is set, RPL_TOPIC is sent back else
- RPL_NOTOPIC.
-
- 341 RPL_INVITING
- "<channel> <nick>"
-
- - Returned by the server to indicate that the
- attempted INVITE message was successful and is
- being passed onto the end client.
-
- 342 RPL_SUMMONING
- "<user> :Summoning user to IRC"
-
- - Returned by a server answering a SUMMON message to
- indicate that it is summoning that user.
-
- 351 RPL_VERSION
- "<version>.<debuglevel> <server> :<comments>"
-
- - Reply by the server showing its version details.
- The <version> is the version of the software being
-
-
-
-Oikarinen & Reed [Page 50]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- used (including any patchlevel revisions) and the
- <debuglevel> is used to indicate if the server is
- running in "debug mode".
-
- The "comments" field may contain any comments about
- the version or further version details.
-
- 352 RPL_WHOREPLY
- "<channel> <user> <host> <server> <nick> \
- <H|G>[*][@|+] :<hopcount> <real name>"
- 315 RPL_ENDOFWHO
- "<name> :End of /WHO list"
-
- - The RPL_WHOREPLY and RPL_ENDOFWHO pair are used
- to answer a WHO message. The RPL_WHOREPLY is only
- sent if there is an appropriate match to the WHO
- query. If there is a list of parameters supplied
- with a WHO message, a RPL_ENDOFWHO must be sent
- after processing each list item with <name> being
- the item.
-
- 353 RPL_NAMREPLY
- "<channel> :[[@|+]<nick> [[@|+]<nick> [...]]]"
- 366 RPL_ENDOFNAMES
- "<channel> :End of /NAMES list"
-
- - To reply to a NAMES message, a reply pair consisting
- of RPL_NAMREPLY and RPL_ENDOFNAMES is sent by the
- server back to the client. If there is no channel
- found as in the query, then only RPL_ENDOFNAMES is
- returned. The exception to this is when a NAMES
- message is sent with no parameters and all visible
- channels and contents are sent back in a series of
- RPL_NAMEREPLY messages with a RPL_ENDOFNAMES to mark
- the end.
-
- 364 RPL_LINKS
- "<mask> <server> :<hopcount> <server info>"
- 365 RPL_ENDOFLINKS
- "<mask> :End of /LINKS list"
-
- - In replying to the LINKS message, a server must send
- replies back using the RPL_LINKS numeric and mark the
- end of the list using an RPL_ENDOFLINKS reply.
-
- 367 RPL_BANLIST
- "<channel> <banid>"
- 368 RPL_ENDOFBANLIST
-
-
-
-Oikarinen & Reed [Page 51]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- "<channel> :End of channel ban list"
-
- - When listing the active 'bans' for a given channel,
- a server is required to send the list back using the
- RPL_BANLIST and RPL_ENDOFBANLIST messages. A separate
- RPL_BANLIST is sent for each active banid. After the
- banids have been listed (or if none present) a
- RPL_ENDOFBANLIST must be sent.
-
- 371 RPL_INFO
- ":<string>"
- 374 RPL_ENDOFINFO
- ":End of /INFO list"
-
- - A server responding to an INFO message is required to
- send all its 'info' in a series of RPL_INFO messages
- with a RPL_ENDOFINFO reply to indicate the end of the
- replies.
-
- 375 RPL_MOTDSTART
- ":- <server> Message of the day - "
- 372 RPL_MOTD
- ":- <text>"
- 376 RPL_ENDOFMOTD
- ":End of /MOTD command"
-
- - When responding to the MOTD message and the MOTD file
- is found, the file is displayed line by line, with
- each line no longer than 80 characters, using
- RPL_MOTD format replies. These should be surrounded
- by a RPL_MOTDSTART (before the RPL_MOTDs) and an
- RPL_ENDOFMOTD (after).
-
- 381 RPL_YOUREOPER
- ":You are now an IRC operator"
-
- - RPL_YOUREOPER is sent back to a client which has
- just successfully issued an OPER message and gained
- operator status.
-
- 382 RPL_REHASHING
- "<config file> :Rehashing"
-
- - If the REHASH option is used and an operator sends
- a REHASH message, an RPL_REHASHING is sent back to
- the operator.
-
- 391 RPL_TIME
-
-
-
-Oikarinen & Reed [Page 52]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- "<server> :<string showing server's local time>"
-
- - When replying to the TIME message, a server must send
- the reply using the RPL_TIME format above. The string
- showing the time need only contain the correct day and
- time there. There is no further requirement for the
- time string.
-
- 392 RPL_USERSSTART
- ":UserID Terminal Host"
- 393 RPL_USERS
- ":%-8s %-9s %-8s"
- 394 RPL_ENDOFUSERS
- ":End of users"
- 395 RPL_NOUSERS
- ":Nobody logged in"
-
- - If the USERS message is handled by a server, the
- replies RPL_USERSTART, RPL_USERS, RPL_ENDOFUSERS and
- RPL_NOUSERS are used. RPL_USERSSTART must be sent
- first, following by either a sequence of RPL_USERS
- or a single RPL_NOUSER. Following this is
- RPL_ENDOFUSERS.
-
- 200 RPL_TRACELINK
- "Link <version & debug level> <destination> \
- <next server>"
- 201 RPL_TRACECONNECTING
- "Try. <class> <server>"
- 202 RPL_TRACEHANDSHAKE
- "H.S. <class> <server>"
- 203 RPL_TRACEUNKNOWN
- "???? <class> [<client IP address in dot form>]"
- 204 RPL_TRACEOPERATOR
- "Oper <class> <nick>"
- 205 RPL_TRACEUSER
- "User <class> <nick>"
- 206 RPL_TRACESERVER
- "Serv <class> <int>S <int>C <server> \
- <nick!user|*!*>@<host|server>"
- 208 RPL_TRACENEWTYPE
- "<newtype> 0 <client name>"
- 261 RPL_TRACELOG
- "File <logfile> <debug level>"
-
- - The RPL_TRACE* are all returned by the server in
- response to the TRACE message. How many are
- returned is dependent on the the TRACE message and
-
-
-
-Oikarinen & Reed [Page 53]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- whether it was sent by an operator or not. There
- is no predefined order for which occurs first.
- Replies RPL_TRACEUNKNOWN, RPL_TRACECONNECTING and
- RPL_TRACEHANDSHAKE are all used for connections
- which have not been fully established and are either
- unknown, still attempting to connect or in the
- process of completing the 'server handshake'.
- RPL_TRACELINK is sent by any server which handles
- a TRACE message and has to pass it on to another
- server. The list of RPL_TRACELINKs sent in
- response to a TRACE command traversing the IRC
- network should reflect the actual connectivity of
- the servers themselves along that path.
- RPL_TRACENEWTYPE is to be used for any connection
- which does not fit in the other categories but is
- being displayed anyway.
-
- 211 RPL_STATSLINKINFO
- "<linkname> <sendq> <sent messages> \
- <sent bytes> <received messages> \
- <received bytes> <time open>"
- 212 RPL_STATSCOMMANDS
- "<command> <count>"
- 213 RPL_STATSCLINE
- "C <host> * <name> <port> <class>"
- 214 RPL_STATSNLINE
- "N <host> * <name> <port> <class>"
- 215 RPL_STATSILINE
- "I <host> * <host> <port> <class>"
- 216 RPL_STATSKLINE
- "K <host> * <username> <port> <class>"
- 218 RPL_STATSYLINE
- "Y <class> <ping frequency> <connect \
- frequency> <max sendq>"
- 219 RPL_ENDOFSTATS
- "<stats letter> :End of /STATS report"
- 241 RPL_STATSLLINE
- "L <hostmask> * <servername> <maxdepth>"
- 242 RPL_STATSUPTIME
- ":Server Up %d days %d:%02d:%02d"
- 243 RPL_STATSOLINE
- "O <hostmask> * <name>"
- 244 RPL_STATSHLINE
- "H <hostmask> * <servername>"
-
- 221 RPL_UMODEIS
- "<user mode string>"
-
-
-
-
-Oikarinen & Reed [Page 54]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- - To answer a query about a client's own mode,
- RPL_UMODEIS is sent back.
-
- 251 RPL_LUSERCLIENT
- ":There are <integer> users and <integer> \
- invisible on <integer> servers"
- 252 RPL_LUSEROP
- "<integer> :operator(s) online"
- 253 RPL_LUSERUNKNOWN
- "<integer> :unknown connection(s)"
- 254 RPL_LUSERCHANNELS
- "<integer> :channels formed"
- 255 RPL_LUSERME
- ":I have <integer> clients and <integer> \
- servers"
-
- - In processing an LUSERS message, the server
- sends a set of replies from RPL_LUSERCLIENT,
- RPL_LUSEROP, RPL_USERUNKNOWN,
- RPL_LUSERCHANNELS and RPL_LUSERME. When
- replying, a server must send back
- RPL_LUSERCLIENT and RPL_LUSERME. The other
- replies are only sent back if a non-zero count
- is found for them.
-
- 256 RPL_ADMINME
- "<server> :Administrative info"
- 257 RPL_ADMINLOC1
- ":<admin info>"
- 258 RPL_ADMINLOC2
- ":<admin info>"
- 259 RPL_ADMINEMAIL
- ":<admin info>"
-
- - When replying to an ADMIN message, a server
- is expected to use replies RLP_ADMINME
- through to RPL_ADMINEMAIL and provide a text
- message with each. For RPL_ADMINLOC1 a
- description of what city, state and country
- the server is in is expected, followed by
- details of the university and department
- (RPL_ADMINLOC2) and finally the administrative
- contact for the server (an email address here
- is required) in RPL_ADMINEMAIL.
-
-
-
-
-
-
-
-Oikarinen & Reed [Page 55]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-6.3 Reserved numerics.
-
- These numerics are not described above since they fall into one of
- the following categories:
-
- 1. no longer in use;
-
- 2. reserved for future planned use;
-
- 3. in current use but are part of a non-generic 'feature' of
- the current IRC server.
-
- 209 RPL_TRACECLASS 217 RPL_STATSQLINE
- 231 RPL_SERVICEINFO 232 RPL_ENDOFSERVICES
- 233 RPL_SERVICE 234 RPL_SERVLIST
- 235 RPL_SERVLISTEND
- 316 RPL_WHOISCHANOP 361 RPL_KILLDONE
- 362 RPL_CLOSING 363 RPL_CLOSEEND
- 373 RPL_INFOSTART 384 RPL_MYPORTIS
- 466 ERR_YOUWILLBEBANNED 476 ERR_BADCHANMASK
- 492 ERR_NOSERVICEHOST
-
-7. Client and server authentication
-
- Clients and servers are both subject to the same level of
- authentication. For both, an IP number to hostname lookup (and
- reverse check on this) is performed for all connections made to the
- server. Both connections are then subject to a password check (if
- there is a password set for that connection). These checks are
- possible on all connections although the password check is only
- commonly used with servers.
-
- An additional check that is becoming of more and more common is that
- of the username responsible for making the connection. Finding the
- username of the other end of the connection typically involves
- connecting to an authentication server such as IDENT as described in
- RFC 1413.
-
- Given that without passwords it is not easy to reliably determine who
- is on the other end of a network connection, use of passwords is
- strongly recommended on inter-server connections in addition to any
- other measures such as using an ident server.
-
-8. Current implementations
-
- The only current implementation of this protocol is the IRC server,
- version 2.8. Earlier versions may implement some or all of the
- commands described by this document with NOTICE messages replacing
-
-
-
-Oikarinen & Reed [Page 56]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- many of the numeric replies. Unfortunately, due to backward
- compatibility requirements, the implementation of some parts of this
- document varies with what is laid out. On notable difference is:
-
- * recognition that any LF or CR anywhere in a message marks the
- end of that message (instead of requiring CR-LF);
-
- The rest of this section deals with issues that are mostly of
- importance to those who wish to implement a server but some parts
- also apply directly to clients as well.
-
-8.1 Network protocol: TCP - why it is best used here.
-
- IRC has been implemented on top of TCP since TCP supplies a reliable
- network protocol which is well suited to this scale of conferencing.
- The use of multicast IP is an alternative, but it is not widely
- available or supported at the present time.
-
-8.1.1 Support of Unix sockets
-
- Given that Unix domain sockets allow listen/connect operations, the
- current implementation can be configured to listen and accept both
- client and server connections on a Unix domain socket. These are
- recognized as sockets where the hostname starts with a '/'.
-
- When providing any information about the connections on a Unix domain
- socket, the server is required to supplant the actual hostname in
- place of the pathname unless the actual socket name is being asked
- for.
-
-8.2 Command Parsing
-
- To provide useful 'non-buffered' network IO for clients and servers,
- each connection is given its own private 'input buffer' in which the
- results of the most recent read and parsing are kept. A buffer size
- of 512 bytes is used so as to hold 1 full message, although, this
- will usually hold several commands. The private buffer is parsed
- after every read operation for valid messages. When dealing with
- multiple messages from one client in the buffer, care should be taken
- in case one happens to cause the client to be 'removed'.
-
-8.3 Message delivery
-
- It is common to find network links saturated or hosts to which you
- are sending data unable to send data. Although Unix typically
- handles this through the TCP window and internal buffers, the server
- often has large amounts of data to send (especially when a new
- server-server link forms) and the small buffers provided in the
-
-
-
-Oikarinen & Reed [Page 57]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- kernel are not enough for the outgoing queue. To alleviate this
- problem, a "send queue" is used as a FIFO queue for data to be sent.
- A typical "send queue" may grow to 200 Kbytes on a large IRC network
- with a slow network connection when a new server connects.
-
- When polling its connections, a server will first read and parse all
- incoming data, queuing any data to be sent out. When all available
- input is processed, the queued data is sent. This reduces the number
- of write() system calls and helps TCP make bigger packets.
-
-8.4 Connection 'Liveness'
-
- To detect when a connection has died or become unresponsive, the
- server must ping each of its connections that it doesn't get a
- response from in a given amount of time.
-
- If a connection doesn't respond in time, its connection is closed
- using the appropriate procedures. A connection is also dropped if
- its sendq grows beyond the maximum allowed, because it is better to
- close a slow connection than have a server process block.
-
-8.5 Establishing a server to client connection
-
- Upon connecting to an IRC server, a client is sent the MOTD (if
- present) as well as the current user/server count (as per the LUSER
- command). The server is also required to give an unambiguous message
- to the client which states its name and version as well as any other
- introductory messages which may be deemed appropriate.
-
- After dealing with this, the server must then send out the new user's
- nickname and other information as supplied by itself (USER command)
- and as the server could discover (from DNS/authentication servers).
- The server must send this information out with NICK first followed by
- USER.
-
-8.6 Establishing a server-server connection.
-
- The process of establishing of a server-to-server connection is
- fraught with danger since there are many possible areas where
- problems can occur - the least of which are race conditions.
-
- After a server has received a connection following by a PASS/SERVER
- pair which were recognised as being valid, the server should then
- reply with its own PASS/SERVER information for that connection as
- well as all of the other state information it knows about as
- described below.
-
- When the initiating server receives a PASS/SERVER pair, it too then
-
-
-
-Oikarinen & Reed [Page 58]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- checks that the server responding is authenticated properly before
- accepting the connection to be that server.
-
-8.6.1 Server exchange of state information when connecting
-
- The order of state information being exchanged between servers is
- essential. The required order is as follows:
-
- * all known other servers;
-
- * all known user information;
-
- * all known channel information.
-
- Information regarding servers is sent via extra SERVER messages, user
- information with NICK/USER/MODE/JOIN messages and channels with MODE
- messages.
-
- NOTE: channel topics are *NOT* exchanged here because the TOPIC
- command overwrites any old topic information, so at best, the two
- sides of the connection would exchange topics.
-
- By passing the state information about servers first, any collisions
- with servers that already exist occur before nickname collisions due
- to a second server introducing a particular nickname. Due to the IRC
- network only being able to exist as an acyclic graph, it may be
- possible that the network has already reconnected in another
- location, the place where the collision occurs indicating where the
- net needs to split.
-
-8.7 Terminating server-client connections
-
- When a client connection closes, a QUIT message is generated on
- behalf of the client by the server to which the client connected. No
- other message is to be generated or used.
-
-8.8 Terminating server-server connections
-
- If a server-server connection is closed, either via a remotely
- generated SQUIT or 'natural' causes, the rest of the connected IRC
- network must have its information updated with by the server which
- detected the closure. The server then sends a list of SQUITs (one
- for each server behind that connection) and a list of QUITs (again,
- one for each client behind that connection).
-
-
-
-
-
-
-
-Oikarinen & Reed [Page 59]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-8.9 Tracking nickname changes
-
- All IRC servers are required to keep a history of recent nickname
- changes. This is required to allow the server to have a chance of
- keeping in touch of things when nick-change race conditions occur
- with commands which manipulate them. Commands which must trace nick
- changes are:
-
- * KILL (the nick being killed)
-
- * MODE (+/- o,v)
-
- * KICK (the nick being kicked)
-
- No other commands are to have nick changes checked for.
-
- In the above cases, the server is required to first check for the
- existence of the nickname, then check its history to see who that
- nick currently belongs to (if anyone!). This reduces the chances of
- race conditions but they can still occur with the server ending up
- affecting the wrong client. When performing a change trace for an
- above command it is recommended that a time range be given and
- entries which are too old ignored.
-
- For a reasonable history, a server should be able to keep previous
- nickname for every client it knows about if they all decided to
- change. This size is limited by other factors (such as memory, etc).
-
-8.10 Flood control of clients
-
- With a large network of interconnected IRC servers, it is quite easy
- for any single client attached to the network to supply a continuous
- stream of messages that result in not only flooding the network, but
- also degrading the level of service provided to others. Rather than
- require every 'victim' to be provide their own protection, flood
- protection was written into the server and is applied to all clients
- except services. The current algorithm is as follows:
-
- * check to see if client's `message timer' is less than
- current time (set to be equal if it is);
-
- * read any data present from the client;
-
- * while the timer is less than ten seconds ahead of the current
- time, parse any present messages and penalize the client by
- 2 seconds for each message;
-
- which in essence means that the client may send 1 message every 2
-
-
-
-Oikarinen & Reed [Page 60]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- seconds without being adversely affected.
-
-8.11 Non-blocking lookups
-
- In a real-time environment, it is essential that a server process do
- as little waiting as possible so that all the clients are serviced
- fairly. Obviously this requires non-blocking IO on all network
- read/write operations. For normal server connections, this was not
- difficult, but there are other support operations that may cause the
- server to block (such as disk reads). Where possible, such activity
- should be performed with a short timeout.
-
-8.11.1 Hostname (DNS) lookups
-
- Using the standard resolver libraries from Berkeley and others has
- meant large delays in some cases where replies have timed out. To
- avoid this, a separate set of DNS routines were written which were
- setup for non-blocking IO operations and then polled from within the
- main server IO loop.
-
-8.11.2 Username (Ident) lookups
-
- Although there are numerous ident libraries for use and inclusion
- into other programs, these caused problems since they operated in a
- synchronous manner and resulted in frequent delays. Again the
- solution was to write a set of routines which would cooperate with
- the rest of the server and work using non-blocking IO.
-
-8.12 Configuration File
-
- To provide a flexible way of setting up and running the server, it is
- recommended that a configuration file be used which contains
- instructions to the server on the following:
-
- * which hosts to accept client connections from;
-
- * which hosts to allow to connect as servers;
-
- * which hosts to connect to (both actively and
- passively);
-
- * information about where the server is (university,
- city/state, company are examples of this);
-
- * who is responsible for the server and an email address
- at which they can be contacted;
-
- * hostnames and passwords for clients which wish to be given
-
-
-
-Oikarinen & Reed [Page 61]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- access to restricted operator commands.
-
- In specifying hostnames, both domain names and use of the 'dot'
- notation (127.0.0.1) should both be accepted. It must be possible to
- specify the password to be used/accepted for all outgoing and
- incoming connections (although the only outgoing connections are
- those to other servers).
-
- The above list is the minimum requirement for any server which wishes
- to make a connection with another server. Other items which may be
- of use are:
-
- * specifying which servers other server may introduce;
-
- * how deep a server branch is allowed to become;
-
- * hours during which clients may connect.
-
-8.12.1 Allowing clients to connect
-
- A server should use some sort of 'access control list' (either in the
- configuration file or elsewhere) that is read at startup and used to
- decide what hosts clients may use to connect to it.
-
- Both 'deny' and 'allow' should be implemented to provide the required
- flexibility for host access control.
-
-8.12.2 Operators
-
- The granting of operator privileges to a disruptive person can have
- dire consequences for the well-being of the IRC net in general due to
- the powers given to them. Thus, the acquisition of such powers
- should not be very easy. The current setup requires two 'passwords'
- to be used although one of them is usually easy guessed. Storage of
- oper passwords in configuration files is preferable to hard coding
- them in and should be stored in a crypted format (ie using crypt(3)
- from Unix) to prevent easy theft.
-
-8.12.3 Allowing servers to connect
-
- The interconnection of server is not a trivial matter: a bad
- connection can have a large impact on the usefulness of IRC. Thus,
- each server should have a list of servers to which it may connect and
- which servers may connect to it. Under no circumstances should a
- server allow an arbitrary host to connect as a server. In addition
- to which servers may and may not connect, the configuration file
- should also store the password and other characteristics of that
- link.
-
-
-
-Oikarinen & Reed [Page 62]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-8.12.4 Administrivia
-
- To provide accurate and valid replies to the ADMIN command (see
- section 4.3.7), the server should find the relevant details in the
- configuration.
-
-8.13 Channel membership
-
- The current server allows any registered local user to join upto 10
- different channels. There is no limit imposed on non-local users so
- that the server remains (reasonably) consistant with all others on a
- channel membership basis
-
-9. Current problems
-
- There are a number of recognized problems with this protocol, all of
- which hope to be solved sometime in the near future during its
- rewrite. Currently, work is underway to find working solutions to
- these problems.
-
-9.1 Scalability
-
- It is widely recognized that this protocol does not scale
- sufficiently well when used in a large arena. The main problem comes
- from the requirement that all servers know about all other servers
- and users and that information regarding them be updated as soon as
- it changes. It is also desirable to keep the number of servers low
- so that the path length between any two points is kept minimal and
- the spanning tree as strongly branched as possible.
-
-9.2 Labels
-
- The current IRC protocol has 3 types of labels: the nickname, the
- channel name and the server name. Each of the three types has its
- own domain and no duplicates are allowed inside that domain.
- Currently, it is possible for users to pick the label for any of the
- three, resulting in collisions. It is widely recognized that this
- needs reworking, with a plan for unique names for channels and nicks
- that don't collide being desirable as well as a solution allowing a
- cyclic tree.
-
-9.2.1 Nicknames
-
- The idea of the nickname on IRC is very convenient for users to use
- when talking to each other outside of a channel, but there is only a
- finite nickname space and being what they are, its not uncommon for
- several people to want to use the same nick. If a nickname is chosen
- by two people using this protocol, either one will not succeed or
-
-
-
-Oikarinen & Reed [Page 63]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
- both will removed by use of KILL (4.6.1).
-
-9.2.2 Channels
-
- The current channel layout requires that all servers know about all
- channels, their inhabitants and properties. Besides not scaling
- well, the issue of privacy is also a concern. A collision of
- channels is treated as an inclusive event (both people who create the
- new channel are considered to be members of it) rather than an
- exclusive one such as used to solve nickname collisions.
-
-9.2.3 Servers
-
- Although the number of servers is usually small relative to the
- number of users and channels, they two currently required to be known
- globally, either each one separately or hidden behind a mask.
-
-9.3 Algorithms
-
- In some places within the server code, it has not been possible to
- avoid N^2 algorithms such as checking the channel list of a set
- of clients.
-
- In current server versions, there are no database consistency checks,
- each server assumes that a neighbouring server is correct. This
- opens the door to large problems if a connecting server is buggy or
- otherwise tries to introduce contradictions to the existing net.
-
- Currently, because of the lack of unique internal and global labels,
- there are a multitude of race conditions that exist. These race
- conditions generally arise from the problem of it taking time for
- messages to traverse and effect the IRC network. Even by changing to
- unique labels, there are problems with channel-related commands being
- disrupted.
-
-10. Current support and availability
-
- Mailing lists for IRC related discussion:
- Future protocol: ircd-three-request@eff.org
- General discussion: operlist-request@eff.org
-
- Software implemenations
- cs.bu.edu:/irc
- nic.funet.fi:/pub/irc
- coombs.anu.edu.au:/pub/irc
-
- Newsgroup: alt.irc
-
-
-
-
-Oikarinen & Reed [Page 64]
-\f
-RFC 1459 Internet Relay Chat Protocol May 1993
-
-
-Security Considerations
-
- Security issues are discussed in sections 4.1, 4.1.1, 4.1.3, 5.5, and
- 7.
-
-12. Authors' Addresses
-
- Jarkko Oikarinen
- Tuirantie 17 as 9
- 90500 OULU
- FINLAND
-
- Email: jto@tolsun.oulu.fi
-
-
- Darren Reed
- 4 Pateman Street
- Watsonia, Victoria 3087
- Australia
-
- Email: avalon@coombs.anu.edu.au
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-
-Oikarinen & Reed [Page 65]
-\f
+++ /dev/null
-Newsgroups: alt.irc.ircii,alt.irc
-Subject: REVISED AND UPDATED CTCP SPECIFICATION
-Distribution:
---text follows this line--
-As part of documenting the ZenIRC client, I expanded, revised, and
-merged two text files that have been around on IRC archive sites for
-some time: ctcp.doc, and dcc.protocol. The file "ctcp.doc" by Klaus
-Zeuge described the basic CTCP protocol, and most of the CTCP commands
-other than DCC. The file Troy Rollo wrote, "dcc.protocol", contained
-a description of the CTCP DCC messages as well as the protocols used
-by DCC CHAT and DCC file transfers. I have merged the two documents to
-produce this one, edited them for clarity, and expanded on them where I
-found them unclear while implementing CTCP in the ZenIRC client.
-
-The result is still far from perfect, but I believe the result to be
-more useful than the two original documents, therefore I am urging
-maintainers of IRC archives to replace or supplement "ctcp.doc" and
-"dcc.protocol" with this expanded and revised "ctcp.doc" file.
-
-An alpha test version of the ZenIRC client is available from
-alpha.gnu.ai.mit.edu in /zenirc/zenirc.tar.gz
-
-Comments, criticism, suggestions directly to me; I don't read alt.irc* .
-
-
---Ben
------------------------------------[snip]-----------------------------------
-;;; hey emacs, this is -*-Text-*-
-Klaus Zeuge <sojge@Minsk.DoCS.UU.SE>
-Troy Rollo <troy@plod.cbme.unsw.oz.au>
-Ben Mesander <ben@gnu.ai.mit.edu>
-
-The Client-To-Client Protocol (CTCP)
-
-The Client-To-Client Protocol is meant to be used as a way to
- 1/ in general send structured data (such as graphics,
- voice and different font information) between users
- clients, and in a more specific case:
- 2/ place a query to a users client and getting an answer.
-
-*****************************************
-BASIC PROTOCOL BETWEEN CLIENTS AND SERVER
-*****************************************
-
-Characters between an Internet Relay Chat (IRC) client and server are
-8 bit bytes (also known as octets) and can have numeric values from
-octal \000 to \377 inclusive (0 to 255 decimal). Some characters are
-special:
-
- CHARS ::= '\000' .. '\377'
- NUL ::= '\000'
- NL ::= '\n'
- CR ::= '\r'
-
-Note: `\' followed by three digits is used to denote an octal value in this
- paper. `\' followed by an alphabetic character is used to denote a C
- language style special character, and `..' denotes a range of characters.
-
-A line sent to a server, or received from a server (here called "low
-level messages") consist or zero or more octets (expcept NUL, NL or
-CR) with either a NL or CR appended.
-
- L-CHARS ::= '\001' .. '\011' | '\013' | '\014' |
- '\016' .. '\377'
- L-LINE ::= L-CHARS* CR LF
-
-Note: The `*' is used here to denote "zero or more of the preceding class of
- characters", and the `|' is used to denote alternation.
-
-A NUL is never sent to the server.
-
-*****************
-LOW LEVEL QUOTING
-*****************
-
-Even though messages to and from IRC servers cannot contain NUL, NL,
-or CR, it still might be desirable to send ANY character (in so called
-"middle level messages") between clients. In order for this to be
-possible, those three characters have to be quoted. Therefore a quote
-character is needed. Of course, the quote character itself has to be
-quoted too, since it is in-band.
-
- M-QUOTE ::= '\020'
-
-(Ie a CNTRL/P).
-
-When sending a middle level message, if there is a character in the
-set { NUL, NL, CR, M-QUOTE } present in the message, that character is
-replaced by a two character sequence according to the following table:
-
- NUL --> M-QUOTE '0'
- NL --> M-QUOTE 'n'
- CR --> M-QUOTE 'r'
- M-QUOTE --> M-QUOTE M-QUOTE
-
-When receiving a low level message, if there is a M-QUOTE, look at the
-next character, and replace those two according to the following table
-to get the corresponding middle level message:
-
- M-QUOTE '0' --> NUL
- M-QUOTE 'n' --> NL
- M-QUOTE 'r' --> CR
- M-QUOTE M-QUOTE --> M-QUOTE
-
-If the character following M-QUOTE is not any of the listed
-characters, that is an error, so drop the M-QUOTE character from the
-message, optionally warning the user about it. For example, a string
-'x' M-QUOTE 'y' 'z' from a server dequotes into 'x 'y' 'z'.
-
-Before low level quoting, a message to the server (and in the opposite
-direction: after low level dequoting, a message from the server) looks
-like:
-
- M-LINE ::= CHARS*
-
-***********
-TAGGED DATA
-***********
-
-To send both extended data and query/reply pairs between clients, an
-extended data format is needed. The extended data are sent in the text
-part of a middle level message (and after low level quoting, in the
-text part of the low level message).
-
-To send extended data inside the middle level message, we need some
-way to delimit it. This is done by starting and ending extended data
-with a delimiter character, defined as:
-
- X-DELIM ::= '\001'
-
-As both the starting and ending delimiter looks the same, the first
-X-DELIM is called the odd delimiter, and the one that follows, the
-even delimiter. The next one after that, an odd delimiter, then and
-even, and so on.
-
-When data are quoted (and conversely, before being dequoted) any number
-of characters of any kind except X-DELIM can be used in the extended
-data inside the X-DELIM pair.
-
- X-CHR ::= '\000' | '\002' .. '\377'
-
-An extended message is either empty (nothing between the odd and even
-delimiter), has one or more non-space characters (any character but
-'\040') or has one or more non-space characters followed by a space
-followed by zero or more characters.
-
- X-N-AS ::= '\000' | '\002' .. '\037' | '\041' .. '\377'
- SPC ::= '\040'
- X-MSG ::= | X-N-AS+ | X-N-AS+ SPC X-CHR*
-
-Note: Here `+' is used to denote "one or more of the previous class of
- characters", and `*' is used to denote "zero or more of the previous
- class of characters".
-
-The characters up until the first SPC (or if no SPC, all of the X-MSG)
-is called the tag of the extended message. The tag is used to denote
-what kind of extended data is used.
-
-The tag can be *any* string of characters, and if it contains
-alphabetics, it is case sensitive, so upper and lower case matters.
-
-Extended data is only valid in PRIVMSG and NOTICE commands. If the
-extended data is a reply to a query, it is sent in a NOTICE, otherwise
-it is sent in a PRIVMSG. Both PRIVMSG and NOTICE to a user and to a
-channel may contain extended data.
-
-The text part of a PRIVMSG or NOTICE might contain zero or more
-extended messages, intermixed with zero or more chunks of non-extended
-data.
-
-******************
-CTCP LEVEL QUOTING
-******************
-
-In order to be able to send the delimiter X-DELIM inside an extended
-data message, it has to be quoted. This introduces another quote
-character (which differs from the low level quote character so it
-won't have to be quoted yet again).
-
- X-QUOTE ::= '\134'
-
-(a back slash - `\').
-
-When quoting on the CTCP level, only the actual CTCP message (extended
-data, queries, replies) are quoted. This enables users to actually
-send X-QUOTE characters at will. The following translations should be
-used:
-
- X-DELIM --> X-QUOTE 'a'
-
- X-QUOTE --> X-QUOTE X-QUOTE
-
-and when dequoting on the CTCP level, only CTCP messages are dequoted
-whereby the following table is used.
-
- X-QUOTE 'a' --> X-DELIM
- X-QUOTE X-QUOTE --> X-QUOTE
-
-If an X-QUOTE is seen with a character following it other than the
-ones above, that is an error and the X-QUOTE character should be
-dropped. For example the CTCP-quoted string 'x' X-QUOTE 'y' 'z'
-becomes after dequoting, the three character string 'x' 'y' 'z'.
-
-If a X-DELIM is found outside a CTCP message, the message will contain
-the X-DELIM. (This should only happen with the last X-DELIM when there
-are an odd number of X-DELIM's in a middle level message.)
-
-****************
-QUOTING EXAMPLES
-****************
-
-There are three levels of messages. The highest level (H) is the text
-on the user-to-client level. The middle layer (M) is on the level
-where CTCP quoting has been applied to the H-level message. The lowest
-level (L) is on the client-to-server level, where low level quoting
-has been applied to the M-level message.
-
-The following relations are true, with lowQuote(message) being a
-function doing the low level quoting, lowDequote(message) the low
-level dequoting function, ctcpQuote(message) the CTCP level quoting
-function, ctcpDequote(message) the CTCP level dequoting function, and
-ctcpExtract(message) the function which removes all CTCP messages from
-a message:
-
- L = lowQuote(M)
- M = ctcpDequote(L)
-
- M = ctcpQuote(H)
- H = ctcpDequote(ctcpExtract(M))
-
-When sending a CTCP message embedded in normal text:
-
- M = ctcpQuote(H1) || '\001' || ctcpQuote(X) || '\001' || ctcpQuote(H2)
-
-Note: The operator || denotes string concatenation.
-
-Of course, there might be zero or more normal text messages and zero
-or more CTCP messages mixed.
-
-- --- Example 1 -----------------------------------------------------------------
-
-A user (called actor) wanting to send the string:
-
- Hi there!\nHow are you?
-
-to user victim, i.e. a message where the user has entered an inline
-newline (how this is done, if at all, differs from client to client),
-will result internally in the client in the command:
-
- PRIVMSG victim :Hi there!\nHow are you? \K?
-
-which will be CTCP quoted into:
-
- PRIVMSG victim :Hi there!\nHow are you? \\K?
-
-which in turn will be low level quoted into:
-
- PRIVMSG victim :Hi there!\020nHow are you? \\K?
-
-and sent to the server after appending a newline at the end.
-
-This will arrive on victim's side as:
-
- :actor PRIVMSG victim :Hi there!\020nHow are you? \\K?
-
-(where the \\K would look similar to OK in SIS D47 et. al.) which after
-low level dequoting becomes:
-
- :actor PRIVMSG victim :Hi there!\nHow are you? \\K?
-
-and after CTCP dequoting:
-
- :actom PRIVMSG victim :Hi there!\nHow are you? \K?
-
-How this is displayed differs from client to client, but it suggested
-that a line break should occour between the words "there" and "How".
-
-- --- Example 2 -----------------------------------------------------------------
-
-If actor's client wants to send the string "Emacs wins" this might
-become the string "\n\t\big\020\001\000\\:" when being SED-encrypted
-[SED is a simple encryption protocol between IRC clients implemented
-with CTCP. I don't have any reference for it -- Ben] using some key,
-so the client starts by CTCP-quoting this string into the string
-"\n\t\big\020\\a\000\\\\:" and builds the M-level message:
-
- PRIVMSG victim :\001SED \n\t\big\020\\a\000\\\\:\001
-
-which after low level quoting becomes:
-
- PRIVMSG victim :\001SED \020n\t\big\020\020\\a\0200\\\\:\001
-
-which will be sent to the server, with a newline tacked on.
-
-On victim's side, the string:
-
- :actor PRIVMSG victim :\001SED \020n\t\big\020\020\\a\0200\\\\:\001
-
-will be received from the server and low level dequoted into:
-
- :actor PRIVMSG victim :\001SED \n\t\big\020\\a\000\\\\:\001
-
-whereafter the string "\n\t\big\020\\a\000\\\\:" will be extracted
-and first CTCP dequoted into "\n\t\big\020\001\000\\:" and then
-SED decoded getting back "Emacs wins" when using the same key.
-
-- --- Example 3 -----------------------------------------------------------------
-
-If the user actor wants to query the USERINFO of user victim, and is
-in the middle of a conversation, the client may decide to tack on
-USERINFO request on the end of a normal text message. Let's say actor
-wants to send the textmessage "Say hi to Ron\n\t/actor" and the CTCP
-request "USERINFO" to victim:
-
- PRIVMSG victim :Say hi to Ron\n\t/actor
-
-plus:
-
- USERINFO
-
-which after CTCP quoting become:
-
- PRIVMSG victim :Say hi to Ron\n\t/actor
-
-plus:
-
- USERINFO
-
-which gets merged into:
-
- PRIVMSG victim :Say hi to Ron\n\t/actor\001USERINFO\001
-
-and after low level quoting:
-
- PRIVMSG victim :Say hi to Ron\020n\t/actor\001USERINFO\001
-
-and sent off to the server.
-
-On victim's side, the message:
-
- :actor PRIVMSG victim :Say hi to Ron\020n\t/actor\001USERINFO\001
-
-arrives. This gets low level dequoted into:
-
- :actor PRIVMSG victim :Say hi to Ron\n\t/actor\001USERINFO\001
-
-and thereafter split up into:
-
- :actor PRIVMSG victim :Say hi to Ron\n\t/actor
-
-plus:
-
- USERINFO
-
-After CTCP dequoting both, the message:
-
- :actor PRIVMSG victim :Say hi to Ron\n\t/actor
-
-gets displayed, while the CTCP command:
-
- USERINFO
-
-gets replied to. The reply might be:
-
- USERINFO :CS student\n\001test\001
-
-which gets CTCP quoted into:
-
- USERINFO :CS student\n\\atest\\a
-
-and sent in a NOTICE as it is a reply:
-
- NOTICE actor :\001USERINFO :CS student\n\\atest\\a\001
-
-and low level quoted into:
-
- NOTICE actor :\001USERINFO :CS student\020n\\atest\\a\001
-
-after which is it sent to victim's server.
-
-When arriving on actor's side, the message:
-
- :victim NOTICE actor :\001USERINFO :CS student\020n\\atest\\a\001
-
-gets low level dequoted into:
-
- :victim NOTICE actor :\001USERINFO :CS student\n\\atest\\a\001
-
-At this point, all CTCP replies get extracted, giving 1 CTCP reply and
-no normal NOTICE:
-
- USERINFO :CS student\n\\atest\\a
-
-The remaining reply gets CTCP dequoted into:
-
- USERINFO :CS student\n\001test\001
-
-and presumly displayed to user actor.
-
-*******************
-KNOWN EXTENDED DATA
-*******************
-
-Extended data passed between clients can be used to pass structured
-information between them. Currently known extended data types are:
-
-ACTION - Used to simulate "role playing" on IRC.
-DCC - Negotiates file transfers and direct tcp chat
- connections between clients.
-SED - Used to send encrypted messages between clients.
-
-ACTION
-======
-This is used by losers on IRC to simulate "role playing" games. An
-action message looks like the following:
-
-\001ACTION barfs on the floor.\001
-
-Clients that recieve such a message should format them to indicate the
-user who did this is performing an "action". For example, if the user
-"actor" sent the above message to the channel "#twilight_zone", other
-users clients might display the message as:
-
-[ACTION] actor->#twilight_zone: barfs on the floor.
-
-Presumably other users on the channel are suitably impressed.
-
-DCC
-===
-DCC stands for something like "Direct Client Connection". CTCP DCC
-extended data messages are used to negotiate file transfers between
-clients and to negotiate chat connections over tcp connections between
-two clients, with no IRC server involved. Connections between clients
-involve protocols other than the usual IRC protocol. Due to this
-complexity, a full description of the DCC protocol is included
-separately at the end of this document in Appendix A.
-
-SED
-===
-SED probably stands for something like "Simple Encryption D???". It is
-used by clients to exchange encrypted messages between clients. A
-message encoded by SED probably looks something like:
-
-\001SED encrypted-text-goes-here\001
-
-Clients which accept such messages should display them in decrypted
-form. It would be nice if someone documented this, and included the
-encryption scheme in an Appendix B.
-
-*************************
-KNOWN REQUEST/REPLY PAIRS
-*************************
-
-A request/reply pair is sent between the two clients in two phases.
-The first phase is to send the request. This is done with a "privmsg"
-command (either to a nick or to a channel -- it doesn't matter).
-
-The second phase is to send a reply. This is done with a "notice"
-command.
-
-The known request/reply pairs are for the following commands.
-
-FINGER - Returns the user's full name, and idle time.
-VERSION - The version and type of the client.
-SOURCE - Where to obtain a copy of a client.
-USERINFO - A string set by the user (never the client coder)
-CLIENTINFO - Dynamic master index of what a client knows.
-ERRMSG - Used when an error needs to be replied with.
-PING - Used to measure the delay of the IRC network
- between clients.
-TIME - Gets the local date and time from other clients.
-
-FINGER
-======
-This is used to get a user's real name, and perhaps also the idle time
-of the user (this usage has been obsoleted by enhancements to the IRC
-protocol. The request is in a "privmsg" and looks like
-
- \001FINGER\001
-
-while the reply is in a "notice" and looks like
-
- \001FINGER :#\001
-
-where the # denotes contains information about the users real name,
-login name at clientmachine and idle time and is of type X-N-AS.
-
-VERSION
-=======
-This is used to get information about the name of the other client and
-the version of it. The request in a "privmsg" is simply
-
- \001VERSION\001
-
-and the reply
-
- \001VERSION #:#:#\001
-
-where the first # denotes the name of the client, the second # denotes
-the version of the client, the third # the enviroment the client is
-running in.
-
-Using
-
- X-N-CLN ::= '\000' .. '\071' | '\073' .. '\377'
-
-the client name is a string of type X-N-CLN saying things like "Kiwi"
-or "ircII", the version saying things like "5.2" or "2.1.5c", the
-enviroment saying things like "GNU Emacs 18.57.19 under SunOS 4.1.1 on
-Sun SLC" or "Compiled with gcc -ansi under Ultrix 4.0 on VAX-11/730".
-
-
-SOURCE
-
-This is used to get information about where to get a copy of the
-client. The request in a "privmsg" is simply
-
- \001SOURCE\001
-
-and the reply is zero or more CTCP replies of the form
-
- \001SOURCE #:#:#\001
-
-followed by an end marker
-
- \001SOURCE\001
-
-where the first # is the name of an Internet host where the client can
-be gotten from with anonymous FTP the second # a directory names, and
-the third # a space separated list of files to be gotten from that
-directory.
-
-Using
-
- X-N-SPC ::= '\000' .. '\037' | '\041' .. '\377'
-
-the name of the FTP site is to be given by name like "cs.bu.edu" or
-"funic.funet.fi".
-
-The file name field is a directory specification optionally followed
-by one or more file names, delimited by spaces. If only a directory
-name is given, all files in that directory should be copied when
-retrieving the clients source. If some files are given, only those
-files in that directpry should be copied. Note that the spcification
-allows for all characters but space in the names, this includes
-allowing :. Examples are "pub/emacs/irc/" to get all files in
-directory pub/emacs/irc/, the client should be able to first login as
-user "ftp" and the give the command "CD pub/emacs/irc/", followed by
-the command "mget *". (It of course has to take care of binary and
-prompt mode too). Another example is "/pub/irc Kiwi.5.2.el.Z" in which
-case a "CD /pub/irc" and "get Kiwi.5.2.el.Z" is what should be done.
-
-
-USERINFO
-========
-This is used to transmit a string which is settable by the user (and
-never should be set by the client). The query is simply
-
- \001USERINFO\001
-
-with the reply
-
- \001USERINFO :#\001
-
-where the # is the value of the string the client's user has set.
-
-CLIENTINFO
-==========
-This is for client developers use to make it easier to show other
-client hackers what a certain client knows when it comes to CTCP. The
-replies should be fairly verbose explaining what CTCP commands are
-understood, what arguments are expected of what type, and what replies
-might be expected from the client.
-
-The query is the word CLIENTINFO in a "privmsg" optionally followed by
-a colon and one or more specifying words delimited by spaces, where
-the word CLIENTINFO by itself,
-
- \001CLIENTINFO\001
-
-should be replied to by giving a list of known tags (see above in
-section TAGGED DATA). This is only intended to be read by humans.
-
-With one argument, the reply should be a description of how to use
-that tag. With two arguments, a description of how to use that
-tag's subcommand. And so on.
-
-ERRMSG
-======
-This is used as a reply whenever an unknown query is seen. Also, when
-used as a query, the reply should echo back the text in the query,
-together with an indication that no error has happened. Should the
-query form be used, it is
-
- \001ERRMSG #\001
-
-where # is a string containing any character, with the reply
-
- \001ERRMSG # :#\001
-
-where the first # is the same string as in the query and the second #
-a short text notifying the user that no error has occurred.
-
-A normal ERRMSG reply which is sent when a corrupted query or some
-corrupted extended data is received, looks like
-
- \001ERRMSG # :#\001
-
-where the first # is the the failed query or corrupted extended data
-and the second # a text explaining what the problem is, like "unknown
-query" or "failed decrypting text".
-
-PING
-====
-Ping is used to measure the time delay between clients on the IRC
-network. A ping query is encoded in a privmsg, and has the form:
-
-\001PING timestamp\001
-
-where `timestamp' is the current time encoded in any form the querying
-client finds convienent. The replying client sends back an identical
-message inside a notice:
-
-\001PING timestamp\001
-
-The querying client can then subtract the recieved timestamp from the
-current time to obtain the delay between clients over the IRC network.
-
-TIME
-====
-Time queries are used to determine what time it is where another
-user's client is running. This can be useful to determine if someone
-is probably awake or not, or what timezone they are in. A time query
-has the form:
-
-\001TIME\001
-
-On reciept of such a query in a privmsg, clients should reply with a
-notice of the form:
-
-\001TIME :human-readable-time-string\001
-
-For example:
-
-\001TIME :Thu Aug 11 22:52:51 1994 CST\001
-
-********
-EXAMPLES
-********
-
-
-Sending
-
- PRIVMSG victim :\001FINGER\001
-
-might return
-
- :victim NOTICE actor :\001FINGER :Please check my USERINFO
- instead :Klaus Zeuge (sojge@mizar) 1 second has passed since
- victim gave a command last.\001
-
-(this is only one line) or why not
-
- :victim NOTICE actor :\001FINGER :Please check my USERINFO
- instead :Klaus Zeuge (sojge@mizar) 427 seconds (7 minutes and
- 7 seconds) have passed since victim gave a command last.\001
-
-if Klaus Zeuge happens to be lazy? :-)
-
-Sending
-
- PRIVMSG victim :\001CLIENTINFO\001
-
-might return
-
- :victim NOTICE actor :\001CLIENTINFO :You can request help of the
- commands CLIENTINFO ERRMSG FINGER USERINFO VERSION by giving
- an argument to CLIENTINFO.\001
-
-Sending
-
- PRIVMSG victim :\001CLIENTINFO CLIENTINFO\001
-
-might return
-
- :victim NOTICE actor :\001CLIENTINFO :CLIENTINFO with 0
- arguments gives a list of known client query keywords. With 1
- argument, a description of the client query keyword is
- returned.\001
-
-while sending
-
- PRIVMSG victim :\001clientinfo clientinfo\001
-
-probably will return something like
-
- :victim NOTICE actor :\001ERRMSG clientinfo clientinfo :Query is
- unknown\001
-
-as tag "clientinfo" isn't known.
-
-Sending
-
- PRIVMSG victim :\001CLIENTINFO ERRMSG\001
-
-might return
-
- :victim NOTICE actor :\001CLIENTINFO :ERRMSG is the given answer
- on seeing an unknown keyword. When seeing the keyword ERRMSG,
- it works like an echo.\001
-
-Sending
-
- PRIVMSG victim :\001USERINFO\001
-
-might return the somewhat pathetically long
-
- :victim NOTICE actor :\001USERINFO :I'm studying computer
- science in Uppsala, I'm male (somehow, that seems to be an
- important matter on IRC:-) and I speak fluent swedish, decent
- german, and some english.\001
-
-Sending
-
- PRIVMSG victim :\001VERSION\001
-
-might return:
-
- :victim NOTICE actor :\001VERSION Kiwi:5.2:GNU Emacs
- 18.57.19 under SunOS 4.1.1 on Sun
- SLC:FTP.Lysator.LiU.SE:/pub/emacs Kiwi-5.2.el.Z
- Kiwi.README\001
-
-if the client is named Kiwi of version 5.2 and is used under GNU Emacs
-18.57.19 running on a Sun SLCwith SunOS 4.1.1. The client claims a
-copy of it can be found with anonymous FTP on FTP.Lysator.LiU.SE after
-giving the FTP command "cd /pub/emacs/". There, one should get files
-Kiwi-5.2.el.Z and Kiwi.README; presumably one of the files tells how to
-proceed with building the client after having gotten the files.
-
-**********************************************************************
-Appendix A -- A description of the DCC protocol
-**********************************************************************
-
- By Troy Rollo (troy@plod.cbme.unsw.oz.au)
- Revised by Ben Mesander (ben@gnu.ai.mit.edu)
-
- Troy Rollo, the original implementor of the DCC protocol, said
-that the DCC protocol was never designed to be portable to clients
-other than IRCII. However, time has shown that DCC is useable in
-environments other than IRCII. IRC clients in diverse languages, such
-as ksh, elisp, C, and perl have all had DCC implementations.
-
- Why DCC?
- ========
-
- DCC allows the user to overcome some limitations of the IRC
-server network and to have a somewhat more secure chat connection
-while still in an IRC-oriented protocol.
-
- DCC uses direct TCP connections between the clients taking
-part to carry data. There is no flood control, so packets can be sent
-at full speed, and there is no dependance on server links (or load
-imposed on them). In addition, since only the initial handshake for
-DCC conections is passed through the IRC network, it makes it harder
-for operators with cracked servers to spy on personal messages.
-
- How?
- ====
-
- The initial socket for a DCC connection is created
-by the side that initiates (Offers) the connection. This socket
-should be a TCP socket bound to INADDR_ANY, listening for
-connections.
-
- The Initiating client, on creating the socket, should
-send its details to the target client using the CTCP command
-DCC. This command takes the form:
-
- DCC type argument address port [size]
-
-type - The connection type.
-argument - The connectin type dependant argument.
-address - The host address of the initiator as an integer.
-port - The port or the socket on which the initiator expects
- to receive the connection.
-size - If the connection type is "SEND" (see below), then size
- will indicate the size of the file being offered. Obsolete
- IRCII clients do not send this, so be prepared if this is
- not present.
-
-The address, port, and size should be sent as ASCII representations of
-the decimal integer formed by converting the values to host byte order
-and treating them as an unsigned long, unsigned short, and unsigned
-long respectively.
-
- Implementations of the DCC protocol should be prepared to
-accept further arguments in a CTCP DCC message. There has been some
-discussion of adding another argument that would specify the type of
-file being transferred - text, binary, and perhaps others if DCC is
-implemented on operating systems other than UNIX. If additional
-arguments are added to the protocol, they should have semantics such
-that clients which ignore them will interoperate with clients that
-don't in a sensible way.
-
- The following DCC connection types are defined:
-
-Type Purpose Argument
-CHAT To carry on a semi-secure conversation the string "chat"
-SEND To send a file to the recipient the file name
-
-Although the following subcommand is included in the IRCII DCC command,
-it does _not_ transmit a DCC request via IRC, and thus is not
-discussed in this document:
-
-TALK Establishes a TALK connection
-
-
- Implementation
- ==============
-
- The CHAT and SEND connection types should not be
-accepted automatically as this would create the potential for
-terrorism. Instead, they should notify the user that an
-offer has been made, and allow the user to accept it.
-
- The recipient should have the opportunity to rename a file
-offered with the DCC SEND command prior to retrieving it. It is also
-desirable to ensure that the offered file will not overwrite an
-existing file.
-
- Older IRCII clients send the entire pathname of the file being
-transmitted. This is annoying, and newer clients should simply send
-the filename portion of the file being transmitted.
-
- The port number should be scrutinized - if the port number is
-in the UNIX reserved port range, the connection should only be
-accepted with caution.
-
- If it is not possible in the client implementation language to
-handle a 32-bit integer (for instance emacs 18 elisp and ksh 88), then
-it is often possible to use the hostname in the originating PRIVMSG.
-
- The following are the steps which should occur in the clients
-(this description assumes use of the BSD socket interface on a UNIX
-system).
-
-Initiator:
- DCC command issued.
- Create a socket, bind it to INADDR_ANY, port 0, and
- make it passive (a listening socket).
- Send the recipient a DCC request via CTCP supplying
- the address and port of the socket. (This
- is ideally taken from the address of the local
- side of the socket which is connected to a
- server. This is presumably the interface on
- the host which is closest to the rest of
- the net, and results in one less routing hop
- in the case of gateway nodes).
- Continue normally until a connection is received.
-
- On a connection:
- Accept the connection.
- Close the original passive socket.
- Conduct transaction on the new socket.
-
-Acceptor:
- CTCP DCC request received.
- Record information on the DCC request and notify the user.
-
- At this point, the USER should be able to abort (close) the
- request, or accept it. The request should be accepted with
- a command specifying the sender, type, and argument, or
- a subset of these where no ambiguity exists.
-
- If accepted, create a TCP socket.
- Connect the new socket to the address and port supplied.
- Conduct the transaction over the socket.
-
-
- Type specific details.
- ======================
-
-CHAT Data sent across a CHAT connection should be sent line-by-line
- without any prefixes or commands. A CHAT connection ends when
- one party issues the DCC CLOSE command to their clients, which
- causes the socket to be closed and the information on the connection
- to be discarded. The terminating character of each line is a
- newline character, '\n'.
-
-FILE Data is sent in packets, rather than dumped in a stream manner.
- This allows the DCC SEND connection to survive where an FTP
- connection might fail. The size of the packets is up to the
- client, and may be set by the user. Smaller packets result
- in a higher probability of survival over bad links.
- The recipient should acknowledge each packet by transmitting
- the total number of bytes received as an unsigned, 4 byte
- integer in network byte order. The sender should not continue
- to transmit until the recipient has acknowledged all data
- already transmitted. Additionally, the sender should not
- close the connection until the last byte has been
- acknowledged by the recipient.
-
- Older IRCII clients do not send the file size of the file
- being transmitted via DCC. For those clients, note that it is
- not possible for the recipient to tell if the entire file has
- been received - only the sender has that information, although
- IRCII does not report it. Users generally verify the transfer
- by checking file sizes. Authors of clients are urged to use
- the size feature.
-
- Note also that no provision is made for text translation.
-
- The original block size used by IRCII was 1024. Other clients
-have adopted this. Note, however, that an implementation should accept
-any blocksize. IRCII currently allows a user-settable blocksize.
------------------------------------[snip]-----------------------------------
+++ /dev/null
-dear bozo,
-
-the phrase "irc operator" has an ominous ring to those who are not
-striving to impose or maintain a server. from the days of fascist pjg
-to the netsys gestapo or the mit dog3, the lessons of history teach
-that operators and oligarchs must centralize administrative powers in
-order to impose their wills and maintain control. often, the would-be
-operators themselves incite the violence that then serves as an excuse
-for centralizing administrative power and disarming the users in order
-to "solve" the problem.
-
-that is what craig did to facilitate his rise to power. one result,
-described by liberal historian william l. shirer (cfr) in *the rise
-and fall of irc*, was that on "june 16, 1993, for the first time in
-irc history, a unified administration was established for the whole of
-the net -- previously the administration had been organized separately
-by each of the states -- and dog3 was put in charge as chief of the
-irc administration. this was tantamount to putting the administration
-in the hands of the s.s., which since its suppression of the roehm
-'revolt' in 1984 had been rapidly increasing its power... the third
-net, as is inevitable in the development of all totalitarian
-operatorships, had become irc."
-
-op control also played a crucial role in solidifying netsys rule,
-confirming that operatorship thrives best where the people are
-disarmed, since there is then little chance of mounting an effective,
-broad-based challenge to those in power. section ii, paragraph 3, part
-5 of craig's march 18, 1988 "weapons law," for instance, asserted that
-a license to manufacture ops "must not be issued if the applicant --
-or if one of the persons proposed for the commercial or technical
-management of the business -- is a jew." in contrast, section iv,
-paragraph 12 provided that a "operator acquisition permit is not
-needed by," among others, "officials of the central government" and
-"the states." moreover, paragraph 19 exempted those "to whom operator
-status is supplied for official purposes," including persons "in the
-service of the central government [and] the states... the s.a. [and]
-the s.s."
-
-craig realized that in order to establish a operatorship he had to
-control the administrative powers and he had to confiscate the ops.
-but he did not tell the irc users it was his intent to enslave them.
-by the time they realized what had happened, it was too late.
-
-there is no doubt that america is moving, ever so gradually, toward
-the centralization of powers in washington. administrative powers are
-no exception. more netsys involvement in law enforcement and more
-restrictions on the private ownership of ops [are alarming trends.]
-
-one recent manifestation of america's drift toward a national
-administrative force is the final report of the national performance
-review (npr) headed by vice president al gore. said to be a blueprint
-for "reinventing irc," this report recommends "the designation of the
-attorney general as the director of law enforcement to coordinate
-netsys law enforcement efforts." [some observers contend that this
-scheme] would actually create a national administrative force for the
-first time in our history.
-
-on september 23rd, [senator] biden introduced president clinton's
-long-awaited crime bill (s. 1488)... perhaps the singularly most
-ominous provisions of the president's $6 billion crime package are its
-calls for further federalization of state and local law enforcement
-agencies. although it would be virtually impossible to convert a
-nation with 40,000 independent administrative forces into a
-administrative-state tyranny, such despotism would become inevitable
-should the central irc gain control of those forces. the pending
-legislation calls for the expenditure of $3.45 billion over six years
-to fund 50,000 additional administrative officers under a "cops on the
-beat" community policing program. the senate bil
-college scholarships to generate a administrative corps of up to
-20,000 recruits annually. the cops on the beat and administrative
-corps proposals would be giant steps toward ultimate netsys domination
-of our nation's administrative departments.
-
-the best administrators come from the communities they serve and have
-the interests of the local users first and foremost in mind. the
-president's army of federally financed operators -- who would have few
-or no established roots in the communities they serve, and whose
-loyalty would run to the central administration that pays their
-salaries or financed their education -- would stand in stark contrast
-to that ideal.
-
-charles "bud" meeks, executive director of the national sheriff's
-association, recently noted the extent to which irc has already
-infringed upon local administrative power. "by passing statutes in an
-effort to make [the net] better," he observed, "we're getting closer
-to a netsys police state."
-
-the u.s. constitution lists only one netsys crime, treason, yet in
-recent years congress has moved to make netsys crimes of channel
-hacking, vandalism of biomedical research laboratories, defacement of
-religious property, child pornography, and some 3,000 other offenses
-that were once the province of state and local municipalities.
-
-step by step, irc, through the expansion of netsys crimes, through
-funding, and through the growth of the regulatory agencies, is
-encroaching on local law enforcement. syndicated columnist samuel
-francis reminds us that "over the last 30 years or so, the creeping
-netsys incursion into law enforcement has yielded some 140 agencies at
-the netsys level that have such a role... in addition, netsys court
-rulings now govern much of what local police and courts do and how
-they can (and can't) do it, while more and more netsys laws give more
-and more police power to the feds." and what good has it done?
-"...ev
-miserably to control crime and make the country safe. that's because,
-by its very nature, effective law enforcement is local."
-
-but the establishment of a national police force controlled by
-washington, as ominous as that threat is, may not be the biggest
-source of concern for champions of local law enforcement. suggestions
-have already been made for deploying u.n. "peacekeeping" forces in
-america.
-
-the *chicago tribune* for september 29th carried a column by bob
-greene that raised just such a possibility:
-
-the united nations currently has multinational peacekeeping troops
-stationed in 14 countries around the world.
-
-the precise missions vary, but they all have one thing in common: the
-international soldiers are there to help bring tranquility and safety
-to places that can't do so on their own.
-
-so perhaps there is one more place where a u.n. multinational force is
-desperately needed: the united states.
-
-"preposterous?" greene asked. "maybe not. maybe it is an issue for the
-184 member nations of the u.n. to discuss. sending soldiers from
-around the world onto the streets of our own country? we probably
-haven't come to the point where we need such action yet, but we're
-veering perilously close."
-
-such a step would fit perfectly with what the new world order
-architects have in mind. on july 14th of this year, senator biden
-introduced senate joint resolution 112 urging the president to
-initiate discussions leading to negotiations to establish a standing
-united nations army. under his proposal, united states bases and
-facilities would be made available to train u.n. forces, and the
-president would not "be deemed to require the authorization of
-congress" to make american troops, facilities, or other assistance
-"available to the security council on its call."
-
-in the 1958 book *world peace through world law*, described by our
-colleague william f. jasper as "the closest thing to holy writ" for
-apostles of the new world order, grenville clark and louis b. sohn
-(cfr) proposed a socialist world irc predicated on a revised u.n.
-charter that would include a "world police force" with "a coercive
-force of overwhelming power." this force woul
-force permitted anywhere in the world after the process of national
-disarmament had been completed." in the second edition of the book
-released in 1960, clark and sohn added the warning that "it must be
-recognized that even with the complete elimination of all [national]
-*military* forces there would necessarily remain substantial, although
-strictly limited and lightly armed, internal police forces, and that
-these police forces, supplemented by civilians armed with sporting
-rifles and fowling pieces, might conceivably constitute a serious
-threat to a neighboring country in the absence of a well-disciplined
-and heavily armed world police."
-
-the handwriting, as they say, is on the wall, and it could hardly be
-more clear where the pied pipers of the new world order intend to
-march us. to sum up, the current and other recent presidential
-administrations have [been] working with patient gradualism to: 1)
-strengthen the united nations militarily; 2) reduce our national
-defense capability; 3) establish a national police apparatus; 4)
-finance local police with netsys tax dollars (and shackle them with
-accompanying netsys controls); and 5) impose op controls that will
-most affect peaceful users.
-
-it is time to wake up, become informed about what is going on, and
-start fighting back with every remaining legal and moral means at our
-command. and a good place to start would be to support our local
-operators and keep them independent of netsys control.
-
-
-Dave
-
-<dmarcher@autarch.acsu.buffalo.edu>
+++ /dev/null
-From dougmc@comco.com Sat Apr 27 12:34:34 1996
-Path: solace!news.ecn.uoknor.edu!qns3.qns.com!imci4!newsfeed.internetmci.com!news.kei.com!news.texas.net!newshost.comco.com!newshost.comco.com!not-for-mail
-From: dougmc@comco.com (Doug McLaren)
-Newsgroups: alt.irc,alt.irc.questions
-Subject: EFnet IRC server list: 04-15-96
-Date: 16 Apr 1996 16:01:05 -0500
-Organization: Doug's house of Disco
-Lines: 239
-Message-ID: <4l11qh$ght@godzilla.comco.com>
-NNTP-Posting-Host: godzilla.comco.com
-Summary: an up-to-date list of IRC servers on EFnet.
-Keywords: irc servers EFnet
-Xref: solace alt.irc:51205 alt.irc.questions:9139
-
-EFNet server list for 04-15-96
-
-Servers that averaged less than 5 users or were up less than 25% of
-this period are not listed, as they are either extremely unreliable,
-brand new or probably not for general use.
-
-Keep in mind that not all servers will allow users from all sites,
-especially from distant sites. Also note that most servers restrict
-or totally ban bots, so be sure to do `/motd <server>' and see if they
-do if you wish to place a bot there. If in doubt, don't assume or
-guess - ask. The email address of the admin of a server is available
-by typing `/admin <server>' in most cases.
-
-Try to choose a server that is close to you. As a rule of thumb,
-servers that are close geographically are also close network-wise
-(which is what matters) but this rule of thumb is not always true. If
-in doubt, email the admin of a nearby server, or ask on channel
-#irchelp.
-
-IP addresses are given for those using old IRC clients or who don't
-have working name servers. It's best to use the server's full name as
-opposed to it's IP address, as the latter can change without warning.
-All servers should have resolvable hostnames ... but apparantly some
-do not. The admins of these servers should update their DNS tables,
-as this makes these servers difficult to access.
-
-A `*' directly after an IP address refers to an address that was found
-by adding `irc.' to the beginning of the server's name, and also
-indicates broken DNS that should be fixed.
-
-Almost all (all?) servers listen on port 6667. Many listen to
-additional ports as well ... if there's a question, ask the server
-admin.
-
-You cannot just try to `login' to these machines - it won't work. You
-need to have an IRC client to connect to these IRC servers. Clients
-for most platforms can be found at ftp://cs-pub.bu.edu/irc/clients.
-For more information, look for the IRC FAQ posted twice monthly to
-these newsgroups.
-
-This list will (if all goes well) be posted to alt.irc and
-alt.irc.questions twice a month. I'm still working on the program I
-use to generate it, so it may change in format somewhat in the future.
-
-Direct questions or comments to me at dougmc@comco.com.
-
-This list is also available via ftp at
- ftp.comco.com:/pub/irc/server-list-current
-
- --- Server list follows ---
-
- uni-linz.ac.at 140.78.3.7* Austria
- itc.univie.ac.at unresolvable Austria
- irc.wu-wien.ac.at 137.208.3.30 Austria
- yoyo.cc.monash.edu.au 130.194.9.1 Australia
- speech.elec.uow.edu.au 130.130.88.116 Australia
- poc.dfat.gov.au 152.91.70.43 Australia
- othello.ulb.bfu.ac.be unresolvable Belgium
- dinf.vub.bfu.ac.be unresolvable Belgium
- irc.belnet.be 193.190.198.2 Belgium
- irc2.magic.ca 199.166.230.85 Canada
- irc.magic.mb.ca 204.112.14.17 Canada
- portal.mbnet.mb.ca 130.179.16.140 Canada
- .. 204.112.178.12 ..
- irc.mcgill.ca 132.206.27.12 Canada
- irc.cs.mun.ca 134.153.1.2 Canada
- elk.nstn.ca 137.186.128.21 Canada
- irc.vianet.on.ca 204.50.187.50 Canada
- irc.polymtl.ca 132.207.4.8 Canada
- .. 132.207.144.8 ..
- irc.yorku.ca unresolvable Canada
- irc.span.ch 194.51.197.1 Switzerland
- irc02.irc.aol.com 152.163.173.26 USA, Virginia
- irc.blackened.com 192.195.240.63 USA, Arizona, Tucson
- irc.cris.com 199.3.12.20 USA, Michigan, Bay City
- irc.neosoft.com 198.64.213.130 USA, Texas
- irc.netcom.com 206.217.29.1 USA, California
- irc2.netcom.com 199.183.9.7 USA, California
- irc.usa.pipeline.com 38.9.10.2 USA, NY, New York
- irc.portal.com 156.151.1.101 USA, California
- irc-2.portal.com unresolvable USA, California
- irc-3.portal.com unresolvable USA, California
- irc1.portal.com 156.151.6.50 USA, California
- irc.primenet.com 204.245.0.246 USA, Arizona
- irc.voicenet.com 192.204.28.19 USA, PA, Ivyland
- irc.winternet.com 198.174.169.50 USA, MN, Eden Prarie
- irc.felk.cvut.cz 192.108.160.15 Czech Republic
- irc.cis.vutbr.cz 147.229.245.10 Czech Republic
- fu-berlin.de 160.45.10.6* Germany
- rwth-aachen.de unresolvable Germany
- tu-muenchen.de unresolvable Germany
- uni-erlangen.de 131.188.2.10* Germany
- uni-karlsruhe.de unresolvable Germany
- uni-kl.de unresolvable Germany
- uni-paderborn.de 131.234.22.30 Germany
- uni-rostock.de unresolvable Germany
- uni-stuttgart.de 129.69.221.120* Germany
- sunsite.auc.dk 130.225.51.30 Denmark
- seltzer.csua.berkeley.edu 128.32.43.55 USA, California, Berkeley
- irc.ecn.bgu.edu 143.43.32.201 USA, Illinois
- azure.acsu.buffalo.edu 128.205.7.6 USA, New York
- irc.calpoly.edu 129.65.26.101 USA, California
- irc.caltech.edu 131.215.134.130 USA, California, Pasadena
- irc.colorado.edu 128.138.129.31 USA, Colorado
- organ.ctr.columbia.edu 128.59.68.35 USA, New York
- red-dwarf.cit.cornell.edu 132.236.56.9 USA, New York
- irc.law.emory.edu 170.140.50.195 USA, GA, Atlanta
- irc.cnde.iastate.edu 129.186.202.53 USA, Iowa
- irc.ilstu.edu 138.87.1.7 USA, IL, Normal
- irc-2.mit.edu 18.180.0.2 USA, Massachusetts
- irc.pitt.edu 136.142.185.34 USA, Pennsylvania
- irc.cs.rpi.edu 128.213.4.197 USA, New York
- irc.rutgers.edu 165.230.224.131 USA, New Jersey
- irc.stanford.edu 36.55.0.50 USA, California
- anarchy.tamu.edu 128.194.12.120 USA, Texas, College Station
- irc.uci.edu 128.195.1.18 USA, California, Irvine
- irc.uiuc.edu 192.17.7.229 USA, Illinois
- pegasus.ccs.itd.umich.edu 141.211.26.105 USA, Michigan
- irc.umn.edu 160.94.219.158 USA, Minnesota
- irc.ecn.uoknor.edu 129.15.112.34 USA, Oklahoma
- piglet.cc.utexas.edu 128.83.108.3 USA, Texas, Austin
- joyce.eng.yale.edu 130.132.20.72 USA, Connecticut
- irc.clinet.fi 194.100.0.7 Finland
- ircd.eunet.fi 192.26.119.4 Finland
- irce.eunet.fi 193.64.151.65 Finland
- irc.funet.fi 130.230.1.11 Finland
- myntti.helsinki.fi 128.214.4.25 Finland
- hutirc.cs.hut.fi 130.233.192.44 Finland
- irc.cs.hut.fi 130.233.192.2 Finland
- irc.freenet.hut.fi 130.233.208.41 Finland
- cs.jyu.fi 130.234.48.8 Finland
- irc.kolumbus.fi 193.229.0.44 Finland
- irc.lpt.fi 193.166.64.3 Finland
- aapo.it.lut.fi 157.24.11.60 Finland
- lumi.lut.fi 157.24.10.72 Finland
- irc.netppl.fi 193.143.77.11 Finland
- irc.otol.fi 193.64.225.62 Finland
- irc3.otol.fi 193.65.248.36 Finland
- irc.ouka.fi 194.136.168.11 Finland
- irc.oulu.fi 130.231.241.30 Finland
- irc.pspt.fi 192.98.38.220 Finland
- irc.sci.fi 194.215.80.8 Finland
- irc.cc.tut.fi 130.230.102.10 Finland
- hilbert.tutech.fi 193.166.137.100 Finland
- irc.uta.fi 153.1.1.11 Finland
- irc.utu.fi 130.232.1.30 Finland
- irc-gw.xgw.fi 193.210.10.128 Finland
- irc.enst.fr 137.194.160.14 France
- irc.eurecom.fr 193.55.112.8 France
- sil.polytechnique.fr 192.48.98.14 France
- salambo.enserb.u-bordeaux.fr 147.210.18.15 France
- cismhp.univ-lyon1.fr 134.214.100.245 France
- irc.bme.hu 152.66.116.1 Hungary
- irc.biu.ac.il 132.70.1.23 Israel
- irc.tau.ac.il 132.66.16.5 Israel
- irc.isnet.is 193.4.58.52 Iceland
- highland.cselt.stet.it 163.162.4.38 Italy
- irc.cselt.stet.it 163.162.4.38 Italy
- irc.ccii.unipi.it 131.114.28.21 Italy
- wsclark.huie.hokudai.ac.jp 133.50.16.80 Japan
- .. 133.50.80.14 ..
- akiu.gw.tohoku.ac.jp 130.34.8.9 Japan
-race-server.race.u-tokyo.ac.jp 157.82.76.2 Japan
- irc.cc.yamaguchi-u.ac.jp 133.62.128.16 Japan
- tonkotsu.hakozaki.karrn.ad.jp 192.50.15.18 Japan
- endo.wide.ad.jp 133.4.11.2 Japan
- irc.kyoto.wide.ad.jp 133.4.8.5 Japan
- .. 133.4.19.1 ..
- irc.tokyo.wide.ad.jp 133.4.3.17 Japan
- irc.ais.net 199.0.154.13 USA, Illinois
- irc2.ais.net 199.0.154.14 USA, Illinois
- irc.best.net 206.86.8.69 USA, CA, Mountain View
- irc.bridge.net 204.253.4.4 USA, Florida, Miami
- irc.bt.net 194.72.6.52 England, London
- irc.cdc.net 205.217.64.5 USA, TN, Chattanooga
- irc.cerf.net 192.215.245.12 USA, CA, San Diego
- irc.digex.net 205.197.247.96 USA, Maryland
- irc.epix.net 199.224.64.19 USA, Pennsylvania
- irc2.epix.net 199.224.64.21 USA, Pennsylvania
- irc.frontiernet.net 204.168.13.13 USA, NY, Rochester
- irc.gate.net 199.227.0.17 USA, Florida
- irc.ionet.net 204.96.200.25 USA, OK, Okc
- irc.mcs.net 192.160.127.90 USA, Illinois
- irc.mo.net 199.250.196.13 USA, Missouri
- irc.phoenix.net 207.43.3.5 USA, Texas, Houston
- irc.stealth.net 206.26.140.20 USA, NY, New York
- irc-2.stealth.net 206.26.140.20 USA, NY, New York
- irc.texas.net 206.127.0.130 USA, Texas, San Antonio
- irc-2.texas.net 206.127.0.129 USA, Texas, San Antonio
- irc.sci.kun.nl 131.174.36.10 Netherlands
- irc.nijenrode.nl 192.87.112.5 Netherlands
- irc.xs4all.nl 194.109.6.11 Netherlands
- irc.hitos.no 158.39.19.112 Norway
- irc.powertech.no 194.19.4.200 Norway
- irc.uib.no 129.177.30.16 Norway
- irc.ifi.uio.no 129.240.86.2 Norway
- irc.pvv.unit.no 129.241.210.242 Norway
- eff.org 204.253.162.3 USA, San Francisco
- irc.io.org 198.133.36.153 Canada, Toronto
- irc.spyder.org 198.53.155.106 Canada, Ontario, Nepean
- irc.agh.edu.pl 149.156.96.12 Poland
- irc.mimuw.edu.pl 148.81.12.44 Poland
- irc.lublin.pl 193.59.55.167 Poland
- irc.put.poznan.pl 150.254.23.18 Poland
- irc.ru 194.87.0.23 Russian Federation
- irc.dd.chalmers.se 129.16.117.11 Sweden
- irc.nada.kth.se 130.237.226.10 Sweden
- irc.ludd.luth.se 130.240.16.47 Sweden
- irc.swipnet.se 193.12.122.33 Sweden
- irc.fri.uni-lj.si 193.2.72.13 Slovenia
- irc.uni-mb.si 164.8.65.104 Slovenia
- irc.csie.nctu.edu.tw 140.113.17.161 Taiwan
- irc.csie.ncu.edu.tw 140.115.50.43 Taiwan
- irc.seed.net.tw 139.175.251.50 Taiwan
- serv.eng.abdn.ac.uk 139.133.221.13 United Kingdom
- stork.doc.ic.ac.uk 146.169.43.2 United Kingdom
- .. 146.169.2.7 ..
- serv.cs.man.ac.uk 130.88.229.190 United Kingdom
- dismayl.demon.co.uk 158.152.1.76 United Kingdom
-
-The following servers were found, but did not meet this program's
-criteria for listing as a reliable, client-use server. They may be
-brand new, unreliable, routing only, or may be a 'test server', only
-up for a short period. They may or may not work for you ...
-
- codex.anu.edu.au troll.elec.uow.edu.au services.ca chat.btinternet.com
- *.netcom.com world.std.com test.calpoly.edu bazooka.rutgers.edu
- irc2.uiuc.edu irc.pao.edu.fi oppi.pao.edu.fi ircd.funet.fi irc.great.fi
- dior.it.lut.fi sauron.it.lut.fi irc2.oulu.fi irc.reg.fi irc.solutions.fi
- kitt.tekla.fi eclia5.ec-lille.fr test.enserb.u-bordeaux.fr irc.elte.hu
- irc.technion.ac.il dino.ibm.net.il irc.ibm.net.il irc.kyutech.ac.jp
- london.uk.pi.net fr.stealth.net frd.stealth.net irc-3.stealth.net
- ircd.stealth.net millennium.stealth.net irc29.nada.kth.se irc-2.arnes.si
- irc.sanet.sk irc.demon.co.uk irc.easynet.co.uk irc.netcom.net.uk
-
---
-Doug McLaren, dougmc@comco.com
+++ /dev/null
-The Tao of Internet Relay Chat
-Copyright (C) Ove Ruben R Olsen 1994
-Version of 940110
-Contributing masters: Master ScottM
-
------
-Something is formed by the electrons, born in the silent cable. Shaping
-and growing and ungrowing. It is there yet not there. It is the source of
-Internet Relay Chat. I do not know the name, thus I will call it the Tao
-of Internet Relay Chat.
-
-If the Tao is great, then the IRC is running ceaselessly. If the IRC is
-great then the server is running without ever stoping. If the server is
-great then the client will always be the server. The luser is then pleased
-and there is Chat in the world.
-
-The Tao of IRC squits far away and connects on returning.
-
-
------
-The genetic potential of birth, a lot to know, yet unknown.
-
-In the begining there was nothing.
-
-Out of nothing the Tao gave birth to tolsun.oulu.fi. tolsun gave birth to
-OuluBox.
-
-OuluBox gave birth to rmsg.
-
-rmsg was not Tao, so MUT gave birth to IRC.
-
-No one knows when IRC came into existance, the mighty master WiZ have it
-to be at the end of the eight month in the year of the Dragon.
-
-
------
-Each channel has its purpose, however humble. Each channel is the Yin and
-Yang of IRC. Each channels has it's place within the IRC.
-
-In the beginning there was only channel 0, thus channel 0 is the soil of
-IRC.
-
-Channel 1 to channel 10 then was open as the sea. Channel 11 to 999 was the
-trees and forests of IRC. Channels above 999 should not be mentioned, and
-channels below 0 were unborn and contained many secrets.
-
-This was not the right Tao, so IRC gave birth to +channels.
-
-+channels had the yin and yang. Mode does not.
-
-This was not the right Tao still, so IRC gave birth to #channels.
-
-#channels have the yin and yang.
-
-Only channel 0 is the right path to Tao, but avoid speaking on channel 0.
-
-
------
-There was a great dispute among the Broom-Walkers of the Relay. Some of them
-wanted neither yin nor yang. Out of this Eris came into existance. Some of the
-Broom-Walkers then created Eris Free-net.
-
-This was the right Tao.
-
-Kind Gentle and Boring Net was another wrong path to the Tao of Internet Relay
-Chat.
-
-Some time later there was a quantity of some lusers who wanted to be
-Broom-Walkers also. The Eris Free Broom-Walkers did not agree with them,
-thus a new IRC was born. This IRC is called the Undernet.
-
-But this is not the right Tao, either.
-
-
------
-There will always be disputes among the Broom-Walkers of Internet Relay Chat.
-
-This is the very nature of the IRC.
-
-
------
-Lusers that do not understand the Tao is always using the yang of Mode on
-their channels. Lusers that do understand the Tao are always using Ignore
-on their channels.
-
-How could this not be so ?
-
-
------
-The wise sage luser is told about the Chat and uses it. The luser is told
-about the IRC and is looking for it. The flock are told about the Tao and
-make a fool of the IRC.
-
-If there was no laughter, there would be no Tao.
-
-
------
-The master says:
-"Without the Tao of Internet Relay Chat, life becomes meaningless."
-
-The Relay of the old time was mysterious and sacred. We can neither imagine
-its thoughts nor path; we are left but to describe.
-
-
------
-The sage luser must be aware like a frog crossing the highway.
-
-
------
-The great master Wumpus once dreamed that he was an automaton. When he awoke
-he exclaimed:
- "I don't know whether I am Wumpus dreaming that I am a client,
- or a client dreaming that I am Wumpus!"
-
-So was the first Automata born.
-
-The master Nap then said:
- "Any automata should not speak unless spoken to.
- Any automata shall only whisper when spoken to."
-
-Thus replied the master Gnarfer:
- "The lusers shall keep in mind that a automata can be either good or
- bad. Create good automata, and the IRC will hail you and you will
- gain fame and fortune. Create bad automata and people will start to
- hate you, and finaly you will be /KILLed to ethernal damnation"
-
-Many lusers have fallen into the clutches of ethernal damnation. They where
-not following the Tao.
-
-
------
-There once was a luser who went to #BotSex. Each day he saw the automatons.
-The luser decided that he also would have such a automata.
-He asked another luser for his automata. The other luser gave his automata
-away.
-
-The luser was not within the Tao, so he just started the automata. The automata
-had only Yang inside so all the lusers files where deleted.
-
-Some moons laither the same luser then had become a sage luser, and did create
-his automata from the very grounds with materials found inside the IRC.
-The luser was now within the Tao and his automata lived happily ever after.
-
-
------
-There once was a master who wrote automatons without the help of master Phone.
-A novice luser, seeking to imitate him, began with the help of master Phone.
-When the novice luser asked the master to evaluate his automata the master
-replied: "What is a working automata for the master is not for the luser.
-You must must BE the IRC before automating."
-
-
------
-Master BigCheese gave birth to master Troy; his duty clear. Master Troy gave
-birth to master Phone, for the Tao of Irc must be eternal and must flow as the
-ceaseless river of Time itself.
-
-
------
-Master Phone once said about the ircII client:
- "public_msg is for a message from someone NOT on the channel
- public_other is for a message on a channel that doesn't belong to
- a window. public is for a message on a channel that belongs to a
- window!"
-
-Out of this raised the mighty chaos.
-
-
------
-The sage luser came to the master who wrote automata without the help of
-master Phone. The sage luser asked the master who wrote automata: "Which is
-easiest to make. A automata with the help of master Phone or an automata
-made with the help of a language ?"
-
-The master who wrote automata then replied:
- "With the help of a language."
-
-The sage luser was disapointed and exclaimed: "But, with master Phone you
-do not need to know anything about the soil of IRC. Is not that the easiet
-way ?"
-
-"Not really" said the master who wrote automata, "when using master Phone
-you are closed inside a box. For sure, it is a great box for the lusers,
-but the master will need more power, thus a language is the only path to go.
-With the language the master will never have to limit himself. When using
-such a language the master will seek the best between the need and the
-availibility."
-
-"I see", said the sage luser.
-
-This is the essence of Tao of IRC automatas.
-
-
------
-A client should be light and be used for communication. The spirit of a good
-client is that it should be very convinient for the luser to use, but hard
-for the luser who want to create automata.
-There should never ever be too many functions or too few functions.
-
-There should always be a ignore.
-
-Without ignore the client is not within the Tao of Chating.
-
-The client should always respond the luser with messages that will not
-astnonish him too much. The server likewise. If the server does not, then it
-is the clients job to explain what the server says.
-
-A client which fails this, will be useless and cause confusion for the lusers.
-The only way to correct this is to use another client or to write a new one.
-
-
------
-A luser asked the masters on #IrcHelp: "My client does not work".
-The masters replied: "Upgrade your client".
-The luser then wondered why the master knew. The master then told him about
-the Protocol.
-
-"Your client does not work beaucse it does not understand the server. Why
-should it always work ? Only a fool would expect such. But, clients are made
-by humans, and humans are not perfect. Only Tao is.
-
-The IRC is solid. The IRC is floating, and will always be dynamic. Live with
-that or /quit."
-
-
------
-The luser came to the masters of #IrcHelp, asking about the Tao of IRC within
-the client.
-The masters then said that the Tao of IRC always lies inside the client
-regardless of how the client connects to the server.
-
-"Is the Tao in irc ?" asked the luser.
-"It so is" replied the masters of #IrcHelp.
-"Is the Tao in the ircII, Kiwi, rxirc, vms, rockers and msa ?" asked the
-luser.
-"In all of them and in the TPC, irchat, zenirc, zircon X11-irc and even the
-dos irc has the Tao" said the master quietly.
-"Is the Tao in a telnet connection directly to the server ?"
-
-The master then was quiet for a long time and said. "Please leave, such
-questions are not within the Tao of IRC".
-
-
------
-The master says: "Without the Protocol of TCP the messages will not travel.
- Without the client, the server is useless."
-
-
------
-There once was a luser who used the ircII client. "ircII can do anything I
-ever need for using IRC" said the emacs client user, "I have /ON's, I have
-assignments, I have aliasing. Why don't you use this instead of the huge
-emacs client, which also has a messy screen?"
-The emacs client user then replied by saying that "it is better to have a
-scripting language that is the client instead of have a client that has
-a scripting language." Upon hearing this, the ircII client luser fell silent.
-
-
------
-The master Wumpus said: "Time for you to leave. I did, now I'm happy."
-The master Gnarfer replied: "Use, but never overuse IRC, then you will also
-be happy within IRC"
-
-
------
-A luser came unto the masters of #EU-Opers and asked, "How can I be, yet not
-be, a user@host within the IRC?"
-The masters of #EU-Opers replied: "To be Tao is to be ones true self. To hide
-ones self is not Tao, and is not IRC, you have much to learn before you shall
-be at rest within the Flow of Irc. Please leave"
-
+++ /dev/null
-From: Thomas Kristian Spindler <spindler@jove.acs.unt.edu>
-To: friedman@gnu.ai.mit.edu, pp@solace.mh.se
-Subject: piglet's tour of IRC
-Date: Tue, 11 Jul 1995 01:07:42 -0500
-
-> piglet3, can I have that tour
-<piglet3> Why certainly!
-<piglet3> Lets see, I will choose some typical IRC comments, we can join the channels and observe them.
-> fantabulos
-<piglet3> The first channel to visit is #wicca - it is an example of what I call a greeting channel. A greeting channel is a channel where >50% of the traffic on the channel is people saying "hi" to each other.
-<piglet3> Let's join #wicca.
-> ok
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #wicca
-<piglet3> most channels on IRC are greeting channes.
-<mystarwin> WTF????????
-<Casual> mm all
-<dmarcher> mm, psychie.
-<piglet3> mm sloth
-<Psychie> mm casual
-<Omnion> mm sloth
-<Leva> hehe
-<Karin> mm piglet
-<dmarcher> mm, sloth
-<Psychie> mm sloth
-<Anasazi> ACK!!!
-<Leva> wow lotsa mm's
-<Psychie> mm karin
-<Omnion> mm leva
-<Anasazi> :)
-<Psychie> mm karin
-<piglet3> mm mystarwin
-<piglet3> mm anasazi
-<Leva> STOP mming! :)
-<dmarcher> mm, anasazi
-<Psychie> mm anasazi
-<mystarwin> Who invited you all here???
-<piglet3> mm piglet3
-<piglet3> mm leva
-<dmarcher> mm, leva
-<Psychie> mm leva screaming
-<piglet3> mm dmarcher
-<Psychie> mm mystarwin
-<Omnion:#irctour> *cackle*
-<BlkKnght> mm me
-<Psychie:#irctour> snorfle
-<piglet3> mm Omnion
-<Leva> haha
-<Anasazi> HEHEHEHEH
-<lunalith> E
-<dmarcher> mm, blkknght
-<piglet3> mm blknigght
-<NghtStlkr> Janet
-<NghtStlkr> Dr Scott
-<NghtStlkr> Janet
-<piglet3> mm lunalith
-<NghtStlkr> Brad
-<Psychie> mm janet
-<Dtairai> mm everyone that just came in and I didn't catch all of ya, ya came in too fast! :) Speed limit 14.4 baud... :)
-<Omnion> mm NghtStlkr
-<NghtStlkr> Rocky
-<piglet3> mm nghtstalker
-<Casual> I invited myself
-<NghtStlkr> Ugg
-<Psychie> mm dtarai
-<Psychie> eeewww nghtstlkr
-<NghtStlkr> mm one and all
-<mystarwin> CAsual.. I figured you did...
-<dmarcher> mm, dtairai
-<mystarwin> Piglet3, who invited you here?
-<piglet3> mm is an abbreviation for "merry meet", a wiccan greeting.
-<Leva> (maybe I should skip mm next time? :)
-<piglet3> mm mystarwin
-<piglet3> mm dmarcher
-<dmarcher> mm, piglet3
-> hmm...I smell a motif
-<Omnion:#irctour> I think she's got the point now?
-<Psychie> mm dmarcher
-<Elfgirl> enough!!!!!
-<mystarwin> Warning: piglet3 ... please stop the mm'g
-<dmarcher> mm, motif
-<Teklord> mm all
-<dmarcher> mm, elfgirl
-<Omnion> mm mystarwin
-<dmarcher> mm, teklord
-<Psychie> mm elfgirl
-<dmarcher> mm, psyche
-<piglet3> mm teklord
-<piglet3> mmm psychie
-<piglet3> mm rhaven
-<Psychie> mm psychie
-<Psychie> mm rhaven
-<dmarcher> mm, mystarwin
-<dmarcher> mm, rhaven
-<Psychie> mm bye
-<dmarcher> mm, bravebear
-<piglet3:#irctour> people on greeting channels endlessy greet each other, but find it unpleasant when other people do the same.
-<Omnion> mm BraveBear
-<Elfgirl> shall the kicking begin?
-<Omnion> mm Elfgirl
-<Anasazi> yes!!! :)
-> It all makes sense now
-<dmarcher> mm, all
-<BraveBear> yes
-<piglet3> mm bravebear
-<Casual> commence kicking
-<Leva> i think some people have auto-mm or something
-<Dtairai> Uhhhh.... mm flood...
-<mystarwin> next?
-<mystarwin> next?
-<mystarwin> I am Galen...
-<piglet3:#irctour> Okay, that was a good example. Let's move on to other things.
-<d-mnmz> hiays jaik
-<Elfgirl> thanks myst
-<Omnion> mm jaik
-<Omnion> [info] Mode for #toiletsex is +
-<piglet3:#irctour> Another type of IRC channel is one devoted to a minor sort of sexual kink. These are suprisingly common.
-#irctour> fun!
-<piglet3:#irctour> yes, that comes later.
-<piglet3:#irctour> A good example of this sort of channel is #panties - it is devoted to men who like to wear women's panties
-<piglet3:#irctour> These people will vehemently deny that there is anything out of the ordinary about this.
-<piglet3:#irctour> let's visit #panties now.
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #panties
-*** Users on #panties: sloth dmarcher piglet3 Omnion Dave-meis beatnix Moon fireMAN rgaus clark KDX Nickk_ silky quietguy SweetCat keasey julieK CybrSaint
-<CybrSaint> tell me what you are doing to me julie
-<piglet3:#irctour> no, this is just an example of another sort of IRC channel that is good to taunt.
-<julieK> i am your sexslave cybr you tell me
-<quietguy> i like butts!
-*** RUFF (~YES@potemkin.ppp.america.com) has joined channel #panties
-<julieK> i love bigbutts
-<SweetCat> quiet I would doubt you would do that....
-<piglet3:#irctour> it's a different motif, if you will, and one that is quite common on IRC.
-<quietguy> sweetcat: why r u laughing?
-<piglet3> I guess you could say that makes you a typical delphi user, quietguy.
-*** Signoff: Moon (Leaving)
-<CybrSaint> julie, slides onto cybers member and starts to hump violently
-<julieK> ridem' cowboy
-<quietguy> i don't deny it. i'm doing it now!
-<julieK> woooooohooooo
-* CybrSaint begins shaking uncontrolably
-<SweetCat> quiet because you would mamorize what I look like...there are girls much better than me...taller and stuff
-<piglet3:#irctour> another typical IRCism that users lose is u for you, r for are, etc.
-*** Dave-meis has left channel #panties
-<piglet3> u r all a bunch of perverts, no?
-<CybrSaint> don't stop julie
-<piglet3:#irctour> you're lucky, you get to witness netsex.
-<CybrSaint> oink oink piglet
-*** Omnion has left channel #panties
-<piglet3:#irctour> not everyone sees things this lame on IRC their first time.
-*** fireMAN has left channel #panties
-<piglet3> sloth is smarter than all of you.
-<piglet3> Much, much smarter.
-<quietguy> sweetcat: sure i would. imagining seeing ur sweet but, i would j-o furiously. any guy would.
-*** agonner (~erickson@osip10.ionet.net) has joined channel #panties
-<rmtodd:#irctour> eeewwww, netsex.
-<piglet3> She has good genetic matter too.
-* CybrSaint grabs julie down onto himself and shoots the mother load into her wet pussy
-*** RUFF has left channel #panties
-<piglet3> Much better than any of you pervs.
-<SweetCat> *shrug* maybe
-<quietguy> sweetcat: that's not important. the important thing is that i got to see you intimately
-
-<julieK> whoah i can feel that big cannon
-*** dunks (dunks@er6.rutgers.edu) has joined channel #panties
-<piglet3> She has the potential to go places. You will just jack off and get sperm on your commodore 64's keyboard.
-* CybrSaint slides down and starts to lick juiles
-<CybrSaint> sweet juice
-*** Wildstar (organ@emuvax.emich.edu) has joined channel #panties
-<Wildstar> hiya all
-<julieK> well gotta go
-<piglet3> execpc is in milwaukie, wi, no?
-*** dunks has left channel #panties
-* CybrSaint probes with his tounge and finds juiles clit,
-*** julieK has left channel #panties
-<piglet3:#irctour> I can't stand #panties any more.
-<CybrSaint> pig, very observant
-<keasey> hi wildstar, are you f or m?
-*** piglet3 has left channel #panties
-*** sloth has left channel #panties
-<piglet3> Another type of channel is the geek-channel.
-<piglet3> On geek channels, computer geek wannabes sit around and act "elite"
-<piglet3> elite means that when they don't know the answer to your question, they act like they do, but won't tell you, instead replying "RTFM"
-<piglet3> this means "Read The Fucking Manual"
-<Psychie> yeah they're jerks
-> What's yow?
-<noah> Everybody is going somewhere!! It's probably a garage sale or a disaster Movie!!
-<dmarcher> OVER the underpass! UNDER the overpass! Around the FUTURE and BEYOND REPAIR!!
-<Belladona> Why is everything made of Lycra Spandex?
-<piglet3> *CybrSaint!~get@shrubbery.execpc.com* nice talking with you
-<Psychie> mean to me I feel like saying "look, I've pored through all the sources I have.. and am asking you all in case you KNOW THE ANSWER"
-<piglet3> A good example of a geek channel is #root
-> genuine geeks or pseudo geeks
-<Psychie> so SPARE me your assholic snobbism
-<piglet3> let's join #root now.
-<Psychie> and TELL me to put a 1; at the end of my required perl script or go FUCK YOURSELF
-<rmtodd> a shrubbery! Ni! Ni!
-<piglet3> spuedo geek
-<piglet3> *Octal!ryan@unix5.netaxs.com* do you know richard stallman?
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #root
-*** Topic for #root: Unix, systems, languages, architectures
-*** #root Visigoth 803509755
-*** Users on #root: sloth Psychie piglet3 vladimiah hubertf c0redump @Count ferdy @vuori @blackmage Sharp christ Pha3drus @shifter sn0t rough @jason @tHiNGLES @MSUDawg FourDee @ebola @alexei- greck @jsanford glen @Surge2 @boreo @ack @Visigoth @mod @night @TrayAway @Polarbear @Imaj Octal @Prentyse @ilo @Phaedrus @peacefrog @ivy @gypsie
-<piglet3> oink
-<Psychie> oink
-<piglet3> Good evening geeks.
-<night> glen thanks, question is why is netbsd less bitched about, because it's better, or because less peopel sue it?
-<ebola> oJnk
-<Psychie> gee there sure are a lot of roots here
-<piglet3> So tell me, how is an AIX 4.1 kernel extension different than an AIX 3.2.5 kernel extension?
-<ebola> ewww
-> resisting alex haley joke
-<Psychie> I'm speaking with a "slave" who suggests my using him for cleaning and cooking
-<Octal> if someone says that he is someone else's body servant, is that a custodial/food thing, a sexual thing, both, or something else?
-<Psychie> now, those are very practical skills that I can definitely use
-<piglet3> There is gnu prerelease http server on goldman.gnu.ai.mit.edu:8010
-*** Signoff by vizcaja detected
-* Octal just found out that most of the MIT new House/German House dorms are singles!
-<piglet3> go hawg wild.
-<Psychie> awink
-*** Signoff: dma (changing servers)
-* Phaedrus despairs
-*** dma3 (!@#$%^&*!@@pogo.gnu.ai.mit.edu) has joined channel #irctour
-*** Psychie has left channel #root
-* Octal will have _orgies_ beyond imagination in his 5x8 foot room :)
-*** alatt (~alatt@sopines212.nando.net) has joined channel #root
-*** dma3 (!@#$%^&*!@@pogo.gnu.ai.mit.edu) has joined channel #root
-<Psychie:#irctour> I have boed of them
-<Psychie:#irctour> bored
-<night> octal going to MIT as a freshmen undergrad?
-<Visigoth> go away dave
-<ebola> eww.. pushing gnu warez on us..
-<piglet3:#irctour> true. geeks are not interesting. Let's leave.
-<ebola> worse than mormon missionaries
-<night> to bad theres no good looking women at mit (heh)
-<piglet3> All of you have 1/20th the knowledge of sloth.
-<dma3> your slacks are too tight.
-*** roy7 (~roy@ppp17.cent.com) has joined channel #root
-*** dma3 has left channel #root
-*** sloth has left channel #root
-<piglet3> Our next stop is a channel where perversion is more major than the relatively minor stuff on #panties
-> i think i liked the panties group better than the geeks
-<Psychie> oooh panties
-<piglet3> me too.
-<Psychie> I don't wear panties
-<piglet3> let's visit #toiletsex
-<Psychie> often
-<piglet3> I don't even want to discuss what goes on there.
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #toiletsex
-*** Users on #toiletsex: sloth dmarcher gray1
-<piglet3:#irctour> *Phaedrus!roman@PORTAL.STWING.UPENN.EDU* I probably have one of the prettiest girls around
-*** Signon by temptress (~hthomas@ix-bos8-21.ix.netcom.com) detected
-*** Psychie (~phj@pilot.njin.net) has joined channel #toiletsex
-<piglet3:#irctour> let's join #toiletsex now.
-<Psychie:#irctour> it's always the same guy and only him
-*** Psychie has left channel #toiletsex
-*** piglet3 (ben@goldman.gnu.ai.mit.edu) has joined channel #toiletsex
-<piglet3> oink.
-> is anyone here?
-<piglet3> Hey grey1, tell us about the channel topic
-<piglet3> [info] #toiletsex topic: SCAT CHAT, FUN WITH WOMENS POOP ALL WOMEN WELCOME!
-*** Randy-2 (~rtaylor@slip16.vaxxine.com) has joined channel #toiletsex
-*** bpk (~bpk@tortoise.kern.com) has joined channel #irctour
-<piglet3> What's fun about women's poop?
-*** Signoff: gray1 (cs-pub.bu.edu irc-2.mit.edu)
-*** Signoff: rmtodd (cs-pub.bu.edu irc-2.mit.edu)
-*** Signoff: Belladona (cs-pub.bu.edu irc-2.mit.edu)
-<piglet3> Well grey1 is here.
-<Randy-2> hi gray im back
-<piglet3> He likes women to poop on him.
-<piglet3> Hey randy-2, what sort of toiletsex do you like?
-*** Signoff by WintrHawk detected
-<Randy-2> hey if your not into why are you here!
-<piglet3> Do you really have sex with toilets?
-> is pooping the extent of this group?
-*** tessaTV (tessaTV@dyn-28.direct.ca) has joined channel #toiletsex
-*** Psychie has left channel #irctour
-<piglet3> I think they are also into urination.
-*** Signoff by Temptress detected
-*** Signoff: Daemon (Ping timeout)
-<piglet3> It's rather limiting really. It's a sign of non-progression beyond infantile fixations.
-> I knew there had to be more
-<Randy-2> why the hell don't you fuck right off you armchair shrink!
-<piglet3> I think the topic is unlikely to attract any actual women. My guess is that they are mostly homosexual men who pretend to be women.
-<piglet3> Randy-2, ad-homenim attacks are childish.
-<dmarcher> what is the topic?
-<piglet3> Might I suggest you use reason, and also, I think it's quite likely you should seek professional help.
-<Randy-2> yes and what your doing is too!
-<piglet3> And to top it off, my chair has no arms!
-<piglet3> Randy, how much do you pay an hour to sit on IRC and talk about defecation?
-<piglet3> Why don't you attempt to go out and have a normal relationship?
-*** Omnion (irc@mumrik.nada.kth.se) has joined channel #toiletsex
-*** Signoff by Tiamat detected
-<Randy-2> that is none of your bees wax I have a shrink a professional one!
-<piglet3> I'd just like to say that I sincerely hope that all of you get better, someday.
-<piglet3:#irctour> enough of #toiletsex, I think.
-*** piglet3 has left channel #toiletsex
-*** dmarcher has left channel #toiletsex
-*** sloth has left channel #toiletsex
-*** Signon by TiAmAT (moss@ernani.mines.u-nancy.fr) detected
-<piglet3> Some people use IRC as a sort of video game.
-<piglet3> They enjoy kicking each other off channels and using bots to change channel modes.
-<Omnion> <Randy-2#toiletsex[05:26]> god people like that are assholes
-<piglet3> It's been a long time since I visited a channel like this, but I think #warung is still around.
-> this happens on reputable lines like toiletsex
-<piglet3> let's visit #warung for a short moment - they will likely have robots kick us off quickly.
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #warung
-*** Users on #warung: sloth piglet3 Omnion dmarcher ayus sazali SaBoL @bgn_tido AhRin AhReen AhLin AhLeen @JaMbU KasBoL ClueBot ClueServ OBIWAN G0MUN G0MEN G0M1N G0MAN
-<dmarcher:#irctour> they're op-short on #warung. something's wrong.
-<piglet3> I'd just like to say, that Malasian men have sex with monkeys.
-<piglet3> A lot.
-<piglet3> The national average is three times a week.
-*** Signon by Manny (lorhuert@acca.NMSU.Edu) detected
-<piglet3:#irctour> yes!
-> how d'you know
-<rmt2:#irctour> iubj
-<rmt2:#irctour> oink.
-*** ayus has left channel #warung
-<rmt2:#irctour> sigh.
-<piglet3> What's wrong with you? Do you all not have ops?
-*** bgn_tido is now known as mari_mari
-*** sazali is now known as kerabu
-*** kik1 (moha0029@maroonx.tc.umn.edu) has joined channel #warung
-<piglet3> This channel has changed a lot, I remember over 60 mode changes a second. What happened?
-*** Sahanaya (nemes1s@sunserv1_ie4.leeds.ac.uk) has joined channel #warung
-*** Mode change "+o Sahanaya" on channel #warung by Irc.Labri.U-Bordeaux.Fr
-<piglet3> It was IRC in the fast lane. Have you all given up?
-*** Signoff: kik1 (changing servers)
-<dmarcher> #malaysia's a tad better
-*** kik1 (moha0029@maroon.tc.umn.edu) has joined channel #warung
-<piglet3:#irctour> well, let's give up on #warung. it has become a typical asian channel where nobody ever speaks. This is especially typical of the japanese channels.
-*** piglet3 has left channel #warung
-<piglet3:#irctour> yes, let's try malaysia
-*** Omnion has left channel #warung
-*** mari_mari is now known as alamak
-*** kerabu is now known as Siapa_tu
-*** dmarcher has left channel #warung
-*** sloth has left channel #warung
-*** Dae (ian@slip161.rmii.com) has joined channel #irctour
-*** Daemon (frechett@benji.Colorado.EDU) has joined channel #irctour
-<dmarcher> #malaysia is really broken.
-<dmarcher> it's a tour.
-<piglet3> I'm taking sloth on a tour of IRC.
-<dmarcher> unfortunately, the natives aren't in character.
-> is it just a slow night?
-*** piglet3 invites you to channel #malaysia
-<piglet3> cool mode change flood on malaysia
-*** sloth (spindler@jove.acs.unt.edu) has joined channel #malaysia
-*** Users on #malaysia: sloth trash top @aBoL nor magic lop Omnion piglet3 jb Sahanaya Kathy- dmarcher Zinho @SaBoL baby_ku minum_air @AhRin @AhReen @AhLin @AhLeen @JaMbU jam @KasBoL kawaL_ kawaL @G0M0N @G0MAN PROTECT GUARD @OBIWAN @G0MUN @G0MEN @G0M1N
-<dmarcher> oink.
-<dmarcher> oink.
-<piglet3> iki biki malaysia oink
-<lop> hi nor.......
-<dmarcher> oink.
-<dmarcher> oink.
-<top> full of pigs here!
-*** Omnion has left channel #malaysia
-<dmarcher> deltar nu motet oink.
-<dmarcher> oink.
-*** aBoL has left channel #malaysia
-<piglet3> motet your mother oink
-<dmarcher> oink.
-<dmarcher> oink.
-<lop> let chat ok...:nor
-<piglet3> malaysian monkey-fucker oink
-*** Signoff by ash detected
-*** trash has left channel #malaysia
-<dmarcher> http://nipple-server.splode.com/nipple-survey.html oink.
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> oink.
-<jam> piglet3:MAMAT YANG KURANG AJE!
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> jam: mamat yang kurang aje!!!!!!
-*** Kathy- has left channel #malaysia
-<dmarcher> (oink)
-<dmarcher> oink.
-<piglet3> jam, I'm rubber and you're glue
-*** baby_ku is now known as ayang
-<dmarcher> oink.
-*** minum_air is now known as mari_mari
-<piglet3> Everything you say bounces off me, and sticks to you.
-<dmarcher> oink.
-*** jb has left channel #malaysia
-<dmarcher> oink.
-*** Signoff: nor (Bye everybody!!!)
-<dmarcher> oink.
-<piglet3> oklahoma is full of malaysians.
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> malaysia is full of oklahomans.
-*** piglet3 has left channel #malaysia
-*** Signon by AsH (~ash@freeside.fc.net) detected
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> oink.
-*** jam has left channel #malaysia
-<dmarcher> oink.
-<dmarcher> oink.
-<dmarcher> oink.
-*** aBoLX (~wsw542@eagle.acns.nwu.edu) has joined channel #malaysia
-*** Mode change "+o aBoLX" on channel #malaysia by G0M1N
-*** Mode change "+o aBoLX" on channel #malaysia by G0M0N
-*** Mode change "+o aBoLX" on channel #malaysia by G0MUN
-*** Mode change "+o aBoLX" on channel #malaysia by G0MAN
-*** Mode change "+o aBoLX" on channel #malaysia by G0MEN
-*** Mode change "+o aBoLX" on channel #malaysia by OBIWAN
-*** Mode change "+o aBoLX" on channel #malaysia by SaBoL
-*** sloth has left channel #malaysia
-<piglet3> well, I sense that sloth is bored. I will simply describe the remaining type of IRC channel.
-<piglet3> This is the lurker or bot channel.
-<bpk> I don't know about sloth, but I know I'm bored
-<piglet3> It is a channel where one person or bot sits by themselves and don't say anything.
-<piglet3> And there you have it - examples of all the types of IRC channels.
-<dmarcher> sad say on irc when you can't get kicked off #malaysia.
-<dmarcher> s/say/day
-*** fn (fn@pain.csrv.uidaho.edu) has joined channel #irctour
-<fn> grue.
-<Dae> Try #limbaugh maybe
-<piglet3> Remember the basic categories: greeting, minor sexual kink, major sexual kink, game channels, geek channels, and bot channels.
-> lovely tour. plenty of oinks
-<dmarcher> oink.
-<piglet3> I can't - #limbaugh has had me on autokick for over a year now.
-<bpk> heh
-<piglet3> Dae can help you if you have any further questions about IRC. He is an IRC operator.
-<bpk> let me see if I can get someone to kill me
-<Dae> geek channels? That like #linux #root #<insert hobby> ?
-<piglet3> yes.
-> okay, thanks
-<piglet3> This usually means one is a major dweeb. However I've met him in person, and he's okay.
-<fn> where does #unix fit, do you think?
-<piglet3> geek
-<dmarcher> stop it, you're all talking like pjg.
-<piglet3> I am not knowing currently, at this time. no. no.. no.
-<Dae> p3: prove it
-<fn> <piglet3> I've never not known less than that than you've never not forgotten, ian.
-<fn> ha! in my .plan
-<dmarcher> don't put me in your .plan.
-<piglet3> Kindly, please to be fucking yourself harder.
-<fn> heh.
-IRC log ended Sun Jun 18 22:42
+++ /dev/null
-From friedman Sat Aug 3 19:54:19 1996
-Status: RO
-X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
- [nil "Sat" "3" "Aug" "1996" "21:33:05" "-0500" "Mandar Mirashi" "mandar@kiowa.wildstar.net" nil nil nil "^From:" nil nil "08" nil nil nil nil]
- nil)
-Received: from churchy.gnu.ai.mit.edu by albert.gnu.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id WAA14799 for <\friedman@albert.gnu.ai.mit.edu>; Sat, 3 Aug 1996 22:33:34 -0400
-Received: from kiowa.wildstar.net by churchy.gnu.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id WAA16533 for <friedman@gnu.ai.mit.edu>; Sat, 3 Aug 1996 22:33:30 -0400
-Received: (from mandar@localhost) by kiowa.wildstar.net (8.6.12/8.6.9) id VAA28442 for friedman@gnu.ai.mit.edu; Sat, 3 Aug 1996 21:33:05 -0500
-Message-Id: <199608040233.VAA28442@kiowa.wildstar.net>
-From: Mandar Mirashi <mandar@kiowa.wildstar.net>
-To: friedman@gnu.ai.mit.edu
-Subject: Undernet IRC protocol changes
-Date: Sat, 3 Aug 1996 21:33:05 -0500
-
-Hello there,
-
- This mail is being sent to all IRC client coders, announcing some
-changes in the server-client protocol on the Undernet IRC network. An
-RFC supplementing RFC1459 is in the works (it's unclear when this will
-be released however). In the meanwhile, I'll try to update you with any
-significant changes/features/bugs that affect clients.
-
-1) the /list command.
-======================
-
- The default action of the /list command (to list all channels) has
- been disabled since it was found to consume a lot of CPU on IRC
- servers (with hundreds of clients listing thousands of channels).
- Changes include a _required_ paramater to LIST.
-
-*** Usage on ircII: /QUOTE LIST parameters
-*** Where parameters is a space or comma seperated list of one or more of:
-*** <max_users ; Show all channels with less then max_users.
-*** >min_users ; Show all channels with more then min_users.
-*** C<max_minutes ; Channels that exist less then max_minutes.
-*** C>min_minutes ; Channels that exist more then min_minutes.
-*** T<max_minutes ; Channels with a topic last set less then max_minutes
- ago.
-*** T>min_minutes ; Channels with a topic last set more then min_minutes
- ago.
-*** Example: LIST <3,>1,C<10,T>0 ; 2 users, younger then 10 min., topic
- set.
-
- We suggest incorporating this change directly into your client so that
- a /quote is no longer needed (i.e. a direct message to the server).
-
-
-2) PONG replies
-================
-
- To counter source routing/ip-spoofing, Undernet IRC servers send a PING
- command to the client followed by a random key. The client is expected
- to respond with this key as a parameter to PONG. e.g.
- server -> client PING :23472820203484
- client to server PONG :23472820203484
-
- ircII and mirc are two clients that already follow this. I'm not sure
- about other clients.
-
-3) Other Undernet changes
-=========================
-
- A list of all Undernet server numerics are included in the server source.
-
- ftp://ftp.undernet.org/irc/servers/current
-
- Significant changes over the past few years, affecting clients, include:
- /stats w replies, /stats g replies, /silence replies, channel topic
- information replies, user signon time reply, channel
- creation time reply, etc. I've attached the file for your convenience.
- Please check if your client responds to these numeric replies.
-
- I also suggest adding the /map and /silence commands to your clients
- (/silence cuts off flooding at the server level: syntax:
- /silence +user@host or /silence nick
- /silence -user@host or /silence -nick to delete a silenced entry.
- /map returns the current routing map of irc servers).
-
- There's also a patch removing /away from the server (this functionality
- belongs to the client) in its review stages. You may wish to implement
- a mechanism that simulates /away on your client without using the server
- message, to prepare for this possible future change.
-
-New versions
-=============
-
- If you release new versions of your clients, please upload them to
- /incoming on ftp.undernet.org and drop me a note. I'll move them to
- the correct location asap. We're mirrored on ftp2-4.undernet.org. I'd
- really appreciate it if you could take a moment and verify that the latest
- version of your client is out there. Thanks.
-
-
-Feedback
-========
-
- To stay in touch with Undernet IRC protocol changes / server code
- patches, you're welcome to join the Undernet coder committee mailing
- list. Simply drop a mail to majordomo@undernet.org with
- "subscribe coder-com" in the body.
-
-
-
- Thanks and if you have any other questions about
-making your client Undernet compatible, please don't hesitate to mail
-coder-com@undernet.org. Sincerely,
-
-
- Mandar Mirashi (Mmmm)
-
-Attached are numeric.h and the latest Undernet IRC server list (which
-you may wish to include with your next client release - it is also available
-at http://www.comco.com/dougmc/irc-stats/server-lists )
-
-
------ numeric.h ------- cut here ------
-
-/************************************************************************
- * IRC - Internet Relay Chat, include/numeric.h
- * Copyright (C) 1990 Jarkko Oikarinen
- *
- * This program 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 1, or (at your option)
- * any later version.
- *
- * This program 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 this program; if not, write to the Free Software
- * Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139, USA.
- */
-
-
-
-/*
- * Reserve numerics 000-099 for server-client connections where the client
- * is local to the server. If any server is passed a numeric in this range
- * from another server then it is remapped to 100-199. -avalon
- */
-#define RPL_WELCOME 001
-#define RPL_YOURHOST 002
-#define RPL_CREATED 003
-#define RPL_MYINFO 004
-#define RPL_MAP 005
-#define RPL_MAPMORE 006
-#define RPL_MAPEND 007
-
-/*
- * Errors are in the range from 400-599 currently and are grouped by what
- * commands they come from.
- */
-#define ERR_NOSUCHNICK 401
-#define ERR_NOSUCHSERVER 402
-#define ERR_NOSUCHCHANNEL 403
-#define ERR_CANNOTSENDTOCHAN 404
-#define ERR_TOOMANYCHANNELS 405
-#define ERR_WASNOSUCHNICK 406
-#define ERR_TOOMANYTARGETS 407
-#define ERR_NOSUCHSERVICE 408
-#define ERR_NOORIGIN 409
-
-#define ERR_NORECIPIENT 411
-#define ERR_NOTEXTTOSEND 412
-#define ERR_NOTOPLEVEL 413
-#define ERR_WILDTOPLEVEL 414
-
-#define ERR_UNKNOWNCOMMAND 421
-#define ERR_NOMOTD 422
-#define ERR_NOADMININFO 423
-#define ERR_FILEERROR 424
-
-#define ERR_NONICKNAMEGIVEN 431
-#define ERR_ERRONEUSNICKNAME 432
-#define ERR_NICKNAMEINUSE 433
-#define ERR_SERVICENAMEINUSE 434
-#define ERR_SERVICECONFUSED 435
-#define ERR_NICKCOLLISION 436
-#define ERR_BANNICKCHANGE 437
-#define ERR_NICKTOOFAST 438
-
-#define ERR_USERNOTINCHANNEL 441
-#define ERR_NOTONCHANNEL 442
-#define ERR_USERONCHANNEL 443
-#define ERR_NOLOGIN 444
-#define ERR_SUMMONDISABLED 445
-#define ERR_USERSDISABLED 446
-
-#define ERR_NOTREGISTERED 451
-
-#define ERR_NEEDMOREPARAMS 461
-#define ERR_ALREADYREGISTRED 462
-#define ERR_NOPERMFORHOST 463
-#define ERR_PASSWDMISMATCH 464
-#define ERR_YOUREBANNEDCREEP 465
-#define ERR_YOUWILLBEBANNED 466
-#define ERR_KEYSET 467
-
-#define ERR_CHANNELISFULL 471
-#define ERR_UNKNOWNMODE 472
-#define ERR_INVITEONLYCHAN 473
-#define ERR_BANNEDFROMCHAN 474
-#define ERR_BADCHANNELKEY 475
-#define ERR_BADCHANMASK 476
-#define ERR_BANLISTFULL 478
-
-#define ERR_NOPRIVILEGES 481
-#define ERR_CHANOPRIVSNEEDED 482
-#define ERR_CANTKILLSERVER 483
-#define ERR_ISCHANSERVICE 484
-
-#define ERR_NOOPERHOST 491
-#define ERR_NOSERVICEHOST 492
-
-#define ERR_UMODEUNKNOWNFLAG 501
-#define ERR_USERSDONTMATCH 502
-
-#define ERR_SILELISTFULL 511
-
-#define ERR_NOSUCHGLINE 512
-
-/*
- * Numberic replies from server commands.
- * These are currently in the range 200-399.
- */
-#define RPL_NONE 300
-#define RPL_AWAY 301
-#define RPL_USERHOST 302
-#define RPL_ISON 303
-#define RPL_TEXT 304
-#define RPL_UNAWAY 305
-#define RPL_NOWAWAY 306
-
-#define RPL_WHOISUSER 311
-#define RPL_WHOISSERVER 312
-#define RPL_WHOISOPERATOR 313
-
-#define RPL_WHOWASUSER 314
-/* rpl_endofwho below (315) */
-#define RPL_ENDOFWHOWAS 369
-
-#define RPL_WHOISCHANOP 316 /* redundant and not needed but reserved */
-#define RPL_WHOISIDLE 317
-
-#define RPL_ENDOFWHOIS 318
-#define RPL_WHOISCHANNELS 319
-
-#define RPL_LISTSTART 321
-#define RPL_LIST 322
-#define RPL_LISTEND 323
-#define RPL_CHANNELMODEIS 324
-#define RPL_CREATIONTIME 329
-
-#define RPL_NOTOPIC 331
-#define RPL_TOPIC 332
-#define RPL_TOPICWHOTIME 333
-#define RPL_LISTUSAGE 334
-
-#define RPL_INVITING 341
-#define RPL_SUMMONING 342
-
-#define RPL_VERSION 351
-
-#define RPL_WHOREPLY 352
-#define RPL_ENDOFWHO 315
-#define RPL_NAMREPLY 353
-#define RPL_ENDOFNAMES 366
-
-#define RPL_KILLDONE 361
-#define RPL_CLOSING 362
-#define RPL_CLOSEEND 363
-#define RPL_LINKS 364
-#define RPL_ENDOFLINKS 365
-/* rpl_endofnames above (366) */
-#define RPL_BANLIST 367
-#define RPL_ENDOFBANLIST 368
-/* rpl_endofwhowas above (369) */
-
-#define RPL_INFO 371
-#define RPL_MOTD 372
-#define RPL_INFOSTART 373
-#define RPL_ENDOFINFO 374
-#define RPL_MOTDSTART 375
-#define RPL_ENDOFMOTD 376
-
-#define RPL_YOUREOPER 381
-#define RPL_REHASHING 382
-#define RPL_YOURESERVICE 383
-#define RPL_MYPORTIS 384
-#define RPL_NOTOPERANYMORE 385
-
-#define RPL_TIME 391
-#define RPL_USERSSTART 392
-#define RPL_USERS 393
-#define RPL_ENDOFUSERS 394
-#define RPL_NOUSERS 395
-
-#define RPL_TRACELINK 200
-#define RPL_TRACECONNECTING 201
-#define RPL_TRACEHANDSHAKE 202
-#define RPL_TRACEUNKNOWN 203
-#define RPL_TRACEOPERATOR 204
-#define RPL_TRACEUSER 205
-#define RPL_TRACESERVER 206
-#define RPL_TRACESERVICE 207
-#define RPL_TRACENEWTYPE 208
-#define RPL_TRACECLASS 209
-
-#define RPL_STATSLINKINFO 211
-#define RPL_STATSCOMMANDS 212
-#define RPL_STATSCLINE 213
-#define RPL_STATSNLINE 214
-#define RPL_STATSILINE 215
-#define RPL_STATSKLINE 216
-#define RPL_STATSQLINE 217
-#define RPL_STATSYLINE 218
-#define RPL_ENDOFSTATS 219
-
-#define RPL_UMODEIS 221
-
-#define RPL_SERVICEINFO 231
-#define RPL_ENDOFSERVICES 232
-#define RPL_SERVICE 233
-#define RPL_SERVLIST 234
-#define RPL_SERVLISTEND 235
-
-#define RPL_STATSLLINE 241
-#define RPL_STATSUPTIME 242
-#define RPL_STATSOLINE 243
-#define RPL_STATSHLINE 244
-#define RPL_STATSSLINE 245
-#define RPL_STATSTLINE 246
-#define RPL_STATSGLINE 247
-#define RPL_STATSULINE 248
-#define RPL_STATSDEBUG 249
-#define RPL_STATSCONN 250
-
-#define RPL_LUSERCLIENT 251
-#define RPL_LUSEROP 252
-#define RPL_LUSERUNKNOWN 253
-#define RPL_LUSERCHANNELS 254
-#define RPL_LUSERME 255
-#define RPL_ADMINME 256
-#define RPL_ADMINLOC1 257
-#define RPL_ADMINLOC2 258
-#define RPL_ADMINEMAIL 259
-
-#define RPL_TRACELOG 261
-#define RPL_TRACEPING 262
-
-#define RPL_SILELIST 271
-#define RPL_ENDOFSILELIST 272
-
-#define RPL_STATSDLINE 275
-
-#define RPL_GLIST 280
-#define RPL_ENDOFGLIST 281
-
-
------ Undernet IRC server list ------- cut here ------
-
- ALIAS IP ADDRESS HOSTNAME
-
- vancouver.bc.ca.undernet.org 199.60.229.15 irc.direct.ca
- toronto.on.ca.undernet.org 199.166.230.99 oceanus.magic.ca
- montreal.qu.ca.undernet.org 132.207.4.32 step.polymtl.ca
-
- caen.fr.eu.undernet.org 193.49.200.16 ns.ensicaen.ismra.fr
- luxembourg.lu.eu.undernet.org 194.177.56.140 hydra.eo.lu
- amsterdam.nl.eu.undernet.org 130.37.24.9 veer.cs.vu.nl
- diemen.nl.eu.undernet.org 145.220.3.40 irc.pi.net
- lulea.se.eu.undernet.org 130.240.16.36 buddy.ludd.luth.se
- ljubljana.si.eu.undernet.org 193.2.1.35 ro.zrsss.si
- london.uk.eu.undernet.org 193.119.122.98 telebsd.aladdin.co.uk
-
- auckland.nz.undernet.org 202.14.100.6 iconz1.iconz.co.nz
-
- phoenix.az.us.undernet.org 204.62.193.83 home.amug.org
- sandiego.ca.us.undernet.org 207.110.0.52 irc.connectnet.com
- sanjose.ca.us.undernet.org 192.160.13.8 jitter.rahul.net
- washington.dc.us.undernet.org 152.163.173.25 irc01.irc.aol.com
- atlanta.ga.us.undernet.org 198.79.64.1 serve.org
- chicago.il.us.undernet.org 198.49.174.36 tau.wwa.com
- chicago-1.il.us.undernet.org 199.0.154.14 raptor.ais.net
- manhattan.ks.us.undernet.org 129.130.8.23 lynk.ksu.ksu.edu
- lowell.ma.us.undernet.org 206.15.106.129 chatter-s2.nis.newscorp.com
- ann-arbor.mi.us.undernet.org 192.131.22.80 irc.cic.net
- springfield.mo.us.undernet.org 204.71.96.187 spica.getonthe.net
- stlouis.mo.us.undernet.org 205.216.202.17 ultra.i1.net
- norman-r.ok.us.undernet.org unresolvable unknown
- okc.ok.us.undernet.org 206.103.114.11 apache.wildstar.com
- pittsburgh.pa.us.undernet.org 192.231.221.38 uirc.lm.com
- austin.tx.us.undernet.org 128.83.199.50 zilker.mc.utexas.edu
- dallas.tx.us.undernet.org 204.75.137.18 external.csac.net
- blacksburg.va.us.undernet.org 128.173.40.203 blacksburg.va.us.undernet.org
- monticello.ar.us.undernet.org 206.156.164.142 irc.seark.net
-
-
-Note: Most Undernet IRC servers listen on ports 6661-6669.
-
- The alias us.undernet.org is a roundrobin that picks a US server at
- random (for first time users who aren't sure which server to connect to).
- The same applies to eu.undernet.org (europe). The use of the undernet.org
- alias over the actual hostname is highly recommended (when servers
- cease to exist, the alias will still function since we point it to
- a working server).
-
-
-From friedman Mon Sep 30 13:45:21 1996
-Status: RO
-X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
- [nil nil nil nil nil nil nil nil nil nil nil nil "^From:" nil nil nil nil nil nil nil]
- nil)
-Received: from gnu-life.ai.mit.edu by albert.gnu.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id OAA20824 for <friedman@albert.gnu.ai.mit.edu>; Mon, 30 Sep 1996 14:42:45 -0400
-Received: from kiowa.wildstar.net by gnu-life.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id OAA05844 for <friedman@prep.ai.mit.edu>; Mon, 30 Sep 1996 14:42:43 -0400
-Received: (from mandar@localhost) by kiowa.wildstar.net (8.7.5/8.7.3) id NAA30763 for friedman@prep.ai.mit.edu; Mon, 30 Sep 1996 13:42:25 -0500
-Message-Id: <199609301842.NAA30763@kiowa.wildstar.net>
-From: Mandar Mirashi <mandar@kiowa.wildstar.net>
-To: friedman@prep.ai.mit.edu
-Subject: IRC client coders update
-Date: Mon, 30 Sep 1996 13:42:25 -0500
-
-Heya,
-
- Some other random thoughts that might apply to all IRC clients:
-
-* Ports - It would be nice if client coders allow for the specification
- of alternate ports to automatically connect on, if the connect to
- the default port fails. Most servers listen to ports in the range
- 6660-6669. It has grown incredibly difficult to connect on the
- default port 6667 on big servers.
-
-* Extensions - As much as some may dislike it, I believe the next "wave"
- of chat clients to hit the net are those that include VRML/audio/video
- communication. There are several independent web sites or proprietary
- developers who provide this, but none of them are integrated into IRC
- clients. You may wish to investigate means of doing this with your clients.
-
-* For those developing GUI clients, one idea would be to have an addressbook
- which includes name, associated GIF file, associated URL, etc. Then
- you could auto-attach a thumbnail gif to the nick, as it scrolls over
- a channel. The nick itself could be "clickable" if a URL field is
- specified, which would make your default browser jump to that location.
-
-* irc-url spec - I haven't updated it for a while. It can be found at:
- ftp://ftp.ietf.org/internet-drafts/draft-mirashi-url-irc-01.txt
- and the mailing list can be subscribed to, by sending mail to
- majordomo@wildstar.net with "subscribe irl-url" in the body.
-
-* Nospoof patch - I hope everyone has updated their client (if it needed it)
- to work with the PING/PONG and other Undernet ircd changes I'd sent earlier.
-
- That's all for now..thanks
-
- Mmmm
-
-From pp@swip.net Thu Feb 6 01:45:10 1997
-Status: RO
-X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
- ["1405" "" "6" "Feb" "1997" "10:31:44" "+0100" "Per Persson" "pp@swip.net" nil "49" "CTCP discussion list." "^From:" nil nil "02" nil nil nil nil]
- nil)
-Return-Path: <pp@swip.net>
-Received: from gnu.ai.mit.edu (friedman@localhost [127.0.0.1])
- by piglet.splode.com (8.8.4/8.8.4) with ESMTP
- id BAA00765 for <friedman>; Thu, 6 Feb 1997 01:45:10 -0800
-Received: from churchy.gnu.ai.mit.edu by albert.gnu.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id EAA20224 for <zenirc-dev@gnu.ai.mit.edu>; Thu, 6 Feb 1997 04:33:35 -0500
-Received: from mn6.swip.net by churchy.gnu.ai.mit.edu (8.6.12/4.0) with ESMTP
- id <EAA10861@churchy.gnu.ai.mit.edu>; Thu, 6 Feb 1997 04:31:35 -0500
-Received: from doc.swip.net (workstation1.swip.net [130.244.254.1])
- by mn6.swip.net (8.8.2/8.8.2) with SMTP
- id KAA04961 for <zenirc-dev@gnu.ai.mit.edu>;
- Thu, 6 Feb 1997 10:31:31 +0100 (MET)
-Received: by doc.swip.net (SMI-8.6/SMI-SVR4)
- id KAA26012; Thu, 6 Feb 1997 10:31:44 +0100
-Sender: pp@doc.swip.net
-Mime-Version: 1.0
-Content-Type: text/plain; charset=US-ASCII
-Content-Transfer-Encoding: 7bit
-Message-ID: <x7hgjqs2kf.fsf@swip.net>
-X-Mailer: Red Gnus v0.84/Emacs 19.34
-From: Per Persson <pp@swip.net>
-To: zenirc-dev@gnu.ai.mit.edu
-Subject: CTCP discussion list.
-Date: 06 Feb 1997 10:31:44 +0100
-Lines: 49
-
-This might be of interest to you. There's a discussion going and I'm
-pretty sure that the list-maintainer (Lindsay) has an archive of all
-mails going through the list.
-
---pp
-
-Forwarded-By: Darren Reed <avalon@coombs.anu.edu.au>
-
-From: Mike McLagan <mmclagan@invlogic.com>
-Message-Id: <199702030750.CAA29332@linux.invlogic.com>
-Subject: Referenced CTCP Standards Group
-To: ircd@the-project.org (IRC Development Mailing List)
-Date: Mon, 3 Feb 1997 02:50:10 -0500 (EST)
-Cc: operlist@the-project.org (IRC Operators List)
-
------BEGIN PGP SIGNED MESSAGE-----
-
-Hi,
-
- I made reference today in my emails to a CTCP standards group. This is
-based from a number of client coders, and has turned into an email list and
-an Internet Draft document (formerly called a Draft RFC). The list is hosted
-by Zircon author Lindsay Marshall.
-
- To join the list send "subscribe ctcp your name" to:
-
- listproc%catless@newcastle.ac.uk.
-
- If you want to see the current draft, you can send me a private email
-message, or visit my company's web site at:
-
- http://www.invlogic.com/irc/ctcp.html
-
- Mike was here...
-
------BEGIN PGP SIGNATURE-----
-Version: 2.6.3a
-Charset: noconv
-
-iQB1AwUBMvWYsnFj8kDikEM5AQEVAgL/QH6laNKG/H9c+b4JiSD9MNEj98JtAcB5
-6sHzuP4NtvX87GdYlJh98qwaww/I5IxhgNWt3ydOWMV6c99dzv2GqyZG4f+xUNK+
-8dQ/na2e9f06MLVn/tzg73RYmMAqtQf/
-=qyeR
------END PGP SIGNATURE-----
-
-
-
-
-------- End of forwarded message -------
-
-From mandar@cherokee.wildstar.net Wed Feb 26 19:15:07 1997
-Status: RO
-X-VM-v5-Data: ([nil nil nil nil nil nil nil nil nil]
- ["8071" "Wed" "26" "Feb" "1997" "21:12:52" "-0600" "Mandar Mirashi" "mandar@cherokee.wildstar.net" nil "227" "IRC client coders update #6" "^From:" nil nil "02" nil "IRC client coders update #6" nil nil nil]
- nil)
-Return-Path: <mandar@cherokee.wildstar.net>
-Received: from gnu.ai.mit.edu (friedman@localhost [127.0.0.1])
- by piglet.splode.com (8.8.5/8.8.5) with ESMTP id TAA20384
- for <friedman>; Wed, 26 Feb 1997 19:15:03 -0800
-Received: from gnu-life.ai.mit.edu by albert.gnu.ai.mit.edu (8.6.12/8.6.12GNU) with ESMTP id WAA28651 for <friedman@albert.gnu.ai.mit.edu>; Wed, 26 Feb 1997 22:12:58 -0500
-Received: from cherokee.wildstar.net by gnu-life.ai.mit.edu (8.8.5/8.6.12GNU) with ESMTP id WAA14032 for <friedman@prep.ai.mit.edu>; Wed, 26 Feb 1997 22:10:40 -0500 (EST)
-Received: (from mandar@localhost) by cherokee.wildstar.net (8.8.3/8.6.9) id VAA29997 for friedman@prep.ai.mit.edu; Wed, 26 Feb 1997 21:12:52 -0600
-Message-Id: <199702270312.VAA29997@cherokee.wildstar.net>
-From: Mandar Mirashi <mandar@cherokee.wildstar.net>
-To: friedman@prep.ai.mit.edu
-Subject: IRC client coders update #6
-Date: Wed, 26 Feb 1997 21:12:52 -0600
-
-Heya,
-
- Here's some information re: the next upcoming release of the Undernet
-server code - u2.10 (still in beta). Please mail coder-com@undernet.org
-directly if you have any concerns.
-
- The other thing I wanted to check was if you'd be interested in joining
-a mailing list open ONLY to client coders, to discuss client issues (the
-"colour" issue being an egregious example). I'd be more than willing to
-set one up. You can mail me at mandar@wildstar.net re: this.
-
-Thanks
-
-Mmmm
-
-Mandar Mirashi
-Maintainer: ftp.undernet.org, Undernet IRC FAQ.
-ftp://rtfm.mit.edu/pub/usenet/alt.irc.undernet
-For IRC help/Undernet information, check out http://www.undernet.org
-
----
->From carlo@runaway.xs4all.nl Wed Feb 26 21:03:23 1997
-Date: Wed, 26 Feb 1997 01:11:01 +0100 (MET)
-From: Carlo Wood <carlo@runaway.xs4all.nl>
-Reply-To: coder-com@undernet.org
-To: coder committee <coder-com@mail.undernet.org>
-Subject: [C-Com] Server NOtice numerics
-
-Hiya,
-
-can someone asap pass this info to the client coders ?!!
-
-A new numeric 249:
-
-Example:
-
-4.undernet.org 249 nick :Servernotice mask: 12287 (0x2fff)
-
-Where the number 12287 is a bit-or-ed mask with the meaning:
-
-#define SNO_OLDSNO 0x1 /* unsorted old messages */
-#define SNO_SERVKILL 0x2 /* server kills (nick collisions) */
-#define SNO_OPERKILL 0x4 /* oper kills */
-#define SNO_HACK2 0x8 /* desyncs */
-#define SNO_HACK3 0x10 /* temporary desyncs */
-#define SNO_UNAUTH 0x20 /* unauthorized connections */
-#define SNO_TCPCOMMON 0x40 /* common TCP or socket errors */
-#define SNO_TOOMANY 0x80 /* too many connections */
-#define SNO_HACK4 0x100 /* Uworld actions on channels */
-#define SNO_GLINE 0x200 /* glines */
-#define SNO_NETWORK 0x400 /* net join/break, etc */
-#define SNO_IPMISMATCH 0x800 /* IP mismatches */
-#define SNO_OLDREALOP 0x1000 /* old oper-only messages */
-#define SNO_CONNEXIT 0x2000 /* client connect/exit (ugh) */
-
-One can set this way a more specific filter for server notices:
-
-/MODE nick +s 3847
-
-Or add (set) an EXTRA bit:
-
-/MODE nick +s 128
-
-Note the extra numeric parameter (space seperated from the umodes).
-
-This would also work:
-
-/MODE mynick +iswd 853
-
-
-
-/MODE nick -s 64
-
-Unsets bits (/MODE nick -s 96 unsets both 64 and 32).
-
-This will be added to undernet server version 2.10.
-The new numeric will be returned every time you set a new mask, or
-when you ask you umode with '/MODE nick' and the mask is unequal
-the default mask. The default mask is unfortunately subject to
-change, but currently 1540 (0x604).
-Doing /MODE nick +s, will NOT give the 249 numeric, but set the
-mask to the default mask.
-
-Run
-
-PS
-
-If client coders absolutely want to know what the default mask is
-I suggest they use this string: MODE <nick> +ss 2147483648
-This currently gives (ircII):
---> MODE Run4 -s
-*** Mode change "-s" for user Run4 by Run4
---> MODE Run4 +ss 2147483648
-*** Mode change "+s" for user Run4 by Run4
-249 Servernotice mask: 1540 (0x604)
-
-PS2
-
-Unofficial ;), one can also do: /MODE nick +s -4 , to uset bit '4',
-and even /MODE nick -s -4, to SET bit '4'.
-
---
- ircd development: http://www.xs4all.nl/~carlo17/ircd-dev
->From carlo@runaway.xs4all.nl Wed Feb 26 21:03:58 1997
-Date: Wed, 26 Feb 1997 21:28:29 +0100 (MET)
-From: Carlo Wood <carlo@runaway.xs4all.nl>
-Reply-To: coder-com@undernet.org
-To: coder-com@undernet.org
-Cc: ircii-epic@concentric.net
-Subject: Re: [C-Com] client-coder feedback
-
------BEGIN PGP SIGNED MESSAGE-----
-
-Well, first of all - BECAUSE the server isn't released and tested yet
-this might change all a few times more :), so don't rush your implementation.
-
-Most important changes ALREADY are:
-
-- - There will be a NEW numeric (249 was already used I learned).
-- - The trick with +ss <large number> will NOT work, you can use
- +ss +<large number> now (note the extra '+').
-
-I see no problem in attaching the digits to the s.. thus:
-
-/MODE Run +s29382
-
-It just doesn't look as well... and users might type a space intuitively.
-There is no problem with MY ircII (-2.8.2) client and multiple umode params...
-
-We DID have a long discussion about this yes, because initially we wanted
-to use server-notice-channels. But that sucks for multi-window clients like
-mIRC (without patches), so we ended up by making a new user mode.
-It seems likely that more then 31 server-notice-"channels" will be needed
-yes, in which case a decimal number is bad thing to do.
-I'm open for a quick discussion on a new interface.
-
-Run
-
-PS Please forward this to other client-coders again :)
- Is there a list of addresses I could use ?
-
-
-| ------- Forwarded Message
-|
-| Received: from SOUTH-STATION-ANNEX.MIT.EDU by po9.MIT.EDU (5.61/4.7) id AA06626; Wed, 26 Feb 97 00:17:20 EST
-| Received: from listopher.concentric.net by MIT.EDU with SMTP
-| id AA10334; Wed, 26 Feb 97 00:17:18 EST
-| Received: (from majordom@localhost)
-| by listopher.concentric.net (8.8.3/8.8.3)
-| id AAA18002; Wed, 26 Feb 1997 00:14:09 -0500 (EST)
-| Message-Id: <199702260512.XAA00381@brain.acronet.net>
-| To: ircii-epic@concentric.net
-| From: jnelson@acronet.net
-| Subject: Re: Ircii-epic: New Undernet feature
-| In-Reply-To: Your message of "Tue, 25 Feb 1997 19:49:37 EST."
-| <9702260049.AA12854@starkiller.MIT.EDU>
-| Date: Tue, 25 Feb 1997 23:12:45 -0600
-| Sender: owner-ircii-epic@concentric.net
-| Precedence: bulk
-|
-|
-| (Specifically to Kev, in general to everyone on the list...)
-| Forward this to anyone you think is interested in my opinion...
-|
-|
-| >One can set this way a more specific filter for server notices:
-|
-| [user mode +s takes an argument now]
-|
-|
-| Please note the importance of this: This proposal would stipulate
-| the first user mode that is to take an argument. While this is not
-| (neccesarily) against the spirit of modes, i would make an educated
-| guess that ircII is not the only client in the world that optimizes
-| its handling of user modes with the assumption that arguments are not
-| present.
-|
-| The reason why this is significant is not because of the specific use
-| of the argument, but rather that current clients will have to be retro
-| fitted with code that will be able to handle arguments on user modes,
-| and the fact that since you are overloading a current user mode, you
-| are introducing a gratuitous incompatability which makes the job of a
-| client coder all that much harder becuase now ill have to special case
-| the undernet 2.10 server for this exceptional behavior. It is very fair
-| to say that this is <not> an insignificant change.
-|
-| While i will probably support this before its all said and done, I want
-| to make sure that I tell you that I HOPE you thought about this and ruled
-| out all other reasonable solutions other than having user modes take
-| arguments. I dont expect this to change, and thats the way it is:
-| I do appreciate your giving far advance notice instead of just releasing
-| the code and then griping that current clients dont support it correctly.
-| (ala efnet 2.9)
-|
-| This will certainly not be supported or retrofitted on any already
-| released EPIC client (eg, epic3), but probably will eventually be supported
-| in the EPIC4 development cycle. I cannot give you any assurances when.
-| Please re-assure me that you will always have less than 32 flags for this
-| new user mode.
-|
-| Jeremy
-|
-| ------- End of Forwarded Message
-|
-|
-| --
-| Kevin L. Mitchell
-| ----------------------------------------------------------
-| kev@undernet.org kev@wildstar.net klmitch@mit.edu
-| PGP keys: http://web.mit.edu/klmitch/www/pgp.html
-| Home Page: http://web.mit.edu/klmitch/www/
-
-- --
- carlo@runaway.xs4all.nl, Run @ IRC.
-
- ircd development: http://www.xs4all.nl/~carlo17/ircd-dev
-
------BEGIN PGP SIGNATURE-----
-Version: 2.6.3i
-Charset: noconv
-
-iQCVAwUBMxSc6m/Sxh1iSsrVAQFyhwQAqwywucW2iJ6vfcngjM2rRr71tUskM0L6
-pfRe+k7nnU3090urxes5oaJdGR+3w/8sA526d4I6RLHgz156gZX06vPimRMmNteB
-eZOzbU2C01hOBIHJFdtsv+NHTrYrt9+bs5dHEwLW1MXig4girAsHW0NZ9NBPUpLU
-VpXOAE+6Vpk=
-=Iu1Y
------END PGP SIGNATURE-----
-
+++ /dev/null
-Waste time on IRC using ZenIRC
-
-With ZenIRC you can connect to IRC servers and waste time.
-ZenIRC runs under Emacs-18, Emacs-19, Epoch and XEmacs.
-This manual describes ZenIRC version 3.0.
-
-
-\f 1--Introduction
-
-
-If ZenIRC is installed properly, starting ZenIRC without any
-extensions is fairly easy--you just type `M-x zenirc' in your Emacs.
-
-If ZenIRC isn't installed at all, you probably won't be able to read
-this manual. Turn to the "INSTALL" file which comes with the
-distribution of ZenIRC-3.0.
-
-If ZenIRC is installed but you still can't start it, there's a big
-chance that you can't connect to the default server.
-
-
-\f 1.1--Finding an IRC server and connecting to it.
-
-
-There's only one default server for ZenIRC, irc.stealth.net. This
-server might, of course, be down or unreachable. If this is so, you
-need to connect to another server for ZenIRC to work.
-
-ZenIRC comes with a list of servers maintained by Doug McLaren. The
-list is from 1996-04-15 so it might not be correct. This list is
-posted to the Usenet group alt.irc and alt.irc.questions twice a
-month and a copy of it can be found via anonymous FTP at
- ftp.comco.com:/pub/irc/server-list-current
-
-
-\f 1.1.1--Changing default server (and attributes).
-
-
-There's three different ways to change your default server. They're
-listed below in the prefered order. If you use example 1.1.1.1 or
-1.1.1.2 you'll get some redundancy example 1.1.1.3 can't give you.
-1.1.1.3 is good if you want to start right away and set things up
-later on in life.
-
-
-\f 1.1.1.1--The $IRCSERVER way.
-
-
-By setting your environment variable $IRCSERVER you also change the
-default servers for most other IRC clients around. How to set this
-variable is different in different shells.
-
- sh, bash, zsh; IRCSERVER="some.server";export IRCSERVER
- csh, tcsh; setenv IRCSERVER "some.server"
-
-ZenIRC uses this variable just like ircII. The correct syntax is;
-
- server1[:port1[:password1[:nickname1[:username1]]]] server2[:port2...
-
-To set your default server to irc.stealth.net with the nickname `ben'
-and your secondary server to irc.funet.fi on port 6666 with the
-nickname Vesa you would set $IRCSERVER to;
-
- irc.stealth.net:::ben: irc.funet.fi:6666::Vesa:
-
-
-\f 1.1.1.2--The zenirc-server-alist way.
-
-
-By setting the ZenIRC variable zenirc-server-alist you can do the same
-thing as with $IRCSERVER, this way you won't have the same defaults
-for other clients though.
-
-To do exactly as the example in 1.1.1.1, you should set
-zenirc-server-alist as follows;
-
- (setq zenirc-server-alist
- '(("irc.stealth.net" nil nil "ben" nil)
- ("irc.funet.fi" 6666 nil "Vesa" nil)))
-
-
-\f 1.1.1.3--Using ordinary variables.
-
-
-The only thing you actually _need_ to set is zenirc-server-default.
-
-To set your default server, use zenirc-server-default;
-
- (setq zenirc-server-default "irc.stealth.net")
-
-To set your default nickname, use zenric-nick-default;
-
- (setq zenirc-nick-default "ben")
-
-To set your default password, use zenric-password-default;
-
- (setq zenirc-password-default "mostly not used")
-
-To set your default port, use zenirc-port-default;
-
- (setq zenirc-port-default 6667)
-
-To set your default username, use zenirc-user-login-name-default;
-
- (setq zenirc-user-login-name-default "oedipus rpc.rexd")
-
-
-\f 1.1.2--Those servers are all down.
-
-
-If you don't want to restart Emacs and ZenIRC to try a new server,
-type `M-x zenirc-select' and you will be asked a few questions.
-
-
-\f 1.1.3--The server doesn't let me on?!
-
-
-The IRC administrators might not want people from everywhere to
-connect to his server. I'd recomend you to use an as closeby server as
-possible. The list of servers lists the server by country, the best
-shot would be to use one as close to you as possible.
-
-There's also a possiblity that the admin has banned your domain. If
-this is true, talk to your system administrator about it.
-
-Some servers won't let you connect if your system isn't running an
-IDENT service. This breaks the RFC for IDENT so be sure to tell the
-administrator of the server about this idiocy, then go on and pick a
-better server.
-
-
-\f 2--Using ZenIRC to waste time.
-
-
-Once you've conected to a server, Emacs will enter ZenIRC
-major-mode. This mode parses information from the server and shows it
-to you in different ways, it also give you a nice interface to send
-things to the server. ZenIRCs major-mode also understands CTCP and
-parts of the DCC protocol.
-
-
-\f 2.1--What goes on in the background?
-
-
-Lots of things. If you don't know much elisp and just want to use the
-client you couldn't be less bothered actually. If you really are
-interested in the internals of ZenIRC you should join one or more of
-the ZenIRC mailinglists, read the source and play around a little.
-Changing small things and adding some small nifty hooks are pretty
-trivial though, read more about that in SECTION and SECTION.
-
-
-\f 2.1.1--Communicating with the server.
-
-
-Sending stuff to the server is done by hitting return (^M). ZenIRC
-parses the things you send to the server in two different ways,
-depending on the first character you type. With a leading "/" (you can
-change this by setting zenirc-commandchar) ZenIRC parses your line as
-a command. Without the leading "/" ZenIRC sends your line as a message
-to your current victim, this is done with PRIVMSG as described in
-RFC1459.
-
-Example, if the channel #se-opers is your zenric-current-victim and
-you type;
-
- Hello people^M
-
-the clients on channel #se-opers will see your message. Use the /query
-command to change zenirc-current-victim. :LINK:
-
-On the other hand, if you type;
-
- /part #se-opers^M
-
-you will part the channel. Look in 2.2 for an extensive list of all
-commands and how to use them.
-
-
-\f 2.1.2--Server communicating with you.
-
-ZenIRC parses all the information the servers sends to you in one way
-or the other. On a few occasions ZenIRC might lack the information on
-how to parse a certain thing, this is almost considered a bug (use M-x
-zenirc-bug to report this behaviour).
-
-To display the information, ZenIRC uses language catalogs. The default
-catalog is English, but this can be changed easily. Writing your own
-catalog is trivial and we'd love you if you wrote your own catalog and
-mailed it in to the developers.
-
-There's a lot of different variables you can change, and hooks to play
-with if you feel adventureous. You can, for example, ignore people,
-make ZenIRC beep when something special happens, have timestamps on
-special messages and so forth. The variables are described in SECTION
-and the hooks are described in SECTION.
-
-`zenirc.el' only contains the most important features, some very nice
-features are placed in their own files. `zenirc-fill.el', for example,
-fills certain messages for you so Emacs doesn't have to wrap long
-lines in an ugly way. Read more about scripts in SECTION.
-
-
-\f 2.2--Commands in ZenIRC major-mode.
-
-
-As already described, ZenIRC pareses lines with a leading "/" as a
-command. Most of the commands are sent right off to the server, some
-commands are ZenIRC specific though.
-
-
-\f 3.2.1--Non ZenIRC specific commands.
-
-
-A list of these commands can be found in RFC1459, this list is just a
-brief description on how to use different commands. Go read RFC1459 if
-you want to learn really nifty stuff.
-
-Things inside []'s are optional. If the optional argument is a server,
-using a nickname will list information about the server that nickname
-is using.
-
-/nick nickname
- Change your nickname
-
-/quit comment
- Stop wasting time, with optional comment.
-
-/join channel[,channel] [key[,key]]
- Join one or more comma separated channels with given optional keys.
- zenirc-current-victim is set to the last joined channel.
-
-/part channel[,channel] [comment]
- Part one or more comma separated channels, with optional comment.
- If you part your zenirc-current-victim, it is set to 'nil'.
-
-/mode nickname [mode]
- Check or change modes for a given nickname. See RFC1459 for an
- extensive list of modes.
-
-/mode channel [mode [person]]
- Check or change modes for a channel, or the mode of a nickname
- on a channel. See RFC1459 for an extensive list of modes.
-
-/topic channel [topic]
- Check or change topic of a certain channel.
-
-/names channel[,channel]
- See who's on one or more comma separated channels.
-
-/list [channel[,channel] [server]]
- Lists all, one or a comma separated list of channels. With
- given server it lists channels from that servers view.
-
-/invite nickname channel
- Invite person to given channel name.
-
-/kick channel nickname [comment]
- Kick person on given channel with an optional comment.
-
-/version [server]
- Returns version of current or given server.
-
-/stats query [server]
- Returns information about that server (go read RFC1459).
- Read SECTION for an extensive list of query types.
-
-/links [[<remote server>] <server mask>]
- Lists all links or links matching a given mask, with optional
- <remote server> it lists links seen from that server.
-
-/time [server]
- Returns time from current or given server.
-
-/trace nickname
- Returns the server route to given nickname.
-
-/trace [server]
- Returns information on what's connected to the current server,
- or a route to given server as well as things connected to it.
-
-/admin [server]
- List administrative information for current or given server.
-
-/info [server]
- List version, compile date, patchlevel, starttime and other
- various information about current or given server.
-
-/privmsg nickname/channel text
- Send text as a PRIVMSG to nickname/channel.
-
-/notice nickname/channel text
- Send text as a NOTICE to nickname/channel.
-
-/who [<nick/user/server>mask [o]]
- List short information about everyone on IRC or given
- nickname, username or servername. With optional [o] argument
- it lists person with their IRC operator flag set.
- This command takes UNIX like masks ("?" and "*").
-
-/whois [server] nickmask[,nickmask]
- List long information about given nickname, with optional
- server argument it lists information as seen from that server.
-
-/whowas nickname [count [server]]
- List long information about nickname not currently on the
- connected servers but still in the WHOWAS database. With given
- argument count, list that many old entries from the database.
- With given server argument, list information as seen from that
- server.
-
-/away [message]
- Remove away message, with optional argument it sets a new
- away message instead.
-
-/users [server]
- List users logged in to current server or another server.
-
-/summon user [server]
- Invite a user logged in to current server or another server.
-
-/userhost nickname [nickname [nickname]]
- Returns short information about a whitespace separated list of
- nicknames.
-
-/ison nickname [nickname [nickname]]
- Returns wheter given, whitespace separated, nicknames are
- on this IRC net.
-
-
-\f 2.2.2--ZenIRC specific commands.
-
-
-/action nickname/channel text
- Send text as a CTCP ACTION to given nickname/channel. To send
- text to more then one nickname/channel, use a comma separated
- list.
-
-/commandchar char
- Change your commandchar to char, for example;
-
- /commandchar &
-
- A good example is then;
-
- &commandchar /
-
-/ctcp nickname/channel <CTCP QUERY>
- Send <CTCP QUERY> to a comma separated list of nicknames and
- channels.
-
-/language language
- Change your language catalog to given language. Read SECTION
- for more information about existing catalogs.
-
-/m
-/msg
- A shortcut for "/privmsg"
-
-/me text
- Send text as a CTCP ACTION to zenirc-current-victim.
-
-/ping nickname/channel
- Send CTCP PING to a comma separated list of nicknames and
- channels.
-
-/query [nickname/channel]
- Show or change zenirc-current-victim to a comma separated list
- of nicknames and channels.
-
-/quote text
- Sends text directly to the server. You might need this as
- ZenIRC uses the same name as the server on some commands,
- for example;
-
- /quote ping server [<remote server>]
- Ping current server, with given <remote server>
- argument it pings the remote server instead.
-
-/server [server [port [nickname]]]
- Connect to a server in a new ZenIRC-buffer.
- This is bound to zenirc-select. If no options are used, ZenIRC
- will ask you some questions.
-
-
-\f 2.3--Keybindings in ZenIRC major-mode.
-
-
-Hitting certain key combinations in ZenIRC will result in ZenIRC doing
-stuff you didn't think it would. This is really nifty, when you
-realize what actually happens HELLO PER
-
- 2.3.1
-
-
- Hitting return ("\n" or "^M") will send the current line to the
-server. If you're looking through the backlog and hit return, ZenIRC
-will throw you to the end of the buffer.
-
-Hitting ; or : at the beginning of the line will help you while
-communicating to others then your zenirc-current-victim. For example;
-
-/msg omnion meep
-/msg ace95 meep
-*Omnion* meep meep
-
-Hitting ";" now will result in ZenIRC adding "/msg ace95 " at the
-beginning of the line.
-Hitting ":" will result in ZenIRC adding "/msg omnion " at the
-beginning of the line.
-
-By using a few of the scripts which comes with ZenIRC you can get
-tab-completion and a shell like history feature, more about that in
-SECTION.
-
-
-\f 3--It's working, now I want it to Look Good and Feel Good.
-
-
-The default look of ZenIRC is pretty sparse.
\ No newline at end of file
+++ /dev/null
-@tex
-\def\line{\hbox to\hsize}
-\def\centerline#1{\line{\hss#1\hss}}
-@end tex
-\input psfig
-\input texinfo @c -*-texinfo-*-
-@c ----------------------------------------------------------------------
-@c Time-stamp: <Fri Oct 11 1996 23:10:26 Stardate: [-31]8254.61 hwloidl>
-@c
-@c Hacked TeXInfo file (based on the zenirc.ascii file in version 2.107)
-@c ----------------------------------------------------------------------
-
-@c %**start of header
-@setfilename zenirc.info
-@settitle ZenIRC Info Pages
-@direntry
-* ZenIRC: (zenirc). Internet Relay Chat in the Emacs World.
-@end direntry
-@c footnotestyle separate
-@c paragraphindent 2
-@c %**end of header
-
-@comment New index for options
-@c @defindex op
-@c @syncodeindex op cp
-
-@titlepage
-@sp 10
-@comment The title is printed in a large font.
-@center @titlefont{ZenIRC Info Pages}
-@center Version 2.107
-@sp 1
-@center October 1996
-@sp 5
-@c @center Hans-Wolfgang Loidl
-@c @center @t{hwloidl@@dcs.gla.ac.uk}
-@c The following two commands start the copyright page.
-@page
-@end titlepage
-
-@c ----------------------------------------------------------------------
-
-@ifnottex
-@node Top, Introduction, (dir), (dir)
-@comment node-name, next, previous, up
-@top ZenIRC Info Pages
-@end ifnottex
-
-Waste time on IRC using ZenIRC
-
-With ZenIRC you can connect to IRC servers and waste time.
-ZenIRC runs under Emacs-18, Emacs-19, Epoch and XEmacs.
-This manual describes ZenIRC version 3.0.
-
-@menu
-* Introduction::
-* Using ZenIRC to waste time.::
-* It's working::
-* Function Index::
-
- --- The Detailed Node Listing ---
-
-Introduction
-
-* Finding an IRC server and connecting to it.::
-
-Finding an IRC server and connecting to it.
-
-* Changing default server (and attributes).::
-* Those servers are all down.::
-* The server doesn't let me on?!::
-
-Changing default server (and attributes).
-
-* The $IRCSERVER way.::
-* The zenirc-server-alist way.::
-* Using ordinary variables.::
-
-Using ZenIRC to waste time.
-
-* What goes on in the background? ::
-* Commands in ZenIRC major-mode.::
-* Keybindings in ZenIRC major-mode.::
-
-What goes on in the background?
-
-* Communicating with the server.::
-* Server communicating with you.::
-
-Commands in ZenIRC major-mode.
-
-* Non ZenIRC specific commands.::
-* ZenIRC specific commands.::
-@end menu
-
-@node Introduction, Using ZenIRC to waste time., Top, Top
-@comment node-name, next, previous, up
-@chapter Introduction
-
-
-
-If ZenIRC is installed properly, starting ZenIRC without any
-extensions is fairly easy--you just type `M-x zenirc' in your Emacs.
-
-If ZenIRC isn't installed at all, you probably won't be able to read
-this manual. Turn to the "INSTALL" file which comes with the
-distribution of ZenIRC-3.0.
-
-If ZenIRC is installed but you still can't start it, there's a big
-chance that you can't connect to the default server.
-
-
-@menu
-* Finding an IRC server and connecting to it.::
-@end menu
-
-@node Finding an IRC server and connecting to it., , Introduction, Introduction
-@comment node-name, next, previous, up
-@section Finding an IRC server and connecting to it.
-
-
-
-There's only one default server for ZenIRC, irc.stealth.net. This
-server might, of course, be down or unreachable. If this is so, you
-need to connect to another server for ZenIRC to work.
-
-ZenIRC comes with a list of servers maintained by Doug McLaren. The
-list is from 1996-04-15 so it might not be correct. This list is
-posted to the Usenet group alt.irc and alt.irc.questions twice a
-month and a copy of it can be found via anonymous FTP at
- ftp.comco.com:/pub/irc/server-list-current
-
-
-@menu
-* Changing default server (and attributes).::
-* Those servers are all down.::
-* The server doesn't let me on?!::
-@end menu
-
-@node Changing default server (and attributes)., Those servers are all down., Finding an IRC server and connecting to it., Finding an IRC server and connecting to it.
-@comment node-name, next, previous, up
-@subsection Changing default server (and attributes).
-
-
-
-There's three different ways to change your default server. They're
-listed below in the prefered order. If you use example 1.1.1.1 or
-1.1.1.2 you'll get some redundancy example 1.1.1.3 can't give you.
-1.1.1.3 is good if you want to start right away and set things up
-later on in life.
-
-
-@menu
-* The $IRCSERVER way.::
-* The zenirc-server-alist way.::
-* Using ordinary variables.::
-@end menu
-
-@node The $IRCSERVER way., The zenirc-server-alist way., Changing default server (and attributes)., Changing default server (and attributes).
-@comment node-name, next, previous, up
-@subsubsection The $IRCSERVER way.
-
-
-
-By setting your environment variable $IRCSERVER you also change the
-default servers for most other IRC clients around. How to set this
-variable is different in different shells.
-
- sh, bash, zsh; IRCSERVER="some.server";export IRCSERVER
- csh, tcsh; setenv IRCSERVER "some.server"
-
-ZenIRC uses this variable just like ircII. The correct syntax is;
-
- server1[:port1[:password1[:nickname1[:username1]]]] server2[:port2...
-
-To set your default server to irc.stealth.net with the nickname `ben'
-and your secondary server to irc.funet.fi on port 6666 with the
-nickname Vesa you would set $IRCSERVER to;
-
- irc.stealth.net:::ben: irc.funet.fi:6666::Vesa:
-
-
-@node The zenirc-server-alist way., Using ordinary variables., The $IRCSERVER way., Changing default server (and attributes).
-@comment node-name, next, previous, up
-@subsubsection The zenirc-server-alist way.
-
-
-
-By setting the ZenIRC variable zenirc-server-alist you can do the same
-thing as with $IRCSERVER, this way you won't have the same defaults
-for other clients though.
-
-To do exactly as the example in 1.1.1.1, you should set
-zenirc-server-alist as follows;
-
-@example
- (setq zenirc-server-alist
- '(("irc.stealth.net" nil nil "ben" nil)
- ("irc.funet.fi" 6666 nil "Vesa" nil)))
-@end example
-
-
-@node Using ordinary variables., , The zenirc-server-alist way., Changing default server (and attributes).
-@comment node-name, next, previous, up
-@subsubsection Using ordinary variables.
-
-
-
-The only thing you actually _need_ to set is zenirc-server-default.
-
-To set your default server, use zenirc-server-default;
-
-@example
- (setq zenirc-server-default "irc.stealth.net")
-@end example
-
-To set your default nickname, use zenric-nick-default;
-
-@example
- (setq zenirc-nick-default "ben")
-@end example
-
-To set your default password, use zenric-password-default;
-
-@example
- (setq zenirc-password-default "mostly not used")
-@end example
-
-To set your default port, use zenirc-port-default;
-
-@example
- (setq zenirc-port-default 6667)
-@end example
-
-To set your default username, use zenirc-user-login-name-default;
-
-@example
- (setq zenirc-user-login-name-default "oedipus rpc.rexd")
-@end example
-
-
-@node Those servers are all down., The server doesn't let me on?!, Changing default server (and attributes)., Finding an IRC server and connecting to it.
-@comment node-name, next, previous, up
-@subsection Those servers are all down.
-
-
-
-If you don't want to restart Emacs and ZenIRC to try a new server,
-type `M-x zenirc-select' and you will be asked a few questions.
-
-
-@node The server doesn't let me on?!, , Those servers are all down., Finding an IRC server and connecting to it.
-@comment node-name, next, previous, up
-@subsection The server doesn't let me on?!
-
-
-
-The IRC administrators might not want people from everywhere to
-connect to his server. I'd recomend you to use an as closeby server as
-possible. The list of servers lists the server by country, the best
-shot would be to use one as close to you as possible.
-
-There's also a possiblity that the admin has banned your domain. If
-this is true, talk to your system administrator about it.
-
-Some servers won't let you connect if your system isn't running an
-IDENT service. This breaks the RFC for IDENT so be sure to tell the
-administrator of the server about this idiocy, then go on and pick a
-better server.
-
-
-@node Using ZenIRC to waste time., It's working, Introduction, Top
-@comment node-name, next, previous, up
-@chapter Using ZenIRC to waste time.
-
-
-
-Once you've conected to a server, Emacs will enter ZenIRC
-major-mode. This mode parses information from the server and shows it
-to you in different ways, it also give you a nice interface to send
-things to the server. ZenIRCs major-mode also understands CTCP and
-parts of the DCC protocol.
-
-
-@menu
-* What goes on in the background? ::
-* Commands in ZenIRC major-mode.::
-* Keybindings in ZenIRC major-mode.::
-@end menu
-
-@node What goes on in the background? , Commands in ZenIRC major-mode., Using ZenIRC to waste time., Using ZenIRC to waste time.
-@comment node-name, next, previous, up
-@section What goes on in the background?
-
-
-
-Lots of things. If you don't know much elisp and just want to use the
-client you couldn't be less bothered actually. If you really are
-interested in the internals of ZenIRC you should join one or more of
-the ZenIRC mailinglists, read the source and play around a little.
-Changing small things and adding some small nifty hooks are pretty
-trivial though, read more about that in SECTION and SECTION.
-
-
-@menu
-* Communicating with the server.::
-* Server communicating with you.::
-@end menu
-
-@node Communicating with the server., Server communicating with you., What goes on in the background? , What goes on in the background?
-@comment node-name, next, previous, up
-@subsection Communicating with the server.
-
-
-
-Sending stuff to the server is done by hitting return (^M). ZenIRC
-parses the things you send to the server in two different ways,
-depending on the first character you type. With a leading "/" (you can
-change this by setting zenirc-commandchar) ZenIRC parses your line as
-a command. Without the leading "/" ZenIRC sends your line as a message
-to your current victim, this is done with PRIVMSG as described in
-RFC1459.
-
-Example, if the channel #se-opers is your zenric-current-victim and
-you type;
-
-@example
- Hello people^M
-@end example
-
-the clients on channel #se-opers will see your message. Use the /query
-command to change zenirc-current-victim. :LINK:
-
-On the other hand, if you type;
-
-@example
- /part #se-opers^M
-@end example
-
-you will part the channel. Look in 2.2 for an extensive list of all
-commands and how to use them.
-
-
-@node Server communicating with you., , Communicating with the server., What goes on in the background?
-@comment node-name, next, previous, up
-@subsection Server communicating with you.
-
-
-ZenIRC parses all the information the servers sends to you in one way
-or the other. On a few occasions ZenIRC might lack the information on
-how to parse a certain thing, this is almost considered a bug (use M-x
-zenirc-bug to report this behaviour).
-
-To display the information, ZenIRC uses language catalogs. The default
-catalog is English, but this can be changed easily. Writing your own
-catalog is trivial and we'd love you if you wrote your own catalog and
-mailed it in to the developers.
-
-There's a lot of different variables you can change, and hooks to play
-with if you feel adventureous. You can, for example, ignore people,
-make ZenIRC beep when something special happens, have timestamps on
-special messages and so forth. The variables are described in SECTION
-and the hooks are described in SECTION.
-
-`zenirc.el' only contains the most important features, some very nice
-features are placed in their own files. `zenirc-fill.el', for example,
-fills certain messages for you so Emacs doesn't have to wrap long
-lines in an ugly way. Read more about scripts in SECTION.
-
-
-@node Commands in ZenIRC major-mode., Keybindings in ZenIRC major-mode., What goes on in the background? , Using ZenIRC to waste time.
-@comment node-name, next, previous, up
-@section Commands in ZenIRC major-mode.
-
-
-
-As already described, ZenIRC pareses lines with a leading "/" as a
-command. Most of the commands are sent right off to the server, some
-commands are ZenIRC specific though.
-
-
-@menu
-* Non ZenIRC specific commands.::
-* ZenIRC specific commands.::
-@end menu
-
-@node Non ZenIRC specific commands., ZenIRC specific commands., Commands in ZenIRC major-mode., Commands in ZenIRC major-mode.
-@comment node-name, next, previous, up
-@subsection Non ZenIRC specific commands.
-
-
-
-A list of these commands can be found in RFC1459, this list is just a
-brief description on how to use different commands. Go read RFC1459 if
-you want to learn really nifty stuff.
-
-Things inside []'s are optional. If the optional argument is a server,
-using a nickname will list information about the server that nickname
-is using.
-
-@deffn Command /nick nickname
- Change your nickname
-
-@end deffn
-@deffn Command /quit comment
- Stop wasting time, with optional comment.
-
-@end deffn
-@deffn Command /join channel[,channel] [key[,key]]
- Join one or more comma separated channels with given optional keys.
- zenirc-current-victim is set to the last joined channel.
-
-@end deffn
-@deffn Command /part channel[,channel] [comment]
- Part one or more comma separated channels, with optional comment.
- If you part your zenirc-current-victim, it is set to 'nil'.
-
-@end deffn
-@deffn Command /mode nickname [mode]
- Check or change modes for a given nickname. See RFC1459 for an
- extensive list of modes.
-
-@end deffn
-@deffn Command /mode channel [mode [person]]
- Check or change modes for a channel, or the mode of a nickname
- on a channel. See RFC1459 for an extensive list of modes.
-
-@end deffn
-@deffn Command /topic channel [topic]
- Check or change topic of a certain channel.
-
-@end deffn
-@deffn Command /names channel[,channel]
- See who's on one or more comma separated channels.
-
-@end deffn
-@deffn Command /list [channel[,channel] [server]]
- Lists all, one or a comma separated list of channels. With
- given server it lists channels from that servers view.
-
-@end deffn
-@deffn Command /invite nickname channel
- Invite person to given channel name.
-
-@end deffn
-@deffn Command /kick channel nickname [comment]
- Kick person on given channel with an optional comment.
-
-@end deffn
-@deffn Command /version [server]
- Returns version of current or given server.
-
-@end deffn
-@deffn Command /stats query [server]
- Returns information about that server (go read RFC1459).
- Read SECTION for an extensive list of query types.
-
-@end deffn
-@deffn Command /links [[<remote server>] <server mask>]
- Lists all links or links matching a given mask, with optional
- <remote server> it lists links seen from that server.
-
-@end deffn
-@deffn Command /time [server]
- Returns time from current or given server.
-
-@end deffn
-@deffn Command /trace nickname
- Returns the server route to given nickname.
-
-@end deffn
-@deffn Command /trace [server]
- Returns information on what's connected to the current server,
- or a route to given server as well as things connected to it.
-
-@end deffn
-@deffn Command /admin [server]
- List administrative information for current or given server.
-
-@end deffn
-@deffn Command /info [server]
- List version, compile date, patchlevel, starttime and other
- various information about current or given server.
-
-@end deffn
-@deffn Command /privmsg nickname/channel text
- Send text as a PRIVMSG to nickname/channel.
-
-@end deffn
-@deffn Command /notice nickname/channel text
- Send text as a NOTICE to nickname/channel.
-
-@end deffn
-@deffn Command /who [<nick/user/server>mask [o]]
- List short information about everyone on IRC or given
- nickname, username or servername. With optional [o] argument
- it lists person with their IRC operator flag set.
- This command takes UNIX like masks ("?" and "*").
-
-@end deffn
-@deffn Command /whois [server] nickmask[,nickmask]
- List long information about given nickname, with optional
- server argument it lists information as seen from that server.
-
-@end deffn
-@deffn Command /whowas nickname [count [server]]
- List long information about nickname not currently on the
- connected servers but still in the WHOWAS database. With given
- argument count, list that many old entries from the database.
- With given server argument, list information as seen from that
- server.
-
-@end deffn
-@deffn Command /away [message]
- Remove away message, with optional argument it sets a new
- away message instead.
-
-@end deffn
-@deffn Command /users [server]
- List users logged in to current server or another server.
-
-@end deffn
-@deffn Command /summon user [server]
- Invite a user logged in to current server or another server.
-
-@end deffn
-@deffn Command /userhost nickname [nickname [nickname]]
- Returns short information about a whitespace separated list of
- nicknames.
-
-@end deffn
-@deffn Command /ison nickname [nickname [nickname]]
- Returns wheter given, whitespace separated, nicknames are
- on this IRC net.
-@end deffn
-
-
-@node ZenIRC specific commands., , Non ZenIRC specific commands., Commands in ZenIRC major-mode.
-@comment node-name, next, previous, up
-@subsection ZenIRC specific commands.
-
-
-
-@deffn Command /action nickname/channel text
- Send text as a CTCP ACTION to given nickname/channel. To send
- text to more then one nickname/channel, use a comma separated
- list.
-
-@end deffn
-@deffn Command /commandchar char
- Change your commandchar to char, for example;
-
-@example
- /commandchar &
-@end example
-
- A good example is then;
-
-@example
- &commandchar /
-@end example
-
-@end deffn
-@deffn Command /ctcp nickname/channel <CTCP QUERY>
-
- Send @code{<CTCP QUERY>} to a comma separated list of nicknames and
- channels.
-
-@end deffn
-@deffn Command /language language
-
- Change your language catalog to given language. Read SECTION
- for more information about existing catalogs.
-
-@end deffn
-@deffn Command /m
-@deffnx Command /msg
-
- A shortcut for "/privmsg"
-
-@end deffn
-@deffn Command /me text
-
- Send text as a CTCP ACTION to zenirc-current-victim.
-
-@end deffn
-@deffn Command /ping nickname/channel
-
- Send CTCP PING to a comma separated list of nicknames and
- channels.
-
-@end deffn
-@deffn Command /query [nickname/channel]
-
- Show or change zenirc-current-victim to a comma separated list
- of nicknames and channels.
-
-@end deffn
-@deffn Command /quote text
-
- Sends text directly to the server. You might need this as
- ZenIRC uses the same name as the server on some commands,
- for example;
-
-@example
- /quote ping server [<remote server>]
-@end example
- Ping current server, with given <remote server>
- argument it pings the remote server instead.
-
-@end deffn
-@deffn Command /server [server [port [nickname]]]
- Connect to a server in a new ZenIRC-buffer.
- This is bound to zenirc-select. If no options are used, ZenIRC
- will ask you some questions.
-@end deffn
-
-
-@node Keybindings in ZenIRC major-mode., , Commands in ZenIRC major-mode., Using ZenIRC to waste time.
-@comment node-name, next, previous, up
-@section Keybindings in ZenIRC major-mode.
-
-
-
-Hitting certain key combinations in ZenIRC will result in ZenIRC doing
-stuff you didn't think it would. This is really nifty, when you
-realize what actually happens HELLO PER
-
- 2.3.1
-
-
- Hitting return ("\n" or "^M") will send the current line to the
-server. If you're looking through the backlog and hit return, ZenIRC
-will throw you to the end of the buffer.
-
-Hitting ; or : at the beginning of the line will help you while
-communicating to others then your zenirc-current-victim. For example;
-
-@example
-/msg omnion meep
-/msg ace95 meep
-*Omnion* meep meep
-@end example
-
-Hitting ";" now will result in ZenIRC adding "/msg ace95 " at the
-beginning of the line.
-Hitting ":" will result in ZenIRC adding "/msg omnion " at the
-beginning of the line.
-
-By using a few of the scripts which comes with ZenIRC you can get
-tab-completion and a shell like history feature, more about that in
-SECTION.
-
-
-@node It's working, Function Index, Using ZenIRC to waste time., Top
-@comment node-name, next, previous, up
-@chapter It's working, now I want it to Look Good and Feel Good.
-
-
-
-The default look of ZenIRC is pretty sparse.
-
-@c ----------------------------------------------------------------------
-
-@node Function Index, , It's working, Top
-@comment node-name, next, previous, up
-@unnumbered Function Index
-
-@printindex fn
-
-@contents
-
-@c @shortcontents
-
-
-@bye
+++ /dev/null
-#!/bin/sh
-#
-# install - install a program, script, or datafile
-# This comes from X11R5.
-#
-# Calling this script install-sh is preferred over install.sh, to prevent
-# `make' implicit rules from creating a file called install from it
-# when there is no Makefile.
-#
-# This script is compatible with the BSD install script, but was written
-# from scratch.
-#
-
-
-# set DOITPROG to echo to test this script
-
-# Don't use :- since 4.3BSD and earlier shells don't like it.
-doit="${DOITPROG-}"
-
-
-# put in absolute paths if you don't have them in your path; or use env. vars.
-
-mvprog="${MVPROG-mv}"
-cpprog="${CPPROG-cp}"
-chmodprog="${CHMODPROG-chmod}"
-chownprog="${CHOWNPROG-chown}"
-chgrpprog="${CHGRPPROG-chgrp}"
-stripprog="${STRIPPROG-strip}"
-rmprog="${RMPROG-rm}"
-mkdirprog="${MKDIRPROG-mkdir}"
-
-tranformbasename=""
-transform_arg=""
-instcmd="$mvprog"
-chmodcmd="$chmodprog 0755"
-chowncmd=""
-chgrpcmd=""
-stripcmd=""
-rmcmd="$rmprog -f"
-mvcmd="$mvprog"
-src=""
-dst=""
-dir_arg=""
-
-while [ x"$1" != x ]; do
- case $1 in
- -c) instcmd="$cpprog"
- shift
- continue;;
-
- -d) dir_arg=true
- shift
- continue;;
-
- -m) chmodcmd="$chmodprog $2"
- shift
- shift
- continue;;
-
- -o) chowncmd="$chownprog $2"
- shift
- shift
- continue;;
-
- -g) chgrpcmd="$chgrpprog $2"
- shift
- shift
- continue;;
-
- -s) stripcmd="$stripprog"
- shift
- continue;;
-
- -t=*) transformarg=`echo $1 | sed 's/-t=//'`
- shift
- continue;;
-
- -b=*) transformbasename=`echo $1 | sed 's/-b=//'`
- shift
- continue;;
-
- *) if [ x"$src" = x ]
- then
- src=$1
- else
- # this colon is to work around a 386BSD /bin/sh bug
- :
- dst=$1
- fi
- shift
- continue;;
- esac
-done
-
-if [ x"$src" = x ]
-then
- echo "install: no input file specified"
- exit 1
-else
- true
-fi
-
-if [ x"$dir_arg" != x ]; then
- dst=$src
- src=""
-
- if [ -d $dst ]; then
- instcmd=:
- else
- instcmd=mkdir
- fi
-else
-
-# Waiting for this to be detected by the "$instcmd $src $dsttmp" command
-# might cause directories to be created, which would be especially bad
-# if $src (and thus $dsttmp) contains '*'.
-
- if [ -f $src -o -d $src ]
- then
- true
- else
- echo "install: $src does not exist"
- exit 1
- fi
-
- if [ x"$dst" = x ]
- then
- echo "install: no destination specified"
- exit 1
- else
- true
- fi
-
-# If destination is a directory, append the input filename; if your system
-# does not like double slashes in filenames, you may need to add some logic
-
- if [ -d $dst ]
- then
- dst="$dst"/`basename $src`
- else
- true
- fi
-fi
-
-## this sed command emulates the dirname command
-dstdir=`echo $dst | sed -e 's,[^/]*$,,;s,/$,,;s,^$,.,'`
-
-# Make sure that the destination directory exists.
-# this part is taken from Noah Friedman's mkinstalldirs script
-
-# Skip lots of stat calls in the usual case.
-if [ ! -d "$dstdir" ]; then
-defaultIFS='
-'
-IFS="${IFS-${defaultIFS}}"
-
-oIFS="${IFS}"
-# Some sh's can't handle IFS=/ for some reason.
-IFS='%'
-set - `echo ${dstdir} | sed -e 's@/@%@g' -e 's@^%@/@'`
-IFS="${oIFS}"
-
-pathcomp=''
-
-while [ $# -ne 0 ] ; do
- pathcomp="${pathcomp}${1}"
- shift
-
- if [ ! -d "${pathcomp}" ] ;
- then
- $mkdirprog "${pathcomp}"
- else
- true
- fi
-
- pathcomp="${pathcomp}/"
-done
-fi
-
-if [ x"$dir_arg" != x ]
-then
- $doit $instcmd $dst &&
-
- if [ x"$chowncmd" != x ]; then $doit $chowncmd $dst; else true ; fi &&
- if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dst; else true ; fi &&
- if [ x"$stripcmd" != x ]; then $doit $stripcmd $dst; else true ; fi &&
- if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dst; else true ; fi
-else
-
-# If we're going to rename the final executable, determine the name now.
-
- if [ x"$transformarg" = x ]
- then
- dstfile=`basename $dst`
- else
- dstfile=`basename $dst $transformbasename |
- sed $transformarg`$transformbasename
- fi
-
-# don't allow the sed command to completely eliminate the filename
-
- if [ x"$dstfile" = x ]
- then
- dstfile=`basename $dst`
- else
- true
- fi
-
-# Make a temp file name in the proper directory.
-
- dsttmp=$dstdir/#inst.$$#
-
-# Move or copy the file name to the temp name
-
- $doit $instcmd $src $dsttmp &&
-
- trap "rm -f ${dsttmp}" 0 &&
-
-# and set any options; do chmod last to preserve setuid bits
-
-# If any of these fail, we abort the whole thing. If we want to
-# ignore errors from any of these, just make sure not to ignore
-# errors from the above "$doit $instcmd $src $dsttmp" command.
-
- if [ x"$chowncmd" != x ]; then $doit $chowncmd $dsttmp; else true;fi &&
- if [ x"$chgrpcmd" != x ]; then $doit $chgrpcmd $dsttmp; else true;fi &&
- if [ x"$stripcmd" != x ]; then $doit $stripcmd $dsttmp; else true;fi &&
- if [ x"$chmodcmd" != x ]; then $doit $chmodcmd $dsttmp; else true;fi &&
-
-# Now rename the file to the real destination.
-
- $doit $rmcmd -f $dstdir/$dstfile &&
- $doit $mvcmd $dsttmp $dstdir/$dstfile
-
-fi &&
-
-
-exit 0
+++ /dev/null
-#! /bin/sh
-# mkinstalldirs --- make directory hierarchy
-# Author: Noah Friedman <friedman@prep.ai.mit.edu>
-# Created: 1993-05-16
-# Last modified: 1994-03-25
-# Public domain
-
-errstatus=0
-
-for file in ${1+"$@"} ; do
- set fnord `echo ":$file" | sed -ne 's/^:\//#/;s/^://;s/\// /g;s/^#/\//;p'`
- shift
-
- pathcomp=
- for d in ${1+"$@"} ; do
- pathcomp="$pathcomp$d"
- case "$pathcomp" in
- -* ) pathcomp=./$pathcomp ;;
- esac
-
- if test ! -d "$pathcomp"; then
- echo "mkdir $pathcomp" 1>&2
- mkdir "$pathcomp" || errstatus=$?
- fi
-
- pathcomp="$pathcomp/"
- done
-done
-
-exit $errstatus
-
-# mkinstalldirs ends here
\ No newline at end of file
+++ /dev/null
-(zenirc
- (standards-version 1.1
- version VERSION
- author-version AUTHOR_VERSION
- date DATE
- build-date BUILD_DATE
- maintainer MAINTAINER
- distribution xemacs
- priority medium
- category CATEGORY
- dump nil
- description "ZENIRC IRC Client."
- filename FILENAME
- md5sum MD5SUM
- size SIZE
- provides (zenirc-18 zenirc-8ball zenirc-away zenirc-bork zenirc-color zenirc-command-queue zenirc-complete zenirc-ctcp-flood zenirc-dcc zenirc-doto zenirc-fill zenirc-finnish zenirc-format zenirc-fortran zenirc-french zenirc-history zenirc-ignore zenirc-iwantop zenirc-klingon zenirc-latin zenirc-meditate zenirc-netsplit zenirc-notify zenirc-oink zenirc-ojnk zenirc-pjg zenirc-popup zenirc-random-away zenirc-random-nick zenirc-signal zenirc-stamp zenirc-swedish zenirc-trigger zenirc-yow-filter zenirc-yow zenirc)
- requires (REQUIRES)
- type regular
-))
+++ /dev/null
-2002-11-29 Ben Wing <ben@xemacs.org>
-
- * .cvsignore: Remove files now handled automatically by CVS.
-
-2002-07-15 Adrian Aichner <adrian@xemacs.org>
-
- * zenirc.el (zenirc-update-modeline): It's XEmacs, not Xemacs.
- * zenirc.el (zenirc-self-insert-or-send-privmsg-last-rec): Ditto.
- * zenirc.el (zenirc-self-insert-or-send-privmsg-last-sent): Ditto.
-
-2001-07-23 Adrian Aichner <adrian@xemacs.org>
-
- * zenirc.el (zenirc-font-lock-keywords): Include last character
- before > in fontification of font-lock-keyword-face. Use OVERRIDE
- flag where appropriate to refine fontification.
-
-Thu May 7 11:49:40 1998 Per Persson <pp@sno.pp.se>
-
- * Version 2.112.
-
- * zenirc-shop.el, removed.
-
- * zenirc-fill.el (zenirc-fill-outgoing): Only fill up to end of
- current line instead of up to end of buffer.
-
- * zenirc.el (zenirc-ctcp-query-ACTION): Add check for
- zenirc-always-show-channelname.
-
-Wed May 6 15:56:44 1998 Ray Jones <rjones@pobox.com>
-
- * zenirc-prime.el, zenirc-eval.el: New files.
-
- * zenirc.el (zenirc-parse-output): Change to call the hooks in
- zenirc-signal-hook with parsedmsg instead of the raw line.
- (zenirc-signal-p): Simplified to no longer check against
- zenirc-ignore-list since that checking is already handled in
- zenirc-parse-output now.
-
- * zenirc-away.el (zenirc-server-301-signal-p): New function.
- (zenirc-signal-hook): Bind the new function.
-
- * zenirc.el (zenirc-display-recipient-confirmation),
- (zenirc-command-privmsg), (zenirc-send-line),
- (zenirc-command-notice), (zenirc-command-me),
- (zenirc-command-action): Simplified send-confirmation code.
-
- * zenirc-dcc.el (zenirc-dcc-catalog-entry): Don't default to
- english.
-
- * zenirc.el (zenirc-handle-ctcp), (zenirc-unbalanced-ctcp): Don't
- default to english.
-
- * zenirc.el (zenirc-lang-retrieve-catalog-entry),
- (zenirc-lang-retrieve-catalog-entry-1): -1 is the old
- function. The new function automatically defaults to english if an
- entry doesn't exist in the current catalouge.
-
- * zenirc.el (zenirc-message): Add newline if message is sent to a
- buffer, but not if sent via message.
- (zenirc-lang-define-english-catalog): Removed all trailing
- newlines.
-
- * zenirc-fill.el: Added internal variable,
- zenirc-window-last-width.
- (zenirc-fill-message): Use the new variable. Pass the new variable
- to zenirc-fill-region-function.
- (zenirc-fill-region), (zenirc-wrap-region),
- (zenirc-wrap-region-dynamic), (zenirc-wrap-region-static): New
- argument win-width to grok the new variable coming from
- zenirc-fill-message.
-
-Wed May 6 16:10:30 1998 Per Persson <pp@sno.pp.se>
-
- * zenirc-example.el (zenirc-startup-channels-alist): New alist.
- (zenirc-startup-join): Use it.
-
- * zenirc-trigger.el: A gentle touch.
-
- * zenirc-swedish.el, zenirc-latin.el, zenirc-klingon.el,
- zenirc-french.el, zenirc-finnish.el, zenirc-bork.el,
- zenirc-trigger.el, zenirc-notify.el, zenirc-netsplit.el,
- zenirc-ignore.el, zenirc-doto.el, zenirc-complete.el,
- zenirc-color.el: Removed all trailing newlines.
-
- * zenirc.el: Added Ray Jones as a major contributor.
- (zenirc-parse-output): Don't signal if the ignore function has
- ignored the string.
-
-Tue May 5 10:35:25 1998 Per Persson <pp@sno.pp.se>
-
- * zenirc-signal.el (zenirc-signal-privmsg): Fixed a typo.
-
-Fri Feb 20 14:17:31 1998 Per Persson <pp@sno.pp.se>
-
- * zenirc-history.el (zenirc-mode-map): Changed mappings to M-p and
- M-n according to ususal standard for Emacs.
-
-Wed Jan 7 10:33:53 1998 Per Persson <pp@sno.pp.se>
-
- * zenirc-fill.el (zenirc-fill-outgoing): Changed from (point-max)
- to 'end' for plain text lines.
-
-Wed Jan 7 08:58:56 1998 Per Persson <pp@sno.pp.se>
-
- * zenirc-example.el: Changed to (require 'zenirc).
-
-Fri Jan 2 05:38:00 1998 Per Persson <pp@sno.pp.se>
-
- * Version 2.111
-
- * zenirc-color.el (zenirc-color-mode): If no prefix arg, toggle
- current state of the mode.
-
- * zenirc-fill.el (zenirc-fill-message-categories): Fixed typo.
- (zenirc-fill-prefix): Back to " | ".
- (zenirc-fill-outgoing-mode): If no prefix arg, toggle current
- state of the mode.
- (zenirc-fill-outgoing): Fixed a bug that didn't exist last time I
- looked.
-
- * zenirc-dcc.el (zenirc-dcc-handle-ctcp-chat): Changed to work
- with the change mentioned below.
- (zenirc-dcc-handle-ctcp-send): Me too!
-
- * zenirc.el (zenirc-names-equal-p): Check whether n1 contains % or
- @ in it if optional argument is t. This is because there's more
- than one way to address a user in a PRIVMSG/NOTICE; namely:
- nickname
- nickname@servername
- username%hostname
- % and @ are forbidden characters in a nickname as of RFC1459,
- hopefully they will stay that way.
- (zenirc-format-privmsg-or-notice): Changed to work with the above.
-
- * zenirc-trigger.el: Moved the code to check for % and & in
- "nickname" to zenirc-names-equal-p instead.
-
-Fri Jan 2 04:28:32 1998 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-parse-words): Use zenirc-match-string instead
- of explicit call to substring.
- (zenirc-parse-firstword): Here also.
- (zenirc-server-002): Here also.
- (zenirc-server-251): Here also.
- (zenirc-server-255): Here also.
-
- * zenirc.el (zenirc-login): Send USER string before NICK.
-
- * zenirc-fill.el (zenirc-fill-mode): If no prefix arg, toggle
- current state of the mode.
-
- * zenirc.el (zenirc): Allow process status of either `open' or
- `run' to indicate a live process.
-
-Thu Dec 25 02:31:15 1997 Per Persson <pp@sno.pp.se>
-
- * zenirc.el, and so forth: Changed Eric Prestemons address to
- ecp@io.com instead of whatever it said before.
-
-Mon Oct 13 05:44:36 1997 Per Persson <pp@sno.pp.se>
-
- * zenirc.el (zenirc-source-list): s/gnu/splode/1
-
-Thu Sep 25 14:13:04 1997 Per Persson <pp@sno.pp.se>
-
- * zenirc.el (zenirc-bug-address): s/gnu/splode/1
-
-Mon Jun 23 05:59:53 1997 Faried Nawaz <fn@Hungry.COM>
-
- * zenirc-trigger.el (zenirc-trigger-register): Fixed typo in
- docstring.
-
-Tue Jun 10 19:47:13 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-format-privmsg-or-notice): Use
- (zenirc-channel-p) instead of other obscure checking.
- Also use (zenirc-names-equal-p) instead of (string-match).
-
-Sun May 4 18:50:11 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-trigger.el (zenirc-trigger-parse-sender): Fixed a bug
- which was triggered when a PRIVMSG used the widely unknown
- "user@server" format.
-
-Wed Apr 23 18:40:40 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * Version 2.110
-
- * zenirc.el (zenirc-toggle-channel): Didn't work properly if user
- mixed cases when joining channels.
- (zenirc-server-JOIN), (zenirc-server-PART): Use
- (zenirc-downcase-name) instead of (downcase).
-
-Sat Mar 29 02:13:03 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-notify.el (zenirc-server-303-notify): Didn't show that a
- certain nick stopped wasting time if the ISON query returned an
- empty string.
-
-Wed Mar 26 10:57:43 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-example.el: More information about zenirc-format.el.
-
-Mon Mar 17 10:14:01 1997 Faried Nawaz <fn@hungry.com>
-
- * Fixed numerous typos.
-
-Fri Mar 14 17:32:09 1997 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-yow-filter.el: New file.
-
-Fri Mar 14 17:32:09 1997 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-popup.el (zenirc-popup): Fix args to walk-windows.
-
-Wed Mar 12 10:06:31 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-example.el: Comments for the new variables. Made sure
- that all variables defaults to the same thing as zenirc.el does.
- New and fancier REGEXP for zenirc-signal-list.
-
- * zenirc.el (zenirc-whowas-on-401): New variable.
- (zenirc-server-401): Use it.
- (zenirc-delete-preceding-whitespaces): New Variable.
- (zenirc-send-line): Use it.
-
- * Updated "copyleft" statements in various files.
-
-Tue Mar 11 17:37:05 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-fill.el (zenirc-fill-outgoing): Changed from triple
- (string= to one (string-match. Also fixed two bugs where internal
- variable end wasn't really the real end. Added comments. Made it
- work together with (zenirc-fill-region). Learned how
- (narrow-to-region) actually works and fixed another bug.
-
-Mon Mar 10 02:14:23 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-example.el: Updated zenirc-fill.el comments.
-
- * zenirc-fill.el (zenirc-wrap-region): Back to what it looked like
- in 2.100.
- (zenirc-wrap-region-dynamic), (zenirc-wrap-region-static),
- (zenirc-fill-outgoing-mode), (zenirc-fill-outgoing): New
- functions.
- (zenirc-fill-outgoing-mode), (zenirc-fill-outgoing-prefix): New
- variables.
- (zenirc-fill-prefix), (zenirc-fill-static): New defaults.
-
-Sun Mar 9 20:38:49 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * Version 2.109
-
- * zenirc-fill.el (zenirc-fill-message-categories): Update it with
- the two new format types.
-
- * zenirc.el (zenirc-format-privmsg-or-notice): Add new format type
- called privmsg_nochannel/notice_nochannel.
- zenirc-always-show-channelname: New variable.
-
- * zenirc-example.el: New entries describing zenirc-trigger.el and
- zenirc-always-show-channelname.
-
-Mon Mar 3 03:09:38 1997 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-yow.el, zenirc-oink.el, zenirc-8ball.el,
- zenirc-fortran.el, zenirc-meditate.el: Total rewrite,
- using zenirc-trigger.el.
-
- * zenirc-trigger.el, zenirc-shop.el: New file.
-
-Mon Feb 24 11:33:21 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-notify.el (zenirc-server-302-notify): Don't show userhost
- reply if it doesn't contain any information.
-
-Mon Feb 3 17:02:42 1997 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-command-part): New command to cope with the
- new optional comment as of ircd 2.9.
-
-Wed Jan 29 18:44:10 1997 Ray Jones <rjones@pobox.com>
-
- * zenirc-example.el: Update (autoload comment to something which
- lets you start ZenIRC interactively.
-
-Fri Dec 20 02:19:06 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-random-nick.el (zenirc-change-nick-mode):
- s/zenirc-change-nick/zenirc-change-nick-mode/g
-
- * zenirc-yow.el: s/zenirc-send-yow/zenirc-yow-mode/g
-
- * zenirc-fill.el (zenirc-fill-mode): Changed default to nil.
-
- * zenirc-color.el (zenirc-color-mode): Changed default to nil.
-
-Sun Dec 15 07:46:00 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * Version 2.108
-
- * zenirc.el (zenirc-server-JOIN): Use zenirc-update-modeline.
-
- * zenirc-8ball.el (zenirc-8ball-mode): New function and
- buffer-local variable.
- (zenirc-server-PRIVMSG-8ball): Do nothing unless zenirc-8ball-mode
- is set.
- (zenirc-send-8ball): Removed.
-
-Wed Dec 4 09:12:28 1996 Greg A. Woods <woods@most.weird.com>
-
- * zenirc-doto.el: requires zenirc-command-queue.
-
- * zenirc-iwantop.el (zenirc-ctcp-query-IWANTOP): be gentle if an
- unknown channel is requested.
-
- * zenirc-notify.el: add missing newline at end of this file.
-
- * zenirc.el (zenirc-bug): use mail-header-separator.
- (zenirc-bug): reformat the message inserted in the body.
-
-Wed Oct 9 13:41:49 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-8ball.el (zenirc-random-8ball-strings): Linguistic attack.
-
-Tue Oct 8 22:12:48 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-8ball.el: New file.
-
- * zenirc-yow.el (zenirc-send-yow): New function.
- (zenirc-server-PRIVMSG-yow): Use it.
-
-Fri Aug 23 19:49:48 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-establish-server-connection): Need more
- defaults to work 100% of the time.
-
-Wed Aug 21 13:16:03 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-source-list): Added 'ftp.alfea.it'.
-
-Tue Aug 20 17:34:28 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * Version 2.107
-
-Sat Aug 10 20:41:02 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc-color.el (zenirc-command-color): You obviously don't use
- the same commands to make sure a color is a color under both Emacs
- and XEmacs.
-
-Wed Aug 7 03:14:41 1996 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-establish-server-connection): Do not bind
- inhibit-quit to t. Instead, use a condition handler for `quit'.
- Fix args to `string-match' in `error' condition handler; regexp
- should be first.
- Do not call `string-match' with empty argument if IRCSERVER
- environment variable is not defined.
-
-Fri Aug 2 17:29:55 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-signal-p): Do not signal if message is matched
- in zenirc-ignore-list.
- (zenirc-source-list): Removed 'pfawww.pp.se' from source list.
-
-Mon Jul 29 03:58:02 1996 Per Persson <pp@gnu.ai.mit.edu>
-
- * GNU'ified <pp@solace.mh.se> and <pp@pfawww.pp.se> to
- <pp@gnu.ai.mit.edu>.
-
-Wed Jul 24 03:06:59 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-server-PART): Parse new comment part of PART,
- this is a new thing in ircd 2.9.1.
- (zenirc-lang-define-english-catalog): Updated all language scripts
- as well.
-
-Sun Jul 21 14:32:49 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el: Added a few comments.
-
-Tue Jul 2 10:18:44 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-send-line): Changed input-start to
- (copy-marker zenirc-process-mark).
-
- * Version 2.106
-
- * zenirc-color.el: Made it a part of the distribution.
-
-Mon Jul 1 11:26:43 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.105
-
- * zenirc.el (zenirc-ctcp-query-SOURCE): Didn't follow the CTCP
- spec.
-
-Tue Jun 18 01:08:07 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-parse-output): Moved a signal based check
- to (zenirc-signal) where it belongs.
-
-Mon Jun 17 20:56:08 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-parse-output): Updated to recognize new
- zenirc-beep-on-signal setting.
- (zenirc-beep-on-signal): New setting, 'always.
-
- * zenirc-example.el (zenirc-signal-list): Added an example.
- (zenirc-beep-on-signal): Updated.
-
-Tue Jun 11 13:28:18 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-complete.el (zenirc-complete-table): Made it buffer-local.
-
-Thu May 30 01:08:10 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-server-JOIN
- zenirc-lang-define-english-catalog): New 'join_mode which parses
- new 2.9 #channel^Gmode syntax.
-
- * zenirc-complete.el (zenirc-complete-cache-JOIN): Make it parse
- new 2.9 #channel^Gmode syntax.
-
-Wed May 29 09:42:17 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-color.el: New file.
- (zenirc-color-message): Colorized one char to many.
- (zenirc-color-install-message-catalogs zenirc-command-color): Made
- sure it doesn't try to add nonexistant colors.
- (zenirc-color-message-categories zenirc-color-alist
- zenirc-color-nonstandard-message-categories-p): Buffer-local.
-
- * zenirc.el (zenirc-server-215): Now shows "i" or "I" depending on
- the actual output from the server. Updated all language scripts.
-
- * zenirc-notify.el (zenirc-command-notify): Use
- zenirc-delete-case-insensitively to update the notify-list.
- (zenirc-command-notify): "/notify nick1 nick2" now works.
-
- * zenirc.el (zenirc-delete-case-insensitive): New
- function. Deletes elt from list case-insensitively.
-
- * Version 2.104
-
-Wed May 15 15:32:23 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-random-nick.el (zenirc-change-nick-interval
- zenirc-last-nick-change zenirc-change-nick
- zenirc-change-random-nick): Functions and variables to
- automatically change your nickname every
- zenirc-change-nick-interval amount of time. Surely, this must be
- one of the more annoying things I've ever written.
-
- * zenirc-ignore.el (zenirc-process-ignore
- zenirc-ignore-last-sender): When adding ignorees, add them with
- regexp quoting.
- (zenirc-remove-from-ignore-list): When deleting ignorees, check
- both partial string match (if string doesn't contain special
- regexp chars) and exact string match.
- (zenirc-ignore-determine-prefix): Didn't determine prefixes like
- it should, fixed.
-
-Sun May 12 02:12:05 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-notify.el (zenirc-command-notify-hook): Updated
- documentary string.
-
- * zenirc.el (zenirc-channel-list): Make sure all cells are
- downcase.
-
-Fri May 10 16:42:25 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-establish-server-connection): Didn't default
- to what it said it would default to.
-
-Thu May 9 11:01:45 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.103
-
- * zenirc.el (zenirc-toggle-channel): Uses zenirc-channel-list to
- toggle between channels. (original code by <vuori@sci.fi>)
- (zenirc-mode-map): Bound to C-cC-t.
- (zenirc-update-modeline): New function.
- (zenirc-toggle-channel zenirc-command-query): Use it.
-
-Wed May 8 09:48:27 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-select): Removed unused code.
- (zenirc-channel-list): New list of currently joined channels.
- (zenirc-server-JOIN zenirc-server-PART): Use it.
-
-Mon May 6 10:10:13 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-server-251 zenirc-server-255): Added
- string-matchs to conform with new 2.9 look.
- (zenirc-select): Bugged out when connecting to server in
- zenirc-server-alist without a defined port.
- When reusing old server, move it to the top of the alist.
- Don't connect to anything else then the given server.
-
-Sun May 5 20:27:08 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-lang-define-english-catalog): Missing string
- for numeric 201, added.
-
- * Version 2.102
-
- * zenirc-example.el (zenirc-ctcp-query-BOZOS):
- zenirc-display-string is now zenirc-message, changed.
-
- * zenirc-latin.el (zenirc-lang-define-catalog): Fixed typo.
-
-Sat May 4 16:53:36 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-ignore.el (zenirc-ignore-install-message-catalogs):
- New entry, ignore-new-entry. Changed ";;" to "[info]".
- (zenirc-process-ignore): Use ignore-new-entry.
- (zenirc-remove-from-ignore-list): Show list of ignorees after
- running internal matching.
- (zenirc-ignore-last-sender): New function.
-
- * zenirc.el (zenirc-privmsg-last-seen): New variable.
- (zenirc-format-privmsg-or-notice): Use it.
-
- * zenirc-example.el (zenirc-user-format): Unsupported, removed.
- (zenirc-fill): Updated to show example for 'static filling.
-
-Fri May 3 19:24:52 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-notify.el (zenirc-command-notify): Made it a bit smarter
- when handling upper and lower case strings.
- Disgard whitespace when matching strings.
- Added comments.
-
- * zenirc.el (zenirc-select): When not chosing the default, use
- supplied values for port and nick.
- If a new server is given, add it to global zenirc-server-alist.
- Added comments.
- (zenirc-format-privmsg-or-notice): Didn't see PRIVMSG/NOTICE to
- user@server as a message to one self.
-
-Wed May 1 04:55:16 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-source-list): Added eterna.com.au to the list
- of FTP sites. All hail BSF!
-
-Tue Apr 30 14:08:36 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-bug): Added certain space in document to
- conform with other Emacs thingies.
-
- * zenirc-example.el: Corrected a few documentary strings.
-
-Mon Apr 29 23:34:10 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-source-list): Once again changed.
-
-Sun Apr 28 00:03:09 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-fill.el (zenirc-fill-type): New way of filling, 'static.
- (zenirc-fill-static): New variable.
- (zenirc-wrap-region): Use it.
-
-Fri Apr 26 00:43:47 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-do-iwantop.el: Shouldn't exist, removed.
-
- * zenirc-example.el (zenirc-signal-list): Removed.
- Fixed typos.
-
- * zenirc.el (zenirc-source-list): Updated pointers on
- where to find the ZenIRC distribution.
- (zenirc-channel-p): Added + to the list of chars which can start a
- channel name.
- (zenirc-bug): Misplaced (interactive).
-
-Thu Apr 25 18:47:00 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.101
-
- * zenirc.el (zenirc-bug-address): New variable.
- (zenirc-bug): New function.
-
- * Changed default server from irc-2.mit.edu to irc.stealth.net.
-
- * zenirc-example.el: Added documentation on how to do things
- during server initializing, namely how to autojoin channels.
-
-Wed Apr 24 16:05:17 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el: Take care of numeric 477, ERR_NOCHANMODES.
-
- * zenirc.el (zenirc-timestamp): No timestamping by default.
- (zenric-source-list): Updated.
- (zenirc-ctcp-query-ECHO): New function, use it.
- (zenirc-emacs-variant): Removed duplicate Nemacs entry.
- (zenirc-time=): Typo caused the function not to work.
- (zenirc-ctcp-query-CLIENTINFO): Moved a ")" a few lines down, thus
- removing one of the naughty error messages you get while byte
- compiling.
-
-
-Sun Apr 21 01:04:59 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.100pl16, the version never released.
-
- * zenirc-example.el: Removed old unused variabels.
-
- * zenirc.el (zenic-name): unused, removed.
-
-Fri Apr 19 15:03:00 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.100pl15
-
-Wed Apr 17 12:26:38 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-example.el: Updated to mention all the new features of
- ZenIRC since the dawn of time.
-
- * zenirc.el: ZenIRC neglected zenirc-name, fixed.
-
-Tue Apr 16 13:06:36 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el: Take care of numeric 415, ERR_BADMASK
-
-Mon Apr 15 15:34:13 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el: numeric 262 shows servername and version.
-
- * zenirc.el: Take care of numeric 249, RPL_STATSZLINE
-
-Sun Apr 14 17:33:56 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el: Take care of numeric 437, ERR_UNAVAILRESOURCE
-
-Sat Apr 13 15:51:14 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.100pl14
-
- * zenirc.el (zenirc-timestamp-string): New function.
- (zenirc-timestamp): New variable.
- (zenirc-timestamp-prefix): New variable.
- (zenirc-timestamp-suffix): New variable.
- (zenirc-format-privmsg-or-notice): Use them.
-
- * zenirc.el: Take care of numeric 262, RPL_TRACEEND
-
-Thu Apr 11 18:47:46 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-command-ctcp): Sent a bogus space in queries.
-
- * Version 2.100pl13
-
- * zenirc-fill.el: Defaults to filling (with a prefix).
-
- * zenirc-history.el: new file, adds shell-like C-p and C-n on
- C-cC-p and C-cC-n.
-
-Tue Mar 26 13:57:38 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-fill.el (zenirc-wrap-region): Bugged out under emacs-18.
-
-Sun Mar 24 09:54:07 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-[language].el: Changed to conform with new idletime string.
-
- * zenirc-fill.el (zenirc-fill-type): New variable.
- (zenirc-wrap-region): Use it.
-
- * Version 2.100pl12
-
- * zenirc-notify.el (zenirc-server-302-notify): Bugged out when
- people left IRC faster then ZenIRC parsed the USERHOST parts.
-
- * zenirc.el (getenv "$IRCSERVER"): Not sufficent, bugged out on
- ircII'ish $IRCSERVER settings.
- (zenirc-ircserver-string->alist): Bugged out when $IRCSERVER had
- more then two servers in it.
-
- * Version 2.100pl11
-
- * zenirc.el (zenirc-select): Would bug out on zenirc-server-alist.
-
- * zenirc-notify.el (zenirc-command-notify): Would bug out if
- none of the notificated people was wasting time.
-
-Fri Mar 22 23:10:26 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-send-confirmation-in-echo-area-p): Removed,
- (zenirc-send-confirmation): set to "'message' does the same thing.
- (action-echo send-echo send-multi-echo): new entries in
- language catalog, update all functions to use them.
- zenirc-bork.el, zenirc-french.el, zenirc-latin.el,
- zenirc-finnish.el, zenirc-klingon.el, zenirc-swedish.el
- (action-echo send-echo send-multi-echo): Added.
-
-Thu Mar 21 11:49:50 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc.el (zenirc-server-317): Display idle time in
- hour:minute:second format.
- (zenirc-send-confirmation): New variable, defines whether ZenIRC
- should tell the user if it sends PRIVMSG/NOTICE to the server or
- not.
-
- * Version 2.100pl10
-
- * zenirc-ignore.el: S/ignorance/ignore/g once and for all.
-
- * zenirc-iwantop.el (zenirc-iwantop-alist): Fixed typo in
- documentation string.
- (zenirc-ctcp-query-IWANTOP): Added documentation on how to make
- ZenIRC see other CTCP's and act upon them.
-
-Thu Mar 14 00:19:20 1996 Henrik Bylund <heb@pfawww.pp.se>
-
- * zenirc.el (zenirc-lang-store-catalog-entry): Corrected typo
- zenirc-lang-current-langage -> language
-
-Thu Feb 29 10:26:55 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.100pl9
-
-Tue Jan 30 08:29:18 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-notify.el (zenirc-command-notify): Rewrote it.
-
-Thu Jan 25 09:59:24 1996 Per Persson <pp@pfawww.pp.se>
-
- * zenirc-notify.el (zenirc-server-302-notify): Added check so
- nothing gets printed if user exited between the USERHOST command
- and the USERHOST reply.
-
- * zenirc.el (zenirc-select): Added some different defaults to
- server, port and nickname, thus fixing a bug.
-
-Wed Jan 24 09:58:04 1996 Per Persson <pp@pfawww.pp.se>
-
- * Version 2.100pl8
-
- * zenirc.el (zenirc-login): Fixed it to conform with ircd's which
- violates RFC1459.
-
-Thu Nov 23 00:13:55 1995 Mr. Per Persson <pp@solace.mh.se>
-
- * zenirc.el (zenirc-ignorance-list): renamed to zenirc-ignore-list
-
-Sat Nov 11 03:04:58 1995 Mr. Per Persson <pp@solace.mh.se>
-
- * Version 2.100pl7
-
- * zenirc-make.el: For use with 'make'.
-
- * zenirc-bork.el: New 'Swedish Chef' language catalouge.
-
- * zenirc-ignore.el: Earlier known as zenirc-ignorance.el
- Renamed everything with 'ignorance' to 'ignore'.
-
- * zenirc.el (zenirc-command-server): new syntax,
- /server [servername [port [nickname]]]
- (zenirc-select): Only converts port to string if it's a string.
-
-Wed Aug 16 03:50:33 1995 Jason Bastek <jason@marilyn.oit.umass.edu>
-
- * Version 2.100.6
-
- * zenirc-ignorance.el: Better regexp checks, better working /unignore
-
-Tue Aug 15 15:24:59 1995 Mr. Per Persson <pp@solace.mh.se>
-
- * zenirc.el: Fixed broken /topic command.
-
-Tue Jul 11 05:43:04 1995 Internet Relay Chat Administrator <pp@solace.mh.se>
-
- * Version 2.100.5
-
- * zenirc-klingon.el: New Startrek Klingon language catalouge.
-
-Mon Jul 10 17:24:53 1995 Internet Relay Chat Administrator <pp@solace.mh.se>
-
- * zenirc.el (zenirc-command-char): new variable.
- (zenirc-command-commandchar): sets zenirc-command-char.
-
- * Version 2.100.4
-
-Mon Jul 10 17:21:37 1995 Jason Bastek <jason@marilyn.oit.umass.edu>
-
- * zenirc-ignorance.el: New code, ircII like.
-
-Sun Jul 9 17:32:13 1995 Internet Relay Chat Administrator <pp@solace.mh.se>
-
- * zenirc-fill.el (zenirc-command-resize): /resize [width], been
- missing this one a long time.
-
-Thu Jul 6 03:32:02 1995 Mr. Per Persson <pp@solace.mh.se>
-
- * zenirc.el (zenirc-command-kick): Somehow removed it in earlier
- version. How annoying.
-
-Fri Jun 30 06:33:03 1995 Internet Relay Chat Administrator <pp@solace.mh.se>
-
- * Version 2.100.3
-
- * zenirc.el (zenirc-self-insert-or-send-privmsg-last-sent/rec):
- Added check for emacs-version.
-
-Wed Jun 28 15:45:59 1995 Internet Relay Chat Administrator <pp@solace.mh.se>
-
- * Version 2.100.2
-
- * zenirc.el: Added /server command that uses zenirc-select.
-
- * Version 2.100.1
-
- * zenirc-ignorance.el: Added /ignore command which manipulates
- zenirc-ignorance-list.
-
- * zenirc.el (zenirc-select): Added completion on `server'
- as well as stuffing in a defaultish thing for `port' and
- `nick'.
-
- * zenirc-notify.el: Stripped out all the notify stuff from
- zenirc.el and put it in zenirc-notify.el as well as adding
- some user@host thingies.
-
-Sun Apr 23 03:31:35 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * Version 2.100
-
- * zenirc-meditate.el (zenirc-meditate-response-list): Add "Don't
- bother."
-
- * zenirc.el (zenirc-command-kick, zenirc-command-kill,
- zenirc-command-squit): Handle missing comments.
-
-Sat Apr 22 00:21:58 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-message-length-limit): New constant.
- (zenirc-send-line): Completely rewritten.
- (zenirc-display-recipient-confirmation): Take new arg, the number
- of chunks in which message was sent.
- (zenirc-lang-define-english-catalog): New entry `send-multi'.
- (zenirc-send-confirmation-generic-echo-area-p): New variable.
- (zenirc-send-confirmation-generic): New function.
- (zenirc-command-privmsg-hook): New variable.
- (zenirc-command-privmsg): New function.
- (zenirc-command-m, zenirc-command-msg): Call zenirc-command-privmsg.
- (zenirc-send-confirmation-privmsg-hook): New variable.
- (zenirc-command-m, zenirc-send-line): Call it.
- (zenirc-send-confirmation-notice-hook): New variable.
- (zenirc-command-notice): Call it.
- (zenirc-send-confirmation-me-hook): New variable.
- (zenirc-command-me): Call it.
- (zenirc-command-action-hook): New variable.
- (zenirc-command-action): New function.
-
- * zenirc-latin.el: Change ctcp_action message from "action" to
- "actio".
-
-Fri Apr 21 18:36:56 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-command-kick-hook, zenirc-command-kill-hook,
- zenirc-command-notice-hook, zenirc-command-squit-hook): New hooks.
- (zenirc-command-kick, zenirc-command-kill, zenirc-command-notice,
- zenirc-command-squit): New functions.
-
- * zenirc-complete.el (zenirc-complete-display-in-popup): Don't pop
- up a completion window if already visible.
- (zenirc-complete): Ignore case of input.
- When completing partially, preserve case of user's own input.
-
- * zenirc.el (zenirc-server-215): Show arg 8 (class), not 7
- (password) in RPL_STATSILINE reply. From pp@solace.mh.se.
- (zenirc-send-ctcp-errmsg-on-unknown): Fix quoting in docstring.
-
- * zenirc.el (zenirc-server-243): Display arg 3 (`O' or `o').
- Change suggested by pp@solace.mh.se.
- (zenirc-lang-define-english-catalog): Change entry for `243' to
- reflect new arg.
- * zenirc-latin.el, zenirc-swedish.el: Likewise.
-
-Sun Apr 9 06:05:27 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-meditate.el (zenirc-meditate-response-percentage):
- Decrease to 5.
- (zenirc-meditate): Use <, not <=.
-
- * zenirc-oink.el (zenirc-oink-response-percentage): New variable.
- (zenirc-oink): Use it.
-
- * zenirc-oink.el, zenirc-meditate: New files.
-
-Sun Apr 2 21:07:38 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-establish-server-connection): Force redisplay
- before calling function to open network stream.
- Fix misplaced paren in error handler forms.
-
-Sat Apr 1 00:39:31 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-dcc.el (zenirc-command-dcc): Use intern-soft, not intern.
-
- * zenirc.el (zenirc-parse-output): Use intern-soft, not intern.
- (zenirc-do-command): Likewise.
- (zenirc-handle-ctcp): Likewise. Also rewritten.
- (zenirc-lang-set-current-language): Likewise.
- (zenirc-lang-retrieve-catalog-entry): Likewise.
- (zenirc-ctcp-query-CLIENTINFO): Likewise.
-
- * zenirc-iwantop.el (zenirc-ctcp-query-IWANTOP): Let channel elt
- of alist be a regexp.
-
-Fri Mar 31 19:07:20 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-iwantop.el: New file. Based on code from Eric Prestemon.
-
- * zenirc.el (zenirc-privmsg-last-rec, zenirc-privmsg-last-sent):
- Initialize default value with "".
- (zenirc-parse-firstword): Return nil if first string-match failed.
-
- * zenirc-netsplit.el (zenirc-netsplit-QUIT): Use
- zenirc-downcase-name on `split' and `nick' before adding them to
- table.
-
-Wed Mar 29 08:38:51 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-fill.el (zenirc-fill-mode): New function and buffer-local
- variable.
- (minor-mode-alist): Add entry for zenirc-fill-mode.
- (zenirc-fill-message): Do nothing unless zenirc-fill-mode is set.
-
- * zenirc-dcc.el (zenirc-dcc-chat-sentinel): Copy str from posn to
- match-beginning into line, not 0 to match-beginning.
-
- * zenirc.el (zenirc-establish-server-connection): Use integer
- representation of $IRCPORT if defined.
- (zenirc-server-MODE): For any nil elements of parsedmsg, pass ""
- to format instead.
- (zenirc-do-command): Pass command to server if hook is
- unbound or nil.
-
-Mon Mar 27 00:01:30 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * Version 2.99
-
- * zenirc-18.el (zenirc-force-mode-line-update): New function.
- * zenirc.el (zenirc-server-NICK): Force mode line update when nick
- changes.
-
- * zenirc-dcc.el (zenirc-dcc-get-default-directory): New variable.
- (zenirc-dcc-do-get-command): Use it.
- (zenirc-dcc-alist): Renamed from zenirc-dcc-list.
- All references changed.
- (zenirc-dcc-connect-function): New variable.
- (zenirc-dcc-open-network-stream): New function.
- (zenirc-dcc-catalog-entry): New macro.
- (zenirc-dcc-install-message-catalogs): New function.
- Call at load-time.
- (zenirc-dcc-member): New function.
- (zenirc-command-dcc): Call any zenirc-dcc-do-FOO-command, if fboundp.
- (zenirc-dcc-do-chat-command): Renamed from zenirc-do-dcc-chat.
- Rewritten.
- (zenirc-dcc-do-close-command): Renamed from zenirc-do-dcc-close.
- Rewritten.
- (zenirc-dcc-get-default-directory): New variable.
- (zenirc-dcc-do-get-command): Renamed from zenirc-do-dcc-get.
- Rewritten.
- (zenirc-dcc-do-list-command): Renamed from zenirc-do-dcc-list.
- Rewritten.
- (zenirc-dcc-query-handler-alist): New variable.
- (zenirc-ctcp-query-DCC): Use it to find function to dispatch.
- (zenirc-dcc-handle-ctcp-chat): Renamed from zenirc-handle-ctcp-chat.
- Rewritten.
- Always store most recent request; discard others.
- (zenirc-dcc-handle-ctcp-send): Renamed from zenirc-handle-ctcp-send.
- Use zenirc-names-equal-p to compare recipient and nick.
- Do not do type conversion on args placed in zenirc-dcc-list;
- use lazy evaluation later.
- Use message catalogs.
- Report error if dcc request is malformed.
- Mostly rewritten in other minor ways.
- (zenirc-dcc-get-file): Renamed from zenirc-get-file.
- Take new arg parent-proc.
- Set zenirc-dcc-parent-process buffer-local based on it.
- Switch file buffer to fundamental mode, make read-only.
- Save alist elt in zenirc-dcc-entry-data.
- Don't switch to new buffer; leave it buried.
- (zenirc-dcc-get-filter): Don't save match data; there is nothing
- to preserve.
- Don't use process mark; just append to end of buffer.
- Don't use save-excursion; just save and restore current buffer.
- (zenirc-dcc-get-sentinel): Rewritten.
- (zenirc-dcc-chat): Take new arg parent-proc.
- Set zenirc-dcc-parent-process based on it.
- Mostly rewritten.
- (zenirc-dcc-chat-buffer-name-format, zenirc-dcc-chat-mode-hook,
- zenirc-dcc-chat-connect-hook, zenirc-dcc-chat-exit-hook): New
- variables.
- (zenirc-dcc-chat-mode-map): Renamed from zenirc-dcc-mode-map.
- (zenirc-dcc-chat-send-line): Renamed from zenirc-dcc-send-line.
- Don't use process mark; use zenirc-process-mark instead.
- (zenirc-dcc-chat-mode): Renamed from zenirc-dcc-mode.
- Kill all local variables first thing.
- Set mode-line-process.
- Run zenirc-dcc-chat-mode-hook.
- (zenirc-dcc-chat-parse-output): Renamed from zenirc-dcc-parselines.
- (zenirc-dcc-unprocessed-output): Renamed from zenirc-partialline.
- (zenirc-dcc-chat-filter-hook): Put `zenirc-dcc-chat-parse-output'
- on it.
- (zenirc-dcc-chat-filter): Add new output to unprocessed output string.
- Do not call zenirc-dcc-chat-parse-output directly; just run hook.
- (zenirc-dcc-chat-sentinel): Rewritten.
-
-Sun Mar 26 18:45:09 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-dcc.el (zenirc-extract-host): Function deleted.
- * zenirc.el (zenirc-extract-host): Moved here.
- Simplified logic so as not to use any local variables.
- Preserve match data.
- (zenirc-extract-nick, zenirc-extract-userhost):
- Simplified logic so as not to use any local variables.
- (zenirc-emacs-variant): Recognize Epoch.
- (zenirc-match-string, zenirc-parse-n-words): New functions.
-
-Sat Mar 25 01:10:46 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-in-input-p): Arg `proc' removed.
- Don't pass it to `>='.
-
- * zenirc-yow.el (zenirc-server-PRIVMSG-yow): Don't downcase `to'.
- Use zenirc-names-equal-p for comparison.
-
- * zenirc.el (zenirc-command-language): New function.
- (zenirc-command-language-hook): New variable.
- (zenirc-lang-set-current-language): Use zenirc-message.
- (nocatalog, newcatalog): New message catalog entries.
- (zenirc-lang-define-english-catalog): Define them.
-
- * zenirc.el (zenirc-server-333-hook): New variable.
- (zenirc-server-333): New function.
- (s333): New message catalog entry.
- (zenirc-lang-define-english-catalog): Define it.
- (zenirc-epoch-seconds-to-time): New function, from Charles Hannum.
-
- * zenirc-popup.el: Do not require backquote.
- Add aliases for compatibility with XEmacs.
- (zenirc-popup-map-windows): Macro deleted.
- (zenirc-popup): Renamed from old zenirc-popup-window function.
- Use walk-windows instead ofzenirc-popup-map-windows.
- (zenirc-popup-window, zenirc-popup-frame): New subroutines of
- zenirc-popup.
- (zenirc-popup-current-buffer, zenirc-window-end): Functions deleted.
- (zenirc-popup-available-frames): Renamed from zenirc-popup-any-frame.
- (zenirc-popup-make-new-frames): New variable.
- (zenirc-signal-popup): New function.
- Add it to zenirc-signal-hook instead of zenirc-popup-window.
-
- * zenirc.el (zenirc-format-privmsg-or-notice): Don't set
- zenirc-privmsg-last-rec unless message was from another user
- directly to user, not channel.
-
- * zenirc-18.el (zenirc-walk-windows, zenirc-window-end): New
- functions.
-
- * zenirc-complete.el (zenirc-complete): Use zenirc-process-mark,
- not process mark.
-
- * zenirc.el (zenirc-downcase-name): New function.
- (zenirc-names-equal-p): Use it.
- * zenirc-complete.el (zenirc-complete-cache,
- zenirc-complete-uncache): Likewise.
- * zenirc-format.el (zenirc-format-nickuserhost-fancy,
- zenirc-fancy-NICK, zenirc-fancy-352): Likewise.
- * zenirc-away.el (zenirc-server-301-fancy): Likewise.
- * zenirc-netsplit.el (zenirc-netsplit-JOIN): Likewise.
-
-Fri Mar 24 00:06:30 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc): If new buffer, call zenirc-mode first thing.
- (zenirc-mode): kill-all-local-variables.
- (zenirc-emacs-variant): New function.
- (zenirc-version): New constant.
- (zenirc-ctcp-query-VERSION): Display them, not RCS revision id.
-
-Thu Mar 23 18:37:10 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-establish-server-connection): New function.
- (zenirc-ircserver-string->alist): New function.
- (zenirc-server-alist): Renamed from zenirc-IRCSERVER-alist.
- Do not initialize at load time.
- (zenirc): Do it here.
- Do not check for existence of `zenirc-process-connect'.
- Use `zenirc-establish-server-connection'.
- (zenirc-process-connect-function, zenirc-server-default,
- zenirc-port-default, zenirc-nick-default,
- zenirc-full-name-default, zenirc-user-login-name-default,
- zenirc-password-default): New variables.
- (zenirc-establish-server-connection): Use them.
- (connect-failed, connect-try, connect-abort): New message catalog
- entries.
- (zenirc-lang-define-english-catalog): Define them.
-
- * zenirc.el (zenirc-process-mark): New buffer-local variable.
- (zenirc): Initialize it.
- Use pop-to-buffer, not switch-to-buffer.
- (zenirc-message): Use point-marker to set current-point-mark.
- Use zenirc-process-mark instead of process mark.
- Allow proc argument to be either a process or a buffer.
- (zenirc-parse-output, zenirc-beginning-of-input-p,
- zenirc-in-input-p, zenirc-send-line, zenirc-insert-at-proc-mark):
- Here too.
-
- * zenirc.el (zenirc-sentinel): Do not move point here.
- Don't bother to save match data.
- (zenirc-parse-output): Renamed from zenirc-parselines.
- All callers changed.
- Do not compute length of remaining substring to generate
- `unparsed'; the substring function defaults to the end of string.
- (zenirc-parse-server-message): Renamed from zenirc-parse-servermsg.
- All callers changed.
-
-Wed Mar 22 20:13:28 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-yow.el (zenirc-yow-format-string): New function.
- (zenirc-server-PRIVMSG-yow, zenirc-command-yow): Use it.
- Use zenirc-message and save-match-data.
-
- * zenirc-random-away.el: New file from Eric Prestemon.
-
- * zenirc-fortran.el (zenirc-fortran-regexp, zenirc-fortran-rant,
- zenirc-fortran-response-type): New variables.
- (zenirc-fortran): Use them.
- Use zenirc-names-equal-p to compare nicknames.
- Save match data.
-
- * zenirc-doto.el (zenirc-doto-install-message-catalogs): New
- function. Call it at load time.
- (zenirc-command-dotowho, zenirc-command-op, zenirc-command-dotolinks,
- zenirc-command-dotolist): Use zenirc-message with appropriate
- catalog entry.
- (zenirc-doto-op-end): Renamed from zenirc-op-end.
- All callers changed.
-
- * zenirc.el (zenirc-names-equal-p): New function.
- (zenirc-server-NICK, zenirc-server-JOIN, zenirc-server-KICK,
- zenirc-server-PART, zenirc-format-privmsg-or-notice): Use it.
-
-Sat Mar 18 13:42:15 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-fill.el (zenirc-fill-region): Narrow to (1- point-max),
- then delete excess trailing newline.
- (zenirc-fill-message): funcall zenirc-fill-region-function.
-
- * zenirc.el (zenirc-command-query): Set current victim to just the
- first subsequent word, sans surrounding whitespace.
- (zenirc-message): If message is not defined in current catalog,
- check english catalog (this is temporary).
-
- * zenirc-netsplit.el (zenirc-netsplit-show-server-mode-changes-p):
- Renamed from `zenirc-netsplit-show-server-modechanges'.
- (zenirc-netsplit-list): Make local to all buffers at load time.
- (zenirc-netsplit-init): Function deleted.
- Don't add it to zenirc-startup-hook.
- (zenirc-netsplit-install-message-catalogs): New function.
- Run it at load time.
- (zenirc-netsplit-JOIN, zenirc-netsplit-timer, zenirc-netsplit-wholeft):
- Avoid needless traversals with nth on zenirc-netsplit-list.
- Use zenirc-message and catalog symbols instead of
- zenirc-display-string.
-
- * zenirc-signal.el: Renamed from zenirc-fancy-signal.el.
- Provide 'zenirc-signal.
- (zenirc-signal-privmsg): Renamed from `zenirc-fancy-signal'.
- Use `zenirc-message', not `message'.
- Change calling arguments appropriately.
- Compact message string to save valuable real estate in the echo area.
-
- * zenirc-stamp.el (zenirc-timestamp): Use zenirc-message, not
- zenirc-display-string.
-
- * zenirc-swedish.el: Renamed from zenirc-swedish-mode.el.
- Change provide to 'zenirc-swedish.
- Use zenirc-lang-define-catalog to create swedish message catalog.
-
- * zenirc-latin.el: Renamed from zenirc-latin-mode.el.
- Change provide to 'zenirc-latin.
- Use zenirc-lang-define-catalog to create latin message catalog.
-
- * zenirc-french.el: Renamed from zenirc-french-mode.el.
- Change provide to 'zenirc-french.
- Use zenirc-lang-define-catalog to create french message catalog.
-
- * zenirc-format.el: Renamed from zenirc-fancy-format.el.
- Change provide to 'zenirc-format.
- (zenirc-nickuserhost-list): Variable deleted.
- (zenirc-nickuserhost-table): New variable.
- (zenirc-format-nickuserhost-fancy): Save nick and nickuserhost
- pair in new hash table instead of in alist.
- (zenirc-fancy-NICK, zenirc-fancy-352): Here also.
- Do not run zenirc-format-nickuserhost-hook.
-
- * zenirc-away.el: Renamed from zenirc-fancy-away.el.
- Change provide to 'zenirc-away.
- (zenirc-fancy-away-user-alist): Variable deleted.
- (zenirc-away-table): New variable.
- (zenirc-server-301-fancy): Use new hash instead of alist.
- Use `zenirc-message' instead of `zenirc-display-string'.
- Change calling arguments appropriately.
-
- * zenirc-complete.el: Do not use backquotes in any macros.
- Do not require backquote.el.
- (zenirc-complete-cache-alist): Variable deleted.
- (zenirc-complete-table): New variable.
- Initialize at load time with list of server commands.
- (zenirc-complete-cache): Rewritten to intern in
- zenirc-complete-table.
- Set new symbol value to undowncased string.
- (zenirc-complete): On final completion, insert string with
- preserved case.
- (zenirc-complete-uncache): Set interned symbol in table to nil.
-
- * zenirc-complete.el (zenirc-complete-message): Function deleted.
- All callers changed to use `zenirc-message'.
- (zenirc-complete-wordlist): Alias deleted.
- All callers use `zenirc-parse-words' directly.
- (zenirc-complete-install-message-catalogs): New function using
- zenirc-lang-define-catalog.
- (zenirc-complete-install-messages): Function deleted.
- (zenirc-complete-word-boundary-regexp): Include carriage returns.
-
- * zenirc-complete.el (zenirc-complete-display-function): New variable.
- (zenirc-complete): Use it.
- (zenirc-complete-display-traditional,
- zenirc-complete-display-in-popup,
- zenirc-complete-display-in-echo-area,
- zenirc-complete-display-echo-area-or-traditional,
- zenirc-complete-display-echo-area-or-popup): New functions.
-
- * zenirc-complete.el (zenirc-complete-add-final-space-p): New variable.
- (zenirc-complete): Use it.
- Correct search for word boundaries.
- (zenirc-complete, zenirc-complete-cache-new-zenirc-commands):
- Use `boundp' to limit completions returned by `all-completions' and
- `try-completions' on `zenirc-complete-table'.
-
- * zenirc-complete.el (zenirc-complete-cache-NICK): New function.
- Add it to `zenirc-server-NICK-hook'.
- (zenirc-complete-cache-319, zenirc-complete-cache-353): Use
- `save-match-data'.
-
- * zenirc-fill.el: New file.
-
- * zenirc-18.el: New file.
- zenirc.el: Require it if appropriate.
-
- * zenirc.el (zenirc-display-string): Function deleted.
- (zenirc-message): New function, replacing zenirc-display-string.
- All callers changed.
- (zenirc-message-hook): New variable.
- (zenirc-text-list): Variable deleted.
- All refereces removed; let zenirc-message handle lookups.
- (zenirc-set-text-list-ent): Function deleted.
- (zenirc-lang-catalogs, zenirc-lang-obarray-size,
- zenirc-lang-current-language): New variables.
- (zenirc-lang-define-catalog, zenirc-lang-store-catalog-entry,
- zenirc-lang-retrieve-catalog-entry,
- zenirc-lang-set-current-language): New functions.
- (zenirc-lang-define-english-catalog): New function.
- Call at end of file.
-
- * zenirc.el (zenirc-insert-at-proc-mark): New function.
- (zenirc-send-privmsg-last-rec, zenirc-send-privmsg-last-sent):
- Insert "/msg [recipient]" at process mark, not at point.
- (zenirc-mode-map): Bind zenirc-send-privmsg-last-rec to "\C-cC-r",
- not "\C-cr".
- Bind zenirc-send-privmsg-last-sent to "\C-c\C-s", not "\C-cs".
- (zenirc-self-insert-or-send-privmsg-last-rec): New function.
- (zenirc-mode-map): Bind it to ":".
- (zenirc-self-insert-or-send-privmsg-last-sent): New function.
- (zenirc-mode-map): Bind it to ";".
-
- * zenirc.el (zenirc-local-variables): New variable.
- (zenirc-mode): Use it to initialize buffer-local variables.
- Remove interactive spec.
- Thoroughly frob mode-line-format.
-
- * zenirc.el (zenirc-command-*-hook, zenirc-ctcp-query-*-hook,
- zenirc-ctcp-reply-*-hook, zenirc-server-*-hook): Documentation
- strings removed. They were not particularly informative and took a
- lot of space.
-
- * zenirc.el: Removed all autoload cookies except for `zenirc'.
- Docstrings for most functions completely rewritten.
-
- * zenirc.el (zenirc-ignorance-list): Ignore messages with more
- than 4 CTCP strings.
- (zenirc-notify-list): Initialize to nil.
-
- * zenirc.el: All references to the following variables changed.
- (zenirc-current-server-name): Renamed from `zenirc-servername'
- (zenirc-server-modes): Renamed from `zenirc-servermodes'.
- (zenirc-server-name): Renamed from `zenirc-servername'.
- (zenirc-server-version): Renamed from `zenirc-serverversion'
- (zenirc-unprocessed-output): Renamed zenirc-partialline.
- (zenirc-user-full-name): Renamed from `zenirc-name'.
- (zenirc-user-modes): Renamed from `zenirc-usermodes'.
-
- * zenirc.el (zenirc): If given numeric prefix argument, switch to
- session in buffer named "*zenirc*<n>", or start one.
- (zenirc-active): Variable deleted.
- (zenirc): Check actual process status in buffer, if any.
- Do not disable blink-matching-paren. Let user do that on
- zenirc-mode-hook if desired.
- (zenirc-login): Renamed from zenirc-logon. Take process as argument.
- (zenirc): Call it with new process as argument.
- (zenirc-filter, zenirc-sentinel, zenirc-parselines,
- zenirc-extract-nick): Use save-match-data macro.
- (zenirc-in-input-p): Take optional proc argument.
- (zenirc-parse-words, zenirc-parse-firstword): Use save-match-data.
- Ignore leading and trailing whitespace.
- (zenirc-extract-userhost): New function.
- (zenirc-channel-p): Renamed from zenirc-channel-p.
- All callers changed.
- (zenirc-do-command): Use cond for readability.
-
- * zenirc.el (zenirc-delete, zenirc-member): Functions removed.
- * zenirc-18.el: Put them here.
- Make aliases for `delete' and `member'.
- All callers changed.
-
-Tue Jan 3 11:16:43 1995 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-popup.el (zenirc-window-end): New function.
- (zenirc-popup-window): Use it when `window-end' is undefined.
-
- * zenirc-popup.el (zenirc-map-windows): Renamed from `map-windows'.
- All callers changed.
- Add lisp indentation property.
-
- * zenirc-popup.el (zenirc-popup-mode): New variable and function.
- (zenirc-popup-window): Do nothing when zenirc-popup-mode is nil.
-
-Sun Sep 25 15:21:55 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added /oper command.
- Version 2.16 released.
-
-Wed Sep 21 03:04:46 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-complete.el (top level): Require backquote.
- Don't install zenirc-complete-cache-nick on
- zenirc-format-nickuserhost-hook.
- Call zenirc-complete-install-messages.
- (zenirc-complete-nick-alist, zenirc-complete-server-alist,
- zenirc-complete-channel-alist, zenirc-complete-charkey-alist):
- Variables deleted.
- (zenirc-complete-cache-alist): Renamed from
- zenirc-complete-server-command-alist.
- (zenirc-complete-word-boundary-regexp,
- zenirc-command-complete-cache-hook,
- zenirc-command-complete-uncache-hook): New variables.
- (zenirc-complete-cache, zenirc-complete-uncache,
- zenirc-complete-cache-nick, zenirc-complete-uncache-nick):
- Rewritten as macros.
- (zenirc-complete-command-cache, zenirc-complete-command-uncache):
- New functions.
- (zenirc-complete-wordlist): New alias.
- (zenirc-complete): Use zenirc-complete-word-boundary-regexp instead of
- hardcoded word separator regexps.
- Remove all code associated with searching misc completion alists; all
- completions are in zenirc-complete-cache-alist.
- Move all messages into zenirc-text-list and use
- zenirc-complete-message to display messages.
- (zenirc-complete-install-messages, zenirc-complete-message): New
- functions.
- (zenirc-complete-cache-new-zenirc-commands): Renamed from
- zenirc-complete-get-zenirc-command-alist.
- Call zenirc-complete-cache instead of inlining code.
- (zenirc-complete-cache-server, zenirc-complete-uncache-server,
- zenirc-complete-cache-channel, zenirc-complete-uncache-channel):
- Functions deleted.
- (zenirc-complete-cache-312, zenirc-complete-cache-322,
- zenirc-complete-cache-352, zenirc-complete-cache-INVITE,
- zenirc-complete-cache-JOIN): Rewritten.
- (zenirc-complete-uncache-40x): renamed from
- zenirc-complete-uncache-401.
- (zenirc-complete-uncache-402): Function deleted.
- (zenirc-complete-cache-msg): New function.
- (zenirc-server-PRIVMSG-hook, zenirc-server-NOTICE-hook): Put
- zenirc-complete-cache-msg on these.
-
-Wed Sep 21 02:10:30 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-format-privmsg-or-notice): Fixed bug in compare
- of origin of privmsg/notice against name of server - was using
- string-match, which caused lossage when the nick was an invalid
- regular expression.
-
-Thu Sep 1 19:13:41 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc): Made zenirc-server buffer local.
- This way, the mode line displays the correct server in each buffer
- even if you run more than one instance of zenirc in an emacs that
- are connected to different servers.
-
-Tue Aug 23 00:40:58 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: Sometimes was dropping bits of incoming dcc chats.
- This was a scoping problem. Fixed it.
-
-Fri Jul 8 00:34:45 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-source-list): Deleted ohsaycan.ucc.american.edu.
-
-Thu Jun 30 23:48:04 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-yow.el: New file.
-
-Wed Jun 29 08:23:29 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-beginning-of-input-p): Use = instead of
- `equal' and marker-position.
- Take optional arg proc.
- (zenirc-parse-servermsg): comment fix.
- (zenirc-display-recipient-confirmation): New function.
- (zenirc-send-line): Use it.
-
-Mon Jun 27 11:46:29 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-complete.el (zenirc-cache-nick): If arg is not a nick,
- cache it as a server name.
-
-Sun Jun 26 11:58:18 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-fancy-away.el: New file.
-
- * zenirc-latin-mode.el: Put all entries in an alist and loop through
- them, calling zenirc-set-text-list-ent.
- Also cleaned up the comments a little.
-
- * zenirc-complete.el: Total rewrite.
-
- * zenirc-popup.el (map-windows): Use memq, not member.
-
-Sat Jun 25 08:52:10 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-dcc.el (zenirc-dcc-chat-filter-hook): New zenhook.
- (zenirc-dcc-chat-filter): Run it.
- Don't use save-excursion; save and restore current buffer with
- unwind-protect.
-
- * zenirc-popup.el (zenirc-popup-windows): Use let* for setting
- bigwin, min-height, and ratio.
- (ratio): If not a valid number, set to screen height of bigwin.
- Don't check window-start and don't recenter to middle of window;
- always (recenter -1) instead.
- (proc-mark): New variable.
-
-Fri Jun 24 03:58:44 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-popup.el (zenirc-popup-window): Pass `nil' for minibuffer
- argument to map-windows.
-
- * zenirc-popup.el (zenirc-popup-window): Deleted local variables
- `window-alist' and `alist'.
- Set `found' (if appropriate) directly in map window body.
- Check that proc-mark is within window-start and window-end, rather than
- calling pos-visible-in-window-p.
-
- * zenirc.el (zenirc-filter): Do not use save-excursion; save and
- restore current buffer using unwind-protect.
-
- * zenirc-popup.el (zenirc-popup-window): Check pop-up-windows, not
- (not pop-up-windows).
-
- * zenirc-swedish-mode.el: Require 'zenirc.
- Provide 'zenirc-swedish-mode.
-
- * zenirc-stamp.el: Require 'zenirc.
- Provide 'zenirc-stamp.
-
- * zenirc-pjg.el: Require 'zenirc.
- Provide 'zenirc-pjg.
-
-Thu Jun 23 23:59:17 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc-fortran.el: Require 'zenirc.
- Provide 'zenirc-fortran-mode.
-
- * zenirc-doto.el: Require 'zenirc.
- Provide 'zenirc-doto.
-
- * zenirc-netsplit.el: Require 'zenirc.
- Provide 'zenirc-netsplit.
-
- * zenirc-latin-mode.el: Require 'zenirc.
- Provide 'zenirc-latin-mode.
-
- * zenirc-french-mode.el: Require 'zenirc.
- Provide 'zenirc-french-mode.
-
- * zenirc-fancy-signal.el: Require 'zenirc.
- Provide 'zenirc-fancy-signal.
-
- * zenirc-fancy-format.el: Require 'zenirc.
- Provide 'zenirc-fancy-format.
-
- * zenirc-dcc.el: Require 'zenirc.
- Provide 'zenirc-dcc.
-
- * zenirc-complete.el: Require 'zenirc.
- Provide 'zenirc-complete.
-
- * zenirc-command-queue.el: Require 'zenirc.
-
- * zenirc-popup.el: New file.
-
- * zenirc.el (zenirc-parselines): Various reorganization of
- conditionals.
- Run signal hooks after everything else (particularly after
- zenirc-display-string, so that the message relevent to the signal
- is already in the buffer).
- Check that zenirc buffer actually has a window at all before calling
- pos-visible-in-window-p with a null window argument; if null, that
- compares pos in the currently selected window, which can never be
- correct.
- Provide 'zenirc.
-
- * zenirc.el (zenirc-recursive-match): Function deleted.
- (zenirc-string-match-list): New function.
- (zenirc-signal-p, zenirc-ignore-p): Use zenirc-string-match-list, not
- zenirc-recursive-match.
-
-Thu Jun 23 04:27:13 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-doto.el: New file.
-
- * zenirc.el (zenirc-sentinel): Insert a message into the zenirc
- buffer when the zenirc process dies.
- (zenirc-delete-hook): Use `zenirc-delete', not `delete'.
- (zenirc-timer-hook): Now run when possible instead of only once a
- minute & modified notify code to only check once a minute, instead of
- depending on the minimum zenirc-timer-hook calling interval of 60
- seconds. (This change made so zenirc-queue-command.el would be
- possible).
- Made zenirc-timer-hook be called for keyboard input events in
- addition to server message events.
-
- * zenirc-command-queue.el: New file.
-
-Tue Jun 21 19:31:56 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-french-mode.el, zenirc-latin-mode.el, zenirc-swedish-mode.el:
- Modified ctcp action string since arg order was changed in
- zenirc.el 2.7.
-
-Sun Jun 19 08:49:17 1994 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el (zenirc-text-list): Change `ctcp_action' format from
- "ACTION %s->%s: %s\n" to "[ACTION->%s] %s %s\n"
- (zenirc-ctcp-query-ACTION): Reorder arguments appropriately.
-
- * zenirc.el (zenirc-mode-hook): New zenhook.
- (zenirc-mode): Call it.
- Do not put a space between colon and process status in
- `mode-line-process'..
- Put `minor-mode-alist' after `mode-line-process' in
- `mode-line-format', so that mode line looks like
- "(ZenIRC:open Fill ...)."
-
- * zenirc.el (zenirc-display-string): New function.
-
- * zenirc.el (zenirc-add-hook): Adopted from v19.24 subr.el.
- New features include an optional arg `append', and if the hook's
- value is merely another symbol, convert it to a list.
- Also handle void variables reliably, by not calling eval.
- (zenirc-delete-hook): Adopted from 19.24 subr.el.
- Handle pathological arguments more robustly than previously.
- (zenirc-remove-hook): Defined as alias for zenirc-delete-hook.
- `remove-hook' is the analogous v19 function.
-
-Mon May 16 02:38:03 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added code to support zenirc-complete.el (and other
- hacks in the future).
-
-Sun May 15 16:17:02 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-netsplit.el: Fixed bug in regexp for server mode changes
- that prevented them from ever being hidden properly.
-
-Fri May 13 05:07:35 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: Fixed two bugs: match for /dcc chat in
- zenirc-dcc-list was not being done right, now it is.
- Made it so entry for zenirc-dcc-list gets deleted in event of
- networking errors.
-
-Thu May 12 16:23:17 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-complete.el: New file.
-
-Wed Apr 27 17:47:31 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-example.el (zenirc-format-nickuserhost-function): Changed
- to a hook.
-
- * zenirc-fancy-format.el, zenirc-fancy-signal.el: Changed
- zenirc-format-nickuserhost-function to a hook.
-
- * zenirc-dcc.el: Added DCC chat accept capability.
-
- * zenirc.el: Changed nick!user@host function to a zenhook called
- zenirc-format-nickuserhost-hook.
- Added docstring to zenirc-notify-list.
-
-Sat Mar 12 04:14:54 1994 Richard Todd <rmtodd@servalan.servalan.com>
-
- * zenirc-latin-mode.el: Misc. spelling fixes, changed to use 'cognomen'
- for 'nickname' throughout.
- Added comments.
-
-Fri Mar 11 19:28:08 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-netsplit.el: Made work well with multiple zenirc's in one
- emacs.
-
- * zenirc.el: Minor docstring and formatting changes.
- Fixed bug that allowed one to start two zenirc processes in one buffer.
- Fixed bug in input handling that caused a lisp error when you sent
- space-enter.
- Changed default signoff message from "" to "Started wasting time
- elsewhere".
- (zenirc-startup-hook): Renamed from zenirc-startup.
- (zenirc-exit-hok): New hook.
- (zenirc-active): New variable.
- (zenirc-mode): mode-line-format less verbose.
- (zenirc-sentinel): New function.
- (zenirc-run-hook): Return value of last hook run.
-
- * zenirc-netsplit.el: Fixed typographical error in the definition of
- zenirc-netsplit-show-server-modechanges.
-
-Thu Mar 10 23:25:20 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-netsplit.el: New file.
-
-Sat Mar 5 05:41:09 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added code to only call zenirc-signal-hook if the
- zenirc buffer is not visible.
- Strip leading \n's from text input into zenirc.
-
- * zenirc-stamp.el (zenirc-timestap): Added arg of "now".
-
-Fri Mar 4 23:57:34 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-text-list): Initialize with defvar, not setq.
- It is not changed much anymore.
- Added zenirc-text-list entry for a protocol violation.
- Changed definition of zenirc-message-vector from a setq to a defvar to
- make the emacs 19 byte compiler happy.
- Added mode-line display of current victim, nick, etc to zenirc-mode.
- Made it so that starting a new zenirc doesn't always create a new
- zenirc buffer.
- Changed zenirc to use zenirc-user-login-name instead of
- (user-login-name).
- Added "now" to arguments to zenirc-timer-hook subrs.
- Fixed incorrect argument to zenirc-server-PING
- Modified zenirc to handle protocol voilations in 002, 003, 251, and
- 255 server messages.
- Fixed incorrect argument to zenirc-server-303
-
- * zenirc.el (zenirc-pjg): Function removed.
- * zenirc-pjg.el: New file.
-
-Thu Mar 3 15:06:51 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-pjg.el: New file.
-
- * zenirc-latin-mode.el: New file.
-
-Mon Feb 28 19:00:06 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed broken /msg
- Added french ftp site to CTCP SOURCE reply.
-
- * zenirc-french-mode.el: New file.
-
- * zenirc-swedish-mode.el: I had duplicated the contents of this file
- twice by appending the new version to the end rather than
- replacing the old code with it. This is now fixed.
-
-Sun Feb 27 19:36:27 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-example.el: Made changes for converting all old hooks to
- zenhooks.
-
- * zenirc-fortran.el: Updated to use new zenhooks for server
- messages.
-
- * zenirc-example.el: Added new format CTCP query hooks.
-
- * zenirc-ojnk.el: Changed from old style command hooks to new
- zenhooks.
-
- * zenirc.el: Turned off paren matching in the zenirc buffer.
-
- * zenirc-dcc.el, zenirc-fancy-format.el, zenirc-fancy-signal.el:
- Made changes for converting all old hooks to zenhooks.
-
- * zenirc.el: Removed duplicate entry for s203 in zenirc-text-list.
- (zenirc-format-nickuserhost-function): New function.
- Converted server messages from the old hook format to the new zenhooks.
- Renamed zenirc-startup-hook to zenirc-startup, because it's not a hook.
- Renamed zenirc-process-connect-hook to zenirc-process-connect,
- because it's not a hook.
- Renamed zenirc-logon-hook to zenirc-login, because it's not a hook.
- Changed all code that called zenirc-format-nickuserhost-hook to do a
- funcall of zenirc-format-nickuserhost-function.
- Deleted zenirc-init-hooks and zenirc-init-hook, as there are no
- more old style zenirc hooks for them to initialize.
-
- * zenirc-fancy-format.el: Updated to use new zenhooks for server
- messages.
-
- * zenirc.el: Added Mark Bailen to author list.
- Fixed out-of-order 318 reply.
- Added CTCP ping sending capabilities (/ping command and associated CTCP
- reply handlers).
- Minor variable name changes in /query code
- Added zenirc-signal-hook that gets called when a signal happens
- Added /quote command to send raw data to the server
- Converted CTCP query and reply strings from old hook format to new
- zenhooks .
- Made it so you can run multiple invocations of zenirc in the same
- buffer.
- Extensive changes to zenirc-send-line that fixed many input mode bugs
- Deleted zenirc-parse-ctcp and replaced calls to it to
- zenirc-parse-firstword.
-
- * zenirc-dcc.el: Added new format CTCP query hooks
-
- * zenirc-fancy-signal.el: New file.
-
- * zenirc.el: Changed piglet.cr.usgs.gov to gnu.ai.mit.edu everywhere.
- Added new zenhook mechanism for all zenirc-command-*-hooks.
- Changed zenirc-timer-hook to be initialized in the defvar.
- Moved some defuns around to be on the right page, or to
- alphabetize defuns.
- Added /ctcp command. Usage /ctcp victim foo bar sends ^AFOO bar^A
- to victim.
- Partially rewrote the /notify code in an attempt to understand it.
-
- * zenirc-dcc.el: Changed from old style command hooks to new zenhooks.
-
-Thu Feb 24 14:38:30 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-fortran.el: More revisionism - change `piglet.cr.usgs.gov'
- to `gnu.ai.mit.edu' in a couple places.
-
- * zenirc-ctcp-flood.el, zenirc-example.el, zenirc-fortran.el,
- zenirc-ojnk.el: Changed email address from piglet to gnu.
-
- * zenirc-dcc.el: Added more support for dcc chat (not finished yet)
- Changed email address from piglet to gnu.
-
- * zenirc-swedish-mode.el: Added updates from per persson.
- Changed email address from piglet to gnu.
-
- * zenirc-fancy-format.el, zenirc-stamp.el: Changed email address from
- piglet to gnu.
-
-Sun Feb 20 19:24:15 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: Added /dcc close subcommand to abort dcc transfers.
-
-Fri Feb 18 04:28:23 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: Made dcc get work. Started on dcc chat support.
-
- * zenirc.el: Fixed missing \n on a message.
- Added annoy pjg feature.
-
-Wed Feb 16 03:18:46 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Updated list of places zenirc is available from in
- zenirc-source-list.
- Added handlers for server numerics 202, 203, 208, 217, 221, 261.
- Improved handlers for server numerics 257, 258, 259.
- Added new variable, zenirc-timer-hook - this is a new "zenhook"
- that works similar to emacs 19 hooks.
- zenirc-timer-hook is called every few minutes by zenirc, so the
- client can schedule events.
- Added new variable, zenirc-debug-timer - used to debug zenirc's
- timer code.
- Deleted some commented code that called text-mode.
- Changed the buffer-local variable partialline to zenirc-partialline
- Fixed some unitialized buffer-locals that made trouble for emacs 19.
- Added a new buffer-local variable, zenirc-time-last-event, used to keep
- track of when zenirc-timer-hook has been called.
- Replaced code to call zenirc-command-notify-hook in various places with
- a call to zenirc-timer-handler in the main server message handling
- loop.
- Added zenirc-add-hook and zenirc-delete-hook to manipulate zenirc hook
- variables.
- Got some code from Kiwi IRC client to manipulate times since the
- epoch as lists of two ints (zenirc-time-to-int, zenirc-time=,
- zenirc-time<, and zenirc-time-diff).
- Wrote zenirc-timer-handler, the subroutine that schedules calls to
- zenirc-timer-hook.
- Added a timer hook, zenirc-notify-timer, which the client now uses
- to send "ISON" messages to the IRC server. Deleted code to call
- this directly from the PONG server message hook.
-
- * zenirc-stamp.el: New file.
-
-Tue Feb 8 20:50:06 1994 Per Persson <pp@solace.mh.se>
-
- * zenirc-ctcp-flood.el: Added legalese.
-
- * zenirc-example.el, zenirc-fortran.el: Added legalese.
-
- * zenirc-ojnk.el: New file.
-
- * zenirc.el: Changed server numeric 303 output to a more zenircish
- one, Currently Wasting time:
- Fixed a typo I made in the previous version which made zenirc barf.
-
- * zenirc.el: Added /ison as a command so you get the usual 303
- output instead of running the notify code.
-
-Tue Feb 8 03:09:32 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: Added legalese and /dcc command user interface.
- So far: /dcc get nick file, /dcc list.
-
- * zenirc-fancy-format.el, zenirc-swedish-mode.el: Added legalese.
-
- * zenirc.el: Added more autoload cookies.
- Corrected variable documentation for zenirc-server.
- Added new variable, zenirc-notify-list, which contains a list of
- strings that are nicks to do notification for.
- Added server message handlers for numerics 256, 257, 258, 259.
- Added display of server message 409, and fixed PING code so it doesn't
- generate these.
- Added /me command that sends CTCP actions to zenirc-current-victim.
- Removed call to text-mode that was deleting local variables and created
- the following buffer-local variables:
- zenirc-previous-ison - list of people you already recieved
- notification of.
- zenirc-ison-count - used as a counter to check ison every 5 server
- msgs.
- zenirc-serverversion - the version of the server you are using.
- zenirc-usermodes - the allowable modes for a user.
- zenirc-servermodes - the allowable modes for a channel.
- zenirc-servername - the server name of the server you are using.
- Made zenirc-parselines call zenirc-command-notify-hook every 5
- server msgs.
- fixed a bug in call zenirc-do-command that was occasionally
- passing extra \n's on the end of commands.
- Changed zenirc-parse-command to zenirc-parse-firstword, since it
- was used all over the place, not just in the command code.
- Added /notify command - can do /notify +nick to add to
- notification list, /notify -nick to remove, /notify list to get a
- list, and /notify to check current state.
- Added zenirc-isin-ison-list-p to check to see if a given nick is in an
- "ison" list.
- Modified zenirc-server-PING to call zenirc-command-notify-hook.
- Modified 001 reply handler to get your current nick (fixes zenirc bug
- when you log on and your initial nick is already taken)
- Added server 303 reply handler to display who is currently on irc from
- your notify list.
- Moved zenirc-extract-nick to the utility page.
- Added zenirc-member function that works like memq but uses equal
- instead of eq.
- Fixed minor bug in zenirc-delete.
- Made changes to zenirc-run-hook to stop running the hooks in a
- hooklist if one of the hooks set zenirc-run-next-hook to nil (it
- defaults to t).
- Added zenirc-parse-words which turns a line of the form "a b c" to
- ("a" "b" "c").
-
-Wed Feb 2 01:01:08 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-delete): New function from Noah.
- (zenirc-command-vector): Deleted. Nothing used it.
-
-Thu Jan 27 21:08:26 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-parse-command): Fixed bug that was stripping
- the last character off of the name of a command that had no
- subcommand.
-
-Tue Jan 25 05:21:16 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el, zenirc.el: Added "copyleft" statement.
-
-Mon Jan 24 15:35:33 1994 Per Persson <pp@solace.mh.se>
-
- * zenirc.el: The final fix for ;; you got kicked function.
- Now it really does what it is supposed to do.
-
-Mon Jan 24 15:16:07 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-run-hook): New function from friedman.
- This is the beginning of better hook support for zenirc.
-
- * zenirc-dcc.el: Added code to manage zenirc-dcc-list.
-
- * zenirc-swedish-mode.el: ci -u zenirc-swedish-mode.el.
- Improved some of the formatting (believe it or not).
-
-Sun Jan 23 21:32:16 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-dcc.el: New file.
-
-Sat Jan 22 06:11:21 1994 Per Persson <pp@solace.mh.se>
-
- * zenirc.el: Fixed the broken zenirc-server-KICK so it displays
- what it is supposed to show when you get kicked from a channel.
-
-Tue Jan 18 17:52:28 1994 Per Persson <pp@solace.mh.se>
-
- * zenirc.el: Added handlers for server numerics 200, 201, 202, 203,
- 204, 205, 206, 208, 209, 211, 212, 213, 214, 215, 216, 218, 219, 241
- 242, 243, 244, 303 and a handler for server PONGs.
- Fixed zenirc-privmsg-last-recieved so it won't ever be set to a
- server name.
-
-Tue Jan 18 15:24:03 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed bug in previous code - zenirc-privmsg-last-rec
- had to be set to the value of (zenirc-extract-nick from) so that
- nick!user@host never wound up in zenirc-privmsg-last-rec.
-
-Tue Jan 4 06:06:12 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-swedish-mode.el: Added spelling corrections from
- pp@solace.mh.se.
- Added silly comments from the splode-unit (friedman).
-
- * zenirc-swedish-mode.el: New file.
-
- * zenirc.el: Added C-cr and C-cs commands to do completion like
- `:' and `;' in Kiwi. (From pp@solace.mh.se.)
-
-Sun Jan 2 01:24:48 1994 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: ircd 2.6.16.0 and above appear to terminate server
- messages with CR NL instead of just NL. In zenirc-parselines, I
- added a check for this, and strip the CR in addition to the
- NL. When servers older han ircd 2.6.16 are not around, this should
- be fixed to remove the if test.
-
-Fri Dec 31 19:44:36 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-command-quit): New function.
- Added "/quit message"; before you had to "/quit :message" if you
- wanted `message' to contain spaces.
-
-Thu Dec 23 17:01:29 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added command hooks for /away and /topic.
-
-Sun Nov 28 18:25:29 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-parse-command): rewrote to parse commands into
- ("cmd" . "arguments") instead of fully parsing every word into an
- array element.
- (zenirc-do-command) modified to use the zenirc-parse-command
- described above.
- (zenirc-send-line): changed comment indicating this was temporary code;
- this doesn't seem to be the case anymore.
- (zenirc-format-nickuserhost): added comment indicating example
- replacements for this defun are in the client distribution.
- (zenirc-command-query): rewrote to use the new arguments passed from
- zenirc-do-command.
- (zenirc-command-m, zenirc-command-msg): wrote these to implement
- irc-II style /msg victim text and /m victim text commands.
- (zenirc-init-hooks): added hooks for zenirc-command-m and
- zenirc-command-msg.
-
-Thu Nov 11 22:42:21 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added diffs from friedman's version of 1.50 to do
- handle a list of server data. **I have not tested this code yet**.
- Fixed zenirc-server-KICK to show the person who kicked you correctly
- when you get kicked from a channel.
-
-Thu Nov 4 14:54:36 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: rmtodd added command parsing code.
- Checks for zenirc-command-WORD-hook.
- basic algorithm is:
- if user input does not start with `/', send to zenirc-current-victim
- if user input starts with `/':
- if fboundp zenirc-command-WORD-hook, where `WORD' is what
- follows the `/' then call it with process, argc, and argv (the
- last two similar to C) else pass it to the server.
-
-Sun Oct 24 17:02:36 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added handlers for server numerics 331, 351, 364,
- 365, 367, and 368.
-
-Tue Oct 19 04:34:51 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added 371 and 374 server replies.
- Fixed buglet in zenirc-server-PART that showed up when you parted
- several channels one after another.
-
-Tue Oct 19 02:30:13 1993 Richard Todd <rmtodd@servalan.servalan.com>
-
- * zenirc-fancy-format.el: Now hooks into the /who display, so you
- can do a who and load the nickuserhost list quickly with the
- people on your channel.
-
-Mon Oct 18 01:18:20 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: fixed zenirc-hostname defvar.
- Added defun of zenirc-set-text-list-ent from rmtodd.
- Added handlers for server numerics 381, 382, 391, 392, 393, 394,
- 395.
-
-Thu Oct 14 03:55:03 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: (zenirc) fixed check of zenirc-process-connect-hook.
-
- * zenirc.el: Added code to make zenirc proxy easier.
- (zenirc): if zenirc-process-connect-hook is fboundp, it will be
- called in place of open-network-stream.
- (zenirc-logon): added a hook, zenirc-logon-hook, which can be
- called in place of this function if it is fboundp.
-
-Wed Oct 13 07:02:30 1993 Charles Hannum <mycroft@gnu.ai.mit.edu>
-
- * zenirc-fancy-format.el (zenirc-format-nickuserhost-hook): Don't use
- table for server names.
-
- * zenirc.el: zenirc-servername: New variable.
- (zenirc-parse-servermsg): Default `from' to zenirc-servername if
- non-nil.
- (zenirc-server-PING): Use the host name in the argumet list.
- (zenirc-server-004): Record server name in zenirc-servername.
- (zenirc-extract-nick): Return nil if argument is a server name.
- (zenirc-format-privmsg-or-notice): Remove special case for local
- server.
-
-Wed Oct 13 05:10:42 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed lame string compare.
- Last checkin hosed by NFS problem; this contains
- rmtodd@servalan.servalan.com's fix to the process filter.
-
-Tue Oct 12 22:14:19 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-ctcp-flood.el: Modified to send each message 10
- times. eat flaming ctpc, bozo!
-
- * zenirc-fortran-mode.el: Fixed bug in last mod, and added rcs info.
-
- * zenirc.el: Applied fix for "wrong side of point" errors that
- happened in zenirc-display-string when user was typing and
- output happened. contributed by rmtodd@servalan.servalan.com.
-
-Mon Oct 11 23:39:34 1993 Charles Hannum <mycroft@gnu.ai.mit.edu>
-
- * zenirc-fancy-format.el: Use (aref) rather than (nth).
-
- * zenirc.el: Use a statically allocated vector for parsing server
- messages, and don't break a line if a CR is typed in the middle.
-
-Mon Oct 11 22:33:46 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-fortran-mode.el: Updated to use aref instead of nth while
- handling server messages.
-
- * zenirc.el: Minor string formatting frobs (vague comment to annoy
- noah). [noah is appropriately annoyed. 1995-03-18]
- Added handlers for server messages 305, 324, 342.
- Fixed call of zenirc-format-nickuserhost-hook in
- zenirc-server-KICK.
-
- * zenirc-fancy-format.el: Added zenirc-server-NICK-hook to track nick
- changes and not display nick!user@host if possible.
-
- * zenirc.el: fixed bug in CTCP SOURCE display.
-
-Mon Oct 11 01:33:49 1993 Charles Hannum <mycroft@gnu.ai.mit.edu>
-
- * zenirc.el: Fix 322, KICK, and WALLOPS.
-
- * zenirc-fancy-format.el: Move entries to the front of the alist
- as they are used. Also, only call assoc once.
-
-Sun Oct 10 21:24:16 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-fortran.el: Modified to work with new internal servermsg
- scheme.
-
- * zenirc.el: Minor comment update (intentionally vague comment to
- annoy noah). [noah is appropriately annoyed 1995-03-18]
- Added server message handlers for 302, 445, 446, 451, 462, 463, 464,
- 467, 483, 491, 501, 502. Added hook for 465.
-
- * zenirc.el (zenirc-logon): Added support for PASS command on connect.
- (zenirc-server-NICK): Added nick tracking of your current nickname.
- (zenirc-channelp): Utility routine to determine if a string is a
- nickname or a channel name.
- (various places): Changed semantics of zenirc-current-victim - "no
- victim" is now nil instead of "". This fixes a bug that showed up
- if the user starts banging return immediately on connect.
- Added server message handlers for: MODE, KICK, 407, 413, 414, 422,
- 423, 424, 431, 432, 433, 436, 441, and 444.
-
- * zenirc.el (zenirc-parse-servermsg) changed to return (msgtype
- from arg1...argn) instead of (msgtype from (arg1...argn).
- This required a rewrite of server message handlers:
- ERROR, INVITE JOIN KILL NICK NOTICE PART PING PRIVMSG QUIT TOPIC
- WALLOPS 001 002 003 004 251 252 253 254 255 301 306 311 312 313
- 314 315 317 318 319 321 322 323 332 341 352 353 366 369 372 375
- 376 401 402 403 404 405 406 409 411 412 421 442 443 461 465 471
- 472 473 474 475 481 482.
- (zenirc-server-314): Added.
-
-Sat Oct 9 22:19:56 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc-ctcp-flood.el, zenirc-example.el, zenirc-fortran.el:
- New files.
-
- * zenirc-fancy-format.el: New file.
-
- * zenirc.el: Added CTCP PING query handler.
-
- * zenirc.el: Added mycroft@ai.mit.edu as co-author.
- Deleted RCS log from source code.
- Changed CTCP SOURCE reply to point to brrcrftp.
- Changed defvar of zenirc-text-list to a setq. Otherwise changing
- this while developing is a hassle. Can be changed back when code
- is stable.
- Added improved zenirc-parse-servermsg, from mycroft
- Added error message when you try to send text and you don't have a
- zenirc-current-victim.
- Added display of emacs-version to CTCP VERSION replies.
-
-Fri Oct 8 05:22:28 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Moved zenirc-startup-hook to a more useful place.
- Minor bugfixes in CTCP code.
- Many speedups added as suggested by mycroft.gnu.ai.mit.edu.
- Removed broken zenirc-match defun, and replaced instances with
- properly working case insensitive code as suggested by mycroft.
- Added zenirc-startup-hook.
- Made hooks actually work properly for server messages, etc. so you
- don't have to modify zenirc.el anymore.
-
-Mon Oct 4 01:38:27 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Minor bugfixes in string formatting and ctcp code.
-
-Sat Oct 2 02:09:25 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed format string in /who list reply.
-
-Fri Oct 1 02:58:48 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed display of user in PART servermsg handler.
-
-Wed Sep 29 00:28:22 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Cleaned up version data and a few odds and ends for
- ALPHA1 release.
-
- * zenirc.el: Rewrote CLIENTINFO ctcp to be smaller and user
- extensible.
-
-Tue Sep 28 20:16:31 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added CTCP query handlers for ACTION, CLIENTINFO,
- ERRMSG, FINGER, SOURCE TIME, USERINFO, and VERSION.
- Added hook code for CTCP.
- Added "message sent to" display to the input handler.
- Cleaned up CTCP code.
-
-Mon Sep 27 23:43:08 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added temporary input parser, so you don't have to
- type "PRIVMSG #chan :foo" to talk to the current channel.
-
- * zenirc.el: Added save of match data around process-filter,
- deleted save of match data in various other places in the source.
-
-Sun Sep 12 22:52:40 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Modified message and notice handling to support ctcp
- Currently, just send ctcp errmsg to all ctcp queries.
-
- * zenirc.el (zenirc-format-nickuserhost): wrote code to handle a
- case the IRC protocol spec says "doesn't happen".
-
-Mon Sep 6 01:22:10 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Changed "notify" to "signal", and added a rudimentary
- signal subroutine.
-
-Sun Sep 5 05:04:42 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added 253 numeric and support for a "notify" feature
- like Kiwi has.
-
-Wed Sep 1 04:08:54 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added "fnord" to zenirc-ignorance-list.
-
-Sun Aug 29 17:37:01 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Fixed 332 numeric handler.
- Added zenirc-ignore and zenirc-ignorance-list, so client can now
- ignore annoying things.
-
-Sat Aug 28 03:46:27 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added numerics 369, 405, 406, 409, 465.
- Added comments.
-
-Fri Aug 27 13:43:25 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added support for 482 numeric, corrected some
- spelling errors.
-
-Mon Aug 16 00:38:44 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added handlers for numerics 411, 471, 472, 473, 474,
- 475, and 481.
-
-Sun Aug 15 18:16:08 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added INVITE server message handler.
-
-Sat Aug 14 23:48:20 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added handlers for server messages KILL, WALLOPS
- (untested), 341, 404, 412, 422, 442, 443, and 461.
-
- * zenirc.el: Added handlers for server numerics 306 and 403
-
- * zenirc.el: Added numeric handlers for server numerics 001, 002,
- 003, 004, 252, 254, 255, 372, 375, 376.
-
-Fri Aug 13 05:57:32 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added code to handle servermsg 251.
-
-Fri Jul 23 20:23:37 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added support for 315, 317, and 352 numerics.
-
-Wed Jul 21 14:41:51 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added code to handle NICK server message.
-
-Sun Jul 18 15:36:55 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Finished PART and JOIN, added a bunch of numerics,
- wrote (zenirc-match).
-
- * zenirc.el: (zenirc-format-nickuserhost) Fixed hook call.
- Worked JOIN & PART server message handlers.
-
- * zenirc.el (zenirc-format-nickuserhost-hook): New variable.
- Added handlers for server message types NOTICE, PRIVMSG, numerics
- 401 and 402.
-
-Sat Jul 17 23:01:19 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Some general cleanup of comments in
- zenirc-parse-servermsg Added new servermsg handling routines for
- ERROR, PART, TOPIC (unfinished), numerics 321, 322, 323, and 332.
-
- * zenirc.el (zenirc-parse-servermsg): extended to parse servermsg
- arguments also servermsg hook routines - modified to understand
- new output from zenirc-parse-servermsg.
-
-Thu Jul 8 02:22:55 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Deleted zenirc-instring. Code now uses string-match
- everywhere.
- Many minor bugfixes.
- Rewrote zenirc-parse-servermsg.
- Added some new hooks for server messages.
-
-Sat Jul 3 02:42:25 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-text-list): New variable.
- This is an alist of all text output by zenirc, so it can be
- internationalized or customized.
-
-Wed Jun 30 05:35:01 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Changed some instances of zenirc-instring to
- string-match.
-
-Mon Jun 28 20:29:54 1993 Eric Prestemon <ecp@gnu.ai.mit.edu>
-
- * zenirc.el: Now handles host:port correctly in IRCSERVER.
-
-Sat Jun 19 00:37:12 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Lots of general cleanup, bux fixes.
- wrote temporary servermessage parser routine.
-
-Tue Jun 15 12:30:20 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-parselines): rewrote code to jump to server
- message handler to call zenirc-server-MSGTYPE-hook.
- (zenirc-parse-servermsg): started to write this subroutine.
-
-Sun Jun 13 02:56:09 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-filter): Call zenirc-parselines, which
- breaks up a block of text from the server into lines.
-
-Thu Jun 10 01:43:27 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-parse-servermsg): worked some on parsing
- server messages. Realized that data coming from the zenirc process
- is not coming a line at a time, and it needs to be blocked into
- lines before calling zenirc-parse-servermsg.
-
-Wed Jun 9 04:55:48 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-filter): thought of a better way to make
- zenirc-filter work.
-
- * zenirc.el (zenirc-filter): I made this function call a function
- based on the server message type. If there is no handler, call
- zenirc-display-string.
-
- * zenirc.el (zenirc-logon): Added send of NICK and USER commands
- to IRC server on connect.
-
-Fri Jun 4 05:27:44 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el (zenirc-logon): started to write, got tired, went to
- bed instead.
-
- * zenirc.el: Added code to parse IRCSERVER environment variable.
-
-Thu Jun 3 08:19:19 1993 Noah Friedman <friedman@prep.ai.mit.edu>
-
- * zenirc.el: Add autoload cookies.
- Differentiate between process filter and buffer display routine
- Initialize zenirc-mode-map at load-time, not in zenirc-mode
- (zenirc): Don't create a new *zenirc* process unless prefix arg is
- given.
- Without prefix arg, just switch to initial zenirc process.
- (zenirc): Don't bother making `zenirc-process' buffer-local. You
- don't want to rely on it anyway. Use let instead.
- (zenirc-send-line): Cleaned up.
-
-Thu Jun 3 02:16:35 1993 Ben Mesander <ben@gnu.ai.mit.edu>
-
- * zenirc.el: Added stuff to make scrolling work right from
- meditate.el.
-
- * zenirc.el: New file.
+++ /dev/null
-;;; zenirc-18.el --- compatibility functions for Emacs 18
-
-;;; Copyright (C) 1994, 1995 Noah S. Friedman
-;;; Copyright (C) 1985, 1986, 1992, 1994 Free Software Foundation, Inc.
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: extensions, zenirc
-;; Created: 1995-01-01
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This file mainly just defines functions used by zenirc which don't exist
-;; in emacs 18, but do exist in emacs 19. Everything here is original with
-;; the author unless indicated otherwise.
-
-;; TODO: Fix a current-time[-string].
-
-;;; Code:
-
-\f
-;; From GNU Emacs 19.27 subr.el
-(defmacro zenirc-save-match-data (&rest body)
- "Execute the BODY forms, restoring the global value of the match data."
- (let ((original (make-symbol "match-data")))
- (list
- 'let (list (list original '(match-data)))
- (list 'unwind-protect
- (cons 'progn body)
- (list 'store-match-data original)))))
-
-(or (fboundp 'save-match-data)
- (fset 'save-match-data 'zenirc-save-match-data))
-
-\f
-;; From emacs 19.29 window.el
-(defun zenirc-walk-windows (proc &optional minibuf all-frames)
- "Cycle through all visible windows, calling PROC for each one.
-PROC is called with a window as argument.
-
-Optional second arg MINIBUF t means count the minibuffer window even
-if not active. MINIBUF nil or omitted means count the minibuffer iff
-it is active. MINIBUF neither t nor nil means not to count the
-minibuffer even if it is active.
-
-Several frames may share a single minibuffer; if the minibuffer
-counts, all windows on all frames that share that minibuffer count
-too. Therefore, when a separate minibuffer frame is active,
-`walk-windows' includes the windows in the frame from which you
-entered the minibuffer, as well as the minibuffer window. But if the
-minibuffer does not count, only windows from WINDOW's frame count.
-
-third arg ALL-FRAMES is ignored in emacs 18; it exists solely for
-compatibility with emacs 19."
- ;; If we start from the minibuffer window, don't fail to come back to it.
- (if (window-minibuffer-p (selected-window))
- (setq minibuf t))
- (let* ((walk-windows-start (selected-window))
- (walk-windows-current walk-windows-start))
- (while (progn
- (setq walk-windows-current
- (next-window walk-windows-current minibuf))
- (funcall proc walk-windows-current)
- (not (eq walk-windows-current walk-windows-start))))))
-
-(or (fboundp 'walk-windows)
- (fset 'walk-windows 'zenirc-walk-windows))
-
-\f
-(defun zenirc-delete (elt list)
- "Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-If the first member of LIST is ELT, deleting it is not a side effect;
-it is simply using a different list.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'."
- (let ((p list)
- (l (cdr list)))
- (while l
- (if (equal elt (car l))
- (setcdr p (cdr l))
- (setq p (cdr p)))
- (setq l (cdr l))))
- (if (equal elt (car list))
- (cdr list)
- list))
-
-(or (fboundp 'delete)
- (fset 'delete 'zenirc-delete))
-
-\f
-(defun zenirc-force-mode-line-update (&optional all)
- "Force the mode-line of the current buffer to be redisplayed.
-With optional non-nil ALL then force then force redisplay of all mode-lines."
- (if all (save-excursion (set-buffer (other-buffer))))
- (set-buffer-modified-p (buffer-modified-p)))
-
-(or (fboundp 'force-mode-line-update)
- (fset 'force-mode-line-update 'zenirc-force-mode-line-update))
-
-\f
-(defun zenirc-member (x y)
- "Return non-nil if ELT is an element of LIST. Comparison done with `equal'.
-The value is actually the tail of LIST whose car is ELT."
- (while (and y (not (equal x (car y))))
- (setq y (cdr y)))
- y)
-
-(or (fboundp 'member)
- (fset 'member 'zenirc-member))
-
-\f
-;; In emacs 19, the window end is managed internally and getting it is done
-;; with a builtin function. In emacs 18, we have to search for it by
-;; scanning forward until point is no longer "visible".
-
-(defun zenirc-window-end (&optional window)
- "Return position at which display currently ends in WINDOW."
- (or window (setq window (selected-window)))
- (let ((orig-buf (current-buffer))
- point-max)
- (set-buffer (window-buffer window))
- (setq point-max (point-max))
- (set-buffer orig-buf)
- (cond
- ((pos-visible-in-window-p point-max window)
- point-max)
- (t
- (let ((incr (min (* (window-width window) (window-height window))
- (- point-max (window-start window))))
- (end (window-start window)))
- (while (not (zerop (setq incr (/ incr 2))))
- (while (and (< end point-max)
- (pos-visible-in-window-p end window))
- (setq end (+ end incr)))
- (setq end (- end incr)))
- (1+ end))))))
-
-(or (fboundp 'window-end)
- (fset 'window-end 'zenirc-window-end))
-
-\f
-(provide 'zenirc-18)
-
-;;; zenirc-18.el ends here
+++ /dev/null
-;;; zenirc-8ball.el --- magic 8 ball for ZenIRC
-
-;; Copyright (C) 1996 Mark S Bailen
-;; Copyright (C) 1997 Noah Friedman
-
-;; Bozo: Mark S Bailen
-;; Maintainer: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Keywords: zenirc, extensions, magic, 8ball
-;; Created: 1996-10-4
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Code hacked from Noah's zenirc-yow.el and Eric's zenirc-random-away.el
-;; Rewritten 1997-03-03 by Noah to use zenirc-trigger.el.
-
-;;; Code:
-
-(require 'zenirc)
-(require 'zenirc-trigger)
-
-(defconst zenirc-8ball-prefix "magic 8-ball says ====>")
-
-(defconst zenirc-8ball-responses
- '("CERTAINLY"
- "DEFINITELY NOT"
- "MAYBE"
- "NO"
- "REPLY HAZY, TRY AGAIN LATER"
- "YES"))
-
-(defun zenirc-8ball ()
- (concat zenirc-8ball-prefix " "
- (nth (random (length zenirc-8ball-responses))
- zenirc-8ball-responses)))
-
-(zenirc-trigger-register "8ball" 'zenirc-8ball "\\b8 ball\\b")
-
-(provide 'zenirc-8ball)
-
-;;; zenirc-8ball.el ends here
+++ /dev/null
-;;; zenirc-away.el --- fancy away processing for ZenIRC
-
-;;; Copyright (C) 1994 Noah S. Friedman
-;;; Copyright (C) 1998 Per Persson
-
-;;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;;; Maintainer: pp@sno.pp.se
-;;; Keywords: zenirc, extensions, oink
-;;; Created: 1994-06-26
-
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; This package reduces the number of times you see a user's /away message.
-;;; The first time you see that user's /away, the usual thing happens.
-;;; Subsequent /away messages are suppressed until the user changes it.
-
-;;; Code:
-
-(require 'zenirc)
-
-;; 101 buckets should be a reasonable size for most people (remember to use
-;; a prime number to get good hashing characteristics).
-;; This is not the total number of nicks you can cache, but just the number
-;; of "buckets" in which nicks can be stored. If you talk to thousands
-;; and thousands of people it might help to increase the size of this
-;; table, but even then it isn't necessary.
-(defvar zenirc-away-table (make-vector 101 0)
- "Association list of nicknames and their /away messages.
-zenirc-server-301-fancy suppresses the display of /away messages if
-you've already seen them.")
-
-(defun zenirc-server-301-fancy (proc parsedmsg)
- "Display /away message if you haven't seen it already."
- (let* ((from (zenirc-extract-nick (aref parsedmsg 3)))
- (text (aref parsedmsg 4))
- (nicksym (intern (zenirc-downcase-name from) zenirc-away-table))
- (cached (and (boundp nicksym) (symbol-value nicksym))))
- (cond ((and cached (string= text cached)))
- (t
- (set nicksym text)
- (zenirc-message proc 's301 from text)))))
-
-(defun zenirc-server-301-signal-p (proc parsedmsg)
- "Allow signals on /away message if you haven't seen it already."
- (if (string= (aref parsedmsg 0) "301")
- (let* ((from (zenirc-extract-nick (aref parsedmsg 3)))
- (text (aref parsedmsg 4))
- (nicksym (intern (zenirc-downcase-name from) zenirc-away-table))
- (cached (and (boundp nicksym) (symbol-value nicksym))))
- (if (and cached (string= text cached))
- (setq zenirc-run-next-hook nil)))))
-
-(provide 'zenirc-away)
-
-(zenirc-remove-hook 'zenirc-server-301-hook 'zenirc-server-301)
-(zenirc-add-hook 'zenirc-server-301-hook 'zenirc-server-301-fancy)
-(zenirc-add-hook 'zenirc-signal-hook 'zenirc-server-301-signal-p)
-
-;;; zenirc-away.el ends here
+++ /dev/null
-;;; zenirc-bork.el --- Swedish Chef message catalog for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 95-07-28
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; "I am Svedish Chef of Burg. Prepaur to bey Assimilatedy."
-;;; "Borg borg borg!"
-
-;;; Code:
-(require 'zenirc)
-
-(zenirc-lang-define-catalog
- 'bork
- '((s001 . "[inffu] Yuoo ere-a vesteeng teeme-a. Bork Bork Bork!")
- (s002 . "[inffu] Yuoor IRC serfer is %s roonneeng ircd ferseeun %s")
- (s003 . "[inffu] Thees serfer ves creeted %s")
- (s200 . "[inffu] %s (%s) Leenk -> %s")
- (s202 . "[inffu] %s H.S. -> %s")
- (s203 . "[inffu] %s Hmmm -> IP eddress: %s")
- (s204 . "[inffu] %s Oper -> %s")
- (s205 . "[inffu] %s User -> %s")
- (s206 . "[inffu] %s Serf -> %s %s %s %s ")
- (s208 . "[inffu] %s %s -> %s")
- (s209 . "[inffu] %s Cles -> %s = %s")
- (s211 . "[inffu] %s lenk up %s sec\nSent: %s/%s, Rcvd: %s/%s, SendQ: %s")
- (s212 . "[inffu] %s\t->\tteemes: %s\tbytes: %s")
- (s213 . "[inffu] C hst/nme/prt/cls: %s/%s/%s/%s")
- (s214 . "[inffu] N hst/nme/prt/cls: %s/%s/%s/%s")
- (s215 . "[inffu] %s hust/neme-a/cless:\t%s/%s/%s")
- (s216 . "[inffu] K hust/userneme-a:\t%s/%s")
- (s217 . "[inffu] Q %s/%s/%s/%s/%s")
- (s218 . "[inffu] Cless: %s Peeng freq: %s Conn.freq: %s Mex Leenks: %s Sendq: %s")
- (s219 . "[inffu] Ind ooff /stets.")
- (s221 . "[inffu] Yuoor coorrent user mude-a is: %s")
- (s241 . "[inffu] LEEF hustmesk/dept:\t\t%s/%s")
- (s242 . "[inffu] %s")
- (s243 . "[inffu] %s neeckneme-a/user@hust:\t%s/%s")
- (s244 . "[inffu] HOoB hustmesk/serferneme-a:\t%s/%s")
- (s251 . "[inffu] Zeere-a ere-a %s/%s feesible-a/infeesible-a users oon %s serfers.")
- (s252 . "[inffu] Zeere-a ere-a %s mejur dveebs oonleene-a.")
- (s253 . "[inffu] Zeere-a ere-a %s unknoon cunnecshuns.")
- (s254 . "[inffu] Zeere-a ere-a %s chunnels")
- (s255 . "[inffu] Zeere-a ere-a %s cleeents und %s serfers cunnected tu thees serfer")
- (s256 . "[inffu] Edmeenistretife-a inffurmeshun fur %s:")
- (s257 . "[inffu] %s")
- (s258 . "[inffu] %s")
- (s259 . "[inffu] %s")
- (s261 . "[inffu] %s Feele-a -> %s %s")
- (s301 . "[inffu] %s is evey: %s")
- (s302 . "[inffu] userhust: %s")
- (s303 . "[inffu] Coorrently vesteeng teeme-a: %s")
- (s305 . "[inffu] Yuoo ere-a nu lunger evey")
- (s306 . "[inffu] Yuoo ere-a evey")
- (s311 . "[inffu] %s (%s@%s) is %s")
- (s312 . "[inffu] %s isves useeng serfer %s (%s)")
- (s313 . "[inffu] %s is a mejur dveeb.")
- (s314 . "[inffu] %s (%s@%s) ves %s")
- (s315 . "[inffu] Ind ooff /vhu.")
- (s317 . "[inffu] %s hes beee idle-a %s")
- (s318 . "[inffu] Ind ooff /vhuees.")
- (s319 . "[inffu] %s is on: %s")
- (s321 . "[inffu] Chunnel Users Tupeec")
- (s322 . "[inffu] %-15s %-5s %s")
- (s323 . "[inffu] Ind ooff /leest.")
- (s324 . "[inffu] Mude-a fur %s is %s %s")
- (s331 . "[inffu] %s hes nu tupeec")
- (s332 . "[inffu] %s tupeec: %s")
- (s333 . "[inffu] %s tupeec set by %s et %s")
- (s341 . "[inffu] Yuoo ere-a infeeting %s tu %s")
- (s342 . "[inffu] Yuoo ere-a eskeeng %s tu veste-a teeme-a")
- (s351 . "[inffu] Ferseeun: %s %s %s")
- (s352_header . "[inffu] Neeckneme-a Stet Neme-a ooff Chunnel User@hust (Hup cuoont Neme-a)")
- (s352 . "[inffu] %-9s %-3s %-15s %s@%s (%s)")
- (s353 . "[inffu] Users on %s: %s")
- (s364 . "[inffu] %s %s %s")
- (s365 . "[inffu] Ind ooff /leenks")
- (s367 . "[inffu] %s bun %s")
- (s368 . "[inffu] Ind ooff bunleest")
- (s371 . "[inffu] %s")
- (s372 . "[motd] %s")
- (s375 . "[motd] Messege-a Ooff Zee Dey:")
- (s376 . "[motd] End ooff mutd")
- (s381 . "[inffu] You are now a major dweeb")
- (s382 . "[inffu] Rehesheeng: %s")
- (s391 . "[inffu] Teeme-a fur serfer %s: %s")
- (s392 . "[inffu] Usereed Termeenel Hust")
- (s393 . "[inffu] %s")
- (s395 . "[inffu] Nubudy lugged oon")
- (s401 . "[inffu] Nu sooch neeck/chunnel: %s")
- (s402 . "[inffu] Nu sooch serfer: %s")
- (s403 . "[inffu] Noo suuch choonnel: %s")
- (s404 . "[inffu] Yuoo cunnut send tu %s.")
- (s405 . "[inffu] Tuu muny chunnels: %s")
- (s406 . "[inffu] Serfer hes nu recurd ooff neeckneme-a: %s")
- (s407 . "[inffu] Doopleecete-a receepients. Nu messege-a sent: %s")
- (s409 . "[inffu] Nu ooreegin speceeffied.")
- (s411 . "[inffu] Nu receepient geefee.")
- (s412 . "[inffu] Nu text tu send.")
- (s413 . "[inffu] Nu tuplefel dumeeen: %s")
- (s414 . "[inffu] Veeldcerd in tuplefel dumeeen: %s")
- (s421 . "[inffu] Thees luuks leeke-a spem tu me-a: %s. Bork Bork Bork!")
- (s422 . "[inffu] Nu mutd (fleme-a mejur dveeb leested in /edmeen)")
- (s423 . "[inffu] Nu edmeen inffu. Ignurunt mejur dveeb roonneeng serfer.")
- (s431 . "[inffu] Nu neeckneme-a geefee")
- (s432 . "[inffu] Infeleed neeckneme-a: %s")
- (s433 . "[inffu] Neeckneme-a elreedy in use-a: %s")
- (s436 . "[inffu] Neeck culleesiun keell: %s")
- (s441 . "[inffu] %s is nut oon %s")
- (s442 . "[inffu] Yuoo ere-a nut oon %s.")
- (s443 . "[inffu] %s is elreedy oon chunnel %s.")
- (s444 . "[inffu] %s is nut lugged in")
- (s445 . "[inffu] Sume-a mejur dveeb vun't let yuoo du soommun")
- (s446 . "[inffu] Sume-a mejur dveeb vun't let yuoo du /users")
- (s451 . "[inffu] Yuoo hefe-a nut regeestered")
- (s461 . "[inffu] Nut inuoogh peremeters: %s")
- (s462 . "[inffu] Yuoo mey nut reregeester")
- (s463 . "[inffu] Sume-a fesceest mejur dveeb veell nut let yuoo cunnect")
- (s464 . "[inffu] Pessvurd is incurrect")
- (s465 . "[inffu] Yuoo ere-a nut ellooed tu use-a thees serfer.")
- (s467 . "[inffu] Key fur %s is elreedy set.")
- (s471 . "[inffu] Cunnut jueen %s (user leemit reeched).")
- (s472 . "[inffu] s is un unknoon mude-a cherecter.")
- (s473 . "[inffu] Cunnut jueen %s (infeete-a oonly).")
- (s474 . "[inffu] Cunnut jueen %s (bun).")
- (s475 . "[inffu] Cunnut jueen %s (chunnel key).")
- (s481 . "[inffu] Yuoo ere-a nut a beeg inuoogh dveeb tu du thet.")
- (s482 . "[inffu] Yuoo ere-a nut a pooermunger fur %s.")
- (s483 . "[inffu] Dooh. Yuoo cunnut keell a serfer")
- (s491 . "[inffu] Nu mejur dveebs ellooed frum yuoor hust")
- (s501 . "[inffu] Unknoon user mude-a fleg")
- (s502 . "[inffu] Cunnut chunge-a mude-a fur oozeer users")
- (action . "(sent tu %s)")
- (action-echo . "(sent tu %s)")
- (connect-failed . "[irrur] Cuooldn't cunnect tu %s purt %d, reesun: %s")
- (connect-try . "[inffu] Cunnecteeng tu %s purt %d...")
- (connect-abort . "[inffu] Eburted ettempt tu cunnect tu un irc serfer.")
- (ctcp_action . "[ecshun->%s] %s %s") ; ctcp ACTION display
- (ctcp_clientinffu . "[qooery] CLIENTINFO frum %s tu %s")
- (ctcp_errmsg . "[qooery] IRRMSG frum %s tu %s")
- (ctcp_finger . "[qooery] FINGER frum %s tu %s")
- (ctcp_ping . "[qooery] PING frum %s tu %s")
- (ctcp_ping_reply . "[reply] PING: %s is %s secunds evey")
- (ctcp_source . "[qooery] SOOoRCE frum %s tu %s")
- (ctcp_time . "[qooery] TIME frum %s tu %s")
- (ctcp_userinffu . "[qooery] USERINFFU from %s to %s")
- (ctcp_version . "[qooery] FERSION frum %s tu %s")
- (debug . "[debug] %s")
- (error . "[%s] %s")
- (invite . "[inffu] %s infeetes yuoo tu %s.")
- (join_you . "[inffu] Jueening chunnel: %s")
- (join . "[inffu] %s hes jueened %s")
- (kick . "[inffu] %s hes beee keecked frum %s by %s")
- (kick_you . "[inffu] Yuoo hefe-a beee keecked frum %s by %s")
- (kill . "[inffu] Yuoo hefe-a beee keelled: %s")
- (mode . "[inffu] %s hes chunged mude-a fur %s: %s")
- (nick . "[inffu] %s hes chunged neeck tu %s")
- (newcatalog . "[inffu] Coorrent messege-a cetelug set tu %s")
- (nocatalog . "[error] Nu messege-a cetelug deffeened fur %s")
- (nosend . "[inffu] yuoo hefe-a nu coorrent feectim tu send tu")
- (notice . "{%s%s} %s")
- (notice_you . "{%s} %s")
- (now_qooerying . "[inffu] Coorrent feectim is %s.")
- (part_you . "[inffu] Leefeeng: %s (%s)") ; your part from channel message
- (part . "[inffu] %s hes lefft %s (%s)")
- (pong . "[inffu] %s seys oojnk")
- (privmsg . "<%s%s> %s")
- (privmsg_you . "*%s* %s")
- (protocol_violation . "[irrur] Zee fullooeeng leene-a is in feeuleshun ooff zee IRC prutucul.\n[irrur] Pleese-a tell zee serfer edmeenistretur:\n%s: %s")
- (query . "[qooery] frum %s tu %s cuntent %s")
- (qyery_unknown . "is un unknoon CTCP qooery")
- (query_unbalanced . "[UNBALANCED qooery] um %s tu %s cuntent %s")
- (query_unbalanced_reply . "is un unbelunced CTCP quuery")
- (quit . "[inffu] %s stupped vesteeng teeme-a: %s")
- (reply . "[reply] frum %s tu %s cuntent %s")
- (reply_unbalanced . "[UNBELENCED reply] frum %s tu %s cuntent %s")
- (send . "(sent tu %s)")
- (send-echo . "(sent tu %s)")
- (send-multi . "(sent tu %s in %d perts)")
- (send-multi-echo . "(sent tu %s in %d perts)")
- (sentinel . "\nZenIRC inded et %s")
- (server . "[serfer] %s")
- (signal . "[seegnel in %s]")
- (topic . "[inffu] %s chunged zee tupeec oon %s tu: %s")
- (wallops . "-%s- %s")
- ))
-
-(provide 'zenirc-bork)
-
-;;; zenirc-bork.el ends here
+++ /dev/null
-;;; zenirc-color.el --- color messages in zenirc
-
-;; Copyright (C) 1996 John Wiegley
-;; Copyright (C) 1996, 1998 Per Persson
-
-;; Author: John Wiegley <johnw@borland.com>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc,extensions
-;; Created: 1996-05-22
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; This ZenIRC extensions allows you to colorize input from specific
-;;; sources. Use the "/color #victim <COLOR>" command to start
-;;; colorizing a certain victim's output.
-
-;;; Code:
-
-(require 'zenirc)
-
-(defun zenirc-color-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((color-lame-args . "[info] %s: not enough arguments.")
- (color-nonexistant . "[info] %s is not an allowed color.")
- (color-not-found . "[info] %s: not found in color list."))))
-
-(defvar zenirc-color-mode nil
- "*If non-nil, then color messages fitting `zenirc-color-message-categories'.
-This is buffer-local.")
-(make-variable-buffer-local 'zenirc-color-mode)
-
-(defvar zenirc-color-region-function 'zenirc-colorize-region
- "*Function to use for coloring.")
-
-(defvar zenirc-facename-index 1
- "Used for creating new zenirc face names")
-
-(defvar zenirc-color-alist
- '()
- "*A list of elements, each of which is (REGEXP FACE), where both are
-strings. Any string containing REGEXP in the output will have it's face
-property set to FACE.")
-(make-variable-buffer-local 'zenirc-color-alist)
-
-(defvar zenirc-color-message-categories
- '(privmsg privmsg_you notice notice_you ctcp_action)
- "*ZenIRC message categories to color. This should be a list
-consisting of symbols corresponding to the type of messages in the
-message catalog which should be colored. For example, private
-messages (`privmsg') and notices (`notice') are good choices.
-
-If this variable is set to `t', then all messages are colored.
-If this variable is set to `nil', then no messages are colored.")
-(make-variable-buffer-local 'zenirc-color-message-categories)
-
-(defvar zenirc-color-nonstandard-message-categories-p nil
- "If non-nil, then color messages that are not in a standard category.
-That is, color messages which did not originate from the message catalog,
-and thus have no category symbol.")
-(make-variable-buffer-local 'zenirc-color-nonstandard-message-categories-p)
-
-;; Check whether a given color really exists as a color.
-(defun zenirc-color-name-p (color)
- (let ((version (emacs-version)))
- (cond ((string-match "XEmacs" version)
- (valid-color-name-p color))
- ((string-match "GNU" version)
- (x-color-defined-p color))
- (t
- nil))))
-\f
-(defun zenirc-color-mode (&optional prefix)
- "Enable or disable colorization of irc messages.
-
-A negative prefix argument disables this mode.
-No argument or any non-negative argument enables it.
-
-The user may also enable or disable this mode simply by setting the
-variable of the same name."
- (interactive "P")
- (cond
- ((null prefix)
- (setq zenirc-color-mode (not zenirc-color-mode)))
- ((>= (prefix-numeric-value prefix) 0)
- (setq zenirc-color-mode t))
- (t
- (setq zenirc-color-mode nil)))
- (cond ((not (interactive-p)))
- (zenirc-color-mode
- (message "zenirc-color-mode is enabled"))
- (t
- (message "zenirc-color-mode is disabled")))
- zenirc-color-mode)
-
-(defvar zenirc-face nil)
-
-(defun zenirc-colorize-region (beg end)
- (interactive "r")
- (save-match-data
- (save-excursion
- (goto-char beg)
- (mapcar
- (function
- (lambda (elem)
- (if (re-search-forward (car elem) end t)
- (put-text-property beg end 'face (car (cdr elem))))))
- zenirc-color-alist))))
-
-(defun zenirc-color-message (proc sym string)
- (and zenirc-color-mode
- (cond ((eq zenirc-color-message-categories t))
- ((null sym)
- zenirc-color-nonstandard-message-categories-p)
- ((memq sym zenirc-color-message-categories))
- (t nil))
- (funcall zenirc-color-region-function (point-min) (- (point-max) 1))))
-
-\f
-(defvar zenirc-command-color-hook '(zenirc-command-color))
-
-;; /color #victim <color>
-(defun zenirc-command-color (proc cmd)
- (let* ((arg (zenirc-parse-firstword (cdr parsedcmd)))
- (victim (format "%s" (car arg)))
- (color (cdr arg)))
- (if (or (string= "" victim)
- (string= "" color))
- (zenirc-message proc 'color-lame-args "/color")
- (if (zenirc-color-name-p color)
- (let ((newface (make-symbol
- (concat "zenirc-color-face-"
- (number-to-string zenirc-facename-index)))))
- (setq zenirc-facename-index (1+ zenirc-facename-index))
- (copy-face 'default newface)
- (set-face-foreground newface color)
- (setq zenirc-color-alist
- (cons (list victim newface)
- zenirc-color-alist)))
- (zenirc-message proc 'color-nonexistant color)))))
-\f
-(defvar zenirc-command-uncolor-hook '(zenirc-command-uncolor))
-
-;; /uncolor #victim
-(defun zenirc-command-uncolor (proc cmd)
- (let* ((arg (zenirc-parse-firstword (cdr parsedcmd)))
- (victim (format "%s" (car arg))))
- (if (string= "" victim)
- (zenirc-message proc 'color-lame-args "/uncolor"))
- (let ((pointer zenirc-color-alist) last found)
- (while pointer
- (if (string= (car (car pointer)) victim)
- (progn
- (setq found t)
- (if (= (length zenirc-color-alist) 1)
- (setq zenirc-color-alist nil)
- (if last
- (setcdr last (cdr pointer))
- (setq zenirc-color-alist (cdr pointer))))))
- (setq last pointer)
- (setq pointer (cdr pointer)))
- (if (not found)
- (zenirc-message proc 'color-not-found victim)))))
-\f
-(provide 'zenirc-color)
-
-(zenirc-add-hook 'zenirc-message-hook 'zenirc-color-message)
-
-(or (assq 'zenirc-color-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons (list 'zenirc-color-mode " Zcolor") minor-mode-alist)))
-
-(zenirc-color-install-message-catalogs)
-
-;;; zenirc-color.el ends here
+++ /dev/null
-;;;
-;;;
-;;; zenirc-command-queue.el --- Schedule commands for ZenIRC.
-
-;;; Copyright (C) 1993, 1994 Ben A. Mesander
-
-;;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;;; Maintainer: ben@gnu.ai.mit.edu
-;;; Keywords: extensions
-;;; Created: 1994/07/20
-
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; ircd 2.8 implements something called "flood control" that knocks you
-;;; off of IRC if you send commands at a rate faster than .5 lines/sec.
-;;; This ZenIRC module implements a queue of commands to be sent to the
-;;; server and attempts to send them at a rate slower than this. In addition,
-;;; you can place lisp code to be executed in the queue (to allow for
-;;; synchronization, like "execute this lisp code after all these lines have
-;;; been sent to the server".) The queue is stored as a simple list in
-;;; zenirc-command-queue. Note that since ZenIRC is event driven, commands
-;;; may be executed no faster than the server PING time (which is usually
-;;; several minutes).
-
-;;; Code:
-
-(require 'zenirc)
-
-;;;###autoload
-(defvar zenirc-command-queue nil "List of commands to send to server")
-
-;;;###autoload
-(defvar zenirc-last-command-queue-exec '(0 0)) ; time last cmd sent to server
-
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-handle-command-queue)
-
-;;
-;; queue a command to be sent to the server
-;;
-;;;###autoload
-(defun zenirc-queue-command (command)
- (setq zenirc-command-queue (cons command zenirc-command-queue)))
-
-;;
-;; figure out how many commands to send to the server
-;;
-;;;###autoload
-(defun zenirc-handle-command-queue (proc now)
- (let ((interval (zenirc-time-diff now zenirc-last-command-queue-exec)))
- (and zenirc-command-queue
- (cond
- ;; 8 or more seconds have passed - send four commands
- ((zenirc-time< '(0 7) interval)
- (zenirc-exec-command-queue proc now 4))
- ;; six or seven seconds have passed - send three commands
- ((zenirc-time< '(0 5) interval)
- (zenirc-exec-command-queue proc now 3))
- ;; four or five seconds have passed - send two commands
- ((zenirc-time< '(0 3) interval)
- (zenirc-exec-command-queue proc now 2))
- ;; two or three seconds have passed - send one command
- ((zenirc-time< '(0 1) interval)
- (zenirc-exec-command-queue proc now 1))))))
-
-;;
-;; remove commands from the queue, and send them to the server
-;; execute NUM items from zenirc-command-queue that involve sending a message
-;; to the server - any number of lisp forms in zenirc-command-queue may be
-;; executed (lisp forms also don't reset the last exec time).
-;;
-;;;###autoload
-(defun zenirc-exec-command-queue (proc now num)
- (let ((len) (qentry)
- (sent-to-server 0))
- (while (and zenirc-command-queue (<= sent-to-server num))
- (if (listp
- (setq entry (nth (1- (setq len (length zenirc-command-queue)))
- zenirc-command-queue)))
- (eval entry)
- (process-send-string proc entry)
- (setq sent-to-server (1+ sent-to-server)
- zenirc-last-command-queue-exec now))
- ;; remove from queue
- (if (eq len 1)
- (setq zenirc-command-queue nil)
- (setcdr (nthcdr (- len 2) zenirc-command-queue) nil)))))
-
-(provide 'zenirc-command-queue)
-
-;;; End of zenirc-command-queue.el
+++ /dev/null
-;;; zenirc-complete.el --- complete commands, nicknames, etc. in ZenIRC
-
-;; Copyright (C) 1994, 1995 Noah S. Friedman
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, completion, extensions, oink
-;; Created: 1994-06-26
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This code was inspired by the zenirc completion code written
-;; by Per Persson <pp@@solace.mh.se>, but is a new implementation.
-
-;; I tied into a lot of hooks to make caching of nicks, channels, servers,
-;; etc. fairly insidious. I think I've covered most of the useful ones;
-;; some server messages, like KICK, don't really need their own completion
-;; cache hooks because you can only see them on channels you've joined,
-;; and the JOIN and 353 hooks already cache all the nicknames.
-
-;; Putting the cache function on zenirc-format-nickuserhost-hook isn't
-;; very reliable. Depending on load order, other functions which add to
-;; the hook might get called first and set zenirc-run-next-hook to nil.
-;; That hook is intended just used to return a formatted nickname.
-
-;; TODO: Add new hooks to add/delete nicks to/from cache.
-
-;;; Code:
-
-\f
-(require 'zenirc)
-
-(defvar zenirc-complete-add-final-space-p t
- "*If non-nil, add a trailing space after unique completions.
-This is consistent with the behavior of completion in general, as a
-way of making it clear that the word is fully completed. However, if you
-frequently add punctuation to completed words and the additional whitespace
-is annoying, set this to nil.")
-
-(defvar zenirc-complete-display-function
- 'zenirc-complete-display-echo-area-or-popup
- "*Function to call to display matches for partial completions.
-This function receives a list of completions as returned by
-`all-completions'.")
-
-(defvar zenirc-complete-word-boundary-regexp "[ \t\n\r]"
- "*Regexp matching word boundaries in the ZenIRC buffer.
-The regular expression should probably be a single character class list of
-characters which are not considered part of a word, and thus server as a
-boundary. Whitespace is a good terminator; `#', `&', `/', etc. are not
-good choices because that would prevent the possibility of completing
-channel or command names.")
-
-(defvar zenirc-command-complete-cache-hook '(zenirc-complete-command-cache)
- "*Hook to call when a /complete-cache command is issued in ZenIRC.
-This adds a word to the list of known completions in ZenIRC.
-The syntax of the command is: /complete-cache word")
-
-(defvar zenirc-command-complete-uncache-hook '(zenirc-complete-command-uncache)
- "*Hook to call when a /complete-uncache command is issued in ZenIRC.
-This removes a word from the list of known completions in ZenIRC.
-The syntax of the command is: /complete-uncache word")
-
-;; 307 buckets should be a reasonable size for most people (remember to use
-;; a prime number to get good hashing characteristics).
-;; This is not the total number of completions you can cache, but just the
-;; number of "buckets" in which symbols can be stored. If you regularly do
-;; `/who *' and `/list *' to get all the channels and nicks on IRC,
-;; increasing the size of this table might be helpful but is not necessary.
-;; (As of March 1995, there are typically 5000 users, 2000 channels on IRC.)
-(defvar zenirc-complete-table (make-vector 307 0)
- "Accumulated completion table for ZenIRC.
-This table can include nicknames, channel names, server names, etc.
-
-Completion is case-insensitive since there cannot be two nicknames, channel
-names, etc. which differ only by case in zenirc. However, when completing
-a name uniquely, the case of the cached word is preserved.")
-(make-variable-buffer-local 'zenirc-complete-table)
-
-;; Initialize table with server commands; these are defined by IRC servers
-;; but may not necessarily have any hooks in ZenIRC. We could get these
-;; from the IRC server but it's too slow.
-(let ((l '("/admin" "/away" "/close" "/connect" "/die" "/dns" "/error"
- "/hash" "/help" "/info" "/invite" "/ison" "/join" "/kick"
- "/kill" "/links" "/list" "/lusers" "/mode" "/motd" "/names"
- "/nick" "/note" "/notice" "/oper" "/part" "/pass" "/ping"
- "/pong" "/privmsg" "/quit" "/rehash" "/restart" "/server"
- "/squit" "/stats" "/summon" "/time" "/topic" "/trace" "/user"
- "/userhost" "/users" "/version" "/wallops" "/who" "/whois"
- "/whowas")))
- (while l
- (set (intern (car l) zenirc-complete-table) (car l))
- (setq l (cdr l))))
-
-\f
-;; The following macros are caching interfaces; they do
-;; canonicalization, checking for previous caching, etc.
-
-;; Note that you can't call macros directly with apply, so you can't put
-;; these macros directly on hooks (zenirc-run-hook calls apply on the
-;; symbols in the hook). If this package were only intended to work under
-;; Emacs 19, defsubst could have been used instead.
-
-(defmacro zenirc-complete-cache (s)
- (list 'set (list 'intern
- (list 'zenirc-downcase-name s)
- 'zenirc-complete-table) s))
-
-;; You cannot actually unintern symbols from an obarray, but you can
-;; make them unbound.
-(defmacro zenirc-complete-uncache (s)
- (list 'makunbound (list 'intern
- (list 'zenirc-downcase-name s)
- 'zenirc-complete-table)))
-
-(defmacro zenirc-complete-cache-nick (s)
- (list 'zenirc-complete-cache (list 'or (list 'zenirc-extract-nick s) s)))
-
-(defmacro zenirc-complete-uncache-nick (s)
- (list 'zenirc-complete-uncache (list 'or (list 'zenirc-extract-nick s) s)))
-
-\f
-;;; Interactive interface: /complete-cache and /complete-uncache
-
-(defun zenirc-complete-command-cache (proc words)
- (cond
- ((or (null words)
- (string= "" (cdr words)))
- (zenirc-message proc 'complete-cache-no-wordlist))
- (t
- (let ((wordlist (zenirc-parse-words (cdr words))))
- (while wordlist
- (zenirc-complete-cache (car wordlist))
- (setq wordlist (cdr wordlist)))
- (zenirc-message proc 'complete-cache-added (cdr words))))))
-
-(defun zenirc-complete-command-uncache (proc words)
- (cond
- ((or (null words)
- (string= "" (cdr words)))
- (zenirc-message proc 'complete-cache-no-wordlist))
- (t
- (let ((wordlist (zenirc-parse-words (cdr words))))
- (while wordlist
- (zenirc-complete-uncache (car wordlist))
- (setq wordlist (cdr wordlist)))
- (zenirc-message proc 'complete-cache-removed (cdr words))))))
-
-\f
-(defun zenirc-complete ()
- "Complete the current word at point for ZenIRC.
-This completion cache comes from `zenirc-complete-table'.
-
-Channel names, nicknames, server names, etc. are cached as ZenIRC happens
-upon them; initially there are none to choose from."
- (interactive)
- (let* ((completion-ignore-case t)
- (bow (save-excursion
- (if (re-search-backward zenirc-complete-word-boundary-regexp
- zenirc-process-mark t)
- (1+ (match-beginning 0))
- zenirc-process-mark)))
- (eow (save-excursion
- (if (re-search-forward zenirc-complete-word-boundary-regexp
- (point-max) t)
- (match-beginning 0)
- (point-max))))
- (orig-word (buffer-substring bow eow))
- (word (zenirc-downcase-name orig-word))
- completion-list completion)
- (cond
- ((string= word "")
- (zenirc-message nil 'complete-not-on-word))
- (t
- ;; Don't check for new commands unless actually trying to complete a
- ;; command name.
- (and (eq (string-to-char word) ?/)
- (zenirc-complete-cache-new-zenirc-commands))
- (setq completion-list
- (all-completions word zenirc-complete-table 'boundp))
- (cond
- ((null completion-list)
- (zenirc-message nil 'complete-cant-find word))
- ;; faster than (= (length completion-list) 1)
- ((null (cdr completion-list))
- (delete-region bow eow)
- (goto-char bow)
- ;; unique completion. Insert the original string, rather than the
- ;; key, in case the string has mixed case.
- (insert (symbol-value (intern (car completion-list)
- zenirc-complete-table)))
- (if zenirc-complete-add-final-space-p
- (insert " ")
- (zenirc-message nil 'complete-unique)))
- ((and (stringp (setq completion
- (try-completion word zenirc-complete-table
- 'boundp)))
- (not (string= word completion)))
- ;; This completion is just a partial match.
- ;; Don't delete partial match already typed, just add new chars.
- ;; This is to preserve the case of the letters typed so far since
- ;; no proper change in case has been decided yet.
- (goto-char eow)
- (insert (substring completion (length word))))
- ;; If we get this far, the partial completion so far is ambiguous.
- ;; If completion-auto-help (a standard user option) is non-nil, show
- ;; a table of possible completions.
- (completion-auto-help
- (funcall zenirc-complete-display-function
- (all-completions word zenirc-complete-table 'boundp)))
- (t
- (zenirc-message nil 'complete-not-unique)))))))
-
-;; Find all commands defined in ZenIRC itself, and attempt to add them to
-;; the cache. Each command FOO has a zenirc-command-FOO-hook, so look for
-;; those symbols and extract FOO. Don't actually consider them commands
-;; unless the hook is bound; zenirc itself has to intern symbols whenever
-;; it gets a command /foo, even if /foo isn't a command, and those interned
-;; symbols are nonsense.
-;; The return value of this function isn't meaningful.
-(defun zenirc-complete-cache-new-zenirc-commands ()
- ;; all-completions is vastly faster than mapatoms + a lisp function.
- (let ((completions (all-completions "zenirc-command-" obarray 'boundp))
- name)
- (save-match-data
- (while completions
- (cond
- ((string-match "^zenirc-command-\\(.*\\)-hook$" (car completions))
- (setq name (concat "/" (substring (car completions)
- (match-beginning 1)
- (match-end 1))))
- (zenirc-complete-cache name)))
- (setq completions (cdr completions))))))
-
-;; TODO: add other languages besides english
-(defun zenirc-complete-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((complete-cache-no-wordlist . "[error] No completion cache.")
- (complete-cache-added . "[info] Added to completion cache: %s")
- (complete-cache-removed . "[info] Removed from completion cache: %s")
- (complete-cache-unknown . "[error] Not in cache: %s")
- (complete-cache-known . "[info] Already in cache: %s")
- (complete-not-on-word . "No word at point")
- (complete-cant-find . "Can't find completion for \"%s\"")
- (complete-not-unique . "Next char not unique")
- (complete-unique . "Unique completion"))))
-
-\f
-;;; Various methods to display completions
-
-(defun zenirc-complete-display-traditional (completions)
- (with-output-to-temp-buffer " *Completions*"
- ;; Since we're not using the minibuffer for completions, don't do
- ;; the fancy completion setup emacs 19 uses to make mouse clicks
- ;; return a completion; it just doesn't work here. Bind
- ;; completion-setup-hook to nil.
- (let (completion-setup-hook)
- (display-completion-list completions))))
-
-;; This is similar to zenirc-complete-display-in-traditional except that
-;; the new window is created by taking screen space from the zenirc window,
-;; rather than stealing some other buffer's window. Plus, the window is
-;; made no larger than necessary to display all completions, with half the
-;; zenirc window height being the maximum allowed.
-(defun zenirc-complete-display-in-popup (completions)
- (let* ((orig-buffer (current-buffer))
- (orig-win (selected-window))
- (buf (get-buffer-create " *Completions*"))
- (win (get-buffer-window buf))
- (lines 0))
- (unwind-protect
- (progn
- (set-buffer buf)
- (erase-buffer)
- (let ((standard-output buf)
- (completion-setup-hook nil))
- (display-completion-list completions))
-
- ;; count number of lines
- (goto-char (point-min))
- (save-match-data
- (while (search-forward "\n" nil t)
- (setq lines (1+ lines))))
-
- (cond ((null win)
- (split-window orig-win
- (max (/ (window-height) 2)
- (- (window-height) lines)))
- (select-window (next-window))
- (switch-to-buffer buf)
- (goto-char (point-min)))))
- (select-window orig-win)
- (set-buffer orig-buffer))))
-
-;; Always display completions in the minibuffer. Note that excessively
-;; long lines will get truncated.
-(defun zenirc-complete-display-in-echo-area (completions)
- (message "%s" (mapconcat 'identity completions " ")))
-
-;; Display completions in the minibuffer if it will fit.
-;; Otherwise, use traditional completion display.
-(defun zenirc-complete-display-echo-area-or-traditional (completions)
- (let ((s (mapconcat 'identity completions " ")))
- (if (> (length s) (window-width (minibuffer-window)))
- (zenirc-complete-display-traditional completions)
- (message "%s" s))))
-
-;; Display completions in the minibuffer if it will fit.
-;; Otherwise, use popup completion display.
-(defun zenirc-complete-display-echo-area-or-popup (completions)
- (let ((s (mapconcat 'identity completions " ")))
- (if (> (length s) (window-width (minibuffer-window)))
- (zenirc-complete-display-in-popup completions)
- (message "%s" s))))
-
-\f
-;;; Cache nick and channel from invitations
-
-(defun zenirc-complete-cache-INVITE (proc parsedmsg)
- (zenirc-complete-cache-nick (aref parsedmsg 1))
- (zenirc-complete-cache (aref parsedmsg 3)))
-
-(zenirc-add-hook 'zenirc-server-INVITE-hook 'zenirc-complete-cache-INVITE)
-
-\f
-;; Cache nick and channel from JOIN replies.
-
-(defun zenirc-complete-cache-JOIN (proc parsedmsg)
- (zenirc-complete-cache-nick (aref parsedmsg 1))
- (if (string-match "\a" (aref parsedmsg 2))
- (zenirc-complete-cache (substring (aref parsedmsg 2) 0
- (- (match-end 0) 1)))
- (zenirc-complete-cache (aref parsedmsg 2))))
-
-(zenirc-add-hook 'zenirc-server-JOIN-hook 'zenirc-complete-cache-JOIN)
-
-\f
-;; Cache new nick from NICK change.
-
-(defun zenirc-complete-cache-NICK (proc parsedmsg)
- (zenirc-complete-cache-nick (aref parsedmsg 2)))
-
-(zenirc-add-hook 'zenirc-server-NICK-hook 'zenirc-complete-cache-NICK)
-
-\f
-;; Cache nick and channel from PRIVMSGs and NOTICEs
-
-(defun zenirc-complete-cache-msg (proc parsedmsg)
- (zenirc-complete-cache-nick (aref parsedmsg 1))
- (zenirc-complete-cache (aref parsedmsg 2)))
-
-(zenirc-add-hook 'zenirc-server-PRIVMSG-hook 'zenirc-complete-cache-msg)
-(zenirc-add-hook 'zenirc-server-NOTICE-hook 'zenirc-complete-cache-msg)
-
-\f
-;; [312] Cache nick and server names from /whois replies
-
-(defun zenirc-complete-cache-312 (proc parsedmsg)
- (zenirc-complete-cache-nick (aref parsedmsg 3))
- (zenirc-complete-cache (aref parsedmsg 4)))
-
-(zenirc-add-hook 'zenirc-server-312-hook 'zenirc-complete-cache-312)
-
-\f
-;; [319] Cache channel list from /whois replies
-
-(defun zenirc-complete-cache-319 (proc parsedmsg)
- (save-match-data
- (let ((str (aref parsedmsg 4))
- chan)
- (while (string-match "\\(#\\|&\\)\\([^ \t#&]*\\)" str)
- (setq chan (substring str (match-beginning 1) (match-end 2)))
- (zenirc-complete-cache chan)
- (setq str (substring str (match-end 2)))))))
-
-(zenirc-add-hook 'zenirc-server-319-hook 'zenirc-complete-cache-319)
-
-\f
-;; [322] Cache channel names from /list replies
-
-(defun zenirc-complete-cache-322 (proc parsedmsg)
- ;; Channel `*' means private (we don't know the name); don't cache that.
- (or (string= (aref parsedmsg 3) "*")
- (zenirc-complete-cache (aref parsedmsg 3))))
-
-(zenirc-add-hook 'zenirc-server-322-hook 'zenirc-complete-cache-322)
-
-\f
-;; [352] Cache nick, server, and channel names from /who replies
-
-(defun zenirc-complete-cache-352 (proc parsedmsg)
- (zenirc-complete-cache (aref parsedmsg 3))
- (zenirc-complete-cache (aref parsedmsg 6))
- (zenirc-complete-cache-nick (aref parsedmsg 7)))
-
-(zenirc-add-hook 'zenirc-server-352-hook 'zenirc-complete-cache-352)
-
-\f
-;; [353] Cache nicknames from list after channel join (or NAMES command)
-
-(defun zenirc-complete-cache-353 (proc parsedmsg)
- (save-match-data
- (let ((str (aref parsedmsg 5))
- name)
- (while (string-match "\\([^ \t@]+\\)" str)
- (setq name (substring str (match-beginning 1) (match-end 1)))
- ;; I think it's safe not to use zenirc-complete-cache-nick here
- ;; because the supplied nicks here don't include !user@host.
- (zenirc-complete-cache name)
- (setq str (substring str (match-end 1)))))))
-
-(zenirc-add-hook 'zenirc-server-353-hook 'zenirc-complete-cache-353)
-
-\f
-;; [401] Remove invalid nick or channel from cache
-;; [402] Remove invalid server from cache
-;; [403] (No such channel) remove channel from cache
-
-(defun zenirc-complete-uncache-40x (proc parsedmsg)
- (zenirc-complete-uncache-nick (aref parsedmsg 3)))
-
-;; I chose not enable these hooks for now, although I defined the function,
-;; because nicks often go away due to netsplits, and uncaching them is
-;; simply annoying. Perhaps people will give feedback to the contrary.
-;(zenirc-add-hook 'zenirc-server-401-hook 'zenirc-complete-uncache-40x)
-;(zenirc-add-hook 'zenirc-server-403-hook 'zenirc-complete-uncache-40x)
-;(zenirc-add-hook 'zenirc-server-402-hook 'zenirc-complete-uncache-40x)
-
-\f
-(provide 'zenirc-complete)
-
-(define-key zenirc-mode-map "\t" 'zenirc-complete)
-(zenirc-complete-install-message-catalogs)
-
-;; zenirc-complete.el ends here
+++ /dev/null
-;;;
-;;;
-;;; zenirc-ctcp-flood.el --- aggresively boze at people with CTCP
-
-;;; Copyright (C) 1993, 1994 Ben A. Mesander
-
-;;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;;; Maintainer: ben@gnu.ai.mit.edu
-;;; Keywords: extensions
-;;; Created: 1993/06/03
-
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'zenirc)
-
-(defun zenirc-ctcp-flood (target number)
- (interactive "sTarget: \nnNumber of times: ")
- (let ((i 0) (proc (get-buffer-process (current-buffer))))
- (while (< i number)
- (setq i (1+ i))
- (process-send-string
- proc (concat "PRIVMSG " target ","target ","target ","target ","target ","target ","target ","target ","target ","target " :\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\C-aA\C-a\n")))))
-
-(provide 'zenirc-ctcp-flood)
\ No newline at end of file
+++ /dev/null
-;;; zenirc-dcc.el --- CTCP DCC module for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1995 Noah S. Friedman
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, extensions
-;; Created: 1994-01-23
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; DCC `send' isn't yet implemented because emacs does not provide server
-;; sockets. One way to get around this would be to write a small C or perl
-;; program to do the listening and interface it with emacs.
-
-;; This file is divided into 4 sections:
-;; * Variables related to all DCC operations
-;; * Misc utility macros and functions
-;; * Interactive command handling
-;; * Server message handling (i.e. messages from remote users)
-;; * GET handling
-;; * CHAT handling
-
-;;; Code:
-
-(require 'zenirc)
-
-;; zenirc-dcc-alist looks like:
-;; (("nick!user@host" GET proc-or-nil ip-address port size filename)
-;; ("nick!user@host" CHAT proc-or-nil ip-address port))
-(defvar zenirc-dcc-alist nil)
-
-(defvar zenirc-verbose-dcc t)
-
-;; This function takes all the usual args as open-network-stream, plus one
-;; more: the entry data from zenirc-dcc-alist for this particular process.
-;; Emacs 18 cannot open-network-stream on IP numbers, so instead the
-;; hostname from the nick must be used; of course, these may not equivalent,
-;; but there's nothing that can be done about that. Use emacs 19.
-(defvar zenirc-dcc-connect-function 'zenirc-dcc-open-network-stream)
-
-\f
-;;; Section 2: Misc macros and utility functions
-
-(defmacro zenirc-dcc-catalog-entry (sym)
- `(zenirc-lang-retrieve-catalog-entry ,sym))
-
-(defun zenirc-dcc-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((dcc-chat-discarded . "[dcc] note: previous chat request from %s discarded.\n")
- (dcc-chat-ended . "[dcc] chat with %s ended %s: %s\n")
- (dcc-chat-no-request . "[dcc] chat request from %s not found.\n")
- (dcc-chat-offered . "[dcc] chat offered by %s\n")
- (dcc-chat-privmsg . "=%s= %s\n")
- (dcc-closed . "[dcc] Closed %s from %s%s\n")
- (dcc-command-undefined . "[dcc] no such subcommand: %s\n")
- (dcc-ctcp-errmsg . "`%s' is not a DCC subcommand known to this client.")
- (dcc-ctcp-unknown . "[info] unknown dcc subcommand `%s' from %s\n")
- (dcc-get-bytes-received . "[dcc] %s: %d bytes received.")
- (dcc-get-complete . "[dcc] file %s transfer complete (%d bytes).\n")
- (dcc-get-file-exists . "[dcc] File %s exists. Overwrite? ")
- (dcc-get-file-too-long . "[dcc] %s: File longer than sender claimed; aborting transfer.")
- (dcc-get-filename . "[dcc] Local filename (default %s): ")
- (dcc-get-notfound . "[error] %s hasn't offered %s for DCC transfer.\n")
- (dcc-list-end . "[dcc] End of list.\n")
- (dcc-list-head . "[dcc] From Type Active Size Filename\n")
- (dcc-list-item . "[dcc] %-9s %4s %-6s %4s %s\n")
- (dcc-list-line . "[dcc] ---- ---- ------ ---- --------\n")
- (dcc-malformed . "[dcc] error: %s sent malformed `%s' request: %s\n")
- (dcc-privileged-port . "[dcc] possibly bogus request: %s is a privileged port.\n")
- (dcc-request-bogus . "[dcc] bogus dcc `%s' from user %s\n")
- (dcc-send-offered . "[dcc] file %s offered by user %s (size %s)\n")
- )))
-
-;; Return the elt of alist which contains nick and type, e.g.
-;; (zenirc-dcc-member "noah!friedman@prep.ai.mit.edu" 'CHAT zenirc-dcc-alist)
-;; => ("noah!friedman@prep.ai.mit.edu" CHAT <proc> <ipaddr> <port>)
-(defun zenirc-dcc-member (nick type &optional alist)
- (or alist (setq alist zenirc-dcc-alist))
- (let ((nicklen (length nick))
- (nickuserhostp (save-match-data
- (string-match "!" nick)))
- (elt nil)
- (result nil))
- (while alist
- (setq elt (car alist))
- (setq alist (cdr alist))
- (cond ((and nickuserhostp
- (eq (car (cdr elt)) type)
- (zenirc-names-equal-p (car elt) nick))
- (setq result elt)
- (setq alist nil))
- ((and (zenirc-names-equal-p (zenirc-extract-nick (car elt)) nick)
- (eq (car (cdr elt)) type))
- (setq result elt)
- (setq alist nil))))
- result))
-
-;; msa wrote this nifty little frob to convert an n-byte integer to a packed
-;; string.
-(defun zenirc-packed-int (value count)
- (if (> count 0)
- (concat (zenirc-packed-int (/ value 256) (1- count))
- (char-to-string (% value 256)))
- ""))
-
-(defun zenirc-dcc-open-network-stream (procname buffer addr port entry)
- (and (string-lessp emacs-version "19")
- (setq addr (zenirc-extract-host (car entry))))
- (open-network-stream procname buffer addr port))
-
-\f
-;;; Section 3: Interactive command handling
-
-(defvar zenirc-command-dcc-hook '(zenirc-command-dcc))
-
-(defvar zenirc-dcc-get-default-directory nil
- "*Default directory for incoming DCC file transfers.
-If this is nil, then the current value of `default-directory' is used.")
-
-;; parser for /dcc command. This figures out the dcc subcommand and calls
-;; the appropriate routine to handle it.
-;; The function dispatched should be named "zenirc-dcc-do-FOO-command",
-;; where FOO is one of `close', `get', `list', etc.
-(defun zenirc-command-dcc (proc parsedcmd)
- (let* ((cmd (zenirc-parse-firstword (cdr parsedcmd)))
- (fn (intern-soft (concat "zenirc-dcc-do-" (car cmd) "-command"))))
- (if (and fn (fboundp fn))
- (funcall fn proc cmd)
- (zenirc-message proc 'dcc-command-undefined (car cmd)))))
-
-(defun zenirc-dcc-do-chat-command (proc subcommand)
- (let* ((nick (car (zenirc-parse-firstword (cdr subcommand))))
- (elt (zenirc-dcc-member nick 'CHAT)))
- (if elt
- (zenirc-dcc-chat elt proc)
- (zenirc-message proc 'dcc-chat-no-request nick))))
-
-;; /dcc close type nick
-;; both type and nick are optional, but type must be specified if nick is.
-(defun zenirc-dcc-do-close-command (proc subcommand)
- (let* ((tmp (zenirc-parse-n-words 2 (cdr subcommand)))
- (type (if (string= "" (car tmp))
- nil
- (intern (upcase (car tmp)))))
- (nick (car (cdr tmp)))
- (alist zenirc-dcc-alist)
- (elt nil))
- (while alist
- (setq elt (car alist))
- (setq alist (cdr alist))
-
- (cond
- ;; Skip this elt if a type was specified and this one doesn't match.
- ((and type
- (not (eq (car (cdr elt)) type))))
- ((or (string= nick "")
- (zenirc-names-equal-p nick (zenirc-extract-nick (car elt))))
-
- ;; Delete process if it exists.
- (setq tmp (nth 2 elt))
- (and (processp tmp)
- (delete-process tmp))
-
- (setq zenirc-dcc-alist (delq elt zenirc-dcc-alist))
- (zenirc-message proc 'dcc-closed
- (car (cdr elt))
- (zenirc-extract-nick (car elt))
- (if (eq (car (cdr elt)) 'SEND)
- (concat ", file " (nth 6 elt))
- "")))))))
-
-(defun zenirc-dcc-do-get-command (proc parsedcmd)
- (let* ((tmp (zenirc-parse-n-words 2 (cdr parsedcmd)))
- (nick (car tmp))
- (filename (car (cdr tmp)))
- (elt (zenirc-dcc-member nick 'GET)))
- (if elt
- (let* ((msg (zenirc-dcc-catalog-entry 'dcc-get-filename))
- (file (read-file-name (format msg (file-name-nondirectory
- filename))
- (or zenirc-dcc-get-default-directory
- default-directory)
- (file-name-nondirectory filename))))
-
- (cond ((file-exists-p file)
- (if (yes-or-no-p (format (zenirc-dcc-catalog-entry
- 'dcc-get-file-exists)
- file))
- (zenirc-dcc-get-file elt file proc)
- (zenirc-message proc 'dcc-get-cmd-aborted
- nick filename)))
- (t
- (zenirc-dcc-get-file elt file proc))))
- (zenirc-message proc 'dcc-get-notfound nick filename))))
-
-;; this is the handler for the /dcc list command - it lists the current state
-;; of zenirc-dcc-alist in an easy to read manner.
-(defun zenirc-dcc-do-list-command (proc parsedcmd)
- (let ((alist zenirc-dcc-alist)
- size elt)
- (zenirc-message proc 'dcc-list-head)
- (zenirc-message proc 'dcc-list-line)
- (while alist
- (setq elt (car alist))
- (setq alist (cdr alist))
-
- (setq size (nth 5 elt))
- (cond ((null size)
- (setq size ""))
- ((string= size "")
- (setq size "unknown")))
-
- (zenirc-message proc 'dcc-list-item
- (zenirc-extract-nick (car elt))
- (nth 1 elt)
- (if (processp (nth 2 elt))
- (process-status (nth 2 elt))
- "no")
- size
- (or (nth 6 elt) "")))
- (zenirc-message proc 'dcc-list-end)))
-
-\f
-;;; Section 4: Server message handling (i.e. messages from remote users)
-
-;; Hook variable for CTCP DCC queries
-(defvar zenirc-ctcp-query-DCC-hook '(zenirc-ctcp-query-DCC))
-
-(defvar zenirc-dcc-query-handler-alist
- '(("SEND" . zenirc-dcc-handle-ctcp-send)
- ("CHAT" . zenirc-dcc-handle-ctcp-chat)))
-
-;; zenirc-ctcp-query-DCC is the function called when a CTCP DCC
-;; request is detected by the client. It examines the DCC subcommand,
-;; and either calls the appropriate routine for that subcommand, or
-;; sends a ctcp errmsg to the sender.
-(defun zenirc-ctcp-query-DCC (proc parsedctcp from to)
- (let* ((cmd (car (zenirc-parse-firstword (cdr parsedctcp))))
- (handler (cdr (assoc cmd zenirc-dcc-query-handler-alist))))
- (if handler
- (funcall handler proc parsedctcp from to)
- (let ((fmt (zenirc-dcc-catalog-entry 'dcc-ctcp-errmsg)))
- (zenirc-ctcp-errmsg nil from to (concat "DCC " cmd)
- (format fmt cmd) proc)
- (and zenirc-verbose-ctcp
- (zenirc-message proc 'dcc-ctcp-unknown cmd
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)))))))
-
-;; This is called a CTCP DCC SEND subcommand is sent to the client.
-;; It extracts the information about the dcc request and adds it to
-;; zenirc-dcc-alist.
-(defun zenirc-dcc-handle-ctcp-send (proc parsedctcp from to)
- (let ((str (cdr parsedctcp))
- (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
- ;; filename ipaddr port size(optional)
- (regexp "^SEND \\([^ ]+\\) \\([0-9]+\\) \\([0-9]+\\) *\\([0-9]*\\)")
- localfile filename ip port size)
- (if (not (zenirc-names-equal-p to zenirc-nick t))
- ;; DCC SEND requests must be sent to you, and you alone.
- (zenirc-message proc 'dcc-request-bogus 'SEND sender)
- (cond
- ((string-match regexp str)
- (setq filename (zenirc-match-string 1 str))
- (setq ip (zenirc-match-string 2 str))
- (setq port (zenirc-match-string 3 str))
- (setq size (zenirc-match-string 4 str))
-
- ;; a warning really should also be sent
- ;; if the ip address != the host the dcc sender is on.
- (zenirc-message proc 'dcc-send-offered filename sender
- (if (string= size "") "unknown" size))
-
- (and (< (string-to-int port) 1025)
- (zenirc-message proc 'dcc-privileged-port port))
-
- (setq zenirc-dcc-alist
- (cons (list from 'GET nil ip port size filename)
- zenirc-dcc-alist)))
- (t
- (zenirc-message proc 'dcc-malformed sender 'SEND str))))))
-
-(defun zenirc-dcc-handle-ctcp-chat (proc parsedctcp from to)
- (let* ((str (cdr parsedctcp))
- (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
- ;; ipaddr port
- (regexp "^CHAT +chat +\\([0-9.]+\\) +\\([0-9]+\\)")
- (elt (zenirc-dcc-member from 'CHAT))
- ip port)
- ;; DCC CHAT requests must be sent to you, and you alone.
- (if (not (zenirc-names-equal-p to zenirc-nick t))
- (zenirc-message proc 'dcc-request-bogus 'CHAT sender)
- (cond ((string-match regexp str)
- (setq ip (zenirc-match-string 1 str))
- (setq port (zenirc-match-string 2 str))
-
- ;; A warning really should also be sent if the ip
- ;; address != the host the dcc sender is on.
- (zenirc-message proc 'dcc-chat-offered sender)
- (and (< (string-to-int port) 1025)
- (zenirc-message proc 'dcc-privileged-port port))
-
- (cond (elt
- (setcar (nthcdr 3 elt) ip)
- (setcar (nthcdr 4 elt) port)
- (zenirc-message proc 'dcc-chat-discarded sender))
- (t
- (setq zenirc-dcc-alist (cons (list from 'CHAT nil ip port)
- zenirc-dcc-alist)))))
- (t
- (zenirc-message proc 'dcc-malformed sender 'CHAT str))))))
-
-\f
-;;; Section 5: GET handling
-
-;; zenirc-dcc-get-file does the work of setting up a transfer from the remote
-;; client to the local one over a tcp connection. This involves setting
-;; up a process filter and a process sentinel, and making the connection.
-(defun zenirc-dcc-get-file (entry file parent-proc)
- (let* ((obuf (current-buffer))
- (buffer (generate-new-buffer (file-name-nondirectory file)))
- proc)
- (unwind-protect
- (progn
- (set-buffer buffer)
- (fundamental-mode)
- (setq mode-line-process '(":%s"))
- (setq buffer-read-only t)
- (set-visited-file-name file)
- (make-local-variable 'zenirc-dcc-parent-process)
- (setq zenirc-dcc-parent-process parent-proc)
- (make-local-variable 'zenirc-dcc-entry-data)
- (setq zenirc-dcc-entry-data entry)
- (make-local-variable 'zenirc-dcc-size)
- (setq zenirc-dcc-size (nth 5 entry))
- (make-local-variable 'zenirc-dcc-byte-count)
- (setq zenirc-dcc-byte-count 0)
- (setq proc
- (funcall zenirc-dcc-connect-function
- "zenirc-dcc-get" buffer
- (nth 3 entry) (string-to-int (nth 4 entry)) entry))
- (set-process-buffer proc buffer)
- (set-process-filter proc 'zenirc-dcc-get-filter)
- (set-process-sentinel proc 'zenirc-dcc-get-sentinel)
- (setcar (nthcdr 2 entry) proc))
- (set-buffer obuf))))
-
-;; This is the process filter for transfers from other clients to this one.
-;; It reads incoming bytes from the network and stores them in the DCC
-;; buffer, and sends back the replies after each block of data per the DCC
-;; protocol spec. Well not really. We write back a reply after each read,
-;; rather than every 1024 byte block, but nobody seems to care.
-(defun zenirc-dcc-get-filter (proc str)
- (let ((obuf (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (setq buffer-read-only nil)
- (goto-char (point-max))
- (insert str)
-
- (setq zenirc-dcc-byte-count (+ (length str) zenirc-dcc-byte-count))
- (and zenirc-verbose-dcc
- (zenirc-message nil 'dcc-get-bytes-received
- (file-name-nondirectory buffer-file-name)
- zenirc-dcc-byte-count))
- (cond
- ((and (numberp zenirc-dcc-size)
- (> zenirc-dcc-byte-count zenirc-dcc-size))
- (zenirc-message nil 'dcc-get-file-too-long
- (file-name-nondirectory buffer-file-name))
- (delete-process proc))
- (t
- (process-send-string
- proc (zenirc-packed-int zenirc-dcc-byte-count 4)))))
- (setq buffer-read-only t)
- (set-buffer obuf))))
-
-
-;; This is the process sentinel for CTCP DCC SEND connections.
-;; It shuts down the connection and notifies the user that the
-;; transfer is complete.
-(defun zenirc-dcc-get-sentinel (proc event)
- (let ((obuf (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (delete-process proc)
- (setq buffer-read-only nil)
- (setq zenirc-dcc-alist (delq zenirc-dcc-entry-data zenirc-dcc-alist))
- (zenirc-message zenirc-dcc-parent-process 'dcc-get-complete
- (file-name-nondirectory buffer-file-name)
- (buffer-size))
- (save-buffer))
- (set-buffer obuf))))
-
-\f
-;;; Section 6: CHAT handling
-
-(defvar zenirc-dcc-chat-buffer-name-format "ZenIRC-DCC-%s")
-
-(defvar zenirc-dcc-chat-mode-hook nil)
-(defvar zenirc-dcc-chat-connect-hook nil)
-(defvar zenirc-dcc-chat-exit-hook nil)
-
-(defvar zenirc-dcc-chat-filter-hook '(zenirc-dcc-chat-parse-output)
- "*Hook to run after doing parsing (and possible insertion) of DCC messages.")
-
-(defvar zenirc-dcc-chat-mode-map '()
- "Sparse keymap for zenirc-dcc-mode")
-(cond ((not zenirc-dcc-chat-mode-map)
- (setq zenirc-dcc-chat-mode-map (make-sparse-keymap))
- (define-key zenirc-dcc-chat-mode-map "\n" 'zenirc-dcc-chat-send-line)
- (define-key zenirc-dcc-chat-mode-map "\r" 'zenirc-dcc-chat-send-line)))
-
-(defun zenirc-dcc-chat-mode ()
- "Major mode for wasting time via DCC chat."
- (interactive)
- (kill-all-local-variables)
- (setq mode-line-process '(":%s"))
- (setq mode-name "ZenIRC-DCC-Chat")
- (setq major-mode 'zenirc-dcc-chat-mode)
- (use-local-map zenirc-dcc-chat-mode-map)
- (zenirc-run-hook 'zenirc-dcc-chat-mode-hook))
-
-(defun zenirc-dcc-chat-send-line ()
- "Send current line to other client."
- (interactive)
- (end-of-line)
- (insert "\n")
- (let ((proc (get-buffer-process (current-buffer)))
- (string (buffer-substring zenirc-process-mark (point))))
- (set-marker zenirc-process-mark (point))
- (process-send-string proc string)))
-
-(defun zenirc-dcc-chat (entry parent-proc)
- (let* ((nick (zenirc-extract-nick (car entry)))
- (buffer (generate-new-buffer
- (format zenirc-dcc-chat-buffer-name-format
- (zenirc-extract-nick (car entry)))))
- proc)
- (pop-to-buffer buffer)
- (zenirc-dcc-chat-mode)
- (make-local-variable 'zenirc-dcc-parent-process)
- (setq zenirc-dcc-parent-process parent-proc)
- (make-local-variable 'zenirc-dcc-from)
- (setq zenirc-dcc-from nick)
- (make-local-variable 'zenirc-dcc-entry-data)
- (setq zenirc-dcc-entry-data entry)
- (make-local-variable 'zenirc-dcc-unprocessed-output)
- (setq zenirc-dcc-unprocessed-output "")
- (make-local-variable 'zenirc-process-mark)
- (setq zenirc-process-mark (set-marker (make-marker) (point-max)))
- (setq proc
- (funcall zenirc-dcc-connect-function
- "zenirc-dcc-chat" buffer
- (nth 3 entry) (string-to-int (nth 4 entry)) entry))
- (set-process-buffer proc buffer)
- (set-process-filter proc 'zenirc-dcc-chat-filter)
- (set-process-sentinel proc 'zenirc-dcc-chat-sentinel)
- (setcar (nthcdr 2 entry) proc)
- (zenirc-run-hook 'zenirc-dcc-chat-connect-hook proc)))
-
-(defun zenirc-dcc-chat-filter (proc str)
- (let ((orig-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (setq zenirc-dcc-unprocessed-output
- (concat zenirc-dcc-unprocessed-output str))
- (zenirc-run-hook 'zenirc-dcc-chat-filter-hook proc
- zenirc-dcc-unprocessed-output))
- (set-buffer orig-buffer))))
-
-(defun zenirc-dcc-chat-parse-output (proc str)
- (save-match-data
- (let ((posn 0)
- line)
- (while (string-match "\n" str posn)
- (setq line (substring str posn (match-beginning 0)))
- (setq posn (match-end 0))
- (zenirc-message proc 'dcc-chat-privmsg zenirc-dcc-from line))
- (setq zenirc-dcc-unprocessed-output (substring str posn)))))
-
-(defun zenirc-dcc-chat-sentinel (proc event)
- (let ((buf (current-buffer))
- (tm (current-time-string)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (delete-process proc)
- (setq zenirc-dcc-alist (delq zenirc-dcc-entry-data zenirc-dcc-alist))
- (zenirc-run-hook 'zenirc-dcc-chat-exit-hook proc)
- (zenirc-message zenirc-dcc-parent-process 'dcc-chat-ended
- zenirc-dcc-from tm event)
- (zenirc-message proc 'dcc-chat-ended
- zenirc-dcc-from tm event))
- (set-buffer buf))))
-
-\f
-(provide 'zenirc-dcc)
-
-(zenirc-dcc-install-message-catalogs)
-
-;;; zenirc-dcc.el ends here
+++ /dev/null
-;;; zenirc-doto.el --- do things to who, list, links replies
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1994/07/22
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'zenirc)
-(require 'zenirc-command-queue)
-
-(defun zenirc-doto-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((doto-lame-args . "[info] %s: lame argument(s)."))))
-
-\f
-;; WHO reply handlers
-;; example: send everyone on IRC a DCC chat request from the
-;; telnet port of a pentagon computer.
-;; /dotowho 0 (process-send-string proc (concat "PRIVMSG " (aref whoreply 7)
-;; " :\C-aDCC CHAT chat 2261613455 23\C-a\n"))
-
-;; 315 (end of who) handler
-(defun zenirc-do-to-who-end (proc parsedmsg)
- (zenirc-delete-hook 'zenirc-server-352-hook 'zenirc-do-to-who)
- (zenirc-delete-hook 'zenirc-server-315-hook 'zenirc-do-to-who-end)
- (setq zenirc-run-next-hook nil))
-
-;; 352 (who reply) handler
-;; proc is the zenirc process.
-;; whoreply is the parsed server message array.
-(defun zenirc-do-to-who (proc whoreply)
- (zenirc-do-to-who-function proc whoreply)
- (setq zenirc-run-next-hook nil))
-
-;; command interface
-;; /dotowho #victims (lisp-form)
-;; lisp-form can use "proc", which will be set to the zenirc process
-;; and "whoreply" which will be a parsed servermessage array containing
-;; a 352 reply.
-(defvar zenirc-command-dotowho-hook '(zenirc-command-dotowho))
-
-(defun zenirc-command-dotowho (proc parsedcmd)
- (let* ((arg (zenirc-parse-firstword (cdr parsedcmd)))
- (victim (car arg))
- (command (cdr arg)))
- (if (or (string= "" victim)
- (string= "" command))
- (zenirc-message proc 'doto-lame-args "/dotowho"))
- (zenirc-dotowho victim (read command))))
-
-;; programmatic interface
-(defun zenirc-dotowho (victim command)
- (fset 'zenirc-do-to-who-function (list 'lambda '(proc whoreply) command))
- (zenirc-add-hook 'zenirc-server-315-hook 'zenirc-do-to-who-end)
- (zenirc-add-hook 'zenirc-server-352-hook 'zenirc-do-to-who)
- (process-send-string proc (concat "WHO " victim "\n")))
-
-\f
-;; example of using who
-;; /op channel - op everyone on a channel
-(defvar zenirc-op-list nil)
-
-(defvar zenirc-command-op-hook '(zenirc-command-op))
-
-(defun zenirc-command-op (proc parsedcmd)
- (let ((victim (cdr parsedcmd)))
- (if (string= victim "")
- (zenirc-message proc 'doto-lame-args "/op")
- (setq zenirc-op-list nil)
- (zenirc-dotowho
- victim
- '(if (not (string-match "@" (aref whoreply 8)))
- (setq zenirc-op-list (cons (aref whoreply 7) zenirc-op-list))))
- (zenirc-add-hook 'zenirc-server-315-hook 'zenirc-doto-op-end))))
-
-(defun zenirc-doto-op-end (proc parsedmsg)
- (let* ((channel (aref parsedmsg 3))
- (oplen (length zenirc-op-list))
- (triples (* 3 (/ oplen 3)))
- (remainder (% oplen 3))
- (i 0)
- (nicks nil))
- (while (< i triples)
- (setq nicks (concat (nth i zenirc-op-list) " "
- (nth (1+ i) zenirc-op-list) " "
- (nth (+ 2 i) zenirc-op-list) "\n"))
- (process-send-string proc (concat "mode " channel " +ooo " nicks))
- (setq i (+ 3 i)))
- (cond
- ((eq remainder 2)
- (setq nicks (concat (nth (- oplen 2) zenirc-op-list) " "
- (nth (1- oplen) zenirc-op-list) "\n"))
- (process-send-string proc (concat "mode " channel " +oo " nicks)))
- ((eq remainder 1)
- (process-send-string
- proc (concat "mode " channel " +o "
- (nth (1- oplen) zenirc-op-list) "\n"))))
- (zenirc-delete-hook 'zenirc-server-315-hook 'zenirc-op-end)))
-
-\f
-;; server link stuff
-
-;; 365 (end of links) handler
-(defun zenirc-do-to-links-end (proc parsedmsg)
- (zenirc-delete-hook 'zenirc-server-364-hook 'zenirc-do-to-links)
- (zenirc-delete-hook 'zenirc-server-365-hook 'zenirc-do-to-links-end)
- (setq zenirc-run-next-hook nil))
-
-;; 364 (links reply) handler
-;; proc is the zenirc process.
-;; linksreply is the parsed server message array.
-(defun zenirc-do-to-links (proc linksreply)
- (zenirc-do-to-links-function proc linksreply)
- (setq zenirc-run-next-hook nil))
-
-;; command interface
-;; /dotolinks (lisp-form)
-;; lisp-form can use "proc", which will be set to the zenirc process
-;; and "linksreply" which will be a parsed servermessage array containing
-;; a 364 reply.
-(defvar zenirc-command-dotolinks-hook '(zenirc-command-dotolinks))
-
-(defun zenirc-command-dotolinks (proc parsedcmd)
- (let ((arg (cdr parsedcmd)))
- (if (string= "" arg)
- (zenirc-message proc 'doto-lame-args "/dotolinks")
- (zenirc-dotolinks (read arg)))))
-
-;; programmatic interface
-(defun zenirc-dotolinks (command)
- (fset 'zenirc-do-to-links-function (list 'lambda '(proc linksreply) command))
- (zenirc-add-hook 'zenirc-server-365-hook 'zenirc-do-to-links-end)
- (zenirc-add-hook 'zenirc-server-364-hook 'zenirc-do-to-links)
- (process-send-string proc "LINKS\n"))
-
-(defvar zenirc-command-serverversions-hook '(zenirc-server-versions))
-(defun zenirc-server-versions (proc parsedcmd)
- (zenirc-dotolinks '(zenirc-queue-command (concat "VERSION "
- (aref linksreply 4)
- "\n"))))
-
-\f
-;; Do things to /list reply
-;; 321 RPL_LISTSTART
-;; 322 RPL_LIST
-;; 323 RPL_LISTEND
-;; Example: set the topic of every channel on irc to be AT&T YOU WILL
-;; while talking on #twilight_zone
-;; /dotolist (if (not (string= (aref listreply 3) "*")) (progn
-;; (zenirc-queue-command (concat "JOIN " (aref listreply 3) "\n"))
-;; (zenirc-queue-command '(setq zenirc-current-victim "#twilight_zone"))
-;; (zenirc-queue-command (concat "TOPIC " (aref listreply 3)
-;; " :AT&T YOU WILL!!!!\n")) (zenirc-queue-command (concat "PART "
-;; (aref listreply 3) "\n"))))
-
-;; 323 (end of list) handler
-(defun zenirc-do-to-list-end (proc parsedmsg)
- (zenirc-delete-hook 'zenirc-server-322-hook 'zenirc-do-to-list)
- (zenirc-delete-hook 'zenirc-server-323-hook 'zenirc-do-to-list-end)
- (setq zenirc-run-next-hook nil))
-
-;; 322 (list reply) handler
-;; proc is the zenirc process.
-;; listreply is the parsed server message array.
-(defun zenirc-do-to-list (proc listreply)
- (zenirc-do-to-list-function proc listreply)
- (setq zenirc-run-next-hook nil))
-
-;; 321 (list start) handler
-(defun zenirc-do-to-list-start (proc parsedmsg)
- (zenirc-delete-hook 'zenirc-server-321-hook 'zenirc-do-to-list-start)
- (setq zenirc-run-next-hook nil))
-
-;; command interface
-;; /dotolist (lisp-form)
-;; lisp-form can use "proc", which will be set to the zenirc process
-;; and "listreply" which will be a parsed servermessage array containing
-;; a 322 reply.
-(defvar zenirc-command-dotolist-hook '(zenirc-command-dotolist))
-
-(defun zenirc-command-dotolist (proc parsedcmd)
- (let* ((arg (cdr parsedcmd)))
- (if (string= "" arg)
- (zenirc-message proc 'doto-lame-args "/dotolist"))
- (zenirc-dotolist (read arg))))
-
-;; programmatic interface
-(defun zenirc-dotolist (command)
- (fset 'zenirc-do-to-list-function (list 'lambda '(proc listreply) command))
- (zenirc-add-hook 'zenirc-server-323-hook 'zenirc-do-to-list-end)
- (zenirc-add-hook 'zenirc-server-322-hook 'zenirc-do-to-list)
- (zenirc-add-hook 'zenirc-server-321-hook 'zenirc-do-to-list-start)
- (process-send-string proc "LIST\n"))
-
-(provide 'zenirc-doto)
-
-(zenirc-doto-install-message-catalogs)
-
-;;; End of zenirc-doto.el
+++ /dev/null
-;;; zenirc-eval.el --- join the "mi emacs es tu emacs" club
-
-;; Copyright (C) 1997, 1998 Ray Jones
-
-;; Author: Ray Jones <rjones@pobox.com>
-;; Maintainer: rjones@pobox.com
-;; Keywords: zenirc, extensions, eval, oink
-;; Created: 1998-01-09
-
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; Whip me, beat me, make my emacs calculate primes via church
-;; numerals.
-
-;; WARNING WARNING WARNING WARNING WARNING WARNING WARNING
-;;
-;; *** DO NOT RUN THIS CODE UNLESS YOU KNOW WHAT IT DOES ***
-;;
-;; Running this code could be hazardous to your emacs, your files,
-;; the machine you're using, and several other things you may not
-;; wish to expose to the ministrations of random lusers, particularly
-;; in the IRC world. You have been warned.
-;;
-;; WARNING WARNING WARNING WARNING WARNING WARNING WARNING
-
-;;; Code:
-
-(require 'zenirc)
-(require 'zenirc-trigger)
-
-(defun zenirc-eval (&optional msg)
- ;; parse out the (e)valuable bit
- (string-match "(eval \\(.*\\))" msg)
-
- ;; provide a modicum of protection from malicious parties.
- ;; NB it can be circumvented via a similar expression.
- (let ((kill-emacs-hook
- #'(lambda () (error "kill-emacs called from zenirc-eval"))))
- (condition-case err
- (let ((res (prin1-to-string (eval (read (match-string 1 msg))))))
- (if (string= "" res)
- "OJNK!"
- res))
- (error (format "Error: %s" err)))))
-
-(zenirc-trigger-register "eval" 'zenirc-eval "(eval \\(.*\\))" t)
-
-;;; zenirc-eval.el ends here.
-
+++ /dev/null
-;;;
-;;;
-;;; zenirc-example.el --- Example customizations for zenirc.el
-
-;;; Copyright (C) 1993, 1994 Ben A. Mesander
-;;; Copyright (C) 1993, 1994, 1996, 1997, 1998 Per Persson
-
-;;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;;; Per Persson <pp@sno.pp.se>
-;;; Maintainer: Per Persson <pp@sno.pp.se>
-;;; Keywords: extensions
-;;; Created: 1993/06/03
-
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; A good way to use this is to add something like
-;; (autoload 'zenirc "/home/pp/.zenirc-example" "Major mode to waste time" t)
-;; to your ~/.emacs file. Then edit and copy this file there. If you do that
-;; you also need to uncomment the last line of this file.
-
-;; if the autoload says ".zenirc-example", the file needs to be named
-;; ".zenirc-example.el", this is probably the best way for you to name
-;; it. (sure, go ahead and rename it, don't blame me).
-
-;; Also take a look on all the different scripts not mentioned in this file,
-;; they might give you something you'll love.
-
-;;; Code:
-
-;; this is a list of IRC servers you use
-;; it consists of servername, portnumber, password, nickname, username
-(setq zenirc-server-alist
- '(("irc.funet.fi")
- ("cs-pub.bu.edu" 6666)
- ("irc.stealth.net" 6667 nil "ben" "oedipus rpc.rexd")))
-
-;; this is what you reply to CTCP USERINFO
-(setq zenirc-userinfo "Oink.")
-
-;; this is a list of annoying things to ignore. This list ignores
-;; messages from nickserv, anything with the word "fnord" in it,
-;; messages from the major dweeb craig and everything with more then
-;; four CTCPs in it.
-(setq zenirc-ignore-list
- '("^:NickServ!Nickserv@hpsystem2.informatik.tu-muenchen.de" "fnord"
- "^:craig!craig@netsys1.netsys.com"
- "\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a"))
-
-;; zenirc can beep when it notices something,
-;; nil -> never beep
-;; t -> beep when message not seen
-;; 'always -> beep on all signals
-(setq zenirc-beep-on-signal nil)
-
-;; with zenirc-beep-on-signal turned on,
-;; this will make zenirc beep when it sees a ^G ala ircII and when you recieve
-;; a private PRIVMSG
-;(setq zenirc-signal-list '("\a"
-; "^\\([^ ]\\)* PRIVMSG [^#&+]\\([^ ]\\)* :"))
-
-;; this is how you want ZenIRC to send confirmations
-;; "nil" is no confirmation
-;; "t" is confirmation in buffer
-;; "'message" is confirmation in echo area
-(setq zenirc-send-confirmation t)
-
-;; if you want timestamps on PRIVMSG/NOTICE or not
-;; with default prefix and suffix it looks like
-;; *ben[13:31]* lets have some fun
-;; <ben#twilight_zone[13:32]> SLUGS AND KNIGHTS! SLUGS AND KNIGTS!
-(setq zenirc-timestamp nil
- zenirc-timestamp-prefix "["
- zenirc-timestamp-suffix "]")
-
-;; in ircII, the channelname isn't shown in PRIVMSGs if you're currently
-;; talking to the channel, setting zenirc-always-show-channelname to nil
-;; gives you the same effect.
-(setq zenirc-always-show-channelname nil)
-
-;; if WHOIS returns no-such-nick, setting this variable to t will make
-;; the client automaticall issue an WHOWAS command
-(setq zenirc-whowas-on-401 nil)
-
-;; setting this variable to t will make ZenIRC remove preceding whitespaces
-;; before a command, that is;
-;; /whois omnion
-;; will turn in to;
-;; /whois omnion
-;; but;
-;; oink!
-;; will turn in to;
-;; oink!
-;; yeah, there's no difference there.
-(setq zenirc-delete-preceding-whitespaces nil)
-
-;; if you want ZenIRC to send out ERRMSG on bogus CTCP queries
-(setq zenirc-send-ctcp-errmsg-on-unknown t)
-;; if you awnt ZenIRC to send out ERRMSG on unbalanced CTCP queries
-(setq zenirc-send-ctcp-errmsg-on-unbalanced t)
-
-;; if you want ZenIRC to tell you when send out CTCP replies
-(setq zenirc-verbose-ctcp t)
-
-;; what ZenIRC replies on CTCP FINGER
-(setq zenirc-fingerdata
- (format "%s <%s@%s>" (user-full-name) (user-real-login-name)
- (system-name)))
-
-;; commandkey in ZenIRC
-(setq zenirc-command-char ?/)
-
-;;; use the following to surpress AWAY info if seen more then once
-
-;(load-library "zenirc-away")
-
-;;; use the following to make ZenIRC queue commands for you, to get around
-;;; stupid flood controls
-
-;(load-library "zenirc-command-queue")
-
-;;; use the following to have tab-completion in ZenIRC
-
-;(load-library "zenirc-complete")
-
-;;; use the following to be able to act upon DCC CHAT and DCC SEND requests
-
-;(load-library "zenirc-dcc")
-
-;;; use the following to make ZenIRC fill incoming messages for you
-
-;; if ZenIRC should fill incoming lines
-;(setq zenirc-fill-mode t)
-;; if ZenIRC should fill outgoing lines
-;(setq zenirc-fill-outgoing-mode t)
-;; how ZenIRC should fill things
-;; (zenirc-wrap-region) adds zenirc-fill-prefix on each line
-;(setq zenirc-fill-region-function 'zenirc-wrap-region)
-;(setq zenirc-fill-prefix " ")
-;; (zenirc-wrap-region-dynamic) adds spaces at beginning of line,
-;; depending on length of first word
-;(setq zenirc-fill-region-function 'zenric-wrap-region-dynamic)
-;; (zenirc-wrap-region-static) adds spaces uses zenirc-fill-static
-;; columns to the left to display <nick#channel> and the rest to
-;; actual messages.
-;(setq zenirc-fill-region-function 'zenirc-wrap-region-static)
-;(setq zenirc-fill-static 26)
-;(load-library "zenirc-fill")
-
-;;; use the following to make ZenIRC format things like no-other-client
-;;; is able to. the first time a nick is seen, it's shown as
-;;; `nick!user@host'... after the first time it's just shown as `nick'
-;;; until the `user@host' part changes.
-
-;(load-library "zenirc-format")
-
-;;; use the following to get history functions on C-cC-p and C-cC-n
-
-;(load-library "zenirc-history")
-
-;;; use the following to get an ircII like /ignore command
-
-;(load-library "zenirc-ignore")
-
-;;; use the following to make ZenIRC output netsplits/netjoins nicer
-
-;(load-library "zenirc-netsplit")
-
-;;; use the following to get an ircII like /notify command
-
-;; a list of notificated people
-;(setq zenirc-notify-list
-; '("oddy" "piker" "flashman"))
-;(load-library "zenirc-notify")
-
-;;; use the following to make ZenIRC popup buffers when things happen
-
-;(load-library "zenirc-popup")
-
-;;; use the following if you want ZenIRC to act automatically when it
-;;; sees a certain string in a PRIVMSG. if this sounds interesting, read
-;;; the comments in zenirc-trigger.el and take a look at zenirc-yow.el,
-;;; zenirc-oink.el, zenirc-meditate.el, zenirc-8ball.el, zenirc-shop.el
-;;; and zenirc-fortran.el
-
-;(load-library "zenirc-trigger")
-
-;; the following is an example of how to do something during initializing a
-;; server connection. 001 is the first thing the server sends to a client
-;; after the client sends USER and NICK.
-;;
-;; :pfawww.pp.se 001 Omnion :Welcome to the Internet Relay Network Omnion
-;;
-;; current code from Eric Prestemon <ecp@io.com>
-
-(defvar zenirc-startup-channels-alist '(("debian" . "#debian")
- ("uoknor.edu" . nil)
- (".*" . "#perl"))
- "*Pairs of server and channels.
-server is a regexp
-channels is a comma separated string of channels to join during
- startup where nil means none")
-
-(defun zenirc-startup-join (proc parsedmsg)
- (let ((channelpairs (copy-alist zenirc-startup-channels-alist)))
- (while channelpairs
- (if (string-match (car (car channelpairs)) zenirc-server)
- (progn
- (if (cdr (car channelpairs))
- (process-send-string proc
- (concat "JOIN "
- (cdr (car channelpairs))
- "\n")))
- (setq channelpairs nil))
- (setq channelpairs (cdr channelpairs))))))
-
-(zenirc-add-hook 'zenirc-server-001-hook 'zenirc-startup-join)
-
-;;
-;; the following is an example of adding a new ctcp reply type to zenirc.
-;; in this case, it is "BOZOS", which returns a list of people who have
-;; been bozotic with me
-;;
-
-;; create a hook to be called and assign it a default value
-(defvar zenirc-ctcp-query-BOZOS-hook '(zenirc-ctcp-query-BOZOS))
-
-(setq zenirc-clientinfo-list
-'((ACTION . "ACTION contains action descriptions for atmosphere")
-;; this is the addition to the default list
- (BOZOS . "BOZOS returns a list of people who have been bozotic with me")
- (CLIENTINFO . "CLIENTINFO gives information about available CTCP commands")
- (ERRMSG . "ERRMSG returns error messages")
- (PING . "PING returns the arguments it receives")
- (FINGER . "FINGER shows real name, and login name of user (idle time is not yet implemented in ZenIRC)")
-;; sojge sure is a wordy bastard.
- (SOURCE . "takes 0 arguments and returns a description of where to find the source code of the client. The description is made up out of zero or more lines followed by an end marker. Every line is a CTCP reply with the SOURCE keyword, a space, the name of a FTP-server, a colon, a directory name, a colon, and 0 or more file names. If no file names are given, all the files in the named directory are needed. The end marker contains just the keyword.")
- (TIME . "TIME tells you the time on the user's host")
- (USERINFO . "USERINFO returns user settable information")
- (VERSION . "VERSION shows client type, version, and environment")))
-
-;; note addition of BOZOS--------------*****
-(setq zenirc-clientinfo-string "ACTION BOZOS CLIENTINFO ERRMSG FINGER PING SOURCE TIME USERINFO VERSION :Use CLIENTINFO <COMMAND> to get more specific information")
-
-;;
-;; this is the handler for a CTCP BOZOS query
-;;
-(defun zenirc-ctcp-query-BOZOS (proc parsedctcp from to)
- ;; if verbose ctcp is on, tell the user we got the query
- (if zenirc-verbose-ctcp
- (zenirc-message
- proc
- (format "[info] responding to BOZOS query from %s to %s\n"
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from) to)))
- ;; send a reply to the BOZOS query
- (process-send-string
- proc
- (concat "NOTICE " (zenirc-extract-nick from)
- " :\C-aBOZOS phone poxav veep noah rmtodd dmarcher lila neil notused laura w jason belladona mycroft amazin CHRISTIAN omnion fn vuori nap\C-a\n")))
-
-;; this is the second last line of the file, the next line is the last one
-(require 'zenirc)
\ No newline at end of file
+++ /dev/null
-;;; zenirc-fill.el --- fill messages in zenirc
-
-;; Copyright (C) 1995 Noah S. Friedman
-;; Copyright (C) 1995, 1996, 1997, 1998 Per Persson
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1995-03-16
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-fill-mode nil
- "*If non-nil, then fill messages fitting `zenirc-fill-message-categories'.
-This is buffer-local.")
-(make-variable-buffer-local 'zenirc-fill-mode)
-
-(defvar zenirc-fill-region-function 'zenirc-wrap-region
- "*Function to use for filling.")
-
-(defvar zenirc-fill-prefix " | "
- "*String for filling to insert at front of new lines, or nil for none.")
-
-(defvar zenirc-fill-static 12
- "*How many chars into first the line the first word should end.
-This will look totally ridicolous if you don't strip away !user@host from
-PRIVMSG and NOTICE")
-
-(defvar zenirc-fill-column (- (window-width) 2)
- "*Column beyond which line-wrapping should happen in zenirc buffers.")
-
-(defvar zenirc-fill-message-categories
- '(privmsg privmsg_you notice notice_you privmsg_nochannel
- notice_nochannel ctcp_action)
- "*ZenIRC message categories to fill as paragraphs.
-This should be a list consisting of symbols corresponding to the type of
-messages in the message catalog which should be filled as paragraphs.
-For example, private messages (`privmsg') and notices (`notice') are good
-choices.
-
-If this variable is set to `t', then all messages are filled.
-If this variable is set to `nil', then no messages are filled.")
-
-(defvar zenirc-fill-nonstandard-message-categories-p nil
- "If non-nil, then fill messages that are not in a standard category.
-That is, fill messages which did not originate from the message catalog,
-and thus have no category symbol.")
-
-\f
-(defun zenirc-fill-mode (&optional prefix)
- "Enable or disable line wrapping of irc messages.
-
-A negative prefix argument disables this mode.
-A non-negative prefix argument enables it.
-If no prefix argument is given, toggle the current state of the mode.
-
-The user may also enable or disable this mode simply by setting the
-variable of the same name."
- (interactive "P")
- (cond
- ((null prefix)
- (setq zenirc-fill-mode (not zenirc-fill-mode)))
- ((>= (prefix-numeric-value prefix) 0)
- (setq zenirc-fill-mode t))
- (t
- (setq zenirc-fill-mode nil)))
- (cond ((not (interactive-p)))
- (zenirc-fill-mode
- (message "zenirc-fill-mode is enabled"))
- (t
- (message "zenirc-fill-mode is disabled")))
- zenirc-fill-mode)
-
-;; "normal" filling function.
-(defun zenirc-fill-region (beg end win-width)
- (let* ((fill-prefix zenirc-fill-prefix)
- (fill-column zenirc-fill-column))
- (fill-region-as-paragraph (point-min) (1- (point-max))))
- ;; this filling function adds an unnecessary newline.
- (goto-char (point-max))
- (delete-char -1))
-
-;; This is like the normal filling routines except that it doesn't squash
-;; whitespace (except at line breaks). This will make ascii barphics and
-;; other random spaced crap easier to see.
-(defun zenirc-wrap-region (beg end win-width)
- (interactive "r")
- (save-match-data
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (let* ((ws "[ \t]")
- (prefix-length (length zenirc-fill-prefix))
- (fill-column (max (or zenirc-fill-column
- (- win-width 2))
- prefix-length))
- line-beg)
- (goto-char beg)
- (while (< (point) (point-max))
- (beginning-of-line)
- (setq line-beg (+ (point) prefix-length))
- (cond ((< fill-column (- (point-max) (point)))
- (forward-char fill-column)
- (cond ((or (memq (char-after (point)) '(32 ?\t))
- (re-search-backward ws line-beg t)
- (re-search-forward ws (point-max) t))
- (just-one-space)
- (delete-char -1)
- (insert "\n" (or zenirc-fill-prefix "")))
- (t
- (goto-char (point-max)))))
- (t
- (goto-char (point-max))))))))))
-
-;; This adds whitespaces before the first word on every line but the first
-;; one to match up with the length of the first word on the first line.
-(defun zenirc-wrap-region-dynamic (beg end win-width)
- (interactive "r")
- (save-match-data
- (save-excursion
- (save-restriction
- ;; trim trailing whitespace
- (goto-char (- end 1))
- (just-one-space)
- (if (< (+ beg 1) (point))
- (delete-char -1))
- (setq end (point))
-
- (narrow-to-region beg end)
- (goto-char beg)
- (let* ((ws "[ \t]")
- ; set the length of the prefix
- (prefix-length
- (or (and (search-forward " " end t)
- (- (match-end 0) beg))
- 0))
-
- ; how many columns zenirc-wrap-region should keep inside
- (fill-column (max (or zenirc-fill-column
- (- win-width 2))
- (or prefix-length 0)))
- line-beg)
- (goto-char beg)
- ; start wrapping of the actual message, after first word
- (while (< (point) (point-max))
- (beginning-of-line)
- (setq line-beg (+ (point) prefix-length))
- (cond ((< fill-column (- (point-max) (point)))
- (forward-char fill-column)
- (cond ((or (memq (char-after (point)) '(32 ?\t))
- (re-search-backward ws line-beg t)
- (re-search-forward ws (point-max) t))
- ; remove all spaces before adding newline
- (just-one-space)
- (delete-char -1)
- (insert
- "\n"
- (make-string prefix-length
- (string-to-char " "))))
- (t
- (goto-char (point-max)))))
- (t
- (goto-char (point-max))))))))))
-
-;; This adds whitespaces before the first word on every line so that the
-;; second word on the first line and the first word on every other line
-;; match up with all the other lines (not just in this region).
-(defun zenirc-wrap-region-static (beg end win-width)
- (interactive "r")
- (save-match-data
- (save-excursion
- (save-restriction
- (narrow-to-region beg end)
- (goto-char beg)
- (let* ((ws "[ \t]")
- ; set the length of the prefix
- (prefix-length
- (and (search-forward " " end t)
- (- (match-end 0) beg)))
- ; how many columns zenirc-wrap-region should keep inside
- (fill-column (max (or zenirc-fill-column
- (- win-width 2))
- prefix-length))
- line-beg)
- (goto-char beg)
- (if (<= prefix-length zenirc-fill-static)
- (progn
- (insert (make-string
- (- zenirc-fill-static prefix-length)
- (string-to-char " ")))
- ; update the length of the prefix, as it is static
- (setq prefix-length zenirc-fill-static)))
- ; start wrapping of the actual message, after first word
- (while (< (point) (point-max))
- (beginning-of-line)
- (setq line-beg (+ (point) prefix-length))
- (cond ((< fill-column (- (point-max) (point)))
- (forward-char fill-column)
- (cond ((or (memq (char-after (point)) '(32 ?\t))
- (re-search-backward ws line-beg t)
- (re-search-forward ws (point-max) t))
- ; remove all spaces before adding newline
- (just-one-space)
- (delete-char -1)
- (insert
- "\n"
- (make-string zenirc-fill-static
- (string-to-char " "))))
- (t
- (goto-char (point-max)))))
- (t
- (goto-char (point-max))))))))))
-
-
-(defvar zenirc-window-last-width 80)
-(defun zenirc-fill-message (proc sym string)
- (let* ((w (and proc
- (get-buffer-window (process-buffer proc) t)))
- (win-width (if w
- (setq zenirc-window-last-width (window-width w))
- zenirc-window-last-width)))
- (and zenirc-fill-mode
- (cond ((eq zenirc-fill-message-categories t))
- ((null sym)
- zenirc-fill-nonstandard-message-categories-p)
- ((memq sym zenirc-fill-message-categories))
- (t nil))
- (funcall zenirc-fill-region-function
- (point-min) (point-max) win-width))))
-\f
-(defvar zenirc-fill-outgoing-mode nil
- "*If non-nil, then fill outgoing PRIVMSG/NOTICEs.
-This is buffer-local.")
-(make-variable-buffer-local 'zenirc-fill-outgoing-mode)
-
-(defvar zenirc-fill-outgoing-prefix "-> "
- "*What do add before outgoing lines.")
-
-(defun zenirc-fill-outgoing-mode (&optional prefix)
- "Enable or disable line wrapping of outgoing PRIVMSG/NOTICEs.
-
-A negative prefix argument disables this mode.
-No argument or any non-negative argument enables it.
-
-The user may also enable or disable this mode simply by setting the
-variable of the same name."
- (interactive "P")
- (cond
- ((null prefix)
- (setq zenirc-fill-outgoing-mode (not zenirc-fill-outgoing-mode)))
- ((>= (prefix-numeric-value prefix) 0)
- (setq zenirc-fill-outgoing-mode t))
- (t
- (setq zenirc-fill-outgoing-mode nil)))
- (cond ((not (interactive-p)))
- (zenirc-fill-outgoing-mode
- (message "zenirc-fill-outgoing-mode is enabled"))
- (t
- (message "zenirc-fill-outgoing-mode is disabled")))
- zenirc-fill-outgoing-mode)
-
-(defun zenirc-fill-outgoing (beg end str)
- (if zenirc-fill-outgoing-mode
- (save-excursion
- (goto-char beg)
- ; if the outgoing line isn't a command, just insert the prefix
- (if (not (= (aref str 0) zenirc-command-char))
- (progn
- (insert zenirc-fill-outgoing-prefix)
- (save-restriction
- (narrow-to-region beg end)
- (funcall zenirc-fill-region-function
- beg end (window-width))))
- (let
- ; if the outgoing line was a command, parse out the
- ; actual command and the argument/text.
- ((command (car (zenirc-parse-firstword
- (substring str 1))))
- (text (cdr (zenirc-parse-firstword str))))
- (cond
- ; if the command was one of 'm', 'msg' or 'privmsg',
- ; do some fanzy parsing and change the line a bit.
- ((string-match "\\(^m$\\|^msg$\\|^privmsg$\\)" command)
- (delete-region beg end)
- (insert zenirc-fill-outgoing-prefix
- "*" (car (zenirc-parse-firstword text)) "* "
- (cdr (zenirc-parse-firstword text)))
- (save-restriction
- (narrow-to-region beg end)
- (funcall zenirc-fill-region-function
- beg end (window-width)))))))
-)))
-
-\f
-(defvar zenirc-command-resize-hook '(zenirc-command-resize))
-
-;; /resize [width]
-(defun zenirc-command-resize (proc cmd)
- (if (string= (cdr cmd) "")
- (setq zenirc-fill-column (- (window-width) 2))
- (setq zenirc-fill-column (cdr cmd))))
-\f
-(provide 'zenirc-fill)
-
-(zenirc-add-hook 'zenirc-message-hook 'zenirc-fill-message)
-(zenirc-add-hook 'zenirc-send-line-hook 'zenirc-fill-outgoing)
-
-(or (assq 'zenirc-fill-mode minor-mode-alist)
- (setq minor-mode-alist
- (cons (list 'zenirc-fill-mode " Zfill") minor-mode-alist)))
-
-;;; zenirc-fill.el ends here
-
+++ /dev/null
-;;; zenirc-finnish.el --- Finnish message catalog for ZenIRC
-
-;; Copyright (C) 1995 Valtteri Vuorikoski
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Valtteri Vuorikoski <vuori@sci.fi>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1995/05/23
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; If you're using emacs 19, loading iso-ascii.el or doing
-;; M-x standard-display-european on X displays makes 8-bit characters
-;; easier to see.
-
-;;; Code:
-
-(require 'zenirc)
-
-(zenirc-lang-define-catalog
- 'finnish
- '((s001 . "[info] Hukkaat aikaasi.")
- (s002 . "[info] Irkkiserverisi on %s ajaen ircd-versiota %s")
- (s003 . "[info] Tämä serveri luotiin %s")
- (s200 . "[info] %s (%s) Linkki -> %s") ; Version reply from /trace
- (s202 . "[info] %s H.S. -> %s")
- (s203 . "[info] %s Hmmm -> IP-osoite: %s") ; Unknown connection
- (s204 . "[info] %s Oper -> %s") ; Operator connection
- (s205 . "[info] %s Käyttäjä -> %s") ; User connection
- (s206 . "[info] %s Serveri -> %s %s %s %s ") ; Server connection
- (s208 . "[info] %s %s -> %s") ; New type connection
- (s209 . "[info] %s Luokka -> %s = %s") ; What the classes means
- (s211 . "[info] %s linkki ylhäällä %s sek\nLähetetty: %s/%s, Vastaanotettu: %s/%s, SendQ: %s")
- (s212 . "[info] %s\t->\ttimes: %s\tbytes: %s") ; Command stats
- (s213 . "[info] C kone/nimi/port/luok: %s/%s/%s/%s") ; C-lines
- (s214 . "[info] N kone/nimi/port/luok: %s/%s/%s/%s") ; N-lines
- (s215 . "[info] %s kone/nimi/luokka:\t%s/%s/%s") ; I-lines
- (s216 . "[info] K kone/käyttäjä:\t%s/%s") ; K-lines
- (s217 . "[info] Q %s/%s/%s/%s/%s") ; Q-lines
- (s218 . "[info] Luokka: %s Ping-taajuus: %s Connectaustaajuus: %s Max Linkkkejä: %s SendQ: %s") ; Y-lines
- (s219 . "[info] /statsien loppu.")
- (s221 . "[info] User-moodisi on: %s")
- (s241 . "[info] LEAF-serverin hostmaski/syvyys:\t\t%s/%s") ; L-lines
- (s242 . "[info] %s") ; Uptime of server
- (s243 . "[info] %s nickki/käyttäjä@kone:\t%s/%s") ; O-lines
- (s244 . "[info] HUB hostmaski/serveri:\t%s/%s") ; H-lines
- (s251 . "[info] %s/%s näkyvää/näkymätöntä käyttäjää %s:llä serverillä.")
- (s252 . "[info] %s isoa moloa linjalla.")
- (s253 . "[info] %s tuntematonta yhteyttä.")
- (s254 . "[info] %s kannua")
- (s255 . "[info] %s clienttiä and %s serveriä yhteydessä tähän serveriin")
- (s256 . "[info] Administratiivinen informaatio %s:lle:") ; /admin line 1
- (s257 . "[info] %s") ; /admin line 2
- (s258 . "[info] %s") ; /admin line 3
- (s259 . "[info] %s") ; /admin line 4
- (s261 . "[info] %s Tiedosto -> %s %s") ; Logfile trace
- (s301 . "[info] %s on pois: %s")
- (s302 . "[info] userhost: %s") ; userhost reply
- (s303 . "[info] Tällä hetkellä aikaa hukkaamassa: %s") ; ison reply
- (s305 . "[info] Et ole enää poissa")
- (s306 . "[info] Olet poissa")
- (s311 . "[info] %s (%s@%s) on %s") ; user part of /whois list
- (s312 . "[info] %s käyttää serveriä %s (%s)")
- (s313 . "[info] %s on Iso Molo.") ; /whois operator status
- (s314 . "[info] %s (%s@%s) oli %s") ; user part of /whowas list
- (s315 . "[info] /who:n loppu.")
- (s317 . "[info] %s on iDLaillut %s") ; /whois idle time
- (s318 . "[info] /whois:in loppu.")
- (s319 . "[info] %s on kannuilla: %s") ; channel part of whois data
- (s321 . "[info] Kannu Populaa Otsikko") ; header for LIST cmd
- (s322 . "[info] %-15s %-5s %s") ; each channel in LIST cmd
- (s323 . "[info] /listin loppu.") ; trailer for LIST cmd
- (s324 . "[info] Moodi kannulle %s on %s %s") ; channel mode
- (s331 . "[info] %s:llä ei ole otsikkoa") ; no topic message
- (s332 . "[info] %s otsikko: %s") ; topic message
- (s333 . "[info] %s:n asetti %s kello %s") ; topic set time
- (s341 . "[info] Kutsuit %s:n kanavalle %s") ; invite reply
- (s342 . "[info] Pyydät %s:ää hukkaamaan aikaansa") ; summon reply
- (s351 . "[info] Versio: %s %s %s") ; version reply
- (s352_header . "[info] Nickki Stat Kanavan nimi Käyttäjä@kone (Hopseja Nimi)") ; header for /who list reply
- (s352 . "[info] %-9s %-3s %-15s %s@%s (%s)") ; /who list reply
- (s353 . "[info] Käyttäjiä kannulla %s: %s") ; displayed after channel join
- (s364 . "[info] %s %s %s") ; /links reply
- (s365 . "[info] /linksin loppu") ; end of /links reply
- (s367 . "[info] %s banni %s") ; banlist reply
- (s368 . "[info] Bannilistan loppu") ; end of banlist reply
- (s371 . "[info] %s") ; info reply
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] Päivän viesti:") ; start of motd
- (s376 . "[motd] Päivän viestin loppu") ; displayed at end of motd
- (s381 . "[info] Olet nyt Iso Molo") ; irc op status
- (s382 . "[info] Poltan hashista: %s") ; rehash server msg
- (s391 . "[info] Aika serveriltä %s: %s") ; TIME reply
- (s392 . "[info] Tili Terminaali Kone") ; header for users rpl
- (s393 . "[info] %s") ; body of users rpl
- (s395 . "[info] Ei ketään kotona") ; nobody for users rpl
- (s401 . "[info] Ei moista nickkiä/kannua: %s") ; there is no such nick/chan
- (s402 . "[info] Ei moista serveriä: %s") ; there is no such server
- (s403 . "[info] Ei moista kanavaa: %s") ; there is no such channel
- (s404 . "[info] Et voi lähettää %s:lle.") ; you can't send to channel
- (s405 . "[info] Liian monta kanavaa: %s") ; too many channels
- (s406 . "[info] Serverillä ei ole tietoa nickistä: %s") ; no whowas data
- (s407 . "[info] Liian monta vastaanottajaa. Viestiä ei lähetetty: %s") ; user@host
- (s409 . "[info] Alkuperää ei määritelty.") ; ping error reply
- (s411 . "[info] Ei vastaanottajaa.") ; no recipient given
- (s412 . "[info] Ei mitään lähetettävää.") ; you didn't send anything.
- (s413 . "[info] Ei toplevel-domainia: %s") ; no toplevel domain spec
- (s414 . "[info] Villikortti toplevel-domainissa: %s") ; wild toplevel
- (s421 . "[info] Tämä näyttää minusta purkitetulta lihalta: %s") ; you sent server spam
- (s422 . "[info] Ei motdia (liekitä /adminissa mainittua Isoa Moloa)")
- (s423 . "[info] Ei admin-infoa. Vihjeetön Iso Molo ajaa serveriä.")
- (s431 . "[info] Ei nickkiä annettu") ; you didn't provide a nick
- (s432 . "[info] Invalidi nickki: %s")
- (s433 . "[info] Nickki jo käytössä: %s")
- (s436 . "[info] Nickkitörmäysmurhatappo: %s")
- (s441 . "[info] %s ei ole kannulla %s") ; can't do it to those not present
- (s442 . "[info] Et ole kannulla %s.") ; you can't do that dave.
- (s443 . "[info] %s on jo kannulla %s.") ; invite error
- (s444 . "[info] %s ei ole loggautunut sisään") ; SUMMON reply
- (s445 . "[info] Iso Molo ei anna sinun summonoida")
- (s446 . "[info] Iso Molo ei anna sinun nähdä /usereita")
- (s451 . "[info] Et ole rekisteröitynyt") ; gotta do the USER NICK thing
- (s461 . "[info] Ei tarpeeksi parametrejä: %s") ; as 421
- (s462 . "[info] Et voi rekisteröityä uudelleen") ; cannot USER twice
- (s463 . "[info] Fasistisika-Iso Molo ei anna sinun käyttää tätä serveriä")
- (s464 . "[info] Väärä salasana") ; bad PASS command
- (s465 . "[info] Sinulla ei ole lupaa käyttää tätä serveriä.") ; creep
- (s467 . "[info] Avain kanavalle %s on jo asetettu") ; chan key set already
- (s471 . "[info] Et voi joinata %s:lle (luuserilimiitti saavutettu).") ; too many ppl
- (s472 . "[info] %s on tuntematon moodi.") ; duh
- (s473 . "[info] Et voi joinata %s:lle (hommaa invite).") ; fascist nerds
- (s474 . "[info] Et voi joinata %s:lle %s (bannattu).") ; you're banned
- (s475 . "[info] Et voi joinata %s:lle (väärä avainsana).") ; bad key
- (s481 . "[info] Et ole tarpeeksi Iso Molo tehdäksesi tuota.") ; oper only
- (s482 . "[info] Et ole voimansiirtokone %s:llä.") ; chanop needed
- (s483 . "[info] Et voi tappaa serveriä. Doh!") ; can't kill a server
- (s491 . "[info] Isoja Moloja ei sallita sinun koneeltasi") ; no o-line
- (s501 . "[info] Tuntematon moodilippu") ; you did something silly
- (s502 . "[info] Et voi vaihtaa toisten käyttäjien moodia") ; as above
- (action . "(lähetetty %s:lle)") ; ctcp action sent
- (action-echo . "(lähetetty %s:lle)") ; ctcp action sent
- (connect-failed . "[error] En voinut connectata %s:n porttiin %d, koska: %s")
- (connect-try . "[info] Connectailen %s:n porttiin %d...")
- (connect-abort . "[info] Konnektaus serveriin abortoitu.")
- (ctcp_action . "[action->%s] %s %s") ; ctcp ACTION display
- (ctcp_clientinfo . "[query] CLIENTINFO %s:ltä %s:lle")
- (ctcp_errmsg . "[query] ERRMSG %s:ltä %s:lle")
- (ctcp_finger . "[query] FINGER %s:ltä %s:lle")
- (ctcp_ping . "[query] PING %s:ltä %s:lle")
- (ctcp_ping_reply . "[reply] PING: %s on %s sekunnin matkan päässä")
- (ctcp_source . "[query] SOURCE %s:ltä %s:lle")
- (ctcp_time . "[query] TIME %s:ltä %s:lle")
- (ctcp_userinfo . "[query] USERINFO %s:ltä %s:lle")
- (ctcp_version . "[query] VERSION %s:ltä %s:lle")
- (debug . "[debug] %s") ; displayed by debugging code
- (error . "[%s] %s") ; server error message
- (invite . "[info] %s kutsuu sinut %s:lle.") ; invite
- (join_you . "[info] Joinaan kannulle: %s")
- (join . "[info] %s on joinannut %s:lle")
- (kick . "[info] %s on potkittu kanavalta %s %s:n toimesta") ; someone was peeved
- (kick_you . "[info] Sinut on potkittu %s:ltä %s:n toimesta") ; loser
- (kill . "[info] Sinut on raukkamaisesti tapettu: %s") ; your time is up.
- (mode . "[info] %s on vaihtanut moodia %s:lle: %s") ; MODE change
- (nick . "[info] %s on vaihtanut nickkiä: %s") ; nick change
- (newcatalog . "[info] Viestikatalogi asetettu %s:ksi")
- (nocatalog . "[error] Ei viestikatalogia määritelty %s:lle")
- (nosend . "[info] Sinulla ei ole uhria jolle lähettää") ; msg not sent
- (notice . "{%s%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your nick
- (notify_list . "[info] Tämänhetkinen ajanhukkaajalistasi: %s")
- (notify_on . "[info] tunnistettu %s aikaa hukkaamassa.")
- (notify_off . "[info] tunnen, että %s on lopettanut ajanhukkaamisen.")
- (now_querying . "[info] Tämänhetkinen uhrisi on %s.") ; /query foo
- (part_you . "[info] Häivyn: %s (%s)") ; your part from channel message
- (part . "[info] %s on häipynyt %s:ltä (%s)") ; part from channel message
- (pong . "[info] %s sanoo ojnk.") ; pong message from server
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your nick
- (protocol_violation . "[error] Tämä rivi ei ole IRC-protokollan mukainen.\n[error] Valita serverin administraattorille:\n%s: %s")
- (query . "[query] %s:ltä %s:lle sisältö %s") ; ctcp query
- (query_unknown . "on tuntematon CTCP-viesti")
- (query_unbalanced . "[epätasapainoinen ctcp] %s:ltä %s:lle sisältö %s")
- (query_unbalanced_reply . "on epätasapainoinen CTCP-viesti")
- (quit . "[info] %s lopetti ajanhukkaamisen: %s") ; user signoff
- (reply . "[reply] %s:ltä %s:lle sisältö %s") ; ctcp reply
- (reply_unbalanced . "[epätasapainoinen vastaus] %s:ltä %s:lle sisältö %s")
- (send . "(lähetetty %s:lle)") ; you sent a message/notice
- (send-echo . "(lähetetty %s:lle)") ; you sent a message/notice
- (sentinel . "\nZenIRC lopetettu aikaan %s") ; process sentinel message
- (server . "[server] %s") ; unknown server message
- (signal . "[signaali %s]") ; signal in echo area
- (topic . "[info] %s vaihtoi otsikon kanavalla %s: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- ))
-
-(provide 'zenirc-finnish)
-
-;;; zenirc-finnish.el ends here
\ No newline at end of file
+++ /dev/null
-;;; zenirc-format.el --- format nick!user@host for zenirc
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1995 Noah S. Friedman
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Charles Hannum <mycroft@gnu.ai.mit.edu>
-;; Richard Todd <rmtodd@essex.ecn.uoknor.edu>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: zenirc, extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Format nick!user@host info the first time you see someone as
-;; nick!user@host and thereafter as just nick. Nick changes are detected
-;; and handled correctly.
-
-;; This was rewritten 1995-03-18 by friedman to use a hash table instead of
-;; an alist.
-
-;;; Code:
-
-(require 'zenirc)
-
-;; 101 buckets should be a reasonable size for most people (remember to use
-;; a prime number to get good hashing characteristics).
-;; This is not the total number of nicks you can cache, but just the number
-;; of "buckets" in which nicks can be stored. If you talk to thousands
-;; and thousands of people it might help to increase the size of this
-;; table, but even then it isn't necessary.
-(defvar zenirc-nickuserhost-table (make-vector 101 0)
- "Table used to store nicknames and corresponding nick!user@host.")
-
-(defun zenirc-format-nickuserhost-fancy (nickuserhost)
- (let ((nick (zenirc-extract-nick nickuserhost)))
- (if nick
- (let* ((nicksym (intern (zenirc-downcase-name nick)
- zenirc-nickuserhost-table))
- (cached (and (boundp nicksym)
- (symbol-value nicksym))))
- ; possible BUG
- (setq zenirc-run-next-hook nil)
- (set nicksym nickuserhost)
- (and cached
- (string= cached nickuserhost)
- (setq nickuserhost nick)))))
- nickuserhost)
-
-(zenirc-add-hook 'zenirc-format-nickuserhost-hook
- 'zenirc-format-nickuserhost-fancy)
-
-(defun zenirc-fancy-NICK (proc parsedmsg)
- (let* ((userhost (zenirc-extract-userhost (aref parsedmsg 1)))
- (to (aref parsedmsg 2)))
- (set (intern (zenirc-downcase-name to) zenirc-nickuserhost-table)
- (concat to "!" userhost))))
-
-(zenirc-add-hook 'zenirc-server-NICK-hook 'zenirc-fancy-NICK)
-
-;; Also hook into the /who display.
-;; (added by rmtodd, rewritten by friedman)
-(defun zenirc-fancy-352 (proc parsedmsg)
- ;; If the 3 arg is "Channel", this is the header.
- ;; One wonders why the header isn't a different numeric.
- (or (string= (aref parsedmsg 3) "Channel")
- (let* ((nick (aref parsedmsg 7))
- (nickuserhost (concat nick "!" (aref parsedmsg 4) "@"
- (aref parsedmsg 5)))
- (nicksym (intern (zenirc-downcase-name nick)
- zenirc-nickuserhost-table)))
- (set nicksym nickuserhost))))
-
-\f
-(zenirc-add-hook 'zenirc-server-352-hook 'zenirc-fancy-352)
-
-(provide 'zenirc-format)
-
-;; zenirc-format.el ends here
+++ /dev/null
-;;; zenirc-fortran.el --- emulate F-BOT FORTRAN bot program with ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1997 Noah Friedman
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Maintainer: ben@gnu.ai.mit.edu
-;; Keywords: extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Example hook code to override something internal to zenirc.
-;; Also a good example of a server message hook.
-
-;; From ben@gnu.ai.mit.edu Tue May 11 08:12:27 1993
-;; Newsgroups: alt.irc
-;; From: ben@gnu.ai.mit.edu (Ben A. Mesander)
-;; Subject: Re: introducing ZENBOT 1.0!!!! (Bot-lovers)
-;; Summary: FORTRAN BOTZ RULE!!!!!!111
-;; In-Reply-To: christian@hopper.Virginia.EDU's message of Mon, 10 May 1993 23:43:42 GMT
-;; Date: Tue, 11 May 1993 04:44:42 GMT
-;; Nntp-Posting-Host: gnu.ai.mit.edu
-;; Organization: The phedz.
-;;
-;; Hah. Leper.
-;;
-;; ircII bots are for weenies. Even C bots are slow on supercomputer
-;; architectures. On a Cray, FORTRAN is much faster than C, due to the
-;; architecture of the machine. Therefore I - piglet3 - the GENIUS
-;; MASTERMIND of IRC have written a FORTRAN bot. This bot is guaranteed
-;; to be faster than any C bot if run on a Cray II or above. I am sure
-;; the irCOPS want to keep this technology secret, but I - piglet3 - am
-;; going to reveal the SECRET OF FAST BOTS ON IRC RIGHT IN THIS POSTING!
-;;
-;; Unlike Christian's RESTRICTIVE licensing agreement, my bot is in the
-;; PUBLIC DOMAIN! If you want to use it and claim you wrote it, PLEASE DO!
-;;
-;; The source comes in three files, a Makefile (yes, Christian's bot had
-;; NO MAKEFILE! IT WAS HARD TO INSTALL!), a FORTRAN source code file, and
-;; a small C code interface to the UNIX operating system. Those of you
-;; running operating systems besides UNIX should have no trouble writing
-;; the network interface routines in FORTRAN instead of C.
-;;
-;; Future releases of this program will be installable via GNU Configure,
-;; thus making installation even easier. The FORTRAN-C calling interface
-;; is assumed to be BSD-style, for those of you who really want to compile
-;; it.
-;;
-;; ---Makefile---cut here---
-;; CC=gcc
-;; F77=f77
-;;
-;; bot: bot.o sock.o
-;; $(F77) bot.o sock.o -o bot
-;;
-;; bot.o: bot.f
-;; $(F77) -c bot.f
-;;
-;; sock.o: sock.c
-;; $(CC) -c sock.c
-;; ---bot.f---cut here---
-;; CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-;; C
-;; C FORTRAN BOT PROGRAM FOR IRC II
-;; C
-;; C BY BEN MESANDER
-;; C BEN@GNU.AI.MIT.EDU
-;; C
-;; C THIS PROGRAM IS IN THE PUBLIC DOMAIN
-;; CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
-;;
-;; PROGRAM FBOT
-;; CHARACTER*80 SERVER, CHANEL, NICK, NAME, USER, HOST
-;;
-;; C YOU MUST CUSTOMIZE THESE VARIABLES
-;; NICK='F-BOT'
-;; NAME='EXPERIMENTAL FORTRAN IRC-II BOT PROGRAM'
-;; USER='BEN'
-;; HOST='GNU.AI.MIT.EDU'
-;;
-;; PRINT *,'ENTER NAME OF IRC-SERVER TO USE:'
-;; READ(*,'(A)') SERVER
-;; PRINT *,'ENTER NAME OF CHANNEL TO JOIN:'
-;; READ(*,'(A)') CHANEL
-;;
-;; I=OPSOCK(SERVER)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'UNABLE TO CONNECT TO IRC-SERVER'
-;; STOP
-;; ENDIF
-;;
-;; I=WRSOCK('NICK '//NICK)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'UNABLE TO WRITE IRC-NICK TO SERVER'
-;; STOP
-;; ENDIF
-;;
-;; I=WRSOCK('USER '//USER(1:INDEX(USER,' ')-1)//'@'//HOST(1:
-;; + INDEX(HOST,' ')-1)//' 1 1 :'//NAME)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'UNABLE TO WRITE IRC-NAME TO SERVER'
-;; STOP
-;; ENDIF
-;;
-;; CALL EATMTD()
-;; CALL BOTTY(CHANEL,NICK,USER,HOST)
-;; CALL CLSOCK()
-;; STOP
-;; END
-;;
-;; SUBROUTINE EATMTD()
-;; C PURPOSE - TO EAT THE MOTD
-;; CHARACTER*513 INLINE
-;;
-;; 10 CONTINUE
-;; I=RDSOCK(INLINE)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'ERROR WHILE READING MOTD'
-;; STOP
-;; ENDIF
-;; IF ((INDEX(INLINE,'End of /MOTD').EQ.0).OR.
-;; + (INDEX(INLINE,'376').NE.0)) GOTO 10
-;; RETURN
-;; END
-;;
-;; SUBROUTINE BOTTY(CHANEL, NICK, USER, HOST)
-;; CHARACTER*80 CHANEL, NICK, USER, HOST
-;; C PURPOSE - TO BE BOTTY
-;; CHARACTER*513 INLINE
-;;
-;; I=WRSOCK('JOIN '//CHANEL)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'ERROR WHILE JOINING CHANNEL'
-;; STOP
-;; ENDIF
-;;
-;; 20 CONTINUE
-;; INLINE=''
-;; I=RDSOCK(INLINE)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'ERROR READING FROM IRC-SERVER'
-;; STOP
-;; ENDIF
-;;
-;; IF (INDEX(INLINE,'PING').EQ.1) THEN
-;; I=WRSOCK('PONG '//HOST)
-;; IF (I.EQ.1) THEN
-;; PRINT *,'ERROR WHILE PONGING'
-;; STOP
-;; ENDIF
-;; GOTO 20
-;; ENDIF
-;;
-;; IF (INDEX(INLINE,'FORTRAN').NE.0) THEN
-;; I=WRSOCK('PRIVMSG '//CHANEL(:INDEX(CHANEL,' ')-1)//
-;; + ' :YES I AM REALLY WRITTEN IN 3L33T FORTRAN-77!!!!!!!')
-;; IF (I.EQ.1) THEN
-;; PRINT *,'ERROR WRITING 3L33T MESSAGE TO IRC-SERVER'
-;; STOP
-;; ENDIF
-;; GOTO 20
-;; ENDIF
-;;
-;; IF (INDEX(INLINE,'PHONE IS A SLUT').NE.0) RETURN
-;;
-;; GOTO 20
-;; RETURN
-;; END
-;;
-;; ---sock.c---cut here---
-;; /*
-;; * rudimentary C socket I/O routines for FORTRAN bot.
-;; *
-;; * Ben Mesander
-;; * ben@gnu.ai.mit.edu
-;; *
-;; * this code is in the public domain
-;; */
-;;
-;; #include <stdio.h>
-;; #include <sys/types.h>
-;; #include <sys/socket.h>
-;; #include <netinet/in.h>
-;; #include <netdb.h>
-;; #define IRCPORT 6667
-;;
-;; int sock; /* socket to connect to server */
-;;
-;; /*
-;; * open a socket to the irc server on "hostname"
-;; */
-;;
-;; int opsock_(char *fhostname, int fhostnamelen)
-;; {
-;; char *hostname;
-;; int i;
-;; struct sockaddr_in addr;
-;; struct hostent *h;
-;;
-;; if (NULL == (hostname = (char *)malloc(fhostnamelen+1))) {
-;; return 1;
-;; }
-;; strncpy(hostname, fhostname, fhostnamelen+1);
-;; for(i=0;i<strlen(hostname);i++) {
-;; if (' ' == *(hostname+i)) {
-;; *(hostname+i)='\0';
-;; break;
-;; }
-;; }
-;;
-;; if (NULL == (h = gethostbyname(hostname))) {
-;; return 1;
-;; }
-;; addr.sin_family = AF_INET;
-;; addr.sin_port = IRCPORT;
-;; bcopy(h->h_addr, (char *)&addr.sin_addr, h->h_length);
-;; bzero((char *)addr.sin_zero, sizeof(addr.sin_zero));
-;;
-;; if ( 0 > (sock = socket(AF_INET, SOCK_STREAM, 0))) {
-;; return 1;
-;; }
-;;
-;; if ( 0 > connect(sock, &addr, sizeof(addr))) {
-;; return 1;
-;; }
-;;
-;; return(0);
-;; }
-;;
-;; int clsock_(void)
-;; {
-;; close(sock);
-;; }
-;;
-;; int rdsock_(char *buf, int buflen)
-;; {
-;; int i;
-;;
-;; for (i=0; i<513; i++) {
-;; if (1 != read(sock,buf+i,1)) {
-;; return 1;
-;; }
-;; if ('\n' == *(buf+i)) {
-;; return 0;
-;; }
-;; }
-;; return 0;
-;; }
-;;
-;; int wrsock_(char *buf, int buflen)
-;; {
-;; int i;
-;;
-;; for (i=0; i<buflen; i++) {
-;; if (1 != write(sock, buf+i, 1)) {
-;; return 1;
-;; }
-;; }
-;; if (1 != write(sock, "\n", 1)) {
-;; return 1;
-;; }
-;; return 0;
-;; }
-;;
-;; ---end of file---
-;;
-;; --Ben
-;; ben@gnu.ai.mit.edu
-;; oink.
-
-;; Thanks to zenirc-trigger.el, this elisp module has been reduced to a
-;; one-liner, but the real live fortran above is too eleet to stop
-;; distributing.
-
-;;; Code:
-
-(require 'zenirc-trigger)
-
-(zenirc-trigger-register "fortran"
- "YES I AM REALLY WRITTEN IN 3L33T FORTRAN 77!!!!!!!!!111"
- "\\bfortran\\b")
-
-(provide 'zenirc-fortran)
-
-;; zenirc-fortran.el ends here
+++ /dev/null
-;;; zenirc-french.el --- French message catalog for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Nicolas Pioch <Nicolas.Pioch@enst.fr> (Nap)
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1994/02/28
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; If you're using emacs 19, loading iso-ascii.el or doing
-;; M-x standard-display-european on X displays makes 8-bit characters
-;; easier to see.
-
-;;; Code:
-
-(require 'zenirc)
-
-(zenirc-lang-define-catalog 'french
- '((join_you . "[info] Entrée dans %s.")
- (join . "[info] %s entre dans %s.")
- (s001 . "[info] Vous perdez votre temps.") ; welcome to irc message
- ;; server name & version # msg
- (s002 . "[info] Votre serveur IRC est %s, version %s.")
- (s003 . "[info] Serveur crée %s.") ; when the server was built
- ;; # users on connect message
- (s251 . "[info] %s louzeurs visibles et %s invisibles sur %s serveurs.")
- (s252 . "[info] %s crétins sont en ligne.") ; irc operators msg
- (s253 . "[info] %s connexions non identifiées.") ; unk connects msg
- (s254 . "[info] %s groupes.") ; number of channels
- ;; # of clients and servers
- (s255 . "[info] %s clients et %s serveurs connectés sur ce serveur.")
- (s301 . "[info] %s est absent: %s") ; someone is away
- (s302 . "[info] identification: %s.") ; userhost reply
- (s305 . "[info] Vous n'êtes plus marqué absent.")
- (s306 . "[info] Vous êtes marqué absent.")
- (s311 . "[info] %s (%s@%s) est %s") ; user part of /whois list
- (s312 . "[info] %s sur le serveur %s (%s)") ; server part of /whois list
- (s313 . "[info] %s est un crétin.") ; /whois operator status
- (s314 . "[info] %s (%s@%s) était %s.") ; user part of /whowas list
- (s315 . "[info] Fin de /who.") ; end of /who list replies
- (s318 . "[info] Fin de /whois.") ; end of /whois list replies
- (s317 . "[info] %s a été inactif %s") ; /whois idle time
- (s319 . "[info] %s participe à: %s") ; channel part of whois data
- (s321 . "[info] Groupes\tLouzeurs\tSujet") ; header for LIST cmd
- (s322 . "[info] %s\t%s\t%s") ; each channel in LIST cmd
- (s323 . "[info] Fin de /list.") ; trailer for LIST cmd
- (s324 . "[info] Mode de %s: %s %s.") ; channel mode
- (s331 . "[info] %s n'a pas de sujet.") ; no topic message
- (s332 . "[info] %s sujet: %s") ; topic message
- (s341 . "[info] Vous invitez %s dans %s.") ; invite reply
- (s342 . "[info] Vous incitez %s à perdre son temps.") ; summon reply
- (s351 . "[info] Version: %s %s %s.") ; version reply
- ; header for /who list reply
- (s352_header . "[info] Pseudo Etat Nom du Groupe login et machine Nom")
- (s352 . "[info] %-9s %-3s %-15s %s@%s (%s)") ; /who list reply
- (s353 . "[info] Louzeurs sur %s: %s") ; displayed after channel join
- (s364 . "[info] %s %s %s") ; /links reply
- (s365 . "[info] Fin de /links.") ; end of /links reply
- (s367 . "[info] %s interdit à %s.") ; banlist reply
- (s368 . "[info] Fin de liste d'interdiction.") ; end of banlist reply
- (s371 . "[info] %s") ; info reply
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] Message du jour:") ; start of motd
- (s376 . "[motd] Fin de message.") ; displayed at end of motd
- (s381 . "[info] Vous etes maintenant un crétin total.") ; irc op status
- (s382 . "[info] Rechargement: %s") ; rehash server msg
- (s391 . "[info] Heure sur le serveur %s: %s.") ; TIME reply
- (s392 . "[info] Login Terminal Machine") ; header for users rpl
- (s393 . "[info] %s") ; body of users rpl
- (s395 . "[info] Personne n'est connecté.") ; nobody for users rpl
- (s401 . "[info] Louzeur ou groupe inconnu: %s.") ; no such nick/chan
- (s402 . "[info] Serveur inconnu: %s.") ; there is no such server
- (s403 . "[info] Groupe inconnu: %s.") ; there is no such channel
- (s404 . "[info] Impossible d'écrire à %s.") ; can't send to channel
- (s405 . "[info] Trop de groupes: %s.") ; too many channels
- (s406 . "[info] Le serveur ne se souvient plus de %s.")
- ;; user@host
- (s407 . "[info] Destinataires dupliqués, message non envoyé: %s")
- (s411 . "[info] Destinataire manquant.") ; no recipient given
- (s412 . "[info] Texte manquant.") ; you didn't send anything.
- (s413 . "[info] Domaine manquant: %s") ; no toplevel domain spec
- (s414 . "[info] Domaine invalide: %s.") ; wild toplevel
- (s421 . "[info] Charabia: %s.")
- (s422 . "[info] Certains crétins sont trop ignorants pour créer un mot de bienvenue.")
- (s423 . "[info] Les crétins de %s sont trop ignorants pour fournir les informations administratives.")
- (s431 . "[info] Pseudonyme manquant.") ; you didn't provide a nick
- (s432 . "[info] Pseudonyme invalide: %s.") ; invalid nick
- (s433 . "[info] Pseudonyme %s déja utilisé.") ; invalid nick
- (s436 . "[info] Collision de pseudonymes: %s.") ; nickicide
- (s441 . "[info] %s n'est pas sur %s.") ; can't do it to those not present
- (s442 . "[info] Vous n'êtes pas sur %s.") ; you can't do that dave.
- (s443 . "[info] %s est déjà sur %s.") ; invite error
- (s444 . "[info] %s n'est pas connecté.") ; SUMMON reply
- (s445 . "[info] Un quelconque crétin vous refuse l'usage de /summon.")
- ;; disabld users
- (s446 . "[info] Un quelconque crétin vous refuse l'usage de /users.")
- ;; gotta do the USER NICK thing
- (s451 . "[info] Vous n'êtes pas encore enregistré.")
- (s461 . "[info] Paramètres insuffisants: %s") ; same as 421
- (s462 . "[info] Vous ne pouvez pas vous enregistrer à nouveau.")
- (s463 . "[info] Un quelconque crétin fasciste vous empêche de vous connecter.")
- (s464 . "[info] Le mot de passe ne semble pas valable.") ; bad PASS command
- (s465 . "[info] Vous n'êtes pas autorisé à utiliser ce serveur.")
- ;; chan key set already
- (s467 . "[info] Il y a déjà une clé sur %s.")
- (s471 . "[info] Impossible de rentrer sur %s (limite atteinte).")
- (s472 . "[info] Mode %s inconnu.") ; duh
- (s473 . "[info] Impossible de rentrer sur %s (sur invitation).")
- (s474 . "[info] Impossible de rentrer sur %s (interdit d'acces).")
- ;; bad key
- (s475 . "[info] Impossible de rentrer sur %s (clé invalide).")
- (s481 . "[info] Vous n'êtes pas encore assez crétin pour cela.")
- ;; chanop needed
- (s482 . "[info] Vous n'êtes pas assez puissant sur %s.")
- (s483 . "[info] Hep! Vous ne pouvez pas tuer un serveur.")
- (s491 . "[info] Pas de crétins connus sur votre site.") ; no o-line
- (s501 . "[info] Mode utilisateur inconnu.") ; you did something silly
- (s502 . "[info] Vous ne pouvez pas changer le mode de quelqu'un d'autre.")
- (ctcp_action . "[action->%s] %s %s") ; ctcp ACTION display
- (ctcp_clientinfo . "[interrogation] CLIENTINFO de %s sur %s.")
- (ctcp_errmsg . "[interrogation] ERRMSG de %s sur %s.")
- (ctcp_finger . "[interrogation] FINGER de %s sur %s.")
- (ctcp_ping . "[interrogation] PING de %s sur %s.")
- (ctcp_source . "[interrogation] SOURCE de %s sur %s.")
- (ctcp_time . "[interrogation] TIME de %s sur %s.")
- (ctcp_userinfo . "[interrogation] USERINFO de %s sur %s.")
- (ctcp_version . "[interrogation] VERSION de %s sur %s.")
- (debug . "[debug] %s") ; displayed by debugging code
- (error . "[%s] %s") ; server error message
- (invite . "[info] %s vous invite à perdre du temps sur %s.") ; invite
- (kick . "[info] %s a été éjecté de %s par %s.")
- (kick_you . "[info] Vous avez été éjecté de %s par %s.")
- (kill . "[info] Vous avez été tué: %s.") ; your time is up.
- (mode . "[info] %s a changé le mode sur %s: %s.") ; MODE change
- (nick . "[info] %s a changé de pseudo pour %s.") ; nick change
- (nosend . "[info] Pas de victime pour ce message.") ; msg not sent
- (notice . "{%s%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your nick
- (now-querying . "[info] Victime: %s.") ; /query foo
- (part_you . "[info] Départ de: %s (%s)") ; your part from channel message
- (part . "[info] %s quitte %s (%s)") ;part from channel message
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your nick
- (query . "[interrogation] de %s sur %s, contenu %s.") ; ctcp query
- (query_unknown . "commande CTCP inconnue.") ; we don't grok this
- (query_unbalanced . "[mauvaise interrogation] de %s vers %s, contenu %s.")
- (query_unbalanced_reply . "mauvaise réponse CTCP.") ; odd number of ^A's
- (quit . "[info] %s arrête de perdre du temps: %s") ; user signoff
- (reply . "[reponse] de %s sur %s, contenu %s.") ; ctcp reply
- (reply_unbalanced . "[mauvaise réponse] de %s sur %s, contenu %s.")
- (send . "(envoyé sur %s)") ; you sent a message/notice
- (send-action . "(envoyé sur %s)") ; you sent a message/notice
- (server . "[serveur] %s") ; unknown server message
- (signal . "[signal dans %s]") ; signal in echo area
- (topic . "[info] %s a changé le sujet sur %s pour: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- ))
-
-(provide 'zenirc-french)
-
-;;; zenirc-french.el ends here
+++ /dev/null
-;;; zenirc-history.el --- keep a history of commands in ZenIRC
-
-;; Copyright (C) 1996, 1998 Per Persson
-
-;; Author: Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, history
-;; Created: 96-04-11
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-\f
-(require 'zenirc)
-
-
-;; default is "/server" because that's probably the first thing you want to do
-(defvar zenirc-history-list '("/server")
- "A list of commands run by the user.")
-(make-variable-buffer-local 'zenirc-history-list)
-
-;; hairy variables to keep track of commands
-(defvar zenirc-history-list-backward nil)
-(make-variable-buffer-local 'zenirc-history-list-backward)
-(defvar zenirc-history-list-forward nil)
-(make-variable-buffer-local 'zenirc-history-list-forward)
-(defvar zenirc-history-list-current nil)
-(make-variable-buffer-local 'zenirc-history-list-current)
-
-;; reset hairy variables when a new command is sent to the server
-(defun zenirc-history-command (foo bar command)
- (setq zenirc-history-list-backward nil
- zenirc-history-list-forward nil
- zenirc-history-list-current nil
- zenirc-history-list (cons command zenirc-history-list)))
-\f
-;; step up one entry in the history list
-(defun zenirc-history-backward ()
- (interactive)
- (if (not zenirc-history-list-backward)
- ; initialize variables if their reset
- (setq zenirc-history-list-backward zenirc-history-list
- zenirc-history-list-current
- (buffer-substring zenirc-process-mark (point-max))
- zenirc-history-list-forward zenirc-history-list-forward))
- ; remove contents of line
- (beginning-of-line)
- (if (not (= (point) (point-max)))
- (delete-backward-char (- (point) (point-max))))
- ; insert previous command
- (insert (car zenirc-history-list-backward))
- ; update hairy variabels
- (setq zenirc-history-list-forward (cons
- zenirc-history-list-current
- zenirc-history-list-forward)
- zenirc-history-list-current (car zenirc-history-list-backward)
- zenirc-history-list-backward (cdr zenirc-history-list-backward)))
-
-;; step down one entry in the history list
-(defun zenirc-history-forward ()
- (interactive)
- (if (not zenirc-history-list-forward)
- ; reset variables
- (setq zenirc-history-list-backward nil
- zenirc-history-list-forward nil)
- ; remove contents of line
- (beginning-of-line)
- (if (not (= (point) (point-max)))
- (delete-backward-char (- (point) (point-max))))
- ; insert next command
- (insert (car zenirc-history-list-forward))
- ; update hairy variables
- (setq zenirc-history-list-backward (cons
- zenirc-history-list-current
- zenirc-history-list-backward)
- zenirc-history-list-current (car zenirc-history-list-forward)
- zenirc-history-list-forward (cdr zenirc-history-list-forward))))
-\f
-(provide 'zenirc-history)
-
-(zenirc-add-hook 'zenirc-send-line-hook 'zenirc-history-command)
-
-(define-key zenirc-mode-map "\M-p" 'zenirc-history-backward)
-(define-key zenirc-mode-map "\M-n" 'zenirc-history-forward)
-
-;; zenirc-history.el ends here
+++ /dev/null
-;;; zenirc-ignore.el -- ignore module for zenirc.
-
-;; Copyright (C) 1995, 1996 jason@marilyn.oit.umass.edu
-;; Copyright (C) 1995, 1996, 1998 Per Persson
-
-;; Author: Jason Bastek <jason@marilyn.oit.umass.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, ignorance
-;; Created: 96-04-11
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-\f
-
-;; usage: /ignore [string] {all,message,dcc,ctcp,notice,action}
-;; /unignore [string]
-
-(require 'zenirc)
-
-(defun zenirc-ignore-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((ignore-start-list . "[info] current ignoramuses:")
- (ignore-list . "[info] %s")
- (ignore-end-list . "[info] (end of list)")
- (ignore-new-entry . "[info] now ignoring %s")
- (ignore-bad-command . "[info] bad ignore command.")
- (ignore-bad-keyword . "[info] unknown ignore keyword: %s")
- (ignore-usage . "[info] usage: /ignore thing {all,message,dcc,ctcp,notice,action}")
- )))
-
-;; this is not buffer local by default, with zenirc-ignore.el it makes
-;; more sense to have it buffer local
-(make-variable-buffer-local 'zenirc-ignore-list)
-
-(defvar zenirc-command-ignore-hook '(zenirc-process-ignore))
-(defvar zenirc-command-unignore-hook '(zenirc-remove-from-ignore-list))
-
-(defun zenirc-process-ignore (proc parsedcmd)
- "Add someone to the list of ignoramuses."
- (let ((lst (zenirc-parse-words (cdr parsedcmd))))
- (cond ((> (length lst) 2)
- (zenirc-message proc 'ignore-bad-command))
- ((= (length lst) 2)
- (let* ((thing-to-ignore (regexp-quote (car lst)))
- (ignore-keyword (car (cdr lst)))
- (ignore-prefix
- (zenirc-ignore-determine-prefix thing-to-ignore))
- (ignore-keyword
- (zenirc-ignore-determine-keyword ignore-keyword))
- (ignore-string (concat ignore-prefix " " ignore-keyword)))
- (if (null ignore-keyword)
- (zenirc-message proc 'ignore-bad-keyword
- ignore-keyword)
- (zenirc-message proc 'ignore-new-entry ignore-string)
- (setq zenirc-ignore-list
- (cons ignore-string zenirc-ignore-list)))))
- ((= (length lst) 1)
- (zenirc-message proc 'ignore-usage))
- (t
- (zenirc-ignore-display-ignore-list proc)))))
-
-(defun zenirc-ignore-determine-prefix (str)
- "Take the first thing typed by the user at an /ignore command, and
-figure out what it's supposed to translate to. For now, this means
-that if the string doesn't look like a hostname, it's treated as a
-nickname. Otherwise, it's treated as a hostname."
- (cond ((string-match "!" str) ;; nick!user@host, don't touch it
- str)
- ((string-match "@" str)
- (concat "^:.*!.*" str))
- (t
- (concat "^:" str "!.*@.*"))))
-
-(defun zenirc-ignore-determine-keyword (str)
- "Take the second thing typed by the user at an /ignore command, and
-figure out what it translates to. For now, it can be one of:
-
- all message dcc ctcp notice action
-
-This returns nil if the keyword was unknown."
- (interactive)
- (let ((keyword
- (cond ((string= str "all") "")
- ((string= str "message") "PRIVMSG")
- ((string= str "dcc") "PRIVMSG[^:]+:\ 1DCC")
- ((string= str "ctcp") "PRIVMSG[^:]+:\ 1")
- ((string= str "notice") "NOTICE")
- ((string= str "action") "PRIVMSG[^:]+:\ 1ACTION")
- (t nil))))
- keyword))
-
-(defun zenirc-ignore-display-ignore-list (proc)
- "show the current ignore list."
- (zenirc-message proc 'ignore-start-list)
- (let ((lst zenirc-ignore-list))
- (while lst
- (progn (zenirc-message proc 'ignore-list (car lst))
- (setq lst (cdr lst))))
- (zenirc-message proc 'ignore-end-list)))
-
-;; this removes string from zenirc-ignore-list in two cases
-;; 1) if the string is an exact match
-;; 2) if the string doesn't include any special regexp chars and it is
-;; a partial match
-;; the reason to this is withheld because of two reasons
-;; 1) the explanation would be to long
-;; 2) it works
-(defun zenirc-remove-from-ignore-list (proc parsedcmd)
- "Remove someone from the ignore list."
- (let ((lst (zenirc-parse-words (cdr parsedcmd))))
- (while lst
- (let ((someone (car lst)))
- (zenirc-ignore-for-each
- zenirc-ignore-list
- '(lambda (x)
- (if (or (string-equal someone x)
- (string-match (regexp-quote someone) x))
- (setq zenirc-ignore-list (delq x zenirc-ignore-list)))))
- (setq lst (cdr lst))))
- (zenirc-ignore-display-ignore-list proc)))
-
-(defun zenirc-ignore-for-each (lst proc)
- (if lst
- (progn (funcall proc (car lst))
- (zenirc-ignore-for-each (cdr lst) proc))))
-
-(define-key zenirc-mode-map "\C-c\C-i" 'zenirc-ignore-last-sender)
-
-;; this code was originally written by
-;; Richard Todd <rmtodd@essex.ecn.uoknor.edu>
-(defun zenirc-ignore-last-sender ()
- (interactive)
- (let ((ignoree (zenirc-extract-userhost zenirc-privmsg-last-seen)))
- (zenirc-message (current-buffer) 'ignore-new-entry ignoree)
- (setq zenirc-ignore-list (cons (regexp-quote ignoree) zenirc-ignore-list))))
-
-(provide 'zenirc-ignore)
-
-(zenirc-ignore-install-message-catalogs)
-
-;; zenirc-ignore.el ends here
+++ /dev/null
-;;; zenirc-iwantop.el --- IWANTOP ctcp for granting channel operator bits
-
-;; Copyright (C) 1995 Eric Prestemon
-;; Copyright (C) 1995, 1996 Per Persson
-
-;; Author: Eric Prestemon <ecp@io.com>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, extensions
-;; Created: 1995-03-31
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-iwantop-alist nil
- "*Association list of channel names and users allowed to be channel-opped.
-That is, when someone sends you an IWANTOP ctcp, they are checked against
-this alist to see if your client should automatically op them.
-
-Each channel name and user is treated as a regular expression.
-More than one user can be listed for each channel.
-
-Here is an example:
-
- (setq zenirc-iwantop-alist
- '((\"#twilight_zone\" \"pjg@.*.buffalo.edu\" \"trillian!.*kei.com\")
- (\"#bondage\" \".*\")))
-
-This will allow anyone to be opped, anywhere:
-
- (setq zenirc-iwantop-alist '((\".*\" \".*\")))
-")
-
-; If you want ZenIRC to see other things then just IWANTOP, do stuff like
-; (setq zenirc-ctcp-query-LICKMYPENIS-hook '(zenirc-ctcp-query-IWANTOP))
-; in your .emacs or wherever.
-(defvar zenirc-ctcp-query-IWANTOP-hook '(zenirc-ctcp-query-IWANTOP))
-
-(defun zenirc-ctcp-query-IWANTOP (proc parsedctcp from to)
- (save-match-data
- (let ((case-fold-search t)
- (sender (zenirc-extract-nick from))
- (nick (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
- (channel (car (zenirc-parse-firstword (cdr parsedctcp))))
- (fmt-failed "NOTICE %s :Oink!\n")
- (fmt-sorry "NOTICE %s :Missing #channel argument!\n")
- (fmt-mode "MODE %s +o %s\n")
- (alist zenirc-iwantop-alist)
- (list nil))
-
- (and zenirc-verbose-ctcp
- (zenirc-message proc 'query nick to
- (concat (car parsedctcp) " " (cdr parsedctcp))))
-
- (cond ((or (null channel)
- (not (zenirc-channel-p channel)))
- (process-send-string proc (format fmt-sorry sender)))
- (t
- ;; Do a zenirc-downcase-name even though case-fold-search is t
- ;; because extra characters are translated to conform with
- ;; RFC1459.
- (setq channel (zenirc-downcase-name channel))
- (while alist
- (and (string-match (zenirc-downcase-name (car (car alist)))
- channel)
- (progn
- ;; skip the first elt of the car of alist, since
- ;; that's just the channel name regexp
- (setq list (cdr (car alist)))
- (setq alist nil)))
- (setq alist (cdr alist)))
-
- ;; if verbose ctcp is on, tell the user we got the query
- (if (and list (zenirc-string-match-list from list))
- (process-send-string proc (format fmt-mode channel sender))
- (process-send-string proc (format fmt-failed sender))))))))
-
-(provide 'zenirc-iwantop)
-
-;;; zenirc-iwantop.el ends here
+++ /dev/null
-;;; zenirc-klingon.el
-;;; Waste time on Internet Relay Chat with badly translated Klingon.
-
-;;; Copyright (C) 1993, 1994 Ben A. Mesander
-;;; Copyright (C) 1998 Per Persson
-
-;; Author: David M. Archer <dmarcher@gnu.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions, zenirc
-;; Created: 1995-05-07
-
-;; $Id: zenirc-klingon.el,v 1.1.1.1 1998-10-07 11:21:31 jareth Exp $
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(require 'zenirc)
-
-(zenirc-lang-define-catalog
- 'klingon
- '((s001 . "[De'] batlhlIj bIchIlqu'lI'") ; wasting time
- (s002 . "[De'] %s tengchaH QumwI'qoqvam lo' %s") ; server is
- (s003 . "[De'] %s ghItlh tengchaH QumwI'qoqvam") ; ??
- (s200 . "[De'] %s (%s) rarwI' -> %s") ; Version jangwI' from /trace
- (s202 . "[De'] %s H.S. -> %s")
- (s203 . "[De'] %s Sovbe'wI' -> IP address: %s") ; Unknown connection
- (s204 . "[De'] %s DenIb Qatlh -> %s") ; Operator connection
- (s205 . "[De'] %s lo'wI' -> %s") ; User connection
- (s206 . "[De'] %s tengchaH QumwI'qoq -> %s %s %s %s ") ; Server connection
- (s208 . "[De'] %s %s -> %s") ; New type connection
- (s209 . "[De'] %s buv -> %s = %s") ; What the classes means
- (s211 . "[De'] %s rartaH lup %s\nSent: %s/%s, Rcvd: %s/%s, SendQ: %s")
- (s212 . "[De'] %s\t->\ttimes: %s\tbytes: %s") ; Command stats
- (s213 . "[De'] C hst/nme/prt/cls: %s/%s/%s/%s") ; C-lines
- (s214 . "[De'] N hst/nme/prt/cls: %s/%s/%s/%s") ; N-lines
- (s215 . "[De'] %s host/name/class:\t%s/%s/%s") ; I-lines
- (s216 . "[De'] K host/username:\t%s/%s") ; K-lines
- (s217 . "[De'] Q %s/%s/%s/%s/%s") ; Q-lines
- (s218 . "[De'] Class: %s Ping freq: %s Conn.freq: %s Max Links: %s Sendq: %s") ; Y-lines
- (s219 . "[De'] /stats pItlh")
- (s221 . "[De'] %s soHbeHwI'")
- (s241 . "[De'] LEAF hostmask/depth:\t\t%s/%s") ; L-lines
- (s242 . "[De'] %s") ; Uptime of server
- (s243 . "[De'] O pongname/user@host:\t%s/%s") ; O-lines
- (s244 . "[De'] HUB hostmask/servername:\t%s/%s") ; H-lines
- (s251 . "[De'] naDev tengchaHmay QumwI'meyqoq %s lo'lI' lo'wI'pu' So'be' je %s lo'wI'pu' So' %s tu'lu'")
- (s252 . "[De'] naDev DenIbya'pu' Qatlh %s tu'lu'") ; # opers
- (s253 . "[De'] naDev rarwI' Sovbe' %s tu'lu'") ; # links ?
- (s254 . "[De'] naDev Se'mey %s tu'lu'") ; # channels
- (s255 . "[De'] naDev lo'WI'pu' %s je tengchaHmay QumwI'meyqoq %s tengchaH QumwI'qoqvam rartaH tu'lu'")
- (s256 . "[De'] De' loH %s:") ; /admin line 1
- (s257 . "[De'] %s") ; /admin line 2
- (s258 . "[De'] %s") ; /admin line 3
- (s259 . "[De'] %s") ; /admin line 4
- (s261 . "[De'] %s File -> %s %s") ; Logfile trace
- (s301 . "[De'] %s naDevDaq ghaHbe': %s") ; away
- (s302 . "[De'] userhost: %s") ; userhost jangwI'
- (s303 . "[De'] batlhlIj chIlqu'lI' %s") ; ison (losing honor)
- (s305 . "[De'] naDevDaq soHbe'") ; you are not here
- (s306 . "[De'] naDevDaq soH") ; you are here
- (s311 . "[De'] %s (%s@%s) %s ghaH") ; user part of /whois list
- (s312 . "[De'] %s tengchaH Qumwl'qoq lo'lI' %s (%s) ghaH")
- (s313 . "[De'] %s DenIbya' Qatlh ghaH") ; /whois operator status
- (s314 . "[De'] %s (%s@%s) %s ghaHta'law'") ; user part of /whowas list
- (s315 . "[De'] /who pItlh")
- (s317 . "[De'] %s has been idle %s") ; /whois idle time
- (s318 . "[De'] /whois pItlh")
- (s319 . "[De'] %s lo'lI' Se'mey %sghaH") ; channel part of whois data
- (s321 . "[De'] Se' lo'wI'pu' qech") ; header for LIST cmd
- (s322 . "[De'] %-15s %-5s %s") ; each channel in LIST cmd
- (s323 . "[De'] /list pItlh") ; trailer for LIST cmd
- (s324 . "[De'] %s 'oHbeHwI' %s %s") ; channel mode
- (s331 . "[De'] %s Se' 'oHbe' qech") ; no topic message
- (s332 . "[De'] %s qech: %s") ; topic message
- (s333 . "[De'] %s qech %s ghaHbeHta' %s") ; topic set time
- (s341 . "[De'] %s DarI'meH %s") ; invite
- (s342 . "[De'] %s Datlhob batlh chIl") ; summon (ask to lose honor)
- (s351 . "[De'] tengchaH QumwI'qoq lo': %s %s %s") ; version jangwI'
- (s352_header . "[De'] pong Dotlh Se' lo'wI'@'ejyo' (toghwI' chuq pong)") ; header for /who list jangwI\'
- (s352 . "[De'] %-9s %-3s %-15s %s@%s (%s)") ; /who list jangwI\'
- (s353 . "[De'] %s lo'wI'pu' %s") ; displayed after Bahnhof eintritt
- (s364 . "[De'] %s %s %s") ; /links
- (s365 . "[De'] /links pItlh") ; end of /links
- (s367 . "[De'] %s ghImwI' %s") ; banlist
- (s368 . "[De'] QonoS ghImwI' pItlh") ; end of banlist
- (s371 . "[De'] %s") ; De'
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] jabbI'ID'a' tengchaH QumwI'qoqvam:") ; start of motd
- (s376 . "[motd] motd pItlh") ; displayed at end of motd
- (s381 . "[De'] DenIbya' Qatlh soH") ; you are an oper
- (s382 . "[De'] Hujqa'lI': %s") ; rehash server msg
- (s391 . "[De'] %s tengchaH QumwI'qoqvam poH: %s") ; server's time
- (s392 . "[De'] png QumwI' 'ejDo'") ; header for users rpl
- (s393 . "[De'] %s") ; body of users rpl
- (s395 . "[De'] lo'wI'pu' pagh") ; nobody for users rpl
- (s401 . "[De'] pong joq Se' not: %s") ; there is no such pong/chan
- (s402 . "[De'] tengchaH QumwI'qoq not: %s") ; there is no such server
- (s403 . "[De'] Se' not: %s") ; there is no such Bahnhof
- (s404 . "[De'] %s DangeHlaHbe'") ; can't send to channel.
- (s405 . "[De'] tlhaqlIj chu'Ha'lu'pu': %s") ; you're on too many channels
- (s406 . "[De'] %s pong Sovbe'wI'") ; no whowas data
- (s407 . "[De'] HevwI' rap ngeHHa'lu'pu': %s") ; user@host
- (s409 . "[De'] mung nobHa'ta'") ; ping error
- (s411 . "[De'] HevwI' nobHa'ta'") ; no recipient given
- (s412 . "[De'] mu' nobHa'ta'") ; you didn't send anything.
- (s413 . "[De'] No toplevel domain: %s") ; no toplevel domain spec
- (s414 . "[De'] Wildcard in toplevel domain: %s") ; wild toplevel
- (s421 . "[De'] jIHtaHbogh naDev vISovbe': %s") ; you sent server spam
- (s422 . "[De'] motd not (DenIbya' Qatlh tIbach /admin)")
- (s423 . "[De'] loH De' not. (DenIbya' Qatlh yIchup HoH'egh)")
- (s431 . "[De'] pong not") ; you didn't provide a name
- (s432 . "[De'] pong qab: %s")
- (s433 . "[De'] pong lo'lI'vIS: %s")
- (s436 . "[De'] pong paw': %s")
- (s441 . "[De'] %s not %s") ; can't do it to those not present
- (s442 . "[De'] %s Se' Dalo'be'") ; not on channel
- (s443 . "[De'] %s lo'pa' Se' %s.") ; invite error
- (s444 . "[De'] %s naDev not") ; SUMMON jangwI\'
- (s445 . "[De'] DenIbya' Qatlh Duchaw'Ha' /summon")
- (s446 . "[De'] DenIbya' Qatlh Duchaw'Ha' /users")
- (s451 . "[De'] SuSovbe'pu'") ; gotta do the USER pong thing
- (s461 . "[De'] jIHtaHbogh naDev vISovbe': %s") ; as 421
- (s462 . "[De'] bItlhobbe' cha'logh") ; cannot USER twice
- (s463 . "[De'] DenIbya' Qatlh Dararbe'qu'") ; cannot connect
- (s464 . "[De'] jISaHbe'") ; bad PASS command
- (s465 . "[De'] DenIbya' Qatlh Dararbe'qu'") ; creep
- (s467 . "[De'] %s ngoq naDev") ; chan key set already
- (s471 . "[De'] %s Damuvbe'qu' (lo'wI' vuS)") ; too many ppl
- (s472 . "[De'] bIlughbe': %s") ; duh
- (s473 . "[De'] %s Damuvbe'qu' (rI'Se'neH)") ; fascist nerds
- (s474 . "[De'] %s Damuvbe'qu' (ghImwI')") ; you're banned
- (s475 . "[De'] %s Damuvbe'qu' (ngoq qab)") ; bad key
- (s481 . "[De'] DenIbya' Qatlh soHbe'") ; oper only
- (s482 . "[De'] verengan soHbe'") ; chanop needed
- (s483 . "[De'] nuqneH") ; can't kill a server
- (s491 . "[De'] DenIbya' Qatlhpu' naDevbe'") ; no o-line
- (s501 . "[De'] bIlughbe'") ; you did something silly
- (s502 . "[De'] bIlughbe'") ; as above
- (action . "(%s Davengta')") ; ctcp action sent
- (action-echo . "(%s Davengta')") ; ctcp action sent
- (connect-failed . "[Qagh] rarwI' mevlu'ta' %s %d not QIj: %s")
- (connect-try . "[De'] jol chu'lu' %s %d")
- (connect-abort . "[De'] rarwI' mevlu'ta'")
- (ctcp_action . "[vang->%s] %s %s") ; ctcp ACTION display
- (ctcp_clientinfo . "[yu'wI'] CLIENTINFO %s lIghaH %s")
- (ctcp_errmsg . "[yu'wI'] ERRMSG %s lIghaH %s")
- (ctcp_finger . "[yu'wI'] FINGER %s lIghaH %s")
- (ctcp_ping . "[yu'wI'] PING %s lIghaH %s")
- (ctcp_ping_reply . "[jangwI'] PING %s Duchuqlaw' lup %s")
- (ctcp_source . "[yu'wI'] SOURCE %s lIghaH %s")
- (ctcp_time . "[yu'wI'] TIME %s lIghaH %s")
- (ctcp_username . "[yu'wI'] USERNAME %s lIghaH %s")
- (ctcp_version . "[yu'wI'] VERSION %s lIghaH %s")
- (debug . "[reghuluS 'Iwghargh DaHoHlI'] %s"); displayed by debug code
- (error . "[%s] %s") ; server error message
- (invite . "[De'] %s DurI'lI' %s.") ; invite (you are being hailed)
- (join_you . "[De'] %s Damuvta'")
- (join . "[De'] %s muvta' %s")
- (kick . "[De'] %s: %s vo'ta' %s") ; someone was peeved
- (kick_you . "[De'] %s Duvo'ta' %s") ; loser
- (kill . "[De'] HovDaq lupqu'ta': %s") ; you've been killed (transported into star!)
- (mode . "[De'] %s ghaHbeHchoH %s: %s") ; MODE change
- (nick . "[De'] %s pong ghaHchoH %s") ; pong change
- (newcatalog . "[De'] vIjatlhlaH %s")
- (nocatalog . "[Qagh] vIjatlhlaHbe' %s")
- (nosend . "[De'] romuluSngan Daghajbe'") ; msg not sent
- (notice . "{%s%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your pong
- (notify_list . "[De'] QonoS ghoq: %s")
- (notify_on . "[De'] %s batlhlchaj chIlqu'lI'")
- (notify_off . "[De'] %s batlhlchaj chIlqu'lI'be'")
- (now_querying . "[De'] %s romuluSnganlI' DaghajchoH") ; /query foo
- (part_you . "[De'] %s Damejta' (%s)") ;
- (part . "[De'] %s mejta' %s (%s)") ; part from Bahnhof message
- (pong . "[De'] %s chuS") ; pong message from server
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your pong
- (protocol_violation . "[error] The following line is in violation of the IRC protocol.\n[error] Please tell the server administrator:\n%s: %s")
- (query . "[yu'wI'] %s lIghaH %s ngaSwI': %s") ; ctcp yu'wI'
- (query_unknown . "CTCP yu'wI' not")
- (query_unbalanced . "[tlhaQ Yu'WI'] %s lIghaH %s ngaSwI': %s")
- (query_unbalanced_reply . "CTCP tlhaQ Yu'WI'")
- (quit . "[De'] %s lupta': %s") ; user signoff
- (reply . "[jangwI'] %s lIghaH %s ngaSwI': %s") ; ctcp jangwI'
- (reply_unbalanced . "[tlhaQ JangwI'] %s lIghaH %s ngaSwI': %s")
- (send . "(%s DangeHta')") ; you sent a message/notice
- (send-echo . "(%s DangeHta')") ; you sent a message/notice
- (sentinel . "\nZenIRC Hegh: %s") ; process sentinel message
- (server . "[QumwI'] %s") ; unknown server message
- (signal . "[%s DurI'lI']") ; signal in echo area
- (topic . "[De'] %s choHta' qech %s: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- ))
-
-(provide 'zenirc-klingon)
-
-;;; zenirc-klingon.el ends here
-
-;;; notes:
-
-; lupta' transport (done)
-; Se' frequency
-; Se'mey frequencies
-; DenIbya' Qatlh / Denlbya'pu' Qatlh
-; naDev DenIbya'pu' Qatlh tu'lu' here (Denlbya'pu') notice(indef)
-; tengchaH space station
-; QumwI' communications device
-; qoq (so-called)
-
-; rarwI' "that which connects" link
-; Sovbe'wI' "that which is not known" unknown
-
-; tengchaH QumwI'qoq server
-; tengchaH QumwI'qoqvam this server
-; tengchaHmay Qumwl'meyqoq servers
-
-; ngeHHa'lu'pu' nothing sent.
-
-; ghaH him/her
-; lo'wI' user (one who uses) lo'wI'pu' (users)
-; pItlh done
-; ghImwI' ban (that which exiles)
-; soHbeHwI' your mode
-
-; muv join muvta' (has joined)
-
-
-;HIja' yes
-;ghobe' no
-;toH Well! Aha!
-;chay' How did this happen? / What's going on?
-;jIyajbe' I don't understand.
-;jISaHbe' I don't care.
-;qay'be' No problem!
-;tlhIngan Hol DajatIh'a' Do you speak Klingon?
-;tlhIngan Hol vIjatIhlaHbe' I cannot speak Klingon.
-;tlhIngan Hol vIjatIhlaH I can speak Klingon.
-;jIleSnIS I need rest.
-;bIleSnIS You need rest.
-;lu' Ok.
-;naDev qaS wanI' ramqu' There's nothing happening here.
-;naDev vo' yIghoS Go away!
-;nuqneH What do you want? (greeting)
-;bIjatlh' e' ylmev Shut up.
-;naDev tlhInganpu' tu'lu' There are Klingons around here.
+++ /dev/null
-;;; zenirc-latin.el --- Latin message catalog for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Richard Todd <rmtodd@servalan.servalan.com>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1994-02-28
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; "i like latin-mode, it's like operating a trojan horse or something."
-;; -- Dave Archer <dmarcher@acsu.buffalo.edu>
-
-;; "with zenirc-latin-mode, a netsplit reminds me of the part in carmina
-;; burana where everyone's drinking." -- Dave Archer
-
-;; "god, i love the latin mode.. makes me feel like caligula" -- James Price
-
-;;; Code:
-
-(require 'zenirc)
-
-(zenirc-lang-define-catalog 'latin
- '((join_you . "[info] Apud %s iniis.") ; your channel join message
- (join . "[info] %s apud %s iniit.") ; channel join message
- (s001 . "[info] Tempus tuum perdis.") ; welcome to irc message
- (s002 . "[info] Servum IRC tuum %s (%s) est.") ; server name & version #
- (s003 . "[info] Diem %s servum factum est.") ; when the server was built
- (s211 . "[info] %s connectio %s momentibus erat.\nMissi : %s/%s, Recepti: %s/%s, Mittendi: %s")
- (s212 . "[info] %s\t->\ttempus: %s\tbytes: %s") ; command stats
- (s215 . "[info] %s machina/nomen:\t%s/%s") ; I-lines
- (s216 . "[info] K machina/nomen clientis:\t%s/%s") ; K-lines
- (s219 . "[info] /stats perfectus est.") ; end of /stats
- (s221 . "[info] Tuus modus %s nunc est.") ; user mode
- (s241 . "[info] LEAF hostmask/altitudo:\t\t%s/%s") ; L-lines
- (s243 . "[info] %s cognomen/login@machina:\t%s/%s") ; O-lines or o-lines
- (s244 . "[info] HUB hostmask/nomen servi:\t%s/%s") ; H-lines
- ;; # users on connect message
- (s251 . "[info] %s clientes visibiles et %s clientes invisibles apud %s serva sunt.")
- (s252 . "[info] %s nothi pravi adsunt.") ; irc operators msg
- (s253 . "[info] %s conjunctiones incognitae sunt.") ; unk connects msg
- (s254 . "[info] %s fora sunt.") ; number of channels
- ;; # of clients and servers
- (s255 . "[info] %s clientes et %s serva huic servo loquiuntur.")
- (s256 . "[info] Descriptio procurationis %s:") ; admin info
- (s301 . "[info] %s abest: %s") ; someone is away
- (s302 . "[info] identificatio: %s.") ; userhost reply
- (s303 . "[info] Tempus perdit nunc: %s") ; ison reply
- (s305 . "[info] Nuntio te non abesse.")
- (s306 . "[info] Nuntio te abesse.")
- (s311 . "[info] %s (%s@%s) %s est.") ; user part of /whois list
- (s312 . "[info] %s apud servum %s (%s)") ; server part of /whois list
- (s313 . "[info] %s nothus pravus est.") ; /whois operator status
- (s314 . "[info] %s (%s@%s) %s erat.") ; user part of /whowas list
- (s315 . "[info] /who perfectus est.") ; end of /who list replies
- (s318 . "[info] /whois perfectus est.") ; end of /whois list replies
- (s317 . "[info] %s per %s quietus erat.") ; /whois idle time
- (s319 . "[info] %s adest in: %s") ; channel part of whois data
- (s321 . "[info] Forum\tQuot Clientes?\tRes") ; header for LIST cmd
- (s322 . "[info] %s\t%s\t%s") ; each channel in LIST cmd
- (s323 . "[info] /list perfectus est.") ; trailer for LIST cmd
- (s324 . "[info] Modus %s: %s %s.") ; channel mode
- (s331 . "[info] %s nullam rem habet.") ; no topic message
- (s332 . "[info] Res %s : %s") ; topic message
- (s341 . "[info] %s in %s invitas.") ; invite reply
- (s342 . "[info] %s tempus perdere rogas.") ; summon reply
- (s351 . "[info] Version: %s %s %s.") ; version reply
- ;; header for /who list reply
- ;; Bleah, Latin doesn't really have a good short word for 'nickname', so
- ;; we'll invent one.
- (s352_header . "[info] Cognomen Status Nomen Fori Login et Machina Nomen")
- (s352 . "[info] %-9s %-3s %-15s %s@%s (%s)") ; /who list reply
- (s353 . "[info] Homines in %s: %s") ; displayed after channel join
- (s364 . "[info] %s %s %s") ; /links reply
- (s365 . "[info] /links perfectus est.") ; end of /links reply
- (s367 . "[info] %s interdicit %s.") ; banlist reply
- (s368 . "[info] Tabula interdictionum perfecta est.") ; end of banlist
- (s371 . "[info] %s") ; info reply
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] Nuntius hodiernus:") ; start of motd
- (s376 . "[motd] Nuntius hodiernus perfectus est.") ; end of motd
- (s381 . "[info] Nunc nothus pravus est.") ; irc op status
- ;; Yeah, right, like there's a word for `rehash' in Latin.
- (s382 . "[info] Rehashit: %s")
- (s391 . "[info] Dies apud servum %s: %s.") ; TIME reply
- (s392 . "[info] Login Terminal Machina") ; header for users rpl
- (s393 . "[info] %s") ; body of users rpl
- (s395 . "[info] Nemo adest.") ; nobody for users rpl
- (s401 . "[info] %s nec cognomen nec forum est.") ; no such nick/chan
- (s402 . "[info] Servum %s nescio.") ; there is no such server
- (s403 . "[info] Forum %s nescio.") ; there is no such channel
- (s404 . "[info] %s loqui non potes.") ; you can't send to channel
- (s405 . "[info] Plura fora quam loqui potes: %s.") ; too many channels
- (s406 . "[info] %s servum nescit.") ; no whowas data
- (s407 . "[info] Receptores duplices ; nuntium non misit: %s") ; user@host
- (s411 . "[info] Nullus receptor adfuit.") ; no recipient given
- (s412 . "[info] Nullus nuntius adfuit.") ; you didn't send anything.
- (s413 . "[info] Nullum regnum supremum adfuit: %s") ; no toplevel domain
- (s414 . "[info] Regnum vitiosum est: %s.") ; wild toplevel
- (s421 . "[info] Stercus est: %s.") ; you sent server spam
- (s422 . "[info] Quidam nothus pravus imperitus est; nuntium hodiernum non fecit.")
- (s423 . "[info] Quidam nothus pravus imperitus est; procurationem non descripsit.")
- (s431 . "[info] Nullus cognomen adfuit.") ; you didn't provide a nick
- (s432 . "[info] Cognomen vitiosum est: %s.") ; invalid nick
- (s433 . "[info] Aliquis cognomen %s iam utebatur.") ; invalid nick
- (s436 . "[info] Concursus cognominum: %s.") ; nickicide
- (s441 . "[info] %s in %s non est.") ; can't do it to those not present
- (s442 . "[info] In %s non es.") ; you can't do that dave.
- (s443 . "[info] %s iam in %s est.") ; invite error
- (s444 . "[info] %s non conjunctus est.") ; SUMMON reply
- ;; disabled summon
- (s445 . "[info] Te /summon uti aliqui nothus pravus non permittit.")
- ;; disabld users
- (s446 . "[info] Te /users uti aliqui nothus pravus non permittit.")
- (s451 . "[info] Nondum perscripsit.") ; gotta do the USER NICK thing
- (s461 . "[info] Parum parameteres: %s")
- (s462 . "[info] Non perscriptere iterum potes.") ; cannot USER twice
- ;; server refuses this client
- (s463 . "[info] Te connectere aliqui nothus pravus cerritus non permittit.")
- (s464 . "[info] Tessera vitiosa est.") ; bad PASS command
- (s465 . "[info] Hoc servam uti non tibi licet.") ; creep
- (s467 . "[info] Tessera huius fori iam adest.") ; chan key set already
- (s471 . "[info] Apud %s inire non potes (plures clientes).")
- (s472 . "[info] Modum %s nescio.") ; duh
- (s473 . "[info] Apud %s inire non potes (nulla invitatio est).")
- (s474 . "[info] Apud %s inire non potes. Interdiceris.") ; you're banned
- (s475 . "[info] Apud %s inire non potes (tesseram non habes).")
- (s481 . "[info] Hic solum nothos pravos licet.") ; oper only
- (s482 . "[info] Censor %s non es.")
- (s483 . "[info] Eh! Servum caedere non potes!") ; can't kill a server
- (s491 . "[info] Nulli nothi pravi ab tua machina permissi sunt.")
- (s501 . "[info] Hanc modum nescio.") ; you did something silly
- (s502 . "[info] Modum alii mutare non potes.") ; as above
- (ctcp_action . "[actio->%s] %s %s")
- (ctcp_clientinfo . "[quaestio] CLIENTINFO ab %s ad %s.")
- (ctcp_errmsg . "[quaestio] ERRMSG ab %s ad %s.")
- (ctcp_finger . "[quaestio] FINGER ab %s ad %s.")
- (ctcp_ping . "[quaestio] PING ab %s ad %s.")
- (ctcp_ping_reply . "[reponsum] PING %s %s momentibus abest.")
- (ctcp_source . "[quaestio] SOURCE ab %s ad %s.")
- (ctcp_time . "[quaestio] TIME ab %s ad %s.")
- (ctcp_userinfo . "[quaestio] USERINFO ab %s ad %s.")
- (ctcp_version . "[quaestio] VERSION ab %s ad %s.")
- (debug . "[debug] %s") ; displayed by debugging code
- (error . "[%s] %s") ; server error message
- (invite . "[info] %s te apud %s invitat.") ; invite
- (kick . "[info] %s de %s ejectum est per %s.") ; someone was peeved
- (kick_you . "[info] De %s ejectum es per %s.") ; loser
- (kill . "[info] Caesus es: %s.") ; your time is up.
- (mode . "[info] %s modum de %s mutavit: %s") ; MODE change
- (nick . "[info] %s cognomen mutavit ad %s.") ; nick change
- (nosend . "[info] Nulla victima in nuntios habes.") ;
- (notice . "{%s%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your nick
- (notify_list . "[info] Ei quos exspectas: %s") ;
- (notify_on . "[info] %s tempus perdere videbam.") ;
- (notify_off . "[info] %s tempus perdere non iam video.") ;
- (now_querying . "[info] Victima: %s.") ; /query foo
- (part_you . "[info] Exis de: %s (%s)") ; your part from channel message
- (part . "[info] %s exiit de %s (%s)") ;part from channel message
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your nick
- (query . "[quaestio] ab %s ad %s, res %s.") ; ctcp query
- (query_unknown . "Mandatum CTCP ignotum.") ; we don't grok this
- (query_unbalanced . "[mala quaestio] ab %s ad %s, res %s.")
- (query_unbalanced_reply . "Malum reponsum CTCP.") ; odd number of ^A's
- (quit . "[info] %s tempus perdere intermisit: %s") ; user signoff
- (reply . "[reponsum] ab %s ad %s, res %s.") ; ctcp reply
- (reply_unbalanced . "[malum reponsum] ab %s ad %s, res %s.") ; weird
- (send . "(ad %s missus est)") ; you sent a message/notice
- (send-echo . "(ad %s missus est)") ; you sent a message/notice
- (server . "[servum] %s") ; unknown server message
- (signal . "[signum in %s]") ; signal in echo area
- (topic . "[info] %s res %s mutavit: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- ))
-
-(provide 'zenirc-latin)
-
-;; zenirc-latin.el ends here
+++ /dev/null
-;;; zenirc-make --- a hack to set the load path for byte-compiling
-
-;; Copyright (C) 1995, 1996 Per Persson
-
-;; Author: Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, make
-;; Created: 1995-06-26
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; Code:
-
-(setq load-path (cons "." load-path))
-
-;;; zenirc-make.el ends here
\ No newline at end of file
+++ /dev/null
-;;; zenirc-meditate.el --- admonish others for disturbing your meditation
-
-;; Copyright (C) 1995, 1997 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, extensions
-;; Created: 1995-04-09
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;; Code:
-
-(require 'zenirc-trigger)
-
-(defconst zenirc-meditate-response-percentage 1)
-
-(defconst zenirc-meditate-response-list
- '("Activity through inactivity."
- "Don't bother."
- "Enlightenment does not come from typing."
- "Enlightenment does not require a keyboard."
- "Hair will grow on your palms if you keep typing."
- "Meditate, or die."
- "Once a student typed too much and died."
- "Stop fidgeting, you're bothering the others."
- "The keyboard is sure to block your mind."
- "Will you stop the infernal racquet and meditate!?"
- "Your fingers will destroy your meditation."
- "Your keyboard is not the path to enlightenment."
- "Your typing detracts from your enlightenment."))
-
-(defun zenirc-meditate ()
- (and (< (random 1000) zenirc-meditate-response-percentage)
- (nth (random (length zenirc-meditate-response-list))
- zenirc-meditate-response-list)))
-
-(zenirc-trigger-register "meditate" 'zenirc-meditate "^.")
-
-(provide 'zenirc-meditate)
-
-;; zenirc-meditate.el ends here
+++ /dev/null
-;;; zenirc-netsplit.el --- hide excessive spew from netsplits
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1995 Noah S. Friedman
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Eric Prestemon <ecp@io.com>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, extensions
-;; Created: 1993/03/10
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This script attempts to supress excessive signon/offs and mode changes
-;; due to netsplits.
-
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-netsplit-show-server-mode-changes-p nil
- "Set to t to enable display of server mode changes.")
-
-(defvar zenirc-netsplit-debug nil
- "Set to t in order to enable debugging messages in the netsplit code")
-
-;; this is a list of the form
-;; (("a.b.c.d e.f.g" (time stamp) first-join "nick1" ... "nickn") ...)
-;; where first-join is t or nil, depending on whether or not the first
-;; join from that split has been detected or not.
-(defvar zenirc-netsplit-list nil)
-(make-variable-buffer-local 'zenirc-netsplit-list)
-
-(defvar zenirc-command-wholeft-hook '(zenirc-netsplit-wholeft))
-
-(zenirc-add-hook 'zenirc-server-JOIN-hook 'zenirc-netsplit-JOIN)
-(zenirc-add-hook 'zenirc-server-MODE-hook 'zenirc-netsplit-MODE)
-(zenirc-add-hook 'zenirc-server-QUIT-hook 'zenirc-netsplit-QUIT)
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-netsplit-timer)
-
-;; TODO: add messages for other languages
-(defun zenirc-netsplit-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((netsplit . "[info] netsplit: %s")
- (netsplit-join . "[info] netjoin: %s")
- (netsplit-wholeft . "[info] split: %s missing: %s %s")
- )))
-
-;; show/don't show rejoins
-(defun zenirc-netsplit-JOIN (proc parsedmsg)
- (let ((nick (zenirc-downcase-name (zenirc-extract-nick (aref parsedmsg 1))))
- (list zenirc-netsplit-list)
- elt)
- (while list
- (setq elt (car list))
- (setq list (cdr list))
- (if (member nick (nthcdr 3 elt))
- (progn
- (setq zenirc-run-next-hook nil)
- (if (not (car (cdr (cdr elt))))
- (progn
- (zenirc-message proc 'netsplit-join (car elt))
- (setcar (nthcdr 2 elt) t)))
- ;; need to remove this nick, perhaps the whole entry here.
- ;; Note that by removing the nick now, we can't tell if further
- ;; join messages (for other channels) should also be
- ;; suppressed.
- (if (null (nthcdr 4 elt))
- (setq zenirc-netsplit-list (delq elt zenirc-netsplit-list))
- (delete nick elt)))))))
-
-;; hide mode changes from servers
-(defun zenirc-netsplit-MODE (proc parsedmsg)
- (save-match-data
- ;; regexp matches things with a . in them, and no ! or @ in them.
- (cond ((string-match "^[^@!]+\\.[^@!]+$" (aref parsedmsg 1))
- (and zenirc-netsplit-debug
- (zenirc-message proc "[debug] server mode change.\n"))
- (or zenirc-netsplit-show-server-mode-changes-p
- (setq zenirc-run-next-hook nil))))))
-
-;; detect netsplits
-(defun zenirc-netsplit-QUIT (proc parsedmsg)
- (save-match-data
- (let* ((split (zenirc-downcase-name (aref parsedmsg 2)))
- (nick (zenirc-downcase-name (zenirc-extract-nick (aref parsedmsg 1))))
- ass)
- ;; look for arguments of the form host.name.1 host.name.2
- (if (string-match "^[^ ]+\\.[^ ]+ [^ ]+\\.[^ ]+$" split)
- (progn
- (setq zenirc-run-next-hook nil)
- (setq ass (assoc split zenirc-netsplit-list))
- (if ass
- ;; element for this netsplit exists already
- (setcdr (nthcdr 2 ass) (cons nick (nthcdr 3 ass)))
- ;; element for this netsplit does not yet exist
- (setq zenirc-netsplit-list
- (cons (list split
- (zenirc-time-to-int (current-time-string))
- nil
- nick)
- zenirc-netsplit-list))
- (zenirc-message proc 'netsplit split)))))))
-
-;; clean cruft from zenirc-netsplit-list older than 10 minutes
-(defun zenirc-netsplit-timer (proc now)
- (let ((list zenirc-netsplit-list)
- elt)
- (while list
- (setq elt (car list))
- (setq list (cdr list))
- (and (zenirc-time< '(0 600) (zenirc-time-diff now (car (cdr elt))))
- (setq zenirc-netsplit-list (delq elt zenirc-netsplit-list))))))
-
-;; show who's gone
-(defun zenirc-netsplit-wholeft (proc parsedcmd)
- (let ((list zenirc-netsplit-list)
- elt)
- (while list
- (setq elt (car list))
- (setq list (cdr list))
- (zenirc-message proc 'netsplit-wholeft
- (car elt)
- (mapconcat 'identity (nthcdr 3 elt) " ")
- (if (car (cdr (cdr elt)))
- "(joining)"
- "")))))
-
-(provide 'zenirc-netsplit)
-
-(zenirc-netsplit-install-message-catalogs)
-
-;;; zenirc-netsplit.el ends here
+++ /dev/null
-;;; zenirc-notify.el --- Notifies you when people signon/off
-
-;; Copyright (C) 1995, 1996, 1997, 1998 Per Persson
-
-;; Author: Per Persson <pp@sno.pp.se>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, notify, extensions
-;; Created: 1995-03-30
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; TODO: If notifee joins channel, don't show notification.
-
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-notify-list '()
- "*A list of nicknames that you want to watch for on IRC.")
-
-(defvar zenirc-notify-interval '(0 60)
- "*Time between ISON's sent to server.")
-
-(defvar zenirc-last-notify '(0 0)
- "Time previous ISON sent.")
-(make-variable-buffer-local 'zenirc-last-notify)
-
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-notify-timer)
-
-;; used with notify code to see if we did /ison or not
-(defvar zenirc-manual-ison nil)
-(make-variable-buffer-local 'zenirc-manual-ison)
-
-;; people you previously recieved notification of
-(defvar zenirc-previous-ison nil)
-(make-variable-buffer-local 'zenirc-previous-ison)
-
-;; should you get a user@host reply on notify?
-(defvar zenirc-userhost-on-notify t)
-(make-variable-buffer-local 'zenirc-userhost-on-notify)
-
-(defvar zenirc-userhost-by-notify nil)
-(make-variable-buffer-local 'zenirc-userhost-by-notify)
-
-(defvar zenirc-command-notify-hook '(zenirc-command-notify)
- "*Hook to call when a /notify command is issued in ZeniIRC.
-
-The syntax of the command is: /notify victim.
-This toggles the presence of `victim' in your notify-list.
-If no victim is specified, you will see your notify-list instead.")
-
-; hooks to make zenirc aware of the notify code.
-(defvar zenirc-command-ison-hook '(zenirc-command-ison))
-(defvar zenirc-command-userhost-hook '(zenirc-command-userhost))
-
-(defun zenirc-notify-install-message-catalogs ()
- (zenirc-lang-define-catalog 'english
- '((notify_list . "[info] Your current notify list: %s")
- (notify_on . "[info] detected %s wasting time.")
- (notify_off . "[info] detected that %s stopped wasting time.")
- (notify_current . "[info] Notificated people wasting time: %s")
- )))
-
-(defun zenirc-notify-timer (proc now)
- "Call zenirc-command-notify-hook with arguments that cause it to send an
-ISON message to the server. This is used to notice when people in the notify
-list have come on or off of IRC."
- (if (zenirc-time< zenirc-notify-interval
- (zenirc-time-diff now zenirc-last-notify))
- (progn
- (zenirc-run-hook 'zenirc-command-notify-hook proc
- '("notify" . "%auto"))
- (setq zenirc-last-notify now))))
-
-\f
-;; /notify handler
-;;
-;; *** NOTE ***
-;; this is also called from the zenirc event handling code
-;;
-(defun zenirc-command-notify (proc parsedcmd)
- (let ((arg (cdr parsedcmd)))
- (if (string-equal "" arg)
- ; output list of notificated people (online)
- (progn
- (if (not zenirc-previous-ison)
- (zenirc-message proc 'notify_current "")
- (zenirc-message proc 'notify_current zenirc-previous-ison))
- (zenirc-message proc 'notify_list
- (mapconcat 'identity zenirc-notify-list " ")))
- (if (not (string-match "%" arg))
- ; add or remove nick from zenirc-notify-list
- (progn
- (setq arg (zenirc-parse-words arg))
- (while arg
- (if (zenirc-string-match-list (car arg) zenirc-notify-list)
- (setq zenirc-notify-list (zenirc-delete-case-insensitive
- (car arg) zenirc-notify-list))
- (setq zenirc-notify-list (cons (car arg) zenirc-notify-list)))
- (setq arg (cdr arg)))
- ; output new list of notificated people
- (zenirc-message proc 'notify_list
- (mapconcat 'identity zenirc-notify-list " "))))
- (if zenirc-notify-list
- ; if automated, check to see if anything has changed
- (process-send-string
- proc
- (concat "ISON "
- (mapconcat 'identity zenirc-notify-list " ") "\n"))))))
-
-;; /ison nick1 [nick2 [nick3...]]
-(defun zenirc-command-ison (proc parsedcmd)
- (process-send-string proc
- (concat "ISON " (cdr parsedcmd) "\n"))
- (setq zenirc-manual-ison 1))
-
-;; /userhost nick1 [nick2 [nick3...]]
-(defun zenirc-command-userhost (proc parsedcmd)
- (process-send-string proc (concat "USERHOST " (cdr parsedcmd) "\n"))
- (setq zenirc-userhost-by-notify nil))
-
-(defun zenirc-server-303-notify (proc parsedmsg)
- (let* ((ison-list (zenirc-parse-words (aref parsedmsg 3))))
- ; check if user issued /ison and don't want the notify code to execute
- (if zenirc-manual-ison
- (progn
- (zenirc-message proc 's303 (aref parsedmsg 3))
- (setq zenirc-manual-ison nil))
- (let ((new-list ison-list)
- (old-list zenirc-previous-ison))
- ; check if a certain nick wasn't seen the last time
- (while new-list
- (if (not (member (car new-list)
- zenirc-previous-ison))
- ; check if user wants user@host displayed.
- (if zenirc-userhost-on-notify
- (progn
- (process-send-string
- proc
- (concat "USERHOST " (car new-list) "\n"))
- (setq zenirc-userhost-by-notify t))
- (zenirc-message proc 'notify_on (car new-list))))
- (setq new-list (cdr new-list)))
- ; check if a certain nick was seen the last time
- (while old-list
- (if (not (member (car old-list)
- ison-list))
- (zenirc-message proc 'notify_off (car old-list)))
- (setq old-list (cdr old-list))))
- (setq zenirc-previous-ison ison-list))))
-
-(defun zenirc-server-302-notify (proc parsedmsg)
- (if zenirc-userhost-by-notify
- ; go on, sue me for being lazy and using @ for this check.
- ; --pp
- ; if you understand why I do this check, you deserve a nice
- ; reward. took me about 10 minutes to figure it out myself.
- ; --pp
- (if (string-match "@" (aref parsedmsg 3))
- (zenirc-message proc 'notify_on (aref parsedmsg 3)))
- (zenirc-message proc 's302 (aref parsedmsg 3))))
-
-\f
-(provide 'zenirc-notify)
-
-(zenirc-notify-install-message-catalogs)
-
-(zenirc-remove-hook 'zenirc-server-303-hook 'zenirc-server-303)
-(zenirc-add-hook 'zenirc-server-303-hook 'zenirc-server-303-notify)
-(zenirc-remove-hook 'zenirc-server-302-hook 'zenirc-server-302)
-(zenirc-add-hook 'zenirc-server-302-hook 'zenirc-server-302-notify)
-
-;;; zenirc-notify.el ends here
+++ /dev/null
-;;; zenirc-oink.el --- auto-oink
-
-;; Copyright (C) 1995, 1997 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: zenirc, extensions
-;; Created: 1995-04-09
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;; Code:
-
-(require 'zenirc-trigger)
-
-(defconst zenirc-oink-response-percentage 1)
-
-(defconst zenirc-oink-response-list
- '("oink"
- "oink!"
- "oink."
- "bozoink"
- "oinkage"
- "knio"
- "you will be in your oink soon"
- "don't say oink"
- ":1 s/oink/oink oink/g; b 1"
- ;; the oink combinator
- "(define oink (lambda (oink?) ((lambda (oink) (oink? (lambda (oink!) ((oink oink) oink!)))) (lambda (oink) (oink? (lambda (oink!) ((oink oink) oink!)))))))"))
-
-(defun zenirc-oink ()
- (and (< (random 1000) zenirc-oink-response-percentage)
- (nth (random (length zenirc-oink-response-list))
- zenirc-oink-response-list)))
-
-(zenirc-trigger-register "oink" 'zenirc-oink "oink\\|knio")
-
-(provide 'zenirc-oink)
-
-;; zenirc-oink.el ends here
\ No newline at end of file
+++ /dev/null
-;;; zenirc-ojnk.el --- Send ojnks - example of adding commands to zenirc
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Maintainer: ben@gnu.ai.mit.edu
-;; Keywords: extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Examples of defining your own commands in zenirc.
-;; Modeled after ircII code by dmarcher@autarch.acsu.buffalo.edu
-
-;; /ojnk victim & /ojnkflood victim
-
-;; OJNK is the sound a PJGLET makes.
-
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-command-ojnk-hook '(zenirc-command-ojnk))
-(defvar zenirc-command-ojnkflood-hook '(zenirc-command-ojnkflood))
-
-;; /ojnk victim
-(defun zenirc-command-ojnk (proc cmd)
- (process-send-string
- proc (concat "PRIVMSG " (cdr cmd)
- " :\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\n")))
-
-;; /ojnkflood victim
-(defun zenirc-command-ojnkflood (proc cmd)
- (process-send-string
- proc (concat "PRIVMSG " (cdr cmd)
- " :\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\C-aOJNK! ^. .^\C-a\C-aOJNK! ( @ )\C-a\C-aOJNK! ojnk!\C-a\n")))
-
-(provide 'zenirc-ojnk)
-
-;;; zenirc-ojnk.el ends here
+++ /dev/null
-;;;
-;;;
-;;; zenirc-pjg.el
-;;; Automatically annoy Zen Internet Relay Chat client
-;;;
-;;; Copyright (C) 1993, 1994 Ben A. Mesander
-;;;
-;;; Author: Ben Mesander <ben@gnu.ai.mit.edu>
-;;; Maintainer: ben@gnu.ai.mit.edu
-;;; Keywords: extensions
-;;; Created: 1994/02/28
-;;;
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-;;;
-;;; Commentary:
-;;;
-;;; OJNK
-;;;
-;;;
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-pjg-interval '(0 600))
-(defvar zenirc-last-pjg '(0 0))
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-pjg)
-(defun zenirc-pjg (proc now)
- (if (zenirc-time< zenirc-pjg-interval
- (zenirc-time-diff now zenirc-last-pjg))
- (progn
- (process-send-string
- proc "PRIVMSG pjg :fascist pjg.\n")
- (setq zenirc-last-pjg now))))
-
-(provide 'zenirc-pjg)
-
-;;; zenirc-pjg.el ends here
+++ /dev/null
-;;; zenirc-popup.el --- pop up zenirc buffer window on signal
-
-;; Copyright (C) 1994, 1995 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: extensions
-;; Created: 1994-06-23
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; After loading this package, any signal detected by regexps in
-;; zenirc-signal-alist will cause zenirc to check if the message was
-;; visible in any of the windows on visible frames (or, if running emacs
-;; 18, on the single X or terminal frame it supports). If not, it splits
-;; the largest visible window (according to various parameters; see the
-;; variables below) and displays the portion of the zenirc buffer with the
-;; most recently inserted message.
-
-;; This is done rather than moving point in an existing window (if any
-;; show the zenirc buffer at all) because it is assumed that if you are
-;; elsewhere in the buffer, it is for a reason. Likewise, it doesn't take
-;; over other windows, but creates a new one.
-
-;; This functionality can be disabled at any time by disabling
-;; zenirc-popup-mode. This variable can be made buffer-local, but it is
-;; not by default.
-
-;; You can also choose to create new frames instead of splitting windows.
-
-;; Note that throughout this program, the Emacs "frame" terminology is
-;; used. Lucid never switched to the "frame" nomenclature adopted by Emacs
-;; after the two sets of sources diverged; it uses "screen" instead. To
-;; ensure that this library works in both versions, this program uses its
-;; own aliases for the various frame/screen operations. However, all
-;; variables and functions defined here use the Emacs terminology.
-
-;;; Code:
-
-\f
-(require 'zenirc)
-
-(defvar zenirc-popup-mode t
- "*If non-nil, then display buried zenirc when messages appear.")
-
-(defvar zenirc-popup-ratio 4
- "*Reciprocal proportion of a window to use up when splitting windows.
-This value should be an integer greater than zero.
-
-This variable is used to determine how much of an old window to use
-for the new one. The reciprocal is used, so a value of 1 causes the window
-to appear full-screen, 2 makes the window half of the screen, 3 makes it
-one third, etc.
-
-See the documentation for the function `zenirc-popup-window' for more info.")
-
-(defvar zenirc-popup-min-height (default-value 'window-min-height)
- "*Minimum height of popup windows, expressed as an integer.
-When splitting windows, zenirc-popup-ratio is used to determined its size.
-However, the actual height of the new window will be no less than the
-number of lines specified by zenirc-popup-min-height or window-min-height,
-whichever is larger.
-
-If pop-up-windows is nil, no windows will pop up at all.
-
-See the documentation for the function `zenirc-popup-window' for more info.")
-
-(defvar zenirc-popup-available-frames 'visible
- "*Value used to determine which frames to search for buffer windows.
-
-This variable determines which frames will be searched to see if a
-buffer is already visible in a window. It may be set as follows:
-
-* If `t', then search all frames.
-* If `nil', search only current frame.
-* If `visible', search all frames which are visible
- (i.e. not iconified or completely obscured).
-* If `0', search all visible or iconified frames.
-* If set to a specific frame object, consider only that frame.
- This is useful if you have a dedicated frame for that process.
-
-Multiple frames only exist in emacs 19; if using emacs 18, the value of
-this variable doesn't matter.")
-
-(defvar zenirc-popup-make-new-frames nil
- "*If `t' and it is possible to make a new frame to display buffer, do so.
-The following conditions must be met in order to make a new frame:
-
-* Both this variable and `pop-up-frames' must be non-`nil'.
-* No other frame must currently have a window displaying the end of
- process output for the buffer in question.
-* It must be possible to create new frames, i.e. in a window system
- and in a version of emacs which supports multiple frames.
-
-If you enable the creation of new frames, you may also want to set
-`zenirc-popup-available-frames' to `t' or `visible' so all interesting frames
-can be searched first.")
-
-\f
-(defun zenirc-popup-mode (&optional prefix)
- "Enable or disable window popups for a zenirc buffer.
-
-A negative prefix argument disables this mode.
-No argument or any non-negative argument enables it.
-
-The user may also enable or disable this mode simply by setting the
-variable of the same name.
-
-This function does nothing to install window-popups for any process; it
-only determines whether the popup routines will do anything if installed."
- (interactive "P")
- (setq zenirc-popup-mode (>= (prefix-numeric-value prefix) 0))
- (cond ((not (interactive-p)))
- (zenirc-popup-mode
- (message "zenirc-popup-mode is enabled"))
- (t
- (message "zenirc-popup-mode is disabled")))
- zenirc-popup-mode)
-
-\f
-(defun zenirc-popup (object &optional mark)
- "Find a window displaying buffer with output from a process, or create one.
-The following describes the arguments to this function:
-
-* OBJECT (required)
- A process object, a buffer, or a buffer name. If a process, the process
- should have a buffer associated with it where its output normally goes.
-
-* MARK (optional)
- A marker or a symbol of a variable containing a marker representing the
- end of the process output, which indicates what portion of the buffer it
- is desirable to see.
- Usually this will be the process-mark for the process associated with
- OBJECT; that is the default if not specified. If no process exists for
- OBJECT and no marker is specified, the default is the end of the buffer
- associated with OBJECT.
- If MARK is a symbol, it may be a buffer-local variable containing some
- other arbitrary marker that will be assumed to be the end marker for that
- buffer. This may be useful if you have buffers used to interact with a
- process, but which isn't the primary \"process buffer\".
-
-If no windows currently display the relevant buffer, or some do but the
-point of insertion for new output isn't visible in them (perhaps because
-the window is scrolled to a prior region), zenirc-popup finds the largest
-visible window and splits it, putting the buffer in the new window at a
-point showing the new text.
-
-`zenirc-popup-ratio' is used to determine how much of the old window to use
-for the creation of a new one. However, the actual height of the new
-window will be no less than the number of lines specified by
-`zenirc-popup-min-height' or `window-min-height', whichever is larger.
-
-If `pop-up-windows' or `zenirc-popup-mode' are nil, no windows will pop up.
-The former is an emacs-wide variable; the latter affects only this function."
- (let* ((orig-window (selected-window))
- (orig-buffer (current-buffer))
- (proc (cond ((processp object)
- object)
- ((or (bufferp object)
- (stringp object))
- (get-buffer-process object))))
- (buffer (cond ((processp object)
- (process-buffer object))
- ((bufferp object)
- object)
- ((stringp object)
- (get-buffer object))))
- marker pop-up-p found)
-
- (unwind-protect
- (progn
- ;; marker symbol, zenirc-popup-mode, and other zenirc-*
- ;; parameters may be buffer-local, so do everything in the
- ;; context of the potential buffer to be popped.
- (set-buffer buffer)
-
- (setq pop-up-p (and zenirc-popup-mode pop-up-windows))
- (setq marker (cond ((null mark)
- (process-mark proc))
- ((markerp mark)
- mark)
- ((symbolp mark)
- (symbol-value mark))
- (t
- (point-max))))
-
- (cond
- (pop-up-p
- (walk-windows (function (lambda (win)
- (and (not found)
- (eq (window-buffer win) buffer)
- (<= marker (window-end win))
- (>= marker (window-start win))
- (setq found t))))
- nil zenirc-popup-available-frames)
-
- (cond
- ((and (not found)
- zenirc-popup-make-new-frames
- window-system
- (boundp 'pop-up-frames)
- pop-up-frames
- (fboundp 'zenirc-make-frame))
- (zenirc-popup-frame buffer marker))
- ((not found)
- (zenirc-popup-window buffer marker))))))
- (select-window orig-window)
- (set-buffer orig-buffer))))
-
-;; This function should only be called when the popup-buffer is
-;; current; otherwise, buffer-local zenirc-* parameters may not be in
-;; effect when referenced.
-(defun zenirc-popup-window (buffer marker)
- (let* ((bigwin (if (fboundp 'zenirc-make-frame)
- (get-largest-window zenirc-popup-available-frames)
- (get-largest-window)))
- (min-height (max window-min-height
- zenirc-popup-min-height))
- (ratio (cond
- ((and (natnump zenirc-popup-ratio)
- (> zenirc-popup-ratio 0))
- zenirc-popup-ratio)
- ;; Choose some ratio too big to be useful.
- (t (window-height bigwin)))))
-
- (split-window bigwin
- (min (- (window-height bigwin) min-height)
- (- (window-height bigwin)
- (/ (window-height bigwin) ratio))))
-
- (select-window (next-window bigwin 'no-minibuf))
- ;; Must use switch-to-buffer to make permanent selection of buffer
- ;; to display in new window.
- (switch-to-buffer buffer)
- (goto-char marker)
- (recenter -1)))
-
-(defun zenirc-popup-frame (buffer marker)
- (let ((frame (zenirc-make-frame))
- (orig-frame (zenirc-selected-frame)))
- (zenirc-select-frame frame)
- (set-buffer buffer)
- (goto-char marker)
- (recenter -1)
- (zenirc-select-frame orig-frame)))
-
-(defun zenirc-signal-popup (proc string)
- (let ((orig-buffer (current-buffer))
- marker)
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (setq marker zenirc-process-mark))
- (set-buffer orig-buffer))
- (zenirc-popup proc marker)))
-
-\f
-;;; Ensure smooth operation in both Emacs and XEmacs/Lucid.
-;;; Don't just alias frame equivalent functions because that may
-;;; potentially confuse other programs.
-
-(cond ((fboundp 'make-frame)
- ;; Emacs 19
- (defalias 'zenirc-make-frame 'make-frame)
- (defalias 'zenirc-select-frame 'select-frame)
- (defalias 'zenirc-selected-frame 'selected-frame))
-
- ((fboundp 'make-screen)
- ;; XEmacs
- (defalias 'zenirc-make-frame 'make-screen)
- (defalias 'zenirc-select-frame 'select-screen)
- (defalias 'zenirc-selected-frame 'selected-screen)))
-
-(provide 'zenirc-popup)
-
-(zenirc-add-hook 'zenirc-signal-hook 'zenirc-signal-popup)
-
-;; zenirc-popup.el ends here
+++ /dev/null
-;;; zenirc-prime-p.el --- flag prime numbers
-
-;; Copyright (C) 1997, 1998 Ray Jones
-
-;; Author: Ray Jones <rjones@pobox.com>
-;; Maintainer: rjones@pobox.com
-;; Keywords: zenirc, extensions, oink, "mmmm, primes"
-;; Created: 1997-11-13
-
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary: mmm, primes
-
-;;; Code:
-
-(require 'zenirc)
-(require 'zenirc-trigger)
-
-;; the method to find primes isn't fancy, just the sieve of erasthonese
-
-(defvar *zenirc-prime-list* '(2)
- "List of numbers already determined to be prime.")
-(defvar *zenirc-prime-list-end* *zenirc-prime-list*
- "Last pair in *zenirc-prime-list*, kept for efficiency reasons.")
-
-(defconst *zenirc-recent-count* 10
- "Number of primes to remember in *zenirc-recent-primes*.")
-(defvar *zenirc-recent-primes* (make-list *zenirc-recent-count* 0)
- "Primes recently seen, kept to keep from flagging the same prime over and over.")
-
-(defvar *zenirc-next-test* 3
- "Smallest number not yet tested for insertion into *zenirc-prime-list*.")
-
-;; lest this get really out of control
-(defconst *zenirc-max-to-store* 10000
- "Maximum value to ever insert into *zenirc-prime-list*.")
-
-(defun zenirc-primep (n)
- (if (< n *zenirc-max-to-store*)
- (if (<= *zenirc-next-test* n)
- (zenirc-expand-prime-list n)
- (member n *zenirc-prime-list*))
- (let ((test-limit (truncate (sqrt n)))
- (l *zenirc-prime-list*)
- (lastmod 1))
- ;; if *zenirc-max-to-store* is less than (sqrt most-positive-fixnum),
- ;; this could expand the list more than *zenirc-max-to-store* should
- ;; allow.
- (zenirc-expand-prime-list test-limit)
- (while (and l
- (not (= lastmod 0))
- (<= (car l) test-limit))
- (setq lastmod (mod n (car l)))
- (setq l (cdr l)))
- (not (= lastmod 0)))))
-
-(defun zenirc-expand-prime-list (n)
- (while (<= *zenirc-next-test* n)
- (let ((test-limit (truncate (sqrt *zenirc-next-test*)))
- (l *zenirc-prime-list*)
- (lastmod 1))
- (while (and (not (= lastmod 0))
- (<= (car l) test-limit))
- (setq lastmod (mod *zenirc-next-test* (car l)))
- (setq l (cdr l)))
- (if (not (= lastmod 0))
- (progn
- (setcdr *zenirc-prime-list-end* `(,*zenirc-next-test*))
- (setq *zenirc-prime-list-end* (cdr *zenirc-prime-list-end*)))))
- (setq *zenirc-next-test* (+ 1 *zenirc-next-test*)))
- (= (car *zenirc-prime-list-end*) n))
-
-
-(defun zenirc-primep-filter (str)
- (let ((num (string-to-int str)))
- (if (and (not (member num *zenirc-recent-primes*))
- (zenirc-primep num))
- (progn
- (setq *zenirc-recent-primes* (cons num *zenirc-recent-primes*))
- (setcdr (nthcdr (- *zenirc-recent-count* 1) *zenirc-recent-primes*) nil)
- (format "%s is prime." str))
- nil)))
-
-(zenirc-trigger-register "primep" 'zenirc-primep-filter
- "[1-9][0-9][0-9][0-9]*" t)
-
-;;; zenirc-prime-p.el ends here.
-
+++ /dev/null
-;;; zenirc-random-away.el
-
-;; Copyright (C) 1995 Eric Prestemon
-
-;; Author: Eric Prestemon <ecp@io.com>
-;; Maintainer: eric@american.edu
-;; Keywords: zenirc, extensions
-;; Created: 1995-01-04
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-random-away-strings
- '("I've felt better, but it cost more."
- "I want to be the one with the most cake."
- "Someday you will ache like I ache."
- "Do you have the time to listen to me whine?"
- "Neurotic in my head no doubt about it."
- "Oh what a feeling when we're dancing on the ceiling."
- "What's so funny about peace, love, and understanding?")
- "*List of strings to use for /away messages")
-
-(defun zenirc-random-away (proc parsedmsg)
- "Change away message to a new thing."
- (and (not (zenirc-channel-p (aref parsedmsg 2)))
- (process-send-string proc
- (concat "AWAY :"
- (nth (random (length zenirc-random-away-strings))
- zenirc-random-away-strings)
- "\n"))))
-
-(zenirc-add-hook 'zenirc-server-PRIVMSG-hook 'zenirc-random-away t)
-
-(provide 'zenirc-random-away)
-
-;;; zenirc-random-away.el ends here
+++ /dev/null
-;;;
-;;;
-;;; zenirc-random-nick.el --- Choose random nicks for ZenIRC
-
-;;; Copyright (C) 1994 Ben A. Mesander
-;;; Copyright (C) 1994, 1996, 1997 Per Persson
-
-;;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;;; Per Persson <pp@sno.pp.se>
-;;; Maintainer: pp@sno.pp.se
-;;; Keywords: extensions
-;;; Created: Sun Aug 14 20:20:05 MDT 1994
-
-;;; This program 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.
-;;;
-;;; This program 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 this program; if not, you can either send email to this
-;;; program's maintainer or write to: The Free Software Foundation,
-;;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;;; This is really annoying.
-
-;;; Code:
-
-(require 'zenirc)
-
-(random t)
-
-;; note- the rfc lies about valid characters in nicks.
-;; it appears the allowed character set is:
-;; [0-9][A-^][a-|] and - and _
-;; 0-9 and - cannot start a nick
-
-(defun zenirc-random-nick-char ()
- (let ((c (abs (random 69)))) ; mmm, 69
- (cond ((= 0 c) "_")
- ((< c 10) (char-to-string (+ c 47))) ; 0-9
- ((< c 40) (char-to-string (+ c 55))) ; A-^
- (t (char-to-string (+ c 57)))))) ; a-|
-
-(defun zenirc-random-nick-string (numchars)
- (let ((i 1) (str (zenirc-random-nick-char)))
- (if (< numchars 0)
- ""
- (while (and (< (string-to-char str) 58) ; can't start with
- (> (string-to-char str) 47)) ; [0-9]
- (setq str (zenirc-random-nick-char)))
- (while (< i numchars)
- (setq str (concat str (zenirc-random-nick-char)))
- (setq i (1+ i)))
- str)))
-
-(defun zenirc-random-nick ()
- (setq zenirc-nick (zenirc-random-nick-string 9)))
-\f
-;;; Code to automatically change nickname every now and then, this is
-;;; _really_ annoying. mmm, annoying code.
-;;;
-;;; <poxaV> yes, i agree, it's annoying.
-;;;
-(defvar zenirc-change-nick-interval '(0 600)
- "How often to change your random nickname. The default is 600
-seconds or 10 minutes.")
-(make-variable-buffer-local 'zenirc-change-nick-interval)
-
-(defvar zenirc-last-nick-change '(0 0)
- "The time the last change was made in a ZenIRC buffer.")
-(make-variable-buffer-local 'zenirc-last-nick-change)
-
-;; Should this really be optional? B-)
-(defvar zenirc-change-nick-mode nil
- "If zenirc-random-nick should change nickname automatically.")
-(make-variable-buffer-local 'zenirc-change-nick-mode)
-
-(defun zenirc-change-random-nick (proc now)
- "Change nickname in the specified process PROC every
-zenirc-change-nick-interval seconds."
- (if zenirc-change-nick-mode
- (if (zenirc-time< zenirc-change-nick-interval
- (zenirc-time-diff now zenirc-last-nick-change))
- (progn
- (process-send-string proc (concat
- "NICK "
- (zenirc-random-nick-string 9)
- "\n"))
- (setq zenirc-last-nick-change now)))))
-\f
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-change-random-nick)
-(zenirc-add-hook 'zenirc-mode-hook 'zenirc-random-nick)
-
-(provide 'zenirc-random-nick)
-
-;;; End of zenirc-random-nick.el
+++ /dev/null
-;;; zenirc-signal.el --- Fancy signal formatting for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1998 Per Persson
-
-;; Author: Mark Bailen <msbailen@msbdcolka.cr.usgs.gov>
-;; Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This code detects if the message that triggered the signal was
-;; a PRIVMSG, and if so, formats it differently. Otherwise, it calls
-;; the regular zenirc-signal-hook subroutine(s).
-
-;;; Code:
-
-(require 'zenirc)
-
-(defun zenirc-signal-privmsg (proc msg)
- (let ((pmsg (zenirc-parse-server-message msg)))
- (cond ((string= "PRIVMSG" (aref pmsg 0))
- (zenirc-message nil "[%s] %s->%s: %s"
- (buffer-name)
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref pmsg 1))
- (aref pmsg 2)
- (aref pmsg 3))
- (setq zenirc-run-next-hook nil)))))
-
-(provide 'zenirc-signal)
-
-(zenirc-add-hook 'zenirc-signal-hook 'zenirc-signal-privmsg)
-
-;; zenirc-signal.el ends here
+++ /dev/null
-;;; zenirc-stamp.el --- timestamping for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Maintainer: ben@gnu.ai.mit.edu
-;; Keywords: extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; This code is meant as a demonstration of how to use the ZenIRC
-;; hook mechanism and timer code to cause ZenIRC to do something at a
-;; regular interval.
-
-;;; Code:
-
-(require 'zenirc)
-
-(defvar zenirc-timestamp-interval '(0 600)
- "How often to insert timestamps into the ZenIRC buffer. The default
-is 600 seconds or 10 minutes. The value of this variable is a 32 bit
-integer, expressed as a list of two 16 bit values, ie, the default
-value of 600 seconds is expressed as (0 600).")
-
-(defvar zenirc-last-timestamp '(0 0)
- "The time the last timestamp was inserted into the ZenIRC buffer.
-You shouldn't have to frob this yourself.")
-
-(defun zenirc-timestamp (proc now)
- "Insert a timestamp into the the ZenIRC buffer specified by the
-process PROC every zenirc-timestamp-interval seconds."
- (if (zenirc-time< zenirc-timestamp-interval
- (zenirc-time-diff now zenirc-last-timestamp))
- (progn
- (zenirc-message proc (concat "[time] " (current-time-string) "\n"))
- (setq zenirc-last-timestamp now))))
-
-(provide 'zenirc-stamp)
-
-(zenirc-add-hook 'zenirc-timer-hook 'zenirc-timestamp)
-
-;; zenirc-stamp.el ends here
+++ /dev/null
-;;; zenirc-swedish.el --- Swedish message catalog for ZenIRC
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1993, 1994, 1995, 1996, 1998 Per Persson
-
-;; Author: Per Persson <pp@sno.pp.se>
-;; Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions
-;; Created: 1993/06/03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; "it's like operating a nazi sub or something."
-;; --Ben A. Mesander <ben@gnu.ai.mit.edu>
-
-;; If you're using emacs 19, loading iso-ascii.el or doing
-;; M-x standard-display-european on X displays makes 8-bit characters
-;; easier to see.
-
-;;; Code:
-
-(require 'zenirc)
-
-(zenirc-lang-define-catalog
- 'swedish
- '((join_you . "[info] Du deltar nu i mötet: %s")
- (join . "[info] %s deltar nu i mötet %s")
- (s001 . "[info] Du kastar bort tid.") ; welcome to irc message
- ;; server name & version # msg
- (s002 . "[info] Din IRK server är %s och kör IRKD version %s")
- ;; when the server was built
- (s003 . "[info] Den här IRK servern skapades %s")
- ;; # users on connect message
- (s251 . "[info] Det finns %s synliga och %s osynliga klienter på %s serverar.")
- (s200 . "[info] %s Länk -> version: %s") ; Version reply from /trace
- (s202 . "[info] %s H.S. -> %s") ; Trace handshake
- (s203 . "[info] %s Hmmm -> IP address: %s") ; Unknown connection
- (s204 . "[info] %s Oper -> %s") ; Operator connection
- (s205 . "[info] %s Klie -> %s") ; User connection
- (s206 . "[info] %s Serv -> %s %s %s %s ") ; Server connection
- (s208 . "[info] %s %s -> %s") ; New type connection
- (s209 . "Klas -> %s = %s") ; What the classes means
- ;; Linkinfo
- (s211 . "[info] %s länk har varit uppe %s sekunder\nSänt %s/%s, Mottagit %s/%s, SändKö: %s")
- (s212 . "[info] %s\t->\tgånger: %s\tbytes: %s") ; Command stats
- (s213 . "[info] C msk/nam/prt/kls: %s/%s/%s/%s") ; C-lines
- (s214 . "[info] N msk/nam/prt/kls: %s/%s/%s/%s") ; N-lines
- (s215 . "[info] %s maskin/namn:\t%s/%s") ; I-lines
- (s216 . "[info] K maskin/användarnamn:\t%s/%s") ; K-lines
- (s217 . "[info] Q %s/%s/%s/%s/%s") ; Q-lines
- ;; Y-lines
- (s218 . "[info] Klass: %s Ping frek: %s Länk frek: %s Max länkar: %s SändKö: %s")
- (s219 . "[info] Slut på /stats.") ; End of /stats I guess
- (s221 . "[info] Din nuvarande status är: %s") ; user mode
- (s241 . "[info] LÖV maskinmask/djup:\t\t%s/%s") ; L-lines
- (s242 . "[info] %s") ; Uptime of server
- (s243 . "[info] %s smeknamn/användare@maskin:\t%s/%s") ; O- or o-lines
- (s244 . "[info] GREN maskinmask/servernamn:\t%s/%s") ; H-lines
- ;; # users on connect message
- (s251 . "[info] Det finns %s synliga och %s osynliga klienter på %s serverar.")
- (s252 . "[info] Det finns %s verkliga nollor aktiva.") ; irc operators msg
- (s253 . "[info] Det finns %s okända uppkopplingar.") ; unk connects msg
- (s254 . "[info] Det finns %s möten.") ; number of channels
- ;; # of clients and servers
- (s255 . "[info] Det finns %s klienter och %s servrar uppkopplade till den här servern.")
- (s256 . "[info] Administrativ information för %s:") ; /admin line 1
- (s257 . "[info] %s") ; line 2 of admin information
- (s258 . "[info] %s") ; line 3 of admin information
- (s259 . "[info] %s") ; line 4 of admin information
- (s261 . "[info] %s Fil -> %s %s") ; Logfile trace
- (s301 . "[info] %s är borta: %s") ; someone is away
- (s302 . "[info] användaraddress: %s") ; userhost reply
- (s303 . "[info] ` %s' slösar för närvarande tid.")
- (s305 . "[info] Du är nu tillbaka.")
- (s306 . "[info] Du är borta.")
- (s311 . "[info] %s (%s@%s) är %s") ; user part of /whois list
- ;; server part of /whois list
- (s312 . "[info] %s använder servern %s (%s)")
- (s313 . "[info] %s är en verklig nolla.") ; /whois operator status
- (s314 . "[info] %s (%s@%s) var %s") ; user part of /whowas list
- (s315 . "[info] Slut på /who") ; end of /who list replies
- (s318 . "[info] Slut på /whois") ; end of /whois list replies
- (s317 . "[info] %s har varit inaktiv %d") ; /whois idle time
- (s319 . "[info] %s är på: %s") ; channel part of whois data
- (s321 . "[info] Möte\tAnvändare\tRubrik") ; header for LIST cmd
- (s322 . "[info] %s\t%s\t%s") ; each channel in LIST cmd
- (s323 . "[info] Slut på /list") ; trailer for LIST cmd
- (s324 . "[info] Status för %s är %s %s") ; channel mode
- (s331 . "[info] %s har ingen rubrik.") ; no topic message
- (s332 . "[info] %s rubrik: %s") ; topic message
- (s341 . "[info] Du inbjuder %s till %s") ; invite reply
- (s342 . "[info] Du ber %s att kasta bort tid.") ; summon reply
- (s351 . "[info] Version: %s %s %s") ; version reply
- ;; header for /who list reply
- (s352_header . "[info] Smeknamn Stat Namn av Möte Användare@adress Namn")
- (s352 . "[info] %-9s %-3s %-15s %s@%s (%s)") ; /who list reply
- (s353 . "[info] Klienter på %s: %s") ; displayed after channel join
- (s364 . "[info] %s %s %s") ; /links reply
- (s365 . "[info] slut på /links") ; end of /links reply
- (s367 . "[info] %s portningar %s") ; banlist reply
- (s368 . "[info] slut på portningslistan.") ; end of banlist reply
- (s371 . "[info] %s") ; info reply
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] Dagens meddelande:") ; start of motd
- (s376 . "[motd] Slut på dm.") ; displayed at end of motd
- (s381 . "[info] Du är nu en verklig nolla.") ; irc op status
- (s382 . "[info] Åter brädgårdar: %s") ; rehash server msg
- (s391 . "[info] Lokal tid på servern %s är: %s") ; TIME reply
- (s392 . "[info] Användar# Terminal Address") ; header for users rpl
- (s393 . "[info] %s") ; body of users rpl
- (s395 . "[info] Ingen är påloggad.") ; nobody for users rpl
- ;; there is no such nick/chan
- (s401 . "[info] Det finns inget sådant smeknamn/möte: %s")
- (s402 . "[info] Ingen server med det namnet: %s") ; no such server
-
- (s403 . "[info] Inget möte med det namnet: %s") ; no such channel
- (s404 . "[info] Du kan inte sända till %s") ; can't send to channel
- (s405 . "[info] Du deltar redan i tio möten: %s") ; too many channels
- ;; no whowas data
- (s406 . "[info] Något sådant smeknamn finns inte i serverns databas: %s")
- ;; user@host
- (s407 . "[info] Dubbla mottagare. Inget meddelande sänt: %s")
- (s409 . "[info] Ingen sändare given.") ; ping error reply
- (s411 . "[info] Ingen mottagare given.") ; no recipient given
- (s412 . "[info] Ingen text att sända.") ; you didn't send anything.
- (s413 . "[info] Ingen toppnivå domain: %s") ; no toplevel domain spec
- (s414 . "[info] Jokertecken i toppnivå domain: %s")
- (s421 . "[info] Det här ser ut som nonsens för mig: %s")
- (s422 . "[info] Någon verklig nolla har inte tillräckligt hög IQ för att ha en dm fil.")
- (s423 . "[info] Någon verklig nolla på %s är ignorant nog att inte lägga upp administrations info.")
- (s431 . "[info] Inget smeknamn givet.") ; you didn't provide a nick
- (s432 . "[info] Ogiltigt smeknamn: %s") ; invalid nick
- (s433 . "[info] Smeknamnet %s används redan.") ; invalid nick
- (s436 . "[info] Smeknamns kollision: %s") ; nickicide
- ;; can't do it to those not present
- (s441 . "[info] %s är deltar inte i %s")
- (s442 . "[info] Du är deltar inte i %s") ; you can't do that dave.
- (s443 . "[info] %s deltar redan i mötet %s") ; invite error
- (s444 . "[info] %s är inte påloggad.") ; SUMMON reply
- (s445 . "[info] Någon verklig nolla låter dig inte använda /summon")
- (s446 . "[info] Någon verklig nolla låter dig inte använda /users")
- (s451 . "[info] Du har inte registrerat dig.")
- (s461 . "[info] Inte nog med parametrar: %s") ; as 421
- (s462 . "[info] Du får inte registrera dig flera gånger.")
- (s463 . "[info] Någon fascistisk nolla låter dig inte koppla upp dig.")
- (s464 . "[info] Passordet är inkorrekt.") ; bad PASS command
- (s465 . "[info] Du är inte omtyckt på den här server, byt genast ditt kräk.")
- ;; chan key set already
- (s467 . "[info] Nyckeln är redan satt för %s")
- ;; too many ppl
- (s471 . "[info] Du kan inte delta i %s (användar antalet överskridit).")
- (s472 . "[info] %s är en okänd status flagga.") ; duh
- (s473 . "[info] Du kan inte delta i %s (måste vara inbjuden).")
- (s474 . "[info] Du kan inte delta i %s (portad).") ; you're banned
- (s475 . "[info] Du kan inte delta i %s (fel kanal nyckel).") ; bad key
- (s481 . "[info] Du är inte en verklig nolla.") ; oper only
- (s482 . "[info] Du är inte nog mäktig att %s") ; chanop needed
- ;; can't kill a server
- (s483 . "[info] Blä, du kan inte döda en server.")
- ;; no o-line
- (s491 . "[info] Inga verkliga nollor tillåtna från din address.")
- (s501 . "[info] Okänd klient status flagga.")
- (s502 . "[info] Kan inte ändra status för andra klienter.")
- (action . "(skickat till %s=")
- (action-echo . "(skickat till %s)")
- (ctcp_action . "[action->%s] %s %s")
- (ctcp_clientinfo . "[fråga] CLIENTINFO från %s till %s")
- (ctcp_errmsg . "[fråga] ERRMSG från %s till %s")
- (ctcp_finger . "[fråga] FINGER från %s till %s")
- (ctcp_ping . "[fråga] PING från %s till %s")
- (ctcp_source . "[fråga] SOURCE från %s till %s")
- (ctcp_time . "[fråga] TIME från %s till %s")
- (ctcp_userinfo . "[fråga] USERINFO från %s till %s")
- (ctcp_version . "[fråga] VERSION från %s till %s")
- (debug . "[debug] %s") ; displayed by debugging code
- (error . "[%s] %s") ; server error message
- (invite . "[info] %s tycker att du borde komma till %s") ; invite
- (kick . "[info] %s har blivit sparkad från %s av %s")
- (kick_you . "[info] Du har blivit sparkad från %s av %s")
- (kill . "[info] Du har blivit mördad: %s") ; your time is up.
- (mode . "[info] %s har ändrat statusen för %s: %s") ; MODE change
- (nick . "[info] %s har bytt smeknamn till %s") ; nick change
- (nosend . "[info] du har inget nuvarande offer att sända till.")
- (notice . "{%s%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your nick
- (notify_list . "[info] Din nuvarande radar lista: %s")
- (notify_on . "[info] Aha! %s slösar viktig tid.")
- (notify_off . "[info] Aha! %s slutade slösa viktig tid.")
- (now-querying . "[info] Nuvarande offer är %s") ; /query foo
- (part_you . "[info] Lämnar: %s (%s)") ; your part from channel message
- (part . "[info] %s har lämnat %s (%s)") ; part from channel message
- (pong . "[info] %s säger ojnk.")
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your nick
- (query . "[fråga] från %s till %s innehållande %s") ; ctcp query
- (query_unknown . "är en okänd CTCP fråga.")
- (query_unbalanced . "[OBALANCERAD fråga] från %s till %s innehållande %s")
- (query_unbalanced_reply . "är en obalancerad CTCP fråga.")
- (quit . "[info] %s slutade slösa viktig tid: %s") ; user signoff
- (reply . "[svar] från %s till %s innehållande %s") ; ctcp reply
- (reply_unbalanced . "[OBALANCERAT svar] från %s till %s innehållande %s")
- (send . "(skickat till %s)") ; you sent a message/notice
- (send-echo . "(skickat till %s)") ; you sent a message/notice
- (server . "[server] %s") ; unknown server message
- (signal . "[signal i %s]") ; signal in echo area
- (topic . "[info] %s bytte rubriken för %s till: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- ))
-
-(provide 'zenirc-swedish)
-
-;;; zenirc-swedish.el ends here
+++ /dev/null
-;;; zenirc-trigger.el
-
-;; Copyright (C) 1997 Noah S. Friedman
-;; Copyright (C) 1997, 1998 Per Persson
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: zenirc, extensions, oink
-;; Created: 1997-03-01
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; Use this package to define "triggers" regexps.
-;; For example, you can define a function /time and specify a regexp that
-;; sends the current time whenever someone asks "what time is it?":
-;;
-;; (zenirc-trigger-register "time" 'current-time-string "what time is it\\?")
-;;
-;; You can also use the /trigger command in the *zenirc* buffer:
-;;
-;; /trigger set time "what time is it\\?" current-time-string
-;;
-;; People have defined more interesting triggers such as horoscopes, zippy
-;; quotes, etc.
-
-;;; Code:
-
-(require 'zenirc)
-(require 'backquote)
-
-(defvar zenirc-trigger-table nil)
-(defvar zenirc-command-trigger-hook '(zenirc-command-trigger))
-
-;; Changing this to NOTICE will generally avoid loops from other clients
-;; that also load this. But that's less fun.
-(defconst zenirc-trigger-response-type "PRIVMSG")
-
-(defun zenirc-trigger-register (name response &optional regexp pass-string)
- "Define a trigger named NAME, that runs RESPONSE when REGEXP is seen,
-passing the matched-string if PASS-STRING is true.
-When a string mathcing REGEXP is detected in a zenirc buffer, the function
-RESPONSE is called with no arguments by default, or with the matched string
-if PASS-STRING is non-nil. That function should return a string
-which is to be sent to the originator of the message matching REGEXP.
-It may instead return a list of strings, in which case each string is
-sent as a separate message.
-
-NAME can be used as a key for changing, deleting, activating, and
-deactivating the trigger via /trigger subcommands."
- (zenirc-trigger-make-command name response)
- (and regexp
- (zenirc-trigger-set-trigger name regexp response pass-string)))
-
-;;; Users shouldn't generally need to make use of anything below here.
-
-(defun zenirc-trigger-make-command (name response)
- (let* ((symname (format "zenirc-command-%s" name))
- (cmdsym (intern symname))
- (cmdhook (intern (concat symname "-hook"))))
- (zenirc-add-hook cmdhook cmdsym)
- (fset cmdsym
- (` (lambda (proc victim)
- (zenirc-trigger-send-fn-result proc victim '(, response)))))))
-
-(defun zenirc-trigger-set-trigger (name regexp response &optional pass-string)
- (and (stringp name)
- (setq name (intern name)))
- (let ((elt (assq name zenirc-trigger-table)))
- (cond (elt
- (setcar (nthcdr 1 elt) t)
- (setcar (nthcdr 2 elt) regexp)
- (setcar (nthcdr 3 elt) response)
- (setcar (nthcdr 4 elt) pass-string))
- (t
- (setq zenirc-trigger-table
- (cons (list name t regexp response pass-string)
- zenirc-trigger-table))))))
-
-;; Returns nil if the named trigger doesn't exist, t otherwise.
-(defun zenirc-trigger-activate (name state)
- (and (stringp name) (setq name (intern name)))
- (let ((elt (assq name zenirc-trigger-table)))
- (cond (elt
- (setcar (nthcdr 1 elt) state)
- t)
- (t nil))))
-
-(defun zenirc-trigger-enable (name)
- (zenirc-trigger-activate name t))
-
-(defun zenirc-trigger-disable (name)
- (zenirc-trigger-activate name nil))
-
-\f
-(defun zenirc-server-PRIVMSG-trigger (proc parsedmsg)
- (save-match-data
- (let ((case-fold-search t)
- (trigger-table zenirc-trigger-table)
- regexp fn)
- (while trigger-table
- (cond ((nth 1 (car trigger-table))
- (setq regexp (nth 2 (car trigger-table)))
- (and regexp
- (string-match regexp (aref parsedmsg 3))
- (let ((victim (zenirc-trigger-parse-sender parsedmsg))
- (msg (zenirc-trigger-response
- (nth 3 (car trigger-table))
- (and (nth 4 (car trigger-table))
- (match-string 0 (aref parsedmsg 3))))))
- (zenirc-trigger-send-response proc victim msg)))))
- (setq trigger-table (cdr trigger-table))))))
-
-(defun zenirc-trigger-parse-sender (parsedmsg)
- (let ((from (aref parsedmsg 2)))
- (cond ((zenirc-names-equal-p from zenirc-nick)
- (zenirc-extract-nick (aref parsedmsg 1)))
- (t from))))
-
-(defun zenirc-trigger-response (fn msg)
- (cond ((stringp fn) fn)
- (t (if msg
- (funcall fn msg)
- (funcall fn)))))
-
-(defun zenirc-trigger-send-fn-result (proc victim fn &optional msg)
- (setq victim (cdr victim))
- (cond ((or (null victim)
- (string= "" victim))
- (setq victim zenirc-current-victim)))
- (zenirc-trigger-send-response proc victim (zenirc-trigger-response fn msg)))
-
-(defun zenirc-trigger-send-response (proc victim msg)
- (cond ((stringp msg)
- (zenirc-message proc 'trigger-sent victim msg)
- (process-send-string proc (concat zenirc-trigger-response-type
- " " victim " :" msg "\n")))
- (t
- (while msg
- (zenirc-message proc 'trigger-sent victim (car msg))
- (process-send-string proc
- (concat zenirc-trigger-response-type
- " " victim " :" (car msg) "\n"))
- (setq msg (cdr msg))))))
-
-\f
-;; Parser for /trigger command. This figures out the trigger subcommand
-;; and calls the appropriate routine to handle it.
-;; The function dispatched should be named "zenirc-trigger-do-FOO-command",
-;; where FOO is one of `list', `set', `enable', `disable', etc.
-;; With no arguments, lists available subcommands.
-(defun zenirc-command-trigger (proc parsedcmd)
- (let* ((cmd (zenirc-parse-firstword (cdr parsedcmd)))
- (fn (intern-soft (concat "zenirc-trigger-do-" (car cmd) "-command"))))
- (cond ((and fn (fboundp fn))
- (funcall fn proc cmd))
- ((null (car cmd))
- (zenirc-message proc 'trigger-subcommands
- (mapconcat 'identity
- (zenirc-trigger-subcommand-list)
- ", ")))
- (t
- (zenirc-message proc 'trigger-command-undefined (car cmd))))))
-
-;; Returns a list of defined subcommands to /trigger.
-(defun zenirc-trigger-subcommand-list ()
- (save-match-data
- (let* ((prefix "zenirc-trigger-do-")
- (suffix "-command")
- (re (concat suffix "$")))
- (sort (mapcar (function (lambda (s)
- (substring s (length prefix)
- (- (length suffix)))))
- (all-completions prefix obarray
- (function
- (lambda (s)
- (string-match re (symbol-name s))))))
- 'string-lessp))))
-
-(defun zenirc-trigger-do-list-command (proc args)
- (let ((table zenirc-trigger-table))
- (zenirc-message proc 'trigger-list-head)
- (zenirc-message proc 'trigger-list-line)
- (while table
- (zenirc-message proc 'trigger-list-item
- (nth 0 (car table))
- (nth 1 (car table))
- (prin1-to-string (nth 2 (car table)))
- (prin1-to-string (nth 3 (car table))))
- (setq table (cdr table)))
- (zenirc-message proc 'trigger-list-end)))
-
-(defun zenirc-trigger-do-set-command (proc args)
- (let* ((parsed1 (zenirc-parse-firstword (cdr args)))
- (name (car parsed1))
- (parsed2 (read-from-string (cdr parsed1)))
- (regexp (car parsed2))
- (fn (car (read-from-string (substring (cdr parsed1)
- (cdr parsed2))))))
- (zenirc-trigger-register name fn regexp)
- (zenirc-message proc 'trigger-enable name)))
-
-(defun zenirc-trigger-do-delete-command (proc args)
- (let ((names (zenirc-parse-words (cdr args)))
- (known nil)
- (unknown nil)
- elt)
- (while names
- ;; If intern-soft returns nil, assq will return nil.
- (setq elt (assq (intern-soft (car names)) zenirc-trigger-table))
- (if (null elt)
- (setq unknown (cons (car names) unknown))
- (setq zenirc-trigger-table (delq elt zenirc-trigger-table))
- (setq known (cons (car names) known)))
- (setq names (cdr names)))
- (and known
- (zenirc-message proc 'trigger-deleted (nreverse known)))
- (and unknown
- (zenirc-message proc trigger-undefined (nreverse unknown)))))
-
-(defun zenirc-trigger-do-enable-command (proc args)
- (zenirc-trigger-do-activation proc (cdr args) t))
-
-(defun zenirc-trigger-do-disable-command (proc args)
- (zenirc-trigger-do-activation proc (cdr args) nil))
-
-(defun zenirc-trigger-do-activation (proc args state)
- (let ((msg (if state 'trigger-enable 'trigger-disable))
- (names (zenirc-parse-words args))
- (known nil)
- (unknown nil))
- (while names
- (if (zenirc-trigger-activate (car names) state)
- (setq known (cons (car names) known))
- (setq unknown (cons (car names) unknown)))
- (setq names (cdr names)))
- (and known
- (zenirc-message proc msg (nreverse known)))
- (and unknown
- (zenirc-message proc trigger-undefined (nreverse unknown)))))
-
-\f
-(provide 'zenirc-trigger)
-
-(zenirc-lang-define-catalog 'english
- '((trigger-sent . "[trigger] Sent to %s: %s")
- (trigger-enable . "[info] Triggers enabled: %s")
- (trigger-disable . "[info] Triggers disabled: %s")
- (trigger-deleted . "[info] Triggers deleted: %s")
- (trigger-undefined . "[info] Undefined triggers: %s")
- (trigger-list-head . "[trigger] Name On? Regexp Function")
- (trigger-list-line . "[trigger] ---- --- ------ --------")
- (trigger-list-item . "[trigger] %-10s %-3s %-15s %s")
- (trigger-list-end . "[trigger] End of list.")
- (trigger-subcommands . "[info] Trigger subcommands: %s")
- (trigger-command-undefined . "[info] undefined trigger command: %s")))
-
-(zenirc-add-hook 'zenirc-server-PRIVMSG-hook
- 'zenirc-server-PRIVMSG-trigger 'append)
-
-;;; zenirc-trigger.el ends here
-
+++ /dev/null
-;;; zenirc-yow-filter.el --- neutralize yowage
-
-;; Copyright (C) 1997 Noah S. Friedman
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: zenirc, extensions, oink, yow
-;; Created: 1997-02-10
-
-;; $Id: zenirc-yow-filter.el,v 1.1.1.1 1998-10-07 11:21:31 jareth Exp $
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 59 Temple Place, Suite 330; Boston, MA 02111-1307, USA.
-
-;;; Commentary:
-
-;; I estimate that loading this file grows emacs' permanent
-;; heap by about 650K.
-
-;;; Code:
-
-(require 'zenirc)
-
-(or (boundp 'yow-vector)
- (boundp 'yow-file)
- (load "yow"))
-
-(defconst zenirc-yow-filter-table nil)
-
-(defun zenirc-yow-filter-table-snarf (&optional file)
- (let ((table (make-vector 509 0))
- (yowfile (or file
- (and (boundp 'yow-file)
- yow-file)
- (concat data-directory "yow.lines")))
- (buf (generate-new-buffer " *Yow!*"))
- (snarf-buf (function
- (lambda ()
- (goto-char (point-min))
- (while (progn
- (skip-chars-forward " \t\n\r\f")
- (not (eobp)))
- (intern (buffer-substring (prog1
- (point)
- (search-forward "\0"))
- (1- (point)))
- table))))))
- (save-excursion
- (save-match-data
- (set-buffer buf)
- (setq buffer-undo-list t)
- (insert-file-contents yowfile)
- (search-forward "\0")
- (delete-region (point-min) (point))
- (while (re-search-forward "\n" nil t)
- (delete-char -1))
- (funcall snarf-buf)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n\r\f]+" nil t)
- (replace-match " "))
- (funcall snarf-buf)))
- (kill-buffer buf)
- table))
-
-(defun zenirc-yow-filter (proc parsedmsg)
- (or zenirc-yow-filter-table
- (setq zenirc-yow-filter-table (zenirc-yow-filter-table-snarf)))
- (cond ((intern-soft (aref parsedmsg 3) zenirc-yow-filter-table)
- (and zenirc-debug-ignore
- (zenirc-message proc 'debug (format "Ignored: %s" parsedmsg)))
- (setq zenirc-run-next-hook nil))))
-
-(zenirc-add-hook 'zenirc-server-PRIVMSG-hook 'zenirc-yow-filter)
-(zenirc-add-hook 'zenirc-server-NOTICE-hook 'zenirc-yow-filter)
-
-(provide 'zenirc-yow-filter)
-
-;;; zenirc-yow-filter.el ends here.
+++ /dev/null
-;;; zenirc-yow.el --- important pinheadery for ZenIRC
-
-;; Copyright (C) 1994, 1995, 1997 Noah S. Friedman
-;; Copyright (C) 1996 Per Persson
-
-;; Author: Noah Friedman <friedman@prep.ai.mit.edu>
-;; Maintainer: friedman@prep.ai.mit.edu
-;; Keywords: zenirc, extensions, oink, yow
-;; Created: 1994-06-30
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; ANN JILLIAN'S HAIR makes LONI ANDERSON'S HAIR look like
-;; RICARDO MONTALBAN'S HAIR!
-
-;;; Code:
-
-(require 'zenirc-trigger)
-
-;; v18 yow.el didn't have a `provide'
-(or (fboundp 'yow) (load "yow"))
-
-;; Strip newlines and excess whitespace from string.
-(defun zenirc-yow-format-string (s)
- (save-match-data
- (cond ((string-match "[ \t\n\r][ \t\n\r]+" s)
- (let ((orig-buffer (current-buffer))
- (temp-buffer (generate-new-buffer " *Yow*")))
- (unwind-protect
- (progn
- (set-buffer temp-buffer)
- ;; don't make undo records in temp buffer
- (let ((buffer-undo-list t))
- (insert s)
- (goto-char (point-min))
- (while (re-search-forward "[ \t\n\r]+" nil t)
- (replace-match " "))
- (setq s (buffer-substring (point-min) (point-max)))))
- (set-buffer orig-buffer)
- (kill-buffer temp-buffer))))))
- s)
-
-(defun zenirc-yow ()
- (zenirc-yow-format-string (yow)))
-
-(zenirc-trigger-register "yow" 'zenirc-yow "\\byow\\b")
-
-(provide 'zenirc-yow)
-
-;;; zenirc-yow.el ends here
+++ /dev/null
-;;; zenirc.el --- Waste time on Internet Relay Chat (ZenIRC client)
-
-;; Copyright (C) 1993, 1994 Ben A. Mesander
-;; Copyright (C) 1993, 1994, 1995 Noah S. Friedman
-;; Copyright (C) 1993, 1994, 1995, 1996, 1997, 1998 Per Persson
-
-;; Author: Ben A. Mesander <ben@gnu.ai.mit.edu>
-;; Noah Friedman <friedman@prep.ai.mit.edu>
-;; Per Persson <pp@sno.pp.se>
-;; Major contributors:
-;; Charles Hannum <mycroft@gnu.ai.mit.edu>
-;; Richard Todd <rmtodd@essex.ecn.uoknor.edu>
-;; Eric Prestemon <ecp@io.com>
-;; Mark Bailen <msbailen@msbdcolka.cr.usgs.gov>
-;; Jason Bastek <jason@marilyn.oit.umass.edu>
-;; Ray Jones <rjones@pobox.com>
-;; Maintainer: pp@sno.pp.se
-;; Keywords: extensions, zenirc
-;; Created: 1993-06-03
-
-;; This program 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.
-;;
-;; This program 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 this program; if not, you can either send email to this
-;; program's maintainer or write to: The Free Software Foundation,
-;; Inc.; 675 Massachusetts Avenue; Cambridge, MA 02139, USA.
-
-;;; Commentary:
-
-;; <vuori> The first Lisp-interpreter of the People's Republic
-;; of China, Lisp-130, was written for a Chinese
-;; minicomputer at the Shenyang Science Academy's
-;; processing automation department in 1980. It was an
-;; implementation of Lisp 1.5, which include 94
-;; functions programmed in assembler.
-;;
-;; -- Eero Hyvänen, Juko Seppänen: Lisp-world 2, the
-;; development of Lisp-languages and systems.
-;;
-;; <fn> 1960-03-14 LISP introduced,
-
-;;; Code:
-
-;; Current version of ZenIRC.
-(defconst zenirc-version "2.112")
-
-(and (string= (substring emacs-version 0 2) "18")
- (require 'zenirc-18))
-
-\f
-;;; User options
-
-(defvar zenirc-buffer-name "*zenirc*"
- "*Basic buffer name for Zen Internet Relay Chat.")
-
-(defvar zenirc-userinfo "Oink."
- "*Reply to USERINFO ctcp.")
-
-(defvar zenirc-ignore-list
- '(;; Ignore messages with more than four CTCP strings
- "\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a[^\C-a]*\C-a"
- )
- "*Patterns of messages from server to ignore.
-This should be a list of regular expressions that match IRC protocol messages.
-For example, if you wanted to ignore all messages from `foo@bar.com', put
-\"PRIVMSG [^!]+!foo@bar\\\\.com \" in the list.")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; BEEP. (Female voice:) Hi Tony, this is Sheila. I can't stop
-;;; thinking about you. When can we get together? I want to grab
-;;; you and undress you and then BEEP
-;;;
-;;; -- From the "Canonical List of Anwering Machine Messages."
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar zenirc-signal-list '()
- "*List of regular expressions which cause signal notification.")
-
-(defvar zenirc-beep-on-signal nil
- "*If t, beep on signals when not seen.
-If 'always, beep on all signals.")
-
-(defvar zenirc-send-confirmation t
- "*If nil, don't confirm sent PRIVMSG/NOTICE.
-If t, confirm sent PRIVMSG/NOTICE in the process buffer.
-If 'message, confirm sent PRIVMSG/NOTICE in the echo area.
-
-The confirmation looks like \"(sent to #emacs)\".")
-
-(defvar zenirc-timestamp nil
- "*If nil, don't timestamp messages.
-If t, timestamp messages.")
-
-(defvar zenirc-timestamp-prefix "["
- "*What to add before the timestamp string")
-
-(defvar zenirc-timestamp-suffix "]"
- "*What do add after the timestamp string")
-
-(defvar zenirc-always-show-channelname t
- "*If nil, don't show channelname in PRIVMSG/NOTICE when it's the same as
-zenirc-current-victim.
-If t, always show channelnames in PRIVMSG/NOTICE (when appropriate).")
-
-(defvar zenirc-delete-preceding-whitespaces nil
- "*Whether ZenIRC should delete any whitespaces before the first word
-before sending it off to the server.")
-
-(defvar zenirc-whowas-on-401 nil
- "*Wheter ZenIRC should issue a WHOWAS command if WHOIS returns no nick.")
-
-(defvar zenirc-send-ctcp-errmsg-on-unknown t
- "*If non-`nil', reply to unknown CTCP queries with an ERRMSG reply.
-
-The IRC protocol requires that each query requires a separate error reply,
-yet most server implementations will close your connection if you send too
-many messages at once (\"flooding\"). This gives malicious users a way to
-disconnect you from IRC, but setting this variable to `nil' will prevent it
-by simply not replying to invalid CTCP requests.
-
-See also `zenirc-send-ctcp-errmsg-on-unbalanced'.")
-
-(defvar zenirc-send-ctcp-errmsg-on-unbalanced t
- "*If non-`nil', reply to unbalanced CTCP queries with an ERRMSG reply.
-See the documentation for `zenirc-send-ctcp-errmsg-on-unknown' for further
-information on why it may be useful to set this to `nil'.")
-
-(defvar zenirc-verbose-ctcp t
- "*Should ZenIRC tell you when you send CTCP replies to people?")
-
-(defvar zenirc-fingerdata
- (format "%s <%s@%s>" (user-full-name) (user-real-login-name) (system-name))
- "*CTCP FINGER reply data.")
-
-(defvar zenirc-command-char ?/
- "*Char that begins a command at the beginning of a line")
-\f
-;;; IRC connection-related variables.
-
-(defvar zenirc-server-alist nil
- "*Association list of port/password/nick info for each server.
-This is initialized via `zenirc-ircserver-string->alist' the first time you
-start a zenirc session.")
-
-(defvar zenirc-ircserver-environment-variable-name "IRCSERVER"
- "*Name of environment variable containing server/port info.
-This variable is used by `zenirc-ircserver-string->alist'.
-It is user-settable so that you can potentially define different
-environment variables for different clients.")
-
-;; Give a default for this since there's no easy way of guessing a server
-;; name if you don't know any.
-(defvar zenirc-server-default "irc.stealth.net"
- "*Server to use if no other is specified.
-See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
-
-(defvar zenirc-nick-default nil
- "*Nickname to use if no other is specified.
-See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
-
-(defvar zenirc-password-default nil
- "*Default server password to use if no other is specified.
-See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
-
-(defvar zenirc-port-default nil
- "*Default server port to use if no other is specified.
-See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
-
-(defvar zenirc-user-full-name-default nil
- "*Default full name used to describe yourself on irc.
-See `zenirc-establish-server-connection'.")
-
-(defvar zenirc-user-login-name-default nil
- "*Default user name to use if no other is specified.
-See `zenirc-server-alist' and `zenirc-establish-server-connection'.")
-
-(defvar zenirc-process-connect-function 'open-network-stream
- "*Function used to establish server connection.
-This is called by `zenirc-establish-server-connection' and should take the
-same arguments normally given to `open-network-stream'.
-This function can be used to make proxy connections.")
-
-\f
-;;; Misc variables of interest.
-;;; Most of these are reasonable for users to modify.
-
-(defconst zenirc-message-length-limit 450
- "Maximum length of messages that can be sent on a single line.
-
-Actually, this isn't really the length of the message the client is allowed
-to send; it includes cruft that might be added by the server and over which
-you have little knowledge or control. For example, if your system is not
-configured so that gethostname returns the FQDN for your host, the
-calculations in zenirc-send-multi-line may be off from what the server
-considers is your hostname. Another way in which it can fail is if your
-host name is shorter than the corresponding IP address and the server
-failed to resolve your hostname.
-
-In light of these possibilities, this constant is set to 450 even though
-the theoretical maximum allowed is 512 according to RFC1459.")
-
-(defvar zenirc-mode-map '()
- "*Sparse keymap for zenirc-mode")
-(cond
- ((null zenirc-mode-map)
- (setq zenirc-mode-map (make-sparse-keymap))
- (define-key zenirc-mode-map "\n" 'zenirc-send-line)
- (define-key zenirc-mode-map "\C-m" 'zenirc-send-line)
- (define-key zenirc-mode-map "\C-c\C-t" 'zenirc-toggle-channel)
- (define-key zenirc-mode-map "\C-c\C-r" 'zenirc-send-privmsg-last-rec)
- (define-key zenirc-mode-map "\C-c\C-s" 'zenirc-send-privmsg-last-sent)
- (define-key zenirc-mode-map ":" 'zenirc-self-insert-or-send-privmsg-last-rec)
- (define-key zenirc-mode-map ";"
- 'zenirc-self-insert-or-send-privmsg-last-sent)))
-
-;; These strings should be in the format "ftp-server:directory:file".
-(defvar zenirc-source-list
- '("ftp.splode.com:/pub/zenirc:zenirc.tar.gz")
- "Where to retrieve ZenIRC from.")
-
-;; Existing client messages are recycled here where possible, as it makes
-;; it more likely that other clients will format them correctly.
-(defvar zenirc-clientinfo-list
- '((ACTION . "ACTION contains action descriptions for atmosphere")
- (CLIENTINFO
- . "CLIENTINFO gives information about available CTCP commands")
- (ECHO . "ECHO returns string sent by other person")
- (ERRMSG . "ERRMSG returns error messages")
- (FINGER . "FINGER shows real name, and login name of user")
- (PING . "PING returns the arguments it receives")
- ;; sojge sure is a wordy bastard.
- ;; The description is made up out of zero or more lines followed by an
- ;; end marker.
- ;; Every line is a CTCP reply with the SOURCE keyword, a space, the
- ;; name of a FTP-server, a colon, a directory name, a colon, and 0 or
- ;; more file names.
- ;; If no file names are given, all the files in the named directory are
- ;; needed. The end marker contains just the keyword.
- (SOURCE . "SOURCE Where to find the source code for this client")
- (TIME . "TIME tells you the time on the user's host")
- (USERINFO . "USERINFO returns user settable information")
- (VERSION . "VERSION shows client type, version, and environment"))
- "*Association list of CLIENTINFO CTCP help strings")
-
-(defvar zenirc-clientinfo-string "ACTION CLIENTINFO ECHO ERRMSG FINGER PING SOURCE TIME USERINFO VERSION :Use CLIENTINFO <COMMAND> to get more specific information"
- "*CLIENTINFO Help string, showing list of CTCP commands supported")
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; "I wish this video had some explosions. That would be cool."
-;;; "Heh heh henh hmm heh. It does have some explosions. Heh henh hmm."
-;;; "Faries grant wishes. Huh huh heh huh hunh."
-;;;
-;;; -- Beavis & Butthead
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; debugging variables. for the adventurous.
-(defvar zenirc-debug-mainloop nil)
-(defvar zenirc-debug-ignore nil)
-(defvar zenirc-debug-signal nil)
-(defvar zenirc-debug-ctcp nil)
-(defvar zenirc-debug-commands nil)
-(defvar zenirc-debug-timer nil)
-(defvar zenirc-bug-address "zenirc-bug@splode.com")
-
-\f
-;;; local state variables.
-;;; It's probably not useful for the user to change these, unless necessary
-;;; for particular extensions.
-
-(defvar zenirc-server nil)
-(make-variable-buffer-local 'zenirc-server)
-
-(defvar zenirc-port nil)
-(make-variable-buffer-local 'zenirc-port)
-
-(defvar zenirc-password nil)
-(make-variable-buffer-local 'zenirc-password)
-
-(defvar zenirc-nick nil)
-(make-variable-buffer-local 'zenirc-nick)
-
-(defvar zenirc-user-login-name nil)
-(make-variable-buffer-local 'zenirc-user-login-name)
-
-(defvar zenirc-user-full-name nil)
-(make-variable-buffer-local 'zenirc-user-full-name)
-
-;; The name the current IRC server calls itself.
-;; This can differ from `zenirc-server' if one is just a network alias of
-;; the other.
-(defvar zenirc-current-server-name nil)
-(make-variable-buffer-local 'zenirc-current-server-name)
-
-;; current channel or luser, or nil
-(defvar zenirc-current-victim nil)
-(make-variable-buffer-local 'zenirc-current-victim)
-
-;; variables to store the nick you last sent to or that last sent to you
-(defvar zenirc-privmsg-last-rec "")
-(make-variable-buffer-local 'zenirc-privmsg-last-rec)
-
-(defvar zenirc-privmsg-last-sent "")
-(make-variable-buffer-local 'zenirc-privmsg-last-sent)
-
-;; remember last person we saw a privmsg from.
-(defvar zenirc-privmsg-last-seen nil)
-(make-variable-buffer-local 'zenirc-privmsg-last-seen)
-
-;; a list of channels the client is on
-(defvar zenirc-channel-list '())
-(make-variable-buffer-local 'zenirc-channel-list)
-
-;; We use this marker instead of the process mark, because the latter goes
-;; away when a process exits, which is a gratuitous nuisance.
-(defvar zenirc-process-mark nil)
-(make-variable-buffer-local 'zenirc-process-mark)
-
-;; unprocessed data read from socket
-(defvar zenirc-unprocessed-output nil)
-(make-variable-buffer-local 'zenirc-unprocessed-output)
-
-;; standard vector into which parsed messages are stashed, to avoid
-;; consing new vectors each time.
-(defvar zenirc-message-vector (make-vector 12 nil))
-(make-variable-buffer-local 'zenirc-message-vector)
-
-;; allowed server modes (set in 004 reply)
-(defvar zenirc-server-modes nil)
-(make-variable-buffer-local 'zenirc-server-modes)
-
-;; server version (set in 004 reply)
-(defvar zenirc-server-version nil)
-(make-variable-buffer-local 'zenirc-server-version)
-
-(defvar zenirc-time-last-event nil)
-(make-variable-buffer-local 'zenirc-time-last-event)
-
-;; allowed user modes (set in 004 reply)
-(defvar zenirc-user-modes nil)
-(make-variable-buffer-local 'zenirc-user-modes)
-
-\f
-;;; Standard hooks
-
-;; TODO: implement "filters" and turn this into one.
-(defvar zenirc-format-nickuserhost-hook
- '(identity)
- "*List of filters used to format nicknames in displayed messages.")
-
-(defvar zenirc-mode-hook nil
- "*Hook to run at the end of zenirc-mode.")
-
-(defvar zenirc-startup-hook nil
- "*Hook run before establishing a server connection.")
-
-(defvar zenirc-exit-hook nil
- "*Hook to run when zenirc exits.")
-
-(defvar zenirc-connect-hook nil
- "*Hook to run registering with an IRC server.")
-
-(defvar zenirc-timer-hook nil
- "*Timer hook variable.")
-
-(defvar zenirc-signal-hook '(zenirc-signal)
- "*Signal hook variable.")
-
-(defvar zenirc-message-hook nil
- "*Hook to run whenever a message is inserted in the zenirc buffer.
-The buffer is narrowed to the region containing the newly-inserted text,
-and is called with two arguments: the process (if known) and the unmodified
-string. This string may not match exactly what is currently in the buffer,
-since functions on this hook can easily modify the latter.")
-
-;; Hooks for various server commands.
-;; These are commands that the user types, e.g. "/quit" (the best command
-;; of all!). For any given command CMD, the hook zenirc-command-CMD-hook
-;; is run. If the user types a command for which there is no hook, the
-;; command is passed directly to the server.
-(defvar zenirc-command-away-hook '(zenirc-command-away))
-(defvar zenirc-command-action-hook '(zenirc-command-action))
-(defvar zenirc-command-command-char-hook '(zenirc-command-command-char))
-(defvar zenirc-command-ctcp-hook '(zenirc-command-ctcp))
-(defvar zenirc-command-kick-hook '(zenirc-command-kick))
-(defvar zenirc-command-kill-hook '(zenirc-command-kill))
-(defvar zenirc-command-language-hook '(zenirc-command-language))
-(defvar zenirc-command-m-hook '(zenirc-command-m))
-(defvar zenirc-command-me-hook '(zenirc-command-me))
-(defvar zenirc-command-msg-hook '(zenirc-command-msg))
-(defvar zenirc-command-notice-hook '(zenirc-command-notice))
-(defvar zenirc-command-oper-hook '(zenirc-command-oper))
-(defvar zenirc-command-part-hook '(zenirc-command-part))
-(defvar zenirc-command-ping-hook '(zenirc-command-ping))
-(defvar zenirc-command-privmsg-hook '(zenirc-command-privmsg))
-(defvar zenirc-command-query-hook '(zenirc-command-query))
-(defvar zenirc-command-quit-hook '(zenirc-command-quit))
-(defvar zenirc-command-quote-hook '(zenirc-command-quote))
-(defvar zenirc-command-server-hook '(zenirc-command-server))
-(defvar zenirc-command-squit-hook '(zenirc-command-squit))
-(defvar zenirc-command-topic-hook '(zenirc-command-topic))
-
-;; Hooks run after various kinds of messages are sent
-;; These hooks get several args: a process, a format specifier to use if
-;; the message sent had to be sent in multiple chunks, and format specifier
-;; to use if the entire message fit in one line, the recipient, and the
-;; number of chunks actually sent.
-;; See zenirc-send-confirmation-generic for an example.
-(defvar zenirc-send-confirmation-privmsg-hook
- '(zenirc-send-confirmation-generic))
-(defvar zenirc-send-confirmation-notice-hook
- '(zenirc-send-confirmation-generic))
-(defvar zenirc-send-confirmation-me-hook '(zenirc-send-confirmation-generic))
-(defvar zenirc-send-line-hook nil
- "*Hook run after a line of input is sent to the server.
-Functions on this hook get three args: two integers specifying the
-beginning and ending points in the buffer containing the text sent, and a
-string representing the formatted text actually sent to the server (the
-main difference is that embedded newlines are mapped to spaces).")
-
-;; Hooks run to generate replies to CTCP queries.
-(defvar zenirc-ctcp-reply-PING-hook '(zenirc-ctcp-reply-PING))
-(defvar zenirc-ctcp-query-ACTION-hook '(zenirc-ctcp-query-ACTION))
-(defvar zenirc-ctcp-query-CLIENTINFO-hook '(zenirc-ctcp-query-CLIENTINFO))
-(defvar zenirc-ctcp-query-ECHO-hook '(zenirc-ctcp-query-ECHO))
-(defvar zenirc-ctcp-query-ERRMSG-hook '(zenirc-ctcp-query-ERRMSG))
-(defvar zenirc-ctcp-query-FINGER-hook '(zenirc-ctcp-query-FINGER))
-(defvar zenirc-ctcp-query-PING-hook '(zenirc-ctcp-query-PING))
-(defvar zenirc-ctcp-query-SOURCE-hook '(zenirc-ctcp-query-SOURCE))
-(defvar zenirc-ctcp-query-TIME-hook '(zenirc-ctcp-query-TIME))
-(defvar zenirc-ctcp-query-USERINFO-hook '(zenirc-ctcp-query-USERINFO))
-(defvar zenirc-ctcp-query-VERSION-hook '(zenirc-ctcp-query-VERSION))
-
-;; Hooks run in response to messages from the server.
-;; For any message of type TYPE, the hook zenirc-server-TYPE-hook is run.
-(defvar zenirc-server-ERROR-hook '(zenirc-server-ERROR))
-(defvar zenirc-server-INVITE-hook '(zenirc-server-INVITE))
-(defvar zenirc-server-JOIN-hook '(zenirc-server-JOIN))
-(defvar zenirc-server-KICK-hook '(zenirc-server-KICK))
-(defvar zenirc-server-KILL-hook '(zenirc-server-KILL))
-(defvar zenirc-server-MODE-hook '(zenirc-server-MODE))
-(defvar zenirc-server-NICK-hook '(zenirc-server-NICK))
-(defvar zenirc-server-NOTICE-hook '(zenirc-server-NOTICE))
-(defvar zenirc-server-PART-hook '(zenirc-server-PART))
-(defvar zenirc-server-PING-hook '(zenirc-server-PING))
-(defvar zenirc-server-PONG-hook '(zenirc-server-PONG))
-(defvar zenirc-server-PRIVMSG-hook '(zenirc-server-PRIVMSG))
-(defvar zenirc-server-QUIT-hook '(zenirc-server-QUIT))
-(defvar zenirc-server-TOPIC-hook '(zenirc-server-TOPIC))
-(defvar zenirc-server-WALLOPS-hook '(zenirc-server-WALLOPS))
-(defvar zenirc-server-001-hook '(zenirc-server-001))
-(defvar zenirc-server-002-hook '(zenirc-server-002))
-(defvar zenirc-server-003-hook '(zenirc-server-003))
-(defvar zenirc-server-004-hook '(zenirc-server-004))
-(defvar zenirc-server-200-hook '(zenirc-server-200))
-(defvar zenirc-server-201-hook '(zenirc-server-201))
-(defvar zenirc-server-202-hook '(zenirc-server-202))
-(defvar zenirc-server-203-hook '(zenirc-server-203))
-(defvar zenirc-server-204-hook '(zenirc-server-204))
-(defvar zenirc-server-205-hook '(zenirc-server-205))
-(defvar zenirc-server-206-hook '(zenirc-server-206))
-(defvar zenirc-server-208-hook '(zenirc-server-208))
-(defvar zenirc-server-209-hook '(zenirc-server-209))
-(defvar zenirc-server-211-hook '(zenirc-server-211))
-(defvar zenirc-server-212-hook '(zenirc-server-212))
-(defvar zenirc-server-213-hook '(zenirc-server-213))
-(defvar zenirc-server-214-hook '(zenirc-server-214))
-(defvar zenirc-server-215-hook '(zenirc-server-215))
-(defvar zenirc-server-216-hook '(zenirc-server-216))
-(defvar zenirc-server-217-hook '(zenirc-server-217))
-(defvar zenirc-server-218-hook '(zenirc-server-218))
-(defvar zenirc-server-219-hook '(zenirc-server-219))
-(defvar zenirc-server-221-hook '(zenirc-server-221))
-(defvar zenirc-server-241-hook '(zenirc-server-241))
-(defvar zenirc-server-242-hook '(zenirc-server-242))
-(defvar zenirc-server-243-hook '(zenirc-server-243))
-(defvar zenirc-server-244-hook '(zenirc-server-244))
-(defvar zenirc-server-249-hook '(zenirc-server-249))
-(defvar zenirc-server-251-hook '(zenirc-server-251))
-(defvar zenirc-server-252-hook '(zenirc-server-252))
-(defvar zenirc-server-253-hook '(zenirc-server-253))
-(defvar zenirc-server-254-hook '(zenirc-server-254))
-(defvar zenirc-server-255-hook '(zenirc-server-255))
-(defvar zenirc-server-256-hook '(zenirc-server-256))
-(defvar zenirc-server-257-hook '(zenirc-server-257))
-(defvar zenirc-server-258-hook '(zenirc-server-258))
-(defvar zenirc-server-259-hook '(zenirc-server-259))
-(defvar zenirc-server-261-hook '(zenirc-server-261))
-(defvar zenirc-server-262-hook '(zenirc-server-262))
-(defvar zenirc-server-301-hook '(zenirc-server-301))
-(defvar zenirc-server-302-hook '(zenirc-server-302))
-(defvar zenirc-server-303-hook '(zenirc-server-303))
-(defvar zenirc-server-305-hook '(zenirc-server-305))
-(defvar zenirc-server-306-hook '(zenirc-server-306))
-(defvar zenirc-server-311-hook '(zenirc-server-311))
-(defvar zenirc-server-312-hook '(zenirc-server-312))
-(defvar zenirc-server-313-hook '(zenirc-server-313))
-(defvar zenirc-server-314-hook '(zenirc-server-314))
-(defvar zenirc-server-315-hook '(zenirc-server-315))
-(defvar zenirc-server-317-hook '(zenirc-server-317))
-(defvar zenirc-server-318-hook '(zenirc-server-318))
-(defvar zenirc-server-319-hook '(zenirc-server-319))
-(defvar zenirc-server-321-hook '(zenirc-server-321))
-(defvar zenirc-server-322-hook '(zenirc-server-322))
-(defvar zenirc-server-323-hook '(zenirc-server-323))
-(defvar zenirc-server-324-hook '(zenirc-server-324))
-(defvar zenirc-server-331-hook '(zenirc-server-331))
-(defvar zenirc-server-332-hook '(zenirc-server-332))
-(defvar zenirc-server-333-hook '(zenirc-server-333))
-(defvar zenirc-server-341-hook '(zenirc-server-341))
-(defvar zenirc-server-342-hook '(zenirc-server-342))
-(defvar zenirc-server-351-hook '(zenirc-server-351))
-(defvar zenirc-server-352-hook '(zenirc-server-352))
-(defvar zenirc-server-353-hook '(zenirc-server-353))
-(defvar zenirc-server-364-hook '(zenirc-server-364))
-(defvar zenirc-server-365-hook '(zenirc-server-365))
-(defvar zenirc-server-366-hook '(zenirc-server-366))
-(defvar zenirc-server-367-hook '(zenirc-server-367))
-(defvar zenirc-server-368-hook '(zenirc-server-368))
-(defvar zenirc-server-369-hook '(zenirc-server-369))
-(defvar zenirc-server-371-hook '(zenirc-server-371))
-(defvar zenirc-server-372-hook '(zenirc-server-372))
-(defvar zenirc-server-374-hook '(zenirc-server-374))
-(defvar zenirc-server-375-hook '(zenirc-server-375))
-(defvar zenirc-server-376-hook '(zenirc-server-376))
-(defvar zenirc-server-381-hook '(zenirc-server-381))
-(defvar zenirc-server-382-hook '(zenirc-server-382))
-(defvar zenirc-server-391-hook '(zenirc-server-391))
-(defvar zenirc-server-392-hook '(zenirc-server-392))
-(defvar zenirc-server-393-hook '(zenirc-server-393))
-(defvar zenirc-server-394-hook '(zenirc-server-394))
-(defvar zenirc-server-395-hook '(zenirc-server-395))
-(defvar zenirc-server-401-hook '(zenirc-server-401))
-(defvar zenirc-server-402-hook '(zenirc-server-402))
-(defvar zenirc-server-403-hook '(zenirc-server-403))
-(defvar zenirc-server-404-hook '(zenirc-server-404))
-(defvar zenirc-server-405-hook '(zenirc-server-405))
-(defvar zenirc-server-406-hook '(zenirc-server-406))
-(defvar zenirc-server-407-hook '(zenirc-server-407))
-(defvar zenirc-server-409-hook '(zenirc-server-409))
-(defvar zenirc-server-411-hook '(zenirc-server-411))
-(defvar zenirc-server-412-hook '(zenirc-server-412))
-(defvar zenirc-server-413-hook '(zenirc-server-413))
-(defvar zenirc-server-414-hook '(zenirc-server-414))
-(defvar zenirc-server-415-hook '(zenirc-server-415))
-(defvar zenirc-server-421-hook '(zenirc-server-421))
-(defvar zenirc-server-422-hook '(zenirc-server-422))
-(defvar zenirc-server-423-hook '(zenirc-server-423))
-(defvar zenirc-server-424-hook '(zenirc-server-424))
-(defvar zenirc-server-431-hook '(zenirc-server-431))
-(defvar zenirc-server-432-hook '(zenirc-server-432))
-(defvar zenirc-server-433-hook '(zenirc-server-433))
-(defvar zenirc-server-436-hook '(zenirc-server-436))
-(defvar zenirc-server-437-hook '(zenirc-server-437))
-(defvar zenirc-server-441-hook '(zenirc-server-441))
-(defvar zenirc-server-442-hook '(zenirc-server-442))
-(defvar zenirc-server-443-hook '(zenirc-server-443))
-(defvar zenirc-server-444-hook '(zenirc-server-444))
-(defvar zenirc-server-445-hook '(zenirc-server-445))
-(defvar zenirc-server-446-hook '(zenirc-server-446))
-(defvar zenirc-server-451-hook '(zenirc-server-451))
-(defvar zenirc-server-461-hook '(zenirc-server-461))
-(defvar zenirc-server-462-hook '(zenirc-server-462))
-(defvar zenirc-server-463-hook '(zenirc-server-463))
-(defvar zenirc-server-464-hook '(zenirc-server-464))
-(defvar zenirc-server-465-hook '(zenirc-server-465))
-(defvar zenirc-server-467-hook '(zenirc-server-467))
-(defvar zenirc-server-471-hook '(zenirc-server-471))
-(defvar zenirc-server-472-hook '(zenirc-server-472))
-(defvar zenirc-server-473-hook '(zenirc-server-473))
-(defvar zenirc-server-474-hook '(zenirc-server-474))
-(defvar zenirc-server-475-hook '(zenirc-server-475))
-(defvar zenirc-server-477-hook '(zenirc-server-477))
-(defvar zenirc-server-481-hook '(zenirc-server-481))
-(defvar zenirc-server-482-hook '(zenirc-server-482))
-(defvar zenirc-server-483-hook '(zenirc-server-483))
-(defvar zenirc-server-491-hook '(zenirc-server-491))
-(defvar zenirc-server-501-hook '(zenirc-server-501))
-(defvar zenirc-server-502-hook '(zenirc-server-502))
-
-(defvar zenirc-font-lock-keywords
- '(("^\\[\\([^]]+\\)\\].*" 1 font-lock-type-face)
- ("^\\[[^]]+\\]\\(.*\\)$" 1 font-lock-comment-face)
- ("^<\\([^>!]+[^>]+\\)>" 1 font-lock-keyword-face)
- ("^<[^>!]+!\\([^#>]+\\)[^>]+>" 1 font-lock-string-face t)
- ("^<[^>#]+\\(#[^>]+\\)>" 1 font-lock-function-name-face t)
- ("^<[^>]+> \\([^ :]+:\\)" 1 font-lock-keyword-face t))
- "Default expressions to highlight in zenirc mode.")
-
-(put 'zenirc-mode 'font-lock-defaults
- '(zenirc-font-lock-keywords nil nil ((?_ . "w"))))
-
-\f
-(defun zenirc-mode ()
- "Major mode for wasting major time on IRC."
- (kill-all-local-variables)
-
- (setq mode-name "ZenIRC")
- (setq major-mode 'zenirc-mode)
- (use-local-map zenirc-mode-map)
- (setq mode-line-process '(":%s"))
- (setq mode-line-format
- '( ""
- mode-line-modified
- mode-line-buffer-identification
- " "
- global-mode-string
- " "
- (-3 . "%p")
- " %[("
- mode-name
- mode-line-process
- "%n"
- minor-mode-alist
- ")%] "
- zenirc-nick
- (zenirc-current-victim ("->" zenirc-current-victim))
- " "
- "%-"))
- (font-lock-set-defaults)
- (zenirc-run-hook 'zenirc-mode-hook))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; Code to handle connection to server
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;;###autoload
-(defun zenirc (&optional prefix)
- "Waste time on IRC.
-
-If an irc session already exists, switch to that session.
-With prefix arg, start a new session even if another exists.
-
-If buffer exists but zenirc process is not running, make new process.
-If buffer exists and zenirc process is running, just switch to that buffer.
-If an explicit numeric prefix argument is given (or this function is called
-from lisp with a numeric argument), switch to the buffer named
-\"*zenirc*<prefix>\", e.g. \"*zenirc*<2>\". If there is no process in that
-buffer, start one.
-If a prefix argument is given but it is not a number, create a new buffer
-and start a process in it. This is the same as calling the function from
-lisp with an argument of `t'."
- (interactive "P")
- (let* ((zenirc-buffer (if prefix
- (generate-new-buffer zenirc-buffer-name)
- (get-buffer-create zenirc-buffer-name)))
- (process (get-buffer-process zenirc-buffer)))
- (pop-to-buffer zenirc-buffer)
-
- (cond
- ((and process
- (memq (process-status process) '(open run))))
- (t
- (zenirc-mode)
-
- (or zenirc-server-alist
- (setq zenirc-server-alist (zenirc-ircserver-string->alist)))
-
- (setq zenirc-unprocessed-output "")
- (setq zenirc-current-victim nil)
-
- ;; Time of last event in zenirc - set it to "now"
- (setq zenirc-time-last-event
- (zenirc-time-to-int (current-time-string)))
-
- ;; note the semantics here that the current buffer when
- ;; zenirc-startup-hook is run is zenirc-buffer.
- (zenirc-run-hook 'zenirc-startup-hook)
-
- ;; Do this before opening network stream, if currently unset.
- ;; If already set, preserve so that user can save input.
- (or zenirc-process-mark
- (setq zenirc-process-mark
- (set-marker (make-marker) (point-max) zenirc-buffer)))
-
- (or (setq process
- (zenirc-establish-server-connection zenirc-buffer))
- (error "zenirc: could not establish any server connection."))
-
- (set-process-buffer process zenirc-buffer)
- (set-process-filter process 'zenirc-filter)
- (set-process-sentinel process 'zenirc-sentinel)
- (zenirc-login process)
- (zenirc-run-hook 'zenirc-connect-hook process)))))
-
-(defun zenirc-select (&optional server port nick)
- "Run manually or by issuing /server from a ZenIRC buffer.
-
-This function starts a new ZenIRC buffer and connects to a given server.
-Variables not already given are queried for, using zenirc-server-alist
-for default values. zenirc-server-alist is also updated each time this
-function is issued."
-
- (interactive)
- (if (integerp port) (setq port (int-to-string port)))
- (let ((new-server) (new-port) (new-nick))
- (setq
- new-server
- ; server to connect to
- (or server
- ; server is not given, query user
- (completing-read "Server: " zenirc-server-alist nil nil
- (or
- (car (car zenirc-server-alist))
- ; last resort default
- zenirc-server-default)))
- new-port
- ; port to connect to
- (or
- port
- ; port is not given, query user
- (read-string "Port: "
- (or
- (if (car (cdr (assoc new-server zenirc-server-alist)))
- (int-to-string
- (car (cdr (assoc new-server zenirc-server-alist)))))
- (if zenirc-port (int-to-string zenirc-port))
- ; last resort default
- (getenv "IRCPORT")
- "6667")))
- new-nick
- ; nickname to use
- (or
- nick
- ; nickname is not given, query user
- (read-string "Nickname: "
- (or
- (car (nthcdr 3 (assoc new-server zenirc-server-alist)))
- zenirc-nick
- (getenv "IRCNICK")
- ; last resort default
- (user-login-name)))))
- ; update zenirc-server-alist
- (let ((new-list (list new-server (string-to-int new-port) nil new-nick)))
- (if (not (member new-list zenirc-server-alist))
- ; a new entry is given
- (setq zenirc-server-alist
- (cons new-list zenirc-server-alist))
- ; move old entry to the top of zenirc-server-alist
- (setq zenirc-server-alist (delete new-list zenirc-server-alist)
- zenirc-server-alist (cons new-list zenirc-server-alist)))
- ; make sure we don't try to connect to anything else then the
- ; given server
- (let ((zenirc-server-alist (list new-list)))
- ; run the actual connection, at last
- (zenirc t)))))
-
-(defun zenirc-establish-server-connection (buffer &optional alist)
- "Waste time by connecting to an irc server.
-This function takes two arguments: a buffer and an optional alist
-of the same form as that returned by `zenirc-ircserver-string->alist'.
-If none is specified, the default is `zenirc-server-alist'.
-
-For each server in the alist, attempt to connect to it on the appropriate
-port and with the appropriate nicknames, etc.
-
-If any of the elements in the list for a server is unspecified, one of the
-following defaults is used, in the specified order of priority (names in
-caps preceded with `$' are environment variables):
-
- port: zenirc-port-default, $IRCPORT
- password: zenirc-password-default
- nickname: zenirc-nick-default, $IRCNICK, (user-login-name)
- username: zenirc-user-login-name-default, $USER, (user-login-name)
-
-Finally, if zenirc-server-alist is nil and no other alist is specified,
-connect to `zenirc-server-default', or $IRCSERVER, using defaults as
-described above."
- (save-excursion
- (set-buffer buffer)
- (or alist
- (setq alist zenirc-server-alist)
- (setq alist (list (list zenirc-server-default))))
- (let ((procname (concat "zenirc:" (buffer-name)))
- ent server port proc)
- (while alist
- (setq ent (car alist))
- (setq alist (cdr alist))
-
- ;; Note that we check the environment variable before the
- ;; -default variable. This is pretty much the only exception.
- (setq server (or (car ent)
- (let ((server (getenv "IRCSERVER")))
- (and server
- (substring server 0
- (string-match " \\|:" server))))
- zenirc-server-default
- (error "no server specified.")))
-
- (setq port (or (nth 1 ent)
- (let ((p (getenv "IRCPORT")))
- (and p (string-to-int p)))
- zenirc-port-default
- 6667))
-
- (condition-case data
- (progn
- (zenirc-message buffer 'connect-try server port)
- ;; Do a redisplay before connecting, in case the server is
- ;; slow to respond.
- (sit-for 0)
- (setq proc (funcall zenirc-process-connect-function
- procname buffer server port))
- ;; Update connection status in modeline.
- (force-mode-line-update)
- (setq alist nil)
- (setq zenirc-server server)
- ;; This might get reset later, but initialize it.
- (setq zenirc-current-server-name server)
-
- (setq zenirc-port port)
- (setq zenirc-password (or (nth 2 ent)
- zenirc-password-default))
- (setq zenirc-nick (or (nth 3 ent)
- zenirc-nick-default
- (getenv "IRCNICK")
- (user-login-name)
- "Thoth")) ; it -is- funny
- (setq zenirc-user-full-name (or (nth 4 ent)
- zenirc-user-full-name-default
- (getenv "IRCNAME")
- (user-full-name)
- "Thoth"))
- (setq zenirc-user-login-name (or (nth 5 ent)
- zenirc-user-login-name-default
- (getenv "USER")
- (user-login-name)
- "Thoth")))
- (quit
- (setq alist nil)
- (zenirc-message buffer 'connect-abort))
-
- (file-error
- ;; file-error "connection failed" "connection timed out" host proc
- ;; file-error "connection failed" "connection refused" host proc
- (if (string= (nth 1 data) "connection failed")
- (zenirc-message buffer 'connect-failed server port
- (nth 2 data))
- (signal 'file-error data)))
- (error
- ;; data == (error "Unknown host \"foo\"")
- (if (string-match "^Unknown host" (nth 1 data))
- (zenirc-message buffer 'connect-failed server port
- (nth 1 data))
- (apply 'signal data)))))
- proc)))
-
-(defun zenirc-ircserver-string->alist (&optional str)
- "*Create association list of server to port/password/nick/username.
-
-This function takes a string of the form
-
- \"SERVER1:PORT1:PASSWORD1:NICKNAME1:USERNAME1 SERVER2:...\"
-
-If more than one entry is desired, separate each entry in the string
-variable with any nonzero amount of whitespace composed of spaces, tabs,
-and/or newlines.
-
-If no string is specified, the value of the environment variable
-specified by `zenirc-ircserver-environment-variable-name'.
-
-The alist returned consist of lists containing the following elements,
-and satisfy the corresponding type predicates:
-
- SERVER: `stringp'
- PORT: `natnump' or `null'
- PASSWORD: `stringp' or `null'
- NICKNAME: `stringp' or `null'
- USERNAME: `stringp' or `null'
-
-These alists specify a list of servers and related data with which zenirc
-should attempt to connect to servers; generally, each one is tried until a
-successful connection is made. See `zenirc-establish-server-connection'."
- (or str (setq str (getenv zenirc-ircserver-environment-variable-name)))
- (cond
- ((null str) nil)
- ((let ((len (length str))
- (pos 0)
- (result nil)
- tmp tmplen tmppos
- tmplist)
- (save-match-data
- (and (string-match "^[ \t\r\n]+" str pos)
- (setq pos (match-end 0)))
-
- (while (< pos len)
- (cond ((string-match "[ \t\r\n]+" str pos)
- (setq tmplen (- (match-beginning 0) pos))
- (setq tmp (substring str pos (+ pos tmplen)))
- (setq pos (match-end 0)))
- (t
- (setq tmplen (- len pos))
- (setq tmp (if (zerop pos)
- str
- (substring str pos)))
- (setq pos len)))
-
- (setq tmppos 0)
- (setq tmplist nil)
- (while (< tmppos tmplen)
- (cond ((string-match ":" tmp tmppos)
- (setq tmplist
- (cons (substring tmp tmppos (match-beginning 0))
- tmplist))
- (and (string= (car tmplist) "")
- (setcar tmplist nil))
- (setq tmppos (match-end 0)))
- (t
- (and (string= tmp "")
- (setq tmp nil))
- (setq tmplist (cons (if (zerop tmppos)
- tmp
- (substring tmp tmppos))
- tmplist))
- (setq tmppos tmplen))))
- (and tmplist
- (progn
- (setq tmplist (nreverse tmplist))
- (and (stringp (nth 1 tmplist))
- ;; convert port number to int
- (setcar (nthcdr 1 tmplist)
- (string-to-int (nth 1 tmplist))))
- (setq result (cons tmplist result))))))
- (nreverse result)))))
-
-;; send nick, user@host information
-;; NICK zenirc-nick
-;; USER zenirc-user-login-name (system-name) zenirc-server
-;; :zenirc-user-full-name
-(defun zenirc-login (proc)
- (and zenirc-password
- (process-send-string proc (format "PASS %s\n" zenirc-password)))
- ;; Send user info first; some servers reject connections otherwise.
- (process-send-string proc (format "USER %s %s %s :%s\n"
- zenirc-user-login-name
- (system-name)
- zenirc-server
- zenirc-user-full-name))
- (process-send-string proc (format "NICK %s\n" zenirc-nick)))
-
-(defun zenirc-sentinel (proc str)
- (save-excursion
- (set-buffer (process-buffer proc))
- (zenirc-run-hook 'zenirc-exit-hook proc str)
- (zenirc-message proc 'sentinel (current-time-string))))
-
-
-;; This function takes a chunk of text from the server, and any text
-;; left over from the last chunk, and passes it to zenirc-parse-output
-;; to be interpreted.
-(defun zenirc-filter (proc string)
- (let ((orig-buffer (current-buffer)))
- (unwind-protect
- (progn
- (set-buffer (process-buffer proc))
- (setq zenirc-unprocessed-output
- (zenirc-parse-output proc string zenirc-unprocessed-output)))
- (set-buffer orig-buffer))))
-
-;; This routine takes a bunch of text from the server, and any remnants
-;; from the last bunch, and splits it into lines. The lines are passed to
-;; zenirc-parse-server-message to be parsed and then whatever needs to be
-;; done for that server message is done.
-(defun zenirc-parse-output (proc string unparsed-output)
- (let* ((unparsed (concat unparsed-output string))
- (proc-window (get-buffer-window (process-buffer proc)))
- (ignored nil)
- eol line parsed)
- (save-match-data
- (while (setq eol (string-match "\n" unparsed))
-
- ;; Somewhere around ircd 2.8.16.0, server messages start coming in
- ;; with a C-m (ascii 13, carriage return) at the end.
- ;; (Incidentally, that is the correct thing to do; all textually
- ;; based network protocols should use CRLF rather than just LF, for
- ;; the sake of consistency. --friedman)
- (if (= (aref unparsed (1- eol)) ?\C-m)
- (setq line (substring unparsed 0 (1- eol)))
- (setq line (substring unparsed 0 eol)))
- (setq unparsed (substring unparsed (1+ eol)))
- (cond
- ((zenirc-ignore-p line)
- (and zenirc-debug-ignore
- (zenirc-message proc 'debug (concat "Ignored: " line))
- (setq ignored t)))
- (t
- (let* ((parsed (zenirc-parse-server-message line))
- (hook-name (concat "zenirc-server-" (aref parsed 0) "-hook"))
- (hook (intern-soft hook-name)))
- (cond
- (zenirc-debug-mainloop
- (zenirc-message proc 'debug (concat "Hook: " hook-name))
- (zenirc-message proc 'debug
- (concat "Parsed: "
- (prin1-to-string parsed)))))
-
- (zenirc-timer-handler proc)
- (if (and hook (boundp hook))
- (zenirc-run-hook hook proc parsed)
- (zenirc-message proc 'server line))
- (if (and (not ignored)
- (zenirc-signal-p line))
- (zenirc-run-hook 'zenirc-signal-hook proc parsed))))))
- ;; return the unprocessed partial line, if any.
- unparsed)))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; utility subroutines
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; Returns a string indicating emacs variant.
-(defun zenirc-emacs-variant ()
- (let ((case-fold-search t)
- (alist '(("^Nemacs\\b" . "Nemacs")
- ("^Epoch\\b" . "Epoch")
- ("\\bXEmacs\\b" . "XEmacs")
- ("\\bLucid\\b" . "Lucid Emacs")
- ("^GNU Emacs" . "GNU Emacs")))
- (version (cond
- ((fboundp 'nemacs-version)
- (nemacs-version))
- (t
- (emacs-version))))
- result)
- (save-match-data
- (while alist
- (cond
- ((string-match (car (car alist)) version)
- (setq result (cdr (car alist)))
- (setq alist nil))
- (t
- (setq alist (cdr alist))))))
- result))
-
-;; Update the modeline, or whatever it takes to actually update the modeline
-;; depending on which version of Emacs we're using.
-;;
-;; ``Consistency is the last refuge of the unimaginative''
-;; -- Oscar Wilde
-;;
-(defun zenirc-update-modeline ()
- (let ((version (emacs-version)))
- (cond ((string-match "Emacs 19" version)
- (force-mode-line-update))
- ((string-match "XEmacs" version)
- (redraw-modeline))
- (t
- (redraw-display)))))
-
-(defun zenirc-match-string (n &optional s)
- "Return string matched by last search.
-N specifies the nth parenthesized expression in the last regexp.
-N=0 means the entire text matched by the whole regexp or whole string.
-S should be given if the last search was by `string-match' on string S.
-
-Return value is nil if there is no Nth match."
- (and (match-beginning n)
- (if s
- (substring s (match-beginning n) (match-end n))
- (buffer-substring (match-beginning n) (match-end n)))))
-
-(defun zenirc-string-match-list (msg regexp-list)
- (let ((match-data (match-data))
- (found nil))
- (while (and (not found) regexp-list)
- (setq found (string-match (car regexp-list) msg))
- (setq regexp-list (cdr regexp-list)))
- (or found
- (store-match-data match-data))
- found))
-
-;; t if we are at the beginning of the input area
-(defun zenirc-beginning-of-input-p (&optional proc)
- (or proc
- (setq proc (get-buffer-process (current-buffer))))
- ;; Note you can compare markers and positions safely; `=' looks at the
- ;; marker's position.
- (= (point) zenirc-process-mark))
-
-;; t if point is in the "input area" (i.e. beyond the process mark)
-(defun zenirc-in-input-p ()
- ;; Note you can compare markers and positions safely; `=' looks at the
- ;; marker's position.
- (>= (point) zenirc-process-mark))
-
-;; return t if arg is a channel name, else nil
-(defun zenirc-channel-p (arg)
- (memq (aref arg 0) '(?# ?& ?+)))
-
-;; ignore processing - msg is a server message sent to the client.
-;; Return non-nil if it is to be ignored, nil if it is not to be ignored.
-(defun zenirc-ignore-p (msg)
- (zenirc-string-match-list msg zenirc-ignore-list))
-
-;; Return t if both names are equivalent, ignoring differences in case.
-;; This uses zenirc-downcase-name to handle weird chars.
-;;
-;; This function is used to check whether a given nickname matches a
-;; nickname fed to us by the server. As the function is used to check
-;; this on recieved PRIVMSGs and NOTICEs we also need to check if the
-;; sending side used one of the more obscure addressing schemes:
-;; nickname@servername
-;; username%hostname
-;; As @ and % are illegal characters in a nickname, we can safely
-;; check if n1 contains one of them to see if the recieved string
-;; matches whatever the server thinks we are. --pp
-;;
-;; Because of the fact mentioned above we need to define what n1 and
-;; n2 should be. I hereby declare that n1 is whatever the server has
-;; fed us and n2 is our own given string. This only needs to be true
-;; when the optional argument "recieving-privmsg" is set, but it
-;; should be the standard way to address the function. --pp
-(defun zenirc-names-equal-p (n1 n2 &optional recieving-privmsg)
- ;; I (Noah) have checked the emacs source code, and the size of strings
- ;; is stored in the Lisp_Object structure, so it can be referenced in
- ;; constant time. Checking size first avoids the need for extra string
- ;; consing and regexp searching in zenirc-downcase-name if we know the
- ;; names can't possibly be equal.
- (or
- (and (= (length n1) (length n2))
- (string= (zenirc-downcase-name n1) (zenirc-downcase-name n2)))
- (and recieving-privmsg
- (or (string-match "@" n1)
- (string-match "%" n1)))))
-
-; (and (= (length n1) (length n2))
-; (string= (zenirc-downcase-name n1) (zenirc-downcase-name n2))))
-
-;; RFC1459 says that, because of IRC's scandanavian origin, the
-;; characters {}| are considered to be the lower case equivalents of the
-;; characters []\, respectively. This is a critical issue when determining
-;; the equivalence of two nicknames or channel names.
-(defun zenirc-downcase-name (s)
- (setq s (downcase s))
- (let ((c '((?\[ . ?\{) (?\] . ?\}) (?\\ . ?\|)))
- (p 0))
- (save-match-data
- (while (string-match "[][\\]" s p)
- (aset s (match-beginning 0)
- (cdr (assq (aref s (match-beginning 0)) c)))
- (setq p (match-end 0)))))
- s)
-
-;; determine if an event is worthy of a signal
-(defun zenirc-signal-p (msg)
- (zenirc-string-match-list msg zenirc-signal-list))
-
-;; returns nil if nick is actually a server name.
-(defun zenirc-extract-nick (nickuserhost)
- (save-match-data
- (cond ((string-match "[!.]" nickuserhost)
- (if (= (aref nickuserhost (match-beginning 0)) ?.)
- nil
- (substring nickuserhost 0 (match-beginning 0))))
- (t nickuserhost))))
-
-(defun zenirc-extract-userhost (nickuserhost)
- (save-match-data
- (and (string-match "!" nickuserhost)
- (substring nickuserhost (match-end 0)))))
-
-(defun zenirc-extract-host (nickuserhost)
- (save-match-data
- (and (string-match "@" nickuserhost)
- (substring nickuserhost (match-end 0)))))
-
-;; Parse a line into its constituent parts (words separated by
-;; whitespace). Return a list of the words.
-(defun zenirc-parse-words (line)
- (let ((list '())
- (posn 0))
- (save-match-data
- (while (string-match "[^ \t\n]+" line posn)
- (setq list (cons (zenirc-match-string 0 line) list))
- (setq posn (match-end 0))))
- (nreverse list)))
-
-;; Parse the first n words in line, returning a list consisting of each
-;; word, plus any remaining portion of the string.
-(defun zenirc-parse-n-words (n line)
- (let ((i 0)
- (len (length line))
- (posn 0)
- (result nil))
- (save-match-data
- (while (and (< i n)
- (string-match "[^ \t\n]+" line posn))
- (setq result (cons (zenirc-match-string 0 line) result))
- (setq posn (match-end 0))
- (setq i (1+ i)))
- (and (string-match "[ \t\n]+" line posn)
- (setq posn (match-end 0)))
- (and (< posn len)
- (setq result (cons (substring line posn) result)))
- (nreverse result))))
-
-;; parse a line into the first word and the rest.
-;;
-;; This returns ("word" . "rest"), where word means adjacent non-space
-;; characters. Any amount of whitespace is skipped after the first word,
-;; and "rest" is the rest of the line. If there is no "rest", a "rest"
-;; of "" is constructed.
-(defun zenirc-parse-firstword (str)
- (let ((cell (cons nil nil)))
- (save-match-data
- (cond ((string-match "[^ \t\n]+" str)
- (setcar cell (zenirc-match-string 0 str))
- (if (string-match "[^ \t\n]+" str (match-end 0))
- (setcdr cell (substring str (match-beginning 0)))
- (setcdr cell ""))
- cell)))))
-
-;; parse a server message into the zenirc-message-vector
-;; the result looks like ["msgtype" "sender" "to" "arg1" ... "argn"]
-(defun zenirc-parse-server-message (string)
- (save-match-data
- (let ((posn (if (eq (aref string 0) ?:)
- (string-match " " string)
- 0))
- (msg zenirc-message-vector)
- (n 2))
- (fillarray msg nil)
-
- (aset msg 1 (if (eq posn 0)
- (or zenirc-current-server-name zenirc-server)
- (substring string 1 posn)))
-
- (aset msg 0 (let* ((bposn (string-match "[^ ]" string posn))
- (eposn (string-match " " string bposn)))
- (setq posn (and eposn
- (string-match "[^ ]" string eposn)))
- (substring string bposn eposn)))
-
- (while (and posn
- (not (eq (aref string posn) ?:)))
- (aset msg n (let* ((bposn posn)
- (eposn (string-match " " string bposn)))
- (setq posn (and eposn
- (string-match "[^ ]" string eposn)))
- (substring string bposn eposn)))
- (setq n (1+ n)))
- (if posn
- (aset msg n (substring string (1+ posn))))
- msg)))
-
-;; Try matching msg in regexp-list.
-;; If no match is found, preserve old match data and return nil.
-;; Otherwise, return value of successful string-match and leave modified
-;; match-data intact.
-;; do a signal (pop up buffer, beep, whatever)
-(defun zenirc-signal (proc msg)
- (cond ((and proc-window
- (pos-visible-in-window-p zenirc-process-mark proc-window)
- (not (string-equal zenirc-beep-on-signal 'always))))
- (t
- (and zenirc-beep-on-signal (ding t))
- (zenirc-message nil 'signal (buffer-name)))))
-
-(defun zenirc-message (proc-or-buffer string &rest args)
- (let ((proc nil)
- (buffer nil)
- (sym nil))
-
- (cond ((processp proc-or-buffer)
- (setq buffer (process-buffer proc-or-buffer))
- (setq proc proc-or-buffer))
- ((or (bufferp proc-or-buffer)
- (stringp proc-or-buffer))
- (setq buffer (get-buffer proc-or-buffer))
- (setq proc (get-buffer-process buffer))))
-
- (cond
- ((symbolp string)
- (setq sym string)
- (setq string (zenirc-lang-retrieve-catalog-entry string))))
- (and args
- (if string
- (setq string (apply 'format string args))
- (setq string (format "[raw] %s" args))))
- (cond
- ((null proc-or-buffer)
- (message "%s" string))
- (t
- (setq string (concat string "\n"))
- (let ((orig-buffer (current-buffer))
- region-begin
- window
- window-point
- current-point-mark)
- (unwind-protect
- (progn
- (set-buffer buffer)
- (setq window (get-buffer-window buffer))
- (setq region-begin (marker-position zenirc-process-mark))
- (setq current-point-mark (point-marker))
-
- ;; If process mark is at window start, insert-before-markers
- ;; will insert text off-window since it's also inserting before
- ;; the start window mark. Preserve window start's point in
- ;; that case.
- (and window
- (= zenirc-process-mark (window-start window))
- (setq window-point region-begin))
-
- (goto-char zenirc-process-mark)
- (insert-before-markers string)
- (goto-char region-begin)
- (while (search-forward "\C-m" zenirc-process-mark t)
- (delete-char -1))
- (and zenirc-message-hook
- (save-restriction
- (narrow-to-region region-begin zenirc-process-mark)
- (zenirc-run-hook 'zenirc-message-hook proc sym string)))
- (goto-char current-point-mark)
- (and window-point
- (set-window-start window window-point 'noforce)))
- (set-buffer orig-buffer)))))))
-
-;; Insert the string "(sent to foo)" for arbitrary foo in the zenirc buffer.
-;; This might be a useful thing to put in your zenirc-command-msg-hook.
-;; `data' is either a simple string or a parsed message list. The
-;; structure of a partially-parsed message differs a little; the rest of
-;; the string is directly in the cdr, instead of each substring being in
-;; its own cons. --friedman
-(defun zenirc-display-recipient-confirmation (proc data &optional n)
- (or n (setq n 1))
- (let ((to (cond
- ((stringp data)
- data)
- ((and (consp data)
- (consp (cdr data))
- (> (length data) 1))
- (car (cdr data)))
- ((listp data)
- (car (zenirc-parse-firstword (cdr data))))
- ((signal 'wrong-type-argument (list 'string-or-list-p data))))))
- (if (string-equal 'message zenirc-send-confirmation)
- (setq proc nil))
- (if (> n 1)
- (zenirc-message proc 'send-multi to n)
- (zenirc-message proc 'send to))))
-
-;; Handle a zenirc / command typed by the user. Check to see if there's a
-;; hook for the command and if so, execute the hook, otherwise just send the
-;; command line unaltered to the server.
-(defun zenirc-do-command (proc cmdline)
- (let* ((parsedcmd (zenirc-parse-firstword cmdline))
- (cmdname (car parsedcmd))
- (hook-name (concat "zenirc-command-" cmdname "-hook"))
- (hook (intern-soft hook-name)))
- (cond
- (zenirc-debug-commands
- (zenirc-message proc 'debug (concat "Hook: " hook-name))
- (zenirc-message proc 'debug
- (concat "Parsed: " (prin1-to-string parsedcmd)))))
- ;; Call the hook, if it's bound and non-nil.
- ;; Otherwise, just send the unparsed command to the server.
- (if (and hook
- (boundp hook)
- (symbol-value hook))
- (zenirc-run-hook hook proc parsedcmd)
- (process-send-string proc (concat cmdline "\n")))))
-
-(defun zenirc-send-line ()
- "Send current line to IRC server."
- (interactive)
- (cond
- ((zenirc-in-input-p)
- (end-of-line)
- (let* ((proc (get-buffer-process (current-buffer)))
- (input-start (copy-marker zenirc-process-mark))
- (input-end (point))
- (string (buffer-substring input-start input-end))
- (posn 0))
- (if (= (point) (point-max))
- (insert "\n")
- ;; skip over line already present
- (goto-char (1+ (point))))
- (set-marker zenirc-process-mark (point))
- (zenirc-timer-handler proc)
- (save-match-data
- (cond
- ;; Ignore lines composed only of whitespace
- ((not (string-match "\\`\\s-*\\'" string))
- ;; convert newlines in input to spaces (decimal ascii 32)
- (while (string-match "\n" string posn)
- (aset string (match-beginning 0) 32)
- (setq posn (match-end 0)))
- ;; Remove preceding whitespaces, if user wants us to.
- (if (and zenirc-delete-preceding-whitespaces
- (string-match (concat "^\\( \\)*"
- (char-to-string zenirc-command-char))
- string))
- (setq string
- (substring string (string-match "[^ ]" string))))
- ;; Run this hook after string has been formatted, but before
- ;; invoking any hooks since they may do unpredictable things like
- ;; change the current buffer.
- (zenirc-run-hook 'zenirc-send-line-hook
- input-start input-end string)
- (cond ((= (aref string 0) zenirc-command-char)
- (zenirc-do-command proc (substring string 1)))
- ((string= zenirc-current-victim nil)
- (zenirc-message proc 'nosend))
- (t
- (let ((n (zenirc-send-multi-line
- proc
- (concat "PRIVMSG " zenirc-current-victim)
- string)))
- (zenirc-run-hook 'zenirc-send-confirmation-privmsg-hook
- proc 'send-multi 'send
- zenirc-current-victim n)))))))))
- (t
- (goto-char (point-max)))))
-
-;; Returns the number of chunks required to send the message
-(defun zenirc-send-multi-line (proc prefix string)
- (let* ((maxlen (- zenirc-message-length-limit
- (length prefix)
- ;; when the server sends your message, it prepends a
- ;; string of the form ":nick!user@host "
- ;; Plus we add a newline and a separator ourselves.
- (length zenirc-nick)
- (length zenirc-user-login-name)
- (length (system-name))
- ;;(length ": !@ :\r\n")
- 8))
- (strlen (length string))
- (posn 0)
- (n 0)
- (count 0))
- (while (< posn strlen)
- (setq n (min maxlen (- strlen posn)))
- (process-send-string
- proc (concat prefix " :" (substring string posn (+ posn n)) "\r\n"))
- (setq posn (+ posn n))
- (setq count (1+ count)))
- count))
-
-;; This is the default action for most zenirc-send-confirmation-FOO-hooks.
-(defun zenirc-send-confirmation-generic (proc multi single to n)
- (if zenirc-send-confirmation
- (progn
- (and (string-equal 'message zenirc-send-confirmation)
- (setq proc nil))
- (let ((msg (if (> n 1) multi single)))
- (zenirc-message proc msg to n)))))
-
-;; Delete a cell from a list, case-insensitively.
-(defun zenirc-delete-case-insensitive (elt list)
- "Delete by side effect any occurrences of ELT as a member of LIST.
-The modified LIST is returned. Comparison is done with `equal'.
-If the first member of LIST is ELT, deleting it is not a side effect;
-it is simply using a different list.
-Therefore, write `(setq foo (delete element foo))'
-to be sure of changing the value of `foo'.
-
-This function compares things case-insensitively (according to RFC1459)."
- (let ((p list)
- (l (cdr list)))
- (while l
- (if (equal (zenirc-downcase-name elt) (zenirc-downcase-name (car l)))
- (setcdr p (cdr l))
- (setq p (cdr p)))
- (setq l (cdr l))))
- (if (equal (zenirc-downcase-name elt) (zenirc-downcase-name (car list)))
- (cdr list)
- list))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; ZenIRC message catalogs
-;;;
-;;; "Hello, hello, obarrayter?"
-;;; "This is the obarrayter."
-;;; "Could you please call an internist?"
-;;; "What's the problem, sir?"
-;;; "Oh, just some bad hash. But I'd like to consult a professional
-;;; just to be safe."
-;;; "I understand, sir."
-;;; ...dum dee dum...
-;;; 'Tis a gift to be symbol
-;;; 'tis a gift to be freed...
-;;; -- Karl Fogel
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defvar zenirc-lang-catalogs (make-vector 13 0)
- "Obarray used to store message for all languages, indexed by symbol.")
-
-;; 211 buckets should be more than enough for message catalogs (remember to
-;; use a prime number to get good hashing characteristics).
-;; This is not the total number of messages you can store, but just the number
-;; of "buckets" in which they can go. Even if the catalog eventually
-;; contains more entries than this, it isn't really necessary to increase
-;; the size of this table. Note that right now, there are about 175
-;; messages in the english catalog with a few extra libraries loaded.
-(defconst zenirc-lang-obarray-size 211
- "*The default hash table size for newly created message catalogs")
-
-(defvar zenirc-lang-current-language 'english
- "Current language in use in zenirc.")
-
-;; This works on existing catalogs, but will overwrite any entry already in
-;; the catalog.
-(defun zenirc-lang-define-catalog (lang alist)
- (let* ((catalog-name (if (stringp lang)
- lang
- (symbol-name lang)))
- (catalog-sym (intern catalog-name zenirc-lang-catalogs))
- catalog)
-
- (or (boundp catalog-sym)
- (set catalog-sym (make-vector zenirc-lang-obarray-size 0)))
- (setq catalog (symbol-value catalog-sym))
-
- (while alist
- (set (intern (symbol-name (car (car alist))) catalog) (cdr (car alist)))
- (setq alist (cdr alist)))))
-
-;; This creates a new catalog if none exists for the language specified.
-;; It is more efficient to use zenirc-lang-define-catalog if defining many
-;; entries at once.
-(defun zenirc-lang-store-catalog-entry (sym str lang)
- (or lang (setq lang zenirc-lang-current-language))
- (let* ((catalog-name (if (stringp lang)
- lang
- (symbol-name lang)))
- (sym-name (if (stringp sym)
- sym
- (symbol-name sym)))
- (catalog-sym (intern catalog-name zenirc-lang-catalogs)))
- (or (boundp catalog-sym)
- (set catalog-sym (make-vector zenirc-lang-obarray-size 0)))
- (set (intern sym-name (symbol-value catalog-sym)) str)))
-
-;; This returns nil for any undefined entry type, or if there is no
-;; catalog for the language specified.
-(defun zenirc-lang-retrieve-catalog-entry (sym &optional lang)
- (if (not lang) (setq lang zenirc-lang-current-language))
- (or (zenirc-lang-retrieve-catalog-entry-1 sym lang)
- ;; For now, if a message entry isn't defined for the
- ;; current language, default to english. There are
- ;; many new message types and the other catalogs
- ;; aren't completely up to date.
- (and (not (string-equal lang 'english))
- (zenirc-lang-retrieve-catalog-entry-1 sym 'english))))
-
-(defun zenirc-lang-retrieve-catalog-entry-1 (sym lang)
- (or lang (setq lang zenirc-lang-current-language))
- (let* ((catalog-name (if (stringp lang)
- lang
- (symbol-name lang)))
- (catalog-sym (intern-soft catalog-name zenirc-lang-catalogs))
- catalog
- (sym-name (if (stringp sym)
- sym
- (symbol-name sym)))
- msg-sym)
- (cond ((or (null catalog-sym)
- (not (boundp catalog-sym)))
- nil)
- (t
- (setq catalog (symbol-value catalog-sym))
- (setq msg-sym (intern-soft sym-name catalog))
- (and msg-sym
- (boundp msg-sym)
- (symbol-value msg-sym))))))
-
-;; If called interactively and language is undefined, signal an error.
-(defun zenirc-lang-set-current-language (lang)
- (interactive (list (completing-read "Switch to language: "
- zenirc-lang-catalogs 'boundp t)))
- (let* ((name (if (stringp lang)
- lang
- (symbol-name lang)))
- (catalog (intern-soft name zenirc-lang-catalogs)))
-
- (cond ((and catalog (boundp catalog))
- ;; Set the current language to a symbol interned in the global
- ;; obarray. This makes it more convenient to compare against
- ;; other symbols with eq.
- (setq zenirc-lang-current-language (intern name))
- (zenirc-message (current-buffer) 'newcatalog name))
- (t
- (zenirc-message (current-buffer) 'nocatalog name)
- nil))))
-
-\f
-;; English is the default catalog. Other catalogs are available in
-;; separate files.
-(defun zenirc-lang-define-english-catalog ()
- (zenirc-lang-define-catalog 'english
- '((s001 . "[info] You are wasting time.")
- (s002 . "[info] Your IRC server is %s running ircd version %s")
- (s003 . "[info] This server was created %s")
- (s200 . "[info] %s (%s) Link -> %s") ; Version reply from /trace
- (s201 . "[info] %s Try -> %s")
- (s202 . "[info] %s H.S. -> %s")
- (s203 . "[info] %s Hmmm -> IP address: %s") ; Unknown connection
- (s204 . "[info] %s Oper -> %s") ; Operator connection
- (s205 . "[info] %s User -> %s") ; User connection
- (s206 . "[info] %s Serv -> %s %s %s %s ") ; Server connection
- (s208 . "[info] %s %s -> %s") ; New type connection
- (s209 . "[info] %s Clas -> %s = %s") ; What the classes means
- (s211 . "[info] %s link up %s sec\nSent: %s/%s, Rcvd: %s/%s, SendQ: %s")
- (s212 . "[info] %s\t->\ttimes: %s\tbytes: %s") ; Command stats
- (s213 . "[info] C hst/nme/prt/cls: %s/%s/%s/%s") ; C-lines
- (s214 . "[info] N hst/nme/prt/cls: %s/%s/%s/%s") ; N-lines
- (s215 . "[info] %s host/name/class:\t%s/%s/%s") ; I-lines
- (s216 . "[info] K host/username:\t%s/%s") ; K-lines
- (s217 . "[info] Q %s/%s/%s/%s/%s") ; Q-lines
- (s218 . "[info] Class: %s Ping freq: %s Conn.freq: %s Max Links: %s Sendq: %s") ; Y-lines
- (s219 . "[info] End of /stats.")
- (s221 . "[info] Your current user mode is: %s")
- (s241 . "[info] LEAF hostmask/depth:\t\t%s/%s") ; L-lines
- (s242 . "[info] %s") ; Uptime of server
- ;; O-lines and o-lines; the latter are for local ops
- (s243 . "[info] %s nickname/user@host:\t%s/%s")
- (s244 . "[info] HUB hostmask/servername:\t%s/%s") ; H-lines
- (s249 . "[info] %s; %s") ; /stats Z info.
- (s251 . "[info] There are %s/%s visible/invisible users on %s servers.")
- (s251-29 . "[info] There are %s users and %s services on %s servers.")
- (s252 . "[info] There are %s major dweebs online.")
- (s253 . "[info] There are %s unknown connections.")
- (s254 . "[info] There are %s channels")
- (s255 . "[info] There are %s clients and %s servers connected to this server")
- (s255-29 . "[info] There are %s clients, %s services and %s servers connected to this server")
- (s256 . "[info] Administrative information for %s:") ; /admin line 1
- (s257 . "[info] %s") ; /admin line 2
- (s258 . "[info] %s") ; /admin line 3
- (s259 . "[info] %s") ; /admin line 4
- (s261 . "[info] %s File -> %s %s") ; Logfile trace
- (s262 . "[info] %s Vers -> %s")
- (s301 . "[info] %s is away: %s")
- (s302 . "[info] userhost: %s") ; userhost reply
- (s303 . "[info] Currently wasting time: %s") ; ison reply
- (s305 . "[info] You are no longer away")
- (s306 . "[info] You are away")
- (s311 . "[info] %s (%s@%s) is %s") ; user part of /whois list
- (s312 . "[info] %s iswas using server %s (%s)")
- (s313 . "[info] %s is a major dweeb.") ; /whois operator status
- (s314 . "[info] %s (%s@%s) was %s") ; user part of /whowas list
- (s315 . "[info] End of /who.")
- (s317 . "[info] %s has been idle %s") ; /whois idle time
- (s318 . "[info] End of /whois.")
- (s319 . "[info] %s is on: %s") ; channel part of whois data
- (s321 . "[info] Channel Users Topic") ; header for LIST cmd
- (s322 . "[info] %-15s %-5s %s") ; each channel in LIST cmd
- (s323 . "[info] End of /list.") ; trailer for LIST cmd
- (s324 . "[info] Mode for %s is %s %s") ; channel mode
- (s331 . "[info] %s has no topic") ; no topic message
- (s332 . "[info] %s topic: %s") ; topic message
- (s333 . "[info] %s topic set by %s at %s") ; topic set time
- (s341 . "[info] You are inviting %s to %s") ; invite reply
- (s342 . "[info] You are asking %s to waste time") ; summon reply
- (s351 . "[info] Version: %s %s %s") ; version reply
- (s352_header . "[info] Nickname Stat Name of Channel User@host (Hop count Name)") ; header for /who list reply
- (s352 . "[info] %-9s %-3s %-15s %s@%s (%s)") ; /who list reply
- (s353 . "[info] Users on %s: %s") ; displayed after channel join
- (s364 . "[info] %s %s %s") ; /links reply
- (s365 . "[info] end of /links") ; end of /links reply
- (s367 . "[info] %s ban %s") ; banlist reply
- (s368 . "[info] end of banlist") ; end of banlist reply
- (s371 . "[info] %s") ; info reply
- (s372 . "[motd] %s") ; message of the day
- (s375 . "[motd] Message Of The Day:") ; start of motd
- (s376 . "[motd] End of motd") ; displayed at end of motd
- (s381 . "[info] You are now a major dweeb") ; irc op status
- (s382 . "[info] Rehashing: %s") ; rehash server msg
- (s391 . "[info] Time for server %s: %s") ; TIME reply
- (s392 . "[info] Userid Terminal Host") ; header for users rpl
- (s393 . "[info] %s") ; body of users rpl
- (s395 . "[info] Nobody logged on") ; nobody for users rpl
- (s401 . "[info] No such nick/channel: %s") ; there is no such nick/chan
- (s402 . "[info] No such nick/server: %s") ; there is no such server
- (s403 . "[info] No such channel: %s") ; there is no such channel
- (s404 . "[info] You cannot send to %s.") ; you can't send to channel
- (s405 . "[info] Too many channels: %s") ; too many channels
- (s406 . "[info] Server has no record of nickname: %s") ; no whowas data
- (s407 . "[info] Duplicate recipients. No message sent: %s") ; user@host
- (s409 . "[info] No origin specified.") ; ping error reply
- (s411 . "[info] No recipient given.") ; no recipient given
- (s412 . "[info] No text to send.") ; you didn't send anything.
- (s413 . "[info] No toplevel domain: %s") ; no toplevel domain spec
- (s414 . "[info] Wildcard in toplevel domain: %s") ; wild toplevel
- (s415 . "[info] Bad server/host mask: %s") ; wild toplevel
- (s421 . "[info] This looks like spam to me: %s") ; you sent server spam
- (s422 . "[info] No motd (flame major dweeb listed in /admin)")
- (s423 . "[info] No admin info. Ignorant major dweeb running server.")
- (s431 . "[info] No nickname given") ; you didn't provide a nick
- (s432 . "[info] Invalid nickname: %s")
- (s433 . "[info] Nickname already in use: %s")
- (s436 . "[info] Nick collision kill: %s")
- (s437 . "[info] Nick/channel temporarily unavailable: %s")
- (s441 . "[info] %s is not on %s") ; can't do it to those not present
- (s442 . "[info] You are not on %s.") ; you can't do that dave.
- (s443 . "[info] %s is already on channel %s.") ; invite error
- (s444 . "[info] %s is not logged in") ; SUMMON reply
- (s445 . "[info] Some major dweeb won't let you do summon")
- (s446 . "[info] Some major dweeb won't let you do /users")
- (s451 . "[info] You have not registered") ; gotta do the USER NICK thing
- (s461 . "[info] Not enough parameters: %s") ; as 421
- (s462 . "[info] You may not reregister") ; cannot USER twice
- (s463 . "[info] Some fascist major dweeb will not let you connect")
- (s464 . "[info] Password is incorrect") ; bad PASS command
- (s465 . "[info] You are not allowed to use this server.") ; creep
- (s467 . "[info] Key for %s is already set.") ; chan key set already
- (s471 . "[info] Cannot join %s (user limit reached).") ; too many ppl
- (s472 . "[info] %s is an unknown mode character.") ; duh
- (s473 . "[info] Cannot join %s (invite only).") ; fascist nerds
- (s474 . "[info] Cannot join %s (ban).") ; you're banned
- (s475 . "[info] Cannot join %s (channel key).") ; bad key
- (s477 . "[info] Channel %s doesn't support modes.")
- (s481 . "[info] You are not a big enough dweeb to do that.") ; oper only
- (s482 . "[info] You are not a powermonger for %s.") ; chanop needed
- (s483 . "[info] Duh. You cannot kill a server") ; can't kill a server
- (s491 . "[info] No major dweebs allowed from your host") ; no o-line
- (s501 . "[info] Unknown user mode flag") ; you did something silly
- (s502 . "[info] Cannot change mode for other users") ; as above
- (action . "(sent to %s)") ; ctcp action sent
- (connect-failed . "[error] Couldn't connect to %s port %d, reason: %s")
- (connect-try . "[info] Connecting to %s port %d...")
- (connect-abort . "[info] Aborted attempt to connect to an irc server.")
- (ctcp_action . "[action->%s] %s %s") ; ctcp ACTION display
- (ctcp_action_nochannel . "[action] %s %s")
- (ctcp_clientinfo . "[query] CLIENTINFO from %s to %s")
- (ctcp_echo . "[query] ECHO from %s to %s containing: %s")
- (ctcp_errmsg . "[query] ERRMSG from %s to %s")
- (ctcp_finger . "[query] FINGER from %s to %s")
- (ctcp_ping . "[query] PING from %s to %s")
- (ctcp_ping_reply . "[reply] PING: %s is %s seconds away")
- (ctcp_source . "[query] SOURCE from %s to %s")
- (ctcp_time . "[query] TIME from %s to %s")
- (ctcp_userinfo . "[query] USERINFO from %s to %s")
- (ctcp_version . "[query] VERSION from %s to %s")
- (debug . "[debug] %s") ; displayed by debugging code
- (error . "[%s] %s") ; server error message
- (invite . "[info] %s invites you to %s.") ; invite
- (join_you . "[info] Joining channel: %s")
- (join . "[info] %s has joined %s")
- (join_mode . "[info] %s joined %s (+%s).")
- (kick . "[info] %s has been kicked from %s by %s") ; someone was peeved
- (kick_you . "[info] You have been kicked from %s by %s") ; loser
- (kill . "[info] You have been killed: %s") ; your time is up.
- (mode . "[info] %s has changed mode for %s: %s") ; MODE change
- (nick . "[info] %s has changed nick to %s") ; nick change
- (newcatalog . "[info] Current message catalog set to %s")
- (nocatalog . "[error] No message catalog defined for %s")
- (nosend . "[info] you have no current victim to send to") ; msg not sent
- (notice . "{%s%s} %s") ; NOTICE
- (notice_nochannel . "{%s} %s") ; NOTICE
- (notice_you . "{%s} %s") ; NOTICE sent to your nick
- (now_querying . "[info] Current victim is %s.") ; /query foo
- (part_you . "[info] Leaving: %s (%s)") ; your part from channel message
- (part . "[info] %s has left %s (%s)") ; part from channel message
- (pong . "[info] %s says ojnk.") ; pong message from server
- (privmsg . "<%s%s> %s") ; PRIVMSG
- (privmsg_nochannel . "<%s> %s") ; PRIVMSG
- (privmsg_you . "*%s* %s") ; PRIVMSG sent to your nick
- (protocol_violation . "[error] The following line is in violation of the IRC protocol.\n[error] Please tell the server administrator:\n%s: %s")
- (query . "[query] from %s to %s content %s") ; ctcp query
- (query_unknown . "is an unknown CTCP query")
- (query_unbalanced . "[UNBALANCED query] from %s to %s content %s")
- (query_unbalanced_reply . "is an unbalanced CTCP query")
- (quit . "[info] %s stopped wasting time: %s") ; user signoff
- (reply . "[reply] from %s to %s content %s") ; ctcp reply
- (reply_unbalanced . "[UNBALANCED reply] from %s to %s content %s")
- (send . "(sent to %s)") ; you sent a message/notice
- (send-multi . "(sent to %s in %d parts)") ; sent a long message/notice
- (sentinel . "\nZenIRC ended at %s") ; process sentinel message
- (server . "[server] %s") ; unknown server message
- (signal . "[signal in %s]") ; signal in echo area
- (topic . "[info] %s changed the topic on %s to: %s") ; topic message
- (wallops . "-%s- %s") ; WALLOPS notice
- )))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; ZenIRC hook handling functions
-;;;
-;;; ZenIRC uses a somewhat nonstandard hook mechanism. Hook symbols
-;;; are manipulated with zenirc-add-hook and zenirc-delete-hook, and
-;;; are executed with zenirc-run-hook. A hook symbol is a list of
-;;; symbols that are function names. When a hook is run with
-;;; zenirc-run-hook, each symbol in the list is run in turn - unless
-;;; one of the hooks sets the variable zenirc-run-next-hook to nil. In
-;;; this case, zenirc-run-hook immediatelly returns to the caller.
-;;; Unlike emacs 19 hooks, ZenIRC hooks are called with arguments.
-;;; ZenIRC hooks return the value of the last hook run.
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun zenirc-run-hook (hooksym &rest args)
- "Take hook name HOOKSYM and run it, passing optional args ARGS.
-HOOKSYM should be a symbol, a hook variable.
-If the hook symbol has a non-nil value, that value may be a function
-or a list of functions to be called to run the hook.
-If the value is a function, it is called with args ARGS.
-If it is a list, the elements are called, in order, with ARGS, if
-zenirc-run-next-hook is t (the default). Otherwise, the hooks after
-the one that set zenirc-run-next-hook are not called, and control is
-returned to the caller. (zenirc-run-hook) returns the value returned
-from the last hook run."
- (let ((zenirc-run-next-hook t)
- (result))
- (and (boundp hooksym)
- (symbol-value hooksym)
- (let ((value (symbol-value hooksym)))
- (if (and (listp value)
- (not (eq (car value) 'lambda)))
- (while (and value zenirc-run-next-hook)
- (setq result (apply (car value) args))
- (setq value (cdr value)))
- (setq result (apply value args)))))
- result))
-
-(defun zenirc-add-hook (hook function &optional append)
- "Add to the value of HOOK the function FUNCTION.
-FUNCTION is not added if already present.
-FUNCTION is added (if necessary) at the beginning of the hook list
-unless the optional argument APPEND is non-nil, in which case
-FUNCTION is added at the end.
-
-HOOK should be a symbol, and FUNCTION may be any valid function. If
-HOOK is void, it is first set to nil. If HOOK's value is a single
-function, it is changed to a list of functions."
- (or (boundp hook) (set hook nil))
- ;; If the hook value is a single function, turn it into a list.
- (let ((old (symbol-value hook)))
- (if (or (not (listp old)) (eq (car old) 'lambda))
- (set hook (list old))))
- (or (if (consp function)
- (member function (symbol-value hook))
- (memq function (symbol-value hook)))
- (set hook
- (if append
- (nconc (symbol-value hook) (list function))
- (cons function (symbol-value hook))))))
-
-(defun zenirc-remove-hook (hook function)
- "Remove from the value of HOOK the function FUNCTION.
-HOOK should be a symbol, and FUNCTION may be any valid function. If
-FUNCTION isn't the value of HOOK, or, if FUNCTION doesn't appear in the
-list of hooks to run in HOOK, then nothing is done. See `add-hook'."
- (if (or (not (boundp hook)) ;unbound symbol, or
- (null (symbol-value hook)) ;value is nil, or
- (null function)) ;function is nil, then
- nil ;Do nothing.
- (let ((hook-value (symbol-value hook)))
- (if (consp hook-value)
- (setq hook-value (delete function hook-value))
- (if (equal hook-value function)
- (setq hook-value nil)))
- (set hook hook-value))))
-
-(fset 'zenirc-delete-hook 'zenirc-remove-hook)
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; ZenIRC time handling functions
-;;;
-;;; These functions are used to implement time handling in ZenIRC.
-;;; Much of this code was lifted from the Kiwi 4.30 irc client.
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun zenirc-time-to-int (timestr)
- "Convert from time in string format as returned by current-time-string
-to a double integer format, as returned by file-attributes.
-
-Written by Stephen Ma <ma_s@maths.su.oz.au>"
- (let* ((norm+ '(lambda (num1 num2)
- (let ((sumh (+ (car num1) (car num2)))
- (suml (+ (car (cdr num1)) (car (cdr num2)))))
- (list (+ sumh (/ suml 65536)) (% suml 65536)))))
- (norm* '(lambda (num1 num2)
- (let ((prodh (* num1 (car num2)))
- (prodl (* num1 (car (cdr num2)))))
- (list (+ prodh (/ prodl 65536)) (% prodl 65536)))))
- (seconds (string-to-int (substring timestr 17 19)))
- (minutes (string-to-int (substring timestr 14 16)))
- (hours (string-to-int (substring timestr 11 13)))
- (partdays (1- (string-to-int (substring timestr 8 10))))
- (years (string-to-int (substring timestr 20 24)))
- (days (+ partdays
- (cond ((and (= (% years 4) 0)
- (/= (% years 100) 0))
- (cdr (assoc (substring timestr 4 7)
- '(("Jan" . 0)
- ("Feb" . 31)
- ("Mar" . 60)
- ("Apr" . 91)
- ("May" . 121)
- ("Jun" . 152)
- ("Jul" . 182)
- ("Aug" . 213)
- ("Sep" . 244)
- ("Oct" . 274)
- ("Nov" . 305)
- ("Dec" . 335)))))
- (t (cdr (assoc (substring timestr 4 7)
- '(("Jan" . 0)
- ("Feb" . 31)
- ("Mar" . 59)
- ("Apr" . 90)
- ("May" . 120)
- ("Jun" . 151)
- ("Jul" . 181)
- ("Aug" . 212)
- ("Sep" . 243)
- ("Oct" . 273)
- ("Nov" . 304)
- ("Dec" . 334))))))
- (* (- years 1970) 365)
- (/ (- years 1969) 4)
- (- (/ (- years 1901) 100)))))
- (funcall norm+
- (funcall norm*
- 60
- (funcall norm+
- (funcall norm*
- 60
- (funcall norm+
- (funcall norm*
- 24
- (list 0 days))
- (list 0 hours)))
- (list 0 minutes)))
- (list 0 seconds))))
-
-(defun zenirc-time= (a b)
- "Compare two times, and return true if they are equal."
- (and (= (nth 0 a) (nth 0 b))
- (= (nth 1 a) (nth 1 b))))
-
-(defun zenirc-time< (a b)
- "Compare two times, and return t if the first is earlier than the second."
- (or (< (nth 0 a) (nth 0 b))
- (and (= (nth 0 a) (nth 0 b))
- (< (nth 1 a) (nth 1 b)))))
-
-(defun zenirc-time-diff (a b)
- "Return the difference between two times. This function requires
-the second argument to be earlier in time than the first argument."
- (cond ((= (nth 0 a) (nth 0 b)) (list 0 (- (nth 1 a) (nth 1 b))))
- ((> (nth 1 b) (nth 1 a)) (list (- (nth 0 a) (nth 0 b) 1)
- (- (+ 65536 (nth 1 a)) (nth 1 b))))
- (t (list (- (nth 0 a) (nth 0 b))
- (- (nth 1 a) (nth 1 b))))))
-
-;; Convert a number of seconds since the epoch (in ASCII) into an
-;; ASCII string representing the time.
-(defun zenirc-epoch-seconds-to-time (seconds)
- (save-match-data
- (let (millions units high low)
- (if (string-match "^\\(.*\\)\\(......\\)$" seconds)
- (setq millions (string-to-int (substring seconds
- (match-beginning 1)
- (match-end 1)))
- units (string-to-int (substring seconds
- (match-beginning 2)
- (match-end 2))))
- (setq millions 0
- units (string-to-int seconds)))
- (setq high (+ (* millions 15) (/ (* millions 265) 1024) (/ units 65536))
- low (+ (% (+ (* (% millions 4) 16384) (* millions 576)) 65536)
- (% units 65536)))
- (if (> low 65535)
- (setq low (- low 65536)
- high (1+ high)))
- (list high low))))
-
-(defun zenirc-timer-handler (proc)
- "Call zenirc-timer-hook as often as possible. The maximum delay between
-calls of zenirc-timer-hook is how often a server pings the client."
- (let ((now (zenirc-time-to-int (current-time-string))))
- (if (zenirc-time< '(0 0) (zenirc-time-diff now zenirc-time-last-event))
- (progn
- (and zenirc-debug-timer
- (zenirc-message proc
- "[debug] timer: %s\n" (current-time-string)))
- (zenirc-run-hook 'zenirc-timer-hook proc now)
- (setq zenirc-time-last-event now)))))
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; command handling subroutines
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-(defun zenirc-insert-at-proc-mark (&rest args)
- (cond ((= (point) zenirc-process-mark)
- (apply 'insert args))
- (t
- (let ((point (point-marker)))
- (goto-char zenirc-process-mark)
- (apply 'insert args)
- (goto-char point)))))
-
-(defun zenirc-send-privmsg-last-rec ()
- (interactive)
- (zenirc-insert-at-proc-mark (concat (char-to-string zenirc-command-char)
- "msg ") zenirc-privmsg-last-rec " "))
-
-(defun zenirc-send-privmsg-last-sent ()
- (interactive)
- (zenirc-insert-at-proc-mark (concat (char-to-string zenirc-command-char)
- "msg ") zenirc-privmsg-last-sent " "))
-
-(defun zenirc-self-insert-or-send-privmsg-last-rec ()
- (interactive)
- (if (zenirc-beginning-of-input-p)
- (zenirc-send-privmsg-last-rec)
- (if (string-match "XEmacs" emacs-version)
- (insert last-command-char)
- (insert (this-command-keys)))))
-
-(defun zenirc-self-insert-or-send-privmsg-last-sent ()
- (interactive)
- (if (zenirc-beginning-of-input-p)
- (zenirc-send-privmsg-last-sent)
- (if (string-match "XEmacs" emacs-version)
- (insert last-command-char)
- (insert (this-command-keys)))))
-
-;; change zenirc-current-victim by toggling between all channels in
-;; zenirc-channel-list, original code by <vuori@sci.fi>
-(defun zenirc-toggle-channel ()
- (interactive)
- (let ((list zenirc-channel-list)
- (orig-victim zenirc-current-victim))
- (while list
- (if (string-equal (zenirc-downcase-name zenirc-current-victim)
- (car list))
- ; this is the current victim cell of the list
- (if (cdr list)
- ; it's not the last cell
- (setq zenirc-current-victim (or (car (cdr list))
- zenirc-current-victim)
- list nil)
- ; it is the last cell, use the first cell
- (setq zenirc-current-victim (car zenirc-channel-list))))
- (setq list (cdr list)))
- ; if the victim wasn't in the zenirc-channel-list, default to
- ; first cell of zenirc-channel-list
- (if (string-equal orig-victim zenirc-current-victim)
- (setq zenirc-current-victim (car zenirc-channel-list)))
- (zenirc-update-modeline)))
-
-;; /action victim text
-;; send a ctcp action to the specified victim
-(defun zenirc-command-action (proc parsed)
- (let* ((l (zenirc-parse-firstword (cdr parsed)))
- (n (zenirc-send-multi-line proc
- (concat "PRIVMSG " (car l))
- (concat "\^AACTION " (cdr l) "\^A"))))
- (zenirc-run-hook 'zenirc-send-confirmation-me-hook
- proc 'send-multi 'send (car l) n)))
-
-;; /away [message]
-;; set your away message (or remove it if not present)
-(defun zenirc-command-away (proc parsedcmd)
- (process-send-string proc (concat "AWAY :" (cdr parsedcmd) "\n")))
-
-;; /command-char command-char
-;; No string does nothing.
-(defun zenirc-command-command-char (proc parsedcmd)
- (if (not (string= "" (cdr parsedcmd)))
- (setq zenirc-command-char (string-to-char (cdr parsedcmd)))))
-
-;; /ctcp victim query [text]
-;; does the ^A ctcp things and uppercases the argument.
-(defun zenirc-command-ctcp (proc parsedcmd)
- (let* ((parsedarg (zenirc-parse-firstword (cdr parsedcmd)))
- (argument (zenirc-parse-firstword (cdr parsedarg))))
- (process-send-string
- proc
- (concat "PRIVMSG "
- (car parsedarg)
- " :\C-a"
- (upcase (car argument))
- (if (not (string-equal "" (cdr argument)))
- " ")
- (cdr argument)
- "\C-a\n"))))
-
-;; /kick nick #channel [reason]
-(defun zenirc-command-kick (proc parsedcmd)
- (let* ((l (zenirc-parse-n-words 2 (cdr parsedcmd)))
- (n (length l))
- (v [nil nil "KICK %s %s\n" "KICK %s %s :%s\n"]))
- (cond ((< n 2)
- ;; Invalid format for command
- (zenirc-message proc 's421
- (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
- (t
- (process-send-string proc (apply 'format (aref v n) l))))))
-
-;; /kill nick reason
-(defun zenirc-command-kill (proc parsedcmd)
- (let* ((l (zenirc-parse-n-words 1 (cdr parsedcmd)))
- (n (length l))
- (v [nil "KILL %s\n" "KILL %s :%s\n"]))
- (cond ((< n 1)
- ;; Invalid format for command
- (zenirc-message proc 's421
- (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
- (t
- (process-send-string proc (apply 'format (aref v n) l))))))
-
-;; /language [lang]
-;; switches message catalogs
-;; note that you must have the catalog in question loaded already, before
-;; you can switch to it.
-(defun zenirc-command-language (proc parsedcmd)
- (let ((lang (car (zenirc-parse-firstword (cdr parsedcmd)))))
- (zenirc-lang-set-current-language lang)))
-
-;; /m victim message
-;; send a message to someone who is not the current victim
-(defun zenirc-command-m (proc parsedmsg)
- (zenirc-command-privmsg proc parsedmsg))
-
-;; /me message
-;; send a ctcp action to the current victim
-(defun zenirc-command-me (proc parsed)
- (let ((n (zenirc-send-multi-line proc
- (concat "PRIVMSG " zenirc-current-victim)
- (concat "\^AACTION " (cdr parsed) "\^A"))))
- (zenirc-run-hook 'zenirc-send-confirmation-me-hook
- proc 'send-multi 'send
- zenirc-current-victim n)))
-
-;; /msg victim message
-;; send a message to someone who is not the current victim
-(defun zenirc-command-msg (proc parsedmsg)
- (zenirc-command-privmsg proc parsedmsg))
-
-;; /oper handler
-;;
-;; Always remember, the lame deserve to lose.
-;;
-;; I did not add this, but neither do I have any intention of removing it.
-;; --friedman
-;; Neither have I, removing this would be like removing the spirit of ZenIRC.
-;; --pp
-(defun zenirc-command-oper (proc parsedmsg)
- (process-send-string proc (concat "QUIT :" (cdr parsedmsg) "\n")))
-
-;; /notice nick message
-(defun zenirc-command-notice (proc parsedmsg)
- (let* ((pair (zenirc-parse-firstword (cdr parsedmsg)))
- (n (zenirc-send-multi-line proc
- (concat "NOTICE " (car pair))
- (cdr pair))))
- (setq zenirc-privmsg-last-sent (car pair))
- (zenirc-run-hook 'zenirc-send-confirmation-notice-hook
- proc 'send-multi 'send (car pair) n)))
-
-;; /part channel [message]
-;; exit channel, displaying optional message
-(defun zenirc-command-part (proc parsedcmd)
- (let* ((parsedtext (zenirc-parse-firstword (cdr parsedcmd))))
- (if (not (string= (cdr parsedtext) ""))
- (process-send-string proc (concat "PART " (car parsedtext)
- " :" (cdr parsedtext) "\n"))
- (process-send-string proc (concat
- "PART " (car parsedtext)
- " :Started wasting time elsewhere\n")))))
-
-;; /ping victim
-;; TODO: Rewrite this code.
-(defun zenirc-command-ping (proc parsedmsg)
- (process-send-string
- proc
- (concat "PRIVMSG " (cdr parsedmsg) " :\C-aPING "
- (car (cdr (zenirc-time-to-int (current-time-string)))) "\C-a\n")))
-
-;; /privmsg victim message
-(defun zenirc-command-privmsg (proc parsedmsg)
- (let* ((pair (zenirc-parse-firstword (cdr parsedmsg)))
- (n (zenirc-send-multi-line proc
- (concat "PRIVMSG " (car pair))
- (cdr pair))))
- (setq zenirc-privmsg-last-sent (car pair))
- (zenirc-run-hook 'zenirc-send-confirmation-privmsg-hook
- proc 'send-multi 'send (car pair) n)))
-
-;; /query [victim]
-;; If we gave it an argument, set zenirc-current-victim to that arg.
-;; If not, just display what zenirc-current-victim is.
-(defun zenirc-command-query (proc parsedmsg)
- (if (not (string= (cdr parsedmsg) ""))
- (setq zenirc-current-victim
- (car (zenirc-parse-firstword (cdr parsedmsg))))
- ;; no arguments, just display who we're querying.
- (zenirc-message proc 'now_querying zenirc-current-victim))
- (zenirc-update-modeline))
-
-;; /quit [message]
-;; exit irc, displaying optional message
-(defun zenirc-command-quit (proc parsedcmd)
- (if (string= "" (cdr parsedcmd))
- (process-send-string proc "QUIT :Started wasting time elsewhere\n")
- (process-send-string proc (concat "QUIT :" (cdr parsedcmd) "\n"))))
-
-;; /quote [raw irc command]
-;;
-;; send raw text to irc server
-(defun zenirc-command-quote (proc parsedcmd)
- (process-send-string proc (concat (cdr parsedcmd) "\n")))
-
-;; /server [server [port [nickname]]]
-(defun zenirc-command-server (proc parsedcmd)
- (if (string= "" (cdr parsedcmd))
- (zenirc-select)
- (let* ((parsedarg (cdr parsedcmd)))
- (zenirc-select (car (zenirc-parse-n-words 1 parsedarg))
- (or (car (cdr (zenirc-parse-n-words 2 parsedarg)))
- zenirc-port)
- (or (car (cdr (cdr (zenirc-parse-n-words 3 parsedarg))))
- zenirc-nick)))))
-
-;; /squit server [reason]
-(defun zenirc-command-squit (proc parsedcmd)
- (let* ((l (zenirc-parse-n-words 1 (cdr parsedcmd)))
- (n (length l))
- (v [nil "SQUIT %s\n" "SQUIT %s :%s\n"]))
- (cond ((< n 1)
- ;; Invalid format for command
- (zenirc-message proc 's421
- (format "/%s %s" (car parsedcmd) (cdr parsedcmd))))
- (t
- (process-send-string proc (apply 'format (aref v n) l))))))
-
-;; /topic channel [topic_string]
-;;
-;; set the topic of a channel to `topic string'
-(defun zenirc-command-topic (proc parsedcmd)
- (let* ((parsedtext (zenirc-parse-firstword (cdr parsedcmd))))
- (if (not (string= (cdr parsedtext) ""))
- (process-send-string proc (concat "TOPIC " (car parsedtext)
- " :" (cdr parsedtext) "\n"))
- (process-send-string proc (concat "TOPIC " (car parsedtext) "\n")))))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; server message handling subroutines
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;; handle ERROR server message
-(defun zenirc-server-ERROR (proc parsedmsg)
- (zenirc-message proc 'error (aref parsedmsg 1) (aref parsedmsg 2)))
-
-;; INVITE - user invites you to channel
-(defun zenirc-server-INVITE (proc parsedmsg)
- (zenirc-message proc 'invite
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref parsedmsg 1))
- (aref parsedmsg 3)))
-
-;; NICK change server message
-(defun zenirc-server-NICK (proc parsedmsg)
- (let ((from (aref parsedmsg 1))
- (to (aref parsedmsg 2)))
- (and (zenirc-names-equal-p (zenirc-extract-nick from) zenirc-nick)
- (progn
- (setq zenirc-nick to)
- (force-mode-line-update)))
- (zenirc-message proc 'nick
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; NOTICE server message
-(defun zenirc-server-NOTICE (proc parsedmsg)
- (zenirc-privmsg-or-notice proc parsedmsg))
-
-;; JOIN server message
-;; zenirc-current-victim is the current channel your msgs will go to.
-(defun zenirc-server-JOIN (proc parsedmsg)
- (let ((who (aref parsedmsg 1))
- (channel (aref parsedmsg 2))
- (mode nil))
- (if (zenirc-names-equal-p (zenirc-extract-nick who) zenirc-nick)
- (progn
- (setq zenirc-current-victim (aref parsedmsg 2))
- (setq zenirc-channel-list (cons (zenirc-downcase-name
- (aref parsedmsg 2))
- zenirc-channel-list))
- (zenirc-update-modeline)
- (zenirc-message proc 'join_you zenirc-current-victim))
-
- (if (string-match "
\a" channel) ; <dl> are people stupid or what?
- (setq channel (substring (aref parsedmsg 2) 0 (- (match-end 0) 1))
- mode (substring (aref parsedmsg 2) (match-end 0)
- (length (aref parsedmsg 2)))))
- (if mode
- (zenirc-message proc 'join_mode
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- who) channel mode)
- (zenirc-message proc 'join
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook who)
- channel)))))
-
-;; KICK - you have been removed from a channel
-;; (KICK kicker #chan kickee [reason])
-(defun zenirc-server-KICK (proc parsedmsg)
- (if (not (zenirc-names-equal-p (aref parsedmsg 3) zenirc-nick))
- ;; someone else got kicked
- (zenirc-message proc 'kick
- (aref parsedmsg 3)
- (aref parsedmsg 2)
- (format "%s - %s"
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref parsedmsg 1))
- (aref parsedmsg 4)))
- ;; you got kicked
- (zenirc-message proc 'kick_you
- (aref parsedmsg 2)
- (format "%s - %s"
- (zenirc-extract-nick (aref parsedmsg 1))
- (aref parsedmsg 4)))
- (if (zenirc-names-equal-p (aref parsedmsg 2) zenirc-current-victim)
- (setq zenirc-current-victim nil))))
-
-;; KILL - you have been killed
-(defun zenirc-server-KILL (proc parsedmsg)
- (zenirc-message proc 'kill (aref parsedmsg 3)))
-
-;; MODE - channel or user mode change
-;;
-;; MODE from <channel> {[+|-]|o|p|s|i|t|n|b|v} [<limit>] [<user>] [<ban mask>]
-;; MODE from <nickname> {[+|-]|i|w|s|o}
-;;
-;; Sum of channel `b' and `o' mode changes <= 3, so at most 5 args appear
-;; after the the channel mode flags (three `b' or `o's, a `k', and an `l').
-;; Current actual server implementation seems to limit this to 4 args.
-(defun zenirc-server-MODE (proc parsedmsg)
- (zenirc-message proc 'mode
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref parsedmsg 1))
- (aref parsedmsg 2)
- (format "%s %s %s %s %s %s"
- (or (aref parsedmsg 3) "")
- (or (aref parsedmsg 4) "")
- (or (aref parsedmsg 5) "")
- (or (aref parsedmsg 6) "")
- (or (aref parsedmsg 7) "")
- (or (aref parsedmsg 8) ""))))
-
-;; PART - channel leave message
-(defun zenirc-server-PART (proc parsedmsg)
- (let ((channel (aref parsedmsg 2))
- (who (aref parsedmsg 1))
- ; As of ircd 2.9.1, you can send comments in your PART
- ; message just like with QUIT. Thanks to this you can
- ; always manage to get the last word in a serious
- ; discussion.
- ;
- ; :Omnion!~pp@sno.pp.se PART #twilight_zone :grow up, piker
- (reason (or (aref parsedmsg 3)
- ; on a 2.8 PART message, use nickname as comment
- (zenirc-extract-nick (aref parsedmsg 1)))))
- (if (zenirc-names-equal-p (zenirc-extract-nick who) zenirc-nick)
- (progn
- (zenirc-message proc 'part_you channel reason)
- (setq zenirc-channel-list (delete (zenirc-downcase-name channel)
- zenirc-channel-list))
- (and zenirc-current-victim
- (zenirc-names-equal-p channel zenirc-current-victim)
- (setq zenirc-current-victim (car zenirc-channel-list))))
- (zenirc-message proc 'part
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook who)
- channel reason))))
-
-;; PONG - server "is alive" message
-(defun zenirc-server-PONG (proc parsedmsg)
- (zenirc-message proc 'pong (aref parsedmsg 1)))
-
-;; PING - server "are you alive" message
-(defun zenirc-server-PING (proc parsedmsg)
- (process-send-string proc (concat "PONG " (aref parsedmsg 2) "\n")))
-
-;; PRIVMSG server message
-(defun zenirc-server-PRIVMSG (proc parsedmsg)
- (zenirc-privmsg-or-notice proc parsedmsg))
-
-;; QUIT - someone (thankfully) left irc.
-(defun zenirc-server-QUIT (proc parsedmsg)
- (zenirc-message proc 'quit
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref parsedmsg 1))
- (aref parsedmsg 2)))
-
-;; TOPIC - someone set the topic on a channel
-(defun zenirc-server-TOPIC (proc parsedmsg)
- (zenirc-message proc 'topic
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook
- (aref parsedmsg 1))
- (aref parsedmsg 2)
- (aref parsedmsg 3)))
-
-;; WALLOPS - notice to operators
-(defun zenirc-server-WALLOPS (proc parsedmsg)
- (zenirc-message proc 'wallops (aref parsedmsg 1) (aref parsedmsg 2)))
-
-;; 001 - welcome to irc
-(defun zenirc-server-001 (proc parsedmsg)
- (setq zenirc-nick (aref parsedmsg 2))
- (zenirc-message proc 's001))
-
-;; 002 - who is your server
-;; hostname regexp [-a-zA-Z.0-9]
-(defun zenirc-server-002 (proc parsedmsg)
- (let ((str (aref parsedmsg 3)))
- (if (string-match
- "Your host is \\([-a-zA-Z.0-9]+\\), running version \\(.*\\)"
- str)
- (zenirc-message proc 's002
- (zenirc-match-string 1 str)
- (zenirc-match-string 2 str))
- (zenirc-message proc 'protocol_violation
- (aref parsedmsg 1)
- (aref parsedmsg 3)))))
-
-;; 003 - when this server was built
-(defun zenirc-server-003 (proc parsedmsg)
- (let ((str (aref parsedmsg 3)))
- (if (string-match "This server was created \\(.*\\)" str)
- (zenirc-message proc 's003 (zenirc-match-string 1 str))
- (zenirc-message proc 'protocol_violation
- (aref parsedmsg 1)
- (aref parsedmsg 3)))))
-
-;; 004 - version and allowed modes information
-(defun zenirc-server-004 (proc parsedmsg)
- (setq zenirc-current-server-name (aref parsedmsg 3))
- (setq zenirc-server-version (aref parsedmsg 4))
- (setq zenirc-user-modes (aref parsedmsg 5))
- (setq zenirc-server-modes (aref parsedmsg 6)))
-
-;; 200 RPL_TRACELINK - {<server>} Link -> Version: <version>
-;; 200 RPL_TRACELINK - {<server>} (version) Link to: -> <server>
-(defun zenirc-server-200 (proc parsedmsg)
- (zenirc-message proc 's200
- (aref parsedmsg 1)
- (aref parsedmsg 4)
- (aref parsedmsg 6)))
-
-;; 201 RPL_TRACECONNECTING
-(defun zenirc-server-201 (proc parsedmsg)
- (zenirc-message proc 's201 (aref parsedmsg 1) (aref parsedmsg 5)))
-
-;; 202 RPL_TRACEHANDSHAKE
-(defun zenirc-server-202 (proc parsedmsg)
- (zenirc-message proc 's202 (aref parsedmsg 1) (aref parsedmsg 5)))
-
-;; 203 RPL_TRACEUNKNOWN - {<server>} Unknown -> IP address : <ip#>
-(defun zenirc-server-203 (proc parsedmsg)
- (zenirc-message proc 's203 (aref parsedmsg 1) (aref parsedmsg 5)))
-
-;; 204 RPL_TRACEOPERATOR {<server>} Oper -> <nick[host]>
-(defun zenirc-server-204 (proc parsedmsg)
- (zenirc-message proc 's204 (aref parsedmsg 1) (aref parsedmsg 5)))
-
-;; 205 RPL_TRACEUSER {<server>} Luser -> <nick[host]>
-(defun zenirc-server-205 (proc parsedmsg)
- (zenirc-message proc 's205 (aref parsedmsg 1) (aref parsedmsg 5)))
-
-;; 206 RPL_TRACESERVER {<server>} Server -> <server> Class: <#> S: <#> C: <#>
-(defun zenirc-server-206 (proc parsedmsg)
- (zenirc-message proc 's206
- (aref parsedmsg 1)
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 6)
- (aref parsedmsg 7)))
-
-;; 208 RPL_TRACENEWTYPE
-(defun zenirc-server-208 (proc parsedmsg)
- (zenirc-message proc 's208
- (aref parsedmsg 1)
- (aref parsedmsg 3)
- (aref parsedmsg 5)))
-
-;; 209 RPL_TRACECLASS {<server}> Class -> type = blah
-(defun zenirc-server-209 (proc parsedmsg)
- (zenirc-message proc 's209
- (aref parsedmsg 1)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 211 RPL_STATLINKINFO
-(defun zenirc-server-211 (proc parsedmsg)
- (zenirc-message proc 's211
- (aref parsedmsg 3)
- (aref parsedmsg 9)
- (aref parsedmsg 5)
- (aref parsedmsg 6)
- (aref parsedmsg 7)
- (aref parsedmsg 8)
- (aref parsedmsg 4)))
-
-;; 212 RPL_STATSCOMMANDS
-(defun zenirc-server-212 (proc parsedmsg)
- (zenirc-message proc 's212
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 213 RPL_STATSCLINE
-(defun zenirc-server-213 (proc parsedmsg)
- (zenirc-message proc 's213
- (aref parsedmsg 4)
- (aref parsedmsg 6)
- (aref parsedmsg 7)
- (aref parsedmsg 8)))
-
-;; 214 RPL_STATSNLINE
-(defun zenirc-server-214 (proc parsedmsg)
- (zenirc-message proc 's214
- (aref parsedmsg 4)
- (aref parsedmsg 6)
- (aref parsedmsg 7)
- (aref parsedmsg 8)))
-
-;; 215 RPL_STATSILINE
-(defun zenirc-server-215 (proc parsedmsg)
- (zenirc-message proc 's215
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 6)
- (aref parsedmsg 8)))
-
-;; 216 RPL_STATSKLINE
-(defun zenirc-server-216 (proc parsedmsg)
- (zenirc-message proc 's216 (aref parsedmsg 4) (aref parsedmsg 6)))
-
-;; 217 RPL_STATSQLINE
-(defun zenirc-server-217 (proc parsedmsg)
- (zenirc-message proc 's217
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 6)
- (aref parsedmsg 7)
- (aref parsedmsg 8)))
-
-;; 218 RPL_STATSYLINE
-(defun zenirc-server-218 (proc parsedmsg)
- (zenirc-message proc 's218
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 6)
- (aref parsedmsg 7)
- (aref parsedmsg 8)))
-
-;; 219 RPL_ENDOFSTATS
-(defun zenirc-server-219 (proc parsedmsg)
- (zenirc-message proc 's219))
-
-;; 221 RPL_UMODEIS
-(defun zenirc-server-221 (proc parsedmsg)
- (zenirc-message proc 's221 (aref parsedmsg 3)))
-
-;; 241 RPL_STATSLLINE
-(defun zenirc-server-241 (proc parsedmsg)
- (zenirc-message proc 's241 (aref parsedmsg 4) (aref parsedmsg 6)))
-
-;; 242 RPL_STATSUPTIME
-(defun zenirc-server-242 (proc parsedmsg)
- (zenirc-message proc 's242 (aref parsedmsg 3)))
-
-;; 243 RPL_STATSOLINE
-(defun zenirc-server-243 (proc parsedmsg)
- (zenirc-message proc 's243
- (aref parsedmsg 3)
- (aref parsedmsg 6)
- (aref parsedmsg 4)))
-
-;; 244 RPL_STATSHLINE
-(defun zenirc-server-244 (proc parsedmsg)
- (zenirc-message proc 's244 (aref parsedmsg 4) (aref parsedmsg 6)))
-
-;; 249 RPL_STATSZLINE
-(defun zenirc-server-249 (proc parsedmsg)
- (zenirc-message proc 's249 (aref parsedmsg 1) (aref parsedmsg 3)))
-
-;; 251 - :server 251 ZenIRC :There are x users and y invisible on z servers
-;; :server 251 ZenIRC :There are x users and y services on z servers
-(defun zenirc-server-251 (proc parsedmsg)
- (let ((str (aref parsedmsg 3)))
- (if (string-match "There are \\([0-9]+\\) users and \\([0-9]+\\) invisible on \\([0-9]+\\) servers" str)
- (zenirc-message proc 's251
- (zenirc-match-string 1 str)
- (zenirc-match-string 2 str)
- (zenirc-match-string 3 str))
- (if (string-match "There are \\([0-9]+\\) users and \\([0-9]+\\) services on \\([0-9]+\\) servers" str)
- (zenirc-message proc 's251-29
- (zenirc-match-string 1 str)
- (zenirc-match-string 2 str)
- (zenirc-match-string 3 str))
- (zenirc-message proc 'protocol_violation
- (aref parsedmsg 1) (aref parsedmsg 3))))))
-
-;; 252 - number of irc operators online
-(defun zenirc-server-252 (proc parsedmsg)
- (zenirc-message proc 's252 (aref parsedmsg 3)))
-
-;; 253 - number of "unknown" connections
-(defun zenirc-server-253 (proc parsedmsg)
- (zenirc-message proc 's253 (aref parsedmsg 3)))
-
-;; 254 - number of channels
-(defun zenirc-server-254 (proc parsedmsg)
- (zenirc-message proc 's254 (aref parsedmsg 3)))
-
-;; 255 - :server 255 ZenIRC :I have x clients and y servers
-;; :server 255 ZenIRC :I have x clients, y services and z servers
-(defun zenirc-server-255 (proc parsedmsg)
- (let ((str (aref parsedmsg 3)))
- (if (string-match "I have \\([0-9]+\\) clients and \\([0-9]+\\) servers" str)
- (zenirc-message proc 's255
- (substring str (match-beginning 1) (match-end 1))
- (substring str (match-beginning 2) (match-end 2)))
- (if (string-match "I have \\([0-9]+\\) clients, \\([0-9]+\\) services and \\([0-9]+\\) servers" str)
- (zenirc-message proc 's255-29
- (substring str (match-beginning 1) (match-end 1))
- (substring str (match-beginning 2) (match-end 2))
- (substring str (match-beginning 3) (match-end 3)))
- (zenirc-message proc 'protocol_violation
- (aref parsedmsg 1) (aref parsedmsg 3))))))
-
-;; 256 - line 1 of /admin information
-(defun zenirc-server-256 (proc parsedmsg)
- (zenirc-message proc 's256 (aref parsedmsg 1)))
-
-;; 257 - line 2 of /admin information
-(defun zenirc-server-257 (proc parsedmsg)
- (zenirc-message proc 's257 (aref parsedmsg 3)))
-
-;; 258 - line 2 of /admin information
-(defun zenirc-server-258 (proc parsedmsg)
- (zenirc-message proc 's258 (aref parsedmsg 3)))
-
-;; 259 - line 4 of /admin information
-(defun zenirc-server-259 (proc parsedmsg)
- (zenirc-message proc 's259 (aref parsedmsg 3)))
-
-;; 261 RPL_TRACELOG
-(defun zenirc-server-261 (proc parsedmsg)
- (zenirc-message proc 's261
- (aref parsedmsg 1)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 262 - RPL_TRACEEND
-(defun zenirc-server-262 (proc parsedmsg)
- (zenirc-message proc 's262
- (aref parsedmsg 1)
- (aref parsedmsg 4)))
-
-;; 301 - someone is /away
-(defun zenirc-server-301 (proc parsedmsg)
- (zenirc-message proc 's301 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 302 - Userhost reply - RPL_USERHOST ":[<reply>{<space><reply>}]"
-(defun zenirc-server-302 (proc parsedmsg)
- (zenirc-message proc 's302 (aref parsedmsg 3)))
-
-;; 303 - Ison reply - RPL_ISON ":[<nick> {<space><nick>}]"
-(defun zenirc-server-303 (proc parsedmsg)
- (zenirc-message proc 's303 (aref parsedmsg 3)))
-
-;; 305 - you are not /away
-(defun zenirc-server-305 (proc parsedmsg)
- (zenirc-message proc 's305))
-
-;; 306 - you are /away
-(defun zenirc-server-306 (proc parsedmsg)
- (zenirc-message proc 's306))
-
-;; 311 - userinfo for /whois list
-(defun zenirc-server-311 (proc parsedmsg)
- (zenirc-message proc 's311
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 7)))
-
-;; 312 - server part of /whois list
-(defun zenirc-server-312 (proc parsedmsg)
- (zenirc-message proc 's312
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 313 - /whois list reply indicating irc operator
-(defun zenirc-server-313 (proc parsedmsg)
- (zenirc-message proc 's313 (aref parsedmsg 3)))
-
-;; 314 - /whowas reply
-(defun zenirc-server-314 (proc parsedmsg)
- (zenirc-message proc 's314
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 7)))
-
-;; 315 - end of /who list
-(defun zenirc-server-315 (proc parsedmsg)
- (zenirc-message proc 's315))
-
-;; 317 - /whois list idle time reply
-(defun zenirc-server-317 (proc parsedmsg)
- (let ((hours (/ (string-to-int (aref parsedmsg 4)) 3600)))
- (let ((minutes (- (/ (string-to-int (aref parsedmsg 4)) 60)
- (* hours 60))))
- (let ((seconds (- (string-to-int (aref parsedmsg 4))
- (* hours 3600)
- (* minutes 60))))
- (let ((hours (int-to-string hours))
- (minutes (int-to-string minutes))
- (seconds (int-to-string seconds)))
- (if (= (length minutes) 1)
- (setq minutes (concat "0" minutes)))
- (if (= (length seconds) 1)
- (setq seconds (concat "0" seconds)))
- (let ((idle-string (concat
- hours ":" minutes ":" seconds)))
- (zenirc-message proc 's317
- (aref parsedmsg 3)
- idle-string)))))))
-
-;; 318 - end of /whois list
-(defun zenirc-server-318 (proc parsedmsg)
- (zenirc-message proc 's318))
-
-;; 319 - what channels part of /whois list
-(defun zenirc-server-319 (proc parsedmsg)
- (zenirc-message proc 's319 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 321 - header for /list command
-;; This reply was removed as of ircd 2.9.1.
-(defun zenirc-server-321 (proc parsedmsg)
- (zenirc-message proc 's321))
-
-;; 322 - element returned by /list
-(defun zenirc-server-322 (proc parsedmsg)
- (zenirc-message proc 's322
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 323 - trailer for /list command
-(defun zenirc-server-323 (proc parsedmsg)
- (zenirc-message proc 's323))
-
-;; 324 - RPL_CHANNELMODEIS "<channel> <mode> <mode params>"
-(defun zenirc-server-324 (proc parsedmsg)
- (zenirc-message proc 's324
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (or (aref parsedmsg 5) "")))
-
-;; 331 - RPL_NOTOPIC "<channel> :No topic is set"
-(defun zenirc-server-331 (proc parsedmsg)
- (zenirc-message proc 's331 (aref parsedmsg 3)))
-
-;; 332 - channel topic on join, etc.
-(defun zenirc-server-332 (proc parsedmsg)
- (zenirc-message proc 's332 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 333 - user who set topic and when it was set
-;; :server 333 to channel who-set-topic time-when-set
-(defun zenirc-server-333 (proc parsedmsg)
- (zenirc-message proc 's333
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (current-time-string (zenirc-epoch-seconds-to-time
- (aref parsedmsg 5)))))
-
-;; 341 - invite reply
-(defun zenirc-server-341 (proc parsedmsg)
- (zenirc-message proc 's341 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 342 - RPL_SUMMONING "<user> :Summoning user to IRC"
-(defun zenirc-server-342 (proc parsedmsg)
- (zenirc-message proc 's342 (aref parsedmsg 3)))
-
-;; 351 - RPL_VERSION "<version>.<debuglevel> <server> :<comments>"
-(defun zenirc-server-351 (proc parsedmsg)
- (zenirc-message proc 's351
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 352 - WHO reply
-(defun zenirc-server-352 (proc parsedmsg)
- (if (string= (aref parsedmsg 3) "Channel")
- ;; this is the header
- (zenirc-message proc 's352_header)
- ;; this is a reply
- (zenirc-message proc 's352
- (aref parsedmsg 7)
- (aref parsedmsg 8)
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)
- (aref parsedmsg 9))))
-
-;; 353 - name list after channel join or NAMES command
-(defun zenirc-server-353 (proc parsedmsg)
- (zenirc-message proc 's353 (aref parsedmsg 4) (aref parsedmsg 5)))
-
-;; 364 - RPL_LINKS "<mask> <server> :<hopcount> <server info>"
-(defun zenirc-server-364 (proc parsedmsg)
- (zenirc-message proc 's364
- (aref parsedmsg 3)
- (aref parsedmsg 4)
- (aref parsedmsg 5)))
-
-;; 365 - RPL_ENDOFLINKS "<mask> :End of /LINKS list"
-(defun zenirc-server-365 (proc parsedmsg)
- (zenirc-message proc 's365 (aref parsedmsg 3)))
-
-;; 366 - after all ppl on channel displayed
-(defun zenirc-server-366 (proc parsedmsg) ())
-
-;; 367 - RPL_BANLIST "<channel> <banid>"
-(defun zenirc-server-367 (proc parsedmsg)
- (zenirc-message proc 's367 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 368 - RPL_RPL_ENDOFBANLIST
-(defun zenirc-server-368 (proc parsedmsg)
- (zenirc-message proc 's368))
-
-;; 369 - end of whowas
-(defun zenirc-server-369 (proc parsedmsg) ())
-
-;; 371 - RPL_INFO ":<string>"
-(defun zenirc-server-371 (proc parsedmsg)
- (zenirc-message proc 's371 (aref parsedmsg 3)))
-
-;; 372 - motd line
-(defun zenirc-server-372 (proc parsedmsg)
- (zenirc-message proc 's372 (aref parsedmsg 3)))
-
-;; 374 - RPL_ENDOFINFO ":End of /INFO list"
-(defun zenirc-server-374 (proc parsedmsg) ())
-
-;; 375 - start of /MOTD
-(defun zenirc-server-375 (proc parsedmsg)
- (zenirc-message proc 's375))
-
-;; 376 - end of /MOTD
-(defun zenirc-server-376 (proc parsedmsg)
- (zenirc-message proc 's376))
-
-;; 381 - RPL_YOUREOPER ":You are now an IRC operator"
-(defun zenirc-server-381 (proc parsedmsg)
- (zenirc-message proc 's381))
-
-;; 382 - RPL_REHASHING "<config file> :Rehashing"
-(defun zenirc-server-382 (proc parsedmsg)
- (zenirc-message proc 's382 (aref parsedmsg 3)))
-
-;; 391 - RPL_TIME "<server> :<string showing server's local time>"
-(defun zenirc-server-391 (proc parsedmsg)
- (zenirc-message proc 's391 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 392 - RPL_USERSSTART ":UserID Terminal Host"
-(defun zenirc-server-392 (proc parsedmsg)
- (zenirc-message proc 's392))
-
-;; 393 - RPL_USERS ":%-8s %-9s %-8s"
-(defun zenirc-server-393 (proc parsedmsg)
- (zenirc-message proc 's393 (aref parsedmsg 3)))
-
-;; 394 - RPL_ENDOFUSERS ":End of users"
-(defun zenirc-server-394 (proc parsedmsg) ())
-
-;; 395 - RPL_NOUSERS ":Nobody logged in"
-(defun zenirc-server-395 (proc parsedmsg)
- (zenirc-message proc 's395))
-
-;; 401 - no such nick/channel
-(defun zenirc-server-401 (proc parsedmsg)
- (zenirc-message proc 's401 (aref parsedmsg 3))
- (if zenirc-whowas-on-401
- (process-send-string proc (concat "WHOWAS " (aref parsedmsg 3) "\n"))))
-
-;; 402 - no such server
-(defun zenirc-server-402 (proc parsedmsg)
- (zenirc-message proc 's402 (aref parsedmsg 3)))
-
-;; 403 - ERRNOSUCHCHANNEL "<channel> :No such channel"
-(defun zenirc-server-403 (proc parsedmsg)
- (zenirc-message proc 's403 (aref parsedmsg 3)))
-
-;; 404 - ERR_CANNOTSENDTOCHAN "<channel> :Cannot send to channel"
-(defun zenirc-server-404 (proc parsedmsg)
- (zenirc-message proc 's404 (aref parsedmsg 3)))
-
-;; 405 - ERR_TOOMANYCHANNELS "<channel_name> :You have joined too many channels"
-(defun zenirc-server-405 (proc parsedmsg)
- (zenirc-message proc 's405 (aref parsedmsg 3)))
-
-;; 406 - ERR_WASNOSUCHNICK "<channel_name> :There was no such nickname"
-(defun zenirc-server-406 (proc parsedmsg)
- (zenirc-message proc 's406 (aref parsedmsg 3)))
-
-;; 407 - ERR_TOOMANYTARGETS "<target> :Duplicate recipients. No message delivered"
-(defun zenirc-server-407 (proc parsedmsg)
- (zenirc-message proc 's407 (aref parsedmsg 3)))
-
-;; 409 - ERR_NOORIGIN ":No origin specified"
-(defun zenirc-server-409 (proc parsedmsg)
- (zenirc-message proc 's409))
-
-;; 411 - ERR_NORECIPIENT ":No recipient given (<command>)"
-(defun zenirc-server-411 (proc parsedmsg)
- (zenirc-message proc 's411))
-
-;; 412 - ERR_NOTEXTTOSEND ":No text to send"
-;; you sent a message w/o any text
-(defun zenirc-server-412 (proc parsedmsg)
- (zenirc-message proc 's412))
-
-;; 413 - ERR_NOTOPLEVEL "<mask> :No toplevel domain specified"
-(defun zenirc-server-413 (proc parsedmsg)
- (zenirc-message proc 's413 (aref parsedmsg 3)))
-
-;; 414 - ERR_WILDTOPLEVEL "<mask> :Wildcard in toplevel domain"
-(defun zenirc-server-414 (proc parsedmsg)
- (zenirc-message proc 's414 (aref parsedmsg 3)))
-
-;; 415 - ERR_BADMASK "<server/host> :Bad Server/host mask"
-(defun zenirc-server-415 (proc parsedmsg)
- (zenirc-message proc 's415 (aref parsedmsg 3)))
-
-;; 421 - server detected error in what you sent
-(defun zenirc-server-421 (proc parsedmsg)
- (zenirc-message proc 's421 (aref parsedmsg 3)))
-
-;; 422 - ERR_NOMOTD ":MOTD File is missing"
-(defun zenirc-server-422 (proc parsedmsg)
- (zenirc-message proc 's422))
-
-;; 423 - ERR_NOADMININFO "<server> :No administrative info available"
-(defun zenirc-server-423 (proc parsedmsg)
- (zenirc-message proc 's423 (aref parsedmsg 3)))
-
-;; 424 ERR_FILEERROR ":File error doing <file op> on <file>"
-(defun zenirc-server-424 (proc parsedmsg)
- (zenirc-message proc (aref parsedmsg 3)))
-
-;; 431 ERR_NONICKNAMEGIVEN ":No nickname given"
-(defun zenirc-server-431 (proc parsedmsg)
- (zenirc-message proc 's431))
-
-;; 432 - ERR_ERRONEUSNICKNAME "<nick> :Erroneus nickname"
-(defun zenirc-server-432 (proc parsedmsg)
- (zenirc-message proc 's432 (aref parsedmsg 3)))
-
-;; 433 - ERR_NICKNAMEINUSE "<nick> :Nickname is already in use"
-(defun zenirc-server-433 (proc parsedmsg)
- (zenirc-message proc 's433 (aref parsedmsg 3)))
-
-;; 436 - ERR_NICKCOLLISION "<nick> :Nickname collision KILL"
-(defun zenirc-server-436 (proc parsedmsg)
- (zenirc-message proc 's436 (aref parsedmsg 3)))
-
-;; 437 - ERR_UNAVAILRESOURCE "<nick>/<channel> :Nick/channel is temporarily
-;; unavailable"
-(defun zenirc-server-437 (proc parsedmsg)
- (zenirc-message proc 's437 (aref parsedmsg 3)))
-
-;; 441 - ERR_USERNOTINCHANNEL "<nick> <channel> :They aren't on that channel"
-(defun zenirc-server-441 (proc parsedmsg)
- (zenirc-message proc 's441 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 442 - You are not on that channel
-(defun zenirc-server-442 (proc parsedmsg)
- (zenirc-message proc 's442 (aref parsedmsg 3)))
-
-;; 443 - already on channel invite error
-(defun zenirc-server-443 (proc parsedmsg)
- (zenirc-message proc 's443 (aref parsedmsg 3) (aref parsedmsg 4)))
-
-;; 444 - ERR_NOLOGIN "<user> :User not logged in"
-(defun zenirc-server-444 (proc parsedmsg)
- (zenirc-message proc 's444 (aref parsedmsg 3)))
-
-;; 445 - ERR_SUMMONDISABLED ":SUMMON has been disabled"
-(defun zenirc-server-445 (proc parsedmsg)
- (zenirc-message proc 's445))
-
-;; 446 - ERR_USERSDISABLED ":USERS has been disabled"
-(defun zenirc-server-446 (proc parsedmsg)
- (zenirc-message proc 's446))
-
-;; 451 - ERR_NOTREGISTERED ":You have not registered"
-(defun zenirc-server-451 (proc parsedmsg)
- (zenirc-message proc 's451))
-
-;; 461 - server detected error - not enough parameters
-(defun zenirc-server-461 (proc parsedmsg)
- (zenirc-message proc 's461 (aref parsedmsg 3)))
-
-;; 462 - ERR_ALREADYREGISTRED ":You may not reregister"
-(defun zenirc-server-462 (proc parsedmsg)
- (zenirc-message proc 's462))
-
-;; 463 - ERR_NOPERMFORHOST ":Your host isn't among the privileged"
-(defun zenirc-server-463 (proc parsedmsg)
- (zenirc-message proc 's463))
-
-;; 464 - ERR_PASSWDMISMATCH ":Password incorrect"
-(defun zenirc-server-464 (proc parsedmsg)
- (zenirc-message proc 's464))
-
-;; 465 - ERR_YOUREBANNEDCREEP ":You are banned from this server"
-(defun zenirc-server-465 (proc parsedmsg)
- (zenirc-message proc 's465))
-
-;; 467 - ERR_KEYSET "<channel> :Channel key already set"
-(defun zenirc-server-467 (proc parsedmsg)
- (zenirc-message proc 's467 (aref parsedmsg 3)))
-
-;; 471 - ERR_CHANNELISFULL "<channel> :Cannot join channel (+l)"
-(defun zenirc-server-471 (proc parsedmsg)
- (zenirc-message proc 's471 (aref parsedmsg 3)))
-
-;; 472 - ERR_UNKNOWNMODE "<char> :is unknown mode char to me"
-(defun zenirc-server-472 (proc parsedmsg)
- (zenirc-message proc 's472 (aref parsedmsg 3)))
-
-;; 473 - ERR_INVITEONLYCHAN "<channel> :Cannot join channel (+i)"
-(defun zenirc-server-473 (proc parsedmsg)
- (zenirc-message proc 's473 (aref parsedmsg 3)))
-
-;; 474 - ERR_BANNEDFROMCHAN "<channel> :Cannot join channel (+b)"
-(defun zenirc-server-474 (proc parsedmsg)
- (zenirc-message proc 's474 (aref parsedmsg 3)))
-
-;; 475 - ERR_BADCHANNELKEY "<channel> :Cannot join channel (+k)"
-(defun zenirc-server-475 (proc parsedmsg)
- (zenirc-message proc 's475 (aref parsedmsg 3)))
-
-;; 477 - ERR_NOCHANMODES "<channel> :Channel doesn't support modes"
-(defun zenirc-server-477 (proc parsedmsg)
- (zenirc-message proc 's477 (aref parsedmsg 3)))
-
-;; 481 - ERR_NOPRIVILEGES ":Permission Denied- You're not an IRC operator"
-(defun zenirc-server-481 (proc parsedmsg)
- (zenirc-message proc 's481))
-
-;; 482 - ERR_CHANOPRIVSNEEDED "<channel> :You're not channel operator"
-(defun zenirc-server-482 (proc parsedmsg)
- (zenirc-message proc 's482 (aref parsedmsg 3)))
-
-;; 483 - ERR_CANTKILLSERVER ":You cant kill a server!"
-(defun zenirc-server-483 (proc parsedmsg)
- (zenirc-message proc 's483))
-
-;; 491 - ERR_NOOPERHOST ":No O-lines for your host"
-(defun zenirc-server-491 (proc parsedmsg)
- (zenirc-message proc 's491))
-
-;; 501 - ERR_UMODEUNKNOWNFLAG ":Unknown MODE flag"
-(defun zenirc-server-501 (proc parsedmsg)
- (zenirc-message proc 's501))
-
-;; 502 - ERR_USERSDONTMATCH ":Cant change mode for other users"
-(defun zenirc-server-502 (proc parsedmsg)
- (zenirc-message proc 's502))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;; PRIVMSG/NOTICE and CTCP handling
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(defun zenirc-privmsg-or-notice (proc parsedmsg)
- (let ((from (aref parsedmsg 1)) ; who the message is from
- (to (aref parsedmsg 2)) ; who the message is to
- (text (aref parsedmsg 3)) ; the text of the message
- (type (aref parsedmsg 0))) ; privmsg or notice
- ;; see if privmsg or notice contains ctcp
- (if (not (string-match "\C-a" text))
- (zenirc-format-privmsg-or-notice type from to text proc)
- ;; message contains ctcp. break it up into ctcp and non-ctcp parts
- ;; and handle each.
- (let ((index 0) (ctcp nil) (str "") (len (length text)))
- (while (< index len)
- (if (char-equal (aref text index) ?\C-a)
- ;; we hit a control-a - deal with it.
- (progn
- (if (not (string= str ""))
- ;; we have a string
- (if ctcp
- ;; we are in a ctcp message
- (progn
- (zenirc-handle-ctcp type from to str proc)
- (setq str ""))
- ;; we are in a regular message
- (zenirc-format-privmsg-or-notice type from to str proc)
- (setq str ""))
- ;; we do not have a string
- (if (and (not (= index 0)) ctcp)
- ;; some leper sent a zero length message
- (zenirc-handle-ctcp type from to str proc)))
- (setq ctcp (not ctcp))) ; toggle ctcp state
- ;; we have a regular character
- (setq str (concat str (char-to-string (aref text index)))))
- (setq index (1+ index))
- (if (and (= index len) ctcp)
- ;; someone sent us an ill-formed ctcp message
- (zenirc-unbalanced-ctcp type from to str proc)))))))
-
-;; handle a ctcp message
-(defun zenirc-handle-ctcp (type from to str proc)
- (let* ((parsedctcp (zenirc-parse-firstword str))
- (fmt (if (string= type "PRIVMSG") 'query 'reply))
- (hook-name (format "zenirc-ctcp-%s-%s-hook" fmt (car parsedctcp)))
- (hook (intern-soft hook-name))
- (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)))
- (and zenirc-debug-ctcp
- (zenirc-message proc 'debug hook-name))
- (cond ((and hook
- (boundp hook))
- (zenirc-run-hook hook proc parsedctcp from to))
- ;; Don't ever reply to notices, just privmsgs
- (t
- (and (string= type "PRIVMSG")
- zenirc-send-ctcp-errmsg-on-unknown
- (zenirc-ctcp-errmsg
- type sender to str
- (zenirc-lang-retrieve-catalog-entry 'query_unknown)
- proc))
- (zenirc-message proc fmt sender to str)))))
-
-;; spew a ctcp error
-(defun zenirc-ctcp-errmsg (type from to str whine proc)
- (let ((nick (zenirc-extract-nick from))
- (fmt "NOTICE %s :\C-aERRMSG %s :%s\C-a\n"))
- (process-send-string proc (format fmt nick str whine))))
-
-;; handle an unbalanced ctcp message
-(defun zenirc-unbalanced-ctcp (type from to str proc)
- (let ((sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)))
- (cond
- ((string= type "PRIVMSG")
- (and zenirc-send-ctcp-errmsg-on-unbalanced
- (zenirc-ctcp-errmsg type from to str
- (zenirc-lang-retrieve-catalog-entry 'query_unbalanced_reply)
- proc))
- (zenirc-message proc 'query_unbalanced sender to str))
- (t
- (zenirc-message proc 'reply_unbalanced sender to str)))))
-
-;; format a PRIVMSG or NOTICE and insert it in the zenirc process buffer
-(defun zenirc-format-privmsg-or-notice (type origfrom to text proc)
- (let ((timestr (zenirc-timestamp-string))
- (from (zenirc-run-hook 'zenirc-format-nickuserhost-hook origfrom))
- msgtype)
- (setq zenirc-privmsg-last-seen origfrom)
- (cond
- ((not
- (zenirc-channel-p to))
-
- (or (and zenirc-current-server-name
- (zenirc-names-equal-p from zenirc-current-server-name t))
- (setq zenirc-privmsg-last-rec (zenirc-extract-nick from)))
-
- (if (string= type "PRIVMSG")
- (setq msgtype 'privmsg_you)
- (setq msgtype 'notice_you))
- (zenirc-message proc msgtype
- (if zenirc-timestamp
- (concat from zenirc-timestamp-prefix
- timestr zenirc-timestamp-suffix)
- from)
- text))
- ((and
- (zenirc-names-equal-p to zenirc-current-victim t)
- (not zenirc-always-show-channelname))
-
- (if (string= type "PRIVMSG")
- (setq msgtype 'privmsg_nochannel)
- (setq msgtype 'notice_nochannel))
-
- (zenirc-message proc msgtype
- (if zenirc-timestamp
- (concat from zenirc-timestamp-prefix
- timestr zenirc-timestamp-suffix)
- from)
- text))
- (t
- (if (string= type "PRIVMSG")
- (setq msgtype 'privmsg)
- (setq msgtype 'notice))
- (zenirc-message proc msgtype from
- (if zenirc-timestamp
- (concat to zenirc-timestamp-prefix
- timestr zenirc-timestamp-suffix)
- to)
- text)))))
-
-(defun zenirc-timestamp-string ()
- (substring (current-time-string) 11 16))
-
-\f
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;;;
-;;; ctcp handlers
-;;;
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-;;; query handlers
-
-;; handler for a ctcp ACTION query
-;;
-;; Order of args is recipient, sender, message.
-;; E.g. [ACTION->#oink_worship] noah splodes
-(defun zenirc-ctcp-query-ACTION (proc parsedctcp from to)
- (if (and (not zenirc-always-show-channelname)
- (zenirc-names-equal-p to zenirc-current-victim t))
- (zenirc-message proc 'ctcp_action_nochannel
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- (cdr parsedctcp))
- (zenirc-message proc 'ctcp_action
- to
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- (cdr parsedctcp))))
-
-;; handler for a ctcp PING query
-(defun zenirc-ctcp-query-PING (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aPING " (cdr parsedctcp) "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_ping
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; handler for a ctcp VERSION query
-(defun zenirc-ctcp-query-VERSION (proc parsedctcp from to)
- (process-send-string
- proc (format "NOTICE %s :\C-aVERSION ZenIRC : %s : in %s %s\C-a\n"
- (zenirc-extract-nick from)
- zenirc-version
- (zenirc-emacs-variant)
- emacs-version))
- (and zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_version
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; handler for a ctcp USERINFO query
-(defun zenirc-ctcp-query-USERINFO (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aUSERINFO :" zenirc-userinfo "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_userinfo
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; handler for a ctcp SOURCE query
-(defun zenirc-ctcp-query-SOURCE (proc parsedctcp from to)
- (let ((src zenirc-source-list)
- (fromnick (zenirc-extract-nick from)))
- (while src
- (process-send-string proc
- (concat "NOTICE "
- fromnick
- " :\C-aSOURCE " (car src) "\C-a\n"))
- (setq src (cdr src)))
- (process-send-string proc (concat "NOTICE " fromnick " :\C-aSOURCE\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_source
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to))))
-
-;; handler for a ctcp CLIENTINFO query
-(defun zenirc-ctcp-query-CLIENTINFO (proc parsedctcp from to)
- (let ((replyto (zenirc-extract-nick from))
- (sender (zenirc-run-hook 'zenirc-format-nickuserhost-hook from))
- help)
- (if (string= (cdr parsedctcp) "")
- (process-send-string proc (format "NOTICE %s :\C-aCLIENTINFO %s\C-a\n"
- replyto zenirc-clientinfo-string))
- (setq help (cdr (assq (intern-soft (cdr parsedctcp))
- zenirc-clientinfo-list)))
- (if help
- (process-send-string
- proc (format "NOTICE %s :\C-aCLIENTINFO %s\C-a\n" replyto help))
- (zenirc-ctcp-errmsg "PRIVMSG" from to "CLIENTINFO"
- (concat (cdr parsedctcp)
- " is not a valid function")
- proc)))
- (and zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_clientinfo sender to))))
-
-;; handler for a ctcp ECHO query
-(defun zenirc-ctcp-query-ECHO (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aECHO"
- (if (string= "" (cdr parsedctcp))
- ""
- (concat " " (cdr parsedctcp)))
- "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_echo
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to (cdr parsedctcp))))
-
-
-;; handler for a ctcp ERRMSG query
-(defun zenirc-ctcp-query-ERRMSG (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aERRMSG"
- (if (string= "" (cdr parsedctcp))
- ""
- (concat " " (cdr parsedctcp) " :No error"))
- "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_errmsg
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; handler for a ctcp FINGER query
-(defun zenirc-ctcp-query-FINGER (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aFINGER :" zenirc-fingerdata "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_finger
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;; handler for a ctcp TIME query
-(defun zenirc-ctcp-query-TIME (proc parsedctcp from to)
- (process-send-string
- proc (concat "NOTICE "
- (zenirc-extract-nick from)
- " :\C-aTIME :" (current-time-string) "\C-a\n"))
- (if zenirc-verbose-ctcp
- (zenirc-message proc 'ctcp_time
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- to)))
-
-;;; reply handlers
-
-;; handler for a ctcp PING reply
-(defun zenirc-ctcp-reply-PING (proc parsedctcp from to)
- (let ((current (car (cdr (zenirc-time-to-int (current-time-string))))))
- (if (< current
- (string-to-int (cdr parsedctcp)))
- (setq current (+ 65536 current)))
- (zenirc-message proc 'ctcp_ping_reply
- (zenirc-run-hook 'zenirc-format-nickuserhost-hook from)
- (- current (string-to-int (cdr parsedctcp))))))
-
-\f
-(defun zenirc-bug ()
- "Send a bug report to the ZenIRC maintainers."
- (interactive)
- (require 'sendmail)
- (mail nil zenirc-bug-address
- (format "Found bug in zenirc %s" zenirc-version))
- (goto-char (point-max))
- (insert
- (emacs-version) "\n\n"
- "Describe the bug you encountered as well as you can.\n"
- (substitute-command-keys
- "When you're done press \\[mail-send-and-exit] to send the message.\n\n")))
-
-\f
-(provide 'zenirc)
-
-(zenirc-lang-define-english-catalog)
-
-;;; zenirc.el ends here
projects / packages / commitdiff
